hugs98-plus-Sep2006/0000755006511100651110000000000010504341417012762 5ustar rossrosshugs98-plus-Sep2006/ac_macros/0000755006511100651110000000000010504340130014700 5ustar rossrosshugs98-plus-Sep2006/ac_macros/acx_pthread.m40000644006511100651110000001600310002551245017430 0ustar rossrossdnl Available from the GNU Autoconf Macro Archive at: dnl http://www.gnu.org/software/ac-archive/htmldoc/acx_pthread.html dnl AC_DEFUN([ACX_PTHREAD], [ AC_REQUIRE([AC_CANONICAL_HOST]) AC_LANG_SAVE AC_LANG_C acx_pthread_ok=no # We used to check for pthread.h first, but this fails if pthread.h # requires special compiler flags (e.g. on True64 or Sequent). # It gets checked for in the link test anyway. # First of all, check if the user has set any of the PTHREAD_LIBS, # etcetera environment variables, and if threads linking works using # them: if test x"$PTHREAD_LIBS$PTHREAD_CFLAGS" != x; then save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS $PTHREAD_CFLAGS" save_LIBS="$LIBS" LIBS="$PTHREAD_LIBS $LIBS" AC_MSG_CHECKING([for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS]) AC_TRY_LINK_FUNC(pthread_join, acx_pthread_ok=yes) AC_MSG_RESULT($acx_pthread_ok) if test x"$acx_pthread_ok" = xno; then PTHREAD_LIBS="" PTHREAD_CFLAGS="" fi LIBS="$save_LIBS" CFLAGS="$save_CFLAGS" fi # We must check for the threads library under a number of different # names; the ordering is very important because some systems # (e.g. DEC) have both -lpthread and -lpthreads, where one of the # libraries is broken (non-POSIX). # Create a list of thread flags to try. Items starting with a "-" are # C compiler flags, and other items are library names, except for "none" # which indicates that we try without any flags at all. acx_pthread_flags="pthreads none -Kthread -kthread lthread -pthread -pthreads -mthreads pthread --thread-safe -mt" # The ordering *is* (sometimes) important. Some notes on the # individual items follow: # pthreads: AIX (must check this before -lpthread) # none: in case threads are in libc; should be tried before -Kthread and # other compiler flags to prevent continual compiler warnings # -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h) # -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able) # lthread: LinuxThreads port on FreeBSD (also preferred to -pthread) # -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads) # -pthreads: Solaris/gcc # -mthreads: Mingw32/gcc, Lynx/gcc # -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it # doesn't hurt to check since this sometimes defines pthreads too; # also defines -D_REENTRANT) # pthread: Linux, etcetera # --thread-safe: KAI C++ case "${host_cpu}-${host_os}" in *solaris*) # On Solaris (at least, for some versions), libc contains stubbed # (non-functional) versions of the pthreads routines, so link-based # tests will erroneously succeed. (We need to link with -pthread or # -lpthread.) (The stubs are missing pthread_cleanup_push, or rather # a function called by this macro, so we could check for that, but # who knows whether they'll stub that too in a future libc.) So, # we'll just look for -pthreads and -lpthread first: acx_pthread_flags="-pthread -pthreads pthread -mt $acx_pthread_flags" ;; esac if test x"$acx_pthread_ok" = xno; then for flag in $acx_pthread_flags; do case $flag in none) AC_MSG_CHECKING([whether pthreads work without any flags]) ;; -*) AC_MSG_CHECKING([whether pthreads work with $flag]) PTHREAD_CFLAGS="$flag" ;; *) AC_MSG_CHECKING([for the pthreads library -l$flag]) PTHREAD_LIBS="-l$flag" ;; esac save_LIBS="$LIBS" save_CFLAGS="$CFLAGS" LIBS="$PTHREAD_LIBS $LIBS" CFLAGS="$CFLAGS $PTHREAD_CFLAGS" # Check for various functions. We must include pthread.h, # since some functions may be macros. (On the Sequent, we # need a special flag -Kthread to make this header compile.) # We check for pthread_join because it is in -lpthread on IRIX # while pthread_create is in libc. We check for pthread_attr_init # due to DEC craziness with -lpthreads. We check for # pthread_cleanup_push because it is one of the few pthread # functions on Solaris that doesn't have a non-functional libc stub. # We try pthread_create on general principles. AC_TRY_LINK([#include ], [pthread_t th; pthread_join(th, 0); pthread_attr_init(0); pthread_cleanup_push(0, 0); pthread_create(0,0,0,0); pthread_cleanup_pop(0); ], [acx_pthread_ok=yes]) LIBS="$save_LIBS" CFLAGS="$save_CFLAGS" AC_MSG_RESULT($acx_pthread_ok) if test "x$acx_pthread_ok" = xyes; then break; fi PTHREAD_LIBS="" PTHREAD_CFLAGS="" done fi # Various other checks: if test "x$acx_pthread_ok" = xyes; then save_LIBS="$LIBS" LIBS="$PTHREAD_LIBS $LIBS" save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS $PTHREAD_CFLAGS" # Detect AIX lossage: threads are created detached by default # and the JOINABLE attribute has a nonstandard name (UNDETACHED). AC_MSG_CHECKING([for joinable pthread attribute]) AC_TRY_LINK([#include ], [int attr=PTHREAD_CREATE_JOINABLE;], ok=PTHREAD_CREATE_JOINABLE, ok=unknown) if test x"$ok" = xunknown; then AC_TRY_LINK([#include ], [int attr=PTHREAD_CREATE_UNDETACHED;], ok=PTHREAD_CREATE_UNDETACHED, ok=unknown) fi if test x"$ok" != xPTHREAD_CREATE_JOINABLE; then AC_DEFINE(PTHREAD_CREATE_JOINABLE, $ok, [Define to the necessary symbol if this constant uses a non-standard name on your system.]) fi AC_MSG_RESULT(${ok}) if test x"$ok" = xunknown; then AC_MSG_WARN([we do not know how to create joinable pthreads]) fi AC_MSG_CHECKING([if more special flags are required for pthreads]) flag=no case "${host_cpu}-${host_os}" in *-aix* | *-freebsd*) flag="-D_THREAD_SAFE";; *solaris* | *-osf* | *-hpux*) flag="-D_REENTRANT";; esac AC_MSG_RESULT(${flag}) if test "x$flag" != xno; then PTHREAD_CFLAGS="$flag $PTHREAD_CFLAGS" fi LIBS="$save_LIBS" CFLAGS="$save_CFLAGS" # More AIX lossage: must compile with cc_r AC_CHECK_PROG(PTHREAD_CC, cc_r, cc_r, ${CC}) else PTHREAD_CC="$CC" fi AC_SUBST(PTHREAD_LIBS) AC_SUBST(PTHREAD_CFLAGS) AC_SUBST(PTHREAD_CC) # Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: if test x"$acx_pthread_ok" = xyes; then ifelse([$1],,AC_DEFINE(HAVE_PTHREAD,1,[Define if you have POSIX threads libraries and header files.]),[$1]) : else acx_pthread_ok=no $2 fi AC_LANG_RESTORE ])dnl ACX_PTHREAD hugs98-plus-Sep2006/ac_macros/ice_prog_cpp_traditional.m40000644006511100651110000000276510205372732022212 0ustar rossrossdnl dnl This file is part of DDD. dnl dnl DDD is free software; you can redistribute it and/or dnl modify it under the terms of the GNU General Public dnl License as published by the Free Software Foundation; either dnl version 2 of the License, or (at your option) any later version. dnl dnl ICE_PROG_CPP_TRADITIONAL dnl ------------------------ dnl dnl Set output variable `CPP_TRADITIONAL' to a command that runs a dnl "traditional" C preprocessor (that is, pre-ANSI-C). dnl Try each one of `$CPP', `$CC -E', `/lib/cpp' either without flags dnl or with `-traditional-cpp' or with `-traditional'. dnl dnl Local changes: dnl - the test input is Haskellized dnl - added -Xs (for Solaris) dnl AC_DEFUN([ICE_PROG_CPP_TRADITIONAL], [ AC_REQUIRE([AC_PROG_CPP]) AC_CACHE_CHECK([for a traditional C preprocessor], [ice_cv_traditional_cpp], [ cat > conftest.c << EOF #if 1 {-# INLINE f' #-} f' x = x+1 #endif EOF ice_cv_traditional_cpp= ice_save_cpp="$CPP" ice_save_cppflags="$CPPFLAGS" for ice_cpp in "$CPP" "$CC -E" "/lib/cpp"; do for ice_cppflags in '' ' -traditional-cpp' ' -traditional' ' -Xs'; do CPP="$ice_cpp" CPPFLAGS="$ice_cppflags" AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ #if 1 {-# INLINE f' #-} f' x = x+1 #endif ]])], [ice_cv_traditional_cpp="${CPP}${CPPFLAGS}"]) if test "$ice_cv_traditional_cpp" != ""; then break 2 fi done done CPP="$ice_save_cpp" CPPFLAGS="$ice_save_cppflags" ]) CPP_TRADITIONAL="$ice_cv_traditional_cpp" AC_SUBST(CPP_TRADITIONAL) ])dnl hugs98-plus-Sep2006/.cvsignore0000644006511100651110000000002610005177205014756 0ustar rossross*.rpm Defs.mk hugsdir hugs98-plus-Sep2006/Credits0000644006511100651110000000210110041424634014273 0ustar rossrossPlease send bug reports to General questions about using Hugs should be sent to ======================================================================== Credits ======================================================================== Original author: Mark Jones Primary developers: Sigbjorn Finne Jeff Lewis Johan Nordlander Sven Panne Ross Paterson Alastair Reid Valuable contributions: Hans Aberg Pablo Azero Levent Erkok Pepe Gallardo Andy Gill Thomas Nordin Jeremy Shute Richard Watson ======================================================================== The development of Hugs has been supported, in part and at different times, by the Yale Haskell Group at Yale University, by the Pacific Software Research Center (PacSoft) at the OGI School of Science & Engineering at OHSU, by Galois Connections, Inc., and by Reid Consulting (UK) Limited. ======================================================================== hugs98-plus-Sep2006/License0000644006511100651110000000321007743000202014256 0ustar rossrossThe Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, 1994-2003, All rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/Makefile0000644006511100651110000001225510504341417014427 0ustar rossross# Top-level Makefile for Hugs # (this should be a POSIX 1003.2-1992 Makefile) # Start of general settings (leave this line unchanged) NAME = hugs98 # Set to 0 if a snapshot release. MAJOR_RELEASE = 1 # Release number of RPM. RELEASE = 1 TAG = HEAD HSLIBSTAG = HEAD CVS_ROOT = :pserver:anoncvs@cvs.haskell.org:/cvs HSLIBSDIRS = concurrent data hssource lang net text util posix DARCS_ROOT = http://darcs.haskell.org LIBRARIESDIRS = base haskell98 haskell-src mtl network parsec QuickCheck unix \ Cabal OpenGL GLUT OpenAL ALUT fgl X11 HGL HaXml HUnit Win32 time stm \ xhtml DARCS_CPPHS = http://www.cs.york.ac.uk/fp/darcs/cpphs # End of general settings (leave this line unchanged) PACKAGES = packages/base/base.cabal DARCS_GET = darcs get --partial # General targets: # # all: (default) build a system that can be run in-place. # install: all + install in $(prefix) as supplied to configure. # clean: delete files generated in building, except those needed # for in-place use. # distclean: delete files created by configuring or building. # veryclean: delete most things that can be regenerated (though this # will require additional tools). # check: run regression tests # Note: we have to build in src before building in libraries, as the # latter uses the binaries in src. See libraries/Makefile.in for # details of the bootstrapping of the libraries. all: $(PACKAGES) src/Makefile cd src; $(MAKE) all cd libraries; $(MAKE) all cd docs; $(MAKE) all # We install the standard libraries and the simple demos. # We don't install things which don't work on Unix (e.g. Win32). install: install_all_but_docs cd docs; $(MAKE) install # Install everything except documentation, which is installed differently # by some packagers (e.g. rpm) install_all_but_docs: $(PACKAGES) src/Makefile cd src; $(MAKE) install cd libraries; $(MAKE) install cd demos; $(MAKE) install clean: clean_root cd src; if test -f Makefile; then $(MAKE) clean; fi cd libraries; if test -f Makefile; then $(MAKE) clean; fi cd docs; if test -f Makefile; then $(MAKE) clean; fi cd demos; if test -f Makefile; then $(MAKE) clean; fi distclean: distclean_root cd src; if test -f Makefile; then $(MAKE) distclean; fi cd libraries; if test -f Makefile; then $(MAKE) distclean; fi cd docs; if test -f Makefile; then $(MAKE) distclean; fi cd demos; if test -f Makefile; then $(MAKE) distclean; fi veryclean: veryclean_root cd src; if test -f Makefile; then $(MAKE) veryclean; fi cd libraries; if test -f Makefile; then $(MAKE) veryclean; fi cd docs; if test -f Makefile; then $(MAKE) veryclean; fi cd demos; if test -f Makefile; then $(MAKE) veryclean; fi clean_root: $(RM) *.tar.gz *.rpm Defs.mk $(RM) *~ distclean_root: clean_root $(RM) -r config.status config.log config.cache autom4te.cache $(RM) MkDefs tests/config veryclean_root: distclean_root cd debian; $(RM) control hugs.copyright libhugs-*-bundled.* ################################################################ # Regression tests (Unix only) # # Uses runstdtest (from ghc-0.26/ghc/glafp-utils/scripts), perl 5 # and /bin/sh (Bourne shell). # # "make verbosecheck" generates a lot of output to explain what is going on # and reassure you that progress is being made. This is great if you've # never run these tests before - but if you just want to reassure yourself # that nothing has broken since the last release, you might prefer to # run "make check" which removes all the explanations and success # stories - leaving just the errors (if any). # ################################################################ check: all cd tests && sh testScript | if egrep -v '^--( |-----)'; then false; else true; fi verbosecheck: all cd tests && sh testScript # Building distributions tarplus: Defs.mk $(MAKE) -f RPM.mk tar tar: Defs.mk $(MAKE) PKGNAME=$(NAME) LIBRARIESDIRS='base haskell98 Cabal' -f RPM.mk tar rpm: Defs.mk $(MAKE) -f RPM.mk rpm Defs.mk: Makefile ( echo '# Automatically extracted from Makefile (so edit that instead)';\ sed -n '/^# Start of general settings/,/^# End of general settings/p' Makefile;\ ) >$@ # Build phases: # configuration src/Makefile: configure $(RM) -r config.cache autom4te.cache LIBS=$(GNULIBS) ./configure $(EXTRA_CONFIGURE_OPTS) configure: configure.ac aclocal.m4 $(PACKAGES) for dir in packages/*; do if test -f $$dir/configure.ac; \ then (cd $$dir; autoreconf); fi; done -autoreconf # fetching library sources and utility programs $(PACKAGES): cvs -d $(CVS_ROOT) checkout -r $(HSLIBSTAG) `for lib in $(HSLIBSDIRS); do echo fptools/hslibs/$$lib; done` $(RM) -r packages cpphs hsc2hs mkdir packages for lib in $(LIBRARIESDIRS); do $(DARCS_GET) --repo-name=packages/$$lib $(DARCS_ROOT)/packages/$$lib; done # We don't use this, so don't leave it there for Cabal to run cd packages; $(RM) HaXml/configure # Move these so that make_bootlib won't convert them cd packages; mv Cabal/*.lhs Cabal/examples $(DARCS_GET) $(DARCS_CPPHS) $(DARCS_GET) $(DARCS_ROOT)/hsc2hs debian/control: debian/control.in debian/make-control.hs cp License debian/hugs.copyright # We need runhugs to build a Debian source package from CVS, # but don't complain if it's unavailable. -runhugs -98 debian/make-control.hs `ls packages/*/*.cabal | grep -v Win32` 2>/dev/null hugs98-plus-Sep2006/MkDefs.in0000644006511100651110000000136210464157152014473 0ustar rossross########################################################################## # @configure_input@ # Makefile definitions also used by the libraries # These variables determine where various parts of the Hugs system are # installed. (They are ignored in Windows or DOS.) # Binaries are installed in $(bindir); libraries go in $(hugsdir)/libraries prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ datarootdir = @datarootdir@ datadir = @datadir@ mandir = @mandir@ hugsdir = @hugsdir@ RM = @RM@ CP = @CP@ HOST = @HostPlatform@ HOST_OS = @HostOS_CPP@ HOST_ARCH = @HostArch_CPP@ DLL = @DLL@ BAT = @BAT@ # end of @configure_input@ ########################################################################## hugs98-plus-Sep2006/RPM.mk0000644006511100651110000000764010477335113013765 0ustar rossross# A (GNU) Makefile for building source and RPM distributions. include Defs.mk DARCS_GET = darcs get --no-pristine-tree --partial MONTH_YEAR = $(shell date +"%B %Y") MON_YEAR = $(shell date +"%b%Y") YEAR_MONTH_DAY = $(shell date +"%Y%m%d") # convention: a release uses the MON_YEAR form of version, # while a snapshot uses the YEAR_MONTH_DAY form. # this should be sync'd with src/version.c ifeq "$(MAJOR_RELEASE)" "1" VERSION=$(MON_YEAR) else VERSION=$(YEAR_MONTH_DAY) endif PKGNAME = $(NAME) PACKAGE = $(PKGNAME)-$(VERSION) # Starting with Red Hat 8.0, the build functionality was removed from rpm, so # one has to use rpmbuild instead. SuSE didn't follow this change, so there is # no rpmbuild on SuSE and rpm still does the job. I like such changes... RPMBUILD = rpmbuild TMP = /tmp RPMTMP = $(TMP)/rpm # probably should be uniqueified TARTMP = $(TMP)/mktar SPECFILE=$(NAME).spec RPMDEFS = --define "_topdir $(RPMTMP)" \ --define "name $(NAME)" \ --define "version $(VERSION)" \ --define "release $(RELEASE)" \ VERSION_SUBSTS = \ -e "s/define MAJOR_RELEASE.*/define MAJOR_RELEASE $(MAJOR_RELEASE)/" \ -e "s/VERSION_STRING MONTH_YEAR/VERSION_STRING \"$(MONTH_YEAR)\"/" \ -e "s/VERSION_STRING YYYYMMDD/VERSION_STRING \"$(YEAR_MONTH_DAY)\"/" RC_STRING = RC1 RC_VERSION_SUBSTS = \ -e "s/define MAJOR_RELEASE.*/define MAJOR_RELEASE $(MAJOR_RELEASE)/" \ -e "s/VERSION_STRING MONTH_YEAR/VERSION_STRING \"$(MON_YEAR) $(RC_STRING)\"/" tar: $(PACKAGE).tar.gz # Utilities needed to pre-process fptools. To override # these, set them on the command-line when invoking 'make': # # foo$ make FIND=/usr/bin/find HAPPY=c:/happy/happy-1.15/bin/happy ... # FIND=find HAPPY=happy $(PACKAGE).tar.gz: -rm -rf $(TARTMP) -mkdir -p $(TARTMP) # Note: The following line will not work correctly for "make -C blah". CVSROOT=$(CVS_ROOT); export CVSROOT; \ cd $(TARTMP); \ cvs export -r $(TAG) hugs98; \ cd hugs98; \ cvs export -r $(HSLIBSTAG) `for lib in $(HSLIBSDIRS); do echo fptools/hslibs/$$lib; done` cd $(TARTMP)/hugs98; mkdir packages cd $(TARTMP)/hugs98/packages; for lib in $(LIBRARIESDIRS); do $(DARCS_GET) $(DARCS_ROOT)/packages/$$lib; done cd $(TARTMP)/hugs98/packages; $(RM) -r */_darcs cd $(TARTMP)/hugs98/packages; $(RM) HaXml/configure cd $(TARTMP)/hugs98/packages; mv Cabal/Setup.lhs Cabal/examples/DefaultSetup.lhs # preprocess, so the package can be built without happy if test -d $(TARTMP)/hugs98/packages/haskell-src; \ then $(HAPPY) $(TARTMP)/hugs98/packages/haskell-src/Language/Haskell/Parser.ly; \ else true; \ fi cd $(TARTMP)/hugs98; $(DARCS_GET) $(DARCS_CPPHS) cd $(TARTMP)/hugs98; $(RM) -r cpphs/_darcs cd $(TARTMP)/hugs98; $(DARCS_GET) $(DARCS_ROOT)/hsc2hs cd $(TARTMP)/hugs98; $(RM) -r hsc2hs/_darcs cp $(TARTMP)/hugs98/src/version.c $(TARTMP) cd $(TARTMP)/hugs98/src; sed $(VERSION_SUBSTS) < $(TARTMP)/version.c > $(TARTMP)/hugs98/src/version.c # using `make parser.c' would be best, but by default yacc # will be used, and byacc is, for some reason, incompatible cd $(TARTMP)/hugs98/src; bison -y parser.y; mv y.tab.c parser.c # Siggy deren't like these in distros if test "$(MAJOR_RELEASE)" -eq 1; then cd $(TARTMP)/hugs98; rm -rf tests; fi cd $(TARTMP)/hugs98; make configure cd $(TARTMP)/hugs98; $(RM) -r autom4te.cache libraries/autom4te.cache packages/*/autom4te.cache cd $(TARTMP)/hugs98; make debian/control mv $(TARTMP)/hugs98 $(TARTMP)/$(PACKAGE) cd $(TARTMP); tar cf $(TMP)/$(PKGNAME).tar $(PACKAGE) gzip -9 $(TMP)/$(PKGNAME).tar mv $(TMP)/$(PKGNAME).tar.gz $(PACKAGE).tar.gz rpm-dirs: -mkdir $(RPMTMP) -mkdir $(RPMTMP)/BUILD -mkdir $(RPMTMP)/RPMS -mkdir $(RPMTMP)/SOURCES -mkdir $(RPMTMP)/SPECS -mkdir $(RPMTMP)/SRPMS rpm: tar rpm-dirs cp $(PACKAGE).tar.gz $(RPMTMP)/SOURCES $(RPMBUILD) $(RPMDEFS) -ba $(SPECFILE) mv $(RPMTMP)/RPMS/i?86/$(PACKAGE)-$(RELEASE).i?86.rpm . mv $(RPMTMP)/SRPMS/$(PACKAGE)-$(RELEASE).src.rpm . rc-rpm: $(MAKE) VERSION_SUBSTS='$(RC_VERSION_SUBSTS)' rpm hugs98-plus-Sep2006/Readme0000644006511100651110000000440110430331101014064 0ustar rossross------------------------------------------------------------------------------ __ __ __ __ ____ ___ _________________________________________ || || || || || || ||__ Hugs 98: Based on the Haskell 98 standard ||___|| ||__|| ||__|| __|| Copyright (c) 1994-2006 ||---|| ___|| World Wide Web: http://haskell.org/hugs || || Report bugs to: hugs-bugs@haskell.org || || Version: May 2006 _________________________________________ ------------------------------------------------------------------------------ We are pleased to announce a new release of Hugs98, an interpreter and programming environment for developing Haskell programs. In addition to numerous bug fixes, changes since the interim release in March 2005 include: - The default current module is now the empty module Hugs. - Compatibility libraries are present, but no longer included on the default search path. They will be removed in the next release. - Rewritten graphical Windows interface (contributed by Neil Mitchell). Further changes since the last major release in November 2003 include: - The Char type and the Char module now support Unicode as specified in the Haskell 98 Report (contributed by Dmitry Golubovsky). - The new -X option groups several options into one argument. - The syntax of the ffihugs command has changed: the +G and +L options are gone, and a new +i option can be used to specify include files. - Hugs now has basic support for Cabal. The home page for Hugs is at http://haskell.org/hugs. Send email to hugs-users-request@haskell.org to join the hugs-users mailing list. Bug reports should be sent to hugs-bugs@haskell.org. Send email to hugs-bugs-request@haskell.org to subscribe to the hugs-bugs list. ------------------------------------------------------------------------------ The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, 1994-2005, All rights reserved. It is distributed as free software under the license in the file "License", which is included in the distribution. ------------------------------------------------------------------------------ hugs98-plus-Sep2006/aclocal.m40000644006511100651110000001473410313641557014641 0ustar rossrossdnl ################################################################ dnl Macros dnl (hard-core autoconf hackers only) dnl ################################################################ dnl Like AC_SUBST but with a default value in case var is undefined dnl typically usage from cshell: env DEV_NULL="/dev/null" ./configure dnl AC_SUBST_DEF(varname,defaultvalue) AC_DEFUN([AC_SUBST_DEF],[ $1=${$1=$2} AC_SUBST($1) ]) dnl On some machines, you cannot take the address of a jmp_buf dnl AC_DEFUN([AC_C_JMPBUF_ARRAY], [AC_CACHE_CHECK(for arrays of jmp_bufs, ac_cv_c_jmp_buf_array, [AC_TRY_COMPILE([ #include int test1() { jmp_buf jb[1]; jmp_buf *jbp = jb; return (setjmp(jb[0]) == 0); } ], [int i;], ac_cv_c_jmp_buf_array=yes, ac_cv_c_jmp_buf_array=no)]) if test "$ac_cv_c_jmp_buf_array" = yes; then AC_DEFINE(JMPBUF_ARRAY, [1], [Define to 1 if jmpbufs can be treated like arrays.]) fi ]) dnl POSIX systems prefer "diff -C 1"; SunOS4 prefers "diff -c1". dnl AC_DEFUN([AC_PROG_DIFF], [AC_PATH_PROG(DIFF,diff) AC_CACHE_CHECK(whether to use "diff -c1" or "diff -C 1", CONTEXT_DIFF, if AC_TRY_COMMAND(diff -C 1 config.log config.log); then CONTEXT_DIFF="$DIFF -C 1" else if AC_TRY_COMMAND(diff -c1 config.log config.log); then CONTEXT_DIFF="$DIFF -c1" else CONTEXT_DIFF="$DIFF" fi fi ) AC_SUBST(CONTEXT_DIFF) ]) dnl check for gcc's "labels as values" feature AC_DEFUN([AC_C_LABELS_AS_VALUES], [AC_CACHE_CHECK([labels as values], ac_cv_labels_as_values, [AC_TRY_COMPILE([ int foo(int); int foo(i) int i; { static void *label[] = { &&l1, &&l2 }; goto *label[i]; l1: return 1; l2: return 2; } ], [int i;], ac_cv_labels_as_values=yes, ac_cv_labels_as_values=no)]) if test "$ac_cv_labels_as_values" = yes; then AC_DEFINE(HAVE_LABELS_AS_VALUES, [1], [Define to 1 if compiler supports gcc's "labels as values" (aka computed goto) feature (which is used to speed up instruction dispatch in the interpreter).]) fi ]) # FP_DECL_TIMEZONE # --------------- # Defines HAVE_DECL_TIMEZONE to 1 if declared, 0 otherwise. # Defines HAVE_DECL__TIMEZONE to 1 if declared, 0 otherwise. # Defines HAVE_DECL_ALTZONE to 1 if declared, 0 otherwise. # AC_DEFUN([FP_DECL_TIMEZONE], [AC_REQUIRE([AC_HEADER_TIME])dnl AC_CHECK_HEADERS([sys/time.h]) AC_CHECK_DECLS([timezone, _timezone, altzone], [], [], [#if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif]) ])# FP_DECL_TIMEZONE # FP_CHECK_FUNC(FUNCTION, PROLOGUE, BODY, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) # --------------------------------------------------------------------------------- # A variant of AC_CHECK_FUNCS, limited to a single FUNCTION, but with the # additional flexibility of specifying the PROLOGUE and BODY. AC_DEFUN([FP_CHECK_FUNC], [AS_VAR_PUSHDEF([fp_func], [fp_cv_func_$1])dnl AC_CACHE_CHECK([for $1], fp_func, [AC_LINK_IFELSE([AC_LANG_PROGRAM([$2], [$3])], [AS_VAR_SET(fp_func, yes)], [AS_VAR_SET(fp_func, no)])]) AS_IF([test AS_VAR_GET(fp_func) = yes], [AC_DEFINE(AS_TR_CPP(HAVE_$1), [1], [Define to 1 if you have the `]$1[' function.]) $4], [$5])dnl AS_VAR_POPDEF([fp_func])dnl ])# FP_CHECK_FUNC dnl ** Try building and loading a dynamically loadable library using dnl the specified flags. dnl AC_DEFUN([HUGS_TRY_DYNLINK], dnl AC_BEFORE([$0], [AC_C_PROTOTYPES]) [AC_MSG_CHECKING(if '$1' builds loadable libraries) AC_CACHE_VAL(ac_cv_dll_flags, [ cat > conftest_dl.c < conftest.c << EOF #include "confdefs.h" #if PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif #define SYMBOL1 "test" #define SYMBOL2 "_test" #define CANTRUN 1 #define CANTOPEN 2 #define SYM1_OK 3 #define SYM2_OK 4 #define CANTFIND 5 #if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */ #include #include main() { void *instance; void *sym; instance = dlopen("./conftest_dl.so",1); if (instance==0) exit(CANTOPEN); sym = dlsym(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = dlsym(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_DL_H /* eg HPUX */ #include main() { shl_t instance; void* r; instance = shl_load("./conftest_dl.so",BIND_IMMEDIATE,0L); if (instance == 0) exit(CANTOPEN); if (0 == shl_findsym(&instance,SYMBOL1,TYPE_PROCEDURE,&r)) exit(SYM1_OK); if (0 == shl_findsym(&instance,SYMBOL2,TYPE_PROCEDURE,&r)) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_MACH_O_DYLD_H /* MacOS X */ #include #include main() { NSObjectFileImage ofile; NSModule handle = NULL; void* addr; NSSymbol sym; if (NSCreateObjectFileImageFromFile("./conftest_dl.so",&ofile) != NSObjectFileImageSuccess) exit(CANTOPEN); handle = NSLinkModule(ofile,"./conftest_dl.so",NSLINKMODULE_OPTION_PRIVATE); if (handle == 0) exit(CANTOPEN); sym = NSLookupSymbolInModule(handle, SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = NSLookupSymbolInModule(handle, SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_WINDOWS_H #include main() { HINSTANCE instance; void* sym; instance = LoadLibrary("conftest_dl.so"); if (instance ==0) exit(CANTOPEN); sym = (void*)GetProcAddress(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = (void*)GetProcAddress(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #else main() { exit(CANTRUN); } #endif EOF if AC_TRY_EVAL(ac_link) && test -s conftest${ac_exeext} then dnl compiling and linking loader succeeded ./conftest 2>/dev/null ac_result=$? if test $ac_result = 3; then ac_cv_dll_flags='$1' ac_cv_leading_underscore=no fi if test $ac_result = 4; then ac_cv_dll_flags='$1' ac_cv_leading_underscore=yes fi fi dnl compiling and linking loader succeeded fi dnl compiling and linking loadee succeeded rm -fr conftest* a.out ]) dnl close AC_CACHE_VAL AC_MSG_RESULT($ac_cv_dll_flags)] ) dnl External macros builtin([include],ac_macros/acx_pthread.m4) hugs98-plus-Sep2006/config.guess0000755006511100651110000012475310331137251015313 0ustar rossross#! /bin/sh # Attempt to guess a canonical system name. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. timestamp='2005-08-03' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA # 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Originally written by Per Bothner . # Please send patches to . Submit a context # diff and a properly formatted ChangeLog entry. # # This script attempts to guess a canonical system name similar to # config.sub. If it succeeds, it prints the system name on stdout, and # exits with 0. Otherwise, it exits with 1. # # The plan is that this can be called by configure scripts if you # don't specify an explicit build system type. me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] Output the configuration name of the system \`$me' is run on. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to ." version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" >&2 exit 1 ;; * ) break ;; esac done if test $# != 0; then echo "$me: too many arguments$help" >&2 exit 1 fi trap 'exit 1' 1 2 15 # CC_FOR_BUILD -- compiler used by this script. Note that the use of a # compiler to aid in system detection is discouraged as it requires # temporary files to be created and, as you can see below, it is a # headache to deal with in a portable fashion. # Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still # use `HOST_CC' if defined, but it is deprecated. # Portable tmp directory creation inspired by the Autoconf team. set_cc_for_build=' trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; : ${TMPDIR=/tmp} ; { tmp=`(umask 077 && mktemp -d -q "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; dummy=$tmp/dummy ; tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; case $CC_FOR_BUILD,$HOST_CC,$CC in ,,) echo "int x;" > $dummy.c ; for c in cc gcc c89 c99 ; do if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then CC_FOR_BUILD="$c"; break ; fi ; done ; if test x"$CC_FOR_BUILD" = x ; then CC_FOR_BUILD=no_compiler_found ; fi ;; ,,*) CC_FOR_BUILD=$CC ;; ,*,*) CC_FOR_BUILD=$HOST_CC ;; esac ; set_cc_for_build= ;' # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24) if (test -f /.attbin/uname) >/dev/null 2>&1 ; then PATH=$PATH:/.attbin ; export PATH fi UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown # Note: order is significant - the case branches are not exclusive. case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward # compatibility and a consistent mechanism for selecting the # object file format. # # Note: NetBSD doesn't particularly care about the vendor # portion of the name. We always set it to "unknown". sysctl="sysctl -n hw.machine_arch" UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ /usr/sbin/$sysctl 2>/dev/null || echo unknown)` case "${UNAME_MACHINE_ARCH}" in armeb) machine=armeb-unknown ;; arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched # to ELF recently, or will in the future. case "${UNAME_MACHINE_ARCH}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep __ELF__ >/dev/null then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? os=netbsd else os=netbsdelf fi ;; *) os=netbsd ;; esac # The OS release # Debian GNU/NetBSD machines have a different userland, and # thus, need a distinct triplet. However, they do not need # kernel version information, so it can be replaced with a # suitable tag, in the style of linux-gnu. case "${UNAME_VERSION}" in Debian*) release='-gnu' ;; *) release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` ;; esac # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: # contains redundant information, the shorter form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} exit ;; *:ekkoBSD:*:*) echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} exit ;; macppc:MirBSD:*:*) echo powerppc-unknown-mirbsd${UNAME_RELEASE} exit ;; *:MirBSD:*:*) echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} exit ;; alpha:OSF1:*:*) case $UNAME_RELEASE in *4.0) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on # OSF/1 and Tru64 systems produced since 1995. I hope that # covers most systems running today. This code pipes the CPU # types through head -n 1, so we only detect the type of CPU 0. ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` case "$ALPHA_CPU_TYPE" in "EV4 (21064)") UNAME_MACHINE="alpha" ;; "EV4.5 (21064)") UNAME_MACHINE="alpha" ;; "LCA4 (21066/21068)") UNAME_MACHINE="alpha" ;; "EV5 (21164)") UNAME_MACHINE="alphaev5" ;; "EV5.6 (21164A)") UNAME_MACHINE="alphaev56" ;; "EV5.6 (21164PC)") UNAME_MACHINE="alphapca56" ;; "EV5.7 (21164PC)") UNAME_MACHINE="alphapca57" ;; "EV6 (21264)") UNAME_MACHINE="alphaev6" ;; "EV6.7 (21264A)") UNAME_MACHINE="alphaev67" ;; "EV6.8CB (21264C)") UNAME_MACHINE="alphaev68" ;; "EV6.8AL (21264B)") UNAME_MACHINE="alphaev68" ;; "EV6.8CX (21264D)") UNAME_MACHINE="alphaev68" ;; "EV6.9A (21264/EV69A)") UNAME_MACHINE="alphaev69" ;; "EV7 (21364)") UNAME_MACHINE="alphaev7" ;; "EV7.9 (21364A)") UNAME_MACHINE="alphaev79" ;; esac # A Pn.n version is a patched version. # A Vn.n version is a released version. # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` exit ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead # of the specific Alpha model? echo alpha-pc-interix exit ;; 21064:Windows_NT:50:3) echo alpha-dec-winnt3.5 exit ;; Amiga*:UNIX_System_V:4.0:*) echo m68k-unknown-sysv4 exit ;; *:[Aa]miga[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-amigaos exit ;; *:[Mm]orph[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-morphos exit ;; *:OS/390:*:*) echo i370-ibm-openedition exit ;; *:z/VM:*:*) echo s390-ibm-zvmoe exit ;; *:OS400:*:*) echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; arm:riscos:*:*|arm:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) echo hppa1.1-hitachi-hiuxmpp exit ;; Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. if test "`(/bin/universe) 2>/dev/null`" = att ; then echo pyramid-pyramid-sysv3 else echo pyramid-pyramid-bsd fi exit ;; NILE*:*:*:dcosx) echo pyramid-pyramid-svr4 exit ;; DRS?6000:unix:4.0:6*) echo sparc-icl-nx6 exit ;; DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; i86pc:SunOS:5.*:*) echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:*:*) case "`/usr/bin/arch -k`" in Series*|S4*) UNAME_RELEASE=`uname -v` ;; esac # Japanese Language versions have a version number like `4.1.3-JL'. echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` exit ;; sun3*:SunOS:*:*) echo m68k-sun-sunos${UNAME_RELEASE} exit ;; sun*:*:4.2BSD:*) UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 case "`/bin/arch`" in sun3) echo m68k-sun-sunos${UNAME_RELEASE} ;; sun4) echo sparc-sun-sunos${UNAME_RELEASE} ;; esac exit ;; aushp:SunOS:*:*) echo sparc-auspex-sunos${UNAME_RELEASE} exit ;; # The situation for MiNT is a little confusing. The machine name # can be virtually everything (everything which is not # "atarist" or "atariste" at least should have a processor # > m68000). The system name ranges from "MiNT" over "FreeMiNT" # to the lowercase version "mint" (or "freemint"). Finally # the system name "TOS" denotes a system which is actually not # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) echo m68k-milan-mint${UNAME_RELEASE} exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) echo m68k-hades-mint${UNAME_RELEASE} exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) echo m68k-unknown-mint${UNAME_RELEASE} exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; powerpc:machten:*:*) echo powerpc-apple-machten${UNAME_RELEASE} exit ;; RISC*:Mach:*:*) echo mips-dec-mach_bsd4.3 exit ;; RISC*:ULTRIX:*:*) echo mips-dec-ultrix${UNAME_RELEASE} exit ;; VAX*:ULTRIX*:*:*) echo vax-dec-ultrix${UNAME_RELEASE} exit ;; 2020:CLIX:*:* | 2430:CLIX:*:*) echo clipper-intergraph-clix${UNAME_RELEASE} exit ;; mips:*:*:UMIPS | mips:*:*:RISCos) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #ifdef __cplusplus #include /* for printf() prototype */ int main (int argc, char *argv[]) { #else int main (argc, argv) int argc; char *argv[]; { #endif #if defined (host_mips) && defined (MIPSEB) #if defined (SYSTYPE_SYSV) printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_SVR4) printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); #endif #endif exit (-1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && SYSTEM_NAME=`$dummy $dummyarg` && { echo "$SYSTEM_NAME"; exit; } echo mips-mips-riscos${UNAME_RELEASE} exit ;; Motorola:PowerMAX_OS:*:*) echo powerpc-motorola-powermax exit ;; Motorola:*:4.3:PL8-*) echo powerpc-harris-powermax exit ;; Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) echo powerpc-harris-powermax exit ;; Night_Hawk:Power_UNIX:*:*) echo powerpc-harris-powerunix exit ;; m88k:CX/UX:7*:*) echo m88k-harris-cxux7 exit ;; m88k:*:4*:R4*) echo m88k-motorola-sysv4 exit ;; m88k:*:3*:R3*) echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ [ ${TARGET_BINARY_INTERFACE}x = x ] then echo m88k-dg-dgux${UNAME_RELEASE} else echo m88k-dg-dguxbcs${UNAME_RELEASE} fi else echo i586-dg-dgux${UNAME_RELEASE} fi exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; M88*:*:R3*:*) # Delta 88k system running SVR3 echo m88k-motorola-sysv3 exit ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) echo m88k-tektronix-sysv3 exit ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) echo m68k-tektronix-bsd exit ;; *:IRIX*:*:*) echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` exit ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i*86:AIX:*:*) echo i386-ibm-aix exit ;; ia64:AIX:*:*) if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} exit ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include main() { if (!__power_pc()) exit(1); puts("powerpc-ibm-aix3.2.5"); exit(0); } EOF if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` then echo "$SYSTEM_NAME" else echo rs6000-ibm-aix3.2.5 fi elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then echo rs6000-ibm-aix3.2.4 else echo rs6000-ibm-aix3.2 fi exit ;; *:AIX:*:[45]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 else IBM_ARCH=powerpc fi if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${IBM_ARCH}-ibm-aix${IBM_REV} exit ;; *:AIX:*:*) echo rs6000-ibm-aix exit ;; ibmrt:4.4BSD:*|romp-ibm:BSD:*) echo romp-ibm-bsd4.4 exit ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to exit ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) echo rs6000-bull-bosx exit ;; DPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 exit ;; 9000/[34]??:4.3bsd:1.*:*) echo m68k-hp-bsd exit ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) echo m68k-hp-bsd4.4 exit ;; 9000/[34678]??:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` case "${UNAME_MACHINE}" in 9000/31? ) HP_ARCH=m68000 ;; 9000/[34]?? ) HP_ARCH=m68k ;; 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` case "${sc_cpu_version}" in 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 532) # CPU_PA_RISC2_0 case "${sc_kernel_bits}" in 32) HP_ARCH="hppa2.0n" ;; 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 esac ;; esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #define _HPUX_SOURCE #include #include int main () { #if defined(_SC_KERNEL_BITS) long bits = sysconf(_SC_KERNEL_BITS); #endif long cpu = sysconf (_SC_CPU_VERSION); switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0"); break; case CPU_PA_RISC1_1: puts ("hppa1.1"); break; case CPU_PA_RISC2_0: #if defined(_SC_KERNEL_BITS) switch (bits) { case 64: puts ("hppa2.0w"); break; case 32: puts ("hppa2.0n"); break; default: puts ("hppa2.0"); break; } break; #else /* !defined(_SC_KERNEL_BITS) */ puts ("hppa2.0"); break; #endif default: puts ("hppa1.0"); break; } exit (0); } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa fi ;; esac if [ ${HP_ARCH} = "hppa2.0w" ] then eval $set_cc_for_build # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler # generating 64-bit code. GNU and HP use different nomenclature: # # $ CC_FOR_BUILD=cc ./config.guess # => hppa2.0w-hp-hpux11.23 # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | grep __LP64__ >/dev/null then HP_ARCH="hppa2.0w" else HP_ARCH="hppa64" fi fi echo ${HP_ARCH}-hp-hpux${HPUX_REV} exit ;; ia64:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` echo ia64-hp-hpux${HPUX_REV} exit ;; 3050*:HI-UX:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include int main () { long cpu = sysconf (_SC_CPU_VERSION); /* The order matters, because CPU_IS_HP_MC68K erroneously returns true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct results, however. */ if (CPU_IS_PA_RISC (cpu)) { switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; default: puts ("hppa-hitachi-hiuxwe2"); break; } } else if (CPU_IS_HP_MC68K (cpu)) puts ("m68k-hitachi-hiuxwe2"); else puts ("unknown-hitachi-hiuxwe2"); exit (0); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } echo unknown-hitachi-hiuxwe2 exit ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) echo hppa1.1-hp-bsd exit ;; 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exit ;; *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) echo hppa1.0-hp-mpeix exit ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf exit ;; hp8??:OSF1:*:*) echo hppa1.0-hp-osf exit ;; i*86:OSF1:*:*) if [ -x /usr/sbin/sysversion ] ; then echo ${UNAME_MACHINE}-unknown-osf1mk else echo ${UNAME_MACHINE}-unknown-osf1 fi exit ;; parisc*:Lites*:*:*) echo hppa1.1-hp-lites exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*[A-Z]90:*:*:*) echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ -e 's/\.[^.]*$/.X/' exit ;; CRAY*TS:*:*:*) echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*T3E:*:*:*) echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*SV1:*:*:*) echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; *:UNICOS/mp:*:*) echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; 5000:UNIX_System_V:4.*:*) FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} exit ;; sparc*:BSD/OS:*:*) echo sparc-unknown-bsdi${UNAME_RELEASE} exit ;; *:BSD/OS:*:*) echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; i*:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; i*:windows32*:*) # uname -m includes "-pc" on this system. echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; x86:Interix*:[34]*) echo i586-pc-interix${UNAME_RELEASE}|sed -e 's/\..*//' exit ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we # UNAME_MACHINE based on the output of uname instead of i386? echo i586-pc-interix exit ;; i*:UWIN*:*) echo ${UNAME_MACHINE}-pc-uwin exit ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) echo x86_64-unknown-cygwin exit ;; p*:CYGWIN*:*) echo powerpcle-unknown-cygwin exit ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; *:GNU:*:*) # the GNU system echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` exit ;; *:GNU/*:*:*) # other systems with GNU libc and userland echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu exit ;; i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; arm*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) echo cris-axis-linux-gnu exit ;; crisv32:Linux:*:*) echo crisv32-axis-linux-gnu exit ;; frv:Linux:*:*) echo frv-unknown-linux-gnu exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; m32r*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; mips:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU #undef mips #undef mipsel #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) CPU=mipsel #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) CPU=mips #else CPU= #endif #endif EOF eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU #undef mips64 #undef mips64el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) CPU=mips64el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) CPU=mips64 #else CPU= #endif #endif EOF eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; or32:Linux:*:*) echo or32-unknown-linux-gnu exit ;; ppc:Linux:*:*) echo powerpc-unknown-linux-gnu exit ;; ppc64:Linux:*:*) echo powerpc64-unknown-linux-gnu exit ;; alpha:Linux:*:*) case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in EV5) UNAME_MACHINE=alphaev5 ;; EV56) UNAME_MACHINE=alphaev56 ;; PCA56) UNAME_MACHINE=alphapca56 ;; PCA57) UNAME_MACHINE=alphapca56 ;; EV6) UNAME_MACHINE=alphaev6 ;; EV67) UNAME_MACHINE=alphaev67 ;; EV68*) UNAME_MACHINE=alphaev68 ;; esac objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in PA7*) echo hppa1.1-unknown-linux-gnu ;; PA8*) echo hppa2.0-unknown-linux-gnu ;; *) echo hppa-unknown-linux-gnu ;; esac exit ;; parisc64:Linux:*:* | hppa64:Linux:*:*) echo hppa64-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; x86_64:Linux:*:*) echo x86_64-unknown-linux-gnu exit ;; i*86:Linux:*:*) # The BFD linker knows what the default object file format is, so # first see if it will tell us. cd to the root directory to prevent # problems with other programs or directories called `ld' in the path. # Set LC_ALL=C to ensure ld outputs messages in English. ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ | sed -ne '/supported targets:/!d s/[ ][ ]*/ /g s/.*supported targets: *// s/ .*// p'` case "$ld_supported_targets" in elf32-i386) TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" ;; a.out-i386-linux) echo "${UNAME_MACHINE}-pc-linux-gnuaout" exit ;; coff-i386) echo "${UNAME_MACHINE}-pc-linux-gnucoff" exit ;; "") # Either a pre-BFD a.out linker (linux-gnuoldld) or # one that does not give us useful --help. echo "${UNAME_MACHINE}-pc-linux-gnuoldld" exit ;; esac # Determine whether the default compiler is a.out or elf eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include #ifdef __ELF__ # ifdef __GLIBC__ # if __GLIBC__ >= 2 LIBC=gnu # else LIBC=gnulibc1 # endif # else LIBC=gnulibc1 # endif #else #ifdef __INTEL_COMPILER LIBC=gnu #else LIBC=gnuaout #endif #endif #ifdef __dietlibc__ LIBC=dietlibc #endif EOF eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=` test x"${LIBC}" != x && { echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit } test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both # sysname and nodename. echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) # Unixware is an offshoot of SVR4, but it has its own version # number series starting with 2... # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) # If we were able to find `uname', then EMX Unix compatibility # is probably installed. echo ${UNAME_MACHINE}-pc-os2-emx exit ;; i*86:XTS-300:*:STOP) echo ${UNAME_MACHINE}-unknown-stop exit ;; i*86:atheos:*:*) echo ${UNAME_MACHINE}-unknown-atheos exit ;; i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) echo ${UNAME_MACHINE}-pc-msdosdjgpp exit ;; i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} else echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} fi exit ;; i*86:*:5:[678]*) # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; *Pent*|*Celeron) UNAME_MACHINE=i686 ;; esac echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} exit ;; i*86:*:3.2:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ && UNAME_MACHINE=i686 (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ && UNAME_MACHINE=i686 echo ${UNAME_MACHINE}-pc-sco$UNAME_REL else echo ${UNAME_MACHINE}-pc-sysv32 fi exit ;; pc:*:*:*) # Left here for compatibility: # uname -m prints for DJGPP always 'pc', but it prints nothing about # the processor, so we play safe by assuming i386. echo i386-pc-msdosdjgpp exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; paragon:*:*:*) echo i860-intel-osf1 exit ;; i860:*:4.*:*) # i860-SVR4 if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 fi exit ;; mini*:CTIX:SYS*5:*) # "miniframe" echo m68010-convergent-sysv exit ;; mc68k:UNIX:SYSTEM5:3.51m) echo m68k-convergent-sysv exit ;; M680?0:D-NIX:5.3:*) echo m68k-diab-dnix exit ;; M68*:*:R3V[5678]*:*) test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) OS_REL='' test -r /etc/.relid \ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; mc68030:UNIX_System_V:4.*:*) echo m68k-atari-sysv4 exit ;; TSUNAMI:LynxOS:2.*:*) echo sparc-unknown-lynxos${UNAME_RELEASE} exit ;; rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) echo mips-dde-sysv${UNAME_RELEASE} exit ;; RM*:ReliantUNIX-*:*:*) echo mips-sni-sysv4 exit ;; RM*:SINIX-*:*:*) echo mips-sni-sysv4 exit ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` echo ${UNAME_MACHINE}-sni-sysv4 else echo ns32k-sni-sysv fi exit ;; PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort # says echo i586-unisys-sysv4 exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes . # How about differentiating between stratus architectures? -djm echo hppa1.1-stratus-sysv4 exit ;; *:*:*:FTX*) # From seanf@swdc.stratus.com. echo i860-stratus-sysv4 exit ;; i*86:VOS:*:*) # From Paul.Green@stratus.com. echo ${UNAME_MACHINE}-stratus-vos exit ;; *:VOS:*:*) # From Paul.Green@stratus.com. echo hppa1.1-stratus-vos exit ;; mc68*:A/UX:*:*) echo m68k-apple-aux${UNAME_RELEASE} exit ;; news*:NEWS-OS:6*:*) echo mips-sony-newsos6 exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then echo mips-nec-sysv${UNAME_RELEASE} else echo mips-unknown-sysv${UNAME_RELEASE} fi exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. echo powerpc-apple-beos exit ;; BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; SX-5:SUPER-UX:*:*) echo sx5-nec-superux${UNAME_RELEASE} exit ;; SX-6:SUPER-UX:*:*) echo sx6-nec-superux${UNAME_RELEASE} exit ;; Power*:Rhapsody:*:*) echo powerpc-apple-rhapsody${UNAME_RELEASE} exit ;; *:Rhapsody:*:*) echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} exit ;; *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in *86) UNAME_PROCESSOR=i686 ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} exit ;; *:procnto*:*:* | *:QNX:[0123456789]*:*) UNAME_PROCESSOR=`uname -p` if test "$UNAME_PROCESSOR" = "x86"; then UNAME_PROCESSOR=i386 UNAME_MACHINE=pc fi echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} exit ;; *:QNX:*:4*) echo i386-pc-qnx exit ;; NSE-?:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) echo nsr-tandem-nsk${UNAME_RELEASE} exit ;; *:NonStop-UX:*:*) echo mips-compaq-nonstopux exit ;; BS2000:POSIX*:*:*) echo bs2000-siemens-sysv exit ;; DS/*:UNIX_System_V:*:*) echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} exit ;; *:Plan9:*:*) # "uname -m" is not consistent, so use $cputype instead. 386 # is converted to i386 for consistency with other x86 # operating systems. if test "$cputype" = "386"; then UNAME_MACHINE=i386 else UNAME_MACHINE="$cputype" fi echo ${UNAME_MACHINE}-unknown-plan9 exit ;; *:TOPS-10:*:*) echo pdp10-unknown-tops10 exit ;; *:TENEX:*:*) echo pdp10-unknown-tenex exit ;; KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) echo pdp10-dec-tops20 exit ;; XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) echo pdp10-xkl-tops20 exit ;; *:TOPS-20:*:*) echo pdp10-unknown-tops20 exit ;; *:ITS:*:*) echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; V*) echo vax-dec-vms ; exit ;; esac ;; *:XENIX:*:SysV) echo i386-pc-xenix exit ;; i*86:skyos:*:*) echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' exit ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 eval $set_cc_for_build cat >$dummy.c < # include #endif main () { #if defined (sony) #if defined (MIPSEB) /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, I don't know.... */ printf ("mips-sony-bsd\n"); exit (0); #else #include printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 "4" #else "" #endif ); exit (0); #endif #endif #if defined (__arm) && defined (__acorn) && defined (__unix) printf ("arm-acorn-riscix\n"); exit (0); #endif #if defined (hp300) && !defined (hpux) printf ("m68k-hp-bsd\n"); exit (0); #endif #if defined (NeXT) #if !defined (__ARCHITECTURE__) #define __ARCHITECTURE__ "m68k" #endif int version; version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; if (version < 4) printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); else printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); exit (0); #endif #if defined (MULTIMAX) || defined (n16) #if defined (UMAXV) printf ("ns32k-encore-sysv\n"); exit (0); #else #if defined (CMU) printf ("ns32k-encore-mach\n"); exit (0); #else printf ("ns32k-encore-bsd\n"); exit (0); #endif #endif #endif #if defined (__386BSD__) printf ("i386-pc-bsd\n"); exit (0); #endif #if defined (sequent) #if defined (i386) printf ("i386-sequent-dynix\n"); exit (0); #endif #if defined (ns32000) printf ("ns32k-sequent-dynix\n"); exit (0); #endif #endif #if defined (_SEQUENT_) struct utsname un; uname(&un); if (strncmp(un.version, "V2", 2) == 0) { printf ("i386-sequent-ptx2\n"); exit (0); } if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ printf ("i386-sequent-ptx1\n"); exit (0); } printf ("i386-sequent-ptx\n"); exit (0); #endif #if defined (vax) # if !defined (ultrix) # include # if defined (BSD) # if BSD == 43 printf ("vax-dec-bsd4.3\n"); exit (0); # else # if BSD == 199006 printf ("vax-dec-bsd4.3reno\n"); exit (0); # else printf ("vax-dec-bsd\n"); exit (0); # endif # endif # else printf ("vax-dec-bsd\n"); exit (0); # endif # else printf ("vax-dec-ultrix\n"); exit (0); # endif #endif #if defined (alliant) && defined (i860) printf ("i860-alliant-bsd\n"); exit (0); #endif exit (1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } # Apollos put the system type in the environment. test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } # Convex versions that predate uname can use getsysinfo(1) if [ -x /usr/convex/getsysinfo ] then case `getsysinfo -f cpu_type` in c1*) echo c1-convex-bsd exit ;; c2*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; c34*) echo c34-convex-bsd exit ;; c38*) echo c38-convex-bsd exit ;; c4*) echo c4-convex-bsd exit ;; esac fi cat >&2 < in order to provide the needed information to handle your system. config.guess timestamp = $timestamp uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` /bin/uname -X = `(/bin/uname -X) 2>/dev/null` hostinfo = `(hostinfo) 2>/dev/null` /bin/universe = `(/bin/universe) 2>/dev/null` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` /bin/arch = `(/bin/arch) 2>/dev/null` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` UNAME_MACHINE = ${UNAME_MACHINE} UNAME_RELEASE = ${UNAME_RELEASE} UNAME_SYSTEM = ${UNAME_SYSTEM} UNAME_VERSION = ${UNAME_VERSION} EOF exit 1 # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: hugs98-plus-Sep2006/config.sub0000755006511100651110000007577710331137252014772 0ustar rossross#! /bin/sh # Configuration validation subroutine script. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. timestamp='2005-07-08' # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software # can handle that machine. It does not imply ALL GNU software can. # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA # 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Please send patches to . Submit a context # diff and a properly formatted ChangeLog entry. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. # Each package is responsible for reporting which valid configurations # it does not support. The user should be able to distinguish # a failure to support a valid configuration from a meaningless # configuration. # The goal of this file is to map all the various variations of a given # machine specification into a single specification in the form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM # or in some cases, the newer four-part form: # CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM # It is wrong to echo any other type of specification. me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] CPU-MFR-OPSYS $0 [OPTION] ALIAS Canonicalize a configuration name. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to ." version="\ GNU config.sub ($timestamp) Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" exit 1 ;; *local*) # First pass through any local machine types. echo $1 exit ;; * ) break ;; esac done case $# in 0) echo "$me: missing argument$help" >&2 exit 1;; 1) ;; *) echo "$me: too many arguments$help" >&2 exit 1;; esac # Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in nto-qnx* | linux-gnu* | linux-dietlibc | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | \ kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] then os=`echo $1 | sed 's/.*-/-/'` else os=; fi ;; esac ### Let's recognize common machines as not being operating systems so ### that things like config.sub decstation-3100 work. We also ### recognize some manufacturers as not being operating systems, so we ### can provide default operating systems below. case $os in -sun*os*) # Prevent following clause from handling this invalid input. ;; -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ -apple | -axis | -knuth | -cray) os= basic_machine=$1 ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 ;; -scout) ;; -wrs) os=-vxworks basic_machine=$1 ;; -chorusos*) os=-chorusos basic_machine=$1 ;; -chorusrdb) os=-chorusrdb basic_machine=$1 ;; -hiux*) os=-hiuxwe2 ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco4) os=-sco3.2v4 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2.[4-9]*) os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2v[4-9]*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -udk*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -isc) os=-isc2.2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -clix*) basic_machine=clipper-intergraph ;; -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -lynx*) os=-lynxos ;; -ptx*) basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` ;; -windowsnt*) os=`echo $os | sed -e 's/windowsnt/winnt/'` ;; -psos*) os=-psos ;; -mint | -mint[0-9]*) basic_machine=m68k-atari os=-mint ;; esac # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ | m32r | m32rle | m68000 | m68k | m88k | maxq | mcore \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ | mips64vr | mips64vrel \ | mips64orion | mips64orionel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ | mipsisa64 | mipsisa64el \ | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ | ms1 \ | msp430 \ | ns16k | ns32k \ | or32 \ | pdp10 | pdp11 | pj | pjl \ | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ | pyramid \ | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b \ | strongarm \ | tahoe | thumb | tic4x | tic80 | tron \ | v850 | v850e \ | we32k \ | x86 | xscale | xscalee[bl] | xstormy16 | xtensa \ | z8k) basic_machine=$basic_machine-unknown ;; m32c) basic_machine=$basic_machine-unknown ;; m6811 | m68hc11 | m6812 | m68hc12) # Motorola 68HC11/12. basic_machine=$basic_machine-unknown os=-none ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. i*86 | x86_64) basic_machine=$basic_machine-pc ;; # Object if more than one company name word. *-*-*) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* \ | bfin-* | bs2000-* \ | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ | m88110-* | m88k-* | maxq-* | mcore-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ | mips64vr-* | mips64vrel-* \ | mips64orion-* | mips64orionel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ | mipsisa64-* | mipsisa64el-* \ | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | ms1-* \ | msp430-* \ | none-* | np1-* | ns16k-* | ns32k-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ | pyramid-* \ | romp-* | rs6000-* \ | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc86x-* | sparclet-* \ | sparclite-* \ | sparcv8-* | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \ | tahoe-* | thumb-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ | tron-* \ | v850-* | v850e-* | vax-* \ | we32k-* \ | x86-* | x86_64-* | xps100-* | xscale-* | xscalee[bl]-* \ | xstormy16-* | xtensa-* \ | ymp-* \ | z8k-*) ;; m32c-*) ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. 386bsd) basic_machine=i386-unknown os=-bsd ;; 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) basic_machine=m68000-att ;; 3b*) basic_machine=we32k-att ;; a29khif) basic_machine=a29k-amd os=-udi ;; abacus) basic_machine=abacus-unknown ;; adobe68k) basic_machine=m68010-adobe os=-scout ;; alliant | fx80) basic_machine=fx80-alliant ;; altos | altos3068) basic_machine=m68k-altos ;; am29k) basic_machine=a29k-none os=-bsd ;; amd64) basic_machine=x86_64-pc ;; amd64-*) basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; amdahl) basic_machine=580-amdahl os=-sysv ;; amiga | amiga-*) basic_machine=m68k-unknown ;; amigaos | amigados) basic_machine=m68k-unknown os=-amigaos ;; amigaunix | amix) basic_machine=m68k-unknown os=-sysv4 ;; apollo68) basic_machine=m68k-apollo os=-sysv ;; apollo68bsd) basic_machine=m68k-apollo os=-bsd ;; aux) basic_machine=m68k-apple os=-aux ;; balance) basic_machine=ns32k-sequent os=-dynix ;; c90) basic_machine=c90-cray os=-unicos ;; convex-c1) basic_machine=c1-convex os=-bsd ;; convex-c2) basic_machine=c2-convex os=-bsd ;; convex-c32) basic_machine=c32-convex os=-bsd ;; convex-c34) basic_machine=c34-convex os=-bsd ;; convex-c38) basic_machine=c38-convex os=-bsd ;; cray | j90) basic_machine=j90-cray os=-unicos ;; craynv) basic_machine=craynv-cray os=-unicosmp ;; cr16c) basic_machine=cr16c-unknown os=-elf ;; crds | unos) basic_machine=m68k-crds ;; crisv32 | crisv32-* | etraxfs*) basic_machine=crisv32-axis ;; cris | cris-* | etrax*) basic_machine=cris-axis ;; crx) basic_machine=crx-unknown os=-elf ;; da30 | da30-*) basic_machine=m68k-da30 ;; decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) basic_machine=mips-dec ;; decsystem10* | dec10*) basic_machine=pdp10-dec os=-tops10 ;; decsystem20* | dec20*) basic_machine=pdp10-dec os=-tops20 ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) basic_machine=m68k-motorola ;; delta88) basic_machine=m88k-motorola os=-sysv3 ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx ;; dpx2* | dpx2*-bull) basic_machine=m68k-bull os=-sysv3 ;; ebmon29k) basic_machine=a29k-amd os=-ebmon ;; elxsi) basic_machine=elxsi-elxsi os=-bsd ;; encore | umax | mmax) basic_machine=ns32k-encore ;; es1800 | OSE68k | ose68k | ose | OSE) basic_machine=m68k-ericsson os=-ose ;; fx2800) basic_machine=i860-alliant ;; genix) basic_machine=ns32k-ns ;; gmicro) basic_machine=tron-gmicro os=-sysv ;; go32) basic_machine=i386-pc os=-go32 ;; h3050r* | hiux*) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; h8300hms) basic_machine=h8300-hitachi os=-hms ;; h8300xray) basic_machine=h8300-hitachi os=-xray ;; h8500hms) basic_machine=h8500-hitachi os=-hms ;; harris) basic_machine=m88k-harris os=-sysv3 ;; hp300-*) basic_machine=m68k-hp ;; hp300bsd) basic_machine=m68k-hp os=-bsd ;; hp300hpux) basic_machine=m68k-hp os=-hpux ;; hp3k9[0-9][0-9] | hp9[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k2[0-9][0-9] | hp9k31[0-9]) basic_machine=m68000-hp ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp ;; hp9k6[0-9][0-9] | hp6[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k7[0-79][0-9] | hp7[0-79][0-9]) basic_machine=hppa1.1-hp ;; hp9k78[0-9] | hp78[0-9]) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[0-9][13679] | hp8[0-9][13679]) basic_machine=hppa1.1-hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) basic_machine=hppa1.0-hp ;; hppa-next) os=-nextstep3 ;; hppaosf) basic_machine=hppa1.1-hp os=-osf ;; hppro) basic_machine=hppa1.1-hp os=-proelf ;; i370-ibm* | ibm*) basic_machine=i370-ibm ;; # I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 ;; i*86v4*) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv4 ;; i*86v) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv ;; i*86sol2) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-solaris2 ;; i386mach) basic_machine=i386-mach os=-mach ;; i386-vsta | vsta) basic_machine=i386-unknown os=-vsta ;; iris | iris4d) basic_machine=mips-sgi case $os in -irix*) ;; *) os=-irix4 ;; esac ;; isi68 | isi) basic_machine=m68k-isi os=-sysv ;; m88k-omron*) basic_machine=m88k-omron ;; magnum | m3230) basic_machine=mips-mips os=-sysv ;; merlin) basic_machine=ns32k-utek os=-sysv ;; mingw32) basic_machine=i386-pc os=-mingw32 ;; miniframe) basic_machine=m68000-convergent ;; *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) basic_machine=m68k-atari os=-mint ;; mips3*-*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` ;; mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; monitor) basic_machine=m68k-rom68k os=-coff ;; morphos) basic_machine=powerpc-unknown os=-morphos ;; msdos) basic_machine=i386-pc os=-msdos ;; mvs) basic_machine=i370-ibm os=-mvs ;; ncr3000) basic_machine=i486-ncr os=-sysv4 ;; netbsd386) basic_machine=i386-unknown os=-netbsd ;; netwinder) basic_machine=armv4l-rebel os=-linux ;; news | news700 | news800 | news900) basic_machine=m68k-sony os=-newsos ;; news1000) basic_machine=m68030-sony os=-newsos ;; news-3600 | risc-news) basic_machine=mips-sony os=-newsos ;; necv70) basic_machine=v70-nec os=-sysv ;; next | m*-next ) basic_machine=m68k-next case $os in -nextstep* ) ;; -ns2*) os=-nextstep2 ;; *) os=-nextstep3 ;; esac ;; nh3000) basic_machine=m68k-harris os=-cxux ;; nh[45]000) basic_machine=m88k-harris os=-cxux ;; nindy960) basic_machine=i960-intel os=-nindy ;; mon960) basic_machine=i960-intel os=-mon960 ;; nonstopux) basic_machine=mips-compaq os=-nonstopux ;; np1) basic_machine=np1-gould ;; nsr-tandem) basic_machine=nsr-tandem ;; op50n-* | op60c-*) basic_machine=hppa1.1-oki os=-proelf ;; openrisc | openrisc-*) basic_machine=or32-unknown ;; os400) basic_machine=powerpc-ibm os=-os400 ;; OSE68000 | ose68000) basic_machine=m68000-ericsson os=-ose ;; os68k) basic_machine=m68k-none os=-os68k ;; pa-hitachi) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; paragon) basic_machine=i860-intel os=-osf ;; pbd) basic_machine=sparc-tti ;; pbb) basic_machine=m68k-tti ;; pc532 | pc532-*) basic_machine=ns32k-pc532 ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; pentiumpro | p6 | 6x86 | athlon | athlon_*) basic_machine=i686-pc ;; pentiumii | pentium2 | pentiumiii | pentium3) basic_machine=i686-pc ;; pentium4) basic_machine=i786-pc ;; pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumpro-* | p6-* | 6x86-* | athlon-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentium4-*) basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pn) basic_machine=pn-gould ;; power) basic_machine=power-ibm ;; ppc) basic_machine=powerpc-unknown ;; ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown ;; ppcle-* | powerpclittle-*) basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64) basic_machine=powerpc64-unknown ;; ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64le | powerpc64little | ppc64-le | powerpc64-little) basic_machine=powerpc64le-unknown ;; ppc64le-* | powerpc64little-*) basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ps2) basic_machine=i386-ibm ;; pw32) basic_machine=i586-unknown os=-pw32 ;; rom68k) basic_machine=m68k-rom68k os=-coff ;; rm[46]00) basic_machine=mips-siemens ;; rtpc | rtpc-*) basic_machine=romp-ibm ;; s390 | s390-*) basic_machine=s390-ibm ;; s390x | s390x-*) basic_machine=s390x-ibm ;; sa29200) basic_machine=a29k-amd os=-udi ;; sb1) basic_machine=mipsisa64sb1-unknown ;; sb1el) basic_machine=mipsisa64sb1el-unknown ;; sei) basic_machine=mips-sei os=-seiux ;; sequent) basic_machine=i386-sequent ;; sh) basic_machine=sh-hitachi os=-hms ;; sh64) basic_machine=sh64-unknown ;; sparclite-wrs | simso-wrs) basic_machine=sparclite-wrs os=-vxworks ;; sps7) basic_machine=m68k-bull os=-sysv2 ;; spur) basic_machine=spur-unknown ;; st2000) basic_machine=m68k-tandem ;; stratus) basic_machine=i860-stratus os=-sysv4 ;; sun2) basic_machine=m68000-sun ;; sun2os3) basic_machine=m68000-sun os=-sunos3 ;; sun2os4) basic_machine=m68000-sun os=-sunos4 ;; sun3os3) basic_machine=m68k-sun os=-sunos3 ;; sun3os4) basic_machine=m68k-sun os=-sunos4 ;; sun4os3) basic_machine=sparc-sun os=-sunos3 ;; sun4os4) basic_machine=sparc-sun os=-sunos4 ;; sun4sol2) basic_machine=sparc-sun os=-solaris2 ;; sun3 | sun3-*) basic_machine=m68k-sun ;; sun4) basic_machine=sparc-sun ;; sun386 | sun386i | roadrunner) basic_machine=i386-sun ;; sv1) basic_machine=sv1-cray os=-unicos ;; symmetry) basic_machine=i386-sequent os=-dynix ;; t3e) basic_machine=alphaev5-cray os=-unicos ;; t90) basic_machine=t90-cray os=-unicos ;; tic54x | c54x*) basic_machine=tic54x-unknown os=-coff ;; tic55x | c55x*) basic_machine=tic55x-unknown os=-coff ;; tic6x | c6x*) basic_machine=tic6x-unknown os=-coff ;; tx39) basic_machine=mipstx39-unknown ;; tx39el) basic_machine=mipstx39el-unknown ;; toad1) basic_machine=pdp10-xkl os=-tops20 ;; tower | tower-32) basic_machine=m68k-ncr ;; tpf) basic_machine=s390x-ibm os=-tpf ;; udi29k) basic_machine=a29k-amd os=-udi ;; ultra3) basic_machine=a29k-nyu os=-sym1 ;; v810 | necv810) basic_machine=v810-nec os=-none ;; vaxv) basic_machine=vax-dec os=-sysv ;; vms) basic_machine=vax-dec os=-vms ;; vpp*|vx|vx-*) basic_machine=f301-fujitsu ;; vxworks960) basic_machine=i960-wrs os=-vxworks ;; vxworks68) basic_machine=m68k-wrs os=-vxworks ;; vxworks29k) basic_machine=a29k-wrs os=-vxworks ;; w65*) basic_machine=w65-wdc os=-none ;; w89k-*) basic_machine=hppa1.1-winbond os=-proelf ;; xbox) basic_machine=i686-pc os=-mingw32 ;; xps | xps100) basic_machine=xps100-honeywell ;; ymp) basic_machine=ymp-cray os=-unicos ;; z8k-*-coff) basic_machine=z8k-unknown os=-sim ;; none) basic_machine=none-none os=-none ;; # Here we handle the default manufacturer of certain CPU types. It is in # some cases the only manufacturer, in others, it is the most popular. w89k) basic_machine=hppa1.1-winbond ;; op50n) basic_machine=hppa1.1-oki ;; op60c) basic_machine=hppa1.1-oki ;; romp) basic_machine=romp-ibm ;; mmix) basic_machine=mmix-knuth ;; rs6000) basic_machine=rs6000-ibm ;; vax) basic_machine=vax-dec ;; pdp10) # there are many clones, so DEC is not a safe bet basic_machine=pdp10-unknown ;; pdp11) basic_machine=pdp11-dec ;; we32k) basic_machine=we32k-att ;; sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b) basic_machine=sparc-sun ;; cydra) basic_machine=cydra-cydrome ;; orion) basic_machine=orion-highlevel ;; orion105) basic_machine=clipper-highlevel ;; mac | mpw | mac-mpw) basic_machine=m68k-apple ;; pmac | pmac-mpw) basic_machine=powerpc-apple ;; *-unknown) # Make sure to match an already-canonicalized machine name. ;; *) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; esac # Here we canonicalize certain aliases for manufacturers. case $basic_machine in *-digital*) basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` ;; *-commodore*) basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` ;; *) ;; esac # Decode manufacturer-specific aliases for certain operating systems. if [ x"$os" != x"" ] then case $os in # First match some system type aliases # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; -solaris) os=-solaris2 ;; -svr4*) os=-sysv4 ;; -unixware*) os=-sysv4.2uw ;; -gnu/linux*) os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` ;; # First accept the basic system types. # The portable systems comes first. # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ | -aos* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* | -openbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ | -chorusos* | -chorusrdb* \ | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ | -mingw32* | -linux-gnu* | -linux-uclibc* | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ | -skyos* | -haiku*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) case $basic_machine in x86-* | i*86-*) ;; *) os=-nto$os ;; esac ;; -nto-qnx*) ;; -nto*) os=`echo $os | sed -e 's|nto|nto-qnx|'` ;; -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) ;; -mac*) os=`echo $os | sed -e 's|mac|macos|'` ;; -linux-dietlibc) os=-linux-dietlibc ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; -sunos5*) os=`echo $os | sed -e 's|sunos5|solaris2|'` ;; -sunos6*) os=`echo $os | sed -e 's|sunos6|solaris3|'` ;; -opened*) os=-openedition ;; -os400*) os=-os400 ;; -wince*) os=-wince ;; -osfrose*) os=-osfrose ;; -osf*) os=-osf ;; -utek*) os=-bsd ;; -dynix*) os=-bsd ;; -acis*) os=-aos ;; -atheos*) os=-atheos ;; -syllable*) os=-syllable ;; -386bsd) os=-bsd ;; -ctix* | -uts*) os=-sysv ;; -nova*) os=-rtmk-nova ;; -ns2 ) os=-nextstep2 ;; -nsk*) os=-nsk ;; # Preserve the version number of sinix5. -sinix5.*) os=`echo $os | sed -e 's|sinix|sysv|'` ;; -sinix*) os=-sysv4 ;; -tpf*) os=-tpf ;; -triton*) os=-sysv3 ;; -oss*) os=-sysv3 ;; -svr4) os=-sysv4 ;; -svr3) os=-sysv3 ;; -sysvr4) os=-sysv4 ;; # This must come after -sysvr4. -sysv*) ;; -ose*) os=-ose ;; -es1800*) os=-ose ;; -xenix) os=-xenix ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) os=-mint ;; -aros*) os=-aros ;; -kaos*) os=-kaos ;; -zvmoe) os=-zvmoe ;; -none) ;; *) # Get rid of the `-' at the beginning of $os. os=`echo $os | sed 's/[^-]*-//'` echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 exit 1 ;; esac else # Here we handle the default operating systems that come with various machines. # The value should be what the vendor currently ships out the door with their # machine or put another way, the most popular os provided with the machine. # Note that if you're going to try to match "-MANUFACTURER" here (say, # "-sun"), then you have to tell the case statement up towards the top # that MANUFACTURER isn't an operating system. Otherwise, code above # will signal an error saying that MANUFACTURER isn't an operating # system, and we'll never get to this point. case $basic_machine in *-acorn) os=-riscix1.2 ;; arm*-rebel) os=-linux ;; arm*-semi) os=-aout ;; c4x-* | tic4x-*) os=-coff ;; # This must come before the *-dec entry. pdp10-*) os=-tops20 ;; pdp11-*) os=-none ;; *-dec | vax-*) os=-ultrix4.2 ;; m68*-apollo) os=-domain ;; i386-sun) os=-sunos4.0.2 ;; m68000-sun) os=-sunos3 # This also exists in the configure program, but was not the # default. # os=-sunos4 ;; m68*-cisco) os=-aout ;; mips*-cisco) os=-elf ;; mips*-*) os=-elf ;; or32-*) os=-coff ;; *-tti) # must be before sparc entry or we get the wrong os. os=-sysv3 ;; sparc-* | *-sun) os=-sunos4.1.1 ;; *-be) os=-beos ;; *-haiku) os=-haiku ;; *-ibm) os=-aix ;; *-knuth) os=-mmixware ;; *-wec) os=-proelf ;; *-winbond) os=-proelf ;; *-oki) os=-proelf ;; *-hp) os=-hpux ;; *-hitachi) os=-hiux ;; i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) os=-sysv ;; *-cbm) os=-amigaos ;; *-dg) os=-dgux ;; *-dolphin) os=-sysv3 ;; m68k-ccur) os=-rtu ;; m88k-omron*) os=-luna ;; *-next ) os=-nextstep ;; *-sequent) os=-ptx ;; *-crds) os=-unos ;; *-ns) os=-genix ;; i370-*) os=-mvs ;; *-next) os=-nextstep3 ;; *-gould) os=-sysv ;; *-highlevel) os=-bsd ;; *-encore) os=-bsd ;; *-sgi) os=-irix ;; *-siemens) os=-sysv4 ;; *-masscomp) os=-rtu ;; f30[01]-fujitsu | f700-fujitsu) os=-uxpv ;; *-rom68k) os=-coff ;; *-*bug) os=-coff ;; *-apple) os=-macos ;; *-atari*) os=-mint ;; *) os=-none ;; esac fi # Here we handle the case where we know the os, and the CPU type, but not the # manufacturer. We pick the logical manufacturer. vendor=unknown case $basic_machine in *-unknown) case $os in -riscix*) vendor=acorn ;; -sunos*) vendor=sun ;; -aix*) vendor=ibm ;; -beos*) vendor=be ;; -hpux*) vendor=hp ;; -mpeix*) vendor=hp ;; -hiux*) vendor=hitachi ;; -unos*) vendor=crds ;; -dgux*) vendor=dg ;; -luna*) vendor=omron ;; -genix*) vendor=ns ;; -mvs* | -opened*) vendor=ibm ;; -os400*) vendor=ibm ;; -ptx*) vendor=sequent ;; -tpf*) vendor=ibm ;; -vxsim* | -vxworks* | -windiss*) vendor=wrs ;; -aux*) vendor=apple ;; -hms*) vendor=hitachi ;; -mpw* | -macos*) vendor=apple ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) vendor=atari ;; -vos*) vendor=stratus ;; esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` ;; esac echo $basic_machine$os exit # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: hugs98-plus-Sep2006/configure.ac0000644006511100651110000007270210426134734015265 0ustar rossrossdnl-------------------------------------------------------------------- dnl dnl Hugs98 interpreter configure script template. dnl Process this file with autoreconf to produce a configure script. dnl dnl-------------------------------------------------------------------- AC_INIT([Hugs98], [1.0], [hugs-bugs@haskell.org], [hugs98]) AC_CONFIG_SRCDIR([src/hugs.c]) dnl We need 2.50 for AC_HELP_STRING. AC_PREREQ([2.50]) AC_CONFIG_SUBDIRS([libraries]) AC_CONFIG_HEADER(src/config.h src/options.h) AH_TOP([/* platform-specific defines */ #include "platform.h"]) dnl-------------------------------------------------------------------- dnl Choose host(/target/build) platform dnl-------------------------------------------------------------------- dnl Guess host/target/build platform(s) if necessary. AC_CANONICAL_TARGET dnl ** GHC does further canonicalization BuildPlatform=`./fp-platform $build` HostPlatform=`./fp-platform $host` TargetPlatform=`./fp-platform $target` AC_SUBST([HostPlatform]) if test x"$HostPlatform" != x"$BuildPlatform" ; then AC_MSG_ERROR([Hugs98 does not yet support differing build/host (i.e., cross-compiling)]) fi fp_get_cpu='s/-.*//' fp_get_os='s/^[[^-]]*-[[^-]]*-\([[^-]]*\).*/\1/' build_cpu=`echo $BuildPlatform | sed "$fp_get_cpu"` build_os=`echo $BuildPlatform | sed "$fp_get_os"` host_cpu=`echo $HostPlatform | sed "$fp_get_cpu"` host_os=`echo $HostPlatform | sed "$fp_get_os"` target_cpu=`echo $TargetPlatform | sed "$fp_get_cpu"` target_os=`echo $TargetPlatform | sed "$fp_get_os"` # We don't use AS_TR_CPP here, because it changes case too. fp_tr_cpp="sed s/[[^_a-zA-Z0-9]]/_/g" AC_SUBST([BuildPlatform_CPP], [`echo $BuildPlatform | $fp_tr_cpp`]) AC_SUBST([HostPlatform_CPP], [`echo $HostPlatform | $fp_tr_cpp`]) AC_SUBST([TargetPlatform_CPP], [`echo $TargetPlatform | $fp_tr_cpp`]) AC_SUBST([BuildArch_CPP], [`echo $build_cpu | $fp_tr_cpp`]) AC_SUBST([HostArch_CPP], [`echo $host_cpu | $fp_tr_cpp`]) AC_SUBST([TargetArch_CPP], [`echo $target_cpu | $fp_tr_cpp`]) AC_SUBST([BuildOS_CPP], [`echo $build_os | $fp_tr_cpp`]) AC_SUBST([HostOS_CPP], [`echo $host_os | $fp_tr_cpp`]) AC_SUBST([TargetOS_CPP], [`echo $target_os | $fp_tr_cpp`]) dnl-------------------------------------------------------------------- dnl dnl Check Configuration options dnl dnl-------------------------------------------------------------------- AC_ARG_ENABLE(path-canonicalization, [AC_HELP_STRING([--enable-path-canonicalization], [enable canonicalization of filenames])], [if test "$enableval" = yes; then AC_DEFINE([PATH_CANONICALIZATION], [1], [Define to 1 if you want filenames to be converted to normal form by: (a) replacing relative pathnames with absolute pathnames and eliminating .. and . where possible. (b) converting to lower case (only in case-insensitive filesystems)]) fi]) AC_ARG_ENABLE(timer, [AC_HELP_STRING([--enable-timer], [enable evaluation timing (for benchmarking Hugs)])]) AC_ARG_ENABLE(profiling, [AC_HELP_STRING([--enable-profiling], [enable heap profiler])], [if test "$enableval" = yes; then AC_DEFINE([PROFILING], [1], [Define to 1 if heap profiling should be used.]) fi]) AC_ARG_ENABLE(stack-dumps, [AC_HELP_STRING([--enable-stack-dumps], [enable stack dump on stack overflow])], [if test "$enableval" = yes; then AC_DEFINE([GIMME_STACK_DUMPS], [1], [If you get really desperate to understand why your Hugs programs keep crashing or running out of stack, you might like to set this flag and recompile Hugs. When you hit a stack error, it will print out a list of all the objects currently under evaluation. The information isn't perfect and can be pretty hard to understand but it's better than a poke in the eye with a blunt stick. This is a very experimental feature!]) fi]) AC_ARG_WITH(nmake, [AC_HELP_STRING([--with-nmake], [produce a Makefile compatible with nmake])], [if test "$withval" = yes; then RM="del";CP="copy"; fi]) AC_ARG_ENABLE(large-banner, [AC_HELP_STRING([--disable-large-banner], [disable multiline startup banner])], [if test "$enableval" = no; then AC_DEFINE([SMALL_BANNER], [1], [Define to 1 if you want the small startup banner.]) fi]) AC_ARG_WITH(gui, [AC_HELP_STRING([--with-gui], [build Hugs for Windows GUI (Borland C++ only)])]) AC_ARG_ENABLE(internal-prims, [AC_HELP_STRING([--enable-internal-prims], [experimental primitives to access Hugs's innards])], [if test "$enableval" = yes; then AC_DEFINE([INTERNAL_PRIMS], [1], [Define to 1 if you want to use the primitives which let you examine Hugs internals.]) AC_DEFINE([BYTECODE_PRIMS], [1], [Define to 1 if you want to use the primitives which let you examine Hugs bytecodes (requires INTERNAL_PRIMS).]) fi]) AC_ARG_ENABLE(debug, [AC_HELP_STRING([--enable-debug], [include C debugging information (for debugging Hugs)])], [if test "$enableval" = yes; then AC_DEFINE([DEBUG_CODE], [1], [Define to 1 if debugging generated bytecodes or the bytecode interpreter.]) AC_DEFINE([DEBUG_PRINTER], [1], [Define if you want to use a low-level printer from within a debugger.]) fi]) AC_ARG_ENABLE(tag-checks, [AC_HELP_STRING([--enable-tag-checks], [runtime tag checking (for debugging Hugs)])], [if test "$enableval" = yes; then AC_DEFINE([CHECK_TAGS], [1], [Define to 1 if you want to perform runtime tag-checks as an internal consistency check. This makes Hugs run very slowly - but is very effective at detecting and locating subtle bugs.]) fi]) AC_ARG_ENABLE(lint, [AC_HELP_STRING([--enable-lint], [enable "lint" flags (for debugging Hugs)])]) AC_ARG_ENABLE(only98, [AC_HELP_STRING([--enable-only98], [build Hugs to understand Haskell 98 only])], [if test "$enableval" = yes; then AC_DEFINE([HASKELL_98_ONLY], [1], [Define to 1 to omit Hugs extensions]) fi]) AC_ARG_WITH(pthreads, [AC_HELP_STRING([--with-pthreads], [build Hugs using POSIX threads C library])], [if test "$withval" = yes; then # needed with pthreads AC_DEFINE([DONT_PANIC], [1], [In a plain Hugs system, most signals (SIGBUS, SIGTERM, etc) indicate some kind of error in Hugs - or maybe a stack overflow. Rather than just crash, Hugs catches these errors and returns to the main loop. It does this by calling a function "panic" which longjmp's back to the main loop. If you're developing a foreign library, this may not be the right behaviour - it's better if Hugs leaves them for your debugger to catch rather than trapping them and "panicking".]) fi]) AC_ARG_ENABLE(ffi, [AC_HELP_STRING([--enable-ffi], [include modules that use the FFI [default=autodetect]])], , [enable_ffi=autodetect]) AC_ARG_ENABLE(char-encoding, [AC_HELP_STRING([--enable-char-encoding], [encode all character I/O using the byte encoding determined by the locale in effect at that time. To require that the UTF-8 encoding is always used, give the --enable-char-encoding=utf8 option. [default=autodetect]])], , [enable_char_encoding=autodetect]) dnl-------------------------------------------------------------------- dnl dnl Check for programs dnl dnl-------------------------------------------------------------------- dnl ToDo: if we have YACC, insert parser.c: parser.y in Makefile AC_PROG_YACC dnl To implement the Haskell layout rule of inserting an implicit close dnl brace if it would be legal where an illegal token is encountered, dnl parser.y does some error recovery trickery that is incompatible dnl with byacc. if test x"`basename ${YACC}`" = x"byacc"; then AC_MSG_ERROR([Found 'byacc', but the Hugs98 parser is incompatible with it. You need to install 'bison' and re-run the configure script.]) fi : ${CFLAGS=-g} OPTFLAGS="-O2" AC_PROG_CC AC_PROG_GCC_TRADITIONAL if test "$with_pthreads" = yes; then ACX_PTHREAD CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LIBS="$PTHREAD_LIBS $LIBS" CC="$PTHREAD_CC" fi dnl The following patch avoids the outburst of (benign) error messages during dnl compilation of machine.c under MacOS X/Darwin, as well as some linker dnl warnings caused by the default two-level namespace introduced in version 10.1 dnl case $HostPlatform in *-*-darwin*) CFLAGS="$CFLAGS -no-cpp-precomp" LDFLAGS="$LDFLAGS -flat_namespace" ;; # As suggested by James B. White III (Trey) (for # AIX 4.3.3 & XL C 5.0.2 at least, may need to tweak the pattern match # below some to avoid upsetting other AIX versions). *-*-aix*) optcflags="-qalloca" CFLAGS_save="$CFLAGS" CFLAGS="$CFLAGS $optcflags" AC_MSG_CHECKING([whether $CC accepts $optcflags]) AC_LANG_C AC_TRY_LINK([],[int main(){return(0);}],[optok=yes],[optok=no]) if test "$optok" = "yes"; then # lump the recognition of -qalloca together with -qmaxmem=-1 and -bmaxdata.. CFLAGS="$CFLAGS_save $optcflags" LDFLAGS="$LDFLAGS -bmaxdata:0x70000000"; OPTFLAGS="-O -qmaxmem=-1" AC_MSG_RESULT([yes]) else CFLAGS="$CFLAGS_save" AC_MSG_RESULT([no]) fi ;; esac if test "x$CP" != "xcopy"; then # Only check for RM&CP if they haven't been overridden already (cf. --with-nmake) AC_PATH_PROG(RM,rm) RM="$RM -f" AC_PATH_PROG(CP,cp) fi AC_CHECK_PROG(LD,ld,ld) AC_CHECK_PROGS(PERL,perl) dnl should test for perl5 AC_PROG_MAKE_SET AC_CHECK_PROG(have_hp2ps,hp2ps,1,0) if test "$have_hp2ps" = "1"; then AC_DEFINE(HAVE_HP2PS,1, [Define to 1 if heap profiler can (and should) automatically invoke hp2ps to convert heap profile (in "profile.hp") to PostScript.]) fi AC_CHECK_PROGS(DOCBOOK2HTML,[docbook2html db2html],[]) AC_CHECK_PROGS(DOCBOOK2DVI,[docbook2dvi db2dvi],[]) AC_CHECK_PROGS(DOCBOOK2PDF,[docbook2pdf db2pdf],[]) AC_CHECK_PROGS(DOCBOOK2PS,[docbook2ps db2ps],[]) dnl AC_PROG_INSTALL dnl POSIX systems prefer "diff -C 1"; SunOS4 prefers "diff -c1". AC_PROG_DIFF dnl If you can run configure, you certainly have /bin/sh AC_DEFINE(HAVE_BIN_SH, 1, [Define to 1 if you have /bin/sh]) dnl-------------------------------------------------------------------- dnl dnl Check for libraries dnl dnl-------------------------------------------------------------------- AC_CHECK_LIB([dl], [dlopen]) AC_CHECK_LIB([dld], [shl_load]) AC_CHECK_LIB([m], [atan]) dnl-------------------------------------------------------------------- dnl dnl Check for header files dnl dnl-------------------------------------------------------------------- AC_HEADER_STDC dnl checks for sys/wait.h AC_HEADER_SYS_WAIT AC_CHECK_HEADERS(stdarg.h stdlib.h unistd.h assert.h ctype.h string.h limits.h) AC_CHECK_HEADERS(fcntl.h sgtty.h termio.h termios.h signal.h) AC_CHECK_HEADERS(sys/types.h sys/stat.h sys/ioctl.h sys/resource.h sys/param.h) AC_CHECK_HEADERS(console.h Files.h errno.h stat.h direct.h dirent.h) AC_HEADER_TIME AC_CHECK_HEADERS(time.h sys/time.h sys/timeb.h sys/times.h) dnl One of these two is used to obtain floating point parameters AC_CHECK_HEADERS(float.h values.h) dnl DOS include files AC_CHECK_HEADERS(dos.h conio.h io.h std.h) dnl Windows include files AC_CHECK_HEADERS(windows.h) dnl dynamic loading include files AC_CHECK_HEADERS([dlfcn.h dl.h mach-o/dyld.h], [break]) dnl Checks for: dnl farcalloc (in bcc), dnl valloc (in sunos, solaris, mips, amiga, next, minix, ultrix) AC_CHECK_HEADER(alloc.h,[AC_CHECK_FUNCS(farcalloc)]) if test "${ac_cv_header_stdlib_h+set}" = set || test "${ac_cv_header_unistd_h+set}" = set; then AC_CHECK_FUNCS(valloc) fi dnl-------------------------------------------------------------------- dnl Check for Unicode support, and select encoding dnl-------------------------------------------------------------------- AC_CHECK_HEADERS(locale.h wchar.h) if test "x$host_os" = "xmingw32"; then wchar_t_is_unicode=yes # actually UTF-16 elif test "${ac_cv_header_wchar_h+set}" = set; then AC_MSG_CHECKING([whether wchar_t is ISO 10646 (Unicode)]) AC_COMPILE_IFELSE([AC_LANG_PROGRAM( [[#include #ifndef __STDC_ISO_10646__ # error __STDC_ISO_10646__ not defined #endif]])], [wchar_t_is_unicode=yes], [wchar_t_is_unicode=no]) AC_MSG_RESULT([$wchar_t_is_unicode]) else wchar_t_is_unicode=no fi AC_MSG_CHECKING([for locale-based character encoding]) if test "${ac_cv_header_locale_h+set}" = set && test "$wchar_t_is_unicode" = yes; then locale_char_encoding=yes else locale_char_encoding=no fi AC_MSG_RESULT([$locale_char_encoding]) case $enable_char_encoding in locale|yes) if test "$locale_char_encoding" = yes; then enable_char_encoding=locale else AC_MSG_ERROR([System does not support locale-based encoding of Unicode.]) enable_char_encoding=no fi ;; autodetect) if test "$locale_char_encoding" = yes; then enable_char_encoding=locale fi ;; esac case $enable_char_encoding in locale) AC_DEFINE([CHAR_ENCODING_LOCALE], [1], [Define to 1 to use a Char encoding determined by the locale.]) ;; utf8) AC_DEFINE([CHAR_ENCODING_UTF8], [1], [Define to 1 to use the UTF-8 Char encoding.]) ;; esac AC_SEARCH_LIBS([wcrtomb], [msvcp60]) dnl-------------------------------------------------------------------- dnl dnl Check for library functions. dnl dnl-------------------------------------------------------------------- FP_CHECK_FUNC([WinExec], [@%:@include ], [WinExec("",0)]) FP_CHECK_FUNC([GetModuleFileName], [@%:@include ], [GetModuleFileName((HMODULE)0,(LPTSTR)0,0)]) AC_CHECK_FUNCS([atan], [AC_DEFINE([FLOATS_SUPPORTED], [1], [Define to 1 if floating point arithmetic is supported.])]) AC_CHECK_FUNCS(strcasecmp _stricmp stricmp strcmpi) AC_CHECK_FUNCS(strcmp) AC_CHECK_FUNCS(rindex) AC_CHECK_FUNCS(strrchr) AC_CHECK_FUNCS(realpath _fullpath) AC_CHECK_FUNCS(macsystem) AC_CHECK_FUNCS(fseek ftell) AC_CHECK_FUNCS(vsnprintf _vsnprintf) AC_CHECK_FUNCS(snprintf _snprintf ) AC_CHECK_FUNCS(popen _popen ) AC_CHECK_FUNCS(pclose _pclose ) AC_CHECK_FUNCS(sigprocmask) AC_CHECK_FUNCS(getrusage) AC_CHECK_FUNCS(times) AC_CHECK_FUNCS(isatty) AC_CHECK_FUNCS(fstat) AC_CHECK_FUNCS(select) AC_CHECK_FUNCS(gettimeofday) AC_CHECK_FUNCS(ftime) AC_CHECK_FUNCS(time) AC_CHECK_FUNCS(localtime) AC_CHECK_FUNCS(gmtime) AC_CHECK_FUNCS(mktime) AC_CHECK_FUNCS(dup) dnl-------------------------------------------------------------------- dnl dnl Timezonery dnl dnl-------------------------------------------------------------------- AC_STRUCT_TIMEZONE FP_DECL_TIMEZONE dnl This always fails unless you also #include dnl AC_CHECK_FUNCS(GetModuleFileName GetModuleFileNameA) dnl Windows dnl Probably Macintosh specific dnl AC_CHECK_FUNCS(getfinfo) AC_FUNC_ALLOCA dnl Also sets STACK_DIRECTION dnl Visual C++ doesn't have alloca, does have _alloca macro AC_CACHE_CHECK(for _alloca, ac_cv_c__alloca, [AC_TRY_LINK([ #include int test1() { return _alloca(42); } ], [int i;], ac_cv_c__alloca=yes, ac_cv_c__alloca=no)]) if test "$ac_cv_c__alloca" = yes; then AC_DEFINE(HAVE__ALLOCA, [1], [Define to 1 if you have malloc.h and it defines _alloca - eg for Visual C++.]) fi dnl Library functions used in C interface Foreign/test.ss (non-essential) AC_CHECK_FUNCS(stime poly) dnl-------------------------------------------------------------------- dnl dnl Check for typedefs, structures, and compiler characteristics dnl dnl-------------------------------------------------------------------- AC_C_CONST dnl can we use "const"? AC_C_PROTOTYPES dnl can we use function prototypes? AC_C_JMPBUF_ARRAY dnl can we take address of jmpbufs? AC_C_LABELS_AS_VALUES dnl can we use gcc's "labels as values" feature? dnl AC_C_CHAR_UNSIGNED dnl We can test for signed/unsigned chars - but don't use it AC_STRUCT_TM dnl We don't test for this because Borland C uses a typedef to define size_t dnl but puts it in stdio.h - this conflicts with defining it in config.h dnl AC_TYPE_SIZE_T dnl Foo: assumes we can use prototypes. dnl On BCC, signal handlers have type "int(void)", elsewhere its "void(int)". dnl AC_CACHE_CHECK([type of signal handlers], ac_cv_type_signal_handler, dnl [AC_TRY_COMPILE([#include dnl #include dnl #ifdef signal dnl #undef signal dnl #endif dnl void (*signal (int, void (*)(int)))(int); dnl ], dnl [int i;], dnl ac_cv_type_signal_handler=void_int, dnl ac_cv_type_signal_handler=int_void)]) dnl if test "$ac_cv_type_signal_handler" = void_int; then dnl AC_DEFINE(VOID_INT_SIGNALS) dnl fi dnl On BCC, signal handlers have type "int(void)", elsewhere its "void(int)". AC_TYPE_SIGNAL if test "$ac_cv_type_signal" = void; then AC_DEFINE(VOID_INT_SIGNALS, [1], [Define to 1 if signal handlers have type void (*)(int) (Otherwise, they're assumed to have type int (*)(void).)]) fi dnl-------------------------------------------------------------------- dnl dnl Readline - based on the feature testing that the GHC configure dnl script performs. dnl dnl-------------------------------------------------------------------- AC_CHECK_LIB(ncurses, tputs, HaveLibTermcap=YES; LibTermcap=ncurses, AC_CHECK_LIB(termcap, tputs, HaveLibTermcap=YES; LibTermcap=termcap, AC_CHECK_LIB(curses, tputs, HaveLibTermcap=YES; LibTermcap=curses, HaveLibTermcap=NO))) if test $HaveLibTermcap = YES ; then LIBS="-l$LibTermcap $LIBS" fi AC_CHECK_LIB(readline, readline, HaveLibReadline=YES; LibReadline=readline, AC_CHECK_LIB(editline, readline, HaveLibReadline=YES; LibReadline=editline, HaveLibReadline=NO)) if test $HaveLibTermcap = YES && test $HaveLibReadline = YES && test "$enable_char_encoding" != utf8; then LIBS="-l$LibReadline $LIBS" AC_DEFINE([USE_READLINE], [1], [Define to 1 if a command line editor is available and should be used. There are two choices of command line editor that can be used with Hugs: GNU readline and editline (from comp.sources.misc, vol 31, issue 71)]) fi dnl-------------------------------------------------------------------- dnl dnl Profiling dnl dnl-------------------------------------------------------------------- if test "$enable_profiling" = yes; then if test "$have_hp2ps" = "0"; then AC_MSG_WARN( [hp2ps (heap profile display program) not available (not ignoring --enable-profiling)]) fi fi dnl-------------------------------------------------------------------- dnl dnl Timer dnl dnl-------------------------------------------------------------------- want_timer=no if test "$enable_timer" = yes; then if test "$ac_cv_header_time_h" = yes; then want_timer=yes elif test "$ac_cv_header_sys_time_h" = yes && test "$ac_cv_header_sys_resource_h" = yes; then want_timer=yes else AC_MSG_WARN( [neither nor ( and ) is available (ignoring --enable-timer)]) fi fi if test "$want_timer" = yes; then AC_DEFINE([WANT_TIMER], [1], [Define if you want to time every evaluation. Timing is included in the Hugs distribution for the purpose of benchmarking the Hugs interpreter, comparing its performance across a variety of different machines, and with other systems for similar languages. It would be somewhat foolish to try to use the timings produced in this way for any other purpose. In particular, using timings to compare the performance of different versions of an algorithm is likely to give very misleading results. The current implementation of Hugs as an interpreter, without any significant optimizations, means that there are much more significant overheads than can be accounted for by small variations in Hugs code.]) fi dnl-------------------------------------------------------------------- dnl dnl Debugging flags (assumed to be mutually exclusive with optimisation) dnl dnl-------------------------------------------------------------------- if test "$enable_debug" = yes; then OPTFLAGS="" else CFLAGS="-DNDEBUG=1 $CFLAGS" DEBUGFLAGS="" LDDEBUGFLAGS="" fi AC_SUBST(OPTFLAGS) AC_SUBST(DEBUGFLAGS) AC_SUBST(LDDEBUGFLAGS) dnl-------------------------------------------------------------------- dnl dnl Figure out sizes of objects and decide which version of Hugs to build dnl dnl-------------------------------------------------------------------- AC_CHECK_SIZEOF(int,4) AC_CHECK_SIZEOF(float,4) AC_CHECK_SIZEOF(double,8) AC_CHECK_SIZEOF(int*,4) if test "$ac_cv_sizeof_int" -eq "2"; then AC_DEFINE([SMALL_HUGS], [1], [Define to 1 for 16 bit operation on a limited memory PC.]) else dnl ToDo: test for virtual memory - if you have it, LARGE_HUGS is cool dnl also: provide a way to override default if test 0 -eq 1; then echo "building regular hugs" AC_DEFINE([REGULAR_HUGS], [1], [Define to 1 for 32 bit operation using largish default table sizes.]) else echo "building large hugs" AC_DEFINE([LARGE_HUGS], [1], [Define to 1 for 32 bit operation using larger default table sizes.]) fi fi dnl-------------------------------------------------------------------- dnl dnl Figure out how to do dynamic linking. dnl dnl It is fairly easy to do the dynamic loading: that is fairly well dnl documented and only depends on the host platform. dnl dnl It is also fairly easy to decide whether or not to add a leading dnl underscore to symbol names when doing symbol lookup. dnl dnl But it is bloody hard to figure out how to _build_ a file which can be dnl dynamically loaded because it varies with both the platform and the dnl choice of linker. So we use a rather crude approach: we try every dnl set of linking commands that anyone suggests will work. dnl dnl At the time of writing, I have no idea which of these tests will work. dnl I don't want to add flags that are obviously silly but I want to dnl record what is worth trying. So, for now, I'm going to leave all dnl the untested ones commented out. As platforms are found which need dnl those flags, we'll uncomment each line (and maybe even record which dnl platforms those are). dnl dnl-------------------------------------------------------------------- dnl Try the MS Visual C flags HUGS_TRY_DYNLINK([/LD]) HUGS_TRY_DYNLINK([/LD /ML /nologo]) dnl Try the win32 way dnl gcc-mingw, gcc-cygwin don't want to be given -fPIC, dnl but this test fouls up gcc-linux on some architectures. case "$host_os" in mingw32|cygwin32) HUGS_TRY_DYNLINK([-shared]) ;; esac dnl Try the gcc flags HUGS_TRY_DYNLINK([-shared -fPIC]) dnl Try the MacOS X flags HUGS_TRY_DYNLINK([-flat_namespace -bundle -undefined suppress]) dnl Try the MacOS X flags HUGS_TRY_DYNLINK([-bundle]) dnl Try the MacOS X flags dnl HUGS_TRY_DYNLINK([-bundle -lc]) dnl Try the gcc flags dnl HUGS_TRY_DYNLINK([-shared -nostdlib]) dnl Some other gcc flags HUGS_TRY_DYNLINK(-r) dnl Some other gcc flags dnl HUGS_TRY_DYNLINK(-rdynamic) dnl Try the SunOS flags dnl HUGS_TRY_DYNLINK(-G) dnl Try the HPUX flags dnl HUGS_TRY_DYNLINK([-Aa +z]) AC_DEFINE_UNQUOTED(MKDLL_CMD, ["${CC-cc} $CFLAGS $CPPFLAGS $LDFLAGS $ac_cv_dll_flags"], [C compiler invocation use to build a dynamically loadable library. Typical value: "gcc -shared". Must evaluate to a literal C string.]) if test "$ac_cv_leading_underscore" = "yes"; then AC_DEFINE(LEADING_UNDERSCORE, [1], [Define to 1 if your C compiler inserts underscores before symbol names.]) fi dynamic_loading=no FP_CHECK_FUNC([LoadLibrary], [@%:@include ], [LoadLibrary("")], [dynamic_loading=yes], [AC_CHECK_FUNCS([dlopen shl_load NSCreateObjectFileImageFromFile], [dynamic_loading=yes; break])]) if test x"$enable_ffi" = xautodetect; then enable_ffi="$dynamic_loading" fi if test x"$enable_ffi" = xyes; then FFI_LIBRARIES=ffi_libraries else FFI_LIBRARIES= fi AC_SUBST([FFI_LIBRARIES]) dnl-------------------------------------------------------------------- dnl dnl Lint flags dnl (placed after DLL stuff, so not included in MKDLL_CMD) dnl dnl-------------------------------------------------------------------- dnl These flags are gcc specific. dnl They detecting many common programming errors but can get fooled dnl by perfectly safe code so we usually turn them off. dnl We don't use -Wstrict-prototypes because some definitions in dnl storage.h tickle this flag and can't be rewritten the 'correct' way dnl without generating a warning/error from Microsoft's compiler. GCC_LINT_FLAGS='-Wall -Wpointer-arith -Wbad-function-cast -Wcast-qual -Wmissing-prototypes -Wmissing-declarations -Wnested-externs -Wno-parentheses' if test "$enable_lint" = yes; then case "$CC" in gcc|gcc-*|*/gcc|*/gcc-*) LINT_FLAGS="$GCC_LINT_FLAGS" ;; # bcc32) # LINT_FLAGS="$BCC32_LINT_FLAGS" ;; *) AC_MSG_WARN(dnl [lint flags only defined for gcc (at present) (ignoring --enable-lint)]) ;; esac CFLAGS="$CFLAGS $LINT_FLAGS" dnl AC_MSG_WARN(using lint $CFLAGS) fi dnl-------------------------------------------------------------------- dnl dnl Architecture specific substitutions dnl The default values can be overridden by environment variables when dnl the configure script is called dnl dnl-------------------------------------------------------------------- dnl When building a Windows script, $host_os will be set to "mingw32". if test "x$host_os" = "xmingw32"; then BAT=.bat DLL=".dll" DLL_ENDING="-dll" DEV_NULL="nul" hugsdir_deflt='${libdir}/hugs' HUGSPATH=".;{Hugs}\\\\packages\\\\*" HUGSSUFFIXES=".hs;.lhs" MkInstall="src/MkInstal.in" elif test "x$host" = "xdos"; then # Much the same as for Windows BAT=.bat DLL=".dll" DLL_ENDING="-dll" DEV_NULL="nul" hugsdir_deflt='${libdir}\\hugs' HUGSPATH=".;{Hugs}\\\\packages\\\\*" HUGSSUFFIXES=".hs;.lhs" MkInstall="src/MkNull.in" else BAT= hugsdir_deflt='${libdir}/hugs' HUGSPATH=".:{Home}/lib/hugs/packages/*:/usr/local/lib/hugs/packages/*:{Hugs}/packages/*" HUGSSUFFIXES=".hs:.lhs" MkInstall="src/MkInstal.in" fi AC_SUBST(HUGSPATH) AC_SUBST(HUGSSUFFIXES) AC_DEFINE_UNQUOTED([HUGSSUFFIXES], ["$HUGSSUFFIXES"], [The list of suffixes used by Haskell source files, separated either by colons (Unix) or semicolons (Macintosh, Windows, DOS). This value can be overridden using the -S flag.]) if test "x$prefix" = xNONE; then prefix="$ac_default_prefix" fi AC_SUBST_DEF(hugsdir,"$hugsdir_deflt") test "x$prefix" = xNONE && prefix=$ac_default_prefix test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' dnl This is the only way I could find to perform the substitutions dnl in hugsdir. Sigh. HUGSDIR=`sh -c "prefix=$prefix; exec_prefix=$exec_prefix; libdir=$libdir; datadir=$datadir; echo $hugsdir"` AC_DEFINE_UNQUOTED([HUGSDIR], ["$HUGSDIR"], [The directory name which is substituted for the string "{Hugs}" in a path variable. This normally points to where the Hugs libraries are installed - ie so that the file HUGSDIR/packages/base/Prelude.hs exists. Typical values are: "/usr/local/lib/hugs", "/usr/homes/JFHaskell/hugs", "../hugsdir". This value is ignored on Windows and old MacOS versions since it is assumed that the binary is installed in HUGSDIR. This value can be overridden using the environment variable HUGSDIR, and you can always choose _not_ to use the {Hugs} variable.]) AC_SUBST(HUGSDIR) BINDIR=`sh -c "prefix=$prefix; exec_prefix=$exec_prefix; echo $bindir"` AC_SUBST(BINDIR) AC_SUBST_DEF(DLL,".so") AC_SUBST_DEF(DLL_ENDING,"-so") AC_SUBST_DEF(DEV_NULL,"/dev/null") AC_SUBST_DEF(RM,"/bin/rm -f") AC_SUBST_DEF(CP,"/bin/cp") AC_SUBST(BAT) AC_SUBST_FILE(MkInstall) MkDepend=src/MkDepend.in AC_SUBST_FILE(MkDepend) AC_DEFINE_UNQUOTED([HUGSPATH], ["${HUGSPATH}"], [Define this as the default setting of HUGSPATH. Value may contain string "{Hugs}" (for which we will substitute the value of HUGSDIR) and should be either colon-separated (Unix) or semicolon-separated (Macintosh, Windows, DOS). Escape characters in the path string are interpreted according to normal Haskell conventions. This value can be overridden from the command line by setting the HUGSFLAGS environment variable or by storing an appropriate value for HUGSFLAGS in the registry (Win32 only). In all cases, use a string of the form -P"...".]) dnl-------------------------------------------------------------------- dnl dnl Figure out whether we can build the GUI dnl (done last because -W flags messes everything else up) dnl dnl-------------------------------------------------------------------- HUGS_FOR_WINDOWS=no if test "x$with_gui" = xyes; then if test "x$host_os" = "xmingw32"; then LDFLAGS="$LDFLAGS -W" WOBJECTS="win-text.obj" STRIP="brc32 hugs32.rc hugs.exe -w32" RC_FILES="hugs32.rc" HUGS_FOR_WINDOWS=yes elif test "x$host" = "xdos"; then WOBJECTS="win-text.obj" STRIP="brc hugs16.rc hugs.exe" RC_FILES="hugs16.rc" HUGS_FOR_WINDOWS=yes else AC_MSG_WARN( [not building Hugs GUI because this isn't a DOS machine ]) fi fi if test $HUGS_FOR_WINDOWS = yes; then AC_DEFINE([HUGS_FOR_WINDOWS], [1], [Define to 1 if you want to use the "Hugs for Windows" GUI. (Windows 3.1 and compatibles only)]) fi AC_SUBST_DEF(WOBJECTS,"") AC_SUBST_DEF(RC_FILES,"") AC_SUBST_DEF(STRIP,"") dnl-------------------------------------------------------------------- dnl dnl Generate output files dnl dnl-------------------------------------------------------------------- TESTSCRIPT="" if test -f tests/config.in ; then TESTSCRIPT=tests/config fi MAKEFILES='src/Makefile docs/Makefile docs/users_guide/Makefile demos/Makefile' AC_OUTPUT(MkDefs $MAKEFILES src/platform.h docs/hugs.1 $TESTSCRIPT) echo '' echo '************************************************' echo '*** NOW DO: make ; make install' echo '************************************************' exit 0 dnl End of configure.ac hugs98-plus-Sep2006/fp-platform0000755006511100651110000000143210362036117015137 0ustar rossross#! /bin/sh # canonicalize platform names (approximately as GHC does) for platform do cpu="`echo $platform | sed 's/^\([^-]*\)-\([^-]*\)-\([^-]*\).*/\1/'`" vendor="`echo $platform | sed 's/^\([^-]*\)-\([^-]*\)-\([^-]*\).*/\2/'`" os="`echo $platform | sed 's/^\([^-]*\)-\([^-]*\)-\([^-]*\).*/\3/'`" case "$cpu" in i[3456]86*) cpu=i386 ;; esac case "$os" in aix*) os=aix ;; cygwin*) os=cygwin32 ;; darwin*) os=darwin ;; freebsd2*) os=freebsd2 ;; freebsd*) os=freebsd ;; hpux*) os=hpux ;; irix*) os=irix ;; linuxaout*) os=linuxaout ;; linux*) os=linux ;; mingw32*) os=mingw32 ;; netbsd*) os=netbsd ;; openbsd*) os=openbsd ;; osf[12]*) os=osf1 ;; osf*) os=osf3 ;; solaris2*) os=solaris2 ;; sunos4*) os=sunos4 ;; ultrix*) os=ultrix ;; esac echo "$cpu-$vendor-$os" done hugs98-plus-Sep2006/hugs98.nsi0000644006511100651110000000321710314114734014626 0ustar rossross; First attempt at an NSIS (http://nsis.sourceforge.net/) installer ; script for Hugs 98. !ifndef VERSION !ifdef MAJOR_RELEASE !define /date VERSION "%b%Y" !else !define /date VERSION "%Y%m%d" !endif !endif !define HUGS_KEY "Software\Haskell\Hugs${VERSION}" !define WINHUGS_KEY "Software\Haskell\Hugs\WinHugs${VERSION}" !define UNINSTALL_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\Hugs98" SetCompressor lzma Name "Hugs98" OutFile "hugs98-${VERSION}.exe" InstallDir "$PROGRAMFILES\Hugs98" InstallDirRegKey HKLM "${HUGS_KEY}" "Install_Dir" XPStyle on Page directory Page instfiles UninstPage uninstConfirm UninstPage instfiles Section SetOutPath "$INSTDIR" File "Readme" File "License" File "Credits" File "src\hugs.exe" File "src\ffihugs.exe" File "src\runhugs.exe" File /r /x *.c "hugsdir\libraries" File /r /x *.c "hugsdir\packages" File /r /x *.c "hugsdir\programs" File /r "hugsdir\oldlib" File /r "hugsdir\demos" File /r "hugsdir\include" WriteRegStr HKLM "${HUGS_KEY}" "Install_Dir" "$INSTDIR" WriteRegStr HKLM "${UNINSTALL_KEY}" "DisplayName" "Hugs98" WriteRegStr HKLM "${UNINSTALL_KEY}" "UninstallString" '"$INSTDIR\uninstall.exe"' WriteRegDWORD HKLM "${UNINSTALL_KEY}" "NoModify" 1 WriteRegDWORD HKLM "${UNINSTALL_KEY}" "NoRepair" 1 WriteUninstaller "uninstall.exe" CreateDirectory "$SMPROGRAMS\Hugs98" CreateShortCut "$SMPROGRAMS\Hugs98\Uninstall.lnk" "$INSTDIR\uninstall.exe" CreateShortCut "$SMPROGRAMS\Hugs98\Hugs.lnk" "$INSTDIR\hugs.exe" SectionEnd Section "Uninstall" DeleteRegKey HKLM "${UNINSTALL_KEY}" DeleteRegKey HKLM "${HUGS_KEY}" RMDir /r "$SMPROGRAMS\Hugs98" RMDir /r "$INSTDIR" SectionEnd hugs98-plus-Sep2006/hugs98.spec0000644006511100651110000000506310465157303014776 0ustar rossross# Requires %defines of `name', `version' and `release'. # (`make rpm' takes care of these - you aren't expected to # use this spec directly) Name: %{name} Version: %{version} Release: %{release} License: BSDish Group: Development/Languages/Haskell URL: http://haskell.org/hugs/ Source: %{name}-%{version}.tar.gz Packager: Sven Panne BuildRoot: %{_tmppath}/%{name}-buildroot Provides: haskell Requires: readline Summary: Hugs 98 - A Haskell Interpreter %description Hugs 98 is a functional programming system based on Haskell 98, the de facto standard for non-strict functional programming languages. Hugs 98 provides an almost complete implementation of Haskell 98, including: * Lazy evaluation, higher order functions, and pattern matching. * A wide range of built-in types, from characters to bignums, and lists to functions, with comprehensive facilities for defining new datatypes and type synonyms. * An advanced polymorphic type system with type and constructor class overloading. * All of the features of the Haskell 98 expression and pattern syntax including lambda, case, conditional and let expressions, list comprehensions, do-notation, operator sections, and wildcard, irrefutable and `as' patterns. * An implementation of the Haskell 98 primitives for monadic I/O, with support for simple interactive programs, access to text files, handle-based I/O, and exception handling. * An almost complete implementation of the Haskell module system. Hugs 98 also supports a number of advanced and experimental extensions including multi-parameter classes, extensible records, rank-2 polymorphism, existentials, scoped type variables, and restricted type synonyms. %prep %setup -q %build ./configure --prefix=%{_prefix} --mandir=%{_mandir} ${EXTRA_CONFIGURE_OPTS} make %install rm -rf ${RPM_BUILD_ROOT} make DESTDIR=${RPM_BUILD_ROOT} install_all_but_docs make -C docs DESTDIR=${RPM_BUILD_ROOT} install_man %files %defattr(-,root,root) %doc Credits %doc License %doc Readme %doc docs/ffi-notes.txt %doc docs/libraries-notes.txt %doc docs/machugs-notes.txt %doc docs/server.html %doc docs/server.tex %doc docs/winhugs-notes.txt %doc docs/users_guide/users_guide %{_mandir}/man1/hugs.1.gz %{_prefix}/bin/cpphs-hugs %{_prefix}/bin/ffihugs %{_prefix}/bin/hsc2hs-hugs %{_prefix}/bin/hugs %{_prefix}/bin/runhugs %{_prefix}/lib/hugs/demos %{_prefix}/lib/hugs/include %{_prefix}/lib/hugs/oldlib %{_prefix}/lib/hugs/packages %{_prefix}/lib/hugs/programs %{_prefix}/share/hsc2hs-0.67/template-hsc.h hugs98-plus-Sep2006/install-sh0000755006511100651110000002017410116142055014766 0ustar rossross#!/bin/sh # install - install a program, script, or datafile scriptversion=2003-09-24.23 # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the # following copyright and license. # # Copyright (C) 1994 X Consortium # # 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 # X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN # AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- # TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. # # Except as contained in this notice, the name of the X Consortium shall not # be used in advertising or otherwise to promote the sale, use or other deal- # ings in this Software without prior written authorization from the X Consor- # tium. # # # FSF changes to this file are in the public domain. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. It can only install one file at a time, a restriction # shared with many OS's install programs. # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" transformbasename= transform_arg= instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd= chgrpcmd= stripcmd= rmcmd="$rmprog -f" mvcmd="$mvprog" src= dst= dir_arg= usage="Usage: $0 [OPTION]... SRCFILE DSTFILE or: $0 -d DIR1 DIR2... In the first form, install SRCFILE to DSTFILE, removing SRCFILE by default. In the second, create the directory path DIR. Options: -b=TRANSFORMBASENAME -c copy source (using $cpprog) instead of moving (using $mvprog). -d create directories instead of installing files. -g GROUP $chgrp installed files to GROUP. -m MODE $chmod installed files to MODE. -o USER $chown installed files to USER. -s strip installed files (using $stripprog). -t=TRANSFORM --help display this help and exit. --version display version info and exit. Environment variables override the default commands: CHGRPPROG CHMODPROG CHOWNPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG " while test -n "$1"; do case $1 in -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; -c) instcmd=$cpprog shift continue;; -d) dir_arg=true shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; --help) echo "$usage"; exit 0;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -s) stripcmd=$stripprog shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; --version) echo "$0 $scriptversion"; exit 0;; *) if test -z "$src"; then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if test -z "$src"; then echo "$0: no input file specified." >&2 exit 1 fi # Protect names starting with `-'. case $src in -*) src=./$src ;; esac if test -n "$dir_arg"; then dst=$src src= if test -d "$dst"; then instcmd=: chmodcmd= else instcmd=$mkdirprog fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if test ! -f "$src" && test ! -d "$src"; then echo "$0: $src does not exist." >&2 exit 1 fi if test -z "$dst"; then echo "$0: no destination specified." >&2 exit 1 fi # Protect names starting with `-'. case $dst in -*) dst=./$dst ;; esac # If destination is a directory, append the input filename; won't work # if double slashes aren't ignored. if test -d "$dst"; then dst=$dst/`basename "$src"` fi fi # This sed command emulates the dirname command. dstdir=`echo "$dst" | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # Skip lots of stat calls in the usual case. if test ! -d "$dstdir"; then defaultIFS=' ' IFS="${IFS-$defaultIFS}" oIFS=$IFS # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo "$dstdir" | sed -e 's@/@%@g' -e 's@^%@/@'` IFS=$oIFS pathcomp= while test $# -ne 0 ; do pathcomp=$pathcomp$1 shift test -d "$pathcomp" || $mkdirprog "$pathcomp" pathcomp=$pathcomp/ done fi if test -n "$dir_arg"; then $doit $instcmd "$dst" \ && { test -z "$chowncmd" || $doit $chowncmd "$dst"; } \ && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } \ && { test -z "$stripcmd" || $doit $stripcmd "$dst"; } \ && { test -z "$chmodcmd" || $doit $chmodcmd "$dst"; } else # If we're going to rename the final executable, determine the name now. if test -z "$transformarg"; then dstfile=`basename "$dst"` else dstfile=`basename "$dst" $transformbasename \ | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename. test -z "$dstfile" && dstfile=`basename "$dst"` # Make a couple of temp file names in the proper directory. dsttmp=$dstdir/_inst.$$_ rmtmp=$dstdir/_rm.$$_ # Trap to clean up those temp files at exit. trap 'status=$?; rm -f "$dsttmp" "$rmtmp" && exit $status' 0 trap '(exit $?); exit' 1 2 13 15 # Move or copy the file name to the temp name $doit $instcmd "$src" "$dsttmp" && # and set any options; do chmod last to preserve setuid bits. # # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. # { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } \ && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } \ && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } \ && { test -z "$chmodcmd" || $doit $chmodcmd "$dsttmp"; } && # Now remove or move aside any old file at destination location. We # try this two ways since rm can't unlink itself on some systems and # the destination file might be busy for other reasons. In this case, # the final cleanup might fail but the new file should still install # successfully. { if test -f "$dstdir/$dstfile"; then $doit $rmcmd -f "$dstdir/$dstfile" 2>/dev/null \ || $doit $mvcmd -f "$dstdir/$dstfile" "$rmtmp" 2>/dev/null \ || { echo "$0: cannot unlink or rename $dstdir/$dstfile" >&2 (exit 1); exit } else : fi } && # Now rename the file to the real destination. $doit $mvcmd "$dsttmp" "$dstdir/$dstfile" fi && # The final little trick to "correctly" pass the exit status to the exit trap. { (exit 0); exit } # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-end: "$" # End: hugs98-plus-Sep2006/winmake.bat0000644006511100651110000000405310432110726015104 0ustar rossross@echo off REM First run MSys REM cd to your hugs distribution REM Then type "make" REM After that, run this file REM Requires sed echo REBUILDING EVERYTHING set MyVC="%VS71COMNTOOLS%..\IDE\devenv.com" %MyVC% src\msc\hugs.sln /build release %MyVC% src\winhugs\winhugs.sln /build release %MyVC% src\winhugs\installer\Installer.sln /build release %MyVC% src\winhugs\uninstaller\Uninstaller.sln /build release cd docs call users-guide-windows.bat cd .. echo COPYING EVERYTHING copy src\msc\ReleaseFfihugs\ffihugs.exe hugsdir\ffihugs.exe copy src\msc\ffihugs.bat hugsdir\ffihugs.bat copy src\msc\ReleaseHugs\hugs.exe hugsdir\hugs.exe copy src\msc\ReleaseRunhugs\runhugs.exe hugsdir\runhugs.exe copy src\WinHugs\Release\winhugs.exe hugsdir\winhugs.exe mkdir hugsdir\docs 2> nul copy docs\users_guide_windows\hugs98.chm hugsdir\docs\hugs98.chm copy src\winhugs\uninstaller\Release hugsdir\uninstaller.exe sed s/\n/\r\n/ Readme > hugsdir\readme.txt mkdir release 2> nul wzzip -ex -r -p release\winhugs.zip hugsdir copy /b src\winhugs\installer\Release\installer.exe + release\winhugs.zip release\winhugs.exe echo MAKING MINHUGS mkdir mindir mkdir mindir\docs copy hugsdir\readme.txt mindir\readme.txt copy hugsdir\uninstaller.exe mindir\uninstaller.exe copy hugsdir\winhugs.exe mindir\winhugs.exe copy hugsdir\docs\*.* mindir\docs\*.* mkdir mindir\packages\base mkdir mindir\packages\haskell98 mkdir mindir\packages\hugsbase xcopy /y /s hugsdir\packages\base mindir\packages\base xcopy /y /s hugsdir\packages\haskell98 mindir\packages\haskell98 xcopy /y /s hugsdir\packages\hugsbase mindir\packages\hugsbase REM Remove Foreign del mindir\packages\base\Data\ByteString.* del mindir\packages\base\Data\ByteString\*.* /q rmdir mindir\packages\base\Data\ByteString del mindir\packages\base\System\Posix\*.* /q del mindir\packages\base\System\Process\*.* /q rmdir mindir\packages\base\System\Posix rmdir mindir\packages\base\System\Process wzzip -ex -r -p release\minhugs.zip mindir copy /b src\winhugs\installer\Release\installer.exe + release\minhugs.zip release\minhugs.exe echo DONE hugs98-plus-Sep2006/debian/0000755006511100651110000000000010504340740014202 5ustar rossrosshugs98-plus-Sep2006/debian/hugs.copyright0000644006511100651110000000321010504340734017101 0ustar rossrossThe Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, 1994-2003, All rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/changelog0000644006511100651110000003040110333155205016052 0ustar rossrosshugs98 (98.200503.08-4) unstable; urgency=low * Added buid-depends on gzip (Closes: #336201). -- Isaac Jones Sat, 29 Oct 2005 22:34:02 -0700 hugs98 (98.200503.08-3) unstable; urgency=low * New build-depends, libreadline5 (Closes: #326105, Closes: #326344). * Changed a build-conflicts on byacc to build-depends on bison (Closes: #271124). * Updated README.debian (Closes: #299777). -- Isaac Jones Sat, 3 Sep 2005 12:58:57 -0700 hugs98 (98.200503.08-2) unstable; urgency=low * Bugfixes from: Arjan Oosting * Install menu file in /usr/share/menu. * Add HaXml copyright and license information to debian/copyright and remove the license and copyright files COPYRIGHT, LICENCE-GPL, LICENCE-LGPL of HaXml from the binary package. * Add lintian and linda overrides to suppress warning about extra license file usr/lib/hugs/packages/Cabal/Distribution/License.hs. * Set Standards-Version to 3.6.2. No changes needed. * Fix debian/rules to use --enable-debug when DEB_BUILD_OPTIONS contains noopt not the other way around. * Fix debian/rules to stop stripping binaries when DEB_BUILD_OPTIONS contains nostrip. * Added missing build dependencies on xlibmesa-gl-dev and freeglut3- dev and libxt-dev. -- Isaac Jones Wed, 29 Jun 2005 23:27:54 +0200 hugs98 (98.200503.08-1) unstable; urgency=low * New upstream release -- Isaac Jones Tue, 8 Mar 2005 20:57:39 -0800 hugs98 (98.200502-1) unstable; urgency=low * New upstream release -- Isaac Jones Tue, 1 Mar 2005 13:53:52 -0800 hugs98 (98.200311-4) unstable; urgency=low * Applied patch to use -fPIC to create a shared lib. Will probably close #253002, but I'll wait to see the logs. -- Isaac Jones Mon, 6 Dec 2004 15:42:02 -0800 hugs98 (98.200311-3) unstable; urgency=low * Added watchfile * Changed my email address * Added quoted string to menu item per lintian warning. -- Isaac Jones Sat, 20 Nov 2004 14:33:45 -0800 hugs98 (98.200311-2) unstable; urgency=low * Added build-conflicts for byacc (Closes: #271124) -- Isaac Jones Sun, 12 Sep 2004 13:18:45 -0400 hugs98 (98.200311-1) unstable; urgency=low * New upstream release - More of the hierarchical libraries, including imprecise exceptions and unboxed arrays, giving greater compatibility with GHC. For now, compatibility with the old libraries is provided by stub modules, but users are encouraged to migrate to the new libraries. - The Double type is now double-precision on most architectures. - The -e, -f, -i, -N, -W and -X options are gone, as is the :project command. - Integrated .NET support (on Windows). - The beginnings of a User's Guide (still somewhat incomplete). - Numerous bug fixes since the previous major release in Nov 2002. * Control - Removed depends on hugs-doc - Removed pre-depends on autoconf (where did this come from?) (Closes: #211444) - Added build-depends on docbook-utils - Updated standards-version * Rules - Improvements in the upstream Makefile cause some cleanup - fix for configure line (Closes: #208363) - Changed strip rule for new binaries - Added gzip for new haskell-pkg man page - Removed mkdir of (unused) /usr/share/hugs98 (Closes: #197554) * Misc - added -Wall to CFLAGS to conform to standards version 3.5.7.0 -- Isaac Jones Thu, 27 Nov 2003 00:27:54 -0500 hugs98 (98.200211-3) unstable; urgency=low * libraries/Hugs - Patched Word.hs and Int.hs to include 64 bit numbers (for building on ia64) * src/unix - patched configure.in and aclocal.a4 to fix quoting error and add checking for ia64's detection for building shared libraries (Closes: #191033) -- Isaac Jones Tue, 6 May 2003 19:08:59 -0400 hugs98 (98.200211-2) unstable; urgency=low * debian/rules - Fixed broken manpage symlink install lines (Closes: #190905) * debian/control - Removed spurious build-depends on autoconf * src - removed src/options.h.in~ -- Isaac Jones Sun, 27 Apr 2003 22:58:32 -0400 hugs98 (98.200211-1) unstable; urgency=low * New maintainer. * New upstream version (Closes: #187095) - Fixes signed char issue in reading (Closes: #154274, #162471) * debian/rules: - Implemented latest DEB_BUILD_OPTIONS noopt,nostrip bits. - Cleaned out copied Haskell source files. - Moved (now) arch-specific files from /usr/share/hugs98 to /usr/lib/hugs. - Moved documentation from /usr/lib/hugs/ and /usr/lib/hugs/docs into /usr/share/doc/hugs. * debian/README.Debian: - No longer lies (Closes: #157177) * Sets double precision flag (Closes: #129016) -- Isaac Jones Wed, 29 Jan 2003 20:27:03 -0500 hugs98 (98.200112-2) unstable; urgency=low * Add missing build-depends on autoconf. * Closes: #111773 -- William Lee Irwin III Sun, 14 Jul 2002 16:07:12 -0700 hugs98 (98.200112-1) unstable; urgency=low * Update to Dec2001 * Closes: #139381 (new upstream version) * debian/control: Standards-Version 3.5.6.1 -- William Lee Irwin III Sun, 14 Jul 2002 10:15:39 -0700 hugs98 (98.200109-3) unstable; urgency=low * Closes: #11343 (tries writing to /usr/local) * Closes: #11373 (missing build-depends on autoconf) * nuked the ungzipped manpages -- William Lee Irwin III Sun, 9 Sep 2001 15:34:36 -0700 hugs98 (98.200109-2) unstable; urgency=low * Fixed rules file so the thing actually builds after make clean * Closes: #111265 (tries to install into the root fs during build) * Fixed lintian warnings regarding .comment and .note sections -- William Lee Irwin III Wed, 5 Sep 2001 01:48:38 -0700 hugs98 (98.200109-1) unstable; urgency=low * Updated to Feb2001 version. * Closes: #110703 (New upstream release) -- William Lee Irwin III Tue, 4 Sep 2001 01:31:05 -0700 hugs98 (98.200002-3) unstable; urgency=low * Fixed changelog so the bug would close. * Closes: #43666 (runhugs has no manpage) * Closes: #68186 (ITA hugs by Antti-Juhani Kaijanaho) -- William Lee Irwin III Sat, 13 Jan 2001 13:54:11 -0800 hugs98 (98.200002-2) unstable; urgency=low * Added manpage for runhugs. Closes #43666. * Fixed some compilation errors with the new glibc. * New maintainer. -- William Lee Irwin III Wed, 10 Jan 2001 18:40:59 -0800 hugs98 (98.200002-1) unstable; urgency=low * New upstream release. * Use libreadline4 and libncurses5. -- Antti-Juhani Kaijanaho Sun, 9 Apr 2000 15:02:31 +0300 hugs98 (98.199911-1) unstable; urgency=low * New upstream release * debian/control: Standards-Version 3.1.1 + debian/control: Add a Build-Depends line. + debian/rules: Remove the build-depends check. + debian/check-sourcedeps: Removed. * debian/control [Description]: Edited slightly. * debian/copyright: Updated source download information. * src/Makefile.in: make veryclean not remove configure -- Antti-Juhani Kaijanaho Wed, 17 Nov 1999 22:34:47 +0200 hugs98 (98.199909.0.19991020-1) unstable; urgency=low * New upstream minor bugfix release. Upstream changed the tarball without changing the version. Just great. * debian/rules: No need to make src/unix/configure executable anymore. * debian/control: Standards-Version 3.0.1, required changes already made earlier. -- Antti-Juhani Kaijanaho Wed, 20 Oct 1999 15:15:36 +0300 hugs98 (98.199909-2) unstable; urgency=low * debian/rules: Make src/unix/configure executable before calling it. Closes: #47523. -- Antti-Juhani Kaijanaho Sat, 16 Oct 1999 12:40:32 +0300 hugs98 (98.199909-1) unstable; urgency=low * New upstream release (Hugs 98 / September 1999). + Fixes a segfault reported by Havoc Pennington. Closes: #45546. + New license (BSD-like without advertising clause). * debian/rules (debian/build.stamp): Build with GNU readline support, since the new license allows this. Closes: #46155. * debian/README.Debian: Remove the note about no readline support, instead just state that we have it. * debian/copyright: Update the copyright license information. * debian/check-sourcedeps: New file. * debian/rules: Check build-time dependencies (libreadlineg2-dev). * src/hugs.c: To comply with Debian policy, check VISUAL in addition to EDITOR. * debian/rules: Move docs to /usr/share/doc. * debian/{prerm,postinst}: Implement the /usr/doc transition. -- Antti-Juhani Kaijanaho Thu, 14 Oct 1999 17:55:53 +0300 hugs98 (98.199905-4) unstable; urgency=low (medium for >= 98.199905-2) * debian/postinst: /usr/local subdirs should be group "staff". * debian/postinst: Don't create the /usr/local dirs if upgrading from >> 98.199905-3. * debian/prerm: Don't remove the /usr/local dirs on upgrade * debian/rules: Link from undocumented to runhugs.1.gz, not runhugs.1 -- Antti-Juhani Kaijanaho Sun, 29 Aug 1999 13:50:18 +0300 hugs98 (98.199905-3) unstable; urgency=low * debian/rules: WRT bug#43666, install an undocumented(7) symlink for runhugs(1). -- Antti-Juhani Kaijanaho Sat, 28 Aug 1999 23:57:19 +0300 hugs98 (98.199905-2) unstable; urgency=low * src/unix/acconfig.h: Define DEBIAN. * Ran src/unix/mkconfig so that the earlier EDITOR change can take effect. * debian/rules: Updated to match my latest preferences + factorize the install command into a variable + don't use install_zipped + use stamp files + use target-specific vars and lazy vars to create the directory name variables + don't test for rootness + separate clean target into clean-{build,binary} + remove the package root dir at the start of the binary targets * debian/rules: Install GreenCard.h into /usr/include/hugs * debian/README.Debian: Document the location of GreenCard.h. * debian/README.Debian: Added an extension module policy. * src/unix/configure: Add a new search path which conforms with the extension module policy, conditional to building on a Debian system. * Ran src/unix/mkconfig. * debian/postinst: Added commands to install /usr/local dirs as required. * debian/prerm: Removed the alternatives code as useless. * debian/preinst: Guarded the alternative removing code so that upgrading from 98.199905-1 or later does not cause alternatives being removed. * debian/prerm: Remove the /usr/local dirs as required. * debian/rules: Install debian/prerm. * docs/hugs.1: Updated to Hugs 98 (changes will be sent to upstream). * debian/rules: Install the manual page. -- Antti-Juhani Kaijanaho Sat, 28 Aug 1999 20:27:34 +0300 hugs98 (98.199905-1) unstable; urgency=low * New upstream release: Official Hugs98! * This release supersedes Hugs 1.4: + Rename the binary package to hugs. + Conflict/Replace/Provide hugs98. + Remove alternatives support. + Now install a symlink (run)?hugs98 -> \1hugs to keep the impact on user setups as minimal as possible. * Use -isp with gencontrol. * Suggest hugs-doc. -- Antti-Juhani Kaijanaho Thu, 10 Jun 1999 14:35:25 +0300 hugs98 (990319-2) unstable; urgency=low * Suggest haskell-doc, now that it is available. * Rewrote the description. * Gave credit to gorgo for what he did with hugs before me. * Use /usr/bin/editor as a default if building on a Debian system. * Add a guard to prerm not to remove the alternatives provided when upgrading. * Added the same kind of ease to build a readline version as there is in gorgo's original hugs package. -- Antti-Juhani Kaijanaho Sat, 15 May 1999 15:31:50 +0300 hugs98 (990319-1) unstable; urgency=low * New upstream release. * Conflict with non-alternatives-aware hugs 1.4. * Use alternatives for hugs and runhugs. -- Antti-Juhani Kaijanaho Wed, 28 Apr 1999 15:29:58 +0300 hugs98 (990222-1) unstable; urgency=low * Initial release. -- Antti-Juhani Kaijanaho Tue, 27 Apr 1999 23:15:43 +0300 hugs98-plus-Sep2006/debian/compat0000644006511100651110000000000210333155205015400 0ustar rossross4 hugs98-plus-Sep2006/debian/control.in0000644006511100651110000000164410333155205016217 0ustar rossrossSource: hugs98 Section: interpreters Priority: optional Maintainer: Isaac Jones Standards-Version: 3.6.1 Build-Depends: debhelper (>= 4), autoconf, autotools-dev, bison, libncurses5-dev, libreadline5-dev, libxt-dev, xlibmesa-gl-dev, xlibmesa-glu-dev, freeglut3-dev, libopenal-dev Package: hugs Architecture: any Depends: libhugs-base, libhugs-haskell98, ${shlibs:Depends} Conflicts: hugs98 Provides: hugs98 Replaces: hugs98 Suggests: haskell-mode, haskell-doc, hugs-cabal, cpphs Section: interpreters Priority: optional Description: A Haskell 98 interpreter Hugs is an interpreter for the non-strict, purely functional programming language Haskell. This version of Hugs, Hugs 98, supports nearly all of the Haskell 98 specification, as well as a number of extensions. . The Haskell language is described by documents in the haskell-doc package. Other libraries are documented in the ghc6-doc package. hugs98-plus-Sep2006/debian/hugs.README.Debian0000644006511100651110000000056410333155205017215 0ustar rossrossHugs98 for Debian ----------------- This version of Hugs is compiled with GNU readline support. For information on how to release libraries which work with Hugs, see the Haskell Cabal: http://www.haskell.org/cabal and also the Haskell Policy: http://urchin.earth.li/~ian/haskell-policy/haskell-policy.html/ -- Isaac Jones , Sat Sep 3 13:13:43 2005 hugs98-plus-Sep2006/debian/hugs.doc-base0000644006511100651110000000110210333155205016541 0ustar rossrossDocument: hugs-users-guide Title: Hugs User's Guide Author: The Hugs Team Abstract: Hugs is an interpreter for the non-strict, purely functional programming language Haskell. This version of Hugs, Hugs 98, supports nearly all of the Haskell 98 specification, as well as a number of extensions.
The Haskell language is described by documents in the haskell-doc package. Many Haskell libraries are documented in the ghc6-doc package. Section: interpreters Format: HTML Index: /usr/share/doc/hugs/users_guide/index.html Files: /usr/share/doc/hugs/users_guide/*.html hugs98-plus-Sep2006/debian/hugs.docs0000644006511100651110000000011610333155205016020 0ustar rossrossCredits Readme docs/*.html docs/*.tex docs/*.txt docs/users_guide/users_guide hugs98-plus-Sep2006/debian/hugs.examples0000644006511100651110000000002710333155205016707 0ustar rossrossdemos/*.* demos/prolog hugs98-plus-Sep2006/debian/hugs.install0000644006511100651110000000026210426134734016547 0ustar rossrossusr/bin/cpphs-hugs usr/bin/ffihugs usr/bin/hsc2hs-hugs usr/bin/hugs usr/bin/runhugs usr/lib/hugs/include usr/lib/hugs/oldlib usr/lib/hugs/packages/hugsbase usr/lib/hugs/programs hugs98-plus-Sep2006/debian/hugs.links0000644006511100651110000000015610333155205016214 0ustar rossrossusr/share/man/man1/hugs.1 usr/share/man/man1/runhugs.1 usr/share/man/man1/hugs.1 usr/share/man/man1/ffihugs.1 hugs98-plus-Sep2006/debian/hugs.manpages0000644006511100651110000000001410333155205016660 0ustar rossrossdocs/hugs.1 hugs98-plus-Sep2006/debian/hugs.menu0000644006511100651110000000013710333155205016037 0ustar rossross?package(hugs):needs="text" section="Apps/Programming"\ title="Hugs" command="/usr/bin/hugs" hugs98-plus-Sep2006/debian/hugs.postinst0000644006511100651110000000035110333155205016754 0ustar rossross#! /bin/sh set -e case "$1" in configure) ;; abort-upgrade|abort-remove|abort-deconfigure) ;; *) echo "postinst called with unknown argument \`$1'" >&2 exit 1 ;; esac #DEBHELPER# exit 0 hugs98-plus-Sep2006/debian/hugs.postrm0000644006511100651110000000035210333155205016416 0ustar rossross#! /bin/sh set -e case "$1" in purge|remove|upgrade|failed-upgrade|abort-install|abort-upgrade|disappear) ;; *) echo "postrm called with unknown argument \`$1'" >&2 exit 1 esac #DEBHELPER# exit 0 hugs98-plus-Sep2006/debian/hugs.preinst0000644006511100651110000000074610333155205016565 0ustar rossross#! /bin/sh set -e case "$1" in install|upgrade) ;; abort-upgrade) ;; *) echo "preinst called with unknown argument \`$1'" >&2 exit 1 ;; esac if test "$1" = "upgrade" && dpkg --compare-versions "$2" ge '1.4.199806-4' \ && dpkg --compare-versions "$2" lt '98.199905-1' then update-alternatives --remove hugs /usr/bin/hugs1.4 update-alternatives --remove runhugs /usr/bin/runhugs1.4 fi #DEBHELPER# exit 0 hugs98-plus-Sep2006/debian/hugs.prerm0000644006511100651110000000047010333155205016220 0ustar rossross#! /bin/sh set -e case "$1" in remove|upgrade|deconfigure) ;; failed-upgrade) ;; *) echo "prerm called with unknown argument \`$1'" >&2 exit 1 ;; esac package=hugs # FHS transition if [ -L /usr/doc/$package ]; then rm -f /usr/doc/$package fi #DEBHELPER# exit 0 hugs98-plus-Sep2006/debian/make-control.hs0000644006511100651110000000460310333155205017134 0ustar rossross-- Create Debian entries for library packages bundled with the interpreter. -- This program should be run in the top-level directory, and creates -- -- debian/control -- debian/libhugs-*-bundled.* module Main where import Control.Monad import Data.Char import Distribution.Compat.FilePath import Distribution.Package import Distribution.PackageDescription import Distribution.Version import System.Directory import System.Environment import System.IO main = do copyFile "debian/control.in" "debian/control" args <- getArgs flip mapM_ args $ \ fname -> do pkg <- readPackageDescription fname debPackage fname pkg debPackage :: FilePath -> PackageDescription -> IO () debPackage fname pkg = let virtual_name = debName (pkgName (package pkg)) debian_name = virtual_name ++ "-bundled" showLine s = showString s . showChar '\n' depends = concat [debName name ++ ", " | Dependency name _ <- buildDepends pkg] desc = unlines $ map fmtLine $ lines $ description pkg fmtLine "" = " ." fmtLine s = " " ++ s (pkgDir, _) = splitFileName fname in do appendFile "debian/control" (showLine "" $ showLine ("Package: " ++ debian_name) $ showLine ("Architecture: any") $ showLine ("Depends: hugs, " ++ depends ++ "${shlibs:Depends}") $ showLine ("Section: devel") $ showLine ("Priority: optional") $ showLine ("Provides: " ++ virtual_name) $ showLine ("Conflicts: " ++ virtual_name) $ showLine ("Description: " ++ synopsis pkg) $ showString desc $ showLine (" .") $ showLine (" This is the version bundled with the interpreter.") $ "") writeFile ("debian/" ++ debian_name ++ ".install") $ "usr/lib/hugs/packages/" ++ pkgName (package pkg) ++ "\n" writeFile ("debian/" ++ debian_name ++ ".README.Debian") $ "Version of the " ++ pkgName (package pkg) ++ " library package bundled with Hugs.\n\n" ++ "Documentation for this package can be found in the ghc6-doc package.\n" when (not (null (licenseFile pkg))) $ copyFile (pkgDir `joinFileName` licenseFile pkg) ("debian/" ++ debian_name ++ ".copyright") examples <- doesDirectoryExist (pkgDir `joinFileName` "examples") when examples $ do writeFile ("debian/" ++ debian_name ++ ".examples") $ "debian/tmp/usr/lib/hugs/demos/" ++ pkgName (package pkg) ++ "\n" debName :: String -> String debName name = "libhugs-" ++ map debianize name where debianize c | isUpper c = toLower c | isAlphaNum c = c | otherwise = '-' hugs98-plus-Sep2006/debian/rules0000755006511100651110000000666710362036117015303 0ustar rossross#!/usr/bin/make -f # Modified from /usr/share/doc/debhelper/examples/rules.multi2, # incorporating various Hugs bits by # Antti-Juhani Kaijanaho # William Irwin # Isaac Jones # Sample debian/rules that uses debhelper. # This file is public domain software, originally written by Joey Hess. # # This version is for a multibinary package. It also allows you to build any # of the binary packages independantly, via binary- targets. # Uncomment this to turn on verbose mode. #export DH_VERBOSE=1 # This has to be exported to make some magic below work. export DH_OPTIONS # These are used for cross-compiling and for saving the configure script # from having to guess our platform (since we know it already) DEB_HOST_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_HOST_GNU_TYPE) DEB_BUILD_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_BUILD_GNU_TYPE) ifeq (,$(findstring noopt,$(DEB_BUILD_OPTIONS))) DEBUG_OPT = --enable-debug else DEBUG_OPT = endif CONFIG_OPTS = --prefix=/usr $(DEBUG_OPT) --build=$(DEB_BUILD_GNU_TYPE) build_stamp = debian/build.stamp install_stamp = debian/install.stamp # A file that should be present in a Hugs source tree src_file = src/hugs.c build: $(build_stamp) $(build_stamp): dh_testdir $(src_file) # touch so that patched configure does not trigger autoreconf touch configure.ac aclocal.m4 && touch configure CFLAGS='-Wall -fPIC' $(MAKE) EXTRA_CONFIGURE_OPTS="$(CONFIG_OPTS)" touch $@ clean: dh_testdir $(src_file) dh_testroot # get updated config.sub and config.guess cp -f /usr/share/misc/config.sub /usr/share/misc/config.guess . # force rerun of autoreconf (for the source distribution) $(RM) configure $(MAKE) configure dh_clean $(install_stamp) $(RM) $(build_stamp) -$(MAKE) distclean install: $(install_stamp) $(install_stamp): DH_OPTIONS= $(install_stamp): $(build_stamp) dh_testdir $(src_file) dh_testroot dh_clean -k dh_installdirs $(MAKE) DESTDIR="`pwd`/debian/tmp" install_all_but_docs $(RM) debian/tmp/usr/lib/hugs/packages/*/LICENSE dh_install --sourcedir=debian/tmp touch $@ # This single target is used to build all the packages, all at once, or # one at a time. So keep in mind: any options passed to commands here will # affect _all_ packages. Anything you want to only affect one package # should be put in another target, such as the install target. binary-common: dh_testdir $(src_file) dh_testroot dh_installchangelogs dh_installdocs dh_installexamples dh_installmenu # dh_installdebconf # dh_installlogrotate # dh_installemacsen # dh_installcatalogs # dh_installpam # dh_installmime # dh_installinit dh_installman # dh_installcron # dh_installinfo # dh_undocumented dh_strip dh_link dh_compress dh_fixperms # dh_perl # dh_python # dh_makeshlibs dh_installdeb dh_shlibdeps dh_gencontrol dh_md5sums dh_builddeb # Build architecture independant packages using the common target. binary-indep: $(install_stamp) # (Uncomment this next line if you have such packages.) # $(MAKE) -f debian/rules DH_OPTIONS=-i binary-common # Build architecture dependant packages using the common target. binary-arch: $(install_stamp) $(MAKE) -f debian/rules DH_OPTIONS=-a binary-common # Any other binary targets build just one binary package at a time. binary-%: $(install_stamp) $(MAKE) -f debian/rules DH_OPTIONS='-p$*' binary-common binary: binary-indep binary-arch .PHONY: build clean install binary binary-indep binary-arch binary-common update-config hugs98-plus-Sep2006/debian/control0000644006511100651110000002610410504340740015610 0ustar rossrossSource: hugs98 Section: interpreters Priority: optional Maintainer: Isaac Jones Standards-Version: 3.6.1 Build-Depends: debhelper (>= 4), autoconf, autotools-dev, bison, libncurses5-dev, libreadline5-dev, libxt-dev, xlibmesa-gl-dev, xlibmesa-glu-dev, freeglut3-dev, libopenal-dev Package: hugs Architecture: any Depends: libhugs-base, libhugs-haskell98, ${shlibs:Depends} Conflicts: hugs98 Provides: hugs98 Replaces: hugs98 Suggests: haskell-mode, haskell-doc, hugs-cabal, cpphs Section: interpreters Priority: optional Description: A Haskell 98 interpreter Hugs is an interpreter for the non-strict, purely functional programming language Haskell. This version of Hugs, Hugs 98, supports nearly all of the Haskell 98 specification, as well as a number of extensions. . The Haskell language is described by documents in the haskell-doc package. Other libraries are documented in the ghc6-doc package. Package: libhugs-alut-bundled Architecture: any Depends: hugs, libhugs-base, libhugs-opengl, libhugs-openal, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-alut Conflicts: libhugs-alut Description: A binding for the OpenAL Utility Toolkit A Haskell binding for the OpenAL Utility Toolkit, which makes managing of OpenAL contexts, loading sounds in various formats and creating waveforms very easy. For more information about the C library on which this binding is based, please see: . . This is the version bundled with the interpreter. Package: libhugs-cabal-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-cabal Conflicts: libhugs-cabal Description: A framework for packaging Haskell software The Haskell Common Architecture for Building Applications and Libraries: a framework defining a common interface for authors to more easily build their Haskell applications in a portable way. . The Haskell Cabal is meant to be a part of a larger infrastructure for distributing, organizing, and cataloging Haskell libraries and tools. . This is the version bundled with the interpreter. Package: libhugs-glut-bundled Architecture: any Depends: hugs, libhugs-base, libhugs-opengl, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-glut Conflicts: libhugs-glut Description: A binding for the OpenGL Utility Toolkit A Haskell binding for the OpenGL Utility Toolkit, a window system independent toolkit for writing OpenGL programs. For more information about the C library on which this binding is based, please see: . . This is the version bundled with the interpreter. Package: libhugs-hgl-bundled Architecture: any Depends: hugs, libhugs-base, libhugs-x11, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-hgl Conflicts: libhugs-hgl Description: A simple graphics library based on X11 or Win32 A simple graphics library, designed to give the programmer access to most interesting parts of the Win32 Graphics Device Interface and X11 library without exposing the programmer to the pain and anguish usually associated with using these interfaces. . The library also includes a module Graphics.SOE providing the interface used in "The Haskell School of Expression", by Paul Hudak, cf . . This is the version bundled with the interpreter. Package: libhugs-hunit-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-hunit Conflicts: libhugs-hunit Description: A unit testing framework for Haskell HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java, see: . . This is the version bundled with the interpreter. Package: libhugs-haxml-bundled Architecture: any Depends: hugs, libhugs-base, libhugs-haskell98, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-haxml Conflicts: libhugs-haxml Description: Utilities for manipulating XML documents Haskell utilities for parsing, filtering, transforming and generating XML documents. . This is the version bundled with the interpreter. Package: libhugs-openal-bundled Architecture: any Depends: hugs, libhugs-base, libhugs-opengl, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-openal Conflicts: libhugs-openal Description: A binding to the OpenAL cross-platform 3D audio API A Haskell binding for the OpenAL cross-platform 3D audio API, appropriate for use with gaming applications and many other types of audio applications. For more information about OpenAL, please see: . . This is the version bundled with the interpreter. Package: libhugs-opengl-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-opengl Conflicts: libhugs-opengl Description: A binding for the OpenGL graphics system A Haskell binding for the OpenGL graphics system (GL, version 1.5) and its accompanying utility library (GLU, version 1.3). OpenGL is the industry's most widely used and supported 2D and 3D graphics application programming interface (API), incorporating a broad set of rendering, texture mapping, special effects, and other powerful visualization functions. For more information about OpenGL, please see: . . This is the version bundled with the interpreter. Package: libhugs-quickcheck-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-quickcheck Conflicts: libhugs-quickcheck Description: Automatic testing of Haskell programs A library for testing Haskell programs automatically. The programmer provides a specification of the program, in the form of properties which functions should satisfy, and QuickCheck then tests that the properties hold in a large number of randomly generated cases. Specifications are expressed in Haskell, using combinators defined in the QuickCheck library. QuickCheck provides combinators to define properties, observe the distribution of test data, and define test data generators. . This is the version bundled with the interpreter. Package: libhugs-x11-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-x11 Conflicts: libhugs-x11 Description: A binding to the X11 graphics library A Haskell binding to the X11 graphics library. . The binding is a direct translation of the C binding; for documentation of these calls, refer to "The Xlib Programming Manual", available online at . . This is the version bundled with the interpreter. Package: libhugs-base-bundled Architecture: any Depends: hugs, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-base Conflicts: libhugs-base Description: Basic libraries This package contains the Prelude and its support libraries, and a large collection of useful libraries ranging from data structures to parsing combinators and debugging utilities. . This is the version bundled with the interpreter. Package: libhugs-fgl-bundled Architecture: any Depends: hugs, libhugs-base, libhugs-mtl, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-fgl Conflicts: libhugs-fgl Description: Martin Erwig's Functional Graph Library . This is the version bundled with the interpreter. Package: libhugs-haskell-src-bundled Architecture: any Depends: hugs, libhugs-base, libhugs-haskell98, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-haskell-src Conflicts: libhugs-haskell-src Description: Manipulating Haskell source code Facilities for manipulating Haskell source code: an abstract syntax, lexer, parser and pretty-printer. . This is the version bundled with the interpreter. Package: libhugs-haskell98-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-haskell98 Conflicts: libhugs-haskell98 Description: Compatibility with Haskell 98 This package provides compatibility with the modules of Haskell 98 and the FFI addendum, by means of wrappers around modules from the base package (which in many cases have additional features). However Prelude, Numeric and Foreign are provided directly by the base package. . This is the version bundled with the interpreter. Package: libhugs-mtl-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-mtl Conflicts: libhugs-mtl Description: Monad transformer library A monad transformer library, inspired by the paper "Functional Programming with Overloading and Higher-Order Polymorphism", by Mark P Jones (), Advanced School of Functional Programming, 1995. . This is the version bundled with the interpreter. Package: libhugs-network-bundled Architecture: any Depends: hugs, libhugs-base, libhugs-parsec, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-network Conflicts: libhugs-network Description: Networking-related facilities . This is the version bundled with the interpreter. Package: libhugs-parsec-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-parsec Conflicts: libhugs-parsec Description: Monadic parser combinators Parsec is designed from scratch as an industrial-strength parser library. It is simple, safe, well documented (on the package homepage), has extensive libraries and good error messages, and is also fast. . This is the version bundled with the interpreter. Package: libhugs-stm-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-stm Conflicts: libhugs-stm Description: Software Transactional Memory A modular composable concurrency abstraction. . This is the version bundled with the interpreter. Package: libhugs-time-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-time Conflicts: libhugs-time Description: time library . This is the version bundled with the interpreter. Package: libhugs-unix-bundled Architecture: any Depends: hugs, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-unix Conflicts: libhugs-unix Description: POSIX functionality This package gives you access to the set of operating system services standardised by POSIX 1003.1b (or the IEEE Portable Operating System Interface for Computing Environments - IEEE Std. 1003.1). . The package is not supported under Windows (except under Cygwin). . This is the version bundled with the interpreter. Package: libhugs-xhtml-bundled Architecture: any Depends: hugs, libhugs-haskell98, libhugs-base, ${shlibs:Depends} Section: devel Priority: optional Provides: libhugs-xhtml Conflicts: libhugs-xhtml Description: A Haskell XHTML combinator library This is a version of the standard Text.Html modified to produce XHTML 1.0. . This is the version bundled with the interpreter. hugs98-plus-Sep2006/debian/libhugs-alut-bundled.install0000644006511100651110000000003310504340735021605 0ustar rossrossusr/lib/hugs/packages/ALUT hugs98-plus-Sep2006/debian/libhugs-alut-bundled.README.Debian0000644006511100651110000000017510504340735022264 0ustar rossrossVersion of the ALUT library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-alut-bundled.copyright0000644006511100651110000000271510504340735022160 0ustar rossrossCopyright (c) 2005, Sven Panne All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-alut-bundled.examples0000644006511100651110000000004310504340735021756 0ustar rossrossdebian/tmp/usr/lib/hugs/demos/ALUT hugs98-plus-Sep2006/debian/libhugs-cabal-bundled.install0000644006511100651110000000003410504340735021703 0ustar rossrossusr/lib/hugs/packages/Cabal hugs98-plus-Sep2006/debian/libhugs-cabal-bundled.README.Debian0000644006511100651110000000017610504340735022362 0ustar rossrossVersion of the Cabal library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-cabal-bundled.copyright0000644006511100651110000000276010504340735022255 0ustar rossrossCopyright Isaac Jones 2003-2005. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-cabal-bundled.examples0000644006511100651110000000004410504340735022054 0ustar rossrossdebian/tmp/usr/lib/hugs/demos/Cabal hugs98-plus-Sep2006/debian/libhugs-glut-bundled.install0000644006511100651110000000003310504340735021613 0ustar rossrossusr/lib/hugs/packages/GLUT hugs98-plus-Sep2006/debian/libhugs-glut-bundled.README.Debian0000644006511100651110000000017510504340735022272 0ustar rossrossVersion of the GLUT library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-glut-bundled.copyright0000644006511100651110000000272210504340735022164 0ustar rossrossCopyright (c) 2002-2005, Sven Panne All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-glut-bundled.examples0000644006511100651110000000004310504340735021764 0ustar rossrossdebian/tmp/usr/lib/hugs/demos/GLUT hugs98-plus-Sep2006/debian/libhugs-hgl-bundled.install0000644006511100651110000000003210504340736021412 0ustar rossrossusr/lib/hugs/packages/HGL hugs98-plus-Sep2006/debian/libhugs-hgl-bundled.README.Debian0000644006511100651110000000017410504340736022071 0ustar rossrossVersion of the HGL library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-hgl-bundled.examples0000644006511100651110000000004210504340736021563 0ustar rossrossdebian/tmp/usr/lib/hugs/demos/HGL hugs98-plus-Sep2006/debian/libhugs-hgl-bundled.copyright0000644006511100651110000000255010504340736021763 0ustar rossrossThe Haskell Graphics Library is Copyright (c) Alastair Reid, 1996-2003, All rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-hunit-bundled.install0000644006511100651110000000003410504340736021771 0ustar rossrossusr/lib/hugs/packages/HUnit hugs98-plus-Sep2006/debian/libhugs-hunit-bundled.README.Debian0000644006511100651110000000017610504340736022450 0ustar rossrossVersion of the HUnit library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-hunit-bundled.copyright0000644006511100651110000000272410504340736022343 0ustar rossrossHUnit is Copyright (c) Dean Herington, 2002, all rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions, and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions, and the following disclaimer in the documentation and/or other materials provided with the distribution. - The names of the copyright holders may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-hunit-bundled.examples0000644006511100651110000000004410504340736022142 0ustar rossrossdebian/tmp/usr/lib/hugs/demos/HUnit hugs98-plus-Sep2006/debian/libhugs-haxml-bundled.install0000644006511100651110000000003410504340736021753 0ustar rossrossusr/lib/hugs/packages/HaXml hugs98-plus-Sep2006/debian/libhugs-haxml-bundled.README.Debian0000644006511100651110000000017610504340736022432 0ustar rossrossVersion of the HaXml library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-haxml-bundled.copyright0000644006511100651110000000273110504340736022323 0ustar rossrossThe HaXml library and tools were written by and are copyright to (c) copyright 1998-2006 Malcolm Wallace and Colin Runciman The library incorporates the module Text.ParserCombinators.HuttonMeijerWallace (c) copyright 1996 Graham Hutton and Erik Meijer with modifications (c) copyright 1998-2000 Malcolm Wallace The HaXml library is licensed under the terms of the GNU Lesser General Public Licence (LGPL), which can be found in the file called LICENCE-LGPL, with the following special exception: ---- As a relaxation of clause 6 of the LGPL, the copyright holders of this library give permission to use, copy, link, modify, and distribute, binary-only object-code versions of an executable linked with the original unmodified Library, without requiring the supply of any mechanism to modify or replace the Library and relink (clauses 6a, 6b, 6c, 6d, 6e), provided that all the other terms of clause 6 are complied with. ---- The HaXml tools Xtract, Validate, DtdToHaskell, and MkOneOf, are licensed under the terms of the GNU General Public Licence (GPL), which can be found in the file called LICENCE-GPL. This library and toolset is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Licences for more details. If these licensing terms are not acceptable to you, please contact me for negotiation. :-) Malcolm.Wallace@cs.york.ac.uk hugs98-plus-Sep2006/debian/libhugs-haxml-bundled.examples0000644006511100651110000000004410504340736022124 0ustar rossrossdebian/tmp/usr/lib/hugs/demos/HaXml hugs98-plus-Sep2006/debian/libhugs-openal-bundled.install0000644006511100651110000000003510504340736022121 0ustar rossrossusr/lib/hugs/packages/OpenAL hugs98-plus-Sep2006/debian/libhugs-openal-bundled.README.Debian0000644006511100651110000000017710504340736022600 0ustar rossrossVersion of the OpenAL library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-openal-bundled.copyright0000644006511100651110000000272210504340736022470 0ustar rossrossCopyright (c) 2003-2005, Sven Panne All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-openal-bundled.examples0000644006511100651110000000004510504340736022272 0ustar rossrossdebian/tmp/usr/lib/hugs/demos/OpenAL hugs98-plus-Sep2006/debian/libhugs-opengl-bundled.install0000644006511100651110000000003510504340736022127 0ustar rossrossusr/lib/hugs/packages/OpenGL hugs98-plus-Sep2006/debian/libhugs-opengl-bundled.README.Debian0000644006511100651110000000017710504340736022606 0ustar rossrossVersion of the OpenGL library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-opengl-bundled.copyright0000644006511100651110000000272210504340736022476 0ustar rossrossCopyright (c) 2002-2005, Sven Panne All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-quickcheck-bundled.install0000644006511100651110000000004110504340736022752 0ustar rossrossusr/lib/hugs/packages/QuickCheck hugs98-plus-Sep2006/debian/libhugs-quickcheck-bundled.README.Debian0000644006511100651110000000020310504340736023422 0ustar rossrossVersion of the QuickCheck library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-quickcheck-bundled.copyright0000644006511100651110000000311310504340736023317 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-x11-bundled.install0000644006511100651110000000003210504340736021251 0ustar rossrossusr/lib/hugs/packages/X11 hugs98-plus-Sep2006/debian/libhugs-x11-bundled.README.Debian0000644006511100651110000000017410504340736021730 0ustar rossrossVersion of the X11 library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-x11-bundled.copyright0000644006511100651110000000253510504340736021625 0ustar rossrossThe HSX11 Library is Copyright (c) Alastair Reid, 1997-2003, All rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-base-bundled.install0000644006511100651110000000003310504340737021554 0ustar rossrossusr/lib/hugs/packages/base hugs98-plus-Sep2006/debian/libhugs-base-bundled.README.Debian0000644006511100651110000000017510504340737022233 0ustar rossrossVersion of the base library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-base-bundled.copyright0000644006511100651110000000745110504340737022131 0ustar rossrossThis library (libraries/base) is derived from code from several sources: * Code from the GHC project which is largely (c) The University of Glasgow, and distributable under a BSD-style license (see below), * Code from the Haskell 98 Report which is (c) Simon Peyton Jones and freely redistributable (but see the full license for restrictions). * Code from the Haskell Foreign Function Interface specification, which is (c) Manuel M. T. Chakravarty and freely redistributable (but see the full license for restrictions). The full text of these licenses is reproduced below. All of the licenses are BSD-style or compatible. ----------------------------------------------------------------------------- The Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------- Code derived from the document "Report on the Programming Language Haskell 98", is distributed under the following license: Copyright (c) 2002 Simon Peyton Jones The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Language. ----------------------------------------------------------------------------- Code derived from the document "The Haskell 98 Foreign Function Interface, An Addendum to the Haskell 98 Report" is distributed under the following license: Copyright (c) 2002 Manuel M. T. Chakravarty The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Foreign Function Interface. ----------------------------------------------------------------------------- hugs98-plus-Sep2006/debian/libhugs-fgl-bundled.install0000644006511100651110000000003210504340737021411 0ustar rossrossusr/lib/hugs/packages/fgl hugs98-plus-Sep2006/debian/libhugs-fgl-bundled.README.Debian0000644006511100651110000000017410504340737022070 0ustar rossrossVersion of the fgl library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-fgl-bundled.copyright0000644006511100651110000000272410504340737021765 0ustar rossrossCopyright (c) 1999-2004, Martin Erwig All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-haskell-src-bundled.install0000644006511100651110000000004210504340737023052 0ustar rossrossusr/lib/hugs/packages/haskell-src hugs98-plus-Sep2006/debian/libhugs-haskell-src-bundled.README.Debian0000644006511100651110000000020410504340737023522 0ustar rossrossVersion of the haskell-src library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-haskell-src-bundled.copyright0000644006511100651110000000311310504340737023416 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-haskell-src-bundled.examples0000644006511100651110000000005210504340737023223 0ustar rossrossdebian/tmp/usr/lib/hugs/demos/haskell-src hugs98-plus-Sep2006/debian/libhugs-haskell98-bundled.install0000644006511100651110000000004010504340737022444 0ustar rossrossusr/lib/hugs/packages/haskell98 hugs98-plus-Sep2006/debian/libhugs-haskell98-bundled.README.Debian0000644006511100651110000000020210504340737023114 0ustar rossrossVersion of the haskell98 library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-haskell98-bundled.copyright0000644006511100651110000000254110504340737023016 0ustar rossrossCode derived from the document "Report on the Programming Language Haskell 98", is distributed under the following license: Copyright (c) 2002 Simon Peyton Jones The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Language. ----------------------------------------------------------------------------- Code derived from the document "The Haskell 98 Foreign Function Interface, An Addendum to the Haskell 98 Report" is distributed under the following license: Copyright (c) 2002 Manuel M. T. Chakravarty The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Foreign Function Interface. hugs98-plus-Sep2006/debian/libhugs-mtl-bundled.install0000644006511100651110000000003210504340737021435 0ustar rossrossusr/lib/hugs/packages/mtl hugs98-plus-Sep2006/debian/libhugs-mtl-bundled.README.Debian0000644006511100651110000000017410504340737022114 0ustar rossrossVersion of the mtl library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-mtl-bundled.copyright0000644006511100651110000000311310504340737022002 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-network-bundled.install0000644006511100651110000000003610504340737022336 0ustar rossrossusr/lib/hugs/packages/network hugs98-plus-Sep2006/debian/libhugs-network-bundled.README.Debian0000644006511100651110000000020010504340737022777 0ustar rossrossVersion of the network library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-network-bundled.copyright0000644006511100651110000000311310504340737022677 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2002, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-parsec-bundled.install0000644006511100651110000000003510504340737022121 0ustar rossrossusr/lib/hugs/packages/parsec hugs98-plus-Sep2006/debian/libhugs-parsec-bundled.README.Debian0000644006511100651110000000017710504340737022600 0ustar rossrossVersion of the parsec library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-parsec-bundled.copyright0000644006511100651110000000235710504340737022474 0ustar rossrossCopyright 1999-2000, Daan Leijen. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. This software is provided by the copyright holders "as is" and any express or implied warranties, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose are disclaimed. In no event shall the copyright holders be liable for any direct, indirect, incidental, special, exemplary, or consequential damages (including, but not limited to, procurement of substitute goods or services; loss of use, data, or profits; or business interruption) however caused and on any theory of liability, whether in contract, strict liability, or tort (including negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage. hugs98-plus-Sep2006/debian/libhugs-parsec-bundled.examples0000644006511100651110000000004510504340737022272 0ustar rossrossdebian/tmp/usr/lib/hugs/demos/parsec hugs98-plus-Sep2006/debian/libhugs-stm-bundled.install0000644006511100651110000000003210504340737021444 0ustar rossrossusr/lib/hugs/packages/stm hugs98-plus-Sep2006/debian/libhugs-stm-bundled.README.Debian0000644006511100651110000000017410504340737022123 0ustar rossrossVersion of the stm library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-stm-bundled.copyright0000644006511100651110000000311310504340737022011 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-time-bundled.install0000644006511100651110000000003310504340737021600 0ustar rossrossusr/lib/hugs/packages/time hugs98-plus-Sep2006/debian/libhugs-time-bundled.README.Debian0000644006511100651110000000017510504340737022257 0ustar rossrossVersion of the time library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-time-bundled.copyright0000644006511100651110000000241110504340737022144 0ustar rossrossTimeLib is Copyright (c) Ashley Yakeley, 2004-2005. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-unix-bundled.install0000644006511100651110000000003310504340740021617 0ustar rossrossusr/lib/hugs/packages/unix hugs98-plus-Sep2006/debian/libhugs-unix-bundled.README.Debian0000644006511100651110000000017510504340740022276 0ustar rossrossVersion of the unix library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-unix-bundled.copyright0000644006511100651110000000311310504340740022163 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/debian/libhugs-xhtml-bundled.install0000644006511100651110000000003410504340740021771 0ustar rossrossusr/lib/hugs/packages/xhtml hugs98-plus-Sep2006/debian/libhugs-xhtml-bundled.README.Debian0000644006511100651110000000017610504340740022450 0ustar rossrossVersion of the xhtml library package bundled with Hugs. Documentation for this package can be found in the ghc6-doc package. hugs98-plus-Sep2006/debian/libhugs-xhtml-bundled.copyright0000644006511100651110000000315110504340740022336 0ustar rossrossCopyright 2001-2005, The University Court of the University of Glasgow, Bjorn Bringert, Andy Gill, Ian Lynagh, Erik Meijer, Sven Panne All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/demos/0000755006511100651110000000000010504340130014060 5ustar rossrosshugs98-plus-Sep2006/demos/prolog/0000755006511100651110000000000010504340130015362 5ustar rossrosshugs98-plus-Sep2006/demos/prolog/AndorraEngine.hs0000644006511100651110000001027206727055600020455 0ustar rossross{- By Donald A. Smith, December 22, 1994, based on Mark Jones' PureEngine. This inference engine implements a variation of the Andorra Principle for logic programming. (See references at the end of this file.) The basic idea is that instead of always selecting the first goal in the current list of goals, select a relatively deterministic goal. For each goal g in the list of goals, calculate the resolvents that would result from selecting g. Then choose a g which results in the lowest number of resolvents. If some g results in 0 resolvents then fail. (This would occur for a goal like: ?- append(A,B,[1,2,3]),equals(1,2).) Prolog would not perform this optimization and would instead search and backtrack wastefully. If some g results in a single resolvent (i.e., only a single clause matches) then that g will get selected; by selecting and resolving g, bindings are propagated sooner, and useless search can be avoided, since these bindings may prune away choices for other clauses. For example: ?- append(A,B,[1,2,3]),B=[]. -} module AndorraEngine( version, prove ) where import Prolog import Subst version = "Andorra Principle Interpreter (select deterministic goals first)" solve :: Database -> Int -> Subst -> [Term] -> [Subst] solve db = slv where slv :: Int -> Subst -> [Term] -> [Subst] slv n s [] = [s] slv n s goals = let allResolvents = resolve_selecting_each_goal goals db n in let (gs,gres) = findMostDeterministic allResolvents in concat [slv (n+1) (u@@s) (map (app u) (tp++gs)) | (u,tp) <- gres] resolve_selecting_each_goal:: [Term] -> Database -> Int -> [([Term],[(Subst,[Term])])] -- For each pair in the list that we return, the first element of the -- pair is the list of unresolved goals; the second element is the list -- of resolvents of the selected goal, where a resolvent is a pair -- consisting of a substitution and a list of new goals. resolve_selecting_each_goal goals db n = [(gs, gResolvents) | (g,gs) <- delete goals, let gResolvents = resolve db g n] -- The unselected goals from above are not passed in. resolve :: Database -> Term -> Int -> [(Subst,[Term])] resolve db g n = [(u,tp) | (tm:-tp)<-renClauses db n g, u<-unify g tm] -- u is not yet applied to tp, since it is possible that g won't be selected. -- Note that unify could be nondeterministic. findMostDeterministic:: [([Term],[(Subst,[Term])])] -> ([Term],[(Subst,[Term])]) findMostDeterministic allResolvents = minF comp allResolvents where comp:: (a,[b]) -> (a,[b]) -> Bool comp (_,gs1) (_,gs2) = (length gs1) < (length gs2) -- It seems to me that there is an opportunity for a clever compiler to -- optimize this code a lot. In particular, there should be no need to -- determine the total length of a goal list if it is known that -- there is a shorter goal list in allResolvents ... ? delete :: [a] -> [(a,[a])] delete l = d l [] where d :: [a] -> [a] -> [(a,[a])] d [g] sofar = [ (g,sofar) ] d (g:gs) sofar = (g,sofar++gs) : (d gs (g:sofar)) minF :: (a -> a -> Bool) -> [a] -> a minF f (h:t) = m h t where -- m :: a -> [a] -> a m sofar [] = sofar m sofar (h:t) = if (f h sofar) then m h t else m sofar t prove :: Database -> [Term] -> [Subst] prove db = solve db 1 nullSubst {- An optimized, incremental version of the above interpreter would use a data representation in which for each goal in "goals" we carry around the list of resolvents. After each resolution step we update the lists. -} {- References Seif Haridi & Per Brand, "Andorra Prolog, an integration of Prolog and committed choice languages" in Proceedings of FGCS 1988, ICOT, Tokyo, 1988. Vitor Santos Costa, David H. D. Warren, and Rong Yang, "Two papers on the Andorra-I engine and preprocessor", in Proceedings of the 8th ICLP. MIT Press, 1991. Steve Gregory and Rong Yang, "Parallel Constraint Solving in Andorra-I", in Proceedings of FGCS'92. ICOT, Tokyo, 1992. Sverker Janson and Seif Haridi, "Programming Paradigms of the Andorra Kernel Language", in Proceedings of ILPS'91. MIT Press, 1991. Torkel Franzen, Seif Haridi, and Sverker Janson, "An Overview of the Andorra Kernel Language", In LNAI (LNCS) 596, Springer-Verlag, 1992. -} hugs98-plus-Sep2006/demos/prolog/CombParse.hs0000644006511100651110000001020406727055600017607 0ustar rossross----------------------------------------------------------------------------- -- Combinator parsing library: -- -- The original Gofer version of this file was based on Richard Bird's -- parselib.orw for Orwell (with a number of extensions). -- -- Not recommended for new work. -- -- Suitable for use with Hugs 98. ----------------------------------------------------------------------------- module CombParse where infixr 6 `pseq` infixl 5 `pam` infixr 4 `orelse` --- Type definition: type Parser a = [Char] -> [(a,[Char])] -- A parser is a function which maps an input stream of characters into -- a list of pairs each containing a parsed value and the remainder of the -- unused input stream. This approach allows us to use the list of -- successes technique to detect errors (i.e. empty list ==> syntax error). -- it also permits the use of ambiguous grammars in which there may be more -- than one valid parse of an input string. --- Primitive parsers: -- pfail is a parser which always fails. -- okay v is a parser which always succeeds without consuming any characters -- from the input string, with parsed value v. -- tok w is a parser which succeeds if the input stream begins with the -- string (token) w, returning the matching string and the following -- input. If the input does not begin with w then the parser fails. -- sat p is a parser which succeeds with value c if c is the first input -- character and c satisfies the predicate p. pfail :: Parser a pfail is = [] okay :: a -> Parser a okay v is = [(v,is)] tok :: [Char] -> Parser [Char] tok w is = [(w, drop n is) | w == take n is] where n = length w sat :: (Char -> Bool) -> Parser Char sat p [] = [] sat p (c:is) = [ (c,is) | p c ] --- Parser combinators: -- p1 `orelse` p2 is a parser which returns all possible parses of the input -- string, first using the parser p1, then using parser p2. -- p1 `seq` p2 is a parser which returns pairs of values (v1,v2) where -- v1 is the result of parsing the input string using p1 and -- v2 is the result of parsing the remaining input using p2. -- p `pam` f is a parser which behaves like the parser p, but returns -- the value f v wherever p would have returned the value v. -- -- just p is a parser which behaves like the parser p, but rejects any -- parses in which the remaining input string is not blank. -- sp p behaves like the parser p, but ignores leading spaces. -- sptok w behaves like the parser tok w, but ignores leading spaces. -- -- many p returns a list of values, each parsed using the parser p. -- many1 p parses a non-empty list of values, each parsed using p. -- listOf p s parses a list of input values using the parser p, with -- separators parsed using the parser s. orelse :: Parser a -> Parser a -> Parser a (p1 `orelse` p2) is = p1 is ++ p2 is pseq :: Parser a -> Parser b -> Parser (a,b) (p1 `pseq` p2) is = [((v1,v2),is2) | (v1,is1) <- p1 is, (v2,is2) <- p2 is1] pam :: Parser a -> (a -> b) -> Parser b (p `pam` f) is = [(f v, is1) | (v,is1) <- p is] just :: Parser a -> Parser a just p is = [ (v,"") | (v,is')<- p is, dropWhile (' '==) is' == "" ] sp :: Parser a -> Parser a sp p = p . dropWhile (' '==) sptok :: [Char] -> Parser [Char] sptok = sp . tok many :: Parser a -> Parser [a] many p = q where q = ((p `pseq` q) `pam` makeList) `orelse` (okay []) many1 :: Parser a -> Parser [a] many1 p = p `pseq` many p `pam` makeList listOf :: Parser a -> Parser b -> Parser [a] listOf p s = p `pseq` many (s `pseq` p) `pam` nonempty `orelse` okay [] where nonempty (x,xs) = x:(map snd xs) --- Internals: makeList :: (a,[a]) -> [a] makeList (x,xs) = x:xs ----------------------------------------------------------------------------- hugs98-plus-Sep2006/demos/prolog/Main.hs0000644006511100651110000000613306727055600016626 0ustar rossross-- Prolog interpreter top level module -- Mark P. Jones November 1990, modified for Gofer 20th July 1991, -- and for Hugs 1.3 June 1996. -- -- Suitable for use with Hugs 98. -- module Main where import CombParse import Prolog import Interact import Subst import StackEngine import List(nub) --- Command structure and parsing: data Command = Fact Clause | Query [Term] | Show | Error | Quit | NoChange command :: Parser Command command = just (sptok "bye" `orelse` sptok "quit") `pam` (\quit->Quit) `orelse` just (okay NoChange) `orelse` just (sptok "??") `pam` (\show->Show) `orelse` just clause `pam` Fact `orelse` just (sptok "?-" `pseq` termlist) `pam` (\(q,ts)->Query ts) `orelse` okay Error --- Main program read-solve-print loop: signOn :: String signOn = "Mini Prolog Version 1.5g (" ++ version ++ ")\n\n" main :: IO () main = do putStr signOn putStr ("Reading " ++ stdlib) clauses <- readLibrary stdlib interpreter clauses readLibrary lib = do is <- readFile lib let parse = map clause (lines is) clauses = [ r | ((r,""):_) <- parse ] reading = ['.'| c <- clauses] ++ "done\n" putStr reading return clauses `catch` \err -> do putStr "...not found\n" return [] stdlib :: String stdlib = "stdlib" interpreter :: [Clause] -> IO () interpreter lib = do is <- getContents putStr (loop startDb is) where startDb = foldl addClause emptyDb lib loop :: Database -> String -> String loop db = readLine "> " (exec db . fst . head . command) exec :: Database -> Command -> String -> String exec db (Fact r) = loop (addClause db r) exec db (Query q) = demonstrate db q exec db Show = writeStr (show db) (loop db) exec db Error = writeStr "I don't understand\n" (loop db) exec db Quit = writeStr "Thank you and goodbye\n" end exec db NoChange = loop db --- Handle printing of solutions etc... solution :: [Id] -> Subst -> [String] solution vs s = [ show (Var i) ++ " = " ++ show v | (i,v) <- [ (i,s i) | i<-vs ], v /= Var i ] demonstrate :: Database -> [Term] -> Interact demonstrate db q = printOut (map (solution vs) (prove db q)) where vs = (nub . concat . map varsIn) q printOut [] = writeStr "no.\n" (loop db) printOut ([]:bs) = writeStr "yes.\n" (loop db) printOut (b:bs) = writeStr (doLines b) (nextReqd bs) doLines = foldr1 (\xs ys -> xs ++ "\n" ++ ys) nextReqd bs = writeStr " " (readChar end (\c-> if c==';' then writeStr ";\n" (printOut bs) else writeStr "\n" (loop db))) --- End of Main.hs hugs98-plus-Sep2006/demos/prolog/Prolog.hs0000644006511100651110000001044107535140615017200 0ustar rossross-- Representation of Prolog Terms, Clauses and Databases -- Mark P. Jones November 1990, modified for Gofer 20th July 1991, -- and for Hugs 1.3 June 1996. -- -- Suitable for use with Hugs 98. -- module Prolog ( Id, Term(..), Clause(..), Database , varsIn, renClauses, addClause, emptyDb, termlist, clause ) where import List import CombParse import Char infix 6 :- --- Prolog Terms: type Id = (Int,String) type Atom = String data Term = Var Id | Struct Atom [Term] data Clause = Term :- [Term] data Database = Db [(Atom,[Clause])] instance Eq Term where Var v == Var w = v==w Struct a ts == Struct b ss = a==b && ts==ss _ == _ = False --- Determine the list of variables in a term: varsIn :: Term -> [Id] varsIn (Var i) = [i] varsIn (Struct i ts) = (nub . concat . map varsIn) ts renameVars :: Int -> Term -> Term renameVars lev (Var (n,s)) = Var (lev,s) renameVars lev (Struct s ts) = Struct s (map (renameVars lev) ts) --- Functions for manipulating databases (as an abstract datatype) emptyDb :: Database emptyDb = Db [] renClauses :: Database -> Int -> Term -> [Clause] renClauses db n (Var _) = [] renClauses db n (Struct a _) = [ r tm:-map r tp | (tm:-tp)<-clausesFor a db ] where r = renameVars n clausesFor :: Atom -> Database -> [Clause] clausesFor a (Db rss) = case dropWhile (\(n,rs) -> n [] ((n,rs):_) -> if a==n then rs else [] addClause :: Database -> Clause -> Database addClause (Db rss) r@(Struct a _ :- _) = Db (update rss) where update [] = [(a,[r])] update (h@(n,rs):rss') | n==a = (n,rs++[r]) : rss' | n u . showChar '\n' . v) [ showWithTerm "\n" rs | (i,rs)<-rss ] --- Local functions for use in defining instances of Show: showWithSep :: Show a => String -> [a] -> ShowS showWithSep s [x] = shows x showWithSep s (x:xs) = shows x . showString s . showWithSep s xs showWithTerm :: Show a => String -> [a] -> ShowS showWithTerm s xs = foldr1 (.) [shows x . showString s | x<-xs] --- String parsing functions for Terms and Clauses: --- Local definitions: letter :: Parser Char letter = sat (\c->isAlpha c || isDigit c || c `elem` ":;+=-*&%$#@?/.~!") variable :: Parser Term variable = sat isUpper `pseq` many letter `pam` makeVar where makeVar (initial,rest) = Var (0,(initial:rest)) struct :: Parser Term struct = many letter `pseq` (sptok "(" `pseq` termlist `pseq` sptok ")" `pam` (\(o,(ts,c))->ts) `orelse` okay []) `pam` (\(name,terms)->Struct name terms) --- Exports: term :: Parser Term term = sp (variable `orelse` struct) termlist :: Parser [Term] termlist = listOf term (sptok ",") clause :: Parser Clause clause = sp struct `pseq` (sptok ":-" `pseq` listOf term (sptok ",") `pam` (\(from,body)->body) `orelse` okay []) `pseq` sptok "." `pam` (\(head,(goals,dot))->head:-goals) --- End of Prolog.hs hugs98-plus-Sep2006/demos/prolog/PureEngine.hs0000644006511100651110000000305106727055600017777 0ustar rossross-- The Pure Prolog inference engine (using explicit prooftrees) -- Mark P. Jones November 1990, modified for Gofer 20th July 1991, -- and for Hugs 1.3 June 1996. -- -- Suitable for use with Hugs 98. -- module PureEngine( version, prove ) where import Prolog import Subst version = "tree based" --- Calculation of solutions: -- Each node in a prooftree corresponds to: -- either: a solution to the current goal, represented by Done s, where s -- is the required substitution -- or: a choice between a number of subtrees ts, each corresponding to a -- proof of a subgoal of the current goal, represented by Choice ts. -- The proof tree corresponding to an unsolvable goal is Choice [] data Prooftree = Done Subst | Choice [Prooftree] -- prooftree uses the rules of Prolog to construct a suitable proof tree for -- a specified goal prooftree :: Database -> Int -> Subst -> [Term] -> Prooftree prooftree db = pt where pt :: Int -> Subst -> [Term] -> Prooftree pt n s [] = Done s pt n s (g:gs) = Choice [ pt (n+1) (u@@s) (map (app u) (tp++gs)) | (tm:-tp)<-renClauses db n g, u<-unify g tm ] -- search performs a depth-first search of a proof tree, producing the list -- of solution substitutions as they are encountered. search :: Prooftree -> [Subst] search (Done s) = [s] search (Choice pts) = [ s | pt <- pts, s <- search pt ] prove :: Database -> [Term] -> [Subst] prove db = search . prooftree db 1 nullSubst --- End of PureEngine.hs hugs98-plus-Sep2006/demos/prolog/StackEngine.hs0000644006511100651110000000413207472250502020126 0ustar rossross-- Stack based Prolog inference engine -- Mark P. Jones November 1990, modified for Gofer 20th July 1991, -- and for Hugs 1.3 June 1996. -- -- Suitable for use with Hugs 98. -- module StackEngine( version, prove ) where import Prolog import Subst version = "stack based" --- Calculation of solutions: -- the stack based engine maintains a stack of triples (s,goal,alts) -- corresponding to backtrack points, where s is the substitution at that -- point, goal is the outstanding goal and alts is a list of possible ways -- of extending the current proof to find a solution. Each member of alts -- is a pair (tp,u) where tp is a new subgoal that must be proved and u is -- a unifying substitution that must be combined with the substitution s. -- -- the list of relevant clauses at each step in the execution is produced -- by attempting to unify the head of the current goal with a suitably -- renamed clause from the database. type Stack = [ (Subst, [Term], [Alt]) ] type Alt = ([Term], Subst) alts :: Database -> Int -> Term -> [Alt] alts db n g = [ (tp,u) | (tm:-tp) <- renClauses db n g, u <- unify g tm ] -- The use of a stack enables backtracking to be described explicitly, -- in the following `state-based' definition of prove: prove :: Database -> [Term] -> [Subst] prove db gl = solve 1 nullSubst gl [] where solve :: Int -> Subst -> [Term] -> Stack -> [Subst] solve n s [] ow = s : backtrack n ow solve n s (g:gs) ow | g==theCut = solve n s gs (cut ow) | otherwise = choose n s gs (alts db n (app s g)) ow choose :: Int -> Subst -> [Term] -> [Alt] -> Stack -> [Subst] choose n s gs [] ow = backtrack n ow choose n s gs ((tp,u):rs) ow = solve (n+1) (u@@s) (tp++gs) ((s,gs,rs):ow) backtrack :: Int -> Stack -> [Subst] backtrack n [] = [] backtrack n ((s,gs,rs):ow) = choose (n-1) s gs rs ow --- Special definitions for the cut predicate: theCut :: Term theCut = Struct "!" [] cut :: Stack -> Stack cut ss = [] --- End of Engine.hs hugs98-plus-Sep2006/demos/prolog/Subst.hs0000644006511100651110000000437006727055600017043 0ustar rossross-- Substitutions and Unification of Prolog Terms -- Mark P. Jones November 1990, modified for Gofer 20th July 1991, -- and for Hugs 1.3 June 1996. -- -- Suitable for use with Hugs 98. -- module Subst where import Prolog infixr 3 @@ infix 4 ->- --- Substitutions: type Subst = Id -> Term -- substitutions are represented by functions mapping identifiers to terms. -- -- app s extends the substitution s to a function mapping terms to terms -- nullSubst is the empty substitution which maps every identifier to the -- same identifier (as a term). -- i ->- t is the substitution which maps the identifier i to the term t, -- but otherwise behaves like nullSubst. -- s1@@ s2 is the composition of substitutions s1 and s2 -- N.B. app is a monoid homomorphism from (Subst,nullSubst,(@@)) -- to (Term -> Term, id, (.)) in the sense that: -- app (s1 @@ s2) = app s1 . app s2 -- s @@ nullSubst = s = nullSubst @@ s app :: Subst -> Term -> Term app s (Var i) = s i app s (Struct a ts) = Struct a (map (app s) ts) nullSubst :: Subst nullSubst i = Var i (->-) :: Id -> Term -> Subst (i ->- t) j | j==i = t | otherwise = Var j (@@) :: Subst -> Subst -> Subst s1 @@ s2 = app s1 . s2 --- Unification: -- unify t1 t2 returns a list containing a single substitution s which is -- the most general unifier of terms t1 t2. If no unifier -- exists, the list returned is empty. unify :: Term -> Term -> [Subst] unify (Var x) (Var y) = if x==y then [nullSubst] else [x->-Var y] unify (Var x) t2 = [ x ->- t2 | x `notElem` varsIn t2 ] unify t1 (Var y) = [ y ->- t1 | y `notElem` varsIn t1 ] unify (Struct a ts) (Struct b ss) = [ u | a==b, u<-listUnify ts ss ] listUnify :: [Term] -> [Term] -> [Subst] listUnify [] [] = [nullSubst] listUnify [] (r:rs) = [] listUnify (t:ts) [] = [] listUnify (t:ts) (r:rs) = [ u2 @@ u1 | u1<-unify t r, u2<-listUnify (map (app u1) ts) (map (app u1) rs) ] --- End of Subst.hs hugs98-plus-Sep2006/demos/prolog/readme0000644006511100651110000002327006727055600016567 0ustar rossross______________________________________________________________________________ Mini Prolog Version 1.5g A simple Prolog interpreter, for Hugs 1.3 Mark P. Jones, 23rd July 1991, updated for Hugs 1.3, June 1996. ______________________________________________________________________________ This document gives a brief introduction to Mini Prolog Version 1.5g, a simple Prolog interpreter that can be used with Hugs 1.3. The original version of this program was written nearly two years ago as an Orwell program. It has been through many minor changes since then, modified to run under Haskell B, then Gofer, and now Hugs. This document isn't going to explain a lot about how Prolog programs are written and work. But there are plenty of other references for that. Please feel free to contact me with any questions or suggestions. I'd very much like to receive any comments. mpj@cs.nott.ac.uk ______________________________________________________________________________ GETTING STARTED The Mini Prolog interpreter takes the form of a small collection of Hugs scripts. The most important part of any implementation of Prolog is the inference engine which controls the search for goals to user supplied queries. Mini Prolog comes with a choice of two different inference engines, the `pure' engine uses lazy evaluation to construct and traverse potentially infinite proof trees. The `stack' engine uses an explicit stack (implemented using a list) to provide a more concrete description of backtracking. The stack engine also implements the Prolog cut `!' predicate, used in the examples below. Assuming that you've got everything set up properly to use the Hugs interpreter, and that all of the Mini Prolog script files are in the current working directory, you should start Hugs with the command `hugs': C:\HUGS\DEMOS\PROLOG>hugs ___ ___ ___ ___ __________ __________ / / / / / / / / / _______/ / _______/ The Haskell User's / /___/ / / / / / / / _____ / /______ Gofer System / ____ / / / / / / / /_ / /______ / / / / / / /___/ / / /___/ / _______/ / Version 1.3 /__/ /__/ /_________/ /_________/ /_________/ Release alpha Copyright (c) Mark P Jones, The University of Nottingham, 1994-1996. Reading script file "\Hugs\Lib\hugs.prelude": Hugs session for: \Hugs\Lib\hugs.prelude Type :? for help ? and then load the files for the Mini Prolog system: ? :l Main Once the script files have been loaded, start the Mini prolog interpreter by typing the expression `main' and pressing return. ? main Mini Prolog Version 1.5g (stack based) Reading stdlib........done > The `>' prompt indicates that the interpreter is running and waiting for user input. STANDARD PREDICATES Before the `>' prompt appears, Mini Prolog reads a set of standard predicate definitions from the file `stdlib' in the current directory. You are free to modify this file to suit your own needs. The only predicate that is built in to Mini Prolog is the cut, written `!' whose use is demonstrated below. There are no other extralogical predicates, no input/output predicates and no arithmetic as found in full implementations of Prolog. Some of these features could be added to the interpreter without too much difficulty, others would require rather more work. At any time, you can ask the interpreter to display the list of rules that are being held in the database by typing "??" and pressing the return key. Try this after you've started the interpreter and you'll get a list of the predicates defined in the file `stdlib'. For example: > ?? append(nil,X,X). append(cons(X,Y),Z,cons(X,W)):-append(Y,Z,W). equals(X,X). not(X):-X,!,false. not(X). or(X,Y):-X. or(X,Y):-Y. true. > THE APPEND PREDICATE The Mini Prolog interpreter does not support the standard Prolog syntax for lists. Instead, you have to write the list [1,2,3] as "cons(1,cons(2,cons(3,nil)))". One of the first things I tried was appending two simple lists: > ?- append(cons(1,nil),cons(2,nil),X) X = cons(1,cons(2,nil)) ; no. > Given a query, Mini Prolog attempts to find values for each of the variables (beginning with a capital letter) in the query. Here Mini Prolog has found that X = cons(1,cons(2,nil)) is a solution to the query. When I press the semicolon key, ";", it tries to find another solution, but fails and displays the message "no.". What amazed me when I first started experimenting with Prolog was that I could actually ask Mini Prolog to work through the problem in reverse, asking which lists could be appended to get the list cons(1,cons(2,nil)): > ?- append(X,Y,cons(1,cons(2,nil))) X = nil Y = cons(1,cons(2,nil)) ; X = cons(1,nil) Y = cons(2,nil) ; X = cons(1,cons(2,nil)) Y = nil ; no. > Note that the interpreter pauses after displaying each solution and waits for a key to be pressed. Pressing `;' tells Mini Prolog to continue looking for another solution, displaying `no' if no more solutions can be found. Pressing any other key stops the execution of the query. If there are no variables in the original query, then the interpreter simply outputs `yes' if the query can be proved and otherwise prints `no': > ?- append(cons(1,nil),cons(2,nil),cons(1,cons(2,nil))) yes. > ?- append(cons(1,nil),cons(2,nil),cons(1,cons(3,nil))) no. > Unfortunately, typing a control C to interrupt a query with an infinite loop will exit the Prolog interpreter completely -- sorry, but I don't know a way around this at the moment. RUNNING IN THE FAMILY You don't have to stick with the standard predicates that are already included in Mini Prolog. Additional rules can be typed in at the ">" prompt. Here are a couple of examples based around the idea of family trees: > parent(Child,Parent):-father(Child,Parent). > parent(Child,Parent):-mother(Child,Parent). > grandparent(GChild,Gparent):-parent(GChild,Parent),parent(Parent,Gparent). > Note that Mini Prolog expects a maximum of one rule per line, and will not allow predicate definitions to be spread out over a number of lines. All you have to do now is enter some details about your family and then you can ask who your grandparents are ... let's take a typical family: > father(charles,princePhilip). > mother(charles,theQueen). > father(anne,princePhilip). > mother(anne,theQueen). > father(andrew,princePhilip). > mother(andrew,theQueen). > father(edward,princePhilip). > mother(edward,theQueen). > mother(theQueen,theQueenMother). > father(william,charles). > mother(william,diana). > father(harry,charles). > mother(harry,diana). > And now we can ask some questions; like who are the Queen mother's grandchildren ? > ?- grandparent(X,theQueenMother) X = charles ; X = anne ; X = andrew ; X = edward ; no. > or, who are Harry's grandparents ? > ?- grandparent(harry,Who) Who = princePhilip ; Who = theQueen ; no. > Note that Mini Prolog can only use the facts it has been given. Tell it a little more about Diana's parents and you'll find it knows more about Harry's grandparents. Now suppose we define a sibling relation: > sibling(One,Tother) :- parent(One,X),parent(Tother,X). > Fine. It all looks quite correct. But when you try to find Harry's siblings, you get: > ?- sibling(harry,Who) Who = william ; Who = harry ; Who = william ; Who = harry ; no. > Each of William and Harry appears twice in the above. Once by putting X=charles and once using X=diana in the definition of sibling above. We can use the cut predicate to make sure that we look for at most one parent: > newsib(One,Tother) :- parent(One,X),!,parent(Tother,X). > > ?- newsib(harry,Who) Who = william ; Who = harry ; no. > Thats better, but we don't really want to list Harry as his own sibling, so we'll add a further restriction: > newsib1(O,T):-parent(O,X),!,parent(T,X),not(equals(O,T)). > > ?- newsib1(harry,Who) Who = william ; no. > Thats just about perfect. You might like to play with some other examples, enlarge the family tree, work out suitable predicates for other relations (who are Harry's aunts ?) etc. Initially, the answers that Mini Prolog gives will all be pretty obvious to you. Try getting involved in a larger family tree and more complicated relations and you'll find it's not so easy. GOODBYES I could go on with more examples, but I guess you've got the picture by now ... at least I hope so ! I suppose I should just tell you how to get out of Mini Prolog (ok. ^C works but its not exactly elegant). Just type "bye" (or "quit") and you're out. Be warned though: when you leave Mini Prolog, it will not retain any new rules that you've entered, so you'll have to find some other way to save them (I usually type "??" to list the rules that I've entered and use the mouse to paste them into an editor in another window, but that obviously requires you to be using a workstation at the time). > bye Thank you and goodbye (12749 reductions, 1256 cells) ? The `?' prompt tells you that you are now back in Hugs, and you can restart Mini Prolog as before, carry on with some other work in Hugs, or use the :q command to exit Hugs and return to the operating system. I hope you have fun with Mini Prolog; please tell me if you have any comments you'd like to make. ______________________________________________________________________________ hugs98-plus-Sep2006/demos/prolog/stdlib0000644006511100651110000000075506727055600016616 0ustar rossrossThis file contains a list of predicate definitions that will automatically be read into Mini Prolog at the beginning of a session. Each clause in this file must be entered on a single line and lines containing syntax errors are always ignored. This includes the first few lines of this file and provides a simple way to include comments. append(nil,X,X). append(cons(X,Y),Z,cons(X,W)):-append(Y,Z,W). equals(X,X). not(X):-X,!,false. not(X). or(X,Y):-X. or(X,Y):-Y. true. End of stdlib hugs98-plus-Sep2006/demos/AnsiDemo.hs0000644006511100651110000000220006727055600016126 0ustar rossross-- This program is a simple example of the kind of thing that you can do with -- ANSI escape character sequences. But, of course, it will only work on -- machines that support those character sequences (xterms and PCs with -- ansi.sys installed, for example). -- -- Type `interact program' to run the program. module AnsiDemo( program ) where import AnsiInteract writes = writeStr . concat program = writes [ cls, at (17,5) (highlight "Demonstration program"), at (48,5) "Version 1.0", at (17,7) "This program illustrates a simple approach", at (17,8) "to screen-based interactive programs using", at (17,9) "the Hugs functional programming system.", at (17,11) "Please press any key to continue ..." ] (pressAnyKey (promptReadAt (17,15) 18 "Please enter your name: " (\name -> (let reply = "Hello " ++ name ++ "!" in writeAt (40-(length reply`div` 2),18) reply (moveTo (1,23) (writeStr "I'm waiting...\n" (pressAnyKey end))))))) hugs98-plus-Sep2006/demos/ArrayEx.hs0000644006511100651110000000174206727055600016014 0ustar rossross-- Some simple examples using arrays: module ArrayEx where import Array -- Some applications, most taken from the Gentle Introduction ... ------------- timesTable :: Array (Int,Int) Int timesTable = array ((1,1),(10,10)) [ ((i,j), i*j) | i<-[1..10], j<-[1..10] ] fibs n = a where a = array (0,n) ([ (0,1), (1,1) ] ++ [ (i, a!(i-2) + a!(i-1)) | i <- [2..n] ]) wavefront n = a where a = array ((1,1),(n,n)) ([ ((1,j), 1) | j <- [1..n] ] ++ [ ((i,1), 1) | i <- [2..n] ] ++ [ ((i,j), a!(i,j-1) + a!(i-1,j-1) + a!(i-1,j)) | i <- [2..n], j <- [2..n] ]) listwave n = [ [wf!(i,j) | j <- [1..n]] | i <- [1..n] ] where wf = wavefront n eg1 :: Array Integer Integer eg1 = array (1,100) ((1, 1) : [ (i, i * eg1!(i-1)) | i <- [2..100] ]) ------------------------------------------------------------------------------- hugs98-plus-Sep2006/demos/Calendar.hs0000644006511100651110000001154407535140614016151 0ustar rossross-- This is a modification of the calendar program described in section 4.5 -- of Bird and Wadler's ``Introduction to functional programming'', with -- two ways of printing the calendar ... as in B+W, or like UNIX `cal': -- Run using: calFor "1996" -- or: putStr (calendar 1996) -- or: putStr (cal 1996) module Calendar( calendar, cal, calFor, calProg ) where import Gofer import List(zip4) import IO(hPutStr,stderr) import System( getArgs, getProgName, exitWith, ExitCode(..) ) import Char (digitToInt, isDigit) -- Picture handling: infixr 5 `above`, `beside` type Picture = [[Char]] height, width :: Picture -> Int height p = length p width p = length (head p) above, beside :: Picture -> Picture -> Picture above = (++) beside = zipWith (++) stack, spread :: [Picture] -> Picture stack = foldr1 above spread = foldr1 beside empty :: (Int,Int) -> Picture empty (h,w) = replicate h (replicate w ' ') block, blockT :: Int -> [Picture] -> Picture block n = stack . map spread . groupsOf n blockT n = spread . map stack . groupsOf n groupsOf :: Int -> [a] -> [[a]] groupsOf n [] = [] groupsOf n xs = take n xs : groupsOf n (drop n xs) lframe :: (Int,Int) -> Picture -> Picture lframe (m,n) p = (p `beside` empty (h,n-w)) `above` empty (m-h,n) where h = height p w = width p -- Information about the months in a year: monthLengths year = [31,feb,31,30,31,30,31,31,30,31,30,31] where feb | leap year = 29 | otherwise = 28 leap year = if year`mod`100 == 0 then year`mod`400 == 0 else year`mod`4 == 0 monthNames = ["January","February","March","April", "May","June","July","August", "September","October","November","December"] jan1st year = (year + last`div`4 - last`div`100 + last`div`400) `mod` 7 where last = year - 1 firstDays year = take 12 (map (`mod`7) (scanl (+) (jan1st year) (monthLengths year))) -- Producing the information necessary for one month: dates fd ml = map (date ml) [1-fd..42-fd] where date ml d | d<1 || ml String calendar = unlines . block 3 . map picture . months where picture (mn,yr,fd,ml) = title mn yr `above` table fd ml title mn yr = lframe (2,25) [mn ++ " " ++ show yr] table fd ml = lframe (8,25) (daynames `beside` entries fd ml) daynames = ["Sun","Mon","Tue","Wed","Thu","Fri","Sat"] entries fd ml = blockT 7 (dates fd ml) months year = zip4 monthNames (replicate 12 year) (firstDays year) (monthLengths year) -- In a format somewhat closer to UNIX cal: cal year = unlines (banner year `above` body year) where banner yr = [cjustify 75 (show yr)] `above` empty (1,75) body = block 3 . map (pad . pic) . months pic (mn,fd,ml) = title mn `above` table fd ml pad p = (side`beside`p`beside`side)`above`end side = empty (8,2) end = empty (1,25) title mn = [cjustify 21 mn] table fd ml = daynames `above` entries fd ml daynames = [" Su Mo Tu We Th Fr Sa"] entries fd ml = block 7 (dates fd ml) months year = zip3 monthNames (firstDays year) (monthLengths year) -- For a standalone calendar program: -- -- To use this with "runhugs" on Unix: -- -- cat >cal -- #! /usr/local/bin/runhugs -- -- > module Main( main ) where -- > import Calendar -- > main = calProg -- -- -- chmod 755 cal -- -- ./cal 1997 calProg = do args <- getArgs case args of [year] -> calFor year _ -> do putStr "Usage: " getProgName >>= putStr putStrLn " year" exitWith (ExitFailure 1) calFor year | illFormed = hPutStr stderr "Bad argument" >> exitWith (ExitFailure 1) | otherwise = putStr (cal yr) where illFormed = null ds || not (null rs) (ds,rs) = span isDigit year yr = atoi ds atoi s = foldl (\a d -> 10*a+d) 0 (map digitToInt s) -- End of calendar program hugs98-plus-Sep2006/demos/CommaInt.lhs0000644006511100651110000000317106727055600016322 0ustar rossrossThis file contains the definition of commaint, a function which takes a single string argument containing a sequence of digits, and outputs the same sequence with commas inserted after every group of three digits, reading from the right hand end of the string. > module CommaInt where > commaint = reverse . foldr1 (\x y->x++","++y) . group 3 . reverse > where group n = takeWhile (not.null) . map (take n) . iterate (drop n) This definition uses the following library functions: reverse, (.), foldr1, (++), takeWhile, not, null, map, take, iterate, drop. Example: evaluation of commaint "1234567" "1234567" | | reverse V "7654321" _______________________________ | \ | iterate (drop 3) | V | ["7654321", "4321", "1", "", "", ...] | | | | map (take 3) V group 3 V | ["765", "432", "1", "", "", ...] | | | | takeWhile (not.null) | V _______________________________/ ["765", "432", "1"] | | foldr1 (\x y->x++","++y) V "765,432,1" | | reverse V "1,234,567" In a Hugs session: ? commaint "1234567" 1,234,567 ? hugs98-plus-Sep2006/demos/Demos.hs0000644006511100651110000000064606727055600015512 0ustar rossross-- With import chasing enabled, this module can be used to -- load the majority of the demos into a Hugs session. module Demos where import AnsiDemo import Examples import Say import Calendar import CommaInt import Tree import Queens import Mersenne import Gofer import Stack import Lattice import EvalRed import ArrayEx import FastSort import Expr import Literate import Eliza import Minsrand import Ldfs import Matrix hugs98-plus-Sep2006/demos/Eliza.hs0000644006511100651110000002273107535140614015504 0ustar rossross-- Eliza: an implementation of the classic pseudo-psychoanalyst --------------- -- -- Gofer version by Mark P. Jones, January 12 1992. -- Modified for Hugs 1.3, August 1996. -- -- Adapted from a pascal implementation provided as part of an experimental -- package from James Risner (risner@ms.uky.edu), Univ. of KY. with original -- pascal code apparently provided by Robert Migliaccio (mig@ms.uky.edu). ------------------------------------------------------------------------------- module Eliza where import Interact import Char(toUpper) eliza = interact (writeStr hi $ session initial []) where hi = "\n\ \Hi! I'm Eliza. I am your personal therapy computer.\n\ \Please tell me your problem.\n\ \\n" -- Read a line at a time, and produce some kind of response ------------------- session rs prev = readLine "> " (\l -> let ws = words (trim l) (response,rs') = if prev==ws then repeated rs else answer rs ws in writeStr (response ++ "\n\n") $ session rs' ws) trim :: String -> String -- strip punctuation characters trim = foldr cons "" . dropWhile (`elem` punct) where x `cons` xs | x `elem` punct && null xs = [] | otherwise = x : xs punct = [' ', '.', '!', '?', ','] answer :: State -> Words -> (String, State) answer st l = (response, newKeyTab kt st) where (response, kt) = ans (keyTabOf st) e `cons` (r, es) = (r, e:es) ans (e:es) | null rs = e `cons` ans es | otherwise = (makeResponse a (head rs), (key,as):es) where rs = replies key l (key,(a:as)) = e -- Find all possible replies (without leading string for given key ------------ replies :: Words -> Words -> [String] replies key l = ( map (conjug l . drop (length key)) . filter (prefix key . map ucase) . netails) l prefix :: Eq a => [a] -> [a] -> Bool [] `prefix` xs = True (x:xs) `prefix` [] = False (x:xs) `prefix` (y:ys) = x==y && (xs `prefix` ys) netails :: [a] -> [[a]] -- non-empty tails of list netails [] = [] netails xs = xs : netails (tail xs) ucase :: String -> String -- map string to upper case ucase = map toUpper -- Replace keywords in a list of words with appropriate conjugations ---------- conjug :: Words -> Words -> String conjug d = unwords . trailingI . map conj . maybe d -- d is default input where maybe d xs = if null xs then d else xs conj w = head ([m | (w',m)<-conjugates, uw==w'] ++ [w]) where uw = ucase w trailingI = foldr cons [] where x `cons` xs | x=="I" && null xs = ["me"] | otherwise = x:xs conjugates :: [(String, String)] conjugates = prepare (oneways ++ concat [[(x,y), (y,x)] | (x,y) <- bothways]) where oneways = [ ("me", "you") ] bothways = [ ("are", "am"), ("we're", "was"), ("you", "I"), ("your", "my"), ("I've", "you've"), ("I'm", "you're") ] prepare = map (\(w,r) -> (ucase w, r)) -- Response data -------------------------------------------------------------- type Words = [String] type KeyTable = [(Key, Replies)] type Replies = [String] type State = (KeyTable, Replies) type Key = Words repeated :: State -> (String, State) repeated (kt, (r:rp)) = (r, (kt, rp)) newKeyTab :: KeyTable -> State -> State newKeyTab kt' (kt, rp) = (kt', rp) keyTabOf :: State -> KeyTable keyTabOf (kt, rp) = kt makeResponse :: String -> String -> String makeResponse ('?':cs) us = cs ++ " " ++ us ++ "?" makeResponse ('.':cs) us = cs ++ " " ++ us ++ "." makeResponse cs us = cs initial :: State initial = ([(words k, cycle rs) | (k,rs) <-respMsgs], cycle repeatMsgs) repeatMsgs = [ "Why did you repeat yourself?", "Do you expect a different answer by repeating yourself?", "Come, come, elucidate your thoughts.", "Please don't repeat yourself!" ] respMsgs = [ ("CAN YOU", canYou), ("CAN I", canI), ("YOU ARE", youAre), ("YOU'RE", youAre), ("I DON'T", iDont), ("I FEEL", iFeel), ("WHY DON'T YOU", whyDont), ("WHY CAN'T I", whyCant), ("ARE YOU", areYou), ("I CAN'T", iCant), ("I AM", iAm), ("I'M", iAm), ("YOU", you), ("YES", yes), ("NO", no), ("COMPUTER", computer), ("COMPUTERS", computer), ("I WANT", iWant), ("WHAT", question), ("HOW", question), ("WHO", question), ("WHERE", question), ("WHEN", question), ("WHY", question), ("NAME", name), ("BECAUSE", because), ("CAUSE", because), ("SORRY", sorry), ("DREAM", dream), ("DREAMS", dream), ("HI", hello), ("HELLO", hello), ("MAYBE", maybe), ("YOUR", your), ("ALWAYS", always), ("THINK", think), ("ALIKE", alike), ("FRIEND", friend), ("FRIENDS", friend), ("", nokeyMsgs) ] where canYou = [ "?Don't you believe that I can", "?Perhaps you would like to be able to", "?You want me to be able to" ] canI = [ "?Perhaps you don't want to", "?Do you want to be able to" ] youAre = [ "?What makes you think I am", "?Does it please you to believe I am", "?Perhaps you would like to be", "?Do you sometimes wish you were" ] iDont = [ "?Don't you really", "?Why don't you", "?Do you wish to be able to", "Does that trouble you?" ] iFeel = [ "Tell me more about such feelings.", "?Do you often feel", "?Do you enjoy feeling" ] whyDont = [ "?Do you really believe I don't", ".Perhaps in good time I will", "?Do you want me to" ] whyCant = [ "?Do you think you should be able to", "?Why can't you" ] areYou = [ "?Why are you interested in whether or not I am", "?Would you prefer if I were not", "?Perhaps in your fantasies I am" ] iCant = [ "?How do you know you can't", "Have you tried?", "?Perhaps you can now" ] iAm = [ "?Did you come to me because you are", "?How long have you been", "?Do you believe it is normal to be", "?Do you enjoy being" ] you = [ "We were discussing you --not me.", "?Oh,", "You're not really talking about me, are you?" ] yes = [ "You seem quite positive.", "Are you Sure?", "I see.", "I understand." ] no = [ "Are you saying no just to be negative?", "You are being a bit negative.", "Why not?", "Are you sure?", "Why no?" ] computer = [ "Do computers worry you?", "Are you talking about me in particular?", "Are you frightened by machines?", "Why do you mention computers?", "What do you think machines have to do with your problems?", "Don't you think computers can help people?", "What is it about machines that worries you?" ] iWant = [ "?Why do you want", "?What would it mean to you if you got", "?Suppose you got", "?What if you never got", ".I sometimes also want" ] question = [ "Why do you ask?", "Does that question interest you?", "What answer would please you the most?", "What do you think?", "Are such questions on your mind often?", "What is it that you really want to know?", "Have you asked anyone else?", "Have you asked such questions before?", "What else comes to mind when you ask that?" ] name = [ "Names don't interest me.", "I don't care about names --please go on." ] because = [ "Is that the real reason?", "Don't any other reasons come to mind?", "Does that reason explain anything else?", "What other reasons might there be?" ] sorry = [ "Please don't apologise!", "Apologies are not necessary.", "What feelings do you have when you apologise?", "Don't be so defensive!" ] dream = [ "What does that dream suggest to you?", "Do you dream often?", "What persons appear in your dreams?", "Are you disturbed by your dreams?" ] hello = [ "How do you...please state your problem." ] maybe = [ "You don't seem quite certain.", "Why the uncertain tone?", "Can't you be more positive?", "You aren't sure?", "Don't you know?" ] your = [ "?Why are you concerned about my", "?What about your own" ] always = [ "Can you think of a specific example?", "When?", "What are you thinking of?", "Really, always?" ] think = [ "Do you really think so?", "?But you are not sure you", "?Do you doubt you" ] alike = [ "In what way?", "What resemblence do you see?", "What does the similarity suggest to you?", "What other connections do you see?", "Cound there really be some connection?", "How?" ] friend = [ "Why do you bring up the topic of friends?", "Do your friends worry you?", "Do your friends pick on you?", "Are you sure you have any friends?", "Do you impose on your friends?", "Perhaps your love for friends worries you." ] nokeyMsgs = [ "I'm not sure I understand you fully.", "What does that suggest to you?", "I see.", "Can you elaborate on that?", "Say, do you have any psychological problems?" ] ------------------------------------------------------------------------------- hugs98-plus-Sep2006/demos/EvalRed.hs0000644006511100651110000000660106727055600015762 0ustar rossross-- This program can be used to solve exercise 1.2.1 in Bird & Wadler's -- ``Introduction to functional programming'' .... -- -- Write down the ways to reduce sqr (sqr (3+7)) to normal form -- (without assuming shared evaluation of function arguments). module EvalRed where data Term = Square Term -- The square of a term | Plus Term Term -- The sum of two terms | Times Term Term -- The product of two terms | Num Int -- A numeric constant instance Show Term where showsPrec p (Square t) = showString "sqr " . shows t showsPrec p (Plus n m) = showChar '(' . shows n . showChar '+' . shows m . showChar ')' showsPrec p (Times n m) = showChar '(' . shows m . showChar '*' . shows n . showChar ')' showsPrec p (Num i) = shows i -- What are the subterms of a given term? type Subterm = (Term, -- The subterm expression Term->Term) -- A function which embeds -- it back in the original -- term rebuild :: Subterm -> Term rebuild (t, embed) = embed t subterms :: Term -> [Subterm] subterms t = [ (t,id) ] ++ properSubterms t properSubterms :: Term -> [Subterm] properSubterms (Square t) = down Square (subterms t) properSubterms (Plus t1 t2) = down (flip Plus t2) (subterms t1) ++ down (Plus t1) (subterms t2) properSubterms (Times t1 t2) = down (flip Times t2) (subterms t1) ++ down (Times t1) (subterms t2) properSubterms (Num n) = [] down :: (Term -> Term) -> [Subterm] -> [Subterm] down f = map (\(t, e) -> (t, f.e)) -- Some (semi-)general variations on standard themes: filter' :: (a -> Bool) -> [(a, b)] -> [(a, b)] filter' p = filter (p.fst) map' :: (a -> b) -> [(a, c)] -> [(b, c)] map' f = map (\(a, c) -> (f a, c)) -- Reductions: isRedex :: Term -> Bool isRedex (Square _) = True isRedex (Plus (Num _) (Num _)) = True isRedex (Times (Num _) (Num _)) = True isRedex _ = False contract :: Term -> Term contract (Square t) = Times t t contract (Plus (Num n) (Num m)) = Num (n+m) contract (Times (Num n) (Num m)) = Num (n*m) contract _ = error "Not a redex!" singleStep :: Term -> [Term] singleStep = map rebuild . map' contract . filter' isRedex . subterms normalForms :: Term -> [Term] normalForms t | null ts = [ t ] | otherwise = [ n | t'<-ts, n<-normalForms t' ] where ts = singleStep t redSequences :: Term -> [[Term]] redSequences t | null ts = [ [t] ] | otherwise = [ t:rs | t'<-ts, rs<-redSequences t' ] where ts = singleStep t -- Particular example: term0 = Square (Square (Plus (Num 3) (Num 7))) nfs0 = normalForms term0 rsq0 = redSequences term0 -- Using Hugs: -- -- ? length nfs0 -- 547 -- ? -- hugs98-plus-Sep2006/demos/Examples.hs0000644006511100651110000000517406727055600016222 0ustar rossross-- Some examples of functional programming for Hugs module Examples where import Gofer -- Factorials: fact n = product [1..n] -- a simple definition fac n = if n==0 then 1 else n * fac (n-1) -- a recursive definition fac' 0 = 1 -- using two equations fac' n = n * fac (n-1) facts, facts' :: (Enum a, Num a) => [a] facts = scanl (*) 1 [1..] -- infinite list of factorials facts' = 1 : zipWith (*) facts' [1..] -- another way of doing it facFix :: Num a => a -> a facFix = fixedPt f -- using a fixed point combinator where f g 0 = 1 -- overlapping patterns f g n = n * g (n-1) fixedPt f = g where g = f g -- fixed point combinator facCase :: Integral a => a -> a facCase = \n -> case n of 0 -> 1 (m+1) -> (m+1) * facCase m -- Fibonacci numbers: fib 0 = 0 -- using pattern matching: fib 1 = 1 -- base cases... fib (n+2) = fib n + fib (n+1) -- recursive case fastFib n = fibs !! n -- using an infinite stream where fibs = 0 : 1 : zipWith (+) fibs (tail fibs) -- Perfect numbers: factors n = [ i | i<-[1..n-1], n `mod` i == 0 ] perfect n = sum (factors n) == n firstperfect = head perfects perfects = filter perfect [(1::Int)..] -- Prime numbers: primes :: Integral a => [a] primes = map head (iterate sieve [2..]) sieve (p:xs) = [ x | x<-xs, x `rem` p /= 0 ] -- Pythagorean triads: triads n = [ (x,y,z) | let ns=[1..n], x<-ns, y<-ns, z<-ns, x*x+y*y==z*z ] -- The Hamming problem: hamming :: [Integer] hamming = 1 : (map (2*) hamming || map (3*) hamming || map (5*) hamming) where (x:xs) || (y:ys) | x==y = x : (xs || ys) | x [a] -> [a] scale = renorm . map (10*) . tail renorm ds = foldr step [0] (zip ds [2..]) step (d,n) bs | (d `mod` n + 9) < n = (d `div` n) : b : tail bs | otherwise = c : b : tail bs where b' = head bs b = (d+b') `mod` n c = (d+b') `div` n -- Pascal's triangle pascal :: [[Int]] pascal = iterate (\row -> zipWith (+) ([0]++row) (row++[0])) [1] showPascal = putStr ((layn . map show . take 14) pascal) hugs98-plus-Sep2006/demos/Expr.hs0000644006511100651110000000603607535140614015356 0ustar rossross----------------------------------------------------------------------------- -- Parsing simple arithmetic expressions using combinators -- -- Mark P. Jones, April 4, 1993 module Expr where import Char( digitToInt, isDigit ) infixr 6 &&& infixl 5 >>> infixr 4 ||| type Parser a = String -> [(a,String)] result :: a -> Parser a result x s = [(x,s)] (|||) :: Parser a -> Parser a -> Parser a (p ||| q) s = p s ++ q s (&&&) :: Parser a -> Parser b -> Parser (a,b) (p &&& q) s = [ ((x,y),s1) | (x,s0) <- p s, (y,s1) <- q s0 ] (>>>) :: Parser a -> (a -> b) -> Parser b (p >>> f) s = [ (f x, s0) | (x,s0) <- p s ] many :: Parser a -> Parser [a] many p = q where q = p &&& q >>> (\(x,xs) -> x:xs) ||| result [] many1 :: Parser a -> Parser [a] many1 p = p &&& many p >>> (\(x,xs) -> x:xs) sat :: (Char -> Bool) -> Parser Char sat p (c:cs) | p c = [ (c,cs) ] sat p cs = [] tok :: String -> Parser String tok s cs = loop s cs where loop "" cs = [(s,cs)] loop (s:ss) (c:cs) | s==c = loop ss cs loop _ _ = [] digit :: Parser Int digit = sat isDigit >>> digitToInt number :: Parser Int number = many1 digit >>> foldl (\a x -> 10*a+x) 0 -- Original version: -- eval "1" (540 reductions, 933 cells) -- eval "(1)" (5555 reductions, 8832 cells) -- eval "((1))" (50587 reductions, 80354 cells, 1 garbage collection) -- eval "(((1)))" (455907 reductions, 724061 cells, 7 garbage collections) -- eval "1+2+3+4+5" (1296 reductions, 2185 cells) -- eval "1+" (828 reductions, 1227 cells) {- expr = term &&& tok "+" &&& expr >>> (\(x,(p,y)) -> x + y) ||| term &&& tok "-" &&& expr >>> (\(x,(m,y)) -> x - y) ||| term term = atom &&& tok "*" &&& term >>> (\(x,(t,y)) -> x * y) ||| atom &&& tok "/" &&& term >>> (\(x,(d,y)) -> x / y) ||| atom -} atom = tok "-" &&& number >>> (\(u,n) -> -n) ||| number ||| tok "(" &&& expr &&& tok ")" >>> (\(o,(n,c)) -> n) -- Putting the initial prefix parser first: -- eval "1" (96 reductions, 168 cells) -- eval "(1)" (191 reductions, 335 cells) -- eval "((1))" (283 reductions, 498 cells) -- eval "(((1)))" (375 reductions, 661 cells) -- eval "1+2+3+4+5" (472 reductions, 905 cells) -- eval "1+" (124 reductions, 251 cells) expr = term &&& (tok "+" &&& expr >>> (\(p,y) -> (+y)) ||| tok "-" &&& expr >>> (\(m,y) -> subtract y) ||| result id) >>> \(n,f) -> f n term = atom &&& (tok "*" &&& term >>> (\(t,y) -> (*y)) ||| tok "/" &&& term >>> (\(d,y) -> (`div` y)) ||| result id) >>> \(n,f) -> f n eval s = case expr s of ((x,""):_) -> x _ -> error "Syntax error in input" hugs98-plus-Sep2006/demos/FastSort.hs0000644006511100651110000000276506727055600016214 0ustar rossrossmodule FastSort where import Gofer {- list sorting: see L.C.Paulson, ML for the working programmer, Cambidge, p100 -- The list is split into ascending chunks which are then merged in pairs. samsort l = sorting [] 0 l where sorting ls k [] = head(mergepairs ls 0) sorting ls k (x:xs) = sorting (mergepairs (run:ls) kinc) kinc tl where (run, tl) = nextrun [x] xs kinc = k+1 nextrun run [] = (reverse run, []) nextrun rs@(r:_) xl@(x:xs) | x String -> String ljustify n s = s ++ space (n - length s) rjustify n s = space (n - length s) ++ s cjustify n s = space halfm ++ s ++ space (m - halfm) where m = n - length s halfm = m `div` 2 space :: Int -> String space n = copy n ' ' layn :: [String] -> String layn = lay 1 where lay _ [] = [] lay n (x:xs) = rjustify 4 (show n) ++ ") " ++ x ++ "\n" ++ lay (n+1) xs -- Misc. list utilities: ---------------------------------------------------- copy :: Int -> a -> [a] copy n x = take n (repeat x) merge :: Ord a => [a] -> [a] -> [a] merge [] ys = ys merge xs [] = xs merge (x:xs) (y:ys) | x <= y = x : merge xs (y:ys) | otherwise = y : merge (x:xs) ys sort :: Ord a => [a] -> [a] sort = foldr insert [] insert :: Ord a => a -> [a] -> [a] insert x [] = [x] insert x (y:ys) | x <= y = x:y:ys | otherwise = y:insert x ys -- Other functions: --------------------------------------------------------- fst3 :: (a,b,c) -> a fst3 (x,_,_) = x snd3 :: (a,b,c) -> b snd3 (_,x,_) = x thd3 :: (a,b,c) -> c thd3 (_,_,x) = x ----------------------------------------------------------------------------- hugs98-plus-Sep2006/demos/Lattice.hs0000644006511100651110000001007206727055600016022 0ustar rossross-- This file contains a Hugs implementation of the programs described in: -- -- Mark P. Jones, Computing with lattices: An application of type classes, -- Journal of Functional Programming, Volume 2, Number 4, Oct 1992. -- module Lattice where class Eq a => Lattice a where -- A type class representing lattices bottom, top :: a meet, join :: a -> a -> a lt :: a -> a -> Bool x `lt` y = (x `join` y) == y instance Lattice Bool where -- Simple instances of Lattice bottom = False top = True meet = (&&) join = (||) instance (Lattice a, Lattice b) => Lattice (a,b) where bottom = (bottom,bottom) top = (top,top) (x,y) `meet` (u,v) = (x `meet` u, y `meet` v) (x,y) `join` (u,v) = (x `join` u, y `join` v) -- Defining the least fixed point operator: fix f = firstRepeat (iterate f bottom) firstRepeat xs = head [ x | (x,y) <- zip xs (tail xs), x==y ] -- Maximum and minimum frontiers: data Minf a = Minf [a] data Maxf a = Maxf [a] instance Eq a => Eq (Minf a) where -- Equality on Frontiers (Minf xs) == (Minf ys) = setEquals xs ys instance Eq a => Eq (Maxf a) where (Maxf xs) == (Maxf ys) = setEquals xs ys xs `subset` ys = all (`elem` ys) xs setEquals xs ys = xs `subset` ys && ys `subset` xs instance Lattice a => Lattice (Minf a) where -- Lattice structure bottom = Minf [] top = Minf [bottom] (Minf xs) `meet` (Minf ys) = minimal [ x`join`y | x<-xs, y<-ys ] (Minf xs) `join` (Minf ys) = minimal (xs++ys) instance Lattice a => Lattice (Maxf a) where bottom = Maxf [] top = Maxf [top] (Maxf xs) `meet` (Maxf ys) = maximal [ x`meet`y | x<-xs, y<-ys ] (Maxf xs) `join` (Maxf ys) = maximal (xs++ys) -- Find maximal elements of a list xs with respect to partial order po: maximalWrt po = loop [] where loop xs [] = xs loop xs (y:ys) | any (po y) (xs++ys) = loop xs ys | otherwise = loop (y:xs) ys minimal :: Lattice a => [a] -> Minf a -- list to minimum frontier minimal = Minf . maximalWrt (flip lt) maximal :: Lattice a => [a] -> Maxf a -- list to maximum frontier maximal = Maxf . maximalWrt lt -- A representation for functions of type Lattice a => a -> Bool: data Fn a = Fn (Minf a) (Maxf a) instance Eq a => Eq (Fn a) where Fn f1 f0 == Fn g1 g0 = f1==g1 -- && f0==g0 instance Lattice a => Lattice (Fn a) where bottom = Fn bottom top top = Fn top bottom Fn u l `meet` Fn v m = Fn (u `meet` v) (l `join` m) Fn u l `join` Fn v m = Fn (u `join` v) (l `meet` m) -- Navigable lattices: class Lattice a => Navigable a where succs :: a -> Minf a preds :: a -> Maxf a maxComp :: Navigable a => [a] -> Maxf a -- implementation of complement maxComp = foldr meet top . map preds minComp :: Navigable a => [a] -> Minf a minComp = foldr meet top . map succs instance Navigable Bool where -- instances of Navigable succs False = Minf [True] succs True = Minf [] preds False = Maxf [] preds True = Maxf [False] minfOf (Minf xs) = xs maxfOf (Maxf xs) = xs instance (Navigable a, Navigable b) => Navigable (a,b) where succs (x,y) = Minf ([(sx,bottom) | sx <- minfOf (succs x)] ++ [(bottom,sy) | sy <- minfOf (succs y)]) preds (x,y) = Maxf ([(px,top) | px <- maxfOf (preds x)] ++ [(top,py) | py <- maxfOf (preds y)]) instance Navigable a => Navigable (Fn a) where succs (Fn f1 f0) = Minf [Fn (Minf [y]) (preds y) | y <- maxfOf f0] preds (Fn f1 f0) = Maxf [Fn (succs x) (Maxf [x]) | x <- minfOf f1] -- Upwards and downwards closure operators: upwards (Minf []) = [] upwards ts@(Minf (t:_)) = t : upwards (ts `meet` succs t) downwards (Maxf []) = [] downwards ts@(Maxf (t:_)) = t : downwards (ts `meet` preds t) elements :: Navigable a => [a] -- enumerate all elements in lattice elements = upwards top hugs98-plus-Sep2006/demos/Ldfs.hs0000644006511100651110000000247407707211407015332 0ustar rossross------------------------------------------------------------------------------ -- Demonstration of the graph algorithms described in: -- -- ``Lazy Depth-First Search and Linear Graph Algorithms in Haskell'' -- by David King and John Launchbury -- -- Most of the code is in the library modules Data.Graph and Data.Tree. -- -- Suitable for use with Hugs 98. ------------------------------------------------------------------------------ module Ldfs ( figure4, {- figure5, -} figure7 ) where import Data.Char import Data.Graph import Data.Tree graph = buildG (ord 'a',ord 'j') (reverse [(ord v, ord w) | (v,w) <- vs]) where vs = [ ('a', 'b'), ('a', 'f'), ('b', 'c'), ('b', 'e'), ('c', 'a'), ('c', 'd'), ('e', 'd'), ('g', 'h'), ('g', 'j'), ('h', 'f'), ('h', 'i'), ('h', 'j') ] figure4 = buildG (ord 'a',ord 'i') ([(ord v, ord w) | (v,w) <- vs] ++ reverse [ (ord v, ord w) | (w, v) <- vs ]) where vs = [ ('b', 'a'), ('e', 'a'), ('c', 'b'), ('d', 'c'), ('b', 'd'), ('f', 'e'), ('h', 'e'), ('g', 'f'), ('e', 'g'), ('i', 'h'), ('a', 'i'), ('h', 'a') ] {- figure5 = map (do_label figure4 dnum) f where f = dff figure4 dnum = preArr (bounds figure4) f -} figure7 = map (fmap (map chr)) $ bcc figure4 hugs98-plus-Sep2006/demos/Literate.lhs0000644006511100651110000000731607535140614016367 0ustar rossrossLiterate comments ----------------- [This file contains an executable version of a program for processing literate scripts. The original version of this program appeared in Appendix C of the Haskell report, version 1.2. This version has been updated for Haskell 1.3.] > module Literate where > import System(getArgs) > import Char(isSpace) Many Haskell implementations support the ``literate comment'' convention, first developed by Richard Bird and Philip Wadler for Orwell, and inspired in turn by Donald Knuth's ``literate programming''. The convention is not part of the Haskell language, but it is supported by the implementations known to us (Chalmers, Glasgow, and Yale). The literate style encourages comments by making them the default. A line in which ">" is the first character is treated as part of the program; all other lines are comment. Within the program part, the usual "--" and "{- -}" comment conventions may still be used. To capture some cases where one omits an ">" by mistake, it is an error for a program line to appear adjacent to a non-blank comment line, where a line is taken as blank if it consists only of whitespace. By convention, the style of comment is indicated by the file extension, with ".hs" indicating a usual Haskell file, and ".lhs" indicating a literate Haskell file. To make this precise, we present a literate Haskell program to convert literate programs. The program expects a single name "file" on the command line, reads "file.lhs", and either writes the corresponding program to "file.hs" or prints error messages to "stderr". Each of the lines in a literate script is a program line, a blank line, or a comment line. In the first case, the text is kept with the line. > data Classified = Program String | Blank | Comment In a literate program, program lines begins with a `>' character, blank lines contain only whitespace, and all other lines are comment lines. > classify :: String -> Classified > classify ('>':s) = Program s > classify s | all isSpace s = Blank > classify s | otherwise = Comment In the corresponding program, program lines have the leading `>' replaced by a leading space, to preserve tab alignments. > unclassify :: Classified -> String > unclassify (Program s) = " " ++ s > unclassify Blank = "" > unclassify Comment = "" Process a literate program into error messages (if any) and the corresponding non-literate program. > process :: String -> (String, String) > process lhs = (es, hs) > where cs = map classify (lines lhs) > es = unlines (errors cs) > hs = unlines (map unclassify cs) Check that each program line is not adjacent to a comment line. > errors :: [Classified] -> [String] > errors cs = concat (zipWith3 adjacent [1..] cs (tail cs)) Given a line number and a pair of adjacent lines, generate a list of error messages, which will contain either one entry or none. > adjacent :: Int -> Classified -> Classified -> [String] > adjacent n (Program _) Comment = [message n "program" "comment"] > adjacent n Comment (Program _) = [message n "comment" "program"] > adjacent n this next = [] > message n p c = "Line "++show n++": "++p++" line before "++c++" line." The main program gets name "file", reads "file.lhs", and either writes the corresponding program to "file.hs" or prints error messages on "stdout". > main :: IO () > main = do strs <- getArgs > case strs of > [str] -> delit str > _ -> ioError (userError "Too many or too few arguments") > delit f = do lhs <- readFile (f ++ ".lhs") > case (process lhs) of > ([],hs) -> writeFile (f ++ ".hs") hs > (es,_) -> putStr es hugs98-plus-Sep2006/demos/Makefile.in0000644006511100651110000000201210464157152016137 0ustar rossross# @configure_input@ # Makefile (just install) for Hugs demo programs # (this should be a POSIX 1003.2-1992 Makefile) # These variables determine where various parts of the Hugs system are # installed. (They are ignored in Windows or DOS.) # Binaries are installed in $(bindir); libraries go in $(hugsdir)/libraries prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ datarootdir = @datarootdir@ datadir = @datadir@ mandir = @mandir@ hugsdir = @hugsdir@ RM = @RM@ INSTALL = ../install-sh INSTALL_DATA = /bin/cp all: install: all $(INSTALL) -d $(DESTDIR)$(hugsdir)/demos $(INSTALL) -d $(DESTDIR)$(hugsdir)/demos/prolog $(INSTALL_DATA) ../demos/*.* $(DESTDIR)$(hugsdir)/demos $(INSTALL_DATA) ../demos/prolog/*.* $(DESTDIR)$(hugsdir)/demos/prolog $(INSTALL_DATA) ../demos/prolog/readme $(DESTDIR)$(hugsdir)/demos/prolog $(INSTALL_DATA) ../demos/prolog/stdlib $(DESTDIR)$(hugsdir)/demos/prolog clean: $(RM) *~ distclean: clean $(RM) Makefile veryclean: distclean hugs98-plus-Sep2006/demos/Matrix.hs0000644006511100651110000000671506727055600015712 0ustar rossross-- Some simple Hugs programs for manipulating matrices. -- module Matrix where import List type Matrix k = [Row k] -- matrix represented by a list of its rows type Row k = [k] -- a row represented by a list of literals -- General utility functions: shapeMat :: Matrix k -> (Int, Int) shapeMat mat = (rows mat, cols mat) rows :: Matrix k -> Int rows mat = length mat cols :: Matrix k -> Int cols mat = length (head mat) idMat :: Int -> Matrix Int idMat 0 = [] idMat (n+1) = [1:replicate n 0] ++ map (0:) (idMat n) -- Matrix multiplication: multiplyMat :: Matrix Int -> Matrix Int -> Matrix Int multiplyMat a b | cols a==rows b = [[row `dot` col | col<-b'] | row<-a] | otherwise = error "incompatible matrices" where v `dot` w = sum (zipWith (*) v w) b' = transpose b -- An attempt to implement the standard algorithm for converting a matrix -- to echelon form... echelon :: Matrix Int -> Matrix Int echelon rs | null rs || null (head rs) = rs | null rs2 = map (0:) (echelon (map tail rs)) | otherwise = piv : map (0:) (echelon rs') where rs' = map (adjust piv) (rs1++rs3) (rs1,rs2) = span leadZero rs leadZero (n:_) = n==0 (piv:rs3) = rs2 -- To find the echelon form of a matrix represented by a list of rows rs: -- -- {first line in definition of echelon}: -- If either the number of rows or the number of columns in the matrix -- is zero (i.e. if null rs || null (head rs)), then the matrix is -- already in echelon form. -- -- {definition of rs1, rs2, leadZero in where clause}: -- Otherwise, split the matrix into two submatrices rs1 and rs2 such that -- rs1 ++ rs2 == rs and all of the rows in rs1 begin with a zero. -- -- {second line in definition of echelon}: -- If rs2 is empty (i.e. if null rs2) then every row begins with a zero -- and the echelon form of rs can be found by adding a zero on to the -- front of each row in the echelon form of (map tail rs). -- -- {Third line in definition of echelon, and definition of piv, rs3}: -- Otherwise, the first row of rs2 (denoted piv) contains a non-zero -- leading coefficient. After moving this row to the top of the matrix -- the original matrix becomes piv:(rs1++rs3). -- By subtracting suitable multiples of piv from (suitable multiples of) -- each row in (rs1++rs3) {see definition of adjust below}, we obtain a -- matrix of the form: -- -- <----- piv ------> -- __________________ -- 0 | -- . | -- . | rs' where rs' = map (adjust piv) (rs1++rs3) -- . | -- 0 | -- -- whose echelon form is piv : map (0:) (echelon rs'). -- adjust :: Num a => Row a -> Row a -> Row a adjust (m:ms) (n:ns) = zipWith (-) (map (n*) ms) (map (m*) ns) -- A more specialised version of this, for matrices of integers, uses the -- greatest common divisor function gcd in an attempt to try and avoid -- result matrices with very large coefficients: -- -- (I'm not sure this is really worth the trouble!) adjust' :: Row Int -> Row Int -> Row Int adjust' (m:ms) (n:ns) = if g==0 then ns else zipWith (\x y -> b*y - a*x) ms ns where g = gcd m n a = n `div` g b = m `div` g -- end!! hugs98-plus-Sep2006/demos/Mersenne.hs0000644006511100651110000000621606727055600016216 0ustar rossross----------------------------------------------------------------------------- -- Mersenne.hs Mark P. Jones -- February 7, 1995 -- -- Here is a Hugs program to calculate the 30th Mersenne prime using the -- builtin bignum arithmetic. -- -- For those who don't know, a Mersenne prime is a prime number of the form: -- -- n -- 2 - 1 -- -- The first few Mersenne primes are for: -- n = 2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, 1279, 2203, -- 2281, 3217, 4253, 4423, ... -- -- The thirtieth Mersenne prime occurs for n = 216,091. In decimal -- notation, this number has 65050 digits. -- -- -- A little story about me and this number: -- -- As I recall, this fact was discovered nearly ten years ago. I -- wrote an Intel 8080 assembly language program to calculate this -- number. Running on a Z80A based machine, it used a 32K array -- -- more than half of the total memory available -- with each byte -- containing two binary coded decimal digits. The array was -- initialized to contain the number 1 and a loop was used to double -- the value in the array a total of 216091 times, before the final 1 -- was subtracted. Using the timings for individual Z80A -- instructions, I estimated the running time for the program and, -- when it finished on Thursday April 17, 1986, after running for a -- little under 18 hours, I was delighted that my predictions were -- within 10 seconds of the actual running time. Of course, now I -- understand a little more about error bounds and tolerances, I realize -- that this was more by luck than judgement, but at the time, I was -- delighted! I don't remember if I knew the O(log n) algorithm for -- exponentials at the time, but it wouldn't have been easy to apply -- with the limited amount of memory at my disposal back then. (Of -- course, it wouldn't have been O(log n) in practice either because -- the individual multiplications can hardly be considered O(1)!) -- -- Now I can run this program, written in Hugs (or to be accurate, -- written using calls to Hugs primitive functions), on the machine -- on my desk while I'm editing files and reading mail in other -- windows, and it still finishes in under 7 minutes. Of course, -- it did use 6M of heap (though not all at the same time), but -- who's counting? :-) module Mersenne where import List( genericLength ) p :: Integer p = 2 ^ 216091 - 1 digitsInP :: Integer digitsInP = genericLength (show p) -- Here are the smaller Mersenne primes listed above: smallMPindices :: [Int] smallMPindices = [2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, 1279, 2203, 2281, 3217, 4253, 4423 ] smallMP :: [Integer] smallMP = [ 2 ^ n - 1 | n <- smallMPindices ] -- Does an incremental algorithm buy us anything? Not much, it would seem! smallMP' :: [Integer] smallMP' = map (subtract 1) (scanl (\x i -> x * 2^i) (2^n) ns) where (n:ns) = zipWith (-) smallMPindices (0:smallMPindices) ----------------------------------------------------------------------------- hugs98-plus-Sep2006/demos/Minsrand.hs0000644006511100651110000001041506727055600016211 0ustar rossross------------------------------------------------------------------------------- -- The following random number generator is an implementation of the -- Minimum Standard generator recommended in -- -- Random Number Generators: Good ones are hard to find -- Stephen K Park & Keith W Miller -- Communications of the ACM, Oct 88, Vol 31 No 10 1192 - 1201 -- -- Seeds must be in the range 1..2147483646, that is (1..(2**31)-2) -- Output will also be in that range. The generator is full period so that -- all 2147483646 values will be generated before the initial seed repeats. -- Dividing by 2147483647 (real) as in the Pascal code below will map it -- into the range (0..1) if required. -- -- [This program assumes that you are working on a machine with (at least) -- 32 bit integers. Folks using Hugs on a PC will have to stick with the -- less sophisticated random number generator in the file `randoms'.] ------------------------------------------------------------------------------- module Minsrand where min_stand_test :: Int -> Int min_stand_test n = if test > 0 then test else test + 2147483647 where test = 16807 * lo - 2836 * hi hi = n `div` 127773 lo = n `rem` 127773 min_stand_randoms :: Int -> [Int] min_stand_randoms = iterate min_stand_test -- The article produced below also gives a test to check that the -- random number generator is working. We can duplicate this test -- as follows: -- -- ? strictIterate min_stand_test 1 !! 10000 -- 1043618065 -- (149758 reductions, 240096 cells, 2 garbage collections) -- -- Happily, this is the result that we expect to obtain. -- -- The function strictIterate is defined below. It is similar to the -- standard iterate function except that it forces the evaluation of -- each element in the list produced (except possibly the first). -- Had we instead tried to evaluate: -- -- iterate min_stand_test 1 !! 10000 -- -- Hugs would have first constructed the expression graph: -- -- min_stand_test (min_stand_test (... (min_stand_test 1) ...)) -- -- in which the min_stand_test function is applied 10000 times to 1 -- and then attempted to evaluate this. In either case, you'd need a -- large heap to represent the complete expression and a large stack so -- that you could handle 10000 levels of function calling. Most standard -- configurations of Hugs aren't set up with sufficiently large defaults -- to make this possible, so the most likely outcome would be a runtime -- error of one kind or another! strictIterate :: (a -> a) -> a -> [a] strictIterate f x = x : (strictIterate f $! f x) ------------------------------------------------------------------------------- -- Some comments and code from: -- -- Random Number Generators: Good ones are hard to find -- Stephen K Park & Keith W Miller -- Communications of the ACM, Oct 88, Vol 31 No 10 1192 - 1201 -- -- Minimum standard random number generator implementations -- -- This version of Random will be correct if reals are represented -- with a 46-bit or larger mantissa (excluding the sign bit). -- For example, this version will be correct on all systems that support -- the IEEE 64-bit real arithmetic standard since the mantissa in that case -- is 53-bits. -- ... from page 1195 upper right quadrant -- -- var seed : real; -- ... -- function Random : real; -- (* Real Version 1 *) -- const -- a = 16807.0; -- m = 2147483647.0; -- var -- temp : real; -- begin -- temp := a * seed; -- seed := -- temp - m * Trunc(temp / m); -- Random := seed / m; -- end; -- -- ... from page 1195 lower right quadrant, variant by L. Schrage, 1979, 1983 -- -- var seed : integer; -- ... -- function Random : real; -- (* Integer Version 2 *) -- const -- a = 16807; -- m = 2147483647; -- q = 127773; (* m div a *) -- r = 2836; (* m mod a *) -- var -- lo, hi, test : integer; -- begin -- hi := seed div q; -- lo := seed mod q; -- test := a * lo - r * hi; -- if test > 0 then -- seed := test -- else -- seed := test + m; -- -- Random := seed / m; -- end; -- -- From page 1195 lower left quadrant -- -- seed := 1; -- for n := 1 to 10000 do -- u := Random; -- Writeln('The current value of seed is : ', seed); -- (* Expect 1043618065 *) ------------------------------------------------------------------------------- hugs98-plus-Sep2006/demos/Queens.hs0000644006511100651110000000153206727055600015676 0ustar rossross-- This N-Queens program is based on a small variation of the 8-queens -- program from Bird and Wadler's book. -- -- Be warned: printing out the complete list of solutions (all 92 of them) -- by evaluating "q 8" takes well over 1 million reductions and uses nearly -- 2.5 million cells... it may take some time to execute on slower systems! :-) module Queens where import Gofer queens number_of_queens = qu number_of_queens where qu 0 = [[]] qu (m+1) = [ p++[n] | p<-qu m, n<-[1..number_of_queens], safe p n ] safe p n = all not [ check (i,j) (m,n) | (i,j) <- zip [1..] p ] where m = 1 + length p check (i,j) (m,n) = j==n || (i+j==m+n) || (i-j==m-n) -- Use q 5 to see the list of solutions for 5 queens. -- Use q 8 to see the list of solutions for 8 queens .... q = putStr . layn . map show . queens hugs98-plus-Sep2006/demos/Say.hs0000644006511100651110000001166007535140614015173 0ustar rossross------------------------------------------------------------------------------ -- A simple banner program: Mark P Jones, 1992 -- -- Many years ago, I was helping out on a stand at a computer show. -- Or at least, I would have been if anyone had been interested in -- what we had on the stand. So instead, I sat down to see if I -- could write a banner program -- something to print messages out -- in large letters. -- -- The original program was in Basic, but here is a version in Hugs. -- The program itself is only two lines long and that is rather pleasing, -- but the raw data for the letters (and the function mapping characters -- to letters) take up rather more space. I don't have that Basic version -- anymore. I wonder whether the complete Hugs code is that much shorter? -- -- One of the nice things about this program is that the main program is -- completely independent of the size of characters. You could easily add -- a new font, perhaps with higher resolution (bigger letters), or even -- variable width characters, and the program would take it all in its -- stride. -- -- If you have a wide screen (>80 cols), you might like to try evaluating: -- -- (putStr . concat . map say . lines . say) "Hi" -- -- and contemplating how easy it might have been to get my original -- Basic version to perform this trick... -- -- Enjoy! ------------------------------------------------------------------------------ module Say where import Char( ord, chr, isSpace, isUpper, isLower, isDigit ) import List( transpose ) sayit :: String -> IO () sayit = putStr . say say = ('\n':) . unlines . map join . transpose . map picChar where join = foldr1 (\xs ys -> xs ++ " " ++ ys) -- mapping characters to letters: -------------------------------------------- picChar c | isUpper c = alphas !! (ord c - ord 'A') | isLower c = alphas !! (ord c - ord 'a') | isSpace c = blank | isDigit c = digits !! (ord c - ord '0') | c=='/' = slant | c=='\\' = reverse slant | otherwise = head ([ letter | (c',letter) <- punct, c'==c ] ++ [nothing]) -- letters data: ------------------------------------------------------------- blank = [" ", " ", " ", " ", " "] slant = [" ", " ", " ", " ", "" ] nothing= repeat "" punct = [('.', [" ", " ", " ", " .. ", " .. "]), ('?', [" ??? ", "? ?", " ? ", " ? ", " . "]), ('!', [" ! ", " ! ", " ! ", " ! ", " . "]), ('-', [" ", " ", "-----", " ", " "]), ('+', [" + ", " + ", "+++++", " + ", " + "]), (':', [" ", " :: ", " ", " :: ", " "]), (';', [" ", " ;; ", " ", " ;; ", " ;; "]) ] digits = [[" OOO ", "0 00", "0 0 0", "00 0", " 000 "], [" 1 ", " 11 ", " 1 ", " 1 ", "11111"], [" 222 ", "2 2", " 2 ", " 2 ", "22222"], ["3333 ", " 3", " 333 ", " 3", "3333 "], [" 4 ", " 44 ", " 4 4 ", "44444", " 4 "], ["55555", "5 ", "5555 ", " 5", "5555 "], [" 66", " 6 ", " 666 ", "6 6", " 666 "], ["77777", " 7", " 7 ", " 7 ", " 7 "], [" 888 ", "8 8", " 888 ", "8 8", " 888 "], [" 999 ", "9 9", " 999 ", " 9 ", "99 "]] alphas = [[" A ", " A A ", "AAAAA", "A A", "A A"], ["BBBB ", "B B", "BBBB ", "B B", "BBBB "], [" CCCC", "C ", "C ", "C ", " CCCC"], ["DDDD ", "D D", "D D", "D D", "DDDD "], ["EEEEE", "E ", "EEEEE", "E ", "EEEEE"], ["FFFFF", "F ", "FFFF ", "F ", "F "], [" GGGG", "G ", "G GG", "G G", " GGG "], ["H H", "H H", "HHHHH", "H H", "H H"], ["IIIII", " I ", " I ", " I ", "IIIII"], ["JJJJJ", " J ", " J ", "J J ", " JJ "], ["K K", "K K ", "KKK ", "K K ", "K K"], ["L ", "L ", "L ", "L ", "LLLLL"], ["M M", "MM MM", "M M M", "M M", "M M"], ["N N", "NN N", "N N N", "N NN", "N N"], [" OOO ", "O O", "O O", "O O", " OOO "], ["PPPP ", "P P", "PPPP ", "P ", "P "], [" QQQ ", "Q Q", "Q Q Q", "Q Q ", " QQ Q"], ["RRRR ", "R R", "RRRR ", "R R ", "R R"], [" SSSS", "S ", " SSS ", " S", "SSSS "], ["TTTTT", " T ", " T ", " T ", " T "], ["U U", "U U", "U U", "U U", " UUU "], ["V V", "V V", "V V", " V V ", " V "], ["W W", "W W", "W W", "W W W", " W W "], ["X X", " X X ", " X ", " X X ", "X X"], ["Y Y", " Y Y ", " Y ", " Y ", " Y "], ["ZZZZZ", " Z ", " Z ", " Z ", "ZZZZZ"] ] -- end of banner program ----------------------------------------------------- hugs98-plus-Sep2006/demos/Stack.hs0000644006511100651110000000234106727055600015502 0ustar rossross-- Stacks: using restricted type synonyms module Stack where type Stack a = [a] in emptyStack, push, pop, topOf, isEmpty emptyStack :: Stack a emptyStack = [] push :: a -> Stack a -> Stack a push = (:) pop :: Stack a -> Stack a pop [] = error "pop: empty stack" pop (_:xs) = xs topOf :: Stack a -> a topOf [] = error "topOf: empty stack" topOf (x:_) = x isEmpty :: Stack a -> Bool isEmpty = null instance Eq a => Eq (Stack a) where s1 == s2 | isEmpty s1 = isEmpty s2 | isEmpty s2 = isEmpty s1 | otherwise = topOf s1 == topOf s2 && pop s1 == pop s2 -- A slightly different presentation: type Stack' a = [a] in emptyStack' :: Stack' a, push' :: a -> Stack' a -> Stack' a, pop' :: Stack' a -> Stack' a, topOf' :: Stack' a -> a, isEmpty' :: Stack' a -> Bool emptyStack' = [] push' = (:) pop' [] = error "pop': empty stack" pop' (_:xs) = xs topOf' [] = error "topOf': empty stack" topOf' (x:_) = x isEmpty' = null instance Eq a => Eq (Stack' a) where s1 == s2 | isEmpty' s1 = isEmpty' s2 | isEmpty' s2 = isEmpty' s1 | otherwise = topOf' s1 == topOf' s2 && pop' s1 == pop' s2 hugs98-plus-Sep2006/demos/Tree.hs0000644006511100651110000000406606727055600015342 0ustar rossrossmodule Tree where import Gofer -- Here are a collection of fairly standard functions for manipulating -- one form of binary trees data Tree a = Lf a | Tree a :^: Tree a reflect t@(Lf x) = t reflect (l:^:r) = r :^: l mapTree f (Lf x) = Lf (f x) mapTree f (l:^:r) = mapTree f l :^: mapTree f r -- Functions to calculate the list of leaves on a tree: leaves, leaves' :: Tree a -> [a] leaves (Lf l) = [l] -- direct version leaves (l:^:r) = leaves l ++ leaves r leaves' t = leavesAcc t [] -- using an accumulating parameter where leavesAcc (Lf l) = (l:) leavesAcc (l:^:r) = leavesAcc l . leavesAcc r -- Picturing a tree: drawTree :: Show a => Tree a -> IO () drawTree = putStr . unlines . thd3 . pic where pic (Lf a) = (1,1,["-- "++show a]) pic (l:^:r) = (hl+hr+1, hl+1, top pl ++ mid ++ bot pr) where (hl,bl,pl) = pic l (hr,br,pr) = pic r top = zipWith (++) (replicate (bl-1) " " ++ [" ,-"] ++ replicate (hl-bl) " | ") mid = ["-| "] bot = zipWith (++) (replicate (br-1) " | " ++ [" `-"] ++ replicate (hr-br) " ") -- Finally, here is an example due to Richard Bird, which uses lazy evaluation -- and recursion to create a `cyclic' program which avoids multiple traversals -- over a data structure: replaceAndMin m (Lf n) = (Lf m, n) replaceAndMin m (l:^:r) = (rl :^: rr, ml `min` mr) where (rl,ml) = replaceAndMin m l (rr,mr) = replaceAndMin m r replaceWithMin t = mt where (mt,m) = replaceAndMin m t sample, sample2, sample4 :: Num a => Tree a sample = (Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10 sample2 = sample :^: sample sample4 = sample2 :^: sample2 hugs98-plus-Sep2006/docs/0000755006511100651110000000000010504340130013701 5ustar rossrosshugs98-plus-Sep2006/docs/building/0000755006511100651110000000000010504340130015476 5ustar rossrosshugs98-plus-Sep2006/docs/building/config.txt0000644006511100651110000001705110004333354017515 0ustar rossrossBasic Installation ================== These are generic installation instructions. The `configure' shell script attempts to guess correct values for various system-dependent variables used during compilation. It uses those values to create a `Makefile' in each directory of the package. It may also create one or more `.h' files containing system-dependent definitions. Finally, it creates a shell script `config.status' that you can run in the future to recreate the current configuration, a file `config.cache' that saves the results of its tests to speed up reconfiguring, and a file `config.log' containing compiler output (useful mainly for debugging `configure'). If you need to do unusual things to compile the package, please try to figure out how `configure' could check whether to do them, and mail diffs or instructions to the address given in the `README' so they can be considered for the next release. If at some point `config.cache' contains results you don't want to keep, you may remove or edit it. The file `configure.ac' is used to create `configure' by a program called `autoconf'. You only need `configure.ac' if you want to change it or regenerate `configure' using a newer version of `autoconf'. The simplest way to compile this package is: 1. `cd' to the directory containing the package's source code and type `./configure' to configure the package for your system. If you're using `csh' on an old version of System V, you might need to type `sh ./configure' instead to prevent `csh' from trying to execute `configure' itself. Running `configure' takes awhile. While running, it prints some messages telling which features it is checking for. 2. Type `make' to compile the package. 3. Optionally, type `make check' to run any self-tests that come with the package. 4. Type `make install' to install the programs and any data files and documentation. 5. You can remove the program binaries and object files from the source code directory by typing `make clean'. To also remove the files that `configure' created (so you can compile the package for a different kind of computer), type `make distclean'. There is also a `make maintainer-clean' target, but that is intended mainly for the package's developers. If you use it, you may have to get all sorts of other programs in order to regenerate files that came with the distribution. Compilers and Options ===================== Some systems require unusual options for compilation or linking that the `configure' script does not know about. You can give `configure' initial values for variables by setting them in the environment. Using a Bourne-compatible shell, you can do that on the command line like this: CC=c89 CFLAGS=-O2 LIBS=-lposix ./configure Or on systems that have the `env' program, you can do it like this: env CPPFLAGS=-I/usr/local/include LDFLAGS=-s ./configure Compiling For Multiple Architectures ==================================== You can compile the package for more than one kind of computer at the same time, by placing the object files for each architecture in their own directory. To do this, you must use a version of `make' that supports the `VPATH' variable, such as GNU `make'. `cd' to the directory where you want the object files and executables to go and run the `configure' script. `configure' automatically checks for the source code in the directory that `configure' is in and in `..'. If you have to use a `make' that does not supports the `VPATH' variable, you have to compile the package for one architecture at a time in the source code directory. After you have installed the package for one architecture, use `make distclean' before reconfiguring for another architecture. Installation Names ================== By default, `make install' will install the package's files in `/usr/local/bin', `/usr/local/man', etc. You can specify an installation prefix other than `/usr/local' by giving `configure' the option `--prefix=PATH'. You can specify separate installation prefixes for architecture-specific files and architecture-independent files. If you give `configure' the option `--exec-prefix=PATH', the package will use PATH as the prefix for installing programs and libraries. Documentation and other data files will still use the regular prefix. In addition, if you use an unusual directory layout you can give options like `--bindir=PATH' to specify different values for particular kinds of files. Run `configure --help' for a list of the directories you can set and what kinds of files go in them. If the package supports it, you can cause programs to be installed with an extra prefix or suffix on their names by giving `configure' the option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. Optional Features ================= Some packages pay attention to `--enable-FEATURE' options to `configure', where FEATURE indicates an optional part of the package. They may also pay attention to `--with-PACKAGE' options, where PACKAGE is something like `gnu-as' or `x' (for the X Window System). The `README' should mention any `--enable-' and `--with-' options that the package recognizes. For packages that use the X Window System, `configure' can usually find the X include and library files automatically, but if it doesn't, you can use the `configure' options `--x-includes=DIR' and `--x-libraries=DIR' to specify their locations. Specifying the System Type ========================== There may be some features `configure' can not figure out automatically, but needs to determine by the type of host the package will run on. Usually `configure' can figure that out, but if it prints a message saying it can not guess the host type, give it the `--host=TYPE' option. TYPE can either be a short name for the system type, such as `sun4', or a canonical name with three fields: CPU-COMPANY-SYSTEM See the file `config.sub' for the possible values of each field. If `config.sub' isn't included in this package, then this package doesn't need to know the host type. If you are building compiler tools for cross-compiling, you can also use the `--target=TYPE' option to select the type of system they will produce code for and the `--build=TYPE' option to select the type of system on which you are compiling the package. Sharing Defaults ================ If you want to set default values for `configure' scripts to share, you can create a site shell script called `config.site' that gives default values for variables like `CC', `cache_file', and `prefix'. `configure' looks for `PREFIX/share/config.site' if it exists, then `PREFIX/etc/config.site' if it exists. Or, you can set the `CONFIG_SITE' environment variable to the location of the site script. A warning: not all `configure' scripts look for a site script. Operation Controls ================== `configure' recognizes the following options to control how it operates. `--cache-file=FILE' Use and save the results of the tests in FILE instead of `./config.cache'. Set FILE to `/dev/null' to disable caching, for debugging `configure'. `--help' Print a summary of the options to `configure', and exit. `--quiet' `--silent' `-q' Do not print messages saying which checks are being made. `--srcdir=DIR' Look for the package's source code in directory DIR. Usually `configure' can determine that directory automatically. `--version' Print the version of Autoconf used to generate the `configure' script, and exit. `configure' also accepts some other, not widely useful, options. hugs98-plus-Sep2006/docs/building/unix.txt0000644006511100651110000002472010362036117017240 0ustar rossrossBuilding and Installing Hugs from Source ======================================== The following procedure is suggested for installation of Hugs on a Unix machine (including Linux, *BSD and MacOS X). For other systems: Windows: Precompiled binaries are provided, although similar installation procedures can be used for these machines if you have a Unix-like environment installed: see win32.txt for details. Systems without a Unix-like environment: These will be more difficult. You'll have to construct the files generated by configure (see below; those in the src/msc directory may be a useful starting point) and you'll need to convert the libraries. That will probably have to be done in a Unix-like environment. You should be able to get help on the hugs-users mailing list. Short version (for Unix-like environments): make EXTRA_CONFIGURE_OPTS=--prefix=$HOME make clean $HOME/bin/hugs $HOME/lib/hugs/demos/Say putStr (say " /Hugs") :quit Long version: 1) Choose a directory (or directories) for the Hugs files to go in. In the following, we'll assume: /usr/local/solaris/bin user executables /usr/local/solaris/lib/hugs architecture dependent files /usr/local/lib/hugs architecture independent files Check that these directories have appropriate permission settings. 2) Build Hugs and the libraries cd hugs98 make EXTRA_CONFIGURE_OPTS=--exec-prefix=/usr/local/solaris This starts by running the configure script, which runs many small tests on the compiler, preprocessor, linker, etc to determine how your system is configured. It combines this with any configuration flags to generate these files: src/Makefile -- used to control compilation src/config.h -- #included into every C file in Hugs src/options.h -- #included into every C file in Hugs libraries/Makefile -- controls conversion of libraries plus some others related to documentation, testing and examples. EXTRA_CONFIGURE_OPTS can contain any number of options to the configure script. You can omit it if there are none. Read config.txt to find out about general configuration options. Hugs-specific options are listed at the end of this file. It then builds the executables, calls the shell script libraries/tools/make_bootlib to generate a subset of the libraries in libraries/bootlib, and then calls another shell script libraries/tools/convert_libraries to convert the Haskell library packages under packages into libraries under hugsdir for use by Hugs, using the Cabal library (from the bootlib just created). (libraries/hugsbase/Hugs contains Hugs-specific modules that are also copied into hugsdir.) If all that worked, you should now have a working Hugs system, runnable in-place. Even if a few of the libraries had error, you should still have a runnable system. At this point, you might like to run a few tests to make sure everything's working: HUGSDIR=hugsdir src/hugs -- Run a few tests like 1+2, [1..], etc. Use ":quit" to exit Regression tests are run by "make check". You can also run "cd libraries; make LibStatus", which creates a file LibStatus giving the status of each module in packages -- none of them should be ERROR. 3) Install Hugs in chosen directories make install (Note that the permissions of the installed files will be affected by your "umask" setting. If you want the installed files to be world readable, you need to set umask accordingly.) Try a few simple tests: /usr/local/solaris/bin/hugs [1..10] :quit cat > echo < module Main(main) where > import System(getArgs) > > main = do { args <- getArgs; putStrLn (unwords args) } EOF chmod 755 echo ./echo Hello World Administrators of sites with multiple architectures often prefer to install a shell script in /usr/local/bin which will select an appropriate binary according to the architecture on which it is run rather than a binary. Configuration should be the same as above (use a different --bindir argument for each architecture but, if you want, save a small amount of space by using the same --datadir) and use a shell script like the following. #! /bin/sh HW_OS=${HW_OS-`/usr/local/gnu/bin/hw_os`} BINDIR=/local/lib/Hugs1.4/$HW_OS exec $BINDIR/hugs $* This kind of script would also be a good place to set system-wide default options (eg to select an editor or to switch on the "show types" option). 4) Cleanup after yourself You can now run "make clean" to delete all machine-generated files. If you ran "make install", you could delete the entire Hugs source tree - but you might want to keep the Hugs98/doc directory. Hugs specific configuration options ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --enable-ffi / --disable-ffi Provide (or not) libraries that use the Foreign Function Interface. By default, this is enabled for systems that support dynamic linking, so you don't usually need to use this option. Such systems should support static imports; "wrapper" and "dynamic" imports are also supported on most common architectures. --enable-hopengl Provide the HOpenGL libraries, a Haskell binding for OpenGL/GLUT. You will need to have the OpenGL/GLUT libraries and header files installed for this to work. On Mac OS X, if you want to use X11 instead of the "native" libraries, use --enable-hopengl=x11 --with-pthreads Build Hugs with the multi-threaded version of the C library. This is needed, for example, if you are linking to a Java virtual machine (which is multi-threaded). --enable-char-encoding --enable-char-encoding=locale --enable-char-encoding=utf8 Use a byte encoding of Chars for I/O and other system calls (as well as Haskell source): locale (or no argument): the encoding is determined by the LC_CTYPE category of the current locale. Note that the encodings in some locales cannot represent all Unicode characters. utf8: the UTF-8 encoding (which covers all of Char) is always used. Note that this option also disables readline, so the locale-based option with a UTF-8 locale may be preferable if you have recent enough libraries. You can usually omit this option, in which case locale will be used if it is available on your system. You will then need to run Hugs in an environment that supports your chosen encoding. For example (with the appropriate locale settings): UTF-8 works with glibc 2.2, xterm 4.0, bash 2.05b and readline 4.3 EUC multi-byte charsets work with multilingual wterm or rxvt Single-byte charsets work in most environments Single- and multi-byte charsets work under Win32. (The locale used is the "user-default ANSI code page", which may be set using the "Regional Options" tab of the regional and language control panel.) --enable-timer Time how long each evaluation takes. Timing is included for the purpose of benchmarking the Hugs interpreter, comparing its performance across a variety of different machines, and with other systems for similar languages. It would be somewhat foolish to try to use the timings produced in this way for any other purpose. In particular, using timings to compare the performance of different versions of an algorithm is likely to give very misleading results. The current implementation of Hugs as an interpreter, without any significant optimizations, means that there are much more significant overheads than can be accounted for by small variations in Hugs code. --enable-profiling Gather statistics about heap allocation during evaluation. Statistics are written to a file profile.hp which may be viewed using the hp2ps program. This option makes Hugs use much more memory and run much slower. The ":set -d" command can be used to reduce the time overhead by controlling the frequency with which statistics are gathered. --with-nmake Try to generate a Makefile that will work with Microsoft's nmake. --disable-large-banner Print a single-line startup banner instead of the 9 line banner. (This option will cause the "make check" regression tests to fail.) --with-gui Used when generating Hugs for Windows. Only works with Borland C++ --enable-internal-prims Enable experimental features used in Hugs.Internals --enable-stack-dumps Enable printing of the top and bottom few objects on the stack when stack overflow happens. This feature is currently (Sept'97) just a proof of concept. We welcome suggestions (and/or code) to make it useful for people who don't have an intimate knowledge of how the G machine operates. --enable-debug --enable-tag-checks --enable-lint For use when debugging Hugs. There used to be a --with-preprocessor option, enabling the use of a preprocessor for processing Haskell source files before compiling them with Hugs. It's turned on by default at the moment. To turn it off, change USE_PREPROCESSOR in src/options.h. This is an experimental feature and may change in future versions. When configured with preprocessing on, you can use the "-F" option to specify which preprocessor to use. For example, if your preprocessor is in /users/JFH/bin/hscpp, you might say :set -F"/users/JFH/bin/hscpp" If you have perl and gcc installed on your machine, the following script provides a simple cpp-like preprocessor. eval "exec perl -S $0 $*" if $running_under_some_random_shell; # # Reads CPP output and turns #line things into appropriate Haskell # pragmas. This program is derived from the "hscpp" script # distributed with the Glasgow Haskell Compiler. # $Cpp = 'gcc -E -xc -traditional'; open(INPIPE, "$Cpp @ARGV |") || die "Can't open C pre-processor pipe\n"; while () { # line directives come in flavo[u]rs: # s/^#\s*line\s+\d+$/\{\-# LINE \-\}/; IGNORE THIS ONE FOR NOW s/^#\s*line\s+(\d+)\s+(\".+\")$/\{\-# LINE \1 \2 \-\}/; s/^#\s*(\d+)\s+(\".*\").*/\{\-# LINE \1 \2 \-\}/; print $_; } close(INPIPE) || exit(1); # exit is so we reflect any errors. exit(0); Note that Hugs currently ignores the {-# LINE _ _ #-} pragmas so error messages will refer to the wrong line numbers. hugs98-plus-Sep2006/docs/building/win32.txt0000644006511100651110000001026110435076507017222 0ustar rossrossBuilding Hugs on Win32 platforms ================================ Tips and Suggestions -------------------- * Use MinGW/MSYS * If you wish to build the main .exe's using Visual Studio (which you should if you have it available), then keep two separate trees - one to compile the libraries, and a separate one to build the programs. This is because gcc generated hugs.exe etc. are needed to build the libraries and they trample each other. Building from a source snapshot ------------------------------- As the _build_ environment is Unix-slanted, you first need to have the following toolchains installed on your Windows platform: * Install the MinGW compiler toolkit (from http://www.mingw.org/). * You will also need a set of Unix tools, one of (a) MSYS and msysDTK from the MinGW site (the lighter weight alternative). Do not try to install MSYS into the same folder as MinGW, but do install msysDTK into the same folder as MSYS. (b) Cygwin (from http://www.cygwin.com/). In this case, ensure that the mingw/bin directory appears before the cygwin directories in your PATH. (That gets you the MinGW compiler instead of the Cygwin one, so the binaries you build won't require extra libraries to run.) You'll be using the shell from one of these to run the commands below. It may also be possible to use Cygwin by itself, though that will produce Cygwin-dependent binaries. 0) Get a tarball from http://cvs.haskell.org/Hugs/downloads/snapshots/ and unpack it using tar. 1) cd into the toplevel hugs98 directory. 2) Build the interpreter and libraries with foo$ make If you're building under Cygwin, you'll need to say foo$ make EXTRA_CONFIGURE_OPTS='--build=i386-pc-mingw32 --host=i386-pc-mingw32' Other configure options you might add are listed in unix.txt. 3) Test the bits: foo$ export HUGSDIR=/path/to/hugs98/hugsdir foo$ src/hugs Building from CVS ----------------- This is more flexible, but in addition to the environment above, you will need an Internet connection, CVS, darcs and * the Happy parser generator (from http://www.haskell.org/happy/) -- you can also get by without it by getting the file packages/haskell-src/Language/Haskell/Parser.hs from a source snapshot.) * the Bison parser generator (from the MinGW website). Extract it into your msys-1.0 directory using "tar zxf" (NOT WinZip), so that bison.exe ends up in your MSYS "bin" folder. Again you can also get by without this by getting the file src/parser.c from a source snapshot.) 0) Check out the Hugs sources following instructions at http://cvs.haskell.org/ 1) if 'happy' is not available via your PATH setting, you need to tell the build system where it is: foo$ export happy=/path/to/happy 2) Proceed from step 1 of the above procedure for building from snapshots. When you start from CVS, the make command will also check out the library packages and other utilities, and do extra preprocessing that is prebaked in snapshots. Using Microsoft Visual C++ -------------------------- Building the libraries needs a Unix-like environment, as described above, but once you've done that you can build the interpreter and WinHugs using MSVC. Open the project files located in msc (for the plain interpreter) and winhugs (for the GUI interface). Clicking on compile should build the projects. Driving Microsoft Visual C++ from the Command Line (out-of-date) -------------------------------------------------- (We used to invoke VC++ via nmake or make, but we haven't done this for some time.) * Building the Hugs interpreter using MSVC - To compile the interpreter using an MS VC++ compiler, you need to copy msc/{config,options,platform}.h into the src/ directory: foo$ cd /path/to/hugs98/src/ foo$ cp msc/config.h msc/options.h msc/platform.h . foo$ nmake -f msc/Makefile (Using 'make' would also work.) * Building WinHugs using MSVC - Same deal as when compiling Hugs using MSVC, but this time use the winhugs/ subdirectory: foo$ cd /path/to/hugs98/src/ foo$ cp winhugs/config.h winhugs/options.h winhugs/platform.h . foo$ nmake -f winhugs/Makefile (Using 'make' would also work.) hugs98-plus-Sep2006/docs/.cvsignore0000644006511100651110000000002007270363526015715 0ustar rossrossMakefile hugs.1 hugs98-plus-Sep2006/docs/Makefile.in0000644006511100651110000000260510464157152015770 0ustar rossross# @configure_input@ # Makefile for Documentation # (this should be a POSIX 1003.2-1992 Makefile) # Note that some documentation is in other directories. INSTALL = ../install-sh RM = @RM@ CP = @CP@ prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ datarootdir = @datarootdir@ datadir = @datadir@ mandir = @mandir@ hugsdir = @hugsdir@ all: cd users_guide; $(MAKE) all # all:: server.ps hugs.man install :: install_man # manual page install :: install_notes # Readme, etc install :: install_guide # User's Guide install_man: $(INSTALL) -d $(DESTDIR)$(mandir)/man1 $(CP) hugs.1 $(DESTDIR)$(mandir)/man1 install_notes: $(INSTALL) -d $(DESTDIR)$(hugsdir)/docs $(CP) *.txt $(DESTDIR)$(hugsdir)/docs $(CP) server.* $(DESTDIR)$(hugsdir)/docs $(CP) ../Readme $(DESTDIR)$(hugsdir) $(CP) ../License $(DESTDIR)$(hugsdir) $(CP) ../Credits $(DESTDIR)$(hugsdir) install_guide: cd users_guide; $(MAKE) install server.ps: server.dvi dvips server.dvi -o server.ps server.dvi: server.tex latex server.tex hugs.man: hugs.1 groff -Tascii -man hugs.1 | cat -s >$@ hugs.ps: hugs.1 groff -Tps -man hugs.1 >$@ clean: $(RM) *~ cd users_guide; $(MAKE) clean distclean: $(RM) server.ps server.dvi $(RM) hugs.man hugs.ps $(RM) Makefile hugs.1 cd users_guide; $(MAKE) distclean veryclean: distclean # End of Makefile hugs98-plus-Sep2006/docs/ffi-notes.txt0000644006511100651110000001241610362036117016351 0ustar rossrossNotes on the Foreign Function Interface (ffi) - 22 June 2002 N.B. The Hugs FFI implementation has changed significantly since the December 2001 release. Known limitations: o Only the ccall calling convention is supported. All others are flagged as errors. o foreign export is not implemented o foreign import wrappers are only implemented for the x86, PowerPC and Sparc architectures and has been most thoroughly tested on Windows, Linux and using gcc. It should be easy to port by any experienced assembly language programmer, especially if they first look at rts/Adjustor.c in the GHC source tree. The following information is intended for those brave souls who try to port the implementation to other architectures and can be safely ignored by everyone else. To make foreign import wrappers work for other architectures, you have to modify the function mkThunk in hugs98/src/builtin.c to generate a short sequence of machine code (and then send your fix to hugs-bugs@haskell.org for inclusion in the next release). The goal of the code is (more or less) to implement this C function rty f(ty1 a1, ... tym am) { return (*app)(s,a1, ... am); } where rty, ty1, ... tym are C types, app is a "apply" function generated by running "ffihugs +G" and "s" is a "stable pointer" to the Haskell being wrapped. The reason the function is written in machine code is: o For foreign import wrappers the function has to be generated dynamically and neither ANSI C nor any extensions we know of let you generate C functions at runtime. The alternative of invoking the C compiler and loader at runtime is not attractive. o The code has to be placed next to a data structure in memory. The data structure has this type: struct thunk_data { struct thunk_data* next; struct thunk_data* prev; HugsStablePtr stable; char code[16]; }; The next and prev pointers are used to implement a doubly-linked list used by the garbage collector to keep track of all wrapped functions. The stable pointer stores a stable pointer to the Haskell function being wrapped. This is used by the garbage collector. The code field stores the machine code. It is expected that the size will have to be changed for other architectures. o By writing in assembly/machine code, it is possible to use the same code sequence no matter what the function type is. This works because the C calling convention on most machines has the stack looking something like this (the stack grows downwards in this picture) | ... | +--------+ | argm | +--------+ ... +--------+ | arg2 | +--------+ | arg1 | +--------+ |ret_addr| +--------+ This calling convention is more or less imposed by the need to support vararg functions in C. To implement the above function, all we need to do is adjust the stack to look like this: | ... | +--------+ | argm | +--------+ ... +--------+ | arg2 | +--------+ | arg1 | +--------+ | s | +--------+ |ret_addr| +--------+ and jump to (tailcall) the start of app. On the x86, you can do this with the following code sequence: pushl (%esp) ; move the return address "up" movl s,4(%esp) ; stick the stable pointer "under" it jmp app ; tail call app On the Sparc, alignment restrictions require that we add a doubleword. On architectures with very different architectures, you can (hopefully) get things working by passing the stable pointer in a global variable or, perhaps, a callee-saves register and tweaking the "app" function (which is generated by implementForeignImportWrapper in ffi.c) to expect "s" in that variable instead of on the stack. o It is machine code instead of assembly code because we don't want to invoke an assembler and linker/loader at runtime. Having determined which assembly code sequence to use, use "as -a" (or equivalent) to view the corresponding machine code and then write C code which will insert that code into the code field of a thunk. For the x86, the code looks like this. #if defined(__i386__) /* 3 bytes: pushl (%esp) */ *pc++ = 0xff; *pc++ = 0x34; *pc++ = 0x24; /* 8 bytes: movl s,4(%esp) */ *pc++ = 0xc7; *pc++ = 0x44; *pc++ = 0x24; *pc++ = 0x04; *((HugsStablePtr*)pc)++ = s; /* 5 bytes: jmp app */ *pc++ = 0xe9; *((int*)pc)++ = (char*)app - ((char*)&(thunk->code[16])); #else ... #endif This code contains a copy of the stable pointer because it is convenient to do this on the x86. On architectures such as the Sparc where 32-bit immediate loads are more painful, it may be easier to load the copy of the stable pointer stored in the thunk - this is stored at a fixed offset from the code. Likewise, it may be convenient to add a copy of "app" to the thunk struct. hugs98-plus-Sep2006/docs/hugs.1.in0000644006511100651110000002335310347303304015353 0ustar rossross.\" @configure_input@ .TH HUGS 1 "December 2005" "" "" .ds LB @HUGSDIR@ .ds BN @BINDIR@ .ds HP @HUGSPATH@ .ds HS @HUGSSUFFIXES@ .ds VI vi .SH NAME hugs, runhugs, ffihugs \- Hugs 98, functional programming system .SH SYNOPSIS .B hugs [ .I options ] [ .I modules ] .br .B runhugs [ .I options ] .I module [ .I args ] .br .B ffihugs [ .I options ] .I module [ .I compiler_argument ] ... .SH DESCRIPTION Hugs is an interpreter for Haskell, a standard non-strict functional programming language. Hugs implements almost all of the Haskell 98 standard, except for mutually recursive modules. The name \fBHugs\fP is a mnemonic for the \fBHaskell User's Gofer System\fP. .PP The interpreter is started using the .I hugs command. After processing options, it loads the standard module \fBPrelude\fP and any other modules listed on the command line. .PP Each Haskell module is stored in a separate file. When loading a module \fIname\fP, \fIHugs\fP replaces each `\fB.\fP' in \fIname\fP with a `\fB/\fP' and looks in each of the directories on its search path (see \fB\-P\fP under \fBOPTIONS\fP) for the files \fIname\fP\fB.hs\fP and \fIname\fP\fB.lhs\fP. (The recognized suffixes may be changed using the \fB\-S\fP option, described under \fBOPTIONS\fP.) It also tries \fIname\fP as a literal filename. Files ending in "\fB.lhs\fP" are treated as literate scripts. .SH OPTIONS Some options are toggled with \fB+\fP or \fB\-\fP to turn them on or off, respectively. .SS "Language conformance" .TP .B +98 Accept only Haskell 98 (cannot be changed within \fIHugs\fP; default: on). Turning this off enables several special Hugs extensions, which are described in the \fIHugs 98 User Manual\fP. .TP .B +o Allow overlapping instances (a Hugs extension; default: off) .TP .B +O Allow unsafe overlapping instances (a Hugs extension; default: off) .TP .B +H Allow `here documents' (a Hugs extension; default: off) .SS "Module loading" .TP .B +l Treat files whose names end in neither `\fB.hs\fP' nor `\fB.lhs\fP' as literate scripts (default: off) .TP .B +\&. Print dots to show progress while loading modules (default: off) .TP .B +q Print nothing to show progress while loading modules (default: on) .TP .B +w Always show which files are loaded (default: off) .SS "Expression evaluation" .TP .B +s Print number of reductions/cells after each evaluation (default: off) .TP .B +t Print type after each evaluation (default: off) .TP .B +T Apply the Haskell defaulting rules before printing types (default: off) .TP .B +g Print number of cells recovered after each garbage collection (default: off) .TP .B +Q Qualify names when printing (default: off) .TP .B +k Show kind errors in full (default: off) .TP .B +u Use "\fBshow\fP" to display results (default: on) .TP .B +I Display results of IO programs (default: off) .SS Parameters .LP Other options (in which \fB\-\fP could be replaced by \fB+\fP, the choice making no difference) are: .TP .BI \-h num Set heap size (cannot be changed within \fIHugs\fP; default: 250K) .TP .BI \-p str Set prompt string to \fIstr\fP (default: `\fB%s> \fP'). Any \fB%s\fP in the prompt will be replaced by the current module name. .TP .BI \-r str Set repeat last expression string to \fIstr\fP (default: \fB$$\fP). .TP .BI \-P str Set search path for source files to \fIstr\fP, which should be a colon-separated list of directories. A null entry in this list will be replaced by the previous search path; a null \fIstr\fP means the default path. Any occurrence of \fB{Hugs}\fP in this string is expanded to the Hugs library directory, namely \fB\*(LB\fP. Similarly, \fB{Home}\fP is expanded to your home directory (the value of the \fBHOME\fP environment variable). An entry of the form `\fIdirectory\fP\fB/*\fP' means all the immediate subdirectories of .IR directory . The default value is .RS .IP .B \*(HP .RE .TP .BI \-S str Set the colon-separated list of source file suffixes to \fIstr\fP (default: \fB\*(HS\fP). A null entry in this list will be replaced by the previous suffix list; a null \fIstr\fP means the default list. .TP .BI \-E str Use editor setting given by \fIstr\fP (default: the value of the .B EDITOR environment variable). Any occurrences of \fB%d\fP and \fB%s\fP in the editor option are replaced by the start line number and the name of the file to be edited, respectively. A common setting is "\fI\*(VI +%d %s\fP". .TP .BI \-c num Set constraint cutoff limit in the type checker to \fInum\fP (default: 40). .TP .BI \-F cmd Set preprocessor filter for source files to \fIcmd\fP (unset by default). Instead of reading a source file directly, \fIHugs\fP will read the standard output of \fIcmd\fP run with the source file name as argument. .TP .BI \-X str The string \fIstr\fP is interpreted as an option string. This is useful, for example, for passing multiple arguments to \fBrunhugs\fP in a \fB#!\fP script. .SH COMMANDS Once the interpreter has been loaded, the following commands are available: .TP 18 \fB:load\fP [\fImodules\fP] clear all modules except the prelude, and load the specified modules. .TP \fB:also\fP \fImodules\fP read additional modules. .TP .B :reload repeat last \fBload\fP command. .TP \fB:edit\fP \fIfile\fP edit \fIfile\fP. .TP .B :edit edit last file. .TP \fB:module\fP \fImodule\fP set module for evaluating expressions. .TP \fIexpr\fP evaluate expression. .TP \fB:type\fP \fIexpr\fP print type of expression. .TP .B :? display this list of commands. .TP \fB:set\fP \fIoptions\fP set command line options. .TP .B :set help on command line options. .TP \fB:names\fP [\fIpatterns\fP] list names currently in scope matching any of the shell-style patterns. .TP \fB:info\fP \fInames\fP describe named objects. .TP \fB:browse\fP \fImodules\fP browse names exported by \fImodules\fP. .TP \fB:find\fP \fIname\fP edit file containing definition of \fIname\fP. .TP .BI :! command shell escape. .TP \fB:cd\fP \fIdir\fP change directory. .TP .B :gc force garbage collection. .TP .B :version print Hugs version. .TP .B :quit exit Hugs interpreter. .PP Any command may be abbreviated to \fB:\fIc\fR where \fIc\fP is the first character in the full name. On most systems, you can also exit from \fIHugs\fP by typing the end-of-file character (^D). .PP Note that the interrupt key (^C on most systems) can be used at any time whilst using \fIHugs\fP to abandon the process of reading in a file of function definitions or the evaluation of an expression. When the interrupt is detected, \fIHugs\fP prints the string "\fB{Interrupted!}\fP" and prints the prompt so that further commands can be entered. .SH "STANDALONE PROGRAMS" The .I runhugs command is an interpreter for an executable Hugs script, which must contain a Haskell \fBMain\fP module. For example, the executable file \fBhello\fP might contain the lines .LP .nf .RS \fB#!\*(BN/runhugs +l .sp > module Main where > main = putStr "Hello, World\\n"\fP .RE .fi .LP When this file is executed, .I runhugs will invoke the .B main function. Any arguments given on the command line will be available through .BR getArgs . .LP Note that \fB#!\fP passes only one orgument to the script. The \fB\-X\fP option may be used to get around this. .SH "C INTERFACE" On architectures that support dynamic linking, .I Hugs implements the part of the .I "Haskell 98 Foreign Function Interface" (FFI) that allows Haskell functions to call C routines. (On the x86, PowerPC and Sparc architectures, all \fBforeign import\fPs are supported; on others, only \fBstatic\fP imports are provided.) Modules containing such .B foreign declarations must be compiled using the .I ffihugs command before use with .BR hugs . Additional arguments for the C compiler may be supplied via \fIcompiler_argument\fPs. For example, suppose you have some C functions in \fBtest.c\fP and some FFI declarations for those functions in \fBTest.hs\fP and the code in \fBtest.c\fP needs to be compiled with \fB\-lm\fP. Then you would compile the module with the command .IP \fBffihugs Test.hs test.c \-lm \fP .LP which generates an object file \fBTest.so\fP. Then when \fIhugs\fP loads \fBTest.hs\fP, it will also load \fBTest.so\fP. .LP In the standard FFI, each \fBforeign import\fP declaration should name a C header file containing the prototype of the function. Because this is often cumbersome, \fBffihugs\fP provides the following additional option: .TP .BI \-i str Specify an include for the generated C file. The include string should be something that can follow "\fB#include\fP" in a C program, as in .IP \fBffihugs '-i' '-i"mydefs.h"' Test.hs test.c -lm\fP .SH ENVIRONMENT .TP .B HUGSFLAGS Additional options for \fIhugs\fP, processed before any given on the command line. .TP .B HUGSDIR The Hugs library directory (default: .BR \*(LB ). .TP .B EDITOR The default editor, if \fB\-E\fP is not given. .TP .B SHELL Used to specify the shell that is invoked by the \fB:!\fP command. .SH FILES .TP .I \*(BN/hugs executable binary. .TP .I \*(LB directory containing support files. .SH "WEB REFERENCES" .TP .I http://www.haskell.org/hugs/ The Hugs home page. .TP .I http://www.haskell.org/ The Haskell home page, including the language definition, various mailing lists and much more. .SH "SEE ALSO" Mark P. Jones et al. \fIHugs 98 User Manual\fP, June 1999. .PP \fIHugs 98 User's Guide\fP (distributed with Hugs). .PP Paul Hudak & Joseph H. Fasel. A gentle introduction to Haskell. \fIACM SIGPLAN Notices\fP, 27(5), May 1992. .PP S. Peyton Jones (editor). \fIHaskell 98 Language and Libraries: The Revised Report\fP. December 2002. .PP Manuel Chakravarty et al. .IR "Haskell 98 Foreign Function Interface 1.0", .IR "Addendum to the Haskell Report" , September 2003. .SH AUTHOR Hugs 98: Mark Jones and others, June 1999. .PP Manual page: Jonathan Bowen, modified by Gary Leavens, and then (with apologies to the original authors) by Mark Jones. Updated for Hugs 98 by Antti-Juhani Kaijanaho and Ross Paterson. Updated for the March 2005 ffihugs changes by Joseph P. Skudlarek. hugs98-plus-Sep2006/docs/libraries-notes.txt0000644006511100651110000000667410152072066017572 0ustar rossrossUsing Hugs with the new hierarchical libraries Hugs98 now uses the new, hierarchical Haskell libraries (as also provided by NHC and GHC.) This setup offers more flexibility and functionality over the flat module structure provided by Haskell 98. For example, the old library setup provides a module Parsec; in the new setup, its name is Text.ParserCombinators.Parsec but there is also a module called Parsec that merely imports and re-exports this module, so your old source code should still work. This is one major exception to this: in previous Hugs releases, the Prelude exported several names not listed in the Haskell 98 Prelude. The Prelude now complies with the Haskell 98 Report. For more details on the library transition, which affects all Haskell implementations, see http://www.haskell.org/~simonmar/libraries/libraries.html The new library setup comprises the directories {Hugs}/libraries: new hierarchical libraries, covering most of the packages base, haskell98 and haskell-src shipped with GHC 5.04 and documented at: http://www.haskell.org/ghc/docs/latest/html/base/index.html http://www.haskell.org/ghc/docs/latest/html/haskell98/index.html http://www.haskell.org/ghc/docs/latest/html/haskell-src/index.html (Unlike GHC, Hugs does not use packages: all these modules are placed in the same hierarchy.) This version also features a Haskell 98-compliant Prelude (unlike the old setup). For example, functions like isDigit are no longer exported by the Prelude. {Hugs}/oldlib: a collection of stub modules with the same names as the old Hugs modules, but implemented by importing hierarchical modules. For example there is a module MonadReader that merely imports and re-exports the hierarchical module Control.Monad.Reader. This includes the old modules documented at http://www.haskell.org/ghc/docs/5.02.3/set/book-hslibs.html With these compatibility stubs most old code should still work. However, you might well wish to use the new, longer module names in new code. Eventually the compatibility stubs will disappear. More details on the new setup: o Some modules require the -98 option. o the Hugs.* packages (in libraries/Hugs) provide Hugs-specific implementations of standard features, as well as some Hugs-only features. Any program importing them (or modules in oldlib) will not be portable to other implementations. o As noted above, the Prelude is now Haskell 98-compliant. Most of the names formerly exported are available from library modules, including Char, Ix, Numeric and Ratio. The Hugs-specific names may be accessed by importing the prelude implementation module Hugs.Prelude. o Everything under hugslib is created by the libraries/tools/convert_libraries script (so don't edit them). o To check the status of each hierarchical module, run make LibStatus o Some libraries are present, but Hugs does not implement all operations, or does not provide the same semantics as GHC: Control.Concurrent.MVar: Hugs provides only co-operative multitasking, which affects their behaviour. Also finalizers are not implemented. System.Mem.Weak: finalizers must be run explicitly. o Old versions of the Int and Word modules had lots of specific conversion functions, which are now gone. Use fromIntegral instead. o to see what's handled and what's not, have a look at the conversion script libraries/tools/convert_libraries. It's quite a kludge, but it mostly works, though there's still plenty to do. hugs98-plus-Sep2006/docs/machugs-notes.txt0000644006511100651110000000111607242503033017226 0ustar rossrossHugs 98 for MacOS ================= The MacOS version of Hugs 98 can be configured by placing a file named "Hugs Preferences" in the same same folder as the Hugs 98 application. This file may contain an arbitrary sequence of options and filenames, as they would have appeared on a Unix shell command line. Remember to adjust the overall memory allocation to Hugs 98 in the Finder if the heap size assignment is increased extensively. The following interpreter commands are not yet implemented: :! (shell escape) :e (editor escape) Please reports bugs to hugs-bugs@haskell.org. hugs98-plus-Sep2006/docs/server.html0000644006511100651110000010075007633123723016120 0ustar rossross The Hugs

Using Hugs as a "Haskell Server"

Alastair Reid
Reid Consulting (UK) Limited
alastair@reid-consulting-uk.ltd.uk
http://www.reid-consulting-uk.ltd.uk/alastair/

1  Introduction

[Warning: the Haskell server is still under development - you should expect to see changes in the server API from one release of Hugs to the next.]

Hugs is normally used as an interactive program. However, there are situations in which you want to use Hugs as a non-interactive system. Examples include:

  • writing shell scripts in Haskell
  • writing cgi scripts in Haskell
  • writing Netscape plugins to let you embed Haskell code in HTML documents (the same way that you might use Javascript or Java)

For these purposes, we provide a "Hugs Server API" which provides access to some of Hugs ' innards:

  • loading/compiling files
  • compiling expressions
  • constructing and evaluating "Graphs"

This is not enough to implement the Hugs user interface, but it's good enough for all the applications listed above. (We've done all three.)

2  Example

Here's a complete example of how to use the Hugs server. This is a simplified version of the "runhugs" program which loads a file, executes Main.main and returns the resulting exit code. (We've left out all error handling to keep things simple in this version.)


 1> #include "server.h"
 2> extern HugsServerAPI* initHugsServer Args((int,char**));
 3> 
 4> static char* hugs_argv[] = {
 5>  "runhugs",   /* program name */
 6>  "+l"         /* literate scripts as default */
 7> };
 8> static int hugs_argc = sizeof hugs_argv / sizeof hugs_argv[0];
 9> 
10> main( int argc, char** argv) 
11> {  
12>   HugsServerAPI* hugs = initHugsServer(hugs_argc,hugs_argv);     
13>   hugs->setOutputEnable(0);                                      
14>   argc--; argv++;                                                
15>   hugs->setHugsArgs(argc,argv);                                  
16>   hugs->loadFile(argv[0]);                                       
17>   hugs->lookupName("Main","main");                               
18>   exit(hugs->doIO());
19> }             

Here's what each line does:

1-2
Include the server API (included in appendix A)
4-8
Declare command line arguments used when initialising the server. These should consist of the program name (argv[0]) and a list of flags. Unlike Hugs you should not include files to load.
12
Initialise the server. This returns a "virtual function table" which is used to access all other functions in the server API. (This is described in section 3.)
13
Turn off output from the compiler. This does not affect output produced by running Haskell code.
14
Forget the first argument on the command line. On a Unix system, this will be the name of the above C program.
15
Set the values seen by the Haskell functions System.getProgName and System.getArgs.
16
Load and compile the file named on the command line.
17-18
Lookup the Haskell function Main.main (which should be defined in the file we just loaded and should have type IO ()). The value returned is used as an exit code.

3  Initialising the server

The "Hugs server" is initialised by calling initHugsServer


> HugsServerAPI* initHugsServer(
>   Int    argc,
>   String argv[]   /* command line flags (-P, etc) */
>   );

This loads the standard Prelude and the dynamic typing library (see section 8) and processes any command line flags in argv.

If initialisation succeeds, it returns a "virtual function table" containing all the other server functions you can call. That is it returns a non-null pointer to a struct of type HugsServerAPI. We'll go through these in detail in the rest of the document --- but here's the complete list:


> typedef struct _HugsServerAPI {
>     char* (*clearError     ) (void);
>     void  (*setHugsArgs    ) (int, char**);
>     int   (*getNumScripts  ) (void);
>     void  (*reset          ) (int);
>     void  (*setOutputEnable) (unsigned);
>     void  (*changeDir      ) (char*);
>     void  (*loadProject    ) (char*);     /* obsolete */
>     void  (*loadFile       ) (char*);
>     HVal  (*compileExpr    ) (char*,char*);
>         
>     void  (*lookupName     ) (char*,char*); /* push values onto stack*/
>     void  (*mkInt          ) (int);
>     void  (*mkString       ) (char*);
>         
>     void  (*apply          ) (void);      /* manipulate top of stack */
>         
>     int   (*evalInt        ) (void);      /* evaluate top of stack   */
>     char* (*evalString     ) (void);
>     int   (*doIO           ) (void);
>         
>     HVal  (*popHVal        ) (void);      /* pop stack               */
>     void  (*pushHVal       ) (HVal);      /* push back onto stack    */
>     void  (*freeHVal       ) (HVal); 
> } HugsServerAPI;

In the rest of this document, we'll assume that you've put a pointer to the "virtual function table" in a variable called hugs and we'll write things like this


> void  hugs->loadFile    (char*);

to indicate the type of hugs->loadFile.

4  Loading files

Loading files is easy enough. Simply call hugs->loadFile(<name>).


> void  hugs->loadFile    (char*);

Some programs need to be able to "unload" (or "forget") some of the Haskell files that have been loaded. Hugs maintains a "stack" of all files it has loaded. To unload some files, it pops files off the stack. The server API provides two functions for modifying the stack of files: getNumScripts tells you how large the stack is; and reset sets the stack to the required size.


> int   hugs->getNumScripts (void);
> void  hugs->reset         (int);

Typically, one writes code like this to load and execute functions from a sequence of files. Note that the standard Prelude and the module MyLibraries is only loaded once.


> HugsServerAPI* hugs = initHugsServer(hugs_argc,hugs_argv);
> hugs->loadFile("MyLibraries");
> int baseLevel = hugs->getNumScripts();
> for(int i = 1; i < argc; ++i) {
>   hugs->reset(baseLevel);
>   hugs->loadFile(argv[i]);                                       
>   hugs->lookupName("Main","main");                               
>   hugs->doIO();
> }

5  Executing Expressions

In section 2 we used lookupName to lookup "Main.main" and doIO to execute it. As you've probably guessed, lookupName leaves a "pointer" to Main.main on the stack and doIO evaluates the object found on top of the stack. Here are some of the other operations which operate on the stack:


> void  hugs->mkInt       (int);
> int   hugs->evalInt     (void);     
> 
> void  hugs->mkString    (char*);
> char* hugs->evalString  (void);  
> 
> void  hugs->apply       (void);     
> 
> void  hugs->lookupName  (char*,char*);
> int   hugs->doIO        (void);  

The new functions are as follows:

  • mkInt pushes (a representation of) an int onto the stack. evalInt evaluates the Int on top of the stack.

  • Similarily, mkString pushes (a representation of) a C string onto the stack and evalString evaluates the String on top of the stack.

  • apply pops an argument and a function off the stack (in that order) and applies the function to the argument. A typical usage is
    > hugs->lookupName("Foo","ackerman");
    > hugs->mkInt(4);
    > hugs->apply();
    > hugs->mkInt(2);
    > hugs->apply();

    Alternatively, you might define this macro
    > #define ap(f,x) f; x; hugs->apply();
     and write this
    > ap(ap( hugs->lookupName("Foo","factorial")
    >      , hugs->mkInt(4))
    >      , hugs->mkInt(2));

ToDo: The server API currently provides no way to push floats, chars, etc onto the stack. There's no real problem in adding this, but we haven't needed it yet.

6  Haskell Values

It's sometimes useful to be able to store the result of a calculation for later use. These operations allow you to pop Haskell Values off the stack, store them and later push them back onto the stack.


> HVal  hugs->popHVal     (void);     
> void  hugs->pushHVal    (HVal);     
> void  hugs->freeHVal    (HVal); 

"Haskell Values" remain valid if you load additional Haskell files and if you evaluate expressions but are invalidated by calling reset.

Warning: No check is performed to detect the use of invalid values; the result is likely to be messy.

7  Compiling Expressions

The functions described in section 5 let you evaluate almost any Haskell expression but are rather painful to use. This version of the server provides a much more convenient function which lets you compile arbitrary Haskell expressions.


> HVal  hugs->compileExpr (char*,char*);

The function compileExpr takes two arguments. The first argument is the name of the module in which to evaluate the expression. The choice of module determines which functions are in scope. The second argument is the expression itself.

Portability: The current version of the server includes the full Hugs compiler so that we can load the Prelude and other libraries. Since the compiler is included in the server, it is both cheap and easy to provide compileExpr. In future versions of the server, we'd like to be able to load precompiled versions of the Prelude and libraries and omit most of the Hugs compiler. In such a system, we would also omit compileExpr since it is possible to do most of what compileExpr does using lookupName and apply.

ToDo: compileExpr really ought to leave its result on the stack.

8  Dynamic Types

The evaluation mechanisms described above make it very easy to construct and attempt to evaluate ill-typed objects. To avert catastrophe, the server typechecks very function application. The mechanisms used to perform this typecheck are not as flexible as the Haskell type system for two reasons:

  • Typechecking is restricted to a small set of base types and type constructors. If you need to use other types, you'll need to define new instances of the Typeable class. Use the instances in appendix B as examples of how to write your own instances.
  • Typechecking is restricted to monomorphic values. Looking up a polymorphic function will always result in an error. There are two solutions:
    • Add monomorphic instances of the functions to your code. For example, if you need to use Prelude.length at 3 different types, you might write a module containing these definitions
      > length_Int :: [Int] -> Int
      > length_Int = length
      > 
      > length_Ints :: [[Int]] -> Int
      > length_Ints = length

    • Use compileExpr to lookup the values at different types
      > HVal length_Int  = hugs->compileExpr("Prelude","length :: [Int] -> Int");
      > HVal length_Ints = hugs->compileExpr("Prelude","length :: [[Int]] -> Int");

    In practice, both are equally irritating.

ToDo: If we remove compileExpr we should probably improve the dynamic typing.

9  Handling Errors

So far, we have assumed that errors almost never occur. In practice error-free execution is the norm: the standard prelude can't be found; filenames are wrong; programs contain syntax and type errors; modules don't define what they're supposed to; people look up polymorphic functions; Haskell code returns errors; etc.

The Hugs server is fairly robust: it tries to catch any errors and will not perform any further actions until the error is resolved. The function clearError is used to detect whether an error has occurred (since the last time clearError was called); to obtain any compiler output associated with the error; and to reset an "error flag".


> char* hugs->clearError (void);

All other functions in the server API return immediately if the error flag is set --- this encourages programmers to call clearError frequently and prevents the server from being totally corrupted if clearError is not used.

The output returned by clearError depends on whether or not compiler output has been redirected to a buffer using the function setOutputEnable


> void hugs->setOutputEnable (unsigned);

If compiler output has not been redirected, clearError produces a brief error message. If compiler output has not been redirected, then clearError produces an error message followed by all the output that has been collected since the last time clearError was called.

Using these features, it's possible to write a more robust version of the runhugs program given in section 2.


> static void check() {
>   char* err = hugs->clearError();
>   if (err) {
>     fprintf(stderr,"Hugs Error:\n%s\n",err);
>     fflush(stderr);
>     exit(1);
>   }
> }
> 
> main( int argc, char** argv) 
> {  
>   int exitCode;
>   HugsServerAPI* hugs = initHugsServer(hugs_argc,hugs_argv);     
>   if (NULL == hugs) {
>     fprintf(stderr,"Unable to initialise Hugs\n");
>     fflush(stderr);
>     exit(1);
>   }
>   hugs->setOutputEnable(0);                                      
>   check();
>   argc--; argv++;                                                
>   hugs->setHugsArgs(argc,argv);                                  
>   if (argc < 1) {
>     fprintf(stderr,"hugs standalone requires at least one argument\n");
>     fflush(stderr);
>     exit(1);
>   }
>   hugs->loadFile(argv[0]);                                       
>   check();
>   hugs->lookupName("Main","main");                               
>   exitCode = hugs->doIO();
>   check();
>   exit(exitCode);
> }    

A  server.h

This is the current contents of the file server.h. This is the only file you need to include into programs that use the server.


/* --------------------------------------------------------------------------
 * Definition of the Hugs server API
 *
 * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
 * All rights reserved. See NOTICE for details and conditions of use etc...
 * Hugs version 1.4, April 1997
 * ------------------------------------------------------------------------*/

#ifndef Args
# if HAVE_PROTOTYPES
#  define Args(x) x
# else
#  define Args(x) ()
# endif
#endif /* !defined Args */

typedef int HVal;     /* Haskell values are represented by stable pointers */

typedef struct _HugsServerAPI {
    char* (*clearError     ) Args((void));
    void  (*setHugsArgs    ) Args((int, char**));
    int   (*getNumScripts  ) Args((void));
    void  (*reset          ) Args((int));
    void  (*setOutputEnable) Args((unsigned));
    void  (*changeDir      ) Args((char*));
    void  (*loadProject    ) Args((char*));     /* obsolete */
    void  (*loadFile       ) Args((char*));
    HVal  (*compileExpr    ) Args((char*,char*));

    void  (*lookupName     ) Args((char*,char*)); /* push values onto stack*/
    void  (*mkInt          ) Args((int));
    void  (*mkString       ) Args((char*));

    void  (*apply          ) Args((void));      /* manipulate top of stack */

    int   (*evalInt        ) Args((void));      /* evaluate top of stack   */
    char* (*evalString     ) Args((void));
    int   (*doIO           ) Args((void));

    HVal  (*popHVal        ) Args((void));      /* pop stack               */
    void  (*pushHVal       ) Args((HVal));      /* push back onto stack    */
    void  (*freeHVal       ) Args((HVal)); 
} HugsServerAPI;

/* type of "initHugsServer" function */
typedef HugsServerAPI *(*HugsServerInitFun) Args((int, char**));

/* ------------------------------------------------------------------------*/

B  The Dynamic module


module Dynamic
   ( Typeable(typeOf),
   , Dynamic, toDynamic, fromDynamic, dynApply,
   , fromDyn, dynApp,                          
   , intToDyn, fromDynInt, strToDyn, fromDynStr,
   , Tycon(..), Type(..)
   ) where

----------------------------------------------------------------
-- Dynamics
----------------------------------------------------------------

data Dynamic = ...

-- The core functions
toDynamic   :: Typeable a => a -> Dynamic
fromDynamic :: Typeable a => Dynamic -> Maybe a
dynApply    :: Dynamic -> Dynamic -> Maybe Dynamic

-- special cases
fromDyn     :: Typeable a => Dynamic -> a
intToDyn    :: Int    -> Dynamic
strToDyn    :: String -> Dynamic
fromDynInt  :: Dynamic -> Int
fromDynStr  :: Dynamic -> String
runDyn      :: Dynamic -> IO ()
dynApp      :: Dynamic -> Dynamic -> Dynamic

----------------------------------------------------------------
-- Types
----------------------------------------------------------------

data Tycon = Tycon String     deriving Eq
data Type  = App Tycon [Type] deriving Eq

unitTC    = Tycon "()"
intTC     = Tycon "Int"
integerTC = Tycon "Integer"
floatTC   = Tycon "Float"
doubleTC  = Tycon "Double"
charTC    = Tycon "Char"
ioTC      = Tycon "IO"
funTC     = Tycon "->"
listTC    = Tycon "[]"
tup2TC    = Tycon "(,)"

class Typeable a where typeOf :: a -> Type

-- Constant Tycons are easy

instance Typeable ()      where typeOf x = App unitTC    []
instance Typeable Int     where typeOf x = App intTC     []
instance Typeable Integer where typeOf x = App integerTC []
instance Typeable Float   where typeOf x = App floatTC   []
instance Typeable Double  where typeOf x = App doubleTC  []
instance Typeable Char    where typeOf x = App charTC    []

-- Non-constant Tycons require sneakiness

instance Typeable a => Typeable (IO a) where 
  typeOf m = 
    case unsafePerformIO m of { r ->
    App ioTC  [typeOf r]
    }

instance (Typeable a, Typeable b) => Typeable (a -> b) where
  typeOf f = 
    -- We use case to bind arg and result to avoid excess polymorphism
    case undefined of { arg ->
    case f arg     of { result ->
    App funTC [typeOf arg, typeOf result]
    }}

instance Typeable a => Typeable [a] where
  typeOf xs = App listTC [typeOf (head xs)]

instance (Typeable a, Typeable b) => Typeable (a,b) where
  typeOf p = App tup2TC [typeOf (fst p), typeOf (snd p)]

hugs98-plus-Sep2006/docs/server.tex0000644006511100651110000005522707743000202015750 0ustar rossross\documentstyle[11pt]{article} % copied from the Haskore tutorial \textheight=8.5in \textwidth=6.5in \topmargin=-.3in \oddsidemargin=0in \evensidemargin=0in \parskip=6pt plus2pt minus2pt % and some of my own personal preferences \parindent=0in \newcommand{\var}[1]{{\tt #1\/}} % variables \newcommand{\fun}[1]{{\tt #1\/}} % functions \newcommand{\expr}[1]{{\tt #1\/}} % expressions \newcommand{\type}[1]{{\tt #1\/}} % types \newcommand{\class}[1]{{\tt #1\/}} % classes \newcommand{\module}[1]{{\tt #1\/}} % modules \newcommand{\tva}{$\alpha$} % type variables \newcommand{\tvb}{$\beta $} \newcommand{\tvc}{$\gamma$} \newcommand{\arrow}{$\enspace\to\enspace$} % type constructors \newcommand{\Hugs}{{\bf Hugs\/}} \newcommand{\GHC}{{\bf GHC\/}} \newcommand{\Haskell}{{\bf Haskell\/}} \newcommand{\cexpr}[1]{{\tt #1\/}} % C expressions \newcommand{\ctype}[1]{{\tt #1\/}} % C types \newcommand{\cvar}[1]{{\tt #1\/}} % C variables \newcommand{\cfun}[1]{{\tt #1\/}} % C functions \newcommand{\cfile}[1]{{\tt #1\/}} % C files (.c, .h, etc) \newenvironment{aside}{% \medbreak \noindent {\bf Aside: } \begingroup \sl \begin{indent} % why doesn't this do what I expect? }{% \end{indent} \endgroup \par {\bf End aside.} \medbreak } \newenvironment{note}{% \medbreak \noindent {\bf Note: } \begingroup \sl \begin{indent} % why doesn't this do what I expect? }{% \end{indent} \endgroup \par {\bf End note.} \medbreak } \newcommand{\Portability}[1]{\par{{\bf Portability Note:} \sl #1}\par} \newcommand{\Warning}[1]{\par{{\bf Warning:} \sl #1}\par} % These are used for reminders, communication between authors, etc. % There should be no calls to these guys in the final document. \newcommand{\HeyPaul}[1]{\par{{\bf Hey Paul:} \sl #1}\par} \newcommand{\ToDo}[1]{\par{{\bf ToDo:} \sl #1}\par} \newenvironment{outline}{% \medbreak \noindent {\bf Outline: } \begingroup \nobreak \sl }{% \endgroup \nobreak {\bf End outline.} \medbreak } % Here's how you create figures % % \begin{figure*} % \centerline{ % Foo % } % \caption{...} % \label{...} % \end{figure*} \begin{document} \title{% Using \Hugs{} as a ``Haskell server'' } \author{Alastair Reid\\ Reid Consulting (UK) Limited\\ {\tt alastair@reid-consulting-uk.ltd.uk}\\ {\tt http://www.reid-consulting-uk.ltd.uk/alastair/}} \date{22 June, 2002} \maketitle %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Introduction}\label{introduction} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% [Warning: the Haskell server is still under development - you should expect to see changes in the server API from one release of \Hugs{} to the next.] \Hugs{} is normally used as an interactive program. However, there are situations in which you want to use \Hugs{} as a non-interactive system. Examples include: \begin{itemize} \item writing shell scripts in Haskell \item writing cgi scripts in Haskell \item writing Netscape plugins to let you embed Haskell code in HTML documents (the same way that you might use Javascript or Java) \end{itemize} For these purposes, we provide a "\Hugs{} Server API" which provides access to some of \Hugs{}' innards: \begin{itemize} \item loading/compiling files \item compiling expressions \item constructing and evaluating ``Graphs'' \end{itemize} This is not enough to implement the \Hugs{} user interface, but it's good enough for all the applications listed above. (We've done all three.) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Example}\label{example} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Here's a complete example of how to use the \Hugs{} server. This is a simplified version of the ``runhugs'' program which loads a file, executes \fun{Main.main} and returns the resulting exit code. (We've left out all error handling to keep things simple in this version.) \begin{verbatim} 1> #include "server.h" 2> extern HugsServerAPI* initHugsServer Args((int,char**)); 3> 4> static char* hugs_argv[] = { 5> "runhugs", /* program name */ 6> "+l" /* literate scripts as default */ 7> }; 8> static int hugs_argc = sizeof hugs_argv / sizeof hugs_argv[0]; 9> 10> main( int argc, char** argv) 11> { 12> HugsServerAPI* hugs = initHugsServer(hugs_argc,hugs_argv); 13> hugs->setOutputEnable(0); 14> argc--; argv++; 15> hugs->setHugsArgs(argc,argv); 16> hugs->loadFile(argv[0]); 17> hugs->lookupName("Main","main"); 18> exit(hugs->doIO()); 19> } \end{verbatim} Here's what each line does: \begin{description} \item[1-2] Include the server API (included in appendix~\ref{server.c}) \item[4-8] Declare command line arguments used when initialising the server. These should consist of the program name (\cexpr{argv[0]}) and a list of flags. Unlike \Hugs{} you should not include files to load. \item[12] Initialise the server. This returns a ``virtual function table'' which is used to access all other functions in the server API. (This is described in section~\ref{initHugs}.) \item[13] Turn off output from the compiler. This does not affect output produced by running Haskell code. \item[14] Forget the first argument on the command line. On a Unix system, this will be the name of the above C program. \item[15] Set the values seen by the Haskell functions \fun{System.getProgName} and \fun{System.getArgs}. \item[16] Load and compile the file named on the command line. \item[17-18] Lookup the Haskell function \fun{Main.main} (which should be defined in the file we just loaded and should have type \type{IO ()}). The value returned is used as an exit code. \end{description} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Initialising the server}\label{initHugs} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The ``Hugs server'' is initialised by calling \cfun{initHugsServer} \begin{verbatim} > HugsServerAPI* initHugsServer( > Int argc, > String argv[] /* command line flags (-P, etc) */ > ); \end{verbatim} This loads the standard Prelude and the dynamic typing library (see section~\ref{dynamic}) and processes any command line flags in argv. If initialisation succeeds, it returns a ``virtual function table'' containing all the other server functions you can call. That is it returns a non-null pointer to a struct of type \ctype{HugsServerAPI}. We'll go through these in detail in the rest of the document --- but here's the complete list: \begin{verbatim} > typedef struct _HugsServerAPI { > char* (*clearError ) (void); > void (*setHugsArgs ) (int, char**); > int (*getNumScripts ) (void); > void (*reset ) (int); > void (*setOutputEnable) (unsigned); > void (*changeDir ) (char*); > void (*loadProject ) (char*); /* obsolete */ > void (*loadFile ) (char*); > HVal (*compileExpr ) (char*,char*); > > void (*lookupName ) (char*,char*); /* push values onto stack*/ > void (*mkInt ) (int); > void (*mkString ) (char*); > > void (*apply ) (void); /* manipulate top of stack */ > > int (*evalInt ) (void); /* evaluate top of stack */ > char* (*evalString ) (void); > int (*doIO ) (void); > > HVal (*popHVal ) (void); /* pop stack */ > void (*pushHVal ) (HVal); /* push back onto stack */ > void (*freeHVal ) (HVal); > } HugsServerAPI; \end{verbatim} In the rest of this document, we'll assume that you've put a pointer to the ``virtual function table'' in a variable called \cvar{hugs} and we'll write things like this \begin{verbatim} > void hugs->loadFile (char*); \end{verbatim} to indicate the type of \cfun{hugs->loadFile}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Loading files}\label{loading files} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Loading files is easy enough. Simply call \cexpr{hugs->loadFile()}. \begin{verbatim} > void hugs->loadFile (char*); \end{verbatim} Some programs need to be able to ``unload'' (or ``forget'') some of the Haskell files that have been loaded. \Hugs{} maintains a ``stack'' of all files it has loaded. To unload some files, it pops files off the stack. The server API provides two functions for modifying the stack of files: \cfun{getNumScripts} tells you how large the stack is; and \cfun{reset} sets the stack to the required size. \begin{verbatim} > int hugs->getNumScripts (void); > void hugs->reset (int); \end{verbatim} Typically, one writes code like this to load and execute functions from a sequence of files. Note that the standard Prelude and the module \module{MyLibraries} is only loaded once. \begin{verbatim} > HugsServerAPI* hugs = initHugsServer(hugs_argc,hugs_argv); > hugs->loadFile("MyLibraries"); > int baseLevel = hugs->getNumScripts(); > for(int i = 1; i < argc; ++i) { > hugs->reset(baseLevel); > hugs->loadFile(argv[i]); > hugs->lookupName("Main","main"); > hugs->doIO(); > } \end{verbatim} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Executing Expressions}\label{evaluating} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In section~\ref{example} we used \cfun{lookupName} to lookup \cexpr{"Main.main"} and \cfun{doIO} to execute it. As you've probably guessed, \cfun{lookupName} leaves a ``pointer'' to \fun{Main.main} on the stack and \cfun{doIO} evaluates the object found on top of the stack. Here are some of the other operations which operate on the stack: \begin{verbatim} > void hugs->mkInt (int); > int hugs->evalInt (void); > > void hugs->mkString (char*); > char* hugs->evalString (void); > > void hugs->apply (void); > > void hugs->lookupName (char*,char*); > int hugs->doIO (void); \end{verbatim} The new functions are as follows: \begin{itemize} \item \cfun{mkInt} pushes (a representation of) an \ctype{int} onto the stack. \cfun{evalInt} evaluates the \type{Int} on top of the stack. \item Similarily, \cfun{mkString} pushes (a representation of) a C string onto the stack and \cfun{evalString} evaluates the \type{String} on top of the stack. \item \cfun{apply} pops an argument and a function off the stack (in that order) and applies the function to the argument. A typical usage is \begin{verbatim} > hugs->lookupName("Foo","ackerman"); > hugs->mkInt(4); > hugs->apply(); > hugs->mkInt(2); > hugs->apply(); \end{verbatim} Alternatively, you might define this macro \begin{verbatim} > #define ap(f,x) f; x; hugs->apply(); \end{verbatim} and write this \begin{verbatim} > ap(ap( hugs->lookupName("Foo","factorial") > , hugs->mkInt(4)) > , hugs->mkInt(2)); \end{verbatim} \end{itemize} \ToDo{% The server API currently provides no way to push floats, chars, etc onto the stack. There's no real problem in adding this, but we haven't needed it yet.% } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Haskell Values} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% It's sometimes useful to be able to store the result of a calculation for later use. These operations allow you to pop Haskell Values off the stack, store them and later push them back onto the stack. \begin{verbatim} > HVal hugs->popHVal (void); > void hugs->pushHVal (HVal); > void hugs->freeHVal (HVal); \end{verbatim} ``Haskell Values'' remain valid if you load additional Haskell files and if you evaluate expressions but are invalidated by calling \cfun{reset}. \Warning{% No check is performed to detect the use of invalid values; the result is likely to be messy.% } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Compiling Expressions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The functions described in section~\ref{evaluating} let you evaluate almost any Haskell expression but are rather painful to use. This version of the server provides a much more convenient function which lets you compile arbitrary Haskell expressions. \begin{verbatim} > HVal hugs->compileExpr (char*,char*); \end{verbatim} The function \cfun{compileExpr} takes two arguments. The first argument is the name of the module in which to evaluate the expression. The choice of module determines which functions are in scope. The second argument is the expression itself. \Portability{% The current version of the server includes the full \Hugs{} compiler so that we can load the Prelude and other libraries. Since the compiler is included in the server, it is both cheap and easy to provide \cfun{compileExpr}. In future versions of the server, we'd like to be able to load precompiled versions of the Prelude and libraries and omit most of the \Hugs{} compiler. In such a system, we would also omit \cfun{compileExpr} since it is possible to do most of what \cfun{compileExpr} does using \cfun{lookupName} and \cfun{apply}.% } \ToDo{% \cfun{compileExpr} really ought to leave its result on the stack.% } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Dynamic Types}\label{dynamic} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The evaluation mechanisms described above make it very easy to construct and attempt to evaluate ill-typed objects. To avert catastrophe, the server typechecks every function application. The mechanisms used to perform this typecheck are not as flexible as the Haskell type system for two reasons: \begin{itemize} \item Typechecking is restricted to a small set of base types and type constructors. If you need to use other types, you'll need to define new instances of the \class{Typeable} class. Use the instances in appendix~\ref{dynamic-defn} as examples of how to write your own instances. \item Typechecking is restricted to {\em monomorphic\/} values. Looking up a polymorphic function will always result in an error. There are two solutions: \begin{itemize} \item Add monomorphic instances of the functions to your code. For example, if you need to use \fun{Prelude.length} at 3 different types, you might write a module containing these definitions \begin{verbatim} > length_Int :: [Int] -> Int > length_Int = length > > length_Ints :: [[Int]] -> Int > length_Ints = length \end{verbatim} \item Use \cfun{compileExpr} to lookup the values at different types \begin{verbatim} > HVal length_Int = hugs->compileExpr("Prelude","length :: [Int] -> Int"); > HVal length_Ints = hugs->compileExpr("Prelude","length :: [[Int]] -> Int"); \end{verbatim} \end{itemize} In practice, both are equally irritating. \end{itemize} \ToDo{% If we remove \cfun{compileExpr} we should probably improve the dynamic typing.% } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Handling Errors}\label{errors} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% So far, we have assumed that errors almost never occur. In practice error-free execution is the exception rather than the rule: the standard prelude can't be found; filenames are wrong; programs contain syntax and type errors; modules don't define what they're supposed to; people look up polymorphic functions; Haskell code returns errors; etc. The \Hugs{} server is fairly robust: it tries to catch any errors and will not perform any further actions until the error is resolved. The function \cfun{clearError} is used to detect whether an error has occurred (since the last time \cfun{clearError} was called); to obtain any compiler output associated with the error; and to reset an ``error flag''. \begin{verbatim} > char* hugs->clearError (void); \end{verbatim} All other functions in the server API return immediately if the error flag is set --- this encourages programmers to call \cfun{clearError} frequently and prevents the server from being totally corrupted if \cfun{clearError} is not used. The output returned by \cfun{clearError} depends on whether or not compiler output has been redirected to a buffer using the function \cfun{setOutputEnable} \begin{verbatim} > void hugs->setOutputEnable (unsigned); \end{verbatim} If compiler output has not been redirected, \cfun{clearError} produces a brief error message. If compiler output has not been redirected, then \cfun{clearError} produces an error message followed by all the output that has been collected since the last time \cfun{clearError} was called. Using these features, it's possible to write a more robust version of the runhugs program given in section~\ref{example}. \begin{verbatim} > static void check() { > char* err = hugs->clearError(); > if (err) { > fprintf(stderr,"Hugs Error:\n%s\n",err); > fflush(stderr); > exit(1); > } > } > > main( int argc, char** argv) > { > int exitCode; > HugsServerAPI* hugs = initHugsServer(hugs_argc,hugs_argv); > if (NULL == hugs) { > fprintf(stderr,"Unable to initialise Hugs\n"); > fflush(stderr); > exit(1); > } > hugs->setOutputEnable(0); > check(); > argc--; argv++; > hugs->setHugsArgs(argc,argv); > if (argc < 1) { > fprintf(stderr,"hugs standalone requires at least one argument\n"); > fflush(stderr); > exit(1); > } > hugs->loadFile(argv[0]); > check(); > hugs->lookupName("Main","main"); > exitCode = hugs->doIO(); > check(); > exit(exitCode); > } \end{verbatim} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \appendix %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{\cfile{server.h}}\label{server.c} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% This is the current contents of the file \cfile{server.h}. This is the only file you need to include into programs that use the server. \begin{verbatim} /* -------------------------------------------------------------------------- * Definition of the Hugs server API * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * ------------------------------------------------------------------------*/ #ifndef Args # if HAVE_PROTOTYPES # define Args(x) x # else # define Args(x) () # endif #endif /* !defined Args */ typedef int HVal; /* Haskell values are represented by stable pointers */ typedef struct _HugsServerAPI { char* (*clearError ) Args((void)); void (*setHugsArgs ) Args((int, char**)); int (*getNumScripts ) Args((void)); void (*reset ) Args((int)); void (*setOutputEnable) Args((unsigned)); void (*changeDir ) Args((char*)); void (*loadProject ) Args((char*)); /* obsolete */ void (*loadFile ) Args((char*)); HVal (*compileExpr ) Args((char*,char*)); void (*lookupName ) Args((char*,char*)); /* push values onto stack*/ void (*mkInt ) Args((int)); void (*mkString ) Args((char*)); void (*apply ) Args((void)); /* manipulate top of stack */ int (*evalInt ) Args((void)); /* evaluate top of stack */ char* (*evalString ) Args((void)); int (*doIO ) Args((void)); HVal (*popHVal ) Args((void)); /* pop stack */ void (*pushHVal ) Args((HVal)); /* push back onto stack */ void (*freeHVal ) Args((HVal)); } HugsServerAPI; /* type of "initHugsServer" function */ typedef HugsServerAPI *(*HugsServerInitFun) Args((int, char**)); /* ------------------------------------------------------------------------*/ \end{verbatim} \section{The \module{Dynamic} module}\label{dynamic-defn} \begin{verbatim} module Dynamic ( Typeable(typeOf), , Dynamic, toDynamic, fromDynamic, dynApply, , fromDyn, dynApp, , intToDyn, fromDynInt, strToDyn, fromDynStr, , Tycon(..), Type(..) ) where ---------------------------------------------------------------- -- Dynamics ---------------------------------------------------------------- data Dynamic = ... -- The core functions toDynamic :: Typeable a => a -> Dynamic fromDynamic :: Typeable a => Dynamic -> Maybe a dynApply :: Dynamic -> Dynamic -> Maybe Dynamic -- special cases fromDyn :: Typeable a => Dynamic -> a intToDyn :: Int -> Dynamic strToDyn :: String -> Dynamic fromDynInt :: Dynamic -> Int fromDynStr :: Dynamic -> String runDyn :: Dynamic -> IO () dynApp :: Dynamic -> Dynamic -> Dynamic ---------------------------------------------------------------- -- Types ---------------------------------------------------------------- data Tycon = Tycon String deriving Eq data Type = App Tycon [Type] deriving Eq unitTC = Tycon "()" intTC = Tycon "Int" integerTC = Tycon "Integer" floatTC = Tycon "Float" doubleTC = Tycon "Double" charTC = Tycon "Char" ioTC = Tycon "IO" funTC = Tycon "->" listTC = Tycon "[]" tup2TC = Tycon "(,)" class Typeable a where typeOf :: a -> Type -- Constant Tycons are easy instance Typeable () where typeOf x = App unitTC [] instance Typeable Int where typeOf x = App intTC [] instance Typeable Integer where typeOf x = App integerTC [] instance Typeable Float where typeOf x = App floatTC [] instance Typeable Double where typeOf x = App doubleTC [] instance Typeable Char where typeOf x = App charTC [] -- Non-constant Tycons require sneakiness instance Typeable a => Typeable (IO a) where typeOf m = case unsafePerformIO m of { r -> App ioTC [typeOf r] } instance (Typeable a, Typeable b) => Typeable (a -> b) where typeOf f = -- We use case to bind arg and result to avoid excess polymorphism case undefined of { arg -> case f arg of { result -> App funTC [typeOf arg, typeOf result] }} instance Typeable a => Typeable [a] where typeOf xs = App listTC [typeOf (head xs)] instance (Typeable a, Typeable b) => Typeable (a,b) where typeOf p = App tup2TC [typeOf (fst p), typeOf (snd p)] \end{verbatim} \end{document} hugs98-plus-Sep2006/docs/users-guide-windows.bat0000644006511100651110000000273610432061125020331 0ustar rossross@echo off REM Setup for running on Neil Mitchell's machine REM To run on other machines, install the appropriate things and REM Change the environment variables at the top REM REQUIRES: REM Internet Connection REM sed REM -------------------------------------------------------------------------- REM Parameter section REM xsltproc location (http://www.zlatkovic.com/libxml.en.html) set XSLTPROC=xsltproc REM Docbook location (no \ slashes, all must be /) (http://docbook.sourceforge.net/) set DOCBOOK=d:/bin/docbook-xsl-1.60.1/htmlhelp/htmlhelp.xsl REM Html Help Workshop (http://www.microsoft.com/downloads/details.aspx?familyid=00535334-c8a6-452f-9aa0-d597d16580cc&displaylang=en) set HTMLHELP="c:\Program Files\HTML Help Workshop\hhc.exe" REM -------------------------------------------------------------------------- mkdir users_guide_windows > nul pushd users_guide_windows REM First check the users guide is closed if not exist hugs98.chm goto done del hugs98.chm if not exist hugs98.chm goto done echo You have the .chm file still open, please close it first goto finished :done echo Generating HTML %XSLTPROC% %DOCBOOK% ../users_guide/users_guide.xml copy ..\users_guide\*.png *.png copy ..\users_guide\*.css *.css echo Patching HTML ren *.html *.h for %%i in (*.h) do sed "s//<link rel='stylesheet' type='text\/css' href='hugs-ug.css'><title>/" %%i > %%itml echo Generating CHM %HTMLHELP% htmlhelp.hhp ren htmlhelp.chm hugs98.chm :finished popd echo Finished ����������������������������������hugs98-plus-Sep2006/docs/winhugs-notes.txt����������������������������������������������������������0000644�0065111�0065111�00000000545�10435076202�017271� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Hugs 98 for Windows =================== Winhugs saves its configuration in Windows registry under the key HKEY_CURRENT_USER\Software\Haskell\Hugs\Winhugs <version> Most of the options can be configured through the options dialog. Documentation for Haskell and hugs can be accessed from the Help menu. Please report bugs to hugs-bugs@haskell.org. �����������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/docs/users_guide/���������������������������������������������������������������0000755�0065111�0065111�00000000000�10504340131�016220� 5����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/docs/users_guide/.cvsignore�����������������������������������������������������0000644�0065111�0065111�00000000053�07660160505�020234� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������users_guide users_guide.pdf users_guide.ps �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/docs/users_guide/Makefile.in����������������������������������������������������0000644�0065111�0065111�00000005316�10464157152�020310� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# @configure_input@ # Makefile for the Hugs 98 User's Guide # (this should be a POSIX 1003.2-1992 Makefile) INSTALL = ../../install-sh CP = @CP@ RM = @RM@ DOCBOOK2HTML = @DOCBOOK2HTML@ DOCBOOK2DVI = @DOCBOOK2DVI@ DOCBOOK2PDF = @DOCBOOK2PDF@ DOCBOOK2PS = @DOCBOOK2PS@ prefix = @prefix@ exec_prefix = @exec_prefix@ libdir = @libdir@ datarootdir = @datarootdir@ datadir = @datadir@ hugsdir = @hugsdir@ SGMLDocWays = html ROOT = users_guide XML_FILES = $(ROOT).xml faq.xml haskell98.xml hugs_ghc.xml \ hugs_only.xml introduction.xml license.xml \ miscellaneous.xml options.xml others.xml using_hugs.xml SGML_FILES = $(ROOT).sgml faq.sgml haskell98.sgml hugs_ghc.sgml \ hugs_only.sgml introduction.sgml license.sgml \ miscellaneous.sgml options.sgml others.sgml using_hugs.sgml CSS_FILE = hugs-ug.css DSL_FILE = hugs-ug.dsl IMAGE = winhugs.png # Don't use $(ROOT)/index.html, because depending on $(DOCBOOK2HTML) it # could be $(ROOT)/$(ROOT).html instead. HTML = $(ROOT)/license.html %.sgml: %.xml xml2sgml-no-cr.sed LC_ALL=C sed -f xml2sgml-no-cr.sed $*.xml >$@ all: $(SGMLDocWays) install: $(SGMLDocWays) if test -f $(HTML); \ then $(INSTALL) -d $(DESTDIR)$(hugsdir)/docs/users_guide; \ $(CP) users_guide/*.html users_guide/$(CSS_FILE) users_guide/$(IMAGE) $(DESTDIR)$(hugsdir)/docs/users_guide; \ fi for ext in dvi pdf ps;\ do if test -f $(ROOT).$$ext;\ then $(CP) $(ROOT)$$ext $(DESTDIR)$(hugsdir)/docs;\ fi;\ done clean: $(RM) $(SGML_FILES) $(RM) *~ $(RM) xml2sgml-no-cr.sed distclean: clean $(RM) $(ROOT).dvi $(ROOT).ps $(ROOT).pdf $(RM) -r $(ROOT) $(RM) Makefile veryclean: distclean # MSYS sed cannot handle carriage returns in sed scripts, # so generate one that is guaranteed not to have any. # (The wierd sed command below is a portable way of stripping CRs.) xml2sgml-no-cr.sed: xml2sgml.sed cat xml2sgml.sed | LC_ALL=C sed 's/[^ -~]//g' >$@ html: $(HTML) dvi: $(ROOT).dvi ps: $(ROOT).ps pdf: $(ROOT).pdf htmlhelp: $(ROOT).chm $(HTML): $(SGML_FILES) $(DSL_FILE) $(CSS_FILE) if test -n '$(DOCBOOK2HTML)'; then \ $(RM) -r $(ROOT); \ mkdir $(ROOT); \ $(CP) $(CSS_FILE) $(ROOT); \ $(CP) $(IMAGE) $(ROOT); \ $(DOCBOOK2HTML) --dsl $(DSL_FILE) $(ROOT).sgml; \ fi $(ROOT).dvi: $(SGML_FILES) test -z '$(DOCBOOK2DVI)' || $(DOCBOOK2DVI) $(ROOT).sgml $(ROOT).ps: $(SGML_FILES) test -z '$(DOCBOOK2PS)' || $(DOCBOOK2PS) $(ROOT).sgml $(ROOT).pdf: $(SGML_FILES) test -z '$(DOCBOOK2PDF)' || $(DOCBOOK2PDF) $(ROOT).sgml # TODO: assumes xsltproc & hhc, without checking $(ROOT).chm: $(ROOT)-htmlhelp/htmlhelp.hhp -cd $(ROOT)-htmlhelp; hhc htmlhelp.hhp test -f $@ $(ROOT)-htmlhelp/htmlhelp.hhp: $(XML_FILES) htmlhelp.xsl xsltproc htmlhelp.xsl $(ROOT).xml $(CP) $(IMAGE) $(ROOT)-htmlhelp ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/docs/users_guide/faq.xml��������������������������������������������������������0000644�0065111�0065111�00000012220�10423755531�017524� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<chapter id="faq"> <title>Frequently Asked Questions about Hugs These are some frequently asked questions about Hugs 98, and their answers. What is the correct name for Hugs? We use Hugs as a generic name for the interpreters we build. We use a name like Hugs 1.3, Hugs 1.4, or Hugs 98 if we want to identify a version of Hugs that is based on a specific version of Haskell like Haskell 1.3, Haskell 1.4, or Haskell 98. So please note that the 1.4 part in a name like Hugs 1.4 refers to the version of Haskell, and not to the version of Hugs. We use release dates to identify specific Hugs releases. For example, if you report a bug in the most recent release, be sure to mention that you observed the problem with the Hugs 98, Sep 1999 release. What is the relationship between Hugs and Gofer? Hugs is the successor to Gofer, and was originally derived from Gofer version 2.30b. But Hugs incorporates many changes and substantial enhancements, and offers much greater compatibility with Haskell. Who is responsible for Hugs? Mark P Jones (currently at OGI) wrote the original version of Hugs and wrote much of the code in the current distribution. Other Haskell teams have also contributed to Hugs; the current distribution owes much to other groups. See the latest Hugs news to find out who is doing what. How do I report a bug? First, check the list of known deviations and bugs (see ). Please report bugs either by using the bug tracking system on the Hugs development page or by sending a report to the hugs-bugs@haskell.org mailing list. If you send the bug report to an individual, you run the risk that that person is on vacation, is rushing to meet a deadline or just accidentally deletes your mail. Please say which version of Hugs you are using, on which platform, and give us enough information to duplicate the problem. Like all maintainers, we greatly appreciate short error cases. How do I enter function definitions? The Hugs prompt only accepts expressions for evaluation. You can create a file containing a Haskell module, and load that (see for details). How can I access more than one module at once? Hugs has only one current module at any time, but you can edit a module containing several imports. Why are non-exported names accessible at the command prompt? When you evaluate an expression in the interpreter, it has to use some symbol table for looking up the ids you use. What symbol table does it use? The only credible alternatives are: The export list of the current module (see ) The symbol table of the current module Hugs uses the latter (which seems more useful) but you might reasonably expect Hugs to use the export list and wonder why Hugs doesn't seem to implement abstract data types correctly when you do experiments from the command line. What happened to isAlpha, toInt, etc? The Prelude now conforms to Haskell 98, whereas in older versions it exported some additional names. To use character functions like isAlpha, you must load or import the Char module. Non-standard functions like toInt are no longer available. Does Hugs implement everything in Haskell 98? Not quite. Mutually recursive modules are not supported yet, and there are a few other minor discrepancies (see for details). Can I create executable programs with Hugs or do I always have to run programs from the development environment? The distribution includes a stand-alone version of Hugs which will load and go as well as handle command line arguments (see for details). hugs98-plus-Sep2006/docs/users_guide/haskell98.xml0000644006511100651110000003245310465137047020575 0ustar rossross Hugs <foreignphrase>vs</foreignphrase> Haskell 98 and addenda In mode, Hugs supports Haskell 98 and some standardized extensions (described by addenda to the Haskell 98 report). Haskell 98 non-compliance Hugs deviates from Haskell 98 in a few minor ways, listed here corresponding to the relevant sections of the Report. Lexical structure Restricted character set The Haskell report specifies that programs may be written using Unicode. Hugs permits Unicode in strings and comments (in the appropriate locale, see ), but identifiers are limited to the ISO8859-1 (Latin-1) subset at the moment. Limited lookahead Hugs is confused by such things as Just.if, 0xy, 0oy, 9e+y and 9.0e+y, because it doesn't look far enough ahead. Expressions Interaction of fixities with the let/lambda meta-rule Hugs doesn't use the fixity of operators until after parsing, and so fails to accept legal (but weird) Haskell 98 expressions like let x = True in x == x == True Restricted syntax for left sections In Hugs, the expression must be an fexp (or case or do). Legal expressions like (a+b+) and (a*b+) are rejected. Declarations and bindings Slight relaxation of polymorphic recursion Hugs's treatment of polymorphic recursion is less restrictive than Haskell 98 when the functions involved are mutually recursive. Consider the following example: data BalancedTree a = Zero a | Succ (BalancedTree (a,a)) zig :: BalancedTree a -> a zig (Zero a) = a zig (Succ t) = fst (zag t) zag (Zero a) = a zag (Succ t) = snd (zig t) As with many operations on non-regular (or nested) types, zig and zag need to be polymorphic in the element type. In Haskell 98, the bindings of the two functions are interdependent, and thus constitute a single binding group. When type inference is performed on this group, zig may be used at different types, because it has a user-supplied polymorphic signature. However, zag may not, and the example is rejected, unless we add an explicit type signature for zag. (It could be argued that this is a bug in Haskell 98.) In Hugs, the binding of zig depends on that of zag, but not vice versa. (The binding of zag is considered to depend only on the explicit signature of zig.) It is possible to infer a polymorphic type for zag, and from that for zig. This type matches the declared signature, so Hugs accepts this example. Relaxation of type classes Contrary to the the Report (4.3.1), Hugs allows the types of the member functions of a class C a to impose further constraints on a, as in class Foo a where op :: Num a => a -> a -> a Different implementation of the monomorphism restriction for top-level bindings For example, Hugs rejects the following example from the Haskell 98 Report, 4.5.5: module M where import List len1 = genericLength "Hello" len2 = (2*len1) :: Rational This module consists of two binding groups, containing len1 and len2 respectively. Type inference on the first (len1) triggers the monomorphism restriction, so that len1 is assigned the monomorphic type (Num a => a). The next step differs between Haskell 98 and Hugs: In Haskell 98, type inference is then performed on len2, resolving the type variable a to Rational, and the module is legal. In Hugs, the defaulting rule is applied to len1, instantiating the type variable a to Integer. Then type inference on len2 fails. Modules Implicit module header In Haskell 98, if the module header is omitted, it defaults to module Main(main) where. In Hugs it defaults to module Main where, because many people test small modules without module headers. Implicit export list In Haskell 98, a missing export list means all names defined in the current module. In Hugs, it is treated as (module M), where M is the current module. This is almost the same, differing only when an imported module is aliased as M. Type synonyms in export and import lists Hugs allows the T(..) syntax for type synonyms in export and import lists. It also allows the form T() for type synonyms in import lists. Mutually recursive modules are not supported Note that although the Haskell 98 specification of the Prelude and library modules is recursive, Hugs achieves the same effect by putting most of these definitions in a module Hugs.Prelude that these modules import. Weird treatment of (:) The Hugs prelude exports (:) as if it were an identifier, even though this is not permitted in user-defined modules. This means that Hugs incorrectly rejects the following: module Foo where import Prelude() cs = 'a':cs Predefined types and classes Rational literals lose precision In Haskell 98, a floating point literal like 1.234e-5 stands for fromRational (1234 % 100000000). In particular, if the literal is of Rational type, the fraction is exact. In Hugs such literals are stored as double precision floating point numbers before being converted to the appropriate type. If the literal is of Rational type, it usually denotes the same number, but some precision may be lost. Floating point values are printed differently Haskell 98 specifies that show for floating point numbers is the function Numeric.showFloat, but Hugs uses an internal function with slightly different semantics. Derived instances for large tuples are not supplied In Haskell 98, all tuple types are instances of Eq, Ord, Bounded, Read, and Show if all their component types are. Hugs defines these instances only for tuple types of size 5 or less (3 or less in the small Hugs configuration). File locking Hugs does not attempt attempt to enforce the multiple-reader single-writer locking on files required by Haskell 98. Thus under Hugs programs that read and write the same file at the same time may see an inconsistent state, and programs that write to the same file more than once may produce corrupt output. Under Haskell 98, both kinds of program would fail at runtime. Other bugs in Hugs Here are other known bugs in Hugs, in addition to the deviations listed above. If you find a bug that is not listed here, please report it either by using the bug tracking system on the Hugs development page or by sending email to hugs-bugs@haskell.org. Crashes on some infinite computations Normally, an infinite computation will either exhaust the Hugs heap: ERROR - Garbage collection fails to reclaim sufficient space overflow the Hugs stack: ERROR - Control stack overflow or just run indefinitely. Occasionally, depending on the relative sizes of your heap, Hugs stack and C stack, such expressions can overflow the C stack before exhausting the other two. On Unix, this usually causes a segmentation fault and causes Hugs to abort. Space leaks from top-level pattern bindings This expression runs in constant space mapM_ putStrLn (repeat "y") but this program does not: main = mapM_ putStrLn (repeat "y") This is caused by CAF-leaks — a long-standing problem for Haskell implementations. The problem is that main (a Constant Applicative Form) is being updated with an expression of the form: putChar 'y' >> putChar '\n' >> mapM_ putStrLn (repeat "y") and so on. In the former case the outer putChar expressions become garbage after use, but now they are referenced by main. Some day, we hope to fix this by using a smarter garbage collector. In the meantime, you can avoid the problem by making the troublesome CAFs non-updatable. For example, you could rewrite main as the more convoluted: main = return () >>= \ _ -> mapM_ putStrLn (repeat "y") Because the problematic expression is now inside a lambda that is not reduced, its expansion will not be reachable from main, and will thus be garbage-collected as before. Addenda to Haskell 98 These addenda describe extensions that have been standardized across haskell implementations. Foreign Function Interface The Haskell Foreign Function Interface, as described in the FFI addendum is implemented except for the following limitations: Only the ccall, stdcall and dotnet calling conventions are supported. All others are flagged as errors. foreign export is not implemented. foreign import "wrapper" is only implemented for the x86, PowerPC and Sparc architectures and has been most thoroughly tested on Windows and Linux using gcc. Modules containing foreign declarations must be compiled with ffihugs before use (see ). Hierarchical Namespace Extension The Haskell Hierarchical Namespace Extension allows dots in module names, e.g. System.IO.Error, creating a hierarchical module namespace. Hugs has supported this since the December 2001 release. When searching for the source file corresponding to a hierarchical name, Hugs replaces the dots with slashes. hugs98-plus-Sep2006/docs/users_guide/htmlhelp.xsl0000644006511100651110000000116110314323702020570 0ustar rossross book toc,title chapter title qandaset toc hugs98-plus-Sep2006/docs/users_guide/hugs-ug.css0000644006511100651110000000201210274526472020326 0ustar rossrossBODY { font-family: sans-serif; color: black; background: white } DIV.NAVHEADER, DIV.NAVFOOTER { padding-left: 3px; padding-right: 3px; background: #ddeeff } DIV.NAVHEADER TD, DIV.NAVFOOTER TD { color: #000099; font-size: 80% } H1, H2, H3, H4, .QUESTION, DIV.NAVHEADER TH { color: #000099 } H1, H2, H3, H4 { font-weight: bold } .QUESTION { font-style: italic } H1.TITLE { font-size: 200% } H1 { font-size: 150% } H2 { font-size: 130% } H3 { font-size: 115% } H4 { font-size: 100% } VAR, .FUNCTION, .SYSTEMITEM { font-family: monospace; font-style: normal } .COMMAND, .OPTION { font-family: monospace; font-weight: bold } VAR.REPLACEABLE { font-family: sans-serif; font-style: italic } PRE { font-family: monospace; border-width: 2px; border-style: outset; padding: 0.3em } BLOCKQUOTE.NOTE { border-width: 1px; border-style: solid; margin-right: 0em; padding: 0em 0.3em 0.3em } PRE.SCREEN { color: #002211; background-color: #F5FDF5 } PRE.PROGRAMLISTING { color: #442200; background-color: #FDF5E6 } hugs98-plus-Sep2006/docs/users_guide/hugs-ug.dsl0000644006511100651110000000142510151417776020327 0ustar rossross ]> (define %chapter-autolabel% #t) (define %section-autolabel% #t) (define (toc-depth nd) 3) (define %html40% #t) (define %generate-book-titlepage% #t) (define %generate-book-toc% #t) (define ($generate-chapter-toc$) #f) (define use-output-dir #t) (define %output-dir% "users_guide") (define %use-id-as-filename% #t) (define %root-filename% "index") (define %html-ext% ".html") (define %stylesheet% "hugs-ug.css") hugs98-plus-Sep2006/docs/users_guide/hugs-ug.xsl0000644006511100651110000000135310313644535020346 0ustar rossross book toc,title chapter title qandaset toc hugs98-plus-Sep2006/docs/users_guide/hugs_ghc.xml0000644006511100651110000006520210346535431020553 0ustar rossross Language extensions supported by Hugs and GHC These experimental features are enabled with the option. Most are described in Section 7 of the Hugs 98 User Manual. Those described in this chapter are also supported by GHC with appropriate options, though in some cases the GHC versions are more general. Syntactic extensions Recursive do-notation The recursive do-notation (also known as mdo-notation) is implemented as described in: A recursive do for Haskell, Levent Erkök and John Launchbury, Haskell Workshop 2002, pages: 29–37. Pittsburgh, Pennsylvania. The do-notation of Haskell does not allow recursive bindings, that is, the variables bound in a do-expression are visible only in the textually following code block. Compare this to a let-expression, where bound variables are visible in the entire binding group. It turns out that several applications can benefit from recursive bindings in the do-notation, and this extension provides the necessary syntactic support. Here is a simple (yet contrived) example: As you can guess justOnes will evaluate to Just [1,1,1,... The Control.Monad.Fix module introduces the MonadFix class, defined as class Monad m => MonadFix m where mfix :: (a -> m a) -> m a The function mfix dictates how the required recursion operation should be performed. If recursive bindings are required for a monad, then that monad must be declared an instance of the MonadFix class. For details, see the above mentioned reference. The Control.Monad.Fix module also defines instances of MonadFix for lists, Maybe and IO. Furthermore, several other monad modules provide instances of the MonadFix class, including the Control.Monad.ST and Control.Monad.ST.Lazy modules for Haskell's internal state monad (strict and lazy, respectively). There are three important points in using the recursive-do notation: The recursive version of the do-notation uses the keyword mdo (rather than do). You should import Control.Monad.Fix. Hugs should be started with the flag . The web page: http://www.cse.ogi.edu/PacSoft/projects/rmb contains up to date information on recursive monadic bindings. Historical note The old implementation of the mdo-notation (and most of the existing documents) used the name MonadRec for the class and the corresponding library. Parallel list comprehensions (a.k.a. zip-comprehensions) Parallel list comprehensions are a natural extension to list comprehensions. List comprehensions can be thought of as a nice syntax for writing maps and filters. Parallel comprehensions extend this to include the zipWith family. A parallel list comprehension has multiple independent branches of qualifier lists, each separated by a | symbol. For example, the following zips together two lists: The behavior of parallel list comprehensions follows that of zip, in that the resulting list will have the same length as the shortest branch. We can define parallel list comprehensions by translation to regular comprehensions. Given a parallel comprehension of the form: This will be translated to: where zipN is the appropriate zip for the given number of branches. These functions must be in scope; the Prelude defines zip and zip3, but if you want to handle 4 or more lists in parallel, you will need to import List or Data.List. Type class extensions More flexible contexts In Haskell 98, contexts consist of class constraints on type variables applied to zero or more types, as in f :: (Functor f, Num (f Int)) => f String -> f Int -> f Int In class and instance declarations only type variables may be constrained. With the option, any type may be constrained by a class, as in g :: (C [a], D (a -> b)) => [a] -> b Classes are not limited to a single argument either (see ). More flexible instance declarations In Haskell 98, instances may only be declared for a data or newtype type constructor applied to type variables. With the option, any type may be made an instance: instance Monoid (a -> a) where ... instance Show (Tree Int) where ... instance MyClass a where ... instance C String where This relaxation, together with the relaxation of contexts mentioned above, makes the checking of constraints undecidable in general (because you can now code arbitrary Prolog programs using instances). To ensure that type checking terminates, Hugs imposes a limit on the depth of constraints it will check, and type checking fails if this limit is reached. You can raise the limit with the option, but such a failure usually indicates that the type checker wasn't going to terminate for the particular constraint problem you set it. Note that GHC implements a different solution, placing syntactic restrictions on instances to ensure termination, though you can also turn these off, in which case a depth limit like that in Hugs is used. Overlapping instances With the relaxation on the form of instances discussed in the previous section, it seems we could write class C a where c :: a instance C (Bool,a) where ... instance C (a,Char) where ... but then in the expression c :: (Bool,Char), either instance could be chosen. For this reason, overlapping instances are forbidden: ERROR "Test.hs":4 - Overlapping instances for class "C" *** This instance : C (a,Char) *** Overlaps with : C (Bool,a) *** Common instance : C (Bool,Char) However if the option is set, they are permitted when one of the types is a substitution instance of the other (but not equivalent to it), as in class C a where toString :: a -> String instance C [Char] where ... instance C a => C [a] where ... Now for the type [Char], the first instance is used; for any type [t], where t is a type distinct from Char, the second instance is used. Note that the context plays no part in the acceptability of the instances, or in the choice of which to use. The above analysis omitted one case, where the type t is a type variable, as in f :: C a => [a] -> String f xs = toString xs We cannot decide which instance to choose, so Hugs rejects this definition. However if the option is set, this declaration is accepted, and the more general instance is selected, even though this will be the wrong choice if f is later applied to a list of Char. Hugs used to have a option (for multi-instance resolution, if Hugs was compiled with MULTI_INST set), which accepted more overlapping instances by deferring the choice between them, but it is currently broken. Sometimes one can avoid overlapping instances. The particular example discussed above is similar to the situation described by the Show class in the Prelude. However there overlapping instances are avoided by adding the method showList to the class. Multiple parameter type classes In Haskell 98, type classes have a single parameter; they may be thought of as sets of types. In Hugs, they may have one or more parameters, corresponding to relations between types, e.g. class Isomorphic a b where from :: a -> b to :: b -> a Functional dependencies Multiple parameter type classes often lead to ambiguity. Functional dependencies (inspired by relational databases) provide a partial solution, and were introduced in Type Classes with Functional Dependencies, Mark P. Jones, In Proceedings of the 9th European Symposium on Programming, LNCS vol. 1782, Springer 2000. Functional dependencies are introduced by a vertical bar: class MyClass a b c | a -> b where This says that the b parameter is determined by the a parameter; there cannot be two instances of MyClass with the same first parameter and different second parameters. The type inference system then uses this information to resolve many ambiguities. You can have several dependencies: class MyClass a b c | a -> b, a -> c where This example could also be written class MyClass a b c | a -> b c where Similarly more than one type parameter may appear to the left of the arrow: class MyClass a b c | a b -> c where This says that the c parameter is determined by the a and b parameters together; there cannot be two instances of MyClass with the same first and second parameters, but different third parameters. Quantified types Rank 2 types In Haskell 98, all type signatures are implicitly universally quantified at the outer level, for example id :: a -> a Variables bound with a let or where may be polymorphic, as in let f x = x in (f True, f 'a') but function arguments may not be: Haskell 98 rejects g f = (f True, f 'a') However, with the , the function g may be given the signature g :: (forall a. a -> a) -> (Bool, Char) This is called a rank 2 type, because a function argument is polymorphic, as indicated by the forall quantifier. Now the function g may be applied to expression whose generalized type is at least as general as that declared. In this particular example the choice is limited: we can write g id g undefined g (const undefined) or various equivalent forms g (\x -> x) g (id . id . id) g (id id id) There are a number of restrictions on such functions: Functions that take polymorphic arguments must be given an explicit type signature. In the definition of the function, polymorphic arguments must be matched, and can only be matched by a variable or wildcard (_) pattern. When such functions are used, the polymorphic arguments must be supplied: you can't just use g on its own. GHC, which supports arbitrary rank polymorphism, is able to relax some of these restrictions. Hugs reports an error if a type variable in a forall is unused in the enclosed type. An important application of rank 2 types is the primitive runST :: (forall s. ST s a) -> a in the module Control.Monad.ST. Here the type signature ensures that objects created by the state monad, whose types all refer to the parameter s, are unused outside the application of runST. Thus to use this module you need the option. Also, from the restrictions above, it follows that runST must always be applied to its polymorphic argument. Hugs does not permit either of myRunST :: (forall s. ST s a) -> a myRunST = runST f x = runST $ do ... return y (though GHC does). Instead, you can write myRunST :: (forall s. ST s a) -> a myRunST x = runST x f x = runST (do ... return y) Polymorphic components Similarly, components of a constructor may be polymorphic: newtype List a = MkList (forall r. r -> (a -> r -> r) -> r) newtype NatTrans f g = MkNT (forall a. f a -> g a) data MonadT m = MkMonad { my_return :: forall a. a -> m a, my_bind :: forall a b. m a -> (a -> m b) -> m b } So that the constructors have rank 2 types: MkList :: (forall r. r -> (a -> r -> r) -> r) -> List a MkNT :: (forall a. f a -> g a) -> NatTrans f g MkMonad :: (forall a. a -> m a) -> (forall a b. m a -> (a -> m b) -> m b) -> MonadT m As with functions having rank 2 types, such a constructor must be supplied with any polymorphic arguments when it is used in an expression. The record update syntax cannot be used with records containing polymorphic components. Existential quantification It is also possible to have existentially quantified constructors, somewhat confusingly also specified with forall, but before the constructor, as in data Accum a = forall s. MkAccum s (a -> s -> s) (s -> a) This type describes objects with a state of an abstract type s, together with functions to update and query the state. The forall is somewhat motivated by the polymorphic type of the constructor MkAccum, which is s -> (a -> s -> s) -> (s -> a) -> Accum a because it must be able to operate on any state. Some sample values of the Accum type are: adder = MkAccum 0 (+) id averager = MkAccum (0,0) (\x (t,n) -> (t+x,n+1)) (uncurry (/)) Unfortunately, existentially quantified constructors may not contain named fields. You also can't use deriving with existentially quantified types. When we match against an existentially quantified constructor, as in runAccum (MkAccum s add get) [] = ?? we do not know the type of s, only that add and get take arguments of the same type as s. So our options are limited. One possibility is runAccum (MkAccum s add get) [] = get s Similarly we can also write runAccum (MkAccum s add get) (x:xs) = runAccum (MkAccum (add x v) add get) xs This particular application of existentials – modelling objects – may also be done with a Haskell 98 recursive type: data Accum a = MkAccum { add_value :: a -> Accum a, get_value :: a} but other applications do require existentials. Type annotations in patterns Haskell 98 allows expressions to be annotated with type signatures. With the option, these annotations are also allowed on patterns: f (x::Int) = fromIntegral x :: Double Moreover type variables in pattern annotations are treated specially: unless the type variable is already bound (by another pattern annotation), it is universally quantified over the pattern and its scope, e.g. snoc (xs::[a]) (x::a) = xs++[x] :: [a] Occurrences of the type variable in type signatures within this scope are bound to this type variable. In the above example the second and third occurrences of a are bound by the first. This permits locally defined variables to be given signatures in situations where it would be impossible in Haskell 98: sortImage :: Ord b => (a -> b) -> [a] -> [a] sortImage (f::a->b) = sortBy cmp where cmp :: a -> a -> Ordering cmp x y = compare (f x) (f y) Note that the relationship between signature declarations and pattern annotations is asymmetrical: pattern annotations may capture type variables in signature declarations, but not vice versa. There is no connection between the type variables in the type signature of sortImage and those in its definition, but the occurrence of a in the signature of cmp is bound by the pattern (f::a->b). There are some differences with GHC's scoped type variables: In GHC, type variables bound by pattern annotations are existentially quantified, and so may be instantiated. Thus the following is accepted by GHC but not Hugs: g (xs::[a]) = xs ++ "\n" In GHC, type variables bound in the head of a class or instance declaration are bound in method definitions in the where part, but this is not the case in Hugs. GHC also allows result type signatures, where a type signature is attached to the left side of a function definition, but Hugs does not. Implicit parameters Implicit parameters are implemented as described in Implicit parameters: dynamic scoping with static types, J Lewis, MB Shields, E Meijer, J Launchbury, 27th ACM Symposium on Principles of Programming Languages (POPL'00), Boston, Jan 2000. Note however that the binding syntax in that paper, using keywords dlet and with, has been replaced by the form presented below. (Most of the following, still rather incomplete, documentation is due to Jeff Lewis.) A variable is called dynamically bound when it is bound by the calling context of a function and statically bound when bound by the callee's context. In Haskell, all variables are statically bound. Dynamic binding of variables is a notion that goes back to Lisp, but was later discarded in more modern incarnations, such as Scheme, as dynamic binding can be very confusing in an untyped language. Unfortunately typed languages, in particular Hindley-Milner typed languages like Haskell, only support static scoping of variables. However, by a simple extension to the type class system of Haskell, we can support dynamic binding. Basically, we express the use of a dynamically bound variable as a constraint on the type. These constraints lead to types of the form (?x::t') => t, which says this function uses a dynamically-bound variable ?x of type t'. For example, the following expresses the type of a sort function, implicitly parameterized by a comparison function named cmp. sort :: (?cmp :: a -> a -> Bool) => [a] -> [a] The dynamic binding constraints are just a new form of predicate in the type class system. An implicit parameter occurs in an expression using the special form ?x, where x is any valid identifier (e.g. ord ?x is a valid expression). Use of this construct also introduces a new dynamic-binding constraint in the type of the expression. For example, the following definition shows how we can define an implicitly parameterized sort function in terms of an explicitly parameterized sortBy function: sortBy :: (a -> a -> Bool) -> [a] -> [a] sort :: (?cmp :: a -> a -> Bool) => [a] -> [a] sort = sortBy ?cmp Implicit-parameter type constraints Dynamic binding constraints behave just like other type class constraints in that they are automatically propagated. Thus, when a function is used, its implicit parameters are inherited by the function that called it. For example, our sort function might be used to pick out the least value in a list: least :: (?cmp :: a -> a -> Bool) => [a] -> a least xs = fst (sort xs) Without lifting a finger, the ?cmp parameter is propagated to become a parameter of least as well. With explicit parameters, the default is that parameters must always be explicitly propagated. With implicit parameters, the default is to always propagate them. An implicit-parameter type constraint differs from other type class constraints in the following way: all uses of a particular implicit parameter must have the same type. This means that the type of (?x, ?x) is (?x::a) => (a,a), and not (?x::a, ?x::b) => (a, b), as would be the case for type class constraints. You can't have an implicit parameter in the context of a class or instance declaration. For example, both these declarations are illegal: class (?x::Int) => C a where ... instance (?x::a) => Foo [a] where ... Reason: exactly which implicit parameter you pick up depends on exactly where you invoke a function. But the invocation of instance declarations is done behind the scenes by the compiler, so it's hard to figure out exactly where it is done. The easiest thing is to outlaw the offending types. Implicit-parameter constraints do not cause ambiguity. For example, consider: f :: (?x :: [a]) => Int -> Int f n = n + length ?x g :: (Read a, Show a) => String -> String g s = show (read s) Here, g has an ambiguous type, and is rejected, but f is fine. The binding for ?x at f's call site is quite unambiguous, and fixes the type a. Implicit-parameter bindings An implicit parameter is bound using the standard let or where binding forms. For example, we define the min function by binding cmp: a min = let ?cmp = (<=) in least ]]> A group of implicit-parameter bindings may occur anywhere a normal group of Haskell bindings can occur, except at top level. That is, they can occur in a let (including in a list comprehension or do-notation), or a where clause. Note the following points: An implicit-parameter binding group must be a collection of simple bindings to implicit-style variables (no function-style bindings, and no type signatures); these bindings are neither polymorphic or recursive. You may not mix implicit-parameter bindings with ordinary bindings in a single let expression; use two nested lets instead. (In the case of where you are stuck, since you can't nest where clauses.) You may put multiple implicit-parameter bindings in a single binding group; but they are not treated as a mutually recursive group (as ordinary let bindings are). Instead they are treated as a non-recursive group, simultaneously binding all the implicit parameters. The bindings are not nested, and may be re-ordered without changing the meaning of the program. For example, consider: f t = let { ?x = t; ?y = ?x+(1::Int) } in ?x + ?y The use of ?x in the binding for ?y does not see the binding for ?x, so the type of f is f :: (?x::Int) => Int -> Int hugs98-plus-Sep2006/docs/users_guide/hugs_only.xml0000644006511100651110000003736610305333432020775 0ustar rossross Hugs-specific language extensions These experimental features are unique to Hugs. Except of the debugging primitives, they require the option. Typed records with extensibility Trex is a very powerful and flexible record system. See Section 7.2 of the Hugs 98 User Manual for details. To use equality and show on extensible records, a module must import Hugs.Trex. This module also defines an empty record value and type: emptyRec :: Rec EmptyRow Restricted type synonyms Restricted type synonyms are a mechanism for defining abstract datatypes. You can achieve similar effects, and more portably, using the Haskell 98 module system. The idea is that you can say that a type synonym is transparent in the definitions of certain functions (the operations on the type), but opaque elsewhere, by writing type Table a b = [(a,b)] in empty :: Table a b, isEmpty :: Table a b -> Bool, add :: a -> b -> Table a b -> Table a b, search :: a -> Table a b -> Maybe b empty = [] isEmpty = null add a b t = (a,b):t search = lookup or equivalently type Table a b = [(a,b)] in empty, isEmpty, add, search empty :: Table a b empty = [] ... See Section 7.3.5 of the Hugs 98 User Manual for details. Here documents These expressions (named after similar things in Unix shells) are another way of writing string literals, often useful for large strings. Everything from `` to '' (including newlines and backslashes, but not $ characters) is treated as literal text, and layout is ignored. The exception is the $ character, so that you can embed the value of the variable var in the string by writing $(var). To get a literal $ character, write $$ — single $ characters are not allowed. When the option is given, the following letter name = ``Dear $(name), Here are some characters: \ ' ` ". To learn more, send $$10 to the address below.'' is equivalent the Haskell 98 declaration letter name = "Dear " ++ quote name ++ ",\n\ \Here are some characters: \\ ' ` \".\n\ \To learn more, send $10 to the address below." The function class Quote where quote :: a -> String (basically no change for String and Char, and show for everything else) comes from the Hugs.Quote module, which also defines several common instances, and should be imported if you use the $(var) form. (This module also requires the option.) Hugs debugging primitives Hugs contains support for debugging by observations inspired by the Andy Gill's Hood library: Andy Gill, Debugging Haskell by Observing Intermediate Data Structures, in Draft Proceedings of the 2000 Haskell Workshop. The Haskell Object Observation Debugger . Hood is a portable Haskell library that implements the combinator observe :: Observable a => String -> a -> a The partial application observe tag behaves exactly like the identity function, but also records the value of data to which it is applied. Any observations made are reported at the end of the computation. The tag argument is used to label the observed value when it is reported. Non-strict semantics is preserved — observe does not evaluate its second argument. HugsHood uses the same observation model but differs in a number of ways. It is much faster. This is because HugsHood is implemented within the Hugs evaluator and uses primitive builtin functions. Performance depends upon the volume of observations. More frequent observations incur a higher overhead. As a simple comparison, a test program which executed 1 million reductions and made 250 observations incurred a 625 percent overhead when observations were made with the Hood library but just 10 percent when using HugsHood. Caveat: When not using observations, the modifications to the evaluator to support HugsHood imposes an overhead of about 6 percent. It is possible to easily observe arbitrary data structures. HugsHood implements the primitive observe :: String -> a -> a which is unconstrained by the need to build instances of the Observable class for each user defined data type whose values are being observed. HugsHood uses an internal primitive function to display observed values. This may be considered both an advantage and a disadvantage: one does not need to define how to observe values, but one cannot define special user views of data. No modification to the program (apart from instrumentation with observe) is required. The Hood library must be invoked using a special IO monadic combinator to ensure that observations are collected and displayed. There are a number of minor differences in the display format which are a consequence of the Hugs implementation. These are described below. Using HugsHood Modules that use HugsHood combinators must import the module Hugs.Observe. Its only role is to provide the necessary primitive definitions, namely: primitive observe :: String -> a -> a primitive bkpt :: String -> a -> a primitive setBkpt :: String -> Bool -> IO () Breakpoints HugsHood implements breakpoints. A program can be instrumented with the bkpt function. The partial application bkpt bkpt_name behaves exactly like the identity function, except that before it returns its argument it checks if bkpt_name is enabled, and if it is the user is presented with the opportunity to view observed data. A small set of commands is available when Hugs halts due to a breakpoint: p tag_name Print observations made since the computation began. If an observation tag is suppled then only the associated observations will be displayed. Otherwise all observations will be displayed. c n Continue with program evaluation. With no arguments, evaluation will continue until another active breakpoint is encountered. The optional numeric argument will skip n active breakpoints before stopping. s bkpt_name Set a breakpoint. r bkpt_name Reset a named breakpoint or, if no breakpoint name is supplied, reset all breakpoints. A breakpoint is by default disabled. It can be enabled by using the s command in the debug breakpoint dialogue, or by using the setBkpt combinator. Clearly at least one breakpoint must be enabled using setBkpt before a breakpoint dialogue can be triggered. Breakpoint Example Here is a very simple program using the three combinators. import Hugs.Observe prog n = do { setBkpt "fib" True; putStr $ show (observe "fun" f n) } f 0 = 1 f n = n * (bkpt "fib" $ observe "fun" f (n-1)) The following sample session shows how the p and c commands can be used. prog 4 Break @ fib> p >>>>>>> Observations <<<<<< fun { \ 4 -> _ } Break @ fib> c Break @ fib> p >>>>>>> Observations <<<<<< fun { \ 4 -> _ , \ 3 -> _ } Break @ fib> c 2 Break @ fib> p >>>>>>> Observations <<<<<< fun { \ 4 -> _ , \ 3 -> _ , \ 2 -> _ , \ 1 -> _ } Break @ fib> c 24 (98 reductions, 299 cells) >>>>>>> Observations <<<<<< fun { \ 4 -> 24 , \ 3 -> 6 , \ 2 -> 2 , \ 1 -> 1 , \ 0 -> 1 } 10 observations recorded ]]> Differences from Hood HugsHood uses a similar style of display to Hood, though there are differences. One trivial difference is that Hood reports tags with a leading -- while HugsHood does not. Consider now more significant differences. Observing character strings HugsHood (and Hood) reports lists using the cons operator. observe "list" [1..3] [1,2,3] >>>>>>> Observations <<<<<< list (1 : 2 : 3 : []) ]]> This is too verbose for lists of characters, so HugsHood reports strings in the usual format: observe "string" ['a'..'d'] "abcd" >>>>>>> Observations <<<<<< string "abcd" ]]> If only the initial part of the string is evaluated, a trailing ... is reported. take 2 $ observe "string" ['a'..'d'] "ab" >>>>>>> Observations <<<<<< string "ab..." ]]> This is clearly ambiguous, because evaluating the expression observe "string" "ab..." will give the same result, but in practice the ambiguity should be easy to resolve. Unevaluated expressions The _ symbol is used to indicate an unevaluated expression. In Hood all unevaluated expressions will be displayed using _. In HugsHood, _ denotes an unevaluated expression, but not all unevaluated expressions are denoted by _. For example the expression fst $ observe "pair" (1,2) yields -- pair (1, _) in both Hugs and HugsHood. However, fst $ observe "pair" ('a','b') yields pair ('a','b') in HugsHood, and ('a', _) in Hood. This is because HugsHood (unlike Hood) does not actually record evaluation steps. It merely maintains an internal pointer to that part of the heap representing the tagged expression. If the expression in not in weak head normal form, then it obviously has not been evaluated and so it is reported as just _; otherwise it displayed. Integer constants like 1 and 2 are not in WHNF, as they must be coerced to the correct type when evaluated. Characters though are in WHNF so it is not possible to discern whether a character was evaluated. Another consequence of the HugsHood implementation by pointers rather than Hood's implementation by tracing evaluation is that the strictness behaviour of a function can be masked. Consider the example: lazy pair = let x = observe "fst" fst pair y = snd pair in (y,x) For the expression lazy (1,2) Hood reports -- fst { \ (1, _) -> 1 } while HugsHood reports fst { \ (1,2) -> 1 } HugsHood should not be used to deduce the strictness behaviour of a function, or it should be done only with caution. Interaction with the root optimisation The Hugs compiler uses an optimisation when generating code that builds expressions on the heap. If a function definition has the form f arg1 .. argN = ..... f arg1 .. argM ..... where 1 ≤ M ≤ N, then the expression graph for f arg1 .. argM is copied rather than rebuilt from individual application nodes. This interacts with the observation algorithm so that observing functions of the above form gives unexpected results. For instance consider the expression observe "fold" foldl (+) 0 [1..3] When the root optimisation is applied to the compilation of foldl, we see fold { \ primPlusInteger 6 [] -> 6 , \ { \ 3 3 -> 6 } 3 (3 : []) -> 6 , \ { \ 1 2 -> 3 } 1 (2 : 3 : []) -> 6 , \ { \ 0 1 -> 1 } 0 (1 : 2 : 3 : []) -> 6 instead of the expected fold { \ { \ 0 1 -> 1 , \ 1 2 -> 3 , \ 3 3 -> 6 } 0 (1 : 2 : 3 : []) -> 6 } The first form reports the arguments at each application of foldl, while the second reports the arguments for just the initial application (the one marked by observe). The root optimisation can be disabled using the option. This can be done from the command line or by using :s at the Hugs prompt. If you want to compile the prelude definitions without the root optimisation you must invoke Hugs with the option. Testing of execution time with and without the root optimisation for a selection of 23 benchmarks from the nofib suite has been carried out. All but 5 tests resulted in an execution time penalty of less than 3% when running without root optimisation (some even showed a very minor speedup). Known problems Hugs can produce infinite (cyclic) dictionaries when implementing overloading. The observation reporting mechanism does not detect these at present, which leads to a non-terminating report. We plan to address this in a future release. Reporting HugsHood bugs Please report bugs to Richard Watson, rwatson@usq.edu.au In particular, if the message Warning: observation sanity counter > 0 appears, and your program has not terminated abnormally, please report the error situation. hugs98-plus-Sep2006/docs/users_guide/introduction.xml0000644006511100651110000001526010143734075021504 0ustar rossross Introduction In September 1991, Mark Jones released a functional programming system called Gofer, which provided a compact, portable implementation of a Haskell-like language. The system also included experimental type system extensions, many of which later became part of Haskell. On Valentine's Day 1995, Mark released Hugs (Haskell User's Gofer System), a derivative of Gofer with greater Haskell compliance. Hugs versions are named after the version of Haskell they support; Hugs 98 was released in January 1999. Mark gave up the maintainership of Hugs in January 2000. Hugs 98 still aims to be a fairly lightweight, portable implementation, and now adheres closely to Haskell 98. It also supports several extensions shared with other Haskell implementations: Hugs supports standardized extensions (addenda) to Haskell 98, for interfacing to foreign languages and structuring the module space. With the appropriate options (see ), it is also possible to turn on a number of language extensions, most of which are also supported by the Glasgow Haskell Compiler (GHC), though some are specific to Hugs. Hugs comes with a large collection of libraries, also shared with other Haskell implementations, and described in separate documentation. Though these features make Hugs highly compatible with other implementations, it is primarily intended as interpreter and programming environment for developing Haskell programs. If your application involves large programs or speed is critical, you may strike Hugs's limitations, and may wish to try a Haskell compiler. Other sources of information Other documentation The Hugs 98 User Manual This was the definitive reference for earlier versions of Hugs, though parts of it are now out-of-date. Much of it remains relevant, particularly Section 7 on Hugs extensions, and it should be consulted in several areas that this Guide does not cover well. The manual is available in several formats: HTML, PDF, gzipped Postscript, gzipped tar-ed html, dvi, WinHelp(zipped) and HTMLHelp(win32 help format). Haskell 98 Language and Libraries: the Revised Report The definitive reference for the Haskell 98 language and standard libraries, published by Cambridge University Press, and also available online. Haskell Hierarchical Libraries A collection of libraries shared by Haskell implementations, including Hugs. comp.lang.functional FAQ General information about functional programming. More information about Haskell may be found on the Haskell home page and the Hugs home page. Mailing lists There are a number of mailing lists where people discuss Hugs and Haskell, all with archives of past postings: hugs-users This is the place for general discussion about using Hugs. hugs-bugs Use this list for reporting bugs. This is more likely to be effective than direct mail to the authors or maintainers of Hugs. We do read this mailing list – but so do many other people, who might be able to give you more appropriate or timely advice than us! Before reporting a bug, check the list of known deviations from Haskell 98 (see ). cvs-hugs Discussion of the development of Hugs takes place on this list. This list also receives commit messages from the Hugs CVS repository. haskell-cafe An informal list for chatting about Haskell. This is an ideal place for beginners to get help with Haskell, but Hugs-specific questions would be better directed at the Hugs lists. haskell A lower-volume list for more technical discussion of Haskell. Please do not post beginner questions or Hugs-specific questions to this list. There are several other Haskell-related mailing lists served by www.haskell.org. See http://www.haskell.org/mailman/listinfo/ for the full list. Some Haskell-related discussion also takes place in the Usenet newsgroup comp.lang.functional. hugs98-plus-Sep2006/docs/users_guide/license.xml0000644006511100651110000000363210143734075020405 0ustar rossross The Hugs 98 License The Hugs 98 system is Copyright © Mark P Jones, Alastair Reid, the Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, 1994–2004, All rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS AS IS AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/docs/users_guide/miscellaneous.xml0000644006511100651110000003215110504104050021605 0ustar rossross Miscellaneous Hugs 98 release history These are the release notes for the program since it was renamed Hugs 98, reflecting substantial compliance with Haskell 98 (though with numerous optional extensions). Archives of older versions of Gofer and Hugs are still available from Mark Jones's web page. January 1999 (Beta release) Headline news for this release includes: Hugs goes Haskell 98! Hugs 98 is the first released Haskell system to support the new standard for Haskell 98. Hugs goes Open Source! Hugs 98 is the first Hugs release to be distributed as Open source software. Responding to requests from users, this relaxes the conditions of use and distribution of previous releases, and will hopefully make it easier to use Hugs for a wide range of projects. This release of Hugs also merges the features of several earlier releases into one single system. This includes: The module system and dynamic linking facilities of Hugs 1.4 (June 1998); The type system extensions (multi-parameter classes, TREX, rank-2 polymorphism, existentials, etc.) of Hugs 1.3c p1 (March 1998); New features and modifications to support the draft Haskell 98 standard; A whole range of bug fixes and additions for all of the above. May 1999 This release is largely conformant with Haskell 98, including monad and record syntax, newtypes, strictness annotations, and modules. In addition, it comes packaged with the libraries defined in the most recent version of the Haskell Library Report and with extension libraries that are compatible with GHC 3.0 and later. Additional features of the system include: Import chasing: a single module may be loaded, and Hugs will chase down all imports as long as module names are the same as file names and the files are found in the current path. A simple GUI for Windows to facilitate program development. Library extensions to support concepts such as concurrency, mutable variables and arrays, monadic parsing, tracing (for debugging), graphics, and lazy state threads. A Win32 library for complete access to windows, graphics, and other important OS functionalities and a graphics library for easy access to Win32 graphics. A foreign interface mechanism to facilitate interoperability with C. November 1999 BSD-style license (replacing the Artistic License) new commands :browse and :version experimental multi-instance resolution and :xplain command functional dependencies zero parameter type classes better handling of overlapping instances various bug fixes February 2000 This is purely a bug-fix release of Hugs98 November 99. It fixes the following problems: If you defined an instance which inherited a method via a superclass, hugs would go into an infinite loop. Fortunately, most people weren't doing this (except Chris Okasaki...). There were a couple of holes in the implementation of implicit parameters (with wasn't always being scoped properly, sometimes capturing implicit parameters outside of its scope). Functional dependencies weren't being properly propagated in some cases with derived instances (instance P ... => Q ...). July 2000 This is purely a bug-fix release of Hugs98 February 2000. February 2001 This is a major release that incorporates bug fixes as well as several new features and enhancements that have been developed for Hugs over the last year. It is announced with the intention that it will remain a stable and lightweight implementation of Haskell 98 + extensions for some considerable time. A list of the most important new features looks as follows: A Foreign Function Interface closely modelled after the one provided by GHC. Built-in, Hood-like debugging support. Parallel list comprehensions, a.k.a. zip-comprehensions. A new syntax for recursive monad bindings. A new GUI under Windows that doesn't consume all CPU time. Support for the MacOS platform integrated into the main distribution. Corrections of all bugs reported for the January 2001 beta release. December 2001 The most important features of this new release are: The incompatibilities between Hugs and the Haskell Graphics Library have been fixed, and binaries for the HGL are now available on the Hugs download page. The missing standard libraries Directory, CPUTime, Time and Locale have been added along with a complete implementation of Haskell 98 IO. Hugs is now delivered with most of the hslibs libraries installed in the lib/exts/ directory. The added modules cover the Edison, Parsec, HaXml, QuickCheck, concurrent, monad and html subdirectories of hslibs. The :set command now refuses the user to set a module search path that doesn't contain the Prelude. This is to protect users from accidentally rendering their Hugs setups unusable, especially on Windows machines where the options persist in the Registry. MacOS X is now one of the supported unix ports, with pre-built binaries available on the download page. Experimental support is provided for hierarchical module names, where a module name A.B.C is mapped onto the file path A/B/C{.hs,.lhs} and appended to each of the path prefixes in HUGSPATH until the name of a readable file is found. November 2002 Feature highlights of this new release are: Much improved FFI support (contributed by Alastair Reid), bringing Hugs really very close to the Haskell FFI specification. Adoption of a significant subset of GHC's hierarchical libraries (contributed by Ross Paterson). An (allegedly) complete implementation of the Haskell98 module system (Sigbjorn Finne). Numerous bug fixes since the previous major release in Dec 2001. November 2003 There has been substantial internal restructuring. In addition to numerous bug fixes, user-visible changes include: The beginnings of a User's Guide (though still incomplete). The Double type is now double-precision on most architectures. Hugs now relies on the same hierarchical libraries as GHC and Nhc98, and provides almost all of them. For now, compatibility with the old libraries is provided by stub modules, but users are encouraged to migrate to the new libraries. Full support for imprecise exceptions (but not asynchronous ones). Most runtime errors are now reported by applying print to an Exception (formerly the built-in printer was applied to the faulty redex). Integrated .NET support (on Windows platforms). The , , , , and options and the :project command have been removed. A searchpath may include an entry of the form directory/*, meaning all the immediate subdirectories of directory (see ). March 2005 This release is primarily targeted at Unix systems to gain experience with new features. The new Cabal-based library build system has the potential to make building on Windows easier, but it's not there yet. Volunteers welcome. In addition to numerous bug fixes, user-visible changes include: The default current module is now the empty module Hugs.Base instead of the Prelude (see ). The Char type and the Char module now support Unicode as specified in the Haskell 98 Report (contributed by Dmitry Golubovsky). Character oriented I/O uses a byte encoding of characters determined by the current locale (see ). The new option can be used to group several options into one argument. This is now needed for executable runhugs scripts (using the Unix #! feature) that require two or more options (see ). The syntax of the ffihugs command has changed (see ). The and options are gone, and a new option can be used to specify include files. Hugs now has basic support for the Cabal packaging system (see ). May 2006 The default current module is now the empty module Hugs (see ). The compatibility libraries are no longer included on the default search path. You can access them by adding {Hugs}/oldlib to the search path (see ), but they will be removed in the next release. Rewritten graphical Windows interface (contributed by Neil Mitchell; see ). New :main command (contributed by Neil Mitchell). September 2006 This is a minor release fixing bugs in the May 2006 release, and including updated libraries matching those of GHC 6.6. The built-in printer is now less verbose, making pattern-match exceptions more readable. hugs98-plus-Sep2006/docs/users_guide/options.xml0000644006511100651110000007322510477376640020475 0ustar rossross Changing the behaviour of Hugs Hugs options The behaviour of Hugs may be modified by options. These are initially set to default values, and then read from the following sources in order: (Windows only) the registry under the HKEY_LOCAL_MACHINE key. (Windows only) the registry under the HKEY_CURRENT_USER key. This is where options set using the :set command are saved (see ). This step is skipped if the environment variable IGNORE_USER_REGISTRY is set, providing an emergency workaround if the settings are invalid. (Hugs for Windows only) the GUI settings. (Mac OS prior to Mac OS X) the preferences file Hugs Preferences. The environment variable HUGSFLAGS, if set. The Hugs command line. Parsing of option strings In each of the above cases except command line arguments, the string should consist of zero or more options separated by whitespace. To include a literal space in an option, either precede it with a backslash or wrap the whole option in double quotes. Double quoted options may also contain the escape sequences \ , \" and \\. Other backslashes are interpreted literally. Most options can be changed within Hugs using the :set command (see ). Hugs takes two kinds of options: Toggles like or , which start with + or - to turn them on or off, respectively. Options that set a parameter value, like str, in which - could be replaced by +, the choice making no difference. A special option is provided to allow several options in a single argument: str The string str is interpreted as an option string, in the manner described above. This is useful, for example, in some uses of runhugs (see ). Language options Accept only Haskell 98. This is on by default, and cannot be changed within Hugs. Turning this off enables several special Hugs extensions, which are described in , and the Hugs 98 User Manual. num Set the constraint cutoff limit in the type checker to num (default: 40). See . Allow certain overlapping instances (a Hugs extension; default: off). See for details. Allow certain overlapping instances (a Hugs extension; default: off). These are the same overlapping instances as accepted by , but also accepts ambiguous uses of these instances, even though this is unsafe (see ). Support here documents (named after similar things in Unix shells), another way of writing large string literals (see ). This extension is turned off by default. Module loading options Literate scripts as default (default: off). Files with names ending in .hs are always treated as ordinary Haskell, while those ending in .lhs are always treated as literate scripts. This option determines whether other files are literate scripts or not. (See for an example.) Print dots to show progress while loading modules (default: off). Print nothing to show progress while loading modules (default: on). Always show which files were loaded (default: off). cmd Preprocess source files before loading. Instead of reading a source file directly, Hugs will execute cmd with the source file name as argument, and read the standard output. This is handy for preprocessing source files with the C preprocessor, or some preprocessor implementing a language extension. However it is slower. In particular (because of the way Hugs handles imports), the preprocessor will be run twice on files that import modules that have not been loaded yet. str Set search path for source files to str, which should be a list of directories separated by colons (semicolons on Windows, DOS or Macs). A null entry in this list will be replaced by the previous search path; a null str means the default path. Any occurrences of {Hugs} in this string will be replaced by the Hugs library directory. Similarly, {Home} is expanded to your home directory. An entry of the form directory/* means all the immediate subdirectories of directory. (See for a way of using this.) On Unix, the default value is .:{Home}/lib/hugs/packages/*:/usr/local/lib/hugs/packages/*:{Hugs}/packages/* The interpreter won't let you change the search path if that would prevent it from reading the Prelude. If an entry occurs more than once in the search path, the extra copies will be removed, as searching them would be a waste of time. str Set list of filename suffixes. Normally, when you import a module M, Hugs looks for files M.hs and M.lhs in each directory in you search path. With this option, you can change this list, in a similar way to the option for the search path. By default, the suffix list is .hs:.lhs, which gives the behaviour just described. (NB: the : is the Unix separator. Windows or Macs use ; instead.) If you use -S:.xhs then the suffix list becomes .hs:.lhs:.xhs, so Hugs will look for M.hs, M.lhs and M.xhs. A null entry in this list will be replaced by the previous suffix list; a null str means the default list. The interpreter won't let you change the suffix list if that would prevent it from reading the Prelude, i.e. you must include .hs. Note also that the interpreter knows that files ending in .lhs are literate scripts; no other suffix is treated that way. This option can be useful in conjunction with the preprocessor option (). The preprocessor can examine the filename to decide what to do with the file. Specifying a source file editor str Specify the editor used by the :edit command (see ). For example, to have Hugs invoke vi to edit your files, use -Evi The argument string is actually a template string that gets expanded by Hugs, via the following rules: all occurrences of %d are replaced by the line number of where the last error occurred (if any). Please consult your editor's documentation for ways of specifying the line number. all occurrences of %s are replaced by the name of the file. If an occurrence of %s is both preceded by and followed by space, the filename is enclosed in double-quotes. all occurrences of %f are replaced by the absolute filename (provided your platform lets you find the absolute path to a file.) Most of the time, %s will be just fine, but in case your editor doesn't handle relative filenames correctly, try using %f. all occurrences of %% are replaced by %. (Win32 only): if the string is prefixed with the character &, then the invocation is asynchronous, that is, the editor process is created, but Hugs won't wait for the editor to terminate. (Win32 only): if the string is prefixed with the character !, then the invocation will be asynchronous and use the underlying command processor/shell to execute the command. If neither %s nor %f occurs within the string, then the filename is appended before invoking the editor. Here are some example editor configurations: TextPad -E"c:/Program Files/TextPad 4/textpad \"%s\"(%d)" vi and clones -E"vi +%d %s" gnuclient (for use with (X)Emacs) -E"gnuclient +%d %s" Evaluation and printing options str Set prompt string to str (default: %s> ). Any %s in str will be replaced by the current module name. str Set the string denoting the last expression to str (default: $$). Show kind errors in full (default: off). In Haskell, each type expression has a kind. These kinds do not appear in the source language, but they are checked for consistency. By default, Hugs reports such errors as an Illegal type. For example, the declaration instance Monad Int gives rise to the error ERROR "Test.hs":4 - Illegal type in class constraint However if is given, the error message is identified as a Kind error, and is expanded to include the conflicting kinds: ERROR "Test.hs":4 - Kind error in class constraint *** constructor : Int *** kind : * *** does not match : * -> * Also, when is given, the output of the :info will include kind information for classes and type constructors: Hugs> :info Monad -- constructor class with arity * -> * ... Hugs> :info Int -- type constructor with kind * Apply defaulting rules to types before printing (default: off). When printing out types, the interpreter will normally not try to simplify types by applying defaulting rules, e.g., Hugs> :t 1 1 :: Num a => a Hugs> With the option, the interpreter attempts to default types first, using the same rules as for expressions (see ): Hugs> :set +T Hugs> :t 1 1 :: Integer Hugs> Qualify names when printing (default: off). By default, the interpreter will print out names without qualifying them with their defining modules. Most of the time that's exactly what you want, but can become confusing if you re-define types and functions; the error messages not pinning down what entity it is referring to. To have the interpreter qualify the names, use . Typically, you use when resolving errors, but turn it back off again afterwards. Print the type of each expression evaluated (default: off). Normally Hugs merely prints the value of each expression evaluated: Hugs> 1+2 3 With the option, it also adds the type of the expression: Hugs> :set +t Hugs> 1+2 3 :: Integer Note that defaulting has been applied to the type of the expression in order to evaluate it, so the type differs from that reported by the :type command (assuming that the option is not used): Hugs> :type 1+2 1 + 2 :: Num a => a Use show to display results (default: on). By default, the values of expressions typed at the prompt are printed using the show member of the Show class: Hugs> [Just (2+3), Nothing] [Just 5,Nothing] You can define this function as desired for any new datatype. If the type of the expression is not an instance of the Show class, an error results: Hugs> id ERROR - Cannot find "show" function for: *** Expression : id *** Of type : a -> a With the option, a built-in printer is used instead, and this works for any type: Hugs> :set -u Hugs> id id Hugs> \x -> x v1497 Hugs> [Just (2+3), Nothing] [Just 5,Nothing] Another feature of the built-in printer is its treatment of failures (or exceptions). Normally, an exception causes immediate failure of the expression: Hugs> :set +u Hugs> 1 + 2/0 Program error: divide by zero Hugs> [1, 2 + error "foo", 3] [1, Program error: foo However the built-in printer prints the whole value, with embedded exceptions: Hugs> :set -u Hugs> [1, 2 + error "foo", 3] [1,{error "foo"},3] Sometimes a component could produce one of two or more exceptions, but the built-in printer shows only one of them: Hugs> 1 + error "foo" + error "bar" {error "foo"} Display results of IO programs (default: off). By default, an expression of IO type typed at the prompt is executed for effect, but the final value it produces is discarded. When is used, such an expression is evaluated, and then its result is printed with Prelude.print: Hugs> :set +I Hugs> (return 'a' :: IO Char) 'a' Hugs> i.e., evaluating an IO action m with in effect is equivalent to evaluating do { x <- m ; print x } with . Resource usage options num Set the maximum size in the Hugs heap (default: 250k). The argument should be a decimal number, and may by suffixed with k (thousands), M (millions) or G (billions, if your machine has that much memory). Case is not significant. The heap size is measured in cells, each of which usually comprises two ints (taking up 8 bytes on most common architectures). Setting this option with :set does not change the heap size for the current execution of Hugs. On Win32, however, all options are saved to the registry, so it will take effect the next time Hugs is run. Print statistics after each evaluation (default: off). For each evaluation, this option shows the number of reductions performed (a crude measure of the amount of work performed by the interpreter), the total number of cells allocated during evaluation, and the number of garbage collections that occurred during evaluation (if any). Note that even the most trivial evaluation involves several reductions and cells, because Hugs wraps the expression in code to print the value and catch exceptions: Hugs> True True (25 reductions, 46 cells) Note that the cell count measures the total amount of allocation, rather than the number of cells in use at any time (the residency). For that, the option may be more useful. In general these statistics cannot be safely used for much more than spotting general trends. Print the number of cells recovered after each garbage collection (default: off). This can be useful for analysing the residency of an algorithm, the amount of memory it is actually using at each point in time. For example, Hugs> :set +g Hugs> length [1..60000] {{Gc:237618}}{{Gc:237617}}{{Gc:237616}}{{Gc:237623}}{{Gc:237621}} {{Gc:237628}}{{Gc:237623}}{{Gc:237618}}60000 We see that the computation creates a lot of cells, but the number recovered on each garbage collection is roughly the same, so its residency is constant. In contrast, with Hugs> let xs = [1..60000] in sum xs `div` length xs {{Gc:237510}}{{Gc:213862}}{{Gc:190948}}{{Gc:170500}}{{Gc:152225}} {{Gc:135925}}{{Gc:121350}}{{Gc:108350}}{{Gc:96750}}{{Gc:86375}} {{Gc:77125}}{{Gc:68860}}{{Gc:61490}}{{Gc:72948}}{{Gc:97265}} {{Gc:129688}}{{Gc:172916}}{{Gc:230551}}30000 we see that the amount reclaimed by each garbage collection is steadily falling until a certain point (because the original list is retained). These examples use the default heap size of 250000 cells; this may be changed with the option. Since these garbage collection messages will be unpredictably interleaved with the desired output, you would usually only turn on to analyse memory problems, and then turn it off afterwards. Enable root optimisation (default: on). This usually gives a small gain in speed, but you might want to turn it off if you're using the observation-based debugger (see ). Environment variables used by Hugs Hugs also consults a number of environment variables on systems that support them. The method for setting these varies with the system. EMACS (Windows only) If this variable is set, Hugs is assumed to be running in an Emacs subshell (with different line termination conventions on input). HOME The user's home directory. This is substituted for {Home} in the argument of the option (see ), and for ~ in the argument of the :cd command (see ). HUGSFLAGS Additional options for Hugs, processed before any given on the command line (see ). The following example assumes a shell compatible with the Unix Bourne shell: HUGSFLAGS='+k -E"vi +%d"' export HUGSFLAGS HUGSDIR The Hugs library directory. This is substituted for {Hugs} in the argument of the option (see ). This directory should also contain an include subdirectory, which ffihugs will search for include files, particularly HsFFI.h (see ). IGNORE_USER_REGISTRY (Windows only) If this variable is set, options are not read from the user portion of the Registry (see ). You might use this to recover if your registry settings get messed up somehow. LC_CTYPE The locale used for external representation of Haskell Char values (see ). SHELL The shell that is invoked by the :! command (see ). Locale-based character encoding The Haskell 98 Report defines values of the Char type as the code points of Unicode (or equivalently ISO/IEC 10646). However files and other I/O streams typically consist of bytes, with characters in text files encoded as one or more bytes. In many systems, a similar encoding is also required for interactions with the system. Therefore at these points Hugs converts characters to and from sequences of bytes in a manner determined by the LC_CTYPE category of the current locale. This conversion is not applied to the contents of files opened in binary mode. It is applied to program text, so you can use all the characters representable in your locale within comments and string literals. However only ISO Latin-1 characters are permitted in identifiers. The form of the locale string, and how it is set, vary between systems. On POSIX systems, this value is taken from the first nonempty environment variable from LC_ALL, LC_CTYPE and LANG. On Windows, this value is the user-default ANSI code page (not the current OEM code page or the ANSI code page). This may be set using the General tab of the Regional Options control panel. Adding packages to a Hugs installation The recommended way to add Haskell libraries and programs to a Hugs installation (or any other Haskell implementation) is to use the Cabal packaging system. The necessary support library is included in the Hugs installation. For Hugs, a Cabal package will be installed in the following places, where prefix is the directory prefix given to the Cabal setup script: prefix/lib/hugs/packages/package A directory containing the module hierarchy for the package, with associated binary shared objects (if required). To enable Hugs to find these modules, you will need to ensure that the Hugs search path (see ) includes prefix/lib/hugs/packages/* (with a literal *). You can remove the package by simply deleting this directory. prefix/lib/hugs/programs/program A directory containing the modules of an executable Haskell program, with associated binary shared objects (if required). prefix/bin/program An executable shell script that invokes runhugs (see ) on the Main module of an executable Haskell program from the above directory. This program will be runnable if your program search path includes the directory prefix/bin. The default setting of the module search path (see ) supports the following uses: To prepare to install a package privately, invoke the Cabal setup script with setup configure --prefix=$HOME To prepare to install a package for use by all users of the local host, invoke the Cabal setup script without a --prefix option. The package will then be installed under /usr/local/lib/hugs/packages (assuming you have the necessary permissions). Those preparing binary packages will use --prefix=/usr or similar, with an appropriate --destdir option to setup copy. Cabal should work with Hugs on Windows for simple packages. More complex ones require a Unix-like environment such as MSYS/MinGW. Also there is as yet no package manipulation tool hugs-pkg. hugs98-plus-Sep2006/docs/users_guide/others.xml0000644006511100651110000001742610424411367020273 0ustar rossross Other ways of running Hugs Running standalone Haskell programs runhugs option file argument The runhugs command is an interpreter for an executable Hugs script. The first non-option should be the name of a file containing a Haskell Main module. The runhugs command will invoke the the main function in this module, with any subsequent arguments available through the getArgs action. For example, suppose we have a file echo.hs containing module Main where import System.Environment main = do args <- getArgs putStrLn (unwords args) Then we can run this program with the command runhugs echo.hs a b c We can also test the program from within the interpreter using the withArgs function from the System.Environment module: Main> withArgs ["a", "b", "c"] main a b c On Unix systems, it is possible for an executable file to specify which program is used to run it. To do this we need to make the module a literate script, like the following: #! /usr/local/bin/runhugs +l > module Main where > import System.Environment > main = do > args <- getArgs > putStrLn (unwords args) If this file is called myecho, and is executable, we can say myecho a b c This invokes the command /usr/local/bin/runhugs +l myecho a b c The option tells runhugs that myecho contains a literate script, even though its name does not end in .lhs. Unfortunately, the #! feature passes additional arguments (if any) to the program as a single argument: if the first line were #! /usr/local/bin/runhugs +l -98 then the first argument to runhugs would be +l -98. You can get around this using the option, which asks for the string to be split into options: #! /usr/local/bin/runhugs -X +l -98 Then the program will read and act on both the and options. Compiling modules that use the Foreign Function Interface ffihugs option include file cc-arg Any module that contains foreign import declarations must be compiled with ffihugs before it can be loaded into Hugs. Suppose you have some C functions in test.c with some foreign import declarations for those functions in HTest.hs, and that the code in test.c needs to be compiled with . To use these with Hugs, you must first use ffihugs to generate HTest.c, compile it and link it against test.c with to produce an object file (HTest.so on Unix, HTest.dll on Windows): ffihugs HTest.hs test.c -lm Any Hugs options should be placed before the module name, as in ffihugs -98 HTest.hs test.c -lm Now you can run Hugs as normal: hugs -98 HTest.hs When HTest.hs is loaded, Hugs will load the corresponding object file and then use the imported functions. (If HTest.hs depends on other modules using foreign functions, you'll have to have compiled those modules too, but not necessarily before compiling HTest.hs.) Because ffihugs generates a C file with the same base name as the Haskell source file, any auxiliary C files should avoid that name. In the standard FFI, each foreign import declaration should name a C header file containing the prototype of the function. Because this is often cumbersome, ffihugs provides the following additional option: include Specify an include for the generated C file. The include string should be something that can follow #include in a C program, as in ffihugs '-i<math.h>' '-i"mydefs.h"' Test.hs test.c -lm Note the necessary quoting of the options here. Graphical interface for Windows WinHugs is a friendly Windows user interface to Hugs. In addition to the console commands of Hugs (see ), it provides: colorized prompt and various other items to aid reading. hyperlinks (underlined and in blue); clicking on a hyperlink in an error message opens an editor at the offending line. a convenient dialog for control of options. menu and button shortcuts for various commands, such as load. browse commands to view the class hierarchy and items in scope. In addition, some escape codes are supported, in particular those which change the foreground and background color. Getting started with WinHugs The graphical interface is mostly self-explanatory, but this is a small introduction to the most commonly used features. Create a file called Main.hs, and inside put the text module Main where main = putStrLn "Hello, WinHugs! Note that this program contains a syntax error: the closing quote is missing. Now run WinHugs, and click on open (File Open) and browse to the file Main.hs. When WinHugs loads the file, it reports an error, along with a link giving its location. Click on this link, and the file will open in your editor, at the appropriate line. (If the file doesn't open at the correct line, visit the options, and under the WinHugs tab set the Editor value appropriately.) After you've fixed the error, save the file, switch back to WinHugs and click on the Run button. WinHugs will automatically reload your file, and you can watch it produce a message. hugs98-plus-Sep2006/docs/users_guide/users_guide.xml0000644006511100651110000000225410265251707021301 0ustar rossross %ISOpub; %ISOtech; ]> The Hugs 98 User's Guide &license; &introduction; &using-hugs; &options; &others; &haskell98; &hugs-ghc; &hugs-only; &faq; &miscellaneous; hugs98-plus-Sep2006/docs/users_guide/using_hugs.xml0000644006511100651110000003600610465137047021142 0ustar rossross Using Hugs The interpreter may be started with a command line of the form hugs option file On many systems it can also be found in the system menus, and may be started by (double) clicking on a file with a .hs or .lhs extension. Hugs takes options from the command line and elsewhere (see ), and then loads the Haskell Prelude module, as well as as any modules specified on the command line. Hugs starts with a banner like __ __ __ __ ____ ___ _________________________________________ || || || || || || ||__ Hugs 98: Based on the Haskell 98 standard ||___|| ||__|| ||__|| __|| Copyright (c) 1994-2005 ||---|| ___|| World Wide Web: http://haskell.org/hugs || || Bugs: http://hackage.haskell.org/trac/hugs || || Version: March 2005 _________________________________________ Haskell 98 mode: Restart with command line option -98 to enable extensions Type :? for help Hugs> The prompt string Hugs> indicates that the current module is an empty module called Hugs (assuming no modules were specified on the command line). At this prompt, you can type Haskell expressions to be evaluated, and also enter commands of the form :cmd, where cmd may be abbreviated to a single letter. Basic operation expr Evaluate a Haskell expression. The expression cannot be broken over multiple lines. Usually, the value is simply converted to a string (using show) and printed: Hugs> 1+2 3 The printing style can be changed with the option (see ). However, if expr has type IO t for some type t, the resulting IO action is performed: Hugs> print (1+2) >> putStrLn "bye" 3 bye Usually the value produced by this action is ignored, but this can be changed with the option (see ). On ambiguous types If the type of expr is ambiguous, defaulting is applied to each ambiguous type variable v whose constraints all have the form C v where C is a standard class, and at least one of these classes is a numeric class, or is Show, Eq or Ord. (This is an extension of the Haskell 98 rule applied to top-level definitions in modules, which requires a numeric class.) It is an error if any ambiguous type variables cannot be handled in this way. For example, consider Hugs> reverse [] [] Here a Show constraint on the list elements arises from Hugs's use of show to display the result, so the type of the elements defaults to Integer, removing the ambiguity. :type expr Print the type of expr, without evaluating it. Usually the defaulting rules (discussed above) are not applied to the type before printing, but this can be changed with the option (see ). :set option Set command line options. See for a list of available options. On Win32, the new option settings are saved to the registry under the HKEY_CURRENT_USER key, and so persist across Hugs sessions. To make settings persistent on other systems, put them in the HUGSFLAGS environment variable. If no options are given, list the available options and their current settings. :main argument Run the main function, with the getArgs function returning the values specified for the arguments. This is useful for testing programs from the interpreter. If your Main module imports System.Environment, you can get the same effect using withArgs, e.g. withArgs ["Hello", "World"] main :quit Exit the interpreter. Loading and editing Haskell module files The Hugs prompt accepts expressions, but not Haskell definitions. These should be placed in text files containing Haskell modules, and these modules loaded into Hugs either by listing them on the command line, or by using the commands listed here. Hugs assumes that each Haskell module is in a separate file. You can load these files by name, or by specifying a module name. Hugs maintains a notion of a current module, initially the empty module Hugs and normally indicated by the prompt. Expressions presented to Hugs are interpreted within the scope of the current module, i.e. they may refer to unexported names within the module. :load file-or-module Clear all files except the empty module Hugs, the Haskell 98 Prelude and modules it uses, and then load the specified files or modules (if any). The last module loaded becomes the current module. You may specify a literal filename. The named file may contain a Haskell module with any name, but you can't load two modules with the same name together. To include a literal space in a filename, either precede it with a backslash or wrap the whole filename double quotes. Double quoted filenames may also contain the escape sequences \ , \" and \\. Other backslashes are interpreted literally. When asked to load a module M, Hugs looks for a file dir/M.hs or dir/M.lhs, where dir is a directory in its search path. (The / is used on Unix systems; Windows systems use \.) The search path may be changed using the option, while the set of suffixes tried may be changed using the option (see ). The file found should contain a Haskell module called M. In mapping compound module names like A.B.C to files, the dots are interpreted as slashes, leading to filenames dir/A/B/C.hs or dir/A/B/C.lhs. Modules imported by Haskell modules are resolved to filenames in the same way, except that an extra directory is searched first when the importing module was loaded by specifying a filename in that directory, or the importing module was found relative to that directory. This fits nicely with the scenario where you load a module Hugs> :load /path/to/my/project/code.hs Main> where the directory /path/to/my/project contains other modules used directly or indirectly by the module Main in code.hs. For example, suppose Main imports A.B.C, which in turn imports D. These may be resolved to filenames /path/to/my/project/A/B/C.hs, and (assuming that is found), /path/to/my/project/D.hs. However imports from modules found on the search path do not use the extra directory. :also file-or-module Read the specified additional files or modules. The last module loaded becomes the current module. :reload Clear all files except the empty module Hugs, the Haskell 98 Prelude and modules it uses, and then reload all the previously loaded modules. :module module Set the current module for evaluating expressions. :edit file The :edit command starts an editor program to modify or view a Haskell module. Hugs suspends until the editor terminates, and then reloads the currently loaded modules. The option (see ) can be used to configure Hugs to your editor of choice. If no filename is specified, Hugs edits the current module. :find name Edit the module containing the definition of name. Getting information :? Display a brief summary of the commands listed here. :names pattern List names that match any of the listed patterns and are defined in any of the currently loaded modules. Patterns resemble filename patterns: * matches any substring, ? matches any character, [chars] matches any of chars, with char-char standing for a range of characters, and \char matches char. If no patterns are given, all names defined in any of the currently loaded modules are listed. :info name Describe the named objects. Qualified names may be used for objects defined or imported in any loaded module other than the current one. If no arguments are given, the names of all currently loaded files are printed. :browse module List names exported by the specified modules (which must already be loaded). If is given, list all names in scope inside the modules. If no modules are given, it describes the current module. :version Print the version of the Hugs interpreter. Major releases of Hugs are identified by a month and year: Hugs> :version -- Hugs Version November 2003 Development snapshots are identified by a date in YYYYMMDD form. Miscellaneous commands :!command Shell escape. If the command is omitted, run a shell. :cd dir Change the working directory of Hugs to dir. If dir begins with ~/, the ~ is replaced by your home directory. :gc Force a garbage collection. hugs98-plus-Sep2006/docs/users_guide/winhugs.png0000644006511100651110000005334410431064741020434 0ustar rossross‰PNG  IHDR¡Ù9Yu8gAMA± üaV›IDATxÚí ¼U¯+0‘(?}*Š:² *ˆJE–°/ !–° ²†M A”(£<}ês”‘i£Œóó¹7B²ˆ†I„,$ôMî¾$!É]¶ûNÕéª:UuNuUo·ûÞïûý }ëVŸª:]·¾:§ªëX£a¬éÏL:y‰ˆuÂr''­(ef›uúZëÜkv·üwÒÅ}Öì^ëÜnëü^çÅù^Îî'¤ÎÙ@H}sN!uLô€>Ä*Óéü;½Û}Ñé¾?ºS¦·[Çw8/œ»éÇ÷YG,:Ý%Õþ¦Ëw¸áõnýǯ8ùàWG?ü­Ñ©ßú¯£‡|×É´ï;9âncä „Ô/ »!5 e¤ÁÇ11EÖÿ×ÇÈáS‹q¿éêׄ歩OF/ì¾Ý½BðÛ]½iû 1«¯ù=¾îD˜þ£ß "”/£N$„BH٥ʨ?JU˦µ4¯1QýQÚÙT¶È×½.b½Å:tiàx먿Y3×Y§¯šti¿ˆuùzáûí¯ÚþºW„õ­_ßþ†QùZüëO”/äÄ7]ÿ†èsBH‹fÒÕoR¿È}L:T TfÒÜW¶»tÛöW né¦I Yn¶Îuÿ=o³ø±4å¢ ¥œ?àü+¦Ìê+uò‹)"g´[Ç“Ïí¼ìýë_͈x—xoµ…ükÿä3ÝÖùÌu“Ok»ì»ÝÙ ¹«8ùP×îSŸtœ¾Ï­½~í:þC?Ó9¾CëxßëŠÚ»ÝoÓu‡ìîw,RøV„Ô)²!E&F.û^ïêÎ×o¼gëEß™õÏÃ3¾4œ»mè蛇ŽýüÐá7:9ôz'Ÿ¸zPdÿ¹ƒ{_2¸û¼¼mé‹›Å{kSˆ¸+n¦#øWÖ®îÿ—{¿pQ÷õ³ºæÎè¼,×qñÑŸ=¶ãÂÃEÚÏ?TdÝ™Ÿprúþm3ö^}ÜîKN?p㊥BóŽà¥ã?ð #÷·}Ñ]öÎÏÓmw\Èñ·ýç«—|ÿ5™‹¾½U漯m–™õ…¹ßõ6øçD!8ž´ND;øæüÖï,Øö¯ÿµí«ÿoëMù­×Þ½õŠÿ;rÙwFæüŸ‘ ¿92û_FÎùßÃg~uxæW†O¼}舛†¸jóÏoßÿü'D›»6…¸=ó¢oݼñ§ßyùgÿºáž¯ö릾»®íûò½w\Ö{ûœž[/ì¹uvÏMçtßpf×µ3;¯8±ã¢#Úf°äøþaúþ}¯”ÚñûþUãx§[ßü?y-Yð"§ÝÜ;û‹ÝšþyZ™„v<Áñ¤¥éwFîþݶ{þøÊ×¹í¶Ÿl½áž­×|_zë¥ßv }ñ·F.øÆÈ9w ŸvçðÉ_>æ–¡ƒ®Ý¼÷…íï>þA羶š"?Ýq|ï—¾ü‹»7ýúž ?úúÀwoëÿ—ú¾zMï—¯èùÒ¥Bó½_¸¸ç– zìsº®;­sîÉŸ=fí9-=iï_~âÝN!Âñ"ÂñÿôWÅñBûâr½|˜Ýí~ þâïn“vŸÿçW6½þȳ¯œó•—…Ý|zDüø£›f\Ýîhž^zB!-adz¿6,Äü­ßl»ã§[¯ÿáÖ¹ßÛzÉÿ™-”üµ‘3¾2|ê¼áé·t»Óñ.Ú߇Ü0xàÕ›÷¹¸ý½¹ÿvÌZ“Bf´KÇ÷Øg »o¼÷[ë¿Gÿ7®ï»snï/éùüìîÏé¾îŒ®kNí¼bzç'9½÷Ñ~þ!mg¸ôä}~ý©÷:…|j©éxq=^ëx_ð¾ã…ÑåUý¾·ItÑË×Ã[_?éòµ'\¼ÇBiiÇŸö•á[¼õö{7_þÝ­‰~õ¯Žœþåá_>þ–¡£n:äºÁO_+¬ä4í]êÜ”/:fuF/:çE ^¼y]Ï«¢æ­½m]ÎY4(Üù/ªŽÏw‹ÕÙœó*.÷À«£ÏlðëÑ~Æ97°•æJßP³èÞËîH©{N%(Â.â9qùüsnã{Î7…øFΘ7"Â-ÃGÞ ?tà5ƒû_5¸ß•ƒû^9´ß•C»ró¾Ÿí,éYWHYÇG ñ/î³ë¿ëÚþo|N´àý™]ÁŸÐqá‘BðëÎ<П¾î´ýŠ§}ì¹:Ç—úê…ãŤ#Ý/Þ‰«P®ã#×à…ÚE þÜ;f^ß%sÅ¢ôÙ+E”‡ìwå~'îøøÑYœìüô:Êïxæ¤?hû‰ûv|ÏÏnr„½òæ÷ülr²ã½oÇÒ{¥ã“ßB!„TÒŽ?þÖ!qá\¸ùÒooýõ‘³î™ù¥á“n>榡i×}êÚÁ_5ôÑ+‡ö¾|è× ísÅоWnÞgNÇ.'/TÛñj!e-Äs|ç¥Ç‹«ïNý—.í¹e¶?ÇÅÇt\0­ýìO‚?åÃëfîÓvê¾ÏÍØç7ïâòéŽÐ?²$ÜŽ÷ª³¢¾àEž}éUÑQÿÝ_ ÊéES¾³ïU!xÑ‚wæ ‘í/po°—š¿u‹XǶÿbÊÉž§}åß=,~xä¶;¥¶'üÎqÊ:äú¡¯Ü瑱½¯úÐåC¸lhÏˇ>rÅæ|¶ãýÓ£Ž÷ ?&"~-dzàøžÛ.êwÑ‹íóº¯=׺¸ú~ƇÖMÿÀº{¶ÍüÈó'ä·¿¿äøO®08^|9Oô·ŸÓã·à¿þ‹aY–èœm÷Ÿÿy‹üñ¾ÿ~Y¶àŸñü´“Ÿw?à<)×Ñ|¾Ëqó”CVYw—Nd\å÷¹’n¿ù=wÞô´œ¼ÕصI¸¼ðŒÊójþ–>Ë›î:þoî}žã>Yþê™Mrºs9À{—û: p·˜¸ÁéKU—H!„z8ì†AqÇ»¸ïý‚¯;·È‰+ñ§|iø„Û†ŽúüÐ!öÐ7 í{ÝЇ¯úàÜáºrøW íyåæ=çt½oúîã5…ˆ ¿"Úñ3ÚM^p˜¸mÞ¹yþæ Ä•ø®ëNï¼ê”H@Ç©îøÌÛOþ§öXû™=—´ç‚ƒÞ8^6åÅcpÇ Û‹©bZ§ï<×Þü[›åÝvÂîÂñ·|»OÜg'~/Dó] þÐÜRáø@óg÷ç~·Í‘ñÔ¿;ýöí¬u•èZǵNGýÏ'Ÿµ!ßî û,WØkŸ8qêÏw|Ï=?r¾}ðÒM§ô[rzå-BÿSÿî.Nx}ãfþ`Ê÷¶9^ÿúÞòÞ;o~Ôé?hûñ}'þFüvÛκәøã'NrÞÎàë­ŽJ„š:þ kOýòðY_u/þ=íËÎClNøÂðQ·zËÐöо7 ïuÝð®ÞíªáÝçï1wËsºv>1äxµç$Üïž ühf0]¸YÆÕvø-¢¨³Å[^s÷M‹œ“ÑO0å¸ ÖÝÛÜëwOùúF·NŠ7â¬ÛäC¥”Ö“B9{ƒÄW NÿâÐwŸùÏ#³îwÈϘ7œûâðÑ·vÛðŸÞïæá½nÙãú‘]®Þåšá]æîrq×;sŽŽ´…ÈÛìM…ˆßF qßïtŸq@ç•Ó»?wF÷õgö|n–¸Í¾ëê‘ön÷¬½ºOÛ£ë”]ºfìÒ~ò./¿Ë}Ÿx§SÈ¡ë¬CÛÇð§ï8~÷¥Žù…ãgŽ‚—Ž—wØIÁû×àý¼¼ãø‹‡ïÎuãÈ~Ðé®_;à˜~ÞS.ßÔ6ºñ‘G…éûnι3”ÿ«Éç —„}ÀbñÞÜï_—žrjhºˆ½¸Ì[N¼ÿu×ëb9qóf:‹Ëýv³W+Ûrò\„B’#Fà&&½lP|mý”;†…˜O¿søT¡ç/äî>æŽái_þäíÃûÝ6²×-#{Ø#ï¿~ä½×Ž¼wîàÎvÿ¯q¯)Dü˜Pˆøm´Y›¬S_vúµ?óQñÝ÷®«Nvï¾îô®kO Ô~é4ùâ¡M=gìÑ3óýÝ3ÞÛqÒ{—½óMý_î(²=Ö‘kÍlµãøwÿ_×ñâgÇñ}Nû…Á“ì"‚_“‹þSÓþGD8^FŽn+’ûã«¥Ö³úôáÒñ'îøž_Og ç{¤°ÅÛJÂþäR÷o¸Âþ·)g†¦‹ØKʾe8ß©\Œÿæ¿íø1Ñyïä#ÿí¤;_ëoûÏ¿OöV’´nJ'”„R‹8wÀÍÙ2íÆÁ܆N™7¬ÿªÛí#{ݺõŸnyß#;_7²Ó•ƒo¿ ç-ǺMpC!§|yxú¼áî>úŽáÃîþÔ#~!â·ÑB„ãgmr<5}ÏöÙÓ:/Ïu]}J×53Á_qt÷¥‡õÌ î«ïù¾ž“wî8a§G¼ýþýÞRr¼ˆhÍŽ-zÇñ}NGjþÂàQµÁ »Ë¨‚Ú‹LºÄ‰u‘›¼ûÌ¡á÷üV(Y*ß¹£þ“ËÜ^ñ/~ûª'lçWž°8åÌÐtÏñÞ[Ö>q’ó+Y”û–»_w-~ß½?eºxã«…%¯:%Ì{ͽáÿž)Gv—V’B¹È¹¶»Û[ÄäÄ2'~aHïø/ŽìyÛÖÝnÙúž·¾ãš‘·^6¸ã9Ýo:Êm‚ 9éK#¹/ wÇðQó†½cø“Âñ^!â·ÑBDgÀ¬A§q|ÜnëÎþTÇœ£;/?Ñ_z×Çu_~T÷%‡öÌùdßìýÍŸôŽ®cߺüÐïÿ蛜BNØèØ\jÞ[Öwüôn§£þÂÍ¢‘$¾#§¼¼‘^Þ·»È‰'?»ÝÜ7&Í}EĺôuÇô—8v¤þ©eÎw ¿+姸ç—(Ž¿Äs¹;gîOžãÏ M±Ÿõ߲͚¿)\ùÎ[¾ðZ14ñü΢ƒ‰ÝëNëpL·,BL±.zLœ8=ççlù؃‡\?xô-zÇïsûÖݶu×[¶¾ûÆ­o»zë›?;8ùÌîíŽp›à© Q‰rþ6ëÇý/ùÞµ§~L|MNh~èÑß;‚¿ô˜®KêºdZ÷œO÷\t@ïùûôó!1}äO÷öæÞÖyä›—jò}Þ®äxáøO÷9OÂñúê×YÓû»\Ç‹F¹|ÄMDð²‹^üq¹%Û_;*2éê7D„ìýXsWNB=ÝûñÂǧ¼gÁäà·ýS>"¾ïL‘sîxðJù«ÉÇß#n°Ÿratºó«ƒKoqJ8}ß^‘oÉÿq…x‹ûã}ÎyÑ£;å8‹öfûÈã“ç†Ö“Bâ‘-2A"tñ®3·ì9ÇyHíÁ×N³‡¦ÙÇÞ4tðÍCÝ2tÀç‡÷ýüÈž·Œì~óÈûnyǵ[w¼bdòEƒÛÞ5iš{K|M ' ç;k{—è®_{ÆÔöóî˜=­ãÂi³íœ}pç샺.8 û¼}{ÎÚ³÷ŒÝEG½hÄ÷»cÇ´É/|b»{Mr 9yK©)//žRï8þûŽ‚—Õ…ã·¿â1ØLé¼Û|——á#‚ÓõolÃh)ד¿I÷©þ£|Û9'°î-ÊnåB‰ÇiUÏ\¿Ëy÷þìË¿âåO\µéÀ«7M½zóÔk6ìºÍû|nóžŸÛ²ûu[ÞwÍàNsEûmÙîÜ—­ë¬Cœ!ãjRˆß°â ·½xÌ.kNÞû¥Ó>^œõ‰¶³l›5µíÌ©kÏüغYûtœ¾gÇÌÝ;O~_gn§ÎcÞÚqømŸÞîÙ[¿ü Ur¼Ô¼p|©¯>ìx©yáx‘7]ýÚ×½îä7ö‘Ç›4?&É-Øôƒ,Y¹£è8d嘯©y8$Bj˜Î ¯ï=»¸ÓgŠïŸUÜãÜu{ž¿v¯ Ú>tþÚÎ^·Çìu»Í^÷þ ;wžÝ¹Ó]o;¯óÍgwýÃ]“NYg÷Üî§üÉw|•…8½Ö¹þõgNÜ{ѧwZtøû»Çâö\|Â^‹ÿÐ’>øìñ{,=n·eǽÙÑ;¿päN˦½í…ƒß¼ì“ÿðìþ“ÛÇúÕa»»_À 9Þùîœâxñ¿)/[óoš»-jú^—j7 ~l?*ÑÕtàÓˆ'„R.—Ï^²jÓÞgþå­GüáÇ.|çqÿý®ã|ç±îtÜC;¿ðíÇ=üÖãyËqN9ö/âþ¸íxdÒ±}x÷S\¼b½xoõ…\öïCÒñ—ýphà K~ìÞ?ûè[½ÿ;~5õ¿8à]¿Øÿ¿>`§ß°Óo§¾ýþýßú_{Ëïö›rÿ>oºïí÷áI¿ýõëÃvï{~ñeßÛdr|›ïxù¯x¬§A?X2½ÌÕ¯ÉlÕ«ñÈí”}„Ô/\>$„Ô0“/{UXv4#¢Í-Þ%Þ[m!?Ü2ùâçæüó·Mž=rÙ¶d.dà5!øÉŸÙºu¼xX®wNï> Ǻȹ oûK7•âøÞÏ+ò^z5ò¦úàt„Ô+Ü LêþÊH=sþ6y“¸—Þùz½øâÜYÃÖÙ#NÄ‹YƒN‹\þ+_ø9õeëäοò·þøH¢Žw4ßfM[d³xÒ±K¶;ΉuÒ ™I3VËX3ÛœS1zŒoÞ-ã>UŸBZ;Ç·RÇáN7ìfǬvF‰™æåðU¥ô"§ˆÅÓéEÄéåcêå˜4BèzdzØq¼«yßôÚÈœøó+o$¤®‘;*!õË$Bêœ:îÀòY¶¥ûêß·x‡Wí>O!8~q¬—»º{î‘8’Ž^ïOßzwË—ºëu}õ¡K຾úØ9ÇU¥«ûÞµ€¬×ã5îŒôÕ;o· ÊÛ{Žè±—ýáE×¢ÎM_ÜñÁ%B!÷ž»,7£Å¿;ç\÷UîƒS–{ÿÜÔ÷ÜE×V鮇­Tfâ=wº¾ú,wÿ…63Vl|¡‘Fs ×Ø¢+«ó2÷Ü)·:ÆלBÈ8t<™€át„2žÿf³ã­5X|Ê4•\Ûg3³¶M¾Â„BŒŽƒÍïú“òŽ'„BŽ'„BŽ'„BŽ'„BHµŽ€V†v÷­E7ÜJ¤%?ož¥†?xBŽÏàøLGüô‡é_ÿü‡Ú×)ßI ='îRÉj»Öu¼ñ^͆k¾‚:R—Ÿ—Ì#<‚æ !8>­ãÕ£¼||ÜÏäx!’øëôïõ©FóbsÜöŸ $xßôî¯æÉß–µÝ¸t¼ü·²’çyÔÏñÁ+šŸÇŸ=!ÇWØämÇG~¬Ló¾ÈÄP;AoͳÔv|e­yQe²Y‡õp¼*xÙKïÿÈø:„‰ëø)SWj_ö€žæˆŸÉñÒÊòEŽ”PYï½ßŽ7]“žçI~â8Þ×¼/ûŒ—Æd{ZVßRMÎ ã_Uñ$^àxBŽ×8Þ;bŽÆ/E×éz¼ªjé’ Úñþ+î½W ”ðom/–Ù„Ž—v÷“ÕñóJo‘ ëy²ï9>صªq¼¿J²{À; ³TåãxBŽ×:~Ô×|üß:9¾‚F|¤¯-$}ï½z=ÞovêRcÇW¯ymïEÖ ¾ãƒ.úJÛñŠËG¥•÷¨ìQ¯•ãu·ÍzOÁñÆv¼ößz8^mWð.¿ïwh{ﳶãÅ„˜BÊ+¹ÇW©y“ã3U¦Öñqƒ¦ë¢/9^ª=ÜŽŸ—ƾY¯t xBŽOÝŽ/KmÛñèÍÔŽ÷ÏT÷gmÇÇ/ÿ­¹ã«Ñ|¯½ù.M/½ß!ï;^¹o¥éJéxõª¼·\OÁñ©¯ÇGž+¢¦V÷ÜÅU]«v¼Z`:ÇkÚñ¾ƒÕ× J®Øñk¾¶Ž×¨=µãÕF{Ž(³UïøXkÞR­Ï½êT!ùÝõé5_¶q•íxµA?^Ûññ‹ñ8^½$ïõŸûwáÕÌñ‘v|5_â'„ ÔŽ¯Rð)U']®6¾Õ{ã›­iÐ×ëñÕÜWïóп­]î0ò©s¾øk~=ÞoÇ«÷ØóOÁñÇW/øôŽW¥^™ãMnËÚŽÐ<³½Aíø:ÝW_«v|Eß³"ýöRü5¹ÐcjÇó­9BŽOåøê‡'©ÀñÊópÒûIëò ÚñZ7 _ýçZïëñÕ8^í½WOëÑŽÇñ„_þ9w5I¦ëñªÔ+ø]rï}úv¼ÖñumÇ×*¦õ¬ÆñZ‰¦/ÍŸÙ¿úÿ}õ„2ž_½ÔS6j+s|BšÊñ5Ø9ÒQMɵÚyž7Ló‚ã›Ëñ kÔÖðL¢97|Ü„:$„Ÿ¨CB!:Çï0uŽgéCB?Žß­!Ž'„BŽ'„BŽ'„BŽ'„Bp<µC!„ŒGÇ'<7†B!MçQ¤ Ž¿þºK!„ÒrÙ´q]yÇÀ˜²a}çk¯½’~þNÐŽÿŽŒ nÚÔ¿aC·Px{_ߺžž¢Hw÷K"]]k::VnÙ²AÌÙÙù"ŽhÇ ÁŒlÚ$D¾yóúM›Üô¿ürßƽ®û;„éÅœÅâRÐ2Ž‚|Ù|ÉîRðë×wùŽ_±âiÐ2Ž]ô^ Þ±»Œ«öN/¢Ó^ÌùÜsáx€–q¼¸¯öÏ‹<ýôcRí~¤ã/~Ç´–ãûUÁ˵‹[ðä¿ÒñÏ<óŽhÇ‹[è…Ú¥æ}ÁË»ËHÇ/ZôgÐ2ŽþŽ´àÅÅxUó¢¡/ï¹Ãñ­äxáoq ½/uïûrþ×ñ«]Ç?ˆãZÈñ«…Ô¥æ¥àåwâ…Ú¥à{{Ûp<@ë9^<½NtÎKµËÈïÄË^z!xqÁ^̃ãZÏñÂèÂë~äCm}Ç‹ öâq¶8 Å¿nÝrárù59Ù|W[ðò‘õíí+F¹ç µ/žp'šò⊻—5þk1]D^|­N̹té£8 5/ñ)g^µê™ cËæ¬V†,*ÔdƒŠ+k³ÜZ•Sïõ¬YùY3VŸWקVÔ½þ !¤üqO8^<©~ùò¿ŠNø§ŸþÃOÜÿøã b¹ïÉ'X²¤ Æ­aüx€–iÇoÙ40(²eÃÐàÆá¡—Å ³Û¶nÛ6òê«[_}u›È믿òƯʈùq<ŽÍèø)fÇoÉçæ‹ñe›¦×ŠZ-·ÞëÏz6fh4Ûr± á× ]xt‘¦éé)æsVˆ\=?4w}sù1üåöÖàƒ«Ýþà®Q†j÷?²È{LÓÇd¿jîýgì÷ñqüá«­]ïÅñ¬'Ž7[ƒ#ž8J4ÒðÞñÈ}Y ŽéÞ:T³:Ñíªï±¯`7ðتn™~{›cÈç2ŸZ ï)¦/«Îû•©þ›cÿiè~ˆãq'ëÙªŽWÛ…²õaƒ6r.Ÿ·Õ_çœ Ÿa¹Ê±I;²ËuIu„5º*hÍE›†úõWæ((}v!Õ±Ué\ðÖF"––²ë PëÊÎç5å˜Ö¿Þõæ9>TOåÖ§zÇW´_•û¼üí2׿¾~>_Óþc¨g9·˜â½/¼ eÙq<Žg='–ãµÚ‘c½7]i¹ïTç÷_;‡©²Ç¥½å–¤—‰¦72µãµ‡bQH¡7µÇ}eýCM>§Ì`zhö²Ûë¾µ¨éW(¿Ií};ÞÒ”cZÿÌûCÆz‹8^ýp“Ö§¶íøÔûU™…Øvi÷@}ý>ß„ýÇPŽrº-_{gLÙöCãYÏ ÝŽ/ãøp/gøÈ«6Ð2jXôä‚ŽTÅvÅ•m†OMt+ª[uZ¸1RŽ[é[—¡Ô_EŠÍèxýç¥]ÿìûC¶zSÛÁjÍ”[Ÿ8¾fûUÂvéêÐT?ÚÏ7aÿ1Ÿœjv¬û!ŽÇñ¬'ŽOïx£“2_ÿúCE¦s^«z?ªíó5lýMWn[Èñ¯—ï¿ISo~3Ô¶£ç‰ëSÇ×~¿ŠnW|Ìõ“Íñ‰õŒãq<îÄñ5t|Ðô‚£Wh•‹ñá&}µ¨³Û‘AÓ*ûõøàЩ,*Ü“kZÿh©n Ó\›KJ¹nZ‰ã•OÃ[ S½Ö¿Çg«·àW…æ“ק¶ŽO½_•û¼´Ûªcý>_Óþc.G¿Ú™÷CãYÏ äx¿_Pý®”ªvͽuJ¦h¥in¸K©acWhBŸZÇÇn ß_íM«ïg^ÿHÿ²®ßm®Ze›òñRÔ Rÿ©ªNSL¬Ãúg֛ܲÿÝ9ñ‰ëïÄOž^ÛýJëxóBu_ÂÓ×OÂçkØ õ­í½~©öCãYÏ ÕŽ¯ò!GmŽÇ¬ç¸Aiiä9<@ 8p<€K1¿0Û@Êv'•€ãp<Ž˜ðŽglY€ñãøik¬Ýp<À„u¼¸}*—ß_¶iz­¨Õrë½þm=›íó­+ÁS4Ä·Ýë0pfò¢Ó|þf㣇IõõþìÏŽÔ¯ç ãš»¿L·åÊC‹ŠñÚ‹—¯ŸzVOs ´8ÇãxŸ]ðáa*›ó¸žpòQáiIêîfz2oiœrݣŵ㚧{Ú¶ó©¶Oyoøá±áòËOoðYŽÇñ8~ Ì©ï¼ô€Ò¼{Dl©-*ç+zƒ]šÇ½ö›‹Qž¡«=a<ï­^í“r½ñÊ”õª`¨˜ãÓŒkzŽ½¯íìÒ5>¿¨柎ãÇãx?^oœÃ4Þy¨©_TD.*:"LtÜkÕžE}s46>½eg½")Eç±þŒð2VƇö&¶ãC£¦U›Yº‘ýÉŠi:}õ€ãq<ŽïŽ7…iþª3‰IgQǛǧO7¬Ç#ÛòbšF«×Ü0=2‰a@ý5vãð¿iŸt"€ãq'Žo!Ç›îIŽŽXºÄëþ`,=›ãËgßRŽ-¿8ÝôÔíøX÷C¬FC}õi®Á—©;q|³ßs(Û3T?Þ¹ôˆÉ¯Î»òšnê´Ž7OŸèxýÝfå¶;ÚW¯­Í/«v¼©y¬Ÿ^L{Ïe8]³•›&T¯k§«×hŠ™Omp<ŽÇñMöÝ9ýXíxç®På°Öú;梖5{mîsÖOŸ8>z™/Ÿ¥oš/Dg¹ç.ºaþM×'k|=© oêÁ~.¿ütñ€ãq'ŽouÇgGãqË«Vérå¸zW‡º?ƒ>­ã}%GŒ•©/Å ú©ÂñéÝ™°ž…B°þ6«ó8z38¾ S¦ó«\/ÌY—_PN, ¥M°ýó$·2㵑²~BíûB0ÝT~B½áøÆ8¾°(úÄ»³’é8 Ç7®ÌÜžjמžÛŠ‰ÃÃf+6:m™C²a}²–ò¦Œq Ë5—±z±’n“PãÃ듪ëØNݸ7®g¸kA]¨miÚÍA;5nÙp 5t¼XI;òy+]…X!b}줥¤¯ýôÄòMõ†ãiÇõ™á&Ûm«åˆrò€4fŽ7¬OŽÏ¨\ýrÍåDV¤^ŸòŽÏ$ÎòíÑ„…¢íxÛŽuøÛ5[Õš;>2C¦úIãxÍ hûp<Žê3»ãîQ¨(‡†/ênOW8¼yŒó듵ü¬CŸ›ëA_Žœ)X­*úê_Z‹Bôr|ºÓ8ÎÏ´}õv–+ô Ž/( ze âDU¥•~Û¨„úÊêx[×y î8v®Œbíðu„H;;}ýkî“7•ŸPo8Çõ™uÀ÷Ð5xýøñUï _î’¼a}*(?ò–2Æ5Öƒ®yå_´ö­êî¹óïór ݹV0ôÙô÷ŽÉƱöö7»ºÞï„õTo“+ ÞhºÇMTWÁŽ®ª­ë«· }øvbß¾æœÆpMÁÖÞÛ®d±]Úëå©>GÓ½u†òMõ†ãqµz8~%ϲ?Žß Ç7'ÅüB+ÛÀ솄¾ŽÐ*Ä¿0FH<8Çàx€ãÇ@ Ràþö àxqûW.¿%¾lÓôZ1VËpnáç»4ë·tk5^û8úÜ:žúX.Ÿ“SßÏÝ}F\„Xœ÷(çšm¯ÿÌŸLUmY ý|q<Ž‡q‹útXu·éﵯ½Þë9ÖŸ¦Æ5o~¬ÆG¯`°ùÊkÌôœù†oBMÆÒÅñ8 üxudݸé¥Uó¶ö®Æ›?(7Ís_µãµËbüácB+TTf·ú‚e;Ϩ/7æ¬y=µÛ«Ô]yGØnÿ°|œj¾Pzè©ú,úxÓ-¹=u€iz¥‰ieo5ÇøèŽ JQÅ/לÆתv{>—„íRÇÒ JS‡ÚËÕÅñÚÏWN…øëS(Wo8ÇÃ8q¼2²Jò¸éÞ¯”±X*o>c;^?^{hÀ·`°¥K"<ÆL¤ß"Íå íz&mo–1ilå!çÒÁðáAEEÛ”™`§Î8žºÁñc2>z¨¯Û-ªPÓåJÇ—zéÃíxíöš>—„íR_Pj¸ Öm®ÆŽOú| ʉE¡´ ¦zÃñ8ZÞñV¼UžuÜôŠÆ¢ÍêxíxízLJDŽ VĦjѱْ·7 ¥мÁO#ÔiÛß5p|òX«†Þ㺎nc&r~ã/®VË•î…WöÜ%ás1û^jOÇ-kSglÇÒmüPÿv¼:òZÖqÓáxýxíio4p´ýÝDŽO—½µ_Íøè‘‹Ù™Ÿf¹¥ ÷ÍKÝ?‘p;mÇËù §¦wyco¬7ã¡…=Õ¸éŠÿ*o>x‹zzanÇkÇkÖ?Ô'¯J^vÉ5ç æS™²ë™´½™úêÍŽ/( Ç*¯oÞ8žºéz¼ÁñuÝiçBmèBM—›P“&Çk?—„íò; ¢cjæx[×y`ü|u 7ÕŽÇñÐÊøýÖêåöÄñ×…Û”qÓ+o>ò˃»›Æk7Ý[§,Y +¯¹á.µ†õë©ßÞlŽ·ý¶£lGÚ¥«¶ê-Q‘qÙ+O];}âµ€ˆ3Æj|ty?mó+Ÿ{–«œ7øÞMØ^Óçb*ß¿Ÿ `GïÔ³³|Žvbß~Üñ¦Ï×6݃i¨·süàx€ªÃï°Õ¤¯Æ¢þÇæ_)—hÛ泛ϫ:ǯÁñµ|³?-§u×v<î-cóü8Æeo¹zk„ã ñàx‡02:aÜz@;Çàx€ã e¿%Ÿ[¨û­iz­¨j¹ÁS8"cyÕþËÀ uTbÚžÈv—™zV‰æ,ñí*_~ø»X¦rÇW³ÜÈC4[i¬ëÔgá'*Ï=ŠÔ4½¨¯’ÒãPãY5”£ŽQ¦yþkÅÏ+Àñ8>Á…º±5õãšÆó·›ÕqµýÆkÜašñ³åÜâÝÕ«÷±âÚðsLƒ‡¦ê§›¯+.±œðúÄÏ p<Ž¯±ã ž3Žÿ¨6<žwò¸Úq«ÇÏ.¿‰½«2LJú*¢ÚÜúé }õ©¯kD÷Ü4€ãkïxÿâªÌã›…”4®vÑ4´g¼Hc£»"\C‡ Mãxc§GŽWOihÇàøú;^ &2¶•¥ƒZ+±1w|h°Pí–…ú0Ê_ƒß¾ s|mÊ_“åjúÀM㛄”<®¶®¯Þ0~v’ã3ôÕǯøåÛ† Úéê5…b¼RâUa.'tÿ]Ùr ‘ŽŸ2uÅ8u¼vôLíøßÆñ¼ ãjÇ;ý÷×E¦úÝ[Íc7ë¥v|¸ðÈ{‚ß…K*?=t]?¼€Øm‰ £§,êìøÕÂñ8ÇL$ÇŽWæ¬!„Ô1‹ 8€v<ŽÀñ8ÇŽ8ÇãxãƽãÆ–8p<ŽÇñ8ÇàxÀñ€ãÇàx€ãMŽ/Ø–‹]¿njÜÍåk^d@m oŽ*Ëå‹eg+æs­°Ôr?‘›ìÎX¬¸ÞZåó­Cýj¦é)ÿþj¹ûÕîøæî&êØ´_%ïoõ®çf9ÞB#ÛñbŸ öñi¶Æ¾`×zŸõàÿÕUyÄTk´jUN¦ò‹õ^jSî'ê§ß´Œå'ãTd1~Zÿ{qæ­fÚÉ[ûuZñß*ØGLûU†ý­†õÜLÇ[cÇ«í9y¶ì‘þ‰¨˜–·Õ_ù¿°r¹Ä?Zyb˜+\ï –”£îºÁrÅTeŸS›Ñ…Êߥ?Î5sùšíUV2ºJ9ꟷ¿ñÞ[•ÀJÛ¸Qß,Ê]%}»Á\¾³éyÿ·©ª.Ø2±Gä>GÓ瞸?hëM®¿¨õôûIÆcqR½i—›´&~jJ9¥ÆbÞŽnqâçejjþŽÖ?£ãÃç‚A=«ÓÓ˜,Òƒ¦Vö8 ÿ{©Àñ†¿Ç„ã˜ÜšÐþUîs¯Þñµ¨ç†oa¬¯[6rôPÏÕ¿ åˆ:î¨ó«íàr¿3‹×VúË‘o…{_p«žÂª}G¡SØ¢ûæêo:EVËOØ^C{«P(ŒÆÊUO£äk»½Ýk}GŽÉÚ£€©ïªiÑ!ƒ”ÞaþµŸ»q0Ö[1X‚:³a?©]{˸܄ýP/x]ýŒ†®–C[œ°?Ä×ÓT¾aý«jÇ»Ÿ»^žé[»)ë'áï%¹Ï<¦sý~•øwí;^ÝؤϽ¶íø*ê¹1Ç[ Ç.oÇë\n˜î ï©™®©y'†ÞbŠþÖU:eéZ•_›R¡ÞX¾q{õÇâðÁ&âxí|¦¾Y9³”l¼o-“ãµûC¶N<ã9‡ás7N7×[¸¯Åß?õûIm¯[n¶ýÐ|N9ÿSgÌàø„s>íú§4¤¡ Áí¿ ÎŠ•ìT"‹LÉç¬åwËû³ñï1áï:&ÔrŸ{ _›znºã-´†ãl‘óîºîs5ÚÇ‚¿:µeš²üðöêŽÅ¡KüÑ­¬…ãÝ2œÜÿ¢omYÇ›ë­ÙŸi?Lr¼QÖcàøÑ”{B°T"ã1p|âߣñïÚ²m;z>Pî\®zÇ×¢ž›îx Máxµ!¥ë“ôú}FcǦò»‚±ÝÞùý}:T¢Ú‡í÷ŽõPUÐW¯v‘šÊOØÞPnp):Ô£Îññr’jTà¼A”–‹³ Ž×”ŸÑñ‘ûƒ‚ŒŸcfÇêMï*ã~R_Ç—ÙËí?ʱÛë‰Ñx=aÐõÕë˯‡ãÕJϺÿ˜ûê ë_3Çë÷«ò×áÊOþÜkëø*ê¹1Ç[h>Çû½@êwKb}¤á{ë”îš’TÔŽ¬T8Á’ü»ûŠþwSL}h¡.4;|‰È´èÔŽ÷ËÐjõå'm¯îK-ÊfåDµéîØÑôágè ®³Æ®¥™–+?iHÒ•¡/=ºTãçn™÷}½©+YOã~’üÁënŒOOXnÒ~X¾\uŒÜLMåköóç«-?iý3:ÞØ¥í{påo&ÔÝNšr û³áïÑøwퟔCEÂçžq¿M·‡VXÏ ;ÞBS¶ãkÓ¿ µ€?)?ÆŽW΀¹© †‚ç/ Ç7M;p<àxãp<ŽÀñ€ã`Ì¿ÇàxÀñ€ãÇàx€ãq<Ž8p<ŽÇñ8žšÀñ€ãÇàx€ãq<Ž8p<ŽÇñ8ÇàxÀñ€ãÇàx€ãq<Ž€ñâø‚m¹Ø…ðëñ‚ئ\¾X×ò}ÆS½ÀxhÇó¹@NBY˜*=¢îryªZÉñb¢ß0•MÕ 5,'§åmõWþ/¬\.üôó«Mãp!¦òµÓýÕŒ·ãƒùý39·xwê6¹ºš‘UÕ”ïM+ã­˜ºY§W8¾ÖŽ«ª¨u¿7]éüvß©Îï¿v”UÎñ†ùC= ÎgkËO^®ú[ßµÁwkB +êß•¾o,_9]’¯¥ãx_ÿv|LJ;óÃ.ÌzmZ7´u¬e*?i¹Q[‡¶*¼ÅꯔzÈæø„òÓ 8~Ìo”V¤ýšF÷^ë6íé¶üØt8^ãø ç:è“W%,»ÆKóG›ôåTmš_,LûVóüIËÕõÕ«œ Öè¹bÇ'”ŸT,}õ8¾ÖŽ÷/Æ«ßSÕ®¹·Né·m[sÃ]:]™çô×—~ešß0=Þé¾½.2U­ˆH=¤ZeÉÚòcëmíãxßTÏÀI{o´„ã•ïªñíp€ñØŽ8ÇãxãpüÄöF l/õ 0þ_°G-«”ðóhFcOk-ÍV›ïÍGsjQe šõ© rc#¥ŠíÒnQòöFêG–Ü€GÄ?—̯ÝÞú׿©žó¹`¬fïªfÿçV®ò…ò #hJÇ Ñf<´™ŽÔ#GÆС»^ŽŒ‘š˜é·W¸ªU ¤ÝÞÔ¿©žÕéUVcÅû§«Ùž 0öŽW[ð–ÒŽIniŽ¡M!¡RY£˜£¶“ä Kw{äróùЯ‚¦a.z£u|‚â¿2Õ#§‚²JÅÐʈ™ý7bõ¦ešßø¹˜ëßTÚím@ý›êYu¼¿iê-¾¿E‘rýÅ ãË×;>UHQÿcÜŽOèÁŽL #‡ÅLŽ×öÙFÜãO·}†»ýÕ5të)ŸÐÄL_ò€®®R!¢á\éuðlýBðÞÐZæÏTÿÉõ`ë®Y4 þµõllÇëê!yÓž“•Yÿp_}rùÚ=ÁÿÜÕ¥'×@+8¾î 0=‚ög:맇;“#ke'®Œmé[±iû-ÌŽÈX»9¡Ê·ô7CèçÏ^ÿ õÞ…µ­m}Ú¦ëñ…ÄN Ý"ÒnW¤dÿ!ûþœðAÛYþ(Ç7¥ã+ºp[¶¯>“cŒR,¤mÇš¯R§w|xÀú2ŽWÛ‘ÑÚÈäø4õ_Ð_F)4¼þµõl¼Bëx»Ì~U­ãí*öä,õ8¾úê£ý̺&Z¡:Ç—^‡û„ípƒU½êìµÓ:^{Ëz¶¾ú\¨^-ãø‚2s…Ž7×r=Ä··1õ¯­ç Ž/·¿i_výÕŽ¥¬û³©ÞÊÖàø::>ò%ÿdú*ít}‘#`JÇûƒÕïn©‡fͽ]J·ªmënøÒ-:Áñ‘3žLõ ï粕ÛC×zu}òêõoùFÿz³vþ¬õŸ\‘ímXýÇëY_í1Õƒi{õ“býÅι$ŸrN¨·òõ8~Ü>'òýø* K÷)í÷ãÓžŒGjµ½Y¿±6Ñê`‚9¾¨ßMêÇó,[€ñëøø„!õíxãp<ŽÀñÆ€ñéxÆgüx 㸌/Ç3~|¹¦íÄ?~”qÜÆã?>&Îøñ£Œã0AÚñŒŸµZ}üøQÆqÀñŒ?:ÇewÏøñ£ãqüøQÆqÀñŒ?:Çew€qãxÆ­ÓÄ?~”qÜÆ[;~ aüø&€qÜZÓñk¬]?ÇÀxp<#yÆq 8p<ŽÇñu„ñã`|:žñã?¾aõoªd¾£8¾ŽgüørMÛ‰3~|cê?Íž€ã«u<ãǧùÄ?¾1õ¯w<㾎od;žñã³ÖC«ߘú×Ö$㾎oJÇ3~ü¨ÞÓ-7~|Ãê?åç>ʸï€ãÇÞñŒï9¾¥ÇoLýgr|¦rp<ãÇ3~¼~{SÿŒûPÇOcüxÆO=~|ÃêŸqßáø1†ñ㛀Zmo­¾Q €ãÇ…ãkãÇSÿ8žgÙL Ç3‚8aÜwÚñ€ãÇàx€ãÓ9¾˜ÏYQrc>4jÁÖ%ó[,«†_m—õ“©@¿Js­2Ä,ŒWÇK GJ“yÆ Ç‘žTÅËTkãnFýÖ§‚“†â˜×#LpÇ«íà°ÉJ c9±Ô6ÍåÝÿ‹ÿÙšF¿Ú”Nk\ù³Cc«•Ü‚,Zé¤Jñ6¥è5¸Ë,Àq|Þ/I™9q{#ŽOª7Àñu¼3)l©ÒïC½×A£;T@Ñm€Wïø´mh];>Ô –£Î +§ìäE¸§9o\sßÜe¶7ÞŽ7ÔàøZ8~‡LŽW¼®ú>b§’†£­éª/‹«®Àñ±³ƒÐKøô¥lÙÊxhÞËm¯Öñšz?&Ž÷§ª>ŠÈ+p|M••ízö˜8>q{uŽ×Õàø±q¼4SÞŽ^Z]óúð³K«ÜõøŠuª#gƒð+r|¹íÕ÷Õëê p|½þú\L<Ž…C…¼l;g•¹é.¥¹MŽ÷zêSˆ8úí?e`v݆E;ÙS\Œ÷fóÞª\’—ïÄ÷ÏLõ8¾žíø '÷9CJ¨7hÇkŸ*4ëö}ôq*xê š­8p<àxãp<Ž¯ÓCƒj5½U¶«Õ—;^ëp¼`•mÝe‰Ø«Â¯›:ŒËî~=°ì—Ù¼çôKƒÇýõÑ®I­¦U½Õa=SÕs¶å#>ªÜ—áOµ.õŸz»b~J=jƒ;èR±Ê$[%þ. ¹ÚñŧrÔ…æ¨më¢`ße垪Ùß­~Æ­ùøç,Ô=¨…—m™¦|–z«Çz¦¨ç¬ËU'ǞƘQóúº©Ñó†³lWX¶¢ÖrzæqæŒÐôŽý}á§qxz}>ç6÷­»rù§lõWùùrºeÍÏåæ+ÏfŸïμ>{!«´ãÄ«ñ‰ŽÌÖñÞ³l£%Õµ)¯<9''Èò¾´‰Þ ¹ ÊÕ,B}ÈQ¹qÓK¸\.^ÿšz– ú\©qZ3Ef«Ÿ°"ƒyÌÛ¯OÕñ¡õ-‘¬ÝßJMÙ¼mÚã2Ô§](ÙV}mþ|õý4 ŸK‚ãóyíüúz3ÿ]@¿ÆÚõ'e_ó]!—GÜïMírÏÖ®ìÕùý×ÎiÁü°;å™Áü”OyËàxó8ñ…B!˜G9Rú³§ë«÷ߢô½ŽMyuKåQTÛÚRž5¬Ý^S½…–Xt+±Š¦g©le)¦zöZÜžÂ+–e¹‘i¥Û¥¯Ï¨ã#nÓ¬Œi 5À£»Jêí’Ÿ¯û¡Êß)ëéó5}.å›å‘ùÍõ–ðwÍäxË ÓÃùª×e·¼w® ÿ›—çÕtÝË Ñ8O;&MäñûºëªZŸZN×>M¸tÐ÷F±Sú!Š–:'üŽ¬MÏhíëÙ[ábÐX´JÓ.Wëø¤íÒ×gÐNÕ ]¨;¡1ìoÑEfL»]ÁPÍ¥õ ŠÉôùš>—äv|aT7¿±Þ`œ;^?„˜-Ödw?¿Ú§µ§v|è&¤`®Z;¾AWå•öb©'ººm·»Ûß0íö&8¾Ìá:cÓ³FŽÏ°\m_}Ê{Bý=®žmÍýŒŽ/·c¦Ù.ÿm^£Ýÿ9Ûç[KÇë ZÛñ¥×¡>yÑXWŽ¡‹ñÊ÷È©@¶ŽúÑŒ}õÚqâ•Cg¨6tHôÙV,yí±ÊéÆ>ì‚ð‘-}¦Ü‘eÚÞ„z+côë¯w‰©žË:>õr£K.k·+áš@éWºa”•a„ƒ1‚uû›ß³bô‡êÏf*'M ^m'·×5Ž/h ‰4ÄSzMS¸p¼í´ƒ ‘×áåªïÒ¯¿ÒŸ>­1Ôa¦ÏE¿½Êzº²Gð@;~4êþð†~z¢ãµåÔ×ñ…pg@F£—/_:^º3WÒyAmšën&HèðW;ã•ñÁBóÛl¬»¶)ñ¥ö«’Tý«Çû ¸ð)`Ä7bºÚ”ÔÐÃ+Ýi—åúr"÷…Äš¶¦=SÛW8ÉüÆ2ŽÏ¼>ÆzKrž2ü©É^Æñ¦õŒ¬¡r/Ý.ZP‚ã3|.Úí —ZýÊàøjoþ+R.®›§§è«—SwÇÛ5þBMy_Ì…ÒDßñ¶r/^¼¼®Žm~Š¦¹Ú%иv¼ÑñJ¿zUŽ×•?­Ø%Š9R^HÖ»3ÛúÔÊñjû;\əֳLJ‹M׎¯­ãSž“ŒgÇûoêt§-®»™^öž;uþú:^×O¶¶±›Ð§º%^sÌñs9«ããëcr¼XÐ}þv™râýùcíxsÿ­îÐvyÐ e*'é:QVÇË¥çÓ #XUåï"ãúÔÐñê…ŒH;>ýz†Îé#}ïe*!¦^írkãøÐz: 8&–ã5ßóúâ"éK‡NÓt_á¦ïÎÁq‚Çdì¥â}ﶹOÞ6÷ÕWàøàÌCéwÇùÝçß[çtÔÛAw½~=ý÷ÚÁõ…x÷{!Üò.•ž?Ro…äí _P°êp_½î»s^o­;~üBw¢ÜgÄ‘WèÙñË:Ñk‹”ºX¨¿WK[N¼(ÿ:½¶ür×&ÒwJ…z¼Õ·¤_Ÿ„zËë×Ó¯wüxµ*”?ÒREén¯+»žán|Û.{I^¹AR[™‘é?óöªë¹È¦¯YºGç»NDúØǼœ²»¶h9¸8`LŸù)Iu-'eÿDª/‰ÀxÙ»p<àxñ/¼‘Fp<àxÀñ8ÇLlǾ:Ññ«lë.KÄ^~=^(ØVŽoÄÀDt¼xBÔS¹@êBój,Ù»¬ÜSX 9/&ú úÂNã>ðôú|Îmî[wåòOÙê¯òóåtËšŸËÍ7áNÏå×gj~ ”ÇO‹Ÿr9wb._Èçä‹¢2¯¥Nr·KΞXššË•~gñØ:׎/‰ù®Ë#î÷¦‹v¹gkWöêüþkç´`~ø‘RòÌ`~ÊçLE_šâ>òÜ–Ö²ö%¯Œ×nÅÆ€ÉåbcWä<ïk~ 0^ÛñeîÌW½.»å½s}ûXžOTÔu_°½q·rnÙžý»®a®w¼ÒA€ãÇk¯ÎBÌk²;‚Ÿ_ñó¢MŽÝT§êÇŽ7:¾ô:Ô'/ëŠ!Cã•+î‘Slõ£ú¾z£ã½ÙÜ=Žɨr1^ývͽuÞlλ°57Ü…úêe~¦îFõ÷ܹ·Ï•zæíBéæ¹|QéªÏÙvÎ{›r'žÚ‹ïÏíŽ3­¹)`Ü´ã«!|=ZÜñÊwä`<¶ãÇŽÀñ8`¢:^Œ-{/ŽÀñ0ï=Æî¥üXlúñÜÌÓkÿ@ïÑv±M;N|öí­|ÓƶzÆ»òdØdL#¶Õk$·ØCg+^NeÛ[ÁRp<4«ãÕ§ÁæòÕ8^®Rïyké ë¯uÖqâµÛë=!7ØîÐ@7~-ämõWÊStùFœëŽÏäxõ©îþ ìvØ‹V:‡Å§£µ–ºÔ+t¼óFÑœÏÙ¥åÖÇ0N¼a{£îWêÁ{é¾Sß-µÇñÐÔíø’™âCº„›àiíµÒ‘Þ\©»ov—Îñºñå .7׃²þᥨuíŸÀñÐÄŽOìVo¸ãÎyÛ])gb€¹p±q¼qí+îŸßhÇ»}ì –ÏÒW¯N·¿ãÃÄ'9^\<ßÕ_½ãƒž}ý5 Ù%_ÔlWÝîÝ_¡ãÕáÔcã©GúëÕ;ÒÒO^·Š3|ÕNý6šr?Û8ñIÛkº·NY‚èIÐÜp§;O‘§ ì»0–íø1$t;^+ÀUvÀñé„Ù"ÜÊwähšŽ€†9~ ŽOŽßõ'8ÇŽ8Çãxãp<àxÀñ€ãp<ŽÀñ8`Ü9~‡©+p<À8qü´Õêøñ8ÇŽ8Çãxot|>·0_T\`YNrù-êl»4ݲ;ë¹á¶XDne=Š›Ù¨1¦°¨T¥Ö¢‚7­˜_XšX‡Jð Ôƒiº¹ •¹ú|F8¾vŽšQœ­XÐq­]PàÍ&æñ§×KóUø#Ÿ[Th…ØÕjtU)oÛÅ u:#1•œi‰õß p|uŽ­vÓ‘ZñUÇ«¯Ëš@vˆÙ¼¢'³ ån§Šv¡7Ý.”/ß+—+{Ôåý ¹•¥®¥¯¨òíT¿ß"XIYNna.ÖÈÍ/f¨ø\$E;8¥q5õPÏÙoÜ^šòÍíxÑX7µz#i· =S²ÔŒœ¹°ÈÕmhqŽwKE‰éþõ‚P_½zn! ñ äˆÍëWpý\nHhÇÇ&L+ìoš£ùR™ê»Ô×j›;3b[ìEÞ9DèZIPÕ) 7Ôƒ©ž3;>q{ÕO šÍñŽÉtFt²¡ö}IÒò¸¿(Õ‘]Qòh¼¯6‘#s* Dƒã“:ó38^,(|oAÁö¤¥þ*´zʹŽUùEÙ¯P*ÖÐ Nq÷€¡Lõ\I;>i{: iG姕wzÇkï×k%LJ7§Òv|¤m¹í±ŒÂÓ8>ñ¾È ¯ÇǶÇ4±ãc}õ¦þgSŸy6Ç­Z ý}gnׂÚoi[ûņ¯I—i¿†åª(ÓàøÐü•ÊÖsê/(U,W­µÞXdžzH¶ozÇ'm/}õcîøä±eC20ß³–±Z9¡ýxö¢à’|°J óùEêMsʽrÑË ±õŒ®OôöºH9þD¡4¯4¹\u¡Vüô(›ó‚µÒ×OºNC=hëÙTÆúIØ^î¹;ǧ?¾\¿.¤o—7×—ïë ßhzÇ/CLw/Žãí¥ÐüŽ8>5–eñyŽÇñ8ÇàxÐòŽ·ï²¬»rùõÞ¢VÙ–˜2?_v X¹§Š8 YÛñëó9!õ ž¹s¹ùµ}œIAœF¤?Àñ€ãkçø yéuõµß¦w£JºøT.>±t®0?—+½%t¢Ÿî-Àñq¼Ð¹¶è~·WŽ-V’¶W…ÖI˜>Ú:w4_¹á·å¯àxÀñ5u¼Û£.8^ZÙK*Ç{}þò¤!¾%² ¡ëÇŽ¯­ã…• …R“]:^X?è]n®ÞñŽàiÇÔÃñ;`v¼‡âøPƒ¾*ǧë¨Çñ0ÿÚk¯¤Ÿ`@qüá«­]ï5:Þëw›ìAç¼cwÿÞ:ñ[ûœ×]ïöê‡âݯ't¯î+7å¢_ÏÃñŠãÅ¿##ƒ›6õoØÐ-ÞßßÞ×·®§§(ÒÝý’HWךŽŽ•[¶lsvv¾˜ÖñÍŽ€ èx!xÑE?4´Iˆ|óæõ›6 ¸éùå¾{]÷wÓ‹9‹Å¥8 e/,.?8ø²'ø’Ý¥àׯïò¿bÅÓ8 e/ºè½¼cwWí^:D§½˜ó¹çÃñ-ãxq^ퟗ‘j÷#¿xñíêx€‰êø~‘§Ÿ~,"x1Eü+nÄ“Ž晇p<@Ë8^ÜB/¼.t.#zéE„×ý)¾ã-ú3ŽhÇ Ë滪yUð¢¡/ï¹Ãñ­äxáoy½ˆ¯v_ðžãW»ŽÇ´ãW‹ïÈÅ5/Ô.ÓÛÛ†ãZÏñâéu¢s^hÞ«¼¸`/æÁñ­çxaty«Œ|¨­ïxqÁ^<ÎÇ´˜ã×­[.\.Œ.¿/§Ú]>µ^\°oo_1špÏflYkÇ‹'܉¦¼¸âîeÿZL‚ßžs.]úhêñã`L/ñ)g^µê™Ðز8 ™/žT¿|ù_E'üÓOÿá‰'îüñ±Ü÷ä“,YRãÖ¤r¼˜ƒB!­˜$ÇsÞÐÒÿ³ÿüþüÿÖ=wCæîïÿï|ïkßÿÞW !„ÒlŽ¦¾çß¾!óã}[xÜèøç–-ýû¢§Ÿ|êq™Çô±¿}ìa‘Gä!™Â#NyäÏJtRøÓ#…?$åáßÉÜ<üð…‡ÿKŸ…÷B!8 Ô<üÐoe ûhaÁãÝ/óô“¿_ò?ßÞQ|©¸êÅÕ+eV®Z¾bå nž_±âùå+ž[áÆ}±$–Å¥,y&œE~–¿ð·–ý}Ų¿9yÁͲ¿Š,_öT4Ï?¹üù'!„ žž{|ùóQ³b™˜ò˜ÈŠeY¹üq™Õ+Ÿh[ýW£ãûzúú»{z;Kééèéõ"^÷´{Y«¤MIÑÍ%«t»ézÑI÷*?Ý]+Ezº–ëÓ¹ÌËó„BÈLwÇsá,õÓÕ.³¸«c‰Lwdz=KŽßør(û6nìÑ¥;š nÚ#Ù°~›¶HÖ#Ùп:œU^VB!6}«DÖ÷­ ç5}Ï;é]&bv¼"ò œ”Œ^R¸&Öw(Y§ÄqùÀÀZÕåý/EÓ·ÚÍ*?rú½ ô® „BÈ@ï J–ùéïy^d ÷9O!„àxO!„àxO!„àxO!„ÔÍñ»âxB!ÇãxB!¤9ÿ§ßýôO¿»ÇB!ãÑñ¿¿W Hƒã !„ñÖW/Kr¼úúR68é’Y?Щf` ]$ôº]$ýmJ£÷÷­‘^ïï{Q°{ïÊHÄfô÷B!ÄIowéê{·›žçœt/éë~VÄèøˆËã^÷²6š˜ÑK.7x]y½Òo¾;­vO!„”¼ãuy ^}]Æña‘—è£{ñûÞûûÛúÓ¶×ÝøÞUn4F÷¥îwG”NX!„RÊsþ5xÑ‚÷_'9¾¿o]’¶K‘?ö÷•¬‰¦wuitƒË{»Wˆôu/‘Fïév"ÎPâéëzŽB!¡t.‘×àæ»ÿºs‰Ññ½½«Eúz_)½îyQ&òÚI÷ªpV˜"ý­‰;tl·;/ÈsÑt-bt|ÛKÿ#R\³ø¥—J‘?ú)M_óLÙWÿ­|^|ÚÉê¿FóâSjÖB!8/½ø„ŒÝ}Í‹ë_¯ú‹Ññ/®ü[™¬xZ›U+žLÌA–?Í 9Q_+YéäB!dbfÕ ú?ÊëîòWÁëeÞëeï6Ö—´½ôlÛKK½<˜g­—¶5‹£q;4)Í°()«ÿIªþB!dbÅïùv{Ä_ü›ÓÜ_ùäš•OhÿÎÓ:¥æwøL_Ö8ÅB!¤"¿ßÃ!Ç¿õ„Uo?£ø–WþÃQ+²Æ:|Mæˆ5hΞ=ÓÖdOc6'ûŠU°ùMûé7fÅ´ùk’fÝ-ùCžÈG˜m~Ó.¥¢;h‰µïCÖn?u¿óo‘äÜë½h@îÍž†¬Ø® IcV¬‚JnÌR*Ùü{3§A»e•Ü4¨’“‰}PjÞkÌ1yýí7îïå§Î‹÷ÿ»ëøwýÐù!„BÆWþ? £[)IEND®B`‚hugs98-plus-Sep2006/docs/users_guide/xml2sgml.sed0000644006511100651110000000021210305333531020462 0ustar rossross//d /^%/d /^:>:g hugs98-plus-Sep2006/dotnet/0000755006511100651110000000000010504340131014247 5ustar rossrosshugs98-plus-Sep2006/dotnet/doc/0000755006511100651110000000000010504340131015014 5ustar rossrosshugs98-plus-Sep2006/dotnet/doc/dotnet-ffi.html0000644006511100651110000001720007633774366017777 0ustar rossross Accessing .NET via the FFI

Accessing .NET via the FFI

Access to .NET functionality is provided via Haskell's FFI declarations. For example, to use the .NET Framework's static method for looking up environment variables, you'd write the following FFI declaration: 

module Env where
import Dotnet

foreign import dotnet
  "static System.Environment.GetEnvironmentVariable"
  getEnv :: String -> IO String

It declares the IO action getEnv which given the name of an environment variable will look it up by calling System.Environment's static method. The result is whatever the variable maps to, or the empty string if the variable isn't present in the environment block.

getEnv is bound to its .NET method via a specification string. The qualifier, static, indicates that we're binding to a static method; the second part gives the fully qualified name of the static method we're binding to. To tell the FFI implementation that we're accessing .NET code, the dotnet calling convention qualifier is used (and required.)

Along with the specification string goes the Haskell type given to the method. Clearly, this type has to be compatible with the corresponding .NET type. If not, method invocation will fail and a Haskell IO exception is raised.

Binding isn't limited to methods; to access a field you'd write the following: 

module Math where
import Dotnet

foreign import dotnet
  "static field System.Math.PI"
  piVal :: Double

which binds piVal to the value of the static field System.Math.PI -- making the (quite reasonable!) assumption that the value is indeed constant. If it hadn't been constant, giving piVal the type (IO Double) would have been more appropriate.

The above FFI declaration uses the field qualifier in its specification string to indicate that we're binding to a field and not a method. The Hugs98.net implementation looks at the result type of a declaration using field to determine whether the field access is a read or write operation. If the result is of the form (IO ()) (or ()piVal above.) For instance, to provide a way to update the PI field: 

foreign import dotnet
  "static field System.Math.PI"
  setPiVal :: Double -> IO ()

This will actually fail should you attempt to use it, as the field is read-only, but demonstrates how to use an FFI declaration to provide field update functions.

Creating and representing objects

Object constructors are accessed along similar lines: 

foreign import dotnet
  "ctor System.Object"
  newObject :: IO (Object a)

The ctor in the specification string signals that we're binding to a constructor; in this case the default constructor for System.Object. Object references are represented using the type Object. It is parameterised over the type of the class the reference is an instance of. This typed representation of object references lets us use the standard 'trick' of encoding single-inheritance object type hierarchies: 

-- System.Xml.XmlNode
data XmlNode_ a
type XmlNode a = Object (XmlNode_ a)

-- System.Xml.XmlDocument; sub-class of XmlNode
data XmlDocument_ a
type XmlDocument a = XmlNode (XmlDocument_ a)

-- System.Xml.XmlDataDocument; sub-class of XmlDocument
data XmlDataDocument_ a
type XmlDataDocument a = XmlDocument (XmlDataDocument_ a)

obj1 :: XmlDataDocument () -- a reference to an instance of XmlDataDocument
obj2 :: XmlNode a  -- a reference to an object that's at least an XmlNode.

This nesting of the inheritance chain in the type argument helps preserve type safety in Haskell: 

foreign import dotnet
  "method System.Xml.XmlDocument.Load"
  load :: String{-URL-} -> XmlDocument a -> IO ()

The this pointer is here constrained to be (Object (XmlNode (XmlDocument_ a)), i.e., it needs to at least implement System.Xml.XmlDocument, which precisely captures the type constraint on the method.

Clearly this is all dependent on the user being precise when encoding the class hierarchies using types like in the above example. To help writing out FFI declarations and give these appropriate Haskell types, the hugs98.net distribution comes with a tool, hswrapgen, for generating FFI declarations and object types for a .NET class (see dotnet/tools in the distribution.)

To return to the above FFI declaration, it also demonstrates how to bind to non-static methods. Apart from using the method qualifier in the specification string, method bindings take the 'this' pointer as their last argument. This is so that you can write OO-looking code using the (#) from the Dotnet library: 

createDoc url = do
  d <- newDoc 
  d # load url
  return d

So given the above declaration along with: 

foreign import dotnet
  "ctor System.Xml.XmlDocument"
  newDoc :: IO (XmlDocument ())

you're all set to manipulate XML documents. Notice the type argument to XmlDocument for the constructor, (), capturing the fact that the constructor is returning a specific instance.

One final word on constructors; binding to parameterised constructors is straightforward also: 

foreign import dotnet
  "ctor System.Drawing.Icon"
  newIcon :: String -> IO (Icon ()) 
     -- assuming you've defined the Icon object type.

FFI summary

The .NET foreign import declarations have the following form: 

ffidecl : ...
        | 'foreign' 'import' 'dotnet'
	      "spec-string" varName '::' ffiType

spec-string : ('static')? 
              ('field'|'ctor'|'method')?
	      ('[' assemblyName ']')?
	      .NETName

ffiType : PrimType -> ffiType
        | IO PrimType
	| PrimType

PrimType = standard FFI types + Object a + String

i.e., a standard foreign import in Haskell, but with a specification string that lets you unambiguously declare what .NET entity that's being imported / bound to. The first two (optional) entries in the specification string qualifies what kind of entity we're binding to. If they're both omitted, this is equivalent to using method.

By default, the hugs98.net implementation will consult the .NET 'standard' assemblies (i.e., assemblies installed in the same directory as your copy of mscorlib.dll) when attempting to bind to the .NET entity. If its class is part of some other assembly, you may prefix the fully-qualified class name with the name of the assembly, 

foreign import dotnet
  "static [foo.dll]Foo.bar"
  bar :: Int -> IO Int

Assuming foo.dll can be located by the .NET run-time via its assembly search path, foo.dll:Foo.bar can now be accessed.

The range of types supported as arguments to and results of foreign imported .NET entities are those of the Haskell FFI, but extended with support for both passing and returning .NET object references (Object) together with Haskell strings.

<sof@galois.com>
Last modified: Wed Mar 12 07:51:36 Pacific Standard Time 2003 hugs98-plus-Sep2006/dotnet/doc/dotnet-lib.html0000644006511100651110000003153107633774366020004 0ustar rossross Dotnet library and tools

The Dotnet library

The Dotnet library provides you with miscellaneous auxillary functions to help you interoperate with .NET.

Representing object references

At the base, the library defines and exports the Object type which is used to represent .NET object references: 

data Object a = ...abstract...

instance Eq (Object a)   where {...}
instance Show (Object a) where {...}
The Object type is parameterised over a type that encodes the .NET class reference it is representing. To illustrate how, the Dotnet.System.Object and Dotnet.System.String modules define the following: 
-- module providing the functionality of System.Object
module Dotnet.System.Object 
         ( Dotnet.Object
	 , module Dotnet.System.Object
	 ) where 

import Dotnet ( Object )

getHashCode :: Object a -> IO Int
getHashCode = ...
...

-- module providing the functionality of System.Xml.XmlNode
module Dotnet.System.Xml.XmlNode where

import Dotnet.System.Object
...
data XmlNode_ a
type XmlNode a = Dotnet.System.Object.Object (XmlNode_ a)
...
foreign import dotnet
  "method System.Xml.XmlNode.get_InnerXml"
  get_InnerXml :: XmlNode obj -> IO (String)

...
-- module providing the functionality of System.Xml.XmlDocument
module Dotnet.System.Xml.XmlDocument where

import Dotnet
import Dotnet.System.Xml.XmlNode

data XmlDocument_ a
type XmlDocument a = XmlNode (XmlDocument_ a)

...
foreign import dotnet
  "method System.Xml.XmlDocument.LoadXml"
  loadXml :: String -> XmlDocument obj -> IO (())
...

[The reason why Dotnet. is prefixed to each Haskell module is to avoid naming conflicts with other common Haskell modules. See the tools for more details. ]

Notice the type given to Dotnet.System.Xml.XmlNode.get_InnerXml's argument -- XmlNode obj -- capturing precisely that the method get_InnerXml is supported on any object that is an instance of System.Xml.XmlNode or any of its sub-classes (like XmlDocument.) If we expand a type like XmlDocument (), we get: 

XmlDocument () == Dotnet.Object (XmlNode_ (XmlDocument_ ()))

Notice how the type argument to Dotnet.Object encodes the inheritance structure: System.Xml.XmlDocument is a sub-class of System.Xml.XmlNode which again is a sub-class of System.Object. The unit type, (), all the way to the right is used to terminate the chain and state that the type represent just XmlDocument (but none of its sub-classes.)

If instead of () a type variable had been used, like what was done for get_InnerXml's argument type, the type is a subtype. So, if you've got a System.Xml.XmlNode or one of its sub-classes (like XmlDocument), you can safely invoke the method get_InnerXml -- the type variable obj permitting the use of any subtype of System.Xml.XmlNode.

This type trick is a good way to safely represent .NET object references using Haskell's type system. If you're already familiar with the work on integrating COM with Haskell, you'll have already recognised that the type encoding used here mirrors that used for COM interface hierarchies.

OO-style application

To support the syntax for conventional OO-style method invocation, the Dotnet module exports the following two combinators: 

infix 8 #
infix 9 ##

( # )  :: a -> (a -> IO b) -> IO b
obj # method = method obj

( ## ) :: IO a -> (a -> IO b) -> IO b
mObj ## method = mObj >>= method
Using these, method invocation can be expressed as follows: 
  l <- str # Dotnet.System.String.lengthString 
  putStrLn ("Length of string: " ++ show l)

Supporting marshaling

The main way to bind to the .NET object model is to use FFI declarations, but the Dotnet library provides an alternate way (which used to be the only way prior to the integration of .NET interop into the FFI). This route is mainly provided for backwards compatibility, so unless you have a specific reason not to employ the FFI route, the next couple of sections of this document is of limited interest.

To support the automatic marshaling of values between the .NET and Haskell worlds, Dotnet provides two Haskell type classes: 

class NetType a where
   arg    :: a -> InArg
   result :: Object () -> IO a

type InArg = IO (Object ())

class NetArg a where
  marshal :: a -> IO [Object ()]
Both NetType and NetArg work in terms of Dotnet.Object () -- an untyped representation of object references.

The following instances are provided: 

instance NetType (Object a)
instance NetType ()
instance NetType Int
instance NetType {Int8, Int16, Int32}
instance NetType {Word8, Word16, Word32}
instance NetType Bool
instance NetType Char
instance NetType String
instance NetType Float
instance NetType Double
In addition to object references, instances also let you convert to/from the 'standard' unboxed types that the .NET framework provides.

The NetType class takes care of marshaling single arguments to/from their .NET representations; the NetArg deals with marshaling a collection of such arguments: 

instance NetArg ()  -- no args
instance NetType a => NetArg a  -- one arg
instance (NetArg a1, NetArg a2) => NetArg (a1,a2)     -- 2 args
...
instance (NetArg a1, NetArg a2, NetArg a3,
	  NetArg a4, NetArg a5, NetArg a6,
	  NetArg a7) => NetArg (a1,a2,a3,a4,a5,a6,a7) -- 7 args

The idea is here to use tuples to do uncurried method application; details of which will be introduced in the next section.

Creating .NET objects

To create a new object, use one of the following actions: 
type ClassName = String

new    :: ClassName -> IO (Object a)
newObj :: (NetArg a)
       => ClassName
       -> a
       -> IO (Object res)
createObj :: ClassName -> [InArg] -> IO (Object a)
To call the nullary constructor for an object, simply use new: 
main = do
   x <- new "System.Object"
   print x -- under-the-hood this calls ToString() on 'x'

To use a parameterised constructor instead, you can use newObj or createObject: 

newXPathDoc :: String
            -> System.Xml.XmlSpace
	    -> IO (System.Xml.XPath.XPathDocument ())
newXPathDoc uri spc = newObj "System.Xml.XPath.XPathDocument" (uri,spc)

newBitmap :: Int -> Int -> IO (System.Drawing.Bitmap ())
newBitmap w h = createObj "System.Drawing.Bitmap" [arg w, arg h]

createObj lets you pass a list of arguments, but you have to explicitly apply arg to each of them. newObj takes care of this automatically provided you 'tuple up' the arguments.

new can clearly be expressed in terms of these more general constructor actions: 

-- 
new cls = newObj cls ()
-- or
-- new cls = createObj cls []
Note: the reason why both createObj and newObj, which perform identical functions, are provided, is to gain experience as to what is the preferred invocation style.

Unsurprisingly, these two different forms of marshaling arguments are also used when dealing with method invocation, which we look at next.

Calling .NET methods

To invoke a static method, use invokeStatic or staticMethod: 
type MethodName = String

invokeStatic :: (NetArg a, NetType res)
	     => ClassName
	     -> MethodName
             -> a
             -> IO res
staticMethod :: (NetType a)
             => ClassName
	     -> MethodName
             -> [InArg]
             -> IO a
staticMethod_ :: ClassName
	      -> MethodName
              -> [InArg]
              -> IO ()
invokeStatic uses the NetArg type class, so you need to tuple the arguments you pass to the static method: 
doFoo :: String -> Int -> IO String
doFoo x y = invokeStatic "System.Bar" "Foo" (x,y)
staticMethod uses a list to pass arguments to the static method, requiring you to apply the (overloaded) marshaling function first: 
urlEncode :: String -> IO String
urlEncode url = staticMethod "System.Web.HttpUtility"
                             "UrlEncode"
			     [arg url]
Instance method invocation is similar, but of course requires an extra 'this' argument: 
invoke :: (NetArg a, NetType res)
       => MethodName
       -> a
       -> Object b
       -> IO res

method :: (NetType a)
       => MethodName
       -> [InArg]
       -> Object b
       -> IO a

method_ :: MethodName
        -> [InArg]
        -> Object a
        -> IO ()
For example, 
main = do
  obj <- new "System.Object"
  x   <- obj # invoke "GetHashCode" ()
  print ("The hash code is: " ++ show (x::Int))

Field access

As with methods, the Dotnet library provides access to both static and instance fields: 
type FieldName = String

fieldGet :: (NetType a) => FieldName -> Object b -> IO a
fieldSet :: (NetType a) => FieldName -> Object b -> a -> IO ()

staticFieldGet :: (NetType a) => ClassName -> FieldName -> IO a
staticFieldSet :: (NetType a) => ClassName -> FieldName -> a -> IO ()

Using delegators

To assist in the interoperation with the .NET framework (the UI bits, in particular), the Dotnet library lets you wrap up Haskell function values as .NET delegators: 
newDelegator :: (Object a -> Object b -> IO ())
	     -> IO (Object (Dotnet.System.EventHandler ())))
When the System.EventHandler object reference is passed to another .NET method, it can invoke it just like any other EventHandler delegate. When that happens, the Haskell function value you passed to newDelegator is invoked. (The way this is done under the hood is kind of funky, requiring some dynamic code (and class) generation, but I digress.)

To see the delegator support in action, have a look at the UI examples in the distribution.

Creating a Haskell-based .NET class

The Dotnet library provides experimental support for creating new classes that wrap up Haskell IO actions: 
defineClass :: Class -> IO (Object b)

data Class 
 = Class String		-- type/class name
 	 (Maybe String) -- Just x => derive from x
 	 [Method]

data Method
 = Method MethodName       -- .NET name (unqualified).
	  Bool             -- True => override.
 	  String           -- Haskell function to call.
	  [BaseType]       -- Argument types
	  (Maybe BaseType) -- result (Nothing => void).
See examples/class/ in the distribution for more.

Tool support for interfacing with .NET Framework classes

One thing that immediately strikes you when looking at the .NET Framework for the first time is its size. Clearly, it wouldn't be practical to manually type out Haskell wrappers for each and every class that it provides.

To assist in the interfacing to .NET classes, a utility HsWrapGen is provided. Given the name of a .NET class, it generates a Haskell module wrapper for the class, containing FFI declarations that lets you access the methods and fields of a particular class. See the dotnet/tools/ directory, if interested.

Note: Hugs98 for .NET makes good use of the hierarchical module extension to Haskell, so if you do write / generate your own class wrappers, you may want to consider putting them inside the library tree that Hugs98 for .NET comes with.

To demonstrate where and how, supposing you had written a Haskell wrapper for System.Xml.Schema.XmlSchema, you need to name the Haskell module just that, i.e.,: 

module Dotnet.System.Xml.Schema.XmlSchema where { .... }
and place it in dotnet/lib/Dotnet/System/Xml/Schema/ directory inside the Hugs98 for .NET installation tree. You can then utilise the wrapper module in your own code by importing it as 
import Dotnet.System.Xml.Schema.XmlSchema

To avoid naming conflicts with Haskell's hierarchical library tree, we prefix each of the .NET specific modules with Dotnet..

Last modified: Wed Mar 12 19:18:34 Pacific Standard Time 2003
hugs98-plus-Sep2006/dotnet/doc/dotnet.html0000644006511100651110000000740507743000203017211 0ustar rossross Hugs98 for .NET

Hugs98 for .NET

What is it?

Hugs98 for .NET is an extension of the Hugs98 Haskell interpreter, providing good interoperation between the world of Haskell and the world of .NET and the .NET Framework.

The Hugs98 interpreter has been extended with features which lets you instantiate and use .NET objects from within Haskell, and vice versa, allows you to call and use Haskell functions from any .NET language.

The motivation behind this work is entirely pragmatic -- I want to be able to use a great language on an important, new platform laden with many great features and libraries. In contrast with other attempts at integrating functional languages with the .NET platform, Hugs98 for .NET takes a hands-off approach, providing 'just' the ability to interoperate well with .NET. That is, it does not try to compile Haskell into .NET's IL and have the .NET run-time execute it. Instead the Hugs98 interpreter operates side-by-side with the .NET run-time, providing code in either world with just the ability to call code in the other.

Example

To give a flavour of what's possible with Hugs98 for .NET, here's how to fetch a URL into a Haskell String: 
-- dotnet/examples/basic/Http.hs 
module Main where

import Dotnet

foreign import dotnet
  "static System.Net.WebRequest.Create"
  createURL :: String -> IO (Object ())

fetchURL :: String -> IO String
fetchURL url = do
  req <- createURL url
  when (isNullObj req)
       (ioError (userError ("Unable to fetch " ++ show url)))
  rsp <- req # invoke "GetResponse" ()
  str <- rsp # invoke "GetResponseStream" ()
  str # slurpString
See the documentation and the distribution, which contains this example and many others, for details of what this code is doing.

Download

A Windows Installer containing Hugs98 and the .NET extensions is available via http. To use it, you only need to have the .NET Framework installed on your machine (i.e., no need for Visual Studio .NET).

Sources are available via CVS.

Documentation

For documentation on Haskell, see haskell.org.

The distribution includes documentation on how to interop with the .NET platform, but is also available in on-line form:

  • Accessing .NET via the FFI.
  • The Dotnet library documentation.
  • Brief overview of the samples included in the distribution.

Authors

Info on authors and maintainers of Hugs98 can be found via its homepage.

The .NET extensions are by Sigbjorn Finne, with initial encouragement from Erik Meijer.

Copyright and License

The Hugs 98 system is Copyright © Mark P Jones, Alastair Reid, the Yale Haskell Group, and the Oregon Graduate Institute of Science and Technology, 1994-2003, All rights reserved. It is distributed as free software under the license in the file "License", which is included in the distribution.

The .NET extensions are Copyright Sigbjorn Finne, 2002-2003, All rights reserved. It is distributed as free software under the same license as the Hugs98 interpreter (see the file "License.net" included with the distribution.)

Last modified: Wed Mar 12 21:17:05 Pacific Standard Time 2003
hugs98-plus-Sep2006/dotnet/doc/examples.html0000644006511100651110000000224207633774367017557 0ustar rossross Hugs98 for .NET examples

Hugs98 for .NET examples

The dotnet/examples/ directory contains some simple demos of the .NET extensions:
  • basic/Env.hs -- static method invocation example.
  • basic/Http.hs -- slurping URLs.
  • basic/Mail.hs -- sending mail using the .NET framework classes.
  • delegate/Delegate.hs -- wrapping up Haskell function value as a delegator; demonstrates in the context of an ultra-simple WinForms C# application.
  • callin/CallIn.hs -- low-level example of how to call into Haskell from .NET code.
  • class/NewObj.hs -- shows how to dynamically generate a .NET class whose methods are all implemented by Haskell functions.
  • xml/Xml.hs -- demonstrates how to use the System.Xml classes to create an XML parser in Haskell.
  • forms/Forms.hs -- another WinForms example.
Last modified: Wed Mar 12 16:24:40 Pacific Standard Time 2003 hugs98-plus-Sep2006/dotnet/doc/style.css0000644006511100651110000000536307633416001016706 0ustar rossross.bg3 { font: 10pt/12pt "Arial Times"; font-style: "plain"; font-weight: light; color: #000000; text-align: center; background: FFFFFF } .title { font: 10pt/12pt "Times"; font-style: "plain"; font-weight: light; color: #000000; text-align: center; background: FFFFFF; } body { margin-left: 3%; margin-right: 3%; padding-right; 5%; color: black; background: #fafafa; font-size: 12pt/14pt; font-family: "Arial Narrow", serif; } pre { background: #f6f6f6; padding-left: 2%; } h1 { border-style: solid; font-size: 22pt; font-family: verdana, "Arial", serif; background: #fbf6fd; border-color: #bbbbbb; border-width: 1px; text-align: left; padding-left: 2%; padding-top: 2px; padding-bottom: 2px; } H2 {font-family: "verdana"; font-size: 10pt; font-weight: light; background: #fbf6fd; padding-left: 1%; border-style: solid; border-color: #bbbbbb; border-width: 1px; } H3 {font: 8pt/10pt "verdana"; font-weight: light; background: #fbf6fd; padding-left: 1%; padding-top: 5px; padding-bottom: 5px; border-style: solid; border-color: #bbbbbb; border-width: 1px; } H4 {font-family: "verdana"; font-size: 10pt; font-weight: bold} H5 {font: 8pt/10pt "verdana"; font-weight: light} H6 { font-family: "Verdana, Arial, Helvetica" ; line-height: 100% ; font-size: 10pt ; font-weight: light } CODE {font-family: "Courier, Monaco"} a:link { background: transparent; color: #0000FF; } a:active { color: #FFCC99; } a:visited { color: #800080; } h1 { font-size: 145%; margin-bottom: .5em; } h2 { font-size: 125%; margin-top: 1.5em; margin-bottom: .5em; } h3 { font-size: 110%; margin-top: 1.2em; margin-bottom: .5em; } .foo { margin-left: 3em; padding-top: 3em; align: right; margin-right: 0.4em; } .mblock { margin-left: 5em; align: left; margin-right: 0.4em; } .software { margin-right: 3em; } .pub-list-entry { padding: 4pt; } .bar { align-left: left; padding-top: 0.8em; margin-left: 0em; } .indent { align-left: left; margin-left: 4.5em; } p { margin-top:10pt; margin-bottom: 0pt; } hugs98-plus-Sep2006/dotnet/lib/0000755006511100651110000000000010504340131015015 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/0000755006511100651110000000000010504340131016252 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/0000755006511100651110000000000010504340131017536 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Collections/0000755006511100651110000000000010504340131022014 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Collections/DictionaryEntry.hs0000644006511100651110000000155007633672045025525 0ustar rossrossmodule Dotnet.System.Collections.DictionaryEntry where import Dotnet import qualified Dotnet.System.Object import qualified Dotnet.System.ValueType data DictionaryEntry_ a type DictionaryEntry a = Dotnet.System.ValueType.ValueType (DictionaryEntry_ a) foreign import dotnet "method System.Collections.DictionaryEntry.get_Key" get_Key :: DictionaryEntry obj -> IO (Dotnet.System.Object.Object a0) foreign import dotnet "method System.Collections.DictionaryEntry.set_Key" set_Key :: Dotnet.System.Object.Object a0 -> DictionaryEntry obj -> IO (()) foreign import dotnet "method System.Collections.DictionaryEntry.get_Value" get_Value :: DictionaryEntry obj -> IO (Dotnet.System.Object.Object a0) foreign import dotnet "method System.Collections.DictionaryEntry.set_Value" set_Value :: Dotnet.System.Object.Object a0 -> DictionaryEntry obj -> IO (()) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Collections/ICollection.hs0000644006511100651110000000142207633672045024600 0ustar rossrossmodule Dotnet.System.Collections.ICollection where import Dotnet import qualified Dotnet.System.Object import qualified Dotnet.System.Array data ICollection_ a type ICollection a = Dotnet.System.Object.Object (ICollection_ a) foreign import dotnet "method System.Collections.ICollection.get_IsSynchronized" get_IsSynchronized :: ICollection obj -> IO (Bool) foreign import dotnet "method System.Collections.ICollection.get_SyncRoot" get_SyncRoot :: ICollection obj -> IO (Dotnet.System.Object.Object a0) foreign import dotnet "method System.Collections.ICollection.get_Count" get_Count :: ICollection obj -> IO (Int) foreign import dotnet "method System.Collections.ICollection.CopyTo" copyTo :: Dotnet.System.Array.Array a0 -> Int -> ICollection obj -> IO (()) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Collections/IComparer.hs0000644006511100651110000000055307633673457024271 0ustar rossrossmodule Dotnet.System.Collections.IComparer where import Dotnet import qualified Dotnet.System.Object data IComparer_ a type IComparer a = Dotnet.System.Object.Object (IComparer_ a) foreign import dotnet "method System.Collections.IComparer.Compare" compare :: Dotnet.System.Object.Object a0 -> Dotnet.System.Object.Object a1 -> IComparer obj -> IO (Int) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Collections/IDictionary.hs0000644006511100651110000000377007633672045024622 0ustar rossrossmodule Dotnet.System.Collections.IDictionary where import Dotnet import qualified Dotnet.System.Object import qualified Dotnet.System.Collections.IDictionaryEnumerator import qualified Dotnet.System.Collections.ICollection data IDictionary_ a type IDictionary a = Dotnet.System.Object.Object (IDictionary_ a) foreign import dotnet "method System.Collections.IDictionary.Remove" remove :: Dotnet.System.Object.Object a0 -> IDictionary obj -> IO (()) foreign import dotnet "method System.Collections.IDictionary.GetEnumerator" getEnumerator :: IDictionary obj -> IO (Dotnet.System.Collections.IDictionaryEnumerator.IDictionaryEnumerator a0) foreign import dotnet "method System.Collections.IDictionary.get_IsFixedSize" get_IsFixedSize :: IDictionary obj -> IO (Bool) foreign import dotnet "method System.Collections.IDictionary.get_IsReadOnly" get_IsReadOnly :: IDictionary obj -> IO (Bool) foreign import dotnet "method System.Collections.IDictionary.Clear" clear :: IDictionary obj -> IO (()) foreign import dotnet "method System.Collections.IDictionary.Add" add :: Dotnet.System.Object.Object a0 -> Dotnet.System.Object.Object a1 -> IDictionary obj -> IO (()) foreign import dotnet "method System.Collections.IDictionary.Contains" contains :: Dotnet.System.Object.Object a0 -> IDictionary obj -> IO (Bool) foreign import dotnet "method System.Collections.IDictionary.get_Values" get_Values :: IDictionary obj -> IO (Dotnet.System.Collections.ICollection.ICollection a0) foreign import dotnet "method System.Collections.IDictionary.get_Keys" get_Keys :: IDictionary obj -> IO (Dotnet.System.Collections.ICollection.ICollection a0) foreign import dotnet "method System.Collections.IDictionary.set_Item" set_Item :: Dotnet.System.Object.Object a0 -> Dotnet.System.Object.Object a1 -> IDictionary obj -> IO (()) foreign import dotnet "method System.Collections.IDictionary.get_Item" get_Item :: Dotnet.System.Object.Object a0 -> IDictionary obj -> IO (Dotnet.System.Object.Object a1) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Collections/IDictionaryEnumerator.hs0000644006511100651110000000145507633672045026662 0ustar rossrossmodule Dotnet.System.Collections.IDictionaryEnumerator where import Dotnet import qualified Dotnet.System.Collections.DictionaryEntry import qualified Dotnet.System.Object data IDictionaryEnumerator_ a type IDictionaryEnumerator a = Dotnet.System.Object.Object (IDictionaryEnumerator_ a) foreign import dotnet "method System.Collections.IDictionaryEnumerator.get_Entry" get_Entry :: IDictionaryEnumerator obj -> IO (Dotnet.System.Collections.DictionaryEntry.DictionaryEntry a0) foreign import dotnet "method System.Collections.IDictionaryEnumerator.get_Value" get_Value :: IDictionaryEnumerator obj -> IO (Dotnet.System.Object.Object a0) foreign import dotnet "method System.Collections.IDictionaryEnumerator.get_Key" get_Key :: IDictionaryEnumerator obj -> IO (Dotnet.System.Object.Object a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Collections/IEnumerator.hs0000644006511100651110000000100107633645524024621 0ustar rossross-- -- The IEnumerator interface -- module Dotnet.System.Collections.IEnumerator where import Dotnet import qualified Dotnet.System.Object data IEnumerator_ a type IEnumerator a = Object (IEnumerator_ a) -- ToDo: make this type-safe. current :: Dotnet.System.Object.Object a -> IO (Dotnet.System.Object.Object b) current = invoke "get_Current" () moveNext :: Dotnet.System.Object.Object a -> IO Bool moveNext = invoke "MoveNext" () reset :: Dotnet.System.Object.Object a -> IO () reset = invoke "Reset" () hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Collections/IList.hs0000644006511100651110000000304207633672045023420 0ustar rossrossmodule Dotnet.System.Collections.IList where import Dotnet import qualified Dotnet.System.Object data IList_ a type IList a = Dotnet.System.Object.Object (IList_ a) foreign import dotnet "method System.Collections.IList.RemoveAt" removeAt :: Int -> IList obj -> IO (()) foreign import dotnet "method System.Collections.IList.Remove" remove :: Dotnet.System.Object.Object a0 -> IList obj -> IO (()) foreign import dotnet "method System.Collections.IList.Insert" insert :: Int -> Dotnet.System.Object.Object a1 -> IList obj -> IO (()) foreign import dotnet "method System.Collections.IList.IndexOf" indexOf :: Dotnet.System.Object.Object a0 -> IList obj -> IO (Int) foreign import dotnet "method System.Collections.IList.get_IsFixedSize" get_IsFixedSize :: IList obj -> IO (Bool) foreign import dotnet "method System.Collections.IList.get_IsReadOnly" get_IsReadOnly :: IList obj -> IO (Bool) foreign import dotnet "method System.Collections.IList.Clear" clear :: IList obj -> IO (()) foreign import dotnet "method System.Collections.IList.Contains" contains :: Dotnet.System.Object.Object a0 -> IList obj -> IO (Bool) foreign import dotnet "method System.Collections.IList.Add" add :: Dotnet.System.Object.Object a0 -> IList obj -> IO (Int) foreign import dotnet "method System.Collections.IList.set_Item" set_Item :: Int -> Dotnet.System.Object.Object a1 -> IList obj -> IO (()) foreign import dotnet "method System.Collections.IList.get_Item" get_Item :: Int -> IList obj -> IO (Dotnet.System.Object.Object a1) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Array.hs0000644006511100651110000000117707633645524021205 0ustar rossrossmodule Dotnet.System.Array where import Dotnet import qualified Dotnet.System.Object data Array_ a type Array elt = Dotnet.System.Object.Object (Array_ elt) isFixedSize :: Array elt -> IO Bool isFixedSize = invoke "get_IsFixedSize" () isReadOnly :: Array elt -> IO Bool isReadOnly = invoke "get_IsReadOnly" () isSynchronized :: Array elt -> IO Bool isSynchronized = invoke "get_IsSynchronized" () arrayLength :: Array elt -> IO Int arrayLength = invoke "get_Length" () rank :: Array elt -> IO Int rank = invoke "get_Rank" () -- syncRoot getValue :: NetType elt => Int -> Array elt -> IO elt getValue idx = invoke "GetValue" idx hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Byte.hs0000644006511100651110000000023007633645524021017 0ustar rossrossmodule Dotnet.System.Byte where import Dotnet import qualified Dotnet.System.Object data Byte_ a type Byte a = Dotnet.System.Object.Object (Byte_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Char.hs0000644006511100651110000000023007633645524020771 0ustar rossrossmodule Dotnet.System.Char where import Dotnet import qualified Dotnet.System.Object data Char_ a type Char a = Dotnet.System.Object.Object (Char_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Console.hs0000644006511100651110000000075507633645524021532 0ustar rossrossmodule Dotnet.System.Console where import Dotnet.System.ObjectTy import Char data Console_ a type Console a = Object (Console_ a) foreign import dotnet "static Dotnet.System.Console.Read" readChar :: IO Int foreign import dotnet "static Dotnet.System.Console.ReadLine" readLine :: IO String foreign import dotnet "static Dotnet.System.Console.Write" writeChar :: Char -> IO () foreign import dotnet "static Dotnet.System.Console.WriteLine" writeLine :: String -> IO () hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/DateTime.hs0000644006511100651110000000021607633645524021614 0ustar rossrossmodule Dotnet.System.DateTime where import Dotnet import Dotnet.System.ValueType data DateTime_ a type DateTime a = ValueType (DateTime_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Decimal.hs0000644006511100651110000000025407633645524021460 0ustar rossrossmodule Dotnet.System.Decimal where import Dotnet import qualified Dotnet.System.ValueType data Decimal_ a type Decimal a = Dotnet.System.ValueType.ValueType (Decimal_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Double.hs0000644006511100651110000000025007633645524021330 0ustar rossrossmodule Dotnet.System.Double where import Dotnet import qualified Dotnet.System.ValueType data Double_ a type Double a = Dotnet.System.ValueType.ValueType (Double_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Enum.hs0000644006511100651110000000050307633645524021023 0ustar rossrossmodule Dotnet.System.Enum where import Dotnet import qualified Dotnet.System.ValueType import qualified Dotnet.System.TypeTy data Enum_ a type Enum a = Dotnet.System.ValueType.ValueType (Enum_ a) foreign import dotnet "static Dotnet.System.Enum.Parse" parse :: Dotnet.System.TypeTy.Type a -> String -> IO (Enum b) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/IAsyncResult.hs0000644006511100651110000000000007633645524022474 0ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/IFormatProvider.hs0000644006511100651110000000027207633645524023176 0ustar rossrossmodule Dotnet.System.IFormatProvider where import Dotnet import Dotnet.System.Object data IFormatProvider_ a type IFormatProvider a = Dotnet.System.Object.Object (IFormatProvider_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Int32.hs0000644006511100651110000000024407633645524021020 0ustar rossrossmodule Dotnet.System.Int32 where import Dotnet import qualified Dotnet.System.ValueType data Int32_ a type Int32 a = Dotnet.System.ValueType.ValueType (Int32_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Int64.hs0000644006511100651110000000024407633645524021025 0ustar rossrossmodule Dotnet.System.Int64 where import Dotnet import qualified Dotnet.System.ValueType data Int64_ a type Int64 a = Dotnet.System.ValueType.ValueType (Int64_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/MarshalByRefObject.hs0000644006511100651110000000031707633645524023570 0ustar rossrossmodule Dotnet.System.MarshalByRefObject where import Dotnet import qualified Dotnet.System.Object data MarshalByRefObject_ a type MarshalByRefObject a = Dotnet.System.Object.Object (MarshalByRefObject_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Math.hs0000644006511100651110000001541007633661545021014 0ustar rossrossmodule Dotnet.System.Math where import Dotnet import qualified Dotnet.System.Object import qualified Dotnet.System.Decimal import qualified Data.Int import qualified Data.Word data Math_ a type Math a = Dotnet.System.Object.Object (Math_ a) foreign import dotnet "static method System.Math.Acos" acos :: Double -> IO (Double) foreign import dotnet "static method System.Math.Asin" asin :: Double -> IO (Double) foreign import dotnet "static method System.Math.Atan" atan :: Double -> IO (Double) foreign import dotnet "static method System.Math.Atan2" atan2 :: Double -> Double -> IO (Double) foreign import dotnet "static method System.Math.Cos" cos :: Double -> IO (Double) foreign import dotnet "static method System.Math.Sin" sin :: Double -> IO (Double) foreign import dotnet "static method System.Math.Tan" tan :: Double -> IO (Double) foreign import dotnet "static method System.Math.Cosh" cosh :: Double -> IO (Double) foreign import dotnet "static method System.Math.Sinh" sinh :: Double -> IO (Double) foreign import dotnet "static method System.Math.Tanh" tanh :: Double -> IO (Double) foreign import dotnet "static method System.Math.Round" round :: Double -> IO (Double) foreign import dotnet "static method System.Math.Round" round_1 :: Double -> Int -> IO (Double) foreign import dotnet "static method System.Math.Round" round_2 :: Dotnet.System.Decimal.Decimal a0 -> IO (Dotnet.System.Decimal.Decimal a1) foreign import dotnet "static method System.Math.Round" round_3 :: Dotnet.System.Decimal.Decimal a0 -> Int -> IO (Dotnet.System.Decimal.Decimal a2) foreign import dotnet "static method System.Math.Ceiling" ceiling :: Double -> IO (Double) foreign import dotnet "static method System.Math.Floor" floor :: Double -> IO (Double) foreign import dotnet "static method System.Math.Sqrt" sqrt :: Double -> IO (Double) foreign import dotnet "static method System.Math.Log" log :: Double -> IO (Double) foreign import dotnet "static method System.Math.Log10" log10 :: Double -> IO (Double) foreign import dotnet "static method System.Math.Exp" exp :: Double -> IO (Double) foreign import dotnet "static method System.Math.Pow" pow :: Double -> Double -> IO (Double) foreign import dotnet "static method System.Math.IEEERemainder" iEEERemainder :: Double -> Double -> IO (Double) foreign import dotnet "static method System.Math.Abs" abs :: Data.Int.Int8 -> IO (Data.Int.Int8) foreign import dotnet "static method System.Math.Abs" abs_1 :: Data.Int.Int16 -> IO (Data.Int.Int16) foreign import dotnet "static method System.Math.Abs" abs_2 :: Int -> IO (Int) foreign import dotnet "static method System.Math.Abs" abs_3 :: Data.Int.Int64 -> IO (Data.Int.Int64) foreign import dotnet "static method System.Math.Abs" abs_4 :: Double -> IO (Double) foreign import dotnet "static method System.Math.Abs" abs_5 :: Double -> IO (Double) foreign import dotnet "static method System.Math.Abs" abs_6 :: Dotnet.System.Decimal.Decimal a0 -> IO (Dotnet.System.Decimal.Decimal a1) foreign import dotnet "static method System.Math.Max" max :: Data.Int.Int8 -> Data.Int.Int8 -> IO (Data.Int.Int8) foreign import dotnet "static method System.Math.Max" max_1 :: Data.Word.Word8 -> Data.Word.Word8 -> IO (Data.Word.Word8) foreign import dotnet "static method System.Math.Max" max_2 :: Data.Int.Int16 -> Data.Int.Int16 -> IO (Data.Int.Int16) foreign import dotnet "static method System.Math.Max" max_3 :: Data.Word.Word16 -> Data.Word.Word16 -> IO (Data.Word.Word16) foreign import dotnet "static method System.Math.Max" max_4 :: Int -> Int -> IO (Int) foreign import dotnet "static method System.Math.Max" max_5 :: Data.Word.Word32 -> Data.Word.Word32 -> IO (Data.Word.Word32) foreign import dotnet "static method System.Math.Max" max_6 :: Data.Int.Int64 -> Data.Int.Int64 -> IO (Data.Int.Int64) foreign import dotnet "static method System.Math.Max" max_7 :: Data.Word.Word64 -> Data.Word.Word64 -> IO (Data.Word.Word64) foreign import dotnet "static method System.Math.Max" max_8 :: Double -> Double -> IO (Double) foreign import dotnet "static method System.Math.Max" max_9 :: Double -> Double -> IO (Double) foreign import dotnet "static method System.Math.Max" max_10 :: Dotnet.System.Decimal.Decimal a0 -> Dotnet.System.Decimal.Decimal a1 -> IO (Dotnet.System.Decimal.Decimal a2) foreign import dotnet "static method System.Math.Min" min :: Data.Int.Int8 -> Data.Int.Int8 -> IO (Data.Int.Int8) foreign import dotnet "static method System.Math.Min" min_1 :: Data.Word.Word8 -> Data.Word.Word8 -> IO (Data.Word.Word8) foreign import dotnet "static method System.Math.Min" min_2 :: Data.Int.Int16 -> Data.Int.Int16 -> IO (Data.Int.Int16) foreign import dotnet "static method System.Math.Min" min_3 :: Data.Word.Word16 -> Data.Word.Word16 -> IO (Data.Word.Word16) foreign import dotnet "static method System.Math.Min" min_4 :: Int -> Int -> IO (Int) foreign import dotnet "static method System.Math.Min" min_5 :: Data.Word.Word32 -> Data.Word.Word32 -> IO (Data.Word.Word32) foreign import dotnet "static method System.Math.Min" min_6 :: Data.Int.Int64 -> Data.Int.Int64 -> IO (Data.Int.Int64) foreign import dotnet "static method System.Math.Min" min_7 :: Data.Word.Word64 -> Data.Word.Word64 -> IO (Data.Word.Word64) foreign import dotnet "static method System.Math.Min" min_8 :: Double -> Double -> IO (Double) foreign import dotnet "static method System.Math.Min" min_9 :: Double -> Double -> IO (Double) foreign import dotnet "static method System.Math.Min" min_10 :: Dotnet.System.Decimal.Decimal a0 -> Dotnet.System.Decimal.Decimal a1 -> IO (Dotnet.System.Decimal.Decimal a2) foreign import dotnet "static method System.Math.Log" log_1 :: Double -> Double -> IO (Double) foreign import dotnet "static method System.Math.Sign" sign :: Data.Int.Int8 -> IO (Int) foreign import dotnet "static method System.Math.Sign" sign_1 :: Data.Int.Int16 -> IO (Int) foreign import dotnet "static method System.Math.Sign" sign_2 :: Int -> IO (Int) foreign import dotnet "static method System.Math.Sign" sign_3 :: Data.Int.Int64 -> IO (Int) foreign import dotnet "static method System.Math.Sign" sign_4 :: Double -> IO (Int) foreign import dotnet "static method System.Math.Sign" sign_5 :: Double -> IO (Int) foreign import dotnet "static method System.Math.Sign" sign_6 :: Dotnet.System.Decimal.Decimal a0 -> IO (Int) foreign import dotnet "static field System.Math.PI" get_PI :: IO (Double) foreign import dotnet "static field System.Math.PI" set_PI :: Double -> IO () foreign import dotnet "static field System.Math.E" get_E :: IO (Double) foreign import dotnet "static field System.Math.E" set_E :: Double -> IO () hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Object.hs0000644006511100651110000000163307633645524021332 0ustar rossrossmodule Dotnet.System.Object (module Dotnet.System.Object, module Dotnet.System.ObjectTy ) where import qualified Dotnet ( Object ) import Dotnet hiding ( Object ) import Dotnet.System.TypeTy import Dotnet.System.ObjectTy import Dotnet.System.StringTy foreign import dotnet "method Dotnet.System.Object.Equals" equals :: Object a -> Object b -> IO Bool foreign import dotnet "method Dotnet.System.Object.GetHashCode" getHashCode :: Object a -> IO Int foreign import dotnet "method Dotnet.System.Object.GetType" getType :: Object a -> IO (Type ()) foreign import dotnet "method Dotnet.System.Object.MemberwiseClone" memberwiseClone :: Object a -> IO (Type a) foreign import dotnet "static method Dotnet.System.Object.ReferenceEquals" referenceEquals :: Object a -> Object b -> IO Bool foreign import dotnet "method Dotnet.System.Object.ToString" toString :: Object a -> IO String hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/ObjectTy.hs0000644006511100651110000000022307633645524021641 0ustar rossrossmodule Dotnet.System.ObjectTy (Dotnet.Object(..)) where import qualified Dotnet --data Object_ a --type Object a = Dotnet.Object (Object_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Single.hs0000644006511100651110000000025007633645524021337 0ustar rossrossmodule Dotnet.System.Single where import Dotnet import qualified Dotnet.System.ValueType data Single_ a type Single a = Dotnet.System.ValueType.ValueType (Single_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/String.hs0000644006511100651110000000157307633645524021375 0ustar rossrossmodule Dotnet.System.String ( module Dotnet.System.String, module Dotnet.System.StringTy ) where import Dotnet hiding ( Object, new ) import Dotnet.System.Object import Dotnet.System.StringTy new :: String -> IO (StringTy ()) new str = newString str foreign import dotnet "static field Dotnet.System.String.Empty" empty :: IO (StringTy a) foreign import dotnet "method Dotnet.System.String.get_Chars" charAt :: Int -> StringTy a -> IO Char foreign import dotnet "method Dotnet.System.String.get_Length" lengthString :: StringTy a -> IO Int foreign import dotnet "method Dotnet.System.String.Clone" clone :: StringTy a -> IO (StringTy a) foreign import dotnet "method Dotnet.System.String.EndsWith" endsWith :: String -> StringTy a -> IO Bool foreign import dotnet "method Dotnet.System.String.StartsWith" startsWith :: String -> StringTy a -> IO Bool hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/StringTy.hs0000644006511100651110000000023307633645524021702 0ustar rossrossmodule Dotnet.System.StringTy where import qualified Dotnet ( Object ) import Dotnet.System.ObjectTy data String_ a type StringTy a = Object (String_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Type.hs0000644006511100651110000000033707633645524021045 0ustar rossrossmodule Dotnet.System.Type ( module Dotnet.System.Type, module Dotnet.System.TypeTy ) where import Dotnet.System.TypeTy foreign import dotnet "static Dotnet.System.Type.GetType" getType :: String -> IO (Type ()) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/TypeCode.hs0000644006511100651110000000024307633645524021634 0ustar rossrossmodule Dotnet.System.TypeCode where import Dotnet import qualified Dotnet.System.Enum data TypeCode_ a type TypeCode a = Dotnet.System.Enum.Enum (TypeCode_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/TypeTy.hs0000644006511100651110000000022107633645524021352 0ustar rossrossmodule Dotnet.System.TypeTy where import qualified Dotnet ( Object ) import Dotnet.System.ObjectTy data Type_ a type Type a = Object (Type_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/UInt32.hs0000644006511100651110000000025007633645524021142 0ustar rossrossmodule Dotnet.System.UInt32 where import Dotnet import qualified Dotnet.System.ValueType data UInt32_ a type UInt32 a = Dotnet.System.ValueType.ValueType (UInt32_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/UInt64.hs0000644006511100651110000000025007633645524021147 0ustar rossrossmodule Dotnet.System.UInt64 where import Dotnet import qualified Dotnet.System.ValueType data UInt64_ a type UInt64 a = Dotnet.System.ValueType.ValueType (UInt64_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Uri.hs0000644006511100651110000001054207633666454020667 0ustar rossrossmodule Dotnet.System.Uri where import Dotnet import qualified Dotnet.System.MarshalByRefObject import qualified Dotnet.System.Object import qualified Dotnet.System.UriHostNameType import qualified Dotnet.System.Array import qualified Dotnet.System.UriPartial data Uri_ a type Uri a = Dotnet.System.MarshalByRefObject.MarshalByRefObject (Uri_ a) foreign import dotnet "method System.Uri.GetHashCode" getHashCode :: Uri obj -> IO (Int) foreign import dotnet "method System.Uri.Equals" equals :: Dotnet.System.Object.Object a0 -> Uri obj -> IO (Bool) foreign import dotnet "method System.Uri.ToString" toString :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_AbsolutePath" get_AbsolutePath :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_AbsoluteUri" get_AbsoluteUri :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_Authority" get_Authority :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_Fragment" get_Fragment :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_Host" get_Host :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_HostNameType" get_HostNameType :: Uri obj -> IO (Dotnet.System.UriHostNameType.UriHostNameType a0) foreign import dotnet "method System.Uri.get_IsDefaultPort" get_IsDefaultPort :: Uri obj -> IO (Bool) foreign import dotnet "method System.Uri.get_IsFile" get_IsFile :: Uri obj -> IO (Bool) foreign import dotnet "method System.Uri.get_IsLoopback" get_IsLoopback :: Uri obj -> IO (Bool) foreign import dotnet "method System.Uri.get_IsUnc" get_IsUnc :: Uri obj -> IO (Bool) foreign import dotnet "method System.Uri.get_LocalPath" get_LocalPath :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_PathAndQuery" get_PathAndQuery :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_Port" get_Port :: Uri obj -> IO (Int) foreign import dotnet "method System.Uri.get_Query" get_Query :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_Scheme" get_Scheme :: Uri obj -> IO (String) foreign import dotnet "method System.Uri.get_Segments" get_Segments :: Uri obj -> IO (Dotnet.System.Array.Array (String)) foreign import dotnet "method System.Uri.get_UserEscaped" get_UserEscaped :: Uri obj -> IO (Bool) foreign import dotnet "method System.Uri.get_UserInfo" get_UserInfo :: Uri obj -> IO (String) foreign import dotnet "static method System.Uri.CheckHostName" checkHostName :: String -> IO (Dotnet.System.UriHostNameType.UriHostNameType a1) foreign import dotnet "static method System.Uri.CheckSchemeName" checkSchemeName :: String -> IO (Bool) foreign import dotnet "static method System.Uri.FromHex" fromHex :: Char -> IO (Int) foreign import dotnet "method System.Uri.GetLeftPart" getLeftPart :: Dotnet.System.UriPartial.UriPartial a0 -> Uri obj -> IO (String) foreign import dotnet "static method System.Uri.HexEscape" hexEscape :: Char -> IO (String) foreign import dotnet "static method System.Uri.HexUnescape" hexUnescape :: String -> Int -> IO (Char) foreign import dotnet "static method System.Uri.IsHexDigit" isHexDigit :: Char -> IO (Bool) foreign import dotnet "static method System.Uri.IsHexEncoding" isHexEncoding :: String -> Int -> IO (Bool) foreign import dotnet "method System.Uri.MakeRelative" makeRelative :: Dotnet.System.Uri.Uri a0 -> Uri obj -> IO (String) foreign import dotnet "static field System.Uri.UriSchemeFile" get_UriSchemeFile :: IO (String) foreign import dotnet "static field System.Uri.UriSchemeFtp" get_UriSchemeFtp :: IO (String) foreign import dotnet "static field System.Uri.UriSchemeGopher" get_UriSchemeGopher :: IO (String) foreign import dotnet "static field System.Uri.UriSchemeHttp" get_UriSchemeHttp :: IO (String) foreign import dotnet "static field System.Uri.UriSchemeHttps" get_UriSchemeHttps :: IO (String) foreign import dotnet "static field System.Uri.UriSchemeMailto" get_UriSchemeMailto :: IO (String) foreign import dotnet "static field System.Uri.UriSchemeNews" get_UriSchemeNews :: IO (String) foreign import dotnet "static field System.Uri.UriSchemeNntp" get_UriSchemeNntp :: IO (String) foreign import dotnet "static field System.Uri.SchemeDelimiter" get_SchemeDelimiter :: IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/UriHostNameType.hs0000644006511100651110000000027707633645524023167 0ustar rossrossmodule Dotnet.System.UriHostNameType where import Dotnet import qualified Dotnet.System.Enum data UriHostNameType_ a type UriHostNameType a = Dotnet.System.Enum.Enum (UriHostNameType_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/UriPartial.hs0000644006511100651110000000025307633645524022175 0ustar rossrossmodule Dotnet.System.UriPartial where import Dotnet import qualified Dotnet.System.Enum data UriPartial_ a type UriPartial a = Dotnet.System.Enum.Enum (UriPartial_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/ValueType.hs0000644006511100651110000000025407633645524022040 0ustar rossrossmodule Dotnet.System.ValueType where import Dotnet import qualified Dotnet.System.Object data ValueType_ a type ValueType a = Dotnet.System.Object.Object (ValueType_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml.hs0000644006511100651110000000076507633645524020671 0ustar rossrossmodule Dotnet.System.Xml where data XmlNodeType = Attribute | CDATA | Comment | Document | DocumentFragment | Element | EndElement | EndEntity | Entity | EntityReference | None | Notation | ProcessingInstruction | SignificantWhitespace | Text | Whitespace | XmlDeclaration deriving ( Eq, Enum ) data ReadState = Closed | EndOfFile | Error | Initial | Interactive deriving ( Eq, Enum ) data XmlSpace = DefaultSpace | NoSpace | PreserveSpace deriving ( Eq, Enum ) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/IO/0000755006511100651110000000000010504340131020045 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/IO/Directory.hs0000644006511100651110000000652707633645524022406 0ustar rossrossmodule Dotnet.System.IO.Directory where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.IO.DirectoryInfo import Dotnet.System.DateTime import Dotnet.System.Array import Dotnet.System.String data Directory_ a type Directory a = Dotnet.System.Object.Object (Directory_ a) getParent :: String -> Directory obj -> IO (Dotnet.System.IO.DirectoryInfo.DirectoryInfo a1) getParent arg0 = invoke "GetParent" arg0 createDirectory :: String -> Directory obj -> IO (Dotnet.System.IO.DirectoryInfo.DirectoryInfo a1) createDirectory arg0 = invoke "CreateDirectory" arg0 exists :: String -> Directory obj -> IO (Bool) exists arg0 = invoke "Exists" arg0 setCreationTime :: String -> Dotnet.System.DateTime.DateTime a1 -> Directory obj -> IO (()) setCreationTime arg0 arg1 = invoke "SetCreationTime" (arg0,arg1) getCreationTime :: String -> Directory obj -> IO (Dotnet.System.DateTime.DateTime a1) getCreationTime arg0 = invoke "GetCreationTime" arg0 setLastWriteTime :: String -> Dotnet.System.DateTime.DateTime a1 -> Directory obj -> IO (()) setLastWriteTime arg0 arg1 = invoke "SetLastWriteTime" (arg0,arg1) getLastWriteTime :: String -> Directory obj -> IO (Dotnet.System.DateTime.DateTime a1) getLastWriteTime arg0 = invoke "GetLastWriteTime" arg0 setLastAccessTime :: String -> Dotnet.System.DateTime.DateTime a1 -> Directory obj -> IO (()) setLastAccessTime arg0 arg1 = invoke "SetLastAccessTime" (arg0,arg1) getLastAccessTime :: String -> Directory obj -> IO (Dotnet.System.DateTime.DateTime a1) getLastAccessTime arg0 = invoke "GetLastAccessTime" arg0 getFiles :: String -> Directory obj -> IO (Dotnet.System.Array.Array (Dotnet.System.String.StringTy a1)) getFiles arg0 = invoke "GetFiles" arg0 getFiles_1 :: String -> String -> Directory obj -> IO (Dotnet.System.Array.Array (Dotnet.System.String.StringTy a2)) getFiles_1 arg0 arg1 = invoke "GetFiles" (arg0,arg1) getDirectories :: String -> Directory obj -> IO (Dotnet.System.Array.Array (Dotnet.System.String.StringTy a1)) getDirectories arg0 = invoke "GetDirectories" arg0 getDirectories_1 :: String -> String -> Directory obj -> IO (Dotnet.System.Array.Array (Dotnet.System.String.StringTy a2)) getDirectories_1 arg0 arg1 = invoke "GetDirectories" (arg0,arg1) getFileSystemEntries :: String -> Directory obj -> IO (Dotnet.System.Array.Array (Dotnet.System.String.StringTy a1)) getFileSystemEntries arg0 = invoke "GetFileSystemEntries" arg0 getFileSystemEntries_1 :: String -> String -> Directory obj -> IO (Dotnet.System.Array.Array (Dotnet.System.String.StringTy a2)) getFileSystemEntries_1 arg0 arg1 = invoke "GetFileSystemEntries" (arg0,arg1) getLogicalDrives :: Directory obj -> IO (Dotnet.System.Array.Array (Dotnet.System.String.StringTy a0)) getLogicalDrives = invoke "GetLogicalDrives" () getDirectoryRoot :: String -> Directory obj -> IO (String) getDirectoryRoot arg0 = invoke "GetDirectoryRoot" arg0 getCurrentDirectory :: Directory obj -> IO (String) getCurrentDirectory = invoke "GetCurrentDirectory" () setCurrentDirectory :: String -> Directory obj -> IO (()) setCurrentDirectory arg0 = invoke "SetCurrentDirectory" arg0 move :: String -> String -> Directory obj -> IO (()) move arg0 arg1 = invoke "Move" (arg0,arg1) delete :: String -> Directory obj -> IO (()) delete arg0 = invoke "Delete" arg0 delete_1 :: String -> Bool -> Directory obj -> IO (()) delete_1 arg0 arg1 = invoke "Delete" (arg0,arg1) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/IO/DirectoryInfo.hs0000644006511100651110000000033507633645525023212 0ustar rossrossmodule Dotnet.System.IO.DirectoryInfo ( module Dotnet.System.IO.DirectoryInfo ) where import qualified Dotnet.System.Object data DirectoryInfo_ a type DirectoryInfo a = Dotnet.System.Object.Object (DirectoryInfo_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/IO/SeekOrigin.hs0000644006511100651110000000025607633645525022473 0ustar rossrossmodule Dotnet.System.IO.SeekOrigin where import Dotnet import qualified Dotnet.System.Enum data SeekOrigin_ a type SeekOrigin a = Dotnet.System.Enum.Enum (SeekOrigin_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/IO/Stream.hs0000644006511100651110000000600107633666455021666 0ustar rossrossmodule Dotnet.System.IO.Stream where import Dotnet import qualified Dotnet.System.MarshalByRefObject import qualified Data.Word import qualified Dotnet.System.Array import qualified Data.Int import qualified Dotnet.System.IO.SeekOrigin {- import qualified Dotnet.System.IAsyncResult import qualified Dotnet.System.AsyncCallback -} import qualified Dotnet.System.Object data Stream_ a type Stream a = Dotnet.System.MarshalByRefObject.MarshalByRefObject (Stream_ a) foreign import dotnet "method System.IO.Stream.WriteByte" writeByte :: Data.Word.Word8 -> Stream obj -> IO (()) foreign import dotnet "method System.IO.Stream.Write" write :: Dotnet.System.Array.Array (Data.Word.Word8) -> Int -> Int -> Stream obj -> IO (()) foreign import dotnet "method System.IO.Stream.ReadByte" readByte :: Stream obj -> IO (Int) foreign import dotnet "method System.IO.Stream.Read" read :: Dotnet.System.Array.Array (Data.Word.Word8) -> Int -> Int -> Stream obj -> IO (Int) foreign import dotnet "method System.IO.Stream.SetLength" setLength :: Data.Int.Int64 -> Stream obj -> IO (()) foreign import dotnet "method System.IO.Stream.Seek" seek :: Data.Int.Int64 -> Dotnet.System.IO.SeekOrigin.SeekOrigin a1 -> Stream obj -> IO (Data.Int.Int64) {- foreign import dotnet "method System.IO.Stream.EndWrite" endWrite :: Dotnet.System.IAsyncResult.IAsyncResult a0 -> Stream obj -> IO (()) foreign import dotnet "method System.IO.Stream.BeginWrite" beginWrite :: Dotnet.System.Array.Array (Data.Word.Word8) -> Int -> Int -> Dotnet.System.AsyncCallback.AsyncCallback a3 -> Dotnet.System.Object.Object a4 -> Stream obj -> IO (Dotnet.System.IAsyncResult.IAsyncResult a5) foreign import dotnet "method System.IO.Stream.EndRead" endRead :: Dotnet.System.IAsyncResult.IAsyncResult a0 -> Stream obj -> IO (Int) foreign import dotnet "method System.IO.Stream.BeginRead" beginRead :: Dotnet.System.Array.Array (Data.Word.Word8) -> Int -> Int -> Dotnet.System.AsyncCallback.AsyncCallback a3 -> Dotnet.System.Object.Object a4 -> Stream obj -> IO (Dotnet.System.IAsyncResult.IAsyncResult a5) -} foreign import dotnet "method System.IO.Stream.Flush" flush :: Stream obj -> IO (()) foreign import dotnet "method System.IO.Stream.Close" close :: Stream obj -> IO (()) foreign import dotnet "method System.IO.Stream.set_Position" set_Position :: Data.Int.Int64 -> Stream obj -> IO (()) foreign import dotnet "method System.IO.Stream.get_Position" get_Position :: Stream obj -> IO (Data.Int.Int64) foreign import dotnet "method System.IO.Stream.get_Length" get_Length :: Stream obj -> IO (Data.Int.Int64) foreign import dotnet "method System.IO.Stream.get_CanWrite" get_CanWrite :: Stream obj -> IO (Bool) foreign import dotnet "method System.IO.Stream.get_CanSeek" get_CanSeek :: Stream obj -> IO (Bool) foreign import dotnet "method System.IO.Stream.get_CanRead" get_CanRead :: Stream obj -> IO (Bool) foreign import dotnet "static field System.IO.Stream.Null" get_Null :: IO (Dotnet.System.IO.Stream.Stream a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/IO/TextReader.hs0000644006511100651110000000254507633666455022513 0ustar rossrossmodule Dotnet.System.IO.TextReader where import Dotnet import qualified Dotnet.System.MarshalByRefObject import qualified Dotnet.System.Array data TextReader_ a type TextReader a = Dotnet.System.MarshalByRefObject.MarshalByRefObject (TextReader_ a) foreign import dotnet "method System.IO.TextReader.ReadLine" readLine :: TextReader obj -> IO (String) foreign import dotnet "method System.IO.TextReader.ReadBlock" readBlock :: Dotnet.System.Array.Array (Char) -> Int -> Int -> TextReader obj -> IO (Int) foreign import dotnet "method System.IO.TextReader.ReadToEnd" readToEnd :: TextReader obj -> IO (String) foreign import dotnet "method System.IO.TextReader.Read" read :: Dotnet.System.Array.Array (Char) -> Int -> Int -> TextReader obj -> IO (Int) foreign import dotnet "method System.IO.TextReader.Read" read_1 :: TextReader obj -> IO (Int) foreign import dotnet "method System.IO.TextReader.Peek" peek :: TextReader obj -> IO (Int) foreign import dotnet "method System.IO.TextReader.Close" close :: TextReader obj -> IO (()) foreign import dotnet "static method System.IO.TextReader.Synchronized" synchronized :: Dotnet.System.IO.TextReader.TextReader a0 -> IO (Dotnet.System.IO.TextReader.TextReader a1) foreign import dotnet "static field System.IO.TextReader.Null" get_Null :: IO (Dotnet.System.IO.TextReader.TextReader a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/IO/TextWriter.hs0000644006511100651110000001430107633666455022556 0ustar rossrossmodule Dotnet.System.IO.TextWriter where import Dotnet import qualified Dotnet.System.MarshalByRefObject import qualified Dotnet.System.Array import qualified Dotnet.System.Object import qualified Dotnet.System.Decimal import qualified Data.Word import qualified Data.Int import qualified Dotnet.System.Text.Encoding import qualified Dotnet.System.IFormatProvider data TextWriter_ a type TextWriter a = Dotnet.System.MarshalByRefObject.MarshalByRefObject (TextWriter_ a) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine :: String -> Dotnet.System.Array.Array (Dotnet.System.Object.Object a1) -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_1 :: String -> Dotnet.System.Object.Object a1 -> Dotnet.System.Object.Object a2 -> Dotnet.System.Object.Object a3 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_2 :: String -> Dotnet.System.Object.Object a1 -> Dotnet.System.Object.Object a2 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_3 :: String -> Dotnet.System.Object.Object a1 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_4 :: Dotnet.System.Object.Object a0 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_5 :: String -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_6 :: Dotnet.System.Decimal.Decimal a0 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_7 :: Double -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_8 :: Double -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_9 :: Data.Word.Word64 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_10 :: Data.Int.Int64 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_11 :: Data.Word.Word32 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_12 :: Int -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_13 :: Bool -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_14 :: Dotnet.System.Array.Array (Char) -> Int -> Int -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_15 :: Dotnet.System.Array.Array (Char) -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_16 :: Char -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.WriteLine" writeLine_17 :: TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write :: String -> Dotnet.System.Array.Array (Dotnet.System.Object.Object a1) -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_1 :: String -> Dotnet.System.Object.Object a1 -> Dotnet.System.Object.Object a2 -> Dotnet.System.Object.Object a3 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_2 :: String -> Dotnet.System.Object.Object a1 -> Dotnet.System.Object.Object a2 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_3 :: String -> Dotnet.System.Object.Object a1 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_4 :: Dotnet.System.Object.Object a0 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_5 :: String -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_6 :: Dotnet.System.Decimal.Decimal a0 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_7 :: Double -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_8 :: Double -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_9 :: Data.Word.Word64 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_10 :: Data.Int.Int64 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_11 :: Data.Word.Word32 -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_12 :: Int -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_13 :: Bool -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_14 :: Dotnet.System.Array.Array (Char) -> Int -> Int -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_15 :: Dotnet.System.Array.Array (Char) -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Write" write_16 :: Char -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.set_NewLine" set_NewLine :: String -> TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.get_NewLine" get_NewLine :: TextWriter obj -> IO (String) foreign import dotnet "method System.IO.TextWriter.get_Encoding" get_Encoding :: TextWriter obj -> IO (Dotnet.System.Text.Encoding.Encoding a0) foreign import dotnet "method System.IO.TextWriter.Flush" flush :: TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.Close" close :: TextWriter obj -> IO (()) foreign import dotnet "method System.IO.TextWriter.get_FormatProvider" get_FormatProvider :: TextWriter obj -> IO (Dotnet.System.IFormatProvider.IFormatProvider a0) foreign import dotnet "static method System.IO.TextWriter.Synchronized" synchronized :: Dotnet.System.IO.TextWriter.TextWriter a0 -> IO (Dotnet.System.IO.TextWriter.TextWriter a1) foreign import dotnet "static field System.IO.TextWriter.Null" get_Null :: IO (Dotnet.System.IO.TextWriter.TextWriter a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Text/0000755006511100651110000000000010504340131020462 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Text/Decoder.hs0000644006511100651110000000125207633645526022414 0ustar rossrossmodule Dotnet.System.Text.Decoder where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.Array import Dotnet.System.Byte import Dotnet.System.Char data Decoder_ a type Decoder a = Dotnet.System.Object.Object (Decoder_ a) foreign import dotnet "method Dotnet.System.Text.Decoder.GetChars" getChars :: Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0) -> Int -> Int -> Dotnet.System.Array.Array (Dotnet.System.Char.Char a3) -> Int -> Decoder obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Decoder.GetCharCount" getCharCount :: Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0) -> Int -> Int -> Decoder obj -> IO (Int) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Text/Encoder.hs0000644006511100651110000000127207633645526022430 0ustar rossrossmodule Dotnet.System.Text.Encoder where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.Array import Dotnet.System.Char import Dotnet.System.Byte data Encoder_ a type Encoder a = Dotnet.System.Object.Object (Encoder_ a) foreign import dotnet "method Dotnet.System.Text.Encoder.GetBytes" getBytes :: Dotnet.System.Array.Array (Dotnet.System.Char.Char a0) -> Int -> Int -> Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a3) -> Int -> Bool -> Encoder obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoder.GetByteCount" getByteCount :: Dotnet.System.Array.Array (Dotnet.System.Char.Char a0) -> Int -> Int -> Bool -> Encoder obj -> IO (Int) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Text/Encoding.hs0000644006511100651110000001630607633645526022603 0ustar rossrossmodule Dotnet.System.Text.Encoding where import Dotnet import qualified Dotnet.System.Object import qualified Dotnet.System.Array import Dotnet.System.Byte import Dotnet.System.Text.Encoder import Dotnet.System.Text.Decoder import Dotnet.System.Char data Encoding_ a type Encoding a = Dotnet.System.Object.Object (Encoding_ a) foreign import dotnet "method Dotnet.System.Text.Encoding.GetString" getString :: Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0) -> Int -> Int -> Encoding obj -> IO (String) foreign import dotnet "method Dotnet.System.Text.Encoding.GetString" getString_1 :: Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0) -> Encoding obj -> IO (String) foreign import dotnet "method Dotnet.System.Text.Encoding.GetMaxCharCount" getMaxCharCount :: Int -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetMaxByteCount" getMaxByteCount :: Int -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetEncoder" getEncoder :: Encoding obj -> IO (Dotnet.System.Text.Encoder.Encoder a0) foreign import dotnet "method Dotnet.System.Text.Encoding.GetDecoder" getDecoder :: Encoding obj -> IO (Dotnet.System.Text.Decoder.Decoder a0) foreign import dotnet "method Dotnet.System.Text.Encoding.get_CodePage" get_CodePage :: Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetChars" getChars :: Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0) -> Int -> Int -> Dotnet.System.Array.Array (Dotnet.System.Char.Char a3) -> Int -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetChars" getChars_1 :: Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0) -> Int -> Int -> Encoding obj -> IO (Dotnet.System.Array.Array (Dotnet.System.Char.Char a3)) foreign import dotnet "method Dotnet.System.Text.Encoding.GetChars" getChars_2 :: Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0) -> Encoding obj -> IO (Dotnet.System.Array.Array (Dotnet.System.Char.Char a1)) foreign import dotnet "method Dotnet.System.Text.Encoding.GetCharCount" getCharCount :: Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0) -> Int -> Int -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetCharCount" getCharCount_1 :: Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0) -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetBytes" getBytes :: String -> Int -> Int -> Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a3) -> Int -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetBytes" getBytes_1 :: String -> Encoding obj -> IO (Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a1)) foreign import dotnet "method Dotnet.System.Text.Encoding.GetBytes" getBytes_2 :: Dotnet.System.Array.Array (Dotnet.System.Char.Char a0) -> Int -> Int -> Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a3) -> Int -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetBytes" getBytes_3 :: Dotnet.System.Array.Array (Dotnet.System.Char.Char a0) -> Int -> Int -> Encoding obj -> IO (Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a3)) foreign import dotnet "method Dotnet.System.Text.Encoding.GetBytes" getBytes_4 :: Dotnet.System.Array.Array (Dotnet.System.Char.Char a0) -> Encoding obj -> IO (Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a1)) foreign import dotnet "method Dotnet.System.Text.Encoding.GetByteCount" getByteCount :: Dotnet.System.Array.Array (Dotnet.System.Char.Char a0) -> Int -> Int -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetByteCount" getByteCount_1 :: String -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.GetByteCount" getByteCount_2 :: Dotnet.System.Array.Array (Dotnet.System.Char.Char a0) -> Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.get_IsMailNewsSave" get_IsMailNewsSave :: Encoding obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Text.Encoding.get_IsMailNewsDisplay" get_IsMailNewsDisplay :: Encoding obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Text.Encoding.get_IsBrowserSave" get_IsBrowserSave :: Encoding obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Text.Encoding.get_IsBrowserDisplay" get_IsBrowserDisplay :: Encoding obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Text.Encoding.get_WindowsCodePage" get_WindowsCodePage :: Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.get_WebName" get_WebName :: Encoding obj -> IO (String) foreign import dotnet "method Dotnet.System.Text.Encoding.get_HeaderName" get_HeaderName :: Encoding obj -> IO (String) foreign import dotnet "method Dotnet.System.Text.Encoding.get_EncodingName" get_EncodingName :: Encoding obj -> IO (String) foreign import dotnet "method Dotnet.System.Text.Encoding.get_BodyName" get_BodyName :: Encoding obj -> IO (String) foreign import dotnet "method Dotnet.System.Text.Encoding.GetPreamble" getPreamble :: Encoding obj -> IO (Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a0)) foreign import dotnet "method Dotnet.System.Text.Encoding.GetHashCode" getHashCode :: Encoding obj -> IO (Int) foreign import dotnet "method Dotnet.System.Text.Encoding.Equals" equals :: Dotnet.System.Object.Object a0 -> Encoding obj -> IO (Bool) foreign import dotnet "static method Dotnet.System.Text.Encoding.Convert" convert :: Dotnet.System.Text.Encoding.Encoding a0 -> Dotnet.System.Text.Encoding.Encoding a1 -> Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a2) -> IO (Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a3)) foreign import dotnet "static method Dotnet.System.Text.Encoding.Convert" convert_1 :: Dotnet.System.Text.Encoding.Encoding a0 -> Dotnet.System.Text.Encoding.Encoding a1 -> Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a2) -> Int -> Int -> IO (Dotnet.System.Array.Array (Dotnet.System.Byte.Byte a5)) foreign import dotnet "static method Dotnet.System.Text.Encoding.GetEncoding" getEncoding :: Int -> IO (Dotnet.System.Text.Encoding.Encoding a1) foreign import dotnet "static method Dotnet.System.Text.Encoding.GetEncoding" getEncoding_1 :: String -> IO (Dotnet.System.Text.Encoding.Encoding a1) foreign import dotnet "static method Dotnet.System.Text.Encoding.get_ASCII" get_ASCII :: IO (Dotnet.System.Text.Encoding.Encoding a0) foreign import dotnet "static method Dotnet.System.Text.Encoding.get_Default" get_Default :: IO (Dotnet.System.Text.Encoding.Encoding a0) foreign import dotnet "static method Dotnet.System.Text.Encoding.get_Unicode" get_Unicode :: IO (Dotnet.System.Text.Encoding.Encoding a0) foreign import dotnet "static method Dotnet.System.Text.Encoding.get_BigEndianUnicode" get_BigEndianUnicode :: IO (Dotnet.System.Text.Encoding.Encoding a0) foreign import dotnet "static method Dotnet.System.Text.Encoding.get_UTF7" get_UTF7 :: IO (Dotnet.System.Text.Encoding.Encoding a0) foreign import dotnet "static method Dotnet.System.Text.Encoding.get_UTF8" get_UTF8 :: IO (Dotnet.System.Text.Encoding.Encoding a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Web/0000755006511100651110000000000010504340131020253 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Web/Mail/0000755006511100651110000000000010504340131021135 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Web/Mail/MailAttachment.hs0000644006511100651110000000106007633672124024404 0ustar rossrossmodule Dotnet.System.Web.Mail.MailAttachment where import Dotnet import qualified Dotnet.System.Object import qualified Dotnet.System.Web.Mail.MailEncoding data MailAttachment_ a type MailAttachment a = Dotnet.System.Object.Object (MailAttachment_ a) foreign import dotnet "method System.Web.Mail.MailAttachment.get_Filename" get_Filename :: MailAttachment obj -> IO (String) foreign import dotnet "method System.Web.Mail.MailAttachment.get_Encoding" get_Encoding :: MailAttachment obj -> IO (Dotnet.System.Web.Mail.MailEncoding.MailEncoding a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Web/Mail/MailEncoding.hs0000644006511100651110000000136307633672124024050 0ustar rossrossmodule Dotnet.System.Web.Mail.MailEncoding where import Dotnet import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data MailEncoding_ a type MailEncoding a = Dotnet.System.Enum.Enum (MailEncoding_ a) data MailEncodingTy = UUEncode | Base64 deriving ( Enum, Show, Read ) toMailEncoding :: MailEncodingTy -> MailEncoding () toMailEncoding tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Web.Mail.MailEncoding, System.Web, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")) (show tag)) fromMailEncoding :: MailEncoding () -> MailEncodingTy fromMailEncoding obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Web/Mail/MailFormat.hs0000644006511100651110000000136507633672124023554 0ustar rossrossmodule Dotnet.System.Web.Mail.MailFormat where import Dotnet import qualified Dotnet.System.Enum import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data MailFormat_ a type MailFormat a = Dotnet.System.Enum.Enum (MailFormat_ a) data MailFormatTy = Text | Html deriving ( Enum, Show, Read ) toMailFormat :: MailFormatTy -> MailFormat () toMailFormat tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Web.Mail.MailFormat, System.Web, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")) (show tag)) fromMailFormat :: MailFormat () -> MailFormatTy fromMailFormat obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Web/Mail/MailMessage.hs0000644006511100651110000000731707633672124023713 0ustar rossrossmodule Dotnet.System.Web.Mail.MailMessage where import Dotnet import qualified Dotnet.System.Object import qualified Dotnet.System.Web.Mail.MailPriority import qualified Dotnet.System.Web.Mail.MailFormat import qualified Dotnet.System.Text.Encoding import qualified Dotnet.System.Collections.IDictionary import qualified Dotnet.System.Collections.IList data MailMessage_ a type MailMessage a = Dotnet.System.Object.Object (MailMessage_ a) foreign import dotnet "method System.Web.Mail.MailMessage.get_From" get_From :: MailMessage obj -> IO (String) foreign import dotnet "method System.Web.Mail.MailMessage.set_From" set_From :: String -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_To" get_To :: MailMessage obj -> IO (String) foreign import dotnet "method System.Web.Mail.MailMessage.set_To" set_To :: String -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_Cc" get_Cc :: MailMessage obj -> IO (String) foreign import dotnet "method System.Web.Mail.MailMessage.set_Cc" set_Cc :: String -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_Bcc" get_Bcc :: MailMessage obj -> IO (String) foreign import dotnet "method System.Web.Mail.MailMessage.set_Bcc" set_Bcc :: String -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_Subject" get_Subject :: MailMessage obj -> IO (String) foreign import dotnet "method System.Web.Mail.MailMessage.set_Subject" set_Subject :: String -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_Priority" get_Priority :: MailMessage obj -> IO (Dotnet.System.Web.Mail.MailPriority.MailPriority a0) foreign import dotnet "method System.Web.Mail.MailMessage.set_Priority" set_Priority :: Dotnet.System.Web.Mail.MailPriority.MailPriority a0 -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_UrlContentBase" get_UrlContentBase :: MailMessage obj -> IO (String) foreign import dotnet "method System.Web.Mail.MailMessage.set_UrlContentBase" set_UrlContentBase :: String -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_UrlContentLocation" get_UrlContentLocation :: MailMessage obj -> IO (String) foreign import dotnet "method System.Web.Mail.MailMessage.set_UrlContentLocation" set_UrlContentLocation :: String -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_Body" get_Body :: MailMessage obj -> IO (String) foreign import dotnet "method System.Web.Mail.MailMessage.set_Body" set_Body :: String -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_BodyFormat" get_BodyFormat :: MailMessage obj -> IO (Dotnet.System.Web.Mail.MailFormat.MailFormat a0) foreign import dotnet "method System.Web.Mail.MailMessage.set_BodyFormat" set_BodyFormat :: Dotnet.System.Web.Mail.MailFormat.MailFormat a0 -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_BodyEncoding" get_BodyEncoding :: MailMessage obj -> IO (Dotnet.System.Text.Encoding.Encoding a0) foreign import dotnet "method System.Web.Mail.MailMessage.set_BodyEncoding" set_BodyEncoding :: Dotnet.System.Text.Encoding.Encoding a0 -> MailMessage obj -> IO (()) foreign import dotnet "method System.Web.Mail.MailMessage.get_Headers" get_Headers :: MailMessage obj -> IO (Dotnet.System.Collections.IDictionary.IDictionary a0) foreign import dotnet "method System.Web.Mail.MailMessage.get_Attachments" get_Attachments :: MailMessage obj -> IO (Dotnet.System.Collections.IList.IList a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Web/Mail/MailPriority.hs0000644006511100651110000000143207633672124024140 0ustar rossrossmodule Dotnet.System.Web.Mail.MailPriority where import Dotnet import qualified Dotnet.System.Enum import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data MailPriority_ a type MailPriority a = Dotnet.System.Enum.Enum (MailPriority_ a) data MailPriorityTy = Normal | Low | High deriving ( Enum, Show, Read ) toMailPriority :: MailPriorityTy -> MailPriority () toMailPriority tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Web.Mail.MailPriority, System.Web, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")) (show tag)) fromMailPriority :: MailPriority () -> MailPriorityTy fromMailPriority obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Web/Mail/SmtpMail.hs0000644006511100651110000000133707633672124023246 0ustar rossrossmodule Dotnet.System.Web.Mail.SmtpMail where import Dotnet import qualified Dotnet.System.Object import qualified Dotnet.System.Web.Mail.MailMessage data SmtpMail_ a type SmtpMail a = Dotnet.System.Object.Object (SmtpMail_ a) foreign import dotnet "static method System.Web.Mail.SmtpMail.get_SmtpServer" get_SmtpServer :: IO (String) foreign import dotnet "static method System.Web.Mail.SmtpMail.set_SmtpServer" set_SmtpServer :: String -> IO (()) foreign import dotnet "static method System.Web.Mail.SmtpMail.Send" send :: String -> String -> String -> String -> IO (()) foreign import dotnet "static method System.Web.Mail.SmtpMail.Send" send_1 :: Dotnet.System.Web.Mail.MailMessage.MailMessage a0 -> IO (()) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/0000755006511100651110000000000010504340131020276 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/0000755006511100651110000000000010504340131021322 5ustar rossrosshugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/IXPathNavigable.hs0000644006511100651110000000070407633673304024651 0ustar rossrossmodule Dotnet.System.Xml.XPath.IXPathNavigable where import Dotnet import qualified Dotnet.System.Xml.XPath.XPathNavigator import qualified Dotnet.System.Object data IXPathNavigable_ a type IXPathNavigable a = Dotnet.System.Object.Object (IXPathNavigable_ a) foreign import dotnet "method System.Xml.XPath.IXPathNavigable.CreateNavigator" createNavigator :: IXPathNavigable obj -> IO (Dotnet.System.Xml.XPath.XPathNavigator.XPathNavigator a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XPathDocument.hs0000644006511100651110000000067007633673304024430 0ustar rossrossmodule Dotnet.System.Xml.XPath.XPathDocument where import Dotnet import qualified Dotnet.System.Xml.XPath.XPathNavigator import qualified Dotnet.System.Object data XPathDocument_ a type XPathDocument a = Dotnet.System.Object.Object (XPathDocument_ a) foreign import dotnet "method System.Xml.XPath.XPathDocument.CreateNavigator" createNavigator :: XPathDocument obj -> IO (Dotnet.System.Xml.XPath.XPathNavigator.XPathNavigator a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XPathExpression.hs0000644006511100651110000000333307633673304025010 0ustar rossrossmodule Dotnet.System.Xml.XPath.XPathExpression where import Dotnet import qualified Dotnet.System.Xml.XPath.XPathResultType import qualified Dotnet.System.Xml.XmlNamespaceManager import qualified Dotnet.System.Object import qualified Dotnet.System.Xml.XPath.XmlSortOrder import qualified Dotnet.System.Xml.XPath.XmlCaseOrder import qualified Dotnet.System.Xml.XPath.XmlDataType import qualified Dotnet.System.Collections.IComparer data XPathExpression_ a type XPathExpression a = Dotnet.System.Object.Object (XPathExpression_ a) foreign import dotnet "method System.Xml.XPath.XPathExpression.get_ReturnType" get_ReturnType :: XPathExpression obj -> IO (Dotnet.System.Xml.XPath.XPathResultType.XPathResultType a0) foreign import dotnet "method System.Xml.XPath.XPathExpression.SetContext" setContext :: Dotnet.System.Xml.XmlNamespaceManager.XmlNamespaceManager a0 -> XPathExpression obj -> IO (()) foreign import dotnet "method System.Xml.XPath.XPathExpression.Clone" clone :: XPathExpression obj -> IO (Dotnet.System.Xml.XPath.XPathExpression.XPathExpression a0) foreign import dotnet "method System.Xml.XPath.XPathExpression.AddSort" addSort :: Dotnet.System.Object.Object a0 -> Dotnet.System.Xml.XPath.XmlSortOrder.XmlSortOrder a1 -> Dotnet.System.Xml.XPath.XmlCaseOrder.XmlCaseOrder a2 -> String -> Dotnet.System.Xml.XPath.XmlDataType.XmlDataType a4 -> XPathExpression obj -> IO (()) foreign import dotnet "method System.Xml.XPath.XPathExpression.AddSort" addSort_1 :: Dotnet.System.Object.Object a0 -> Dotnet.System.Collections.IComparer.IComparer a1 -> XPathExpression obj -> IO (()) foreign import dotnet "method System.Xml.XPath.XPathExpression.get_Expression" get_Expression :: XPathExpression obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XPathNamespaceScope.hs0000644006511100651110000000153707633673304025543 0ustar rossrossmodule Dotnet.System.Xml.XPath.XPathNamespaceScope where import Dotnet import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data XPathNamespaceScope_ a type XPathNamespaceScope a = Dotnet.System.Enum.Enum (XPathNamespaceScope_ a) data XPathNamespaceScopeTy = All | ExcludeXml | Local deriving ( Enum, Show, Read ) toXPathNamespaceScope :: XPathNamespaceScopeTy -> XPathNamespaceScope () toXPathNamespaceScope tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Xml.XPath.XPathNamespaceScope, System.Xml, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")) (show tag)) fromXPathNamespaceScope :: XPathNamespaceScope () -> XPathNamespaceScopeTy fromXPathNamespaceScope obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XPathNavigator.hs0000644006511100651110000002122107633673304024577 0ustar rossrossmodule Dotnet.System.Xml.XPath.XPathNavigator ( module Dotnet.System.Xml.XPath.XPathNavigatorTy, module Dotnet.System.Xml.XPath.XPathNavigator ) where import Dotnet import qualified Dotnet.System.Xml.XmlNodeOrder import Dotnet.System.Xml.XPath.XPathNavigatorTy import qualified Dotnet.System.Xml.XPath.XPathNodeIterator import qualified Dotnet.System.Xml.XPath.XPathNodeType import qualified Dotnet.System.Xml.XPath.XPathExpression import qualified Dotnet.System.Object import qualified Dotnet.System.Xml.XPath.XPathNamespaceScope import qualified Dotnet.System.Xml.XmlNameTable foreign import dotnet "method System.Xml.XPath.XPathNavigator.IsDescendant" isDescendant :: Dotnet.System.Xml.XPath.XPathNavigator.XPathNavigator a0 -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.ComparePosition" comparePosition :: Dotnet.System.Xml.XPath.XPathNavigator.XPathNavigator a0 -> XPathNavigator obj -> IO (Dotnet.System.Xml.XmlNodeOrder.XmlNodeOrder a1) foreign import dotnet "method System.Xml.XPath.XPathNavigator.SelectAncestors" selectAncestors :: String -> String -> Bool -> XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a3) foreign import dotnet "method System.Xml.XPath.XPathNavigator.SelectAncestors" selectAncestors_1 :: Dotnet.System.Xml.XPath.XPathNodeType.XPathNodeType a0 -> Bool -> XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a2) foreign import dotnet "method System.Xml.XPath.XPathNavigator.SelectDescendants" selectDescendants :: String -> String -> Bool -> XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a3) foreign import dotnet "method System.Xml.XPath.XPathNavigator.SelectDescendants" selectDescendants_1 :: Dotnet.System.Xml.XPath.XPathNodeType.XPathNodeType a0 -> Bool -> XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a2) foreign import dotnet "method System.Xml.XPath.XPathNavigator.SelectChildren" selectChildren :: String -> String -> XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a2) foreign import dotnet "method System.Xml.XPath.XPathNavigator.SelectChildren" selectChildren_1 :: Dotnet.System.Xml.XPath.XPathNodeType.XPathNodeType a0 -> XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a1) foreign import dotnet "method System.Xml.XPath.XPathNavigator.Select" select :: String -> XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a1) foreign import dotnet "method System.Xml.XPath.XPathNavigator.Select" select_1 :: Dotnet.System.Xml.XPath.XPathExpression.XPathExpression a0 -> XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a1) foreign import dotnet "method System.Xml.XPath.XPathNavigator.Matches" matches :: String -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.Matches" matches_1 :: Dotnet.System.Xml.XPath.XPathExpression.XPathExpression a0 -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.Evaluate" evaluate :: String -> XPathNavigator obj -> IO (Dotnet.System.Object.Object a1) foreign import dotnet "method System.Xml.XPath.XPathNavigator.Evaluate" evaluate_1 :: Dotnet.System.Xml.XPath.XPathExpression.XPathExpression a0 -> Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a1 -> XPathNavigator obj -> IO (Dotnet.System.Object.Object a2) foreign import dotnet "method System.Xml.XPath.XPathNavigator.Evaluate" evaluate_2 :: Dotnet.System.Xml.XPath.XPathExpression.XPathExpression a0 -> XPathNavigator obj -> IO (Dotnet.System.Object.Object a1) foreign import dotnet "method System.Xml.XPath.XPathNavigator.Compile" compile :: String -> XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathExpression.XPathExpression a1) foreign import dotnet "method System.Xml.XPath.XPathNavigator.IsSamePosition" isSamePosition :: Dotnet.System.Xml.XPath.XPathNavigator.XPathNavigator a0 -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToId" moveToId :: String -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveTo" moveTo :: Dotnet.System.Xml.XPath.XPathNavigator.XPathNavigator a0 -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToRoot" moveToRoot :: XPathNavigator obj -> IO (()) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToParent" moveToParent :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToFirstChild" moveToFirstChild :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_HasChildren" get_HasChildren :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToFirst" moveToFirst :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToPrevious" moveToPrevious :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToNext" moveToNext :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToNextNamespace" moveToNextNamespace :: Dotnet.System.Xml.XPath.XPathNamespaceScope.XPathNamespaceScope a0 -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToFirstNamespace" moveToFirstNamespace :: Dotnet.System.Xml.XPath.XPathNamespaceScope.XPathNamespaceScope a0 -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToNamespace" moveToNamespace :: String -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.GetNamespace" getNamespace :: String -> XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToNextAttribute" moveToNextAttribute :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToFirstAttribute" moveToFirstAttribute :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToAttribute" moveToAttribute :: String -> String -> XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.GetAttribute" getAttribute :: String -> String -> XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_HasAttributes" get_HasAttributes :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_NameTable" get_NameTable :: XPathNavigator obj -> IO (Dotnet.System.Xml.XmlNameTable.XmlNameTable a0) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_IsEmptyElement" get_IsEmptyElement :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_XmlLang" get_XmlLang :: XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_BaseURI" get_BaseURI :: XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_Value" get_Value :: XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_Prefix" get_Prefix :: XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_Name" get_Name :: XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_NamespaceURI" get_NamespaceURI :: XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_LocalName" get_LocalName :: XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.get_NodeType" get_NodeType :: XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeType.XPathNodeType a0) foreign import dotnet "method System.Xml.XPath.XPathNavigator.Clone" clone :: XPathNavigator obj -> IO (Dotnet.System.Xml.XPath.XPathNavigator.XPathNavigator a0) foreign import dotnet "method System.Xml.XPath.XPathNavigator.ToString" toString :: XPathNavigator obj -> IO (String) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToFirstNamespace" moveToFirstNamespace_1 :: XPathNavigator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNavigator.MoveToNextNamespace" moveToNextNamespace_1 :: XPathNavigator obj -> IO (Bool) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XPathNavigatorTy.hs0000644006511100651110000000027607633673304025123 0ustar rossrossmodule Dotnet.System.Xml.XPath.XPathNavigatorTy where import qualified Dotnet.System.Object data XPathNavigator_ a type XPathNavigator a = Dotnet.System.Object.Object (XPathNavigator_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XPathNodeIterator.hs0000644006511100651110000000202207633673304025242 0ustar rossrossmodule Dotnet.System.Xml.XPath.XPathNodeIterator where import Dotnet import qualified Dotnet.System.Xml.XPath.XPathNavigatorTy import qualified Dotnet.System.Object data XPathNodeIterator_ a type XPathNodeIterator a = Dotnet.System.Object.Object (XPathNodeIterator_ a) foreign import dotnet "method System.Xml.XPath.XPathNodeIterator.get_Count" get_Count :: XPathNodeIterator obj -> IO (Int) foreign import dotnet "method System.Xml.XPath.XPathNodeIterator.get_CurrentPosition" get_CurrentPosition :: XPathNodeIterator obj -> IO (Int) foreign import dotnet "method System.Xml.XPath.XPathNodeIterator.get_Current" get_Current :: XPathNodeIterator obj -> IO (Dotnet.System.Xml.XPath.XPathNavigatorTy.XPathNavigator a0) foreign import dotnet "method System.Xml.XPath.XPathNodeIterator.MoveNext" moveNext :: XPathNodeIterator obj -> IO (Bool) foreign import dotnet "method System.Xml.XPath.XPathNodeIterator.Clone" clone :: XPathNodeIterator obj -> IO (Dotnet.System.Xml.XPath.XPathNodeIterator.XPathNodeIterator a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XPathNodeType.hs0000644006511100651110000000156407633673304024404 0ustar rossrossmodule Dotnet.System.Xml.XPath.XPathNodeType where import Dotnet import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data XPathNodeType_ a type XPathNodeType a = Dotnet.System.Enum.Enum (XPathNodeType_ a) data XPathNodeTypeTy = Root | Element | Attribute | Namespace | Text | SignificantWhitespace | Whitespace | ProcessingInstruction | Comment | All deriving ( Enum, Show, Read ) toXPathNodeType :: XPathNodeTypeTy -> XPathNodeType () toXPathNodeType tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Xml.XPath.XPathNodeType, System.Xml, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")) (show tag)) fromXPathNodeType :: XPathNodeType () -> XPathNodeTypeTy fromXPathNodeType obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XPathResultType.hs0000644006511100651110000000152007633673304024765 0ustar rossrossmodule Dotnet.System.Xml.XPath.XPathResultType where import Dotnet import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data XPathResultType_ a type XPathResultType a = Dotnet.System.Enum.Enum (XPathResultType_ a) data XPathResultTypeTy = Number | String | Boolean | NodeSet | Navigator | Any | Error deriving ( Enum, Show, Read ) toXPathResultType :: XPathResultTypeTy -> XPathResultType () toXPathResultType tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Xml.XPath.XPathResultType, System.Xml, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")) (show tag)) fromXPathResultType :: XPathResultType () -> XPathResultTypeTy fromXPathResultType obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XmlCaseOrder.hs0000644006511100651110000000140307633673304024230 0ustar rossrossmodule Dotnet.System.Xml.XPath.XmlCaseOrder where import Dotnet import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data XmlCaseOrder_ a type XmlCaseOrder a = Dotnet.System.Enum.Enum (XmlCaseOrder_ a) data XmlCaseOrderTy = None | UpperFirst | LowerFirst deriving ( Enum, Show, Read ) toXmlCaseOrder :: XmlCaseOrderTy -> XmlCaseOrder () toXmlCaseOrder tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Xml.XPath.XmlCaseOrder, System.Xml, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")) (show tag)) fromXmlCaseOrder :: XmlCaseOrder () -> XmlCaseOrderTy fromXmlCaseOrder obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XmlDataType.hs0000644006511100651110000000134307633673304024077 0ustar rossrossmodule Dotnet.System.Xml.XPath.XmlDataType where import Dotnet import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data XmlDataType_ a type XmlDataType a = Dotnet.System.Enum.Enum (XmlDataType_ a) data XmlDataTypeTy = Text | Number deriving ( Enum, Show, Read ) toXmlDataType :: XmlDataTypeTy -> XmlDataType () toXmlDataType tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Xml.XPath.XmlDataType, System.Xml, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")) (show tag)) fromXmlDataType :: XmlDataType () -> XmlDataTypeTy fromXmlDataType obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XPath/XmlSortOrder.hs0000644006511100651110000000137207633673304024311 0ustar rossrossmodule Dotnet.System.Xml.XPath.XmlSortOrder where import Dotnet import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data XmlSortOrder_ a type XmlSortOrder a = Dotnet.System.Enum.Enum (XmlSortOrder_ a) data XmlSortOrderTy = Ascending | Descending deriving ( Enum, Show, Read ) toXmlSortOrder :: XmlSortOrderTy -> XmlSortOrder () toXmlSortOrder tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Xml.XPath.XmlSortOrder, System.Xml, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")) (show tag)) fromXmlSortOrder :: XmlSortOrder () -> XmlSortOrderTy fromXmlSortOrder obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/WriteState.hs0000644006511100651110000000025707633645526022762 0ustar rossrossmodule Dotnet.System.Xml.WriteState where import Dotnet import qualified Dotnet.System.Enum data WriteState_ a type WriteState a = Dotnet.System.Enum.Enum (WriteState_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlAttribute.hs0000644006511100651110000000621507633645530023306 0ustar rossrossmodule Dotnet.System.Xml.XmlAttribute ( module Dotnet.System.Xml.XmlAttribute , module Dotnet.System.Xml.XmlAttributeTy ) where import Dotnet import Dotnet.System.Xml.XmlAttributeTy import Dotnet.System.Xml.XmlElement import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlNodeTy import Dotnet.System.Xml.XmlDocument import Dotnet.System.Xml.XmlNodeType foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_OwnerElement" get_OwnerElement :: XmlAttribute obj -> IO (Dotnet.System.Xml.XmlElement.XmlElement a0) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_Specified" get_Specified :: XmlAttribute obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlAttribute obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlAttribute obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_BaseURI" get_BaseURI :: XmlAttribute obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.set_InnerXml" set_InnerXml :: String -> XmlAttribute obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_InnerXml" get_InnerXml :: XmlAttribute obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.set_InnerText" set_InnerText :: String -> XmlAttribute obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_InnerText" get_InnerText :: XmlAttribute obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_LocalName" get_LocalName :: XmlAttribute obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.set_Prefix" set_Prefix :: String -> XmlAttribute obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_Prefix" get_Prefix :: XmlAttribute obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_NamespaceURI" get_NamespaceURI :: XmlAttribute obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.CloneNode" cloneNode :: Bool -> XmlAttribute obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_OwnerDocument" get_OwnerDocument :: XmlAttribute obj -> IO (Dotnet.System.Xml.XmlDocument.XmlDocument a0) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_ParentNode" get_ParentNode :: XmlAttribute obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_NodeType" get_NodeType :: XmlAttribute obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.set_Value" set_Value :: String -> XmlAttribute obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_Value" get_Value :: XmlAttribute obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlAttribute.get_Name" get_Name :: XmlAttribute obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlAttributeCollection.hs0000644006511100651110000000621307633645530025320 0ustar rossrossmodule Dotnet.System.Xml.XmlAttributeCollection ( module Dotnet.System.Xml.XmlAttributeCollection , module Dotnet.System.Xml.XmlAttributeCollectionTy ) where import Dotnet import qualified Dotnet.System.Xml.XmlAttributeCollectionTy import qualified Dotnet.System.Xml.XmlNamedNodeMap import qualified Dotnet.System.Xml.XmlAttributeTy import qualified Dotnet.System.Xml.XmlNodeTy import qualified Dotnet.System.Array data XmlAttributeCollection_ a type XmlAttributeCollection a = Dotnet.System.Xml.XmlNamedNodeMap.XmlNamedNodeMap (XmlAttributeCollection_ a) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.RemoveAll" removeAll :: XmlAttributeCollection obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.RemoveAt" removeAt :: Int -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.Remove" remove :: Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a0 -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.InsertAfter" insertAfter :: Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a0 -> Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1 -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a2) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.InsertBefore" insertBefore :: Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a0 -> Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1 -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a2) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.Append" append :: Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a0 -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.Prepend" prepend :: Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a0 -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.get_ItemOf" get_ItemOf :: String -> String -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a2) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.get_ItemOf" get_ItemOf_1 :: String -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.get_ItemOf" get_ItemOf_2 :: Int -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.SetNamedItem" setNamedItem :: Dotnet.System.Xml.XmlNodeTy.XmlNode a0 -> XmlAttributeCollection obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlAttributeCollection.CopyTo" copyTo :: Dotnet.System.Array.Array (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a0) -> Int -> XmlAttributeCollection obj -> IO (()) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlAttributeCollectionTy.hs0000644006511100651110000000036107633645530025633 0ustar rossrossmodule Dotnet.System.Xml.XmlAttributeCollectionTy where import Dotnet.System.Xml.XmlNamedNodeMap data XmlAttributeCollection_ a type XmlAttributeCollection a = Dotnet.System.Xml.XmlNamedNodeMap.XmlNamedNodeMap (XmlAttributeCollection_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlAttributeTy.hs0000644006511100651110000000030307633645530023613 0ustar rossrossmodule Dotnet.System.Xml.XmlAttributeTy where import Dotnet import Dotnet.System.Xml.XmlNodeTy data XmlAttribute_ a type XmlAttribute a = Dotnet.System.Xml.XmlNodeTy.XmlNode (XmlAttribute_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlCDataSection.hs0000644006511100651110000000240607633645530023642 0ustar rossrossmodule Dotnet.System.Xml.XmlCDataSection where import Dotnet import qualified Dotnet.System.Xml.XmlCharacterData import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlNode import Dotnet.System.Xml.XmlNodeType data XmlCDataSection_ a type XmlCDataSection a = Dotnet.System.Xml.XmlCharacterData.XmlCharacterData (XmlCDataSection_ a) foreign import dotnet "method Dotnet.System.Xml.XmlCDataSection.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlCDataSection obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlCDataSection.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlCDataSection obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlCDataSection.get_LocalName" get_LocalName :: XmlCDataSection obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlCDataSection.CloneNode" cloneNode :: Bool -> XmlCDataSection obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlCDataSection.get_NodeType" get_NodeType :: XmlCDataSection obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlCDataSection.get_Name" get_Name :: XmlCDataSection obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlCharacterData.hs0000644006511100651110000000355007633645531024031 0ustar rossrossmodule Dotnet.System.Xml.XmlCharacterData where import Dotnet import qualified Dotnet.System.Xml.XmlLinkedNode data XmlCharacterData_ a type XmlCharacterData a = Dotnet.System.Xml.XmlLinkedNode.XmlLinkedNode (XmlCharacterData_ a) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.ReplaceData" replaceData :: Int -> Int -> String -> XmlCharacterData obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.DeleteData" deleteData :: Int -> Int -> XmlCharacterData obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.InsertData" insertData :: Int -> String -> XmlCharacterData obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.AppendData" appendData :: String -> XmlCharacterData obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.Substring" substring :: Int -> Int -> XmlCharacterData obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.get_Length" get_Length :: XmlCharacterData obj -> IO (Int) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.set_Data" set_Data :: String -> XmlCharacterData obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.get_Data" get_Data :: XmlCharacterData obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.set_InnerText" set_InnerText :: String -> XmlCharacterData obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.get_InnerText" get_InnerText :: XmlCharacterData obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.set_Value" set_Value :: String -> XmlCharacterData obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlCharacterData.get_Value" get_Value :: XmlCharacterData obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlComment.hs0000644006511100651110000000226607633645531022750 0ustar rossrossmodule Dotnet.System.Xml.XmlComment where import Dotnet import qualified Dotnet.System.Xml.XmlCharacterData import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlNode import Dotnet.System.Xml.XmlNodeType data XmlComment_ a type XmlComment a = Dotnet.System.Xml.XmlCharacterData.XmlCharacterData (XmlComment_ a) foreign import dotnet "method Dotnet.System.Xml.XmlComment.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlComment obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlComment.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlComment obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlComment.get_LocalName" get_LocalName :: XmlComment obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlComment.CloneNode" cloneNode :: Bool -> XmlComment obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlComment.get_NodeType" get_NodeType :: XmlComment obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlComment.get_Name" get_Name :: XmlComment obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlDeclaration.hs0000644006511100651110000000471107633645531023570 0ustar rossrossmodule Dotnet.System.Xml.XmlDeclaration where import Dotnet import qualified Dotnet.System.Xml.XmlLinkedNode import qualified Dotnet.System.Xml.XmlWriter import qualified Dotnet.System.Xml.XmlNodeTy import qualified Dotnet.System.Xml.XmlNodeType data XmlDeclaration_ a type XmlDeclaration a = Dotnet.System.Xml.XmlLinkedNode.XmlLinkedNode (XmlDeclaration_ a) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlDeclaration obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlDeclaration obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.set_InnerText" set_InnerText :: String -> XmlDeclaration obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.get_InnerText" get_InnerText :: XmlDeclaration obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.get_LocalName" get_LocalName :: XmlDeclaration obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.CloneNode" cloneNode :: Bool -> XmlDeclaration obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.get_NodeType" get_NodeType :: XmlDeclaration obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.set_Value" set_Value :: String -> XmlDeclaration obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.get_Value" get_Value :: XmlDeclaration obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.get_Name" get_Name :: XmlDeclaration obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.get_Version" get_Version :: XmlDeclaration obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.get_Encoding" get_Encoding :: XmlDeclaration obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.set_Encoding" set_Encoding :: String -> XmlDeclaration obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.get_Standalone" get_Standalone :: XmlDeclaration obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDeclaration.set_Standalone" set_Standalone :: String -> XmlDeclaration obj -> IO (()) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlDocument.hs0000644006511100651110000003053207633645531023121 0ustar rossrossmodule Dotnet.System.Xml.XmlDocument ( module Dotnet.System.Xml.XmlDocument , module Dotnet.System.Xml.XmlDocumentTy ) where import Dotnet import qualified Dotnet.System.Xml.XmlNode import qualified Dotnet.System.Xml.XmlDocumentTy import Dotnet.System.Xml.XmlWriter import Dotnet.System.IO.TextWriter import Dotnet.System.IO.Stream import Dotnet.System.Xml.XmlReader import Dotnet.System.IO.TextReader import Dotnet.System.Xml.XmlNodeTy import Dotnet.System.Xml.XmlNodeType import Dotnet.System.Xml.XmlElementTy import Dotnet.System.Xml.XmlAttributeTy import Dotnet.System.Xml.XmlNodeList import Dotnet.System.Xml.XmlWhitespace import Dotnet.System.Xml.XmlSignificantWhitespace import Dotnet.System.Xml.XmlText import Dotnet.System.Xml.XmlDeclaration import Dotnet.System.Xml.XmlProcessingInstruction import Dotnet.System.Xml.XmlEntityReference import Dotnet.System.Xml.XmlDocumentFragment import Dotnet.System.Xml.XmlDocumentType import Dotnet.System.Xml.XmlComment import Dotnet.System.Xml.XmlCDataSection import Dotnet.System.Xml.XmlResolver import Dotnet.System.Xml.XmlImplementation import Dotnet.System.Xml.XmlNameTable --import Dotnet.System.Xml.XmlNodeChangedEventHandler data XmlDocument_ a type XmlDocument a = Dotnet.System.Xml.XmlNodeTy.XmlNode (XmlDocument_ a) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.Save" save :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.Save" save_1 :: Dotnet.System.IO.TextWriter.TextWriter a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.Save" save_2 :: Dotnet.System.IO.Stream.Stream a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.Save" save_3 :: String -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.LoadXml" loadXml :: String -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.Load" load :: Dotnet.System.Xml.XmlReader.XmlReader a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.Load" load_1 :: Dotnet.System.IO.TextReader.TextReader a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.Load" load_2 :: Dotnet.System.IO.Stream.Stream a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.Load" load_3 :: String -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.ReadNode" readNode :: Dotnet.System.Xml.XmlReader.XmlReader a0 -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateNode" createNode :: Dotnet.System.Xml.XmlNodeType.XmlNodeType a0 -> String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a3) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateNode" createNode_1 :: String -> String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a3) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateNode" createNode_2 :: Dotnet.System.Xml.XmlNodeType.XmlNodeType a0 -> String -> String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a4) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateElement" createElement :: String -> String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlElementTy.XmlElement a3) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateAttribute" createAttribute :: String -> String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a3) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.ImportNode" importNode :: Dotnet.System.Xml.XmlNodeTy.XmlNode a0 -> Bool -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a2) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.GetElementById" getElementById :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlElementTy.XmlElement a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.GetElementsByTagName" getElementsByTagName :: String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlNodeList.XmlNodeList a2) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.GetElementsByTagName" getElementsByTagName_1 :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlNodeList.XmlNodeList a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateWhitespace" createWhitespace :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlWhitespace.XmlWhitespace a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateSignificantWhitespace" createSignificantWhitespace :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlSignificantWhitespace.XmlSignificantWhitespace a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateTextNode" createTextNode :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlText.XmlText a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateXmlDeclaration" createXmlDeclaration :: String -> String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlDeclaration.XmlDeclaration a3) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateProcessingInstruction" createProcessingInstruction :: String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlProcessingInstruction.XmlProcessingInstruction a2) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateEntityReference" createEntityReference :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlEntityReference.XmlEntityReference a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateDocumentFragment" createDocumentFragment :: XmlDocument obj -> IO (Dotnet.System.Xml.XmlDocumentFragment.XmlDocumentFragment a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateDocumentType" createDocumentType :: String -> String -> String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlDocumentType.XmlDocumentType a4) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateComment" createComment :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlComment.XmlComment a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateCDataSection" createCDataSection :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlCDataSection.XmlCDataSection a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.set_XmlResolver" set_XmlResolver :: Dotnet.System.Xml.XmlResolver.XmlResolver a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_DocumentType" get_DocumentType :: XmlDocument obj -> IO (Dotnet.System.Xml.XmlDocumentType.XmlDocumentType a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_BaseURI" get_BaseURI :: XmlDocument obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.set_InnerXml" set_InnerXml :: String -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_InnerXml" get_InnerXml :: XmlDocument obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_IsReadOnly" get_IsReadOnly :: XmlDocument obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_LocalName" get_LocalName :: XmlDocument obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CloneNode" cloneNode :: Bool -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_OwnerDocument" get_OwnerDocument :: XmlDocument obj -> IO (Dotnet.System.Xml.XmlDocument.XmlDocument a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_NodeType" get_NodeType :: XmlDocument obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_Name" get_Name :: XmlDocument obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_Implementation" get_Implementation :: XmlDocument obj -> IO (Dotnet.System.Xml.XmlImplementation.XmlImplementation a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_DocumentElement" get_DocumentElement :: XmlDocument obj -> IO (Dotnet.System.Xml.XmlElementTy.XmlElement a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateAttribute" createAttribute_1 :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateElement" createElement_1 :: String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlElementTy.XmlElement a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateAttribute" createAttribute_2 :: String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a2) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.CreateElement" createElement_2 :: String -> String -> XmlDocument obj -> IO (Dotnet.System.Xml.XmlElementTy.XmlElement a2) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_NameTable" get_NameTable :: XmlDocument obj -> IO (Dotnet.System.Xml.XmlNameTable.XmlNameTable a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.get_PreserveWhitespace" get_PreserveWhitespace :: XmlDocument obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.set_PreserveWhitespace" set_PreserveWhitespace :: Bool -> XmlDocument obj -> IO (()) {- foreign import dotnet "method Dotnet.System.Xml.XmlDocument.add_NodeInserting" add_NodeInserting :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.remove_NodeInserting" remove_NodeInserting :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.add_NodeInserted" add_NodeInserted :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.remove_NodeInserted" remove_NodeInserted :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.add_NodeRemoving" add_NodeRemoving :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.remove_NodeRemoving" remove_NodeRemoving :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.add_NodeRemoved" add_NodeRemoved :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.remove_NodeRemoved" remove_NodeRemoved :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.add_NodeChanging" add_NodeChanging :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.remove_NodeChanging" remove_NodeChanging :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.add_NodeChanged" add_NodeChanged :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocument.remove_NodeChanged" remove_NodeChanged :: Dotnet.System.Xml.XmlNodeChangedEventHandler.XmlNodeChangedEventHandler a0 -> XmlDocument obj -> IO (()) -} hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlDocumentFragment.hs0000644006511100651110000000370307633645531024605 0ustar rossrossmodule Dotnet.System.Xml.XmlDocumentFragment where import Dotnet import qualified Dotnet.System.Xml.XmlNode import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlDocumentTy import Dotnet.System.Xml.XmlNodeType data XmlDocumentFragment_ a type XmlDocumentFragment a = Dotnet.System.Xml.XmlNode.XmlNode (XmlDocumentFragment_ a) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlDocumentFragment obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlDocumentFragment obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.set_InnerXml" set_InnerXml :: String -> XmlDocumentFragment obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.get_InnerXml" get_InnerXml :: XmlDocumentFragment obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.get_LocalName" get_LocalName :: XmlDocumentFragment obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.CloneNode" cloneNode :: Bool -> XmlDocumentFragment obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.get_OwnerDocument" get_OwnerDocument :: XmlDocumentFragment obj -> IO (Dotnet.System.Xml.XmlDocumentTy.XmlDocument a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.get_ParentNode" get_ParentNode :: XmlDocumentFragment obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.get_NodeType" get_NodeType :: XmlDocumentFragment obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentFragment.get_Name" get_Name :: XmlDocumentFragment obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlDocumentTy.hs0000644006511100651110000000027707633645531023441 0ustar rossrossmodule Dotnet.System.Xml.XmlDocumentTy where import Dotnet import Dotnet.System.Xml.XmlNodeTy data XmlDocument_ a type XmlDocument a = Dotnet.System.Xml.XmlNodeTy.XmlNode (XmlDocument_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlDocumentType.hs0000644006511100651110000000426607633645531023770 0ustar rossrossmodule Dotnet.System.Xml.XmlDocumentType where import Dotnet import qualified Dotnet.System.Xml.XmlLinkedNode import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlNode import Dotnet.System.Xml.XmlNodeType import Dotnet.System.Xml.XmlNamedNodeMap data XmlDocumentType_ a type XmlDocumentType a = Dotnet.System.Xml.XmlLinkedNode.XmlLinkedNode (XmlDocumentType_ a) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlDocumentType obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlDocumentType obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.get_IsReadOnly" get_IsReadOnly :: XmlDocumentType obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.get_LocalName" get_LocalName :: XmlDocumentType obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.CloneNode" cloneNode :: Bool -> XmlDocumentType obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.get_NodeType" get_NodeType :: XmlDocumentType obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.get_Name" get_Name :: XmlDocumentType obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.get_Entities" get_Entities :: XmlDocumentType obj -> IO (Dotnet.System.Xml.XmlNamedNodeMap.XmlNamedNodeMap a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.get_Notations" get_Notations :: XmlDocumentType obj -> IO (Dotnet.System.Xml.XmlNamedNodeMap.XmlNamedNodeMap a0) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.get_PublicId" get_PublicId :: XmlDocumentType obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.get_SystemId" get_SystemId :: XmlDocumentType obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlDocumentType.get_InternalSubset" get_InternalSubset :: XmlDocumentType obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlElement.hs0000644006511100651110000001433007633645531022732 0ustar rossrossmodule Dotnet.System.Xml.XmlElement ( module Dotnet.System.Xml.XmlElement , module Dotnet.System.Xml.XmlElementTy ) where import Dotnet import qualified Dotnet.System.Xml.XmlLinkedNode import Dotnet.System.Xml.XmlElementTy import Dotnet.System.Xml.XmlNodeTy import Dotnet.System.Xml.XmlNodeList import Dotnet.System.Xml.XmlAttributeTy import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlDocument import Dotnet.System.Xml.XmlAttributeCollectionTy import Dotnet.System.Xml.XmlNodeType foreign import dotnet "method Dotnet.System.Xml.XmlElement.RemoveAllAttributes" removeAllAttributes :: XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.RemoveAttributeAt" removeAttributeAt :: Int -> XmlElement obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlElement.HasAttribute" hasAttribute :: String -> String -> XmlElement obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlElement.HasAttribute" hasAttribute_1 :: String -> XmlElement obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlElement.GetElementsByTagName" getElementsByTagName :: String -> String -> XmlElement obj -> IO (Dotnet.System.Xml.XmlNodeList.XmlNodeList a2) foreign import dotnet "method Dotnet.System.Xml.XmlElement.RemoveAttributeNode" removeAttributeNode :: String -> String -> XmlElement obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a2) foreign import dotnet "method Dotnet.System.Xml.XmlElement.SetAttributeNode" setAttributeNode :: String -> String -> XmlElement obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a2) foreign import dotnet "method Dotnet.System.Xml.XmlElement.GetAttributeNode" getAttributeNode :: String -> String -> XmlElement obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a2) foreign import dotnet "method Dotnet.System.Xml.XmlElement.RemoveAttribute" removeAttribute :: String -> String -> XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.SetAttribute" setAttribute :: String -> String -> String -> XmlElement obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlElement.GetAttribute" getAttribute :: String -> String -> XmlElement obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlElement.GetElementsByTagName" getElementsByTagName_1 :: String -> XmlElement obj -> IO (Dotnet.System.Xml.XmlNodeList.XmlNodeList a1) foreign import dotnet "method Dotnet.System.Xml.XmlElement.RemoveAttributeNode" removeAttributeNode_1 :: Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a0 -> XmlElement obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlElement.SetAttributeNode" setAttributeNode_1 :: Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a0 -> XmlElement obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlElement.GetAttributeNode" getAttributeNode_1 :: String -> XmlElement obj -> IO (Dotnet.System.Xml.XmlAttributeTy.XmlAttribute a1) foreign import dotnet "method Dotnet.System.Xml.XmlElement.RemoveAttribute" removeAttribute_1 :: String -> XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.SetAttribute" setAttribute_1 :: String -> String -> XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.GetAttribute" getAttribute_1 :: String -> XmlElement obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_HasAttributes" get_HasAttributes :: XmlElement obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlElement.RemoveAll" removeAll :: XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.set_InnerXml" set_InnerXml :: String -> XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_InnerXml" get_InnerXml :: XmlElement obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlElement.set_InnerText" set_InnerText :: String -> XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_InnerText" get_InnerText :: XmlElement obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_LocalName" get_LocalName :: XmlElement obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlElement.set_Prefix" set_Prefix :: String -> XmlElement obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_Prefix" get_Prefix :: XmlElement obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_NamespaceURI" get_NamespaceURI :: XmlElement obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlElement.CloneNode" cloneNode :: Bool -> XmlElement obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_OwnerDocument" get_OwnerDocument :: XmlElement obj -> IO (Dotnet.System.Xml.XmlDocument.XmlDocument a0) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_Attributes" get_Attributes :: XmlElement obj -> IO (Dotnet.System.Xml.XmlAttributeCollectionTy.XmlAttributeCollection a0) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_NextSibling" get_NextSibling :: XmlElement obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_NodeType" get_NodeType :: XmlElement obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_Name" get_Name :: XmlElement obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlElement.get_IsEmpty" get_IsEmpty :: XmlElement obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlElement.set_IsEmpty" set_IsEmpty :: Bool -> XmlElement obj -> IO (()) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlElementTy.hs0000644006511100651110000000031107633645531023241 0ustar rossrossmodule Dotnet.System.Xml.XmlElementTy where import Dotnet import Dotnet.System.Xml.XmlLinkedNode data XmlElement_ a type XmlElement a = Dotnet.System.Xml.XmlLinkedNode.XmlLinkedNode (XmlElement_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlEntityReference.hs0000644006511100651110000000352707633645531024442 0ustar rossrossmodule Dotnet.System.Xml.XmlEntityReference where import Dotnet import qualified Dotnet.System.Xml.XmlLinkedNode import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlNode import Dotnet.System.Xml.XmlNodeType data XmlEntityReference_ a type XmlEntityReference a = Dotnet.System.Xml.XmlLinkedNode.XmlLinkedNode (XmlEntityReference_ a) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlEntityReference obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlEntityReference obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.get_BaseURI" get_BaseURI :: XmlEntityReference obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.get_IsReadOnly" get_IsReadOnly :: XmlEntityReference obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.get_LocalName" get_LocalName :: XmlEntityReference obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.CloneNode" cloneNode :: Bool -> XmlEntityReference obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.get_NodeType" get_NodeType :: XmlEntityReference obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.set_Value" set_Value :: String -> XmlEntityReference obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.get_Value" get_Value :: XmlEntityReference obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlEntityReference.get_Name" get_Name :: XmlEntityReference obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlImplementation.hs0000644006511100651110000000110607633645531024323 0ustar rossrossmodule Dotnet.System.Xml.XmlImplementation where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.Xml.XmlDocumentTy data XmlImplementation_ a type XmlImplementation a = Dotnet.System.Object.Object (XmlImplementation_ a) foreign import dotnet "method Dotnet.System.Xml.XmlImplementation.CreateDocument" createDocument :: XmlImplementation obj -> IO (Dotnet.System.Xml.XmlDocumentTy.XmlDocument a0) foreign import dotnet "method Dotnet.System.Xml.XmlImplementation.HasFeature" hasFeature :: String -> String -> XmlImplementation obj -> IO (Bool) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlLinkedNode.hs0000644006511100651110000000111307633645531023350 0ustar rossrossmodule Dotnet.System.Xml.XmlLinkedNode where import Dotnet import qualified Dotnet.System.Xml.XmlNodeTy import Dotnet.System.Xml.XmlNodeTy data XmlLinkedNode_ a type XmlLinkedNode a = Dotnet.System.Xml.XmlNodeTy.XmlNode (XmlLinkedNode_ a) foreign import dotnet "method Dotnet.System.Xml.XmlLinkedNode.get_NextSibling" get_NextSibling :: XmlLinkedNode obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlLinkedNode.get_PreviousSibling" get_PreviousSibling :: XmlLinkedNode obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlNameTable.hs0000644006511100651110000000051507633645531023171 0ustar rossrossmodule Dotnet.System.Xml.XmlNameTable where import Dotnet import qualified Dotnet.System.Object data XmlNameTable_ a type XmlNameTable a = Dotnet.System.Object.Object (XmlNameTable_ a) add :: String -> XmlNameTable a -> IO String add str = invoke "Add" str get :: String -> XmlNameTable a -> IO String get str = invoke "Get" str hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlNamedNodeMap.hs0000644006511100651110000000323507633645531023633 0ustar rossrossmodule Dotnet.System.Xml.XmlNamedNodeMap where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.Collections.IEnumerator import Dotnet.System.Xml.XmlNodeTy data XmlNamedNodeMap_ a type XmlNamedNodeMap a = Dotnet.System.Object.Object (XmlNamedNodeMap_ a) foreign import dotnet "method Dotnet.System.Xml.XmlNamedNodeMap.GetEnumerator" getEnumerator :: XmlNamedNodeMap obj -> IO (Dotnet.System.Collections.IEnumerator.IEnumerator a0) foreign import dotnet "method Dotnet.System.Xml.XmlNamedNodeMap.RemoveNamedItem" removeNamedItem :: String -> String -> XmlNamedNodeMap obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a2) foreign import dotnet "method Dotnet.System.Xml.XmlNamedNodeMap.GetNamedItem" getNamedItem :: String -> String -> XmlNamedNodeMap obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a2) foreign import dotnet "method Dotnet.System.Xml.XmlNamedNodeMap.Item" item :: Int -> XmlNamedNodeMap obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlNamedNodeMap.get_Count" get_Count :: XmlNamedNodeMap obj -> IO (Int) foreign import dotnet "method Dotnet.System.Xml.XmlNamedNodeMap.RemoveNamedItem" removeNamedItem_1 :: String -> XmlNamedNodeMap obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlNamedNodeMap.SetNamedItem" setNamedItem :: Dotnet.System.Xml.XmlNodeTy.XmlNode a0 -> XmlNamedNodeMap obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlNamedNodeMap.GetNamedItem" getNamedItem_1 :: String -> XmlNamedNodeMap obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlNamespaceManager.hs0000644006511100651110000000352607633645531024535 0ustar rossrossmodule Dotnet.System.Xml.XmlNamespaceManager where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.Collections.IEnumerator import Dotnet.System.Xml.XmlNameTable data XmlNamespaceManager_ a type XmlNamespaceManager a = Dotnet.System.Object.Object (XmlNamespaceManager_ a) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.GetEnumerator" getEnumerator :: XmlNamespaceManager obj -> IO (Dotnet.System.Collections.IEnumerator.IEnumerator a0) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.HasNamespace" hasNamespace :: String -> XmlNamespaceManager obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.LookupPrefix" lookupPrefix :: String -> XmlNamespaceManager obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.LookupNamespace" lookupNamespace :: String -> XmlNamespaceManager obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.RemoveNamespace" removeNamespace :: String -> String -> XmlNamespaceManager obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.AddNamespace" addNamespace :: String -> String -> XmlNamespaceManager obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.PopScope" popScope :: XmlNamespaceManager obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.PushScope" pushScope :: XmlNamespaceManager obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.get_DefaultNamespace" get_DefaultNamespace :: XmlNamespaceManager obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNamespaceManager.get_NameTable" get_NameTable :: XmlNamespaceManager obj -> IO (Dotnet.System.Xml.XmlNameTable.XmlNameTable a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlNode.hs0000644006511100651110000001707607633645531022240 0ustar rossrossmodule Dotnet.System.Xml.XmlNode ( module Dotnet.System.Xml.XmlNode, module Dotnet.System.Xml.XmlNodeTy ) where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.Xml.XmlNodeTy --import Dotnet.System.Xml.XPath.XPathNavigator import Dotnet.System.Xml.XmlElementTy import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlDocumentTy import Dotnet.System.Xml.XmlAttributeCollectionTy import Dotnet.System.Xml.XmlNodeList import Dotnet.System.Xml.XmlNodeType import Dotnet.System.Xml.XmlNamespaceManager import Dotnet.System.Collections.IEnumerator {- foreign import dotnet "method Dotnet.System.Xml.XmlNode.CreateNavigator" createNavigator :: XmlNode obj -> IO (Dotnet.System.Xml.XPath.XPathNavigator.XPathNavigator a0) -} foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_Item" get_Item :: String -> String -> XmlNode obj -> IO (Dotnet.System.Xml.XmlElementTy.XmlElement a2) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_Item" get_Item_1 :: String -> XmlNode obj -> IO (Dotnet.System.Xml.XmlElementTy.XmlElement a1) foreign import dotnet "method Dotnet.System.Xml.XmlNode.GetPrefixOfNamespace" getPrefixOfNamespace :: String -> XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.GetNamespaceOfPrefix" getNamespaceOfPrefix :: String -> XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.RemoveAll" removeAll :: XmlNode obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNode.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlNode obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNode.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlNode obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_BaseURI" get_BaseURI :: XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.set_InnerXml" set_InnerXml :: String -> XmlNode obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_InnerXml" get_InnerXml :: XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_OuterXml" get_OuterXml :: XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.set_InnerText" set_InnerText :: String -> XmlNode obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_InnerText" get_InnerText :: XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.Clone" clone :: XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_IsReadOnly" get_IsReadOnly :: XmlNode obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_LocalName" get_LocalName :: XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.set_Prefix" set_Prefix :: String -> XmlNode obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_Prefix" get_Prefix :: XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_NamespaceURI" get_NamespaceURI :: XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.Supports" supports :: String -> String -> XmlNode obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlNode.Normalize" normalize :: XmlNode obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNode.CloneNode" cloneNode :: Bool -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_HasChildNodes" get_HasChildNodes :: XmlNode obj -> IO (Bool) foreign import dotnet "method Dotnet.System.Xml.XmlNode.AppendChild" appendChild :: Dotnet.System.Xml.XmlNode.XmlNode a0 -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlNode.PrependChild" prependChild :: Dotnet.System.Xml.XmlNode.XmlNode a0 -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlNode.RemoveChild" removeChild :: Dotnet.System.Xml.XmlNode.XmlNode a0 -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlNode.ReplaceChild" replaceChild :: Dotnet.System.Xml.XmlNode.XmlNode a0 -> Dotnet.System.Xml.XmlNode.XmlNode a1 -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a2) foreign import dotnet "method Dotnet.System.Xml.XmlNode.InsertAfter" insertAfter :: Dotnet.System.Xml.XmlNode.XmlNode a0 -> Dotnet.System.Xml.XmlNode.XmlNode a1 -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a2) foreign import dotnet "method Dotnet.System.Xml.XmlNode.InsertBefore" insertBefore :: Dotnet.System.Xml.XmlNode.XmlNode a0 -> Dotnet.System.Xml.XmlNode.XmlNode a1 -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a2) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_LastChild" get_LastChild :: XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_FirstChild" get_FirstChild :: XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_OwnerDocument" get_OwnerDocument :: XmlNode obj -> IO (Dotnet.System.Xml.XmlDocumentTy.XmlDocument a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_Attributes" get_Attributes :: XmlNode obj -> IO (Dotnet.System.Xml.XmlAttributeCollectionTy.XmlAttributeCollection a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_NextSibling" get_NextSibling :: XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_PreviousSibling" get_PreviousSibling :: XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_ChildNodes" get_ChildNodes :: XmlNode obj -> IO (Dotnet.System.Xml.XmlNodeList.XmlNodeList a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_ParentNode" get_ParentNode :: XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_NodeType" get_NodeType :: XmlNode obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlNode.set_Value" set_Value :: String -> XmlNode obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_Value" get_Value :: XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.get_Name" get_Name :: XmlNode obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlNode.SelectSingleNode" selectSingleNode :: String -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlNode.SelectSingleNode" selectSingleNode_1 :: String -> Dotnet.System.Xml.XmlNamespaceManager.XmlNamespaceManager a1 -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a2) foreign import dotnet "method Dotnet.System.Xml.XmlNode.SelectNodes" selectNodes :: String -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNodeList.XmlNodeList a1) foreign import dotnet "method Dotnet.System.Xml.XmlNode.SelectNodes" selectNodes_1 :: String -> Dotnet.System.Xml.XmlNamespaceManager.XmlNamespaceManager a1 -> XmlNode obj -> IO (Dotnet.System.Xml.XmlNodeList.XmlNodeList a2) foreign import dotnet "method Dotnet.System.Xml.XmlNode.GetEnumerator" getEnumerator :: XmlNode obj -> IO (Dotnet.System.Collections.IEnumerator.IEnumerator a0) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlNodeList.hs0000644006511100651110000000154207633645531023063 0ustar rossrossmodule Dotnet.System.Xml.XmlNodeList where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.Collections.IEnumerator import Dotnet.System.Xml.XmlNodeTy data XmlNodeList_ a type XmlNodeList a = Dotnet.System.Object.Object (XmlNodeList_ a) foreign import dotnet "method Dotnet.System.Xml.XmlNodeList.GetEnumerator" getEnumerator :: XmlNodeList obj -> IO (Dotnet.System.Collections.IEnumerator.IEnumerator a0) foreign import dotnet "method Dotnet.System.Xml.XmlNodeList.get_ItemOf" get_ItemOf :: Int -> XmlNodeList obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlNodeList.get_Count" get_Count :: XmlNodeList obj -> IO (Int) foreign import dotnet "method Dotnet.System.Xml.XmlNodeList.Item" item :: Int -> XmlNodeList obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlNodeOrder.hs0000644006511100651110000000137107633673230023220 0ustar rossrossmodule Dotnet.System.Xml.XmlNodeOrder where import Dotnet import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data XmlNodeOrder_ a type XmlNodeOrder a = Dotnet.System.Enum.Enum (XmlNodeOrder_ a) data XmlNodeOrderTy = Before | After | Same | Unknown deriving ( Enum, Show, Read ) toXmlNodeOrder :: XmlNodeOrderTy -> XmlNodeOrder () toXmlNodeOrder tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Xml.XmlNodeOrder, System.Xml, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")) (show tag)) fromXmlNodeOrder :: XmlNodeOrder () -> XmlNodeOrderTy fromXmlNodeOrder obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlNodeTy.hs0000644006511100651110000000023307633645531022540 0ustar rossrossmodule Dotnet.System.Xml.XmlNodeTy where import qualified Dotnet.System.Object data XmlNode_ a type XmlNode a = Dotnet.System.Object.Object (XmlNode_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlNodeType.hs0000644006511100651110000000177507633645531023101 0ustar rossrossmodule Dotnet.System.Xml.XmlNodeType where import Dotnet import qualified Dotnet.System.Enum import qualified IOExts import qualified Dotnet.System.Type import qualified Dotnet.System.Enum data XmlNodeType_ a type XmlNodeType a = Dotnet.System.Enum.Enum (XmlNodeType_ a) data XmlNodeTypeTy = Value__ | None | Element | Attribute | Text | CDATA | EntityReference | Entity | ProcessingInstruction | Comment | Document | DocumentType | DocumentFragment | Notation | Whitespace | SignificantWhitespace | EndElement | EndEntity | XmlDeclaration deriving ( Enum, Show, Read ) toXmlNodeType :: XmlNodeTypeTy -> XmlNodeType () toXmlNodeType tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType "System.Xml.XmlNodeType, Dotnet.System.Xml, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")) (show tag)) fromXmlNodeType :: XmlNodeType () -> XmlNodeTypeTy fromXmlNodeType obj = IOExts.unsafePerformIO (toString obj >>= return.read) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlProcessingInstruction.hs0000644006511100651110000000465307633645531025726 0ustar rossrossmodule Dotnet.System.Xml.XmlProcessingInstruction where import Dotnet import qualified Dotnet.System.Xml.XmlLinkedNode import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlNode import Dotnet.System.Xml.XmlNodeType data XmlProcessingInstruction_ a type XmlProcessingInstruction a = Dotnet.System.Xml.XmlLinkedNode.XmlLinkedNode (XmlProcessingInstruction_ a) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlProcessingInstruction obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlProcessingInstruction obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.set_InnerText" set_InnerText :: String -> XmlProcessingInstruction obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.get_InnerText" get_InnerText :: XmlProcessingInstruction obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.get_LocalName" get_LocalName :: XmlProcessingInstruction obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.CloneNode" cloneNode :: Bool -> XmlProcessingInstruction obj -> IO (Dotnet.System.Xml.XmlNode.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.get_NodeType" get_NodeType :: XmlProcessingInstruction obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.set_Value" set_Value :: String -> XmlProcessingInstruction obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.get_Value" get_Value :: XmlProcessingInstruction obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.get_Name" get_Name :: XmlProcessingInstruction obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.get_Target" get_Target :: XmlProcessingInstruction obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.get_Data" get_Data :: XmlProcessingInstruction obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlProcessingInstruction.set_Data" set_Data :: String -> XmlProcessingInstruction obj -> IO (()) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlReader.hs0000644006511100651110000001247507633645531022553 0ustar rossross-- -- Haskell wrapper for Dotnet.System.Xml.XmlReader -- module Dotnet.System.Xml.XmlReader where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.Xml.XmlNameTable import Dotnet.System.Xml data XmlReader_ a type XmlReader a = Dotnet.System.Object.Object (XmlReader_ a) attributeCount :: XmlReader a -> IO Int attributeCount = invoke "get_AttributeCount" () baseURI :: XmlReader a -> IO String baseURI = invoke "get_BaseURI" () canResolveEntity :: XmlReader a -> IO Bool canResolveEntity = invoke "get_CanResolveEntity" () depth :: XmlReader a -> IO Int depth = invoke "get_Depth" () eof :: XmlReader a -> IO Bool eof = invoke "get_EOF" () hasAttributes :: XmlReader a -> IO Bool hasAttributes = invoke "get_HasAttributes" () hasValue :: XmlReader a -> IO Bool hasValue = invoke "get_HasValue" () isDefault :: XmlReader a -> IO Bool isDefault = invoke "get_IsDefault" () isEmptyElement :: XmlReader a -> IO Bool isEmptyElement = invoke "get_IsEmptyElement" () itemIndex :: Int -> XmlReader a -> IO String itemIndex idx = invoke "get_Item" idx itemName :: String -> XmlReader a -> IO String itemName nm = invoke "get_Item" nm itemNameURI :: String -> String -> XmlReader a -> IO String itemNameURI nm uri = invoke "get_Item" (nm,uri) localName :: XmlReader a -> IO String localName = invoke "get_LocalName" () name :: XmlReader a -> IO String name = invoke "get_Name" () namespaceURI :: XmlReader a -> IO String namespaceURI = invoke "get_NamespaceURI" () nameTable :: XmlReader a -> IO (Dotnet.System.Xml.XmlNameTable.XmlNameTable b) nameTable = invoke "get_NameTable" () nodeType :: XmlReader a -> IO Dotnet.System.Xml.XmlNodeType nodeType this = do v <- this # invoke "get_NodeType" () return (toEnum v) prefix :: XmlReader a -> IO String prefix = invoke "get_Prefix" () quoteChar :: XmlReader a -> IO Char quoteChar = invoke "get_QuoteChar" () readState :: XmlReader a -> IO Dotnet.System.Xml.ReadState readState this = do v <- this # invoke "get_ReadState" () return (toEnum v) value :: XmlReader a -> IO String value = invoke "get_Value" () xmlLang :: XmlReader a -> IO String xmlLang = invoke "get_XmlLang" () xmlSpace :: XmlReader a -> IO Dotnet.System.Xml.XmlSpace xmlSpace this = do v <- this # invoke "get_XmlSpace" () return (toEnum v) close :: XmlReader a -> IO () close = invoke "Close" () getAttributeIndex :: Int -> XmlReader a -> IO String getAttributeIndex idx = invoke "GetAttribute" idx getAttributeName :: String -> XmlReader a -> IO String getAttributeName nm = invoke "GetAttribute" nm getAttributeNameURI :: String -> String -> XmlReader a -> IO String getAttributeNameURI nm uri = invoke "getAttribute" (nm,uri) isName :: String -> XmlReader a -> IO Bool isName str = invoke "IsName" str isNameToken :: String -> XmlReader a -> IO Bool isNameToken str = invoke "IsNameToken" str isStartElement :: XmlReader a -> IO Bool isStartElement = invoke "IsStartElement" () isStartElementName :: String -> XmlReader a -> IO Bool isStartElementName str = invoke "IsStartElement" str isStartElementNameURI :: String -> String -> XmlReader a -> IO Bool isStartElementNameURI str uri = invoke "IsStartElement" (str,uri) lookupNamespace :: String -> XmlReader a -> IO String lookupNamespace str = invoke "LookupNamespace" str moveToAttributeIndex :: Int -> XmlReader a -> IO () moveToAttributeIndex idx = invoke "MoveToAttribute" idx moveToAttributeName :: String -> XmlReader a -> IO Bool moveToAttributeName str = invoke "MoveToAttribute" str moveToAttributeNameURI :: String -> String -> XmlReader a -> IO Bool moveToAttributeNameURI str uri = invoke "MoveToAttribute" (str,uri) moveToContent :: XmlReader a -> IO Dotnet.System.Xml.XmlNodeType moveToContent this = do v <- this # invoke "MoveToContent" () return (toEnum v) moveToElement :: XmlReader a -> IO Bool moveToElement = invoke "MoveToElement" () moveToFirstAttribute :: XmlReader a -> IO Bool moveToFirstAttribute = invoke "MoveToFirstAttribute" () moveToNextAttribute :: XmlReader a -> IO Bool moveToNextAttribute = invoke "MoveToNextAttribute" () readNext :: XmlReader a -> IO Bool readNext = invoke "Read" () readAttributeValue :: XmlReader a -> IO Bool readAttributeValue = invoke "ReadAttributeValue" () readElementString :: XmlReader a -> IO String readElementString = invoke "ReadElementString" () readElementStringName :: String -> XmlReader a -> IO String readElementStringName str = invoke "ReadElementString" str readElementStringNameURI :: String -> String -> XmlReader a -> IO String readElementStringNameURI str uri = invoke "ReadElementString" (str,uri) readEndElement :: XmlReader a -> IO () readEndElement = invoke "ReadEndElement" () readInnerXml :: XmlReader a -> IO String readInnerXml = invoke "ReadInnerXml" () readOuterXml :: XmlReader a -> IO String readOuterXml = invoke "ReadOuterXml" () readStartElement :: XmlReader a -> IO () readStartElement = invoke "ReadStartElement" () readStartElementName :: String -> XmlReader a -> IO () readStartElementName str = invoke "ReadStartElement" str readStartElementNameURI :: String -> String -> XmlReader a -> IO () readStartElementNameURI str uri = invoke "ReadStartElement" (str,uri) readString :: XmlReader a -> IO String readString = invoke "ReadString" () resolveEntity :: XmlReader a -> IO () resolveEntity = invoke "ResolveEntity" () skip :: XmlReader a -> IO () skip = invoke "Skip" () hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlResolver.hs0000644006511100651110000000152207633645531023141 0ustar rossrossmodule Dotnet.System.Xml.XmlResolver where import Dotnet import qualified Dotnet.System.Object --import Dotnet.System.Net.ICredentials import Dotnet.System.Uri import Dotnet.System.Type data XmlResolver_ a type XmlResolver a = Dotnet.System.Object.Object (XmlResolver_ a) {- foreign import dotnet "method Dotnet.System.Xml.XmlResolver.set_Credentials" set_Credentials :: Dotnet.System.Net.ICredentials.ICredentials a0 -> XmlResolver obj -> IO (()) -} foreign import dotnet "method Dotnet.System.Xml.XmlResolver.ResolveUri" resolveUri :: Dotnet.System.Uri.Uri a0 -> String -> XmlResolver obj -> IO (Dotnet.System.Uri.Uri a2) foreign import dotnet "method Dotnet.System.Xml.XmlResolver.GetEntity" getEntity :: Dotnet.System.Uri.Uri a0 -> String -> Dotnet.System.Type.Type a2 -> XmlResolver obj -> IO (Dotnet.System.Object.Object a3) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlSignificantWhitespace.hs0000644006511100651110000000330407633645531025613 0ustar rossrossmodule Dotnet.System.Xml.XmlSignificantWhitespace where import Dotnet import qualified Dotnet.System.Xml.XmlCharacterData import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlNodeTy import Dotnet.System.Xml.XmlNodeType data XmlSignificantWhitespace_ a type XmlSignificantWhitespace a = Dotnet.System.Xml.XmlCharacterData.XmlCharacterData (XmlSignificantWhitespace_ a) foreign import dotnet "method Dotnet.System.Xml.XmlSignificantWhitespace.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlSignificantWhitespace obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlSignificantWhitespace.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlSignificantWhitespace obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlSignificantWhitespace.get_LocalName" get_LocalName :: XmlSignificantWhitespace obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlSignificantWhitespace.CloneNode" cloneNode :: Bool -> XmlSignificantWhitespace obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlSignificantWhitespace.get_NodeType" get_NodeType :: XmlSignificantWhitespace obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlSignificantWhitespace.set_Value" set_Value :: String -> XmlSignificantWhitespace obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlSignificantWhitespace.get_Value" get_Value :: XmlSignificantWhitespace obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlSignificantWhitespace.get_Name" get_Name :: XmlSignificantWhitespace obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlSpace.hs0000644006511100651110000000024707633645531022376 0ustar rossrossmodule Dotnet.System.Xml.XmlSpace where import Dotnet import qualified Dotnet.System.Enum data XmlSpace_ a type XmlSpace a = Dotnet.System.Enum.Enum (XmlSpace_ a) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlText.hs0000644006511100651110000000300507633645531022262 0ustar rossrossmodule Dotnet.System.Xml.XmlText where import Dotnet import qualified Dotnet.System.Xml.XmlCharacterData import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlNodeTy import Dotnet.System.Xml.XmlNodeType data XmlText_ a type XmlText a = Dotnet.System.Xml.XmlCharacterData.XmlCharacterData (XmlText_ a) foreign import dotnet "method Dotnet.System.Xml.XmlText.SplitText" splitText :: Int -> XmlText obj -> IO (Dotnet.System.Xml.XmlText.XmlText a1) foreign import dotnet "method Dotnet.System.Xml.XmlText.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlText obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlText.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlText obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlText.get_LocalName" get_LocalName :: XmlText obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlText.CloneNode" cloneNode :: Bool -> XmlText obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlText.get_NodeType" get_NodeType :: XmlText obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlText.set_Value" set_Value :: String -> XmlText obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlText.get_Value" get_Value :: XmlText obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlText.get_Name" get_Name :: XmlText obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlWhitespace.hs0000644006511100651110000000275007633645531023440 0ustar rossrossmodule Dotnet.System.Xml.XmlWhitespace where import Dotnet import qualified Dotnet.System.Xml.XmlCharacterData import Dotnet.System.Xml.XmlWriter import Dotnet.System.Xml.XmlNodeTy import Dotnet.System.Xml.XmlNodeType data XmlWhitespace_ a type XmlWhitespace a = Dotnet.System.Xml.XmlCharacterData.XmlCharacterData (XmlWhitespace_ a) foreign import dotnet "method Dotnet.System.Xml.XmlWhitespace.WriteContentTo" writeContentTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlWhitespace obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWhitespace.WriteTo" writeTo :: Dotnet.System.Xml.XmlWriter.XmlWriter a0 -> XmlWhitespace obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWhitespace.get_LocalName" get_LocalName :: XmlWhitespace obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlWhitespace.CloneNode" cloneNode :: Bool -> XmlWhitespace obj -> IO (Dotnet.System.Xml.XmlNodeTy.XmlNode a1) foreign import dotnet "method Dotnet.System.Xml.XmlWhitespace.get_NodeType" get_NodeType :: XmlWhitespace obj -> IO (Dotnet.System.Xml.XmlNodeType.XmlNodeType a0) foreign import dotnet "method Dotnet.System.Xml.XmlWhitespace.set_Value" set_Value :: String -> XmlWhitespace obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWhitespace.get_Value" get_Value :: XmlWhitespace obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlWhitespace.get_Name" get_Name :: XmlWhitespace obj -> IO (String) hugs98-plus-Sep2006/dotnet/lib/Dotnet/System/Xml/XmlWriter.hs0000644006511100651110000001417007633666455022627 0ustar rossrossmodule Dotnet.System.Xml.XmlWriter where import Dotnet import qualified Dotnet.System.Object import Dotnet.System.Xml.XmlReader import Dotnet.System.Xml.XmlSpace import Dotnet.System.Xml.WriteState import qualified Dotnet.System.Array import qualified Data.Word data XmlWriter_ a type XmlWriter a = Dotnet.System.Object.Object (XmlWriter_ a) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteNode" writeNode :: Dotnet.System.Xml.XmlReader.XmlReader a0 -> Bool -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteAttributes" writeAttributes :: Dotnet.System.Xml.XmlReader.XmlReader a0 -> Bool -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteQualifiedName" writeQualifiedName :: String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteName" writeName :: String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteNmToken" writeNmToken :: String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.get_XmlLang" get_XmlLang :: XmlWriter obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.get_XmlSpace" get_XmlSpace :: XmlWriter obj -> IO (Dotnet.System.Xml.XmlSpace.XmlSpace a0) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.LookupPrefix" lookupPrefix :: String -> XmlWriter obj -> IO (String) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.Flush" flush :: XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.Close" close :: XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.get_WriteState" get_WriteState :: XmlWriter obj -> IO (Dotnet.System.Xml.WriteState.WriteState a0) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteBinHex" writeBinHex :: Dotnet.System.Array.Array Data.Word.Word8 -> Int -> Int -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteBase64" writeBase64 :: Dotnet.System.Array.Array Data.Word.Word8 -> Int -> Int -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteRaw" writeRaw :: String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteRaw" writeRaw_1 :: Dotnet.System.Array.Array Char -> Int -> Int -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteChars" writeChars :: Dotnet.System.Array.Array Char -> Int -> Int -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteSurrogateCharEntity" writeSurrogateCharEntity :: Char -> Char -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteString" writeString :: String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteWhitespace" writeWhitespace :: String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteCharEntity" writeCharEntity :: Char -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteEntityRef" writeEntityRef :: String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteProcessingInstruction" writeProcessingInstruction :: String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteComment" writeComment :: String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteCData" writeCData :: String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteEndAttribute" writeEndAttribute :: XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteStartAttribute" writeStartAttribute :: String -> String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteFullEndElement" writeFullEndElement :: XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteEndElement" writeEndElement :: XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteStartElement" writeStartElement :: String -> String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteDocType" writeDocType :: String -> String -> String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteEndDocument" writeEndDocument :: XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteStartDocument" writeStartDocument :: Bool -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteStartDocument" writeStartDocument_1 :: XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteStartElement" writeStartElement_1 :: String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteStartElement" writeStartElement_2 :: String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteAttributeString" writeAttributeString :: String -> String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteAttributeString" writeAttributeString_1 :: String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteAttributeString" writeAttributeString_2 :: String -> String -> String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteStartAttribute" writeStartAttribute_1 :: String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteElementString" writeElementString :: String -> String -> XmlWriter obj -> IO (()) foreign import dotnet "method Dotnet.System.Xml.XmlWriter.WriteElementString" writeElementString_1 :: String -> String -> String -> XmlWriter obj -> IO (()) hugs98-plus-Sep2006/dotnet/lib/Dotnet.hs0000644006511100651110000004061707633774320016642 0ustar rossross-- -- .NET library -- -- (c) 2002, sof -- module Dotnet ( Object -- abstract. Instances: Eq, Show , isNullObj -- :: Object a -> Bool , ( # ) -- :: a -> (a -> IO b) -> IO b , ( ## ) -- :: IO a -> (a -> IO b) -> IO b -- marshalling classes , NetType (arg, result) , NetArg(..) , InArg , createObj -- :: ClassName -> [InArg] -> IO (Object a) , new -- :: ClassName -> IO (Object a) -- all String synonyms. , FieldName , ClassName , MethodName -- low-level method invokers. , method -- :: (NetType a) -- => MethodName -- -> [InArg] -- -> Object b -- -> IO a , staticMethod -- :: (NetType a) -- => ClassName -- -> MethodName -- -> [InArg] -- -> IO a , method_ -- :: MethodName -- -> [InArg] -- -> Object a -- -> IO () , staticMethod_ -- :: ClassName -- -> MethodName -- -> [InArg] -- -> IO () , fieldGet -- :: (NetType a) => FieldName -> Object b -> IO a , fieldSet -- :: (NetType a) => FieldName -> Object b -> a -> IO () , staticFieldGet -- :: (NetType a) => ClassName -> FieldName -> IO a , staticFieldSet -- :: (NetType a) => ClassName -> FieldName -> a -> IO () -- automatic marshalling, provided you 'uncurry' the arguments, i.e., -- foo # invoke "MyMethod" (arg1,arg2,arg3) -- , newObj -- :: (NetArg a) => ClassName -> a -> IO (Object res) , invoke -- :: (NetArg a, NetType res) -- => MethodName -- -> a -- -> Object b -- -> IO (Object res) , invokeStatic -- :: (NetArg a, NetType res) -- => ClassName -- -> MethodName -- -> a -- -> Object b -- -> IO (Object res) -- creates a delegator, that is a System.Delegator object -- that when invoked, will execute the provided Haskell function -- value. Not particularly type safe. , newDelegator -- :: (Object a -> Object b -> IO ()) -- -> IO (Object c) -- converting , hsString -- :: Object a -> IO String , hsValue -- :: (NetType a) => Object obj -> IO a , boxValue -- :: (NetType a) => a -> IO (Object obj) , msgBox -- :: String -> String -> IO () , BaseType(..) , Class(..) , Method(..) , defineClass , mkVector -- :: BaseType -> Int -> IO (Object a) -- no longer needed, use boxValue and hsValue, respectively, instead. , mkInt32 , toInt32 -- use with care. , castObjTy -- :: Object a -> Object b , objType -- :: Object a -> a -- ToDo: remove; use mkVector. , mkPrimVector , newString , toString , isNullPtr , getStaticField , setStaticField , getField , setField ) where import Hugs.Prelude import Data.Char import Int import Word import IOExts --import Foreign ( makeStablePtr ) import StablePtr ( newStablePtr ) import Monad import List ( intersperse ) import Maybe --ximport Char ( chr ) infix 8 # infix 9 ## -- OO-style application operators: ( # ) :: a -> (a -> IO b) -> IO b obj # method = method obj ( ## ) :: IO a -> (a -> IO b) -> IO b mObj ## method = mObj >>= method {- At the heart of it all is the representation of object references - the Object type. The phantom type variable is used to maintain type safety. -} -- value equality instance Eq (Object a) where (==) obj1 obj2 = unsafePerformIO $ obj1 # invoke "Equals" obj2 instance Show (Object a) where show obj1 = unsafePerformIO $ obj1 # invoke "ToString" () castObjTy :: Object a -> Object b castObjTy o = unsafeCoerce o objType :: Object a -> a objType = error "objType" isNullObj :: Object a -> Bool isNullObj x = unsafePerformIO (isNullPtr x) type InArg = IO (Object ()) class NetType a where arg :: a -> InArg result :: Object () -> IO a instance NetType (Object a) where arg x = return (castObjTy x) result x = return (castObjTy x) instance NetType () where arg () = error "NetType.arg{()}: not defined" result _ = return () instance NetType Int where arg i = mkInt i result x = toInt_ x instance NetType Int8 where arg i = mkSByte (fromIntegral i) result x = toSByte x >>= return.fromIntegral instance NetType Int16 where arg i = mkInt32 (fromIntegral i) result x = toInt32 x >>= return.fromIntegral instance NetType Int32 where arg i = mkInt32 (fromIntegral i) result x = toInt32 x >>= return.fromIntegral instance NetType Word32 where arg i = mkUInt32 i result x = toUInt32 x instance NetType Word16 where arg i = mkUInt32 (fromIntegral i) result x = toUInt32 x >>= return.fromIntegral instance NetType Word8 where arg i = mkByte (chr (fromIntegral i)) result x = toByte x >>= return.fromIntegral.ord instance NetType Bool where arg i = mkBool i result x = toBool x instance NetType Char where arg i = mkByte i result x = toByte x instance NetType String where arg s = newString s result x = toString x instance NetType Float where arg i = mkSingle i result x = toSingle x instance NetType Double where arg i = mkDouble i result x = toDouble x -- self-documenting type synonyms type ClassName = String type FieldName = String type MethodName = String {- Creating a new Object: via a parameterised constructor. -} createObj :: ClassName -> [InArg] -> IO (Object a) createObj clsName args = do ls <- sequence args args <- mkArgs ls primCreateObject clsName args {- Creating a new Object via the nullary constructor. -} new :: ClassName -> IO (Object a) new clsName = primCreateObject clsName emptyArgArray emptyArgArray :: Object () emptyArgArray = unsafePerformIO $ do args <- newArgArray 0 return args mkArgs :: [Object ()] -> IO (Object a) mkArgs ls = do args <- newArgArray (length ls) zipWithM_ (setArrayArg args) ls [(0::Int)..] return args buildArgs :: [String] -> IO (Object a) buildArgs ls = do args <- newArgArray (length ls) zipWithM_ (\ idx v -> do x <- newString v setArrayArg args x idx) [(0::Int)..] ls return args {- Method invocation wrappers -- you currently have the choice of using the generic 'method'/'staticMethod' kind, which requires you to explicitly marshal the arguments, or use the method_X, where X is the arity of the method (and the number of arguments expected by the method_X wrapper.) -} method :: (NetType a) => MethodName -> [InArg] -> Object b -> IO a method methName args obj = do ls <- sequence args args <- mkArgs ls res <- invokeMethod obj methName args result res staticMethod :: (NetType a) => ClassName -> MethodName -> [InArg] -> IO a staticMethod clsName methName args = do ls <- sequence args args <- mkArgs ls res <- invokeStaticMethod (mkStaticMethod clsName methName) args result res mkStaticMethod clsName mName = clsName ++ '.':mName method_ :: MethodName -> [InArg] -> Object a -> IO () method_ methName args obj = do ls <- sequence args args <- mkArgs ls res <- invokeMethod obj methName args return () staticMethod_ :: ClassName -> MethodName -> [InArg] -> IO () staticMethod_ clsName methName args = do ls <- sequence args args <- mkArgs ls res <- invokeStaticMethod (mkStaticMethod clsName methName) args return () fieldGet :: (NetType a) => FieldName -> Object b -> IO a fieldGet fName obj = do res <- getField obj fName result (castObjTy res) staticFieldGet :: (NetType a) => ClassName -> FieldName -> IO a staticFieldGet cName fName = do res <- getStaticField cName fName result (castObjTy res) fieldSet :: (NetType a) => FieldName -> a -> Object b -> IO () fieldSet fName val obj = do p <- arg val setField obj fName p staticFieldSet :: (NetType a) => ClassName -> FieldName -> a -> IO () staticFieldSet cName fName val = do p <- arg val setStaticField cName fName p data System obj data Delegate obj foreign import dotnet "static Hugs.Wrapper.DefineDelegator" defineDelegator :: String -> StablePtr a -> IO String newDelegator :: (Object a -> Object b -> IO ()) -> IO (Object (System (Delegate ()))) newDelegator fun = do sp <- newStablePtr (delegatorWrapper fun) tyNm <- defineDelegator "Delegate" sp obj <- new tyNm obj # fieldGet "Delegate_handler" where delegatorWrapper :: (Object a -> Object b -> IO ()) -> Object a -> Object b -> IO () delegatorWrapper inner obj1 obj2 = inner obj1 obj2 {- To support the creation of .NET classes/types whose methods are implemented in Haskell, we provide the Class and Method data types. Status: experimental. -} data Class = Class String -- type/class name (Maybe String) -- Just x => derive from x [Method] {- The Method type describes the mapping between a .NET method, and the Haskell function value which implements it. Terribly type-unsafe at the moment. -} data Method = Method MethodName -- .NET name (unqualified). Bool -- True => override. String -- Haskell function to call. [BaseType] -- Argument types (Maybe BaseType) -- result (Nothing => void). -- ToDo: automate this -- given a Haskell function value, automatically -- derive the .NET arguments it expects (and returns). i.e., as in -- Lambada. data BaseType = ObjectTy (Maybe ClassName) -- Nothing => System.Object | StringTy | IntTy | ByteTy | BooleanTy | CharTy | DoubleTy | Int16Ty | Int32Ty | Int64Ty | SByteTy | SingleTy | UInt16Ty | UInt32Ty | UInt64Ty | VoidTy deriving ( Eq ) foreign import dotnet "static Hugs.Wrapper.DefineType" defineType :: String -> String -> String -> IO String -- create a new class/type + an instance of it (via the default constructor.) defineClass :: Class -> IO (Object b) defineClass cls@(Class clsName mbFrom meths) = do tyStr <- defineType clsName superTy methString if (null tyStr) then ioError (userError "unable to create class") else new tyStr where superTy = fromMaybe "" mbFrom methString = concat $ intersperse "/" $ map mkFunctionInfo meths mkFunctionInfo (Method name override haskellFun argus mbRes) = name ++ '#':haskellFun ++ '|':map toTag argus ++ ['|', fromMaybe 'V' (fmap toTag mbRes)] toTag x = case x of ObjectTy{} -> 'O' StringTy -> 'S' IntTy -> 'I' VoidTy -> 'V' {- Function: msgBox Purpose: Pops up a message box; no title. -} msgBox :: String -> String -> IO () msgBox caption msg = invokeStatic "System.Windows.Forms.MessageBox" "Show" (msg,caption) class NetArg a where marshal :: a -> IO [Object ()] -- unmarshal :: [Object ()] -> (a -> IO b) -> IO b instance NetArg () where marshal _ = return [] instance NetType a => NetArg a where marshal x = arg x >>= \ p -> return [p] instance (NetArg a1, NetArg a2) => NetArg (a1,a2) where marshal (a1,a2) = do lss <- sequence [marshal a1, marshal a2] return (concat lss) instance (NetArg a1, NetArg a2,NetArg a3) => NetArg (a1,a2,a3) where marshal (a1,a2,a3) = do lss <- sequence [marshal a1, marshal a2, marshal a3] return (concat lss) instance (NetArg a1, NetArg a2,NetArg a3, NetArg a4) => NetArg (a1,a2,a3,a4) where marshal (a1,a2,a3,a4) = do lss <- sequence [marshal a1, marshal a2, marshal a3, marshal a4] return (concat lss) instance (NetArg a1, NetArg a2,NetArg a3, NetArg a4, NetArg a5) => NetArg (a1,a2,a3,a4,a5) where marshal (a1,a2,a3,a4,a5) = do lss <- sequence [marshal a1, marshal a2, marshal a3, marshal a4, marshal a5] return (concat lss) instance (NetArg a1, NetArg a2, NetArg a3, NetArg a4, NetArg a5, NetArg a6) => NetArg (a1,a2,a3,a4,a5,a6) where marshal (a1,a2,a3,a4,a5,a6) = do lss <- sequence [marshal a1, marshal a2, marshal a3, marshal a4, marshal a5, marshal a6] return (concat lss) instance (NetArg a1, NetArg a2, NetArg a3, NetArg a4, NetArg a5, NetArg a6, NetArg a7) => NetArg (a1,a2,a3,a4,a5,a6,a7) where marshal (a1,a2,a3,a4,a5,a6,a7) = do lss <- sequence [marshal a1, marshal a2, marshal a3, marshal a4, marshal a5, marshal a6, marshal a7] return (concat lss) invoke :: (NetArg a, NetType res) => MethodName -> a -> Object b -> IO res invoke methName args obj = do ls <- marshal args args <- mkArgs ls res <- invokeMethod obj methName args result res newObj :: (NetArg a) => ClassName -> a -> IO (Object res) newObj clsName args = do ls <- marshal args args <- mkArgs ls primCreateObject clsName args invokeStatic :: (NetArg a, NetType res) => ClassName -> MethodName -> a -> IO res invokeStatic clsName methName args = do ls <- marshal args args <- mkArgs ls res <- invokeStaticMethod (mkStaticMethod clsName methName) args result res hsString :: Object a -> IO String hsString x = toString x hsValue :: NetType a => Object obj -> IO a hsValue x = result (castObjTy x) boxValue :: NetType a => a -> IO (Object b) boxValue v = do r <- arg v return (castObjTy (r :: Object ())) -- type unsafe. mkVector :: BaseType -> Int -> IO (Object a) mkVector eltTy sz = do case eltTy of ObjectTy{} -> newArgArray sz StringTy{} -> newArgArray sz VoidTy -> ioError (userError "DotNet.mkVector: can't create a vector of Voids") x -> mkPrimVector (toTag x) sz where toTag x = case x of ByteTy -> 0 BooleanTy -> 1 CharTy -> 2 DoubleTy -> 3 Int16Ty -> 4 Int32Ty -> 5 Int64Ty -> 6 IntTy -> 5 SByteTy -> 7 SingleTy -> 8 UInt16Ty -> 9 UInt32Ty -> 10 UInt64Ty -> 11 foreign import dotnet "static method System.Convert.ToInt32" mkInt32 :: Int32 -> IO (Object ()) foreign import dotnet "static method System.Convert.ToInt32" toInt32 :: Object a -> IO Int32 foreign import dotnet "static method System.Convert.ToInt32" mkInt :: Int -> IO (Object ()) foreign import dotnet "static method System.Convert.ToInt32" toInt_ :: Object a -> IO Int foreign import dotnet "static method System.Convert.ToSByte" mkSByte :: Int8 -> IO (Object ()) foreign import dotnet "static method System.Convert.ToSByte" toSByte :: Object a -> IO Int8 foreign import dotnet "static method System.Convert.ToByte" mkByte :: Char -> IO (Object ()) foreign import dotnet "static method System.Convert.ToByte" toByte :: Object a -> IO Char foreign import dotnet "static method System.Convert.ToUInt32" mkUInt32 :: Word32 -> IO (Object ()) foreign import dotnet "static method System.Convert.ToUInt32" toUInt32 :: Object a -> IO Word32 foreign import dotnet "static method System.Convert.ToBoolean" mkBool :: Bool -> IO (Object ()) foreign import dotnet "static method System.Convert.ToBoolean" toBool :: Object a -> IO Bool foreign import dotnet "static method System.Convert.ToSingle" mkSingle :: Float -> IO (Object ()) foreign import dotnet "static method System.Convert.ToSingle" toSingle :: Object a -> IO Float foreign import dotnet "static method System.Convert.ToDouble" mkDouble :: Double -> IO (Object ()) foreign import dotnet "static method System.Convert.ToDouble" toDouble :: Object a -> IO Double primitive primCreateObject "createObject" :: String -> Object args -> IO (Object o) primitive invokeMethod :: Object this -> String -> Object args -> IO (Object res) primitive invokeStaticMethod ::String -> Object args -> IO (Object res) primitive newArgArray :: Int -> IO (Object arr) primitive setArrayArg :: Object a -> Object val -> Int -> IO () primitive getArrayArg :: Object a -> Int -> IO (Object val) primitive getField :: Object a -> String -> IO (Object b) primitive setField :: Object a -> String -> Object b -> IO () primitive getStaticField :: String -> String -> IO (Object res) primitive setStaticField :: String -> String -> Object o -> IO () primitive isNullPtr :: Object o -> IO Bool primitive mkPrimVector :: Int{-type tag-} -> Int{-sz-} -> IO (Object o) -- tag values: -- [ Byte=0, Boolean=1, Byte, Char, Double, -- Int16, Int32, Int64, SByte, Single, UInt16, -- UInt32, UInt64] -- primitive newString :: String -> IO (Object a) primitive toString :: Object a -> IO String hugs98-plus-Sep2006/dotnet/ANNOUNCE0000644006511100651110000000262107743000203015405 0ustar rossross Hugs98 for .NET A new version of Hugs98 for .NET is now available, sporting the following: * A version of the popular Haskell interpreter, Hugs98 (http://haskell.org/hugs), targetted at the Microsoft .NET platform. * .NET interop integrated via the Haskell FFI. * Support for wrapping up Haskell functions as .NET classes / delegators, providing any .NET language with the ability to call and use Haskell. The distribution comes with documentation and examples demonstrating how to access and interact with .NET -- all available via the Hugs98.NET homepage: http://galois.com/~sof/hugs98.net/ Feedback, contributions, suggestions for improvements, bug reports etc. are most welcome -- please e-mail these to the author: sof@galois.com ----------------------------------------------------------------------- The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the Yale Haskell Group, and the Oregon Graduate Institute of Science and Technology, 1994-2003, All rights reserved. It is distributed as free software under the license in the file "License", which is included in the distribution. The .NET extension is Copyright (c) Sigbjorn Finne, 2002-2003, All rights reserved. It is distributed as free software under the license in the file "License.net", which is included in the distribution. ----------------------------------------------------------------------- hugs98-plus-Sep2006/dotnet/License.net0000644006511100651110000000307107630573241016362 0ustar rossrossThe .NET extensions to Hugs98 is Copyright (c) Sigbjorn Finne, 2002-2003, All rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/dotnet/examples/0000755006511100651110000000000010504340131016065 5ustar rossrosshugs98-plus-Sep2006/dotnet/examples/basic/0000755006511100651110000000000010504340131017146 5ustar rossrosshugs98-plus-Sep2006/dotnet/examples/basic/HttpOld.hs0000644006511100651110000000231707633650033021101 0ustar rossross-- -- Based on Mondrian example in DDJ. -- module HttpOld where import Dotnet import IOExts -- -- NOTE: this version of the Http example accesses .NET -- via primitive operations provided by the DotNet library -- and not directly via the FFI. See Http.hs for a version -- that does. -- http :: String -> IO () http url = do req <- invokeStatic "System.Net.WebRequest" "Create" url if not (isNullObj req) then do rsp <- req # invoke "GetResponse" () str <- rsp # invoke "GetResponseStream" () ls <- str # slurpString putStrLn ls else putStrLn ("Unable to fetch "++ url) slurpString :: Object a -> IO String slurpString stream = do buf <- mkVector ByteTy 200 off <- boxValue (0::Int) sz <- boxValue (200::Int) let go stream = do x <- stream # invoke "Read" (buf, off, sz) stat <- hsValue x if (stat <= (0 :: Int)) then return [] else do ls <- bytesToUTF8 buf off x rs <- unsafeInterleaveIO (go stream) return (ls ++ rs) go stream bytesToUTF8 :: Object a -> Object a -> Object a -> IO String bytesToUTF8 byteArr off sz = do encUTF8 <- newObj "System.Text.UTF8Encoding" () encUTF8 # invoke "GetString" (byteArr, off, sz) hugs98-plus-Sep2006/dotnet/examples/basic/Env.hs0000644006511100651110000000041507633650033020250 0ustar rossross-- -- Calling a static method -- module Env where import Dotnet foreign import dotnet "static System.Environment.GetEnvironmentVariable" getEnv :: String -> IO String test :: IO () test = do let var = "COMSPEC" s <- getEnv var putStrLn (var ++ " = " ++ s) hugs98-plus-Sep2006/dotnet/examples/basic/Http.hs0000644006511100651110000000407707633650033020447 0ustar rossross-- -- Based on Mondrian example in DDJ, at least originally. -- module Http where import Dotnet import IOExts ( unsafeInterleaveIO ) -- -- This version of the Http example uses the FFI to access -- .NET; see HttpOld.hs for an alternate (and older) approach -- to .NET interop. -- -- -- 'http url' dumps out the response from issuing a HTTP GET -- request to URL 'url'. -- http :: String -> IO () http url = do req <- createURL url if not (isNullObj req) then do rsp <- req # getResponse str <- rsp # getResponseStream ls <- str # slurpString putStrLn ls else putStrLn ("Unable to fetch "++ url) -- -- Define the types representing the objects we're accessing here. -- data WebRequest_ a type WebRequest a = Object (WebRequest_ a) data WebResponse_ a type WebResponse a = Object (WebResponse_ a) data Stream_ a type Stream a = Object (Stream_ a) data UTF8Encoding_ a -- not correct (TextEncoding is the parent), but precise enough. type UTF8Encoding a = Object (UTF8Encoding_ a) -- -- Binding to the methods required. -- foreign import dotnet "static System.Net.WebRequest.Create" createURL :: String -> IO (WebRequest ()) foreign import dotnet "method GetResponse" getResponse :: WebRequest a -> IO (WebResponse ()) foreign import dotnet "method GetResponseStream" getResponseStream :: WebResponse () -> IO (Stream a) foreign import dotnet "method Read" readOffBytes :: Object a -> Int -> Int -> Stream this -> IO Int foreign import dotnet "method GetString" getString :: Object a -> Int -> Int -> UTF8Encoding this -> IO String slurpString :: Stream a -> IO String slurpString stream = do buf <- mkVector ByteTy 200 encUTF8 <- new "System.Text.UTF8Encoding" let bytesToUTF8 byteArr off sz = do encUTF8 # getString byteArr off sz go stream = do stat <- stream # readOffBytes buf 0 200 if (stat <= (0 :: Int)) -- error of some sort, just break off. then return [] else do ls <- bytesToUTF8 buf 0 stat rs <- unsafeInterleaveIO (go stream) return (ls ++ rs) go stream hugs98-plus-Sep2006/dotnet/examples/basic/Mail.hs0000644006511100651110000000057307633650033020407 0ustar rossross-- -- SmtpMail.Send example -- module Mail where import Dotnet foreign import dotnet "static System.Web.Mail.SmtpMail.Send" sendMail :: String -- fromAddr -> String -- toAddr -> String -- subject -> String -- body -> IO () test from toA = do sendMail from toA "Hugs98.net test" "Greetings from Hugs98.NET" hugs98-plus-Sep2006/dotnet/examples/callin/0000755006511100651110000000000010504340131017327 5ustar rossrosshugs98-plus-Sep2006/dotnet/examples/callin/CallIn.hs0000644006511100651110000000123207633650033021041 0ustar rossross-- -- Demonstrating explicit calling in to Haskell from -- .NET code (directly via the Hugs Server API). -- -- The external code calling in can be found in print.cs -- module CallIn where import Dotnet foreign import dotnet "static [print.dll]Print.p" printIt :: Object () -> IO () callIn :: IO () callIn = do -- mildly bogus to create Hugs.Server object, since -- its methods are all static.. serv <- new "Hugs.Server" print serv printIt serv -- (invokeStatic "[print.dll]Print" "p" serv) :: IO (Object Char) putStrLn "done" -- the entry point that will be called from Print.p() greeting = putStrLn "In Haskell: Greetings from Hugs98.NET" hugs98-plus-Sep2006/dotnet/examples/callin/print.cs0000644006511100651110000000063607632754036021044 0ustar rossross/* * Test harness for Hugs.NET - compile with * * csc /t:library print.cs /r:hugs.exe */ using System; using Hugs; public class Print { public static void p(Server o) { Console.WriteLine("In C#: Being passed a {0}", o); /* Looks odd; the entire Server interface is static */ Server.LookupName("CallIn", "greeting"); Server.doIO(); Console.WriteLine("Finished in C#-land;returning."); } } hugs98-plus-Sep2006/dotnet/examples/callin/print.dll0000755006511100651110000000600007632754036021204 0ustar rossrossMZÿÿ¸@€º´ Í!¸LÍ!This program cannot be run in DOS mode. $PELÕ}g>à! Þ# @@ €ˆ#S@(`  H.textä  `.rsrc(@@@.reloc ` @BÀ#Hœ ì0+rp( r5prCp( ( &rUp( *0( *BSJB v1.0.3705l#~tœ#Strings”#US¤#GUID´8#BlobG ú3 $ ;6]Jy+P –B ˆ †DwD!‹ –&!* D. /€qä 1print.dllmscorlibSystemObjectPrinthugsHugsServerp.ctorSystem.DiagnosticsDebuggableAttributeprintoConsoleWriteLineLookupNamedoIO3In C#: Being passed a {0} CallIngreeting=Finished in C#-land;returning.·”ÿ•%« A‹¢2ŠŠ·z\V4à‰   °#Î# À#_CorDllMainmscoree.dllÿ% @€0€HX@ÌÌ4VS_VERSION_INFO½ïþ?DVarFileInfo$Translation°,StringFileInfo000004b0Comments $CompanyName ,FileDescription 0FileVersion0.0.0.04 InternalNameprint.dll(LegalCopyright ,LegalTrademarks < OriginalFilenameprint.dll$ProductName 4ProductVersion0.0.0.08Assembly Version0.0.0.0 à3hugs98-plus-Sep2006/dotnet/examples/class/0000755006511100651110000000000010504340131017172 5ustar rossrosshugs98-plus-Sep2006/dotnet/examples/class/NewObj.hs0000644006511100651110000000217007633650033020730 0ustar rossross-- -- Demonstrating how to dynamically create a new .NET class -- containing methods that call back into Haskell. -- module NewObj where import Dotnet import List {- from DotNet; for reference: data Class = Class String -- type/class name (Maybe String) -- Just x => derive from x [Method] data Method = Method String -- .NET name Bool -- True => override. String -- Haskell function to call [Type] -- Argument types (Maybe Type) -- result (Nothing => void). -- for now, let's be modest.. data Type = Object | String | Int -} greeting :: Object () -> Object b -> IO () greeting o _ = do x <- (result o) >>= hsValue msgBox "hugs98" ("Hugs98.NET here " ++ x) foreign import dotnet "method Greeting" greet :: Object a -> Object b -> Object c -> IO () newObject :: IO () newObject = do let newType = Class "HugsObject" Nothing [Method "Greeting" False "NewObj.greeting" [ObjectTy Nothing,ObjectTy Nothing] Nothing] obj <- defineClass newType print (obj :: Object ()) obj # greet obj obj putStrLn "done" hugs98-plus-Sep2006/dotnet/examples/delegate/0000755006511100651110000000000010504340131017637 5ustar rossrosshugs98-plus-Sep2006/dotnet/examples/delegate/Delegate.hs0000644006511100651110000000160707633650033021727 0ustar rossross-- -- Packaging up Haskell function values as delegates. -- -- The UI which invokes the delegate can be found in ui.cs -- -- Note: you have to start 'hugs' from within its -- installation to have this example work. -- module Delegate where import Dotnet foreign import dotnet "static System.Windows.Forms.Application.Run" run :: Object a -> IO () delegate :: IO () delegate = do ui <- new "[ui.dll]UITest" upHandler <- newDelegator ( \ _ _ -> ui # invoke "IncCount" ()) downHandler <- newDelegator ( \ _ _ -> ui # invoke "DecCount" ()) --msgBox "Hugs98.NET" "a *real* delegate :-)") () <- ui # invoke "AddHandlerUp" upHandler () <- ui # invoke "AddHandlerDown" downHandler -- ToDo: the InvokeBridge is unable to locate this static method; look into. -- For now, use .NET stub method do it for us. -- run ui () <- ui # invoke "RunIt" () putStrLn "done" hugs98-plus-Sep2006/dotnet/examples/delegate/ui.cs0000644006511100651110000000277307632754611020640 0ustar rossross// // The prototypical functional GUI application, the counter. // // To compile: csc /t:library ui.cs // using System; using System.Windows.Forms; public class UITest : Form { private Button upButton; private Button downButton; private Label countLabel; private int count; public UITest() { upButton = new Button(); upButton.Text = "Up"; Controls.Add(upButton); downButton = new Button(); downButton.Text = "Down"; downButton.Location = new System.Drawing.Point (0,50); Controls.Add(downButton); countLabel = new Label(); countLabel.Text = count.ToString(); countLabel.Location = new System.Drawing.Point (0,30); countLabel.TextAlign = System.Drawing.ContentAlignment.MiddleCenter; Controls.Add(countLabel); Text = "WinForms example"; Height = 100; Width = 100; } public void IncCount() { count++; countLabel.Text = count.ToString(); } public void DecCount() { count--; countLabel.Text = count.ToString(); } public void AddHandlerUp(System.EventHandler h) { upButton.Click += h; } public void AddHandlerDown(System.EventHandler h) { downButton.Click += h; } public void RunIt() { Application.Run(this); } /* public void KickOff(System.EventHandler h) { button1.Click += h; Application.Run(this); } private void button1_click(object sender, EventArgs e) { MessageBox.Show("button1 clicked"); } */ } /* public class TestApp { public static void Main(string[] args) { Application.Run(new SampleApp()); } } */ hugs98-plus-Sep2006/dotnet/examples/delegate/ui.dll0000755006511100651110000001000007632754611020767 0ustar rossrossMZÿÿ¸@€º´ Í!¸LÍ!This program cannot be run in DOS mode. $PELÂQh>à! Î& @@ €x&S@ `  H.textÔ  `.rsrc @ @@.reloc `@B°&Hð!ˆ0ß( s }{rpo ( {o s }{rpo {2s o ( {o s }{|( o {s o { o ( {o rpo d( d( *0%%{X}{|( o *0%%{Y}{|( o *0 {o *0 {o *0( *BSJB v1.0.3705lÔ#~@œ#StringsÜ4#US#GUID h#BlobW ú3  &2M Œ… λåö( ;…JŠ+9 B S^P †d1.DdIAJ[N1iT1tT1€Y–Y. _€âä ä |ä 5ui.dllSystem.Windows.FormsFormUITestButtonupButtondownButtonLabelcountLabelcount.ctorIncCountDecCountmscorlibSystemEventHandlerAddHandlerUpAddHandlerDownRunItSystem.DiagnosticsDebuggableAttributeuiControlset_TextControlCollectionget_ControlsAddSystem.DrawingPointset_LocationInt32ToStringContentAlignmentset_TextAlignset_Heightset_Widthhadd_ClickApplicationRunUp Down!WinForms exampleù-M®§µIˆK±ªV†·z\V4à‰        °?_Õ :  !  )  &¾& °&_CorDllMainmscoree.dllÿ% @€0€HX@ÄÄ4VS_VERSION_INFO½ïþ?DVarFileInfo$Translation°$StringFileInfo000004b0Comments $CompanyName ,FileDescription 0FileVersion0.0.0.00InternalNameui.dll(LegalCopyright ,LegalTrademarks 8OriginalFilenameui.dll$ProductName 4ProductVersion0.0.0.08Assembly Version0.0.0.0 Ð6hugs98-plus-Sep2006/dotnet/examples/forms/0000755006511100651110000000000010504340131017213 5ustar rossrosshugs98-plus-Sep2006/dotnet/examples/forms/Forms.hs0000644006511100651110000000422407633734110020654 0ustar rossross-- -- Experiments with WinForms from Haskell -- -- (c) 2002, Bryn Keller. -- module Forms where {- This example uses DotNet actions to access .NET rather than the FFI, as it was written before FFI support was added to hugs98.net. Feel free to upgrade it! :) -} import Dotnet type Control a = Object a type Config a = Control a -> IO () build :: IO () build = do frm <- mkCtrl "System.Windows.Forms.Form" [option setSize (200, 200)] btn <- mkCtrl "System.Windows.Forms.Button" [option setText "Click Me", option setSize (50,50), option setLocation (75,75)] frm `addCtrl` btn event btn "Click" (\_ _ -> msgBox "Hello!" "Congratulations, you're running Haskell code!") invokeStatic "System.Windows.Forms.Application" "Run" frm option :: (Control a -> b -> IO()) -> b -> Config a option f val = \ob -> f ob val mkCtrl :: String -> [Config a] -> IO (Control a) mkCtrl ctrlType options = do ctrl <- newObj ctrlType () sequence_ (map (\x-> x ctrl) options) return ctrl event :: Control a -> String -> (Object a -> Object b -> IO ()) -> IO() event ctrl name func = do delegate <- newDelegator func () <- ctrl # invoke ("add_" ++ name) delegate return () setSize :: Control a -> (Int, Int) -> IO () setSize ctrl (width, height) = do bWidth <- boxValue width bHeight <- boxValue height () <- ctrl # invoke "set_Width" bWidth () <- ctrl # invoke "set_Height" bHeight return () setText :: Control a -> String -> IO () setText ctrl text = do () <- ctrl # invoke "set_Text" text return () setLocation :: Control a -> (Int, Int) -> IO () setLocation ctrl (x,y) = do bX <- boxValue x bY <- boxValue y () <- ctrl # invoke "set_Left" bX () <- ctrl # invoke "set_Top" bY return () add :: Object a -> Object a -> IO () add collection thing = do () <- collection # invoke "Add" thing return () addCtrl :: Control a -> Control a -> IO () addCtrl parent child = do ctrls <- getControls parent () <- add ctrls child return () getControls :: Control a -> IO (Object a) getControls frm = do ctrls <- frm # invoke "get_Controls" () return ctrls hugs98-plus-Sep2006/dotnet/examples/xml/0000755006511100651110000000000010504340131016665 5ustar rossrosshugs98-plus-Sep2006/dotnet/examples/xml/XMLSyn.hs0000644006511100651110000000224707633552414020402 0ustar rossrossmodule XMLSyn where data XMLDoc -- an XML document consists of a document typing + -- some markup using the elements/attributes declared in the header. = XMLDoc (Maybe XMLHeader) [Markup] deriving ( Show ) data XMLHeader = XMLHeader (Maybe XMLVersionInfo) -- version, encoding and standalone decls / info. [Markup] -- initial processing instructions and comments -- (Maybe DTD) -- the DTD [Markup] -- trailing processing instructions and comments deriving ( Show ) data XMLVersionInfo = XMLVersionInfo String (Maybe String) (Maybe String) deriving ( Show ) data Markup = ProcessingInstr String String | Comment String | Element Element -- | Reference RefString | PEReference String | CDSection String | CharData String -- for debugging purposes deriving ( Show ) data Element = Elem String [Attribute] (Maybe [Markup]) deriving ( Show ) data Attribute = Attribute String String deriving ( Show ) data RefString = AChar Char | AString String | PERef String | EntityRef String | CharRef String deriving ( Show ) hugs98-plus-Sep2006/dotnet/examples/xml/Xml.hs0000644006511100651110000000552207633736073020014 0ustar rossross-- -- External parsing of XML documents -- module Xml where import Dotnet import qualified Dotnet.System.Xml.XmlDocument import Dotnet.System.Xml.XmlNode import Dotnet.System.Xml.XmlNodeType as Type import Dotnet.System.Xml.XmlNodeList import qualified Dotnet.System.Xml.XmlAttributeCollection as Attr import qualified Dotnet.System.Xml.XmlNamedNodeMap as Attr import qualified Dotnet.System.Xml.XmlAttribute as At import qualified Dotnet.System.Xml.XmlDeclaration as Decl import XMLSyn import Maybe -- -- This example demonstrates how to make use of the .NET Xml classes -- to handle the parsing of XML documents. After having parsed a document -- externally, we simply walk over the document to generate a Haskell -- representation of it. -- loadXML :: String -> IO XMLDoc loadXML url = do doc <- newDoc doc # Dotnet.System.Xml.XmlDocument.load_3 url l <- doc # get_FirstChild tag <- doc # get_NodeType let v = Type.fromXmlNodeType tag case v of Type.Document -> do version <- doc # getVersion vs <- doc # getNodes return (XMLDoc version vs) _ -> return (XMLDoc Nothing []) getVersion :: XmlNode a -> IO (Maybe XMLHeader) getVersion doc = do -- probe for the xml declaration (assumed to be first child of a document.) ch <- doc # get_FirstChild tag <- ch # get_NodeType case Type.fromXmlNodeType tag of Type.XmlDeclaration -> do v <- ch # Decl.get_Version enc <- ch # Decl.get_Encoding std <- ch # Decl.get_Standalone return (Just (XMLHeader (Just (XMLVersionInfo v (Just enc) (Just std))) [] [])) _ -> return Nothing getNodes :: XmlNode a -> IO [Markup] getNodes node = do ls <- node # get_ChildNodes c <- ls # get_Count vs <- mapM (\ i -> ls # item i >>= \ obj -> getNode obj) [0..(c-1)] return (catMaybes vs) getNode :: XmlNode a -> IO (Maybe Markup) getNode node = do tag <- node # get_NodeType let v = Type.fromXmlNodeType tag case v of Type.Element -> do s <- node # get_Name vs <- node # getNodes as <- node # getAttributes return (Just (XMLSyn.Element (Elem s as (Just vs)))) Type.Comment -> do s <- node # get_InnerText return (Just (XMLSyn.Comment s)) Type.Text -> do s <- node # get_InnerText return (Just (XMLSyn.CharData s)) _ -> {- debugging: str <- toString tag print str -} return Nothing getAttributes :: XmlNode a -> IO [Attribute] getAttributes node = do as <- node # get_Attributes c <- as # Attr.get_Count mapM (\ i -> as # Attr.item i >>= \ obj -> getAttribute obj) [0..(c-1)] getAttribute :: At.XmlAttribute a -> IO Attribute getAttribute attr = do x <- attr # At.get_LocalName y <- attr # At.get_Value return (XMLSyn.Attribute x y) foreign import dotnet "ctor System.Xml.XmlDocument" newDoc :: IO (Dotnet.System.Xml.XmlDocument.XmlDocument ()) hugs98-plus-Sep2006/dotnet/examples/xml/books.xml0000644006511100651110000000147307633552414020553 0ustar rossross The Autobiography of Benjamin Franklin Benjamin Franklin 8.99 The Confidence Man Herman Melville 11.99 The Gorgias Plato 9.99 hugs98-plus-Sep2006/dotnet/tools/0000755006511100651110000000000010504340131015407 5ustar rossrosshugs98-plus-Sep2006/dotnet/tools/HsOutput.cs0000644006511100651110000003255107634262561017563 0ustar rossross// // (c) sof, 2002-2003 // using System; namespace HsWrapGen { /// /// /// public class HsOutput { private System.Type m_type; private System.Reflection.MemberInfo[] m_members; private System.Collections.Specialized.StringCollection m_names; private System.Collections.Specialized.StringCollection m_imports; private System.String m_modname; public HsOutput(System.Type ty,System.Reflection.MemberInfo[] mems) { m_type = ty; m_members = mems; m_names = new System.Collections.Specialized.StringCollection(); m_imports = new System.Collections.Specialized.StringCollection(); m_modname = "Dotnet." + m_type.FullName; } protected void OutputHeader(System.IO.StreamWriter st) { String supTy = (m_type.IsInterface ? "System.Object" : m_type.BaseType.FullName); String supTyCls = (m_type.IsInterface ? "Object" : m_type.BaseType.Name); st.WriteLine("module Dotnet.{0} where", m_type.FullName); st.WriteLine(""); st.WriteLine("import Dotnet"); AddImport("Dotnet."+supTy); foreach (String s in m_imports) { st.WriteLine("import qualified {0}", s); } st.WriteLine(""); // ToDo: provide the option of stashing this away in a separate // module. st.WriteLine("data {0}_ a", m_type.Name); st.WriteLine("type {0} a = Dotnet.{1}.{2} ({0}_ a)", m_type.Name, supTy, supTyCls); st.WriteLine(""); } private String ToHaskellName(String x) { System.String candName, candNameOrig; System.Int32 uniq = 1; if (System.Char.IsUpper(x[0])) { candName = String.Concat(System.Char.ToLower(x[0]), x.Substring(1)); } else { candName = x; } candNameOrig = candName; while (m_names.Contains(candName)) { candName = String.Concat(candNameOrig,"_",uniq.ToString()); uniq++; } m_names.Add(candName); return candName; } private String ToHaskellConName(String x) { System.String candName, candNameOrig; System.Int32 uniq = 1; if (System.Char.IsLower(x[0])) { candName = String.Concat(System.Char.ToUpper(x[0]), x.Substring(1)); } else { candName = x; } candNameOrig = candName; while (m_names.Contains(candName)) { candName = String.Concat(candNameOrig,"_",uniq.ToString()); uniq++; } m_names.Add(candName); return candName; } private void AddImport(System.String nm) { if (!m_imports.Contains(nm) && String.Compare(nm, m_modname) != 0) { m_imports.Add(nm); } } protected void OutputHaskellType(System.Text.StringBuilder sb, System.Type ty, System.Int32 idx) { /* Curiously, &-versions of prim types are showing up (cf. System.Uri.HexUnescape). * Just ignore them. */ if (ty.FullName == "System.Boolean" || ty.FullName == "System.Boolean&" ) { sb.Append("Bool"); return; } if (ty.FullName == "System.String") { sb.Append("String"); return; } if (ty.FullName == "System.Char" || ty.FullName == "System.Char&") { sb.Append("Char"); return; } if (ty.FullName == "System.Double" || ty.FullName == "System.Double&") { sb.Append("Double"); return; } if (ty.FullName == "System.Single" || ty.FullName == "System.Single&") { sb.Append("Double"); return; } if (ty.FullName == "System.SByte" || ty.FullName == "System.SByte&") { AddImport("Data.Int"); sb.Append("Data.Int.Int8"); return; } if (ty.FullName == "System.Int16" || ty.FullName == "System.Int16&") { AddImport("Data.Int"); sb.Append("Data.Int.Int16"); return; } if (ty.FullName == "System.Int32" || ty.FullName == "System.Int32&") { sb.Append("Int"); return; } if (ty.FullName == "System.Int64" || ty.FullName == "System.Int64&") { AddImport("Data.Int"); sb.Append("Data.Int.Int64"); return; } if (ty.FullName == "System.Byte" || ty.FullName == "System.Byte&") { AddImport("Data.Word"); sb.Append("Data.Word.Word8"); return; } if (ty.FullName == "System.UInt16" || ty.FullName == "System.UInt16&") { AddImport("Data.Word"); sb.Append("Data.Word.Word16"); return; } if (ty.FullName == "System.UInt32" || ty.FullName == "System.UInt32&") { AddImport("Data.Word"); sb.Append("Data.Word.Word32"); return; } if (ty.FullName == "System.UInt64" || ty.FullName == "System.UInt64&") { AddImport("Data.Word"); sb.Append("Data.Word.Word64"); return; } if (ty.FullName == "System.Void") { sb.Append("()"); return; } if (ty.FullName == "System.Object") { AddImport("Dotnet.System.Object"); sb.AppendFormat("Dotnet.System.Object.Object a{0}",idx); return; } if (ty.IsArray) { AddImport("Dotnet.System.Array"); sb.Append("Dotnet.System.Array.Array ("); OutputHaskellType(sb, ty.GetElementType(), idx); sb.Append(")"); } else { AddImport("Dotnet." + ty.FullName); sb.AppendFormat("Dotnet.{0}.{1} a{2}", ty.FullName, ty.Name, idx); } } protected void OutputMethodSig(System.Text.StringBuilder sb, System.Reflection.MemberInfo mi) { System.Reflection.MethodInfo m = (System.Reflection.MethodInfo)mi; System.Reflection.ParameterInfo[] ps = m.GetParameters(); int i; for (i=0; i < ps.Length; i++) { OutputHaskellType(sb,ps[i].ParameterType,i); sb.Append(" -> "); } if (m.IsStatic) { sb.Append("IO ("); } else { sb.AppendFormat("{0} obj -> IO (", mi.DeclaringType.Name); } OutputHaskellType(sb,m.ReturnType,i); sb.AppendFormat("){0}",System.Environment.NewLine); } protected void OutputCtorSig(System.Text.StringBuilder sb, System.Reflection.ConstructorInfo ci) { System.Reflection.ParameterInfo[] ps = ci.GetParameters(); int i; for (i=0; i < ps.Length; i++) { OutputHaskellType(sb,ps[i].ParameterType,i); sb.Append(" -> "); } sb.AppendFormat("IO ({0} ())", ci.DeclaringType.Name); sb.Append(System.Environment.NewLine); } protected void OutputFieldSig(System.Text.StringBuilder sb, System.Reflection.FieldInfo fi, bool isSetter) { /* Note: indexed values are provided via properties */ if (isSetter) { OutputHaskellType(sb,fi.FieldType,0); if (!fi.IsStatic) { sb.AppendFormat(" -> {0} obj", fi.DeclaringType.Name); } sb.AppendFormat(" -> IO (){0}",System.Environment.NewLine); } else { if (fi.IsStatic) { sb.Append("IO ("); } else { sb.AppendFormat("{0} obj -> IO (", fi.DeclaringType.Name); } OutputHaskellType(sb,fi.FieldType,0); sb.AppendFormat("){0}",System.Environment.NewLine); } } protected void OutputArgs(System.Text.StringBuilder sb, System.Reflection.MemberInfo mi, System.Boolean isTupled) { System.Reflection.MethodInfo m = (System.Reflection.MethodInfo)mi; Int32 i = 0; System.Reflection.ParameterInfo[] ps = m.GetParameters(); if (isTupled && ps.Length != 1) sb.Append("("); for (i=0; i < ps.Length; i++) { sb.AppendFormat("arg{0}",i); if (isTupled && (i+1) < ps.Length) { sb.Append(","); } else { if (!isTupled) sb.Append(" "); } } if (isTupled && ps.Length != 1) sb.Append(")"); } protected void OutputMember(System.Text.StringBuilder sb, System.Reflection.MemberInfo mi) { switch (mi.MemberType) { case System.Reflection.MemberTypes.Method: System.String methName = ToHaskellName(mi.Name); System.Reflection.MethodInfo m = (System.Reflection.MethodInfo)mi; sb.Append("foreign import dotnet"); sb.Append(System.Environment.NewLine); // the 'method' bit is really optional. sb.AppendFormat(" \"{0}method {1}.{2}\"", (m.IsStatic ? "static " : ""), mi.DeclaringType, mi.Name); sb.Append(System.Environment.NewLine); sb.AppendFormat(" {0} :: ", methName); OutputMethodSig(sb,mi); // the mind boggles, System.Environment ? sb.Append(System.Environment.NewLine); /* old habit ;) */ break; case System.Reflection.MemberTypes.Constructor: OutputCtor(sb,(System.Reflection.ConstructorInfo)mi); break; case System.Reflection.MemberTypes.Field: System.String fieldName = mi.Name; System.Reflection.FieldInfo f = (System.Reflection.FieldInfo)mi; System.String staticPrefix = (f.IsStatic ? "static " : ""); sb.Append("foreign import dotnet"); sb.Append(System.Environment.NewLine); sb.AppendFormat(" \"{0}field {1}.{2}\"", staticPrefix, mi.DeclaringType, mi.Name); sb.Append(System.Environment.NewLine); sb.AppendFormat(" get_{0} :: ", fieldName); OutputFieldSig(sb,f,false); sb.Append(System.Environment.NewLine); if (!f.IsInitOnly) { sb.Append("foreign import dotnet"); sb.Append(System.Environment.NewLine); sb.AppendFormat(" \"{0}field {1}.{2}\"", staticPrefix, mi.DeclaringType, mi.Name); sb.Append(System.Environment.NewLine); sb.AppendFormat(" set_{0} :: ", fieldName); OutputFieldSig(sb,f,true); sb.Append(System.Environment.NewLine); } break; default: break; } } protected void OutputCtor(System.Text.StringBuilder sb, System.Reflection.ConstructorInfo ci) { System.String ctorName = ToHaskellName("new"+ci.DeclaringType.Name); sb.Append("foreign import dotnet"); sb.Append(System.Environment.NewLine); sb.AppendFormat(" \"ctor {0}\"", ci.DeclaringType); sb.AppendFormat("{0}",System.Environment.NewLine); sb.AppendFormat(" {0} :: ", ctorName); OutputCtorSig(sb,ci); sb.Append(System.Environment.NewLine); } protected void OutputField(System.Text.StringBuilder sb, System.Reflection.MemberInfo mi) { switch (mi.MemberType) { case System.Reflection.MemberTypes.Field: System.String fieldName = ToHaskellConName(mi.Name); sb.Append(fieldName); break; default: break; } } public void OutputToFile(String fn) { System.IO.FileStream fs = new System.IO.FileStream(fn,System.IO.FileMode.Create); System.IO.StreamWriter st = new System.IO.StreamWriter(fs,System.Text.Encoding.ASCII); System.Text.StringBuilder sb = new System.Text.StringBuilder(); if (!m_type.IsInterface && m_type.BaseType.FullName == "System.Enum") { /* enumerations are mapped onto Haskell data types. */ System.String sep = " = "; sb.AppendFormat("data {0}Ty", m_type.Name); sb.Append(System.Environment.NewLine); foreach (System.Reflection.MemberInfo mem in m_members) { if (mem.Name != "value__") { sb.Append(sep); OutputField(sb,mem); sb.Append(System.Environment.NewLine); sep = " | "; } } sb.AppendFormat(" deriving ( Enum, Show, Read ){0}",System.Environment.NewLine); // Emit functions for converting betw alg type and object type. AddImport("IOExts"); AddImport("Dotnet.System.Type"); AddImport("Dotnet.System.Enum"); sb.AppendFormat("to{0} :: {0}Ty -> {0} (){1}", m_type.Name, System.Environment.NewLine); sb.AppendFormat("to{0} tag = IOExts.unsafePerformIO (Dotnet.System.Enum.parse (IOExts.unsafePerformIO (Dotnet.System.Type.getType \"{1}\")) (show tag)){2}", m_type.Name, m_type.AssemblyQualifiedName,System.Environment.NewLine); sb.Append(System.Environment.NewLine); sb.AppendFormat("from{0} :: {0} () -> {0}Ty{1}", m_type.Name, System.Environment.NewLine); sb.AppendFormat("from{0} obj = IOExts.unsafePerformIO (toString obj >>= return.read)", m_type.Name); sb.Append(System.Environment.NewLine); } else { foreach (System.Reflection.MemberInfo mem in m_members) { OutputMember(sb,mem); } foreach (System.Reflection.ConstructorInfo ci in m_type.GetConstructors()) { OutputCtor(sb,ci); } } OutputHeader(st); st.WriteLine(sb.ToString()); st.Flush(); st.Close(); fs.Close(); } } } hugs98-plus-Sep2006/dotnet/tools/App.cs0000644006511100651110000000212007634263640016474 0ustar rossross// // (c) sof, 2002-2003 // using System; namespace HsWrapGen { /// /// Toplevel Main wrapper for HsWrapGen tool. /// class App { /// /// Throw-away tool for generating Haskell .NET class wrappers. /// [STAThread] static void Main(string[] args) { if (args.Length > 0) { TypeInfo ti = new TypeInfo(args[0]); if (ti.Type == null) { Console.WriteLine("Unknown type: {0}", args[0]); } else { HsOutput hs = new HsOutput(ti.Type,ti.Members); String outFile; if (args.Length > 1) { outFile = args[1]; } else { Int32 idx = args[0].LastIndexOf('.'); if (idx >= 0) { outFile = String.Concat(args[0].Substring(idx+1), ".hs"); } else { outFile = String.Concat(args[0], ".hs"); } } Console.WriteLine(outFile); hs.OutputToFile(outFile); } } else { Console.WriteLine("Usage: hswrapgen classname [outfile]"); } } } } hugs98-plus-Sep2006/dotnet/tools/AssemblyInfo.cs0000644006511100651110000000116007631141425020343 0ustar rossrossusing System.Reflection; using System.Runtime.CompilerServices; [assembly: AssemblyCompany("The sof company")] [assembly: AssemblyCopyright("Copyright (c) 2002-2003, sof")] [assembly: AssemblyTrademark("")] [assembly: AssemblyProduct("HsWrapGen")] [assembly: AssemblyInformationalVersion("1.0.0.0")] [assembly: AssemblyFileVersion("1.0.0.0")] [assembly: AssemblyVersion("1.0.0.0")] [assembly: AssemblyTitle("HsWrapGen")] [assembly: AssemblyDescription("Haskell .NET wrapper generator")] [assembly: AssemblyCulture("")] [assembly: AssemblyDelaySign(false)] [assembly: AssemblyKeyFile("")] [assembly: AssemblyKeyName("")] hugs98-plus-Sep2006/dotnet/tools/Makefile0000644006511100651110000000041207631141425017060 0ustar rossross# # Makefile for hswrapgen, basic tool for generating # Haskell .NET declarations from a .NET type. # CSC=csc CSC_OPTS= SRCS=App.cs AssemblyInfo.cs HsOutput.cs TypeInfo.cs all : hswrapgen.exe hswrapgen.exe : $(SRCS) $(CSC) $(CSC_OPTS) /out:hswrapgen.exe $(SRCS) hugs98-plus-Sep2006/dotnet/tools/README.txt0000644006511100651110000000005207630573246017127 0ustar rossrossTo build: csc /out:hswrapgen.exe *.cs hugs98-plus-Sep2006/dotnet/tools/TypeInfo.cs0000644006511100651110000000460007634263640017516 0ustar rossross// // (c) sof, 2002-2003 // using System; using System.Reflection; namespace HsWrapGen { /// /// Given a type name, locate the metainfo needed to generate /// Haskell wrappers. /// public class TypeInfo { protected Type m_type; protected System.Reflection.MemberInfo[] m_members; protected static System.Collections.ArrayList m_assemblies; static TypeInfo() { Assembly corAss = Assembly.Load("mscorlib.dll"); System.String corDir = System.IO.Path.GetDirectoryName(corAss.Location); m_assemblies = new System.Collections.ArrayList(); System.String[] fs = System.IO.Directory.GetFiles(corDir, "*.dll"); for (int i=0; i < fs.Length; i++) { try { Assembly tA = Assembly.LoadFrom(fs[i]); m_assemblies.Add(tA.FullName); } catch (Exception) { continue; } } } public static Type GetType(System.String tyName) { try { Type t = Type.GetType(tyName); if (t != null) return t; } catch (Exception) { ; } for (int i=0; i < m_assemblies.Count; i++) { try { String s = String.Format("{0},{1}", tyName, m_assemblies[i].ToString()); // Console.WriteLine(s); Type t = Type.GetType(s); if (t != null) return t; } catch (Exception) { continue; } } return null; } public System.Type Type { get { return (m_type); } } public System.Reflection.MemberInfo[] Members { get { return (m_members); } } private bool myFilter(System.Reflection.MemberInfo m, System.Object filterCrit) { return (m.MemberType == System.Reflection.MemberTypes.Method || m.MemberType == System.Reflection.MemberTypes.Property || m.MemberType == System.Reflection.MemberTypes.Field); } public TypeInfo(System.String tyName) { m_type = TypeInfo.GetType(tyName); if (m_type != null) { if (m_type.IsInterface) { m_members = m_type.GetMethods(); } else { m_members = m_type.FindMembers( System.Reflection.MemberTypes.All, System.Reflection.BindingFlags.DeclaredOnly | System.Reflection.BindingFlags.Instance | System.Reflection.BindingFlags.Public | System.Reflection.BindingFlags.Static, new System.Reflection.MemberFilter(myFilter), null); } } } } } hugs98-plus-Sep2006/icons/0000755006511100651110000000000010504340131014065 5ustar rossrosshugs98-plus-Sep2006/icons/hsicon.gif0000644006511100651110000000207106727057366016072 0ustar rossrossGIF87a ÷h™Àáÿhhh™hÀháhÿh™h™™™À™á™ÿ™ÀhÀ™ÀÀÀáÀÿÀáhá™áÀáááÿáÿhÿ™ÿÀÿáÿÿÿhhh™hÀháhÿhhhhhh™hhÀhháhhÿhh™hh™h™™hÀ™há™hÿ™hÀhhÀh™ÀhÀÀháÀhÿÀháhháh™áhÀáhááhÿáhÿhhÿh™ÿhÀÿháÿhÿÿh™h™™™À™á™ÿ™h™hh™™h™Àh™áh™ÿh™™™h™™™™™À™™á™™ÿ™™À™hÀ™™À™ÀÀ™áÀ™ÿÀ™á™há™™á™Àá™áá™ÿá™ÿ™hÿ™™ÿ™Àÿ™áÿ™ÿÿ™ÀhÀ™ÀÀÀáÀÿÀhÀhhÀ™hÀÀhÀáhÀÿhÀ™Àh™À™™ÀÀ™Àá™Àÿ™ÀÀÀhÀÀ™ÀÀÀÀÀáÀÀÿÀÀáÀháÀ™áÀÀáÀááÀÿáÀÿÀhÿÀ™ÿÀÀÿÀáÿÀÿÿÀáhá™áÀáááÿáháhhá™háÀhááháÿhá™áh™á™™áÀ™áá™áÿ™áÀáhÀá™ÀáÀÀááÀáÿÀáááháá™ááÀáááááÿááÿáhÿá™ÿáÀÿááÿáÿÿáÿhÿ™ÿÀÿáÿÿÿhÿhhÿ™hÿÀhÿáhÿÿhÿ™ÿh™ÿ™™ÿÀ™ÿá™ÿÿ™ÿÀÿhÀÿ™ÀÿÀÀÿáÀÿÿÀÿáÿháÿ™áÿÀáÿááÿÿáÿÿÿhÿÿ™ÿÿÀÿÿáÿÿÿÿÿ!ù, @ÿ¡ÄHp Á‚ÀPÈp¡Ã×"JœÀÄ‹hèDŒ+Š´òšF‡ !J‰qdE‰9ÂøHÑ%È  ¢‚§O*KŠ,™@Ï£ThÖ|’$F?%JÕäF”I«‚\aÅèÏŸ@kŠ½ØÕåW'J…:©© S/Ú, )Z,¯1}zµ#ϸyW:ez’cZ­lû> ĸ±ãÇït{qW* ¿öŒ«wèÖ@,¼ª`x4­ç½­dì*ÓÉTÔ¨ˬ<–ha”œ—R‰r&ÑÀ‰{»V ü"YƞؖgÊ–ž;Óüó0pØ$›#}]pÓìÔK ^þ}­vŸ¹Ãì+^ýtá.ãËŸ/3 ;hugs98-plus-Sep2006/icons/hsicon.ico0000644006511100651110000000525610305442477016073 0ustar rossross(6 è^00hF( €€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿpÿ€x÷xøðÿÿÿ‡ÿÿÿ€ÿÿÿðÿÿÿ÷ÿÿÿÿÿÿÿøÿÿ÷ÿÿwðÿð€ÿ÷÷ÿÿÿ÷pwwwwwÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀ( @€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿˆˆˆˆˆˆˆˆˆˆˆˆÿÿÿÿÿÿÿÿÿÿÿøÿÿÿÿÿÿpÿøÿÿ€ÿÿÿ÷ÿøÿÿðÿÿ€øÿÿ÷ÿÿpðøÿÿÿÿÿÿøøÿÿÿpÿÿÿÿøÿÿÿ€ÿøÿÿÿøÿÿÿð÷ÿÿÿøÿÿÿ÷÷ÿÿÿøÿÿÿÿðÿÿÿÿøÿÿÿÿpðÿÿÿÿøÿÿÿÿðwÿÿÿÿøÿÿÿÿ÷ÿÿÿÿøÿÿÿÿøÿÿÿÿøÿÿÿÿÿÿÿÿÿøÿÿÿÿÿpÿÿÿÿøÿÿÿÿÿðÿÿÿÿøÿÿÿÿÿðÿÿÿÿøÿÿÿÿÿ€ÿÿÿÿÿøÿÿÿÿÿpÿÿÿÿÿøÿÿÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿÿøÿÿwÿ÷ÿÿÿpÿÿ€€ÿÿÿøpÿÿðÿÿÿÿ‡ÿÿÿpÿÿÿÿxpÿÿÿÿÿÿÿÿÿwÿÿÿÿÿÿÿÿÿpwwwwwwwwwpààààààààààààààààààààààààààààà?ààÿàÿ(0`€€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿwwwwwwwwwwwwwwwwwwpÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿpÿÿøÿÿÿÿÿÿx‡ÿÿÿpÿÿ÷ÿÿÿÿÿ÷ÿÿpÿÿÿÿÿÿÿÿðÿÿpÿÿÿpÿÿÿÿÿ€ÿÿpÿÿÿðÿÿÿÿÿðÿÿpÿÿÿøÿÿÿ÷ÿÿÿÿpÿÿÿÿÿÿÿøÿÿÿ€ÿÿpÿÿÿÿ€ÿÿÿðÿÿÿpÿÿpÿÿÿÿðÿÿðÿÿÿðÿÿpÿÿÿÿøÿÿpÿÿÿÿÿÿpÿÿÿÿ÷ÿÿ€ÿÿÿÿÿÿpÿÿÿÿÿÿÿ€ÿÿÿÿÿÿpÿÿÿÿÿpÿÿÿÿÿÿÿÿÿpÿÿÿÿÿð÷ÿÿÿÿÿÿÿpÿÿÿÿÿø÷ÿÿÿÿÿÿÿpÿÿÿÿÿÿøÿÿÿÿÿÿÿpÿÿÿÿÿÿ€ðÿÿÿÿÿÿÿpÿÿÿÿÿÿðpÿÿÿÿÿÿÿpÿÿÿÿÿÿøÿÿÿÿÿÿÿpÿÿÿÿÿÿ÷ÿÿÿÿÿÿÿpÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿpÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿ÷ÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿpÿÿÿÿÿÿ÷ÿÿÿÿÿÿÿÿÿpÿÿÿÿÿÿøÿÿÿÿÿ€ÿÿÿ‡ÿÿÿðÿÿÿÿÿÿÿ÷€ÿÿÿˆÿÿÿ€ÿÿÿÿÿÿÿxÿÿÿpÿ÷ÿÿÿÿÿÿ÷€ÿÿÿðÿpÿÿÿÿÿÿÿxÿÿÿ÷ÿÿÿÿÿÿ÷€ÿÿÿÿ€ÿÿÿÿÿÿxÿÿÿÿøÿÿÿÿÿÿÿ‡€ÿÿÿÿÿÿÿÿÿÿÿÿÿÿˆÿÿÿÿÿÿÿÿÿÿÿÿÿÿ€ˆˆˆˆˆˆˆˆˆˆˆˆˆˆ€øøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøø?øøÿøÿøÿøÿøÿøÿhugs98-plus-Sep2006/icons/hsxicon.gif0000644006511100651110000000216606727057367016270 0ustar rossrossGIF87a ÷h™Àáÿhhh™hÀháhÿh™h™™™À™á™ÿ™ÀhÀ™ÀÀÀáÀÿÀáhá™áÀáááÿáÿhÿ™ÿÀÿáÿÿÿhhh™hÀháhÿhhhhhh™hhÀhháhhÿhh™hh™h™™hÀ™há™hÿ™hÀhhÀh™ÀhÀÀháÀhÿÀháhháh™áhÀáhááhÿáhÿhhÿh™ÿhÀÿháÿhÿÿh™h™™™À™á™ÿ™h™hh™™h™Àh™áh™ÿh™™™h™™™™™À™™á™™ÿ™™À™hÀ™™À™ÀÀ™áÀ™ÿÀ™á™há™™á™Àá™áá™ÿá™ÿ™hÿ™™ÿ™Àÿ™áÿ™ÿÿ™ÀhÀ™ÀÀÀáÀÿÀhÀhhÀ™hÀÀhÀáhÀÿhÀ™Àh™À™™ÀÀ™Àá™Àÿ™ÀÀÀhÀÀ™ÀÀÀÀÀáÀÀÿÀÀáÀháÀ™áÀÀáÀááÀÿáÀÿÀhÿÀ™ÿÀÀÿÀáÿÀÿÿÀáhá™áÀáááÿáháhhá™háÀhááháÿhá™áh™á™™áÀ™áá™áÿ™áÀáhÀá™ÀáÀÀááÀáÿÀáááháá™ááÀáááááÿááÿáhÿá™ÿáÀÿááÿáÿÿáÿhÿ™ÿÀÿáÿÿÿhÿhhÿ™hÿÀhÿáhÿÿhÿ™ÿh™ÿ™™ÿÀ™ÿá™ÿÿ™ÿÀÿhÀÿ™ÀÿÀÀÿáÀÿÿÀÿáÿháÿ™áÿÀáÿááÿÿáÿÿÿhÿÿ™ÿÿÀÿÿáÿÿÿÿÿ!ù, @ÿÀè„–Áƒ*¤Ep ƒ×"Jœx €E31#E(1 xœhP`G‰4HqĈk.p “$-Ž3ZŒ¸sä5„&iù¼È£Ï…êDñÉ5U0Ž@`Ô&A„Y TqF­U"t¨"áÄ‹a)uxrhZU$õY-]±T*ÕÙ³.Q´ä¶¨d  4 8ï`¦ `®°rm2€È/½Ú<ø¯4tEpÀAÚƒy¯.\½š \¶¬c#TA…6ÎÁhßÚ4X{îݾ#Qëýý÷h`ß#sßå=<ùNàpw.Zõ¹næÓ‹S.}ïHÆZébS÷.‘©Ë×Ya©YmwŠ¡\ ™~€*#ÀºwL~fi˜¹âUTm†\S¹t˜ÆX\I4Þc^Q¥ÒE†5ÛmÓùo´…X›l²‰¨B@;hugs98-plus-Sep2006/icons/hsxicon.ico0000644006511100651110000000525610305442477016263 0ustar rossross(6 è^00hF( €€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÌÌÌÌÌÌ ÿÿÿÿÿÿÀÏpÿÿüÏ€x÷xÿüÏøðÿÿÿüÏÿ‡ÿÿÿüÏÿ€ÿÿÿüÏÿðÿÿÿüÏÿ÷ÿÿüÏÿÿð‹üÏÿø;wüÏ÷ð³üÏwðÿó0ÿüÏ€ÿÿÿÿü ÿÿÿÿÿÿÀÌÌÌÌÌÌÀ€€À( @€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌ ÌÿÿÿÿÿÿÿÿÿÿÿÿÌÀ ÏÿÿÿÿÿÿpÿÿüÀÌÿÿÿ€ÿÿÿ÷ÿÿÿÌÌÿÿÿðÿÿ€ÿÿÌÌÿÿÿ÷ÿÿpðÿÿÌÌÿÿÿÿÿÿÿøÿÿÌÌÿÿÿÿpÿÿÿÿÌÌÿÿÿø€ €ÿÿÿÿÌÌÿÿÿó°030ÿÿÿÿÌÌÿÿÿó°3? 30ÿÿÿÿÌÌÿÿ÷»380?€ÿÿÿÌÌÿÿð3{»û³0ÿÿÿÌÌÿÿð3?°‹0ÿÿÿÌÌÿÿóóûw?¿°ÿÿÿÌÌÿÿó3?x{€ÿÿÿÌÌÿÿÿð?8û0ÿÿÿÿÌÌÿÿÿóû»p{?°ÿÿÿÿÌÌÿÿÿÿ3s°ssÿÿÿÿÌÌÿÿÿÿÿó0ƒÿÿÿÿÿÿÌÌÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÌÌÿÿÿÿÿÿpÿÿÿÿÿÿÿÌÌÿÿÿÿÿÿÿÿÿÿÿÿÌÌÿÿÿÿÿÿÿÿÿÿÿÿÌÌÿÿÿwÿ÷ÿÿÿÿÿÿÿÌÌÿÿÿ€€ÿÿÿÿÿÿÿÌÌÿÿÿðÿÿÿÿÿÿÿÿÌ ÏÿÿÿpÿÿÿÿÿÿÿüÀ ÌÿÿÿÿÿÿÿÿÿÿÿÿÌÀÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌðÀ€€€€Àð(0`€€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌ ÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÀÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌ ÌÏÿÿ÷ÿÿÿÿÿÿx‡ÿÿÿüÌÀ Ìÿÿÿÿÿÿÿÿÿ÷ÿÿÿÌÀÌÌÿÿÿÿpÿÿÿÿÿðÿÿÿÌÌÌÏÿÿÿÿðÿÿÿÿ€ÿÿÿüÌÌÏÿÿÿÿøÿÿÿÿÿðÿÿÿüÌÌÏÿÿÿÿÿÿÿÿ÷ÿÿÿÿÿüÌÌÏÿÿÿÿÿ€ÿÿÿøÿÿÿ€ÿÿÿüÌÌÏÿÿÿÿÿðÿÿðÿÿÿpÿÿÿüÌÌÏÿÿÿÿÿøÿÿðÿÿÿðÿÿÿüÌÌÏÿÿÿÿÿ÷ÿÿ€ÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿpÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿ÷p pÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿó°030ÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿó°3? 30ÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿø»370?pÿÿÿÿÿÿüÌÌÏÿÿÿÿÿð3»û³0ÿÿÿÿÿÿüÌÌÏÿÿÿÿÿð3?°{0ÿÿÿÿÿÿüÌÌÏÿÿÿÿÿóóû€?¿°ÿÿÿÿÿÿüÌÌÏÿÿÿÿÿó3?€‹pÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿð?ðû0ÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿóû°?°ÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿ3‡ƒÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿ÷ÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿ‡ÿÿÿðÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿˆÿÿÿ€ÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿpÿ÷ÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿðÿpÿÿÿÿÿÿÿÿÿÿÿüÌÌÌÿÿÿÿ÷ÿÿÿÿÿÿÿÿÿÿÿÌÌ Ìÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿÿÿÌÀ ÌÏÿÿÿÿøÿÿÿÿÿÿÿÿÿÿÿüÌÀÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌ ÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÀÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌü?ðàÀ€€€€Ààðü?hugs98-plus-Sep2006/icons/hugsicon.gif0000644006511100651110000000203306727057370016417 0ustar rossrossGIF87a ÷h™Àáÿhhh™hÀháhÿh™h™™™À™á™ÿ™ÀhÀ™ÀÀÀáÀÿÀáhá™áÀáááÿáÿhÿ™ÿÀÿáÿÿÿhhh™hÀháhÿhhhhhh™hhÀhháhhÿhh™hh™h™™hÀ™há™hÿ™hÀhhÀh™ÀhÀÀháÀhÿÀháhháh™áhÀáhááhÿáhÿhhÿh™ÿhÀÿháÿhÿÿh™h™™™À™á™ÿ™h™hh™™h™Àh™áh™ÿh™™™h™™™™™À™™á™™ÿ™™À™hÀ™™À™ÀÀ™áÀ™ÿÀ™á™há™™á™Àá™áá™ÿá™ÿ™hÿ™™ÿ™Àÿ™áÿ™ÿÿ™ÀhÀ™ÀÀÀáÀÿÀhÀhhÀ™hÀÀhÀáhÀÿhÀ™Àh™À™™ÀÀ™Àá™Àÿ™ÀÀÀhÀÀ™ÀÀÀÀÀáÀÀÿÀÀáÀháÀ™áÀÀáÀááÀÿáÀÿÀhÿÀ™ÿÀÀÿÀáÿÀÿÿÀáhá™áÀáááÿáháhhá™háÀhááháÿhá™áh™á™™áÀ™áá™áÿ™áÀáhÀá™ÀáÀÀááÀáÿÀáááháá™ááÀáááááÿááÿáhÿá™ÿáÀÿááÿáÿÿáÿhÿ™ÿÀÿáÿÿÿhÿhhÿ™hÿÀhÿáhÿÿhÿ™ÿh™ÿ™™ÿÀ™ÿá™ÿÿ™ÿÀÿhÀÿ™ÀÿÀÀÿáÀÿÿÀÿáÿháÿ™áÿÀáÿááÿÿáÿÿÿhÿÿ™ÿÿÀÿÿáÿÿÿÿÿ!ù, @øÀ(–Áƒ&$8ÆÁk!%âÄŠ3fT¨1ãÄbtܘP#H("-R¼ö‘EăNšü8²#˜kª\©óÇŽ'EN\¡óà@™=‹TA… Â§PRaúÐãÅ“Bü©sbÊž\GžLÖêE¯`Kμ*‘'K$iᤵ“â׺(_d87ªß½ þL+ðT¤Zm„¡¢j݉‰a:n#d­e¯UV‰1-â®pɪ €¨çÉ@AŠþ¼öcç‘™ÛN´òötÎÔCÛš†=º.m•œõ²¹[¶ë¯’¯°²¼&ʼ[%<80_ê  ;hugs98-plus-Sep2006/icons/hugsicon.ico0000644006511100651110000000525610305442477016427 0ustar rossross(6 è^00hF( €€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÌÌÌÌÌÌ ÿÿÿÿÿÿÀÏÿpÿüÏÿ€x÷xüÏÿøðÿÿüÏÿÿ‡ÿÿüÏÿÿ€ÿÿüÏÿÿðÿÿüÏÿÿ÷ÿÿüÏÿÿÿÿÿüÏÿÿøÿÿüÏÿ÷ÿÿüÏÿwðÿÿÿüÏÿ€ÿÿÿü ÿÿÿÿÿÿÀÌÌÌÌÌÌÀ€€À( @€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌ ÌÿÿÿÿÿÿÿÿÿÿÿÿÌÀ ÏÿÿÿÿÿÿpÿÿüÀÌÿÿÿ€ÿÿÿ÷ÿÿÿÌÌÿÿÿðÿÿ€ÿÿÌÌÿÿÿ÷ÿÿpðÿÿÌÌÿÿÿÿÿÿÿøÿÿÌÌÿÿÿÿpÿÿÿÿÿÿÌÌÿÿÿÿ€ÿøÿÿÿÿÿÌÌÿÿÿÿð÷ÿÿÿÿÿÌÌÿÿÿÿ÷÷ÿÿÿÿÿÌÌÿÿÿÿÿðÿÿÿÿÿÿÌÌÿÿÿÿÿpðÿÿÿÿÿÿÌÌÿÿÿÿÿðwÿÿÿÿÿÿÌÌÿÿÿÿÿ÷ÿÿÿÿÿÿÌÌÿÿÿÿÿøÿÿÿÿÿÿÌÌÿÿÿÿÿÿÿÿÿÿÿÿÌÌÿÿÿÿÿÿpÿÿÿÿÿÿÌÌÿÿÿÿÿÿðÿÿÿÿÿÿÌÌÿÿÿÿÿÿðÿÿÿÿÿÿÌÌÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÌÌÿÿÿÿÿÿpÿÿÿÿÿÿÿÌÌÿÿÿÿÿÿÿÿÿÿÿÿÌÌÿÿÿÿÿÿÿÿÿÿÿÿÌÌÿÿÿwÿ÷ÿÿÿÿÿÿÿÌÌÿÿÿ€€ÿÿÿÿÿÿÿÌÌÿÿÿðÿÿÿÿÿÿÿÿÌ ÏÿÿÿpÿÿÿÿÿÿÿüÀ ÌÿÿÿÿÿÿÿÿÿÿÿÿÌÀÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌðÀ€€€€Àð(0`€€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌ ÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÀÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌ ÌÏÿÿ÷ÿÿÿÿÿÿx‡ÿÿÿüÌÀ Ìÿÿÿÿÿÿÿÿÿ÷ÿÿÿÌÀÌÌÿÿÿÿpÿÿÿÿÿðÿÿÿÌÌÌÏÿÿÿÿðÿÿÿÿ€ÿÿÿüÌÌÏÿÿÿÿøÿÿÿÿÿðÿÿÿüÌÌÏÿÿÿÿÿÿÿÿ÷ÿÿÿÿÿüÌÌÏÿÿÿÿÿ€ÿÿÿøÿÿÿ€ÿÿÿüÌÌÏÿÿÿÿÿðÿÿðÿÿÿpÿÿÿüÌÌÏÿÿÿÿÿøÿÿðÿÿÿðÿÿÿüÌÌÏÿÿÿÿÿ÷ÿÿ€ÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿð÷ÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿø÷ÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿ€ðÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿðpÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿ÷ÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿ÷ÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿpÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿ÷ÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿ‡ÿÿÿðÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿˆÿÿÿ€ÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿpÿ÷ÿÿÿÿÿÿÿÿÿÿüÌÌÏÿÿÿÿðÿpÿÿÿÿÿÿÿÿÿÿÿüÌÌÌÿÿÿÿ÷ÿÿÿÿÿÿÿÿÿÿÿÌÌ Ìÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿÿÿÌÀ ÌÏÿÿÿÿøÿÿÿÿÿÿÿÿÿÿÿüÌÀÌÌÏÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÌÌ ÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÀÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌÌü?ðàÀ€€€€Ààðü?hugs98-plus-Sep2006/icons/hugsicon1.ico0000644006511100651110000000137606727057370016516 0ustar rossross è( @€€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿ LLLLLLLLLL@ÄÄÄÄÄÄÄÄÄÄÄÄÀ LLLLLLLLLLLL@ÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLGÿ|LGÿ|LLLLÄÄÄÿ÷Äÿ÷ÄÄÄÄLLLÿÿÿLÿÿÿLLLLÄÄÄÿÿÿÄÿÿÿÄÄÄÄLLLÿ÷Lÿ÷LLLLÄÄÄÇÿtÄÇÿtÄÄÄÄLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLGÿ|LGÿ|LLÄÄÄÄÄÿ÷Äÿ÷ÄÄLLLLLÿÿÿLÿÿÿLLÄÄÄÄÄÿÿÿÄÿÿÿÄÄLLLLLÿ÷Lÿ÷LLÄÄÄÄÄÇÿtÄÇÿtÄÄLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÀ LLLLLLLLLLLL@ÄÄÄÄÄÄÄÄÄÄÀÿÿÿÿÿÿÿÿøààÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀÀààøÿÿÿÿÿÿÿÿhugs98-plus-Sep2006/icons/hugsicon2.ico0000644006511100651110000000137606727057370016517 0ustar rossross è( @€€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿLLLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLLLÄÄÄÄÄÄ÷ÄÄ÷ÄÄÄÄLLLLLGÿÿ|Gÿÿ|LLLÄÄÄÄÄÏÿÿôÏÿÿôÄÄÄLLLLLOÿÿüOÿÿüLLLÄÄÄÄÄÇÿÿtÇÿÿtÄÄÄLLLLLL÷LL÷LLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄLLLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄ÷ÄÄ÷ÄÄLLLLLLLGÿÿ|Gÿÿ|LÄÄÄÄÄÄÄÏÿÿôÏÿÿôÄLLLLLLLOÿÿüOÿÿüLÄÄÄÄÄÄÄÇÿÿtÇÿÿtÄLLLLLLLL÷LL÷LLÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ LLLLLLLLLLLLLLLÄÄÄÄÄÄÄÄÄÄÄÄÄÄ€€àhugs98-plus-Sep2006/include/0000755006511100651110000000000010504340131014375 5ustar rossrosshugs98-plus-Sep2006/include/GreenCard.h0000644006511100651110000001137207743000203016410 0ustar rossross/* -------------------------------------------------------------------------- * GreenCard include file. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: GreenCard.h,v $ * $Revision: 1.5 $ * $Date: 2003/10/14 13:56:19 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * * WARNING * * Most of the code in this file must exactly match corresponding definitions * in the Hugs source code. * * We have chosen to copy this code over to avoid the need to #include huge * chunks of the Hugs internal definitions (which sometimes conflict with * Xlib, Win32 or other libraries which we might also have to #include). * * ------------------------------------------------------------------------*/ #ifndef __GREENCARD_H__ #define __GREENCARD_H__ /* Configuration details -- set to 0 if your C compiler doesn't support function protos */ #define HAVE_PROTOTYPES 1 #if HAVE_PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif /* What version of the API this file defines (and corresponding Hugs * sources prefer). * * Introduced in 'version 3', so the absence of this #define indicates * 'version 2' (version 1 is, by now, just a hazy memory to one Hugs * developer :-) ). */ #define HUGSAPI_VERSION 3 #define HUGSAPI_NAME HugsAPI3 /* based on code in builtin.c */ typedef int HugsStackPtr; typedef int HugsStablePtr; typedef void* HugsForeign; #define PROTO_PRIM(name) static void name Args((HugsStackPtr)) #define primFun(name) static void name(HugsStackPtr hugs_root) #define hugs_returnIO(n) hugs->returnIO(hugs_root,n) #define hugs_returnId(n) hugs->returnId(hugs_root,n) /* These declarations must exactly match those in storage.h */ typedef void (*Prim) Args((HugsStackPtr)); /* primitive function */ extern struct primitive { /* table of primitives */ char* ref; /* primitive reference string */ int arity; /* primitive function arity */ Prim imp; /* primitive implementation */ } primitives[]; struct primInfo { void (*controlFun) Args((int)); struct primitive *primFuns; struct primInfo *nextPrimInfo; }; /* This is an exact copy of the declaration found in storage.h */ typedef struct { /* evaluate next argument */ int (*getInt ) Args(()); unsigned int (*getWord) Args(()); void* (*getAddr ) Args(()); float (*getFloat ) Args(()); double (*getDouble) Args(()); char (*getChar ) Args(()); HugsForeign (*getForeign) Args(()); HugsStablePtr (*getStablePtr) Args(()); /* push part of result */ void (*putInt ) Args((int)); void (*putWord ) Args((unsigned int)); void (*putAddr ) Args((void *)); void (*putFloat ) Args((double)); void (*putDouble) Args((double)); void (*putChar ) Args((char)); void (*putForeign) Args((HugsForeign, void (*)(HugsForeign))); void (*putStablePtr) Args((HugsStablePtr)); /* return n values in IO monad or Id monad */ void (*returnIO) Args((HugsStackPtr, int)); void (*returnId) Args((HugsStackPtr, int)); int (*runIO) Args((int)); /* free a stable pointer */ void (*freeStablePtr) Args((HugsStablePtr)); /* register the prim table */ void (*registerPrims) Args((struct primInfo*)); /* garbage collect */ void (*garbageCollect) Args(()); /* API3 additions follow */ HugsStablePtr (*lookupName) Args((char*, char*)); void (*ap) Args((int)); void (*getUnit) Args(()); void* (*mkThunk) Args((void*, HugsStablePtr)); void (*freeThunk) Args((void*)); int (*getBool) Args(()); void (*putBool) Args((int)); } HugsAPI3; static HugsAPI3 *hugs = 0; /* pointer to virtual function table */ /* Copied verbatim from prelude.h */ #ifdef _MSC_VER /* Microsoft Visual C++ */ #define DLLIMPORT(rty) __declspec(dllimport) rty #define DLLEXPORT(rty) __declspec(dllexport) rty #elif defined __BORLANDC__ #define DLLIMPORT(rty) rty far _import #define DLLEXPORT(rty) rty far _export #else #define DLLIMPORT(rty) rty #define DLLEXPORT(rty) rty #endif /* Don't need to declare DLL exports */ #endif /* __GREENCARD_H__ */ hugs98-plus-Sep2006/lib/0000755006511100651110000000000010504340131013520 5ustar rossrosshugs98-plus-Sep2006/lib/exts/0000755006511100651110000000000010504340131014503 5ustar rossrosshugs98-plus-Sep2006/lib/exts/Addr.hs0000644006511100651110000000234010136526065015725 0ustar rossross----------------------------------------------------------------------------- -- Machine Addresses: -- Suitable for use with Hugs 98 on 32 bit machines. ----------------------------------------------------------------------------- module Addr ( Addr , nullAddr -- :: Addr , plusAddr -- :: Addr -> Int -> Addr -- instance Eq Addr -- instance Show Addr , ptrToAddr -- :: Ptr a -> Addr , addrToPtr -- :: Addr -> Ptr a , funPtrToAddr -- :: FunPtr a -> Addr , addrToFunPtr -- :: Addr -> FunPtr a ) where import Prelude -- data Addr -- in Prelude instance Eq Addr where (==) = primEqAddr instance Show Addr where showsPrec = primShowsAddr primitive nullAddr "nullPtr" :: Addr primitive plusAddr "plusPtr" :: Addr -> Int -> Addr primitive primShowsAddr "primShowsPtr" :: Int -> Addr -> ShowS primitive primEqAddr "primEqPtr" :: Addr -> Addr -> Bool primitive ptrToAddr "primUnsafeCoerce" :: Ptr a -> Addr primitive addrToPtr "primUnsafeCoerce" :: Addr -> Ptr a primitive funPtrToAddr "primUnsafeCoerce" :: FunPtr a -> Addr primitive addrToFunPtr "primUnsafeCoerce" :: Addr -> FunPtr a ----------------------------------------------------------------------------- hugs98-plus-Sep2006/lib/exts/ForeignObj.hs0000644006511100651110000000110207673566773017120 0ustar rossrossmodule ForeignObj( ForeignObj, module ForeignObj ) where import Prelude -- data ForeignObj -- in Prelude -- recently renamed newForeignObj = makeForeignObj primitive newForeignPtr_ :: Addr{-free-} -> IO ForeignObj primitive addForeignPtrFinalizer :: ForeignObj -> Addr{-free-} -> IO () primitive writeForeignObj :: ForeignObj -> Addr -> IO () primitive eqForeignObj :: ForeignObj -> ForeignObj -> Bool makeForeignObj addr finalizer = do fo <- newForeignPtr_ addr addForeignPtrFinalizer fo finalizer return fo instance Eq ForeignObj where (==) = eqForeignObj hugs98-plus-Sep2006/lib/hugs/0000755006511100651110000000000010504340131014466 5ustar rossrosshugs98-plus-Sep2006/lib/hugs/AnsiInteract.hs0000644006511100651110000000620206727055600017426 0ustar rossross----------------------------------------------------------------------------- -- Library of functions for writing interactive programs with screen-oriented -- I/O (assumes Ansi screen). -- -- Suitable for use with Hugs 98. ----------------------------------------------------------------------------- module AnsiInteract( module AnsiInteract, module Interact, module AnsiScreen ) where import AnsiScreen import Interact -- Screen oriented input/output functions: clearScreen :: Interact -> Interact writeAt :: Pos -> String -> Interact -> Interact moveTo :: Pos -> Interact -> Interact readAt :: Pos -> -- Start coordinates Int -> -- Maximum input length (String -> Interact) -> -- How to use entered string Interact defReadAt :: Pos -> -- Start coordinates Int -> -- Maximum input length String -> -- Default string value (String -> Interact) -> -- How to use entered string Interact promptReadAt :: Pos -> -- Start coordinates Int -> -- Maximum input length String -> -- Prompt (String -> Interact) -> -- How to use entered string Interact defPromptReadAt :: Pos -> -- Start coordinates Int -> -- Maximum input length String -> -- Prompt String -> -- Default string value (String -> Interact) -> -- How to use entered string Interact clearScreen = writeStr cls writeAt (x,y) s = writeStr (goto x y ++ s) moveTo (x,y) = writeStr (goto x y) readAt pt l use = writeAt pt (replicate l '_') (moveTo pt (loop 0 "")) where loop n s = readChar (return s) (\c -> case c of '\BS' -> delete n s '\DEL' -> delete n s '\n' -> return s c | n < l -> writeChar c (loop (n+1) (c:s)) | otherwise -> ringBell (loop n s)) delete n s = if n>0 then writeStr "\BS_\BS" (loop (n-1) (tail s)) else ringBell (loop 0 "") return s = use (reverse s) defReadAt (x,y) l def use = writeAt (x,y) (take l (def++repeat '_')) ( readChar (use def) (\c -> if c=='\n' then use def else unreadChar c (readAt (x,y) l use))) promptReadAt (x,y) l prompt use = writeAt (x,y) prompt (readAt (x+length prompt,y) l use) defPromptReadAt (x,y) l prompt def use = writeAt (x,y) prompt ( defReadAt (x+length prompt,y) l def use) ----------------------------------------------------------------------------- hugs98-plus-Sep2006/lib/hugs/AnsiScreen.hs0000644006511100651110000000164506727055600017102 0ustar rossross----------------------------------------------------------------------------- -- Library of escape sequences for ANSI compatible screen I/O: -- -- Suitable for use with Hugs 98 ----------------------------------------------------------------------------- module AnsiScreen( Pos(..), cls, goto, at, home, highlight ) where -- Basic screen control codes: type Pos = (Int,Int) at :: Pos -> String -> String highlight :: String -> String goto :: Int -> Int -> String home :: String cls :: String at (x,y) s = goto x y ++ s highlight s = "\ESC[7m"++s++"\ESC[0m" goto x y = '\ESC':'[':(show y ++(';':show x ++ "H")) home = goto 1 1 -- Choose whichever of the following lines is suitable for your system: cls = "\ESC[2J" -- for PC with ANSI.SYS --cls = "\^L" -- for Sun window ----------------------------------------------------------------------------- hugs98-plus-Sep2006/lib/hugs/HugsLibs.hs0000644006511100651110000000121407344513501016553 0ustar rossross----------------------------------------------------------------------------- -- Dummy module to import all of the Hugs libraries; programmers should -- normally be more selective than this when it comes to specifying the -- modules that a particular program depends on. -- -- Suitable for use with Hugs 98 ----------------------------------------------------------------------------- module HugsLibs where import StdLibs import Trace import Number import ParseLib import Interact import AnsiScreen import AnsiInteract import IOExtensions import ListUtils import Dynamic ----------------------------------------------------------------------------- hugs98-plus-Sep2006/lib/hugs/Interact.hs0000644006511100651110000000470106727055600016615 0ustar rossross----------------------------------------------------------------------------- -- Library for simple interactive programs: -- -- Suitable for use with Hugs 98 ----------------------------------------------------------------------------- module Interact( Interact(..), end, readChar, peekChar, unreadChar, pressAnyKey, writeChar, writeStr, readLine, ringBell ) where --- Interactive program combining forms: type Interact = String -> String end :: Interact readChar, peekChar :: Interact -> (Char -> Interact) -> Interact pressAnyKey :: Interact -> Interact unreadChar :: Char -> Interact -> Interact writeChar :: Char -> Interact -> Interact writeStr :: String -> Interact -> Interact ringBell :: Interact -> Interact readLine :: String -> (String -> Interact) -> Interact end cs = "" readChar eof use [] = eof [] readChar eof use (c:cs) = use c cs peekChar eof use [] = eof [] -- like readChar, but character is peekChar eof use cs@(c:_) = use c cs -- not removed from input stream pressAnyKey prog = readChar prog (\c -> prog) unreadChar c prog cs = prog (c:cs) writeChar c prog cs = c : prog cs writeStr s prog cs = s ++ prog cs ringBell = writeChar '\BEL' readLine prompt g is = prompt ++ lineOut 0 line ++ "\n" ++ g (noBackSpaces line) input' where line = before '\n' is input' = after '\n' is after x = tail . dropWhile (x/=) before x = takeWhile (x/=) rubout :: Char -> Bool rubout c = (c=='\DEL' || c=='\BS') lineOut :: Int -> String -> String lineOut n "" = "" lineOut n (c:cs) | n>0 && rubout c = "\BS \BS" ++ lineOut (n-1) cs | n==0 && rubout c = lineOut 0 cs | otherwise = c:lineOut (n+1) cs noBackSpaces :: String -> String noBackSpaces = reverse . delete 0 . reverse where delete n "" = "" delete n (c:cs) | rubout c = delete (n+1) cs | n>0 = delete (n-1) cs | otherwise = c:delete 0 cs ----------------------------------------------------------------------------- hugs98-plus-Sep2006/lib/hugs/ListUtils.hs0000644006511100651110000000157706727055600017010 0ustar rossrossmodule ListUtils( sums, products, subsequences, permutations ) where sums, products :: Num a => [a] -> [a] sums = scanl (+) 0 products = scanl (*) 1 -- subsequences xs returns the list of all subsequences of xs. -- e.g., subsequences "abc" == ["","c","b","bc","a","ac","ab","abc"] subsequences :: [a] -> [[a]] subsequences [] = [[]] subsequences (x:xs) = subsequences xs ++ map (x:) (subsequences xs) -- permutations xs returns the list of all permutations of xs. -- e.g., permutations "abc" == ["abc","bac","bca","acb","cab","cba"] permutations :: [a] -> [[a]] permutations [] = [[]] permutations (x:xs) = [zs | ys <- permutations xs, zs <- interleave x ys ] where interleave :: a -> [a] -> [[a]] interleave x [] = [[x]] interleave x (y:ys) = [x:y:ys] ++ map (y:) (interleave x ys) hugs98-plus-Sep2006/lib/hugs/Number.hs0000644006511100651110000000743706727055600016305 0ustar rossross----------------------------------------------------------------------------- -- Number.hs: Fixed width integers with overflow detection -- -- This library defines a numeric datatype of fixed width integers -- (whatever Int supplies). But, unlike Int, overflows are detected and -- cause a run-time error. Covers all classes upto and including Bounded -- and Ix. A fairly messy hack, but it works (most of the time :-) ... -- -- Suitable for use with Hugs 98 ----------------------------------------------------------------------------- module Number( Number, -- instance Eq Number, -- instance Ord Number, -- instance Show Number, -- instance Enum Number, -- instance Num Number, -- instance Bounded Number, -- instance Real Number, -- instance Ix Number, -- instance Integral Number, ) where import Ix(Ix(..)) default (Number,Int,Float) type Number = Int in numEq :: Number -> Number -> Bool, numCmp :: Number -> Number -> Ordering, numShowsPrec :: Int -> Number -> ShowS, numEnumFrom :: Number -> [Number], numEnumFromThen :: Number -> Number -> [Number], numAdd :: Number -> Number -> Number, numSub :: Number -> Number -> Number, numMul :: Number -> Number -> Number, numNeg :: Number -> Number, numFromInt :: Int -> Number, numToInt :: Number -> Int, numFromInteger :: Integer -> Number, numToInteger :: Number -> Integer, numMax :: Number, numMin :: Number, numSignum :: Number -> Number, numToRat :: Number -> Rational, numQrm :: Number -> Number -> (Number, Number), numRange :: (Number, Number) -> [Number], numIndex :: (Number, Number) -> Number -> Int, numInRange :: (Number, Number) -> Number -> Bool numEq = (==) numCmp = compare numShowsPrec = showsPrec numEnumFrom = enumFrom numEnumFromThen = enumFromThen numFromInt x = x numToInt x = x numFromInteger = fromInteger numToInteger = toInteger numMax = maxBound numMin = minBound numSignum = signum numToRat = toRational numQrm = quotRem numRange = range numIndex = index numInRange = inRange numAdd x y = if xsgn/=ysgn || xsgn==rsgn then r else error "add overflow!" where xsgn = x>=0 ysgn = y>=0 rsgn = r>=0 r = x + y numSub x y = if xsgn==ysgn || ysgn/=rsgn then r else error "sub overflow!" where xsgn = x>=0 ysgn = y>=0 rsgn = r>=0 r = x - y numMul x y = if y==0 || (r `div` y == x) then r else error "mult overflow!" where r = x * y numNeg x = if x>=0 || r>=0 then r else error "negate overflow!" where r = negate x instance Eq Number where (==) = numEq instance Ord Number where compare = numCmp instance Show Number where showsPrec = numShowsPrec instance Enum Number where toEnum = numFromInt fromEnum = numToInt enumFrom = numEnumFrom enumFromThen = numEnumFromThen instance Num Number where (+) = numAdd (-) = numSub (*) = numMul negate = numNeg fromInt = numFromInt fromInteger = numFromInteger abs x = if x<0 then negate x else x signum = numSignum instance Bounded Number where minBound = numMin maxBound = numMax instance Real Number where toRational = numToRat instance Ix Number where range = numRange index = numIndex inRange = numInRange instance Integral Number where quotRem = numQrm toInteger = numToInteger ----------------------------------------------------------------------------- hugs98-plus-Sep2006/lib/hugs/ParseLib.hs0000644006511100651110000001470206727055600016547 0ustar rossross{----------------------------------------------------------------------------- A LIBRARY OF MONADIC PARSER COMBINATORS 29th July 1996 Revised, October 1996 Revised again, November 1998 Graham Hutton Erik Meijer University of Nottingham University of Utrecht This Haskell 98 script defines a library of parser combinators, and is taken from sections 1-6 of our article "Monadic Parser Combinators". Some changes to the library have been made in the move from Gofer to Haskell: * Do notation is used in place of monad comprehension notation; * The parser datatype is defined using "newtype", to avoid the overhead of tagging and untagging parsers with the P constructor. -----------------------------------------------------------------------------} module ParseLib (Parser, item, papply, (+++), sat, many, many1, sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper, letter, alphanum, string, ident, nat, int, spaces, comment, junk, parse, token, natural, integer, symbol, identifier, module Monad) where import Char import Monad infixr 5 +++ --- The parser monad --------------------------------------------------------- newtype Parser a = P (String -> [(a,String)]) instance Functor Parser where -- map :: (a -> b) -> (Parser a -> Parser b) fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp]) instance Monad Parser where -- return :: a -> Parser a return v = P (\inp -> [(v,inp)]) -- >>= :: Parser a -> (a -> Parser b) -> Parser b (P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp]) instance MonadPlus Parser where -- mzero :: Parser a mzero = P (\inp -> []) -- mplus :: Parser a -> Parser a -> Parser a (P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp)) --- Other primitive parser combinators --------------------------------------- item :: Parser Char item = P (\inp -> case inp of [] -> [] (x:xs) -> [(x,xs)]) force :: Parser a -> Parser a force (P p) = P (\inp -> let x = p inp in (fst (head x), snd (head x)) : tail x) first :: Parser a -> Parser a first (P p) = P (\inp -> case p inp of [] -> [] (x:xs) -> [x]) papply :: Parser a -> String -> [(a,String)] papply (P p) inp = p inp --- Derived combinators ------------------------------------------------------ (+++) :: Parser a -> Parser a -> Parser a p +++ q = first (p `mplus` q) sat :: (Char -> Bool) -> Parser Char sat p = do {x <- item; if p x then return x else mzero} many :: Parser a -> Parser [a] many p = force (many1 p +++ return []) many1 :: Parser a -> Parser [a] many1 p = do {x <- p; xs <- many p; return (x:xs)} sepby :: Parser a -> Parser b -> Parser [a] p `sepby` sep = (p `sepby1` sep) +++ return [] sepby1 :: Parser a -> Parser b -> Parser [a] p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)} chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a chainl p op v = (p `chainl1` op) +++ return v chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a p `chainl1` op = do {x <- p; rest x} where rest x = do {f <- op; y <- p; rest (f x y)} +++ return x chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a chainr p op v = (p `chainr1` op) +++ return v chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a p `chainr1` op = do {x <- p; rest x} where rest x = do {f <- op; y <- p `chainr1` op; return (f x y)} +++ return x ops :: [(Parser a, b)] -> Parser b ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs] bracket :: Parser a -> Parser b -> Parser c -> Parser b bracket open p close = do {open; x <- p; close; return x} --- Useful parsers ----------------------------------------------------------- char :: Char -> Parser Char char x = sat (\y -> x == y) digit :: Parser Char digit = sat isDigit lower :: Parser Char lower = sat isLower upper :: Parser Char upper = sat isUpper letter :: Parser Char letter = sat isAlpha alphanum :: Parser Char alphanum = sat isAlphaNum string :: String -> Parser String string "" = return "" string (x:xs) = do {char x; string xs; return (x:xs)} ident :: Parser String ident = do {x <- lower; xs <- many alphanum; return (x:xs)} nat :: Parser Int nat = do {x <- digit; return (digitToInt x)} `chainl1` return op where m `op` n = 10*m + n int :: Parser Int int = do {char '-'; n <- nat; return (-n)} +++ nat --- Lexical combinators ------------------------------------------------------ spaces :: Parser () spaces = do {many1 (sat isSpace); return ()} comment :: Parser () comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()} junk :: Parser () junk = do {many (spaces +++ comment); return ()} parse :: Parser a -> Parser a parse p = do {junk; p} token :: Parser a -> Parser a token p = do {v <- p; junk; return v} --- Token parsers ------------------------------------------------------------ natural :: Parser Int natural = token nat integer :: Parser Int integer = token int symbol :: String -> Parser String symbol xs = token (string xs) identifier :: [String] -> Parser String identifier ks = token (do {x <- ident; if not (elem x ks) then return x else mzero}) ------------------------------------------------------------------------------ hugs98-plus-Sep2006/lib/hugs/StdLibs.hs0000644006511100651110000000116606727055601016413 0ustar rossross----------------------------------------------------------------------------- -- Dummy module to import all of the standard libraries; programmers should -- normally be more selective than this when it comes to specifying the -- modules that a particular program depends on. -- -- Suitable for use with Hugs 98 ----------------------------------------------------------------------------- module StdLibs where import Array import Char import Complex import IO import Ix import List import Maybe import Monad import Ratio import System import Random ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/0000755006511100651110000000000010504340734014737 5ustar rossrosshugs98-plus-Sep2006/libraries/hugsbase/0000755006511100651110000000000010504340131016527 5ustar rossrosshugs98-plus-Sep2006/libraries/hugsbase/Hugs/0000755006511100651110000000000010504340132017436 5ustar rossrosshugs98-plus-Sep2006/libraries/hugsbase/Hugs/Array.hs0000644006511100651110000000727710227457076021107 0ustar rossross----------------------------------------------------------------------------- -- Standard Library: Array operations -- -- Suitable for use with Hugs 98 ----------------------------------------------------------------------------- module Hugs.Array ( module Data.Ix, -- export all of Ix unsafeIndex, Array, array, listArray, (!), bounds, indices, elems, assocs, accumArray, (//), accum, ixmap, unsafeArray, unsafeAt, unsafeReplace, unsafeAccum, unsafeAccumArray ) where import Data.Ix import Hugs.Prelude( unsafeIndex ) infixl 9 !, // data Array a b -- Arrays are implemented as a primitive type array :: Ix a => (a,a) -> [(a,b)] -> Array a b listArray :: Ix a => (a,a) -> [b] -> Array a b (!) :: Ix a => Array a b -> a -> b bounds :: Ix a => Array a b -> (a,a) indices :: Ix a => Array a b -> [a] elems :: Ix a => Array a b -> [b] assocs :: Ix a => Array a b -> [(a,b)] (//) :: Ix a => Array a b -> [(a,b)] -> Array a b accum :: Ix a => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b accumArray :: Ix a => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c primitive primArray :: (a,a) -> Int -> [(Int,b)] -> Array a b primitive primUpdate :: [(Int,b)] -> Array a b -> Array a b primitive primAccum :: [(Int,c)] -> Array a b -> (b -> c -> b) -> Array a b primitive primAccumArray :: (a,a) -> Int -> (b -> c -> b) -> b -> [(Int,c)] -> Array a b primitive primSubscript :: Array a b -> Int -> b primitive primBounds :: Array a b -> (a,a) primitive primElems :: Array a b -> [b] primitive primAmap :: (b -> c) -> Array a b -> Array a c unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e unsafeArray bnds = primArray bnds (rangeSize bnds) unsafeAt :: Ix i => Array i e -> Int -> e unsafeAt = primSubscript unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e unsafeReplace iarr ies = primUpdate ies iarr unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e unsafeAccum f iarr ies = primAccum ies iarr f unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e unsafeAccumArray f z bnds = primAccumArray bnds (rangeSize bnds) f z indexAll :: Ix i => (i,i) -> [(i, a)] -> [(Int, a)] indexAll bnds ivs = [(index bnds i,v) | (i,v) <- ivs] array bnds = unsafeArray bnds . indexAll bnds listArray bnds vs = unsafeArray bnds (zip [0..rangeSize bnds-1] vs) arr!i = unsafeAt arr (index (bounds arr) i) bounds = primBounds indices = range . bounds elems = primElems assocs a = zip (indices a) (elems a) accumArray f z bnds = unsafeAccumArray f z bnds . indexAll bnds a // ivs = unsafeReplace a (indexAll (bounds a) ivs) accum f a ivs = unsafeAccum f a (indexAll (bounds a) ivs) ixmap bnds f arr = unsafeArray bnds [(unsafeIndex bnds i, arr ! f i) | i <- range bnds] instance (Ix a) => Functor (Array a) where fmap = primAmap instance (Ix a, Eq b) => Eq (Array a b) where a == a' = assocs a == assocs a' instance (Ix a, Ord b) => Ord (Array a b) where a <= a' = assocs a <= assocs a' instance (Ix a, Show a, Show b) => Show (Array a b) where showsPrec p a = showParen (p > 9) ( showString "array " . shows (bounds a) . showChar ' ' . shows (assocs a) ) instance (Ix a, Read a, Read b) => Read (Array a b) where readsPrec p = readParen (p > 9) (\r -> [(array b as, u) | ("array",s) <- lex r, (b,t) <- reads s, (as,u) <- reads t ]) ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Base.hs0000644006511100651110000000011710204665424020656 0ustar rossross-- Empty module to serve as the default current module. module Hugs.Base where hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Bits.hs0000644006511100651110000000054210204665424020707 0ustar rossrossmodule Hugs.Bits where primitive primAndInt :: Int -> Int -> Int primitive primOrInt :: Int -> Int -> Int primitive primXorInt :: Int -> Int -> Int primitive primComplementInt :: Int -> Int primitive primShiftInt :: Int -> Int -> Int primitive primBitInt :: Int -> Int primitive primTestInt :: Int -> Int -> Bool hugs98-plus-Sep2006/libraries/hugsbase/Hugs/ByteArray.hs0000644006511100651110000000612110204665424021707 0ustar rossross-- Mutable and immutable byte arrays (identical internally), usable for -- unboxed arrays, and built from FFI primitives. module Hugs.ByteArray ( MutableByteArray, newMutableByteArray, readMutableByteArray, writeMutableByteArray, ByteArray, unsafeFreezeMutableByteArray, thawByteArray, readByteArray ) where import Data.Word ( Word8 ) import Foreign.ForeignPtr ( ForeignPtr, mallocForeignPtrBytes, withForeignPtr ) import Foreign.Marshal.Utils ( copyBytes ) import Foreign.Ptr ( castPtr ) import Foreign.Storable ( Storable( peekElemOff, pokeElemOff )) import Hugs.IOExts ( unsafeCoerce ) import Hugs.ST ( ST, unsafeRunST ) -- This implementation is based on the principle that the FFI primitives -- used, though declared as IO actions, actually only manipulate local -- state, and thus could have been declared in the strict ST monad: -- -- mallocForeignPtrBytes :: Int -> ST s (STForeignPtr s a) -- withForeignPtr :: STForeignPtr s a -> (STPtr s a -> ST s b) -> ST s b -- copyBytes :: STPtr s a -> STPtr s a -> Int -> ST s () -- castPtr :: STPtr s a -> STPtr s b -- peekElemOff :: Storable a => STPtr s a -> Int -> ST s a -- pokeElemOff :: Storable a => STPtr s a -> Int -> a -> ST s () -- -- (where STPtr s and STForeignPtr s are just like Ptr and ForeignPtr, -- but confined to the region s) -- -- Since the strict ST monad has the same representation as the IO monad, -- we are justified in coercing such actions to the ST monad. -- This conversion may be safely applied to computations that manipulate -- only local state, but will give a runtime error if the IO action does -- any concurrency. specialIOToST :: IO a -> ST s a specialIOToST = unsafeCoerce type BytePtr = ForeignPtr Word8 data MutableByteArray s = MutableByteArray !Int !BytePtr newMutableByteArray :: Int -> ST s (MutableByteArray s) newMutableByteArray size = do fp <- specialIOToST (mallocForeignPtrBytes size) return (MutableByteArray size fp) readMutableByteArray :: Storable e => MutableByteArray s -> Int -> ST s e readMutableByteArray (MutableByteArray _ fp) i = specialIOToST $ withForeignPtr fp $ \a -> peekElemOff (castPtr a) i writeMutableByteArray :: Storable e => MutableByteArray s -> Int -> e -> ST s () writeMutableByteArray (MutableByteArray _ fp) i e = specialIOToST $ withForeignPtr fp $ \a -> pokeElemOff (castPtr a) i e data ByteArray = ByteArray !Int !BytePtr -- Don't change the MutableByteArray after calling this. unsafeFreezeMutableByteArray :: MutableByteArray s -> ST s ByteArray unsafeFreezeMutableByteArray (MutableByteArray size fp) = return (ByteArray size fp) thawByteArray :: ByteArray -> ST s (MutableByteArray s) thawByteArray (ByteArray size fp) = specialIOToST $ do fp' <- mallocForeignPtrBytes size withForeignPtr fp $ \p -> withForeignPtr fp' $ \p' -> copyBytes p' p size return (MutableByteArray size fp') -- This one is safe because ByteArrays are immutable -- (cf. unsafeFreezeMutableByteArray) readByteArray :: Storable a => ByteArray -> Int -> a readByteArray (ByteArray _ fp) i = unsafeRunST $ specialIOToST $ withForeignPtr fp $ \p -> peekElemOff (castPtr p) i hugs98-plus-Sep2006/libraries/hugsbase/Hugs/CVHAssert.hs0000644006511100651110000000642010204665424021611 0ustar rossross---------------------------------------------------------------- -- This is a simple implementation of Cordy Hall's assertions -- (for performance debugging). -- -- NB These primitives are an _experimental_ feature which may be -- removed in future versions of Hugs. -- They can only be used if hugs was configured with the -- "--enable-internal-prims" flag. -- -- These primitives mostly break referential transparency - but you're -- only supposed to use them for debugging purposes. ---------------------------------------------------------------- module Hugs.CVHAssert( Test, Action, assert, isEvaluated, pointerEqual ) where import Hugs.Internals( ptrEq, Name, nameInfo, Cell, getCell, cellPtrEq, CellKind(..), classifyCell, ) import Hugs.IOExts( unsafePerformIO ) ---------------------------------------------------------------- -- High level operations ---------------------------------------------------------------- type Test a = a -> Bool type Action a = a -> IO () assert :: Test a -> Action a -> a -> a assert test action x = unsafePerformIO (if test x then return () else action x) `seq` x isEvaluated :: a -> Bool isEvaluated x = unsafePerformIO ( isEvaluatedCell (getCell x) ) representationSize :: a -> Int representationSize x = unsafePerformIO (do cells <- cellsOf (getCell x) [] return (cellSize * length cells) ) pointerEqual :: a -> a -> Bool pointerEqual = ptrEq ---------------------------------------------------------------- -- Utilities ---------------------------------------------------------------- isEvaluatedCell :: Cell -> IO Bool isEvaluatedCell cell = do kind <- classifyCell False cell case kind of Apply fun args -> do funkind <- classifyCell False fun case funkind of Fun nm -> return (nameArity nm > length args) _ -> return True _ -> return True arityOf :: Cell -> IO Int arityOf cell = do kind <- classifyCell False cell case kind of Apply fun args -> do funarity <- arityOf fun return (funarity - length args) Fun nm -> return (nameArity nm) Con nm -> return (nameArity nm) Tuple i -> return i _ -> return 0 nameArity :: Name -> Int nameArity nm = case nameInfo nm of (arity,_,_) -> arity -- list cells occurring in Cell cellsOf :: Cell -> [Cell] -> IO [Cell] cellsOf cell seen | cell `elemCell` seen = return seen | otherwise = do let seen' = cell:seen kind <- classifyCell False cell case kind of Apply f xs -> do seen'' <- cellsOf f seen' cellsOf' xs seen'' Fun _ -> return seen' Con _ -> return seen' Tuple _ -> return seen' Int _ -> return seen' Integer _ -> return seen' Float _ -> return seen' Char _ -> return seen' Prim _ -> return seen' Error _ -> return seen' -- we could argue about this one cellsOf' :: [Cell] -> [Cell] -> IO [Cell] cellsOf' [] seen = return seen cellsOf' (x:xs) seen = do seen' <- cellsOf x seen cellsOf' xs seen' elemCell :: Cell -> [Cell] -> Bool x `elemCell` [] = False x `elemCell` (y:ys) = x `cellPtrEq` y || x `elemCell` ys cellSize :: Int cellSize = 8 ---------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Char.hs0000644006511100651110000000275110215350753020665 0ustar rossrossmodule Hugs.Char ( isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum, intToDigit, toUpper, toLower, toTitle, ord, chr, readLitChar, showLitChar, lexLitChar, primUniGenCat ) where import Hugs.Prelude( isSpace, isUpper, isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum, readLitChar, showLitChar, lexLitChar) -- The Hugs Char type covers only the ISO 8859-1 (Latin-1) subset of Unicode, -- i.e. '\0' to '\xff'. -- Character-testing operations (some others are in Hugs.Prelude) isAscii, isLatin1, isControl :: Char -> Bool isAscii c = c < '\x80' isLatin1 c = c <= '\xff' isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f' primitive isPrint :: Char -> Bool -- Digit conversion operations intToDigit :: Int -> Char intToDigit i | i >= 0 && i <= 9 = toEnum (fromEnum '0' + i) | i >= 10 && i <= 15 = toEnum (fromEnum 'a' + i - 10) | otherwise = error "Char.intToDigit: not a digit" -- Case-changing operations primitive toUpper :: Char -> Char primitive toLower :: Char -> Char primitive toTitle :: Char -> Char -- Character code functions ord :: Char -> Int ord = fromEnum chr :: Int -> Char chr = toEnum -- Unicode character classification primitive primUniGenCat :: Char -> Int hugs98-plus-Sep2006/libraries/hugsbase/Hugs/ConcBase.hs0000644006511100651110000001260310204665424021464 0ustar rossross----------------------------------------------------------------------------- -- This implements Concurrent Haskell's "MVar"s as described in the paper -- -- "Concurrent Haskell" -- Simon Peyton Jones, Andrew Gordon and Sigbjorn Finne. -- In Proceedings of the ACM Symposium on Principles of Programming -- Languages,St Petersburg Beach, Florida, January 1996. -- http://www.dcs.gla.ac.uk/fp/authors/Simon_Peyton_Jones/ -- concurrent-haskell.ps -- -- except that we have made the following name changes for compatability -- with GHC 2.05. -- -- newMVar -> newEmptyMVar -- -- There is one significant difference between this implementation and -- GHC 2.05: -- -- o GHC uses preemptive multitasking. -- -- Context switches can occur at any time (except if you call a C -- function (like "getchar") which blocks the entire process while -- waiting for input. -- -- o Hugs uses cooperative multitasking. -- -- Context switches only occur when you use one of the primitives -- defined in this module. This means that programs such as: -- -- main = forkIO (write 'a') >> write 'b' -- where -- write c = putChar c >> write c -- -- will print either "aaaaaaaaaaaaaa..." or "bbbbbbbbbbbb..." -- instead of some random interleaving of 'a's and 'b's. -- -- Cooperative multitasking is sufficient for writing coroutines and simple -- graphical user interfaces but the usual assumptions of fairness don't -- apply and Channel.getChanContents cannot be implemented. ----------------------------------------------------------------------------- module Hugs.ConcBase( forkIO, MVar, newEmptyMVar, newMVar, takeMVar, tryTakeMVar, putMVar, tryPutMVar, isEmptyMVar, yield ) where import Hugs.Prelude( IO(..), IOResult(..), threadToIOResult, Exception(..), catchException, blockIO) import Hugs.IORef ---------------------------------------------------------------- -- The interface ---------------------------------------------------------------- forkIO :: IO () -> IO () -- Spawn a thread yield :: IO () newEmptyMVar :: IO (MVar a) newMVar :: a -> IO (MVar a) takeMVar :: MVar a -> IO a putMVar :: MVar a -> a -> IO () tryPutMVar :: MVar a -> a -> IO Bool tryTakeMVar :: MVar a -> IO (Maybe a) isEmptyMVar :: MVar a -> IO Bool ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- kill :: IO a kill = IO (\ s -> Hugs_DeadThread) yield = IO (\ s -> Hugs_YieldThread (s ())) -- add the continuation to the runnable list, and continue continueIO :: IOResult -> IO () continueIO cc = IO (\ s -> Hugs_ForkThread (s ()) cc) -- The thread is scheduled immediately and runs with its own success/error -- continuations. forkIO m = continueIO (threadToIOResult (m `catchException` forkExnHandler)) forkExnHandler :: Exception -> IO a forkExnHandler e = do putStr "\nThread raised exception: " putStr (show e) putStr "\n" kill newtype MVar a = MkMVar (IORef (MVarState a)) deriving Eq data MVarState a = Full a [(a,()->IOResult)] -- a value and a list of value-thread pairs blocked waiting -- to write to the MVar. -- The ()-> part of the thread is because blocked threads have -- to be functions. :-( | Empty [a -> IOResult] -- no value, just a list of threads waiting to receive a value newEmptyMVar = fmap MkMVar (newIORef (Empty [])) newMVar x = fmap MkMVar (newIORef (Full x [])) takeMVar (MkMVar v) = do state <- readIORef v case state of Full a [] -> do writeIORef v (Empty []) return a Full a ((a',t):ts) -> do writeIORef v (Full a' ts) continueIO (t ()) -- reschedule t return a Empty cs -> blockIO (\cc -> writeIORef v (Empty (cs ++ [cc]))) -- tryTakeMVar is a non-blocking takeMVar tryTakeMVar (MkMVar v) = do state <- readIORef v case state of Full a [] -> do writeIORef v (Empty []) return (Just a) Full a ((a',t):ts) -> do writeIORef v (Full a' ts) continueIO (t ()) -- reschedule t return (Just a) Empty cs -> return Nothing putMVar (MkMVar v) a = do state <- readIORef v case state of Full a' ts -> blockIO (\cc -> writeIORef v (Full a' (ts++[(a,cc)]))) Empty [] -> writeIORef v (Full a []) Empty (c:cs) -> do writeIORef v (Empty cs) continueIO (c a) -- reschedule the blocked thread tryPutMVar (MkMVar v) a = do state <- readIORef v case state of Full _ _ -> return False Empty [] -> do writeIORef v (Full a []) return True Empty (c:cs) -> do writeIORef v (Empty cs) continueIO (c a) -- reschedule the blocked thread return True {- Low-level op. for checking whether an MVar is filled-in or not. Notice that the boolean value returned is just a snapshot of the state of the MVar. By the time you get to react on its result, the MVar may have been filled (or emptied) - so be extremely careful when using this operation. Use tryTakeMVar instead if possible. If you can re-work your abstractions to avoid having to depend on isEmptyMVar, then you're encouraged to do so, i.e., consider yourself warned about the imprecision in general of isEmptyMVar :-) -} isEmptyMVar (MkMVar v) = do state <- readIORef v case state of Full _ _ -> return False Empty _ -> return True ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Directory.hs0000644006511100651110000000554610204665424021763 0ustar rossross-- -- Hugs98 implementation of the Haskell 98 module, Directory. -- module Hugs.Directory ( Permissions ( readable -- :: Permissions -> Bool , writable -- :: Permissions -> Bool , executable -- :: Permissions -> Bool , searchable -- :: Permissions -> Bool ) -- instances: Eq, Ord, Read, Show , createDirectory -- :: FilePath -> IO () , removeDirectory -- :: FilePath -> IO () , removeFile -- :: FilePath -> IO () , renameDirectory -- :: FilePath -> FilePath -> IO () , renameFile -- :: FilePath -> FilePath -> IO () , getDirectoryContents -- :: FilePath -> IO [FilePath] , getCurrentDirectory -- :: IO FilePath , setCurrentDirectory -- :: FilePath -> IO () , doesFileExist -- :: FilePath -> IO Bool , doesDirectoryExist -- :: FilePath -> IO Bool , getPermissions -- :: FilePath -> IO Permissions , setPermissions -- :: FilePath -> Permissions -> IO () , getModificationTime -- :: FilePath -> IO ClockTime ) where import System.Time ( ClockTime(..) ) data Permissions = Permissions { readable :: Bool , writable :: Bool , executable :: Bool , searchable :: Bool } deriving (Eq, Ord, Read, Show) {- This module is really just a wrapper for various directory and file-related system calls. -} primitive createDirectory :: FilePath -> IO () primitive removeFile :: FilePath -> IO () primitive removeDirectory :: FilePath -> IO () primitive renameFile :: FilePath -> FilePath -> IO () primitive renameDirectory :: FilePath -> FilePath -> IO () primitive setCurrentDirectory :: FilePath -> IO () primitive getCurrentDirectory :: IO FilePath primitive doesDirectoryExist :: FilePath -> IO Bool primitive doesFileExist :: FilePath -> IO Bool getPermissions :: FilePath -> IO Permissions getPermissions fpath = do (r,w,e,s) <- getPerms fpath return (Permissions{readable=r,writable=w,executable=e,searchable=s}) setPermissions :: FilePath -> Permissions -> IO () setPermissions fpath perms = setPerms fpath (readable perms) (writable perms) (executable perms) (searchable perms) primitive getPerms :: FilePath -> IO (Bool,Bool,Bool,Bool) primitive setPerms :: FilePath -> Bool -> Bool -> Bool -> Bool -> IO () getDirectoryContents :: FilePath -> IO [FilePath] getDirectoryContents fpath = do ls <- getDirContents fpath -- it is easiest for the primitive to create the -- list of entries in the order in which they're -- read, so the resulting list will be back to front. -- Hence, list reversal is needed. return (reverse ls) primitive getDirContents :: FilePath -> IO [FilePath] getModificationTime :: FilePath -> IO ClockTime getModificationTime fPath = do x <- getModTime fPath return (TOD (fromIntegral x) 0) primitive getModTime :: FilePath -> IO Int hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Dynamic.hs0000644006511100651110000000047310204665424021375 0ustar rossrossmodule Hugs.Dynamic(module Data.Dynamic, coerceDynamic, runDyn) where import Data.Dynamic coerceDynamic :: Typeable a => Dynamic -> a coerceDynamic d = fromDyn d def where def = error ("coerceDynamic: expecting " ++ show (toDyn def) ++ " found " ++ show d) runDyn :: Dynamic -> IO () runDyn = coerceDynamic hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Exception.hs0000644006511100651110000000444610204665425021754 0ustar rossross-- This is a cut-down version of GHC's Exception module -- -- The main difference is that Hugs does not throw asynchronous -- exceptions, in particular heap and stack overflow and ctrl-C. -- Indeed, it is not entirely clear what to do in response to ctrl-C. module Hugs.Exception( Exception(..), IOException(..), ArithException(..), ArrayException(..), AsyncException(..), catchException, -- :: IO a -> (Exception -> IO a) -> IO a -- Throwing exceptions throwIO, -- :: Exception -> IO a throw, -- :: Exception -> a evaluate, -- :: a -> IO a -- Async exception control block, -- :: IO a -> IO a unblock, -- :: IO a -> IO a ) where import Hugs.Prelude instance Eq Exception where ArithException e1 == ArithException e2 = e1 == e2 ArrayException e1 == ArrayException e2 = e1 == e2 AssertionFailed e1 == AssertionFailed e2 = e1 == e2 AsyncException e1 == AsyncException e2 = e1 == e2 BlockedOnDeadMVar == BlockedOnDeadMVar = True Deadlock == Deadlock = True DynException _ == DynException _ = False -- incomparable ErrorCall e1 == ErrorCall e2 = e1 == e2 ExitException e1 == ExitException e2 = e1 == e2 IOException e1 == IOException e2 = e1 == e2 NoMethodError e1 == NoMethodError e2 = e1 == e2 NonTermination == NonTermination = True PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2 RecConError e1 == RecConError e2 = e1 == e2 RecSelError e1 == RecSelError e2 = e1 == e2 RecUpdError e1 == RecUpdError e2 = e1 == e2 _ == _ = False ---------------------------------------------------------------- -- Primitive throw and catch ---------------------------------------------------------------- throwIO :: Exception -> IO a throwIO exn = IO (\ s -> throw exn) evaluate :: a -> IO a evaluate x = IO (\ s -> x `seq` s x) ---------------------------------------------------------------- -- dummy implementations of block and unblock ---------------------------------------------------------------- block, unblock :: IO a -> IO a block m = m unblock m = m ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/ForeignPtr.hs0000644006511100651110000000230410204665425022064 0ustar rossrossmodule Hugs.ForeignPtr ( ForeignPtr -- abstract, instance of: Eq , FinalizerPtr , FinalizerEnvPtr , newForeignPtr_ -- :: Ptr a -> IO (ForeignPtr a) , addForeignPtrFinalizer -- :: FinalizerPtr a -> ForeignPtr a -> IO () , addForeignPtrFinalizerEnv -- :: FinalizerEnvPtr env a -> Ptr env -> -- ForeignPtr a -> IO () , unsafeForeignPtrToPtr -- :: ForeignPtr a -> Ptr a , touchForeignPtr -- :: ForeignPtr a -> IO () , castForeignPtr -- :: ForeignPtr a -> ForeignPtr b ) where import Hugs.Prelude ( ForeignPtr ) import Foreign.Ptr ( Ptr, FunPtr ) -- data ForeignPtr a -- defined in Prelude.hs type FinalizerPtr a = FunPtr ( Ptr a -> IO ()) type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> IO ()) primitive newForeignPtr_ :: Ptr a -> IO (ForeignPtr a) primitive addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO () primitive addForeignPtrFinalizerEnv :: FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO () primitive touchForeignPtr :: ForeignPtr a -> IO () primitive unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a primitive castForeignPtr "primUnsafeCoerce" :: ForeignPtr a -> ForeignPtr b hugs98-plus-Sep2006/libraries/hugsbase/Hugs/GenericPrint.hs0000644006511100651110000002264010204665425022403 0ustar rossross---------------------------------------------------------------- -- A "generic" (or "polymorphic") print function in Haskell -- This is very heavily based on the code in printer.c -- (Together with the decompiler and error catching primitives, -- this might make a good base on which to build a debugger?) -- -- NB This library is an _experimental_ feature which may be -- removed in future versions of Hugs. -- It can only be used if Hugs was configured with the -- "--enable-internal--prims" flag. ---------------------------------------------------------------- module Hugs.GenericPrint( printError, outputString, print ) where import Prelude hiding (print) import Hugs.Internals( Name, nameInfo, nameString, Cell, getCell, CellKind(..), classifyCell, ) import Hugs.IOExts( unsafePerformIO ) import Hugs.Array import Data.Char( showLitChar, isAlpha ) import Data.List( intersperse ) ---------------------------------------------------------------- -- The top-level print routine ---------------------------------------------------------------- printError :: Cell -> IO () outputString :: String -> IO () print :: a -> IO () printError err = do putStr "\nProgram error: " printDBadRedex err putStr "\n" outputString s = outputStr (getCell s) print x = print' True (getCell x) ---------------------------------------------------------------- printBadRedex err = do putChar '{' print' False err putChar '}' printDBadRedex err = do kind <- classifyCell False err case kind of Apply fun args -> do funkind <- classifyCell False fun case (funkind, args) of (Fun nm, [msg]) | nm == nameError -> outputStr msg _ -> printBadRedex err _ -> printBadRedex err outputStr :: Cell -> IO () outputStr xs = do kind <- hugsClassifyCell True xs case kind of Apply fun args -> hugsClassifyCell True fun >>= \ funkind -> case (funkind, args) of (Con nm, [y,ys]) | nm == nameCons -> hugsClassifyCell True y >>= \ ykind -> case ykind of Char c -> putChar c >> outputStr ys Error err -> printBadRedex err >> outputStr ys _ -> printBadRedex y >> outputStr ys (Error err, _) -> printBadRedex err _ -> printBadRedex xs Con nm | nm == nameNil -> return () Error err -> printBadRedex err _ -> printBadRedex xs print' :: Bool -> Cell -> IO () print' strict x = printCell strict min_prec x --ToDo: combine with sprint (if possible) lprint :: Bool -> Cell -> Cell -> IO () lprint strict x xs = printCell strict min_prec x >> hugsClassifyCell strict xs >>= \ kind -> case kind of Apply fun args -> hugsClassifyCell strict fun >>= \ funkind -> case (funkind, args) of (Con nm, [y,ys]) | nm == nameCons -> putStr ", " >> lprint strict y ys (Error err, _) -> printBadRedex err _ -> putStr "] ++ " >> printBadRedex xs Con nm | nm == nameNil -> putChar ']' Error err -> printBadRedex err _ -> putStr "] ++ " >> printBadRedex xs sprint :: Bool -> Char -> Cell -> IO () sprint strict c xs = putStr (showLitChar c "") >> hugsClassifyCell strict xs >>= \ kind -> case kind of Apply fun args -> hugsClassifyCell strict fun >>= \ funkind -> case (funkind, args) of (Con nm, [y,ys]) | nm == nameCons -> hugsClassifyCell strict y >>= \ ykind -> case ykind of Char c -> sprint strict c ys _ -> lprint False y ys _ -> putStr "\" ++ " >> printBadRedex xs Con nm | nm == nameNil -> putChar '"' _ -> putStr "\" ++ " >> printBadRedex xs printCell :: Bool -> Int -> Cell -> IO () printCell strict d x = hugsClassifyCell strict x >>= \ kind -> case kind of Apply fun args -> hugsClassifyCell strict fun >>= \ funkind -> case funkind of Con nm -> case args of [x,xs] | nm == nameCons -> hugsClassifyCell strict x >>= \ xkind -> case xkind of Char c -> putChar '"' >> sprint strict c xs _ -> putChar '[' >> lprint strict x xs [x] | assoc /= 'A' -> printParen True ( printCell strict (fun_prec-1) x >> putChar ' ' >> putStr (asOp nameStr) ) (x1:x2:xs) | assoc /= 'A' -> printParen (not (null xs) && d >= fun_prec) ( printParen (d <= p) (do printCell strict lp x1 putChar ' ' putStr (asOp nameStr) putChar ' ' printCell strict rp x2 ) >> mapM_ (\ arg -> putChar ' ' >> printCell strict p arg ) xs ) xs -> printParen (not (null xs) && d >= fun_prec) ( -- test that xs is nonNull should be redundant but -- no harm being robust putStr (asVar nameStr) >> mapM_ (\arg -> putChar ' ' >> printCell strict fun_prec arg ) xs ) where (arity, p, assoc) = nameInfo nm nameStr = nameString nm -- from Appendix E2 of Haskell 1.2 report lp = if assoc == 'L' then p else p+1 rp = if assoc == 'R' then p else p+1 Fun nm -> printParen (d >= fun_prec) ( putStr (asVar nameStr) >> mapM_ (\arg -> putChar ' ' >> -- switch to lazy printing! printCell False fun_prec arg ) args ) where nameStr = nameString nm Tuple arity -> printParen (not (null extra) && d >= fun_prec) ( printParen True ( for__ fields (\ field -> printCell strict min_prec field ) (putChar ',') >> -- Haskell's syntax makes it impossible to construct an -- incomplete tuple - but let's play safe! mapM_ (\_ -> putChar ',' ) [numArgs+1..arity] ) >> -- Haskell's type system makes extra arguments impossible -- - but let's play safe! mapM_ (\ arg -> putChar ' ' >> printCell strict fun_prec arg ) extra ) where (fields, extra) = splitAt arity args Error err -> printBadRedex err _ -> printParen (not (null args) && d >= fun_prec) ( printCell strict fun_prec fun >> mapM_ (\arg -> putChar ' ' >> printCell strict fun_prec arg ) args ) where numArgs = length args Fun nm -> putStr (asVar (nameString nm)) Con nm -> putStr (asVar (nameString nm)) Tuple arity -> putStr ('(' : replicate arity ',' ++ ")") Int x -> putStr (show x) Integer x -> putStr (show x) Float x -> putStr (show x) Char x -> putStr ('\'' : showLitChar x "\'") Prim prim -> putStr prim Error err -> printBadRedex err ---------------------------------------------------------------- -- Cell/Name utilities ---------------------------------------------------------------- nameCons = cellName (:) nameNil = cellName [] nameError = cellName error -- Here's something VERY subtle. -- We use classifyCell instead of hugsClassifyCell because -- otherwise, this gets put in the same dependency class as everything -- else and the lack of polymorphic recursion bites us. -- (Using classifyCell is equally good here because it wont fail.) cellName :: a -> Name cellName x = unsafePerformIO ( classifyCell True (getCell x) >>= \ kind -> case kind of Fun nm -> return nm Con nm -> return nm ) -- This implements the error-handling policy: hugsClassifyCell :: Bool -> Cell -> IO CellKind hugsClassifyCell strict obj = classifyCell strict obj >>= \ kind -> case kind of Error err -> if failOnError then exitWith (printError err) else return kind _ -> return kind ---------------------------------------------------------------- -- Utilities ---------------------------------------------------------------- for__ :: Monad m => [a] -> (a -> m ()) -> m () -> m () for__ xs f inc = sequence_ $ intersperse inc $ map f xs min_prec, max_prec, fun_prec :: Int min_prec = 0 max_prec = 9 fun_prec = max_prec+2 asOp str | isOp str = str | otherwise = '`' : str ++ "`" asVar str | isOp str = '(' : str ++ ")" | otherwise = str isOp (c:_) = not (isAlpha c || c == '[') isOp _ = False printParen :: Bool -> IO () -> IO () printParen True m = putChar '(' >> m >> putChar ')' printParen False m = m ---------------------------------------------------------------- -- Missing primitives ---------------------------------------------------------------- -- In Hugs0, this accessed the value of the :set -f" flag failOnError :: Bool failOnError = True -- In Hugs0, this executed the action and terminated the current evaluation exitWith :: IO () -> IO a exitWith m = m >> error "{exitWith}" ---------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/IO.hs0000644006511100651110000001160210426071620020307 0ustar rossross----------------------------------------------------------------------------- -- Standard Library: IO operations, beyond those included in the prelude -- -- Suitable for use with Hugs 98 ----------------------------------------------------------------------------- module Hugs.IO ( Handle, -- instances: Eq, Show. HandlePosn, -- instances: Eq, Show. IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode), BufferMode(NoBuffering,LineBuffering,BlockBuffering), SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd), stdin, stdout, stderr, -- :: Handle openFile, -- :: FilePath -> IOMode -> IO Handle hClose, -- :: Handle -> IO () hFileSize, -- :: Handle -> IO Integer hIsEOF, -- :: Handle -> IO Bool isEOF, -- :: IO Bool hSetBuffering, -- :: Handle -> BufferMode -> IO () hGetBuffering, -- :: Handle -> IO BufferMode hFlush, -- :: Handle -> IO () hGetPosn, -- :: Handle -> IO HandlePosn hSetPosn, -- :: HandlePosn -> IO () hSeek, -- :: Handle -> SeekMode -> Integer -> IO () hTell, -- :: Handle -> IO Integer hLookAhead, -- :: Handle -> IO Char hWaitForInput, -- :: Handle -> Int -> IO Bool hGetChar, -- :: Handle -> IO Char hGetLine, -- :: Handle -> IO String hGetContents, -- :: Handle -> IO String hPutChar, -- :: Handle -> Char -> IO () hPutStr, -- :: Handle -> String -> IO () hIsOpen, -- :: Handle -> IO Bool hIsClosed, -- :: Handle -> IO Bool hIsReadable, -- :: Handle -> IO Bool hIsWritable, -- :: Handle -> IO Bool hIsSeekable, -- :: Handle -> IO Bool -- Non-standard extensions handleToFd, -- :: Handle -> IO Int openFd -- :: Int -> Bool -> IOMode -> Bool -> IO Handle ) where import Hugs.Prelude ( Handle, IOMode(..), stdin, stdout, stderr ) import Hugs.Prelude ( openFile, hClose, hPutChar, hPutStr ) import Hugs.Prelude ( hGetContents, hGetChar, hGetLine ) import Hugs.Prelude ( Ix(..) ) import System.IO.Error -- data Handle data BufferMode = NoBuffering | LineBuffering | BlockBuffering (Maybe Int) deriving (Eq, Ord, Read, Show) data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show) primitive hFileSize :: Handle -> IO Integer primitive hIsEOF :: Handle -> IO Bool isEOF :: IO Bool isEOF = hIsEOF stdin hSetBuffering :: Handle -> BufferMode -> IO () hSetBuffering h bMode = case bMode of NoBuffering -> hSetBuff h 0 0 LineBuffering -> hSetBuff h 1 0 BlockBuffering (Just x) -> hSetBuff h 2 x BlockBuffering _ -> hSetBuff h 2 0 primitive hSetBuff :: Handle -> Int -> Int -> IO () hGetBuffering :: Handle -> IO BufferMode hGetBuffering h = do (k, sz) <- hGetBuff h case k of 1 -> return NoBuffering 2 -> return LineBuffering 3 -> return (BlockBuffering (Just sz)) -- fatal - never to happen. _ -> error "IO.hGetBuffering: unknown buffering mode" primitive hGetBuff :: Handle -> IO (Int,Int) primitive hFlush :: Handle -> IO () data HandlePosn = HandlePosn Handle Int deriving Eq instance Show HandlePosn where showsPrec p (HandlePosn h pos) = showsPrec p h . showString " at position " . shows pos hGetPosn :: Handle -> IO HandlePosn hGetPosn h = do p <- hGetPosnPrim h return (HandlePosn h p) hTell :: Handle -> IO Integer hTell h = do p <- hGetPosnPrim h return (toInteger p) primitive hGetPosnPrim :: Handle -> IO Int hSetPosn :: HandlePosn -> IO () hSetPosn (HandlePosn h p) = hSetPosnPrim h p primitive hSetPosnPrim :: Handle -> Int -> IO () hSeek :: Handle -> SeekMode -> Integer -> IO () hSeek h sMode int | int > fromIntegral (maxBound :: Int) || int < fromIntegral (minBound :: Int) = ioError (userError ("IO.hSeek: seek offset out of supported range")) | otherwise = hSeekPrim h (fromEnum sMode) ((fromIntegral int)::Int) primitive hSeekPrim :: Handle -> Int -> Int -> IO () primitive hWaitForInput :: Handle -> Int -> IO Bool primitive hLookAhead :: Handle -> IO Char primitive hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable :: Handle -> IO Bool ----------------------------------------------------------------------------- -- Extract the file descriptor from a Handle, closing the Handle primitive handleToFd :: Handle -> IO Int -- -- Creating a handle from a file descriptor/socket. -- primitive openFd :: Int -- file descriptor -> Bool -- True => it's a socket. -> IOMode -- what mode to open the handle in. -> Bool -- binary? -> IO Handle hugs98-plus-Sep2006/libraries/hugsbase/Hugs/IOArray.hs0000644006511100651110000000477510204665425021331 0ustar rossross----------------------------------------------------------------------------- -- Mutable arrays in the IO monad: -- -- Suitable for use with Hugs 98. ----------------------------------------------------------------------------- module Hugs.IOArray ( IOArray -- instance of: Eq, Typeable , newIOArray , boundsIOArray , readIOArray , writeIOArray , freezeIOArray , thawIOArray , unsafeFreezeIOArray , unsafeReadIOArray , unsafeWriteIOArray ) where import Hugs.Array ----------------------------------------------------------------------------- data IOArray ix elt -- implemented as an internal primitive newIOArray :: Ix ix => (ix,ix) -> elt -> IO (IOArray ix elt) boundsIOArray :: Ix ix => IOArray ix elt -> (ix, ix) readIOArray :: Ix ix => IOArray ix elt -> ix -> IO elt writeIOArray :: Ix ix => IOArray ix elt -> ix -> elt -> IO () thawIOArray :: Ix ix => Array ix elt -> IO (IOArray ix elt) freezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt) unsafeFreezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt) unsafeReadIOArray :: Ix i => IOArray i e -> Int -> IO e unsafeReadIOArray = primReadArr unsafeWriteIOArray :: Ix i => IOArray i e -> Int -> e -> IO () unsafeWriteIOArray = primWriteArr newIOArray bs e = primNewArr bs (rangeSize bs) e boundsIOArray a = primBounds a readIOArray a i = unsafeReadIOArray a (index (boundsIOArray a) i) writeIOArray a i e = unsafeWriteIOArray a (index (boundsIOArray a) i) e thawIOArray arr = do a <- newIOArray (bounds arr) err let fillin [] = return a fillin((ix,v):ixs) = do writeIOArray a ix v fillin ixs fillin (assocs arr) where err = error "thawArray: element not overwritten" freezeIOArray a = primFreeze a unsafeFreezeIOArray = freezeIOArray -- not as fast as GHC instance Eq (IOArray ix elt) where (==) = eqIOArray primitive primNewArr "IONewArr" :: (a,a) -> Int -> b -> IO (IOArray a b) primitive primReadArr "IOReadArr" :: IOArray a b -> Int -> IO b primitive primWriteArr "IOWriteArr" :: IOArray a b -> Int -> b -> IO () primitive primFreeze "IOFreeze" :: IOArray a b -> IO (Array a b) primitive primBounds "IOBounds" :: IOArray a b -> (a,a) primitive eqIOArray "IOArrEq" :: IOArray a b -> IOArray a b -> Bool ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/IOExts.hs0000644006511100651110000000606410426071620021161 0ustar rossross----------------------------------------------------------------------------- -- IO monad extensions: -- -- Suitable for use with Hugs 98. ----------------------------------------------------------------------------- module Hugs.IOExts ( unsafePerformIO -- :: IO a -> a , unsafeInterleaveIO -- :: IO a -> IO a , performGC , IOModeEx(..) -- instance (Eq, Read, Show) , openFileEx -- :: FilePath -> IOModeEx -> IO Handle , unsafePtrEq , unsafePtrToInt , unsafeCoerce -- backward compatibility with IOExtensions , readBinaryFile -- :: FilePath -> IO String , writeBinaryFile -- :: FilePath -> String -> IO () , appendBinaryFile -- :: FilePath -> String -> IO () , openBinaryFile -- :: FilePath -> IOMode -> IO Handle , hSetBinaryMode -- :: Handle -> Bool -> IO () , hPutBuf -- :: Handle -> Ptr a -> Int -> IO () , hGetBuf -- :: Handle -> Ptr a -> Int -> IO Int , argv -- :: [String] -- Terminal operations , hIsTerminalDevice -- :: Handle -> IO Bool , hGetEcho -- :: Handle -> IO Bool , hSetEcho -- :: Handle -> Bool -> IO () ) where import Hugs.Prelude import Hugs.IO import Hugs.System ( getArgs ) import Hugs.Ptr ( Ptr ) ----------------------------------------------------------------------------- primitive performGC "primGC" :: IO () unsafePerformIO :: IO a -> a unsafePerformIO m = valueOf (basicIORun m) unsafeInterleaveIO :: IO a -> IO a unsafeInterleaveIO m = IO (\ s -> s (unsafePerformIO m)) primitive unsafePtrEq :: a -> a -> Bool primitive unsafePtrToInt :: a -> Int primitive unsafeCoerce "primUnsafeCoerce" :: a -> b valueOf :: IOFinished a -> a valueOf (Finished_Return a) = a valueOf _ = error "IOExts.valueOf: thread failed" -- shouldn't happen ----------------------------------------------------------------------------- -- Binary files ----------------------------------------------------------------------------- data IOModeEx = BinaryMode IOMode | TextMode IOMode deriving (Eq, Read, Show) openFileEx :: FilePath -> IOModeEx -> IO Handle openFileEx fp m = case m of BinaryMode m -> openBinaryFile fp m TextMode m -> openFile fp m argv :: [String] argv = unsafePerformIO getArgs writeBinaryFile :: FilePath -> String -> IO () writeBinaryFile = writeBinaryFile' WriteMode appendBinaryFile :: FilePath -> String -> IO () appendBinaryFile = writeBinaryFile' AppendMode writeBinaryFile' :: IOMode -> FilePath -> String -> IO () writeBinaryFile' mode name s = do h <- openBinaryFile name mode catchException (hPutStr h s) (\e -> hClose h >> throw e) hClose h readBinaryFile :: FilePath -> IO String readBinaryFile name = openBinaryFile name ReadMode >>= hGetContents primitive openBinaryFile :: FilePath -> IOMode -> IO Handle primitive hSetBinaryMode :: Handle -> Bool -> IO () primitive hPutBuf :: Handle -> Ptr a -> Int -> IO () primitive hGetBuf :: Handle -> Ptr a -> Int -> IO Int primitive hIsTerminalDevice :: Handle -> IO Bool primitive hGetEcho :: Handle -> IO Bool primitive hSetEcho :: Handle -> Bool -> IO () hugs98-plus-Sep2006/libraries/hugsbase/Hugs/IORef.hs0000644006511100651110000000105610204665425020754 0ustar rossrossmodule Hugs.IORef ( IORef -- abstract, instance of: Eq , newIORef -- :: a -> IO (IORef a) , readIORef -- :: IORef a -> IO a , writeIORef -- :: IORef a -> a -> IO () ) where data IORef a -- mutable variables containing values of type a primitive newIORef "newRef" :: a -> IO (IORef a) primitive readIORef "getRef" :: IORef a -> IO a primitive writeIORef "setRef" :: IORef a -> a -> IO () primitive eqIORef "eqRef" :: IORef a -> IORef a -> Bool instance Eq (IORef a) where (==) = eqIORef hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Int.hs0000644006511100651110000003012510227457076020547 0ustar rossross---------------------------------------------------------------------------- -- Signed Integers -- Suitable for use with Hugs 98 on 32 bit systems. ----------------------------------------------------------------------------- module Hugs.Int ( Int8 , Int16 , Int32 , Int64 -- plus Eq, Ord, Num, Bounded, Real, Integral, Ix, Enum, Read, -- Show and Bits instances for each of Int8, Int16 and Int32 ) where import Hugs.Prelude ( Int8, Int16, Int32, Int64, boundedSucc, boundedPred, boundedEnumFrom, boundedEnumFromTo, boundedEnumFromThen, boundedEnumFromThenTo ) import Hugs.Prelude ( Ix(..) ) import Hugs.Prelude ( (%) ) import Hugs.Prelude ( readDec ) import Hugs.Prelude ( Num(fromInt), Integral(toInt) ) import Hugs.Numeric ( showInt ) import Hugs.Bits import Data.Bits ----------------------------------------------------------------------------- -- Int8 ----------------------------------------------------------------------------- primitive int8ToInt "primInt8ToInt" :: Int8 -> Int primitive intToInt8 "primIntToInt8" :: Int -> Int8 instance Eq Int8 where (==) = binop (==) instance Ord Int8 where compare = binop compare instance Num Int8 where x + y = intToInt8 (binop (+) x y) x - y = intToInt8 (binop (-) x y) negate = intToInt8 . negate . int8ToInt x * y = intToInt8 (binop (*) x y) abs = absReal signum = signumReal fromInteger = intToInt8 . fromInteger fromInt = intToInt8 instance Bounded Int8 where minBound = 0x80 maxBound = 0x7f instance Real Int8 where toRational x = toInteger x % 1 instance Integral Int8 where x `div` y = intToInt8 (binop div x y) x `quot` y = intToInt8 (binop quot x y) x `rem` y = intToInt8 (binop rem x y) x `mod` y = intToInt8 (binop mod x y) x `quotRem` y = to2 (binop quotRem x y) toInteger = toInteger . int8ToInt toInt = int8ToInt instance Ix Int8 where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Int8 where succ = boundedSucc pred = boundedPred toEnum = fromInt fromEnum = toInt enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Read Int8 where readsPrec p s = [ (intToInt8 x,r) | (x,r) <- readsPrec p s ] instance Show Int8 where showsPrec p = showsPrec p . int8ToInt instance Bits Int8 where x .&. y = intToInt8 (binop (.&.) x y) x .|. y = intToInt8 (binop (.|.) x y) x `xor` y = intToInt8 (binop xor x y) complement = intToInt8 . complement . int8ToInt x `shift` i = intToInt8 (int8ToInt x `shift` i) rotate = rotateSigned bit = intToInt8 . bit setBit x i = intToInt8 (setBit (int8ToInt x) i) clearBit x i = intToInt8 (clearBit (int8ToInt x) i) complementBit x i = intToInt8 (complementBit (int8ToInt x) i) testBit x i = testBit (int8ToInt x) i bitSize _ = 8 isSigned _ = True ----------------------------------------------------------------------------- -- Int16 ----------------------------------------------------------------------------- primitive int16ToInt "primInt16ToInt" :: Int16 -> Int primitive intToInt16 "primIntToInt16" :: Int -> Int16 instance Eq Int16 where (==) = binop (==) instance Ord Int16 where compare = binop compare instance Num Int16 where x + y = intToInt16 (binop (+) x y) x - y = intToInt16 (binop (-) x y) negate = intToInt16 . negate . int16ToInt x * y = intToInt16 (binop (*) x y) abs = absReal signum = signumReal fromInteger = intToInt16 . fromInteger fromInt = intToInt16 instance Bounded Int16 where minBound = 0x8000 maxBound = 0x7fff instance Real Int16 where toRational x = toInteger x % 1 instance Integral Int16 where x `div` y = intToInt16 (binop div x y) x `quot` y = intToInt16 (binop quot x y) x `rem` y = intToInt16 (binop rem x y) x `mod` y = intToInt16 (binop mod x y) x `quotRem` y = to2 (binop quotRem x y) toInteger = toInteger . int16ToInt toInt = int16ToInt instance Ix Int16 where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Int16 where succ = boundedSucc pred = boundedPred toEnum = fromInt fromEnum = toInt enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Read Int16 where readsPrec p s = [ (intToInt16 x,r) | (x,r) <- readsPrec p s ] instance Show Int16 where showsPrec p = showsPrec p . int16ToInt instance Bits Int16 where x .&. y = intToInt16 (binop (.&.) x y) x .|. y = intToInt16 (binop (.|.) x y) x `xor` y = intToInt16 (binop xor x y) complement = intToInt16 . complement . int16ToInt x `shift` i = intToInt16 (int16ToInt x `shift` i) rotate = rotateSigned bit = intToInt16 . bit setBit x i = intToInt16 (setBit (int16ToInt x) i) clearBit x i = intToInt16 (clearBit (int16ToInt x) i) complementBit x i = intToInt16 (complementBit (int16ToInt x) i) testBit x i = testBit (int16ToInt x) i bitSize _ = 16 isSigned _ = True ----------------------------------------------------------------------------- -- Int32 ----------------------------------------------------------------------------- primitive int32ToInt "primInt32ToInt" :: Int32 -> Int primitive intToInt32 "primIntToInt32" :: Int -> Int32 instance Eq Int32 where (==) = binop (==) instance Ord Int32 where compare = binop compare instance Num Int32 where x + y = intToInt32 (binop (+) x y) x - y = intToInt32 (binop (-) x y) negate = intToInt32 . negate . int32ToInt x * y = intToInt32 (binop (*) x y) abs = absReal signum = signumReal fromInteger = intToInt32 . fromInteger fromInt = intToInt32 instance Bounded Int32 where minBound = intToInt32 minBound maxBound = intToInt32 maxBound instance Real Int32 where toRational x = toInteger x % 1 instance Integral Int32 where x `div` y = intToInt32 (binop div x y) x `quot` y = intToInt32 (binop quot x y) x `rem` y = intToInt32 (binop rem x y) x `mod` y = intToInt32 (binop mod x y) x `quotRem` y = to2 (binop quotRem x y) toInteger = toInteger . int32ToInt toInt = int32ToInt instance Ix Int32 where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Int32 where succ = boundedSucc pred = boundedPred toEnum = fromInt fromEnum = toInt enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Read Int32 where readsPrec p s = [ (intToInt32 x,r) | (x,r) <- readsPrec p s ] instance Show Int32 where showsPrec p = showsPrec p . int32ToInt instance Bits Int32 where x .&. y = intToInt32 (binop (.&.) x y) x .|. y = intToInt32 (binop (.|.) x y) x `xor` y = intToInt32 (binop xor x y) complement = intToInt32 . complement . int32ToInt x `shift` i = intToInt32 (int32ToInt x `shift` i) rotate = rotateSigned bit = intToInt32 . bit setBit x i = intToInt32 (setBit (int32ToInt x) i) clearBit x i = intToInt32 (clearBit (int32ToInt x) i) complementBit x i = intToInt32 (complementBit (int32ToInt x) i) testBit x i = testBit (int32ToInt x) i bitSize _ = 32 isSigned _ = True ----------------------------------------------------------------------------- -- Int64 ----------------------------------------------------------------------------- -- Assume a 2s-complement representation, and that this function -- separates the top 32 bits from the lower 32. primitive int64ToInt32 "primInt64ToInt32" :: Int64 -> (Int32,Int32) primitive int32ToInt64 "primInt32ToInt64" :: Int32 -> Int32 -> Int64 integerToI64 :: Integer -> Int64 integerToI64 x = case x `divMod` 0x100000000 of (hi,lo) -> int32ToInt64 (fromInteger hi) (fromInteger lo) i64ToInteger :: Int64 -> Integer i64ToInteger x = case int64ToInt32 x of (hi,lo) -> (if lo<0 then toInteger hi+1 else toInteger hi)*0x100000000 + toInteger lo instance Eq Int64 where x == y = int64ToInt32 x == int64ToInt32 y instance Ord Int64 where compare x y = compare (toInteger x) (toInteger y) instance Bounded Int64 where minBound = int32ToInt64 minBound 0 maxBound = int32ToInt64 maxBound (-1) instance Show Int64 where showsPrec p = showsPrec p . toInteger instance Read Int64 where readsPrec p s = [ (fromInteger x,r) | (x,r) <- readDec s ] instance Num Int64 where x + y = fromInteger (toInteger x + toInteger y) x - y = fromInteger (toInteger x - toInteger y) x * y = fromInteger (toInteger x * toInteger y) abs = absReal signum = signumReal fromInteger = integerToI64 instance Real Int64 where toRational x = toInteger x % 1 instance Ix Int64 where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Int64 where succ = boundedSucc pred = boundedPred toEnum = fromInt fromEnum = toInt enumFrom x = enumFromTo x maxBound enumFromTo x y = map fromInteger [toInteger x .. toInteger y] enumFromThen = boundedEnumFromThen enumFromThenTo x y z = map fromInteger [toInteger x, toInteger y .. toInteger z] instance Integral Int64 where x `quotRem` y = (fromInteger q, fromInteger r) where (q,r) = toInteger x `quotRem` toInteger y toInteger = i64ToInteger instance Bits Int64 where x .&. y = liftBinary (.&.) x y x .|. y = liftBinary (.|.) x y x `xor` y = liftBinary xor x y complement = liftUnary complement x `shift` i = fromInteger (toInteger x `shift` i) rotate = rotateSigned bit i | i `mod` 64 < 32 = int32ToInt64 0 (bit i) | otherwise = int32ToInt64 (bit i) 0 bitSize _ = 64 isSigned _ = True liftBinary :: (Int32 -> Int32 -> Int32) -> Int64 -> Int64 -> Int64 liftBinary op x y = int32ToInt64 (op xhi yhi) (op xlo ylo) where (xhi,xlo) = int64ToInt32 x (yhi,ylo) = int64ToInt32 y liftUnary :: (Int32 -> Int32) -> Int64 -> Int64 liftUnary op x = int32ToInt64 (op xhi) (op xlo) where (xhi,xlo) = int64ToInt32 x rotateSigned :: (Bits a, Ord a) => a -> Int -> a rotateSigned x i | i<0 && x<0 = let left = i+bitSize x in ((x `shift` i) .&. complement ((-1) `shift` left)) .|. (x `shift` left) | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x)) | i==0 = x | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x)) ----------------------------------------------------------------------------- -- End of exported definitions -- -- The remainder of this file consists of definitions which are only -- used in the implementation. ----------------------------------------------------------------------------- binop :: Integral int => (Int -> Int -> a) -> (int -> int -> a) binop op x y = toInt x `op` toInt y from :: Integral int => int -> Int from = toInt to :: Num int => Int -> int to = fromInt to2 :: Num int => (Int, Int) -> (int, int) to2 (x,y) = (fromInt x, fromInt y) ----------------------------------------------------------------------------- -- Code copied from the Prelude ----------------------------------------------------------------------------- absReal x | x >= 0 = x | otherwise = -x signumReal x | x == 0 = 0 | x > 0 = 1 | otherwise = -1 ----------------------------------------------------------------------------- -- End ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Internals.hs0000644006511100651110000001660710204665425021757 0ustar rossross---------------------------------------------------------------- -- Primitives for accessing Hugs internals. -- -- NB These primitives are an _experimental_ feature which may be -- removed in future versions of Hugs. -- They can only be used if hugs was configured with the -- "--enable-internal-prims" flag. -- -- The primitives defined in this module provide the means with -- which to implement simple error-recovery and debugging facilities -- in Haskell. -- -- The error catching primitive only works if the "failOnError" flag -- is FALSE - ie Hugs was invoked with the "-f" flag. -- -- Despite appearances, these primitives are referentially transparent -- (with the exception of the rarely used pointer equality operations) -- (The proof is really neat - but there just isn't enough space in the margin) ---------------------------------------------------------------- module Hugs.Internals( ptrEq, Name, nameString, nameInfo, nameEq, Cell, getCell, cellPtrEq, CellKind(..), classifyCell, catchError, Addr, nameCode, Instr(..), instrAt, instrsAt, ) where import Hugs.Prelude hiding ( Addr ) ---------------------------------------------------------------- -- pointer equality ---------------------------------------------------------------- -- breaks referential transparency - use with care primitive ptrEq "unsafePtrEq" :: a -> a -> Bool ---------------------------------------------------------------- -- Name ---------------------------------------------------------------- data Name -- newtype Name = Name Int -- returns (arity, precedence, associativity) primitive nameInfo :: Name -> (Int, Int, Char) primitive nameString :: Name -> String primitive nameEq :: Name -> Name -> Bool instance Show Name where showsPrec _ nm = showString (nameString nm) instance Eq Name where (==) = nameEq ---------------------------------------------------------------- -- Cell -- Note: cellPtrEq breaks referential transparency - use with care ---------------------------------------------------------------- data Cell primitive getCell :: a -> Cell primitive cellPtrEq :: Cell -> Cell -> Bool primitive catchError "catchError2" :: a -> Either Cell a instance Show Cell where showsPrec _ _ = showString "{Cell}" ---------------------------------------------------------------- -- CellType ---------------------------------------------------------------- data CellKind = Apply Cell [Cell] | Fun Name | Con Name | Tuple Int | Int Int | Integer Integer | Float Float | Double Double | Char Char | Prim String | Error Cell deriving (Show) primitive classifyCell :: Bool -> Cell -> IO CellKind ---------------------------------------------------------------- -- Addr ---------------------------------------------------------------- newtype Addr = Addr Int deriving (Eq, Show) s :: Addr -> Addr s (Addr a) = Addr (a+1) primitive nameCode :: Name -> Addr primitive intAt :: Addr -> Int primitive floatAt :: Addr -> Float primitive doubleAt :: Addr -> Double primitive cellAt :: Addr -> Cell primitive nameAt :: Addr -> Name primitive textAt :: Addr -> String primitive addrAt :: Addr -> Addr primitive bytecodeAt :: Addr -> Bytecode ---------------------------------------------------------------- -- Bytecode ---------------------------------------------------------------- newtype Bytecode = Bytecode Int deriving (Eq, Show) iLOAD = Bytecode 0 iCELL = Bytecode 1 iCHAR = Bytecode 2 iINT = Bytecode 3 iFLOAT = Bytecode 4 iSTRING = Bytecode 5 iMKAP = Bytecode 6 iUPDATE = Bytecode 7 iUPDAP = Bytecode 8 iEVAL = Bytecode 9 iRETURN = Bytecode 10 iTEST = Bytecode 11 iGOTO = Bytecode 12 iSETSTK = Bytecode 13 iROOT = Bytecode 14 iDICT = Bytecode 15 iFAIL = Bytecode 16 iALLOC = Bytecode 17 iSLIDE = Bytecode 18 iSTAP = Bytecode 19 iTABLE = Bytecode 20 iLEVAL = Bytecode 21 iRUPDAP = Bytecode 22 iRUPDATE = Bytecode 23 data Instr = LOAD Int | CELL Cell | CHAR Char | INT Int | FLOAT Float | DOUBLE Double | STRING String | MKAP Int | UPDATE Int | UPDAP Int | EVAL | RETURN | TEST Name Addr | GOTO Addr | SETSTK Int | ROOT Int | DICT Int | FAIL | ALLOC Int | SLIDE Int | STAP | TABLE | LEVAL Int | RUPDAP | RUPDATE deriving (Show) instrAt :: Addr -> (Instr, Addr) instrAt pc = case bytecodeAt pc of i | i == iLOAD -> (LOAD (intAt (s pc)), s (s pc)) i | i == iCELL -> (CELL (cellAt (s pc)), s (s pc)) i | i == iCHAR -> (CHAR (toEnum (intAt (s pc))), s (s pc)) i | i == iINT -> (INT (intAt (s pc)), s (s pc)) i | i == iFLOAT -> (FLOAT (floatAt (s pc)), s (s pc)) i | i == iSTRING -> (STRING (textAt (s pc)), s (s pc)) i | i == iMKAP -> (MKAP (intAt (s pc)), s (s pc)) i | i == iUPDATE -> (UPDATE (intAt (s pc)), s (s pc)) i | i == iUPDAP -> (UPDAP (intAt (s pc)), s (s pc)) i | i == iEVAL -> (EVAL , s pc) i | i == iRETURN -> (RETURN , s pc) i | i == iTEST -> (TEST (nameAt (s pc)) (addrAt (s (s (pc)))), s (s (s pc))) i | i == iGOTO -> (GOTO (addrAt (s pc)), s (s pc)) i | i == iSETSTK -> (SETSTK (intAt (s pc)), s (s pc)) i | i == iROOT -> (ROOT (intAt (s pc)), s (s pc)) i | i == iDICT -> (DICT (intAt (s pc)), s (s pc)) i | i == iFAIL -> (FAIL , s pc) i | i == iALLOC -> (ALLOC (intAt (s pc)), s (s pc)) i | i == iSLIDE -> (SLIDE (intAt (s pc)), s (s pc)) i | i == iSTAP -> (STAP , s pc) i | i == iTABLE -> (TABLE , s pc) i | i == iLEVAL -> (LEVAL (intAt (s pc)), s (s pc)) i | i == iRUPDAP -> (RUPDAP , s pc) i | i == iRUPDATE -> (RUPDATE , s pc) -- list of instructions starting at given address instrsAt :: Addr -> [Instr] instrsAt pc = let (i, pc') = instrAt pc in i : instrsAt pc' ---------------------------------------------------------------- ---------------------------------------------------------------- -- tests ---------------------------------------------------------------- -- test1, test2 :: Either Cell Int -- -- test1 = catchError (error "foo") -- test2 = catchError 1 -- -- -- test3, test4, test5 :: Int -- -- test3 = myCatch (1+error "foo") 2 -- test4 = myCatch 1 (error "bar") -- test5 = myCatch (error "foo") (error "bar") -- -- -- test6, test7, test8, test9 :: IO () -- -- test6 = printString "abcdefg" -- test7 = printString (error "a" : "bcdefg") -- test8 = printString ("abc" ++ error "defg") -- test9 = printString (error "a" : "bc" ++ error "defg") -- -- -- if an error occurs, replace it with a default (hopefully error-free) value -- myCatch :: a -> a -> a -- myCatch x deflt = case catchError x of -- Right x' -> x' -- Left _ -> deflt -- -- -- lazily print a string - catching any errors as necessary -- printString :: String -> IO () -- printString str = -- case catchError str of -- Left _ -> putStr "" -- Right [] -> return () -- Right (c:cs) -> case catchError c of -- Left _ -> putStr "" >> printString cs -- Right c' -> putChar c' >> printString cs hugs98-plus-Sep2006/libraries/hugsbase/Hugs/LazyST.hs0000644006511100651110000000362310204665425021200 0ustar rossross----------------------------------------------------------------------------- -- Lazy State Thread module -- -- This library provides support for both lazy and strict state threads, -- as described in the PLDI '94 paper by John Launchbury and Simon Peyton -- Jones. In addition to the monad ST, it also provides mutable variables -- STRef and mutable arrays STArray. It is identical to the ST module -- except that the ST instance is lazy. -- -- Suitable for use with Hugs 98. ----------------------------------------------------------------------------- module Hugs.LazyST ( ST , runST , unsafeInterleaveST , fixST , lazyToStrictST , strictToLazyST ) where import qualified Hugs.ST as ST import Control.Monad ----------------------------------------------------------------------------- newtype ST s a = ST (State s -> (a, State s)) unST :: ST s a -> State s -> (a, State s) unST (ST f) = f runST :: (forall s. ST s a) -> a runST m = fst (unST m S) unsafeInterleaveST :: ST s a -> ST s a unsafeInterleaveST (ST m) = return (fst (m S)) fixST :: (a -> ST s a) -> ST s a fixST f = ST (\s -> let (x,s') = unST (f x) s in (x,s')) instance Functor (ST s) where fmap = liftM instance Monad (ST s) where return a = ST (\s -> (a, s)) ST m >>= f = ST (\S -> let (a,s') = m S in unST (f a) s') -- ST m >>= f = ST (\s -> let (a,s') = m s in unST (f a) s') ----------------------------------------------------------------------------- data State s = S ----------------------------------------------------------------------------- lazyToStrictST :: ST s a -> ST.ST s a lazyToStrictST (ST m) = ST.ST (\k -> case m S of (a,S) -> k a) strictToLazyST :: ST.ST s a -> ST s a strictToLazyST (ST.ST m) = ST (\S -> m delay) -- \s -> let (a',s') = case s of S -> m (\a -> (a,S)) in (a',s')) delay :: a -> (a, State s) delay a = (a,S) ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Memo.hs0000644006511100651110000001116510204665425020707 0ustar rossross{----------------------------------------------------------------------------- A LIBRARY OF MEMOIZATION COMBINATORS 15th September 1999 Byron Cook OGI This Hugs module implements several flavors of memoization functions, as described in Haskell Workshop 1997. -----------------------------------------------------------------------------} module Hugs.Memo( memo, memoN, memoFix, memoFixN, cache, cacheN, cacheFix, cacheFixN ) where import Hugs.ST -- import Hugs.IOExts (unsafePtrEq) -- import Debug.Trace (trace) memo :: (a -> b) -> (a -> b) memoN :: Int -> (a -> b) -> (a -> b) memoFix :: ((a -> b) -> (a -> b)) -> (a -> b) memoFixN :: Int -> ((a -> b) -> (a -> b)) -> (a -> b) cache :: (a -> b) -> (a -> b) cacheN :: Int -> (a -> b) -> (a -> b) cacheFix :: ((a -> b) -> (a -> b)) -> (a -> b) cacheFixN :: Int -> ((a -> b) -> (a -> b)) -> (a -> b) ---------------------------------------------------------------- -- Memoization Functions (memo-tables are hash-tables) ---------------------------------------------------------------- memo = memoN defaultSize memoN = mkMemo eql hash memoFix = memoFixN defaultSize memoFixN n f = let g = f h h = memoN n g in g ---------------------------------------------------------------- -- Caching Functions (memo-tables are caches) ---------------------------------------------------------------- cache = cacheN defaultSize cacheN = mkCache eql hash cacheFix = cacheFixN defaultSize cacheFixN n f = let g = f h h = cacheN n g in g ---------------------------------------------------------------- -- Type synonyms ---------------------------------------------------------------- type TaintedEq a = a -> a -> ST Mem Bool type HashTable a b = STArray Mem Int [(a,b)] type Cache a b = STArray Mem Int (Maybe (a,b)) type HashSize = Int type HashFunc a = a -> ST Mem Int type Mem = () ---------------------------------------------------------------- -- Foundation functions ---------------------------------------------------------------- defaultSize :: HashSize defaultSize = 40 memoize :: ST Mem t -> (t -> a -> b -> ST Mem b) -> (a -> b) -> a -> b memoize new access f = {-trace "memoize" $-} unsafeRunST $ do t <- new return (\x -> unsafeRunST $ access t x (f x)) mkMemo :: TaintedEq a -> HashFunc a -> Int -> (a -> c) -> (a -> c) mkCache :: TaintedEq a -> HashFunc a -> Int -> (a -> c) -> (a -> c) mkCache e h sz = memoize (newCache sz) (accessCache e h sz) mkMemo e h sz = memoize (newHash sz) (accessHash e h sz) ---------------------------------------------------------------- -- Hash and Cache Tables ---------------------------------------------------------------- accessHash :: TaintedEq a -> HashFunc a -> Int -> HashTable a b -> a -> b -> ST Mem b accessHash equal h sz table x v = do hv' <- h x let hv = hv' `mod` sz l <- readSTArray table hv find l l hv where find l [] hv = {-trace "miss " $-} do u <- writeSTArray table hv ((x,v):l) case u of {() -> return v} find l ((x',v'):xs) hv = do a <- equal x x' if a then {-trace "hit "-} (return $ v') else find l xs hv newHash :: Int -> ST Mem (HashTable a b) newHash n = newSTArray (0,n) [] accessCache :: TaintedEq a -> HashFunc a -> Int -> Cache a b -> a -> b -> ST Mem b accessCache equal h sz table x v = do hv' <- h x let hv = hv' `mod` sz l <- readSTArray table hv case l of Nothing -> do u <- writeSTArray table hv (Just (x,v)) case u of {() -> return v} Just (x',y) -> do e <- equal x' x if e then return y else do u <- writeSTArray table hv (Just (x,v)) case u of {() -> return v} newCache :: Int -> ST Mem (Cache a b) newCache n = newSTArray (0,n) Nothing ------------------------------------------------------------------ -- These functions are bad --- dont pay attention to them -- lisp style eql --- as described in "Lazy-memo functions" primitive eql "IOEql" :: a -> a -> ST Mem Bool -- a `eql` b = return (a `unsafePtrEq` b) -- hash based on addresses (or values if the arg is a base type) primitive hash "IOHash" :: a -> ST Mem Int ------------------------------------------------------------------ hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Numeric.hs0000644006511100651110000002420410204665425021412 0ustar rossross----------------------------------------------------------------------------- -- Standard Library: Numeric operations -- -- Suitable for use with Hugs 98 ----------------------------------------------------------------------------- module Hugs.Numeric ( fromRat -- :: (RealFloat a) => Rational -> a , showEFloat -- :: (RealFloat a) => Maybe Int -> a -> ShowS , showFFloat -- :: (RealFloat a) => Maybe Int -> a -> ShowS , showGFloat -- :: (RealFloat a) => Maybe Int -> a -> ShowS , showFloat -- :: (RealFloat a) => a -> ShowS , floatToDigits -- :: (RealFloat a) => Integer -> a -> ([Int], Int) , showInt -- :: Integral a => a -> ShowS , showSigned -- :: Real a => (a -> ShowS) -> Int -> a -> ShowS ) where import Data.Char ( intToDigit ) import Data.Ratio ( (%), numerator, denominator ) import Hugs.Array ( (!), Array, array ) -- This converts a rational to a floating. This should be used in the -- Fractional instances of Float and Double. fromRat :: (RealFloat a) => Rational -> a fromRat x | x == 0 = encodeFloat 0 0 -- Handle exceptional cases | x < 0 = -fromRat' (-x) -- first. | otherwise = fromRat' x -- Conversion process: -- Scale the rational number by the RealFloat base until -- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat). -- Then round the rational to an Integer and encode it with the exponent -- that we got from the scaling. -- To speed up the scaling process we compute the log2 of the number to get -- a first guess of the exponent. fromRat' :: (RealFloat a) => Rational -> a fromRat' x = r where b = floatRadix r p = floatDigits r (minExp0, _) = floatRange r minExp = minExp0 - p -- the real minimum exponent xMin = toRational (expt b (p-1)) xMax = toRational (expt b p) p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1 (x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f) r = encodeFloat (round x') p' -- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp. scaleRat :: Rational -> Int -> Rational -> Rational -> Int -> Rational -> (Rational, Int) scaleRat b minExp xMin xMax p x | p <= minExp = (x,p) | x >= xMax = scaleRat b minExp xMin xMax (p+1) (x/b) | x < xMin = scaleRat b minExp xMin xMax (p-1) (x*b) | otherwise = (x, p) -- Exponentiation with a cache for the most common numbers. minExpt = 0::Int maxExpt = 1100::Int expt :: Integer -> Int -> Integer expt base n = if base == 2 && n >= minExpt && n <= maxExpt then expts!n else base^n expts :: Array Int Integer expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]] -- Compute the (floor of the) log of i in base b. -- Simplest way would be just divide i by b until it's smaller then b, -- but that would be very slow! We are just slightly more clever. integerLogBase :: Integer -> Integer -> Int integerLogBase b i = if i < b then 0 else -- Try squaring the base first to cut down the number of divisions. let l = 2 * integerLogBase (b*b) i doDiv :: Integer -> Int -> Int doDiv i l = if i < b then l else doDiv (i `div` b) (l+1) in doDiv (i `div` (b^l)) l -- Misc utilities to show integers and floats showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS showFloat :: (RealFloat a) => a -> ShowS showEFloat d x = showString (formatRealFloat FFExponent d x) showFFloat d x = showString (formatRealFloat FFFixed d x) showGFloat d x = showString (formatRealFloat FFGeneric d x) showFloat = showGFloat Nothing -- These are the format types. This type is not exported. data FFFormat = FFExponent | FFFixed | FFGeneric formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String formatRealFloat fmt decs x | isNaN x = "NaN" | isInfinite x = if x < 0 then "-Infinity" else "Infinity" | x < 0 || isNegativeZero x = '-' : doFmt fmt (floatToDigits (toInteger base) (-x)) | otherwise = doFmt fmt (floatToDigits (toInteger base) x) where base = 10 doFmt fmt (is, e) = let ds = map intToDigit is in case fmt of FFGeneric -> doFmt (if e < 0 || e > 7 then FFExponent else FFFixed) (is, e) FFExponent -> case decs of Nothing -> case ds of "0" -> "0.0e0" [d] -> d : ".0e" ++ show (e-1) d:ds -> d : '.' : ds ++ 'e':show (e-1) Just dec -> let dec' = max dec 1 in case is of [0] -> '0':'.':take dec' (repeat '0') ++ "e0" _ -> let (ei, is') = roundTo base (dec'+1) is d:ds = map intToDigit (if ei > 0 then init is' else is') in d:'.':ds ++ "e" ++ show (e-1+ei) FFFixed -> case decs of Nothing | e > 0 -> take e (ds ++ repeat '0') ++ '.' : mk0 (drop e ds) | otherwise -> '0' : '.' : mk0 (replicate (-e) '0' ++ ds) Just dec -> let dec' = max dec 0 in if e >= 0 then let (ei, is') = roundTo base (dec' + e) is (ls, rs) = splitAt (e+ei) (map intToDigit is') in mk0 ls ++ mkdot0 rs else let (ei, is') = roundTo base dec' (replicate (-e) 0 ++ is) d : ds = map intToDigit (if ei > 0 then is' else 0:is') in d : mkdot0 ds where mk0 "" = "0" -- Used to ensure we print 34.0, not 34. mk0 s = s -- and 0.34 not .34 mkdot0 "" = "" -- Used to ensure we print 34, not 34. mkdot0 s = '.' : s roundTo :: Int -> Int -> [Int] -> (Int, [Int]) roundTo base d is = case f d is of v@(0, is) -> v (1, is) -> (1, 1 : is) where b2 = base `div` 2 f n [] = (0, replicate n 0) f 0 (i:_) = (if i >= b2 then 1 else 0, []) f d (i:is) = let (c, ds) = f (d-1) is i' = c + i in if i' == base then (1, 0:ds) else (0, i':ds) -- -- Based on "Printing Floating-Point Numbers Quickly and Accurately" -- by R.G. Burger and R. K. Dybvig, in PLDI 96. -- This version uses a much slower logarithm estimator. It should be improved. -- This function returns a list of digits (Ints in [0..base-1]) and an -- exponent. floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int) floatToDigits _ 0 = ([0], 0) floatToDigits base x = let (f0, e0) = decodeFloat x (minExp0, _) = floatRange x p = floatDigits x b = floatRadix x minExp = minExp0 - p -- the real minimum exponent -- Haskell requires that f be adjusted so denormalized numbers -- will have an impossibly low exponent. Adjust for this. f :: Integer e :: Int (f, e) = let n = minExp - e0 in if n > 0 then (f0 `div` (b^n), e0+n) else (f0, e0) (r, s, mUp, mDn) = if e >= 0 then let be = b^e in if f == b^(p-1) then (f*be*b*2, 2*b, be*b, b) else (f*be*2, 2, be, be) else if e > minExp && f == b^(p-1) then (f*b*2, b^(-e+1)*2, b, 1) else (f*2, b^(-e)*2, 1, 1) k = let k0 = if b==2 && base==10 then -- logBase 10 2 is slightly bigger than 3/10 so -- the following will err on the low side. Ignoring -- the fraction will make it err even more. -- Haskell promises that p-1 <= logBase b f < p. (p - 1 + e0) * 3 `div` 10 else ceiling ((log (fromInteger (f+1)) + fromIntegral e * log (fromInteger b)) / log (fromInteger base)) fixup n = if n >= 0 then if r + mUp <= expt base n * s then n else fixup (n+1) else if expt base (-n) * (r + mUp) <= s then n else fixup (n+1) in fixup k0 gen ds rn sN mUpN mDnN = let (dn, rn') = (rn * base) `divMod` sN mUpN' = mUpN * base mDnN' = mDnN * base in case (rn' < mDnN', rn' + mUpN' > sN) of (True, False) -> dn : ds (False, True) -> dn+1 : ds (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN' rds = if k >= 0 then gen [] r (s * expt base k) mUp mDn else let bk = expt base (-k) in gen [] (r * bk) s (mUp * bk) (mDn * bk) in (map fromIntegral (reverse rds), k) -- ----------------------------------------------------------------------------- -- Showing -- showInt is used for positive numbers only showInt :: Integral a => a -> ShowS showInt n r | n < 0 = error "Numeric.showInt: can't show negative numbers" | otherwise = let (n',d) = quotRem n 10 r' = toEnum (fromEnum '0' + fromIntegral d) : r in if n' == 0 then r' else showInt n' r' showSigned :: Real a => (a -> ShowS) -> Int -> a -> ShowS showSigned showPos p x = if x < 0 then showParen (p > 6) (showChar '-' . showPos (-x)) else showPos x hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Observe.hs0000644006511100651110000000025510204665425021415 0ustar rossrossmodule Hugs.Observe (observe, bkpt, setBkpt) where primitive observe :: String -> a -> a primitive bkpt :: String -> a -> a primitive setBkpt :: String -> Bool -> IO () hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Prelude.hs0000644006511100651110000017751310426071620021416 0ustar rossross{---------------------------------------------------------------------------- __ __ __ __ ____ ___ _______________________________________________ || || || || || || ||__ Hugs 98: The Nottingham and Yale Haskell system ||___|| ||__|| ||__|| __|| Copyright (c) 1994-1999 ||---|| ___|| World Wide Web: http://haskell.org/hugs || || Report bugs to: hugs-bugs@haskell.org || || Version: February 1999_______________________________________________ This is the Hugs 98 Standard Prelude, based very closely on the Standard Prelude for Haskell 98. WARNING: This file is an integral part of the Hugs source code. Changes to the definitions in this file without corresponding modifications in other parts of the program may cause the interpreter to fail unexpectedly. Under normal circumstances, you should not attempt to modify this file in any way! ----------------------------------------------------------------------------- The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, 1994-2003, All rights reserved. It is distributed as free software under the license in the file "License", which is included in the distribution. ----------------------------------------------------------------------------} module Hugs.Prelude ( -- module PreludeList, map, (++), concat, filter, head, last, tail, init, null, length, (!!), foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1, iterate, repeat, replicate, cycle, take, drop, splitAt, takeWhile, dropWhile, span, break, lines, words, unlines, unwords, reverse, and, or, any, all, elem, notElem, lookup, sum, product, maximum, minimum, concatMap, zip, zip3, zipWith, zipWith3, unzip, unzip3, -- module PreludeText, ReadS, ShowS, Read(readsPrec, readList), Show(show, showsPrec, showList), reads, shows, read, lex, showChar, showString, readParen, showParen, -- module PreludeIO, FilePath, IOError, ioError, userError, catch, putChar, putStr, putStrLn, print, getChar, getLine, getContents, interact, readFile, writeFile, appendFile, readIO, readLn, -- module Ix, Ix(range, index, unsafeIndex, inRange, rangeSize), -- module Char, isSpace, isUpper, isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum, readLitChar, showLitChar, lexLitChar, -- module Numeric readSigned, readInt, readDec, readOct, readHex, readSigned, readFloat, lexDigits, -- module Ratio, Ratio((:%)), (%), numerator, denominator, -- Non-standard exports IO(..), IOResult(..), IOException(..), IOErrorType(..), Exception(..), ArithException(..), ArrayException(..), AsyncException(..), ExitCode(..), FunPtr, Ptr, Addr, Word, StablePtr, ForeignObj, ForeignPtr, Int8, Int16, Int32, Int64, Word8, Word16, Word32, Word64, Handle, Object, basicIORun, blockIO, IOFinished(..), threadToIOResult, catchException, throw, Dynamic(..), TypeRep(..), Key(..), TyCon(..), Obj, IOMode(..), stdin, stdout, stderr, openFile, hClose, hGetContents, hGetChar, hGetLine, hPutChar, hPutStr, Bool(False, True), Maybe(Nothing, Just), Either(Left, Right), Ordering(LT, EQ, GT), Char, String, Int, Integer, Float, Double, Rational, IO, -- List type: []((:), []) (:), -- Tuple types: (,), (,,), etc. -- Trivial type: () -- Functions: (->) Rec, emptyRec, EmptyRow, -- non-standard, should only be exported if TREX Eq((==), (/=)), Ord(compare, (<), (<=), (>=), (>), max, min), Enum(succ, pred, toEnum, fromEnum, enumFrom, enumFromThen, enumFromTo, enumFromThenTo), Bounded(minBound, maxBound), -- Num((+), (-), (*), negate, abs, signum, fromInteger), Num((+), (-), (*), negate, abs, signum, fromInteger, fromInt), Real(toRational), -- Integral(quot, rem, div, mod, quotRem, divMod, toInteger), Integral(quot, rem, div, mod, quotRem, divMod, toInteger, toInt), -- Fractional((/), recip, fromRational), Fractional((/), recip, fromRational, fromDouble), Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh), RealFrac(properFraction, truncate, round, ceiling, floor), RealFloat(floatRadix, floatDigits, floatRange, decodeFloat, encodeFloat, exponent, significand, scaleFloat, isNaN, isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2), Monad((>>=), (>>), return, fail), Functor(fmap), mapM, mapM_, sequence, sequence_, (=<<), maybe, either, (&&), (||), not, otherwise, subtract, even, odd, gcd, lcm, (^), (^^), fromIntegral, realToFrac, fst, snd, curry, uncurry, id, const, (.), flip, ($), until, asTypeOf, error, undefined, seq, ($!), boundedSucc, boundedPred, boundedEnumFrom, boundedEnumFromTo, boundedEnumFromThen, boundedEnumFromThenTo ) where -- Standard value bindings {Prelude} ---------------------------------------- infixr 9 . infixl 9 !! infixr 8 ^, ^^, ** infixl 7 *, /, `quot`, `rem`, `div`, `mod`, :%, % infixl 6 +, - --infixr 5 : -- this fixity declaration is hard-wired into Hugs infixr 5 ++ infix 4 ==, /=, <, <=, >=, >, `elem`, `notElem` infixr 3 && infixr 2 || infixl 1 >>, >>= infixr 1 =<< infixr 0 $, $!, `seq` -- Equality and Ordered classes --------------------------------------------- class Eq a where (==), (/=) :: a -> a -> Bool -- Minimal complete definition: (==) or (/=) x == y = not (x/=y) x /= y = not (x==y) class (Eq a) => Ord a where compare :: a -> a -> Ordering (<), (<=), (>=), (>) :: a -> a -> Bool max, min :: a -> a -> a -- Minimal complete definition: (<=) or compare -- using compare can be more efficient for complex types compare x y | x==y = EQ | x<=y = LT | otherwise = GT x <= y = compare x y /= GT x < y = compare x y == LT x >= y = compare x y /= LT x > y = compare x y == GT max x y | x <= y = y | otherwise = x min x y | x <= y = x | otherwise = y class Bounded a where minBound, maxBound :: a -- Minimal complete definition: All -- Numeric classes ---------------------------------------------------------- class (Eq a, Show a) => Num a where (+), (-), (*) :: a -> a -> a negate :: a -> a abs, signum :: a -> a fromInteger :: Integer -> a fromInt :: Int -> a -- Minimal complete definition: All, except negate or (-) x - y = x + negate y fromInt = fromIntegral negate x = 0 - x class (Num a, Ord a) => Real a where toRational :: a -> Rational class (Real a, Enum a) => Integral a where quot, rem, div, mod :: a -> a -> a quotRem, divMod :: a -> a -> (a,a) toInteger :: a -> Integer toInt :: a -> Int -- Minimal complete definition: quotRem and toInteger n `quot` d = q where (q,r) = quotRem n d n `rem` d = r where (q,r) = quotRem n d n `div` d = q where (q,r) = divMod n d n `mod` d = r where (q,r) = divMod n d divMod n d = if signum r == - signum d then (q-1, r+d) else qr where qr@(q,r) = quotRem n d toInt = toInt . toInteger class (Num a) => Fractional a where (/) :: a -> a -> a recip :: a -> a fromRational :: Rational -> a fromDouble :: Double -> a -- Minimal complete definition: fromRational and ((/) or recip) recip x = 1 / x fromDouble = fromRational . fromDouble x / y = x * recip y class (Fractional a) => Floating a where pi :: a exp, log, sqrt :: a -> a (**), logBase :: a -> a -> a sin, cos, tan :: a -> a asin, acos, atan :: a -> a sinh, cosh, tanh :: a -> a asinh, acosh, atanh :: a -> a -- Minimal complete definition: pi, exp, log, sin, cos, sinh, cosh, -- asinh, acosh, atanh pi = 4 * atan 1 x ** y = exp (log x * y) logBase x y = log y / log x sqrt x = x ** 0.5 tan x = sin x / cos x sinh x = (exp x - exp (-x)) / 2 cosh x = (exp x + exp (-x)) / 2 tanh x = sinh x / cosh x asinh x = log (x + sqrt (x*x + 1)) acosh x = log (x + sqrt (x*x - 1)) atanh x = (log (1 + x) - log (1 - x)) / 2 class (Real a, Fractional a) => RealFrac a where properFraction :: (Integral b) => a -> (b,a) truncate, round :: (Integral b) => a -> b ceiling, floor :: (Integral b) => a -> b -- Minimal complete definition: properFraction truncate x = m where (m,_) = properFraction x round x = let (n,r) = properFraction x m = if r < 0 then n - 1 else n + 1 in case signum (abs r - 0.5) of -1 -> n 0 -> if even n then n else m 1 -> m ceiling x = if r > 0 then n + 1 else n where (n,r) = properFraction x floor x = if r < 0 then n - 1 else n where (n,r) = properFraction x class (RealFrac a, Floating a) => RealFloat a where floatRadix :: a -> Integer floatDigits :: a -> Int floatRange :: a -> (Int,Int) decodeFloat :: a -> (Integer,Int) encodeFloat :: Integer -> Int -> a exponent :: a -> Int significand :: a -> a scaleFloat :: Int -> a -> a isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE :: a -> Bool atan2 :: a -> a -> a -- Minimal complete definition: All, except exponent, signficand, -- scaleFloat, atan2 exponent x = if m==0 then 0 else n + floatDigits x where (m,n) = decodeFloat x significand x = encodeFloat m (- floatDigits x) where (m,_) = decodeFloat x scaleFloat k x = encodeFloat m (n+k) where (m,n) = decodeFloat x atan2 y x | x>0 = atan (y/x) | x==0 && y>0 = pi/2 | x<0 && y>0 = pi + atan (y/x) | (x<=0 && y<0) || (x<0 && isNegativeZero y) || (isNegativeZero x && isNegativeZero y) = - atan2 (-y) x | y==0 && (x<0 || isNegativeZero x) = pi -- must be after the previous test on zero y | x==0 && y==0 = y -- must be after the other double zero tests | otherwise = x + y -- x or y is a NaN, return a NaN (via +) -- Numeric functions -------------------------------------------------------- subtract :: Num a => a -> a -> a subtract = flip (-) even, odd :: (Integral a) => a -> Bool even n = n `rem` 2 == 0 odd = not . even gcd :: Integral a => a -> a -> a gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined" gcd x y = gcd' (abs x) (abs y) where gcd' x 0 = x gcd' x y = gcd' y (x `rem` y) lcm :: (Integral a) => a -> a -> a lcm _ 0 = 0 lcm 0 _ = 0 lcm x y = abs ((x `quot` gcd x y) * y) (^) :: (Num a, Integral b) => a -> b -> a x ^ 0 = 1 x ^ n | n > 0 = f x (n-1) x where f _ 0 y = y f x n y = g x n where g x n | even n = g (x*x) (n`quot`2) | otherwise = f x (n-1) (x*y) _ ^ _ = error "Prelude.^: negative exponent" (^^) :: (Fractional a, Integral b) => a -> b -> a x ^^ n = if n >= 0 then x ^ n else recip (x^(-n)) fromIntegral :: (Integral a, Num b) => a -> b fromIntegral = fromInteger . toInteger realToFrac :: (Real a, Fractional b) => a -> b realToFrac = fromRational . toRational -- Index and Enumeration classes -------------------------------------------- class (Ord a) => Ix a where range :: (a,a) -> [a] -- The unchecked variant unsafeIndex is non-standard, but useful index, unsafeIndex :: (a,a) -> a -> Int inRange :: (a,a) -> a -> Bool rangeSize :: (a,a) -> Int -- Must specify one of index, unsafeIndex index b i | inRange b i = unsafeIndex b i | otherwise = error "Ix.index: index out of range" unsafeIndex b i = index b i rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1 | otherwise = 0 -- NB: replacing "inRange b h" by "l <= u" -- fails if the bounds are tuples. For example, -- (1,2) <= (2,1) -- but the range is nevertheless empty -- range ((1,2),(2,1)) = [] class Enum a where succ, pred :: a -> a toEnum :: Int -> a fromEnum :: a -> Int enumFrom :: a -> [a] -- [n..] enumFromThen :: a -> a -> [a] -- [n,m..] enumFromTo :: a -> a -> [a] -- [n..m] enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m] -- Minimal complete definition: toEnum, fromEnum succ = toEnum . (1+) . fromEnum pred = toEnum . subtract 1 . fromEnum enumFrom x = map toEnum [ fromEnum x ..] enumFromTo x y = map toEnum [ fromEnum x .. fromEnum y ] enumFromThen x y = map toEnum [ fromEnum x, fromEnum y ..] enumFromThenTo x y z = map toEnum [ fromEnum x, fromEnum y .. fromEnum z ] -- Read and Show classes ------------------------------------------------------ type ReadS a = String -> [(a,String)] type ShowS = String -> String class Read a where readsPrec :: Int -> ReadS a readList :: ReadS [a] -- Minimal complete definition: readsPrec readList = readParen False (\r -> [pr | ("[",s) <- lex r, pr <- readl s ]) where readl s = [([],t) | ("]",t) <- lex s] ++ [(x:xs,u) | (x,t) <- reads s, (xs,u) <- readl' t] readl' s = [([],t) | ("]",t) <- lex s] ++ [(x:xs,v) | (",",t) <- lex s, (x,u) <- reads t, (xs,v) <- readl' u] class Show a where show :: a -> String showsPrec :: Int -> a -> ShowS showList :: [a] -> ShowS -- Minimal complete definition: show or showsPrec show x = showsPrec 0 x "" showsPrec _ x s = show x ++ s showList [] = showString "[]" showList (x:xs) = showChar '[' . shows x . showl xs where showl [] = showChar ']' showl (x:xs) = showChar ',' . shows x . showl xs -- Monad classes ------------------------------------------------------------ class Functor f where fmap :: (a -> b) -> (f a -> f b) class Monad m where return :: a -> m a (>>=) :: m a -> (a -> m b) -> m b (>>) :: m a -> m b -> m b fail :: String -> m a -- Minimal complete definition: (>>=), return p >> q = p >>= \ _ -> q fail s = error s sequence :: Monad m => [m a] -> m [a] sequence [] = return [] sequence (c:cs) = do x <- c xs <- sequence cs return (x:xs) sequence_ :: Monad m => [m a] -> m () sequence_ = foldr (>>) (return ()) mapM :: Monad m => (a -> m b) -> [a] -> m [b] mapM f = sequence . map f mapM_ :: Monad m => (a -> m b) -> [a] -> m () mapM_ f = sequence_ . map f (=<<) :: Monad m => (a -> m b) -> m a -> m b f =<< x = x >>= f -- Evaluation and strictness ------------------------------------------------ primitive seq :: a -> b -> b primitive ($!) "strict" :: (a -> b) -> a -> b -- f $! x = x `seq` f x -- Trivial type ------------------------------------------------------------- -- data () = () deriving (Eq, Ord, Ix, Enum, Read, Show, Bounded) instance Eq () where () == () = True instance Ord () where compare () () = EQ instance Ix () where range ((),()) = [()] index ((),()) () = 0 inRange ((),()) () = True instance Enum () where toEnum 0 = () fromEnum () = 0 enumFrom () = [()] instance Read () where readsPrec p = readParen False (\r -> [((),t) | ("(",s) <- lex r, (")",t) <- lex s ]) instance Show () where showsPrec p () = showString "()" instance Bounded () where minBound = () maxBound = () -- Boolean type ------------------------------------------------------------- data Bool = False | True deriving (Eq, Ord, Ix, Enum, Read, Show, Bounded) (&&), (||) :: Bool -> Bool -> Bool False && x = False True && x = x False || x = x True || x = True not :: Bool -> Bool not True = False not False = True otherwise :: Bool otherwise = True -- Character type ----------------------------------------------------------- data Char -- builtin datatype of ISO Latin characters type String = [Char] -- strings are lists of characters primitive primEqChar :: Char -> Char -> Bool primitive primCmpChar :: Char -> Char -> Ordering instance Eq Char where (==) = primEqChar instance Ord Char where compare = primCmpChar primitive primCharToInt :: Char -> Int primitive primIntToChar :: Int -> Char instance Enum Char where toEnum = primIntToChar fromEnum = primCharToInt enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Char)] enumFromThen = boundedEnumFromThen instance Ix Char where range (c,c') = [c..c'] unsafeIndex (c,_) i = fromEnum i - fromEnum c inRange (c,c') i = c <= i && i <= c' instance Read Char where readsPrec p = readParen False (\r -> [(c,t) | ('\'':s,t) <- lex r, (c,"\'") <- readLitChar s ]) readList = readParen False (\r -> [(l,t) | ('"':s, t) <- lex r, (l,_) <- readl s ]) where readl ('"':s) = [("",s)] readl ('\\':'&':s) = readl s readl s = [(c:cs,u) | (c ,t) <- readLitChar s, (cs,u) <- readl t ] instance Show Char where showsPrec p '\'' = showString "'\\''" showsPrec p c = showChar '\'' . showLitChar c . showChar '\'' showList cs = showChar '"' . showl cs where showl "" = showChar '"' showl ('"':cs) = showString "\\\"" . showl cs showl (c:cs) = showLitChar c . showl cs instance Bounded Char where minBound = '\0' maxBound = primMaxChar primitive primMaxChar :: Char isSpace, isDigit :: Char -> Bool isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f' || c == '\v' || c == '\xa0' isDigit c = c >= '0' && c <= '9' primitive isUpper :: Char -> Bool primitive isLower :: Char -> Bool primitive isAlpha :: Char -> Bool primitive isAlphaNum :: Char -> Bool -- Maybe type --------------------------------------------------------------- data Maybe a = Nothing | Just a deriving (Eq, Ord, Read, Show) maybe :: b -> (a -> b) -> Maybe a -> b maybe n f Nothing = n maybe n f (Just x) = f x instance Functor Maybe where fmap f Nothing = Nothing fmap f (Just x) = Just (f x) instance Monad Maybe where Just x >>= k = k x Nothing >>= k = Nothing return = Just fail s = Nothing -- Either type -------------------------------------------------------------- data Either a b = Left a | Right b deriving (Eq, Ord, Read, Show) either :: (a -> c) -> (b -> c) -> Either a b -> c either l r (Left x) = l x either l r (Right y) = r y -- Ordering type ------------------------------------------------------------ data Ordering = LT | EQ | GT deriving (Eq, Ord, Ix, Enum, Read, Show, Bounded) -- Lists -------------------------------------------------------------------- -- data [a] = [] | a : [a] deriving (Eq, Ord) instance Eq a => Eq [a] where [] == [] = True (x:xs) == (y:ys) = x==y && xs==ys _ == _ = False instance Ord a => Ord [a] where compare [] (_:_) = LT compare [] [] = EQ compare (_:_) [] = GT compare (x:xs) (y:ys) = primCompAux x y (compare xs ys) instance Functor [] where fmap = map instance Monad [ ] where (x:xs) >>= f = f x ++ (xs >>= f) [] >>= f = [] return x = [x] fail s = [] instance Read a => Read [a] where readsPrec p = readList instance Show a => Show [a] where showsPrec p = showList -- Tuples ------------------------------------------------------------------- -- data (a,b) = (a,b) deriving (Eq, Ord, Ix, Read, Show) -- etc.. -- Standard Integral types -------------------------------------------------- data Int -- builtin datatype of fixed size integers data Integer -- builtin datatype of arbitrary size integers primitive primEqInt :: Int -> Int -> Bool primitive primCmpInt :: Int -> Int -> Ordering primitive primEqInteger :: Integer -> Integer -> Bool primitive primCmpInteger :: Integer -> Integer -> Ordering instance Eq Int where (==) = primEqInt instance Eq Integer where (==) = primEqInteger instance Ord Int where compare = primCmpInt instance Ord Integer where compare = primCmpInteger primitive primPlusInt, primMinusInt, primMulInt :: Int -> Int -> Int primitive primNegInt :: Int -> Int primitive primIntegerToInt :: Integer -> Int instance Num Int where (+) = primPlusInt (-) = primMinusInt negate = primNegInt (*) = primMulInt abs = absReal signum = signumReal fromInteger = primIntegerToInt fromInt x = x primitive primMinInt, primMaxInt :: Int instance Bounded Int where minBound = primMinInt maxBound = primMaxInt primitive primPlusInteger, primMinusInteger, primMulInteger :: Integer -> Integer -> Integer primitive primNegInteger :: Integer -> Integer primitive primIntToInteger :: Int -> Integer instance Num Integer where (+) = primPlusInteger (-) = primMinusInteger negate = primNegInteger (*) = primMulInteger abs = absReal signum = signumReal fromInteger x = x fromInt = primIntToInteger absReal x | x >= 0 = x | otherwise = -x signumReal x | x == 0 = 0 | x > 0 = 1 | otherwise = -1 instance Real Int where toRational x = toInteger x % 1 instance Real Integer where toRational x = x % 1 primitive primDivInt, primQuotInt, primRemInt, primModInt :: Int -> Int -> Int primitive primQrmInt :: Int -> Int -> (Int,Int) instance Integral Int where div = primDivInt quot = primQuotInt rem = primRemInt mod = primModInt quotRem = primQrmInt toInteger = primIntToInteger toInt x = x primitive primQrmInteger :: Integer -> Integer -> (Integer,Integer) instance Integral Integer where quotRem = primQrmInteger toInteger x = x toInt = primIntegerToInt instance Ix Int where range (m,n) = [m..n] unsafeIndex (m,_) i = i - m inRange (m,n) i = m <= i && i <= n instance Ix Integer where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Int where succ = boundedSucc pred = boundedPred toEnum = id fromEnum = id enumFrom = boundedEnumFrom enumFromTo = boundedEnumFromTo enumFromThen = boundedEnumFromThen enumFromThenTo = boundedEnumFromThenTo boundedSucc, boundedPred :: (Num a, Bounded a, Enum a) => a -> a boundedSucc x | x == maxBound = error "succ: applied to maxBound" | otherwise = x+1 boundedPred x | x == minBound = error "pred: applied to minBound" | otherwise = x-1 boundedEnumFrom :: (Ord a, Bounded a, Enum a) => a -> [a] boundedEnumFromTo :: (Ord a, Bounded a, Enum a) => a -> a -> [a] boundedEnumFromThenTo :: (Ord a, Num a, Bounded a, Enum a) => a -> a -> a -> [a] boundedEnumFromThen :: (Ord a, Bounded a, Enum a) => a -> a -> [a] boundedEnumFrom n = takeWhile1 (/= maxBound) (iterate succ n) boundedEnumFromTo n m = takeWhile (<= m) (boundedEnumFrom n) boundedEnumFromThen n m = enumFromThenTo n m (if n <= m then maxBound else minBound) boundedEnumFromThenTo n n' m | n' >= n = if n <= m then takeWhile1 (<= m - delta) ns else [] | otherwise = if n >= m then takeWhile1 (>= m - delta) ns else [] where delta = n'-n ns = iterate (+delta) n -- takeWhile and one more takeWhile1 :: (a -> Bool) -> [a] -> [a] takeWhile1 p (x:xs) = x : if p x then takeWhile1 p xs else [] instance Enum Integer where succ x = x + 1 pred x = x - 1 toEnum = primIntToInteger fromEnum = primIntegerToInt enumFrom = numericEnumFrom enumFromThen = numericEnumFromThen enumFromTo n m = takeWhile (<= m) (numericEnumFrom n) enumFromThenTo n n' m = takeWhile p (numericEnumFromThen n n') where p | n' >= n = (<= m) | otherwise = (>= m) numericEnumFrom :: Num a => a -> [a] numericEnumFromThen :: Num a => a -> a -> [a] numericEnumFromTo :: (Ord a, Fractional a) => a -> a -> [a] numericEnumFromThenTo :: (Ord a, Fractional a) => a -> a -> a -> [a] numericEnumFrom n = iterate' (+1) n numericEnumFromThen n m = iterate' (+(m-n)) n numericEnumFromTo n m = takeWhile (<= m+1/2) (numericEnumFrom n) numericEnumFromThenTo n n' m = takeWhile p (numericEnumFromThen n n') where p | n' >= n = (<= m + (n'-n)/2) | otherwise = (>= m + (n'-n)/2) iterate' :: (a -> a) -> a -> [a] -- strict version of iterate iterate' f x = x : (iterate' f $! f x) primitive primShowsInt :: Int -> Int -> ShowS instance Read Int where readsPrec p = readSigned readDec instance Show Int where showsPrec = primShowsInt primitive primShowsInteger :: Int -> Integer -> ShowS instance Read Integer where readsPrec p = readSigned readDec instance Show Integer where showsPrec = primShowsInteger -- Standard Floating types -------------------------------------------------- data Float -- builtin datatype of single precision floating point numbers data Double -- builtin datatype of double precision floating point numbers primitive primEqFloat :: Float -> Float -> Bool primitive primCmpFloat :: Float -> Float -> Ordering primitive primEqDouble :: Double -> Double -> Bool primitive primCmpDouble :: Double -> Double -> Ordering instance Eq Float where (==) = primEqFloat instance Eq Double where (==) = primEqDouble instance Ord Float where compare = primCmpFloat instance Ord Double where compare = primCmpDouble primitive primPlusFloat, primMinusFloat, primMulFloat :: Float -> Float -> Float primitive primNegFloat :: Float -> Float primitive primIntToFloat :: Int -> Float primitive primIntegerToFloat :: Integer -> Float instance Num Float where (+) = primPlusFloat (-) = primMinusFloat negate = primNegFloat (*) = primMulFloat abs = absReal signum = signumReal fromInteger = primIntegerToFloat fromInt = primIntToFloat primitive primPlusDouble, primMinusDouble, primMulDouble :: Double -> Double -> Double primitive primNegDouble :: Double -> Double primitive primIntToDouble :: Int -> Double primitive primIntegerToDouble :: Integer -> Double instance Num Double where (+) = primPlusDouble (-) = primMinusDouble negate = primNegDouble (*) = primMulDouble abs = absReal signum = signumReal fromInteger = primIntegerToDouble fromInt = primIntToDouble instance Real Float where toRational = floatToRational instance Real Double where toRational = doubleToRational -- Calls to these functions are optimised when passed as arguments to -- fromRational. floatToRational :: Float -> Rational doubleToRational :: Double -> Rational floatToRational x = realFloatToRational x doubleToRational x = realFloatToRational x realFloatToRational x = (m%1)*(b%1)^^n where (m,n) = decodeFloat x b = floatRadix x primitive primDivFloat :: Float -> Float -> Float primitive primDoubleToFloat :: Double -> Float primitive primFloatToDouble :: Float -> Double -- used by runtime optimizer instance Fractional Float where (/) = primDivFloat fromRational = primRationalToFloat fromDouble = primDoubleToFloat primitive primDivDouble :: Double -> Double -> Double instance Fractional Double where (/) = primDivDouble fromRational = primRationalToDouble fromDouble x = x -- These primitives are equivalent to (and are defined using) -- rationalTo{Float,Double}. The difference is that they test to see -- if their argument is of the form (fromDouble x) - which allows a much -- more efficient implementation. primitive primRationalToFloat :: Rational -> Float primitive primRationalToDouble :: Rational -> Double -- These functions are used by Hugs - don't change their types. rationalToFloat :: Rational -> Float rationalToDouble :: Rational -> Double rationalToFloat = rationalToRealFloat rationalToDouble = rationalToRealFloat rationalToRealFloat x = x' where x' = f e f e = if e' == e then y else f e' where y = encodeFloat (round (x * (1%b)^^e)) e (_,e') = decodeFloat y (_,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x' / fromInteger (denominator x)) b = floatRadix x' primitive primSinFloat, primAsinFloat, primCosFloat, primAcosFloat, primTanFloat, primAtanFloat, primLogFloat, primExpFloat, primSqrtFloat :: Float -> Float instance Floating Float where exp = primExpFloat log = primLogFloat sqrt = primSqrtFloat sin = primSinFloat cos = primCosFloat tan = primTanFloat asin = primAsinFloat acos = primAcosFloat atan = primAtanFloat primitive primSinDouble, primAsinDouble, primCosDouble, primAcosDouble, primTanDouble, primAtanDouble, primLogDouble, primExpDouble, primSqrtDouble :: Double -> Double instance Floating Double where exp = primExpDouble log = primLogDouble sqrt = primSqrtDouble sin = primSinDouble cos = primCosDouble tan = primTanDouble asin = primAsinDouble acos = primAcosDouble atan = primAtanDouble instance RealFrac Float where properFraction = floatProperFraction instance RealFrac Double where properFraction = floatProperFraction floatProperFraction x | n >= 0 = (fromInteger m * fromInteger b ^ n, 0) | otherwise = (fromInteger w, encodeFloat r n) where (m,n) = decodeFloat x b = floatRadix x (w,r) = quotRem m (b^(-n)) primitive primFloatRadix :: Integer primitive primFloatDigits :: Int primitive primFloatMinExp, primFloatMaxExp :: Int primitive primFloatEncode :: Integer -> Int -> Float primitive primFloatDecode :: Float -> (Integer, Int) instance RealFloat Float where floatRadix _ = primFloatRadix floatDigits _ = primFloatDigits floatRange _ = (primFloatMinExp, primFloatMaxExp) encodeFloat = primFloatEncode decodeFloat = primFloatDecode isNaN _ = False isInfinite _ = False isDenormalized _ = False isNegativeZero _ = False isIEEE _ = False primitive primDoubleRadix :: Integer primitive primDoubleDigits :: Int primitive primDoubleMinExp, primDoubleMaxExp :: Int primitive primDoubleEncode :: Integer -> Int -> Double primitive primDoubleDecode :: Double -> (Integer, Int) instance RealFloat Double where floatRadix _ = primDoubleRadix floatDigits _ = primDoubleDigits floatRange _ = (primDoubleMinExp, primDoubleMaxExp) encodeFloat = primDoubleEncode decodeFloat = primDoubleDecode isNaN _ = False isInfinite _ = False isDenormalized _ = False isNegativeZero _ = False isIEEE _ = False instance Enum Float where succ x = x+1 pred x = x-1 toEnum = primIntToFloat fromEnum = fromInteger . truncate -- may overflow enumFrom = numericEnumFrom enumFromThen = numericEnumFromThen enumFromTo = numericEnumFromTo enumFromThenTo = numericEnumFromThenTo instance Enum Double where succ x = x+1 pred x = x-1 toEnum = primIntToDouble fromEnum = fromInteger . truncate -- may overflow enumFrom = numericEnumFrom enumFromThen = numericEnumFromThen enumFromTo = numericEnumFromTo enumFromThenTo = numericEnumFromThenTo primitive primShowsFloat :: Int -> Float -> ShowS instance Read Float where readsPrec p = readSigned readFloat -- Note that showFloat in Numeric isn't used here instance Show Float where showsPrec = primShowsFloat primitive primShowsDouble :: Int -> Double -> ShowS instance Read Double where readsPrec p = readSigned readFloat -- Note that showFloat in Numeric isn't used here instance Show Double where showsPrec = primShowsDouble -- Some standard functions -------------------------------------------------- fst :: (a,b) -> a fst (x,_) = x snd :: (a,b) -> b snd (_,y) = y curry :: ((a,b) -> c) -> (a -> b -> c) curry f x y = f (x,y) uncurry :: (a -> b -> c) -> ((a,b) -> c) uncurry f p = f (fst p) (snd p) id :: a -> a id x = x const :: a -> b -> a const k _ = k (.) :: (b -> c) -> (a -> b) -> (a -> c) (f . g) x = f (g x) flip :: (a -> b -> c) -> b -> a -> c flip f x y = f y x ($) :: (a -> b) -> a -> b f $ x = f x until :: (a -> Bool) -> (a -> a) -> a -> a until p f x = if p x then x else until p f (f x) asTypeOf :: a -> a -> a asTypeOf = const error :: String -> a error s = throw (ErrorCall s) undefined :: a undefined = error "Prelude.undefined" -- Standard functions on rational numbers {PreludeRatio} -------------------- data Integral a => Ratio a = !a :% !a deriving (Eq) type Rational = Ratio Integer (%) :: Integral a => a -> a -> Ratio a x % y = reduce (x * signum y) (abs y) reduce :: Integral a => a -> a -> Ratio a reduce x y | y == 0 = error "Ratio.%: zero denominator" | otherwise = (x `quot` d) :% (y `quot` d) where d = gcd x y numerator, denominator :: Integral a => Ratio a -> a numerator (x :% y) = x denominator (x :% y) = y instance Integral a => Ord (Ratio a) where compare (x:%y) (x':%y') = compare (x*y') (x'*y) instance Integral a => Num (Ratio a) where (x:%y) + (x':%y') = reduce (x*y' + x'*y) (y*y') (x:%y) * (x':%y') = reduce (x*x') (y*y') negate (x :% y) = negate x :% y abs (x :% y) = abs x :% y signum (x :% y) = signum x :% 1 fromInteger x = fromInteger x :% 1 fromInt = intToRatio -- Hugs optimises code of the form fromRational (intToRatio x) intToRatio :: Integral a => Int -> Ratio a intToRatio x = fromInt x :% 1 instance Integral a => Real (Ratio a) where toRational (x:%y) = toInteger x :% toInteger y instance Integral a => Fractional (Ratio a) where (x:%y) / (x':%y') = (x*y') % (y*x') recip (x:%y) = y % x fromRational (x:%y) = fromInteger x :% fromInteger y fromDouble = doubleToRatio -- Hugs optimises code of the form fromRational (doubleToRatio x) -- Since this function is private, and only used to convert floating point -- literals, it yields a decimal fraction, hopefully the one the user -- specified in the first place (but some precision may be lost). A real -- Haskell implementation would use Rational to represent these literals. doubleToRatio :: Integral a => Double -> Ratio a doubleToRatio x | n>=0 = (round (x / fromInteger pow) * fromInteger pow) % 1 | otherwise = fromRational (round (x * fromInteger denom) % denom) where (m,n) = decodeFloat x n_dec = ceiling (logBase 10 (encodeFloat 1 n)) denom = 10 ^ (-n_dec) pow = 10 ^ n_dec instance Integral a => RealFrac (Ratio a) where properFraction (x:%y) = (fromIntegral q, r:%y) where (q,r) = quotRem x y instance Integral a => Enum (Ratio a) where succ x = x+1 pred x = x-1 toEnum = fromInt fromEnum = fromInteger . truncate -- may overflow enumFrom = numericEnumFrom enumFromTo = numericEnumFromTo enumFromThen = numericEnumFromThen enumFromThenTo = numericEnumFromThenTo instance (Read a, Integral a) => Read (Ratio a) where readsPrec p = readParen (p > 7) (\r -> [(x%y,u) | (x,s) <- readsPrec 8 r, ("%",t) <- lex s, (y,u) <- readsPrec 8 t ]) instance Integral a => Show (Ratio a) where showsPrec p (x:%y) = showParen (p > 7) (showsPrec 8 x . showString " % " . showsPrec 8 y) -- Standard list functions {PreludeList} ------------------------------------ head :: [a] -> a head (x:_) = x last :: [a] -> a last [x] = x last (_:xs) = last xs tail :: [a] -> [a] tail (_:xs) = xs init :: [a] -> [a] init [x] = [] init (x:xs) = x : init xs null :: [a] -> Bool null [] = True null (_:_) = False (++) :: [a] -> [a] -> [a] [] ++ ys = ys (x:xs) ++ ys = x : (xs ++ ys) map :: (a -> b) -> [a] -> [b] map f xs = [ f x | x <- xs ] filter :: (a -> Bool) -> [a] -> [a] filter p xs = [ x | x <- xs, p x ] concat :: [[a]] -> [a] concat = foldr (++) [] length :: [a] -> Int length = foldl' (\n _ -> n + 1) 0 (!!) :: [a] -> Int -> a xs !! n | n<0 = error "Prelude.!!: negative index" [] !! _ = error "Prelude.!!: index too large" (x:_) !! 0 = x (_:xs) !! n = xs !! (n-1) foldl :: (a -> b -> a) -> a -> [b] -> a foldl f z [] = z foldl f z (x:xs) = foldl f (f z x) xs foldl' :: (a -> b -> a) -> a -> [b] -> a foldl' f a [] = a foldl' f a (x:xs) = (foldl' f $! f a x) xs foldl1 :: (a -> a -> a) -> [a] -> a foldl1 f (x:xs) = foldl f x xs scanl :: (a -> b -> a) -> a -> [b] -> [a] scanl f q xs = q : (case xs of [] -> [] x:xs -> scanl f (f q x) xs) scanl1 :: (a -> a -> a) -> [a] -> [a] scanl1 _ [] = [] scanl1 f (x:xs) = scanl f x xs foldr :: (a -> b -> b) -> b -> [a] -> b foldr f z [] = z foldr f z (x:xs) = f x (foldr f z xs) foldr1 :: (a -> a -> a) -> [a] -> a foldr1 f [x] = x foldr1 f (x:xs) = f x (foldr1 f xs) scanr :: (a -> b -> b) -> b -> [a] -> [b] scanr f q0 [] = [q0] scanr f q0 (x:xs) = f x q : qs where qs@(q:_) = scanr f q0 xs scanr1 :: (a -> a -> a) -> [a] -> [a] scanr1 f [] = [] scanr1 f [x] = [x] scanr1 f (x:xs) = f x q : qs where qs@(q:_) = scanr1 f xs iterate :: (a -> a) -> a -> [a] iterate f x = x : iterate f (f x) repeat :: a -> [a] repeat x = xs where xs = x:xs replicate :: Int -> a -> [a] replicate n x = take n (repeat x) cycle :: [a] -> [a] cycle [] = error "Prelude.cycle: empty list" cycle xs = xs' where xs'=xs++xs' take :: Int -> [a] -> [a] take n _ | n <= 0 = [] take _ [] = [] take n (x:xs) = x : take (n-1) xs drop :: Int -> [a] -> [a] drop n xs | n <= 0 = xs drop _ [] = [] drop n (_:xs) = drop (n-1) xs splitAt :: Int -> [a] -> ([a], [a]) splitAt n xs | n <= 0 = ([],xs) splitAt _ [] = ([],[]) splitAt n (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt (n-1) xs takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile p [] = [] takeWhile p (x:xs) | p x = x : takeWhile p xs | otherwise = [] dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile p [] = [] dropWhile p xs@(x:xs') | p x = dropWhile p xs' | otherwise = xs span, break :: (a -> Bool) -> [a] -> ([a],[a]) span p [] = ([],[]) span p xs@(x:xs') | p x = (x:ys, zs) | otherwise = ([],xs) where (ys,zs) = span p xs' break p = span (not . p) lines :: String -> [String] lines "" = [] lines s = let (l,s') = break ('\n'==) s in l : case s' of [] -> [] (_:s'') -> lines s'' words :: String -> [String] words s = case dropWhile isSpace s of "" -> [] s' -> w : words s'' where (w,s'') = break isSpace s' unlines :: [String] -> String unlines [] = [] unlines (l:ls) = l ++ '\n' : unlines ls unwords :: [String] -> String unwords [] = "" unwords [w] = w unwords (w:ws) = w ++ ' ' : unwords ws reverse :: [a] -> [a] reverse = foldl (flip (:)) [] and, or :: [Bool] -> Bool and = foldr (&&) True or = foldr (||) False any, all :: (a -> Bool) -> [a] -> Bool any p = or . map p all p = and . map p elem, notElem :: Eq a => a -> [a] -> Bool elem = any . (==) notElem = all . (/=) lookup :: Eq a => a -> [(a,b)] -> Maybe b lookup k [] = Nothing lookup k ((x,y):xys) | k==x = Just y | otherwise = lookup k xys sum, product :: Num a => [a] -> a sum = foldl' (+) 0 product = foldl' (*) 1 maximum, minimum :: Ord a => [a] -> a maximum = foldl1 max minimum = foldl1 min concatMap :: (a -> [b]) -> [a] -> [b] concatMap f = concat . map f zip :: [a] -> [b] -> [(a,b)] zip = zipWith (\a b -> (a,b)) zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] zip3 = zipWith3 (\a b c -> (a,b,c)) zipWith :: (a->b->c) -> [a]->[b]->[c] zipWith z (a:as) (b:bs) = z a b : zipWith z as bs zipWith _ _ _ = [] zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs zipWith3 _ _ _ _ = [] unzip :: [(a,b)] -> ([a],[b]) unzip = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) ([], []) unzip3 :: [(a,b,c)] -> ([a],[b],[c]) unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[]) -- PreludeText ---------------------------------------------------------------- reads :: Read a => ReadS a reads = readsPrec 0 shows :: Show a => a -> ShowS shows = showsPrec 0 read :: Read a => String -> a read s = case [x | (x,t) <- reads s, ("","") <- lex t] of [x] -> x [] -> error "Prelude.read: no parse" _ -> error "Prelude.read: ambiguous parse" showChar :: Char -> ShowS showChar = (:) showString :: String -> ShowS showString = (++) showParen :: Bool -> ShowS -> ShowS showParen b p = if b then showChar '(' . p . showChar ')' else p showField :: Show a => String -> a -> ShowS showField m@(c:_) v | isAlpha c || c == '_' = showString m . showString " = " . shows v | otherwise = showChar '(' . showString m . showString ") = " . shows v readParen :: Bool -> ReadS a -> ReadS a readParen b g = if b then mandatory else optional where optional r = g r ++ mandatory r mandatory r = [(x,u) | ("(",s) <- lex r, (x,t) <- optional s, (")",u) <- lex t ] readField :: Read a => String -> ReadS a readField m s0 = [ r | (t, s1) <- readFieldName m s0, ("=",s2) <- lex s1, r <- reads s2 ] readFieldName :: String -> ReadS String readFieldName m@(c:_) s0 | isAlpha c || c == '_' = [ (f,s1) | (f,s1) <- lex s0, f == m ] | otherwise = [ (f,s3) | ("(",s1) <- lex s0, (f,s2) <- lex s1, f == m, (")",s3) <- lex s2 ] lex :: ReadS String lex "" = [("","")] lex (c:s) | isSpace c = lex (dropWhile isSpace s) lex ('\'':s) = [('\'':ch++"'", t) | (ch,'\'':t) <- lexLitChar s, ch /= "'" ] lex ('"':s) = [('"':str, t) | (str,t) <- lexString s] where lexString ('"':s) = [("\"",s)] lexString s = [(ch++str, u) | (ch,t) <- lexStrItem s, (str,u) <- lexString t ] lexStrItem ('\\':'&':s) = [("\\&",s)] lexStrItem ('\\':c:s) | isSpace c = [("",t) | '\\':t <- [dropWhile isSpace s]] lexStrItem s = lexLitChar s lex (c:s) | isSym c = [(c:sym,t) | (sym,t) <- [span isSym s]] | isAlpha c = [(c:nam,t) | (nam,t) <- [span isIdChar s]] -- '_' can be the start of a single char or a name/id. | c == '_' = case span isIdChar s of ([],_) -> [([c],s)] (nm,t) -> [((c:nm),t)] | isSingle c = [([c],s)] | isDigit c = [(c:ds++fe,t) | (ds,s) <- [span isDigit s], (fe,t) <- lexFracExp s ] | otherwise = [] -- bad character where isSingle c = c `elem` ",;()[]{}_`" isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~" isIdChar c = isAlphaNum c || c `elem` "_'" lexFracExp ('.':c:cs) | isDigit c = [('.':ds++e,u) | (ds,t) <- lexDigits (c:cs), (e,u) <- lexExp t ] lexFracExp s = lexExp s lexExp (e:s) | e `elem` "eE" = [(e:c:ds,u) | (c:t) <- [s], c `elem` "+-", (ds,u) <- lexDigits t] ++ [(e:ds,t) | (ds,t) <- lexDigits s] lexExp s = [("",s)] lexDigits :: ReadS String lexDigits = nonnull isDigit nonnull :: (Char -> Bool) -> ReadS String nonnull p s = [(cs,t) | (cs@(_:_),t) <- [span p s]] lexLitChar :: ReadS String lexLitChar "" = [] lexLitChar (c:s) | c /= '\\' = [([c],s)] | otherwise = map (prefix '\\') (lexEsc s) where lexEsc (c:s) | c `elem` "abfnrtv\\\"'" = [([c],s)] lexEsc ('^':c:s) | c >= '@' && c <= '_' = [(['^',c],s)] -- Numeric escapes lexEsc ('o':s) = [prefix 'o' (span isOctDigit s)] lexEsc ('x':s) = [prefix 'x' (span isHexDigit s)] lexEsc s@(c:_) | isDigit c = [span isDigit s] | isUpper c = case [(mne,s') | (c, mne) <- table, ([],s') <- [lexmatch mne s]] of (pr:_) -> [pr] [] -> [] lexEsc _ = [] table = ('\DEL',"DEL") : asciiTab prefix c (t,s) = (c:t, s) isOctDigit c = c >= '0' && c <= '7' isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || c >= 'a' && c <= 'f' lexmatch :: (Eq a) => [a] -> [a] -> ([a],[a]) lexmatch (x:xs) (y:ys) | x == y = lexmatch xs ys lexmatch xs ys = (xs,ys) asciiTab = zip ['\NUL'..' '] ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI", "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", "SP"] readLitChar :: ReadS Char readLitChar ('\\':s) = readEsc s where readEsc ('a':s) = [('\a',s)] readEsc ('b':s) = [('\b',s)] readEsc ('f':s) = [('\f',s)] readEsc ('n':s) = [('\n',s)] readEsc ('r':s) = [('\r',s)] readEsc ('t':s) = [('\t',s)] readEsc ('v':s) = [('\v',s)] readEsc ('\\':s) = [('\\',s)] readEsc ('"':s) = [('"',s)] readEsc ('\'':s) = [('\'',s)] readEsc ('^':c:s) | c >= '@' && c <= '_' = [(toEnum (fromEnum c - fromEnum '@'), s)] readEsc s@(d:_) | isDigit d = [(toEnum n, t) | (n,t) <- readDec s] readEsc ('o':s) = [(toEnum n, t) | (n,t) <- readOct s] readEsc ('x':s) = [(toEnum n, t) | (n,t) <- readHex s] readEsc s@(c:_) | isUpper c = let table = ('\DEL',"DEL") : asciiTab in case [(c,s') | (c, mne) <- table, ([],s') <- [lexmatch mne s]] of (pr:_) -> [pr] [] -> [] readEsc _ = [] readLitChar (c:s) = [(c,s)] showLitChar :: Char -> ShowS showLitChar c | c > '\DEL' = showChar '\\' . protectEsc isDigit (shows (fromEnum c)) showLitChar '\DEL' = showString "\\DEL" showLitChar '\\' = showString "\\\\" showLitChar c | c >= ' ' = showChar c showLitChar '\a' = showString "\\a" showLitChar '\b' = showString "\\b" showLitChar '\f' = showString "\\f" showLitChar '\n' = showString "\\n" showLitChar '\r' = showString "\\r" showLitChar '\t' = showString "\\t" showLitChar '\v' = showString "\\v" showLitChar '\SO' = protectEsc ('H'==) (showString "\\SO") showLitChar c = showString ('\\' : snd (asciiTab!!fromEnum c)) protectEsc p f = f . cont where cont s@(c:_) | p c = "\\&" ++ s cont s = s -- Unsigned readers for various bases readDec, readOct, readHex :: Integral a => ReadS a readDec = readInt 10 isDigit (\ d -> fromEnum d - fromEnum_0) readOct = readInt 8 isOctDigit (\ d -> fromEnum d - fromEnum_0) readHex = readInt 16 isHexDigit hex where hex d = fromEnum d - (if isDigit d then fromEnum_0 else fromEnum (if isUpper d then 'A' else 'a') - 10) fromEnum_0 :: Int fromEnum_0 = fromEnum '0' -- readInt reads a string of digits using an arbitrary base. -- Leading minus signs must be handled elsewhere. readInt :: Integral a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a readInt radix isDig digToInt s = [(foldl1 (\n d -> n * radix + d) (map (fromIntegral . digToInt) ds), r) | (ds,r) <- nonnull isDig s ] readSigned:: Real a => ReadS a -> ReadS a readSigned readPos = readParen False read' where read' r = read'' r ++ [(-x,t) | ("-",s) <- lex r, (x,t) <- read'' s] read'' r = [(n,s) | (str,s) <- lex r, (n,"") <- readPos str] -- This floating point reader uses a less restrictive syntax for floating -- point than the Haskell lexer. The `.' is optional. readFloat :: RealFrac a => ReadS a readFloat r = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r, (k,t) <- readExp s] ++ [ (0/0, t) | ("NaN",t) <- lex r] ++ [ (1/0, t) | ("Infinity",t) <- lex r] where readFix r = [(read (ds++ds'), length ds', t) | (ds, d) <- lexDigits r , (ds',t) <- lexFrac d ] lexFrac ('.':s) = lexDigits s lexFrac s = [("",s)] readExp (e:s) | e `elem` "eE" = readExp' s readExp s = [(0,s)] readExp' ('-':s) = [(-k,t) | (k,t) <- readDec s] readExp' ('+':s) = readDec s readExp' s = readDec s ---------------------------------------------------------------- -- Exception datatype and operations ---------------------------------------------------------------- data Exception = ArithException ArithException | ArrayException ArrayException | AssertionFailed String | AsyncException AsyncException | BlockedOnDeadMVar | Deadlock | DynException Dynamic | ErrorCall String | ExitException ExitCode | IOException IOException -- IO exceptions (from 'ioError') | NoMethodError String | NonTermination | PatternMatchFail String | RecConError String | RecSelError String | RecUpdError String instance Show Exception where showsPrec _ (ArithException e) = shows e showsPrec _ (ArrayException e) = shows e showsPrec _ (AssertionFailed s) = showException "assertion failed" s showsPrec _ (AsyncException e) = shows e showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely" showsPrec _ Deadlock = showString "<>" showsPrec _ (DynException _) = showString "unknown exception" showsPrec _ (ErrorCall s) = showString s showsPrec _ (ExitException err) = showString "exit: " . shows err showsPrec _ (IOException err) = shows err showsPrec _ (NoMethodError s) = showException "undefined member" s showsPrec _ NonTermination = showString "<>" showsPrec _ (PatternMatchFail s) = showException "pattern match failure" s showsPrec _ (RecConError s) = showException "undefined field" s showsPrec _ (RecSelError s) = showException "select of missing field" s showsPrec _ (RecUpdError s) = showException "update of missing field" s data ArithException = Overflow | Underflow | LossOfPrecision | DivideByZero | Denormal deriving (Eq, Ord) instance Show ArithException where showsPrec _ Overflow = showString "arithmetic overflow" showsPrec _ Underflow = showString "arithmetic underflow" showsPrec _ LossOfPrecision = showString "loss of precision" showsPrec _ DivideByZero = showString "divide by zero" showsPrec _ Denormal = showString "denormal" data ArrayException = IndexOutOfBounds String | UndefinedElement String deriving (Eq, Ord) instance Show ArrayException where showsPrec _ (IndexOutOfBounds s) = showException "array index out of range" s showsPrec _ (UndefinedElement s) = showException "undefined array element" s data AsyncException = StackOverflow | HeapOverflow | ThreadKilled deriving (Eq, Ord) instance Show AsyncException where showsPrec _ StackOverflow = showString "stack overflow" showsPrec _ HeapOverflow = showString "heap overflow" showsPrec _ ThreadKilled = showString "thread killed" showException :: String -> String -> ShowS showException tag msg = showString tag . (if null msg then id else showString ": " . showString msg) data ExitCode = ExitSuccess | ExitFailure Int deriving (Eq, Ord, Read, Show) -- data type describing IOErrors / exceptions. type IOError = IOException data IOException = IOError { ioe_handle :: Maybe Handle -- the handle used by the action -- flagging the error , ioe_type :: IOErrorType -- what kind of (std) error , ioe_location :: String -- location of the error , ioe_description :: String -- error-specific string , ioe_filename :: Maybe FilePath -- the resource involved. } deriving (Eq) data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy | ResourceExhausted | EOF | IllegalOperation | PermissionDenied | UserError -- GHC compatibility | ProtocolError | UnsupportedOperation | OtherError -- DOTNET only | DotNetException deriving (Eq) instance Show IOErrorType where show x = case x of AlreadyExists -> "already exists" NoSuchThing -> "does not exist" ResourceBusy -> "resource busy" ResourceExhausted -> "resource exhausted" EOF -> "end of file" IllegalOperation -> "illegal operation" PermissionDenied -> "permission denied" UserError -> "user error" ProtocolError -> "protocol error" UnsupportedOperation -> "unsupported operation" OtherError -> "failed" DotNetException -> ".NET exception" instance Show IOException where showsPrec p (IOError hdl iot loc s fn) = (case fn of Nothing -> case hdl of Nothing -> id Just h -> showsPrec p h . showString ": " Just name -> showString name . showString ": ") . (case loc of "" -> id _ -> showString loc . showString ": ") . showsPrec p iot . (case s of "" -> id _ -> showString " (" . showString s . showString ")") -- Monadic I/O: -------------------------------------------------------------- --data IO a -- builtin datatype of IO actions type FilePath = String -- file pathnames are represented by strings primitive primbindIO :: IO a -> (a -> IO b) -> IO b primitive primretIO :: a -> IO a ioError :: IOError -> IO a ioError e = IO (\ s -> throw (IOException e)) userError :: String -> IOError userError str = IOError Nothing UserError "" str Nothing catch :: IO a -> (IOError -> IO a) -> IO a catch m h = catchException m $ \e -> case e of IOException err -> h err _ -> throw e putChar :: Char -> IO () putChar = hPutChar stdout putStr :: String -> IO () putStr = hPutStr stdout print :: Show a => a -> IO () print = putStrLn . show putStrLn :: String -> IO () putStrLn s = do putStr s putChar '\n' getChar :: IO Char getChar = hGetChar stdin getContents :: IO String getContents = hGetContents stdin getLine :: IO String getLine = hGetLine stdin hGetLine :: Handle -> IO String hGetLine h = do c <- hGetChar h hGetLine' c where hGetLine' '\n' = return "" hGetLine' c = do cs <- getRest return (c:cs) getRest = do c <- catch (hGetChar h) $ \ ex -> if isEOFError ex then return '\n' else ioError ex hGetLine' c isEOFError ex = ioe_type ex == EOF -- defined in System.IO.Error -- raises an exception instead of an error readIO :: Read a => String -> IO a readIO s = case [x | (x,t) <- reads s, ("","") <- lex t] of [x] -> return x [] -> ioError (userError "PreludeIO.readIO: no parse") _ -> ioError (userError "PreludeIO.readIO: ambiguous parse") readLn :: Read a => IO a readLn = do l <- getLine r <- readIO l return r data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show) writeFile :: FilePath -> String -> IO () writeFile = writeFile' WriteMode appendFile :: FilePath -> String -> IO () appendFile = writeFile' AppendMode writeFile' :: IOMode -> FilePath -> String -> IO () writeFile' mode name s = do h <- openFile name mode catchException (hPutStr h s) (\e -> hClose h >> throw e) hClose h readFile :: FilePath -> IO String readFile name = openFile name ReadMode >>= hGetContents interact :: (String -> String) -> IO () interact f = getContents >>= (putStr . f) primitive stdin :: Handle primitive stdout :: Handle primitive stderr :: Handle primitive openFile :: FilePath -> IOMode -> IO Handle primitive hClose :: Handle -> IO () primitive hGetContents :: Handle -> IO String primitive hGetChar :: Handle -> IO Char primitive hPutChar :: Handle -> Char -> IO () primitive hPutStr :: Handle -> String -> IO () instance Functor IO where fmap f x = x >>= (return . f) instance Monad IO where (>>=) = primbindIO return = primretIO fail s = ioError (userError s) -- Hooks for primitives: ----------------------------------------------------- -- Do not mess with these! data FunPtr a -- builtin datatype of C function pointers data Ptr a -- builtin datatype of C pointers data Addr -- builtin datatype of C pointers (deprecated) data Word -- builtin datatype of unsigned ints (deprecated) data Int8 data Int16 data Int32 data Int64 data Word8 data Word16 data Word32 data Word64 data ForeignObj -- builtin datatype of C pointers with finalizers (deprecated) data ForeignPtr a -- builtin datatype of C pointers with finalizers data StablePtr a data Handle data Object a -- builtin datatype of external object references. -- (needed as primitive since they're supported in FFI decls.) instance Eq Handle where (==) = primEqHandle primitive primEqHandle :: Handle -> Handle -> Bool instance Show Handle where showsPrec _ h = case primGetHandleNumber h of 0 -> showString "" 1 -> showString "" 2 -> showString "" _ -> showString "" primitive primGetHandleNumber :: Handle -> Int primitive unsafeCoerce "primUnsafeCoerce" :: a -> b data Dynamic = Dynamic TypeRep Obj data TypeRep = TypeRep !Key TyCon [TypeRep] instance Eq TypeRep where (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2 data TyCon = TyCon !Key String instance Eq TyCon where (TyCon t1 _) == (TyCon t2 _) = t1 == t2 newtype Key = Key Int deriving( Eq ) data Obj = Obj toObj :: a -> Obj toObj = unsafeCoerce fromObj :: Obj -> a fromObj = unsafeCoerce newtype IO a = IO ((a -> IOResult) -> IOResult) data IOResult = Hugs_ExitWith Int | Hugs_Catch IOResult (Exception -> IOResult) (Obj -> IOResult) | Hugs_ForkThread IOResult IOResult | Hugs_DeadThread | Hugs_YieldThread IOResult | Hugs_Return Obj | Hugs_BlockThread (Obj -> IOResult) ((Obj -> IOResult) -> IOResult) data IOFinished a = Finished_ExitWith Int | Finished_Return a primitive throw "primThrowException" :: Exception -> a primitive primCatchException :: a -> Either Exception a catchException :: IO a -> (Exception -> IO a) -> IO a catchException (IO m) k = IO $ \ s -> Hugs_Catch (m hugsReturn) (\ e -> case (k e) of { IO k' -> k' s }) (s . fromObj) hugsReturn :: a -> IOResult hugsReturn x = Hugs_Return (toObj x) -- reify current thread, execute 'm ' and switch to next thread blockIO :: ((a -> IOResult) -> IO ()) -> IO a blockIO m = IO (\ s -> Hugs_BlockThread (s . fromObj) m') where m' k = threadToIOResult (m (k . toObj)) hugsIORun :: IO a -> Either Int a hugsIORun m = case basicIORun (runAndShowError m) of Finished_ExitWith i -> Left i Finished_Return a -> Right a where runAndShowError :: IO a -> IO a runAndShowError m = m `catchException` exceptionHandler exceptionHandler :: Exception -> IO a exceptionHandler (ExitException ExitSuccess) = primExitWith 0 exceptionHandler (ExitException (ExitFailure n)) = primExitWith n exceptionHandler err = runAndShowError $ do putChar '\n' putStr "Program error: " putStrLn (show err) primExitWith 1 basicIORun :: IO a -> IOFinished a basicIORun (IO m) = loop [m hugsReturn] threadToIOResult :: IO a -> IOResult threadToIOResult (IO m) = m (const Hugs_DeadThread) -- This is the queue of *runnable* threads. -- There may be blocked threads attached to MVars -- An important invariant is that at most one thread will result in -- Hugs_Return - and its Obj value has type \alpha loop :: [IOResult] -> IOFinished a loop [] = error "no more threads (deadlock?)" loop [Hugs_Return a] = Finished_Return (fromObj a) loop (Hugs_Return a:r) = loop (r ++ [Hugs_Return a]) loop (Hugs_Catch m f s:r) = loop (hugs_catch m f s : r) loop (Hugs_ExitWith i:_) = Finished_ExitWith i loop (Hugs_DeadThread:r) = loop r loop (Hugs_ForkThread a b:r) = loop (a:b:r) loop (Hugs_YieldThread a:r) = loop (r ++ [a]) loop (Hugs_BlockThread a b:r)= loop (b a : r) loop _ = error "Fatal error in Hugs scheduler" hugs_catch :: IOResult -> (Exception -> IOResult) -> (Obj -> IOResult) -> IOResult hugs_catch m f s = case primCatchException (catch' m) of Left exn -> f exn Right (Hugs_Return a) -> s a Right (Hugs_ForkThread a b) -> Hugs_ForkThread (Hugs_Catch a f s) b Right (Hugs_YieldThread a) -> Hugs_YieldThread (Hugs_Catch a f s) Right (Hugs_BlockThread a b)-> Hugs_BlockThread (\x -> Hugs_Catch (a x) f s) b Right r -> r where catch' :: IOResult -> IOResult catch' (Hugs_Catch m' f' s') = catch' (hugs_catch m' f' s') catch' x = x primExitWith :: Int -> IO a primExitWith c = IO (\ s -> Hugs_ExitWith c) primCompAux :: Ord a => a -> a -> Ordering -> Ordering primCompAux x y o = case compare x y of EQ -> o; LT -> LT; GT -> GT primPmInt :: Num a => Int -> a -> Bool primPmInt n x = fromInt n == x primPmInteger :: Num a => Integer -> a -> Bool primPmInteger n x = fromInteger n == x primPmFlt :: Fractional a => Double -> a -> Bool primPmFlt n x = fromDouble n == x -- The following primitives are only needed if (n+k) patterns are enabled: primPmNpk :: Integral a => Int -> a -> Maybe a primPmNpk n x = if n'<=x then Just (x-n') else Nothing where n' = fromInt n primPmSub :: Integral a => Int -> a -> a primPmSub n x = x - fromInt n -- Trex emptyRec :: Rec EmptyRow emptyRec = EmptyRec -- End of Hugs standard prelude ---------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Ptr.hs0000644006511100651110000000455410204665427020565 0ustar rossross----------------------------------------------------------------------------- -- Machine Addresses: -- Suitable for use with Hugs 98 on 32 bit machines. ----------------------------------------------------------------------------- module Hugs.Ptr ( Ptr , nullPtr -- :: Ptr a , plusPtr -- :: Ptr a -> Int -> Ptr b , castPtr -- :: Ptr a -> Ptr b , alignPtr -- :: Ptr a -> Int -> Ptr a , minusPtr -- :: Ptr a -> Ptr b -> Int -- instance Eq (Ptr a) -- instance Ord (Ptr a) -- instance Show (Ptr a) , FunPtr , nullFunPtr -- :: FunPtr a , castFunPtr -- :: FunPtr a -> FunPtr b , castFunPtrToPtr -- :: FunPtr a -> Ptr b , castPtrToFunPtr -- :: Ptr a -> FunPtr b , freeHaskellFunPtr -- :: FunPtr a -> IO () -- instance Eq (FunPtr a) -- instance Ord (FunPtr a) -- instance Show (FunPtr a) ) where import Hugs.Prelude ( Ptr, FunPtr ) -- data Ptr a -- in Hugs.Prelude instance Eq (Ptr a) where (==) = primEqPtr instance Ord (Ptr a) where compare = primCmpPtr instance Show (Ptr a) where showsPrec = primShowsPtr primitive nullPtr :: Ptr a primitive plusPtr :: Ptr a -> Int -> Ptr b primitive alignPtr :: Ptr a -> Int -> Ptr a primitive minusPtr :: Ptr a -> Ptr b -> Int primitive castPtr "primUnsafeCoerce" :: Ptr a -> Ptr b primitive primShowsPtr :: Int -> Ptr a -> ShowS primitive primEqPtr :: Ptr a -> Ptr a -> Bool primitive primCmpPtr :: Ptr a -> Ptr a -> Ordering -- data FunPtr a -- in Hugs.Prelude instance Eq (FunPtr a) where (==) = primEqFPtr instance Ord (FunPtr a) where compare = primCmpFPtr instance Show (FunPtr a) where showsPrec = primShowsFPtr primitive nullFunPtr "nullPtr" :: FunPtr a primitive primShowsFPtr "primShowsPtr" :: Int -> FunPtr a -> ShowS primitive primEqFPtr "primEqPtr" :: FunPtr a -> FunPtr a -> Bool primitive primCmpFPtr "primCmpPtr" :: FunPtr a -> FunPtr a -> Ordering primitive castFunPtr "primUnsafeCoerce" :: FunPtr a -> FunPtr b primitive castFunPtrToPtr "primUnsafeCoerce" :: FunPtr a -> Ptr b primitive castPtrToFunPtr "primUnsafeCoerce" :: Ptr a -> FunPtr b primitive freeHaskellFunPtr :: FunPtr a -> IO () ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Quote.hs0000644006511100651110000000277710204665427021122 0ustar rossrossmodule Hugs.Quote(Quote, quote, trim) where import Data.List import Data.Ratio(Ratio) class Quote a where quote :: a -> String instance Quote Char where quote c = [c] instance Quote String where quote = id instance Quote Bool where quote = show instance Show a => Quote (Maybe a) where quote = show instance Quote Int where quote = show instance Quote Integer where quote = show instance Quote Float where quote = show instance Quote Double where quote = show instance Integral a => Quote (Ratio a) where quote = show -- trims off leading whitespace up to a common prefix, -- making it easy to layout here docs indented so that -- are not visually confusing (especially if you are doing -- something like using here docs to generate Haskell code) trim s = unlines' ls' where ls = lines' s ls' = map (trimoff 0 n) ls n = case filter (/= 0) $ map (whitecount 0) ls of [] -> 0 xs -> minimum xs -- like the prelude functions, but preserve (lack of) trailing newline lines' s = let (l,s') = break ('\n'==) s in l : case s' of [] -> [] (_:s'') -> lines' s'' unlines' ss = concat $ intersperse "\n" ss whitecount n [] = n whitecount n (' ':cs) = whitecount (n + 1) cs whitecount n ('\t':cs) = whitecount (8 * ((n + 8) `div` 8)) cs whitecount n _ = n trimoff n m [] = [] trimoff n m cs | n >= m = cs trimoff n m (' ' :cs) = trimoff (n + 1) m cs trimoff n m ('\t':cs) = trimoff (8 * ((n + 8) `div` 8)) m cs trimoff n m cs = cs hugs98-plus-Sep2006/libraries/hugsbase/Hugs/ST.hs0000644006511100651110000001075510412462331020334 0ustar rossross----------------------------------------------------------------------------- -- Strict State Thread module -- -- This library provides support for strict state threads, as described -- in the PLDI '94 paper by John Launchbury and Simon Peyton Jones. -- In addition to the monad ST, it also provides mutable variables STRef -- and mutable arrays STArray. -- -- Suitable for use with Hugs 98. ----------------------------------------------------------------------------- module Hugs.ST ( ST(..) , runST , unsafeRunST , RealWorld , stToIO , unsafeIOToST , unsafeSTToIO , STRef -- instance Eq (STRef s a) , newSTRef , readSTRef , writeSTRef , STArray -- instance Eq (STArray s ix elt) , newSTArray , boundsSTArray , readSTArray , writeSTArray , thawSTArray , freezeSTArray , unsafeFreezeSTArray , unsafeReadSTArray , unsafeWriteSTArray ) where import Hugs.Prelude(IO(..)) import Hugs.Array(Array,Ix(index,rangeSize),bounds,elems) import Hugs.IOExts(unsafePerformIO, unsafeCoerce) import Control.Monad ----------------------------------------------------------------------------- -- The ST representation generalizes that of IO (cf. Hugs.Prelude), -- so it can use IO primitives that manipulate local state. newtype ST s a = ST (forall r. (a -> r) -> r) data RealWorld = RealWorld primitive thenStrictST "primbindIO" :: ST s a -> (a -> ST s b) -> ST s b primitive returnST "primretIO" :: a -> ST s a unST :: ST s a -> (a -> r) -> r unST (ST f) = f runST :: (forall s. ST s a) -> a runST m = unST m id unsafeRunST :: ST s a -> a unsafeRunST m = unST m id stToIO :: ST RealWorld a -> IO a stToIO (ST f) = IO f unsafeIOToST :: IO a -> ST s a unsafeIOToST = unsafePerformIO . liftM returnST unsafeSTToIO :: ST s a -> IO a unsafeSTToIO = stToIO . unsafeCoerce instance Functor (ST s) where fmap = liftM instance Monad (ST s) where (>>=) = thenStrictST return = returnST ----------------------------------------------------------------------------- data STRef s a -- implemented as an internal primitive primitive newSTRef "newRef" :: a -> ST s (STRef s a) primitive readSTRef "getRef" :: STRef s a -> ST s a primitive writeSTRef "setRef" :: STRef s a -> a -> ST s () primitive eqSTRef "eqRef" :: STRef s a -> STRef s a -> Bool instance Eq (STRef s a) where (==) = eqSTRef ----------------------------------------------------------------------------- data STArray s ix elt -- implemented as an internal primitive newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt) boundsSTArray :: Ix ix => STArray s ix elt -> (ix, ix) readSTArray :: Ix ix => STArray s ix elt -> ix -> ST s elt writeSTArray :: Ix ix => STArray s ix elt -> ix -> elt -> ST s () thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt) freezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt) unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt) unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e unsafeReadSTArray = primReadArr unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s () unsafeWriteSTArray = primWriteArr newSTArray bs e = primNewArr bs (rangeSize bs) e boundsSTArray a = primBounds a readSTArray a i = unsafeReadSTArray a (index (boundsSTArray a) i) writeSTArray a i e = unsafeWriteSTArray a (index (boundsSTArray a) i) e thawSTArray arr = do stArr <- newSTArray (bounds arr) err sequence_ (zipWith (unsafeWriteSTArray stArr) [0..] (elems arr)) return stArr where err = error "thawArray: element not overwritten" -- shouldnae happen freezeSTArray a = primFreeze a unsafeFreezeSTArray = freezeSTArray -- not as fast as GHC instance Eq (STArray s ix elt) where (==) = eqSTArray primitive primNewArr "IONewArr" :: (a,a) -> Int -> b -> ST s (STArray s a b) primitive primReadArr "IOReadArr" :: STArray s a b -> Int -> ST s b primitive primWriteArr "IOWriteArr" :: STArray s a b -> Int -> b -> ST s () primitive primFreeze "IOFreeze" :: STArray s a b -> ST s (Array a b) primitive primBounds "IOBounds" :: STArray s a b -> (a,a) primitive eqSTArray "IOArrEq" :: STArray s a b -> STArray s a b -> Bool ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Stable.hs0000644006511100651110000000051510204665427021223 0ustar rossrossmodule Hugs.Stable where data StableName a -- abstract primitive makeStableName :: a -> IO (StableName a) primitive deRefStableName :: StableName a -> a primitive hashStableName :: StableName a -> Int primitive eqStableName :: StableName a -> StableName a -> Bool instance Eq (StableName a) where (==) = eqStableName hugs98-plus-Sep2006/libraries/hugsbase/Hugs/StablePtr.hs0000644006511100651110000000064710204665427021717 0ustar rossrossmodule Hugs.StablePtr( StablePtr, module Hugs.StablePtr ) where import Hugs.Prelude( StablePtr, Ptr ) -- recently renamed newStablePtr = makeStablePtr primitive makeStablePtr :: a -> IO (StablePtr a) primitive deRefStablePtr :: StablePtr a -> IO a primitive freeStablePtr :: StablePtr a -> IO () primitive castStablePtrToPtr :: StablePtr a -> Ptr () primitive castPtrToStablePtr :: Ptr () -> StablePtr a hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Storable.hs0000644006511100651110000000747610204665427021601 0ustar rossrossmodule Hugs.Storable where import Hugs.Prelude import Hugs.Ptr (castPtr) {-# CFILES Hugs/Storable_aux.c #-} foreign import ccall unsafe "Storable_aux.h" readIntOffPtr :: Ptr Int -> Int -> IO Int foreign import ccall unsafe "Storable_aux.h" readCharOffPtr :: Ptr Char -> Int -> IO Char foreign import ccall unsafe "Storable_aux.h" readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a) foreign import ccall unsafe "Storable_aux.h" readFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> IO (FunPtr a) foreign import ccall unsafe "Storable_aux.h" readFloatOffPtr :: Ptr Float -> Int -> IO Float foreign import ccall unsafe "Storable_aux.h" readDoubleOffPtr :: Ptr Double -> Int -> IO Double foreign import ccall unsafe "Storable_aux.h" readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a) foreign import ccall unsafe "Storable_aux.h" readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8 foreign import ccall unsafe "Storable_aux.h" readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16 foreign import ccall unsafe "Storable_aux.h" readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32 foreign import ccall unsafe "Storable_aux.h" readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64 foreign import ccall unsafe "Storable_aux.h" readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8 foreign import ccall unsafe "Storable_aux.h" readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16 foreign import ccall unsafe "Storable_aux.h" readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32 foreign import ccall unsafe "Storable_aux.h" readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64 foreign import ccall unsafe "Storable_aux.h" writeIntOffPtr :: Ptr Int -> Int -> Int -> IO () foreign import ccall unsafe "Storable_aux.h" writeCharOffPtr :: Ptr Char -> Int -> Char -> IO () foreign import ccall unsafe "Storable_aux.h" writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO () foreign import ccall unsafe "Storable_aux.h" writeFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> FunPtr a -> IO () foreign import ccall unsafe "Storable_aux.h" writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO () foreign import ccall unsafe "Storable_aux.h" writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO () foreign import ccall unsafe "Storable_aux.h" writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO () foreign import ccall unsafe "Storable_aux.h" writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO () foreign import ccall unsafe "Storable_aux.h" writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO () foreign import ccall unsafe "Storable_aux.h" writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO () foreign import ccall unsafe "Storable_aux.h" writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO () foreign import ccall unsafe "Storable_aux.h" writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO () foreign import ccall unsafe "Storable_aux.h" writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO () foreign import ccall unsafe "Storable_aux.h" writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO () foreign import ccall unsafe "Storable_aux.h" writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO () -- Special treatment for Word: -- it's not a foreign type, but we want an instance of Storable. readWordOffPtr :: Ptr Word -> Int -> IO Word readWordOffPtr p n = do i <- readIntOffPtr (castPtr p) n return (primIntToWord i) writeWordOffPtr :: Ptr Word -> Int -> Word -> IO () writeWordOffPtr p n w = writeIntOffPtr (castPtr p) n (primWordToInt w) primitive primIntToWord :: Int -> Word primitive primWordToInt :: Word -> Int hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Storable_aux.c0000644006511100651110000000076610204665427022261 0ustar rossross#include "Storable_aux.h" #define DEFINE(T) \ void write##T##OffPtr(Hs##T *arg1, HsInt arg2, Hs##T arg3) { arg1[arg2] = arg3; } \ Hs##T read##T##OffPtr(Hs##T *arg1, HsInt arg2) { return arg1[arg2]; } DEFINE(Int ) DEFINE(Char ) DEFINE(Ptr ) DEFINE(FunPtr ) DEFINE(Float ) DEFINE(Double ) DEFINE(StablePtr ) DEFINE(Int8 ) DEFINE(Int16 ) DEFINE(Int32 ) DEFINE(Int64 ) DEFINE(Word8 ) DEFINE(Word16 ) DEFINE(Word32 ) DEFINE(Word64 ) #undef DEFINE hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Storable_aux.h0000644006511100651110000000104010204665427022250 0ustar rossross#ifndef STORABLE_AUX_H #define STORABLE_AUX_H #include "HsFFI.h" #define DECLARE(T) \ void write##T##OffPtr(Hs##T *arg1, HsInt arg2, Hs##T arg3); \ Hs##T read##T##OffPtr(Hs##T *arg1, HsInt arg2); DECLARE(Int ) DECLARE(Char ) DECLARE(Ptr ) DECLARE(FunPtr ) DECLARE(Float ) DECLARE(Double ) DECLARE(StablePtr ) DECLARE(Int8 ) DECLARE(Int16 ) DECLARE(Int32 ) DECLARE(Int64 ) DECLARE(Word8 ) DECLARE(Word16 ) DECLARE(Word32 ) DECLARE(Word64 ) #undef DECLARE #endif /* STORABLE_AUX_H */ hugs98-plus-Sep2006/libraries/hugsbase/Hugs/System.hs0000644006511100651110000000336110204665427021277 0ustar rossross----------------------------------------------------------------------------- -- Standard Library: System operations -- -- Note: on Windows 9x, system always yields ExitSuccess. -- -- Suitable for use with Hugs 98 ----------------------------------------------------------------------------- module Hugs.System ( getArgs, getProgName, withArgs, withProgName, getEnv, system ) where import Hugs.Prelude( ExitCode(..), catchException, throw ) -- In interpretive mode, the initial values of these two are [] and "Hugs", -- but they can be (temporarily) changed using withArgs and withProgName. primitive getArgs "primGetArgs" :: IO [String] primitive getProgName "primGetProgName" :: IO String primitive setArgs "primSetArgs" :: [String] -> IO () primitive setProgName "primSetProgName" :: String -> IO () -- Run an action with a value temporarily overridden -- (a special case of Control.Exception.bracket) with :: IO a -> (a -> IO ()) -> a -> IO b -> IO b with getVal setVal newVal act = do oldVal <- getVal setVal newVal r <- act `catchException` \e -> setVal oldVal >> throw e setVal oldVal return r withArgs :: [String] -> IO a -> IO a withArgs = with getArgs setArgs withProgName :: String -> IO a -> IO a withProgName = with getProgName setProgName primitive getEnv :: String -> IO String system :: String -> IO ExitCode system s = do r <- primSystem s return (toExitCode r) primitive primSystem :: String -> IO Int toExitCode :: Int -> ExitCode toExitCode 0 = ExitSuccess toExitCode n = ExitFailure n ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Time.hs0000644006511100651110000000140610204665427020707 0ustar rossross-- -- Time primitives for Hugs98. -- module Hugs.Time ( getClockTimePrim , toCalTimePrim , toClockTimePrim , getCPUTime -- :: IO Integer , clockTicks -- :: Int ) where primitive getClockTimePrim :: IO (Int,Int) primitive toCalTimePrim :: Int -> Int -> IO (Int,Int,Int,Int,Int,Int,Int,Int,Int,String,Int) primitive toClockTimePrim :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> IO Int picoSec :: Integer picoSec = 1000000000000 -- 10^12 getCPUTime :: IO Integer getCPUTime = do (usec, unsec, ssec, snsec) <- getCPUUsage return (picoSec * fromIntegral usec + 1000 * fromIntegral unsec + picoSec * fromIntegral ssec + 1000 * fromIntegral snsec) primitive getCPUUsage :: IO (Int,Int,Int,Int) primitive clockTicks :: Int hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Trex.hs0000644006511100651110000000351610204665427020737 0ustar rossross----------------------------------------------------------------------------- -- Trex utilities: Functions to compare and show record values -- -- Warning: This file is an integral part of the TREX implementation, and -- should not be modified without corresponding changes in the interpreter. -- -- Suitable for use with Hugs 98, if compiled with TREX support. ----------------------------------------------------------------------------- module Hugs.Trex( Rec, emptyRec, EmptyRow, ShowRecRow(..), EqRecRow(..), insertField ) where import Hugs.Prelude ( Rec, emptyRec, EmptyRow ) -- Code for equalities: instance EqRecRow r => Eq (Rec r) where r == s = eqFields (eqRecRow r s) where eqFields = and . map snd class EqRecRow r where eqRecRow :: Rec r -> Rec r -> [(String,Bool)] instance EqRecRow EmptyRow where eqRecRow _ _ = [] -- Code for showing values: instance ShowRecRow r => Show (Rec r) where showsPrec d = showFields . showRecRow where showFields :: [(String, ShowS)] -> ShowS showFields [] = showString "emptyRec" showFields xs = showChar '(' . foldr1 comma (map fld xs) . showChar ')' where comma a b = a . showString ", " . b fld (s,v) = showString s . showString " = " . v class ShowRecRow r where showRecRow :: Rec r -> [(String, ShowS)] instance ShowRecRow EmptyRow where showRecRow _ = [] -- General utility: insertField :: String -> v -> [(String, v)] -> [(String, v)] insertField n v fs = {- case fs of [] -> [(n,v)] (r:rs) -> if n <= fst r then (n,v):fs else r : insertField n v rs -} bef ++ [(n,v)] ++ aft where (bef,aft) = span (\r -> n > fst r) fs ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Weak.hs0000644006511100651110000000366110204665427020705 0ustar rossross-- A first cut at implementing the (key,value) form of Weak pointers. -- -- Notes (please refer to the draft specification for background): -- -- - Programmers using weak pointers should call runFinalizer at -- regular intervals to ensure that finalizers are scheduled for -- execution. This implementation provides functions runFinalizer, -- finalizerWaiting, and runAllFinalizers to provide programmers with -- control over the execution of finalizers. None of these functions -- are part of the current specification. -- -- Tested with Hugs 98. module Hugs.Weak(Weak, mkWeak, deRefWeak, finalize, replaceFinalizer, runFinalizer, finalizerWaiting, runAllFinalizers ) where data Weak a primitive mkWeak :: k -> v -> Maybe (IO ()) -> IO (Weak v) primitive deRefWeak :: Weak v -> IO (Maybe v) primitive replaceFinalizer :: Weak v -> Maybe (IO ()) -> IO (Maybe (IO ())) primitive finalize :: Weak v -> IO () primitive weakPtrEq :: Weak a -> Weak a -> Bool instance Eq (Weak a) where (==) = weakPtrEq primitive runFinalizer :: IO () primitive finalizerWaiting :: IO Bool runAllFinalizers :: IO () runAllFinalizers = do waiting <- finalizerWaiting if waiting then do runFinalizer runAllFinalizers else return () {- for testing purposes primitive gc "primGC" :: IO () -- not a CAF! test z = do { let k = [z] -- use a list so we're sure it's heap allocated ; print k -- this makes sure x is in whnf ; w <- mkWeak k "value" (Just (putStrLn ("Finalizer for "++show k))) -- note that the finalizer uses the key, but -- this shouldn't keep the weak ptr alive! ; showWeakPtr w ; gc ; print k -- this makes sure k is still alive after the GC ; showWeakPtr w -- so it's probably still alive here ; gc ; showWeakPtr w -- but ought to be dead by here } showWeakPtr :: Show a => Weak a -> IO () showWeakPtr w = do { x <- deRefWeak w ; print x } -} -- End of module Weak hugs98-plus-Sep2006/libraries/hugsbase/Hugs/Word.hs0000644006511100651110000003604310227457077020736 0ustar rossross----------------------------------------------------------------------------- -- Unsigned Integers -- Suitable for use with Hugs 98 on 32 bit systems. ----------------------------------------------------------------------------- module Hugs.Word ( Word , Word8 , Word16 , Word32 , Word64 ) where import Hugs.Prelude ( Word, Word8, Word16, Word32, Word64, boundedSucc, boundedPred, boundedEnumFrom, boundedEnumFromTo, boundedEnumFromThen, boundedEnumFromThenTo ) import Hugs.Prelude ( Ix(..) ) import Hugs.Prelude ( (%) ) import Hugs.Prelude ( readDec ) import Hugs.Prelude ( Num(fromInt), Integral(toInt) ) import Hugs.Numeric ( showInt ) import Data.Bits import Data.Int ----------------------------------------------------------------------------- -- Word ----------------------------------------------------------------------------- instance Eq Word where (==) = primEqWord instance Ord Word where compare = primCmpWord instance Num Word where (+) = primPlusWord (-) = primMinusWord negate = primNegateWord (*) = primMulWord abs = absReal signum = signumReal fromInteger = primIntegerToWord fromInt = primIntToWord instance Bounded Word where minBound = 0 maxBound = primMaxWord instance Real Word where toRational x = toInteger x % 1 instance Integral Word where div = primDivWord quot = primQuotWord rem = primRemWord mod = primModWord quotRem = primQrmWord divMod = quotRem toInteger = primWordToInteger toInt = primWordToInt instance Ix Word where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Word where succ = boundedSucc pred = boundedPred toEnum = primIntToWord fromEnum = primWordToInt enumFrom = boundedEnumFrom enumFromTo = boundedEnumFromTo enumFromThen = boundedEnumFromThen enumFromThenTo = boundedEnumFromThenTo instance Read Word where readsPrec p = readDec instance Show Word where showsPrec p = showInt -- a particularily counterintuitive name! instance Bits Word where (.&.) = primAndWord (.|.) = primOrWord xor = primXorWord complement = primComplementWord shift = primShiftWord rotate = primRotateWord (bitSize (0::Word)) bit = primBitWord setBit x i = x .|. bit i clearBit x i = x .&. complement (bit i) complementBit x i = x `xor` bit i testBit = primTestWord bitSize _ = bitSize (0::Int) isSigned _ = False ----------------------------------------------------------------------------- -- Word8 ----------------------------------------------------------------------------- instance Eq Word8 where (==) = binop (==) instance Ord Word8 where compare = binop compare instance Num Word8 where x + y = to (binop (+) x y) x - y = to (binop (-) x y) negate = to . negate . from x * y = to (binop (*) x y) abs = absReal signum = signumReal fromInteger = to . primIntegerToWord fromInt = to . primIntToWord instance Bounded Word8 where minBound = 0 maxBound = 0xff instance Real Word8 where toRational x = toInteger x % 1 instance Integral Word8 where x `div` y = to (binop div x y) x `quot` y = to (binop quot x y) x `rem` y = to (binop rem x y) x `mod` y = to (binop mod x y) x `quotRem` y = to2 (binop quotRem x y) divMod = quotRem toInteger = toInteger . from toInt = toInt . from instance Ix Word8 where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Word8 where succ = boundedSucc pred = boundedPred toEnum = fromInt fromEnum = toInt enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Read Word8 where readsPrec p = readDec instance Show Word8 where showsPrec p = showInt -- a particularily counterintuitive name! instance Bits Word8 where x .&. y = to (binop (.&.) x y) x .|. y = to (binop (.|.) x y) x `xor` y = to (binop xor x y) complement = to . complement . from x `shift` i = to (from x `shift` i) x `rotate` i = to (from x `rot` i) where rot = primRotateWord 8 bit = to . bit setBit x i = to (setBit (from x) i) clearBit x i = to (clearBit (from x) i) complementBit x i = to (complementBit (from x) i) testBit x i = testBit (from x) i bitSize _ = 8 isSigned _ = False ----------------------------------------------------------------------------- -- Word16 ----------------------------------------------------------------------------- instance Eq Word16 where (==) = binop (==) instance Ord Word16 where compare = binop compare instance Num Word16 where x + y = to (binop (+) x y) x - y = to (binop (-) x y) negate = to . negate . from x * y = to (binop (*) x y) abs = absReal signum = signumReal fromInteger = to . primIntegerToWord fromInt = to . primIntToWord instance Bounded Word16 where minBound = 0 maxBound = 0xffff instance Real Word16 where toRational x = toInteger x % 1 instance Integral Word16 where x `div` y = to (binop div x y) x `quot` y = to (binop quot x y) x `rem` y = to (binop rem x y) x `mod` y = to (binop mod x y) x `quotRem` y = to2 (binop quotRem x y) divMod = quotRem toInteger = toInteger . from toInt = toInt . from instance Ix Word16 where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Word16 where succ = boundedSucc pred = boundedPred toEnum = fromInt fromEnum = toInt enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Read Word16 where readsPrec p = readDec instance Show Word16 where showsPrec p = showInt -- a particularily counterintuitive name! instance Bits Word16 where x .&. y = to (binop (.&.) x y) x .|. y = to (binop (.|.) x y) x `xor` y = to (binop xor x y) complement = to . complement . from x `shift` i = to (from x `shift` i) x `rotate` i = to (from x `rot` i) where rot = primRotateWord 16 bit = to . bit setBit x i = to (setBit (from x) i) clearBit x i = to (clearBit (from x) i) complementBit x i = to (complementBit (from x) i) testBit x i = testBit (from x) i bitSize _ = 16 isSigned _ = False ----------------------------------------------------------------------------- -- Word32 ----------------------------------------------------------------------------- instance Eq Word32 where (==) = binop (==) instance Ord Word32 where compare = binop compare instance Num Word32 where x + y = to (binop (+) x y) x - y = to (binop (-) x y) negate = to . negate . from x * y = to (binop (*) x y) abs = absReal signum = signumReal fromInteger = to . primIntegerToWord fromInt = to . primIntToWord instance Bounded Word32 where minBound = 0 maxBound = 0xffffffff instance Real Word32 where toRational x = toInteger x % 1 instance Integral Word32 where x `div` y = to (binop div x y) x `quot` y = to (binop quot x y) x `rem` y = to (binop rem x y) x `mod` y = to (binop mod x y) x `quotRem` y = to2 (binop quotRem x y) divMod = quotRem toInteger = toInteger . from toInt = toInt . from instance Ix Word32 where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Word32 where succ = boundedSucc pred = boundedPred toEnum = fromInt fromEnum = toInt enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen enumFromTo = boundedEnumFromTo enumFromThenTo = boundedEnumFromThenTo instance Read Word32 where readsPrec p = readDec instance Show Word32 where showsPrec p = showInt -- a particularily counterintuitive name! instance Bits Word32 where x .&. y = to (binop (.&.) x y) x .|. y = to (binop (.|.) x y) x `xor` y = to (binop xor x y) complement = to . complement . from x `shift` i = to (from x `shift` i) x `rotate` i = to (from x `rot` i) where rot = primRotateWord 32 bit = to . bit setBit x i = to (setBit (from x) i) clearBit x i = to (clearBit (from x) i) complementBit x i = to (complementBit (from x) i) testBit x i = testBit (from x) i bitSize _ = 32 isSigned _ = False ----------------------------------------------------------------------------- -- Word64 ----------------------------------------------------------------------------- primitive word64ToWord32 "primWord64ToWord32" :: Word64 -> (Word32,Word32) primitive word32ToWord64 "primWord32ToWord64" :: Word32 -> Word32 -> Word64 integerToW64 :: Integer -> Word64 integerToW64 x = case x `divMod` 0x100000000 of (hi,lo) -> word32ToWord64 (fromInteger hi) (fromInteger lo) w64ToInteger :: Word64 -> Integer w64ToInteger x = case word64ToWord32 x of (hi,lo) -> toInteger hi * 0x100000000 + toInteger lo instance Eq Word64 where x == y = word64ToWord32 x == word64ToWord32 y instance Ord Word64 where compare x y = compare (word64ToWord32 x) (word64ToWord32 y) instance Bounded Word64 where minBound = word32ToWord64 minBound minBound maxBound = word32ToWord64 maxBound maxBound instance Show Word64 where showsPrec p = showInt . toInteger instance Read Word64 where readsPrec p s = [ (fromInteger x,r) | (x,r) <- readDec s ] instance Num Word64 where x + y = fromInteger (toInteger x + toInteger y) x - y = fromInteger (toInteger x - toInteger y) x * y = fromInteger (toInteger x * toInteger y) abs = absReal signum = signumReal fromInteger = integerToW64 instance Real Word64 where toRational x = toInteger x % 1 instance Ix Word64 where range (m,n) = [m..n] unsafeIndex (m,_) i = toInt (i - m) inRange (m,n) i = m <= i && i <= n instance Enum Word64 where succ = boundedSucc pred = boundedPred toEnum = fromInt fromEnum = toInt enumFrom x = enumFromTo x maxBound enumFromTo x y = map fromInteger [toInteger x .. toInteger y] enumFromThen = boundedEnumFromThen enumFromThenTo x y z = map fromInteger [toInteger x, toInteger y .. toInteger z] instance Integral Word64 where x `quotRem` y = (fromInteger q, fromInteger r) where (q,r) = toInteger x `quotRem` toInteger y toInteger = w64ToInteger instance Bits Word64 where x .&. y = liftBinary (.&.) x y x .|. y = liftBinary (.|.) x y x `xor` y = liftBinary xor x y complement = liftUnary complement x `shift` i = fromInteger ((toInteger x `shift` i) `mod` 0x10000000000000000) x `rotate` i | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x)) | i==0 = x | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x)) bit i | i `mod` 64 < 32 = word32ToWord64 0 (bit i) | otherwise = word32ToWord64 (bit i) 0 bitSize _ = 64 isSigned _ = False liftBinary :: (Word32 -> Word32 -> Word32) -> Word64 -> Word64 -> Word64 liftBinary op x y = word32ToWord64 (op xhi yhi) (op xlo ylo) where (xhi,xlo) = word64ToWord32 x (yhi,ylo) = word64ToWord32 y liftUnary :: (Word32 -> Word32) -> Word64 -> Word64 liftUnary op x = word32ToWord64 (op xhi) (op xlo) where (xhi,xlo) = word64ToWord32 x ----------------------------------------------------------------------------- -- End of exported definitions -- -- The remainder of this file consists of definitions which are only -- used in the implementation. ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- Coercions - used to make the instance declarations more uniform ----------------------------------------------------------------------------- primitive word8ToWord "primWord8ToWord" :: Word8 -> Word primitive wordToWord8 "primWordToWord8" :: Word -> Word8 primitive word16ToWord "primWord16ToWord" :: Word16 -> Word primitive wordToWord16 "primWordToWord16" :: Word -> Word16 primitive word32ToWord "primWord32ToWord" :: Word32 -> Word primitive wordToWord32 "primWordToWord32" :: Word -> Word32 class Coerce a where to :: Word -> a from :: a -> Word instance Coerce Word8 where from = word8ToWord to = wordToWord8 instance Coerce Word16 where from = word16ToWord to = wordToWord16 instance Coerce Word32 where from = word32ToWord to = wordToWord32 binop :: Coerce word => (Word -> Word -> a) -> (word -> word -> a) binop op x y = from x `op` from y to2 :: Coerce word => (Word, Word) -> (word, word) to2 (x,y) = (to x, to y) ----------------------------------------------------------------------------- -- primitives ----------------------------------------------------------------------------- primitive primEqWord :: Word -> Word -> Bool primitive primCmpWord :: Word -> Word -> Ordering primitive primPlusWord, primMinusWord, primMulWord :: Word -> Word -> Word primitive primNegateWord :: Word -> Word primitive primIntToWord :: Int -> Word primitive primIntegerToWord :: Integer -> Word primitive primMaxWord :: Word primitive primDivWord, primQuotWord, primRemWord, primModWord :: Word -> Word -> Word primitive primQrmWord :: Word -> Word -> (Word,Word) primitive primWordToInt :: Word -> Int primitive primWordToInteger :: Word -> Integer primitive primAndWord :: Word -> Word -> Word primitive primOrWord :: Word -> Word -> Word primitive primXorWord :: Word -> Word -> Word primitive primComplementWord:: Word -> Word primitive primShiftWord :: Word -> Int -> Word primitive primRotateWord :: Int -> Word -> Int -> Word primitive primBitWord :: Int -> Word primitive primTestWord :: Word -> Int -> Bool ----------------------------------------------------------------------------- -- Code copied from the Prelude ----------------------------------------------------------------------------- absReal x | x >= 0 = x | otherwise = -x signumReal x | x == 0 = 0 | x > 0 = 1 | otherwise = -1 ----------------------------------------------------------------------------- -- End ----------------------------------------------------------------------------- hugs98-plus-Sep2006/libraries/hugsbase/Hugs.hs0000644006511100651110000000011210305333727017777 0ustar rossross-- Empty module to serve as the default current module. module Hugs where hugs98-plus-Sep2006/libraries/hugsbase/hugsbase.cabal0000644006511100651110000000133110305333727021326 0ustar rossrossname: hugsbase version: 1.0 build-depends: license: BSD3 maintainer: homepage: http://www.haskell.org/hugs/ synopsis: Internal modules for Hugs stability: internal exposed-modules: Hugs, Hugs.Array, Hugs.Bits, Hugs.ByteArray, Hugs.CVHAssert, Hugs.Char, Hugs.ConcBase, Hugs.Directory, Hugs.Dynamic, Hugs.Exception, Hugs.ForeignPtr, Hugs.GenericPrint, Hugs.IO, Hugs.IOArray, Hugs.IOExts, Hugs.IORef, Hugs.Int, Hugs.Internals, Hugs.LazyST, Hugs.Memo, Hugs.Numeric, Hugs.Observe, Hugs.Prelude, Hugs.Ptr, Hugs.Quote, Hugs.ST, Hugs.Stable, Hugs.StablePtr, Hugs.Storable, Hugs.System, Hugs.Time, Hugs.Trex, Hugs.Weak, Hugs.Word c-sources: Hugs/Storable_aux.c include-dirs: Hugs hugs98-plus-Sep2006/libraries/Makefile.in0000644006511100651110000001543710466666603017033 0ustar rossross# @configure_input@ ################################################################ # Conversion of libraries from raw sources in the packages tree # (this should be a POSIX 1003.2-1992 Makefile) ################################################################ @MkDefs@ # We use the autoconf-supplied install-sh to create directories # but use /bin/cp to copy data because install-sh can't copy # multiple files at once. INSTALL = ../install-sh INSTALL_DATA = /bin/cp CPPFLAGS = -D__HUGS__ -D$(HOST_OS)_HOST_OS -D$(HOST_OS)_TARGET_OS BUILD_DIR = ../hugsdir HEADERS = ../src/HsFFI.h FP_HEADERS = ../src/platform.h include/MachDeps.h include/ghcconfig.h CPPHS_SRC = ../cpphs HSC2HS_SRC = ../hsc2hs # set the path both for runhugs and any ffihugs invoked by Cabal # HUGSDIR gives the location of HsFFI.h HUGS_SETUP = HUGSFLAGS=-P../libraries/bootlib HUGSDIR=../hugsdir ../src/runhugs -98 ../packages/Cabal/examples/hapax.hs INCLUDES = $(BUILD_DIR)/include/HsFFI.h # represents header files used by the base, network and unix packages FP_INCLUDES = ../ghc/includes/ghcconfig.h # We use a bootstrap procedure to construct the libraries: # # 1. Preprocess hugsbase, base, haskell98 and Cabal into bootlibs # using the shell script make_bootlib. The result is incomplete, # in particular because hsc2hs wasn't available yet, but it's enough # to get ffihugs, runhugs, cpphs, hsc2hs and Cabal working, # # 2. Build cpphs and then hsc2hs into ../hugsdir. # # 3. Build all the packages into ../hugsdir, using cpphs, hsc2hs and Cabal. # # Unfortunately that means building (and configuring) base twice. CPPHS = tools/cpphs HSC2HS = tools/hsc2hs CPPHS_FILE = $(CPPHS)$(BAT) HSC2HS_FILE = $(HSC2HS)$(BAT) MAKE_BOOT = tools/make_bootlib CONVERT = tools/convert_libraries MAKE_OLDLIB = tools/make_oldlib BOOTLIB = bootlib/.stamp LIBS = $(BUILD_DIR)/.stamp all: $(LIBS) $(LIBS): $(BOOTLIB) $(INCLUDES) $(CPPHS_FILE) $(HSC2HS_FILE) $(CONVERT) $(MAKE_OLDLIB) cd ..; HOST='$(HOST)' PREFIX='$(prefix)' libraries/$(CONVERT) fptools hugsdir $(RM) -r $(BUILD_DIR)/oldlib cd ..; libraries/$(MAKE_OLDLIB) fptools hugsdir echo timestamp for libraries >$@ $(HSC2HS): $(BUILD_DIR)/programs/hsc2hs/Main.hs (echo '#! /bin/sh'; \ echo "rootdir='`cd ..; pwd`'"; \ echo '$$rootdir/src/runhugs -98 -P$$rootdir/libraries/bootlib $$rootdir/hugsdir/programs/hsc2hs/Main.hs -I$$rootdir/hugsdir/include -t$$rootdir/hsc2hs/template-hsc.h "$$@"') >$@ chmod 755 $@ $(HSC2HS).bat: $(BUILD_DIR)/programs/hsc2hs/Main.hs (echo '@echo off'; \ echo "set rootdir=`cd ..; src/runhugs -Plibraries/bootlib libraries/pwd.hs`"; \ echo '%rootdir%/src/runhugs -98 -P%rootdir%/libraries/bootlib %rootdir%/hugsdir/programs/hsc2hs/Main.hs -I%rootdir%/hugsdir/include -t%rootdir%/hsc2hs/template-hsc.h %*') >$@ $(BUILD_DIR)/programs/hsc2hs/Main.hs: $(HSC2HS_SRC)/Main.hs $(BOOTLIB) $(INCLUDES) $(CPPHS_FILE) cd $(HSC2HS_SRC); $(HUGS_SETUP) configure --verbose --hugs --prefix='$(prefix)' --scratchdir='$(BUILD_DIR)' --with-compiler=../src/ffihugs --with-cpphs='../libraries/tools/cpphs$(BAT)' cd $(HSC2HS_SRC); $(HUGS_SETUP) build --verbose $(RM) -r $(BUILD_DIR)/autogen $(CPPHS): $(BUILD_DIR)/programs/cpphs/Main.hs (echo '#! /bin/sh'; \ echo "rootdir='`cd ..; pwd`'"; \ echo '$$rootdir/src/runhugs -P$$rootdir/libraries/bootlib $$rootdir/hugsdir/programs/cpphs/Main.hs "$$@"') >$@ chmod 755 $@ $(CPPHS).bat: $(BUILD_DIR)/programs/cpphs/Main.hs (echo '@echo off'; \ echo "set rootdir=`cd ..; src/runhugs -Plibraries/bootlib libraries/pwd.hs`"; \ echo '%rootdir%/src/runhugs -P%rootdir%/libraries/bootlib %rootdir%/hugsdir/programs/cpphs/Main.hs %*') >$@ $(BUILD_DIR)/programs/cpphs/Main.hs: $(BOOTLIB) $(INCLUDES) cd $(CPPHS_SRC); $(HUGS_SETUP) configure --verbose --hugs --prefix='$(prefix)' --scratchdir='$(BUILD_DIR)/packages/cpphs' --with-compiler=../src/ffihugs cd $(CPPHS_SRC); $(HUGS_SETUP) build --verbose $(RM) -r $(BUILD_DIR)/packages/cpphs/autogen mkdir -p $(BUILD_DIR)/programs mv $(BUILD_DIR)/packages/cpphs/programs/cpphs $(BUILD_DIR)/programs rmdir $(BUILD_DIR)/packages/cpphs/programs $(BOOTLIB): hugsbase/Hugs/*.* $(MAKE_BOOT) $(INCLUDES) $(FP_INCLUDES) CPPFLAGS='$(CPPFLAGS)' $(MAKE_BOOT) echo timestamp for bootlib >$@ $(INCLUDES): $(HEADERS) mkdir -p $(BUILD_DIR)/include $(CP) $(HEADERS) $(BUILD_DIR)/include $(FP_INCLUDES): $(FP_HEADERS) mkdir -p ../ghc/includes $(CP) $(FP_HEADERS) ../ghc/includes clean: $(RM) LibStatus $(RM) a.out $(RM) *~ $(RM) -r bootlib $(RM) hugsbase/.installed-pkg-config $(RM) ../cpphs/.installed-pkg-config $(RM) ../packages/*/.installed-pkg-config find ../packages -name \*.hsc | sed 's/c$$//' | xargs $(RM) $(RM) -r ../ghc/includes # package configuration is part of the build process, so clean it here $(RM) hugsbase/.setup-config $(RM) ../cpphs/.setup-config $(RM) ../hsc2hs/.setup-config $(RM) ../packages/*/.setup-config $(RM) ../packages/*/config.log $(RM) ../packages/*/config.status $(RM) -r ../packages/*/autom4te.cache find ../packages -name \*.in | sed 's/\.in$$//' | xargs $(RM) distclean: clean $(RM) $(HSC2HS_FILE) $(RM) $(CPPHS_FILE) $(RM) -r $(BUILD_DIR) $(RM) Makefile tools/config include/ghcconfig.h $(RM) config.log config.status $(RM) -r autom4te.cache veryclean: distclean install: all $(INSTALL) -d $(DESTDIR)$(hugsdir)/include $(INSTALL_DATA) $(BUILD_DIR)/include/* $(DESTDIR)$(hugsdir)/include $(INSTALL) -d $(DESTDIR)$(hugsdir)/oldlib $(INSTALL_DATA) $(BUILD_DIR)/oldlib/* $(DESTDIR)$(hugsdir)/oldlib (cd $(BUILD_DIR); find packages -type f -print) | while read file;\ do dir=`dirname $$file`;\ case $$file in \ *.c) ;;\ *) \ $(INSTALL) -d $(DESTDIR)$(hugsdir)/$$dir;\ $(INSTALL) -c -m 0644 $(BUILD_DIR)/$$file $(DESTDIR)$(hugsdir)/$$file;;\ esac;\ done (cd $(BUILD_DIR); find demos -type f -print) | while read file;\ do dir=`dirname $$file`;\ $(INSTALL) -d $(DESTDIR)$(hugsdir)/$$dir;\ $(INSTALL) -c -m 0644 $(BUILD_DIR)/$$file $(DESTDIR)$(hugsdir)/$$file;\ done (cd $(BUILD_DIR); find programs -type f -print) | while read file;\ do dir=`dirname $$file`;\ $(INSTALL) -d $(DESTDIR)$(hugsdir)/$$dir;\ $(INSTALL) -c -m 0644 $(BUILD_DIR)/$$file $(DESTDIR)$(hugsdir)/$$file;\ done (echo '#! /bin/sh'; \ echo 'runhugs $(hugsdir)/programs/cpphs/Main.hs "$$@"') >$(DESTDIR)$(bindir)/cpphs-hugs chmod 755 $(DESTDIR)$(bindir)/cpphs-hugs # install template file where hsc2hs-hugs expects to find it hsc2hs_data=`sed -n 's/^datadir *= "\(.*\)"/\1/p' $(BUILD_DIR)/programs/hsc2hs/Paths_hsc2hs.hs`; \ $(INSTALL) -d $(DESTDIR)$$hsc2hs_data; \ $(INSTALL) -c -m 0644 ../hsc2hs/template-hsc.h $(DESTDIR)$$hsc2hs_data/template-hsc.h (echo '#! /bin/sh'; \ echo 'runhugs -98 $(hugsdir)/programs/hsc2hs/Main.hs -I$(hugsdir)/include "$$@"') >$(DESTDIR)$(bindir)/hsc2hs-hugs chmod 755 $(DESTDIR)$(bindir)/hsc2hs-hugs LibStatus: $(LIBS) tools/test_libraries ../packages >$@ hugs98-plus-Sep2006/libraries/aclocal.m40000644006511100651110000000626610313644440016610 0ustar rossross# FP_COMPUTE_INT(EXPRESSION, VARIABLE, INCLUDES, IF-FAILS) # -------------------------------------------------------- # Assign VARIABLE the value of the compile-time EXPRESSION using INCLUDES for # compilation. Execute IF-FAILS when unable to determine the value. Works for # cross-compilation, too. # # Implementation note: We are lazy and use an internal autoconf macro, but it # is supported in autoconf versions 2.50 up to the actual 2.57, so there is # little risk. AC_DEFUN([FP_COMPUTE_INT], [_AC_COMPUTE_INT([$1], [$2], [$3], [$4])[]dnl ])# FP_COMPUTE_INT # FP_CHECK_ALIGNMENT(TYPE, [IGNORED], [INCLUDES = DEFAULT-INCLUDES]) # ------------------------------------------------------------------ # A variation of AC_CHECK_SIZEOF for computing the alignment restrictions of a # given type. Defines ALIGNMENT_TYPE. AC_DEFUN([FP_CHECK_ALIGNMENT], [AS_LITERAL_IF([$1], [], [AC_FATAL([$0: requires literal arguments])])[]dnl AC_CHECK_TYPE([$1], [], [], [$3])[]dnl m4_pushdef([fp_Cache], [AS_TR_SH([fp_cv_alignment_$1])])[]dnl AC_CACHE_CHECK([alignment of $1], [fp_Cache], [if test "$AS_TR_SH([ac_cv_type_$1])" = yes; then FP_COMPUTE_INT([(long) (&((struct { char c; $1 ty; } *)0)->ty)], [fp_Cache], [AC_INCLUDES_DEFAULT([$3])], [AC_MSG_ERROR([cannot compute alignment ($1) See `config.log' for more details.], [77])]) else fp_Cache=0 fi])[]dnl AC_DEFINE_UNQUOTED(AS_TR_CPP(alignment_$1), $fp_Cache, [The alignment of a `$1'.])[]dnl m4_popdef([fp_Cache])[]dnl ])# FP_CHECK_ALIGNMENT # FP_CHECK_PROG(VARIABLE, PROG-TO-CHECK-FOR, # [VALUE-IF-NOT-FOUND], [PATH], [REJECT]) # ----------------------------------------------------- # HACK: A small wrapper around AC_CHECK_PROG, setting VARIABLE to the full path # of PROG-TO-CHECK-FOR when found. AC_DEFUN([FP_CHECK_PROG], [AC_CHECK_PROG([$1], [$2], [$as_dir/$ac_word$ac_exec_ext], [$3], [$4], [$5])][]dnl )# FP_CHECK_PROC # FP_PROG_FIND # ------------ # Find a non-WinDoze version of the "find" utility. AC_DEFUN([FP_PROG_FIND], [AC_PATH_PROG([fp_prog_find], [find]) echo foo > conftest.txt $fp_prog_find conftest.txt -print > conftest.out 2>&1 if grep '^conftest.txt$' conftest.out > /dev/null 2>&1 ; then # OK, looks like a real "find". FindCmd="$fp_prog_find" else # Found a poor WinDoze version of "find", ignore it. AC_MSG_WARN([$fp_prog_find looks like a non-*nix find, ignoring it]) FP_CHECK_PROG([FindCmd], [find], [], [], [$fp_prog_find]) fi rm -f conftest.txt conftest.out AC_SUBST([FindCmd])[]dnl ])# FP_PROG_FIND # FP_PROG_SORT # ------------ # Find a non-WinDoze version of the "sort" utility. AC_DEFUN([FP_PROG_SORT], [AC_PATH_PROG([fp_prog_sort], [sort]) echo foo > conftest.txt $fp_prog_sort -u conftest.txt > conftest.out 2>&1 if grep '^foo$' conftest.out > /dev/null 2>&1 ; then # OK, looks like a real "sort". SortCmd="$fp_prog_sort" else # Found a poor WinDoze version of "sort", ignore it. AC_MSG_WARN([$fp_prog_sort looks like a non-*nix sort, ignoring it]) FP_CHECK_PROG([SortCmd], [sort], [], [], [$fp_prog_sort]) fi rm -f conftest.txt conftest.out AC_SUBST([SortCmd])[]dnl ])# FP_PROG_SORT dnl External macros builtin([include],../ac_macros/ice_prog_cpp_traditional.m4) hugs98-plus-Sep2006/libraries/configure.ac0000644006511100651110000000530510473312506017231 0ustar rossrossdnl-------------------------------------------------------------------- dnl dnl Hugs98 libraries configure script template. dnl Process ../configure.ac with autoreconf to produce a configure script. dnl dnl-------------------------------------------------------------------- AC_INIT([Hugs98 libraries], [1.0], [hugs-bugs@haskell.org], [hugslibs]) AC_CONFIG_SRCDIR([include/MachDeps.h]) dnl We need 2.50 for AC_HELP_STRING. AC_PREREQ([2.50]) dnl Named to match the fptools configuration header file AC_CONFIG_HEADER(include/ghcconfig.h) AH_TOP([/* platform-specific defines */ #include "platform.h"]) # necessary evil AC_CONFIG_COMMANDS([ultra-evil], [echo ' #undef PACKAGE_BUGREPORT #undef PACKAGE_NAME #undef PACKAGE_STRING #undef PACKAGE_TARNAME #undef PACKAGE_VERSION' >>include/ghcconfig.h]) dnl -------------------------------------------------- dnl ### program checking ### dnl -------------------------------------------------- AC_PROG_CC AC_PROG_GCC_TRADITIONAL dnl ** figure out how to invoke cpp directly (gcc -E is no good) AC_PROG_CPP ICE_PROG_CPP_TRADITIONAL AC_PROG_MAKE_SET dnl Look for right versions of 'find' and 'sort' (win32 only, really.) FP_PROG_FIND FP_PROG_SORT dnl-------------------------------------------------------------------- dnl ### types dnl-------------------------------------------------------------------- dnl ** do we have long longs? AC_CHECK_TYPES([long long]) dnl ** what are the sizes of various types AC_CHECK_SIZEOF(char, 1) AC_CHECK_SIZEOF(double, 8) AC_CHECK_SIZEOF(float, 4) AC_CHECK_SIZEOF(int, 4) AC_CHECK_SIZEOF(long, 4) if test "$ac_cv_type_long_long" = yes; then AC_CHECK_SIZEOF(long long, 8) fi AC_CHECK_SIZEOF(short, 2) AC_CHECK_SIZEOF(unsigned char, 1) AC_CHECK_SIZEOF(unsigned int, 4) AC_CHECK_SIZEOF(unsigned long, 4) if test "$ac_cv_type_long_long" = yes; then AC_CHECK_SIZEOF(unsigned long long, 8) fi AC_CHECK_SIZEOF(unsigned short, 2) AC_CHECK_SIZEOF(void *, 4) dnl ** what are alignment constraints on various types FP_CHECK_ALIGNMENT(char) FP_CHECK_ALIGNMENT(double) FP_CHECK_ALIGNMENT(float) FP_CHECK_ALIGNMENT(int) FP_CHECK_ALIGNMENT(long) if test "$ac_cv_type_long_long" = yes; then FP_CHECK_ALIGNMENT(long long) fi FP_CHECK_ALIGNMENT(short) FP_CHECK_ALIGNMENT(unsigned char) FP_CHECK_ALIGNMENT(unsigned int) FP_CHECK_ALIGNMENT(unsigned long) if test "$ac_cv_type_long_long" = yes; then FP_CHECK_ALIGNMENT(unsigned long long) fi FP_CHECK_ALIGNMENT(unsigned short) FP_CHECK_ALIGNMENT(void *) dnl Definitions computed by ../configure, for insertion into Makefile MkDefs=../MkDefs AC_SUBST_FILE(MkDefs) AC_CONFIG_FILES(Makefile tools/config) AC_OUTPUT hugs98-plus-Sep2006/libraries/pwd.hs0000644006511100651110000000016310271556245016074 0ustar rossross-- print the current directory module Main where import System.Directory main = getCurrentDirectory >>= putStrLn hugs98-plus-Sep2006/libraries/include/0000755006511100651110000000000010504340731016357 5ustar rossrosshugs98-plus-Sep2006/libraries/include/ghcconfig.h.in0000644006511100651110000000633710504340731021075 0ustar rossross/* include/ghcconfig.h.in. Generated from configure.ac by autoheader. */ /* platform-specific defines */ #include "platform.h" /* The alignment of a `char'. */ #undef ALIGNMENT_CHAR /* The alignment of a `double'. */ #undef ALIGNMENT_DOUBLE /* The alignment of a `float'. */ #undef ALIGNMENT_FLOAT /* The alignment of a `int'. */ #undef ALIGNMENT_INT /* The alignment of a `long'. */ #undef ALIGNMENT_LONG /* The alignment of a `long long'. */ #undef ALIGNMENT_LONG_LONG /* The alignment of a `short'. */ #undef ALIGNMENT_SHORT /* The alignment of a `unsigned char'. */ #undef ALIGNMENT_UNSIGNED_CHAR /* The alignment of a `unsigned int'. */ #undef ALIGNMENT_UNSIGNED_INT /* The alignment of a `unsigned long'. */ #undef ALIGNMENT_UNSIGNED_LONG /* The alignment of a `unsigned long long'. */ #undef ALIGNMENT_UNSIGNED_LONG_LONG /* The alignment of a `unsigned short'. */ #undef ALIGNMENT_UNSIGNED_SHORT /* The alignment of a `void *'. */ #undef ALIGNMENT_VOID_P /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if the system has the type `long long'. */ #undef HAVE_LONG_LONG /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* The size of `char', as computed by sizeof. */ #undef SIZEOF_CHAR /* The size of `double', as computed by sizeof. */ #undef SIZEOF_DOUBLE /* The size of `float', as computed by sizeof. */ #undef SIZEOF_FLOAT /* The size of `int', as computed by sizeof. */ #undef SIZEOF_INT /* The size of `long', as computed by sizeof. */ #undef SIZEOF_LONG /* The size of `long long', as computed by sizeof. */ #undef SIZEOF_LONG_LONG /* The size of `short', as computed by sizeof. */ #undef SIZEOF_SHORT /* The size of `unsigned char', as computed by sizeof. */ #undef SIZEOF_UNSIGNED_CHAR /* The size of `unsigned int', as computed by sizeof. */ #undef SIZEOF_UNSIGNED_INT /* The size of `unsigned long', as computed by sizeof. */ #undef SIZEOF_UNSIGNED_LONG /* The size of `unsigned long long', as computed by sizeof. */ #undef SIZEOF_UNSIGNED_LONG_LONG /* The size of `unsigned short', as computed by sizeof. */ #undef SIZEOF_UNSIGNED_SHORT /* The size of `void *', as computed by sizeof. */ #undef SIZEOF_VOID_P /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS hugs98-plus-Sep2006/libraries/include/MachDeps.h0000644006511100651110000000312110171732556020223 0ustar rossross/* This file is included into various Haskell files in the hierarchical * libraries. * * It provides a variety of constants and symbols required by the * foreign function interface libraries. */ #include "ghcconfig.h" #define SIZEOF_HSCHAR SIZEOF_INT #define SIZEOF_HSINT SIZEOF_INT #define SIZEOF_HSWORD SIZEOF_INT #define SIZEOF_HSPTR SIZEOF_VOID_P #define SIZEOF_HSFUNPTR SIZEOF_VOID_P #define SIZEOF_HSSTABLEPTR SIZEOF_VOID_P #define SIZEOF_HSFLOAT SIZEOF_FLOAT #define SIZEOF_HSDOUBLE SIZEOF_DOUBLE #define SIZEOF_WORD8 1 #define SIZEOF_WORD16 2 #define SIZEOF_WORD32 4 #define SIZEOF_WORD64 8 #define SIZEOF_INT8 1 #define SIZEOF_INT16 2 #define SIZEOF_INT32 4 #define SIZEOF_INT64 8 #define ALIGNMENT_HSCHAR ALIGNMENT_INT #define ALIGNMENT_HSINT ALIGNMENT_INT #define ALIGNMENT_HSWORD ALIGNMENT_INT #define ALIGNMENT_HSPTR ALIGNMENT_VOID_P #define ALIGNMENT_HSFUNPTR ALIGNMENT_VOID_P #define ALIGNMENT_HSSTABLEPTR ALIGNMENT_VOID_P #define ALIGNMENT_HSFLOAT ALIGNMENT_FLOAT #define ALIGNMENT_HSDOUBLE ALIGNMENT_DOUBLE #define ALIGNMENT_WORD8 ALIGNMENT_UNSIGNED_CHAR #define ALIGNMENT_WORD16 ALIGNMENT_UNSIGNED_SHORT #define ALIGNMENT_WORD32 ALIGNMENT_UNSIGNED_INT #define ALIGNMENT_WORD64 ALIGNMENT_UNSIGNED_LONG_LONG #define ALIGNMENT_INT8 ALIGNMENT_CHAR #define ALIGNMENT_INT16 ALIGNMENT_SHORT #define ALIGNMENT_INT32 ALIGNMENT_INT #define ALIGNMENT_INT64 ALIGNMENT_LONG_LONG hugs98-plus-Sep2006/libraries/tools/0000755006511100651110000000000010504340132016067 5ustar rossrosshugs98-plus-Sep2006/libraries/tools/.cvsignore0000644006511100651110000000000710207437527020103 0ustar rossrossconfig hugs98-plus-Sep2006/libraries/tools/config.in0000644006511100651110000000023610204665430017675 0ustar rossross# @configure_input@ # Shell variable definitions for make_bootlib and convert_libraries : ${cpp='@CPP_TRADITIONAL@'} : ${SORT=@SortCmd@} : ${FIND=@FindCmd@} hugs98-plus-Sep2006/libraries/tools/convert_libraries0000755006511100651110000000561510477335113021554 0ustar rossross#!/bin/sh # This script generates: # $2/packages/*: # copies of the heirarchical libraries suitable for # use with Hugs. Note that some of the libraries require extensions # to Haskell 98 and have to be run with the -98 flag. # # Usage: # # ./convert_libraries # # NOTE: This script expects to be run in the top-level hugs98 directory, # and contains paths relative to there. case $# in 2) ;; *) echo "usage: $0 " >&2 exit 1 ;; esac lib_src=packages if [ ! -d $lib_src ]; then echo "Can't find $lib_src directory" >&2 exit 1 fi target="$2" # parameters set by configure case $0 in */*) . `dirname $0`/config ;; *) . ./config ;; esac # Copy package examples (if any) to the demos directory copy_examples() { to_dir=$1 if [ -d examples ] then $FIND examples -follow -name CVS -prune -o \! -name .cvsignore \! -name Makefile \! -name makefile -type f -print | sed 's:^examples/::' | while read name do target_file="$to_dir/$name" mkdir -p `dirname $target_file` cp examples/$name $target_file done fi } # Convert hierarchical modules # top directory relative to package directories. # absolute names won't work from Hugs on MSYS top_dir=../.. HUGSDIR="$top_dir/$target" HUGSFLAGS="-P{Hugs}/packages/*:$top_dir/libraries/bootlib" export HUGSDIR HUGSFLAGS # extension for batch files/shell scripts case `uname -a` in CYGWIN*|MINGW32*) bat=.bat ;; *) bat= ;; esac build_package() { source_dir=$1 pkg=`basename $1` target_dir="$target/packages/$pkg" cd $source_dir runhugs=$top_dir/src/runhugs ffihugs=$top_dir/src/ffihugs HugsSetup="$runhugs -98 $top_dir/packages/Cabal/examples/hapax.hs" case "$happy" in '') happyflag= ;; /*) happyflag="--with-happy=$happy" ;; *) happyflag="--with-happy=$top_dir/$happy" ;; esac # HACK: network package expects host settings case "$source_dir" in */network) extra_opts="--build=$HOST --host=$HOST" ;; *) extra_opts= ;; esac $HugsSetup configure --verbose --hugs \ --prefix="$PREFIX" \ --scratchdir="$top_dir/$target_dir" \ --with-hsc2hs="$top_dir/libraries/tools/hsc2hs$bat" \ --with-cpphs="$top_dir/libraries/tools/cpphs$bat" \ --with-compiler="$top_dir/src/ffihugs" $happyflag \ $extra_opts if $HugsSetup build --verbose; then for name in LICEN[CS]E* COPYING* COPYRIGHT* copyright; do if test -f $name; then cp $name $top_dir/$target_dir fi done rm -rf $top_dir/$target_dir/autogen copy_examples $top_dir/$target/demos/$pkg else echo "Skipping $pkg package" fi cd "$top_dir" } Win32= case `uname -a` in CYGWIN*|MINGW32*) Win32="Win32" ;; esac packages="base haskell98 Cabal haskell-src QuickCheck mtl fgl HaXml parsec html network HUnit $Win32 unix X11 HGL OpenGL GLUT OpenAL ALUT time stm xhtml" build_package libraries/hugsbase for package in $packages do if test -d $lib_src/$package; then build_package $lib_src/$package fi done hugs98-plus-Sep2006/libraries/tools/make_bootlib0000755006511100651110000000775510433435121020466 0ustar rossross#!/bin/sh # Create libraries sufficient for runhugs, ffihugs, cpphs, hsc2hs and # Cabal scripts. boot_packages='base haskell98 Cabal' # ensure that letter ranges work LC_ALL=C export LC_ALL case $0 in */*) toolsdir=`dirname $0` ;; *) toolsdir=. ;; esac # parameters set by configure . $toolsdir/config cd $toolsdir/../.. source=packages target=libraries/bootlib fp_includes=ghc/includes tmpdir_root=/tmp HUGSDIR=hugsdir HUGSFLAGS="-P$target" export HUGSDIR HUGSFLAGS # platform sensitive settings case `uname -a` in *CYGWIN*) # Canonicalize win32 paths # (i.e., stay far away from unportable /cygdrive-paths) case $platform in Cygwin) # stay away from -m # (older versions of 'cygpath' don't support it.) source=`cygpath -w $source | sed -e 's@\\\\@/@g'` target=`cygpath -w $target | sed -e 's@\\\\@/@g'` tmpdir_root=`cygpath -w $tmpdir_root | sed -e 's@\\\\@/@g'` esac platform=Win32 ;; *MINGW*) platform=Win32 ;; *) platform=Unix ;; esac # create all scratch files in $tmpdir tmpdir=$tmpdir_root/cvt.$$ [ -d $tmpdir ] && rm -r $tmpdir trap "rm -rf $tmpdir; exit 0" 0 1 2 3 15 mkdir $tmpdir # K&R-style C preprocessor through_cpp() { # The input file need not be called *.c, but for # portability we run the preprocessor on a .c file. cpp_input=$tmpdir/cppinput.c cp "$1" $cpp_input # gcc-3.3 on MacOS X 10.3 is reported to add #pragma $cpp $cpp_flags $cpp_input | grep -v '^#' | cat -s } # internal Hugs modules mkdir -p $target/Hugs cp libraries/hugsbase/Hugs/*.* $target/Hugs cp libraries/hugsbase/Hugs.hs $target # Preprocess hierarchical modules for package in $boot_packages do package_dir=$source/$package # configure the library package first if test -x $package_dir/configure; then (cd $package_dir; ./configure) fi # Determine the list of modules to be converted module_list=$tmpdir/list.1 all_modules=$tmpdir/list.2 ( cd $package_dir $FIND . \( -name '[a-z]*' -o -name '[GN]HC' \) -prune -o \ \( -name \*.hs -o -name \*.lhs -o -name \*.hsc \) -print | sed ' s:^\./:: s/\..*//' | grep -v '^Text/Regex' | $SORT -u >$all_modules if [ -f hugs/exclude ]; then sed ' /^[ ]*#/ d /^[ ]*$/ d s/[ ].*// s:\.:/:g' hugs/exclude | $SORT -u | comm -13 - $all_modules >$module_list else mv $all_modules $module_list fi ) # Preprocess modules while read modname do echo "Preprocessing $modname" stem=$package_dir/$modname target_stem=$target/$modname dstdir=`dirname $target_stem` basename=`basename $stem` cpp_flags="$CPPFLAGS -I$HUGSDIR/include -I$package_dir/include -I$fp_includes" mkdir -p $dstdir # Hack: can't assume hsc2hs at this point, so just use cpp. # This works for System.Time and System.CPUTime, but not # Text.Regex.Posix, so we won't be compiling that. if [ -f $stem.hsc ]; then through_cpp $stem.hsc >$target_stem.hs elif [ -f $stem.hs ]; then through_cpp $stem.hs >$target_stem.hs elif [ -f $stem.lhs ]; then through_cpp $stem.lhs >$target_stem.lhs else echo "$0: don't know how to handle $stem" >&2 fi done <$module_list done # compile some modules in bootlibs with ffihugs ffihugs=src/ffihugs base_includes="-I$source/base/include -I$fp_includes" case $platform in Unix) base_libs= ;; Win32) base_libs='-lwsock32' ;; esac $ffihugs Hugs.Storable \ libraries/hugsbase/Hugs/Storable_aux.c $ffihugs '-i"HsBase.h"' Foreign.C.Error $base_includes \ $source/base/cbits/PrelIOUtils.c $base_libs $ffihugs '-i"HsBase.h"' Foreign.Marshal.Alloc $base_includes \ $source/base/cbits/PrelIOUtils.c \ $source/base/cbits/dirUtils.c \ $source/base/cbits/consUtils.c $base_libs $ffihugs '-i"HsBase.h"' Foreign.Marshal.Utils $base_includes $base_libs $ffihugs '-i"HsBase.h"' Foreign.Ptr $base_includes \ $source/base/cbits/PrelIOUtils.c $base_libs case $platform in Unix) $ffihugs '-i"HsBase.h"' System.Posix.Internals $base_includes ;; Win32) $ffihugs '-i"HsBase.h"' System.Directory $base_includes $base_libs $ffihugs Distribution.Simple.Utils $ffihugs -98 Distribution.Simple.LocalBuildInfo ;; esac hugs98-plus-Sep2006/libraries/tools/make_oldlib0000755006511100651110000002454410466666603020315 0ustar rossross#!/bin/sh # Compatibility with lib/exts: # This script generates: # $2/oldlib: # compatibility stubs for old Hugs libraries # # Usage: # # ./make_oldlib # # NOTE: This script expects to be run in the top-level hugs98 directory, # and contains paths relative to there. hs_src=$1/hslibs if [ ! -d $hs_src ]; then echo "Can't find hslibs in directory '$1'" >&2 exit 1 fi compat="$2/oldlib" # Create a compatibility stub for a Hugs extension module stub() { case $# in 0) echo "usage: stub module [module ...]" >&2 exit 1 ;; esac stub_module=$1 shift echo "Stub $stub_module -> $*" ( echo "module $stub_module(" for real do echo " module $real," done echo ' ) where' echo for real do echo "import $real" done ) >$compat/$stub_module.hs } # Copy the Hugs version to the compatibility lib libexts() { case $# in 1) ;; *) echo "usage: libexts module" >&2 exit 1 ;; esac name="`ls lib/exts/$1.*hs`" echo "Copy `basename $name`" sed 's/import Prelude/import Hugs.Prelude/' $name >$compat/`basename $name` } libhugs() { case $# in 1) ;; *) echo "usage: libhugs module" >&2 exit 1 ;; esac name="`ls lib/hugs/$1.*hs`" echo "Copy `basename $name`" sed 's/import Prelude/import Hugs.Prelude/' $name >$compat/`basename $name` } # Convert the hslibs version to the compatibility lib hslibs() { case $# in 2) ;; *) echo "usage: hslibs dir file" >&2 exit 1 ;; esac echo "Copy $2" cp $hs_src/$1/$2 $compat/$2 } mkdir -p $compat # Hugs-only modules stub ConcBase Hugs.ConcBase stub Memo Hugs.Memo # hslibs module is different stub Observe Hugs.Observe # hslibs module is different # Stuff from hslibs (many of these are stubs) hslibs concurrent CVar.lhs # superseded by MVars hslibs concurrent Chan.lhs # -> Control.Concurrent.Chan hslibs concurrent Channel.lhs # -> Control.Concurrent.Chan hslibs concurrent ChannelVar.lhs # superseded by MVars hslibs concurrent Concurrent.lhs # -> Control.Concurrent hslibs concurrent MVar.lhs # -> Control.Concurrent.MVar # hslibs concurrent Merge.lhs # needs pre-emptive concurrency hslibs concurrent Parallel.lhs # -> Control.Parallel hslibs concurrent QSem.lhs # -> Control.Concurrent.QSem hslibs concurrent QSemN.lhs # -> Control.Concurrent.QSemN hslibs concurrent SampleVar.lhs # -> Control.Concurrent.SampleVar hslibs concurrent Semaphore.lhs # -> Control.Concurrent.QSem Control.Concurrent.QSemN # hslibs concurrent Strategies.lhs cp $hs_src/data/edison/COPYRIGHT $compat/COPYRIGHT.edison hslibs data/edison/Assoc Assoc.hs hslibs data/edison/Assoc AssocDefaults.hs hslibs data/edison/Assoc AssocList.hs hslibs data/edison/Assoc PatriciaLoMap.hs hslibs data/edison EdisonPrelude.hs hslibs data/edison/Coll Collection.hs hslibs data/edison/Coll CollectionDefaults.hs hslibs data/edison/Coll CollectionUtils.hs hslibs data/edison/Coll LazyPairingHeap.hs hslibs data/edison/Coll LeftistHeap.hs hslibs data/edison/Coll MinHeap.hs hslibs data/edison/Coll SkewHeap.hs hslibs data/edison/Coll SplayHeap.hs hslibs data/edison/Coll TestOrdBag.hs hslibs data/edison/Coll TestOrdSet.hs hslibs data/edison/Coll UnbalancedSet.hs hslibs data/edison/Seq BankersQueue.hs hslibs data/edison/Seq BinaryRandList.hs hslibs data/edison/Seq BraunSeq.hs hslibs data/edison/Seq JoinList.hs hslibs data/edison/Seq ListSeq.hs hslibs data/edison/Seq MyersStack.hs hslibs data/edison/Seq RandList.hs hslibs data/edison/Seq RevSeq.hs hslibs data/edison/Seq Sequence.hs hslibs data/edison/Seq SequenceDefaults.hs hslibs data/edison/Seq SimpleQueue.hs hslibs data/edison/Seq SizedSeq.hs hslibs data/edison/Seq TestSeq.hs hslibs hssource HsLexer.hs # -> Language.Haskell.Lexer hslibs hssource HsParseMonad.hs # -> Language.Haskell.ParseMonad hslibs hssource HsParseUtils.hs # -> Language.Haskell.ParseUtils hslibs hssource HsParser.hs # -> Language.Haskell.Parser hslibs hssource HsPretty.hs # -> Language.Haskell.Pretty hslibs hssource HsSyn.hs # -> Language.Haskell.Syntax # hslibs lang Addr.lhs # deprecated libexts Addr hslibs lang ArrayBase.hs # -> Data.Array.Base hslibs lang Arrow.hs # -> Control.Arrow # hslibs lang ByteArray.lhs # deprecated # hslibs lang CTypesISO.hs # uses C preprocessor hslibs lang DiffArray.hs # -> Data.Array.Diff # hslibs lang DirectoryExts.hs hslibs lang Dynamic.hs # -> Data.Dynamic hslibs lang Exception.hs # -> Control.Exception # hslibs lang ForeignObj.lhs # deprecated libexts ForeignObj # uses Hugs primitives # hslibs lang Generics.hs # -> Data.Generics # hslibs lang GlaExts.lhs # deprecated hslibs lang IArray.hs # -> Data.Array.IArray # hslibs lang IOExts.hs stub IOExts Hugs.IOExts Hugs.IORef Hugs.IOArray System.IO.Unsafe Debug.Trace hslibs lang IORef.hs # -> Data.IORef # hslibs lang LazyST.hs stub LazyST Data.STRef.Lazy Control.Monad.ST.Lazy Hugs.LazyST # hslibs lang MArray.hs # lots of GHC stuff (and obsolete) # hslibs lang MutableArray.lhs # deprecated hslibs lang NativeInfo.hs # -> System.Info # hslibs lang NumExts.lhs # uses C preprocessor hslibs lang PackedString.lhs # -> Data.PackedString # hslibs lang PrelByteArr.lhs # GHC-specific # hslibs lang ST.hs # GHC-specific stub ST Data.STRef.Strict Data.Array.ST Control.Monad.ST Hugs.ST hslibs lang ShowFunctions.hs # -> Text.Show.Functions hslibs lang Stable.hs # -> Foreign.StablePtr System.Mem.StableName hslibs lang StableName.hs # -> System.Mem.StableName hslibs lang StorableArray.hs # -> Data.Array.Storable # hslibs lang SystemExts.lhs # GHC-specific # hslibs lang TimeExts.lhs hslibs lang Weak.hs # -> System.Mem.Weak hslibs lang/monads MonadCont.lhs # -> Control.Monad.Cont hslibs lang/monads MonadEither.lhs # -> Control.Monad.Error hslibs lang/monads MonadError.lhs # -> Control.Monad.Error hslibs lang/monads MonadFix.lhs # -> Control.Monad.Fix hslibs lang/monads MonadIdentity.lhs # -> Control.Monad.Identity hslibs lang/monads MonadList.lhs # -> Control.Monad.List hslibs lang/monads MonadRWS.lhs # -> Control.Monad.RWS hslibs lang/monads MonadReader.lhs # -> Control.Monad.Reader hslibs lang/monads MonadState.lhs # -> Control.Monad.State hslibs lang/monads MonadTrans.lhs # -> Control.Monad.Trans hslibs lang/monads MonadWriter.lhs # -> Control.Monad.Writer hslibs lang/monads Monoid.lhs # -> Data.Monoid hslibs net BSD.hs # -> Network.BSD hslibs net CGI.lhs # -> Network.CGI hslibs net Socket.lhs # -> Network.Socket hslibs net SocketPrim.hs # -> Network.Socket hslibs net URI.hs # -> Network.URI # hslibs posix DL.hs # hslibs posix DLPrim.hsc # hslibs posix POpen.hs # hslibs posix Posix.lhs hslibs posix PosixDB.lhs # hslibs posix PosixErr.lhs hslibs posix PosixFiles.lhs hslibs posix PosixIO.lhs # hslibs posix PosixProcEnv.lhs # uses C preprocessor # hslibs posix PosixProcPrim.lhs hslibs posix PosixTTY.lhs # hslibs posix PosixUtil.lhs hslibs text Pretty.lhs # -> Text.PrettyPrint.HughesPJ hslibs text RegexString.lhs # -> Text.Regex hslibs text/html Html.lhs # -> Text.Html hslibs text/html HtmlBlockTable.lhs # -> Text.Html.BlockTable hslibs text/parsec Parsec.hs # -> Text.ParserCombinators.Parsec hslibs text/parsec ParsecChar.hs # -> Text.ParserCombinators.Parsec.Char hslibs text/parsec ParsecCombinator.hs # -> Text.ParserCombinators.Parsec.Combinator hslibs text/parsec ParsecError.hs # -> Text.ParserCombinators.Parsec.Error hslibs text/parsec ParsecExpr.hs # -> Text.ParserCombinators.Parsec.Expr hslibs text/parsec ParsecLanguage.hs # -> Text.ParserCombinators.Parsec.Language hslibs text/parsec ParsecPerm.hs # -> Text.ParserCombinators.Parsec.Perm hslibs text/parsec ParsecPos.hs # -> Text.ParserCombinators.Parsec.Pos hslibs text/parsec ParsecPrim.hs # -> Text.ParserCombinators.Parsec.Prim hslibs text/parsec ParsecToken.hs # -> Text.ParserCombinators.Parsec.Token hslibs util GetOpt.lhs # -> System.Console.GetOpt # hslibs util Memo.lhs # Hugs module is different # hslibs util Observe.lhs # Hugs module is different # hslibs util Readline.hs # -> System.Console.Readline # hslibs util Select.lhs hslibs util Unique.lhs # -> Data.Unique hslibs util/check QuickCheck.hs # -> Debug.QuickCheck # hslibs util/check QuickCheckBatch.hs # -> Debug.QuickCheck.Batch hslibs util/check QuickCheckPoly.hs # -> Debug.QuickCheck.Poly hslibs util/check QuickCheckUtils.hs # -> Debug.QuickCheck.Utils # Compatibility with lib/hugs: libhugs AnsiInteract libhugs AnsiScreen stub CVHAssert Hugs.CVHAssert stub GenericPrint Hugs.GenericPrint stub HugsInternals Hugs.Internals libhugs HugsLibs # only useful for testing stub IOExtensions Hugs.IOExts libhugs Interact libhugs ListUtils libhugs Number libhugs ParseLib stub Quote Hugs.Quote # only hugs supports here docs libhugs StdLibs # only useful for testing stub Trace Debug.Trace stub Trex Hugs.Trex # only hugs supports Trex # Graphics library stub SOEGraphics Graphics.SOE stub GraphicsCore Graphics.HGL.Core stub GraphicsUtils Graphics.HGL # Win32 library case "$Win32" in Win32) stub Win32 Graphics.Win32 System.Win32 stub GDITypes Graphics.Win32.GDI.Types stub Win32Bitmap Graphics.Win32.GDI.Bitmap stub Win32Brush Graphics.Win32.GDI.Brush stub Win32Clip Graphics.Win32.GDI.Clip stub Win32Font Graphics.Win32.GDI.Font stub Win32Graphics2D Graphics.Win32.GDI.Graphics2D stub Win32HDC Graphics.Win32.GDI.HDC stub Win32Palette Graphics.Win32.GDI.Palette stub Win32Path Graphics.Win32.GDI.Path stub Win32Pen Graphics.Win32.GDI.Pen stub Win32Region Graphics.Win32.GDI.Region stub Win32Control Graphics.Win32.Control stub Win32Dialogue Graphics.Win32.Dialogue stub Win32Icon Graphics.Win32.Icon stub Win32Key Graphics.Win32.Key stub Win32Menu Graphics.Win32.Menu stub Win32Misc Graphics.Win32.Misc stub Win32Resource Graphics.Win32.Resource stub Win32Window Graphics.Win32.Window stub Win32WinMessage Graphics.Win32.Message stub Win32DLL System.Win32.DLL stub Win32File System.Win32.File stub Win32MM System.Win32.Mem stub Win32NLS System.Win32.NLS stub Win32Process System.Win32.Process stub Win32Registry System.Win32.Registry # stub Win32Spawn stub Win32SystemInfo System.Win32.Info stub Win32Types System.Win32.Types ;; esac hugs98-plus-Sep2006/libraries/tools/test_libraries0000755006511100651110000000523510426134734021051 0ustar rossross#!/bin/sh # Test the status within Hugs of each module of the selected packages # from the hierarchical libraries. # ensure that letter ranges work LC_ALL=C export LC_ALL # This script contains paths relative to its own location, but should # be independent of the current directory. this_dir="`dirname $0`" hugs_root_dir="${this_dir:-.}/../.." packages=`cd $hugs_root_dir/packages; ls */*.cabal | sed 's:/.*::'` hugs="$hugs_root_dir/src/hugs" HUGSDIR=$hugs_root_dir/hugsdir export HUGSDIR HUGSFLAGS='-P{Hugs}/packages/*' export HUGSFLAGS case $# in 1) ;; *) echo "usage: $0 " exit 1 ;; esac srcdir=$1 if [ ! -d $srcdir ]; then echo "Can't find directory '$1'" exit 1 fi tmpfile=/tmp/libs.$$ trap 'rm -f $tmpfile+ $tmpfile-; exit 0' 0 1 2 3 15 test_module() { module=$1 # The +. flag ensures that ERRORs will be at the start of a line $hugs +98 +. $module $tmpfile+ $hugs -98 +. $module $tmpfile- if grep "^ERROR - Can't find module \"$module\"" $tmpfile- >/dev/null then echo "missing $module" elif grep ' ERROR: ' $tmpfile- >/dev/null then sed -n 's/\(.* ERROR\): \(.*\)/*\1* '"$module"' (\2)/p' $tmpfile- elif grep '^ERROR' $tmpfile- >/dev/null then module2=`grep '^ERROR ' $tmpfile- | sed -e 's:/packages/[^/]*/:/libraries/:' -e 's:.*"[^"]*/libraries/\([^".]*\)\.[a-z]*".*:\1:' -e 's:/:.:g'` if [ "$module" != "$module2" ] then reason="imports $module2" else reason="`sed -n '/^ERROR / s/.* - //p' $tmpfile-`" fi echo "*ERROR* $module ($reason)" elif grep '^ERROR' $tmpfile+ >/dev/null then module2=`grep '^ERROR ' $tmpfile+ | sed -e 's:/packages/[^/]*/:/libraries/:' -e 's:.*"[^"]*/libraries/\([^".]*\)\.[a-z]*".*:\1:' -e 's:/:.:g'` if [ "$module" != "$module2" ] then reason="imports $module2" else reason="`sed -n '/^ERROR / s/.* - //p' $tmpfile+`" case "$reason" in "Syntax error in data type declaration (unexpected \`.')") reason='rank-2 datatypes' ;; "Syntax error in type expression (unexpected \`.')") reason='rank-2 types' ;; "Haskell 98 does not support dependent parameters") reason='functional dependencies' ;; "Haskell 98 does not support multiple parameter classes") reason='multi-parameter type classes' ;; esac fi echo "hugs -98 $module ($reason)" else echo "hugs +98 $module" fi } ( cd $srcdir for package in $packages do find $package -follow -type f \( -name \*.hs -o -name \*.lhs -o -name \*.y -o -name \*.ly -o -name \*.hsc -o -name \*.gc \) -print | sed 's:^[^/]*/:: s/\..*// s:/:.:g' | sort done ) | grep -v '^Prelude$' | grep -v '^[GN]HC' | grep -v '\.[a-z]' | grep -v '^[a-z]' | while read module do test_module $module done hugs98-plus-Sep2006/libraries/configure0000755006511100651110000170635510504340730016663 0ustar rossross#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.60a for Hugs98 libraries 1.0. # # Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /usr/bin/posix$PATH_SEPARATOR/bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell autoconf@gnu.org about your system, echo including any error possibly output before this echo message } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='Hugs98 libraries' PACKAGE_TARNAME='hugslibs' PACKAGE_VERSION='1.0' PACKAGE_STRING='Hugs98 libraries 1.0' PACKAGE_BUGREPORT='hugs-bugs@haskell.org' ac_unique_file="include/MachDeps.h" # Factoring default headers for most tests. ac_includes_default="\ #include #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_STAT_H # include #endif #ifdef STDC_HEADERS # include # include #else # ifdef HAVE_STDLIB_H # include # endif #endif #ifdef HAVE_STRING_H # if !defined STDC_HEADERS && defined HAVE_MEMORY_H # include # endif # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datarootdir datadir sysconfdir sharedstatedir localstatedir includedir oldincludedir docdir infodir htmldir dvidir pdfdir psdir libdir localedir mandir DEFS ECHO_C ECHO_N ECHO_T LIBS build_alias host_alias target_alias CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP GREP EGREP CPP_TRADITIONAL SET_MAKE fp_prog_find FindCmd fp_prog_sort SortCmd LIBOBJS LTLIBOBJS' ac_subst_files='MkDefs' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS CPPFLAGS CPP' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` eval with_$ac_package=\$ac_optarg ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval with_$ac_package=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute directory names. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { echo "$as_me: error: Working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$0" || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # 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 Hugs98 libraries 1.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/hugslibs] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of Hugs98 libraries 1.0:";; esac cat <<\_ACEOF Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF Hugs98 libraries configure 1.0 generated by GNU Autoconf 2.60a Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by Hugs98 libraries $as_me 1.0, which was generated by GNU Autoconf 2.60a. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then set x "$CONFIG_SITE" elif test "x$prefix" != xNONE; then set x "$prefix/share/config.site" "$prefix/etc/config.site" else set x "$ac_default_prefix/share/config.site" \ "$ac_default_prefix/etc/config.site" fi shift for ac_site_file do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_config_headers="$ac_config_headers include/ghcconfig.h" # necessary evil ac_config_commands="$ac_config_commands ultra-evil" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO: checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; } ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # # List of possible output files, starting from the most likely. # The algorithm is not robust to junk in `.', hence go to wildcards (a.*) # only as a last resort. b.out is created by i960 compilers. ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' # # The IRIX 6 linker writes into existing files which may not be # executable, retaining their permissions. Remove them first so a # subsequent execution test works. ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { (ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi { echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6; } if test -z "$ac_file"; then echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } { echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6; } { echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext { echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT { echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; } if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; } GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CFLAGS="" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_c89+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_c89=$ac_arg else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6; } ;; xno) { echo "$as_me:$LINENO: result: unsupported" >&5 echo "${ECHO_T}unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Extract the first word of "grep ggrep" to use in msg output if test -z "$GREP"; then set dummy grep ggrep; ac_prog_name=$2 if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_GREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_GREP" && $as_executable_p "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_GREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_GREP_found && break 3 done done done IFS=$as_save_IFS fi GREP="$ac_cv_path_GREP" if test -z "$GREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_GREP=$GREP fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 echo "${ECHO_T}$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" { echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6; } if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else # Extract the first word of "egrep" to use in msg output if test -z "$EGREP"; then set dummy egrep; ac_prog_name=$2 if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_EGREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_EGREP" && $as_executable_p "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_EGREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_found && break 3 done done done IFS=$as_save_IFS fi EGREP="$ac_cv_path_EGREP" if test -z "$EGREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_EGREP=$EGREP fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 echo "${ECHO_T}$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" if test $ac_cv_c_compiler_gnu = yes; then { echo "$as_me:$LINENO: checking whether $CC needs -traditional" >&5 echo $ECHO_N "checking whether $CC needs -traditional... $ECHO_C" >&6; } if test "${ac_cv_prog_gcc_traditional+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_pattern="Autoconf.*'x'" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include Autoconf TIOCGETP _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "$ac_pattern" >/dev/null 2>&1; then ac_cv_prog_gcc_traditional=yes else ac_cv_prog_gcc_traditional=no fi rm -f conftest* if test $ac_cv_prog_gcc_traditional = no; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include Autoconf TCGETA _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "$ac_pattern" >/dev/null 2>&1; then ac_cv_prog_gcc_traditional=yes fi rm -f conftest* fi fi { echo "$as_me:$LINENO: result: $ac_cv_prog_gcc_traditional" >&5 echo "${ECHO_T}$ac_cv_prog_gcc_traditional" >&6; } if test $ac_cv_prog_gcc_traditional = yes; then CC="$CC -traditional" fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for a traditional C preprocessor" >&5 echo $ECHO_N "checking for a traditional C preprocessor... $ECHO_C" >&6; } if test "${ice_cv_traditional_cpp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat > conftest.c << EOF #if 1 {-# INLINE f' #-} f' x = x+1 #endif EOF ice_cv_traditional_cpp= ice_save_cpp="$CPP" ice_save_cppflags="$CPPFLAGS" for ice_cpp in "$CPP" "$CC -E" "/lib/cpp"; do for ice_cppflags in '' ' -traditional-cpp' ' -traditional' ' -Xs'; do CPP="$ice_cpp" CPPFLAGS="$ice_cppflags" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if 1 {-# INLINE f' #-} f' x = x+1 #endif int main () { ; return 0; } _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ice_cv_traditional_cpp="${CPP}${CPPFLAGS}" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_ext if test "$ice_cv_traditional_cpp" != ""; then break 2 fi done done CPP="$ice_save_cpp" CPPFLAGS="$ice_save_cppflags" fi { echo "$as_me:$LINENO: result: $ice_cv_traditional_cpp" >&5 echo "${ECHO_T}$ice_cv_traditional_cpp" >&6; } CPP_TRADITIONAL="$ice_cv_traditional_cpp" { echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6; } set x ${MAKE-make}; ac_make=`echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.make <<\_ACEOF SHELL = /bin/sh all: @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. case `${MAKE-make} -f conftest.make 2>/dev/null` in *@@@%%%=?*=@@@%%%*) eval ac_cv_prog_make_${ac_make}_set=yes;; *) eval ac_cv_prog_make_${ac_make}_set=no;; esac rm -f conftest.make fi if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } SET_MAKE= else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } SET_MAKE="MAKE=${MAKE-make}" fi # Extract the first word of "find", so it can be a program name with args. set dummy find; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_path_fp_prog_find+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $fp_prog_find in [\\/]* | ?:[\\/]*) ac_cv_path_fp_prog_find="$fp_prog_find" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_fp_prog_find="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi fp_prog_find=$ac_cv_path_fp_prog_find if test -n "$fp_prog_find"; then { echo "$as_me:$LINENO: result: $fp_prog_find" >&5 echo "${ECHO_T}$fp_prog_find" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi echo foo > conftest.txt $fp_prog_find conftest.txt -print > conftest.out 2>&1 if grep '^conftest.txt$' conftest.out > /dev/null 2>&1 ; then # OK, looks like a real "find". FindCmd="$fp_prog_find" else # Found a poor WinDoze version of "find", ignore it. { echo "$as_me:$LINENO: WARNING: $fp_prog_find looks like a non-*nix find, ignoring it" >&5 echo "$as_me: WARNING: $fp_prog_find looks like a non-*nix find, ignoring it" >&2;} # Extract the first word of "find", so it can be a program name with args. set dummy find; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_FindCmd+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$FindCmd"; then ac_cv_prog_FindCmd="$FindCmd" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "$fp_prog_find"; then ac_prog_rejected=yes continue fi ac_cv_prog_FindCmd="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_FindCmd shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set FindCmd to just the basename; use the full file name. shift ac_cv_prog_FindCmd="$as_dir/$ac_word${1+' '}$@" fi fi fi fi FindCmd=$ac_cv_prog_FindCmd if test -n "$FindCmd"; then { echo "$as_me:$LINENO: result: $FindCmd" >&5 echo "${ECHO_T}$FindCmd" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi rm -f conftest.txt conftest.out # Extract the first word of "sort", so it can be a program name with args. set dummy sort; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_path_fp_prog_sort+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $fp_prog_sort in [\\/]* | ?:[\\/]*) ac_cv_path_fp_prog_sort="$fp_prog_sort" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_fp_prog_sort="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi fp_prog_sort=$ac_cv_path_fp_prog_sort if test -n "$fp_prog_sort"; then { echo "$as_me:$LINENO: result: $fp_prog_sort" >&5 echo "${ECHO_T}$fp_prog_sort" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi echo foo > conftest.txt $fp_prog_sort -u conftest.txt > conftest.out 2>&1 if grep '^foo$' conftest.out > /dev/null 2>&1 ; then # OK, looks like a real "sort". SortCmd="$fp_prog_sort" else # Found a poor WinDoze version of "sort", ignore it. { echo "$as_me:$LINENO: WARNING: $fp_prog_sort looks like a non-*nix sort, ignoring it" >&5 echo "$as_me: WARNING: $fp_prog_sort looks like a non-*nix sort, ignoring it" >&2;} # Extract the first word of "sort", so it can be a program name with args. set dummy sort; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_SortCmd+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$SortCmd"; then ac_cv_prog_SortCmd="$SortCmd" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "$fp_prog_sort"; then ac_prog_rejected=yes continue fi ac_cv_prog_SortCmd="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_SortCmd shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set SortCmd to just the basename; use the full file name. shift ac_cv_prog_SortCmd="$as_dir/$ac_word${1+' '}$@" fi fi fi fi SortCmd=$ac_cv_prog_SortCmd if test -n "$SortCmd"; then { echo "$as_me:$LINENO: result: $SortCmd" >&5 echo "${ECHO_T}$SortCmd" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi rm -f conftest.txt conftest.out { echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) return 2; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking for long long" >&5 echo $ECHO_N "checking for long long... $ECHO_C" >&6; } if test "${ac_cv_type_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_long_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_long_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_long_long" >&5 echo "${ECHO_T}$ac_cv_type_long_long" >&6; } if test $ac_cv_type_long_long = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LONG_LONG 1 _ACEOF fi { echo "$as_me:$LINENO: checking for char" >&5 echo $ECHO_N "checking for char... $ECHO_C" >&6; } if test "${ac_cv_type_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef char ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_char=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_char=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_char" >&5 echo "${ECHO_T}$ac_cv_type_char" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of char" >&5 echo $ECHO_N "checking size of char... $ECHO_C" >&6; } if test "${ac_cv_sizeof_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_char=$ac_lo;; '') if test "$ac_cv_type_char" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (char) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (char) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_char=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef char ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_char=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_char" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (char) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (char) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_char=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_char" >&5 echo "${ECHO_T}$ac_cv_sizeof_char" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_CHAR $ac_cv_sizeof_char _ACEOF { echo "$as_me:$LINENO: checking for double" >&5 echo $ECHO_N "checking for double... $ECHO_C" >&6; } if test "${ac_cv_type_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_double=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_double=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_double" >&5 echo "${ECHO_T}$ac_cv_type_double" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of double" >&5 echo $ECHO_N "checking size of double... $ECHO_C" >&6; } if test "${ac_cv_sizeof_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_double=$ac_lo;; '') if test "$ac_cv_type_double" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (double) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (double) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_double=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_double=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_double" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (double) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (double) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_double=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_double" >&5 echo "${ECHO_T}$ac_cv_sizeof_double" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_DOUBLE $ac_cv_sizeof_double _ACEOF { echo "$as_me:$LINENO: checking for float" >&5 echo $ECHO_N "checking for float... $ECHO_C" >&6; } if test "${ac_cv_type_float+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_float=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_float=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_float" >&5 echo "${ECHO_T}$ac_cv_type_float" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of float" >&5 echo $ECHO_N "checking size of float... $ECHO_C" >&6; } if test "${ac_cv_sizeof_float+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_float=$ac_lo;; '') if test "$ac_cv_type_float" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (float) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (float) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_float=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_float=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_float" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (float) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (float) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_float=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_float" >&5 echo "${ECHO_T}$ac_cv_sizeof_float" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_FLOAT $ac_cv_sizeof_float _ACEOF { echo "$as_me:$LINENO: checking for int" >&5 echo $ECHO_N "checking for int... $ECHO_C" >&6; } if test "${ac_cv_type_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_int=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_int=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_int" >&5 echo "${ECHO_T}$ac_cv_type_int" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of int" >&5 echo $ECHO_N "checking size of int... $ECHO_C" >&6; } if test "${ac_cv_sizeof_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_int=$ac_lo;; '') if test "$ac_cv_type_int" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_int=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_int=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_int" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_int=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_int" >&5 echo "${ECHO_T}$ac_cv_sizeof_int" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_INT $ac_cv_sizeof_int _ACEOF { echo "$as_me:$LINENO: checking for long" >&5 echo $ECHO_N "checking for long... $ECHO_C" >&6; } if test "${ac_cv_type_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_long" >&5 echo "${ECHO_T}$ac_cv_type_long" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of long" >&5 echo $ECHO_N "checking size of long... $ECHO_C" >&6; } if test "${ac_cv_sizeof_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_long=$ac_lo;; '') if test "$ac_cv_type_long" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_long=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_long=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_long" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_long=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_long" >&5 echo "${ECHO_T}$ac_cv_sizeof_long" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_LONG $ac_cv_sizeof_long _ACEOF if test "$ac_cv_type_long_long" = yes; then { echo "$as_me:$LINENO: checking for long long" >&5 echo $ECHO_N "checking for long long... $ECHO_C" >&6; } if test "${ac_cv_type_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_long_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_long_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_long_long" >&5 echo "${ECHO_T}$ac_cv_type_long_long" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of long long" >&5 echo $ECHO_N "checking size of long long... $ECHO_C" >&6; } if test "${ac_cv_sizeof_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_long_long=$ac_lo;; '') if test "$ac_cv_type_long_long" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (long long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_long_long=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_long_long=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_long_long" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (long long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_long_long=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_long_long" >&5 echo "${ECHO_T}$ac_cv_sizeof_long_long" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_LONG_LONG $ac_cv_sizeof_long_long _ACEOF fi { echo "$as_me:$LINENO: checking for short" >&5 echo $ECHO_N "checking for short... $ECHO_C" >&6; } if test "${ac_cv_type_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef short ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_short=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_short=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_short" >&5 echo "${ECHO_T}$ac_cv_type_short" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of short" >&5 echo $ECHO_N "checking size of short... $ECHO_C" >&6; } if test "${ac_cv_sizeof_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_short=$ac_lo;; '') if test "$ac_cv_type_short" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (short) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (short) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_short=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef short ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_short=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_short" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (short) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (short) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_short=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_short" >&5 echo "${ECHO_T}$ac_cv_sizeof_short" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_SHORT $ac_cv_sizeof_short _ACEOF { echo "$as_me:$LINENO: checking for unsigned char" >&5 echo $ECHO_N "checking for unsigned char... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned char ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_char=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_char=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_char" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_char" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of unsigned char" >&5 echo $ECHO_N "checking size of unsigned char... $ECHO_C" >&6; } if test "${ac_cv_sizeof_unsigned_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned char ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_unsigned_char=$ac_lo;; '') if test "$ac_cv_type_unsigned_char" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned char) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned char) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_char=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned char ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_unsigned_char=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_unsigned_char" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned char) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned char) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_char=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_unsigned_char" >&5 echo "${ECHO_T}$ac_cv_sizeof_unsigned_char" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_UNSIGNED_CHAR $ac_cv_sizeof_unsigned_char _ACEOF { echo "$as_me:$LINENO: checking for unsigned int" >&5 echo $ECHO_N "checking for unsigned int... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned int ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_int=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_int=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_int" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_int" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of unsigned int" >&5 echo $ECHO_N "checking size of unsigned int... $ECHO_C" >&6; } if test "${ac_cv_sizeof_unsigned_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_unsigned_int=$ac_lo;; '') if test "$ac_cv_type_unsigned_int" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_int=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned int ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_unsigned_int=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_unsigned_int" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_int=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_unsigned_int" >&5 echo "${ECHO_T}$ac_cv_sizeof_unsigned_int" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_UNSIGNED_INT $ac_cv_sizeof_unsigned_int _ACEOF { echo "$as_me:$LINENO: checking for unsigned long" >&5 echo $ECHO_N "checking for unsigned long... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_long" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_long" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of unsigned long" >&5 echo $ECHO_N "checking size of unsigned long... $ECHO_C" >&6; } if test "${ac_cv_sizeof_unsigned_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_unsigned_long=$ac_lo;; '') if test "$ac_cv_type_unsigned_long" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_long=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_unsigned_long=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_unsigned_long" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_long=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_unsigned_long" >&5 echo "${ECHO_T}$ac_cv_sizeof_unsigned_long" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_UNSIGNED_LONG $ac_cv_sizeof_unsigned_long _ACEOF if test "$ac_cv_type_long_long" = yes; then { echo "$as_me:$LINENO: checking for unsigned long long" >&5 echo $ECHO_N "checking for unsigned long long... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_long_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_long_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_long_long" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_long_long" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of unsigned long long" >&5 echo $ECHO_N "checking size of unsigned long long... $ECHO_C" >&6; } if test "${ac_cv_sizeof_unsigned_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long long ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_unsigned_long_long=$ac_lo;; '') if test "$ac_cv_type_unsigned_long_long" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned long long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned long long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_long_long=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long long ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_unsigned_long_long=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_unsigned_long_long" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned long long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned long long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_long_long=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_unsigned_long_long" >&5 echo "${ECHO_T}$ac_cv_sizeof_unsigned_long_long" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_UNSIGNED_LONG_LONG $ac_cv_sizeof_unsigned_long_long _ACEOF fi { echo "$as_me:$LINENO: checking for unsigned short" >&5 echo $ECHO_N "checking for unsigned short... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned short ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_short=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_short=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_short" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_short" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of unsigned short" >&5 echo $ECHO_N "checking size of unsigned short... $ECHO_C" >&6; } if test "${ac_cv_sizeof_unsigned_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned short ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_unsigned_short=$ac_lo;; '') if test "$ac_cv_type_unsigned_short" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned short) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned short) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_short=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned short ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_unsigned_short=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_unsigned_short" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (unsigned short) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (unsigned short) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_unsigned_short=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_unsigned_short" >&5 echo "${ECHO_T}$ac_cv_sizeof_unsigned_short" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_UNSIGNED_SHORT $ac_cv_sizeof_unsigned_short _ACEOF { echo "$as_me:$LINENO: checking for void *" >&5 echo $ECHO_N "checking for void *... $ECHO_C" >&6; } if test "${ac_cv_type_void_p+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef void * ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_void_p=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_void_p=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_void_p" >&5 echo "${ECHO_T}$ac_cv_type_void_p" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of void *" >&5 echo $ECHO_N "checking size of void *... $ECHO_C" >&6; } if test "${ac_cv_sizeof_void_p+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef void * ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef void * ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef void * ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef void * ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef void * ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_void_p=$ac_lo;; '') if test "$ac_cv_type_void_p" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (void *) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (void *) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_void_p=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef void * ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_void_p=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_void_p" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (void *) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (void *) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_void_p=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_void_p" >&5 echo "${ECHO_T}$ac_cv_sizeof_void_p" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_VOID_P $ac_cv_sizeof_void_p _ACEOF { echo "$as_me:$LINENO: checking for char" >&5 echo $ECHO_N "checking for char... $ECHO_C" >&6; } if test "${ac_cv_type_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef char ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_char=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_char=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_char" >&5 echo "${ECHO_T}$ac_cv_type_char" >&6; } { echo "$as_me:$LINENO: checking alignment of char" >&5 echo $ECHO_N "checking alignment of char... $ECHO_C" >&6; } if test "${fp_cv_alignment_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_char" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; char ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; char ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; char ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; char ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; char ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_char=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (char) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (char) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; char ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; char ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; char ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; char ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; char ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_char=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (char) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (char) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_char=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_char" >&5 echo "${ECHO_T}$fp_cv_alignment_char" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_CHAR $fp_cv_alignment_char _ACEOF { echo "$as_me:$LINENO: checking for double" >&5 echo $ECHO_N "checking for double... $ECHO_C" >&6; } if test "${ac_cv_type_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_double=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_double=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_double" >&5 echo "${ECHO_T}$ac_cv_type_double" >&6; } { echo "$as_me:$LINENO: checking alignment of double" >&5 echo $ECHO_N "checking alignment of double... $ECHO_C" >&6; } if test "${fp_cv_alignment_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_double" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; double ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; double ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; double ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; double ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; double ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_double=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (double) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (double) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; double ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; double ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; double ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; double ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; double ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_double=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (double) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (double) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_double=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_double" >&5 echo "${ECHO_T}$fp_cv_alignment_double" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_DOUBLE $fp_cv_alignment_double _ACEOF { echo "$as_me:$LINENO: checking for float" >&5 echo $ECHO_N "checking for float... $ECHO_C" >&6; } if test "${ac_cv_type_float+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_float=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_float=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_float" >&5 echo "${ECHO_T}$ac_cv_type_float" >&6; } { echo "$as_me:$LINENO: checking alignment of float" >&5 echo $ECHO_N "checking alignment of float... $ECHO_C" >&6; } if test "${fp_cv_alignment_float+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_float" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; float ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; float ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; float ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; float ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; float ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_float=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (float) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (float) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; float ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; float ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; float ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; float ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; float ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_float=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (float) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (float) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_float=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_float" >&5 echo "${ECHO_T}$fp_cv_alignment_float" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_FLOAT $fp_cv_alignment_float _ACEOF { echo "$as_me:$LINENO: checking for int" >&5 echo $ECHO_N "checking for int... $ECHO_C" >&6; } if test "${ac_cv_type_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_int=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_int=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_int" >&5 echo "${ECHO_T}$ac_cv_type_int" >&6; } { echo "$as_me:$LINENO: checking alignment of int" >&5 echo $ECHO_N "checking alignment of int... $ECHO_C" >&6; } if test "${fp_cv_alignment_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_int" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; int ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; int ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; int ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; int ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; int ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_int=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; int ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; int ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; int ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; int ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; int ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_int=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_int=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_int" >&5 echo "${ECHO_T}$fp_cv_alignment_int" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_INT $fp_cv_alignment_int _ACEOF { echo "$as_me:$LINENO: checking for long" >&5 echo $ECHO_N "checking for long... $ECHO_C" >&6; } if test "${ac_cv_type_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_long" >&5 echo "${ECHO_T}$ac_cv_type_long" >&6; } { echo "$as_me:$LINENO: checking alignment of long" >&5 echo $ECHO_N "checking alignment of long... $ECHO_C" >&6; } if test "${fp_cv_alignment_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_long" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_long=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; long ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; long ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; long ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; long ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; long ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_long=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_long=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_long" >&5 echo "${ECHO_T}$fp_cv_alignment_long" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_LONG $fp_cv_alignment_long _ACEOF if test "$ac_cv_type_long_long" = yes; then { echo "$as_me:$LINENO: checking for long long" >&5 echo $ECHO_N "checking for long long... $ECHO_C" >&6; } if test "${ac_cv_type_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_long_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_long_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_long_long" >&5 echo "${ECHO_T}$ac_cv_type_long_long" >&6; } { echo "$as_me:$LINENO: checking alignment of long long" >&5 echo $ECHO_N "checking alignment of long long... $ECHO_C" >&6; } if test "${fp_cv_alignment_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_long_long" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long long ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long long ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long long ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long long ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; long long ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_long_long=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (long long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (long long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; long long ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; long long ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; long long ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; long long ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; long long ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_long_long=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (long long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (long long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_long_long=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_long_long" >&5 echo "${ECHO_T}$fp_cv_alignment_long_long" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_LONG_LONG $fp_cv_alignment_long_long _ACEOF fi { echo "$as_me:$LINENO: checking for short" >&5 echo $ECHO_N "checking for short... $ECHO_C" >&6; } if test "${ac_cv_type_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef short ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_short=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_short=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_short" >&5 echo "${ECHO_T}$ac_cv_type_short" >&6; } { echo "$as_me:$LINENO: checking alignment of short" >&5 echo $ECHO_N "checking alignment of short... $ECHO_C" >&6; } if test "${fp_cv_alignment_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_short" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; short ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; short ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; short ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; short ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; short ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_short=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (short) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (short) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; short ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; short ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; short ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; short ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; short ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_short=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (short) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (short) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_short=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_short" >&5 echo "${ECHO_T}$fp_cv_alignment_short" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_SHORT $fp_cv_alignment_short _ACEOF { echo "$as_me:$LINENO: checking for unsigned char" >&5 echo $ECHO_N "checking for unsigned char... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned char ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_char=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_char=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_char" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_char" >&6; } { echo "$as_me:$LINENO: checking alignment of unsigned char" >&5 echo $ECHO_N "checking alignment of unsigned char... $ECHO_C" >&6; } if test "${fp_cv_alignment_unsigned_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_unsigned_char" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned char ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned char ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned char ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned char ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned char ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_unsigned_char=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned char) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned char) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; unsigned char ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; unsigned char ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; unsigned char ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; unsigned char ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; unsigned char ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_unsigned_char=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned char) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned char) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_unsigned_char=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_unsigned_char" >&5 echo "${ECHO_T}$fp_cv_alignment_unsigned_char" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_UNSIGNED_CHAR $fp_cv_alignment_unsigned_char _ACEOF { echo "$as_me:$LINENO: checking for unsigned int" >&5 echo $ECHO_N "checking for unsigned int... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned int ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_int=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_int=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_int" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_int" >&6; } { echo "$as_me:$LINENO: checking alignment of unsigned int" >&5 echo $ECHO_N "checking alignment of unsigned int... $ECHO_C" >&6; } if test "${fp_cv_alignment_unsigned_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_unsigned_int" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned int ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned int ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned int ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned int ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned int ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_unsigned_int=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; unsigned int ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; unsigned int ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; unsigned int ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; unsigned int ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; unsigned int ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_unsigned_int=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_unsigned_int=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_unsigned_int" >&5 echo "${ECHO_T}$fp_cv_alignment_unsigned_int" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_UNSIGNED_INT $fp_cv_alignment_unsigned_int _ACEOF { echo "$as_me:$LINENO: checking for unsigned long" >&5 echo $ECHO_N "checking for unsigned long... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_long" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_long" >&6; } { echo "$as_me:$LINENO: checking alignment of unsigned long" >&5 echo $ECHO_N "checking alignment of unsigned long... $ECHO_C" >&6; } if test "${fp_cv_alignment_unsigned_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_unsigned_long" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_unsigned_long=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; unsigned long ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; unsigned long ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; unsigned long ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; unsigned long ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; unsigned long ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_unsigned_long=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_unsigned_long=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_unsigned_long" >&5 echo "${ECHO_T}$fp_cv_alignment_unsigned_long" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_UNSIGNED_LONG $fp_cv_alignment_unsigned_long _ACEOF if test "$ac_cv_type_long_long" = yes; then { echo "$as_me:$LINENO: checking for unsigned long long" >&5 echo $ECHO_N "checking for unsigned long long... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned long long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_long_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_long_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_long_long" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_long_long" >&6; } { echo "$as_me:$LINENO: checking alignment of unsigned long long" >&5 echo $ECHO_N "checking alignment of unsigned long long... $ECHO_C" >&6; } if test "${fp_cv_alignment_unsigned_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_unsigned_long_long" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long long ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long long ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long long ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long long ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned long long ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_unsigned_long_long=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned long long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned long long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; unsigned long long ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; unsigned long long ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; unsigned long long ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; unsigned long long ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; unsigned long long ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_unsigned_long_long=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned long long) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned long long) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_unsigned_long_long=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_unsigned_long_long" >&5 echo "${ECHO_T}$fp_cv_alignment_unsigned_long_long" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_UNSIGNED_LONG_LONG $fp_cv_alignment_unsigned_long_long _ACEOF fi { echo "$as_me:$LINENO: checking for unsigned short" >&5 echo $ECHO_N "checking for unsigned short... $ECHO_C" >&6; } if test "${ac_cv_type_unsigned_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef unsigned short ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_unsigned_short=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_unsigned_short=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_unsigned_short" >&5 echo "${ECHO_T}$ac_cv_type_unsigned_short" >&6; } { echo "$as_me:$LINENO: checking alignment of unsigned short" >&5 echo $ECHO_N "checking alignment of unsigned short... $ECHO_C" >&6; } if test "${fp_cv_alignment_unsigned_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_unsigned_short" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned short ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned short ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned short ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned short ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; unsigned short ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_unsigned_short=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned short) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned short) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; unsigned short ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; unsigned short ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; unsigned short ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; unsigned short ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; unsigned short ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_unsigned_short=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (unsigned short) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (unsigned short) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_unsigned_short=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_unsigned_short" >&5 echo "${ECHO_T}$fp_cv_alignment_unsigned_short" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_UNSIGNED_SHORT $fp_cv_alignment_unsigned_short _ACEOF { echo "$as_me:$LINENO: checking for void *" >&5 echo $ECHO_N "checking for void *... $ECHO_C" >&6; } if test "${ac_cv_type_void_p+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef void * ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_void_p=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_void_p=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_void_p" >&5 echo "${ECHO_T}$ac_cv_type_void_p" >&6; } { echo "$as_me:$LINENO: checking alignment of void *" >&5 echo $ECHO_N "checking alignment of void *... $ECHO_C" >&6; } if test "${fp_cv_alignment_void_p+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_void_p" = yes; then if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; void * ty; } *)0)->ty)) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; void * ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; void * ty; } *)0)->ty)) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; void * ty; } *)0)->ty)) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (&((struct { char c; void * ty; } *)0)->ty)) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_cv_alignment_void_p=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute alignment (void *) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (void *) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default static long int longval () { return (long) (&((struct { char c; void * ty; } *)0)->ty); } static unsigned long int ulongval () { return (long) (&((struct { char c; void * ty; } *)0)->ty); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long) (&((struct { char c; void * ty; } *)0)->ty)) < 0) { long int i = longval (); if (i != ((long) (&((struct { char c; void * ty; } *)0)->ty))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long) (&((struct { char c; void * ty; } *)0)->ty))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_alignment_void_p=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute alignment (void *) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute alignment (void *) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val else fp_cv_alignment_void_p=0 fi fi { echo "$as_me:$LINENO: result: $fp_cv_alignment_void_p" >&5 echo "${ECHO_T}$fp_cv_alignment_void_p" >&6; } cat >>confdefs.h <<_ACEOF #define ALIGNMENT_VOID_P $fp_cv_alignment_void_p _ACEOF MkDefs=../MkDefs ac_config_files="$ac_config_files Makefile tools/config" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { echo "$as_me:$LINENO: updating cache $cache_file" >&5 echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by Hugs98 libraries $as_me 1.0, which was generated by GNU Autoconf 2.60a. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for. config_files="$ac_config_files" config_headers="$ac_config_headers" config_commands="$ac_config_commands" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Configuration commands: $config_commands Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ Hugs98 libraries config.status 1.0 configured by $0, generated by GNU Autoconf 2.60a, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2006 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header { echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 CONFIG_SHELL=$SHELL export CONFIG_SHELL exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "include/ghcconfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/ghcconfig.h" ;; "ultra-evil") CONFIG_COMMANDS="$CONFIG_COMMANDS ultra-evil" ;; "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; "tools/config") CONFIG_FILES="$CONFIG_FILES tools/config" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } # # Set up the sed scripts for CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "$CONFIG_FILES"; then _ACEOF # Create sed commands to just substitute file output variables. # Remaining file output variables are in a fragment that also has non-file # output varibles. ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF SHELL!$SHELL$ac_delim PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim PACKAGE_NAME!$PACKAGE_NAME$ac_delim PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim PACKAGE_STRING!$PACKAGE_STRING$ac_delim PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim exec_prefix!$exec_prefix$ac_delim prefix!$prefix$ac_delim program_transform_name!$program_transform_name$ac_delim bindir!$bindir$ac_delim sbindir!$sbindir$ac_delim libexecdir!$libexecdir$ac_delim datarootdir!$datarootdir$ac_delim datadir!$datadir$ac_delim sysconfdir!$sysconfdir$ac_delim sharedstatedir!$sharedstatedir$ac_delim localstatedir!$localstatedir$ac_delim includedir!$includedir$ac_delim oldincludedir!$oldincludedir$ac_delim docdir!$docdir$ac_delim infodir!$infodir$ac_delim htmldir!$htmldir$ac_delim dvidir!$dvidir$ac_delim pdfdir!$pdfdir$ac_delim psdir!$psdir$ac_delim libdir!$libdir$ac_delim localedir!$localedir$ac_delim mandir!$mandir$ac_delim DEFS!$DEFS$ac_delim ECHO_C!$ECHO_C$ac_delim ECHO_N!$ECHO_N$ac_delim ECHO_T!$ECHO_T$ac_delim LIBS!$LIBS$ac_delim build_alias!$build_alias$ac_delim host_alias!$host_alias$ac_delim target_alias!$target_alias$ac_delim CC!$CC$ac_delim CFLAGS!$CFLAGS$ac_delim LDFLAGS!$LDFLAGS$ac_delim CPPFLAGS!$CPPFLAGS$ac_delim ac_ct_CC!$ac_ct_CC$ac_delim EXEEXT!$EXEEXT$ac_delim OBJEXT!$OBJEXT$ac_delim CPP!$CPP$ac_delim GREP!$GREP$ac_delim EGREP!$EGREP$ac_delim CPP_TRADITIONAL!$CPP_TRADITIONAL$ac_delim SET_MAKE!$SET_MAKE$ac_delim fp_prog_find!$fp_prog_find$ac_delim FindCmd!$FindCmd$ac_delim fp_prog_sort!$fp_prog_sort$ac_delim SortCmd!$SortCmd$ac_delim LIBOBJS!$LIBOBJS$ac_delim LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 55; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` if test -n "$ac_eof"; then ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` ac_eof=`expr $ac_eof + 1` fi cat >>$CONFIG_STATUS <<_ACEOF cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof /@[a-zA-Z_][a-zA-Z_0-9]*@/!b end /^[ ]*@MkDefs@[ ]*$/{ r $MkDefs d } _ACEOF sed ' s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g s/^/s,@/; s/!/@,|#_!!_#|/ :n t n s/'"$ac_delim"'$/,g/; t s/$/\\/; p N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n ' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF :end s/|#_!!_#|//g CEOF$ac_eof _ACEOF # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/ s/:*\${srcdir}:*/:/ s/:*@srcdir@:*/:/ s/^\([^=]*=[ ]*\):*/\1/ s/:*$// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF fi # test -n "$CONFIG_FILES" for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS :C $CONFIG_COMMANDS do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 echo "$as_me: error: Invalid tag $ac_tag." >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac ac_file_inputs="$ac_file_inputs $ac_f" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input="Generated from "`IFS=: echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} fi case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin";; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= case `sed -n '/datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p ' $ac_file_inputs` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s&@configure_input@&$configure_input&;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out"; rm -f "$tmp/out";; *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; esac ;; :H) # # CONFIG_HEADER # _ACEOF # Transform confdefs.h into a sed script `conftest.defines', that # substitutes the proper values into config.h.in to produce config.h. rm -f conftest.defines conftest.tail # First, append a space to every undef/define line, to ease matching. echo 's/$/ /' >conftest.defines # Then, protect against being on the right side of a sed subst, or in # an unquoted here document, in config.status. If some macros were # called several times there might be several #defines for the same # symbol, which is useless. But do not sort them, since the last # AC_DEFINE must be honored. ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* # These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where # NAME is the cpp macro being defined, VALUE is the value it is being given. # PARAMS is the parameter list in the macro definition--in most cases, it's # just an empty string. ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' ac_dB='\\)[ (].*,\\1define\\2' ac_dC=' ' ac_dD=' ,' uniq confdefs.h | sed -n ' t rset :rset s/^[ ]*#[ ]*define[ ][ ]*// t ok d :ok s/[\\&,]/\\&/g s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p ' >>conftest.defines # Remove the space that was appended to ease matching. # Then replace #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. # (The regexp can be short, since the line contains either #define or #undef.) echo 's/ $// s,^[ #]*u.*,/* & */,' >>conftest.defines # Break up conftest.defines: ac_max_sed_lines=50 # First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" # Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" # Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" # et cetera. ac_in='$ac_file_inputs' ac_out='"$tmp/out1"' ac_nxt='"$tmp/out2"' while : do # Write a here document: cat >>$CONFIG_STATUS <<_ACEOF # First, check the format of the line: cat >"\$tmp/defines.sed" <<\\CEOF /^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def /^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def b :def _ACEOF sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail grep . conftest.tail >/dev/null || break rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines conftest.tail echo "ac_result=$ac_in" >>$CONFIG_STATUS cat >>$CONFIG_STATUS <<\_ACEOF if test x"$ac_file" != x-; then echo "/* $configure_input */" >"$tmp/config.h" cat "$ac_result" >>"$tmp/config.h" if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else rm -f $ac_file mv "$tmp/config.h" $ac_file fi else echo "/* $configure_input */" cat "$ac_result" fi rm -f "$tmp/out12" ;; :C) { echo "$as_me:$LINENO: executing $ac_file commands" >&5 echo "$as_me: executing $ac_file commands" >&6;} ;; esac case $ac_file$ac_mode in "ultra-evil":C) echo ' #undef PACKAGE_BUGREPORT #undef PACKAGE_NAME #undef PACKAGE_STRING #undef PACKAGE_TARNAME #undef PACKAGE_VERSION' >>include/ghcconfig.h ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi hugs98-plus-Sep2006/src/0000755006511100651110000000000010504340734013552 5ustar rossrosshugs98-plus-Sep2006/src/bcc32/0000755006511100651110000000000010504340135014441 5ustar rossrosshugs98-plus-Sep2006/src/bcc32/Makefile0000644006511100651110000001221107743000213016077 0ustar rossross# Generated automatically from Makefile.in by configure. # -------------------------------------------------------------------------- # Makefile for Hugs # # The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the # Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, # 1994-2003, All rights reserved. It is distributed as # free software under the license in the file "License", which is # included in the distribution. # -------------------------------------------------------------------------- # Targets: # # : make hugs.exe and runhugs.exe # install: make and install programs/libraries # hugs.exe: make minimal working system # runhugs.exe: make batch-mode version of Hugs # clean: delete files not required in running system # distclean: delete files that can be regenerated using C compiler # veryclean: delete all machine generated files # (you need perl, bison/yacc, etc to rebuild these files) # check: run regression tests # TAGS: build emacs TAGS table # This rule goes first to make it the default choice default :: hugs.exe runhugs.exe CC = bcc32 CFLAGS = -j5 -w-pia -w-aus -w-par -w-rvl* OPTFLAGS = -d -y- LD = ld LDFLAGS = DLL_FLAGS = -WDE PIC_FLAGS = LIBS = YACC = bison RM = DEL CP = COPY .SUFFIXES : .SUFFIXES : .c .h .obj HFILES = prelude.h config.h options.h storage.h connect.h \ errors.h command.h server.h HsFFI.h module.h machdep.h script.h CFILES = hugs.c storage.c input.c static.c type.c subst.c \ output.c compiler.c machine.c interp.c builtin.c \ server.c ffi.c module.c machdep.c script.c INCFILES = parser.c preds.c bignums.c scc.c timer.c \ printer.c iomonad.c interns.c array.c YFILES = parser.y SOURCES = $(HFILES) $(CFILES) $(INCFILES) $(YFILES) OBJECTS = storage.obj input.obj static.obj type.obj compiler.obj \ subst.obj plugin.obj builtin.obj machine.obj output.obj \ ffi.obj version.obj module.obj machdep.obj IOBJECTS = hugs.obj $(OBJECTS) PRELUDE = config.h options.h prelude.h script.h ################################################################ # Hugs interpreter and standalone evaluator ################################################################ hugs.exe : $(IOBJECTS) $(CC) $(LDFLAGS) @iobjects.rsp $(LIBS) -ohugs.exe SERVER_OBJECTS = server.obj $(OBJECTS) runhugs.obj : $(PRELUDE) hugs.c machdep.h timer.c runhugs.c runhugs.exe : runhugs.obj $(SERVER_OBJECTS) $(CC) $(LDFLAGS) runhugs.obj @sobjects.rsp $(LIBS) -orunhugs.exe ################################################################ # Clean, distclean, veryclean, TAGS ################################################################ clean :: $(RM) *.o $(RM) *.O $(RM) *.obj $(RM) *.OBJ $(RM) *.LIB $(RM) *.DEF $(RM) *.RES $(RM) *.EXP $(RM) *.ILK $(RM) *.PDB $(RM) *.TD2 $(RM) *.MAP $(RM) *.CSM $(RM) *.TR2 $(RM) *.DSW $(RM) *.aux $(RM) *.hp distclean :: clean distclean :: $(RM) hugs.exe $(RM) runhugs.exe $(RM) *.pdf $(RM) TAGS $(RM) *~ veryclean :: distclean veryclean :: $(RM) options.h $(RM) config.h $(RM) *.rsp TAGS :: etags *.[ych] ################################################################ # Dependencies ################################################################ .c.obj : $(CC) -c $(CFLAGS) $(OPTFLAGS) $< # These are compiled with less optimisation to avoid optimisation bugs in # certain compilers. This may be overly conservative on some compilers. compiler.obj : compiler.c $(CC) -c $(CFLAGS) compiler.c static.obj : static.c $(CC) -c $(CFLAGS) static.c # parser.c : parser.y # -$(YACC) parser.y # mv y.tab.c parser.c # veryclean :: # $(RM) parser.c server.obj : $(PRELUDE) storage.h connect.h errors.h \ command.h machdep.h timer.c hugs.c server.c server.h hugs.obj : $(PRELUDE) storage.h connect.h errors.h \ command.h machdep.h timer.c storage.obj : $(PRELUDE) storage.h connect.h errors.h input.obj : $(PRELUDE) storage.h connect.h errors.h \ parser.c command.h module.h subst.obj : $(PRELUDE) storage.h connect.h errors.h subst.h static.obj : $(PRELUDE) storage.h connect.h errors.h subst.h \ scc.c module.h type.obj : $(PRELUDE) storage.h connect.h errors.h subst.h \ scc.c preds.c output.obj : $(PRELUDE) storage.h connect.h errors.h compiler.obj : $(PRELUDE) storage.h connect.h errors.h machine.obj : $(PRELUDE) storage.h connect.h errors.h plugin.obj : $(PRELUDE) storage.h connect.h errors.h builtin.obj : $(PRELUDE) storage.h connect.h errors.h \ bignums.c printer.c iomonad.c interns.c array.c ffi.obj : $(PRELUDE) storage.h connect.h errors.h module.obj : $(PRELUDE) storage.h connect.h errors.h module.h machdep.obj : $(PRELUDE) storage.h connect.h errors.h machdep.h script.obj : $(PRELUDE) storage.h HsFFI.h connect.h errors.h ################################################################ # Regression tests (none supplied) ################################################################ check : ################################################################ # End of Makefile ################################################################ hugs98-plus-Sep2006/src/bcc32/config.bat0000644006511100651110000000026306727055602016415 0ustar rossrossrem Copy saved copies of .\Makefile, .\config.h and .\options.h to .. copy .\Makefile .. copy .\config.h .. copy .\options.h .. copy .\iobjects.rsp .. copy .\sobjects.rsp .. hugs98-plus-Sep2006/src/bcc32/config.h0000644006511100651110000002044610010230643016057 0ustar rossross/* ../config.h. Generated automatically by configure. */ /* ../config.h.in. Generated automatically from configure.in by autoheader. */ /* Define if using alloca.c. */ /* #undef C_ALLOCA */ /* Define to empty if the keyword does not work. */ /* #undef const */ /* Define to one of _getb67, GETB67, getb67 for Cray-2 and Cray-YMP systems. This function is required for alloca.c support on those systems. */ /* #undef CRAY_STACKSEG_END */ /* Define if you have alloca, as a function or macro. */ #define HAVE_ALLOCA 1 /* Define if you have and it should be used (not on Ultrix). */ /* #undef HAVE_ALLOCA_H */ /* Define if you have that is POSIX.1 compatible. */ /* #undef HAVE_SYS_WAIT_H */ /* Define as the return type of signal handlers (int or void). */ #define RETSIGTYPE void /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ /* #undef STACK_DIRECTION */ /* Define if you have the ANSI C header files. */ /* #undef STDC_HEADERS */ /* Define if you can safely include both and . */ /* #undef TIME_WITH_SYS_TIME */ /* Define if your declares struct tm. */ /* #undef TM_IN_SYS_TIME */ /* The following symbols are defined in options.h: * * BYTECODE_PRIMS * CHECK_TAGS * DEBUG_CODE * DEBUG_PRINTER * DONT_PANIC * GIMME_STACK_DUMPS * HUGSDIR * HUGSPATH * HUGSSUFFIXES * HUGS_FOR_WINDOWS * HUGS_VERSION * INTERNAL_PRIMS * LARGE_HUGS * PATH_CANONICALIZATION * PROFILING * REGULAR_HUGS * SMALL_BANNER * SMALL_HUGS * TREX * IPARAM * USE_PREPROCESSOR * USE_READLINE * WANT_TIMER */ /* Define if you have malloc.h and it defines _alloca - eg for Visual C++. */ #define HAVE__ALLOCA 1 /* Define if you have /bin/sh */ #define HAVE_BIN_SH 1 /* Define if you have the GetModuleFileName function. */ #define HAVE_GETMODULEFILENAME 1 /* Define if heap profiler can (and should) automatically invoke hp2ps * to convert heap profile (in "profile.hp") to postscript. */ #define HAVE_HP2PS 0 /* Define if compiler supports gcc's "labels as values" (aka computed goto) * feature (which is used to speed up instruction dispatch in the interpreter). * Here's what typical code looks like: * * void *label[] = { &&l1, &&l2 }; * ... * goto *label[i]; * l1: ... * l2: ... * ... */ #define HAVE_LABELS_AS_VALUES 0 /* Define if compiler supports prototypes. */ #define PROTOTYPES 1 /* Define if you have the WinExec function. */ #define HAVE_WINEXEC 1 /* Define if jmpbufs can be treated like arrays. * That is, if the following code compiles ok: * * #include * * int test1() { * jmp_buf jb[1]; * jmp_buf *jbp = jb; * return (setjmp(jb[0]) == 0); * } */ #define JMPBUF_ARRAY 1 /* Define if your C compiler inserts underscores before symbol names */ /* #undef LEADING_UNDERSCORE */ /* Define if signal handlers have type void (*)(int) * (Otherwise, they're assumed to have type int (*)(void).) */ #define VOID_INT_SIGNALS 1 /* The number of bytes in a double. */ #define SIZEOF_DOUBLE 8 /* The number of bytes in a float. */ #define SIZEOF_FLOAT 4 /* The number of bytes in a int. */ #define SIZEOF_INT 4 /* The number of bytes in a int*. */ #define SIZEOF_INTP 4 /* Define if you have the PBHSetVolSync function. */ /* #undef HAVE_PBHSETVOLSYNC */ /* Define if you have the _fullpath function. */ #define HAVE__FULLPATH 1 /* Define if you have the _pclose function. */ #define HAVE__PCLOSE 1 /* Define if you have the _popen function. */ #define HAVE__POPEN 1 /* Define if you have the _snprintf function. */ /* #undef HAVE__SNPRINTF */ /* Define if you have the _stricmp function. */ /* #undef HAVE__STRICMP */ /* Define if you have the _vsnprintf function. */ /* #undef HAVE__VSNPRINTF */ /* Define if you have the farcalloc function. */ /* #undef HAVE_FARCALLOC */ /* Define if you have the fgetpos function. */ #define HAVE_FGETPOS 1 /* Define if you have the fseek function. */ #define HAVE_FSEEK 1 /* Define if you have the fsetpos function. */ #define HAVE_FSETPOS 1 /* Define if you have the ftell function. */ #define HAVE_FTELL 1 /* Define if you have the macsystem function. */ /* #undef HAVE_MACSYSTEM */ /* Define if you have the pclose function. */ /* #undef HAVE_PCLOSE */ /* Define if you have the poly function. */ #define HAVE_POLY 1 /* Define if you have the popen function. */ /* #undef HAVE_POPEN */ /* Define if you have the realpath function. */ /* #undef HAVE_REALPATH */ /* Define if you have the snprintf function. */ /* #undef HAVE_SNPRINTF */ /* Define if you have the stime function. */ #define HAVE_STIME 1 /* Define if you have the strcasecmp function. */ /* #undef HAVE_STRCASECMP */ /* Define if you have the strcmp function. */ #define HAVE_STRCMP 1 /* Define if you have the strcmpi function. */ /* #undef HAVE_STRCMPI */ /* Define if you have the stricmp function. */ #define HAVE_STRICMP 1 /* Define if you have the valloc function. */ /* #undef HAVE_VALLOC */ /* Define if you have the vsnprintf function. */ /* #undef HAVE_VSNPRINTF */ /* Define if you have the header file. */ /* #undef HAVE_FILES_H */ /* Define if you have the header file. */ #define HAVE_ASSERT_H 1 /* Define if you have the header file. */ #define HAVE_CONIO_H 1 /* Define if you have the header file. */ /* #undef HAVE_CONSOLE_H */ /* Define if you have the header file. */ #define HAVE_CTYPE_H 1 /* Define if you have the header file. */ /* #undef HAVE_DL_H */ /* Define if you have the header file. */ /* #undef HAVE_DLFCN_H */ /* Define if you have the header file. */ #define HAVE_DOS_H 1 /* Define if you have the header file. */ #define HAVE_ERRNO_H 1 /* Define if you have the header file. */ #define HAVE_FCNTL_H 1 /* Define if you have the header file. */ #define HAVE_FLOAT_H 1 /* Define if you have the header file. */ #define HAVE_IO_H 1 /* Define if you have the header file. */ /* #undef HAVE_NLIST_H */ /* Define if you have the header file. */ /* #undef HAVE_PASCAL_H */ /* Define if you have the header file. */ /* #undef HAVE_SGTTY_H */ /* Define if you have the header file. */ #define HAVE_SIGNAL_H 1 /* Define if you have the header file. */ /* #undef HAVE_STAT_H */ /* Define if you have the header file. */ /* #undef HAVE_STD_H */ /* Define if you have the header file. */ #define HAVE_STDARG_H 1 /* Define if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define if you have the header file. */ #define HAVE_STRING_H 1 /* Define if you have the header file. */ /* #undef HAVE_SYS_IOCTL_H */ /* Define if you have the header file. */ /* #undef HAVE_SYS_PARAM_H */ /* Define if you have the header file. */ /* #undef HAVE_SYS_RESOURCE_H */ /* Define if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define if you have the header file. */ /* #undef HAVE_SYS_TIME_H */ /* Define if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define if you have the header file. */ /* #undef HAVE_TERMIO_H */ /* Define if you have the header file. */ /* #undef HAVE_TERMIOS_H */ /* Define if you have the header file. */ #define HAVE_TIME_H 1 /* Define if you have the header file. */ /* #undef HAVE_UNISTD_H */ /* Define if you have the header file. */ #define HAVE_VALUES_H 1 /* Define if you have the header file. */ #define HAVE_WINDOWS_H 1 /* Define if you have the editline library (-leditline). */ /* #undef HAVE_LIBEDITLINE */ /* Define if you have the dl library (-ldl). */ /* #undef HAVE_LIBDL */ /* Define if you have the dld library (-ldld). */ /* #undef HAVE_LIBDLD */ /* Define to 1 if floating point arithmetic is supported. */ #define FLOATS_SUPPORTED 1 /* Define if you have the editline library (-leditline). */ /* #undef HAVE_LIBREADLINE */ hugs98-plus-Sep2006/src/bcc32/config.sh0000644006511100651110000000264606727055602016270 0ustar rossross#!/bin/sh # Configure script for Hugs (using Borland bcc32) # Before we can run the configure script, we have to patch some # incompatabilities between Unix and Windows: # # o Borland C sends error messages to stdout (instead of stderr). # Replacing uses of ">/dev/null" with ">conftest.out" (which is # where stderr is normally sent) hacks around this. # # o Borland C insists that "-o" options be of the form "-ofoo" # - not -o foo. # # o Borland C writes input filenames to stderr as it processes them. # # o DOS truncates name to 8 characters which confuses conftestval # with the program conftest sed ../unix/configure >./config.fix \ -e "s#/dev/null#conftest.out#" \ -e "s/-o /-o/g" \ -e "s/-v '\^ \*+'/-i error/g" \ -e "s/test -s conftest/test -s conftest.exe/g" \ -e "s/conftestval/conftest.val/g" # Now we override the default values of some environment variables. set -a # All modified env vars are to be exported! CC=${CC="bcc32"} DEBUGFLAGS=${DEBUGFLAGS="-v"} LDDEBUGFLAGS=${LDDEBUGFLAGS="-v"} OPTFLAGS=${OPTFLAGS="-d -y-"} CFLAGS=${CFLAGS="-j5 -w-pia -w-aus -w-par -w-rvl*"} LDFLAGS=$LD CPP=${CPP="cpp32"} DLL_FLAGS=${DLL_FLAGS="-WDE"} # Run the script ./config.fix --target=windows $* # Now patch the Makefile - changing "-o foo" to "-ofoo". sed -e "s/-o /-o/g" ../Makefile >../Makefile.patch mv -f ../Makefile.patch ../Makefile # End hugs98-plus-Sep2006/src/bcc32/iobjects.rsp0000644006511100651110000000017006727055602017005 0ustar rossrosshugs.obj storage.obj input.obj static.obj type.obj compiler.obj subst.obj plugin.obj builtin.obj machine.obj output.obj hugs98-plus-Sep2006/src/bcc32/options.h0000644006511100651110000001773010426134734016326 0ustar rossross/* ../options.h. Generated automatically by configure. */ /* -------------------------------------------------------------------------- * Configuration options * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: options.h,v $ * $Revision: 1.17 $ * $Date: 2006/05/03 14:10:36 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Hugs paths and directories * ------------------------------------------------------------------------*/ /* Define this as the default setting of HUGSPATH. * Value may contain string "{Hugs}" (for which we will substitute the * value of HUGSDIR) and should be either colon-separated (Unix) * or semicolon-separated (Macintosh, Windows, DOS). Escape * characters in the path string are interpreted according to normal * Haskell conventions. * * This value can be overridden from the command line by setting the * HUGSFLAGS environment variable or by storing an appropriate value * for HUGSFLAGS in the registry (Win32 only). In all cases, use a * string of the form -P"...". */ #define HUGSPATH ".;{Hugs}\\packages\\*" /* The list of suffixes used by Haskell source files, separated either * by colons (Unix) or semicolons (Macintosh, Windows, DOS). * * This value can be overridden using the -S flag. */ #define HUGSSUFFIXES ".hs;.lhs" /* The directory name which is substituted for the string "{Hugs}" * in a path variable. This normally points to where the Hugs libraries * are installed - ie so that the file HUGSDIR/lib/Prelude.hs exists * Typical values are: * "/usr/local/lib/hugs" * "/usr/homes/JFHaskell/hugs" * ".." * * This value is ignored on Windows and Macintosh versions since * it is assumed that the binary is installed in HUGSDIR. * * This value cannot be overridden from the command line or by using * environment variables. This isn't quite as limiting as you'd think * since you can always choose _not_ to use the {Hugs} variable - however, * it's obviously _nicer_ to have it set correctly. */ #ifndef HUGSDIR #define HUGSDIR "" #endif /* -------------------------------------------------------------------------- * User interface options * ------------------------------------------------------------------------*/ /* Define if you want to use the "Hugs for Windows" GUI. * (Windows 3.1 and compatibles only) */ #define HUGS_FOR_WINDOWS 0 /* Define if you want filenames to be converted to normal form by: * o replacing relative pathnames with absolute pathnames and * eliminating .. and . where possible. * o converting to lower case (only in case-insensitive filesystems) */ #define PATH_CANONICALIZATION 0 /* Define if a command line editor is available and should be used. * There are two choices of command line editor that can be used with Hugs: * GNU readline and editline (from comp.sources.misc, vol 31, issue 71) */ #define USE_READLINE 0 /* Define if you want the small startup banner. */ #define SMALL_BANNER 0 /* -------------------------------------------------------------------------- * Making Hugs smaller * ------------------------------------------------------------------------*/ /* Define one of these to select overall size of Hugs * SMALL_HUGS for 16 bit operation on a limited memory PC. * REGULAR_HUGS for 32 bit operation using largish default table sizes. * LARGE_HUGS for 32 bit operation using larger default table sizes. */ #define SMALL_HUGS 0 #define REGULAR_HUGS 0 #define LARGE_HUGS 1 /* -------------------------------------------------------------------------- * Fancy features * ------------------------------------------------------------------------*/ /* Define if heap profiling should be used */ #define PROFILING 0 /* Define if you want to run Haskell code through a preprocessor * * Note that there's the import chasing mechanism will not spot any * #includes so you must :load (not :reload) if you change any * (non-Haskell) configurations files. */ #define USE_PREPROCESSOR 1 /* Define if you want to time every evaluation. * * Timing is included in the Hugs distribution for the purpose of benchmarking * the Hugs interpreter, comparing its performance across a variety of * different machines, and with other systems for similar languages. * * It would be somewhat foolish to try to use the timings produced in this * way for any other purpose. In particular, using timings to compare the * performance of different versions of an algorithm is likely to give very * misleading results. The current implementation of Hugs as an interpreter, * without any significant optimizations, means that there are much more * significant overheads than can be accounted for by small variations in * Hugs code. */ /* #undef WANT_TIMER */ /* * By default, the Hugs Server API wraps up each value pushed on the stack * as a Dynamic, achieving some run-time type safety when applying these * arguments to a function. This Dynamic layer sometimes gets in the way * for low-level consumers of the Server API (e.g, HaskellScript, Lambada, * mod_haskell), so by setting NO_DYNAMIC_TYPES to 1 you turn off the * use of Dynamics (and assume all the responsibility of debugging any * bad crashes you might see as a result!) */ /* #undef NO_DYNAMIC_TYPES */ /* -------------------------------------------------------------------------- * Debugging options (intended for use by maintainers) * ------------------------------------------------------------------------*/ /* Define if debugging generated bytecodes or the bytecode interpreter */ #define DEBUG_CODE 0 /* Define if debugging generated supercombinator definitions or compiler */ #define DEBUG_SHOWSC 0 /* Define if you want to use a low-level printer from within a debugger */ #define DEBUG_PRINTER 0 /* Define if you want to perform runtime tag-checks as an internal * consistency check. This makes Hugs run very slowly - but is very * effective at detecting and locating subtle bugs. */ #define CHECK_TAGS 0 /* -------------------------------------------------------------------------- * Experimental features * These are likely to disappear/change in future versions and should not * be used by most people.. * ------------------------------------------------------------------------*/ /* Define if you want to use the primitives which let you examine Hugs * internals. */ #define INTERNAL_PRIMS 0 /* Define if you want to use the primitives which let you examine Hugs * bytecodes (requires INTERNAL_PRIMS). */ #define BYTECODE_PRIMS 0 /* In a plain Hugs system, most signals (SIGBUS, SIGTERM, etc) indicate * some kind of error in Hugs - or maybe a stack overflow. Rather than * just crash, Hugs catches these errors and returns to the main loop. * It does this by calling a function "panic" which longjmp's back to the * main loop. * If you're developing a GreenCard library, this may not be the right * behaviour - it's better if Hugs leaves them for your debugger to * catch rather than trapping them and "panicing". */ #define DONT_PANIC 0 /* If you get really desperate to understand why your Hugs programs keep * crashing or running out of stack, you might like to set this flag and * recompile Hugs. When you hit a stack error, it will print out a list * of all the objects currently under evaluation. The information isn't * perfect and can be pretty hard to understand but it's better than a * poke in the eye with a blunt stick. * * This is a very experimental feature! */ #define GIMME_STACK_DUMPS 0 /* ----------------------------------------------------------------------- */ hugs98-plus-Sep2006/src/bcc32/sobjects.rsp0000644006511100651110000000017206727055602017021 0ustar rossrossserver.obj storage.obj input.obj static.obj type.obj compiler.obj subst.obj plugin.obj builtin.obj machine.obj output.obj hugs98-plus-Sep2006/src/.cvsignore0000644006511100651110000000013510333134354015550 0ustar rossross*.exp *.lib Makefile config.h config.h.in ffihugs hugs options.h parser.c platform.h runhugs hugs98-plus-Sep2006/src/.gdbinit0000644006511100651110000000010306727055601015175 0ustar rossrossbreak internal break evalFails break errHead # break garbageCollecthugs98-plus-Sep2006/src/HsFFI.h0000644006511100651110000002611110311014447014616 0ustar rossross#ifndef __HSFFI_H__ #define __HSFFI_H__ typedef unsigned char hugs_uint8_t; typedef unsigned short hugs_uint16_t; typedef unsigned int hugs_uint32_t; typedef signed char hugs_int8_t; typedef signed short hugs_int16_t; typedef signed int hugs_int32_t; # ifdef _MSC_VER typedef unsigned __int64 hugs_uint64_t; typedef __int64 hugs_int64_t; # else typedef unsigned long long hugs_uint64_t; typedef signed long long hugs_int64_t; # endif /* * The ifdef Args is a crude way of testing whether this file is * #included into Hugs. Use it to eliminate non-portable stuff. */ #ifdef Args /* #included into Hugs */ typedef Int HsInt; typedef Int8 HsInt8; typedef Int16 HsInt16; typedef Int HsInt32; typedef unsigned int HsWord; typedef unsigned char HsWord8; typedef unsigned short HsWord16; typedef unsigned int HsWord32; #else /* #included into user-provided C code */ typedef int HsInt; typedef hugs_int8_t HsInt8; typedef hugs_int16_t HsInt16; typedef hugs_int32_t HsInt32; typedef unsigned int HsWord; typedef hugs_uint8_t HsWord8; typedef hugs_uint16_t HsWord16; typedef hugs_uint32_t HsWord32; #endif /* * Here we deviate from the FFI specification: * If we make them both float, then there's no way to pass a double * to C which means we can't call common C functions like sin. */ typedef float HsFloat; typedef double HsDouble; typedef hugs_int64_t HsInt64; typedef hugs_uint64_t HsWord64; typedef int HsChar; typedef int HsBool; typedef void* HsAddr; typedef void* HsPtr; typedef void (*HsFunPtr)(void); typedef void* HsForeignPtr; typedef void* HsStablePtr; #define HS_CHAR_MIN 0 #define HS_CHAR_MAX 0x10FFFF #define HS_BOOL_FALSE 0 #define HS_BOOL_TRUE 1 #define HS_BOOL_MIN HS_BOOL_FALSE #define HS_BOOL_MAX HS_BOOL_TRUE #define HS_INT_MIN __INT32_MIN #define HS_INT_MAX __INT32_MAX #define HS_INT8_MIN __INT8_MIN #define HS_INT8_MAX __INT8_MAX #define HS_INT16_MIN __INT16_MIN #define HS_INT16_MAX __INT16_MAX #define HS_INT32_MIN __INT32_MIN #define HS_INT32_MAX __INT32_MAX #define HS_INT64_MIN __INT64_MIN #define HS_INT64_MAX __INT64_MAX #define HS_WORD8_MAX __UINT8_MAX #define HS_WORD16_MAX __UINT16_MAX #define HS_WORD32_MAX __UINT32_MAX #define HS_WORD64_MAX __UINT64_MAX #ifndef Args #include #define HS_FLOAT_RADIX FLT_RADIX #define HS_FLOAT_ROUNDS FLT_ROUNDS #define HS_FLOAT_EPSILON FLT_EPSILON #define HS_FLOAT_DIG FLT_DIG #define HS_FLOAT_MANT_DIG FLT_MANT_DIG #define HS_FLOAT_MIN FLT_MIN #define HS_FLOAT_MIN_EXP FLT_MIN_EXP #define HS_FLOAT_MIN_10_EXP FLT_MIN_10_EXP #define HS_FLOAT_MAX FLT_MAX #define HS_FLOAT_MAX_EXP FLT_MAX_EXP #define HS_FLOAT_MAX_10_EXP FLT_MAX_10_EXP #define HS_DOUBLE_RADIX DBL_RADIX #define HS_DOUBLE_ROUNDS DBL_ROUNDS #define HS_DOUBLE_EPSILON DBL_EPSILON #define HS_DOUBLE_DIG DBL_DIG #define HS_DOUBLE_MANT_DIG DBL_MANT_DIG #define HS_DOUBLE_MIN DBL_MIN #define HS_DOUBLE_MIN_EXP DBL_MIN_EXP #define HS_DOUBLE_MIN_10_EXP DBL_MIN_10_EXP #define HS_DOUBLE_MAX DBL_MAX #define HS_DOUBLE_MAX_EXP DBL_MAX_EXP #define HS_DOUBLE_MAX_10_EXP DBL_MAX_10_EXP #endif /* included into user code */ typedef int HugsStackPtr; typedef void* HugsForeign; typedef int HugsStablePtr; typedef void (*HugsPrim) (HugsStackPtr); /* primitive function */ #ifndef Args struct hugs_primitive { /* table of primitives */ char* ref; /* primitive reference string */ int arity; /* primitive function arity */ HugsPrim imp; /* primitive implementation */ }; struct hugs_primInfo { void (*controlFun)(int); struct hugs_primitive *primFuns; struct hugs_primInfo *nextPrimInfo; }; #else #define hugs_primInfo primInfo #endif /* API Version number */ #define HUGS_API_VERSION 5 typedef struct { /* evaluate next argument */ HsBool (*getBool) (void); HsInt (*getInt) (void); HsWord (*getWord) (void); HsAddr (*getAddr) (void); HsFloat (*getFloat) (void); HsDouble (*getDouble) (void); HsChar (*getChar) (void); HugsForeign (*getForeign) (void); HsStablePtr (*getStablePtr4) (void); HsInt8 (*getInt8) (void); HsInt16 (*getInt16) (void); HsInt32 (*getInt32) (void); HsInt64 (*getInt64) (void); HsWord8 (*getWord8) (void); HsWord16 (*getWord16) (void); HsWord32 (*getWord32) (void); HsWord64 (*getWord64) (void); HsPtr (*getPtr) (void); HsFunPtr (*getFunPtr) (void); HsForeignPtr (*getForeignPtr) (void); /* push result */ void (*putBool) (HsBool); void (*putInt) (HsInt); void (*putWord) (HsWord); void (*putAddr) (HsAddr); void (*putFloat) (HsFloat); void (*putDouble) (HsDouble); void (*putChar) (HsChar); void (*putForeign) (HugsForeign, void (*)(HugsForeign)); void (*putInt8) (HsInt8); void (*putInt16) (HsInt16); void (*putInt32) (HsInt32); void (*putInt64) (HsInt64); void (*putWord8) (HsWord8); void (*putWord16) (HsWord16); void (*putWord32) (HsWord32); void (*putWord64) (HsWord64); void (*putPtr) (HsPtr); void (*putFunPtr) (HsFunPtr); void (*putForeignPtr) (HsForeignPtr); void (*putStablePtr4) (HsStablePtr); /* return in IO monad or Id monad */ void (*returnIO) (HugsStackPtr, int); int (*runIO) (int); void (*returnId) (HugsStackPtr, int); int (*runId) (int); /* register the prim table */ void (*registerPrims) (struct hugs_primInfo*); HugsStablePtr (*lookupName) (char*, char*); void (*ap) (int); void (*getUnit) (void); void* (*mkThunk) (HsFunPtr, HugsStablePtr); void (*freeThunk) (void*); HugsStablePtr (*makeStablePtr4) (void); void (*derefStablePtr4)(HugsStablePtr); void (*freeStablePtr4) (HsStablePtr); } HugsAPI5; /* Note: the change in going from version 4 to 5 is that with 5 (and later), the DLLs specify the HugsAPI version assumed by the DLL primitives. The HugsAPI method table is _not_ identical to 4's; it has been re-orged and tidied up. */ extern HugsAPI5* hugsAPI5 (void); typedef void (*InitModuleFun5) (HugsAPI5*); typedef int (*APIVersionFun) (void); /* To ensure backward compatibility, HugsAPI4 is also supported: * (due to the HugsAPI4 vtbl being an extension of HugsAPI3's and * HugsAPI2's, support for these two comes for free.) */ typedef struct { /* evaluate next argument */ HsInt (*getInt) (void); HsWord (*getWord) (void); HsAddr (*getAddr) (void); HsFloat (*getFloat) (void); HsDouble (*getDouble) (void); char (*getChar) (void); HugsForeign (*getForeign) (void); HugsStablePtr (*getStablePtr) (void); /* deprecated */ /* push part of result */ void (*putInt) (HsInt); void (*putWord) (HsWord); void (*putAddr) (HsAddr); void (*putFloat) (HsFloat); void (*putDouble) (HsDouble); void (*putChar) (char); void (*putForeign) (HugsForeign, void (*)(HugsForeign)); void (*putStablePtr) (HugsStablePtr); /* deprecated */ /* return n values in IO monad or Id monad */ void (*returnIO) (HugsStackPtr, int); void (*returnId) (HugsStackPtr, int); int (*runIO) (int); /* free a stable pointer */ void (*freeStablePtr) (HugsStablePtr); /* deprecated */ /* register the prim table */ void (*registerPrims) (struct hugs_primInfo*); /* garbage collect */ void (*garbageCollect) (void); /* API3 additions follow */ HugsStablePtr (*lookupName) (char*, char*); void (*ap) (int); void (*getUnit) (void); void* (*mkThunk) (HsFunPtr, HugsStablePtr); void (*freeThunk) (void*); HsBool (*getBool) (void); void (*putBool) (HsBool); /* API4 additions follow */ HsInt8 (*getInt8) (void); HsInt16 (*getInt16) (void); HsInt32 (*getInt32) (void); HsInt64 (*getInt64) (void); HsWord8 (*getWord8) (void); HsWord16 (*getWord16) (void); HsWord32 (*getWord32) (void); HsWord64 (*getWord64) (void); HsPtr (*getPtr) (void); HsFunPtr (*getFunPtr) (void); HsForeignPtr (*getForeignPtr) (void); void (*putInt8) (HsInt8); void (*putInt16) (HsInt16); void (*putInt32) (HsInt32); void (*putInt64) (HsInt64); void (*putWord8) (HsWord8); void (*putWord16) (HsWord16); void (*putWord32) (HsWord32); void (*putWord64) (HsWord64); void (*putPtr) (HsPtr); void (*putFunPtr) (HsFunPtr); void (*putForeignPtr) (HsForeignPtr); HugsStablePtr (*makeStablePtr4) (void); void (*derefStablePtr4)(HugsStablePtr); void (*putStablePtr4) (HsStablePtr); HsStablePtr (*getStablePtr4) (void); void (*freeStablePtr4) (HsStablePtr); int (*runId) (int); } HugsAPI4; extern HugsAPI4* hugsAPI4 (void); typedef void (*InitModuleFun4) (HugsAPI4*); extern void hs_perform_gc(void); extern void hs_free_stable_ptr(HsStablePtr sp); extern void hs_free_fun_ptr(HsFunPtr fp); /* Copied verbatim from prelude.h */ #if defined(__BORLANDC__) # define DLLIMPORT(rty) rty far _import # define DLLEXPORT(rty) rty far _export #elif defined(_WIN32) /* Microsoft Windows */ # define DLLIMPORT(rty) __declspec(dllimport) rty # define DLLEXPORT(rty) __declspec(dllexport) rty #else # define DLLIMPORT(rty) rty # define DLLEXPORT(rty) rty #endif /* Don't need to declare DLL exports */ #endif /* __HSFFI_H__ */ hugs98-plus-Sep2006/src/HugsAPI.h0000644006511100651110000000464410010230642015157 0ustar rossross/* -------------------------------------------------------------------------- * Definition of the external Hugs server API * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: HugsAPI.h,v $ * $Revision: 1.3 $ * $Date: 2004/02/04 17:53:38 $ * ------------------------------------------------------------------------*/ #ifndef __HUGSAPI_H__ #define __HUGSAPI_H__ #ifndef Args # if PROTOTYPES # define Args(x) x # else # define Args(x) () # endif #endif /* !defined Args */ #ifdef __cplusplus extern "C" { #endif typedef int HVal; /* Haskell values are represented by stable pointers */ typedef struct _HugsServerAPI { char* (*clearError ) Args((void)); void (*setHugsArgs ) Args((int, char**)); int (*getNumScripts ) Args((void)); void (*reset ) Args((int)); void (*setOutputEnable) Args((unsigned)); void (*changeDir ) Args((char*)); void (*loadProject ) Args((char*)); void (*loadFile ) Args((char*)); void (*loadFromBuffer ) Args((char*)); void (*setOptions ) Args((char*)); char* (*getOptions ) Args((void)); HVal (*compileExpr ) Args((char*,char*)); void (*garbageCollect ) Args((void)); void (*lookupName ) Args((char*,char*)); /* push values onto stack*/ void (*mkInt ) Args((int)); void (*mkAddr ) Args((void*)); void (*mkString ) Args((char*)); void (*apply ) Args((void)); /* manipulate top of stack */ int (*evalInt ) Args((void)); /* evaluate top of stack */ void* (*evalAddr ) Args((void)); char* (*evalString ) Args((void)); int (*doIO ) Args((void)); int (*doIO_Int ) Args((int*)); int (*doIO_Addr ) Args((void**)); HVal (*popHVal ) Args((void)); /* pop stack */ void (*pushHVal ) Args((HVal)); /* push back onto stack */ void (*freeHVal ) Args((HVal)); } HugsServerAPI; DLLEXPORT(HugsServerAPI*) initHugsServer Args((Int, String[])); DLLEXPORT(Void) shutdownHugsServer Args((HugsServerAPI*)); #ifdef __cplusplus }; #endif #endif /* __HUGSAPI_H__ */ hugs98-plus-Sep2006/src/Makefile.in0000644006511100651110000001657410464157152015641 0ustar rossross# @configure_input@ # -------------------------------------------------------------------------- # Makefile for Hugs interpreter # (this should be a POSIX 1003.2-1992 Makefile) # # The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the # Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, # 1994-2004, All rights reserved. It is distributed as # free software under the license in the file "License", which is # included in the distribution. # -------------------------------------------------------------------------- # Targets: # # : make hugs@EXEEXT@ and runhugs@EXEEXT@ # install: make and install programs # hugs@EXEEXT@: make minimal working system # runhugs@EXEEXT@: make batch-mode version of Hugs # clean: delete files not required in running system # distclean: delete files that can be regenerated using C compiler # veryclean: delete all machine generated files # (you need perl, bison/yacc, etc to rebuild these files) # TAGS: build emacs TAGS table CC = @CC@ CFLAGS = @CFLAGS@ @DEBUGFLAGS@ OPTFLAGS = @OPTFLAGS@ LD = @LD@ LDFLAGS = @LDFLAGS@ @LDDEBUGFLAGS@ LIBS = @LIBS@ YACC = @YACC@ RM = @RM@ CP = @CP@ EXEEXT = @EXEEXT@ OBJEXT = @OBJEXT@ STRIP = @STRIP@ # These variables determine where various parts of the Hugs system are # installed. (They are ignored in Windows or DOS.) # Binaries are installed in $(bindir); libraries go in $(hugsdir)/libraries prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ datarootdir = @datarootdir@ datadir = @datadir@ mandir = @mandir@ hugsdir = @hugsdir@ .SUFFIXES : .SUFFIXES : .c .h .$(OBJEXT) HFILES = HsFFI.h builtin.h char.h command.h config.h connect.h \ errors.h evaluator.h goal.h machdep.h module.h observe.h \ options.h opts.h output.h prelude.h script.h server.h \ storage.h strutil.h subst.h CFILES = hugs.c runhugs.c server.c edit.c observe.c \ builtin.c char.c compiler.c errors.c evaluator.c ffi.c \ goal.c input.c machdep.c machine.c module.c opts.c \ output.c plugin.c script.c static.c storage.c strutil.c \ subst.c type.c version.c INCFILES = array.c bignums.c dirprim.c interns.c iomonad.c \ preds.c printer.c scc.c timeprim.c timer.c YFILES = parser.y SOURCES = $(HFILES) $(CFILES) $(INCFILES) $(YFILES) OBJECTS = builtin.$(OBJEXT) char.$(OBJEXT) compiler.$(OBJEXT) \ errors.$(OBJEXT) evaluator.$(OBJEXT) ffi.$(OBJEXT) \ goal.$(OBJEXT) input.$(OBJEXT) machdep.$(OBJEXT) \ machine.$(OBJEXT) module.$(OBJEXT) opts.$(OBJEXT) \ output.$(OBJEXT) plugin.$(OBJEXT) script.$(OBJEXT) \ static.$(OBJEXT) storage.$(OBJEXT) strutil.$(OBJEXT) \ subst.$(OBJEXT) type.$(OBJEXT) version.$(OBJEXT) IOBJECTS = hugs.$(OBJEXT) edit.$(OBJEXT) observe.$(OBJEXT) $(OBJECTS) WOBJECTS = @WOBJECTS@ RC_FILES = @RC_FILES@ ################################################################ # Default target ################################################################ # This rule goes first to make it the default choice default :: all all :: hugs$(EXEEXT) runhugs$(EXEEXT) ffihugs$(EXEEXT) ################################################################ # Hugs interpreter and standalone evaluator ################################################################ hugs$(EXEEXT) : $(IOBJECTS) $(WOBJECTS) $(RC_FILES) $(CC) $(LDFLAGS) $(IOBJECTS) $(WOBJECTS) $(LIBS) -o hugs$(EXEEXT) $(STRIP) version.$(OBJEXT) : version.c $(SOURCES) @$(CC) \ -DMONTH_YEAR='"'"`date +'%B %Y' 2> /dev/null`"'"' \ -DYYYYMMDD='"'"`date +'%Y%m%d' 2> /dev/null`"'"' \ -c $(CFLAGS) $(OPTFLAGS) $< SERVER_OBJECTS = server.$(OBJEXT) $(OBJECTS) runhugs$(EXEEXT) : runhugs.$(OBJEXT) $(SERVER_OBJECTS) $(CC) $(LDFLAGS) runhugs.$(OBJEXT) $(SERVER_OBJECTS) $(LIBS) -o runhugs$(EXEEXT) ffihugs$(EXEEXT) : ffihugs.$(OBJEXT) $(SERVER_OBJECTS) $(CC) $(LDFLAGS) ffihugs.$(OBJEXT) $(SERVER_OBJECTS) $(LIBS) -o ffihugs$(EXEEXT) ffihugs.$(OBJEXT) : runhugs.$(OBJEXT) $(CC) -c $(CFLAGS) $(OPTFLAGS) -DFFI_COMPILER runhugs.c -o ffihugs.$(OBJEXT) ################################################################ # Clean, distclean, veryclean, TAGS ################################################################ clean :: $(RM) *.o $(RM) *.O $(RM) *.obj $(RM) *.OBJ $(RM) *.LIB $(RM) *.DEF $(RM) *.RES $(RM) *.EXP $(RM) *.ILK $(RM) *.PDB $(RM) *.TD2 $(RM) *.MAP $(RM) *.CSM $(RM) *.TR2 $(RM) *.DSW $(RM) *.aux $(RM) *.hp distclean :: clean distclean :: $(RM) hugs$(EXEEXT) $(RM) runhugs$(EXEEXT) $(RM) ffihugs$(EXEEXT) $(RM) Makefile $(RM) config.h $(RM) options.h $(RM) platform.h $(RM) *.pdf $(RM) TAGS tags $(RM) *~ veryclean :: distclean veryclean :: TAGS :: etags *.[ych] ################################################################ # C and Yacc rules ################################################################ .c.$(OBJEXT) : $(CC) -c $(CFLAGS) $(OPTFLAGS) $< # Modules to be compiled without optimization. # (old comment: to avoid optimisation bugs in certain compilers. # This may be overly conservative on some compilers.) # (The following explanation is based on a posting by Alastair Reid.) # These modules allocate cells on the Hugs heap and assume a conservative # garbage collector. On some (especially RISC) architectures, the # optimizer may identify a pointer to a Cell as a common subexpression, # and hold that instead of the Cell. This would then be missed by the # conservative garbage collector's simplistic scan of the C stack. # Modules associated with evaluation are safe because they don't assume # conservative GC (see IMPORTANT NOTICE in builtin.c). compiler.$(OBJEXT) : compiler.c $(CC) -c $(CFLAGS) compiler.c module.$(OBJEXT) : module.c $(CC) -c $(CFLAGS) module.c subst.$(OBJEXT) : subst.c $(CC) -c $(CFLAGS) subst.c static.$(OBJEXT) : static.c $(CC) -c $(CFLAGS) static.c type.$(OBJEXT) : type.c $(CC) -c $(CFLAGS) type.c parser.c : parser.y -$(YACC) parser.y mv y.tab.c parser.c # veryclean :: # $(RM) parser.c ################################################################ # Generating object dependencies (requires gcc) ################################################################ HUGS_MAKEFILES = Makefile dotnet/Makefile msc/Makefile winhugs/Makefile # optional definitions that govern include files EXTRA_DEFINES = -DINTERNAL_PRIMS -DUNICODE_CHARS -DWANT_TIMER depend: $(SOURCES) parser.c gcc -MM $(EXTRA_DEFINES) $(CFILES) | sed 's/\.o:/.$$(OBJEXT):/' >TMP if cmp -s TMP MkDepend.in; then : ; else \ $(CP) TMP MkDepend.in; \ for mfile in $(HUGS_MAKEFILES);\ do (echo '/^# Generated object dependencies/+++,/^# End of generated object dependencies/---d';\ echo '-r MkDepend.in';\ echo w) | ed - $$mfile; \ done;\ fi rm TMP ################################################################ # Generated object dependencies (Don't change or delete this line) ################################################################ @MkDepend@ ################################################################ # End of generated object dependencies (Don't change or delete this line) ################################################################ @MkInstall@ ################################################################ # End of Makefile ################################################################ hugs98-plus-Sep2006/src/MkDepend.in0000644006511100651110000000730307767053456015617 0ustar rossrosshugs.$(OBJEXT): hugs.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ command.h connect.h errors.h script.h opts.h strutil.h evaluator.h \ machdep.h output.h module.h timer.c runhugs.$(OBJEXT): runhugs.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h machdep.h observe.h builtin.h evaluator.h errors.h \ server.h HugsAPI.h server.$(OBJEXT): server.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h script.h machdep.h evaluator.h opts.h strutil.h \ errors.h server.h HugsAPI.h edit.$(OBJEXT): edit.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h opts.h strutil.h machdep.h observe.$(OBJEXT): observe.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h command.h errors.h machdep.h builtin.h output.h \ observe.h builtin.$(OBJEXT): builtin.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h machdep.h char.h builtin.h bignums.c \ printer.c iomonad.c timeprim.c dirprim.c interns.c array.c char.$(OBJEXT): char.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h char.h unitable.c compiler.$(OBJEXT): compiler.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h goal.h char.h output.h opts.h errors.$(OBJEXT): errors.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h opts.h goal.h char.h evaluator.h evaluator.$(OBJEXT): evaluator.c prelude.h config.h platform.h options.h \ storage.h HsFFI.h connect.h errors.h script.h output.h strutil.h opts.h \ machdep.h evaluator.h ffi.$(OBJEXT): ffi.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h output.h strutil.h goal.$(OBJEXT): goal.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h machdep.h opts.h goal.h input.$(OBJEXT): input.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h command.h errors.h module.h script.h opts.h goal.h \ machdep.h char.h parser.c machdep.$(OBJEXT): machdep.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h opts.h strutil.h machdep.h char.h \ evaluator.h machine.$(OBJEXT): machine.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h char.h opts.h module.$(OBJEXT): module.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h module.h output.h opts.$(OBJEXT): opts.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h machdep.h strutil.h opts.h char.h output.$(OBJEXT): output.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h char.h plugin.$(OBJEXT): plugin.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h script.$(OBJEXT): script.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h machdep.h opts.h strutil.h script.h static.$(OBJEXT): static.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h machdep.h errors.h output.h subst.h module.h opts.h \ goal.h scc.c storage.$(OBJEXT): storage.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h opts.h errors.h machdep.h evaluator.h strutil.h \ output.h strutil.$(OBJEXT): strutil.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h strutil.h subst.$(OBJEXT): subst.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h opts.h subst.h type.$(OBJEXT): type.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h output.h subst.h goal.h opts.h preds.c scc.c version.$(OBJEXT): version.c prelude.h config.h platform.h options.h hugs98-plus-Sep2006/src/MkInstal.in0000644006511100651110000000066410134600703015624 0ustar rossross################################################################ # Installation (Unix only) ################################################################ INSTALL = ../install-sh install :: hugs$(EXEEXT) runhugs$(EXEEXT) ffihugs$(EXEEXT) $(INSTALL) -d $(DESTDIR)$(bindir) $(INSTALL) -c hugs$(EXEEXT) $(DESTDIR)$(bindir) $(INSTALL) -c runhugs$(EXEEXT) $(DESTDIR)$(bindir) $(INSTALL) -c ffihugs$(EXEEXT) $(DESTDIR)$(bindir) hugs98-plus-Sep2006/src/MkNull.in0000644006511100651110000000000106727055601015303 0ustar rossross hugs98-plus-Sep2006/src/array.c0000644006511100651110000002735207776503713015064 0ustar rossross/* -------------------------------------------------------------------------- * Haskell array primitives. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: array.c,v $ * $Revision: 1.10 $ * $Date: 2004/01/06 10:02:51 $ * ------------------------------------------------------------------------*/ static Name nameEltUndef; /* undefined element in array */ PROTO_PRIM(primArray); PROTO_PRIM(primUpdate); PROTO_PRIM(primAccum); PROTO_PRIM(primAccumArray); PROTO_PRIM(primAmap); PROTO_PRIM(primSubscript); PROTO_PRIM(primBounds); PROTO_PRIM(primElems); PROTO_PRIM(primEltUndef); #if IO_MONAD PROTO_PRIM(primIONewArr); PROTO_PRIM(primIOReadArr); PROTO_PRIM(primIOWriteArr); PROTO_PRIM(primIOFreeze); PROTO_PRIM(primIOArrEq); #endif static struct primitive arrayPrimTable[] = { {"primArray", 3, primArray}, {"primUpdate", 2, primUpdate}, {"primAccum", 3, primAccum}, {"primAccumArray", 5, primAccumArray}, {"primAmap", 2, primAmap}, {"primSubscript", 2, primSubscript}, {"primBounds", 1, primBounds}, {"primElems", 1, primElems}, {"eltUndef", 0, primEltUndef}, #if IO_MONAD {"IONewArr", 3+IOArity, primIONewArr}, {"IOReadArr", 2+IOArity, primIOReadArr}, {"IOWriteArr", 3+IOArity, primIOWriteArr}, {"IOFreeze", 1+IOArity, primIOFreeze}, {"IOBounds", 1, primBounds}, {"IOArrEq", 2, primIOArrEq}, #endif {0, 0, 0} }; static Void outOfBounds Args((void)); static void outOfBounds() { throwException(ap(nameArrayException, ap(nameIndexOutOfBounds, nameNil))); } /* -------------------------------------------------------------------------- * Array control: * ------------------------------------------------------------------------*/ static Void arrayControl Args((Int)); static Void arrayControl(what) Int what; { switch (what) { case INSTALL : setCurrModule(modulePrelude); #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePrelude,NIL) pFun(nameEltUndef, "_undefined_array_element", "eltUndef"); #undef pFun break; } } static struct primInfo arrayPrims = { arrayControl, arrayPrimTable, 0 }; /*-------------------------------------------------------------------------*/ /* The implementation of arrays is heavily parameterized to allow the * use of different implementations. Non-conservative GC is also an * important goal, which is also why so much of this was originally done * using macros rather than procedures. As it happens, this probably could * have been avoided, but there don't seem to be sufficiently good reasons * to warrant changing it. * * The result, however, is a torture-test for the C preprocessor! * * A description of the various `parameters' follows: * * Primitives that build a new array use the macro: * declArr; Allocate slot on stack to hold a freshly created * array that will be seen by the garbage collector. * The value of the array can subsequently be referred * to using the `arr' macro. The declArr macro also * declares a local Int variable, alen, to hold the * length of the array. * * There are four methods for creating a new array, all of which return * the intermediate array in arr and its length in alen: * * aNewSet(b,s,v); Allocate new array with bounds b and size s. * Data elements set to v. * aNewNil(b,s); Equivalent to aNewSet(b,s,NIL), treated separately * because it is possible to use more efficient code * for this special case in some implementations. * aNewCopy(a); Builds an exact copy of array a, which can then be * modified destructively, without changing a. * Note that this forces evaluation of a. * aNewLike(a,v); Builds an array of the same size and bounds as a * with each element initialized to v. * Note that this forces evaluation of a. * * All four of these methods are implemented using macros; the b, r, a * parameters are integers, identifying particular primArg(x) slots. * The v parameters should be constants, unmovable by GC, or primArg(x) * references that can be safely modified during GC. * * Other functions are: * * aEvalModel(a); Evaluate model array primArg(a), and overwrite it * on stack with an indirection free pointer to the * resulting array. * aAssocs(as,p); Move list of assocs -- (offset,value) pairs -- from * primArg(as) (which is NIL'd to prevent space leak) * to top of stack and evaluate, in sequence, until all * assocs have been processed. For each pair, we * run procedure p with the offset in whnfInt and the * associated value in top(), to be popped before p is * done. * aSetElt; To be used with aAssocs: if arr[whnfInt] is NIL, * set it to top(), otherwise set to undefined. * aAddElt(f); To be used with aAssocs: replace whnfInt element e * of arr with ap(ap(primArg(f),e),top()) * aNullElts; Set any null elements in arr to nameEltUndef. * aCopyNull(a); Replace any null elements in arr with corresponding * values in array primArg(a). * aMapElts(f); Replace every element e in arr with ap(primArg(f),e). * aGetElt(a); Push value of whnfInt'th element of primArg(a). * aPutElt(a,v); Put v into whnfInt'th slot of primArg(a). * aElems(a); Evaluate array at primArg(a), and return its list of * elements on top of stack in reverse order, backed onto * NIL (ready for revOnto(top(),nameNil)). * aBounds() Extract bounds from arr. * aGetBounds(a) Extract bounds from primArg(a). * * There is no guarantee that the representation used for arr will be the * same as for any other array. The following methods do however ensure * that the standard representation is used when a value is finally returned: * * updarrRoot(); Updates root of redex with array represented by arr. * (Should also reset arr to avoid space leaks.) * aRetForIO(); Update root to return an array from IO monad; * i.e. pass arr to the continuation. */ #define declArr StackPtr arrPos=sp+1; Int alen; push(NIL) #define arr stack(arrPos) #define aNewNil(b,s) aNewSet(b,s,NIL) #define aNewSet(b,s,v) { Int i; \ eval(primArg(s)); \ alen = (whnfInt>0)?whnfInt:0; \ for (arr=NIL, i=alen; i>0; i--) \ arr = ap(v,arr); \ arr = ap(primArg(b),arr); \ } #define aNewCopy(a) { Cell es = snd(primArg(a)); \ for (arr=ap(hd(es),NIL), alen=0; \ nonNull(es=tl(es)); ++alen) \ arr = ap(hd(es),arr); \ arr = rev(arr); \ } #define aNewLike(a,v) { Cell es = snd(primArg(a)); \ for (arr=ap(hd(es),NIL), alen=0; \ nonNull(es=tl(es)); ++alen) \ arr = ap(v,arr); \ arr = rev(arr); \ } #define aEvalModel(a) eval(primArg(a)); primArg(a)=whnfHead #define aSetElt { List us = snd(arr); \ for (; 0=alen) \ outOfBounds(); \ drop(); p; eval(pop()); \ } /* Finally, we come to the implementation of the Haskell array primitives: */ primFun(primArray) { /* :: (a,a) */ declArr; /* -> Int */ aNewNil(3,2); /* -> [(Int,b)] */ aAssocs(1,aSetElt); /* -> Array a b */ aNullElts; updarrRoot(); } primFun(primUpdate) { /* :: [(Int,b)] */ declArr; /* -> Array a b */ aEvalModel(1); /* -> Array a b */ aNewLike(1,NIL); aAssocs(2,aSetElt); aCopyNull(1); updarrRoot(); } primFun(primAccum) { /* :: [(Int,c)] -> Array a b */ declArr; /* -> (b -> c -> b) */ aEvalModel(2); /* -> Array a b */ aNewCopy(2); aAssocs(3,aAddElt(1)); updarrRoot(); } primFun(primAccumArray) { /* :: (a,a) -> Int */ declArr; /* -> (b -> c -> b) -> b */ aNewSet(5,4,primArg(2)); /* -> [(Int,c)] */ aAssocs(1,aAddElt(3)); /* -> Array a b */ updarrRoot(); } primFun(primAmap) { /* :: (a -> b) */ declArr; /* -> Array c a */ aEvalModel(1); /* -> Array c b */ aNewCopy(1); aMapElts(2); updarrRoot(); } primFun(primSubscript) { /* :: Array a b -> Int -> b */ aEvalModel(2); eval(primArg(1)); aGetElt(2); updateRoot(top()); } primFun(primBounds) { /* :: Array a b -> (a,a) */ aEvalModel(1); updateRoot(aGetBounds(1)); } primFun(primElems) { /* :: Array a b -> [b] */ aEvalModel(1); aElems(1); updateRoot(revOnto(top(),nameNil)); } primFun(primEltUndef) { throwException(ap(nameArrayException, ap(nameUndefinedElement, nameNil))); } #if IO_MONAD primFun(primIONewArr) { /* :: (a,a) */ declArr; /* -> Int */ aNewSet(3+IOArity,2+IOArity,IOArg(1));/* -> b */ aRetForIO(); /* -> IO (IOArray a b) */ } primFun(primIOReadArr) { /* :: IOArray a b -> Int -> IO b */ aEvalModel(2+IOArity); eval(primArg(1+IOArity)); aGetElt(2+IOArity); IOReturn(top()); } primFun(primIOWriteArr) { /* :: IOArray a b -> Int -> b */ aEvalModel(3+IOArity); /* -> IO () */ eval(primArg(2+IOArity)); aPutElt(3+IOArity,IOArg(1)); IOReturn(nameUnit); } primFun(primIOFreeze) { /* :: IOArray a b */ declArr; /* -> IO (Array a b) */ aEvalModel(1+IOArity); aNewCopy(1+IOArity); aRetForIO(); } primFun(primIOArrEq) { /* :: IOArray a b */ aEvalModel(1); /* -> IOArray a b -> Bool */ aEvalModel(2); BoolResult(primArg(1)==primArg(2)); } #endif /* IO_MONAD */ /* Retire macros used in the implementation of arrays -------------------- */ #undef aNewSet #undef aNewNil #undef aNewCopy #undef aNewLike #undef aEvalModel #undef aAssocs #undef aSetElt #undef aAddElt #undef aNullElts #undef aCopyNull #undef aMapElts #undef aGetElt #undef aPutElt #undef aElems #undef aBounds #undef aGetBounds #undef updarrRoot #undef aRetForIO /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/bignums.c0000644006511100651110000006510010140435335015362 0ustar rossross/* -------------------------------------------------------------------------- * Functions for manipulating Haskell Integers (bignums). * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: bignums.c,v $ * $Revision: 1.15 $ * $Date: 2004/10/29 12:43:09 $ * ------------------------------------------------------------------------*/ /*#define DEBUG_BIGNUMS*/ #if DEBUG_BIGNUMS static Void local bigDump(List ds, Int n) { while (nonNull(ds) && 00; no/=BIGBASE, nx=tl(nx)) { tl(nx) = pair(mkDigit(no%BIGBASE),NIL); } return bn; } } Bignum bigWord(n) /* convert Word to bignum */ Unsigned n; { if (n==0) return ZERONUM; else { unsigned long no; Cell nx; no = (unsigned long)(n); bn = pair(POSNUM,NIL); for (nx=bn; no>0; no/=BIGBASE, nx=tl(nx)) { tl(nx) = pair(mkDigit(no%BIGBASE),NIL); } return bn; } } Bignum bigDouble(a) /* convert double to bignum */ double a; { if (a==0) { return ZERONUM; } else { double b; /* Obscure use of a and b is to avoid a bug in Symantec C*/ Cell nx; if (a<0) { b = (-a); bn = pair(NEGNUM,NIL); } else { b = a; bn = pair(POSNUM,NIL); } b = floor(b); /* NB: in IEEE floating point, !(b>0) is not the same as b<=0 */ if (!(b>0)) /* happens on IEEE NaN */ throwException(ap(nameArithException, nameOverflow)); for (nx=bn; b>0; nx=tl(nx)) { double n = fmod(b,(double)(BIGBASE)); Int d = (Int)n; if (d<0) /* happens on IEEE inf and -inf */ throwException(ap(nameArithException, nameOverflow)); tl(nx) = pair(mkDigit(d),NIL); b = (b - n) / BIGBASE; } return bn; } } /* The library documentation says that conversion between signed and * unsigned types preserves representation, not sign. Since this * conversion uses fromInteger, and we do note know the original type, * fromInteger is the same for Int and Word, and must accept values * in the range MINNEGINT..MAXHUGSWORD. */ Cell bigToInt(n) /* convert bignum to Int */ Bignum n; { if (n!=ZERONUM) { List ds = snd(n); if (nonNull(ds)) { Int m; Int b = 1; if (fst(n)==POSNUM) { m = digitOf(hd(ds)); while (nonNull(ds=tl(ds))) { Int d = digitOf(hd(ds)); if (b > (Int)(MAXHUGSWORD/BIGBASE)) return NIL; b *= BIGBASE; if (d > (Int)((MAXHUGSWORD - m)/b)) return NIL; m += b*d; } } else { /* fst(n)==NEGNUM */ m = - digitOf(hd(ds)); while (nonNull(ds=tl(ds))) { Int d = - digitOf(hd(ds)); if (b > (MAXPOSINT/BIGBASE)) return NIL; b *= BIGBASE; if (d < (MINNEGINT - m)/b) return NIL; m += b*d; } } return mkInt(m); } } return mkInt(0); } double bigToDouble(n) /* convert bignum to double */ Bignum n; { if (n==ZERONUM) return 0.0; else { double m = 0.0; double b = 1.0; List ds = snd(n); for (; nonNull(ds); ds=tl(ds)) { m += b*digitOf(hd(ds)); b *= BIGBASE; } return fst(n)==POSNUM ? m : (-m); } } Bignum bigStr(s) /* convert String to bignum */ String s; { /* Surprisingly, this is GC safe */ List ds = NIL; /* because ds is the only variable */ String t = s; /* that needs marking, and always */ Int i; /* appears as the snd of each cons */ if (*t == '-') /* look for leading minus */ t++; /* and ignore for time being */ if ((i=(size_t)strlen(t)%BIGEXP)!=0) { Int d = 0; while (00; i--) d = d*10 + (*t++ - '0'); if (nonNull(ds) || d) ds = cons(mkDigit(d),ds); } return isNull(ds) ? ZERONUM : pair((*s=='-' ? NEGNUM : POSNUM), ds); } Cell bigOut(a,s,b) /* bignum output, prepend digits to*/ Bignum a; /* stream s */ Cell s; /* GC safe; s is snd in each cons */ Bool b; { /* TRUE => wrap neg int in parens */ if (a==ZERONUM) return ap(consChar('0'),s); else { Bool isNeg = fst(a)==NEGNUM; /* keep record of sign */ bn = snd(a); /* list of digits */ if (b && isNeg) /* print closing paren */ s = ap(consChar(')'),s); for (;;) { Int d = digitOf(hd(bn)); /* get next digit */ bn = tl(bn); /* move to next digit */ if (nonNull(bn)) { /* more digits to come after this */ Int i = BIGEXP; for (; i>0; i--, d/=10) s = ap(consChar('0'+(d%10)),s); } else { /* leading (non-zero) digits */ for (; d; d/=10) s = ap(consChar('0'+(d%10)),s); break; } allowBreak(); } if (isNeg) /* print minus sign */ s = ap(consChar('-'),s); if (b && isNeg) /* print open paren */ s = ap(consChar('('),s); return s; } } Bignum bigShift(big,c,mult) /* Digits 0 <= c, mult < BIGBASE */ Bignum big; /* Calculate big*mult+c, if big>=0 */ Int c; /* big*mult-c, if big<0 */ Int mult; { /* UPDATE big, DESTRUCTIVELY! */ if (big==ZERONUM) return (c==0) ? ZERONUM : pair(POSNUM,singleton(mkDigit(c))); else { Cell nx = bn = big; while (nonNull(tl(nx))) { nx = tl(nx); c = digitOf(hd(nx))*mult + c; hd(nx) = mkDigit(c % BIGBASE); c = c / BIGBASE; /* N.B. new carry is < BIGBASE */ } if (c>0) tl(nx) = singleton(mkDigit(c)); } return big; } /*--------------------------------------------------------------------------- * Simple Bignum operations: *-------------------------------------------------------------------------*/ primFun(primIntToInteger) { /* Conversion :: Int -> Integer */ eval(primArg(1)); updateRoot(bigInt(whnfInt)); } primFun(primIntegerToInt) { /* Conversion :: Integer -> Int */ #if SHORT_CIRCUIT_COERCIONS /* Optimisation: we try to short-circuit trivial conversions */ Cell x = followInd(primArg(1)); if (isAp(x) && followInd(fun(x)) == nameIntToInteger) { updateRoot(arg(x)); return; } else #endif { eval(primArg(1)); whnfHead = bigToInt(whnfHead); if (nonNull(whnfHead)) { updateRoot(whnfHead); } else { throwException(ap(nameArithException, nameOverflow)); } } } primFun(primWordToInteger) { /* Conversion :: Word -> Integer */ eval(primArg(1)); updateRoot(bigWord(whnfInt)); } primFun(primIntegerToWord) { /* Conversion :: Integer -> Word */ eval(primArg(1)); whnfHead = bigToInt(whnfHead); if (nonNull(whnfHead)) updateRoot(whnfHead); else throwException(ap(nameArithException, nameOverflow)); } primFun(primIntegerToFloat) { /* Conversion :: Integer -> Float */ eval(primArg(1)); updateRoot(mkFloat((FloatPro)bigToDouble(whnfHead))); } primFun(primIntegerToDouble) { /* Conversion :: Integer -> Double */ eval(primArg(1)); updateRoot(mkDouble((DoublePro)bigToDouble(whnfHead))); } primFun(primNegInteger) { /* Integer unary negate */ eval(primArg(1)); updateRoot(bigNeg(whnfHead)); } Bignum bigNeg(a) /* unary negation */ Bignum a; { if (a==ZERONUM) return ZERONUM; else return pair(((fst(a)==POSNUM) ? NEGNUM : POSNUM), snd(a)); } /*--------------------------------------------------------------------------- * Bignum comparison routines: *-------------------------------------------------------------------------*/ primFun(primEqInteger) { /* Integer equality test */ eval(primArg(2)); primArg(2) = whnfHead; eval(primArg(1)); updateRoot(bigCmp(primArg(2),whnfHead)==0 ? nameTrue : nameFalse); } primFun(primCmpInteger) { /* Integer comparison */ eval(primArg(2)); primArg(2) = whnfHead; eval(primArg(1)); switch (bigCmp(primArg(2),whnfHead)) { case (-1) : updateRoot(nameLT); break; case 0 : updateRoot(nameEQ); break; case 1 : updateRoot(nameGT); break; } } Int bigCmp(a,b) /* Compare bignums returning: */ Bignum a, b; { /* -1 if ab, 0 o/w */ if (a==ZERONUM) return (b==ZERONUM) ? 0 : ((fst(b)==POSNUM) ? (-1) : 1); else if (fst(a)==NEGNUM) if (b==ZERONUM || fst(b)==POSNUM) return (-1); else return digitsCmp(snd(b),snd(a)); else if (b==ZERONUM || fst(b)==NEGNUM) return 1; else return digitsCmp(snd(a),snd(b)); } static Int local digitsCmp(xs,ys) /* Compare positive digit streams */ List xs, ys; { /* -1 if xsys, 0 if= */ Int s = 0; for (; nonNull(xs) && nonNull(ys); xs=tl(xs), ys=tl(ys)) { Int x = hd(xs); Int y = hd(ys); if (xy) s = 1; } return (nonNull(xs) ? 1 : (nonNull(ys) ? (-1) : s)); } /*--------------------------------------------------------------------------- * Addition and subtraction: *-------------------------------------------------------------------------*/ static Bignum local bigAdd(a,b) /* Bignum addition */ Bignum a, b; { if (a==ZERONUM) return b; else if (b==ZERONUM) return a; else if (fst(a)==POSNUM) if (fst(b)==POSNUM) return digitsAdd(POSNUM,snd(a),snd(b)); else return digitsSub(snd(a),snd(b)); else /* fst(a)==NEGNUM */ if (fst(b)==NEGNUM) return digitsAdd(NEGNUM,snd(a),snd(b)); else return digitsSub(snd(b),snd(a)); } static Bignum local bigSub(a,b) /* Bignum subtraction */ Bignum a, b; { if (a==ZERONUM) return bigNeg(b); else if (b==ZERONUM) return a; else if (fst(a)==POSNUM) if (fst(b)==NEGNUM) return digitsAdd(POSNUM,snd(a),snd(b)); else return digitsSub(snd(a),snd(b)); else /* fst(a)==NEGNUM */ if (fst(b)==POSNUM) return digitsAdd(NEGNUM,snd(a),snd(b)); else return digitsSub(snd(b),snd(a)); } static Bignum local digitsAdd(sign,xs,ys)/* Addition of digit streams */ Cell sign; List xs, ys; { Cell nx = bn = pair(sign,NIL); Int c = 0; for (;;) { if (nonNull(xs)) { /* Add any digits to carry */ if (nonNull(ys)) { c += digitOf(hd(xs)) + digitOf(hd(ys)); xs = tl(xs); ys = tl(ys); } else if (c==0) { /* look for short cut when */ tl(nx) = xs; /* a stream ends and there */ break; /* is no outstanding carry */ } else { c += digitOf(hd(xs)); xs = tl(xs); } } else if (c==0) { tl(nx) = ys; break; } else if (nonNull(ys)) { c += digitOf(hd(ys)); ys = tl(ys); } if (c>=BIGBASE) { /* Calculate output digit */ nx = tl(nx) = cons(mkDigit(c-BIGBASE),NIL); c = 1; } else { /* Carry will always be >0 */ nx = tl(nx) = cons(mkDigit(c),NIL); /* at this point */ c = 0; } allowBreak(); } return bn; } static Bignum local digitsSub(xs,ys) /* Subtraction of digit streams */ List xs, ys; { Cell nx; Int b = 0; Int lz = 0; switch (digitsCmp(xs,ys)) { case (-1) : nx = xs; /* if xsys, return +(xs-ys) */ } nx = bn; /* Now we can assume that xs>ys */ for (;;) { /* Scan each digit */ Int y = b; if (nonNull(ys)) { y += digitOf(hd(xs)) - digitOf(hd(ys)); xs = tl(xs); ys = tl(ys); } else if (y==0) { if (nonNull(xs)) for (; lz>0; lz--) nx = tl(nx) = cons(mkDigit(0),NIL); tl(nx) = xs; break; } else { y += digitOf(hd(xs)); /* xs>ys, so we can't run out of */ xs = tl(xs); /* digits of xs while y!=0 */ } if (y<0) { /* Calculate output digit */ y += BIGBASE; b = (-1); } else b = 0; if (y==0) /* Don't insert leading zeros */ lz++; else { for (; lz>0; lz--) nx = tl(nx) = cons(mkDigit(0),NIL); nx = tl(nx) = cons(mkDigit(y),NIL); } allowBreak(); } return bn; } /*--------------------------------------------------------------------------- * Multiplication: *-------------------------------------------------------------------------*/ static Bignum local bigMul(a,b) /* Bignum multiply */ Bignum a, b; { if (a==ZERONUM || b==ZERONUM) /* if either operand is zero, then */ return ZERONUM; /* so is the result ... */ else { /* otherwise, use rule of signs: */ Cell nx = bn = ap((hd(a)==hd(b) ? POSNUM : NEGNUM), NIL); for (; nonNull(b=tl(b)); nx=tl(nx)) { /* loop through digits of b*/ List as = nx; /* At each stage of the loop, add */ List xs = tl(a); /* y * xs to the value in result, */ Int y = digitOf(hd(b)); /* using c as carry */ Int c = 0; for (; nonNull(xs); xs=tl(xs)) { /* loop through digits of a*/ c += digitOf(hd(xs)) * y; if (nonNull(tl(as))) { as = tl(as); c += digitOf(hd(as)); } else as = tl(as) = cons(NIL,NIL); hd(as) = mkDigit(c % BIGBASE); c /= BIGBASE; } if (c>0) /* add carry digit, if required */ tl(as) = cons(mkDigit(c),NIL); allowBreak(); } return bn; } } /*--------------------------------------------------------------------------- * Division: *-------------------------------------------------------------------------*/ static Cell local bigQrm(a,b) /* bignum quotient and remainder */ Bignum a, b; { if (b==ZERONUM) /* division by zero? */ return NIL; else if (a==ZERONUM) /* 0 `div` x == 0 `mod` x == 0 */ return ap(ap(mkTuple(2),ZERONUM),ZERONUM); else { /* The sign of the quotient is positive if numerator and denominator * have the same sign, negative if the signs differ. The sign of the * remainder is always the same as the sign of the numerator. */ Cell qsign = (fst(a)==fst(b) ? POSNUM : NEGNUM); Cell rsign = fst(a); bn = digitsQrm(snd(a),snd(b)); bn = isNull(bn) ? ZERONUM : pair(qsign,bn); bn = pair(mkTuple(2),bn); bigRem = isNull(bigRem) ? ZERONUM : pair(rsign,bigRem); bn = ap(bn,bigRem); bigRem = NIL; return bn; } } static List local digitsQrm(us,vs) /* digits quotient and remainder */ List us, vs; { Bool gc = consGC; consGC = TRUE; if (isNull(tl(vs))) { /* single digit divisor */ Int v = digitOf(hd(vs)); Int r = 0; List us1 = NIL; /* first, copy and reverse us */ for (; nonNull(us); us=tl(us)) us1 = cons(hd(us),us1); while (nonNull(us1)) { /* then do division, MSD first */ Cell tmp = tl(us1); Int u = r * BIGBASE + digitOf(hd(us1)); r = u % v; u = u / v; if (nonNull(us) || u) { /* output quotient digit */ hd(us1) = mkDigit(u); tl(us1) = us; us = us1; } us1 = tmp; } bigRem = r ? singleton(mkDigit(r)) : NIL; consGC = gc; return us; } else { /* at least two digits in divisor */ /* The division algorithm used here is, inevitably, based on the * description in Knuth's volume 2 on Seminumerical algorithms, * and is probably at least as incomprehensible as the MIX * implementation given there :-) */ List us1 = NIL; List vs1 = NIL; List ds = us; Int v1 = 0, v2 = 0; Int uj = 0, uj1 = 0, uj2 = 0; Int n = 0; List qs = NIL; Int sc; while (nonNull(us) && nonNull(vs)) { v2 = v1; v1 = digitOf(hd(vs)); vs1 = cons(hd(vs),vs1); vs = tl(vs); uj2 = uj1; uj1 = digitOf(hd(us)); us1 = cons(hd(us),us1); us = tl(us); n++; } if (nonNull(vs)) { /* if us is shorter than vs, then */ bigRem = ds; /* remainder is us, quotient zero */ consGC = gc; return NIL; } vs = rev(vs1); /* Now we have: * n = number of digits in vs which is at least two (we * also know that us has at least n digits), * v1, v2 = most significant digits of vs * vs = digits of vs with least significant digit first */ #if DEBUG_BIGNUMS Printf("initial vs (n=%d, v1=%d, v2=%d): ",n,v1,v2); bigDump(vs,n); Putchar('\n'); #endif while (nonNull(us)) { uj2 = uj1; uj1 = digitOf(hd(us)); us1 = cons(hd(us),us1); us = tl(us); } us = cons(mkDigit(uj=0),NIL); ds = us1; for (vs1=tl(vs); nonNull(vs1); vs1=tl(vs1)) { us1 = tl(ds); tl(ds) = us; us = ds; ds = us1; } /* And, at this point, we have: * us = first (n-1) significant digits of original numerator, * with least significant digit first, and a zero at the * end (MSD) of the list, so that length us == n. * ds = remaining digits of the numerator, most significant * digit first. * uj, uj1, uj2 * = first three significant digits of us. (At this point, * uj is actually zero.) */ #if DEBUG_BIGNUMS Printf("initial us (uj=%d, uj1=%d, uj2=%d): ",uj,uj1,uj2); bigDump(us,n); Putchar('\n'); Printf("initial ds: "); bigDump(ds,1000); Putchar('\n'); #endif sc = BIGBASE / (v1+1); #if DEBUG_BIGNUMS Printf("scaling factor %d\n",sc); #endif if (sc!=1) { /* Scale numerator and denominator */ Int c = 0; v1 = v2 = 0; for (vs1=vs; nonNull(vs1); vs1=tl(vs1)) { v2 = v1; v1 = sc * digitOf(hd(vs1)) + c; c = v1 / BIGBASE; hd(vs1) = mkDigit(v1%=BIGBASE); } /* no carry here, guaranteed */ c = uj = uj1 = uj2 = 0; for (us1=ds=rev(ds); nonNull(us1); us1=tl(us1)) { uj2 = uj1; uj1 = uj; uj = sc * digitOf(hd(us1)) + c; c = uj / BIGBASE; hd(us1) = mkDigit(uj%=BIGBASE); } for (ds=rev(ds), us1=us; nonNull(us1); us1=tl(us1)) { uj2 = uj1; uj1 = uj; uj = sc * digitOf(hd(us1)) + c; c = uj / BIGBASE; hd(us1) = mkDigit(uj%=BIGBASE); } /* no carry here, guaranteed */ } #if DEBUG_BIGNUMS Printf("scaled vs (n=%d, v1=%d, v2=%d): ",n,v1,v2); bigDump(vs,n); Putchar('\n'); Printf("scaled us (uj=%d, uj1=%d, uj2=%d): ",uj,uj1,uj2); bigDump(us,n); Putchar('\n'); Printf("scaled ds: "); bigDump(ds,1000); Putchar('\n'); #endif /* Most of the conditions above are still valid, except that both * the numerator and denominator have been multiplied by the scaling * factor sc, and the values of the various digit positions have been * updated accordingly. * * Now we can start the division algorithm proper: */ while (nonNull(ds)) { Int nd, c; /* Guess a value for quotient digit*/ Int qhat = (uj==v1) ? (BIGBASE-1) : (uj*BIGBASE+uj1)/v1; while (v2*qhat > (uj*BIGBASE+uj1-qhat*v1)*BIGBASE+uj2) qhat--; /* and then try to improve it */ us1 = tl(ds); /* take digit off off front of ds */ tl(ds) = us; /* and add to front of us */ us = ds; ds = us1; nd = isNull(ds) ? 0 : digitOf(hd(ds)); /* next digit of ds*/ #if DEBUG_BIGNUMS Printf("To divide us (uj=%d, uj1=%d, uj2=%d): ",uj,uj1,uj2); bigDump(us,n+1); Printf(" by vs (v1=%d, v2=%d): ",v1,v2); bigDump(vs,n); Printf(", guess qhat=%d\n",qhat); #endif uj = nd; /* us := us - qhat * vs */ uj1 = uj2 = c = 0; us1 = us; vs1 = vs; do { uj2 = uj1; uj1 = uj; uj = digitOf(hd(us1)) - qhat*digitOf(hd(vs1)) - c; if (uj>=0) c = 0; else { c = (BIGBASE - 1 - uj) / BIGBASE; uj += c*BIGBASE; } hd(us1) = mkDigit(uj); us1 = tl(us1); vs1 = tl(vs1); } while (nonNull(vs1)); if (digitOf(hd(us1))=BIGBASE) c = 1, uj -= BIGBASE; else c = 0; hd(us1) = mkDigit(uj); us1 = tl(us1); vs1 = tl(vs1); } while (nonNull(vs1)); } #if DEBUG_BIGNUMS Printf("There remains (uj=%d, uj1=%d, uj2=%d): ",uj,uj1,uj2); bigDump(us,n); Putchar('\n'); #endif if (nonNull(qs) || qhat) /* output quotient digit, without */ qs = cons(mkDigit(qhat),qs); /* leading zeros */ allowBreak(); } #if DEBUG_BIGNUMS Printf("done quotient\n"); #endif /* Now we have the quotient digits (if any) with least significant * digit first in qs, and sc times the remainder is the first n * digits of us. All that remains is to adjust the remainder: */ us1 = rev(take(n,us)); us = NIL; uj = 0; /* reuse variable uj as a carry */ while (nonNull(us1)) { Int y = uj * BIGBASE + digitOf(hd(us1)); uj = y % sc; y /= sc; if (nonNull(us) || y) { vs1 = tl(us1); tl(us1) = us; hd(us1) = mkDigit(y); us = us1; us1 = vs1; } else us1 = tl(us1); } bigRem = us; consGC = gc; return qs; } } /*-------------------------------------------------------------------------*/ /* e is a constant expression with no live pointers */ #define CAFBignum(nm,e) \ primCAF(nm) { \ push(e); \ bn = NIL; \ } /* e is an expression with free variables x and y */ #define BignumBignum2Bignum(nm,e) \ primFun(nm) { \ Bignum x, y; \ eval(primArg(2)); push(whnfHead); \ eval(primArg(1)); y = whnfHead; \ x = pop(); \ if (!isBignum(x) || !isBignum(y)) \ internal("Bignum expected"); \ updateRoot(e); \ bn = NIL; \ } /* e is an expression with free variable x */ #define Bignum2Bignum(nm,e) \ primFun(nm) { \ Bignum x; \ eval(primArg(1)); x = whnfHead; \ if (!isBignum(x)) \ internal("Bignum expected"); \ updateRoot(e); \ bn = NIL; \ } /* e is an expression with free variable x that does no heap allocation */ #define Bignum2Bool(nm,e) \ primFun(nm) { \ Bignum x; \ eval(primArg(1)); x = whnfHead; \ if (!isBignum(x)) \ internal("Bignum expected"); \ updateRoot(e ? nameTrue : nameFalse); \ bn = NIL; \ } /* e is an expression with free variable x that does no heap allocation */ #define BignumBignum2Bool(nm,e) \ primFun(nm) { \ Bignum x, y; \ eval(primArg(2)); push(whnfHead); \ eval(primArg(1)); y = whnfHead; \ x = pop(); \ if (!isBignum(x) || !isBignum(y)) \ internal("Bignum expected"); \ updateRoot((e) ? nameTrue : nameFalse); \ bn = NIL; \ } /*-------------------------------------------------------------------------*/ BignumBignum2Bignum(primPlusInteger,bigAdd(x,y)) /* Integer addition */ BignumBignum2Bignum(primMinusInteger,bigSub(x,y)) /* Integer subtraction */ BignumBignum2Bignum(primMulInteger,bigMul(x,y)) /* Integer multiply */ primFun(primQrmInteger) { /* Integer quotient and remainder */ Bignum x; eval(primArg(2)); primArg(2) = whnfHead; eval(primArg(1)); x = bigQrm(primArg(2),primArg(1)=whnfHead); if (isNull(x)) { throwException(ap(nameArithException, nameDivideByZero)); } else { updateRoot(x); } bn = NIL; } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/builtin.c0000644006511100651110000024404310437664041015400 0ustar rossross/* -------------------------------------------------------------------------- * Primitive functions, input output etc... * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: builtin.c,v $ * $Revision: 1.93 $ * $Date: 2006/06/01 22:20:17 $ * ------------------------------------------------------------------------*/ /* We include math.h before prelude.h because SunOS 4's cpp incorrectly * reports an error if you use "name(n)" as a macro with arguments and * "name" as a normal identifier (with no arguments). ADR */ #include #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "machdep.h" #include "char.h" #include #if HAVE_IO_H # include #endif /* Header files needed to compile the IO primitives */ #if IO_MONAD #if HAVE_SYS_TYPES_H # include #elif HAVE_TYPES_H # include #endif #if HAVE_SYS_STAT_H # include #elif HAVE_STAT_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_TIMES_H && !mingw32_HOST_OS # include #endif #if HAVE_SYS_TIME_H # include #endif #if HAVE_SYS_RESOURCE_H && !mingw32_HOST_OS # include #endif #if HAVE_ERRNO_H # include #endif #if HAVE_SYS_TIMEB_H # include #endif #if HAVE_WINDOWS_H # include #endif #if HAVE_DIRENT_H # include #endif #if HAVE_DIRECT_H # include #endif #if HAVE_FCNTL_H # include #endif #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) /* Needed for mallocBytesRWX() */ #include #include #endif #endif /* IO_MONAD */ #include "builtin.h" Name nameNegate, nameFlip; /* primitives reqd for parsing */ Name nameFrom, nameFromThen; Name nameFromTo, nameFromThenTo; Name nameFatbar, nameFail; /* primitives reqd for translation */ Name nameIf, nameSel; Name nameId, nameOtherwise; Name nameConCmp, nameEnRange; /* primitives used for deriv inst */ Name nameEnIndex, nameEnInRng; Name nameEnToEn, nameEnFrEn; Name nameEnFrom, nameEnFrTh; Name nameEnFrTo; Name nameBlackHole; /* for GC-detected black hole */ Name nameInd; /* for dict indirection */ Name namePrint, nameNPrint; /* primitives for printing */ Name nameFst, nameSnd; /* 2-tuple selector functions */ Name nameAnd, nameOr; /* built-in logical connectives */ Name namePrimThrow; /* throw primitive function */ Name nameComp; /* function composition */ Name nameApp; /* list append */ Name nameShowField; /* display single field */ Name nameShowParen; /* wrap with parens */ Name nameReadField; /* read single field */ Name nameReadParen; /* unwrap from parens */ Name nameLex; /* lexer */ Name nameRangeSize; /* calculate size of index range */ Name nameCompAux; /* auxiliary function for compares */ Name namePmInt, namePmFlt; /* primitives for pattern matching */ Name nameReturnIO; Name namePmInteger; #if NPLUSK Name namePmNpk, namePmSub; /* primitives for (n+k) patterns */ #endif #if TREX Name nameRecExt, nameRecBrk; /* Extend and break a record */ Name nameRecSel, nameRecShw; /* Select and show a record */ Name nameRecEq; /* Compare records */ Name nameAddEv; /* Add up evidence */ #endif Name nameRationalToFloat; Name nameRationalToDouble; #if SHORT_CIRCUIT_COERCIONS Name nameFloatToRational; Name nameDoubleToRational; Name nameDoubleToRatio; Name nameIntToRatio; Name nameIntToFloat; Name nameIntToDouble; Name nameDoubleToFloat; Name nameFloatToDouble; #endif /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ PROTO_PRIM(primFatbar); PROTO_PRIM(primFail); PROTO_PRIM(primCatchError); PROTO_PRIM(primThrowException); PROTO_PRIM(primCatchException); PROTO_PRIM(primBlackHole); PROTO_PRIM(primIndirect); PROTO_PRIM(primSel); PROTO_PRIM(primIf); PROTO_PRIM(primStrict); PROTO_PRIM(primSeq); PROTO_PRIM(primConCmp); PROTO_PRIM(primEnRange); PROTO_PRIM(primEnIndex); PROTO_PRIM(primEnInRng); PROTO_PRIM(primEnFrEn); PROTO_PRIM(primEnToEn); PROTO_PRIM(primEnFrom); PROTO_PRIM(primEnFrTh); PROTO_PRIM(primEnFrTo); PROTO_PRIM(primMinInt); PROTO_PRIM(primMaxInt); PROTO_PRIM(primPlusInt); PROTO_PRIM(primMinusInt); PROTO_PRIM(primMulInt); PROTO_PRIM(primDivInt); PROTO_PRIM(primQuotInt); PROTO_PRIM(primModInt); PROTO_PRIM(primRemInt); PROTO_PRIM(primQrmInt); PROTO_PRIM(primNegInt); PROTO_PRIM(primAndInt); PROTO_PRIM(primOrInt); PROTO_PRIM(primXorInt); PROTO_PRIM(primComplementInt); PROTO_PRIM(primShiftInt); PROTO_PRIM(primBitInt); PROTO_PRIM(primTestInt); PROTO_PRIM(primCharToInt); PROTO_PRIM(primIntToChar); PROTO_PRIM(primWordToInt); PROTO_PRIM(primIntToWord); PROTO_PRIM(primIntToFloat); PROTO_PRIM(primIntToDouble); PROTO_PRIM(primDummyCvt); PROTO_PRIM(primRationalToFloat); PROTO_PRIM(primRationalToDouble); #if WORD_OPS PROTO_PRIM(primMaxWord); PROTO_PRIM(primPlusWord); PROTO_PRIM(primMinusWord); PROTO_PRIM(primNegateWord); PROTO_PRIM(primMulWord); PROTO_PRIM(primDivWord); PROTO_PRIM(primQuotWord); PROTO_PRIM(primModWord); PROTO_PRIM(primRemWord); PROTO_PRIM(primQrmWord); PROTO_PRIM(primAndWord); PROTO_PRIM(primOrWord); PROTO_PRIM(primXorWord); PROTO_PRIM(primComplementWord); PROTO_PRIM(primShiftWord); PROTO_PRIM(primRotateWord); PROTO_PRIM(primBitWord); PROTO_PRIM(primTestWord); PROTO_PRIM(primItoI8); PROTO_PRIM(primItoI16); PROTO_PRIM(primItoI32); PROTO_PRIM(primI8toI); PROTO_PRIM(primI16toI); PROTO_PRIM(primI32toI); PROTO_PRIM(primI32toI64); PROTO_PRIM(primI64toI32); PROTO_PRIM(primWtoW8); PROTO_PRIM(primWtoW16); PROTO_PRIM(primWtoW32); PROTO_PRIM(primW8toW); PROTO_PRIM(primW16toW); PROTO_PRIM(primW32toW); PROTO_PRIM(primW32toW64); PROTO_PRIM(primW64toW32); #endif PROTO_PRIM(primFreeHFunPtr); PROTO_PRIM(primDoubleToFloat); PROTO_PRIM(primFloatToDouble); PROTO_PRIM(primPlusFloat); PROTO_PRIM(primMinusFloat); PROTO_PRIM(primMulFloat); PROTO_PRIM(primDivFloat); PROTO_PRIM(primNegFloat); PROTO_PRIM(primPlusDouble); PROTO_PRIM(primMinusDouble); PROTO_PRIM(primMulDouble); PROTO_PRIM(primDivDouble); PROTO_PRIM(primNegDouble); #if FLOATS_SUPPORTED PROTO_PRIM(primSinFloat); PROTO_PRIM(primCosFloat); PROTO_PRIM(primTanFloat); PROTO_PRIM(primAsinFloat); PROTO_PRIM(primAcosFloat); PROTO_PRIM(primAtanFloat); #if 0 /* Not used in current Prelude */ PROTO_PRIM(primAtan2Float); #endif PROTO_PRIM(primExpFloat); PROTO_PRIM(primLogFloat); PROTO_PRIM(primSqrtFloat); PROTO_PRIM(primFloatToInt); PROTO_PRIM(primFloatRadix); PROTO_PRIM(primFloatDigits); PROTO_PRIM(primFloatMinExp); PROTO_PRIM(primFloatMaxExp); PROTO_PRIM(primFloatDecode); PROTO_PRIM(primFloatEncode); PROTO_PRIM(primSinDouble); PROTO_PRIM(primCosDouble); PROTO_PRIM(primTanDouble); PROTO_PRIM(primAsinDouble); PROTO_PRIM(primAcosDouble); PROTO_PRIM(primAtanDouble); #if 0 /* Not used in current Prelude */ PROTO_PRIM(primAtan2Double); #endif PROTO_PRIM(primExpDouble); PROTO_PRIM(primLogDouble); PROTO_PRIM(primSqrtDouble); PROTO_PRIM(primDoubleToInt); PROTO_PRIM(primDoubleDigits); PROTO_PRIM(primDoubleMinExp); PROTO_PRIM(primDoubleMaxExp); PROTO_PRIM(primDoubleDecode); PROTO_PRIM(primDoubleEncode); #endif /* FLOATS_SUPPORTED */ PROTO_PRIM(primNullPtr); PROTO_PRIM(primPlusPtr); PROTO_PRIM(primAlignPtr); PROTO_PRIM(primMinusPtr); PROTO_PRIM(primEqPtr); PROTO_PRIM(primCmpPtr); PROTO_PRIM(primEqInt); PROTO_PRIM(primCmpInt); PROTO_PRIM(primEqWord); PROTO_PRIM(primCmpWord); PROTO_PRIM(primEqChar); PROTO_PRIM(primCmpChar); PROTO_PRIM(primEqFloat); PROTO_PRIM(primCmpFloat); PROTO_PRIM(primEqDouble); PROTO_PRIM(primCmpDouble); PROTO_PRIM(primMaxChar); PROTO_PRIM(primIsUpper); PROTO_PRIM(primIsLower); PROTO_PRIM(primIsAlpha); PROTO_PRIM(primIsAlphaNum); PROTO_PRIM(primIsPrint); PROTO_PRIM(primToUpper); PROTO_PRIM(primToLower); PROTO_PRIM(primToTitle); PROTO_PRIM(primUniGenCat); #if TREX PROTO_PRIM(primRecExt); PROTO_PRIM(primRecBrk); PROTO_PRIM(primRecSel); PROTO_PRIM(primRecShw); PROTO_PRIM(primRecEq); #endif #if OBSERVATIONS EXT_PROTO_PRIM(primObserve); EXT_PROTO_PRIM(primBkpt); EXT_PROTO_PRIM(primSetBkpt); #endif PROTO_PRIM(primUnsafePtrEq); PROTO_PRIM(primUnsafePtrToInt); static Cell local followInd Args(( Cell )); /* -------------------------------------------------------------------------- * Table of primitive/built-in values: * ------------------------------------------------------------------------*/ static struct primitive builtinPrimTable[] = { {"fatbar", 2, primFatbar}, {"fail", 0, primFail}, {"catchError", 1, primCatchError}, {"primThrowException",1, primThrowException}, {"primCatchException",1, primCatchException}, {"gcBhole", 0, primBlackHole}, {"dictIndirect", 1, primIndirect}, {"sel", 3, primSel}, {"if", 3, primIf}, {"conCmp", 2, primConCmp}, {"enRange", 1, primEnRange}, {"enIndex", 2, primEnIndex}, {"enInRng", 2, primEnInRng}, {"enToEn", 2, primEnToEn}, {"enFrEn", 1, primEnFrEn}, {"enFrom", 1, primEnFrom}, {"enFrTh", 2, primEnFrTh}, {"enFrTo", 2, primEnFrTo}, {"primMinInt", 0, primMinInt}, {"primMaxInt", 0, primMaxInt}, {"primPlusInt", 2, primPlusInt}, {"primMinusInt", 2, primMinusInt}, {"primMulInt", 2, primMulInt}, {"primDivInt", 2, primDivInt}, {"primQuotInt", 2, primQuotInt}, {"primModInt", 2, primModInt}, {"primRemInt", 2, primRemInt}, {"primNegInt", 1, primNegInt}, {"primQrmInt", 2, primQrmInt}, {"primAndInt", 2, primAndInt}, {"primOrInt", 2, primOrInt}, {"primXorInt", 2, primXorInt}, {"primComplementInt", 1, primComplementInt}, {"primShiftInt", 2, primShiftInt}, {"primBitInt", 1, primBitInt}, {"primTestInt", 2, primTestInt}, #if WORD_OPS {"primMaxWord", 0, primMaxWord}, {"primPlusWord", 2, primPlusWord}, {"primMinusWord", 2, primMinusWord}, {"primNegateWord", 1, primNegateWord}, {"primMulWord", 2, primMulWord}, {"primDivWord", 2, primDivWord}, {"primQuotWord", 2, primQuotWord}, {"primModWord", 2, primModWord}, {"primRemWord", 2, primRemWord}, {"primQrmWord", 2, primQrmWord}, {"primAndWord", 2, primAndWord}, {"primOrWord", 2, primOrWord}, {"primXorWord", 2, primXorWord}, {"primComplementWord",1, primComplementWord}, {"primShiftWord", 2, primShiftWord}, {"primRotateWord", 3, primRotateWord}, {"primBitWord", 1, primBitWord}, {"primTestWord", 2, primTestWord}, {"primIntToInt8", 1, primItoI8}, {"primIntToInt16", 1, primItoI16}, {"primIntToInt32", 1, primItoI32}, {"primInt8ToInt", 1, primI8toI}, {"primInt16ToInt", 1, primI16toI}, {"primInt32ToInt", 1, primI32toI}, {"primInt32ToInt64", 2, primI32toI64}, {"primInt64ToInt32", 1, primI64toI32}, {"primWordToWord8", 1, primWtoW8}, {"primWordToWord16", 1, primWtoW16}, {"primWordToWord32", 1, primWtoW32}, {"primWord8ToWord", 1, primW8toW}, {"primWord16ToWord", 1, primW16toW}, {"primWord32ToWord", 1, primW32toW}, {"primWord32ToWord64",2, primW32toW64}, {"primWord64ToWord32",1, primW64toW32}, #endif {"freeHaskellFunPtr", 1+IOArity, primFreeHFunPtr}, #if !BIGNUMS /* Implement Integer as Int */ {"primPlusInteger", 2, primPlusInt}, {"primMinusInteger", 2, primMinusInt}, {"primMulInteger", 2, primMulInt}, {"primQrmInteger", 2, primQrmInt}, {"primNegInteger", 1, primNegInt}, {"primIntToInteger", 1, primDummyCvt}, {"primIntegerToInt", 1, primDummyCvt}, {"primIntegerToFloat",1, primIntToFloat}, {"primIntegerToDouble",1,primIntToDouble}, {"primEqInteger", 2, primEqInt}, {"primCmpInteger", 2, primCmpInt}, #endif {"primPlusFloat", 2, primPlusFloat}, {"primMinusFloat", 2, primMinusFloat}, {"primMulFloat", 2, primMulFloat}, {"primDivFloat", 2, primDivFloat}, {"primNegFloat", 1, primNegFloat}, {"primPlusDouble", 2, primPlusDouble}, {"primMinusDouble", 2, primMinusDouble}, {"primMulDouble", 2, primMulDouble}, {"primDivDouble", 2, primDivDouble}, {"primNegDouble", 1, primNegDouble}, #if FLOATS_SUPPORTED {"primSinFloat", 1, primSinFloat}, {"primCosFloat", 1, primCosFloat}, {"primTanFloat", 1, primTanFloat}, {"primAsinFloat", 1, primAsinFloat}, {"primAcosFloat", 1, primAcosFloat}, {"primAtanFloat", 1, primAtanFloat}, {"primExpFloat", 1, primExpFloat}, {"primLogFloat", 1, primLogFloat}, {"primSqrtFloat", 1, primSqrtFloat}, {"primFloatToInt", 1, primFloatToInt}, {"primFloatRadix", 0, primFloatRadix}, {"primFloatDigits", 0, primFloatDigits}, {"primFloatMinExp", 0, primFloatMinExp}, {"primFloatMaxExp", 0, primFloatMaxExp}, {"primFloatDecode", 1, primFloatDecode}, {"primFloatEncode", 2, primFloatEncode}, {"primSinDouble", 1, primSinDouble}, {"primCosDouble", 1, primCosDouble}, {"primTanDouble", 1, primTanDouble}, {"primAsinDouble", 1, primAsinDouble}, {"primAcosDouble", 1, primAcosDouble}, {"primAtanDouble", 1, primAtanDouble}, {"primExpDouble", 1, primExpDouble}, {"primLogDouble", 1, primLogDouble}, {"primSqrtDouble", 1, primSqrtDouble}, {"primDoubleToInt", 1, primDoubleToInt}, {"primDoubleRadix", 0, primFloatRadix}, {"primDoubleDigits", 0, primDoubleDigits}, {"primDoubleMinExp", 0, primDoubleMinExp}, {"primDoubleMaxExp", 0, primDoubleMaxExp}, {"primDoubleDecode", 1, primDoubleDecode}, {"primDoubleEncode", 2, primDoubleEncode}, #endif {"primIntToChar", 1, primIntToChar}, {"primCharToInt", 1, primCharToInt}, {"primIntToWord", 1, primIntToWord}, {"primWordToInt", 1, primWordToInt}, {"primIntToFloat", 1, primIntToFloat}, {"primIntToDouble", 1, primIntToDouble}, {"primDoubleToFloat", 1, primDoubleToFloat}, {"primFloatToDouble", 1, primFloatToDouble}, {"primRationalToFloat", 1, primRationalToFloat}, {"primRationalToDouble", 1, primRationalToDouble}, {"nullPtr", 0, primNullPtr}, {"plusPtr", 2, primPlusPtr}, {"alignPtr", 2, primAlignPtr}, {"minusPtr", 2, primMinusPtr}, {"primEqPtr", 2, primEqPtr}, {"primCmpPtr", 2, primCmpPtr}, {"primEqInt", 2, primEqInt}, {"primCmpInt", 2, primCmpInt}, {"primEqWord", 2, primEqWord}, {"primCmpWord", 2, primCmpWord}, {"primEqChar", 2, primEqChar}, {"primCmpChar", 2, primCmpChar}, {"primEqFloat", 2, primEqFloat}, {"primCmpFloat", 2, primCmpFloat}, {"primEqDouble", 2, primEqDouble}, {"primCmpDouble", 2, primCmpDouble}, {"primUnsafeCoerce", 1, primDummyCvt}, /* breaks the type system */ {"strict", 2, primStrict}, {"seq", 2, primSeq}, {"primMaxChar", 0, primMaxChar}, {"isUpper", 1, primIsUpper}, {"isLower", 1, primIsLower}, {"isAlpha", 1, primIsAlpha}, {"isAlphaNum", 1, primIsAlphaNum}, {"isPrint", 1, primIsPrint}, {"toUpper", 1, primToUpper}, {"toLower", 1, primToLower}, {"toTitle", 1, primToTitle}, {"primUniGenCat", 1, primUniGenCat}, #if TREX {"recExt", 3, primRecExt}, {"recBrk", 2, primRecBrk}, {"recSel", 2, primRecSel}, {"recShw", 5, primRecShw}, {"recEq", 6, primRecEq}, #endif #if OBSERVATIONS {"observe", 2, primObserve}, {"bkpt", 2, primBkpt}, {"setBkpt", 2+IOArity, primSetBkpt}, #endif {"unsafePtrEq", 2, primUnsafePtrEq}, /* breaks the semantics */ {"unsafePtrToInt", 1, primUnsafePtrToInt}, /* breaks the semantics */ {0, 0, 0} }; /* -------------------------------------------------------------------------- * Primitive functions: * * IMPORTANT NOTICE: the primitive function definitions in this file * should be written in a style that permits correct execution *without* * conservative garbage collection (i.e., without marking from the C stack). * Adding primitive definitions that do not meet this requirement may * corrupt the heap and lead to failed execution; do not modify this code * unless you are really confident about what you are doing. * * Some general guidelines follow, using c, e to denote expressions that * involve either at most 1 allocation, or the possibility/certainty of * multiple allocations, resp. * * push(c); Ok. * push(e); Bad -- intermediate result may be lost if GC occurs * in the middle of building e; break e into steps, and * use toparg(), topfun(), etc. * * Cell x = ...; Safe if value assigned to x will never be an * be returned to freeList *before* the value is used.) * ... x ... Probably best avoided in other circumstances. * * updateRoot(e); All ok. * updapRoot(e,e); * updateRoot(mkInt(n)); * eval(pop()); * * eval(ap(c,pop())); Bad -- a GC call may corrupt value pop'd off stack. * * It is also worth a reminder that the fst and snd values passed in any call * to the allocator are automatically marked and preserved if a GC is needed. * As a result, code like the following is guaranteed to be safe: * return ap(ap(mkTuple(2),ZERONUM),ZERONUM); (ZERONUM is a constant) * for ( ... ) (PROVIDED that ds is the * ds = cons(consChar(c),ds); only var that needs GC). * * If these restrictions are judged to be too onerous in particular cases, * temporarily enable conservative GC (and reset it to the original state, * either on or off at the beginning of the operation). See bignums.c * for an example. * * There are also certain conventions that must always be obeyed, regardless * of whether conservative GC is in use. For example: * * lhs = expr; If lhs involves an address calculation that may be * invalidated by a gc, and expr could trigger an alloc, * then this expression is bad, or at least not portable: * it will only do the right thing under some evaluation * orders. For example: hd(top()) = ap(..,..) is bad, * unless you know that top() will never be modified * during a GC. * * This is no different from the problems that occur * with non-portable combinations of stack operators * like push(top()); The solution is also the same: * use an intermediate variable to make the order * of evaluation explicit. * * If this version of Hugs has been modified to allow different or * additional run-time representations for certain values, then the * examples and principles illustrated here may need to be reconsidered, * and possibly reclassified. The same will also be true if the execution * mechanisms etc., are changed in any way. (And all this is assuming * that the original implementations are correct...) * ------------------------------------------------------------------------*/ primFun(primFatbar) { /* Fatbar primitive */ Cell temp = evalWithNoError(primArg(2)); if (nonNull(temp)) if (temp==nameFail) /* _FAIL [] r = r */ updateRoot(primArg(1)); else throwException(temp); else updateRoot(primArg(2)); /* l [] r = l -- otherwise */ } primFun(primFail) { /* Failure primitive */ throwException(nameFail); } primFun(primBlackHole) { throwException(nameNonTermination); } primFun(primIndirect) { throwException(nameNonTermination); } primFun(primCatchError) { /* Error catching primitive */ Cell err = NIL; err = evalWithNoError(primArg(1)); /* :: a -> Maybe a */ if (isNull(err)) { updapRoot(nameJust, primArg(1)); } else { updateRoot(nameNothing); } } primFun(primThrowException) { /* Failure primitive */ throwException(primArg(1)); /* :: Exception -> a */ } /* This function ought to be in the IO monad to preserve referential */ /* transparency but it has tricky interactions with the concurrency parts */ /* of the IO monad so we provide it in unsafe form here and make it safe */ /* in the Prelude. */ primFun(primCatchException) { /* Error catching primitive */ Cell err = NIL; /* :: a -> Either Exception a */ err = evalWithNoError(primArg(1)); if (isNull(err)) { updapRoot(nameRight, primArg(1)); } else { updapRoot(nameLeft, err); } } primFun(primSel) { /* Component selection */ eval(primArg(2)); /* _sel c e n return nth component*/ if (whnfHead==primArg(3)) /* in expr e, built with cfun c */ updateRoot(pushed(intOf(primArg(1))-1)); else internal("primSel"); } primFun(primIf) { /* Conditional primitive */ eval(primArg(3)); checkBool(); if (whnfHead==nameTrue) updateRoot(primArg(2)); else updateRoot(primArg(1)); } primFun(primStrict) { /* Strict application primitive */ eval(primArg(1)); /* evaluate 2nd argument */ updapRoot(primArg(2),primArg(1)); /* and apply 1st argument to result*/ } primFun(primSeq) { /* Strict sequencing primitive */ eval(primArg(2)); /* evaluate 1st argument */ updateRoot(primArg(1)); /* and return the first */ } primFun(primConCmp) { /* compare constructors */ Int l,r; /* :: a -> a -> Ordering */ ConArg(l,2); ConArg(r,1); updateRoot(lr ? nameGT : nameEQ)); } primFun(primEnRange) { /* derived range for enum type */ eval(primArg(1)); /* :: (a,a) -> [a] */ updapRoot(ap(nameEnFrTo,primArg(3)),primArg(2)); } primFun(primEnIndex) { /* derived index for enum type */ Int l,h,ix; /* :: (a,a) -> a -> Int */ eval(primArg(2)); ConArg(l,4); /* evaluate lower bound */ ConArg(h,3); /* evaluate upper bound */ ConArg(ix,1); /* evaluate index */ if (l<=ix && ix<=h) { IntResult(ix-l); } else { throwException(ap(nameErrorCall, mkStr(findText("Ix.index: Index out of range.")))); } } primFun(primEnInRng) { /* derived inRange for enum type */ Int l,h,ix; /* :: (a,a) -> a -> Bool */ eval(primArg(2)); ConArg(l,4); /* evaluate lower bound */ ConArg(h,3); /* evaluate upper bound */ ConArg(ix,1); /* evaluate index */ BoolResult(l<=ix && ix<=h); } primFun(primEnToEn) { /* derived toEnum for enum type */ Name n; /* :: a -> Int -> a */ Int i; eval(primArg(2)); checkCon(); n = whnfHead; IntArg(i,1); if (nonNull(n = cfunByNum(n,i))) updateRoot(n); else throwException(ap(nameErrorCall, mkStr(findText("toEnum: out of range")))); } primFun(primEnFrEn) { /* derived fromEnum for enum type */ Int i; /* :: a -> Int */ ConArg(i,1); IntResult(i==0 ? 0 : (i-1)); } primFun(primEnFrom) { /* derived enumFrom for enum type */ Name cfs; /* :: a -> [a] */ eval(primArg(1)); checkCon(); cfs = succCfun(whnfHead); push(isNull(cfs) ? nameNil : ap(nameEnFrom,cfs)); updapRoot(ap(nameCons,whnfHead),top()); } primFun(primEnFrTo) { /* derived enumFromTo for enum type*/ Name l,r; /* :: a -> a -> [a] */ eval(primArg(2)); checkCon(); l = whnfHead; eval(primArg(1)); checkCon(); r = whnfHead; if (cfunOf(l) < cfunOf(r)) { push(ap(nameEnFrTo,succCfun(l))); updapRoot(ap(nameCons,l),ap(top(),whnfHead)); } else if (l==r) { updapRoot(ap(nameCons,l),nameNil); } else { updateRoot(nameNil); } } primFun(primEnFrTh) { /* derived enumFromThen for enum ty*/ Name f,n; /* :: a -> a -> [a] */ eval(primArg(2)); checkCon(); f = whnfHead; eval(primArg(1)); checkCon(); n = nextCfun(f,whnfHead); if (isNull(n)) { push(ap(nameCons,whnfHead)); toparg(nameNil); } else { push(ap(nameEnFrTh,whnfHead)); toparg(n); } updapRoot(ap(nameCons,f),top()); } /* -------------------------------------------------------------------------- * Integer arithmetic primitives: * ------------------------------------------------------------------------*/ CAFInt(primMinInt,MINNEGINT) /* minimum integer CAF */ CAFInt(primMaxInt,MAXPOSINT) /* maximum integer CAF */ IntInt2Int(primPlusInt,x+y) /* Integer addition primitive */ IntInt2Int(primMinusInt,x-y) /* Integer subtraction primitive */ IntInt2Int(primMulInt,x*y) /* Integer multiplication primitive */ Int2Int(primNegInt,-x) /* Integer negation primitive */ IntInt2IntNonZero(primQuotInt,x/y) /* Integer division primitive */ /* truncated towards zero */ IntInt2IntNonZero(primRemInt,x%y) /* Integer remainder primitive */ /* quot and rem satisfy: */ /* (x `quot` y)*y + (x `rem` y) == x */ /* which is exactly the property described in K&R 2: */ /* (a/b)*b + a%b == a */ primFun(primQrmInt) { /* Integer quotient and remainder */ Int x, y; /* truncated towards zero */ IntArg(x,2); IntArg(y,1); if (y==0) throwException(ap(nameArithException, nameDivideByZero)); IntIntResult(x/y,x%y); } primFun(primDivInt) { /* Integer division primitive */ Int x,y,r; /* truncated towards -ve infinity */ IntArg(x,2); IntArg(y,1); if (y==0) throwException(ap(nameArithException, nameDivideByZero)); r = x%y; x = x/y; if ((y<0 && r>0) || (y>0 && r<0)) x--; IntResult(x); } primFun(primModInt) { /* Integer modulo primitive */ Int x,y,r; IntArg(x,2); IntArg(y,1); if (y==0) throwException(ap(nameArithException, nameDivideByZero)); r = x%y; /* "... the modulo having the sign */ if ((r<0 && y>0) || /* of the divisor ..." */ (r>0 && y<0)) { /* See definition on p.91 of Haskell*/ IntResult(r+y); /* report... (Haskell 1.1?) */ } else { IntResult(r); } } IntInt2Int(primAndInt,x&y) IntInt2Int(primOrInt, x|y) IntInt2Int(primXorInt,(x&~y) | (~x&y)) Int2Int(primComplementInt,~x) Int2Int(primBitInt, 1<> y) & 1) primFun(primShiftInt) { Int x,y; IntArg(x,2); IntArg(y,1); if (y >= 0) { IntResult(x << y); } else { IntResult(x >> (-y)); } } /* -------------------------------------------------------------------------- * Unsigned arithmetic primitives: * ------------------------------------------------------------------------*/ #if WORD_OPS CAFWord(primMaxWord,MAXHUGSWORD) /* maximum integer CAF */ WordWord2Word(primPlusWord,x+y) /* Word addition primitive */ WordWord2Word(primMinusWord,x-y) /* Word subtraction primitive */ Word2Word(primNegateWord,-(Int)x) /* Word negation (modulo MAXWORD) */ WordWord2Word(primMulWord,x*y) /* Word multiplication primitive */ WordWord2WordNonZero(primQuotWord,x/y) /* Word division primitive */ /* truncated towards zero */ WordWord2WordNonZero(primDivWord,x/y) /* Word division primitive */ /* truncated towards zero */ WordWord2WordNonZero(primRemWord,x%y) /* Word remainder primitive */ WordWord2WordNonZero(primModWord,x%y) /* Word modulo primitive */ /* quot and rem satisfy: */ /* (x `quot` y)*y + (x `rem` y) == x */ /* which is exactly the property described in K&R 2: */ /* (a/b)*b + a%b == a */ primFun(primQrmWord) { /* Integer quotient and remainder */ Unsigned x, y; /* truncated towards zero */ WordArg(x,2); WordArg(y,1); if (y==0) throwException(ap(nameArithException, nameDivideByZero)); WordWordResult(x/y,x%y); } WordWord2Word(primAndWord,x&y) WordWord2Word(primOrWord, x|y) WordWord2Word(primXorWord,(x&~y) | (~x&y)) Word2Word(primComplementWord,~x) Int2Word(primBitWord, 1<> y) & 1) primFun(primShiftWord) { Unsigned x; Int y; WordArg(x,2); IntArg(y,1); if (y >= 0) { /* << isn't defined for y larger than word size */ WordResult(y >= (Int)(sizeof(x) * 8) ? 0 : x << y); } else { y = -y; WordResult(y >= (Int)(sizeof(x) * 8) ? 0 : x >> y); } } primFun(primRotateWord) { Unsigned x; Int y, z; WordArg(x,2); IntArg(y,1); IntArg(z,3); y = y % z; if (y >= 0) { WordResult((x << y) | (x >> (z - y))); } else { WordResult((x >> (-y)) | (x << (z + y))); } } Int2Int(primItoI8, x&0xff) Int2Int(primItoI16, x&0xffff) Int2Int(primItoI32, x&0xffffffff) Int2Int(primI8toI, (Int8)x) /* casts used to cause sign extension */ Int2Int(primI16toI, (Int16)x) /* casts used to cause sign extension */ Int2Int(primI32toI, x) Word2Word(primWtoW8, x&0xff) Word2Word(primWtoW16, x&0xffff) Word2Word(primWtoW32, x&0xffffffff) Word2Word(primW8toW, x) Word2Word(primW16toW, x) Word2Word(primW32toW, x) primFun(primI64toI32) { Cell x, y; eval(primArg(1)); x = fst(snd(whnfHead)); y = snd(snd(whnfHead)); updapRoot(ap(mkTuple(2),x),y); } primFun(primI32toI64) { Int x, y; IntArg(x,2); IntArg(y,1); updateRoot(pair(I64CELL,pair(mkInt(x),mkInt(y)))); } primFun(primW64toW32) { Cell x, y; eval(primArg(1)); x = fst(snd(whnfHead)); y = snd(snd(whnfHead)); updapRoot(ap(mkTuple(2),x),y); } primFun(primW32toW64) { Unsigned x, y; WordArg(x,2); WordArg(y,1); updateRoot(pair(I64CELL,pair(mkInt(x),mkInt(y)))); } #endif /* WORD_OPS */ /* -------------------------------------------------------------------------- * Haskell Integer (bignum) primitives: * ------------------------------------------------------------------------*/ #if BIGNUMS #include "bignums.c" #endif /* -------------------------------------------------------------------------- * Coercion primitives: * ------------------------------------------------------------------------*/ Char2Int(primCharToInt,x) /* Character to integer primitive */ primFun(primIntToChar) { /* Integer to character primitive */ Int i; IntArg(i,1); if (i<0 || i>MAXCHARVAL) throwException(ap(nameErrorCall, mkStr(findText("chr: out of range")))); CharResult(i); } primFun(primWordToInt) { /* Word to integer primitive */ Unsigned x; WordArg(x,1); IntResult(x); } primFun(primIntToWord) { /* Integer to word primitive */ Int i; IntArg(i,1); WordResult(i); } primFun(primIntToFloat) { /* Integer to Float primitive */ Int i; IntArg(i,1); FloatResult((Float)i); } primFun(primIntToDouble) { /* Integer to Double primitive */ Int i; IntArg(i,1); DoubleResult((Double)i); } primFun(primDummyCvt) { /* dummy (identity) conversion */ updateRoot(primArg(1)); } primFun(primRationalToFloat) { #if SHORT_CIRCUIT_COERCIONS /* Optimisation: we try to short-circuit trivial conversions */ Cell x = followInd(primArg(1)); if (isAp(x)) { Cell f = followInd(fun(x)); Cell a = arg(x); if (f == nameFloatToRational) { updateRoot(a); return; } else if (f == nameDoubleToRational) { updapRoot(nameDoubleToFloat,a); return; } else if (isAp(f)) { Cell g = followInd(fun(f)); if (g == nameDoubleToRatio) { /* ignore the dict - it must be right */ updapRoot(nameDoubleToFloat,a); return; } else if (g == nameIntToRatio) { updapRoot(nameIntToFloat,a); return; } } } #endif updapRoot(nameRationalToFloat,primArg(1)); } primFun(primRationalToDouble) { #if SHORT_CIRCUIT_COERCIONS /* Optimisation: we try to short-circuit trivial conversions */ Cell x = followInd(primArg(1)); if (isAp(x)) { Cell f = followInd(fun(x)); Cell a = arg(x); if (f == nameFloatToRational) { updapRoot(nameFloatToDouble,a); return; } else if (f == nameDoubleToRational) { updateRoot(a); return; } else if (isAp(f)) { Cell g = followInd(fun(f)); if (g == nameDoubleToRatio) { updateRoot(a); /* ignore the dict - it must be right */ return; } else if (g == nameIntToRatio) { updapRoot(nameIntToDouble,a); return; } } } #endif updapRoot(nameRationalToDouble,primArg(1)); } /* -------------------------------------------------------------------------- * Float arithmetic primitives: * ------------------------------------------------------------------------*/ primFun(primFloatToDouble) { Float f; FloatArg(f,1); DoubleResult((Double)f); } primFun(primDoubleToFloat) { Double f; DoubleArg(f,1); FloatResult((Float)f); } FloatFloat2Float(primPlusFloat,x+y) /* Float addition primitive */ FloatFloat2Float(primMinusFloat,x-y) /* Float subtraction primitive */ FloatFloat2Float(primMulFloat,x*y) /* Float multiplication primitive */ Float2Float(primNegFloat,-x) /* Float negation primitive */ FloatFloat2Float(primDivFloat,x/y) /* Float division primitive */ DoubleDouble2Double(primPlusDouble,x+y) /* Double addition primitive */ DoubleDouble2Double(primMinusDouble,x-y)/* Double subtraction primitive */ DoubleDouble2Double(primMulDouble,x*y) /* Double multiplication primitive */ Double2Double(primNegDouble,-x) /* Double negation primitive */ DoubleDouble2Double(primDivDouble,x/y) /* Double division primitive */ #if FLOATS_SUPPORTED Float2Float(primSinFloat,sin(x)) /* Float sin (trig) primitive */ Float2Float(primCosFloat,cos(x)) /* Float cos (trig) primitive */ Float2Float(primTanFloat,tan(x)) /* Float tan (trig) primitive */ Float2Float(primAsinFloat,asin(x)) /* Float arc sin (trig) primitive */ Float2Float(primAcosFloat,acos(x)) /* Float arc cos (trig) primitive */ Float2Float(primAtanFloat,atan(x)) /* Float arc tan (trig) primitive */ #if 0 /* not used in current version of Prelude */ FloatFloat2Float(primAtan2Float,atan2(x,y)) /* Float arc tan with quadrant info*/ #endif /* (trig) primitive */ Float2Float(primExpFloat,exp(x)) /* Float exponential primitive */ Float2FloatPre(primLogFloat,log(x),x>0)/* Float logarithm primitive */ Float2FloatPre(primSqrtFloat,sqrt(x),x>=0) /* Float square root primitive */ Double2Double(primSinDouble,sin(x)) /* Double sin (trig) primitive */ Double2Double(primCosDouble,cos(x)) /* Double cos (trig) primitive */ Double2Double(primTanDouble,tan(x)) /* Double tan (trig) primitive */ Double2Double(primAsinDouble,asin(x)) /* Double arc sin (trig) primitive */ Double2Double(primAcosDouble,acos(x)) /* Double arc cos (trig) primitive */ Double2Double(primAtanDouble,atan(x)) /* Double arc tan (trig) primitive */ Double2Double(primExpDouble,exp(x)) /* Double exponential primitive */ Double2DoublePre(primLogDouble,log(x),x>0)/* Double logarithm primitive */ Double2DoublePre(primSqrtDouble,sqrt(x),x>=0) /* Double square root primitive */ #if 0 /* This was in Hugs 1.01 - not needed by prelude */ Float2FloatPre(primLog10Float,log10(x),x>0) /* Float logarithm (base 10) prim*/ #endif /* Not used in Hugs prelude, rounds towards zero */ Float2Int(primFloatToInt,(Int) x) /* Adhoc Float --> Int conversion */ Double2Int(primDoubleToInt,(Int) x) /* Adhoc Double --> Int conversion */ #if BIGNUMS CAFBignum(primFloatRadix,bigInt(HUGS_FLT_RADIX)) /* Float radix primitive */ #else CAFInt(primFloatRadix,HUGS_FLT_RADIX) /* from K&R2, I hope it's portable */ #endif CAFInt(primFloatDigits,HUGS_FLT_MANT_DIG)/* Float sig. digits primitive */ /* again, courtesy K&R2 */ CAFInt(primFloatMinExp,HUGS_FLT_MIN_EXP)/* Float min exponent primitive */ CAFInt(primFloatMaxExp,HUGS_FLT_MAX_EXP)/* Float max exponent primitive */ CAFInt(primDoubleDigits,HUGS_DBL_MANT_DIG)/* Double sig. digits primitive */ /* again, courtesy K&R2 */ CAFInt(primDoubleMinExp,HUGS_DBL_MIN_EXP)/* Double min exponent primitive */ CAFInt(primDoubleMaxExp,HUGS_DBL_MAX_EXP)/* Double max exponent primitive */ /* ToDo: GHC stole its decode code from Lennart - maybe we should too? */ primFun(primFloatDecode) { /* Float decode primitive */ double f; /* :: Float -> (Integer,Int) */ Int n; /* another gruesome hack */ FloatArg(f,1); f = frexp((double)(f),&n); /* 0.5 <= f < 1 */ f = ldexp(f,HUGS_FLT_MANT_DIG); /* 2^m-1 <= f < 2^m, m=HUGS_FLT_MANT_DIG*/ n -= HUGS_FLT_MANT_DIG; #if BIGNUMS push(bigDouble(f)); updapRoot(ap(mkTuple(2),top()),mkInt(n)); #else push(mkInt((Int)f)); updapRoot(ap(mkTuple(2),top()),mkInt(n)); #endif } primFun(primFloatEncode) { /* Float encode primitive */ Int n; /* :: Integer -> Int -> Float */ Float f; /* Ugly hack, don't use Hugs for */ IntArg(n,1); /* numerical work */ eval(primArg(2)); /* get integer */ #if DJGPP2 _fpreset(); /* Get round a possible DJGPP bug? */ #endif #if BIGNUMS f = (Float)bigToDouble(whnfHead); /* and turn it into a float */ #else f = (Float) whnfInt; /* and turn it into a float */ #endif updateRoot(mkFloat(ldexp(f,n))); } /* ToDo: GHC stole its decode code from Lennart - maybe we should too? */ primFun(primDoubleDecode) { /* Double decode primitive */ double f; /* :: Double -> (Integer,Int) */ Int n; /* another gruesome hack */ DoubleArg(f,1); f = frexp((double)(f),&n); /* 0.5 <= f < 1 */ f = ldexp(f,HUGS_DBL_MANT_DIG); /* 2^m-1 <= f < 2^m, m=HUGS_DBL_MANT_DIG*/ n -= HUGS_DBL_MANT_DIG; #if BIGNUMS push(bigDouble(f)); updapRoot(ap(mkTuple(2),top()),mkInt(n)); #else push(mkInt((Int)f)); updapRoot(ap(mkTuple(2),top()),mkInt(n)); #endif } primFun(primDoubleEncode) { /* Double encode primitive */ Int n; /* :: Integer -> Int -> Double */ Double f; /* Ugly hack, don't use Hugs for */ IntArg(n,1); /* numerical work */ eval(primArg(2)); /* get integer */ #if DJGPP2 _fpreset(); /* Get round a possible DJGPP bug? */ #endif #if BIGNUMS f = (Double)bigToDouble(whnfHead); /* and turn it into a double */ #else f = (Double)whnfInt; /* and turn it into a double */ #endif DoubleResult(ldexp(f,n)); } #endif /* FLOATS_SUPPORTED */ /* -------------------------------------------------------------------------- * Ptr primitives: * ------------------------------------------------------------------------*/ CAFPtr(primNullPtr,0) /* Null pointer */ PtrInt2Ptr(primPlusPtr,(char*)x+y) /* Pointer arithmetic */ PtrInt2Ptr(primAlignPtr,(char*)x+(int)((y - (long)x%y)%y)) /* Aligning the pointer */ PtrPtr2Int(primMinusPtr,(char*)x-(char*)y) /* Pointer arithmetic */ PtrPtr2Bool(primEqPtr,x==y) /* Pointer equality primitive */ primFun(primCmpPtr) { /* Pointer compare primitive */ Pointer x, y; PtrArg(x,2); PtrArg(y,1); updateRoot( xy ? nameGT : nameEQ )); } /* -------------------------------------------------------------------------- * Comparison primitives: * ------------------------------------------------------------------------*/ IntInt2Bool(primEqInt,x==y) /* Integer equality primitive */ WordWord2Bool(primEqWord,x==y) /* Natural equality primitive */ CharChar2Bool(primEqChar,x==y) /* Character equality primitive */ FloatFloat2Bool(primEqFloat, x==y) /* Float equality primitive */ DoubleDouble2Bool(primEqDouble, x==y) /* Double equality primitive */ primFun(primCmpInt) { /* Integer compare primitive */ Int x, y; IntArg(x,2); IntArg(y,1); updateRoot( xy ? nameGT : nameEQ )); } primFun(primCmpWord) { /* Natural compare primitive */ Unsigned x, y; WordArg(x,2); WordArg(y,1); updateRoot( xy ? nameGT : nameEQ )); } primFun(primCmpChar) { /* Character compare primitive */ Char x, y; CharArg(x,2); CharArg(y,1); updateRoot( xy ? nameGT : nameEQ )); } primFun(primCmpFloat) { /* Float compare primitive */ Float x, y; FloatArg(x,2); FloatArg(y,1); updateRoot( xy ? nameGT : nameEQ )); } primFun(primCmpDouble) { /* Double compare primitive */ Double x, y; DoubleArg(x,2); DoubleArg(y,1); updateRoot( xy ? nameGT : nameEQ )); } /* -------------------------------------------------------------------------- * Print primitives: * ------------------------------------------------------------------------*/ #include "printer.c" /* -------------------------------------------------------------------------- * Evaluate name, obtaining a C string from a Hugs string: * ------------------------------------------------------------------------*/ #if FILENAME_MAX < 1024 # define MAX_STRING 1024 #else # define MAX_STRING FILENAME_MAX #endif String evalName(es) /* evaluate es :: [Char] and save */ Cell es; { /* in char array... return ptr to */ static char buffer[MAX_STRING+1]; /* string or 0, if error occurs */ char *bp = buffer; StackPtr saveSp = sp; eval(es); while (whnfHead==nameCons && bp<=buffer+MAX_STRING-MAX_CHAR_ENCODING) { eval(pop()); AddChar(charOf(whnfHead), bp); eval(pop()); } if (whnfHead==nameNil) { *bp = '\0'; return buffer; } sp = saveSp; /* stack pointer must be the same */ return 0; /* as it was on entry */ } /* -------------------------------------------------------------------------- * Top-level printing mechanism: * ------------------------------------------------------------------------*/ Void outputString(fp) /* Evaluate string on top of stack */ FILE *fp; { /* and print it on fp */ StackPtr origSp = sp; for (;;) { Cell temp = evalWithNoError(pop()); if (nonNull(temp)) { sp = origSp; top() = printException((top()=temp),nameNil); } else if (whnfHead==nameCons) { if (nonNull(temp=evalWithNoError(pop()))) { sp = origSp; onto(temp); pushed(1) = printException(pushed(0),pushed(1)); drop(); } else { FPutChar(charOf(whnfHead),fp); fflush(fp); } } else return; } } /* -------------------------------------------------------------------------- * IO monad implementation * ------------------------------------------------------------------------*/ #if IO_MONAD #include "iomonad.c" #endif /* -------------------------------------------------------------------------- * Time and CPUTime module implementations * ------------------------------------------------------------------------*/ #if TIME_MODULE #include "timeprim.c" #endif /* -------------------------------------------------------------------------- * Directory module implementation * ------------------------------------------------------------------------*/ #if DIRECTORY_MODULE #include "dirprim.c" #endif /* -------------------------------------------------------------------------- * Error catching primitives * (not standard Haskell but jolly useful) * ------------------------------------------------------------------------*/ #if INTERNAL_PRIMS #include "interns.c" #endif /* -------------------------------------------------------------------------- * Array primitives: * ------------------------------------------------------------------------*/ #if HASKELL_ARRAYS #include "array.c" #endif /* -------------------------------------------------------------------------- * Char primitives: * ------------------------------------------------------------------------*/ CAFChar(primMaxChar,MAXCHARVAL) Char2Bool(primIsUpper,isUpper(x)) Char2Bool(primIsLower,isLower(x)) Char2Bool(primIsAlpha,isAlpha(x)) Char2Bool(primIsAlphaNum,isAlphaNum(x)) Char2Bool(primIsPrint,isPrint(x)) Char2Char(primToLower,toLower(x)) Char2Char(primToUpper,toUpper(x)) Char2Char(primToTitle,toTitle(x)) Char2Int(primUniGenCat,uni_gencat(x)) /* -------------------------------------------------------------------------- * Extensible records: (Gaster and Jones, 1996) * ------------------------------------------------------------------------*/ #if TREX primFun(primRecExt) { /* :: Int -> a -> Rec ? -> Rec ? */ Int n; Cell b = NIL; Cell r; eval(primArg(3)); n = whnfInt; eval(primArg(1)); for (r=arg(whnfHead); n>0; n--) { b = cons(fun(r),b); r = arg(r); } b = cons(primArg(2),b); updapRoot(RECORD,revOnto(b,r)); } primFun(primRecBrk) { /* :: Int -> Rec ? -> (?, Rec ?) */ Int n; Cell b; Cell r; eval(primArg(2)); n = whnfInt; eval(primArg(1)); b = cons(RECORD,NIL); for (r=arg(whnfHead); n>0; n--) { b = cons(fun(r),b); r = arg(r); } pushed(1) = revOnto(b,arg(r)); pushed(0) = ap(mkTuple(2),fun(r)); updapRoot(pushed(0),pushed(1)); } primFun(primRecSel) { /* :: Int -> Rec ? -> ? */ Int n; Cell r; eval(primArg(2)); n = whnfInt; eval(primArg(1)); for (r=arg(whnfHead); n>0; n--) r = arg(r); updateRoot(fun(r)); } /* recShw :: primArg(5) Label l -> * primArg(4) ShowD a -> * primArg(3) Lacks_l r -> * primArg(2) ShowRecRowD r -> * primArg(1) Rec (l::a|r) -> [(String,ShowS)] * recShw l d e f r * = case recBrk e r of * (v,s) -> insertField l (showsPrec d 0 v) (showRecRow f s) */ primFun(primRecShw) { push(nameRecBrk); toparg(primArg(3)); toparg(primArg(1)); eval(pop()); primArg(2) = ap(nameShowRecRow,primArg(2)); primArg(4) = ap(nameShowsPrec,primArg(4)); primArg(4) = ap(primArg(4),mkInt(0)); primArg(5) = ap(nameInsFld,primArg(5)); pushed(1) = ap(primArg(2),pushed(1)); pushed(0) = ap(primArg(4),pushed(0)); pushed(0) = ap(primArg(5),pushed(0)); updapRoot(pushed(0),pushed(1)); } /* recEq :: primArg(6) Label l -> * primArg(5) EqD a -> * primArg(4) Lacks_x r -> * primArg(3) EqRecRowD r -> * primArg(2) Rec (l::a|r) -> * primArg(1) Rec (l::a|r) -> [(String,Bool)] * reqEq l eqa e eqr r1 r2 * = case recBrk e r1 of * (v,s1) -> case recBrk e r2 of * (w,s2) -> insertField l ((==) eqa v w) * (eqRecRow eqr s1 s2) */ primFun(primRecEq) { push(nameRecBrk); toparg(primArg(4)); toparg(primArg(2)); eval(pop()); push(nameRecBrk); toparg(primArg(4)); toparg(primArg(1)); eval(pop()); primArg(3) = ap(nameEqRecRow,primArg(3)); primArg(3) = ap(primArg(3),pushed(3)); primArg(3) = ap(primArg(3),pushed(1)); primArg(5) = ap(nameEq,primArg(5)); primArg(5) = ap(primArg(5),pushed(2)); primArg(5) = ap(primArg(5),pushed(0)); primArg(6) = ap(nameInsFld,primArg(6)); primArg(6) = ap(primArg(6),primArg(5)); updapRoot(primArg(6),primArg(3)); } #endif /* -------------------------------------------------------------------------- * Auxilliary functions * ------------------------------------------------------------------------*/ static Cell local followInd(c) /* follow chain of indirections and CAFs */ Cell c; { do { switch (whatIs(c)) { case INDIRECT : c = snd(c); break; #if OBSERVATIONS case OBSERVE : c = markedExpr(c); break; #endif case NAME : if (isCfun(c) || name(c).arity != 0 || isNull(name(c).defn)) { return c; } c = name(c).defn; break; default : return c; } allowBreak(); } while (1); } /* -------------------------------------------------------------------------- * Pointer equality * ------------------------------------------------------------------------*/ /* Pointer equality tests break referential transparency. * However, they can be useful in implementing referentially transparent * functions such as lazy memo-tables. * * foo = cache sin * * cache :: (a -> b) -> (a -> b) * cache f = \x -> unsafePerformIO (check x) * where * ref = unsafePerformIO (newRef (error "cache", error "cache")) * check x = derefRef ref >>= \ (x',a) -> * if x `unsafePtrEq` x' then * return a * else * let a = f x in * assignRef ref (x, a) >> * return a */ primFun(primUnsafePtrEq) { /* Unsafe pointer equality test */ Cell x = followInd(primArg(2)); Cell y = followInd(primArg(1)); updateRoot( (x==y) ? nameTrue : nameFalse ); } /* Companion function for use when debugging uses of unsafePtrEq. * Converts a heap pointer to an Int so you can look at it. * I don't think there's any way of using this function that * doesn't break the semantics - debugging use only. */ primFun(primUnsafePtrToInt) { updateRoot(mkInt(followInd(primArg(1)))); } /*--------------------------------------------------------------------------- * GreenCard entry points * * GreenCard generated code accesses Hugs data structures and functions * (only) via these functions (which are stored in the virtual function * table hugsAPI4). *-------------------------------------------------------------------------*/ static void getUnit Args((void)); static HsInt getInt Args((void)); static HsWord getWord Args((void)); static HsAddr getAddr Args((void)); static char getChar4 Args((void)); static HsChar getChar Args((void)); static HugsForeign getForeign Args((void)); static HsBool getBool Args((void)); static HsInt8 getInt8 Args((void)); static HsInt16 getInt16 Args((void)); static HsInt32 getInt32 Args((void)); static HsInt64 getInt64 Args((void)); static HsWord8 getWord8 Args((void)); static HsWord16 getWord16 Args((void)); static HsWord32 getWord32 Args((void)); static HsWord64 getWord64 Args((void)); static HsPtr getPtr Args((void)); static HsFunPtr getFunPtr Args((void)); static HsForeignPtr getForeignPtr Args((void)); static HsStablePtr getStablePtr4 Args((void)); static HsFloat getFloat Args((void)); static HsDouble getDouble Args((void)); static HugsStablePtr getStablePtr Args((void)); static void putInt Args((HsInt)); static void putWord Args((HsWord)); static void putAddr Args((HsAddr)); static void putChar4 Args((char)); static void putChar Args((HsChar)); static void putForeign Args((HugsForeign, void (*)(void *))); static void putStablePtr4 Args((HsStablePtr)); static void putBool Args((HsBool)); static void putInt8 Args((HsInt8)); static void putInt16 Args((HsInt16)); static void putInt32 Args((HsInt32)); static void putInt64 Args((HsInt64)); static void putWord8 Args((HsWord8)); static void putWord16 Args((HsWord16)); static void putWord32 Args((HsWord32)); static void putWord64 Args((HsWord64)); static void putPtr Args((HsPtr)); static void putFunPtr Args((HsFunPtr)); static void putForeignPtr Args((HsForeignPtr)); static void putFloat Args((HsFloat)); static void putDouble Args((HsDouble)); static void freeStablePtr4 Args((HsStablePtr)); static void returnIO Args((HugsStackPtr, int)); static void returnId Args((HugsStackPtr, int)); static int runIO Args((int)); static void apMany Args((int)); static void getUnit() { eval(pop()); } static HsInt getInt() { eval(pop()); checkInt(); return whnfInt; } static HsWord getWord() { eval(pop()); checkWord(); return (unsigned int) whnfInt; } static HsAddr getAddr() { eval(pop()); checkPtr(); return ptrOf(whnfHead); } static char getChar4() { eval(pop()); checkChar(); return charOf(whnfHead); } static HsChar getChar() { eval(pop()); checkChar(); return charOf(whnfHead); } static HugsForeign getForeign() { eval(pop()); return derefMP(whnfHead); } static HsBool getBool() { eval(pop()); checkBool(); return (whnfHead == nameTrue); } static HsInt8 getInt8() { eval(pop()); checkInt(); return whnfInt; } static HsInt16 getInt16() { eval(pop()); checkInt(); return whnfInt; } static HsInt32 getInt32() { eval(pop()); checkInt(); return whnfInt; } static HsInt64 getInt64() { eval(pop()); return int64FromParts(intOf(fst(snd(whnfHead))), intOf(snd(snd(whnfHead)))); } static HsWord8 getWord8() { eval(pop()); checkWord(); return (unsigned int) whnfInt; } static HsWord16 getWord16() { eval(pop()); checkWord(); return (unsigned int) whnfInt; } static HsWord32 getWord32() { eval(pop()); checkWord(); return (unsigned int) whnfInt; } static HsWord64 getWord64() { eval(pop()); return int64FromParts(intOf(fst(snd(whnfHead))), intOf(snd(snd(whnfHead)))); } static HsPtr getPtr() { eval(pop()); checkPtr(); return ptrOf(whnfHead); } static HsFunPtr getFunPtr() { eval(pop()); checkPtr(); return (HsFunPtr)ptrOf(whnfHead); } static HsForeignPtr getForeignPtr() { ERRMSG(0) "getForeignPtr: not implemented in Hugs" EEND; return 0; } static HugsStablePtr getStablePtr() { Cell c = mkStablePtr(pop()); if (isNull(c)) { ERRMSG(0) "Stable pointer table full" EEND; } return c; } static HugsStablePtr lookupName Args((String, String)); static HugsStablePtr lookupName(q,n) String q; String n; { Name nm = findQualFun(findText(q), findText(n)); Cell c; if (isNull(nm)) { ERRMSG(0) "Can't find qualified name '%s.%s'", q, n EEND; } c = mkStablePtr(nm); if (isNull(c)) { ERRMSG(0) "Stable pointer table full" EEND; } return c; } static void putInt (HsInt x) { push(mkInt(x)); } static void putWord(HsWord x) { push(mkInt((int)x)); } static void putAddr(HsAddr x) { push(mkPtr(x)); } static void putChar4(char x) { push(mkChar(x)); } static void putChar(HsChar x) { push(mkChar(x)); } static void putForeign(HugsForeign x, void (*f)(HugsForeign)) { push(mkMallocPtr(x,f)); } static void putStablePtr (HugsStablePtr x) { push(derefStablePtr(x)); } static void putBool (HsBool x) { push(x?nameTrue:nameFalse); } static void putInt8 (HsInt8 x) { push(mkInt(x)); } static void putInt16(HsInt16 x) { push(mkInt(x)); } static void putInt32(HsInt32 x) { push(mkInt(x)); } static void putInt64(HsInt64 x) { push(pair(I64CELL,pair(mkInt(part1Int64(x)),mkInt(part2Int64(x))))); } static void putWord8 (HsWord8 x) { push(mkInt((int)x)); } static void putWord16(HsWord16 x) { push(mkInt((int)x)); } static void putWord32(HsWord32 x) { push(mkInt((int)x)); } static void putWord64(HsWord64 x) { push(pair(I64CELL,pair(mkInt(part1Int64(x)),mkInt(part2Int64(x))))); } static void putPtr (HsPtr x) { push(mkPtr(x)); } static void putFunPtr(HsFunPtr x) { push(mkPtr((Pointer)x)); } static void putStablePtr4(HsStablePtr x) { push((HugsStablePtr)x); } static HsStablePtr getStablePtr4(void) { HugsStablePtr x = pop(); return (HsStablePtr)x; } static Void freeStablePtr4(HsStablePtr x) { if (x) freeStablePtr((HugsStablePtr)x); } static HsFloat getFloat() { eval(pop()); checkFloat(); return whnfFloat; } static HsDouble getDouble() { eval(pop()); checkDouble(); return whnfDouble; } static void putFloat(HsFloat x) { push(mkFloat(x)); } static void putDouble(HsDouble x) { push(mkDouble(x)); } static void putForeignPtr(HsForeignPtr x) { ERRMSG(0) "putForeignPtr: not implemented in Hugs" EEND; } static void returnIO(root,n) /* return in IO monad */ HugsStackPtr root; int n; { /* There should be n return values on the top of the stack */ if (n == 0) { push(nameUnit); } else if (n == 1) { /* do nothing */ } else { int i; push(mkTuple(n)); for(i=0; i= 0; --i) { pushed(n) = ap(pushed(n), pushed(i)); } sp -= n; /* evaluate it - should have type IO a */ temp = evalWithNoError(ap(nameIORun,pop())); if (nonNull(temp)) { ERRMSG(0) "runIO: uncaught error" EEND; } if (sp != old_sp+1) { ERRMSG(0) "runIO: unbalanced stack (%d)", sp-old_sp EEND; } if (whnfHead == nameRight) { return 0; } else if (whnfHead != nameLeft) { /* Called "exit" */ ERRMSG(0) "runIO: bad return value" EEND; } return 1; } static void apMany(n) int n; { /* stack = argn : ... : arg1 : fun : rest */ Int i; /* build application node */ for(i=n-1; i >= 0; --i) { pushed(n) = ap(pushed(n), pushed(i)); } sp -= n; /* stack = ap(...(ap(fun,arg1),...),argn) : rest */ } static int runId Args((int)); static int runId(n) int n; { apMany(n); top() = ap(nameReturnIO,top()); return runIO(0); } /* This allocates a small object and writes some machine code into it. * * The code generated by the generated code is equivalent to: * * rty f(ty1 a1, ... tym am) { * return (*app)(s,a1, ... am); * } * * Where s is a stable pointer (an int). * * But, because this is machine code, we can do it without knowing * anything about the argument types. This works because the C * calling convention on most machines has the stack looking something * like this (where leftmost = top of stack) * * ret_addr : a1 : ... am : rest of stack * * If this is not the case for some architecture/calling convention, * the easiest thing to do might be to make the stable pointer be * the last argument (if that is easily found) or to put it in a callee * saves register - and then adapt the apply function generated by * implementForeignExport. * * thunk->{next,prev}: a doubly linked list (makes deletion easy) * thunk->stable: the stable pointer (makes deletion easy) * * At the end of execution, we run down the list freeing every thunk * that the user did not explicitly deallocate. */ struct thunk_data { struct thunk_data* next; struct thunk_data* prev; HugsStablePtr stable; #if i386_HOST_ARCH char code[17]; #elif powerpc_HOST_ARCH && defined(__GNUC__) char code[13*sizeof(unsigned long)]; #elif sparc_HOST_ARCH && defined(__GNUC__) char code[11*sizeof(unsigned long)]; #else /* This is a placeholder intended to avoid compile-time warnings. * A runtime warning will be generated by mkThunk if an attempt is * make to use foreign wrappers */ char code[1]; #endif }; static void* mkThunk Args((void (*)(void), HugsStablePtr)); static void freeThunkAux Args((struct thunk_data*)); static void freeAllThunks Args((void)); static void initAdjustor Args((void)); static struct thunk_data* foreignThunks = 0; #if i386_HOST_ARCH /* Comment from GHC's Adjustor.c: Now here's something obscure for you: When generating an adjustor thunk that uses the C calling convention, we have to make sure that the thunk kicks off the process of jumping into Haskell with a tail jump. Why? Because as a result of jumping in into Haskell we may end up freeing the very adjustor thunk we came from using freeHaskellFunctionPtr(). Hence, we better not return to the adjustor code on our way out, since it could by then point to junk. The fix is readily at hand, just include the opcodes for the C stack fixup code that we need to perform when returning in some static piece of memory and arrange to return to it before tail jumping from the adjustor thunk. */ static unsigned char *obscure_ccall_ret_code; /* set by initAdjustor() */ #endif /* i386_HOST_ARCH */ /* Heavily arch-specific, I'm afraid.. */ /* * Allocate len bytes which are readable, writable, and executable. * * ToDo: If this turns out to be a performance bottleneck, one could * e.g. cache the last VirtualProtect/mprotect-ed region and do * nothing in case of a cache hit. */ static void* local mallocBytesRWX(int len) { void *addr = (void *)malloc(len); #if defined(i386_HOST_ARCH) && defined(_WIN32) /* This could be necessary for processors which distinguish between READ and EXECUTE memory accesses, e.g. Itaniums. */ DWORD dwOldProtect = 0; if (VirtualProtect(addr, len, PAGE_EXECUTE_READWRITE, &dwOldProtect) == 0) { ERRMSG(0) "mallocBytesRWX: failed to protect 0x%p\n", addr EEND; } #elif defined(openbsd_HOST_OS) || defined(linux_HOST_OS) /* malloced memory isn't executable by default on OpenBSD */ uintptr_t pageSize = sysconf(_SC_PAGESIZE); uintptr_t mask = ~(pageSize - 1); uintptr_t startOfFirstPage = ((uintptr_t)addr ) & mask; uintptr_t startOfLastPage = ((uintptr_t)addr + len - 1) & mask; uintptr_t size = startOfLastPage - startOfFirstPage + pageSize; if (mprotect((void*)startOfFirstPage, (size_t)size, PROT_EXEC | PROT_READ | PROT_WRITE) != 0) { ERRMSG(0) "mallocBytesRWX: failed to protect 0x%p\n", addr EEND; } #endif return addr; } /* Perform initialisation of adjustor thunk layer (if needed). */ static void local initAdjustor() { #if i386_HOST_ARCH obscure_ccall_ret_code = (unsigned char *)mallocBytesRWX(4); obscure_ccall_ret_code[0x00] = (unsigned char)0x83; /* addl $0x4, %esp */ obscure_ccall_ret_code[0x01] = (unsigned char)0xc4; obscure_ccall_ret_code[0x02] = (unsigned char)0x04; obscure_ccall_ret_code[0x03] = (unsigned char)0xc3; /* ret */ #endif } static void* mkThunk(void (*app)(void), HugsStablePtr s) { /* The code part of the thunk_data needs to be marked as executable, but it's simple to do the whole struct. */ struct thunk_data* thunk = (struct thunk_data*)mallocBytesRWX(sizeof(struct thunk_data)); if (!thunk) { /* ToDo: better cleanup */ printf("Can't allocate thunk for foreign import wrapper\n"); exit(1); } if (foreignThunks) { /* non-empty list */ foreignThunks->prev = thunk; } thunk->next = foreignThunks; thunk->prev = 0; foreignThunks = thunk; thunk->stable = s; #if i386_HOST_ARCH /* Mostly cut-n-pasted from GHC's Adjustor.c. */ { unsigned char *adj_code = (unsigned char*)thunk->code; adj_code[0] = (char)0x68; /* pushl s */ *((HugsStablePtr*)(adj_code + 1)) = s; adj_code[5] = (char)0xb8; /* movl app, %eax */ *((HsFunPtr*)(adj_code + 6)) = app; adj_code[10] = (char)0x68; /* pushl obscure_ccall_ret_code */ *((unsigned char**)(adj_code + 11)) = obscure_ccall_ret_code; adj_code[15] = (char)0xff; /* jmp *%eax */ adj_code[16] = (char)0xe0; } #elif powerpc_HOST_ARCH && defined(__GNUC__) /* This is only for MacOS X. * It does not work on MacOS 9 because of the very strange * handling of function pointers in OS 9. * I don't know about LinuxPPC calling conventions. * Please note that it only works for up to 7 arguments. */ { unsigned long *adj_code = (unsigned long*)thunk->code; /* make room for extra arguments */ adj_code[0] = 0x7d2a4b78; /* mr r10,r9 */ adj_code[1] = 0x7d094378; /* mr r9,r8 */ adj_code[2] = 0x7ce83b78; /* mr r8,r7 */ adj_code[3] = 0x7cc73378; /* mr r7,r6 */ adj_code[4] = 0x7ca62b78; /* mr r6,r5 */ adj_code[5] = 0x7c852378; /* mr r5,r4 */ adj_code[6] = 0x7c641b78; /* mr r4,r3 */ adj_code[7] = 0x3c000000; /* lis r0,hi(app) */ adj_code[7] |= ((unsigned long)app) >> 16; adj_code[8] = 0x3c600000; /* lis r3,hi(s) */ adj_code[8] |= ((unsigned long)s) >> 16; adj_code[9] = 0x60000000; /* ori r0,r0,lo(app) */ adj_code[9] |= ((unsigned long)app) & 0xFFFF; adj_code[10] = 0x60630000; /* ori r3,r3,lo(s) */ adj_code[10] |= ((unsigned long)s) & 0xFFFF; adj_code[11] = 0x7c0903a6; /* mtctr r0 */ adj_code[12] = 0x4e800420; /* bctr */ /* Flush the Instruction cache: */ /* MakeDataExecutable(adjustor,4*13); */ /* This would require us to link with CoreServices.framework */ { /* this should do the same: */ int n = 13; unsigned long *p = adj_code; while(n--) { __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0" : : "g" (p)); p++; } __asm__ volatile ("sync\n\tisync"); } } #elif sparc_HOST_ARCH && defined(__GNUC__) /* Mostly cut-n-pasted from GHC's Adjustor.c: <00>: 9C23A008 sub %sp, 8, %sp ! make room for %o4/%o5 in caller's frame <04>: DA23A060 st %o5, [%sp + 96] ! shift registers by 2 positions <08>: D823A05C st %o4, [%sp + 92] <0C>: 9A10000B mov %o3, %o5 <10>: 9810000A mov %o2, %o4 <14>: 96100009 mov %o1, %o3 <18>: 94100008 mov %o0, %o2 <1C>: 13000000 sethi %hi(app), %o1 ! load up app (1 of 2) <20>: 11000000 sethi %hi(s), %o0 ! load up s (1 of 2) <24>: 81C26000 jmp %o1 + %lo(app) ! jump to app (load 2 of 2) <28>: 90122000 or %o0, %lo(), %o0 ! load up s (2 of 2, delay slot) ccall'ing on SPARC is easy, because we are quite lucky to push a multiple of 8 bytes (1 word stable pointer + 1 word dummy arg) in front of the existing arguments (note that %sp must stay double-word aligned at all times, see ABI spec at http://www.sparc.org/standards/psABI3rd.pdf). To do this, we extend the *caller's* stack frame by 2 words and shift the output registers used for argument passing (%o0 - %o5, we are a *leaf* procedure because of the tail-jump) by 2 positions. This makes room in %o0 and %o1 for the additinal arguments, namely the stable pointer and a dummy (used for destination addr of jump on SPARC). This shouldn't cause any problems for a C-like caller: alloca is implemented similarly, and local variables should be accessed via %fp, not %sp. In a nutshell: This should work! (Famous last words! :-) */ { unsigned long *adj_code = (unsigned long *)thunk->code; adj_code[ 0] = 0x9C23A008UL; /* sub %sp, 8, %sp */ adj_code[ 1] = 0xDA23A060UL; /* st %o5, [%sp + 96] */ adj_code[ 2] = 0xD823A05CUL; /* st %o4, [%sp + 92] */ adj_code[ 3] = 0x9A10000BUL; /* mov %o3, %o5 */ adj_code[ 4] = 0x9810000AUL; /* mov %o2, %o4 */ adj_code[ 5] = 0x96100009UL; /* mov %o1, %o3 */ adj_code[ 6] = 0x94100008UL; /* mov %o0, %o2 */ adj_code[ 7] = 0x13000000UL; /* sethi %hi(app), %o1 */ adj_code[ 7] |= ((unsigned long)app) >> 10; adj_code[ 8] = 0x11000000UL; /* sethi %hi(s), %o0 */ adj_code[ 8] |= ((unsigned long)s) >> 10; adj_code[ 9] = 0x81C26000UL; /* jmp %o1 + %lo(app) */ adj_code[ 9] |= ((unsigned long)app) & 0x000003FFUL; adj_code[10] = 0x90122000UL; /* or %o0, %lo(s), %o0 */ adj_code[10] |= ((unsigned long)s) & 0x000003FFUL; /* flush cache */ asm("flush %0" : : "r" (adj_code )); asm("flush %0" : : "r" (adj_code + 2)); asm("flush %0" : : "r" (adj_code + 4)); asm("flush %0" : : "r" (adj_code + 6)); asm("flush %0" : : "r" (adj_code + 10)); /* max. 5 instructions latency, and we need at >= 1 for returning */ asm("nop"); asm("nop"); asm("nop"); asm("nop"); } #else ERRMSG(0) "Foreign import wrapper is not supported on this architecture" EEND; #endif return &thunk->code; /* a pointer into the middle of the thunk */ } static void freeThunkAux(struct thunk_data* thunk) { freeStablePtr(thunk->stable); if (thunk->prev) { assert(foreignThunks != thunk); thunk->prev->next = thunk->next; } else { assert(foreignThunks == thunk); foreignThunks = thunk->next; } if (thunk->next) { thunk->next->prev = thunk->prev; } free(thunk); } static void freeAllThunks(void) { while (foreignThunks) { freeThunkAux(foreignThunks); } } /* This frees the object allocated by mkThunk. * [A useful debugging mode would not deallocate the thunk but would * overwrite the thunk with code which prints an error message.] */ static void freeHaskellFunctionPtr(void* t) { struct thunk_data* thunk = (struct thunk_data*)((char*)t - (char*)&((struct thunk_data*)0)->code); freeThunkAux(thunk); } primFun(primFreeHFunPtr) { /* :: FunPtr a -> IO () */ Pointer x; PtrArg(x,1+IOArity); freeHaskellFunctionPtr(x); IOReturn(nameUnit); } HugsAPI4* hugsAPI4() { /* build virtual function table */ static HugsAPI4 api; static Bool initialised = FALSE; if (!initialised) { /* evaluate next argument */ api.getInt = getInt; api.getWord = getWord; api.getAddr = getAddr; api.getFloat = getFloat; api.getDouble = getDouble; api.getChar = getChar4; api.getForeign = getForeign; api.getStablePtr = getStablePtr; /* push part of result */ api.putInt = putInt; api.putWord = putWord; api.putAddr = putAddr; api.putFloat = putFloat; api.putDouble = putDouble; api.putChar = putChar4; api.putForeign = putForeign; api.putStablePtr = putStablePtr; /* return n values in IO monad or Id monad */ api.returnIO = returnIO; api.returnId = returnId; api.runIO = runIO; /* free a stable pointer */ api.freeStablePtr = freeStablePtr; /* register the prim table */ api.registerPrims = registerPrims; /* garbage collect */ api.garbageCollect = garbageCollect; /* API3 additions follow */ api.lookupName = lookupName; api.ap = apMany; api.getUnit = getUnit; api.mkThunk = mkThunk; api.freeThunk = freeHaskellFunctionPtr; api.getBool = getBool; api.putBool = putBool; /* API4 additions follow */ api.getInt8 = getInt8; api.getInt16 = getInt16; api.getInt32 = getInt32; api.getInt64 = getInt64; api.getWord8 = getWord8; api.getWord16 = getWord16; api.getWord32 = getWord32; api.getWord64 = getWord64; api.getPtr = getPtr; api.getFunPtr = getFunPtr; api.getForeignPtr = getForeignPtr; api.putInt8 = putInt8; api.putInt16 = putInt16; api.putInt32 = putInt32; api.putInt64 = putInt64; api.putWord8 = putWord8; api.putWord16 = putWord16; api.putWord32 = putWord32; api.putWord64 = putWord64; api.putPtr = putPtr; api.putFunPtr = putFunPtr; api.putForeignPtr = putForeignPtr; api.makeStablePtr4 = getStablePtr; api.derefStablePtr4= putStablePtr; api.putStablePtr4 = putStablePtr4; api.getStablePtr4 = getStablePtr4; api.freeStablePtr4 = freeStablePtr4; api.runId = runId; } return &api; } HugsAPI5* hugsAPI5() { /* build virtual function table */ static HugsAPI5 api; static Bool initialised = FALSE; if (!initialised) { api.getBool = getBool; api.getInt = getInt; api.getWord = getWord; api.getAddr = getAddr; api.getFloat = getFloat; api.getDouble = getDouble; api.getChar = getChar; api.getForeign = getForeign; api.getInt8 = getInt8; api.getInt16 = getInt16; api.getInt32 = getInt32; api.getInt64 = getInt64; api.getWord8 = getWord8; api.getWord16 = getWord16; api.getWord32 = getWord32; api.getWord64 = getWord64; api.getPtr = getPtr; api.getFunPtr = getFunPtr; api.getForeignPtr = getForeignPtr; api.getStablePtr4 = getStablePtr4; api.putBool = putBool; api.putInt = putInt; api.putWord = putWord; api.putAddr = putAddr; api.putFloat = putFloat; api.putDouble = putDouble; api.putChar = putChar; api.putForeign = putForeign; api.putInt8 = putInt8; api.putInt16 = putInt16; api.putInt32 = putInt32; api.putInt64 = putInt64; api.putWord8 = putWord8; api.putWord16 = putWord16; api.putWord32 = putWord32; api.putWord64 = putWord64; api.putPtr = putPtr; api.putFunPtr = putFunPtr; api.putForeignPtr = putForeignPtr; api.putStablePtr4 = putStablePtr4; api.returnIO = returnIO; api.runIO = runIO; api.returnId = returnId; api.runId = runId; api.registerPrims = registerPrims; api.lookupName = lookupName; api.ap = apMany; api.getUnit = getUnit; api.mkThunk = mkThunk; api.freeThunk = freeHaskellFunctionPtr; api.makeStablePtr4 = getStablePtr; api.derefStablePtr4= putStablePtr; api.freeStablePtr4 = freeStablePtr4; } return &api; } void hs_perform_gc(void) { garbageCollect(); } void hs_free_stable_ptr(HsStablePtr sp) { freeStablePtr4(sp); } void hs_free_fun_ptr(HsFunPtr fp) { freeHaskellFunctionPtr((void *)fp); } /* -------------------------------------------------------------------------- * Built-in control: * ------------------------------------------------------------------------*/ /* Dummy entry */ static Void builtinControl Args((Int)); static Void builtinControl(what) Int what; { } static struct primInfo builtinPrims = { builtinControl, builtinPrimTable, 0 }; Void builtIn(what) Int what; { switch (what) { case INSTALL : initAdjustor(); registerPrims(&builtinPrims); registerPrims(&printerPrims); #if HASKELL_ARRAYS registerPrims(&arrayPrims); #endif #if BIGNUMS registerPrims(&bignumPrims); #endif #if IO_MONAD registerPrims(&iomonadPrims); #endif #if TIME_MODULE registerPrims(&timePrims); #endif #if DIRECTORY_MODULE registerPrims(&dirPrims); #endif #if INTERNAL_PRIMS registerPrims(&internalPrims); #endif setCurrModule(modulePrelude); #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePrelude,NIL) pFun(nameFatbar, "_FATBAR", "fatbar"); pFun(nameFail, "_FAIL", "fail"); pFun(nameIf, "_IF", "if"); pFun(nameSel, "_SEL", "sel"); pFun(nameConCmp, "_concmp", "conCmp"); pFun(nameEnRange, "_range", "enRange"); pFun(nameEnIndex, "_index", "enIndex"); pFun(nameEnInRng, "_inRange", "enInRng"); pFun(nameEnToEn, "_toEnum", "enToEn"); pFun(nameEnFrEn, "_frEnum", "enFrEn"); pFun(nameEnFrom, "_from", "enFrom"); pFun(nameEnFrTo, "_fromTo", "enFrTo"); pFun(nameEnFrTh, "_fromThen","enFrTh"); pFun(namePrimThrow, "_throw", "primThrowException"); pFun(nameBlackHole, "_Gc Black Hole", "gcBhole"); pFun(nameInd, "_indirect", "dictIndirect"); name(nameInd).number = DFUNNAME; #if TREX pFun(nameRecExt, "_recExt", "recExt"); pFun(nameRecBrk, "_recBrk", "recBrk"); pFun(nameRecSel, "_recSel", "recSel"); pFun(nameRecShw, "_recShw", "recShw"); pFun(nameRecEq, "_recEq", "recEq"); pFun(nameAddEv, "_addEv", "primPlusInt"); name(nameAddEv).number = DFUNNAME; #endif #undef pFun #define predef(nm,str) nm=newName(findText(str),NIL); name(nm).defn=PREDEFINED predef(nameNegate, "negate"); predef(nameFlip, "flip"); predef(nameFrom, "enumFrom"); predef(nameFromThen, "enumFromThen"); predef(nameFromTo, "enumFromTo"); predef(nameFromThenTo, "enumFromThenTo"); predef(nameFst, "fst"); predef(nameSnd, "snd"); predef(nameAnd, "&&"); predef(nameOr, "||"); predef(nameId, "id"); predef(nameOtherwise, "otherwise"); predef(nameComp, "."); predef(nameApp, "++"); predef(nameShowField, "showField"); predef(nameShowParen, "showParen"); predef(nameReadField, "readField"); predef(nameReadParen, "readParen"); predef(nameLex, "lex"); predef(nameRangeSize, "rangeSize"); predef(nameCompAux, "primCompAux"); predef(namePmInt, "primPmInt"); predef(namePmInteger, "primPmInteger"); predef(namePmFlt, "primPmFlt"); predef(nameReturnIO, "primretIO"); #if NPLUSK predef(namePmNpk, "primPmNpk"); predef(namePmSub, "primPmSub"); #endif predef(nameRationalToDouble, "rationalToDouble"); predef(nameRationalToFloat, "rationalToFloat"); #if SHORT_CIRCUIT_COERCIONS predef(nameFloatToRational, "floatToRational"); predef(nameDoubleToRational, "doubleToRational"); predef(nameDoubleToRatio, "doubleToRatio"); predef(nameIntToRatio, "intToRatio"); predef(nameIntToFloat, "primIntToFloat"); predef(nameIntToDouble, "primIntToDouble"); predef(nameDoubleToFloat, "primDoubleToFloat"); predef(nameFloatToDouble, "primFloatToDouble"); #endif #undef predef break; case RESET : freeAllThunks(); break; } } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/builtin.h0000644006511100651110000005640310127034400015370 0ustar rossross/* -------------------------------------------------------------------------- * Primitive functions, input output etc... * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: builtin.h,v $ * $Revision: 1.7 $ * $Date: 2004/09/30 16:49:04 $ * ------------------------------------------------------------------------*/ #ifndef __BUILTIN_H__ #define __BUILTIN_H__ extern String evalName Args((Cell)); extern Cell mkIOError Args((Cell *,Name,String,String,Cell *)); /* -------------------------------------------------------------------------- * Macros used to define primitives: * ------------------------------------------------------------------------*/ #define PROTO_PRIM(name) static Void name Args((StackPtr)) #define EXT_PROTO_PRIM(name) extern Void name Args((StackPtr)) #define primFun(name) static Void name(root) StackPtr root; #define extPrimFun(name) Void name(StackPtr root) #define primCAF(name) static Void name(root) StackPtr root HUGS_unused; #define primArg(n) stack(root+n) /* IMPORTANT: the second element of an update must be written first. * this is to deal with the case where an INDIRECT tag is written into * a Cell before the second value has been set. If a garbage collection * occurs before the second element was set then the INDIRECTion will be * (wrongly) elided and result in chaos. I know. It happened to me. */ #define update(l,r) ((snd(stack(root))=r),(fst(stack(root))=l)) #define updateRoot(c) update(INDIRECT,c) #define updapRoot(l,r) update(l,r) #define blackHoleRoot() update(nameBlackHole,nameBlackHole) #if CHECK_TAGS # define checkChar() if (!isChar(whnfHead)) internal("Char expected") # define checkInt() if (!isInt(whnfHead)) internal("Int expected") # define checkWord() if (!isInt(whnfHead)) internal("Word expected") # define checkPtr() if (!isPtr(whnfHead)) internal("Ptr expected") # define checkFloat() if (!isFloat(whnfHead)) internal("Float expected") # define checkDouble() if (!isDouble(whnfHead)) internal("Double expected") # define checkBool() if (whnfHead != nameTrue && whnfHead != nameFalse) internal("Bool expected"); # define checkCon() if (!isName(whnfHead) || !isCfun(whnfHead)) internal("Constructor expected"); #else # define checkChar() doNothing() # define checkInt() doNothing() # define checkWord() doNothing() # define checkPtr() doNothing() # define checkFloat() doNothing() # define checkDouble() doNothing() # define checkBool() doNothing() # define checkCon() doNothing() #endif /* e is a constant expression */ #define CAFPtr(nm,e) \ primCAF(nm) { \ Pointer r = e; \ push(mkPtr(r)); \ } #define PtrArg(nm,offset) \ eval(primArg(offset)); \ checkPtr(); \ nm = ptrOf(whnfHead) /* nm should be a variable in which result is stored. If you use an expression, reevaluation might occur */ #define PtrResult(nm) \ updateRoot(mkPtr(nm)) /* e is an expression with free variables x and y */ #define PtrInt2Ptr(nm,e) \ primFun(nm) { \ Pointer x, r; \ Int y; \ PtrArg(x,2); \ IntArg(y,1); \ r = e; \ PtrResult(r); \ } /* e is an expression with free variables x */ #define Ptr2Int(nm,e) \ primFun(nm) { \ Pointer x; \ Int r; \ PtrArg(x,1); \ r = e; \ IntResult(r); \ } /* e is a constant expression */ #define CAFInt(nm,e) \ primCAF(nm) { \ Int r = e; \ push(mkInt(r)); \ } #define IntArg(nm,offset) \ eval(primArg(offset)); \ checkInt(); \ nm = whnfInt /* nm should be a variable in which result is stored. If you use an expression, reevaluation might occur */ #define IntResult(nm) \ updateRoot(mkInt(nm)) /* nm should be a variable in which result is stored. If you use an expression, reevaluation might occur */ #define IntIntResult(e1,e2) \ do { \ Int _arg1 = e1; \ Int _arg2 = e2; \ push(mkInt(_arg1)); \ topfun(mkTuple(2)); \ updapRoot(top(),mkInt(_arg2)); \ } while (0) /* e is a constant expression */ #define CAFWord(nm,e) \ primCAF(nm) { \ Unsigned r = e; \ push(mkInt(r)); \ } #define WordArg(nm,offset) \ eval(primArg(offset)); \ checkWord(); \ nm = (Unsigned) whnfInt /* nm should be a variable in which result is stored. If you use an expression, reevaluation might occur */ #define WordResult(nm) \ updateRoot(mkInt(nm)) /* nm should be a variable in which result is stored. If you use an expression, reevaluation might occur */ #define WordWordResult(e1,e2) \ do { \ Unsigned _arg1 = e1; \ Unsigned _arg2 = e2; \ push(mkInt(_arg1)); \ topfun(mkTuple(2)); \ updapRoot(top(),mkInt(_arg2)); \ } while (0) #define FloatArg(nm,offset) \ eval(primArg(offset)); \ checkFloat(); \ nm = whnfFloat /* nm should be a variable in which result is stored. If you use an expression, reevaluation might occur */ #define FloatResult(nm) \ updateRoot(mkFloat(nm)) #define DoubleArg(nm,offset) \ eval(primArg(offset)); \ checkDouble(); \ nm = whnfDouble /* nm should be a variable in which result is stored. If you use an expression, reevaluation might occur */ #define DoubleResult(nm) \ updateRoot(mkDouble(nm)) #define BoolArg(nm, offset) \ eval(primArg(offset)); \ checkBool(); \ nm = (whnfHead == nameTrue) /* e can be an expression if you want */ #define BoolResult(e) \ updateRoot((e) ? nameTrue : nameFalse) #define ConArg(nm,offset) \ eval(primArg(offset)); \ checkCon(); \ nm = cfunOf(whnfHead) \ /* e is an expression with free variables x and y */ #define IntInt2Int(nm,e) \ primFun(nm) { \ Int x, y, r; \ IntArg(x,2); \ IntArg(y,1); \ r = e; \ IntResult(r); \ } /* e is a predicate with free variables x and y */ #define PtrPtr2Bool(nm,e) \ primFun(nm) { \ Pointer x, y; \ PtrArg(x,2); \ PtrArg(y,1); \ BoolResult(e); \ } /* e is an expression with free variables x and y */ #define PtrPtr2Int(nm,e) \ primFun(nm) { \ Pointer x, y; \ Int r; \ PtrArg(x,2); \ PtrArg(y,1); \ r = e; \ IntResult(r); \ } /* e is an expression with free variables x and y */ /* y must be non-zero */ #define IntInt2IntNonZero(nm,e) \ primFun(nm) { \ Int x, y, r; \ IntArg(x,2); \ IntArg(y,1); \ if (y==0) \ throwException(ap(nameArithException, nameDivideByZero));\ r = e; \ IntResult(r); \ } /* e is an expression with free variable x */ #define Int2Int(nm,e) \ primFun(nm) { \ Int x, r; \ IntArg(x,1); \ r = e; \ IntResult(r); \ } /* e is a predicate with free variables x and y */ #define IntInt2Bool(nm,e) \ primFun(nm) { \ Int x, y; \ IntArg(x,2); \ IntArg(y,1); \ BoolResult(e); \ } /* e is a predicate with free variable x */ #define Int2Bool(nm,e) \ primFun(nm) { \ Int x; \ IntArg(x,1); \ BoolResult(e); \ } /* e is an expression with free variables x and y */ #define WordWord2Word(nm,e) \ primFun(nm) { \ Unsigned x, y, r; \ WordArg(x,2); \ WordArg(y,1); \ r = e; \ WordResult(r); \ } /* e is an expression with free variables x and y */ /* y must be non-zero */ #define WordWord2WordNonZero(nm,e) \ primFun(nm) { \ Unsigned x, y, r; \ WordArg(x,2); \ WordArg(y,1); \ if (y==0) \ throwException(ap(nameArithException, nameDivideByZero));\ r = e; \ WordResult(r); \ } /* e is an expression with free variable x */ #define Word2Word(nm,e) \ primFun(nm) { \ Unsigned x, r; \ WordArg(x,1); \ r = e; \ WordResult(r); \ } /* e is an expression with free variable x */ #define Word2Word(nm,e) \ primFun(nm) { \ Unsigned x, r; \ WordArg(x,1); \ r = e; \ WordResult(r); \ } /* e is a predicate with free variables x and y */ #define WordWord2Bool(nm,e) \ primFun(nm) { \ Unsigned x, y; \ WordArg(x,2); \ WordArg(y,1); \ BoolResult(e); \ } /* e is a predicate with free variables x and y */ #define WordInt2Bool(nm,e) \ primFun(nm) { \ Unsigned x; \ Int y; \ WordArg(x,2); \ IntArg(y,1); \ BoolResult(e); \ } /* e is a predicate with free variables x and y */ #define WordInt2Word(nm,e) \ primFun(nm) { \ Unsigned x; \ Int y; \ Unsigned r; \ WordArg(x,2); \ IntArg(y,1); \ r = e; \ WordResult(r); \ } /* e is a predicate with free variable x */ #define Int2Word(nm,e) \ primFun(nm) { \ Int x; \ Unsigned r; \ IntArg(x,1); \ r = e; \ WordResult(r); \ } /* e is a predicate with free variable x */ #define Word2Bool(nm,e) \ primFun(nm) { \ Unsigned x; \ WordArg(x,1); \ BoolResult(e); \ } /* e is an expression with free variables x and y */ #define FloatFloat2Float(nm,e) \ primFun(nm) { \ Float x, y, r; \ FloatArg(x,2); \ FloatArg(y,1); \ r = e; \ FloatResult(r); \ } /* e is an expression with free variables x and y */ /* y must be non-zero */ #define FloatFloat2FloatNonZero(nm,e) \ primFun(nm) { \ Float x, y, r; \ FloatArg(x,2); \ FloatArg(y,1); \ if (y==0) \ throwException(ap(nameArithException, nameDivideByZero));\ r = e; \ FloatResult(r); \ } /* e is an expression with free variable x */ #define Float2Float(nm,e) \ primFun(nm) { \ Float x, r; \ FloatArg(x,1); \ r = (Float)e; \ FloatResult(r); \ } /* e is an expression with free variable x */ #define Float2Int(nm,e) \ primFun(nm) { \ Float x; \ Int r; \ FloatArg(x,1); \ r = e; \ IntResult(r); \ } /* e is an expression with free variable x */ #define Float2Bool(nm,e) \ primFun(nm) { \ Float x; \ Bool r; \ FloatArg(x,1); \ r = e; \ BoolResult(r); \ } /* e is an expression with free variable x */ /* pre is a precondition (fv x) to test */ #define Float2FloatPre(nm,e,pre) \ primFun(nm) { \ Float x, r; \ FloatArg(x,1); \ if (!(pre)) \ throwException(ap(nameErrorCall, mkStr(findText("argument out of range"))));\ r = (Float)e; \ FloatResult(r); \ } /* e is an expression with free variables x and y */ #define DoubleDouble2Double(nm,e) \ primFun(nm) { \ Double x, y, r; \ DoubleArg(x,2); \ DoubleArg(y,1); \ r = e; \ DoubleResult(r); \ } /* e is an expression with free variables x and y */ /* y must be non-zero */ #define DoubleDouble2DoubleNonZero(nm,e) \ primFun(nm) { \ Double x, y, r; \ DoubleArg(x,2); \ DoubleArg(y,1); \ if (y==0) \ throwException(ap(nameArithException, nameDivideByZero));\ r = e; \ DoubleResult(r); \ } /* e is an expression with free variable x */ #define Double2Double(nm,e) \ primFun(nm) { \ Double x, r; \ DoubleArg(x,1); \ r = (Double)e; \ DoubleResult(r); \ } /* e is an expression with free variable x */ #define Double2Int(nm,e) \ primFun(nm) { \ Double x; \ Int r; \ DoubleArg(x,1); \ r = e; \ IntResult(r); \ } /* e is an expression with free variable x */ #define Double2Bool(nm,e) \ primFun(nm) { \ Double x; \ Bool r; \ DoubleArg(x,1); \ r = e; \ BoolResult(r); \ } /* e is an expression with free variable x */ /* pre is a precondition (fv x) to test */ #define Double2DoublePre(nm,e,pre) \ primFun(nm) { \ Double x, r; \ DoubleArg(x,1); \ if (!(pre)) \ throwException(ap(nameErrorCall, mkStr(findText("argument out of range"))));\ r = (Double)e; \ DoubleResult(r); \ } /* e is a constant expression */ #define CAFChar(nm,e) \ primCAF(nm) { \ Char r = e; \ push(mkChar(r)); \ } #define CharArg(nm,offset) \ eval(primArg(offset)); \ checkChar(); \ nm = charOf(whnfHead) /* nm should be a variable in which result is stored. If you use an expression, reevaluation might occur */ #define CharResult(nm) \ updateRoot(mkChar(nm)) /* e is a predicate with free variables x and y */ #define CharChar2Bool(nm,e) \ primFun(nm) { \ Char x, y; \ CharArg(x,2); \ CharArg(y,1); \ BoolResult(e); \ } /* e is a predicate with free variable x */ #define Char2Bool(nm,e) \ primFun(nm) { \ Char x; \ CharArg(x,1); \ BoolResult(e); \ } /* e is an expression with free variable x */ #define Char2Char(nm,e) \ primFun(nm) { \ Char x; \ CharArg(x,1); \ CharResult(e); \ } /* e is an integer expression with free variable x */ #define Char2Int(nm,e) \ primFun(nm) { \ Char x; \ CharArg(x,1); \ IntResult(e); \ } /* e is a predicate with free variables x and y */ #define FloatFloat2Bool(nm,e) \ primFun(nm) { \ Float x, y; \ FloatArg(x,2); \ FloatArg(y,1); \ BoolResult(e); \ } /* e is a predicate with free variables x and y */ #define DoubleDouble2Bool(nm,e) \ primFun(nm) { \ Double x, y; \ DoubleArg(x,2); \ DoubleArg(y,1); \ BoolResult(e); \ } /* -------------------------------------------------------------------------- * IO monad macros: * * Note: the IOReturn and IOFail macros do not use the standard "do while" * trick to create a single statement because some C compilers (eg sun) * report warning messages "end-of-loop code not reached". * This may lead to syntax errors if used where a statement is required - such * errors can be fixed by adding braces round the call. Blech! * ------------------------------------------------------------------------*/ #if IO_MONAD #define IOArg(n) primArg((n)+IOArity) #define IOReturn(r) { updapRoot(primArg(1),r); return; } #define IOFail(r) throwException(ap(nameIOException,r)) #endif #endif /* __BUILTIN_H__ */ hugs98-plus-Sep2006/src/char.c0000644006511100651110000006042310270450666014646 0ustar rossross/* -------------------------------------------------------------------------- * Operations on Chars. * * Extended to Unicode by Dimitry Golubovsky . * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2005, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "char.h" #include /* -------------------------------------------------------------------------- * Unicode character properties (cf http://www.unicode.org/ucd/) * ------------------------------------------------------------------------*/ /* Unicode general categories, listed in the same order as in the Unicode * standard -- this must be the same order as in Data.Char. */ enum { GENCAT_Lu, /* Letter, Uppercase */ GENCAT_Ll, /* Letter, Lowercase */ GENCAT_Lt, /* Letter, Titlecase */ GENCAT_Lm, /* Letter, Modifier */ GENCAT_Lo, /* Letter, Other */ GENCAT_Mn, /* Mark, Non-Spacing */ GENCAT_Mc, /* Mark, Spacing Combining */ GENCAT_Me, /* Mark, Enclosing */ GENCAT_Nd, /* Number, Decimal */ GENCAT_Nl, /* Number, Letter */ GENCAT_No, /* Number, Other */ GENCAT_Pc, /* Punctuation, Connector */ GENCAT_Pd, /* Punctuation, Dash */ GENCAT_Ps, /* Punctuation, Open */ GENCAT_Pe, /* Punctuation, Close */ GENCAT_Pi, /* Punctuation, Initial quote */ GENCAT_Pf, /* Punctuation, Final quote */ GENCAT_Po, /* Punctuation, Other */ GENCAT_Sm, /* Symbol, Math */ GENCAT_Sc, /* Symbol, Currency */ GENCAT_Sk, /* Symbol, Modifier */ GENCAT_So, /* Symbol, Other */ GENCAT_Zs, /* Separator, Space */ GENCAT_Zl, /* Separator, Line */ GENCAT_Zp, /* Separator, Paragraph */ GENCAT_Cc, /* Other, Control */ GENCAT_Cf, /* Other, Format */ GENCAT_Cs, /* Other, Surrogate */ GENCAT_Co, /* Other, Private Use */ GENCAT_Cn /* Other, Not Assigned */ }; #if UNICODE_CHARS /* properties of a Unicode character */ struct CharProperties { int category; /* Unicode general category */ int upper_offset; /* offset of the result of toUpper */ int lower_offset; /* offset of the result of toUpper */ int title_offset; /* offset of the result of toUpper */ }; /* A contiguous block of characters with the same properties */ struct CharBlock { Char blk_start; /* first character in the block */ Char blk_length; /* number of characters in the block */ const struct CharProperties *blk_properties; /* properties shared by these characters, */ /* and possibly by other blocks too. */ }; /* property table automatically generated from UnicodeData file */ #include "unitable.c" /* properties for an character not covered by the table */ static const struct CharProperties null_properties = { GENCAT_Cn, 0, 0, 0 }; #endif /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Void local initConsCharTable Args((Void)); static Void local markConsCharTable Args((Void)); #if UNICODE_CHARS static Void local freeConsCharTable Args((Void)); static const struct CharProperties * local get_properties Args((Char)); #endif #if CHAR_ENCODING_UTF8 static Int local utfseqlen Args((Int)); static Int local utfcodelen Args((Char)); #endif /* -------------------------------------------------------------------------- * Character set handling: * * Hugs follows Haskell 1.3 in assuming that input uses the ISO-8859-1 * (Latin-1) character set. The following code provides methods for * classifying input characters according to the lexical structure * specified by the report. Hugs should still accept older programs * because ASCII is just a subset of the Latin-1 character set. * ------------------------------------------------------------------------*/ Bool charTabBuilt; unsigned char charTable[NUM_LAT1_CHARS]; Void initCharTab() { /* Initialize char decode table */ #define setRange(x,f,t) {Int i=f; while (i<=t) charTable[i++] |=x;} #define setChar(x,c) charTable[c] |= (x) #define setChars(x,s) {char *p=s; while (*p) charTable[(Int)*p++]|=x;} #define setCopy(x,c) {Int i; \ for (i=0; i?@\\^|-~"); setChar (IDAFTER, '\''); /* Characters in identifier */ setCopy (IDAFTER, (DIGIT|SMALL|LARGE)); setChar (SPACE, ' '); /* ASCII space character */ setChar (SPACE, 160); /* Latin-1 non breaking space */ setRange(SPACE, 9,13); /* special whitespace: \t\n\v\f\r */ setRange(PRINT, 32,126); setRange(PRINT, 160,172); setRange(PRINT, 174,255); /* (omits soft hyphen) */ #undef setRange #undef setChar #undef setChars #undef setCopy charTabBuilt = TRUE; } /* -------------------------------------------------------------------------- * Char primitives. * ------------------------------------------------------------------------*/ #if UNICODE_CHARS #define UPPER_MASK ((1<category==GENCAT_Ll; } Bool isUpper(Char c) { return isLatin1(c) ? isUpperLat1(c) : ((1<category)&UPPER_MASK)!=0; } Bool isAlpha(Char c) { return isLatin1(c) ? isAlphaLat1(c) : (get_properties(c)->category<=GENCAT_Lo); } Bool isAlphaNum(Char c) { return isLatin1(c) ? isAlphaNumLat1(c) : get_properties(c)->category<=GENCAT_No; } Bool isPrint(Char c) { return isLatin1(c) ? isPrintLat1(c) : get_properties(c)->category<=GENCAT_Zs; } Char toUpper(Char c) { return c + get_properties(c)->upper_offset; } Char toLower(Char c) { return c + get_properties(c)->lower_offset; } Char toTitle(Char c) { return c + get_properties(c)->title_offset; } Int uni_gencat(Char c) { return get_properties(c)->category; } /* binary search of the properties table */ static const struct CharProperties * local get_properties(Char c) { Int lo, hi, mid; lo = 0; hi = NUM_BLOCKS-1; while (lo!=hi) { /* i <= lo => char_block[i].blk_start <= c */ /* i > hi => char_block[i].blk_start > c */ mid = (lo+hi+1)/2; /* lo < mid <= hi */ if (char_block[mid].blk_start<=c) lo = mid; else hi = mid-1; } /* i <= lo => char_block[i].blk_start <= c */ /* i > lo => char_block[i].blk_start > c */ return c' */ /* '?' */ GENCAT_Sm, GENCAT_Sm, GENCAT_Sm, GENCAT_Po, /* '@' */ /* 'A' */ /* 'B' */ /* 'C' */ GENCAT_Po, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* 'D' */ /* 'E' */ /* 'F' */ /* 'G' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* 'H' */ /* 'I' */ /* 'J' */ /* 'K' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* 'L' */ /* 'M' */ /* 'N' */ /* 'O' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* 'P' */ /* 'Q' */ /* 'R' */ /* 'S' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* 'T' */ /* 'U' */ /* 'V' */ /* 'W' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* 'X' */ /* 'Y' */ /* 'Z' */ /* '[' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Ps, /* '\\' */ /* ']' */ /* '^' */ /* '_' */ GENCAT_Po, GENCAT_Pe, GENCAT_Sk, GENCAT_Pc, /* '`' */ /* 'a' */ /* 'b' */ /* 'c' */ GENCAT_Sk, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* 'd' */ /* 'e' */ /* 'f' */ /* 'g' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* 'h' */ /* 'i' */ /* 'j' */ /* 'k' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* 'l' */ /* 'm' */ /* 'n' */ /* 'o' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* 'p' */ /* 'q' */ /* 'r' */ /* 's' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* 't' */ /* 'u' */ /* 'v' */ /* 'w' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* 'x' */ /* 'y' */ /* 'z' */ /* '{' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ps, /* '|' */ /* '}' */ /* '~' */ /* '\DEL' */ GENCAT_Sm, GENCAT_Pe, GENCAT_Sm, GENCAT_Cc, /* '\128' */ /* '\129' */ /* '\130' */ /* '\131' */ GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, /* '\132' */ /* '\133' */ /* '\134' */ /* '\135' */ GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, /* '\136' */ /* '\137' */ /* '\138' */ /* '\139' */ GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, /* '\140' */ /* '\141' */ /* '\142' */ /* '\143' */ GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, /* '\144' */ /* '\145' */ /* '\146' */ /* '\147' */ GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, /* '\148' */ /* '\149' */ /* '\150' */ /* '\151' */ GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, /* '\152' */ /* '\153' */ /* '\154' */ /* '\155' */ GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, /* '\156' */ /* '\157' */ /* '\158' */ /* '\159' */ GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, GENCAT_Cc, /* '\160' */ /* '\161' */ /* '\162' */ /* '\163' */ GENCAT_Zs, GENCAT_Po, GENCAT_Sc, GENCAT_Sc, /* '\164' */ /* '\165' */ /* '\166' */ /* '\167' */ GENCAT_Sc, GENCAT_Sc, GENCAT_So, GENCAT_So, /* '\168' */ /* '\169' */ /* '\170' */ /* '\171' */ GENCAT_Sk, GENCAT_So, GENCAT_Ll, GENCAT_Pi, /* '\172' */ /* '\173' */ /* '\174' */ /* '\175' */ GENCAT_Sm, GENCAT_Cf, GENCAT_So, GENCAT_Sk, /* '\176' */ /* '\177' */ /* '\178' */ /* '\179' */ GENCAT_So, GENCAT_Sm, GENCAT_No, GENCAT_No, /* '\180' */ /* '\181' */ /* '\182' */ /* '\183' */ GENCAT_Sk, GENCAT_Ll, GENCAT_So, GENCAT_Po, /* '\184' */ /* '\185' */ /* '\186' */ /* '\187' */ GENCAT_Sk, GENCAT_No, GENCAT_Ll, GENCAT_Pf, /* '\188' */ /* '\189' */ /* '\190' */ /* '\191' */ GENCAT_No, GENCAT_No, GENCAT_No, GENCAT_Po, /* '\192' */ /* '\193' */ /* '\194' */ /* '\195' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* '\196' */ /* '\197' */ /* '\198' */ /* '\199' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* '\200' */ /* '\201' */ /* '\202' */ /* '\203' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* '\204' */ /* '\205' */ /* '\206' */ /* '\207' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* '\208' */ /* '\209' */ /* '\210' */ /* '\211' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* '\212' */ /* '\213' */ /* '\214' */ /* '\215' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Sm, /* '\216' */ /* '\217' */ /* '\218' */ /* '\219' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, /* '\220' */ /* '\221' */ /* '\222' */ /* '\223' */ GENCAT_Lu, GENCAT_Lu, GENCAT_Lu, GENCAT_Ll, /* '\224' */ /* '\225' */ /* '\226' */ /* '\227' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* '\228' */ /* '\229' */ /* '\230' */ /* '\231' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* '\232' */ /* '\233' */ /* '\234' */ /* '\235' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* '\236' */ /* '\237' */ /* '\238' */ /* '\239' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* '\240' */ /* '\241' */ /* '\242' */ /* '\243' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* '\244' */ /* '\245' */ /* '\246' */ /* '\247' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Sm, /* '\248' */ /* '\249' */ /* '\250' */ /* '\251' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, /* '\252' */ /* '\253' */ /* '\254' */ /* '\255' */ GENCAT_Ll, GENCAT_Ll, GENCAT_Ll, GENCAT_Ll }; Int uni_gencat(Char c) { return char_category[c]; } #endif /* -------------------------------------------------------------------------- * Multibyte character incodings. * ------------------------------------------------------------------------*/ #if CHAR_ENCODING int fputc_mb(Char c, FILE *f) { char buf[MAX_CHAR_ENCODING]; String s = buf; addc_mb(c, &s); return fwrite(buf, s-buf, 1, f)==1 ? c : EOF; } #endif /* CHAR_ENCODING */ #if CHAR_ENCODING_LOCALE /* Using the encoding specified by the current locale (LC_CTYPE). * Note that ISO C does not permit both byte-oriented and wchar I/O * on the same stream, so we use byte-oriented I/O, and do the conversion * ourselves using mbrtowc/wcrtomb. */ Bool charIsRepresentable(Char c) { char buf[MAX_CHAR_ENCODING]; size_t n; wchar_t wc; mbstate_t st; if (c == '\0') return TRUE; memset(&st, 0, sizeof(st)); n = wcrtomb(buf, c, &st); if (n == (size_t)(-1)) errno = 0; else { memset(&st, 0, sizeof(st)); if (mbrtowc(&wc, buf, n, &st) == n) return wc==c; } return FALSE; } /* Read a Char encoded as a multi-byte sequence. */ int fgetc_mb(FILE *f) { char buf[MAX_CHAR_ENCODING]; Int n = 0; size_t size; wchar_t wc; mbstate_t st; for (;;) { int c = fgetc(f); if (c == EOF) return n == 0 ? EOF : BAD_CHAR; buf[n++] = c; memset(&st, 0, sizeof(st)); size = mbrtowc(&wc, buf, n, &st); switch (size) { case (size_t)(-1): /* decoding error */ errno = 0; return BAD_CHAR; case (size_t)(-2): /* incomplete sequence */ if (n == MAX_CHAR_ENCODING) return BAD_CHAR; break; case 0: /* null character */ return 0; default: /* successful decoding */ if (size < n) /* If the encoding uses lookahead, we have to read extra * bytes to detect the end of an encoding. If it's * just one byte (size == n-1) we can push it back onto * the input. This won't work for encodings that need * more than 1 byte of lookahead, but I don't think * there are any. */ ungetc(c, f); return wc; } } } /* Add a Char to a multi-byte encoded string, moving the pointer. */ Void addc_mb(Char c, String *sp) { size_t size; mbstate_t st; memset(&st, 0, sizeof(st)); size = wcrtomb(*sp, c, &st); if (size == (size_t)-1) { /* encoding error */ *(*sp)++ = '?'; errno = 0; } else *sp += size; } /* Get a Char from a multi-byte encoded string, moving the pointer. */ Char extc_mb(String *sp) { wchar_t c = '\0'; size_t size; mbstate_t st; memset(&st, 0, sizeof(st)); size = mbrtowc(&c, *sp, MAX_CHAR_ENCODING, &st); switch (size) { case (size_t)(-1): /* decoding error */ errno = 0; /* fall through to ... */ case (size_t)(-2): /* incomplete sequence */ c = BAD_CHAR; (*sp)++; break; case 0: /* string starts with \0 */ (*sp)++; break; default: /* successful decoding */ *sp += size; } return c; } #elif CHAR_ENCODING_UTF8 /* * The UTF-FSS (aka UTF-8) encoding of UCS, as described in the following * quote from Ken Thompson's utf-fss.c: * * Bits Hex Min Hex Max Byte Sequence in Binary * 7 00000000 0000007f 0vvvvvvv * 11 00000080 000007FF 110vvvvv 10vvvvvv * 16 00000800 0000FFFF 1110vvvv 10vvvvvv 10vvvvvv * 21 00010000 001FFFFF 11110vvv 10vvvvvv 10vvvvvv 10vvvvvv * 26 00200000 03FFFFFF 111110vv 10vvvvvv 10vvvvvv 10vvvvvv 10vvvvvv * 31 04000000 7FFFFFFF 1111110v 10vvvvvv 10vvvvvv 10vvvvvv 10vvvvvv 10vvvvvv * * The UCS value is just the concatenation of the v bits in the multibyte * encoding. When there are multiple ways to encode a value, for example * UCS 0, only the shortest encoding is legal. */ #define UTFhead(b) (((b)&0xC0)==0xC0) /* head of a multibyte sequence */ #define UTFtail(b) (((b)&0xC0)==0x80) /* tail of a multibyte sequence */ #define UTFmask(n) ((0xFF00>>(n))&0xFF) /* length bits of a head byte */ /* Note also that since ASCII, head and tail chars are disjoint in UTF-8, * it is possible to resynchronize a stream after a coding error, but we * don't do that. */ int fgetc_mb(FILE *f) { unsigned char buf[MAX_CHAR_ENCODING]; Int b; Char c; Int size, i; if ((b = fgetc(f))==EOF) return EOF; if (b<0x80) /* ASCII character */ return b; if (!UTFhead(b)) return BAD_CHAR; size = utfseqlen(b); c = b&~UTFmask(size); for (i=1 ; i=0; i--) { (*sp)[i] = (cn%64)|((i==0)?UTFmask(noct):0x80); cn /= 64; } *sp += noct; } } Char extc_mb(String *sp) { Char c = *(unsigned char *)*sp; if (c<0x80) (*sp)++; else if (!UTFhead(c)) c = BAD_CHAR; else { int i, size = utfseqlen(c); /* how many octets to expect */ c &= ~UTFmask(size); for (i=1; i= 0); return consCharArray[c]; } static void local initConsCharTable() { Int i; for (i=0; i. * ------------------------------------------------------------------------*/ /* Possibly shorter version of Char for use in arrays. */ #if UNICODE_CHARS typedef Char ShortChar; #else typedef unsigned char ShortChar; #endif /* -------------------------------------------------------------------------- * Character classification and other primitives. * ------------------------------------------------------------------------*/ extern Bool charTabBuilt; extern unsigned char charTable[]; #if UNICODE_CHARS /* cf HS_CHAR_MAX in HsFFI.h */ #define MAXCHARVAL 0x10FFFF #else #define MAXCHARVAL (NUM_LAT1_CHARS-1) #endif #define isIn(c,x) (charTable[(unsigned char)(c)]&(x)) #define isLatin1(c) (0<=(c) && (c) # include # define MAX_CHAR_ENCODING MB_LEN_MAX #elif CHAR_ENCODING_UTF8 # define MAX_CHAR_ENCODING 6 #else # define MAX_CHAR_ENCODING 1 #endif #if CHAR_ENCODING extern int fputc_mb Args((Char, FILE *)); extern int fgetc_mb Args((FILE *)); extern Void addc_mb Args((Char, String *)); extern Char extc_mb Args((String *)); #define FPutChar(c,f) fputc_mb(c,f) #define FGetChar(f) fgetc_mb(f) #define AddChar(c,s) addc_mb(c,&s) #define ExtractChar(s) extc_mb(&s) #if CHAR_ENCODING_UTF8 #define charIsRepresentable(c) TRUE #else extern Bool charIsRepresentable Args((Char)); #endif #else /* !CHAR_ENCODING */ #define FPutChar(c,f) (fputc(c, f)) #define FGetChar(f) (getc(f)) #define AddChar(c,s) (*(s)++ = (c)) #define ExtractChar(s) (*(unsigned char *)(s)++) #define charIsRepresentable(c) isLatin1(c) #endif /* !CHAR_ENCODING */ #endif /* CHAR_H */ hugs98-plus-Sep2006/src/command.h0000644006511100651110000000323310361041740015336 0ustar rossross/* -------------------------------------------------------------------------- * Interpreter command structure * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: command.h,v $ * $Revision: 1.15 $ * $Date: 2006/01/10 23:31:44 $ * ------------------------------------------------------------------------*/ #ifndef __COMMAND_H__ #define __COMMAND_H__ typedef Int Command; struct cmd { String cmdString; Command cmdCode; }; extern Command readCommand Args((struct cmd *, Char, Char)); #define EDIT 0 #define FIND 1 #define LOAD 2 #define ALSO 3 #define RELOAD 4 #define EVAL 5 #define TYPEOF 6 #define HELP 7 #define NAMES 8 #define BADCMD 9 #define SET 10 #define QUIT 11 #define SYSTEM 12 #define CHGDIR 13 #define INFO 14 #define COLLECT 15 #define SETMODULE 16 #define BROWSE 17 #define XPLAIN 18 #define PNTVER 19 #define NOCMD 20 #ifdef __SYMBIAN32__ #define PRNDIR 21 #endif #define MAIN 22 #if OBSERVATIONS /*-------------------------------------------------------------------------* * Commands available after breakpoint * *-------------------------------------------------------------------------*/ #define BRK_DISPLAY 0 #define BRK_CONTINUE 1 #define BRK_SET 2 #define BRK_RESET 3 #endif /*-------------------------------------------------------------------------*/ #endif /* __COMMAND_H__ */ hugs98-plus-Sep2006/src/compiler.c0000644006511100651110000020231607763636156015557 0ustar rossross/* -------------------------------------------------------------------------- * This is the Hugs compiler, handling translation of typechecked code to * `kernel' language, elimination of pattern matching and translation to * super combinators (lambda lifting). * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: compiler.c,v $ * $Revision: 1.25 $ * $Date: 2003/12/04 13:53:50 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "goal.h" #include "char.h" #include "output.h" /* needed for DEBUG_CODE|DEBUG_SHOWSC */ #include "opts.h" /* needed for DEBUG_SHOWSC */ Addr inputCode; /* Addr of compiled code for expr */ static Name currentName; /* Top level name being processed */ #if DEBUG_SHOWSC static FILE *scfp; /* super combinator file pointer */ #endif /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Cell local translate Args((Cell)); static Void local transPair Args((Pair)); static Void local transTriple Args((Triple)); static Void local transAlt Args((Cell)); static Void local transCase Args((Cell)); static List local transBinds Args((List)); static Cell local transRhs Args((Cell)); static Cell local mkConsList Args((List)); static Cell local expandLetrec Args((Cell)); static Cell local transComp Args((Cell,List,Cell)); static Cell local transDo Args((Cell,Cell,List)); static Cell local transConFlds Args((Cell,List)); static Cell local transUpdFlds Args((Cell,List,List)); #if MUDO static Cell local transMDo Args((Cell,Cell,List)); static Cell local mdoBuildTuple Args((List)); #endif static Cell local refutePat Args((Cell)); static Cell local refutePatAp Args((Cell)); static Cell local matchPat Args((Cell)); static List local remPat Args((Cell,Cell,List)); static List local remPat1 Args((Cell,Cell,List)); static Cell local pmcTerm Args((Int,List,Cell)); static Cell local pmcPair Args((Int,List,Pair)); static Cell local pmcTriple Args((Int,List,Triple)); static Cell local pmcVar Args((List,Text)); static Void local pmcLetrec Args((Int,List,Pair)); static Cell local pmcVarDef Args((Int,List,List)); static Void local pmcFunDef Args((Int,List,Triple)); static List local altsMatch Args((Int,Int,List,List)); static Cell local match Args((Int,List)); static Cell local joinMas Args((Int,List)); static Bool local canFail Args((Cell)); static List local addConTable Args((Cell,Cell,List)); static Void local advance Args((Int,Int,Cell)); static Bool local emptyMatch Args((Cell)); static Cell local maDiscr Args((Cell)); static Bool local isNumDiscr Args((Cell)); static Bool local eqNumDiscr Args((Cell,Cell)); #if TREX static Bool local isExtDiscr Args((Cell)); static Bool local eqExtDiscr Args((Cell,Cell)); #endif static Cell local lift Args((Int,List,Cell)); static Void local liftPair Args((Int,List,Pair)); static Void local liftTriple Args((Int,List,Triple)); static Void local liftAlt Args((Int,List,Cell)); static Void local liftNumcase Args((Int,List,Triple)); static Cell local liftVar Args((List,Cell)); static Cell local liftLetrec Args((Int,List,Cell)); static Void local liftFundef Args((Int,List,Triple)); static Void local solve Args((List)); static Cell local preComp Args((Cell)); static Cell local preCompPair Args((Pair)); static Cell local preCompTriple Args((Triple)); static Void local preCompCase Args((Pair)); static Cell local preCompOffset Args((Int)); static Void local compileGlobalFunction Args((Pair)); static Void local compileGenFunction Args((Name)); static Name local compileSelFunction Args((Pair)); static Void local newGlobalFunction Args((Name,Int,List,Int,Cell)); #if DEBUG_SHOWSC static Void local debugConstructors Args((FILE *fp,Cell c)); static Void local debugConstructor Args((FILE *fp,Name c)); #endif /* -------------------------------------------------------------------------- * Translation: Convert input expressions into a less complex language * of terms using only LETREC, AP, constants and vars. * Also remove pattern definitions on lhs of eqns. * ------------------------------------------------------------------------*/ static Cell local translate(e) /* Translate expression: */ Cell e; { switch (whatIs(e)) { case LETREC : snd(snd(e)) = translate(snd(snd(e))); return expandLetrec(e); case COND : transTriple(snd(e)); return e; case AP : fst(e) = translate(fst(e)); if (fst(e)==nameId || fst(e)==nameInd) return translate(snd(e)); if (isName(fst(e)) && isMfun(fst(e)) && mfunOf(fst(e))==0) return translate(snd(e)); snd(e) = translate(snd(e)); return e; #if BIGNUMS case POSNUM : case ZERONUM : case NEGNUM : return e; #endif case NAME : if (e==nameOtherwise) return nameTrue; if (isCfun(e)) { if (isName(name(e).defn)) return name(e).defn; if (isPair(name(e).defn)) return snd(name(e).defn); } return e; #if TREX case RECSEL : return nameRecSel; case EXT : #endif case TUPLE : case VAROPCELL : case VARIDCELL : case DICTVAR : case INTCELL : case DOUBLECELL : case STRCELL : case CHARCELL : return e; #if IPARAM case IPVAR : return nameId; #endif case FINLIST : mapOver(translate,snd(e)); return mkConsList(snd(e)); case DOCOMP : { Cell m = translate(fst(snd(e))); Cell r = translate(fst(snd(snd(e)))); return transDo(m,r,snd(snd(snd(e)))); } case MONADCOMP : { Cell m = translate(fst(snd(e))); Cell r = translate(fst(snd(snd(e)))); Cell qs = snd(snd(snd(e))); if (m == nameListMonad) return transComp(r,qs,nameNil); else { #if MONAD_COMPS r = ap(ap(nameReturn,m),r); return transDo(m,r,qs); #else internal("translate: monad comps"); #endif } } #if MUDO case MDOCOMP : { Cell m = translate(fst(fst(snd(e)))); Cell ms = translate(snd(fst(snd(e)))); Cell r = translate(fst(snd(snd(e)))); Cell segs = snd(snd(snd(e))); map2Over(transMDo,m,ms,segs); return transDo(ms,r,segs); } #endif case CONFLDS : return transConFlds(fst(snd(e)),snd(snd(e))); case UPDFLDS : return transUpdFlds(fst3(snd(e)), snd3(snd(e)), thd3(snd(e))); case CASE : { Cell nv = inventVar(); mapProc(transCase,snd(snd(e))); return ap(LETREC, pair(singleton(pair(nv,snd(snd(e)))), ap(nv,translate(fst(snd(e)))))); } case LAMBDA : { Cell nv = inventVar(); transAlt(snd(e)); return ap(LETREC, pair(singleton(pair( nv, singleton(snd(e)))), nv)); } default : internal("translate"); } return e; } static Void local transPair(pr) /* Translate each component in a */ Pair pr; { /* pair of expressions. */ fst(pr) = translate(fst(pr)); snd(pr) = translate(snd(pr)); } static Void local transTriple(tr) /* Translate each component in a */ Triple tr; { /* triple of expressions. */ fst3(tr) = translate(fst3(tr)); snd3(tr) = translate(snd3(tr)); thd3(tr) = translate(thd3(tr)); } static Void local transAlt(e) /* Translate alt: */ Cell e; { /* ([Pat], Rhs) ==> ([Pat], Rhs') */ snd(e) = transRhs(snd(e)); } static Void local transCase(c) /* Translate case: */ Cell c; { /* (Pat, Rhs) ==> ([Pat], Rhs') */ fst(c) = singleton(fst(c)); snd(c) = transRhs(snd(c)); } static List local transBinds(bs) /* Translate list of bindings: */ List bs; { /* eliminating pattern matching on */ List newBinds = NIL; /* lhs of bindings. */ for (; nonNull(bs); bs=tl(bs)) { #if IPARAM Cell v = fst(hd(bs)); while (isAp(v) && fun(v) == nameInd) v = arg(v); fst(hd(bs)) = v; if (isVar(v)) { #else if (isVar(fst(hd(bs)))) { #endif mapProc(transAlt,snd(hd(bs))); newBinds = cons(hd(bs),newBinds); } else newBinds = remPat(fst(snd(hd(bs))), snd(snd(hd(bs)))=transRhs(snd(snd(hd(bs)))), newBinds); } return newBinds; } static Cell local transRhs(rhs) /* Translate rhs: removing line nos */ Cell rhs; { switch (whatIs(rhs)) { case LETREC : snd(snd(rhs)) = transRhs(snd(snd(rhs))); return expandLetrec(rhs); case GUARDED : mapOver(snd,snd(rhs)); /* discard line number */ mapProc(transPair,snd(rhs)); return rhs; default : return translate(snd(rhs)); /* discard line number */ } } static Cell local mkConsList(es) /* Construct expression for list es */ List es; { /* using nameNil and nameCons */ if (isNull(es)) return nameNil; else return ap(ap(nameCons,hd(es)),mkConsList(tl(es))); } static Cell local expandLetrec(root) /* translate LETREC with list of */ Cell root; { /* groups of bindings (from depend. */ Cell e = snd(snd(root)); /* analysis) to use nested LETRECs */ List bss = fst(snd(root)); Cell temp; if (isNull(bss)) /* should never happen, but just in */ return e; /* case: LETREC [] IN e ==> e */ mapOver(transBinds,bss); /* translate each group of bindings */ for (temp=root; nonNull(tl(bss)); bss=tl(bss)) { fst(snd(temp)) = hd(bss); snd(snd(temp)) = ap(LETREC,pair(NIL,e)); temp = snd(snd(temp)); } fst(snd(temp)) = hd(bss); return root; } /* -------------------------------------------------------------------------- * Translation of list comprehensions is based on the description in * `The Implementation of Functional Programming Languages': * * [ e | qs ] ++ l => transComp e qs l * transComp e [] l => e : l * transComp e ((p<-xs):qs) l => LETREC _h [] = l * _h (p:_xs) = transComp e qs (_h _xs) * _h (_:_xs) = _h _xs --if p !failFree * IN _h xs * transComp e (b:qs) l => if b then transComp e qs l else l * transComp e (decls:qs) l => LETREC decls IN transComp e qs l * ------------------------------------------------------------------------*/ static Cell local transComp(e,qs,l) /* Translate [e | qs] ++ l */ Cell e; List qs; Cell l; { if (nonNull(qs)) { Cell q = hd(qs); Cell qs1 = tl(qs); switch (fst(q)) { case FROMQUAL : { Cell ld = NIL; Cell hVar = inventVar(); Cell xsVar = inventVar(); if (!failFree(fst(snd(q)))) ld = cons(pair(singleton( ap(ap(nameCons, WILDCARD), xsVar)), ap(hVar,xsVar)), ld); ld = cons(pair(singleton( ap(ap(nameCons, fst(snd(q))), xsVar)), transComp(e, qs1, ap(hVar,xsVar))), ld); ld = cons(pair(singleton(nameNil), l), ld); return ap(LETREC, pair(singleton(pair(hVar, ld)), ap(hVar, translate(snd(snd(q)))))); } case QWHERE : return expandLetrec(ap(LETREC, pair(snd(q), transComp(e,qs1,l)))); case BOOLQUAL : return ap(COND, triple(translate(snd(q)), transComp(e,qs1,l), l)); } } return ap(ap(nameCons,e),l); } /* -------------------------------------------------------------------------- * Translation of monad comprehensions written using do-notation: * * do { e } => e * do { p <- exp; qs } => LETREC _h p = do { qs } * _h _ = fail m "match fails" * IN bind m exp _h * do { LET decls; qs } => LETREC decls IN do { qs } * do { IF guard; qs } => if guard then do { qs } else fail m "guard fails" * do { exp; qs } => (>>) m exp (do {qs}) * * where m :: Monad f * ------------------------------------------------------------------------*/ static Cell local transDo(m,e,qs) /* Translate do { qs ; e } */ Cell m; Cell e; List qs; { if (nonNull(qs)) { Cell q = hd(qs); Cell qs1 = tl(qs); switch (fst(q)) { case FROMQUAL : { Cell ld = NIL; Cell hVar = inventVar(); if (!failFree(fst(snd(q)))) { Cell str = mkStr(findText("match fails")); ld = cons(pair(singleton(WILDCARD), ap2(nameMFail,m,str)), ld); } ld = cons(pair(singleton(fst(snd(q))), transDo(m,e,qs1)), ld); return ap(LETREC, pair(singleton(pair(hVar,ld)), ap(ap(ap(nameBind, m), translate(snd(snd(q)))), hVar))); } case DOQUAL : return ap(ap(ap(nameThen,m), translate(snd(q))), transDo(m,e,qs1)); case QWHERE : return expandLetrec(ap(LETREC, pair(snd(q), transDo(m,e,qs1)))); case BOOLQUAL : return ap(COND, triple(translate(snd(q)), transDo(m,e,qs1), ap2(nameMFail,m, mkStr(findText("guard fails"))))); } } return e; } #if MUDO /* Copied verbatim from parser.y: */ static Cell local mdoBuildTuple(tup) /* build tuple (x1,...,xn) from */ List tup; { /* list [xn,...,x1] */ Int n = 0; Cell t = tup; Cell x; do { /* . . */ x = fst(t); /* / \ / \ */ fst(t) = snd(t); /* xn . . xn */ snd(t) = x; /* . ===> . */ x = t; /* . . */ t = fun(x); /* . . */ n++; /* / \ / \ */ } while (nonNull(t)); /* x1 NIL (n) x1 */ fst(x) = mkTuple(n); return tup; } static Cell local transMDo(m,ms,seg) /* translate each segment in an mdo */ Cell m; /* dictionary for recursive monad */ Cell ms; /* dictionary for monad */ List seg; { /* seg looks like: ((1,2,3),4) where: 1: rec vars of the segment 2: exp vars of the segment 3: def vars of the segment (not used here) 4: list of qualifiers in the segment */ List qs = snd(seg); List recs = fst3(fst(seg)); List exps = snd3(fst(seg)); Int noOfRecs = length(recs); Int noOfExps = length(exps); /* Case 1: Not a recursive segment. It must be the case that |qs| = 1 */ if(isNull(recs)) { if(length(qs)!=1) { internal("MDO: Non-recursive, non-singleton segment, Impossible!"); } return hd(qs); } #define mkLambda(arg,body) ap(LAMBDA,pair(singleton(arg),pair(0,body))) #define mkDoComp(qs,exp) ap(DOCOMP,pair(ms,pair(exp,qs))) #define BIND(e1,e2) ap3(nameBind,ms,e1,e2) #define RET(e) ap2(nameReturn,ms,e) #define MFIX(arg,body) ap2(nameMFix,m,mkLambda(arg,body)) #define fromQual(p,e) pair(FROMQUAL,pair(p,e)) #define doQual(e) pair(DOQUAL,e) /* Case 2: Segment is recursive, but there are no exported variables: */ if(noOfExps == 0) { Cell RT = noOfRecs==1 ? hd(recs) : mdoBuildTuple(recs); Cell pat = noOfRecs==1 ? RT : ap(LAZYPAT,RT); return doQual(MFIX(pat,mkDoComp(qs,RET(RT)))); } /* Case 3: There is one exported variable, one rec variable, and they're the same */ if(noOfRecs == 1 && noOfExps == 1 && varIsMember(textOf(hd(exps)),recs)) { Cell RT = hd(recs); return fromQual(RT,MFIX(RT,mkDoComp(qs,RET(RT)))); } /* Case 4: There is one exported variable, >= 1 recursive vars, but exported variable is one of the recursives: */ if(noOfExps == 1 && varIsMember(textOf(hd(exps)),recs)) { Cell RT = noOfRecs==1 ? hd(recs) : mdoBuildTuple(recs); Cell ET = hd(exps); Cell pat = noOfRecs==1 ? RT : ap(LAZYPAT,RT); return fromQual(ET,BIND(MFIX(pat,mkDoComp(qs,RET(RT))), mkLambda(RT,RET(ET)))); } /* Case 5: There is only one exported variable, which is not recursive */ if(noOfExps == 1) { Cell ET = hd(exps); Cell RT = mdoBuildTuple(cons(ET,recs)); Cell pat = ap(LAZYPAT,RT); return fromQual(ET,BIND(MFIX(pat,mkDoComp(qs,RET(RT))), mkLambda(RT,RET(ET)))); } /* Case 6: > 1 exports, no (apparent) optimization applicable: Notice that this is also the "catch-all" phase */ { Cell nv = inventVar(); Cell RT = mdoBuildTuple(cons(nv,recs)); Cell ET = mdoBuildTuple(exps); Cell finQ = fromQual(nv,RET(ET)); Cell innerDo = mkDoComp(appendOnto(qs,singleton(finQ)),RET(RT)); Cell pat = ap(LAZYPAT,RT); return fromQual(ET,BIND(MFIX(pat,innerDo),mkLambda(RT,RET(nv)))); } #undef mkLambda #undef mkDoComp #undef BIND #undef RET #undef MFIX #undef fromQual #undef doQual } #endif /* -------------------------------------------------------------------------- * Translation of named field construction and update: * * Construction is implemented using the following transformation: * * C{x1=e1, ..., xn=en} = C v1 ... vm * where: * vi = e1, if the ith component of C is labelled with x1 * ... * = en, if the ith component of C is labelled with xn * = undefined, otherwise * * Update is implemented using the following transformation: * * e{x1=e1, ..., xn=en} * = let nv (C a1 ... am) v1 ... vn = C a1' .. am' * nv (D b1 ... bk) v1 ... vn = D b1' .. bk * ... * nv _ v1 ... vn = error "failed update" * in nv e e1 ... en * where: * nv, v1, ..., vn, a1, ..., am, b1, ..., bk, ... are new variables, * C,D,... = { K | K is a constr fun s.t. {x1,...,xn} subset of sels(K)} * and: * ai' = v1, if the ith component of C is labelled with x1 * ... * = vn, if the ith component of C is labelled with xn * = ai, otherwise * etc... * * The error case may be omitted if C,D,... is an enumeration of all of the * constructors for the datatype concerned. Strictly speaking, error case * isn't needed at all -- the only benefit of including it is that the user * will get a "failed update" message rather than a cryptic {v354 ...}. * So, for now, we'll go with the second option! * * For the time being, code for each update operation is generated * independently of any other updates. However, if updates are used * frequently, then we might want to consider changing the implementation * at a later stage to cache definitions of functions like nv above. This * would create a shared library of update functions, indexed by a set of * constructors {C,D,...}. * ------------------------------------------------------------------------*/ static Cell local transConFlds(c,flds) /* Translate C{flds} */ Name c; List flds; { Cell e = c; Int m = name(c).arity; Int i; Text t = name(c).text; Cell tStr = mkStr(t); Cell empty = ap(namePrimThrow, ap(nameRecConError, tStr)); for (i=m; i>0; i--) { e = ap(e,empty); } for (; nonNull(flds); flds=tl(flds)) { Cell a = e; for (i=m-sfunPos(fst(hd(flds)),c); i>0; i--) a = fun(a); arg(a) = translate(snd(hd(flds))); } return e; } static Cell local transUpdFlds(e,cs,flds)/* Translate e{flds} */ Cell e; /* (cs is corresp list of constrs) */ List cs; List flds; { Cell nv = inventVar(); Cell body = ap(nv,translate(e)); List fs = flds; List args = NIL; List alts = NIL; for (; nonNull(fs); fs=tl(fs)) { /* body = nv e1 ... en */ Cell b = hd(fs); /* args = [v1, ..., vn] */ body = ap(body,translate(snd(b))); args = cons(inventVar(),args); } for (; nonNull(cs); cs=tl(cs)) { /* Loop through constructors to */ Cell c = hd(cs); /* build up list of alts. */ Cell pat = c; Cell rhs = c; List as = args; Int m = name(c).arity; Int i; for (i=m; i>0; i--) { /* pat = C a1 ... am */ Cell a = inventVar(); /* rhs = C a1 ... am */ pat = ap(pat,a); rhs = ap(rhs,a); } for (fs=flds; nonNull(fs); fs=tl(fs), as=tl(as)) { Name s = fst(hd(fs)); /* Replace approp ai in rhs with */ Cell r = rhs; /* vars from [v1,...,vn] */ for (i=m-sfunPos(s,c); i>0; i--) r = fun(r); arg(r) = hd(as); } alts = cons(pair(cons(pat,args),rhs),alts); } return ap(LETREC,pair(singleton(pair(nv,alts)),body)); } /* -------------------------------------------------------------------------- * Elimination of pattern bindings: * * The following code adopts the definition of failure free patterns as given * in the Haskell 1.3 report; the term "irrefutable" is also used there for * a subset of the failure free patterns described here, but has no useful * role in this implementation. Basically speaking, the failure free patterns * are: variable, wildcard, ~apat * var@apat, if apat is failure free * C apat1 ... apatn if C is a product constructor * (i.e. an only constructor) and * apat1,...,apatn are failure free * Note that the last case automatically covers the case where C comes from * a newtype construction. * ------------------------------------------------------------------------*/ Bool failFree(pat) /* is pattern failure free? */ Cell pat; { /* (can we omit the default case?) */ Cell c = getHead(pat); switch (whatIs(c)) { case ASPAT : return failFree(snd(snd(pat))); case NAME : if (!isCfun(c) || cfunOf(c)!=0) return FALSE; /*intentional fall-thru*/ case TUPLE : for (; isAp(pat); pat=fun(pat)) if (!failFree(arg(pat))) return FALSE; /*intentional fall-thru*/ case LAZYPAT : case VAROPCELL : case VARIDCELL : case DICTVAR : case WILDCARD : return TRUE; #if TREX case EXT : return failFree(extField(pat)) && failFree(extRow(pat)); #endif case CONFLDS : if (cfunOf(fst(snd(c)))==0) { List fs = snd(snd(c)); for (; nonNull(fs); fs=tl(fs)) if (!failFree(snd(hd(fs)))) return FALSE; return TRUE; } /*intentional fall-thru*/ default : return FALSE; } } static Cell local refutePat(pat) /* find pattern to refute in conformality*/ Cell pat; { /* test with pat. */ /* e.g. refPat (x:y) == (_:_) */ /* refPat ~(x:y) == _ etc.. */ switch (whatIs(pat)) { case ASPAT : return refutePat(snd(snd(pat))); case FINLIST : { Cell ys = snd(pat); Cell xs = NIL; for (; nonNull(ys); ys=tl(ys)) xs = ap(ap(nameCons,refutePat(hd(ys))),xs); return revOnto(xs,nameNil); } case CONFLDS : { Cell ps = NIL; Cell fs = snd(snd(pat)); for (; nonNull(fs); fs=tl(fs)) { Cell p = refutePat(snd(hd(fs))); ps = cons(pair(fst(hd(fs)),p),ps); } return pair(CONFLDS,pair(fst(snd(pat)),rev(ps))); } case VAROPCELL : case VARIDCELL : case DICTVAR : case WILDCARD : case LAZYPAT : return WILDCARD; case STRCELL : case CHARCELL : #if NPLUSK case ADDPAT : #endif case TUPLE : case NAME : return pat; case AP : return refutePatAp(pat); default : internal("refutePat"); return NIL; /*NOTREACHED*/ } } static Cell local refutePatAp(p) /* find pattern to refute in conformality*/ Cell p; { Cell h = getHead(p); if (h==nameFromInt || h==nameFromInteger || h==nameFromDouble) return p; #if NPLUSK else if (whatIs(h)==ADDPAT) return ap(fun(p),refutePat(arg(p))); #endif #if TREX else if (isExt(h)) { Cell pf = refutePat(extField(p)); Cell pr = refutePat(extRow(p)); return ap(ap(fun(fun(p)),pf),pr); } #endif else { List as = getArgs(p); mapOver(refutePat,as); return applyToArgs(h,as); } } static Cell local matchPat(pat) /* find pattern to match against */ Cell pat; { /* replaces parts of pattern that do not */ /* include variables with wildcards */ switch (whatIs(pat)) { case ASPAT : { Cell p = matchPat(snd(snd(pat))); return (p==WILDCARD) ? fst(snd(pat)) : ap(ASPAT, pair(fst(snd(pat)),p)); } case FINLIST : { Cell ys = snd(pat); Cell xs = NIL; for (; nonNull(ys); ys=tl(ys)) xs = cons(matchPat(hd(ys)),xs); while (nonNull(xs) && hd(xs)==WILDCARD) xs = tl(xs); for (ys=nameNil; nonNull(xs); xs=tl(xs)) ys = ap(ap(nameCons,hd(xs)),ys); return ys; } case CONFLDS : { Cell ps = NIL; Name c = fst(snd(pat)); Cell fs = snd(snd(pat)); Bool avar = FALSE; for (; nonNull(fs); fs=tl(fs)) { Cell p = matchPat(snd(hd(fs))); ps = cons(pair(fst(hd(fs)),p),ps); if (p!=WILDCARD) avar = TRUE; } return avar ? pair(CONFLDS,pair(c,rev(ps))) : WILDCARD; } case VAROPCELL : case VARIDCELL : case DICTVAR : return pat; case LAZYPAT : { Cell p = matchPat(snd(pat)); return (p==WILDCARD) ? WILDCARD : pat; } case WILDCARD : case STRCELL : case CHARCELL : return WILDCARD; case TUPLE : case NAME : case AP : { Cell h = getHead(pat); if (h==nameFromInt || h==nameFromInteger || h==nameFromDouble) return WILDCARD; #if NPLUSK else if (whatIs(h)==ADDPAT) return pat; #endif #if TREX else if (isExt(h)) { Cell pf = matchPat(extField(pat)); Cell pr = matchPat(extRow(pat)); return (pf==WILDCARD && pr==WILDCARD) ? WILDCARD : ap(ap(fun(fun(pat)),pf),pr); } #endif else { List args = NIL; Bool avar = FALSE; for (; isAp(pat); pat=fun(pat)) { Cell p = matchPat(arg(pat)); if (p!=WILDCARD) avar = TRUE; args = cons(p,args); } return avar ? applyToArgs(pat,args) : WILDCARD; } } default : internal("matchPat"); return NIL; /*NOTREACHED*/ } } #define addEqn(v,val,lds) cons(pair(v,singleton(pair(NIL,val))),lds) static List local remPat(pat,expr,lds) Cell pat; /* Produce list of definitions for eqn */ Cell expr; /* pat = expr, including a conformality */ List lds; { /* check if required. */ Cell refPat = refutePat(pat); Cell varPat = matchPat(pat); if (varPat==WILDCARD) /* no vars => no equations */ return lds; /* Conformality test (if required): * pat = expr ==> nv = LETREC confCheck nv@pat = nv * IN confCheck expr * remPat1(pat,nv,.....); */ if (refPat!=WILDCARD) { Cell confVar = inventVar(); Cell nv = inventVar(); Cell locfun = pair(confVar, /* confVar [([nv@refPat],nv)] */ singleton(pair(singleton(ap(ASPAT, pair(nv,refPat))), nv))); if (whatIs(expr)==GUARDED) { /* A spanner ... special case */ lds = addEqn(nv,expr,lds); /* for guarded pattern binding*/ expr = nv; nv = inventVar(); } if (whatIs(varPat)==ASPAT) { /* avoid using new variable if*/ nv = fst(snd(varPat)); /* a variable is already given*/ varPat = snd(snd(varPat)); /* by an as-pattern */ } lds = addEqn(nv, /* nv = */ ap(LETREC,pair(singleton(locfun), /* LETREC [locfun] */ ap(confVar,expr))), /* IN confVar expr */ lds); return remPat1(varPat,nv,lds); } return remPat1(varPat,expr,lds); } static List local remPat1(pat,expr,lds) Cell pat; /* Add definitions for: pat = expr to */ Cell expr; /* list of local definitions in lds. */ List lds; { Cell c = getHead(pat); switch (whatIs(c)) { case WILDCARD : case STRCELL : case CHARCELL : break; case ASPAT : return remPat1(snd(snd(pat)), /* v@pat = expr */ fst(snd(pat)), addEqn(fst(snd(pat)),expr,lds)); case LAZYPAT : { Cell nv; if (isVar(expr) || isName(expr)) nv = expr; else { nv = inventVar(); lds = addEqn(nv,expr,lds); } return remPat(snd(pat),nv,lds); } #if NPLUSK case ADDPAT : { Cell dict = arg(fun(pat)); /* I don't really know what I'm doing here, but * when evaluating an expression like * * Prelude> let (x+4) = 5 in x * * this results in primSub being passed a dict indirection. * As far as I can gather, a dict indirection is a compile-time * construction only, so shorten it out here. * * sof 2/03. */ while(isAp(dict) && fun(dict) == nameInd) { dict = arg(dict); } return remPat1(arg(pat), /* n + k = expr */ ap(ap(ap(namePmSub, dict), mkInt(snd(fun(fun(pat))))), expr), lds); } #endif case FINLIST : return remPat1(mkConsList(snd(pat)),expr,lds); case CONFLDS : { Name h = fst(snd(pat)); Int m = name(h).arity; Cell p = h; List fs = snd(snd(pat)); Int i = m; while (00; i--) r = fun(r); arg(r) = snd(hd(fs)); } return remPat1(p,expr,lds); } case DICTVAR : /* shouldn't really occur */ case VARIDCELL : case VAROPCELL : return addEqn(pat,expr,lds); case NAME : if (c==nameFromInt || c==nameFromInteger || c==nameFromDouble) { if (argCount==2) arg(fun(pat)) = translate(arg(fun(pat))); break; } if (argCount==1 && isCfun(c) /* for newtype */ && cfunOf(c)==0 && name(c).defn==nameId) return remPat1(arg(pat),expr,lds); /* intentional fall-thru */ case TUPLE : { List ps = getArgs(pat); if (nonNull(ps)) { Cell nv, sel; Int i; if (isVar(expr) || isName(expr)) nv = expr; else { nv = inventVar(); lds = addEqn(nv,expr,lds); } sel = ap(ap(nameSel,c),nv); for (i=1; nonNull(ps); ++i, ps=tl(ps)) lds = remPat1(hd(ps), ap(sel,mkInt(i)), lds); } } break; #if TREX case EXT : { Cell nv = inventVar(); arg(fun(fun(pat))) = translate(arg(fun(fun(pat)))); lds = addEqn(nv, ap(ap(nameRecBrk, arg(fun(fun(pat)))), expr), lds); lds = remPat1(extField(pat),ap(nameFst,nv),lds); lds = remPat1(extRow(pat),ap(nameSnd,nv),lds); } break; #endif default : internal("remPat1"); break; } return lds; } /* -------------------------------------------------------------------------- * Eliminate pattern matching in function definitions -- pattern matching * compiler: * * The original Gofer/Hugs pattern matching compiler was based on Wadler's * algorithms described in `Implementation of functional programming * languages'. That should still provide a good starting point for anyone * wanting to understand this part of the system. However, the original * algorithm has been generalized and restructured in order to implement * new features added in Haskell 1.3. * * During the translation, in preparation for later stages of compilation, * all local and bound variables are replaced by suitable offsets, and * locally defined function symbols are given new names (which will * eventually be their names when lifted to make top level definitions). * ------------------------------------------------------------------------*/ static Offset freeBegin; /* only variables with offset <= freeBegin are of */ static List freeVars; /* interest as `free' variables */ static List freeFuns; /* List of `free' local functions */ static Cell local pmcTerm(co,sc,e) /* apply pattern matching compiler */ Int co; /* co = current offset */ List sc; /* sc = scope */ Cell e; { /* e = expr to transform */ switch (whatIs(e)) { case GUARDED : map2Over(pmcPair,co,sc,snd(e)); break; case LETREC : pmcLetrec(co,sc,snd(e)); break; case VARIDCELL: case VAROPCELL: case DICTVAR : return pmcVar(sc,textOf(e)); case COND : return ap(COND,pmcTriple(co,sc,snd(e))); case AP : return pmcPair(co,sc,e); #if BIGNUMS case POSNUM : case ZERONUM : case NEGNUM : #endif #if NPLUSK case ADDPAT : #endif #if TREX case EXT : #endif case TUPLE : case NAME : case CHARCELL : case INTCELL : case DOUBLECELL: case STRCELL : break; default : internal("pmcTerm"); break; } return e; } static Cell local pmcPair(co,sc,pr) /* apply pattern matching compiler */ Int co; /* to a pair of exprs */ List sc; Pair pr; { return pair(pmcTerm(co,sc,fst(pr)), pmcTerm(co,sc,snd(pr))); } static Cell local pmcTriple(co,sc,tr) /* apply pattern matching compiler */ Int co; /* to a triple of exprs */ List sc; Triple tr; { return triple(pmcTerm(co,sc,fst3(tr)), pmcTerm(co,sc,snd3(tr)), pmcTerm(co,sc,thd3(tr))); } static Cell local pmcVar(sc,t) /* find translation of variable */ List sc; /* in current scope */ Text t; { List xs; Name n; for (xs=sc; nonNull(xs); xs=tl(xs)) { Cell x = hd(xs); if (t==textOf(fst(x))) { if (isOffset(snd(x))) { /* local variable ... */ if (snd(x)<=freeBegin && !cellIsMember(snd(x),freeVars)) freeVars = cons(snd(x),freeVars); return snd(x); } else { /* local function ... */ if (!cellIsMember(snd(x),freeFuns)) freeFuns = cons(snd(x),freeFuns); return fst3(snd(x)); } } } if (isNull(n=findName(t))) /* Lookup global name - the only way*/ n = newName(t,currentName); /* this (should be able to happen) */ /* is with new global var introduced*/ /* after type check; e.g. remPat1 */ return n; } static Void local pmcLetrec(co,sc,e) /* apply pattern matching compiler */ Int co; /* to LETREC, splitting decls into */ List sc; /* two sections */ Pair e; { List fs = NIL; /* local function definitions */ List vs = NIL; /* local variable definitions */ List ds; for (ds=fst(e); nonNull(ds); ds=tl(ds)) { /* Split decls into two */ Cell v = fst(hd(ds)); Int arity = length(fst(hd(snd(hd(ds))))); if (arity==0) { /* Variable declaration */ vs = cons(snd(hd(ds)),vs); sc = cons(pair(v,mkOffset(++co)),sc); } else { /* Function declaration */ fs = cons(triple(inventVar(),mkInt(arity),snd(hd(ds))),fs); sc = cons(pair(v,hd(fs)),sc); } } vs = rev(vs); /* Put declaration lists back in */ fs = rev(fs); /* original order */ fst(e) = pair(vs,fs); /* Store declaration lists */ map2Over(pmcVarDef,co,sc,vs); /* Translate variable definitions */ map2Proc(pmcFunDef,co,sc,fs); /* Translate function definitions */ snd(e) = pmcTerm(co,sc,snd(e)); /* Translate LETREC body */ freeFuns = diffList(freeFuns,fs); /* Delete any `freeFuns' bound in fs*/ } static Cell local pmcVarDef(co,sc,vd) /* apply pattern matching compiler */ Int co; /* to variable definition */ List sc; List vd; { /* vd :: [ ([], rhs) ] */ Cell d = snd(hd(vd)); if (nonNull(tl(vd)) && canFail(d)) return ap(FATBAR,pair(pmcTerm(co,sc,d), pmcVarDef(co,sc,tl(vd)))); return pmcTerm(co,sc,d); } static Void local pmcFunDef(co,sc,fd) /* apply pattern matching compiler */ Int co; /* to function definition */ List sc; Triple fd; { /* fd :: (Var, Arity, [Alt]) */ Offset saveFreeBegin = freeBegin; List saveFreeVars = freeVars; List saveFreeFuns = freeFuns; Int arity = intOf(snd3(fd)); Cell temp = altsMatch(co+1,arity,sc,thd3(fd)); Cell xs; freeBegin = mkOffset(co); freeVars = NIL; freeFuns = NIL; temp = match(co+arity,temp); thd3(fd) = triple(freeVars,freeFuns,temp); for (xs=freeVars; nonNull(xs); xs=tl(xs)) if (hd(xs)<=saveFreeBegin && !cellIsMember(hd(xs),saveFreeVars)) saveFreeVars = cons(hd(xs),saveFreeVars); for (xs=freeFuns; nonNull(xs); xs=tl(xs)) if (!cellIsMember(hd(xs),saveFreeFuns)) saveFreeFuns = cons(hd(xs),saveFreeFuns); freeBegin = saveFreeBegin; freeVars = saveFreeVars; freeFuns = saveFreeFuns; } /* --------------------------------------------------------------------------- * Main part of pattern matching compiler: convert [Alt] to case constructs * * This section of Hugs has been almost completely rewritten to be more * general, in particular, to allow pattern matching in orders other than the * strictly left-to-right approach of the previous version. This is needed * for the implementation of the so-called Haskell 1.3 `record' syntax. * * At each stage, the different branches for the cases to be considered * are represented by a list of values of type: * Match ::= { maPats :: [Pat], patterns to match * maOffs :: [Offs], offsets of corresponding values * maSc :: Scope, mapping from vars to offsets * maRhs :: Rhs } right hand side * [Implementation uses nested pairs, ((pats,offs),(sc,rhs)).] * * The Scope component has type: * Scope ::= [(Var,Expr)] * and provides a mapping from variable names to offsets used in the matching * process. * * Matches can be normalized by reducing them to a form in which the list * of patterns is empty (in which case the match itself is described as an * empty match), or in which the list is non-empty and the first pattern is * one that requires either a CASE or NUMCASE (or EXTCASE) to decompose. * ------------------------------------------------------------------------*/ #define mkMatch(ps,os,sc,r) pair(pair(ps,os),pair(sc,r)) #define maPats(ma) fst(fst(ma)) #define maOffs(ma) snd(fst(ma)) #define maSc(ma) fst(snd(ma)) #define maRhs(ma) snd(snd(ma)) #define extSc(v,o,ma) maSc(ma) = cons(pair(v,o),maSc(ma)) static List local altsMatch(co,n,sc,as) /* Make a list of matches from list*/ Int co; /* of Alts, with initial offsets */ Int n; /* reverse (take n [co..]) */ List sc; List as; { List mas = NIL; List us = NIL; for (; n>0; n--) us = cons(mkOffset(co++),us); for (; nonNull(as); as=tl(as)) /* Each Alt is ([Pat], Rhs) */ mas = cons(mkMatch(fst(hd(as)),us,sc,snd(hd(as))),mas); return rev(mas); } static Cell local match(co,mas) /* Generate case statement for Matches mas */ Int co; /* at current offset co */ List mas; { /* N.B. Assumes nonNull(mas). */ Cell srhs = NIL; /* Rhs for selected matches */ List smas = mas; /* List of selected matches */ mas = tl(mas); tl(smas) = NIL; if (emptyMatch(hd(smas))) { /* The case for empty matches: */ while (nonNull(mas) && emptyMatch(hd(mas))) { List temp = tl(mas); tl(mas) = smas; smas = mas; mas = temp; } srhs = joinMas(co,rev(smas)); } else { /* Non-empty match */ Int o = offsetOf(hd(maOffs(hd(smas)))); Cell d = maDiscr(hd(smas)); if (isNumDiscr(d)) { /* Numeric match */ Int da = discrArity(d); Cell d1 = pmcTerm(co,maSc(hd(smas)),d); while (nonNull(mas) && !emptyMatch(hd(mas)) && o==offsetOf(hd(maOffs(hd(mas)))) && isNumDiscr(d=maDiscr(hd(mas))) && eqNumDiscr(d,d1)) { List temp = tl(mas); tl(mas) = smas; smas = mas; mas = temp; } smas = rev(smas); map2Proc(advance,co,da,smas); srhs = ap(NUMCASE,triple(mkOffset(o),d1,match(co+da,smas))); } #if TREX else if (isExtDiscr(d)) { /* Record match */ Int da = discrArity(d); Cell d1 = pmcTerm(co,maSc(hd(smas)),d); while (nonNull(mas) && !emptyMatch(hd(mas)) && o==offsetOf(hd(maOffs(hd(mas)))) && isExtDiscr(d=maDiscr(hd(mas))) && eqExtDiscr(d,d1)) { List temp = tl(mas); tl(mas) = smas; smas = mas; mas = temp; } smas = rev(smas); map2Proc(advance,co,da,smas); srhs = ap(EXTCASE,triple(mkOffset(o),d1,match(co+da,smas))); } #endif else { /* Constructor match */ List tab = addConTable(d,hd(smas),NIL); Int da; while (nonNull(mas) && !emptyMatch(hd(mas)) && o==offsetOf(hd(maOffs(hd(mas)))) && !isNumDiscr(d=maDiscr(hd(mas)))) { tab = addConTable(d,hd(mas),tab); mas = tl(mas); } for (tab=rev(tab); nonNull(tab); tab=tl(tab)) { d = fst(hd(tab)); smas = snd(hd(tab)); da = discrArity(d); map2Proc(advance,co,da,smas); srhs = cons(pair(d,match(co+da,smas)),srhs); } srhs = ap(CASE,pair(mkOffset(o),srhs)); } } return nonNull(mas) ? ap(FATBAR,pair(srhs,match(co,mas))) : srhs; } static Cell local joinMas(co,mas) /* Combine list of matches into rhs*/ Int co; /* using FATBARs as necessary */ List mas; { /* Non-empty list of empty matches */ Cell ma = hd(mas); Cell rhs = pmcTerm(co,maSc(ma),maRhs(ma)); if (nonNull(tl(mas)) && canFail(rhs)) return ap(FATBAR,pair(rhs,joinMas(co,tl(mas)))); else return rhs; } static Bool local canFail(rhs) /* Determine if expression (as rhs) */ Cell rhs; { /* might ever be able to fail */ switch (whatIs(rhs)) { case LETREC : return canFail(snd(snd(rhs))); case GUARDED : return TRUE; /* could get more sophisticated ..? */ default : return FALSE; } } /* type Table a b = [(a, [b])] * * addTable :: a -> b -> Table a b -> Table a b * addTable x y [] = [(x,[y])] * addTable x y (z@(n,sws):zs) * | n == x = (n,sws++[y]):zs * | otherwise = (n,sws):addTable x y zs */ static List local addConTable(x,y,tab) /* add element (x,y) to table */ Cell x, y; List tab; { if (isNull(tab)) return singleton(pair(x,singleton(y))); else if (fst(hd(tab))==x) snd(hd(tab)) = appendOnto(snd(hd(tab)),singleton(y)); else tl(tab) = addConTable(x,y,tl(tab)); return tab; } static Void local advance(co,a,ma) /* Advance non-empty match by */ Int co; /* processing head pattern */ Int a; /* discriminator arity */ Cell ma; { Cell p = hd(maPats(ma)); List ps = tl(maPats(ma)); List us = tl(maOffs(ma)); if (whatIs(p)==CONFLDS) { /* Special case for record syntax */ Name c = fst(snd(p)); List fs = snd(snd(p)); List qs = NIL; List vs = NIL; for (; nonNull(fs); fs=tl(fs)) { vs = cons(mkOffset(co+a+1-sfunPos(fst(hd(fs)),c)),vs); qs = cons(snd(hd(fs)),qs); } ps = revOnto(qs,ps); us = revOnto(vs,us); } else /* Normally just spool off patterns*/ for (; a>0; --a) { /* and corresponding offsets ... */ us = cons(mkOffset(++co),us); ps = cons(arg(p),ps); p = fun(p); } maPats(ma) = ps; maOffs(ma) = us; } /* -------------------------------------------------------------------------- * Normalize and test for empty match: * ------------------------------------------------------------------------*/ static Bool local emptyMatch(ma)/* Normalize and test to see if a given */ Cell ma; { /* match, ma, is empty. */ while (nonNull(maPats(ma))) { Cell p; tidyHd: switch (whatIs(p=hd(maPats(ma)))) { case LAZYPAT : { Cell nv = inventVar(); maRhs(ma) = ap(LETREC, pair(remPat(snd(p),nv,NIL), maRhs(ma))); p = nv; } /* intentional fall-thru */ case VARIDCELL : case VAROPCELL : case DICTVAR : extSc(p,hd(maOffs(ma)),ma); case WILDCARD : maPats(ma) = tl(maPats(ma)); maOffs(ma) = tl(maOffs(ma)); continue; /* So-called "as-patterns"are really just pattern intersections: * (p1@p2:ps, o:os, sc, e) ==> (p1:p2:ps, o:o:os, sc, e) * (But the input grammar probably doesn't let us take * advantage of this, so we stick with the special case * when p1 is a variable.) */ case ASPAT : extSc(fst(snd(p)),hd(maOffs(ma)),ma); hd(maPats(ma)) = snd(snd(p)); goto tidyHd; case FINLIST : hd(maPats(ma)) = mkConsList(snd(p)); return FALSE; case STRCELL : { String s = textToStr(textOf(p)); for (p=NIL; *s!='\0'; ) p = ap(consChar(getStrChr(&s)),p); hd(maPats(ma)) = revOnto(p,nameNil); } return FALSE; case AP : if (isName(fun(p)) && isCfun(fun(p)) && cfunOf(fun(p))==0 && name(fun(p)).defn==nameId) { hd(maPats(ma)) = arg(p); goto tidyHd; } /* intentional fall-thru */ case CHARCELL : case NAME : case CONFLDS : return FALSE; default : internal("emptyMatch"); } } return TRUE; } /* -------------------------------------------------------------------------- * Discriminators: * ------------------------------------------------------------------------*/ static Cell local maDiscr(ma) /* Get the discriminator for a non-empty */ Cell ma; { /* match, ma. */ Cell p = hd(maPats(ma)); Cell h = getHead(p); switch (whatIs(h)) { case CONFLDS : return fst(snd(p)); #if NPLUSK case ADDPAT : arg(fun(p)) = translate(arg(fun(p))); return fun(p); #endif #if TREX case EXT : h = fun(fun(p)); arg(h) = translate(arg(h)); return h; #endif case NAME : if (h==nameFromInt || h==nameFromInteger || h==nameFromDouble) { if (argCount==2) arg(fun(p)) = translate(arg(fun(p))); return p; } } return h; } static Bool local isNumDiscr(d) /* TRUE => numeric discriminator */ Cell d; { switch (whatIs(d)) { case NAME : case TUPLE : case CHARCELL : return FALSE; #if TREX case AP : return !isExt(fun(d)); #else case AP : return TRUE; /* must be a literal or (n+k) */ #endif } internal("isNumDiscr"); return 0;/*NOTREACHED*/ } Int discrArity(d) /* Find arity of discriminator */ Cell d; { switch (whatIs(d)) { case NAME : return name(d).arity; case TUPLE : return tupleOf(d); case CHARCELL : return 0; #if TREX case AP : switch (whatIs(fun(d))) { #if NPLUSK case ADDPAT : return 1; #endif case EXT : return 2; default : return 0; } #else #if NPLUSK case AP : return (whatIs(fun(d))==ADDPAT) ? 1 : 0; #else case AP : return 0; /* must be an Int or Double lit */ #endif #endif } internal("discrArity"); return 0;/*NOTREACHED*/ } static Bool local eqNumDiscr(d1,d2) /* Determine whether two numeric */ Cell d1, d2; { /* descriptors have same value */ #if NPLUSK if (whatIs(fun(d1))==ADDPAT) return whatIs(fun(d2))==ADDPAT && snd(fun(d1))==snd(fun(d2)); #endif if (isInt(arg(d1))) return isInt(arg(d2)) && intOf(arg(d1))==intOf(arg(d2)); if (isDouble(arg(d1))) return isDouble(arg(d2)) && doubleOf(arg(d1))==doubleOf(arg(d2)); #if BIGNUMS if (isBignum(arg(d1))) return isBignum(arg(d2)) && bigCmp(arg(d1),arg(d2))==0; #endif internal("eqNumDiscr"); return FALSE;/*NOTREACHED*/ } #if TREX static Bool local isExtDiscr(d) /* Test of extension discriminator */ Cell d; { return isAp(d) && isExt(fun(d)); } static Bool local eqExtDiscr(d1,d2) /* Determine whether two extension */ Cell d1, d2; { /* discriminators have same label */ return fun(d1)==fun(d2); } #endif /* -------------------------------------------------------------------------- * Lambda Lifter: replace local function definitions with new global * functions. Based on Johnsson's algorithm. * ------------------------------------------------------------------------*/ static Cell local lift(co,tr,e) /* lambda lift term */ Int co; List tr; Cell e; { switch (whatIs(e)) { case GUARDED : map2Proc(liftPair,co,tr,snd(e)); break; case FATBAR : liftPair(co,tr,snd(e)); break; case CASE : map2Proc(liftAlt,co,tr,snd(snd(e))); break; #if TREX case EXTCASE : #endif case NUMCASE : liftNumcase(co,tr,snd(e)); break; case COND : liftTriple(co,tr,snd(e)); break; case AP : liftPair(co,tr,e); break; case VAROPCELL : case VARIDCELL : case DICTVAR : return liftVar(tr,e); case LETREC : return liftLetrec(co,tr,e); #if BIGNUMS case POSNUM : case ZERONUM : case NEGNUM : #endif #if NPLUSK case ADDPAT : #endif #if TREX case EXT : #endif case TUPLE : case NAME : case INTCELL : case DOUBLECELL: case STRCELL : case OFFSET : case CHARCELL : break; default : internal("lift"); break; } return e; } static Void local liftPair(co,tr,pr) /* lift pair of terms */ Int co; List tr; Pair pr; { fst(pr) = lift(co,tr,fst(pr)); snd(pr) = lift(co,tr,snd(pr)); } static Void local liftTriple(co,tr,e) /* lift triple of terms */ Int co; List tr; Triple e; { fst3(e) = lift(co,tr,fst3(e)); snd3(e) = lift(co,tr,snd3(e)); thd3(e) = lift(co,tr,thd3(e)); } static Void local liftAlt(co,tr,pr) /* lift (discr,case) pair */ Int co; List tr; Cell pr; { /* pr :: (discr,case) */ snd(pr) = lift(co+discrArity(fst(pr)), tr, snd(pr)); } static Void local liftNumcase(co,tr,nc)/* lift (offset,discr,case) */ Int co; List tr; Triple nc; { Int da = discrArity(snd3(nc)); snd3(nc) = lift(co,tr,snd3(nc)); thd3(nc) = lift(co+da,tr,thd3(nc)); } static Cell local liftVar(tr,e) /* lift variable */ List tr; Cell e; { Text t = textOf(e); while (nonNull(tr) && textOf(fst(hd(tr)))!=t) tr = tl(tr); if (isNull(tr)) internal("liftVar"); return snd(hd(tr)); } static Cell local liftLetrec(co,tr,e) /* lift letrec term */ Int co; List tr; Cell e; { List vs = fst(fst(snd(e))); List fs = snd(fst(snd(e))); List fds; co += length(vs); solve(fs); for (fds=fs; nonNull(fds); fds=tl(fds)) { Triple fundef = hd(fds); List fvs = fst3(thd3(fundef)); Cell n = newName(textOf(fst3(fundef)),currentName); Cell e0; for (e0=n; nonNull(fvs); fvs=tl(fvs)) e0 = ap(e0,hd(fvs)); tr = cons(pair(fst3(fundef),e0),tr); fst3(fundef) = n; } map2Proc(liftFundef,co,tr,fs); if (isNull(vs)) return lift(co,tr,snd(snd(e))); map2Over(lift,co,tr,vs); fst(snd(e)) = vs; snd(snd(e)) = lift(co,tr,snd(snd(e))); return e; } static Void local liftFundef(co,tr,fd) /* lift function definition */ Int co; List tr; Triple fd; { Int arity = intOf(snd3(fd)); newGlobalFunction(fst3(fd), /* name */ arity, /* arity */ fst3(thd3(fd)), /* free variables */ co+arity, /* current offset */ lift(co+arity,tr,thd3(thd3(fd)))); /* lifted case */ name(fst3(fd)).defn = NIL; } /* Each element in a list of fundefs has the form: (v,a,(fvs,ffs,rhs)) * where fvs is a list of free variables which must be added as extra * parameters to the lifted version of function v, * ffs is a list of fundefs defined either in the group of definitions * including v, or in some outer LETREC binding. * * In order to determine the correct value for fvs, we must include: * - all variables explicitly appearing in the body rhs (this much is * achieved in pmcVar). * - all variables required for lifting those functions appearing in ffs. * - If f is a fundef in an enclosing group of definitions then the * correct list of variables to include with each occurrence of f will * have already been calculated and stored in the fundef f. We simply * take the union of this list with fvs. * - If f is a fundef in the same group of bindings as v, then we iterate * to find the required solution. */ #if DEBUG_CODE extern Void dumpFundefs Args((List)); Void dumpFundefs(fs) List fs; { Printf("Dumping Fundefs:\n"); for (; nonNull(fs); fs=tl(fs)) { Cell t = hd(fs); List fvs = fst3(thd3(t)); List ffs = snd3(thd3(t)); Printf("Var \"%s\", arity %d:\n",textToStr(textOf(fst3(t))), intOf(snd3(t))); Printf("Free variables: "); printExp(stdout,fvs); Putchar('\n'); Printf("Local functions: "); for (; nonNull(ffs); ffs=tl(ffs)) { printExp(stdout,fst3(hd(ffs))); Printf(" "); } Putchar('\n'); } Printf("----------------\n"); } #endif static Void local solve(fs) /* Solve eqns for lambda-lifting */ List fs; { /* of local function definitions */ Bool hasChanged; List fs0, fs1; /* initial pass distinguishes between those functions defined in fs and * those defined in enclosing LETREC clauses ... */ for (fs0=fs; nonNull(fs0); fs0=tl(fs0)) { List fvs = fst3(thd3(hd(fs0))); List ffs = NIL; for (fs1=snd3(thd3(hd(fs0))); nonNull(fs1); fs1=tl(fs1)) { if (cellIsMember(hd(fs1),fs)) /* function in same LETREC */ ffs = cons(hd(fs1),ffs); else { /* enclosing letrec */ List fvs1 = fst3(thd3(hd(fs1))); for (; nonNull(fvs1); fvs1=tl(fvs1)) if (!cellIsMember(hd(fvs1),fvs)) fvs = cons(hd(fvs1),fvs); } } fst3(thd3(hd(fs0))) = fvs; snd3(thd3(hd(fs0))) = ffs; } /* now that the ffs component of each fundef in fs has been restricted * to a list of fundefs in fs, we iterate to add any extra free variables * that are needed (in effect, calculating the reflexive transitive * closure of the local call graph of fs). */ do { hasChanged = FALSE; for (fs0=fs; nonNull(fs0); fs0=tl(fs0)) { List fvs0 = fst3(thd3(hd(fs0))); for (fs1=snd3(thd3(hd(fs0))); nonNull(fs1); fs1=tl(fs1)) if (hd(fs1)!=hd(fs0)) { List fvs1 = fst3(thd3(hd(fs1))); for (; nonNull(fvs1); fvs1=tl(fvs1)) if (!cellIsMember(hd(fvs1),fvs0)) { hasChanged = TRUE; fvs0 = cons(hd(fvs1),fvs0); } } if (hasChanged) fst3(thd3(hd(fs0))) = fvs0; } } while (hasChanged); } /* -------------------------------------------------------------------------- * Pre-compiler: Uses output from lambda lifter to produce terms suitable * for input to code generator. * ------------------------------------------------------------------------*/ static List extraVars; /* List of additional vars to add to function */ static Int numExtraVars; /* Length of extraVars */ static Int localOffset; /* offset value used in original definition */ static Int localArity; /* arity of function being compiled w/o extras */ /* -------------------------------------------------------------------------- * Arrangement of arguments on stack prior to call of * n x_1 ... x_e y_1 ... y_a * where * e = numExtraVars, x_1,...,x_e are the extra params to n * a = localArity of n, y_1,...,y_a are the original params * * offset 1 : y_a } STACKPART1 * .. } * offset a : y_1 } * * offset 1+a : x_e } STACKPART2 * .. } * offset e+a : x_1 } * * offset e+a+1 : used for temporary results ... STACKPART3 * .. * .. * * In the original defn for n, the offsets in STACKPART1 and STACKPART3 * are contiguous. To add the extra parameters we need to insert the * offsets in STACKPART2, adjusting offset values as necessary. * ------------------------------------------------------------------------*/ static Cell local preComp(e) /* Adjust output from compiler to */ Cell e; { /* include extra parameters */ switch (whatIs(e)) { case GUARDED : mapOver(preCompPair,snd(e)); break; case LETREC : mapOver(preComp,fst(snd(e))); snd(snd(e)) = preComp(snd(snd(e))); break; case COND : return ap(COND,preCompTriple(snd(e))); case FATBAR : return ap(FATBAR,preCompPair(snd(e))); case AP : return preCompPair(e); case CASE : fst(snd(e)) = preComp(fst(snd(e))); mapProc(preCompCase,snd(snd(e))); break; #if TREX case EXTCASE : return ap(EXTCASE,preCompTriple(snd(e))); #endif case NUMCASE : return ap(NUMCASE,preCompTriple(snd(e))); case OFFSET : return preCompOffset(offsetOf(e)); #if BIGNUMS case POSNUM : case ZERONUM : case NEGNUM : #endif #if NPLUSK case ADDPAT : #endif #if TREX case EXT : #endif case TUPLE : case NAME : case INTCELL : case DOUBLECELL: case STRCELL : case CHARCELL : break; default : internal("preComp"); } return e; } static Cell local preCompPair(e) /* Apply preComp to pair of Exprs */ Pair e; { return pair(preComp(fst(e)), preComp(snd(e))); } static Cell local preCompTriple(e) /* Apply preComp to triple of Exprs */ Triple e; { return triple(preComp(fst3(e)), preComp(snd3(e)), preComp(thd3(e))); } static Void local preCompCase(e) /* Apply preComp to (Discr,Expr) */ Pair e; { snd(e) = preComp(snd(e)); } static Cell local preCompOffset(n) /* Determine correct offset value */ Int n; { /* for local variable/function arg.*/ if (n>localOffset-localArity) if (n>localOffset) /* STACKPART3 */ return mkOffset(n-localOffset+localArity+numExtraVars); else /* STACKPART1 */ return mkOffset(n-localOffset+localArity); else { /* STACKPART2 */ List fvs = extraVars; Int i = localArity+numExtraVars; for (; nonNull(fvs) && offsetOf(hd(fvs))!=n; --i) fvs=tl(fvs); return mkOffset(i); } } /* -------------------------------------------------------------------------- * Main entry points to compiler: * ------------------------------------------------------------------------*/ Void compileExp() { /* compile input expression */ compiler(RESET); currentName = NIL; inputExpr = lift(0,NIL,pmcTerm(0,NIL,translate(inputExpr))); extraVars = NIL; numExtraVars = 0; localOffset = 0; localArity = 0; inputExpr = preComp(inputExpr); #if DEBUG_SHOWSC if (debugSC) printSc(stdout,findText("main"),0,inputExpr); #endif inputCode = codeGen(NIL,0,inputExpr); inputExpr = NIL; } Void compileDefns() { /* compile script definitions */ Target t = length(valDefns) + length(genDefns) + length(selDefns); Target i = 0; #if DEBUG_SHOWSC Module mod; String modName; char name[256]; List dataCons = NIL; if (debugSC) { mod = currentModule; modName = textToStr(module(currentModule).text); if (snprintf(name,sizeof(name)-1, "%s.cor", modName) < 0) { ERRMSG(0) "Module name (%s) too long", modName EEND_NORET; } else { name[sizeof(name)-1] = '\0'; scfp = fopen(name,"w"); fprintf(scfp,"module %s;\n",modName); dataCons = dupOnto(dataCons,module(currentModule).tycons); dataCons = dupOnto(dataCons,module(currentModule).classes); for (; nonNull(dataCons); dataCons=tl(dataCons)) { Cell t = hd(dataCons); switch(whatIs(t)) { case TYCON: if (tycon(t).what == DATATYPE && nonNull(tycon(t).defn) && tycon(t).mod == mod) { fprintf(scfp,"data %s", textToStr(tycon(t).text)); debugConstructors(scfp,tycon(t).defn); fprintf(scfp,";\n"); } break; case CLASS: if (cclass(t).mod == mod) { fprintf(scfp,"data %s = ", textToStr(cclass(t).text)); debugConstructor(scfp,cclass(t).dcon); fprintf(scfp,";\n"); } break; default: fprintf(scfp,"** unknown datacons **"); } } } } #endif setGoal("Compiling",t); for (; nonNull(valDefns); valDefns=tl(valDefns)) { hd(valDefns) = transBinds(hd(valDefns)); mapProc(compileGlobalFunction,hd(valDefns)); soFar(i++); } for (; nonNull(genDefns); genDefns=tl(genDefns)) { compileGenFunction(hd(genDefns)); soFar(i++); } for (; nonNull(selDefns); selDefns=tl(selDefns)) { mapOver(compileSelFunction,hd(selDefns)); soFar(i++); } #if DEBUG_SHOWSC if (debugSC) { fprintf(scfp,"\n-- end of module %s --\n",modName); fclose(scfp); } #endif done(); } #if DEBUG_SHOWSC static Void local debugConstructors(FILE *fp,Cell c) { char ch = '='; while(isAp(c)) { if (whatIs(hd(c)) == NAME) { fprintf(fp,"\n %c ",ch); ch = '|'; debugConstructor(fp,hd(c)); } c = tl(c); } } static Void local debugConstructor(FILE *fp,Name c) { int i; switch(whatIs(c)) { case NAME: fprintf(fp,"%s",textToStr(name(c).text)); for(i=0;i < name(c).arity;i++) { fprintf(scfp," *"); } break; default: fprintf(fp,"** unknown constructor **"); } } #endif static Void local compileGlobalFunction(bind) Pair bind; { Name n = findName(textOf(fst(bind))); List defs = snd(bind); Int arity = length(fst(hd(defs))); if (isNull(n)) internal("compileGlobalFunction"); compiler(RESET); currentName = n; defs = altsMatch(1,arity,NIL,defs); newGlobalFunction(n,arity,NIL,arity,lift(arity,NIL,match(arity,defs))); name(n).defn = NIL; } static Void local compileGenFunction(n) /* Produce code for internally */ Name n; { /* generated function */ List defs = name(n).defn; Int arity = length(fst(hd(defs))); compiler(RESET); currentName = n; mapProc(transAlt,defs); defs = altsMatch(1,arity,NIL,defs); newGlobalFunction(n,arity,NIL,arity,lift(arity,NIL,match(arity,defs))); name(n).defn = NIL; } static Name local compileSelFunction(p) /* Produce code for selector func */ Pair p; { /* Should be merged with genDefns, */ Name s = fst(p); /* but the name(_).defn field is */ List defs = snd(p); /* already used for other purposes */ Int arity = length(fst(hd(defs))); /* in selector functions. */ compiler(RESET); mapProc(transAlt,defs); defs = altsMatch(1,arity,NIL,defs); newGlobalFunction(s,arity,NIL,arity,lift(arity,NIL,match(arity,defs))); return s; } static Void local newGlobalFunction(n,arity,fvs,co,e) Name n; Int arity; List fvs; Int co; Cell e; { extraVars = fvs; numExtraVars = length(extraVars); localOffset = co; localArity = arity; name(n).arity = arity+numExtraVars; e = preComp(e); #if DEBUG_SHOWSC if (debugSC) { printSc(scfp,name(n).text,name(n).arity,e); } #endif name(n).code = codeGen(n,name(n).arity,e); } /* -------------------------------------------------------------------------- * Compiler control: * ------------------------------------------------------------------------*/ Void compiler(what) Int what; { switch (what) { case INSTALL : case RESET : freeVars = NIL; freeFuns = NIL; freeBegin = mkOffset(0); extraVars = NIL; numExtraVars = 0; localOffset = 0; localArity = 0; break; case MARK : mark(freeVars); mark(freeFuns); mark(extraVars); break; } } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/connect.h0000644006511100651110000004351110344040463015356 0ustar rossross/* -------------------------------------------------------------------------- * Connections between components of the Hugs system * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: connect.h,v $ * $Revision: 1.92 $ * $Date: 2005/12/02 12:42:27 $ * ------------------------------------------------------------------------*/ #ifndef __CONNECT_H__ #define __CONNECT_H__ /* -------------------------------------------------------------------------- * Standard data: * ------------------------------------------------------------------------*/ extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/ extern Module modulePrelude; extern Module moduleUserPrelude; /* -------------------------------------------------------------------------- * Primitive constructor functions * ------------------------------------------------------------------------*/ extern Name nameFalse, nameTrue; extern Name nameNil, nameCons; extern Name nameJust, nameNothing; extern Name nameLeft, nameRight; extern Name nameUnit; extern Name nameLT, nameEQ; extern Name nameGT; extern Name nameFst, nameSnd; /* standard combinators */ extern Name nameId, nameOtherwise; extern Name nameNegate, nameFlip; /* primitives reqd for parsing */ extern Name nameFrom, nameFromThen; extern Name nameFromTo, nameFromThenTo; extern Name nameFatbar, nameFail; /* primitives reqd for translation */ extern Name nameIf, nameSel; extern Name nameCompAux; extern Name namePmInt, namePmFlt; /* primitives for pattern matching */ extern Name namePmInteger; #if NPLUSK extern Name namePmNpk, namePmSub; /* primitives for (n+k) patterns */ #endif extern Name nameBlackHole; /* For GC-detected black hole */ extern Name nameInd; /* For dict indirection */ extern Name nameAnd, nameOr; /* For optimisation of && and || */ extern Name nameFromInt, nameFromDouble;/*coercion of numerics */ extern Name nameFromInteger; extern Name nameEq, nameCompare; /* names used for deriving */ extern Name nameMinBnd, nameMaxBnd; extern Name nameIndex, nameInRange; extern Name nameRange; extern Name nameLe, nameGt; extern Name nameShowsPrec, nameReadsPrec; extern Name nameMult, namePlus; extern Name nameConCmp, nameEnRange; extern Name nameEnIndex, nameEnInRng; extern Name nameEnToEn, nameEnFrEn; extern Name nameEnFrom, nameEnFrTh; extern Name nameEnFrTo; extern Name nameComp, nameApp; /* composition and append */ extern Name nameShowField; /* display single field */ extern Name nameShowParen; /* wrap with parens */ extern Name nameReadField; /* read single field */ extern Name nameReadParen; /* unwrap from parens */ extern Name nameLex; /* lexer */ extern Name nameRangeSize; /* calculate size of index range */ extern Class classMonad; /* Monads */ extern Name nameReturn, nameBind; /* for translating do / monad comps*/ extern Name nameThen; /* for translating do / monad comps*/ extern Name nameMFail; extern Name nameListMonad; /* builder function for List Monad */ #if MUDO extern Class classMonadRec; /* Recursive monads */ extern Name nameMFix; /* for translating mdo-notation */ #endif extern Name namePrint; /* printing primitive */ extern Name nameNPrint; /* internal printer */ #if IO_MONAD extern Type typeIO; /* For the IO monad, IO */ extern Type typeProgIO; /* For the IO monad, IO () */ extern Name nameIORun; /* IO monad executor */ extern Name nameIOBind; /* IO bind executor */ extern Name namePutStr; /* Prelude.putStr */ extern Name nameIOError, nameUserErr; /* primitives required for IOError */ extern Name namePermDenied; extern Name nameAlreadyExists, nameAlreadyInUse, nameDoesNotExist, nameIsFull; extern Name nameIllegal; #endif #define IOArity 1 /* arity of IO actions */ #if IO_HANDLES extern Name nameEOFErr; extern Name nameProtocolError; #endif #if DOTNET extern Name nameNetException; #endif extern Name namePrimThrow; extern Name nameArithException; extern Name nameArrayException; extern Name nameErrorCall; extern Name nameIOException; extern Name nameNoMethodError; extern Name nameNonTermination; extern Name namePatternMatchFail; extern Name nameRecConError; extern Name nameRecSelError; extern Name nameRecUpdError; extern Name nameOverflow; extern Name nameDivideByZero; extern Name nameIndexOutOfBounds; extern Name nameUndefinedElement; extern Text textCCall; /* ffi tokens */ extern Text textSafe; extern Text textUnsafe; extern Text textThreadsafe; extern Text textExport; #if STDCALL_SUPPORTED extern Text textStdcall; #endif #ifdef DOTNET extern Text textDotnet; #endif extern Text textPrelude; extern Text textUserPrelude; extern Text textNum; /* used to process default decls */ #if NPLUSK extern Text textPlus; /* Used to recognise n+k patterns */ #endif #if TREX extern Name nameNoRec; /* The empty record */ extern Type typeNoRow; /* The empty row */ extern Type typeRec; /* Record formation */ extern Kind extKind; /* Kind of extension, *->row->row */ extern Name nameRecExt; /* Extend a record */ extern Name nameRecBrk; /* Break a record */ extern Name nameAddEv; /* Addition of evidence values */ extern Name nameRecSel; /* Select a record */ extern Name nameRecShw; /* Show a record */ extern Name nameShowRecRow; /* Used to output rows */ extern Name nameRecEq; /* Compare records */ extern Name nameEqRecRow; /* Used to compare rows */ extern Name nameInsFld; /* Field insertion routine */ extern Name nameShowRecRowCls; /* Trex.ShowRecRow class */ extern Name nameEqRecRowCls; /* Trex.EqRecRow class */ #endif extern String versionString; /* String containing version name */ #if USE_REGISTRY extern String hugsRegRoot; /* Root in registry for windows */ #endif extern String scriptFile; /* Name of current script (if any) */ extern Type typeArrow; /* Builtin type constructors */ extern Type typeList; extern Type typeUnit; extern Type typeInt; extern Type typeInt8; extern Type typeInt16; extern Type typeInt32; extern Type typeInt64; extern Type typeWord; extern Type typeWord8; extern Type typeWord16; extern Type typeWord32; extern Type typeWord64; extern Type typeFunPtr; extern Type typePtr; extern Type typeAddr; extern Type typeFloat; extern Type typeDouble; extern Type typeChar; extern Type typeForeignP; extern Type typeForeign; extern Type typeStable; extern Type typeBool; extern Type typeString; #ifdef DOTNET extern Type typeObject; #endif #define fn(from,to) ap(ap(typeArrow,from),to) /* make type: from -> to */ extern List stdDefaults; /* List of standard default types */ extern Class classEq; /* `standard' classes */ extern Class classOrd; extern Class classShow; extern Class classRead; extern Class classIx; extern Class classEnum; extern Class classBounded; extern Class classReal; /* `numeric' classes */ extern Class classIntegral; extern Class classRealFrac; extern Class classRealFloat; extern Class classFractional; extern Class classFloating; extern Class classNum; extern Cell *CStackBase; /* pointer to base of C stack */ extern List tyconDefns; /* list of type constructor defns */ extern List typeInDefns; /* list of synonym restrictions */ extern List valDefns; /* list of value definitions */ extern List classDefns; /* list of class definitions */ extern List instDefns; /* list of instance definitions */ extern List selDefns; /* list of selector lists */ extern List genDefns; /* list of generated defns */ extern List primDefns; /* list of primitive definitions */ extern List unqualImports; /* unqualified import list */ extern List defaultDefns; /* default definitions (if any) */ extern Int defaultLine; /* line in which default defs occur*/ extern List evalDefaults; /* defaults for evaluator */ extern Cell inputExpr; /* evaluator input expression */ extern Cell inputContext; /* evaluator input expression */ extern Addr inputCode; /* Code for compiled input expr */ extern Int whnfArgs; /* number of args of term in whnf */ extern Cell whnfHead; /* head of term in whnf */ extern Int whnfInt; /* integer value of term in whnf */ extern Float whnfFloat; /* float value of term in whnf */ extern Double whnfDouble; /* double value of term in whnf */ extern Long numReductions; /* number of reductions used */ extern Long numCells; /* number of cells allocated */ extern Int numGcs; /* number of garbage collections */ extern Bool broken; /* indicates interrupt received */ extern Bool preludeLoaded; /* TRUE => prelude has been loaded */ /* -------------------------------------------------------------------------- * Function prototypes etc... * ------------------------------------------------------------------------*/ #define RESET 1 /* reset subsystem */ #define MARK 2 /* mark parts of graph in use by subsystem */ #define INSTALL 3 /* install subsystem (executed once only) */ #define EXIT 4 /* Take action immediately before exit() */ #define BREAK 5 /* Take action after program break */ /* hugs.c exports: */ extern Void shutdownHugs Args((Void)); extern Void promptForInput Args((String)); /* The next three are required only by winhugs */ extern Bool doCommand Args((Void)); extern Void runEditor Args((Void)); extern Module findEvalModule Args((Void)); extern Void storage Args((Int)); extern Bool startsQual Args((Char)); extern Void input Args((Int)); extern Void consoleInput Args((String)); extern Void stringInput Args((String)); extern Bool parseScript Args((String,Long)); extern Void parseScriptString Args((String)); extern Void parseExp Args((Void)); #if EXPLAIN_INSTANCE_RESOLUTION extern Void parseContext Args((Void)); #endif extern String readFilename Args((Void)); extern String readLine Args((Void)); extern Bool isModuleId Args((String)); extern Syntax defaultSyntax Args((Text)); extern Syntax syntaxOf Args((Name)); extern String unlexChar Args((Char,Char)); extern Void printString Args((String)); extern Char getStrChr Args((String *)); extern Void substitution Args((Int)); extern Void staticAnalysis Args((Int)); extern Void startModule Args((Cell)); extern Void setExportList Args((List)); extern Void setExports Args((List)); extern Void tyconDefn Args((Int,Cell,Cell,Cell)); extern Void setTypeIns Args((List)); extern Void clearTypeIns Args((Void)); extern Type fullExpand Args((Type)); extern Bool isAmbiguous Args((Type)); extern Void ambigError Args((Int,String,Cell,Type)); extern Void classDefn Args((Int,Cell,List,List)); extern Void instDefn Args((Int,Cell,Cell)); extern Void addTupInst Args((Class,Int)); extern Bool hasIOResultType Args((Type)); #if TREX extern Inst addRecShowInst Args((Class,Ext)); extern Inst addRecEqInst Args((Class,Ext)); #endif #if ZIP_COMP extern Text zipName Args((Int)); #endif extern List oclose Args((List,List)); extern List zonkTyvarsIn Args((Type,List)); extern Type zonkTyvar Args((Int)); extern Type zonkType Args((Type,Int)); extern Void primDefn Args((Cell,List,Cell)); extern Void defaultDefn Args((Int,List)); extern Void checkExp Args((Void)); #if EXPLAIN_INSTANCE_RESOLUTION extern Void checkContext Args((Void)); #endif extern Void checkDefns Args((Void)); extern Void h98CheckInferredType Args((Int,Cell,Type)); extern Void h98DoesntSupport Args((Int,String)); extern Cell depExpr Args((Int,Cell)); extern Void foreignImport Args((Cell,Cell,Cell,Cell,Cell,Type)); extern Void foreignExport Args((Cell,Cell,Cell,Cell,Cell,Type)); extern Int foreignCount; extern List foreignImports; /* foreign import declarations */ extern List foreignExports; /* foreign export declarations */ extern Void ffi Args((Int)); extern Void foreignHeader Args((String)); extern Void foreignFooter Args((String,Text,List,List)); extern Void ffiSetFlags Args((String)); extern Void ffiAddCppInclude Args((String)); extern Void implementForeignImport Args((Int,Name,Int,Text,Text,Bool,Text,List,Bool,Type)); extern Void implementForeignImportDynamic Args((Int,Int,Text,List,Bool,Type)); extern Void implementForeignImportWrapper Args((Int,Int,Text,List,Bool,Type)); extern Void implementForeignImportLabel Args((Int,Int,Text,Text,Text,Type)); extern Void implementForeignExport Args((Int,Int,Text,List,Bool,Type)); extern Bool foreignNeedStubs Args((List,List)); extern Bool generateFFI; /* running ffihugs? */ extern Bool generate_ffi; /* generate FFI for the current module? */ extern Void typeChecker Args((Int)); extern Type typeCheckExp Args((Bool)); extern Void typeCheckDefns Args((Void)); extern Cell provePred Args((Kinds,List,Cell)); extern Cell resolvePred Args((Kinds,Cell)); extern List simpleContext Args((List,Int)); extern Cell rhsExpr Args((Cell)); extern Int rhsLine Args((Cell)); extern Cell getProgType Args((List,Type)); extern Cell superEvid Args((Cell,Class,Class)); extern Void linkPreludeTC Args((Void)); extern Void linkPreludeCM Args((Void)); extern Void linkPreludeFuns Args((Void)); extern Void compiler Args((Int)); extern Void compileDefns Args((Void)); extern Void compileExp Args((Void)); extern Bool failFree Args((Cell)); extern Int discrArity Args((Cell)); extern Void machine Args((Int)); extern Addr codeGen Args((Name,Int,Cell)); extern Void implementCfun Args((Name,List)); #if TREX extern Name implementRecShw Args((Text,Cell)); extern Name implementRecEq Args((Text,Cell)); #endif extern Void addCfunTable Args((Tycon)); extern Name succCfun Args((Name)); extern Name nextCfun Args((Name,Name)); extern Name cfunByNum Args((Name,Int)); extern Void unwind Args((Cell)); extern Void run Args((Addr,StackPtr)); #if !WANT_FIXED_SIZE_TABLES extern DynTable* dynMemory; extern void growMemory Args((Void)); #endif extern Void eval Args((Cell)); extern Cell evalWithNoError Args((Cell)); extern Void evalFails Args((StackPtr)); extern Void throwException Args((Cell)) HUGS_noreturn; #if BYTECODE_PRIMS extern Int IntAt Args((Addr)); extern Float FloatAt Args((Addr)); extern Double DoubleAt Args((Addr)); extern Cell CellAt Args((Addr)); extern Text TextAt Args((Addr)); extern Addr AddrAt Args((Addr)); extern Int InstrAt Args((Addr)); #endif /* BYTECODE_PRIMS */ extern Void builtIn Args((Int)); extern Void abandon Args((String,Cell)); extern Void outputString Args((FILE *)); extern Void dialogue Args((Cell)); extern Cell consChar Args((Char)); #if BIGNUMS extern Bignum bigInt Args((Int)); extern Bignum bigDouble Args((double)); extern Bignum bigNeg Args((Bignum)); extern Cell bigToInt Args((Bignum)); extern double bigToDouble Args((Bignum)); extern Bignum bigStr Args((String)); extern Cell bigOut Args((Bignum,Cell,Bool)); extern Bignum bigShift Args((Bignum,Int,Int)); extern Int bigCmp Args((Bignum,Bignum)); #endif #if IO_MONAD extern Void setHugsArgs Args((Int,String[])); #endif extern Void machdep Args((Int)); extern String findPathname Args((String)); extern String findMPathname Args((String)); extern String findMInDir Args((String,String)); extern Bool readable Args((String,Bool)); #if PROFILING extern String timeString Args((Void)); #endif extern String hugsdir Args((Void)); extern String mkFFIFilename Args((String)); extern String mkFFIFilename2 Args((String)); extern Void freeDLL Args((void*)); extern Void compileAndLink Args((String,String)); extern Void plugins Args((Int)); extern Bool havePlugin Args((String)); extern List calcFunDepsPreds Args((List)); extern Inst findInstFor Args((Cell,Int)); #if MULTI_INST extern List findInstsFor Args((Cell,Int)); #endif #if HUGS_FOR_WINDOWS extern Void saveInputState Args((Void)); extern Void restoreInputState Args((Void)); #endif #if OBSERVATIONS #define NUMARGS 16 /* max num of args; must be 2^n */ #define appId(seq,arg) (seq)*NUMARGS+(arg) #define argNum(n) (n)%NUMARGS #define seqNum(n) (n)/NUMARGS extern Bool printingObservations; /* TRUE => print observed exprs */ extern Int appNum; /* for counting applications */ extern Int obsCount; /* sanity counter for observations */ extern Bool isWhnf Args((Cell)); extern Cell getCaf Args((Cell)); extern Int countObserve Args((Void)); #endif extern Void charOps Args((Int)); extern Void pushString Args((String)); /*-------------------------------------------------------------------------*/ #endif /* __CONNECT_H__ */ hugs98-plus-Sep2006/src/dirprim.c0000644006511100651110000003353110221646043015367 0ustar rossross/* * Primitives needed to implement the Haskell 98 Directory module. * * This file has to be included by builtin.c, and won't compile on its own. */ /* -------------------------------------------------------------------------- * Directory control: * ------------------------------------------------------------------------*/ static Void dirControl Args((Int)); static Void dirControl(what) Int what; { } /* -------------------------------------------------------------------------- * Directory primitive table: * ------------------------------------------------------------------------*/ PROTO_PRIM(primCreateDirectory); PROTO_PRIM(primRemoveDirectory); PROTO_PRIM(primRemoveFile); PROTO_PRIM(primRenameDirectory); PROTO_PRIM(primRenameFile); PROTO_PRIM(primGetDirectory); PROTO_PRIM(primSetDirectory); PROTO_PRIM(primFileExist); PROTO_PRIM(primDirExist); PROTO_PRIM(primGetPermissions); PROTO_PRIM(primSetPermissions); PROTO_PRIM(primGetDirContents); PROTO_PRIM(primGetModTime); static struct primitive dirPrimTable[] = { {"createDirectory", 1+IOArity, primCreateDirectory}, {"removeDirectory", 1+IOArity, primRemoveDirectory}, {"removeFile", 1+IOArity, primRemoveFile}, {"renameDirectory", 2+IOArity, primRenameDirectory}, {"renameFile", 2+IOArity, primRenameFile}, {"getCurrentDirectory", 0+IOArity, primGetDirectory}, {"setCurrentDirectory", 1+IOArity, primSetDirectory}, {"doesFileExist", 1+IOArity, primFileExist}, {"doesDirectoryExist", 1+IOArity, primDirExist}, {"getPerms", 1+IOArity, primGetPermissions}, {"setPerms", 5+IOArity, primSetPermissions}, {"getDirContents", 1+IOArity, primGetDirContents}, {"getModTime", 1+IOArity, primGetModTime}, {0, 0, 0} }; static struct primInfo dirPrims = { dirControl, dirPrimTable, 0 }; static Bool local isDirectory Args((String)); #define ToBool(v) ( (v) ? nameTrue : nameFalse) #ifdef _MSC_VER /* If not provided, define em. */ #ifndef R_OK #define R_OK 04 #endif #ifndef W_OK #define W_OK 02 #endif #ifndef X_OK #define X_OK 06 #endif #endif /* MSVC6 doesn't define these helper macros in there * might be other platforms too, so... The assumption here is that * S_ISDIR() and friends indeed are CPP macros - if that's not the * case, please adjust the conditional below to suit your platform * (and feed back the tweak you make.) */ #if !defined(S_ISDIR) #define S_ISDIR(st_mode) ((st_mode & S_IFMT) == S_IFDIR) #endif #if !defined(S_ISREG) #define S_ISREG(st_mode) ((st_mode & S_IFMT) == S_IFREG) #endif /* -------------------------------------------------------------------------- * Directory primitives: * ------------------------------------------------------------------------*/ primFun(primCreateDirectory) { /* create a directory, :: String -> IO () */ int rc; String s = evalName(IOArg(1)); if (!s) { IOFail(mkIOError(NULL, nameIllegal, "Directory.createDirectory", "illegal directory name", &IOArg(1))); } #if defined(_MSC_VER) || mingw32_HOST_OS rc = mkdir(s); #else rc = mkdir(s,0777); #endif if (rc != 0) throwErrno("Directory.createDirectory", FALSE, NO_HANDLE, &IOArg(1)); IOReturn(nameUnit); } primFun(primRemoveDirectory) { /* remove a directory */ int rc; String s = evalName(IOArg(1)); if (!s) { IOFail(mkIOError(NULL, nameIllegal, "Directory.removeDirectory", "illegal directory name", &IOArg(1))); } rc = rmdir(s); if (rc != 0) throwErrno("Directory.removeDirectory", FALSE, NO_HANDLE, &IOArg(1)); IOReturn(nameUnit); } primFun(primRemoveFile) { /* remove a file */ int rc; String s = evalName(IOArg(1)); if (!s) { IOFail(mkIOError(NULL, nameIllegal, "Directory.removeFile", "illegal file name", &IOArg(1))); } rc = unlink(s); if (rc != 0) throwErrno("Directory.removeFile", TRUE, NO_HANDLE, &IOArg(1)); IOReturn(nameUnit); } /* Pair of macros for creating temporary strings */ #if HAVE_ALLOCA # define ALLOC_STRING(x) (String)alloca(sizeof(char)*(x + 1)) # define FREE_STRING(x) #elif HAVE__ALLOCA # define ALLOC_STRING(x) (String)_alloca(sizeof(char)*(x + 1)) # define FREE_STRING(x) #else # define ALLOC_STRING(x) (String)malloc(sizeof(char)*(x + 1)) # define FREE_STRING(x) free(x) #endif primFun(primRenameDirectory) { /* rename a directory */ int rc; String tmpStr; String to; String from; tmpStr = evalName(IOArg(1)); if (!tmpStr) { IOFail(mkIOError(NULL, nameIllegal, "Directory.renameDirectory", "illegal directory name", &IOArg(1))); } to = ALLOC_STRING(strlen(tmpStr)); strcpy(to, tmpStr); from = evalName(IOArg(2)); if (!from) { FREE_STRING(to); IOFail(mkIOError(NULL, nameIllegal, "Directory.renameDirectory", "illegal directory name", &IOArg(2))); } rc = rename(from,to); FREE_STRING(to); if (rc != 0) throwErrno("Directory.renameDirectory", FALSE, NO_HANDLE, &IOArg(1)); IOReturn(nameUnit); } primFun(primRenameFile) { /* rename a file */ int rc; String tmpStr; String to; String from; tmpStr = evalName(IOArg(1)); if (!tmpStr) { IOFail(mkIOError(NULL, nameIllegal, "Directory.renameFile", "illegal file name", &IOArg(1))); } to = ALLOC_STRING(strlen(tmpStr)); strcpy(to, tmpStr); from = evalName(IOArg(2)); if (!from) { FREE_STRING(to); IOFail(mkIOError(NULL, nameIllegal, "Directory.renameFile", "illegal file name", &IOArg(2))); } if (isDirectory(from)) { FREE_STRING(to); IOFail(mkIOError(NULL, namePermDenied, "Directory.renameFile", "is a directory", &IOArg(2))); } if (isDirectory(to)) { FREE_STRING(to); IOFail(mkIOError(NULL, namePermDenied, "Directory.renameFile", "is a directory", &IOArg(1))); } rc = rename(from,to); FREE_STRING(to); if (rc != 0) throwErrno("Directory.renameFile", TRUE, NO_HANDLE, &IOArg(1)); IOReturn(nameUnit); } primFun(primGetDirectory) { /* IO String - get current directory. */ char buffer[FILENAME_MAX+1]; if ((char*)(getcwd(buffer,FILENAME_MAX)) == (char*)NULL) throwErrno("Directory.getCurrentDirectory", FALSE, NO_HANDLE, NULL); pushString(buffer); IOReturn(pop()); } primFun(primSetDirectory) { /* String -> IO () - set current directory. */ int rc; String s = evalName(IOArg(1)); if (!s) { IOFail(mkIOError(NULL, nameIllegal, "Directory.setCurrentDirectory", "illegal directory name", &IOArg(1))); } rc = chdir(s); if (rc != 0) throwErrno("Directory.setCurrentDirectory", FALSE, NO_HANDLE, &IOArg(1)); IOReturn(nameUnit); } primFun(primFileExist) { /* FilePath -> IO Bool - check to see if file exists. */ int rc; String s = evalName(IOArg(1)); struct stat st; if (!s) { IOFail(mkIOError(NULL, nameIllegal, "Directory.doesFileExist", "illegal file name", &IOArg(1))); } rc = stat(s, &st); IOBoolResult(rc == 0 && !S_ISDIR(st.st_mode) ); } primFun(primDirExist) { /* FilePath -> IO Bool - check to see if directory exists. */ String s = evalName(IOArg(1)); if (!s) { IOFail(mkIOError(NULL, nameIllegal, "Directory.doesDirectoryExist", "illegal directory name", &IOArg(1))); } IOBoolResult(isDirectory(s)); } static Bool local isDirectory(s) String s; { int rc; struct stat st; #ifdef _WIN32 /* For whatever reason, stat()ing a directory name * like "foo/" returns an error, while both "foo" and "foo/." * is fine. We want them all to be treated equal. */ int len = strlen(s); while (len > 0 && (s[len-1] == '/' || s[len-1] == '\\')) { s[len-1] = '\0'; len--; } #endif rc = stat(s, &st); return (rc==0 && S_ISDIR(st.st_mode)); } primFun(primGetPermissions) { /* FilePath -> IO (Bool,Bool,Bool,Bool) */ int rc; String s = evalName(IOArg(1)); struct stat st; int isR, isW, isX; #if __MWERKS__ && macintosh IOFail(mkIOError(NULL, nameIllegal, "Directory.primGetPermissions", "operation not supported", &IOArg(1))); #else if (!s) { IOFail(mkIOError(NULL, nameIllegal, "Directory.getPermissions", "illegal file name", &IOArg(1))); } isR = access(s, R_OK); isW = access(s, W_OK); isX = access(s, X_OK); rc = stat(s, &st); if (rc != 0) throwErrno("Directory.getPermissions", FALSE, NO_HANDLE, &IOArg(1)); IOReturn(ap(ap(ap(ap( mkTuple(4), ToBool(isR == 0)), ToBool(isW == 0)), ToBool(isX == 0 && !S_ISDIR(st.st_mode))), ToBool(isX == 0 && S_ISDIR(st.st_mode)))); #endif } #define EVAL_BOOL(x,y) \ eval(y);\ if (whnfHead==nameTrue) { \ x = TRUE; \ } else if (whnfHead==nameFalse) { \ x = FALSE; \ } else { \ IOFail(mkIOError(NULL, \ nameIllegal, \ "Directory.setPermissions", \ "illegal flag", \ NULL)); \ } #ifdef _MSC_VER #define READ_FLAG S_IREAD #define WRITE_FLAG S_IWRITE #define EXEC_FLAG S_IEXEC #else #define READ_FLAG S_IRUSR #define WRITE_FLAG S_IWUSR #define EXEC_FLAG S_IXUSR #endif #define SET_CHMOD_FLAG(x,y) (x ? y : 0) primFun(primSetPermissions) { /* FilePath -> Bool -> Bool -> Bool -> Bool -> IO () */ int rc; String str; struct stat st; Bool r; Bool w; Bool e; Bool s; #if __MWERKS__ && macintosh IOFail(mkIOError(NULL, nameIllegal, "Directory.primSetPermissions", "operation not supported", &IOArg(1))); #else EVAL_BOOL(s, IOArg(1)); EVAL_BOOL(e, IOArg(2)); EVAL_BOOL(w, IOArg(3)); EVAL_BOOL(r, IOArg(4)); str = evalName(IOArg(5)); if (!str) { IOFail(mkIOError(NULL, nameIllegal, "Directory.setPermissions", "illegal file name", &IOArg(5))); } rc = stat(str, &st); if (rc == 0) rc = chmod(str, (st.st_mode & ~(READ_FLAG|WRITE_FLAG|EXEC_FLAG)) | SET_CHMOD_FLAG(r, READ_FLAG) | SET_CHMOD_FLAG(w, WRITE_FLAG) | SET_CHMOD_FLAG(e||s, EXEC_FLAG)); if (rc != 0) throwErrno("Directory.setPermissions", TRUE, NO_HANDLE, &IOArg(5)); IOReturn(nameUnit); #endif } /* Pedantically remove these local defs. */ #undef READ_FLAG #undef WRITE_FLAG #undef EXEC_FLAG #undef SET_CHMOD_FLAG primFun(primGetDirContents) { /* FilePath -> IO [FilePath] */ #ifdef _MSC_VER /* The MS CRT doesn't provide opendir()/readdir(), but uses the 'std' MS find first/next/close group of functions for iterating over the contents of a directory. */ int rc; long dirHandle; struct _finddata_t fData; char buffer[FILENAME_MAX+20]; struct stat st; Cell ls; String fName = evalName(IOArg(1)); if (!fName) { IOFail(mkIOError(NULL, nameIllegal, "Directory.getDirectoryContents", "illegal directory name", &IOArg(1))); } if (strlen(fName) > FILENAME_MAX) { IOFail(mkIOError(NULL, nameIllegal, "Directory.getDirectoryContents", "file name too long", &IOArg(1))); } /* First, check whether the directory exists... */ if (stat(fName, &st) < 0) throwErrno("Directory.getDirectoryContents", FALSE, NO_HANDLE, &IOArg(1)); if (!S_ISDIR(st.st_mode)) { IOFail(mkIOError(NULL, nameIllegal, "Directory.getDirectoryContents", "not a directory", &IOArg(1))); } if (snprintf(buffer,sizeof(buffer)-1,"%s\\*.*",fName) < 0) { IOFail(mkIOError(NULL, nameIllegal, "Directory.getDirectoryContents", "illegal directory name", &IOArg(1))); } else { buffer[sizeof(buffer)-1] = '\0'; } dirHandle = _findfirst(buffer, &fData); rc = dirHandle; ls = nameNil; while (rc >= 0) { Cell n; push(ls); pushString(fData.name); n = ap(nameCons, pop()); ls = ap(n, pop()); rc = _findnext(dirHandle, &fData); } if (errno != ENOENT) throwErrno("Directory.getDirectoryContents", FALSE, NO_HANDLE, &IOArg(1)); /* Close and release resources */ rc = _findclose(dirHandle); if (rc == -1 && errno != ENOENT) throwErrno("Directory.getDirectoryContents", FALSE, NO_HANDLE, &IOArg(1)); IOReturn(ls); #elif HAVE_DIRENT_H /* opendir() / readdir() implementation. */ DIR* dir; struct dirent* pDir; Cell ls; String fName = evalName(IOArg(1)); if (!fName) { IOFail(mkIOError(NULL, nameIllegal, "Directory.getDirectoryContents", "illegal file name", &IOArg(1))); } dir = opendir(fName); if (dir == NULL) throwErrno("Directory.getDirectoryContents", FALSE, NO_HANDLE, &IOArg(1)); ls = nameNil; /* To ensure that the test below doesn't succeed just because the impl of readdir() 'forgot' to reset 'errno', do it ourselves. */ errno = 0; while ( (pDir = readdir(dir)) ) { Cell n; push(ls); pushString(pDir->d_name); n = ap(nameCons, pop()); ls = ap(n, pop()); } if (errno != 0 #if mingw32_HOST_OS && errno != ENOENT #endif ) { int rc = errno; closedir(dir); errno = rc; throwErrno("Directory.getDirectoryContents", FALSE, NO_HANDLE, &IOArg(1)); } closedir(dir); IOReturn(ls); #else /* Sorry, don't know how to access a directory on your platform */ IOFail(mkIOError(NULL, nameIllegal, "Directory.getDirectoryContents", "operation not supported", &IOArg(1))); #endif } primFun(primGetModTime) { /* FilePath -> IO Int{-time_t-} - get the mod. time of the file/directory. */ int rc; String s = evalName(IOArg(1)); struct stat st; if (!s) { IOFail(mkIOError(NULL, nameIllegal, "Directory.getModificationTime", "illegal file name", &IOArg(1))); } rc = stat(s, &st); if (rc < 0) throwErrno("Directory.getModificationTime", TRUE, NO_HANDLE, &IOArg(1)); IOReturn(mkInt(st.st_mtime)); } hugs98-plus-Sep2006/src/edit.c0000644006511100651110000000764107645233501014660 0ustar rossross#include #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "opts.h" #include "strutil.h" #include "machdep.h" Bool startEdit(line,nm) /* Start editor on file name at */ Int line; /* given line. Both name and line */ String nm; { /* or just line may be zero */ String editorCmd; String fullNm; Bool expandedName = FALSE; Bool syncEdit = TRUE; Bool useShell = FALSE; String he; String ec; unsigned int roomReqd = 0; unsigned int nmLen, lineLen, fullNmLen; /* First off, check whether we have actually got a plausible editor * available. On a Mac, files have creator information, telling which * program to launch to, so an editor named to the empty string "" * is often desirable. */ if (!hugsEdit #if !(defined(macintosh)) || *hugsEdit == '\0' #endif ) { ERRMSG(0) "Hugs is not configured to use an editor" EEND; } /* More sanity checks */ if (nm == NULL) { return FALSE; } fullNm = RealPath(nm); fullNmLen = strlen(fullNm); nmLen = strlen(nm); lineLen = 1 + (line == 0 ? 0 : (unsigned int)log10((double)line)); he = hugsEdit; /* Compute the length of the expanded 'hugsEdit' string */ while (*he) { if (*he++ == '%') { if (*he == 's') { /* assume quotes are always put around the filename. */ roomReqd += nmLen + 2; expandedName = TRUE; } else if (*he == 'f') { /* assume quotes are always put around the filename. */ roomReqd += fullNmLen + 2; expandedName = TRUE; } else if ( *he == 'd' ) { roomReqd += lineLen; } else if ( *he == '%' ) { /* %% is contracted to % in the expanded string */ roomReqd++; } else { roomReqd += 2; } he++; } else { roomReqd++; } } if (!expandedName) { /* include room for quotes and an extra space */ roomReqd += nmLen + 3; } editorCmd = (String)malloc(sizeof(char) * (roomReqd + 1)); if (editorCmd == NULL) { Printf("Warning: Unable to start editor\n"); return FALSE; } /* Given a properly sized output buffer, perform the expansion */ expandedName = FALSE; ec = editorCmd; he = hugsEdit; /* If the editor command is prefixed with '&', the editor is * started up asynchronously (the default is for Hugs to block * and wait for the editor to exit). * * If the editor command is prefixed with '!', then the editor is * invoked by going via the shell. */ while (1) { if (*he == '&') { syncEdit = FALSE; he++; } else if (*he == '!') { useShell = TRUE; he++; } else { break; } } while (*he) { if (*he=='%') { if (*++he=='d') { sprintf(ec,"%d",(line ? line : 1)); ec += lineLen; he++; } else if (*he == 's' || *he == 'f') { /* Put quotes around it if the %s occurrence surrounded by wspace only. */ Bool useQuotes = isspace(he[-2]) && (he[1] == '\0' || isspace(he[1])); if (useQuotes) *ec++='\"'; if (*he == 's') { strcpy(ec,nm); ec += nmLen; } else { strcpy(ec,fullNm); ec += fullNmLen; } if (useQuotes) *ec++='\"'; *ec='\0'; expandedName = TRUE; he++; } else if (*he == '%') { /* Unescape % */ *ec++ = '%'; he++; } else { *ec++ = '%'; *ec++ = *he++; } } else { *ec++ = *he++; } } if (!expandedName) { /* If file name was not included, add it. */ *ec++=' '; /* Protect the filename by putting quotes around it */ *ec++='\"'; strcpy(ec,nm); ec += nmLen; *ec++='\"'; } /* Terminate the string and go! */ *ec = '\0'; if (shellEsc(editorCmd,syncEdit/*sync*/, useShell/*sep console*/)) { Printf("Warning: Editor terminated abnormally\n"); free(editorCmd); return FALSE; } free(editorCmd); return syncEdit; } hugs98-plus-Sep2006/src/errors.c0000644006511100651110000002137010465137047015244 0ustar rossross/* -------------------------------------------------------------------------- * Error handling support functions * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "output.h" #include "opts.h" #include "goal.h" #include "char.h" #include "evaluator.h" /* everybody() proto only */ #include jmp_buf catch_error; /* jump buffer for error trapping */ /* -------------------------------------------------------------------------- * Error handling: * ------------------------------------------------------------------------*/ Void stopAnyPrinting() { /* terminate printing of expression,*/ if (printing) { /* after successful termination or */ printing = FALSE; /* runtime error (e.g. interrupt) */ Putchar('\n'); if (showStats) { #define plural(v) v, (v==1?"":"s") #if HUGS_FOR_WINDOWS { int svColor = SetForeColor(BLUE); #endif Printf("(%lu reduction%s, ",plural(numReductions)); Printf("%lu cell%s",plural(numCells)); if (numGcs>0) Printf(", %u garbage collection%s",plural(numGcs)); Printf(")\n"); #if HUGS_FOR_WINDOWS SetForeColor(svColor); } #endif #undef plural } #if OBSERVATIONS printObserve(ALLTAGS); if (obsCount) { ERRMSG(0) "Internal: observation sanity counter > 0\n" EEND; } if (showStats){ Int n = countObserve(); if (n > 0) Printf("%d observations recorded\n", n); } #endif FlushStdout(); garbageCollect(); } } Void errHead(l) /* print start of error message */ Int l; { failed(); /* failed to reach target ... */ stopAnyPrinting(); FPrintf(errorStream,"ERROR"); /* * Encapsulating the filename portion inside of d-quotes makes it * a tad easier for an Emacs-mode to decipher the location of the error. * -- sof 9/01. */ if (scriptFile) { setLastEdit(scriptFile,l); #ifdef HUGS_FOR_WINDOWS FPrintf(errorStream," "); WinHugsFilename(scriptFile, l); #else FPrintf(errorStream," \"%s\"",scriptFile); if (l) FPrintf(errorStream,":%d",l); #endif scriptFile = 0; } FPrintf(errorStream," - "); FFlush(errorStream); } Void errFail() { /* terminate error message and */ Putc('\n',errorStream); /* produce exception to return to */ FFlush(errorStream); /* main command loop */ #if USE_THREADS stopEvaluatorThread(); #endif /* USE_THREADS */ longjmp(catch_error,1); } Void errAbort() { /* altern. form of error handling */ failed(); /* used when suitable error message*/ stopAnyPrinting(); /* has already been printed */ errFail(); } Void internal(msg) /* handle internal error */ String msg; { #if HUGS_FOR_WINDOWS char buf[300]; sprintf(buf,"INTERNAL ERROR: %s",msg); ErrorBox(buf); #endif failed(); stopAnyPrinting(); Printf("INTERNAL ERROR: %s\n",msg); Printf("Please report this Hugs bug to "); #if HUGS_FOR_WINDOWS WinHugsHyperlink("http://hackage.haskell.org/trac/hugs"); #else Printf("http://hackage.haskell.org/trac/hugs"); #endif Printf("\n"); FlushStdout(); #if USE_THREADS stopEvaluatorThread(); #endif /* USE_THREADS */ longjmp(catch_error,1); } Void fatal(msg) /* handle fatal error */ String msg; { #if HUGS_FOR_WINDOWS char buf[300]; sprintf(buf,"FATAL ERROR: %s",msg); ErrorBox(buf); #endif FlushStdout(); Printf("\nFATAL ERROR: %s\n",msg); everybody(EXIT); exit(1); } /* -------------------------------------------------------------------------- * Break interrupt handler: * ------------------------------------------------------------------------*/ sigHandler(breakHandler) { /* respond to break interrupt */ #if HUGS_FOR_WINDOWS ErrorBox("Interrupted!"); #endif #if HUGS_FOR_WINDOWS FPrintf(errorStream,"{Interrupted!}\n"); #else Hilite(); Printf("{Interrupted!}\n"); Lolite(); #endif breakOn(TRUE); /* reinstall signal handler - redundant on BSD systems */ /* but essential on POSIX (and other?) systems */ everybody(BREAK); failed(); stopAnyPrinting(); FlushStdout(); clearerr(stdin); #if USE_THREADS stopEvaluatorThread(); #endif /* USE_THREADS */ longjmp(catch_error,1); sigResume;/*NOTREACHED*/ } /* -------------------------------------------------------------------------- * Compiler output * We can redirect compiler output (prompts, error messages, etc) by * tweaking these functions. * ------------------------------------------------------------------------*/ #if REDIRECT_OUTPUT && !HUGS_FOR_WINDOWS static Bool disableOutput = FALSE; /* redirect output to buffer? */ #if HAVE_STDARG_H #include #else #include #endif /* ----------------------------------------------------------------------- */ #define BufferSize 10000 /* size of redirected output buffer */ typedef struct _HugsStream { char buffer[BufferSize]; /* buffer for redirected output */ Int next; /* next space in buffer */ } HugsStream; static Void local vBufferedPrintf Args((HugsStream*, const char*, va_list)); static Void local bufferedPutchar Args((HugsStream*, int)); static String local bufferClear Args((HugsStream *stream)); static Void local vBufferedPrintf(stream, fmt, ap) HugsStream* stream; const char* fmt; va_list ap; { Int spaceLeft = BufferSize - stream->next; char* p = &stream->buffer[stream->next]; Int charsAdded = vsnprintf(p, spaceLeft, fmt, ap); if (0 <= charsAdded && charsAdded < spaceLeft) stream->next += charsAdded; #if 1 /* we can either buffer the first n chars or buffer the last n chars */ else stream->next = 0; #endif } static Void local bufferedPutchar(stream, c) HugsStream *stream; int c; { if (BufferSize - stream->next >= 2) { stream->buffer[stream->next++] = c; stream->buffer[stream->next] = '\0'; } } static String local bufferClear(stream) HugsStream *stream; { if (stream->next == 0) { return ""; } else { stream->next = 0; return stream->buffer; } } /* ----------------------------------------------------------------------- */ static HugsStream outputStream; /* ADR note: * We rely on standard C semantics to initialise outputStream.next to 0. */ Void hugsEnableOutput(f) Bool f; { disableOutput = !f; } String hugsClearOutputBuffer() { return bufferClear(&outputStream); } #if HAVE_STDARG_H Void hugsPrintf(const char *fmt, ...) { va_list ap; /* pointer into argument list */ va_start(ap, fmt); /* make ap point to first arg after fmt */ if (!disableOutput) { vprintf(fmt, ap); } else { vBufferedPrintf(&outputStream, fmt, ap); } va_end(ap); /* clean up */ } #else Void hugsPrintf(fmt, va_alist) const char *fmt; va_dcl { va_list ap; /* pointer into argument list */ va_start(ap); /* make ap point to first arg after fmt */ if (!disableOutput) { vprintf(fmt, ap); } else { vBufferedPrintf(&outputStream, fmt, ap); } va_end(ap); /* clean up */ } #endif Void hugsPutchar(c) int c; { if (!disableOutput) { putchar(c); } else { bufferedPutchar(&outputStream, c); } } Void hugsFlushStdout() { if (!disableOutput) { fflush(stdout); } } Void hugsFFlush(fp) FILE* fp; { if (!disableOutput) { fflush(fp); } } #if HAVE_STDARG_H Void hugsFPrintf(FILE *fp, const char* fmt, ...) { va_list ap; va_start(ap, fmt); if (!disableOutput) { vfprintf(fp, fmt, ap); } else { vBufferedPrintf(&outputStream, fmt, ap); } va_end(ap); } #else Void hugsFPrintf(FILE *fp, const char* fmt, va_list) FILE* fp; const char* fmt; va_dcl { va_list ap; va_start(ap); if (!disableOutput) { vfprintf(fp, fmt, ap); } else { vBufferedPrintf(&outputStream, fmt, ap); } va_end(ap); } #endif Void hugsPutc(c, fp) int c; FILE* fp; { if (!disableOutput) { fputc(c,fp); } else { bufferedPutchar(&outputStream, c); } } #endif /* REDIRECT_OUTPUT && !HUGS_FOR_WINDOWS */ hugs98-plus-Sep2006/src/errors.h0000644006511100651110000000735610305613356015254 0ustar rossross/* -------------------------------------------------------------------------- * Error handling support functions * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: errors.h,v $ * $Revision: 1.13 $ * $Date: 2005/09/01 14:57:50 $ * ------------------------------------------------------------------------*/ #ifndef __ERRORS_H__ #define __ERRORS_H__ extern Void internal Args((String)) HUGS_noreturn; extern Void fatal Args((String)) HUGS_noreturn; extern Void stopAnyPrinting Args((Void)); /*--------------------------------------------------------------------------- * Compiler output * Tweaking this lets us redirect prompts, error messages, etc - but has no * effect on output of Haskell programs (which should use hPutStr and friends). *-------------------------------------------------------------------------*/ #if REDIRECT_OUTPUT extern Void hugsPrintf Args((const char *, ...)); extern Void hugsPutchar Args((int)); extern Void hugsFlushStdout Args((Void)); extern Void hugsEnableOutput Args((Bool)); extern String hugsClearOutputBuffer Args((Void)); extern Void hugsFFlush Args((FILE*)); extern Void hugsFPrintf Args((FILE*, const char*, ...)); extern Void hugsPutc Args((int, FILE*)); #define Printf hugsPrintf #define Putchar hugsPutchar #define FlushStdout hugsFlushStdout #define EnableOutput hugsEnableOutput #define ClearOutputBuffer hugsClearOutputBuffer #define FFlush hugsFFlush #define FPrintf hugsFPrintf #define Putc hugsPutc #else /* !REDIRECT_OUTPUT */ #define Printf printf #define Putchar putchar #define FlushStdout() fflush(stdout) #define EnableOutput(f) doNothing() #define ClearOutputBuffer() 0 #define FFlush fflush #define FPrintf fprintf #define Putc putc #endif /* REDIRECT_OUTPUT */ /*-------------------------------------------------------------------------*/ #if HUGS_FOR_WINDOWS /* output to stderr uses RED color already */ #undef Hilite #undef Lolite #define Hilite() doNothing() #define Lolite() doNothing() #define SetForeColor(c) WinHugsColor(c); #define errorStream stderr #else #define Hilite() doNothing() #define Lolite() doNothing() #define errorStream stdout #endif #define ERRMSG(l) Hilite(); errHead(l); FPrintf(errorStream, #define EEND ); Lolite(); errFail() #define EEND_NORET ); Lolite() #define ETHEN ); #define ERRTEXT Hilite(); FPrintf(errorStream, #define ERREXPR(e) Hilite(); printExp(errorStream,e); Lolite() #define ERRTYPE(e) Hilite(); printType(errorStream,e); Lolite() #define ERRCONTEXT(qs) Hilite(); printContext(errorStream,qs); Lolite() #define ERRPRED(pi) Hilite(); printPred(errorStream,pi); Lolite() #define ERRKIND(k) Hilite(); printKind(errorStream,k); Lolite() #define ERRKINDS(ks) Hilite(); printKinds(errorStream,ks); Lolite() #define ERRFD(fd) Hilite(); printFD(errorStream,fd); Lolite() extern Void errHead Args((Int)); /* in main.c */ extern Void errFail Args((Void)) HUGS_noreturn; extern Void errAbort Args((Void)); extern sigProto(breakHandler); extern Bool breakOn Args((Bool)); /* in machdep.c */ #include extern jmp_buf catch_error; /* jump buffer for error trapping */ /*-------------------------------------------------------------------------*/ #endif /* __ERRORS_H__ */ hugs98-plus-Sep2006/src/evaluator.c0000644006511100651110000001566610213332370015730 0ustar rossross/* * The Hugs evaluator / command interpreter + support functions. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * */ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "script.h" #include "output.h" #include "strutil.h" #include "opts.h" #include "machdep.h" #include "evaluator.h" #if HAVE_WINDOWS_H #include #endif /* -------------------------------------------------------------------------- * Flags and options: * * Note: definitions here are restricted to interpreter state that's independent * of the UI used. * * ------------------------------------------------------------------------*/ Int hpSize = DEFAULTHEAP; /* Desired heap size */ String hugsPath = 0; /* String for file search path */ String hugsSuffixes = 0; /* Source filename suffixes */ /* -------------------------------------------------------------------------- * Evaluator initialization: * ------------------------------------------------------------------------*/ Void startEvaluator(Void) { initScripts(); hugsPath = uniqPath(strCopy(HUGSPATH)); hugsSuffixes = strCopy(HUGSSUFFIXES); #if HSCRIPT hscriptSuffixes(); #endif } /* -------------------------------------------------------------------------- * Shutdown evaluator. * ------------------------------------------------------------------------*/ Void stopEvaluator() { /* Let go of dynamic storage */ if (hugsPath) { free(hugsPath); hugsPath=0; } if (hugsSuffixes) { free(hugsSuffixes); hugsSuffixes=0; } if (prompt) { free(prompt); prompt=0; } if (repeatStr) { free(repeatStr); repeatStr=0; } } Void evaluator(m) Module m; { /* evaluate expr and print value */ Type type, bd, t; Kinds ks = NIL; Cell temp = NIL; setCurrModule(m); scriptFile = 0; startNewScript(0); /* Enables recovery of storage */ /* allocated during evaluation */ parseExp(); checkExp(); defaultDefns = evalDefaults; type = typeCheckExp(TRUE); if (isPolyType(type)) { ks = polySigOf(type); bd = monotypeOf(type); } else bd = type; if (whatIs(bd)==QUAL) { ERRMSG(0) "Unresolved overloading" ETHEN ERRTEXT "\n*** Type : " ETHEN ERRTYPE(type); ERRTEXT "\n*** Expression : " ETHEN ERREXPR(inputExpr); ERRTEXT "\n" EEND; } #if PROFILING if (profiling) profilerLog("profile.hp"); numReductions = 0; garbageCollect(); #endif #if WANT_TIMER updateTimers(); #endif #if IO_MONAD if ((t = getProgType(ks,type)) != 0) { if (displayIO) { Cell printer = namePrint; if (useShow) { Cell d = resolvePred(ks,ap(classShow,t)); if (isNull(d)) { printing = FALSE; ERRMSG(0) "Cannot find \"show\" function for IO result:" ETHEN ERRTEXT "\n*** Expression : " ETHEN ERREXPR(inputExpr); ERRTEXT "\n*** Of type : " ETHEN ERRTYPE(type); ERRTEXT "\n" EEND; } printer = ap(nameShowsPrec,d); } printer = ap(ap(nameFlip,ap(printer,mkInt(MIN_PREC))),nameNil); printer = ap(ap(nameComp,namePutStr),printer); inputExpr = ap(ap(nameIOBind,inputExpr),printer); } } else #endif { Cell printer = namePrint; if (useShow) { Cell d = resolvePred(ks,ap(classShow,bd)); if (isNull(d)) { printing = FALSE; ERRMSG(0) "Cannot find \"show\" function for:" ETHEN ERRTEXT "\n*** Expression : " ETHEN ERREXPR(inputExpr); ERRTEXT "\n*** Of type : " ETHEN ERRTYPE(type); ERRTEXT "\n" EEND; } printer = ap(nameShowsPrec,d); } inputExpr = ap(ap(ap(printer,mkInt(MIN_PREC)),inputExpr),nameNil); inputExpr = ap(namePutStr,inputExpr); } inputExpr = ap(nameIORun,inputExpr); compileExp(); clearStack(); run(inputCode,sp); /* Build graph for redex */ #if DEBUG_CODE if (debugCode) { Printf("evaluator() builds: "); printExp(stdout,top()); Putchar('\n'); } #endif numCells = 0; numReductions = 0; numGcs = 0; printing = TRUE; #if OBSERVATIONS appNum = 0; obsCount = 0; clearAllBreak(); clearObserve(); #endif consGC = FALSE; if (nonNull(type) && addType) { onto(NIL); pushed(0) = pushed(1); pushed(1) = type; if (nonNull(temp = evalWithNoError(pop()))) { abandon("Program execution",temp); } drop(); if (whnfHead == nameRight) { #if HUGS_FOR_WINDOWS INT svColor = SetForeColor(BLUE); #endif Printf(" :: "); printType(stdout,pop()); #if HUGS_FOR_WINDOWS SetForeColor(svColor); #endif } } else { if (nonNull(temp = evalWithNoError(pop()))) { abandon("Program execution",temp); } } stopAnyPrinting(); } /* -------------------------------------------------------------------------- * Read in prelude module(s): * ------------------------------------------------------------------------*/ Void loadPrelude() { /* load in the Prelude module(s). */ String prelLocation; Bool listFlg; if (!hugsPath) fatal("Hugs search path not defined"); if (!( prelLocation = findMPathname(STD_PRELUDE_HUGS)) ) { Printf("%s not found on current path: \"%s\"\n", STD_PRELUDE_HUGS, hugsPath); fatal("Unable to load prelude implementation"); } addScriptName(prelLocation, FALSE); /* add the H98 Prelude module to the stack */ if (!( prelLocation = findMPathname(STD_PRELUDE)) ) { Printf("%s not found on current path: \"%s\"\n", STD_PRELUDE, hugsPath); fatal("Unable to load prelude"); } addScriptName(prelLocation, FALSE); everybody(INSTALL); /* Hack to temporarily turn off 'listScripts' feature. */ listFlg = listScripts; listScripts = FALSE; readScripts(0); listScripts = listFlg; } /* -------------------------------------------------------------------------- * Send message to each component of system: * ------------------------------------------------------------------------*/ Void everybody(what) /* send command `what' to each component of*/ Int what; { /* system to respond as appropriate ... */ machdep(what); /* The order of calling each component is */ storage(what); /* important for the INSTALL command */ substitution(what); input(what); staticAnalysis(what); typeChecker(what); compiler(what); machine(what); charOps(what); builtIn(what); controlFuns(what); plugins(what); ffi(what); script(what); } hugs98-plus-Sep2006/src/evaluator.h0000644006511100651110000000125007747453740015744 0ustar rossross/* * The Hugs evaluator / command interpreter + support functions. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * */ #ifndef __EVALUATOR_H__ #define __EVALUATOR_H__ extern Void startEvaluator Args((Void)); extern Void stopEvaluator Args((Void)); extern Void evaluator Args((Module)); extern Void everybody Args((Int)); extern Void loadPrelude Args((Void)); #endif /* __EVALUATOR_H__ */ hugs98-plus-Sep2006/src/ffi.c0000644006511100651110000006747410255773534014517 0ustar rossross/* -------------------------------------------------------------------------- * This is the Hugs foreign function interface * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: ffi.c,v $ * $Revision: 1.40 $ * $Date: 2005/06/21 11:17:48 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "output.h" #include "strutil.h" /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Void local foreignType Args((Int,Type)); #ifdef DOTNET static Cell local foreignTypeTag Args((Int,Type)); #endif static Void local foreignGet Args((Int,Type,String,Int)); static Void local foreignPut Args((Int,Type,String,Int)); static Void local ffiInclude Args((Text)); static Void local ffiDeclare Args((Int,Type,String,Int)); static Void local ffiDeclareList Args((Int,List,String)); static Void local foreignType Args((Int,Type)); static Void local ffiGetList Args((Int,List,String)); static Void local ffiPutList Args((Int,List,String)); static Void local ffiCallFun Args((Int,Text,List,List)); static Void local ffiDeclareFun Args((Int,Text,Bool,Bool,List,Type)); static Void local ffiFunTypeCast Args((Int,List,Type)); static Void local ffiPrimProto Args((Text,Int)); static Void local ffiPrimHeader Args((Text,Int)); static Void local ffiReturn Args((Type,String,Int)); static FILE* out = NIL; /* file we're generating code into */ static List includes = NIL; /* files already #included */ Void ffi(what) Int what; { switch (what) { case RESET : if (out) { fclose(out); out = NIL; } includes = NIL; break; } } static String ffiFlags = 0; /* extra flags for compilation command line */ Void ffiSetFlags(s) String s; { if (s == 0) return; if (ffiFlags) { Int l = strlen(ffiFlags); ffiFlags=(char *)realloc(ffiFlags,l+strlen(s)+2); if (ffiFlags==0) { ERRMSG(0) "String storage space exhausted" EEND; } ffiFlags[l] = ' '; strcpy(ffiFlags+l+1,s); } else { ffiFlags = strCopy(s); } } static String cppDirectives = 0; /* extra C preprocessor directives */ Void ffiAddCppInclude(String s) { Int l; Int needed = strlen(s)+11; if (cppDirectives) { l = strlen(cppDirectives); cppDirectives = (char *)realloc(cppDirectives,l+needed); } else { l = 0; cppDirectives = (char *)malloc(needed); } if (cppDirectives==0) { ERRMSG(0) "String storage space exhausted" EEND; } sprintf(cppDirectives+l, "#include %s\n", s); } Bool foreignNeedStubs(imps,exps) List imps; List exps; { #ifndef DOTNET return (nonNull(imps) || nonNull(exps)); #else if (isNull(exps)) { List xs; for (xs = imps; nonNull(xs); xs=tl(xs)) { if (isName(hd(xs)) && ((name(hd(xs)).foreignFlags & FFI_CCONV_DOTNET) == 0) ) { return TRUE; } } return FALSE; } else { return TRUE; } #endif } Void foreignHeader(fn) String fn; { String fnm = mkFFIFilename(fn); FILE* f = fopen(fnm,"w"); if (f == NULL) { ERRMSG(0) "Unable to create file '%s'", fnm EEND; } out = f; fprintf(out,"/* Machine generated file, do not modify */\n"); fprintf(out,"#include \n"); fprintf(out,"#include \"HsFFI.h\"\n"); if (cppDirectives) fprintf(out,"%s",cppDirectives); fprintf(out,"\n"); fprintf(out,"static HugsAPI5 *hugs = 0;\n"); } Void foreignFooter(fn,mn,is,es) String fn; Text mn; List is; List es; { List xs = NIL; fprintf(out,"\n"); /* Table of all primitives generated by foreign imports */ fprintf(out,"static struct hugs_primitive hugs_primTable[] = {\n"); for(xs=is; nonNull(xs); xs=tl(xs)) { Name n = hd(xs); #ifdef DOTNET if (name(n).foreignFlags & FFI_CCONV_DOTNET != 0) continue; #endif fprintf(out," {\"%s\", ",textToStr(name(n).text)); fprintf(out,"%d, ",name(n).arity); fprintf(out,"hugsprim_%s_%d},\n",textToStr(name(n).extFun),name(n).foreignId); } for(xs=es; nonNull(xs); xs=tl(xs)) { Name n = hd(xs); Text ext = name(n).extFun; Bool dynamic = inventedText(ext); if (dynamic) { fprintf(out," {\"%s\", 3, ",textToStr(name(n).text)); fprintf(out,"hugsprim_%s},\n",textToStr(name(n).extFun)); } } fprintf(out,"};\n"); fprintf(out,"\n"); /* The control function: rebuilds stable ptr table on RESET */ fprintf(out, "static void hugs_primControl(int);\n" "static void hugs_primControl(what)\n" "int what; {\n"); if (nonNull(es)) { fprintf(out, " switch (what) {\n" " case %d:\n", RESET ); } for(xs=es; nonNull(xs); xs=tl(xs)) { Name n = hd(xs); Text ext = name(n).extFun; Bool dynamic = inventedText(ext); if (!dynamic) { fprintf(out, " hugs_stable_for_%s = ", textToStr(ext)); fprintf(out, "hugs->lookupName("); fprintf(out, "\"%s\"", textToStr(module(name(n).mod).text)); fprintf(out, ", \"%s\"", textToStr(name(n).text)); fprintf(out, ");\n"); } } if (nonNull(es)) { fprintf(out," }\n"); } fprintf(out, "}\n"); /* For use as a plugin, rename the initialization function with a name */ /* derived from the module name, but abbreviated for limited linkers. */ /* example: Foreign.Marshal.Alloc yields initFMAlloc() */ fprintf(out, "\n"); fprintf(out, "#ifdef STATIC_LINKAGE\n"); fprintf(out, "#define initModule init"); { String s = textToStr(mn); String next; while ((next = strchr(s, '.')) != NULL) { fprintf(out, "%c", s[0]); s = next+1; } fprintf(out, "%s\n", s); } fprintf(out, "#endif\n"); fprintf(out, "\n"); /* Boilerplate initialization function */ fprintf(out, "static struct hugs_primInfo hugs_prims = { hugs_primControl, hugs_primTable, 0 };\n" "\n" "#ifdef __cplusplus\n" "extern \"C\" {\n" "#endif\n" "#ifndef __cplusplus\n" "DLLEXPORT(int) HugsAPIVersion(void);\n" "#endif\n" "DLLEXPORT(int) HugsAPIVersion() {return (%d);}\n" "DLLEXPORT(void) initModule(HugsAPI5 *);\n" "DLLEXPORT(void) initModule(HugsAPI5 *hugsAPI) {\n" " hugs = hugsAPI;\n" " hugs->registerPrims(&hugs_prims);\n" ,HUGS_API_VERSION); fprintf(out, "}\n" "#ifdef __cplusplus\n" "}\n" "#endif\n" "\n"); fclose(out); out = NIL; compileAndLink(fn, ffiFlags); if (ffiFlags) { free(ffiFlags); ffiFlags=0; } } #ifdef DOTNET static Cell foreignTypeTag(l,t) Int l; Type t; { if (t == typeUnit) return mkInt(FFI_TYPE_UNIT); else if (t == typeChar) return mkInt(FFI_TYPE_CHAR); else if (t == typeInt) return mkInt(FFI_TYPE_INT); else if (t == typeInt8) return mkInt(FFI_TYPE_INT8); else if (t == typeInt16) return mkInt(FFI_TYPE_INT16); else if (t == typeInt32) return mkInt(FFI_TYPE_INT32); else if (t == typeInt64) return mkInt(FFI_TYPE_INT64); else if (t == typeWord8) return mkInt(FFI_TYPE_WORD8); else if (t == typeWord16) return mkInt(FFI_TYPE_WORD16); else if (t == typeWord32) return mkInt(FFI_TYPE_WORD32); else if (t == typeWord64) return mkInt(FFI_TYPE_WORD64); else if (t == typeFloat) return mkInt(FFI_TYPE_FLOAT); else if (t == typeDouble) return mkInt(FFI_TYPE_DOUBLE); else if (t == typeBool) return mkInt(FFI_TYPE_BOOL); else if (t == typeAddr) return mkInt(FFI_TYPE_ADDR); else if (getHead(t) == typePtr) return mkInt(FFI_TYPE_PTR); else if (getHead(t) == typeFunPtr) return mkInt(FFI_TYPE_FUNPTR); else if (getHead(t) == typeForeign) return mkInt(FFI_TYPE_FOREIGN); else if (getHead(t) == typeStable) return mkInt(FFI_TYPE_STABLE); else if (getHead(t) == typeObject) return mkInt(FFI_TYPE_OBJECT); else if (getHead(t) == typeList && nthArg(1,t) == typeChar) return mkInt(FFI_TYPE_STRING); else { ERRMSG(l) "Illegal foreign type" ETHEN ERRTEXT " \"" ETHEN ERRTYPE(t); ERRTEXT "\"" EEND; } return 0; } #endif static Void local foreignType(l,t) Int l; Type t; { if (t == typeChar) fprintf(out,"HsChar"); else if (t == typeInt) fprintf(out,"HsInt"); else if (t == typeInt8) fprintf(out,"HsInt8"); else if (t == typeInt16) fprintf(out,"HsInt16"); else if (t == typeInt32) fprintf(out,"HsInt32"); else if (t == typeInt64) fprintf(out,"HsInt64"); else if (t == typeWord8) fprintf(out,"HsWord8"); else if (t == typeWord16) fprintf(out,"HsWord16"); else if (t == typeWord32) fprintf(out,"HsWord32"); else if (t == typeWord64) fprintf(out,"HsWord64"); else if (t == typeFloat) fprintf(out,"HsFloat"); else if (t == typeDouble) fprintf(out,"HsDouble"); else if (t == typeBool) fprintf(out,"HsBool"); else if (t == typeAddr) fprintf(out,"HsAddr"); else if (getHead(t) == typePtr) fprintf(out,"HsPtr"); else if (getHead(t) == typeFunPtr) fprintf(out,"HsFunPtr"); else if (getHead(t) == typeForeign)fprintf(out,"HugsForeign"); else if (getHead(t) == typeStable) fprintf(out,"HsStablePtr"); #ifdef DOTNET else if (getHead(t) == typeObject) fprintf(out,"HsPtr"); #endif else { ERRMSG(l) "Illegal foreign type" ETHEN ERRTEXT " \"" ETHEN ERRTYPE(t); ERRTEXT "\"" EEND; } } static Void local foreignGet(l,t,nm,num) Int l; Type t; String nm; Int num; { if (t == typeUnit) fprintf(out,"hugs->getUnit();\n"); else if (t == typeChar) fprintf(out,"%s%d = hugs->getChar();\n", nm, num); else if (t == typeInt) fprintf(out,"%s%d = hugs->getInt();\n", nm, num); else if (t == typeInt8) fprintf(out,"%s%d = hugs->getInt8();\n", nm, num); else if (t == typeInt16) fprintf(out,"%s%d = hugs->getInt16();\n", nm, num); else if (t == typeInt32) fprintf(out,"%s%d = hugs->getInt32();\n", nm, num); else if (t == typeInt64) fprintf(out,"%s%d = hugs->getInt64();\n", nm, num); else if (t == typeWord8) fprintf(out,"%s%d = hugs->getWord8();\n", nm, num); else if (t == typeWord16) fprintf(out,"%s%d = hugs->getWord16();\n", nm, num); else if (t == typeWord32) fprintf(out,"%s%d = hugs->getWord32();\n", nm, num); else if (t == typeWord64) fprintf(out,"%s%d = hugs->getWord64();\n", nm, num); else if (t == typeFloat) fprintf(out,"%s%d = hugs->getFloat();\n", nm, num); else if (t == typeDouble) fprintf(out,"%s%d = hugs->getDouble();\n", nm, num); else if (t == typeBool) fprintf(out,"%s%d = hugs->getBool();\n", nm, num); else if (t == typeAddr) fprintf(out,"%s%d = hugs->getAddr();\n", nm, num); else if (getHead(t) == typePtr) fprintf(out,"%s%d = hugs->getPtr();\n", nm, num); else if (getHead(t) == typeFunPtr) fprintf(out,"%s%d = hugs->getFunPtr();\n", nm, num); else if (getHead(t) == typeForeign)fprintf(out,"%s%d = hugs->getForeign();\n", nm, num); else if (getHead(t) == typeStable) fprintf(out,"%s%d = hugs->getStablePtr4();\n", nm, num); #ifdef DOTNET else if (getHead(t) == typeObject) fprintf(out,"%s%d = hugs->getPtr();\n", nm, num); #endif else { ERRMSG(l) "Illegal outbound (away from Haskell) type" ETHEN ERRTEXT " \"" ETHEN ERRTYPE(t); ERRTEXT "\"" EEND; } } static Void local foreignPut(l,t,nm,num) Int l; Type t; String nm; Int num; { if (t == typeUnit) fprintf(out,"\n"); else if (t == typeChar) fprintf(out,"hugs->putChar(%s%d);\n", nm, num); else if (t == typeInt) fprintf(out,"hugs->putInt(%s%d);\n", nm, num); else if (t == typeInt8) fprintf(out,"hugs->putInt8(%s%d);\n", nm, num); else if (t == typeInt16) fprintf(out,"hugs->putInt16(%s%d);\n", nm, num); else if (t == typeInt32) fprintf(out,"hugs->putInt32(%s%d);\n", nm, num); else if (t == typeInt64) fprintf(out,"hugs->putInt64(%s%d);\n", nm, num); else if (t == typeWord8) fprintf(out,"hugs->putWord8(%s%d);\n", nm, num); else if (t == typeWord16) fprintf(out,"hugs->putWord16(%s%d);\n", nm, num); else if (t == typeWord32) fprintf(out,"hugs->putWord32(%s%d);\n", nm, num); else if (t == typeWord64) fprintf(out,"hugs->putWord64(%s%d);\n", nm, num); else if (t == typeFloat) fprintf(out,"hugs->putFloat(%s%d);\n", nm, num); else if (t == typeDouble) fprintf(out,"hugs->putDouble(%s%d);\n", nm, num); else if (t == typeBool) fprintf(out,"hugs->putBool(%s%d);\n", nm, num); else if (t == typeAddr) fprintf(out,"hugs->putAddr(%s%d);\n", nm, num); else if (getHead(t) == typePtr) fprintf(out,"hugs->putPtr(%s%d);\n", nm, num); else if (getHead(t) == typeFunPtr) fprintf(out,"hugs->putFunPtr(%s%d);\n", nm, num); else if (getHead(t) == typeForeign)fprintf(out,"hugs->putForeign(%s%d);\n", nm, num); else if (getHead(t) == typeStable) fprintf(out,"hugs->putStablePtr4(%s%d);\n", nm, num); #ifdef DOTNET else if (getHead(t) == typeObject) fprintf(out,"hugs->putPtr(%s%d);\n", nm, num); #endif else { ERRMSG(l) "Illegal inbound (coming into Haskell) type" ETHEN ERRTEXT " \"" ETHEN ERRTYPE(t); ERRTEXT "\"" EEND; } } static Void local ffiInclude(fn) /* Add #include */ Text fn; { if (fn != -1 && !varIsMember(fn,includes)) { fprintf(out, "#include \"%s\"\n", textToStr(fn)); includes = cons(mkVar(fn),includes); } } static Void local ffiDeclare(line,ty,prefix,i) /* Declare variable */ Int line; Type ty; String prefix; Int i; { if (ty != typeUnit) { fprintf(out," "); foreignType(line,ty); fprintf(out," %s%d;\n",prefix,i); } } static Void local ffiReturn(ty,prefix,i) /* Return variable */ Type ty; String prefix; Int i; { if (ty != typeUnit) { fprintf(out," return %s%d;\n",prefix,i); } else { fprintf(out," return;\n"); } } static Void local ffiDeclareList(line,tys,prefix) /* Declare variables */ Int line; List tys; String prefix; { Int i; for(i=1; nonNull(tys); tys=tl(tys),++i) { ffiDeclare(line,hd(tys),prefix,i); } } static Void local ffiGetList(line,tys,prefix) /* Get values from Haskell */ Int line; List tys; String prefix; { Int i; for(i=1; nonNull(tys); tys=tl(tys),++i) { fprintf(out," "); foreignGet(line,hd(tys),prefix,i); } } static Void local ffiPutList(line,tys,prefix) /* Put values to Haskell */ Int line; List tys; String prefix; { Int i; for(i=1; nonNull(tys); tys=tl(tys),++i) { fprintf(out," "); foreignPut(line,hd(tys),prefix,i); } } static Void local ffiDeclareFun(line,n,indirect,extraArg,argTys,resultTy) Int line; Text n; Bool indirect; Bool extraArg; /* Add a StablePtr argument? */ List argTys; List resultTy; { Int i; if (resultTy == typeUnit) { fprintf(out,"void"); } else { foreignType(line,resultTy); } if (indirect) { fprintf(out," (*%s)", textToStr(n)); } else { fprintf(out," %s", textToStr(n)); } fprintf(out,"("); if (extraArg) { #if sparc_TARGET_ARCH || i386_TARGET_ARCH /* On SPARC we need an additional dummy argument due to stack alignment restrictions, see the comment in mkThunk in builtin.c. On x86 platforms we need it, too, but for a different reason: The "real" return address is still visible on the stack as an additional argument, but we return to a small stub which pops the stable pointer before the "real" return. */ fprintf(out,"HugsStablePtr fun1, void* unusedArg"); #else fprintf(out,"HugsStablePtr fun1"); #endif if (nonNull(argTys)) { fprintf(out,", "); } } for(i=1; nonNull(argTys); argTys=tl(argTys),++i) { foreignType(line,hd(argTys)); fprintf(out," arg%d",i); if (nonNull(tl(argTys))) { fprintf(out,", "); } } fprintf(out,")"); } static Void local ffiFunTypeCast(line,argTys,resultTy) Int line; List argTys; List resultTy; { Int i; fprintf(out,"("); if (resultTy == typeUnit) { fprintf(out,"void"); } else { foreignType(line,resultTy); } fprintf(out," (*)("); for(i=1; nonNull(argTys); argTys=tl(argTys),++i) { foreignType(line,hd(argTys)); if (nonNull(tl(argTys))) { fprintf(out,", "); } } fprintf(out,"))"); } static Void local ffiCallFun(line,e,argTys,resultTy) Int line; Text e; List argTys; Type resultTy; { Int i; fprintf(out," "); if (resultTy != typeUnit) { fprintf(out,"res1 = "); } fprintf(out,"%s(", textToStr(e)); for(i=1; nonNull(argTys); argTys=tl(argTys),++i) { fprintf(out,"arg%d",i); if (nonNull(tl(argTys))) { fprintf(out,", "); } } fprintf(out,");\n"); } /* Generate a Hugs Prim prototype. * name should match the C function we're calling because we know * that name is a valid C identifier whereas the Haskell name may * not be. */ static Void local ffiPrimProto(name,id) Text name; Int id; { fprintf(out,"\nstatic void hugsprim_%s_%d(HugsStackPtr);\n",textToStr(name),id); } /* Generate a Hugs Prim Header. * name should match the C function we're calling because we know * that name is a valid C identifier whereas the Haskell name may * not be. */ static Void local ffiPrimHeader(name,id) Text name; Int id; { fprintf(out,"static void hugsprim_%s_%d(HugsStackPtr hugs_root)\n", textToStr(name),id); } /* Generate C code for calling C functions from Haskell. * The code has to be compiled with a C compiler and dynamically * loaded. * * For example: * * foreign import "static fn ext_nm" name :: Int -> Float -> IO Char * ==> * * #ifndef ENABLE_MACRO_INTERFACE * #undef ext_nm * #endif * * static void hugsprim_extnm(HugsStackPtr); * static void hugsprim_extnm(HugsStackPtr hugs_root) * { * int arg1 = hugs->getInt(); * float arg2 = hugs->getFloat(); * char res1 = ext_nm(arg1,arg2); * hugs->putChar(res1); * hugs->returnIO(hugs_root,1); * } * */ Void implementForeignImport(line,n,id,fn,cid,isStatic,libName,argTys,isIO,resultTy) Int line; Name n; Int id; Text fn; /* Include file */ Text cid; /* Function name */ Bool isStatic; Text libName; List argTys; Bool isIO; Type resultTy; { #ifdef DOTNET if ( name(n).foreignFlags & FFI_CCONV_DOTNET ) { /* .NET methods are bound when invoked, just record * the method name + the types we're calling it at. * */ List params = dupList(argTys); Int flags = (Int)fn; map1Over(foreignTypeTag,line,params); /* Qualifying the method name with the class & namespace * prefix is redundant, but as a nicety we support being * verbose -- symmetric with static methods * verbosity. */ if ( ((flags & FFI_DOTNET_METHOD) != 0) && ((flags & FFI_DOTNET_STATIC) == 0) ) { char* meth = strrchr(textToStr(cid),'.'); if ( (meth && *(meth+1) != '\0') ) { /* Dotted name (with non-empty last component), use * last component. */ cid = findText(meth+1); } } name(n).number = EXECNAME; name(n).foreignInfo = pair (cid, pair(libName, pair(mkInt(flags), pair(mkInt(isIO), pair(foreignTypeTag(line,resultTy), params))))); return; } else { #endif ffiInclude(fn); /* Prevent the cid from matching a C macro */ fprintf(out,"\n#ifndef ENABLE_MACRO_INTERFACE\n"); fprintf(out,"#undef %s\n", textToStr(cid)); fprintf(out,"#endif\n"); ffiPrimProto(cid,id); ffiPrimHeader(cid,id); fprintf(out,"{\n"); #if 0 /* Prototype for function we're going to call */ fprintf(out," extern "); ffiDeclareFun(line,cid,FALSE,FALSE,argTys,resultTy); fprintf(out,";\n"); #endif ffiDeclareList(line,argTys,"arg"); ffiDeclare(line,resultTy,"res",1); ffiGetList(line,argTys,"arg"); ffiCallFun(line,cid,argTys,resultTy); fprintf(out," "); foreignPut(line,resultTy,"res",1); if (isIO || nonNull(argTys)) { fprintf(out," hugs->return%s(hugs_root,%d);\n", isIO?"IO":"Id", resultTy==typeUnit ? 0 : 1); } fprintf(out,"}\n"); #ifdef DOTNET } #endif } Void implementForeignImportDynamic(line,id,e,argTys,isIO,resultTy) Int line; Int id; Text e; List argTys; Bool isIO; Type resultTy; { ffiPrimProto(e,id); ffiPrimHeader(e,id); fprintf(out,"{\n"); /* Declare arguments and result */ fprintf(out," "); ffiDeclareFun(line,e,TRUE,FALSE,argTys,resultTy); fprintf(out,";\n"); ffiDeclareList(line,argTys,"arg"); ffiDeclare(line,resultTy,"res",1); fprintf(out," %s = ", textToStr(e)); ffiFunTypeCast(line,argTys,resultTy); fprintf(out,"hugs->getFunPtr();\n"); ffiGetList(line,argTys,"arg"); ffiCallFun(line,e,argTys,resultTy); fprintf(out," "); foreignPut(line,resultTy,"res",1); if (isIO || nonNull(argTys)) { fprintf(out," hugs->return%s(hugs_root,%d);\n", isIO?"IO":"Id", resultTy==typeUnit ? 0 : 1); } fprintf(out,"}\n"); } /* * For wrappers, we generate: * * For example: * * foreign import "wrapper" name :: (Int -> Float -> Char) * -> IO (FunPtr (Int -> Float -> Char)) * ==> * * static HsChar wrapper(HugsStablePtr arg1, HsInt arg2, HsFloat arg3); * static HsChar wrapper(HugsStablePtr arg1, HsInt arg2, HsFloat arg3); * { * HsChar res1; * hugs->derefStablePtr4(arg1); * hugs->putInt(arg2); * hugs->putFloat(arg3); * if (hugs->runIO(2)) { * exit(hugs->getInt()); * } * res1 = hugs->getChar(); * return res1; * } * * static void hugsprim_name(HugsStackPtr hugs_root); * static void hugsprim_name(HugsStackPtr hugs_root) * { * HugsStablePtr arg1 = hugs->makeStablePtr4(); * void* thunk = hugs->mkThunk(&wrapper,arg1); * hugs->putAddr(thunk); * hugs->returnIO(hugs_root,1); * } */ Void implementForeignImportWrapper(line,id,e,argTys,isIO,resultTy) Int line; Int id; Text e; List argTys; Bool isIO; Type resultTy; { /* Prototype for function we're generating */ fprintf(out,"\nstatic "); ffiDeclareFun(line,e,FALSE,TRUE,argTys,resultTy); fprintf(out,";\n"); /* The function wrapper */ fprintf(out,"static "); ffiDeclareFun(line,e,FALSE,TRUE,argTys,resultTy); fprintf(out,"\n{\n"); ffiDeclare(line,resultTy,"res",1); /* Push function pointer and arguments */ fprintf(out," hugs->derefStablePtr4(fun1);\n"); ffiPutList(line,argTys,"arg"); /* Make the call and check for uncaught exception */ /* ToDo: I'm not sure that exiting from the Hugs session is the right * response to the Haskell function calling System.exit. */ fprintf(out," if (hugs->run%s(%d)) {\n", isIO?"IO":"Id", length(argTys)); fprintf(out, " exit(hugs->getInt());\n" " }\n" ); fprintf(out," "); foreignGet(line,resultTy,"res",1); ffiReturn(resultTy,"res",1); /* Return result */ fprintf(out,"}\n"); ffiPrimProto(e,id); ffiPrimHeader(e,id); fprintf(out, "{\n" " HugsStablePtr arg1 = hugs->makeStablePtr4();\n" " void* thunk = hugs->mkThunk((HsFunPtr)%s,arg1);\n", textToStr(e) ); fprintf(out, " hugs->putAddr(thunk);\n" " hugs->returnIO(hugs_root,1);\n" "}\n"); } /* * Generate C code for calling C functions from Haskell. * The code has to be compiled with a C compiler and dynamically * loaded. * * For example: * * foreign export "extnm" name :: Int -> Float -> IO Char * ==> * * static HugsStablePtr hugs_stable_for_extnm = -1; * char extnm(int arg1, float arg2); * char extnm(int arg1, float arg2) * { * char res1; * hugs->putInt(hugs_stable_for_extnm); * hugs->putInt(arg1); * hugs->putFloat(arg2); * if (hugs->runIO(2)) { * exit(hugs->getInt()); * } * res1 = hugs->getChar(); * return res1; * } * */ Void implementForeignExport(line,id,e,argTys,isIO,resultTy) Int line; Int id; Text e; List argTys; Bool isIO; Type resultTy; { /* Prototype for function we're generating */ fprintf(out,"\nextern "); ffiDeclareFun(line,e,FALSE,FALSE,argTys,resultTy); fprintf(out,";\n"); fprintf(out,"static HugsStablePtr hugs_stable_for_%s = -1;\n", textToStr(e)); /* The function wrapper */ ffiDeclareFun(line,e,FALSE,FALSE,argTys,resultTy); fprintf(out,"\n{\n"); ffiDeclare(line,resultTy,"res",1); /* Push function pointer and arguments */ fprintf(out," hugs->putInt(hugs_stable_for_%s);\n", textToStr(e)); ffiPutList(line,argTys,"arg"); /* Make the call and check for uncaught exception */ if (isIO) { /* ToDo: I'm not sure that exiting from the Hugs session is the right * response to the Haskell function calling System.exit. */ fprintf(out," if (hugs->runIO(%d)) {\n", length(argTys)); fprintf(out, " exit(hugs->getInt());\n" " }\n" ); } else { fprintf(out," hugs->ap(%d);\n", length(argTys)); } fprintf(out," "); foreignGet(line,resultTy,"res",1); ffiReturn(resultTy,"res",1); fprintf(out,"}\n"); } /* * Generate primitive for address of a C symbol. * * For example: * * foreign import "static & cid" name :: Addr * ==> * * #ifndef ENABLE_MACRO_INTERFACE * #undef cid * #endif * * static void hugsprim_name(HugsStackPtr); * static void hugsprim_name(HugsStackPtr hugs_root) * { * extern int cid; // probably the wrong type but it doesn't matter * hugs->putAddr(&cid); * hugs_returnId(1); * } */ Void implementForeignImportLabel(line, id, fn, cid, n, ty) Int line; Int id; Text fn; /* Include file */ Text cid; /* Function name */ Text n; /* Haskell name */ Type ty; { ffiInclude(fn); /* Prevent the cid from matching a C macro */ fprintf(out,"\n#ifndef ENABLE_MACRO_INTERFACE\n"); fprintf(out,"#undef %s\n", textToStr(cid)); fprintf(out,"#endif\n"); ffiPrimProto(cid,id); ffiPrimHeader(cid,id); fprintf(out,"{\n"); if (getHead(ty) == typeFunPtr) fprintf(out," hugs->putFunPtr((HsFunPtr)&%s);\n", textToStr(cid)); else fprintf(out," hugs->putPtr(&%s);\n", textToStr(cid)); fprintf(out,"}\n"); } /* ToDo: * chain all foreign exports together and free at end of run? * copy GreenCard.h into Test.c? */ /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/goal.c0000644006511100651110000000402707747453740014664 0ustar rossross/* * Keeping track of progress towards a goal. */ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "machdep.h" #include "opts.h" #include "goal.h" /* -------------------------------------------------------------------------- * Display progress towards goal: * ------------------------------------------------------------------------*/ static Target currTarget; static Bool aiming = FALSE; static Int currPos; static Int maxPos; static Int charCount; Void setGoal(what, t) /* Set goal for what to be t */ String what; Target t; { if (quiet #if EXPLAIN_INSTANCE_RESOLUTION || showInstRes #endif ) return; currTarget = (t?t:1); aiming = TRUE; if (useDots) { currPos = strlen(what); maxPos = getTerminalWidth() - 1; Printf("%s",what); } else for (charCount=0; *what; charCount++) Putchar(*what++); FlushStdout(); } Void soFar(t) /* Indicate progress towards goal */ Target t; { /* has now reached t */ if (quiet #if EXPLAIN_INSTANCE_RESOLUTION || showInstRes #endif ) return; if (useDots) { Int newPos = (Int)((maxPos * ((long)t))/currTarget); if (newPos>maxPos) newPos = maxPos; if (newPos>currPos) { do Putchar('.'); while (newPos>++currPos); FlushStdout(); } FlushStdout(); } } Void done() { /* Goal has now been achieved */ if (quiet #if EXPLAIN_INSTANCE_RESOLUTION || showInstRes #endif ) return; if (useDots) { while (maxPos>currPos++) Putchar('.'); Putchar('\n'); } else for (; charCount>0; charCount--) { Putchar('\b'); #if !(__MWERKS__ && macintosh) Putchar(' '); Putchar('\b'); #endif } aiming = FALSE; FlushStdout(); } Void failed() { /* Goal cannot be reached due to */ if (aiming) { /* errors */ aiming = FALSE; Putchar('\n'); FlushStdout(); } } hugs98-plus-Sep2006/src/goal.h0000644006511100651110000000043607632751740014663 0ustar rossross/* * Keeping track of progress towards a goal. */ #ifndef __GOAL_H__ #define __GOAL_H__ typedef long Target; extern Void setGoal Args((String,Target)); extern Void soFar Args((Target)); extern Void done Args((Void)); extern Void failed Args((Void)); #endif /* __GOAL_H__ */ hugs98-plus-Sep2006/src/hugs.c0000644006511100651110000010032210465137047014671 0ustar rossross/* -------------------------------------------------------------------------- * Command interpreter * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2005, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: hugs.c,v $ * $Revision: 1.150 $ * $Date: 2006/08/05 15:49:59 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "command.h" #include "connect.h" #include "errors.h" #include "script.h" #include "opts.h" #include "strutil.h" #include "evaluator.h" #include "machdep.h" #include "output.h" #include "module.h" #include #include #include /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Void local interpreter Args((Int,String [])); static Void local initInterpreter Args((Void)); static Void local menu Args((Void)); static Void local guidance Args((Void)); static Void local forHelp Args((Void)); static Void local changeDir Args((Void)); static Void local load Args((Void)); static Void local editor Args((Void)); static Void local find Args((Void)); static Void local setModule Args((Void)); static Void local showtype Args((Void)); static String local objToStr Args((Module, Cell)); static Void local info Args((Void)); static Void local printSyntax Args((Name)); static Void local showInst Args((Inst)); static Void local describe Args((Text)); static Void local listNames Args((Void)); static Void local expandPath Args((String,String,unsigned int)); static Void local browse Args((Void)); static Void local initialize Args((Int, String [])); static Void local clearEvalModule Args((Void)); #if HUGS_FOR_WINDOWS static Void local autoReloadFiles Args((Void)); #endif /* -------------------------------------------------------------------------- * Optional timer hooks: * ------------------------------------------------------------------------*/ #if WANT_TIMER #include "timer.c" #endif /* -------------------------------------------------------------------------- * Local data areas: * ------------------------------------------------------------------------*/ static Text evalModule = 0; /* Name of module we eval exprs in */ static String defaultArgv[] = { "Hugs" }; /* program name */ /* -------------------------------------------------------------------------- * UI interpreter initalization: * ------------------------------------------------------------------------*/ static Void local initialize(argc,argv) Int argc; String argv[]; { startEvaluator(); setLastEdit((String)0,0); #if HUGS_FOR_WINDOWS || HAVE_WINDOWS_H #define DEFAULT_EDITOR "\\notepad.exe" /* * Check first to see if the user has explicitly defined * an editor via the environment variable EDITOR.. */ hugsEdit = strCopy(fromEnv("EDITOR",NULL)); if (hugsEdit == NULL) { #if HUGS_FOR_WINDOWS hugsEdit = WinHugsPickDefaultEditor(); #else UINT rc; int notePadLen = strlen(DEFAULT_EDITOR); char* notePadLoc; /* * Nope, the default editor is used instead. In our case * this is 'notepad', which we assume is always residing * in the windows directory, so locate it first.. * (it would be somewhat odd for a user not to have that * directory in his/her PATH, but the less we assume, the better.) */ notePadLoc = #if HAVE_ALLOCA alloca #else _alloca #endif (sizeof(char)*(MAX_PATH + notePadLen + 2)); notePadLoc[0] = '&'; rc = GetWindowsDirectory(notePadLoc+1, MAX_PATH); if ( !(rc == 0 || rc > MAX_PATH) ) { strcat(notePadLoc, DEFAULT_EDITOR); hugsEdit = strCopy(notePadLoc); } #endif } #elif __MWERKS__ && macintosh hugsEdit = NULL; #else hugsEdit = strCopy(fromEnv("EDITOR",NULL)); #endif readOptions("-p\"%s> \" -r$$",FALSE); readOptionSettings(); processOptionVector(argc,argv); #if !HASKELL_98_ONLY if (haskell98) { Printf("Haskell 98 mode: Restart with command line option -98 to enable extensions\n\n"); } else { Printf("Hugs mode: Restart with command line option +98 for Haskell 98 mode\n\n"); } #endif /* Figure out what Prelude module we're using + hoist it in. */ loadPrelude(); /* Add an empty module as the default, to avoid being inside the Prelude */ addScriptName(STD_EMPTY_MODULE, TRUE); /* We record the number of scripts that loading the Prelude * brought about, so that when the user comes to clear the module * stack (e.g., ":l"), only modules later than the Prelude * ones are scratched. */ setScriptStableMark(); addScriptsFromArgs(argc,argv); setHugsArgs(1, defaultArgv); clearEvalModule(); /* evaluate wrt last module by default */ readScripts(0); } /* -------------------------------------------------------------------------- * Printing the banner * ------------------------------------------------------------------------*/ static Void printBanner Args((Void)); static Void printBanner() { #if SMALL_BANNER Printf("Hugs98 - http://haskell.org/hugs - %s\n", versionString); #elif HUGS_FOR_WINDOWS INT svColor; svColor = SetForeColor(BLUE); Printf( "__ __ __ __ ____ ___"); Printf(" _______________________________________________\n"); SetForeColor(svColor); svColor = SetForeColor(RED); Printf("|| || || || || || ||__ "); SetForeColor(svColor); Printf(" Hugs 98: Based on the Haskell 98 standard\n"); svColor = SetForeColor(BLUE); Printf("||___|| ||__|| ||__|| __||"); SetForeColor(svColor); Printf(" Copyright (c) 1994-2005\n"); svColor = SetForeColor(RED); Printf("||---|| ___|| "); SetForeColor(svColor); Printf(" World Wide Web: "); WinHugsHyperlink("http://haskell.org/hugs"); Printf("\n"); svColor = SetForeColor(BLUE); Printf("|| || "); SetForeColor(svColor); Printf(" Bugs: "); WinHugsHyperlink("http://hackage.haskell.org/trac/hugs"); Printf("\n"); svColor = SetForeColor(RED); Printf("|| || "); SetForeColor(svColor); Printf("Version: %-14s",versionString); svColor = SetForeColor(BLUE); Printf(" _______________________________________________\n\n"); SetForeColor(svColor); #else Printf("__ __ __ __ ____ ___ _________________________________________\n"); Printf("|| || || || || || ||__ Hugs 98: Based on the Haskell 98 standard\n"); Printf("||___|| ||__|| ||__|| __|| Copyright (c) 1994-2005\n"); Printf("||---|| ___|| World Wide Web: http://haskell.org/hugs\n"); Printf("|| || Bugs: http://hackage.haskell.org/trac/hugs\n"); Printf("|| || Version: %-14s _________________________________________\n\n",versionString); #endif FlushStdout(); } /* -------------------------------------------------------------------------- * Hugs entry point: * ------------------------------------------------------------------------*/ int main Args((Int, String [])); /* now every func has a prototype */ int main(argc,argv) int argc; char *argv[]; { CStackBase = &argc; /* Save stack base for use in gc */ if (!initSystem()) { Printf("%0: failed to initialize, exiting\n", (argv ? argv[0] : "")); return 1; } printBanner(); interpreter(argc,argv); Printf("[Leaving Hugs]\n"); everybody(EXIT); shutdownHugs(); return 0; } /* -------------------------------------------------------------------------- * Shutdown interpreter. * ------------------------------------------------------------------------*/ Void shutdownHugs() { /* Let go of dynamic storage */ if (hugsEdit) { free(hugsEdit); hugsEdit=0; } /* empties lastEdit state (and frees it up.) */ setLastEdit((String)0,0); stopEvaluator(); } /* -------------------------------------------------------------------------- * Print Menu of list of commands: * ------------------------------------------------------------------------*/ static struct cmd cmds[] = { {":?", HELP}, {":cd", CHGDIR}, {":also", ALSO}, {":type", TYPEOF}, {":!", SYSTEM}, {":load", LOAD}, {":reload", RELOAD}, {":gc", COLLECT}, {":edit", EDIT}, {":quit", QUIT}, {":set", SET}, {":find", FIND}, {":names", NAMES}, {":info", INFO}, {":module", SETMODULE}, {":browse", BROWSE}, {":main", MAIN}, #if EXPLAIN_INSTANCE_RESOLUTION {":xplain", XPLAIN}, #endif {":version", PNTVER}, #ifdef __SYMBIAN32__ {":Pwd",PRNDIR}, #endif {"", EVAL}, {0,0} }; static Void local menu() { Printf("LIST OF COMMANDS: Any command may be abbreviated to :c where\n"); Printf("c is the first character in the full name.\n\n"); Printf(":load load modules from specified files\n"); Printf(":load clear all files except prelude\n"); Printf(":also read additional modules\n"); Printf(":reload repeat last load command\n"); Printf(":edit edit file\n"); Printf(":edit edit last module\n"); Printf(":module set module for evaluating expressions\n"); Printf(" evaluate expression\n"); Printf(":type print type of expression\n"); Printf(":? display this list of commands\n"); Printf(":set set command line options\n"); Printf(":set help on command line options\n"); Printf(":names [pat] list names currently in scope\n"); Printf(":info describe named objects\n"); Printf(":browse browse names exported by \n"); Printf(":main run the main function with the given arguments\n"); #if EXPLAIN_INSTANCE_RESOLUTION Printf(":xplain explain instance resolution for \n"); #endif Printf(":find edit module containing definition of name\n"); #if 0 Printf(":!command shell escape\n"); #endif Printf(":cd dir change directory\n"); Printf(":gc force garbage collection\n"); #ifdef __SYMBIAN32__ Printf(":Pwd print working directory\n"); #endif Printf(":version print Hugs version\n"); Printf(":quit exit Hugs interpreter\n"); } static Void local guidance() { Printf("Command not recognised. "); forHelp(); } static Void local forHelp() { Printf("Type :? for help\n"); } /* -------------------------------------------------------------------------- * Change directory command: * ------------------------------------------------------------------------*/ /* * Poor man's path expansion: expand out ~/ */ static Void local expandPath(origPath,expandedPath,maxLen) String origPath; String expandedPath; unsigned int maxLen; { if (!origPath) { return; } /* If the original path starts with "~/", expand it. */ if (*origPath == '~' && *(origPath+1) == '/') { unsigned int origLen; String home = getenv("HOME"); origLen = (origPath ? strlen(origPath) : 0); /* The expansion of $HOME will fit in iff * (maxLength - length(unexpanded) - length("~")) >= length("$HOME") */ if ( (maxLen - origLen - 1) >= strlen(home) ) { strcpy(expandedPath, home); strcat(expandedPath, origPath+1); return; } } strcpy(expandedPath, origPath); } static Void local changeDir() { /* change directory */ String path = readFilename(); char expandedPath[FILENAME_MAX+1]; expandPath(path, expandedPath,FILENAME_MAX); if (path && chdir(expandedPath)) { ERRMSG(0) "Unable to change to directory \"%s\"", path EEND; } } #ifdef __SYMBIAN32__ /* -------------------------------------------------------------------------- * Print working directory command: * ------------------------------------------------------------------------*/ static Void local printDir() { /* print directory */ char s[256]; printf("%s\n",getcwd(s,255)); } #endif /* -------------------------------------------------------------------------- * Commands for loading and removing script files: * ------------------------------------------------------------------------*/ static Void local load() { /* read filenames from command line */ String s; /* and add to list of scripts waiting */ /* to be read */ clearEvalModule(); while ((s=readFilename())!=0) { #if HUGS_FOR_WINDOWS WinHugsAddMruFile(s); #endif addScriptName(s,TRUE); } readScripts(1); } /* -------------------------------------------------------------------------- * Access to external editor: * ------------------------------------------------------------------------*/ static Void local editor() { /* interpreter-editor interface */ String newFile = readFilename(); if (newFile) { setLastEdit(newFile,0); if (readFilename()) { ERRMSG(0) "Multiple filenames not permitted" EEND; } } runEditor(); } static Void local find() { /* edit file containing definition */ String nm = readFilename(); /* of specified name */ if (!nm) { ERRMSG(0) "No name specified" EEND; } else if (readFilename()) { ERRMSG(0) "Multiple names not permitted" EEND; } else { Text t; Cell c; setCurrModule(findEvalModule()); startNewScript(0); if (nonNull(c=findTycon(t=findText(nm)))) { if ( startEdit(tycon(c).line,getScriptName(scriptThisTycon(c))) ) { readScripts(1); } } else if (nonNull(c=findName(t))) { if ( startEdit(name(c).line,getScriptName(scriptThisName(c))) ) { readScripts(1); } } else { ERRMSG(0) "No current definition for name \"%s\"", nm EEND; } } } Void runEditor() { /* run editor on script lastEdit */ String fileToEdit; Int lastLine; String lastEdit = getLastEdit(&lastLine); if (lastEdit == NULL) { fileToEdit = fileOfModule(lastModule()); } else { fileToEdit = lastEdit; } if (startEdit(lastLine,fileToEdit)) { /* at line lastLine */ /* reload entire module stack bar the Prelude. */ readScripts(1); } } /* -------------------------------------------------------------------------- * Read and evaluate an expression: * ------------------------------------------------------------------------*/ static Void local setModule(){/*set module in which to evaluate expressions*/ String s = readFilename(); if (s!=0) { /* Locate named module */ Text t = findText(s); Module m = findModule(t); if (isNull(m)) { ERRMSG(0) "Cannot find module \"%s\"", s EEND; } else { evalModule = t; setLastEdit(fileOfModule(m),0); } } else { /* :m clears the current module selection */ clearEvalModule(); setLastEdit(fileOfModule(lastModule()),0); } } Module findEvalModule() { /*Module in which to eval expressions*/ Module m = findModule(evalModule); if (isNull(m)) m = lastModule(); return m; } static Void local clearEvalModule() { evalModule = findText(""); } /* -------------------------------------------------------------------------- * Print type of input expression: * ------------------------------------------------------------------------*/ static Void local showtype() { /* print type of expression (if any)*/ Cell type; setCurrModule(findEvalModule()); startNewScript(0); /* Enables recovery of storage */ /* allocated during evaluation */ parseExp(); checkExp(); defaultDefns = evalDefaults; type = typeCheckExp(printTypeUseDefaults); printExp(stdout,inputExpr); #if HUGS_FOR_WINDOWS { INT svColor = SetForeColor(BLUE); #endif Printf(" :: "); printType(stdout,type); #if HUGS_FOR_WINDOWS SetForeColor(svColor); } #endif Putchar('\n'); } static Void local browse() { /* browse modules */ Int count = 0; /* or current module */ String s; Bool all = FALSE; setCurrModule(findEvalModule()); startNewScript(0); /* for recovery of storage */ while ((s=readFilename())!=0) if (strcmp(s,"all") == 0) { all = TRUE; } else { Module mod = findModule(findText(s)); if (isNull(mod)) { Printf("Unknown module %s\n",s); } else { browseModule(mod,all); } count++; } if (count == 0) browseModule(findEvalModule(),all); } #if EXPLAIN_INSTANCE_RESOLUTION static Void local xplain() { /* print type of expression (if any)*/ Cell d; Bool sir = showInstRes; setCurrModule(findEvalModule()); startNewScript(0); /* Enables recovery of storage */ /* allocated during evaluation */ parseContext(); checkContext(); showInstRes = TRUE; d = provePred(NIL,NIL,hd(inputContext)); if (isNull(d)) { fprintf(stdout, "not Sat\n"); } else { fprintf(stdout, "Sat\n"); } fflush(stdout); showInstRes = sir; } #endif static Void local runmain() { int MaxArgs = 255; String args[256]; String s; int argPos = 1, i; args[0] = "Hugs"; while (argPos < MaxArgs && (s = readFilename())) { args[argPos++] = strCopy(s); } setHugsArgs(argPos, args); for (i = 1; i < argPos; i++) free(args[i]); stringInput((String)"main"); input(BREAK); doCommand(); } /* -------------------------------------------------------------------------- * Enhanced help system: print current list of scripts or give information * about an object. * ------------------------------------------------------------------------*/ static String local objToStr(m,c) Module m; Cell c; { #if 1 || DISPLAY_QUANTIFIERS static char newVar[60]; switch (whatIs(c)) { case NAME : if (m == name(c).mod) { sprintf(newVar,"%s", textToStr(name(c).text)); } else { sprintf(newVar,"%s.%s", textToStr(module(name(c).mod).text), textToStr(name(c).text)); } break; case TYCON : if (m == tycon(c).mod) { sprintf(newVar,"%s", textToStr(tycon(c).text)); } else { sprintf(newVar,"%s.%s", textToStr(module(tycon(c).mod).text), textToStr(tycon(c).text)); } break; case CLASS : if (m == cclass(c).mod) { sprintf(newVar,"%s", textToStr(cclass(c).text)); } else { sprintf(newVar,"%s.%s", textToStr(module(cclass(c).mod).text), textToStr(cclass(c).text)); } break; default : internal("objToStr"); } return newVar; #else static char newVar[33]; switch (whatIs(c)) { case NAME : sprintf(newVar,"%s", textToStr(name(c).text)); break; case TYCON : sprintf(newVar,"%s", textToStr(tycon(c).text)); break; case CLASS : sprintf(newVar,"%s", textToStr(cclass(c).text)); break; default : internal("objToStr"); } return newVar; #endif } static Void local info() { /* describe objects */ Int count = 0; /* or give menu of commands */ String s; Module evMod; evMod = findEvalModule(); setCurrModule(evMod); startNewScript(0); /* for recovery of storage */ for (; (s=readFilename())!=0; count++) { String mod=NULL; String nm=NULL; /* In the event of a qualified name, decompose it. */ splitQualString(s, &mod, &nm); if (mod == NULL) { describe(findText(nm)); } else { Module homeMod = findModule(findText(mod)); if (nonNull(homeMod)) { setCurrModule(homeMod); describe(findText(nm)); } else Printf("Unknown module `%s'\n",mod); /* With the module unknown, don't check the name. */ free(mod); mod = NULL; } } if (count == 0) { whatScripts(); } setCurrModule(evMod); } static Void local describe(t) /* describe an object */ Text t; { Tycon tc = findTycon(t); Class cl = findClass(t); Name nm = findName(t); if (nonNull(tc)) { /* as a type constructor */ Type t = tc; Int i; Inst in; for (i=0; i"); break; } Putchar('\n'); if (nonNull(in=findFirstInst(tc))) { Printf("\n-- instances:\n"); do { showInst(in); in = findNextInst(tc,in); } while (nonNull(in)); } Putchar('\n'); } if (nonNull(cl)) { /* as a class */ List ins = cclass(cl).instances; Kinds ks = cclass(cl).kinds; if (nonNull(ks) && isNull(tl(ks)) && hd(ks)==STAR) { Printf("-- type class"); } else { Printf("-- constructor class"); if (kindExpert) { Printf(" with arity "); printKinds(stdout,ks); } } Putchar('\n'); mapProc(printSyntax,cclass(cl).members); Printf("class "); if (nonNull(cclass(cl).supers)) { printContext(stdout,cclass(cl).supers); Printf(" => "); } printPred(stdout,cclass(cl).head); if (nonNull(cclass(cl).fds)) { List fds = cclass(cl).fds; String pre = " | "; for (; nonNull(fds); fds=tl(fds)) { Printf(pre); printFD(stdout,hd(fds)); pre = ", "; } } if (nonNull(cclass(cl).members)) { List ms = cclass(cl).members; Printf(" where"); do { Type t = name(hd(ms)).type; if (isPolyType(t)) { t = monotypeOf(t); } Printf("\n "); printExp(stdout,hd(ms)); Printf(" :: "); if (isNull(tl(fst(snd(t))))) { t = snd(snd(t)); } else { t = ap(QUAL,pair(tl(fst(snd(t))),snd(snd(t)))); } printType(stdout,t); ms = tl(ms); } while (nonNull(ms)); } Putchar('\n'); if (nonNull(ins)) { Printf("\n-- instances:\n"); do { showInst(hd(ins)); ins = tl(ins); } while (nonNull(ins)); } Putchar('\n'); } if (nonNull(nm)) { /* as a function/name */ printSyntax(nm); printExp(stdout,nm); Printf(" :: "); if (nonNull(name(nm).type)) { printType(stdout,name(nm).type); } else { Printf(""); } if (isCfun(nm)) { Printf(" -- data constructor"); } else if (isMfun(nm)) { Printf(" -- class member"); } else if (isSfun(nm)) { Printf(" -- selector function"); } if (name(nm).primDef) { Printf(" -- primitive"); } Printf("\n\n"); } if (isNull(tc) && isNull(cl) && isNull(nm)) { Printf("Unknown reference `%s'\n",textToStr(t)); } } static Void local printSyntax(nm) Name nm; { Syntax sy = syntaxOf(nm); Text t = name(nm).text; String s = textToStr(t); if (sy != defaultSyntax(t)) { Printf("infix"); switch (assocOf(sy)) { case LEFT_ASS : Putchar('l'); break; case RIGHT_ASS : Putchar('r'); break; case NON_ASS : break; } Printf(" %i ",precOf(sy)); if (isascii(*s) && isalpha(*s)) { Printf("`%s`",s); } else { Printf("%s",s); } Putchar('\n'); } } static Void local showInst(in) /* Display instance decl header */ Inst in; { Printf("instance "); if (nonNull(inst(in).specifics)) { printContext(stdout,inst(in).specifics); Printf(" => "); } printPred(stdout,inst(in).head); Putchar('\n'); } /* -------------------------------------------------------------------------- * List all names currently in scope: * ------------------------------------------------------------------------*/ static Void local listNames() { /* list names matching optional pat*/ String pat = readFilename(); List names = NIL; Int width = getTerminalWidth() - 1; Int count = 0; Int termPos; Module mod = findEvalModule(); if (pat) { /* First gather names to list */ do { names = addNamesMatching(pat,names); } while ((pat=readFilename())!=0); } else { names = addNamesMatching((String)0,names); } if (isNull(names)) { /* Then print them out */ ERRMSG(0) "No names selected" EEND; } for (termPos=0; nonNull(names); names=tl(names)) { String s = objToStr(mod,hd(names)); Int l = strlen(s); if (termPos+1+l>width) { Putchar('\n'); termPos = 0; } else if (termPos>0) { Putchar(' '); termPos++; } Printf("%s",s); termPos += l; count++; } Printf("\n(%d names listed)\n", count); } /* -------------------------------------------------------------------------- * print a prompt and read a line of input: * ------------------------------------------------------------------------*/ /* Size of (expanded) prompt buffer, should be more than enough.... */ #define MAX_PROMPT_SIZE 1000 Void promptForInput(moduleName) String moduleName; { char promptBuffer[MAX_PROMPT_SIZE]; char* fromPtr; char* toPtr; int modLen = strlen(moduleName); int roomLeft = MAX_PROMPT_SIZE - 1; toPtr = promptBuffer; fromPtr = prompt; /* Carefully substituting occurrences of %s in the prompt string with the module name. */ while (*fromPtr != '\0' && roomLeft > 0) { if (*fromPtr == '%' && *(fromPtr+1) == 's') { /* Substitute module name */ if (modLen > roomLeft) { /* Running out of room; copy what we can */ fromPtr = moduleName; while (roomLeft-- > 0) { *toPtr++ = *fromPtr++; } break; } else { strcpy(toPtr,moduleName); toPtr += modLen; roomLeft -= modLen; fromPtr +=2; } } else { *toPtr++ = *fromPtr++; roomLeft--; } } *toPtr = '\0'; consoleInput(promptBuffer); } #if HUGS_FOR_WINDOWS static Void local autoReloadFiles() { if (autoLoadFiles) { InAutoReloadFiles = TRUE; saveInputState(); readScripts(1); restoreInputState(); InAutoReloadFiles = FALSE; } } #endif /* -------------------------------------------------------------------------- * main read-eval-print loop, with error trapping: * ------------------------------------------------------------------------*/ static Void local interpreter(argc,argv)/* main interpreter loop */ Int argc; String argv[]; { Int errorNumber = setjmp(catch_error); breakOn(TRUE); /* enable break trapping */ if ( numLoadedScripts()==0 ) { /* only succeeds on first time, */ if (errorNumber) /* before Prelude has been loaded */ fatal("Unable to load Prelude"); initialize(argc,argv); forHelp(); } #if defined(_MSC_VER) && !defined(_MANAGED) /* Under Win32 (when compiled with MSVC), we specially * catch and handle SEH stack overflows. */ __try { #endif #ifdef HUGS_FOR_WINDOWS initInterpreter(); InAutoReloadFiles = FALSE; WinHugsMessagePump(); #else for (;;) { initInterpreter(); if (doCommand()) break; } #endif breakOn(FALSE); #if defined(_MSC_VER) && !defined(_MANAGED) } __except ( ((GetExceptionCode() == EXCEPTION_STACK_OVERFLOW) ? EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) ) { /* Closely based on sample code in Nov 1999 Dr GUI MSDN column */ /* http://msdn.microsoft.com/archive/en-us/dnaraskdr/html/drgui49.asp */ char* stackPtr; static SYSTEM_INFO si; static MEMORY_BASIC_INFORMATION mi; static DWORD protect; /* get at the current stack pointer */ _asm mov stackPtr, esp; /* query for page size + VM info for the allocation chunk we're currently in. */ GetSystemInfo(&si); VirtualQuery(stackPtr, &mi, sizeof(mi)); /* Abandon the C stack and, most importantly, re-insert the page guard bit. Do this on the page above the current one, not the one where the exception was raised. */ stackPtr = (LPBYTE) (mi.BaseAddress) - si.dwPageSize; if ( VirtualFree(mi.AllocationBase, (LPBYTE)stackPtr - (LPBYTE) mi.AllocationBase, MEM_DECOMMIT) && VirtualProtect(stackPtr, si.dwPageSize, PAGE_GUARD | PAGE_READWRITE, &protect) ) { /* careful not to do a garbage collection here (as it may have caused the overflow). */ ERRTEXT "ERROR - C stack overflow" /* EEND does a longjmp back to a sane state. */ EEND; } else { fatal("C stack overflow; unable to recover."); } } #endif } static Void local initInterpreter() { everybody(RESET); /* reset to sensible initial state */ dropScriptsFrom(numLoadedScripts()-1); /* remove partially loaded scripts */ /* not counting prelude as a script*/ promptForInput(textToStr(module(findEvalModule()).text)); } Bool doCommand() /* read and execute a command */ { /* returns TRUE on QUIT (:quit) */ Command cmd; cmd = readCommand(cmds, (Char)':', (Char)'!'); #if WANT_TIMER updateTimers(); #endif switch (cmd) { case EDIT : editor(); break; case FIND : #if HUGS_FOR_WINDOWS autoReloadFiles(); #endif find(); break; case LOAD : forgetAllScripts(); load(); break; case ALSO : forgetScriptsFrom(numLoadedScripts()); load(); break; case RELOAD : readScripts(1); break; case SETMODULE : setModule(); break; case EVAL : #if HUGS_FOR_WINDOWS autoReloadFiles(); #endif #if USE_THREADS startEvaluatorThread(); loopInBackground(); #else evaluator(findEvalModule()); #endif break; case TYPEOF : #if HUGS_FOR_WINDOWS autoReloadFiles(); #endif showtype(); break; case BROWSE : browse(); break; #if EXPLAIN_INSTANCE_RESOLUTION case XPLAIN : xplain(); break; #endif case NAMES : #if HUGS_FOR_WINDOWS autoReloadFiles(); #endif listNames(); break; case HELP : menu(); break; case BADCMD : guidance(); break; case SET : setOptions(); break; case SYSTEM : if (shellEsc(readLine(),TRUE,TRUE)) Printf("Warning: Shell escape terminated abnormally\n"); break; case CHGDIR : changeDir(); break; case INFO : #if HUGS_FOR_WINDOWS autoReloadFiles(); #endif info(); break; case PNTVER: Printf("-- Hugs Version %s\n", versionString); break; case QUIT : return TRUE; case COLLECT: consGC = FALSE; garbageCollect(); consGC = TRUE; Printf("Garbage collection recovered %d cells\n", cellsRecovered); break; case NOCMD : break; case MAIN: runmain(); break; #ifdef __SYMBIAN32__ case PRNDIR : printDir(); break; #endif } #if WANT_TIMER updateTimers(); Printf("Elapsed time (ms): %ld (user), %ld (system)\n", millisecs(userElapsed), millisecs(systElapsed)); #endif return FALSE; } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/hugsscript.c0000644006511100651110000000115707750763465016140 0ustar rossross/* * DllMain() for Hugsscript.dll */ #include #define HUGS_SERVER 1 #include "prelude.h" #include "storage.h" #include "connect.h" /* included to provide stub defn of some unsupported primops. */ #include "observe.h" extern void setHugsModule(HMODULE); BOOL WINAPI DllMain( HINSTANCE hinstDLL, /* handle to the DLL module */ DWORD fdwReason, /* reason for calling function */ LPVOID lpvReserved /* reserved */ ) { switch(fdwReason) { case DLL_PROCESS_ATTACH: /* Stash away the HMODULE for later use. */ setHugsModule(hinstDLL); break; } return TRUE; } hugs98-plus-Sep2006/src/input.c0000644006511100651110000016670710500505554015075 0ustar rossross/* -------------------------------------------------------------------------- * Input functions, lexical analysis parsing etc... * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: input.c,v $ * $Revision: 1.91 $ * $Date: 2006/09/09 09:37:48 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "command.h" #include "errors.h" #include "module.h" #include "script.h" #include "opts.h" #include "goal.h" #include "machdep.h" #include "char.h" #include #if HAVE_WINDOWS_H #include #undef IN #endif /* -------------------------------------------------------------------------- * Global data: * ------------------------------------------------------------------------*/ List tyconDefns = NIL; /* type constructor definitions */ List typeInDefns = NIL; /* type synonym restrictions */ List valDefns = NIL; /* value definitions in script */ List classDefns = NIL; /* class defns in script */ List instDefns = NIL; /* instance defns in script */ List selDefns = NIL; /* list of selector lists */ List genDefns = NIL; /* list of generated names */ List primDefns = NIL; /* primitive definitions */ List unqualImports = NIL; /* unqualified import list */ Int foreignCount = 0; /* count of foreigns in this module*/ List foreignImports = NIL; /* foreign import declarations */ List foreignExports = NIL; /* foreign export declarations */ List foreignLabels = NIL; /* foreign label declarations */ List defaultDefns = NIL; /* default definitions (if any) */ Int defaultLine = 0; /* line in which default defs occur*/ List evalDefaults = NIL; /* defaults for evaluator */ Cell inputExpr = NIL; /* input expression */ Cell inputContext = NIL; /* input context */ Bool literateScripts = FALSE; /* TRUE => default to lit scripts */ String repeatStr = 0; /* Repeat last expr */ #if SUPPORT_PREPROCESSOR String preprocessor = 0; #endif /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Bool local fileInput Args((String,Long)); static Bool local literateMode Args((String)); static Bool local linecmp Args((String,ShortChar *)); static Int local nextLine Args((Void)); static Void local skip Args((Void)); static Void local thisLineIs Args((Int)); static Void local newlineSkip Args((Void)); static Void local closeAnyInput Args((Void)); Int yyparse Args((Void)); /* can't stop yacc making this */ /* public, but don't advertise */ /* it in a header file. */ static Void local endToken Args((Void)); static Text local readOperator Args((Void)); static Text local readIdent Args((Void)); static Cell local readRadixNumber Args((Int)); static Cell local readNumber Args((Void)); static Cell local readChar Args((Void)); static Cell local readString Args((Void)); static Void local saveStrChr Args((Char)); static Cell local readAChar Args((Bool)); static Bool local lazyReadMatches Args((String)); static Cell local readEscapeChar Args((Bool,Bool)); static Void local skipGap Args((Void)); static Cell local readCtrlChar Args((Void)); static Cell local readOctChar Args((Void)); static Cell local readHexChar Args((Void)); static Int local readHexDigit Args((Char)); static Cell local readDecChar Args((Void)); static Void local goOffside Args((Int)); static Void local unOffside Args((Void)); static Bool local canUnOffside Args((Void)); static Void local skipWhitespace Args((Void)); static Int local yylex Args((Void)); static Int local repeatLast Args((Void)); static Void local parseInput Args((Int)); /* -------------------------------------------------------------------------- * Text values for reserved words and special symbols: * ------------------------------------------------------------------------*/ static Text textCase, textOfK, textData, textType, textIf; static Text textThen, textElse, textWhere, textLet, textIn; static Text textInfix, textInfixl, textInfixr, textPrim, textNewtype; static Text textDefault, textDeriving, textDo, textClass, textInstance; #if IPARAM static Text textWith, textDlet; #endif #if MUDO static Text textMDo; #endif static Text textCoco, textEq, textUpto, textAs, textLambda; static Text textBar, textMinus, textFrom, textArrow, textLazy; static Text textBang, textDot, textAll, textImplies; static Text textModule, textImport; static Text textHiding, textQualified, textAsMod; static Text textWildcard; static Text textNeedPrims; static Text textForeign; Text textCCall; /* ccall */ Text textSafe; /* safe */ Text textUnsafe; /* unsafe */ Text textThreadsafe; /* threadsafe */ Text textExport; /* export */ /* Platform-specific calling conventions */ #if STDCALL_SUPPORTED Text textStdcall; /* stdcall */ #endif #ifdef DOTNET Text textDotnet; /* dotnet */ #endif Text textNum; /* Num */ Text textPrelude; /* Prelude / Hugs.Prelude */ Text textUserPrelude; /* Prelude */ Text textPlus; /* (+) */ static Cell conMain; /* Main */ static Cell varMain; /* main */ static Cell varMinus; /* (-) */ static Cell varPlus; /* (+) */ static Cell varBang; /* (!) */ static Cell varDot; /* (.) */ static Cell varHiding; /* hiding */ static Cell varQualified; /* qualified */ static Cell varAsMod; /* as */ static List imps; /* List of imports to be chased */ #if HERE_DOC Bool hereDocs = FALSE; enum { START = 0, KEEP_GOING, BEGIN_VAR, ISSUE_QUOTE, HERE_VAR, END_VAR, CLOSE_PAREN }; static Int hereState = START; #endif #if MULTI_LINEFEED #define FOPEN_MODE "rb" #else #define FOPEN_MODE "r" #endif /* -------------------------------------------------------------------------- * Single character input routines: * * At the lowest level of input, characters are read one at a time, with the * current character held in c0 and the following (lookahead) character in * c1. The corrdinates of c0 within the file are held in (column,row). * The input stream is advanced by one character using the skip() function. * ------------------------------------------------------------------------*/ #define TABSIZE 8 /* spacing between tabstops */ #define NOTHING 0 /* what kind of input is being read?*/ #define KEYBOARD 1 /* - keyboard/console? */ #define SCRIPTFILE 2 /* - script file */ #define STRING 3 /* - string buffer? */ #define NOKEYBOARD 4 /* - standard input, but not a tty */ static Int reading = NOTHING; static Target readSoFar; static Int row, column, startColumn; static int c0, c1; static FILE *inputStream = 0; static Bool thisLiterate; static String nextStringChar; /* next char in string buffer */ #if USE_READLINE /* for command line editors */ static String currentLine; /* editline or GNU readline */ static String nextChar; #define nextConsoleChar() (*nextChar=='\0' ? '\n' : ExtractChar(nextChar)) extern Void add_history Args((String)); extern String readline Args((String)); #else #define nextConsoleChar() FGetChar(stdin) #endif static Int litLines; /* count defn lines in lit script */ #define DEFNCHAR '>' /* definition lines begin with this */ static Int lastLine; /* records type of last line read: */ #define STARTLINE 0 /* - at start of file, none read */ #define BLANKLINE 1 /* - blank (may preceed definition) */ #define TEXTLINE 2 /* - text comment */ #define DEFNLINE 3 /* - line containing definition */ #define CODELINE 4 /* - line inside code block */ #define BEGINCODE "\\begin{code}" #define ENDCODE "\\end{code}" Bool startsQual(c) Char c; { return isIn(c,LARGE); } #define LINEBUFFER_SIZE 1000 static ShortChar lineBuffer[LINEBUFFER_SIZE]; static int lineLength = 0; static int inCodeBlock = FALSE; /* Inside \begin{code}..\end{code} */ static int linePtr = 0; Void consoleInput(prompt) /* prepare to input characters from */ String prompt; { /* standard in (i.e. console/kbd) */ reading = KEYBOARD; /* keyboard input is Line oriented, */ c0 = /* i.e. input terminated by '\n' */ c1 = ' '; column = (-1); row = 0; #if HERE_DOC hereState = START; #endif #if HAVE_ISATTY && USE_READLINE if (!isatty(fileno(stdin))) { /* not reading from a tty: */ reading = NOKEYBOARD; /* don't try readline */ Printf("%s",prompt);FlushStdout(); return; } #endif #if USE_READLINE /* Paranoid freeing code supplied by Sverker Nilsson (sverker@opq.se) * avoids accidentally freeing currentLine twice. */ if (currentLine) { String oldCurrentLine = currentLine; currentLine = 0; /* We may lose the space of currentLine */ free(oldCurrentLine); /* if interrupted here - unlikely */ } currentLine = readline(prompt); nextChar = currentLine; if (currentLine) { if (*currentLine) add_history(currentLine); } else c0 = c1 = EOF; #else #if HUGS_FOR_WINDOWS { INT svColor = SetForeColor(GREEN); #endif Printf("%s",prompt); FlushStdout(); #if HUGS_FOR_WINDOWS SetForeColor(svColor); } #endif #endif } #if HUGS_FOR_WINDOWS /* These variables and functions are used to save the current */ /* state of the input, to implement auto load of files */ static Int saveReading; static int savec0, savec1; Void saveInputState(Void) { saveReading = reading; savec0 = c0; savec1 = c1; } Void restoreInputState(Void) { reading = saveReading; c0 = savec0; c1 = savec1; } #endif static Bool local fileInput(nm,len) /* prepare to input characters from*/ String nm; /* named file (specified length is */ Long len; { /* used to set target for reading) */ #if SUPPORT_PREPROCESSOR if (!readable(nm,FALSE)) { /* file not there */ inputStream = NULL; } else if (preprocessor) { Int reallen = strlen(preprocessor) + 1 + strlen(nm) + 1; char *cmd = malloc(reallen+1); if (cmd == NULL) { ERRMSG(0) "Unable to allocate memory for filter command." EEND_NORET; return FALSE; } if (snprintf(cmd,reallen, "%s %s", preprocessor, nm) < 0) { ERRMSG(0) "Unable to allocate memory for filter command." EEND_NORET; return FALSE; } else { cmd[reallen] = '\0'; } inputStream = popen(cmd,"r"); free(cmd); } else { inputStream = fopen(nm,FOPEN_MODE); } #else if (nm[0] == '\0') inputStream = NULL; else inputStream = fopen(nm,FOPEN_MODE); #endif if (inputStream) { reading = SCRIPTFILE; c0 = ' '; c1 = '\n'; column = 1; row = 0; lastLine = STARTLINE; /* literate file processing */ litLines = 0; linePtr = 0; lineLength = 0; thisLiterate = literateMode(nm); inCodeBlock = FALSE; readSoFar = 0; setGoal("Parsing", (Target)len); } else { ERRMSG(0) "Unable to open file \"%s\"", nm EEND_NORET; return FALSE; } return TRUE; } Void stringInput(s) /* prepare to input characters from string */ String s; { reading = STRING; c0 = EOF; c1 = EOF; if (*s) c0 = *s++; if (*s) c1 = *s++; column = 1; row = 1; nextStringChar = s; if (!charTabBuilt) initCharTab(); } static Bool local literateMode(nm) /* Select literate mode for file */ String nm; { char *dot = strrchr(nm,'.'); /* look for last dot in file name */ if (dot) { if (filenamecmp(dot+1,"hs")==0) /* .hs files are never literate */ return FALSE; if (filenamecmp(dot+1,"lhs") ==0 || /* .lhs, .verb files are always*/ filenamecmp(dot+1,"verb")==0) /* literate scripts */ return TRUE; } return literateScripts; /* otherwise, use the default */ } /* This code originally came from Sigbjorn Finne (sof@dcs.gla.ac.uk). * I've removed the loop (since newLineSkip contains a loop too) and * replaced the warnings with errors. ADR */ /* * To deal with literate \begin{code}...\end{code} blocks, * add a line buffer that rooms the current line. The old c0 and c1 * stream pointers are used as before within that buffer -- sof * * Upon reading a new line into the line buffer, we check to see if * we're reading in a line containing \begin{code} or \end{code} and * take appropriate action. */ static Bool local linecmp(s,line) /* compare string with line */ String s; /* line may end in whitespace */ ShortChar *line; { Int i=0; while (s[i] != '\0' && s[i] == line[i]) { ++i; } /* s[0..i-1] == line[0..i-1] */ if (s[i] != '\0') { /* check s `isPrefixOf` line */ return FALSE; } while (isIn(line[i], SPACE)) { /* allow whitespace at end of line */ ++i; } return (line[i] == '\0'); } /* Returns line length (including \n) or 0 upon EOF. */ static Int local nextLine() { int ch; for (lineLength = 0; lineLength < LINEBUFFER_SIZE-1; lineLength++) { lineBuffer[lineLength] = (ch = FGetChar(inputStream)); if (ch == EOF) break; #if MULTI_LINEFEED if ((char)ch == '\r') { ch = fgetc(inputStream); /* ToDo: verify that this behaves correctly re EOF */ if ((char)ch != '\n') ungetc(ch, inputStream); lineBuffer[lineLength] = '\n'; lineLength++; break; } else #endif if ((char)ch == '\n') { lineLength++; break; } } lineBuffer[lineLength] = '\0'; if (lineLength <= 0) { /* EOF / IO error, who knows.. */ return lineLength; } else if (lineLength >= 2 && lineBuffer[0] == '#' && lineBuffer[1] == '!') { lineBuffer[0]='\n'; /* pretend it's a blank line */ lineBuffer[1]='\0'; lineLength=1; } else if (thisLiterate) { if (linecmp(BEGINCODE, lineBuffer)) { if (!inCodeBlock) { /* Entered a code block */ inCodeBlock = TRUE; lineBuffer[0]='\n'; /* pretend it's a blank line */ lineBuffer[1]='\0'; lineLength=1; } else { ERRMSG(row) "\\begin{code} encountered inside code block" EEND; } } else if (linecmp(ENDCODE, lineBuffer)) { if (inCodeBlock) { /* Finished code block */ inCodeBlock = FALSE; lineBuffer[0]='\n'; /* pretend it's a blank line */ lineBuffer[1]='\0'; lineLength=1; } else { ERRMSG(row) "\\end{code} encountered outside code block" EEND; } } } return lineLength; } static Void local skip() { /* move forward one char in input */ if (c0!=EOF) { /* stream, updating c0, c1, ... */ if (c0=='\n') { /* Adjusting cursor coords as nec. */ row++; column=1; if (reading==SCRIPTFILE) soFar(readSoFar); } else if (c0=='\t') column += TABSIZE - ((column-1)%TABSIZE); else column++; c0 = c1; readSoFar++; if (c0==EOF) { column = 0; if (reading==SCRIPTFILE) done(); closeAnyInput(); } else if (reading==KEYBOARD) { allowBreak(); if (c0=='\n') c1 = EOF; else { c1 = nextConsoleChar(); #if HAVE_WINDOWS_H && !HUGS_FOR_WINDOWS Sleep(0); #endif /* On Win32, hitting ctrl-C causes the next getchar to * fail - returning "-1" to indicate an error. * This is one of the rare cases where "-1" does not mean EOF. */ if (EOF == c1 && (!feof(stdin) || broken==TRUE)) { c1 = ' '; } } } else if (reading==NOKEYBOARD) { c1 = c0=='\n' ? EOF : FGetChar(stdin); } else if (reading==STRING) { c1 = ExtractChar(nextStringChar); if (c1 == '\0') c1 = EOF; } else { if (lineLength <=0 || linePtr == lineLength) { /* Current line, exhausted - get new one */ if (nextLine() <= 0) { /* EOF */ c1 = EOF; } else { linePtr = 0; c1 = lineBuffer[linePtr++]; } } else { c1 = lineBuffer[linePtr++]; } } } } static Void local thisLineIs(kind) /* register kind of current line */ Int kind; { /* & check for literate script errs */ if ((kind==DEFNLINE && lastLine==TEXTLINE) || (kind==TEXTLINE && lastLine==DEFNLINE)) { ERRMSG(row) "Program line next to comment" EEND; } lastLine = kind; } static Void local newlineSkip() { /* skip `\n' (supports lit scripts) */ /* assert(c0=='\n'); */ if (reading==SCRIPTFILE && thisLiterate) { do { skip(); if (inCodeBlock) { /* pass chars on definition lines */ thisLineIs(CODELINE); /* to lexer (w/o leading DEFNCHAR) */ litLines++; return; } if (c0==DEFNCHAR) { /* pass chars on definition lines */ thisLineIs(DEFNLINE); /* to lexer (w/o leading DEFNCHAR) */ skip(); litLines++; return; } while (c0!='\n' && isIn(c0,SPACE)) /* maybe line is blank? */ skip(); if (c0=='\n' || c0==EOF) thisLineIs(BLANKLINE); else { thisLineIs(TEXTLINE); /* otherwise it must be a comment */ while (c0!='\n' && c0!=EOF) skip(); } /* by now, c0=='\n' or c0==EOF */ } while (c0!=EOF); /* if new line, start again */ if (litLines==0) { ERRMSG(row) "Empty script - perhaps you forgot the `%c's?", DEFNCHAR EEND; } return; } skip(); } static Void local closeAnyInput() { /* Close input stream, if open, */ switch (reading) { /* or skip to end of console line */ case SCRIPTFILE : if (inputStream) { #if SUPPORT_PREPROCESSOR if (preprocessor) { pclose(inputStream); } else { fclose(inputStream); } #else fclose(inputStream); #endif inputStream = 0; } break; case KEYBOARD : while (c0!=EOF) skip(); break; } reading=NOTHING; } /* -------------------------------------------------------------------------- * Parser: Uses table driven parser generated from parser.y using yacc * ------------------------------------------------------------------------*/ # if __MWERKS__ && macintosh #include "parser.tab.c" #else #include "parser.c" #endif /* -------------------------------------------------------------------------- * Single token input routines: * * The following routines read the values of particular kinds of token given * that the first character of the token has already been located in c0 on * entry to the routine. * ------------------------------------------------------------------------*/ #define MAX_TOKEN 4000 #define startToken() tokPtr = tokenStr #define saveTokenChar(c) if (tokPtr<=tokenStr+MAX_TOKEN-MAX_CHAR_ENCODING) saveChar(c); else ++tokPtr #define saveChar(c) AddChar((c), tokPtr) #define overflows(n,b,d,m) (n > ((m)-(d))/(b)) static char tokenStr[MAX_TOKEN+1]; /* token buffer */ static String tokPtr; /* input position in buffer */ static Int identType; /* identifier type: CONID / VARID */ static Int opType; /* operator type : CONOP / VAROP */ static Void local endToken() { /* check for token overflow */ if (tokPtr>tokenStr+MAX_TOKEN) { ERRMSG(row) "Maximum token length (%d) exceeded", MAX_TOKEN EEND; } *tokPtr = '\0'; } static Text local readOperator() { /* read operator symbol */ startToken(); do { saveTokenChar(c0); skip(); } while (isLatin1(c0) && isIn(c0,SYMBOL)); opType = (tokenStr[0]==':' ? CONOP : VAROP); endToken(); return findText(tokenStr); } static Text local readIdent() { /* read identifier */ startToken(); do { saveTokenChar(c0); skip(); } while (isLatin1(c0) && isIn(c0,IDAFTER)); endToken(); identType = isIn(tokenStr[0],LARGE) ? CONID : VARID; return findText(tokenStr); } static Cell local readRadixNumber(r) /* Read literal in specified radix */ Int r; { /* from input of the form 0c{digs} */ Int d; skip(); /* skip leading zero */ if ((d=readHexDigit(c1))<0 || d>=r)/* Special case; no digits, lex as */ return mkInt(0); /* if it had been written "0 c..." */ else { Int n = 0; #if BIGNUMS Cell big = NIL; #endif skip(); do { #if BIGNUMS if (nonNull(big)) big = bigShift(big,d,r); else if (overflows(n,r,d,MAXPOSINT)) big = bigShift(bigInt(n),d,r); else #else if (overflows(n,r,d,MAXPOSINT)) { ERRMSG(row) "Integer literal out of range" EEND; } else #endif n = r*n + d; skip(); d = readHexDigit(c0); } while (d>=0 && d 0x7f) { *tokPtr++ = 0x80 | (c&0x7f); c >>= 7; } *tokPtr++ = c; } } else #endif if (c!='\0' && c!='\\') { /* save non null char as single char*/ saveTokenChar(c); } else { /* save null char as TWO null chars */ if (tokPtr enable \& and gaps */ Cell c = mkChar(c0); if (c0=='\\') { /* escape character? */ return readEscapeChar(isStrLit,TRUE); } #if !UNICODE_CHARS if (!isLatin1(c0)) { ERRMSG(row) "Non Latin-1 character `\\%d' in constant", ((int)c0) EEND; } #endif skip(); /* normal character? */ return c; } /* -------------------------------------------------------------------------- * Character escape code sequences: * ------------------------------------------------------------------------*/ static struct { /* table of special escape codes */ char *codename; int codenumber; } escapes[] = { {"a", 7}, {"b", 8}, {"f", 12}, {"n", 10}, /* common escapes */ {"r", 13}, {"t", 9}, {"\\",'\\'}, {"\"",'\"'}, {"\'",'\''}, {"v", 11}, {"NUL", 0}, {"SOH", 1}, {"STX", 2}, {"ETX", 3}, /* ascii codenames */ {"EOT", 4}, {"ENQ", 5}, {"ACK", 6}, {"BEL", 7}, {"BS", 8}, {"HT", 9}, {"LF", 10}, {"VT", 11}, {"FF", 12}, {"CR", 13}, {"SO", 14}, {"SI", 15}, {"DLE", 16}, {"DC1", 17}, {"DC2", 18}, {"DC3", 19}, {"DC4", 20}, {"NAK", 21}, {"SYN", 22}, {"ETB", 23}, {"CAN", 24}, {"EM", 25}, {"SUB", 26}, {"ESC", 27}, {"FS", 28}, {"GS", 29}, {"RS", 30}, {"US", 31}, {"SP", 32}, {"DEL", 127}, {0,0} }; static Int alreadyMatched; /* Record portion of input stream */ static char alreadyRead[10]; /* that has been read w/o a match */ static Bool local lazyReadMatches(s) /* compare input stream with string */ String s; { /* possibly using characters that */ int i; /* have already been read */ for (i=0; i=8) { ERRMSG(row) "Empty octal character escape" EEND; } do { if (overflows(n,8,d,MAXCHARVAL)) { ERRMSG(row) "Octal character escape out of range" EEND; } n = 8*n + d; skip(); } while ((d = readHexDigit(c0))>=0 && d<8); return mkChar(n); } static Cell local readHexChar() { /* read hex character constant */ Int n = 0; Int d; skip(/* 'x' */); if ((d = readHexDigit(c0))<0) { ERRMSG(row) "Empty hexadecimal character escape" EEND; } do { if (overflows(n,16,d,MAXCHARVAL)) { ERRMSG(row) "Hexadecimal character escape out of range" EEND; } n = 16*n + d; skip(); } while ((d = readHexDigit(c0))>=0); return mkChar(n); } static Int local readHexDigit(c) /* read single hex digit */ Char c; { if ('0'<=c && c<='9') return c-'0'; if ('A'<=c && c<='F') return 10 + (c-'A'); if ('a'<=c && c<='f') return 10 + (c-'a'); return -1; } static Cell local readDecChar() { /* read decimal character constant */ Int n = 0; do { if (overflows(n,10,(c0-'0'),MAXCHARVAL)) { ERRMSG(row) "Decimal character escape out of range" EEND; } n = 10*n + (c0-'0'); skip(); } while (c0!=EOF && isIn(c0,DIGIT)); return mkChar(n); } /* -------------------------------------------------------------------------- * Produce printable representation of character: * ------------------------------------------------------------------------*/ String unlexChar(c,quote) /* return string representation of */ Char c; /* character... */ Char quote; { /* protect quote character */ static char buffer[12]; assert(c >= 0); if (isascii(c) && isIn(c,PRINT)) { /* normal printable character */ if (c==quote || c=='\\') { /* look for quote of approp. kind */ buffer[0] = '\\'; buffer[1] = (char)c; buffer[2] = '\0'; } else { buffer[0] = (char)c; buffer[1] = '\0'; } } else { /* look for escape code */ Int escs; for (escs=0; escapes[escs].codename; escs++) if (escapes[escs].codenumber==c) { sprintf(buffer,"\\%s",escapes[escs].codename); return buffer; } sprintf(buffer,"\\%d",c); /* otherwise use numeric escape */ } return buffer; } Void printString(s) /* print string s, using quotes and */ String s; { /* escapes if any parts need them */ if (s) { String t = s; Char c; while ((c = *t)!=0 && isLatin1(c) && isIn(c,PRINT) && c!='"' && !isIn(c,SPACE)) { t++; } if (*t) { Putchar('"'); for (t=s; *t; ) Printf("%s",unlexChar(ExtractChar(t),'"')); Putchar('"'); } else Printf("%s",s); } } /* ------------------------------------------------------------------------- * Handle special types of input for use in interpreter: * -----------------------------------------------------------------------*/ Command readCommand(cmds,start,sys) /* read command at start of input */ struct cmd *cmds; /* line in interpreter */ Char start; /* characters introducing a cmd */ Char sys; { /* character for shell escape */ while (c0==' ' || c0 =='\t') skip(); if (c0=='\n') /* look for blank command lines */ return NOCMD; if (c0==EOF) /* look for end of input stream */ #if HUGS_FOR_WINDOWS return NOCMD; #else return QUIT; #endif if (c0==sys) { /* single character system escape */ skip(); return SYSTEM; } if (c0==start && c1==sys) { /* two character system escape */ skip(); skip(); return SYSTEM; } startToken(); /* All cmds start with start */ #if OBSERVATIONS if (c0==start || (start==0 && c0!=EOF)) /* except cmds without start char */ #else if (c0==start) /* except default (usually EVAL) */ #endif do { /* which is empty */ saveTokenChar(c0); skip(); } while (c0!=EOF && !isIn(c0,SPACE)); endToken(); for (; cmds->cmdString; ++cmds) if (strcmp((cmds->cmdString),tokenStr)==0 || (tokenStr[0]==start && tolower(tokenStr[1])==(cmds->cmdString)[1] && tokenStr[2]=='\0')) return (cmds->cmdCode); return BADCMD; } String readFilename() { /* Read filename from input (if any)*/ while (c0==' ' || c0=='\t') skip(); if (c0=='\n' || c0==EOF) /* return null string at end of line*/ return 0; startToken(); while (c0!=EOF && !isIn(c0,SPACE)) { if (c0=='"') { skip(); while (c0!=EOF && c0!='\"') { Cell c; /* Permit and treat an escaped space as legal character in a filename. Some environments include these when pasting filenames (MacOS X one, according to reports). Also, we no longer support the full array of escape chars in filename / option strings; apart from '\ ', only '\"' and '\\' are recognised. This is done to have lone backslashes (as is common in filenames on certain platforms) be interpreted as just that. As was, such backslashes would either cause the interpreter to fall over (and fail to start up) or be interpreted as some (unintended) escaped character. */ if (c0 == '\\') { skip(); if (c0 == '"' || c0 == ' ' || c0 == '\\') { saveTokenChar(c0); skip(); continue; } else { saveTokenChar('\\'); continue; } } else { c = readAChar(TRUE); } if (nonNull(c)) { saveTokenChar(charOf(c)); } } if (c0=='"') skip(); else { ERRMSG(row) "a closing quote, '\"', was expected" EEND; } } else { Int savedChar = c0; skip(); /* Handle escaped spaces - see above comment. */ if (savedChar == '\\' && c0 == ' ') { saveTokenChar(' '); skip(); } else { saveTokenChar(savedChar); } } } endToken(); return tokenStr; } String readLine() { /* Read command line from input */ while (c0==' ' || c0=='\t') /* skip leading whitespace */ skip(); startToken(); while (c0!='\n' && c0!=EOF) { saveTokenChar(c0); skip(); } endToken(); return tokenStr; } /* -------------------------------------------------------------------------- * This lexer supports the Haskell layout rule: * * - Layout area bounded by { ... }, with `;'s in between. * - A `{' is a HARD indentation and can only be matched by a corresponding * HARD '}' * - Otherwise, if no `{' follows the keywords WHERE/LET or OF, a SOFT `{' * is inserted with the column number of the first token after the * WHERE/LET/OF keyword. * - When a soft indentation is uppermost on the indentation stack with * column col' we insert: * `}' in front of token with column=MAXINDENT) { ERRMSG(row) "Too many levels of program nesting" EEND; } layout[++indentDepth] = col; } static Void local unOffside() { /* leave layout rule area */ indentDepth--; } static Bool local canUnOffside() { /* Decide if unoffside permitted */ return indentDepth>=0 && layout[indentDepth]!=HARD; } /* -------------------------------------------------------------------------- * Main tokeniser: * ------------------------------------------------------------------------*/ static Void local skipWhitespace() { /* Skip over whitespace/comments */ for (;;) /* Strictly speaking, this code is */ if (c0==EOF) /* a little more liberal than the */ return; /* report allows ... */ else if (c0=='\n') newlineSkip(); else if (isIn(c0,SPACE)) skip(); else if (c0=='{' && c1=='-') { /* (potentially) nested comment */ Int nesting = 1; Int origRow = row; /* Save original row number */ skip(); skip(); while (nesting>0 && c0!=EOF) if (c0=='{' && c1=='-') { skip(); skip(); nesting++; } else if (c0=='-' && c1=='}') { skip(); skip(); nesting--; } else if (c0=='\n') newlineSkip(); else skip(); if (nesting>0) { ERRMSG(origRow) "Unterminated nested comment {- ..." EEND; } } else if (c0=='-' && c1=='-') { /* One line comment */ do skip(); while (c0!='\n' && c0!=EOF); if (c0=='\n') newlineSkip(); } else return; } static Bool allDashes(char* s) { char* ptr = s; while ( *ptr != '\0' ) { if (*ptr != '-') return FALSE; ptr++; } return TRUE; } static Bool foundDashedOp = FALSE; /* * Haskell98 makes it harder to detect one-line comment markup, * "--" is now only the start of a one-line comment if it isn't * followed by symbol chars other than "-". i.e., need to tokenise * anything that starts with "--" as an operator and check whether * the lexeme consists of all dashes or not. */ static Void local skipWhitespaceTok() { /* Skip over whitespace/comments */ for (;;) /* Strictly speaking, this code is */ if (c0==EOF) /* a little more liberal than the */ return; /* report allows ... */ else if (c0=='\n') newlineSkip(); else if (isIn(c0,SPACE)) skip(); else if (c0=='{' && c1=='-') { /* (potentially) nested comment */ Int nesting = 1; Int origRow = row; /* Save original row number */ skip(); skip(); while (nesting>0 && c0!=EOF) if (c0=='{' && c1=='-') { skip(); skip(); nesting++; } else if (c0=='-' && c1=='}') { skip(); skip(); nesting--; } else if (c0=='\n') newlineSkip(); else skip(); if (nesting>0) { ERRMSG(origRow) "Unterminated nested comment {- ..." EEND; } } else if (c0=='-' && c1=='-') { /* One line comment... */ /* ..possibly, could also be the start of an operator, so tokenise the operator symbol & check whether it consists of all dashes or not. */ readOperator(); if (!allDashes(tokenStr)) { /* Yep, return (with the operator in the token buffer). */ foundDashedOp = TRUE; return; } else { /* Reset token buffer */ startToken(); } while (c0!='\n' && c0!=EOF) { skip(); } if (c0=='\n') newlineSkip(); } else return; } static Bool firstToken; /* Set to TRUE for first token */ static Int firstTokenIs; /* ... with token value stored here */ static Int local yylex() { /* Read next input token ... */ static Bool insertOpen = FALSE; static Bool insertClose = FALSE; static Bool insertedToken = FALSE; static Bool inADo = FALSE; static Text textRepeat; Bool readingRepeat = repeatStr && (reading==KEYBOARD || reading==STRING); #define lookAhead(t) {skipWhitespace(); insertOpen = (c0!='{'); inADo = (t==DO); return t;} if (firstToken) { /* Special case for first token */ indentDepth = (-1); firstToken = FALSE; insertOpen = FALSE; insertedToken = FALSE; inADo = FALSE; if (readingRepeat) textRepeat = findText(repeatStr); return firstTokenIs; } if ( insertOpen ) { /* insert `soft' opening brace */ insertOpen = FALSE; insertedToken = TRUE; /* If the indentation of a nested layout context is not more indented than the current/enclosing, empty braces are inserted. cf. of Section B.3 (note 2) of the Haskell98 report. Extension: adopt GHC's special (and useful) handling of the following (comment straight out of ghc/compiler/parser/Lex.lhs): There's also a special hack in here to deal with do .... e $ do blah i.e. the inner context is at the same indentation level as the outer context. This is strictly illegal according to Haskell 98, but there's a lot of existing code using this style and it doesn't make any sense to disallow it, since empty 'do' lists don't make sense. */ insertClose = (indentDepth >=0 && (inADo ? column < layout[indentDepth] : column <= layout[indentDepth])); if (!insertClose) { goOffside(column); } push(yylval = mkInt(row)); return '{'; } if ( insertClose ) { insertOpen = FALSE; insertClose = FALSE; insertedToken = FALSE; push(yylval = mkInt(row)); return '}'; } #if HERE_DOC if (hereState) { switch (hereState) { case KEEP_GOING : readHereString(); return STRINGLIT; case BEGIN_VAR : hereJoin(); hereState = ISSUE_QUOTE; return VAROP; case ISSUE_QUOTE : hereQuote(); hereState = HERE_VAR; return VARID; case HERE_VAR : hereState = END_VAR; /* will parse and return id, and come back in the right state */ break; case END_VAR : skipWhitespace(); if (c0!=')') { ERRMSG(row) "Improperly escaped variable in here document" EEND; } skip(); hereJoin(); hereState = KEEP_GOING; return VAROP; case CLOSE_PAREN : push(yylval = mkInt(row)); hereState = START; return ')'; } } #endif /* ---------------------------------------------------------------------- * Skip white space, and insert tokens to support layout rules as reqd. * --------------------------------------------------------------------*/ skipWhitespaceTok(); startColumn = column; push(yylval = mkInt(row)); /* default token value is line no. */ /* subsequent changes to yylval must also set top() to the same value */ if (indentDepth>=0) { /* layout rule(s) active ? */ if (insertedToken) { /* avoid inserting multiple `;'s */ insertedToken = FALSE; /* or putting `;' after `{' */ } else if (layout[indentDepth]!=HARD) { if (column"); textLazy = findText("~"); textBang = findText("!"); textDot = findText("."); textImplies = findText("=>"); textPrelude = findText(STD_PRELUDE_HUGS); textUserPrelude= findText(STD_PRELUDE); textNum = findText("Num"); textModule = findText("module"); textImport = findText("import"); textHiding = findText("hiding"); textQualified = findText("qualified"); textNeedPrims = findText("needPrims_hugs"); textForeign = findText("foreign"); textExport = findText("export"); textCCall = findText("ccall"); textSafe = findText("safe"); textUnsafe = findText("unsafe"); textThreadsafe = findText("threadsafe"); #if STDCALL_SUPPORTED textStdcall = findText("stdcall"); #endif #ifdef DOTNET textDotnet = findText("dotnet"); #endif textAsMod = findText("as"); textWildcard = findText("_"); textAll = findText("forall"); varMinus = mkVar(textMinus); varPlus = mkVar(textPlus); varBang = mkVar(textBang); varDot = mkVar(textDot); varHiding = mkVar(textHiding); varQualified = mkVar(textQualified); varAsMod = mkVar(textAsMod); conMain = mkCon(findText("Main")); varMain = mkVar(findText("main")); evalDefaults = NIL; input(RESET); break; case RESET : tyconDefns = NIL; typeInDefns = NIL; valDefns = NIL; classDefns = NIL; instDefns = NIL; selDefns = NIL; genDefns = NIL; primDefns = NIL; unqualImports= NIL; foreignCount = 0; foreignImports= NIL; foreignExports= NIL; defaultDefns = NIL; defaultLine = 0; inputExpr = NIL; imps = NIL; closeAnyInput(); break; case BREAK : if (reading==KEYBOARD) c0 = EOF; break; case MARK : mark(tyconDefns); mark(typeInDefns); mark(valDefns); mark(classDefns); mark(instDefns); mark(selDefns); mark(genDefns); mark(primDefns); mark(unqualImports); mark(foreignImports); mark(foreignExports); mark(defaultDefns); mark(evalDefaults); mark(inputExpr); mark(varMinus); mark(varPlus); mark(varBang); mark(varDot); mark(varHiding); mark(varQualified); mark(varAsMod); mark(varMain); mark(conMain); mark(imps); break; } } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/interns.c0000644006511100651110000003411207756762574015432 0ustar rossross/* -------------------------------------------------------------------------- * Implementation of primitives which provide access to internal Hugs * data structures and representations from within Haskell. * * Despite appearances, the only primitives which break referential * transparency are the pointer equality primitives. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: interns.c,v $ * $Revision: 1.14 $ * $Date: 2003/11/19 21:49:48 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * internalPrims control * ------------------------------------------------------------------------*/ static Void linkInternals Args((Void)); static Name nameLeft; /* standard data constructors */ static Name nameRight; static Void local internalControl Args((Int)); static Void local internalControl(what) Int what; { switch (what) { case INSTALL : #define predef(nm,str) nm=newName(findText(str),NIL); name(nm).defn=PREDEFINED setCurrModule(modulePrelude); predef(nameLeft, "Left"); predef(nameRight, "Right"); #undef predef break; case RESET : linkInternals(); break; } } PROTO_PRIM(primGetCell); PROTO_PRIM(primCellPtrEq); PROTO_PRIM(primCatchError2); PROTO_PRIM(primClassifyCell); PROTO_PRIM(primNameInfo); PROTO_PRIM(primNameEq); PROTO_PRIM(primNameString); #if BYTECODE_PRIMS PROTO_PRIM(primNameCode); PROTO_PRIM(primIntAt); PROTO_PRIM(primFloatAt); PROTO_PRIM(primDoubleAt); PROTO_PRIM(primCellAt); PROTO_PRIM(primNameAt); PROTO_PRIM(primBytecodeAt); PROTO_PRIM(primTextAt); PROTO_PRIM(primAddrAt); #endif /* BYTECODE_PRIMS */ static struct primitive internalPrimTable[] = { {"getCell", 1, primGetCell}, {"cellPtrEq", 2, primCellPtrEq}, {"catchError2", 1, primCatchError2}, {"classifyCell", 2+IOArity, primClassifyCell}, {"nameString", 1, primNameString}, {"nameInfo", 1, primNameInfo}, {"nameEq", 2, primNameEq}, #if BYTECODE_PRIMS {"nameCode", 1, primNameCode}, {"intAt", 1, primIntAt}, {"floatAt", 1, primFloatAt}, {"doubleAt", 1, primDoubleAt}, {"cellAt", 1, primCellAt}, {"nameAt", 1, primNameAt}, {"bytecodeAt", 1, primBytecodeAt}, {"textAt", 1, primTextAt}, {"addrAt", 1, primAddrAt}, #endif /* BYTECODE_PRIMS */ {0, 0, 0} }; static struct primInfo internalPrims = {internalControl, internalPrimTable, 0}; /* -------------------------------------------------------------------------- * linkInternals * ------------------------------------------------------------------------*/ static Module moduleInternals; static Name nameHugsApply; /* data CellKind = Apply Cell [Cell] */ static Name nameHugsFun; /* | Fun Name */ static Name nameHugsCon; /* | Con Name */ static Name nameHugsTuple; /* | Tuple Int */ static Name nameHugsInt; /* | Int Int */ static Name nameHugsInteger; /* | Integer Integer */ static Name nameHugsFloat; /* | Float Float */ static Name nameHugsDouble; /* | Double Double */ static Name nameHugsChar; /* | Char Char */ static Name nameHugsPrim; /* | Prim String */ static Name nameHugsError; /* | Error Cell */ static Void linkInternals() { String internLib = "Hugs.Internals"; moduleInternals = findModule(findText(internLib)); if (nonNull(moduleInternals)) { setCurrModule(moduleInternals); nameHugsApply = findName(findText("Apply")); nameHugsFun = findName(findText("Fun")); nameHugsCon = findName(findText("Con")); nameHugsTuple = findName(findText("Tuple")); nameHugsInt = findName(findText("Int")); nameHugsInteger = findName(findText("Integer")); nameHugsFloat = findName(findText("Float")); nameHugsDouble = findName(findText("Double")); nameHugsChar = findName(findText("Char")); nameHugsPrim = findName(findText("Prim")); nameHugsError = findName(findText("Error")); if (isNull(nameHugsApply) || isNull(nameHugsFun) || isNull(nameHugsCon) || isNull(nameHugsTuple) || isNull(nameHugsInt) || isNull(nameHugsInteger) || isNull(nameHugsFloat) || isNull(nameHugsDouble) || isNull(nameHugsChar) || isNull(nameHugsPrim) || isNull(nameHugsError) ) { fatal("module HugsInternals doesn't define CellKind correctly"); } } } /* -------------------------------------------------------------------------- * Operations on Cells * ------------------------------------------------------------------------*/ /* Cells have to be boxed (using the HUGSOBJECT tag) so that we can */ /* evaluate a Cell expression such as "fst (cell1, cell2)" without */ /* evaluating the thunk inside the Cell. */ #define isHugsObject(a) (isPair(a) && fst(a)==HUGSOBJECT) #define checkHugsObject(x) \ if (!isHugsObject(x)) internal("HugsObject expected") #define HugsObjectArg(nm, offset) \ eval(primArg(offset)); \ checkHugsObject(whnfHead); \ nm = snd(whnfHead); primFun(primGetCell) { /* Trivial coercion */ updapRoot(HUGSOBJECT,primArg(1)); /* :: a -> Cell */ } /* -------------------------------------------------------------------------- * Pointer equality on Cells * ------------------------------------------------------------------------*/ primFun(primCellPtrEq) { /* Unsafe pointer equality test */ Cell x = 0; Cell y = 0; HugsObjectArg(x,1); push(x); HugsObjectArg(y,2); x = pop(); /* We chase indirection chains since that's easy and gives more * accurate results. * Don't do this if we use this function during error recovery - * it might be possible for an infinite loop to occur. */ while (isPair(x) && INDIRECT == fst(x)) x = snd(x); while (isPair(y) && INDIRECT == fst(y)) y = snd(y); updateRoot( (x==y) ? nameTrue : nameFalse ); } /* -------------------------------------------------------------------------- * Error catching - evaluate a Cell and return an error redex or its value * ------------------------------------------------------------------------*/ primFun(primCatchError2) { /* Error catching primitive */ /* :: a -> Either Cell a */ Cell err = NIL; err = evalWithNoError(primArg(1)); if (isNull(err)) { updapRoot(nameRight, primArg(1)); } else { updapRoot(nameLeft, ap(HUGSOBJECT, err)); } } /* -------------------------------------------------------------------------- * Examine an object either with or without evaluation. * * This primitive lets Haskell programs examine values of any datatype * (probably to print them). It is wired into the IO monad to (narrowly) * avoid breaking referential transparency. * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Note: we can't force the object _outside_ classify for two reasons: * * 1) Writing "strict classifyCell x" only causes x to be evaluated to * WHNF. Since x is a Cell, this doesn't achieve very much. * * 2) We can overcome this by adding an operation * * "forceCell :: Cell -> Cell" * * and writing "classifyObject (forceObject x)" but, if "x" is a CAF, * then "x" will be updated but the indirection via "x" will remain * in place. * ------------------------------------------------------------------------*/ primFun(primClassifyCell) { /* classifyCell */ Bool gc = consGC; /* :: Bool -> Cell -> IO CellKind */ Bool strict; Cell result = NIL; BoolArg(strict,2+IOArity); if (strict) { Cell temp; eval(IOArg(1)); /* object */ checkHugsObject(whnfHead); whnfHead = snd(whnfHead); if (nonNull(temp = evalWithNoError(whnfHead))) { IOReturn(ap(nameHugsError,ap(HUGSOBJECT,temp))); } } else { eval(IOArg(1)); /* object */ checkHugsObject(whnfHead); whnfHead = snd(whnfHead); unwind(whnfHead); } consGC = TRUE; if (whnfArgs > 0) { Cell args = nameNil; while (whnfArgs-- > 0) args = ap(ap(nameCons, ap(HUGSOBJECT, pushed(whnfArgs))), args); result = ap(ap(nameHugsApply, ap(HUGSOBJECT,whnfHead)), args); } else { switch (whatIs(whnfHead)) { case NAME : result = ap((isCfun(whnfHead) ? nameHugsCon : nameHugsFun), mkInt(whnfHead)); break; case TUPLE : result = ap(nameHugsTuple,mkInt(tupleOf(whnfHead))); break; #if BIGNUMS case ZERONUM : case POSNUM : case NEGNUM : result = ap(nameHugsInteger, whnfHead); break; #endif case INTCELL : result = ap(nameHugsInt, whnfHead); break; case CHARCELL : result = ap(nameHugsChar, whnfHead); break; case FLOATCELL: result = ap(nameHugsFloat, whnfHead); break; case DOUBLECELL: result = ap(nameHugsDouble, whnfHead); break; #if IO_HANDLES case HANDCELL : result = ap(nameHugsPrim, mkStr(findText("{handle}"))); break; #endif #if IO_REFS case MUTVAR : result = ap(nameHugsPrim, mkStr(findText("{ref}"))); break; #endif #if HASKELL_ARRAYS case ARRAY : result = ap(nameHugsPrim, mkStr(findText("{primitive array}"))); break; #endif case HUGSOBJECT : /* ToDo: fix so that debugger can examine itself */ result = ap(nameHugsPrim, mkStr(findText("{Cell ...}"))); break; case INSTANCE : result = ap(nameHugsPrim, mkStr(findText("{instance}"))); break; #if OBSERVATIONS case OBSERVE : result = ap(nameHugsPrim, mkStr(findText("{observe marker}"))); break; #endif default : internal("Error in graph2"); break; } } consGC = gc; IOReturn(result); } /* -------------------------------------------------------------------------- * Operations on Names * ------------------------------------------------------------------------*/ primFun(primNameString) { /* Get string of a name */ Text t; /* :: Name -> String */ Name nm; IntArg(nm,1); t = name(nm).text; if (0 <= t && t < NUM_TEXT) { /* ToDo: replace updateRoot(mkStr(..)) with updapRoot(STRCELL,..) */ updateRoot(mkStr(t)); } else { /* If textToStr generates result on the fly, we build the entire * string now. */ pushString(textToStr(t)); updateRoot(pop()); } } primFun(primNameInfo) { /* Get arity and fixity of a Name */ Name nm; /* :: Name -> (Int,Int,Char) */ Syntax syn = 0; Char assoc = 0; IntArg(nm,1); syn = syntaxOf(nm); switch (assocOf(syn)) { case APPLIC : assoc = 'A'; break; case LEFT_ASS : assoc = 'L'; break; case RIGHT_ASS : assoc = 'R'; break; case NON_ASS : assoc = 'N'; break; } updapRoot(ap(ap(mkTuple(3), mkInt(name(nm).arity)), mkInt(precOf(syn))), mkChar(assoc)); } primFun(primNameEq) { /* Compare names */ Name nm1; /* :: Name -> Name -> Bool */ Name nm2; IntArg(nm1,2); IntArg(nm2,1); BoolResult(nm1==nm2); } #if BYTECODE_PRIMS primFun(primNameCode) { /* Obtain address of first bytecode */ Name nm; /* :: Name -> Addr */ IntArg(nm,1); IntResult(name(nm).code); } #endif /* BYTECODE_PRIMS */ /* -------------------------------------------------------------------------- * Operations on Addresses/Bytecodes * ------------------------------------------------------------------------*/ #if BYTECODE_PRIMS primFun(primIntAt) { /* Obtain Int at address */ Addr m; /* :: Addr -> Int */ IntArg(m,1); IntResult(IntAt(m)); } primFun(primFloatAt) { /* Obtain float at address */ Addr m; /* :: Addr -> Cell */ IntArg(m,1); FloatResult(FloatAt(m)); } primFun(primDoubleAt) { /* Obtain float at address */ Addr m; /* :: Addr -> Cell */ IntArg(m,1); DoubleResult(DoubleAt(m)); } primFun(primCellAt) { /* Obtain cell at address */ Addr m; /* :: Addr -> Cell */ IntArg(m,1); updapRoot(HUGSOBJECT,CellAt(m)); } primFun(primNameAt) { /* Obtain Name at address */ Addr m; /* :: Addr -> Name */ IntArg(m,1); IntResult(CellAt(m)); } primFun(primBytecodeAt) { /* Obtain bytecode at address */ Addr m; /* :: Addr -> Bytecode */ IntArg(m,1); IntResult(InstrAt(m)); } primFun(primTextAt) { /* Obtain string at address */ Addr m; /* :: Addr -> String */ IntArg(m,1); updapRoot(STRCELL,TextAt(m)); } primFun(primAddrAt) { /* Obtain address at address */ Addr m; /* :: Addr -> Addr */ IntArg(m,1); IntResult(AddrAt(m)); } #endif /* BYTECODE_PRIMS */ /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/iomonad.c0000644006511100651110000014136510426071620015354 0ustar rossross/* -------------------------------------------------------------------------- * Implementation of the Haskell IO monad. * * The primitives below implement the standard IO monad for Haskell 1.3 * using a continuation passing monad for sequencing. The primitives are * believed to give a reasonably good implementation of the semantics * specified by the Haskell 1.3 report. There are also some additional * primitives, particularly for dealing with IOError and Handle values * that are not included in the prelude, but are used by standard libraries. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: iomonad.c,v $ * $Revision: 1.101 $ * $Date: 2006/05/03 09:10:40 $ * ------------------------------------------------------------------------*/ Name nameIORun; /* run IO code */ Name nameIOBind; /* bind IO code */ Name namePutStr; /* Prelude.putStr */ static Name namePass; /* auxiliary:: \f b a -> f a b */ #if IO_HANDLES static Name nameHreader; /* auxiliary function */ #endif static Cell hugsProgName; /* value of getProgName */ static Cell hugsArgs; /* value of getArgs */ #if IO_HANDLES static Void local throwErrno Args((String,Bool,Int,Cell *)); static String local toIOErrorDescr Args((int,Bool)); static Name local toIOError Args((int)); static Int local newHandle Args((Cell *,String)); static String local modeString Args((Int,Bool)); static Cell local openHandle Args((StackPtr,Cell *,Int,Bool,String)); static Cell local openFdHandle Args((StackPtr,Int,Int,Bool,String)); static Char local hGetChar Args((Int,String)); static Void local hPutChar Args((Char,Int,String)); static Void local setRWState Args((Int,Int)); static Void local checkOpen Args((Int,String)); static Void local checkReadable Args((Int,String)); static Void local checkWritable Args((Int,String)); #endif #if IO_HANDLES # if WANT_FIXED_SIZE_TABLES # define MAX_HANDLES NUM_HANDLES # else # define MAX_HANDLES num_handles # endif #endif extern Void local pushString Args((String)); /* -------------------------------------------------------------------------- * IO monad control: * ------------------------------------------------------------------------*/ static Void iomonadControl Args((Int)); static Void iomonadControl(what) Int what; { switch (what) { case INSTALL : setCurrModule(modulePrelude); #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePrelude,NIL) pFun(namePass, "_pass", "passIO"); #if IO_HANDLES pFun(nameHreader, "_hreader", "hreader"); #endif #undef pFun #define predef(nm,str) nm=newName(findText(str),NIL); name(nm).defn=PREDEFINED predef(nameIORun, "hugsIORun"); predef(nameIOBind, "primbindIO"); predef(namePutStr, "putStr"); #undef predef break; case MARK : mark(hugsProgName); mark(hugsArgs); break; } } PROTO_PRIM(primReturnIO); PROTO_PRIM(primBindIO); PROTO_PRIM(primPass); PROTO_PRIM(primGC); PROTO_PRIM(primGetEnv); PROTO_PRIM(primSystem); PROTO_PRIM(primGetRandomSeed); PROTO_PRIM(primGetProgName); PROTO_PRIM(primGetArgs); PROTO_PRIM(primSetProgName); PROTO_PRIM(primSetArgs); #if IO_HANDLES static Void local fopenPrim Args((StackPtr,Bool,String)); static int local getIOMode Args((Cell)); PROTO_PRIM(primHGetChar); PROTO_PRIM(primHPutChar); PROTO_PRIM(primHPutStr); PROTO_PRIM(primHreader); PROTO_PRIM(primHContents); PROTO_PRIM(primOpenFile); PROTO_PRIM(primOpenBinaryFile); PROTO_PRIM(primStdin); PROTO_PRIM(primStdout); PROTO_PRIM(primStderr); PROTO_PRIM(primOpenFd); PROTO_PRIM(primHandleToFd); PROTO_PRIM(primHIsEOF); PROTO_PRIM(primHFlush); PROTO_PRIM(primHClose); PROTO_PRIM(primHGetPosn); PROTO_PRIM(primHSetPosn); PROTO_PRIM(primHSetBuffering); PROTO_PRIM(primHGetBuffering); PROTO_PRIM(primHSeek); PROTO_PRIM(primHLookAhead); PROTO_PRIM(primHIsOpen); PROTO_PRIM(primHIsClosed); PROTO_PRIM(primHIsReadable); PROTO_PRIM(primHIsWritable); PROTO_PRIM(primHIsSeekable); PROTO_PRIM(primHFileSize); PROTO_PRIM(primHWaitForInput); PROTO_PRIM(primEqHandle); PROTO_PRIM(primGetHandleNumber); PROTO_PRIM(primHSetBinaryMode); PROTO_PRIM(primHPutBuf); PROTO_PRIM(primHGetBuf); PROTO_PRIM(primHIsTerminalDevice); PROTO_PRIM(primHGetEcho); PROTO_PRIM(primHSetEcho); PROTO_PRIM(primIOEql); PROTO_PRIM(primIOHash); #endif #if IO_REFS PROTO_PRIM(primNewRef); PROTO_PRIM(primDerefRef); PROTO_PRIM(primAssignRef); PROTO_PRIM(primEqRef); #endif PROTO_PRIM(primMakeSP); PROTO_PRIM(primDerefSP); PROTO_PRIM(primFreeSP); PROTO_PRIM(primCastSPToP); PROTO_PRIM(primCastPToSP); PROTO_PRIM(primNewFP); PROTO_PRIM(primAddFPF); PROTO_PRIM(primAddFPFEnv); PROTO_PRIM(primWriteFP); PROTO_PRIM(primEqFP); PROTO_PRIM(primTouchFP); PROTO_PRIM(primFPToP); #if GC_WEAKPTRS PROTO_PRIM(primWeakPtrEq); PROTO_PRIM(primMkWeak); PROTO_PRIM(primDeRefWeak); PROTO_PRIM(primReplaceFinalizer); PROTO_PRIM(primFinalize); PROTO_PRIM(primRunFinalizer); PROTO_PRIM(primFinalizerWaiting); #endif #if STABLE_NAMES PROTO_PRIM(primMakeSN); PROTO_PRIM(primDerefSN); PROTO_PRIM(primHashSN); PROTO_PRIM(primEqSN); #endif #ifdef HSCRIPT PROTO_PRIM(primGetCurrentScript); #endif #ifdef DOTNET /* These primops are remnants from the first attempt at * providing .NET interop for Haskell / Hugs. They've been * mostly superceeded by the integration of .NET interop * with the Haskell FFI, but we'll keep these primops around * for a little bit longer. */ EXT_PROTO_PRIM(primCreateObject); EXT_PROTO_PRIM(primInvokeMethod); EXT_PROTO_PRIM(primInvokeStaticMethod); EXT_PROTO_PRIM(primNewString); EXT_PROTO_PRIM(primToHsString); EXT_PROTO_PRIM(primNewArgArray); EXT_PROTO_PRIM(primSetArg); EXT_PROTO_PRIM(primGetArg); EXT_PROTO_PRIM(primGetField); EXT_PROTO_PRIM(primSetField); EXT_PROTO_PRIM(primGetStaticField); EXT_PROTO_PRIM(primSetStaticField); EXT_PROTO_PRIM(primIsNullPtr); EXT_PROTO_PRIM(primMkPrimVector); #endif static struct primitive iomonadPrimTable[] = { {"primretIO", 1+IOArity, primReturnIO}, {"primbindIO", 2+IOArity, primBindIO}, {"passIO", 2+IOArity, primPass}, {"primGC", 0+IOArity, primGC}, {"getEnv", 1+IOArity, primGetEnv}, {"primSystem", 1+IOArity, primSystem}, {"getRandomSeed", 0+IOArity, primGetRandomSeed}, {"primGetProgName", 0+IOArity, primGetProgName}, {"primGetArgs", 0+IOArity, primGetArgs}, {"primSetProgName", 1+IOArity, primSetProgName}, {"primSetArgs", 1+IOArity, primSetArgs}, #if IO_HANDLES {"hGetChar", 1+IOArity, primHGetChar}, {"hPutChar", 2+IOArity, primHPutChar}, {"hPutStr", 2+IOArity, primHPutStr}, {"hreader", 1, primHreader}, {"hGetContents", 1+IOArity, primHContents}, {"openFile", 2+IOArity, primOpenFile}, {"openBinaryFile", 2+IOArity, primOpenBinaryFile}, {"openFd", 4+IOArity, primOpenFd}, {"handleToFd", 1+IOArity, primHandleToFd}, {"stdin", 0, primStdin}, {"stdout", 0, primStdout}, {"stderr", 0, primStderr}, {"hIsEOF", 1+IOArity, primHIsEOF}, {"hFlush", 1+IOArity, primHFlush}, {"hClose", 1+IOArity, primHClose}, {"hGetPosnPrim", 1+IOArity, primHGetPosn}, {"hSetPosnPrim", 2+IOArity, primHSetPosn}, {"hSetBuff", 3+IOArity, primHSetBuffering}, {"hGetBuff", 1+IOArity, primHGetBuffering}, {"hSeekPrim", 3+IOArity, primHSeek}, {"hLookAhead", 1+IOArity, primHLookAhead}, {"hIsOpen", 1+IOArity, primHIsOpen}, {"hIsClosed", 1+IOArity, primHIsClosed}, {"hIsReadable", 1+IOArity, primHIsReadable}, {"hIsWritable", 1+IOArity, primHIsWritable}, {"hIsSeekable", 1+IOArity, primHIsSeekable}, {"hFileSize", 1+IOArity, primHFileSize}, {"hWaitForInput", 2+IOArity, primHWaitForInput}, {"primEqHandle", 2, primEqHandle}, {"primGetHandleNumber", 1, primGetHandleNumber}, {"hSetBinaryMode", 2+IOArity, primHSetBinaryMode}, {"hPutBuf", 3+IOArity, primHPutBuf}, {"hGetBuf", 3+IOArity, primHGetBuf}, {"hIsTerminalDevice", 1+IOArity, primHIsTerminalDevice}, {"hGetEcho", 1+IOArity, primHGetEcho}, {"hSetEcho", 2+IOArity, primHSetEcho}, #endif #if IO_REFS {"newRef", 1+IOArity, primNewRef}, {"getRef", 1+IOArity, primDerefRef}, {"setRef", 2+IOArity, primAssignRef}, {"eqRef", 2, primEqRef}, #endif {"makeStablePtr", 1+IOArity, primMakeSP}, {"deRefStablePtr", 1+IOArity, primDerefSP}, {"freeStablePtr", 1+IOArity, primFreeSP}, {"castStablePtrToPtr",1, primCastSPToP}, {"castPtrToStablePtr",1, primCastPToSP}, {"writeForeignObj", 2+IOArity, primWriteFP}, {"eqForeignObj", 2, primEqFP}, {"newForeignPtr_", 1+IOArity, primNewFP}, {"addForeignPtrFinalizer", 2+IOArity, primAddFPF}, {"addForeignPtrFinalizerEnv", 3+IOArity, primAddFPFEnv}, {"touchForeignPtr", 1+IOArity, primTouchFP}, {"unsafeForeignPtrToPtr", 1, primFPToP}, #if GC_WEAKPTRS {"weakPtrEq", 2, primWeakPtrEq}, {"mkWeak", 3+IOArity, primMkWeak}, {"deRefWeak", 1+IOArity, primDeRefWeak}, {"replaceFinalizer", 2+IOArity, primReplaceFinalizer}, {"finalize", 1+IOArity, primFinalize}, {"runFinalizer", 0+IOArity, primRunFinalizer}, {"finalizerWaiting", 0+IOArity, primFinalizerWaiting}, #endif #if STABLE_NAMES {"makeStableName", 1+IOArity, primMakeSN}, {"deRefStableName", 1, primDerefSN}, {"hashStableName", 1, primHashSN}, {"eqStableName", 2, primEqSN}, #endif #ifdef HSCRIPT {"getCurrentScript", 0+IOArity, primGetCurrentScript}, #endif #ifdef DOTNET {"createObject", 2+IOArity, primCreateObject}, {"invokeMethod", 3+IOArity, primInvokeMethod}, {"invokeStaticMethod", 2+IOArity, primInvokeStaticMethod}, {"newString", 1+IOArity, primNewString}, {"toString", 1+IOArity, primToHsString}, {"newArgArray", 1+IOArity, primNewArgArray}, {"setArrayArg", 3+IOArity, primSetArg}, {"getArrayArg", 2+IOArity, primGetArg}, {"getField", 2+IOArity, primGetField}, {"setField", 3+IOArity, primSetField}, {"getStaticField", 2+IOArity, primGetStaticField}, {"setStaticField", 3+IOArity, primSetStaticField}, {"isNullPtr", 1+IOArity, primIsNullPtr}, {"mkPrimVector", 2+IOArity, primMkPrimVector}, #endif {"IOEql", 2+IOArity, primIOEql}, {"IOHash", 1+IOArity, primIOHash}, {0, 0, 0} }; static struct primInfo iomonadPrims = { iomonadControl, iomonadPrimTable, 0 }; /* -------------------------------------------------------------------------- * The monad combinators: * ------------------------------------------------------------------------*/ primFun(primReturnIO) { /* IO monad unit */ IOReturn(IOArg(1)); } primFun(primBindIO) { /* IO monad bind */ push(ap(namePass,primArg(2))); /* bind 3 2 1 = 3 (pass 2 1) */ toparg(primArg(1)); updapRoot(primArg(3),top()); } primFun(primPass) { /* Auxiliary function */ push(ap(primArg(3),primArg(1))); /* pass 3 2 1 = 3 1 2 */ updapRoot(top(),primArg(2)); } /* -------------------------------------------------------------------------- * Handle operations: * ------------------------------------------------------------------------*/ #if IO_HANDLES static Int local newHandle(sCell,loc) /* return a free Handle or throw an IOError */ Cell *sCell; String loc; { Int i; for (i=0; i<(Int)MAX_HANDLES && nonNull(handles[i].hcell); ++i) ; /* Search for unused handle*/ if (i>=(Int)MAX_HANDLES) { /* If at first we don't */ garbageCollect(); /* succeed, garbage collect*/ for (i=0; i<(Int)MAX_HANDLES && nonNull(handles[i].hcell); ++i) ; /* and try again ... */ #if !WANT_FIXED_SIZE_TABLES if (i >= (Int)MAX_HANDLES) { Int j; growDynTable(dynTabHandles); handles = (struct strHandle*)(dynTabHandles->data); num_handles = dynTabHandles->maxIdx; /* Nil out the new entries in the table */ for (j=i; j < (Int)num_handles; j++) { handles[j].hcell = NIL; } } #endif } if (i>=(Int)MAX_HANDLES) { /* ... before we give up */ IOFail(mkIOError(NULL, nameIllegal, loc, "too many handles open", sCell)); } return i; } static String local modeString(hmode,binary) /* return mode string for f(d)open */ Int hmode; Bool binary; { if (binary) { return (hmode&HAPPEND) ? "ab" : (hmode&HWRITE) ? "wb" : (hmode&HREADWRITE) ? "rb+" : (hmode&HREAD) ? "rb" : (String)0; } else { return (hmode&HAPPEND) ? "a" : (hmode&HWRITE) ? "w" : (hmode&HREADWRITE) ? "r+" : (hmode&HREAD) ? "r" : (String)0; } } static Cell local openHandle(root,sCell,hmode,binary,loc) /* open handle to file named s in */ StackPtr root; Cell *sCell; /* the specified hmode */ Int hmode; Bool binary; String loc; { Int i; String s = evalName(*sCell); String stmode = modeString(hmode,binary); /* openHandle() either returns a Handle or throws an IOError. */ if (!s) { /* check for valid name */ IOFail(mkIOError(NULL, nameIllegal, loc, "illegal file name", NULL)); } i = newHandle(sCell,loc); if (!stmode) { IOFail(mkIOError(NULL, nameIllegal, loc, "illegal mode", NULL)); } /* prepare to open file */ handles[i].hfp = fopen(s,stmode); if (hmode==HREADWRITE && handles[i].hfp==NULL) /* try to create it */ handles[i].hfp = fopen(s, binary ? "wb+" : "w+"); if (!handles[i].hfp) throwErrno(loc, TRUE, NO_HANDLE, sCell); handles[i].hmode = hmode; handles[i].hbufMode = HUNKNOWN_BUFFERING; handles[i].hbufSize = (-1); setRWState(i, RW_NEUTRAL); #if CHAR_ENCODING handles[i].hBinaryMode = binary; handles[i].hLookAhead = -1; #endif return (handles[i].hcell = ap(HANDCELL,i)); } static Cell local openFdHandle(root,fd,hmode,binary,loc) /* open handle to file desc fd in */ StackPtr root; Int fd; /* the specified hmode */ Int hmode; Bool binary; String loc; { Int i = newHandle(NIL,loc); String stmode = modeString(hmode,binary); /* openFdHandle() either returns a Handle or throws an IOError. */ if (!stmode) { IOFail(mkIOError(NULL, nameIllegal, loc, "illegal mode", NULL)); } if (!(handles[i].hfp=fdopen(fd,stmode))) throwErrno(loc, TRUE, NO_HANDLE, NULL); handles[i].hmode = hmode; handles[i].hbufMode = HANDLE_NOTBUFFERED; handles[i].hbufSize = 0; setRWState(i, RW_NEUTRAL); #if CHAR_ENCODING handles[i].hBinaryMode = binary; handles[i].hLookAhead = -1; #endif return (handles[i].hcell = ap(HANDCELL,i)); } static Char local hGetChar(Int h, String fname) { Int c; #if CHAR_ENCODING if (handles[h].hLookAhead>=0) { c = handles[h].hLookAhead; handles[h].hLookAhead = -1; } else if (handles[h].hBinaryMode) { c = getc(handles[h].hfp); } else { c = FGetChar(handles[h].hfp); } #else /* !CHAR_ENCODING */ c = FGetChar(handles[h].hfp); #endif if (c==EOF && !feof(handles[h].hfp)) throwErrno(fname, TRUE, h, NULL); #if CHAR_ENCODING else if (c==BAD_CHAR) { IOFail(mkIOError(&handles[h].hcell, nameProtocolError, fname, "input contains non-character data - use binary I/O for binary data", NULL)); } #endif /* CHAR_ENCODING */ return c; } static Void local hPutChar(Char c, Int h, String fname) { Int retval; #if CHAR_ENCODING retval = handles[h].hBinaryMode ? putc(c, handles[h].hfp) : FPutChar(c, handles[h].hfp); #else retval = FPutChar(c, handles[h].hfp); #endif if (retval == EOF) throwErrno(fname, TRUE, h, NULL); #if FLUSHEVERY if (h <= 2) { /* Only flush the standard handles */ fflush(handles[h].hfp); } #endif } /* If the stream is read-write, set the state, otherwise do nothing */ static Void local setRWState(Int h, Int newState) { if (handles[h].hmode&HREADWRITE) { /* ANSI C requires repositioning between writes and reads */ if (newState==RW_READING) { if (handles[h].hRWState==RW_WRITING) { fflush(handles[h].hfp); fseek(handles[h].hfp, 0L, SEEK_CUR); } } else if (newState==RW_WRITING) { if (handles[h].hRWState==RW_READING) fseek(handles[h].hfp, 0L, SEEK_CUR); } handles[h].hRWState = newState; } } /* ensure that the handle is neither closed nor semi-closed */ static Void local checkOpen(Int h, String fname) { Int mode = handles[h].hmode; if (mode==HCLOSED) IOFail(mkIOError(&handles[h].hcell, nameIllegal, fname, "handle is closed", NULL)); if (mode==HSEMICLOSED) IOFail(mkIOError(&handles[h].hcell, nameIllegal, fname, "handle is semi-closed", NULL)); } /* ensure that the handle is readable */ static Void local checkReadable(Int h, String fname) { checkOpen(h, fname); if (!(handles[h].hmode&(HREAD|HREADWRITE))) IOFail(mkIOError(&handles[h].hcell, nameIllegal, fname, "handle is not readable", NULL)); } /* ensure that the handle is writable */ static Void local checkWritable(Int h, String fname) { checkOpen(h, fname); if (!(handles[h].hmode&(HWRITE|HAPPEND|HREADWRITE))) IOFail(mkIOError(&handles[h].hcell, nameIllegal, fname, "handle is not writeable", NULL)); } /* -------------------------------------------------------------------------- * Building strings: * ------------------------------------------------------------------------*/ Void pushString(s) /* push pointer to string onto stack */ String s; { if (*s == '\0') push(nameNil); else { Cell l = ap(consChar(ExtractChar(s)),NIL); push(l); while (*s) { snd(l) = ap(consChar(ExtractChar(s)),NIL); l = snd(l); } snd(l) = nameNil; } } /* Helper function for constructing IOErrors (see Prelude defn of * IOError for explanation of what the the individual arguments * do. */ Cell mkIOError(mbH, kind, loc, desc, mbF) Cell *mbH; /* a Handle or NULL */ Name kind; /* an IOErrorType */ String loc; String desc; Cell *mbF; /* a FilePath or NULL */ { Cell str; push(nameIOError); toparg(mbH==NULL ? nameNothing : ap(nameJust,*mbH)); toparg(kind); pushString(loc); str = pop(); toparg(str); pushString(desc); str = pop(); toparg(str); toparg(mbF==NULL ? nameNothing : ap(nameJust,*mbF)); return pop(); } #endif /* -------------------------------------------------------------------------- * IO Errors (more defined for file ops) * ------------------------------------------------------------------------*/ static Void local throwErrno(String fname, Bool isFile, Int h, Cell *mbF) { IOFail(mkIOError(h == NO_HANDLE ? NULL : &handles[h].hcell, toIOError(errno), fname, toIOErrorDescr(errno, isFile), mbF)); } /* * Map a libc error code to an IOError */ static Name local toIOError(errc) int errc; { #if HAVE_ERRNO_H && !(__MWERKS__ && macintosh) switch(errc) { case EEXIST: return nameAlreadyExists; case ENOENT: case ENOTDIR: return nameDoesNotExist; case EPERM: case EACCES: return namePermDenied; case ENOSPC: case EFBIG: return nameIsFull; default: return nameIllegal; } #else return nameIllegal; #endif } /* * Map a libc error code to an IOError descriptive string */ static String local toIOErrorDescr(errc,isFile) int errc; Bool isFile; { #if HAVE_ERRNO_H && !(__MWERKS__ && macintosh) switch(errc) { case EEXIST: return (isFile ? "file already exists" : "directory already exists"); case ENOENT: case ENOTDIR: return (isFile ? "file does not exist" : "directory does not exist"); case EPERM: case EACCES: return ""; /* No need to replicate the info conveyed by the IOErrorKind */ case ENOSPC: case EFBIG: return "device is full"; default: return ""; } #else return ""; #endif } /* -------------------------------------------------------------------------- * Misc. * ------------------------------------------------------------------------*/ primFun(primGC) { /* force a GC right now */ garbageCollect(); IOReturn(nameUnit); } #if BIGNUMS && defined HAVE_TIME_H #include primFun(primGetRandomSeed) { /* generate a random seed */ IOReturn(bigInt(clock())); } #else primFun(primGetRandomSeed) { /* generate a random seed */ ERRMSG(0) "getRandomSeed is not implemented on this architecture" EEND; } #endif primFun(primGetEnv) { /* primGetEnv :: String -> IO String */ String s = evalName(IOArg(1)); /* Eval name */ String r; if (!s) { /* check for valid name */ IOFail(mkIOError(NULL, nameIllegal, "System.getEnv", "illegal environment variable name", &IOArg(1))); } if ((r = getenv(s))==0) { IOFail(mkIOError(NULL, nameDoesNotExist, "System.getEnv", "environment variable not found", &IOArg(1))); } pushString(r); IOReturn(pop()); } #if HAVE_SYS_TYPES_H #include #endif #if HAVE_SYS_WAIT_H # include #endif #ifndef WEXITSTATUS /* If it's not defined, return it verbatim. */ # define WEXITSTATUS(stat_val) (stat_val) #endif primFun(primSystem) { /* primSystem :: String -> IO Int */ String s = evalName(IOArg(1)); /* Eval name */ Int r; if (!s) { /* check for valid string */ IOFail(mkIOError(NULL, nameIllegal, "System.system", "illegal system command string", &IOArg(1))); } r = shellEsc(s, TRUE/*synchronous*/, TRUE/*use shell*/); IOReturn(mkInt(WEXITSTATUS(r))); } Void setHugsArgs(argc,argv) Int argc; String argv[]; { int i; Cell str; hugsArgs = nameNil; pushString(argv[0]); hugsProgName = pop(); for (i=argc-1; i>0; i--) { pushString(argv[i]); str = pop(); hugsArgs = ap2(nameCons, str, hugsArgs); } } primFun(primGetProgName) { /* primGetProgName :: IO String */ IOReturn(hugsProgName); } primFun(primGetArgs) { /* primGetArgs :: IO [String] */ IOReturn(hugsArgs); } primFun(primSetProgName) { /* primSetProgName :: String -> IO () */ hugsProgName = IOArg(1); IOReturn(nameUnit); } primFun(primSetArgs) { /* primSetArgs :: [String] -> IO () */ hugsArgs = IOArg(1); IOReturn(nameUnit); } /* -------------------------------------------------------------------------- * File IO * ------------------------------------------------------------------------*/ #if IO_HANDLES #define HandleArg(nm,offset) \ eval(primArg(offset)); \ nm = intValOf(whnfHead) #define IOBoolResult(e) \ IOReturn((e)?nameTrue:nameFalse) primFun(primHGetChar) { /* Read character from handle */ Int h; Int c; HandleArg(h,1+IOArity); checkReadable(h, "IO.hGetChar"); setRWState(h, RW_READING); c = hGetChar(h, "IO.hGetChar"); if (c==EOF) { setRWState(h, RW_NEUTRAL); IOFail(mkIOError(&handles[h].hcell, nameEOFErr, "IO.hGetChar", "end of file", NULL)); } IOReturn(mkChar(c)); } primFun(primHPutChar) { /* print character on handle */ Char c = 0; Int h; HandleArg(h,2+IOArity); CharArg(c,1+IOArity); checkWritable(h, "IO.hPutChar"); setRWState(h, RW_WRITING); hPutChar(c, h, "IO.hPutChar"); IOReturn(nameUnit); } primFun(primHPutStr) { /* print string on handle */ Int h; HandleArg(h,2+IOArity); push(primArg(1+IOArity)); primArg(1+IOArity) = NIL; checkWritable(h, "IO.hPutStr"); setRWState(h, RW_WRITING); blackHoleRoot(); eval(pop()); while (whnfHead==nameCons) { eval(pop()); hPutChar(charOf(whnfHead),h,"IO.hPutStr"); eval(pop()); } #if !FLUSHEVERY if (h <= 2) { /* Only flush the standard handles */ fflush(handles[h].hfp); } #endif IOReturn(nameUnit); } primFun(primHreader) { /* read String from a handle */ Int h; /* Handle -> String */ HandleArg(h,1); if (handles[h].hmode&HSEMICLOSED) { /* read requires semi-closed handle*/ Int c = hGetChar(h, "IO.getContents"); if (c!=EOF && c>=0 && c<=MAXCHARVAL) { updapRoot(consChar(c),ap(nameHreader,primArg(1))); return; } clearerr(handles[h].hfp); } updateRoot(nameNil); } primFun(primHContents) { /* hGetContents :: Handle -> IO Str*/ Int h; HandleArg(h,1+IOArity); checkReadable(h, "IO.hGetContents"); /* must have readable handle */ setRWState(h, RW_READING); handles[h].hmode = HSEMICLOSED; /* semi-close handle */ IOReturn(ap(nameHreader,IOArg(1))); } static int local getIOMode(mode) /* From IOMode to internal form */ Cell mode; { Int m = HCLOSED; eval(mode); /* Eval IOMode */ if (isName(whnfHead) && isCfun(whnfHead)) switch (cfunOf(whnfHead)) { /* we have to use numeric consts */ case 1 : m = HREAD; /* here to avoid the need to put */ break; /* IOMode in startup environment */ case 2 : m = HWRITE; break; case 3 : m = HAPPEND; break; case 4 : m = HREADWRITE; break; } return m; } static Void local fopenPrim(root,binary,loc)/* Auxiliary function for */ StackPtr root; /* opening a file */ Bool binary; String loc; { Int m; m = getIOMode(IOArg(1)); if (m==HCLOSED) { /* Only accept legal modes */ IOFail(mkIOError(NULL, nameIllegal, loc, "unknown handle mode", &IOArg(2))); } IOReturn(openHandle(root,&IOArg(2),m,binary,loc)); } primFun(primOpenFile) { /* open handle to a text file */ fopenPrim(root,FALSE,"IO.openFile"); } primFun(primOpenBinaryFile) { /* open handle to a binary file */ fopenPrim(root,TRUE,"System.IO.openBinaryFile"); } primFun(primStdin) { /* Standard input handle */ push(handles[HSTDIN].hcell); } primFun(primStdout) { /* Standard output handle */ push(handles[HSTDOUT].hcell); } primFun(primStderr) { /* Standard error handle */ push(handles[HSTDERR].hcell); } primFun(primOpenFd) { /* open handle to file descriptor. */ Int m; /* :: Int{-Fd-} -> Bool -> IOMode -> Bool -> IO Handle */ Int fd; Bool binary; Bool isSock; IntArg(fd,4+IOArity); BoolArg(isSock,3+IOArity); BoolArg(binary,1+IOArity); m = getIOMode(IOArg(2)); if (m==HCLOSED) { /* Only accept legal modes */ IOFail(mkIOError(NULL, nameIllegal, "openFd", "unknown handle mode", NULL)); } #if defined(_WIN32) && !cygwin32_HOST_OS if (isSock) { /* fd is a SOCKET, convert it to an FD. * Note: _open_osfhandle() will fail under * Win9x. ToDo: better on those plats. */ fd = _open_osfhandle(fd, (m & HREAD ? O_RDONLY : 0) | (m & HWRITE ? O_WRONLY : 0) | (m & HREADWRITE ? O_RDWR : 0) | (m & HAPPEND ? O_APPEND : 0) | (binary ? O_BINARY : O_TEXT) ); } #endif IOReturn(openFdHandle(root,fd,m,binary,"openFd")); } /* Extract the file descriptor from a Handle, discarding the Handle */ primFun(primHandleToFd) { Int h; HandleArg(h,1+IOArity); if (IS_STANDARD_HANDLE(h)) { IOFail(mkIOError(NULL, nameIllegal, "System.Posix.IO.handleToFd", "invalid handle", NULL)); } checkOpen(h, "System.Posix.IO.handleToFd"); #if HAVE_DUP { Int fd = dup(fileno(handles[h].hfp)); fclose(handles[h].hfp); handles[h].hfp = 0; handles[h].hmode = HCLOSED; IOReturn(mkInt(fd)); } #else IOFail(mkIOError(&handles[h].hcell, nameIllegal, "System.Posix.IO.handleToFd", "unsupported operation", NULL)); #endif } primFun(primHIsEOF) { /* Test for end of file on handle */ /* :: Handle -> IO Bool */ Int h; FILE* fp; Bool isEOF; HandleArg(h,1+IOArity); checkReadable(h, "IO.hIsEOF"); fp = handles[h].hfp; isEOF = feof(fp); if (isEOF) { /* If the EOF flag is already signalled, peeking at the next char isn't likely to produce a different outcome! */ IOBoolResult(isEOF); #if CHAR_ENCODING } else if (handles[h].hLookAhead>=0) { IOReturn(nameFalse); #endif } else { Int c; setRWState(h, RW_READING); c = fgetc(fp); isEOF = feof(fp); if (isEOF) setRWState(h, RW_NEUTRAL); /* Put the char back and clear any flags. */ ungetc(c,fp); clearerr(fp); IOBoolResult(isEOF); } } primFun(primHFlush) { /* Flush handle */ Int h; HandleArg(h,1+IOArity); checkWritable(h, "IO.hFlush"); fflush(handles[h].hfp); IOReturn(nameUnit); } primFun(primHClose) { /* Close handle */ Int h; HandleArg(h,1+IOArity); /* Disallow closing any of the standard handles */ if (!IS_STANDARD_HANDLE(h) && handles[h].hmode!=HCLOSED) { if (h>HSTDERR && handles[h].hfp) fclose(handles[h].hfp); handles[h].hfp = 0; handles[h].hmode = HCLOSED; } /* closing an already closed handle is the identity (i.e., not an error.) */ IOReturn(nameUnit); } primFun(primHGetPosn) { /* Get file position */ Int h; long pos; HandleArg(h,1+IOArity); checkOpen(h, "IO.hGetPosn"); #if HAVE_FTELL pos = ftell(handles[h].hfp); IOReturn(mkInt((Int)pos)); #else IOFail(mkIOError(NULL, nameIllegal, "IO.hGetPosn", "unsupported operation", NULL)); #endif } primFun(primHSetPosn) { /* Set file position */ #if HAVE_FSEEK long pos = 0; #endif Int h; HandleArg(h,2+IOArity); IntArg(pos,1+IOArity); checkOpen(h, "IO.hSetPosn"); #if HAVE_FSEEK setRWState(h, RW_NEUTRAL); fflush(handles[h].hfp); if (fseek(handles[h].hfp,pos,SEEK_SET) == 0) { IOReturn(nameUnit); } #else IOFail(mkIOError(NULL, nameIllegal, "IO.hSetPosn", "unsupported operation", NULL)); } #endif } primFun(primHSeek) { /* Seek to new file posn */ /* :: Handle -> Int -> Int -> IO () */ Int h; Int sMode; Int off; HandleArg(h,3+IOArity); IntArg(sMode, 2+IOArity); IntArg(off, 1+IOArity); if (sMode == 0) sMode = SEEK_SET; else if (sMode == 1) sMode = SEEK_CUR; else sMode = SEEK_END; checkOpen(h, "IO.hSeek"); if (fseek(handles[h].hfp,off,sMode) != 0) throwErrno("IO.hSeek", TRUE, h, NULL); setRWState(h, RW_NEUTRAL); IOReturn(nameUnit); } primFun(primHLookAhead) { /* Peek at the next char */ /* :: Handle -> IO Char */ Int h; Int c; HandleArg(h,1+IOArity); checkReadable(h, "IO.hLookAhead"); #if CHAR_ENCODING if (handles[h].hLookAhead>=0) { IOReturn(mkChar(handles[h].hLookAhead)); return; } #endif setRWState(h, RW_READING); if (feof(handles[h].hfp) || (c = hGetChar(h, "IO.hLookAhead")) == EOF) { setRWState(h, RW_NEUTRAL); IOFail(mkIOError(&handles[h].hcell, nameEOFErr, "IO.hLookAhead", "end of file", NULL)); } #if CHAR_ENCODING if (handles[h].hBinaryMode) ungetc(c, handles[h].hfp); else handles[h].hLookAhead = c; #else ungetc(c, handles[h].hfp); #endif IOReturn(mkChar(c)); } primFun(primHSetBuffering) { /* Change a Handle's buffering */ /* :: Handle -> Int -> Int -> IO () */ Int h; Int ty; Int sz; int rc; HandleArg(h,3+IOArity); IntArg(ty,2+IOArity); IntArg(sz,1+IOArity); checkOpen(h, "IO.hSetBuffering"); switch(ty) { case 0: ty = _IONBF; handles[h].hbufMode = HANDLE_NOTBUFFERED; handles[h].hbufSize = 0; break; case 1: ty = _IOLBF; sz = BUFSIZ; handles[h].hbufMode = HANDLE_LINEBUFFERED; handles[h].hbufSize = 0; break; case 2: ty = _IOFBF; handles[h].hbufMode = HANDLE_BLOCKBUFFERED; if (sz == 0) { sz=BUFSIZ; } handles[h].hbufSize = sz; break; default: IOFail(mkIOError(&handles[h].hcell, nameIllegal, "IO.hSetBuffering", "illegal buffer mode", NULL)); } /* Change the buffering mode; setvbuf() flushes the old buffer. */ /* Let setvbuf() allocate the buffer for us. */ rc = setvbuf(handles[h].hfp, NULL, ty, sz); if (rc != 0) throwErrno("IO.hSetBuffering", TRUE, h, NULL); #if HAVE_ISATTY if ((handles[h].hmode&(HWRITE|HAPPEND|HREADWRITE)) && isatty(fileno(handles[h].hfp))) setBuffTerminal(fileno(handles[h].hfp), ty!=0); #endif IOReturn(nameUnit); } primFun(primHGetBuffering) { /* Return buffering info of a handle. */ /* Handle :: IO (Int,Int) */ Int h; HandleArg(h,1+IOArity); checkOpen(h, "IO.hGetBuffering"); if (handles[h].hbufMode == HUNKNOWN_BUFFERING) { /* figure out buffer mode and size. */ #if HAVE_ISATTY if (isatty (fileno(handles[h].hfp)) ) { /* TTY connected handles are normally linebuffered. */ handles[h].hbufMode = (handles[h].hmode&(HWRITE|HAPPEND|HREADWRITE))==0 || getBuffTerminal(fileno(handles[h].hfp)) ? HANDLE_LINEBUFFERED : HANDLE_NOTBUFFERED; handles[h].hbufSize = 0; } else { #endif /* ..if not, block buffered. */ handles[h].hbufMode = HANDLE_BLOCKBUFFERED; handles[h].hbufSize = BUFSIZ; #if HAVE_ISATTY } #endif } IOReturn(ap(ap(mkTuple(2),mkInt((Int)handles[h].hbufMode)), mkInt((Int)handles[h].hbufSize))); } primFun(primHIsOpen) { /* Test is handle open */ Int h; HandleArg(h,1+IOArity); IOBoolResult(handles[h].hmode!=HCLOSED && handles[h].hmode!=HSEMICLOSED); } primFun(primHIsClosed) { /* Test is handle closed */ Int h; HandleArg(h,1+IOArity); IOBoolResult(handles[h].hmode==HCLOSED); } primFun(primHIsReadable) { /* Test is handle readable */ Int h; HandleArg(h,1+IOArity); IOBoolResult(handles[h].hmode&(HREAD|HREADWRITE)); } primFun(primHIsWritable) { /* Test is handle writable */ Int h; HandleArg(h,1+IOArity); IOBoolResult(handles[h].hmode&(HWRITE|HREADWRITE|HAPPEND)); } #if defined(IS_WINDOWS) && !defined(S_ISREG) #define S_ISREG(x) ((x) & _S_IFREG) #endif primFun(primHIsSeekable) { /* Test if handle is writable */ Int h; Bool okHandle; #if HAVE_FSTAT struct stat sb; #endif HandleArg(h,1+IOArity); okHandle = (handles[h].hmode&(HREAD|HWRITE|HREADWRITE|HAPPEND)); #if HAVE_FSTAT if (okHandle && (fstat(fileno(handles[h].hfp), &sb) == 0)) { okHandle = S_ISREG(sb.st_mode); } IOBoolResult(okHandle); #else IOFail(mkIOError(&handles[h].hcell, nameIllegal, "IO.hIsSeekable", "unsupported operation", NULL)); #endif } primFun(primHFileSize) { /* If handle points to a regular file, return the size of the file */ /* :: Handle -> IO Integer */ Int h; #if HAVE_FSTAT struct stat sb; #endif HandleArg(h,1+IOArity); #if HAVE_FSTAT checkOpen(h, "IO.hFileSize"); if (handles[h].hmode&(HWRITE|HREADWRITE|HAPPEND)) fflush(handles[h].hfp); if (fstat(fileno(handles[h].hfp), &sb) != 0 || !S_ISREG(sb.st_mode)) { IOFail(mkIOError(&handles[h].hcell, nameIllegal, "IO.hFileSize", "not a regular file", NULL)); } IOReturn(bigWord(sb.st_size)); #else IOFail(mkIOError(&handles[h].hcell, nameIllegal, "IO.hFileSize", "unsupported operation", NULL)); #endif } primFun(primEqHandle) { /* Test for handle equality */ Int h1, h2; HandleArg(h1,1); HandleArg(h2,2); BoolResult(h1==h2); } primFun(primGetHandleNumber) { Int h; HandleArg(h,1); IntResult(h); } primFun(primHSetBinaryMode) { Int h; Bool binary; HandleArg(h, 2+IOArity); BoolArg(binary, 1+IOArity); checkOpen(h, "System.IO.hSetBinaryMode"); #if defined(mingw32_HOST_OS) || defined(_MSC_VER) setmode(fileno(handles[h].hfp), binary ? _O_BINARY : _O_TEXT); #endif #if CHAR_ENCODING handles[h].hBinaryMode = binary; #endif IOReturn(nameUnit); } primFun(primHPutBuf) { /* write binary data from a buffer */ Int h, size; Pointer buf; HandleArg(h, 3+IOArity); PtrArg(buf, 2+IOArity); IntArg(size, 1+IOArity); /* argument checks */ checkWritable(h, "System.IO.hPutBuf"); if (size < 0) { IOFail(mkIOError(&handles[h].hcell, nameIllegal, "System.IO.hPutBuf", "illegal buffer size", NULL)); } #if CHAR_ENCODING if (!handles[h].hBinaryMode) { IOFail(mkIOError(&handles[h].hcell, nameIllegal, "System.IO.hPutBuf", "not a binary handle", NULL)); } #endif setRWState(h, RW_WRITING); errno = 0; while (size > 0) { size -= (Int)fwrite(buf, 1, size, handles[h].hfp); if (errno < 0) throwErrno("System.IO.hPutBuf", TRUE, h, NULL); } IOReturn(nameUnit); } primFun(primHGetBuf) { /* read binary data into a buffer */ Int h, size, numRead; Pointer buf; HandleArg(h, 3+IOArity); PtrArg(buf, 2+IOArity); IntArg(size, 1+IOArity); /* argument checks */ checkReadable(h, "System.IO.hGetBuf"); if (size < 0) { IOFail(mkIOError(&handles[h].hcell, nameIllegal, "System.IO.hGetBuf", "illegal buffer size", NULL)); } #if CHAR_ENCODING if (!handles[h].hBinaryMode) { IOFail(mkIOError(&handles[h].hcell, nameIllegal, "System.IO.hGetBuf", "not a binary handle", NULL)); } #endif setRWState(h, RW_READING); numRead = (Int)fread(buf, 1, size, handles[h].hfp); if (numRead < size && ferror(handles[h].hfp)) throwErrno("System.IO.hGetBuf", TRUE, h, NULL); IOReturn(mkInt(numRead)); } primFun(primHWaitForInput) { /* Check whether a character can be read from a handle within x msecs */ /* :: Handle -> Int -> IO Bool */ Int h; Int msecs; HandleArg(h,2+IOArity); IntArg(msecs,1+IOArity); #if HAVE_SELECT checkReadable(h, "IO.hWaitForInput"); { /* Implementation is a rip-off of GHC's inputReady.c */ int maxfd, fd; int ready; fd_set rfd; struct timeval tv; FD_ZERO(&rfd); fd = fileno(handles[h].hfp); FD_SET(fd, &rfd); maxfd = fd + 1; tv.tv_sec = msecs / 1000; tv.tv_usec = msecs % 1000; while ( (ready = select(maxfd, &rfd, NULL, NULL, &tv)) < 0 ) { if (errno != EINTR) { IOFail(mkIOError(&handles[h].hcell, nameIllegal, "IO.hWaitForInput", "input waiting terminated by signal", NULL)); } } IOBoolResult(ready > 0); } #else /* For now, punt on implementing async IO under Win32 */ /* For other platforms that don't support select() on file file descs, please insert code that'll work. */ IOFail(mkIOError(&handles[h].hcell, nameIllegal, "IO.hWaitForInput", "unsupported operation", NULL)); #endif } primFun(primHIsTerminalDevice) { /* Does the handle refer to a terminal? */ Int h; HandleArg(h, 1+IOArity); checkOpen(h, "System.IO.hIsTerminalDevice"); #if HAVE_ISATTY IOBoolResult(isatty(fileno(handles[h].hfp))); #else IOBoolResult(h<=HSTDERR); #endif } primFun(primHGetEcho) { Int h; Int fd; HandleArg(h, 1+IOArity); checkOpen(h, "System.IO.hGetEcho"); fd = fileno(handles[h].hfp); #if HAVE_ISATTY IOBoolResult(isatty(fd) && getEchoTerminal(fd)); #else IOBoolResult(FALSE); #endif } primFun(primHSetEcho) { Int h; Bool echo; Int fd; HandleArg(h, 2+IOArity); BoolArg(echo, 1+IOArity); checkOpen(h, "System.IO.hSetEcho"); fd = fileno(handles[h].hfp); #if HAVE_ISATTY if (isatty(fd)) setEchoTerminal(fd, echo); #endif IOReturn(nameUnit); } #endif /* IO_HANDLES */ /* -------------------------------------------------------------------------- * Mutable variables * ------------------------------------------------------------------------*/ #if IO_REFS #if CHECK_TAGS #define checkRef() if (MUTVAR != whatIs(whnfHead)) internal("Ref expected") #else #define checkRef() /* do nothing */ #endif primFun(primNewRef) { /* a -> IO (Ref a) */ IOReturn(ap(MUTVAR,IOArg(1))); } primFun(primDerefRef) { /* Ref a -> IO a */ eval(pop()); checkRef(); IOReturn(snd(whnfHead)); } primFun(primAssignRef) { /* Ref a -> a -> IO () */ eval(IOArg(2)); checkRef(); snd(whnfHead) = IOArg(1); IOReturn(nameUnit); } primFun(primEqRef) { /* Ref a -> Ref a -> Bool */ eval(primArg(2)); checkRef(); push(whnfHead); eval(primArg(1)); checkRef(); updateRoot(pop()==whnfHead ? nameTrue : nameFalse); } #endif /* -------------------------------------------------------------------------- * Stable Pointers * ------------------------------------------------------------------------*/ #if CHECK_TAGS #define checkSP() checkInt() #else #define checkSP() /* do nothing */ #endif #define SPArg(nm,offset) \ eval(primArg(offset)); \ checkSP(); \ nm = (HugsStablePtr)whnfInt /* nm should be a variable in which result is stored. If you use an expression, reevaluation might occur */ #define SPResult(nm) \ updateRoot(mkInt((Int)(nm))) primFun(primMakeSP) { /* a -> IO (StablePtr a) */ HugsStablePtr sp = mkStablePtr(IOArg(1)); if (sp == 0) { IOFail(mkIOError(NULL, nameIsFull, "Foreign.makeStablePtr", "too many StablePtrs", NULL)); } IOReturn(mkInt(sp)); } primFun(primDerefSP) { /* StablePtr a -> IO a */ HugsStablePtr x; SPArg(x,1+IOArity); IOReturn(derefStablePtr(x)); } primFun(primFreeSP) { /* StablePtr a -> IO () */ HugsStablePtr x; SPArg(x,1+IOArity); freeStablePtr(x); IOReturn(nameUnit); } primFun(primCastSPToP) { /* StablePtr a -> Ptr () */ HugsStablePtr x; SPArg(x,1); PtrResult((Pointer)x); } primFun(primCastPToSP) { /* Ptr () -> StablePtr a */ Pointer x; PtrArg(x,1); SPResult((HsStablePtr)x); } /* -------------------------------------------------------------------------- * Foreign Objects * ------------------------------------------------------------------------*/ #if CHECK_TAGS #define checkForeign() if (MPCELL != whatIs(whnfHead)) internal("ForeignObj expected") #else #define checkForeign() /* do nothing */ #endif primFun(primNewFP) { /* Ptr a -> IO (ForeignPtr a) */ Pointer addr = 0; eval(IOArg(1)); addr = ptrOf(whnfHead); IOReturn(newMallocPtr(addr)); } primFun(primAddFPF) { /* FunPtr (Ptr a -> IO ()) -> ForeignPtr a -> IO () */ int mp; eval(IOArg(1)); mp = mpOf(whnfHead); eval(IOArg(2)); mallocPtrs[mp].finalizers = cons(whnfHead, mallocPtrs[mp].finalizers); IOReturn(nameUnit); } primFun(primAddFPFEnv) { /* FunPtr (Ptr env -> Ptr a -> IO ()) -> */ int mp; /* Ptr Env -> ForeignPtr a -> IO () */ eval(IOArg(1)); mp = mpOf(whnfHead); eval(IOArg(2)); push(whnfHead); eval(IOArg(3)); mallocPtrs[mp].finalizers = cons(pair(whnfHead, pop()), mallocPtrs[mp].finalizers); IOReturn(nameUnit); } primFun(primWriteFP) { /* ForeignPtr a -> Ptr a -> IO () */ Cell mp = NIL; eval(IOArg(2)); checkForeign(); mp = whnfHead; eval(IOArg(1)); derefMP(mp) = ptrOf(whnfHead); IOReturn(nameUnit); } primFun(primEqFP) { /* ForeignPtr a -> ForeignPtr a -> Bool */ eval(primArg(2)); checkForeign(); push(whnfHead); eval(primArg(1)); checkForeign(); updateRoot(pop()==whnfHead ? nameTrue : nameFalse); } primFun(primTouchFP) { /* ForeignPtr a -> IO () */ eval(IOArg(1)); checkForeign(); IOReturn(nameUnit); } primFun(primFPToP) { /* ForeignPtr a -> Ptr a */ eval(primArg(1)); checkForeign(); PtrResult(derefMP(whnfHead)); } #if STABLE_NAMES /* -------------------------------------------------------------------------- * Stable Names * ------------------------------------------------------------------------*/ primFun(primMakeSN) { /* a -> IO (StableName a) */ IOReturn(ap(STABLENAME,IOArg(1))); } primFun(primDerefSN) { /* StableName a -> a */ eval(primArg(1)); updateRoot(snd(whnfHead)); } primFun(primHashSN) { /* StableName a -> Int */ eval(primArg(1)); updateRoot(mkInt(whnfHead)); } primFun(primEqSN) { /* StableName a -> StableName a -> Bool */ eval(primArg(2)); push(whnfHead); eval(primArg(1)); updateRoot(pop()==whnfHead ? nameTrue : nameFalse); } #endif #if GC_WEAKPTRS /* -------------------------------------------------------------------------- * Weak Pointers * ------------------------------------------------------------------------*/ #if CHECK_TAGS #define checkWeak() if(WEAKCELL!=whatIs(whnfHead)) internal("weakPtr expected"); #else #define checkWeak() /* do nothing */ #endif primFun(primWeakPtrEq) { /* Weak a -> Weak a -> Bool */ eval(primArg(2)); push(whnfHead); eval(primArg(1)); updateRoot(pop()==whnfHead ? nameTrue : nameFalse); } primFun(primMkWeak) { /* k -> v -> Maybe (IO ()) */ Cell w = NIL; /* -> IO (Weak v) */ eval(IOArg(1)); if (whnfHead==nameJust) { /* Look for finalizer */ w = pop(); } w = ap(NIL,ap(NIL,ap(NIL,w))); fst(snd(w)) = IOArg(3); fst(snd(snd(w))) = IOArg(2); liveWeakPtrs = cons(w,liveWeakPtrs); fst(w) = WEAKFIN; IOReturn(w); } primFun(primDeRefWeak) { /* Weak v -> IO (Maybe v) */ eval(IOArg(1)); if (whatIs(whnfHead)!=WEAKFIN) { internal("primDeRefWeak"); } if (nonNull(snd(whnfHead))) { IOReturn(ap(nameJust,fst(snd(snd(whnfHead))))); } else { IOReturn(nameNothing); } } primFun(primReplaceFinalizer) { /* Weak v -> Maybe (IO ()) */ /* -> IO (Maybe (IO ())) */ eval(IOArg(1)); /* Grab new finalizer ... */ if (whnfHead!=nameJust) { push(NIL); } eval(IOArg(2)); /* Get weak pointer ... */ if (whatIs(whnfHead)!=WEAKFIN) { internal("primReplaceFinalizer"); } else if (nonNull(snd(whnfHead))) {/* ... and replace finalizer */ Cell oldfin = snd(snd(snd(whnfHead))); snd(snd(snd(whnfHead))) = pop(); if (nonNull(oldfin)) { IOReturn(ap(nameJust,oldfin)); } } IOReturn(nameNothing); } primFun(primFinalize) { /* Weak v -> IO () */ eval(IOArg(1)); /* Bring weak pointer to an early */ if (whatIs(whnfHead)!=WEAKFIN) { /* end ... */ internal("primFinalize"); } else if (nonNull(snd(whnfHead))) { Cell wp = whnfHead; Cell vf = snd(snd(wp)); if (isPair(vf)) { if (nonNull(snd(vf))) { fst(vf) = snd(vf); snd(vf) = finalizers; finalizers = vf; } fst(snd(wp)) = NIL; snd(snd(wp)) = NIL; snd(wp) = NIL; } liveWeakPtrs = removeCell(wp,liveWeakPtrs); } IOReturn(nameUnit); } primFun(primRunFinalizer) { /* IO () */ if (isNull(finalizers)) { IOReturn(nameUnit); } else { updapRoot(ap(hd(finalizers),primArg(2)),primArg(1)); finalizers = tl(finalizers); return; } } primFun(primFinalizerWaiting) { /* IO Boolean */ IOBoolResult(!isNull(finalizers)); } #endif /* GC_WEAKPTRS */ #if HSCRIPT #if EMBEDDED extern void* getCurrentScript(void); primFun(primGetCurrentScript) { /* IO Int */ IOReturn( mkInt( (int)getCurrentScript() ) ); } #else primFun(primGetCurrentScript) { /* IO Int */ IOReturn( mkInt( 0 ) ); } #endif /* EMBEDDED */ #endif /* HSCRIPT */ /* -------------------------------------------------------------------------- * Primitives for implementing disposable memo functions * Byron Cook -- byron@cse.ogi.edu * * IOEql :: Eval a => a -> a -> IO Bool * if argument is an Int or Char * then use == * else use pointer identity * * IOHash :: Eval a => a -> IO Int * if a is an Int or Char * then use value cast as an Int * else use pointer identity * * (Earlier versions made Float a special case too - but that's not very * portable since it assumes that sizeof(FloatPro) == sizeof(Int).) * ------------------------------------------------------------------------*/ primFun(primIOEql) { /* :: Eval a => a -> a -> ST Mem Bool */ Cell x = IOArg(1); Cell y = IOArg(2); eval(x); eval(y); x = followInd(IOArg(1)); y = followInd(IOArg(2)); if (whatIs(x) == whatIs(y)) { switch (whatIs(x)) { case INTCELL : IOBoolResult(intOf(x)==intOf(y)); case CHARCELL : IOBoolResult(charOf(x)==charOf(y)); /* deliberate fall through to end */ } } IOBoolResult(x==y); } primFun(primIOHash) { /* :: Eval a => a -> ST Mem Int */ Cell x = IOArg(1); eval(x); x = followInd(IOArg(1)); switch(whatIs(x)) { case INTCELL : IOBoolResult(x); case CHARCELL : IOBoolResult(mkInt(charOf(x))); } IOBoolResult(mkInt((Int)x)); } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/machdep.c0000644006511100651110000020750210430652303015321 0ustar rossross/* -------------------------------------------------------------------------- * Machine dependent code * RISCOS specific code provided by Bryan Scatergood, JBS * Macintosh specific code provided by Hans Aberg (haberg@matematik.su.se) * HaskellScript code and recursive directory search (now just one level) * provided by Daan Leijen (leijen@fwi.uva.nl) * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: machdep.c,v $ * $Revision: 1.140 $ * $Date: 2006/05/11 15:14:11 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "opts.h" #include "strutil.h" #include "machdep.h" #include "char.h" #include "evaluator.h" /* everybody() proto only */ /*#define DEBUG_SEARCH*/ #if HAVE_SIGNAL_H # include #endif #if HAVE_SYS_TYPES_H # include #else # if HAVE_TYPES_H # include # endif #endif #if HAVE_SYS_PARAM_H # include #endif #if HAVE_LIMITS_H # include #endif #if HAVE_SYS_STAT_H # include #else # if HAVE_STAT_H # include # endif #endif #if HAVE_DIRENT_H # include #endif #if HAVE_LOCALE_H # include #endif /* Hack for systems with unlimited path length (e.g. the Hurd), which * will not define PATH_MAX or MAXPATHLEN. The Right Thing would be * to dynamically allocate these buffers, and use functions like * get_current_dir_name() and canonicalize_file_name(). */ #if HAVE_REALPATH && !defined(MAXPATHLEN) #ifdef PATH_MAX #define MAXPATHLEN PATH_MAX #else #define MAXPATHLEN 4096 #endif #endif /* Windows/DOS include files */ #if HAVE_DOS_H # include #endif #if HAVE_CONIO_H && ! HUGS_FOR_WINDOWS # include #endif #if HAVE_IO_H # include #endif #if HAVE_STD_H # include #endif #if HAVE_WINDOWS_H # include #endif #if DOS #include extern unsigned _stklen = 8000; /* Allocate an 8k stack segment */ #endif #if RISCOS #include "swis.h" #include "os.h" #endif /* Macintosh include files */ #if HAVE_CONSOLE_H # include #endif #if HAVE_FILES_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_ERRNO_H # include #endif #if HAVE_STDLIB_H # include #endif #if HAVE_UNIX_H #include #endif #if __MWERKS__ && macintosh #include /* The variable time_release should be set to a value which gives good cooperative multitasking. */ int time_release = 20000; int allow_break_count = 0; #endif /* -------------------------------------------------------------------------- * Prototypes for registry reading * ------------------------------------------------------------------------*/ #if USE_REGISTRY /* where have we hidden things in the registry? */ #if HSCRIPT #define HScriptRoot ("SOFTWARE\\Haskell\\HaskellScript\\") #endif extern String readRegString Args((HKEY, String, String, String)); static Bool local createKey Args((HKEY, String, PHKEY, REGSAM)); static Bool local queryValue Args((HKEY, String, String, LPDWORD, LPBYTE, DWORD)); static Bool local queryString Args((HKEY,String,String,String*)); static Bool local setValue Args((HKEY, String, String, DWORD, LPBYTE, DWORD)); #endif /* -------------------------------------------------------------------------- * Find information about a file: * ------------------------------------------------------------------------*/ Void getFileInfo(f,tm,sz) /* find time stamp and size of file*/ String f; Time *tm; Long *sz; { #if HAVE_SYS_STAT_H || HAVE_STAT_H || HAVE_UNIX_H struct stat scbuf; if (!stat(f,&scbuf)) { *tm = scbuf.st_mtime; *sz = (Long)(scbuf.st_size); } else { *tm = 0; *sz = 0; } #else /* normally just use stat() */ os_regset r; /* RISCOS PRM p.850 and p.837 */ r.r[0] = 17; /* Read catalogue, no path */ r.r[1] = (int)s; os_swi(OS_File, &r); if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) { tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */ tm->lo = r.r[3]; /* Execution address (low 4 bytes) */ } else { /* Not found, or not time-stamped */ tm->hi = tm->lo = 0; } *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0); #endif } #if HAVE_GETFINFO /* Mac971031 */ /* -------------------------------------------------------------------------- * Define a MacOS version of access(): * If the file is not accessible, -1 is returned and errno is set to * the reason for the failure. * If the file is accessible and the dummy is 0 (existence), 2 (write), * or 4 (read), the return is 0. * If the file is accessible, and the dummy is 1 (executable), then if * the file is a program (of type 'APPL'), the return is 0, otherwise -1. * Warnings: Use with caution. UNIX access do no translate to Macs. * Check of write access is not implemented (same as read). * ------------------------------------------------------------------------*/ int access(char *fileName, int dummy); int access(char *fileName, int dummy) { FInfo fi; short rc; errno = getfinfo(fileName, 0, &fi); if (errno != 0) return -1; /* Check file accessible. */ /* Cases dummy = existence, read, write. */ if (dummy == 0 || dummy & 0x6) return 0; /* Case dummy = executable. */ if (dummy == 1) { if (fi.fdType == 'APPL') return 0; errno = fi.fdType; return -1; } return 0; } #endif Bool readable(f,isReg) /* is f readable (and also, a regular file?) */ String f; Bool isReg; { #if DJGPP2 || HAVE_GETFINFO /* stat returns bogus mode bits on djgpp2 */ return (0 == access(f,4)); #elif HAVE_SYS_STAT_H || HAVE_STAT_H struct stat scbuf; return ( !stat(f,&scbuf) #if !(defined macintosh) /* Macintosh files always have read permission */ && (scbuf.st_mode & S_IREAD) /* readable */ #endif && ( !isReg || (scbuf.st_mode & S_IFREG)) /* regular file */ ); #elif HAVE_OS_SWI /* RISCOS specific */ os_regset r; /* RISCOS PRM p.850 -- JBS */ assert(dummy == 0); r.r[0] = 17; /* Read catalogue, no path */ r.r[1] = (int)f; os_swi(OS_File, &r); return r.r[0] != 1; /* Does this check it's a regular file? ADR */ #endif } /* -------------------------------------------------------------------------- * Search for script files on the HUGS path: * ------------------------------------------------------------------------*/ static String local homeDir Args((void)); #if __MWERKS__ && macintosh static String local currentDir Args((void)); #endif #if HSCRIPT static String local hscriptDir Args((Void)); static void local hscriptSuffixes Args((Void)); #endif #if 0 /* UNUSED */ static int local pathCmp Args((String, String)); #endif static String local normPath Args((String)); static Void local searchChr Args((Int)); static Void local searchStr Args((String)); static Bool local tryEndings Args((Void)); static Bool local find1 Args((String)); static Bool local find2 Args((String)); static String local expandVariable Args((String)); static String local skipVariable Args((String)); static String local nextPath Args((String)); static Bool local samePath Args((String,String)); #if DOS_FILENAMES static Bool local isPathSep Args((String)); #endif static Bool local scanSubDirs Args((String)); #if __MWERKS__ && macintosh typedef char FileName[FILENAME_MAX + 1]; FileName macHugsDir; /* Directory where Hugs was found. */ #endif #if DOS_FILENAMES # define SLASH '\\' # define isSLASH(c) ((c)=='\\' || (c)=='/') # define PATHSEP ';' # define isPATHSEP(x) isPathSep(x) # define DLL_ENDING ".dll" #elif MAC_FILENAMES # define SLASH ':' # define isSLASH(c) ((c)==SLASH) # define PATHSEP ';' # define isPATHSEP(x) (*(x) == PATHSEP) /* Mac PEF (Preferred Executable Format) file */ # define DLL_ENDING ".pef" #else # define SLASH '/' # define isSLASH(c) ((c)==SLASH) # define PATHSEP ':' # define isPATHSEP(x) (*(x) == PATHSEP) # define DLL_ENDING ".so" #endif #if HAVE_GETMODULEFILENAME && !DOS && !cygwin32_HOST_OS static HMODULE hugsModule = (HMODULE)0; static String hugsRoot = 0; extern Void setHugsModule Args((HMODULE)); extern Bool setHugsRoot Args((String)); Void setHugsModule(hmod) HMODULE hmod; { hugsModule = hmod; } Bool setHugsRoot(s) String s; { String newRoot = malloc(strlen(s) + 1); if (!newRoot) return FALSE; strcpy(newRoot,s); if (hugsRoot) free(hugsRoot); hugsRoot = newRoot; return TRUE; } #endif String hugsdir() { /* directory containing libraries/Prelude.hs */ #if HSCRIPT /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */ static char dir[FILENAME_MAX+1] = ""; if (dir[0] == '\0') { /* not initialised yet */ String s = readRegString(HKEY_LOCAL_MACHINE,hugsRegRoot,"InstallDir", HUGSDIR); if (s) { /* Protect against overruns */ strncpy(dir,s,FILENAME_MAX); dir[sizeof(dir)-1] = '\0'; free(s); } } return dir; #elif __MWERKS__ && macintosh static FileName dir = "\0"; /* Directory containing lib: Prelude.hs */ strcpy(dir,macHugsDir); return dir; #elif HAVE_GETMODULEFILENAME && !DOS && !cygwin32_HOST_OS /* On Windows, we can find the binary we're running and it's * conventional to put the libraries in the same place. */ static char dir[FILENAME_MAX+1] = ""; if (hugsRoot) return hugsRoot; if ( dir[0] == '\0' ) { /* not initialised yet */ String slash = NIL; char *hugsdir = getenv("HUGSDIR"); if (hugsdir) { strncpy(dir,hugsdir,FILENAME_MAX); } else { GetModuleFileName(hugsModule,dir,FILENAME_MAX+1); if ( dir[0] == '\0' ) { /* GetModuleFileName must have failed */ return HUGSDIR; } if ( (slash = strrchr(dir,SLASH)) != NULL ) { /* truncate after directory name */ *slash = '\0'; } } } return dir; #else /* On Unix systems, data is not typically stored relative to a binary * (it's also harder for a binary to determine where it lives). * First, check for an environment var, then fall back to * a configuration-time constant (--datadir=...). */ char *hugsdir = getenv("HUGSDIR"); return hugsdir ? hugsdir : HUGSDIR; #endif } static String homeDir() { return getenv("HOME"); } #if __MWERKS__ && macintosh static String currentDir() { static FileName dir = "\0"; getcwd(dir, FILENAME_MAX); dir[strlen(dir) - 1] = '\0'; return dir; } #endif #if HSCRIPT static String local hscriptDir() { /* Directory containing hscript.dll */ static char dir[FILENAME_MAX+1] = ""; if (dir[0] == '\0') { /* not initialised yet */ String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir",""); if (s) { /* Protect against overruns */ strncpy(dir,s,FILENAME_MAX); free(s); } } return dir; } static void hscriptSuffixes() { String ss = hugsSuffixes; hugsSuffixes = substPath(":.hsx:.hash",hugsSuffixes); free(ss); } #endif String local RealPath(s) /* Find absolute pathname of file */ String s; { #if HAVE__FULLPATH /* eg DOS */ static char path[FILENAME_MAX+1]; _fullpath(path,s,FILENAME_MAX+1); #elif HAVE_REALPATH /* eg Unix */ static char path[MAXPATHLEN+1]; path[sizeof(path)-1] = '\0'; if (strlen(s) <= (sizeof(path)-1)) { realpath(s,path); } else { return s; } #else static char path[FILENAME_MAX+1]; path[sizeof(path)-1] = '\0'; if (strlen(s) <= (sizeof(path)-1)) { strcpy(path,s); } else { return s; } #endif return path; } #if 0 /* UNUSED */ static int local pathCmp(p1,p2) /* Compare paths after normalisation */ String p1; String p2; { #if HAVE__FULLPATH /* eg DOS */ static char path1[FILENAME_MAX+1]; static char path2[FILENAME_MAX+1]; _fullpath(path1,p1,FILENAME_MAX+1); _fullpath(path2,p2,FILENAME_MAX+1); #elif HAVE_REALPATH /* eg Unix */ static char path1[MAXPATHLEN+1]; static char path2[MAXPATHLEN+1]; realpath(p1,path1); realpath(p2,path2); #else static char path1[FILENAME_MAX+1]; static char path2[FILENAME_MAX+1]; strcpy(path1,p1); strcpy(path2,p2); #endif #if CASE_INSENSITIVE_FILENAMES strlwr(path1); strlwr(path2); #endif return filenamecmp(path1,path2); } #endif static String local normPath(s) /* Try, as much as possible, to normalize */ String s; { /* a pathname in some appropriate manner. */ #if PATH_CANONICALIZATION String path = RealPath(s); #if CASE_INSENSITIVE_FILENAMES strlwr(path); /* and convert to lowercase */ #endif return path; #else /* ! PATH_CANONICALIZATION */ return s; #endif /* ! PATH_CANONICALIZATION */ } static char searchBuf[FILENAME_MAX+1]; static Int searchPos; #define searchReset(n) searchBuf[searchPos=(n)]='\0' static Void local searchChr(c) /* Add single character to search buffer */ Int c; { if (searchPos:\ but that seems too difficult) */ return *sep == ';' || *sep == ':' && *(sep+1) != SLASH; } #endif /* scandir, June 98 Daan Leijen searches the direct subdirectories of a directory for a file (excluding directories that start with a dot) input: searchbuf contains base directory (not SLASH terminated) argument name contains the module name output: TRUE: searchBuf contains the full filename FALSE: searchBuf is garbage, file not found */ #if HAVE_DIRENT_H static Bool scanSubDirs(s) String s; { DIR *dir; struct dirent *entry; struct stat statb; int save; if ((dir = opendir(searchBuf)) == NULL) errno = 0; else { searchChr(SLASH); save = searchPos; while ((entry = readdir(dir)) != NULL) if (entry->d_name[0] != '.') { searchStr(entry->d_name); if (stat(searchBuf, &statb)==0 && S_ISDIR(statb.st_mode)) { searchChr(SLASH); if (find2(s)) { closedir(dir); return TRUE; } } searchReset(save); } closedir(dir); } return FALSE; } #elif HAVE_WINDOWS_H static Bool scanSubDirs(s) String s; { struct _finddata_t findInfo; long handle; int save; searchChr(SLASH); save = searchPos; searchStr("*.*"); /* initiate the search */ handle = _findfirst( searchBuf, &findInfo ); if (handle==-1) { errno = 0; return FALSE; } /* search all subdirectories */ do { /* if we have a valid sub directory */ if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) && (findInfo.name[0] != '.')) { searchReset(save); searchStr(findInfo.name); searchChr(SLASH); if (find2(s)) { _findclose( handle ); return TRUE; } } } while (_findnext( handle, &findInfo ) == 0); _findclose( handle ); return FALSE; } #elif __MWERKS__ && macintosh /* Macintosh subscan */ #include #include "MoreFilesExtras.h" #include #define MAXSPECS 50 extern StringPtr c2pstr(char *aStr); extern char *p2cstr(StringPtr aStr); static Bool scanSubDirs(s) String s; { FileName name = "\0"; ConstStr255Param pname = "\p"; String subdir = "\0"; OSErr error; FSSpec specs[MAXSPECS]; short found = 0; short start = 1; int i, save; save = searchPos; /* is it in the current directory ? */ if (find2(s)) return TRUE; searchReset(save); /* initiate the search */ /* the complete path to the directory is in searchBuf */ strncpy(name,searchBuf,FILENAME_MAX); /* do not mess up :-) */ pname = c2pstr(name); /* get all subdirectories in path */ error = GetDirItems( 0, 0, pname, false, true, specs , MAXSPECS, &found, &start ); /* search over the found directories */ if ((error != noErr) && (error != fnfErr)) { errno = 0; return FALSE; } else { if (found > 0) for (i = 0; i < found; i++) { subdir = p2cstr(specs[i].name); searchStr(subdir); searchChr(SLASH); if (find2(s)) return TRUE; searchReset(save); } } return FALSE; } #else static Bool scanSubDirs(name) String name; { return FALSE; } #endif /* HAVE_WINDOWS_H || HAVE_DIRENT_H || (__MWERKS__ && macintosh) */ /* Variables that may be substituted in the path */ struct shellVariable { String var_name; String (*var_value) Args((Void)); }; static struct shellVariable shell_var[] = { { "Hugs", &hugsdir }, { "Home", &homeDir }, #if __MWERKS__ && macintosh { "Current", ¤tDir }, #endif #if HSCRIPT { "HScript", &hscriptDir }, #endif { 0, 0 } }; /* findPathname nm = [ nm ++ e | e <- "" : hugsSuffixes ] */ String findPathname(filename) /* Look for a file, trying various extensions */ String filename; { /* Return ***input name*** if no file was found */ searchReset(0); searchStr(filename); #if DEBUG_SEARCH Printf("trying '%s'\n", searchBuf); #endif if (!readable(searchBuf,TRUE) && !tryEndings()) searchStr(""); return normPath(searchBuf); } /* Finding the filename corresponding to a module name: find maybe_dir nm = [ d ++ map dot2slash nm ++ e | d <- dirs, e <- exts ] where dirs = maybeToList maybe_dir ++ hugsPath exts = hugsSuffixes -- default: [".hs",".lhs"] -- the dir is added if the importing module was found there, or -- was specified as an explicit filename. dot2slash c = if c=='.' then slash else c */ String findMInDir(dir,nm) /* Look for a module in the suggested dir */ String dir; /* Return NULL if no file was found */ String nm; { searchReset(0); searchStr(dir); searchChr(SLASH); if (find2(nm)) { return normPath(searchBuf); } else { return NULL; } } String findMPathname(name) /* Look for a module */ String name; { /* Return NULL if no file was found */ if (find1(name)) { return normPath(searchBuf); } else { return NULL; } } static Bool find1(name) /* Search each directory of the path */ String name; { String pathpt = hugsPath; String value; searchReset(0); /* look along the HUGSPATH */ if (pathpt) { while (*pathpt) { searchReset(0); if ((value=expandVariable(pathpt)) != NULL) { searchStr(value); pathpt = skipVariable(pathpt); } while (*pathpt && !isPATHSEP(pathpt)) searchChr(*pathpt++); /* If the path entry ends in SLASH '*', search immediate subdirs */ if (searchPos >= 2 && isSLASH(pathpt[-2]) && pathpt[-1] == '*') { searchPos -= 2; searchBuf[searchPos] = '\0'; if (scanSubDirs(name)) return TRUE; } else { searchChr(SLASH); if (find2(name)) return TRUE; } if (isPATHSEP(pathpt)) pathpt++; } } return FALSE; } /* Expansion of initial MPW-style "shell-variables" of the form {varname} */ static String local expandVariable(pathpt) String pathpt; { if (*pathpt=='{') { int i, len; for (i = 0; shell_var[i].var_name!=NULL; i++) { len = strlen(shell_var[i].var_name); if (strncmp(pathpt+1,shell_var[i].var_name,len)==0 && pathpt[len+1]=='}') { return (*shell_var[i].var_value)(); } } } return NULL; } /* Assuming expandVariable(pathpt) succeeded, skip past the variable */ static String local skipVariable(pathpt) String pathpt; { return strchr(pathpt+1,'}')+1; } static Bool local find2(s) /* Turn module name into a filename */ String s; { String sp; /* replace all dots in the module name with slashes */ for (sp = s; *sp; sp++) { searchBuf[searchPos++] = *sp == '.' ? SLASH : *sp; } return tryEndings(); } String dirname(filename) /* Return the directory part of the filename */ String filename; { /* or "." if no directory. */ #if DOS_FILENAMES /* Allow both / and \\ as delimiters */ /* So we cannot make use of strrchr() */ String slash; slash = filename + strlen(filename) - 1; while (slash > filename) { if (isSLASH(*slash)) break; slash--; } if (slash <= filename) { return strCopy("."); } else { return strnCopy(filename, slash - filename); } #else String slash = strrchr(filename,SLASH); if (!slash) { return strCopy("."); } else { return strnCopy(filename, slash - filename); } #endif } /* -------------------------------------------------------------------------- * Substitute old value of path into empty entries in new path * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e" * ------------------------------------------------------------------------*/ String local substPath(new,sub) /* substitute sub path into new path*/ String new; String sub; { Bool substituted = FALSE; /* only allow one replacement */ Int maxlen = strlen(sub) + strlen(new); /* safe upper bound */ String r = (String) malloc(maxlen+1); /* result string */ String t = r; /* pointer into r */ String next = new; /* next uncopied char in new */ String start = next; /* start of last path component */ if (r == 0) { ERRMSG(0) "String storage space exhausted" EEND; } do { if (isPATHSEP(next) || *next == '\0') { if (!substituted && next == start) { String s = sub; for(; *s != '\0'; ++s) { *t++ = *s; } substituted = TRUE; } start = next+1; } } while ((*t++ = *next++) != '\0'); return uniqPath(r); } /* Remove duplicates from the path */ String uniqPath(path) String path; { char *pp; for (pp = path; *pp; ) { char *prev; char *next = nextPath(pp); for (prev = path; prev != pp; prev = nextPath(prev)) if (samePath(prev,pp)) break; if (prev == pp) /* not found: keep entry */ pp = next; else if (*next) /* found in middle: delete entry */ strcpy(pp, next); else { /* found at end: delete last entry */ if (pp != path) pp--; *pp = '\0'; } } return realloc(path, strlen(path)+1); } /* Advance to the start of the next entry in the path list */ static String local nextPath(pp) String pp; { while (*pp && !isPATHSEP(pp)) pp++; if (*pp) pp++; return pp; } static Bool local samePath(pp1, pp2) String pp1, pp2; { char *ppsave1, *ppsave2; char *value; /* initial substitution variable? */ if ((value=expandVariable(pp1)) != NULL) { ppsave1 = skipVariable(pp1); pp1 = value; } else ppsave1 = 0; if ((value=expandVariable(pp2)) != NULL) { ppsave2 = skipVariable(pp2); pp2 = value; } else ppsave2 = 0; while (*pp1 && !isPATHSEP(pp1) && *pp2 && !isPATHSEP(pp2)) { if (*pp1 != *pp2) return FALSE; if (*++pp1 == '\0' && ppsave1 != 0) { /* end of substitution */ pp1 = ppsave1; ppsave1 = 0; } if (*++pp2 == '\0' && ppsave2 != 0) { /* end of substitution */ pp2 = ppsave2; ppsave2 = 0; } } return (*pp1=='\0' || isPATHSEP(pp1)) && (*pp2=='\0' || isPATHSEP(pp2)); } /* -------------------------------------------------------------------------- * Read value from environment variable or registry: * ------------------------------------------------------------------------*/ String fromEnv(var,def) /* return value of: */ String var; /* environment variable named by var */ String def; { /* or: default value given by def */ String s = getenv(var); return (s ? s : def); } /* -------------------------------------------------------------------------- * Get time/date stamp for inclusion in compiled files: * ------------------------------------------------------------------------*/ #if PROFILING String timeString() { /* return time&date string */ time_t clock; /* must end with '\n' character */ time(&clock); return(ctime(&clock)); } #endif /* -------------------------------------------------------------------------- * Garbage collection notification: * ------------------------------------------------------------------------*/ Bool gcMessages = FALSE; /* TRUE => print GC messages */ Void gcStarted() { /* Notify garbage collector start */ if (gcMessages) { Printf("{{Gc"); FlushStdout(); } } Void gcScanning() { /* Notify garbage collector scans */ if (gcMessages) { Putchar(':'); FlushStdout(); } } Void gcRecovered(recovered) /* Notify garbage collection done */ Int recovered; { if (gcMessages) { Printf("%d}}",recovered); FlushStdout(); } } Cell *CStackBase; /* Retain start of C control stack */ #if RISCOS /* Stack traversal for RISCOS */ /* Warning: The following code is specific to the Acorn ARM under RISCOS (and C4). We must explicitly walk back through the stack frames, since the stack is extended from the heap. (see PRM pp. 1757). gcCStack must not be modified, since the offset '5' assumes that only v1 is used inside this function. Hence we do all the real work in gcARM. */ #define spreg 13 /* C3 has SP=R13 */ #define previousFrame(fp) ((int *)((fp)[-3])) #define programCounter(fp) ((int *)((*(fp)-12) & ~0xFC000003)) #define isSubSPSP(w) (((w)&dontCare) == doCare) #define doCare (0xE24DD000) /* SUB r13,r13,#0 */ #define dontCare (~0x00100FFF) /* S and # bits */ #define immediateArg(x) ( ((x)&0xFF) << (((x)&0xF00)>>7) ) static void gcARM(int *fp) { int si = *programCounter(fp); /* Save instruction indicates how */ /* many registers in this frame */ int *regs = fp - 4; if (si & (1<<0)) markWithoutMove(*regs--); if (si & (1<<1)) markWithoutMove(*regs--); if (si & (1<<2)) markWithoutMove(*regs--); if (si & (1<<3)) markWithoutMove(*regs--); if (si & (1<<4)) markWithoutMove(*regs--); if (si & (1<<5)) markWithoutMove(*regs--); if (si & (1<<6)) markWithoutMove(*regs--); if (si & (1<<7)) markWithoutMove(*regs--); if (si & (1<<8)) markWithoutMove(*regs--); if (si & (1<<9)) markWithoutMove(*regs--); if (previousFrame(fp)) { /* The non-register stack space is for the previous frame is above this fp, and not below the previous fp, because of the way stack extension works. It seems the only way of discovering its size is finding the SUB sp, sp, #? instruction by walking through the code following the entry point. */ int *oldpc = programCounter(previousFrame(fp)); int fsize = 0, i; for(i = 1; i < 6; ++i) if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4; for(i=1; i<=fsize; ++i) markWithoutMove(fp[i]); } } void gcCStack() { int dummy; int *fp = 5 + &dummy; while (fp) { gcARM(fp); fp = previousFrame(fp); } } #else /* Garbage collection for standard stack machines */ Void gcCStack() { /* Garbage collect elements off */ Cell stackTop = NIL; /* C stack */ Cell *ptr = &stackTop; #if SIZEOF_INTP == 2 if (((long)(ptr) - (long)(CStackBase))&1) fatal("gcCStack"); #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */ if (((long)(ptr) - (long)(CStackBase))&1) fatal("gcCStack"); #else if (((long)(ptr) - (long)(CStackBase))&3) fatal("gcCStack"); #endif #define StackGrowsDown while (ptr<=CStackBase) markWithoutMove(*ptr++) #define StackGrowsUp while (ptr>=CStackBase) markWithoutMove(*ptr--) #define GuessDirection if (ptr>CStackBase) StackGrowsUp; else StackGrowsDown #if STACK_DIRECTION > 0 StackGrowsUp; #elif STACK_DIRECTION < 0 StackGrowsDown; #else GuessDirection; #endif #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */ ptr = (Cell *)((long)(&stackTop) + 2); StackGrowsDown; #endif #undef StackGrowsDown #undef StackGrowsUp #undef GuessDirection } #endif /* -------------------------------------------------------------------------- * Terminal dependent stuff: * ------------------------------------------------------------------------*/ #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H) /* grab the varargs prototype for ioctl */ #if HAVE_SYS_IOCTL_H # include #endif /* The order of these three tests is very important because * some systems have more than one of the requisite header file * but only one of them seems to work. * Anyone changing the order of the tests should try enabling each of the * three branches in turn and write down which ones work as well as which * OS/compiler they're using. * * OS Compiler sgtty termio termios notes * Linux 2.0.18 gcc 2.7.2 absent works works 1 * * Notes: * 1) On Linux, termio.h just #includes termios.h and sgtty.h is * implemented using termios.h. * sgtty.h is in /usr/include/bsd which is not on my standard include * path. Adding it does no harm but you might as well use termios. * -- * alastair@reid-consulting-uk.ltd.uk */ #if HAVE_TERMIOS_H #include typedef struct termios TermParams; #define getTerminal(fd,tp) tcgetattr(fd, &tp) #define setTerminal(fd,tp) tcsetattr(fd, TCSAFLUSH, &tp) #define getEcho(tp) ((tp.c_lflag | ECHO) != 0) #define noEcho(tp) tp.c_lflag &= ~ECHO; #define doEcho(tp) tp.c_lflag |= ECHO; #define getBuff(tp) ((tp.c_lflag | ICANON) != 0) #define noBuff(tp) tp.c_lflag &= ~ICANON; \ tp.c_cc[VMIN] = 1; \ tp.c_cc[VTIME] = 0; #define doBuff(tp) tp.c_lflag |= ICANON; \ tp.c_cc[VEOF] = '\04'; \ tp.c_cc[VEOL] = '\0'; #elif HAVE_SGTTY_H #include typedef struct sgttyb TermParams; #define getTerminal(fd,tp) ioctl(fd,TIOCGETP,&tp) #define setTerminal(fd,tp) ioctl(fd,TIOCSETP,&tp) #define getEcho(tp) ((tp.sg_flags | ECHO) != 0) #define noEcho(tp) tp.sg_flags &= ~ECHO; #define doEcho(tp) tp.sg_flags |= ECHO; #if HPUX #define getBuff(tp) ((tp.sg_flags | RAW) == 0) #define noBuff(tp) tp.sg_flags |= RAW; #define doBuff(tp) tp.sg_flags &= ~RAW; #else #define getBuff(tp) ((tp.sg_flags | CBREAK) == 0) #define noBuff(tp) tp.sg_flags |= CBREAK; #define doBuff(tp) tp.sg_flags &= ~CBREAK; #endif #elif HAVE_TERMIO_H #include typedef struct termio TermParams; #define getTerminal(fd,tp) ioctl(fd,TCGETA,&tp) #define setTerminal(fd,tp) ioctl(fd,TCSETAF,&tp) #define getEcho(tp) ((tp.c_lflag | ECHO) != 0) #define noEcho(tp) tp.c_lflag &= ~ECHO; #define doEcho(tp) tp.c_lflag |= ECHO; #define getBuff(tp) ((tp.c_lflag | ICANON) != 0) #define noBuff(tp) tp.c_lflag &= ~ICANON; \ tp.c_cc[VMIN] = 1; \ tp.c_cc[VTIME] = 0; #define doBuff(tp) tp.c_lflag |= ICANON; \ tp.c_cc[VEOF] = '\04'; \ tp.c_cc[VEOL] = '\0'; #endif static Bool messedWithTerminal = FALSE; static TermParams originalSettings; Void normalTerminal() { /* restore terminal initial state */ if (messedWithTerminal) setTerminal(fileno(stdin), originalSettings); } Bool getEchoTerminal(Int fd) { TermParams settings; getTerminal(fd, settings); return getEcho(settings); } Void setEchoTerminal(Int fd, Bool echo) { TermParams settings; if (fd==0 && !messedWithTerminal) { getTerminal(0, originalSettings); messedWithTerminal = TRUE; } getTerminal(fd, settings); if (echo) { doEcho(settings); } else { noEcho(settings); } setTerminal(fd, settings); } Bool getBuffTerminal(Int fd) { TermParams settings; getTerminal(fd, settings); return getEcho(settings); } Void setBuffTerminal(Int fd, Bool buffered) { TermParams settings; if (fd==0 && !messedWithTerminal) { getTerminal(0, originalSettings); messedWithTerminal = TRUE; } getTerminal(fd, settings); if (buffered) { doBuff(settings); } else { noBuff(settings); } setTerminal(fd, settings); } Int getTerminalWidth() { /* determine width of terminal */ #ifdef TIOCGWINSZ #ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/ #include /* Required by sys/ptem.h */ #include /* Required to declare winsize */ #endif static struct winsize terminalSize; ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize); return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col; #else return 80; #endif } #elif __MWERKS__ && macintosh #include Int getTerminalWidth() { /* Never insert extra '\n' in output, as the console softwraps. */ return INT_MAX; } Void normalTerminal() { } Bool getEchoTerminal(Int fd) { return TRUE; } Void setEchoTerminal(Int fd, Bool echo) { } Bool getBuffTerminal(Int fd) { return TRUE; } Void setBuffTerminal(Int fd, Bool buffered) { } #elif IS_WINDOWS static Bool messedWithTerminal = FALSE; static DWORD originalSettings; Int getTerminalWidth() { return 80; } Void normalTerminal() { /* restore terminal initial state */ if (messedWithTerminal) { HANDLE hIn; hIn = GetStdHandle(STD_INPUT_HANDLE); SetConsoleMode(hIn, originalSettings); messedWithTerminal = FALSE; } } Bool getEchoTerminal(Int fd) { if (fd==0) { DWORD mo; HANDLE hIn; hIn = GetStdHandle(STD_INPUT_HANDLE); GetConsoleMode(hIn, &mo); return (mo & ENABLE_ECHO_INPUT)!=0; } else return FALSE; } Void setEchoTerminal(Int fd, Bool echo) { if (fd==0) { DWORD mo; HANDLE hIn; hIn = GetStdHandle(STD_INPUT_HANDLE); GetConsoleMode(hIn, &mo); if (!messedWithTerminal) { originalSettings = mo; messedWithTerminal = TRUE; } if (echo) mo |= ENABLE_ECHO_INPUT; else mo &= ~ENABLE_ECHO_INPUT; SetConsoleMode(hIn, mo); } } Bool getBuffTerminal(Int fd) { if (fd==0) { DWORD mo; HANDLE hIn; hIn = GetStdHandle(STD_INPUT_HANDLE); GetConsoleMode(hIn, &mo); return (mo & ENABLE_LINE_INPUT)!=0; } else return FALSE; } Void setBuffTerminal(Int fd, Bool buffered) { if (fd==0) { DWORD mo; HANDLE hIn; hIn = GetStdHandle(STD_INPUT_HANDLE); GetConsoleMode(hIn, &mo); if (!messedWithTerminal) { originalSettings = mo; messedWithTerminal = TRUE; } if (buffered) mo |= ENABLE_LINE_INPUT; else mo &= ~ENABLE_LINE_INPUT; SetConsoleMode(hIn, mo); } } #else /* no terminal driver - eg DOS, RISCOS */ Int getTerminalWidth() { #if RISCOS int dummy, width; (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width); return width+1; #else return 80; #endif } Void normalTerminal() { /* restore terminal initial state */ } Bool getEchoTerminal(Int fd) { return fd==0; } Void setEchoTerminal(Int fd, Bool echo) { } Bool getBuffTerminal(Int fd) { return fd==0; } Void setBuffTerminal(Int fd, Bool buffered) { } #if 0 Int readTerminalChar() { /* read character from terminal */ if (terminalEchoReqd) { return getchar(); } else { #if IS_WINDOWS && !HUGS_FOR_WINDOWS && !__BORLANDC__ /* When reading a character from the console/terminal, we want * to operate in 'raw' mode (to use old UNIX tty parlance) and have * it return when a character is available and _not_ wait until * the next time the user hits carriage return. On Windows platforms, * this _can_ be done by reading directly from the console, using * getch(). However, this doesn't sit well with programming * environments such as Emacs which allow you to create sub-processes * running Hugs, and then communicate with the running interpreter * through its standard input and output handles. If you use getch() * in that setting, you end up trying to read the (unused) console * of the editor itself, through which not a lot of characters is * bound to come out, since the editor communicates input to Hugs * via the standard input handle. * * To avoid this rather unfortunate situation, we use the Win32 * console API and re-jig the input properties of the standard * input handle before trying to read a character using stdio's * getchar(). * * The 'cost' of this solution is that it is Win32 specific and * won't work with Windows 3.1 + it is kind of ugly and verbose * to have to futz around with the console properties on a * per-char basis. Both of these disadvantages aren't in my * opinion fatal. * * -- sof 5/99 */ Int c; DWORD mo; HANDLE hIn; static int isEmacs = -1; /* Cannot claim to fully understand, but if the FILE*s underlying file descriptor is in text mode, we seem to lose the first carriage return. */ setmode(fileno(stdin), _O_BINARY); hIn = GetStdHandle(STD_INPUT_HANDLE); GetConsoleMode(hIn, &mo); SetConsoleMode(hIn, mo & ~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT)); /* * When using the read-eval-print loop inside of a Win32 console, a * lone '\n' is returned by getc() after switching to binary mode. * Since Enter maps to a raw '\r', and we map this (below) to '\n', * we can just ignore all *raw* '\n's. * * However, Emacs subshells (via comint) doesn't emit '\r's, just \n's, * which is incompatible with the above. The hack/workaround, is to * dynamically check whether we're exec'ing within Emacs and fall * back to the simple, non-\n stripping input mode if we are. sigh. * */ if (isEmacs < 0) { isEmacs = (getenv("EMACS") != NULL); } if (isEmacs) { c = getc(stdin); } else { do { c = getc(stdin); } while (c == '\n'); } /* Same as it ever was - revert back state of stdin. */ SetConsoleMode(hIn, mo); setmode(fileno(stdin), _O_TEXT); #else Int c = getch(); #endif return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */ } } #endif #endif /* no terminal driver */ /* -------------------------------------------------------------------------- * Interrupt handling: * ------------------------------------------------------------------------*/ Bool broken = FALSE; /* pending break to be handled */ static Bool breakReqd = FALSE; /* currently trapping breaks */ static Bool trapBreak = FALSE; /* ever asked to trap breaks */ static sigProto(ignoreBreak); static Void local installHandlers Args((Void)); Bool breakOn(reqd) /* set break trapping on if reqd, */ Bool reqd; { /* or off otherwise, returning old */ Bool old = breakReqd; breakReqd = reqd; if (reqd) { trapBreak = TRUE; if (broken) { /* repond to break signal received */ broken = FALSE; /* whilst break trap disabled */ sigRaise(breakHandler); /* not reached */ } #if HANDLERS_CANT_LONGJMP ctrlbrk(ignoreBreak); #else ctrlbrk(breakHandler); #endif } else if (trapBreak) { /* If we have been trapping breaks, */ ctrlbrk(ignoreBreak); /* switch to deferring them. */ } return old; } static sigHandler(ignoreBreak) { /* record but don't respond to break*/ ctrlbrk(ignoreBreak); /* reinstall signal handler */ /* redundant on BSD systems but essential */ /* on POSIX and other systems */ broken = TRUE; sigResume; } #if !DONT_PANIC static sigProto(panic); static sigHandler(panic) { /* exit in a panic, on receipt of */ everybody(EXIT); /* an unexpected signal */ fprintf(stderr,"\nUnexpected signal\n"); exit(1); sigResume;/*NOTREACHED*/ } #endif /* !DONT_PANIC */ #if IS_WINDOWS BOOL WINAPI consoleHandler(DWORD dwCtrlType) { switch (dwCtrlType) { /* Allows Hugs to be terminated */ case CTRL_CLOSE_EVENT : /* from the window's close menu. */ ExitProcess(0); } return FALSE; } #endif static Void local installHandlers() { /* Install handlers for all fatal */ /* signals except SIGINT and SIGBREAK*/ #if IS_WINDOWS SetConsoleCtrlHandler(consoleHandler,TRUE); #endif #if !DONT_PANIC && !DOS # ifdef SIGABRT signal(SIGABRT,panic); # endif # ifdef SIGBUS signal(SIGBUS,panic); # endif # ifdef SIGFPE signal(SIGFPE,panic); # endif # ifdef SIGHUP signal(SIGHUP,panic); # endif # ifdef SIGILL signal(SIGILL,panic); # endif # ifdef SIGQUIT signal(SIGQUIT,panic); # endif # ifdef SIGSEGV signal(SIGSEGV,panic); # endif # ifdef SIGTERM signal(SIGTERM,panic); # endif #endif /* !DONT_PANIC && !DOS */ } /* -------------------------------------------------------------------------- * Shell escapes: * ------------------------------------------------------------------------*/ Int shellEsc(cmd, sync, useShell) /* run a shell command (or shell) */ String cmd; Bool sync; Bool useShell; { #ifndef HAVE_WINDOWS_H /* currently ignore the 'useShell' and 'sync' flags */ # if HAVE_MACSYSTEM return macsystem(cmd); # else # if HAVE_BIN_SH if (cmd[0]=='\0') { cmd = fromEnv("SHELL","/bin/sh"); } # endif return system(cmd); # endif #else STARTUPINFO si; PROCESS_INFORMATION pi; BOOL bStatus; DWORD dwResult; if (useShell) { return system(cmd); } ZeroMemory(&si, sizeof(si)); si.cb = sizeof(si); si.dwFlags = STARTF_USESHOWWINDOW; si.wShowWindow = SW_SHOW; bStatus = CreateProcess(NULL, /* app name is the first component of the command line string */ cmd, NULL, /* default process security attributes */ NULL, /* default prim. thread security attributes */ FALSE, /* don't inherit */ CREATE_NEW_CONSOLE, NULL, /* environment; same block as parent */ NULL, /* current directory; same as parent */ &si, &pi); if (!bStatus) { return 1; } else { CloseHandle(pi.hThread); /* * Wait for the editor process to complete, or not. If we * don't wait for the editor process to complete, the user * will have to manually :(re)load the sources after having * save them within the editor. The default is to wait. */ if (!sync) { CloseHandle(pi.hProcess); return 0; } else { # if !HUGS_FOR_WINDOWS dwResult = WaitForSingleObject(pi.hProcess, INFINITE); return (dwResult == WAIT_OBJECT_0 ? 0 : 1); # else MSG msg; while (1) { dwResult = MsgWaitForMultipleObjects(1, &pi.hProcess, FALSE, /* fWaitAll */ INFINITE, QS_PAINT); if (dwResult == WAIT_OBJECT_0) { return 0; } else if (dwResult == (WAIT_OBJECT_0 + 1)) { /* Dispatch waiting messages. */ while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE)) { TranslateMessage(&msg); DispatchMessage(&msg); } } else { return 1; } } # endif } } #endif } #if RISCOS /* RISCOS also needs a chdir() */ int chdir(char *s) { /* RISCOS PRM p. 885 -- JBS */ return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL; } #endif /* -------------------------------------------------------------------------- * Floating point support: * ------------------------------------------------------------------------*/ #if FLOATS_SUPPORTED #if BREAK_FLOATS static union { Float flVal; struct { Cell flPart1,flPart2; } clVal; } fudgeCoerce; Cell bfTemp = NIL; Cell mkFloat(fl) FloatPro fl; { Cell p1,p2; fudgeCoerce.flVal = fl; bfTemp = mkInt(fudgeCoerce.clVal.flPart1); p2 = mkInt(fudgeCoerce.clVal.flPart2); p1 = bfTemp; bfTemp = NIL; return pair(FLOATCELL,pair(p1,p2)); } FloatPro floatOf(c) Cell c; { fudgeCoerce.clVal.flPart1 = intOf(fst(snd(c))); fudgeCoerce.clVal.flPart2 = intOf(snd(snd(c))); return fudgeCoerce.flVal; } #else /* !BREAK_FLOATS */ static union { Float flVal; Cell clVal; } fudgeCoerce; Cell mkFloat(fl) FloatPro fl; { fudgeCoerce.flVal = (Float)fl; return pair(FLOATCELL,fudgeCoerce.clVal); } FloatPro floatOf(c) Cell c; { fudgeCoerce.clVal = snd(c); return fudgeCoerce.flVal; } #endif /* !BREAK_FLOATS */ String floatToString(fl) /* Make sure that floating */ FloatPro fl; { /* point values print out in */ static char buffer1[32]; /* a form in which they could */ static char buffer2[32]; /* also be entered as floats */ Int i=0, j=0; sprintf(buffer1,FloatFMT,fl); while (buffer1[i] && strchr("eE.",buffer1[i])==0) buffer2[j++] = buffer1[i++]; if (buffer1[i]=='\0') { sprintf(buffer1,"%.1f",fl); i = j = 0; } else if (buffer1[i]!='.') { buffer2[j++] = '.'; buffer2[j++] = '0'; } while ((buffer2[j++]=buffer1[i++])!=0) { } return buffer2; } static union { Double dblVal; struct { Cell dblPart1,dblPart2; } cdVal; } fudgeDCoerce; Cell part1Double(dbl) DoublePro dbl; { fudgeDCoerce.dblVal = dbl; return fudgeDCoerce.cdVal.dblPart1; } Cell part2Double(dbl) DoublePro dbl; { fudgeDCoerce.dblVal = dbl; return fudgeDCoerce.cdVal.dblPart2; } DoublePro doubleFromParts(c1,c2) Cell c1, c2; { fudgeDCoerce.cdVal.dblPart1 = c1; fudgeDCoerce.cdVal.dblPart2 = c2; return fudgeDCoerce.dblVal; } Cell bdTemp = NIL; Cell mkDouble(dbl) DoublePro dbl; { Cell p1,p2; fudgeDCoerce.dblVal = dbl; bdTemp = mkInt(fudgeDCoerce.cdVal.dblPart1); p2 = mkInt(fudgeDCoerce.cdVal.dblPart2); p1 = bdTemp; bdTemp = NIL; return pair(DOUBLECELL,pair(p1,p2)); } DoublePro doubleOf(c) Cell c; { fudgeDCoerce.cdVal.dblPart1 = intOf(fst(snd(c))); fudgeDCoerce.cdVal.dblPart2 = intOf(snd(snd(c))); return fudgeDCoerce.dblVal; } String doubleToString(dbl) /* Make sure that floating */ DoublePro dbl; { /* point values print out in */ static char buffer1[32]; /* a form in which they could */ static char buffer2[32]; /* also be entered as doubles */ Int i=0, j=0; sprintf(buffer1,DoubleFMT,dbl); while (buffer1[i] && strchr("eE.",buffer1[i])==0) buffer2[j++] = buffer1[i++]; if (buffer1[i]=='\0') { sprintf(buffer1,"%.1f",dbl); i = j = 0; } else if (buffer1[i]!='.') { buffer2[j++] = '.'; buffer2[j++] = '0'; } while ((buffer2[j++]=buffer1[i++])!=0) { } return buffer2; } DoublePro stringToDouble(s) String s; { return atof(s); } #else /* !FLOATS_SUPPORTED */ Cell mkFloat(fl) FloatPro fl; { internal("mkFloat"); return 0;/*NOTREACHED*/ } FloatPro floatOf(c) Cell c; { internal("floatOf"); return 0;/*NOTREACHED*/ } String floatToString(fl) FloatPro fl; { internal("floatToString"); return "";/*NOTREACHED*/ } Cell part1Double(dbl) DoublePro dbl; { internal("part1Double"); return 0;/*NOTREACHED*/ } Cell part2Double(dbl) DoublePro dbl; { internal("part2Double"); return 0;/*NOTREACHED*/ } DoublePro doubleFromParts(c1,c2) Cell c1, c2; { internal("doubleFromParts"); return 0;/*NOTREACHED*/ } Cell mkDouble(fl) DoublePro fl; { internal("mkDouble"); return 0;/*NOTREACHED*/ } DoublePro doubleOf(c) Cell c; { internal("doubleOf"); return 0;/*NOTREACHED*/ } String doubleToString(fl) DoublePro fl; { internal("doubleToString"); return "";/*NOTREACHED*/ } #endif /* !FLOATS_SUPPORTED */ /*--------------------------------------------------------------------------- * Int64-related operations: *-------------------------------------------------------------------------*/ #if PROVIDE_INT64 Int part1Int64(i) HsInt64 i; { return (Int)(i >> 32); } Int part2Int64(i) HsInt64 i; { return (Int)(i); } HsInt64 int64FromParts(c1,c2) Int c1, c2; { return ((HsInt64)c1 << 32) | (HsInt64)((HsWord32)c2); } #endif /* PROVIDE_INT64 */ /*--------------------------------------------------------------------------- * Printf-related operations: *-------------------------------------------------------------------------*/ #if !HAVE_VSNPRINTF int vsnprintf(char* buffer, size_t count, const char* fmt, va_list ap); int vsnprintf(char* buffer, size_t count, const char* fmt, va_list ap) { #if HAVE__VSNPRINTF return _vsnprintf(buffer, count, fmt, ap); #else return 0; #endif } #endif /* HAVE_VSNPRINTF */ #if !HAVE_SNPRINTF && !HAVE__SNPRINTF int snprintf(char* buffer, size_t count, const char* fmt, ...); int snprintf(char* buffer, size_t count, const char* fmt, ...) { #if HAVE_VSNPRINTF || HAVE__VSNPRINTF int r; va_list ap; /* pointer into argument list */ va_start(ap, fmt); /* make ap point to first arg after fmt */ r = vsnprintf(buffer, count, fmt, ap); va_end(ap); /* clean up */ return r; #else return 0; #endif } #endif /* HAVE_SNPRINTF */ /* -------------------------------------------------------------------------- * Dynamic loading: * ------------------------------------------------------------------------*/ static void* local getModDLL Args((String)); static void* local getDLL Args((String)); static void* local getDLLSymbol Args((void*,String)); #if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */ #include #include static void* local getDLL(dll) /* load dll */ String dll; { void *instance = dlopen(dll, 0 #if defined(RTLD_LAZY) /* eg SunOS4 doesn't have RTLD_NOW */ | RTLD_LAZY # if defined(RTLD_GLOBAL) | RTLD_GLOBAL # endif #elif defined(RTLD_NOW) | RTLD_NOW #else /* eg FreeBSD doesn't have RTLD_LAZY */ | 1 #endif ); if (NULL == instance) { ERRMSG(0) "Error while importing DLL \"%s\":\n%s\n", dll, dlerror() EEND; } return instance; } static void* local getDLLSymbol(instance,symbol) /* lookup dll symbol */ void* instance; String symbol; { void *sym; if ((sym = dlsym(instance,symbol)) == 0) { ERRMSG(0) "Error loading sym:\n%s\n", dlerror() EEND; } return sym; } void freeDLL (dll) /* free up DLL */ void* dll; { if (dll) { /* No error checking done. */ dlclose(dll); } return; } #elif HAVE_DL_H /* eg HPUX */ #include static void* local getDLL(dll) /* load dll */ String dll; { shl_t instance = shl_load(dll,BIND_IMMEDIATE,0L); if (NULL == instance) { ERRMSG(0) "Error while importing DLL \"%s\"", dll EEND; } /* Assuming that shl_t can be converted into a void* with loss of information here... is this OK? */ return instance; } static void* local getDLLSymbol(dll,symbol) /* lookup dll symbol */ void* dll; String symbol; { void* r; return (0 == shl_findsym(&(shl_t)dll,symbol,TYPE_PROCEDURE,&r)) ? r : 0; } Void freeDLL(dll) void* dll; { if (dll) { shl_unload((shl_t)dll); } return; } #elif HAVE_WINDOWS_H && !defined(__MSDOS__) static void* local getDLL(dll) /* load dll */ String dll; { HINSTANCE instance = LoadLibrary(dll); if (NULL == instance) { /* GetLastError allegedly provides more detail - in practice, * it tells you nothing more. */ ERRMSG(0) "Error while importing DLL \"%s\"", dll EEND; } /* fprintf(stderr, "Loaded DLL 0x%p\n",instance); fflush(stderr); */ return instance; } static void* local getDLLSymbol(instance,symbol) /* lookup dll symbol */ void* instance; String symbol; { return (void*)GetProcAddress((HINSTANCE)instance,symbol); } Void freeDLL(dll) void* dll; { if (dll) { /* fprintf(stderr, "Freeing DLL 0x%p\n",dll); fflush(stderr); */ FreeLibrary(dll); } return; } #elif HAVE_MACH_O_DYLD_H /* MacOS X */ /*****************************************************************************/ #include #include /* static char* dl_last_error = ( char* ) 0; */ static int dlerror_index = 1; static char* dlerror( ) { static char* OFIErrorStrings[] = { "Object Image Load Failure\n", "Object Image Load Success\n", "Not an recognisable object file\n", "No valid architecture\n", "Object image has an invalid format\n", "Invalid access (permissions?)\n", "Unknown error code from NSCreateObjectFileImageFromFile\n", }; #define NUM_OFI_ERRORS ( sizeof( OFIErrorStrings ) /\ sizeof( OFIErrorStrings[ 0 ] ) ) if( dlerror_index > NUM_OFI_ERRORS - 1 ) dlerror_index = NUM_OFI_ERRORS - 1; return OFIErrorStrings[ dlerror_index ]; } int dlclose( void* handle ) { NSUnLinkModule( handle, FALSE ); return 0; } static void* dlopen( char* path, int mode /* mode is ignored */ ) { int dyld_result; NSObjectFileImage ofile; NSModule handle = NULL; dyld_result = NSCreateObjectFileImageFromFile( path, &ofile ); if( dyld_result != NSObjectFileImageSuccess ) dlerror_index = dyld_result; else { handle = NSLinkModule( ofile, path, NSLINKMODULE_OPTION_PRIVATE ); } return handle; } void* dlsym( void* handle, char* symbol ) { void* addr; NSSymbol s = NSLookupSymbolInModule( (NSModule)handle, symbol ); if( s ) { addr = NSAddressOfSymbol(s); } else { addr = NULL; } return addr; } /*****************************************************************************/ static void* local getDLL(dll) /* load dll */ String dll; { void *instance = dlopen(dll,1); if (NULL == instance) { ERRMSG(0) "Error while importing DLL \"%s\":\n%s\n", dll, dlerror() EEND; } return instance; } static void* local getDLLSymbol(instance,symbol) /* lookup dll symbol */ void* instance; String symbol; { void *sym; if (sym = dlsym(instance,symbol)) return sym; ERRMSG(0) "Error loading sym: %s\n", symbol EEND; } Void freeDLL(dll) void* dll; { if (dll) { dlclose(dll); } return; } #else /* Dynamic loading not available */ static void* local getDLL(dll) /* load dll */ String dll; { #if 1 /* very little to choose between these options */ return 0; #else ERRMSG(0) "This Hugs build does not support plugins\n" EEND; #endif } static void* local getDLLSymbol(dll,symbol) /* load dll and lookup symbol */ void* dll; String symbol; { #if 1 /* very little to choose between these options */ return 0; #else ERRMSG(0) "This Hugs build does not support plugins\n" EEND; #endif } Void freeDLL(dll) void* dll; { } #endif /* Dynamic loading not available */ static void* local getModDLL(file) /* load DLL for module */ String file; { #if HAVE_REALPATH && !HAVE__FULLPATH char dllPath[MAXPATHLEN+1]; #else char dllPath[FILENAME_MAX+1]; #endif String dot; String s; for (s = file; *s && !isSLASH(*s); s++) ; if (*s) strcpy(dllPath, file); /* pathname for module */ else /* if in this directory, prefix ./ so search won't use the path */ sprintf(dllPath, ".%c%s", SLASH, file); dot = strrchr(dllPath,'.'); /* patch file extension */ if (dot == NULL || dot == file) { dot = dllPath + strlen(dllPath); } strcpy(dot,DLL_ENDING); return getDLL(dllPath); } String mkFFIFilename2(file) String file; { #if HAVE_REALPATH && !HAVE__FULLPATH static char path[MAXPATHLEN+1]; #else static char path[FILENAME_MAX+1]; #endif String dot = strrchr(file,'.'); /* patch file extension */ if (isNull(dot)) dot = file + strlen(file); strcpy(path, file); strcpy(path + (dot - file),DLL_ENDING); return path; } String mkFFIFilename(file) /* get DLL path for module */ String file; { #if HAVE_REALPATH && !HAVE__FULLPATH static char path[MAXPATHLEN+1]; #else static char path[FILENAME_MAX+1]; #endif String dot = strrchr(file,'.'); /* patch file extension */ if (isNull(dot)) dot = file + strlen(file); strcpy(path, file); strcpy(path + (dot - file),".c"); return path; } #if LEADING_UNDERSCORE # define INIT_MODULE_FUN "_initModule" # define API_VERSION_FUN "_HugsAPIVersion" #else # define INIT_MODULE_FUN "initModule" # define API_VERSION_FUN "HugsAPIVersion" #endif Void needPrims(version,dll) /* Load dll containing prims for current module */ Int version; void* dll; { if (havePlugin(textToStr(module(currentModule).text))) { return; } /* Version 2-5: the Haskell module specifies what module to expect * (via a needPrims_hugs decl). * * Version 0: the extension DLL specifies the API version it assumes. */ switch (version) { case 2 : case 3 : case 4 : { InitModuleFun4 initModule; if (!dll) dll = getModDLL(scriptFile); initModule = (InitModuleFun4)getDLLSymbol(dll,INIT_MODULE_FUN); if (initModule) { Bool flg = setOldDLLFlag(TRUE); (*initModule)(hugsAPI4()); setScriptPrims(setPrimInfoDll(dll)); setOldDLLFlag(flg); return; } break; } case 5 : { InitModuleFun5 initModule; if (!dll) dll = getModDLL(scriptFile); initModule = (InitModuleFun5)getDLLSymbol(dll,INIT_MODULE_FUN); if (initModule) { Bool flg = setOldDLLFlag(FALSE); (*initModule)(hugsAPI5()); setScriptPrims(setPrimInfoDll(dll)); setOldDLLFlag(flg); return; } break; } case 0 : { APIVersionFun versionFun; Int version = 5; dll = getModDLL(scriptFile); versionFun = (APIVersionFun)getDLLSymbol(dll,API_VERSION_FUN); if (versionFun) { version = (*versionFun)(); } needPrims(version, dll); return; } default: { ERRMSG(0) "This version of Hugs does not support FFI version %d\n", version EEND; } } ERRMSG(0) "Unable to load FFI primitives\n" EEND; } /* -------------------------------------------------------------------------- * Compile and link an ffi file which can be dynamically loaded using * the above mechanisms. * ------------------------------------------------------------------------*/ #define BUFSIZE 1000 static char buffer[BUFSIZE]; static Int used = 0; static Void local insert Args((String)); static Void local insertPath Args((String)); static Void local insertChar Args((Char)); static Void local insert(s) String s; { Int l = strlen(s); if (used + l + 1 >= BUFSIZE) { ERRMSG(0) "Unable to build compilation command" EEND; } strcpy(buffer+used,s); used += l; } /* Convert backslashes, because they can cause problems with system() */ static Void local insertPath(s) String s; { Int l = strlen(s); if (used + l + 1 >= BUFSIZE) { ERRMSG(0) "Unable to build compilation command" EEND; } while (*s) { buffer[used++] = *s == SLASH ? '/' : *s; s++; } } static Void local insertChar(c) Char c; { char s[2]; s[0] = c; s[1] = '\0'; insert(s); } #undef BUFSIZE Void compileAndLink(fn,flags) String fn; String flags; { char* i = fn; used = 0; #if defined(MKDLL_VISUAL_STUDIO) /* find the location of ffihugs.bat */ /* is in the same directory */ { char Buffer[MAX_PATH+1]; char Buffer2[MAX_PATH+1]; GetModuleFileName(GetModuleHandle(NULL), Buffer, MAX_PATH); strcpy(strrchr(Buffer, '.'), ".bat"); GetShortPathName(Buffer, Buffer2, MAX_PATH); insert(Buffer2); insert(MKDLL_CMD); } #elif defined(MKDLL_CMD) /* The compile and link command */ insert(MKDLL_CMD); #endif /* Identify ourselves */ insert(" -D__HUGS__"); /* the path to HsFFI.h */ insert(" \"-I"); insertPath(hugsdir()); insertChar('/'); insert("include\""); /* the output file */ insert(" -o \""); insert(mkFFIFilename2(i)); insert("\""); /* the file to compile */ insert(" \""); insert(mkFFIFilename(i)); insert("\""); /* compiler and linker flags specified on Hugs command line */ if (flags) { insert(" "); insert(flags); } #if 0 printf("Executing '%s'\n",buffer); #endif if (shellEsc(buffer,TRUE,TRUE) != 0) { ERRMSG(0) "Error while running compilation command '%s'", buffer EEND; } used = 0; } /* -------------------------------------------------------------------------- * Read/write values from/to the registry * ------------------------------------------------------------------------*/ #if USE_REGISTRY static Bool local createKey(hKey, regPath, phRootKey, samDesired) HKEY hKey; String regPath; PHKEY phRootKey; REGSAM samDesired; { DWORD dwDisp; return RegCreateKeyEx(hKey, regPath, 0, "", REG_OPTION_NON_VOLATILE, samDesired, NULL, phRootKey, &dwDisp) == ERROR_SUCCESS; } static Bool local queryValue(hKey, regPath, var, type, buf, bufSize) HKEY hKey; String regPath; String var; LPDWORD type; LPBYTE buf; DWORD bufSize; { HKEY hRootKey; if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) { return FALSE; } else { LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize); RegCloseKey(hRootKey); return (res == ERROR_SUCCESS); } } /* Specialised version of queryValue(), which doesn't require * you to guess the length of a REG_SZ value. Allocates a big * enough buffer (using malloc()) to hold the key's value, which * is then returned to the callee (along with the resp. to free the * buffer.) */ static Bool local queryString(hKey, regPath, var, pString) HKEY hKey; String regPath; String var; String* pString; { HKEY hRootKey; LONG rc; DWORD bufSize; DWORD valType = REG_SZ; Bool res = FALSE; if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) { return FALSE; } else { /* Determine the length of the entry */ rc = RegQueryValueEx(hRootKey, var, NULL, &valType, NULL, &bufSize); if (rc == ERROR_SUCCESS && valType == REG_SZ) { /* Got the length, now allocate the buffer and retrieve the string. */ if ((*pString = (String)malloc(sizeof(char) * (bufSize + 1))) != NULL) { rc = RegQueryValueEx(hRootKey, var, NULL, &valType, (LPBYTE)*pString, &bufSize); res = (rc == ERROR_SUCCESS); } } RegCloseKey(hRootKey); return (res); } } static Bool local setValue(hKey, regPath, var, type, buf, bufSize) HKEY hKey; String regPath; String var; DWORD type; LPBYTE buf; DWORD bufSize; { HKEY hRootKey; if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) { return FALSE; } else { LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize); RegCloseKey(hRootKey); return (res == ERROR_SUCCESS); } } String readRegString(HKEY key, String regPath, String var, String def) /* read String from registry */ { char* stringVal; if (queryString(key, regPath, var, &stringVal)) { /* The callee is responsible for freeing the returned string */ return (String)stringVal; } else { /* Create a *copy* of the default string, so that it can be freed without worry. */ if ((stringVal = malloc(sizeof(char) * (strlen(def) + 1))) == NULL) { return NULL; } else { strcpy(stringVal, def); return (String)stringVal; } } } Bool writeRegString(var,val) /* write String to registry */ String var; String val; { String realVal = ( (NULL == val) ? "" : val); return setValue(HKEY_CURRENT_USER, hugsRegRoot, var, REG_SZ, (LPBYTE)realVal, lstrlen(realVal)+1); } #if HUGS_FOR_WINDOWS Bool writeRegInt(var,val) /* write String to registry */ String var; Int val; { return setValue(HKEY_CURRENT_USER, hugsRegRoot, var, REG_DWORD, (LPBYTE)&val, sizeof(val)); } Int readRegInt(var, def) /* read Int from registry */ String var; Int def; { DWORD buf; DWORD type; if (queryValue(HKEY_CURRENT_USER, hugsRegRoot, var, &type, (LPBYTE)&buf, sizeof(buf)) && type == REG_DWORD) { return (Int)buf; } else if (queryValue(HKEY_LOCAL_MACHINE, hugsRegRoot, var, &type, (LPBYTE)&buf, sizeof(buf)) && type == REG_DWORD) { return (Int)buf; } else { return def; } } #endif /* concatenate together all strings from registry of the form regPath\\*\\var, * separated by PATHSEP. */ String readRegChildStrings(HKEY key, String regPath, String var, String def) { HKEY baseKey; ULONG ulResult; int done = 0; DWORD dwIndex = 0; char subKeyName[256]; DWORD subKeyLen; BOOL addedPath = FALSE; char* resPath = NULL; /* result path, returned to caller */ String component; FILETIME ft; /* just to satisfy RegEnumKeyEx() */ char sepString[2]; StringBuilder* builder = newStringBuilder(0); sepString[0] = PATHSEP; sepString[1] = '\0'; ulResult = RegOpenKeyEx(key, regPath, 0, KEY_READ, &baseKey); if (ulResult != ERROR_SUCCESS) { freeStringBuilder(builder); resPath = strCopy(def); return resPath; } appendString(builder, def); while (!done) { subKeyLen = sizeof(subKeyName); ulResult = RegEnumKeyEx(baseKey, dwIndex, subKeyName, &subKeyLen, NULL, NULL, NULL, &ft); if (ulResult == ERROR_SUCCESS) { /* read next component of path */ component = readRegString(baseKey, subKeyName, var, ""); if (addedPath) { appendString(builder,sepString); } addedPath = TRUE; appendString(builder,component); free(component); /* readRegString() dynamically allocated it, so let go. */ } else { if (ulResult == ERROR_NO_MORE_ITEMS) { done = 1; } } dwIndex++; } RegCloseKey(baseKey); resPath = strCopy(toString(builder)); freeStringBuilder(builder); return resPath; } #endif /* USE_REGISTRY */ /* -------------------------------------------------------------------------- * Platform initialisation * ------------------------------------------------------------------------*/ extern Bool initSystem Args((Void)); Bool local initSystem() { /* Called right away by main() */ #if __MWERKS__ && macintosh strcpy(macHugsDir,currentDir()); SIOUXSettings.autocloseonquit = true; SIOUXSettings.asktosaveonclose = false; SIOUXSettings.columns = 80; SIOUXSettings.rows = 40; SIOUXSettings.tabspaces = 8; SIOUXSettings.enabledraganddrop = true; SIOUXSetTitle("\pHugs 98"); #endif #if HAVE_LOCALE_H setlocale(LC_CTYPE, ""); #endif return TRUE; } /* -------------------------------------------------------------------------- * Machine dependent control: * ------------------------------------------------------------------------*/ Void machdep(what) /* Handle machine specific */ Int what; { /* initialisation etc.. */ switch (what) { case MARK : #if FLOATS_SUPPORTED #if BREAK_FLOATS mark(bfTemp); #endif mark(bdTemp); #endif break; case INSTALL : installHandlers(); break; case RESET : #if FLOATS_SUPPORTED #if BREAK_FLOATS bfTemp = NIL; #endif bdTemp = NIL; #endif case BREAK : case EXIT : normalTerminal(); #if HUGS_FOR_WINDOWS if (what==EXIT) WinHugsExit(); else SetCursor(LoadCursor(NULL,IDC_ARROW)); #endif break; } } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/machdep.h0000644006511100651110000000550510213332373015326 0ustar rossross/* -------------------------------------------------------------------------- * Machine dependent code * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * ------------------------------------------------------------------------*/ #ifndef __MACHDEP_H__ #define __MACHDEP_H__ #include "prelude.h" #if HAVE_TIME_H # include #endif #if USE_REGISTRY # if HAVE_WINDOWS_H #include # endif #endif /* -------------------------------------------------------------------------- * Find information about a file: * ------------------------------------------------------------------------*/ #if RISCOS typedef struct { unsigned hi, lo; } Time; #define timeChanged(now,thn) (now.hi!=thn.hi || now.lo!=thn.lo) #define timeSet(var,tm) var.hi = tm.hi; var.lo = tm.lo #else typedef time_t Time; #define timeChanged(now,thn) (now!=thn) #define timeSet(var,tm) var = tm #endif extern Void getFileInfo Args((String, Time *, Long *)); /* -------------------------------------------------------------------------- * Prototypes for registry reading * ------------------------------------------------------------------------*/ #if USE_REGISTRY #if HUGS_FOR_WINDOWS extern Int readRegInt Args((String,Int)); extern Bool writeRegInt Args((String,Int)); #endif extern String readRegString Args((HKEY, String, String, String)); extern Bool writeRegString Args((String,String)); extern String readRegChildStrings Args((HKEY, String, String, String)); #endif /* USE_REGISTRY */ /* -------------------------------------------------------------------------- * Search for script files on the HUGS path: * ------------------------------------------------------------------------*/ extern String RealPath Args((String)); extern String substPath Args((String,String)); extern String uniqPath Args((String)); #if !HUGS_SERVER extern Bool startEdit Args((Int,String)); #endif extern Int shellEsc Args((String,Bool,Bool)); extern Int getTerminalWidth Args((Void)); extern Void normalTerminal Args((Void)); extern Bool getEchoTerminal Args((Int)); extern Void setEchoTerminal Args((Int,Bool)); extern Bool getBuffTerminal Args((Int)); extern Void setBuffTerminal Args((Int,Bool)); extern Void gcStarted Args((Void)); extern Void gcScanning Args((Void)); extern Void gcRecovered Args((Int)); extern Void gcCStack Args((Void)); extern Void needPrims Args((Int,void*)); extern String fromEnv Args((String,String)); extern Bool initSystem Args((Void)); extern String dirname Args((String)); #endif /* __MACHDEP_H__ */ hugs98-plus-Sep2006/src/machine.c0000644006511100651110000015132210374400543015326 0ustar rossross/* -------------------------------------------------------------------------- * Graph reduction engine, code generation and execution * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: machine.c,v $ * $Revision: 1.26 $ * $Date: 2006/02/14 16:12:19 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "char.h" #include "opts.h" /* needed for DEBUG_CODE */ #include #if OBSERVATIONS Bool rootOpt = TRUE; /* TRUE => enable root optimisation*/ #endif #if DEBUG_CODE Bool debugCode = FALSE; /* TRUE => print G-code to screen */ #endif #if DEBUG_SHOWSC Bool debugSC = FALSE; /* TRUE => print SC-code to screen */ #endif Int evalDepth; /* depth of nested eval()'s */ /* -------------------------------------------------------------------------- * Data structures for machine memory (program storage): * ------------------------------------------------------------------------*/ /* This list defines the sequence of all instructions that can be used in * the abstract machine code for Hugs. The Ins() macro is used to * ensure that the correct mapping of instructions to labels is used when * compiling the GCC_THREADED version. */ #define INSTRLIST Ins(iLOAD), Ins(iCELL), Ins(iCHAR), \ Ins(iINT), Ins(iDOUBLE), Ins(iSTRING), \ Ins(iMKAP), Ins(iUPDATE), Ins(iUPDAP), \ Ins(iEVAL), Ins(iRETURN), Ins(iTEST), \ Ins(iGOTO), Ins(iSETSTK), Ins(iROOT), \ Ins(iSLIDE), Ins(iSTAP), Ins(iTABLE), \ Ins(iLEVAL), Ins(iRUPDAP), Ins(iRUPDATE), \ Ins(iFAIL), Ins(iALLOC) #define Ins(x) x typedef enum { INSTRLIST } Instr; #undef Ins typedef Int Label; typedef union { Int mint; #if !BREAK_FLOATS Float mfloat; #endif Cell cell; Text text; Addr addr; Instr instr; Label lab; } MemCell; typedef MemCell far *Memory; static Memory memory; #if !WANT_FIXED_SIZE_TABLES /* (Dynamically) growable memory. */ DynTable* dynMemory = NULL; #endif #if !WANT_FIXED_SIZE_TABLES void growMemory(void) { growDynTable(dynMemory); memory = (Memory)(dynMemory->data); if (memory==0) fatal("Cannot allocate program memory"); } #endif #define intAt(m) memory[m].mint #if !BREAK_FLOATS #define floatAt(m) memory[m].mfloat #endif #define cellAt(m) memory[m].cell #define textAt(m) memory[m].text #define setAddrAt(m,a) memory[m].addr = ((a)-(m)) #define addrAt(m) (memory[m].addr+(m)) #define instrAt(m) memory[m].instr #define labAt(m) memory[m].lab #if BYTECODE_PRIMS Int IntAt(m) Addr m; { return intAt(m); } Float FloatAt(m) Addr m; { #if BREAK_FLOATS return floatFromParts(cellAt(m),cellAt(m+1)); #else return floatAt(m); #endif } Double DoubleAt(m) Addr m; { return doubleFromParts(cellAt(m),cellAt(m+1)); } Cell CellAt(m) Addr m; { return cellAt(m); } Text TextAt(m) Addr m; { return textAt(m); } Addr AddrAt(m) Addr m; { return addrAt(m); } Int InstrAt(m) Addr m; { return instrAt(m); } #endif /* BYTECODE_PRIMS */ /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Void local instrNone Args((Instr)); static Void local instrInt Args((Instr,Int)); static Void local instrDouble Args((Instr,DoublePro)); static Void local instrCell Args((Instr,Cell)); static Void local instrText Args((Instr,Text)); static Void local instrLab Args((Instr,Label)); static Void local instrCellLab Args((Instr,Cell,Label)); static Void local asSTART Args((Void)); static Label local newLabel Args((Label)); static Void local asEND Args((Void)); static Void local asEVAL Args((Void)); static Void local asTEST Args((Cell,Label)); static Void local asSLIDE Args((Int)); static Void local asMKAP Args((Int)); static Void local asUPDATE Args((Int)); static Void local asRUPDATE Args((Void)); static Void local asGOTO Args((Label)); #if DEBUG_CODE static Void local dissassemble Args((Addr,Addr)); static Addr local dissInstr Args((Addr)); static Void local printCell Args((Cell)); static Addr local dissNone Args((Addr,String)); static Addr local dissInt Args((Addr,String)); static Addr local dissDouble Args((Addr,String)); static Addr local dissCell Args((Addr,String)); static Addr local dissText Args((Addr,String)); static Addr local dissAddr Args((Addr,String)); static Addr local dissCellAddr Args((Addr,String)); #endif static Void local build Args((Cell,Int)); static Void local buildGuards Args((List,Int)); static Int local buildLoc Args((List,Int)); #if BIGNUMS static Void local buildBignum Args((Bignum)); #endif #if TREX static Void local buildName Args((Cell)); #endif static Void local make Args((Cell,Int,Label,Label)); static Void local makeCond Args((Cell,Cell,Cell,Int,Label,Label)); static Void local makeNumcase Args((Triple,Int,Label,Label)); #if TREX static Void local makeExtcase Args((Triple,Int,Label,Label)); #endif static Void local testGuard Args((Pair,Int,Label,Label,Label)); static Void local testCase Args((Pair,Int,Label,Label,Label)); static Void local analyseAp Args((Cell)); #if TREX static Int local fastBuildRec Args((Cell,Int)); #endif static Void local buildAp Args((Cell,Int,Label,Bool)); static Void local evalString Args((Cell)); /* -------------------------------------------------------------------------- * Assembler: (Low level, instruction code storage) * ------------------------------------------------------------------------*/ static Addr startInstr; /* first instruction after START */ static Addr lastInstr; /* last instr written (for peephole*/ /* optimisations etc.) */ static Bool newBasicBlock; /* lastInstr ends a basic block */ /* (so no peeping at lastInstr) */ static Addr noMatch; /* address of a single FAIL instr */ static Int srsp; /* simulated runtime stack pointer */ static Int offsPosn[NUM_OFFSETS]; /* mapping from logical to physical*/ /* offset positions */ static Void local instrNone(opc) /* Opcode with no operands */ Instr opc; { lastInstr = getMem(1); instrAt(lastInstr) = opc; newBasicBlock = FALSE; } static Void local instrInt(opc,n) /* Opcode with integer operand */ Instr opc; Int n; { lastInstr = getMem(2); instrAt(lastInstr) = opc; intAt(lastInstr+1) = n; newBasicBlock = FALSE; } static Void local instrDouble(opc,fl) /* Opcode with Double operand */ Instr opc; DoublePro fl; { lastInstr = getMem(3); instrAt(lastInstr) = opc; cellAt(lastInstr+1) = part1Double(fl); cellAt(lastInstr+2) = part2Double(fl); newBasicBlock = FALSE; } static Void local instrCell(opc,c) /* Opcode with Cell operand */ Instr opc; Cell c; { lastInstr = getMem(2); instrAt(lastInstr) = opc; cellAt(lastInstr+1) = c; newBasicBlock = FALSE; } static Void local instrText(opc,t) /* Opcode with Text operand */ Instr opc; Text t; { lastInstr = getMem(2); instrAt(lastInstr) = opc; textAt(lastInstr+1) = t; newBasicBlock = FALSE; } static Void local instrLab(opc,l) /* Opcode with label operand */ Instr opc; Label l; { lastInstr = getMem(2); instrAt(lastInstr) = opc; labAt(lastInstr+1) = l; if (l<0) internal("bad Label"); newBasicBlock = FALSE; } static Void local instrCellLab(opc,c,l) /* Opcode with cell, label operands*/ Instr opc; Cell c; Label l; { lastInstr = getMem(3); instrAt(lastInstr) = opc; cellAt(lastInstr+1) = c; labAt(lastInstr+2) = l; if (l<0) internal("bad Label"); newBasicBlock = FALSE; } /* -------------------------------------------------------------------------- * Main low level assembler control: (includes label assignment and fixup) * * Labels are used as a simple form of continuation during the code gen: * RUNON => produce code which does not make jump at end of construction * UPDRET => produce code which performs RUPDATE at end * VALRET => produce code which performs RETURN at end * other(d) => produce code which branches to label d at end * ------------------------------------------------------------------------*/ static Label nextLab; /* next label number to allocate */ #define SHOULDNTFAIL (-1) #define RUNON (-2) #define UPDRET (-3) #define VALRET (-4) static Addr fixups[NUM_FIXUPS]; /* fixup table maps Label -> Addr*/ #define atLabel(n) (newBasicBlock = TRUE, fixups[n] = getMem(0)) #define endLabel(d,l) if (d==RUNON) atLabel(l) #define fix(a) setAddrAt(a,fixups[labAt(a)]) static Addr lengthAddr; static Void local asSTART() { /* initialise assembler */ fixups[0] = noMatch; nextLab = 1; lengthAddr = getMem(1); startInstr = getMem(0); lastInstr = startInstr-1; newBasicBlock = TRUE; srsp = 0; offsPosn[0] = 0; } static Label local newLabel(d) /* allocate new label */ Label d; { if (d==RUNON) { if (nextLab>=NUM_FIXUPS) { ERRMSG(0) "Compiled code too complex" EEND; } return nextLab++; } return d; } static Void local asEND() { /* Fix addresses in assembled code */ Addr pc = startInstr; intAt(lengthAddr) = lastInstr - startInstr + 1; while (pc<=lastInstr) switch (instrAt(pc)) { case iEVAL : /* opcodes taking no arguments */ case iFAIL : case iSTAP : case iRUPDATE: case iRUPDAP : case iRETURN : pc++; break; case iGOTO : fix(pc+1); /* opcodes taking one argument */ case iSETSTK : case iALLOC : case iSLIDE : case iROOT : case iLOAD : case iLEVAL : case iCELL : case iCHAR : case iINT : case iSTRING : case iMKAP : case iUPDATE : case iUPDAP : pc+=2; break; case iDOUBLE : pc+=3; break; case iTEST : fix(pc+2); pc+=3; break; default : internal("fixAddrs"); } } /* -------------------------------------------------------------------------- * Assembler Opcodes: (includes simple peephole optimisations) * ------------------------------------------------------------------------*/ #define asINTEGER(n) instrInt(iINT,n); srsp++ #define asDOUBLE(fl) instrDouble(iDOUBLE,fl); srsp++ #define asSTRING(t) instrText(iSTRING,t); srsp++ #define asCHAR(n) instrInt(iCHAR,n); srsp++ #define asLOAD(n) instrInt(iLOAD,n); srsp++ #define asALLOC(n) instrInt(iALLOC,n); srsp+=n #define asROOT(n) instrInt(iROOT,n); srsp++ #define asSETSTK(n) instrInt(iSETSTK,n); srsp=n #define asSTAP() instrNone(iSTAP); srsp-- #define asRETURN() instrNone(iRETURN) #define asCELL(c) instrCell(iCELL,c); srsp++ #define asFAIL() instrNone(iFAIL) /* Peephole optimisations are unsafe if we're at the start of a new 'basic block' (newBasicBlock is TRUE) -- e.g., f a b = if (if a then True else b) then foo else bar After having emitted the code for the conditional, we want to evaluate it, BUT we better _not_ look at the last instruction of the code comprising the conditional expression and decide whether or not to peephole the EVAL into an LEVAL. */ static Void local asEVAL() { /* load and eval stack element */ if (!newBasicBlock && instrAt(lastInstr)==iLOAD) /* Peephole optimisation: */ instrAt(lastInstr) = iLEVAL; /* LOAD n; EVAL ===> LEVAL n */ else instrNone(iEVAL); srsp--; } static Void local asTEST(c,l) /* test whnf and branch on mismatch*/ Cell c; Label l; { switch (whatIs(c)) { case TUPLE : return; /* typing guarantees that tags will*/ /* match without further tests */ case NAME : if (isCfun(c) && cfunOf(c)==0) return; } instrCellLab(iTEST,c,l); } static Void local asSLIDE(n) /* Slide results down stack */ Int n; { if (!newBasicBlock && instrAt(lastInstr)==iSLIDE) /* Peephole optimisation: */ intAt(lastInstr+1)+=n; /* SLIDE n;SLIDE m ===> SLIDE (n+m)*/ else instrInt(iSLIDE,n); srsp -= n; } static Void local asMKAP(n) /* Make application nodes ... */ Int n; { if (!newBasicBlock && instrAt(lastInstr)==iMKAP) /* Peephole optimisation: */ intAt(lastInstr+1)+=n; /* MKAP n; MKAP m ===> MKAP (n+m) */ else instrInt(iMKAP,n); srsp -= n; } static Void local asUPDATE(n) /* Update node ... */ Int n; { if (!newBasicBlock && instrAt(lastInstr)==iMKAP) { Int m = intAt(lastInstr+1); /* Peephole optimisations: */ nextInstr(lastInstr); if (m==1) /* MKAP 1; UPDATE p ===> UPDAP p */ instrInt(iUPDAP,n); else { /* MKAP m; UPDATE p */ instrInt(iMKAP,m-1); /* ===> MKAP (m-1); UPDAP p */ instrInt(iUPDAP,n); } } else instrInt(iUPDATE,n); srsp--; } static Void local asRUPDATE() { /* Update node and return ... */ if (!newBasicBlock && instrAt(lastInstr)==iMKAP) { Int m = intAt(lastInstr+1); /* Peephole optimisations: */ nextInstr(lastInstr); if (m==1) /* MKAP 1; RUPDATE ===> RUPDAP */ instrNone(iRUPDAP); else { /* MKAP m; RUPDATE */ instrInt(iMKAP,m-1); /* ===> MKAP (m-1); RUPDAP */ instrNone(iRUPDAP); } } else instrNone(iRUPDATE); } static Void local asGOTO(l) /* End evaluation of expr in manner*/ Label l; { /* indicated by label l */ switch (l) { /* inaccurate srsp */ case UPDRET : asRUPDATE(); break; case VALRET : asRETURN(); case RUNON : break; default : instrLab(iGOTO,l); break; } } /* -------------------------------------------------------------------------- * Constructor function tables: * * Tables of constructor functions for enumerated types are needed to * produce derived instances. * ------------------------------------------------------------------------*/ Void addCfunTable(tc) /* Add a constructor fun table to */ Tycon tc; { /* constructors for tycon tc */ if (isTycon(tc) && tycon(tc).what==DATATYPE) { List cs = tycon(tc).defn; if (hasCfun(cs) && hasCfun(tl(cs)) && name(hd(cs)).code<=0) { Int l = length(cs); Addr a = getMem(2+l); instrAt(a) = iTABLE; intAt(a+1) = l; for (l=0; nonNull(cs); l++, cs=tl(cs)) { cellAt(a+l+2) = hd(cs); name(hd(cs)).code = a; } } } } Name succCfun(n) /* get next constructor in sequence*/ Name n; { /* or NIL, if none */ if (cfunOf(n)==0) return NIL; else { Int d = cfunOf(n)+1; Addr a = name(n).code; return (d>intAt(a+1)) ? NIL : cellAt(a+d+1); } } Name nextCfun(n1,n2) /* get next constructor in series */ Name n1, n2; { /* or NIL, if none */ if (cfunOf(n1)==0) /* For product constructors, the */ return n1; /* only possibility is n1 == n2 */ else { Int d = 2*cfunOf(n2) - cfunOf(n1); Addr a = name(n1).code; return (d<=0 || d>intAt(a+1)) ? NIL : cellAt(a+d+1); } } Name cfunByNum(n,i) /* get ith constructor (0<=i=0 && i if x then y else False */ makeCond(arg(fun(e)),arg(e),nameFalse,co,f,d); break; } else if (h==nameOr && argCount==2) { /* x || y ==> if x then True else y */ makeCond(arg(fun(e)),nameTrue,arg(e),co,f,d); break; } } buildAp(e,co,f,TRUE); asGOTO(d); break; #if TREX case NAME : buildName(e); asGOTO(d); break; case TUPLE : asCELL(e); asGOTO(d); break; #else case TUPLE : case NAME : asCELL(e); asGOTO(d); break; #endif #if BIGNUMS case ZERONUM : case POSNUM : case NEGNUM : buildBignum(e); asGOTO(d); break; #endif case INTCELL : asINTEGER(intOf(e)); asGOTO(d); break; case DOUBLECELL : asDOUBLE(doubleOf(e)); asGOTO(d); break; case STRCELL : asSTRING(textOf(e)); asGOTO(d); break; case CHARCELL : asCHAR(charOf(e)); asGOTO(d); break; case OFFSET : asLOAD(offsPosn[offsetOf(e)]); asGOTO(d); break; default : internal("make"); } } static Void local makeCond(i,t,e,co,f,d)/* Build code for conditional */ Cell i,t,e; Int co; Label f; Label d; { Label l1 = newLabel(RUNON); Label l2 = newLabel(d); Int savesp; make(i,co,f,RUNON); asEVAL(); savesp = srsp; asTEST(nameTrue,l1); make(t,co,f,l2); srsp = savesp; atLabel(l1); make(e,co,f,(d==RUNON?d:l2)); endLabel(d,l2); } static Void local makeNumcase(nc,co,f,d)/* Build code for numcase */ Triple nc; Int co; Label f, d; { Cell discr = snd3(nc); Cell h = getHead(discr); make(fst3(nc),co,SHOULDNTFAIL,RUNON); switch (whatIs(h)) { case NAME : if (h==nameFromInt) { asINTEGER(intOf(arg(discr))); make(arg(fun(discr)),co,SHOULDNTFAIL,RUNON); asCELL(namePmInt); } #if BIGNUMS else if (h==nameFromInteger) { buildBignum(arg(discr)); make(arg(fun(discr)),co,SHOULDNTFAIL,RUNON); asCELL(namePmInteger); } #else /* ToDo: should this be the same as fromInt? */ #endif else if (h==nameFromDouble) { asDOUBLE(doubleOf(arg(discr))); make(arg(fun(discr)),co,SHOULDNTFAIL,RUNON); asCELL(namePmFlt); } asMKAP(3); asEVAL(); asTEST(nameTrue,f); make(thd3(nc),co,f,d); break; #if NPLUSK case ADDPAT : asINTEGER(snd(h)); make(arg(discr),co,SHOULDNTFAIL,RUNON); asCELL(namePmNpk); asMKAP(3); asEVAL(); asTEST(nameJust,f); offsPosn[co+1] = ++srsp; make(thd3(nc),co+1,f,d); --srsp; break; #endif } } #if TREX static Void local makeExtcase(ec,co,f,d)/* Build code for extcase */ Triple ec; Int co; Label f, d; { make(ap(ap(nameRecBrk,arg(snd3(ec))),fst3(ec)),co,SHOULDNTFAIL,RUNON); asEVAL(); offsPosn[co+1] = ++srsp; offsPosn[co+2] = ++srsp; make(thd3(ec),co+2,f,d); } #endif static Void local testGuard(g,co,f,cf,d)/* Produce code for guard */ Pair g; Int co; Label f; Label cf; Label d; { if (fst(g)!=nameTrue) { make(fst(g),co,SHOULDNTFAIL,RUNON); asEVAL(); asTEST(nameTrue,cf); } make(snd(g),co,f,d); } static Void local testCase(c,co,f,cf,d) /* Produce code for guard */ Pair c; Int co; /* labels determine where to go if:*/ Label f; /* match succeeds, but rest fails */ Label cf; /* this match fails */ Label d; { Int n = discrArity(fst(c)); Int i; asTEST(fst(c),cf); for (i=1; i<=n; i++) offsPosn[co+i] = ++srsp; make(snd(c),co+n,f,d); } /* -------------------------------------------------------------------------- * We frequently encounter functions which call themselves recursively with * a number of initial arguments preserved: * e.g. (map f) [] = [] * (map f) (x:xs) = f x : (map f) xs * Lambda lifting, in particular, is likely to introduce such functions. * Rather than reconstructing a new instance of the recursive function and * its arguments, we can extract the relevant portion of the root of the * current redex. * * The following functions implement this optimisation. * ------------------------------------------------------------------------*/ static Int nonRoots; /* #args which can't get from root */ static Int rootPortion; /* portion of root used ... */ static Name definingName; /* name of func being defined,if any*/ static Int definingArity; /* arity of definingName */ static Void local analyseAp(e) /* Determine if any portion of an */ Cell e; { /* application can be built using a */ if (isAp(e)) { /* portion of the root */ analyseAp(fun(e)); if (nonRoots==0 && rootPortion>1 && isOffset(arg(e)) && offsetOf(arg(e))==rootPortion-1) rootPortion--; else nonRoots++; } else if (e==definingName) rootPortion = definingArity+1; else rootPortion = 0; } #if TREX static Int local fastBuildRec(e,co) /* Try to build record, returning */ Cell e; /* no of elements, or (-1) if not a*/ Int co; { /* simple record */ if (e==nameNoRec) { asCELL(NIL); return 0; } else if (isExt(getHead(e)) && argCount==3) { Int c = fastBuildRec(extRow(e),co); if (c>=0) { build(extField(e),co); asMKAP(1); return (c+1); } } return (-1); } #endif static Void local buildAp(e,co,f,str) /* Build application, making use of */ Cell e; /* root optimisation if poss. */ Int co; Label f; Bool str; { Int nr, rp, i; #if TREX if ((i=fastBuildRec(e,co))>=0) { /* Fast build for records whose */ asCELL(RECORD); /* structure is known at compile */ asMKAP(1); /* time ... but the savings are */ return; /* pretty small. */ } #endif #if OBSERVATIONS if (!rootOpt){ rp = 0; nr = 0; while (isAp(e)){ build(arg(e),co); e = fun(e); nr++; } } else { #endif nonRoots = 0; analyseAp(e); nr = nonRoots; rp = rootPortion; for (i=0; i0) { asMKAP(nr); } } /* -------------------------------------------------------------------------- * Code generator entry points: * ------------------------------------------------------------------------*/ Addr codeGen(n,arity,e) /* Generate code for expression e, */ Name n; /* treating return value of CAFs */ Int arity; /* differently to functs with args */ Cell e; { definingName = n; definingArity = arity; #if DEBUG_CODE if (debugCode) { Printf("------------------\n"); if (nonNull(n)) Printf("name=%s\n",textToStr(name(n).text)); Printf("Arity = %d\n",arity); Printf("codeGen = "); printExp(stdout,e); Putchar('\n'); } #endif asSTART(); if (nonNull(n)) { Int i; for (i=1; i<=arity; i++) offsPosn[i] = ++srsp; make(e,arity,noMatch,(arity>0 ? UPDRET : VALRET)); } else { build(e,0); asRETURN(); } asEND(); #if DEBUG_CODE if (debugCode) { if (nonNull(n)) Printf("name=%s\n",textToStr(name(n).text)); dissassemble(startInstr,lastInstr); Printf("------------------\n"); } #endif return startInstr; } Void implementCfun(c,scs) /* Build implementation for constr */ Name c; /* fun c. scs lists integers (1..)*/ List scs; { /* in incr order of strict comps. */ Int a = name(c).arity; if (a==0 || isNull(scs)) name(c).defn = c; /* Name ==> no special imp. */ else { Name n = newName(inventText(),c); Int i = 1; name(c).defn = pair(scs,n); /* (scs,n) => strict components */ name(n).arity = a; /* Initialize name data as approp. */ asSTART(); /* inaccurate srsp doesn't matter */ asCELL(c); for (; i<=a; i++) if (nonNull(scs) && intOf(hd(scs))==i) { asSTAP(); scs = tl(scs); } else asMKAP(1); asRUPDATE(); asEND(); name(n).code = startInstr; #if DEBUG_CODE if (debugCode) { Printf("Implement constructor "); printExp(stdout,c); Printf(" using "); printExp(stdout,n); Printf(" with code:\n"); dissassemble(startInstr,lastInstr); Printf("------------------\n"); } #endif } } #if TREX Name nameInsFld; /* Hooks to Trex library */ Name nameShowRecRow; /* static.c:trexLoad() binds them */ Name nameEqRecRow; Name implementRecShw(t,parent) /* Build implementation for record */ Text t; /* display function. */ Cell parent; { Name n = newName(inventText(),parent); name(n).arity = 0; name(n).number = DFUNNAME; asSTART(); asSTRING(t); asCELL(nameRecShw); asMKAP(1); asRETURN(); asEND(); name(n).code = startInstr; return n; } Name implementRecEq(t,parent) /* Build implementation for record */ Text t; /* compare function. */ Cell parent; { Name n = newName(inventText(),parent); name(n).arity = 0; name(n).number = DFUNNAME; asSTART(); asSTRING(t); asCELL(nameRecEq); asMKAP(1); asRETURN(); asEND(); name(n).code = startInstr; return n; } #endif /* -------------------------------------------------------------------------- * Evaluator: * ------------------------------------------------------------------------*/ Int whnfArgs; /* number of arguments of whnf term*/ Cell whnfHead; /* head cell of term in whnf */ Int whnfInt; /* value of INTCELL (in whnf) */ Float whnfFloat; /* value of FLOATCELL (in whnf) */ Double whnfDouble; /* value of DOUBLECELL (in whnf) */ Long numReductions; /* number of reductions counted */ #if PROFILING #define saveProducer(n) { Name old = producer; producer = n #define restoreProducer() producer = old; \ if ((numReductions%profInterval)==0) \ garbageCollect(); \ } #else #define saveProducer(n) /* nothing */ #define restoreProducer() /* nothing */ #endif static Cell exception; /* Exception thrown */ static jmp_buf *evalError = 0; /* jump buffer for eval errors */ #if GIMME_STACK_DUMPS Int rootsp = (-1); Cell evalRoots[NUM_STACK]; #endif #if OBSERVATIONS #define obsMarker(p) (whatIs(stack(p))==OBSERVESTK) #define isFree(n) (whatIs(n)==OBSERVE && whatIs(markedExpr(n))==FREECELL) Int appNum; Int obsCount=0; #endif Void eval(n) /* Graph reduction evaluator */ Cell n; { StackPtr base = sp; Int ar; STACK_CHECK if (++evalDepth == MAX_EVAL_DEPTH) hugsStackOverflow(); #if GIMME_STACK_DUMPS evalRoots[++rootsp] = n; /* Save pointer to root expression */ /* should probably test that rootsp*/ /* is in interval 0..NUM_STACK-1 */ #endif unw:switch (whatIs(n)) { /* unwind spine of application */ case AP : push(n); n = fun(n); goto unw; case INDIRECT : n = arg(n); allowBreak(); goto unw; #if OBSERVATIONS case OBSERVE : push(pair(OBSERVESTK,markedObs(n))); obsCount++; n = markedExpr(n); goto unw; #endif case NAME : allowBreak(); { #if DEBUG_CODE Name saveName = n; if (debugCode) { Printf("%*sEntering name(%d): %s\n", base, "", n - NAMEMIN, textToStr(name(n).text)); } #endif #if OBSERVATIONS if (!obsCount) { #endif if (!isCfun(n) && (ar=name(n).arity)<=(sp-base)) { if (ar>0) { /* fn with args*/ StackPtr root; push(NIL); /* rearrange */ root = sp; do { stack(root) = arg(stack(root-1)); --root; } while (--ar>0); saveProducer(n); #ifdef DOTNET if (name(n).foreignInfo != NIL) primInvoker(root,n); else #endif if (name(n).primDef) /* reduce */ (*name(n).primDef)(root); else run(name(n).code,root); numReductions++; restoreProducer(); sp = root; /* continue... */ n = pop(); } else { /* CAF */ if (isNull(name(n).defn)) {/* build CAF */ StackPtr root = sp; push(n); /* save CAF */ saveProducer(n); #ifdef DOTNET if (name(n).foreignInfo != NIL) primInvoker(root,n); else #endif if (name(n).primDef) (*name(n).primDef)(sp); else run(name(n).code,sp); numReductions++; restoreProducer(); name(n).defn = top(); sp = root; /* drop CAF */ } n = name(n).defn; /*already built*/ if (sp>base) fun(top()) = n; } #if DEBUG_CODE if (debugCode) { Printf("%*sLeaving name(%d): %s\n", base, "", saveName - NAMEMIN, textToStr(name(saveName).text)); } #endif goto unw; } #if OBSERVATIONS } else { /* handle reduction in presence of observations */ StackPtr p, dest; Int args; Cell newCell, arg, newHead; args = 0; /* count arguments */ for (p=sp; p>base; p--) if (!obsMarker(p)) args++; if (!isCfun(n) && (ar=name(n).arity)<=args) { if (ar>0) { /* fn with args*/ StackPtr root; StackPtr q; Int argNum, markers, i; Cell insCell; push(NIL); /* conv. AP to arg; count markers */ for (p=sp-1, args=0, markers=0; args=root+1; p--) if (obsMarker(p)) { /* set function return value cell */ /* new result list elem */ insCell = triple(NIL,mkInt(appId(appNum,0)),NIL); insertAfterObs(snd(stack(p)),insCell); seqObs(snd(stack(p))) = mkInt(0); snd(stack(p)) = insCell; for (q=p-1, argNum=1; q>=root+1; q--) if (!obsMarker(q)) { arg = triple(OBSERVE,stack(q), NIL); stack(q)=arg; newCell = triple(NIL, mkInt(-1), stack(q)); newHead = triple(OBSERVEHEAD,newCell,newCell); /* fix back pointers */ nextObs(newCell) = newHead; markedObs(arg) = newCell; /* reuse newCell as inderect obs. list item */ newCell = triple(NIL, mkInt(appId(appNum,argNum++)), newHead); insertAfterObs(insCell, newCell); insCell = newCell; } } /* reorganise stack (move markers) */ for (p=dest=sp; p>=root; p--) if (obsMarker(p)) push(stack(p)); else stack(dest--) = stack(p); for (i=1, p=root; i<=markers; i++) stack(p++) = pop(); root = p; } saveProducer(n); #ifdef DOTNET if (name(n).foreignInfo != NIL) primInvoker(root,n); else #endif if (name(n).primDef){ /* reduce */ (*name(n).primDef)(root); } else run(name(n).code,root); numReductions++; restoreProducer(); sp = root; /* continue... */ n = pop(); if (markers) { /* observe results */ for (p=root-1, i=1; i<=markers; i++){ exprObs(snd(stack(p--))) = n; } sp = sp - markers; obsCount -= markers; } } else { /* CAF */ if (isNull(name(n).defn) /* build CAF */ /* || isFree(name(n).defn) */){ StackPtr root = sp; push(n); /* save CAF */ saveProducer(n); #ifdef DOTNET if (name(n).foreignInfo != NIL) primInvoker(root,n); else #endif if (name(n).primDef) (*name(n).primDef)(sp); else run(name(n).code,sp); numReductions++; restoreProducer(); name(n).defn = top(); sp = root; /* drop CAF */ } n = name(n).defn; /*already built*/ /* move OBSERVESTK markers */ for (p=sp; p > base && obsMarker(p); p--) ; if (p > base) fun(stack(p)) = n; } #if DEBUG_CODE if (debugCode) { Printf("%*sLeaving name(%d): %s\n", base, "", saveName - NAMEMIN, textToStr(name(saveName).text)); } #endif goto unw; } } #endif } break; case INTCELL : whnfInt = intOf(n); break; case FLOATCELL : whnfFloat = (Float)floatOf(n); break; case DOUBLECELL : whnfDouble = (Double)doubleOf(n); break; case STRCELL : evalString(n); goto unw; } #if OBSERVATIONS /* remove observation markers due to non-fun observations */ if (obsCount){ StackPtr p, dest; for (p=dest=base+1; p<=sp; p++) if (!obsMarker(p)) stack(dest++) = stack(p); else{ obsCount--; } sp = dest - 1; } #endif whnfHead = n; /* rearrange components of term on */ whnfArgs = sp - base; /* stack, now in whnf ... */ for (ar=whnfArgs; ar>0; ar--) { fun(stack(base+ar)) = n; n = stack(base+ar); stack(base+ar) = arg(n); } #if GIMME_STACK_DUMPS rootsp--; #endif evalDepth--; } #if OBSERVATIONS Bool isWhnf(n) /* is graph expr in WHNF */ Cell n; { Int ar; Int args=0; unw:switch (whatIs(n)) { /* unwind spine of application */ case AP : args++; n = fun(n); goto unw; case INDIRECT : n = arg(n); goto unw; case OBSERVE : n = markedExpr(n); goto unw; case NAME : return isCfun(n) || (ar=name(n).arity) > args || ar == 0; case STRCELL : evalString(n); goto unw; } return TRUE; } Cell getCaf(n) Cell n; { while (whatIs(n) == INDIRECT) n = arg(n); if (whatIs(n) == NAME && !isCfun(n) && name(n).arity == 0) return n; else return 0; } #endif Void unwind(n) /* unwind spine of application; */ Cell n; { /* like eval except that we always */ whnfArgs = 0; /* treat the expression n as if it */ /* were already in whnf. */ unw:switch (whatIs(n)) { case AP : push(arg(n)); whnfArgs++; n = fun(n); goto unw; case INDIRECT : n = arg(n); allowBreak(); goto unw; case INTCELL : whnfInt = intOf(n); break; case FLOATCELL : whnfFloat = (Float)floatOf(n); break; case DOUBLECELL : whnfDouble = (Double)doubleOf(n); break; case STRCELL : evalString(n); goto unw; } whnfHead = n; } static Void local evalString(n) /* expand STRCELL at node n */ Cell n; { Text t = textOf(n); String s = textToStr(t); Char c; if (*s==0) { fst(n) = INDIRECT; snd(n) = nameNil; return; } c = getStrChr(&s); push(n); /* protect n during mkStr */ fst(n) = consChar(c); snd(n) = mkStr(t + (s-textToStr(t))); drop(); } Void run(start,root) /* execute code beginning at given */ Addr start; /* address with local stack starting*/ StackPtr root; { /* at given root offset */ register Memory pc = memory+start; #if !DEBUG_CODE && HAVE_LABELS_AS_VALUES #define Ins(x) &&l##x static void *labs[] = { INSTRLIST }; #undef Ins #define Case(x) l##x #define Continue goto *labs[(pc++)->instr] #define Dispatch Continue; #define EndDispatch #else #if DEBUG_CODE #define Dispatch for (;;) { \ if (debugCode) { \ Printf("%*s0x%04X: ", root, "", pc-memory); \ dissInstr(pc-memory); \ } \ switch((pc++)->instr) { #else #define Dispatch for (;;) { switch((pc++)->instr) { #endif #define Case(x) case x #define Continue continue #define EndDispatch default : internal("illegal instruction"); \ break; \ }} #endif Dispatch Case(iLOAD) : push(stack(root+pc->mint)); /* load from stack*/ pc++; Continue; Case(iCELL) : push(pc->cell); /* load const Cell*/ pc++; Continue; Case(iCHAR) : push(mkChar(pc->mint)); /* load char const*/ pc++; Continue; Case(iINT) : push(mkInt(pc->mint)); /* load int const */ pc++; Continue; Case(iDOUBLE) : push(mkDouble(doubleFromParts /* load dbl const */ (pc->cell,(pc+1)->cell))); pc+=2; Continue; Case(iSTRING) : push(mkStr(pc->text)); /* load str const */ pc++; Continue; Case(iMKAP) : { Int i = pc->mint; /* make AP nodes */ while (0mint); Cell r = pop(); while (isPair(r) && fst(r)==INDIRECT) r = snd(r); fst(t) = INDIRECT; snd(t) = r; } pc++; Continue; Case(iRUPDATE): { Cell t = stack(root); /* update and ret */ Cell r = top(); while (isPair(r) && fst(r)==INDIRECT) r = snd(r); fst(t) = INDIRECT; snd(t) = r; } return; Case(iUPDAP) : { Cell t = stack(root /* update AP node */ + pc->mint); fst(t) = pop(); snd(t) = pop(); } pc++; Continue; Case(iRUPDAP) : { Cell t = stack(root); /* updap and ret */ fst(t) = pop(); snd(t) = top(); } return; Case(iEVAL) : eval(pop()); /* evaluate top() */ Continue; Case(iLEVAL) : eval(stack(root+pc->mint)); /* eval from stack*/ pc++; Continue; Case(iSTAP) : eval(pushed(1)); /* strict apply */ sp -= whnfArgs; pushed(1) = ap(top(),pushed(1)); drop(); Continue; Case(iRETURN) : return; /* terminate */ Case(iTEST) : if (whnfHead==pc->cell) /* test for cell */ pc += 2; else pc += 1 + (pc+1)->addr; Continue; Case(iGOTO) : pc += pc->addr; /* goto label */ Continue; Case(iSETSTK) : sp = root + pc->mint; /* set stack ptr */ pc++; Continue; Case(iALLOC) : { Int i = pc->mint; /* alloc loc vars */ chkStack(i); while (0mint; Cell c; while ((c = fst(t))==INDIRECT || c==OBSERVE) { allowBreak(); t = c == INDIRECT ? arg(t) : markedExpr(t); } while (0mint; while (fst(t)==INDIRECT) { allowBreak(); t = arg(t); } while (0mint) = top(); /* remove loc vars*/ sp -= pc->mint; pc++; Continue; Case(iTABLE) : Case(iFAIL) : evalFails(root); /* cannot reduce */ return;/*NOT REACHED*/ EndDispatch #undef Dispatch #undef Case #undef Continue #undef EndDispatch } Cell evalWithNoError(e) /* Evaluate expression, returning */ Cell e; { /* NIL if successful, */ Cell caughtEx; /* Exception value if not... */ jmp_buf *oldCatch = evalError; #if JMPBUF_ARRAY jmp_buf catcherr[1]; evalError = catcherr; if (setjmp(catcherr[0])==0) { eval(e); caughtEx = NIL; } else caughtEx = exception; #else jmp_buf catcherr; evalError = &catcherr; if (setjmp(catcherr)==0) { eval(e); caughtEx = NIL; } else caughtEx = exception; #endif evalError = oldCatch; return caughtEx; } Void evalFails(root) /* Eval of current redex fails */ StackPtr root; { Cell errorRedex = stack(root); /* get error & bypass indirections */ while (isPair(errorRedex) && fst(errorRedex)==INDIRECT) errorRedex = snd(errorRedex); throwException(ap(namePatternMatchFail, ap(ap(ap(nameNPrint, mkInt(MIN_PREC)), errorRedex), nameNil))); } Void throwException(ex) Cell ex; { exception = ex; #if OBSERVATIONS obsCount=0; #endif if (evalError) longjmp(*evalError,1); else internal("uncaught exception"); } /* -------------------------------------------------------------------------- * Machine control: * ------------------------------------------------------------------------*/ Void machine(what) Int what; { switch (what) { case INSTALL : #if WANT_FIXED_SIZE_TABLES memory = (Memory)farCalloc(NUM_ADDRS,sizeof(MemCell)); #else /* prelude.h defines NUM_ADDRS; 0 is the upper bound (=> unbounded.) */ dynMemory = allocDynTable(sizeof(Memory), NUM_ADDRS, 0, "memory"); memory = (Memory)(dynMemory->data); #endif if (memory==0) fatal("Cannot allocate program memory"); instrNone(iFAIL); noMatch = lastInstr; break; case MARK : break; case RESET : evalError = 0; evalDepth = 0; #if GIMME_STACK_DUMPS rootsp = (-1); #endif break; #if OBSERVATIONS case BREAK : obsCount = 0; break; #endif case EXIT : #if WANT_FIXED_SIZE_TABLES free(memory); #else if (dynMemory) freeDynTable(dynMemory); #endif break; } } /* ------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/module.c0000644006511100651110000011242010332161004015171 0ustar rossross/* -------------------------------------------------------------------------- * Haskell 98 module system implementation for Hugs. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * -sof 2002. * * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "module.h" #include "output.h" /* -------------------------------------------------------------------------- * Static analysis of modules: * * The static checks of the import and export lists are invoked * via the entry points in module.h (cf. static.c:checkDefns()). * * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * local function prototypes: * ------------------------------------------------------------------------*/ static Name local lookupName Args((Text,List)); static Module local modOfEntity Args((Cell)); static Void local reportAmbigEntity Args((Text,Text,List)); static List local checkSubentities Args((List,List,List,String,Text)); static Void local checkExportDistinct Args((List,Bool,Cell)); static List local checkExportTycon Args((List,Text,Bool,Cell,Tycon)); static List local checkExportClass Args((List,Text,Bool,Cell,Class)); static List local checkExportModule Args((List,Text,Cell)); static List local checkExport Args((List,Text,Cell)); static List local checkImportEntity Args((List,Module,Bool,Cell)); static List local resolveImportList Args((Module,Cell,Bool)); static Cell local entityIsMember Args((Cell,List)); static List local augmentEntity Args((Bool,Cell,Cell,List)); static List local addEntity Args((Cell,Cell,List)); static List local addEntityPair Args((Cell,List)); static List local mergeImportLists Args((List,List)); static List local getIEOrphans Args((List)); static List local fixupIEList Args((List)); static List local allMethodsOrDCons Args((List,Cell,Module,Bool)); static Cell local importEntity Args((Module,Cell)); static Void local importTycon Args((Module,Tycon)); static Void local importClass Args((Module,Class)); static Void local browseName Args((Name)); static Void local browseEntity Args((Cell)); Void addQualImport(orig,new,entities) /* Add to qualified import list */ Cell orig; /* Original name of module */ Cell new; /* Name module is called within this module (or NIL) */ List entities; { /* List of entity names */ /* Record the entities imported */ module(currentModule).qualImports = addEntity(orig,entities,module(currentModule).qualImports); /* Record the module --> alias mapping */ module(currentModule).modAliases = cons(pair(isNull(new)?orig:new,orig), module(currentModule).modAliases); } Void addUnqualImport(mod,new,entities) /* An unqualified import */ Cell mod; /* Name of module */ Cell new; /* Local alias */ List entities; { /* List of entity names */ /* Add to unqualified import list */ unqualImports = addEntity(mod,entities,unqualImports); /* Record the module --> alias mapping */ module(currentModule).modAliases = cons(pair(isNull(new)?mod:new,mod), module(currentModule).modAliases); } static Name local lookupName(t,nms) /* find text t in list of Names */ Text t; List nms; { /* :: [Name] */ for(; nonNull(nms); nms=tl(nms)) { if ( t == name(hd(nms)).text ) { return hd(nms); } } return NIL; } static List local checkSubentities(imports,named,wanted,description,textParent) List imports; List named; /* :: [ Q?(Var|Con)(Id|Op) ] */ List wanted; /* :: [Name] */ String description; /* "| of |" */ Text textParent; { for(; nonNull(named); named=tl(named)) { Pair x = hd(named); /* ToDo: ignores qualifier; doesn't check that entity is in scope */ Text t = isPair(snd(x)) ? qtextOf(x) : textOf(x); Name n = lookupName(t,wanted); if (isNull(n)) { ERRMSG(0) "Entity \"%s\" is not a %s \"%s\"", textToStr(t), description, textToStr(textParent) EEND; } imports = cons(n,imports); } return imports; } #if 0 /* debugging code - dumping IE lists */ static Void showIEEntity Args((Cell)); static Void showIEList Args((List,char)); static Void showIEEntity(e) Cell e; { if (isName(e)) { fprintf(stderr, "%s", textToStr(name(e).text)); } else if (isClass(e)) { fprintf(stderr, "%s", textToStr(cclass(e).text)); } else if (isTycon(e)) { fprintf(stderr, "%s", textToStr(tycon(e).text)); } else if (isPair(e)) { showIEEntity(fst(e)); fprintf(stderr, "("); showIEList(snd(e),' '); fprintf(stderr, ")"); } else { fprintf(stderr, "showIEEntity: unknown entity kind %d\n", whatIs(e)); fflush(stderr); } } static Void showIEList(ieList,sep) List ieList; char sep; { List xs = ieList; for(;nonNull(xs);xs=tl(xs)) { showIEEntity(hd(xs)); if (tl(xs) != NIL) { fputc(sep, stderr); } } } #endif static List getIEOrphans(ieList) /* locate methods/dcons appearing on their */ List ieList; { /* own in an import/export list. */ List orphans = NIL; List xs; for(xs=ieList;nonNull(xs);xs=tl(xs)) { Cell e = hd(xs); if ( isName(e) ) { if (isClass(name(e).parent)) { /* a lone member */ orphans = cons(pair(name(e).parent, singleton(e)), orphans); } else if (isCfun(e)) { /* a lone data constructor (can only appear in a hiding list.) */ orphans = cons(pair(name(e).parent, singleton(e)), orphans); } else if (isSfun(e)) { /* a field name */ Cell p = name(e).parent; /* the data constructor */ Cell t = name(p).parent; /* the type constructor */ orphans = cons(pair(t,singleton(e)), orphans); } } } return orphans; } /* * fixupIEList() traverses an import/export list, adjusting * the list in the following ways: * * 1. 'orphan'/subordinate names are joined up with their * parents. An orphan E is either a class member, field * name or a data constructor (in 'hiding' lists *only*) * that's imported/exported without referring to its * parent P -- E appears in an import/export list rather * than P(E). If P is appearing elsewhere in the * import/export list, float E inside of P. * * ToDo: remove duplicates from the resulting list also; it's * harmless for there to be any, but may lead to confusion * later on. * */ static List fixupIEList(ieList) List ieList; { List orphans = NIL; List xs; orphans = getIEOrphans(ieList); if (nonNull(orphans)) { #if 0 /* Debugging - show the orphan list */ fprintf(stderr, "Orphan list{%s}:", textToStr(module(currentModule).text)); fflush(stderr); showIEList(orphans,'\n'); fflush(stderr); #endif /* Transformation 1 (we're actually being a bit sloppy here and not removing the orphan from the IE list if it can be floated inside its parent.) */ for(xs=orphans; nonNull(xs);xs=tl(xs)) { ieList = augmentEntity(FALSE,fst(hd(xs)),snd(hd(xs)),ieList); } } return ieList; } Void fixupImportExports (ls) List ls; { List xs; for(xs=ls;nonNull(xs);xs=tl(xs)) { if ( isPair(hd(xs)) && !fst(snd(hd(xs))) ) { snd(snd(hd(xs))) = fixupIEList(snd(snd(hd(xs)))); } } } static List local checkImportEntity(imports,exporter,isHidden,entity) List imports; /* Accumulated list of things to import */ Module exporter; Bool isHidden; Cell entity; { /* Entry from import/hiding list */ Bool impFound = FALSE; Bool isId = isIdent(entity); Cell subEntities = !isId ? snd(entity) : NIL; Text t = isId ? textOf(entity) : textOf(fst(entity)); List es = module(exporter).exports; Bool lookForVar = isVar(entity); /* In H98, a data con may be named in a 'hiding' list, so we * have to grovel around inside each tycon looking for it. */ Bool lookForDataCon = isHidden && subEntities == NONE && isCon(isId ? entity : fst(entity)); /* The use of NONE heralds a dcon */ subEntities = ( (subEntities == NONE) ? NIL : subEntities); for(; nonNull(es); es=tl(es)) { Cell e = hd(es); /* :: Entity | (Entity, NIL|DOTDOT|[Entity]) */ if (isPair(e)) { Cell f = fst(e); if (isTycon(f)) { if (tycon(f).text == t) { impFound = TRUE; if (!isId) { switch (tycon(f).what) { case NEWTYPE: case DATATYPE: if (DOTDOT == subEntities) { /* Want all dcons that are _exported_ by the importing module. */ Cell dcons; if (snd(e) == DOTDOT) { dcons = tycon(f).defn; } else { dcons = snd(e); } imports=addEntity(f,dcons,imports); } else if ( NIL == subEntities) { imports=addEntity(f,NIL,imports); } else { List xs = NIL; xs = checkSubentities(xs, subEntities, tycon(f).defn,"constructor of type",t); imports=addEntity(f,xs,imports); } break; case SYNONYM: case RESTRICTSYN: imports=addEntity(f,DOTDOT,imports); break; default:; /* deliberate fall thru */ } } else { imports = addEntity(f,NIL,imports); } if (!lookForDataCon) break; } /* check the data constructors or field labels for match */ if (tycon(f).what != SYNONYM && tycon(f).what != RESTRICTSYN && (lookForVar || lookForDataCon)) { /* The type's exported dcons/fields */ Cell dcons; if (snd(e) == DOTDOT) { dcons = tycon(f).defn; } else { dcons = snd(e); } while(nonNull(dcons)) { if (isName(hd(dcons)) && name(hd(dcons)).text == t) { impFound = TRUE; imports=addEntity(hd(dcons),NIL,imports); break; } dcons=tl(dcons); } } } else if (isClass(f)) { List sigs = NIL; /* Want all members that are _exported_ by the importing module. */ if (isPair(e)) { if (snd(e) == DOTDOT) { sigs = cclass(f).members; } else { sigs = snd(e); } } if (cclass(f).text == t) { impFound = TRUE; if (!isId) { if (DOTDOT == subEntities) { imports=addEntity(f,sigs,imports); return imports; } else if ( NIL == subEntities) { imports=addEntity(f,NIL,imports); } else { List xs = NIL; xs = checkSubentities(xs, subEntities, cclass(f).members,"member of class",t); imports=addEntity(f,xs,imports); } } break; } if (!impFound && isId) { List xs = sigs; while(nonNull(xs)) { if (isName(hd(xs)) && name(hd(xs)).text == t) { impFound = TRUE; imports=cons(hd(xs),imports); break; } xs=tl(xs); } } } else { internal("checkImportEntity2"); } } else if (isName(e)) { if (isId && name(e).text == t) { impFound = TRUE; imports=cons(e,imports); if (!lookForDataCon) break; } } else if (isTycon(e)) { if (isId && tycon(e).text == t) { impFound = TRUE; imports = addEntity(e,NIL,imports); if (!lookForDataCon) break; } } else { internal("checkImportEntity3"); } } if (!impFound) { ERRMSG(0) "Unknown entity \"%s\" %s from module \"%s\"", textToStr(t), ((!isHidden) ? "imported" : "hidden"), textToStr(module(exporter ).text) EEND; } return imports; } static List local resolveImportList(m,impList,isHidden) Module m; /* exporting module */ Cell impList; Bool isHidden; { List imports = NIL; if (DOTDOT == impList) { List es = module(m).exports; for(; nonNull(es); es=tl(es)) { Cell e = hd(es); if (isName(e)) { imports = cons(e,imports); } else { Cell c = fst(e); List subentities = NIL; if ( isClass(c) || (isTycon(c) && (tycon(c).what == DATATYPE || tycon(c).what == NEWTYPE)) ) { if (snd(e) != DOTDOT) { List ys = snd(e); Name sub; while (nonNull(ys)) { if (isPair(hd(ys))) { if (nonNull(sub = findQualName(hd(ys)))) { subentities = cons (sub,subentities); } } else { subentities = cons(hd(ys),subentities); } ys=tl(ys); } subentities = rev(subentities); } else { if (isClass(c)) { subentities = cclass(c).members; } else { subentities = tycon(c).defn; } } } imports = addEntity(c,subentities,imports); } } imports = rev(imports); } else { map2Accum(checkImportEntity,imports,m,isHidden,impList); } return imports; } Void checkQualImportList(importSpec) Pair importSpec; { /* checkQualImport() has verified that the module has already been loaded; * just locate the Module for it here & update the qualImports. */ Module m = findModid(fst(importSpec)); fst(importSpec) = m; checkImportList(TRUE,importSpec); } static List local addEntityPair(e,is) /* For pair (e,ls) add ls to the 'is' */ /* import/export list. */ Cell e; List is; { if (isPair(e)) { return addEntity(fst(e),snd(e), is); } else if (isName(e)) { if (isClass(name(e).parent)) { return addEntity(name(e).parent, singleton(e),is); } else if (isTycon(name(e).parent) && isCfun(e)) { return addEntity(name(e).parent, singleton(e),is); } else if (isSfun(e)) { /* a field name */ Cell p = name(e).parent; /* the data constructor */ Cell t = name(p).parent; /* the type constructor */ return addEntity(t, singleton(e), is); } } return addEntity(e,NIL,is); } static List local augmentEntity(addNew,e,ls,is) Bool addNew; /* For entity e, add 'ls' to the 'is' */ Cell e; /* import/export list,combining it with */ Cell ls; /* previous entries (if any.) */ List is; { Cell ms = entityIsMember(e,is); if (!ms) { if (!addNew) { return is; } else { if (isName(e) && (ls == NIL || ls == NONE)) { return cons(e,is); } else { return cons(pair(e,ls),is); } } } else { /* concat the two lists; remove duplicates. */ if (!isPair(hd(ms)) && ls != NIL) { hd(ms) = pair(e,ls); } else if (ls == NIL || ls == NONE || snd(hd(ms)) == DOTDOT) { ; } else if (ls == DOTDOT || snd(hd(ms)) == NIL || snd(hd(ms)) == NONE) { snd(hd(ms)) = ls; } else { snd(hd(ms)) = nubList(dupOnto(ls,snd(hd(ms)))); } return is; } } static List local addEntity(e,ls,is) Cell e; Cell ls; List is; { return augmentEntity(TRUE,e,ls,is); } static Cell local entityIsMember(x,xs) /* Test for membership of specific */ Cell x; /* entity x in import/export list xs */ List xs; { for (; nonNull(xs); xs=tl(xs)) { if (x == hd(xs)) return xs; if (isPair (hd(xs)) && x==fst(hd(xs))) return xs; } return NIL; } static List local mergeImportLists(ls1,ls2) List ls1; List ls2; { List xs; for (xs=ls1;nonNull(xs);xs=tl(xs)) { ls2 = addEntityPair(hd(xs),ls2); } return ls2; } Void checkImportList(isQual,importSpec) /*Import a module (un)qualified*/ Bool isQual; Pair importSpec; { Module m = fst(importSpec); Cell impList = snd(importSpec); List imports = NIL; /* entities we want to import */ List hidden = NIL; /* entities we want to hide */ List modImps = NIL; /* The effective import list */ List es = NIL; Bool isHidden = (isPair(impList) && HIDDEN == fst(impList)); if (!isQual && moduleThisScript(m)) { ERRMSG(0) "Module \"%s\" recursively imports itself", textToStr(module(m).text) EEND; } if ( isHidden ) { List orphans; /* Somewhat inefficient - but obviously correct: * imports = importsOf("module Foo") `setDifference` hidden; */ hidden = fixupIEList(resolveImportList(m, snd(impList),TRUE)); imports = resolveImportList(m, DOTDOT,FALSE); /* Get the lone method/field/dcons that appear in the hiding list. */ orphans = getIEOrphans(hidden); /* remove them from their parents in the import list. */ for (;nonNull(orphans);orphans=tl(orphans)) { /* the 'hd.snd' is the orphan entity, 'fst' is its parent. */ /* Locate and remove the sub-entity. */ Cell ls = entityIsMember(fst(hd(orphans)), imports); if (ls && isPair(hd(ls))) { snd(hd(ls)) = removeCell(hd(snd(hd(orphans))), dupList(snd(hd(ls)))); } } /* With the orphans in the 'hiding' list accounted for, * compute the effective import list by traversing over the * entire import list, checking whether any of the entities * do appear in the hiding list. */ for(; nonNull(imports); imports=tl(imports)) { Cell e = hd(imports); if (isPair(e)) { /* A tycon/class */ Cell tc = fst(e); Cell subs = snd(e); List ms = entityIsMember(tc,hidden); if (!ms) { /* not in the hiding list, add it to effective import list. */ if (isQual) { modImps = cons(pair(tc,subs),modImps); } else { modImps = cons(importEntity(m,e), modImps); } } else if isPair(hd(ms)) { /* The parent tycon/class is hidden, but perhaps not all of its subentities. */ Cell ent = fst(hd(ms)); List hiddenSubs = snd(hd(ms)); Module impMod; /* Figure out what module the entity was imported from */ if ( isClass(ent) ) { impMod = cclass(ent).mod; } else if ( isTycon(ent) ) { impMod = tycon(ent).mod; } else { internal("checkImportList"); } for(;nonNull(subs);subs=tl(subs)) { if (!entityIsMember(hd(subs),hiddenSubs)) { /* Register the sub-entity as imported */ if (!isQual) importName(impMod, hd(subs)); modImps = cons(hd(subs), modImps); } } } } else { if (!entityIsMember(e,hidden)) { if (isQual) { modImps = cons(pair(e,NIL),modImps); } else { modImps = cons(importEntity(m,e), modImps); } } } } } else { /* the more common case, no hidings. */ imports = resolveImportList(m, impList,FALSE); if (isQual) { modImps = imports; } else { for(; nonNull(imports); imports=tl(imports)) { modImps = addEntityPair(importEntity(m,hd(imports)), modImps); } } } /* To be able to handle re-exportation of modules, each module * keeps track of the effective import list of all its imports, * so that we later on can constrain re-exportation to only * contain what was imported. */ /* If there's more than one import decl for the same module, * combine the import lists. */ for(es=module(currentModule).modImports;nonNull(es);es=tl(es)) { if (isPair(hd(es)) && fst(hd(es)) == m) { fst(snd(hd(es))) = FALSE; /* => perform fixup at the end. */ snd(snd(hd(es))) = mergeImportLists(modImps, snd(snd(hd(es)))); break; } } if (isNull(es)) { /* Module not already present, add it. */ module(currentModule).modImports = cons(pair(m,pair(isHidden,modImps)),module(currentModule).modImports); } } static Cell local importEntity(source,e) Module source; Cell e; { Cell ent = e; Cell cs = NIL; /* If a pair, then the snd component gives the * constructors/methods that are specifically imported * with the tycon/class. */ if ( isPair(e) ) { ent = fst(e); cs = snd(e); } if (cs != NIL && cs != DOTDOT) { List xs; for (xs=cs;nonNull(xs);xs=tl(xs)) { importEntity(source,hd(xs)); } } switch (whatIs(ent)) { case VARIDCELL : case VAROPCELL : case CONIDCELL : case CONOPCELL : importName(source,snd(ent)); return e; case NAME : importName(source,ent); return e; case TYCON : importTycon(source,ent); return pair(ent,cs); case CLASS : importClass(source,ent); return pair(ent,cs); default: internal("importEntity"); return NIL; } } Void importName(source,n) Module source; Name n; { Name clash = addName(n); if (nonNull(clash) && clash!=n /* 'n' contains a name imported from another module's * export list. Due to module re-exportation, its 'home * module' (i.e., the module where 'n' was actually declared) * may not be equal to that of the module we're now importing * from here ('source'.) So, we've only got a name clash if * the home module of 'n' is different from that of 'clash'. */ && name(n).mod != name(clash).mod ) { name(clash).clashes = cons(n,name(clash).clashes); } } static Void local importTycon(source,tc) Module source; Tycon tc; { Tycon clash=addTycon(tc); Class cc; if (nonNull(clash) && clash!=tc /* See importName() comment. */ && tycon(tc).mod != tycon(clash).mod ) { tycon(clash).clashes = cons(tc,tycon(clash).clashes); } if ( nonNull(cc = findClass(tycon(tc).text)) ) { cclass(cc).clashes = cons(tc,cclass(cc).clashes); } } static Void local importClass(source,c) Module source; Class c; { Class clash=addClass(c); if (nonNull(clash) && clash!=c /* See importName() comment. */ && cclass(c).mod != cclass(clash).mod ) { /* Hmm..don't quite understand why we need to record the clash on both the class values here..*/ cclass(c).clashes = cons(clash,cclass(c).clashes); cclass(clash).clashes = cons(c,cclass(clash).clashes); } if (nonNull(findTycon(cclass(c).text))) { cclass(clash).clashes = cons(c,cclass(clash).clashes); } } static Module local modOfEntity(ent) /* get at the module of name/tycon/class */ Cell ent; { if (isName(ent)) { return name(ent).mod; } else if (isTycon(ent)) { return tycon(ent).mod; } else if (isClass(ent)) { return cclass(ent).mod; } return NIL; } static Void local reportAmbigEntity(mt,t,clashes) Text mt; Text t; List clashes; { if (nonNull(clashes)) { /* Unqualified name is ambiguous, report this. */ Module m1; ERRMSG(0) "Ambiguous export of entity \"%s\"", textToStr(t) ETHEN ERRTEXT "\n*** Could refer to: %s.%s ", textToStr(mt), textToStr(t) ETHEN for(;nonNull(clashes);clashes=tl(clashes)) { m1 = modOfEntity(hd(clashes)); if (m1) { ERRTEXT "%s.%s ", textToStr(module(m1).text), textToStr(t) ETHEN } } ERRTEXT "\n" EEND; } } /* verify that the entity is unique in unqualified form */ static Void local checkExportDistinct(exports,ambigCheck,ent) List exports; Bool ambigCheck; Cell ent; { Name clashNm; Tycon clashTc; Class clashCc; Module mod1,mod2; Text txt; Bool inConflict = FALSE; List clashes = NIL; if ( isName(ent) ) { clashes = name(ent).clashes; txt = name(ent).text; mod1 = name(ent).mod; if ( (clashNm = nameInIEList(ent,exports)) && (name(clashNm).mod != name(ent).mod) ) { mod2 = name(clashNm).mod; inConflict = TRUE; } } else if ( isTycon(ent) ) { clashes = tycon(ent).clashes; txt = tycon(ent).text; mod1 = tycon(ent).mod; if ( (clashTc = tyconInIEList(tycon(ent).text,exports)) && (tycon(clashTc).mod != tycon(ent).mod) ) { mod2 = tycon(clashTc).mod; inConflict = TRUE; } } else if ( isClass(ent) ) { clashes = cclass(ent).clashes; txt = cclass(ent).text; mod1 = cclass(ent).mod; if ( (clashCc = classInIEList(cclass(ent).text,exports)) && (cclass(clashCc).mod != cclass(ent).mod) ) { mod2 = cclass(clashCc).mod; inConflict = TRUE; } } else if (isPair(ent)) { List subs = NIL; checkExportDistinct(exports, ambigCheck, fst(ent)); if (snd(ent) == DOTDOT) { if (isTycon(fst(ent))) { if (tycon(fst(ent)).what == SYNONYM || tycon(fst(ent)).what == RESTRICTSYN) { subs = NIL; } else { subs = tycon(fst(ent)).defn; } } else if (isClass(fst(ent))) { subs = cclass(fst(ent)).members; } } else { subs = snd(ent); } map2Proc(checkExportDistinct,exports,ambigCheck,subs); return; } else { return; } if (inConflict) { ERRMSG(0) "Conflicting exports of entity \"%s\"", textToStr(txt) ETHEN ERRTEXT "\n*** Could refer to %s.%s or %s.%s", textToStr(module(mod1).text), textToStr(txt), textToStr(module(mod2).text), textToStr(txt) EEND; } if (ambigCheck && nonNull(clashes)) { reportAmbigEntity(module(mod1).text,txt,clashes); } } static List local checkExportTycon(exports,mt,viaModExport,spec,tc) List exports; Text mt; Bool viaModExport; Cell spec; Tycon tc; { checkExportDistinct(exports,!viaModExport,pair(tc,spec)); if (DOTDOT == spec || SYNONYM == tycon(tc).what) { return addEntity(tc,DOTDOT,exports); } else { return addEntity(tc,NIL,exports); } } static List local checkExportClass(exports,mt,viaModExport,spec,cl) List exports; Text mt; Bool viaModExport; Class cl; Cell spec; { checkExportDistinct(exports,!viaModExport,pair(cl,spec)); if (DOTDOT == spec) { return addEntity(cl,DOTDOT,exports); } else { return addEntity(cl,NIL,exports); } } static List local checkExportModule(exports,mt,e) List exports; Text mt; Cell e; { /* The name refers to the module alias; get at the modules it refers to */ Text alias = textOf(snd(e)); List mods = findQualifiers(alias); Module m; /* Re-exporting a module we didn't import isn't allowed. */ if (isNull(mods)) { ERRMSG(0) "Unknown module \"%s\" exported from module \"%s\"", textToStr(alias), textToStr(mt) EEND; } for (;nonNull(mods);mods=tl(mods)) { m = hd(mods); if (m == currentModule) { /* Exporting the current module exports all local definitions */ List xs; for(xs=module(m).classes; nonNull(xs); xs=tl(xs)) { if (cclass(hd(xs)).mod==m) exports = checkExportClass(exports,mt,TRUE,DOTDOT,hd(xs)); } for(xs=module(m).tycons; nonNull(xs); xs=tl(xs)) { if (tycon(hd(xs)).mod==m) exports = checkExportTycon(exports,mt,TRUE,DOTDOT,hd(xs)); } for(xs=module(m).names; nonNull(xs); xs=tl(xs)) { if (name(hd(xs)).mod==m && /* don't add dcons or class members */ (!isCfun(hd(xs)) && !isClass(name(hd(xs)).parent))) { checkExportDistinct(exports,FALSE,hd(xs)); exports = cons(hd(xs),exports); } } } else { /* Re-exporting a module alias M exports all unqualified * entities that have been imported into scope by modules * having that alias _and_ for which the qualified (by * the _alias_ M) entities are also visible. */ List xs = module(currentModule).modImports; List ents = NIL; for(;nonNull(xs);xs=tl(xs)) { if (isPair(hd(xs)) && fst(hd(xs)) == m) { ents = snd(snd(hd(xs))); break; } } if (isNull(xs)) { ents = module(m).exports; } for(;nonNull(ents);ents=tl(ents)) { Cell qid; Text txtNm; Cell ent = NIL; Name nm; Tycon tc; Class cc; /* Build the (alias) qualified entity and test whether it's in scope -- ugly. */ if (isName(hd(ents))) { txtNm = name(hd(ents)).text; qid = mkQId(alias,mkVar(txtNm)); } else if (isTycon(hd(ents))) { txtNm = tycon(hd(ents)).text; qid = mkQId(alias,mkCon(txtNm)); } else if (isClass(hd(ents))) { txtNm = cclass(hd(ents)).text; qid = mkQId(alias,mkCon(txtNm)); } else if (isQualIdent(hd(ents))) { txtNm = qtextOf(hd(ents)); qid = mkQId(alias,snd(snd(hd(ents)))); } else { /* ({tycon|class}, [entity]) */ if (isTycon(fst(hd(ents)))) { txtNm = tycon(fst(hd(ents))).text; qid = mkQId(alias,mkCon(txtNm)); } else if (isClass(fst(hd(ents)))) { txtNm = cclass(fst(hd(ents))).text; qid = mkQId(alias,mkCon(txtNm)); } else { internal("checkExportModule"); } } /* Decide whether an entity E is to be exported; * it needs to satisfy the following conditions: * * - it needs to be visible in unqualified form, * _unambiguously_. * - it is also available as A.E (where A is the * alias used in the module re-exportation element * in the export list.) * - the two names refer to the same (declared) name. */ if ( ( (ent = findName(txtNm)) && !isNull((nm = findQualName(qid))) && (nonNull((name(ent).clashes)) || name(ent).mod == name(nm).mod)) || ( (ent = findTycon(txtNm)) && !isNull((tc = findQualTycon(qid))) && (nonNull((tycon(ent).clashes)) || tycon(ent).mod == tycon(tc).mod)) || ( (ent = findClass(txtNm)) && !isNull((cc = findQualClass(qid))) && (nonNull((cclass(ent).clashes)) || cclass(ent).mod == cclass(cc).mod)) ) { checkExportDistinct(exports,FALSE,hd(ents)); exports=cons(hd(ents),exports); } } } } return exports; } static List local allMethodsOrDCons(imps,nm,mod,wantMethods) List imps; Cell nm; Module mod; Bool wantMethods; { /* For a non-local tycon / class exported using (..), locate * the list of dcons/methods that are in scope. * * This requires going through all the import lists, locating * the tycon/class and take the union of all the dcons/methods * found. */ List xs; List resList = NIL; for (xs = imps; nonNull(xs); xs=tl(xs)) { if ( isPair(hd(xs)) && isPair(snd(hd(xs))) ) { List ns; /* Find the entry for 'nm' tycon.. */ for (ns = snd(snd(hd(xs))); nonNull(ns); ns=tl(ns)) { if ( isPair(hd(ns)) && ((!wantMethods && isTycon(fst(hd(ns))) && fst(hd(ns)) == nm && tycon(fst(hd(ns))).mod == mod) || (wantMethods && isClass(fst(hd(ns))) && fst(hd(ns)) == nm && cclass(fst(hd(ns))).mod == mod)) ) { resList=dupOnto(snd(hd(ns)),resList); /* Assumption: tycon/class may appear more than once in an import list; */ } } } } if (nonNull(resList)) { resList = nubList(resList); } return resList; } static List local checkExport(exports,mt,e) /* Process entry in export list */ List exports; Text mt; Cell e; { if (isIdent(e)) { Name export; Bool expFound = FALSE; if (isQCon(e) && nonNull(export=findQualTycon(e))) { expFound = TRUE; exports = checkExportTycon(exports,mt,FALSE,NIL,export); } else if (isQCon(e) && nonNull(export=findQualClass(e))) { /* opaque class export */ expFound = TRUE; exports = checkExportClass(exports,mt,FALSE,NIL,export); } else if (nonNull(export=findQualName(e))) { /* Data constructors cannot appear in export lists, * so flag an error if they do. * * Notice that we have to be a bit careful when testing * for this, as both data constructors and type synonyms * have a tycon as parent. (In the case of type synonyms, * the parent is the type on the RHS.) * */ if ( isCfun(export) && !isPreludeScript() && currentModule != moduleUserPrelude) { /* Special case reqd for Prelude(s) to handle (:) */ ERRMSG(0) "Illegal export of a lone data constructor \"%s\"", textToStr(name(export).text) EEND; } expFound = TRUE; /* Re-use static analysis code to verify that * a qualified export isn't ambiguous. Unqualified * ones are better handled by checkExportDistinct(). */ if (isQualIdent(e)) { depExpr(1,e); } checkExportDistinct(exports,!isQualIdent(e),export); exports=cons(export,exports); } if (!expFound) { ERRMSG(0) "Unknown entity \"%s\" exported from module \"%s\"", identToStr(e), textToStr(mt) EEND; } return exports; } else if (MODULEENT == fst(e)) { return checkExportModule(exports,mt,e); } else { Cell ident = fst(e); /* class name or type name */ Cell parts = snd(e); /* members or constructors */ Cell nm; if (isQCon(ident) && nonNull(nm=findQualTycon(ident))) { switch (tycon(nm).what) { case SYNONYM: if (DOTDOT!=parts) { ERRMSG(0) "Explicit constructor list given for type synonym \"%s\" in export list of module \"%s\"", identToStr(ident), textToStr(mt) EEND; } exports = addEntity(nm,DOTDOT,exports); return exports; case RESTRICTSYN: ERRMSG(0) "Transparent export of restricted type synonym \"%s\" in export list of module \"%s\"", identToStr(ident), textToStr(mt) EEND; return exports; /* Not reached */ case NEWTYPE: case DATATYPE: if (DOTDOT==parts) { Module thisModule = lastModule(); if ( tycon(nm).mod == thisModule ) { exports = addEntity(nm,DOTDOT,exports); } else { exports = addEntity(nm, allMethodsOrDCons(module(thisModule).modImports, nm, tycon(nm).mod, FALSE), exports); } } else { List ps = NIL; ps = checkSubentities(ps,parts,tycon(nm).defn, "constructor of type", tycon(nm).text); exports = addEntity(nm,ps,exports); } return exports; default: internal("checkExport1"); } } else if (isQCon(ident) && nonNull(nm=findQualClass(ident))) { if (DOTDOT == parts) { Module thisModule = lastModule(); if ( cclass(nm).mod == thisModule ) { exports = addEntity(nm,DOTDOT,exports); } else { exports = addEntity(nm, allMethodsOrDCons(module(thisModule).modImports, nm, cclass(nm).mod, TRUE), exports); } } else { List ps = NIL; ps = checkSubentities(ps,parts,cclass(nm).members, "member of class",cclass(nm).text); exports=addEntity(nm,ps,exports); } return exports; } else { ERRMSG(0) "Explicit export list given for non-class/datatype \"%s\" in export list of module \"%s\"", identToStr(ident), textToStr(mt) EEND; } } return exports; /*NOTUSED*/ } List checkExports(exports) List exports; { Module m = lastModule(); Text mt = module(m).text; List es = NIL; /* [Entity | (Entity,DOTDOT|NIL|[Entity])] */ /* To properly handle methods and field names that are exported * separately from their class/type ('orphans'), we construct the effective * export list in two passes. First, we resolve and collect up * all the entities, be they orphans or not. Secondly, we fix up * this list, attempting to join up the each 'orphan' with its * parent, but only if that parent (class/tycon) is also exported. * i.e., just exporting a method _does not_ cause its class to * implicitly be added to the export list. * * This only applies to methods and field names; data constructors * cannot be exported on their own. */ map1Accum(checkExport,es,mt,exports); es = fixupIEList(es); #if DEBUG_MODULES for(xs=es; nonNull(xs); xs=tl(xs)) { Printf(" %s", textToStr(textOfEntity(hd(xs)))); } #endif return es; } /* -------------------------------------------------------------------------- * Browsing module exports * ------------------------------------------------------------------------*/ Void browseModule(mod,all) Module mod; Bool all; { /* include all names in scope in the module? */ List exports = resolveImportList(mod, DOTDOT, FALSE); Printf("module %s where\n",textToStr(module(mod).text)); if (all) { List all_names = dupList(module(mod).names); mapProc(browseName,rev(all_names)); } else { mapProc(browseEntity,exports); } } static Void local browseEntity(entity) Cell entity; { /* Entity | (Entity,[Entity]) */ if (isName(entity)) { browseName(entity); } else { /* (Entity,[Entity]) */ mapProc(browseName,snd(entity)); } } static Void local browseName(nm) Name nm; { /* unwanted artifacts, like lambda lifted values, are in the list of names, but have no types */ if (nonNull(name(nm).type)) { printExp(stdout,nm); Printf(" :: "); printType(stdout,name(nm).type); if (isCfun(nm)) { Printf(" -- data constructor"); } else if (isMfun(nm)) { Printf(" -- class member"); } else if (isSfun(nm)) { Printf(" -- selector function"); } if (name(nm).primDef) { Printf(" -- primitive"); } Printf("\n"); } } hugs98-plus-Sep2006/src/module.h0000644006511100651110000000175507743000207015217 0ustar rossross/* -------------------------------------------------------------------------- * Haskell 98 module system implementation for Hugs. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * -sof 2002. * * ------------------------------------------------------------------------*/ #ifndef __MODULE_H__ #define __MODULE_H__ extern Void addQualImport Args((Text,Text,List)); extern Void addUnqualImport Args((Text,Text,List)); extern Void importName Args((Module,Name)); extern Void checkImportList Args((Bool,Pair)); extern Void checkQualImportList Args((Pair)); extern Void fixupImportExports Args((List)); extern List checkExports Args((List)); extern Void browseModule Args((Module,Bool)); #endif /* __MODULE_H__ */ hugs98-plus-Sep2006/src/observe.c0000644006511100651110000000631210131220642015354 0ustar rossross/* * Debugging via observations. * * Note: only available via the command interpreter, not * in batch mode. * */ #include "prelude.h" #include "storage.h" #include "connect.h" #include "command.h" #include "errors.h" #include "machdep.h" #include "builtin.h" #include "output.h" #include "observe.h" /* -------------------------------------------------------------------------- * Break dialogue code * ------------------------------------------------------------------------*/ #if OBSERVATIONS static Void breakDialogue Args((String)); static struct cmd brkCmds[] = { {"p", BRK_DISPLAY} , {"c", BRK_CONTINUE} , {"s", BRK_SET} , {"r", BRK_RESET} , {0,0} }; static Void breakDialogue(s) String s;{ String arg; Int n; char cmdstr[80]; Command cmd; normalTerminal(); do { strcpy(cmdstr,"Break @ "); promptForInput(strcat(cmdstr,s)); cmd = readCommand(brkCmds, (Char)0, (Char)'!'); switch (cmd){ case BRK_DISPLAY: if ((arg=readFilename())!=0) printObserve(arg); else printObserve(ALLTAGS); break; case BRK_CONTINUE: if ((arg=readFilename())!=0){ n = atoi(arg); if (n>0) n--; setBreakCount(s,n); } break; case BRK_SET: if ((arg=readFilename())!=0) setBreakpt(arg,TRUE); break; case BRK_RESET: if ((arg=readFilename())==0) setBreakpt(s,FALSE); else setBreakpt(arg,FALSE); break; } } while (cmd!=BRK_CONTINUE); } #endif /* -------------------------------------------------------------------------- * Observations & breakpoints primops: * ------------------------------------------------------------------------*/ #if OBSERVATIONS #define MAXTAGLENGTH 80 static char obsTag[MAXTAGLENGTH+1]; extPrimFun(primObserve) { /* the observe primitive for */ Cell exp, obsCell; /* debugging purposes */ int i=0; /* :: String -> a -> a */ fflush(stdout); eval(pop()); while (whnfHead==nameCons) { eval(pop()); if (i print stats after eval */ Bool addType = FALSE; /* TRUE => print type with value */ Bool useShow = TRUE; /* TRUE => use Text/show printer */ Bool displayIO = FALSE; /* TRUE => use printer for IO result*/ Bool useDots = RISCOS; /* TRUE => use dots in progress */ Bool listScripts = FALSE; /* TRUE => list scripts after loading*/ Bool quiet = TRUE; /* TRUE => don't show progress */ Bool printing = FALSE; /* TRUE => currently printing value*/ String hugsEdit = 0; /* String for editor command */ String prompt = 0; /* Prompt string */ #if !HASKELL_98_ONLY Bool haskell98 = TRUE; /* TRUE => Haskell 98 compatibility*/ #endif #if EXPLAIN_INSTANCE_RESOLUTION Bool showInstRes = FALSE; #endif #if MULTI_INST Bool multiInstRes = FALSE; #endif Bool printTypeUseDefaults = FALSE; #if USE_PREFERENCES_FILE /* -------------------------------------------------------------------------- * Decls for MacOS preference file support: * ------------------------------------------------------------------------*/ static Void readPrefsFile Args((FILE *)); typedef char GVarname[2000]; static GVarname hugsFlags = ""; int iniArgc; char iniArgv[10][33]; #endif /* -------------------------------------------------------------------------- * Keeping track of current file: * ------------------------------------------------------------------------*/ static String lastEdit = 0; /* Name of script to edit (if any) */ static Int lastLine = 0; /* Editor line number (if possible)*/ Void setLastEdit(fname,line) /* keep name of last file to edit */ String fname; Int line; { if (lastEdit) { free(lastEdit); } lastEdit = strCopy(fname); lastLine = line; } String getLastEdit(Int* pLastLine) { if (pLastLine) *pLastLine = lastLine; return lastEdit; } /* -------------------------------------------------------------------------- * Setting of command line options: * ------------------------------------------------------------------------*/ #if HASKELL_98_ONLY #define Option(c,h98,description,flag) { c, description, flag } #else #define Option(c,h98,description,flag) { c, h98, description, flag } #endif static Void local toggleSet Args((Char,Bool)); static Void local togglesIn Args((Bool)); struct options toggle[] = { /* List of command line toggles */ Option('s', 1, "Print no. reductions/cells after eval", &showStats), Option('t', 1, "Print type after evaluation", &addType), Option('g', 1, "Print no. cells recovered after gc", &gcMessages), Option('l', 1, "Literate modules as default", &literateScripts), Option('.', 1, "Print dots to show progress", &useDots), Option('q', 1, "Print nothing to show progress", &quiet), Option('Q', 1, "Qualify names when printing", &useQualifiedNames), Option('w', 1, "Always show which modules are loaded", &listScripts), Option('k', 1, "Show kind errors in full", &kindExpert), Option('o', 0, "Allow overlapping instances", &allowOverlap), Option('O', 0, "Allow unsafe overlapping instances", &allowUnsafeOverlap), Option('u', 1, "Use \"show\" to display results", &useShow), Option('I', 1, "Display results of IO programs", &displayIO), Option('T', 1, "Apply 'defaulting' when printing types", &printTypeUseDefaults), /* Conditional toggles: */ #if HUGS_FOR_WINDOWS Option('A', 1, "Auto load files", &autoLoadFiles), #endif #if EXPLAIN_INSTANCE_RESOLUTION Option('x', 1, "Explain instance resolution", &showInstRes), #endif #if MULTI_INST Option('m', 0, "Use multi instance resolution", &multiInstRes), #endif #if DEBUG_CODE Option('D', 1, "Debug: show generated G code", &debugCode), #endif #if DEBUG_SHOWSC Option('C', 1, "Debug: show generated SC code", &debugSC), #endif #if OBSERVATIONS Option('R', 1, "Enable root optimisation", &rootOpt), #endif #if HERE_DOC Option('H', 0, "Enable `here documents'", &hereDocs), #endif Option(0, 0, 0, 0) }; Void setOptions(Void) /* change command line options from Hugs command line */ { String s; if ((s=readFilename())!=0) { do { if (!processOption(s)) { ERRMSG(0) "Option string must begin with `+' or `-'" EEND; } } while ((s=readFilename())!=0); #if USE_REGISTRY writeRegString("Options", optionsToStr()); #endif } else { optionInfo(); } } static Void local toggleSet(c,state) /* Set command line toggle */ Char c; Bool state; { Int i; for (i=0; toggle[i].c; ++i) if (toggle[i].c == c) { *toggle[i].flag = state; return; } Printf("Warning: unknown toggle `%c'; ignoring.\n", c); } static Void local togglesIn(state) /* Print current list of toggles in*/ Bool state; { /* given state */ Int count = 0; Int i; for (i=0; toggle[i].c; ++i) #if HASKELL_98_ONLY if (*toggle[i].flag == state) { #else if (*toggle[i].flag == state && (!haskell98 || toggle[i].h98)) { #endif if (count==0) Putchar((char)(state ? '+' : '-')); Putchar(toggle[i].c); count++; } if (count>0) Putchar(' '); } Void optionInfo(Void) { /* Print information about command */ static String fmts = "%-5s%s\n"; /* line settings */ static String fmtc = "%-5c%s\n"; Int i; Printf("TOGGLES: groups begin with +/- to turn options on/off resp.\n"); for (i=0; toggle[i].c; ++i) { #if !HASKELL_98_ONLY if (!haskell98 || toggle[i].h98) { #endif Printf(fmtc,toggle[i].c,toggle[i].description); #if !HASKELL_98_ONLY } #endif } Printf("\nOTHER OPTIONS: (leading + or - makes no difference)\n"); Printf(fmts,"hnum","Set heap size (cannot be changed within Hugs)"); Printf(fmts,"pstr","Set prompt string to str"); Printf(fmts,"rstr","Set repeat last expression string to str"); Printf(fmts,"Pstr","Set search path for modules to str"); Printf(fmts,"Sstr","Set list of source file suffixes to str"); Printf(fmts,"Estr","Use editor setting given by str"); Printf(fmts,"cnum","Set constraint cutoff limit"); #if SUPPORT_PREPROCESSOR Printf(fmts,"Fstr","Set preprocessor filter to str"); #endif #if PROFILING Printf(fmts,"dnum","Gather profiling statistics every reductions\n"); #endif Printf("\nCurrent settings: "); togglesIn(TRUE); togglesIn(FALSE); Printf("-h%d",heapSize); Printf(" -p"); printString(prompt); Printf(" -r"); printString(repeatStr); Printf(" -c%d",cutoff); Printf("\nSearch path : -P"); printString(hugsPath); #if __MWERKS__ && macintosh Printf("\n{Hugs} : %s",hugsdir()); Printf("\n{Current} : %s",currentDir()); #endif Printf("\nSource suffixes : -S"); printString(hugsSuffixes); Printf("\nEditor setting : -E"); printString(hugsEdit); #if SUPPORT_PREPROCESSOR Printf("\nPreprocessor : -F"); printString(preprocessor); #endif #if PROFILING Printf("\nProfile interval: -d%d", profiling ? profInterval : 0); #endif #if HASKELL_98_ONLY Printf("\nCompatibility : Haskell 98"); #else Printf("\nCompatibility : %s", haskell98 ? "Haskell 98 (+98)" : "Hugs Extensions (-98)"); #endif Putchar('\n'); } /* Get rid off superfluous trailing space(s) */ #define TRIMSPC() while (*(next-1) == ' ') { next--; charsLeft++; } #define PUTC(c) \ if (charsLeft > 1) { \ *next++=(c);charsLeft--; \ } else { \ *next='\0'; \ } #define PUTS(s) \ do { String sref = (s); \ Int len = strlen(sref); \ if ( charsLeft > len ) { \ strcpy(next,sref); \ next+=len; \ charsLeft -= len; \ } else { \ *next = '\0'; \ } \ } while(0) #define PUTInt(optc,i) \ if ( charsLeft > 20 /*conservative*/ ) { \ sprintf(next,"-%c%d",optc,i); \ next+=strlen(next); \ } else { \ *next = '\0'; \ } #define PUTStr(c,s) \ next=PUTStr_aux(next,&charsLeft,c,s) static String local PUTStr_aux Args((String,Int*,Char, String)); static String local PUTStr_aux(next,chLeft,c,s) String next; Int* chLeft; Char c; String s; { Int charsLeft = *chLeft; Int len; if (s && (len = strlen(s)) > 0 ) { String t = 0; len = strlen(s); if ( (Int)(len + 10) > charsLeft ) { *next = '\0'; /* optionsToStr() will not to break off immediately, * but soon enough. */ return next; } *next++ = '-'; *next++=c; *next++='"'; charsLeft -= 3; /* * Subtlety if *s == '\0': for-loop below bails out right away, * causing strlen(next) to report quite possibly an inappropriate * result. => always zero-terminate first. * * Do this even if we now explicitly test for 's' not being "" at * the start. */ *next = '\0'; for(t=s; *t; ) { /* Explicitly bind result to a local to avoid * duplicating work within PUTS() macro. Ugly. */ String strChar = unlexChar(ExtractChar(t),'"'); PUTS(strChar); } next+=strlen(next); PUTS("\" "); } *chLeft = charsLeft; return next; } String optionsToStr() { /* convert options to string */ static char buffer[2000]; String next = buffer; Int charsLeft = 2000; Int i; for (i=0; toggle[i].c; ++i) { PUTC(*toggle[i].flag ? '+' : '-'); PUTC(toggle[i].c); PUTC(' '); } #if !HASKELL_98_ONLY PUTS(haskell98 ? "+98 " : "-98 "); #endif PUTInt('h',hpSize); PUTC(' '); PUTStr('p',prompt); PUTStr('r',repeatStr); PUTStr('P',hugsPath); PUTStr('S',hugsSuffixes); PUTStr('E',hugsEdit); PUTInt('c',cutoff); PUTC(' '); #if SUPPORT_PREPROCESSOR PUTStr('F',preprocessor); #endif #if PROFILING PUTInt('d',profiling ? profInterval : 0); #endif TRIMSPC(); PUTC('\0'); return buffer; } #undef TRIMSPC #undef PUTC #undef PUTS #undef PUTInt #undef PUTStr /* -------------------------------------------------------------------------- * Reading and processing option strings: * ------------------------------------------------------------------------*/ Void readOptions(options,freeUp) /* read options from string */ String options; Bool freeUp; { if (!readOptions2(options)) { ERRMSG(0) "Option string must begin with `+' or `-'" EEND; } if (options && freeUp) { free(options); } } Bool readOptions2(options) /* read options from string */ String options; { String s; if (options) { stringInput(options); while ((s=readFilename())!=0) { if (*s && !processOption(s)) return FALSE; } } return TRUE; } Bool processOption(s) /* process string s for options, */ String s; { /* return FALSE if none found. */ Bool state; if (s[0]=='-') state = FALSE; else if (s[0]=='+') state = TRUE; else return FALSE; while (*++s) switch (*s) { case 'p' : if (s[1]) { if (prompt) free(prompt); prompt = strCopy(s+1); } return TRUE; case 'r' : if (s[1]) { if (repeatStr) free(repeatStr); repeatStr = strCopy(s+1); } return TRUE; #if PROFILING case 'd' : { /* random choice of letter - ADR */ Int i = argToInt(s+1); if (i > 0) { profiling = TRUE; profInterval = i; } else { profiling = FALSE; /* To keep the profiling test efficient(?) * we dont actually disable the gathering * of profiling statistics - we just gather * them very infrequently. ADR */ profInterval = MAXPOSINT; } } return TRUE; #endif case 'P' : { String prelLoc; String savedPath; savedPath = hugsPath; if (*(s+1) == '\0') { hugsPath = uniqPath(strCopy(HUGSPATH)); } else { hugsPath = substPath(s+1,hugsPath ? hugsPath : ""); } prelLoc = findMPathname(STD_PRELUDE); /* prelLoc points to static storage, don't free. */ if (!prelLoc) { Printf("ERROR: unable to locate Prelude along new path: \"%s\" - ignoring it.\n", hugsPath); if (hugsPath) free(hugsPath); hugsPath = savedPath; } else { if (savedPath) free(savedPath); } return TRUE; } case 'S' : { String saveSuffixes = hugsSuffixes; if (*(s+1) == '\0') hugsSuffixes = strCopy(HUGSSUFFIXES); else hugsSuffixes = substPath(s+1,hugsSuffixes); if ( !findMPathname(STD_PRELUDE) ) { Printf("ERROR: unable to locate Prelude with new suffix list: \"%s\" - ignoring it.\n", hugsSuffixes); free(hugsSuffixes); hugsSuffixes = saveSuffixes; } else { free(saveSuffixes); } return TRUE; } case 'E' : if (hugsEdit) free(hugsEdit); hugsEdit = strCopy(s+1); return TRUE; #if SUPPORT_PREPROCESSOR case 'F' : if (preprocessor) free(preprocessor); preprocessor = strCopy(s+1); if (preprocessor && strlen(preprocessor) == 0) { free(preprocessor); preprocessor = NULL; } return TRUE; #endif case 'i' : ffiAddCppInclude(s+1); return TRUE; /* re-parse options (useful with #!) */ case 'X' : return readOptions2(s+1); case 'h' : setHeapSize(s+1); return TRUE; case 'c' : { Int cutcand = argToInt(s+1); if (cutcand>=1 && cutcand<=1024) cutoff = cutcand; } return TRUE; /* warnings about obsolete options */ case 'e': case 'f': case 'N': case 'W': case 'G' : Printf("ERROR: ignoring obsolete %c%c option.\n", state ? '+' : '-', *s); return TRUE; case 'L' : Printf("ERROR: +L is no longer supported for ffihugs - put the argument (without +L) *after* the module - ignoring it.\n"); return TRUE; default : #if !HASKELL_98_ONLY if (strcmp("98",s)==0) { if (heapBuilt() && (state != haskell98)) { FPrintf(stderr,"Haskell 98 compatibility cannot be changed while the interpreter is running\n"); FFlush(stderr); } else { haskell98 = state; } return TRUE; } else { #endif toggleSet(*s,state); #if !HASKELL_98_ONLY } #endif break; } return TRUE; } Bool isOption(s) String s; { /* return TRUE if 's' looks like an option */ return ( s && (s[0] == '-' || s[0] == '+') ); } Void setHeapSize(s) String s; { if (s) { hpSize = argToInt(s); if (hpSize < MINIMUMHEAP) hpSize = MINIMUMHEAP; else if (MAXIMUMHEAP && hpSize > MAXIMUMHEAP) hpSize = MAXIMUMHEAP; if (heapBuilt() && hpSize != heapSize) { #define HEAP_RESIZE_MSG "Change to heap size will not take effect until you rerun Hugs" #if HUGS_FOR_WINDOWS InfoBox(HEAP_RESIZE_MSG); #endif #if USE_REGISTRY FPrintf(stderr,HEAP_RESIZE_MSG "\n"); #else FPrintf(stderr,"Cannot change heap size\n"); #endif #undef HEAP_RESIZE_MSG FFlush(stderr); } else { heapSize = hpSize; } } } Int argToInt(s) /* read integer from argument str */ String s; { Int n = 0; String t = s; if (*s=='\0' || !isascii(*s) || !isdigit(*s)) { ERRMSG(0) "Missing integer in option setting \"%s\"", t EEND; } do { Int d = (*s++) - '0'; if (n > ((MAXPOSINT - d)/10)) { ERRMSG(0) "Option setting \"%s\" is too large", t EEND; } n = 10*n + d; } while (isascii(*s) && isdigit(*s)); if (*s=='K' || *s=='k') { if (n > (MAXPOSINT/1000)) { ERRMSG(0) "Option setting \"%s\" is too large", t EEND; } n *= 1000; s++; } #if MAXPOSINT > 1000000 /* waste of time on 16 bit systems */ if (*s=='M' || *s=='m') { if (n > (MAXPOSINT/1000000)) { ERRMSG(0) "Option setting \"%s\" is too large", t EEND; } n *= 1000000; s++; } #endif #if MAXPOSINT > 1000000000 if (*s=='G' || *s=='g') { if (n > (MAXPOSINT/1000000000)) { ERRMSG(0) "Option setting \"%s\" is too large", t EEND; } n *= 1000000000; s++; } #endif if (*s!='\0') { ERRMSG(0) "Unwanted characters after option setting \"%s\"", t EEND; } return n; } /* -------------------------------------------------------------------------- * Process the options entries in an argv-vector: * ------------------------------------------------------------------------*/ Void processOptionVector(argc,argv) Int argc; String argv[]; { Int i; for (i=1; i, where t < 10). * - WinHugs GUI options. * */ Void readOptionSettings() { #if USE_PREFERENCES_FILE FILE *f; FileName hugsPrefsFile = "\0"; #endif #if USE_REGISTRY readOptions(readRegString(HKEY_LOCAL_MACHINE,hugsRegRoot,"Options",""), TRUE); if (!fromEnv("IGNORE_USER_REGISTRY",NULL)) { /* If IGNORE_USER_REGISTRY exist as an env var, don't consult * the user portion of the Registry. Emergency workaround if it has * somehow become invalid. */ readOptions(readRegString(HKEY_CURRENT_USER, hugsRegRoot,"Options",""), TRUE); } #endif /* USE_REGISTRY */ #if USE_PREFERENCES_FILE if (f=fopen(PREFS_FILE_NAME,"r")) { /* is preferences file in the {Current} folder? */ readPrefsFile(f); } else { /* is preferences file in the {Hugs} folder? */ strcpy(hugsPrefsFile,macHugsDir); strcat(hugsPrefsFile,":"); strcat(hugsPrefsFile,PREFS_FILE_NAME); if (f=fopen(hugsPrefsFile,"r")) readPrefsFile(f); } /* else: take default preferences */ readOptions(hugsFlags,FALSE); #else readOptions(fromEnv("HUGSFLAGS",""),FALSE); #endif } #if USE_PREFERENCES_FILE static Void readPrefsFile(FILE *f) { GVarname line = ""; int linep = 0; char c; while ( (c=fgetc(f)) != EOF && c != '\n') { /* read HUGSFLAGS */ if ((c != '\t') && (c != '\r')) { /* skip some control chars */ line[linep++] = c; line[linep] = '\0'; } } strcpy(hugsFlags,line); iniArgc = 0; do { /* read input command line files */ while ((c == '\n') || (c == '\t') || (c == ' ')) /* skip blank spaces */ c=fgetc(f); if (c == '"') { /* filename found */ linep = 0; iniArgv[iniArgc][0] = '\0'; while ((c=fgetc(f)) != EOF && c != '"') { if (linep <= 32) { /* filename limit on a mac 32 chars */ iniArgv[iniArgc][linep++] = c; iniArgv[iniArgc][linep] = '\0'; } } if (c == EOF) { ERRMSG(0) "Incorrect name specification in preferences file" EEND; } else { iniArgc++; } } } while ( (c = fgetc(f)) != EOF ); } #endif hugs98-plus-Sep2006/src/opts.h0000644006511100651110000001307010153400136014702 0ustar rossross/* * Processing options/toggles. * * */ #ifndef __OPTS_H__ #define __OPTS_H__ /* -------------------------------------------------------------------------- * Functions for processing and displaying Hugs options: * ------------------------------------------------------------------------*/ extern Bool processOption Args((String)); extern Void readOptions Args((String,Bool)); extern Bool readOptions2 Args((String)); extern Void optionInfo Args((Void)); extern Bool isOption Args((String)); extern Void setOptions Args((Void)); extern String optionsToStr Args((Void)); extern Void processOptionVector Args((Int, String [])); extern Void readOptionSettings Args((Void)); extern Void setLastEdit Args((String,Int)); extern String getLastEdit Args((Int*)); extern Int argToInt Args((String)); extern Void setHeapSize Args((String)); /* -------------------------------------------------------------------------- * Interpreter flags and options: * ------------------------------------------------------------------------*/ extern Bool showStats; /* TRUE => print stats after eval */ extern Bool addType; /* TRUE => print type with value */ extern Bool gcMessages; /* TRUE => print GC messages */ extern Bool literateScripts; /* TRUE => default lit scripts */ extern Bool useDots; /* TRUE => use dots in progress */ extern Bool quiet; /* TRUE => don't show progress */ extern Bool useQualifiedNames; /* TRUE => qualify names when printing types and terms */ extern Bool listScripts; /* TRUE => list scripts after loading*/ extern Bool kindExpert; /* TRUE => display kind errors in */ /* full detail */ extern Bool allowOverlap; /* TRUE => allow overlapping insts */ extern Bool allowUnsafeOverlap; /* TRUE => in addition, allow */ /* potentially inconsistent */ /* overlapping instances */ extern Bool useShow; /* TRUE => use Text/show printer */ extern Bool displayIO; /* TRUE => use printer for IO result */ extern Bool printTypeUseDefaults; /* TRUE => use 'default'ing when printing types */ extern Int cutoff; /* Constraint Cutoff depth */ extern String prompt; /* Prompt string */ extern String repeatStr; /* Repeat last expr */ extern String hugsPath; /* String for file search path */ extern String hugsSuffixes; /* Source filename suffixes */ extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/ extern Int hpSize; /* Desired heap size */ extern String hugsEdit; /* String for editor command */ /* The rest are conditionally supported flags: */ #if PROFILING extern Bool profiling; /* TRUE => perform profiling. */ extern Int profInterval; /* interval between samples */ #endif #if HUGS_FOR_WINDOWS extern Bool autoLoadFiles; /* TRUE => reload files before eval*/ #endif #if EXPLAIN_INSTANCE_RESOLUTION extern Bool showInstRes; /* TRUE => show instance resolution */ #endif #if MULTI_INST extern Bool multiInstRes; /* TRUE => use multi inst resolution */ #endif #if DEBUG_CODE extern Bool debugCode; /* TRUE => print G-code to screen */ #endif #if DEBUG_SHOWSC extern Bool debugSC; /* TRUE => print SC to screen */ #endif #if OBSERVATIONS extern Bool rootOpt; /* TRUE => enable root optimisation*/ #endif #if HERE_DOC extern Bool hereDocs; /* TRUE => enable `here documents' */ #endif #if HUGS_FOR_WINDOWS extern Bool autoLoadFiles; /* TRUE => automatically reloaded modified files */ #endif #if SUPPORT_PREPROCESSOR extern String preprocessor; /* preprocessor command */ #endif extern Bool printing; /* TRUE => currently printing value*/ /* * How to add a new flag / option: * * - declare the variable which records the setting of the new option * in the above block; add a definition for it at the start of opts.c, * or local to whatever module the variable is being used. * * - decide on what upper/lower-case letter to use for your new option * (getting harder...option handling really ought to be extended with * better support for option strings.) * * - if the flag is a toggle, add an entry for it to the toggle[] array * in opts.c. If it is an option that takes an argument, extend * the switch statement in processOption() to cover your option. There's * a decent chance that code for one of the other options supported can * be adapted to suit your needs.. * * - if the code module which uses the new option doesn't already, add * #include "opts.h" to it to bring the underlying variable declaration * into scope. */ /* * Representing toggles -- exposed here so that UIs (such as winhugs/) can * work off the toggle[] array when putting together an 'Options' dialog. * */ struct options { /* command line option toggles */ char c; /* table defined in main app. */ #if !HASKELL_98_ONLY int h98; /* set in Haskell'98 mode? */ #endif String description; Bool *flag; }; extern struct options toggle[]; #endif /* __OPTS_H__ */ hugs98-plus-Sep2006/src/output.c0000644006511100651110000012261410332161004015252 0ustar rossross/* -------------------------------------------------------------------------- * Unparse expressions and types - for use in error messages, type checker * and for debugging. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: output.c,v $ * $Revision: 1.40 $ * $Date: 2005/11/02 15:57:56 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "output.h" #include "char.h" #include #if OBSERVATIONS #define DEPTH_LIMIT 150 #else #define DEPTH_LIMIT 15 #endif /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Void local putChr Args((Int)); static Void local putStr Args((String)); static Void local putInt Args((Int)); static Void local put Args((Int,Cell)); static Void local putFlds Args((Cell,List)); static Void local putComp Args((Cell,List)); static Void local putQual Args((Cell)); static Bool local isDictVal Args((Cell)); static Cell local maySkipDict Args((Cell)); static Void local putAp Args((Int,Cell)); static Void local putOverInfix Args((Int,Text,Syntax,Cell)); static Void local putInfix Args((Int,Text,Syntax,Cell,Cell)); static Void local putSimpleAp Args((Cell,Int)); static Void local putTuple Args((Int,Cell)); static Int local unusedTups Args((Int,Cell)); static Void local unlexVar Args((Text)); static Void local unlexFullVar Args((Name)); static Void local unlexOp Args((Text)); static Void local unlexCharConst Args((Char)); static Void local unlexStrConst Args((Text)); static Void local putSigType Args((Cell)); static Void local putContext Args((List,List,Int)); static Void local putPred Args((Cell,Int)); static Void local putType Args((Cell,Int,Int)); static Void local putModule Args((Module)); static Void local putTyVar Args((Int)); static Bool local putTupleType Args((Cell,Int)); static Void local putApType Args((Type,Int,Int)); static Void local putKind Args((Kind)); static Void local putKinds Args((Kinds)); #if OBSERVATIONS static Bool local printObsList Args((Cell,Int,Bool)); static Void local printArg Args((FILE *,Cell)); #endif static Bool local isStrConst Args((Cell)); static Void local putStrConst Args((Cell)); static Bool local isCharCell Args((Cell)); static Char local getCellChar Args((Cell)); /* -------------------------------------------------------------------------- * Basic output routines: * ------------------------------------------------------------------------*/ static FILE *outputStream; /* current output stream */ #if DEBUG_SHOWSC || OBSERVATIONS static Int outColumn = 0; /* current output column number */ #endif #define OPEN(b) if (b) putChr('('); #define CLOSE(b) if (b) putChr(')'); static Void local putChr(c) /* print single character */ Int c; { Putc(c,outputStream); #if DEBUG_SHOWSC || OBSERVATIONS outColumn++; #endif } static Void local putStr(s) /* print string */ String s; { for (; *s; s++) { Putc(*s,outputStream); #if DEBUG_SHOWSC || OBSERVATIONS outColumn++; #endif } } static Void local putInt(n) /* print integer */ Int n; { static char intBuf[16]; sprintf(intBuf,"%d",n); putStr(intBuf); } /* -------------------------------------------------------------------------- * Precedence values (See Haskell 1.3 report, p.12): * ------------------------------------------------------------------------*/ #define ALWAYS FUN_PREC /* Always use parens (unless atomic)*/ /* User defined operators have prec */ /* in the range MIN_PREC..MAX_PREC */ #define ARROW_PREC MAX_PREC /* for printing -> in type exprs */ #define COCO_PREC (MIN_PREC-1) /* :: is left assoc, low precedence */ #define COND_PREC (MIN_PREC-2) /* conditional expressions */ #define WHERE_PREC (MIN_PREC-3) /* where expressions */ #define LAM_PREC (MIN_PREC-4) /* lambda abstraction */ #define NEVER LAM_PREC /* Never use parentheses */ /* -------------------------------------------------------------------------- * Print an expression (used to display context of type errors): * ------------------------------------------------------------------------*/ static Int putDepth = 0; /* limits depth of printing DBG */ static Bool inString= 0; /* is char string being put? */ static Void local put(d,e) /* print expression e in context of */ Int d; /* operator of precedence d */ Cell e; { List xs; if (putDepth>DEPTH_LIMIT) { putStr("..."); return; } else putDepth++; #if OBSERVATIONS if (printingObservations) { Cell caf; if (!isWhnf(e)) { if (inString) putStr("..."); else putStr("_"); putDepth--; return; } if ((caf = getCaf(e)) && !isNull(name(caf).defn)) { put(d, name(caf).defn); putDepth--; return; } } #endif switch (whatIs(e)) { case FINLIST : putChr('['); xs = snd(e); if (nonNull(xs)) { put(NEVER,hd(xs)); while (nonNull(xs=tl(xs))) { putChr(','); put(NEVER,hd(xs)); } } putChr(']'); break; case AP : putAp(d,e); break; case NAME : #if OBSERVATIONS if (inString) break; #endif putModule(name(e).mod); unlexVar(name(e).text); break; case VARIDCELL : case VAROPCELL : case DICTVAR : case CONIDCELL : case CONOPCELL : unlexVar(textOf(e)); break; #if IPARAM case IPVAR : putChr('?'); unlexVar(textOf(e)); break; case WITHEXP : OPEN(d>WHERE_PREC); putStr("dlet {...} in "); put(WHERE_PREC+1,fst(snd(e))); CLOSE(d>WHERE_PREC); break; #endif #if TREX case RECSEL : putChr('#'); unlexVar(extText(snd(e))); break; #endif case FREECELL : putStr("{free!}"); break; case TUPLE : putTuple(tupleOf(e),e); break; case WILDCARD : putChr('_'); break; case ASPAT : put(NEVER,fst(snd(e))); putChr('@'); put(ALWAYS,snd(snd(e))); break; case LAZYPAT : putChr('~'); put(ALWAYS,snd(e)); break; #if MUDO case MDOCOMP : putStr("mdo {...}"); break; #endif case DOCOMP : putStr("do {...}"); break; case COMP : putComp(fst(snd(e)),snd(snd(e))); break; case MONADCOMP : putComp(fst(snd(snd(e))),snd(snd(snd(e)))); break; case CHARCELL : unlexCharConst(charOf(e)); break; case INTCELL : { Int i = intOf(e); if (i<0 && d>=UMINUS_PREC) putChr('('); putInt(i); if (i<0 && d>=UMINUS_PREC) putChr(')'); } break; #if BIGNUMS case NEGNUM : case ZERONUM : case POSNUM : xs = bigOut(e,NIL,d>=UMINUS_PREC); for (; nonNull(xs); xs=tl(xs)) putChr(charOf(arg(hd(xs)))); break; #endif case DOUBLECELL : { Double f = (Double)doubleOf(e); if (f<0 && d>=UMINUS_PREC) putChr('('); putStr(doubleToString(f)); if (f<0 && d>=UMINUS_PREC) putChr(')'); } break; case STRCELL : unlexStrConst(textOf(e)); break; case LETREC : OPEN(d>WHERE_PREC); #if DEBUG_CODE putStr("let {"); put(NEVER,fst(snd(e))); putStr("} in "); #else putStr("let {...} in "); #endif put(WHERE_PREC+1,snd(snd(e))); CLOSE(d>WHERE_PREC); break; case COND : OPEN(d>COND_PREC); putStr("if "); put(COND_PREC+1,fst3(snd(e))); putStr(" then "); put(COND_PREC+1,snd3(snd(e))); putStr(" else "); put(COND_PREC+1,thd3(snd(e))); CLOSE(d>COND_PREC); break; case LAMBDA : xs = fst(snd(e)); if (whatIs(xs)==BIGLAM) xs = snd(snd(xs)); while (nonNull(xs) && isDictVal(hd(xs))) xs = tl(xs); if (isNull(xs)) { put(d,snd(snd(snd(e)))); break; } OPEN(d>LAM_PREC); putChr('\\'); if (nonNull(xs)) { put(ALWAYS,hd(xs)); while (nonNull(xs=tl(xs))) { putChr(' '); put(ALWAYS,hd(xs)); } } putStr(" -> "); put(LAM_PREC,snd(snd(snd(e)))); CLOSE(d>LAM_PREC); break; case ESIGN : OPEN(d>COCO_PREC); put(COCO_PREC,fst(snd(e))); putStr(" :: "); putSigType(snd(snd(e))); CLOSE(d>COCO_PREC); break; case BIGLAM : put(d,snd(snd(e))); break; case CASE : putStr("case "); put(NEVER,fst(snd(e))); #if DEBUG_CODE putStr(" of {"); put(NEVER,snd(snd(e))); putChr('}'); #else putStr(" of {...}"); #endif break; case CONFLDS : putFlds(fst(snd(e)),snd(snd(e))); break; case UPDFLDS : putFlds(fst3(snd(e)),thd3(snd(e))); break; #if OBSERVATIONS case INDIRECT : if(printingObservations) put(d, snd(e)); else { putChr('^'); put(ALWAYS,snd(e)); } break; case OBSERVE : if(printingObservations) put(d, markedExpr(e)); else{ putChr('='); putChr('>'); put(ALWAYS,markedExpr(e)); } break; #else case INDIRECT : putChr('^'); put(ALWAYS,snd(e)); break; #endif default : /*internal("put");*/ putChr('$'); putInt(e); break; } putDepth--; } static Void local putFlds(exp,fs) /* Output exp using labelled fields*/ Cell exp; List fs; { put(ALWAYS,exp); putStr(" {"); for (; nonNull(fs); fs=tl(fs)) { Cell v = hd(fs); if (isVar(v)) put(NEVER,v); else { Cell f = fst(v); Cell e = snd(v); Text t = isName(f) ? name(f).text : isVar(f) ? textOf(f) : inventText(); Text s = isName(e) ? name(e).text : isVar(e) ? textOf(e) : inventText(); put(NEVER,f); #if HASKELL_98_ONLY if (s!=t) { #else if (haskell98 || s!=t) { #endif putStr(" = "); put(NEVER,e); } } if (nonNull(tl(fs))) putStr(", "); } putChr('}'); } static Void local putComp(e,qs) /* print comprehension */ Cell e; List qs; { putStr("[ "); put(NEVER,e); if (nonNull(qs)) { putStr(" | "); putQual(hd(qs)); while (nonNull(qs=tl(qs))) { putStr(", "); putQual(hd(qs)); } } putStr(" ]"); } static Void local putQual(q) /* print list comp qualifier */ Cell q; { switch (whatIs(q)) { case BOOLQUAL : put(NEVER,snd(q)); return; case QWHERE : putStr("let {...}"); return; case FROMQUAL : put(ALWAYS,fst(snd(q))); putStr("<-"); put(NEVER,snd(snd(q))); return; } } static Bool local isDictVal(e) /* Look for dictionary value */ Cell e; { #if !DEBUG_CODE || OBSERVATIONS /* code definitely needed for obs. */ Cell h = getHead(e); switch (whatIs(h)) { case DICTVAR : return TRUE; case NAME : return isDfun(h); } #endif return FALSE; } static Cell local maySkipDict(e) /* descend function application, */ Cell e; { /* ignoring dict aps */ while (isAp(e) && isDictVal(arg(e))) e = fun(e); return e; } static Void local putAp(d,e) /* print application (args>=1) */ Int d; Cell e; { Cell h = NIL; Text t = NIL; Syntax sy = NIL; Int args = 0; for (h=e; isAp(h); h=fun(h)) /* find head of expression, looking*/ if (!isDictVal(arg(h))) /* for dictionary arguments */ args++; if (args==0) { /* Special case when *all* args */ put(d,h); /* are dictionary values */ return; } switch (whatIs(h)) { #if NPLUSK case ADDPAT : if (args==1) putInfix(d,textPlus,syntaxOf(namePlus), arg(e),mkInt(intValOf(fun(e)))); else putStr("ADDPAT"); return; #endif case TUPLE : OPEN(args>tupleOf(h) && d>=FUN_PREC); putTuple(tupleOf(h),e); CLOSE(args>tupleOf(h) && d>=FUN_PREC); return; case NAME : if (args==1 && ((h==nameFromInt && isInt(arg(e))) || (h==nameFromInteger && isBignum(arg(e))) || (h==nameFromDouble && isDouble(arg(e))))) { put(d,arg(e)); return; } t = name(h).text; sy = syntaxOf(h); break; case VARIDCELL : case VAROPCELL : case DICTVAR : case CONIDCELL : case CONOPCELL : sy = defaultSyntax(t = textOf(h)); break; #if TREX case EXT : if (args==2) { String punc = "("; do { putStr(punc); punc = ", "; putStr(textToStr(extText(h))); putStr(" = "); put(NEVER,extField(e)); args = 0; e = extRow(e); for (h=e; isAp(h); h=fun(h)) if (!isDictVal(arg(h))) args++; } while (isExt(h) && args==2); if (e!=nameNoRec) { putStr(" | "); put(NEVER,e); } putChr(')'); return; } else if (args<2) internal("putExt"); else args-=2; break; #endif default : sy = APPLIC; break; } e = maySkipDict(e); if (sy==APPLIC) { /* print simple application */ OPEN(d>=FUN_PREC); putSimpleAp(e,args); CLOSE(d>=FUN_PREC); return; } else if (args==1) { /* print section of the form (e+) */ putChr('('); put(FUN_PREC-1,arg(e)); putChr(' '); unlexOp(t); putChr(')'); } else if (args==2 && isStrConst(e)) putStrConst(e); else if (args==2) /* infix expr of the form e1 + e2 */ putInfix(d,t,sy,arg(maySkipDict(fun(e))),arg(e)); else { /* o/w (e1 + e2) e3 ... en (n>=3) */ OPEN(d>=FUN_PREC); putOverInfix(args,t,sy,e); CLOSE(d>=FUN_PREC); } } static Void local putStrConst(e) Cell e; { putChr('"'); while (isAp(e) && isAp(fun(e)) && fun(fun(e))==nameCons) { putStr(unlexChar(getCellChar(arg(fun(e))),'"')); e = arg(e); } if (e!=nameNil) internal("putStrConst"); putChr('"'); } static Bool local isStrConst(e) Cell e; { while (isAp(e) && isAp(fun(e)) && fun(fun(e))==nameCons) { if (!isCharCell(arg(fun(e)))) return FALSE; e = arg(e); } return e==nameNil; } static Bool local isCharCell(e) Cell e; { while(1) switch(whatIs(e)) { case CHARCELL : return 1; case INDIRECT : e = snd(e); break; #if OBSERVATIONS case OBSERVE : e = markedExpr(e); break; #endif default : return 0; } } static Char local getCellChar(e) Cell e; { while(1) switch(whatIs(e)) { case CHARCELL : return charOf(e); case INDIRECT : e = snd(e); break; #if OBSERVATIONS case OBSERVE : e = markedExpr(e); break; #endif default : internal("error in getCellChar"); } } static Void local putOverInfix(args,t,sy,e) Int args; /* infix applied to >= 3 arguments */ Text t; Syntax sy; Cell e; { if (args>2) { putOverInfix(args-1,t,sy,maySkipDict(fun(e))); putChr(' '); put(FUN_PREC,arg(e)); } else putInfix(ALWAYS,t,sy,arg(maySkipDict(fun(e))),arg(e)); } static Void local putInfix(d,t,sy,e,f) /* print infix expression */ Int d; Text t; /* Infix operator symbol */ Syntax sy; /* with name t, syntax s */ Cell e, f; { /* Left and right operands */ Syntax a = assocOf(sy); Int p = precOf(sy); OPEN(d>p); put((a==LEFT_ASS ? p : 1+p), e); putChr(' '); unlexOp(t); putChr(' '); put((a==RIGHT_ASS ? p : 1+p), f); CLOSE(d>p); } static Void local putSimpleAp(e,n) /* print application e0 e1 ... en */ Cell e; Int n; { if (n>0) { putSimpleAp(maySkipDict(fun(e)),n-1); putChr(' '); put(FUN_PREC,arg(e)); } else put(FUN_PREC,e); } static Void local putTuple(ts,e) /* Print tuple expression, allowing*/ Int ts; /* for possibility of either too */ Cell e; { /* few or too many args to constr */ Int i; putChr('('); if ((i=unusedTups(ts,e))>0) { while (--i>0) putChr(','); putChr(')'); } } static Int local unusedTups(ts,e) /* print first part of tuple expr */ Int ts; /* returning number of constructor */ Cell e; { /* args not yet printed ... */ if (isAp(e)) { if ((ts=unusedTups(ts,fun(e))-1)>=0) { put(NEVER,arg(e)); putChr(ts>0?',':')'); } else { putChr(' '); put(FUN_PREC,arg(e)); } } return ts; } static Void local unlexVar(t) /* print text as a variable name */ Text t; { /* operator symbols must be enclosed*/ String s = textToStr(t); /* in parentheses... except [] ... */ if ((isascii(s[0]) && isalpha(s[0])) || s[0]=='_' || s[0]=='[' || s[0]=='(') putStr(s); else { putChr('('); putStr(s); putChr(')'); } } static Void local unlexFullVar(n) /* print text as a variable name */ Name n; { Module m = name(n).mod; Text t = name(n).text; if (name(n).parent && isName(name(n).parent) && isPair(name(name(n).parent).defn) && snd(name(name(n).parent).defn) == n) { /* Constructor with strict fields are handled in * a strange manner. Here we print the true construtor name */ unlexFullVar(name(n).parent); } else { if (name(n).primDef) { putStr("Prelude"); } else { putStr(textToStr(module(m).text)); } putChr('.'); putStr(textToStr(t)); } } static Void local unlexOp(t) /* print text as operator name */ Text t; { /* alpha numeric symbols must be */ String s = textToStr(t); /* enclosed by backquotes */ if (isascii(s[0]) && isalpha(s[0])) { putChr('`'); putStr(s); putChr('`'); } else putStr(s); } static Void local unlexCharConst(c) Char c; { putChr('\''); putStr(unlexChar(c,'\'')); putChr('\''); } static Void local unlexStrConst(t) Text t; { String s = textToStr(t); static Char SO = 14; /* ASCII code for '\SO' */ Bool lastWasSO = FALSE; Bool lastWasDigit = FALSE; Bool lastWasEsc = FALSE; putChr('\"'); while (*s) { String ch; Char c = ' '; Char sc = getStrChr(&s); ch = unlexChar(sc,'\"'); if ((lastWasSO && *ch=='H') || (lastWasEsc && lastWasDigit && isascii(*ch) && isdigit(*ch))) putStr("\\&"); lastWasEsc = (*ch=='\\'); lastWasSO = (sc==SO); for (; *ch; c = *ch++) putChr(*ch); lastWasDigit = (isascii(c) && isdigit(c)); } putChr('\"'); } /* -------------------------------------------------------------------------- * Pretty printer for supercombinator definitions: * (i.e., for lambda-lifter output, immediately prior to code generation.) * ------------------------------------------------------------------------*/ #if DEBUG_SHOWSC static Void local pIndent Args((Int)); static Void local pPut Args((Int,Cell,Int)); static Void local pPutAp Args((Int,Cell,Int)); static Void local pPutSimpleAp Args((Cell,Int)); static Void local pPutTuple Args((Int,Cell,Int)); static Int local punusedTups Args((Int,Cell,Int)); static Void local pPutOffset Args((Int)); static Int local pPutLocals Args((List,Int)); static Void local pLiftedStart Args((Cell,Int,String)); static Void local pLifted Args((Cell,Int,String)); static Int local pDiscr Args((Cell,Int)); static Void local pIndent(n) /* indent to particular position */ Int n; { outColumn = n; while (0=UMINUS_PREC) putChr('('); putInt(i); if (i<0 && d>=UMINUS_PREC) putChr(')'); } break; case DOUBLECELL : { Double f = (Double)doubleOf(e); if (f<0 && d>=UMINUS_PREC) putChr('('); putStr(doubleToString(f)); if (f<0 && d>=UMINUS_PREC) putChr(')'); } break; case STRCELL : unlexStrConst(textOf(e)); break; #if BIGNUMS case NEGNUM : case ZERONUM : case POSNUM : { List xs = bigOut(e,NIL,d>=UMINUS_PREC); for (; nonNull(xs); xs=tl(xs)) putChr(charOf(arg(hd(xs)))); } break; #endif case LETREC : OPEN(d>WHERE_PREC); co += pPutLocals(fst(snd(e)),co); pPut(WHERE_PREC+1, snd(snd(e)), co); CLOSE(d>WHERE_PREC); break; case COND : { Int left = outColumn; OPEN(d>COND_PREC); putStr("case "); pPut(COND_PREC+1,fst3(snd(e)),co); putStr(" of"); pIndent(left+2); putStr(" { Prelude.True -> "); pPut(COND_PREC+1,snd3(snd(e)),co); pIndent(left+2); putStr(" ; Prelude.False -> "); pPut(COND_PREC+1,thd3(snd(e)),co); pIndent(left+2); putStr("}"); CLOSE(d>COND_PREC); break; } default : printf("[e = %d, whatIs(e) = %d]\n",e,whatIs(e)); internal("pPut"); } } static Void local pPutAp(d,e,co) /* print application (args>=1) */ Int d; Cell e; Int co; { Cell h = getHead(e); if (isTuple(h)) { Int args = argCount; OPEN(args>tupleOf(h) && d>=FUN_PREC); pPutTuple(tupleOf(h),e,co); CLOSE(args>tupleOf(h) && d>=FUN_PREC); return; } OPEN(d>=FUN_PREC); pPutSimpleAp(e,co); CLOSE(d>=FUN_PREC); } static Void local pPutSimpleAp(e,co) /* print application e0 e1 ... en */ Cell e; Int co; { if (isAp(e)) { pPutSimpleAp(fun(e),co); putChr(' '); pPut(FUN_PREC,arg(e),co); } else pPut(FUN_PREC,e,co); } static Void local pPutTuple(ts,e,co) /* Print tuple expression, allowing*/ Int ts; /* for possibility of either too */ Cell e; /* few or too many args to constr */ Int co; { Int i; putStr("(#"); putInt(ts); putChr(' '); if ((i=punusedTups(ts,e,co))>0) { while (--i>0) putChr(' '); } putChr(')'); } static Int local punusedTups(ts,e,co) /* print first part of tuple expr */ Int ts; /* returning number of constructor */ Cell e; /* args not yet printed ... */ Int co; { if (isAp(e)) { if ((ts=punusedTups(ts,fun(e),co)-1)>=0) { pPut(ALWAYS,arg(e),co); putStr(ts>0?" ":""); } else { putChr(' '); pPut(FUN_PREC,arg(e),co); } } return ts; } static Void local pPutOffset(n) /* pretty print offset number */ Int n; { putChr('_'); putInt(n); } static Int local pPutLocals(vs,co) /* pretty print locals */ List vs; Int co; { Int left = outColumn; Int n = length(vs); Int i; putStr("let "); for (i=0; i "); pPut(NEVER,snd(hd(gs)),co); putStr("\n"); pIndent(left + 2); putStr("; _ -> \n"); gs = tl(gs); pIndent(left); if (!nonNull(gs)) break; } putStr("_fatbar "); for(tmp = 0;tmp < count;tmp++) { putChr('}'); } putStr(";\n"); } break; case LETREC : co += pPutLocals(fst(snd(e)),co); pLifted(snd(snd(e)), co, eq); break; case FATBAR : { Int left = outColumn; putStr("let_ _fatbar = \n"); pIndent(left+2); pLifted(snd(snd(e)),co,eq); pIndent(left); putStr("in\n"); pIndent(left+2); pLifted(fst(snd(e)),co,eq); } break; case CASE : { Int left = outColumn; List cs = snd(snd(e)); putStr("case "); pPut(NEVER,fst(snd(e)),co); putStr(" of {\n"); for (; nonNull(cs); cs=tl(cs)) { Int arity; pIndent(left+2); arity = pDiscr(fst(hd(cs)),co); putChr(' '); pLiftedStart(snd(hd(cs)),co+arity,"->"); } pIndent(left+2); putStr("_ -> _fatbar\n"); pIndent(left); putStr("};\n"); } break; #if TREX case EXTCASE : #endif case NUMCASE : { Int left = outColumn; Cell t = snd(e); Cell h = getHead(snd3(t)); String eqInt = "Prelude.primPmInt"; String eqInteger = "Prelude.primPmInteger"; String eqDouble = "Prelude.primPmFlt"; String theEq = "** BAD EQUALITY **"; Int ar = 0; putStr("case "); switch (whatIs(h)) { case NAME: if (h==nameFromInt) { theEq = eqInt; } else if (h == nameFromInteger) { theEq = eqInteger; } else if (h == nameFromDouble) { theEq = eqDouble; } else { ERRMSG(0) "error in NUMCASE" EEND; } break; case ADDPAT: ERRMSG(0) "error in NUMCASE " EEND; break; default: ERRMSG(0) "error in NUMCASE" EEND; break; } putStr(theEq); putStr(" ("); pPut(NEVER,arg(fun(snd3(t))),co); putStr(") ("); pPut(NEVER,arg(snd3(t)),co); putStr(") ("); pPut(NEVER,fst3(t),co); putStr(") of\n"); pIndent(left+2); putStr("{ Prelude.True "); pLiftedStart(thd3(t),co+ar,"->"); putStr("\n"); pIndent(left+2); putStr(" _ -> _fatbar\n"); pIndent(left+2); putStr("};\n"); pIndent(left); } break; default : pPut(NEVER,e,co); putStr(";\n"); break; } } static Int local pDiscr(d,co) /* pretty print discriminator */ Cell d; Int co; { Int arity = 0; switch (whatIs(d)) { #if NPLUSK case ADDPAT : pPutOffset(co+1); putChr('+'); putInt(intValOf(d)); arity = 1; break; #endif case NAME : { Int i = 0; arity = name(d).arity; unlexFullVar(d); for (; i 0) { putStr(", "); } } if (useParens) putChr(')'); } static Void local putPred(pi,fr) /* Output predicate */ Cell pi; Int fr; { if (isAp(pi)) { #if TREX if (isExt(fun(pi))) { putType(arg(pi),ALWAYS,fr); putChr('\\'); putStr(textToStr(extText(fun(pi)))); return; } #endif #if IPARAM if (isIP(fun(pi))) { putChr('?'); putPred(fun(pi),fr); putStr(" :: "); putType(arg(pi),NEVER,fr); return; } #endif putPred(fun(pi),fr); putChr(' '); putType(arg(pi),ALWAYS,fr); } else if (isClass(pi)) { putModule(cclass(pi).mod); putStr(textToStr(cclass(pi).text)); } else if (isCon(pi)) { putStr(textToStr(textOf(pi))); } #if IPARAM else if (isIP(pi)) unlexVar(textOf(pi)); #endif else putStr(""); } static Void local putType(t,prec,fr) /* print nongeneric type expression*/ Cell t; Int prec; Int fr; { switch(whatIs(t)) { case TYCON : putModule(tycon(t).mod); putStr(textToStr(tycon(t).text)); break; case TUPLE : { Int n = tupleOf(t); putChr('('); while (--n > 0) putChr(','); putChr(')'); } break; case POLYTYPE : { Kinds ks = polySigOf(t); OPEN(prec>=ARROW_PREC); putStr("forall "); for (; isAp(ks); ks=tl(ks)) { putTyVar(fr++); if (isAp(tl(ks))) putChr(' '); } putStr(". "); putType(monotypeOf(t),NEVER,fr); CLOSE(prec>=ARROW_PREC); } break; case CDICTS : case QUAL : OPEN(prec>=ARROW_PREC); if (whatIs(snd(snd(t)))==CDICTS) { putContext(fst(snd(t)),fst(snd(snd(snd(t)))),fr); putStr(" => "); putType(snd(snd(snd(snd(t)))),NEVER,fr); } else { putContext(fst(snd(t)),NIL,fr); putStr(" => "); putType(snd(snd(t)),NEVER,fr); } CLOSE(prec>=ARROW_PREC); break; case EXIST : case RANK2 : putType(snd(snd(t)),prec,fr); break; case OFFSET : putTyVar(offsetOf(t)); break; case VARIDCELL : case VAROPCELL : putChr('_'); unlexVar(textOf(t)); break; case INTCELL : putChr('_'); putInt(intOf(t)); break; case AP : { Cell typeHead = getHead(t); Bool brackets = (argCount!=0 && prec>=ALWAYS); Int args = argCount; if (typeHead==typeList) { if (argCount==1) { putChr('['); putType(arg(t),NEVER,fr); putChr(']'); return; } } else if (typeHead==typeArrow) { if (argCount==2) { OPEN(prec>=ARROW_PREC); putType(arg(fun(t)),ARROW_PREC,fr); putStr(" -> "); putType(arg(t),NEVER,fr); CLOSE(prec>=ARROW_PREC); return; } /* else if (argCount==1) { putChr('('); putType(arg(t),ARROW_PREC,fr); putStr("->)"); return; } */ } else if (isTuple(typeHead)) { if (argCount==tupleOf(typeHead)) { putChr('('); putTupleType(t,fr); putChr(')'); return; } } #if TREX else if (isExt(typeHead)) { if (args==2) { String punc = "("; do { putStr(punc); punc = ", "; putStr(textToStr(extText(typeHead))); putStr(" :: "); putType(extField(t),NEVER,fr); t = extRow(t); typeHead = getHead(t); } while (isExt(typeHead) && argCount==2); if (t!=typeNoRow) { putStr(" | "); putType(t,NEVER,fr); } putChr(')'); return; } else if (args<2) internal("putExt"); else args-=2; } #endif OPEN(brackets); putApType(t,args,fr); CLOSE(brackets); } break; default : putStr("(bad type)"); } } static Void local putTyVar(n) /* print type variable */ Int n; { static String alphabet /* for the benefit of EBCDIC :-) */ ="abcdefghijklmnopqrstuvwxyz"; putChr(alphabet[n%26]); if (n /= 26) /* just in case there are > 26 vars*/ putInt(n); } static Bool local putTupleType(e,fr) /* print tuple of types, returning */ Cell e; /* TRUE if something was printed, */ Int fr; { /* FALSE otherwise; used to control*/ if (isAp(e)) { /* printing of intermed. commas */ if (putTupleType(fun(e),fr)) putChr(','); putType(arg(e),NEVER,fr); return TRUE; } return FALSE; } static Void local putApType(t,n,fr) /* print type application */ Cell t; Int n; Int fr; { if (n>0) { putApType(fun(t),n-1,fr); putChr(' '); putType(arg(t),ALWAYS,fr); } else putType(t,ALWAYS,fr); } /* -------------------------------------------------------------------------- * Print kind expression: * ------------------------------------------------------------------------*/ static Void local putKind(k) /* print kind expression */ Kind k; { switch (whatIs(k)) { case AP : if (isAp(fst(k))) { putChr('('); putKind(fst(k)); putChr(')'); } else putKind(fst(k)); if (whatIs(snd(k)) != NIL) { putStr(" -> "); putKind(snd(k)); } break; #if TREX case ROW : putStr("row"); break; #endif case STAR : putChr('*'); break; case OFFSET : putTyVar(offsetOf(k)); break; case INTCELL : putChr('_'); putInt(intOf(k)); break; default : putStr("(bad kind)"); } } static Void local putKinds(ks) /* Print list of kinds */ Kinds ks; { if (isNull(ks)) putStr("()"); else if (nonNull(tl(ks))) { putChr('('); putKind(hd(ks)); while (nonNull(ks=tl(ks))) { putChr(','); putKind(hd(ks)); } putChr(')'); } else putKind(hd(ks)); } /* -------------------------------------------------------------------------- * Print observations * ------------------------------------------------------------------------*/ #if OBSERVATIONS #define DELTA 2 Bool printingObservations = FALSE; Void newLine Args((Int)); Void newLine(indent) Int indent; { putChr('\n'); outColumn = 0; while (indent--) putChr(' '); } Int countObsList Args((Cell)); Int countObsList(header) Cell header; { Int seq, n=0; Cell j; for (j=firstObs(header); j!=header; j=nextObs(j)) { seq = intOf(seqObs(j)); if (seq < 0) { /* non-functional value */ n++; } else if (seq!=0) { /* a function observation */ if (whatIs(exprObs(j)) == OBSERVEHEAD) { n += countObsList(exprObs(j)); } else { n++; } } } return n; } Int countObserve(){ Observe i; Int n=0; i=firstObserve(); while(i != NIL){ n += countObsList(observe(i).head); i = nextObserve(); } return n; } Void printObserve(t) String t; { Observe i; String s; if (! (i=firstObserve())) return; printingObservations = TRUE; outputStream = stdout; #if HUGS_FOR_WINDOWS { int svColor = SetForeColor(MAGENTA); #endif putStr("\n>>>>>>> Observations <<<<<<"); newLine(0); while(i != NIL){ newLine(0); s = textToStr(observe(i).tag); if (*t==0 || strcmp(s,t)==0){ putStr(s); newLine(2); if (printObsList(observe(i).head,2,FALSE)) newLine(0); } i = nextObserve(); } newLine(0); printingObservations = FALSE; #if HUGS_FOR_WINDOWS SetForeColor(svColor); } #endif } Bool printObsList(header, indent, funPrint) Cell header; Int indent; Bool funPrint; { Cell j, resultExp = 0; Int seq=0, appN, argN; Bool firstApp = 1; for (j=firstObs(header); j!=header; j=nextObs(j)){ seq = intOf(seqObs(j)); appN = seqNum(seq); argN = argNum(seq); if ( seq < 0 ) { /* non-functional value */ printArg(stdout, exprObs(j)); if (!funPrint) newLine(indent); } else if (seq!=0) { /* a function observation */ funPrint =1; if (argN == 0){ /* the result expr */ if (firstApp){ /* print previous result */ firstApp = 0; indent = outColumn; putStr("{ "); } else { putStr(" -> "); printExp(stdout,resultExp); newLine(indent); putStr(", "); } resultExp = exprObs(j); putStr ("\\ "); } else { /* an arg expr */ if (whatIs(exprObs(j)) == OBSERVEHEAD) printObsList(exprObs(j), indent, TRUE); else printArg(stdout,exprObs(j)); putStr(" "); } } } if (seq >= 0){ /* print result of last fun. obs. in list */ putStr(" -> "); printExp(stdout,resultExp); newLine(indent); putStr("}"); } return(funPrint); } #endif /* -------------------------------------------------------------------------- * Print qualified module name (if wanted): * ------------------------------------------------------------------------*/ Bool useQualifiedNames = FALSE; static Void local putModule(m) /* print module qualifier */ Module m; { if (useQualifiedNames && !isPrelude(m)) { /* leave out "Prelude." qualifiers, too noisy. */ putStr(textToStr(module(m).text)); putChr('.'); } } /* -------------------------------------------------------------------------- * Main drivers: * ------------------------------------------------------------------------*/ Void printExp(fp,e) /* print expr on specified stream */ FILE *fp; Cell e; { outputStream = fp; putDepth = 0; put(NEVER,e); } #if OBSERVATIONS static Void printArg(fp,e) /* print expr on specified stream */ FILE *fp; Cell e; { outputStream = fp; putDepth = 0; put(ALWAYS,e); } #endif Void printType(fp,t) /* print type on specified stream */ FILE *fp; Cell t; { outputStream = fp; putSigType(t); } Void printContext(fp,qs) /* print context on spec. stream */ FILE *fp; List qs; { outputStream = fp; putContext(qs,NIL,0); } Void printPred(fp,pi) /* print predicate pi on stream */ FILE *fp; Cell pi; { outputStream = fp; putPred(pi,0); } Void printKind(fp,k) /* print kind k on stream */ FILE *fp; Kind k; { outputStream = fp; putKind(k); } Void printKinds(fp,ks) /* print list of kinds on stream */ FILE *fp; Kinds ks; { outputStream = fp; putKinds(ks); } Void printFD(fp,fd) /* print functional dependency */ FILE* fp; Pair fd; { List us; outputStream = fp; for (us=fst(fd); nonNull(us); us=tl(us)) { putTyVar(offsetOf(hd(us))); if (nonNull(tl(us))) { putChr(' '); } } putStr(" -> "); for (us=snd(fd); nonNull(us); us=tl(us)) { putTyVar(offsetOf(hd(us))); if (nonNull(tl(us))) { putChr(' '); } } } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/output.h0000644006511100651110000000212707743000207015264 0ustar rossross/* -------------------------------------------------------------------------- * Unparse expressions and types - for use in error messages, type checker * and for debugging. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * ------------------------------------------------------------------------*/ #ifndef __OUTPUT_H__ #define __OUTPUT_H__ extern Void printExp Args((FILE *,Cell)); extern Void printType Args((FILE *,Cell)); extern Void printContext Args((FILE *,List)); extern Void printPred Args((FILE *,Cell)); extern Void printKind Args((FILE *,Kind)); extern Void printKinds Args((FILE *,Kinds)); extern Void printFD Args((FILE *,Pair)); #if OBSERVATIONS #define ALLTAGS "" extern Void printObserve Args((String)); #endif #if DEBUG_SHOWSC extern Void printSc Args((FILE*, Text, Int, Cell)); #endif #endif /* __OUTPUT_H__ */ hugs98-plus-Sep2006/src/parser.y0000644006511100651110000012046310475357611015257 0ustar rossross/* -------------------------------------------------------------------------- * Hugs parser (included as part of input.c) * * Expect 16 shift/reduce conflicts when passing this grammar through yacc, * but don't worry; they should all be resolved in an appropriate manner. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: parser.y,v $ * $Revision: 1.50 $ * $Date: 2006/08/30 18:57:13 $ * ------------------------------------------------------------------------*/ %{ #ifndef lint #define lint #endif #define defTycon(n,l,lhs,rhs,w) tyconDefn(intOf(l),lhs,rhs,w); sp-=n #define sigdecl(l,vs,t) ap(SIGDECL,triple(l,vs,t)) #define fixdecl(l,ops,a,p) ap(FIXDECL,\ triple(l,ops,mkInt(mkSyntax(a,intOf(p))))) #define grded(gs) ap(GUARDED,gs) #define bang(t) ap(BANG,t) #define only(t) ap(ONLY,t) #define letrec(bs,e) (nonNull(bs) ? ap(LETREC,pair(bs,e)) : e) #define qualify(ps,t) (nonNull(ps) ? ap(QUAL,pair(ps,t)) : t) #define exportSelf() singleton(ap(MODULEENT,mkCon(module(currentModule).text))) #define yyerror(s) /* errors handled elsewhere */ #define YYSTYPE Cell #ifdef YYBISON # if !defined(__GNUC__) || __GNUC__ <= 1 static void __yy_memcpy Args((char*,char*, unsigned int)); # endif #endif #ifdef _MANAGED static void yymemcpy (char *yyto, const char *yyfrom, size_t yycount); #endif static Cell local gcShadow Args((Int,Cell)); static Void local syntaxError Args((String)); static String local unexpected Args((Void)); static Cell local checkPrec Args((Cell)); static Cell local buildTuple Args((List)); static List local checkCtxt Args((List)); static Cell local checkPred Args((Cell)); static Pair local checkDo Args((List)); static Cell local checkTyLhs Args((Cell)); static Cell local checkConstr Args((Cell)); #if MUDO static Pair local checkMDo Args((List)); #endif #if !TREX static Void local noTREX Args((String)); #endif #if !IPARAM static Void local noIP Args((String)); #endif #if !MUDO static Void local noMDo Args((String)); #endif /* For the purposes of reasonably portable garbage collection, it is * necessary to simulate the YACC stack on the Hugs stack to keep * track of all intermediate constructs. The lexical analyser * pushes a token onto the stack for each token that is found, with * these elements being removed as reduce actions are performed, * taking account of look-ahead tokens as described by gcShadow() * below. * * Of the non-terminals used below, only start, topDecl & begin * do not leave any values on the Hugs stack. The same is true for the * terminals EXPR and SCRIPT. At the end of a successful parse, there * should only be one element left on the stack, containing the result * of the parse. */ #define gc0(e) gcShadow(0,e) #define gc1(e) gcShadow(1,e) #define gc2(e) gcShadow(2,e) #define gc3(e) gcShadow(3,e) #define gc4(e) gcShadow(4,e) #define gc5(e) gcShadow(5,e) #define gc6(e) gcShadow(6,e) #define gc7(e) gcShadow(7,e) %} %token EXPR CTXT SCRIPT %token CASEXP OF DATA TYPE IF %token THEN ELSE WHERE LET IN %token INFIXN INFIXL INFIXR PRIMITIVE TNEWTYPE %token DEFAULT DERIVING DO TCLASS TINSTANCE /*#if MUDO*/ %token MDO /*#endif*/ %token REPEAT ALL NUMLIT CHARLIT STRINGLIT %token VAROP VARID CONOP CONID %token QVAROP QVARID QCONOP QCONID /*#if TREX*/ %token RECSELID IPVARID /*#endif*/ %token COCO '=' UPTO '@' '\\' %token '|' '-' FROM ARROW '~' %token '!' IMPLIES '(' ',' ')' %token '[' ';' ']' '`' '.' %token TMODULE IMPORT HIDING QUALIFIED ASMOD %token NEEDPRIMS %token FOREIGN %% /*- Top level script/module structure -------------------------------------*/ start : EXPR exp lwherePart {inputExpr = letrec($3,$2); sp-=2;} | CTXT context {inputContext = $2; sp-=1;} | SCRIPT topModule {valDefns = $2; sp-=1;} | error {syntaxError("input");} ; /*- Haskell module header/import parsing: ----------------------------------- * Syntax for Haskell modules (module headers and imports) is parsed but * most of it is ignored. However, module names in import declarations * are used, of course, if import chasing is turned on. *-------------------------------------------------------------------------*/ /* In Haskell 1.2, the default module header was "module Main where" * In 1.3, this changed to "module Main(main) where". * We use the 1.2 header because it breaks much less pre-module code. */ topModule : startMain begin modBody end { setExportList(singleton(ap(MODULEENT,mkCon(module(currentModule).text)))); $$ = gc3($3); } | startMain '{' modBody '}' { setExportList(singleton(ap(MODULEENT,mkCon(module(currentModule).text)))); $$ = gc4($3); } | TMODULE modname expspec WHERE '{' modBody end {setExportList($3); $$ = gc7($6);} | TMODULE modname expspec WHERE error {syntaxError("declaration");} | TMODULE error {syntaxError("module definition");} ; /* To implement the Haskell module system, we have to keep track of the * current module. We rely on the use of LALR parsing to ensure that this * side effect happens before any declarations within the module. */ startMain : /* empty */ {startModule(conMain); $$ = gc0(NIL);} ; modname : qconid {startModule(mkCon(mkNestedQual($1))); $$ = gc1(NIL);} ; modid : qconid {$$ = mkCon(mkNestedQual($1));} | STRINGLIT { String modName = findPathname(textToStr(textOf($1))); if (modName) { /* fillin pathname if known */ $$ = mkStr(findText(modName)); } else { $$ = $1; } } ; modBody : /* empty */ {$$ = gc0(NIL); } | ';' modBody {$$ = gc2($2);} | topDecls {$$ = gc1($1);} | impDecls chase {$$ = gc2(NIL);} | impDecls ';' chase topDecls {$$ = gc4($4);} ; /*- Exports: --------------------------------------------------------------*/ expspec : /* empty */ {$$ = gc0(exportSelf());} | '(' ')' {$$ = gc2(NIL);} | '(' ',' ')' {$$ = gc3(NIL);} | '(' exports ')' {$$ = gc3($2);} | '(' exports ',' ')' {$$ = gc4($2);} ; exports : exports ',' export {$$ = gc3(cons($3,$1));} | export {$$ = gc1(singleton($1));} ; /* The qcon should be qconid. * Relaxing the rule lets us explicitly export (:) from the Prelude. */ export : qvar {$$ = $1;} | qcon {$$ = $1;} | qconid '(' UPTO ')' {$$ = gc4(pair($1,DOTDOT));} | qconid '(' qnames ')' {$$ = gc4(pair($1,$3));} | TMODULE modid {$$ = gc2(ap(MODULEENT,$2));} ; qnames : /* empty */ {$$ = gc0(NIL);} | ',' {$$ = gc1(NIL);} | qnames1 {$$ = $1;} | qnames1 ',' {$$ = gc2($1);} ; qnames1 : qnames1 ',' qname {$$ = gc3(cons($3,$1));} | qname {$$ = gc1(singleton($1));} ; qname : qvar {$$ = $1;} | qcon {$$ = $1;} ; /*- Import declarations: --------------------------------------------------*/ impDecls : impDecls ';' impDecl {imps = cons($3,imps); $$=gc3(NIL);} | impDecls ';' {$$ = gc2(NIL); } | impDecl {imps = singleton($1); $$=gc1(NIL);} ; chase : /* empty */ {if (chase(imps)) { clearStack(); onto(imps); done(); closeAnyInput(); return 0; } $$ = gc0(NIL); } ; /* Note that qualified import ignores the import list. */ impDecl : IMPORT modid impspec {addUnqualImport($2,NIL,$3); $$ = gc3($2);} | IMPORT modid ASMOD modid impspec {addUnqualImport($2,$4,$5); $$ = gc5($2);} | IMPORT QUALIFIED modid ASMOD modid impspec {addQualImport($3,$5,$6); $$ = gc6($3);} | IMPORT QUALIFIED modid impspec {addQualImport($3,$3,$4); $$ = gc4($3);} | IMPORT error {syntaxError("import declaration");} ; impspec : /* empty */ {$$ = gc0(DOTDOT);} | HIDING '(' imports ')' {$$ = gc4(ap(HIDDEN,$3));} | '(' imports ')' {$$ = gc3($2);} ; imports : /* empty */ {$$ = gc0(NIL);} | ',' {$$ = gc1(NIL);} | imports1 {$$ = $1;} | imports1 ',' {$$ = gc2($1);} ; imports1 : imports1 ',' import {$$ = gc3(cons($3,$1));} | import {$$ = gc1(singleton($1));} ; import : var {$$ = $1;} | CONID {$$ = gc1(pair($1,NONE));} | CONID '(' UPTO ')' {$$ = gc4(pair($1,DOTDOT));} | CONID '(' names ')' {$$ = gc4(pair($1,$3));} ; names : /* empty */ {$$ = gc0(NIL);} | ',' {$$ = gc1(NIL);} | names1 {$$ = $1;} | names1 ',' {$$ = gc2($1);} ; names1 : names1 ',' name {$$ = gc3(cons($3,$1));} | name {$$ = gc1(singleton($1));} ; name : var {$$ = $1;} | con {$$ = $1;} ; /*- Top-level declarations: -----------------------------------------------*/ topDecls : topDecls ';' {$$ = gc2($1);} | topDecls ';' topDecl {$$ = gc2($1);} | topDecls ';' decl {$$ = gc3(cons($3,$1));} | topDecl {$$ = gc0(NIL);} | decl {$$ = gc1(cons($1,NIL));} ; /*- Type declarations: ----------------------------------------------------*/ topDecl : TYPE tyLhs '=' type {defTycon(4,$3,$2,$4,SYNONYM);} | TYPE tyLhs '=' type IN invars {defTycon(6,$3,$2, ap($4,$6),RESTRICTSYN);} | TYPE error {syntaxError("type declaration");} | DATA btype2 '=' constrs deriving {defTycon(5,$3,checkTyLhs($2), ap(rev($4),$5),DATATYPE);} | DATA context IMPLIES tyLhs '=' constrs deriving {defTycon(7,$5,$4, ap(qualify($2,rev($6)), $7),DATATYPE);} | DATA btype2 {defTycon(2,$1,checkTyLhs($2), ap(NIL,NIL),DATATYPE);} | DATA context IMPLIES tyLhs {defTycon(4,$1,$4, ap(qualify($2,NIL), NIL),DATATYPE);} | DATA error {syntaxError("data declaration");} | TNEWTYPE btype2 '=' nconstr deriving {defTycon(5,$3,checkTyLhs($2), ap($4,$5),NEWTYPE);} | TNEWTYPE context IMPLIES tyLhs '=' nconstr deriving {defTycon(7,$5,$4, ap(qualify($2,$6), $7),NEWTYPE);} | TNEWTYPE error {syntaxError("newtype declaration");} | NEEDPRIMS NUMLIT {if (isInt($2)) { needPrims(intOf($2), NULL); } else { syntaxError("needprims decl"); } sp-=2;} | NEEDPRIMS error {syntaxError("needprims decl");} ; tyLhs : tyLhs varid {$$ = gc2(ap($1,$2));} | CONID {$$ = $1;} | error {syntaxError("type defn lhs");} ; invars : invars ',' invar {$$ = gc3(cons($3,$1));} | invar {$$ = gc1(cons($1,NIL));} ; invar : var COCO topType {$$ = gc3(sigdecl($2,singleton($1), $3));} | var {$$ = $1;} ; constrs : constrs '|' pconstr {$$ = gc3(cons($3,$1));} | pconstr {$$ = gc1(cons($1,NIL));} ; pconstr : ALL varids '.' qconstr {$$ = gc4(ap(POLYTYPE, pair(rev($2),$4)));} | constr {$$ = $1;} ; qconstr : context IMPLIES constr {$$ = gc3(qualify($1,$3));} | constr {$$ = $1;} ; constr : '!' btype conop bbtype {$$ = gc4(ap(ap($3,bang($2)),$4));} | btype1 conop bbtype {$$ = gc3(ap(ap($2,$1),$3));} | btype2 conop bbtype {$$ = gc3(ap(ap($2,$1),$3));} | bpolyType conop bbtype {$$ = gc3(ap(ap($2,$1),$3));} | btype2 {$$ = checkConstr($1);} | btype3 {$$ = checkConstr($1);} | con '{' fieldspecs '}' {$$ = gc4(ap(LABC,pair($1,rev($3))));} | con '{' '}' {$$ = gc3(ap(LABC,pair($1,NIL)));} | error {syntaxError("data type declaration");} ; btype3 : btype2 '!' atype {$$ = gc3(ap($1,bang($3)));} | btype2 bpolyType {$$ = gc2(ap($1,$2));} | btype3 atype {$$ = gc2(ap($1,$2));} | btype3 '!' atype {$$ = gc3(ap($1,bang($3)));} | btype3 bpolyType {$$ = gc2(ap($1,$2));} | '(' CONOP ')' {$$ = gc3($2);} ; bbtype : '!' btype {$$ = gc2(bang($2));} | btype {$$ = $1;} | bpolyType {$$ = $1;} ; nconstr : pconstr {$$ = gc1(singleton($1));} ; fieldspecs: fieldspecs ',' fieldspec {$$ = gc3(cons($3,$1));} | fieldspec {$$ = gc1(cons($1,NIL));} ; fieldspec : vars COCO polyType {$$ = gc3(pair(rev($1),$3));} | vars COCO type {$$ = gc3(pair(rev($1),$3));} | vars COCO '!' type {$$ = gc4(pair(rev($1),bang($4)));} ; deriving : /* empty */ {$$ = gc0(NIL);} | DERIVING qconid {$$ = gc2(singleton($2));} | DERIVING '(' derivs0 ')' {$$ = gc4($3);} ; derivs0 : /* empty */ {$$ = gc0(NIL);} | derivs {$$ = gc1(rev($1));} ; derivs : derivs ',' qconid {$$ = gc3(cons($3,$1));} | qconid {$$ = gc1(singleton($1));} ; /*- Processing definitions of primitives ----------------------------------*/ topDecl : PRIMITIVE prims COCO topType{primDefn($1,$2,$4); sp-=4;} ; prims : prims ',' prim {$$ = gc3(cons($3,$1));} | prim {$$ = gc1(cons($1,NIL));} | error {syntaxError("primitive defn");} ; prim : var STRINGLIT {$$ = gc2(pair($1,$2));} | var {$$ = $1;} ; /*- Foreign Function Interface --------------------------------------------*/ topDecl : FOREIGN IMPORT var STRINGLIT var COCO topType {foreignImport($1,$3,NIL,$4,$5,$7); sp-=7;} | FOREIGN IMPORT var var COCO topType {foreignImport($1,$3,NIL,$4,$4,$6); sp-=6;} | FOREIGN IMPORT var var STRINGLIT var COCO topType {foreignImport($1,$3,$4,$5,$6,$8); sp-=8;} | FOREIGN IMPORT var var var COCO topType {foreignImport($1,$3,$4,$5,$5,$7); sp-=7;} | FOREIGN var var STRINGLIT var COCO topType {foreignExport($1,$2,$3,$4,$5,$7); sp-=7;} ; /*- Class declarations: ---------------------------------------------------*/ topDecl : TCLASS crule fds wherePart {classDefn(intOf($1),$2,$4,$3); sp-=4;} | TINSTANCE irule wherePart {instDefn(intOf($1),$2,$3); sp-=3;} | DEFAULT '(' dtypes ')' {defaultDefn(intOf($1),$3); sp-=4;} | TCLASS error {syntaxError("class declaration");} | TINSTANCE error {syntaxError("instance declaration");} | DEFAULT error {syntaxError("default declaration");} ; crule : context IMPLIES btype2 {$$ = gc3(pair($1,checkPred($3)));} | btype2 {$$ = gc1(pair(NIL,checkPred($1)));} ; irule : context IMPLIES btype2 {$$ = gc3(pair($1,checkPred($3)));} | btype2 {$$ = gc1(pair(NIL,checkPred($1)));} ; dtypes : /* empty */ {$$ = gc0(NIL);} | dtypes1 {$$ = gc1(rev($1));} ; dtypes1 : dtypes1 ',' type {$$ = gc3(cons($3,$1));} | type {$$ = gc1(cons($1,NIL));} ; fds : /* empty */ {$$ = gc0(NIL);} | '|' fds1 {h98DoesntSupport(row,"dependent parameters"); $$ = gc2(rev($2));} ; fds1 : fds1 ',' fd {$$ = gc3(cons($3,$1));} | fd {$$ = gc1(cons($1,NIL));} ; fd : varids0 ARROW varids0 {$$ = gc3(pair(rev($1),rev($3)));} | error {syntaxError("functional dependency");} ; varids0 : /* empty */ {$$ = gc0(NIL);} | varids0 varid {$$ = gc2(cons($2,$1));} ; /*- Type expressions: -----------------------------------------------------*/ topType : ALL varids '.' topType0 {$$ = gc4(ap(POLYTYPE, pair(rev($2),$4)));} | topType0 {$$ = $1;} ; topType0 : context IMPLIES topType1 {$$ = gc3(qualify($1,$3));} | topType1 {$$ = $1;} ; topType1 : bpolyType ARROW topType1 {$$ = gc3(fn($1,$3));} | btype1 ARROW topType1 {$$ = gc3(fn($1,$3));} | btype2 ARROW topType1 {$$ = gc3(fn($1,$3));} | btype {$$ = $1;} ; polyType : ALL varids '.' sigType {$$ = gc4(ap(POLYTYPE, pair(rev($2),$4)));} | bpolyType {$$ = $1;} ; bpolyType : '(' polyType ')' {$$ = gc3($2);} | '(' lcontext IMPLIES type ')' {$$ = gc5(qualify($2,$4));} ; varids : varids varid {$$ = gc2(cons($2,$1));} | varid {$$ = gc1(singleton($1));} ; sigType : context IMPLIES type {$$ = gc3(qualify($1,$3));} | type {$$ = $1;} ; context : '(' ')' {$$ = gc2(NIL);} | btype2 {$$ = gc1(singleton(checkPred($1)));} | '(' btype2 ')' {$$ = gc3(singleton(checkPred($2)));} | '(' btypes2 ')' {$$ = gc3(checkCtxt(rev($2)));} | lacks {$$ = gc1(singleton($1));} | '(' lacks1 ')' {$$ = gc3(checkCtxt(rev($2)));} ; lcontext : lacks {$$ = gc1(singleton($1));} | '(' lacks1 ')' {$$ = gc3(checkCtxt(rev($2)));} ; lacks : varid '\\' varid { #if TREX $$ = gc3(ap(mkExt(textOf($3)),$1)); #else noTREX("a type context"); #endif } | IPVARID COCO type { #if IPARAM $$ = gc3(pair(mkIParam($1),$3)); #else noIP("a type context"); #endif } ; lacks1 : btypes2 ',' lacks {$$ = gc3(cons($3,$1));} | lacks1 ',' btype2 {$$ = gc3(cons($3,$1));} | lacks1 ',' lacks {$$ = gc3(cons($3,$1));} | btype2 ',' lacks {$$ = gc3(cons($3,cons($1,NIL)));} | lacks {$$ = gc1(singleton($1));} ; type : type1 {$$ = $1;} | btype2 {$$ = $1;} ; type1 : btype1 {$$ = $1;} | bpolyType ARROW type {$$ = gc3(fn($1,$3));} | btype1 ARROW type {$$ = gc3(fn($1,$3));} | btype2 ARROW type {$$ = gc3(fn($1,$3));} | error {syntaxError("type expression");} ; btype : btype1 {$$ = $1;} | btype2 {$$ = $1;} ; btype1 : btype1 atype {$$ = gc2(ap($1,$2));} | atype1 {$$ = $1;} ; btype2 : btype2 atype {$$ = gc2(ap($1,$2));} | qconid {$$ = $1;} ; atype : atype1 {$$ = $1;} | qconid {$$ = $1;} ; atype1 : varid {$$ = $1;} | '(' ')' {$$ = gc2(typeUnit);} | '(' ARROW ')' {$$ = gc3(typeArrow);} | '(' type1 ')' {$$ = gc3($2);} | '(' btype2 ')' {$$ = gc3($2);} | '(' tupCommas ')' {$$ = gc3($2);} | '(' btypes2 ')' {$$ = gc3(buildTuple($2));} | '(' typeTuple ')' {$$ = gc3(buildTuple($2));} | '(' tfields ')' { #if TREX $$ = gc3(revOnto($2,typeNoRow)); #else noTREX("a type"); #endif } | '(' tfields '|' type ')' { #if TREX $$ = gc5(revOnto($2,$4)); #else noTREX("a type"); #endif } | '[' type ']' {$$ = gc3(ap(typeList,$2));} | '[' ']' {$$ = gc2(typeList);} | '_' {h98DoesntSupport(row,"anonymous type variables"); $$ = gc1(inventVar());} ; btypes2 : btypes2 ',' btype2 {$$ = gc3(cons($3,$1));} | btype2 ',' btype2 {$$ = gc3(cons($3,cons($1,NIL)));} ; typeTuple : type1 ',' type {$$ = gc3(cons($3,cons($1,NIL)));} | btype2 ',' type1 {$$ = gc3(cons($3,cons($1,NIL)));} | btypes2 ',' type1 {$$ = gc3(cons($3,$1));} | typeTuple ',' type {$$ = gc3(cons($3,$1));} ; /*#if TREX*/ tfields : tfields ',' tfield {$$ = gc3(cons($3,$1));} | tfield {$$ = gc1(singleton($1));} ; tfield : varid COCO type {h98DoesntSupport(row,"extensible records"); $$ = gc3(ap(mkExt(textOf($1)),$3));} ; /*#endif*/ /*- Value declarations: ---------------------------------------------------*/ gendecl : INFIXN optDigit ops {$$ = gc3(fixdecl($1,$3,NON_ASS,$2));} | INFIXN error {syntaxError("fixity decl");} | INFIXL optDigit ops {$$ = gc3(fixdecl($1,$3,LEFT_ASS,$2));} | INFIXL error {syntaxError("fixity decl");} | INFIXR optDigit ops {$$ = gc3(fixdecl($1,$3,RIGHT_ASS,$2));} | INFIXR error {syntaxError("fixity decl");} | vars COCO topType {$$ = gc3(sigdecl($2,$1,$3));} | vars COCO error {syntaxError("type signature");} ; optDigit : NUMLIT {$$ = gc1(checkPrec($1));} | /* empty */ {$$ = gc0(mkInt(DEF_PREC));} ; ops : ops ',' op {$$ = gc3(cons($3,$1));} | op {$$ = gc1(singleton($1));} ; vars : vars ',' var {$$ = gc3(cons($3,$1));} | var {$$ = gc1(singleton($1));} ; decls : '{' decls0 end {$$ = gc3($2);} | '{' decls1 end {$$ = gc3($2);} ; decls0 : /* empty */ {$$ = gc0(NIL);} | decls0 ';' {$$ = gc2($1);} | decls1 ';' {$$ = gc2($1);} ; decls1 : decls0 decl {$$ = gc2(cons($2,$1));} ; decl : gendecl {$$ = $1;} | funlhs rhs {$$ = gc2(ap(FUNBIND,pair($1,$2)));} | funlhs COCO type rhs {$$ = gc4(ap(FUNBIND, pair($1,ap(RSIGN, ap($4,$3)))));} | pat0 rhs {$$ = gc2(ap(PATBIND,pair($1,$2)));} ; funlhs : funlhs0 {$$ = $1;} | funlhs1 {$$ = $1;} | npk {$$ = $1;} ; funlhs0 : pat10_vI varop pat0 {$$ = gc3(ap2($2,$1,$3));} | infixPat varop pat0 {$$ = gc3(ap2($2,$1,$3));} | NUMLIT varop pat0 {$$ = gc3(ap2($2,$1,$3));} | var varop_pl pat0 {$$ = gc3(ap2($2,$1,$3));} | var '+' pat0_INT {$$ = gc3(ap2(varPlus,$1,$3));} ; funlhs1 : '(' funlhs0 ')' apat {$$ = gc4(ap($2,$4));} | '(' funlhs1 ')' apat {$$ = gc4(ap($2,$4));} | '(' npk ')' apat {$$ = gc4(ap($2,$4));} | var apat {$$ = gc2(ap($1,$2));} | funlhs1 apat {$$ = gc2(ap($1,$2));} ; rhs : rhs1 wherePart {$$ = gc2(letrec($2,$1));} | error {syntaxError("declaration");} ; rhs1 : '=' exp {$$ = gc2(pair($1,$2));} | gdrhs {$$ = gc1(grded(rev($1)));} ; gdrhs : gdrhs gddef {$$ = gc2(cons($2,$1));} | gddef {$$ = gc1(singleton($1));} ; gddef : '|' exp0 '=' exp {$$ = gc4(pair($3,pair($2,$4)));} ; wherePart : /* empty */ {$$ = gc0(NIL);} | WHERE decls {$$ = gc2($2);} ; /* lwherePart and ldecls permit the binding of both 'normal' * and implicit parameter bindings. */ lwherePart : /* empty */ {$$ = gc0(NIL);} | WHERE ldecls {$$ = gc2($2);} ; ldecls : '{' ldecls0 end {$$ = gc3($2);} | '{' ldecls1 end {$$ = gc3($2);} ; ldecls0 : /* empty */ {$$ = gc0(NIL);} | ldecls0 ';' {$$ = gc2($1);} | ldecls1 ';' {$$ = gc2($1);} ; ldecls1 : ldecls0 ldecl {$$ = gc2(cons($2,$1));} ; ldecl : IPVARID '=' exp { #if IPARAM $$ = gc3(pair($1,$3)); #else noIP("a binding"); #endif } | IPVARID error {syntaxError("a binding");} | decl {$$ = $1;} ; /*- Patterns: -------------------------------------------------------------*/ pat : npk {$$ = $1;} | pat_npk {$$ = $1;} ; pat_npk : pat0 COCO type {$$ = gc3(ap(ESIGN,pair($1,$3)));} | pat0 {$$ = $1;} ; npk : var '+' NUMLIT {$$ = gc3(ap2(varPlus,$1,$3));} ; pat0 : var {$$ = $1;} | NUMLIT {$$ = $1;} | pat0_vI {$$ = $1;} ; pat0_INT : var {$$ = $1;} | pat0_vI {$$ = $1;} ; pat0_vI : pat10_vI {$$ = $1;} | infixPat {$$ = gc1(ap(INFIX,$1));} ; infixPat : '-' pat10 {$$ = gc2(ap(NEG,only($2)));} | '-' error {syntaxError("pattern");} | var qconop pat10 {$$ = gc3(ap(ap($2,only($1)),$3));} | var qconop '-' pat10 {$$ = gc4(ap(NEG,ap2($2,only($1),$4)));} | NUMLIT qconop pat10 {$$ = gc3(ap(ap($2,only($1)),$3));} | NUMLIT qconop '-' pat10 {$$ = gc4(ap(NEG,ap2($2,only($1),$4)));} | pat10_vI qconop pat10 {$$ = gc3(ap(ap($2,only($1)),$3));} | pat10_vI qconop '-' pat10 {$$ = gc4(ap(NEG,ap2($2,only($1),$4)));} | infixPat qconop pat10 {$$ = gc3(ap(ap($2,$1),$3));} | infixPat qconop '-' pat10 {$$ = gc4(ap(NEG,ap(ap($2,$1),$4)));} ; pat10 : fpat {$$ = $1;} | apat {$$ = $1;} ; pat10_vI : fpat {$$ = $1;} | apat_vI {$$ = $1;} ; fpat : fpat apat {$$ = gc2(ap($1,$2));} | gcon apat {$$ = gc2(ap($1,$2));} ; apat : NUMLIT {$$ = $1;} | var {$$ = $1;} | apat_vI {$$ = $1;} ; apat_vI : var '@' apat {$$ = gc3(ap(ASPAT,pair($1,$3)));} | gcon {$$ = $1;} | qcon '{' patbinds '}' {$$ = gc4(ap(CONFLDS,pair($1,$3)));} | CHARLIT {$$ = $1;} | STRINGLIT {$$ = $1;} | '_' {$$ = gc1(WILDCARD);} | '(' pat_npk ')' {$$ = gc3($2);} | '(' npk ')' {$$ = gc3($2);} | '(' pats2 ')' {$$ = gc3(buildTuple($2));} | '[' pats1 ']' {$$ = gc3(ap(FINLIST,rev($2)));} | '~' apat {$$ = gc2(ap(LAZYPAT,$2));} /*#if TREX*/ | '(' patfields ')' { #if TREX $$ = gc3(revOnto($2,nameNoRec)); #else $$ = gc3(NIL); #endif } | '(' patfields '|' pat ')' {$$ = gc5(revOnto($2,$4));} /*#endif TREX*/ ; pats2 : pats2 ',' pat {$$ = gc3(cons($3,$1));} | pat ',' pat {$$ = gc3(cons($3,singleton($1)));} ; pats1 : pats1 ',' pat {$$ = gc3(cons($3,$1));} | pat {$$ = gc1(singleton($1));} ; patbinds : /* empty */ {$$ = gc0(NIL);} | patbinds1 {$$ = gc1(rev($1));} ; patbinds1 : patbinds1 ',' patbind {$$ = gc3(cons($3,$1));} | patbind {$$ = gc1(singleton($1));} ; patbind : qvar '=' pat {$$ = gc3(pair($1,$3));} | var {$$ = $1;} ; /*#if TREX*/ patfields : patfields ',' patfield {$$ = gc3(cons($3,$1));} | patfield {$$ = gc1(singleton($1));} ; patfield : varid '=' pat { #if TREX $$ = gc3(ap(mkExt(textOf($1)),$3)); #else noTREX("a pattern"); #endif } ; /*#endif TREX*/ /*- Expressions: ----------------------------------------------------------*/ exp : exp_err {$$ = $1;} | error {syntaxError("expression");} ; exp_err : exp0a COCO sigType {$$ = gc3(ap(ESIGN,pair($1,$3)));} | exp0 {$$ = $1;} ; exp0 : exp0a {$$ = $1;} | exp0b {$$ = $1;} ; exp0a : infixExpa {$$ = gc1(ap(INFIX,$1));} | exp10a {$$ = $1;} ; exp0b : infixExpb {$$ = gc1(ap(INFIX,$1));} | exp10b {$$ = $1;} ; infixExpa : infixExpa qop '-' exp10a {$$ = gc4(ap(NEG,ap(ap($2,$1),$4)));} | infixExpa qop exp10a {$$ = gc3(ap(ap($2,$1),$3));} | '-' exp10a {$$ = gc2(ap(NEG,only($2)));} | exp10a qop '-' exp10a {$$ = gc4(ap(NEG, ap(ap($2,only($1)),$4)));} | exp10a qop exp10a {$$ = gc3(ap(ap($2,only($1)),$3));} ; infixExpb : infixExpa qop '-' exp10b {$$ = gc4(ap(NEG,ap(ap($2,$1),$4)));} | infixExpa qop exp10b {$$ = gc3(ap(ap($2,$1),$3));} | '-' exp10b {$$ = gc2(ap(NEG,only($2)));} | exp10a qop '-' exp10b {$$ = gc4(ap(NEG, ap(ap($2,only($1)),$4)));} | exp10a qop exp10b {$$ = gc3(ap(ap($2,only($1)),$3));} ; exp10a : CASEXP exp OF '{' alts end {$$ = gc6(ap(CASE,pair($2,rev($5))));} | DO '{' stmts end {$$ = gc4(ap(DOCOMP,checkDo($3)));} | MDO '{' stmts end { #if MUDO $$ = gc4(ap(MDOCOMP, checkMDo($3))); #else noMDo("an expression"); #endif } | appExp {$$ = $1;} ; exp10b : '\\' pats ARROW exp {$$ = gc4(ap(LAMBDA, pair(rev($2), pair($3,$4))));} | LET ldecls IN exp {$$ = gc4(letrec($2,$4));} | IF exp then_exp else_exp {$$ = gc4(ap(COND,triple($2,$3,$4)));} ; /* Allow optional semicolons before 'then' and 'else' (as suggested by John Meacham), to remove a common pitfall when using if-then-else inside do expressions with implicit layout. */ then_exp : ';' THEN exp {$$ = gc3($3);} | THEN exp {$$ = gc2($2);} ; else_exp : ';' ELSE exp {$$ = gc3($3);} | ELSE exp {$$ = gc2($2);} ; pats : pats apat {$$ = gc2(cons($2,$1));} | apat {$$ = gc1(cons($1,NIL));} ; appExp : appExp aexp {$$ = gc2(ap($1,$2));} | aexp {$$ = $1;} ; aexp : qvar {$$ = $1;} | qvar '@' aexp {$$ = gc3(ap(ASPAT,pair($1,$3)));} | '~' aexp {$$ = gc2(ap(LAZYPAT,$2));} | IPVARID {$$ = $1;} | '_' {$$ = gc1(WILDCARD);} | gcon {$$ = $1;} | qcon '{' fbinds '}' {$$ = gc4(ap(CONFLDS,pair($1,$3)));} | aexp '{' fbinds '}' {$$ = gc4(ap(UPDFLDS, triple($1,NIL,$3)));} | NUMLIT {$$ = $1;} | CHARLIT {$$ = $1;} | STRINGLIT {$$ = $1;} | REPEAT {$$ = $1;} | '(' exp ')' {$$ = gc3($2);} | '(' exps2 ')' {$$ = gc3(buildTuple($2));} /*#if TREX*/ | '(' vfields ')' { #if TREX $$ = gc3(revOnto($2,nameNoRec)); #else $$ = gc3(NIL); #endif } | '(' vfields '|' exp ')' {$$ = gc5(revOnto($2,$4));} | RECSELID {$$ = $1;} /*#endif*/ | '[' list ']' {$$ = gc3($2);} | '(' exp10a qop ')' {$$ = gc4(ap($3,$2));} | '(' qvarop_mi exp0 ')' {$$ = gc4(ap(ap(nameFlip,$2),$3));} | '(' qconop exp0 ')' {$$ = gc4(ap(ap(nameFlip,$2),$3));} ; exps2 : exps2 ',' exp {$$ = gc3(cons($3,$1));} | exp ',' exp {$$ = gc3(cons($3,cons($1,NIL)));} ; /*#if TREX*/ vfields : vfields ',' vfield {$$ = gc3(cons($3,$1));} | vfield {$$ = gc1(singleton($1));} ; vfield : varid '=' exp { #if TREX $$ = gc3(ap(mkExt(textOf($1)),$3)); #else noTREX("an expression"); #endif } ; /*#endif*/ alts : alts1 {$$ = $1;} | ';' alts {$$ = gc2($2);} ; alts1 : alts1 ';' alt {$$ = gc3(cons($3,$1));} | alts1 ';' {$$ = gc2($1);} | alt {$$ = gc1(cons($1,NIL));} ; alt : pat altRhs wherePart {$$ = gc3(pair($1,letrec($3,$2)));} ; altRhs : guardAlts {$$ = gc1(grded(rev($1)));} | ARROW exp {$$ = gc2(pair($1,$2));} | error {syntaxError("case expression");} ; guardAlts : guardAlts guardAlt {$$ = gc2(cons($2,$1));} | guardAlt {$$ = gc1(cons($1,NIL));} ; guardAlt : '|' exp0 ARROW exp {$$ = gc4(pair($3,pair($2,$4)));} ; stmts : stmts1 {$$ = $1;} | ';' stmts {$$ = gc2($2);} ; stmts1 : stmts1 ';' stmt {$$ = gc3(cons($3,$1));} | stmts1 ';' {$$ = gc2($1);} | stmt {$$ = gc1(cons($1,NIL));} ; stmt : exp_err FROM exp {$$ = gc3(ap(FROMQUAL,pair($1,$3)));} | LET ldecls {$$ = gc2(ap(QWHERE,$2));} /* | IF exp {$$ = gc2(ap(BOOLQUAL,$2));}*/ | exp_err {$$ = gc1(ap(DOQUAL,$1));} ; fbinds : /* empty */ {$$ = gc0(NIL);} | fbinds1 {$$ = gc1(rev($1));} ; fbinds1 : fbinds1 ',' fbind {$$ = gc3(cons($3,$1));} | fbind {$$ = gc1(singleton($1));} ; fbind : var {$$ = $1;} | qvar '=' exp {$$ = gc3(pair($1,$3));} ; /*- List Expressions: -------------------------------------------------------*/ list : exp {$$ = gc1(ap(FINLIST,cons($1,NIL)));} | exps2 {$$ = gc1(ap(FINLIST,rev($1)));} | exp zipquals { #if ZIP_COMP if (length($2)==1) { $$ = gc2(ap(COMP,pair($1,hd($2)))); } else { if (haskell98) syntaxError("list comprehension"); $$ = gc2(ap(ZCOMP,pair($1,rev($2)))); } #else if (length($2)!=1) { syntaxError("list comprehension"); } $$ = gc2(ap(COMP,pair($1,hd($2)))); #endif } | exp UPTO exp {$$ = gc3(ap(ap(nameFromTo,$1),$3));} | exp ',' exp UPTO {$$ = gc4(ap(ap(nameFromThen,$1),$3));} | exp UPTO {$$ = gc2(ap(nameFrom,$1));} | exp ',' exp UPTO exp {$$ = gc5(ap(ap(ap(nameFromThenTo, $1),$3),$5));} ; zipquals : zipquals '|' quals {$$ = gc3(cons(rev($3),$1));} | '|' quals {$$ = gc2(cons(rev($2),NIL));} ; quals : quals ',' qual {$$ = gc3(cons($3,$1));} | qual {$$ = gc1(cons($1,NIL));} ; qual : exp FROM exp {$$ = gc3(ap(FROMQUAL,pair($1,$3)));} | exp {$$ = gc1(ap(BOOLQUAL,$1));} | LET ldecls {$$ = gc2(ap(QWHERE,$2));} ; /*- Identifiers and symbols: ----------------------------------------------*/ gcon : qcon {$$ = $1;} | '(' ')' {$$ = gc2(nameUnit);} | '[' ']' {$$ = gc2(nameNil);} | '(' tupCommas ')' {$$ = gc3($2);} ; tupCommas : tupCommas ',' {$$ = gc2(mkTuple(tupleOf($1)+1));} | ',' {$$ = gc1(mkTuple(2));} ; varid : VARID {$$ = $1;} | HIDING {$$ = gc1(varHiding);} | QUALIFIED {$$ = gc1(varQualified);} | ASMOD {$$ = gc1(varAsMod);} ; qconid : QCONID {$$ = $1;} | CONID {$$ = $1;} ; var : varid {$$ = $1;} | '(' VAROP ')' {$$ = gc3($2);} | '(' '+' ')' {$$ = gc3(varPlus);} | '(' '-' ')' {$$ = gc3(varMinus);} | '(' '!' ')' {$$ = gc3(varBang);} | '(' '.' ')' {$$ = gc3(varDot);} ; qvar : QVARID {$$ = $1;} | '(' QVAROP ')' {$$ = gc3($2);} | var {$$ = $1;} ; con : CONID {$$ = $1;} | '(' CONOP ')' {$$ = gc3($2);} ; qcon : QCONID {$$ = $1;} | '(' QCONOP ')' {$$ = gc3($2);} | con {$$ = $1;} ; varop : '+' {$$ = gc1(varPlus);} | '-' {$$ = gc1(varMinus);} | varop_mipl {$$ = $1;} ; varop_mi : '+' {$$ = gc1(varPlus);} | varop_mipl {$$ = $1;} ; varop_pl : '-' {$$ = gc1(varMinus);} | varop_mipl {$$ = $1;} ; varop_mipl: VAROP {$$ = $1;} | '`' varid '`' {$$ = gc3($2);} | '!' {$$ = gc1(varBang);} | '.' {$$ = gc1(varDot);} ; qvarop : '-' {$$ = gc1(varMinus);} | qvarop_mi {$$ = $1;} ; qvarop_mi : QVAROP {$$ = $1;} | '`' QVARID '`' {$$ = gc3($2);} | varop_mi {$$ = $1;} ; conop : CONOP {$$ = $1;} | '`' CONID '`' {$$ = gc3($2);} ; qconop : QCONOP {$$ = $1;} | '`' QCONID '`' {$$ = gc3($2);} | conop {$$ = $1;} ; op : varop {$$ = $1;} | conop {$$ = $1;} ; qop : qvarop {$$ = $1;} | qconop {$$ = $1;} ; /*- Tricks to force insertion of leading and closing braces ---------------*/ begin : /* empty */ {goOffside(startColumn);} ; /* deal with trailing semicolon */ end : '}' {$$ = $1;} | error {yyerrok; if (canUnOffside()) { unOffside(); /* insert extra token on stack*/ push(NIL); pushed(0) = pushed(1); pushed(1) = mkInt(column); } else syntaxError("declaration"); } ; /*-------------------------------------------------------------------------*/ %% static Cell local gcShadow(n,e) /* keep parsed fragments on stack */ Int n; Cell e; { /* If a look ahead token is held then the required stack transformation * is: * pushed: n 1 0 1 0 * x1 | ... | xn | la ===> e | la * top() top() * * Othwerwise, the transformation is: * pushed: n-1 0 0 * x1 | ... | xn ===> e * top() top() */ if (yychar>=0) { pushed(n-1) = top(); pushed(n) = e; } else pushed(n-1) = e; sp -= (n-1); return e; } static Void local syntaxError(s) /* report on syntax error */ String s; { ERRMSG(row) "Syntax error in %s (unexpected %s)", s, unexpected() EEND; } static String local unexpected() { /* find name for unexpected token */ static char buffer[100]; static char *fmt = "%s \"%s\""; static char *kwd = "keyword"; switch (yychar) { case 0 : return "end of input"; #define keyword(kw) sprintf(buffer,fmt,kwd,kw); return buffer; case INFIXL : keyword("infixl"); case INFIXR : keyword("infixr"); case INFIXN : keyword("infix"); case TINSTANCE : keyword("instance"); case TCLASS : keyword("class"); case PRIMITIVE : keyword("primitive"); case CASEXP : keyword("case"); case OF : keyword("of"); case IF : keyword("if"); case THEN : keyword("then"); case ELSE : keyword("else"); case WHERE : keyword("where"); case TYPE : keyword("type"); case DATA : keyword("data"); case TNEWTYPE : keyword("newtype"); case LET : keyword("let"); case IN : keyword("in"); case DERIVING : keyword("deriving"); case DEFAULT : keyword("default"); case IMPORT : keyword("import"); case TMODULE : keyword("module"); case ALL : keyword("forall"); #undef keyword case ARROW : return "`->'"; case '=' : return "`='"; case COCO : return "`::'"; case '-' : return "`-'"; case '!' : return "`!'"; case ',' : return "comma"; case '@' : return "`@'"; case '(' : return "`('"; case ')' : return "`)'"; case '{' : return "`{', possibly due to bad layout"; case '}' : return "`}', possibly due to bad layout"; case '_' : return "`_'"; case '|' : return "`|'"; case '.' : return "`.'"; case ';' : return "`;', possibly due to bad layout"; case UPTO : return "`..'"; case '[' : return "`['"; case ']' : return "`]'"; case FROM : return "`<-'"; case '\\' : return "backslash (lambda)"; case '~' : return "tilde"; case '`' : return "backquote"; #if TREX case RECSELID : sprintf(buffer,"selector \"#%s\"", textToStr(extText(snd(yylval)))); return buffer; #endif #if IPARAM case IPVARID : sprintf(buffer,"implicit parameter \"?%s\"", textToStr(textOf(yylval))); return buffer; #endif case VAROP : case VARID : case CONOP : case CONID : sprintf(buffer,"symbol \"%s\"", textToStr(textOf(yylval))); return buffer; case QVAROP : case QVARID : case QCONOP : case QCONID : sprintf(buffer,"symbol \"%s\"", identToStr(yylval)); return buffer; case HIDING : return "symbol \"hiding\""; case QUALIFIED : return "symbol \"qualified\""; case ASMOD : return "symbol \"as\""; case NUMLIT : return "numeric literal"; case CHARLIT : return "character literal"; case STRINGLIT : return "string literal"; case IMPLIES : return "`=>'"; default : return "token"; } } static Cell local checkPrec(p) /* Check for valid precedence value*/ Cell p; { if (!isInt(p) || intOf(p)MAX_PREC) { ERRMSG(row) "Precedence value must be an integer in the range [%d..%d]", MIN_PREC, MAX_PREC EEND; } return p; } static Cell local buildTuple(tup) /* build tuple (x1,...,xn) from */ List tup; { /* list [xn,...,x1] */ Int n = 0; Cell t = tup; Cell x; do { /* . . */ x = fst(t); /* / \ / \ */ fst(t) = snd(t); /* xn . . xn */ snd(t) = x; /* . ===> . */ x = t; /* . . */ t = fun(x); /* . . */ n++; /* / \ / \ */ } while (nonNull(t)); /* x1 NIL (n) x1 */ fst(x) = mkTuple(n); return tup; } static List local checkCtxt(con) /* validate context */ Type con; { mapOver(checkPred, con); return con; } static Cell local checkPred(c) /* check that type expr is a valid */ Cell c; { /* constraint */ Cell cn = getHead(c); #if TREX if (isExt(cn) && argCount==1) return c; #endif #if IPARAM if (isIP(cn)) return c; #endif if (!isQCon(cn) /*|| argCount==0*/) syntaxError("class expression"); return c; } static Pair local checkDo(dqs) /* convert reversed list of dquals */ List dqs; { /* to an (expr,quals) pair */ if (isNull(dqs) || whatIs(hd(dqs))!=DOQUAL) { ERRMSG(row) "Last generator in do {...} must be an expression" EEND; } fst(dqs) = snd(fst(dqs)); /* put expression in fst of pair */ snd(dqs) = rev(snd(dqs)); /* & reversed list of quals in snd */ return dqs; } #if MUDO static Pair local checkMDo(dqs) /* convert reversed list of dquals */ List dqs; { /* to an (expr,quals) pair */ if (isNull(dqs) || whatIs(hd(dqs))!=DOQUAL) { ERRMSG(row) "Last generator in mdo {...} must be an expression" EEND; } fst(dqs) = snd(fst(dqs)); /* put expression in fst of pair */ snd(dqs) = rev(snd(dqs)); /* & reversed list of quals in snd */ return dqs; } #endif static Cell local checkTyLhs(c) /* check that lhs is of the form */ Cell c; { /* T a1 ... a */ Cell tlhs = c; while (isAp(tlhs) && whatIs(arg(tlhs))==VARIDCELL) { tlhs = fun(tlhs); } if (whatIs(tlhs)!=CONIDCELL) { ERRMSG(row) "Illegal left hand side in data type declaration" EEND; } return c; } static Cell local checkConstr(c) /* check that data constructor has */ Cell c; { /* an unqualified conid as head */ Cell chd = c; while (isAp(chd)) { chd = fun(chd); } if (whatIs(chd)==QUALIDENT) { ERRMSG(row) "Qualified constructor in data type declaration" EEND; } return c; } #if !TREX static Void local noTREX(where) String where; { ERRMSG(row) "Attempt to use TREX records while parsing %s.\n", where ETHEN ERRTEXT "(TREX is disabled in this build of Hugs)" EEND; } #endif #if !IPARAM static Void local noIP(where) String where; { ERRMSG(row) "Attempt to use Implicit Parameters while parsing %s.\n", where ETHEN ERRTEXT "(Implicit Parameters are disabled in this build of Hugs)" EEND; } #endif #if !MUDO /*** Due to the way we implement this stuff, this function will actually never be called. When MUDO is not defined, the lexer thinks that mdo is just another identifier, and hence the MDO token is never returned to the parser: consequently the mdo production is never reduced, making this code unreachable. The alternative is to let the lexer to recognize "mdo" all the time, but that's not Haskell compliant. In any case we keep this function here, even if just for documentation purposes. ***/ static Void local noMDo(where) String where; { ERRMSG(row) "Attempt to use MDO while parsing %s.\n", where ETHEN ERRTEXT "(Recursive monadic bindings are disabled in this build of Hugs)" EEND; } #endif /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/platform.h.in0000644006511100651110000000162710135735550016166 0ustar rossross/* * @configure_input@ * configure-sussed platform #defines. */ #ifndef __PLATFORM_H__ #define __PLATFORM_H__ #define HostPlatform @HostPlatform_CPP@ #define TargetPlatform @TargetPlatform_CPP@ #define BuildPlatform @BuildPlatform_CPP@ /* Definitions suitable for use in CPP conditionals */ #define @HostPlatform_CPP@_HOST 1 #define @TargetPlatform_CPP@_TARGET 1 #define @BuildPlatform_CPP@_BUILD 1 #define @HostArch_CPP@_HOST_ARCH 1 #define @TargetArch_CPP@_TARGET_ARCH 1 #define @BuildArch_CPP@_BUILD_ARCH 1 #define @HostOS_CPP@_HOST_OS 1 #define @TargetOS_CPP@_TARGET_OS 1 #define @BuildOS_CPP@_BUILD_OS 1 /* Definitions of strings for use in C or Haskell code */ #define HOST_ARCH "@HostArch_CPP@" #define TARGET_ARCH "@TargetArch_CPP@" #define BUILD_ARCH "@BuildArch_CPP@" #define HOST_OS "@HostOS_CPP@" #define TARGET_OS "@TargetOS_CPP@" #define BUILD_OS "@BuildOS_CPP@" #endif /* __PLATFORM_H__ */ hugs98-plus-Sep2006/src/plugin.c0000644006511100651110000000340107747453512015230 0ustar rossross/* -------------------------------------------------------------------------- * Statically linked plugins * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: plugin.c,v $ * $Revision: 1.10 $ * $Date: 2003/10/28 11:47:22 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" /* This file is often compiled with a command-line argument such as * '-DPLUGINS={"Xlib",initXlib},' * default to empty if not present. */ #ifndef PLUGINS # define PLUGINS #endif struct pluginInfo { String nm; /* Name of plugin module */ InitModuleFun5 initModule; /* Initialisation code for the plugin */ }; static struct pluginInfo pluginList[] = { /* hardwired list of all plugins */ /* {"Test", initTest}, */ /* {"Xlib", initXlib}, */ PLUGINS {0,0} }; Bool havePlugin(mod) /* can we statically link this plugin? */ String mod; { /* (called when each module is loaded) */ Int i; for(i=0; pluginList[i].nm; ++i) { if (0 == strcmp(mod, pluginList[i].nm)) { (*pluginList[i].initModule)(hugsAPI5()); return TRUE; } } return FALSE; } /* -------------------------------------------------------------------------- * Plugins control: * ------------------------------------------------------------------------*/ Void plugins(what) Int what; { } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/preds.c0000644006511100651110000007356107750763467015074 0ustar rossross/* -------------------------------------------------------------------------- * Part of the type checker dealing with predicates and entailment * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: preds.c,v $ * $Revision: 1.36 $ * $Date: 2003/11/01 17:02:47 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Cell local assumeEvid Args((Cell,Int)); #if IPARAM static Cell local findIPEvid Args((Text)); static Void local removeIPEvid Args((Text)); #endif static List local makePredAss Args((List,Int)); static List local copyPreds Args((List)); static Void local qualify Args((List,Cell)); static Void local qualifyBinding Args((List,Cell)); static Cell local qualifyExpr Args((Int,List,Cell)); static Void local overEvid Args((Cell,Cell)); static Void local cutoffExceeded Args((Cell,Int,List)); static Cell local scFind Args((Cell,Cell,Int,Cell,Int,Int)); static Cell local scEntail Args((List,Cell,Int,Int)); static Cell local entail Args((List,Cell,Int,Int)); static Cell local inEntail Args((List,Cell,Int,Int)); #if MULTI_INST static Cell local inEntails Args((List,Cell,Int,Int)); static Bool local instCompare Args((Inst, Inst)); #endif #if TREX static Cell local lacksNorm Args((Type,Int,Cell)); #endif static List local scSimplify Args((List)); static Void local elimTauts Args((Void)); static Bool local anyGenerics Args((Type,Int)); static List local elimOuterPreds Args((List)); static List local elimPredsUsing Args((List,List)); static Void local reducePreds Args((Void)); static Void local normPreds Args((Int)); static Bool local resolveDefs Args((List,Bool)); static Bool local resolveVar Args((Int,Bool)); static Class local classConstraining Args((Int,Cell,Int)); #if MULTI_INST static Bool local instComp_ Args((Inst,Inst)); #endif /* -------------------------------------------------------------------------- * Predicate assignments: * * A predicate assignment is represented by a list of triples (pi,o,ev) * where o is the offset for types in pi, with evidence required at the * node pointed to by ev (which is taken as a dictionary parameter if * no other evidence is available). Note that the ev node will be * overwritten at a later stage if evidence for that predicate is found * subsequently. * ------------------------------------------------------------------------*/ static List preds; /* Current predicate assignment */ static Cell local assumeEvid(pi,o) /* Add predicate pi (offset o) to */ Cell pi; /* preds with new dict var nd */ Int o; { Cell nd = inventDictVar(); preds = cons(triple(pi,mkInt(o),nd),preds); return nd; } #if IPARAM static Cell local findIPEvid(t) Text t; { List ps = preds; for (; nonNull(ps); ps=tl(ps)) { Cell p = hd(ps); if (ipMatch(fst3(p), t)) return p; } return NIL; } static Void local removeIPEvid(t) Text t; { List ps = preds; List *prev = &preds; for (; nonNull(ps); ps = tl(ps)) if (ipMatch(fst3(hd(ps)), t)) { *prev = tl(ps); return; } else { prev = &tl(ps); } } #endif static List local makePredAss(qs,o) /* Make list of predicate assumps. */ List qs; /* from qs (offset o), w/ new dict */ Int o; { /* vars for each predicate */ List result = NIL; for (; nonNull(qs); qs=tl(qs)) result = cons(triple(hd(qs),mkInt(o),inventDictVar()),result); return rev(result); } static List local copyPreds(qs) /* Copy list of predicates */ List qs; { List result = NIL; for (; nonNull(qs); qs=tl(qs)) { Cell pi = hd(qs); result = cons(copyPred(fst3(pi),intOf(snd3(pi))),result); } return rev(result); } static Void local qualify(qs,alt) /* Add extra dictionary args to */ List qs; /* qualify alt by predicates in qs */ Cell alt; { /* :: ([Pat],Rhs) */ List ds; for (ds=NIL; nonNull(qs); qs=tl(qs)) ds = cons(thd3(hd(qs)),ds); fst(alt) = revOnto(ds,fst(alt)); } static Void local qualifyBinding(qs,b) /* Add extra dict args to each */ List qs; /* alternative in function binding */ Cell b ; { if (!isVar(fst(b))) /* check for function binding */ internal("qualifyBinding"); map1Proc(qualify,qs,snd(snd(b))); } static Cell local qualifyExpr(l,ps,e) /* Add dictionary params to expr */ Int l; List ps; Cell e; { if (nonNull(ps)) { /* Qualify input expression with */ if (whatIs(e)!=LAMBDA) /* additional dictionary params */ e = ap(LAMBDA,pair(NIL,pair(mkInt(l),e))); qualify(ps,snd(e)); } return e; } static Void local overEvid(dv,ev) /* Overwrite dict var dv with */ Cell dv; /* evidence ev */ Cell ev; { fst(dv) = nameInd; snd(dv) = ev; } /* -------------------------------------------------------------------------- * Predicate entailment: * * Entailment plays a prominent role in the theory of qualified types, and * so, unsurprisingly, in the implementation too. For practical reasons, * we break down entailment into two pieces. The first, scEntail, uses * only the information provided by class declarations, while the second, * entail, also uses the information in instance declarations. * * scEntail uses the following auxiliary function to do its work: * * scFind (e : pi') pi : Find evidence for predicate pi using only * equality of predicates, superclass entailment, * and the evidence e for pi'. * * scFind (e : pi') pi = * * if pi = pi' then * return e * * if (pi.class.level < pi'.class.level) * get superclass entailment pi' ||- P * for each (sc, pi0) in P * if (ev := scFind (sc e : pi0) pi) /= NIL * return ev * * return NIL * * This code assumes that the class hierarchy is acyclic, and that * each class has been assigned a `level', which is its height in * the hierachy. The first of the assumptions guarantees that the * algorithm will terminate. The comparison of levels is an * optimization that cuts down the search space: given that superclass * entailments can only be used to descend the hierarchy, there is no * way we can reach a higher level than the one that we start with, * and hence there is no point in looking if we reach such a position. * * scEntail extends scFind to work on whole predicate assignments: * * scEntail P pi : Find evidence for predicate pi using the evidence * provided by the predicate assignment P, and using * only superclass entailments. * * scEntail P pi = * * for each (v:pi') in P * if (ev := scFind (v:pi') pi) /= NIL * return ev; * return NIL * * ------------------------------------------------------------------------*/ Int cutoff = 40; /* Used to limit depth of recursion*/ static Void local cutoffExceeded(pi,o,ps) Cell pi; /* Display error msg when cutoff */ Int o; List ps; { clearMarks(); ERRMSG(0) "\n*** The type checker has reached the cutoff limit while trying to\n" ETHEN ERRTEXT "*** determine whether:\n*** " ETHEN ERRPRED(copyPred(pi,o)); ps = copyPreds(ps); ERRTEXT "\n*** can be deduced from:\n*** " ETHEN ERRCONTEXT(ps); ERRTEXT "\n*** This may indicate that the problem is undecidable. However,\n" ETHEN ERRTEXT "*** you may still try to increase the cutoff limit using the -c\n" ETHEN ERRTEXT "*** option and then try again. (The current setting is -c%d)\n", cutoff EEND; } static Cell local scFind(e,pi1,o1,pi,o,d)/* Use superclass entailment to */ Cell e; /* find evidence for (pi,o) using */ Cell pi1; /* the evidence e for (pi1,o1). */ Int o1; Cell pi; Int o; Int d; { Class h1 = getHead(pi1); Class h = getHead(pi); Cell ev = NIL; if (samePred(pi1,o1,pi,o)) return e; if (isClass(h1) && (!isClass(h) || cclass(h).level= cutoff) cutoffExceeded(pi,o,ps); for (; nonNull(ps); ps=tl(ps)) { Cell pi1 = hd(ps); Cell ev = scFind(thd3(pi1),fst3(pi1),intOf(snd3(pi1)),pi,o,d); if (nonNull(ev)) return ev; } return NIL; } /* -------------------------------------------------------------------------- * Now we reach the main entailment routine: * * entail P pi : Find evidence for predicate pi using the evidence * provided by the predicate assignment P. * * entail P pi = * * if (ev := scEntail P pi) /= NIL * return ev; * * if there is an instance entailment i : Q ||- pi * for each pi' in Q * if (ev := entail P pi') /= NIL * i := ap(i,ev) * else * return NIL * return i * * return NIL; * * The form of evidence expressions produced by scEntail can be described * by the grammar: * * e = v | sc e (v = evidence var, sc = superclass sel) * * while entail extends this to include dictionary expressions given by: * * d = e | mki d1 ... dn (mki = dictionary constructor) * * A full grammar for evidence expressions is: * * d = v | sc d | mki d1 ... dn * * and this includes evidence expressions of the form sc (mki d1 ... dn) * that can never be produced by either of the entail functions described * above. This is good, from a practical perspective, because t means * that we won't waste effort building a dictionary (mki d1 ... dn) only * to extract just one superclass component and throw the rest away. * Moreover, conditions on instance decls already guarantee that any * expression of this form can be rewritten in the form mki' d1' ... dn'. * (Minor point: they don't guarantee that such rewritings will lead to * smaller terms, and hence to termination. However, we have already * accepted the benefits of an undecidable entailment relation over * guarantees of termination, and this additional quirk is unlikely * to cause any further concern, except in pathological cases.) * ------------------------------------------------------------------------*/ static Cell local entail(ps,pi,o,d) /* Calc evidence for (pi,o) from ps*/ List ps; /* Uses superclasses, equality, */ Cell pi; /* tautology, and construction */ Int o; Int d; { Cell ev = NIL; #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) { int i; for (i = 0; i < d; i++) fputc(' ', stdout); fputs("entail: ", stdout); printContext(stdout,copyPreds(ps)); fputs(" ||- ", stdout); printPred(stdout, copyPred(pi, o)); fputc('\n', stdout); } #endif ev = scEntail(ps,pi,o,d); if (nonNull(ev)) { #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) { int i; for (i = 0; i < d; i++) fputc(' ', stdout); fputs("scSat.\n", stdout); } #endif } else { ev = #if MULTI_INST multiInstRes ? inEntails(ps,pi,o,d) : inEntail(ps,pi,o,d); #else inEntail(ps,pi,o,d); #endif #if EXPLAIN_INSTANCE_RESOLUTION if (nonNull(ev) && showInstRes) { int i; for (i = 0; i < d; i++) fputc(' ', stdout); fputs("inSat.\n", stdout); } #endif } return ev; } static Cell local inEntail(ps,pi,o,d) /* Calc evidence for (pi,o) from ps*/ List ps; /* using a top-level instance */ Cell pi; /* entailment */ Int o; Int d; { #if EXPLAIN_INSTANCE_RESOLUTION int i; #endif Inst in; if (d++ >= cutoff) cutoffExceeded(pi,o,ps); #if TREX if (isAp(pi) && isExt(fun(pi))) { /* Lacks predicates */ Cell e = fun(pi); Cell l; l = lacksNorm(arg(pi),o,e); if (isNull(l) || isInt(l)) return l; else { List qs = ps; for (; nonNull(qs); qs=tl(qs)) { Cell qi = fst3(hd(qs)); if (isAp(qi) && fun(qi)==e) { Cell lq = lacksNorm(arg(qi),intOf(snd3(hd(qs))),e); if (isAp(lq) && intOf(fst(l))==intOf(fst(lq))) { Int f = intOf(snd(l)) - intOf(snd(lq)); return (f==0) ? thd3(hd(qs)) : ap2(nameAddEv, mkInt(f), thd3(hd(qs))); } } } return NIL; } } else { #endif in = findInstFor(pi,o); /* Class predicates */ if (nonNull(in)) { Int beta = typeOff; Cell e = inst(in).builder; List es = inst(in).specifics; List fs = NIL; for (; nonNull(es); es=tl(es)) fs = cons(triple(hd(es),mkInt(beta),NIL),fs); fs = rev(fs); improve(0,ps,fs); #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) { for (i = 0; i < d; i++) fputc(' ', stdout); fputs("try ", stdout); printContext(stdout, copyPreds(fs)); fputs(" => ", stdout); printPred(stdout, copyPred(inst(in).head,beta)); fputc('\n', stdout); } #endif for (es=inst(in).specifics; nonNull(es); es=tl(es)) { Cell ev; improve1(0,ps,hd(es),beta); ev = entail(ps,hd(es),beta,d); if (nonNull(ev)) e = ap(e,ev); else return NIL; } return e; } #if EXPLAIN_INSTANCE_RESOLUTION else { if (showInstRes) { for (i = 0; i < d; i++) fputc(' ', stdout); fputs("No instance found for ", stdout); printPred(stdout, copyPred(pi, o)); fputc('\n', stdout); } } #endif return NIL; #if TREX } #endif } #if MULTI_INST static Cell local inEntails(ps,pi,o,d) /* Calc evidence for (pi,o) from ps*/ List ps; /* using a top-level instance */ Cell pi; /* entailment */ Int o; Int d; { #if EXPLAIN_INSTANCE_RESOLUTION int i; #endif int k = 0; Cell ins; /* Class predicates */ Inst in, in_; Cell e_; if (d++ >= cutoff) cutoffExceeded(pi,o,ps); #if TREX if (isAp(pi) && isExt(fun(pi))) { /* Lacks predicates */ Cell e = fun(pi); Cell l; l = lacksNorm(arg(pi),o,e); if (isNull(l) || isInt(l)) return l; else { List qs = ps; for (; nonNull(qs); qs=tl(qs)) { Cell qi = fst3(hd(qs)); if (isAp(qi) && fun(qi)==e) { Cell lq = lacksNorm(arg(qi),intOf(snd3(hd(qs))),e); if (isAp(lq) && intOf(fst(l))==intOf(fst(lq))) { Int f = intOf(snd(l)) - intOf(snd(lq)); return (f==0) ? thd3(hd(qs)) : ap2(nameAddEv, mkInt(f), thd3(hd(qs))); } } } return NIL; } } else { #endif #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) { for (i = 0; i < d; i++) fputc(' ', stdout); fputs("inEntails: ", stdout); printContext(stdout,copyPreds(ps)); fputs(" ||- ", stdout); printPred(stdout, copyPred(pi, o)); fputc('\n', stdout); } #endif ins = findInstsFor(pi,o); for (; nonNull(ins); ins=tl(ins)) { in = snd(hd(ins)); if (nonNull(in)) { Int beta = fst(hd(ins)); Cell e = inst(in).builder; Cell es = inst(in).specifics; #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) { for (i = 0; i < d; i++) fputc(' ', stdout); fputs("try ", stdout); printContext(stdout, es); fputs(" => ", stdout); printPred(stdout, inst(in).head); fputc('\n', stdout); } #endif for (; nonNull(es); es=tl(es)) { Cell ev = entail(ps,hd(es),beta,d); if (nonNull(ev)) e = ap(e,ev); else { e = NIL; break; } } #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) for (i = 0; i < d; i++) fputc(' ', stdout); #endif if (nonNull(e)) { #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) fprintf(stdout, "Sat\n"); #endif if (k > 0) { if (instCompare (in_, in)) { ERRMSG(0) "Multiple satisfiable instances for " ETHEN ERRPRED(copyPred(pi, o)); ERRTEXT "\nin_ " ETHEN ERRPRED(inst(in_).head); ERRTEXT "\nin " ETHEN ERRPRED(inst(in).head); ERRTEXT "\n" EEND; } } if (k++ == 0) { e_ = e; in_ = in; } continue; } else { #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) fprintf(stdout, "not Sat\n"); #endif continue; } } #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) { for (i = 0; i < d; i++) fputc(' ', stdout); fprintf(stdout, "not Sat.\n"); } #endif } if (k > 0) return e_; #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) { for (i = 0; i < d; i++) fputc(' ', stdout); fprintf(stdout, "all not Sat.\n"); } #endif return NIL; #if TREX } #endif } static Bool local instComp_(ia,ib) /* See if ia is an instance of ib */ Inst ia, ib;{ Int alpha = newKindedVars(inst(ia).kinds); Int beta = newKindedVars(inst(ib).kinds); return matchPred(inst(ia).head,alpha,inst(ib).head,beta); } static Bool local instCompare (ia, ib) Inst ia, ib; { return instComp_(ia, ib) && instComp_(ib, ia); } #endif Cell provePred(ks,ps,pi) /* Find evidence for predicate pi */ Kinds ks; /* assuming ps. If ps is null, */ List ps; /* then we get to decide whether */ Cell pi; { /* is tautological, and we can use */ Int beta; /* the evidence as a dictionary. */ Cell ev; emptySubstitution(); beta = newKindedVars(ks); /* (ks provides kinds for any */ ps = makePredAss(ps,beta); /* vars that appear in pi.) */ ev = entail(ps,pi,beta,0); emptySubstitution(); return ev; } Cell resolvePred(ks,pi) /* Find evidence for predicate pi. */ Kinds ks; /* Unlike `provePred', also uses */ Cell pi; { /* desparate measures like context */ Int beta; /* reduction and defaulting. */ List qs; emptySubstitution(); beta = newKindedVars(ks); qs = makePredAss(cons(pi,NIL),beta); preds = qs; elimTauts(); if (resolveDefs(NIL,TRUE)) elimTauts(); emptySubstitution(); return (nonNull(preds) ? NIL : thd3(hd(qs))); } #if TREX static Cell local lacksNorm(t,o,e) /* Normalize lacks pred (t,o)\l */ Type t; /* returning NIL (unsatisfiable), */ Int o; /* Int (tautological) or pair (v,a)*/ Cell e; { /* such that, if e is evid for v\l,*/ Text l = extText(e); /* then (e+a) is evid for (t,o)\l. */ Int a = 0; for (;;) { Tyvar *tyv; deRef(tyv,t,o); if (tyv) return pair(mkInt(tyvNum(tyv)),mkInt(a)); else { Cell h = getDerefHead(t,o); if (h==typeNoRow && argCount==0) return mkInt(a); else if (isExt(h) && argCount==2) { Text l1 = extText(h); if (l1==l) return NIL; else if (strcmp(textToStr(l1),textToStr(l))<0) a++; t = arg(t); } else return NIL; } } } #endif /* -------------------------------------------------------------------------- * Predicate set Simplification: * * Calculate a minimal equivalent subset of a given set of predicates. * ------------------------------------------------------------------------*/ static List local scSimplify(qs) /* Simplify predicates in qs, */ List qs; { /* returning equiv minimal subset */ Int n = length(qs); while (0=tycon(h).arity) { expandSyn(h,a,&t,&o); return anyGenerics(t,o); } else { Tyvar* tyv; for (; 0offs == FIXED_TYVAR) { numFixedVars++; return FALSE; } else return TRUE; else return FALSE; } } static List local elimOuterPreds(sps) /* Simplify and defer any remaining*/ List sps; { /* preds that contain no generics. */ List qs = NIL; elimTauts(); for (preds=scSimplify(preds); nonNull(preds); ) { Cell pi = hd(preds); Cell nx = tl(preds); if (anyGenerics(fst3(pi),intOf(snd3(pi))) || !isAp(fst3(pi)) || isIP(fun(fst3(pi)))) { tl(preds) = qs; /* Retain predicate*/ qs = preds; } else { /* Defer predicate */ tl(preds) = sps; sps = preds; } preds = nx; } preds = qs; return sps; } static List local elimPredsUsing(ps,sps)/* Try to discharge or defer preds,*/ List ps; /* splitting if necessary to match */ List sps; { /* context ps. sps = savePreds. */ List rems = NIL; while (nonNull(preds)) { /* Pick a predicate from preds */ Cell p = preds; Cell pi = fst3(hd(p)); Int o = intOf(snd3(hd(p))); Cell ev = entail(ps,pi,o,0); preds = tl(preds); if (nonNull(ev)) { /* Discharge if ps ||- (pi,o) */ overEvid(thd3(hd(p)),ev); } else if (!isAp(pi) || isIP(fun(pi)) || !anyGenerics(pi,o)) { tl(p) = sps; /* Defer if no generics */ sps = p; } else { /* Try to split generics and fixed */ Inst in; if (numFixedVars>0 && nonNull(in=findInstFor(pi,o))) { List qs = inst(in).specifics; for (ev=inst(in).builder; nonNull(qs); qs=tl(qs)) ev = ap(ev,assumeEvid(hd(qs),typeOff)); overEvid(thd3(hd(p)),ev); } else { /* No worthwhile progress possible */ tl(p) = rems; rems = p; } } } preds = rems; /* Return any remaining predicates */ return sps; } static Void local reducePreds() { /* Context reduce predicates: uggh!*/ List rems = NIL; /* (A last resort for defaulting) */ while (nonNull(preds)) { /* Pick a predicate from preds */ Cell p = preds; Cell pi = fst3(hd(p)); Int o = intOf(snd3(hd(p))); Inst in = NIL; #if MULTI_INST List ins = NIL; if (multiInstRes) { ins = findInstsFor(pi,o); in = nonNull(ins) && isNull(tl(ins)) ? snd(hd(ins)) : NIL; } else #endif in = findInstFor(pi,o); preds = tl(preds); if (nonNull(in)) { List qs = inst(in).specifics; Cell ev = inst(in).builder; for (; nonNull(qs); qs=tl(qs)) ev = ap(ev,assumeEvid(hd(qs),typeOff)); overEvid(thd3(hd(p)),ev); } else { /* No worthwhile progress possible */ tl(p) = rems; rems = p; } } preds = scSimplify(rems); /* Return any remaining predicates */ } static Void local normPreds(line) /* Normalize each element of preds */ Int line; { /* in some appropriate manner */ #if TREX List ps = preds; List pr = NIL; while (nonNull(ps)) { Cell pi = fst3(hd(ps)); Cell ev = thd3(hd(ps)); if (isAp(pi) && isExt(fun(pi))) { Cell r = lacksNorm(arg(pi),intOf(snd3(hd(ps))),fun(pi)); if (isNull(r)) { ERRMSG(line) "Cannot satisfy constraint " ETHEN ERRPRED(copyPred(pi,intOf(snd3(hd(ps))))); ERRTEXT "\n" EEND; } else if (isInt(r)) { overEvid(ev,r); ps = tl(ps); if (isNull(pr)) preds = ps; else tl(pr) = ps; } else if (intOf(snd(r))!=0) { Cell nd = inventDictVar(); Cell ev1 = ap2(nameAddEv,snd(r),nd); pi = ap(fun(pi),aVar); hd(ps) = triple(pi,fst(r),nd); overEvid(ev,ev1); pr = ps; ps = tl(ps); } else { fst3(hd(ps)) = ap(fun(pi),fst(r)); pr = ps; ps = tl(ps); } } else { pr = ps; ps = tl(ps); } } #endif } /* -------------------------------------------------------------------------- * Mechanisms for dealing with defaults: * ------------------------------------------------------------------------*/ static Bool local resolveDefs(vs,interactive)/* Attempt to resolve defaults */ List vs; /* for variables vs subject to */ Bool interactive; { /* constraints in preds */ List pvs = NIL; List qs = preds; Bool defaulted = FALSE; #if DEBUG_DEFAULTS Printf("Attempt to resolve variables "); printExp(stdout,vs); Printf(" with context "); printContext(stdout,copyPreds(preds)); Printf("\n"); #endif resetGenerics(); /* find type variables in ps */ for (; nonNull(qs); qs=tl(qs)) { Cell pi = fst3(hd(qs)); Int o = intOf(snd3(hd(qs))); for (; isAp(pi); pi=fun(pi)) pvs = genvarType(arg(pi),o,pvs); } for (; nonNull(pvs); pvs=tl(pvs)) { /* now try defaults */ Int vn = intOf(hd(pvs)); #if DEBUG_DEFAULTS Printf("is var %d included in ",vn); printExp(stdout,vs); Printf("?\n"); #endif if (!intIsMember(vn,vs)) defaulted |= resolveVar(vn,interactive); #if DEBUG_DEFAULTS else Printf("Yes, so no ambiguity!\n"); #endif } return defaulted; } static Bool local resolveVar(vn,interactive)/* Determine whether an ambig. */ Int vn; /* variable vn can be resolved */ Bool interactive; { /* by default in the context of */ List ps = preds; List cs = NIL; /* the predicates in ps */ Bool aNumClass = FALSE; if (tyvar(vn)->bound == SKOLEM) return FALSE; /* According to the Haskell definition, we can only default an ambiguous * variable if the set of classes that constrain it: * (a) includes at least one numeric class. * (However if interactive is TRUE, we also allow Show, Eq or Ord) * (b) includes only numeric or standard classes. * In addition, we will not allow a variable to be defaulted unless it * appears only in predicates of the form (Class var). */ #if DEBUG_DEFAULTS Printf("Trying to default variable %d\n",vn); #endif for (; nonNull(ps); ps=tl(ps)) { Cell pi = hd(ps); Class c = classConstraining(vn,fst3(pi),intOf(snd3(pi))); if (nonNull(c)) { if (c==classRealFrac || c==classRealFloat || c==classFractional || c==classFloating || c==classReal || c==classIntegral || c==classNum || (interactive && (c==classEq || c==classOrd || c==classShow))) aNumClass = TRUE; else if (c!=classEq && c!=classOrd && c!=classShow && c!=classRead && c!=classIx && c!=classEnum && c!=classBounded) return FALSE; { Type t = arg(fst3(pi));/* Check for single var as arg */ Int o = intOf(snd3(pi)); Tyvar *tyv; deRef(tyv,t,o); if (!tyv || tyvNum(tyv)!=vn) return FALSE; } if (!cellIsMember(c,cs)) cs = cons(c,cs); } } /* Now find the first class (if any) in the list of defaults that * is an instance of all of the required classes. * * If we get this far, then cs only mentions classes from the list * above, all of which have only a single parameter of kind *. */ if (aNumClass) { List ds = defaultDefns; /* N.B. guaranteed to be monotypes */ #if DEBUG_DEFAULTS Printf("Default conditions met, looking for type\n"); #endif for (; nonNull(ds); ds=tl(ds)) { List cs1 = cs; while (nonNull(cs1) && nonNull(entail(NIL,ap(hd(cs1),hd(ds)),0,0))) cs1 = tl(cs1); if (isNull(cs1)) { bindTv(vn,hd(ds),0); #if DEBUG_DEFAULTS Printf("Default type for variable %d is ",vn); printType(stdout,hd(ds)); Printf("\n"); #endif return TRUE; } } } #if DEBUG_DEFAULTS Printf("No default permitted/found\n"); #endif return FALSE; } static Class local classConstraining(vn,pi,o) Int vn; /* Return class constraining var*/ Cell pi; /* vn in predicate pi, or NIL if*/ Int o; { /* vn is not involved */ for (; isAp(pi); pi=fun(pi)) if (!doesntOccurIn(tyvar(vn),arg(pi),o)) return getHead(pi); return NIL; } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/prelude.h0000644006511100651110000006333610310675474015405 0ustar rossross/* -------------------------------------------------------------------------- * Basic data type definitions, prototypes and standard macros including * machine dependent variations... * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: prelude.h,v $ * $Revision: 1.80 $ * $Date: 2005/09/11 00:33:00 $ * ------------------------------------------------------------------------*/ #ifndef __PRELUDE_H__ #define __PRELUDE_H__ #include "config.h" #include "options.h" #include #if HAVE_STDLIB_H # include #endif #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif /*--------------------------------------------------------------------------- * Most of the configuration code from earlier versions of Hugs has been moved * into config.h (which is usually automatically generated). * * Most of the configuration code is "feature based". That is, the * configure script looks to see if a particular feature (or misfeature) * is present on the compiler/OS. * * A small amount of configuration code is still "system based": it tests * flags to determine what kind of compiler/system it's running on - from * which it infers what features the compiler/system has. Use of system * based tests generally indicates that we can't remember/figure out * what the original problem was and so we can't add an appropriate feature * test to the configure script. *-------------------------------------------------------------------------*/ #ifdef __RISCOS__ /* Acorn DesktopC running RISCOS2 or 3 */ # define RISCOS 1 #else # define RISCOS 0 #endif #if defined __DJGPP__ && __DJGPP__==2 # define DJGPP2 1 #else # define DJGPP2 0 #endif #if defined __MSDOS__ && __MSDOS__ && !DJGPP2 # define DOS 1 #else # define DOS 0 #endif #ifdef __SYMBIAN32__ #define IS_WIN32 0 #define IS_WINDOWS 0 #else #if defined(_WIN32) || defined(__WIN32__) # define IS_WIN32 1 # define IS_WINDOWS 1 #elif defined(_WIN64) # define IS_WIN64 1 # define IS_WINDOWS 1 #else # define IS_WIN32 0 # define IS_WINDOWS 0 #endif #endif /* using a (possibly multi-byte) encoding of Chars in Strings and I/O? */ #if CHAR_ENCODING_LOCALE || CHAR_ENCODING_UTF8 # define CHAR_ENCODING 1 #endif #if defined(_WIN32) || cygwin32_HOST_OS #define STDCALL_SUPPORTED 1 #endif /*--------------------------------------------------------------------------- * Configuration options * * Most configuration options are arguments to the configure script * (try running "configure --help"). The following options are either * experimental or require changes to "Prelude.hs", the standard libraries * and demos and therefore cannot be modified using the configure script. * Most users should leave them alone! * * OBSERVATIONS to include support for `observe' and friends * TREX to include support for Typed Rows and EXtensions. * IPARAM to include support for Implicit Parameters. * MUDO to include support for Recursive-do notation * ZIP_COMP to include support for Zip Comprehensions * MULTI_INST to include support for Multi-Instance Resolution. * HASKELL_ARRAYS to include support for Haskell array primitives. * IO_MONAD to include the IO monad primitives and support. * IO_HANDLES to include the IO file operations. * IO_REFS Ref type for IO_MONAD, and simple operations. * FLUSHEVERY to force a fflush after every char in putStr/hPutStr. * NPLUSK to include support for (n+k) patterns. * BIGNUMS to include support for Integer bignums. * FIXED_SUBST to force a fixed size for the current substitution. * DYN_TABLES to allocate tables dynamically, currently just a memory * saving trick, but this may be extended at a later stage * to allow at least some of the tables to be extended * dynamically at run-time to avoid exhausted space errors. * GC_STABLEPTRS to include support for safely passing Haskell * pointers over to C * (only required if you use callbacks in the foreign * language interface) * GC_MALLOCPTRS to include support for automatic deallocation of * C objects when Haskell is done with them. * GC_WEAKPTRS to include support for weak pointers. * STABLE_NAMES stable names a la Simon PJ * MONAD_COMPS to allow monad comprehensions. * REDIRECT_OUTPUT ability to redirect stdout/stderr to a buffer. * Only necessary for the Hugs server interface * (which is used in the Netscape plugin and the standalone * evaluator). * WORD_OPS to include operations on unsigned ints * ADDR_OPS to include operations on addresses * PROVIDE_INT64 to include 64 bit Ints * SHORT_CIRCUIT_COERCIONS to try to apply these rewrites at runtime: * integerToInt (intToInteger x) -> x * rationalToFloat (fromDouble {dict} x) -> doubleToFloat x * rationalToDouble (fromDouble {dict} x) -> x * FAST_WHATIS to use a macro instead of a func for whatIs(), for speed * FAST_WHATIS1 to use whatIs1(), a faster version of whatIs(), for speed *-------------------------------------------------------------------------*/ #if !HASKELL_98_ONLY #define TREX 1 #define IPARAM 1 #define MUDO 1 #define OBSERVATIONS 1 #define ZIP_COMP 1 #define HERE_DOC 1 #else #define TREX 0 #define IPARAM 0 #define MUDO 0 #define OBSERVATIONS 0 #define ZIP_COMP 0 #define HERE_DOC 0 #endif #define HASKELL_ARRAYS 1 #define IO_MONAD 1 #define IO_HANDLES 1 #define IO_REFS 1 /* Experimental IO Ref type */ #define FLUSHEVERY 1 #define NPLUSK 1 /* Warning: There are those that would prefer 0 */ #define BIGNUMS 1 /* Experimental bignum implementation */ #define FIXED_SUBST 0 /* Warning: This may not be appropriate for PCs */ #define DYN_TABLES SMALL_HUGS /* For dynamically allocated tables */ #define GC_STABLEPTRS 1 /* May be required by external libraries */ #define GC_MALLOCPTRS 1 /* May be required by external libraries */ #define GC_WEAKPTRS 1 #define STABLE_NAMES 1 #define MONAD_COMPS 0 #define REDIRECT_OUTPUT (!HUGS_FOR_WINDOWS) #define WORD_OPS 1 #define ADDR_OPS 1 #define PROVIDE_INT64 1 #define TIME_MODULE 1 #define DIRECTORY_MODULE 1 #define MULTI_LINEFEED 1 /* Platform-independent linefeed handling */ #define MULTI_INST 0 #define WANT_FIXED_SIZE_TABLES 0 /* use fixed-size tables for internal structs */ /* (as opposed to dynamically growable ones) */ #define UNICODE_CHARS 1 /* Char is Unicode (ISO-10646) */ #define SHORT_CIRCUIT_COERCIONS 1 #define FAST_WHATIS 1 #define FAST_WHATIS1 1 /* can only use if FAST_WHATIS is 1 */ /*--------------------------------------------------------------------------- * Platform-dependent settings: *-------------------------------------------------------------------------*/ #if HAVE_MACSYSTEM /* Macintosh system() prototype. */ int macsystem(char *filenames); #endif /*--------------------------------------------------------------------------- * Include stuff required for WinHugs: * mainly redirect get/put console functions * also required API definitions *-------------------------------------------------------------------------*/ #if HUGS_FOR_WINDOWS # include "winhugs/Winhugs.h" #endif /*--------------------------------------------------------------------------- * Macros used in declarations: * function prototypes * local/far declarations * HUGS_noreturn/HUGS_unused (prevent spurious warnings) * result type of main * dynamic linking declarations *-------------------------------------------------------------------------*/ #if PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif /* local = prefix for locally defined functions */ /* far = prefix for far pointers */ #if DOS # define local near pascal #else # define local # define far #endif #ifdef __GNUC__ /* Avoid spurious warnings */ #if __GNUC__ > 2 || __GNUC__ == 2 && __GNUC_MINOR__ >= 7 #define HUGS_noreturn __attribute__ ((noreturn)) #define HUGS_unused __attribute__ ((unused)) #else #define HUGS_noreturn #define HUGS_unused #endif #else #define HUGS_noreturn #define HUGS_unused #endif /*--------------------------------------------------------------------------- * Dynamic linking tricks *-------------------------------------------------------------------------*/ #if 0 /* DLLs, shareable libraries, etc generated by the foreign language * interface generator need some way to access the Hugs stack, standard * constructor functions, the garbage collector, etc. * * Most UNIX systems use the same mechanisms as for static linking - when * you load the shareable object file, it patches it with the values of * the required symbols. * * DOS/Windows uses a different mechanism - a DLL (or EXE) accesses code and * data from other DLLs (or EXEs) via an indirection. No big deal for code * but it makes a huge difference when accessing data and the compiler * _HAS TO KNOW_ whether a piece of data is accessed directly (it's in * the same DLL/EXE) or indirectly. * * On Microsoft Visual C++, this is done using a VC++ specific language * extension on declarations and definitions of all imported/exported * symbols. The "extern" declarations of imported symbols are modified * with "__declspec(dllimport)" and the definitions of exported symbols * are marked with "__declspec(dllexport)". If you want both the * declaration and the definition to coexist in the same file without * generating warning messages, you have to go through contortions. * * We also do this under MinGW, to interoperate with MSVC. * * Sigh, to add to the confusion, MS C and Borland C disagree about whether * to put the export declaration before or after the return type - so we * have to parameterise it to allow both. */ #endif #if defined(__BORLANDC__) # define DLLIMPORT(rty) rty far _import # define DLLEXPORT(rty) rty far _export #elif defined(_WIN32) /* Microsoft Windows */ # define DLLIMPORT(rty) __declspec(dllimport) rty # define DLLEXPORT(rty) __declspec(dllexport) rty #else # define DLLIMPORT(rty) rty # define DLLEXPORT(rty) rty #endif /* Don't need to declare DLL exports */ #ifdef __EXTERNAL #define HUGSAPI(rty) DLLIMPORT(rty) #else #define HUGSAPI(rty) DLLEXPORT(rty) #endif /*--------------------------------------------------------------------------- * String operations: *-------------------------------------------------------------------------*/ #if HAVE_STRING_H # include #else extern int strcmp Args((const char*, const char*)); extern int strncmp Args((const char*, const char*, int)); extern char *strchr Args((const char*, int)); extern char *strrchr Args((const char*, int)); extern size_t strlen Args((const char *)); extern char *strcpy Args((char *, const char*)); extern char *strcat Args((char *, const char*)); #endif #if HAVE_STRCMP #if HUGS_FOR_WINDOWS #define strCompare stricmp #else #define strCompare strcmp #endif #else /* probably only used for DOS - ADR */ extern int stricmp Args((const char *, const char*)); #define strCompare stricmp #endif #if HAVE_CTYPE_H # include #endif #ifndef isascii #define isascii(c) (((unsigned)(c))<128) #endif /*--------------------------------------------------------------------------- * Printf-related operations: *-------------------------------------------------------------------------*/ #if HAVE_STDARG_H #include #else #include #endif #if !HAVE_SNPRINTF # if HAVE__SNPRINTF # define snprintf _snprintf # elif __MWERKS__ && macintosh extern int snprintf Args((char*, unsigned long, const char*, va_list)); # else extern int snprintf Args((char*, size_t, const char*, ...)); # endif #endif #if !HAVE_VSNPRINTF # if __MWERKS__ && macintosh extern int vsnprintf Args((char*, unsigned long, const char*, va_list)); # else extern int vsnprintf Args((char*, size_t, const char*, va_list)); # endif #endif /*--------------------------------------------------------------------------- * Pipe-related operations: * * On Windows, many standard Unix names acquire a leading underscore. * Irritating, but easy to work around. *-------------------------------------------------------------------------*/ #if !HAVE_POPEN && HAVE__POPEN #define popen(x,y) _popen(x,y) #endif #if !HAVE_PCLOSE && HAVE__PCLOSE #define pclose(x) _pclose(x) #endif /*--------------------------------------------------------------------------- * Interrupting execution (signals, allowBreak): *-------------------------------------------------------------------------*/ #if !DOS && VOID_INT_SIGNALS # define sigProto(nm) void nm Args((int)) # define sigRaise(nm) nm(1) # define sigHandler(nm) void nm(sig_arg) int sig_arg; # define sigResume return #else # define sigProto(nm) int nm Args((Void)) # define sigRaise(nm) nm() # define sigHandler(nm) int nm(Void) # define sigResume return 1 #endif /* allowBreak: call to allow user to interrupt computation * ctrlbrk: set control break handler */ /* On Unix (and almost every other system), the interrupt handlers perform * a longjmp to break out of the current computation. * On Win32 this does not work because the interrupt handler is run in * a separate thread from the main computation. Instead we set a * flag (the global variable "broken") to request an interrupt and * all potentially infinite loops of the evaluator check the flag using * the "allowBreak" call. */ #define HANDLERS_CANT_LONGJMP IS_WINDOWS #if DOS # define allowBreak() ; #elif HANDLERS_CANT_LONGJMP /* eg Win32 */ # define ctrlbrk(bh) do { signal(SIGINT,bh); signal(SIGBREAK,bh); } while (0) # define allowBreak() if (broken) { broken = FALSE; sigRaise(breakHandler); } #else /* !DOS && !HANDLERS_CANT_LONGJMP - eg Unix */ # if HAVE_SIGPROCMASK # include # define ctrlbrk(bh) { sigset_t mask; \ signal(SIGINT,bh); \ sigemptyset(&mask); \ sigaddset(&mask, SIGINT); \ sigprocmask(SIG_UNBLOCK, &mask, NULL); \ } # else # define ctrlbrk(bh) signal(SIGINT,bh) # endif #if __MWERKS__ && macintosh # define allowBreak() doNothing() #else # define allowBreak() doNothing() #endif #endif /* !DOS && !HANDLERS_CANT_LONGJMP */ #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */ # define SIGBREAK 21 #endif /*--------------------------------------------------------------------------- * Floating point support *-------------------------------------------------------------------------*/ /* Can we fit floats into ints? */ #define BREAK_FLOATS (SIZEOF_FLOAT > SIZEOF_INT) #if FLOATS_SUPPORTED #define FloatImpType float #define FloatPro double /* type to use in prototypes */ /* strictly ansi (i.e. gcc) conforming */ /* but breaks data hiding :-( */ #define FloatFMT "%.7g" /* Is double too big for two ints? (if so, use float instead) */ #define DOUBLE_IS_FLOAT (SIZEOF_DOUBLE > 2*SIZEOF_INT) #if DOUBLE_IS_FLOAT #define DoubleImpType FloatImpType #define DoublePro FloatPro #define DoubleFMT FloatFMT #else #define DoubleImpType double #define DoublePro double #define DoubleFMT "%.15g" #endif #if HAVE_FLOAT_H #include # define HUGS_FLT_RADIX FLT_RADIX # define HUGS_FLT_MANT_DIG FLT_MANT_DIG # define HUGS_FLT_MIN_EXP FLT_MIN_EXP # define HUGS_FLT_MAX_EXP FLT_MAX_EXP #if DOUBLE_IS_FLOAT # define HUGS_DBL_MANT_DIG HUGS_FLT_MANT_DIG # define HUGS_DBL_MIN_EXP HUGS_FLT_MIN_EXP # define HUGS_DBL_MAX_EXP HUGS_FLT_MAX_EXP #else # define HUGS_DBL_MANT_DIG DBL_MANT_DIG # define HUGS_DBL_MIN_EXP DBL_MIN_EXP # define HUGS_DBL_MAX_EXP DBL_MAX_EXP #endif #elif HAVE_VALUES_H #include # define HUGS_FLT_RADIX _EXPBASE # define HUGS_FLT_MANT_DIG FSIGNIF # define HUGS_FLT_MIN_EXP FMINEXP # define HUGS_FLT_MAX_EXP FMAXEXP #if DOUBLE_IS_FLOAT # define HUGS_DBL_MANT_DIG HUGS_FLT_MANT_DIG # define HUGS_DBL_MIN_EXP HUGS_FLT_MIN_EXP # define HUGS_DBL_MAX_EXP HUGS_FLT_MAX_EXP #else # define HUGS_DBL_MANT_DIG DSIGNIF # define HUGS_DBL_MIN_EXP DMINEXP # define HUGS_DBL_MAX_EXP DMAXEXP #endif #endif #ifdef __SYMBIAN32__ /* Guesswork, really */ #define HUGS_FLT_RADIX 2 #define HUGS_FLT_MANT_DIG 24 #define HUGS_FLT_MIN_EXP -125 #define HUGS_FLT_MAX_EXP 128 #define HUGS_DBL_MANT_DIG 53 #define HUGS_DBL_MIN_EXP -1021 #define HUGS_DBL_MAX_EXP 1024 #endif #else /* !FLOATS_SUPPORTED */ #define FloatImpType int /*dummy*/ #define FloatPro int #define FloatFMT "%d" #define DoubleImpType int /*dummy*/ #define DoublePro int #define DoubleFMT "%d" #endif /* !FLOATS_SUPPORTED */ /*--------------------------------------------------------------------------- * Memory allocation *-------------------------------------------------------------------------*/ #if HAVE_FARCALLOC # include # define farCalloc(n,s) farcalloc((unsigned long)n,(unsigned long)s) #elif HAVE_VALLOC # define farCalloc(n,s) (Void *)valloc(((unsigned)n)*((unsigned)s)) #else # define farCalloc(n,s) (Void *)calloc(((unsigned)n),((unsigned)s)) #endif /* bison-generated parsers like to have alloca - so try to define it */ #if HAVE_ALLOCA_H #include #else # if HAVE__ALLOCA && !defined(__SYMBIAN32__) # include # endif #endif /*--------------------------------------------------------------------------- * Assertions *-------------------------------------------------------------------------*/ #if HAVE_ASSERT_H #include #else #define assert(x) doNothing() #endif /*--------------------------------------------------------------------------- * Preprocessor support *-------------------------------------------------------------------------*/ /* * Note: initially defined as * #define SUPPORT_PREPROCESSOR USE_PREPROCESSOR && (defined(HAVE_POPEN) || defined(HAVE__POPEN)) * * which worked OK with GNU cpp, but MSVC didn't expand the 'defined' correctly. * */ #if USE_PREPROCESSOR # if HAVE_POPEN || HAVE__POPEN # define SUPPORT_PREPROCESSOR 1 # else # define SUPPORT_PREPROCESSOR 0 # endif #else # define SUPPORT_PREPROCESSOR 0 #endif /*--------------------------------------------------------------------------- * Environment variables and the registry *-------------------------------------------------------------------------*/ /* On Win32 we can use the registry to supplement info in environment * variables. */ #define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__) /*--------------------------------------------------------------------------- * File operations: *-------------------------------------------------------------------------*/ #if !HAVE_UNISTD_H && !_MSC_VER extern int chdir Args((const char*)); #endif #if HAVE_DIRECT_H #include #endif #ifndef HAVE_STDLIB_H extern int system Args((const char *)); extern double atof Args((const char *)); extern void exit Args((int)); #endif #ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/ # define FILENAME_MAX 256 #elif FILENAME_MAX < 256 # undef FILENAME_MAX # define FILENAME_MAX 256 #elif FILENAME_MAX > 8192 /* Systems with no limit on path length (e.g. the Hurd), will have */ /* FILENAME_MAX impossibly large. Ideally we should dynamically */ /* allocate/grow these buffers and not use FILENAME_MAX at all. */ # undef FILENAME_MAX # define FILENAME_MAX 8192 #endif /* Hack, hack: if you have dos.h, you probably have a DOS filesystem */ #ifndef __SYMBIAN32__ /* No dos.h but a DOS filesystem */ #define DOS_FILENAMES HAVE_DOS_H #else #define DOS_FILENAMES 1 #endif /* ToDo: can we replace this with a feature test? */ #define MAC_FILENAMES macintosh #define CASE_INSENSITIVE_FILENAMES (DOS_FILENAMES | RISCOS) #if CASE_INSENSITIVE_FILENAMES # if HAVE_STRCASECMP # define filenamecmp(s1,s2) strcasecmp(s1,s2) # elif HAVE__STRICMP # define filenamecmp(s1,s2) _stricmp(s1,s2) # elif HAVE_STRICMP # define filenamecmp(s1,s2) stricmp(s1,s2) # elif HAVE_STRCMPI # define filenamecmp(s1,s2) strcmpi(s1,s2) # endif #else # define filenamecmp(s1,s2) strcmp(s1,s2) #endif /*--------------------------------------------------------------------------- * Optimisations: *-------------------------------------------------------------------------*/ #ifdef __GNUC__ /* look for GCC 2.x extensions */ #if __GNUC__ >= 2 && !defined(NeXT) /* NeXT cc lies and says it's 2.x */ /* WARNING: if you use the following optimisations to assign registers for * particular global variables, you should be very careful to make sure that * storage(RESET) is called after a longjump (usually resulting from an error * condition) and before you try to access the heap. The current version of * main deals with this using everybody(RESET) at the head of the main read, * eval, print loop */ #ifdef m68k /* global registers on an m68k */ #define GLOBALfst asm("a4") #define GLOBALsnd asm("a5") #define GLOBALsp asm("a3") #endif #ifdef sparc /* global registers on a sparc */ /* sadly, although the gcc documentation suggests that the following reg */ /* assignments should be ok, experience shows (at least on Suns) that they */ /* are not -- it seems that atof() and friends spoil things. */ /*#define GLOBALfst asm("g5")*/ /*#define GLOBALsnd asm("g6")*/ /*#define GLOBALsp asm("g7")*/ #endif /* sparc */ #endif #endif /* defined(__GNUC__) */ /*--------------------------------------------------------------------------- * General settings: *-------------------------------------------------------------------------*/ #define Void void /* older compilers object to: typedef void Void; */ #if !defined(_XLIB_H_) /* clashes with similar declaration in Xlib.h */ typedef unsigned Bool; #endif #define TRUE 1 #define FALSE 0 #ifndef _XtIntrinsic_h typedef char *String; #endif typedef int Int; typedef signed char Int8; typedef short Int16; typedef long Long; typedef int Char; typedef unsigned Unsigned; typedef void* Pointer; #define doNothing() do { } while (0) /* Null statement */ #ifndef STD_PRELUDE #if RISCOS #define STD_PRELUDE "prelude" #define STD_PRELUDE_HUGS "hugs.prelude" #define STD_EMPTY_MODULE "hugs.prelude" #else #define STD_PRELUDE "Prelude" #define STD_PRELUDE_HUGS "Hugs.Prelude" #define STD_EMPTY_MODULE "Hugs" #endif #endif #if IO_MONAD #define NUM_HANDLES 40 #endif #define NUM_TUPLES 100 #define NUM_OFFSETS 1024 #define NUM_LAT1_CHARS 256 #if TREX #define NUM_EXT 100 #endif #if PROFILING #define DEF_PROFINTDIV 10 /* hpsize/this cells between samples*/ #endif #if SMALL_HUGS /* the McDonalds mentality :-) */ #define Pick(s,r,l) s #endif #if REGULAR_HUGS #define Pick(s,r,l) r #endif #if LARGE_HUGS #define Pick(s,r,l) l #endif #if OBSERVATIONS #define NUM_OBS_TAGS Pick(100, 200, 1000) #define NUM_BRKPTS Pick(100, 200, 200) #endif #define NUM_SCRIPTS Pick(64, 200, 800) #define NUM_FIXUPS Pick(400, 400, 1000) #define NUM_TYCON Pick(60, 320, 2000) #define NUM_NAME Pick(1000, 4000, 32000) #define NUM_CLASSES Pick(30, 240, 1000) #define NUM_INSTS Pick(200, 400, 4000) #define NUM_TEXT Pick(12000, 20000, 320000) #define NUM_TEXTH Pick(1, 10, 10) #define NUM_TYVARS Pick(800, 2000, 8000) #define NUM_STACK Pick(1800, 16000, 160000) #define NUM_ADDRS Pick(28000, 120000, 1280000) #define MINIMUMHEAP Pick(7500, 19000, 19000) #define MAXIMUMHEAP Pick(32765, 0, 0) #define DEFAULTHEAP Pick(28000, 100000, 1000000) #define MAXPOSINT Pick(0x7fff, 0x7fffffff, 0x7fffffff) #define MAXHUGSWORD Pick(0xffffU, 0xffffffffU, 0xffffffffU) #define NUM_STABLEPTRS Pick(10, 100, 10000) #define NUM_MALLOCPTRS Pick(10, 100, 10000) #ifdef DOTNET #define NUM_DOTNETPTRS Pick(10, 100, 10000) #endif #define NUM_DTUPLES Pick(3, 5, 5) /* Some infinite computations generate an infinite depth of alternations * between eval() and run(). If they don't use the Hugs stack or heap, * they will overrun the C stack, crashing the interpreter. To protect * against this, we place a limit on the depth of recursion of eval(). */ #define MAX_EVAL_DEPTH Pick(1024, 4096, 16384) /* Representation of Integer: requires BIGBASE == 10^BIGEXP */ #define BIGBASE Pick(100, 10000, 10000) #define BIGEXP Pick(2, 4, 4) #define MINNEGINT (-MAXPOSINT-1) #define NUM_MODULE NUM_SCRIPTS #if DYN_TABLES /* Tables may be alloc'd at runtime*/ #define DECTABLE(tab) far *tab /* macros for declaration & defn */ #define DYNDECTABLE(tab) DECTABLE(tab) #define DEFTABLE(tab,sz) far *tab = 0 #else /* or at compile-time: */ #define DECTABLE(tab) tab[] #define DYNDECTABLE(tab) far *tab #define DEFTABLE(tab,sz) tab[sz] #endif #define minRecovery Pick(1000, 1000, 1000) #define bitsPerWord Pick(16, 32, 32) #define wordShift Pick(4, 5, 5) #define wordMask Pick(15, 31, 31) #define bitArraySize(n) ((n)/bitsPerWord + 1) #define placeInSet(n) ((-(n)-1)>>wordShift) #define maskInSet(n) (1<<((-(n)-1)&wordMask)) /*-------------------------------------------------------------------------*/ #endif /* __PRELUDE_H__ */ hugs98-plus-Sep2006/src/printer.c0000644006511100651110000003567010477376640015432 0ustar rossross/* -------------------------------------------------------------------------- * Builtin printer, used as an alternative to overloaded "show", and also * used for certain primitive types. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: printer.c,v $ * $Revision: 1.15 $ * $Date: 2006/09/05 22:43:44 $ * ------------------------------------------------------------------------*/ static Void local printer Args((Name,Int)); static Void local outName Args((Name)); static Void local outVar Args((Name)); static Void local outOp Args((Name)); static Void local outStr Args((String)); static Void local outPr Args((Name,Int,Cell)); static Void local outLPr Args((Name,Cell)); static Void local outException Args((Cell)); static Void local outBadRedex Args((Cell)); static Cell local printDException Args((Cell)); static Cell local printException Args((Cell,Cell)); static Name nameLPrint, nameNLPrint; /* list printing primitives */ static Name nameSPrint, nameNSPrint; /* string printing primitives */ static Cell out; /* GC'd var used by printer code */ #define outCh(c) out = ap(consChar(c),out) #define outSCh(c) outStr(unlexChar(c,'\"')) #define updOutRoot(ss) out = revOnto(out,ss); \ updapRoot(fst(out),snd(out)); \ out = NIL; /* -------------------------------------------------------------------------- * Printer control: * ------------------------------------------------------------------------*/ static Void printerControl Args((Int)); static Void printerControl(what) Int what; { switch (what) { case MARK : mark(out); break; case INSTALL : setCurrModule(modulePrelude); #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePrelude,NIL) pFun(namePrint, "_print", "print"); pFun(nameNPrint, "_nprint", "nprint"); pFun(nameLPrint, "_lprint", "lprint"); pFun(nameNLPrint, "_nlprint", "nlprint"); pFun(nameSPrint, "_sprint", "sprint"); pFun(nameNSPrint, "_nsprint", "nsprint"); #undef pFun /* deliberate fall through */ case RESET : out = NIL; break; } } PROTO_PRIM(primPrint); PROTO_PRIM(primBPrint); PROTO_PRIM(primNPrint); PROTO_PRIM(primLPrint); PROTO_PRIM(primNLPrint); PROTO_PRIM(primSPrint); PROTO_PRIM(primNSPrint); static struct primitive printerPrimTable[] = { {"print", 3, primPrint}, {"nprint", 3, primNPrint}, {"lprint", 2, primLPrint}, {"nlprint", 2, primNLPrint}, {"sprint", 2, primSPrint}, {"nsprint", 2, primNSPrint}, {"primShowsInt", 3, primBPrint}, {"primShowsPtr", 3, primBPrint}, {"primShowsInteger", 3, primBPrint}, {"primShowsFloat", 3, primBPrint}, {"primShowsDouble", 3, primBPrint}, {0, 0, 0} }; static struct primInfo printerPrims = { printerControl, printerPrimTable, 0 }; /*-------------------------------------------------------------------------*/ primFun(primPrint) { /* Evaluate and print term */ Cell temp; /* :: Int->Expr->[Char]->[Char] */ Int d; eval(primArg(3)); d = whnfInt; temp = evalWithNoError(primArg(2)); out = NIL; if (nonNull(temp)) { push(temp); outException(top()); } else printer(namePrint,d); updOutRoot(primArg(1)); } primFun(primBPrint) { /* Eval and print value of basic */ Int d; /* type -- Int, Integer, Float, or */ eval(primArg(3)); /* Double -- as a string. */ d = whnfInt; eval(primArg(2)); /* Differs from primPrint only in */ out = NIL; /* its use of weaker error handling*/ printer(namePrint,d); /* to make showsPrec strict. */ updOutRoot(primArg(1)); } primFun(primNPrint) { /* print term without evaluation */ Int d; /* :: Int->Expr->[Char]->[Char] */ eval(primArg(3)); d = whnfInt; unwind(primArg(2)); out = NIL; printer(nameNPrint,d); updOutRoot(primArg(1)); } static Void local printer(pr,d) /* Main part: primPrint/primNPrint */ Name pr; /* printer to use on components */ Int d; { /* precedence level */ Int used = 0; /* Output, in reverse, to "out" */ allowBreak(); switch(whatIs(whnfHead)) { case NAME : { Syntax sy = syntaxOf(whnfHead); if (!isCfun(whnfHead) || name(whnfHead).arity>whnfArgs) pr = nameNPrint; #ifndef VERBOSE_PRINT /* don't print dictionary arguments */ while (used=2 && sy!=APPLIC) { /* e1+e2 */ Syntax a = assocOf(sy); Int p = precOf(sy); if (whnfArgs-used>2 || d>p) outCh('('); outPr(pr,(a==LEFT_ASS? p:1+p),pushed(used)); used++; outCh(' '); outOp(whnfHead); outCh(' '); outPr(pr,(a==RIGHT_ASS?p:1+p),pushed(used)); used++; if (whnfArgs-used>2 || d>p) outCh(')'); } else /* f ... */ outVar(whnfHead); } break; #if BIGNUMS case NEGNUM : case ZERONUM : case POSNUM : out = rev(bigOut(whnfHead,NIL,d>=UMINUS_PREC)); pr = nameNPrint; break; #endif case INTCELL : { Int digit; if (intOf(whnfHead)<0 && d>=UMINUS_PREC) outCh(')'); do { digit = whnfInt%10; if (digit<0) digit= (-digit); outCh('0'+digit); } while ((whnfInt/=10)!=0); if (intOf(whnfHead)<0) { outCh('-'); if (d>=UMINUS_PREC) outCh('('); } out = rev(out); pr = nameNPrint; } break; case PTRCELL : { Pointer p = ptrOf(whnfHead); char buffer[32]; char spec[16]; /* Fall into line with how GHC shows Addrs */ sprintf(spec,"0x%%.%dx", (SIZEOF_INTP)*2); sprintf(buffer,spec,(long)p); #if 0 /* Old skool */ sprintf(buffer,"%p",p); #endif outStr(buffer); pr = nameNPrint; } break; case TUPLE : { Int tn = tupleOf(whnfHead); Int punc = '('; Int i; used = tn=UMINUS_PREC) outCh('('); outStr(floatToString(whnfFloat)); if (whnfFloat<0.0 && d>=UMINUS_PREC) outCh(')'); pr = nameNPrint; break; case DOUBLECELL:if (whnfDouble<0.0 && d>=UMINUS_PREC) outCh('('); outStr(doubleToString(whnfDouble)); if (whnfDouble<0.0 && d>=UMINUS_PREC) outCh(')'); pr = nameNPrint; break; #if HASKELL_ARRAYS case ARRAY : outStr("{array}"); pr = nameNPrint; break; #endif #if IO_REFS case MUTVAR : outStr("{mutable variable}"); pr = nameNPrint; break; #endif case HUGSOBJECT: outStr("{Cell ...}"); pr = nameNPrint; break; #if TREX case RECORD : outStr("{record}"); pr = nameNPrint; break; #endif #if IO_HANDLES case HANDCELL : outStr("{handle}"); pr = nameNPrint; break; #endif #if OBSERVATIONS case OBSERVE : outStr("printer.c: printer(): OBSERVE"); break; #endif default : internal("Error in graph"); break; } if (used=FUN_PREC) { /* Determine if parens are needed */ out = appendOnto(out,singleton(consChar('('))); outCh(')'); } } } /* -------------------------------------------------------------------------- * List printing primitives: * ------------------------------------------------------------------------*/ primFun(primLPrint) { /* evaluate and print list */ Cell temp = evalWithNoError(primArg(2)); out = NIL; if (nonNull(temp)) { push(temp); outStr("] ++ "); outException(top()); } else if (whnfHead==nameCons && whnfArgs==2) { outCh(','); outPr(namePrint,MIN_PREC,pushed(0)); outLPr(nameLPrint,pushed(1)); } else if (whnfHead==nameNil && whnfArgs==0) outCh(']'); else { outStr("] ++ "); outBadRedex(primArg(2)); } updOutRoot(primArg(1)); } primFun(primNLPrint) { /* print list without evaluation */ unwind(primArg(2)); out = NIL; if (whnfHead==nameCons && whnfArgs==2) { outCh(','); outPr(nameNPrint,MIN_PREC,pushed(0)); outLPr(nameNLPrint,pushed(1)); } else if (whnfHead==nameNil && whnfArgs==0) outCh(']'); else { outStr("] ++ "); outPr(nameNPrint,FUN_PREC-1,primArg(2)); } updOutRoot(primArg(1)); } primFun(primSPrint) { /* evaluate and print string */ Cell temp = evalWithNoError(primArg(2)); out = NIL; if (nonNull(temp)) { push(temp); outStr("\" ++ "); outException(top()); } else if (whnfHead==nameCons && whnfArgs==2) { temp = evalWithNoError(top()); /* primArg(4), primArg(3) contain */ out = NIL; /* the head and tail of list, resp */ if (nonNull(temp)) { push(temp); outStr("\" ++ ["); outException(top()); outLPr(nameLPrint,primArg(3)); } else if (isChar(whnfHead) && whnfArgs==0) { outSCh(charOf(whnfHead)); outLPr(nameSPrint,primArg(3)); } else { outStr("\" ++ ["); outBadRedex(primArg(4)); outLPr(nameLPrint,primArg(3)); } } else if (whnfHead==nameNil && whnfArgs==0) outCh('"'); else { outStr("\" ++ "); outBadRedex(primArg(2)); } updOutRoot(primArg(1)); } primFun(primNSPrint) { /* print string without eval */ unwind(primArg(2)); out = NIL; if (whnfHead==nameCons && whnfArgs==2) { unwind(pushed(0)); if (isChar(whnfHead) && whnfArgs==0) { outSCh(charOf(whnfHead)); outLPr(nameNSPrint,primArg(3)); } else { outStr("\" ++ ["); outPr(nameNPrint,MIN_PREC,primArg(4)); outLPr(nameNLPrint,primArg(3)); } } else if (whnfHead==nameNil && whnfArgs==0) outCh('"'); else { outStr("\" ++ "); outPr(nameNPrint,FUN_PREC-1,primArg(2)); } updOutRoot(primArg(1)); } /* -------------------------------------------------------------------------- * Auxiliary functions for printer(s): * ------------------------------------------------------------------------*/ static Void local outName(nm) /* output nm using parent field if possible */ Name nm; { Cell p = name(nm).parent; switch (whatIs(p)) { #ifdef VERBOSE_PRINT case INSTANCE : outStr("inst"); outStr(textToStr(cclass(inst(p).c).text)); outCh('_'); break; case CLASS : outStr(textToStr(cclass(p).text)); outCh('_'); break; case TYCON : outStr(textToStr(tycon(p).text)); outCh('_'); break; #endif case NAME : outName(p); outCh('_'); break; } outStr(textToStr(name(nm).text)); } static Void local outVar(nm) /* output nm as function symbol */ Name nm; { String s = textToStr(name(nm).text); if ((isascii(*s) && isalpha(*s)) || *s=='_' || *s=='[' || *s=='(') outName(nm); else { outCh('('); outName(nm); outCh(')'); } } static Void local outOp(nm) /* output nm as operator symbol */ Name nm; { String s = textToStr(name(nm).text); if (isascii(s[0]) && isalpha(s[0])) { outCh('`'); outName(nm); outCh('`'); } else outName(nm); } static Void local outStr(s) /* output string s */ String s; { while (*s) outCh(ExtractChar(s)); } static Void local outPr(pr,d,e) /* output expr e with printer pr, */ Name pr; /* precedence d */ Int d; Cell e; { out = ap(NIL,out); fst(out) = ap(NIL,e); fst(fst(out)) = ap(pr,mkInt(d)); } static Void local outLPr(pr,xs) /* output list xs with printer pr */ Name pr; Cell xs; { out = ap(NIL,out); fst(out) = ap(pr,xs); } static Void local outException(ex) /* Produce expr to print exception */ Cell ex; { outCh('{'); if (isAp(ex) && fun(ex)==nameErrorCall) { outStr("error "); outPr(nameNPrint,FUN_PREC,arg(ex)); } else { outStr("throw "); outPr(nameNPrint,FUN_PREC,ex); } outCh('}'); } static Void local outBadRedex(rx) /* Produce expr to print bad redex */ Cell rx; { outCh('{'); outPr(nameNPrint,MIN_PREC,rx); outCh('}'); } static Cell local printDException(ex) /* Produce expression for exception*/ Cell ex; { /* with special handling */ if (isAp(ex) && fun(ex)==nameErrorCall)/* of {error str} exceptions */ return arg(ex); else return printException(ex,nameNil); } static Cell local printException(ex,rs) /* produce expression for exception*/ Cell ex, rs; { out = NIL; outException(ex); return revOnto(out,rs); } Void abandon(what,ex) /* abandon computation */ String what; Cell ex; { push(printDException(ex)); out = NIL; outCh('\n'); outStr(what); outStr(" error: "); top() = revOnto(out,top()); out = NIL; outputString(errorStream); errAbort(); } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/runhugs.c0000644006511100651110000000666010423663404015423 0ustar rossross/* -------------------------------------------------------------------------- * Standalone hugs system * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: runhugs.c,v $ * $Revision: 1.23 $ * $Date: 2006/04/26 12:26:44 $ * ------------------------------------------------------------------------*/ #include #include #define HUGS_SERVER 1 #include "prelude.h" #include "storage.h" #include "connect.h" #include "machdep.h" #include "observe.h" #include "server.h" #if defined(_MSC_VER) && !defined(_MANAGED) #include #endif extern int main Args((int, char**)); static void check Args((void)); static void loadHugs Args((int, char**)); static HugsServerAPI* hugs = 0; static void check() { char* err = hugs->clearError(); if (err) { fprintf(stderr,"runhugs: %s\n",err); fflush(stderr); exit(1); } } static void loadHugs(argc,argv) int argc; char* argv[]; { hugs = initHugsServer(argc,argv); if (NULL == hugs) { fprintf(stderr,"runhugs: Unable to initialise Hugs (%s)\n", lastError); fflush(stderr); exit(1); } hugs->setOutputEnable(0); check(); } /* -------------------------------------------------------------------------- * main * ------------------------------------------------------------------------*/ int main(argc,argv) int argc; char* argv[]; { int exitCode = 0; char** hugs_argv; int hugs_argc; char* progname; progname = argv ? argv[0] : "runhugs"; if (!initSystem()) { fprintf(stderr,"%s: failed to initialize, exiting\n", progname); fflush(stderr); exit(1); } #if __MWERKS__ && macintosh argc = ccommand(&argv); #endif #if defined(FFI_COMPILER) generateFFI = TRUE; #endif /* skip over any option flags before the program name */ { int i = 1; /* ignore first arg - name of this program */ while (i < argc && argv[i] /* paranoia */ && (argv[i][0] == '+' || argv[i][0] == '-') ) { ++i; } hugs_argv = argv; hugs_argc = i; argv += i; argc -= i; } if (argc < 1) { fprintf(stderr,"%s: missing file argument\n",progname); fflush(stderr); exit(1); } #if defined(_MSC_VER) && !defined(_MANAGED) __try { #endif loadHugs(hugs_argc, hugs_argv); #if defined(FFI_COMPILER) /* all arguments following the module name are passed to the C compiler */ { int i; for (i=1; iloadFile(argv[0]); check(); #else /* all arguments following the module name are available via getArgs */ hugs->loadFile(argv[0]); check(); hugs->setHugsArgs(argc,argv); hugs->pushHVal(hugs->compileExpr("Main","main >> return () :: IO ()")); exitCode = hugs->doIO(); check(); #endif #if defined(_MSC_VER) && !defined(_MANAGED) } __except ( ((GetExceptionCode() == EXCEPTION_STACK_OVERFLOW) ? EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) ) { fatal("C stack overflow"); } #endif shutdownHugsServer(hugs); exit(exitCode); return 0;/*NOTUSED*/ } #if WANT_TIMER /* dummy definition: timers are only available in the interpreter */ void updateTimers Args((void)); void updateTimers() {} #endif hugs98-plus-Sep2006/src/scc.c0000644006511100651110000000707607743000210014471 0ustar rossross/* -------------------------------------------------------------------------- * Strongly connected components algorithm for static.c. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: scc.c,v $ * $Revision: 1.5 $ * $Date: 2003/10/14 13:56:24 $ * ------------------------------------------------------------------------*/ #ifndef SCC_C #define SCC_C #define visited(d) (isInt(DEPENDS(d))) /* binding already visited?*/ static Cell daSccs = NIL; static Int daCount; static Int local sccMin Args((Int,Int)); static Int local sccMin(x,y) /* calculate minimum of x,y */ Int x, y; { /* (unless y is zero) */ return (x<=y || y==0) ? x : y; } #endif /* -------------------------------------------------------------------------- * A couple of parts of this program require an algorithm for sorting a list * of values (with some added dependency information) into a list of strongly * connected components in which each value appears before its dependents. * * The algorithm used here is based on those described in: * 1) Robert Tarjan, Depth-first search and Linear Graph Algorithms, * SIAM J COMPUT, vol 1, no 2, June 1972, pp.146-160. * 2) Aho, Hopcroft and Ullman, Design and Analysis of Algorithms, * Addison Wesley, 1972. pp.189-195. * The version used here probably owes most to the latter presentation but * has been modified to simplify the algorithm and improve the use of space. * * This would probably have been a good application for C++ templates ... * ------------------------------------------------------------------------*/ static Int local LOWLINK Args((Cell)); /* local function */ static Int local LOWLINK(v) /* calculate `lowlink' of v */ Cell v; { Int low = daCount; Int dfn = daCount; /* depth first search no. of v */ List ws = DEPENDS(v); /* adjacency list for v */ SETDEPENDS(v,mkInt(daCount++)); /* push v onto stack */ push(v); while (nonNull(ws)) { /* scan adjacency list for v */ Cell w = hd(ws); ws = tl(ws); low = sccMin(low, (visited(w) ? intOf(DEPENDS(w)) : LOWLINK(w))); } if (low == dfn) { /* start a new scc? */ List temp=NIL; do { /* take elements from stack */ SETDEPENDS(top(),mkInt(0)); temp = cons(top(),temp); } while (pop()!=v); daSccs = cons(temp,daSccs); /* make new strongly connected comp*/ } return low; } #ifdef SCC static List local SCC(bs) /* sort list with added dependency */ List bs; { /* info into SCCs */ clearStack(); daSccs = NIL; /* clear current list of SCCs */ for (daCount=1; nonNull(bs); bs=tl(bs)) /* visit each binding */ if (!visited(hd(bs))) LOWLINK(hd(bs)); return rev(daSccs); /* reverse to obtain correct order */ } #endif #ifdef SCC2 /* Two argument version */ static List local SCC2(bs,cs) /* sort lists with added dependency*/ List bs, cs; { /* info into SCCs */ clearStack(); daSccs = NIL; /* clear current list of SCCs */ for (daCount=1; nonNull(bs); bs=tl(bs)) /* visit each binding */ if (!visited(hd(bs))) LOWLINK(hd(bs)); for (; nonNull(cs); cs=tl(cs)) if (!visited(hd(cs))) LOWLINK(hd(cs)); return rev(daSccs); /* reverse to obtain correct order */ } #endif /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/script.c0000644006511100651110000002664310320517456015240 0ustar rossross/* * Maintaining a stack of files / scripts. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * */ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "machdep.h" #include "opts.h" #include "strutil.h" #include "script.h" /* -------------------------------------------------------------------------- * Local script state: * ------------------------------------------------------------------------*/ /* * The scripts that either have been loaded or will be later are all * stored in fixed-size stacks. (Moving to growable tables will also * require making the module table expandable.) */ struct strScript { String fileName; /* Script file name */ String realName; /* Full path to canonical name */ String directory; /* Directory module was found in */ Time lastChange; /* Time of last change to script */ Bool postponed; /* Indicates postponed load */ Bool chased; /* Added by import chasing? */ }; static struct strScript scriptTable[NUM_SCRIPTS]; static Int numScripts; /* Number of scripts loaded */ static Int namesUpto; /* Number of script names set */ static Int scriptsStable; /* Number of (Prelude) scripts */ /* considered 'stable' */ /* (=> won't be nuked when clearing */ /* the script stack / reloading.) */ static Bool needsImports; /* set to TRUE if imports required */ String scriptFile; /* Name of current script (if any) */ /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Bool local addScript Args((String,Long)); static Void local freeScript Args((Int)); /* -------------------------------------------------------------------------- * Initialising / freeing script stacks: * ------------------------------------------------------------------------*/ Void initScripts() { scriptFile = 0; numScripts = 0; namesUpto = 0; scriptsStable = 0; } Void stopScripts() { int i; for (i=0; i < numScripts ; i++) freeScript(i); } static Void local freeScript(i) Int i; { if (scriptTable[i].fileName) free(scriptTable[i].fileName); if (scriptTable[i].realName) free(scriptTable[i].realName); if (scriptTable[i].directory) free(scriptTable[i].directory); } /* We record the number of scripts that loading the Prelude * brought about, so that when the user comes to clear the module * stack (e.g., ":l"), only modules later than the Prelude * ones are scratched. */ Void setScriptStableMark() { scriptsStable = namesUpto; } String getScriptName(s) /* access the script name at index 's' */ Script s; { if ( s >=0 && s <= numScripts ) { return scriptTable[s].fileName; } else { ERRMSG(0) "getScriptName: Illegal script index %d (max: %d)", s, numScripts EEND; } return NULL; } String getScriptRealName(s) /* access the path of script at index 's' */ Script s; { if ( s >=0 && s <= numScripts ) { return scriptTable[s].realName; } else { ERRMSG(0) "getScriptRealName: Illegal script index %d (max: %d)", s, numScripts EEND; } return NULL; } Int getScriptHwMark() { /* return number of on the stack, loaded or not. */ return namesUpto; } Int numLoadedScripts() { /* return number of currently loaded scripts */ return numScripts; } #if HUGS_FOR_WINDOWS /* UI pokes around the script stack, give it access... */ Void setNumLoadedScripts(s) Script s; { numScripts=s; } Void setScriptHwMark(s) Script s; { namesUpto = s; } Void setScriptName(s,scr) Script s; String scr; { scriptTable[s].fileName = scr; } Void setScriptRealName(s,scr) Script s; String scr; { scriptTable[s].realName = scr; } #endif /* -------------------------------------------------------------------------- * Loading script files: * ------------------------------------------------------------------------*/ Void addScriptName(s,sch) /* Add script to list of scripts */ String s; /* to be read in ... */ Bool sch; { /* TRUE => requires pathname search*/ if (namesUpto>=NUM_SCRIPTS) { ERRMSG(0) "Too many module files (maximum of %d allowed)", NUM_SCRIPTS EEND; return; } if (sch) { if (isModuleId(s)) { String location = findMPathname(s); if (!location) { ERRMSG(0) "Can't find module \"%s\"", s EEND; } scriptTable[namesUpto].fileName = strCopy(location); scriptTable[namesUpto].directory = NULL; } else { scriptTable[namesUpto].fileName = strCopy(findPathname(s)); scriptTable[namesUpto].directory = dirname(scriptTable[namesUpto].fileName); } } else { scriptTable[namesUpto].fileName = strCopy(s); scriptTable[namesUpto].directory = NULL; } scriptTable[namesUpto].realName = strCopy(RealPath(scriptTable[namesUpto].fileName)); scriptTable[namesUpto].chased = !sch; namesUpto++; } static Bool local addScript(fname,len) /* read single script file */ String fname; /* name of script file */ Long len; { /* length of script file */ #if HUGS_FOR_WINDOWS /* Set clock cursor while loading */ allowBreak(); SetCursor(LoadCursor(NULL, IDC_WAIT)); #endif if (!quiet) { Printf("Reading file \"%s\":\n",fname); FlushStdout(); } setLastEdit(fname,0); needsImports = FALSE; scriptFile = 0; if (!parseScript(fname,len)) { /* process script file */ /* file or parse error, drop the script */ forgetAScript(numScripts); errFail(); } if (needsImports) return FALSE; checkDefns(); typeCheckDefns(); compileDefns(); scriptFile = 0; preludeLoaded = TRUE; return TRUE; } Bool chase(imps) /* Process list of import requests */ List imps; { Int origPos = numScripts; /* keep track of original position */ String origDir = scriptTable[origPos].directory; for (; nonNull(imps); imps=tl(imps)) { String modname = textToStr(textOf(hd(imps))); String iname = NULL; String rname; Bool inOrigDir = FALSE; Int i = 0; if (origDir) { iname = findMInDir(origDir,modname); if (iname) inOrigDir = TRUE; } if (iname == NULL) iname = findMPathname(modname); if (iname == NULL) { ERRMSG(0) "Can't find imported module \"%s\"", modname EEND; } rname = RealPath(iname); for (; i=origPos) { /* Neither loaded or queued */ struct strScript tmpScript; scriptTable[origPos].postponed = TRUE; needsImports = TRUE; if (i>=namesUpto) { /* Name not found (i==namesUpto) */ addScriptName(iname,FALSE); if (inOrigDir) scriptTable[i].directory = strCopy(origDir); } else if (scriptTable[i].postponed) {/* imported by itself? */ ERRMSG(0) "Recursive import dependency between \"%s\" and \"%s\"", scriptTable[origPos].fileName, iname EEND; } /* Right rotate section of tables between numScripts and i so * that i ends up with other imports in front of orig. script */ tmpScript = scriptTable[i]; for (; i>numScripts; i--) scriptTable[i] = scriptTable[i-1]; scriptTable[numScripts] = tmpScript; origPos++; } } return needsImports; } /* -------------------------------------------------------------------------- * Adding scripts found in an argument vector: * ------------------------------------------------------------------------*/ Void addScriptsFromArgs(argc,argv) Int argc; String argv[]; { Int i; #if USE_PREFERENCES_FILE extern Int iniArgc; extern String* iniArgv; if (iniArgc > 0) { /* load additional files found in the preferences file */ for (i=0; inamesUpto) numScripts = scno; } Void forgetAllScripts() { /* Drop all but the stable scripts; i.e., the * Prelude and (possibly) its implementation module(s). */ forgetScriptsFrom( scriptsStable ); } Void forgetAScript(scno) /* remove a script from system */ Script scno; { Script i; if (scno > namesUpto) return; freeScript(scno); for (i=scno+1; i < namesUpto; i++) scriptTable[i-1] = scriptTable[i]; dropAScript(scno); namesUpto--; } Void readScripts(n) /* Reread current list of scripts, */ Int n; { /* loading everything after and */ Time timeStamp; /* including the first script which*/ Long fileSize; /* has been either changed or added*/ #if HUGS_FOR_WINDOWS SetCursor(LoadCursor(NULL, IDC_WAIT)); #endif for (; n0) /* no new script for prelude */ startNewScript(scriptTable[numScripts].fileName); generate_ffi = generateFFI && !scriptTable[numScripts].chased; if (addScript(scriptTable[numScripts].fileName,fileSize)) numScripts++; else dropScriptsFrom(numScripts-1); } if (listScripts) whatScripts(); if (numScripts<=1) setLastEdit((String)0, 0); } Void whatScripts() { /* list scripts in current session */ int i; #if HUGS_FOR_WINDOWS if (!InAutoReloadFiles) { #endif Printf("\nHugs session for:"); for (i=0; i */ /* Define if using alloca.c. */ #undef C_ALLOCA /* Define to empty if the keyword does not work. */ #undef const /* Define to one of _getb67, GETB67, getb67 for Cray-2 and Cray-YMP systems. This function is required for alloca.c support on those systems. */ #undef CRAY_STACKSEG_END /* Define if you have alloca, as a function or macro. */ #define HAVE_ALLOCA 1 /* Define if you have and it should be used (not on Ultrix). */ #define HAVE_ALLOCA_H 0 /* Define if you have that is POSIX.1 compatible. */ #define HAVE_SYS_WAIT_H 1 /* Define as the return type of signal handlers (int or void). */ #define RETSIGTYPE 1 /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ #define STACK_DIRECTION 0 /* Define if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define if you can safely include both and . */ #define TIME_WITH_SYS_TIME 1 /* Define if your declares struct tm. */ #define TM_IN_SYS_TIME 0 /* The following symbols are defined in options.h: * * BYTECODE_PRIMS * CHECK_TAGS * DEBUG_CODE * DEBUG_PRINTER * DONT_PANIC * GIMME_STACK_DUMPS * HUGSDIR * HUGSPATH * HUGSSUFFIXES * HUGS_FOR_WINDOWS * HUGS_VERSION * INTERNAL_PRIMS * LARGE_HUGS * PATH_CANONICALIZATION * PROFILING * REGULAR_HUGS * SMALL_BANNER * SMALL_HUGS * USE_PREPROCESSOR * USE_READLINE * WANT_TIMER */ /* Define if you have malloc.h and it defines _alloca - eg for Visual C++. */ #define HAVE__ALLOCA 1 /* Define if you have /bin/sh */ #define HAVE_BIN_SH 0 /* Define if you have the GetModuleFileName function. */ #define HAVE_GETMODULEFILENAME 0 /* Define if heap profiler can (and should) automatically invoke hp2ps * to convert heap profile (in "profile.hp") to postscript. */ #define HAVE_HP2PS 0 /* Define if compiler supports gcc's "labels as values" (aka computed goto) * feature (which is used to speed up instruction dispatch in the interpreter). * Here's what typical code looks like: * * void *label[] = { &&l1, &&l2 }; * ... * goto *label[i]; * l1: ... * l2: ... * ... */ #ifdef __MARM__ #define HAVE_LABELS_AS_VALUES 1 #else #define HAVE_LABELS_AS_VALUES 0 #endif /* Define if compiler supports prototypes. */ #define PROTOTYPES 1 /* Define if you have the WinExec function. */ #define HAVE_WINEXEC 0 /* Define if jmpbufs can be treated like arrays. * That is, if the following code compiles ok: * * #include * * int test1() { * jmp_buf jb[1]; * jmp_buf *jbp = jb; * return (setjmp(jb[0]) == 0); * } */ #define JMPBUF_ARRAY 1 /* Define if your C compiler inserts underscores before symbol names */ /*#undef LEADING_UNDERSCORE*/ /* Define if signal handlers have type void (*)(int) * (Otherwise, they're assumed to have type int (*)(void).) */ #define VOID_INT_SIGNALS 1 /* The number of bytes in a double. */ #define SIZEOF_DOUBLE 8 /* The number of bytes in a float. */ #define SIZEOF_FLOAT 4 /* The number of bytes in a int. */ #define SIZEOF_INT 4 /* The number of bytes in a int*. */ #define SIZEOF_INTP 4 /* Define if you have the PBHSetVolSync function. */ #undef HAVE_PBHSETVOLSYNC /* Define if you have the _fullpath function. */ #undef HAVE__FULLPATH /* Define if you have the _pclose function. */ #undef HAVE__PCLOSE /* Define if you have the _popen function. */ #undef HAVE__POPEN /* Define if you have the _snprintf function. */ #undef HAVE__SNPRINTF /* Define if you have the _stricmp function. */ #undef HAVE__STRICMP /* Define if you have the _vsnprintf function. */ #undef HAVE__VSNPRINTF /* Define if you have the farcalloc function. */ #undef HAVE_FARCALLOC /* Define if you have the fgetpos function. */ #define HAVE_FGETPOS 1 /* Define if you have the fseek function. */ #define HAVE_FSEEK 1 /* Define if you have the fsetpos function. */ #define HAVE_FSETPOS 1 /* Define if you have the ftell function. */ #define HAVE_FTELL 1 /* Define if you have the macsystem function. */ #undef HAVE_MACSYSTEM /* Define if you have the pclose function. */ /*#undef HAVE_PCLOSE*/ /* Define if you have the poly function. */ #undef HAVE_POLY /* Define if you have the popen function. */ /*#undef HAVE_POPEN*/ /* Define if you have the realpath function. */ #undef HAVE_REALPATH /* Define if you have the sigprocmask function. */ #undef HAVE_SIGPROCMASK /* Define if you have the snprintf function. */ #undef HAVE_SNPRINTF /* Define if you have the stime function. */ #undef HAVE_STIME /* Define if you have the strcasecmp function. */ #define HAVE_STRCASECMP 1 /* Define if you have the strcmp function. */ #define HAVE_STRCMP 1 /* Define if you have the strcmpi function. */ #define HAVE_STRCMPI 0 /* Define if you have the stricmp function. */ #define HAVE_STRICMP 0 /* Define if you have the valloc function. */ #define HAVE_VALLOC 0 /* Define if you have the vsnprintf function. */ #undef HAVE_VSNPRINTF /* Define if you have the header file. */ #undef HAVE_FILES_H /* Define if you have the header file. */ #define HAVE_ASSERT_H 1 /* Define if you have the header file. */ #undef HAVE_CONIO_H /* Define if you have the header file. */ #undef HAVE_CONSOLE_H /* Define if you have the header file. */ #define HAVE_CTYPE_H 1 /* Define if you have the header file. */ #undef HAVE_DL_H /* Define if you have the header file. */ #undef HAVE_DLFCN_H /* Define if you have the header file. */ #undef HAVE_DOS_H /* Define if you have the header file. */ #undef HAVE_ERRNO_H /* Define if you have the header file. */ #define HAVE_FCNTL_H 1 /* Define if you have the header file. */ #define HAVE_FLOAT_H 0 /* Define if you have the header file. */ #undef HAVE_FTW_H /* Define if you have the header file. */ #undef HAVE_IO_H /* Define if you have the header file. */ /*#undef HAVE_NLIST_H*/ /* Define if you have the header file. */ #undef HAVE_PASCAL_H /* Define if you have the header file. */ #undef HAVE_SGTTY_H /* Define if you have the header file. */ #define HAVE_SIGNAL_H 1 /* Define if you have the header file. */ #undef HAVE_STAT_H /* Define if you have the header file. */ #undef HAVE_STD_H /* Define if you have the header file. */ #define HAVE_STDARG_H 1 /* Define if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define if you have the header file. */ #define HAVE_STRING_H 1 /* Define if you have the header file. */ #define HAVE_SYS_IOCTL_H 0 /* Define if you have the header file. */ #define HAVE_SYS_PARAM_H 1 /* Define if you have the header file. */ #define HAVE_SYS_RESOURCE_H 1 /* Define if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define if you have the header file. */ #define HAVE_SYS_TIME_H 1 /* Define if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define if you have the header file. */ #undef HAVE_TERMIO_H /* Define if you have the header file. */ #undef HAVE_TERMIOS_H /* Define if you have the header file. */ #undef HAVE_TIME_H /* Define if you have the header file. */ #define HAVE_UNISTD_H 1 /* Define if you have the header file. */ #define HAVE_VALUES_H 0 /* Define if you have the header file. */ #undef HAVE_WINDOWS_H /* Define if you have the editline library (-leditline). */ #undef HAVE_LIBEDITLINE /* Define if you have the dl library (-ldl). */ #undef HAVE_LIBDL /* Define if you have the dld library (-ldld). */ #undef HAVE_LIBDLD /* Define to 1 if floating point arithmetic is supported. */ #define FLOATS_SUPPORTED 1 /* Define if you have the editline library (-leditline). */ #undef HAVE_LIBREADLINE hugs98-plus-Sep2006/src/epoc/README0000644006511100651110000000230707135625757015403 0ustar rossrossHugs for EPOC ------------- Port by Glenn Strong (Glenn.Strong@cs.tcd.ie) Integrated by Reuben Thomas (rrt@sc3d.org) Hugs for EPOC should be built with the Symbian SDK. This directory contains all the necessary files; after unpacking the source, copy config.h, options.h and hugs.mmp into src/ and then, after copying the hugs98 directory into C:\epoc_code, an incantation of the form makmake hugs.mmp {marm,winc} should make a makefile which you can then use with nmake -f hugs.{marm,winc} If you're using MS VC++ 6.0 introductory edition, you should uncomment the section at the end of hugs.mmp which contains a hack to make things work. To get a slightly smaller ARM build, edit the hugs.marm file and change the -O flag in CFLAGS to -O2. By default, Hugs for EPOC is built without the Hugs extensions; change HASKELL_98_ONLY to 0 in options.h to stop that. The remainder of the files are for building a SIS installation file (demos_readme, eshell_readme, hugs.pkg, readme; you also need the file License from the root of the hugs tree for this). Good luck, and please pester Reuben or Glenn with questions about building, and, in the first instance, for bugs (which are likely to be ours rather than Hugs's). hugs98-plus-Sep2006/src/epoc/demos_readme0000644006511100651110000000010307371566464017063 0ustar rossrossDo you wish to install a set of sample hugs programs (about 100k)? hugs98-plus-Sep2006/src/epoc/epoc.c0000644006511100651110000000102507371566464015612 0ustar rossross/* * Support functions for EPOC. * The EPOC libc is not complete, but that's OK. Here we plug the gaps. * * Glenn Strong */ #include #include #include #include #include /* * Signals are not supported in EPOC, and probably never will be */ _sig_func_ptr signal(int x,_sig_func_ptr y){ return 0; }; /* * convert string to lowercase. * */ void strlwr(char *str){ char *s; for(s=str;*s;s++) if(isupper(*s)) (*s)=(char)tolower(*s); } hugs98-plus-Sep2006/src/epoc/epoc.h0000644006511100651110000000057207371566464015625 0ustar rossross/* * Definitions for Epoc specific support functions * kept here to try to minimise impact on main source * files (hah!) * * Glenn Strong */ #include /* signal() is declared in the Epoc libc, but apparently * not defined. Figure that one out if you can. */ extern _sig_func_ptr signal (int,_sig_func_ptr); extern void strlwr(char *); hugs98-plus-Sep2006/src/epoc/epoc_input.c0000644006511100651110000001602407371566464017036 0ustar rossross#include #include #include #include #include /* * Simplistic input routines for the default EPOC * console. * * Glenn Strong * */ #define NUM_RECORDED_LINES 10 #define KEY_ESC 27 #define KEY_DEL 8 #define KEY_RET 10 #define KEY_SPACE 32 #define ERASE_CHAR() printf("\b \b") /* I presume this is a CONIO.H function, which does an * unbuffered, unechoed getchar() */ char getch(){ char c = (char)getchar(); if (c!=KEY_DEL) ERASE_CHAR(); else printf(" "); /* best we can hope for */ return c; }; static char *old_lines[NUM_RECORDED_LINES]; static current_history = 0; static history_started_flag = 0; static void history_cleanup(void); /* * Take string s and add it to the current command line history. * s is subject to being freed, so we must take a copy of it. */ void add_history(char *s){ int i; /* check exit behaviour */ if(!history_started_flag){ history_started_flag=1; atexit(history_cleanup); } /* cycle the buffer */ if((current_history == (NUM_RECORDED_LINES-1))&& (old_lines[current_history]!=NULL)){ free(old_lines[0]); for(i=0; i=cursor_pos; i--){ b[i+1]=b[i]; /* shuffle up */ } b[cursor_pos]=c; printf("%s",b+cursor_pos); back_up(last_pos-cursor_pos); cursor_pos++; last_pos++; break; } }while(!done); printf("\n"); return b; } static void erase_chars(int num){ back_up(num); print_spaces(num); back_up(num); } static void back_up(int num){ for(;num>0;num--) printf("\b"); } static void print_spaces(int num){ for(;num>0;num--) printf(" "); } /* * * Line editing mode: select lines from history buffer and edit them. * */ #define EDIT_PROMPT "Edit> " static void editline(const char *p, char *b, int *cursor_pos){ char store[MAX_BUFSIZE]; char c; int n, i, done=0, old_cursor_pos = (*cursor_pos); printf("%s",b+(*cursor_pos)); erase_chars(strlen(b)+strlen(p)-1); printf("%s%s",EDIT_PROMPT,b); print_spaces( (strlen(p) - strlen(EDIT_PROMPT) )); back_up( (strlen(p) - strlen(EDIT_PROMPT) )); back_up(strlen(b)-(*cursor_pos)); strcpy(store,b); do{ c = (char)getchar(); ERASE_CHAR(); switch(c){ case KEY_SPACE: if(current_history==0) break; c = (char)('0' + current_history); if(current_history!=(NUM_RECORDED_LINES-1)) c--; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': n = c-'0'; i = strlen(b); if ((n<=current_history)&&(old_lines[n]!=NULL)){ strcpy(b,old_lines[c-'0']); }; erase_chars(strlen(EDIT_PROMPT)+(*cursor_pos)); printf("%s%s",EDIT_PROMPT,b); print_spaces( i-(strlen(b) )); back_up( i - strlen(b) ); (*cursor_pos) = strlen(b); break; case KEY_ESC: printf("\n"); for(i=0;i<=current_history;i++) if(old_lines[i]!=NULL) printf("%d %s\n",i,old_lines[i]); printf("%s%s","Edit>",b); back_up( strlen(b)-(*cursor_pos) ); break; case 'h': if((*cursor_pos) > 0){ printf("%s",(b+(*cursor_pos))); (*cursor_pos)--; back_up(strlen(b)-(*cursor_pos)); } break; case 'l': if((*cursor_pos) < strlen(b)){ printf("%s",(b+(*cursor_pos))); (*cursor_pos)++; back_up(strlen(b)-(*cursor_pos)); } break; case '$': printf("%s",(b+(*cursor_pos))); (*cursor_pos) = strlen(b); break; case '^': printf("%s",(b+(*cursor_pos))); (*cursor_pos)=0; back_up(strlen(b)-(*cursor_pos)); break; case 'D': print_spaces(strlen(b)-(*cursor_pos)); back_up(strlen(b)-(*cursor_pos)); b[*cursor_pos] = '\0'; (*cursor_pos) = strlen(b); break; case 'r': printf("%s",b+(*cursor_pos)); back_up(strlen(b)-(*cursor_pos)); c=getchar(); if(c==KEY_ESC){ printf("%s",b+(*cursor_pos)); back_up(strlen(b)-(*cursor_pos)); }else{ if((*cursor_pos)==strlen(b)) b[(*cursor_pos)+1] = '\0'; b[(*cursor_pos)] = c; back_up(1); printf("%s",b+(*cursor_pos)); back_up(strlen(b)-(*cursor_pos)); } break; case 'q': erase_chars(*cursor_pos); strcpy(b,store); printf("%s\n",b); print_spaces( (*cursor_pos) - (strlen(p)+strlen(b)) ); back_up( (*cursor_pos) - (strlen(p)+strlen(b)+1) ); (*cursor_pos) = old_cursor_pos; done = 1; break; case KEY_RET : done = 1; printf("\n"); break; case '?' : printf("\nCheat sheet for edit mode hack\n"); printf("\tescape\tShow history buffer\n"); printf("\tdigit\tSelect history line\n"); printf("\tspace\tSelect most recent\n"); printf("\treturn\tBack to input mode\n"); printf("\tq \tRevert to input mode\n"); printf("\th \tBack one character\n"); printf("\tl \tForward one character\n"); printf("\t^ \tStart of line\n"); printf("\t$ \tEnd of line\n"); printf("\tD \tDelete to end of line\n"); printf("\tr \tChange current character\n"); printf("%s%s",p,b); break; default : printf("%s",b+(*cursor_pos)); back_up(strlen(b)-(*cursor_pos)); break; } }while(!done); } /* * We allocate some heap space for dealing with the history. * although it's probably not necessary, we want to clean it up */ static void history_cleanup(){ int i; for(i=0;i * */ extern void add_history(char *); extern char *readline(char *); hugs98-plus-Sep2006/src/epoc/eshell_readme0000644006511100651110000000007407371566464017237 0ustar rossrossDo you wish to install ESHELL (the Epoc command line shell) hugs98-plus-Sep2006/src/epoc/hugs.mmp0000644006511100651110000000146307371566464016207 0ustar rossross// // Project file for Hugs98 // TARGET hugs.exe TARGETTYPE exe PROJECT epoc_code SUBPROJECT hugs98\src SOURCE hugs.c storage.c input.c static.c type.c subst.c SOURCE output.c compiler.c machine.c builtin.c plugin.c SOURCE epoc\epoc.c epoc\epoc_input.c SYSTEMINCLUDE \epoc32\include\libc \epoc32\include USERINCLUDE \epoc_code\hugs98\src \epoc_code\hugs98\src\epoc #if defined(MARM) LIBRARY ecrt0.o #else LIBRARY ecrt0.obj #endif LIBRARY estlib.lib euser.lib // EPOCSTACKSIZE 8192 EPOCHEAPSIZE 1024 3145728 //START WINS // This seems to be necessary for builds with // visual C++ 6.0 introductory edition to work properly. // Contains a dummy definition of pfnStdChk() // WIN32_LIBRARY \epoc_code\vc6sup\debug\vc6sup.lib //END hugs98-plus-Sep2006/src/epoc/hugs.pkg0000644006511100651110000001126007371566464016173 0ustar rossross#{"Hugs September 1999"},(0x100051DA),1,5 "\epoc32\release\marm\rel\hugs.exe"-"!:\hugs\hugs.exe" "\epoc32\wins\c\Documents\Hugs readme"-"!:\hugs\readme" "\Epoc32\wins\c\Documents\Hugs_License"-"!:\hugs\LICENSE" ; Libs "..\..\lib\Array.hs"-"!:\Hugs\Lib\Array.hs" "..\..\lib\Char.hs"-"!:\Hugs\Lib\Char.hs" "..\..\lib\Complex.hs"-"!:\Hugs\Lib\Complex.hs" "..\..\lib\IO.hs"-"!:\Hugs\Lib\IO.hs" "..\..\lib\Ix.hs"-"!:\Hugs\Lib\Ix.hs" "..\..\lib\List.hs"-"!:\Hugs\Lib\List.hs" "..\..\lib\Locale.lhs"-"!:\Hugs\Lib\Locale.lhs" "..\..\lib\Maybe.hs"-"!:\Hugs\Lib\Maybe.hs" "..\..\lib\Monad.hs"-"!:\Hugs\Lib\Monad.hs" "..\..\lib\Numeric.hs"-"!:\Hugs\Lib\Numeric.hs" "..\..\lib\Prelude.hs"-"!:\Hugs\Lib\Prelude.hs" "..\..\lib\Random.hs"-"!:\Hugs\Lib\Random.hs" "..\..\lib\Ratio.hs"-"!:\Hugs\Lib\Ratio.hs" "..\..\lib\System.hs"-"!:\Hugs\Lib\System.hs" "..\..\lib\exts\Addr.hs"-"!:\Hugs\Lib\exts\Addr.hs" "..\..\lib\exts\Bits.hs"-"!:\Hugs\Lib\exts\Bits.hs" "..\..\lib\exts\Channel.lhs"-"!:\Hugs\Lib\exts\Channel.lhs" "..\..\lib\exts\ChannelVar.lhs"-"!:\Hugs\Lib\exts\ChannelVar.lhs" "..\..\lib\exts\ConcBase.hs"-"!:\Hugs\Lib\exts\ConcBase.hs" "..\..\lib\exts\Concurrent.lhs"-"!:\Hugs\Lib\exts\Concurrent.lhs" "..\..\lib\exts\Dynamic.lhs"-"!:\Hugs\Lib\exts\Dynamic.lhs" "..\..\lib\exts\Foreign.hs"-"!:\Hugs\Lib\exts\Foreign.hs" "..\..\lib\exts\GetOpt.lhs"-"!:\Hugs\Lib\exts\Getopt.lhs" "..\..\lib\exts\Int.hs"-"!:\Hugs\Lib\exts\Int.hs" "..\..\lib\exts\IOExts.hs"-"!:\Hugs\Lib\exts\IOExts.hs" "..\..\lib\exts\LazyST.hs"-"!:\Hugs\Lib\exts\LazyST.hs" "..\..\lib\exts\Memo.hs"-"!:\Hugs\Lib\exts\Memo.hs" "..\..\lib\exts\NumExts.hs"-"!:\Hugs\Lib\exts\NumExts.hs" "..\..\lib\exts\Pretty.lhs"-"!:\Hugs\Lib\exts\Pretty.lhs" "..\..\lib\exts\SampleVar.lhs"-"!:\Hugs\Lib\exts\SampleVar.lhs" "..\..\lib\exts\Semaphore.lhs"-"!:\Hugs\Lib\exts\Semaphore.lhs" "..\..\lib\exts\ST.hs"-"!:\Hugs\Lib\exts\ST.hs" "..\..\lib\exts\Stable.hs"-"!:\Hugs\Lib\exts\Stable.hs" "..\..\lib\exts\Weak.hs"-"!:\Hugs\Lib\exts\Weak.hs" "..\..\lib\exts\Word.hs"-"!:\Hugs\Lib\exts\Word.hs" "..\..\lib\hugs\AnsiInteract.hs"-"!:\Hugs\Lib\hugs\AnsiInteract.hs" "..\..\lib\hugs\AnsiScreen.hs"-"!:\Hugs\Lib\hugs\AnsiScreen.hs" "..\..\lib\hugs\CVHAssert.hs"-"!:\Hugs\Lib\hugs\CVHAssert.hs" "..\..\lib\hugs\GenericPrint.hs"-"!:\Hugs\Lib\hugs\GenericPrint.hs" "..\..\lib\hugs\HugsDynamic.hs"-"!:\Hugs\Lib\hugs\HugsDynamic.hs" "..\..\lib\hugs\HugsInternals.hs"-"!:\Hugs\Lib\hugs\HugsInternals.hs" "..\..\lib\hugs\HugsLibs.hs"-"!:\Hugs\Lib\hugs\HugsLibs.hs" "..\..\lib\hugs\Interact.hs"-"!:\Hugs\Lib\hugs\Interact.hs" "..\..\lib\hugs\IOExtensions.hs"-"!:\Hugs\Lib\hugs\IOExtensions.hs" "..\..\lib\hugs\ListUtils.hs"-"!:\Hugs\Lib\hugs\ListUtils.hs" "..\..\lib\hugs\Number.hs"-"!:\Hugs\Lib\hugs\Number.hs" "..\..\lib\hugs\OldWeak.hs"-"!:\Hugs\Lib\hugs\OldWeak.hs" "..\..\lib\hugs\ParseLib.hs"-"!:\Hugs\Lib\hugs\ParseLib.hs" "..\..\lib\hugs\Sequence.hs"-"!:\Hugs\Lib\hugs\Sequence.hs" "..\..\lib\hugs\StdLibs.hs"-"!:\Hugs\Lib\hugs\StdLibs.hs" "..\..\lib\hugs\Trace.hs"-"!:\Hugs\Lib\hugs\Trace.hs" "..\..\lib\hugs\Trex.hs"-"!:\Hugs\Lib\hugs\Trex.hs" ; Demos options "demos_readme"-"",FT,TA "..\..\demos\AnsiDemo.hs"-"!:\Hugs\Demos\AnsiDemo.hs" "..\..\demos\ArrayEx.hs"-"!:\Hugs\Demos\ArrayEx.hs" "..\..\demos\Calendar.hs"-"!:\Hugs\Demos\Calendar.hs" "..\..\demos\CommaInt.lhs"-"!:\Hugs\Demos\CommaInt.lhs" "..\..\demos\Demos.hs"-"!:\Hugs\Demos\Demos.hs" "..\..\demos\Eliza.hs"-"!:\Hugs\Demos\Eliza.hs" "..\..\demos\EvalRed.hs"-"!:\Hugs\Demos\EvalRed.hs" "..\..\demos\Examples.hs"-"!:\Hugs\Demos\Examples.hs" "..\..\demos\Expr.hs"-"!:\Hugs\Demos\Expr.hs" "..\..\demos\FastSort.hs"-"!:\Hugs\Demos\FastSort.hs" "..\..\demos\Gofer.hs"-"!:\Hugs\Demos\Gofer.hs" "..\..\demos\Lattice.hs"-"!:\Hugs\Demos\Lattice.hs" "..\..\demos\Ldfs.hs"-"!:\Hugs\Demos\Ldfs.hs" "..\..\demos\Literate.lhs"-"!:\Hugs\Demos\Literate.lhs" "..\..\demos\Matrix.hs"-"!:\Hugs\Demos\Matrix.hs" "..\..\demos\Mersenne.hs"-"!:\Hugs\Demos\Mersenne.hs" "..\..\demos\Minsrand.hs"-"!:\Hugs\Demos\Minsrand.hs" "..\..\demos\Queens.hs"-"!:\Hugs\Demos\Queens.hs" "..\..\demos\Say.hs"-"!:\Hugs\Demos\Say.hs" "..\..\demos\Stack.hs"-"!:\Hugs\Demos\Stack.hs" "..\..\demos\Tree.hs"-"!:\Hugs\Demos\Tree.hs" "..\..\demos\prolog\AndorraEngine.hs"-"!:\Hugs\Demos\prolog\AndorraEngine.hs" "..\..\demos\prolog\CombParse.hs"-"!:\Hugs\Demos\prolog\CombParse.hs" "..\..\demos\prolog\Main.hs"-"!:\Hugs\Demos\prolog\Main.hs" "..\..\demos\prolog\Prolog.hs"-"!:\Hugs\Demos\prolog\Prolog.hs" "..\..\demos\prolog\PureEngine.hs"-"!:\Hugs\Demos\prolog\PureEngine.hs" "..\..\demos\prolog\StackEngine.hs"-"!:\Hugs\Demos\prolog\StackEngine.hs" "..\..\demos\prolog\Subst.hs"-"!:\Hugs\Demos\prolog\Subst.hs" "..\..\demos\prolog\readme"-"!:\Hugs\Demos\prolog\readme" "..\..\demos\prolog\stdlib"-"!:\Hugs\Demos\prolog\stdlib" hugs98-plus-Sep2006/src/epoc/options.h0000644006511100651110000002076410426134734016361 0ustar rossross/* -------------------------------------------------------------------------- * Configuration options * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: options.h,v $ * $Revision: 1.14 $ * $Date: 2006/05/03 14:10:36 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Configuration created manually for Epoc * by Glenn Strong * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Hugs paths and directories * ------------------------------------------------------------------------*/ /* Define this as the default setting of HUGSPATH. * Value may contain string "{Hugs}" (for which we will substitute the * value of HUGSDIR) and should be either colon-separated (Unix) * or semicolon-separated (Macintosh, Windows, DOS). Escape * characters in the path string are interpreted according to normal * Haskell conventions. * * This value can be overridden from the command line by setting the * HUGSFLAGS environment variable or by storing an appropriate value * for HUGSFLAGS in the registry (Win32 only). In all cases, use a * string of the form -P"...". */ #define HUGSPATH ".;{Hugs}\\packages\\*" /* The list of suffixes used by Haskell source files, separated either * by colons (Unix) or semicolons (Macintosh, Windows, DOS). * * This value can be overridden using the -S flag. */ #define HUGSSUFFIXES ".hs;.lhs" /* The directory name which is substituted for the string "{Hugs}" * in a path variable. This normally points to where the Hugs libraries * are installed - ie so that the file HUGSDIR/lib/Prelude.hs exists * Typical values are: * "/usr/local/lib/hugs" * "/usr/homes/JFHaskell/hugs" * ".." * * This value is ignored on Windows and Macintosh versions since * it is assumed that the binary is installed in HUGSDIR. * * This value cannot be overridden from the command line or by using * environment variables. This isn't quite as limiting as you'd think * since you can always choose _not_ to use the {Hugs} variable - however, * it's obviously _nicer_ to have it set correctly. */ #ifndef HUGSDIR #define HUGSDIR "?:\\hugs" #endif /* -------------------------------------------------------------------------- * User interface options * ------------------------------------------------------------------------*/ /* Define if you want to use the "Hugs for Windows" GUI. * (Windows 3.1 and compatibles only) */ #define HUGS_FOR_WINDOWS 0 /* Define if you want filenames to be converted to normal form by: * o replacing relative pathnames with absolute pathnames and * eliminating .. and . where possible. * o converting to lower case (only in case-insensitive filesystems) */ #define PATH_CANONICALIZATION 0 /* Define if you want path entries ending in / to be recursively * searched for Haskell code. */ #define SEARCH_DIR 0 /* Not ready yet! */ /* Define if a command line editor is available and should be used. * There are two choices of command line editor that can be used with Hugs: * GNU readline and editline (from comp.sources.misc, vol 31, issue 71) */ #define USE_READLINE 1 /* Define if you want the small startup banner. */ #define SMALL_BANNER 0 /* -------------------------------------------------------------------------- * Making Hugs smaller * ------------------------------------------------------------------------*/ /* Define one of these to select overall size of Hugs * SMALL_HUGS for 16 bit operation on a limited memory PC. * REGULAR_HUGS for 32 bit operation using largish default table sizes. * LARGE_HUGS for 32 bit operation using larger default table sizes. */ #define SMALL_HUGS 0 #define REGULAR_HUGS 1 #define LARGE_HUGS 0 /* -------------------------------------------------------------------------- * Fancy features * ------------------------------------------------------------------------*/ /* Define to omit Hugs extensions */ #define HASKELL_98_ONLY 1 /* Define if :xplain should be enabled */ #define EXPLAIN_INSTANCE_RESOLUTION 0 /* Define if heap profiling should be used */ #define PROFILING 0 /* Define if you want to run Haskell code through a preprocessor * * Note that there's the import chasing mechanism will not spot any * #includes so you must :load (not :reload) if you change any * (non-Haskell) configurations files. */ #define USE_PREPROCESSOR 0 /* Define if you want to time every evaluation. * * Timing is included in the Hugs distribution for the purpose of benchmarking * the Hugs interpreter, comparing its performance across a variety of * different machines, and with other systems for similar languages. * * It would be somewhat foolish to try to use the timings produced in this * way for any other purpose. In particular, using timings to compare the * performance of different versions of an algorithm is likely to give very * misleading results. The current implementation of Hugs as an interpreter, * without any significant optimizations, means that there are much more * significant overheads than can be accounted for by small variations in * Hugs code. */ #undef WANT_TIMER /* * By default, the Hugs Server API wraps up each value pushed on the stack * as a Dynamic, achieving some run-time type safety when applying these * arguments to a function. This Dynamic layer sometimes gets in the way * for low-level consumers of the Server API (e.g, HaskellScript, Lambada, * mod_haskell), so by setting NO_DYNAMIC_TYPES to 1 you turn off the * use of Dynamics (and assume all the responsibility of debugging any * bad crashes you might see as a result!) */ /* #undef NO_DYNAMIC_TYPES */ /* -------------------------------------------------------------------------- * Debugging options (intended for use by maintainers) * ------------------------------------------------------------------------*/ /* Define if debugging generated bytecodes or the bytecode interpreter */ #define DEBUG_CODE 0 /* Define if debugging generated supercombinator definitions or compiler */ #define DEBUG_SHOWSC 0 /* Define if you want to use a low-level printer from within a debugger */ #define DEBUG_PRINTER 0 /* Define if you want to perform runtime tag-checks as an internal * consistency check. This makes Hugs run very slowly - but is very * effective at detecting and locating subtle bugs. */ #define CHECK_TAGS 0 /* -------------------------------------------------------------------------- * Experimental features * These are likely to disappear/change in future versions and should not * be used by most people.. * ------------------------------------------------------------------------*/ /* Define if you want to use the primitives which let you examine Hugs * internals. */ #define INTERNAL_PRIMS 0 /* Define if you want to use the primitives which let you examine Hugs * bytecodes (requires INTERNAL_PRIMS). */ #define BYTECODE_PRIMS 0 /* In a plain Hugs system, most signals (SIGBUS, SIGTERM, etc) indicate * some kind of error in Hugs - or maybe a stack overflow. Rather than * just crash, Hugs catches these errors and returns to the main loop. * It does this by calling a function "panic" which longjmp's back to the * main loop. * If you're developing a GreenCard library, this may not be the right * behaviour - it's better if Hugs leaves them for your debugger to * catch rather than trapping them and "panicing". */ #define DONT_PANIC 0 /* If you get really desperate to understand why your Hugs programs keep * crashing or running out of stack, you might like to set this flag and * recompile Hugs. When you hit a stack error, it will print out a list * of all the objects currently under evaluation. The information isn't * perfect and can be pretty hard to understand but it's better than a * poke in the eye with a blunt stick. * * This is a very experimental feature! */ #define GIMME_STACK_DUMPS 0 /* ----------------------------------------------------------------------- */ hugs98-plus-Sep2006/src/server.c0000644006511100651110000005214110310525202015215 0ustar rossross/* -------------------------------------------------------------------------- * Implementation of the Hugs server API. * * The Hugs server allows you to programmatically load scripts and * build/evaluate terms. Used by 'runhugs' to provide a batch-mode * UI to the interpreter. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: server.c,v $ * $Revision: 1.45 $ * $Date: 2005/09/10 09:42:26 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "script.h" #include "machdep.h" #include "evaluator.h" #include "opts.h" #include "strutil.h" #include "errors.h" #include "server.h" #include static Void setHugsAPI Args((Void)); static Bool SetModule Args((String)); #ifndef NO_DYNAMIC_TYPES static Bool linkDynamic Args((Void)); #endif /* -------------------------------------------------------------------------- * Dynamic linking * * The simplest way to do dynamic linking is this: * 1) load the dll/shared object file * 2) get the address of an initialisation function * from the dll symbol table * 3) call the initialisation function - which returns a "virtual * function table" - a struct containing the addresses of all other * functions and variables that we need to access. * ------------------------------------------------------------------------*/ static Int GetNumScripts Args((Void)); static Void Reset Args((Int)); static Void SetOutputEnable Args((Bool)); static Void ChangeDir Args((String)); static Void LoadProject Args((String)); static Void LoadFile Args((String)); static Void LoadStringF Args((String)); static Void SetOptions Args((String)); static String GetOptions Args((Void)); static HVal CompileExpr Args((String, String)); static Void GarbageCollect Args((void)); static Void LookupName Args((String, String)); static Void MkInt Args((Int)); static Void MkAddr Args((void*)); static Void MkString Args((String)); static Void Apply Args((Void)); static Int EvalInt Args((Void)); static void* EvalAddr Args((void)); static String EvalString Args((Void)); static Int DoIO Args((Void)); static Int DoIO_Int Args((int*)); static Int DoIO_Addr Args((void**)); static HVal PopHVal Args((Void)); static Void PushHVal Args((HVal)); static Void FreeHVal Args((HVal)); static HugsServerAPI hugs; /* virtual function table */ static Void setHugsAPI() { /* initialise virtual function table */ static Bool api_inited = FALSE; if (!api_inited) { api_inited = TRUE; hugs.clearError = ClearError; hugs.setHugsArgs = setHugsArgs; hugs.getNumScripts = GetNumScripts; hugs.reset = Reset; hugs.setOutputEnable = SetOutputEnable; hugs.changeDir = ChangeDir; hugs.loadProject = LoadProject; hugs.loadFile = LoadFile; hugs.loadFromBuffer = LoadStringF; hugs.setOptions = SetOptions; hugs.getOptions = GetOptions; hugs.compileExpr = CompileExpr; hugs.garbageCollect = GarbageCollect; hugs.lookupName = LookupName; hugs.mkInt = MkInt; hugs.mkAddr = MkAddr; hugs.mkString = MkString; hugs.apply = Apply; hugs.evalInt = EvalInt; hugs.evalAddr = EvalAddr; hugs.evalString = EvalString; hugs.doIO = DoIO; hugs.doIO_Int = DoIO_Int; hugs.doIO_Addr = DoIO_Addr; hugs.popHVal = PopHVal; hugs.pushHVal = PushHVal; hugs.freeHVal = FreeHVal; } } /* -------------------------------------------------------------------------- * Error handling * * We buffer error messages and refuse to execute commands until * the error is cleared. * ------------------------------------------------------------------------*/ #define ErrorBufferSize 10000 static char serverErrMsg[ErrorBufferSize]; /* Buffer for error messages */ char* lastError = NULL; String ClearError() { String err = lastError; lastError = NULL; ClearOutputBuffer(); if (err && (numLoadedScripts() > 0)) { everybody(RESET); dropScriptsFrom(numLoadedScripts()-1); /* remove partially loaded scripts */ } return err; } Void setError(s) /* Format an error message */ String s; { Int n = 0; String err = ClearOutputBuffer(); if (NULL == err) { n = snprintf(serverErrMsg, ErrorBufferSize, "%s\n", s); } else { n = snprintf(serverErrMsg, ErrorBufferSize, "%s\n%s\n", s, err); } if (0 <= n && n <= ErrorBufferSize) { lastError = serverErrMsg; } else { lastError = "error buffer overflowed\n"; } } /* All server entry points set CStackBase for the benefit of the (conservative) * GC and do error catching. Any calls to Hugs functions should be "protected" * by being placed inside this macro. * * void entryPoint(arg1, arg2, result) * T1 arg1; * T2 arg2; * T3 *result; * { * protect(doNothing(), * ... * ); * } * * Macro decomposed into BEGIN_PROTECT and END_PROTECT pieces so that i * can be used on some compilers (Mac?) that have limits on the size of * macro arguments. */ #define BEGIN_PROTECT \ if (NULL == lastError) { \ Cell dummy; \ CStackBase = &dummy; /* Save stack base for use in gc */ \ consGC = TRUE; /* conservative GC is the default */ \ if (!setjmp(catch_error)) { #define END_PROTECT \ } else { \ setError("Error occurred"); \ normalTerminal(); \ } \ } #define protect(s) BEGIN_PROTECT s; END_PROTECT /* -------------------------------------------------------------------------- * Initialisation * ------------------------------------------------------------------------*/ /* I've added a special case for the server. Probably should just add another entry point but what the heck. If argc = -1 then the hugs server should NOT read registry or default hugs path stuff. Instead, all options are in the first argument in argv. -- jcp */ DLLEXPORT(HugsServerAPI*) initHugsServer(argc, argv) /*server initialisation*/ Int argc; String argv[]; { static Bool is_initialized = FALSE; if (!is_initialized) { is_initialized = TRUE; setHugsAPI(); BEGIN_PROTECT /* Too much text for protect() */ Int i; startEvaluator(); if (argc == -1) { readOptions(argv[0],FALSE); } else { readOptionSettings(); for (i=1; i= MAXLEN) break; } message[len] = '\0'; setError(message); } static Bool tryEval(Cell c) { Cell temp = evalWithNoError(c); if (nonNull(temp)) { evalError(temp); return FALSE; } else return TRUE; } Bool safeEval(Cell c) { Bool ok; startEval(); ok = tryEval(c); normalTerminal(); return ok; } static Int EvalInt() /* Evaluate a cell (:: Int) */ { Cell d; BEGIN_PROTECT startEval(); #ifndef NO_DYNAMIC_TYPES d = getTypeableDict(typeInt); safeEval(ap(ap(nameCoerceDynamic,d),pop())); #else safeEval(pop()); #endif normalTerminal(); return whnfInt; END_PROTECT return 0; } static void* EvalAddr() /* Evaluate a cell (:: Addr) */ { Cell d; BEGIN_PROTECT startEval(); #ifndef NO_DYNAMIC_TYPES d = getTypeableDict(typeAddr); safeEval(ap(ap(nameCoerceDynamic,d),pop())); #else safeEval(pop()); #endif normalTerminal(); return ptrOf(whnfHead); END_PROTECT return 0; } static String EvalString() /* Evaluate a cell (:: String) */ { Cell d; BEGIN_PROTECT Int len = 0; String s; Bool ok; StackPtr oldsp = sp; startEval(); /* Evaluate spine of list onto stack */ #ifndef NO_DYNAMIC_TYPES d = getTypeableDict(typeString); ok = tryEval(ap(ap(nameCoerceDynamic,d),pop())); #else ok = tryEval(pop()); #endif if (!ok) { sp = oldsp-1; return NULL; } while (whnfHead==nameCons && whnfArgs==2) { Cell e = pop(); Cell es = pop(); len++; push(e); ok = tryEval(es); if (!ok) { sp = oldsp-1; return NULL; } } normalTerminal(); if (whnfHead != nameNil) { setError("evalString: nil expected"); return NULL; } if (sp != oldsp-1+len) { setError("evalString: unbalanced stack1"); return NULL; } /* Pull characters off stack into array */ if (!(s = malloc(len+1))) { setError("Malloc failed in mkString"); return NULL; } s[len] = '\0'; while (--len >= 0) { ok = tryEval(pop()); if (!ok) { sp = oldsp; free(s); return NULL; } s[len] = charOf(whnfHead); } if (sp+1 != oldsp) { setError("evalString: unbalanced stack2"); return NULL; } return s; END_PROTECT return NULL; } static Int DoIO() /* Evaluate a cell (:: IO ()) return exit status */ { BEGIN_PROTECT Int exitCode = 0; Bool ok; StackPtr oldsp = sp; startEval(); #ifndef NO_DYNAMIC_TYPES ok = safeEval(ap(nameIORun,ap(nameRunDyn, pop()))); #else ok = safeEval(ap(nameIORun,pop())); #endif if (!ok) { sp = oldsp-1; exitCode = 1; } else if (whnfHead == nameLeft) { /* Left exitCode -> return exitCode */ safeEval(pop()); exitCode = whnfInt; } else { /* Right void -> return 0 */ drop(); exitCode = 0; /* implicit exit code is 0 */ } normalTerminal(); if (sp != oldsp-1) { setError("doIO: unbalanced stack"); return 1; } return exitCode; END_PROTECT return -1; /* error code */ } /* * Evaluate a cell (:: IO Int) return exit status */ static Int DoIO_Int(int* phval) { BEGIN_PROTECT Int exitCode = 0; Bool ok = TRUE; StackPtr oldsp = sp; startEval(); #ifndef NO_DYNAMIC_TYPES ok = safeEval(ap(nameIORun,ap(nameRunDyn,pop()))); #else ok = safeEval(ap(nameIORun,pop())); #endif if (!ok) { sp = oldsp-1; exitCode = 1; } else if (whnfHead == nameLeft) { safeEval(pop()); exitCode = whnfInt; } else { if (phval) { safeEval(pop()); *phval = whnfInt; } else { drop(); } exitCode = 0; } normalTerminal(); if (sp != oldsp-1) { setError("doIO: unbalanced stack"); return 1; } return exitCode; END_PROTECT; return -1; /* error code */ } /* * Evaluate a cell (:: IO Addr) return exit status */ static Int DoIO_Addr(void** phval) { BEGIN_PROTECT Int exitCode = 0; Bool ok; StackPtr oldsp = sp; startEval(); #ifndef NO_DYNAMIC_TYPES ok = safeEval(ap(nameIORun,ap(nameRunDyn,pop()))); #else ok = safeEval(ap(nameIORun,pop())); #endif if (!ok) { sp = oldsp-1; exitCode = 1; } else if (whnfHead == nameLeft) { safeEval(pop()); exitCode = whnfInt; } else { if (phval) { safeEval(pop()); *phval = (void*)ptrOf(whnfHead); } else { drop(); } exitCode = 0; } normalTerminal(); if (sp != oldsp-1) { setError("doIO: unbalanced stack"); return 1; } return exitCode; END_PROTECT; return -1; /* error code */ } /* -------------------------------------------------------------------------- * Stable pointers * * If a value is popped off the stack, it is made into a stable pointer * which must be explicitly freed. * ------------------------------------------------------------------------*/ static HVal PopHVal() /* Get a value off the stack */ { protect( HVal r = mkStablePtr(pop()); if (0 == r) { setError("popHVal: no free stable pointers"); return 0; } return r; ); return 0; } static Void PushHVal(hval) /* Put a value back on the stack */ HVal hval; { protect( if (hval == 0) { setError("pushHVal: invalid HVal"); return; } push(derefStablePtr(hval)) ); } static Void FreeHVal(hval) /* Free a Haskell value */ HVal hval; { protect(freeStablePtr(hval)); } #ifndef NO_DYNAMIC_TYPES /* -------------------------------------------------------------------------- * Testing for class membership: * ------------------------------------------------------------------------*/ Cell getTypeableDict(t) /* Find a Typeable dictionary for instance t, */ Type t; { /* or NIL if none found */ Class c = classTypeable; Kinds ks = NIL; if (isPolyType(t)) { ks = polySigOf(t); t = monotypeOf(t); } switch (whatIs(t)) { case QUAL : case RANK2 : case EXIST : case CDICTS: return NIL; } return provePred(ks,NIL,ap(c,t)); } #endif /* ----------------------------------------------------------------------- */ hugs98-plus-Sep2006/src/server.h0000644006511100651110000000242507743000211015226 0ustar rossross/* -------------------------------------------------------------------------- * Definition of the Hugs server API * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: server.h,v $ * $Revision: 1.12 $ * $Date: 2003/10/14 13:56:25 $ * ------------------------------------------------------------------------*/ #include "HugsAPI.h" /* These have non-local scope, as they're used when creating * extended/delegated versions of the server API (cf. the server * interface provided by the .NET extensions.) */ extern Void setError Args((String)); extern Void startEval Args((Void)); extern Bool safeEval Args((Cell)); extern String ClearError Args((Void)); extern Cell getTypeableDict Args((Type)); extern char* lastError; /* Get the API method table from the currently running interpreter. * => the interpreter / server is assumed to have already been initialized. */ extern HugsServerAPI* getHugsAPI Args((Void)); /* ------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/static.c0000644006511100651110000065231210475356376015236 0ustar rossross/* -------------------------------------------------------------------------- * Static Analysis for Hugs * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: static.c,v $ * $Revision: 1.180 $ * $Date: 2006/08/30 18:46:22 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "machdep.h" #include "errors.h" #include "output.h" #include "subst.h" #include "module.h" #include "opts.h" #include "goal.h" /* -------------------------------------------------------------------------- * local function prototypes: * ------------------------------------------------------------------------*/ static Void local kindError Args((Int,Constr,Constr,String,Kind,Int)); static Void local checkQualImport Args((Pair)); static Void local checkUnqualImport Args((Triple)); static Void local checkTyconDefn Args((Tycon)); static Void local depConstrs Args((Tycon,List,Cell)); static Int local userArity Args((Name)); static List local addSels Args((Int,Name,List,List)); static List local selectCtxt Args((List,List)); static Void local checkSynonyms Args((List)); static List local visitSyn Args((List,Tycon,List)); static Type local fullerExpand Args((Type)); static Type local instantiateNewtype Args((Name,Type)); static Type local instantiateSyn Args((Type,Type)); static Void local checkClassDefn Args((Class)); static Void local checkClassDefn2 Args((Class)); static Void local checkClassDefn2_ Args((List)); static Cell local depPredExp Args((Int,List,Cell)); static Void local checkMems Args((Class,List,Cell)); static Void local checkMems2 Args((Class,Cell)); static Void local addMembers Args((Class)); static Name local newMember Args((Int,Int,Cell,Type,Class)); static Name local newDSel Args((Class,Int)); static Text local generateText Args((String,Class)); static Int local visitClass Args((Class)); static List local classBindings Args((String,Class,List)); static Name local memberName Args((Class,Text)); static List local numInsert Args((Int,Cell,List)); static List local typeVarsIn Args((Cell,List,List,List)); static List local maybeAppendVar Args((Cell,List)); static Type local checkSigType Args((Int,String,Cell,Type)); static Void local checkOptQuantVars Args((Int,List,List)); static Type local depTopType Args((Int,List,Type)); static Type local depCompType Args((Int,List,Type)); static Type local depTypeExp Args((Int,List,Type)); static Type local depTypeVar Args((Int,List,Text)); static List local checkQuantVars Args((Int,List,List,Cell)); static List local offsetTyvarsIn Args((Type,List)); static List local otvars Args((Cell,List)); static Bool local osubset Args((List,List)); static Void local kindConstr Args((Int,Int,Int,Constr)); static Kind local kindAtom Args((Int,Constr)); static Void local kindPred Args((Int,Int,Int,Cell)); static Void local kindType Args((Int,String,Type)); static Void local fixKinds Args((Void)); static Void local kindTCGroup Args((List)); static Void local initTCKind Args((Cell)); static Void local kindTC Args((Cell)); static Void local genTC Args((Cell)); static Void local checkInstDefn Args((Inst)); static Void local insertInst Args((Inst)); static Bool local instCompare Args((Inst,Inst)); static Name local newInstImp Args((Inst)); static Void local kindInst Args((Inst,Int)); static Void local checkDerive Args((Tycon,List,List,Cell)); static Void local addDerInst Args((Int,Class,List,List,Type,Int)); static Void local deriveContexts Args((List)); static Void local initDerInst Args((Inst)); static Void local calcInstPreds Args((Inst)); static List local calcFunDeps Args((List)); static Void local maybeAddPred Args((Cell,Int,Int,List)); static Cell local copyAdj Args((Cell,Int,Int)); static Void local tidyDerInst Args((Inst)); static List local inheritFundeps Args((Class,Cell,Int)); static Void local extendFundeps Args((Class)); static List local otvarsZonk Args((Cell,List,Int)); static Void local addDerivImp Args((Inst)); static List local getDiVars Args((Int)); static Cell local mkBind Args((String,List)); static Cell local mkVarAlts Args((Int,Cell)); static List local deriveEq Args((Tycon)); static Pair local mkAltEq Args((Int,List)); static List local deriveOrd Args((Tycon)); static Pair local mkAltOrd Args((Int,List)); static List local makeDPats2 Args((Cell,Int)); static List local deriveEnum Args((Tycon)); static List local deriveIx Args((Tycon)); static Bool local isEnumType Args((Tycon)); static List local mkIxBinds Args((Int,Cell,Int)); static Cell local prodRange Args((Int,List,Cell,Cell,Cell)); static Cell local prodIndex Args((Int,List,Cell,Cell,Cell)); static Cell local prodInRange Args((Int,List,Cell,Cell,Cell)); static List local deriveShow Args((Tycon)); static Cell local mkAltShow Args((Int,Cell,Int)); static Cell local showsPrecRhs Args((Cell,Cell,Int)); static List local deriveRead Args((Cell)); static Cell local mkReadCon Args((Name,Cell,Cell)); static Cell local mkReadPrefix Args((Cell)); static Cell local mkReadInfix Args((Cell)); static Cell local mkReadTuple Args((Cell)); static Cell local mkReadRecord Args((Cell,List)); static List local deriveBounded Args((Tycon)); static List local mkBndBinds Args((Int,Cell,Int)); static Void local checkDefaultDefns Args((Void)); static List local checkPrimDefn Args((Triple)); static Name local addNewPrim Args((Int,Text,String,Cell)); static Void local checkForeignImport Args((Name)); static Void local checkForeignExport Args((Name)); static Void local linkForeign Args((Name)); static Cell local tidyInfix Args((Int,Cell)); static Pair local attachFixity Args((Int,Cell)); static Syntax local lookupSyntax Args((Text)); static Cell local checkPat Args((Int,Cell)); static Cell local checkMaybeCnkPat Args((Int,Cell)); static Cell local checkApPat Args((Int,Int,Cell)); static Void local addToPatVars Args((Int,Cell)); static Name local conDefined Args((Int,Cell,Bool)); static Void local checkIsCfun Args((Int,Name)); static Void local checkCfunArgs Args((Int,Cell,Int)); static Cell local checkPatType Args((Int,String,Cell,Type)); static Cell local applyBtyvs Args((Cell)); static Cell local bindPat Args((Int,Cell)); static Void local bindPats Args((Int,List)); static List local extractSigdecls Args((List)); static List local extractFixdecls Args((List)); static List local extractBindings Args((List)); static List local getPatVars Args((Int,Cell,List)); static List local addPatVar Args((Int,Cell,List)); static List local eqnsToBindings Args((List,List,List,List)); static Void local notDefined Args((Int,List,Cell)); static Cell local findBinding Args((Text,List)); static Cell local getAttr Args((List,Cell)); static Void local addSigdecl Args((List,Cell)); static Void local addFixdecl Args((List,List,List,List,Triple)); static Void local dupFixity Args((Int,Text)); static Void local missFixity Args((Int,Text)); static List local dependencyAnal Args((List)); static List local topDependAnal Args((List)); static Void local addDepField Args((Cell)); static Void local remDepField Args((List)); static Void local remDepField1 Args((Cell)); static Void local clearScope Args((Void)); static Void local withinScope Args((List)); static Void local leaveScope Args((Void)); static Void local saveSyntax Args((Cell,Cell)); static Void local dropNameClash Args((Cell)); #if IPARAM static Bool local checkIBindings Args((Int,List)); #endif static Void local depBinding Args((Cell)); static Void local depDefaults Args((Class)); static Void local depInsts Args((Inst)); static Void local depClassBindings Args((List)); static Void local depAlt Args((Cell)); static Cell local depLetRec Args((Bool,Int,Cell)); static Void local depRhs Args((Cell)); static Void local depGuard Args((Cell)); static Void local depPair Args((Int,Cell)); static Void local depTriple Args((Int,Cell)); static Void local depComp Args((Int,Cell,List)); #if ZIP_COMP static Void local depZComp Args((Int,Cell,List)); static Void local depZCompBranch Args((Int,List)); static List local intersectBinds Args((List bs1,List bs2)); static List local getBindVars Args((List bs)); #endif static Void local depCaseAlt Args((Int,Cell)); static Cell local depVar Args((Int,Cell,Bool)); static Cell local depQVar Args((Int,Cell,Bool)); static Void local depConFlds Args((Int,Cell,Bool)); static Void local depUpdFlds Args((Int,Cell)); static List local depFields Args((Int,Cell,List,Bool)); static Void local checkNameAmbigName Args((Int,Name,Bool)); static Void local checkNameAmbig Args((Int,Text,Cell)); static Cell local checkTyconAmbig Args((Int,Text,Cell)); #if IPARAM static Void local depWith Args((Int,Cell)); static List local depDwFlds Args((Int,Cell,List)); #endif #if TREX static Void local trexUsed Args((Void)); static Void local trexLoad Args((Void)); static Cell local depRecord Args((Int,Cell)); #endif #if MUDO static Void local mdoLoad Args((Void)); static Void local mdoUsed Args((Void)); static List local mdoGetPatVarsLet Args((Int,List,List)); static List local mdoBVars Args((Int,List)); static List local mdoUsedVars Args((List,Cell,List,List)); static Void local depRecComp Args((Int,Cell,List)); static Void local mdoExpandQualifiers Args((Int,Cell,List,List)); static Bool local mdoIsConnected Args((Cell,List)); static Int local mdoSegment Args((Cell,List)); static Void local mdoSCC Args((List)); static List local mdoCleanSegment Args((Triple)); static List local mdoNoLets Args((Triple)); static Void local mdoComputeExports Args((Triple,Cell)); static Bool local mdoUsedInAnySeg Args((Text,List)); /*#define DEBUG_MDO_SEGMENTS*/ #endif static List local tcscc Args((List,List)); static List local bscc Args((List)); static Void local addRSsigdecls Args((Pair)); static Void local allNoPrevDef Args((Cell)); static Void local noPrevDef Args((Int,Cell)); static Bool local odiff Args((List,List)); static Void local duplicateError Args((Int,Module,Text,String)); static Void local checkTypeIn Args((Pair)); static Bool local h98Pred Args((Bool,Cell)); static Cell local h98Context Args((Bool,List)); static Void local h98CheckCtxt Args((Int,String,Bool,List,Inst)); static Void local h98CheckType Args((Int,String,Cell,Type)); /* -------------------------------------------------------------------------- * The code in this file is arranged in roughly the following order: * - Kind inference preliminaries * - Module declarations * - Type declarations (data, type, newtype, type in) * - Class declarations * - Type signatures * - Instance declarations * - Default declarations * - Primitive definitions * - Foreign Function Interface declarations * - Patterns * - Infix expressions * - Value definitions * - Top-level static analysis and control * - Haskell 98 compatibility tests * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Kind checking preliminaries: * ------------------------------------------------------------------------*/ Bool kindExpert = FALSE; /* TRUE => display kind errors in */ /* full detail */ static Void local kindError(l,c,in,wh,k,o) Int l; /* line number near constuctor exp */ Constr c; /* constructor */ Constr in; /* context (if any) */ String wh; /* place in which error occurs */ Kind k; /* expected kind (k,o) */ Int o; { /* inferred kind (typeIs,typeOff) */ clearMarks(); if (!kindExpert) { /* for those with a fear of kinds */ ERRMSG(l) "Illegal type" ETHEN if (nonNull(in)) { ERRTEXT " \"" ETHEN ERRTYPE(in); ERRTEXT "\"" ETHEN } ERRTEXT " in %s\n", wh EEND; } ERRMSG(l) "Kind error in %s", wh ETHEN if (nonNull(in)) { ERRTEXT "\n*** expression : " ETHEN ERRTYPE(in); } ERRTEXT "\n*** constructor : " ETHEN ERRTYPE(c); ERRTEXT "\n*** kind : " ETHEN ERRKIND(copyType(typeIs,typeOff)); ERRTEXT "\n*** does not match : " ETHEN ERRKIND(copyType(k,o)); if (unifyFails) { ERRTEXT "\n*** because : %s", unifyFails ETHEN } ERRTEXT "\n" EEND; } #define shouldKind(l,c,in,wh,k,o) if (!kunify(typeIs,typeOff,k,o)) \ kindError(l,c,in,wh,k,o) #define checkKind(l,a,m,c,in,wh,k,o) kindConstr(l,a,m,c); \ shouldKind(l,c,in,wh,k,o) #define inferKind(k,o) typeIs=k; typeOff=o static List unkindTypes; /* types in need of kind annotation*/ #if TREX Kind extKind; /* Kind of extension, *->row->row */ #endif /* -------------------------------------------------------------------------- * Static analysis of modules: * ------------------------------------------------------------------------*/ #if HSCRIPT String reloadModule; #endif Void startModule(nm) /* switch to a new module */ Cell nm; { Module m; Text t = textOf(nm); if (!isCon(nm)) internal("startModule"); if (isNull(m = findModule(t))) { m = newModule(t); if ( moduleUserPrelude == 0 && t == textUserPrelude ) { moduleUserPrelude = m; } } else if (!isPreludeScript()) { /* You're allowed to break the rules in the Prelude! */ #if HSCRIPT reloadModule = textToStr(t); #endif ERRMSG(0) "Module \"%s\" already loaded", textToStr(t) EEND; } setCurrModule(m); } Void setExportList(exps) /* Add export list to current module */ List exps; { module(currentModule).exports = exps; } static Void local checkQualImport(i) /* Process qualified import */ Pair i; { Module m = findModid(snd(i)); if (isNull(m)) { ERRMSG(0) "Module \"%s\" not previously loaded", textToStr(textOf(snd(i))) EEND; } snd(i)=m; } static Void local checkUnqualImport(i) /* Process unqualified import */ Pair i; { Module m = findModid(fst(i)); if (isNull(m)) { ERRMSG(0) "Module \"%s\" not previously loaded", textToStr(textOf(fst(i))) EEND; } fst(i)=m; } /* the bulk of the module system implementation now resides in module.c */ /* -------------------------------------------------------------------------- * Static analysis of type declarations: * * Type declarations come in two forms: * - data declarations - define new constructed data types * - type declarations - define new type synonyms * * A certain amount of work is carried out as the declarations are * read during parsing. In particular, for each type constructor * definition encountered: * - check that there is no previous definition of constructor * - ensure type constructor not previously used as a class name * - make a new entry in the type constructor table * - record line number of declaration * - Build separate lists of newly defined constructors for later use. * ------------------------------------------------------------------------*/ Void tyconDefn(line,lhs,rhs,what) /* process new type definition */ Int line; /* definition line number */ Cell lhs; /* left hand side of definition */ Cell rhs; /* right hand side of definition */ Cell what; { /* SYNONYM/DATATYPE/etc... */ Text t = textOf(getHead(lhs)); Tycon tc = findTycon(t); if ( nonNull(tc) ) { ERRMSG(line) "Multiple declarations of type constructor \"%s\"", textToStr(t) EEND; } else if (nonNull(tc) && nonNull(tycon(tc).clashes)) { List ls = tycon(tc).clashes; ERRMSG(line) "Ambiguous type constructor occurrence \"%s\"", textToStr(t) ETHEN ERRTEXT "\n*** Could refer to: " ETHEN ERRTEXT "%s.%s ", textToStr(module(tycon(tc).mod).text), textToStr(tycon(tc).text) ETHEN for(;nonNull(ls);ls=tl(ls)) { ERRTEXT "%s.%s ", textToStr(module(tycon(hd(ls)).mod).text), textToStr(tycon(hd(ls)).text) ETHEN } ERRTEXT "\n" EEND; } else if (nonNull(findClass(t))) { ERRMSG(line) "\"%s\" used as both class and type constructor", textToStr(t) EEND; } else { Tycon nw = newTycon(t); tyconDefns = cons(nw,tyconDefns); tycon(nw).line = line; tycon(nw).arity = argCount; tycon(nw).what = what; if (what==RESTRICTSYN) { h98DoesntSupport(line,"restricted type synonyms"); typeInDefns = cons(pair(nw,snd(rhs)),typeInDefns); rhs = fst(rhs); } tycon(nw).defn = pair(lhs,rhs); } } Void setTypeIns(bs) /* set local synonyms for given */ List bs; { /* binding group */ List cvs = typeInDefns; for (; nonNull(cvs); cvs=tl(cvs)) { Tycon c = fst(hd(cvs)); List vs = snd(hd(cvs)); for (tycon(c).what = RESTRICTSYN; nonNull(vs); vs=tl(vs)) { if (nonNull(findBinding(textOf(hd(vs)),bs))) { tycon(c).what = SYNONYM; break; } } } } Void clearTypeIns() { /* clear list of local synonyms */ for (; nonNull(typeInDefns); typeInDefns=tl(typeInDefns)) tycon(fst(hd(typeInDefns))).what = RESTRICTSYN; } /* -------------------------------------------------------------------------- * Further analysis of Type declarations: * * In order to allow the definition of mutually recursive families of * data types, the static analysis of the right hand sides of type * declarations cannot be performed until all of the type declarations * have been read. * * Once parsing is complete, we carry out the following: * * - check format of lhs, extracting list of bound vars and ensuring that * there are no repeated variables and no Skolem variables. * - run dependency analysis on rhs to check that only bound type vars * appear in type and that all constructors are defined. * Replace type variables by offsets, constructors by Tycons. * - use list of dependents to sort into strongly connected components. * - ensure that there is not more than one synonym in each group. * - kind-check each group of type definitions. * * - check that there are no previous definitions for constructor * functions in data type definitions. * - install synonym expansions and constructor definitions. * ------------------------------------------------------------------------*/ static List tcDeps = NIL; /* list of dependent tycons/classes*/ static Void local checkTyconDefn(d) /* validate type constructor defn */ Tycon d; { Cell lhs = fst(tycon(d).defn); Cell rhs = snd(tycon(d).defn); Int line = tycon(d).line; List tyvars = getArgs(lhs); List temp; /* check for repeated tyvars on lhs*/ for (temp=tyvars; nonNull(temp); temp=tl(temp)) if (nonNull(varIsMember(textOf(hd(temp)),tl(temp)))) { ERRMSG(line) "Repeated type variable \"%s\" on left hand side", textToStr(textOf(hd(temp))) EEND; } tcDeps = NIL; /* find dependents */ switch (whatIs(tycon(d).what)) { case RESTRICTSYN : case SYNONYM : rhs = depTopType(line,tyvars,rhs); if (cellIsMember(d,tcDeps)) { ERRMSG(line) "Recursive type synonym \"%s\"", textToStr(tycon(d).text) EEND; } break; case DATATYPE : case NEWTYPE : depConstrs(d,tyvars,rhs); rhs = fst(rhs); break; default : internal("checkTyconDefn"); break; } tycon(d).defn = rhs; tycon(d).kind = tcDeps; tcDeps = NIL; } static Void local depConstrs(t,tyvars,cd) Tycon t; /* Define constructor functions and*/ List tyvars; /* do dependency analysis for data */ Cell cd; { /* definitions (w or w/o deriving) */ Int line = tycon(t).line; List ctxt = NIL; Int conNo = 1; Type lhs = t; List cs = fst(cd); List derivs = snd(cd); List compTypes = NIL; List sels = NIL; Int i; for (i=0; i0) { /* Add rank 2 annotation */ type = ap(RANK2,pair(mkInt(nr2-length(lps)),type)); } if (nonNull(evs)) { /* Add existential annotation */ if (nonNull(derivs)) { ERRMSG(line) "Cannot derive instances for types" ETHEN ERRTEXT " with existentially typed components" EEND; } if (fs!=NONE) { ERRMSG(line) "Cannot use selectors with existentially typed components" EEND; } type = ap(EXIST,pair(mkInt(length(evs)),type)); } if (nonNull(lps)) { /* Add local preds part to type */ type = ap(CDICTS,pair(lps,type)); } if (nonNull(ctxt1)) { /* Add context part to type */ type = ap(QUAL,pair(ctxt1,type)); } if (nonNull(sig)) { /* Add quantifiers to type */ List ts1 = sig; for (; nonNull(ts1); ts1=tl(ts1)) { hd(ts1) = NIL; } type = mkPolyType(sig,type); } n = findName(textOf(con)); /* Allocate constructor fun name */ if (isNull(n)) { n = newName(textOf(con),NIL); } else if (name(n).defn!=PREDEFINED && name(n).mod == currentModule) { /* A local repeated definition */ duplicateError(line,name(n).mod,name(n).text,"data constructor"); } else if (name(n).defn!=PREDEFINED) { Name oldnm = n; removeName(n); n = newName(textOf(con),NIL); name(n).defn = PREDEFINED; name(n).clashes = cons(oldnm,name(n).clashes); } name(n).arity = arity; /* Save constructor fun details */ name(n).line = line; name(n).parent = t; name(n).number = cfunNo(conNo++); name(n).type = type; if (tycon(t).what==NEWTYPE) { if (nonNull(lps)) { ERRMSG(line) "A newtype constructor cannot have class constraints" EEND; } if (arity!=1) { ERRMSG(line) "A newtype constructor must have exactly one argument" EEND; } if (nonNull(scs)) { ERRMSG(line) "Illegal strictness annotation for newtype constructor" EEND; } name(n).defn = nameId; } else { implementCfun(n,scs); } hd(cs) = n; if (fs!=NONE) { sels = addSels(line,n,fs,sels); } } if (nonNull(sels)) { sels = rev(sels); fst(cd) = appendOnto(fst(cd),sels); selDefns = cons(sels,selDefns); } if (nonNull(derivs)) { /* Generate derived instances */ map3Proc(checkDerive,t,ctxt,compTypes,derivs); } } static Int local userArity(c) /* Find arity for cfun, ignoring */ Name c; { /* CDICTS parameters */ Int a = name(c).arity; Type t = name(c).type; Int w; if (isPolyType(t)) { t = monotypeOf(t); } if ((w=whatIs(t))==QUAL) { #if FAST_WHATIS /* decompose expression for whatIs macro */ t=snd(snd(t)); w = whatIs(t); #else w = whatIs(t=snd(snd(t))); #endif } if (w==CDICTS) { a -= length(fst(snd(t))); } return a; } static List cfunSfuns; /* List of (Cfun,[SelectorVar]) */ /* - used for deriving Show */ static List local addSels(line,c,fs,ss) /* Add fields to selector list */ Int line; /* line number of constructor */ Name c; /* corresponding constr function */ List fs; /* list of fields (varids) */ List ss; { /* list of existing selectors */ Int sn = 1; cfunSfuns = cons(pair(c,fs),cfunSfuns); for (; nonNull(fs); fs=tl(fs), ++sn) { List ns = ss; Text t = textOf(hd(fs)); if (nonNull(varIsMember(t,tl(fs)))) { ERRMSG(line) "Repeated field name \"%s\" for constructor \"%s\"", textToStr(t), textToStr(name(c).text) EEND; } while (nonNull(ns) && t!=name(hd(ns)).text) { ns = tl(ns); } if (nonNull(ns)) { name(hd(ns)).defn = cons(pair(c,mkInt(sn)),name(hd(ns)).defn); } else { Name n; Name oldnm = findName(t); if ( nonNull(oldnm) ) { if ( name(oldnm).mod == currentModule ) { ERRMSG(line) "Multiple declarations for selector \"%s\"", textToStr(t) EEND; } else { removeName(oldnm); } } n = newName(t,c); name(n).line = line; name(n).number = SELNAME; name(n).defn = singleton(pair(c,mkInt(sn))); if (nonNull(oldnm)) { name(n).clashes = cons(oldnm,name(n).clashes); } ss = cons(n,ss); } } return ss; } static List local selectCtxt(ctxt,vs) /* calculate subset of context */ List ctxt; List vs; { if (isNull(vs)) { return NIL; } else { List ps = NIL; for (; nonNull(ctxt); ctxt=tl(ctxt)) { List us = offsetTyvarsIn(hd(ctxt),NIL); for (; nonNull(us) && cellIsMember(hd(us),vs); us=tl(us)) { } if (isNull(us)) { ps = cons(hd(ctxt),ps); } } return rev(ps); } } static Void local checkSynonyms(ts) /* Check for mutually recursive */ List ts; { /* synonyms */ List syns = NIL; for (; nonNull(ts); ts=tl(ts)) { /* build list of all synonyms */ Tycon t = hd(ts); switch (whatIs(tycon(t).what)) { case SYNONYM : case RESTRICTSYN : syns = cons(t,syns); break; } } while (nonNull(syns)) { /* then visit each synonym */ syns = visitSyn(NIL,hd(syns),syns); } } static List local visitSyn(path,t,syns) /* visit synonym definition to look*/ List path; /* for cycles */ Tycon t; List syns; { if (cellIsMember(t,path)) { /* every elt in path depends on t */ ERRMSG(tycon(t).line) "Type synonyms \"%s\" and \"%s\" are mutually recursive", textToStr(tycon(t).text), textToStr(tycon(hd(path)).text) EEND; } else { List ds = tycon(t).kind; List path1 = NIL; for (; nonNull(ds); ds=tl(ds)) { if (cellIsMember(hd(ds),syns)) { if (isNull(path1)) { path1 = cons(t,path); } syns = visitSyn(path1,hd(ds),syns); } } } tycon(t).defn = fullExpand(tycon(t).defn); return removeCell(t,syns); } /* -------------------------------------------------------------------------- * Expanding out all type synonyms and newtypes in a type expression: * ------------------------------------------------------------------------*/ static Type local fullerExpand(t) /* find full expansion of type exp */ Type t; { /* assuming that all relevant type */ Cell h = t; /* synonym defns of lower rank have*/ Int n = 0; /* already been fully expanded but */ List args; /* not assuming same for newtypes */ for (args=NIL; isAp(h); h=fun(h), n++) { /* Does not apply recursively because the ffi is only interested * in the top level constructors */ args = cons(arg(h),args); } t = applyToArgs(h,args); if (isSynonym(h) && n>=tycon(h).arity) { if (n==tycon(h).arity) { t = instantiateSyn(tycon(h).defn,t); } else { Type p = t; while (--n > tycon(h).arity) { p = fun(p); } fun(p) = instantiateSyn(tycon(h).defn,fun(p)); } t = fullerExpand(t); /* chase synonym chains. */ } else if (isNewtype(h) && n==tycon(h).arity && h != typeIO) { if (n != 0) { /* Not supported because I don't understand the typechecker * well enough. For those that grok the data structures, it * should be simple. */ ERRMSG(name(h).line) "Use of polymorphic newtype '" ETHEN ERRTYPE(t); ERRTEXT "' not supported in foreign function declarations." EEND; } t = instantiateNewtype(hd(tycon(h).defn),t); t = fullerExpand(t); /* chase chains of newtypes */ } return t; } Bool hasIOResultType(ty) /* return TRUE if FFI/primitive type sig is an IO action. */ Type ty; { Type t = ty; if (isPolyType(t)) { t = monotypeOf(t); } t = fullerExpand(t); while (getHead(t) == typeArrow && argCount == 2) { t = fullerExpand(arg(t)); } return (getHead(t) == typeIO && argCount == 1); } static Type local instantiateNewtype(c,env) /* instantiate type using */ Name c; /* env to determine appropriate */ Type env; { /* values for OFFSET type vars */ Type t = NIL; assert(isName(c)); t = name(c).type; if (isPolyType(t)) { t = monotypeOf(t); } assert(getHead(t)==typeArrow && argCount==2); t = arg(fun(t)); /* This is probably where we should invoke instantiateSyn(t,env) */ return t; } /* -------------------------------------------------------------------------- * Expanding out all type synonyms in a type expression: * ------------------------------------------------------------------------*/ Type fullExpand(t) /* find full expansion of type exp */ Type t; { /* assuming that all relevant */ Cell h = t; /* synonym defns of lower rank have*/ Int n = 0; /* already been fully expanded */ List args; for (args=NIL; isAp(h); h=fun(h), n++) { args = cons(fullExpand(arg(h)),args); } t = applyToArgs(h,args); if (isSynonym(h) && n>=tycon(h).arity) { if (n==tycon(h).arity) { t = instantiateSyn(tycon(h).defn,t); } else { Type p = t; while (--n > tycon(h).arity) { p = fun(p); } fun(p) = instantiateSyn(tycon(h).defn,fun(p)); } } return t; } static Type local instantiateSyn(t,env) /* instantiate type according using*/ Type t; /* env to determine appropriate */ Type env; { /* values for OFFSET type vars */ switch (whatIs(t)) { case AP : return ap(instantiateSyn(fun(t),env), instantiateSyn(arg(t),env)); case OFFSET : return nthArg(offsetOf(t),env); default : return t; } } /* -------------------------------------------------------------------------- * Static analysis of class declarations: * * Performed in a similar manner to that used for type declarations. * * The first part of the static analysis is performed as the declarations * are read during parsing. The parser ensures that: * - the class header and all superclass predicates are of the form * ``Class var'' * * The classDefn() function: * - ensures that there is no previous definition for class * - checks that class name has not previously been used as a type constr. * - make new entry in class table * - record line number of declaration * - build list of classes defined in current script for use in later * stages of static analysis. * ------------------------------------------------------------------------*/ Void classDefn(line,head,ms,fds) /* process new class definition */ Int line; /* definition line number */ Cell head; /* class header :: ([Supers],Class) */ List ms; /* class definition body */ List fds; { /* functional dependencies */ Text ct = textOf(getHead(snd(head))); Int arity = argCount; if (nonNull(findClass(ct))) { ERRMSG(line) "Multiple declarations of class \"%s\"", textToStr(ct) EEND; } else if (nonNull(findTycon(ct))) { ERRMSG(line) "\"%s\" used as both class and type constructor", textToStr(ct) EEND; } else { Class nw = newClass(ct); cclass(nw).line = line; cclass(nw).arity = arity; cclass(nw).head = snd(head); cclass(nw).supers = fst(head); cclass(nw).members = ms; cclass(nw).level = 0; cclass(nw).fds = fds; cclass(nw).xfds = NIL; classDefns = cons(nw,classDefns); if (arity!=1) h98DoesntSupport(line,"multiple parameter classes"); } } /* -------------------------------------------------------------------------- * Further analysis of class declarations: * * Full static analysis of class definitions must be postponed until the * complete script has been read and all static analysis on type definitions * has been completed. * * Once this has been achieved, we carry out the following checks on each * class definition: * - check that variables in header are distinct * - replace head by skeleton * - check superclass declarations, replace by skeletons * - split body of class into members and declarations * - make new name entry for each member function * - record member function number (eventually an offset into dictionary!) * - no member function has a previous definition ... * - no member function is mentioned more than once in the list of members * - each member function type is valid, replace vars by offsets * - qualify each member function type by class header * - only bindings for members appear in defaults * - only function bindings appear in defaults * - check that extended class hierarchy does not contain any cycles * ------------------------------------------------------------------------*/ static Void local checkClassDefn(c) /* validate class definition */ Class c; { List tyvars = NIL; Cell temp = cclass(c).head; List fs = NIL; List ss = NIL; for (; isAp(temp); temp=fun(temp)) { if (!isVar(arg(temp))) { ERRMSG(cclass(c).line) "Type variable required in class head" EEND; } if (nonNull(varIsMember(textOf(arg(temp)),tyvars))) { ERRMSG(cclass(c).line) "Repeated type variable \"%s\" in class head", textToStr(textOf(arg(temp))) EEND; } tyvars = cons(arg(temp),tyvars); } for (fs=cclass(c).fds; nonNull(fs); fs=tl(fs)) { Pair fd = hd(fs); List vs = snd(fd); /* Check for trivial dependency */ if (isNull(vs)) { ERRMSG(cclass(c).line) "Functional dependency is trivial" EEND; } /* Check for duplicated vars on right hand side, and for vars on * right that also appear on the left: */ for (vs=snd(fd); nonNull(vs); vs=tl(vs)) { if (varIsMember(textOf(hd(vs)),fst(fd))) { ERRMSG(cclass(c).line) "Trivial dependency for variable \"%s\"", textToStr(textOf(hd(vs))) EEND; } if (varIsMember(textOf(hd(vs)),tl(vs))) { ERRMSG(cclass(c).line) "Repeated variable \"%s\" in functional dependency", textToStr(textOf(hd(vs))) EEND; } hd(vs) = depTypeVar(cclass(c).line,tyvars,textOf(hd(vs))); } /* Check for duplicated vars on left hand side: */ for (vs=fst(fd); nonNull(vs); vs=tl(vs)) { if (varIsMember(textOf(hd(vs)),tl(vs))) { ERRMSG(cclass(c).line) "Repeated variable \"%s\" in functional dependency", textToStr(textOf(hd(vs))) EEND; } hd(vs) = depTypeVar(cclass(c).line,tyvars,textOf(hd(vs))); } } /* add in the tyvars from the `supers' so that we don't prematurely complain about undefined tyvars */ tyvars = typeVarsIn(cclass(c).supers,NIL,NIL,tyvars); cclass(c).tyvars = dupList(tyvars); if (cclass(c).arity==0) { cclass(c).head = c; } else { Int args = cclass(c).arity - 1; for (temp=cclass(c).head; args>0; temp=fun(temp), args--) { arg(temp) = mkOffset(args); } arg(temp) = mkOffset(0); fun(temp) = c; } tcDeps = NIL; /* find dependents */ map2Over(depPredExp,cclass(c).line,tyvars,cclass(c).supers); #ifdef IPARAM for ( ss = cclass(c).supers; nonNull(ss); ss=tl(ss) ) { if ( isIP(getHead(hd(ss))) ) { ERRMSG(cclass(c).line) "Implicit parameters not permitted in class context" EEND; } } #endif h98CheckCtxt(cclass(c).line,"class declaration",FALSE,cclass(c).supers,NIL); cclass(c).numSupers = length(cclass(c).supers); cclass(c).defaults = extractBindings(cclass(c).members); /* defaults*/ ss = extractSigdecls(cclass(c).members); fs = extractFixdecls(cclass(c).members); cclass(c).members = pair(ss,fs); map2Proc(checkMems,c,tyvars,ss); cclass(c).kinds = tcDeps; tcDeps = NIL; } static Void local checkClassDefn2_(cs) List cs; { mapProc(checkClassDefn2,cs); } static Void local checkClassDefn2(c) /* validate class definition, pt 2 */ Class c; { /* can only finish this job after */ /* we've inherited fds */ /* and are in dependency order */ if (!isTycon(c)) { List tvts = offsetTyvarsIn(cclass(c).head,NIL); List tvps = offsetTyvarsIn(cclass(c).supers,NIL); List fds = calcFunDeps(cclass(c).supers); tvts = oclose(fds,tvts); tvts = odiff(tvps,tvts); if (!isNull(tvts)) { ERRMSG(cclass(c).line) "Undefined type variable \"%s\"", textToStr(textOf(nth(offsetOf(hd(tvts)),cclass(c).tyvars))) EEND; } } } /* -------------------------------------------------------------------------- * Functional dependencies are inherited from superclasses. * For example, if I've got the following classes: * * class C a b | a -> b * class C [b] a => D a b * * then C will have the dependency ([a], [b]) as expected, and D will inherit * the dependency ([b], [a]) from C. * When doing pairwise improvement, we have to consider not just improving * when we see a pair of Cs or a pair of Ds in the context, but when we've * got a C and a D as well. In this case, we only improve when the * predicate in question matches the type skeleton in the relevant superclass * constraint. E.g., we improve the pair (C [Int] a, D b Int) (unifying * a and b), but we don't improve the pair (C Int a, D b Int). * To implement functional dependency inheritance, we calculate * the closure of all functional dependencies, and store the result * in an additional field `xfds' (extended functional dependencies). * The `xfds' field is a list of functional dependency lists, annotated * with a list of predicate skeletons constraining when improvement can * happen against this dependency list. For example, the xfds field * for C above would be: * [([C a b], [([a], [b])])] * and the xfds field for D would be: * [([C [b] a, D a b], [([b], [a])])] * Self-improvement (of a C with a C, or a D with a D) is treated as a * special case of an inherited dependency. * ------------------------------------------------------------------------*/ static List local inheritFundeps(c,pi,o) Class c; Cell pi; Int o; { Int alpha = newKindedVars(cclass(c).kinds); List scs = cclass(c).supers; List xfds = NIL; Cell this = NIL; /* alloc additional vars for any vars in supers not in the head */ newKindvars(length(cclass(c).tyvars) - cclass(c).arity); /* better not fail ;-) */ if (!matchPred(pi,o,cclass(c).head,alpha)) { /* If the qualified type is not valid, for instance by * having type variables occurring free in the context, * but not in the head -- we will end up here. * * Silently give up & assume that checkClassDefn2() will * catch the error condition. */ return xfds; } this = copyPred(pi,o); for (; nonNull(scs); scs=tl(scs)) { Class s = getHead(hd(scs)); if (isClass(s)) { List sfds = inheritFundeps(s,hd(scs),alpha); for (; nonNull(sfds); sfds=tl(sfds)) { Cell h = hd(sfds); xfds = cons(pair(cons(this,fst(h)),snd(h)),xfds); } } } if (nonNull(cclass(c).fds)) { List fds = NIL, fs = cclass(c).fds; for (; nonNull(fs); fs=tl(fs)) { fds = cons(pair(otvars(this,fst(hd(fs))), otvars(this,snd(hd(fs)))),fds); } xfds = cons(pair(cons(this,NIL),fds),xfds); } return xfds; } static Void local extendFundeps(c) Class c; { Int alpha; emptySubstitution(); alpha = newKindedVars(cclass(c).kinds); cclass(c).xfds = inheritFundeps(c,cclass(c).head,alpha); /* we can now check for ambiguity */ map1Proc(checkMems2,c,fst(cclass(c).members)); } static Cell local depPredExp(line,tyvars,pred) Int line; List tyvars; Cell pred; { Int args = 0; Cell prev = NIL; Cell h = pred; for (; isAp(h); args++) { arg(h) = depTypeExp(line,tyvars,arg(h)); prev = h; h = fun(h); } if (args==0) { h98DoesntSupport(line,"tag classes"); } else if (args!=1) { h98DoesntSupport(line,"multiple parameter classes"); } if (isQCon(h)) { /* standard class constraint */ Class c = findQualClass(h); if (isNull(c)) { ERRMSG(line) "Undefined class \"%s\"", identToStr(h) EEND; } if (!isQualIdent(h) && nonNull(cclass(c).clashes)) { List ls = cclass(c).clashes; ERRMSG(line) "Ambiguous class occurrence \"%s\"", textToStr(cclass(c).text) ETHEN ERRTEXT "\n*** Could refer to: " ETHEN ERRTEXT "%s.%s ", textToStr(module(cclass(c).mod).text), textToStr(cclass(c).text) ETHEN for (;nonNull(ls);ls=tl(ls)) { ERRTEXT "%s.%s ", textToStr(module(cclass(hd(ls)).mod).text), textToStr(cclass(hd(ls)).text) ETHEN } ERRTEXT "\n" EEND; } if (isNull(prev)) { pred = c; } else { fun(prev) = c; } if (args!=cclass(c).arity) { ERRMSG(line) "Wrong number of arguments for class \"%s\"", textToStr(cclass(c).text) EEND; } if (cellIsMember(c,classDefns) && !cellIsMember(c,tcDeps)) { tcDeps = cons(c,tcDeps); } } #if TREX else if (isExt(h)) { /* Lacks predicate */ if (args!=1) { /* parser shouldn't let this happen*/ ERRMSG(line) "Wrong number of arguments for lacks predicate" EEND; } } #endif else #if IPARAM if (!isIP(h)) #endif { internal("depPredExp"); } return pred; } static Void local checkMems(c,tyvars,m) /* check member function details */ Class c; List tyvars; Cell m; { Int line = intOf(fst3(m)); List vs = snd3(m); Type t = thd3(m); List sig = NIL; List tvs = NIL; List xtvs = NIL; if (isPolyType(t)) { xtvs = fst(snd(t)); t = monotypeOf(t); } tyvars = typeVarsIn(t,NIL,xtvs,tyvars); /* Look for extra type vars. */ checkOptQuantVars(line,xtvs,tyvars); if (isQualType(t)) { /* Overloaded member signatures? */ map2Over(depPredExp,line,tyvars,fst(snd(t))); } else { t = ap(QUAL,pair(NIL,t)); } fst(snd(t)) = cons(cclass(c).head,fst(snd(t)));/* Add main predicate */ snd(snd(t)) = depTopType(line,tyvars,snd(snd(t))); for (tvs=tyvars; nonNull(tvs); tvs=tl(tvs)){/* Quantify */ sig = ap(NIL,sig); } if (nonNull(sig)) { t = mkPolyType(sig,t); } thd3(m) = t; /* Save type */ take(cclass(c).arity,tyvars); /* Delete extra type vars */ h98CheckType(line,"member type",hd(vs),t); } static Void local checkMems2(c,m) /* check member function details */ Class c; Cell m; { Int line = intOf(fst3(m)); List vs = snd3(m); Type t = thd3(m); if (isAmbiguous(t)) { ambigError(line,"class declaration",hd(vs),t); } } static Void local addMembers(c) /* Add definitions of member funs */ Class c; { /* and other parts of class struct.*/ List ms = fst(cclass(c).members); List fs = snd(cclass(c).members); List ns = NIL; /* List of names */ Int mno; /* Member function number */ for (mno=0; mno=MAX_GEN) { ERRMSG(0) "Please use a shorter name for class \"%s\"", cname EEND; } sprintf(buffer,sk,cname); return findText(buffer); } static Int local visitClass(c) /* visit class defn to check that */ Class c; { /* class hierarchy is acyclic */ #if TREX if (isExt(c)) { /* special case for lacks preds */ return 0; } #endif if (cclass(c).level < 0) { /* already visiting this class? */ ERRMSG(cclass(c).line) "Superclass relation for \"%s\" is cyclic", textToStr(cclass(c).text) EEND; } else if (cclass(c).level == 0) { /* visiting class for first time */ List scs = cclass(c).supers; Int lev = 0; cclass(c).level = (-1); for (; nonNull(scs); scs=tl(scs)) { #ifdef IPARAM if ( !isIP(getHead(hd(scs))) ) { #endif Int l = visitClass(getHead(hd(scs))); if (l>lev) lev=l; #ifdef IPARAM } #endif } cclass(c).level = 1+lev; /* level = 1 + max level of supers */ } return cclass(c).level; } /* -------------------------------------------------------------------------- * Process class and instance declaration binding groups: * ------------------------------------------------------------------------*/ static List local classBindings(where,c,bs) String where; /* Check validity of bindings bs */ Class c; /* for class c (or an inst of c) */ List bs; { /* sort into approp. member order */ List nbs = NIL; Text nm; for (; nonNull(bs); bs=tl(bs)) { Cell b = hd(bs); Cell body = snd(snd(b)); Name mnm; if ( !(isVar(fst(b))) ) { /* Only allow function bindings */ ERRMSG(rhsLine(snd(body))) "Pattern binding illegal in %s declaration", where EEND; } nm = textOf(fst(b)); if (isNull(mnm=memberName(c,nm))) { ERRMSG(rhsLine(snd(hd(body)))) "No member \"%s\" in class \"%s\"", textToStr(nm), textToStr(cclass(c).text) EEND; } snd(b) = body; nbs = numInsert(mfunOf(mnm)-1,b,nbs); } return nbs; } static Name local memberName(c,t) /* return name of member function */ Class c; /* with name t in class c */ Text t; { /* return NIL if not a member */ List ms = cclass(c).members; for (; nonNull(ms); ms=tl(ms)) { if (t==name(hd(ms)).text) { return hd(ms); } } return NIL; } static List local numInsert(n,x,xs) /* insert x at nth position in xs, */ Int n; /* filling gaps with NIL */ Cell x; List xs; { List start = isNull(xs) ? cons(NIL,NIL) : xs; for (xs=start; 0=NUM_OFFSETS) { ERRMSG(line) "Too many type variables in %s\n", where EEND; } else { List ts = tvs; for (; nonNull(ts); ts=tl(ts)) { hd(ts) = NIL; } type = mkPolyType(tvs,type); } } unkindTypes = NIL; kindType(line,"type expression",type); fixKinds(); unkindTypes = sunk; h98CheckType(line,where,e,type); return type; } static Void local checkOptQuantVars(line,xtvs,tvs) Int line; List xtvs; /* Explicitly quantified vars */ List tvs; { /* Implicitly quantified vars */ if (nonNull(xtvs)) { List vs = tvs; for (; nonNull(vs); vs=tl(vs)) { if (!varIsMember(textOf(hd(vs)),xtvs)) { ERRMSG(line) "Quantifier does not mention type variable \"%s\"", textToStr(textOf(hd(vs))) EEND; } } for (vs=xtvs; nonNull(vs); vs=tl(vs)) { if (!varIsMember(textOf(hd(vs)),tvs)) { ERRMSG(line) "Quantified type variable \"%s\" is not used", textToStr(textOf(hd(vs))) EEND; } if (varIsMember(textOf(hd(vs)),tl(vs))) { ERRMSG(line) "Quantified type variable \"%s\" is repeated", textToStr(textOf(hd(vs))) EEND; } } } } static Type local depTopType(l,tvs,t) /* Check top-level of type sig */ Int l; List tvs; Type t; { Type prev = NIL; Type t1 = t; Int nr2 = 0; Int i = 1; for (; getHead(t1)==typeArrow && argCount==2; ++i) { arg(fun(t1)) = depCompType(l,tvs,arg(fun(t1))); if (isPolyOrQualType(arg(fun(t1)))) { nr2 = i; } prev = t1; t1 = arg(t1); } if (nonNull(prev)) { arg(prev) = depTypeExp(l,tvs,t1); } else { t = depTypeExp(l,tvs,t1); } if (nr2>0) { t = ap(RANK2,pair(mkInt(nr2),t)); } return t; } static Type local depCompType(l,tvs,t) /* Check component type for constr */ Int l; List tvs; Type t; { Int ntvs = length(tvs); List nfr = NIL; if (isPolyType(t)) { List vs = fst(snd(t)); t = monotypeOf(t); tvs = checkQuantVars(l,vs,tvs,t); nfr = replicate(length(vs),NIL); } if (isQualType(t)) { map2Over(depPredExp,l,tvs,fst(snd(t))); snd(snd(t)) = depTypeExp(l,tvs,snd(snd(t))); /* it's premature to judge ambiguity (e.g. given functional deps) if (isAmbiguous(t)) { ambigError(l,"type component",NIL,t); } */ } else { t = depTypeExp(l,tvs,t); } if (isNull(nfr)) { return t; } take(ntvs,tvs); return mkPolyType(nfr,t); } static Type local depTypeExp(line,tyvars,type) Int line; List tyvars; Type type; { switch (whatIs(type)) { case AP : fst(type) = depTypeExp(line,tyvars,fst(type)); snd(type) = depTypeExp(line,tyvars,snd(type)); break; case VARIDCELL : return depTypeVar(line,tyvars,textOf(type)); case QUALIDENT : if (isQVar(type)) { ERRMSG(line) "Qualified type variables not allowed" EEND; } /* deliberate fall through */ case CONIDCELL : { Tycon tc = findQualTycon(type); if (isNull(tc)) { ERRMSG(line) "Undefined type constructor \"%s\"", identToStr(type) EEND; } if ( whatIs(type) != QUALIDENT ) { checkTyconAmbig(line,tycon(tc).text,tc); } if (cellIsMember(tc,tyconDefns) && !cellIsMember(tc,tcDeps)) { tcDeps = cons(tc,tcDeps); } return tc; } #if TREX case EXT : trexUsed(); h98DoesntSupport(line,"extensible records"); #endif case TYCON : case TUPLE : break; default : internal("depTypeExp"); } return type; } static Type local depTypeVar(line,tyvars,tv) Int line; List tyvars; Text tv; { Int offset = 0; Int found = (-1); for (; nonNull(tyvars); offset++) { if (tv==textOf(hd(tyvars))) { found = offset; } tyvars = tl(tyvars); } if (found<0) { Cell vt = findBtyvs(tv); if (nonNull(vt)) { return fst(vt); } ERRMSG(line) "Undefined type variable \"%s\"", textToStr(tv) EEND; } return mkOffset(found); } static List local checkQuantVars(line,vs,tvs,body) Int line; List vs; /* variables to quantify over */ List tvs; /* variables already in scope */ Cell body; { /* type/constr for scope of vars */ if (nonNull(vs)) { List bvs = typeVarsIn(body,NIL,NIL,NIL); List us = vs; for (; nonNull(us); us=tl(us)) { Text u = textOf(hd(us)); if (varIsMember(u,tl(us))) { ERRMSG(line) "Repeated quantified variable %s", textToStr(u) EEND; } #if 0 if (varIsMember(u,tvs)) { ERRMSG(line) "Local quantifier for %s hides an outer use", textToStr(u) EEND; } #endif if (!varIsMember(u,bvs)) { ERRMSG(line) "Locally quantified variable %s is not used", textToStr(u) EEND; } } tvs = appendOnto(tvs,vs); } return tvs; } /* -------------------------------------------------------------------------- * Check for ambiguous types: * A type Preds => type is ambiguous if not (TV(P) `subset` TV(type)) * ------------------------------------------------------------------------*/ static List local offsetTyvarsIn(t,vs) /* add list of offset tyvars in t */ Type t; /* to list vs */ List vs; { switch (whatIs(t)) { case AP : return offsetTyvarsIn(fun(t), offsetTyvarsIn(arg(t),vs)); case OFFSET : if (cellIsMember(t,vs)) return vs; else return cons(t,vs); case QUAL : return offsetTyvarsIn(snd(t),vs); case POLYTYPE : return offsetTyvarsIn(monotypeOf(t),vs); /* slightly inaccurate, but won't matter here */ case EXIST : case RANK2 : return offsetTyvarsIn(snd(snd(t)),vs); default : return vs; } } List zonkTyvarsIn(t,vs) Type t; List vs; { switch (whatIs(t)) { case AP : return zonkTyvarsIn(fun(t), zonkTyvarsIn(arg(t),vs)); case INTCELL : if (cellIsMember(t,vs)) return vs; else return cons(t,vs); /* this case will lead to a type error -- much better than reporting an internal error ;-) */ /* case OFFSET : internal("zonkTyvarsIn"); */ default : return vs; } } static List local otvars(pi,os) /* os is a list of offsets that */ Cell pi; /* refer to the arguments of pi; */ List os; { /* find list of offsets in those */ List us = NIL; /* positions */ for (; nonNull(os); os=tl(os)) { us = offsetTyvarsIn(nthArg(offsetOf(hd(os)),pi),us); } return us; } static List local otvarsZonk(pi,os,o) /* same as above, but zonks */ Cell pi; List os; Int o; { List us = NIL; for (; nonNull(os); os=tl(os)) { Type t = zonkType(nthArg(offsetOf(hd(os)),pi),o); us = zonkTyvarsIn(t,us); } return us; } static Bool local odiff(us,vs) List us, vs; { while (nonNull(us) && cellIsMember(hd(us),vs)) { us = tl(us); } return us; } static Bool local osubset(us,vs) /* Determine whether us is subset */ List us, vs; { /* of vs */ while (nonNull(us) && cellIsMember(hd(us),vs)) { us = tl(us); } return isNull(us); } List oclose(fds,vs) /* Compute closure of vs wrt to fds*/ List fds; List vs; { Bool changed = TRUE; while (changed) { List fds1 = NIL; changed = FALSE; while (nonNull(fds)) { Cell fd = hd(fds); List next = tl(fds); if (osubset(fst(fd),vs)) { /* Test if fd applies */ List os = snd(fd); for (; nonNull(os); os=tl(os)) { if (!cellIsMember(hd(os),vs)) { vs = cons(hd(os),vs); changed = TRUE; } } } else { /* Didn't apply this time, so keep */ tl(fds) = fds1; fds1 = fds; } fds = next; } fds = fds1; } return vs; } Bool isAmbiguous(type) /* Determine whether type is */ Type type; { /* ambiguous */ if (isPolyType(type)) { type = monotypeOf(type); } if (isQualType(type)) { /* only qualified types can be */ List ps = fst(snd(type)); /* ambiguous */ List tvps = offsetTyvarsIn(ps,NIL); List tvts = offsetTyvarsIn(snd(snd(type)),NIL); List fds = calcFunDeps(ps); tvts = oclose(fds,tvts); /* Close tvts under fds */ return !osubset(tvps,tvts); } return FALSE; } List calcFunDeps(ps) List ps; { List fds = NIL; for (; nonNull(ps); ps=tl(ps)) {/* Calc functional dependencies */ Cell pi = hd(ps); Cell c = getHead(pi); if (isClass(c)) { List xfs = cclass(c).xfds; for (; nonNull(xfs); xfs=tl(xfs)) { List fs = snd(hd(xfs)); for (; nonNull(fs); fs=tl(fs)) { fds = cons(pair(otvars(pi,fst(hd(fs))), otvars(pi,snd(hd(fs)))),fds); } } } #if IPARAM else if (isIP(c)) { fds = cons(pair(NIL,offsetTyvarsIn(arg(pi),NIL)),fds); } #endif } return fds; } List calcFunDepsPreds(ps) List ps; { List fds = NIL; for (; nonNull(ps); ps=tl(ps)) {/* Calc functional dependencies */ Cell pi3 = hd(ps); Cell pi = fst3(pi3); Cell c = getHead(pi); Int o = intOf(snd3(pi3)); if (isClass(c)) { List xfs = cclass(c).xfds; for (; nonNull(xfs); xfs=tl(xfs)) { List fs = snd(hd(xfs)); for (; nonNull(fs); fs=tl(fs)) { fds = cons(pair(otvarsZonk(pi,fst(hd(fs)),o), otvarsZonk(pi,snd(hd(fs)),o)),fds); } } } #if IPARAM else if (isIP(c)) { fds = cons(pair(NIL,zonkTyvarsIn(arg(pi),NIL)),fds); } #endif } return fds; } Void ambigError(line,where,e,type) /* produce error message for */ Int line; /* ambiguity */ String where; Cell e; Type type; { ERRMSG(line) "Ambiguous type signature in %s", where ETHEN ERRTEXT "\n*** ambiguous type : " ETHEN ERRTYPE(type); if (nonNull(e)) { ERRTEXT "\n*** assigned to : " ETHEN ERREXPR(e); } ERRTEXT "\n" EEND; } /* -------------------------------------------------------------------------- * Kind inference for simple types: * ------------------------------------------------------------------------*/ static Void local kindConstr(line,alpha,m,c) Int line; /* Determine kind of constructor */ Int alpha; Int m; Cell c; { Cell h = getHead(c); Int n = argCount; #if DEBUG_KINDS Printf("kindConstr: alpha=%d, m=%d, c=",alpha,m); printType(stdout,c); Printf("\n"); #endif switch (whatIs(h)) { case POLYTYPE : if (n!=0) { internal("kindConstr1"); } else { static String pt = "polymorphic type"; Type t = dropRank1(c,alpha,m); Kinds ks = polySigOf(t); Int m1 = 0; Int beta; for (; isAp(ks); ks=tl(ks)) { m1++; } beta = newKindvars(m1); unkindTypes = cons(pair(mkInt(beta),t),unkindTypes); checkKind(line,beta,m1,monotypeOf(t),NIL,pt,STAR,0); } return; case CDICTS : case QUAL : if (n!=0) { internal("kindConstr2"); } map3Proc(kindPred,line,alpha,m,fst(snd(c))); kindConstr(line,alpha,m,snd(snd(c))); return; case EXIST : case RANK2 : kindConstr(line,alpha,m,snd(snd(c))); return; #if TREX case EXT : if (n!=2) { ERRMSG(line) "Illegal use of row in " ETHEN ERRTYPE(c); ERRTEXT "\n" EEND; } break; #endif case TYCON : if (isSynonym(h) && n ... -> vn -> w */ shouldKind(line,h,c,app,k,beta); for (i=n; i>0; --i) { /* ci :: vi for each 1 <- 1..n */ checkKind(line,alpha,m,arg(a),c,app,aVar,beta+i-1); a = fun(a); } tyvarType(beta+n); /* inferred kind is w */ } } static Kind local kindAtom(alpha,c) /* Find kind of atomic constructor */ Int alpha; Cell c; { switch (whatIs(c)) { case TUPLE : return simpleKind(tupleOf(c)); /*(,)::* -> * -> * */ case OFFSET : return mkInt(alpha+offsetOf(c)); case TYCON : return tycon(c).kind; case INTCELL : return c; case VARIDCELL : case VAROPCELL : { Cell vt = findBtyvs(textOf(c)); if (nonNull(vt)) { return snd(vt); } } #if TREX case EXT : return extKind; #endif } #if DEBUG_KINDS Printf("kindAtom(%d,whatIs(%d)) on ",alpha,whatIs(c)); printType(stdout,c); Printf("\n"); #endif internal("kindAtom"); return STAR;/* not reached */ } static Void local kindPred(l,alpha,m,pi)/* Check kinds of arguments in pred*/ Int l; Int alpha; Int m; Cell pi; { #if TREX if (isAp(pi) && isExt(fun(pi))) { static String lackspred = "lacks predicate"; checkKind(l,alpha,m,arg(pi),NIL,lackspred,ROW,0); return; } #endif #if IPARAM if (isAp(pi) && isIP(fun(pi))) { static String ippred = "iparam predicate"; checkKind(l,alpha,m,arg(pi),NIL,ippred,STAR,0); return; } #endif { static String predicate = "class constraint"; Class c = getHead(pi); List as = getArgs(pi); Kinds ks = cclass(c).kinds; while (nonNull(ks)) { checkKind(l,alpha,m,hd(as),NIL,predicate,hd(ks),0); ks = tl(ks); as = tl(as); } } } static Void local kindType(line,wh,type)/* check that (poss qualified) type*/ Int line; /* is well-kinded */ String wh; Type type; { checkKind(line,0,0,type,NIL,wh,STAR,0); } static Void local fixKinds() { /* add kind annotations to types */ for (; nonNull(unkindTypes); unkindTypes=tl(unkindTypes)) { Pair pr = hd(unkindTypes); Int beta = intOf(fst(pr)); Cell qts = polySigOf(snd(pr)); for (;;) { if (isNull(hd(qts))) { hd(qts) = copyKindvar(beta++); } else { internal("fixKinds"); } if (nonNull(tl(qts))) { qts = tl(qts); } else { tl(qts) = STAR; break; } } #if DEBUG_KINDS Printf("Type expression: "); printType(stdout,snd(pr)); Printf(" :: "); printKind(stdout,polySigOf(snd(pr))); Printf("\n"); #endif } } /* -------------------------------------------------------------------------- * Kind checking of groups of type constructors and classes: * ------------------------------------------------------------------------*/ static Void local kindTCGroup(tcs) /* find kinds for mutually rec. gp */ List tcs; { /* of tycons and classes */ emptySubstitution(); unkindTypes = NIL; mapProc(initTCKind,tcs); mapProc(kindTC,tcs); mapProc(genTC,tcs); fixKinds(); emptySubstitution(); } static Void local initTCKind(c) /* build initial kind/arity for c */ Cell c; { if (isTycon(c)) { /* Initial kind of tycon is: */ Int beta = newKindvars(1); /* v1 -> ... -> vn -> vn+1 */ varKind(tycon(c).arity); /* where n is the arity of c. */ bindTv(beta,typeIs,typeOff); /* For data definitions, vn+1 == * */ switch (whatIs(tycon(c).what)) { case NEWTYPE : case DATATYPE : bindTv(typeOff+tycon(c).arity,STAR,0); } tycon(c).kind = mkInt(beta); } else { Int n = cclass(c).arity; Int beta = newKindvars(n); cclass(c).kinds = NIL; while (n>0) { n--; cclass(c).kinds = pair(mkInt(beta+n),cclass(c).kinds); } } } static Void local kindTC(c) /* check each part of a tycon/class*/ Cell c; { /* is well-kinded */ if (isTycon(c)) { static String cfun = "data constructor"; static String tsyn = "synonym declaration"; Int line = tycon(c).line; Int beta = tyvar(intOf(tycon(c).kind))->offs; Int m = tycon(c).arity; switch (whatIs(tycon(c).what)) { case NEWTYPE : case DATATYPE : { List cs = tycon(c).defn; if (isQualType(cs)) { map3Proc(kindPred,line,beta,m, fst(snd(cs))); tycon(c).defn = cs = snd(snd(cs)); } for (; hasCfun(cs); cs=tl(cs)) { kindType(line,cfun,name(hd(cs)).type); } break; } default : checkKind(line,beta,m,tycon(c).defn,NIL, tsyn,aVar,beta+m); } } else { /* scan type exprs in class defn to*/ List ms = fst(cclass(c).members); Int m = cclass(c).arity; /* determine the class signature */ Int beta = newKindvars(length(cclass(c).tyvars)); kindPred(cclass(c).line,beta,m,cclass(c).head); map3Proc(kindPred,cclass(c).line,beta,m,cclass(c).supers); for (; nonNull(ms); ms=tl(ms)) { Int line = intOf(fst3(hd(ms))); Type type = thd3(hd(ms)); kindType(line,"member function type signature",type); } } } static Void local genTC(c) /* generalise kind inferred for */ Cell c; { /* given tycon/class */ if (isTycon(c)) { tycon(c).kind = copyKindvar(intOf(tycon(c).kind)); #if DEBUG_KINDS Printf("%s :: ",textToStr(tycon(c).text)); printKind(stdout,tycon(c).kind); Putchar('\n'); #endif } else { Kinds ks = cclass(c).kinds; for (; nonNull(ks); ks=tl(ks)) { hd(ks) = copyKindvar(intOf(hd(ks))); } #if DEBUG_KINDS Printf("%s :: ",textToStr(cclass(c).text)); printKinds(stdout,cclass(c).kinds); Putchar('\n'); #endif } } /* -------------------------------------------------------------------------- * Static analysis of instance declarations: * * The first part of the static analysis is performed as the declarations * are read during parsing: * - make new entry in instance table * - record line number of declaration * - build list of instances defined in current script for use in later * stages of static analysis. * ------------------------------------------------------------------------*/ Void instDefn(line,head,ms) /* process new instance definition */ Int line; /* definition line number */ Cell head; /* inst header :: (context,Class) */ List ms; { /* instance members */ Inst nw = newInst(); inst(nw).line = line; inst(nw).specifics = fst(head); inst(nw).head = snd(head); inst(nw).implements = ms; instDefns = cons(nw,instDefns); } /* -------------------------------------------------------------------------- * Further static analysis of instance declarations: * * Makes the following checks: * - Class part of header has form C (T a1 ... an) where C is a known * class, and T is a known datatype constructor (or restricted synonym), * and there is no previous C-T instance, and (T a1 ... an) has a kind * appropriate for the class C. * - Each element of context is a valid class expression, with type vars * drawn from a1, ..., an. * - All bindings are function bindings * - All bindings define member functions for class C * - Arrange bindings into appropriate order for member list * - No top level type signature declarations * ------------------------------------------------------------------------*/ Bool allowOverlap = FALSE; /* TRUE => allow overlapping insts */ Bool allowUnsafeOverlap = FALSE; /* TRUE => in addition, allow */ /* potentially inconsistent */ /* overlapping instances */ Name nameListMonad = NIL; /* builder function for List Monad */ static Void local checkInstDefn(in) /* Validate instance declaration */ Inst in; { Int line = inst(in).line; List tyvars = typeVarsIn(inst(in).head,NIL,NIL,NIL); List tvps = NIL, tvts = NIL; List fds = NIL; #if !HASKELL_98_ONLY if (haskell98) { /* Check for `simple' type */ #endif List tvs = NIL; Cell t = arg(inst(in).head); for (; isAp(t); t=fun(t)) { if (!isVar(arg(t))) { ERRMSG(line) "Syntax error in instance head (variable expected)" EEND; } if (varIsMember(textOf(arg(t)),tvs)) { ERRMSG(line) "Repeated type variable \"%s\" in instance head", textToStr(textOf(arg(t))) EEND; } tvs = cons(arg(t),tvs); #if !HASKELL_98_ONLY } #endif if (isVar(t)) { ERRMSG(line) "Syntax error in instance head (constructor expected)" EEND; } } /* add in the tyvars from the `specifics' so that we don't prematurely complain about undefined tyvars */ tyvars = typeVarsIn(inst(in).specifics,NIL,NIL,tyvars); inst(in).head = depPredExp(line,tyvars,inst(in).head); #if !HASKELL_98_ONLY if (haskell98) #endif { Type h = getHead(arg(inst(in).head)); if (isSynonym(h)) { ERRMSG(line) "Cannot use type synonym in instance head" EEND; } } map2Over(depPredExp,line,tyvars,inst(in).specifics); /* OK, now we start over, and test for ambiguity */ tvts = offsetTyvarsIn(inst(in).head,NIL); tvps = offsetTyvarsIn(inst(in).specifics,NIL); fds = calcFunDeps(inst(in).specifics); tvts = oclose(fds,tvts); tvts = odiff(tvps,tvts); if (!isNull(tvts)) { ERRMSG(line) "Ambiguous type variable \"%s\"", textToStr(textOf(nth(offsetOf(hd(tvts)),tyvars))) EEND; } h98CheckCtxt(line,"instance declaration",FALSE,inst(in).specifics,NIL); inst(in).numSpecifics = length(inst(in).specifics); inst(in).c = getHead(inst(in).head); if (!isClass(inst(in).c)) { ERRMSG(line) "Illegal predicate in instance declaration" EEND; } /* should this be over xfds? */ if (nonNull(cclass(inst(in).c).fds)) { List fds = cclass(inst(in).c).fds; for (; nonNull(fds); fds=tl(fds)) { List as = otvars(inst(in).head, fst(hd(fds))); List bs = otvars(inst(in).head, snd(hd(fds))); List fs = calcFunDeps(inst(in).specifics); as = oclose(fs,as); if (!osubset(bs,as)) { ERRMSG(inst(in).line) "Instance is more general than a dependency allows" ETHEN ERRTEXT "\n*** Instance : " ETHEN ERRPRED(inst(in).head); ERRTEXT "\n*** For class : " ETHEN ERRPRED(cclass(inst(in).c).head); ERRTEXT "\n*** Under dependency : " ETHEN ERRFD(hd(fds)); ERRTEXT "\n" EEND; } } } kindInst(in,length(tyvars)); insertInst(in); if (nonNull(extractSigdecls(inst(in).implements))) { ERRMSG(line) "Type signature declarations not permitted in instance declaration" EEND; } if (nonNull(extractFixdecls(inst(in).implements))) { ERRMSG(line) "Fixity declarations not permitted in instance declaration" EEND; } inst(in).implements = classBindings("instance", inst(in).c, extractBindings(inst(in).implements)); inst(in).builder = newInstImp(in); if (!preludeLoaded && isNull(nameListMonad) && isAp(inst(in).head) && fun(inst(in).head)==classMonad && arg(inst(in).head)==typeList) { nameListMonad = inst(in).builder; } } static Void local insertInst(in) /* Insert instance into class */ Inst in; { Class c = inst(in).c; List ins = cclass(c).instances; List prev = NIL; if (nonNull(cclass(c).fds)) { /* Check for conflicts with fds */ List ins1 = cclass(c).instances; for (; nonNull(ins1); ins1=tl(ins1)) { List fds = cclass(c).fds; substitution(RESET); for (; nonNull(fds); fds=tl(fds)) { Int alpha = newKindedVars(inst(in).kinds); Int beta = newKindedVars(inst(hd(ins1)).kinds); List as = fst(hd(fds)); Bool same = TRUE; for (; same && nonNull(as); as=tl(as)) { Int n = offsetOf(hd(as)); same &= unify(nthArg(n,inst(in).head),alpha, nthArg(n,inst(hd(ins1)).head),beta); } if (isNull(as) && same) { for (as=snd(hd(fds)); same && nonNull(as); as=tl(as)) { Int n = offsetOf(hd(as)); same &= sameType(nthArg(n,inst(in).head),alpha, nthArg(n,inst(hd(ins1)).head),beta); } if (!same) { ERRMSG(inst(in).line) "Instances are not consistent with dependencies" ETHEN ERRTEXT "\n*** This instance : " ETHEN ERRPRED(inst(in).head); ERRTEXT "\n*** Conflicts with : " ETHEN ERRPRED(inst(hd(ins1)).head); ERRTEXT "\n*** For class : " ETHEN ERRPRED(cclass(c).head); ERRTEXT "\n*** Under dependency : " ETHEN ERRFD(hd(fds)); ERRTEXT "\n" EEND; } } } } } substitution(RESET); while (nonNull(ins)) { /* Look for overlap w/ other insts */ Int alpha = newKindedVars(inst(in).kinds); Int beta = newKindedVars(inst(hd(ins)).kinds); if (unifyPred(inst(in).head,alpha,inst(hd(ins)).head,beta)) { Cell pi = copyPred(inst(in).head,alpha); #if !HASKELL_98_ONLY if ((allowOverlap || allowUnsafeOverlap) && !haskell98) { Bool bef = instCompare(in,hd(ins)); Bool aft = instCompare(hd(ins),in); if (bef && !aft) { /* in comes strictly before hd(ins)*/ break; } if (aft && !bef) { /* in comes strictly after hd(ins) */ prev = ins; ins = tl(ins); continue; } } #endif #if MULTI_INST if (multiInstRes && nonNull(inst(in).specifics)) { break; } else { #endif ERRMSG(inst(in).line) "Overlapping instances for class \"%s\"", textToStr(cclass(c).text) ETHEN ERRTEXT "\n*** This instance : " ETHEN ERRPRED(inst(in).head); ERRTEXT "\n*** Overlaps with : " ETHEN ERRPRED(inst(hd(ins)).head); ERRTEXT "\n*** Common instance : " ETHEN ERRPRED(pi); ERRTEXT "\n" EEND; #if MULTI_INST } #endif } prev = ins; /* No overlap detected, so move on */ ins = tl(ins); /* to next instance */ } substitution(RESET); if (nonNull(prev)) { /* Insert instance at this point */ tl(prev) = cons(in,ins); } else { cclass(c).instances = cons(in,ins); } } static Bool local instCompare(ia,ib) /* See if ia is an instance of ib */ Inst ia, ib;{ Int alpha = newKindedVars(inst(ia).kinds); Int beta = newKindedVars(inst(ib).kinds); return matchPred(inst(ia).head,alpha,inst(ib).head,beta); } static Name local newInstImp(in) /* Make definition for inst builder*/ Inst in; { Name b = newName(inventText(),in); name(b).line = inst(in).line; name(b).arity = inst(in).numSpecifics; name(b).number = DFUNNAME; return b; } /* -------------------------------------------------------------------------- * Kind checking of instance declaration headers: * ------------------------------------------------------------------------*/ static Void local kindInst(in,freedom) /* check predicates in instance */ Inst in; Int freedom; { Int beta; emptySubstitution(); beta = newKindvars(freedom); kindPred(inst(in).line,beta,freedom,inst(in).head); if (whatIs(inst(in).specifics)!=DERIVE) { map3Proc(kindPred,inst(in).line,beta,freedom,inst(in).specifics); } for (inst(in).kinds = NIL; 0 Show (T a) where ... * instance (Show a) => Show (T a) where ... * * (assuming, of course, that instance (Show a) => Show [a]). For now, we * choose to reduce contexts in the hope of detecting errors at an earlier * stage---in contrast with value definitions, there is no way for a user * to provide something analogous to a `type signature' by which they might * be able to control this behaviour themselves. We eliminate tautological * predicates, but only allow predicates to appear in the final result if * they have at least one argument with a variable at its head. * * In general, we have to deal with mutually recursive instance declarations. * We find a solution in the obvious way by iterating to find a fixed point. * Of course, without restrictions on the form of instance declarations, we * cannot be sure that this will always terminate! * * For each instance we maintain a pair of the form DERIVE (ctxt,ps). * Ctxt is a list giving the parts of the context that have been produced * so far in the form of predicate skeletons. During the calculation of * derived instances, we attach a dummy NIL value to the end of the list * which acts as a kind of `variable': other parts of the system maintain * pointers to this variable, and use it to detect when the context has * been extended with new elements. Meanwhile, ps is a list containing * predicates (pi,o) together with (delayed) substitutions of the form * (o,xs) where o is an offset and xs is one of the context variables * described above, which may have been partially instantiated. * ------------------------------------------------------------------------*/ static Bool instsChanged; static Void local deriveContexts(is) /* Calc contexts for derived insts */ List is; { emptySubstitution(); mapProc(initDerInst,is); /* Prepare derived instances */ do { /* Main calculation of contexts */ instsChanged = FALSE; mapProc(calcInstPreds,is); } while (instsChanged); mapProc(tidyDerInst,is); /* Tidy up results */ } static Void local initDerInst(in) /* Prepare instance for calculation*/ Inst in; { /* of derived instance context */ Cell spcs = inst(in).specifics; Int beta = newKindedVars(inst(in).kinds); if (whatIs(spcs)!=DERIVE) { internal("initDerInst"); } fst(snd(spcs)) = appendOnto(fst(snd(spcs)),singleton(NIL)); for (spcs=snd(snd(spcs)); nonNull(spcs); spcs=tl(spcs)) { hd(spcs) = ap2(inst(in).c,hd(spcs),mkInt(beta)); } inst(in).numSpecifics = beta; #if DEBUG_DERIVING Printf("initDerInst: "); printPred(stdout,inst(in).head); Printf("\n"); printContext(stdout,snd(snd(inst(in).specifics))); Printf("\n"); #endif } static Void local calcInstPreds(in) /* Calculate next approximation */ Inst in; { /* of the context for a derived */ List retain = NIL; /* instance */ List ps = snd(snd(inst(in).specifics)); List spcs = fst(snd(inst(in).specifics)); Int beta = inst(in).numSpecifics; Int its = 1; Int factor = 1+length(ps); #if DEBUG_DERIVING Printf("calcInstPreds: "); printPred(stdout,inst(in).head); Printf("\n"); #endif while (nonNull(ps)) { Cell p = hd(ps); ps = tl(ps); if (its++ >= factor*cutoff) { Cell bpi = inst(in).head; ERRMSG(inst(in).line) "\n*** Cannot derive " ETHEN ERRPRED(bpi); ERRTEXT " after %d iterations.", its-1 ETHEN ERRTEXT "\n*** This may indicate that the problem is undecidable. However,\n" ETHEN ERRTEXT "*** you may still try to increase the cutoff limit using the -c\n" ETHEN ERRTEXT "*** option and then try again. (The current setting is -c%d)\n", cutoff EEND; } if (isInt(fst(p))) { /* Delayed substitution? */ List qs = snd(p); for (; nonNull(hd(qs)); qs=tl(qs)) { ps = cons(pair(hd(qs),fst(p)),ps); } retain = cons(pair(fst(p),qs),retain); } #if TREX else if (isExt(fun(fst(p)))) { /* Lacks predicate */ Text l = extText(fun(fst(p))); Type t = arg(fst(p)); Int o = intOf(snd(p)); Type h; Tyvar *tyv; deRef(tyv,t,o); h = getDerefHead(t,o); while (isExt(h) && argCount==2 && l!=extText(h)) { t = arg(t); deRef(tyv,t,o); h = getDerefHead(t,o); } if (argCount==0 && isOffset(h)) { maybeAddPred(ap(fun(fun(p)),h),o,beta,spcs); } else if (argCount!=0 || h!=typeNoRow) { Cell bpi = inst(in).head; Cell pi = copyPred(fun(p),intOf(snd(p))); ERRMSG(inst(in).line) "Cannot derive " ETHEN ERRPRED(bpi); ERRTEXT " because predicate " ETHEN ERRPRED(pi); ERRTEXT " does not hold\n" EEND; } } #endif else { /* Class predicate */ Cell pi = fst(p); Int o = intOf(snd(p)); Inst in1 = findInstFor(pi,o); if (nonNull(in1)) { List qs = inst(in1).specifics; Int off = mkInt(typeOff); if (whatIs(qs)==DERIVE) { /* Still being derived */ for (qs=fst(snd(qs)); nonNull(hd(qs)); qs=tl(qs)) { ps = cons(pair(hd(qs),off),ps); } retain = cons(pair(off,qs),retain); } else { /* Previously def'd inst */ for (; nonNull(qs); qs=tl(qs)) { ps = cons(pair(hd(qs),off),ps); } } } else { /* No matching instance */ Cell qi = pi; while (isAp(qi) && isOffset(getDerefHead(arg(qi),o))) { qi = fun(qi); } if (isAp(qi)) { Cell bpi = inst(in).head; pi = copyPred(pi,o); ERRMSG(inst(in).line) "An instance of " ETHEN ERRPRED(pi); ERRTEXT " is required to derive " ETHEN ERRPRED(bpi); ERRTEXT "\n" EEND; } else { maybeAddPred(pi,o,beta,spcs); } } } } snd(snd(inst(in).specifics)) = retain; } static Void local maybeAddPred(pi,o,beta,ps) Cell pi; /* Add predicate pi to the list ps,*/ Int o; /* setting the instsChanged flag if*/ Int beta; /* pi is not already a member and */ List ps; { /* using beta to adjust vars */ Cell c = getHead(pi); for (; nonNull(ps); ps=tl(ps)) { if (isNull(hd(ps))) { /* reached the `dummy' end of list?*/ hd(ps) = copyAdj(pi,o,beta); tl(ps) = pair(NIL,NIL); instsChanged = TRUE; return; } else if (c==getHead(hd(ps)) && samePred(pi,o,hd(ps),beta)) { return; } } } static Cell local copyAdj(c,o,beta) /* Copy (c,o), replacing vars with */ Cell c; /* offsets relative to beta. */ Int o; Int beta; { switch (whatIs(c)) { case AP : { Cell l = copyAdj(fst(c),o,beta); Cell r = copyAdj(snd(c),o,beta); return ap(l,r); } case OFFSET : { Int vn = o+offsetOf(c); Tyvar *tyv = tyvar(vn); if (isBound(tyv)) { return copyAdj(tyv->bound,tyv->offs,beta); } vn -= beta; if (vn<0 || vn>=NUM_OFFSETS) { internal("copyAdj"); } return mkOffset(vn); } } return c; } static Void local tidyDerInst(in) /* Tidy up results of derived inst */ Inst in; { /* calculations */ Int o = inst(in).numSpecifics; List ps = tl(rev(fst(snd(inst(in).specifics)))); clearMarks(); copyPred(inst(in).head,o); inst(in).specifics = simpleContext(ps,o); h98CheckCtxt(inst(in).line,"derived instance",FALSE,inst(in).specifics,in); inst(in).numSpecifics = length(inst(in).specifics); #if DEBUG_DERIVING Printf("Derived instance: "); printContext(stdout,inst(in).specifics); Printf(" ||- "); printPred(stdout,inst(in).head); Printf("\n"); #endif } /* -------------------------------------------------------------------------- * Generate code for derived instances: * ------------------------------------------------------------------------*/ static Void local addDerivImp(in) Inst in; { List imp = NIL; Type t = getHead(arg(inst(in).head)); Class c = inst(in).c; if (c==classEq) { imp = deriveEq(t); } else if (c==classOrd) { imp = deriveOrd(t); } else if (c==classEnum) { imp = deriveEnum(t); } else if (c==classIx) { imp = deriveIx(t); } else if (c==classShow) { imp = deriveShow(t); } else if (c==classRead) { imp = deriveRead(t); } else if (c==classBounded) { imp = deriveBounded(t); } else { ERRMSG(inst(in).line) "Cannot derive instances of class \"%s\"", textToStr(cclass(inst(in).c).text) EEND; } kindInst(in,intOf(inst(in).kinds)); insertInst(in); inst(in).builder = newInstImp(in); inst(in).implements = classBindings("derived instance", inst(in).c, imp); } static List diVars = NIL; /* Acts as a cache of invented vars*/ static Int diNum = 0; static List local getDiVars(n) /* get list of at least n vars for */ Int n; { /* derived instance generation */ for (; diNum [a] * range (X a b c, X p q r) * = [ X x y z | x <- range (a,p), y <- range (b,q), z <- range (c,r) ] */ Cell is1 = is; List e = NIL; for (; isAp(ls); ls=fun(ls), us=fun(us), is=fun(is)) { e = cons(ap(FROMQUAL,pair(arg(is), ap(nameRange,ap2(mkTuple(2), arg(ls), arg(us))))),e); } e = ap(COMP,pair(is1,e)); e = singleton(pair(pats,pair(mkInt(line),e))); return mkBind("range",e); } static Cell local prodIndex(line,pats,ls,us,is) Int line; /* Make definition of index for a */ List pats; /* product type */ Cell ls, us, is; { /* index :: (a,a) -> a -> Bool * index (X a b c, X p q r) (X x y z) * = index (c,r) z + rangeSize (c,r) * ( * index (b,q) y + rangeSize (b,q) * ( * index (a,x) x)) */ List xs = NIL; Cell e = NIL; for (; isAp(ls); ls=fun(ls), us=fun(us), is=fun(is)) { xs = cons(ap2(nameIndex,ap2(mkTuple(2),arg(ls),arg(us)),arg(is)),xs); } for (e=hd(xs); nonNull(xs=tl(xs));) { Cell x = hd(xs); e = ap2(namePlus,x,ap2(nameMult,ap(nameRangeSize,arg(fun(x))),e)); } e = singleton(pair(pats,pair(mkInt(line),e))); return mkBind("index",e); } static Cell local prodInRange(line,pats,ls,us,is) Int line; /* Make definition of inRange for a*/ List pats; /* product type */ Cell ls, us, is; { /* inRange :: (a,a) -> a -> Bool * inRange (X a b c, X p q r) (X x y z) * = inRange (a,p) x && inRange (b,q) y && inRange (c,r) z */ Cell e = ap2(nameInRange,ap2(mkTuple(2),arg(ls),arg(us)),arg(is)); while (ls=fun(ls), us=fun(us), is=fun(is), isAp(ls)) { e = ap2(nameAnd, ap2(nameInRange,ap2(mkTuple(2),arg(ls),arg(us)),arg(is)), e); } e = singleton(pair(pats,pair(mkInt(line),e))); return mkBind("inRange",e); } /* -------------------------------------------------------------------------- * Deriving Show: * ------------------------------------------------------------------------*/ static List local deriveShow(t) /* Construct definition of text conversion */ Tycon t; { List alts = NIL; if (isTycon(t)) { /* deal with type constrs */ List cs = tycon(t).defn; for (; hasCfun(cs); cs=tl(cs)) { alts = cons(mkAltShow(tycon(t).line,hd(cs),userArity(hd(cs))), alts); } alts = rev(alts); } else { /* special case for tuples */ alts = singleton(mkAltShow(0,t,tupleOf(t))); } return singleton(mkBind("showsPrec",alts)); } static Cell local mkAltShow(line,h,a) /* make alt for showsPrec eqn */ Int line; Cell h; Int a; { List vs = getDiVars(a+1); Cell d = hd(vs); Cell pat = h; List pats = NIL; Int i = 0; for (vs=tl(vs); i1; --i) { rhs = ap(showsCM,ap2(nameComp,ap(shows0,arg(pat)),rhs)); pat = fun(pat); } return ap(showsOP,ap2(nameComp,ap(shows0,arg(pat)),rhs)); } for (; nonNull(cfs) && h!=fst(hd(cfs)); cfs=tl(cfs)) { } if (nonNull(cfs)) { /* To display a value using record syntax: * showsPrec d C{x=e, y=f, z=g} = * showString "C" . showString " {" . * showField "x" e . showString ", " . * showField "y" f . showString ", " . * showField "z" g . showChar '}' * showField lab val * = showString lab . showString " = " . shows val */ Cell rhs = showsCB; List vs = dupOnto(snd(hd(cfs)),NIL); if (isAp(pat)) { for (;;) { rhs = ap2(nameComp, ap2(nameShowField, mkStr(textOf(hd(vs))), arg(pat)), rhs); pat = fun(pat); vs = tl(vs); if (isAp(pat)) { rhs = ap(showsCM,ap(showsSP,rhs)); } else { break; } } } rhs = ap2(nameComp,ap(nameApp,mkStr(name(h).text)), ap(showsSP,ap(showsOB,rhs))); return rhs; } else if (a==0) { /* To display a nullary constructor: * showsPrec d Foo = showString "Foo" */ return ap(nameApp,mkStr(name(h).text)); } else { Syntax s = syntaxOf(h); if (a==2 && assocOf(s)!=APPLIC) { /* For a binary constructor with prec p: * showsPrec d (a :* b) = showParen (d > p) * (showsPrec lp a . showChar ' ' . * showsString s . showChar ' ' . * showsPrec rp b) */ Int p = precOf(s); Int lp = (p+1); /* how it was in Haskell from Day 1 until 11/4/2002: (assocOf(s)==LEFT_ASS) ? p : (p+1); */ Int rp = (p+1); /* ditto: (assocOf(s)==RIGHT_ASS) ? p : (p+1); */ Cell rhs = ap(showsSP,ap2(nameShowsPrec,mkInt(rp),arg(pat))); if (defaultSyntax(name(h).text)==APPLIC) { rhs = ap(showsBQ, ap2(nameComp, ap(nameApp,mkStr(fixLitText(name(h).text))), ap(showsBQ,rhs))); } else { rhs = ap2(nameComp, ap(nameApp,mkStr(fixLitText(name(h).text))),rhs); } rhs = ap2(nameComp, ap2(nameShowsPrec,mkInt(lp),arg(fun(pat))), ap(showsSP,rhs)); rhs = ap2(nameShowParen,ap2(nameGt,d,mkInt(p)),rhs); return rhs; } else { /* To display a non-nullary constructor with applicative syntax: * showsPrec d (Foo x y) = showParen (d>APP_PREC) * (showString "Foo" . * showChar ' ' . showsPrec (APP_PREC+1) x . * showChar ' ' . showsPrec (APP_PREC+1) y) */ Cell rhs = ap(showsSP,ap(showsN(APP_PREC+1),arg(pat))); for (pat=fun(pat); isAp(pat); pat=fun(pat)) { rhs = ap(showsSP,ap2(nameComp,ap(showsN(APP_PREC+1),arg(pat)),rhs)); } rhs = ap2(nameComp,ap(nameApp,mkStr(name(h).text)),rhs); rhs = ap2(nameShowParen,ap2(nameGt,d,mkInt(APP_PREC)),rhs); return rhs; } } } #undef showsN #undef shows0 #undef showsOP #undef showsOB #undef showsCM #undef showsSP #undef showsBQ #undef showsCP #undef showsCB /* -------------------------------------------------------------------------- * Deriving Read: * ------------------------------------------------------------------------*/ #define Tuple2(f,s) ap2(mkTuple(2),f,s) #define Lex(r) ap(nameLex,r) #define ZFexp(h,q) ap(FROMQUAL, pair(h,q)) #define ReadsPrec(n,e) ap2(nameReadsPrec,n,e) #define Lambda(v,e) ap(LAMBDA,pair(v, pair(mkInt(0),e))) #define ReadParen(a,b,c) ap(ap2(nameReadParen,a,b),c) #define ReadField(f,s) ap2(nameReadField,f,s) #define GT(l,r) ap2(nameGt,l,r) #define Append(a,b) ap2(nameApp,a,b) /* Construct the readsPrec function of the form: * * readsPrec d r = (readParen (d>p1) (\r -> [ (C1 ...,s) | ... ]) r ++ * (readParen (d>p2) (\r -> [ (C2 ...,s) | ... ]) r ++ * ... * (readParen (d>pn) (\r -> [ (Cn ...,s) | ... ]) r) ... )) */ static List local deriveRead(t) /* construct definition of text reader */ Cell t; { Cell alt = NIL; Cell exp = NIL; Cell d = inventVar(); Cell r = inventVar(); List pat = cons(d,cons(r,NIL)); Int line = 0; if (isTycon(t)) { List cs = tycon(t).defn; List exps = NIL; for (; hasCfun(cs); cs=tl(cs)) { exps = cons(mkReadCon(hd(cs),d,r),exps); } /* reverse concatenate list of subexpressions */ exp = hd(exps); for (exps=tl(exps); nonNull(exps); exps=tl(exps)) { exp = ap2(nameApp,hd(exps),exp); } line = tycon(t).line; } else { /* Tuples */ exp = ap(mkReadTuple(t),r); } /* printExp(stdout,exp); putc('\n',stdout); */ alt = pair(pat,pair(mkInt(line),exp)); return singleton(mkBind("readsPrec",singleton(alt))); } /* Generate an expression of the form: * * readParen (d > p) r * * for a (non-tuple) constructor "con" of precedence "p". */ static Cell local mkReadCon(con, d, r) /* generate reader for a constructor */ Name con; Cell d; Cell r; { Cell exp = NIL; Int p = 0; Syntax s = syntaxOf(con); List cfs = cfunSfuns; for (; nonNull(cfs) && con!=fst(hd(cfs)); cfs=tl(cfs)) { } if (nonNull(cfs)) { exp = mkReadRecord(con,snd(hd(cfs))); return ReadParen(nameFalse, exp, r); } if (userArity(con)==2 && assocOf(s)!=APPLIC) { exp = mkReadInfix(con); p = precOf(s); } else { exp = mkReadPrefix(con); p = APP_PREC; } return ReadParen(userArity(con)==0 ? nameFalse : GT(d,mkInt(p)), exp, r); } /* Given an n-ary prefix constructor, generate a single lambda * expression, such that * * data T ... = Constr a1 a2 .. an | .... * * derives * * \ r -> [ (Constr t1 t2 ... tn, sn) | ("Constr",s0) <- lex r, * (t1,s1) <- readsPrec (APP_PREC+1) s0, * (t2,s2) <- readsPrec (APP_PREC+1) s1, * ..., * (tn,sn) <- readsPrec (APP_PREC+1) sn-1 ] * */ static Cell local mkReadPrefix(con) /* readsPrec for prefix constructor */ Cell con; { Int arity = userArity(con); Cell cn = mkStr(name(con).text); Cell r = inventVar(); Cell prev_s = inventVar(); Cell exp = con; List quals = NIL; Int i; /* build (reversed) list of qualifiers and constructor */ quals = cons(ZFexp(Tuple2(cn,prev_s),Lex(r)),quals); for(i=0; i [ (exp, prev_s) | quals ] */ return Lambda(singleton(r),ap(COMP,pair(Tuple2(exp, prev_s), rev(quals)))); } /* Given a binary infix constructor of precedence p * * ... | T1 `con` T2 | ... * * generate the lambda expression * * \ r -> [ (u `con` v, s2) | (u,s0) <- readsPrec lp r, * ("con",s1) <- lex s0, * (v,s2) <- readsPrec rp s1 ] * * where lp and rp are either p or p+1 depending on associativity */ static Cell local mkReadInfix( con ) Cell con; { Syntax s = syntaxOf(con); Int p = precOf(s); Int lp = (p+1); /* how it was in Haskell from Day 1 until 11/4/2002: assocOf(s)==LEFT_ASS ? p : (p+1); */ Int rp = (p+1); /* ditto: assocOf(s)==RIGHT_ASS ? p : (p+1); */ Cell cn = mkStr(name(con).text); Cell r = inventVar(); Cell s0 = inventVar(); Cell s1 = inventVar(); Cell s2 = inventVar(); Cell u = inventVar(); Cell v = inventVar(); List quals = NIL; quals = cons(ZFexp(Tuple2(u, s0), ReadsPrec(mkInt(lp),r)), quals); quals = cons(ZFexp(Tuple2(cn,s1), Lex(s0)), quals); quals = cons(ZFexp(Tuple2(v, s2), ReadsPrec(mkInt(rp),s1)), quals); return Lambda(singleton(r), ap(COMP,pair(Tuple2(ap2(con,u,v),s2),rev(quals)))); } /* Given the n-ary tuple constructor return a lambda expression: * * \ r -> [ ((t1,t2,...tn),s(2n+1)) | ("(",s0) <- lex r, * (t1, s1) <- readsPrec 0 s0, * ... * (",",s(2n-1)) <- lex s(2n-2), * (tn, s(2n)) <- readsPrec 0 s(2n-1), * (")",s(2n+1)) <- lex s(2n) ] */ static Cell local mkReadTuple( tup ) /* readsPrec for n-tuple */ Cell tup; { Int arity = tupleOf(tup); Cell lp = mkStr(findText("(")); Cell rp = mkStr(findText(")")); Cell co = mkStr(findText(",")); Cell sep = lp; Cell r = inventVar(); Cell prev_s = r; Cell s = inventVar(); Cell exp = tup; List quals = NIL; Int i; /* build (reversed) list of qualifiers and constructor */ for(i=0; i [ (exp,s) | quals ] */ return Lambda(singleton(r),ap(COMP,pair(Tuple2(exp,s),rev(quals)))); } /* Given a record constructor * * ... | C { f1 :: T1, ... fn :: Tn } | ... * * generate the expression: * * \ r -> [(C t1 t2 ... tn,s(2n+1)) | ("C", s0) <- lex r, * ("{", s1) <- lex s0, * (t1, s2) <- readField "f1" s1, * ... * (",", s(2n-1)) <- lex s(2n), * (tn, s(2n)) <- readField "fn" s(2n+1), * ("}", s(2n+1)) <- lex s(2n+2) ] * * where * * readField :: Read a => String -> ReadS a * readField m s0 = [ r | (t, s1) <- lex s0, t == m, * ("=",s2) <- lex s1, * r <- reads s2 ] */ static Cell local mkReadRecord(con, fs) /* readsPrec for record constructor */ Cell con; List fs; { Cell cn = mkStr(name(con).text); Cell lb = mkStr(findText("{")); Cell rb = mkStr(findText("}")); Cell co = mkStr(findText(",")); Cell sep = lb; Cell r = inventVar(); Cell s0 = inventVar(); Cell prev_s = s0; Cell s = inventVar(); Cell exp = con; List quals = NIL; /* build (reversed) list of qualifiers and constructor */ quals = cons(ZFexp(Tuple2(cn,s0),Lex(r)), quals); for(; nonNull(fs); fs=tl(fs)) { Cell f = mkStr(textOf(hd(fs))); Cell t = inventVar(); Cell si = inventVar(); Cell sj = inventVar(); quals = cons(ZFexp(Tuple2(sep,si),Lex(prev_s)), quals); quals = cons(ZFexp(Tuple2(t, sj),ReadField(f,si)), quals); exp = ap(exp,t); prev_s = sj; sep = co; } quals = cons(ZFexp(Tuple2(rb,s),Lex(prev_s)),quals); /* \ r -> [ (exp,s) | quals ] */ return Lambda(singleton(r),ap(COMP,pair(Tuple2(exp,s),rev(quals)))); } #undef Tuple2 #undef Lex #undef ZFexp #undef ReadsPrec #undef Lambda #undef ReadParen #undef ReadField #undef GT #undef Append /* -------------------------------------------------------------------------- * Deriving Bounded: * ------------------------------------------------------------------------*/ static List local deriveBounded(t)/* construct definition of bounds */ Tycon t; { if (isEnumType(t)) { Cell last = tycon(t).defn; Cell first = hd(last); while (hasCfun(tl(last))) { last = tl(last); } return cons(mkBind("minBound",mkVarAlts(tycon(t).line,first)), cons(mkBind("maxBound",mkVarAlts(tycon(t).line,hd(last))), NIL)); } else if (isTuple(t)) { /* Definitions for product types */ return mkBndBinds(0,t,tupleOf(t)); } else if (isTycon(t) && cfunOf(hd(tycon(t).defn))==0) { return mkBndBinds(tycon(t).line, hd(tycon(t).defn), userArity(hd(tycon(t).defn))); } ERRMSG(tycon(t).line) "Can only derive instances of Bounded for enumeration and product types" EEND; return NIL; } static List local mkBndBinds(line,h,n) /* build bindings for derived */ Int line; /* Bounded on a product type */ Cell h; Int n; { Cell minB = h; Cell maxB = h; while (n-- > 0) { minB = ap(minB,nameMinBnd); maxB = ap(maxB,nameMaxBnd); } return cons(mkBind("minBound",mkVarAlts(line,minB)), cons(mkBind("maxBound",mkVarAlts(line,maxB)), NIL)); } /* -------------------------------------------------------------------------- * Default definitions; only one default definition is permitted in a * given script file. If no default is supplied, then a standard system * default will be used where necessary. * ------------------------------------------------------------------------*/ Void defaultDefn(line,defs) /* Handle default types definition */ Int line; List defs; { if (defaultLine!=0) { ERRMSG(line) "Multiple default declarations are not permitted in" ETHEN ERRTEXT " a single script file.\n" EEND; } defaultDefns = defs; defaultLine = line; } static Void local checkDefaultDefns() { /* check that default types are */ List ds = NIL; /* well-kinded instances of Num */ if (defaultLine!=0) { map2Over(depTypeExp,defaultLine,NIL,defaultDefns); emptySubstitution(); unkindTypes = NIL; map2Proc(kindType,defaultLine,"default type",defaultDefns); fixKinds(); emptySubstitution(); mapOver(fullExpand,defaultDefns); } else { defaultDefns = stdDefaults; } if (isNull(classNum)) { classNum = findClass(findText("Num")); } for (ds=defaultDefns; nonNull(ds); ds=tl(ds)) { if (isNull(provePred(NIL,NIL,ap(classNum,hd(ds))))) { ERRMSG(defaultLine) "Default types must be instances of the Num class" EEND; } } } /* -------------------------------------------------------------------------- * Primitive definitions are usually only included in the first script * file read - the prelude. A primitive definition associates a variable * name with a string (which identifies a built-in primitive) and a type. * ------------------------------------------------------------------------*/ Void primDefn(line,prims,type) /* Handle primitive definitions */ Cell line; List prims; Cell type; { primDefns = cons(triple(line,prims,type),primDefns); } static List local checkPrimDefn(pd) /* Check primitive definition */ Triple pd; { Int line = intOf(fst3(pd)); List prims = snd3(pd); Type type = thd3(pd); emptySubstitution(); type = checkSigType(line,"primitive declaration",fst(hd(prims)),type); for (; nonNull(prims); prims=tl(prims)) { Cell p = hd(prims); Bool same = isVar(p); Text pt = textOf(same ? p : fst(p)); String pr = textToStr(textOf(same ? p : snd(p))); hd(prims) = addNewPrim(line,pt,pr,type); } return snd3(pd); } static Name local addNewPrim(l,vn,s,t) /* make binding of variable vn to */ Int l; /* primitive function referred */ Text vn; /* to by s, with given type t */ String s; Cell t;{ Name n = findName(vn); if (isNull(n)) { n = newName(vn,NIL); } else if (name(n).defn!=PREDEFINED) { duplicateError(l,name(n).mod,vn,"primitive"); } addPrim(l,n,s,currentModule,t); return n; } /* -------------------------------------------------------------------------- * Foreign import declarations are Hugs' equivalent of GHC's ccall mechanism. * They are used to "import" C functions into a module. * Foreign export declarations allow Hugs functions to be called from C. * Foreign export declarations provide the address of a C symbol. * ------------------------------------------------------------------------*/ /* When using the FFI, you first run Hugs with generateFFI == TRUE * to generate C files for any modules which contain foreign import/export * declarations. You then compile and partially link the C files and run * Hugs with generateFFI == FALSE to load the object files and lookup * the appropriate helper functions in the object files. * Only when you run Hugs in the second mode can you actually execute code. */ Bool generateFFI = FALSE; Bool generate_ffi = FALSE; /* generate FFI for the current module? */ static Int checkCallConv Args((Int,Text)); /* Checking if the calling convention is supported */ static Int checkCallConv(line,t) Int line; Text t; { if (t == textCCall ) return FFI_CCONV_CCALL; #if STDCALL_SUPPORTED /* also support the stdcall calling convention */ if (t == textStdcall) return FFI_CCONV_STDCALL; #endif #ifdef DOTNET if (t == textDotnet) return FFI_CCONV_DOTNET; #endif return FFI_CCONV_UNKNOWN; } /* Tricky naming detail: * * When we generate C function names, we need to make sure they * are unique within each module. This is done using the foreignCount * variable. */ Void foreignImport(l,callconv,safety,ext,intName,type) /* Handle foreign imports */ Cell l; Cell callconv; Cell safety; Cell ext; Cell intName; Cell type; { Text t = textOf(intName); Name n = findName(t); Int sfty; Int cconv; Int line = intOf(l); if (isNull(n)) { n = newName(t,NIL); } else if (name(n).defn!=PREDEFINED) { ERRMSG(line) "Redeclaration of foreign \"%s\"", textToStr(t) EEND; } cconv = checkCallConv(line,textOf(callconv)); if ( cconv == FFI_CCONV_UNKNOWN ) { ERRMSG(line) "Foreign import calling convention \"%s\" not supported", textToStr(textOf(callconv)) EEND; } if (isNull(safety) || textOf(safety) == textSafe) { sfty = FFI_SAFE; } else if (textOf(safety) == textUnsafe) { sfty = FFI_UNSAFE; } else if (textOf(safety) == textThreadsafe) { sfty = FFI_THREADSAFE; } else { ERRMSG(line) "Foreign import safety level \"%s\" not supported", textToStr(textOf(safety)) EEND; } name(n).line = line; name(n).type = type; name(n).extFun = textOf(ext); name(n).foreignId = foreignCount++; name(n).foreignFlags = sfty | cconv; foreignImports = cons(n,foreignImports); } Void foreignExport(l,v,callconv,ext,intName,type) /* Handle foreign exports */ Cell l; Cell v; Cell callconv; Cell ext; Cell intName; Cell type; { /* * Export attaches to an existing name in the symbol table. * We generate a new name whose definition is * newName :: type * newName = intName; * and pass the whole thing through the typechecker. * * This lets us have multiple exports of each symbol and nicely * deals with the fact that the exported signature might not match * the signature of the definition and might even be overloaded. * * The only problem is that the text of the name has to be * shared between the generated code and Hugs. Since these * are two separate invocations of Hugs, we cannot use an * invented Text so we generate the text by adding a prefix * to the start which cannot conflict with normal identifiers. */ Int line = intOf(l); Int cconv; Text t = concatText("--FFI_",textToStr(textOf(ext))); Name n = newName(t,NIL); if (textOf(v) != textExport) { ERRMSG(line) "Foreign declarations must be either import or export not \"%s\"", textToStr(textOf(v)) EEND; } cconv = checkCallConv(line,textOf(callconv)); if ( cconv == FFI_CCONV_UNKNOWN ) { ERRMSG(line) "Foreign export calling convention \"%s\" not supported", textToStr(textOf(callconv)) EEND; } name(n).line = line; name(n).type = type; name(n).extFun = textOf(ext); name(n).defn = intName; name(n).foreignId = foreignCount++; name(n).foreignFlags = FFI_NOSAFETY | cconv; foreignExports = cons(n,foreignExports); } static String skipSpaces Args((String)); static String matchToken Args((String,String)); static String skipToSpace Args((String)); static String skipToChar Args((String,int)); static String matchFname Args((String)); static String skipSpaces(s) String s; { while (isspace(*s)) { ++s; } return s; } static String skipToSpace(s) String s; { while (*s != '\0' && !isspace(*s)) { ++s; } return s; } static String skipToChar(s,c) String s; int c; { while (*s != '\0' && *s != c) { ++s; } return s; } static String matchToken(t,s) String t; String s; { while (*t != '\0' && *t == *s) { ++t; ++s; } if (*t == '\0') { return s; } else { return 0; } } static String matchFname(s) String s; { String t = skipToSpace(s); if (t-s >= 3 && t[-2] == '.' && t[-1] == 'h') { return t; } else { return 0; } } static Void local checkForeignImport(p) /* Check foreign import */ Name p; { Int line = name(p).line; String ext = textToStr(name(p).extFun); String e = 0; Type t = NIL; List argTys = NIL; Bool generate_stub = generate_ffi #ifdef DOTNET || (name(p).foreignFlags & FFI_CCONV_DOTNET != 0) #endif ; emptySubstitution(); name(p).type = checkSigType(name(p).line, "foreign import declaration", p, name(p).type); t = name(p).type; if (isPolyType(t)) { t = monotypeOf(t); } t = fullerExpand(t); while (getHead(t)==typeArrow && argCount==2) { Type ta = fullerExpand(arg(fun(t))); Type tr = fullerExpand(arg(t)); argTys = cons(ta,argTys); t = tr; } argTys = rev(argTys); /* argTys now holds the argument tys and t holds result type */ /* What kind of import is this? */ ext = skipSpaces(ext); if ((e = matchToken("dynamic",ext))) { /* dynamic import */ Type ta = NIL; Bool isIO = FALSE; e = skipSpaces(e); if (*e != '\0') goto cantparse; /* type must be of the form: * * (FunPtr fty) -> fty * */ if (length(argTys) < 1) goto dynerr; ta = hd(argTys); argTys = tl(argTys); if (getHead(ta) != typeFunPtr || argCount!=1) goto dynerr; ta = hd(getArgs(ta)); /* ToDo: check that ta == argTys -> t and check it's a valid type */ if (getHead(t) == typeIO && argCount==1) { isIO = TRUE; t = fullerExpand(hd(getArgs(t))); } if (generate_stub) { name(p).arity = 1 + length(argTys) + (isIO ? IOArity : 0); name(p).extFun = inventText(); implementForeignImportDynamic(line,name(p).foreignId,name(p).extFun,argTys,isIO,t); } } else if ((e = matchToken("wrapper",ext))) { /* thunk builder */ Bool isIO = FALSE; Type ta = NIL; e = skipSpaces(e); if (*e != '\0') goto cantparse; if (length(argTys) != 1) goto wraperr; ta = hd(argTys); if (getHead(t) != typeIO || argCount!=1) goto wraperr; t = fullerExpand(hd(getArgs(t))); if (getHead(t) != typeFunPtr) goto wraperr; t = fullerExpand(hd(getArgs(t))); /* ToDo: check that ta == t */ t = fullerExpand(t); argTys = NIL; while (getHead(t)==typeArrow && argCount==2) { Type ta = fullerExpand(arg(fun(t))); Type tr = fullerExpand(arg(t)); argTys = cons(ta,argTys); t = tr; } argTys = rev(argTys); /* argTys now holds the argument tys and t holds result type */ if (getHead(t) == typeIO && argCount==1) { isIO = TRUE; t = fullerExpand(hd(getArgs(t))); } t = fullerExpand(t); if (generate_stub) { name(p).arity = 1+IOArity; name(p).extFun = inventText(); implementForeignImportWrapper(line,name(p).foreignId,name(p).extFun,argTys,isIO,t); } } else { /* static function or address: * * ['static'] [fname] ['[' lib ']'] [&] [cid] * * or, for .NET bindings: * * ['static'] ['ctor' | 'field' | 'method' ] ['[' lib ']'] [cid] * */ Bool isStatic = FALSE; Text fn = -1; Text libn = -1; Text cid = -1; Bool isLabel = FALSE; #ifdef DOTNET Int methFlags = FFI_DOTNET_METHOD; #endif if ((e = matchToken("static",ext))) { isStatic = TRUE; #ifdef DOTNET methFlags |= FFI_DOTNET_STATIC; #endif ext = skipSpaces(e); } #ifdef DOTNET if ( name(p).foreignFlags & FFI_CCONV_DOTNET ) { if ( e = matchToken("ctor", ext) ) { methFlags = ((methFlags & ~FFI_DOTNET_METHOD) | FFI_DOTNET_CTOR) ; ext = skipSpaces(e); } else if ( e = matchToken("field", ext) ) { methFlags = ((methFlags & ~FFI_DOTNET_METHOD) | FFI_DOTNET_FIELD) ; ext = skipSpaces(e); } else if ( e = matchToken("method", ext) ) { /* redundant */ methFlags |= FFI_DOTNET_METHOD; ext = skipSpaces(e); } } else { #endif if ((e = matchFname(ext))) { fn = subText(ext,e-ext); ext = skipSpaces(e); } #ifdef DOTNET } #endif if ((e = matchToken("&",ext))) { isLabel = TRUE; ext = skipSpaces(e); #ifdef DOTNET if ( name(p).foreignFlags & FFI_CCONV_DOTNET ) goto no_dnet_label; #endif } if ((e = matchToken("[",ext))) { ext = skipToChar(e,']'); if (*ext != ']' || ext == e) goto cantparse; libn = subText(e,ext-e); ext = skipSpaces(ext+1); #if !defined(SILENTLY_IGNORE_FFI_LIB_SPECS) && !defined(DOTNET) ERRMSG(line) "Hugs doesn't use library specifications." EEND; #endif } if (*ext != '\0') { e = skipToSpace(ext); cid = subText(ext,e-ext); ext = skipSpaces(e); } else { cid = name(p).text; } if (*ext != '\0') goto cantparse; if (isLabel) { if (!isNull(argTys)) goto labelerr; if (!( (getHead(t) == typePtr && argCount == 1) || (getHead(t) == typeFunPtr && argCount == 1) )) { goto labelerr; } if (generate_stub) { name(p).arity = 0; implementForeignImportLabel(line,name(p).foreignId,fn,cid,name(p).text,t); name(p).extFun = cid; } } else { Bool isIO = FALSE; if (getHead(t) == typeIO && argCount==1) { isIO = TRUE; t = fullerExpand(hd(getArgs(t))); } if (generate_stub) { name(p).arity = length(argTys) + (isIO ? IOArity : 0); implementForeignImport(line,p,name(p).foreignId, #ifndef DOTNET fn, #else (Text)methFlags, #endif cid,isStatic, libn, argTys,isIO,t); name(p).extFun = cid; } } } return; cantparse: ERRMSG(line) "Can't parse external entity '" ETHEN ERRTEXT ext ETHEN ERRTEXT "'\n" EEND; dynerr: ERRMSG(line) "foreign import dynamic must have type '(FunPtr ft) -> ft'" EEND; wraperr: ERRMSG(line) "foreign import wrapper must have type 'ft -> IO (FunPtr ft)'" EEND; labelerr: ERRMSG(line) "foreign import & must have type 'Ptr a' or 'FunPtr a'" EEND; #ifdef DOTNET no_dnet_label: ERRMSG(line) "foreign import & with 'dotnet' calling convention not supported." EEND; #endif } static Void local checkForeignExport(p) /* Check foreign export */ Name p; { Int line = name(p).line; Text ext = name(p).extFun; Type t; List argTys = NIL; Bool isIO = FALSE; emptySubstitution(); name(p).type = checkSigType(line, "foreign export declaration", p, name(p).type); t = name(p).type; t = fullerExpand(t); while (getHead(t)==typeArrow && argCount==2) { Type ta = fullerExpand(arg(fun(t))); Type tr = fullerExpand(arg(t)); argTys = cons(ta,argTys); t = tr; } argTys = rev(argTys); if (getHead(t) == typeIO && argCount==1) { t = fullerExpand(hd(getArgs(t))); isIO = TRUE; } if (generate_ffi) { name(p).arity = length(argTys) + (isIO ? IOArity : 0); implementForeignExport(line,name(p).foreignId,ext,argTys,isIO,t); } } static Void local linkForeign(p) /* Link an ffi-generated primitive */ Name p; { addPrim(name(p).line,p,textToStr(name(p).text),name(p).mod,name(p).type); } /* -------------------------------------------------------------------------- * Static analysis of patterns: * * Patterns are parsed as ordinary (atomic) expressions. Static analysis * makes the following checks: * - Patterns are well formed (according to pattern syntax), including the * special case of (n+k) patterns. * - All constructor functions have been defined and are used with the * correct number of arguments. * - No variable name is used more than once in a pattern. * * The list of pattern variables occuring in each pattern is accumulated in * a global list `patVars', which must be initialised to NIL at appropriate * points before using these routines to check for valid patterns. This * mechanism enables the pattern checking routine to be mapped over a list * of patterns, ensuring that no variable occurs more than once in the * complete pattern list (as is required on the lhs of a function defn). * ------------------------------------------------------------------------*/ static List patVars; /* List of vars bound in pattern */ static Cell local checkPat(line,p) /* Check valid pattern syntax */ Int line; Cell p; { switch (whatIs(p)) { case VARIDCELL : case VAROPCELL : addToPatVars(line,p); break; case INFIX : return checkPat(line,tidyInfix(line,snd(p))); case AP : return checkMaybeCnkPat(line,p); case NAME : case QUALIDENT : case CONIDCELL : case CONOPCELL : return checkApPat(line,0,p); #if BIGNUMS case ZERONUM : case POSNUM : case NEGNUM : #endif case WILDCARD : case STRCELL : case CHARCELL : case DOUBLECELL: case INTCELL : break; case ASPAT : addToPatVars(line,fst(snd(p))); snd(snd(p)) = checkPat(line,snd(snd(p))); break; case LAZYPAT : snd(p) = checkPat(line,snd(p)); break; case FINLIST : map1Over(checkPat,line,snd(p)); break; case CONFLDS : depConFlds(line,p,TRUE); break; case ESIGN : snd(snd(p)) = checkPatType(line, "pattern", fst(snd(p)), snd(snd(p))); fst(snd(p)) = checkPat(line,fst(snd(p))); break; default : ERRMSG(line) "Illegal pattern syntax" EEND; } return p; } static Cell local checkMaybeCnkPat(l,p)/* Check applicative pattern with */ Int l; /* the possibility of n+k pattern */ Cell p; { #if NPLUSK Cell h = getHead(p); if (argCount==2 && isVar(h) && textOf(h)==textPlus) { /* n+k */ Cell v = arg(fun(p)); if (!isVar(v)) { ERRMSG(l) "First argument in (n+k) pattern must be a variable" EEND; } if (!isInt(arg(p))) { ERRMSG(l) "Second argument in (n+k) pattern must be an integer" EEND; } if (intOf(arg(p))<=0) { ERRMSG(l) "Integer k in (n+k) pattern must be > 0" EEND; } fst(fun(p)) = ADDPAT; intValOf(fun(p)) = intOf(arg(p)); arg(p) = checkPat(l,v); return p; } #endif return checkApPat(l,0,p); } static Cell local checkApPat(line,args,p) Int line; /* check validity of application */ Int args; /* of constructor to arguments */ Cell p; { switch (whatIs(p)) { case AP : fun(p) = checkApPat(line,args+1,fun(p)); arg(p) = checkPat(line,arg(p)); break; case TUPLE : if (tupleOf(p)!=args) { ERRMSG(line) "Illegal tuple pattern" EEND; } break; #if TREX case EXT : h98DoesntSupport(line,"extensible records"); trexUsed(); if (args!=2) { ERRMSG(line) "Illegal record pattern" EEND; } break; #endif case QUALIDENT : if (!isQCon(p)) { ERRMSG(line) "Illegal use of qualified variable in pattern" EEND; } /* deliberate fall through */ case CONIDCELL : case CONOPCELL : p = conDefined(line,p,TRUE); checkCfunArgs(line,p,args); break; case NAME : checkIsCfun(line,p); checkCfunArgs(line,p,args); break; default : ERRMSG(line) "Illegal pattern syntax" EEND; } return p; } static Void local addToPatVars(line,v) /* Add variable v to list of vars */ Int line; /* in current pattern, checking */ Cell v; { /* for repeated variables. */ Text t = textOf(v); List p = NIL; List n = patVars; for (; nonNull(n); p=n, n=tl(n)) { if (textOf(hd(n))==t) { ERRMSG(line) "Repeated variable \"%s\" in pattern", textToStr(t) EEND; } } if (isNull(p)) { patVars = cons(v,NIL); } else { tl(p) = cons(v,NIL); } } static Name local conDefined(line,nm,check) Int line; /* check that nm is the name of a */ Cell nm; /* previously defined constructor */ Bool check; { /* function (and only one.) */ Name n = findQualName(nm); if (isNull(n)) { ERRMSG(line) "Undefined data constructor \"%s\"", identToStr(nm) EEND; } checkIsCfun(line,n); if (check) { if (isQualIdent(nm)) { depQVar(line,nm,FALSE); } else { checkNameAmbigName(line,n,FALSE); } } return n; } static Void local checkIsCfun(line,c) /* Check that c is a constructor fn */ Int line; Name c; { if (!isCfun(c)) { ERRMSG(line) "\"%s\" is not a data constructor", textToStr(name(c).text) EEND; } } static Void local checkCfunArgs(line,c,args) Int line; /* Check constructor applied with */ Cell c; /* correct number of arguments */ Int args; { Int a = userArity(c); if (a!=args) { ERRMSG(line) "Constructor \"%s\" must have exactly %d argument%s in pattern", textToStr(name(c).text), a, ((a==1)?"":"s") EEND; } } static Cell local checkPatType(l,wh,e,t)/* Check type appearing in pattern */ Int l; String wh; Cell e; Type t; { List tvs = typeVarsIn(t,NIL,NIL,NIL); h98DoesntSupport(l,"pattern type annotations"); for (; nonNull(tvs); tvs=tl(tvs)) { Int beta = newKindvars(1); hd(btyvars) = cons(pair(hd(tvs),mkInt(beta)), hd(btyvars)); } t = checkSigType(l,"pattern type",e,t); if (isPolyOrQualType(t) || whatIs(t)==RANK2) { ERRMSG(l) "Illegal syntax in %s type annotation", wh EEND; } return t; } static Cell local applyBtyvs(pat) /* Record bound type vars in pat */ Cell pat; { List bts = hd(btyvars); leaveBtyvs(); if (nonNull(bts)) { pat = ap(BIGLAM,pair(bts,pat)); for (; nonNull(bts); bts=tl(bts)) { snd(hd(bts)) = copyKindvar(intOf(snd(hd(bts)))); } } return pat; } /* -------------------------------------------------------------------------- * Maintaining lists of bound variables and local definitions, for * dependency and scope analysis. * ------------------------------------------------------------------------*/ static List bounds; /* list of lists of bound vars */ static List bindings; /* list of lists of binds in scope */ static List depends; /* list of lists of dependents */ /* bounds :: [[Var]] -- var equality used on Vars */ /* bindings :: [[([Var],?)]] -- var equality used on Vars */ /* depends :: [[Var]] -- pointer equality used on Vars */ #if MUDO static List mdepends; /* list of dependents for mdo */ /* mdepends :: [Var] -- var equality used on Vars */ #endif #define saveBvars() hd(bounds) /* list of bvars in current scope */ #define restoreBvars(bs) hd(bounds)=bs /* restore list of bound variables */ static Cell local bindPat(line,p) /* add new bound vars for pattern */ Int line; Cell p; { patVars = NIL; p = checkPat(line,p); hd(bounds) = dupOnto(patVars,hd(bounds)); return p; } static Void local bindPats(line,ps) /* add new bound vars for patterns */ Int line; List ps; { patVars = NIL; map1Over(checkPat,line,ps); hd(bounds) = revOnto(patVars,hd(bounds)); } /* -------------------------------------------------------------------------- * Before processing value and type signature declarations, all data and * type definitions have been processed so that: * - all valid type constructors (with their arities) are known. * - all valid constructor functions (with their arities and types) are * known. * * The result of parsing a list of value declarations is a list of Eqns: * Eqn ::= (SIGDECL,(Line,[Var],type)) * | (FIXDECL,(Line,[Op],SyntaxInt)) * | (Expr,Rhs) * The ordering of the equations in this list is the reverse of the original * ordering in the script parsed. This is a consequence of the structure of * the parser ... but also turns out to be most convenient for the static * analysis. * * As the first stage of the static analysis of value declarations, each * list of Eqns is converted to a list of Bindings. As part of this * process: * - The ordering of the list of Bindings produced is the same as in the * original script. * - When a variable (function) is defined over a number of lines, all * of the definitions should appear together and each should give the * same arity to the variable being defined. * - No variable can have more than one definition. * - For pattern bindings: * - Each lhs is a valid pattern/function lhs, all constructor functions * have been defined and are used with the correct number of arguments. * - Each lhs contains no repeated pattern variables. * - Each equation defines at least one variable (e.g. True = False is * not allowed). * - Types appearing in type signatures are well formed: * - Type constructors used are defined and used with correct number * of arguments. * - type variables are replaced by offsets, type constructor names * by Tycons. * - Every variable named in a type signature declaration is defined by * one or more equations elsewhere in the script. * - No variable has more than one type declaration. * - Similar properties for fixity declarations. * * ------------------------------------------------------------------------*/ #define bindingAttr(b) fst(snd(b)) /* type(s)/fixity(ies) for binding */ #define fbindAlts(b) snd(snd(b)) /* alternatives for function binding*/ static List local extractSigdecls(es) /* Extract the SIGDECLS from list */ List es; { /* of equations */ List sigdecls = NIL; /* :: [(Line,[Var],Type)] */ for(; nonNull(es); es=tl(es)) { if (fst(hd(es))==SIGDECL) { /* type-declaration? */ Pair sig = snd(hd(es)); Int line = intOf(fst3(sig)); List vs = snd3(sig); for(; nonNull(vs); vs=tl(vs)) { if (isQualIdent(hd(vs))) { ERRMSG(line) "Type signature for qualified variable \"%s\" is not allowed", identToStr(hd(vs)) EEND; } } sigdecls = cons(sig,sigdecls); /* discard SIGDECL tag*/ } } return sigdecls; } static List local extractFixdecls(es) /* Extract the FIXDECLS from list */ List es; { /* of equations */ List fixdecls = NIL; /* :: [(Line,SyntaxInt,[Op])] */ for(; nonNull(es); es=tl(es)) { if (fst(hd(es))==FIXDECL) { /* fixity declaration?*/ fixdecls = cons(snd(hd(es)),fixdecls); /* discard FIXDECL tag*/ } } return fixdecls; } static List local extractBindings(ds) /* extract untyped bindings from */ List ds; { /* given list of equations */ Cell lastVar = NIL; /* = var def'd in last eqn (if any)*/ Int lastArity = 0; /* = number of args in last defn */ List bs = NIL; /* :: [Binding] */ for(; nonNull(ds); ds=tl(ds)) { Cell d = hd(ds); if (fst(d)==FUNBIND) { /* Function bindings */ Cell rhs = snd(snd(d)); Int line = rhsLine(rhs); Cell lhs = fst(snd(d)); Cell v = getHead(lhs); Cell newAlt = pair(getArgs(lhs),rhs); if ( !isVar(v) ) { internal("FUNBIND"); } if (nonNull(lastVar) && (textOf(v))==textOf(lastVar)) { if (argCount!=lastArity) { ERRMSG(line) "Equations give different arities for \"%s\"", textToStr(textOf(v)) EEND; } fbindAlts(hd(bs)) = cons(newAlt,fbindAlts(hd(bs))); } else { lastVar = v; lastArity = argCount; notDefined(line,bs,v); bs = cons(pair(v,pair(NIL,singleton(newAlt))),bs); } } else if (fst(d)==PATBIND) { /* Pattern bindings */ Cell rhs = snd(snd(d)); Int line = rhsLine(rhs); Cell pat = fst(snd(d)); while (whatIs(pat)==ESIGN) {/* Move type annotations to rhs */ Cell p = fst(snd(pat)); fst(snd(pat)) = rhs; snd(snd(d)) = rhs = pat; fst(snd(d)) = pat = p; /* Lift out the line number, i.e., * (ESIGN,((location, expr),ty)) ~=> (location,(ESIGN,(expr,ty))) */ p = snd(rhs); fst(rhs) = fst(fst(p)); snd(rhs) = ap(ESIGN,ap(snd(fst(p)),snd(p))); } if (isVar(pat)) { /* Convert simple pattern bind to */ notDefined(line,bs,pat);/* a function binding */ bs = cons(pair(pat,pair(NIL,singleton(pair(NIL,rhs)))),bs); } else { List vs = getPatVars(line,pat,NIL); #if 0 /* Legal Haskell, and a bit useful (intros typing constraints.) */ if (isNull(vs)) { ERRMSG(line) "No variables defined in lhs pattern" EEND; } #endif map2Proc(notDefined,line,bs,vs); bs = cons(pair(vs,pair(NIL,snd(d))),bs); } lastVar = NIL; } else lastVar = NIL; } return bs; } static List local getPatVars(line,p,vs) /* Find list of variables bound in */ Int line; /* pattern p */ Cell p; List vs; { switch (whatIs(p)) { case AP : do { vs = getPatVars(line,arg(p),vs); p = fun(p); } while (isAp(p)); return vs; /* Ignore head of application */ case CONFLDS : { List pfs = snd(snd(p)); for (; nonNull(pfs); pfs=tl(pfs)) { if (isVar(hd(pfs))) { vs = addPatVar(line,hd(pfs),vs); } else { vs = getPatVars(line,snd(hd(pfs)),vs); } } } return vs; case FINLIST : { List ps = snd(p); for (; nonNull(ps); ps=tl(ps)) { vs = getPatVars(line,hd(ps),vs); } } return vs; case ESIGN : return getPatVars(line,fst(snd(p)),vs); case LAZYPAT : case NEG : case ONLY : case INFIX : return getPatVars(line,snd(p),vs); case ASPAT : return addPatVar(line,fst(snd(p)), getPatVars(line,snd(snd(p)),vs)); case VARIDCELL : case VAROPCELL : return addPatVar(line,p,vs); case CONIDCELL : case CONOPCELL : case QUALIDENT : case INTCELL : case DOUBLECELL : case CHARCELL : case STRCELL : case NAME : case WILDCARD : return vs; default : internal("getPatVars"); } return vs; } static List local addPatVar(line,v,vs) /* Add var to list of previously */ Int line; /* encountered variables */ Cell v; List vs; { if (varIsMember(textOf(v),vs)) { ERRMSG(line) "Repeated use of variable \"%s\" in pattern binding", textToStr(textOf(v)) EEND; } return cons(v,vs); } static List local eqnsToBindings(es,ts,cs,ps) List es; /* Convert list of equations to */ List ts; /* list of typed bindings */ List cs; List ps; { List bs = extractBindings(es); map1Proc(addSigdecl,bs,extractSigdecls(es)); map4Proc(addFixdecl,bs,ts,cs,ps,extractFixdecls(es)); return bs; } static Void local notDefined(line,bs,v)/* check if name already defined in */ Int line; /* list of bindings */ List bs; Cell v; { if (nonNull(findBinding(textOf(v),bs))) { ERRMSG(line) "\"%s\" multiply defined", textToStr(textOf(v)) EEND; } } static Cell local findBinding(t,bs) /* look for binding for variable t */ Text t; /* in list of bindings bs */ List bs; { for (; nonNull(bs); bs=tl(bs)) { if (isVar(fst(hd(bs)))) { /* function-binding? */ if (textOf(fst(hd(bs)))==t) { return hd(bs); } } else if (nonNull(varIsMember(t,fst(hd(bs))))){/* pattern-binding?*/ return hd(bs); } } return NIL; } static Cell local getAttr(bs,v) /* Locate type/fixity attribute */ List bs; /* for variable v in bindings bs */ Cell v; { Text t = textOf(v); Cell b = findBinding(t,bs); if (isNull(b)) { /* No binding */ return NIL; } else if (isVar(fst(b))) { /* func binding? */ if (isNull(bindingAttr(b))) { bindingAttr(b) = pair(NIL,NIL); } return bindingAttr(b); } else { /* pat binding? */ List vs = fst(b); List as = bindingAttr(b); if (isNull(as)) { bindingAttr(b) = as = replicate(length(vs),NIL); } while (nonNull(vs) && t!=textOf(hd(vs))) { vs = tl(vs); as = tl(as); } if (isNull(vs)) { internal("getAttr"); } else if (isNull(hd(as))) { hd(as) = pair(NIL,NIL); } return hd(as); } } static Void local addSigdecl(bs,sigdecl)/* add type information to bindings*/ List bs; /* :: [Binding] */ Cell sigdecl; { /* :: (Line,[Var],Type) */ Int l = intOf(fst3(sigdecl)); List vs = snd3(sigdecl); Type type = checkSigType(l,"type declaration",hd(vs),thd3(sigdecl)); for (; nonNull(vs); vs=tl(vs)) { Cell v = hd(vs); Pair attr = getAttr(bs,v); if (isNull(attr)) { ERRMSG(l) "Missing binding for variable \"%s\" in type signature", textToStr(textOf(v)) EEND; } else if (nonNull(fst(attr))) { ERRMSG(l) "Multiple type signatures for \"%s\"", textToStr(textOf(v)) EEND; } fst(attr) = type; } } static Void local addFixdecl(bs,ts,cs,ps,fixdecl) List bs; List ts; List cs; List ps; Triple fixdecl; { Int line = intOf(fst3(fixdecl)); List ops = snd3(fixdecl); Cell sy = thd3(fixdecl); for (; nonNull(ops); ops=tl(ops)) { Cell op = hd(ops); Text t = textOf(op); Cell attr = getAttr(bs,op); if (nonNull(attr)) { /* Found name in binding? */ if (nonNull(snd(attr))) { dupFixity(line,t); } snd(attr) = sy; } else { /* Look in tycons, classes, prims */ Name n = NIL; List ts1 = ts; List cs1 = cs; List ps1 = ps; for (; isNull(n) && nonNull(ts1); ts1=tl(ts1)) { /* tycons */ Tycon tc = hd(ts1); if (tycon(tc).what==DATATYPE || tycon(tc).what==NEWTYPE) { n = nameIsMember(t,tycon(tc).defn); } } for (; isNull(n) && nonNull(cs1); cs1=tl(cs1)) { /* classes */ n = nameIsMember(t,cclass(hd(cs1)).members); } for (; isNull(n) && nonNull(ps1); ps1=tl(ps1)) { /* prims */ n = nameIsMember(t,hd(ps1)); } if (isNull(n)) { missFixity(line,t); } else if (name(n).syntax!=NO_SYNTAX) { dupFixity(line,t); } name(n).syntax = intOf(sy); } } } static Void local dupFixity(line,t) /* Report repeated fixity decl */ Int line; Text t; { ERRMSG(line) "Multiple fixity declarations for operator \"%s\"", textToStr(t) EEND; } static Void local missFixity(line,t) /* Report missing op for fixity */ Int line; Text t; { ERRMSG(line) "Cannot find binding for operator \"%s\" in fixity declaration", textToStr(t) EEND; } /* -------------------------------------------------------------------------- * Dealing with infix operators: * * Expressions involving infix operators or unary minus are parsed as * elements of the following type: * * data InfixExp = Only Exp | Neg InfixExp | Infix InfixExp Op Exp * * (The algorithms here do not assume that negation can be applied only once, * i.e., that - - x is a syntax error, as required by the Haskell report. * Instead, that restriction is captured by the grammar itself, given above.) * * There are rules of precedence and grouping, expressed by two functions: * * prec :: Op -> Int; assoc :: Op -> Assoc (Assoc = {L, N, R}) * * InfixExp values are rearranged accordingly when a complete expression * has been read using a simple shift-reduce parser whose result may be taken * to be a value of the following type: * * data Exp = Atom Int | Negate Exp | Apply Op Exp Exp | Error String * * The machine on which this parser is based can be defined as follows: * * tidy :: InfixExp -> [(Op,Exp)] -> Exp * tidy (Only a) [] = a * tidy (Only a) ((o,b):ss) = tidy (Only (Apply o a b)) ss * tidy (Infix a o b) [] = tidy a [(o,b)] * tidy (Infix a o b) ((p,c):ss) * | shift o p = tidy a ((o,b):(p,c):ss) * | red o p = tidy (Infix a o (Apply p b c)) ss * | ambig o p = Error "ambiguous use of operators" * tidy (Neg e) [] = tidy (tidyNeg e) [] * tidy (Neg e) ((o,b):ss) * | nshift o = tidy (Neg (underNeg o b e)) ss * | nred o = tidy (tidyNeg e) ((o,b):ss) * | nambig o = Error "illegal use of negation" * * At each stage, the parser can either shift, reduce, accept, or error. * The transitions when dealing with juxtaposed operators o and p are * determined by the following rules: * * shift o p = (prec o > prec p) * || (prec o == prec p && assoc o == L && assoc p == L) * * red o p = (prec o < prec p) * || (prec o == prec p && assoc o == R && assoc p == R) * * ambig o p = (prec o == prec p) * && (assoc o == N || assoc p == N || assoc o /= assoc p) * * The transitions when dealing with juxtaposed unary minus and infix * operators are as follows. The precedence of unary minus (infixl 6) is * hardwired in to these definitions, as it is to the definitions of the * Haskell grammar in the official report. * * nshift o = (prec o > 6) * nred o = (prec o < 6) || (prec o == 6 && assoc o == L) * nambig o = prec o == 6 && (assoc o == R || assoc o == N) * * An InfixExp of the form (Neg e) means negate the last thing in * the InfixExp e; we can force this negation using: * * tidyNeg :: OpExp -> OpExp * tidyNeg (Only e) = Only (Negate e) * tidyNeg (Infix a o b) = Infix a o (Negate b) * tidyNeg (Neg e) = tidyNeg (tidyNeg e) * * On the other hand, if we want to sneak application of an infix operator * under a negation, then we use: * * underNeg :: Op -> Exp -> OpExp -> OpExp * underNeg o b (Only e) = Only (Apply o e b) * underNeg o b (Neg e) = Neg (underNeg o b e) * underNeg o b (Infix e p f) = Infix e p (Apply o f b) * * As a concession to efficiency, we lower the number of calls to syntaxOf * by keeping track of the values of sye, sys throughout the process. The * value APPLIC is used to indicate that the syntax value is unknown. * ------------------------------------------------------------------------*/ static Cell local tidyInfix(line,e) /* Convert infixExp to Exp */ Int line; Cell e; { /* :: OpExp */ Cell s = NIL; /* :: [(Op,Exp)] */ Syntax sye = APPLIC; /* Syntax of op in e (init unknown)*/ Syntax sys = APPLIC; /* Syntax of op in s (init unknown)*/ Cell d = e; while (fst(d)!=ONLY) { /* Attach fixities to operators */ if (fst(d)==NEG) { d = snd(d); } else { fun(fun(d)) = attachFixity(line,fun(fun(d))); d = arg(fun(d)); } } for (;;) switch (whatIs(e)) { case ONLY : e = snd(e); while (nonNull(s)) { Cell next = arg(fun(s)); arg(fun(s)) = e; fun(fun(s)) = snd(snd(fun(fun(s)))); e = s; s = next; } return e; case NEG : if (nonNull(s)) { if (sys==APPLIC) { /* calculate sys */ sys = intOf(fst(fun(fun(s)))); } if (precOf(sys)==UMINUS_PREC && /* nambig */ assocOf(sys)!=UMINUS_ASSOC) { ERRMSG(line) "Ambiguous use of unary minus with \"" ETHEN ERREXPR(fst(snd(fun(fun(s))))); ERRTEXT "\"" EEND; } if (precOf(sys)>UMINUS_PREC) { /* nshift */ Cell e1 = snd(e); Cell t = s; s = arg(fun(s)); while (whatIs(e1)==NEG) e1 = snd(e1); arg(fun(t)) = arg(e1); fun(fun(t)) = snd(snd(fun(fun(t)))); arg(e1) = t; sys = APPLIC; continue; } } /* Intentional fall-thru for nreduce and isNull(s) */ { Cell prev = e; /* e := tidyNeg e */ Cell temp = arg(prev); Int nneg = 1; for (; whatIs(temp)==NEG; nneg++) { fun(prev) = nameNegate; prev = temp; temp = arg(prev); } if (isInt(arg(temp))) { /* special cases */ if (nneg&1) /* for literals */ arg(temp) = mkInt(-intOf(arg(temp))); } #if BIGNUMS else if (isBignum(arg(temp))) { if (nneg&1) arg(temp) = bigNeg(arg(temp)); } #endif else if (isDouble(arg(temp))) { if (nneg&1) arg(temp) = mkDouble(-doubleOf(arg(temp))); } else { fun(prev) = nameNegate; arg(prev) = arg(temp); arg(temp) = e; } e = temp; } continue; default : if (isNull(s)) {/* Move operation onto empty stack */ Cell next = arg(fun(e)); s = e; arg(fun(s)) = NIL; e = next; sys = sye; sye = APPLIC; } else { /* deal with pair of operators */ if (sye==APPLIC) { /* calculate sys and sye */ sye = intOf(fst(fun(fun(e)))); } if (sys==APPLIC) { sys = intOf(fst(fun(fun(s)))); } if (precOf(sye)==precOf(sys) && /* ambig */ (assocOf(sye)!=assocOf(sys) || assocOf(sye)==NON_ASS)) { ERRMSG(line) "Ambiguous use of operator \"" ETHEN ERREXPR(fst(snd(fun(fun(e))))); ERRTEXT "\" with \"" ETHEN ERREXPR(fst(snd(fun(fun(s))))); ERRTEXT "\"" EEND; } if (precOf(sye)>precOf(sys) || /* shift */ (precOf(sye)==precOf(sys) && assocOf(sye)==LEFT_ASS && assocOf(sys)==LEFT_ASS)) { Cell next = arg(fun(e)); arg(fun(e)) = s; s = e; e = next; sys = sye; sye = APPLIC; } else { /* reduce */ Cell next = arg(fun(s)); arg(fun(s)) = arg(e); fun(fun(s)) = snd(snd(fun(fun(s)))); arg(e) = s; s = next; sys = APPLIC; /* sye unchanged */ } } continue; } } static Pair local attachFixity(line,op) /* Attach fixity to operator in an */ Int line; /* infix expression */ Cell op; { Syntax sy = DEF_OPSYNTAX; Cell trop = op; switch (whatIs(op)) { case VAROPCELL : case VARIDCELL : if ((sy=lookupSyntax(textOf(op)))==NO_SYNTAX) { Name n = findName(textOf(op)); if (isNull(n)) { ERRMSG(line) "Undefined variable \"%s\"", textToStr(textOf(op)) EEND; } sy = syntaxOf(n); trop = n; } break; case CONOPCELL : case CONIDCELL : sy = syntaxOf(trop = conDefined(line,op,FALSE)); break; case QUALIDENT : { Name n = findQualName(op); if (nonNull(n)) { trop = n; sy = syntaxOf(n); } else { ERRMSG(line) "Undefined qualified variable \"%s\"", identToStr(op) EEND; } } break; } if (sy==APPLIC) { sy = DEF_OPSYNTAX; } return pair(mkInt(sy),pair(trop,op)); /* Pair fixity with (possibly) */ /* translated operator */ } static Syntax local lookupSyntax(t) /* Try to find fixity for var in */ Text t; { /* enclosing bindings */ List bounds1 = bounds; List bindings1 = bindings; while (nonNull(bindings1)) { if (nonNull(varIsMember(t,hd(bounds1)))) { return DEF_OPSYNTAX; } else { Cell b = findBinding(t,hd(bindings1)); if (nonNull(b)) { Cell a = fst(snd(b)); if (isVar(fst(b))) { /* Function binding */ if (nonNull(a) && nonNull(snd(a))) { return intOf(snd(a)); } } else { /* Pattern binding */ List vs = fst(b); while (nonNull(vs) && nonNull(a)) { if (t==textOf(hd(vs))) { if (nonNull(hd(a)) && isInt(snd(hd(a)))) { return intOf(snd(hd(a))); } break; } vs = tl(vs); a = tl(a); } } return DEF_OPSYNTAX; } } bounds1 = tl(bounds1); bindings1 = tl(bindings1); } return NO_SYNTAX; } /* -------------------------------------------------------------------------- * To facilitate dependency analysis, lists of bindings are temporarily * augmented with an additional field, which is used in two ways: * - to build the `adjacency lists' for the dependency graph. Represented by * a list of pointers to other bindings in the same list of bindings. * - to hold strictly positive integer values (depth first search numbers) of * elements `on the stack' during the strongly connected components search * algorithm, or a special value mkInt(0), once the binding has been added * to a particular strongly connected component. * * Using this extra field, the type of each list of declarations during * dependency analysis is [Binding'] where: * * Binding' ::= (Var, (Attr, (Dep, [Alt]))) -- function binding * | ([Var], ([Attr], (Dep, (Pat,Rhs)))) -- pattern binding * * ------------------------------------------------------------------------*/ #define depVal(d) (fst(snd(snd(d)))) /* Access to dependency information*/ static List local dependencyAnal(bs) /* Separate lists of bindings into */ List bs; { /* mutually recursive groups in */ /* order of dependency */ mapProc(addDepField,bs); /* add extra field for dependents */ mapProc(depBinding,bs); /* find dependents of each binding */ bs = bscc(bs); /* sort to strongly connected comps*/ mapProc(remDepField,bs); /* remove dependency info field */ return bs; } static List local topDependAnal(bs) /* Like dependencyAnal(), but at */ List bs; { /* top level, reporting on progress*/ List xs; Int i = 0; setGoal("Dependency analysis",(Target)(length(bs))); mapProc(addDepField,bs); /* add extra field for dependents */ for (xs=bs; nonNull(xs); xs=tl(xs)) { emptySubstitution(); depBinding(hd(xs)); soFar((Target)(i++)); } bs = bscc(bs); /* sort to strongly connected comps */ mapProc(remDepField,bs); /* remove dependency info field */ done(); return bs; } static Void local addDepField(b) /* add extra field to binding to */ Cell b; { /* hold list of dependents */ snd(snd(b)) = pair(NIL,snd(snd(b))); } static Void local remDepField(bs) /* remove dependency field from */ List bs; { /* list of bindings */ mapProc(remDepField1,bs); } static Void local remDepField1(b) /* remove dependency field from */ Cell b; { /* single binding */ snd(snd(b)) = snd(snd(snd(b))); } static Void local clearScope() { /* initialise dependency scoping */ bounds = NIL; bindings = NIL; depends = NIL; #if MUDO mdepends = NIL; #endif } static Void local withinScope(bs) /* Enter scope of bindings bs */ List bs; { bounds = cons(NIL,bounds); bindings = cons(bs,bindings); depends = cons(NIL,depends); } static Void local leaveScope() { /* Leave scope of last withinScope */ List bs = hd(bindings); /* Remove fixity info from binds */ Bool toplevel = isNull(tl(bindings)); for (; nonNull(bs); bs=tl(bs)) { Cell b = hd(bs); if (isVar(fst(b))) { /* Variable binding */ Cell a = fst(snd(b)); dropNameClash(fst(b)); if (isPair(a)) { if (toplevel) { saveSyntax(fst(b),snd(a)); } fst(snd(b)) = fst(a); } } else { /* Pattern binding */ List vs = fst(b); List as = fst(snd(b)); while (nonNull(vs) && nonNull(as)) { if (isPair(hd(as))) { dropNameClash(hd(vs)); if (toplevel) { saveSyntax(hd(vs),snd(hd(as))); } hd(as) = fst(hd(as)); } vs = tl(vs); as = tl(as); } } } bounds = tl(bounds); bindings = tl(bindings); depends = tl(depends); } static Void local dropNameClash(v) Cell v; { Name n = findName(textOf(v)); if ( !isNull(n) && nonNull(name(n).clashes) ) { name(n).clashes = tl(name(n).clashes); } } static Void local saveSyntax(v,sy) /* Save syntax of top-level var */ Cell v; /* in corresponding Name */ Cell sy; { Name n = findName(textOf(v)); if (isNull(n) || name(n).syntax!=NO_SYNTAX) { internal("saveSyntax"); } if (nonNull(sy)) { name(n).syntax = intOf(sy); } } #if IPARAM static Bool local checkIBindings(line,bs) Int line; List bs; { List xs = bs; Bool hasIParam = FALSE; Bool oldFlg = FALSE; if (isNull(xs)) { return FALSE; } if (isPair(hd(xs)) && isPair(fst(hd(xs))) && fst(fst(hd(xs))) == IPVAR) { hasIParam = TRUE; } xs = tl(xs); while (nonNull(xs)) { oldFlg = hasIParam; hasIParam = isPair(hd(xs)) && isPair(fst(hd(xs))) && (fst(fst(hd(xs))) == IPVAR); if ( oldFlg != hasIParam ) { ERRMSG(line) "Not legal to mix implicit parameter bindings with other bindings." EEND; } xs = tl(xs); } return hasIParam; } #endif /* -------------------------------------------------------------------------- * As a side effect of the dependency analysis we also make the following * checks: * - Each lhs is a valid pattern/function lhs, all constructor functions * have been defined and are used with the correct number of arguments. * - No lhs contains repeated pattern variables. * - Expressions used on the rhs of an eqn should be well formed. This * includes: * - Checking for valid patterns (including repeated vars) in lambda, * case, and list comprehension expressions. * - Recursively checking local lists of equations. * - No free (i.e. unbound) variables are used in the declaration list. * ------------------------------------------------------------------------*/ static Void local depBinding(b) /* find dependents of binding */ Cell b; { Cell defpart = snd(snd(snd(b))); /* definition part of binding */ hd(depends) = NIL; if (isVar(fst(b))) { /* function-binding? */ mapProc(depAlt,defpart); if (isNull(fst(snd(b)))) { /* Save dep info if no type sig */ fst(snd(b)) = pair(ap(IMPDEPS,hd(depends)),NIL); } else if (isNull(fst(fst(snd(b))))) { fst(fst(snd(b))) = ap(IMPDEPS,hd(depends)); } } else { /* pattern-binding? */ Int line = rhsLine(snd(defpart)); enterBtyvs(); patVars = NIL; fst(defpart) = checkPat(line,fst(defpart)); depRhs(snd(defpart)); #if 0 if (nonNull(hd(btyvars))) { ERRMSG(line) "Sorry, no type variables are allowed in pattern binding type annotations" EEND; } #endif fst(defpart) = applyBtyvs(fst(defpart)); } depVal(b) = hd(depends); } static Void local depDefaults(c) /* dependency analysis on defaults */ Class c; { /* from class definition */ depClassBindings(cclass(c).defaults); } static Void local depInsts(in) /* dependency analysis on instance */ Inst in; { /* bindings */ depClassBindings(inst(in).implements); } static Void local depClassBindings(bs) /* dependency analysis on list of */ List bs; { /* bindings, possibly containing */ for (; nonNull(bs); bs=tl(bs)) { /* NIL bindings ... */ if (nonNull(hd(bs))) { /* No need to add extra field for */ mapProc(depAlt,snd(hd(bs)));/* dependency information... */ } } } static Cell local depLetRec(isRhs,line,e) /* dependency analysis on a letrec */ Bool isRhs; Int line; Cell e; { /* expr, containing a set of bindings */ #if IPARAM Bool isIP = checkIBindings(line,fst(snd(e))); /* check that i-param binders aren't */ /* mixed with 'normal' ones. */ if ( isIP ) { snd(snd(e)) = depExpr(line,snd(snd(e))); fst(snd(e)) = depDwFlds(line,e,fst(snd(e))); /* Turn it into a WITHEXP */ return pair(WITHEXP,pair(snd(snd(e)),fst(snd(e)))); } else { #endif fst(snd(e)) = eqnsToBindings(fst(snd(e)),NIL,NIL,NIL); withinScope(fst(snd(e))); fst(snd(e)) = dependencyAnal(fst(snd(e))); hd(depends) = fst(snd(e)); if (isRhs) { depRhs(snd(snd(e))); } else { snd(snd(e)) = depExpr(line,snd(snd(e))); } leaveScope(); return e; #if IPARAM } #endif } static Void local depAlt(a) /* Find dependents of alternative */ Cell a; { List obvs = saveBvars(); /* Save list of bound variables */ enterBtyvs(); bindPats(rhsLine(snd(a)),fst(a)); /* add new bound vars for patterns */ depRhs(snd(a)); /* find dependents of rhs */ fst(a) = applyBtyvs(fst(a)); restoreBvars(obvs); /* restore original list of bvars */ } static Void local depRhs(r) /* Find dependents of rhs */ Cell r; { switch (whatIs(r)) { case GUARDED : mapProc(depGuard,snd(r)); break; case LETREC : r = depLetRec(TRUE, rhsLine(snd(snd(r))),r); break; case RSIGN : snd(snd(r)) = checkPatType(rhsLine(fst(snd(r))), "result", rhsExpr(fst(snd(r))), snd(snd(r))); depRhs(fst(snd(r))); break; default : snd(r) = depExpr(intOf(fst(r)),snd(r)); break; } } static Void local depGuard(g) /* find dependents of single guarded*/ Cell g; { /* expression */ depPair(intOf(fst(g)),snd(g)); } Cell depExpr(line,e) /* find dependents of expression */ Int line; Cell e; { switch (whatIs(e)) { case VARIDCELL : case VAROPCELL : return depVar(line,e,TRUE); case CONIDCELL : case CONOPCELL : return conDefined(line,e,TRUE); case QUALIDENT : if (isQVar(e)) { return depQVar(line,e,TRUE); } else { /* QConOrConOp */ return conDefined(line,e,TRUE); } case INFIX : return depExpr(line,tidyInfix(line,snd(e))); #if TREX case RECSEL : break; case AP : if (isAp(e) && isAp(fun(e)) && isExt(fun(fun(e)))) { trexUsed(); return depRecord(line,e); } else { Cell nx = e; Cell a; do { a = nx; arg(a) = depExpr(line,arg(a)); nx = fun(a); } while (isAp(nx)); fun(a) = depExpr(line,fun(a)); } break; #else case AP : depPair(line,e); break; #endif #if BIGNUMS case ZERONUM : case POSNUM : case NEGNUM : #endif #if IPARAM case IPVAR : #endif case NAME : case TUPLE : case STRCELL : case CHARCELL : case DOUBLECELL : case INTCELL : break; case COND : depTriple(line,snd(e)); break; case FINLIST : map1Over(depExpr,line,snd(e)); break; case LETREC : e = depLetRec(FALSE,line,e); break; case LAMBDA : depAlt(snd(e)); break; #if MUDO case MDOCOMP : mdoUsed(); depRecComp(line, snd(e), snd(snd(e))); break; #endif case DOCOMP : /* fall-thru */ case COMP : depComp(line,snd(e),snd(snd(e))); break; #if ZIP_COMP case ZCOMP : depZComp(line,snd(e),snd(snd(e))); break; #endif case ESIGN : fst(snd(e)) = depExpr(line,fst(snd(e))); snd(snd(e)) = checkSigType(line, "expression", fst(snd(e)), snd(snd(e))); break; case CASE : fst(snd(e)) = depExpr(line,fst(snd(e))); map1Proc(depCaseAlt,line,snd(snd(e))); break; case CONFLDS : depConFlds(line,e,FALSE); break; case UPDFLDS : depUpdFlds(line,e); break; #if IPARAM case WITHEXP : depWith(line,e); break; #endif case ASPAT : ERRMSG(line) "Illegal `@' in expression" EEND; case LAZYPAT : ERRMSG(line) "Illegal `~' in expression" EEND; case WILDCARD : ERRMSG(line) "Illegal `_' in expression" EEND; #if TREX case EXT : ERRMSG(line) "Illegal application of record" EEND; #endif default : internal("depExpr"); } return e; } static Void local depPair(line,e) /* find dependents of pair of exprs*/ Int line; Cell e; { fst(e) = depExpr(line,fst(e)); snd(e) = depExpr(line,snd(e)); } static Void local depTriple(line,e) /* find dependents of triple exprs */ Int line; Cell e; { fst3(e) = depExpr(line,fst3(e)); snd3(e) = depExpr(line,snd3(e)); thd3(e) = depExpr(line,thd3(e)); } static Void local depComp(l,e,qs) /* find dependents of comprehension*/ Int l; Cell e; List qs; { if (isNull(qs)) { fst(e) = depExpr(l,fst(e)); } else { Cell q = hd(qs); List qs1 = tl(qs); switch (whatIs(q)) { case FROMQUAL : { List obvs = saveBvars(); snd(snd(q)) = depExpr(l,snd(snd(q))); enterBtyvs(); fst(snd(q)) = bindPat(l,fst(snd(q))); depComp(l,e,qs1); fst(snd(q)) = applyBtyvs(fst(snd(q))); restoreBvars(obvs); } break; case QWHERE : #if IPARAM if ( checkIBindings(l,snd(q)) ) { /* It is unclear what the meaning of this is (by people in-the-know), * so outlaw it for now. */ ERRMSG(l) "Currently illegal to bind implicit parameters using comprehension/do-level lets" EEND; } else { #endif snd(q) = eqnsToBindings(snd(q),NIL,NIL,NIL); withinScope(snd(q)); snd(q) = dependencyAnal(snd(q)); hd(depends) = snd(q); depComp(l,e,qs1); leaveScope(); #if IPARAM } #endif break; case DOQUAL : /* fall-thru */ case BOOLQUAL : snd(q) = depExpr(l,snd(q)); depComp(l,e,qs1); break; } } } #if MUDO /* * When typechecking mdo expressions, we need to have * access to mfix et al., so we keep track of whether * a module uses MDOCOMP, and if it does, look up * the necessary class + method in mdoLoad(). * * Do this here rather than in the typechecker itself * (where the innards of mdoLoad() used to be), as name * resolution / checking is really the domain of static * analysis. It also simplifies the handling of a module's * import lists. * */ static Bool mdoLibsNeeded = FALSE; static Void local mdoUsed() { mdoLibsNeeded = TRUE; } static Void local mdoLoad() { if (mdoLibsNeeded) { String fixLib = "Control.Monad.Fix"; String fixClass = "MonadFix"; /* Locate the module containing the MonadRec/MonadFix class */ Module m = findModule(findText(fixLib)); Text t = module(m).text; Text alias = findModAlias(t); /* The class and method name are qualified by the local alias, not * the (real) module name. */ Cell monadRecName = mkQCon(alias,findText(fixClass)); Cell mfixName = mkQCon(alias,findText("mfix")); /* Reset this flag before signalling errors, so we won't inadvertently * loop. */ mdoLibsNeeded = FALSE; if( !(classMonadRec = findQualClass(monadRecName)) && !(classMonadRec = findClass(qtextOf(monadRecName))) ) { ERRMSG(0) "%s class not in scope", fixClass ETHEN ERRTEXT "\n*** Possible cause: \"%s\" module not imported", fixLib EEND; } if( !(nameMFix = findQualName(mfixName)) && !(nameMFix = findName(qtextOf(mfixName))) ) { ERRMSG(0) "%s class does not define the mfix method", fixClass EEND; } } mdoLibsNeeded = FALSE; } /* mdoExpandQualifiers inflates qs into a list of triples the first element is the original q the second is the defined vars the third is the used vars THAT are defined in that binding group */ static Void local mdoExpandQualifiers(l,e,qs,defs) Int l; Cell e; List qs; List defs; { if (isNull(qs)) { List currDeps = mdepends; fst(e) = depExpr(l,fst(e)); fst(e) = pair(fst(e),mdoUsedVars(mdepends,currDeps,defs,NIL)); } else { Cell q = hd(qs); List qs1 = tl(qs); hd(qs) = triple(q,NIL,NIL); switch (whatIs(q)) { case FROMQUAL : { List obvs = saveBvars(); List currDeps = mdepends; enterBtyvs(); fst(snd(q)) = bindPat(l,fst(snd(q))); snd(snd(q)) = depExpr(l,snd(snd(q))); snd3(hd(qs)) = getPatVars(l,fst(snd(q)),NIL); thd3(hd(qs)) = mdoUsedVars(mdepends,currDeps,defs,NIL); mdoExpandQualifiers(l,e,qs1,defs); fst(snd(q)) = applyBtyvs(fst(snd(q))); restoreBvars(obvs); } break; case QWHERE : #if IPARAM if ( checkIBindings(l,snd(q)) ) { ERRMSG(l) "Currently illegal to bind implicit parameters in the recursive do-notation" EEND; } else #endif { List currDeps = mdepends; snd3(hd(qs)) = mdoGetPatVarsLet(l,snd(q),NIL); snd(q) = eqnsToBindings(snd(q),NIL,NIL,NIL); withinScope(snd(q)); snd(q) = dependencyAnal(snd(q)); hd(depends) = snd(q); thd3(hd(qs)) = mdoUsedVars(mdepends,currDeps,defs,snd3(hd(qs))); mdoExpandQualifiers(l,e,qs1,defs); leaveScope(); } break; case DOQUAL : /* fall-thru */ case BOOLQUAL : { List currDeps = mdepends; snd(q) = depExpr(l,snd(q)); thd3(hd(qs)) = mdoUsedVars(mdepends,currDeps,defs,NIL); mdoExpandQualifiers(l,e,qs1,defs); break; } } } } static List local mdoUsedVars(xs,c,ys,ls)/* copy elements of xs until the */ List xs; /* sublist pointed to by c, */ Cell c; List ys; /* if they are in ys */ List ls; { /* but not in ls */ List zs = NIL; List rs = NIL; List final = NIL; for(; nonNull(xs) && xs != c; xs = tl(xs)) { if(cellIsMember(hd(xs),ys) && !varIsMember(textOf(hd(xs)),ls)) { zs = cons(hd(xs), zs); } } /* eliminate duplicates: */ for(rs = zs; nonNull(rs); rs = tl(rs)) { if(!varIsMember(textOf(hd(rs)), tl(rs))) { final = cons(hd(rs), final); } } return final; } static List local mdoGetPatVarsLet(l, eqns, fvs) Int l; List eqns; List fvs; { Cell tmp; Cell e; /* extract pattern variables from eqns.. */ for(tmp = eqns; nonNull(tmp); tmp = tl(tmp)) { switch (fst(hd(tmp))) { case PATBIND : /* now, fst(snd(hd(tmp))) is the pattern.. */ fvs = getPatVars(l, fst(snd(hd(tmp))), fvs); break; case FUNBIND : /* now, we only need to get the function name! */ e = getHead(fst(snd(hd(tmp)))); if(!varIsMember(textOf(e),fvs)) { fvs = cons(e, fvs); } break; default : /* ignore: fixity and type declarations.. */ break; } } return fvs; } static List local mdoBVars(l, qs) /* return list of bound vars */ Int l; /* in an mdo */ List qs; { List mdoBounds = NIL; for(; nonNull(qs); qs = tl(qs)) { Cell q = hd(qs); switch(whatIs(q)) { case FROMQUAL : mdoBounds = getPatVars(l, fst(snd(q)), mdoBounds); break; case QWHERE : { List letVs = NIL; letVs = mdoGetPatVarsLet(l, snd(q), NIL); for(; nonNull(letVs); letVs = tl(letVs)) { mdoBounds = addPatVar(l, hd(letVs), mdoBounds); } } break; case DOQUAL : case BOOLQUAL : break; default : internal("mdo: unknown statement"); break; } } return mdoBounds; } #define segRecs(seg) fst(fst3(seg)) #define segExps(seg) snd(fst3(seg)) #define segDefs(seg) fst(snd3(seg)) #define segUses(seg) snd(snd3(seg)) #define segQuals(seg) thd3(seg) #define qualBody(q) fst3(q) #define qualDefs(q) snd3(q) #define qualUses(q) thd3(q) static List local mdoCleanSegment(seg) /* clean the segment by */ Triple seg; { /* storing rec and used vars first */ List tmp; List accumRecs = NIL; for(tmp = segQuals(seg); nonNull(tmp); tmp = tl(tmp)) { segDefs(seg) = dupOnto(qualDefs(hd(tmp)),segDefs(seg)); } for(tmp = segQuals(seg); nonNull(tmp); tmp = tl(tmp)) { List vs; segUses(seg) = dupOnto(qualUses(hd(tmp)), segUses(seg)); for(vs = qualUses(hd(tmp)); nonNull(vs); vs = tl(vs)) { /* Here're the rules for being added to segRecs: 1. it must be defined in this segment 2. it must not already be defined in this segment 3. it must not already be added 4. if this is a let expression, it must not be defined in that let expression (because let is already recursive) The following if statement exactly captures these rules: */ if( varIsMember(textOf(hd(vs)), segDefs(seg)) && !varIsMember(textOf(hd(vs)), accumRecs) && !varIsMember(textOf(hd(vs)), segRecs(seg)) && ( whatIs(qualBody(hd(tmp))) != QWHERE || !varIsMember(textOf(hd(vs)), qualDefs(hd(tmp))))) { segRecs(seg) = cons(hd(vs), segRecs(seg)); } } accumRecs = dupOnto(qualDefs(hd(tmp)), accumRecs); } return seg; } /* mdoNoLets gets rid of let bindings within mdo in favor of fromquals. * The translation is: * * let bs ---> d <- return (let bs in d) * * where d is the tuple of vars defined in let's. * * It might be argued that this translation happens to early, but this * seems to be the right thing to do to avoid complications in type * checking. */ static List local mdoNoLets(seg) /* get rid of let's */ Triple seg; { List qs; for(qs = segQuals(seg); nonNull(qs); qs = tl(qs)) { Cell q = qualBody(hd(qs)); Cell defs = qualDefs(hd(qs)); switch(whatIs(q)) { case FROMQUAL : case DOQUAL : case BOOLQUAL : break; case QWHERE : { Cell p1,p2; Cell rhs; if(length(defs)==1) { p1 = p2 = hd(defs); } else { List tmp; p1 = pair(mkTuple(length(defs)),hd(defs)); p2 = pair(mkTuple(length(defs)),hd(defs)); for(tmp = tl(defs); nonNull(tmp); tmp=tl(tmp)) { p1 = pair(p1,hd(tmp)); p2 = pair(p2,hd(tmp)); } } rhs = ap(mkVar(findText("return")), ap(LETREC,pair(snd(q),p2))); qualBody(hd(qs)) = ap(QWHERE,pair(p1,rhs)); } break; } } return seg; } static Bool local mdoUsedInAnySeg(v,segs) /* does v appear in any */ Text v; /* used list of any seg? */ List segs; { for(; nonNull(segs); segs = tl(segs)) { if(varIsMember(v,segUses(hd(segs)))) { return TRUE; } } return FALSE; } static Void local mdoComputeExports(segs,e) /* compute export lists */ List segs; /* for each segment */ Cell e; { List eUses = snd(fst(e)); for(; nonNull(segs); segs = tl(segs)) { List vs; for(vs = segDefs(hd(segs)); nonNull(vs); vs = tl(vs)) { if(varIsMember(textOf(hd(vs)),eUses) || mdoUsedInAnySeg(textOf(hd(vs)), tl(segs))) { segExps(hd(segs)) = cons(hd(vs), segExps(hd(segs))); } } } } static Void local depRecComp(l,e,qs) /* find dependents of a recursive */ Int l; /* comprehension */ Cell e; List qs; { List mdoBounds; List obvs; withinScope(NIL); mdoBounds = mdoBVars(l, qs); enterBtyvs(); obvs = saveBvars(); hd(bounds) = mdoBounds; mdoExpandQualifiers(l,e,qs,mdoBounds); restoreBvars(obvs); leaveBtyvs(); leaveScope(); mdoSCC(qs); mapOver(rev,qs); /* qualifiers are reversed after SCC */ /* reserve space for rec and used vars: */ map2Over(triple,pair(NIL,NIL),pair(NIL,NIL),qs); /* clean up each segmet to get recs, uses etc: */ mapOver(mdoCleanSegment,qs); /* get rid of QWHERE's: */ mapOver(mdoNoLets,qs); /* determine the exports of segments: */ mdoComputeExports(qs,e); /**************************************************************** Here's the structure we have at this point: qs is the list of segments each segment looks like: ((1,2), (3,4), [(5,6,7)]) where 1: recursive vars of the segment 2: exported vars of the segment 3: defined vars of the segment 4: used vars of the segment 5: the qualifier 6: the vars that the qualifier defines 7: the vars that the qualifier uses e looks like: ((1,2),3) where 1: the expression 2: used vars of the expression 3: The pointer to qs! The following code prints it out nicely: ****************************************************************/ #if DEBUG_MDO_SEGMENTS #define DBL(s,w) printf(s); printList(w,50); printf("\n") printf("\nAfter SCC, The segments:\n"); { List tmp; Int i = 0; for(tmp = snd(e); nonNull(tmp); i++, tmp = tl(tmp)) { List tmp2; printf("Segment %d:\n----------------------\n", i); for(tmp2 = segQuals(hd(tmp)); nonNull(tmp2); tmp2 = tl(tmp2)) { DBL("Defines : ", qualDefs(hd(tmp2))); DBL("Uses : ", qualUses(hd(tmp2))); } DBL("Segment recs: ", segRecs(hd(tmp))); DBL("Segment uses: ", segUses(hd(tmp))); DBL("Segment defs: ", segDefs(hd(tmp))); DBL("Segment exps: ", segExps(hd(tmp))); } printf("Final Segment:\n----------------------\n"); printf("e : "); printExp(stdout,fst(fst(e))); printf("\n"); DBL("E uses : ", snd(fst(e))); } #undef DBL #endif /* Now do a real clean up: all we need is rec vars and exp vars for each segment. We also keep def vars. Everything else becomes garbage: */ for(; nonNull(qs); qs = tl(qs)) { /* get rid of qual defines and uses of each qual: */ mapOver(fst3,segQuals(hd(qs))); /* if recs is NIL, exps is irrelevant: */ if(isNull(segRecs(hd(qs)))) { segExps(hd(qs)) = NIL; } /* get rid of seg uses: */ hd(qs) = pair(triple(segRecs(hd(qs)),segExps(hd(qs)),segDefs(hd(qs))), segQuals(hd(qs))); } fst(e) = fst(fst(e)); /* clean up e, completes depRecComp */ /************************************************************** At this point the structure we have is: qs is the list of segments each segment looks like: ((1,2,3), 4) where 1: recursive vars of the segment 2: exported vars of the segment 3: defined vars of the segment 4: the list of qualifiers e looks like: (1,2) where 1: the expression 2: The pointer to qs! **************************************************************/ } #undef segRecs #undef segExps #undef segDefs #undef segUses #undef segQuals #undef qualBody #undef qualDefs #undef qualUses static Bool local mdoIsConnected(q, usedVars) /* Does q1 define a variable */ Cell q; /* that is in usedVars? */ List usedVars; { Cell defs; for(defs = snd3(q); nonNull(defs); defs = tl(defs)) { if(varIsMember(textOf(hd(defs)), usedVars)) { return TRUE; } } return FALSE; } static Int local mdoSegment(q, eqs) /* return the index of the last qual */ Cell q; /* in eqs that q is connected to */ List eqs; { Int i, j; List usesAccum = dupList(thd3(q)); Cell qUses = usesAccum; for(i = 1, j = 0; nonNull(eqs); i++, eqs = tl(eqs)) { usesAccum = dupOnto(thd3(hd(eqs)), usesAccum); if(mdoIsConnected(hd(eqs), qUses)) { qUses = usesAccum; j = i; } } return j; } static Void local mdoSCC(eqs) /* SCC for mdo */ List eqs; { /* The input eqs is the extended qualifier list. I.e. each qualifier is a triple where the first element is the qualifier itself, second element is the defined variables and third is the used ones. After SCC, eqs becomes a list of list of qualifiers, where each inner list is a strongly connected component, i.e. a segment. */ Int covers; List eqs1; if(isNull(eqs)) return; hd(eqs) = cons(hd(eqs), NIL); /* Turn into a list */ eqs1 = tl(eqs); covers = mdoSegment(hd(hd(eqs)), eqs1); if(covers > 0) { /* Multiple statements */ while(covers--) { hd(eqs) = cons(hd(eqs1),hd(eqs)); eqs1 = tl(eqs1); } } tl(eqs) = eqs1; mdoSCC(tl(eqs)); /* recurse for the remainder */ } #endif #if ZIP_COMP static List gatheredVars; static List gatheredBinds; static List gatheredTyvars; #define enterGathering() List svGVs = gatheredVars, svGBs = gatheredBinds, svGTs = gatheredTyvars; gatheredVars = gatheredBinds = gatheredTyvars = NIL #define leaveGathering() gatheredVars = svGVs; gatheredBinds = svGBs; gatheredTyvars = svGTs Text zipName(n) Int n; { static char zip[14]; /* n >= 2, enforced by the parser */ if (n == 2) strcpy(zip, "zip"); else sprintf(zip, "zip%d", n); return findText(zip); } static Void local depZComp(l,e,qss) Int l; Cell e; List qss; { Int n = length(qss); enterGathering(); if (n > 3 && isNull(findQualName(mkQVar(findText("List"),zipName(n)))) && isNull(findQualName(mkQVar(findText("Data.List"),zipName(n))))) { ERRMSG(l) "undefined variable \"%s\" (introduced by parallel comprehension)", textToStr(zipName(n)) EEND; } withinScope(NIL); for (;nonNull(qss);qss=tl(qss)) { depZCompBranch(l,hd(qss)); /* reset for next list of qualifiers */ restoreBvars(NIL); } /* add gathered vars */ hd(bounds) = gatheredVars; withinScope(gatheredBinds); enterBtyvs(); hd(btyvars) = gatheredTyvars; fst(e) = depExpr(l,fst(e)); leaveBtyvs(); /* don't want to re-remove the dependency tags */ bounds = tl(bounds); bindings = tl(bindings); depends = tl(depends); leaveScope(); leaveGathering(); } static Void local depZCompBranch(l,qs) /* find dependents of comprehension*/ Int l; List qs; { if (isNull(qs)) { } else { Cell q = hd(qs); List qs1 = tl(qs); switch (whatIs(q)) { case FROMQUAL : { snd(snd(q)) = depExpr(l,snd(snd(q))); enterBtyvs(); fst(snd(q)) = bindPat(l,fst(snd(q))); if (nonNull(intersect(gatheredVars,patVars))) { ERRMSG(l) "Repeated pattern variable(s) in parallel comprehension" EEND; } gatheredVars = revOnto(patVars,gatheredVars); gatheredTyvars = dupOnto(hd(btyvars),gatheredTyvars); depZCompBranch(l,qs1); fst(snd(q)) = applyBtyvs(fst(snd(q))); } break; case QWHERE : snd(q) = eqnsToBindings(snd(q),NIL,NIL,NIL); withinScope(snd(q)); snd(q) = dependencyAnal(snd(q)); hd(depends) = snd(q); if (nonNull(intersectBinds(gatheredBinds,hd(bindings)))) { ERRMSG(l) "Repeated binding(s) in parallel comprehension" EEND; } gatheredBinds = dupOnto(hd(bindings),gatheredBinds); depZCompBranch(l,qs1); leaveScope(); break; case DOQUAL : /* fall-thru */ case BOOLQUAL : snd(q) = depExpr(l,snd(q)); depZCompBranch(l,qs1); break; } } } static List local intersectBinds(bs1,bs2) List bs1, bs2; { return (intersect(getBindVars(bs1),getBindVars(bs2))); } static List local getBindVars(bs) List bs; { List zs = NIL; for (; nonNull(bs); bs=tl(bs)) dupOnto(fst(hd(bs)),zs); return zs; } #endif static Void local depCaseAlt(line,a) /* Find dependents of case altern. */ Int line; Cell a; { List obvs = saveBvars(); /* Save list of bound variables */ enterBtyvs(); fst(a) = bindPat(line,fst(a)); /* Add new bound vars for pats */ depRhs(snd(a)); /* Find dependents of rhs */ fst(a) = applyBtyvs(fst(a)); restoreBvars(obvs); /* Restore original list of bvars */ } static Void local checkNameAmbigName(line,n,isV) Int line; Cell n; Bool isV; { String kind = (isV ? "variable" : "data constructor"); if (!isNull(n) && nonNull(name(n).clashes)) { Text t = name(n).text; List ls = name(n).clashes; ERRMSG(line) "Ambiguous %s occurrence \"%s\"", kind, textToStr(t) ETHEN ERRTEXT "\n*** Could refer to: " ETHEN ERRTEXT "%s.%s ", textToStr(module(name(n).mod).text), textToStr(name(n).text) ETHEN for(;nonNull(ls);ls=tl(ls)) { ERRTEXT "%s.%s ", textToStr(module(name(hd(ls)).mod).text), textToStr(name(hd(ls)).text) ETHEN } ERRTEXT "\n" EEND; } } static Void local checkNameAmbig(line,t,e) Int line; Text t; Cell e; { Name n; if (isName(e)) { n = e; } else { n = findName(t); } checkNameAmbigName(line,n,TRUE); } static Cell local checkTyconAmbig(line,t,e) Int line; Text t; Cell e; { Tycon tc; if (isTycon(e)) { tc = e; } else { tc = findTycon(t); } if (!isNull(tc) && nonNull(tycon(tc).clashes)) { Text t = tycon(tc).text; List ls = tycon(tc).clashes; ERRMSG(line) "Ambiguous type constructor occurrence \"%s\"", textToStr(t) ETHEN ERRTEXT "\n*** Could refer to: " ETHEN ERRTEXT "%s.%s ", textToStr(module(tycon(tc).mod).text), textToStr(tycon(tc).text) ETHEN for(;nonNull(ls);ls=tl(ls)) { ERRTEXT "%s.%s ", textToStr(module(tycon(hd(ls)).mod).text), textToStr(tycon(hd(ls)).text) ETHEN } ERRTEXT "\n" EEND; } return e; } static Cell local depVar(line,e,check) /* Register occurrence of variable */ Int line; Cell e; Bool check; { List bounds1 = bounds; List bindings1 = bindings; List depends1 = depends; Text t = textOf(e); Cell n; while (nonNull(bindings1)) { n = varIsMember(t,hd(bounds1)); /* look for t in bound variables */ if (nonNull(n)) { #if MUDO mdepends = cons(n,mdepends); #endif return (n); } n = findBinding(t,hd(bindings1)); /* look for t in var bindings */ if (nonNull(n)) { if (!cellIsMember(n,hd(depends1))) { hd(depends1) = cons(n,hd(depends1)); } #if MUDO mdepends = cons(isVar(fst(n)) ? fst(n) : e,mdepends); #endif if (check) { checkNameAmbig(line,t, (isVar(fst(n)) ? fst(n) : e)); } return (isVar(fst(n)) ? fst(n) : e); } bounds1 = tl(bounds1); bindings1 = tl(bindings1); depends1 = tl(depends1); } if (isNull(n=findName(t))) { /* check global definitions */ ERRMSG(line) "Undefined variable \"%s\"", textToStr(t) EEND; } /* Check whether there's no ambiguity about which global entity */ if (check) { checkNameAmbig(line,t,e); } if (!moduleThisScript(name(n).mod)) { return n; } /* Later phases of the system cannot cope if we resolve references * to unprocessed objects too early. This is the main reason that * we cannot cope with recursive modules at the moment. */ return e; } static Cell local depQVar(line,e,isV)/* register occurrence of qualified variable */ Int line; Cell e; Bool isV; { List ns = findQualNames(e); String kind = (isV ? "variable" : "data constructor"); Name n; if (isNull(ns)) { /* check global definitions */ ERRMSG(line) "Undefined qualified %s \"%s\"", kind, identToStr(e) EEND; } if (!isNull(tl(ns))) { List ls = ns; ERRMSG(line) "Ambiguous qualified %s occurrence \"%s\"", kind, identToStr(e) ETHEN ERRTEXT "\n*** Could refer to: " ETHEN for(;nonNull(ls);ls=tl(ls)) { ERRTEXT "%s.%s ", textToStr(module(name(hd(ls)).mod).text), textToStr(name(hd(ls)).text) ETHEN } ERRTEXT "\n" EEND; } n = hd(ns); if (name(n).mod != currentModule) { return n; } if (fst(e) == VARIDCELL) { e = mkVar(qtextOf(e)); } else { e = mkVarop(qtextOf(e)); } return depVar(line,e,FALSE); } static Void local depConFlds(line,e,isP)/* check construction using fields */ Int line; Cell e; Bool isP; { Name c = conDefined(line,fst(snd(e)),TRUE); if (isNull(snd(snd(e))) || nonNull(cellIsMember(c,depFields(line,e,snd(snd(e)),isP)))) { fst(snd(e)) = c; } else { ERRMSG(line) "Constructor \"%s\" does not have selected fields in ", textToStr(name(c).text) ETHEN ERREXPR(e); ERRTEXT "\n" EEND; } if (!isP && isPair(name(c).defn)) { /* Check that banged fields defined*/ List scs = fst(name(c).defn); /* List of strict components */ Type t = name(c).type; Int a = userArity(c); List fs = snd(snd(e)); List ss; if (isPolyType(t)) { /* Find tycon that c belongs to */ t = monotypeOf(t); } if (isQualType(t)) { t = snd(snd(t)); } if (whatIs(t)==CDICTS) { t = snd(snd(t)); } while (00) { prev = nx; nx = extRow(nx); } if (nonNull(nx) && t==extText(fun(fun(nx)))) { ERRMSG(line) "Repeated label \"%s\" in record ", s ETHEN ERREXPR(e); ERRTEXT "\n" EEND; } if (isNull(prev)) { exts = cons(fun(r),exts); } else { tl(prev) = cons(fun(r),nx); } extField(r) = depExpr(line,extField(r)); r = extRow(r); } while (isAp(r) && isAp(fun(r)) && isExt(fun(fun(r)))); r = depExpr(line,r); return revOnto(exts,r); } #endif /* -------------------------------------------------------------------------- * Several parts of this program require an algorithm for sorting a list * of values (with some added dependency information) into a list of strongly * connected components in which each value appears before its dependents. * * Each of these algorithms is obtained by parameterising a standard * algorithm in "scc.c" as shown below. * ------------------------------------------------------------------------*/ #define SCC2 tcscc /* make scc algorithm for Tycons */ #define LOWLINK tclowlink #define DEPENDS(c) (isTycon(c) ? tycon(c).kind : cclass(c).kinds) #define SETDEPENDS(c,v) if(isTycon(c)) tycon(c).kind=v; else cclass(c).kinds=v #include "scc.c" #undef SETDEPENDS #undef DEPENDS #undef LOWLINK #undef SCC2 #define SCC bscc /* make scc algorithm for Bindings */ #define LOWLINK blowlink #define DEPENDS(t) depVal(t) #define SETDEPENDS(c,v) depVal(c)=v #include "scc.c" #undef SETDEPENDS #undef DEPENDS #undef LOWLINK #undef SCC /* -------------------------------------------------------------------------- * Main static analysis: * ------------------------------------------------------------------------*/ Void checkExp() { /* Top level static check on Expr */ staticAnalysis(RESET); clearScope(); /* Analyse expression in the scope */ withinScope(NIL); /* of no local bindings */ inputExpr = depExpr(0,inputExpr); leaveScope(); staticAnalysis(RESET); } #if EXPLAIN_INSTANCE_RESOLUTION Void checkContext() { /* Top level static check on Expr */ List vs, qs; staticAnalysis(RESET); clearScope(); /* Analyse expression in the scope */ withinScope(NIL); /* of no local bindings */ qs = inputContext; for (vs = NIL; nonNull(qs); qs=tl(qs)) { vs = typeVarsIn(hd(qs),NIL,NIL,vs); } map2Proc(depPredExp,0,vs,inputContext); leaveScope(); staticAnalysis(RESET); } #endif Void checkDefns() { /* Top level static analysis */ List tcs; Module thisModule = lastModule(); staticAnalysis(RESET); setCurrModule(thisModule); /* Resolve module references */ mapProc(checkQualImport, module(thisModule).modAliases); mapProc(checkUnqualImport,unqualImports); /* Add "import Prelude" if there's no explicit import */ if ((thisModule!=modulePrelude && thisModule!=moduleUserPrelude) && isNull(cellAssoc(moduleUserPrelude,unqualImports)) && isNull(cellRevAssoc(moduleUserPrelude,module(thisModule).modAliases)) ) { addUnqualImport(moduleUserPrelude,mkCon(textUserPrelude),DOTDOT); } map1Proc(checkImportList, FALSE, unqualImports); mapProc(checkQualImportList, module(thisModule).qualImports); /* And, finally, fix-up the effective import lists. */ fixupImportExports(module(currentModule).modImports); /* Note: there's a lot of side-effecting going on here, so don't monkey about with the order of operations here unless you know what you are doing */ linkPreludeTC(); /* Get prelude tycons and classes */ mapProc(checkTyconDefn,tyconDefns); /* validate tycon definitions */ checkSynonyms(tyconDefns); /* check synonym definitions */ mapProc(checkClassDefn,classDefns); /* process class definitions */ tcs = tcscc(tyconDefns,classDefns); /* calc dependencies for type */ /* constructors and classes */ mapProc(kindTCGroup,tcs); /* attach kinds */ mapProc(visitClass,classDefns); /* check class hierarchy */ mapProc(extendFundeps,classDefns); /* finish class definitions */ /* (convenient if we do this after */ /* calling `visitClass' so that we */ /* know the class hierarchy is */ /* acyclic) */ mapProc(checkClassDefn2_,tcs); /* process class definitions again */ mapProc(addMembers,classDefns); /* add definitions for member funs */ linkPreludeCM(); /* Get prelude cfuns and mfuns */ mapOver(checkPrimDefn,primDefns); /* check primitive declarations */ instDefns = rev(instDefns); /* process instance definitions */ mapProc(checkInstDefn,instDefns); setCurrModule(thisModule); mapProc(addRSsigdecls,typeInDefns); /* add sigdecls for RESTRICTSYN */ valDefns = eqnsToBindings(valDefns,tyconDefns,classDefns,primDefns); mapProc(allNoPrevDef,valDefns); /* check against previous defns */ mapProc(addDerivImp,derivedInsts); /* Add impls for derived instances */ deriveContexts(derivedInsts); /* Calculate derived inst contexts */ instDefns = appendOnto(instDefns,derivedInsts); checkDefaultDefns(); /* validate default definitions */ tyconDefns = NIL; primDefns = NIL; if (nonNull(foreignImports) || nonNull(foreignExports)) { /* If generate_ffi is set, we generate a C file which defines * appropriate primitives. * Otherwise, we try to load a C file and look for those * primitives. */ Bool need_stubs = foreignNeedStubs(foreignImports, foreignExports); if (generate_ffi && need_stubs) { foreignHeader(scriptFile); } mapProc(checkForeignImport,foreignImports); mapProc(checkForeignExport,foreignExports); if (generate_ffi && need_stubs) { foreignFooter(scriptFile, module(thisModule).text, foreignImports, foreignExports); } if (need_stubs && (generate_ffi || !generateFFI)) { needPrims(0, NULL); mapProc(linkForeign,foreignImports); #if 0 mapProc(linkForeign,foreignExports); #endif } /* We are now finished with foreign import declarations but * foreign export declarations need to pass through the * typechecker so that we can check that the exported type is * an instance of the actual type and so that we can gnerate * code which inserts any dictionaries we might need. */ foreignImports = NIL; } /* Every top-level name has now been created - so we can build the */ /* export list. Note that this has to happen before dependency */ /* analysis so that references to Prelude.foo will be resolved */ /* when compiling the prelude. */ module(thisModule).exports = checkExports(module(thisModule).exports); mapProc(checkTypeIn,typeInDefns); /* check restricted synonym defns */ clearScope(); withinScope(valDefns); valDefns = topDependAnal(valDefns); /* top level dependency ordering */ linkPreludeFuns(); /* Get prelude funs */ mapProc(depDefaults,classDefns); /* dep. analysis on class defaults */ mapProc(depInsts,instDefns); /* dep. analysis on inst defns */ leaveScope(); /* ToDo: evalDefaults should match current evaluation module */ evalDefaults = defaultDefns; /* Set defaults for evaluator */ /* A module's 'modImports' list is only used to construct a precise export * list in the presence of module re-exportation. We've now finished * computing the export list, so 'modImports' can now be stubbed out. * * 10/02 refinement: hold on to the 'modImports' a little bit longer; * until we switch to another module. This lets the user have access * to the effective imports when eval/querying from the read-eval-print * loop. However, once we switch to another module, the info is gone. * (i.e., there's potential for confusion wrt. the :m command.) * * This is an approximation to simply holding on to a module's * effective imports until it is unloaded. This isn't done due to the * storage overhead imposed. */ staticAnalysis(RESET); } static Void local addRSsigdecls(pr) /* add sigdecls from TYPE ... IN ..*/ Pair pr; { List vs = snd(pr); /* get list of variables */ for (; nonNull(vs); vs=tl(vs)) { if (fst(hd(vs))==SIGDECL) { /* find a sigdecl */ valDefns = cons(hd(vs),valDefns); /* add to valDefns */ hd(vs) = hd(snd3(snd(hd(vs)))); /* and replace with var */ } } } static Void local allNoPrevDef(b) /* ensure no previous bindings for*/ Cell b; { /* variables in new binding */ if (isVar(fst(b))) { noPrevDef(rhsLine(snd(hd(snd(snd(b))))),fst(b)); } else { Int line = rhsLine(snd(snd(snd(b)))); map1Proc(noPrevDef,line,fst(b)); } } static Void local noPrevDef(line,v) /* ensure no previous binding for */ Int line; /* new variable */ Cell v; { Name n = findName(textOf(v)); if (isNull(n)) { n = newName(textOf(v),NIL); name(n).defn = PREDEFINED; } else if (name(n).defn!=PREDEFINED && name(n).mod == currentModule) { /* A local repeated definition */ duplicateError(line,name(n).mod,name(n).text,"variable"); } else if (name(n).defn!=PREDEFINED) { Name oldnm = n; removeName(n); n = newName(textOf(v),NIL); name(n).defn = PREDEFINED; name(n).clashes = cons(oldnm,name(n).clashes); } name(n).line = line; } static Void local duplicateError(line,mod,t,kind)/* report duplicate defn */ Int line; Module mod; Text t; String kind; { if (mod == currentModule) { ERRMSG(line) "Multiple declarations for %s \"%s\"", kind, textToStr(t) EEND; } else { ERRMSG(line) "Declaration of %s \"%s\" clashes with import", kind, textToStr(t) EEND; } } static Void local checkTypeIn(cvs) /* Check that vars in restricted */ Pair cvs; { /* synonym are defined */ Tycon c = fst(cvs); List vs = snd(cvs); for (; nonNull(vs); vs=tl(vs)) { if (isNull(findName(textOf(hd(vs))))) { ERRMSG(tycon(c).line) "No top level binding of \"%s\" for restricted synonym \"%s\"", textToStr(textOf(hd(vs))), textToStr(tycon(c).text) EEND; } } } /* -------------------------------------------------------------------------- * Haskell 98 compatibility tests: * ------------------------------------------------------------------------*/ static Bool local h98Pred(allowArgs,pi) /* Check syntax of Hask98 predicate*/ Bool allowArgs; Cell pi; { return isClass(getHead(pi)) && argCount==1 && (isOffset(getHead(arg(pi))) || isInt(getHead(arg(pi)))) && (argCount==0 || allowArgs); } static Cell local h98Context(allowArgs,ps) Bool allowArgs; /* Check syntax of Hask98 context */ List ps; { for (; nonNull(ps); ps=tl(ps)) { if (!h98Pred(allowArgs,hd(ps))) { return hd(ps); } } return NIL; } static Void local h98CheckCtxt(line,wh,allowArgs,ps,in) Int line; /* Report illegal context/predicate*/ String wh; Bool allowArgs; List ps; Inst in; { #if !HASKELL_98_ONLY if (haskell98) { #endif Cell pi = h98Context(allowArgs,ps); if (nonNull(pi)) { ERRMSG(line) "Illegal Haskell 98 class constraint in %s",wh ETHEN if (nonNull(in)) { ERRTEXT "\n*** Instance : " ETHEN ERRPRED(inst(in).head); } ERRTEXT "\n*** Constraint : " ETHEN ERRPRED(pi); if (nonNull(ps) && nonNull(tl(ps))) { ERRTEXT "\n*** Context : " ETHEN ERRCONTEXT(ps); } ERRTEXT "\n" EEND; } #if !HASKELL_98_ONLY } #endif } static Void local h98CheckType(line,wh,e,t) /* Check for Haskell 98 type */ Int line; String wh; Cell e; Type t; { #if !HASKELL_98_ONLY if (haskell98) { #endif Type ty = t; if (isPolyType(t)) t = monotypeOf(t); if (isQualType(t)) { Cell pi = h98Context(TRUE,fst(snd(t))); if (nonNull(pi)) { ERRMSG(line) "Illegal Haskell 98 class constraint in %s",wh ETHEN ERRTEXT "\n*** Expression : " ETHEN ERREXPR(e); ERRTEXT "\n*** Type : " ETHEN ERRTYPE(ty); ERRTEXT "\n" EEND; } } #if !HASKELL_98_ONLY } #endif } Void h98CheckInferredType(line,e,t) /* Check for Haskell 98 type */ Int line; Cell e; Type t; { #if !HASKELL_98_ONLY if (haskell98) { #endif if (isPolyType(t)) t = monotypeOf(t); if (isQualType(t)) { Cell pi = h98Context(TRUE,fst(snd(t))); if (nonNull(pi)) { ERRMSG(line) "Cannot infer instance" ETHEN ERRTEXT "\n*** Instance : " ETHEN ERRPRED(pi); ERRTEXT "\n*** Expression : " ETHEN ERREXPR(e); ERRTEXT "\n" EEND; } } #if !HASKELL_98_ONLY } #endif } Void h98DoesntSupport(line,wh) /* Report feature missing in H98 */ Int line; String wh; { #if !HASKELL_98_ONLY if (haskell98) { #endif ERRMSG(line) "Haskell 98 does not support %s", wh EEND; #if !HASKELL_98_ONLY } #endif } /* -------------------------------------------------------------------------- * Static Analysis control: * ------------------------------------------------------------------------*/ Void staticAnalysis(what) Int what; { switch (what) { case RESET : #if MUDO mdoLoad(); #endif #if TREX trexLoad(); #endif cfunSfuns = NIL; daSccs = NIL; patVars = NIL; bounds = NIL; bindings = NIL; depends = NIL; #if MUDO mdepends = NIL; #endif tcDeps = NIL; derivedInsts = NIL; diVars = NIL; diNum = 0; unkindTypes = NIL; break; case MARK : mark(daSccs); mark(patVars); mark(bounds); mark(bindings); mark(depends); #if MUDO mark(mdepends); #endif mark(tcDeps); mark(derivedInsts); mark(diVars); mark(cfunSfuns); mark(unkindTypes); #if TREX mark(extKind); #endif break; case INSTALL : staticAnalysis(RESET); #if TREX extKind = pair(STAR,pair(ROW,ROW)); #endif break; } } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/storage.c0000644006511100651110000032550507776610107015407 0ustar rossross/* -------------------------------------------------------------------------- * Primitives for manipulating global data structures * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: storage.c,v $ * $Revision: 1.86 $ * $Date: 2004/01/06 19:45:11 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "opts.h" #include "errors.h" #include "machdep.h" #include "evaluator.h" /* everybody() proto only */ #include "strutil.h" #include "output.h" /* needed for DEBUG_PRINTER|PROFILING */ #include /*#define DEBUG_SHOWUSE*/ /* -------------------------------------------------------------------------- * local function prototypes: * ------------------------------------------------------------------------*/ static Int local hash Args((String)); static Int local saveText Args((Text)); static Void local hashTycon Args((Tycon)); static List local insertTycon Args((Tycon,List)); static Void local hashName Args((Name)); static List local insertName Args((Name,List)); static Void local patternError Args((String)); static Bool local stringMatch Args((String,String)); static Bool local typeInvolves Args((Type,Type)); static Cell local markCell Args((Cell)); static Cell local markSnd Args((Cell)); static Cell local indirectChain Args((Cell)); static Bool local isMarked Args((Cell)); static Cell local lowLevelLastIn Args((Cell)); static Cell local lowLevelLastOut Args((Cell)); #if IO_HANDLES static Void local freeHandle Args((Int)); #endif #if GC_STABLEPTRS static Void local resetStablePtrs Args((Void)); #endif #if OBSERVATIONS static Observe local newObserve Args((Text)); static Void local appendObs Args((Cell,Cell)); static Breakpt local addBreakpt Args((String)); static Breakpt local findBreakpt Args((String)); #endif #ifdef DOTNET extern Void markDotNetPtrs(Int* masks); extern Void zeroDotNetTable(); #endif /* -------------------------------------------------------------------------- * Text storage: * * provides storage for the characters making up identifier and symbol * names, string literals, character constants etc... * * All character strings are stored in a large character array, with textHw * pointing to the next free position. Lookup in the array is improved using * a hash table. Internally, text strings are represented by integer offsets * from the beginning of the array to the string in question. * * Where memory permits, the use of multiple hashtables gives a significant * increase in performance, particularly when large source files are used. * * Each string in the array is terminated by a zero byte. No string is * stored more than once, so that it is safe to test equality of strings by * comparing the corresponding offsets. * * Special text values (beyond the range of the text array table) are used * to generate unique `new variable names' as required. * * The same text storage is also used to hold text values stored in a saved * expression. This grows downwards from the top of the text table (and is * not included in the hash table). * ------------------------------------------------------------------------*/ #define TEXTHSZ 512 /* Size of Text hash table */ #define NOTEXT ((Text)(~0)) /* Empty bucket in Text hash table */ static Text textHw; /* Next unused position */ static Text savedText = NUM_TEXT; /* Start of saved portion of text */ static Text nextNewText; /* Next new text value */ static Text nextNewDText; /* Next new dict text value */ static char DEFTABLE(text,NUM_TEXT);/* Storage of character strings */ static Text textHash[TEXTHSZ][NUM_TEXTH]; /* Hash table storage */ String textToStr(t) /* find string corresp to given Text*/ Text t; { static char newVar[16]; if (0<=t && t=NUM_TEXT); } #define MAX_FIXLIT 100 Text fixLitText(t) /* fix literal text that might include \ */ Text t; { String s = textToStr(t); char p[MAX_FIXLIT]; Int i; for(i = 0;i < MAX_FIXLIT-2 && *s;s++) { p[i++] = *s; if (*s == '\\') { p[i++] = '\\'; } } if (i < MAX_FIXLIT-2) { p[i] = 0; } else { ERRMSG(0) "storage space exhausted for internal literal string" EEND; } return (findText(p)); } #undef MAX_FIXLIT #define MAX_TEXTLEN 4000 /* cf. MAX_TOKEN in input.c */ Text concatText(s1,s2) String s1; String s2; { char s[MAX_TEXTLEN]; if (snprintf(s,MAX_TEXTLEN,"%s%s",s1,s2) == -1) { ERRMSG(0) "Generated name '%s%s' exceeds limit of %d", s1, s2, MAX_TEXTLEN EEND; } return findText(s); } #undef MAX_TEXTLEN Text subText(s,l) /* extract a substring and make it a Text */ String s; Int l; { /* * This used to insert '\0' at s[l], do a lookup and then change s[l] * back to its old value. This fails if the String happens to be the * result of textToStr so instead we make a copy, do the lookup and * forget the copy. */ String t = strnCopy(s, l); Text r = findText(t); free(t); return r; } static Int local hash(s) /* Simple hash function on strings */ String s; { int v, j = 3; for (v=((int)(*s))*8; *s; s++) v += ((int)(*s))*(j++); if (v<0) v = (-v); return(v%TEXTHSZ); } Text findText(s) /* Locate string in Text array */ String s; { int h = hash(s); int hashno = 0; Text textPos = textHash[h][hashno]; #define TryMatch { Text originalTextPos = textPos; \ String t; \ for (t=s; *t==text[textPos]; textPos++,t++) \ if (*t=='\0') \ return originalTextPos; \ } #define Skip while (text[textPos++]) ; while (textPos!=NOTEXT) { TryMatch if (++hashno savedText) { ERRMSG(0) "Character string storage space exhausted" EEND; } while ((text[textHw++] = *s++) != 0) { } if (hashno savedText) { ERRMSG(0) "Character string storage space exhausted" EEND; } savedText -= l+1; strcpy(text+savedText,s); return savedText; } /* -------------------------------------------------------------------------- * Addr storage: records `next unused program location' * ------------------------------------------------------------------------*/ static Addr addrHw; /* next unused program location */ Addr getMem(n) /* Get some more memory */ Int n; { Addr newAddr = addrHw; addrHw += n; #if WANT_FIXED_SIZE_TABLES if (addrHw>=NUM_ADDRS) { ERRMSG(0) "Program code storage space exhausted" EEND; } #else while (addrHw>=(Int)(dynMemory->maxIdx)) { growMemory(); } #endif return newAddr; } Void nextInstr(a) /* Reset point to next instruction */ Addr a; { /* Currently does NO CHECKING */ addrHw = a; } /* -------------------------------------------------------------------------- * Ext storage: * * Currently, the only attributes that we store for each Ext value is the * corresponding Text label. At some later stage, we may decide to cache * types, predicates, etc. here as a space saving gesture. Given that Text * comparison is cheap, and that this is an experimental implementation, we * will use a straightforward linear search to locate Ext values from their * corresponding Text labels; a hashing scheme can be introduced later if * this turns out to be a problem. * ------------------------------------------------------------------------*/ #if TREX Text DEFTABLE(tabExt,NUM_EXT); /* Storage for Ext names */ Ext extHw; Ext mkExt(t) /* Allocate or find an Ext value */ Text t; { Ext e = EXTMIN; for (; e= NUM_EXT) { ERRMSG(0) "Ext storage space exhausted" EEND; } extText(extHw) = t; return extHw++; } #endif /* -------------------------------------------------------------------------- * Tycon storage: * * A Tycon represents a user defined type constructor. Tycons are indexed * by Text values ... a very simple hash function is used to improve lookup * times. Tycon entries with the same hash code are chained together, with * the most recent entry at the front of the list. * ------------------------------------------------------------------------*/ #define TYCONHSZ 256 /* Size of Tycon hash table*/ #define tHash(x) ((x)%TYCONHSZ) /* Tycon hash function */ static Tycon tyconHw; /* next unused Tycon */ static Tycon DEFTABLE(tyconHash,TYCONHSZ); /* Hash table storage */ struct strTycon DEFTABLE(tabTycon,NUM_TYCON); /* Tycon storage */ Tycon newTycon(t) /* add new tycon to tycon table */ Text t; { Int h = tHash(t); if (tyconHw-TYCMIN >= NUM_TYCON) { ERRMSG(0) "Type constructor storage space exhausted" EEND; } tycon(tyconHw).text = t; /* clear new tycon record */ tycon(tyconHw).mod = currentModule; tycon(tyconHw).kind = NIL; tycon(tyconHw).what = NIL; tycon(tyconHw).defn = NIL; module(currentModule).tycons = cons(tyconHw,module(currentModule).tycons); tycon(tyconHw).nextTyconHash = tyconHash[h]; tycon(tyconHw).clashes = NIL; tyconHash[h] = tyconHw; return tyconHw++; } Tycon findTycon(t) /* locate Tycon in tycon table */ Text t; { Tycon tc = tyconHash[tHash(t)]; while (nonNull(tc) && tycon(tc).text!=t) tc = tycon(tc).nextTyconHash; return tc; } Tycon addTycon(tc) /* Insert Tycon in tycon table - if no clash is caused */ Tycon tc; { Tycon oldtc = findTycon(tycon(tc).text); if (isNull(oldtc)) { hashTycon(tc); module(currentModule).tycons=cons(tc,module(currentModule).tycons); return tc; } else return oldtc; } static Void local hashTycon(tc) /* Insert Tycon into hash table */ Tycon tc; { Text t = tycon(tc).text; Int h = tHash(t); tycon(tc).nextTyconHash = tyconHash[h]; tycon(tc).clashes = NIL; tyconHash[h] = tc; } Tycon findQualTycon(id) /*locate (possibly qualified) Tycon in tycon table */ Cell id; { if (!isPair(id)) internal("findQualTycon"); switch (fst(id)) { case CONIDCELL : case CONOPCELL : return findTycon(textOf(id)); case QUALIDENT : { Text t = qtextOf(id); List ms = findQualifiers(qmodOf(id)); if (isNull(ms)) return NIL; while (nonNull(ms)) { Module m = hd(ms); List es = NIL; ms = tl(ms); if (m == currentModule) { es = module(m).tycons; } else { es = getModuleImports(m); } for(; nonNull(es); es=tl(es)) { Cell e = hd(es); if (isTycon(e) && tycon(e).text==t) return e; if (isPair(e) && isTycon(fst(e)) && tycon(fst(e)).text==t) return fst(e); } } return NIL; } default : internal("findQualTycon2"); } return NIL;/*NOTUSED*/ } Tycon addPrimTycon(t,kind,ar,what,defn) /* add new primitive type constr */ Text t; Kind kind; Int ar; Cell what; Cell defn; { Tycon tc = newTycon(t); tycon(tc).line = 0; tycon(tc).kind = kind; tycon(tc).what = what; tycon(tc).defn = defn; tycon(tc).arity = ar; tycon(tc).mod = currentModule; return tc; } static List local insertTycon(tc,ts) /* insert tycon tc into sorted list*/ Tycon tc; /* ts */ List ts; { Cell prev = NIL; Cell curr = ts; String s = textToStr(tycon(tc).text); while (nonNull(curr) && strCompare(s,textToStr(tycon(hd(curr)).text))>=0) { if (hd(curr)==tc) /* just in case we get duplicates! */ return ts; prev = curr; curr = tl(curr); } if (nonNull(prev)) { tl(prev) = cons(tc,curr); return ts; } else return cons(tc,curr); } List addTyconsMatching(pat,ts) /* Add tycons matching pattern pat */ String pat; /* to list of Tycons ts */ List ts; { /* Null pattern matches every tycon*/ Tycon tc; /* (Tycons with NIL kind excluded) */ for (tc=TYCMIN; tcInt */ static Name nameHw; /* next unused name */ static Name DEFTABLE(nameHash,NAMEHSZ); /* Hash table storage */ struct strName DEFTABLE(tabName,NUM_NAME); /* Name table storage */ Name newName(t,parent) /* Add new name to name table */ Text t; Cell parent; { Int h = nHash(t); if (nameHw-NAMEMIN >= NUM_NAME) { ERRMSG(0) "Name storage space exhausted" EEND; } name(nameHw).text = t; /* clear new name record */ name(nameHw).line = 0; name(nameHw).syntax = (unsigned int)NO_SYNTAX; name(nameHw).parent = parent; name(nameHw).arity = 0; name(nameHw).number = EXECNAME; name(nameHw).defn = NIL; name(nameHw).type = NIL; name(nameHw).extFun = 0; name(nameHw).foreignId = -1; name(nameHw).foreignFlags = FFI_NOSAFETY | FFI_CCONV_UNKNOWN; #ifdef DOTNET name(nameHw).foreignInfo = NIL; #endif name(nameHw).primDef = 0; name(nameHw).code = 0; name(nameHw).mod = currentModule; name(nameHw).clashes = NIL; module(currentModule).names=cons(nameHw,module(currentModule).names); name(nameHw).nextNameHash = nameHash[h]; nameHash[h] = nameHw; return nameHw++; } Name findName(t) /* Locate name in name table */ Text t; { Name n = nameHash[nHash(t)]; while (nonNull(n) && name(n).text!=t) n = name(n).nextNameHash; return n; } Name addName(nm) /* Insert Name in name table - if */ Name nm; { /* no clash is caused */ Name oldnm = findName(name(nm).text); if (isNull(oldnm)) { hashName(nm); module(currentModule).names=cons(nm,module(currentModule).names); return nm; } else return oldnm; } static Void local hashName(nm) /* Insert Name into hash table */ Name nm; { Text t = name(nm).text; Int h = nHash(t); name(nm).nextNameHash = nameHash[h]; name(nm).clashes = NIL; nameHash[h] = nm; } /* * Remove 'n' from a module's 'names' list; used to implement * local overrides of imported decls. */ Void removeName(n) Name n; { List ls = module(currentModule).names; List* prev = &(module(currentModule).names); for (;nonNull(ls);ls=tl(ls)) { if (hd(ls) == n) { *prev = tl(ls); break; } prev = &(tl(ls)); } } Name findQualName(id) /* Locate (possibly qualified) name*/ Cell id; { /* in name table */ if (!isPair(id)) internal("findQualName"); switch (fst(id)) { case VARIDCELL : case VAROPCELL : case CONIDCELL : case CONOPCELL : return findName(textOf(id)); case QUALIDENT : { Text t = qtextOf(id); List ms = findQualifiers(qmodOf(id)); if (isNull(ms)) return NIL; while (nonNull(ms)) { Module m = hd(ms); List es = NIL; ms = tl(ms); if (m == currentModule) { es = module(m).names; } else { es = getModuleImports(m); } for(; nonNull(es); es=tl(es)) { Cell e = hd(es); if (isName(e) && name(e).text==t) return e; if (isTycon(e) && tycon(e).text==t) return e; else if (isPair(e)) { List subentities = NIL; Cell c = fst(e); if (snd(e) == DOTDOT) { if (isTycon(c) && (tycon(c).what==DATATYPE || tycon(c).what==NEWTYPE)) { subentities = tycon(c).defn; } else if (isClass(c)) subentities = cclass(c).members; } else { subentities = snd(e); } for(; nonNull(subentities); subentities=tl(subentities)) { if (name(hd(subentities)).text == t) return hd(subentities); } } } } return NIL; } default : internal("findQualName2"); } return NIL;/*NOTUSED*/ } List findQualNames(id) /* Locate (possibly qualified) names */ Cell id; { /* in name table */ if (!isPair(id)) internal("findQualNames"); switch (fst(id)) { case VARIDCELL : case VAROPCELL : case CONIDCELL : case CONOPCELL : return singleton(findName(textOf(id))); case QUALIDENT : { Text t = qtextOf(id); Text aliasMod = qmodOf(id); List ms = findQualifiers(aliasMod); List res = NIL; Bool fromHome = FALSE; if (isNull(ms)) return NIL; while (nonNull(ms)) { Module m = hd(ms); List es = NIL; ms = tl(ms); /* For each module with alias 'aliasMod', get at * what 'currentModule' imports from it. */ if (m == currentModule) { es = module(m).names; fromHome = TRUE; } else { es = getModuleImports(m); fromHome = FALSE; } /* Chase down list looking for _unqual_ entity. */ for(; nonNull(es); es=tl(es)) { Cell e = hd(es); if (isName(e) && name(e).text==t && !cellIsMember(e,res)) { if (fromHome && name(e).mod != currentModule) { /* If we're processing local names, only interested in * names that were actually declared there. */ continue; } res = cons(e,res); } else if (isPair(e)) { List subentities = NIL; Cell c = fst(e); if (DOTDOT==snd(e)) { if (isTycon(c) && (tycon(c).what==DATATYPE || tycon(c).what==NEWTYPE)) subentities = tycon(c).defn; else if (isClass(c)) subentities = cclass(c).members; } else { subentities = snd(e); } for(; nonNull(subentities); subentities=tl(subentities)) { if (name(hd(subentities)).text == t && !cellIsMember(hd(subentities),res) ) { if (fromHome && name(hd(subentities)).mod != currentModule) { continue; } res=cons(hd(subentities),res); } } } } } return res; } default : internal("findQualName2"); } return NIL;/*NOTUSED*/ } Name findQualFun(m,v) /* Locate name in name table */ Text m; Text v; { Module mod = findModule(m); List ns; if (isNull(mod)) { return NIL; } for(ns=module(mod).names; nonNull(ns); ns=tl(ns)) { Name n = hd(ns); if (name(n).text == v) { return n; } } return NIL; } /* -------------------------------------------------------------------------- * Primitive functions: * ------------------------------------------------------------------------*/ struct primInfoDef { Module prim_module; /* module that defined prim-table */ Bool prim_oldIO; /* backwards compat: does the DLL's primop assume old IO rep? */ void* prim_dll; /* if in a dll, handle to it. */ struct primInfo* p_info; struct primInfoDef* nextPrimInfoDef; /* subsumes nextPrimInfo (ToDo: nuke it) */ }; static Void local freePrimInfo Args((struct primInfoDef*)); static struct primInfoDef *firstPrimInfo = 0; /* queue of primInfo structures */ static struct primInfoDef *lastPrimInfo = 0; /* Nasty global flag - set prior to hoisting in a DLL */ static Bool oldIO_dll = FALSE; Bool setOldDLLFlag(flg) Bool flg; { Bool res = oldIO_dll; oldIO_dll = flg; return res; } Void registerPrims(info) /* register new primitives */ struct primInfo *info; { struct primInfoDef* new_entry; /* ToDo: this is in all likelihood not the Approved Way of asking for mem. from the OS. * Figure out what's the local idiom. */ if ( (new_entry = malloc(sizeof(struct primInfoDef))) == NULL ) { /* It's going to break pretty soon anyway...*/ return; } else { new_entry->prim_module = currentModule; new_entry->prim_oldIO = oldIO_dll; new_entry->p_info = info; new_entry->prim_dll = NULL; } if (0 == firstPrimInfo) /* first entry in queue */ firstPrimInfo = lastPrimInfo = new_entry; else lastPrimInfo = lastPrimInfo->nextPrimInfoDef = new_entry; lastPrimInfo->nextPrimInfoDef = 0; } struct primInfoDef* setPrimInfoDll(dll) void* dll; { /* After a module has registered its primitives, we set its primInfoDef (==lastPrimInfo) to point to the DLL the prims are located in, so that we can later on release the DLL upon module unload. */ lastPrimInfo->prim_dll = dll; return lastPrimInfo; } static Void local freePrimInfo(p) struct primInfoDef* p; { struct primInfoDef* info = firstPrimInfo; struct primInfoDef* prev = 0; if (p && p->prim_dll) { freeDLL(p->prim_dll); } while (info) { if (info == p) { /* Remove it from the list */ if (prev) { prev->nextPrimInfoDef = info->nextPrimInfoDef; } else { firstPrimInfo = info->nextPrimInfoDef; prev = firstPrimInfo; } if (lastPrimInfo == info) { lastPrimInfo = prev; } free(p); return; } prev = info; info = info->nextPrimInfoDef; } } Void addPrim(l,n,s,mod,ty) /* Add primitive function value */ Int l; Name n; String s; Module mod; Type ty; { struct primInfoDef *info_def; Bool lookInPrelude = TRUE; name(n).line = l; name(n).defn = NIL; name(n).type = ty; name(n).mod = mod; /* * (mini) sigh - the primitives for the Prelude'ish modules * are special in the sense that each such module doesn't * have its own prim-table (cf. Int). So, we make two passes * over the prim-table list, first time around we demand * that the defining Module for the primitive we're adding * matches that of the Module pinned onto the prim-table we're * currently looking at. If that didn't produce any matches, * we have another go, this time scanning through the misc * builtin prim-tables. * * => If a module's prim-table doesn't have an entry for * the prim-decl in question, we try to fall back on * any of the builtin ones. * */ do { info_def = firstPrimInfo; lookInPrelude = !lookInPrelude; for(; 0 != info_def; info_def=info_def->nextPrimInfoDef) { if ( ( lookInPrelude && isPrelude(info_def->prim_module)) || mod == info_def->prim_module ) { struct primitive *prims = info_def->p_info->primFuns; Int i = 0; for (; prims[i].ref; ++i) if (strcmp(s,prims[i].ref)==0) { name(n).arity = prims[i].arity; if ( info_def->prim_oldIO && hasIOResultType(ty) ) { /* The primitive has IO type and its impl assumes the old * IO rep which took a failure and success continuation. * The failure continuation is assumed unused within the * DLL's primitives (reasonable assumption), so interoperating * with the new representation is simply a case of adjusting * the arity. */ name(n).arity--; } name(n).number = EXECNAME; name(n).primDef = prims[i].imp; return; } } } } while (!lookInPrelude); ERRMSG(name(n).line) "Unknown primitive reference \"%s\"", s EEND; } Name addPrimCfun(t,arity,no,type) /* add primitive constructor func */ Text t; Int arity; Int no; Cell type; { Name n = newName(t,NIL); name(n).arity = arity; name(n).number = cfunNo(no); name(n).type = type; name(n).mod = currentModule; return n; } Int sfunPos(s,c) /* Find position of field with */ Name s; /* selector s in constructor c. */ Name c; { List cns; cns = name(s).defn; for (; nonNull(cns); cns=tl(cns)) if (fst(hd(cns))==c) return intOf(snd(hd(cns))); internal("sfunPos"); return 0;/*NOTREACHED*/ } static List local insertName(nm,ns) /* insert name nm into sorted list */ Name nm; /* ns */ List ns; { Cell prev = NIL; Cell curr = ns; String s = textToStr(name(nm).text); while (nonNull(curr) && strCompare(s,textToStr(name(hd(curr)).text))>=0) { if (hd(curr)==nm) /* just in case we get duplicates! */ return ns; prev = curr; curr = tl(curr); } if (nonNull(prev)) { tl(prev) = cons(nm,curr); return ns; } else return cons(nm,curr); } List addNamesMatching(pat,ns) /* Add names matching pattern pat */ String pat; /* to list of names ns */ List ns; { /* Null pattern matches every name */ Name nm; /* (Names with NIL type, or hidden */ #if 1 for (nm=NAMEMIN; nm= *str))) found = TRUE; if (*pat != ']') patternError("missing `]'"); if (!found) return FALSE; pat++; str++; } break; case '\\' : if (*++pat == '\0') patternError("extra trailing `\\'"); /*fallthru!*/ default : if (*pat++ != *str++) return FALSE; break; } } /* -------------------------------------------------------------------------- * Storage of type classes, instances etc...: * ------------------------------------------------------------------------*/ static Class classHw; /* next unused class */ static List classes; /* list of classes in current scope */ static Inst instHw; /* next unused instance record */ #if WANT_FIXED_SIZE_TABLES struct strClass DEFTABLE(tabClass,NUM_CLASSES); /* table of class records */ #else /* (Dynamically) growable tables holding the class and instance info */ static DynTable* dynTabClass = NULL; static DynTable* dynTabInst = NULL; struct strClass *tabClass; #endif struct strInst *tabInst; /* (pointer to) table of instances */ Class newClass(t) /* add new class to class table */ Text t; { #if WANT_FIXED_SIZE_TABLES if (classHw-CLASSMIN >= NUM_CLASSES) { ERRMSG(0) "Class storage space exhausted" EEND; } #else if (classHw-CLASSMIN >= (Int)(dynTabClass->maxIdx)) { growDynTable(dynTabClass); tabClass = (struct strClass*)(dynTabClass->data); } #endif cclass(classHw).text = t; cclass(classHw).line = 0; cclass(classHw).arity = 0; cclass(classHw).tyvars = NIL; cclass(classHw).kinds = NIL; cclass(classHw).head = NIL; cclass(classHw).fds = NIL; cclass(classHw).xfds = NIL; cclass(classHw).dcon = NIL; cclass(classHw).supers = NIL; cclass(classHw).numSupers = 0; cclass(classHw).dsels = NIL; cclass(classHw).members = NIL; cclass(classHw).numMembers = 0; cclass(classHw).defaults = NIL; cclass(classHw).instances = NIL; cclass(classHw).clashes = NIL; classes=cons(classHw,classes); cclass(classHw).mod = currentModule; module(currentModule).classes=cons(classHw,module(currentModule).classes); return classHw++; } Class classMax() { /* Return max Class in use ... */ return classHw; /* This is a bit ugly, but it's not*/ } /* worth a lot of effort right now */ Class findClass(t) /* look for named class in table */ Text t; { Class cl; List cs; for (cs=classes; nonNull(cs); cs=tl(cs)) { cl=hd(cs); if (cclass(cl).text==t) return cl; } return NIL; } Class addClass(c) /* Insert Class in class list */ Class c; { /* - if no clash caused */ Class oldc = findClass(cclass(c).text); if (isNull(oldc)) { classes=cons(c,classes); module(currentModule).classes=cons(c,module(currentModule).classes); return c; } else return oldc; } Class findQualClass(c) /* Look for (possibly qualified) */ Cell c; { /* class in class list */ if (!isQualIdent(c)) { return findClass(textOf(c)); } else { Text t = qtextOf(c); List ms = findQualifiers(qmodOf(c)); if (isNull(ms)) return NIL; while (nonNull(ms)) { Module m = hd(ms); List es = NIL; ms = tl(ms); if (m == currentModule) { es = module(m).classes; } else { es = getModuleImports(m); } for (; nonNull(es); es=tl(es)) { Cell e = hd(es); if (isClass(e) && cclass(e).text == t) return e; if (isPair(e) && isClass(fst(e)) && cclass(fst(e)).text==t) return fst(e); } } } return NIL; } Inst newInst() { /* Add new instance to table */ #if WANT_FIXED_SIZE_TABLES if (instHw-INSTMIN >= NUM_INSTS) { ERRMSG(0) "Instance storage space exhausted" EEND; } #else if (instHw-INSTMIN >= (Int)(dynTabInst->maxIdx)) { growDynTable(dynTabInst); tabInst = (struct strInst*)(dynTabInst->data); } #endif inst(instHw).kinds = NIL; inst(instHw).head = NIL; inst(instHw).specifics = NIL; inst(instHw).implements = NIL; inst(instHw).builder = NIL; return instHw++; } #if DEBUG_DICTS extern Void printInst Args((Inst)); Void printInst(in) Inst in; { Class cl = inst(in).c; Printf("%s-", textToStr(cclass(cl).text)); printType(stdout,inst(in).t); } #endif /* DEBUG_DICTS */ Inst findFirstInst(tc) /* look for 1st instance involving */ Tycon tc; { /* the type constructor tc */ return findNextInst(tc,INSTMIN-1); } Inst findNextInst(tc,in) /* look for next instance involving*/ Tycon tc; /* the type constructor tc */ Inst in; { /* starting after instance in */ while (++in < instHw) { Cell pi = inst(in).head; for (; isAp(pi); pi=fun(pi)) if (typeInvolves(arg(pi),tc)) return in; } return NIL; } static Bool local typeInvolves(ty,tc) /* Test to see if type ty involves */ Type ty; /* type constructor/tuple tc. */ Type tc; { return (ty==tc) || (isAp(ty) && (typeInvolves(fun(ty),tc) || typeInvolves(arg(ty),tc))); } /* -------------------------------------------------------------------------- * Control stack: * * Various parts of the system use a stack of cells. Most of the stack * operations are defined as macros, expanded inline. * ------------------------------------------------------------------------*/ Cell DEFTABLE(cellStack,NUM_STACK); /* Storage for cells on stack */ #ifndef GLOBALsp StackPtr sp; /* stack pointer */ #endif #if GIMME_STACK_DUMPS #define UPPER_DISP 5 /* # display entries on top of stack */ #define LOWER_DISP 5 /* # display entries on bottom of stack*/ extern Int rootsp; extern Cell evalRoots[]; Void hugsStackOverflow() { /* Report stack overflow */ ERRMSG(0) "Control stack overflow" ETHEN if (rootsp>=0) { Int i; if (rootsp>=UPPER_DISP+LOWER_DISP) { for (i=0; i=0; i--) { ERRTEXT "\nwhile evaluating: " ETHEN ERREXPR(evalRoots[i]); } } else { for (i=rootsp; i>=0; i--) { ERRTEXT "\nwhile evaluating: " ETHEN ERREXPR(evalRoots[i]); } } } ERRTEXT "\n" EEND; } #else /* !GIMME_STACK_DUMPS */ Void hugsStackOverflow() { /* Report stack overflow */ ERRMSG(0) "Control stack overflow" EEND; } #endif /* !GIMME_STACK_DUMPS */ /* -------------------------------------------------------------------------- * Observation storage * ------------------------------------------------------------------------*/ #if OBSERVATIONS static Observe observeHw; /* next unused Observe */ struct strObserve DEFTABLE(tabObserve,NUM_OBS_TAGS); /* Observe storage */ static Observe currentObs; /* for table iterators */ Observe newObserve(t) Text t; { if (observeHw-OBSMIN >= NUM_OBS_TAGS) { ERRMSG(0) "Observation storage space exhausted" EEND; } observe(observeHw).tag = t; observe(observeHw).head = triple(OBSERVEHEAD,NIL,NIL); return observeHw++; } Observe firstObserve(){ if (observeHw==OBSMIN) return currentObs=0; else return currentObs=OBSMIN; } Observe nextObserve(){ if (currentObs && ++currentObs < observeHw) return currentObs; else return currentObs=0; } Void clearObserve(){ observeHw = OBSMIN; } Cell addObsInstance(s,e,id) String s; /* the tag */ Cell e; /* observed expr */ Int id; /* identifying number */ { Observe i; Triple obsCell = triple(NIL, mkInt(id), e); Text t = findText(s); for (i=OBSMIN; i=i; j--) breakpt(j+1) = breakpt(j); breakpt(i).tag = t; breakpt(i).enabled = FALSE; breakptHw++; return i; } } Breakpt findBreakpt(s) /* return index of breakpt name */ String s; { /* return BRKMIN-1 if not found */ Breakpt lower, upper, i; Text t = findText(s); lower = BRKMIN; upper = breakptHw-1; while (lower <= upper) { i = (lower+upper) / 2; if (t < breakpt(i).tag) upper = i - 1; else if (t > breakpt(i).tag) lower = i + 1; else return i; } return BRKMIN-1; } Bool breakNow(s) /* break enabled && no skips */ String s; { /* decrements skip counter */ Breakpt b = findBreakpt(s); if ((b >= BRKMIN) && breakpt(b).enabled) if (breakpt(b).count){ breakpt(b).count--; return FALSE; } else return TRUE; else return FALSE; } Void setBreakpt(s,v) /* enable breakpt; may create a table entry*/ String s; Bool v; { Breakpt b = findBreakpt(s); if (b < BRKMIN) b = addBreakpt(s); breakpt(b).enabled = v; } Void setBreakCount(s,n) /* set skip count value for breakpoint */ String s; Int n; { Breakpt b = findBreakpt(s); if (b >= BRKMIN) breakpt(b).count = n; } #endif /* -------------------------------------------------------------------------- * Module storage: * * A Module represents a user defined module. * * Note: there are now two lookup mechanisms in the system: * * 1) The exports from a module are stored in a big list. * We resolve qualified names, and import lists by linearly scanning * through this list. * * 2) Unqualified imports and local definitions for the current module * are stored in hash tables (tyconHash and nameHash) or linear lists * (classes). * * ------------------------------------------------------------------------*/ static Module moduleHw; /* next unused Module */ struct strModule DEFTABLE(tabModule,NUM_MODULE); /* Module storage */ Module currentModule; /* Module currently being processed*/ Bool isValidModule(m) /* is m a legitimate module id? */ Module m; { return (MODMIN <= m && m < moduleHw); } Module newModule(t) /* add new module to module table */ Text t; { if (moduleHw-MODMIN >= NUM_MODULE) { ERRMSG(0) "Module storage space exhausted" EEND; } module(moduleHw).text = t; /* clear new module record */ module(moduleHw).tycons = NIL; module(moduleHw).names = NIL; module(moduleHw).classes = NIL; module(moduleHw).exports = NIL; module(moduleHw).modAliases = NIL; module(moduleHw).modImports = NIL; module(moduleHw).qualImports = NIL; return moduleHw++; } Module findModule(t) /* locate Module in module table */ Text t; { Module m; for(m=MODMIN; m= NUM_SCRIPTS) { ERRMSG(0) "Too many script files in use" EEND; } #else if (scriptHw >= (Int)(dynTabScripts->maxIdx)) { growDynTable(dynTabScripts); scripts = (script*)(dynTabScripts->data); } #endif #if DEBUG_SHOWUSE showUse("Text", textHw, NUM_TEXT); showUse("Addr", addrHw, NUM_ADDRS); showUse("Module", moduleHw-MODMIN, NUM_MODULE); showUse("Tycon", tyconHw-TYCMIN, NUM_TYCON); showUse("Name", nameHw-NAMEMIN, NUM_NAME); #if WANT_FIXED_SIZE_TABLES showUse("Class", classHw-CLASSMIN, NUM_CLASSES); showUse("Inst", instHw-INSTMIN, NUM_INSTS); #else showUse("Class", classHw-CLASSMIN, dynTabClass->maxIdx); showUse("Inst", instHw-INSTMIN, dynTabInst->maxIdx); #endif #if TREX showUse("Ext", extHw-EXTMIN, NUM_EXT); #endif #endif scripts[scriptHw].file = findText( f ? f : "" ); scripts[scriptHw].textHw = textHw; scripts[scriptHw].nextNewText = nextNewText; scripts[scriptHw].nextNewDText = nextNewDText; scripts[scriptHw].addrHw = addrHw; scripts[scriptHw].moduleHw = moduleHw; scripts[scriptHw].tyconHw = tyconHw; scripts[scriptHw].nameHw = nameHw; scripts[scriptHw].classHw = classHw; scripts[scriptHw].instHw = instHw; #if TREX scripts[scriptHw].extHw = extHw; #endif scripts[scriptHw].prims = NULL; return scriptHw++; } Bool isPreludeScript() { /* Test whether this is the Prelude*/ return (scriptHw==0); } Bool moduleThisScript(m) /* Test if given module is defined */ Module m; { /* in current script file */ return scriptHw<1 || m>=scripts[scriptHw-1].moduleHw; } Module lastModule() { /* Return module in current script file */ return (moduleHw>MODMIN ? moduleHw-1 : modulePrelude); } #define scriptThis(nm,t,tag) \ Script nm(x) \ t x; { \ Script s=0; \ while (s=scripts[s].tag) \ s++; \ return s; \ } scriptThis(scriptThisName,Name,nameHw) scriptThis(scriptThisTycon,Tycon,tyconHw) scriptThis(scriptThisInst,Inst,instHw) scriptThis(scriptThisClass,Class,classHw) #undef scriptThis Module moduleOfScript(s) Script s; { return (s==0) ? modulePrelude : scripts[s-1].moduleHw; } String fileOfModule(m) Module m; { Script s; if (m == modulePrelude) { return findMPathname(STD_PRELUDE_HUGS); } for(s=0; s= 0 && sno < scriptHw) { /* is there anything to restore? */ int i; textHw = scripts[sno].textHw; nextNewText = scripts[sno].nextNewText; nextNewDText = scripts[sno].nextNewDText; moduleHw = scripts[sno].moduleHw; addrHw = scripts[sno].addrHw; tyconHw = scripts[sno].tyconHw; nameHw = scripts[sno].nameHw; classHw = scripts[sno].classHw; instHw = scripts[sno].instHw; #if TREX extHw = scripts[sno].extHw; #endif for (i=0; i=BCSTAG) { STACK_CHECK return markSnd(c); } else { return c; } } static Cell local markSnd(c) /* Variant of markCell used to */ Cell c; { /* update snd component of cell */ Cell t; /* using tail recursion */ Cell orig; orig = c; ma: t = c; /* Keep pointer to original pair */ c = snd(c); mb: if (!isPair(c)) return orig; switch (fst(c)) { case INDIRECT : snd(t) = c = indirectChain(c); goto mb; #if GC_WEAKPTRS case WEAKCELL : { register int place = placeInSet(c); register int mask = maskInSet(c); if (!(marks[place]&mask)) { marks[place] |= mask; marks[placeInSet(snd(c))] |= maskInSet(snd(c)); nextWeakPtr(c) = weakPtrs; weakPtrs = c; recordMark(); } return orig; } #endif } { register int place = placeInSet(c); register int mask = maskInSet(c); if (marks[place]&mask) return orig; else { marks[place] |= mask; recordMark(); } } if (isGenPair(fst(c))) { fst(c) = markCell(fst(c)); goto ma; } else if (isNull(fst(c)) || fst(c)>=BCSTAG) goto ma; return orig; } static Cell local indirectChain(c) /* Scan chain of indirections */ Cell c; { /* Detecting loops of indirections */ Cell is = c; /* Uses pointer reversal ... */ c = snd(is); snd(is) = NIL; fst(is) = INDIRECT1; while (isPair(c) && fst(c)==INDIRECT) { register Cell temp = snd(c); snd(c) = is; is = c; c = temp; fst(is) = INDIRECT1; } if (isPair(c) && fst(c)==INDIRECT1) c = nameBlackHole; do { register Cell temp = snd(is); fst(is) = INDIRECT; snd(is) = c; is = temp; } while (nonNull(is)); return c; } Void markWithoutMove(n) /* Garbage collect cell at n, as if*/ Cell n; { /* it was a cell ref, but don't */ /* move cell (i.e. retain INDIRECT */ /* at top level) so we don't have */ /* to modify the stored value of n */ if (isGenPair(n)) { recordStackRoot(); if (fst(n)==INDIRECT) { /* special case for indirections */ register int place = placeInSet(n); register int mask = maskInSet(n); marks[place] |= mask; recordMark(); markSnd(n); } else markCell(n); /* normal pairs don't move anyway */ } } static Bool local isMarked(c) Cell c; { if (isGenPair(c)) { Int place = placeInSet(c); Int mask = maskInSet(c); return (marks[place]&mask)!=0; } else { return TRUE; } } Void garbageCollect() { /* Run garbage collector ... */ Bool breakStat = breakOn(FALSE); /* disable break checking */ Int i,j; register Int mask; register Int place; Int recovered; jmp_buf regs; /* save registers on stack */ setjmp(regs); gcStarted(); for (i=0; i= 0; i--) { /* release any unused mallocptrs */ if (isPair(mallocPtrs[i].mpcell)) { register int place = placeInSet(mallocPtrs[i].mpcell); register int mask = maskInSet(mallocPtrs[i].mpcell); if ((marks[place]&mask)==0) incMallocPtrRefCnt(i,-1); } } #endif /* GC_MALLOCPTRS */ #ifdef DOTNET markDotNetPtrs(marks); #endif /* DOTNET */ #if GC_WEAKPTRS /* After GC completes, we scan the list of weak pointers that are * still live and zap their contents unless the contents are still * live (by some other means). * Note that this means the contents must itself be heap allocated. * This means it can't be a nullary constructor or an Int or a Name * or lots of other things - hope this doesn't bite too hard. */ for (; nonNull(weakPtrs); weakPtrs=nextWeakPtr(weakPtrs)) { Cell ptr = derefWeakPtr(weakPtrs); if (isGenPair(ptr)) { Int place = placeInSet(ptr); Int mask = maskInSet(ptr); if ((marks[place]&mask)==0) { /* printf("Zapping weak pointer %d\n", ptr); */ derefWeakPtr(weakPtrs) = NIL; } else { /* printf("Keeping weak pointer %d\n", ptr); */ } } else if (nonNull(ptr)) { printf("Weak ptr contains object which isn't heap allocated %d\n", ptr); } } if (nonNull(liveWeakPtrs) || nonNull(finalizers)) { Bool anyMarked; /* Weak pointers with finalizers */ List wps; List newFins = NIL; /* Step 1: iterate until we've found out what is reachable */ do { anyMarked = FALSE; for (wps=liveWeakPtrs; nonNull(wps); wps=tl(wps)) { Cell wp = hd(wps); Cell k = fst(snd(wp)); if (isNull(k)) { internal("bad weak ptr"); } if (isMarked(k)) { Cell vf = snd(snd(wp)); if (!isMarked(fst(vf)) || !isMarked(snd(vf))) { mark(fst(vf)); mark(snd(vf)); anyMarked = TRUE; } } } } while (anyMarked); /* Step 2: Now we know which weak pointers will die, so we can */ /* remove them from the live set and gather their finalizers. But */ /* note that we mustn't mark *anything* at this stage or we will */ /* corrupt our view of what's alive, and what's dead. */ wps = NIL; while (nonNull(liveWeakPtrs)) { Cell wp = hd(liveWeakPtrs); List nx = tl(liveWeakPtrs); Cell k = fst(snd(wp)); if (!isMarked(k)) { /* If the key is dead, then*/ Cell vf = snd(snd(wp)); /* stomp on weak pointer */ if (nonNull(snd(vf))) { fst(vf) = snd(vf); snd(vf) = newFins; newFins = vf; /* reuse because we can't */ } /* reallocate here ... */ fst(snd(wp)) = NIL; snd(snd(wp)) = NIL; snd(wp) = NIL; liveWeakPtrs = nx; } else { tl(liveWeakPtrs) = wps; /* Otherwise, weak pointer */ wps = liveWeakPtrs;/* survives to face another*/ liveWeakPtrs = nx; /* garbage collection */ } } liveWeakPtrs = wps; /* Step 3: Now we've identified the live cells and the newly */ /* scheduled finalizers, but we had better make sure that they are */ /* all marked now, including any internal structure, to ensure that*/ /* they make it to the other side of gc. */ for (; nonNull(wps); wps=tl(wps)) { mark(snd(hd(wps))); } mark(liveWeakPtrs); mark(newFins); finalizers = revOnto(newFins,finalizers); } #endif /* GC_WEAKPTRS */ gcScanning(); /* scan mark set */ mask = 1; place = 0; recovered = 0; j = 0; #if PROFILING if (profile) { sysCount = 0; for (i=NAMEMIN; i0) fprintf(profile," SYSTEM %d\n",sysCount); */ /* Accumulate costs in top level objects */ for (i=NAMEMIN; i0) if (isPair(name(i).parent)) { Pair p = name(i).parent; Cell f = fst(p); fprintf(profile," "); if (isClass(f)) fprintf(profile,"%s",textToStr(cclass(f).text)); else { fprintf(profile,"%s_",textToStr(cclass(inst(f).c).text)); /* Will hp2ps accept the spaces produced by this? */ printPred(profile,inst(f).head); } fprintf(profile,"_%s %d\n", textToStr(name(snd(p)).text), name(i).count); } else { fprintf(profile," %s %d\n", textToStr(name(i).text), name(i).count); } fprintf(profile,"END_SAMPLE %ld.00\n",numReductions); } #endif /* can only return if freeList is nonempty on return. */ if (recovered=INTMIN) return INTCELL; if (c>=NAMEMIN) if (c>=CLASSMIN) if (c>=CHARMIN) return CHARCELL; else return CLASS; else if (c>=INSTMIN) return INSTANCE; else return NAME; else if (c>=MODMIN) if (c>=TYCMIN) return TYCON; else return MODULE; else if (c>=OFFMIN) return OFFSET; #if TREX else return (c>=EXTMIN) ? EXT : TUPLE; #else else return TUPLE; #endif /* if (isPair(c)) { register Cell fstc = fst(c); return isTag(fstc) ? fstc : AP; } if (c>=INTMIN) return INTCELL; if (c>=CHARMIN) return CHARCELL; if (c>=CLASSMIN) return CLASS; if (c>=INSTMIN) return INSTANCE; if (c>=NAMEMIN) return NAME; if (c>=TYCMIN) return TYCON; if (c>=MODMIN) return MODULE; if (c>=OFFMIN) return OFFSET; #if TREX if (c>=EXTMIN) return EXT; #endif if (c>=TUPMIN) return TUPLE; return c;*/ } #endif #if DEBUG_PRINTER /* A very, very simple printer. * Output is uglier than from printExp - but the printer is more * robust and can be used on any data structure irrespective of * its type. */ Void printList Args((List, Int)); Void print Args((Cell, Int)); Void print(c, depth) Cell c; Int depth; { if (0 == depth) { Printf("..."); #if 0 /* Not in this version of Hugs */ } else if (isPair(c) && !isGenPair(c)) { extern Void printEvalCell Args((Cell, Int)); printEvalCell(c,depth); #endif } else { Int tag = whatIs(c); switch (tag) { case AP : Putchar('('); print(fst(c), depth-1); Putchar(','); print(snd(c), depth-1); Putchar(')'); break; case FREECELL : Printf("free(%d)", c); break; case INTCELL : Printf("int(%d)", intOf(c)); break; case FLOATCELL : Printf("float(%f)", floatOf(c)); break; case DOUBLECELL : Printf("double(%f)", doubleOf(c)); break; case CHARCELL : Printf("char('%c')", charOf(c)); break; case CLASS : Printf("class(%d)", c-CLASSMIN); if (CLASSMIN <= c && c < classHw) Printf("=\"%s\"", textToStr(cclass(c).text)); break; case INSTANCE : Printf("instance(%d)", c - INSTMIN); break; case NAME : Printf("name(%d)", c-NAMEMIN); if (NAMEMIN <= c && c < nameHw) Printf("=\"%s\"", textToStr(name(c).text)); break; case TYCON : Printf("tycon(%d)", c-TYCMIN); if (TYCMIN <= c && c < tyconHw) Printf("=\"%s\"", textToStr(tycon(c).text)); break; case MODULE : Printf("module(%d)", c - MODMIN); break; case OFFSET : Printf("Offset %d", offsetOf(c)); break; case TUPLE : Printf("Tuple %d", tupleOf(c)); break; case NIL : Printf("NIL"); break; case DOTDOT : Printf("DOTDOT"); break; case DICTVAR : Printf("{dict %d}",textOf(c)); break; case VARIDCELL : case VAROPCELL : case CONIDCELL : case CONOPCELL : Printf("{id %s}",textToStr(textOf(c))); break; #if IPARAM case IPCELL : Printf("{ip %s}",textToStr(textOf(c))); break; case IPVAR : Printf("?%s",textToStr(textOf(c))); break; #endif case QUALIDENT : Printf("{qid %s.%s}",textToStr(qmodOf(c)),textToStr(qtextOf(c))); break; case LETREC: Printf("LetRec("); print(fst(snd(c)),depth-1); Putchar(','); print(snd(snd(c)),depth-1); Putchar(')'); break; #if OBSERVATIONS case INDIRECT: Printf("->"); print(snd(c),depth); break; case OBSERVE: Printf("{==>"); print(snd3(c),depth); Putchar('|'); Printf("cell = %d=(", thd3(c)); Printf("next= %d,", nextObs(thd3(c))); Printf("seq= %d,", intOf(seqObs(thd3(c)))); Printf("expr= %d)}", exprObs(thd3(c))); break; case OBSERVESTK: Printf("{=STK=>{"); Printf("cell = %d=(", thd3(c)); Printf("next= %d,", nextObs(thd3(c))); Printf("seq= %d,", intOf(seqObs(thd3(c)))); Printf("expr= %d)}", exprObs(thd3(c))); break; #endif case BIGLAM: Printf("BigLam("); printList(fst(snd(c)),depth-1); Putchar(','); print(snd(snd(c)),depth-1); Putchar(')'); break; case ESIGN: Printf("ESign("); print(fst(snd(c)),depth-1); Putchar(','); print(snd(snd(c)),depth-1); Putchar(')'); break; case COMP: Printf("COMP("); print(fst(snd(c)),depth-1); Putchar(','); print(snd(snd(c)),depth-1); Putchar(')'); break; case FROMQUAL: Printf("FROMQUAL("); print(fst(snd(c)),depth-1); Putchar(','); print(snd(snd(c)),depth-1); Putchar(')'); break; default : if (isBoxTag(tag)) { Printf("Tag(%d)=%d", c, tag); } else if (isConTag(tag)) { Printf("%d@(%d,",c,tag); print(snd(c), depth-1); Putchar(')'); break; } else if (c == tag) { Printf("Tag(%d)", c); } else { Printf("Tag(%d)=%d", c, tag); } break; } } FlushStdout(); } Void printList(l, depth) List l; Int depth; { Int tag; Cell n; Putchar('['); if ((tag = whatIs(l)) != NIL) for (; ; l=n) { if (tag == AP) { print(fst(l), depth-1); n = snd(l); tag = whatIs(n); if (tag == NIL) break; Putchar(','); } else { Printf("NotAList!\n"); break; } } Putchar(']'); } #endif Bool isVar(c) /* is cell a VARIDCELL/VAROPCELL ? */ Cell c; { /* also recognises DICTVAR cells */ return isPair(c) && (fst(c)==VARIDCELL || fst(c)==VAROPCELL || fst(c)==DICTVAR); } Bool isCon(c) /* is cell a CONIDCELL/CONOPCELL ? */ Cell c; { return isPair(c) && (fst(c)==CONIDCELL || fst(c)==CONOPCELL); } Bool isQVar(c) /* is cell a [un]qualified varop/id? */ Cell c; { if (!isPair(c)) return FALSE; switch (fst(c)) { case VARIDCELL : case VAROPCELL : return TRUE; case QUALIDENT : return isVar(snd(snd(c))); default : return FALSE; } } Bool isQCon(c) /*is cell a [un]qualified conop/id? */ Cell c; { if (!isPair(c)) return FALSE; switch (fst(c)) { case CONIDCELL : case CONOPCELL : return TRUE; case QUALIDENT : return isCon(snd(snd(c))); default : return FALSE; } } Bool isQualIdent(c) /* is cell a qualified identifier? */ Cell c; { return isPair(c) && (fst(c)==QUALIDENT); } Bool isIdent(c) /* is cell an identifier? */ Cell c; { if (!isPair(c)) return FALSE; switch (fst(c)) { case VARIDCELL : case VAROPCELL : case CONIDCELL : case CONOPCELL : return TRUE; case QUALIDENT : return TRUE; default : return FALSE; } } Bool isInt(c) /* cell holds integer value? */ Cell c; { return isSmall(c) || (isPair(c) && fst(c)==INTCELL); } Int intOf(c) /* find integer value of cell? */ Cell c; { return isPair(c) ? (Int)(snd(c)) : (Int)(c-INTZERO); } Cell mkInt(n) /* make cell representing integer */ Int n; { return (MINSMALLINT <= n && n <= MAXSMALLINT) ? INTZERO+n : pair(INTCELL,n); } #if UNICODE_CHARS /* -------------------------------------------------------------------------- * Unicode Characters: NUM_SHORT_CHARS is the number of one-cell characters. * Like integers, the constructor, the selector, and the predicate * are defined as external functions implemented in storage.c * For characters with value less than NUM_SHORT_CHARS, one cell will be * allocated. For greater character values, a pair of cells will be * allocated. The pair of cells will have CHARCELL as fst, and * the UNICODE value of the character as snd. * ------------------------------------------------------------------------*/ Bool isChar(c) /* cell holds character value? */ Cell c; { return isShortChar(c) || (isPair(c) && fst(c)==CHARCELL); } Char charOf(c) /* find character value of cell? */ Cell c; { return isPair(c) ? (Char)(snd(c)) : (Char)(c-CHARMIN); } Cell mkChar(c) /* make cell representing character */ Char c; { return (0 <= c && c < NUM_SHORT_CHARS) ? CHARMIN+c : pair(CHARCELL,c); } #endif /* UNICODE_CHARS */ #if BIGNUMS Bool isBignum(c) /* cell holds bignum value? */ Cell c; { return c==ZERONUM || (isPair(c) && (fst(c)==POSNUM || fst(c)==NEGNUM)); } #endif #if SIZEOF_INTP == SIZEOF_INT typedef union {Int i; Pointer p;} IntOrPointer; Cell mkPtr(p) Pointer p; { IntOrPointer x; x.p = p; return pair(PTRCELL,x.i); } Pointer ptrOf(c) Cell c; { IntOrPointer x; assert(fst(c) == PTRCELL); x.i = snd(c); return x.p; } #elif SIZEOF_INTP == 2*SIZEOF_INT typedef union {struct {Int i1; Int i2;} i; Pointer p;} IntOrPointer; Cell mkPtr(p) Pointer p; { IntOrPointer x; x.p = p; return pair(PTRCELL,pair(mkInt(x.i.i1),mkInt(x.i.i2))); } Pointer ptrOf(c) Cell c; { IntOrPointer x; assert(fst(c) == PTRCELL); x.i.i1 = intOf(fst(snd(c))); x.i.i2 = intOf(snd(snd(c))); return x.p; } #else #warning "type Ptr not supported on this architecture - don't use it" Cell mkPtr(p) Pointer p; { ERRMSG(0) "mkPtr: type Ptr not supported on this architecture" EEND; } Pointer ptrOf(c) Cell c; { ERRMSG(0) "ptrOf: type Ptr not supported on this architecture" EEND; } #endif /* -------------------------------------------------------------------------- * List operations: * ------------------------------------------------------------------------*/ Int length(xs) /* calculate length of list xs */ List xs; { Int n = 0; for (; nonNull(xs); ++n) xs = tl(xs); return n; } List appendOnto(xs,ys) /* Destructively prepend xs onto */ List xs, ys; { /* ys by modifying xs ... */ if (isNull(xs)) return ys; else { List zs = xs; while (nonNull(tl(zs))) zs = tl(zs); tl(zs) = ys; return xs; } } List dupOnto(xs,ys) /* non-destructively prepend xs backwards onto ys */ List xs; List ys; { for (; nonNull(xs); xs=tl(xs)) ys = cons(hd(xs),ys); return ys; } List dupList(xs) /* Duplicate spine of list xs */ List xs; { List ys = NIL; for (; nonNull(xs); xs=tl(xs)) ys = cons(hd(xs),ys); return rev(ys); } List dupUpto(xs,c) /* Duplicate spine of list xs */ List xs; Cell c; { List ys = NIL; for (; nonNull(xs) && hd(xs) != c; xs=tl(xs)) ys = cons(hd(xs),ys); return rev(ys); } List revOnto(xs,ys) /* Destructively reverse elements of*/ List xs, ys; { /* list xs onto list ys... */ Cell zs; while (nonNull(xs)) { zs = tl(xs); tl(xs) = ys; ys = xs; xs = zs; } return ys; } #if 0 List delete(xs,y) /* Delete first use of y from xs */ List xs; Cell y; { if (isNull(xs)) { return xs; } else if (hs(xs) == y) { return tl(xs); } else { tl(xs) = delete(tl(xs),y); return xs; } } List minus(xs,ys) /* Delete members of ys from xs */ List xs, ys; { mapAccum(delete,xs,ys); return xs; } #endif List concat(xss) List xss; { List xs = NIL; for (; nonNull(xss); xss=tl(xss)) xs = dupOnto(hd(xss),xs); return xs; } List intersect(xs,ys) List xs, ys; { List zs = NIL; for (;nonNull(xs);xs=tl(xs)) { if (varIsMember(textOf(hd(xs)),ys)) zs = cons(hd(xs),zs); } return zs; } Cell varIsMember(t,xs) /* Test if variable is a member of */ Text t; /* given list of variables */ List xs; { for (; nonNull(xs); xs=tl(xs)) if (t==textOf(hd(xs))) return hd(xs); return NIL; } Name nameIsMember(t,ns) /* Test if name with text t is a */ Text t; /* member of list of names xs */ List ns; { for (; nonNull(ns); ns=tl(ns)) { if (t==name(hd(ns)).text) { return hd(ns); } } return NIL; } /* Locating entities in import/export lists */ Name nameInIEList(nm,ns) /* Test if Name is a member of */ Name nm; /* of import/export list xs. */ List ns; { Text t = name(nm).text; Bool isMethod = isClass(name(nm).parent); Bool isDCon = isTycon(name(nm).parent) && !findTycon(name(nm).text); for (; nonNull(ns); ns=tl(ns)) { if (isName(hd(ns)) && t==name(hd(ns)).text) { return hd(ns); } if ( (isMethod && isPair(hd(ns)) && isClass(fst(hd(ns)))) || (isDCon && isPair(hd(ns)) && isTycon(fst(hd(ns))) && (tycon(fst(hd(ns))).what != SYNONYM) && (tycon(fst(hd(ns))).what != RESTRICTSYN)) ) { Name r; List subs = snd(hd(ns)); if (subs == DOTDOT) { if (isClass(fst(hd(ns)))) { subs = cclass(fst(hd(ns))).members; } else if (isTycon(fst(hd(ns)))) { subs = tycon(fst(hd(ns))).defn; } } r = nameInIEList(nm,subs); if (r) return r; } } return NIL; } Tycon tyconInIEList(t,ns) /* Test if Tycon with text t is a */ Text t; /* member of import/export list xs */ List ns; { for (; nonNull(ns); ns=tl(ns)) { if (isTycon(hd(ns)) && t==tycon(hd(ns)).text) { return hd(ns); } else if (isPair(hd(ns)) && isTycon(fst(hd(ns))) && t == tycon(fst(hd(ns))).text) { return fst(hd(ns)); } } return NIL; } Class classInIEList(t,ns) /* Test if Class with text t is a */ Text t; /* member of import/export list xs */ List ns; { for (; nonNull(ns); ns=tl(ns)) { if (isClass(hd(ns)) && t==cclass(hd(ns)).text) { return hd(ns); } if (isPair(hd(ns)) && isClass(fst(hd(ns))) && t == cclass(fst(hd(ns))).text) { return fst(hd(ns)); } } return NIL; } List nubList(ls) /* (non-destructively) remove duplicates from list */ List ls; { List res = NIL; while (nonNull(ls)) { if (!cellIsMember(hd(ls),res)) { res = cons(hd(ls),res); } ls = tl(ls); } return res; } Cell intIsMember(n,xs) /* Test if integer n is member of */ Int n; /* given list of integers */ List xs; { for (; nonNull(xs); xs=tl(xs)) if (n==intOf(hd(xs))) return hd(xs); return NIL; } Cell cellIsMember(x,xs) /* Test for membership of specific */ Cell x; /* cell x in list xs */ List xs; { for (; nonNull(xs); xs=tl(xs)) if (x==hd(xs)) return hd(xs); return NIL; } Cell cellAssoc(c,xs) /* Lookup cell in association list */ Cell c; List xs; { for (; nonNull(xs); xs=tl(xs)) if (c==fst(hd(xs))) return hd(xs); return NIL; } Cell cellRevAssoc(c,xs) /* Lookup cell in range of */ Cell c; /* association lists */ List xs; { for (; nonNull(xs); xs=tl(xs)) if (c==snd(hd(xs))) return hd(xs); return NIL; } List replicate(n,x) /* create list of n copies of x */ Int n; Cell x; { List xs=NIL; while (00; --n) { xs = tl(xs); } return xs; } Cell nth(n,xs) /* extract n'th element of list */ Int n; List xs; { for(; n>0 && nonNull(xs); --n, xs=tl(xs)) { } if (isNull(xs)) internal("nth"); return hd(xs); } List removeCell(x,xs) /* destructively remove cell from */ Cell x; /* list */ List xs; { if (nonNull(xs)) { if (hd(xs)==x) return tl(xs); /* element at front of list */ else { List prev = xs; List curr = tl(xs); for (; nonNull(curr); prev=curr, curr=tl(prev)) if (hd(curr)==x) { tl(prev) = tl(curr); return xs; /* element in middle of list */ } } } return xs; /* here if element not found */ } /* -------------------------------------------------------------------------- * Operations on applications: * ------------------------------------------------------------------------*/ Int argCount; /* number of args in application */ Cell getHead(e) /* get head cell of application */ Cell e; { /* set number of args in argCount */ for (argCount=0; isAp(e); e=fun(e)) argCount++; return e; } List getArgs(e) /* get list of arguments in function*/ Cell e; { /* application: */ List as; /* getArgs(f e1 .. en) = [e1,..,en] */ for (as=NIL; isAp(e); e=fun(e)) as = cons(arg(e),as); return as; } Cell nthArg(n,e) /* return nth arg in application */ Int n; /* of function to m args (m>=n) */ Cell e; { /* nthArg n (f x0 x1 ... xm) = xn */ for (n=numArgs(e)-n-1; n>0; n--) e = fun(e); return arg(e); } Int numArgs(e) /* find number of arguments to expr */ Cell e; { Int n; for (n=0; isAp(e); e=fun(e)) n++; return n; } Cell applyToArgs(f,args) /* destructively apply list of args */ Cell f; /* to function f */ List args; { while (nonNull(args)) { Cell temp = tl(args); tl(args) = hd(args); hd(args) = f; f = args; args = temp; } return f; } /* -------------------------------------------------------------------------- * Handle table - declared here for the GC to access. * ------------------------------------------------------------------------*/ #if IO_HANDLES #if WANT_FIXED_SIZE_TABLES struct strHandle DEFTABLE(handles,NUM_HANDLES); #else DynTable* dynTabHandles = NULL; struct strHandle *handles; unsigned long num_handles = 0; #endif /* -------------------------------------------------------------------------- * Freeing a handle. * ------------------------------------------------------------------------*/ static Void local freeHandle(n) /* release handle storage when no */ Int n; { /* heap references to it remain */ #if WANT_FIXED_SIZE_TABLES if (0<=n && n<(Int)NUM_HANDLES && nonNull(handles[n].hcell)) { #else if (0<=n && n<(Int)num_handles && nonNull(handles[n].hcell)) { #endif if (n>HSTDERR && handles[n].hmode!=HCLOSED && handles[n].hfp) { fclose(handles[n].hfp); handles[n].hfp = 0; } fst(handles[n].hcell) = snd(handles[n].hcell) = NIL; handles[n].hcell = NIL; } } #endif #if GC_MALLOCPTRS /* -------------------------------------------------------------------------- * Malloc Ptrs: * ------------------------------------------------------------------------*/ struct strMallocPtr mallocPtrs[NUM_MALLOCPTRS]; /* Points to the next available slot in 'mallocPtrs'. */ int mallocPtr_hw; /* It might GC (because it uses a table not a list) which will trash any * unstable pointers. * (It happens that we never use it with unstable pointers.) */ Cell newMallocPtr(ptr) /* create a new malloc pointer */ Pointer ptr; { Int i; for (i=0; i=NUM_MALLOCPTRS) { /* If at first we don't */ garbageCollect(); /* succeed, garbage collect*/ for (i=0; i=NUM_MALLOCPTRS) { /* ... before we give up */ ERRMSG(0) "Too many ForeignPtrs open" EEND; } mallocPtrs[i].ptr = ptr; mallocPtrs[i].finalizers = NIL; mallocPtrs[i].refCount = 1; /* adjust the high-water mark for the table. */ if (i >= mallocPtr_hw) { mallocPtr_hw = i + 1; } return (mallocPtrs[i].mpcell = ap(MPCELL,i)); } Cell mkMallocPtr(ptr,cleanup) /* create a new malloc pointer */ Pointer ptr; CFinalizer cleanup; { Cell mp; Int i; mp = newMallocPtr(ptr); i = mpOf(mp); mallocPtrs[i].finalizers = cons(mkPtr((Pointer)cleanup), mallocPtrs[i].finalizers); return mp; } Void incMallocPtrRefCnt(n,i) /* change ref count of MallocPtr */ Int n; Int i; { if (!(0<=n && n 0)) internal("freeMallocPtr"); mallocPtrs[n].refCount += i; if (mallocPtrs[n].refCount <= 0) { Cell p; for (p=mallocPtrs[n].finalizers; nonNull(p); p=tl(p)) { Cell fin = hd(p); if (isPtr(fin)) ((CFinalizer)ptrOf(fin))(mallocPtrs[n].ptr); else ((CFinalizerEnv)ptrOf(fst(fin))) (ptrOf(snd(fin)), mallocPtrs[n].ptr); } mallocPtrs[n].ptr = 0; mallocPtrs[n].finalizers = NIL; mallocPtrs[n].refCount = 0; mallocPtrs[n].mpcell = NIL; /* Freed the slot next to the high-water mark; adjust the marker. */ if ((n+1) == mallocPtr_hw) { do { --mallocPtr_hw; } while (mallocPtr_hw>0 && isNull(mallocPtrs[mallocPtr_hw-1].mpcell)); } } } #endif /* GC_MALLOCPTRS */ /* -------------------------------------------------------------------------- * Stable pointers * This is a mechanism that allows the C world to manipulate pointers into the * Haskell heap without having to worry that the garbage collector is going * to delete it or move it around. * The implementation and interface is based on my implementation in * GHC - but, at least for now, is simplified by using a fixed size * table of stable pointers. * ------------------------------------------------------------------------*/ #if GC_STABLEPTRS /* Each entry in the stable pointer table is either a heap pointer * or is not currently allocated. * Unallocated entries are threaded together into a freelist. * The last entry in the list contains the Cell 0; all other values * contain a Cell whose value is the next free stable ptr in the list. * It follows that stable pointers are strictly positive (>0). */ static Cell stablePtrTable[NUM_STABLEPTRS]; static Int sptFreeList; #define SPT(sp) stablePtrTable[(sp)-1] static Void local resetStablePtrs() { Int i; /* It would be easier to build the free list in the other direction * but, when debugging, it's way easier to understand if the first * pointer allocated is "1". */ for(i=1; i < NUM_STABLEPTRS; ++i) SPT(i) = i+1; SPT(NUM_STABLEPTRS) = 0; sptFreeList = 1; } Int mkStablePtr(c) /* Create a stable pointer */ Cell c; { Int i = sptFreeList; if (i == 0) return 0; sptFreeList = SPT(i); SPT(i) = c; return i; } Cell derefStablePtr(p) /* Dereference a stable pointer */ Int p; { if (!(1 <= p && p <= NUM_STABLEPTRS)) { internal("derefStablePtr"); } return SPT(p); } Void freeStablePtr(i) /* Free a stable pointer */ Int i; { SPT(i) = sptFreeList; sptFreeList = i; } #undef SPT #endif /* GC_STABLEPTRS */ /* -------------------------------------------------------------------------- * storage control: * ------------------------------------------------------------------------*/ #if DYN_TABLES static void far* safeFarCalloc Args((Int,Int)); static void far* safeFarCalloc(n,s) /* allocate table storage and check*/ Int n, s; { /* for non-null return */ void far* tab = farCalloc(n,s); if (tab==0) { ERRMSG(0) "Cannot allocate run-time tables" EEND; } return tab; } #define TABALLOC(v,t,n) v=(t far*)safeFarCalloc(n,sizeof(t)); #define TABFREE(v) free(v) #else #define TABALLOC(v,t,n) #define TABFREE(v) #endif DynTable* allocDynTable(eltSize, maxIdx, hWater, tabName) unsigned long eltSize; unsigned long maxIdx; unsigned long hWater; const char* tabName; { DynTable *tab = (DynTable*)malloc(sizeof(struct strDynTable)); if ( tab != NULL ) { tab->maxIdx = maxIdx; tab->hWater = hWater; tab->tabName = tabName; tab->eltSize = eltSize; tab->data = (void*)malloc(eltSize * maxIdx); } if (tab == NULL || tab->data == NULL) { ERRMSG(0) "Cannot allocate dynamic table \"%s\"", tabName EEND; } return tab; } void freeDynTable(tab) DynTable* tab; { if (tab) { free(tab->data); free(tab); } return; } void growDynTable(tab) DynTable* tab; { unsigned long newSize; void* newData; if ( tab == NULL ) { ERRMSG(0) "growDynTable: null table" EEND; } /* Are we already at the limit? */ if ( tab->hWater != 0 && tab->maxIdx == tab->hWater ) { ERRMSG(0) "growDynTable: unable to grow table \"%s\" further (reached limit: %d)", tab->tabName, tab->hWater EEND; } /* Growing currently means doubling. */ newSize = 2*tab->maxIdx; /* don't grow beyond hWater */ if (tab->hWater != 0 && tab->hWater < newSize) { newSize = tab->hWater; } else if ( newSize == 0 ) { newSize = 1; } #if 0 fprintf(stderr, "growing \"%s\" from %d to %d elements\n", tab->tabName, tab->maxIdx, newSize); fflush(stderr); #endif newData = (void*)realloc(tab->data, newSize*tab->eltSize); if ( newData == NULL ) { ERRMSG(0) "growDynTable: unable to grow table \"%s\" (limit: %d)", tab->tabName, tab->hWater EEND; } else { tab->maxIdx = newSize; tab->data = newData; } } Void controlFuns(what) Int what; { Int i; struct primInfoDef *info_def = firstPrimInfo; for(; 0 != info_def; info_def=info_def->nextPrimInfoDef) { if (info_def->p_info->controlFun) { (*(info_def->p_info->controlFun))(what); } } if (EXIT == what) { struct primInfoDef *ptr, *tmp; /* Release all primitive DLLs */ i = 0; while (i < scriptHw) { if (scripts[i].prims) { freePrimInfo(scripts[i].prims); scripts[i].prims = 0; } i++; } ptr = firstPrimInfo; while (ptr) { tmp = ptr->nextPrimInfoDef; free(ptr); ptr = tmp; } #if !WANT_FIXED_SIZE_TABLES if (dynTabScripts) freeDynTable(dynTabScripts); #endif } } Void storage(what) Int what; { Int i; switch (what) { case RESET : clearStack(); /* the next 2 statements are particularly important * if you are using GLOBALfst or GLOBALsnd since the * corresponding registers may be reset to their * uninitialised initial values by a longjump. */ heapTopFst = heapFst + heapSize; heapTopSnd = heapSnd + heapSize; #if PROFILING heapTopThd = heapThd + heapSize; if (profile) { garbageCollect(); fclose(profile); #if HAVE_HP2PS system("hp2ps profile.hp"); #endif profile = 0; } #endif #if IO_HANDLES handles[HSTDIN].hmode = HREAD; handles[HSTDIN].hbufMode = HUNKNOWN_BUFFERING; handles[HSTDOUT].hmode = HAPPEND; handles[HSTDOUT].hbufMode = HUNKNOWN_BUFFERING; handles[HSTDERR].hmode = HAPPEND; handles[HSTDERR].hbufMode = HUNKNOWN_BUFFERING; #if CHAR_ENCODING handles[HSTDIN].hLookAhead = -1; handles[HSTDIN].hBinaryMode = FALSE; handles[HSTDOUT].hBinaryMode = FALSE; handles[HSTDERR].hBinaryMode = FALSE; #endif /* CHAR_ENCODING */ #endif /* IO_HANDLES */ #ifdef DOTNET zeroDotNetTable(); #endif #if !HSCRIPT #if GC_STABLEPTRS resetStablePtrs(); #endif #endif consGC = TRUE; lsave = NIL; rsave = NIL; if (isNull(lastExprSaved)) savedText = NUM_TEXT; break; case MARK : start(); for (i=NAMEMIN; idata); dynTabClass = allocDynTable(sizeof(struct strClass),10,NUM_CLASSES,"class"); tabClass = (struct strClass*)(dynTabClass->data); dynTabInst = allocDynTable(sizeof(struct strInst),50,NUM_INSTS,"instance"); tabInst = (struct strInst*)(dynTabInst->data); dynTabHandles = allocDynTable(sizeof(struct strHandle),4, 0, "handles"); handles = (struct strHandle*)(dynTabHandles->data); num_handles = dynTabHandles->maxIdx; #endif TABALLOC(text, char, NUM_TEXT) TABALLOC(tyconHash, Tycon, TYCONHSZ) TABALLOC(tabTycon, struct strTycon, NUM_TYCON) TABALLOC(nameHash, Name, NAMEHSZ) TABALLOC(tabName, struct strName, NUM_NAME) TABALLOC(tabClass, struct strClass, NUM_CLASSES) TABALLOC(cellStack, Cell, NUM_STACK) TABALLOC(tabModule, struct strModule, NUM_MODULE) #if TREX TABALLOC(tabExt, Text, NUM_EXT) #endif #if OBSERVATIONS TABALLOC(tabObserve,struct strObserve, NUM_OBS_TAGS) TABALLOC(tabBreakpt,struct strBreakpt, NUM_BRKPTS) #endif clearStack(); #if IO_HANDLES TABALLOC(handles, struct strHandle, NUM_HANDLES) #if WANT_FIXED_SIZE_TABLES for (i=0; i<(Int)NUM_HANDLES; i++) #else for (i=0; i<(Int)num_handles; i++) #endif handles[i].hcell = NIL; handles[HSTDIN].hcell = ap(HANDCELL,HSTDIN); handles[HSTDIN].hfp = stdin; handles[HSTDOUT].hcell = ap(HANDCELL,HSTDOUT); handles[HSTDOUT].hfp = stdout; handles[HSTDERR].hcell = ap(HANDCELL,HSTDERR); handles[HSTDERR].hfp = stderr; #endif textHw = 0; nextNewText = NUM_TEXT; nextNewDText = (-1); lastExprSaved = NIL; savedText = NUM_TEXT; for (i=0; i>2) #define mkSyntax(a,p) ((a)|((p)<<2)) #define DEF_OPSYNTAX mkSyntax(DEF_ASS,DEF_PREC) #define NO_SYNTAX ((Syntax)(-1)) #define FFI_NOSAFETY 0 #define FFI_SAFE 1 #define FFI_UNSAFE 2 #define FFI_THREADSAFE 4 /* Note: cconv flags are combined with the above safety flags, * so need to be disjoint. */ #define FFI_CCONV_UNKNOWN 0 #define FFI_CCONV_CCALL 8 #define FFI_CCONV_STDCALL 16 #define FFI_CCONV_DOTNET 32 #define FFI_TYPE_UNIT 0 #define FFI_TYPE_CHAR 1 #define FFI_TYPE_INT 2 #define FFI_TYPE_INT8 3 #define FFI_TYPE_INT16 4 #define FFI_TYPE_INT32 5 #define FFI_TYPE_INT64 6 #define FFI_TYPE_WORD8 7 #define FFI_TYPE_WORD16 8 #define FFI_TYPE_WORD32 9 #define FFI_TYPE_WORD64 10 #define FFI_TYPE_FLOAT 11 #define FFI_TYPE_DOUBLE 12 #define FFI_TYPE_BOOL 13 #define FFI_TYPE_ADDR 14 #define FFI_TYPE_PTR 15 #define FFI_TYPE_FUNPTR 16 #define FFI_TYPE_FOREIGN 17 #define FFI_TYPE_STABLE 18 #ifdef DOTNET #define FFI_TYPE_OBJECT 19 #define FFI_TYPE_STRING 20 #endif #ifdef DOTNET #define FFI_DOTNET_STATIC 1 #define FFI_DOTNET_FIELD 2 #define FFI_DOTNET_CTOR 4 #define FFI_DOTNET_METHOD 8 #endif /* -------------------------------------------------------------------------- * Primitive functions: * ------------------------------------------------------------------------*/ struct primitive { /* entry in table of primitives */ String ref; /* primitive reference string */ Int arity; /* primitive function arity */ Prim imp; /* primitive implementation */ }; /* Modules that define new primitive functions must register a control * function (defining INSTALL, RESET, etc code) and a (null-terminated) * table of primitive functions. * * They are stored as a linked list - so there's no wired in limits. * Control functions are called in the order they are registered * after all other control functions have been called. * (At the moment) there's no way of unregistering a module. */ struct primInfo { Void (*controlFun) Args((Int)); struct primitive *primFuns; struct primInfo *nextPrimInfo; }; extern Void registerPrims Args((struct primInfo*)); extern Void controlFuns Args((Int)); /* Call all control functions in */ /* prim list. */ extern struct primInfoDef* setPrimInfoDll Args((void*)); /* -------------------------------------------------------------------------- * Program code storage: for holding compiled function defns etc... * ------------------------------------------------------------------------*/ extern Addr getMem Args((Int)); extern Void nextInstr Args((Addr)); /* -------------------------------------------------------------------------- * Heap storage: * Provides a garbage collectable heap for storage of expressions etc. * ------------------------------------------------------------------------*/ #define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell))) #define heapBuilt() (heapFst) extern Int heapSize; extern Heap heapFst, heapSnd; #ifdef GLOBALfst register Heap heapTopFst GLOBALfst; #else extern Heap heapTopFst; #endif #ifdef GLOBALsnd register Heap heapTopSnd GLOBALsnd; #else extern Heap heapTopSnd; #endif extern Bool consGC; /* Set to FALSE to turn off gc from*/ /* C stack; use with extreme care! */ extern Int cellsRecovered; /* cells recovered by last gc */ #define fst(c) heapTopFst[c] #define snd(c) heapTopSnd[c] #if PROFILING extern Heap heapThd, heapTopThd; #define thd(c) heapTopThd[c] extern Name producer; extern Bool profiling; extern Int profInterval; extern Void profilerLog Args((String)); #endif extern Pair pair Args((Cell,Cell)); extern Void garbageCollect Args((Void)); extern Void overwrite Args((Pair,Pair)); extern Cell markExpr Args((Cell)); extern Void markWithoutMove Args((Cell)); #define mark(v) v=markExpr(v) #define isPair(c) ((c)<0) #define isGenPair(c) ((c)<0 && -heapSize<=(c)) #if FAST_WHATIS #define whatIs(c) (isPair(c)? (isTag(fst(c)) ? fst(c) : AP ) : whatCode[c]) extern unsigned char whatCode[]; #else extern Cell whatIs Args((Cell)); #endif /* -------------------------------------------------------------------------- * Box cell tags are used as the fst element of a pair to indicate that * the snd element of the pair is to be treated in some special way, other * than as a Cell. Examples include holding integer values, variable name * and string text etc. * ------------------------------------------------------------------------*/ #define TAGMIN 1 /* Box and constructor cell tag values */ #define BCSTAG 30 /* Box=TAGMIN..BCSTAG-1 */ #define isTag(c) (TAGMIN<=(c) && (c)data))[idx]) extern DynTable* allocDynTable Args((unsigned long,unsigned long,unsigned long,const char*)); extern void freeDynTable Args((DynTable*)); extern void growDynTable Args((DynTable*)); /* -------------------------------------------------------------------------- * Constructor cell tags are used as the fst element of a pair to indicate * a particular syntactic construct described by the snd element of the * pair. * Note that a cell c will not be treated as an application (AP/isAp) node * if its first element is a constructor cell tag, whereas a cell whose fst * element is a special cell will be treated as an application node. * ------------------------------------------------------------------------*/ #define LETREC 30 /* LETREC snd :: ([Decl],Exp) */ #define COND 31 /* COND snd :: (Exp,Exp,Exp) */ #define LAMBDA 32 /* LAMBDA snd :: Alt */ #define FINLIST 33 /* FINLIST snd :: [Exp] */ #define DOCOMP 34 /* DOCOMP snd :: (Exp,[Qual]) */ #if MUDO #define MDOCOMP 44 /* MDOCOMP snd :: (Exp,[Qual]) */ #endif #define BANG 35 /* BANG snd :: Type */ #define COMP 36 /* COMP snd :: (Exp,[Qual]) */ #define ASPAT 37 /* ASPAT snd :: (Var,Exp) */ #define ESIGN 38 /* ESIGN snd :: (Exp,Type) */ #define RSIGN 39 /* RSIGN snd :: (Rhs,Type) */ #define CASE 40 /* CASE snd :: (Exp,[Alt]) */ #define NUMCASE 41 /* NUMCASE snd :: (Exp,Disc,Rhs) */ #define FATBAR 42 /* FATBAR snd :: (Exp,Exp) */ #define LAZYPAT 43 /* LAZYPAT snd :: Exp */ #define DERIVE 45 /* DERIVE snd :: Cell */ #if BREAK_FLOATS #define FLOATCELL 46 /* FLOATCELL snd :: (Int,Int) */ #endif #if BIGNUMS #define POSNUM 47 /* POSNUM snd :: [Int] */ #define NEGNUM 48 /* NEGNUM snd :: [Int] */ #endif #define BOOLQUAL 49 /* BOOLQUAL snd :: Exp */ #define QWHERE 50 /* QWHERE snd :: [Decl] */ #define FROMQUAL 51 /* FROMQUAL snd :: (Exp,Exp) */ #define DOQUAL 52 /* DOQUAL snd :: Exp */ #define MONADCOMP 53 /* MONADCOMP snd :: ((m,m0),(Exp,[Qual])*/ #define GUARDED 54 /* GUARDED snd :: [guarded exprs] */ #define ARRAY 55 /* Array snd :: (Bounds,[Values]) */ #define MUTVAR 56 /* Mutvar snd :: Cell */ #define HUGSOBJECT 57 /* HUGSOBJECT snd :: Cell */ #if STABLE_NAMES #define STABLENAME 58 /* Stable Nm snd :: Cell */ #endif #if IPARAM #define WITHEXP 59 /* WITH snd :: [(Var,Exp)] */ #endif #define POLYTYPE 60 /* POLYTYPE snd :: (Kind,Type) */ #define QUAL 61 /* QUAL snd :: ([Classes],Type) */ #define RANK2 62 /* RANK2 snd :: (Int,Type) */ #define EXIST 63 /* EXIST snd :: (Int,Type) */ #define POLYREC 64 /* POLYREC snd :: (Int,Type) */ #define BIGLAM 65 /* BIGLAM snd :: (vars,patterns) */ #define CDICTS 66 /* CDICTS snd :: ([Pred],Type) */ #define LABC 70 /* LABC snd :: (con,[(Vars,Type)]) */ #define CONFLDS 71 /* CONFLDS snd :: (con,[Field]) */ #define UPDFLDS 72 /* UPDFLDS snd :: (Exp,[con],[Field]) */ #if TREX #define RECORD 73 /* RECORD snd :: [Val] */ #define EXTCASE 74 /* EXTCASE snd :: (Exp,Disc,Rhs) */ #define RECSEL 75 /* RECSEL snd :: Ext */ #endif #define IMPDEPS 78 /* IMPDEPS snd :: [Binding] */ #define QUALIDENT 80 /* Qualified identifier snd :: (Id,Id) */ #define HIDDEN 81 /* hiding import list snd :: [Entity] */ #define MODULEENT 82 /* module in export list snd :: con */ #if OBSERVATIONS #define OBSERVEHEAD 83 /* obs. list; snd ::(first,last) */ #define OBSERVE 84 /* observe marker; snd :: (Cell,observe) */ #define OBSERVESTK 85 /* observe marker on stack */ #endif #define INFIX 90 /* INFIX snd :: (see tidyInfix) */ #define ONLY 91 /* ONLY snd :: Exp */ #define NEG 92 /* NEG snd :: Exp */ #if ZIP_COMP #define ZCOMP 93 /* ZCOMP snd :: (Exp,[[Qual]]) */ #endif #define DOUBLECELL 97 /* DOUBLECELL snd :: (Int,Int) */ #define I64CELL 98 /* Int/Word64 snd :: (Int,Int) */ #if SIZEOF_INTP != SIZEOF_INT #define PTRCELL 99 /* C Heap Pointer snd :: (Int,Int) */ #endif /* Last constructor tag must be less than SPECMIN */ /* -------------------------------------------------------------------------- * Special cell values: * ------------------------------------------------------------------------*/ #if FAST_WHATIS1 #define SPECMIN 129 /* must be out of TAG_MASK range */ #define NONE 129 /* Dummy stub */ #define STAR 130 /* Representing the kind of types */ #if TREX #define ROW 131 /* Representing the kind of rows */ #endif #define WILDCARD 132 /* Wildcard pattern */ #define SKOLEM 133 /* Skolem constant */ #define DOTDOT 134 /* ".." in import/export list */ #if BIGNUMS #define ZERONUM 136 /* The zero bignum (see POSNUM, NEGNUM) */ #endif #define NAME 138 /* whatIs code for isName */ #define TYCON 139 /* whatIs code for isTycon */ #define CLASS 140 /* whatIs code for isClass */ #define MODULE 141 /* whatIs code for isModule */ #define INSTANCE 142 /* whatIs code for isInst */ #define TUPLE 143 /* whatIs code for tuple constructor */ #define OFFSET 144 /* whatis code for offset */ #define AP 145 /* whatIs code for application node */ #if TREX #define EXT 147 /* whatIs code for isExt */ #endif #define SIGDECL 148 /* Signature declaration */ #define FIXDECL 149 /* Fixity declaration */ #define FUNBIND 150 /* Function binding */ #define PATBIND 151 /* Pattern binding */ #define DATATYPE 158 /* Datatype type constructor */ #define NEWTYPE 159 /* Newtype type constructor */ #define SYNONYM 160 /* Synonym type constructor */ #define RESTRICTSYN 161 /* Synonym with restricted scope */ #define NODEPENDS 163 /* Stop calculation of deps in type check*/ #define PREDEFINED 164 /* Predefined name, not yet filled */ #else /* !FAST_WHATIS1 */ #define SPECMIN 101 #define isSpec(c) (SPECMIN<=(c) && (c)=1 * EXECNAME = code for executable name (bytecodes or primitive) * SELNAME = code for selector function * DFUNNAME = code for dictionary builder or selector * cfunNo(i) = code for data constructor * datatypes with only one constructor uses cfunNo(0) * datatypes with multiple constructors use cfunNo(n), n>=1 */ #define EXECNAME 0 #define SELNAME 1 #define DFUNNAME 2 #define CFUNNAME 3 #define isSfun(n) (name(n).number==SELNAME) #define isDfun(n) (name(n).number==DFUNNAME) #define isCfun(n) (name(n).number>=CFUNNAME) #define cfunOf(n) (name(n).number-CFUNNAME) #define cfunNo(i) ((i)+CFUNNAME) #define hasCfun(cs) (nonNull(cs) && isCfun(hd(cs))) #define isMfun(n) (name(n).number<0) #define mfunOf(n) ((-1)-name(n).number) #define mfunNo(i) ((-1)-(i)) extern Name newName Args((Text,Cell)); extern Name findName Args((Text)); extern Name addName Args((Name)); extern Void removeName Args((Name)); extern Name findQualName Args((Cell)); extern List findQualNames Args((Cell)); extern Name findQualFun Args((Text,Text)); extern Void addPrim Args((Int,Name,String,Module,Type)); extern Name addPrimCfun Args((Text,Int,Int,Cell)); extern Int sfunPos Args((Name,Name)); extern Bool setOldDLLFlag Args((Bool)); /* -------------------------------------------------------------------------- * Type class values: * ------------------------------------------------------------------------*/ #define INSTMIN (NAMEMIN+NUM_NAME) /* instances */ #define isInst(c) (INSTMIN<=(c) && (c)(c))) extern Bool isChar Args((Cell)); extern Int charOf Args((Cell)); extern Cell mkChar Args((Int)); #else /* !UNICODE_CHARS */ #define isChar(c) (CHARMIN<=(c) && (c)=NUM_STACK-(n)) hugsStackOverflow() #define push(c) \ do { \ chkStack(1); \ onto(c); \ } while (0) #define onto(c) stack(++sp)=(c) #define pop() stack(sp--) #define drop() sp-- #define top() stack(sp) #define pushed(n) stack(sp-(n)) #define topfun(f) top()=ap((f),top()) #define toparg(x) top()=ap(top(),(x)) extern Void hugsStackOverflow Args((Void)); #if __MWERKS__ && macintosh #include #define STACK_HEADROOM 16384 #define STACK_CHECK if (StackSpace() <= STACK_HEADROOM) \ internal("Macintosh function parameter stack overflow."); #else #define STACK_CHECK #endif /* -------------------------------------------------------------------------- * Script file control: * The implementation of script file storage is hidden. * ------------------------------------------------------------------------*/ extern Script startNewScript Args((String)); extern Bool moduleThisScript Args((Module)); extern Module moduleOfScript Args((Script)); extern Bool isPreludeScript Args((Void)); extern Module lastModule Args((Void)); extern Script scriptThisFile Args((Text)); extern Script scriptThisName Args((Name)); extern Script scriptThisTycon Args((Tycon)); extern Script scriptThisInst Args((Inst)); extern Script scriptThisClass Args((Class)); extern String fileOfModule Args((Module)); extern Void dropAScript Args((Script)); extern Void dropScriptsFrom Args((Script)); extern Void setScriptPrims Args((void*)); /* -------------------------------------------------------------------------- * I/O Handles: * ------------------------------------------------------------------------*/ #if IO_HANDLES #define HSTDIN 0 /* Numbers for standard handles */ #define HSTDOUT 1 #define HSTDERR 2 #define IS_STANDARD_HANDLE(h) ((h) <= 2) struct strHandle { /* Handle description and status flags */ Cell hcell; /* Heap representation of handle (or NIL) */ FILE *hfp; /* Corresponding file pointer */ Int hmode; /* Current mode: see below */ Int hbufMode; /* Buffering mode. */ Int hbufSize; /* < 0 => not yet known. */ Int hRWState; /* State of a READWRITE handle (see below) */ #if CHAR_ENCODING Bool hBinaryMode; /* TRUE => Handle opened in binary mode */ Char hLookAhead; /* Char read by hLookAhead (or <0 if none) */ /* This is only used in text mode. */ #endif }; #define HCLOSED 0000 /* no I/O permitted */ #define HSEMICLOSED 0001 /* semiclosed reads only */ #define HREAD 0002 /* set to enable reads from handle */ #define HWRITE 0004 /* set to enable writes to handle */ #define HAPPEND 0010 /* opened in append mode */ #define HREADWRITE 0020 /* set to enable both reading and writing */ #define HUNKNOWN_BUFFERING (-1) /* the buffering mode of a handle is lazily determined. */ #define HANDLE_NOTBUFFERED 1 #define HANDLE_LINEBUFFERED 2 #define HANDLE_BLOCKBUFFERED 3 #define RW_NEUTRAL 0 /* r/w stream was just opened/at EOF/seeked */ #define RW_READING 1 /* last operation on r/w stream was reading */ #define RW_WRITING 2 /* last operation on r/w stream was writing */ #define NO_HANDLE (-1) #if !WANT_FIXED_SIZE_TABLES extern unsigned long num_handles; extern DynTable* dynTabHandles; extern struct strHandle* handles; #else extern struct strHandle DECTABLE(handles); #endif #endif /* -------------------------------------------------------------------------- * Malloc Pointers * ------------------------------------------------------------------------*/ #if GC_MALLOCPTRS struct strMallocPtr { /* Malloc Ptr description */ Cell mpcell; /* Back pointer to MPCELL */ Void *ptr; /* Pointer into C world */ Int refCount; /* Reference count */ Cell finalizers; /* List of finalizer functions */ /* or (finalizer, envptr) pairs */ }; typedef Void (*CFinalizer) Args((Pointer)); typedef Void (*CFinalizerEnv) Args((Pointer, Pointer)); extern struct strMallocPtr mallocPtrs[]; extern Cell newMallocPtr Args((Void *)); extern Cell mkMallocPtr Args((Void *, CFinalizer)); extern Void freeMallocPtr Args((Cell)); extern Void incMallocPtrRefCnt Args((Int, Int)); extern Int mallocPtr_hw; #define mpOf(c) snd(c) #define derefMP(c) (mallocPtrs[(Int)mpOf(c)].ptr) #endif /* GC_MALLOCPTRS */ #if GC_WEAKPTRS /* -------------------------------------------------------------------------- * Weak Pointers * ------------------------------------------------------------------------*/ #define mkWeakPtr(c) pair(WEAKCELL,pair(c,NIL)) #define derefWeakPtr(c) fst(snd(c)) #define nextWeakPtr(c) snd(snd(c)) extern List finalizers; extern List liveWeakPtrs; #endif /* GC_WEAKPTRS */ /* -------------------------------------------------------------------------- * Foreign Function Interface * ------------------------------------------------------------------------*/ #include "HsFFI.h" extern Int part1Int64 Args((HsInt64)); extern Int part2Int64 Args((HsInt64)); extern HsInt64 int64FromParts Args((Int,Int)); /* -------------------------------------------------------------------------- * Stable pointers * ------------------------------------------------------------------------*/ #if GC_STABLEPTRS extern Int mkStablePtr Args((Cell)); extern Cell derefStablePtr Args((Int)); extern Void freeStablePtr Args((Int)); #endif /* -------------------------------------------------------------------------- * Misc: * ------------------------------------------------------------------------*/ extern Void setLastExpr Args((Cell)); extern Cell getLastExpr Args((Void)); extern List addTyconsMatching Args((String,List)); extern List addNamesMatching Args((String,List)); /*-------------------------------------------------------------------------*/ #if FAST_WHATIS1 /* whatIs1 is faster than whatIs, but it will return NIL if fst(c) is NIL * Used with care in the right places it gains us speed. */ #define isTag1(c) (((c) & TAG_MASK) == 0) /* doesn't exclude NIL */ #define whatIs1(c) (isPair(c)? (isTag1(fst(c))? fst(c) : AP ) : whatCode[c]) #define isAp1(c) (isPair(c) && !isTag1(fst(c))) #endif #endif /* __STORAGE_H__ */ hugs98-plus-Sep2006/src/strutil.c0000644006511100651110000001402110234722530015420 0ustar rossross/* * String utilities needed throughout the Hugs codebase. */ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "strutil.h" #include "char.h" /* -------------------------------------------------------------------------- * String manipulation routines: * ------------------------------------------------------------------------*/ String strCopy(s) /* make malloced copy of a string */ String s; { if (s) { char *t; if ((t=(char *)malloc(strlen(s)+1))==0) { ERRMSG(0) "String storage space exhausted" EEND; } strcpy(t, s); return t; } return NULL; } String strnCopy(s,n) /* make malloced copy of a substring */ String s; Int n; { if (s) { char *t; if ((Int)strlen(s) < n) n = strlen(s); if ((t=(char *)malloc(n+1))==0) { ERRMSG(0) "String storage space exhausted" EEND; } strncpy(t, s, n); t[n] = '\0'; return t; } return NULL; } /* Given a string containing a possibly qualified name, * split it up into a module and a name portion. */ Void splitQualString(nm, pMod, pName) String nm; String* pMod; String* pName; { String dot; /* Find the last occurrence of '.' preceded by an identifier */ dot = nm + strlen(nm) - 1; while (dot != nm && !(*dot == '.' && isIn(dot[-1],IDAFTER))) dot--; if (dot == nm) { *pMod = NULL; *pName = nm; } else { /* The module portion consists of everything upto the last dot. */ *pMod = strnCopy(nm, dot - nm); /* Everything after the last '.' is the name string */ *pName = dot+1; } } /* Cheap&cheerful expandable strings / StringBuilders. * * Note: I'm willfully breaking the convention of using K&R style * function declarations here. Their time has come and gone. */ struct StringBuilder { unsigned int len; unsigned int size; char* buf; }; #define INITIAL_BUILDER_SIZE 200 static Bool expandStringBuilder Args((StringBuilder* b, unsigned int newSz)); /* * Function: newStringBuilder(sz) * * Allocate a new StringBuilder object, giving its * initial buffer size 'sz'. If sz == 0, the initial size * is set to INITIAL_BUILDER_SIZE.. * */ StringBuilder* newStringBuilder ( unsigned int sz ) { StringBuilder* b = (StringBuilder*)malloc(sizeof(StringBuilder)); if (!b) return NULL; b->size = ( sz == 0 ? INITIAL_BUILDER_SIZE : sz); b->len = 0; b->buf = (char*)malloc(sizeof(char)*b->size); if (!b->buf) { free(b); return NULL; } *(b->buf) = '\0'; return b; } /* * Function: expandStringBuilder(builder, newSz) * * Internal function for expanding a StringBuilder's internal * buffer to 'newSz'. Along with expansion the old contents of * the buffer is copied over. * * Returns TRUE if successful. */ static Bool expandStringBuilder(StringBuilder* b, unsigned int newSz) { char* buf; if (!b) return FALSE; if (b->size > newSz) return FALSE; buf = realloc(b->buf, newSz); if (!buf) return FALSE; b->size = newSz; b->buf = buf; return TRUE; } /* * Function: prependString(builder, str) * * The preferred usage mode for StringBuilders is to * concatenate stuff at the back, but prependString() * handles addition at the other end. * * Returns TRUE if successful. */ Bool prependString(StringBuilder* b, char* str) { unsigned int len, newLen; if (!b) return FALSE; if (!str) return TRUE; len = strlen(str); newLen = b->len + len; if (len==0) return TRUE; if ( newLen >= b->size ) { unsigned int newSz = b->size*2; if ( newSz < newLen ) { newSz = newLen; } if ( !expandStringBuilder(b, newSz) ) { return FALSE; } } /* shift the buffer down to make room for 'str' */ memcpy(b->buf+len, b->buf, b->len+1); memcpy(b->buf, str, len-1); b->len = newLen; return TRUE; } /* * Function: appendString(builder, str) * * Append 'str' to the back of 'builder', expanding its * buffer to accommodate the added string, if needs be. * * Returns TRUE if successful. */ Bool appendString(StringBuilder* b, char* str) { unsigned int len, newLen; if (!b) return FALSE; if (!str) return TRUE; len = strlen(str); newLen = b->len + len; if (len==0) return TRUE; if ( newLen >= b->size ) { unsigned int newSz = b->size*2; if ( newSz < newLen ) { newSz = newLen; } if ( !expandStringBuilder(b, newSz) ) { return FALSE; } } memcpy(b->buf+b->len,str,len+1); b->len = newLen; return TRUE; } /* * Function: appendStringFormat(builder, fmt, arg) * * This function provides an extremely limited form of * sprintf()-style format strings, allowing the substitution * of 'arg' zero or more times via the format string 'fmt': * * appendStringFormat(builder, "-P%s -Y%s", "foo"); * * is equivalent to * * appendString(builder, "-Pfoo -Yfoo"); * * Returns TRUE if successful. */ Bool appendStringFormat(StringBuilder* b, char* fmt, char* arg) { char* prev = fmt; char* ptr = fmt; char tmp; if (!b) return FALSE; while ( (ptr = strchr(ptr, '%')) ) { /* Append verbatim text from the format string */ tmp = *ptr; *ptr = '\0'; appendString(b, prev); *ptr = tmp; if ( ptr[1] != '%' ) { /* Not an escaped occurrence of '%' */ switch (ptr[1]) { case 's': appendString(b, arg); ptr += 2; break; default: fprintf(stderr,"Unsupported format specifier, %%%c; ignoring", ptr[1]); ptr += 2; break; } } else { if (ptr[1] != '\0') { ptr += 2; } } prev = ptr; } appendString(b,prev); return TRUE; } /* * Function: toString(builder) * * Returns a pointer to the builder's internal buffer, i.e., * a copy is not made (=> the caller isn't passed the * responsibility of freeing the returned string.) * * */ char* toString(StringBuilder* b) { if (!b) return NULL; return (b->buf); } /* * Function: freeStringBuilder(builder) * * Free up a StringBuilder object. */ void freeStringBuilder(StringBuilder* b) { if (!b) return; if (b->buf) free(b->buf); b->buf = NULL; free(b); } hugs98-plus-Sep2006/src/strutil.h0000644006511100651110000000447707762001166015452 0ustar rossross/* * String utilities needed throughout the Hugs codebase. */ #ifndef __STRUTIL_H__ #define __STRUTIL_H__ /* string copy operator, allocates new via malloc() */ extern String strCopy Args((String)); /* substring copy operator, allocates new via malloc() */ extern String strnCopy Args((String, Int)); /* Given a string containing a possibly qualified name, * split it up into a module and a name portion. */ extern Void splitQualString Args((String, String*, String*)); /* * Auto-expandable string builder objects: */ typedef struct StringBuilder StringBuilder; /* * Function: newStringBuilder(sz) * * Allocate a new StringBuilder object, giving its * initial buffer size 'sz'. If sz == 0, the initial size * is set to INITIAL_BUILDER_SIZE.. * */ extern StringBuilder* newStringBuilder Args((unsigned int sz)); /* * Function: freeStringBuilder(builder) * * Free up a StringBuilder object. */ extern void freeStringBuilder Args((StringBuilder* b)); /* * Function: prependString(builder, str) * * The preferred usage mode for StringBuilders is to * concatenate stuff at the back, but prependString() * handles addition at the other end. * * Returns TRUE if successful. */ extern Bool prependString Args((StringBuilder* b, char* str)); /* * Function: appendString(builder, str) * * Append 'str' to the back of 'builder', expanding its * buffer to accommodate the added string, if needs be. * * Returns TRUE if successful. */ extern Bool appendString Args((StringBuilder* b, char* str)); /* * Function: appendStringFormat(builder, fmt, arg) * * This function provides an extremely limited form of * sprintf()-style format strings, allowing the substitution * of 'arg' zero or more times via the format string 'fmt': * * appendStringFormat(builder, "-P%s -Y%s", "foo"); * * is equivalent to * * appendString(builder, "-Pfoo -Yfoo"); * * Returns TRUE if successful. */ extern Bool appendStringFormat Args((StringBuilder* b, char* fmt, char* arg)); /* * Function: toString(builder) * * Returns a pointer to the builder's internal buffer, i.e., * a copy is not made (=> the caller isn't passed the * responsibility of freeing the returned string.) * * */ extern char* toString Args((StringBuilder* b)); #endif /* __STRUTIL_H__ */ hugs98-plus-Sep2006/src/subst.c0000644006511100651110000015415610141436050015064 0ustar rossross/* -------------------------------------------------------------------------- * Provides an implementation for the `current substitution' used during * type and kind inference in both static analysis and type checking. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: subst.c,v $ * $Revision: 1.30 $ * $Date: 2004/11/01 13:37:44 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "output.h" #include "opts.h" #include "subst.h" static Int numTyvars; /* no. type vars currently in use */ static Int maxTyvars = 0; static Int nextGeneric; /* number of generics found so far */ #if FIXED_SUBST Tyvar tyvars[NUM_TYVARS]; /* storage for type variables */ #else Tyvar *tyvars = 0; /* storage for type variables */ #endif Int typeOff; /* offset of result type */ Type typeIs; /* skeleton of result type */ Int typeFree; /* freedom in instantiated type */ List predsAre; /* list of predicates in type */ List genericVars; /* list of generic vars */ List btyvars = NIL; /* explicitly scoped type vars */ /* -------------------------------------------------------------------------- * local function prototypes: * ------------------------------------------------------------------------*/ static Void local expandSubst Args((Int)); static Int local findBtyvsInt Args((Text)); static Type local makeTupleType Args((Int)); static Kind local makeSimpleKind Args((Int)); static Kind local makeVarKind Args((Int)); static Void local expandSyn1 Args((Tycon, Type *, Int *)); static List local listTyvar Args((Int,List)); static List local listTyvars Args((Type,Int,List)); static Cell local dupTyvar Args((Int,List)); static Cell local dupTyvars Args((Cell,Int,List)); static Pair local copyNoMark Args((Cell,Int)); static Type local dropRank1Body Args((Type,Int,Int)); static Type local liftRank1Body Args((Type,Int)); static Bool local matchTypeAbove Args((Type,Int,Type,Int,Int)); static Bool local varToVarBind Args((Tyvar *,Tyvar *)); static Bool local varToTypeBind Args((Tyvar *,Type,Int)); #if TREX static Bool local inserter Args((Type,Int,Type,Int)); static Int local remover Args((Text,Type,Int)); static Int local tailVar Args((Type,Int)); #endif #if TREX || IO_MONAD static Void local expandSynFully Args((Type *, Int *)); #endif static Bool local improveAgainst Args((Int,List,Cell,Int)); static Bool local instImprove Args((Int,Class,Cell,Int)); static Bool local pairImprove Args((Int,Class,Cell,Int,Cell,Int,Int)); #if IPARAM static Bool local ipImprove Args((Int,Cell,Int,Cell,Int)); #endif static Bool local kvarToVarBind Args((Tyvar *,Tyvar *)); static Bool local kvarToTypeBind Args((Tyvar *,Type,Int)); /* -------------------------------------------------------------------------- * The substitution, types, and kinds: * * In early versions of Gofer, the `substitution' data structure was only * used by the type checker, so it made sense to include support for it in * type.c. This changed when kinds and kind inference where introduced, * which required access to the substitution during static analysis. The * links between type.c and static.c that were intially used to accomplish * this have now been avoided by making the substitution visible as an * independent data structure in storage.c. * * In the same way that values have types, type constructors (and more * generally, expressions built from such constructors) have kinds. * The syntax of kinds in the current implementation is very simple: * * kind ::= STAR -- the kind of types * | kind => kind -- constructors * | variables -- either INTCELL or OFFSET * * For various reasons, this implementation uses structure sharing, instead * of a copying approach. In principal, this is fast and avoids the need to * build new type expressions. Unfortunately, this implementation will not * be able to handle *very* large expressions. * * The substitution is represented by an array of type variables each of * which is a triple: * bound a (skeletal) type expression, or NIL if the variable * is not bound, or SKOLEM for a Skolem constant (i.e., an * uninstantiable variable). * offs offset of skeleton in bound. If isNull(bound), then offs is * used to indicate whether that variable is generic (i.e. free * in the current assumption set) or fixed (i.e. bound in the * current assumption set). Generic variables are assigned * offset numbers whilst copying type expressions (t,o) to * obtain their most general form. * kind kind of value bound to type variable (`type variable' is * rather inaccurate -- `constructor variable' would be better). * ------------------------------------------------------------------------*/ Void emptySubstitution() { /* clear current substitution */ numTyvars = 0; #if !FIXED_SUBST /* If the table has grown larger than NUM_TYVARS, free 'tyvars'. * If not, keep it around as it's bound to get used again. */ if (maxTyvars > NUM_TYVARS) { maxTyvars = 0; if (tyvars) { free(tyvars); tyvars = 0; } } #endif nextGeneric = 0; genericVars = NIL; typeIs = NIL; predsAre = NIL; btyvars = NIL; } static Void local expandSubst(n) /* add further n type variables to */ Int n; { /* current substituion */ #if FIXED_SUBST if (numTyvars+n>NUM_TYVARS) { ERRMSG(0) "Too many type variables in type checker" EEND; } #else if (numTyvars+n>maxTyvars) { /* need to expand substitution */ Int newMax = maxTyvars+NUM_TYVARS; Tyvar *newTvs; Int i; if (numTyvars+n>newMax) { /* safety precaution */ ERRMSG(0) "Substitution expanding too quickly" EEND; } /* It would be better to realloc() here, but that isn't portable * enough for calloc()ed arrays. The following code could cause * a space leak if an interrupt occurs while we're copying the * array ... we won't worry about this for the time being because * we don't expect to have to go through this process much (if at * all) in normal use of the type checker. */ newTvs = (Tyvar *)calloc(newMax,sizeof(Tyvar)); if (!newTvs) { ERRMSG(0) "Too many variables (%d) in type checker", newMax EEND; } for (i=0; i0; n--) { tyvars[numTyvars-n].offs = UNUSED_GENERIC; tyvars[numTyvars-n].bound = NIL; tyvars[numTyvars-n].kind = STAR; #if DEBUG_TYPES Printf("new type variable: _%d ::: ",numTyvars-n); printKind(stdout,tyvars[numTyvars-n].kind); Putchar('\n'); #endif } return beta; } Int newKindedVars(k) /* allocate new variables with */ Kind k; { /* specified kinds */ Int beta = numTyvars; /* if k = k0 -> k1 -> ... -> kn */ for (; isPair(k); k=snd(k)) { /* then allocate n vars with kinds */ expandSubst(1); /* k0, k1, ..., k(n-1) */ tyvars[numTyvars].offs = UNUSED_GENERIC; tyvars[numTyvars].bound = NIL; tyvars[numTyvars].kind = fst(k); #if DEBUG_TYPES Printf("new type variable: _%d ::: ",numTyvars); printKind(stdout,tyvars[numTyvars].kind); Putchar('\n'); #endif numTyvars++; } return beta; } Void instantiate(type) /* instantiate type, if nonNull */ Type type; { predsAre = NIL; typeIs = type; typeFree = 0; if (nonNull(typeIs)) { /* instantiate type expression ? */ if (isPolyType(typeIs)) { /* Polymorphic type scheme ? */ Kinds ks = polySigOf(typeIs); typeOff = newKindedVars(ks); typeIs = monotypeOf(typeIs); for (; isAp(ks); ks=arg(ks)) typeFree++; } if (isQualType(typeIs)) { /* Qualified type? */ predsAre = fst(snd(typeIs)); typeIs = snd(snd(typeIs)); } } } /* -------------------------------------------------------------------------- * Bound type variables: * ------------------------------------------------------------------------*/ Pair findBtyvs(t) /* Look for bound tyvar */ Text t; { List bts = btyvars; for (; nonNull(bts); bts=tl(bts)) { List bts1 = hd(bts); for (; nonNull(bts1); bts1=tl(bts1)) if (t==textOf(fst(hd(bts1)))) return hd(bts1); } return NIL; } static Int local findBtyvsInt(t) /* Look for bound type variable */ Text t; { /* expecting to find an integer */ Pair p = findBtyvs(t); if (isNull(p)) internal("findBtyvsInt"); return intOf(snd(p)); } Void markBtyvs() { /* Mark explicitly scoped vars */ List bts = btyvars; for (; nonNull(bts); bts=tl(bts)) { List bts1 = hd(bts); for (; nonNull(bts1); bts1=tl(bts1)) markTyvar(intOf(snd(hd(bts1)))); } } Type localizeBtyvs(t) /* Localize type to eliminate refs */ Type t; { /* to explicitly scoped vars */ switch (whatIs(t)) { case RANK2 : case POLYTYPE : snd(snd(t)) = localizeBtyvs(snd(snd(t))); break; case QUAL : fst(snd(t)) = localizeBtyvs(fst(snd(t))); snd(snd(t)) = localizeBtyvs(snd(snd(t))); break; case AP : fst(t) = localizeBtyvs(fst(t)); snd(t) = localizeBtyvs(snd(t)); break; case VARIDCELL: case VAROPCELL: return mkInt(findBtyvsInt(textOf(t))); } return t; } /* -------------------------------------------------------------------------- * Dereference or bind types in subsitution: * ------------------------------------------------------------------------*/ Tyvar *getTypeVar(t,o) /* get number of type variable */ Type t; /* represented by (t,o) [if any]. */ Int o; { #if FAST_WHATIS1 switch (whatIs1(t)) { #else switch (whatIs(t)) { #endif case INTCELL : return tyvar(intOf(t)); case OFFSET : return tyvar(o+offsetOf(t)); case VARIDCELL : case VAROPCELL : return tyvar(findBtyvsInt(textOf(t))); } return ((Tyvar *)0); } Void tyvarType(vn) /* load type held in type variable */ Int vn; { /* vn into (typeIs,typeOff) */ Tyvar *tyv; while ((tyv=tyvar(vn)), isBound(tyv)) switch(whatIs(tyv->bound)) { case INTCELL : vn = intOf(tyv->bound); break; case OFFSET : vn = offsetOf(tyv->bound)+(tyv->offs); break; case VARIDCELL : case VAROPCELL : vn = findBtyvsInt(textOf(tyv->bound)); break; default : typeIs = tyv->bound; typeOff = tyv->offs; return; } typeIs = aVar; typeOff = vn; } Void bindTv(vn,t,o) /* set type variable vn to (t,o) */ Int vn; Type t; Int o; { Tyvar *tyv = tyvar(vn); tyv->bound = t; tyv->offs = o; #if DEBUG_TYPES Printf("binding type variable: _%d to ",vn); printType(stdout,debugType(t,o)); Putchar('\n'); #endif } Cell getDerefHead(t,o) /* get value at head of type exp. */ Type t; Int o; { Tyvar *tyv; argCount = 0; for (;;) { while (isAp(t)) { argCount++; t = fun(t); } if ((tyv=getTypeVar(t,o)) && isBound(tyv)) { t = tyv->bound; o = tyv->offs; } else break; } return t; } /* -------------------------------------------------------------------------- * Expand type synonyms: * ------------------------------------------------------------------------*/ Void expandSyn(h,ar,at,ao) /* Expand type synonym with: */ Tycon h; /* head h */ Int ar; /* ar args (NB. ar>=tycon(h).arity)*/ Type *at; /* original expression (*at,*ao) */ Int *ao; { /* expansion returned in (*at,*ao) */ ar -= tycon(h).arity; /* calculate surplus arguments */ if (ar==0) expandSyn1(h,at,ao); else { /* if there are more args than the */ Type t = *at; /* arity, we have to do a little */ Int o = *ao; /* bit of work to isolate args that*/ Type args = NIL; /* will not be changed by expansion*/ Int i; while (ar-- > 0) { /* find part to expand, and the */ Tyvar *tyv; /* unused arguments */ args = cons(arg(t),args); t = fun(t); deRef(tyv,t,o); } expandSyn1(h,&t,&o); /* do the expansion */ bindTv((i=newTyvars(1)),t,o); /* and embed the results back in */ tyvar(i)->kind = getKind(t,o); /* (*at, *ao) as required */ *at = applyToArgs(mkInt(i),args); } } static Void local expandSyn1(h,at,ao) /* Expand type synonym with: */ Tycon h; /* head h, tycon(h).arity args, */ Type *at; /* original expression (*at,*ao) */ Int *ao; { /* expansion returned in (*at,*ao) */ Int n = tycon(h).arity; Type t = *at; Int o = *ao; Tyvar *tyv; *at = tycon(h).defn; *ao = newKindedVars(tycon(h).kind); for (; 0offs = UNUSED_GENERIC; genericVars = NIL; nextGeneric = 0; } Void markAllVars() { /* Set all unbound type vars to */ Int i; /* be fixed vars */ for (i=0; ioffs = FIXED_TYVAR; genericVars = NIL; nextGeneric = 0; } Void resetGenerics() { /* Reset all generic vars to unused*/ Int i; for (i=0; ioffs>=GENERIC) tyvar(i)->offs = UNUSED_GENERIC; genericVars = NIL; nextGeneric = 0; } Void markTyvar(vn) /* mark fixed vars in type bound to*/ Int vn; { /* given type variable */ Tyvar *tyv = tyvar(vn); if (isBound(tyv)) markType(tyv->bound, tyv->offs); else (tyv->offs) = FIXED_TYVAR; } Void markType(t,o) /* mark fixed vars in type (t,o) */ Type t; Int o; { STACK_CHECK switch (whatIs(t)) { case POLYTYPE : case QUAL : #if TREX case EXT : #endif case TYCON : case TUPLE : return; case AP : markType(fst(t),o); markType(snd(t),o); return; case OFFSET : markTyvar(o+offsetOf(t)); return; case INTCELL : markTyvar(intOf(t)); return; case VARIDCELL : case VAROPCELL : markTyvar(findBtyvsInt(textOf(t))); return; case RANK2 : markType(snd(snd(t)),o); return; default : internal("markType"); } } Void markPred(pi) /* Marked fixed type vars in pi */ Cell pi; { Cell cl = fst3(pi); Int o = intOf(snd3(pi)); for (; isAp(cl); cl=fun(cl)) markType(arg(cl),o); } /* -------------------------------------------------------------------------- * Copy type expression from substitution to make a single type expression: * ------------------------------------------------------------------------*/ Type copyTyvar(vn) /* calculate most general form of */ Int vn; { /* type bound to given type var */ Tyvar *tyv = tyvar(vn); if ((tyv->bound)==SKOLEM) { return mkInt(vn); } else if (tyv->bound) { return copyType(tyv->bound,tyv->offs); } switch (tyv->offs) { case FIXED_TYVAR : return mkInt(vn); case UNUSED_GENERIC : (tyv->offs) = GENERIC + nextGeneric++; if (nextGeneric>=NUM_OFFSETS) { ERRMSG(0) "Too many quantified type variables" EEND; } genericVars = cons(mkInt(vn),genericVars); default : return mkOffset(tyv->offs - GENERIC); } } Type copyType(t,o) /* calculate most general form of */ Type t; /* type expression (t,o) */ Int o; { STACK_CHECK switch (whatIs(t)) { case AP : { Type l = copyType(fst(t),o);/* ensure correct */ Type r = copyType(snd(t),o);/* eval. order */ return ap(l,r); } case OFFSET : return copyTyvar(o+offsetOf(t)); case INTCELL : return copyTyvar(intOf(t)); case VARIDCELL : case VAROPCELL : return copyTyvar(findBtyvsInt(textOf(t))); } return t; } Cell copyPred(pi,o) /* Copy single predicate (or part */ Cell pi; /* thereof) ... */ Int o; { if (isAp(pi)) { Cell temp = copyPred(fun(pi),o);/* to ensure correct order of eval.*/ return ap(temp,copyType(arg(pi),o)); } else return pi; } Type zonkTyvar(vn) /* flatten type by chasing all references */ Int vn; { /* and collapsing OFFSETS to absolute indexes */ Tyvar *tyv = tyvar(vn); if (tyv->bound) return zonkType(tyv->bound,tyv->offs); else return mkInt(vn); } Type zonkType(t,o) /* flatten type by chasing all references */ Type t; /* and collapsing OFFSETS to absolute indexes */ Int o; { STACK_CHECK switch (whatIs(t)) { case AP : { Type l = zonkType(fst(t),o);/* ensure correct */ Type r = zonkType(snd(t),o);/* eval. order */ return ap(l,r); } case OFFSET : return zonkTyvar(o+offsetOf(t)); case INTCELL : return zonkTyvar(intOf(t)); } return t; } #if DEBUG_TYPES Type debugTyvar(vn) /* expand type structure in full */ Int vn; { /* detail */ Tyvar *tyv = tyvar(vn); if (isBound(tyv)) return debugType(tyv->bound,tyv->offs); return mkInt(vn); } Type debugType(t,o) Type t; Int o; { STACK_CHECK switch (whatIs(t)) { case AP : { Type l = debugType(fst(t),o); Type r = debugType(snd(t),o); return ap(l,r); } case OFFSET : return debugTyvar(o+offsetOf(t)); case INTCELL : return debugTyvar(intOf(t)); case VARIDCELL : case VAROPCELL : return debugTyvar(findBtyvsInt(textOf(t))); } return t; } List debugContext(ps) List ps; { Cell p; List qs = NIL; for (; nonNull(ps); ps=tl(ps)) { p = debugPred(fst3(hd(ps)),intOf(snd3(hd(ps)))); qs = cons(p,qs); } return rev(qs); } Cell debugPred(pi,o) Cell pi; Int o; { if (isAp(pi)) { return pair(debugPred(fun(pi),o),debugType(arg(pi),o)); } return pi; } #endif /*DEBUG_TYPES*/ Kind copyKindvar(vn) /* build kind attatched to variable*/ Int vn; { Tyvar *tyv = tyvar(vn); if (tyv->bound) return copyKind(tyv->bound,tyv->offs); return STAR; /* any unbound variable defaults to*/ } /* the kind of all types */ Kind copyKind(k,o) /* build kind expression from */ Kind k; /* given skeleton */ Int o; { switch (whatIs(k)) { case AP : { Kind l = copyKind(fst(k),o); /* ensure correct */ Kind r = copyKind(snd(k),o); /* eval. order */ return ap(l,r); } case OFFSET : return copyKindvar(o+offsetOf(k)); case INTCELL : return copyKindvar(intOf(k)); } return k; } /* -------------------------------------------------------------------------- * Copy type expression from substitution without marking: * ------------------------------------------------------------------------*/ static List local listTyvar(vn,ns) Int vn; List ns; { Tyvar *tyv = tyvar(vn); if (isBound(tyv)) { return listTyvars(tyv->bound,tyv->offs,ns); } else if (!intIsMember(vn,ns)) { ns = cons(mkInt(vn),ns); } return ns; } static List local listTyvars(t,o,ns) Cell t; Int o; List ns; { switch (whatIs(t)) { case AP : return listTyvars(fst(t),o, listTyvars(snd(t),o, ns)); case OFFSET : return listTyvar(o+offsetOf(t),ns); case INTCELL : return listTyvar(intOf(t),ns); default : break; } return ns; } static Cell local dupTyvar(vn,ns) Int vn; List ns; { Tyvar *tyv = tyvar(vn); if (isBound(tyv)) { return dupTyvars(tyv->bound,tyv->offs,ns); } else { Int i = 0; for (; nonNull(ns) && vn!=intOf(hd(ns)); ns=tl(ns)) { i++; } return mkOffset(i); } } static Cell local dupTyvars(t,o,ns) Cell t; Int o; List ns; { switch (whatIs(t)) { case AP : { Type l = dupTyvars(fst(t),o,ns); Type r = dupTyvars(snd(t),o,ns); return ap(l,r); } case OFFSET : return dupTyvar(o+offsetOf(t),ns); case INTCELL : return dupTyvar(intOf(t),ns); } return t; } static Cell local copyNoMark(t,o) /* Copy a type or predicate without*/ Cell t; /* changing marks */ Int o; { List ns = listTyvars(t,o,NIL); Cell result = pair(ns,dupTyvars(t,o,ns)); for (; nonNull(ns); ns=tl(ns)) { hd(ns) = tyvar(intOf(hd(ns)))->kind; } return result; } /* -------------------------------------------------------------------------- * Droping and lifting of type schemes that appear in rank 2 position: * ------------------------------------------------------------------------*/ Type dropRank2(t,alpha,n) /* Drop a (potentially) rank2 type */ Type t; Int alpha; Int n; { if (whatIs(t)==RANK2) { Cell r = fst(snd(t)); Int i = intOf(r); Type as = NIL; for (t=snd(snd(t)); i>0; i--) { Type a = arg(fun(t)); if (isPolyType(a)) a = dropRank1(a,alpha,n); as = fn(a,as); t = arg(t); } t = ap(RANK2,pair(r,revOnto(as,t))); } return t; } Type dropRank1(t,alpha,n) /* Copy rank1 argument type t to */ Type t; /* make a rank1 type scheme */ Int alpha; Int n; { if (n>0 && isPolyType(t)) t = mkPolyType(polySigOf(t),dropRank1Body(monotypeOf(t),alpha,n)); return t; } static Type local dropRank1Body(t,alpha,n) Type t; Int alpha; Int n; { switch (whatIs(t)) { case OFFSET : { Int m = offsetOf(t); return (m>=n) ? mkOffset(m-n) : mkInt(alpha+m); } case POLYTYPE : return mkPolyType(polySigOf(t), dropRank1Body(monotypeOf(t),alpha,n)); case QUAL : return ap(QUAL,dropRank1Body(snd(t),alpha,n)); case RANK2 : return ap(RANK2,pair(fst(snd(t)), dropRank1Body(snd(snd(t)), alpha, n))); case AP : return ap(dropRank1Body(fun(t),alpha,n), dropRank1Body(arg(t),alpha,n)); default : return t; } } Void liftRank2Args(as,alpha,m) List as; Int alpha; Int m; { Int i = 0; for (; i0; i--) { Type a = arg(fun(t)); a = isPolyType(a) ? liftRank1Body(a,m) : copyType(a,alpha); as = fn(a,as); t = arg(t); } t = ap(RANK2,pair(r,revOnto(as,copyType(t,alpha)))); } else t = copyType(t,alpha); return t; } Type liftRank1(t,alpha,m) Type t; Int alpha; Int m; { if (m>0 && isPolyType(t)) { Int i = 0; resetGenerics(); for (; i * -> * */ case OFFSET : return tyvar(o+offsetOf(c))->kind; case INTCELL : return tyvar(intOf(c))->kind; case VARIDCELL : case VAROPCELL : return tyvar(findBtyvsInt(textOf(c)))->kind; case TYCON : return tycon(c).kind; #if TREX case EXT : return extKind; #endif } #if DEBUG_KINDS Printf("getKind c = %d, whatIs=%d\n",c,whatIs(c)); #endif internal("getKind"); return STAR;/* not reached */ } /* -------------------------------------------------------------------------- * Find generic variables in a type: * ------------------------------------------------------------------------*/ Type genvarTyvar(vn,vs) /* calculate list of generic vars */ Int vn; /* thru variable vn, prepended to */ List vs; { /* list vs */ Tyvar *tyv = tyvar(vn); if (isBound(tyv)) return genvarType(tyv->bound,tyv->offs,vs); else if (tyv->offs == UNUSED_GENERIC) { tyv->offs += GENERIC + nextGeneric++; return cons(mkInt(vn),vs); } else if (tyv->offs>=GENERIC && !intIsMember(vn,vs)) return cons(mkInt(vn),vs); else return vs; } List genvarType(t,o,vs) /* calculate list of generic vars */ Type t; /* in type expression (t,o) */ Int o; /* results are prepended to vs */ List vs; { switch (whatIs(t)) { case AP : return genvarType(snd(t),o,genvarType(fst(t),o,vs)); case OFFSET : return genvarTyvar(o+offsetOf(t),vs); case INTCELL : return genvarTyvar(intOf(t),vs); case VARIDCELL : case VAROPCELL : return genvarTyvar(findBtyvsInt(textOf(t)),vs); } return vs; } /* -------------------------------------------------------------------------- * Occurs check: * ------------------------------------------------------------------------*/ Bool doesntOccurIn(lookFor,t,o) /* Return TRUE if var lookFor */ Tyvar *lookFor; /* isn't referenced in (t,o) */ Type t; Int o; { Tyvar *tyv; STACK_CHECK for (;;) { deRef(tyv,t,o); if (tyv) /* type variable */ return tyv!=lookFor; else if (isAp(t)) { /* application */ if (doesntOccurIn(lookFor,snd(t),o)) t = fst(t); else return FALSE; } else /* no variable found */ break; } return TRUE; } /* -------------------------------------------------------------------------- * Unification algorithm: * ------------------------------------------------------------------------*/ char *unifyFails = 0; /* Unification error message */ static Int bindAbove = 0; /* Used to restrict var binding */ #define bindOnlyAbove(beta) bindAbove=beta #define noBind() bindAbove=MAXPOSINT #define unrestrictBind() bindAbove=0 static Bool local varToVarBind(tyv1,tyv2)/* Make binding tyv1 := tyv2 */ Tyvar *tyv1, *tyv2; { if (tyv1!=tyv2) { /* If vars are same, nothing to do!*/ /* Check that either tyv1 or tyv2 is in allowed range for binding */ /* and is not a Skolem constant, and swap vars if nec. so we can */ /* bind to tyv1. */ if (tyvNum(tyv1)bound==SKOLEM) { if (tyvNum(tyv2)bound==SKOLEM) { unifyFails = "types do not match"; return FALSE; } else { Tyvar *tyv = tyv1; tyv1 = tyv2; tyv2 = tyv; } } if (!eqKind(tyv1->kind,tyv2->kind)) { unifyFails = "constructor variable kinds do not match"; return FALSE; } tyv1->bound = aVar; tyv1->offs = tyvNum(tyv2); #if DEBUG_TYPES Printf("vv binding tyvar: _%d to _%d\n",tyvNum(tyv1),tyvNum(tyv2)); #endif } return TRUE; } static Bool local varToTypeBind(tyv,t,o)/* Make binding tyv := (t,o) */ Tyvar *tyv; Type t; /* guaranteed not to be a v'ble or */ Int o; { /* have synonym as outermost constr*/ if (tyvNum(tyv)bound == SKOLEM) { /* Check that it is not Skolemized */ unifyFails = "cannot instantiate Skolem constant"; return FALSE; } else if (!doesntOccurIn(tyv,t,o)) /* Carry out occurs check */ unifyFails = "unification would give infinite type"; else if (!eqKind(tyv->kind,getKind(t,o))) unifyFails = "kinds do not match"; else { tyv->bound = t; tyv->offs = o; #if DEBUG_TYPES Printf("vt binding type variable: _%d to ",tyvNum(tyv)); printType(stdout,debugType(t,o)); Putchar('\n'); #endif return TRUE; } return FALSE; } Bool unify(t1,o1,t2,o2) /* Main unification routine */ Type t1,t2; /* unify (t1,o1) with (t2,o2) */ Int o1,o2; { Tyvar *tyv1, *tyv2; STACK_CHECK deRef(tyv1,t1,o1); deRef(tyv2,t2,o2); un: if (tyv1) if (tyv2) return varToVarBind(tyv1,tyv2); /* t1, t2 variables */ else { Cell h2 = getDerefHead(t2,o2); /* t1 variable, t2 not */ if (isSynonym(h2) && argCount>=tycon(h2).arity) { expandSyn(h2,argCount,&t2,&o2); deRef(tyv2,t2,o2); goto un; } return varToTypeBind(tyv1,t2,o2); } else if (tyv2) { Cell h1 = getDerefHead(t1,o1); /* t2 variable, t1 not */ if (isSynonym(h1) && argCount>=tycon(h1).arity) { expandSyn(h1,argCount,&t1,&o1); deRef(tyv1,t1,o1); goto un; } return varToTypeBind(tyv2,t1,o1); } else { /* t1, t2 not vars */ Type h1 = getDerefHead(t1,o1); Int a1 = argCount; Type h2 = getDerefHead(t2,o2); Int a2 = argCount; #if DEBUG_TYPES Printf("tt unifying types: "); printType(stdout,debugType(t1,o1)); Printf(" with "); printType(stdout,debugType(t2,o2)); Putchar('\n'); #endif if (isOffset(h1) || isInt(h1)) h1=NIL; /* represent var by NIL*/ if (isOffset(h2) || isInt(h2)) h2=NIL; #if TREX if (isExt(h1) && a1==2) return inserter(t1,o1,t2,o2) && unify(arg(t1),o1,aVar,remover(extText(h1),t2,o2)); if (isExt(h2) && a2==2) return inserter(t2,o2,t1,o1) && unify(arg(t2),o2,aVar,remover(extText(h2),t1,o1)); #endif if (nonNull(h1) && h1==h2) {/* Assuming well-formed types, both*/ if (a1!=a2) { /* t1, t2 must have same no of args*/ unifyFails = "incompatible constructors"; return FALSE; } while (isAp(t1)) { if (!unify(arg(t1),o1,arg(t2),o2)) return FALSE; t1 = fun(t1); deRef(tyv1,t1,o1); t2 = fun(t2); deRef(tyv2,t2,o2); } unifyFails = 0; return TRUE; } /* Types do not match -- look for type synonyms to expand */ if (isSynonym(h1) && a1>=tycon(h1).arity) { expandSyn(h1,a1,&t1,&o1); deRef(tyv1,t1,o1); goto un; } if (isSynonym(h2) && a2>=tycon(h2).arity) { expandSyn(h2,a2,&t2,&o2); deRef(tyv2,t2,o2); goto un; } if ((isNull(h1) && a1<=a2) || /* last attempt -- maybe */ (isNull(h2) && a2<=a1)) { /* one head is a variable? */ for (;;) { deRef(tyv1,t1,o1); deRef(tyv2,t2,o2); if (tyv1) /* unify heads! */ if (tyv2) return varToVarBind(tyv1,tyv2); else return varToTypeBind(tyv1,t2,o2); else if (tyv2) return varToTypeBind(tyv2,t1,o1); /* at this point, neither t1 nor t2 is a variable. In */ /* addition, they must both be APs unless one of the */ /* head variables has been bound during unification of */ /* the arguments. */ if (!isAp(t1) || !isAp(t2)) { /* might not be APs*/ unifyFails = 0; return t1==t2; } if (!unify(arg(t1),o1,arg(t2),o2)) /* o/w must be APs */ return FALSE; t1 = fun(t1); t2 = fun(t2); } } } unifyFails = 0; return FALSE; } #if TREX static Bool local inserter(r1,o1,r,o) /* Insert first field in (r1,o1), */ Type r1; /* which is known to begin with */ Int o1; /* an EXT, into row (r,o) */ Type r; Int o; { Text labt = extText(fun(fun(r1))); /* Find the text of the label */ #if DEBUG_TYPES Printf("inserting "); printType(stdout,debugType(r1,o1)); Printf(" into "); printType(stdout,debugType(r,o)); Putchar('\n'); #endif for (;;) { Tyvar *tyv; expandSynFully(&r,&o); deRef(tyv,r,o); if (tyv) { Int beta; /* Test for common tail */ if (tailVar(arg(r1),o1)==tyvNum(tyv)) { unifyFails = "distinct rows have common tail"; return FALSE; } beta = newTyvars(1); /* Extend row with new field */ tyvar(beta)->kind = ROW; return varToTypeBind(tyv,ap(fun(r1),mkInt(beta)),o1); } else if (isAp(r) && isAp(fun(r)) && isExt(fun(fun(r)))) { if (labt==extText(fun(fun(r))))/* Compare existing fields */ return unify(arg(fun(r1)),o1,extField(r),o); r = extRow(r); /* Or skip to next field */ } else { /* Nothing else will match */ unifyFails = "field mismatch"; return FALSE; } } } static Int local remover(l,r,o) /* Make a new row by copying (r,o) */ Text l; /* but removing the l field (which */ Type r; /* MUST exist) */ Int o; { Tyvar *tyv; Int beta = newTyvars(1); tyvar(beta)->kind = ROW; #if DEBUG_TYPES Printf("removing %s from",textToStr(l)); printType(stdout,debugType(r,o)); Putchar('\n'); #endif expandSynFully(&r,&o); deRef(tyv,r,o); if (tyv || !isAp(r) || !isAp(fun(r)) || !isExt(fun(fun(r)))) internal("remover"); if (l==extText(fun(fun(r)))) r = extRow(r); else r = ap(fun(r),mkInt(remover(l,extRow(r),o))); bindTv(beta,r,o); return beta; } static Int local tailVar(r,o) /* Find var at tail end of a row */ Type r; Int o; { for (;;) { Tyvar *tyv; expandSynFully(&r,&o); deRef(tyv,r,o); if (tyv) { return tyvNum(tyv); } else if (isAp(r) && isAp(fun(r)) && isExt(fun(fun(r)))) { r = extRow(r); } else { return (-1); } } } #endif #if TREX || IO_MONAD static Void local expandSynFully(at,ao) /* repeatedly expand synonyms */ Type *at; /* original expression (*at,*ao) */ Int *ao; { /* expansion returned in (*at,*ao) */ Type h; Int a; for (;;) { h = getDerefHead(*at,*ao); a = argCount; if (! isSynonym(h) || a pi [improves pi'] where ... * * The intention here is that any predicate matching pi' can be unified * with pi to get more accurate types. A simple example of this is: * * instance Collection [a] a improves Collection [a] b where ... * * As soon as we know what the collection type is (in this case, a list), * we will also know what the element type is. To ensure that the rule * for improvement is valid, the compilation system will also need to use * a one-way matching process to ensure that pi is a (substitution) instance * of pi'. Another extension would be to allow more than one predicate pi' * in an improving rule. Read the paper on simplification and improvement * for technical background. Watch this space for implementation news! * ------------------------------------------------------------------------*/ Bool samePred(pi1,o1,pi,o) /* Test to see if predicates are */ Cell pi1; /* the same, with no binding of */ Int o1; /* the variables in either one. */ Cell pi; /* Assumes preds are kind correct */ Int o; { /* with the same class. */ Bool result; noBind(); result = unifyPred(pi1,o1,pi,o); unrestrictBind(); return result; } Bool matchPred(pi1,o1,pi,o) /* One way match predicate (pi1,o1)*/ Cell pi1; /* against (pi,o), allowing only */ Int o1; /* vars in 2nd pred to be bound. */ Cell pi; /* Assumes preds are kind correct */ Int o; { /* with the same class and that no */ Bool result; /* vars have been alloc'd since o. */ bindOnlyAbove(o); result = unifyPred(pi1,o1,pi,o); unrestrictBind(); return result; } Bool unifyPred(pi1,o1,pi,o) /* Unify two predicates */ Cell pi1; /* Assumes preds are kind correct */ Int o1; /* with the same class. */ Cell pi; Int o; { for (; isAp(pi1); pi1=fun(pi1), pi=fun(pi)) { if (!isAp(pi) || !unify(arg(pi1),o1,arg(pi),o)) return FALSE; } /* pi1 has exhausted its argument chain, we also need to check that pi has no remaining arguments. However, under this condition, the pi1 == pi will always return FALSE, giving the desired result. */ #if IPARAM if (isIP(pi1) && isIP(pi)) return textOf(pi1)==textOf(pi); else #endif return pi1==pi; } #if TREX Name nameShowRecRowCls = NIL; /* Used to test for show on records*/ Name nameEqRecRowCls = NIL; /* Used to test for eq on records*/ #endif Inst findInstFor(pi,o) /* Find matching instance for pred */ Cell pi; /* (pi,o), or otherwise NIL. If a */ Int o; { /* match is found, then tyvars from*/ Class c = getHead(pi); /* typeOff have been initialized to*/ List ins; /* allow direct use of specifics. */ Cell kspi = NIL; if (!isClass(c)) return NIL; for (ins=cclass(c).instances; nonNull(ins); ins=tl(ins)) { Inst in = hd(ins); Int beta = newKindedVars(inst(in).kinds); if (matchPred(pi,o,inst(in).head,beta)) { typeOff = beta; return in; } else { numTyvars = beta; if (allowOverlap && !allowUnsafeOverlap) { Int alpha = newKindedVars(inst(in).kinds); if (isNull(kspi)) { kspi = copyNoMark(pi,o); } beta = newKindedVars(fst(kspi)); if (matchPred(inst(in).head,alpha,snd(kspi),beta)) { numTyvars = alpha; return NIL; } numTyvars = alpha; } } } unrestrictBind(); #if TREX { Bool wantShow = (c==nameShowRecRowCls); Bool wantEither = wantShow || (c==nameEqRecRowCls); if (wantEither) { /* Generate instances of */ Type t = arg(pi); /* ShowRecRow and EqRecRow */ Tyvar *tyv; /* on the fly */ Cell e; deRef(tyv,t,o); e = getHead(t); if (isExt(e)) { Inst in = NIL; for (ins=cclass(c).instances; nonNull(ins); ins=tl(ins)) if (getHead(arg(inst(hd(ins)).head))==e) { in = hd(ins); break; } if (isNull(in)) in = (wantShow ? addRecShowInst(c,e) : addRecEqInst(c,e)); typeOff = newKindedVars(extKind); bindTv(typeOff,arg(fun(t)),o); bindTv(typeOff+1,arg(t),o); return in; } } } #endif return NIL; } #if MULTI_INST List findInstsFor(pi,o) /* Find matching instance for pred */ Cell pi; /* (pi,o), or otherwise NIL. If a */ Int o; { /* match is found, then tyvars from*/ Class c = getHead(pi); /* typeOff have been initialized to*/ List ins; /* allow direct use of specifics. */ List res = NIL; if (!isClass(c)) return NIL; for (ins=cclass(c).instances; nonNull(ins); ins=tl(ins)) { Inst in = hd(ins); Int beta = newKindedVars(inst(in).kinds); if (matchPred(pi,o,inst(in).head,beta)) { res = cons (pair (beta, in), res); continue; } else numTyvars = beta; } if (res == NIL) { unrestrictBind(); } return rev(res); } #endif /* -------------------------------------------------------------------------- * Improvement: * ------------------------------------------------------------------------*/ Void improve(line,sps,ps) /* Improve a list of predicates */ Int line; List sps; List ps; { Bool improved; List ps1; do { improved = FALSE; for (ps1=ps; nonNull(ps1); ps1=tl(ps1)) { Cell pi = fst3(hd(ps1)); Int o = intOf(snd3(hd(ps1))); Cell c = getHead(pi); if ((isClass(c) && nonNull(cclass(c).xfds)) || isIP(c)) { improved |= improveAgainst(line,sps,pi,o); if (!isIP(c)) improved |= instImprove(line,c,pi,o); improved |= improveAgainst(line,tl(ps1),pi,o); } } } while (improved); } Void improve1(line,sps,pi,o) /* Improve a single predicate */ Int line; List sps; Cell pi; Int o; { Bool improved; Cell c = getHead(pi); do { improved = FALSE; if ((isClass(c) && nonNull(cclass(c).xfds)) || isIP(c)) { improved |= improveAgainst(line,sps,pi,o); if (!isIP(c)) improved |= instImprove(line,c,pi,o); } } while (improved); } Bool improveAgainst(line,ps,pi,o) Int line; List ps; Cell pi; Int o; { Bool improved = FALSE; Cell h = getHead(pi); for (; nonNull(ps); ps=tl(ps)) { Cell pr = hd(ps); Cell pi1 = fst3(pr); Int o1 = intOf(snd3(pr)); Cell h1 = getHead(pi1); /* it would be nice to optimize for the common case where h == h1 */ if (isClass(h) && isClass(h1)) { improved |= pairImprove(line,h,pi,o,pi1,o1,numTyvars); if (h != h1) improved |= pairImprove(line,h1,pi1,o1,pi,o,numTyvars); } #if IPARAM else if (isIP(h1) && textOf(h1) == textOf(h)) improved |= ipImprove(line,pi,o,pi1,o1); #endif } return improved; } /* should emulate findInsts behavior of shorting out if the predicate would match a more general signature... */ Bool instImprove(line,c,pi,o) Int line; Class c; Cell pi; Int o; { Bool improved = FALSE; List ins = cclass(c).instances; for (; nonNull(ins); ins=tl(ins)) { Cell in = hd(ins); Int alpha = newKindedVars(inst(in).kinds); improved |= pairImprove(line,c,pi,o,inst(in).head,alpha,alpha); } return improved; } #if IPARAM Bool ipImprove(line,pi,o,pi1,o1) Int line; Cell pi; Int o; Cell pi1; Int o1; { Type t = arg(pi); Type t1 = arg(pi1); if (!sameType(t,o,t1,o1)) { if (!unify(t,o,t1,o1)) { ERRMSG(line) "Mismatching uses of implicit parameter\n" ETHEN ERRTEXT "\n*** " ETHEN ERRPRED(copyPred(pi1,o1)); ERRTEXT "\n*** " ETHEN ERRPRED(copyPred(pi,o)); ERRTEXT "\n" EEND; } return TRUE; } return FALSE; } #endif Bool pairImprove(line,c,pi1,o1,pi2,o2,above) /* Look for improvement of */ Int line; /* (pi1,o1) against (pi2,o2) */ Class c; Cell pi1; Int o1; Cell pi2; Int o2; Int above; { Bool improved = FALSE; List xfds = cclass(c).xfds; for (; nonNull(xfds); xfds=tl(xfds)) { Cell xfd = hd(xfds); Cell hs = fst(xfd); Int alpha = (-1); for (; nonNull(hs); hs=tl(hs)) { Cell h = hd(hs); Class d = getHead(h); alpha = newKindedVars(cclass(d).kinds); if (matchPred(pi2,o2,h,alpha)) break; numTyvars = alpha; } if (nonNull(hs)) { List fds = snd(xfd); for (; nonNull(fds); fds=tl(fds)) { List as = fst(hd(fds)); Bool same = TRUE; for (; same && nonNull(as); as=tl(as)) { Int n = offsetOf(hd(as)); same &= matchTypeAbove(nthArg(n,pi1),o1, mkOffset(n),alpha,above); } if (isNull(as) && same) { for (as=snd(hd(fds)); same && nonNull(as); as=tl(as)) { Int n = offsetOf(hd(as)); Type t1 = nthArg(n,pi1); Type t2 = mkOffset(n); if (!matchTypeAbove(t1,o1,t2,alpha,above)) { same &= unify(t1,o1,t2,alpha); improved = TRUE; } } if (!same) { ERRMSG(line) "Constraints are not consistent with functional dependency" ETHEN ERRTEXT "\n*** Constraint : " ETHEN ERRPRED(copyPred(pi1,o1)); ERRTEXT "\n*** And constraint : " ETHEN ERRPRED(copyPred(pi2,o2)); ERRTEXT "\n*** For class : " ETHEN ERRPRED(cclass(c).head); ERRTEXT "\n*** Break dependency : " ETHEN ERRFD(hd(fds)); ERRTEXT "\n" EEND; } } } numTyvars = alpha; } } return improved; } /* -------------------------------------------------------------------------- * Compare type schemes: * ------------------------------------------------------------------------*/ Bool sameSchemes(s,s1) /* Test to see whether two type */ Type s; /* schemes are the same */ Type s1; { Int o = 0; Int m = 0; Int nr2 = 0; Bool b = isPolyType(s); /* Check quantifiers are the same */ Bool b1 = isPolyType(s1); if (b || b1) { if (b && b1 && eqKind(polySigOf(s),polySigOf(s1))) { Kind k = polySigOf(s); s = monotypeOf(s); s1 = monotypeOf(s1); o = newKindedVars(k); for (; isAp(k); k=arg(k)) m++; } else return FALSE; } b = (whatIs(s)==QUAL); /* Check that contexts are the same*/ b1 = (whatIs(s1)==QUAL); if (b || b1) { if (b && b1) { List ps = fst(snd(s)); List ps1 = fst(snd(s1)); noBind(); while (nonNull(ps) && nonNull(ps1)) { Cell pi = hd(ps); Cell pi1 = hd(ps1); if (getHead(pi)!=getHead(pi1) || !unifyPred(pi,o,pi1,o)) break; ps = tl(ps); ps1 = tl(ps1); } unrestrictBind(); if (nonNull(ps) || nonNull(ps1)) return FALSE; s = snd(snd(s)); s1 = snd(snd(s1)); } else return FALSE; } b = (whatIs(s)==RANK2); /* Check any rank 2 annotations */ b1 = (whatIs(s1)==RANK2); if (b || b1) { if (b && b1 && intOf(fst(snd(s)))==intOf(fst(snd(s1)))) { nr2 = intOf(fst(snd(s))); s = snd(snd(s)); s1 = snd(snd(s1)); } else return FALSE; } for (; nr2>0; nr2--) { /* Deal with rank 2 arguments */ Type t = arg(fun(s)); Type t1 = arg(fun(s1)); b = isPolyOrQualType(t); b1 = isPolyOrQualType(t1); if (b || b1) { if (b && b1) { t = dropRank1(t,o,m); t1 = dropRank1(t1,o,m); if (!sameSchemes(t,t1)) return FALSE; } else return FALSE; } else { if (!sameType(t,o,t1,o)) { return FALSE; } } s = arg(s); s1 = arg(s1); } return sameType(s,o,s1,o); /* Ensure body types are the same */ } Bool sameType(t1,o1,t,o) /* Test to see if types are */ Type t1; /* the same, with no binding of */ Int o1; /* the variables in either one. */ Cell t; /* Assumes types are kind correct */ Int o; { /* with the same kind. */ Bool result; noBind(); result = unify(t1,o1,t,o); unrestrictBind(); return result; } Bool matchType(t1,o1,t,o) /* One way match type (t1,o1) */ Type t1; /* against (t,o), allowing only */ Int o1; /* vars in 2nd type to be bound. */ Type t; /* Assumes types are kind correct */ Int o; { /* and that no vars have been */ Bool result; /* alloc'd since o. */ bindOnlyAbove(o); result = unify(t1,o1,t,o); unrestrictBind(); return result; } static Bool local matchTypeAbove(t1,o1,t,o,a) /* match, allowing only vars */ Type t1; /* allocated since `a' to be bound */ Int o1; /* this is deeply hacky, since it */ Type t; /* relies on careful use of the */ Int o; /* substitution stack */ Int a; { Bool result; bindOnlyAbove(a); result = unify(t1,o1,t,o); unrestrictBind(); return result; } /* -------------------------------------------------------------------------- * Unify kind expressions: * ------------------------------------------------------------------------*/ static Bool local kvarToVarBind(tyv1,tyv2)/* Make binding tyv1 := tyv2 */ Tyvar *tyv1, *tyv2; { /* for kind variable bindings */ if (tyv1!=tyv2) { tyv1->bound = aVar; tyv1->offs = tyvNum(tyv2); #if DEBUG_KINDS Printf("vv binding kvar: _%d to _%d\n",tyvNum(tyv1),tyvNum(tyv2)); #endif } return TRUE; } static Bool local kvarToTypeBind(tyv,t,o)/* Make binding tyv := (t,o) */ Tyvar *tyv; /* for kind variable bindings */ Type t; /* guaranteed not to be a v'ble or */ Int o; { /* have synonym as outermost constr*/ if (doesntOccurIn(tyv,t,o)) { tyv->bound = t; tyv->offs = o; #if DEBUG_KINDS Printf("vt binding kind variable: _%d to ",tyvNum(tyv)); printType(stdout,debugType(t,o)); Putchar('\n'); #endif return TRUE; } unifyFails = "unification would give infinite kind"; return FALSE; } Bool kunify(k1,o1,k2,o2) /* Unify kind expr (k1,o1) with */ Kind k1,k2; /* (k2,o2) */ Int o1,o2; { Tyvar *kyv1, *kyv2; deRef(kyv1,k1,o1); deRef(kyv2,k2,o2); if (kyv1) if (kyv2) return kvarToVarBind(kyv1,kyv2); /* k1, k2 variables */ else return kvarToTypeBind(kyv1,k2,o2); /* k1 variable, k2 not */ else if (kyv2) return kvarToTypeBind(kyv2,k1,o1); /* k2 variable, k1 not */ else { #if DEBUG_KINDS Printf("unifying kinds: "); printType(stdout,debugType(k1,o1)); Printf(" with "); printType(stdout,debugType(k2,o2)); Putchar('\n'); #endif if (k1==STAR && k2==STAR) /* k1, k2 not vars */ return TRUE; #if TREX else if (k1==ROW && k2==ROW) return TRUE; #endif else if (isAp(k1) && isAp(k2)) return kunify(fst(k1),o1,fst(k2),o2) && kunify(snd(k1),o1,snd(k2),o2); } unifyFails = 0; return FALSE; } /* -------------------------------------------------------------------------- * Tuple type constructors: are generated as necessary. The most common * n-tuple constructors (n=MAXTUPCON) typeIs = makeTupleType(n); else if (tupleConTypes[n]) typeIs = tupleConTypes[n]; else typeIs = tupleConTypes[n] = makeTupleType(n); } static Type local makeTupleType(n) /* construct type for tuple constr. */ Int n; { /* t1 -> ... -> tn -> (t1,...,tn) */ Type h = mkTuple(n); Int i; for (i=0; i * -> ... -> * -> * for kinds of ->, [], ->, (,) etc... * v1 -> v2 -> ... -> vn -> vn+1 skeletons for constructor kinds * Expressions of these forms are produced by the following functions which * use a cache to avoid repeated construction of commonly used values. * A similar approach is used to store the types of tuple constructors in the * main type checker. * ------------------------------------------------------------------------*/ #define MAXKINDFUN 10 static Kind simpleKindCache[MAXKINDFUN]; static Kind varKindCache[MAXKINDFUN]; static Kind local makeSimpleKind(n) /* construct * -> ... -> * (n args)*/ Int n; { Kind k = STAR; while (n-- > 0) k = ap(STAR,k); return k; } Kind simpleKind(n) /* return (possibly cached) simple */ Int n; { /* function kind */ if (n>=MAXKINDFUN) return makeSimpleKind(n); else if (nonNull(simpleKindCache[n])) return simpleKindCache[n]; else if (n==0) return simpleKindCache[0] = STAR; else return simpleKindCache[n] = ap(STAR,simpleKind(n-1)); } static Kind local makeVarKind(n) /* construct v0 -> .. -> vn */ Int n; { Kind k = mkOffset(n); while (n-- > 0) k = ap(mkOffset(n),k); return k; } Void varKind(n) /* return (possibly cached) var */ Int n; { /* function kind */ typeOff = newKindvars(n+1); if (n>=MAXKINDFUN) typeIs = makeVarKind(n); else if (nonNull(varKindCache[n])) typeIs = varKindCache[n]; else typeIs = varKindCache[n] = makeVarKind(n); } /* -------------------------------------------------------------------------- * Substitutution control: * ------------------------------------------------------------------------*/ Void substitution(what) Int what; { Int i; switch (what) { case RESET : emptySubstitution(); unrestrictBind(); btyvars = NIL; break; case MARK : for (i=0; ibound) && ((t)->bound!=SKOLEM)) #define aVar mkOffset(0) /* Simple skeletons for type vars */ #define bVar mkOffset(1) #define enterBtyvs() btyvars = cons(NIL,btyvars) #define leaveBtyvs() btyvars = tl(btyvars) #define deRef(tyv,t,o) while ((tyv=getTypeVar(t,o)) && isBound(tyv)) { \ t = tyv->bound; \ o = tyv->offs; \ } /* offs values when isNull(bound): */ #define FIXED_TYVAR 0 /* fixed in current assumption */ #define UNUSED_GENERIC 1 /* not fixed, not yet encountered */ #define GENERIC 2 /* GENERIC+n==nth generic var found*/ extern char *unifyFails; /* Unification error message */ extern Void emptySubstitution Args((Void)); extern Int newTyvars Args((Int)); #define newKindvars(n) newTyvars(n) extern Int newKindedVars Args((Kind)); extern Void instantiate Args((Type)); extern Pair findBtyvs Args((Text)); extern Void markBtyvs Args((Void)); extern Type localizeBtyvs Args((Type)); extern Tyvar *getTypeVar Args((Type,Int)); extern Void tyvarType Args((Int)); extern Void bindTv Args((Int,Type,Int)); extern Cell getDerefHead Args((Type,Int)); extern Void expandSyn Args((Tycon, Int, Type *, Int *)); extern Void clearMarks Args((Void)); extern Void markAllVars Args((Void)); extern Void resetGenerics Args((Void)); extern Void markTyvar Args((Int)); extern Void markType Args((Type,Int)); extern Void markPred Args((Cell)); extern Type copyTyvar Args((Int)); extern Type copyType Args((Type,Int)); extern Cell copyPred Args((Cell,Int)); extern Type dropRank2 Args((Type,Int,Int)); extern Type dropRank1 Args((Type,Int,Int)); extern Void liftRank2Args Args((List,Int,Int)); extern Type liftRank2 Args((Type,Int,Int)); extern Type liftRank1 Args((Type,Int,Int)); #if DEBUG_TYPES extern Type debugTyvar Args((Int)); extern Type debugType Args((Type,Int)); extern List debugContext Args((List)); extern Cell debugPred Args((Cell,Int)); #endif extern Kind copyKindvar Args((Int)); extern Kind copyKind Args((Kind,Int)); extern Bool eqKind Args((Kind,Kind)); extern Kind getKind Args((Cell,Int)); extern List genvarTyvar Args((Int,List)); extern List genvarType Args((Type,Int,List)); extern Bool doesntOccurIn Args((Tyvar*,Type,Int)); extern Bool unify Args((Type,Int,Type,Int)); extern Bool kunify Args((Kind,Int,Kind,Int)); extern Void typeTuple Args((Cell)); extern Kind simpleKind Args((Int)); extern Void varKind Args((Int)); extern Bool samePred Args((Cell,Int,Cell,Int)); extern Bool matchPred Args((Cell,Int,Cell,Int)); extern Bool unifyPred Args((Cell,Int,Cell,Int)); extern Inst findInstFor Args((Cell,Int)); extern Void improve Args((Int,List,List)); extern Void improve1 Args((Int,List,Cell,Int)); extern Bool sameSchemes Args((Type,Type)); extern Bool sameType Args((Type,Int,Type,Int)); extern Bool matchType Args((Type,Int,Type,Int)); /*-------------------------------------------------------------------------*/ #endif /* __SUBST_H__ */ hugs98-plus-Sep2006/src/timeprim.c0000644006511100651110000002034410221646043015545 0ustar rossross/* * Primitives needed to implement the Haskell 98 Time & CPUTime modules. * * This file has to be included by builtin.c, and won't compile on its own. */ /* -------------------------------------------------------------------------- * Time/CPUTime control: * ------------------------------------------------------------------------*/ static Void timeControl Args((Int)); static Void timeControl(what) Int what; { } /* -------------------------------------------------------------------------- * Time/CPUTime primitive table: * ------------------------------------------------------------------------*/ PROTO_PRIM(primClockTicks); PROTO_PRIM(primGetCPUUsage); PROTO_PRIM(primGetClockTime); PROTO_PRIM(primGetCalTime); PROTO_PRIM(primMkTime); static struct primitive timePrimTable[] = { /* CPUTime primitives */ {"clockTicks", 0, primClockTicks}, {"getCPUUsage", 0+IOArity, primGetCPUUsage}, /* Time primitives */ {"getClockTimePrim", 0+IOArity, primGetClockTime}, {"toCalTimePrim", 2+IOArity, primGetCalTime}, {"toClockTimePrim", 7+IOArity, primMkTime}, {0, 0, 0} }; static struct primInfo timePrims = { timeControl, timePrimTable, 0 }; /* -------------------------------------------------------------------------- * Time primitives: * ------------------------------------------------------------------------*/ primFun(primGetClockTime) { /* :: IO (Int,Int) */ #if HAVE_GETTIMEOFDAY struct timeval tv; int rc; rc = gettimeofday(&tv,NULL); if (rc == -1) throwErrno("Time.getClockTime", TRUE, NO_HANDLE, NULL); IOReturn(ap(ap(mkTuple(2), mkInt(tv.tv_sec)),mkInt(tv.tv_usec))); #elif HAVE_FTIME struct timeb tb; int rc = 0; # ifdef mingw32_HOST_OS ftime(&tb); # else rc = ftime(&tb); # endif if (rc == -1) throwErrno("Time.getClockTime", TRUE, NO_HANDLE, NULL); IOReturn(ap(ap(mkTuple(2),mkInt(tb.time)),mkInt(tb.millitm * 1000))); #elif HAVE_TIME time_t t = time(NULL); if (t == (time_t)-1) throwErrno("Time.getClockTime", TRUE, NO_HANDLE, NULL); IOReturn(ap(ap(mkTuple(2),mkInt(t)),mkInt(0))); #else IOFail(mkIOError(NULL, nameIllegal, "Time.getClockTime", "operation not supported", NULL)); #endif } #if HAVE_DECL__TIMEZONE # define timezone _timezone #endif primFun(primGetCalTime) { /* Int -> Int -> IO (.....) */ /* isUTC secs */ /* isUTC => convert time to UTC, o/wise local time */ Int isUTC; #if HAVE_LOCALTIME && HAVE_GMTIME time_t secs; struct tm* tm; char* zoneNm = NULL; Int utcOff; Cell zoneStr = NIL; IntArg(isUTC,2+IOArity); IntArg(secs,1+IOArity); if (isUTC) { tm=gmtime(&secs); } else { tm=localtime(&secs); } /* Warning - ugliness. */ #if HAVE_STRUCT_TM_TM_ZONE zoneNm = (char*)tm->tm_zone; #elif HAVE_TZNAME || IS_WINDOWS /* ToDo: fix autoconf macro AC_STRUCT_TIMEZONE so that it will recognise * mingw's _tzname global. For now, force it. */ zoneNm = (char*)(tm->tm_isdst ? tzname[1] : tzname[0]); #else /* Don't know how to get at the timezone name, complain louder? */ zoneNm = NULL; #endif #if HAVE_STRUCT_TM_TM_ZONE utcOff = tm->tm_gmtoff; #elif HAVE_DECL_TIMEZONE || HAVE_DECL__TIMEZONE # if HAVE_DECL_ALTZONE utcOff = (-(tm->tm_isdst ? altzone : timezone)); # else /* Assume DST adjustment is 1 hour. */ utcOff = -(tm->tm_isdst ? (timezone - 3600) : timezone); # endif #else /* Again, complain louder? */ utcOff = 0; #endif pushString(zoneNm); zoneStr = pop(); IOReturn(ap(ap(ap(ap(ap(ap(ap(ap(ap(ap(ap(mkTuple(11),mkInt(tm->tm_sec)), mkInt(tm->tm_min)), mkInt(tm->tm_hour)), mkInt(tm->tm_mday)), mkInt(tm->tm_mon)), mkInt(tm->tm_year)), mkInt(tm->tm_wday)), mkInt(tm->tm_yday)), mkInt(tm->tm_isdst)), zoneStr), mkInt(utcOff))); #else /* !(HAVE_LOCALTIME && HAVE_GMTIME) */ IntArg(isUTC,2+IOArity); IOFail(mkIOError(NULL, nameIllegal, (isUTC ? "Time.toUTCTime" : "Time.toCalendarTime"), "operation not supported", NULL)); #endif } primFun(primMkTime) { /* Int{-year-} -> Int{-month-} -> Int{-day-} -> Int{-hour-} -> Int{-mins-} -> Int{-sec-} -> Int{-tz offset-} -> IO Int{-secs since Epoch-} */ #if HAVE_MKTIME Int year, month, day; Int hour,min,sec; Int tz; struct tm tm; time_t t; IntArg(year,7+IOArity); IntArg(month,6+IOArity); IntArg(day,5+IOArity); IntArg(hour,4+IOArity); IntArg(min,3+IOArity); IntArg(sec,2+IOArity); IntArg(tz,1+IOArity); tm.tm_year = year; tm.tm_mon = month; tm.tm_mday = day; tm.tm_hour = hour; tm.tm_min = min; tm.tm_sec = sec; /* The OpenGroup spec suggests that setting tm_isdst to a neg. value, makes mktime() try to figure this out on its own. */ tm.tm_isdst = -1; t = mktime(&tm); if (t ==(time_t)-1) throwErrno("Time.toClockTime", TRUE, NO_HANDLE, NULL); /* mktime() assumes that the given time was local, but we might have been passed an UTC cal. time, so we now have to add the UTC offset, that is, the difference between toClockTime's UTC offset and the UTC offset returned by mktime(). */ tz = -tz; #if HAVE_STRUCT_TM_TM_ZONE tz += tm.tm_gmtoff; #elif HAVE_DECL_TIMEZONE || HAVE_DECL__TIMEZONE # if HAVE_DECL_ALTZONE tz += (-(tm.tm_isdst ? altzone : timezone)); # else /* Assume DST adjustment is 1 hour */ tz += (- (tm.tm_isdst ? (timezone - 3600) : timezone)); # endif #else /* Unknown, assume nothing */ #endif IOReturn(mkInt(t+tz)); #else /* !HAVE_MKTIME */ IOFail(mkIOError(NULL, nameIllegal, "Time.toClockTime", "operation not supported", NULL)); #endif } /* -------------------------------------------------------------------------- * CPUTime primitives: * ------------------------------------------------------------------------*/ #ifdef CLK_TCK CAFInt(primClockTicks, CLK_TCK) #elif defined(CLOCKS_PER_SEC) CAFInt(primClockTicks, CLOCKS_PER_SEC) #else CAFInt(primClockTicks, sysconf(_SC_CLK_TCK)) #endif /* * The code for grabbing the process times has been lifted from GHC. * Don't feel too bad about that, since I wrote and maintained it. */ primFun(primGetCPUUsage) { /* IO (Int,Int,Int,Int) */ int userSec, userNSec; int sysSec, sysNSec; #if IS_WINDOWS # ifdef _MSC_VER # define NS_PER_SEC 10000000 # else # define NS_PER_SEC 10000000LL # endif # define FT2usecs(ll,ft) \ (ll)=(ft).dwHighDateTime; \ (ll) <<= 32; \ (ll) |= (ft).dwLowDateTime; FILETIME creationTime, exitTime, kernelTime, userTime; # ifdef _MSC_VER unsigned __int64 uT, kT; # else unsigned long long uT, kT; # endif /* Notice that the 'process time' includes the time used by all the threads of a process, all of which may not be kept busy running the Hugs interpreter... */ if (!GetProcessTimes (GetCurrentProcess(), &creationTime, &exitTime, &kernelTime, &userTime)) { /* Probably on a Win95 box..*/ userSec = 0; userNSec = 0; sysSec = 0; sysNSec = 0; } else { FT2usecs(uT, userTime); FT2usecs(kT, kernelTime); userSec = (unsigned int)(uT / NS_PER_SEC); userNSec = (unsigned int)((uT - userSec * NS_PER_SEC) * 100); sysSec = (unsigned int)(kT / NS_PER_SEC); sysNSec = (unsigned int)((kT - sysSec * NS_PER_SEC) * 100); } #elif HAVE_GETRUSAGE /* && ! irix_HOST_OS && ! solaris2_HOST_OS */ struct rusage t; getrusage(RUSAGE_SELF, &t); userSec = t.ru_utime.tv_sec; userNSec = 1000 * t.ru_utime.tv_usec; sysSec = t.ru_stime.tv_sec; sysNSec = 1000 * t.ru_stime.tv_usec; #elif HAVE_TIMES struct tms t; # if defined(CLK_TCK) # define ticks CLK_TCK # else long ticks; ticks = sysconf(_SC_CLK_TCK); # endif times(&t); userSec = t.tms_utime / ticks; userNSec = (t.tms_utime - userSec * ticks) * (1000000000 / ticks); sysSec = t.tms_stime / ticks; sysNSec = (t.tms_stime - sysSec * ticks) * (1000000000 / ticks); #else IOFail(mkIOError(NULL, nameIllegal, "CPUTime.getCPUTime", "illegal operation", NULL)); #endif IOReturn(ap(ap(ap(ap( mkTuple(4), mkInt(userSec)), mkInt(userNSec)), mkInt(sysSec)), mkInt(sysNSec))); } hugs98-plus-Sep2006/src/timer.c0000644006511100651110000000536610133574361015053 0ustar rossross/* -------------------------------------------------------------------------- * This file provides a simple mechanism for measuring elapsed time on Unix * machines (more precisely, on any machine with an rusage() function). * A somewhat limited version for other systems is also included, believed * to be ANSI compatible, but not guaranteed ... * * It is included in the Hugs distribution for the purpose of benchmarking * the Hugs interpreter, comparing its performance across a variety of * different machines, and with other systems for similar languages. * * To make use of these functions, use the --enable-timer when configuring * Hugs or change the setting of "WANT_TIMER" in config.h and recompile * Hugs. * * It would be somewhat foolish to try to use the timings produced in this * way for anything other than the purpose described above. In particular, * using timings to compare the performance of different versions of an * algorithm is likely to give very misleading results. The current * implementation of Hugs as an interpreter, without any significant * optimizations, means that there are much more significant overheads than * can be accounted for by small variations in Hugs code. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: timer.c,v $ * $Revision: 1.6 $ * $Date: 2004/10/14 22:08:49 $ * ------------------------------------------------------------------------*/ #if HAVE_SYS_TIME_H && HAVE_SYS_RESOURCE_H #include #include void updateTimers Args((void)); long millisecs Args((long)); long userElapsed, systElapsed; void updateTimers() { static long lastUser = 0; static long lastSyst = 0; long curr; struct rusage ruse; getrusage(RUSAGE_SELF,&ruse); curr = ruse.ru_utime.tv_sec*1000000L + ruse.ru_utime.tv_usec; userElapsed = curr - lastUser; lastUser = curr; curr = ruse.ru_stime.tv_sec*1000000L + ruse.ru_stime.tv_usec; systElapsed = curr - lastSyst; lastSyst = curr; } long millisecs(t) long t; { return (t+500)/1000; } #else #include void updateTimers Args((void)); long millisecs Args((clock_t)); clock_t userElapsed=0, systElapsed=0; void updateTimers() { static clock_t lastUser = 0; clock_t curr; curr = clock(); userElapsed = curr - lastUser; lastUser = curr; } long millisecs(t) clock_t t; { return (long)((t * 1000)/CLK_TCK); } #endif /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/type.c0000644006511100651110000030200310346535431014701 0ustar rossross/* -------------------------------------------------------------------------- * This is the Hugs type checker * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: type.c,v $ * $Revision: 1.81 $ * $Date: 2005/12/10 11:25:13 $ * ------------------------------------------------------------------------*/ #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "output.h" #include "subst.h" #include "goal.h" #include "opts.h" /* needed for EXPLAIN_INSTANCE_RESOLUTION|MULTI_INST */ Bool catchAmbigs = FALSE; /* TRUE => functions with ambig. */ /* types produce error */ Type typeArrow, typeList; /* Important primitive types */ Type typeUnit; Module modulePrelude; Module moduleUserPrelude; Type typeInt; Type typeInt8; Type typeInt16; Type typeInt32; Type typeInt64; Type typeWord; Type typeWord8; Type typeWord16; Type typeWord32; Type typeWord64; Type typeFunPtr; Type typePtr; Type typeAddr; Type typeFloat; Type typeDouble; Type typeChar; Type typeForeignP; Type typeForeign; Type typeStable; Type typeBool; Type typeString; #ifdef DOTNET Type typeObject; #endif static Type typeInteger; static Type typeMaybe; static Type typeOrdering; Class classEq, classOrd; /* `standard' classes */ Class classIx, classEnum; Class classShow, classRead; Class classBounded; Class classReal, classIntegral; /* `numeric' classes */ Class classRealFrac, classRealFloat; Class classFractional, classFloating; Class classNum; List stdDefaults; /* standard default values */ Name nameFromInt, nameFromDouble; /* coercion of numerics */ Name nameFromInteger; Name nameEq, nameCompare; /* derivable names */ Name nameLe; Name nameShowsPrec; Name nameReadsPrec; Name nameMinBnd, nameMaxBnd; Name nameIndex, nameInRange; Name nameRange; Name nameMult, namePlus; Name nameTrue, nameFalse; /* primitive boolean constructors */ Name nameNil, nameCons; /* primitive list constructors */ Name nameJust, nameNothing; /* primitive Maybe constructors */ Name nameLeft, nameRight; /* primitive Either constructors */ Name nameUnit; /* primitive Unit type constructor */ Name nameLT, nameEQ; /* Ordering constructors */ Name nameGT; Class classMonad; /* Monads */ Name nameReturn, nameBind, nameThen; /* for translating do/monad comps */ Name nameMFail; Name nameGt; /* for readsPrec */ #if MUDO Class classMonadRec; /* Recursive monads */ Name nameMFix; #endif #if IO_MONAD Type typeIO; /* For the IO monad, IO */ Type typeProgIO; /* For the IO monad, IO a */ Name nameIOError, nameUserErr; /* loosely coupled IOError cfuns */ Name namePermDenied; Name nameAlreadyExists, nameAlreadyInUse, nameDoesNotExist, nameIsFull; Name nameIllegal; #endif #if IO_HANDLES Name nameEOFErr; Name nameProtocolError; #endif Name nameArithException; Name nameArrayException; Name nameErrorCall; Name nameIOException; Name nameNoMethodError; Name nameNonTermination; Name namePatternMatchFail; Name nameRecConError; Name nameRecSelError; Name nameRecUpdError; Name nameOverflow; Name nameDivideByZero; Name nameIndexOutOfBounds; Name nameUndefinedElement; #if TREX Type typeNoRow; /* Empty row */ Type typeRec; /* Record formation */ Name nameNoRec; /* Empty record */ #endif #if DOTNET Name nameNetException; #endif /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Void local emptyAssumption Args((Void)); static Void local enterBindings Args((Void)); static Void local leaveBindings Args((Void)); static Int local defType Args((Cell)); static Type local useType Args((Cell)); static Void local markAssumList Args((List)); static Cell local findAssum Args((Text)); static Pair local findInAssumList Args((Text,List)); static List local intsIntersect Args((List,List)); static List local genvarAllAss Args((List)); static List local genvarAnyAss Args((List)); static Int local newVarsBind Args((Cell)); static Void local newDefnBind Args((Cell,Type)); static Void local enterPendingBtyvs Args((Void)); static Void local leavePendingBtyvs Args((Void)); static Cell local patBtyvs Args((Cell)); static Void local doneBtyvs Args((Int)); static Void local enterSkolVars Args((Void)); static Void local leaveSkolVars Args((Int,Type,Int,Int)); static Void local typeError Args((Int,Cell,Cell,String,Type,Int)); static Void local reportTypeError Args((Int,Cell,Cell,String,Type,Type)); static Void local cantEstablish Args((Int,String,Cell,Type,List)); static Void local tooGeneral Args((Int,Cell,Type,Type)); static Cell local typeExpr Args((Int,Cell)); static Cell local typeAp Args((Int,Cell)); static Type local typeExpected Args((Int,String,Cell,Type,Int,Int,Bool)); static Void local typeAlt Args((String,Cell,Cell,Type,Int,Int)); static Int local funcType Args((Int)); static Void local typeCase Args((Int,Int,Cell)); static Void local typeComp Args((Int,Type,Cell,List)); static Cell local typeMonadComp Args((Int,Cell)); #if ZIP_COMP static Cell local typeZComp Args((Int,Type,Cell,List)); static Void local typeCompy Args((Int,Type,List)); static Cell local typeMonadZComp Args((Int,Cell)); static List local getPats Args((List)); static Cell local tupleUp Args((List)); #endif static Void local typeDo Args((Int,Cell)); #if MUDO static Void local typeRecComp Args((Int,Type,Cell,List)); static Void local typeMDo Args((Int,Cell)); static Void local typeRecursiveDo Args((Int,Cell)); #endif static Void local typeConFlds Args((Int,Cell)); static Void local typeUpdFlds Args((Int,Cell)); #if IPARAM static Cell local typeWith Args((Int,Cell)); #endif static Cell local typeFreshPat Args((Int,Cell)); static Void local typeBindings Args((List)); static Void local removeTypeSigs Args((Cell)); static Void local monorestrict Args((List)); static Void local restrictedBindAss Args((Cell)); static Void local restrictedAss Args((Int,Cell,Type)); static Void local unrestricted Args((List)); static List local itbscc Args((List)); static Void local addEvidParams Args((List,Cell)); static Void local typeClassDefn Args((Class)); static Void local typeInstDefn Args((Inst)); static Void local typeMember Args((String,Name,Cell,List,Cell,Int)); static Void local typeBind Args((Cell)); static Void local typeDefAlt Args((Int,Cell,Pair)); static Cell local typeRhs Args((Cell)); static Void local guardedType Args((Int,Cell)); static Void local genBind Args((List,Cell)); static Void local genAss Args((Int,List,Cell,Type)); static Type local genTest Args((Int,Cell,List,Type,Type,Int)); static Type local generalize Args((List,Type)); static Bool local equalTypes Args((Type,Type)); static Void local typeDefnGroup Args((List)); static Void local typeForeignExport Args((Name)); static Pair local typeSel Args((Name)); static Name local linkName Args((String)); static Tycon local linkTycon Args((String)); static Class local linkClass Args((String)); /* -------------------------------------------------------------------------- * Frequently used type skeletons: * ------------------------------------------------------------------------*/ static Type arrow; /* mkOffset(0) -> mkOffset(1) */ static Type boundPair; /* (mkOffset(0),mkOffset(0)) */ static Type listof; /* [ mkOffset(0) ] */ static Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */ static Cell predNum; /* Num (mkOffset(0)) */ static Cell predFractional; /* Fractional (mkOffset(0)) */ static Cell predIntegral; /* Integral (mkOffset(0)) */ static Kind starToStar; /* Type -> Type */ static Cell predMonad; /* Monad (mkOffset(0)) */ #if MUDO static Cell predMonadRec; /* MonadRec/MonadFix (mkOffset(0)) */ #endif /* -------------------------------------------------------------------------- * Assumptions: * * A basic typing statement is a pair (Var,Type) and an assumption contains * an ordered list of basic typing statements in which the type for a given * variable is given by the most recently added assumption about that var. * * In practice, the assumption set is split between a pair of lists, one * holding assumptions for vars defined in bindings, the other for vars * defined in patterns/binding parameters etc. The reason for this * separation is that vars defined in bindings may be overloaded (with the * overloading being unknown until the whole binding is typed), whereas the * vars defined in patterns have no overloading. A form of dependency * analysis (at least as far as calculating dependents within the same group * of value bindings) is required to implement this. Where it is known that * no overloaded values are defined in a binding (i.e., when the `dreaded * monomorphism restriction' strikes), the list used to record dependents * is flagged with a NODEPENDS tag to avoid gathering dependents at that * level. * * To interleave between vars for bindings and vars for patterns, we use * a list of lists of typing statements for each. These lists are always * the same length. The implementation here is very similar to that of the * dependency analysis used in the static analysis component of this system. * * To deal with polymorphic recursion, variables defined in bindings can be * assigned types of the form (POLYREC,(def,use)), where def is a type * variable for the type of the defining occurence, and use is a type * scheme for (recursive) calls/uses of the variable. * ------------------------------------------------------------------------*/ static List defnBounds; /*::[[(Var,Type)]] possibly ovrlded*/ static List varsBounds; /*::[[(Var,Type)]] not overloaded */ static List depends; /*::[?[Var]] dependents/NODEPENDS */ static List skolVars; /*::[[Var]] skolem vars */ static List localEvs; /*::[[(Pred,offset,ev)]] */ static List savedPs; /*::[[(Pred,offset,ev)]] */ static Cell dummyVar; /* Used to put extra tvars into ass*/ #define saveVarsAss() List saveAssump = hd(varsBounds) #define restoreVarsAss() hd(varsBounds) = saveAssump #define addVarAssump(v,t) hd(varsBounds) = cons(pair(v,t),hd(varsBounds)) #define findTopBinding(v) findInAssumList(textOf(v),hd(defnBounds)) static Void local emptyAssumption() { /* set empty type assumption */ defnBounds = NIL; varsBounds = NIL; depends = NIL; skolVars = NIL; localEvs = NIL; savedPs = NIL; } static Void local enterBindings() { /* Add new level to assumption sets */ defnBounds = cons(NIL,defnBounds); varsBounds = cons(NIL,varsBounds); depends = cons(NIL,depends); } static Void local leaveBindings() { /* Drop one level of assumptions */ defnBounds = tl(defnBounds); varsBounds = tl(varsBounds); depends = tl(depends); } static Int local defType(a) /* Return type for defining occ. */ Cell a; { /* of a var from assumption pair */ return (isPair(a) && fst(a)==POLYREC) ? fst(snd(a)) : a; } static Type local useType(a) /* Return type for use of a var */ Cell a; { /* defined in an assumption */ return (isPair(a) && fst(a)==POLYREC) ? snd(snd(a)) : a; } static Void local markAssumList(as) /* Mark all types in assumption set*/ List as; { /* :: [(Var, Type)] */ for (; nonNull(as); as=tl(as)) { /* No need to mark generic types; */ Type t = defType(snd(hd(as))); /* the only free variables in those*/ if (!isPolyType(t)) /* must have been free earlier too */ markType(t,0); } } static Cell local findAssum(t) /* Find most recent assumption about*/ Text t; { /* variable named t, if any */ List defnBounds1 = defnBounds; /* return translated variable, with */ List varsBounds1 = varsBounds; /* type in typeIs */ List depends1 = depends; while (nonNull(defnBounds1)) { Pair ass = findInAssumList(t,hd(varsBounds1));/* search varsBounds */ if (nonNull(ass)) { typeIs = snd(ass); return fst(ass); } ass = findInAssumList(t,hd(defnBounds1)); /* search defnBounds */ if (nonNull(ass)) { Cell v = fst(ass); typeIs = snd(ass); if (hd(depends1)!=NODEPENDS && /* save dependent? */ isNull(v=varIsMember(t,hd(depends1)))) /* N.B. make new copy of variable and store this on list of*/ /* dependents, and in the assumption so that all uses of */ /* the variable will be at the same node, if we need to */ /* overwrite the call of a function with a translation... */ hd(depends1) = cons(v=mkVar(t),hd(depends1)); return v; } defnBounds1 = tl(defnBounds1); /* look in next level*/ varsBounds1 = tl(varsBounds1); /* of assumption set */ depends1 = tl(depends1); } return NIL; } static Pair local findInAssumList(t,as)/* Search for assumption for var */ Text t; /* named t in list of assumptions as*/ List as; { for (; nonNull(as); as=tl(as)) if (textOf(fst(hd(as)))==t) return hd(as); return NIL; } static List local intsIntersect(as,bs) /* calculate intersection of lists */ List as, bs; { /* of integers (as sets) */ List ts = NIL; /* destructively modifies as */ while (nonNull(as)) if (intIsMember(intOf(hd(as)),bs)) { List temp = tl(as); tl(as) = ts; ts = as; as = temp; } else as = tl(as); return ts; } static List local genvarAllAss(as) /* calculate generic vars that are */ List as; { /* in every type in assumptions as */ List vs = genvarTyvar(intOf(defType(snd(hd(as)))),NIL); for (as=tl(as); nonNull(as) && nonNull(vs); as=tl(as)) vs = intsIntersect(vs,genvarTyvar(intOf(defType(snd(hd(as)))),NIL)); return vs; } static List local genvarAnyAss(as) /* calculate generic vars that are */ List as; { /* in any type in assumptions as */ List vs = genvarTyvar(intOf(defType(snd(hd(as)))),NIL); for (as=tl(as); nonNull(as); as=tl(as)) vs = genvarTyvar(intOf(defType(snd(hd(as)))),vs); return vs; } static Int local newVarsBind(v) /* make new assump for pattern var */ Cell v; { Int beta = newTyvars(1); addVarAssump(v,mkInt(beta)); #if DEBUG_TYPES Printf("variable, assume "); printExp(stdout,v); Printf(" :: _%d\n",beta); #endif return beta; } static Void local newDefnBind(v,type) /* make new assump for defn var */ Cell v; /* and set type if given (nonNull) */ Type type; { Int beta = newTyvars(1); Cell ta = mkInt(beta); instantiate(type); if (nonNull(type) && isPolyType(type)) ta = pair(POLYREC,pair(ta,type)); hd(defnBounds) = cons(pair(v,ta), hd(defnBounds)); #if DEBUG_TYPES Printf("definition, assume "); printExp(stdout,v); Printf(" :: _%d\n",beta); #endif bindTv(beta,typeIs,typeOff); /* Bind beta to new type skeleton */ } /* -------------------------------------------------------------------------- * Predicates: * ------------------------------------------------------------------------*/ #include "preds.c" /* -------------------------------------------------------------------------- * Bound and skolemized type variables: * ------------------------------------------------------------------------*/ static List pendingBtyvs = NIL; static Void local enterPendingBtyvs() { enterBtyvs(); pendingBtyvs = cons(NIL,pendingBtyvs); } static Void local leavePendingBtyvsQuietly() { pendingBtyvs = tl(pendingBtyvs); leaveBtyvs(); } static Void local leavePendingBtyvs() { List pts = hd(pendingBtyvs); pendingBtyvs = tl(pendingBtyvs); for (; nonNull(pts); pts=tl(pts)) { Int line = intOf(fst(hd(pts))); List vs = snd(hd(pts)); Int i = 0; clearMarks(); for (; nonNull(vs); vs=tl(vs)) { Cell v = fst(hd(vs)); Cell t = copyTyvar(intOf(snd(hd(vs)))); if (!isOffset(t)) { ERRMSG(line) "Type annotation uses variable " ETHEN ERREXPR(v); ERRTEXT " where a more specific type " ETHEN ERRTYPE(t); ERRTEXT " was inferred" EEND; } else if (offsetOf(t)!=i) { List us = snd(hd(pts)); Int j = offsetOf(t); if (j>=i) internal("leavePendingBtyvs"); for (; j>0; j--) us = tl(us); ERRMSG(line) "Type annotation uses distinct variables " ETHEN ERREXPR(v); ERRTEXT " and " ETHEN ERREXPR(fst(hd(us))); ERRTEXT " where a single variable was inferred" EEND; } else i++; } } leaveBtyvs(); } static Cell local patBtyvs(p) /* Strip bound type vars from pat */ Cell p; { if (whatIs(p)==BIGLAM) { List bts = hd(btyvars) = fst(snd(p)); for (p=snd(snd(p)); nonNull(bts); bts=tl(bts)) { Int beta = newTyvars(1); tyvar(beta)->kind = snd(hd(bts)); snd(hd(bts)) = mkInt(beta); } } return p; } static Void local doneBtyvs(l) Int l; { if (nonNull(hd(btyvars))) { /* Save bound tyvars */ hd(pendingBtyvs) = cons(pair(mkInt(l),hd(btyvars)),hd(pendingBtyvs)); hd(btyvars) = NIL; } } static Void local enterSkolVars() { skolVars = cons(NIL,skolVars); localEvs = cons(NIL,localEvs); savedPs = cons(preds,savedPs); preds = NIL; } static Void local leaveSkolVars(l,t,o,m) Int l; Type t; Int o; Int m; { if (nonNull(hd(localEvs))) { /* Check for local predicates */ List sks = hd(skolVars); List sps = NIL; if (isNull(sks)) { internal("leaveSkolVars"); } markAllVars(); /* Mark all variables in current */ do { /* substitution, then unmark sks. */ tyvar(intOf(fst(hd(sks))))->offs = UNUSED_GENERIC; sks = tl(sks); } while (nonNull(sks)); normPreds(l); sps = elimPredsUsing(hd(localEvs),sps); preds = revOnto(preds,sps); } if (nonNull(hd(skolVars))) { /* Check that Skolem vars do not */ List vs; /* escape their scope */ Int i = 0; clearMarks(); /* Look for occurences in the */ for (; ioffs == FIXED_TYVAR) { Cell tv = copyTyvar(vn); Type ty = liftRank2(t,o,m); ERRMSG(l) "Existentially quantified variable in inferred type" ETHEN ERRTEXT "\n*** Variable : " ETHEN ERRTYPE(tv); ERRTEXT "\n*** From pattern : " ETHEN ERREXPR(snd(hd(vs))); ERRTEXT "\n*** Result type : " ETHEN ERRTYPE(ty); ERRTEXT "\n" EEND; } } markBtyvs(); /* Now check assumptions */ mapProc(markAssumList,defnBounds); mapProc(markAssumList,varsBounds); mapProc(markPred,preds); for (vs=hd(skolVars); nonNull(vs); vs=tl(vs)) { Int vn = intOf(fst(hd(vs))); if (tyvar(vn)->offs == FIXED_TYVAR) { ERRMSG(l) "Existentially quantified variable escapes from pattern " ETHEN ERREXPR(snd(hd(vs))); ERRTEXT "\n" EEND; } } } localEvs = tl(localEvs); skolVars = tl(skolVars); preds = revOnto(preds,hd(savedPs)); savedPs = tl(savedPs); } /* -------------------------------------------------------------------------- * Type errors: * ------------------------------------------------------------------------*/ static Void local typeError(l,e,in,wh,t,o) Int l; /* line number near type error */ Cell e; /* source of error */ Cell in; /* context if any (NIL if not) */ String wh; /* place in which error occurs */ Type t; /* should be of type (t,o) */ Int o; { /* type inferred is (typeIs,typeOff) */ clearMarks(); /* types printed here are monotypes */ /* use marking to give sensible names*/ #if DEBUG_KINDS { List vs = genericVars; for (; nonNull(vs); vs=tl(vs)) { Int v = intOf(hd(vs)); Printf("%c :: ", ('a'+tyvar(v)->offs)); printKind(stdout,tyvar(v)->kind); Putchar('\n'); } } #endif reportTypeError(l,e,in,wh,copyType(typeIs,typeOff),copyType(t,o)); } static Void local reportTypeError(l,e,in,wh,inft,expt) Int l; /* Error printing part of typeError*/ Cell e, in; String wh; Type inft, expt; { ERRMSG(l) "Type error in %s", wh ETHEN if (nonNull(in)) { ERRTEXT "\n*** Expression : " ETHEN ERREXPR(in); } ERRTEXT "\n*** Term : " ETHEN ERREXPR(e); ERRTEXT "\n*** Type : " ETHEN ERRTYPE(inft); ERRTEXT "\n*** Does not match : " ETHEN ERRTYPE(expt); if (unifyFails) { ERRTEXT "\n*** Because : %s", unifyFails ETHEN } ERRTEXT "\n" EEND; } #define shouldBe(l,e,in,where,t,o) if (!unify(typeIs,typeOff,t,o)) \ typeError(l,e,in,where,t,o); #define check(l,e,in,where,t,o) e=typeExpr(l,e); shouldBe(l,e,in,where,t,o) #define inferType(t,o) typeIs=t; typeOff=o #if IPARAM #define spTypeExpr(l,e) svPreds = preds; preds = NIL; e = typeExpr(l,e); preds = revOnto(preds,svPreds); #define spCheck(l,e,in,where,t,o) svPreds = preds; preds = NIL; check(l,e,in,where,t,o); preds = revOnto(preds,svPreds); #else #define spTypeExpr(l,e) e = typeExpr(l,e); #define spCheck(l,e,in,where,t,o) check(l,e,in,where,t,o); #endif static Void local cantEstablish(line,wh,e,t,ps) Int line; /* Complain when declared preds */ String wh; /* are not sufficient to discharge */ Cell e; /* or defer the inferred context. */ Type t; List ps; { ERRMSG(line) "Cannot justify constraints in %s", wh ETHEN ERRTEXT "\n*** Expression : " ETHEN ERREXPR(e); ERRTEXT "\n*** Type : " ETHEN ERRTYPE(t); ERRTEXT "\n*** Given context : " ETHEN ERRCONTEXT(ps); ERRTEXT "\n*** Constraints : " ETHEN ERRCONTEXT(copyPreds(preds)); ERRTEXT "\n" EEND; } static Void local tooGeneral(l,e,dt,it) /* explicit type sig. too general */ Int l; Cell e; Type dt, it; { ERRMSG(l) "Inferred type is not general enough" ETHEN ERRTEXT "\n*** Expression : " ETHEN ERREXPR(e); ERRTEXT "\n*** Expected type : " ETHEN ERRTYPE(dt); ERRTEXT "\n*** Inferred type : " ETHEN ERRTYPE(it); ERRTEXT "\n" EEND; } /* -------------------------------------------------------------------------- * Typing of expressions: * ------------------------------------------------------------------------*/ #define EXPRESSION 0 /* type checking expression */ #define NEW_PATTERN 1 /* pattern, introducing new vars */ #define OLD_PATTERN 2 /* pattern, involving bound vars */ static int tcMode = EXPRESSION; #if DEBUG_TYPES static Cell local mytypeExpr Args((Int,Cell)); static Cell local typeExpr(l,e) Int l; Cell e; { static int number = 0; Cell retv; int mynumber = number++; STACK_CHECK Printf("%d) to check: ",mynumber); printExp(stdout,e); Putchar('\n'); retv = mytypeExpr(l,e); Printf("%d) result: ",mynumber); printType(stdout,debugType(typeIs,typeOff)); Printf("\n%d) preds: ",mynumber); printContext(stdout,debugContext(preds)); Putchar('\n'); return retv; } static Cell local mytypeExpr(l,e) /* Determine type of expr/pattern */ #else static Cell local typeExpr(l,e) /* Determine type of expr/pattern */ #endif Int l; Cell e; { static String cond = "conditional"; static String list = "list"; static String discr = "case discriminant"; static String aspat = "as (@) pattern"; static String typeSig = "type annotation"; static String lambda = "lambda expression"; #if IPARAM List svPreds; #endif switch (whatIs(e)) { /* The following cases can occur in either pattern or expr. mode */ case AP : case NAME : case VAROPCELL : case VARIDCELL : #if IPARAM case IPVAR : #endif return typeAp(l,e); case TUPLE : typeTuple(e); break; #if BIGNUMS case POSNUM : case ZERONUM : case NEGNUM : { Int alpha = newTyvars(1); inferType(aVar,alpha); return ap(ap(nameFromInteger, assumeEvid(predNum,alpha)), e); } #endif case INTCELL : { Int alpha = newTyvars(1); inferType(aVar,alpha); return ap(ap(nameFromInt, assumeEvid(predNum,alpha)), e); } case DOUBLECELL : { Int alpha = newTyvars(1); inferType(aVar,alpha); return ap(ap(nameFromDouble, assumeEvid(predFractional,alpha)), e); } case STRCELL : inferType(typeString,0); break; case CHARCELL : inferType(typeChar,0); break; case CONFLDS : typeConFlds(l,e); break; case ESIGN : snd(snd(e)) = localizeBtyvs(snd(snd(e))); return typeExpected(l,typeSig, fst(snd(e)),snd(snd(e)), 0,0,FALSE); #if TREX case EXT : { Int beta = newTyvars(2); Cell pi = ap(e,aVar); Type t = fn(aVar, fn(ap(typeRec,bVar), ap(typeRec,ap(ap(e,aVar),bVar)))); tyvar(beta+1)->kind = ROW; inferType(t,beta); return ap(e,assumeEvid(pi,beta+1)); } #endif /* The following cases can only occur in expr mode */ case UPDFLDS : typeUpdFlds(l,e); break; #if IPARAM case WITHEXP : return typeWith(l,e); #endif case COND : { Int beta = newTyvars(1); check(l,fst3(snd(e)),e,cond,typeBool,0); spCheck(l,snd3(snd(e)),e,cond,aVar,beta); spCheck(l,thd3(snd(e)),e,cond,aVar,beta); tyvarType(beta); } break; case LETREC : enterBindings(); enterSkolVars(); mapProc(typeBindings,fst(snd(e))); spTypeExpr(l,snd(snd(e))); leaveBindings(); leaveSkolVars(l,typeIs,typeOff,0); break; case FINLIST : { Int beta = newTyvars(1); List xs; for (xs=snd(e); nonNull(xs); xs=tl(xs)) { spCheck(l,hd(xs),e,list,aVar,beta); } inferType(listof,beta); } break; case DOCOMP : typeDo(l,e); break; #if MUDO case MDOCOMP : typeMDo(l,e); break; #endif case COMP : return typeMonadComp(l,e); #if ZIP_COMP case ZCOMP : return typeMonadZComp(l,e); #endif case CASE : { Int beta = newTyvars(2); /* discr result */ check(l,fst(snd(e)),NIL,discr,aVar,beta); map2Proc(typeCase,l,beta,snd(snd(e))); tyvarType(beta+1); } break; case LAMBDA : { Int beta = newTyvars(1); enterPendingBtyvs(); typeAlt(lambda,e,snd(e),aVar,beta,1); leavePendingBtyvs(); tyvarType(beta); } break; #if TREX case RECSEL : { Int beta = newTyvars(2); Cell pi = ap(snd(e),aVar); Type t = fn(ap(typeRec, ap(ap(snd(e),aVar), bVar)),aVar); tyvar(beta+1)->kind = ROW; inferType(t,beta); return ap(e,assumeEvid(pi,beta+1)); } #endif /* The remaining cases can only occur in pattern mode: */ case WILDCARD : inferType(aVar,newTyvars(1)); break; case ASPAT : { Int beta = newTyvars(1); snd(snd(e)) = typeExpr(l,snd(snd(e))); bindTv(beta,typeIs,typeOff); check(l,fst(snd(e)),e,aspat,aVar,beta); tyvarType(beta); } break; case LAZYPAT : snd(e) = typeExpr(l,snd(e)); break; #if NPLUSK case ADDPAT : { Int alpha = newTyvars(1); inferType(typeVarToVar,alpha); return ap(e,assumeEvid(predIntegral,alpha)); } #endif default : internal("typeExpr"); } return e; } /* -------------------------------------------------------------------------- * Typing rules for particular special forms: * ------------------------------------------------------------------------*/ static Cell local typeAp(l,e) /* Type check application, which */ Int l; /* may be headed with a variable */ Cell e; { /* requires polymorphism, qualified*/ static String app = "application"; /* types, and possible rank2 args. */ Cell h = getHead(e); Int n = argCount; Cell p = NIL; Cell a = e; Int i; #if IPARAM List svPreds; #endif switch (whatIs(h)) { case NAME : typeIs = name(h).type; break; case VAROPCELL : case VARIDCELL : if (tcMode==NEW_PATTERN) { inferType(aVar,newVarsBind(e)); } else { Cell v = findAssum(textOf(h)); if (nonNull(v)) { h = v; typeIs = (tcMode==OLD_PATTERN) ? defType(typeIs) : useType(typeIs); } else { h = findName(textOf(h)); if (isNull(h)) internal("typeAp0"); typeIs = name(h).type; } } break; #if IPARAM case IPVAR : { Text t = textOf(h); Int alpha = newTyvars(1); Cell ip = pair(ap(IPCELL,t),aVar); Cell ev = assumeEvid(ip,alpha); typeIs = mkInt(alpha); h = ap(h,ev); } break; #endif default : h = typeExpr(l,h); break; } if (isNull(typeIs)) internal("typeAp1"); instantiate(typeIs); /* Deal with polymorphism ... */ if (nonNull(predsAre)) { /* ... and with qualified types. */ List evs = NIL; for (; nonNull(predsAre); predsAre=tl(predsAre)) { evs = cons(assumeEvid(hd(predsAre),typeOff),evs); } if (!isName(h) || !isCfun(h)) { h = applyToArgs(h,rev(evs)); } } if (whatIs(typeIs)==CDICTS) { /* Deal with local dictionaries */ List evs = makePredAss(fst(snd(typeIs)),typeOff); List ps = evs; typeIs = snd(snd(typeIs)); for (; nonNull(ps); ps=tl(ps)) { h = ap(h,thd3(hd(ps))); } if (tcMode==EXPRESSION) { preds = revOnto(evs,preds); } else { hd(localEvs) = revOnto(evs,hd(localEvs)); } } if (whatIs(typeIs)==EXIST) { /* Deal with existential arguments */ Int n = intOf(fst(snd(typeIs))); typeIs = snd(snd(typeIs)); if (!isCfun(getHead(h)) || n>typeFree) { internal("typeAp2"); } else if (tcMode!=EXPRESSION) { Int alpha = typeOff + typeFree; for (; n>0; n--) { bindTv(alpha-n,SKOLEM,0); hd(skolVars) = cons(pair(mkInt(alpha-n),e),hd(skolVars)); } } } if (whatIs(typeIs)==RANK2) { /* Deal with rank 2 arguments */ Int alpha = typeOff; Int m = typeFree; Int nr2 = intOf(fst(snd(typeIs))); Type body = snd(snd(typeIs)); List as = e; Bool added = FALSE; if (n1) { ERRTEXT " in " ETHEN ERREXPR(e); } ERRTEXT " requires at least %d argument%s\n", nr2, (nr2==1 ? "" : "s") EEND; } for (i=nr2; i0 && !added) { for (i=0; i0) { /* Deal with remaining args */ Int beta = funcType(n); /* check h::t1->t2->...->tn->rn+1 */ shouldBe(l,h,e,app,aVar,beta); for (i=n; i>0; --i) { /* check e_i::t_i for each i */ spCheck(l,arg(a),e,app,aVar,beta+2*i-1); p = a; a = fun(a); } tyvarType(beta+2*n); /* Inferred type is r_n+1 */ } if (isNull(p)) /* Replace head with translation */ e = h; else fun(p) = h; return e; } static Cell local typeExpected(l,wh,e,reqd,alpha,n,addEvid) Int l; /* Type check expression e in wh */ String wh; /* at line l, expecting type reqd, */ Cell e; /* and treating vars alpha through */ Type reqd; /* (alpha+n-1) as fixed. */ Int alpha; Int n; Bool addEvid; { /* TRUE => add \ev -> ... */ List savePreds = preds; Type t; Int o; Int m; List ps; Int i; instantiate(reqd); t = typeIs; o = typeOff; m = typeFree; ps = makePredAss(predsAre,o); preds = NIL; check(l,e,NIL,wh,t,o); improve(l,ps,preds); clearMarks(); mapProc(markAssumList,defnBounds); mapProc(markAssumList,varsBounds); mapProc(markPred,savePreds); markBtyvs(); if (n > 0) { /* mark alpha thru alpha+n-1, plus any */ /* type vars that are functionally */ List us = NIL, vs = NIL; /* dependent on them */ List fds = calcFunDepsPreds(preds); for (i=0; i0 && !added) { Int i = 0; for (; i r_i+1 */ for (i=0; i rhs */ Int l; /* (case given by c == (pat,rhs)) */ Int beta; /* need: pat :: (var,beta) */ Cell c; { /* rhs :: (var,beta+1) */ static String casePat = "case pattern"; static String caseExpr = "case expression"; saveVarsAss(); enterSkolVars(); fst(c) = typeFreshPat(l,patBtyvs(fst(c))); shouldBe(l,fst(c),NIL,casePat,aVar,beta); snd(c) = typeRhs(snd(c)); shouldBe(l,rhsExpr(snd(c)),NIL,caseExpr,aVar,beta+1); restoreVarsAss(); doneBtyvs(l); leaveSkolVars(l,typeIs,typeOff,0); } static Void local typeComp(l,m,e,qs) /* type check comprehension */ Int l; Type m; /* monad (mkOffset(0)) */ Cell e; List qs; { static String boolQual = "boolean qualifier"; static String genQual = "generator"; #if IPARAM List svPreds; #endif STACK_CHECK if (isNull(qs)) { /* no qualifiers left */ spTypeExpr(l,fst(e)); } else { Cell q = hd(qs); List qs1 = tl(qs); switch (whatIs(q)) { case BOOLQUAL : spCheck(l,snd(q),NIL,boolQual,typeBool,0); typeComp(l,m,e,qs1); break; case QWHERE : enterBindings(); enterSkolVars(); mapProc(typeBindings,snd(q)); typeComp(l,m,e,qs1); leaveBindings(); leaveSkolVars(l,typeIs,typeOff,0); break; case FROMQUAL : { Int beta = newTyvars(1); saveVarsAss(); enterPendingBtyvs(); spCheck(l,snd(snd(q)),NIL,genQual,m,beta); enterSkolVars(); fst(snd(q)) = typeFreshPat(l,patBtyvs(fst(snd(q)))); shouldBe(l,fst(snd(q)),NIL,genQual,aVar,beta); typeComp(l,m,e,qs1); restoreVarsAss(); leavePendingBtyvs(); leaveSkolVars(l,typeIs,typeOff,0); } break; case DOQUAL : spCheck(l,snd(q),NIL,genQual,m,newTyvars(1)); typeComp(l,m,e,qs1); break; } } } #if ZIP_COMP /* -------------------------------------------------------------------------- * Parallel comprehensions * * This is an extension to the standard list comprehension notation, * allowing parallel lists of qualifiers that generate independently * of each other. Parallel qualifier lists are separated with additional * `|' symbols: * [ e | p1 <- e11, p2 <- e12, ... * | q1 <- e21, q2 <- e22, ... * ... ] * * The meaning of a parallel comprehension can be defined in terms of zip * and a regular comprehension: * [ e | ((p1,p2), (q1,q2)) <- zip [(p1,p2) | p1 <- e11, p2 <- e12] * [(q1,q2) | q1 <- e21, q2 <- e22]] * The use of let-bindings in the qualifier lists complicates this slightly. * Let-bound variables will scope over the rest of their qualifier list * as well as `e', but not over any part of a parallel qualifier list. * We can express this in the translation by including in the derived * patterns all the let-bound variables: * [ e | p1 <- e11, let v1 = e12, p2 <- e13 * | q1 <- e21, let v2 = e22, q2 <- e23] * => * [ e | ((p1,v1,p2), (q1,v2,q2)) <- * zip [(p1,v1,p2) | p1 <- e11, let v1 = e12, p2 <- e13] * [(q1,v2,q2) | q1 <- e21, let v2 = e22, q2 <- e23]] * Where it is understood that the `v' patterns in the tuples are given * rank-2 types, so we don't lose the polymorphism. We also have to be * careful to preserve any shadowing. * * ZZ We aren't dealing with WHEREs correctly... * ZZ We aren't dealing with skolem vars correctly... * ------------------------------------------------------------------------*/ static List gatheredAss; static List gatheredDefns; static List gatheredTyvars; static List gatheredPTyvars; #define enterGathering() List svGA = gatheredAss, svGD = gatheredDefns, svGT = gatheredTyvars, svGP = gatheredPTyvars; gatheredAss = gatheredDefns = gatheredTyvars = gatheredPTyvars = NIL #define leaveGathering() gatheredAss = svGA; gatheredDefns = svGD; gatheredTyvars = svGT; gatheredPTyvars = svGP static List local getPats(bs) List bs; { List ps = NIL; for (; nonNull(bs); bs=tl(bs)) { ps = cons(fst(hd(bs)), ps); } return ps; } static Cell local tupleUp(xs) List xs; { Int n = length(xs); if (n == 0) return nameUnit; else if (n == 1) return hd(xs); else { Cell x = mkTuple(n); for (; nonNull(xs); xs=tl(xs)) x = ap(x, hd(xs)); return x; } } static Cell local typeZComp(l,m,e,qss) /* type check comprehension */ Int l; Type m; /* monad (mkOffset(0)) */ Cell e; List qss; { List pss, ass; List zpat, zexp; Int len; Text zName; #if IPARAM List svPreds; #endif enterGathering(); enterBindings(); for (pss = qss;nonNull(pss);pss=tl(pss)) { gatheredAss = cons(NIL,gatheredAss); gatheredDefns = cons(NIL,gatheredDefns); typeCompy(l,m,hd(pss)); /* reset for next list of qualifiers */ hd(varsBounds) = NIL; } /* add gathered vars */ hd(varsBounds) = revOnto(concat(gatheredAss),hd(varsBounds)); enterBindings(); hd(defnBounds) = revOnto(concat(gatheredDefns),hd(defnBounds)); enterPendingBtyvs(); hd(btyvars) = gatheredTyvars; hd(pendingBtyvs) = gatheredPTyvars; spTypeExpr(l,fst(e)); leavePendingBtyvs(); leaveBindings(); leaveBindings(); /* now, we construct a regular comprehension out of the parallel one */ len = length(qss); zName = zipName(len); zpat = mkTuple(len); zexp = findQualFun(findText("Data.List"),zName); if (isNull(zexp)) zexp = findQualFun(findText("List"),zName); if (isNull(zexp)) { /* if they don't have List loaded, we can still handle the most common cases, because `zip' and `zip3' are defined in the Prelude */ zexp = findQualFun(textPrelude,zName); } if (isNull(zexp)) { ERRMSG(l) "\"%s\" not in scope (introduced by parallel comprehension)", textToStr(zName) ETHEN ERRTEXT "\n*** Possible cause: \"List\" module not imported" EEND; } for (pss=qss, ass=rev(gatheredAss);nonNull(pss);pss=tl(pss), ass=tl(ass)) { List ps = tupleUp(getPats(hd(ass))); zpat = ap(zpat, ps); zexp = ap(zexp, ap(MONADCOMP,pair(nameListMonad,pair(ps, hd(pss))))); } leaveGathering(); return pair(fst(e),singleton(ap(FROMQUAL,pair(zpat,zexp)))); } static Void local typeCompy(l,m,qs) /* type check comprehension */ Int l; Type m; /* monad (mkOffset(0)) */ List qs; { static String boolQual = "boolean qualifier"; static String genQual = "generator"; #if IPARAM List svPreds; #endif STACK_CHECK if (!isNull(qs)) { /* no qualifiers left */ Cell q = hd(qs); List qs1 = tl(qs); switch (whatIs(q)) { case BOOLQUAL : spCheck(l,snd(q),NIL,boolQual,typeBool,0); typeCompy(l,m,qs1); break; case QWHERE : enterBindings(); enterSkolVars(); mapProc(typeBindings,snd(q)); hd(gatheredAss) = dupOnto(hd(varsBounds),hd(gatheredAss)); /* ZZ what is gatheredDefns used for ??? */ hd(gatheredDefns) = dupOnto(hd(defnBounds),hd(gatheredDefns)); typeCompy(l,m,qs1); leaveBindings(); leaveSkolVars(l,typeIs,typeOff,0); break; case FROMQUAL : { Int beta = newTyvars(1); enterPendingBtyvs(); spCheck(l,snd(snd(q)),NIL,genQual,m,beta); enterSkolVars(); fst(snd(q)) = typeFreshPat(l,patBtyvs(fst(snd(q)))); shouldBe(l,fst(snd(q)),NIL,genQual,aVar,beta); hd(gatheredAss) = dupOnto(hd(varsBounds),hd(gatheredAss)); gatheredTyvars = dupOnto(hd(btyvars),gatheredTyvars); gatheredPTyvars = dupOnto(hd(pendingBtyvs),gatheredPTyvars); typeCompy(l,m,qs1); leavePendingBtyvsQuietly(); leaveSkolVars(l,typeIs,typeOff,0); } break; case DOQUAL : spCheck(l,snd(q),NIL,genQual,m,newTyvars(1)); typeCompy(l,m,qs1); break; default: internal("typeComp"); } } } #endif static Cell local typeMonadComp(l,e) /* type check monad comprehension */ Int l; Cell e; { Int alpha = newTyvars(1); Int beta = newTyvars(1); Cell mon = ap(mkInt(beta),aVar); Cell m = assumeEvid(predMonad,beta); tyvar(beta)->kind = starToStar; #if !MONAD_COMPS bindTv(beta,typeList,0); m = nameListMonad; #endif typeComp(l,mon,snd(e),snd(snd(e))); bindTv(alpha,typeIs,typeOff); inferType(mon,alpha); return ap(MONADCOMP,pair(m,snd(e))); } #if ZIP_COMP static Cell local typeMonadZComp(l,e) /* type check monad comprehension */ Int l; Cell e; { Int alpha = newTyvars(1); Int beta = newTyvars(1); Cell mon = ap(mkInt(beta),aVar); Cell m = assumeEvid(predMonad,beta); Cell new; tyvar(beta)->kind = starToStar; #if !MONAD_COMPS bindTv(beta,typeList,0); m = nameListMonad; #endif new = typeZComp(l,mon,snd(e),snd(snd(e))); bindTv(alpha,typeIs,typeOff); inferType(mon,alpha); return ap(MONADCOMP,pair(m,new)); } #endif static Void local typeDo(l,e) /* type check do-notation */ Int l; Cell e; { static String finGen = "final generator"; Int alpha = newTyvars(1); Int beta = newTyvars(1); Cell mon = ap(mkInt(beta),aVar); Cell m = assumeEvid(predMonad,beta); tyvar(beta)->kind = starToStar; typeComp(l,mon,snd(e),snd(snd(e))); shouldBe(l,fst(snd(e)),NIL,finGen,mon,alpha); snd(e) = pair(m,snd(e)); } #if MUDO #define segRecs(seg) fst3(fst(seg)) #define segExps(seg) snd3(fst(seg)) #define segDefs(seg) thd3(fst(seg)) #define segQuals(seg) snd(seg) static Void local typeRecComp(l,m,e,qs) /* type check rec-comp */ Int l; Type m; /* monad (mkOffset(0)) */ Cell e; List qs; { static String boolQual = "boolean qualifier"; static String genQual = "generator"; static String letQual = "mdo-transformed let generator"; String mesg = genQual; #if IPARAM List svPreds; #endif STACK_CHECK if (isNull(qs)) { /* no qualifiers left */ spTypeExpr(l,fst(e)); } else { Cell q = hd(qs); List qs1 = tl(qs); switch (whatIs(q)) { case BOOLQUAL : spCheck(l,snd(q),NIL,boolQual,typeBool,0); typeRecComp(l,m,e,qs1); break; case QWHERE : mesg = letQual; fst(q) = FROMQUAL; /* intentional fall-thru */ case FROMQUAL : { Int beta = newTyvars(1); saveVarsAss(); enterPendingBtyvs(); spCheck(l,snd(snd(q)),NIL,mesg,m,beta); enterSkolVars(); tcMode = OLD_PATTERN; fst(snd(q)) = typeExpr(l,patBtyvs(fst(snd(q)))); tcMode = EXPRESSION; shouldBe(l,fst(snd(q)),NIL,mesg,aVar,beta); typeRecComp(l,m,e,qs1); restoreVarsAss(); leavePendingBtyvs(); leaveSkolVars(l,typeIs,typeOff,0); } break; case DOQUAL : spCheck(l,snd(q),NIL,genQual,m,newTyvars(1)); typeRecComp(l,m,e,qs1); break; } } } static Void local typeMDo(l,e) /* type check recursive-do */ Int l; Cell e; { String fixLib = "Control.Monad.Fix"; String fixClass = "MonadFix"; if( !classMonadRec ) { ERRMSG(0) "%s class not defined", fixClass ETHEN ERRTEXT "\n*** Possible cause: \"%s\" module not imported", fixLib EEND; } predMonadRec = ap(classMonadRec,aVar); /* Now we're safe: do the actual type-checking now: */ typeRecursiveDo(l,e); } static Void local typeRecursiveDo(l,e) /* type check recursive-do exp. */ Int l; Cell e; { /* The structure at this point: e = (TAG, (1, [((2, 3, 4), 5)])) where 1 = expression 2 = rec vars of the segment 3 = exported vars of the segment 4 = defined vars of the segment 5 = qualifiers */ static String finGen = "final generator"; Int alpha = newTyvars(1); Int beta = newTyvars(1); Cell mon = ap(mkInt(beta),aVar); Cell monDict = assumeEvid(predMonad,beta); Cell m = assumeEvid(predMonadRec,beta); List tmp; List whole = NIL; tyvar(beta)->kind = starToStar; enterBindings(); /* introduce defined variables into the typing environment: */ for(tmp = snd(snd(e)); nonNull(tmp); tmp = tl(tmp)) { List rtmp = segDefs(hd(tmp)); for(; nonNull(rtmp); rtmp = tl(rtmp)) { newVarsBind(hd(rtmp)); } } /* collect all qualifiers from all segments: */ for(tmp = snd(snd(e)); nonNull(tmp); tmp = tl(tmp)) { List tmp2; for(tmp2 = segQuals(hd(tmp)); nonNull(tmp2); tmp2 = tl(tmp2)) { whole=cons(hd(tmp2),whole); } } typeRecComp(l,mon,snd(e),rev(whole)); shouldBe(l,fst(snd(e)),NIL,finGen,mon,alpha); leaveBindings(); snd(e) = pair(pair(m,monDict),snd(e)); } #undef segRecs #undef segExps #undef segDefs #undef segQuals #endif static Void local typeConFlds(l,e) /* Type check a construction */ Int l; Cell e; { static String conExpr = "value construction"; Name c = fst(snd(e)); List fs = snd(snd(e)); Type tc; Int to; Int tf; Int i; #if IPARAM List svPreds; #endif instantiate(name(c).type); for (; nonNull(predsAre); predsAre=tl(predsAre)) assumeEvid(hd(predsAre),typeOff); if (whatIs(typeIs)==RANK2) typeIs = snd(snd(typeIs)); tc = typeIs; to = typeOff; tf = typeFree; for (; nonNull(fs); fs=tl(fs)) { Type t = tc; for (i=sfunPos(fst(hd(fs)),c); --i>0; t=arg(t)) ; t = dropRank1(arg(fun(t)),to,tf); if (isPolyOrQualType(t)) snd(hd(fs)) = typeExpected(l,conExpr,snd(hd(fs)),t,to,tf,TRUE); else { spCheck(l,snd(hd(fs)),e,conExpr,t,to); } } for (i=name(c).arity; i>0; i--) tc = arg(tc); inferType(tc,to); } static Void local typeUpdFlds(line,e) /* Type check an update */ Int line; /* (Written in what might seem a */ Cell e; { /* bizarre manner for the benefit */ static String update = "update"; /* of as yet unreleased extensions)*/ List cs = snd3(snd(e)); /* List of constructors */ List fs = thd3(snd(e)); /* List of field specifications */ List ts = NIL; /* List of types for fields */ Int n = length(fs); Int alpha = newTyvars(2+n); Int i; List fs1; #if IPARAM List svPreds; #endif /* Calculate type and translation for each expr in the field list */ for (fs1=fs, i=alpha+2; nonNull(fs1); fs1=tl(fs1), i++) { spTypeExpr(line,snd(hd(fs1))); bindTv(i,typeIs,typeOff); } clearMarks(); mapProc(markAssumList,defnBounds); mapProc(markAssumList,varsBounds); mapProc(markPred,preds); markBtyvs(); for (fs1=fs, i=alpha+2; nonNull(fs1); fs1=tl(fs1), i++) { resetGenerics(); ts = cons(generalize(NIL,copyTyvar(i)),ts); } ts = rev(ts); /* Type check expression to be updated */ spTypeExpr(line,fst3(snd(e))); bindTv(alpha,typeIs,typeOff); for (; nonNull(cs); cs=tl(cs)) { /* Loop through constrs */ Name c = hd(cs); List ta = replicate(name(c).arity,NIL); Type td, tr; Int od, or; tcMode = NEW_PATTERN; /* Domain type */ instantiate(name(c).type); tcMode = EXPRESSION; td = typeIs; od = typeOff; for (; nonNull(predsAre); predsAre=tl(predsAre)) assumeEvid(hd(predsAre),typeOff); if (whatIs(td)==RANK2) /* Skip rank2 annotation, if any */ td = snd(snd(td)); instantiate(name(c).type); /* Range type */ tr = typeIs; or = typeOff; for (; nonNull(predsAre); predsAre=tl(predsAre)) assumeEvid(hd(predsAre),typeOff); if (whatIs(tr)==RANK2) /* Skip rank2 annotation, if any */ tr = snd(snd(tr)); for (fs1=fs, i=1; nonNull(fs1); fs1=tl(fs1), i++) { Int n = sfunPos(fst(hd(fs1)),c); Cell ta1 = ta; for (; n>1; n--) ta1 = tl(ta1); hd(ta1) = mkInt(i); } for (; nonNull(ta); ta=tl(ta)) { /* For each cfun arg */ if (nonNull(hd(ta))) { /* Field to updated? */ Int n = intOf(hd(ta)); Cell f = fs; Cell t = ts; for (; n-- > 1; f=tl(f), t=tl(t)) ; if (isPolyOrQualType(arg(fun(td)))) { ERRMSG(line) "Sorry, record update syntax cannot currently be used for polymorphic components" EEND; } f = hd(f); t = hd(t); instantiate(t); shouldBe(line,snd(f),e,update,arg(fun(tr)),or); } /* Unmentioned component */ else if (!unify(arg(fun(td)),od,arg(fun(tr)),or)) internal("typeUpdFlds"); tr = arg(tr); td = arg(td); } inferType(td,od); /* Check domain type */ shouldBe(line,fst3(snd(e)),e,update,aVar,alpha); inferType(tr,or); /* Check range type */ shouldBe(line,e,NIL,update,aVar,alpha+1); } /* (typeIs,typeOff) still carry the result type when we exit the loop */ } #if IPARAM static Cell local typeWith(line,e) /* Type check a with */ Int line; Cell e; { List fs = snd(snd(e)); /* List of field specifications */ Int n = length(fs); Int alpha = newTyvars(2+n); Int i; List fs1; Cell tIs; Cell tOff; List dpreds = NIL, dp; Cell bs = NIL; /* Type check expression to be updated */ fst(snd(e)) = typeExpr(line,fst(snd(e))); bindTv(alpha,typeIs,typeOff); tIs = typeIs; tOff = typeOff; /* elim duplicates */ improve(line,NIL,preds); preds = scSimplify(preds); /* extract preds that we're going to bind */ for (fs1=fs; nonNull(fs1); fs1=tl(fs1)) { Text t = textOf(fst(hd(fs1))); Cell p = findIPEvid(t); dpreds = cons(p, dpreds); if (nonNull(p)) { removeIPEvid(t); } else { /* maybe give a warning message here... */ } } dpreds = rev(dpreds); /* Calculate type and translation for each expr in the field list */ for (fs1=fs, dp=dpreds, i=alpha+2; nonNull(fs1); fs1=tl(fs1), dp=tl(dp), i++) { static String with = "with"; Cell ev = hd(dp); snd(hd(fs1)) = typeExpr(line,snd(hd(fs1))); bindTv(i,typeIs,typeOff); if (nonNull(ev)) { shouldBe(line,fst(hd(fs1)),e,with,snd(fst3(ev)),intOf(snd3(ev))); bs = cons(cons(pair(thd3(ev), cons(triple(NIL, mkInt(line), snd(hd(fs1))), NIL)), NIL), bs); } } typeIs = tIs; typeOff = tOff; return (ap(LETREC,pair(bs,fst(snd(e))))); } #endif static Cell local typeFreshPat(l,p) /* find type of pattern, assigning */ Int l; /* fresh type variables to each var */ Cell p; { /* bound in the pattern */ tcMode = NEW_PATTERN; p = typeExpr(l,p); tcMode = EXPRESSION; return p; } /* -------------------------------------------------------------------------- * Type check group of bindings: * ------------------------------------------------------------------------*/ static Void local typeBindings(bs) /* type check a binding group */ List bs; { Bool usesPatBindings = FALSE; /* TRUE => pattern binding in bs */ Bool usesUntypedVar = FALSE; /* TRUE => var bind w/o type decl */ List bs1; /* The following loop is used to determine whether the monomorphism */ /* restriction should be applied. It could be written marginally more */ /* efficiently by using breaks, but clarity is more important here ... */ for (bs1=bs; nonNull(bs1); bs1=tl(bs1)) { /* Analyse binding group */ Cell b = hd(bs1); if (!isVar(fst(b))) usesPatBindings = TRUE; else if (isNull(fst(hd(snd(snd(b))))) /* no arguments */ && whatIs(fst(snd(b)))==IMPDEPS) /* implicitly typed*/ usesUntypedVar = TRUE; } if (usesPatBindings || usesUntypedVar) monorestrict(bs); else unrestricted(bs); elimTauts(); /* clean up any additional */ /* tauts that arose due to */ /* late-stage `improvement' */ mapProc(removeTypeSigs,bs); /* Remove binding type info */ hd(varsBounds) = revOnto(hd(defnBounds), /* transfer completed assmps*/ hd(varsBounds)); /* out of defnBounds */ hd(defnBounds) = NIL; hd(depends) = NIL; } static Void local removeTypeSigs(b) /* Remove type info from a binding */ Cell b; { snd(b) = snd(snd(b)); } /* -------------------------------------------------------------------------- * Type check a restricted binding group: * ------------------------------------------------------------------------*/ static Void local monorestrict(bs) /* Type restricted binding group */ List bs; { List savePreds = preds; Int line = isVar(fst(hd(bs))) ? rhsLine(snd(hd(snd(snd(hd(bs)))))) : rhsLine(snd(snd(snd(hd(bs))))); hd(defnBounds) = NIL; hd(depends) = NODEPENDS; /* No need for dependents here */ preds = NIL; /* Type check the bindings */ mapProc(restrictedBindAss,bs); mapProc(typeBind,bs); improve(line,NIL,preds); normPreds(line); elimTauts(); preds = revOnto(preds,savePreds); clearMarks(); /* Mark fixed variables */ mapProc(markAssumList,tl(defnBounds)); mapProc(markAssumList,tl(varsBounds)); mapProc(markPred,preds); markBtyvs(); if (isNull(tl(defnBounds))) { /* Top-level may need defaulting */ normPreds(line); if (nonNull(preds) && resolveDefs(genvarAnyAss(hd(defnBounds)),FALSE)) elimTauts(); clearMarks(); reducePreds(); improve(line,NIL,preds); if (nonNull(preds)) resolveDefs(NIL,FALSE); /* Nearly Haskell 1.4? */ elimTauts(); if (nonNull(preds)) { /* Look for unresolved overloading */ Cell v = isVar(fst(hd(bs))) ? fst(hd(bs)) : hd(fst(hd(bs))); Cell ass = findInAssumList(textOf(v),hd(varsBounds)); preds = scSimplify(preds); ERRMSG(line) "Unresolved top-level overloading" ETHEN ERRTEXT "\n*** Binding : %s", textToStr(textOf(v)) ETHEN if (nonNull(ass)) { ERRTEXT "\n*** Inferred type : " ETHEN ERRTYPE(snd(ass)); } ERRTEXT "\n*** Outstanding context : " ETHEN ERRCONTEXT(copyPreds(preds)); ERRTEXT "\n" EEND; } } map1Proc(genBind,NIL,bs); /* Generalize types of def'd vars */ } static Void local restrictedBindAss(b) /* Make assums for vars in binding */ Cell b; { /* gp with restricted overloading */ if (isVar(fst(b))) { /* function-binding? */ Cell t = fst(snd(b)); if (whatIs(t)==IMPDEPS) { /* Discard implicitly typed deps */ fst(snd(b)) = t = NIL; /* in a restricted binding group. */ } fst(snd(b)) = localizeBtyvs(t); restrictedAss(rhsLine(snd(hd(snd(snd(b))))), fst(b), t); } else { /* pattern-binding? */ List vs = fst(b); List ts = fst(snd(b)); Int line = rhsLine(snd(snd(snd(b)))); for (; nonNull(vs); vs=tl(vs)) { if (nonNull(ts)) { restrictedAss(line,hd(vs),hd(ts)=localizeBtyvs(hd(ts))); ts = tl(ts); } else { restrictedAss(line,hd(vs),NIL); } } } } static Void local restrictedAss(l,v,t) /* Assume that type of binding var v*/ Int l; /* is t (if nonNull) in restricted */ Cell v; /* binding group */ Type t; { newDefnBind(v,t); if (nonNull(predsAre)) { ERRMSG(l) "Explicit overloaded type for \"%s\"",textToStr(textOf(v)) ETHEN ERRTEXT " not permitted in restricted binding" EEND; } } /* -------------------------------------------------------------------------- * Unrestricted binding group: * ------------------------------------------------------------------------*/ static Void local unrestricted(bs) /* Type unrestricted binding group */ List bs; { List savePreds = preds; List imps = NIL; /* Implicitly typed bindings */ List exps = NIL; /* Explicitly typed bindings */ List bs1; /* ---------------------------------------------------------------------- * STEP 1: Separate implicitly typed bindings from explicitly typed * bindings and do a dependency analyis, where f depends on g iff f * is implicitly typed and involves a call to g. * --------------------------------------------------------------------*/ for (; nonNull(bs); bs=tl(bs)) { Cell b = hd(bs); if (whatIs(fst(snd(b)))==IMPDEPS) imps = cons(b,imps); /* N.B. New lists are built to */ else /* avoid breaking the original */ exps = cons(b,exps); /* list structure for bs. */ } for (bs=imps; nonNull(bs); bs=tl(bs)) { Cell b = hd(bs); /* Restrict implicitly typed dep */ List ds = snd(fst(snd(b))); /* lists to bindings in imps */ List cs = NIL; while (nonNull(ds)) { bs1 = tl(ds); if (cellIsMember(hd(ds),imps)) { tl(ds) = cs; cs = ds; } ds = bs1; } fst(snd(b)) = cs; } imps = itbscc(imps); /* Dependency analysis on imps */ for (bs=imps; nonNull(bs); bs=tl(bs)) for (bs1=hd(bs); nonNull(bs1); bs1=tl(bs1)) fst(snd(hd(bs1))) = NIL; /* reset imps type fields */ #if DEBUG_DEPENDS Printf("Binding group:"); for (bs1=imps; nonNull(bs1); bs1=tl(bs1)) { Printf(" [imp:"); for (bs=hd(bs1); nonNull(bs); bs=tl(bs)) Printf(" %s",textToStr(textOf(fst(hd(bs))))); Printf("]"); } if (nonNull(exps)) { Printf(" [exp:"); for (bs=exps; nonNull(bs); bs=tl(bs)) Printf(" %s",textToStr(textOf(fst(hd(bs))))); Printf("]"); } Printf("\n"); #endif /* ---------------------------------------------------------------------- * STEP 2: Add type assumptions about any explicitly typed variable. * --------------------------------------------------------------------*/ for (bs=exps; nonNull(bs); bs=tl(bs)) { fst(snd(hd(bs))) = localizeBtyvs(fst(snd(hd(bs)))); hd(varsBounds) = cons(pair(fst(hd(bs)),fst(snd(hd(bs)))), hd(varsBounds)); } /* ---------------------------------------------------------------------- * STEP 3: Calculate types for each group of implicitly typed bindings. * --------------------------------------------------------------------*/ for (; nonNull(imps); imps=tl(imps)) { Cell b = hd(hd(imps)); Int line = isVar(fst(b)) ? rhsLine(snd(hd(snd(snd(b))))) : rhsLine(snd(snd(snd(b)))); hd(defnBounds) = NIL; hd(depends) = NIL; for (bs1=hd(imps); nonNull(bs1); bs1=tl(bs1)) newDefnBind(fst(hd(bs1)),NIL); preds = NIL; mapProc(typeBind,hd(imps)); improve(line,NIL,preds); clearMarks(); mapProc(markAssumList,tl(defnBounds)); mapProc(markAssumList,tl(varsBounds)); mapProc(markPred,savePreds); markBtyvs(); normPreds(line); savePreds = elimOuterPreds(savePreds); if (nonNull(preds) && resolveDefs(genvarAllAss(hd(defnBounds)),FALSE)) { savePreds = elimOuterPreds(savePreds); } map1Proc(genBind,preds,hd(imps)); if (nonNull(preds)) { map1Proc(addEvidParams,preds,hd(depends)); map1Proc(qualifyBinding,preds,hd(imps)); } h98CheckInferredType(line, fst(hd(hd(defnBounds))),snd(hd(hd(defnBounds)))); hd(varsBounds) = revOnto(hd(defnBounds),hd(varsBounds)); } /* ---------------------------------------------------------------------- * STEP 4: Now infer a type for each explicitly typed variable and * check for compatibility with the declared type. * --------------------------------------------------------------------*/ for (; nonNull(exps); exps=tl(exps)) { static String extbind = "explicitly typed binding"; Cell b = hd(exps); List alts = snd(snd(b)); Int line = rhsLine(snd(hd(alts))); Type t; Int o; Int m; List ps; hd(defnBounds) = NIL; hd(depends) = NODEPENDS; preds = NIL; instantiate(fst(snd(b))); o = typeOff; m = typeFree; t = dropRank2(typeIs,o,m); ps = makePredAss(predsAre,o); enterPendingBtyvs(); for (; nonNull(alts); alts=tl(alts)) typeAlt(extbind,fst(b),hd(alts),t,o,m); improve(line,ps,preds); leavePendingBtyvs(); if (nonNull(ps)) /* Add dict params, if necessary */ qualifyBinding(ps,b); clearMarks(); mapProc(markAssumList,tl(defnBounds)); mapProc(markAssumList,tl(varsBounds)); mapProc(markPred,savePreds); markBtyvs(); normPreds(line); savePreds = elimPredsUsing(ps,savePreds); if (nonNull(preds)) { List vs = NIL; Int i = 0; for (; ikind; k = ap(ka,k); } t = mkPolyType(k,t); #if DEBUG_KINDS Printf("Generalized type: "); printType(stdout,t); Printf(" ::: "); printKind(stdout,k); Printf("\n"); #endif } return t; } static Bool local equalTypes(t1,t2) /* Compare simple types for equality*/ Type t1, t2; { STACK_CHECK et: if (whatIs(t1)!=whatIs(t2)) return FALSE; switch (whatIs(t1)) { #if TREX case EXT : #endif case TYCON : case OFFSET : case TUPLE : return t1==t2; case INTCELL : return intOf(t1)!=intOf(t2); case AP : if (equalTypes(fun(t1),fun(t2))) { t1 = arg(t1); t2 = arg(t2); goto et; } return FALSE; default : internal("equalTypes"); } return TRUE;/*NOTREACHED*/ } /* -------------------------------------------------------------------------- * Entry points to type checker: * ------------------------------------------------------------------------*/ Type typeCheckExp(useDefs) /* Type check top level expression */ Bool useDefs; { /* using defaults if reqd */ Type type; List ctxt; Int beta; typeChecker(RESET); emptySubstitution(); enterBindings(); inputExpr = typeExpr(0,inputExpr); type = typeIs; beta = typeOff; clearMarks(); improve(0,NIL,preds); normPreds(0); elimTauts(); preds = scSimplify(preds); if (useDefs && nonNull(preds)) { clearMarks(); reducePreds(); if (nonNull(preds) && resolveDefs(NIL,TRUE)) /* Nearly Haskell 1.4? */ elimTauts(); } resetGenerics(); ctxt = copyPreds(preds); type = generalize(ctxt,copyType(type,beta)); inputExpr = qualifyExpr(0,preds,inputExpr); h98CheckInferredType(0,inputExpr,type); typeChecker(RESET); emptySubstitution(); return type; } Void typeCheckDefns() { /* Type check top level bindings */ Target t = length(selDefns) + length(valDefns) + length(instDefns) + length(classDefns); Target i = 0; List gs; typeChecker(RESET); emptySubstitution(); enterSkolVars(); enterBindings(); setGoal("Type checking",t); for (gs=selDefns; nonNull(gs); gs=tl(gs)) { mapOver(typeSel,hd(gs)); soFar(i++); } for (gs=valDefns; nonNull(gs); gs=tl(gs)) { typeDefnGroup(hd(gs)); soFar(i++); } mapProc(typeForeignExport,foreignExports); /* ToDo: soFar magic */ clearTypeIns(); for (gs=classDefns; nonNull(gs); gs=tl(gs)) { emptySubstitution(); typeClassDefn(hd(gs)); soFar(i++); } for (gs=instDefns; nonNull(gs); gs=tl(gs)) { emptySubstitution(); typeInstDefn(hd(gs)); soFar(i++); } typeChecker(RESET); emptySubstitution(); done(); } static Void local typeDefnGroup(bs) /* type check group of value defns */ List bs; { /* (one top level scc) */ List as; emptySubstitution(); hd(defnBounds) = NIL; preds = NIL; setTypeIns(bs); typeBindings(bs); /* find types for vars in bindings */ if (nonNull(preds)) { Cell v = fst(hd(hd(varsBounds))); Name n = findName(textOf(v)); Int l = nonNull(n) ? name(n).line : 0; preds = scSimplify(preds); ERRMSG(l) "Instance%s of ", (length(preds)==1 ? "" : "s") ETHEN ERRCONTEXT(copyPreds(preds)); ERRTEXT " required for definition of " ETHEN ERREXPR(nonNull(n)?n:v); ERRTEXT "\n" EEND; } if (nonNull(hd(skolVars))) { Cell b = hd(bs); Name n = findName(isVar(fst(b)) ? textOf(fst(b)) : textOf(hd(fst(b)))); Int l = nonNull(n) ? name(n).line : 0; leaveSkolVars(l,typeUnit,0,0); enterSkolVars(); } for (as=hd(varsBounds); nonNull(as); as=tl(as)) { Cell a = hd(as); /* add infered types to environment*/ Name n = findName(textOf(fst(a))); if (isNull(n)) internal("typeDefnGroup"); name(n).type = snd(a); } hd(varsBounds) = NIL; } static Void local typeForeignExport(n) /* Typecheck a foreign export decl */ Name n; { Int line = name(n).line; /* todo */ #if 0 /* Old comment from checkForeignExport: */ /* The following doesn't work because the type written into the * dummy binding has been through the typechecker once already * so it has the wrong type. * What's needed here is something like what we do for bindings * in instance decls: insert enough dictionaries to make the export * have the stated type (or report why this can't be done). */ /* We have to generate a dummy definition to * pass to the typechecker. This is done here rather than in * foreign export because valDefns gets set at the end of parsing * which would overwrite the result of the following assignment. */ Cell v = mkVar(name(p).text); Cell rhs = pair(mkInt(line),name(p).defn); Cell alt = pair(NIL,rhs); valDefns = cons(pair(v,pair(name(p).type,singleton(alt))),valDefns); #else ERRMSG(line) "Foreign export not implemented yet." EEND; #endif } static Pair local typeSel(s) /* Calculate a suitable type for a */ Name s; { /* particular selector, s. */ List cns = name(s).defn; Int line = name(s).line; Type dom = NIL; /* Inferred domain */ Type rng = NIL; /* Inferred range */ Cell nv = inventVar(); List alts = NIL; Int o; Int m; #if DEBUG_SELS Printf("Selector %s, cns=",textToStr(name(s).text)); printExp(stdout,cns); Putchar('\n'); #endif emptySubstitution(); preds = NIL; for (; nonNull(cns); cns=tl(cns)) { Name c = fst(hd(cns)); Int n = intOf(snd(hd(cns))); Int a = name(c).arity; Cell pat = c; Type dom1; Type rng1; Int o1; Int m1; instantiate(name(c).type); /* Instantiate constructor type */ o1 = typeOff; m1 = typeFree; for (; nonNull(predsAre); predsAre=tl(predsAre)) assumeEvid(hd(predsAre),o1); if (whatIs(typeIs)==RANK2) /* Skip rank2 annotation, if any */ typeIs = snd(snd(typeIs)); for (; --n>0; a--) { /* Get range */ pat = ap(pat,WILDCARD); typeIs = arg(typeIs); } rng1 = dropRank1(arg(fun(typeIs)),o1,m1); pat = ap(pat,nv); typeIs = arg(typeIs); while (--a>0) { /* And then look for domain */ pat = ap(pat,WILDCARD); typeIs = arg(typeIs); } dom1 = typeIs; if (isNull(dom)) { /* Save first domain type and then */ dom = dom1; /* unify with subsequent domains to*/ o = o1; /* match up preds and range types */ m = m1; } else if (!unify(dom1,o1,dom,o)) internal("typeSel1"); if (isNull(rng)) /* Compare component types */ rng = rng1; else if (!sameSchemes(rng1,rng)) { clearMarks(); rng = liftRank1(rng,o,m); rng1 = liftRank1(rng1,o1,m1); ERRMSG(name(s).line) "Mismatch in field types for selector \"%s\"", textToStr(name(s).text) ETHEN ERRTEXT "\n*** Field type : " ETHEN ERRTYPE(rng1); ERRTEXT "\n*** Does not match : " ETHEN ERRTYPE(rng); ERRTEXT "\n" EEND; } alts = cons(pair(singleton(pat),pair(mkInt(line),nv)),alts); } alts = rev(alts); if (isNull(dom) || isNull(rng)) /* Should have been initialized by */ internal("typeSel2"); /* now, assuming length cns >= 1. */ clearMarks(); /* No fixed variables here */ preds = scSimplify(preds); /* Simplify context */ dom = copyType(dom,o); /* Calculate domain type */ instantiate(rng); rng = copyType(typeIs,typeOff); if (nonNull(predsAre)) { List ps = makePredAss(predsAre,typeOff); List alts1 = alts; for (; nonNull(alts1); alts1=tl(alts1)) { Cell body = nv; List qs = ps; for (; nonNull(qs); qs=tl(qs)) body = ap(body,thd3(hd(qs))); snd(snd(hd(alts1))) = body; } preds = appendOnto(preds,ps); } name(s).type = generalize(copyPreds(preds),fn(dom,rng)); name(s).arity = 1 + length(preds); map1Proc(qualify,preds,alts); #if DEBUG_SELS Printf("Inferred arity = %d, type = ",name(s).arity); printType(stdout,name(s).type); Putchar('\n'); #endif return pair(s,alts); } /* -------------------------------------------------------------------------- * Type checker control: * ------------------------------------------------------------------------*/ Void typeChecker(what) Int what; { switch (what) { case RESET : tcMode = EXPRESSION; daSccs = NIL; preds = NIL; pendingBtyvs = NIL; emptyAssumption(); break; case MARK : mark(defnBounds); mark(varsBounds); mark(depends); mark(pendingBtyvs); mark(skolVars); mark(localEvs); mark(savedPs); mark(dummyVar); mark(daSccs); mark(preds); mark(stdDefaults); mark(arrow); mark(boundPair); mark(listof); mark(typeVarToVar); mark(predNum); mark(predFractional); mark(predIntegral); mark(starToStar); mark(predMonad); #if MUDO mark(predMonadRec); #endif #if IO_MONAD mark(typeProgIO); #endif break; case INSTALL : typeChecker(RESET); dummyVar = inventVar(); modulePrelude = newModule(textPrelude); moduleUserPrelude = 0; setCurrModule(modulePrelude); starToStar = simpleKind(1); typeUnit = addPrimTycon(findText("()"), STAR,0,DATATYPE,NIL); typeArrow = addPrimTycon(findText("(->)"), simpleKind(2),2, DATATYPE,NIL); typeList = addPrimTycon(findText("[]"), starToStar,1, DATATYPE,NIL); arrow = fn(aVar,bVar); listof = ap(typeList,aVar); boundPair = ap(ap(mkTuple(2),aVar),aVar); nameUnit = addPrimCfun(findText("()"),0,0,typeUnit); tycon(typeUnit).defn = singleton(nameUnit); nameNil = addPrimCfun(findText("[]"),0,1, mkPolyType(starToStar, listof)); nameCons = addPrimCfun(findText(":"),2,2, mkPolyType(starToStar, fn(aVar, fn(listof, listof)))); name(nameCons).syntax = mkSyntax(RIGHT_ASS,5); tycon(typeList).defn = cons(nameNil,cons(nameCons,NIL)); typeVarToVar = fn(aVar,aVar); #if TREX typeNoRow = addPrimTycon(findText("EmptyRow"), ROW,0,DATATYPE,NIL); typeRec = addPrimTycon(findText("Rec"), pair(ROW,STAR),1, DATATYPE,NIL); nameNoRec = addPrimCfun(findText("EmptyRec"),0,0, ap(typeRec,typeNoRow)); #else /* bogus definitions to avoid changing the prelude */ addPrimCfun(findText("Rec"), 0,0,typeUnit); addPrimCfun(findText("EmptyRow"), 0,0,typeUnit); addPrimCfun(findText("EmptyRec"), 0,0,typeUnit); #endif break; } } static Name local linkName(s) String s; { Name n = findName(findText(s)); if (isNull(n)) { ERRMSG(0) "Prelude does not define standard name \"%s\"", s EEND; } return n; } static Tycon local linkTycon(s) String s; { Tycon tc = findTycon(findText(s)); if (isNull(tc)) { ERRMSG(0) "Prelude does not define standard type \"%s\"", s EEND; } return tc; } static Class local linkClass(s) String s; { Class cc = findClass(findText(s)); if (isNull(cc)) { ERRMSG(0) "Prelude does not define standard class \"%s\"", s EEND; } return cc; } Void linkPreludeTC() { /* Hook to tycons and classes in */ if (isNull(typeBool)) { /* prelude when first loaded */ Int i; typeInt = linkTycon("Int"); typeInt8 = linkTycon("Int8"); typeInt16 = linkTycon("Int16"); typeInt32 = linkTycon("Int32"); typeInt64 = linkTycon("Int64"); typeWord = linkTycon("Word"); /* deprecated */ typeWord8 = linkTycon("Word8"); typeWord16 = linkTycon("Word16"); typeWord32 = linkTycon("Word32"); typeWord64 = linkTycon("Word64"); typeFunPtr = linkTycon("FunPtr"); typePtr = linkTycon("Ptr"); typeAddr = linkTycon("Addr"); /* deprecated */ typeFloat = linkTycon("Float"); typeDouble = linkTycon("Double"); typeChar = linkTycon("Char"); typeForeignP = linkTycon("ForeignPtr"); typeForeign = linkTycon("ForeignObj"); /* deprecated */ typeStable = linkTycon("StablePtr"); #ifdef DOTNET typeObject = linkTycon("Object"); #endif typeBool = linkTycon("Bool"); typeString = linkTycon("String"); typeInteger = linkTycon("Integer"); typeMaybe = linkTycon("Maybe"); typeOrdering = linkTycon("Ordering"); stdDefaults = cons(typeInteger,cons(typeDouble,NIL)); classEq = linkClass("Eq"); classOrd = linkClass("Ord"); classIx = linkClass("Ix"); classEnum = linkClass("Enum"); classShow = linkClass("Show"); classRead = linkClass("Read"); classBounded = linkClass("Bounded"); classReal = linkClass("Real"); classIntegral = linkClass("Integral"); classRealFrac = linkClass("RealFrac"); classRealFloat = linkClass("RealFloat"); classFractional = linkClass("Fractional"); classFloating = linkClass("Floating"); classNum = linkClass("Num"); predNum = ap(classNum,aVar); predFractional = ap(classFractional,aVar); predIntegral = ap(classIntegral,aVar); classMonad = linkClass("Monad"); predMonad = ap(classMonad,aVar); #if IO_MONAD typeIO = linkTycon("IO"); typeProgIO = ap(typeIO,aVar); #endif /* The following primitives are referred to in derived instances and * hence require types; the following types are a little more general * than we might like, but they are the closest we can get without a * special datatype class. */ name(nameConCmp).type = mkPolyType(starToStar,fn(aVar,fn(aVar,typeOrdering))); name(nameEnRange).type = mkPolyType(starToStar,fn(boundPair,listof)); name(nameEnIndex).type = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeInt))); name(nameEnInRng).type = mkPolyType(starToStar,fn(boundPair,fn(aVar,typeBool))); name(nameEnToEn).type = mkPolyType(starToStar,fn(aVar,fn(typeInt,aVar))); name(nameEnFrEn).type = mkPolyType(starToStar,fn(aVar,typeInt)); name(nameEnFrom).type = mkPolyType(starToStar,fn(aVar,listof)); name(nameEnFrTo).type = name(nameEnFrTh).type = mkPolyType(starToStar,fn(aVar,fn(aVar,listof))); for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */ addTupInst(classEq,i); addTupInst(classOrd,i); addTupInst(classShow,i); addTupInst(classRead,i); addTupInst(classIx,i); } } } Void linkPreludeCM() { /* Hook to cfuns and mfuns in */ if (isNull(nameFalse)) { /* prelude when first loaded */ nameFalse = linkName("False"); nameTrue = linkName("True"); nameJust = linkName("Just"); nameNothing = linkName("Nothing"); nameLeft = linkName("Left"); nameRight = linkName("Right"); nameLT = linkName("LT"); nameEQ = linkName("EQ"); nameGT = linkName("GT"); nameFromInt = linkName("fromInt"); nameFromInteger = linkName("fromInteger"); nameFromDouble = linkName("fromDouble"); nameEq = linkName("=="); nameCompare = linkName("compare"); nameLe = linkName("<="); nameGt = linkName(">"); nameShowsPrec = linkName("showsPrec"); nameReadsPrec = linkName("readsPrec"); nameIndex = linkName("index"); nameInRange = linkName("inRange"); nameRange = linkName("range"); nameMult = linkName("*"); namePlus = linkName("+"); nameMinBnd = linkName("minBound"); nameMaxBnd = linkName("maxBound"); nameReturn = linkName("return"); nameBind = linkName(">>="); nameThen = linkName(">>"); nameMFail = linkName("fail"); #if IO_MONAD /* The constructor names better match up with the defn of IOErrorType in Prelude. */ nameIOError = linkName("IOError"); nameAlreadyExists = linkName("AlreadyExists"); nameDoesNotExist = linkName("NoSuchThing"); nameAlreadyInUse = linkName("ResourceBusy"); nameIsFull = linkName("ResourceExhausted"); nameEOFErr = linkName("EOF"); nameProtocolError = linkName("ProtocolError"); nameIllegal = linkName("IllegalOperation"); namePermDenied = linkName("PermissionDenied"); nameUserErr = linkName("UserError"); #ifdef DOTNET nameNetException = linkName("DotNetException"); #endif #endif nameArithException = linkName("ArithException"); nameArrayException = linkName("ArrayException"); nameErrorCall = linkName("ErrorCall"); nameIOException = linkName("IOException"); nameNoMethodError = linkName("NoMethodError"); nameNonTermination = linkName("NonTermination"); namePatternMatchFail = linkName("PatternMatchFail"); nameRecConError = linkName("RecConError"); nameRecSelError = linkName("RecSelError"); nameRecUpdError = linkName("RecUpdError"); nameOverflow = linkName("Overflow"); nameDivideByZero = linkName("DivideByZero"); nameIndexOutOfBounds = linkName("IndexOutOfBounds"); nameUndefinedElement = linkName("UndefinedElement"); } } Void linkPreludeFuns() { /* Hook to cfuns and mfuns in */ /* prelude when first loaded */ } /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/unitable.c0000644006511100651110000017275110000552253015526 0ustar rossross/*---------------------------------------------------- This is an automatically generated file: DO NOT EDIT. Generated by unix/mkunitable from UnicodeData-4.0.1d1b.txt, which was obtained from http://www.unicode.org/ucd/ -----------------------------------------------------*/ #define NUM_BLOCKS 1914 static const struct CharProperties prop0 = { GENCAT_Cc, 0, 0, 0 }; static const struct CharProperties prop1 = { GENCAT_Zs, 0, 0, 0 }; static const struct CharProperties prop2 = { GENCAT_Po, 0, 0, 0 }; static const struct CharProperties prop3 = { GENCAT_Sc, 0, 0, 0 }; static const struct CharProperties prop4 = { GENCAT_Ps, 0, 0, 0 }; static const struct CharProperties prop5 = { GENCAT_Pe, 0, 0, 0 }; static const struct CharProperties prop6 = { GENCAT_Sm, 0, 0, 0 }; static const struct CharProperties prop7 = { GENCAT_Pd, 0, 0, 0 }; static const struct CharProperties prop8 = { GENCAT_Nd, 0, 0, 0 }; static const struct CharProperties prop9 = { GENCAT_Lu, 0, 32, 0 }; static const struct CharProperties prop10 = { GENCAT_Sk, 0, 0, 0 }; static const struct CharProperties prop11 = { GENCAT_Pc, 0, 0, 0 }; static const struct CharProperties prop12 = { GENCAT_Ll, -32, 0, -32 }; static const struct CharProperties prop13 = { GENCAT_So, 0, 0, 0 }; static const struct CharProperties prop14 = { GENCAT_Ll, 0, 0, 0 }; static const struct CharProperties prop15 = { GENCAT_Pi, 0, 0, 0 }; static const struct CharProperties prop16 = { GENCAT_Cf, 0, 0, 0 }; static const struct CharProperties prop17 = { GENCAT_No, 0, 0, 0 }; static const struct CharProperties prop18 = { GENCAT_Ll, 743, 0, 743 }; static const struct CharProperties prop19 = { GENCAT_Pf, 0, 0, 0 }; static const struct CharProperties prop20 = { GENCAT_Ll, 121, 0, 121 }; static const struct CharProperties prop21 = { GENCAT_Lu, 0, 1, 0 }; static const struct CharProperties prop22 = { GENCAT_Ll, -1, 0, -1 }; static const struct CharProperties prop23 = { GENCAT_Lu, 0, -199, 0 }; static const struct CharProperties prop24 = { GENCAT_Ll, -232, 0, -232 }; static const struct CharProperties prop25 = { GENCAT_Lu, 0, -121, 0 }; static const struct CharProperties prop26 = { GENCAT_Ll, -300, 0, -300 }; static const struct CharProperties prop27 = { GENCAT_Lu, 0, 210, 0 }; static const struct CharProperties prop28 = { GENCAT_Lu, 0, 206, 0 }; static const struct CharProperties prop29 = { GENCAT_Lu, 0, 205, 0 }; static const struct CharProperties prop30 = { GENCAT_Lu, 0, 79, 0 }; static const struct CharProperties prop31 = { GENCAT_Lu, 0, 202, 0 }; static const struct CharProperties prop32 = { GENCAT_Lu, 0, 203, 0 }; static const struct CharProperties prop33 = { GENCAT_Lu, 0, 207, 0 }; static const struct CharProperties prop34 = { GENCAT_Ll, 97, 0, 97 }; static const struct CharProperties prop35 = { GENCAT_Lu, 0, 211, 0 }; static const struct CharProperties prop36 = { GENCAT_Lu, 0, 209, 0 }; static const struct CharProperties prop37 = { GENCAT_Lu, 0, 213, 0 }; static const struct CharProperties prop38 = { GENCAT_Ll, 130, 0, 130 }; static const struct CharProperties prop39 = { GENCAT_Lu, 0, 214, 0 }; static const struct CharProperties prop40 = { GENCAT_Lu, 0, 218, 0 }; static const struct CharProperties prop41 = { GENCAT_Lu, 0, 217, 0 }; static const struct CharProperties prop42 = { GENCAT_Lu, 0, 219, 0 }; static const struct CharProperties prop43 = { GENCAT_Lo, 0, 0, 0 }; static const struct CharProperties prop44 = { GENCAT_Ll, 56, 0, 56 }; static const struct CharProperties prop45 = { GENCAT_Lu, 0, 2, 1 }; static const struct CharProperties prop46 = { GENCAT_Lt, -1, 1, 0 }; static const struct CharProperties prop47 = { GENCAT_Ll, -2, 0, -1 }; static const struct CharProperties prop48 = { GENCAT_Ll, -79, 0, -79 }; static const struct CharProperties prop49 = { GENCAT_Lu, 0, -97, 0 }; static const struct CharProperties prop50 = { GENCAT_Lu, 0, -56, 0 }; static const struct CharProperties prop51 = { GENCAT_Lu, 0, -130, 0 }; static const struct CharProperties prop52 = { GENCAT_Ll, -210, 0, -210 }; static const struct CharProperties prop53 = { GENCAT_Ll, -206, 0, -206 }; static const struct CharProperties prop54 = { GENCAT_Ll, -205, 0, -205 }; static const struct CharProperties prop55 = { GENCAT_Ll, -202, 0, -202 }; static const struct CharProperties prop56 = { GENCAT_Ll, -203, 0, -203 }; static const struct CharProperties prop57 = { GENCAT_Ll, -207, 0, -207 }; static const struct CharProperties prop58 = { GENCAT_Ll, -209, 0, -209 }; static const struct CharProperties prop59 = { GENCAT_Ll, -211, 0, -211 }; static const struct CharProperties prop60 = { GENCAT_Ll, -213, 0, -213 }; static const struct CharProperties prop61 = { GENCAT_Ll, -214, 0, -214 }; static const struct CharProperties prop62 = { GENCAT_Ll, -218, 0, -218 }; static const struct CharProperties prop63 = { GENCAT_Ll, -217, 0, -217 }; static const struct CharProperties prop64 = { GENCAT_Ll, -219, 0, -219 }; static const struct CharProperties prop65 = { GENCAT_Lm, 0, 0, 0 }; static const struct CharProperties prop66 = { GENCAT_Mn, 0, 0, 0 }; static const struct CharProperties prop67 = { GENCAT_Mn, 84, 0, 84 }; static const struct CharProperties prop68 = { GENCAT_Lu, 0, 38, 0 }; static const struct CharProperties prop69 = { GENCAT_Lu, 0, 37, 0 }; static const struct CharProperties prop70 = { GENCAT_Lu, 0, 64, 0 }; static const struct CharProperties prop71 = { GENCAT_Lu, 0, 63, 0 }; static const struct CharProperties prop72 = { GENCAT_Ll, -38, 0, -38 }; static const struct CharProperties prop73 = { GENCAT_Ll, -37, 0, -37 }; static const struct CharProperties prop74 = { GENCAT_Ll, -31, 0, -31 }; static const struct CharProperties prop75 = { GENCAT_Ll, -64, 0, -64 }; static const struct CharProperties prop76 = { GENCAT_Ll, -63, 0, -63 }; static const struct CharProperties prop77 = { GENCAT_Ll, -62, 0, -62 }; static const struct CharProperties prop78 = { GENCAT_Ll, -57, 0, -57 }; static const struct CharProperties prop79 = { GENCAT_Lu, 0, 0, 0 }; static const struct CharProperties prop80 = { GENCAT_Ll, -47, 0, -47 }; static const struct CharProperties prop81 = { GENCAT_Ll, -54, 0, -54 }; static const struct CharProperties prop82 = { GENCAT_Ll, -86, 0, -86 }; static const struct CharProperties prop83 = { GENCAT_Ll, -80, 0, -80 }; static const struct CharProperties prop84 = { GENCAT_Ll, 7, 0, 7 }; static const struct CharProperties prop85 = { GENCAT_Lu, 0, -60, 0 }; static const struct CharProperties prop86 = { GENCAT_Ll, -96, 0, -96 }; static const struct CharProperties prop87 = { GENCAT_Lu, 0, -7, 0 }; static const struct CharProperties prop88 = { GENCAT_Lu, 0, 80, 0 }; static const struct CharProperties prop89 = { GENCAT_Me, 0, 0, 0 }; static const struct CharProperties prop90 = { GENCAT_Lu, 0, 48, 0 }; static const struct CharProperties prop91 = { GENCAT_Ll, -48, 0, -48 }; static const struct CharProperties prop92 = { GENCAT_Mc, 0, 0, 0 }; static const struct CharProperties prop93 = { GENCAT_Nl, 0, 0, 0 }; static const struct CharProperties prop94 = { GENCAT_Ll, -59, 0, -59 }; static const struct CharProperties prop95 = { GENCAT_Ll, 8, 0, 8 }; static const struct CharProperties prop96 = { GENCAT_Lu, 0, -8, 0 }; static const struct CharProperties prop97 = { GENCAT_Ll, 74, 0, 74 }; static const struct CharProperties prop98 = { GENCAT_Ll, 86, 0, 86 }; static const struct CharProperties prop99 = { GENCAT_Ll, 100, 0, 100 }; static const struct CharProperties prop100 = { GENCAT_Ll, 128, 0, 128 }; static const struct CharProperties prop101 = { GENCAT_Ll, 112, 0, 112 }; static const struct CharProperties prop102 = { GENCAT_Ll, 126, 0, 126 }; static const struct CharProperties prop103 = { GENCAT_Lt, 0, -8, 0 }; static const struct CharProperties prop104 = { GENCAT_Ll, 9, 0, 9 }; static const struct CharProperties prop105 = { GENCAT_Lu, 0, -74, 0 }; static const struct CharProperties prop106 = { GENCAT_Lt, 0, -9, 0 }; static const struct CharProperties prop107 = { GENCAT_Ll, -7205, 0, -7205 }; static const struct CharProperties prop108 = { GENCAT_Lu, 0, -86, 0 }; static const struct CharProperties prop109 = { GENCAT_Lu, 0, -100, 0 }; static const struct CharProperties prop110 = { GENCAT_Lu, 0, -112, 0 }; static const struct CharProperties prop111 = { GENCAT_Lu, 0, -128, 0 }; static const struct CharProperties prop112 = { GENCAT_Lu, 0, -126, 0 }; static const struct CharProperties prop113 = { GENCAT_Zl, 0, 0, 0 }; static const struct CharProperties prop114 = { GENCAT_Zp, 0, 0, 0 }; static const struct CharProperties prop115 = { GENCAT_Lu, 0, -7517, 0 }; static const struct CharProperties prop116 = { GENCAT_Lu, 0, -8383, 0 }; static const struct CharProperties prop117 = { GENCAT_Lu, 0, -8262, 0 }; static const struct CharProperties prop118 = { GENCAT_Nl, 0, 16, 0 }; static const struct CharProperties prop119 = { GENCAT_Nl, -16, 0, -16 }; static const struct CharProperties prop120 = { GENCAT_So, 0, 26, 0 }; static const struct CharProperties prop121 = { GENCAT_So, -26, 0, -26 }; static const struct CharProperties prop122 = { GENCAT_Cs, 0, 0, 0 }; static const struct CharProperties prop123 = { GENCAT_Co, 0, 0, 0 }; static const struct CharProperties prop124 = { GENCAT_Lu, 0, 40, 0 }; static const struct CharProperties prop125 = { GENCAT_Ll, -40, 0, -40 }; static const struct CharBlock char_block[] = { { 0x0000, 32, &prop0 }, { 0x0020, 1, &prop1 }, { 0x0021, 3, &prop2 }, { 0x0024, 1, &prop3 }, { 0x0025, 3, &prop2 }, { 0x0028, 1, &prop4 }, { 0x0029, 1, &prop5 }, { 0x002A, 1, &prop2 }, { 0x002B, 1, &prop6 }, { 0x002C, 1, &prop2 }, { 0x002D, 1, &prop7 }, { 0x002E, 2, &prop2 }, { 0x0030, 10, &prop8 }, { 0x003A, 2, &prop2 }, { 0x003C, 3, &prop6 }, { 0x003F, 2, &prop2 }, { 0x0041, 26, &prop9 }, { 0x005B, 1, &prop4 }, { 0x005C, 1, &prop2 }, { 0x005D, 1, &prop5 }, { 0x005E, 1, &prop10 }, { 0x005F, 1, &prop11 }, { 0x0060, 1, &prop10 }, { 0x0061, 26, &prop12 }, { 0x007B, 1, &prop4 }, { 0x007C, 1, &prop6 }, { 0x007D, 1, &prop5 }, { 0x007E, 1, &prop6 }, { 0x007F, 33, &prop0 }, { 0x00A0, 1, &prop1 }, { 0x00A1, 1, &prop2 }, { 0x00A2, 4, &prop3 }, { 0x00A6, 2, &prop13 }, { 0x00A8, 1, &prop10 }, { 0x00A9, 1, &prop13 }, { 0x00AA, 1, &prop14 }, { 0x00AB, 1, &prop15 }, { 0x00AC, 1, &prop6 }, { 0x00AD, 1, &prop16 }, { 0x00AE, 1, &prop13 }, { 0x00AF, 1, &prop10 }, { 0x00B0, 1, &prop13 }, { 0x00B1, 1, &prop6 }, { 0x00B2, 2, &prop17 }, { 0x00B4, 1, &prop10 }, { 0x00B5, 1, &prop18 }, { 0x00B6, 1, &prop13 }, { 0x00B7, 1, &prop2 }, { 0x00B8, 1, &prop10 }, { 0x00B9, 1, &prop17 }, { 0x00BA, 1, &prop14 }, { 0x00BB, 1, &prop19 }, { 0x00BC, 3, &prop17 }, { 0x00BF, 1, &prop2 }, { 0x00C0, 23, &prop9 }, { 0x00D7, 1, &prop6 }, { 0x00D8, 7, &prop9 }, { 0x00DF, 1, &prop14 }, { 0x00E0, 23, &prop12 }, { 0x00F7, 1, &prop6 }, { 0x00F8, 7, &prop12 }, { 0x00FF, 1, &prop20 }, { 0x0100, 1, &prop21 }, { 0x0101, 1, &prop22 }, { 0x0102, 1, &prop21 }, { 0x0103, 1, &prop22 }, { 0x0104, 1, &prop21 }, { 0x0105, 1, &prop22 }, { 0x0106, 1, &prop21 }, { 0x0107, 1, &prop22 }, { 0x0108, 1, &prop21 }, { 0x0109, 1, &prop22 }, { 0x010A, 1, &prop21 }, { 0x010B, 1, &prop22 }, { 0x010C, 1, &prop21 }, { 0x010D, 1, &prop22 }, { 0x010E, 1, &prop21 }, { 0x010F, 1, &prop22 }, { 0x0110, 1, &prop21 }, { 0x0111, 1, &prop22 }, { 0x0112, 1, &prop21 }, { 0x0113, 1, &prop22 }, { 0x0114, 1, &prop21 }, { 0x0115, 1, &prop22 }, { 0x0116, 1, &prop21 }, { 0x0117, 1, &prop22 }, { 0x0118, 1, &prop21 }, { 0x0119, 1, &prop22 }, { 0x011A, 1, &prop21 }, { 0x011B, 1, &prop22 }, { 0x011C, 1, &prop21 }, { 0x011D, 1, &prop22 }, { 0x011E, 1, &prop21 }, { 0x011F, 1, &prop22 }, { 0x0120, 1, &prop21 }, { 0x0121, 1, &prop22 }, { 0x0122, 1, &prop21 }, { 0x0123, 1, &prop22 }, { 0x0124, 1, &prop21 }, { 0x0125, 1, &prop22 }, { 0x0126, 1, &prop21 }, { 0x0127, 1, &prop22 }, { 0x0128, 1, &prop21 }, { 0x0129, 1, &prop22 }, { 0x012A, 1, &prop21 }, { 0x012B, 1, &prop22 }, { 0x012C, 1, &prop21 }, { 0x012D, 1, &prop22 }, { 0x012E, 1, &prop21 }, { 0x012F, 1, &prop22 }, { 0x0130, 1, &prop23 }, { 0x0131, 1, &prop24 }, { 0x0132, 1, &prop21 }, { 0x0133, 1, &prop22 }, { 0x0134, 1, &prop21 }, { 0x0135, 1, &prop22 }, { 0x0136, 1, &prop21 }, { 0x0137, 1, &prop22 }, { 0x0138, 1, &prop14 }, { 0x0139, 1, &prop21 }, { 0x013A, 1, &prop22 }, { 0x013B, 1, &prop21 }, { 0x013C, 1, &prop22 }, { 0x013D, 1, &prop21 }, { 0x013E, 1, &prop22 }, { 0x013F, 1, &prop21 }, { 0x0140, 1, &prop22 }, { 0x0141, 1, &prop21 }, { 0x0142, 1, &prop22 }, { 0x0143, 1, &prop21 }, { 0x0144, 1, &prop22 }, { 0x0145, 1, &prop21 }, { 0x0146, 1, &prop22 }, { 0x0147, 1, &prop21 }, { 0x0148, 1, &prop22 }, { 0x0149, 1, &prop14 }, { 0x014A, 1, &prop21 }, { 0x014B, 1, &prop22 }, { 0x014C, 1, &prop21 }, { 0x014D, 1, &prop22 }, { 0x014E, 1, &prop21 }, { 0x014F, 1, &prop22 }, { 0x0150, 1, &prop21 }, { 0x0151, 1, &prop22 }, { 0x0152, 1, &prop21 }, { 0x0153, 1, &prop22 }, { 0x0154, 1, &prop21 }, { 0x0155, 1, &prop22 }, { 0x0156, 1, &prop21 }, { 0x0157, 1, &prop22 }, { 0x0158, 1, &prop21 }, { 0x0159, 1, &prop22 }, { 0x015A, 1, &prop21 }, { 0x015B, 1, &prop22 }, { 0x015C, 1, &prop21 }, { 0x015D, 1, &prop22 }, { 0x015E, 1, &prop21 }, { 0x015F, 1, &prop22 }, { 0x0160, 1, &prop21 }, { 0x0161, 1, &prop22 }, { 0x0162, 1, &prop21 }, { 0x0163, 1, &prop22 }, { 0x0164, 1, &prop21 }, { 0x0165, 1, &prop22 }, { 0x0166, 1, &prop21 }, { 0x0167, 1, &prop22 }, { 0x0168, 1, &prop21 }, { 0x0169, 1, &prop22 }, { 0x016A, 1, &prop21 }, { 0x016B, 1, &prop22 }, { 0x016C, 1, &prop21 }, { 0x016D, 1, &prop22 }, { 0x016E, 1, &prop21 }, { 0x016F, 1, &prop22 }, { 0x0170, 1, &prop21 }, { 0x0171, 1, &prop22 }, { 0x0172, 1, &prop21 }, { 0x0173, 1, &prop22 }, { 0x0174, 1, &prop21 }, { 0x0175, 1, &prop22 }, { 0x0176, 1, &prop21 }, { 0x0177, 1, &prop22 }, { 0x0178, 1, &prop25 }, { 0x0179, 1, &prop21 }, { 0x017A, 1, &prop22 }, { 0x017B, 1, &prop21 }, { 0x017C, 1, &prop22 }, { 0x017D, 1, &prop21 }, { 0x017E, 1, &prop22 }, { 0x017F, 1, &prop26 }, { 0x0180, 1, &prop14 }, { 0x0181, 1, &prop27 }, { 0x0182, 1, &prop21 }, { 0x0183, 1, &prop22 }, { 0x0184, 1, &prop21 }, { 0x0185, 1, &prop22 }, { 0x0186, 1, &prop28 }, { 0x0187, 1, &prop21 }, { 0x0188, 1, &prop22 }, { 0x0189, 2, &prop29 }, { 0x018B, 1, &prop21 }, { 0x018C, 1, &prop22 }, { 0x018D, 1, &prop14 }, { 0x018E, 1, &prop30 }, { 0x018F, 1, &prop31 }, { 0x0190, 1, &prop32 }, { 0x0191, 1, &prop21 }, { 0x0192, 1, &prop22 }, { 0x0193, 1, &prop29 }, { 0x0194, 1, &prop33 }, { 0x0195, 1, &prop34 }, { 0x0196, 1, &prop35 }, { 0x0197, 1, &prop36 }, { 0x0198, 1, &prop21 }, { 0x0199, 1, &prop22 }, { 0x019A, 2, &prop14 }, { 0x019C, 1, &prop35 }, { 0x019D, 1, &prop37 }, { 0x019E, 1, &prop38 }, { 0x019F, 1, &prop39 }, { 0x01A0, 1, &prop21 }, { 0x01A1, 1, &prop22 }, { 0x01A2, 1, &prop21 }, { 0x01A3, 1, &prop22 }, { 0x01A4, 1, &prop21 }, { 0x01A5, 1, &prop22 }, { 0x01A6, 1, &prop40 }, { 0x01A7, 1, &prop21 }, { 0x01A8, 1, &prop22 }, { 0x01A9, 1, &prop40 }, { 0x01AA, 2, &prop14 }, { 0x01AC, 1, &prop21 }, { 0x01AD, 1, &prop22 }, { 0x01AE, 1, &prop40 }, { 0x01AF, 1, &prop21 }, { 0x01B0, 1, &prop22 }, { 0x01B1, 2, &prop41 }, { 0x01B3, 1, &prop21 }, { 0x01B4, 1, &prop22 }, { 0x01B5, 1, &prop21 }, { 0x01B6, 1, &prop22 }, { 0x01B7, 1, &prop42 }, { 0x01B8, 1, &prop21 }, { 0x01B9, 1, &prop22 }, { 0x01BA, 1, &prop14 }, { 0x01BB, 1, &prop43 }, { 0x01BC, 1, &prop21 }, { 0x01BD, 1, &prop22 }, { 0x01BE, 1, &prop14 }, { 0x01BF, 1, &prop44 }, { 0x01C0, 4, &prop43 }, { 0x01C4, 1, &prop45 }, { 0x01C5, 1, &prop46 }, { 0x01C6, 1, &prop47 }, { 0x01C7, 1, &prop45 }, { 0x01C8, 1, &prop46 }, { 0x01C9, 1, &prop47 }, { 0x01CA, 1, &prop45 }, { 0x01CB, 1, &prop46 }, { 0x01CC, 1, &prop47 }, { 0x01CD, 1, &prop21 }, { 0x01CE, 1, &prop22 }, { 0x01CF, 1, &prop21 }, { 0x01D0, 1, &prop22 }, { 0x01D1, 1, &prop21 }, { 0x01D2, 1, &prop22 }, { 0x01D3, 1, &prop21 }, { 0x01D4, 1, &prop22 }, { 0x01D5, 1, &prop21 }, { 0x01D6, 1, &prop22 }, { 0x01D7, 1, &prop21 }, { 0x01D8, 1, &prop22 }, { 0x01D9, 1, &prop21 }, { 0x01DA, 1, &prop22 }, { 0x01DB, 1, &prop21 }, { 0x01DC, 1, &prop22 }, { 0x01DD, 1, &prop48 }, { 0x01DE, 1, &prop21 }, { 0x01DF, 1, &prop22 }, { 0x01E0, 1, &prop21 }, { 0x01E1, 1, &prop22 }, { 0x01E2, 1, &prop21 }, { 0x01E3, 1, &prop22 }, { 0x01E4, 1, &prop21 }, { 0x01E5, 1, &prop22 }, { 0x01E6, 1, &prop21 }, { 0x01E7, 1, &prop22 }, { 0x01E8, 1, &prop21 }, { 0x01E9, 1, &prop22 }, { 0x01EA, 1, &prop21 }, { 0x01EB, 1, &prop22 }, { 0x01EC, 1, &prop21 }, { 0x01ED, 1, &prop22 }, { 0x01EE, 1, &prop21 }, { 0x01EF, 1, &prop22 }, { 0x01F0, 1, &prop14 }, { 0x01F1, 1, &prop45 }, { 0x01F2, 1, &prop46 }, { 0x01F3, 1, &prop47 }, { 0x01F4, 1, &prop21 }, { 0x01F5, 1, &prop22 }, { 0x01F6, 1, &prop49 }, { 0x01F7, 1, &prop50 }, { 0x01F8, 1, &prop21 }, { 0x01F9, 1, &prop22 }, { 0x01FA, 1, &prop21 }, { 0x01FB, 1, &prop22 }, { 0x01FC, 1, &prop21 }, { 0x01FD, 1, &prop22 }, { 0x01FE, 1, &prop21 }, { 0x01FF, 1, &prop22 }, { 0x0200, 1, &prop21 }, { 0x0201, 1, &prop22 }, { 0x0202, 1, &prop21 }, { 0x0203, 1, &prop22 }, { 0x0204, 1, &prop21 }, { 0x0205, 1, &prop22 }, { 0x0206, 1, &prop21 }, { 0x0207, 1, &prop22 }, { 0x0208, 1, &prop21 }, { 0x0209, 1, &prop22 }, { 0x020A, 1, &prop21 }, { 0x020B, 1, &prop22 }, { 0x020C, 1, &prop21 }, { 0x020D, 1, &prop22 }, { 0x020E, 1, &prop21 }, { 0x020F, 1, &prop22 }, { 0x0210, 1, &prop21 }, { 0x0211, 1, &prop22 }, { 0x0212, 1, &prop21 }, { 0x0213, 1, &prop22 }, { 0x0214, 1, &prop21 }, { 0x0215, 1, &prop22 }, { 0x0216, 1, &prop21 }, { 0x0217, 1, &prop22 }, { 0x0218, 1, &prop21 }, { 0x0219, 1, &prop22 }, { 0x021A, 1, &prop21 }, { 0x021B, 1, &prop22 }, { 0x021C, 1, &prop21 }, { 0x021D, 1, &prop22 }, { 0x021E, 1, &prop21 }, { 0x021F, 1, &prop22 }, { 0x0220, 1, &prop51 }, { 0x0221, 1, &prop14 }, { 0x0222, 1, &prop21 }, { 0x0223, 1, &prop22 }, { 0x0224, 1, &prop21 }, { 0x0225, 1, &prop22 }, { 0x0226, 1, &prop21 }, { 0x0227, 1, &prop22 }, { 0x0228, 1, &prop21 }, { 0x0229, 1, &prop22 }, { 0x022A, 1, &prop21 }, { 0x022B, 1, &prop22 }, { 0x022C, 1, &prop21 }, { 0x022D, 1, &prop22 }, { 0x022E, 1, &prop21 }, { 0x022F, 1, &prop22 }, { 0x0230, 1, &prop21 }, { 0x0231, 1, &prop22 }, { 0x0232, 1, &prop21 }, { 0x0233, 1, &prop22 }, { 0x0234, 3, &prop14 }, { 0x0250, 3, &prop14 }, { 0x0253, 1, &prop52 }, { 0x0254, 1, &prop53 }, { 0x0255, 1, &prop14 }, { 0x0256, 2, &prop54 }, { 0x0258, 1, &prop14 }, { 0x0259, 1, &prop55 }, { 0x025A, 1, &prop14 }, { 0x025B, 1, &prop56 }, { 0x025C, 4, &prop14 }, { 0x0260, 1, &prop54 }, { 0x0261, 2, &prop14 }, { 0x0263, 1, &prop57 }, { 0x0264, 4, &prop14 }, { 0x0268, 1, &prop58 }, { 0x0269, 1, &prop59 }, { 0x026A, 5, &prop14 }, { 0x026F, 1, &prop59 }, { 0x0270, 2, &prop14 }, { 0x0272, 1, &prop60 }, { 0x0273, 2, &prop14 }, { 0x0275, 1, &prop61 }, { 0x0276, 10, &prop14 }, { 0x0280, 1, &prop62 }, { 0x0281, 2, &prop14 }, { 0x0283, 1, &prop62 }, { 0x0284, 4, &prop14 }, { 0x0288, 1, &prop62 }, { 0x0289, 1, &prop14 }, { 0x028A, 2, &prop63 }, { 0x028C, 6, &prop14 }, { 0x0292, 1, &prop64 }, { 0x0293, 29, &prop14 }, { 0x02B0, 18, &prop65 }, { 0x02C2, 4, &prop10 }, { 0x02C6, 12, &prop65 }, { 0x02D2, 14, &prop10 }, { 0x02E0, 5, &prop65 }, { 0x02E5, 9, &prop10 }, { 0x02EE, 1, &prop65 }, { 0x02EF, 17, &prop10 }, { 0x0300, 69, &prop66 }, { 0x0345, 1, &prop67 }, { 0x0346, 18, &prop66 }, { 0x035D, 19, &prop66 }, { 0x0374, 2, &prop10 }, { 0x037A, 1, &prop65 }, { 0x037E, 1, &prop2 }, { 0x0384, 2, &prop10 }, { 0x0386, 1, &prop68 }, { 0x0387, 1, &prop2 }, { 0x0388, 3, &prop69 }, { 0x038C, 1, &prop70 }, { 0x038E, 2, &prop71 }, { 0x0390, 1, &prop14 }, { 0x0391, 17, &prop9 }, { 0x03A3, 9, &prop9 }, { 0x03AC, 1, &prop72 }, { 0x03AD, 3, &prop73 }, { 0x03B0, 1, &prop14 }, { 0x03B1, 17, &prop12 }, { 0x03C2, 1, &prop74 }, { 0x03C3, 9, &prop12 }, { 0x03CC, 1, &prop75 }, { 0x03CD, 2, &prop76 }, { 0x03D0, 1, &prop77 }, { 0x03D1, 1, &prop78 }, { 0x03D2, 3, &prop79 }, { 0x03D5, 1, &prop80 }, { 0x03D6, 1, &prop81 }, { 0x03D7, 1, &prop14 }, { 0x03D8, 1, &prop21 }, { 0x03D9, 1, &prop22 }, { 0x03DA, 1, &prop21 }, { 0x03DB, 1, &prop22 }, { 0x03DC, 1, &prop21 }, { 0x03DD, 1, &prop22 }, { 0x03DE, 1, &prop21 }, { 0x03DF, 1, &prop22 }, { 0x03E0, 1, &prop21 }, { 0x03E1, 1, &prop22 }, { 0x03E2, 1, &prop21 }, { 0x03E3, 1, &prop22 }, { 0x03E4, 1, &prop21 }, { 0x03E5, 1, &prop22 }, { 0x03E6, 1, &prop21 }, { 0x03E7, 1, &prop22 }, { 0x03E8, 1, &prop21 }, { 0x03E9, 1, &prop22 }, { 0x03EA, 1, &prop21 }, { 0x03EB, 1, &prop22 }, { 0x03EC, 1, &prop21 }, { 0x03ED, 1, &prop22 }, { 0x03EE, 1, &prop21 }, { 0x03EF, 1, &prop22 }, { 0x03F0, 1, &prop82 }, { 0x03F1, 1, &prop83 }, { 0x03F2, 1, &prop84 }, { 0x03F3, 1, &prop14 }, { 0x03F4, 1, &prop85 }, { 0x03F5, 1, &prop86 }, { 0x03F6, 1, &prop6 }, { 0x03F7, 1, &prop21 }, { 0x03F8, 1, &prop22 }, { 0x03F9, 1, &prop87 }, { 0x03FA, 1, &prop21 }, { 0x03FB, 1, &prop22 }, { 0x0400, 16, &prop88 }, { 0x0410, 32, &prop9 }, { 0x0430, 32, &prop12 }, { 0x0450, 16, &prop83 }, { 0x0460, 1, &prop21 }, { 0x0461, 1, &prop22 }, { 0x0462, 1, &prop21 }, { 0x0463, 1, &prop22 }, { 0x0464, 1, &prop21 }, { 0x0465, 1, &prop22 }, { 0x0466, 1, &prop21 }, { 0x0467, 1, &prop22 }, { 0x0468, 1, &prop21 }, { 0x0469, 1, &prop22 }, { 0x046A, 1, &prop21 }, { 0x046B, 1, &prop22 }, { 0x046C, 1, &prop21 }, { 0x046D, 1, &prop22 }, { 0x046E, 1, &prop21 }, { 0x046F, 1, &prop22 }, { 0x0470, 1, &prop21 }, { 0x0471, 1, &prop22 }, { 0x0472, 1, &prop21 }, { 0x0473, 1, &prop22 }, { 0x0474, 1, &prop21 }, { 0x0475, 1, &prop22 }, { 0x0476, 1, &prop21 }, { 0x0477, 1, &prop22 }, { 0x0478, 1, &prop21 }, { 0x0479, 1, &prop22 }, { 0x047A, 1, &prop21 }, { 0x047B, 1, &prop22 }, { 0x047C, 1, &prop21 }, { 0x047D, 1, &prop22 }, { 0x047E, 1, &prop21 }, { 0x047F, 1, &prop22 }, { 0x0480, 1, &prop21 }, { 0x0481, 1, &prop22 }, { 0x0482, 1, &prop13 }, { 0x0483, 4, &prop66 }, { 0x0488, 2, &prop89 }, { 0x048A, 1, &prop21 }, { 0x048B, 1, &prop22 }, { 0x048C, 1, &prop21 }, { 0x048D, 1, &prop22 }, { 0x048E, 1, &prop21 }, { 0x048F, 1, &prop22 }, { 0x0490, 1, &prop21 }, { 0x0491, 1, &prop22 }, { 0x0492, 1, &prop21 }, { 0x0493, 1, &prop22 }, { 0x0494, 1, &prop21 }, { 0x0495, 1, &prop22 }, { 0x0496, 1, &prop21 }, { 0x0497, 1, &prop22 }, { 0x0498, 1, &prop21 }, { 0x0499, 1, &prop22 }, { 0x049A, 1, &prop21 }, { 0x049B, 1, &prop22 }, { 0x049C, 1, &prop21 }, { 0x049D, 1, &prop22 }, { 0x049E, 1, &prop21 }, { 0x049F, 1, &prop22 }, { 0x04A0, 1, &prop21 }, { 0x04A1, 1, &prop22 }, { 0x04A2, 1, &prop21 }, { 0x04A3, 1, &prop22 }, { 0x04A4, 1, &prop21 }, { 0x04A5, 1, &prop22 }, { 0x04A6, 1, &prop21 }, { 0x04A7, 1, &prop22 }, { 0x04A8, 1, &prop21 }, { 0x04A9, 1, &prop22 }, { 0x04AA, 1, &prop21 }, { 0x04AB, 1, &prop22 }, { 0x04AC, 1, &prop21 }, { 0x04AD, 1, &prop22 }, { 0x04AE, 1, &prop21 }, { 0x04AF, 1, &prop22 }, { 0x04B0, 1, &prop21 }, { 0x04B1, 1, &prop22 }, { 0x04B2, 1, &prop21 }, { 0x04B3, 1, &prop22 }, { 0x04B4, 1, &prop21 }, { 0x04B5, 1, &prop22 }, { 0x04B6, 1, &prop21 }, { 0x04B7, 1, &prop22 }, { 0x04B8, 1, &prop21 }, { 0x04B9, 1, &prop22 }, { 0x04BA, 1, &prop21 }, { 0x04BB, 1, &prop22 }, { 0x04BC, 1, &prop21 }, { 0x04BD, 1, &prop22 }, { 0x04BE, 1, &prop21 }, { 0x04BF, 1, &prop22 }, { 0x04C0, 1, &prop79 }, { 0x04C1, 1, &prop21 }, { 0x04C2, 1, &prop22 }, { 0x04C3, 1, &prop21 }, { 0x04C4, 1, &prop22 }, { 0x04C5, 1, &prop21 }, { 0x04C6, 1, &prop22 }, { 0x04C7, 1, &prop21 }, { 0x04C8, 1, &prop22 }, { 0x04C9, 1, &prop21 }, { 0x04CA, 1, &prop22 }, { 0x04CB, 1, &prop21 }, { 0x04CC, 1, &prop22 }, { 0x04CD, 1, &prop21 }, { 0x04CE, 1, &prop22 }, { 0x04D0, 1, &prop21 }, { 0x04D1, 1, &prop22 }, { 0x04D2, 1, &prop21 }, { 0x04D3, 1, &prop22 }, { 0x04D4, 1, &prop21 }, { 0x04D5, 1, &prop22 }, { 0x04D6, 1, &prop21 }, { 0x04D7, 1, &prop22 }, { 0x04D8, 1, &prop21 }, { 0x04D9, 1, &prop22 }, { 0x04DA, 1, &prop21 }, { 0x04DB, 1, &prop22 }, { 0x04DC, 1, &prop21 }, { 0x04DD, 1, &prop22 }, { 0x04DE, 1, &prop21 }, { 0x04DF, 1, &prop22 }, { 0x04E0, 1, &prop21 }, { 0x04E1, 1, &prop22 }, { 0x04E2, 1, &prop21 }, { 0x04E3, 1, &prop22 }, { 0x04E4, 1, &prop21 }, { 0x04E5, 1, &prop22 }, { 0x04E6, 1, &prop21 }, { 0x04E7, 1, &prop22 }, { 0x04E8, 1, &prop21 }, { 0x04E9, 1, &prop22 }, { 0x04EA, 1, &prop21 }, { 0x04EB, 1, &prop22 }, { 0x04EC, 1, &prop21 }, { 0x04ED, 1, &prop22 }, { 0x04EE, 1, &prop21 }, { 0x04EF, 1, &prop22 }, { 0x04F0, 1, &prop21 }, { 0x04F1, 1, &prop22 }, { 0x04F2, 1, &prop21 }, { 0x04F3, 1, &prop22 }, { 0x04F4, 1, &prop21 }, { 0x04F5, 1, &prop22 }, { 0x04F8, 1, &prop21 }, { 0x04F9, 1, &prop22 }, { 0x0500, 1, &prop21 }, { 0x0501, 1, &prop22 }, { 0x0502, 1, &prop21 }, { 0x0503, 1, &prop22 }, { 0x0504, 1, &prop21 }, { 0x0505, 1, &prop22 }, { 0x0506, 1, &prop21 }, { 0x0507, 1, &prop22 }, { 0x0508, 1, &prop21 }, { 0x0509, 1, &prop22 }, { 0x050A, 1, &prop21 }, { 0x050B, 1, &prop22 }, { 0x050C, 1, &prop21 }, { 0x050D, 1, &prop22 }, { 0x050E, 1, &prop21 }, { 0x050F, 1, &prop22 }, { 0x0531, 38, &prop90 }, { 0x0559, 1, &prop65 }, { 0x055A, 6, &prop2 }, { 0x0561, 38, &prop91 }, { 0x0587, 1, &prop14 }, { 0x0589, 1, &prop2 }, { 0x058A, 1, &prop7 }, { 0x0591, 17, &prop66 }, { 0x05A3, 23, &prop66 }, { 0x05BB, 3, &prop66 }, { 0x05BE, 1, &prop2 }, { 0x05BF, 1, &prop66 }, { 0x05C0, 1, &prop2 }, { 0x05C1, 2, &prop66 }, { 0x05C3, 1, &prop2 }, { 0x05C4, 1, &prop66 }, { 0x05D0, 27, &prop43 }, { 0x05F0, 3, &prop43 }, { 0x05F3, 2, &prop2 }, { 0x0600, 4, &prop16 }, { 0x060C, 2, &prop2 }, { 0x060E, 2, &prop13 }, { 0x0610, 6, &prop66 }, { 0x061B, 1, &prop2 }, { 0x061F, 1, &prop2 }, { 0x0621, 26, &prop43 }, { 0x0640, 1, &prop65 }, { 0x0641, 10, &prop43 }, { 0x064B, 14, &prop66 }, { 0x0660, 10, &prop8 }, { 0x066A, 4, &prop2 }, { 0x066E, 2, &prop43 }, { 0x0670, 1, &prop66 }, { 0x0671, 99, &prop43 }, { 0x06D4, 1, &prop2 }, { 0x06D5, 1, &prop43 }, { 0x06D6, 7, &prop66 }, { 0x06DD, 1, &prop16 }, { 0x06DE, 1, &prop89 }, { 0x06DF, 6, &prop66 }, { 0x06E5, 2, &prop65 }, { 0x06E7, 2, &prop66 }, { 0x06E9, 1, &prop13 }, { 0x06EA, 4, &prop66 }, { 0x06EE, 2, &prop43 }, { 0x06F0, 10, &prop8 }, { 0x06FA, 3, &prop43 }, { 0x06FD, 2, &prop13 }, { 0x06FF, 1, &prop43 }, { 0x0700, 14, &prop2 }, { 0x070F, 1, &prop16 }, { 0x0710, 1, &prop43 }, { 0x0711, 1, &prop66 }, { 0x0712, 30, &prop43 }, { 0x0730, 27, &prop66 }, { 0x074D, 3, &prop43 }, { 0x0780, 38, &prop43 }, { 0x07A6, 11, &prop66 }, { 0x07B1, 1, &prop43 }, { 0x0901, 2, &prop66 }, { 0x0903, 1, &prop92 }, { 0x0904, 54, &prop43 }, { 0x093C, 1, &prop66 }, { 0x093D, 1, &prop43 }, { 0x093E, 3, &prop92 }, { 0x0941, 8, &prop66 }, { 0x0949, 4, &prop92 }, { 0x094D, 1, &prop66 }, { 0x0950, 1, &prop43 }, { 0x0951, 4, &prop66 }, { 0x0958, 10, &prop43 }, { 0x0962, 2, &prop66 }, { 0x0964, 2, &prop2 }, { 0x0966, 10, &prop8 }, { 0x0970, 1, &prop2 }, { 0x0981, 1, &prop66 }, { 0x0982, 2, &prop92 }, { 0x0985, 8, &prop43 }, { 0x098F, 2, &prop43 }, { 0x0993, 22, &prop43 }, { 0x09AA, 7, &prop43 }, { 0x09B2, 1, &prop43 }, { 0x09B6, 4, &prop43 }, { 0x09BC, 1, &prop66 }, { 0x09BD, 1, &prop43 }, { 0x09BE, 3, &prop92 }, { 0x09C1, 4, &prop66 }, { 0x09C7, 2, &prop92 }, { 0x09CB, 2, &prop92 }, { 0x09CD, 1, &prop66 }, { 0x09D7, 1, &prop92 }, { 0x09DC, 2, &prop43 }, { 0x09DF, 3, &prop43 }, { 0x09E2, 2, &prop66 }, { 0x09E6, 10, &prop8 }, { 0x09F0, 2, &prop43 }, { 0x09F2, 2, &prop3 }, { 0x09F4, 6, &prop17 }, { 0x09FA, 1, &prop13 }, { 0x0A01, 2, &prop66 }, { 0x0A03, 1, &prop92 }, { 0x0A05, 6, &prop43 }, { 0x0A0F, 2, &prop43 }, { 0x0A13, 22, &prop43 }, { 0x0A2A, 7, &prop43 }, { 0x0A32, 2, &prop43 }, { 0x0A35, 2, &prop43 }, { 0x0A38, 2, &prop43 }, { 0x0A3C, 1, &prop66 }, { 0x0A3E, 3, &prop92 }, { 0x0A41, 2, &prop66 }, { 0x0A47, 2, &prop66 }, { 0x0A4B, 3, &prop66 }, { 0x0A59, 4, &prop43 }, { 0x0A5E, 1, &prop43 }, { 0x0A66, 10, &prop8 }, { 0x0A70, 2, &prop66 }, { 0x0A72, 3, &prop43 }, { 0x0A81, 2, &prop66 }, { 0x0A83, 1, &prop92 }, { 0x0A85, 9, &prop43 }, { 0x0A8F, 3, &prop43 }, { 0x0A93, 22, &prop43 }, { 0x0AAA, 7, &prop43 }, { 0x0AB2, 2, &prop43 }, { 0x0AB5, 5, &prop43 }, { 0x0ABC, 1, &prop66 }, { 0x0ABD, 1, &prop43 }, { 0x0ABE, 3, &prop92 }, { 0x0AC1, 5, &prop66 }, { 0x0AC7, 2, &prop66 }, { 0x0AC9, 1, &prop92 }, { 0x0ACB, 2, &prop92 }, { 0x0ACD, 1, &prop66 }, { 0x0AD0, 1, &prop43 }, { 0x0AE0, 2, &prop43 }, { 0x0AE2, 2, &prop66 }, { 0x0AE6, 10, &prop8 }, { 0x0AF1, 1, &prop3 }, { 0x0B01, 1, &prop66 }, { 0x0B02, 2, &prop92 }, { 0x0B05, 8, &prop43 }, { 0x0B0F, 2, &prop43 }, { 0x0B13, 22, &prop43 }, { 0x0B2A, 7, &prop43 }, { 0x0B32, 2, &prop43 }, { 0x0B35, 5, &prop43 }, { 0x0B3C, 1, &prop66 }, { 0x0B3D, 1, &prop43 }, { 0x0B3E, 1, &prop92 }, { 0x0B3F, 1, &prop66 }, { 0x0B40, 1, &prop92 }, { 0x0B41, 3, &prop66 }, { 0x0B47, 2, &prop92 }, { 0x0B4B, 2, &prop92 }, { 0x0B4D, 1, &prop66 }, { 0x0B56, 1, &prop66 }, { 0x0B57, 1, &prop92 }, { 0x0B5C, 2, &prop43 }, { 0x0B5F, 3, &prop43 }, { 0x0B66, 10, &prop8 }, { 0x0B70, 1, &prop13 }, { 0x0B71, 1, &prop43 }, { 0x0B82, 1, &prop66 }, { 0x0B83, 1, &prop43 }, { 0x0B85, 6, &prop43 }, { 0x0B8E, 3, &prop43 }, { 0x0B92, 4, &prop43 }, { 0x0B99, 2, &prop43 }, { 0x0B9C, 1, &prop43 }, { 0x0B9E, 2, &prop43 }, { 0x0BA3, 2, &prop43 }, { 0x0BA8, 3, &prop43 }, { 0x0BAE, 8, &prop43 }, { 0x0BB7, 3, &prop43 }, { 0x0BBE, 2, &prop92 }, { 0x0BC0, 1, &prop66 }, { 0x0BC1, 2, &prop92 }, { 0x0BC6, 3, &prop92 }, { 0x0BCA, 3, &prop92 }, { 0x0BCD, 1, &prop66 }, { 0x0BD7, 1, &prop92 }, { 0x0BE7, 9, &prop8 }, { 0x0BF0, 3, &prop17 }, { 0x0BF3, 6, &prop13 }, { 0x0BF9, 1, &prop3 }, { 0x0BFA, 1, &prop13 }, { 0x0C01, 3, &prop92 }, { 0x0C05, 8, &prop43 }, { 0x0C0E, 3, &prop43 }, { 0x0C12, 23, &prop43 }, { 0x0C2A, 10, &prop43 }, { 0x0C35, 5, &prop43 }, { 0x0C3E, 3, &prop66 }, { 0x0C41, 4, &prop92 }, { 0x0C46, 3, &prop66 }, { 0x0C4A, 4, &prop66 }, { 0x0C55, 2, &prop66 }, { 0x0C60, 2, &prop43 }, { 0x0C66, 10, &prop8 }, { 0x0C82, 2, &prop92 }, { 0x0C85, 8, &prop43 }, { 0x0C8E, 3, &prop43 }, { 0x0C92, 23, &prop43 }, { 0x0CAA, 10, &prop43 }, { 0x0CB5, 5, &prop43 }, { 0x0CBC, 1, &prop66 }, { 0x0CBD, 1, &prop43 }, { 0x0CBE, 1, &prop92 }, { 0x0CBF, 1, &prop66 }, { 0x0CC0, 5, &prop92 }, { 0x0CC6, 1, &prop66 }, { 0x0CC7, 2, &prop92 }, { 0x0CCA, 2, &prop92 }, { 0x0CCC, 2, &prop66 }, { 0x0CD5, 2, &prop92 }, { 0x0CDE, 1, &prop43 }, { 0x0CE0, 2, &prop43 }, { 0x0CE6, 10, &prop8 }, { 0x0D02, 2, &prop92 }, { 0x0D05, 8, &prop43 }, { 0x0D0E, 3, &prop43 }, { 0x0D12, 23, &prop43 }, { 0x0D2A, 16, &prop43 }, { 0x0D3E, 3, &prop92 }, { 0x0D41, 3, &prop66 }, { 0x0D46, 3, &prop92 }, { 0x0D4A, 3, &prop92 }, { 0x0D4D, 1, &prop66 }, { 0x0D57, 1, &prop92 }, { 0x0D60, 2, &prop43 }, { 0x0D66, 10, &prop8 }, { 0x0D82, 2, &prop92 }, { 0x0D85, 18, &prop43 }, { 0x0D9A, 24, &prop43 }, { 0x0DB3, 9, &prop43 }, { 0x0DBD, 1, &prop43 }, { 0x0DC0, 7, &prop43 }, { 0x0DCA, 1, &prop66 }, { 0x0DCF, 3, &prop92 }, { 0x0DD2, 3, &prop66 }, { 0x0DD6, 1, &prop66 }, { 0x0DD8, 8, &prop92 }, { 0x0DF2, 2, &prop92 }, { 0x0DF4, 1, &prop2 }, { 0x0E01, 48, &prop43 }, { 0x0E31, 1, &prop66 }, { 0x0E32, 2, &prop43 }, { 0x0E34, 7, &prop66 }, { 0x0E3F, 1, &prop3 }, { 0x0E40, 6, &prop43 }, { 0x0E46, 1, &prop65 }, { 0x0E47, 8, &prop66 }, { 0x0E4F, 1, &prop2 }, { 0x0E50, 10, &prop8 }, { 0x0E5A, 2, &prop2 }, { 0x0E81, 2, &prop43 }, { 0x0E84, 1, &prop43 }, { 0x0E87, 2, &prop43 }, { 0x0E8A, 1, &prop43 }, { 0x0E8D, 1, &prop43 }, { 0x0E94, 4, &prop43 }, { 0x0E99, 7, &prop43 }, { 0x0EA1, 3, &prop43 }, { 0x0EA5, 1, &prop43 }, { 0x0EA7, 1, &prop43 }, { 0x0EAA, 2, &prop43 }, { 0x0EAD, 4, &prop43 }, { 0x0EB1, 1, &prop66 }, { 0x0EB2, 2, &prop43 }, { 0x0EB4, 6, &prop66 }, { 0x0EBB, 2, &prop66 }, { 0x0EBD, 1, &prop43 }, { 0x0EC0, 5, &prop43 }, { 0x0EC6, 1, &prop65 }, { 0x0EC8, 6, &prop66 }, { 0x0ED0, 10, &prop8 }, { 0x0EDC, 2, &prop43 }, { 0x0F00, 1, &prop43 }, { 0x0F01, 3, &prop13 }, { 0x0F04, 15, &prop2 }, { 0x0F13, 5, &prop13 }, { 0x0F18, 2, &prop66 }, { 0x0F1A, 6, &prop13 }, { 0x0F20, 10, &prop8 }, { 0x0F2A, 10, &prop17 }, { 0x0F34, 1, &prop13 }, { 0x0F35, 1, &prop66 }, { 0x0F36, 1, &prop13 }, { 0x0F37, 1, &prop66 }, { 0x0F38, 1, &prop13 }, { 0x0F39, 1, &prop66 }, { 0x0F3A, 1, &prop4 }, { 0x0F3B, 1, &prop5 }, { 0x0F3C, 1, &prop4 }, { 0x0F3D, 1, &prop5 }, { 0x0F3E, 2, &prop92 }, { 0x0F40, 8, &prop43 }, { 0x0F49, 34, &prop43 }, { 0x0F71, 14, &prop66 }, { 0x0F7F, 1, &prop92 }, { 0x0F80, 5, &prop66 }, { 0x0F85, 1, &prop2 }, { 0x0F86, 2, &prop66 }, { 0x0F88, 4, &prop43 }, { 0x0F90, 8, &prop66 }, { 0x0F99, 36, &prop66 }, { 0x0FBE, 8, &prop13 }, { 0x0FC6, 1, &prop66 }, { 0x0FC7, 6, &prop13 }, { 0x0FCF, 1, &prop13 }, { 0x1000, 34, &prop43 }, { 0x1023, 5, &prop43 }, { 0x1029, 2, &prop43 }, { 0x102C, 1, &prop92 }, { 0x102D, 4, &prop66 }, { 0x1031, 1, &prop92 }, { 0x1032, 1, &prop66 }, { 0x1036, 2, &prop66 }, { 0x1038, 1, &prop92 }, { 0x1039, 1, &prop66 }, { 0x1040, 10, &prop8 }, { 0x104A, 6, &prop2 }, { 0x1050, 6, &prop43 }, { 0x1056, 2, &prop92 }, { 0x1058, 2, &prop66 }, { 0x10A0, 38, &prop79 }, { 0x10D0, 41, &prop43 }, { 0x10FB, 1, &prop2 }, { 0x1100, 90, &prop43 }, { 0x115F, 68, &prop43 }, { 0x11A8, 82, &prop43 }, { 0x1200, 7, &prop43 }, { 0x1208, 63, &prop43 }, { 0x1248, 1, &prop43 }, { 0x124A, 4, &prop43 }, { 0x1250, 7, &prop43 }, { 0x1258, 1, &prop43 }, { 0x125A, 4, &prop43 }, { 0x1260, 39, &prop43 }, { 0x1288, 1, &prop43 }, { 0x128A, 4, &prop43 }, { 0x1290, 31, &prop43 }, { 0x12B0, 1, &prop43 }, { 0x12B2, 4, &prop43 }, { 0x12B8, 7, &prop43 }, { 0x12C0, 1, &prop43 }, { 0x12C2, 4, &prop43 }, { 0x12C8, 7, &prop43 }, { 0x12D0, 7, &prop43 }, { 0x12D8, 23, &prop43 }, { 0x12F0, 31, &prop43 }, { 0x1310, 1, &prop43 }, { 0x1312, 4, &prop43 }, { 0x1318, 7, &prop43 }, { 0x1320, 39, &prop43 }, { 0x1348, 19, &prop43 }, { 0x1361, 8, &prop2 }, { 0x1369, 9, &prop8 }, { 0x1372, 11, &prop17 }, { 0x13A0, 85, &prop43 }, { 0x1401, 620, &prop43 }, { 0x166D, 2, &prop2 }, { 0x166F, 8, &prop43 }, { 0x1680, 1, &prop1 }, { 0x1681, 26, &prop43 }, { 0x169B, 1, &prop4 }, { 0x169C, 1, &prop5 }, { 0x16A0, 75, &prop43 }, { 0x16EB, 3, &prop2 }, { 0x16EE, 3, &prop93 }, { 0x1700, 13, &prop43 }, { 0x170E, 4, &prop43 }, { 0x1712, 3, &prop66 }, { 0x1720, 18, &prop43 }, { 0x1732, 3, &prop66 }, { 0x1735, 2, &prop2 }, { 0x1740, 18, &prop43 }, { 0x1752, 2, &prop66 }, { 0x1760, 13, &prop43 }, { 0x176E, 3, &prop43 }, { 0x1772, 2, &prop66 }, { 0x1780, 52, &prop43 }, { 0x17B4, 2, &prop16 }, { 0x17B6, 1, &prop92 }, { 0x17B7, 7, &prop66 }, { 0x17BE, 8, &prop92 }, { 0x17C6, 1, &prop66 }, { 0x17C7, 2, &prop92 }, { 0x17C9, 11, &prop66 }, { 0x17D4, 3, &prop2 }, { 0x17D7, 1, &prop65 }, { 0x17D8, 3, &prop2 }, { 0x17DB, 1, &prop3 }, { 0x17DC, 1, &prop43 }, { 0x17DD, 1, &prop66 }, { 0x17E0, 10, &prop8 }, { 0x17F0, 10, &prop17 }, { 0x1800, 6, &prop2 }, { 0x1806, 1, &prop7 }, { 0x1807, 4, &prop2 }, { 0x180B, 3, &prop66 }, { 0x180E, 1, &prop1 }, { 0x1810, 10, &prop8 }, { 0x1820, 35, &prop43 }, { 0x1843, 1, &prop65 }, { 0x1844, 52, &prop43 }, { 0x1880, 41, &prop43 }, { 0x18A9, 1, &prop66 }, { 0x1900, 29, &prop43 }, { 0x1920, 3, &prop66 }, { 0x1923, 4, &prop92 }, { 0x1927, 2, &prop66 }, { 0x1929, 3, &prop92 }, { 0x1930, 2, &prop92 }, { 0x1932, 1, &prop66 }, { 0x1933, 6, &prop92 }, { 0x1939, 3, &prop66 }, { 0x1940, 1, &prop13 }, { 0x1944, 2, &prop2 }, { 0x1946, 10, &prop8 }, { 0x1950, 30, &prop43 }, { 0x1970, 5, &prop43 }, { 0x19E0, 32, &prop13 }, { 0x1D00, 44, &prop14 }, { 0x1D2C, 54, &prop65 }, { 0x1D62, 10, &prop14 }, { 0x1E00, 1, &prop21 }, { 0x1E01, 1, &prop22 }, { 0x1E02, 1, &prop21 }, { 0x1E03, 1, &prop22 }, { 0x1E04, 1, &prop21 }, { 0x1E05, 1, &prop22 }, { 0x1E06, 1, &prop21 }, { 0x1E07, 1, &prop22 }, { 0x1E08, 1, &prop21 }, { 0x1E09, 1, &prop22 }, { 0x1E0A, 1, &prop21 }, { 0x1E0B, 1, &prop22 }, { 0x1E0C, 1, &prop21 }, { 0x1E0D, 1, &prop22 }, { 0x1E0E, 1, &prop21 }, { 0x1E0F, 1, &prop22 }, { 0x1E10, 1, &prop21 }, { 0x1E11, 1, &prop22 }, { 0x1E12, 1, &prop21 }, { 0x1E13, 1, &prop22 }, { 0x1E14, 1, &prop21 }, { 0x1E15, 1, &prop22 }, { 0x1E16, 1, &prop21 }, { 0x1E17, 1, &prop22 }, { 0x1E18, 1, &prop21 }, { 0x1E19, 1, &prop22 }, { 0x1E1A, 1, &prop21 }, { 0x1E1B, 1, &prop22 }, { 0x1E1C, 1, &prop21 }, { 0x1E1D, 1, &prop22 }, { 0x1E1E, 1, &prop21 }, { 0x1E1F, 1, &prop22 }, { 0x1E20, 1, &prop21 }, { 0x1E21, 1, &prop22 }, { 0x1E22, 1, &prop21 }, { 0x1E23, 1, &prop22 }, { 0x1E24, 1, &prop21 }, { 0x1E25, 1, &prop22 }, { 0x1E26, 1, &prop21 }, { 0x1E27, 1, &prop22 }, { 0x1E28, 1, &prop21 }, { 0x1E29, 1, &prop22 }, { 0x1E2A, 1, &prop21 }, { 0x1E2B, 1, &prop22 }, { 0x1E2C, 1, &prop21 }, { 0x1E2D, 1, &prop22 }, { 0x1E2E, 1, &prop21 }, { 0x1E2F, 1, &prop22 }, { 0x1E30, 1, &prop21 }, { 0x1E31, 1, &prop22 }, { 0x1E32, 1, &prop21 }, { 0x1E33, 1, &prop22 }, { 0x1E34, 1, &prop21 }, { 0x1E35, 1, &prop22 }, { 0x1E36, 1, &prop21 }, { 0x1E37, 1, &prop22 }, { 0x1E38, 1, &prop21 }, { 0x1E39, 1, &prop22 }, { 0x1E3A, 1, &prop21 }, { 0x1E3B, 1, &prop22 }, { 0x1E3C, 1, &prop21 }, { 0x1E3D, 1, &prop22 }, { 0x1E3E, 1, &prop21 }, { 0x1E3F, 1, &prop22 }, { 0x1E40, 1, &prop21 }, { 0x1E41, 1, &prop22 }, { 0x1E42, 1, &prop21 }, { 0x1E43, 1, &prop22 }, { 0x1E44, 1, &prop21 }, { 0x1E45, 1, &prop22 }, { 0x1E46, 1, &prop21 }, { 0x1E47, 1, &prop22 }, { 0x1E48, 1, &prop21 }, { 0x1E49, 1, &prop22 }, { 0x1E4A, 1, &prop21 }, { 0x1E4B, 1, &prop22 }, { 0x1E4C, 1, &prop21 }, { 0x1E4D, 1, &prop22 }, { 0x1E4E, 1, &prop21 }, { 0x1E4F, 1, &prop22 }, { 0x1E50, 1, &prop21 }, { 0x1E51, 1, &prop22 }, { 0x1E52, 1, &prop21 }, { 0x1E53, 1, &prop22 }, { 0x1E54, 1, &prop21 }, { 0x1E55, 1, &prop22 }, { 0x1E56, 1, &prop21 }, { 0x1E57, 1, &prop22 }, { 0x1E58, 1, &prop21 }, { 0x1E59, 1, &prop22 }, { 0x1E5A, 1, &prop21 }, { 0x1E5B, 1, &prop22 }, { 0x1E5C, 1, &prop21 }, { 0x1E5D, 1, &prop22 }, { 0x1E5E, 1, &prop21 }, { 0x1E5F, 1, &prop22 }, { 0x1E60, 1, &prop21 }, { 0x1E61, 1, &prop22 }, { 0x1E62, 1, &prop21 }, { 0x1E63, 1, &prop22 }, { 0x1E64, 1, &prop21 }, { 0x1E65, 1, &prop22 }, { 0x1E66, 1, &prop21 }, { 0x1E67, 1, &prop22 }, { 0x1E68, 1, &prop21 }, { 0x1E69, 1, &prop22 }, { 0x1E6A, 1, &prop21 }, { 0x1E6B, 1, &prop22 }, { 0x1E6C, 1, &prop21 }, { 0x1E6D, 1, &prop22 }, { 0x1E6E, 1, &prop21 }, { 0x1E6F, 1, &prop22 }, { 0x1E70, 1, &prop21 }, { 0x1E71, 1, &prop22 }, { 0x1E72, 1, &prop21 }, { 0x1E73, 1, &prop22 }, { 0x1E74, 1, &prop21 }, { 0x1E75, 1, &prop22 }, { 0x1E76, 1, &prop21 }, { 0x1E77, 1, &prop22 }, { 0x1E78, 1, &prop21 }, { 0x1E79, 1, &prop22 }, { 0x1E7A, 1, &prop21 }, { 0x1E7B, 1, &prop22 }, { 0x1E7C, 1, &prop21 }, { 0x1E7D, 1, &prop22 }, { 0x1E7E, 1, &prop21 }, { 0x1E7F, 1, &prop22 }, { 0x1E80, 1, &prop21 }, { 0x1E81, 1, &prop22 }, { 0x1E82, 1, &prop21 }, { 0x1E83, 1, &prop22 }, { 0x1E84, 1, &prop21 }, { 0x1E85, 1, &prop22 }, { 0x1E86, 1, &prop21 }, { 0x1E87, 1, &prop22 }, { 0x1E88, 1, &prop21 }, { 0x1E89, 1, &prop22 }, { 0x1E8A, 1, &prop21 }, { 0x1E8B, 1, &prop22 }, { 0x1E8C, 1, &prop21 }, { 0x1E8D, 1, &prop22 }, { 0x1E8E, 1, &prop21 }, { 0x1E8F, 1, &prop22 }, { 0x1E90, 1, &prop21 }, { 0x1E91, 1, &prop22 }, { 0x1E92, 1, &prop21 }, { 0x1E93, 1, &prop22 }, { 0x1E94, 1, &prop21 }, { 0x1E95, 1, &prop22 }, { 0x1E96, 5, &prop14 }, { 0x1E9B, 1, &prop94 }, { 0x1EA0, 1, &prop21 }, { 0x1EA1, 1, &prop22 }, { 0x1EA2, 1, &prop21 }, { 0x1EA3, 1, &prop22 }, { 0x1EA4, 1, &prop21 }, { 0x1EA5, 1, &prop22 }, { 0x1EA6, 1, &prop21 }, { 0x1EA7, 1, &prop22 }, { 0x1EA8, 1, &prop21 }, { 0x1EA9, 1, &prop22 }, { 0x1EAA, 1, &prop21 }, { 0x1EAB, 1, &prop22 }, { 0x1EAC, 1, &prop21 }, { 0x1EAD, 1, &prop22 }, { 0x1EAE, 1, &prop21 }, { 0x1EAF, 1, &prop22 }, { 0x1EB0, 1, &prop21 }, { 0x1EB1, 1, &prop22 }, { 0x1EB2, 1, &prop21 }, { 0x1EB3, 1, &prop22 }, { 0x1EB4, 1, &prop21 }, { 0x1EB5, 1, &prop22 }, { 0x1EB6, 1, &prop21 }, { 0x1EB7, 1, &prop22 }, { 0x1EB8, 1, &prop21 }, { 0x1EB9, 1, &prop22 }, { 0x1EBA, 1, &prop21 }, { 0x1EBB, 1, &prop22 }, { 0x1EBC, 1, &prop21 }, { 0x1EBD, 1, &prop22 }, { 0x1EBE, 1, &prop21 }, { 0x1EBF, 1, &prop22 }, { 0x1EC0, 1, &prop21 }, { 0x1EC1, 1, &prop22 }, { 0x1EC2, 1, &prop21 }, { 0x1EC3, 1, &prop22 }, { 0x1EC4, 1, &prop21 }, { 0x1EC5, 1, &prop22 }, { 0x1EC6, 1, &prop21 }, { 0x1EC7, 1, &prop22 }, { 0x1EC8, 1, &prop21 }, { 0x1EC9, 1, &prop22 }, { 0x1ECA, 1, &prop21 }, { 0x1ECB, 1, &prop22 }, { 0x1ECC, 1, &prop21 }, { 0x1ECD, 1, &prop22 }, { 0x1ECE, 1, &prop21 }, { 0x1ECF, 1, &prop22 }, { 0x1ED0, 1, &prop21 }, { 0x1ED1, 1, &prop22 }, { 0x1ED2, 1, &prop21 }, { 0x1ED3, 1, &prop22 }, { 0x1ED4, 1, &prop21 }, { 0x1ED5, 1, &prop22 }, { 0x1ED6, 1, &prop21 }, { 0x1ED7, 1, &prop22 }, { 0x1ED8, 1, &prop21 }, { 0x1ED9, 1, &prop22 }, { 0x1EDA, 1, &prop21 }, { 0x1EDB, 1, &prop22 }, { 0x1EDC, 1, &prop21 }, { 0x1EDD, 1, &prop22 }, { 0x1EDE, 1, &prop21 }, { 0x1EDF, 1, &prop22 }, { 0x1EE0, 1, &prop21 }, { 0x1EE1, 1, &prop22 }, { 0x1EE2, 1, &prop21 }, { 0x1EE3, 1, &prop22 }, { 0x1EE4, 1, &prop21 }, { 0x1EE5, 1, &prop22 }, { 0x1EE6, 1, &prop21 }, { 0x1EE7, 1, &prop22 }, { 0x1EE8, 1, &prop21 }, { 0x1EE9, 1, &prop22 }, { 0x1EEA, 1, &prop21 }, { 0x1EEB, 1, &prop22 }, { 0x1EEC, 1, &prop21 }, { 0x1EED, 1, &prop22 }, { 0x1EEE, 1, &prop21 }, { 0x1EEF, 1, &prop22 }, { 0x1EF0, 1, &prop21 }, { 0x1EF1, 1, &prop22 }, { 0x1EF2, 1, &prop21 }, { 0x1EF3, 1, &prop22 }, { 0x1EF4, 1, &prop21 }, { 0x1EF5, 1, &prop22 }, { 0x1EF6, 1, &prop21 }, { 0x1EF7, 1, &prop22 }, { 0x1EF8, 1, &prop21 }, { 0x1EF9, 1, &prop22 }, { 0x1F00, 8, &prop95 }, { 0x1F08, 8, &prop96 }, { 0x1F10, 6, &prop95 }, { 0x1F18, 6, &prop96 }, { 0x1F20, 8, &prop95 }, { 0x1F28, 8, &prop96 }, { 0x1F30, 8, &prop95 }, { 0x1F38, 8, &prop96 }, { 0x1F40, 6, &prop95 }, { 0x1F48, 6, &prop96 }, { 0x1F50, 1, &prop14 }, { 0x1F51, 1, &prop95 }, { 0x1F52, 1, &prop14 }, { 0x1F53, 1, &prop95 }, { 0x1F54, 1, &prop14 }, { 0x1F55, 1, &prop95 }, { 0x1F56, 1, &prop14 }, { 0x1F57, 1, &prop95 }, { 0x1F59, 1, &prop96 }, { 0x1F5B, 1, &prop96 }, { 0x1F5D, 1, &prop96 }, { 0x1F5F, 1, &prop96 }, { 0x1F60, 8, &prop95 }, { 0x1F68, 8, &prop96 }, { 0x1F70, 2, &prop97 }, { 0x1F72, 4, &prop98 }, { 0x1F76, 2, &prop99 }, { 0x1F78, 2, &prop100 }, { 0x1F7A, 2, &prop101 }, { 0x1F7C, 2, &prop102 }, { 0x1F80, 8, &prop95 }, { 0x1F88, 8, &prop103 }, { 0x1F90, 8, &prop95 }, { 0x1F98, 8, &prop103 }, { 0x1FA0, 8, &prop95 }, { 0x1FA8, 8, &prop103 }, { 0x1FB0, 2, &prop95 }, { 0x1FB2, 1, &prop14 }, { 0x1FB3, 1, &prop104 }, { 0x1FB4, 1, &prop14 }, { 0x1FB6, 2, &prop14 }, { 0x1FB8, 2, &prop96 }, { 0x1FBA, 2, &prop105 }, { 0x1FBC, 1, &prop106 }, { 0x1FBD, 1, &prop10 }, { 0x1FBE, 1, &prop107 }, { 0x1FBF, 3, &prop10 }, { 0x1FC2, 1, &prop14 }, { 0x1FC3, 1, &prop104 }, { 0x1FC4, 1, &prop14 }, { 0x1FC6, 2, &prop14 }, { 0x1FC8, 4, &prop108 }, { 0x1FCC, 1, &prop106 }, { 0x1FCD, 3, &prop10 }, { 0x1FD0, 2, &prop95 }, { 0x1FD2, 2, &prop14 }, { 0x1FD6, 2, &prop14 }, { 0x1FD8, 2, &prop96 }, { 0x1FDA, 2, &prop109 }, { 0x1FDD, 3, &prop10 }, { 0x1FE0, 2, &prop95 }, { 0x1FE2, 3, &prop14 }, { 0x1FE5, 1, &prop84 }, { 0x1FE6, 2, &prop14 }, { 0x1FE8, 2, &prop96 }, { 0x1FEA, 2, &prop110 }, { 0x1FEC, 1, &prop87 }, { 0x1FED, 3, &prop10 }, { 0x1FF2, 1, &prop14 }, { 0x1FF3, 1, &prop104 }, { 0x1FF4, 1, &prop14 }, { 0x1FF6, 2, &prop14 }, { 0x1FF8, 2, &prop111 }, { 0x1FFA, 2, &prop112 }, { 0x1FFC, 1, &prop106 }, { 0x1FFD, 2, &prop10 }, { 0x2000, 12, &prop1 }, { 0x200C, 4, &prop16 }, { 0x2010, 6, &prop7 }, { 0x2016, 2, &prop2 }, { 0x2018, 1, &prop15 }, { 0x2019, 1, &prop19 }, { 0x201A, 1, &prop4 }, { 0x201B, 2, &prop15 }, { 0x201D, 1, &prop19 }, { 0x201E, 1, &prop4 }, { 0x201F, 1, &prop15 }, { 0x2020, 8, &prop2 }, { 0x2028, 1, &prop113 }, { 0x2029, 1, &prop114 }, { 0x202A, 5, &prop16 }, { 0x202F, 1, &prop1 }, { 0x2030, 9, &prop2 }, { 0x2039, 1, &prop15 }, { 0x203A, 1, &prop19 }, { 0x203B, 4, &prop2 }, { 0x203F, 2, &prop11 }, { 0x2041, 3, &prop2 }, { 0x2044, 1, &prop6 }, { 0x2045, 1, &prop4 }, { 0x2046, 1, &prop5 }, { 0x2047, 11, &prop2 }, { 0x2052, 1, &prop6 }, { 0x2053, 1, &prop2 }, { 0x2054, 1, &prop11 }, { 0x2057, 1, &prop2 }, { 0x205F, 1, &prop1 }, { 0x2060, 4, &prop16 }, { 0x206A, 6, &prop16 }, { 0x2070, 1, &prop17 }, { 0x2071, 1, &prop14 }, { 0x2074, 6, &prop17 }, { 0x207A, 3, &prop6 }, { 0x207D, 1, &prop4 }, { 0x207E, 1, &prop5 }, { 0x207F, 1, &prop14 }, { 0x2080, 10, &prop17 }, { 0x208A, 3, &prop6 }, { 0x208D, 1, &prop4 }, { 0x208E, 1, &prop5 }, { 0x20A0, 18, &prop3 }, { 0x20D0, 13, &prop66 }, { 0x20DD, 4, &prop89 }, { 0x20E1, 1, &prop66 }, { 0x20E2, 3, &prop89 }, { 0x20E5, 6, &prop66 }, { 0x2100, 2, &prop13 }, { 0x2102, 1, &prop79 }, { 0x2103, 4, &prop13 }, { 0x2107, 1, &prop79 }, { 0x2108, 2, &prop13 }, { 0x210A, 1, &prop14 }, { 0x210B, 3, &prop79 }, { 0x210E, 2, &prop14 }, { 0x2110, 3, &prop79 }, { 0x2113, 1, &prop14 }, { 0x2114, 1, &prop13 }, { 0x2115, 1, &prop79 }, { 0x2116, 3, &prop13 }, { 0x2119, 5, &prop79 }, { 0x211E, 6, &prop13 }, { 0x2124, 1, &prop79 }, { 0x2125, 1, &prop13 }, { 0x2126, 1, &prop115 }, { 0x2127, 1, &prop13 }, { 0x2128, 1, &prop79 }, { 0x2129, 1, &prop13 }, { 0x212A, 1, &prop116 }, { 0x212B, 1, &prop117 }, { 0x212C, 2, &prop79 }, { 0x212E, 1, &prop13 }, { 0x212F, 1, &prop14 }, { 0x2130, 2, &prop79 }, { 0x2132, 1, &prop13 }, { 0x2133, 1, &prop79 }, { 0x2134, 1, &prop14 }, { 0x2135, 4, &prop43 }, { 0x2139, 1, &prop14 }, { 0x213A, 2, &prop13 }, { 0x213D, 1, &prop14 }, { 0x213E, 2, &prop79 }, { 0x2140, 5, &prop6 }, { 0x2145, 1, &prop79 }, { 0x2146, 4, &prop14 }, { 0x214A, 1, &prop13 }, { 0x214B, 1, &prop6 }, { 0x2153, 13, &prop17 }, { 0x2160, 16, &prop118 }, { 0x2170, 16, &prop119 }, { 0x2180, 4, &prop93 }, { 0x2190, 5, &prop6 }, { 0x2195, 5, &prop13 }, { 0x219A, 2, &prop6 }, { 0x219C, 4, &prop13 }, { 0x21A0, 1, &prop6 }, { 0x21A1, 2, &prop13 }, { 0x21A3, 1, &prop6 }, { 0x21A4, 2, &prop13 }, { 0x21A6, 1, &prop6 }, { 0x21A7, 7, &prop13 }, { 0x21AE, 1, &prop6 }, { 0x21AF, 31, &prop13 }, { 0x21CE, 2, &prop6 }, { 0x21D0, 2, &prop13 }, { 0x21D2, 1, &prop6 }, { 0x21D3, 1, &prop13 }, { 0x21D4, 1, &prop6 }, { 0x21D5, 31, &prop13 }, { 0x21F4, 268, &prop6 }, { 0x2300, 8, &prop13 }, { 0x2308, 4, &prop6 }, { 0x230C, 20, &prop13 }, { 0x2320, 2, &prop6 }, { 0x2322, 7, &prop13 }, { 0x2329, 1, &prop4 }, { 0x232A, 1, &prop5 }, { 0x232B, 81, &prop13 }, { 0x237C, 1, &prop6 }, { 0x237D, 30, &prop13 }, { 0x239B, 25, &prop6 }, { 0x23B4, 1, &prop4 }, { 0x23B5, 1, &prop5 }, { 0x23B6, 1, &prop2 }, { 0x23B7, 26, &prop13 }, { 0x2400, 39, &prop13 }, { 0x2440, 11, &prop13 }, { 0x2460, 60, &prop17 }, { 0x249C, 26, &prop13 }, { 0x24B6, 26, &prop120 }, { 0x24D0, 26, &prop121 }, { 0x24EA, 22, &prop17 }, { 0x2500, 183, &prop13 }, { 0x25B7, 1, &prop6 }, { 0x25B8, 9, &prop13 }, { 0x25C1, 1, &prop6 }, { 0x25C2, 54, &prop13 }, { 0x25F8, 8, &prop6 }, { 0x2600, 24, &prop13 }, { 0x2619, 86, &prop13 }, { 0x266F, 1, &prop6 }, { 0x2670, 14, &prop13 }, { 0x2680, 18, &prop13 }, { 0x26A0, 2, &prop13 }, { 0x2701, 4, &prop13 }, { 0x2706, 4, &prop13 }, { 0x270C, 28, &prop13 }, { 0x2729, 35, &prop13 }, { 0x274D, 1, &prop13 }, { 0x274F, 4, &prop13 }, { 0x2756, 1, &prop13 }, { 0x2758, 7, &prop13 }, { 0x2761, 7, &prop13 }, { 0x2768, 1, &prop4 }, { 0x2769, 1, &prop5 }, { 0x276A, 1, &prop4 }, { 0x276B, 1, &prop5 }, { 0x276C, 1, &prop4 }, { 0x276D, 1, &prop5 }, { 0x276E, 1, &prop4 }, { 0x276F, 1, &prop5 }, { 0x2770, 1, &prop4 }, { 0x2771, 1, &prop5 }, { 0x2772, 1, &prop4 }, { 0x2773, 1, &prop5 }, { 0x2774, 1, &prop4 }, { 0x2775, 1, &prop5 }, { 0x2776, 30, &prop17 }, { 0x2794, 1, &prop13 }, { 0x2798, 24, &prop13 }, { 0x27B1, 14, &prop13 }, { 0x27D0, 22, &prop6 }, { 0x27E6, 1, &prop4 }, { 0x27E7, 1, &prop5 }, { 0x27E8, 1, &prop4 }, { 0x27E9, 1, &prop5 }, { 0x27EA, 1, &prop4 }, { 0x27EB, 1, &prop5 }, { 0x27F0, 16, &prop6 }, { 0x2800, 256, &prop13 }, { 0x2900, 131, &prop6 }, { 0x2983, 1, &prop4 }, { 0x2984, 1, &prop5 }, { 0x2985, 1, &prop4 }, { 0x2986, 1, &prop5 }, { 0x2987, 1, &prop4 }, { 0x2988, 1, &prop5 }, { 0x2989, 1, &prop4 }, { 0x298A, 1, &prop5 }, { 0x298B, 1, &prop4 }, { 0x298C, 1, &prop5 }, { 0x298D, 1, &prop4 }, { 0x298E, 1, &prop5 }, { 0x298F, 1, &prop4 }, { 0x2990, 1, &prop5 }, { 0x2991, 1, &prop4 }, { 0x2992, 1, &prop5 }, { 0x2993, 1, &prop4 }, { 0x2994, 1, &prop5 }, { 0x2995, 1, &prop4 }, { 0x2996, 1, &prop5 }, { 0x2997, 1, &prop4 }, { 0x2998, 1, &prop5 }, { 0x2999, 63, &prop6 }, { 0x29D8, 1, &prop4 }, { 0x29D9, 1, &prop5 }, { 0x29DA, 1, &prop4 }, { 0x29DB, 1, &prop5 }, { 0x29DC, 32, &prop6 }, { 0x29FC, 1, &prop4 }, { 0x29FD, 1, &prop5 }, { 0x29FE, 258, &prop6 }, { 0x2B00, 14, &prop13 }, { 0x2E80, 26, &prop13 }, { 0x2E9B, 89, &prop13 }, { 0x2F00, 214, &prop13 }, { 0x2FF0, 12, &prop13 }, { 0x3000, 1, &prop1 }, { 0x3001, 3, &prop2 }, { 0x3004, 1, &prop13 }, { 0x3005, 1, &prop65 }, { 0x3006, 1, &prop43 }, { 0x3007, 1, &prop93 }, { 0x3008, 1, &prop4 }, { 0x3009, 1, &prop5 }, { 0x300A, 1, &prop4 }, { 0x300B, 1, &prop5 }, { 0x300C, 1, &prop4 }, { 0x300D, 1, &prop5 }, { 0x300E, 1, &prop4 }, { 0x300F, 1, &prop5 }, { 0x3010, 1, &prop4 }, { 0x3011, 1, &prop5 }, { 0x3012, 2, &prop13 }, { 0x3014, 1, &prop4 }, { 0x3015, 1, &prop5 }, { 0x3016, 1, &prop4 }, { 0x3017, 1, &prop5 }, { 0x3018, 1, &prop4 }, { 0x3019, 1, &prop5 }, { 0x301A, 1, &prop4 }, { 0x301B, 1, &prop5 }, { 0x301C, 1, &prop7 }, { 0x301D, 1, &prop4 }, { 0x301E, 2, &prop5 }, { 0x3020, 1, &prop13 }, { 0x3021, 9, &prop93 }, { 0x302A, 6, &prop66 }, { 0x3030, 1, &prop7 }, { 0x3031, 5, &prop65 }, { 0x3036, 2, &prop13 }, { 0x3038, 3, &prop93 }, { 0x303B, 1, &prop65 }, { 0x303C, 1, &prop43 }, { 0x303D, 1, &prop2 }, { 0x303E, 2, &prop13 }, { 0x3041, 86, &prop43 }, { 0x3099, 2, &prop66 }, { 0x309B, 2, &prop10 }, { 0x309D, 2, &prop65 }, { 0x309F, 1, &prop43 }, { 0x30A0, 1, &prop7 }, { 0x30A1, 90, &prop43 }, { 0x30FB, 1, &prop11 }, { 0x30FC, 3, &prop65 }, { 0x30FF, 1, &prop43 }, { 0x3105, 40, &prop43 }, { 0x3131, 94, &prop43 }, { 0x3190, 2, &prop13 }, { 0x3192, 4, &prop17 }, { 0x3196, 10, &prop13 }, { 0x31A0, 24, &prop43 }, { 0x31F0, 16, &prop43 }, { 0x3200, 31, &prop13 }, { 0x3220, 10, &prop17 }, { 0x322A, 26, &prop13 }, { 0x3250, 1, &prop13 }, { 0x3251, 15, &prop17 }, { 0x3260, 30, &prop13 }, { 0x327F, 1, &prop13 }, { 0x3280, 10, &prop17 }, { 0x328A, 39, &prop13 }, { 0x32B1, 15, &prop17 }, { 0x32C0, 63, &prop13 }, { 0x3300, 256, &prop13 }, { 0x3400, 6582, &prop43 }, { 0x4DC0, 64, &prop13 }, { 0x4E00, 20902, &prop43 }, { 0xA000, 1165, &prop43 }, { 0xA490, 55, &prop13 }, { 0xAC00, 11172, &prop43 }, { 0xD800, 2048, &prop122 }, { 0xE000, 6400, &prop123 }, { 0xF900, 302, &prop43 }, { 0xFA30, 59, &prop43 }, { 0xFB00, 7, &prop14 }, { 0xFB13, 5, &prop14 }, { 0xFB1D, 1, &prop43 }, { 0xFB1E, 1, &prop66 }, { 0xFB1F, 10, &prop43 }, { 0xFB29, 1, &prop6 }, { 0xFB2A, 13, &prop43 }, { 0xFB38, 5, &prop43 }, { 0xFB3E, 1, &prop43 }, { 0xFB40, 2, &prop43 }, { 0xFB43, 2, &prop43 }, { 0xFB46, 108, &prop43 }, { 0xFBD3, 363, &prop43 }, { 0xFD3E, 1, &prop4 }, { 0xFD3F, 1, &prop5 }, { 0xFD50, 64, &prop43 }, { 0xFD92, 54, &prop43 }, { 0xFDF0, 12, &prop43 }, { 0xFDFC, 1, &prop3 }, { 0xFDFD, 1, &prop13 }, { 0xFE00, 16, &prop66 }, { 0xFE20, 4, &prop66 }, { 0xFE30, 1, &prop2 }, { 0xFE31, 2, &prop7 }, { 0xFE33, 2, &prop11 }, { 0xFE35, 1, &prop4 }, { 0xFE36, 1, &prop5 }, { 0xFE37, 1, &prop4 }, { 0xFE38, 1, &prop5 }, { 0xFE39, 1, &prop4 }, { 0xFE3A, 1, &prop5 }, { 0xFE3B, 1, &prop4 }, { 0xFE3C, 1, &prop5 }, { 0xFE3D, 1, &prop4 }, { 0xFE3E, 1, &prop5 }, { 0xFE3F, 1, &prop4 }, { 0xFE40, 1, &prop5 }, { 0xFE41, 1, &prop4 }, { 0xFE42, 1, &prop5 }, { 0xFE43, 1, &prop4 }, { 0xFE44, 1, &prop5 }, { 0xFE45, 2, &prop2 }, { 0xFE47, 1, &prop4 }, { 0xFE48, 1, &prop5 }, { 0xFE49, 4, &prop2 }, { 0xFE4D, 3, &prop11 }, { 0xFE50, 3, &prop2 }, { 0xFE54, 4, &prop2 }, { 0xFE58, 1, &prop7 }, { 0xFE59, 1, &prop4 }, { 0xFE5A, 1, &prop5 }, { 0xFE5B, 1, &prop4 }, { 0xFE5C, 1, &prop5 }, { 0xFE5D, 1, &prop4 }, { 0xFE5E, 1, &prop5 }, { 0xFE5F, 3, &prop2 }, { 0xFE62, 1, &prop6 }, { 0xFE63, 1, &prop7 }, { 0xFE64, 3, &prop6 }, { 0xFE68, 1, &prop2 }, { 0xFE69, 1, &prop3 }, { 0xFE6A, 2, &prop2 }, { 0xFE70, 5, &prop43 }, { 0xFE76, 135, &prop43 }, { 0xFEFF, 1, &prop16 }, { 0xFF01, 3, &prop2 }, { 0xFF04, 1, &prop3 }, { 0xFF05, 3, &prop2 }, { 0xFF08, 1, &prop4 }, { 0xFF09, 1, &prop5 }, { 0xFF0A, 1, &prop2 }, { 0xFF0B, 1, &prop6 }, { 0xFF0C, 1, &prop2 }, { 0xFF0D, 1, &prop7 }, { 0xFF0E, 2, &prop2 }, { 0xFF10, 10, &prop8 }, { 0xFF1A, 2, &prop2 }, { 0xFF1C, 3, &prop6 }, { 0xFF1F, 2, &prop2 }, { 0xFF21, 26, &prop9 }, { 0xFF3B, 1, &prop4 }, { 0xFF3C, 1, &prop2 }, { 0xFF3D, 1, &prop5 }, { 0xFF3E, 1, &prop10 }, { 0xFF3F, 1, &prop11 }, { 0xFF40, 1, &prop10 }, { 0xFF41, 26, &prop12 }, { 0xFF5B, 1, &prop4 }, { 0xFF5C, 1, &prop6 }, { 0xFF5D, 1, &prop5 }, { 0xFF5E, 1, &prop6 }, { 0xFF5F, 1, &prop4 }, { 0xFF60, 1, &prop5 }, { 0xFF61, 1, &prop2 }, { 0xFF62, 1, &prop4 }, { 0xFF63, 1, &prop5 }, { 0xFF64, 1, &prop2 }, { 0xFF65, 1, &prop11 }, { 0xFF66, 10, &prop43 }, { 0xFF70, 1, &prop65 }, { 0xFF71, 45, &prop43 }, { 0xFF9E, 2, &prop65 }, { 0xFFA0, 31, &prop43 }, { 0xFFC2, 6, &prop43 }, { 0xFFCA, 6, &prop43 }, { 0xFFD2, 6, &prop43 }, { 0xFFDA, 3, &prop43 }, { 0xFFE0, 2, &prop3 }, { 0xFFE2, 1, &prop6 }, { 0xFFE3, 1, &prop10 }, { 0xFFE4, 1, &prop13 }, { 0xFFE5, 2, &prop3 }, { 0xFFE8, 1, &prop13 }, { 0xFFE9, 4, &prop6 }, { 0xFFED, 2, &prop13 }, { 0xFFF9, 3, &prop16 }, { 0xFFFC, 2, &prop13 }, { 0x10000, 12, &prop43 }, { 0x1000D, 26, &prop43 }, { 0x10028, 19, &prop43 }, { 0x1003C, 2, &prop43 }, { 0x1003F, 15, &prop43 }, { 0x10050, 14, &prop43 }, { 0x10080, 123, &prop43 }, { 0x10100, 2, &prop2 }, { 0x10102, 1, &prop13 }, { 0x10107, 45, &prop17 }, { 0x10137, 9, &prop13 }, { 0x10300, 31, &prop43 }, { 0x10320, 4, &prop17 }, { 0x10330, 26, &prop43 }, { 0x1034A, 1, &prop93 }, { 0x10380, 30, &prop43 }, { 0x1039F, 1, &prop2 }, { 0x10400, 40, &prop124 }, { 0x10428, 40, &prop125 }, { 0x10450, 78, &prop43 }, { 0x104A0, 10, &prop8 }, { 0x10800, 6, &prop43 }, { 0x10808, 1, &prop43 }, { 0x1080A, 44, &prop43 }, { 0x10837, 2, &prop43 }, { 0x1083C, 1, &prop43 }, { 0x1083F, 1, &prop43 }, { 0x1D000, 246, &prop13 }, { 0x1D100, 39, &prop13 }, { 0x1D12A, 59, &prop13 }, { 0x1D165, 2, &prop92 }, { 0x1D167, 3, &prop66 }, { 0x1D16A, 3, &prop13 }, { 0x1D16D, 6, &prop92 }, { 0x1D173, 8, &prop16 }, { 0x1D17B, 8, &prop66 }, { 0x1D183, 2, &prop13 }, { 0x1D185, 7, &prop66 }, { 0x1D18C, 30, &prop13 }, { 0x1D1AA, 4, &prop66 }, { 0x1D1AE, 48, &prop13 }, { 0x1D300, 87, &prop13 }, { 0x1D400, 26, &prop79 }, { 0x1D41A, 26, &prop14 }, { 0x1D434, 26, &prop79 }, { 0x1D44E, 7, &prop14 }, { 0x1D456, 18, &prop14 }, { 0x1D468, 26, &prop79 }, { 0x1D482, 26, &prop14 }, { 0x1D49C, 1, &prop79 }, { 0x1D49E, 2, &prop79 }, { 0x1D4A2, 1, &prop79 }, { 0x1D4A5, 2, &prop79 }, { 0x1D4A9, 4, &prop79 }, { 0x1D4AE, 8, &prop79 }, { 0x1D4B6, 4, &prop14 }, { 0x1D4BB, 1, &prop14 }, { 0x1D4BD, 7, &prop14 }, { 0x1D4C5, 11, &prop14 }, { 0x1D4D0, 26, &prop79 }, { 0x1D4EA, 26, &prop14 }, { 0x1D504, 2, &prop79 }, { 0x1D507, 4, &prop79 }, { 0x1D50D, 8, &prop79 }, { 0x1D516, 7, &prop79 }, { 0x1D51E, 26, &prop14 }, { 0x1D538, 2, &prop79 }, { 0x1D53B, 4, &prop79 }, { 0x1D540, 5, &prop79 }, { 0x1D546, 1, &prop79 }, { 0x1D54A, 7, &prop79 }, { 0x1D552, 26, &prop14 }, { 0x1D56C, 26, &prop79 }, { 0x1D586, 26, &prop14 }, { 0x1D5A0, 26, &prop79 }, { 0x1D5BA, 26, &prop14 }, { 0x1D5D4, 26, &prop79 }, { 0x1D5EE, 26, &prop14 }, { 0x1D608, 26, &prop79 }, { 0x1D622, 26, &prop14 }, { 0x1D63C, 26, &prop79 }, { 0x1D656, 26, &prop14 }, { 0x1D670, 26, &prop79 }, { 0x1D68A, 26, &prop14 }, { 0x1D6A8, 25, &prop79 }, { 0x1D6C1, 1, &prop6 }, { 0x1D6C2, 25, &prop14 }, { 0x1D6DB, 1, &prop6 }, { 0x1D6DC, 6, &prop14 }, { 0x1D6E2, 25, &prop79 }, { 0x1D6FB, 1, &prop6 }, { 0x1D6FC, 25, &prop14 }, { 0x1D715, 1, &prop6 }, { 0x1D716, 6, &prop14 }, { 0x1D71C, 25, &prop79 }, { 0x1D735, 1, &prop6 }, { 0x1D736, 25, &prop14 }, { 0x1D74F, 1, &prop6 }, { 0x1D750, 6, &prop14 }, { 0x1D756, 25, &prop79 }, { 0x1D76F, 1, &prop6 }, { 0x1D770, 25, &prop14 }, { 0x1D789, 1, &prop6 }, { 0x1D78A, 6, &prop14 }, { 0x1D790, 25, &prop79 }, { 0x1D7A9, 1, &prop6 }, { 0x1D7AA, 25, &prop14 }, { 0x1D7C3, 1, &prop6 }, { 0x1D7C4, 6, &prop14 }, { 0x1D7CE, 50, &prop8 }, { 0x20000, 42711, &prop43 }, { 0x2F800, 542, &prop43 }, { 0xE0001, 1, &prop16 }, { 0xE0020, 96, &prop16 }, { 0xE0100, 240, &prop66 }, { 0xF0000, 65534, &prop123 }, { 0x100000, 65534, &prop123 } }; hugs98-plus-Sep2006/src/version.c0000644006511100651110000000356010504340627015410 0ustar rossross/* -------------------------------------------------------------------------- * Version string * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * ------------------------------------------------------------------------*/ /* Is this a major release or not? */ #define MAJOR_RELEASE 1 /* Define this as a string (of _max_ 14 characters) uniquely identifying the * current version. Upper limit of 14 chars is there to make the banner * come out nice and aligned. * * Major releases are of the form " " * Minor releases are of the form "Version YYYYMMDD" * Anyone else should use a different format to avoid confusion. * * On standard unix platforms, the Makefile will automatically fill in * the date for both major and minor releases. Only modify this file * if you need to override the automatically generated date. * * However, if your system doesn't have GNU date, then the version strings * will be empty, and you'll want to manually specify the version strings. */ #include "prelude.h" #if defined(_MSC_VER) /* When compiling via MSVC (by using {msc,winhugs}/Makefile), * echodate.h contains the generated define for YYYYMMDD */ #include "echodate.h" #endif #ifndef MONTH_YEAR #define VERSION_STRING "" #else #if MAJOR_RELEASE #define VERSION_STRING "September 2006" #else #define VERSION_STRING "20060920" #endif #endif String versionString = VERSION_STRING; #if USE_REGISTRY #if HUGS_FOR_WINDOWS #define HUGSROOT ("SOFTWARE\\Haskell\\Hugs\\Winhugs" VERSION_STRING "\\") #else #define HUGSROOT ("SOFTWARE\\Haskell\\Hugs\\" VERSION_STRING "\\") #endif String hugsRegRoot = HUGSROOT; #endif hugs98-plus-Sep2006/src/djgpp2/0000755006511100651110000000000010504340135014733 5ustar rossrosshugs98-plus-Sep2006/src/djgpp2/Makefile0000644006511100651110000001160307743000214016376 0ustar rossross# -------------------------------------------------------------------------- # Makefile for Hugs (adapted for use with djgpp2) # # The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the # Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, # 1994-2003, All rights reserved. It is distributed as # free software under the license in the file "License", which is # included in the distribution. # -------------------------------------------------------------------------- # Targets: # # : make hugs.exe # hugs.exe: make minimal working system # runhugs.exe: make standalone evaluator # clean: delete files not required in running system # distclean: delete files that can be regenerated using C compiler # veryclean: delete all machine generated files # (you need perl, bison/yacc, etc to rebuild these files) # check: run regression tests # TAGS: build emacs TAGS table # This rule goes first to make it the default choice default :: hugs.exe runhugs.exe CC = gcc CFLAGS = -g -O LD = gcc LDFLAGS = LIBS = YACC = bison -y RM = DEL CP = COPY .SUFFIXES : .SUFFIXES : .c .h .o HFILES = prelude.h config.h options.h storage.h connect.h \ errors.h command.h server.h HsFFI.h module.h machdep.h script.h CFILES = hugs.c storage.c input.c static.c type.c subst.c \ output.c compiler.c machine.c interp.c builtin.c \ server.c ffi.c module.c machdep.c script.c INCFILES = parser.c preds.c bignums.c scc.c timer.c \ printer.c iomonad.c interns.c array.c YFILES = parser.y SOURCES = $(HFILES) $(CFILES) $(INCFILES) $(YFILES) OBJECTS = storage.o input.o static.o type.o subst.o compiler.o \ plugin.o builtin.o machine.o output.o ffi.o version.o module.o machdep.o IOBJECTS = hugs.o $(OBJECTS) PRELUDE = config.h options.h prelude.h script.h ################################################################ # Hugs interpreter and standalone evaluator ################################################################ hugs.exe : $(IOBJECTS) $(LD) $(LDFLAGS) -o hugs.exe $(IOBJECTS) $(LIBS) # strip hugs.exe # coff2exe hugs.exe # for DJGPP2 SERVER_OBJECTS = server.o $(OBJECTS) runhugs.o : config.h options.h server.h runhugs.c runhugs.exe : runhugs.o $(SERVER_OBJECTS) $(LD) $(LDFLAGS) -o runhugs.exe runhugs.o $(SERVER_OBJECTS) $(LIBS) ################################################################ # Clean, distclean, veryclean, TAGS ################################################################ clean :: $(RM) *.o $(RM) *.aux $(RM) *.hp $(RM) *.def $(RM) *.exp $(RM) *.ilk $(RM) *.lib $(RM) *.pdb $(RM) *.td2 $(RM) *.map $(RM) *.csm $(RM) *.MAP $(RM) *.TR2 $(RM) *.RES $(RM) *.DSW $(RM) *.OBJ distclean :: clean distclean :: $(RM) hugs.exe $(RM) runhugs.exe $(RM) *.lib $(RM) *.pdf $(RM) TAGS $(RM) *~ veryclean :: distclean TAGS :: etags *.[ych] ################################################################ # Dependencies ################################################################ .c.o : $(CC) -c $(CFLAGS) $(OPTFLAGS) $< # These are compiled with less optimisation to avoid optimisation bugs in # certain compilers. This may be overly conservative on some compilers. compiler.o : compiler.c $(CC) -c $(CFLAGS) compiler.c static.o : static.c $(CC) -c $(CFLAGS) static.c # parser.c : parser.y # -$(YACC) parser.y # mv y.tab.c parser.c # veryclean :: # $(RM) parser.c server.o : $(PRELUDE) storage.h connect.h errors.h \ command.h machdep.h timer.c server.c server.h hugs.o : $(PRELUDE) storage.h connect.h errors.h \ command.h machdep.h timer.c storage.o : $(PRELUDE) storage.h connect.h errors.h input.o : $(PRELUDE) storage.h connect.h errors.h \ parser.c command.h module.h subst.o : $(PRELUDE) storage.h connect.h errors.h subst.h static.o : $(PRELUDE) storage.h connect.h errors.h subst.h \ scc.c module.h type.o : $(PRELUDE) storage.h connect.h errors.h subst.h \ scc.c preds.c output.o : $(PRELUDE) storage.h connect.h errors.h compiler.o : $(PRELUDE) storage.h connect.h errors.h \ compiler.c machine.o : $(PRELUDE) storage.h connect.h errors.h plugin.o : $(PRELUDE) storage.h connect.h errors.h builtin.o : $(PRELUDE) storage.h connect.h errors.h \ bignums.c printer.c iomonad.c interns.c array.c ffi.o : $(PRELUDE) storage.h connect.h errors.h module.o : $(PRELUDE) storage.h connect.h errors.h module.h machdep.o : $(PRELUDE) storage.h connect.h errors.h machdep.h script.o : $(PRELUDE) storage.h HsFFI.h connect.h errors.h ################################################################ # Regression tests (none supplied) ################################################################ check : ################################################################ # End of Makefile ################################################################ hugs98-plus-Sep2006/src/djgpp2/config.bat0000644006511100651110000000062406727055602016710 0ustar rossross@echo off rem A simple configure script for people who don't have /bin/sh and related rem tools. echo Copying .\Makefile, .\options.h and .\config.h to .. copy .\Makefile .. copy .\options.h .. copy .\config.h .. echo You may need to edit ..\Makefile and ..\config.h to suit the echo peculiarities of your machine. echo You may also choose to edit ..\options.h to suit your personal preferences. hugs98-plus-Sep2006/src/djgpp2/config.h0000644006511100651110000002001510010230643016341 0ustar rossross/* src/djgpp2/config.h. * Generated manually from src/config.h.in for djgpp2 by ADR. */ /* Define if using alloca.c. */ #undef C_ALLOCA /* Define to empty if the keyword does not work. */ #undef const /* Define to one of _getb67, GETB67, getb67 for Cray-2 and Cray-YMP systems. This function is required for alloca.c support on those systems. */ #undef CRAY_STACKSEG_END /* Define if you have alloca, as a function or macro. */ #define HAVE_ALLOCA 1 /* Define if you have and it should be used (not on Ultrix). */ #undef HAVE_ALLOCA_H /* Define if you have that is POSIX.1 compatible. */ #define HAVE_SYS_WAIT_H 1 /* Define as the return type of signal handlers (int or void). */ #undef RETSIGTYPE /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ #define STACK_DIRECTION 0 /* Define if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define if you can safely include both and . */ #define TIME_WITH_SYS_TIME 1 /* Define if your declares struct tm. */ #undef TM_IN_SYS_TIME /* The following symbols are defined in options.h: * * BYTECODE_PRIMS * CHECK_TAGS * DEBUG_CODE * DEBUG_PRINTER * DONT_PANIC * GIMME_STACK_DUMPS * HUGSDIR * HUGSPATH * HUGSSUFFIXES * HUGS_FOR_WINDOWS * HUGS_VERSION * INTERNAL_PRIMS * LARGE_HUGS * PATH_CANONICALIZATION * PROFILING * REGULAR_HUGS * SMALL_BANNER * SMALL_HUGS * TREX * IPARAM * USE_PREPROCESSOR * USE_READLINE * WANT_TIMER */ /* Define if you have malloc.h and it defines _alloca - eg for Visual C++. */ #define HAVE__ALLOCA 0 /* Define if you have /bin/sh */ #define HAVE_BIN_SH 0 /* Define if you have the GetModuleFileName function. */ #define HAVE_GETMODULEFILENAME 0 /* Define if heap profiler can (and should) automatically invoke hp2ps * to convert heap profile (in "profile.hp") to postscript. */ #define HAVE_HP2PS 0 /* Define if compiler supports gcc's "labels as values" (aka computed goto) * feature (which is used to speed up instruction dispatch in the interpreter). * Here's what typical code looks like: * * void *label[] = { &&l1, &&l2 }; * ... * goto *label[i]; * l1: ... * l2: ... * ... */ #define HAVE_LABELS_AS_VALUES 1 /* Define if compiler supports prototypes. */ #define PROTOTYPES 1 /* Define if you have the WinExec function. */ #define HAVE_WINEXEC 0 /* Define if jmpbufs can be treated like arrays. * That is, if the following code compiles ok: * * #include * * int test1() { * jmp_buf jb[1]; * jmp_buf *jbp = jb; * return (setjmp(jb[0]) == 0); * } */ #define JMPBUF_ARRAY 1 /* Define if your C compiler inserts underscores before symbol names */ /* #undef LEADING_UNDERSCORE */ /* Define if signal handlers have type void (*)(int) * (Otherwise, they're assumed to have type int (*)(void).) */ #define VOID_INT_SIGNALS 1 /* The number of bytes in a double. */ #define SIZEOF_DOUBLE 8 /* The number of bytes in a float. */ #define SIZEOF_FLOAT 4 /* The number of bytes in a int. */ #define SIZEOF_INT 4 /* The number of bytes in a int*. */ #define SIZEOF_INTP 4 /* Define if you have the PBHSetVolSync function. */ #undef HAVE_PBHSETVOLSYNC /* Define if you have the _fullpath function. */ #undef HAVE__FULLPATH /* Define if you have the _pclose function. */ #undef HAVE__PCLOSE /* Define if you have the _popen function. */ #undef HAVE__POPEN /* Define if you have the _snprintf function. */ #undef HAVE__SNPRINTF /* Define if you have the _stricmp function. */ #undef HAVE__STRICMP /* Define if you have the _vsnprintf function. */ #undef HAVE__VSNPRINTF /* Define if you have the farcalloc function. */ #undef HAVE_FARCALLOC /* Define if you have the fgetpos function. */ #define HAVE_FGETPOS 1 /* Define if you have the fseek function. */ #define HAVE_FSEEK 1 /* Define if you have the fsetpos function. */ #define HAVE_FSETPOS 1 /* Define if you have the ftell function. */ #define HAVE_FTELL 1 /* Define if you have the macsystem function. */ #undef HAVE_MACSYSTEM /* Define if you have the pclose function. */ /* #undef HAVE_PCLOSE */ /* Define if you have the poly function. */ #undef HAVE_POLY /* Define if you have the popen function. */ /* #undef HAVE_POPEN */ /* Define if you have the realpath function. */ #undef HAVE_REALPATH /* Define if you have the snprintf function. */ #undef HAVE_SNPRINTF /* Define if you have the stime function. */ #undef HAVE_STIME /* Define if you have the strcasecmp function. */ #define HAVE_STRCASECMP 1 /* Define if you have the strcmp function. */ #define HAVE_STRCMP 1 /* Define if you have the strcmpi function. */ #define HAVE_STRCMPI 0 /* Define if you have the stricmp function. */ #define HAVE_STRICMP 0 /* Define if you have the valloc function. */ #undef HAVE_VALLOC /* Define if you have the vsnprintf function. */ #undef HAVE_VSNPRINTF /* Define if you have the header file. */ #undef HAVE_FILES_H /* Define if you have the header file. */ #define HAVE_ASSERT_H 1 /* Define if you have the header file. */ #define HAVE_CONIO_H 1 /* Define if you have the header file. */ #undef HAVE_CONSOLE_H /* Define if you have the header file. */ #define HAVE_CTYPE_H 1 /* Define if you have the header file. */ #undef HAVE_DL_H /* Define if you have the header file. */ #undef HAVE_DLFCN_H /* Define if you have the header file. */ #define HAVE_DOS_H 1 /* Define if you have the header file. */ #undef HAVE_ERRNO_H /* Define if you have the header file. */ #define HAVE_FCNTL_H 1 /* Define if you have the header file. */ #define HAVE_FLOAT_H 1 /* Define if you have the header file. */ #define HAVE_IO_H 1 /* Define if you have the header file. */ /* #undef HAVE_NLIST_H */ /* Define if you have the header file. */ #undef HAVE_PASCAL_H /* Define if you have the header file. */ #undef HAVE_SGTTY_H /* Define if you have the header file. */ #define HAVE_SIGNAL_H 1 /* Define if you have the header file. */ #undef HAVE_STAT_H /* Define if you have the header file. */ #define HAVE_STD_H 1 /* Define if you have the header file. */ #define HAVE_STDARG_H 1 /* Define if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define if you have the header file. */ #define HAVE_STRING_H 1 /* Define if you have the header file. */ #define HAVE_SYS_IOCTL_H 0 /* Define if you have the header file. */ #define HAVE_SYS_PARAM_H 1 /* Define if you have the header file. */ #define HAVE_SYS_RESOURCE_H 1 /* Define if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define if you have the header file. */ #define HAVE_SYS_TIME_H 1 /* Define if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define if you have the header file. */ #undef HAVE_TERMIO_H /* Define if you have the header file. */ #undef HAVE_TERMIOS_H /* Define if you have the header file. */ #undef HAVE_TIME_H /* Define if you have the header file. */ #define HAVE_UNISTD_H 1 /* Define if you have the header file. */ #define HAVE_VALUES_H 1 /* Define if you have the header file. */ #undef HAVE_WINDOWS_H /* Define if you have the editline library (-leditline). */ #undef HAVE_LIBEDITLINE /* Define if you have the dl library (-ldl). */ #undef HAVE_LIBDL /* Define if you have the dld library (-ldld). */ #undef HAVE_LIBDLD /* Define to 1 if floating point arithmetic is supported. */ #define FLOATS_SUPPORTED 1 /* Define if you have the editline library (-leditline). */ #undef HAVE_LIBREADLINE hugs98-plus-Sep2006/src/djgpp2/config.sh0000644006511100651110000000124106727055602016550 0ustar rossross#!/bin/sh echo "\ Unable to generate a working configure script for djgpp Running ./config.bat will copy hand-written versions of ./Makefile ./options.h ./config.h into .. " # Actually, we can run the configure script - but on my machine it # crashes while generating the output files. The answers printed # before it crashed were used to hand-generate the output files. # # sed ../unix/configure >./config.fix \ # -e "s#/dev/null#conf_devnull#" # # # Now we override the default values of some environment variables. # # set -a # All modified env vars are to be exported! # # CC=${CC="gcc"} # # # Run the script # # ./config.fix $* # End hugs98-plus-Sep2006/src/djgpp2/options.h0000644006511100651110000001770310426134734016620 0ustar rossross/* -------------------------------------------------------------------------- * Configuration options for DJGPP2 (based on src/options.h.in) * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: options.h,v $ * $Revision: 1.16 $ * $Date: 2006/05/03 14:10:36 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Hugs paths and directories * ------------------------------------------------------------------------*/ /* Define this as the default setting of HUGSPATH. * Value may contain string "{Hugs}" (for which we will substitute the * value of HUGSDIR) and should be either colon-separated (Unix) * or semicolon-separated (Macintosh, Windows, DOS). Escape * characters in the path string are interpreted according to normal * Haskell conventions. * * This value can be overridden from the command line by setting the * HUGSFLAGS environment variable or by storing an appropriate value * for HUGSFLAGS in the registry (Win32 only). In all cases, use a * string of the form -P"...". */ #define HUGSPATH ".;{Hugs}\\packages\\*" /* The list of suffixes used by Haskell source files, separated either * by colons (Unix) or semicolons (Macintosh, Windows, DOS). * * This value can be overridden using the -S flag. */ #define HUGSSUFFIXES ".hs;.lhs" /* The directory name which is substituted for the string "{Hugs}" * in a path variable. This normally points to where the Hugs libraries * are installed - ie so that the file HUGSDIR/lib/Prelude.hs exists * Typical values are: * "/usr/local/lib/hugs" * "/usr/homes/JFHaskell/hugs" * ".." * * This value is ignored on Windows and Macintosh versions since * it is assumed that the binary is installed in HUGSDIR. * * This value cannot be overridden from the command line or by using * environment variables. This isn't quite as limiting as you'd think * since you can always choose _not_ to use the {Hugs} variable - however, * it's obviously _nicer_ to have it set correctly. */ #ifndef HUGSDIR #define HUGSDIR "\\Hugs" #endif /* -------------------------------------------------------------------------- * User interface options * ------------------------------------------------------------------------*/ /* Define if you want to use the "Hugs for Windows" GUI. * (Windows 3.1 and compatibles only) */ #define HUGS_FOR_WINDOWS 0 /* Define if you want filenames to be converted to normal form by: * o replacing relative pathnames with absolute pathnames and * eliminating .. and . where possible. * o converting to lower case (only in case-insensitive filesystems) */ #define PATH_CANONICALIZATION 1 /* Define if a command line editor is available and should be used. * There are two choices of command line editor that can be used with Hugs: * GNU readline and editline (from comp.sources.misc, vol 31, issue 71) */ #define USE_READLINE 0 /* Define if you want the small startup banner. */ #define SMALL_BANNER 0 /* -------------------------------------------------------------------------- * Making Hugs smaller * ------------------------------------------------------------------------*/ /* Define one of these to select overall size of Hugs * SMALL_HUGS for 16 bit operation on a limited memory PC. * REGULAR_HUGS for 32 bit operation using largish default table sizes. * LARGE_HUGS for 32 bit operation using larger default table sizes. */ #define SMALL_HUGS 0 #define REGULAR_HUGS 0 #define LARGE_HUGS 1 /* -------------------------------------------------------------------------- * Fancy features * ------------------------------------------------------------------------*/ /* Define if heap profiling should be used */ #define PROFILING 0 /* Define if you want to run Haskell code through a preprocessor * * Note that there's the import chasing mechanism will not spot any * #includes so you must :load (not :reload) if you change any * (non-Haskell) configurations files. */ #define USE_PREPROCESSOR 1 /* Define if you want to time every evaluation. * * Timing is included in the Hugs distribution for the purpose of benchmarking * the Hugs interpreter, comparing its performance across a variety of * different machines, and with other systems for similar languages. * * It would be somewhat foolish to try to use the timings produced in this * way for any other purpose. In particular, using timings to compare the * performance of different versions of an algorithm is likely to give very * misleading results. The current implementation of Hugs as an interpreter, * without any significant optimizations, means that there are much more * significant overheads than can be accounted for by small variations in * Hugs code. */ #undef WANT_TIMER /* * By default, the Hugs Server API wraps up each value pushed on the stack * as a Dynamic, achieving some run-time type safety when applying these * arguments to a function. This Dynamic layer sometimes gets in the way * for low-level consumers of the Server API (e.g, HaskellScript, Lambada, * mod_haskell), so by setting NO_DYNAMIC_TYPES to 1 you turn off the * use of Dynamics (and assume all the responsibility of debugging any * bad crashes you might see as a result!) */ /* #undef NO_DYNAMIC_TYPES */ /* -------------------------------------------------------------------------- * Debugging options (intended for use by maintainers) * ------------------------------------------------------------------------*/ /* Define if debugging generated bytecodes or the bytecode interpreter */ #define DEBUG_CODE 0 /* Define if debugging generated supercombinator definitions or compiler */ #define DEBUG_SHOWSC 0 /* Define if you want to use a low-level printer from within a debugger */ #define DEBUG_PRINTER 0 /* Define if you want to perform runtime tag-checks as an internal * consistency check. This makes Hugs run very slowly - but is very * effective at detecting and locating subtle bugs. */ #define CHECK_TAGS 0 /* -------------------------------------------------------------------------- * Experimental features * These are likely to disappear/change in future versions and should not * be used by most people.. * ------------------------------------------------------------------------*/ /* Define if you want to use the primitives which let you examine Hugs * internals. */ #define INTERNAL_PRIMS 0 /* Define if you want to use the primitives which let you examine Hugs * bytecodes (requires INTERNAL_PRIMS). */ #define BYTECODE_PRIMS 0 /* In a plain Hugs system, most signals (SIGBUS, SIGTERM, etc) indicate * some kind of error in Hugs - or maybe a stack overflow. Rather than * just crash, Hugs catches these errors and returns to the main loop. * It does this by calling a function "panic" which longjmp's back to the * main loop. * If you're developing a GreenCard library, this may not be the right * behaviour - it's better if Hugs leaves them for your debugger to * catch rather than trapping them and "panicing". */ #define DONT_PANIC 0 /* If you get really desperate to understand why your Hugs programs keep * crashing or running out of stack, you might like to set this flag and * recompile Hugs. When you hit a stack error, it will print out a list * of all the objects currently under evaluation. The information isn't * perfect and can be pretty hard to understand but it's better than a * poke in the eye with a blunt stick. * * This is a very experimental feature! */ #define GIMME_STACK_DUMPS 0 /* ----------------------------------------------------------------------- */ hugs98-plus-Sep2006/src/dotnet/0000755006511100651110000000000010504340135015042 5ustar rossrosshugs98-plus-Sep2006/src/dotnet/.cvsignore0000644006511100651110000000002107632753434017055 0ustar rossrossHugsWrapper.dll hugs98-plus-Sep2006/src/dotnet/HugsServ.cpp0000644006511100651110000001561607633135203017334 0ustar rossross// // Managed C++ wrapper class around the Hugs server API. // #using extern "C" { #include "prelude.h" #include "storage.h" #include "machdep.h" #include "connect.h" }; #include "prim.h" #include "HugsServ.h" #define ToCharString(str) \ static_cast(System::Runtime::InteropServices::Marshal::StringToHGlobalAnsi(str).ToPointer()) #define FreeCharString(pstr) System::Runtime::InteropServices::Marshal::FreeHGlobal(pstr) extern "C" { extern char* lastError; extern char* ClearError(); extern Void setError (char*); extern Bool safeEval (Cell c); extern Void startEval (Void); }; /* All server entry points set CStackBase for the benefit of the (conservative) * GC and do error catching. Any calls to Hugs functions should be "protected" * by being placed inside this macro. * * void entryPoint(arg1, arg2, result) * T1 arg1; * T2 arg2; * T3 *result; * { * protect(doNothing(), * ... * ); * } * * Macro decomposed into BEGIN_PROTECT and END_PROTECT pieces so that i * can be used on some compilers (Mac?) that have limits on the size of * macro arguments. */ #define BEGIN_PROTECT \ if (NULL == lastError) { \ Cell dummy; \ CStackBase = &dummy; /* Save stack base for use in gc */ \ consGC = TRUE; /* conservative GC is the default */ \ if (1) { #define END_PROTECT \ } else { \ setError("Error occurred"); \ normalTerminal(); \ } \ } #define protect(s) BEGIN_PROTECT s; END_PROTECT static Void MkObject Args((System::Object*)); static Object* EvalObject Args((Void)); static Int DoIO_Object Args((Object* __gc&)); /* Push an Object/DotNetPtr onto the stack */ static Void MkObject(Object* a) { #ifndef NO_DYNAMIC_TYPES Cell d = getTypeableDict(type); if (isNull(d)) { setError("MkObject: can't create Typeable instance"); return 0; } protect(push(ap(ap(nameToDynamic,d),mkDotNetPtr(a,freeNetPtr)))); #else protect(push(mkDotNetPtr(a,freeNetPtr))); #endif } static Object* EvalObject() /* Evaluate a cell (:: Object) */ { Cell d; BEGIN_PROTECT startEval(); #ifndef NO_DYNAMIC_TYPES d = getTypeableDict(type); if (isNull(d)) { setError("EvalObject: can't create Typeable instance"); return 0; } safeEval(ap(ap(nameToDynamic,d),pop())); #else safeEval(pop()); #endif normalTerminal(); return getNP(whnfHead); END_PROTECT return 0; } /* * Evaluate a cell (:: IO DotNetPtr) return exit status */ static Int DoIO_Object(Object* __gc& phval) { BEGIN_PROTECT Int exitCode = 0; Bool ok; StackPtr oldsp = sp; startEval(); #ifndef NO_DYNAMIC_TYPES ok = safeEval(ap(nameIORun,ap(nameRunDyn,pop()))); #else ok = safeEval(ap(nameIORun,pop())); #endif if (!ok) { sp = oldsp-1; exitCode = 1; } else if (whnfHead == nameLeft) { safeEval(pop()); exitCode = whnfInt; } else { if (phval) { safeEval(pop()); phval = getNP(whnfHead); } else { drop(); } exitCode = 0; } normalTerminal(); if (sp != oldsp-1) { setError("doIO: unbalanced stack"); return 1; } return exitCode; END_PROTECT; return -1; /* error code */ } namespace Hugs { System::String* Server::ClearError() { char* s = m_server->clearError(); return new System::String(s); } // // Method: SetHugsArgs(String* argv[]) // // Purpose: Configure the argument vector which // H98's System.getArgs returns. // void Server::SetHugsArgs(System::String* argv[]) { char __nogc* __nogc* args = new char*[argv.Length]; int len = argv.Length; for (int i=0; i < len; i++) { args[i] = new char[argv[i]->Length + 1]; args[i] = ToCharString(argv[i]); } m_server->setHugsArgs(len,args); /* Looks kind of silly; a better way? */ for (int i=0; i < len; i++) { delete args[i]; } delete args; return; } int Server::GetNumScripts() { return m_server->getNumScripts(); } void Server::Reset(int i) { m_server->reset(i); return; } void Server::SetOutputEnable (int i) { m_server->setOutputEnable(i); return; } void Server::ChangeDir(System::String* dir) { char __nogc* dirStr = ToCharString(dir); m_server->changeDir(dirStr); FreeCharString(dirStr); return; } void Server::LoadProject(System::String* proj) { char __nogc* projStr = ToCharString(proj); m_server->loadProject(projStr); FreeCharString(projStr); return; } void Server::LoadFile(System::String* fname) { char __nogc* fnameStr = ToCharString(fname); m_server->loadProject(fnameStr); FreeCharString(fnameStr); return; } void Server::LoadFromBuffer(System::String* haskMod) { char __nogc* hStr = ToCharString(haskMod); m_server->loadFromBuffer(hStr); FreeCharString(hStr); return; } void Server::SetOptions(System::String* opts) { char __nogc* hStr = ToCharString(opts); m_server->setOptions(hStr); FreeCharString(hStr); return; } System::String* Server::GetOptions() { char* r = m_server->getOptions(); return System::Runtime::InteropServices::Marshal::PtrToStringAnsi(r); } HVal Server::CompileExpr(System::String* mo,System::String* v) { char __nogc* moStr = ToCharString(mo); char __nogc* vStr = ToCharString(v); HVal res = m_server->compileExpr(moStr,vStr); FreeCharString(moStr); FreeCharString(vStr); return res; } void Server::GarbageCollect() { m_server->garbageCollect(); return; } void Server::LookupName(System::String* mo,System::String* v) { char __nogc* moStr = ToCharString(mo); char __nogc* vStr = ToCharString(v); m_server->lookupName(moStr,vStr); FreeCharString(moStr); FreeCharString(vStr); return; } void Server::mkInt(int i) { m_server->mkInt(i); return; } void Server::mkAddr(void* ptr) { m_server->mkAddr(ptr); return; } void Server::mkObject(Object* obj) { MkObject(obj); return; } void Server::mkString(System::String* s) { char* str = ToCharString(s); m_server->mkString(str); FreeCharString(str); return; } void Server::apply() { m_server->apply(); return; } int Server::evalInt() { return m_server->evalInt(); } void* Server::evalAddr() { return m_server->evalAddr(); } Object* Server::evalObject() { return EvalObject(); } System::String* Server::evalString() { char* str = m_server->evalString(); return System::Runtime::InteropServices::Marshal::PtrToStringAnsi(str); } int Server::doIO() { return m_server->doIO(); } int Server::doIO_Int(int* pRes) { return 0; } int Server::doIO_Addr(void** pRes) { return 0; } int Server::doIO_Object(Object* __gc& pRes) { return DoIO_Object(pRes); } HVal Server::popHVal() { HVal h = m_server->popHVal(); return h; } void Server::pushHVal(HVal arg) { m_server->pushHVal(arg); return; } void Server::freeHVal(HVal arg) { m_server->freeHVal(arg); return; } }; hugs98-plus-Sep2006/src/dotnet/HugsServ.h0000644006511100651110000000321207632753060016774 0ustar rossross// // (c) 2002-2003, sof. // // Hugs Server API exposed as a .NET type (via Managed C++). // #pragma once #using extern "C" { #include "prelude.h" #include "server.h" extern struct _HugsServerAPI* getHugsAPI(); }; using namespace System; namespace Hugs { typedef int HVal; public __gc class Server { private: static struct _HugsServerAPI* m_server; public: static Server() { m_server = getHugsAPI(); } static System::String* ClearError(); static void SetHugsArgs (System::String* args[]); static int GetNumScripts(); static void Reset(int i); static void SetOutputEnable (int i); static void ChangeDir(System::String* dir); static void LoadProject(System::String* proj); static void LoadFile(System::String* fname); static void LoadFromBuffer(System::String* haskMod); static void SetOptions(System::String* opts); static System::String* GetOptions(); static HVal CompileExpr(System::String* a1, System::String* a2); static void GarbageCollect(); static void LookupName(System::String* mod,System::String* nm); static void mkInt(int i); static void mkAddr(void* ptr); static void mkObject(Object* obj); static void mkString(System::String* s); static void apply(); static int evalInt(); static void* evalAddr(); static Object* evalObject(); static System::String* evalString(); static int doIO(); static int doIO_Int(int* pRes); static int doIO_Addr(void** pRes); static int doIO_Object(Object* __gc& pRes); static HVal popHVal(); static void pushHVal(HVal arg); static void freeHVal(HVal arg); }; }; hugs98-plus-Sep2006/src/dotnet/HugsWrapper.cpp0000644006511100651110000000003107633135473020027 0ustar rossross#include "HugsWrapper.h" hugs98-plus-Sep2006/src/dotnet/HugsWrapper.cs0000644006511100651110000003620107632752743017666 0ustar rossross// // Helper class for dynamically creating types/classes // wrapping up Hugs functions/actions. // // (c) 2002, sof. // using System; using System.Reflection; using System.Reflection.Emit; using Hugs; // // Class: HugsWrapper // public class HugsWrapper { // Class: FunctionInfo // // Packages up the information in a 'method string' that's // passed from Haskell. // private class FunctionInfo { public String methodName; public String moduleName; public String functionName; public String argTys; public String resTy; internal FunctionInfo(String str) { // The format of the string is as follows: // // MethodName#[Module.]function|+| // // where is a type tag: // I - int // S - string // O - object pointer. // int idx; idx = str.IndexOf('#'); methodName = str.Substring(0,Math.Max(0,idx)); str = str.Substring(idx+1); idx = str.IndexOf('.'); moduleName = str.Substring(0,Math.Max(0,idx)); str = str.Substring(idx+1); idx = str.IndexOf('|'); functionName = str.Substring(0,Math.Max(0,idx)); str = str.Substring(idx+1); idx = str.IndexOf('|'); argTys = str.Substring(0,Math.Max(0,idx)); resTy = str.Substring(idx+1); } public static Type tagToType(char ch) { switch (ch) { case 'I': return Type.GetType("System.Int32"); case 'S': return Type.GetType("System.String"); case 'O': return Type.GetType("System.Object"); default: return Type.GetType("System.Void"); } } public static Type[] tagsToType(String s) { Type[] tyVec = new Type[s.Length]; for ( int i=0; i 0 && i%2 == 0) { // make sure the last argument is hooked up to an @ node too. Server.apply(); Console.WriteLine("apply"); } if (fi.resTy.Length > 0) { switch (fi.resTy[0]) { case 'I': unsafe { int res; Server.doIO_Int(&res); return (Object)res; } case 'S': unsafe { Object res = new Object(); Server.doIO_Object(ref res); return (String)res; } case 'O': unsafe { Object res = new Object(); Server.doIO_Object(ref res); return res; } default: Server.doIO(); return null; } } return null; } // // Method: InvokeStablePtr() // // Like InvokeFunction, but instead of via a 'method string', the Haskell // function value to call is given as a stable ptr. // public static Object InvokeStablePtr(Int32 stablePtr, String argTys, String resTy, Object[] args) { Int32 i = 0; Server.pushHVal(stablePtr); while (i < argTys.Length) { switch (argTys[i]) { case 'I': Server.mkInt((int)args[i]); break; case 'H': Server.pushHVal((int)args[i]); break; case 'S': Server.mkString((String)args[i]); break; case 'O': Server.mkObject(args[i]); break; default: Console.WriteLine("bogus type tag {0};ignoring.", argTys[i]); break; } i++; if (i % 2 == 1) { Server.apply(); } } if (i > 0) { // make sure the last argument is hooked up to an @ node too. Server.apply(); } if (resTy.Length > 0) { switch (resTy[0]) { case 'I': unsafe { int res; Server.doIO_Int(&res); return (Object)res; } case 'S': unsafe { Object res = new Object(); Server.doIO_Object(ref res); return (String)res; } case 'O': unsafe { Object res = new Object(); Server.doIO_Object(ref res); return res; } default: Server.doIO(); return null; } } return null; } static Assembly Resolver(Object sender, ResolveEventArgs args) { return assemblyBuilder; } // // Method: DefineType // // Given a type name and a 'method string', construct a new // type in a dynamic module in a dynamic assembly. The new type's // function in life is to wrap up Hugs functions, so that when // its methods are invoked, they will delegate the call to their // corresponding Hugs function. // static public String DefineType(String typeName, String super, String methodSpecs) { Int32 count = 0; Int32 idx = 0; Int32 i = 0; Int32 len = methodSpecs.Length; MethodBuilder methodBuilder; // Ideally, we want to pass the method strings in an array, but // I'm running into issues passing arrays via the Hugs .NET primops // (specifically, how to make Convert.ChangeType() deal with the // arrays.) // // So, temporarily, we separate the method strings by '/'. // while (idx >= 0 ) { idx = methodSpecs.IndexOf('/'); count++; methodSpecs = methodSpecs.Substring(idx+1); } String[] methods = new String[count]; idx = 0; count = 0; while (idx >= 0 ) { idx = methodSpecs.IndexOf('/'); if (idx == (-1)) { methods[count] = methodSpecs.Substring(0); } else { methods[count] = methodSpecs.Substring(0,Math.Max(0,idx)); } count++; } Int32 no = methods.Length; String theTypeName; TypeBuilder typeBuilder = null; theTypeName = typeName; while (true) { try { if (super != null && super.Length > 0) { Type supTy = DynInvoke.InvokeBridge.GetType(super); typeBuilder = moduleBuilder.DefineType(theTypeName, TypeAttributes.Public, supTy); Console.WriteLine("Succeeded creating {0} type", supTy); } else { typeBuilder = moduleBuilder.DefineType(theTypeName, TypeAttributes.Public); } break; } catch (ArgumentException) { uniq++; theTypeName = typeName + uniq; } } Console.WriteLine("Succeeded creating {0} type", theTypeName); ConstructorBuilder constructorBuilder = typeBuilder.DefineConstructor(MethodAttributes.Public, CallingConventions.Standard, null); ILGenerator ilGenerator = constructorBuilder.GetILGenerator(); FieldBuilder fieldBuilder; // Call the base constructor -- required? ilGenerator.Emit(OpCodes.Ldarg_0); Type[] ctor_args = new Type[0]; ilGenerator.Emit(OpCodes.Call,Type.GetType("System.Object").GetConstructor(ctor_args)); for (i=0;i < no; i++) { fieldBuilder = typeBuilder.DefineField("spec_" + i, typeof(String), FieldAttributes.Private); // assign the field. ilGenerator.Emit(OpCodes.Ldarg_0); ilGenerator.Emit(OpCodes.Ldstr,methods[i]); ilGenerator.Emit(OpCodes.Stfld, fieldBuilder); FunctionInfo fi = new FunctionInfo(methods[i]); methodBuilder = typeBuilder.DefineMethod(fi.methodName, MethodAttributes.Public | MethodAttributes.Virtual, CallingConventions.Standard, (fi.resTy.Length == 0 ? Type.GetType("System.Void") : FunctionInfo.tagToType(fi.resTy[0])), FunctionInfo.tagsToType(fi.argTys)); ILGenerator ilGen = methodBuilder.GetILGenerator(); ilGen.DeclareLocal(typeof(Object[])); ilGen.Emit(OpCodes.Ldc_I4,fi.argTys.Length); ilGen.Emit(OpCodes.Newarr,typeof(Object)); ilGen.Emit(OpCodes.Stloc_0); for (Int32 j=0; j < fi.argTys.Length; j++) { ilGen.Emit(OpCodes.Ldloc_0); ilGen.Emit(OpCodes.Ldc_I4,j); switch (j+1) { case 1 : ilGen.Emit(OpCodes.Ldarg_1); break; case 2 : ilGen.Emit(OpCodes.Ldarg_2); break; case 3 : ilGen.Emit(OpCodes.Ldarg_3); break; default: ilGen.Emit(OpCodes.Ldarg,j+1); break; } if (fi.argTys[j] == 'I') { ilGen.Emit(OpCodes.Box,Type.GetType("System.Int32")); } ilGen.Emit(OpCodes.Stelem_Ref); } ilGen.Emit(OpCodes.Ldarg_0); ilGen.Emit(OpCodes.Ldfld,fieldBuilder); ilGen.Emit(OpCodes.Ldloc_0); ilGen.Emit(OpCodes.Call, Type.GetType("HugsWrapper").GetMethod("InvokeFunction")); // pop the result off of the stack when returning void. if (fi.resTy.Length > 0 && fi.resTy[0] == 'V') { ilGen.Emit(OpCodes.Pop); } ilGen.Emit(OpCodes.Ret); // of 'delegator' shape? if ((fi.resTy.Length == 1 && fi.resTy[0] == 'V') && (fi.argTys.Length == 2 && fi.argTys[1] == 'O' && fi.argTys[1] == 'O')) { Type[] del_args = new Type[2]; del_args[0] = typeof(Object); del_args[1] = Type.GetType("System.EventArgs"); MethodBuilder delegator = typeBuilder.DefineMethod(fi.methodName + "_delegator", MethodAttributes.Public, CallingConventions.Standard, typeof(void), del_args); // Simple stuff - just delegate the call (do we really need this meth?) ILGenerator delIl = delegator.GetILGenerator(); delIl.Emit(OpCodes.Ldarg_0); delIl.Emit(OpCodes.Ldarg_1); delIl.Emit(OpCodes.Ldarg_2); delIl.Emit(OpCodes.Call,methodBuilder); delIl.Emit(OpCodes.Ret); // Type compatible with a delegator, create impedance matchers for free. fieldBuilder = typeBuilder.DefineField(fi.methodName + "_handler", Type.GetType("System.EventHandler"), FieldAttributes.Public); ilGenerator.Emit(OpCodes.Ldarg_0); ilGenerator.Emit(OpCodes.Ldarg_0); ilGenerator.Emit(OpCodes.Ldftn,delegator); Type[] eh_args = new Type[2]; eh_args[0] = typeof(Object); eh_args[1] = Type.GetType("System.IntPtr"); ConstructorInfo ci = Type.GetType("System.EventHandler").GetConstructor(eh_args); ilGenerator.Emit(OpCodes.Newobj,ci); ilGenerator.Emit(OpCodes.Stfld,fieldBuilder); } } ilGenerator.Emit(OpCodes.Ret); Type res = typeBuilder.CreateType(); Console.WriteLine("Succeeded creating {0} type..", res); // For debugging purposes, persist the generated assembly. // (this goes hand-in-hand with the dynamic, persistable module // we created above). // assemblyBuilder.Save("foo.dll"); return theTypeName; } static public String DefineDelegator(String methodName, Int32 stablePtr) { String theTypeName; TypeBuilder typeBuilder = null; theTypeName = "DynDelegator"; while (true) { try { Console.WriteLine("Attempting to create type {0}..",theTypeName); typeBuilder = moduleBuilder.DefineType(theTypeName, TypeAttributes.Public); break; } catch (ArgumentException) { uniq++; theTypeName = "DynDelegator" + uniq; } } Console.WriteLine("Succeeded creating {0} type", theTypeName); ConstructorBuilder constructorBuilder = typeBuilder.DefineConstructor(MethodAttributes.Public, CallingConventions.Standard, null); ILGenerator ilGenerator = constructorBuilder.GetILGenerator(); // Call the base constructor -- required? ilGenerator.Emit(OpCodes.Ldarg_0); Type[] ctor_args = new Type[0]; ilGenerator.Emit(OpCodes.Call,Type.GetType("System.Object").GetConstructor(ctor_args)); // Build the delegator method which calls back into Haskell. Type[] del_args = new Type[2]; del_args[0] = typeof(Object); del_args[1] = Type.GetType("System.EventArgs"); MethodBuilder delegator = typeBuilder.DefineMethod(methodName, MethodAttributes.Public, CallingConventions.Standard, Type.GetType("System.Void"), del_args); ILGenerator delIl = delegator.GetILGenerator(); // construct the object array expected by InvokeFunction(). delIl.DeclareLocal(typeof(Object[])); delIl.Emit(OpCodes.Ldc_I4,2); delIl.Emit(OpCodes.Newarr,typeof(Object)); delIl.Emit(OpCodes.Stloc_0); // args[0] = arg1; delIl.Emit(OpCodes.Ldloc_0); delIl.Emit(OpCodes.Ldc_I4,0); delIl.Emit(OpCodes.Ldarg_1); delIl.Emit(OpCodes.Stelem_Ref); // args[0] = arg2; delIl.Emit(OpCodes.Ldloc_0); delIl.Emit(OpCodes.Ldc_I4,1); delIl.Emit(OpCodes.Ldarg_2); delIl.Emit(OpCodes.Stelem_Ref); // call InvokeFunction, passing it the method name // delIl.Emit(OpCodes.Ldarg_0); delIl.Emit(OpCodes.Ldc_I4,stablePtr); delIl.Emit(OpCodes.Ldstr,"OO"); delIl.Emit(OpCodes.Ldstr,"V"); delIl.Emit(OpCodes.Ldloc_0); delIl.Emit(OpCodes.Call, Type.GetType("HugsWrapper").GetMethod("InvokeStablePtr")); delIl.Emit(OpCodes.Pop); delIl.Emit(OpCodes.Ret); // Type compatible with a delegator, create impedance matchers for free. FieldBuilder fieldBuilder = typeBuilder.DefineField(methodName + "_handler", Type.GetType("System.EventHandler"), FieldAttributes.Public); ilGenerator.Emit(OpCodes.Ldarg_0); ilGenerator.Emit(OpCodes.Ldarg_0); ilGenerator.Emit(OpCodes.Ldftn,delegator); Type[] eh_args = new Type[2]; eh_args[0] = typeof(Object); eh_args[1] = Type.GetType("System.IntPtr"); ConstructorInfo ci = Type.GetType("System.EventHandler").GetConstructor(eh_args); ilGenerator.Emit(OpCodes.Newobj,ci); ilGenerator.Emit(OpCodes.Stfld,fieldBuilder); ilGenerator.Emit(OpCodes.Ret); Type res = typeBuilder.CreateType(); // assemblyBuilder.Save("foo.dll"); return theTypeName; } #if WANT_MAIN public static void Main() { AppDomain currentDomain = AppDomain.CurrentDomain; currentDomain.AssemblyResolve += new ResolveEventHandler(Resolver); try { DefineType("HugsTest", "Clicked#DotNet.hello|OO|O"); currentDomain.CreateInstance("HugsAssembly", "HugsTest"); } catch (Exception e) { Console.WriteLine(e.Message); } InvokeFunction("Clicked#DotNet.hello|OO|O",null); // assemblyBuilder.Save("foo.dll"); } #endif } /* class HugsWrapper */ hugs98-plus-Sep2006/src/dotnet/HugsWrapper.h0000644006511100651110000004023207633774533017511 0ustar rossross// // Helper class for dynamically creating types/classes // wrapping up Hugs functions/actions. // // (c) 2002-2003, sof. // #pragma once #using extern "C" { #include "prelude.h" #include "storage.h" #include "machdep.h" #include "connect.h" }; #include "dotnet/HugsServ.h" #include "dotnet/Invoker.h" using namespace System; using namespace System::Reflection; using namespace System::Reflection::Emit; using namespace Hugs; namespace Hugs { public __gc class Wrapper { private: // Class: FunctionInfo // // Packages up the information in a 'method string' that's // passed from Haskell. // __gc class FunctionInfo { public: System::String* methodName; System::String* moduleName; System::String* functionName; System::String* argTys; System::String* resTy; FunctionInfo(System::String* str) { // The format of the string is as follows: // // MethodName#[Module.]function|+| // // where is a type tag: // I - int // S - string // O - object pointer. // int idx; idx = str->IndexOf('#'); methodName = str->Substring(0,Math::Max(0,idx)); str = str->Substring(idx+1); idx = str->IndexOf('.'); moduleName = str->Substring(0,Math::Max(0,idx)); str = str->Substring(idx+1); idx = str->IndexOf('|'); functionName = str->Substring(0,Math::Max(0,idx)); str = str->Substring(idx+1); idx = str->IndexOf('|'); argTys = str->Substring(0,Math::Max(0,idx)); resTy = str->Substring(idx+1); } static System::Type* tagToType(char ch) { switch (ch) { case 'I': return System::Type::GetType("System.Int32"); case 'S': return System::Type::GetType("System.System::String"); case 'O': return System::Type::GetType("System.Object"); default: return System::Type::GetType("System.Void"); } } static System::Type* tagsToType(System::String* s) [] { System::Type* tyVec[] = new System::Type*[s->Length]; for ( int i=0; iLength; i++ ) { tyVec[i] = tagToType(s->get_Chars(i)); } return tyVec; } }; /* class FunctionInfo */ public: static Wrapper() { AssemblyName* assemblyName = new AssemblyName(); assemblyName->Name = "HugsAssembly"; AppDomain* currentDomain = AppDomain::CurrentDomain; currentDomain->AssemblyResolve += new ResolveEventHandler(0, Resolver); assemblyBuilder = currentDomain->DefineDynamicAssembly(assemblyName, AssemblyBuilderAccess::Run, //AssemblyBuilderAccess::RunAndSave, (System::String*)0); moduleBuilder = assemblyBuilder->DefineDynamicModule("HugsModule"); // assemblyBuilder->DefineDynamicModule("HugsModule", "test.dll"); hugs = new Server(); uniq = 0; } private: static Hugs::Server* hugs; static AssemblyBuilder* assemblyBuilder; static ModuleBuilder* moduleBuilder; static int uniq; public: // // Method: InvokeFunction() // // Given a 'method string' and an object array holding the arguments, // construct a (Hugs) function application and then perform it. // static Object* InvokeFunction (System::String* str, Object* args[]) { int i = 0; FunctionInfo* fi = new FunctionInfo(str); Server::LookupName(fi->moduleName,fi->functionName); while (i < fi->argTys->Length) { switch (fi->argTys->get_Chars(i)) { case 'I': Server::mkInt(Convert::ToInt32(args[i])); break; case 'H': Server::pushHVal(Convert::ToInt32(args[i])); break; case 'S': Server::mkString(__try_cast(args[i])); break; case 'O': Server::mkObject(args[i]); break; default: Console::WriteLine("bogus type tag {0};ignoring.", __box(fi->argTys->get_Chars(i))); break; } i++; if (i % 2 == 1) { Server::apply(); } } if (i > 0 && i%2 == 0) { // make sure the last argument is hooked up to an @ node too. Server::apply(); } if (fi->resTy->Length > 0) { switch (fi->resTy->get_Chars(0)) { case 'I': { int res; Server::doIO_Int(&res); return __box(res); } case 'S': { Object* res = new Object(); try { Server::doIO_Object(res); } catch (Exception* e) { Console::WriteLine("{0} {1}", e, e->InnerException); throw(e); } return __try_cast(res); } case 'O': { Object* res = new Object(); Server::doIO_Object(res); return res; } default: Server::doIO(); return 0; } } return 0; } // // Method: InvokeStablePtr() // // Like InvokeFunction, but instead of via a 'method string', the Haskell // function value to call is given as a stable ptr. // static Object __gc* InvokeStablePtr(int stablePtr, System::String* argTys, System::String* resTy, Object __gc* args[]) { int i = 0; Server::pushHVal(stablePtr); while (i < argTys->Length) { switch (argTys->get_Chars(i)) { case 'I': Server::mkInt(Convert::ToInt32(args[i])); break; case 'H': Server::pushHVal(Convert::ToInt32(args[i])); break; case 'S': Server::mkString(__try_cast(args[i])); break; case 'O': Server::mkObject(args[i]); break; default: Console::WriteLine("bogus type tag {0};ignoring.", argTys); break; } i++; if (i % 2 == 1) { Server::apply(); } } if (i > 0) { // make sure the last argument is hooked up to an @ node too. Server::apply(); } if (resTy->Length > 0) { switch (resTy->get_Chars(0)) { case 'I': { int res; Server::doIO_Int(&res); return __box(res); } case 'S': { Object* res = new Object(); Server::doIO_Object(res); return __try_cast(res); } case 'O': { Object* res = new Object(); Server::doIO_Object(res); return res; } default: Server::doIO(); return 0; } } return 0; } static Assembly* Resolver(Object* sender, ResolveEventArgs* args) { return assemblyBuilder; } // // Method: DefineType // // Given a type name and a 'method string', construct a new // type in a dynamic module in a dynamic assembly. The new type's // function in life is to wrap up Hugs functions, so that when // its methods are invoked, they will delegate the call to their // corresponding Hugs function. // static System::String* DefineType(System::String* typeName, System::String* super, System::String* methodSpecs) { int count = 0; int idx = 0; int i = 0; int len = methodSpecs->Length; MethodBuilder* methodBuilder; // Ideally, we want to pass the method strings in an array, but // I'm running into issues passing arrays via the Hugs .NET primops // (specifically, how to make Convert.ChangeType() deal with the // arrays.) // // So, temporarily, we separate the method strings by '/'. // while (idx >= 0 ) { idx = methodSpecs->IndexOf('/'); count++; methodSpecs = methodSpecs->Substring(idx+1); } System::String* methods[] = new System::String*[count]; idx = 0; count = 0; while (idx >= 0 ) { idx = methodSpecs->IndexOf('/'); if (idx == (-1)) { methods[count] = methodSpecs->Substring(0); } else { methods[count] = methodSpecs->Substring(0,Math::Max(0,idx)); } count++; } int no = methods->Length; System::String* theTypeName; TypeBuilder* typeBuilder; theTypeName = typeName; while (true) { try { if (super != 0 && super->Length > 0) { System::Type* supTy = DynInvoke::InvokeBridge::GetType(super); typeBuilder = moduleBuilder->DefineType(theTypeName, TypeAttributes::Public, supTy); #if 0 Console::WriteLine("Succeeded creating {0} type", supTy); #endif } else { typeBuilder = moduleBuilder->DefineType(theTypeName, TypeAttributes::Public); } break; } catch (ArgumentException*) { uniq++; theTypeName = String::Format("{0}{1}",typeName, __box(uniq)); } } #if 0 Console::WriteLine("Succeeded creating {0} type", theTypeName); #endif ConstructorBuilder* constructorBuilder = typeBuilder->DefineConstructor(MethodAttributes::Public, CallingConventions::Standard, 0); ILGenerator* ilGenerator = constructorBuilder->GetILGenerator(); FieldBuilder* fieldBuilder; // Call the base constructor -- required? ilGenerator->Emit(OpCodes::Ldarg_0); System::Type* ctor_args[] = new System::Type*[0]; ilGenerator->Emit(OpCodes::Call, System::Type::GetType("System.Object")->GetConstructor(ctor_args)); for (i=0;i < no; i++) { fieldBuilder = typeBuilder->DefineField("spec_" + i, __typeof(System::String), FieldAttributes::Private); // assign the field. ilGenerator->Emit(OpCodes::Ldarg_0); ilGenerator->Emit(OpCodes::Ldstr,methods[i]); ilGenerator->Emit(OpCodes::Stfld, fieldBuilder); FunctionInfo* fi = new FunctionInfo(methods[i]); methodBuilder = typeBuilder->DefineMethod(fi->methodName, (MethodAttributes)( MethodAttributes::Public | MethodAttributes::Virtual), CallingConventions::Standard, (fi->resTy->Length == 0 ? System::Type::GetType("System.Void") : FunctionInfo::tagToType(fi->resTy->get_Chars(0))), FunctionInfo::tagsToType(fi->argTys)); ILGenerator* ilGen = methodBuilder->GetILGenerator(); ilGen->DeclareLocal(__typeof(Object*[])); ilGen->Emit(OpCodes::Ldc_I4,fi->argTys->Length); ilGen->Emit(OpCodes::Newarr,__typeof(Object)); ilGen->Emit(OpCodes::Stloc_0); for (int j=0; j < fi->argTys->Length; j++) { ilGen->Emit(OpCodes::Ldloc_0); ilGen->Emit(OpCodes::Ldc_I4,j); switch (j+1) { case 1 : ilGen->Emit(OpCodes::Ldarg_1); break; case 2 : ilGen->Emit(OpCodes::Ldarg_2); break; case 3 : ilGen->Emit(OpCodes::Ldarg_3); break; default: ilGen->Emit(OpCodes::Ldarg,j+1); break; } if (fi->argTys->get_Chars(j) == 'I') { ilGen->Emit(OpCodes::Box,Type::GetType("System.Int32")); } ilGen->Emit(OpCodes::Stelem_Ref); } ilGen->Emit(OpCodes::Ldarg_0); ilGen->Emit(OpCodes::Ldfld,fieldBuilder); ilGen->Emit(OpCodes::Ldloc_0); ilGen->Emit(OpCodes::Call, System::Type::GetType("Hugs.Wrapper")->GetMethod("InvokeFunction")); // pop the result off of the stack when returning void. if (fi->resTy->Length > 0 && fi->resTy->get_Chars(0) == 'V') { ilGen->Emit(OpCodes::Pop); } ilGen->Emit(OpCodes::Ret); // of 'delegator' shape? if ((fi->resTy->Length == 1 && fi->resTy->get_Chars(0) == 'V') && (fi->argTys->Length == 2 && fi->argTys->get_Chars(1) == 'O' && fi->argTys->get_Chars(1) == 'O')) { System::Type* del_args[] = new System::Type*[2]; del_args[0] = __typeof(System::Object); del_args[1] = System::Type::GetType("System.EventArgs"); MethodBuilder* delegator = typeBuilder->DefineMethod(String::Concat(fi->methodName, "_delegator"), MethodAttributes::Public, CallingConventions::Standard, __typeof(void), del_args); // Simple stuff - just delegate the call (do we really need this meth?) ILGenerator* delIl = delegator->GetILGenerator(); delIl->Emit(OpCodes::Ldarg_0); delIl->Emit(OpCodes::Ldarg_1); delIl->Emit(OpCodes::Ldarg_2); delIl->Emit(OpCodes::Call,methodBuilder); delIl->Emit(OpCodes::Ret); // System::Type compatible with a delegator, create impedance matchers for free. fieldBuilder = typeBuilder->DefineField(String::Concat(fi->methodName, "_handler"), System::Type::GetType("System.EventHandler"), FieldAttributes::Public); ilGenerator->Emit(OpCodes::Ldarg_0); ilGenerator->Emit(OpCodes::Ldarg_0); ilGenerator->Emit(OpCodes::Ldftn,delegator); System::Type* eh_args[] = new System::Type*[2]; eh_args[0] = __typeof(System::Object); eh_args[1] = System::Type::GetType("System.IntPtr"); ConstructorInfo* ci = System::Type::GetType("System.EventHandler")->GetConstructor(eh_args); ilGenerator->Emit(OpCodes::Newobj,ci); ilGenerator->Emit(OpCodes::Stfld,fieldBuilder); } } ilGenerator->Emit(OpCodes::Ret); System::Type* res = typeBuilder->CreateType(); #if 0 Console::WriteLine("Succeeded creating {0} type..", res); #endif // For debugging purposes, persist the generated assembly. // (this goes hand-in-hand with the dynamic, persistable module // we created above). // assemblyBuilder->Save("foo.dll"); return theTypeName; } static System::String* DefineDelegator(System::String* methodName, int stablePtr) { System::String* theTypeName; TypeBuilder* typeBuilder; theTypeName = "DynDelegator"; while (true) { try { #if 0 Console::WriteLine("Attempting to create type {0}..",theTypeName); #endif typeBuilder = moduleBuilder->DefineType(theTypeName, TypeAttributes::Public); break; } catch (ArgumentException*) { uniq++; theTypeName = String::Format("DynDelegator{0}",__box(uniq)); } } #if 0 Console::WriteLine("Succeeded creating {0} type", theTypeName); #endif ConstructorBuilder* constructorBuilder = typeBuilder->DefineConstructor(MethodAttributes::Public, CallingConventions::Standard, 0); ILGenerator* ilGenerator = constructorBuilder->GetILGenerator(); // Call the base constructor -- required? ilGenerator->Emit(OpCodes::Ldarg_0); System::Type* ctor_args[] = new System::Type*[0]; ilGenerator->Emit(OpCodes::Call, System::Type::GetType("System.Object")->GetConstructor(ctor_args)); // Build the delegator method which calls back into Haskell. System::Type* del_args[] = new System::Type*[2]; del_args[0] = __typeof(System::Object); del_args[1] = System::Type::GetType("System.EventArgs"); MethodBuilder* delegator = typeBuilder->DefineMethod(methodName, MethodAttributes::Public, CallingConventions::Standard, System::Type::GetType("System.Void"), del_args); ILGenerator* delIl = delegator->GetILGenerator(); // construct the object array expected by InvokeFunction(). delIl->DeclareLocal(__typeof(Object*[])); delIl->Emit(OpCodes::Ldc_I4,2); delIl->Emit(OpCodes::Newarr,__typeof(System::Object)); delIl->Emit(OpCodes::Stloc_0); // args[0] = arg1; delIl->Emit(OpCodes::Ldloc_0); delIl->Emit(OpCodes::Ldc_I4,0); delIl->Emit(OpCodes::Ldarg_1); delIl->Emit(OpCodes::Stelem_Ref); // args[0] = arg2; delIl->Emit(OpCodes::Ldloc_0); delIl->Emit(OpCodes::Ldc_I4,1); delIl->Emit(OpCodes::Ldarg_2); delIl->Emit(OpCodes::Stelem_Ref); // call InvokeFunction, passing it the method name // delIl.Emit(OpCodes.Ldarg_0); delIl->Emit(OpCodes::Ldc_I4,stablePtr); delIl->Emit(OpCodes::Ldstr,"OO"); delIl->Emit(OpCodes::Ldstr,"V"); delIl->Emit(OpCodes::Ldloc_0); delIl->Emit(OpCodes::Call, System::Type::GetType("Hugs.Wrapper")->GetMethod("InvokeStablePtr")); delIl->Emit(OpCodes::Pop); delIl->Emit(OpCodes::Ret); // System::Type compatible with a delegator, create impedance matchers for free. FieldBuilder* fieldBuilder = typeBuilder->DefineField(String::Concat(methodName,"_handler"), System::Type::GetType("System.EventHandler"), FieldAttributes::Public); ilGenerator->Emit(OpCodes::Ldarg_0); ilGenerator->Emit(OpCodes::Ldarg_0); ilGenerator->Emit(OpCodes::Ldftn,delegator); System::Type* eh_args[] = new System::Type*[2]; eh_args[0] = __typeof(Object); eh_args[1] = System::Type::GetType("System.IntPtr"); ConstructorInfo* ci = System::Type::GetType("System.EventHandler")->GetConstructor(eh_args); ilGenerator->Emit(OpCodes::Newobj,ci); ilGenerator->Emit(OpCodes::Stfld,fieldBuilder); ilGenerator->Emit(OpCodes::Ret); System::Type* res = typeBuilder->CreateType(); // assemblyBuilder.Save("foo.dll"); return theTypeName; } }; /* class Wrapper */ }; /* namespace Hugs */ hugs98-plus-Sep2006/src/dotnet/Invoker.cpp0000644006511100651110000002162607632752646017220 0ustar rossross// // (c) 2002-2003, sof. // // Dynamic invocation helper classes. The details of how // to access the .NET object model via the Reflection API // is taken care of by Invoker.{h,cpp} // #include "Invoker.h" namespace DynInvoke { static TypeName* ParseType(String* str) { int curPos = 0; int endPos; // Console::WriteLine("x{0}y", str); TypeName* typeName = new TypeName(); if ( str->get_Chars(0) == '[' ) { endPos = str->IndexOf(']'); curPos = endPos + 1; typeName->m_assembly = str->Substring(1,endPos-1); typeName->m_length = endPos+1; } String* delimStr = " ,()"; Char delims __gc [] = delimStr->ToCharArray(); endPos = str->IndexOfAny(delims,curPos); // Console::WriteLine("{0} {1} x{2}x", __box(endPos), __box(curPos), str); if ( endPos == -1 ) { typeName->m_class = str->Substring(curPos); } else { typeName->m_class = str->Substring(curPos,endPos-curPos); } // typeName->m_class = str->Substring(curPos,endPos-curPos); typeName->m_length += endPos-curPos; return typeName; } // Method: GetType(String* typeName); // // Purpose: Assembly-savvy version of Type::GetType() // Type* InvokeBridge::GetType(String* typeName) { try { Type* t = Type::GetType(typeName); if (t) return t; } catch (Exception*) { ; } for (int i=0;i < InvokeBridge::m_assemblies->Count; i++) { try { String* stuff = String::Format("{0},{1}",typeName,InvokeBridge::m_assemblies->get_Item(i)->ToString()); // Console::WriteLine(stuff); Type* t = Type::GetType(stuff); if (t) { return t; } } catch (Exception*) { continue; } } return 0; } // // Method: CreateInstance(String* typeName, Object* []) // // Purpose: Assembly-savvy invocation of Activator::CreateInstance Object* InvokeBridge::CreateInstance(TypeName* typeName, Object* args[]) { Object* instance = 0; Type* t = InvokeBridge::GetType(typeName->toStdString()); // Console::WriteLine("x{0} y{1}", typeName->toStdString(), t); if (!t) { try { Assembly* localA = Assembly::LoadFrom(typeName->m_assembly); t = localA->GetType(typeName->m_class); } catch (Exception* e) { ; } } if (!t) { try { AppDomain* currentDomain = AppDomain::CurrentDomain; // Assembly* stuff[] = currentDomain->GetAssemblies(); // for (int i=0;i < stuff.Length; i++) { // Console::WriteLine("x{0} y{1}", stuff[i]->ToString(), stuff[i]->FullName); // } // Console::WriteLine("x{0} y{1}", typeName->toStdString(), t); Assembly* localA = Assembly::LoadWithPartialName("HugsAssembly"); t = localA->GetType(typeName->m_class); // Console::WriteLine("x{0} y{1}", typeName->toStdString(), t); } catch (Exception*) { ; } } if (t) { try { Object* o =Activator::CreateInstance(t,(Object* [])args); return o; } catch (Exception* e) { Console::WriteLine("Failure: {0}", e); return 0; } } } // // Method: CreateObject(String* objSpec, Array* args) // // Purpose: Given a fully qualified name of a class/type, try // to create an instance of it. // Object* InvokeBridge::CreateObject(String* assemName, String* objSpec, Array* args) { Object* instance = 0; // Unravel the name of the class/type. TypeName* typeName = ParseType(objSpec); if (assemName != 0 && assemName->Length > 0) { typeName->m_assembly = assemName; } // Try creating the instance.. try { instance = InvokeBridge::CreateInstance(typeName,(Object* [])args); } catch (Exception* e) { Console::WriteLine("Unable to create instance \"{0}\" {1}", objSpec, e); throw(e); } if (!instance) { Console::WriteLine("Unable to create instance \"{0}\"", objSpec); } return instance; } // // Method: InvokeMethod // // Purpose: Given a pointer to an already created object, look up // one of its method. If found, invoke the method passing it // 'args' as arguments. // Object* InvokeBridge::InvokeMethod(Object* obj, String* methName, Array* args) { // Get the methods from the type MethodInfo* methods __gc[] = obj->GetType()->GetMethods(); MethodInfo* mInfo; if (!methods) { Console::WriteLine("InvokeMethod: No matching types found"); return 0; } System::Reflection::BindingFlags flgs = (System::Reflection::BindingFlags) // why do I need to cast? (System::Reflection::BindingFlags::Public | System::Reflection::BindingFlags::NonPublic | System::Reflection::BindingFlags::Instance | System::Reflection::BindingFlags::Static | System::Reflection::BindingFlags::InvokeMethod); /* Caller is assumed to catch any exceptions raised. */ return obj->GetType()->InvokeMember(methName, flgs, 0, obj, (Object __gc* [])args); } // // Method: InvokeStaticMethod // // Purpose: Invoke a static method, given the fully qualified name // of the method (and its arguments). If found, invoke the // method passing it 'args' as arguments. // Object* InvokeBridge::InvokeStaticMethod(String* assemName, String* typeAndMethName, Array* args) { // Get the methods from the type MethodInfo* methods __gc[]; MethodInfo* mInfo; int lastDot = typeAndMethName->LastIndexOf('.'); String* className = typeAndMethName->Substring(0,lastDot); String* methName = typeAndMethName->Substring(lastDot+1); // Unravel the name of the class/type. TypeName* typeName = ParseType(className); Type* t; if (assemName != 0 && assemName->Length > 0) { typeName->m_assembly = assemName; } try { t = InvokeBridge::GetType(typeName->toStdString()); if (!t) { try { Assembly* localA = Assembly::LoadFrom(typeName->m_assembly); t = localA->GetType(typeName->m_class); // Console::WriteLine("InvokeStaticMethod: Type {0} found", t); } catch (Exception* e) { ; } } if (t) { methods = t->GetMethods(); } else { Console::WriteLine("InvokeStaticMethod: Type {0} not found", className); return 0; } } catch (Exception *e) { Console::WriteLine("InvokeStaticMethod: Type {0} not found", className); throw(e); } System::Reflection::BindingFlags flgs = (System::Reflection::BindingFlags) // why do I need to cast? (System::Reflection::BindingFlags::DeclaredOnly | System::Reflection::BindingFlags::Public | System::Reflection::BindingFlags::NonPublic | System::Reflection::BindingFlags::Static | System::Reflection::BindingFlags::InvokeMethod); return t->InvokeMember(methName, flgs, 0, 0, (Object __gc* [])args); } // // Method: GetField // // Purpose: Fetch the (boxed) value of named field of a given object. // Object* InvokeBridge::GetField(Object* obj, System::String* fieldName) { FieldInfo* fInfo = obj->GetType()->GetField(fieldName); return fInfo->GetValue(obj); } // // Method: GetStaticField // // Purpose: Fetch the (boxed) value of named static field. // Object* InvokeBridge::GetStaticField(System::String* clsName, System::String* fieldName) { Type* ty = InvokeBridge::GetType(clsName); System::Reflection::BindingFlags static_field_flgs = (System::Reflection::BindingFlags) (System::Reflection::BindingFlags::Public | System::Reflection::BindingFlags::NonPublic | System::Reflection::BindingFlags::FlattenHierarchy | System::Reflection::BindingFlags::Static); FieldInfo* fInfo = ty->GetField(fieldName, static_field_flgs); return fInfo->GetValue(0); // according to doc, ok to pass any val here. } // // Method: SetField // // Purpose: Replace the (boxed) value of named field of a given object. // void InvokeBridge::SetField(Object* obj, System::String* fieldName, Object* val) { FieldInfo* fInfo = obj->GetType()->GetField(fieldName); fInfo->SetValue(obj,val); return; } // // Method: SetStaticField // // Purpose: Replace the (boxed) value of named static field. // void InvokeBridge::SetStaticField(System::String* clsName, System::String* fieldName, Object* val) { Type* ty = InvokeBridge::GetType(clsName); System::Reflection::BindingFlags static_field_flgs = (System::Reflection::BindingFlags) (System::Reflection::BindingFlags::Public | System::Reflection::BindingFlags::NonPublic | System::Reflection::BindingFlags::FlattenHierarchy | System::Reflection::BindingFlags::Static); FieldInfo* fInfo = ty->GetField(fieldName,static_field_flgs); fInfo->SetValue(0,val); return; } Array* InvokeBridge::NewArgArray(int sz) { return Array::CreateInstance(__typeof(Object), sz); } void InvokeBridge::SetArg(Array* arr, Object* val, int idx) { arr->SetValue(val,idx); } Object* InvokeBridge::GetArg(Array* arr, int idx) { return arr->GetValue(idx); } } /* namespace */ hugs98-plus-Sep2006/src/dotnet/Invoker.h0000644006511100651110000001126407630573257016657 0ustar rossross// // (c) 2002, sof. // // Dynamic invocation helper classes. The details of how // to access the .NET object model via the Reflection API // is taken care of by Invoker.{h,cpp} // #pragma once #using using namespace System; using namespace System::Reflection; using namespace System::Text; namespace DynInvoke { #ifdef DEBUG public __gc class CustomException : public Exception { public: CustomException(System::String* m) : Exception(m) {} CustomException(System::String* m, Exception* n) : Exception(m,n) {} }; #endif // // Class: TypeName // // Purpose: pairing up an assembly name and the type/class name. // public __gc class TypeName { public: System::String* m_assembly; System::String* m_class; int m_length; TypeName() { m_assembly = String::Empty; m_class = String::Empty; m_length = 0; } void Print() { if (m_assembly && m_assembly != String::Empty ) { Console::Write("["); Console::Write(m_assembly); Console::Write("]"); } Console::WriteLine(m_class); } int Length() { return m_length; } System::String* toStdString() { System::String* res = new System::String(m_class->ToCharArray()); if (m_assembly && m_assembly != String::Empty ){ res = String::Concat(res, S","); res = String::Concat(res, m_assembly); } return res; } }; // // Class: InvokeBridge // // Purpose: Collection of (static) methods for dynamically creating // objects and accessing methods/fields on them. // public __gc class InvokeBridge { public: static InvokeBridge() { Assembly* corAss = Assembly::Load("mscorlib.dll"); System::String* dir = System::IO::Path::GetDirectoryName(corAss->Location); m_assemblies = new System::Collections::ArrayList(); System::String* fs[] = System::IO::Directory::GetFiles(dir, "*.dll"); for (int i=0;i < fs->Length; i++) { try { Assembly* tAss = Assembly::LoadFrom(fs[i]); m_assemblies->Add(tAss->FullName); } catch (Exception* e) { continue; } } } // // Method: CreateObject(Stirng* assemName, String* objSpec, Array* args) // // Purpose: Given a fully qualified name of a class/type, try // to create an instance of it. // static Object* CreateObject(System::String* assemName, System::String* objSpec, Array* args); // // Method: InvokeMethod // // Purpose: Given a pointer to an already created object, look up // one of its method. If found, invoke the method passing it // 'args' as arguments. // // Comments: the format of the method-spec is "methodName(type1,..,typeN)" [N>=0] // static Object* InvokeMethod(Object* obj, System::String* methSpec, Array* args); // // Method: InvokeStaticMethod // // Purpose: Invoke a static method, given the fully qualified name // of the method (and its arguments). If found, invoke the // method passing it 'args' as arguments. // // Comments: the format of the method-spec is // "T1.T2.<..>.Tn.methodName(type1,..,typeN)" [N>=0] // static Object* InvokeStaticMethod(System::String* assemName, System::String* methSpec, Array* args); // // Method: GetField // // Purpose: Fetch the (boxed) value of named field of a given object. // static Object* GetField(Object* obj, System::String* fieldSpec); // // Method: GetField // // Purpose: Fetch the (boxed) value of named static field. // static Object* GetStaticField(System::String* clsName, System::String* fieldSpec); // // Method: SetField // // Purpose: Replace the (boxed) value of named field of a given object. // static void SetField(Object* obj, System::String* fieldSpec, Object* val); // // Method: SetStaticField // // Purpose: Replace the (boxed) value of named field of a given object. // static void SetStaticField(System::String* clsName,System::String* fieldSpec, Object* val); // // Method: NewArgArray // // Purpose: create a new array for holding (boxed) arguments to constructors/ // methods. // static Array* NewArgArray(int sz); // // Method: SetArg // // Purpose: set an entry in the argument vector. // static void SetArg(Array* arr, Object* val, int idx); // // Method: GetArg // // Purpose: get an entry in the argument vector. // static Object* GetArg(Array* arr, int idx); static System::Type* InvokeBridge::GetType(System::String* typeName); protected: static System::Collections::ArrayList __gc* m_assemblies; static Object* InvokeBridge::CreateInstance(TypeName* typeName, Object* args[]); }; } /* namespace */ hugs98-plus-Sep2006/src/dotnet/Makefile0000644006511100651110000002747710153350400016517 0ustar rossross# Generated automatically from Makefile.in by configure. # -------------------------------------------------------------------------- # Makefile for Hugs # # The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the # Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, # 1994-2004, All rights reserved. It is distributed as # free software under the license in the file "License", which is # included in the distribution. # -------------------------------------------------------------------------- # Targets: # # : make hugs.exe and runhugs.exe # install: make and install programs/libraries # hugs.exe: make minimal working system # runhugs.exe: make batch-mode version of Hugs # hugsscript.dll: make DLL version of Hugs # clean: delete files not required in running system # distclean: delete files that can be regenerated using C compiler # veryclean: delete all machine generated files # (you need perl, bison/yacc, etc to rebuild these files) # TAGS: build emacs TAGS table CC = cl /nologo CFLAGS = -clr -DDOTNET -DMONTH_YEAR="\"Nov 2003\"" #CFLAGS = -ML -Zi -DMONTH_YEAR="\"Nov 2003"" OPTFLAGS = -O2 LD = $(CC) -clr LDFLAGS = # When debugging: #LDFLAGS = -Zi DLL_FLAGS = /LD PIC_FLAGS = LIBS = kernel32.lib advapi32.lib YACC = bison RM = -del CP = copy EXEEXT = .exe OBJEXT = obj .SUFFIXES : .SUFFIXES : .c .h .$(OBJEXT) DOTNET_FILES = dotnet\Invoker.cpp dotnet\HugsServ.cpp \ dotnet\HugsWrapper.cpp dotnet\prim.cpp DOBJECTS = dotnet\Invoker.$(OBJEXT) dotnet\HugsServ.$(OBJEXT) \ dotnet\prim.$(OBJEXT) dotnet\HugsWrapper.$(OBJEXT) HFILES = HsFFI.h builtin.h char.h command.h config.h connect.h \ errors.h evaluator.h goal.h machdep.h module.h observe.h \ options.h opts.h output.h prelude.h script.h server.h \ storage.h strutil.h subst.h CFILES = hugs.c runhugs.c server.c edit.c observe.c \ builtin.c char.c compiler.c errors.c evaluator.c ffi.c \ goal.c input.c machdep.c machine.c module.c opts.c \ output.c plugin.c script.c static.c storage.c strutil.c \ subst.c type.c version.c $(DOTNET_FILES) INCFILES = array.c bignums.c dirprim.c interns.c iomonad.c \ preds.c printer.c scc.c timeprim.c timer.c YFILES = parser.y SOURCES = $(HFILES) $(CFILES) $(INCFILES) $(YFILES) OBJECTS = builtin.$(OBJEXT) char.$(OBJEXT) compiler.$(OBJEXT) \ errors.$(OBJEXT) evaluator.$(OBJEXT) ffi.$(OBJEXT) \ goal.$(OBJEXT) input.$(OBJEXT) machdep.$(OBJEXT) \ machine.$(OBJEXT) module.$(OBJEXT) opts.$(OBJEXT) \ output.$(OBJEXT) plugin.$(OBJEXT) script.$(OBJEXT) \ static.$(OBJEXT) storage.$(OBJEXT) strutil.$(OBJEXT) \ subst.$(OBJEXT) type.$(OBJEXT) version.$(OBJEXT) IOBJECTS = hugs.$(OBJEXT) edit.$(OBJEXT) observe.$(OBJEXT) $(OBJECTS) \ hugs.res $(DOBJECTS) ################################################################ # Default target ################################################################ # This rule goes first to make it the default choice default :: all all :: hugs.exe runhugs.exe ffihugs.exe hugsscript.dll ################################################################ # Hugs interpreter and standalone evaluator ################################################################ hugs$(EXEEXT) : $(IOBJECTS) $(LD) $(LDFLAGS) $(IOBJECTS) $(LIBS) -o hugs$(EXEEXT) $(LINK_FLAGS) SERVER_OBJECTS = runhugs.res $(OBJECTS) server.$(OBJEXT) $(DOBJECTS) runhugs.$(OBJEXT) : $(PRELUDE) hugs.c machdep.h timer.c runhugs.c runhugs$(EXEEXT) : runhugs.$(OBJEXT) $(SERVER_OBJECTS) $(LD) $(LDFLAGS) runhugs.$(OBJEXT) $(SERVER_OBJECTS) $(LIBS) -o runhugs$(EXEEXT) $(LINK_FLAGS) ffihugs$(EXEEXT) : ffihugs.$(OBJEXT) $(SERVER_OBJECTS) $(CC) $(LDFLAGS) ffihugs.$(OBJEXT) $(SERVER_OBJECTS) $(LIBS) -o ffihugs$(EXEEXT) $(LINK_FLAGS) ffihugs.$(OBJEXT) : runhugs.$(OBJEXT) $(CC) -c $(CFLAGS) $(OPTFLAGS) -DFFI_COMPILER runhugs.c /Foffihugs.$(OBJEXT) hugsscript.$(OBJEXT) : hugsscript.c hugsscript.dll : $(SERVER_OBJECTS) hugsscript.$(OBJEXT) $(CC) $(DLL_FLAGS) $(LDFLAGS) $(SERVER_OBJECTS) hugsscript.$(OBJEXT) $(LIBS) -o hugsscript.dll # # Create all the FFI extension DLLs. # FFIHUGS=..\ffihugs FFIHUGS_OPTS=+G -98 -P .PHONY: ffi-dlls ffi-dlls: $(FFIHUGS) $(FFIHUGS_OPTS) +L../libraries/Hugs/Storable_aux.c Hugs.Storable $(FFIHUGS) $(FFIHUGS_OPTS) Foreign.Marshal.Alloc $(FFIHUGS) $(FFIHUGS_OPTS) Foreign.Marshal.Utils $(FFIHUGS) $(FFIHUGS_OPTS) +L../libraries/Foreign/C/errno.c Foreign.C.Error $(FFIHUGS) $(FFIHUGS_OPTS) +L../libraries/Network/initWinSock.c +Lwsock32.lib Network.Socket $(FFIHUGS) $(FFIHUGS_OPTS) +Lwsock32.lib Network.BSD ################################################################ # Clean, distclean, veryclean, TAGS ################################################################ clean :: $(RM) *.o $(RM) *.O $(RM) *.obj $(RM) *.OBJ $(RM) *.LIB $(RM) *.DEF $(RM) *.RES $(RM) *.EXP $(RM) *.ILK $(RM) *.PDB $(RM) *.TD2 $(RM) *.MAP $(RM) *.CSM $(RM) *.TR2 $(RM) *.DSW $(RM) *.RES $(RM) *.aux $(RM) *.hp distclean :: clean distclean :: $(RM) hugs$(EXEEXT) $(RM) runhugs$(EXEEXT) $(RM) ffihugs$(EXEEXT) $(RM) *.pdf $(RM) TAGS $(RM) *~ veryclean :: distclean veryclean :: $(RM) config.h $(RM) options.h TAGS :: etags *.[ych] ################################################################ # C and Yacc rules ################################################################ .c.$(OBJEXT) : $(CC) -c $(CFLAGS) $(OPTFLAGS) $< dotnet\prim.$(OBJEXT) : dotnet\prim.cpp $(CC) -c $(CFLAGS) $(OPTFLAGS) -I. dotnet\prim.cpp /Fodotnet\prim.$(OBJEXT) dotnet\Invoker.$(OBJEXT) : dotnet\Invoker.cpp $(CC) -c $(CFLAGS) $(OPTFLAGS) -I. dotnet\Invoker.cpp /Fodotnet\Invoker.$(OBJEXT) dotnet\HugsServ.$(OBJEXT) : dotnet\HugsServ.cpp $(CC) -c $(CFLAGS) $(OPTFLAGS) -I. dotnet\HugsServ.cpp /Fodotnet\HugsServ.$(OBJEXT) dotnet\HugsServ.cpp : dotnet\HugsServ.h dotnet\HugsWrapper.$(OBJEXT) : dotnet\HugsWrapper.cpp $(CC) -c $(CFLAGS) $(OPTFLAGS) -I. dotnet\HugsWrapper.cpp /Fodotnet\HugsWrapper.$(OBJEXT) dotnet\HugsWrapper.cpp : dotnet\HugsWrapper.h dotnet\prim.$(OBJEXT) : $(PRELUDE) dotnet\prim.cpp dotnet\Invoker.h dotnet\Invoker.cpp # Old & unused, but keep it around for now. #dotnet\HugsWrapper.dll : hugs$(EXEEXT) dotnet\HugsWrapper.cs # csc /t:library /unsafe /out:dotnet\HugsWrapper.dll dotnet\HugsWrapper.cs /r:hugs$(EXEEXT) #dotnet\HugsWrapper.dll: $(PRELUDE) dotnet\HugsWrapper.cs # Modules to be compiled without optimization. # (old comment: to avoid optimisation bugs in certain compilers. # This may be overly conservative on some compilers.) # (The following explanation is based on a posting by Alastair Reid.) # These modules allocate cells on the Hugs heap and assume a conservative # garbage collector. On some (especially RISC) architectures, the # optimizer may identify a pointer to a Cell as a common subexpression, # and hold that instead of the Cell. This would then be missed by the # conservative garbage collector's simplistic scan of the C stack. # Modules associated with evaluation are safe because they don't assume # conservative GC (see IMPORTANT NOTICE in builtin.c). compiler.$(OBJEXT) : compiler.c $(CC) -c $(CFLAGS) compiler.c static.$(OBJEXT) : static.c $(CC) -c $(CFLAGS) static.c parser.c : parser.y -$(YACC) parser.y mv parser.tab.c parser.c # veryclean :: # $(RM) parser.c hugs.res : msc\hugs.rc ..\icons\hugsicon.ico rc /imsc /i..\icons /r /fo hugs.res msc\hugs.rc runhugs.res : msc\runhugs.rc ..\icons\hsxicon.ico rc /imsc /i..\icons /r /fo runhugs.res msc\runhugs.rc ################################################################ # Generated object dependencies (Don't change or delete this line) ################################################################ hugs.$(OBJEXT): hugs.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ command.h connect.h errors.h script.h opts.h strutil.h evaluator.h \ machdep.h output.h module.h timer.c runhugs.$(OBJEXT): runhugs.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h machdep.h observe.h builtin.h evaluator.h errors.h \ server.h HugsAPI.h server.$(OBJEXT): server.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h script.h machdep.h evaluator.h opts.h strutil.h \ errors.h server.h HugsAPI.h edit.$(OBJEXT): edit.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h opts.h strutil.h machdep.h observe.$(OBJEXT): observe.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h command.h errors.h machdep.h builtin.h output.h \ observe.h builtin.$(OBJEXT): builtin.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h machdep.h char.h builtin.h bignums.c \ printer.c iomonad.c timeprim.c dirprim.c interns.c array.c char.$(OBJEXT): char.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h char.h unitable.c compiler.$(OBJEXT): compiler.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h goal.h char.h output.h opts.h errors.$(OBJEXT): errors.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h opts.h goal.h char.h evaluator.h evaluator.$(OBJEXT): evaluator.c prelude.h config.h platform.h options.h \ storage.h HsFFI.h connect.h errors.h script.h output.h strutil.h opts.h \ machdep.h evaluator.h ffi.$(OBJEXT): ffi.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h output.h strutil.h goal.$(OBJEXT): goal.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h machdep.h opts.h goal.h input.$(OBJEXT): input.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h command.h errors.h module.h script.h opts.h goal.h \ machdep.h char.h parser.c machdep.$(OBJEXT): machdep.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h opts.h strutil.h machdep.h char.h \ evaluator.h machine.$(OBJEXT): machine.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h char.h opts.h module.$(OBJEXT): module.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h module.h output.h opts.$(OBJEXT): opts.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h machdep.h strutil.h opts.h char.h output.$(OBJEXT): output.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h char.h plugin.$(OBJEXT): plugin.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h script.$(OBJEXT): script.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h machdep.h opts.h strutil.h script.h static.$(OBJEXT): static.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h machdep.h errors.h output.h subst.h module.h opts.h \ goal.h scc.c storage.$(OBJEXT): storage.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h opts.h errors.h machdep.h evaluator.h strutil.h \ output.h strutil.$(OBJEXT): strutil.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h strutil.h subst.$(OBJEXT): subst.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h opts.h subst.h type.$(OBJEXT): type.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h output.h subst.h goal.h opts.h preds.c scc.c version.$(OBJEXT): version.c prelude.h config.h platform.h options.h ################################################################ # End of generated object dependencies (Don't change or delete this line) ################################################################ ################################################################ # End of Makefile ################################################################ hugs98-plus-Sep2006/src/dotnet/config.h0000644006511100651110000002641410173334365016501 0ustar rossross/* ../config.h. Generated by configure. */ /* ../config.h.in. Generated from configure.ac by autoheader. */ /* platform-specific defines */ #include "platform.h" /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP systems. This function is required for `alloca.c' support on those systems. */ /* #undef CRAY_STACKSEG_END */ /* Define to 1 if using `alloca.c'. */ #define C_ALLOCA 1 /* Define to 1 if floating point arithmetic is supported. */ #define FLOATS_SUPPORTED 1 /* Define to 1 if you have `alloca', as a function or macro. */ /* #undef HAVE_ALLOCA */ /* Define to 1 if you have and it should be used (not on Ultrix). */ /* #undef HAVE_ALLOCA_H */ /* Define to 1 if you have the header file. */ #define HAVE_ASSERT_H 1 /* Define to 1 if you have the `atan' function. */ #define HAVE_ATAN 1 /* Define to 1 if you have /bin/sh */ #define HAVE_BIN_SH 1 /* Define to 1 if you have the header file. */ #define HAVE_CONIO_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_CONSOLE_H */ /* Define to 1 if you have the header file. */ #define HAVE_CTYPE_H 1 /* Define to 1 if you have the declaration of `altzone', and to 0 if you don't. */ /* #undef HAVE_DECL_ALTZONE */ /* Define to 1 if you have the declaration of `timezone', and to 0 if you don't. */ #define HAVE_DECL_TIMEZONE 1 /* Define to 1 if you have the declaration of `_timezone', and to 0 if you don't. */ #define HAVE_DECL__TIMEZONE 1 /* Define to 1 if you have the header file. */ #define HAVE_DIRECT_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_DIRENT_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_DLFCN_H */ /* Define to 1 if you have the `dlopen' function. */ /* #undef HAVE_DLOPEN */ /* Define to 1 if you have the header file. */ /* #undef HAVE_DL_H */ /* Define to 1 if you have the header file. */ #define HAVE_DOS_H 1 /* Define to 1 if you have the `dup' function. */ /* #undef HAVE_DUP */ /* Define to 1 if you have the header file. */ #define HAVE_ERRNO_H 1 /* Define to 1 if you have the `farcalloc' function. */ /* #undef HAVE_FARCALLOC */ /* Define to 1 if you have the header file. */ #define HAVE_FCNTL_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_FILES_H */ /* Define to 1 if you have the header file. */ #define HAVE_FLOAT_H 1 /* Define to 1 if you have the `fseek' function. */ #define HAVE_FSEEK 1 /* Define to 1 if you have the `fstat' function. */ #define HAVE_FSTAT 1 /* Define to 1 if you have the `ftell' function. */ #define HAVE_FTELL 1 /* Define to 1 if you have the `ftime' function. */ /* #undef HAVE_FTIME */ /* Define to 1 if you have the `GetModuleFileName' function. */ #define HAVE_GETMODULEFILENAME 1 /* Define to 1 if you have the `getrusage' function. */ /* #undef HAVE_GETRUSAGE */ /* Define to 1 if you have the `gettimeofday' function. */ /* #undef HAVE_GETTIMEOFDAY */ /* Define to 1 if you have the `gmtime' function. */ #define HAVE_GMTIME 1 /* Define to 1 if heap profiler can (and should) automatically invoke hp2ps to convert heap profile (in "profile.hp") to PostScript. */ /* #undef HAVE_HP2PS */ /* Define to 1 if you have the header file. */ #define HAVE_INTTYPES_H 1 /* Define to 1 if you have the header file. */ #define HAVE_IO_H 1 /* Define to 1 if you have the `isatty' function. */ #define HAVE_ISATTY 1 /* Define to 1 if compiler supports gcc's "labels as values" (aka computed goto) feature (which is used to speed up instruction dispatch in the interpreter). */ #define HAVE_LABELS_AS_VALUES 0 /* Define to 1 if you have the `dl' library (-ldl). */ /* #undef HAVE_LIBDL */ /* Define to 1 if you have the `dld' library (-ldld). */ /* #undef HAVE_LIBDLD */ /* Define to 1 if you have the `m' library (-lm). */ #define HAVE_LIBM 1 /* Define to 1 if you have the header file. */ #define HAVE_LIMITS_H 1 /* Define to 1 if you have the `LoadLibrary' function. */ #define HAVE_LOADLIBRARY 1 /* Define to 1 if you have the header file. */ #define HAVE_LOCALE_H 1 /* Define to 1 if you have the `localtime' function. */ #define HAVE_LOCALTIME 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_MACH_O_DYLD_H */ /* Define to 1 if you have the `macsystem' function. */ /* #undef HAVE_MACSYSTEM */ /* Define to 1 if you have the header file. */ #define HAVE_MEMORY_H 1 /* Define to 1 if you have the `mktime' function. */ #define HAVE_MKTIME 1 /* Define to 1 if you have the `NSCreateObjectFileImageFromFile' function. */ /* #undef HAVE_NSCREATEOBJECTFILEIMAGEFROMFILE */ /* Define to 1 if you have the `pclose' function. */ /* #undef HAVE_PCLOSE */ /* Define to 1 if you have the `poly' function. */ /* #undef HAVE_POLY */ /* Define to 1 if you have the `popen' function. */ /* #undef HAVE_POPEN */ /* Define if you have POSIX threads libraries and header files. */ /* #undef HAVE_PTHREAD */ /* Define to 1 if you have the `realpath' function. */ /* #undef HAVE_REALPATH */ /* Define to 1 if you have the `rindex' function. */ /* #undef HAVE_RINDEX */ /* Define to 1 if you have the `select' function. */ /* #undef HAVE_SELECT */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SGTTY_H */ /* Define to 1 if you have the `shl_load' function. */ /* #undef HAVE_SHL_LOAD */ /* Define to 1 if you have the header file. */ #define HAVE_SIGNAL_H 1 /* Define to 1 if you have the `sigprocmask' function. */ /* #undef HAVE_SIGPROCMASK */ /* Define to 1 if you have the `snprintf' function. */ /* #undef HAVE_SNPRINTF */ /* Define to 1 if you have the header file. */ /* #undef HAVE_STAT_H */ /* Define to 1 if you have the header file. */ #define HAVE_STDARG_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDINT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_STD_H */ /* Define to 1 if you have the `stime' function. */ /* #undef HAVE_STIME */ /* Define to 1 if you have the `strcasecmp' function. */ /* #undef HAVE_STRCASECMP */ /* Define to 1 if you have the `strcmp' function. */ #define HAVE_STRCMP 1 /* Define to 1 if you have the `strcmpi' function. */ #define HAVE_STRCMPI 1 /* Define to 1 if you have the `stricmp' function. */ #define HAVE_STRICMP 1 /* Define to 1 if you have the header file. */ #define HAVE_STRINGS_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRING_H 1 /* Define to 1 if you have the `strrchr' function. */ #define HAVE_STRRCHR 1 /* Define to 1 if `tm_zone' is member of `struct tm'. */ /* #undef HAVE_STRUCT_TM_TM_ZONE */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_IOCTL_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_PARAM_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_RESOURCE_H */ /* Define to 1 if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_TIMEB_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_TIMES_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_TIME_H */ /* Define to 1 if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define to 1 if you have that is POSIX.1 compatible. */ /* #undef HAVE_SYS_WAIT_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_TERMIOS_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_TERMIO_H */ /* Define to 1 if you have the `time' function. */ #define HAVE_TIME 1 /* Define to 1 if you have the `times' function. */ /* #undef HAVE_TIMES */ /* Define to 1 if you have the header file. */ #define HAVE_TIME_H 1 /* Define to 1 if your `struct tm' has `tm_zone'. Deprecated, use `HAVE_STRUCT_TM_TM_ZONE' instead. */ /* #undef HAVE_TM_ZONE */ /* Define to 1 if you don't have `tm_zone' but do have the external array `tzname'. */ #define HAVE_TZNAME 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_UNISTD_H */ /* Define to 1 if you have the `valloc' function. */ /* #undef HAVE_VALLOC */ /* Define to 1 if you have the header file. */ /* #undef HAVE_VALUES_H */ /* Define to 1 if you have the `vsnprintf' function. */ /* #undef HAVE_VSNPRINTF */ /* Define to 1 if you have the header file. */ #define HAVE_WCHAR_H 1 /* Define to 1 if you have the header file. */ #define HAVE_WINDOWS_H 1 /* Define to 1 if you have the `WinExec' function. */ #define HAVE_WINEXEC 1 /* Define to 1 if you have malloc.h and it defines _alloca - eg for Visual C++. */ #define HAVE__ALLOCA 1 /* Define to 1 if you have the `_fullpath' function. */ #define HAVE__FULLPATH 1 /* Define to 1 if you have the `_pclose' function. */ #define HAVE__PCLOSE 1 /* Define to 1 if you have the `_popen' function. */ #define HAVE__POPEN 1 /* Define to 1 if you have the `_snprintf' function. */ #define HAVE__SNPRINTF 1 /* Define to 1 if you have the `_stricmp' function. */ #define HAVE__STRICMP 1 /* Define to 1 if you have the `_vsnprintf' function. */ #define HAVE__VSNPRINTF 1 /* Define to 1 if jmpbufs can be treated like arrays. */ #define JMPBUF_ARRAY 1 /* Define to 1 if your C compiler inserts underscores before symbol names. */ /* #undef LEADING_UNDERSCORE */ /* C compiler invocation use to build a dynamically loadable library. Typical value: "gcc -shared". Must evaluate to a literal C string. */ #define MKDLL_CMD "cl /LD /ML /nologo" /* Define to 1 if the C compiler supports function prototypes. */ #define PROTOTYPES 1 /* Define to the necessary symbol if this constant uses a non-standard name on your system. */ /* #undef PTHREAD_CREATE_JOINABLE */ /* Define as the return type of signal handlers (`int' or `void'). */ #define RETSIGTYPE void /* The size of a `double', as computed by sizeof. */ #define SIZEOF_DOUBLE 8 /* The size of a `float', as computed by sizeof. */ #define SIZEOF_FLOAT 4 /* The size of a `int', as computed by sizeof. */ #define SIZEOF_INT 4 /* The size of a `int*', as computed by sizeof. */ #define SIZEOF_INTP 4 /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ #define STACK_DIRECTION -1 /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define to 1 if you can safely include both and . */ /* #undef TIME_WITH_SYS_TIME */ /* Define to 1 if your declares `struct tm'. */ /* #undef TM_IN_SYS_TIME */ /* Define to 1 if signal handlers have type void (*)(int) (Otherwise, they're assumed to have type int (*)(void).) */ #define VOID_INT_SIGNALS 1 /* Define like PROTOTYPES; this can be used by system headers. */ #define __PROTOTYPES 1 /* Define to empty if `const' does not conform to ANSI C. */ /* #undef const */ hugs98-plus-Sep2006/src/dotnet/hugs.rc0000644006511100651110000000002607630573257016357 0ustar rossross0 ICON "hugsicon.ico" hugs98-plus-Sep2006/src/dotnet/options.h0000644006511100651110000002013610426134734016721 0ustar rossross/* ../options.h. Generated automatically by configure. */ /* -------------------------------------------------------------------------- * Configuration options * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the Oregon Graduate Institute of Science and * Technology, 1994-1999, All rights reserved. It is distributed as * free software under the license in the file "License", which is * included in the distribution. * * $RCSfile: options.h,v $ * $Revision: 1.9 $ * $Date: 2006/05/03 14:10:36 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Hugs paths and directories * ------------------------------------------------------------------------*/ /* Define this as the default setting of HUGSPATH. * Value may contain string "{Hugs}" (for which we will substitute the * value of HUGSDIR) and should be either colon-separated (Unix) * or semicolon-separated (Macintosh, Windows, DOS). Escape * characters in the path string are interpreted according to normal * Haskell conventions. * * This value can be overridden from the command line by setting the * HUGSFLAGS environment variable or by storing an appropriate value * for HUGSFLAGS in the registry (Win32 only). In all cases, use a * string of the form -P"...". */ #define HUGSPATH ".;{Hugs}\\packages\\*;{Hugs}\\dotnet\\lib" /* The list of suffixes used by Haskell source files, separated either * by colons (Unix) or semicolons (Macintosh, Windows, DOS). * * This value can be overridden using the -S flag. */ #define HUGSSUFFIXES ".hs;.lhs" /* The directory name which is substituted for the string "{Hugs}" * in a path variable. This normally points to where the Hugs libraries * are installed - ie so that the file HUGSDIR/lib/Prelude.hs exists * Typical values are: * "/usr/local/lib/hugs" * "/usr/homes/JFHaskell/hugs" * ".." * * This value is ignored on Windows and Macintosh versions since * it is assumed that the binary is installed in HUGSDIR. * * This value cannot be overridden from the command line or by using * environment variables. This isn't quite as limiting as you'd think * since you can always choose _not_ to use the {Hugs} variable - however, * it's obviously _nicer_ to have it set correctly. */ #ifndef HUGSDIR #define HUGSDIR "" #endif /* -------------------------------------------------------------------------- * User interface options * ------------------------------------------------------------------------*/ /* Define if you want to use the "Hugs for Windows" GUI. * (Windows 3.1 and compatibles only) */ /* #undef HUGS_FOR_WINDOWS */ /* Define if you want filenames to be converted to normal form by: * o replacing relative pathnames with absolute pathnames and * eliminating .. and . where possible. * o converting to lower case (only in case-insensitive filesystems) */ /* #undef PATH_CANONICALIZATION */ /* Define if a command line editor is available and should be used. * There are two choices of command line editor that can be used with Hugs: * GNU readline and editline (from comp.sources.misc, vol 31, issue 71) */ /* #undef USE_READLINE */ /* Define if you want the small startup banner. */ /* #undef SMALL_BANNER */ /* -------------------------------------------------------------------------- * Making Hugs smaller * ------------------------------------------------------------------------*/ /* Define one of these to select overall size of Hugs * SMALL_HUGS for 16 bit operation on a limited memory PC. * REGULAR_HUGS for 32 bit operation using largish default table sizes. * LARGE_HUGS for 32 bit operation using larger default table sizes. */ /* #undef SMALL_HUGS */ /* #undef REGULAR_HUGS */ #define LARGE_HUGS 1 /* -------------------------------------------------------------------------- * Fancy features * ------------------------------------------------------------------------*/ /* Define to omit Hugs extensions */ /* #undef HASKELL_98_ONLY */ /* Define if :xplain should be enabled */ /* #undef EXPLAIN_INSTANCE_RESOLUTION */ /* Define if heap profiling should be used */ /* #undef PROFILING */ /* Define if you want to run Haskell code through a preprocessor * * Note that there's the import chasing mechanism will not spot any * #includes so you must :load (not :reload) if you change any * (non-Haskell) configurations files. */ #define USE_PREPROCESSOR 1 /* Define if you want to time every evaluation. * * Timing is included in the Hugs distribution for the purpose of benchmarking * the Hugs interpreter, comparing its performance across a variety of * different machines, and with other systems for similar languages. * * It would be somewhat foolish to try to use the timings produced in this * way for any other purpose. In particular, using timings to compare the * performance of different versions of an algorithm is likely to give very * misleading results. The current implementation of Hugs as an interpreter, * without any significant optimizations, means that there are much more * significant overheads than can be accounted for by small variations in * Hugs code. */ /* #undef WANT_TIMER */ /* * By default, the Hugs Server API wraps up each value pushed on the stack * as a Dynamic, achieving some run-time type safety when applying these * arguments to a function. This Dynamic layer sometimes gets in the way * for low-level consumers of the Server API (e.g, HaskellScript, Lambada, * mod_haskell), so by setting NO_DYNAMIC_TYPES to 1 you turn off the * use of Dynamics (and assume all the responsibility of debugging any * bad crashes you might see as a result!) */ #define NO_DYNAMIC_TYPES 1 /* -------------------------------------------------------------------------- * Debugging options (intended for use by maintainers) * ------------------------------------------------------------------------*/ /* Define if debugging generated bytecodes or the bytecode interpreter */ /* #undef DEBUG_CODE */ /* Define if debugging generated supercombinator definitions or compiler */ /* #undef DEBUG_SHOWSC */ /* Define if you want to use a low-level printer from within a debugger */ /* #undef DEBUG_PRINTER */ /* Define if you want to perform runtime tag-checks as an internal * consistency check. This makes Hugs run very slowly - but is very * effective at detecting and locating subtle bugs. */ /* #undef CHECK_TAGS */ /* -------------------------------------------------------------------------- * Experimental features * These are likely to disappear/change in future versions and should not * be used by most people.. * ------------------------------------------------------------------------*/ /* Define if you want to use the primitives which let you examine Hugs * internals. */ /* #undef INTERNAL_PRIMS */ /* Define if you want to use the primitives which let you examine Hugs * bytecodes (requires INTERNAL_PRIMS). */ /* #undef BYTECODE_PRIMS */ /* In a plain Hugs system, most signals (SIGBUS, SIGTERM, etc) indicate * some kind of error in Hugs - or maybe a stack overflow. Rather than * just crash, Hugs catches these errors and returns to the main loop. * It does this by calling a function "panic" which longjmp's back to the * main loop. * If you're developing a GreenCard library, this may not be the right * behaviour - it's better if Hugs leaves them for your debugger to * catch rather than trapping them and "panicing". */ #define DONT_PANIC 1 /* If you get really desperate to understand why your Hugs programs keep * crashing or running out of stack, you might like to set this flag and * recompile Hugs. When you hit a stack error, it will print out a list * of all the objects currently under evaluation. The information isn't * perfect and can be pretty hard to understand but it's better than a * poke in the eye with a blunt stick. * * This is a very experimental feature! */ /* #undef GIMME_STACK_DUMPS */ /* ----------------------------------------------------------------------- */ hugs98-plus-Sep2006/src/dotnet/platform.h0000644006511100651110000000137610173332301017044 0ustar rossross/* * configure-sussed platform #defines. */ #ifndef __PLATFORM_H__ #define __PLATFORM_H__ #define HostPlatform i386_unknown_msvc #define TargetPlatform i386_unknown_msvc #define BuildPlatform i386_unknown_msvc /* Definitions suitable for use in CPP conditionals */ #define i386_unknown_msvc_HOST 1 #define i386_unknown_msvc_TARGET 1 #define i386_unknown_msvc_BUILD 1 #define i386_HOST_ARCH 1 #define i386_TARGET_ARCH 1 #define i386_BUILD_ARCH 1 #define msvc_HOST_OS 1 #define msvc_TARGET_OS 1 #define msvc_BUILD_OS 1 /* Definitions of strings for use in C or Haskell code */ #define HOST_ARCH "i686" #define TARGET_ARCH "i686" #define BUILD_ARCH "i686" #define HOST_OS "msvc" #define TARGET_OS "msvc" #define BUILD_OS "msvc" #endif /* __PLATFORM_H__ */ hugs98-plus-Sep2006/src/dotnet/prim.cpp0000644006511100651110000005122407633653346016545 0ustar rossross#using extern "C" { #include "prelude.h" #include "storage.h" #include "connect.h" #include "builtin.h" #include "errors.h" #include "evaluator.h" #include "prim.h" #include "Invoker.h" }; /* Utility macro for converting a System::String to a char* (and later on, free it.) */ #define ToCharString(str) \ (char*)System::Runtime::InteropServices::Marshal::StringToHGlobalAnsi(str).ToPointer() #define FreeCharString(pstr) System::Runtime::InteropServices::Marshal::FreeHGlobal(pstr) /* -------------------------------------------------------------------------- * .NET Ptrs: like mallocPtrs, but store managed pointers instead. * ------------------------------------------------------------------------*/ __gc struct strDotNetPtr { /* .NET pointer description */ Cell npcell; /* Back pointer to NPCELL */ System::Object* ptr; /* Pointer into managed heap */ Int refCount; /* Reference count */ Void (*cleanup) Args((System::Object*)); /* Code to free the .NET pointer */ }; /* * Encoding a global variable in Managed C++; */ __gc class DotNetPtrTable { private: static System::Array __gc* m_table; public: static DotNetPtrTable() { int i; m_table = Array::CreateInstance(__typeof(__gc struct strDotNetPtr), NUM_DOTNETPTRS); for (i=0; i < NUM_DOTNETPTRS; i++) { __gc struct strDotNetPtr* rec = new __gc struct strDotNetPtr; rec->ptr = 0; rec->cleanup = 0; rec->refCount = 0; rec->npcell = NIL; m_table->SetValue(rec,i); } } static int hw_dotnetptrs = 1; static void setVal(int idx, __gc struct strDotNetPtr* rec) { #if 0 Console::WriteLine("setVal({0}) = {1}", __box(idx), rec->ptr->ToString()); #endif m_table->SetValue(rec,idx); } static __gc struct strDotNetPtr* indexDotNetPtrs (int i) { __gc struct strDotNetPtr* res = static_cast<__gc struct strDotNetPtr*>(m_table->GetValue(i)); #if 0 if (res->ptr == 0) { ; } else { Console::WriteLine("indexDotNetPtrs({0}) = {1}", __box(i), res->ptr->ToString()); } #endif return res; } }; __gc struct strDotNetPtr* idxDotNetPtr(int i) { return DotNetPtrTable::indexDotNetPtrs(i); } #define dotNetPtrOf(c) snd(c) #define derefNP(c) (idxDotNetPtr((Int)dotNetPtrOf(c))->ptr) static Cell mkDotNetPtr Args((System::Object *, Void (*)(System::Object *))); extern "C" { System::Object __gc* getNP(Cell c) { return derefNP(c); } static Void incDotNetPtrRefCnt Args((Int, Int)); static Void local pushWideString(wchar_t s __gc[], int l) { /* push pointer to string onto stack */ Int j; char arr[10]; int len; push(nameNil); while (--l >= 0) { len = wctomb(arr,s[l]); for (j=len ; j >= 1; j--) { topfun(consChar(arr[len-j])); } } } Void zeroDotNetTable() { Int i; for (i=0; inpcell = NIL; } Void markDotNetPtrs(Int* marks) { Int i; int max = DotNetPtrTable::hw_dotnetptrs-1; for (i=max; i>0; i--) { /* release any unused dotnet ptrs */ __gc struct strDotNetPtr* rec = DotNetPtrTable::indexDotNetPtrs(i); if (isPair(rec->npcell)) { int place = placeInSet(rec->npcell); int mask = maskInSet(rec->npcell); if ((marks[place]&mask)==0) { incDotNetPtrRefCnt(i,-1); } } } } /* * Allocate .NET object reference on the heap, tagging it with * an NPCELL. */ static Cell mkDotNetPtr(Object* ptr,void (*cleanup)(Object*)) { int i; Cell c = 0; __gc struct strDotNetPtr* rec = new __gc struct strDotNetPtr; for (i=0; irefCount!=0; ++i) ; /* Search for unused entry */ if (i>= NUM_DOTNETPTRS) { /* If at first we don't */ garbageCollect(); /* succeed, garbage collect*/ for (i=0; irefCount!=0; ++i) ; /* and try again ... */ } if (i>=NUM_DOTNETPTRS) { /* ... before we give up */ ERRMSG(0) "Too many DotNetPtrs open" EEND; } if ((i+1) >= DotNetPtrTable::hw_dotnetptrs) { DotNetPtrTable::hw_dotnetptrs = i+1; } c = ap(NPCELL,i); rec->ptr = ptr; rec->cleanup = cleanup; rec->refCount = 1; rec->npcell = c; #if 0 Console::WriteLine("Created {0} at idx {1} {2}", ptr->ToString(), __box(i), __box(snd(c))); #endif DotNetPtrTable::setVal(i,rec); return c; } static Void incDotNetPtrRefCnt(Int n, Int i) { /* change ref count of MallocPtr */ if (!(0<=n && nrefCount > 0)) internal("incDotNetPtrRefCnt"); __gc struct strDotNetPtr* rec = idxDotNetPtr(n); rec->refCount += i; if (rec->refCount <= 0) { rec->cleanup(rec->ptr); rec->ptr = 0; rec->cleanup = 0; rec->refCount = 0; rec->npcell = NIL; #if 0 Console::WriteLine("adjusting hw {0} {1}", __box(n), __box(DotNetPtrTable::hw_dotnetptrs)); #endif if ((n+1) == DotNetPtrTable::hw_dotnetptrs) { DotNetPtrTable::hw_dotnetptrs = n; } } } void freeNetPtr (Object* x) { return; } /* ------------------------------------------------------------------------ * The .NET Primops: * ------------------------------------------------------------------------*/ /* * Function: primInvoker() * * Performs invocation of .NET methods / access fields using metadata provided * via a FFI declaration. */ Void primInvoker(StackPtr root,Name n) { ::Text methName; ::Text fieldSpec; ::Text libName; Int ffiFlags; Bool isIO; Int resultType; List paramTys; Cell c; Int primArity; if (name(n).foreignInfo == NIL) { Console::WriteLine("primInvoker: no ForeignInfo!"); return; } /* unravel the foreignInfo metadata; beautiful. */ c = name(n).foreignInfo; methName = fst(c); libName = fst(snd(c)); ffiFlags = intOf(fst(snd(snd(c)))); isIO = intOf(fst(snd(snd(snd(c))))); resultType = intOf(fst(snd(snd(snd(snd(c)))))); paramTys = snd(snd(snd(snd(snd(c))))); primArity = (isIO ? IOArity : 0); #define PrimReturn(r) if (isIO) { IOReturn(r) ; } else if (len == 0) { push(r); return; } else { updateRoot(r); return; } System::String *methNameStr = new System::String(textToStr(methName)); System::String *libNameStr = ( (libName != -1) ? new System::String(textToStr(libName)) : ""); int len = length(paramTys); List ps = paramTys; Bool hasThis = ((ffiFlags & FFI_DOTNET_STATIC) | (ffiFlags & FFI_DOTNET_CTOR)) == 0; int i = 0; int noArgs = (hasThis ? len - 1 : len); System::Array *args = Array::CreateInstance(__typeof(Object), noArgs); System::Object *thisPtr; /* NOTE: the 'this' pointer is assumed to be passed *last* */ if (hasThis) { eval(primArg(1+primArity)); thisPtr = derefNP(whnfHead); } /* Fill in the parameter array */ for (i=0; iSetValue(__box((char)whnfInt),i); break; case FFI_TYPE_INT: eval(primArg((len-i)+primArity)); checkInt(); args->SetValue(__box(whnfInt),i); break; case FFI_TYPE_INT8: eval(primArg((len-i)+primArity)); checkInt(); args->SetValue(__box((signed char)whnfInt),i); break; case FFI_TYPE_INT16: eval(primArg((len-i)+primArity)); checkInt(); args->SetValue(__box(System::Convert::ToInt16(whnfInt)),i); break; case FFI_TYPE_INT32: eval(primArg((len-i)+primArity)); checkInt(); args->SetValue(__box(whnfInt),i); break; case FFI_TYPE_INT64: eval(primArg((len-i)+primArity)); args->SetValue(__box(int64FromParts(intOf(fst(snd(whnfHead))), intOf(snd(snd(whnfHead))))), i); break; case FFI_TYPE_WORD8: eval(primArg((len-i)+primArity)); checkInt(); args->SetValue(__box((unsigned char)whnfInt),i); break; case FFI_TYPE_WORD16: eval(primArg((len-i)+primArity)); checkInt(); args->SetValue(__box(System::Convert::ToUInt16(whnfInt)),i); break; case FFI_TYPE_WORD32: eval(primArg((len-i)+primArity)); checkInt(); args->SetValue(__box((unsigned int)whnfInt),i); break; case FFI_TYPE_WORD64: eval(primArg((len-i)+primArity)); args->SetValue(__box(int64FromParts(intOf(fst(snd(whnfHead))), intOf(snd(snd(whnfHead))))), i); break; case FFI_TYPE_FLOAT: eval(primArg((len-i)+primArity)); checkFloat(); args->SetValue(__box((float)whnfFloat), i); break; case FFI_TYPE_DOUBLE: eval(primArg((len-i)+primArity)); checkDouble(); args->SetValue(__box((float)whnfDouble), i); break; case FFI_TYPE_BOOL: eval(primArg((len-i)+primArity)); checkBool(); args->SetValue(__box((int)whnfHead==nameTrue), i); break; case FFI_TYPE_ADDR: case FFI_TYPE_PTR: case FFI_TYPE_FUNPTR: eval(primArg((len-i)+primArity)); checkPtr(); args->SetValue(__box((System::IntPtr)ptrOf(whnfHead)), i); break; case FFI_TYPE_FOREIGN: eval(primArg((len-i)+primArity)); args->SetValue(__box((System::IntPtr)derefMP(whnfHead)), i); break; case FFI_TYPE_STABLE: eval(primArg((len-i)+primArity)); args->SetValue(__box((int)intOf(whnfHead)), i); break; case FFI_TYPE_OBJECT: eval(primArg((len-i)+primArity)); args->SetValue(derefNP(whnfHead), i); break; case FFI_TYPE_STRING: { char* r = (char*)evalName(primArg((len-i)+primArity)); args->SetValue(new System::String(r),i); break;} default: break; } } /* Make the call / access the field. */ try { Object __pin* res; if ( ffiFlags & FFI_DOTNET_CTOR ) { res = DynInvoke::InvokeBridge::CreateObject(libNameStr, methNameStr, args); PrimReturn(mkDotNetPtr(res,freeNetPtr)); } else if ( ffiFlags & FFI_DOTNET_METHOD ) { if ( ffiFlags & FFI_DOTNET_STATIC ) { res = DynInvoke::InvokeBridge::InvokeStaticMethod(libNameStr, methNameStr, args); } else { res = DynInvoke::InvokeBridge::InvokeMethod(thisPtr, methNameStr, args); } } else if ( ffiFlags & FFI_DOTNET_FIELD ) { Bool setter = (resultType == FFI_TYPE_UNIT); if ( ffiFlags & FFI_DOTNET_STATIC ) { /* ToDo: split up methNameStr into class and field components */ System::String *fieldName; System::String *clsName; int idx = methNameStr->LastIndexOf('.'); if (idx != (-1) ) { fieldName = methNameStr->Substring(idx+1); clsName = methNameStr->Substring(0,idx); } if (setter) { DynInvoke::InvokeBridge::SetStaticField(clsName, fieldName, args->GetValue(0)); IOReturn(nameUnit); } else { res = DynInvoke::InvokeBridge::GetStaticField(clsName, fieldName); } } else { if (setter) { DynInvoke::InvokeBridge::SetField(thisPtr, methNameStr, args->GetValue(0)); IOReturn(nameUnit); } else { res = DynInvoke::InvokeBridge::GetField(thisPtr, methNameStr); } } } /* With the result in hand, return back to Haskell. */ switch (resultType) { case FFI_TYPE_UNIT: PrimReturn(nameUnit); case FFI_TYPE_CHAR: PrimReturn(mkChar(System::Convert::ToByte(res))); case FFI_TYPE_INT: PrimReturn(mkInt(System::Convert::ToInt32(res))); case FFI_TYPE_INT8: PrimReturn(mkInt((signed char)res)); case FFI_TYPE_INT16: PrimReturn(mkInt((System::Int16)res)); case FFI_TYPE_INT32: PrimReturn(mkInt((System::Int32)res)); case FFI_TYPE_WORD8: PrimReturn(mkInt((unsigned char)res)); case FFI_TYPE_WORD16: PrimReturn(mkInt((System::UInt16)res)); case FFI_TYPE_WORD32: PrimReturn(mkInt((System::UInt32)res)); case FFI_TYPE_INT64: { __int64 r = (__int64)res; PrimReturn(pair(I64CELL,pair(part1Int64(r),part2Int64(r)))); } case FFI_TYPE_WORD64: { __int64 r = (__int64)res; PrimReturn(pair(I64CELL,pair(part1Int64(r),part2Int64(r)))); } case FFI_TYPE_FLOAT: PrimReturn(mkFloat((float)System::Convert::ToDouble(res))); case FFI_TYPE_DOUBLE: PrimReturn(mkDouble(System::Convert::ToDouble(res))); case FFI_TYPE_BOOL: PrimReturn((System::Convert::ToBoolean(res)) ? nameTrue : nameFalse); case FFI_TYPE_ADDR: PrimReturn(mkPtr((::Pointer)(int)res)); case FFI_TYPE_PTR: PrimReturn(mkPtr((::Pointer)(int)res)); case FFI_TYPE_FUNPTR: PrimReturn(mkPtr((::Pointer)(int)res)); case FFI_TYPE_FOREIGN: PrimReturn(mkMallocPtr((::Pointer)(int)res,NULL)); case FFI_TYPE_STABLE: PrimReturn(derefStablePtr((int)res)); case FFI_TYPE_OBJECT: PrimReturn(mkDotNetPtr(res,freeNetPtr)); case FFI_TYPE_STRING: if (res == 0) { push(nameNil); } else { // char* r = ToCharString(res->ToString()); // pushString(r); wchar_t wRes __gc[] = res->ToString()->ToCharArray(); pushWideString(wRes, res->ToString()->Length); } PrimReturn(pop()); default: IOFail(mkIOError(NIL, nameNetException, textToStr(methName), "unknown result type", NIL)); } } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, textToStr(methName), ToCharString(e->ToString()), NIL)); } PrimReturn(nameUnit); } extPrimFun(primCreateObject) { /* String -> DotNetPtr -> IO DotNetPtr */ char* s = evalName(IOArg(2)); eval(IOArg(1)); try { Object __pin* res = DynInvoke::InvokeBridge::CreateObject(0, new System::String(s), static_cast(derefNP(whnfHead))); IOReturn(mkDotNetPtr(res,freeNetPtr)); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, "Dotnet.createObject", ToCharString(e->ToString()), NIL)); } } extPrimFun(primInvokeMethod) { /* DotNetPtr -> String -> DotNetPtr -> IO DotNetPtr */ Object* arg1; System::Array* arg3; Object* res; eval(IOArg(1)); arg3 = static_cast(derefNP(whnfHead)); char* s = evalName(IOArg(2)); eval(IOArg(3)); arg1 = derefNP(whnfHead); try { res = DynInvoke::InvokeBridge::InvokeMethod(arg1, new System::String(s), arg3); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, s, ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(mkDotNetPtr(res,freeNetPtr)); } extPrimFun(primInvokeStaticMethod) { /* String -> DotNetPtr -> IO DotNetPtr */ System::Array* arg2; Object* res; eval(IOArg(1)); arg2 = static_cast(derefNP(whnfHead)); char* s = evalName(IOArg(2)); try { res = DynInvoke::InvokeBridge::InvokeStaticMethod(0, new System::String(s), arg2); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, s, ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(mkDotNetPtr(res,freeNetPtr)); } extPrimFun(primGetField) { /* DotNetPtr -> String -> IO DotNetPtr */ System::Object* arg1; Object* res; char* s = evalName(IOArg(1)); eval(IOArg(2)); arg1 = derefNP(whnfHead); try { res = DynInvoke::InvokeBridge::GetField(arg1, new System::String(s)); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, s, ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(mkDotNetPtr(res,freeNetPtr)); } extPrimFun(primGetStaticField) { /* String -> String -> IO DotNetPtr */ System::Object* arg1; Object* res; char* fName = evalName(IOArg(1)); char* cName = evalName(IOArg(2)); try { res = DynInvoke::InvokeBridge::GetStaticField(new System::String(cName),new System::String(fName)); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, fName, ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(mkDotNetPtr(res,freeNetPtr)); } extPrimFun(primSetField) { /* DotNetPtr -> String -> DotNetPtr -> IO () */ System::Object* arg1; System::Object* arg3; eval(IOArg(1)); arg3 = derefNP(whnfHead); char* s = evalName(IOArg(2)); eval(IOArg(3)); arg1 = derefNP(whnfHead); try{ DynInvoke::InvokeBridge::SetField(arg1, new System::String(s),arg3); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, s, ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(nameUnit); } extPrimFun(primSetStaticField) { /* String -> String -> DotNetPtr -> IO () */ System::Object* arg3; eval(IOArg(1)); arg3 = derefNP(whnfHead); char* fName = evalName(IOArg(2)); char* clsName = evalName(IOArg(3)); try{ DynInvoke::InvokeBridge::SetField(new System::String(clsName),new System::String(fName),arg3); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, fName, ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(nameUnit); } extPrimFun(primNewString) { /* String -> IO DotNetPtr */ Object* res; char* s = evalName(IOArg(1)); try { res = new System::String(s); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, "Dotnet.newString", ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(mkDotNetPtr(res,freeNetPtr)); } extPrimFun(primToHsString) { /* DotNetPtr -> IO String */ Object* arg1; int count; eval(IOArg(1)); arg1 = derefNP(whnfHead); if (arg1) { wchar_t wRes __gc[] = arg1->ToString()->ToCharArray(); pushWideString(wRes, arg1->ToString()->Length); } else { push(nameNil); } IOReturn(pop()); } extPrimFun(primNewArgArray) { /* Int -> IO DotNetPtr */ Object* res; int sz; IntArg(sz,1+IOArity); try { res = DynInvoke::InvokeBridge::NewArgArray(sz); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, "Dotnet.newArgArray", ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(mkDotNetPtr(res,freeNetPtr)); } extPrimFun(primSetArg) { /* DotNetPtr -> DotNetPtr -> Int -> IO () */ System::Array* arg1; Object* arg2; int idx; IntArg(idx,1+IOArity); eval(IOArg(2)); arg2 = derefNP(whnfHead); eval(IOArg(3)); arg1 = static_cast(derefNP(whnfHead)); try { DynInvoke::InvokeBridge::SetArg(arg1,arg2,idx); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, "Dotnet.setArgArray", ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(nameUnit); } extPrimFun(primGetArg) { /* DotNetPtr -> Int -> IO DotNetPtr */ System::Array* arg1; Object* res; int idx; IntArg(idx,1+IOArity); eval(IOArg(2)); arg1 = static_cast(derefNP(whnfHead)); try { res = DynInvoke::InvokeBridge::GetArg(arg1,idx); } catch (Exception* e) { IOFail(mkIOError(NIL, nameNetException, "Dotnet.getArg", ToCharString(e->GetType()->ToString()), NIL)); } IOReturn(mkDotNetPtr(res,freeNetPtr)); } extPrimFun(primIsNullPtr) { /* DotNetPtr -> IO Bool */ Object* arg1; eval(IOArg(1)); arg1 = static_cast(derefNP(whnfHead)); IOReturn((arg1 == 0) ? nameTrue:nameFalse); } extPrimFun(primMkPrimVector) { /* Int -> Int -> IO DotNetPtr */ System::Int32 ty; System::Int32 sz; IntArg(ty,2+IOArity); IntArg(sz,1+IOArity); switch (ty) { case 0: // Byte IOReturn(mkDotNetPtr(new Byte[sz],freeNetPtr)); case 1: // Boolean IOReturn(mkDotNetPtr(new Boolean[sz],freeNetPtr)); case 2: // Char IOReturn(mkDotNetPtr(new System::Char[sz],freeNetPtr)); case 3: // Double IOReturn(mkDotNetPtr(new System::Double[sz],freeNetPtr)); case 4: // Int16 IOReturn(mkDotNetPtr(new System::Int16[sz],freeNetPtr)); case 5: // Int32 IOReturn(mkDotNetPtr(new System::Int32[sz],freeNetPtr)); case 6: // Int64 IOReturn(mkDotNetPtr(new System::Int64[sz],freeNetPtr)); case 7: // SByte IOReturn(mkDotNetPtr(new System::SByte[sz],freeNetPtr)); case 8: // Single IOReturn(mkDotNetPtr(new System::Single[sz],freeNetPtr)); case 9: // UInt16 IOReturn(mkDotNetPtr(new System::UInt16[sz],freeNetPtr)); case 10: // UInt32 IOReturn(mkDotNetPtr(new System::UInt32[sz],freeNetPtr)); case 11: // UInt64 IOReturn(mkDotNetPtr(new System::UInt64[sz],freeNetPtr)); default: IOFail(mkIOError(NIL, nameIllegal, "Dotnet.mkPrimVector", "", NIL)); } } }; hugs98-plus-Sep2006/src/dotnet/prim.h0000644006511100651110000000033007632752505016176 0ustar rossross#pragma once extern "C" { extern System::Object __gc* getNP(Cell c); Cell mkDotNetPtr (System::Object *, Void (*)(System::Object *)); Void incDotNetPtrRefCnt(Int, Int); Void freeNetPtr (System::Object* x); }; hugs98-plus-Sep2006/src/dotnet/runhugs.rc0000644006511100651110000000002507630573257017103 0ustar rossross0 ICON "hsxicon.ico" hugs98-plus-Sep2006/src/machugs/0000755006511100651110000000000010504340135015174 5ustar rossrosshugs98-plus-Sep2006/src/machugs/MoreFilesExtras.c0000644006511100651110000001672407242472532020442 0ustar rossross/* ** Apple Macintosh Developer Technical Support ** ** A collection of useful high-level File Manager routines. ** ** by Jim Luther, Apple Developer Technical Support Emeritus ** ** File: MoreFilesExtras.c ** ** Copyright © 1992-1998 Apple Computer, Inc. ** All rights reserved. ** ** You may incorporate this sample code into your applications without ** restriction, though the sample code has been provided "AS IS" and the ** responsibility for its operation is 100% yours. However, what you are ** not permitted to do is to redistribute the source as "DSC Sample Code" ** after having made changes. If you're going to re-distribute the source, ** we require that you make it clear in the source that the code was ** descended from Apple Sample Code, but that you've made changes. */ #include #include #include #define __COMPILINGMOREFILES #include "MoreFilesExtras.h" /*****************************************************************************/ pascal void TruncPString(StringPtr destination, ConstStr255Param source, short maxLength) { short charType; if ( source != NULL && destination != NULL ) /* don't do anything stupid */ { if ( source[0] > maxLength ) { /* Make sure the string isn't truncated in the middle of */ /* a multi-byte character. */ while (maxLength != 0) { charType = CharByte((Ptr)&source[1], maxLength); if ( (charType == smSingleByte) || (charType == smLastByte) ) break; /* source[maxLength] is now a valid last character */ --maxLength; } } else { maxLength = source[0]; } /* Set the destination string length */ destination[0] = maxLength; /* and copy maxLength characters (if needed) */ if ( source != destination ) { while ( maxLength != 0 ) { destination[maxLength] = source[maxLength]; --maxLength; } } } } /*****************************************************************************/ /* ** GetVolumeInfoNoName uses pathname and vRefNum to call PBHGetVInfoSync ** in cases where the returned volume name is not needed by the caller. ** The pathname and vRefNum parameters are not touched, and the pb ** parameter is initialized by PBHGetVInfoSync except that ioNamePtr in ** the parameter block is always returned as NULL (since it might point ** to the local tempPathname). ** ** I noticed using this code in several places, so here it is once. ** This reduces the code size of MoreFiles. */ pascal OSErr GetVolumeInfoNoName(ConstStr255Param pathname, short vRefNum, HParmBlkPtr pb) { Str255 tempPathname; OSErr error; /* Make sure pb parameter is not NULL */ if ( pb != NULL ) { pb->volumeParam.ioVRefNum = vRefNum; if ( pathname == NULL ) { pb->volumeParam.ioNamePtr = NULL; pb->volumeParam.ioVolIndex = 0; /* use ioVRefNum only */ } else { BlockMoveData(pathname, tempPathname, pathname[0] + 1); /* make a copy of the string and */ pb->volumeParam.ioNamePtr = (StringPtr)tempPathname; /* use the copy so original isn't trashed */ pb->volumeParam.ioVolIndex = -1; /* use ioNamePtr/ioVRefNum combination */ } error = PBHGetVInfoSync(pb); pb->volumeParam.ioNamePtr = NULL; /* ioNamePtr may point to local tempPathname, so don't return it */ } else { error = paramErr; } return ( error ); } /*****************************************************************************/ pascal OSErr GetCatInfoNoName(short vRefNum, long dirID, ConstStr255Param name, CInfoPBPtr pb) { Str31 tempName; OSErr error; /* Protection against File Sharing problem */ if ( (name == NULL) || (name[0] == 0) ) { tempName[0] = 0; pb->dirInfo.ioNamePtr = tempName; pb->dirInfo.ioFDirIndex = -1; /* use ioDirID */ } else { pb->dirInfo.ioNamePtr = (StringPtr)name; pb->dirInfo.ioFDirIndex = 0; /* use ioNamePtr and ioDirID */ } pb->dirInfo.ioVRefNum = vRefNum; pb->dirInfo.ioDrDirID = dirID; error = PBGetCatInfoSync(pb); pb->dirInfo.ioNamePtr = NULL; return ( error ); } /*****************************************************************************/ pascal OSErr DetermineVRefNum(ConstStr255Param pathname, short vRefNum, short *realVRefNum) { HParamBlockRec pb; OSErr error; error = GetVolumeInfoNoName(pathname,vRefNum, &pb); if ( error == noErr ) { *realVRefNum = pb.volumeParam.ioVRefNum; } return ( error ); } /*****************************************************************************/ pascal OSErr GetDirectoryID(short vRefNum, long dirID, ConstStr255Param name, long *theDirID, Boolean *isDirectory) { CInfoPBRec pb; OSErr error; error = GetCatInfoNoName(vRefNum, dirID, name, &pb); if ( error == noErr ) { *isDirectory = (pb.hFileInfo.ioFlAttrib & ioDirMask) != 0; if ( *isDirectory ) { *theDirID = pb.dirInfo.ioDrDirID; } else { *theDirID = pb.hFileInfo.ioFlParID; } } return ( error ); } /*****************************************************************************/ pascal OSErr GetDirItems(short vRefNum, long dirID, ConstStr255Param name, Boolean getFiles, Boolean getDirectories, FSSpecPtr items, short reqItemCount, short *actItemCount, short *itemIndex) /* start with 1, then use what's returned */ { CInfoPBRec pb; OSErr error; long theDirID; Boolean isDirectory; FSSpec *endItemsArray; if ( *itemIndex > 0 ) { /* NOTE: If I could be sure that the caller passed a real vRefNum and real directory */ /* to this routine, I could rip out calls to DetermineVRefNum and GetDirectoryID and this */ /* routine would be much faster because of the overhead of DetermineVRefNum and */ /* GetDirectoryID and because GetDirectoryID blows away the directory index hint the Macintosh */ /* file system keeps for indexed calls. I can't be sure, so for maximum throughput, */ /* pass a big array of FSSpecs so you can get the directory's contents with few calls */ /* to this routine. */ /* get the real volume reference number */ error = DetermineVRefNum(name, vRefNum, &pb.hFileInfo.ioVRefNum); if ( error == noErr ) { /* and the real directory ID of this directory (and make sure it IS a directory) */ error = GetDirectoryID(vRefNum, dirID, name, &theDirID, &isDirectory); if ( error == noErr ) { if ( isDirectory ) { *actItemCount = 0; endItemsArray = items + reqItemCount; while ( (items < endItemsArray) && (error == noErr) ) { pb.hFileInfo.ioNamePtr = (StringPtr) &items->name; pb.hFileInfo.ioDirID = theDirID; pb.hFileInfo.ioFDirIndex = *itemIndex; error = PBGetCatInfoSync(&pb); if ( error == noErr ) { items->parID = pb.hFileInfo.ioFlParID; /* return item's parID */ items->vRefNum = pb.hFileInfo.ioVRefNum; /* return item's vRefNum */ ++*itemIndex; /* prepare to get next item in directory */ if ( (pb.hFileInfo.ioFlAttrib & ioDirMask) != 0 ) { if ( getDirectories ) { ++*actItemCount; /* keep this item */ ++items; /* point to next item */ } } else { if ( getFiles ) { ++*actItemCount; /* keep this item */ ++items; /* point to next item */ } } } } } else { /* it wasn't a directory */ error = dirNFErr; } } } } else { /* bad itemIndex */ error = paramErr; } return ( error ); } /*****************************************************************************/ hugs98-plus-Sep2006/src/machugs/MoreFilesExtras.h0000644006511100651110000003143407242472532020442 0ustar rossross/* ** Apple Macintosh Developer Technical Support ** ** A collection of useful high-level File Manager routines. ** ** by Jim Luther, Apple Developer Technical Support Emeritus ** ** File: MoreFilesExtras.h ** ** Copyright © 1992-1998 Apple Computer, Inc. ** All rights reserved. ** ** You may incorporate this sample code into your applications without ** restriction, though the sample code has been provided "AS IS" and the ** responsibility for its operation is 100% yours. However, what you are ** not permitted to do is to redistribute the source as "DSC Sample Code" ** after having made changes. If you're going to re-distribute the source, ** we require that you make it clear in the source that the code was ** descended from Apple Sample Code, but that you've made changes. */ #ifndef __MOREFILESEXTRAS__ #define __MOREFILESEXTRAS__ #include #include #include "Optimization.h" #ifdef __cplusplus extern "C" { #endif /*****************************************************************************/ /* Constants and types from Universal Interfaces 3.0.1 Files.h */ #if UNIVERSAL_INTERFACES_VERSION < 0x0301 enum { volMountNoLoginMsgFlagBit = 0, /* Input to VolumeMount: If set, the file system */ volMountNoLoginMsgFlagMask = 0x0001, /* should suppresss any log-in message/greeting dialog */ volMountExtendedFlagsBit = 7, /* Input to VolumeMount: If set, the mount info is a */ volMountExtendedFlagsMask = 0x0080 /* AFPXVolMountInfo record for 3.7 AppleShare Client */ }; /* AFPXVolMountInfo is the new AFP volume mount info record, requires the 3.7 AppleShare Client */ struct AFPXVolMountInfo { short length; /* length of location data (including self) */ VolumeType media; /* type of media */ short flags; /* bits for no messages, no reconnect */ SInt8 nbpInterval; /* NBP Interval parameter (IM2, p.322) */ SInt8 nbpCount; /* NBP Interval parameter (IM2, p.322) */ short uamType; /* User Authentication Method type */ short zoneNameOffset; /* short positive offset from start of struct to Zone Name */ short serverNameOffset; /* offset to pascal Server Name string */ short volNameOffset; /* offset to pascal Volume Name string */ short userNameOffset; /* offset to pascal User Name string */ short userPasswordOffset; /* offset to pascal User Password string */ short volPasswordOffset; /* offset to pascal Volume Password string */ short extendedFlags; /* extended flags word */ short uamNameOffset; /* offset to a pascal UAM name string */ short alternateAddressOffset; /* offset to Alternate Addresses in tagged format */ char AFPData[176]; /* variable length data may follow */ }; typedef struct AFPXVolMountInfo AFPXVolMountInfo; typedef AFPXVolMountInfo * AFPXVolMountInfoPtr; enum { kAFPExtendedFlagsAlternateAddressMask = 1 /* bit in AFPXVolMountInfo.extendedFlags that means alternateAddressOffset is used*/ }; enum { /* constants for use in AFPTagData.fType field*/ kAFPTagTypeIP = 0x01, kAFPTagTypeIPPort = 0x02, kAFPTagTypeDDP = 0x03 /* Currently unused*/ }; enum { /* constants for use in AFPTagData.fLength field*/ kAFPTagLengthIP = 0x06, kAFPTagLengthIPPort = 0x08, kAFPTagLengthDDP = 0x06 }; struct AFPTagData { UInt8 fLength; /* length of this data tag including the fLength field */ UInt8 fType; UInt8 fData[1]; /* variable length data */ }; typedef struct AFPTagData AFPTagData; struct AFPAlternateAddress { UInt8 fAddressCount; UInt8 fAddressList[1]; /* actually variable length packed set of AFPTagData */ }; typedef struct AFPAlternateAddress AFPAlternateAddress; #endif #if PRAGMA_ALIGN_SUPPORTED #pragma options align=mac68k #endif #if PRAGMA_ALIGN_SUPPORTED #pragma options align=reset #endif /*****************************************************************************/ pascal void TruncPString(StringPtr destination, ConstStr255Param source, short maxLength); /* ¶ International friendly string truncate routine. The TruncPString function copies up to maxLength characters from the source Pascal string to the destination Pascal string. TruncPString ensures that the truncated string ends on a single-byte character, or on the last byte of a multi-byte character. destination output: destination Pascal string. source input: source Pascal string. maxLength output: The maximum allowable length of the destination string. */ /*****************************************************************************/ pascal OSErr GetVolumeInfoNoName(ConstStr255Param pathname, short vRefNum, HParmBlkPtr pb); /* ¶ Call PBHGetVInfoSync ignoring returned name. GetVolumeInfoNoName uses pathname and vRefNum to call PBHGetVInfoSync in cases where the returned volume name is not needed by the caller. The pathname and vRefNum parameters are not touched, and the pb parameter is initialized by PBHGetVInfoSync except that ioNamePtr in the parameter block is always returned as NULL (since it might point to GetVolumeInfoNoName's local variable tempPathname). I noticed using this code in several places, so here it is once. This reduces the code size of MoreFiles. pathName input: Pointer to a full pathname or nil. If you pass in a partial pathname, it is ignored. A full pathname to a volume must end with a colon character (:). vRefNum input: Volume specification (volume reference number, working directory number, drive number, or 0). pb input: A pointer to HParamBlockRec. output: The parameter block as filled in by PBHGetVInfoSync except that ioNamePtr will always be NULL. Result Codes noErr 0 No error nsvErr -35 No such volume paramErr -50 No default volume, or pb was NULL */ /*****************************************************************************/ pascal OSErr GetCatInfoNoName(short vRefNum, long dirID, ConstStr255Param name, CInfoPBPtr pb); /* ¶ Call PBGetCatInfoSync ignoring returned name. GetCatInfoNoName uses vRefNum, dirID and name to call PBGetCatInfoSync in cases where the returned object is not needed by the caller. The vRefNum, dirID and name parameters are not touched, and the pb parameter is initialized by PBGetCatInfoSync except that ioNamePtr in the parameter block is always returned as NULL (since it might point to GetCatInfoNoName's local variable tempName). I noticed using this code in several places, so here it is once. This reduces the code size of MoreFiles. vRefNum input: Volume specification. dirID input: Directory ID. name input: Pointer to object name, or nil when dirID specifies a directory that's the object. pb input: A pointer to CInfoPBRec. output: The parameter block as filled in by PBGetCatInfoSync except that ioNamePtr will always be NULL. Result Codes noErr 0 No error nsvErr -35 No such volume ioErr -36 I/O error bdNamErr -37 Bad filename fnfErr -43 File not found paramErr -50 No default volume dirNFErr -120 Directory not found or incomplete pathname afpAccessDenied -5000 User does not have the correct access afpObjectTypeErr -5025 Directory not found or incomplete pathname */ /*****************************************************************************/ pascal OSErr DetermineVRefNum(ConstStr255Param pathname, short vRefNum, short *realVRefNum); /* ¶ Determine the real volume reference number. The DetermineVRefNum function determines the volume reference number of a volume from a pathname, a volume specification, or a combination of the two. WARNING: Volume names on the Macintosh are *not* unique -- Multiple mounted volumes can have the same name. For this reason, the use of a volume name or full pathname to identify a specific volume may not produce the results you expect. If more than one volume has the same name and a volume name or full pathname is used, the File Manager currently uses the first volume it finds with a matching name in the volume queue. pathName input: Pointer to a full pathname or nil. If you pass in a partial pathname, it is ignored. A full pathname to a volume must end with a colon character (:). vRefNum input: Volume specification (volume reference number, working directory number, drive number, or 0). realVRefNum output: The real volume reference number. Result Codes noErr 0 No error nsvErr -35 No such volume paramErr -50 No default volume */ /*****************************************************************************/ #if OLDROUTINENAMES #define GetDirID(vRefNum, dirID, name, theDirID, isDirectory) \ GetDirectoryID(vRefNum, dirID, name, theDirID, isDirectory) #endif pascal OSErr GetDirectoryID(short vRefNum, long dirID, ConstStr255Param name, long *theDirID, Boolean *isDirectory); /* ¶ Get the directory ID number of the directory specified. The GetDirectoryID function gets the directory ID number of the directory specified. If a file is specified, then the parent directory of the file is returned and isDirectory is false. If a directory is specified, then that directory's ID number is returned and isDirectory is true. WARNING: Volume names on the Macintosh are *not* unique -- Multiple mounted volumes can have the same name. For this reason, the use of a volume name or full pathname to identify a specific volume may not produce the results you expect. If more than one volume has the same name and a volume name or full pathname is used, the File Manager currently uses the first volume it finds with a matching name in the volume queue. vRefNum input: Volume specification. dirID input: Directory ID. name input: Pointer to object name, or nil when dirID specifies a directory that's the object. theDirID output: If the object is a file, then its parent directory ID. If the object is a directory, then its ID. isDirectory output: True if object is a directory; false if object is a file. Result Codes noErr 0 No error nsvErr -35 No such volume ioErr -36 I/O error bdNamErr -37 Bad filename fnfErr -43 File not found paramErr -50 No default volume dirNFErr -120 Directory not found or incomplete pathname afpAccessDenied -5000 User does not have the correct access afpObjectTypeErr -5025 Directory not found or incomplete pathname */ /*****************************************************************************/ pascal OSErr GetDirItems(short vRefNum, long dirID, ConstStr255Param name, Boolean getFiles, Boolean getDirectories, FSSpecPtr items, short reqItemCount, short *actItemCount, short *itemIndex); /* ¶ Return a list of items in a directory. The GetDirItems function returns a list of items in the specified directory in an array of FSSpec records. File, subdirectories, or both can be returned in the list. A noErr result indicates that the items array was filled (actItemCount == reqItemCount) and there may be additional items left in the directory. A fnfErr result indicates that the end of the directory list was found and actItemCount items were actually found this time. vRefNum input: Volume specification. dirID input: Directory ID. name input: Pointer to object name, or nil when dirID specifies a directory that's the object. getFiles input: Pass true to have files added to the items list. getDirectories input: Pass true to have directories added to the items list. items input: Pointer to array of FSSpec where the item list is returned. reqItemCount input: Maximum number of items to return (the number of elements in the items array). actItemCount output: The number of items actually returned. itemIndex input: The current item index position. Set to 1 to start with the first item in the directory. output: The item index position to get the next item. Pass this value the next time you call GetDirItems to start where you left off. Result Codes noErr 0 No error, but there are more items to list nsvErr -35 No such volume ioErr -36 I/O error bdNamErr -37 Bad filename fnfErr -43 File not found, there are no more items to be listed. paramErr -50 No default volume or itemIndex was <= 0 dirNFErr -120 Directory not found or incomplete pathname afpAccessDenied -5000 User does not have the correct access afpObjectTypeErr -5025 Directory not found or incomplete pathname */ /*****************************************************************************/ #ifdef __cplusplus } #endif #include "OptimizationEnd.h" #endif /* __MOREFILESEXTRAS__ */ hugs98-plus-Sep2006/src/machugs/Optimization.h0000644006511100651110000000567407242472532020063 0ustar rossross/* ** Apple Macintosh Developer Technical Support ** ** DirectoryCopy: #defines that let you make MoreFiles code more efficient. ** ** by Jim Luther, Apple Developer Technical Support Emeritus ** ** File: Optimization.h ** ** Copyright © 1992-1998 Apple Computer, Inc. ** All rights reserved. ** ** You may incorporate this sample code into your applications without ** restriction, though the sample code has been provided "AS IS" and the ** responsibility for its operation is 100% yours. However, what you are ** not permitted to do is to redistribute the source as "DSC Sample Code" ** after having made changes. If you're going to re-distribute the source, ** we require that you make it clear in the source that the code was ** descended from Apple Sample Code, but that you've made changes. ** ** The Optimization changes to MoreFiles source and header files, along with ** this file and OptimizationEnd.h, let you optimize the code produced ** by MoreFiles in several ways. ** ** 1 -- MoreFiles contains extra code so that many routines can run under ** Mac OS systems back to System 6. If your program requires a specific ** version of Mac OS and your program checks for that version before ** calling MoreFiles routines, then you can remove a lot of compatibility ** code by defining one of the following to 1: ** ** __MACOSSEVENFIVEONEORLATER // assume Mac OS 7.5.1 or later ** __MACOSSEVENFIVEORLATER // assume Mac OS 7.5 or later ** __MACOSSEVENORLATER // assume Mac OS 7.0 or later ** ** By default, all compatibility code is ON. ** ** 2 -- You may disable Pascal calling conventions in all MoreFiles routines ** except for system callbacks that require Pascal calling conventions. ** This will make C programs both smaller and faster. ** Just define __WANTPASCALELIMINATION to be 1 to turn this optimization on ** when building MoreFiles for use from C programs (you'll need to keep ** Pascal calling conventions when linking MoreFiles routines with Pascal ** programs). ** ** 3 -- If Metrowerks compiler is used, "#pragma internal on" may help produce ** better code. However, this option can also cause problems if you're ** trying to build MoreFiles as a shared library, so it is by default not used. ** Just define __USEPRAGMAINTERNAL to be 1 to turn this optimization on. ** ** Original changes supplied by Fabrizio Oddone ** ** File: Optimization.h */ #ifndef __MACOSSEVENFIVEONEORLATER #define __MACOSSEVENFIVEONEORLATER 1 #endif #ifndef __MACOSSEVENFIVEORLATER #define __MACOSSEVENFIVEORLATER __MACOSSEVENFIVEONEORLATER #endif #ifndef __MACOSSEVENORLATER #if GENERATINGCFM #define __MACOSSEVENORLATER 1 #else #define __MACOSSEVENORLATER __MACOSSEVENFIVEORLATER #endif #endif #ifndef __WANTPASCALELIMINATION #define __WANTPASCALELIMINATION 1 #endif #if __WANTPASCALELIMINATION #define pascal #endif #ifndef __USEPRAGMAINTERNAL #define __USEPRAGMAINTERNAL 0 #endif #if __USEPRAGMAINTERNAL #if defined(__MWERKS__) #pragma internal on #endif #endif hugs98-plus-Sep2006/src/machugs/OptimizationEnd.h0000644006511100651110000000230407242472532020475 0ustar rossross/* ** Apple Macintosh Developer Technical Support ** ** DirectoryCopy: #defines that let you make MoreFiles code more efficient. ** ** by Jim Luther, Apple Developer Technical Support Emeritus ** ** File: OptimizationEnd.h ** ** Copyright © 1992-1998 Apple Computer, Inc. ** All rights reserved. ** ** You may incorporate this sample code into your applications without ** restriction, though the sample code has been provided "AS IS" and the ** responsibility for its operation is 100% yours. However, what you are ** not permitted to do is to redistribute the source as "DSC Sample Code" ** after having made changes. If you're going to re-distribute the source, ** we require that you make it clear in the source that the code was ** descended from Apple Sample Code, but that you've made changes. ** ** The Optimization changes to MoreFiles source and header files, along with ** this file and Optimization.h, let you optimize the code produced by MoreFiles ** in several ways. ** ** Original changes supplied by Fabrizio Oddone */ #if __USEPRAGMAINTERNAL #if defined(__MWERKS__) #pragma internal reset #endif #endif #if __WANTPASCALELIMINATION #ifndef __COMPILINGMOREFILES #undef pascal #endif #endif hugs98-plus-Sep2006/src/machugs/config.h0000644006511100651110000002146110010230644016611 0ustar rossross/* src/mac/config.h. * Generated manually from src/config.h.in by Hans Aberg and Pablo Azero for * MacOS/Metrowerks CodeWarrior Pro C. */ /* Define if using alloca.c. */ #undef C_ALLOCA /* Define to empty if the keyword does not work. */ #undef const /* Define to one of _getb67, GETB67, getb67 for Cray-2 and Cray-YMP systems. This function is required for alloca.c support on those systems. */ #undef CRAY_STACKSEG_END /* Define if you have alloca, as a function or macro. */ #undef HAVE_ALLOCA /* Define if you have and it should be used (not on Ultrix). */ #define HAVE_ALLOCA_H 1 /* Define if you have that is POSIX.1 compatible. */ #undef HAVE_SYS_WAIT_H /* Define as the return type of signal handlers (int or void). */ #define RETSIGTYPE void /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ #undef STACK_DIRECTION /* Define if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define if you can safely include both and . */ #undef TIME_WITH_SYS_TIME /* Define if your declares struct tm. */ #undef TM_IN_SYS_TIME /* The following symbols are defined in options.h: * * BYTECODE_PRIMS * CHECK_TAGS * DEBUG_CODE * DEBUG_PRINTER * DONT_PANIC * GIMME_STACK_DUMPS * HUGSDIR * HUGSPATH * HUGSSUFFIXES * HUGS_FOR_WINDOWS * HUGS_VERSION * INTERNAL_PRIMS * LARGE_HUGS * PATH_CANONICALIZATION * PROFILING * REGULAR_HUGS * SMALL_BANNER * SMALL_HUGS * USE_PREPROCESSOR * USE_READLINE * WANT_TIMER */ /* Define if you have malloc.h and it defines _alloca - eg for Visual C++. */ #define HAVE__ALLOCA 0 /* Define if you have /bin/sh */ #define HAVE_BIN_SH 0 /* Define if you have the GetModuleFileName function. */ #define HAVE_GETMODULEFILENAME 0 /* Define if heap profiler can (and should) automatically invoke hp2ps * to convert heap profile (in "profile.hp") to postscript. */ #define HAVE_HP2PS HEAP_PROFILER_HUGS /* Define if compiler supports gcc's "labels as values" (aka computed goto) * feature (which is used to speed up instruction dispatch in the interpreter). * Here's what typical code looks like: * * void *label[] = { &&l1, &&l2 }; * ... * goto *label[i]; * l1: ... * l2: ... * ... */ #define HAVE_LABELS_AS_VALUES 0 /* Define if compiler supports prototypes. */ #define PROTOTYPES 1 /* Define if you have the WinExec function. */ #define HAVE_WINEXEC 0 /* Define if jmpbufs can be treated like arrays. * That is, if the following code compiles ok: * * #include * * int test1() { * jmp_buf jb[1]; * jmp_buf *jbp = jb; * return (setjmp(jb[0]) == 0); * } */ #define JMPBUF_ARRAY 0 /* Define if your C compiler inserts underscores before symbol names */ #undef LEADING_UNDERSCORE /* Define if signal handlers have type void (*)(int) * (Otherwise, they're assumed to have type int (*)(void).) */ #define VOID_INT_SIGNALS 1 /* The number of bytes in a double. */ #define SIZEOF_DOUBLE 8 /* The number of bytes in a float. */ #define SIZEOF_FLOAT 4 /* The number of bytes in a int. */ #define SIZEOF_INT 4 /* The number of bytes in a int*. */ #define SIZEOF_INTP 4 /* Define if you have the _fullpath function. */ #undef HAVE__FULLPATH /* Define if you have the _pclose function. */ #undef HAVE__PCLOSE /* Define if you have the _popen function. */ #undef HAVE__POPEN /* Define if you have the _snprintf function. */ #undef HAVE__SNPRINTF /* Define if you have the _stricmp function. */ #undef HAVE__STRICMP /* Define if you have the _vsnprintf function. */ #undef HAVE__VSNPRINTF /* Define if you have the farcalloc function. */ #undef HAVE_FARCALLOC /* Define if you have the fgetpos function. */ #define HAVE_FGETPOS 1 /* Define if you have the fseek function. */ #define HAVE_FSEEK 1 /* Define if you have the fsetpos function. */ #define HAVE_FSETPOS 1 /* Define if you have the ftell function. */ #define HAVE_FTELL 1 /* Define if you have the Macintosh getinfo function. */ #define HAVE_GETFINFO 1 /* Define if you have the macsystem function. */ #undef HAVE_MACSYSTEM /* Define if you have the pclose function. */ #undef HAVE_PCLOSE /* Define if you have the poly function. */ #undef HAVE_POLY /* Define if you have the popen function. */ #undef HAVE_POPEN /* Define if you have the realpath function. */ #undef HAVE_REALPATH /* Define if you have the sigprocmask function. */ #undef HAVE_SIGPROCMASK /* Define if you have the snprintf function. */ #define HAVE_SNPRINTF 1 /* Define if you have the stime function. */ #undef HAVE_STIME /* Define if you have the strcasecmp function. */ #undef HAVE_STRCASECMP /* Define if you have the strcmp function. */ #define HAVE_STRCMP 1 /* Define if you have the strcmpi function. */ #undef HAVE_STRCMPI /* Define if you have the stricmp function. */ #undef HAVE_STRICMP /* Define if you have the valloc function. */ #undef HAVE_VALLOC /* Define if you have the vsnprintf function. */ #define HAVE_VSNPRINTF 1 /* Define if you have the header file. */ #define HAVE_FILES_H 1 /* Define if you have the header file. */ #define HAVE_ASSERT_H 1 /* Define if you have the header file. */ #undef HAVE_CONIO_H /* Define if you have the header file. */ #define HAVE_CONSOLE_H /* Define if you have the header file. */ #define HAVE_CTYPE_H 1 /* Define if you have the header file. */ #undef HAVE_DL_H /* Define if you have the header file. */ #undef HAVE_DLFCN_H /* Define if you have the header file. */ #undef HAVE_DOS_H /* Define if you have the header file. */ #define HAVE_ERRNO_H 1 /* Define if you have the header file. */ #define HAVE_FCNTL_H 1 /* Define if you have the header file. */ #define HAVE_FLOAT_H 1 /* Define if you have the header file. */ #undef HAVE_FTW_H /* Define if you have the header file. */ #undef HAVE_IO_H /* Define if you have the header file. */ #undef HAVE_NLIST_H /* Define if you have the header file. */ #undef HAVE_SGTTY_H /* Define if you have the header file */ #define HAVE_SIOUX_H 1 /* Define if you have the header file */ #define HAVE_SIGNAL_H 1 /* Define if you have the header file. */ #define HAVE_STAT_H 1 /* Define if you have the header file. */ #undef HAVE_STD_H /* Define if you have the header file. */ #define HAVE_STDARG_H 1 /* Define if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define if you have the header file. */ #define HAVE_STRING_H 1 /* Define if you have the header file. */ #undef HAVE_SYS_IOCTL_H /* Define if you have the header file. */ #undef HAVE_SYS_PARAM_H /* Define if you have the header file. */ #undef HAVE_SYS_RESOURCE_H /* Define if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define if you have the header file. */ #undef HAVE_SYS_TIME_H /* Define if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define if you have the header file. */ #undef HAVE_TERMIO_H /* Define if you have the header file. */ #undef HAVE_TERMIOS_H /* Define if you have the header file. */ #define HAVE_TIME_H 1 /* Define if you have the header file. */ #define HAVE_UNISTD_H 1 /* Define if you have the header file. */ #define HAVE_UNIX_H 1 /* Define if you have the header file. */ #undef HAVE_VALUES_H /* Define if you have the header file. */ #undef HAVE_WINDOWS_H /* Define if you have the editline library (-leditline). */ #undef HAVE_LIBEDITLINE /* Define if you have the dl library (-ldl). */ #undef HAVE_LIBDL /* Define if you have the dld library (-ldld). */ #undef HAVE_LIBDLD /* Define to 1 if floating point arithmetic is supported. */ #define FLOATS_SUPPORTED 1 /* Define if you have the editline library (-leditline). */ #undef HAVE_LIBREADLINE /* Define if you want read the preferences from file at startup. */ #define USE_PREFERENCES_FILE 1 /* If you do use a preferences file, define its name. */ #define PREFS_FILE_NAME "Hugs Preferences" /* Define if implementation need to be able to print the preferences to file. */ #define USE_PRINT_PREFERENCES 1 /* Define if banner at startup should not be displayed. */ #undef DO_NOT_USE_BANNER /* The following options are Macintosh specific: HAVE_GETFINFO HAVE_MACSYSTEM HAVE_FILES_H HAVE_CONSOLE_H HAVE_SIOUX_H USE_PREFERENCES_FILE PREFS_FILE_NAME USE_PRINT_PREFERENCES */ hugs98-plus-Sep2006/src/machugs/hugs.mcp.xml0000644006511100651110000021433407242475443017471 0ustar rossross ]> Hugs 98 UserSourceTrees CustomColor1 Red0 Green32767 Blue0 CustomColor2 Red0 Green32767 Blue0 CustomColor3 Red0 Green32767 Blue0 CustomColor4 Red0 Green32767 Blue0 AlwaysSearchUserPathsfalse InterpretDOSAndUnixPathstrue UserSearchPaths SearchPath Path: PathFormatMacOS PathRootProject Recursivetrue HostFlagsAll SearchPath Path:: PathFormatMacOS PathRootProject Recursivefalse HostFlagsAll SystemSearchPaths SearchPath Path:MSL: PathFormatMacOS PathRootCodeWarrior Recursivetrue HostFlagsAll SearchPath Path: PathFormatMacOS PathRootCodeWarrior Recursivetrue HostFlagsAll LinkerMacOS PPC Linker PreLinker PostLinker TargetnameHugs 98 OutputDirectory Path::: PathFormatMacOS PathRootProject SaveEntriesUsingRelativePathsfalse FileMappings FileTypeAPPL FileExtension Compiler Precompilefalse Launchabletrue ResourceFiletrue IgnoredByMakefalse FileTypeAppl FileExtension Compiler Precompilefalse Launchabletrue ResourceFiletrue IgnoredByMakefalse FileTypeMMLB FileExtension CompilerLib Import PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeMPLF FileExtension CompilerLib Import PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeMWCD FileExtension Compiler Precompilefalse Launchabletrue ResourceFiletrue IgnoredByMakefalse FileTypeRSRC FileExtension Compiler Precompilefalse Launchabletrue ResourceFiletrue IgnoredByMakefalse FileTypeTEXT FileExtension.bh CompilerBalloon Help Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.c CompilerMW C/C++ PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.c++ CompilerMW C/C++ PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.cc CompilerMW C/C++ PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.cp CompilerMW C/C++ PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.cpp CompilerMW C/C++ PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.exp Compiler Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.h CompilerMW C/C++ PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMaketrue FileTypeTEXT FileExtension.l CompilerBSD Flex/Lex PPC Precompiletrue Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.p CompilerMW Pascal PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.pas CompilerMW Pascal PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.pch CompilerMW C/C++ PPC Precompiletrue Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.pch++ CompilerMW C/C++ PPC Precompiletrue Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.ppu CompilerMW Pascal PPC Precompiletrue Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.r CompilerRez Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.s CompilerPPCAsm Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeTEXT FileExtension.y CompilerBison Preprocessor Precompiletrue Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypeXCOF FileExtension CompilerXCOFF Import PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypedocu FileExtension Compiler Precompilefalse Launchabletrue ResourceFiletrue IgnoredByMakefalse FileTypersrc FileExtension Compiler Precompilefalse Launchabletrue ResourceFiletrue IgnoredByMakefalse FileTypeshlb FileExtension CompilerPEF Import PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileTypestub FileExtension CompilerPEF Import PPC Precompilefalse Launchablefalse ResourceFilefalse IgnoredByMakefalse FileExtension.doc Compiler Precompilefalse Launchabletrue ResourceFilefalse IgnoredByMaketrue CacheModDatestrue ActivateBrowsertrue DumpBrowserInfotrue CacheSubprojectstrue UseThirdPartyDebuggerfalse DebuggerCommandLine Debugger Runtime 0002000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000051C5BC01000000000000100051C64D0 000200000000000000000000051C536000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000 LogSystemMessagestrue AutoTargetDLLsfalse StopAtWatchpointstrue PauseWhileRunningfalse PauseInterval5 PauseUIFlags0 AltExePath Path PathFormatGeneric PathRootAbsolute Bison Panel 0002000000000000000000000000000000000000000000000000000000000000 00000000000000000000 Flex Panel 000300000000000100000300 MWCodeGen_68K_codesizeSmall MWCodeGen_68K_structalignmentMC68K MWCodeGen_68K_fp_modeSANE MWCodeGen_68K_code680200 MWCodeGen_68K_profiler0 MWCodeGen_68K_mpwc0 MWCodeGen_68K_fourbyteints0 MWCodeGen_68K_IEEEdoubles0 MWCodeGen_68K_fardata0 MWCodeGen_68K_farvtables0 MWCodeGen_68K_farstrings0 MWCodeGen_68K_pcrelstrings0 MWCodeGen_68K_macsbugNew MWCodeGen_68K_a6frames1 MWDisassembler_68K_showcode1 MWDisassembler_68K_mix0 MWDisassembler_68K_nohex0 MWDisassembler_68K_showdata1 MWDisassembler_68K_showexceptions1 MWDisassembler_68K_showsym0 MWDisassembler_68K_shownames1 GlobalOptimizer_68K_optimizationlevelLevel1 GlobalOptimizer_68K_optforSpeed MWLinker_68K_linksym1 MWLinker_68K_symfullpath1 MWLinker_68K_linksingle0 MWLinker_68K_fastlink1 MWLinker_68K_generateMap0 MWLinker_68K_nolinkwarnings0 MWLinker_68K_glueintosegone1 MWLinker_68K_dontdeadstripinitcode0 MWProject_68K_typeApplication MWProject_68K_outfilea.out MWProject_68K_symfilename MWProject_68K_filecreator1061109567 MWProject_68K_filetype1095782476 MWProject_68K_size384 MWProject_68K_flags22656 MWProject_68K_rsrcheaderStandard MWProject_68K_rsrcname MWProject_68K_rsrctype1061109567 MWProject_68K_rsrcid0 MWProject_68K_rsrcmulti0 MWProject_68K_rsrcstore0 MWProject_68K_rsrcmerge0 MWProject_68K_rsrcflags0 MWProject_68K_a40 MWProject_68K_minsize384 MWProject_68K_rsrcsegtype0 MWProject_68K_cfm68kcodegen0 MWProject_68K_stacksize0 MWProject_68K_thedebugger0 MWProject_68K_rsrc_custom0 MWProject_68K_is_rseg_app0 MWProject_68K_is_pilot_lib0 MWProject_68K_pilot_main_entry MWFrontEnd_C_cplusplus0 MWFrontEnd_C_checkprotos1 MWFrontEnd_C_arm0 MWFrontEnd_C_trigraphs0 MWFrontEnd_C_onlystdkeywords0 MWFrontEnd_C_enumsalwaysint0 MWFrontEnd_C_mpwpointerstyle0 MWFrontEnd_C_prefixname MWFrontEnd_C_ansistrict0 MWFrontEnd_C_mpwcnewline0 MWFrontEnd_C_wchar_type1 MWFrontEnd_C_enableexceptions0 MWFrontEnd_C_dontreusestrings0 MWFrontEnd_C_poolstrings0 MWFrontEnd_C_dontinline0 MWFrontEnd_C_useRTTI0 MWFrontEnd_C_multibyteaware0 MWFrontEnd_C_unsignedchars0 MWFrontEnd_C_autoinline0 MWFrontEnd_C_booltruefalse1 MWFrontEnd_C_direct_to_som0 MWFrontEnd_C_som_env_check0 MWFrontEnd_C_alwaysinline0 MWFrontEnd_C_inlinelevel0 MWFrontEnd_C_ecplusplus0 MWFrontEnd_C_objective_c0 MWFrontEnd_C_defer_codegen0 MWWarning_C_warn_illpragma0 MWWarning_C_warn_emptydecl0 MWWarning_C_warn_possunwant0 MWWarning_C_warn_unusedvar0 MWWarning_C_warn_unusedarg0 MWWarning_C_warn_extracomma0 MWWarning_C_pedantic0 MWWarning_C_warningerrors0 MWWarning_C_warn_hidevirtual0 MWWarning_C_warn_implicitconv0 MWWarning_C_warn_notinlined0 MWWarning_C_warn_structclass0 MWCFM68K_exportsNone MWCFM68K_olddefversion0 MWCFM68K_oldimpversion0 MWCFM68K_currentversion0 MWCFM68K_farthreshold256 PCFM68K_sharedata0 MWCFM68K_fragmentname MWCFM68K_initname MWCFM68K_mainname__start MWCFM68K_termname MWCFM68K_libfolder0 MWCFM68K_alignmentAlign_2 MWMerge_MacOS_projectTypeApplication MWMerge_MacOS_outputNameMerge Out MWMerge_MacOS_outputCreator1061109567 MWMerge_MacOS_outputType1095782476 MWMerge_MacOS_suppressWarning0 MWMerge_MacOS_copyFragments1 MWMerge_MacOS_copyResources1 MWMerge_MacOS_skipResources ×÷ƒ xI ­ MWCodeGen_PPC_structalignmentPPC MWCodeGen_PPC_tracebacktablesInline MWCodeGen_PPC_processorGeneric MWCodeGen_PPC_readonlystrings0 MWCodeGen_PPC_tocdata1 MWCodeGen_PPC_profiler0 MWCodeGen_PPC_fpcontract1 MWCodeGen_PPC_schedule0 MWCodeGen_PPC_peephole0 MWCodeGen_PPC_processorspecific0 MWCodeGen_PPC_altivec0 MWCodeGen_PPC_vectortocdata1 MWCodeGen_PPC_vrsave1 MWCodeGen_PPC_autovectorize0 MWCodeGen_PPC_usebuiltins0 MWDisassembler_PPC_showcode1 MWDisassembler_PPC_extended1 MWDisassembler_PPC_mix0 MWDisassembler_PPC_nohex0 MWDisassembler_PPC_showdata1 MWDisassembler_PPC_showexceptions1 MWDisassembler_PPC_showsym0 MWDisassembler_PPC_shownames1 GlobalOptimizer_PPC_optimizationlevelLevel0 GlobalOptimizer_PPC_optforSpeed MWLinker_PPC_linksym1 MWLinker_PPC_symfullpath1 MWLinker_PPC_linkmap1 MWLinker_PPC_nolinkwarnings1 MWLinker_PPC_dontdeadstripinitcode0 MWLinker_PPC_permitmultdefs0 MWLinker_PPC_linkmodeFast MWLinker_PPC_initname MWLinker_PPC_mainname__start MWLinker_PPC_termname MWPEF_exportsNone MWPEF_libfolder0 MWPEF_sortcodeNone MWPEF_expandbss0 MWPEF_sharedata0 MWPEF_olddefversion0 MWPEF_oldimpversion0 MWPEF_currentversion0 MWPEF_fragmentname MWPEF_collapsereloads0 MWProject_PPC_typeApplication MWProject_PPC_outfileHugs 98 MWProject_PPC_filecreator1215653747 MWProject_PPC_filetype1095782476 MWProject_PPC_size12000 MWProject_PPC_minsize6000 MWProject_PPC_stacksize256 MWProject_PPC_flags22752 MWProject_PPC_symfilename MWProject_PPC_rsrcname MWProject_PPC_rsrcheaderNative MWProject_PPC_rsrctype1061109567 MWProject_PPC_rsrcid0 MWProject_PPC_rsrcflags0 MWProject_PPC_rsrcstore0 MWProject_PPC_rsrcmerge0 MWAssembler_PPC_auxheader0 MWAssembler_PPC_symmodeMac MWAssembler_PPC_dialectPPC MWAssembler_PPC_prefixfile MWAssembler_PPC_typecheck0 MWAssembler_PPC_warnings0 MWAssembler_PPC_casesensitive0 MWRez_Language_maxwidth80 MWRez_Language_scriptRoman MWRez_Language_alignmentAlign1 MWRez_Language_filtermodeFilterSkip MWRez_Language_suppresswarnings0 MWRez_Language_escapecontrolchars1 MWRez_Language_prefixname MWRez_Language_filteredtypes'CODE' 'DATA' 'PICT' MWWinRC_prefixname MWCodeGen_X86_processorGeneric MWCodeGen_X86_alignmentbytes8 MWCodeGen_X86_exceptionsZeroOverhead MWCodeGen_X86_extinst_mmx0 MWCodeGen_X86_extinst_3dnow0 MWCodeGen_X86_use_mmx_3dnow_convention0 MWCodeGen_X86_machinecodelisting0 MWCodeGen_X86_intrinsics0 MWCodeGen_X86_syminfo0 MWCodeGen_X86_codeviewinfo1 MWDebugger_X86_Exceptions 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 GlobalOptimizer_X86_optimizationlevelLevel1 GlobalOptimizer_X86_optforSpeed MWLinker_X86_entrypointusageDefault MWLinker_X86_entrypoint MWLinker_X86_subsystemWinGUI MWLinker_X86_subsysmajorid4 MWLinker_X86_subsysminorid0 MWLinker_X86_usrmajorid0 MWLinker_X86_usrminorid0 MWLinker_X86_commandfile MWLinker_X86_generatemap0 MWLinker_X86_linksym0 MWLinker_X86_linkCV1 MWProject_X86_typeApplication MWProject_X86_outfileNONAME.EXE MWProject_X86_baseaddress4194304 MWProject_X86_maxstacksize1024 MWProject_X86_minstacksize4 MWProject_X86_size1024 MWProject_X86_minsize4 MWProject_X86_importlib Name MSL C++.PPC.Lib MacOS Library Name MSL C.PPC.Lib MacOS Library Name InterfaceLib MacOS Library Name MathLib MacOS Library Name MSL SIOUX.PPC.Lib MacOS Library Name MSL RuntimePPC.Lib MacOS Library Debug Name MSL AppRuntime.Lib MacOS Library Debug Name builtin.c MacOS Text Debug Name compiler.c MacOS Text Debug Name hugs.c MacOS Text Debug Name input.c MacOS Text Debug Name machine.c MacOS Text Debug Name output.c MacOS Text Debug Name parser.y MacOS Text Debug Name static.c MacOS Text Debug Name storage.c MacOS Text Debug Name type.c MacOS Text Debug Name PLStringFuncsPPC.lib MacOS Library Debug Name subst.c MacOS Text Debug Name plugin.c MacOS Text Debug Name ffi.c MacOS Text Debug Name MoreFilesExtras.c MacOS Text Debug Name hugs.r MacOS Text Debug Name MSL C++.PPC.Lib MacOS Name MSL C.PPC.Lib MacOS Name InterfaceLib MacOS Name MathLib MacOS Name MSL SIOUX.PPC.Lib MacOS Name MSL RuntimePPC.Lib MacOS Name MSL AppRuntime.Lib MacOS Name builtin.c MacOS Name compiler.c MacOS Name hugs.c MacOS Name input.c MacOS Name machine.c MacOS Name output.c MacOS Name parser.y MacOS Name static.c MacOS Name storage.c MacOS Name type.c MacOS Name PLStringFuncsPPC.lib MacOS Name subst.c MacOS Name plugin.c MacOS Name ffi.c MacOS Name MoreFilesExtras.c MacOS Name hugs.r MacOS Hugs 98 Sources Hugs 98 Name builtin.c MacOS Hugs 98 Name compiler.c MacOS Hugs 98 Name ffi.c MacOS Hugs 98 Name hugs.c MacOS Hugs 98 Name input.c MacOS Hugs 98 Name machine.c MacOS Hugs 98 Name output.c MacOS Hugs 98 Name parser.y MacOS Hugs 98 Name static.c MacOS Hugs 98 Name storage.c MacOS Hugs 98 Name plugin.c MacOS Hugs 98 Name subst.c MacOS Hugs 98 Name type.c MacOS Mac specific Hugs 98 Name hugs.r MacOS Hugs 98 Name MoreFilesExtras.c MacOS ANSI Libraries Hugs 98 Name MSL C.PPC.Lib MacOS Hugs 98 Name MSL C++.PPC.Lib MacOS Hugs 98 Name MSL SIOUX.PPC.Lib MacOS Mac Libraries Hugs 98 Name InterfaceLib MacOS Hugs 98 Name MathLib MacOS Hugs 98 Name MSL RuntimePPC.Lib MacOS Hugs 98 Name MSL AppRuntime.Lib MacOS Hugs 98 Name PLStringFuncsPPC.lib MacOS hugs98-plus-Sep2006/src/machugs/hugs.r0000644006511100651110000011636507406035331016347 0ustar rossrossdata 'BNDL' (128) { $"4875 6773 0000 0001 4652 4546 0001 0000" /* Hugs....FREF.... */ $"0080 0001 0081 4943 4E23 0001 0000 0080" $"0001 0081" }; data 'BNDL' (130) { $"4875 6748 0000 0001 4652 4546 0001 0000" /* HugH....FREF.... */ $"0084 0001 0085 4943 4E23 0001 0000 0085" $"0001 0081" }; data 'BNDL' (129) { $"4875 6742 0000 0001 4652 4546 0001 0000" /* HugB....FREF.... */ $"008B 0001 008C 4943 4E23 0001 0000 0083" $"0001 0081" }; data 'FREF' (128, "APPL") { $"4150 504C 0000 00" /* APPL... */ }; data 'FREF' (129, "TEXT") { $"5445 5854 0001 00" /* TEXT... */ }; data 'FREF' (130) { $"4150 504C 0000 00" /* APPL... */ }; data 'FREF' (131) { $"5445 5854 0001 00" /* TEXT... */ }; data 'FREF' (132) { $"4150 504C 0000 00" /* APPL... */ }; data 'FREF' (133) { $"5445 5854 0001 00" /* TEXT... */ }; data 'FREF' (134) { $"4150 504C 0000 00" /* APPL... */ }; data 'FREF' (135) { $"5445 5854 0001 00" /* TEXT... */ }; data 'FREF' (136) { $"4150 504C 0000 00" /* APPL... */ }; data 'FREF' (137) { $"5445 5854 0001 00" /* TEXT... */ }; data 'FREF' (138) { $"4150 504C 0000 00" /* APPL... */ }; data 'FREF' (139) { $"4150 504C 0000 00" /* APPL... */ }; data 'FREF' (140) { $"5445 5854 0001 00" /* TEXT... */ }; data 'ICN#' (128) { $"0000 0000 0000 0000 0000 0000 0FFF FFFE" $"3FFF FFFE 3FFF FFFE 7F1F 1FFE 7E0E 0FFE" $"7E0E 0FFE 7E0E 0FFE 7F1F 1FFE 7FFF FFFE" $"71F1 FFFE 60E0 FFFE 60E0 FFFE 60E0 FFFE" $"71F1 FFFE 7FFF FFFE 7FFF FFFE 7FFF FFFE" $"7FEF FFFE 7FEF FFFE 7FEB 6C62 7FE5 6B5E" $"7FED 6B66 7FED 6C7A 7FED 9F46 7FFF FB7E" $"7FFF FCFE 7FFF FFFE 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0FFF FFFE" $"3FFF FFFE 3FFF FFFE 7F1F 1FFE 7E0E 0FFE" $"7E0E 0FFE 7E0E 0FFE 7F1F 1FFE 7FFF FFFE" $"71F1 FFFE 60E0 FFFE 60E0 FFFE 60E0 FFFE" $"71F1 FFFE 7FFF FFFE 7FFF FFFE 7FFF FFFE" $"7FEF FFFE 7FEF FFFE 7FEB 6C62 7FE5 6B5E" $"7FED 6B66 7FED 6C7A 7FED 9F46 7FFF FB7E" $"7FFF FCFE 7FFF FFFE 0000 0000 0000 0000" }; data 'ICN#' (129) { $"1FFF FC00 1FFF FE00 1FFF FD00 1FFF FC80" $"1FC7 1C40 1F82 0C20 1F82 0FF0 1F82 0FF0" $"1FC7 1FF0 1FFF FFF0 1C71 FFF0 1820 FFF0" $"1820 FFF0 1820 FFF0 1C71 FFF0 1FFF FFF0" $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1DFF FFF0" $"1DFF FFF0 1D6D 8C70 1CAD 6BF0 1DAD 6CF0" $"1DAD 8F70 1DB3 E8F0 1FFF 6FF0 1FFF 9FF0" $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0" $"1FFF FC00 1FFF FE00 1FFF FF00 1FFF FF80" $"1FC7 1FC0 1F82 0FE0 1F82 0FF0 1F82 0FF0" $"1FC7 1FF0 1FFF FFF0 1C71 FFF0 1820 FFF0" $"1820 FFF0 1820 FFF0 1C71 FFF0 1FFF FFF0" $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1DFF FFF0" $"1DFF FFF0 1D6D 8C70 1CAD 6BF0 1DAD 6CF0" $"1DAD 8F70 1DB3 E8F0 1FFF 6FF0 1FFF 9FF0" $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0" }; data 'ICN#' (130) { $"1FFF FC00 1FFF FE00 1FFF FFFC 1FFF FFFC" $"1FC7 1FFC 1F82 0FFC 1F82 0FFC 1F82 0FFC" $"1FC7 1FFC 1FFF FFFC 1C71 FFFC 1820 FFFC" $"1820 FFFC 1820 FFFC 1C71 FFFC 1FFF FFFC" $"1FFF FFFC 1DFF FFFC 1DFF FFFC 1D6D 8C7C" $"1CAD 6BFC 1DAD 6CFC 1DAD 8F7C 1DB3 E8FC" $"1FFF 6FFC 1FFF 9FFC 1FFF FFFC 1FFF FFFC" $"1FFF FFFC 1FFF FFFC 0FFF FFFC 0FFF FFFC" $"1FFF FC00 1FFF FE00 1FFF FFFC 1FFF FFFC" $"1FC7 1FFC 1F82 0FFC 1F82 0FFC 1F82 0FFC" $"1FC7 1FFC 1FFF FFFC 1C71 FFFC 1820 FFFC" $"1820 FFFC 1820 FFFC 1C71 FFFC 1FFF FFFC" $"1FFF FFFC 1DFF FFFC 1DFF FFFC 1D6D 8C7C" $"1CAD 6BFC 1DAD 6CFC 1DAD 8F7C 1DB3 E8FC" $"1FFF 6FFC 1FFF 9FFC 1FFF FFFC 1FFF FFFC" $"1FFF FFFC 1FFF FFFC 0FFF FFFC 0FFF FFFC" }; data 'ICN#' (133) { $"0000 0000 0000 0000 0000 0000 0FFF FFFE" $"3FFF FFFE 3FFF FFFE 7F1F 1FFE 7E0E 0FFE" $"7E0E 0FFE 7E0E 0FFE 7F1F 1FFE 7FFF FFFE" $"71F1 FFFE 60E0 FFFE 60E0 FFFE 60E0 FFFE" $"71F1 FFFE 7FFF FFFE 7FFF FFFE 7FFF FFFE" $"7FEF FFFE 7FEF FFFE 7FEB 6C62 7FE5 6B5E" $"7FED 6B66 7FED 6C7A 7FED 9F46 7FFF FB7E" $"7FFF FCFE 7FFF FFFE 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0FFF FFFE" $"3FFF FFFE 3FFF FFFE 7F1F 1FFE 7E0E 0FFE" $"7E0E 0FFE 7E0E 0FFE 7F1F 1FFE 7FFF FFFE" $"71F1 FFFE 60E0 FFFE 60E0 FFFE 60E0 FFFE" $"71F1 FFFE 7FFF FFFE 7FFF FFFE 7FFF FFFE" $"7FEF FFFE 7FEF FFFE 7FEB 6C62 7FE5 6B5E" $"7FED 6B66 7FED 6C7A 7FED 9F46 7FFF FB7E" $"7FFF FCFE 7FFF FFFE 0000 0000 0000 0000" }; data 'ICN#' (131) { $"0000 0000 0000 0000 0000 0000 0FFF FFFE" $"3FFF FFFE 3FFF FFFE 7F1F 1FFE 7E0E 0FFE" $"7E0E 0FFE 7E0E 0FFE 7F1F 1FFE 7FFF FFFE" $"71F1 FFFE 60E0 FFFE 60E0 FFFE 60E0 FFFE" $"71F1 FFFE 7FFF FFFE 7FFF FFFE 7FFF FFFE" $"7FEF FFFE 7FEF FFFE 7FEB 6C62 7FE5 6B5E" $"7FED 6B66 7FED 6C7A 7FED 9F46 7FFF FB7E" $"7FFF FCFE 7FFF FFFE 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0FFF FFFE" $"3FFF FFFE 3FFF FFFE 7F1F 1FFE 7E0E 0FFE" $"7E0E 0FFE 7E0E 0FFE 7F1F 1FFE 7FFF FFFE" $"71F1 FFFE 60E0 FFFE 60E0 FFFE 60E0 FFFE" $"71F1 FFFE 7FFF FFFE 7FFF FFFE 7FFF FFFE" $"7FEF FFFE 7FEF FFFE 7FEB 6C62 7FE5 6B5E" $"7FED 6B66 7FED 6C7A 7FED 9F46 7FFF FB7E" $"7FFF FCFE 7FFF FFFE 0000 0000 0000 0000" }; data 'icl8' (128) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 002A ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"0000 ECEC ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"002A ECEC ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC 0000 00EC ECEC ECEC" $"0000 00EC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC EC00 0000 0000 ECEC EC00" $"0000 0000 ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC EC00 0000 0000 ECEC EC00" $"0000 0000 ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC EC00 0000 0000 ECEC EC00" $"0000 0000 ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC 0000 00EC ECEC ECEC" $"0000 00EC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC 0000 00EC ECEC ECEC 0000 00EC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC EC00 0000 0000 ECEC EC00 0000 0000" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC EC00 0000 0000 ECEC EC00 0000 0000" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC EC00 0000 0000 ECEC EC00 0000 0000" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC 0000 00EC ECEC ECEC 0000 00EC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC EC00 ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC EC00 ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC EC00 EC00 ECEC" $"00EC EC00 ECEC 0000 00EC EC00 0000 EC00" $"00EC ECEC ECEC ECEC ECEC EC00 00EC 00EC" $"00EC EC00 EC00 ECEC 00EC 00EC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC EC00 ECEC 00EC" $"00EC EC00 EC00 ECEC 00EC EC00 00EC EC00" $"00EC ECEC ECEC ECEC ECEC EC00 ECEC 00EC" $"00EC EC00 ECEC 0000 00EC ECEC EC00 EC00" $"00EC ECEC ECEC ECEC ECEC EC00 ECEC 00EC" $"EC00 00EC ECEC ECEC 00EC 0000 00EC EC00" $"00EC ECEC ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC EC00 ECEC 00EC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC 0000 ECEC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'icl8' (129) { $"0000 00FF FFFF FFFF FFFF FFFF FFFF FFFF" $"FFFF FFFF FFFF 0000 0000 0000 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECFF FF00 0000 0000 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECFF ECFF 0000 0000 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECFF ECEC FF00 0000 0000 0000" $"0000 00FF ECEC ECEC ECEC 0000 00EC ECEC" $"0000 00EC ECFF ECEC ECFF 0000 0000 0000" $"0000 00FF ECEC ECEC EC00 0000 0000 EC00" $"0000 0000 ECFF ECEC ECEC FF00 0000 0000" $"0000 00FF ECEC ECEC EC00 0000 0000 EC00" $"0000 0000 ECFF FFFF FFFF FFFF 0000 0000" $"0000 00FF ECEC ECEC EC00 0000 0000 EC00" $"0000 0000 ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC 0000 00EC ECEC" $"0000 00EC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC 0000 00EC ECEC 0000 00EC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF EC00 0000 0000 EC00 0000 0000" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF EC00 0000 0000 EC00 0000 0000" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF EC00 0000 0000 EC00 0000 0000" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC 0000 00EC ECEC 0000 00EC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC 00EC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC 00EC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC 00EC 00EC EC00 ECEC 00EC" $"EC00 0000 ECEC 0000 00EC ECFF 0000 0000" $"0000 00FF ECEC 0000 EC00 EC00 ECEC 00EC" $"00EC EC00 EC00 ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC 00EC EC00 EC00 ECEC 00EC" $"00EC EC00 ECEC 0000 ECEC ECFF 0000 0000" $"0000 00FF ECEC 00EC EC00 EC00 ECEC 00EC" $"EC00 0000 ECEC ECEC 00EC ECFF 0000 0000" $"0000 00FF ECEC 00EC EC00 ECEC 0000 ECEC" $"ECEC EC00 EC00 0000 ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"00EC EC00 ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"EC00 00EC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF ECEC ECEC ECEC ECEC ECEC ECEC" $"ECEC ECEC ECEC ECEC ECEC ECFF 0000 0000" $"0000 00FF FFFF FFFF FFFF FFFF FFFF FFFF" $"FFFF FFFF FFFF FFFF FFFF FFFF 0000 0000" }; data 'icl8' (130) { $"0000 00FF FFFF FFFF FFFF FFFF FFFF FFFF" $"FFFF FFFF FFFF 0000 0000 0000 0000 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7AFF FF00 0000 0000 0000 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7AFF 7AFF FFFF FFFF FFFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7AFF 7A7A FF7A 7A7A 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 0000 007A 7A7A" $"0000 007A 7AFF 7A7A 7AFF 7A7A 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A00 0000 0000 7A00" $"0000 0000 7AFF 7A7A 7A7A FF7A 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A00 0000 0000 7A00" $"0000 0000 7AFF FFFF FFFF FFFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A00 0000 0000 7A00" $"0000 0000 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 0000 007A 7A7A" $"0000 007A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 0000 007A 7A7A 0000 007A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A00 0000 0000 7A00 0000 0000" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A00 0000 0000 7A00 0000 0000" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A00 0000 0000 7A00 0000 0000" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 0000 007A 7A7A 0000 007A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 007A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 007A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 007A 007A 7A00 7A7A 007A" $"7A00 0000 7A7A 0000 007A 7AFF 7AFF 0000" $"0000 00FF 7A7A 0000 7A00 7A00 7A7A 007A" $"007A 7A00 7A00 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 007A 7A00 7A00 7A7A 007A" $"007A 7A00 7A7A 0000 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 007A 7A00 7A00 7A7A 007A" $"7A00 0000 7A7A 7A7A 007A 7AFF 7AFF 0000" $"0000 00FF 7A7A 007A 7A00 7A7A 0000 7A7A" $"7A7A 7A00 7A00 0000 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"007A 7A00 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A00 007A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 7AFF 0000" $"0000 00FF FFFF FFFF FFFF FFFF FFFF FFFF" $"FFFF FFFF FFFF FFFF FFFF FFFF 7AFF 0000" $"0000 0000 FF7A 7A7A 7A7A 7A7A 7A7A 7A7A" $"7A7A 7A7A 7A7A 7A7A 7A7A 7A7A 7AFF 0000" $"0000 0000 FFFF FFFF FFFF FFFF FFFF FFFF" $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF 0000" }; data 'icl8' (131) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0092 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"0000 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"0092 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 0000 00E3 E3E3 E3E3" $"0000 00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E300 0000 0000 E3E3 E300" $"0000 0000 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E300 0000 0000 E3E3 E300" $"0000 0000 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E300 0000 0000 E3E3 E300" $"0000 0000 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 0000 00E3 E3E3 E3E3" $"0000 00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 0000 00E3 E3E3 E3E3 0000 00E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E300 0000 0000 E3E3 E300 0000 0000" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E300 0000 0000 E3E3 E300 0000 0000" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E300 0000 0000 E3E3 E300 0000 0000" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 0000 00E3 E3E3 E3E3 0000 00E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E300 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E300 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E300 E300 E3E3" $"00E3 E300 E3E3 0000 00E3 E300 0000 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E300 00E3 00E3" $"00E3 E300 E300 E3E3 00E3 00E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E300 E3E3 00E3" $"00E3 E300 E300 E3E3 00E3 E300 00E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E300 E3E3 00E3" $"00E3 E300 E3E3 0000 00E3 E3E3 E300 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E300 E3E3 00E3" $"E300 00E3 E3E3 E3E3 00E3 0000 00E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E300 E3E3 00E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E3E3 0000 E3E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3" $"E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'icl8' (132) { $"0000 0000 0000 0041 3B3B 0000 0000 0000" $"0000 0000 003B 3B41 0000 0000 0000 0000" $"0000 0000 0000 003B 893B 3B00 0000 0000" $"0000 0000 3B3B 893B 0000 0000 0000 0000" $"0000 0000 0000 003B 8989 3B89 3B3B 3B3B" $"3B3B 3B89 3B89 893B 0000 0000 0000 0000" $"0000 0000 0000 0000 3B3B 3B89 893B 3B3B" $"3B3B 8989 3B3B 3B00 0000 0000 0000 0000" $"0000 0000 0000 0000 3B3B 3B3B 893B 3B3B" $"3B3B 893B 3B3B 3B00 0000 0000 0000 0000" $"0000 0000 0000 0000 893B 3B3B 3B3B 3B3B" $"3B3B 3B3B 3B3B 3B00 0000 0000 0000 0000" $"0000 0000 0000 0000 893B 3B3B 3B3B 3B3B" $"3B3B 3B3B 3B3B 8900 0000 0000 0000 0000" $"0000 0000 0000 0089 893B 3B3B 3B3B 3B3B" $"3B3B 3B3B 3B3B 8989 0000 0000 0000 0000" $"0000 0000 0000 003B 893B 3B3B 3B3B 3B3B" $"3B3B 3B3B 3B3B 8916 0000 0000 0000 0000" $"0000 0000 0000 3B3B 3B3B 3B3B 3BFF 3B3B" $"3BFF 3B3B 3B3B 3B16 1000 0000 0000 0000" $"0000 0000 0000 3B3B 3B3B 3B3B 3B3B 3B3B" $"3B3B 3B3B 3B3B 3B16 1000 0000 0000 0000" $"0000 0000 0000 3B3B 3B3B 3B3B 3B3B 3BFF" $"3B3B 3B3B 3B3B 3B16 1000 0000 0000 0000" $"0000 0000 0000 3B3B 3B3B 3B3B 3B3B FFFF" $"FF3B 3B3B 3B3B 3B3B 3B00 0000 0000 0000" $"0000 0000 0000 3B3B 3B3B 3B3B 3B3B 3B3B" $"3B3B 3B3B 3B3B 3B16 1000 0000 0000 0000" $"0000 0000 0000 3B3B 3B3B 3B3B 3B3B 3B3B" $"3B3B 3B3B 3B3B 3B16 1000 0000 0000 0000" $"0000 0000 0000 3B3B 3B3B 3B3B FFFF 3B3B" $"3BFF FF3B 3B3B 3B3B 3B00 0000 0000 0000" $"0000 0000 0000 003B 3B3B 3B3B 3B3B FFFF" $"FF3B 3B3B 3B3B 1610 0000 0000 0000 0000" $"0000 0000 0000 003B 3B3B 3B3B 3B3B F63B" $"F63B 3B3B 3B16 1000 0000 0000 0000 0000" $"0000 0000 0000 0000 3B3B 3B3B 3B3B F63B" $"F63B 3B3B 1616 1000 0000 0000 0000 0000" $"0000 0000 0000 0000 003B 3B3B 3B3B 3B3B" $"3B3B 3B3B 1610 0000 0000 0000 0000 0000" $"00FF FFFF FFFF FFFF FFFF FFFF FFFF FFFF" $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF 0000" $"3BFF 0808 0808 0808 0808 0808 0808 0808" $"0808 0808 0808 0808 0808 0808 08FF 3B00" $"3BFF 0808 0808 0808 0808 0808 0808 0808" $"0808 0808 0808 0808 0808 0808 08FF 3B00" $"3BFF 0808 0808 0808 0808 08B0 0808 B008" $"B0B0 B008 0808 0833 3333 3333 33FC 3B00" $"3BFF 0808 0808 0808 0808 08B0 0808 B008" $"B008 08B0 0808 3308 0808 0808 08FB 3B00" $"00FF FFFF FFFF FFFF 0808 08B0 B0B0 B008" $"B0B0 B008 0833 08FB FBFB FBFB FBFB 0000" $"0000 0000 0000 0000 FF08 08B0 0808 B008" $"B008 0808 0833 FB00 0000 0000 0000 0000" $"0000 0000 0000 0000 FF08 08B0 0808 B008" $"B008 0808 3308 FB00 0000 0000 0000 0000" $"0000 0000 0000 0000 FF08 0808 0808 0808" $"0808 0808 3308 FB00 0000 0000 0000 0000" $"0000 0000 0000 0000 8D8D 8D8D 8D08 0808" $"0808 8D8D 8C85 6000 0000 0000 0000 0000" $"0000 0000 0000 0000 8D8D 8D8D 8D08 0808" $"0808 8D8D 8C85 6000 0000 0000 0000 0000" $"0000 0000 0000 0000 8D8D 8D8D 8D08 0808" $"0808 8D8D 8C85 6000 0000 0000 0000 0000" }; data 'icl8' (133) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0008 1616 1616 1616 1616 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0000 1616 1616 1616 1616 1616 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0008 1616 1616 1616 1616 1616 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1616 0000 0116 1616 1616" $"0000 0016 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1600 0000 0000 1616 1600" $"0000 0000 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1600 0000 0000 1616 1600" $"0000 0000 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1600 0000 0000 1616 1600" $"0000 0000 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1616 0000 0016 1616 1616" $"0000 0016 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1616 1616 1616 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1616 0000 0016 1616 1616 0000 0016" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1600 0000 00F5 1616 1600 0000 0000" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1600 0000 0001 1616 1600 0000 0000" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1601 0000 0001 1616 1600 0000 0000" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1616 0000 0016 1616 1616 0000 0016" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1616 1616 1616 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1616 1616 1616 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1616 1616 1616 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1616 1616 1600 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1616 1616 1600 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0016 1616 1616 1616 1616 1600 1600 1616" $"0016 1600 1616 0000 0016 1600 0000 1600" $"0016 1616 1616 1616 1616 1600 0016 0016" $"0016 1600 1600 1616 0016 0016 1616 1600" $"0016 1616 1616 1616 1616 1600 1616 0016" $"0016 1600 1600 1616 0016 1600 0016 1600" $"0016 1616 1616 1616 1616 1600 1616 0016" $"0016 1600 1616 0000 0016 1616 1600 1600" $"0016 1616 1616 1616 1616 1600 1616 0016" $"1600 0016 1616 1616 0016 0000 0016 1600" $"0016 1616 1616 1616 1616 1616 1616 1616" $"1616 1616 1600 1616 0016 1616 1616 1600" $"0016 1616 1616 1616 1616 1616 1616 1616" $"1616 1616 1616 0000 1616 1616 1616 1600" $"0016 1616 1616 1616 1616 1616 1616 1616" $"1616 1616 1616 1616 1616 1616 1616 1600" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'icl4' (128) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"000C 6666 6666 6666 6666 6666 6666 6660" $"0066 6666 6666 6666 6666 6666 6666 6660" $"0C66 6666 6666 6666 6666 6666 6666 6660" $"0666 6666 0006 6666 0006 6666 6666 6660" $"0666 6660 0000 6660 0000 6666 6666 6660" $"0666 6660 0000 6660 0000 6666 6666 6660" $"0666 6660 0000 6660 0000 6666 6666 6660" $"0666 6666 0006 6666 0006 6666 6666 6660" $"0666 6666 6666 6666 6666 6666 6666 6660" $"0666 0006 6666 0006 6666 6666 6666 6660" $"0660 0000 6660 0000 6666 6666 6666 6660" $"0660 0000 6660 0000 6666 6666 6666 6660" $"0660 0000 6660 0000 6666 6666 6666 6660" $"0666 0006 6666 0006 6666 6666 6666 6660" $"0666 6666 6666 6666 6666 6666 6666 6660" $"0666 6666 6666 6666 6666 6666 6666 6660" $"0666 6666 6666 6666 6666 6666 6666 6660" $"0666 6666 6660 6666 6666 6666 6666 6660" $"0666 6666 6660 6666 6666 6666 6666 6660" $"0666 6666 6660 6066 0660 6600 0660 0060" $"0666 6666 6660 0606 0660 6066 0606 6660" $"0666 6666 6660 6606 0660 6066 0660 0660" $"0666 6666 6660 6606 0660 6600 0666 6060" $"0666 6666 6660 6606 6006 6666 0600 0660" $"0666 6666 6666 6666 6666 6066 0666 6660" $"0666 6666 6666 6666 6666 6600 6666 6660" $"0666 6666 6666 6666 6666 6666 6666 6660" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'icl4' (129) { $"000F FFFF FFFF FFFF FFFF FF00 0000 0000" $"000F DDDD DDDD DDDD DDDD DFF0 0000 0000" $"000F DDDD DDDD DDDD DDDD DFDF 0000 0000" $"000F DDDD DDDD DDDD DDDD DFDD F000 0000" $"000F DDDD DD00 0DDD 000D DFDD DF00 0000" $"000F DDDD D000 00D0 0000 DFDD DDF0 0000" $"000F DDDD D000 00D0 0000 DFFF FFFF 0000" $"000F DDDD D000 00D0 0000 DDDD DDDF 0000" $"000F DDDD DD00 0DDD 000D DDDD DDDF 0000" $"000F DDDD DDDD DDDD DDDD DDDD DDDF 0000" $"000F DD00 0DDD 000D DDDD DDDD DDDF 0000" $"000F D000 00D0 0000 DDDD DDDD DDDF 0000" $"000F D000 00D0 0000 DDDD DDDD DDDF 0000" $"000F D000 00D0 0000 DDDD DDDD DDDF 0000" $"000F DD00 0DDD 000D DDDD DDDD DDDF 0000" $"000F DDDD DDDD DDDD DDDD DDDD DDDF 0000" $"000F DDDD DDDD DDDD DDDD DDDD DDDF 0000" $"000F DDDD DDDD DDDD DDDD DDDD DDDF 0000" $"000F DDDD DDDD DDDD DDDD DDDD DDDF 0000" $"000F DD0D DDDD DDDD DDDD DDDD DDDF 0000" $"000F DD0D DDDD DDDD DDDD DDDD DDDF 0000" $"000F DD0D 0DD0 DD0D D000 DD00 0DDF 0000" $"000F DD00 D0D0 DD0D 0DD0 D0DD DDDF 0000" $"000F DD0D D0D0 DD0D 0DD0 DD00 DDDF 0000" $"000F DD0D D0D0 DD0D D000 DDDD 0DDF 0000" $"000F DD0D D0DD 00DD DDD0 D000 DDDF 0000" $"000F DDDD DDDD DDDD 0DD0 DDDD DDDF 0000" $"000F DDDD DDDD DDDD D00D DDDD DDDF 0000" $"000F DDDD DDDD DDDD DDDD DDDD DDDF 0000" $"000F DDDD DDDD DDDD DDDD DDDD DDDF 0000" $"000F DDDD DDDD DDDD DDDD DDDD DDDF 0000" $"000F FFFF FFFF FFFF FFFF FFFF FFFF 0000" }; data 'icl4' (130) { $"000F FFFF FFFF FFFF FFFF FF00 0000 0000" $"000F DDDD DDDD DDDD DDDD DFF0 0000 0000" $"000F DDDD DDDD DDDD DDDD DFDF FFFF FF00" $"000F DDDD DDDD DDDD DDDD DFDD FDDD DF00" $"000F DDDD DD00 0DDD 000D DFDD DFDD DF00" $"000F DDDD D000 00D0 0000 DFDD DDFD DF00" $"000F DDDD D000 00D0 0000 DFFF FFFF DF00" $"000F DDDD D000 00D0 0000 DDDD DDDF DF00" $"000F DDDD DD00 0DDD 000D DDDD DDDF DF00" $"000F DDDD DDDD DDDD DDDD DDDD DDDF DF00" $"000F DD00 0DDD 000D DDDD DDDD DDDF DF00" $"000F D000 00D0 0000 DDDD DDDD DDDF DF00" $"000F D000 00D0 0000 DDDD DDDD DDDF DF00" $"000F D000 00D0 0000 DDDD DDDD DDDF DF00" $"000F DD00 0DDD 000D DDDD DDDD DDDF DF00" $"000F DDDD DDDD DDDD DDDD DDDD DDDF DF00" $"000F DDDD DDDD DDDD DDDD DDDD DDDF DF00" $"000F DD0D DDDD DDDD DDDD DDDD DDDF DF00" $"000F DD0D DDDD DDDD DDDD DDDD DDDF DF00" $"000F DD0D 0DD0 DD0D D000 DD00 0DDF DF00" $"000F DD00 D0D0 DD0D 0DD0 D0DD DDDF DF00" $"000F DD0D D0D0 DD0D 0DD0 DD00 DDDF DF00" $"000F DD0D D0D0 DD0D D000 DDDD 0DDF DF00" $"000F DD0D D0DD 00DD DDD0 D000 DDDF DF00" $"000F DDDD DDDD DDDD 0DD0 DDDD DDDF DF00" $"000F DDDD DDDD DDDD D00D DDDD DDDF DF00" $"000F DDDD DDDD DDDD DDDD DDDD DDDF DF00" $"000F DDDD DDDD DDDD DDDD DDDD DDDF DF00" $"000F DDDD DDDD DDDD DDDD DDDD DDDF DF00" $"000F FFFF FFFF FFFF FFFF FFFF FFFF DF00" $"0000 FDDD DDDD DDDD DDDD DDDD DDDD DF00" $"0000 FFFF FFFF FFFF FFFF FFFF FFFF FF00" }; data 'icl4' (131) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0007 8888 8888 8888 8888 8888 8888 8880" $"0088 8888 8888 8888 8888 8888 8888 8880" $"0788 8888 8888 8888 8888 8888 8888 8880" $"0888 8888 0008 8888 0008 8888 8888 8880" $"0888 8880 0000 8880 0000 8888 8888 8880" $"0888 8880 0000 8880 0000 8888 8888 8880" $"0888 8880 0000 8880 0000 8888 8888 8880" $"0888 8888 0008 8888 0008 8888 8888 8880" $"0888 8888 8888 8888 8888 8888 8888 8880" $"0888 0008 8888 0008 8888 8888 8888 8880" $"0880 0000 8880 0000 8888 8888 8888 8880" $"0880 0000 8880 0000 8888 8888 8888 8880" $"0880 0000 8880 0000 8888 8888 8888 8880" $"0888 0008 8888 0008 8888 8888 8888 8880" $"0888 8888 8888 8888 8888 8888 8888 8880" $"0888 8888 8888 8888 8888 8888 8888 8880" $"0888 8888 8888 8888 8888 8888 8888 8880" $"0888 8888 8880 8888 8888 8888 8888 8880" $"0888 8888 8880 8888 8888 8888 8888 8880" $"0888 8888 8880 8088 0880 8800 0880 0080" $"0888 8888 8880 0808 0880 8088 0808 8880" $"0888 8888 8880 8808 0880 8088 0880 0880" $"0888 8888 8880 8808 0880 8800 0888 8080" $"0888 8888 8880 8808 8008 8888 0800 0880" $"0888 8888 8888 8888 8888 8088 0888 8880" $"0888 8888 8888 8888 8888 8800 8888 8880" $"0888 8888 8888 8888 8888 8888 8888 8880" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'icl4' (132) { $"0000 0003 2200 0000 0000 0223 0000 0000" $"0000 0002 A220 0000 0000 22A2 0000 0000" $"0000 0002 AA2A 2222 222A 2AA2 0000 0000" $"0000 0000 222A A222 22AA 2220 0000 0000" $"0000 0000 2222 A222 22A2 2220 0000 0000" $"0000 0000 A222 2222 2222 2220 0000 0000" $"0000 0000 A222 2222 2222 22A0 0000 0000" $"0000 000A A222 2222 2222 22AA 0000 0000" $"0000 0002 A222 2222 2222 22A2 0000 0000" $"0000 0022 2222 2F22 2F22 2222 2000 0000" $"0000 0022 2222 2222 2222 2222 2000 0000" $"0000 0022 2222 222F 2222 2222 2000 0000" $"0000 0022 2222 22FF F222 2222 2000 0000" $"0000 0022 2222 2222 2222 2222 2000 0000" $"0000 0022 2222 2222 2222 2222 2000 0000" $"0000 0022 2222 FF22 2FF2 2222 2000 0000" $"0000 0002 2222 22FF F222 2222 0000 0000" $"0000 0002 2222 22C2 C222 2220 0000 0000" $"0000 0000 2222 22C2 C222 2220 0000 0000" $"0000 0000 0222 2222 2222 2200 0000 0000" $"0FFF FFFF FFFF FFFF FFFF FFFF FFFF FF00" $"2F11 1111 1111 1111 1111 1111 1111 1F20" $"2F11 1111 1111 1111 1111 1111 1111 1F20" $"2F11 1111 1116 1161 6661 1111 1111 1E20" $"2F11 1111 1116 1161 6116 1111 1111 1E20" $"0FFF FFFF 1116 6661 6661 111E EEEE EE00" $"0000 0000 F116 1161 6111 11E0 0000 0000" $"0000 0000 F116 1161 6111 11E0 0000 0000" $"0000 0000 F111 1111 1111 11E0 0000 0000" $"0000 0000 5555 5111 1155 5550 0000 0000" $"0000 0000 5555 5111 1155 5550 0000 0000" $"0000 0000 5555 5111 1155 5550 0000 0000" }; data 'icl4' (133) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"000C 2222 2222 2222 2222 2222 2222 2220" $"0022 2222 2222 2222 2222 2222 2222 2220" $"0C22 22D2 2222 2222 2222 2222 2222 2220" $"0222 2222 0002 2222 0002 2222 2222 2220" $"0222 2220 0000 2220 0000 2222 2222 2220" $"0222 2220 0000 2220 0000 2222 2222 2220" $"0222 2220 0000 2220 0000 2222 2222 2220" $"0222 2222 0002 2222 0002 2222 2222 2220" $"0222 2222 2222 2222 2222 2222 2222 2220" $"0222 0002 2222 0002 2222 2222 2222 2220" $"0220 0000 2220 0000 2222 2222 2222 2220" $"0220 0000 2220 0000 2222 2222 2222 2220" $"0220 0000 2220 0000 2222 2222 2222 2220" $"0222 0002 2222 0002 2222 2222 2222 2220" $"0222 2222 2222 2222 2222 2222 2222 2220" $"0222 2222 2222 2222 2222 2222 2222 2220" $"0222 2222 2222 2222 2222 2222 2222 2220" $"0222 2222 2220 2222 2222 2222 2222 2220" $"0222 2222 2220 2222 2222 2222 2222 2220" $"0222 2222 2220 2022 0220 2200 0220 0020" $"0222 2222 2220 0202 0220 2022 0202 2220" $"0222 2222 2220 2202 0220 2022 0220 0220" $"0222 2222 2220 2202 0220 2200 0222 2020" $"0222 2222 2220 2202 2002 2222 0200 0220" $"0222 2222 2222 2222 2222 2022 0222 2220" $"0222 2222 2222 2222 2222 2200 2222 2220" $"0222 2222 2222 2222 2222 2222 2222 2220" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'ics#' (128) { $"0000 0000 0000 0FFE 3FFE 327E 727E 7FFE" $"64DE 64DE 7FC6 7FD6 7FD6 7FFE 0000 0000" $"0000 0000 0000 0FFE 3FFE 327E 727E 7FFE" $"64DE 64DE 7FC6 7FD6 7FD6 7FFE 0000 0000" }; data 'ics#' (129) { $"0000 1FC0 1FE0 1FF0 1FF8 1D78 1FF8 1AF8" $"1FF8 1F78 1F78 1F38 1F38 1FF8 1FF8 0000" $"0000 1FC0 1FE0 1FF0 1FF8 1FF8 1FF8 1FF8" $"1FF8 1FF8 1FF8 1FF8 1FF8 1FF8 1FF8 0000" }; data 'ics#' (130) { $"0000 1FC0 1FFC 1FD4 1FFC 1D7C 1FFC 1AFC" $"1FFC 1F7C 1F7C 1F3C 1F3C 1FFC 1FFC 0FFC" $"0000 1FC0 1FFC 1FFC 1FFC 1FFC 1FFC 1FFC" $"1FFC 1FFC 1FFC 1FFC 1FFC 1FFC 1FFC 0FFC" }; data 'ics#' (133) { $"0000 0000 0000 0FFE 3FFE 327E 727E 7FFE" $"64DE 64DE 7FC6 7FD6 7FD6 7FFE 0000 0000" $"0000 0000 0000 0FFE 3FFE 327E 727E 7FFE" $"64DE 64DE 7FC6 7FD6 7FD6 7FFE 0000 0000" }; data 'ics#' (131) { $"0000 0000 0000 0FFE 3FFE 327E 727E 7FFE" $"64DE 64DE 7FC6 7FD6 7FD6 7FFE 0000 0000" $"0000 0000 0000 0FFE 3FFE 327E 727E 7FFE" $"64DE 64DE 7FC6 7FD6 7FD6 7FFE 0000 0000" }; data 'ics4' (128) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 000C 6666 6666 6660" $"0066 6666 6666 6660 0C66 0060 0666 6660" $"0666 0060 0666 6660 0666 6666 6666 6660" $"0660 0600 6606 6660 0660 0600 6606 6660" $"0666 6666 6600 0660 0666 6666 6606 0660" $"0666 6666 6606 0660 0666 6666 6666 6660" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'ics4' (129) { $"0000 0000 0000 0000 000F FFFF FF00 0000" $"000F DDDD DFF0 0000 000F DDDD DFDF 0000" $"000F DDDD DFFF F000 000F DD0D 0DDD F000" $"000F DDDD DDDD F000 000F D0D0 DDDD F000" $"000F DDDD DDDD F000 000F DDDD 0DDD F000" $"000F DDDD 0DDD F000 000F DDDD 00DD F000" $"000F DDDD 00DD F000 000F DDDD DDDD F000" $"000F FFFF FFFF F000 0000 0000 0000 0000" }; data 'ics4' (130) { $"0000 0000 0000 0000 000F FFFF FF00 0000" $"000F DDDD DFFF FF00 000F DDDD DFDF DF00" $"000F DDDD DFFF FF00 000F DD0D 0DDD FF00" $"000F DDDD DDDD FF00 000F D0D0 DDDD FF00" $"000F DDDD DDDD FF00 000F DDDD 0DDD FF00" $"000F DDDD 0DDD FF00 000F DDDD 00DD FF00" $"000F DDDD 00DD FF00 000F DDDD DDDD FF00" $"000F FFFF FFFF FF00 0000 FFFF FFFF FF00" }; data 'ics4' (131) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0007 8888 8888 8880" $"0088 8888 8888 8880 0788 0080 0888 8880" $"0888 0080 0888 8880 0888 8888 8888 8880" $"0880 0800 8808 8880 0880 0800 8808 8880" $"0888 8888 8800 0880 0888 8888 8808 0880" $"0888 8888 8808 0880 0888 8888 8888 8880" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'ics4' (132) { $"0000 0000 0000 0000 000F F000 00FF 0000" $"000F 2FFF FF2F 0000 000F 2222 222F 0000" $"00F2 2222 2222 F000 00F2 2F22 2F22 F000" $"00E2 222F 2222 E000 00F2 2222 2222 F000" $"00E2 2FF2 FF22 E000 000F 222F 222F 0000" $"0000 F222 22F0 0000 0FFF FFFF FFFF FF00" $"2F11 1111 1111 1F20 2F11 11FF A111 1F20" $"0FFF F1FF A1FF FF00 0000 F111 11F0 0000" }; data 'ics4' (133) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 000C 2222 2222 2220" $"0022 2222 2222 2220 0C22 0020 0222 2220" $"0222 0020 0222 2220 0222 2222 2222 2220" $"0220 0200 2202 2220 0220 0200 2202 2220" $"0222 2222 2200 0220 0222 2222 2202 0220" $"0222 2222 2202 0220 0222 2222 2222 2220" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'ics8' (128) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 002A ECEC ECEC ECEC ECEC ECEC EC00" $"0000 ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"002A ECEC 0000 EC00 00EC ECEC ECEC EC00" $"00EC ECEC 0000 EC00 00EC ECEC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"00EC EC00 00EC 0000 ECEC 00EC ECEC EC00" $"00EC EC00 00EC 0000 ECEC 00EC ECEC EC00" $"00EC ECEC ECEC ECEC ECEC 0000 00EC EC00" $"00EC ECEC ECEC ECEC ECEC 00EC 00EC EC00" $"00EC ECEC ECEC ECEC ECEC 00EC 00EC EC00" $"00EC ECEC ECEC ECEC ECEC ECEC ECEC EC00" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'ics8' (129) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 00FF FFFF FFFF FFFF 0000 0000 0000" $"0000 00FF ECEC ECEC ECFF FF00 0000 0000" $"0000 00FF ECEC ECEC ECFF ECFF 0000 0000" $"0000 00FF ECEC ECEC ECFF FFFF FF00 0000" $"0000 00FF ECEC 00EC 00EC ECEC FF00 0000" $"0000 00FF ECEC ECEC ECEC ECEC FF00 0000" $"0000 00FF EC00 EC00 ECEC ECEC FF00 0000" $"0000 00FF ECEC ECEC ECEC ECEC FF00 0000" $"0000 00FF ECEC ECEC 00EC ECEC FF00 0000" $"0000 00FF ECEC ECEC 00EC ECEC FF00 0000" $"0000 00FF ECEC ECEC 0000 ECEC FF00 0000" $"0000 00FF ECEC ECEC 0000 ECEC FF00 0000" $"0000 00FF ECEC ECEC ECEC ECEC FF00 0000" $"0000 00FF FFFF FFFF FFFF FFFF FF00 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'ics8' (130) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 00FF FFFF FFFF FFFF 0000 0000 0000" $"0000 00FF 7A7A 7A7A 7AFF FFFF FFFF 0000" $"0000 00FF 7A7A 7A7A 7AFF 7AFF 7AFF 0000" $"0000 00FF 7A7A 7A7A 7AFF FFFF FFFF 0000" $"0000 00FF 7A7A 007A 007A 7A7A FFFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A FFFF 0000" $"0000 00FF 7A00 7A00 7A7A 7A7A FFFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A FFFF 0000" $"0000 00FF 7A7A 7A7A 007A 7A7A FFFF 0000" $"0000 00FF 7A7A 7A7A 007A 7A7A FFFF 0000" $"0000 00FF 7A7A 7A7A 0000 7A7A FFFF 0000" $"0000 00FF 7A7A 7A7A 0000 7A7A FFFF 0000" $"0000 00FF 7A7A 7A7A 7A7A 7A7A FFFF 0000" $"0000 00FF FFFF FFFF FFFF FFFF FFFF 0000" $"0000 0000 FFFF FFFF FFFF FFFF FFFF 0000" }; data 'ics8' (131) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0092 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"0000 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"0092 E3E3 0000 E300 00E3 E3E3 E3E3 E300" $"00E3 E3E3 0000 E300 00E3 E3E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"00E3 E300 00E3 0000 E3E3 00E3 E3E3 E300" $"00E3 E300 00E3 0000 E3E3 00E3 E3E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 0000 00E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 00E3 00E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 00E3 00E3 E300" $"00E3 E3E3 E3E3 E3E3 E3E3 E3E3 E3E3 E300" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'ics8' (132) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 00FF FF00 0000 0000 FFFF 0000 0000" $"0000 00FF 3BFF FFFF FFFF 3BFF 0000 0000" $"0000 00FF 3B3B 3B3B 3B3B 3BFF 0000 0000" $"0000 FF3B 3B3B 3B3B 3B3B 3B3B FF00 0000" $"0000 FF3B 3BFF 3B3B 3BFF 3B3B FF00 0000" $"0000 FB3B 3B3B 3BFF 3B3B 3B3B FB00 0000" $"0000 FF3B 3B3B 3B3B 3B3B 3B3B FF00 0000" $"0000 FB3B 3BFF FF3B FFFF 3B3B FB00 0000" $"0000 00FF 3B3B 3BFF 3B3B 3BFF 0000 0000" $"0000 0000 FF3B 3B3B 3B3B FF00 0000 0000" $"00FF FFFF FFFF FFFF FFFF FFFF FFFF 0000" $"3BFF 0808 0808 0808 0808 0808 08FF 3B00" $"3BFF 0808 0808 B0FF B008 0808 08FF 3B00" $"00FF FFFF FF08 B0B0 B008 FFFF FFFF 0000" $"0000 0000 FF08 0808 0808 FF00 0000 0000" }; data 'ics8' (133) { $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0008 1616 1616 1616 1616 1616 1600" $"0000 1616 1616 1616 1616 1616 1616 1600" $"0008 1616 0000 1600 0016 1616 1616 1600" $"0016 1616 0000 1600 0016 1616 1616 1600" $"0016 1616 1616 1616 1616 1616 1616 1600" $"0016 1600 0016 0000 1616 0016 1616 1600" $"0016 1600 0016 0000 1616 0016 1616 1600" $"0016 1616 1616 1616 1616 0000 0016 1600" $"0016 1616 1616 1616 1616 0016 0016 1600" $"0016 1616 1616 1616 1616 0016 0016 1600" $"0016 1616 1616 1616 1616 1616 1616 1600" $"0000 0000 0000 0000 0000 0000 0000 0000" $"0000 0000 0000 0000 0000 0000 0000 0000" }; data 'MENU' (128, "Apple") { $"0080 0000 0000 0000 0000 FFFF FFFF 0114" $"00" }; data 'MENU' (129, "File") { $"0081 0000 0000 0000 0000 FFFF FFFF 0446" $"696C 6500" }; data 'ALRT' (200, "Error Box", purgeable) { $"0064 0078 00E0 01C4 00C8 4444 300A" }; data 'DITL' (200, "Error", purgeable) { $"0003 0000 0000 005C 00F6 0070 013E 0402" $"4F4B 0000 0000 000B 0049 004B 013E 8802" $"5E30 0000 0000 000B 000B 002B 002B A002" $"0000 0000 0000 0060 000B 0070 0064 8809" $"4572 726F 7220 235E 3100" }; data 'STR#' (100, "Error Messages") { $"0002 5654 6869 7320 6170 706C 6963 6174" $"696F 6E20 7265 7175 6972 6573 2041 7070" $"6C65 2065 7665 6E74 732E 2020 506C 6561" $"7365 2075 7067 7261 6465 2074 6F20 5379" $"7374 656D 2037 2E30 206F 7220 6C61 7465" $"7220 746F 2075 7365 2E2F 416E 2065 7272" $"6F72 206F 6363 7572 6564 2064 7572 696E" $"6720 4170 706C 6520 6576 656E 7420 7072" $"6F63 6573 7369 6E67 2E" }; data 'vers' (1) { $"0000 8000 0000 1648 7567 7320 3938 2C20" /* ..Ä....Hugs 98, */ $"4465 6365 6D62 6572 2032 3030 3116 4875" /* December 2001.Hu */ $"6773 2039 382C 2044 6563 656D 6265 7220" /* gs 98, December */ $"3230 3031" /* 2001 */ }; data 'vers' (2) { $"0000 8000 0000 1648 7567 7320 3938 2C20" /* ..Ä....Hugs 98, */ $"4465 6365 6D62 6572 2032 3030 3116 4875" /* December 2001.Hu */ $"6773 2039 382C 2044 6563 656D 6265 7220" /* gs 98, December */ $"3230 3031" /* 2001 */ }; data 'Hugs' (0, "Owner resource") { $"00" }; data 'HugB' (0, "Owner resource") { $"00" }; data 'HugH' (0, "Owner resource") { $"00" }; hugs98-plus-Sep2006/src/machugs/options.h0000644006511100651110000002027210426134734017054 0ustar rossross/* -------------------------------------------------------------------------- * Configuration options * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: options.h,v $ * $Revision: 1.15 $ * $Date: 2006/05/03 14:10:36 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Hugs paths and directories * ------------------------------------------------------------------------*/ /* Define this as the default setting of HUGSPATH. * Value may contain string "{Hugs}" (for which we will substitute the * value of HUGSDIR) and should be either colon-separated (Unix) * or semicolon-separated (Macintosh, Windows, DOS). Escape * characters in the path string are interpreted according to normal * Haskell conventions. * * This value can be overridden from the command line by setting the * HUGSFLAGS environment variable or by storing an appropriate value * for HUGSFLAGS in the registry (Win32 only). In all cases, use a * string of the form -P"...". */ #define HUGSPATH "{Current};{Hugs}:packages:*" /* The list of suffixes used by Haskell source files, separated either * by colons (Unix) or semicolons (Macintosh, Windows, DOS). * * This value can be overridden using the -S flag. */ #define HUGSSUFFIXES ".hs;.lhs" /* The directory name which is substituted for the string "{Hugs}" * in a path variable. This normally points to where the Hugs libraries * are installed - ie so that the file HUGSDIR/lib/Prelude.hs exists * Typical values are: * "/usr/local/lib/hugs" * "/usr/homes/JFHaskell/hugs" * ".." * * This value is ignored on Windows and Macintosh versions since * it is assumed that the binary is installed in HUGSDIR. * * This value cannot be overridden from the command line or by using * environment variables. This isn't quite as limiting as you'd think * since you can always choose _not_ to use the {Hugs} variable - however, * it's obviously _nicer_ to have it set correctly. */ #ifndef HUGSDIR #define HUGSDIR "" #endif /* -------------------------------------------------------------------------- * User interface options * ------------------------------------------------------------------------*/ /* Define if you want to use the "Hugs for Windows" GUI. * (Windows 3.1 and compatibles only) */ #define HUGS_FOR_WINDOWS 0 /* Define if you want filenames to be converted to normal form by: * o replacing relative pathnames with absolute pathnames and * eliminating .. and . where possible. * o converting to lower case (only in case-insensitive filesystems) */ #define PATH_CANONICALIZATION 0 /* Define if you want path entries ending in / to be recursively * searched for Haskell code. */ #define SEARCH_DIR 0 /* Not ready yet! */ /* Define if a command line editor is available and should be used. * There are two choices of command line editor that can be used with Hugs: * GNU readline and editline (from comp.sources.misc, vol 31, issue 71) */ #define USE_READLINE 0 /* Define if you want the small startup banner. */ #define SMALL_BANNER 0 /* -------------------------------------------------------------------------- * Making Hugs smaller * ------------------------------------------------------------------------*/ /* Define one of these to select overall size of Hugs * SMALL_HUGS for 16 bit operation on a limited memory PC. * REGULAR_HUGS for 32 bit operation using largish default table sizes. * LARGE_HUGS for 32 bit operation using larger default table sizes. */ #define SMALL_HUGS 0 #define REGULAR_HUGS 0 #define LARGE_HUGS 1 /* -------------------------------------------------------------------------- * Fancy features * ------------------------------------------------------------------------*/ /* Define if :xplain should be enabled */ #define EXPLAIN_INSTANCE_RESOLUTION (STANDARD_HUGS || HEAP_PROFILER_HUGS) /* Define if heap profiling should be used */ #define PROFILING HEAP_PROFILER_HUGS /* Define if you want to run Haskell code through a preprocessor * * Note that there's the import chasing mechanism will not spot any * #includes so you must :load (not :reload) if you change any * (non-Haskell) configurations files. */ #define USE_PREPROCESSOR 0 /* Define if you want to time every evaluation. * * Timing is included in the Hugs distribution for the purpose of benchmarking * the Hugs interpreter, comparing its performance across a variety of * different machines, and with other systems for similar languages. * * It would be somewhat foolish to try to use the timings produced in this * way for any other purpose. In particular, using timings to compare the * performance of different versions of an algorithm is likely to give very * misleading results. The current implementation of Hugs as an interpreter, * without any significant optimizations, means that there are much more * significant overheads than can be accounted for by small variations in * Hugs code. */ #undef WANT_TIMER /* * By default, the Hugs Server API wraps up each value pushed on the stack * as a Dynamic, achieving some run-time type safety when applying these * arguments to a function. This Dynamic layer sometimes gets in the way * for low-level consumers of the Server API (e.g, HaskellScript, Lambada, * mod_haskell), so by setting NO_DYNAMIC_TYPES to 1 you turn off the * use of Dynamics (and assume all the responsibility of debugging any * bad crashes you might see as a result!) */ /* #undef NO_DYNAMIC_TYPES */ /* -------------------------------------------------------------------------- * Debugging options (intended for use by maintainers) * ------------------------------------------------------------------------*/ /* Define if debugging generated bytecodes or the bytecode interpreter */ #define DEBUG_CODE 0 /* Define if debugging generated supercombinator definitions or compiler */ #define DEBUG_SHOWSC 0 /* Define if you want to use a low-level printer from within a debugger */ #define DEBUG_PRINTER 0 /* Define if you want to perform runtime tag-checks as an internal * consistency check. This makes Hugs run very slowly - but is very * effective at detecting and locating subtle bugs. */ #define CHECK_TAGS 0 /* -------------------------------------------------------------------------- * Experimental features * These are likely to disappear/change in future versions and should not * be used by most people.. * ------------------------------------------------------------------------*/ /* Define if you want to use the primitives which let you examine Hugs * internals. */ #define INTERNAL_PRIMS 0 /* Define if you want to use the primitives which let you examine Hugs * bytecodes (requires INTERNAL_PRIMS). */ #define BYTECODE_PRIMS 0 /* In a plain Hugs system, most signals (SIGBUS, SIGTERM, etc) indicate * some kind of error in Hugs - or maybe a stack overflow. Rather than * just crash, Hugs catches these errors and returns to the main loop. * It does this by calling a function "panic" which longjmp's back to the * main loop. * If you're developing a GreenCard library, this may not be the right * behaviour - it's better if Hugs leaves them for your debugger to * catch rather than trapping them and "panicing". */ #define DONT_PANIC 0 /* If you get really desperate to understand why your Hugs programs keep * crashing or running out of stack, you might like to set this flag and * recompile Hugs. When you hit a stack error, it will print out a list * of all the objects currently under evaluation. The information isn't * perfect and can be pretty hard to understand but it's better than a * poke in the eye with a blunt stick. * * This is a very experimental feature! */ #define GIMME_STACK_DUMPS 0 /* ----------------------------------------------------------------------- */ hugs98-plus-Sep2006/src/msc/0000755006511100651110000000000010504340135014327 5ustar rossrosshugs98-plus-Sep2006/src/msc/Makefile0000644006511100651110000003060210207437527016004 0ustar rossross# Generated automatically from Makefile.in by configure. # -------------------------------------------------------------------------- # Makefile for Hugs # # The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the # Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, # 1994-2004, All rights reserved. It is distributed as # free software under the license in the file "License", which is # included in the distribution. # -------------------------------------------------------------------------- # Targets: # # : make hugs.exe and runhugs.exe # install: make and install programs/libraries # hugs.exe: make minimal working system # runhugs.exe: make batch-mode version of Hugs # hugsscript.dll: make DLL version of Hugs # clean: delete files not required in running system # distclean: delete files that can be regenerated using C compiler # veryclean: delete all machine generated files # (you need perl, bison/yacc, etc to rebuild these files) # TAGS: build emacs TAGS table CC = cl /nologo VERSTR = -DMONTH_YEAR="\"Nov 2003\"" CFLAGS = -MD $(VERSTR) # When debugging: #CFLAGS = -MDd -Zi $(VERSTR) OPTFLAGS = -O2 LD = ld LDFLAGS = # When debugging: #LDFLAGS = -Zi -MDd DLL_FLAGS = /LD PIC_FLAGS = LIBS = kernel32.lib advapi32.lib YACC = bison RM = -del CP = xcopy /Y EXEEXT = .exe OBJEXT = obj FPTOOLS = ../../fptools BUILD_DIR = ..\\hugsdir # a file created by make libraries LIBRARIES = $(BUILD_DIR)/libraries/Prelude.hs # a file created by make include INCLUDES = $(BUILD_DIR)/include/HsFFI.h .SUFFIXES : .SUFFIXES : .c .h .$(OBJEXT) HFILES = HsFFI.h builtin.h char.h command.h config.h connect.h \ errors.h evaluator.h goal.h machdep.h module.h observe.h \ options.h opts.h output.h prelude.h script.h server.h \ storage.h strutil.h subst.h CFILES = hugs.c runhugs.c server.c edit.c observe.c \ builtin.c char.c compiler.c errors.c evaluator.c ffi.c \ goal.c input.c machdep.c machine.c module.c opts.c \ output.c plugin.c script.c static.c storage.c strutil.c \ subst.c type.c version.c INCFILES = array.c bignums.c dirprim.c interns.c iomonad.c \ preds.c printer.c scc.c timeprim.c timer.c YFILES = parser.y SOURCES = $(HFILES) $(CFILES) $(INCFILES) $(YFILES) OBJECTS = builtin.$(OBJEXT) char.$(OBJEXT) compiler.$(OBJEXT) \ errors.$(OBJEXT) evaluator.$(OBJEXT) ffi.$(OBJEXT) \ goal.$(OBJEXT) input.$(OBJEXT) machdep.$(OBJEXT) \ machine.$(OBJEXT) module.$(OBJEXT) opts.$(OBJEXT) \ output.$(OBJEXT) plugin.$(OBJEXT) script.$(OBJEXT) \ static.$(OBJEXT) storage.$(OBJEXT) strutil.$(OBJEXT) \ subst.$(OBJEXT) type.$(OBJEXT) version.$(OBJEXT) IOBJECTS = hugs.$(OBJEXT) edit.$(OBJEXT) observe.$(OBJEXT) $(OBJECTS) \ hugs.res HEADERS = HsFFI.h config.h unix\\MachDeps.h unix\\template-hsc.h TOOLSDIR = ..\\tools TOOLS = ..\\tools\\Package.hs ..\\tools\\ParsePkgConf.hs \ ..\\tools\\get_pkg_field ################################################################ # Default target ################################################################ # This rule goes first to make it the default choice default :: all all :: hugs$(EXEEXT) runhugs$(EXEEXT) ffihugs$(EXEEXT) hugsscript.dll ################################################################ # Hugs interpreter and standalone evaluator ################################################################ hugs$(EXEEXT) : $(IOBJECTS) $(CC) $(LDFLAGS) $(IOBJECTS) $(LIBS) -o hugs$(EXEEXT) SERVER_OBJECTS = server.$(OBJEXT) runhugs.res $(OBJECTS) runhugs$(EXEEXT) : runhugs.$(OBJEXT) $(SERVER_OBJECTS) $(CC) $(LDFLAGS) runhugs.$(OBJEXT) $(SERVER_OBJECTS) $(LIBS) -o runhugs$(EXEEXT) ffihugs$(EXEEXT) : ffihugs.$(OBJEXT) $(SERVER_OBJECTS) $(CC) $(LDFLAGS) ffihugs.$(OBJEXT) $(SERVER_OBJECTS) $(LIBS) -o ffihugs$(EXEEXT) ffihugs.$(OBJEXT) : runhugs.$(OBJEXT) $(CC) -c $(CFLAGS) $(OPTFLAGS) -DFFI_COMPILER runhugs.c /Foffihugs.$(OBJEXT) hugsscript.$(OBJEXT) : hugsscript.c hugsscript.dll : $(SERVER_OBJECTS) hugsscript.$(OBJEXT) $(CC) $(DLL_FLAGS) $(LDFLAGS) $(SERVER_OBJECTS) hugsscript.$(OBJEXT) $(LIBS) -o hugsscript.dll ################################################################ # Libraries, converted from raw sources out of the fptools tree ################################################################ libraries :: $(LIBRARIES) $(LIBRARIES) : runhugs$(EXEEXT) ffihugs$(EXEEXT) ../libraries/Hugs/*.* unix/convert_libraries $(TOOLS) $(INCLUDES) -mkdir $(BUILD_DIR)\\tools $(CP) $(TOOLSDIR)\*.* $(BUILD_DIR)\\tools -mkdir $(BUILD_DIR)\\libraries -mkdir $(BUILD_DIR)\\libraries/Hugs $(CP) ..\libraries\Hugs\*.* $(BUILD_DIR)\\libraries\\Hugs cd unix && sh convert_libraries $(FPTOOLS) ../../hugsdir $(INCLUDES) : $(HEADERS) -mkdir $(BUILD_DIR)\\include $(CP) HsFFI.h $(BUILD_DIR)\\include $(CP) config.h $(BUILD_DIR)\\include $(CP) unix\\MachDeps.h $(BUILD_DIR)\\include $(CP) unix\\template-hsc.h $(BUILD_DIR)\\include ################################################################ # Library modules that use the Foreign Function Interface ################################################################ FFI_LIBRARIES = $(BUILD_DIR)/libraries/Hugs/Storable.dll ffi_libraries : $(FFI_LIBRARIES) BUILD_FFI = env HUGSDIR='$(BUILD_DIR)' HUGSFLAGS='' ./ffihugs +G # # Create all the FFI extension DLLs. # FFIHUGS=ffihugs$(EXEEXT) FFIHUGS_OPTS=+G -98 -P../hugsdir/libraries +L-I../hugsdir/include .PHONY: ffi-dlls ffi-dlls: $(FFIHUGS) $(FFIHUGS) $(FFIHUGS_OPTS) +L../libraries/Hugs/Storable_aux.c Hugs.Storable $(FFIHUGS) $(FFIHUGS_OPTS) Foreign.Marshal.Alloc $(FFIHUGS) $(FFIHUGS_OPTS) Foreign.Marshal.Utils $(FFIHUGS) $(FFIHUGS_OPTS) +L../hugsdir/libraries/Foreign/C/Error.c Foreign.C.Error # $(FFIHUGS) $(FFIHUGS_OPTS) +L../libraries/Network/initWinSock.c +L../libraries/Network/winSockErr.c +Lwsock32.lib Network.Socket # $(FFIHUGS) $(FFIHUGS_OPTS) +Lwsock32.lib Network.BSD ################################################################ # Clean, distclean, veryclean, TAGS ################################################################ clean :: $(RM) echodate$(EXEEXT) $(RM) *.o $(RM) *.O $(RM) *.obj $(RM) *.OBJ $(RM) *.LIB $(RM) *.DEF $(RM) *.RES $(RM) *.EXP $(RM) *.ILK $(RM) *.PDB $(RM) *.TD2 $(RM) *.MAP $(RM) *.CSM $(RM) *.TR2 $(RM) *.DSW $(RM) *.RES $(RM) *.aux $(RM) *.hp distclean :: clean distclean :: $(RM) hugs$(EXEEXT) $(RM) runhugs$(EXEEXT) $(RM) ffihugs$(EXEEXT) $(RM) *.pdf $(RM) TAGS $(RM) *~ veryclean :: distclean veryclean :: $(RM) config.h $(RM) options.h TAGS :: etags *.[ych] ################################################################ # C and Yacc rules ################################################################ .c.$(OBJEXT) : $(CC) -c $(CFLAGS) $(OPTFLAGS) $< # Modules to be compiled without optimization. # (old comment: to avoid optimisation bugs in certain compilers. # This may be overly conservative on some compilers.) # (The following explanation is based on a posting by Alastair Reid.) # These modules allocate cells on the Hugs heap and assume a conservative # garbage collector. On some (especially RISC) architectures, the # optimizer may identify a pointer to a Cell as a common subexpression, # and hold that instead of the Cell. This would then be missed by the # conservative garbage collector's simplistic scan of the C stack. # Modules associated with evaluation are safe because they don't assume # conservative GC (see IMPORTANT NOTICE in builtin.c). compiler.$(OBJEXT) : compiler.c $(CC) -c $(CFLAGS) compiler.c static.$(OBJEXT) : static.c $(CC) -c $(CFLAGS) static.c parser.c : parser.y -$(YACC) parser.y mv parser.tab.c parser.c # veryclean :: # $(RM) parser.c hugs.res : msc\hugs.rc ..\icons\hugsicon.ico rc /imsc /i..\icons /r /fo hugs.res msc\hugs.rc runhugs.res : msc\runhugs.rc ..\icons\hsxicon.ico rc /imsc /i..\icons /r /fo runhugs.res msc\runhugs.rc ################################################################ # Generated object dependencies (Don't change or delete this line) ################################################################ hugs.$(OBJEXT): hugs.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ command.h connect.h errors.h script.h opts.h strutil.h evaluator.h \ machdep.h output.h module.h timer.c runhugs.$(OBJEXT): runhugs.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h machdep.h observe.h builtin.h evaluator.h errors.h \ server.h HugsAPI.h server.$(OBJEXT): server.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h script.h machdep.h evaluator.h opts.h strutil.h \ errors.h server.h HugsAPI.h edit.$(OBJEXT): edit.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h opts.h strutil.h machdep.h observe.$(OBJEXT): observe.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h command.h errors.h machdep.h builtin.h output.h \ observe.h builtin.$(OBJEXT): builtin.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h machdep.h char.h builtin.h bignums.c \ printer.c iomonad.c timeprim.c dirprim.c interns.c array.c char.$(OBJEXT): char.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h char.h unitable.c compiler.$(OBJEXT): compiler.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h goal.h char.h output.h opts.h errors.$(OBJEXT): errors.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h opts.h goal.h char.h evaluator.h evaluator.$(OBJEXT): evaluator.c prelude.h config.h platform.h options.h \ storage.h HsFFI.h connect.h errors.h script.h output.h strutil.h opts.h \ machdep.h evaluator.h ffi.$(OBJEXT): ffi.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h output.h strutil.h goal.$(OBJEXT): goal.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h machdep.h opts.h goal.h input.$(OBJEXT): input.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h command.h errors.h module.h script.h opts.h goal.h \ machdep.h char.h parser.c machdep.$(OBJEXT): machdep.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h opts.h strutil.h machdep.h char.h \ evaluator.h machine.$(OBJEXT): machine.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h char.h opts.h module.$(OBJEXT): module.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h module.h output.h opts.$(OBJEXT): opts.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h machdep.h strutil.h opts.h char.h output.$(OBJEXT): output.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h char.h plugin.$(OBJEXT): plugin.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h script.$(OBJEXT): script.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h machdep.h opts.h strutil.h script.h static.$(OBJEXT): static.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h machdep.h errors.h output.h subst.h module.h opts.h \ goal.h scc.c storage.$(OBJEXT): storage.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h opts.h errors.h machdep.h evaluator.h strutil.h \ output.h strutil.$(OBJEXT): strutil.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h strutil.h subst.$(OBJEXT): subst.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h opts.h subst.h type.$(OBJEXT): type.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h output.h subst.h goal.h opts.h preds.c scc.c version.$(OBJEXT): version.c prelude.h config.h platform.h options.h ################################################################ # End of generated object dependencies (Don't change or delete this line) ################################################################ version.$(OBJEXT): echodate.h echodate.h: echodate$(EXEEXT) $(PWD)/echodate$(EXEEXT) > echodate.h echodate$(EXEEXT): msc/echodate.c $(CC) $(LDFLAGS) msc/echodate.c -o $@ ################################################################ # End of Makefile ################################################################ hugs98-plus-Sep2006/src/msc/README0000644006511100651110000000277607542115563015240 0ustar rossrossHow to build Hugs with Microsoft Visual C++ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We used to do this using a pure Microsoft environment (.bat files, DOS command windows, etc.) and that all ought to still work but we don't do things that way anymore so we can't provide accurate information on how to do it. These days, we often build using a Cygwin environment to provide the shell and Microsoft's Visual C++ compiler (using in batch mode) and NMake to compile Hugs. 1) Put this in your .bashrc (or whatever you use) VSCommonDir="/cygdrive/c/program files/microsoft visual studio/common" MSDevDir="/cygdrive/c/program files/microsoft visual studio/common/msdev98" MSVCDir="/cygdrive/c/program files/microsoft visual studio/vc98" export PATH="$MSDevDir/bin:$MSVCDir/bin:$VSCommonDir/tools/win95:$VSCommonDir/tools:$PATH" export VSCommonDir="C:\\PROGRA~1\\MICROS~3\\COMMON" export MSDevDir="C:\\PROGRA~1\\MICROS~3\\COMMON\\msdev98" export MSVCDir="C:\\PROGRA~1\\MICROS~3\\VC98" export INCLUDE="$MSVCDir\\ATL\\INCLUDE;$MSVCDir\\INCLUDE;$MSVCDir\\MFC\\INCLUDE;$INCLUDE" export LIB="$MSVCDir\\LIB;$MSVCDir\\MFC\\LIB;$LIB" 2) Put configure-generated files in the right place: cd hugs98/src cp msc/{Makefile,config.h,options.h} . 3) Build using nmake (_not__ GNU make) nmake 4) Copy into directory above and test cp *.exe .. ../hugs At the moment, there's no story for running convert_libraries and friends when doing a build like this. (Probably easy but I haven't done it so I can't document it.) hugs98-plus-Sep2006/src/msc/config.bat0000644006511100651110000000020506747650200016274 0ustar rossrossrem Copy saved copies of .\Makefile, .\config.h and .\options.h to .. copy .\Makefile .. copy .\config.h .. copy .\options.h .. hugs98-plus-Sep2006/src/msc/config.h0000644006511100651110000002645010430652303015755 0ustar rossross/* ../config.h. Generated by configure. */ /* ../config.h.in. Generated from configure.ac by autoheader. */ /* platform-specific defines */ #include "platform.h" /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP systems. This function is required for `alloca.c' support on those systems. */ /* #undef CRAY_STACKSEG_END */ /* Define to 1 if using `alloca.c'. */ #define C_ALLOCA 1 /* Define to 1 if floating point arithmetic is supported. */ #define FLOATS_SUPPORTED 1 /* Define to 1 if you have `alloca', as a function or macro. */ /* #undef HAVE_ALLOCA */ /* Define to 1 if you have and it should be used (not on Ultrix). */ /* #undef HAVE_ALLOCA_H */ /* Define to 1 if you have the header file. */ #define HAVE_ASSERT_H 1 /* Define to 1 if you have the `atan' function. */ #define HAVE_ATAN 1 /* Define to 1 if you have /bin/sh */ #define HAVE_BIN_SH 1 /* Define to 1 if you have the header file. */ #define HAVE_CONIO_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_CONSOLE_H */ /* Define to 1 if you have the header file. */ #define HAVE_CTYPE_H 1 /* Define to 1 if you have the declaration of `altzone', and to 0 if you don't. */ /* #undef HAVE_DECL_ALTZONE */ /* Define to 1 if you have the declaration of `timezone', and to 0 if you don't. */ #define HAVE_DECL_TIMEZONE 1 /* Define to 1 if you have the declaration of `_timezone', and to 0 if you don't. */ #define HAVE_DECL__TIMEZONE 1 /* Define to 1 if you have the header file. */ #define HAVE_DIRECT_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_DIRENT_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_DLFCN_H */ /* Define to 1 if you have the `dlopen' function. */ /* #undef HAVE_DLOPEN */ /* Define to 1 if you have the header file. */ /* #undef HAVE_DL_H */ /* Define to 1 if you have the header file. */ #define HAVE_DOS_H 1 /* Define to 1 if you have the `dup' function. */ /* #undef HAVE_DUP */ /* Define to 1 if you have the header file. */ #define HAVE_ERRNO_H 1 /* Define to 1 if you have the `farcalloc' function. */ /* #undef HAVE_FARCALLOC */ /* Define to 1 if you have the header file. */ #define HAVE_FCNTL_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_FILES_H */ /* Define to 1 if you have the header file. */ #define HAVE_FLOAT_H 1 /* Define to 1 if you have the `fseek' function. */ #define HAVE_FSEEK 1 /* Define to 1 if you have the `fstat' function. */ #define HAVE_FSTAT 1 /* Define to 1 if you have the `ftell' function. */ #define HAVE_FTELL 1 /* Define to 1 if you have the `ftime' function. */ /* #undef HAVE_FTIME */ /* Define to 1 if you have the `GetModuleFileName' function. */ #define HAVE_GETMODULEFILENAME 1 /* Define to 1 if you have the `getrusage' function. */ /* #undef HAVE_GETRUSAGE */ /* Define to 1 if you have the `gettimeofday' function. */ /* #undef HAVE_GETTIMEOFDAY */ /* Define to 1 if you have the `gmtime' function. */ #define HAVE_GMTIME 1 /* Define to 1 if heap profiler can (and should) automatically invoke hp2ps to convert heap profile (in "profile.hp") to PostScript. */ /* #undef HAVE_HP2PS */ /* Define to 1 if you have the header file. */ #define HAVE_INTTYPES_H 1 /* Define to 1 if you have the header file. */ #define HAVE_IO_H 1 /* Define to 1 if you have the `isatty' function. */ #define HAVE_ISATTY 1 /* Define to 1 if compiler supports gcc's "labels as values" (aka computed goto) feature (which is used to speed up instruction dispatch in the interpreter). */ #define HAVE_LABELS_AS_VALUES 0 /* Define to 1 if you have the `dl' library (-ldl). */ /* #undef HAVE_LIBDL */ /* Define to 1 if you have the `dld' library (-ldld). */ /* #undef HAVE_LIBDLD */ /* Define to 1 if you have the `m' library (-lm). */ #define HAVE_LIBM 1 /* Define to 1 if you have the header file. */ #define HAVE_LIMITS_H 1 /* Define to 1 if you have the `LoadLibrary' function. */ #define HAVE_LOADLIBRARY 1 /* Define to 1 if you have the header file. */ #define HAVE_LOCALE_H 1 /* Define to 1 if you have the `localtime' function. */ #define HAVE_LOCALTIME 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_MACH_O_DYLD_H */ /* Define to 1 if you have the `macsystem' function. */ /* #undef HAVE_MACSYSTEM */ /* Define to 1 if you have the header file. */ #define HAVE_MEMORY_H 1 /* Define to 1 if you have the `mktime' function. */ #define HAVE_MKTIME 1 /* Define to 1 if you have the `NSCreateObjectFileImageFromFile' function. */ /* #undef HAVE_NSCREATEOBJECTFILEIMAGEFROMFILE */ /* Define to 1 if you have the `pclose' function. */ /* #undef HAVE_PCLOSE */ /* Define to 1 if you have the `poly' function. */ /* #undef HAVE_POLY */ /* Define to 1 if you have the `popen' function. */ /* #undef HAVE_POPEN */ /* Define if you have POSIX threads libraries and header files. */ /* #undef HAVE_PTHREAD */ /* Define to 1 if you have the `realpath' function. */ /* #undef HAVE_REALPATH */ /* Define to 1 if you have the `rindex' function. */ /* #undef HAVE_RINDEX */ /* Define to 1 if you have the `select' function. */ /* #undef HAVE_SELECT */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SGTTY_H */ /* Define to 1 if you have the `shl_load' function. */ /* #undef HAVE_SHL_LOAD */ /* Define to 1 if you have the header file. */ #define HAVE_SIGNAL_H 1 /* Define to 1 if you have the `sigprocmask' function. */ /* #undef HAVE_SIGPROCMASK */ /* Define to 1 if you have the `snprintf' function. */ /* #undef HAVE_SNPRINTF */ /* Define to 1 if you have the header file. */ /* #undef HAVE_STAT_H */ /* Define to 1 if you have the header file. */ #define HAVE_STDARG_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDINT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_STD_H */ /* Define to 1 if you have the `stime' function. */ /* #undef HAVE_STIME */ /* Define to 1 if you have the `strcasecmp' function. */ /* #undef HAVE_STRCASECMP */ /* Define to 1 if you have the `strcmp' function. */ #define HAVE_STRCMP 1 /* Define to 1 if you have the `strcmpi' function. */ #define HAVE_STRCMPI 1 /* Define to 1 if you have the `stricmp' function. */ #define HAVE_STRICMP 1 /* Define to 1 if you have the header file. */ #define HAVE_STRINGS_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRING_H 1 /* Define to 1 if you have the `strrchr' function. */ #define HAVE_STRRCHR 1 /* Define to 1 if `tm_zone' is member of `struct tm'. */ /* #undef HAVE_STRUCT_TM_TM_ZONE */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_IOCTL_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_PARAM_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_RESOURCE_H */ /* Define to 1 if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_TIMEB_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_TIMES_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_TIME_H */ /* Define to 1 if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define to 1 if you have that is POSIX.1 compatible. */ /* #undef HAVE_SYS_WAIT_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_TERMIOS_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_TERMIO_H */ /* Define to 1 if you have the `time' function. */ #define HAVE_TIME 1 /* Define to 1 if you have the `times' function. */ /* #undef HAVE_TIMES */ /* Define to 1 if you have the header file. */ #define HAVE_TIME_H 1 /* Define to 1 if your `struct tm' has `tm_zone'. Deprecated, use `HAVE_STRUCT_TM_TM_ZONE' instead. */ /* #undef HAVE_TM_ZONE */ /* Define to 1 if you don't have `tm_zone' but do have the external array `tzname'. */ #define HAVE_TZNAME 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_UNISTD_H */ /* Define to 1 if you have the `valloc' function. */ /* #undef HAVE_VALLOC */ /* Define to 1 if you have the header file. */ /* #undef HAVE_VALUES_H */ /* Define to 1 if you have the `vsnprintf' function. */ /* #undef HAVE_VSNPRINTF */ /* Define to 1 if you have the header file. */ #define HAVE_WCHAR_H 1 /* Define to 1 if you have the header file. */ #define HAVE_WINDOWS_H 1 /* Define to 1 if you have the `WinExec' function. */ #define HAVE_WINEXEC 1 /* Define to 1 if you have malloc.h and it defines _alloca - eg for Visual C++. */ #define HAVE__ALLOCA 1 /* Define to 1 if you have the `_fullpath' function. */ #define HAVE__FULLPATH 1 /* Define to 1 if you have the `_pclose' function. */ #define HAVE__PCLOSE 1 /* Define to 1 if you have the `_popen' function. */ #define HAVE__POPEN 1 /* Define to 1 if you have the `_snprintf' function. */ #define HAVE__SNPRINTF 1 /* Define to 1 if you have the `_stricmp' function. */ #define HAVE__STRICMP 1 /* Define to 1 if you have the `_vsnprintf' function. */ #define HAVE__VSNPRINTF 1 /* Define to 1 if jmpbufs can be treated like arrays. */ #define JMPBUF_ARRAY 1 /* Define to 1 if your C compiler inserts underscores before symbol names. */ /* #undef LEADING_UNDERSCORE */ /* C compiler invocation use to build a dynamically loadable library. Typical value: "gcc -shared". Must evaluate to a literal C string. */ #define MKDLL_CMD " /LD /ML /nologo" #define MKDLL_VISUAL_STUDIO 1 /* Define to 1 if the C compiler supports function prototypes. */ #define PROTOTYPES 1 /* Define to the necessary symbol if this constant uses a non-standard name on your system. */ /* #undef PTHREAD_CREATE_JOINABLE */ /* Define as the return type of signal handlers (`int' or `void'). */ #define RETSIGTYPE void /* The size of a `double', as computed by sizeof. */ #define SIZEOF_DOUBLE 8 /* The size of a `float', as computed by sizeof. */ #define SIZEOF_FLOAT 4 /* The size of a `int', as computed by sizeof. */ #define SIZEOF_INT 4 /* The size of a `int*', as computed by sizeof. */ #define SIZEOF_INTP 4 /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ #define STACK_DIRECTION -1 /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define to 1 if you can safely include both and . */ /* #undef TIME_WITH_SYS_TIME */ /* Define to 1 if your declares `struct tm'. */ /* #undef TM_IN_SYS_TIME */ /* Define to 1 if signal handlers have type void (*)(int) (Otherwise, they're assumed to have type int (*)(void).) */ #define VOID_INT_SIGNALS 1 /* Define like PROTOTYPES; this can be used by system headers. */ #define __PROTOTYPES 1 /* Define to empty if `const' does not conform to ANSI C. */ /* #undef const */ hugs98-plus-Sep2006/src/msc/config.sh0000644006511100651110000000240206727055602016144 0ustar rossross#!/bin/sh # Configure script for Hugs (using Microsoft Visual C++) # Before we can run the configure script, we have to patch some # incompatabilities between Unix and Windows: # # o Visual C++ can't handle the file descriptor that bash (from # cygwin beta release 16) passes to it when stdout is redirected # to /dev/null. # # o Visual C++ writes input filenames to stderr as it processes them. sed ../unix/configure >./config.fix \ -e "s#/dev/null#conf_devnull#" \ -e "s/-v '\^ \*+'/-i \"error\\\|warning\"/g" # Now we override the default values of some environment variables. set -a # All modified env vars are to be exported! CC=${CC="cl /nologo"} DEBUGFLAGS=${DEBUGFLAGS="-Zi"} LDDEBUGFLAGS=${LDDEBUGFLAGS="-Zi"} OPTFLAGS=${OPTFLAGS="-O2"} CFLAGS=${CFLAGS="-ML"} LDFLAGS=$LD DLL_FLAGS="/LD" CPP=${CPP="cl /nologo /E"} LIBS=${LIBS="kernel32.lib advapi32.lib"} GUILIBS="kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib comctl32.lib winmm.lib advapi32.lib" # Run the script ./config.fix --target=windows $* # Store the generated files for the benefit of those who can't # run configure directly. echo "Copying ../Makefile, ../config.h and ../options.h to ." cp ../Makefile ../config.h ../options.h . # Endhugs98-plus-Sep2006/src/msc/echodate.c0000644006511100651110000000127010044524447016260 0ustar rossross/* * Little helper to portably (i.e., across 'make's and command shells) print * out the current date, as needed by version.c * */ #include #include int main() { time_t t; struct tm *pt; char buf[256]; if ( time(&t) == (-1) ) { fprintf(stderr, "Unable to get the current time.\n"); fflush(stderr); return 1; } if ( (pt = localtime(&t)) == NULL ) { fprintf(stderr, "Unable to decode time value.\n"); fflush(stderr); return 1; } if (strftime(buf, sizeof(buf), "%Y%m%d", pt) == 0) { fprintf(stderr, "Unable to format time string.\n"); fflush(stderr); return 1; } printf("#define YYYYMMDD \"%s\"\n", buf); return 0; } hugs98-plus-Sep2006/src/msc/ffihugs.bat0000644006511100651110000000037410423764352016471 0ustar rossross@echo off REM First build up the command line to pass on in %s% set s= :begin if '%1' == '' goto done set s=%s% %1 shift goto begin :done REM Now figure out what to do if not "%VS71COMNTOOLS%" == "" call "%VS71COMNTOOLS%vsvars32.bat" > nul cl %s% hugs98-plus-Sep2006/src/msc/ffihugs.vcproj0000644006511100651110000002722510430112677017225 0ustar rossross hugs98-plus-Sep2006/src/msc/hugs.dsp0000644006511100651110000001254707556071501016031 0ustar rossross# Microsoft Developer Studio Project File - Name="hugs" - Package Owner=<4> # Microsoft Developer Studio Generated Build File, Format Version 6.00 # ** DO NOT EDIT ** # TARGTYPE "Win32 (x86) Console Application" 0x0103 CFG=hugs - Win32 Debug !MESSAGE This is not a valid makefile. To build this project using NMAKE, !MESSAGE use the Export Makefile command and run !MESSAGE !MESSAGE NMAKE /f "hugs.mak". !MESSAGE !MESSAGE You can specify a configuration when running NMAKE !MESSAGE by defining the macro CFG on the command line. For example: !MESSAGE !MESSAGE NMAKE /f "hugs.mak" CFG="hugs - Win32 Debug" !MESSAGE !MESSAGE Possible choices for configuration are: !MESSAGE !MESSAGE "hugs - Win32 Release" (based on "Win32 (x86) Console Application") !MESSAGE "hugs - Win32 Debug" (based on "Win32 (x86) Console Application") !MESSAGE # Begin Project # PROP AllowPerConfigDependencies 0 # PROP Scc_ProjName "" # PROP Scc_LocalPath "" CPP=cl.exe RSC=rc.exe !IF "$(CFG)" == "hugs - Win32 Release" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "Release" # PROP BASE Intermediate_Dir "Release" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "Release" # PROP Intermediate_Dir "Release" # PROP Ignore_Export_Lib 0 # PROP Target_Dir "" # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c # ADD CPP /nologo /W3 /GX /O2 /I "msc" /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c # ADD BASE RSC /l 0x409 /d "NDEBUG" # ADD RSC /l 0x409 /d "NDEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 # Begin Special Build Tool SOURCE="$(InputPath)" PostBuild_Desc=Install hugs binary PostBuild_Cmds=copy hugs.exe ..\ # End Special Build Tool !ELSEIF "$(CFG)" == "hugs - Win32 Debug" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 1 # PROP BASE Output_Dir "Debug" # PROP BASE Intermediate_Dir "Debug" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 1 # PROP Output_Dir "Debug" # PROP Intermediate_Dir "Debug" # PROP Ignore_Export_Lib 0 # PROP Target_Dir "" # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c # ADD CPP /nologo /ML /W3 /Gm /GX /ZI /I "." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c # SUBTRACT CPP /Fr # ADD BASE RSC /l 0x409 /d "_DEBUG" # ADD RSC /l 0x409 /i "..\..\icons" /d "_DEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept # Begin Special Build Tool TargetPath=.\Debug\hugs.exe SOURCE="$(InputPath)" PostBuild_Desc=Install hugs binary PostBuild_Cmds=copy $(TargetPath) ..\ # End Special Build Tool !ENDIF # Begin Target # Name "hugs - Win32 Release" # Name "hugs - Win32 Debug" # Begin Group "Source Files" # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" # Begin Source File SOURCE=..\builtin.c # End Source File # Begin Source File SOURCE=..\compiler.c # End Source File # Begin Source File SOURCE=..\ffi.c # End Source File # Begin Source File SOURCE=..\hugs.c # End Source File # Begin Source File SOURCE=..\input.c # End Source File # Begin Source File SOURCE=..\machine.c # End Source File # Begin Source File SOURCE=..\output.c # End Source File # Begin Source File SOURCE=..\plugin.c # End Source File # Begin Source File SOURCE=..\static.c # End Source File # Begin Source File SOURCE=..\storage.c # End Source File # Begin Source File SOURCE=..\subst.c # End Source File # Begin Source File SOURCE=..\type.c # End Source File # Begin Source File SOURCE=..\version.c # End Source File # End Group # Begin Group "Header Files" # PROP Default_Filter "h;hpp;hxx;hm;inl" # Begin Source File SOURCE=..\command.h # End Source File # Begin Source File SOURCE=..\config.h # End Source File # Begin Source File SOURCE=..\connect.h # End Source File # Begin Source File SOURCE=..\errors.h # End Source File # Begin Source File SOURCE=..\options.h # End Source File # Begin Source File SOURCE=..\prelude.h # End Source File # Begin Source File SOURCE=..\server.h # End Source File # Begin Source File SOURCE=..\storage.h # End Source File # Begin Source File SOURCE=..\subst.h # End Source File # Begin Source File SOURCE=..\version.h # End Source File # End Group # Begin Group "Resource Files" # PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe" # Begin Source File SOURCE=.\hugs.rc # End Source File # End Group # Begin Group "yacc files" # PROP Default_Filter "y" # Begin Source File SOURCE=..\parser.y # End Source File # End Group # End Target # End Project hugs98-plus-Sep2006/src/msc/hugs.dsw0000644006511100651110000000124707336346521016036 0ustar rossrossMicrosoft Developer Studio Workspace File, Format Version 6.00 # WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE! ############################################################################### Project: "hugs"=.\hugs.dsp - Package Owner=<4> Package=<5> {{{ }}} Package=<4> {{{ }}} ############################################################################### Project: "runhugs"=.\runhugs.dsp - Package Owner=<4> Package=<5> {{{ }}} Package=<4> {{{ }}} ############################################################################### Global: Package=<5> {{{ }}} Package=<3> {{{ }}} ############################################################################### hugs98-plus-Sep2006/src/msc/hugs.rc0000644006511100651110000000002607412405423015627 0ustar rossross0 ICON "hugsicon.ico" hugs98-plus-Sep2006/src/msc/hugs.sln0000644006511100651110000000350210423700223016011 0ustar rossrossMicrosoft Visual Studio Solution File, Format Version 8.00 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "hugs", "hugs.vcproj", "{705885EA-3D93-4ADC-8820-DEE50A79E76B}" ProjectSection(ProjectDependencies) = postProject EndProjectSection EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "runhugs", "runhugs.vcproj", "{D61C0FB3-4D9D-46CF-B89B-E295CC91E38C}" ProjectSection(ProjectDependencies) = postProject EndProjectSection EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "ffihugs", "ffihugs.vcproj", "{7F28DDDF-EA93-45EE-93B4-AF476392B680}" ProjectSection(ProjectDependencies) = postProject EndProjectSection EndProject Global GlobalSection(SolutionConfiguration) = preSolution Debug = Debug Release = Release EndGlobalSection GlobalSection(ProjectConfiguration) = postSolution {705885EA-3D93-4ADC-8820-DEE50A79E76B}.Debug.ActiveCfg = Debug|Win32 {705885EA-3D93-4ADC-8820-DEE50A79E76B}.Debug.Build.0 = Debug|Win32 {705885EA-3D93-4ADC-8820-DEE50A79E76B}.Release.ActiveCfg = Release|Win32 {705885EA-3D93-4ADC-8820-DEE50A79E76B}.Release.Build.0 = Release|Win32 {D61C0FB3-4D9D-46CF-B89B-E295CC91E38C}.Debug.ActiveCfg = Debug|Win32 {D61C0FB3-4D9D-46CF-B89B-E295CC91E38C}.Debug.Build.0 = Debug|Win32 {D61C0FB3-4D9D-46CF-B89B-E295CC91E38C}.Release.ActiveCfg = Release|Win32 {D61C0FB3-4D9D-46CF-B89B-E295CC91E38C}.Release.Build.0 = Release|Win32 {7F28DDDF-EA93-45EE-93B4-AF476392B680}.Debug.ActiveCfg = Debug|Win32 {7F28DDDF-EA93-45EE-93B4-AF476392B680}.Debug.Build.0 = Debug|Win32 {7F28DDDF-EA93-45EE-93B4-AF476392B680}.Release.ActiveCfg = Release|Win32 {7F28DDDF-EA93-45EE-93B4-AF476392B680}.Release.Build.0 = Release|Win32 EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution EndGlobalSection GlobalSection(ExtensibilityAddIns) = postSolution EndGlobalSection EndGlobal hugs98-plus-Sep2006/src/msc/hugs.vcproj0000644006511100651110000002555010305440735016537 0ustar rossross hugs98-plus-Sep2006/src/msc/options.h0000644006511100651110000002010610426134734016203 0ustar rossross/* ../options.h. Generated automatically by configure. */ /* -------------------------------------------------------------------------- * Configuration options * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: options.h,v $ * $Revision: 1.22 $ * $Date: 2006/05/03 14:10:36 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Hugs paths and directories * ------------------------------------------------------------------------*/ /* Define this as the default setting of HUGSPATH. * Value may contain string "{Hugs}" (for which we will substitute the * value of HUGSDIR) and should be either colon-separated (Unix) * or semicolon-separated (Macintosh, Windows, DOS). Escape * characters in the path string are interpreted according to normal * Haskell conventions. * * This value can be overridden from the command line by setting the * HUGSFLAGS environment variable or by storing an appropriate value * for HUGSFLAGS in the registry (Win32 only). In all cases, use a * string of the form -P"...". */ #define HUGSPATH ".;{Hugs}\\packages\\*" /* The list of suffixes used by Haskell source files, separated either * by colons (Unix) or semicolons (Macintosh, Windows, DOS). * * This value can be overridden using the -S flag. */ #define HUGSSUFFIXES ".hs;.lhs" /* The directory name which is substituted for the string "{Hugs}" * in a path variable. This normally points to where the Hugs libraries * are installed - ie so that the file HUGSDIR/lib/Prelude.hs exists * Typical values are: * "/usr/local/lib/hugs" * "/usr/homes/JFHaskell/hugs" * ".." * * This value is ignored on Windows and Macintosh versions since * it is assumed that the binary is installed in HUGSDIR. * * This value cannot be overridden from the command line or by using * environment variables. This isn't quite as limiting as you'd think * since you can always choose _not_ to use the {Hugs} variable - however, * it's obviously _nicer_ to have it set correctly. */ #ifndef HUGSDIR #define HUGSDIR "" #endif /* -------------------------------------------------------------------------- * User interface options * ------------------------------------------------------------------------*/ /* Define if you want to use the "Hugs for Windows" GUI. * (Windows 3.1 and compatibles only) */ /* #undef HUGS_FOR_WINDOWS */ /* Define if you want filenames to be converted to normal form by: * o replacing relative pathnames with absolute pathnames and * eliminating .. and . where possible. * o converting to lower case (only in case-insensitive filesystems) */ /* #undef PATH_CANONICALIZATION */ /* Define if a command line editor is available and should be used. * There are two choices of command line editor that can be used with Hugs: * GNU readline and editline (from comp.sources.misc, vol 31, issue 71) */ /* #undef USE_READLINE */ /* Define if you want the small startup banner. */ /* #undef SMALL_BANNER */ /* -------------------------------------------------------------------------- * Making Hugs smaller * ------------------------------------------------------------------------*/ /* Define one of these to select overall size of Hugs * SMALL_HUGS for 16 bit operation on a limited memory PC. * REGULAR_HUGS for 32 bit operation using largish default table sizes. * LARGE_HUGS for 32 bit operation using larger default table sizes. */ /* #undef SMALL_HUGS */ /* #undef REGULAR_HUGS */ #define LARGE_HUGS 1 /* -------------------------------------------------------------------------- * Fancy features * ------------------------------------------------------------------------*/ /* Define to omit Hugs extensions */ /* #undef HASKELL_98_ONLY */ /* Define if :xplain should be enabled */ /* #undef EXPLAIN_INSTANCE_RESOLUTION */ /* Define if heap profiling should be used */ /* #undef PROFILING */ /* Define if you want to run Haskell code through a preprocessor * * Note that there's the import chasing mechanism will not spot any * #includes so you must :load (not :reload) if you change any * (non-Haskell) configurations files. */ #define USE_PREPROCESSOR 1 /* Define if you want to time every evaluation. * * Timing is included in the Hugs distribution for the purpose of benchmarking * the Hugs interpreter, comparing its performance across a variety of * different machines, and with other systems for similar languages. * * It would be somewhat foolish to try to use the timings produced in this * way for any other purpose. In particular, using timings to compare the * performance of different versions of an algorithm is likely to give very * misleading results. The current implementation of Hugs as an interpreter, * without any significant optimizations, means that there are much more * significant overheads than can be accounted for by small variations in * Hugs code. */ /* #undef WANT_TIMER */ /* * By default, the Hugs Server API wraps up each value pushed on the stack * as a Dynamic, achieving some run-time type safety when applying these * arguments to a function. This Dynamic layer sometimes gets in the way * for low-level consumers of the Server API (e.g, HaskellScript, Lambada, * mod_haskell), so by setting NO_DYNAMIC_TYPES to 1 you turn off the * use of Dynamics (and assume all the responsibility of debugging any * bad crashes you might see as a result!) */ /* #undef NO_DYNAMIC_TYPES */ /* -------------------------------------------------------------------------- * Debugging options (intended for use by maintainers) * ------------------------------------------------------------------------*/ /* Define if debugging generated bytecodes or the bytecode interpreter */ /* #undef DEBUG_CODE */ /* Define if debugging generated supercombinator definitions or compiler */ /* #undef DEBUG_SHOWSC */ /* Define if you want to use a low-level printer from within a debugger */ /* #undef DEBUG_PRINTER */ /* Define if you want to perform runtime tag-checks as an internal * consistency check. This makes Hugs run very slowly - but is very * effective at detecting and locating subtle bugs. */ /* #undef CHECK_TAGS */ /* -------------------------------------------------------------------------- * Experimental features * These are likely to disappear/change in future versions and should not * be used by most people.. * ------------------------------------------------------------------------*/ /* Define if you want to use the primitives which let you examine Hugs * internals. */ /* #undef INTERNAL_PRIMS */ /* Define if you want to use the primitives which let you examine Hugs * bytecodes (requires INTERNAL_PRIMS). */ /* #undef BYTECODE_PRIMS */ /* In a plain Hugs system, most signals (SIGBUS, SIGTERM, etc) indicate * some kind of error in Hugs - or maybe a stack overflow. Rather than * just crash, Hugs catches these errors and returns to the main loop. * It does this by calling a function "panic" which longjmp's back to the * main loop. * If you're developing a GreenCard library, this may not be the right * behaviour - it's better if Hugs leaves them for your debugger to * catch rather than trapping them and "panicing". */ /* #undef DONT_PANIC */ /* If you get really desperate to understand why your Hugs programs keep * crashing or running out of stack, you might like to set this flag and * recompile Hugs. When you hit a stack error, it will print out a list * of all the objects currently under evaluation. The information isn't * perfect and can be pretty hard to understand but it's better than a * poke in the eye with a blunt stick. * * This is a very experimental feature! */ /* #undef GIMME_STACK_DUMPS */ /* ----------------------------------------------------------------------- */ hugs98-plus-Sep2006/src/msc/platform.h0000755006511100651110000000137610173332277016350 0ustar rossross/* * configure-sussed platform #defines. */ #ifndef __PLATFORM_H__ #define __PLATFORM_H__ #define HostPlatform i386_unknown_msvc #define TargetPlatform i386_unknown_msvc #define BuildPlatform i386_unknown_msvc /* Definitions suitable for use in CPP conditionals */ #define i386_unknown_msvc_HOST 1 #define i386_unknown_msvc_TARGET 1 #define i386_unknown_msvc_BUILD 1 #define i386_HOST_ARCH 1 #define i386_TARGET_ARCH 1 #define i386_BUILD_ARCH 1 #define msvc_HOST_OS 1 #define msvc_TARGET_OS 1 #define msvc_BUILD_OS 1 /* Definitions of strings for use in C or Haskell code */ #define HOST_ARCH "i686" #define TARGET_ARCH "i686" #define BUILD_ARCH "i686" #define HOST_OS "msvc" #define TARGET_OS "msvc" #define BUILD_OS "msvc" #endif /* __PLATFORM_H__ */ hugs98-plus-Sep2006/src/msc/runhugs.dsp0000644006511100651110000001260007556071501016544 0ustar rossross# Microsoft Developer Studio Project File - Name="runhugs" - Package Owner=<4> # Microsoft Developer Studio Generated Build File, Format Version 6.00 # ** DO NOT EDIT ** # TARGTYPE "Win32 (x86) Console Application" 0x0103 CFG=runhugs - Win32 Debug !MESSAGE This is not a valid makefile. To build this project using NMAKE, !MESSAGE use the Export Makefile command and run !MESSAGE !MESSAGE NMAKE /f "runhugs.mak". !MESSAGE !MESSAGE You can specify a configuration when running NMAKE !MESSAGE by defining the macro CFG on the command line. For example: !MESSAGE !MESSAGE NMAKE /f "runhugs.mak" CFG="runhugs - Win32 Debug" !MESSAGE !MESSAGE Possible choices for configuration are: !MESSAGE !MESSAGE "runhugs - Win32 Release" (based on "Win32 (x86) Console Application") !MESSAGE "runhugs - Win32 Debug" (based on "Win32 (x86) Console Application") !MESSAGE # Begin Project # PROP AllowPerConfigDependencies 0 # PROP Scc_ProjName "" # PROP Scc_LocalPath "" CPP=cl.exe RSC=rc.exe !IF "$(CFG)" == "runhugs - Win32 Release" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "Release" # PROP BASE Intermediate_Dir "Release" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "Release" # PROP Intermediate_Dir "Release" # PROP Target_Dir "" # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c # ADD CPP /nologo /W3 /GX /O2 /I "msc" /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c # ADD BASE RSC /l 0x409 /d "NDEBUG" # ADD RSC /l 0x409 /d "NDEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 # Begin Special Build Tool SOURCE="$(InputPath)" PostBuild_Desc=Installing runhugs binary PostBuild_Cmds=copy runhugs.exe ..\ # End Special Build Tool !ELSEIF "$(CFG)" == "runhugs - Win32 Debug" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 1 # PROP BASE Output_Dir "runhugs___Win32_Debug" # PROP BASE Intermediate_Dir "runhugs___Win32_Debug" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 1 # PROP Output_Dir "runhugs___Win32_Debug" # PROP Intermediate_Dir "runhugs___Win32_Debug" # PROP Ignore_Export_Lib 0 # PROP Target_Dir "" # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c # ADD CPP /nologo /W3 /Gm /GX /ZI /Od /I "." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c # ADD BASE RSC /l 0x409 /d "_DEBUG" # ADD RSC /l 0x409 /i "..\..\icons" /d "_DEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept # Begin Special Build Tool TargetPath=.\runhugs___Win32_Debug\runhugs.exe SOURCE="$(InputPath)" PostBuild_Desc=Installing runhugs binary PostBuild_Cmds=copy $(TargetPath) ..\ # End Special Build Tool !ENDIF # Begin Target # Name "runhugs - Win32 Release" # Name "runhugs - Win32 Debug" # Begin Group "Source Files" # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" # Begin Source File SOURCE=..\builtin.c # End Source File # Begin Source File SOURCE=..\compiler.c # End Source File # Begin Source File SOURCE=..\ffi.c # End Source File # Begin Source File SOURCE=..\input.c # End Source File # Begin Source File SOURCE=..\machine.c # End Source File # Begin Source File SOURCE=..\output.c # End Source File # Begin Source File SOURCE=..\plugin.c # End Source File # Begin Source File SOURCE=..\runhugs.c # End Source File # Begin Source File SOURCE=..\server.c # End Source File # Begin Source File SOURCE=..\static.c # End Source File # Begin Source File SOURCE=..\storage.c # End Source File # Begin Source File SOURCE=..\subst.c # End Source File # Begin Source File SOURCE=..\type.c # End Source File # Begin Source File SOURCE=..\version.c # End Source File # End Group # Begin Group "Header Files" # PROP Default_Filter "h;hpp;hxx;hm;inl" # Begin Source File SOURCE=..\command.h # End Source File # Begin Source File SOURCE=.\config.h # End Source File # Begin Source File SOURCE=..\connect.h # End Source File # Begin Source File SOURCE=..\errors.h # End Source File # Begin Source File SOURCE=.\options.h # End Source File # Begin Source File SOURCE=..\prelude.h # End Source File # Begin Source File SOURCE=..\server.h # End Source File # Begin Source File SOURCE=..\storage.h # End Source File # Begin Source File SOURCE=..\subst.h # End Source File # Begin Source File SOURCE=..\version.h # End Source File # End Group # Begin Group "Resource Files" # PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe" # Begin Source File SOURCE=.\runhugs.rc # End Source File # End Group # End Target # End Project hugs98-plus-Sep2006/src/msc/runhugs.rc0000644006511100651110000000002507412405423016353 0ustar rossross0 ICON "hsxicon.ico" hugs98-plus-Sep2006/src/msc/runhugs.vcproj0000644006511100651110000002710510305440735017262 0ustar rossross hugs98-plus-Sep2006/src/unix/0000755006511100651110000000000010504340136014531 5ustar rossrosshugs98-plus-Sep2006/src/unix/.cvsignore0000644006511100651110000000002010207437527016534 0ustar rossrossBuildFFI config hugs98-plus-Sep2006/src/unix/README0000644006511100651110000000606110004333354015413 0ustar rossrossAn overview of Hugs configuration ================================= [This is out of date] We use GNU's autoconf to determine the configuration of the target platform. See docs/building/unix.txt for Unix instructions and Hugs-specific configure options. See docs/building/config.txt for general configure options. [Note: all configuration scripts should be run from the directory containing the script - but I'll use full paths when discussing scripts so that you can find them.] Windows/DOS ~~~~~~~~~~~ On Windows/DOS, you can only run the configuration scripts if you have the cygnus tools installed (version 16beta; version 17 seems to have a bug that crashes the configure script). Even if you have the tools installed, the configuration script won't run directly because: 1) The configure script uses Unix features like /dev/null that don't exist on DOS. 2) The configure script assumes that C compilers follow Unix traditions when interpreting their command arguments. All DOS compilers we've tried use radically different syntax for their command line arguments. To overcome these problems, the files src/{msc,bcc32,bcc16,win32,win16,djgpp2}/config.sh contain scripts which make the configure scripts run (through a combination of patching the configure script, override default values, etc). [The djgpp2 script crashes near the end - however, the results it prints up to that point are useful for creating configuration files by hand.] In fact, we rarely run these scripts directly. Instead, we run src/unix/mkconfigs which runs all the scripts with appropriate arguments and makes copies of the generated files (Makefile, config.h and options.h) in appropriate subdirectories. These copies are for the benefit of people who can't run the configure scripts directly. They cannot be expected to match all machines perfectly (since the configuration script only checked what was happening on my machine) - but they chould be pretty close and they are well commented. (I don't think it's possible to do any better - without writing a version of autoconf which works on all DOS machines.) The prebuilt copies are stored in subdirectories of src and can be installed by running one of src/{msc,bcc32,bcc16,win32,win16,djgpp2}/config.bat (If you're running bash, "cmd Modifying the configure script ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If you're modifying Hugs or porting it to a new platform, you might need to extend the configure script. The steps are: 1) Get a recent copy of autoconf. (We use version 2.57.) 2) Read the autoconf documentation. (If all you need to do is test whether /usr/include/sys/foo.h exists - you can probably figure it out without reading the docs.) 3) Edit src/unix/configure.in in whatever way you like. 4) Run src/unix/mkconfig. This uses autoconf to generate src/unix/configure and it uses autoheader to generate src/config.h.in (You need version 2.13 of autoheader for this -- more recent versions don't work.) 5) Send patches to hugs-bugs@haskell.org (please). hugs98-plus-Sep2006/src/unix/linking_notes0000644006511100651110000000647707507723001017342 0ustar rossrossThe following notes may provide some guidance in figuring out how to do dynamic linking on various platforms. Our goal is to transfer any useful information into the configure script (and delete the rest). Comments from the HGL Makefile # The following choices have been found to be appropriate for building # shared object files on various systems. # Please let us know if these don't work or if you know the appropriate # choice for other systems. LDFLAGS_MKSO.Linux = -shared LDFLAGS_MKSO.FreeBSD = -shared LDFLAGS_MKSO.NetBSD = -shared LDFLAGS_MKSO.SunOS = -G LDFLAGS_MKSO.MacOSX = -bundle -lc LDFLAGS_MKSO.Unixlike = -shared Comments from the Win32 sources \section{Building dlls} It is very hard to find decent documentation about how to construct a DLL. This is some of what I found out. \subsection{Perl configuration} Perl's Configure script has this to say: Some systems may require passing special flags to ld to create a library that can be dynamically loaded. If your ld flags include -L/other/path options to locate libraries outside your loader's normal search path, you may need to specify those -L options here as well. To use no flags, say "none". \begin{verbatim} case "$osname" in hpux) dflt='-b' ;; linux) dflt='-shared' ;; next) dflt='none' ;; solaris) dflt='-G' ;; sunos) dflt='-assert nodefinitions' ;; svr4*|esix*) dflt="-G $ldflags" ;; *) dflt='none' ;; esac \end{verbatim} Some systems use ld to create libraries that can be dynamically loaded, while other systems (such as those using ELF) use cc. Some systems may require passing special flags to cc to indicate that the resulting executable will use dynamic linking. To use no flags, say "none". \begin{verbatim} case "$osname" in hpux) dflt='-Wl,-E' ;; linux) dflt='-rdynamic' ;; next) dflt='none' ;; sunos) dflt='none' ;; *) dflt='none' ;; esac ;; \end{verbatim} \subsection{Hugs configuration} This quote from Hugs/Install describes what little I could find out about dynamic linking. I wish I'd looked at perl earlier. \begin{verbatim} Here's a list of what to do on the compilers we know about. Visual C++ (4.2 and 5.0): Nothing to do: the distributed Makefile uses DLL_FLAGS=/LD Borland C: ??? We couldn't figure out how to make DLLs with Borland C. Linux + gcc 2.7.2: env "DLL_FLAGS=-shared -nostdlib" ./configure --with-plugins Solaris + gcc (2.6.3 and 2.7.2): env "DLL_FLAGS=-shared -nostdlib -fPIC" ./configure --with-plugins Solaris + /opt/SUNWspro/bin/cc: env "DLL_FLAGS=-G" ./configure --with-plugins Here's what little we know about building shared object files on other machines. We'd be delighted if you could tell us what changes you need to make to the Makefile to build a working Xlib.so file. (And don't forget that static linking is a viable option!) ??? Sunos4 + gcc 2.4.5: env "DLL_FLAGS=-r" ./configure --with-plugins cd .. make Xlib.so chmod 111 Xlib.so ??? Sunos4 + acc acc -pic -c Foo.c ld -assert pure-text Foo.o -o Foo.so ??? HPUX + cc cc -D_HPUX_SOURCE -Aa +z -c Foo.c ld -b Foo.o -o Foo.so \end{verbatim} hugs98-plus-Sep2006/src/unix/mkconfigs0000755006511100651110000000157606727055603016466 0ustar rossross#! /bin/sh # This script should be run on Windows # set DOITPROG to echo to test this script doit="${DOITPROG-}" build() { echo "# Configuring $1" ${doit} cd ../$1 shift ${doit} rm -f config.cache ${doit} ./config.sh $* # echo "Copying ../Makefile, ../config.h and ../options.h to ." ${doit} cp -f ../Makefile ../config.h ../options.h . ${doit} cd ../unix } ################################################################ # Start ################################################################ # No - doesn't work properly on Windows # ${doit} ./mkconfig build msc --with-plugins --with-nmake build bcc32 build win32 # build bcc16 --datadir="c:" --enable-path-canonicalization # build win16 --datadir="c:" --enable-path-canonicalization echo " Don't forget you have to update the djgpp2 files. " ################################################################ hugs98-plus-Sep2006/src/unix/mkunitable0000755006511100651110000000505710000552253016615 0ustar rossross#!/bin/sh # -------------------------------------------------------------------------- # This is the script to create the Unicode chars property table. # It expects a UnicodeData file (obtainable from http://www.unicode.org/ucd/) # as argument, and produces C code on its standard output. This C code # should be included in char.c. See unitable.h for relevant definitions. # # Written by Dimitry Golubovsky (dimitry@golubovsky.org) as part of basic # Unicode support. # # The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the # Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, # 1994-2003, All rights reserved. It is distributed as free software under # the license in the file "License", which is included in the distribution. # ------------------------------------------------------------------------- case $# in 1) ;; *) echo "usage: $0 unidata-file" >&2 exit 1 ;; esac # Output the file header echo "/*---------------------------------------------------- This is an automatically generated file: DO NOT EDIT. Generated by $0 from `basename $1`, which was obtained from http://www.unicode.org/ucd/ -----------------------------------------------------*/ " # Convert the file to the C table awk ' BEGIN { FS = ";" num_props = 0 num_blocks = 0 first_code = -1 digits = "0123456789ABCDEF" for (i=0; i<16; i++) hex[substr(digits,i+1,1)] = i } function readhex(a) { l = length(a) acc = 0 for (i=1; i<=l; i++) acc = acc*16+hex[substr(a,i,1)] return acc } function endblock() { if (first_code >= 0) { blocks[num_blocks] = block_start ", " (next_code-first_code) ", &prop" props[block_prop] num_blocks++ } block_start = hex_code first_code = this_code block_prop = prop } { hex_code = "0x" $1 this_code = readhex($1) name = $2 cat = $3 updist = $13 == "" ? 0 : readhex($13) - this_code lowdist = $14 == "" ? 0 : readhex($14) - this_code ttldist = $15 == "" ? 0 : readhex($15) - this_code prop = "GENCAT_" cat ", " updist ", " lowdist ", " ttldist if (props[prop] == "") props[prop] = num_props++ if (index(name, "Last>") == 0 && (this_code != next_code || prop != block_prop)) endblock() next_code = this_code+1 } END { endblock() print "#define NUM_BLOCKS " num_blocks print "" for (p in props) props_inv[props[p]] = p for (i=0; i #ifdef _DEBUG # define Assert(a) if (!(a)) _asm int 3; # define AssertD(a)if (!(a)) _asm int 3; //use if it has to create extra data to Assert on #else # define Assert(a) __assume(a); //Microsoft specific, speed up programs # define AssertD(a) //nothing #endif #if defined(_DEBUG) && defined(ERR_BREAK) # define ErrMsg(a) _asm int 3; #else # define ErrMsg(a) //nothing #endif //to remove Compression define NO_COMPRESSION #define NO_COMPRESSION //Make good programming practice #ifndef PLAY_NICELY #define malloc MALLOC_IS_OLD #define free FREE_IS_OLD #define strdup STRDUP_IS_OLD #define BOOL BOOL_IS_FOR_CRAP_C_COMPILERS_ONLY #endif //!PLAY_NICELY typedef unsigned char u8; typedef unsigned short u16; typedef unsigned long u32; typedef unsigned int uint; // Macros for reading shorts and longs from an array of bytes u16 inline stream16(char* b, int i) { return *((u16*) &b[i]); } u32 inline stream32(char* b, int i) { return *((u32*) &b[i]); } class datLocal; class datCentral; class datEnd; #include "General.h" #include "FileIO.h" #include "Structs.h" class BlueZip; class zList; class fList; #include "BlueZip.h" #include "zList.h" #include "fList.h" //From CRC void CRC(const u8* buf, uint len); void InitCRC(); u32 GetCRC(); //From Store.cpp void ReadStore(File In, File Out, zList* z); void WriteStore(File In, File Out, zList* z); hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/BlueZip.cpp0000644006511100651110000000323510321204023022651 0ustar rossross#include "BlueHead.h" void BlueZip::Setup(LPCTSTR FileName) { this->FileName = CopyString(FileName); //Initialise for a blank file name Files = NULL; Comment = NULL; data.lComment = 0; #ifndef NO_COMPRESSION Pending = NULL; #endif } BlueZip::~BlueZip() { delete[] FileName; if (Comment) delete[] Comment; while (Files != NULL) { zList* z = Files; Files = Files->next; delete z; } #ifndef NO_COMPRESSION while (Pending != NULL) { fList* f = Pending; Pending = Pending->next; delete f; } #endif } #ifndef NO_COMPRESSION void BlueZip::AddFile(LPCTSTR FileName) { Pending = new fList(FileName, Pending); } void BlueZip::WriteEnd(File f) { //Handle mutliple disks correctly (i.e. don't) data.DiskNo = 0; data.DiskOne = 0; data.DiskNum = data.Count; long l = sigEnd; FileWrite(f, &l, 4); data.Write(f); if (data.lComment) FileWrite(f, Comment, data.lComment); } #endif //!NO_COMPRESSION void BlueZip::ReadEnd(File f) { data.Read(f); if (data.lComment) { Comment = new char[data.lComment]; FileRead(f, Comment, data.lComment); } } bool BlueZip::GetFile(zList* z, LPCTSTR FileName) { //First open the ZIP file for reading File Orig = FileOpenRead(this->FileName); if (!FileValid(Orig)) { ErrMsg("Failed to open the reading file"); return false; } File Out = FileOpenWrite(FileName); if (!FileValid(Out)) { ErrMsg("Failed to open the output file"); return false; } //Perform CRC checks yourself InitCRC(); SeekBeg(Orig, z->data.Offset + FilePosDelta); ReadStore(Orig, Out, z); if (z->data.CRC != GetCRC()) { ErrMsg("Failed on the CRC"); return false; } FileClose(Orig); FileClose(Out); return true; } hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/BlueZip.h0000644006511100651110000000156310321204023022320 0ustar rossross class __declspec(dllexport) BlueZip { private: datEnd data; // The end header char* Comment; // Actual comment int FilePosDelta; // The value added to begin seeks to compenstate for SFX headers LPTSTR FileName; //Used by ReadFile bool ScanZip(File f); void ReadEnd(File f); void Setup(LPCTSTR FileName); #ifndef NO_COMPRESSION fList* Pending; // List of names to add void WriteEnd(File f); //fList** PendingNext; - Implement this to add in order #endif public: zList* Files; // A point to the first file in the ZIP BlueZip(){}; BlueZip(LPCTSTR FileName){Setup(FileName);} void SetZipFile(LPCTSTR FileName){Setup(FileName);} ~BlueZip(); bool Read(); //Load the file into memory #ifndef NO_COMPRESSION bool Write(bool Store = false); //Write the file back out void AddFile(LPCTSTR FileName); #endif bool GetFile(zList* z, LPCTSTR FileName); }; hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/CRC.cpp0000644006511100651110000001077410321204023021714 0ustar rossross#include "BlueHead.h" //Create a CRC value for a buffer //First define the table const u32 CrcTable[256] = { 0x00000000L, 0x77073096L, 0xee0e612cL, 0x990951baL, 0x076dc419L, 0x706af48fL, 0xe963a535L, 0x9e6495a3L, 0x0edb8832L, 0x79dcb8a4L, 0xe0d5e91eL, 0x97d2d988L, 0x09b64c2bL, 0x7eb17cbdL, 0xe7b82d07L, 0x90bf1d91L, 0x1db71064L, 0x6ab020f2L, 0xf3b97148L, 0x84be41deL, 0x1adad47dL, 0x6ddde4ebL, 0xf4d4b551L, 0x83d385c7L, 0x136c9856L, 0x646ba8c0L, 0xfd62f97aL, 0x8a65c9ecL, 0x14015c4fL, 0x63066cd9L, 0xfa0f3d63L, 0x8d080df5L, 0x3b6e20c8L, 0x4c69105eL, 0xd56041e4L, 0xa2677172L, 0x3c03e4d1L, 0x4b04d447L, 0xd20d85fdL, 0xa50ab56bL, 0x35b5a8faL, 0x42b2986cL, 0xdbbbc9d6L, 0xacbcf940L, 0x32d86ce3L, 0x45df5c75L, 0xdcd60dcfL, 0xabd13d59L, 0x26d930acL, 0x51de003aL, 0xc8d75180L, 0xbfd06116L, 0x21b4f4b5L, 0x56b3c423L, 0xcfba9599L, 0xb8bda50fL, 0x2802b89eL, 0x5f058808L, 0xc60cd9b2L, 0xb10be924L, 0x2f6f7c87L, 0x58684c11L, 0xc1611dabL, 0xb6662d3dL, 0x76dc4190L, 0x01db7106L, 0x98d220bcL, 0xefd5102aL, 0x71b18589L, 0x06b6b51fL, 0x9fbfe4a5L, 0xe8b8d433L, 0x7807c9a2L, 0x0f00f934L, 0x9609a88eL, 0xe10e9818L, 0x7f6a0dbbL, 0x086d3d2dL, 0x91646c97L, 0xe6635c01L, 0x6b6b51f4L, 0x1c6c6162L, 0x856530d8L, 0xf262004eL, 0x6c0695edL, 0x1b01a57bL, 0x8208f4c1L, 0xf50fc457L, 0x65b0d9c6L, 0x12b7e950L, 0x8bbeb8eaL, 0xfcb9887cL, 0x62dd1ddfL, 0x15da2d49L, 0x8cd37cf3L, 0xfbd44c65L, 0x4db26158L, 0x3ab551ceL, 0xa3bc0074L, 0xd4bb30e2L, 0x4adfa541L, 0x3dd895d7L, 0xa4d1c46dL, 0xd3d6f4fbL, 0x4369e96aL, 0x346ed9fcL, 0xad678846L, 0xda60b8d0L, 0x44042d73L, 0x33031de5L, 0xaa0a4c5fL, 0xdd0d7cc9L, 0x5005713cL, 0x270241aaL, 0xbe0b1010L, 0xc90c2086L, 0x5768b525L, 0x206f85b3L, 0xb966d409L, 0xce61e49fL, 0x5edef90eL, 0x29d9c998L, 0xb0d09822L, 0xc7d7a8b4L, 0x59b33d17L, 0x2eb40d81L, 0xb7bd5c3bL, 0xc0ba6cadL, 0xedb88320L, 0x9abfb3b6L, 0x03b6e20cL, 0x74b1d29aL, 0xead54739L, 0x9dd277afL, 0x04db2615L, 0x73dc1683L, 0xe3630b12L, 0x94643b84L, 0x0d6d6a3eL, 0x7a6a5aa8L, 0xe40ecf0bL, 0x9309ff9dL, 0x0a00ae27L, 0x7d079eb1L, 0xf00f9344L, 0x8708a3d2L, 0x1e01f268L, 0x6906c2feL, 0xf762575dL, 0x806567cbL, 0x196c3671L, 0x6e6b06e7L, 0xfed41b76L, 0x89d32be0L, 0x10da7a5aL, 0x67dd4accL, 0xf9b9df6fL, 0x8ebeeff9L, 0x17b7be43L, 0x60b08ed5L, 0xd6d6a3e8L, 0xa1d1937eL, 0x38d8c2c4L, 0x4fdff252L, 0xd1bb67f1L, 0xa6bc5767L, 0x3fb506ddL, 0x48b2364bL, 0xd80d2bdaL, 0xaf0a1b4cL, 0x36034af6L, 0x41047a60L, 0xdf60efc3L, 0xa867df55L, 0x316e8eefL, 0x4669be79L, 0xcb61b38cL, 0xbc66831aL, 0x256fd2a0L, 0x5268e236L, 0xcc0c7795L, 0xbb0b4703L, 0x220216b9L, 0x5505262fL, 0xc5ba3bbeL, 0xb2bd0b28L, 0x2bb45a92L, 0x5cb36a04L, 0xc2d7ffa7L, 0xb5d0cf31L, 0x2cd99e8bL, 0x5bdeae1dL, 0x9b64c2b0L, 0xec63f226L, 0x756aa39cL, 0x026d930aL, 0x9c0906a9L, 0xeb0e363fL, 0x72076785L, 0x05005713L, 0x95bf4a82L, 0xe2b87a14L, 0x7bb12baeL, 0x0cb61b38L, 0x92d28e9bL, 0xe5d5be0dL, 0x7cdcefb7L, 0x0bdbdf21L, 0x86d3d2d4L, 0xf1d4e242L, 0x68ddb3f8L, 0x1fda836eL, 0x81be16cdL, 0xf6b9265bL, 0x6fb077e1L, 0x18b74777L, 0x88085ae6L, 0xff0f6a70L, 0x66063bcaL, 0x11010b5cL, 0x8f659effL, 0xf862ae69L, 0x616bffd3L, 0x166ccf45L, 0xa00ae278L, 0xd70dd2eeL, 0x4e048354L, 0x3903b3c2L, 0xa7672661L, 0xd06016f7L, 0x4969474dL, 0x3e6e77dbL, 0xaed16a4aL, 0xd9d65adcL, 0x40df0b66L, 0x37d83bf0L, 0xa9bcae53L, 0xdebb9ec5L, 0x47b2cf7fL, 0x30b5ffe9L, 0xbdbdf21cL, 0xcabac28aL, 0x53b39330L, 0x24b4a3a6L, 0xbad03605L, 0xcdd70693L, 0x54de5729L, 0x23d967bfL, 0xb3667a2eL, 0xc4614ab8L, 0x5d681b02L, 0x2a6f2b94L, 0xb40bbe37L, 0xc30c8ea1L, 0x5a05df1bL, 0x2d02ef8dL }; //One atomic operation #define DO1(buf) CRC32(*buf++) #define DO2(buf) DO1(buf); DO1(buf) #define DO4(buf) DO2(buf); DO2(buf) #define DO8(buf) DO4(buf); DO4(buf) //Local variable holding the CRC value: u32 CrcRegister; void inline CRC32(u8 b) { CrcRegister = CrcTable[((int)CrcRegister ^ b) & 0xff] ^ (CrcRegister >> 8); } void InitCRC() { //Do the inversion at this stage, save the odd clock cycle CrcRegister = 0xffffffffL; } u32 GetCRC() { //Check code is compatible with ZIP code, may vary based on word size Assert((CrcRegister ^ 0xffffffffL) == ~CrcRegister); return ~CrcRegister; } void CRC(const u8* buf, uint len) { //crc - the shift register //buf - the buffer containing the data //len - the length of the buffer // Run a set of bytes through the crc shift register. If buf is a NULL // pointer, then initialize the crc shift register contents instead. // Return the current crc in either case. if (buf == NULL) return; //unroll the loops for (; len >= 8; len -= 8) { //Will be expanded to 8 different calls DO8(buf); } for (; len /* >= 1 */; len--) { DO1(buf); } } hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/CompHead.h0000644006511100651110000000214110321204023022417 0ustar rossross#include "BlueHead.h" #define error(a) _asm int 3 const uint MinMatch = 3; const uint MaxMatch = 258; /* The minimum and maximum match lengths */ const uint WSize = 0x8000; /* Maximum window size = 32K. If you are really short of memory, compile * with a smaller WSIZE but this reduces the compression ratio for files * of size > WSIZE. WSIZE must be a power of two in the current implementation. */ const uint MinLookahead = (MaxMatch + MinMatch + 1); /* Minimum amount of lookahead, except at the end of the input file. * See deflate.c for comments about the MIN_MATCH+1. */ const uint MaxDist = (WSize - MinLookahead); /* In order to simplify the code, particularly on 16 bit machines, match * distances are limited to MAX_DIST instead of WSIZE. */ /* Public globals */ void flush_outbuf(char *, unsigned *); uint ReadBuf(char *buf, unsigned size); /* in deflate.c */ void LmInit(); u32 Deflate(); /* in trees.c */ void ct_init (int *); bool ct_tally (int, int); u32 flush_block (char far *, u32, int); void bi_init (char *, unsigned int, int); hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/DefTree.cpp0000644006511100651110000000140510321204023022612 0ustar rossross#include "CompHead.h" #ifndef NO_COMPRESSION #ifdef _DEBUG extern u32 isize; /* byte length of input file, for debug only */ #endif File ifile; /* file to compress */ File zfile; /* output zip file */ void SetupDeftree(File In, File Out, int my_level) { ifile = In; zfile = Out; } uint ReadBuf(char* buf, uint size) { //IN assertion: size >= 2 (for end-of-line translation) //Do not do end of line translation, who cares (use TextPad!) const uint len = FileReadBuf(ifile, buf, size); if (len != 0) CRC((u8*) buf, len); #ifdef _DEBUG isize += (u32) len; #endif return len; } void flush_outbuf(char* buf, uint* size) { if (*size != 0) { FileWrite(zfile, buf, *size); } *size = 0; } #endif //!NO_COMPRESSIONhugs98-plus-Sep2006/src/winhugs/installer/BlueZip/Deflate.cpp0000644006511100651110000004232610321204023022647 0ustar rossross#include "CompHead.h" //exclude from some builds #ifndef NO_COMPRESSION //PUBLIC SECTION #ifdef _DEBUG unsigned long isize; #endif //END PUBLIC SECTION //INIT SECTION char FileOutbuf[1024]; // output buffer for compression to file //END const uint HashBits = 15; // Number of bits used to hash strings const uint HashSize (1 << HashBits); const uint HashMask = HashSize - 1; const uint WMask = (WSize - 1); // HASH_SIZE and WSIZE must be powers of two const uint NIL = 0; // Tail of hash chains const uint TooFar = 4096; // Matches of length 3 are discarded if their distance exceeds TOO_FAR // =========================================================================== // Local data used by the "longest match" routines. typedef u16 Pos; typedef uint IPos; // A Pos is an index in the character window. We use short instead of int to // save space in the various tables. IPos is used only for parameter passing. u8 Window[2 * WSize]; // Sliding window. Input bytes are read into the second half of the window, // and move to the first half later to keep a dictionary of at least WSIZE // bytes. With this organization, matches are limited to a distance of // WSIZE-MAX_MATCH bytes, but this ensures that IO is always // performed with a length multiple of the block size. Also, it limits // the window size to 64K, which is quite useful on MSDOS. Pos Prev[WSize]; // Link to older string with same hash index. To limit the size of this // array to 64K, this link is maintained only for the last 32K strings. // An index in this array is thus a window index modulo 32K. Pos Head[HashSize]; // Heads of the hash chains or NIL. If your compiler thinks that // HASH_SIZE is a dynamic value, recompile with -DDYN_ALLOC. const u32 WindowSize = 2 * WSize; // The size of the window long BlockStart; // window position at the beginning of the current output block. Gets // negative when the window is moved backwards. uint InsH; // hash index of string to be inserted const uint HShift = ((HashBits + MinMatch - 1) / MinMatch); // Number of bits by which ins_h and del_h must be shifted at each // input step. It must be such that after MIN_MATCH steps, the oldest // byte no longer takes part in the hash key, that is: // H_SHIFT * MIN_MATCH >= HASH_BITS uint PrevLength; // Length of the best match at previous step. Matches not greater than this // are discarded. This is used in the lazy match evaluation. uint StrStart; // start of string to insert uint MatchStart; // start of matching string bool EOFile; // flag set at end of input file uint LookAhead; // number of valid bytes ahead in window //Parameters for compression mode const uint MaxChainLength = 4096; // To speed up deflation, hash chains are never searched beyond this length. // A higher limit improves compression ratio but degrades the speed. const uint MaxLazyMatch = 258; // Attempt to find a better match only when the current match is strictly // smaller than this value. This mechanism is used only for compression // levels >= 4. const uint GoodMatch = 32; // Use a faster search when the previous match is longer than this int NiceMatch; // Stop searching when current match exceeds this const int Equal = 0; /* result of memcmp for equal strings */ /* =========================================================================== * Prototypes for local functions. */ void FillWindow(); int LongestMatch(IPos CurMatch); #ifdef _DEBUG void CheckMatch(IPos Start, IPos Match, int Length); #endif /* =========================================================================== * Update a hash value with the given input byte * IN assertion: all calls to to UPDATE_HASH are made with consecutive * input characters, so that a running hash key can be computed from the * previous key instead of complete recalculation each time. */ void inline UpdateHash(u8 b) { InsH = ((InsH << HShift) ^ b) & HashMask; } /* =========================================================================== * Insert string s in the dictionary and set match_head to the previous head * of the hash chain (the most recent string with same hash key). Return * the previous length of the hash chain. * IN assertion: all calls to to INSERT_STRING are made with consecutive * input characters and the first MIN_MATCH bytes of s are valid * (except for the last MIN_MATCH-1 bytes of the input file). */ IPos inline InsertString(IPos HashHead) //StrStart is the other value { UpdateHash(Window[StrStart + (MinMatch - 1)]); IPos i = Head[InsH]; Prev[StrStart & WMask] = i; Head[InsH] = StrStart; return i; } /* =========================================================================== * Initialize the "longest match" routines for a new file * * IN assertion: window_size is > 0 if the input file is already read or * mmap'ed in the window[] array, 0 otherwise. In the first case, * window_size is sufficient to contain the whole input file plus * MIN_LOOKAHEAD bytes (to avoid referencing memory beyond the end * of window[] when looking for matches towards the end). */ void LmInit() { // Initialize the hash table (avoiding 64K overflow for 16 bit systems). // prev[] will be initialized on the fly. Head[HashSize-1] = NIL; memset((char*) Head, NIL, (uint) (HashSize - 1) * sizeof(*Head)); // Set the default configuration parameters: //Do not try to find matches longer than the maximum NiceMatch = MaxMatch; StrStart = 0; BlockStart = 0; // Read 64K in one step, double the window size LookAhead = ReadBuf((char*) Window, WSize * 2); EOFile = (LookAhead == 0); if (EOFile) return; // Make sure that we always have enough lookahead. This is important // if input comes from a device such as a tty. if (LookAhead < MinLookahead) FillWindow(); InsH = 0; uint j; for (j = 0; j < MinMatch - 1; j++) UpdateHash(Window[j]); // If lookahead < MIN_MATCH, ins_h is garbage, but this is // not important since only literal bytes will be emitted. } // =========================================================================== // Set match_start to the longest match starting at the given string and // return its length. Matches shorter or equal to prev_length are discarded, // in which case the result is equal to prev_length and match_start is // garbage. // IN assertions: cur_match is the head of the hash chain for the current // string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1 int LongestMatch(IPos CurMatch) { uint ChainLength = MaxChainLength; // max hash chain length u8* Scan = Window + StrStart; // current string u8* Match; // matched string int Len; // length of current match int BestLen = PrevLength; // best match length so far IPos Limit = StrStart > (IPos)MaxDist ? StrStart - (IPos)MaxDist : NIL; // Stop when cur_match becomes <= limit. To simplify the code, // we prevent matches with the string of window index 0. u8* StrEnd = Window + StrStart + MaxMatch; u8 ScanEnd1 = Scan[BestLen - 1]; u8 ScanEnd = Scan[BestLen]; /* Do not waste too much time if we already have a good match: */ if (PrevLength >= GoodMatch) { ChainLength >>= 2; } Assert(StrStart <= WindowSize - MinLookahead);//, "insufficient lookahead"); do { Assert(CurMatch < StrStart);//, "no future"); Match = Window + CurMatch; /* Skip to next match if the match length cannot increase * or if the match length is less than 2: */ if (Match[BestLen] != ScanEnd || Match[BestLen - 1] != ScanEnd1 || *Match != Scan[0] || *++Match != Scan[1]) continue; // The check at best_len-1 can be removed because it will be made // again later. (This heuristic is not always a win.) // It is not necessary to compare scan[2] and match[2] since they // are always equal when the other bytes match, given that // the hash keys are equal and that HASH_BITS >= 8. Scan += 2; Match++; /* We check for insufficient lookahead only every 8th comparison; * the 256th check will be made at strstart+258. */ do { } while ((*++Scan == *++Match) && (*++Scan == *++Match) && (*++Scan == *++Match) && (*++Scan == *++Match) && (*++Scan == *++Match) && (*++Scan == *++Match) && (*++Scan == *++Match) && (*++Scan == *++Match) && Scan < StrEnd); Assert(Scan <= Window + (uint)(WindowSize-1));//, "wild scan"); Len = MaxMatch - (int)(StrEnd - Scan); Scan = StrEnd - MaxMatch; if (Len > BestLen) { MatchStart = CurMatch; BestLen = Len; if (Len >= NiceMatch) break; ScanEnd1 = Scan[BestLen - 1]; ScanEnd = Scan[BestLen]; } } while ((CurMatch = Prev[CurMatch & WMask]) > Limit && --ChainLength != 0); return BestLen; } #ifdef _DEBUG /* =========================================================================== * Check that the match at match_start is indeed a match. */ void CheckMatch(IPos Start, IPos Match, int Len) { // check that the match is indeed a match if (memcmp((char*) Window + Match, (char*) Window + Start, Len) != Equal) { error("invalid match"); } } #else # define CheckMatch(Start, Match, Len) #endif /* =========================================================================== * Fill the window when the lookahead becomes insufficient. * Updates strstart and lookahead, and sets eofile if end of input file. * * IN assertion: lookahead < MIN_LOOKAHEAD && strstart + lookahead > 0 * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD * At least one byte has been read, or eofile is set; file reads are * performed for at least two bytes (required for the translate_eol option). */ void FillWindow() { uint n, m; uint More; // Amount of free space at the end of the window. do { More = (unsigned)(WindowSize - (u32)LookAhead - (u32)StrStart); // If the window is almost full and there is insufficient lookahead, // move the upper half to the lower one to make room in the upper half. if (More == (unsigned)EOF) { //Occurs for files one byte long More--; } else if (StrStart >= WSize + MaxDist) { // By the IN assertion, the window is not empty so we can't confuse // more == 0 with more == 64K on a 16 bit machine. memcpy((char*) Window, (char*) Window + WSize, (uint) WSize); MatchStart -= WSize; StrStart -= WSize; // we now have strstart >= MAX_DIST: BlockStart -= (long) WSize; //Neil Optimisation, HASH_SIZE == WSIZE //:. only do one loop, with two operations in it //This must be true, if not use the original ZIP code Assert(HashSize == WSize); for (n = 0; n < HashSize; n++) { m = Head[n]; //NB: Do NOT use MAX as More is uint :. always > 0 Head[n] = (Pos) (m >= WSize ? m-WSize : NIL); //Dependant on WSIZE m = Prev[n]; Prev[n] = (Pos)(m >= WSize ? m-WSize : NIL); // If n is not on any hash chain, prev[n] is garbage but // its value will never be used. } More += WSize; } if (EOFile) return; /* If there was no sliding: * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 && * more == window_size - lookahead - strstart * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1) * => more >= window_size - 2*WSIZE + 2 * In the MMAP or BIG_MEM case (not yet supported in gzip), * window_size == input_size + MIN_LOOKAHEAD && * strstart + lookahead <= input_size => more >= MIN_LOOKAHEAD. * Otherwise, window_size == 2*WSIZE so more >= 2. * If there was sliding, more >= WSIZE. So in all cases, more >= 2. */ Assert(More >= 2); //more < 2 n = ReadBuf((char*) Window + StrStart + LookAhead, More); EOFile = (n == 0); LookAhead += n; } while ((LookAhead < MinLookahead) && !EOFile); } /* =========================================================================== * Flush the current block, with given end-of-file flag. * IN assertion: strstart is set to the end of the current match. */ inline u32 DoFlushBlock(bool eof) { return flush_block(BlockStart >= 0L ? (char*)&Window[(unsigned)BlockStart] : \ (char*)NULL, (long)StrStart - BlockStart, eof); } /* =========================================================================== * Same as above, but achieves better compression. We use a lazy * evaluation for matches: a match is finally adopted only if there is * no better match at the next window position. */ u32 Deflate() { IPos HashHead = NIL; // head of hash chain IPos PrevMatch; // previous match bool Flush; // set if current block must be flushed bool MatchAvailable = false; // set if previous match exists uint MatchLength = MinMatch - 1; // length of best match #ifdef _DEBUG extern u32 isize; // byte length of input file, for debug only #endif // Process the input block. while (LookAhead != 0) { // Insert the string window[strstart .. strstart+2] in the // dictionary, and set hash_head to the head of the hash chain: if (LookAhead >= MinMatch) HashHead = InsertString(HashHead); // Find the longest match, discarding those <= prev_length. PrevLength = MatchLength; PrevMatch = MatchStart; MatchLength = MinMatch - 1; if ((HashHead != NIL) && (PrevLength < MaxLazyMatch) && (StrStart - HashHead <= MaxDist)) { // To simplify the code, we prevent matches with the string // of window index 0 (in particular we have to avoid a match // of the string with itself at the start of the input file). // Do not look for matches beyond the end of the input. // This is necessary to make deflate deterministic. if ((uint) NiceMatch > LookAhead) NiceMatch = (int) LookAhead; MatchLength = LongestMatch(HashHead); // LongestMatch() sets match_start if (MatchLength > LookAhead) MatchLength = LookAhead; // Ignore a length 3 match if it is too distant: if ((MatchLength == MinMatch) && (StrStart - MatchStart > TooFar)) { // If prev_match is also MIN_MATCH, match_start is garbage // but we will ignore the current match anyway. MatchLength = MinMatch - 1; } } // If there was a match at the previous step and the current // match is not better, output the previous match: if ((PrevLength >= MinMatch) && (MatchLength <= PrevLength)) { uint MaxInsert = StrStart + LookAhead - MinMatch; CheckMatch(StrStart - 1, PrevMatch, PrevLength); Flush = ct_tally(StrStart - 1 - PrevMatch, PrevLength - MinMatch); // Insert in hash table all strings up to the end of the match. // strstart-1 and strstart are already inserted. LookAhead -= PrevLength - 1; PrevLength -= 2; do { if (++StrStart <= MaxInsert) { HashHead = InsertString(HashHead); // strstart never exceeds WSIZE-MAX_MATCH, so there are // always MIN_MATCH bytes ahead. } } while (--PrevLength != 0); StrStart++; MatchAvailable = false; MatchLength = MinMatch - 1; if (Flush) { DoFlushBlock(false); BlockStart = StrStart; } } else if (MatchAvailable) { // If there was no match at the previous position, output a // single literal. If there was a match but the current match // is longer, truncate the previous match to a single literal. if (ct_tally (0, Window[StrStart-1])) { DoFlushBlock(false); BlockStart = StrStart; } StrStart++; LookAhead--; } else { /* There is no previous match to compare with, wait for * the next step to decide. */ MatchAvailable = true; StrStart++; LookAhead--; } AssertD((StrStart <= isize) && (LookAhead <= isize));//, "a bit too far"); // Make sure that we always have enough lookahead, except // at the end of the input file. We need MAX_MATCH bytes // for the next match, plus MIN_MATCH bytes to insert the // string following the next match. if (LookAhead < MinLookahead) FillWindow(); } if (MatchAvailable) ct_tally (0, Window[StrStart-1]); return DoFlushBlock(true); // eof } //NEIL SPECIFIC u32 filecompress(int* cmpr_method) { /* Set the defaults for file compression. */ //zfile = zipfile; handled in SetupDefTree #ifdef _DEBUG isize = 0; #endif /* Initialize deflate's internals and execute file compression. */ bi_init(FileOutbuf, sizeof(FileOutbuf), true); ct_init(cmpr_method); LmInit(); return Deflate(); } #endif //!NO_COMPRESSIONhugs98-plus-Sep2006/src/winhugs/installer/BlueZip/Errors.h0000644006511100651110000000017010321204023022213 0ustar rossross//Error messages, with descriptive text //Can be turned off with the command //Can either send the text, or 0xffffffff hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/FileIO.cpp0000644006511100651110000000535110321204023022407 0ustar rossross#include "BlueHead.h" File FileOpenRead(LPCTSTR s) { return CreateFile(s, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); } File FileOpenWrite(LPCTSTR s) { return CreateFile(s, GENERIC_WRITE, FILE_SHARE_READ, NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL); } void FileRead(File f, void* buf, DWORD size) { DWORD d; ReadFile(f, buf, size, &d, NULL); Assert(size == d); } int FileReadBuf(File f, void* buf, DWORD size) { DWORD d; ReadFile(f, buf, size, &d, NULL); return d; } void FileWrite(File f, const void* buf, DWORD size) { DWORD d; WriteFile(f, buf, size, &d, NULL); Assert(size == d); } bool FileValid(File f) { return (f != File_Invalid); } void FileClose(File f) { #ifdef _DEBUG if (!CloseHandle(f)) _asm int 3; #else CloseHandle(f); #endif } bool FileReplace(LPCTSTR To, LPCTSTR From) { //First remove the existing file DeleteFile(To); //Then copy it accross return (MoveFile(From, To) != FALSE); } File FileOpenTemp(LPTSTR s) { char Buffer[MAX_PATH]; if ((GetTempPath(MAX_PATH, Buffer) == 0) || (GetTempFileName(Buffer, "ZIP", 0, s) == 0)) return File_Invalid; return CreateFile(s, GENERIC_WRITE, FILE_SHARE_READ, NULL, CREATE_ALWAYS, //Create Always, not Create New FILE_ATTRIBUTE_NORMAL, NULL);; } //return TRUE for success, FALSE for failure //fseek returns 0 for success void inline _p_Seek(File f, long offset, DWORD origin) { #ifdef _DEBUG if (SetFilePointer(f, offset, NULL, origin) == 0xFFFFFFFF) _asm int 3; #else SetFilePointer(f, offset, NULL, origin); #endif } void SeekBeg(File f, long offset) {_p_Seek(f, offset, FILE_BEGIN);} void SeekCur(File f, long offset) {_p_Seek(f, offset, FILE_CURRENT);} void SeekEnd(File f, long offset) {_p_Seek(f, offset, FILE_END);} int FilePos(File f) { DWORD d = SetFilePointer(f, 0, NULL, FILE_CURRENT); Assert(d != 0xFFFFFFFF); return d; } int FileLen(File f) { return GetFileSize(f, NULL); } void FileGetDate(File f, datCentral* data) { FILETIME ft; #ifdef _DEBUG if (!GetFileTime(f, NULL, NULL, &ft)) _asm int 3; if (!FileTimeToDosDateTime(&ft, &data->Date, &data->Time)) _asm int 3; #else GetFileTime(f, &ft, NULL, NULL); FileTimeToDosDateTime(&ft, &data->Date, &data->Time); #endif } #define A_RONLY 0x01 #define A_HIDDEN 0x02 #define A_SYSTEM 0x04 #define A_LABEL 0x08 #define A_DIR 0x10 #define A_ARCHIVE 0x20 u32 FileGetAttrib(File f, LPCTSTR FileName) { DWORD Attr = GetFileAttributes(FileName); Assert(Attr != 0xFFFFFFFF); return( (Attr & FILE_ATTRIBUTE_READONLY ? A_RONLY :0) | (Attr & FILE_ATTRIBUTE_HIDDEN ? A_HIDDEN :0) | (Attr & FILE_ATTRIBUTE_SYSTEM ? A_SYSTEM :0) | (Attr & FILE_ATTRIBUTE_DIRECTORY ? A_DIR :0) | (Attr & FILE_ATTRIBUTE_ARCHIVE ? A_ARCHIVE :0)); } hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/FileIO.h0000644006511100651110000000124710321204023022054 0ustar rossross //Use Windows (reliable) file IO routines #define File HANDLE #define File_Invalid INVALID_HANDLE_VALUE File FileOpenRead(LPCTSTR s); File FileOpenWrite(LPCTSTR s); File FileOpenTemp(LPTSTR s); bool FileReplace(LPCTSTR To, LPCTSTR From); void FileRead(File f, void* buf, DWORD size); int FileReadBuf(File f, void* buf, DWORD size); void FileWrite(File f, const void* buf, DWORD size); bool FileValid(File f); void FileClose(File f); void SeekBeg(File f, long offset); void SeekCur(File f, long offset); void SeekEnd(File f, long offset); int FilePos(File f); int FileLen(File f); void FileGetDate(File f, datCentral* data); u32 FileGetAttrib(File f, LPCTSTR FileName); hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/General.cpp0000644006511100651110000000022210321204023022645 0ustar rossross#include "BlueHead.h" LPTSTR CopyString(LPCTSTR s) { const int i = strlen(s); LPTSTR res = new char[i+1]; memcpy(res, s, i+1); return res; } hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/General.h0000644006511100651110000000003710321204023022316 0ustar rossross LPTSTR CopyString(LPCTSTR s); hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/Inflate.cpp0000644006511100651110000007233010321204023022663 0ustar rossross#include "BlueHead.h" #include File hOut; //THIS MUST BE SET BY MY PROGRAM File hIn; #undef malloc #undef free void Neil_Init(File Out, File In) { hOut = Out; hIn = In; } #include "inflate.h" //Used to be globals.h struct Globals G; //From consts.h const u16 mask_bits[] = { 0x0000, 0x0001, 0x0003, 0x0007, 0x000f, 0x001f, 0x003f, 0x007f, 0x00ff, 0x01ff, 0x03ff, 0x07ff, 0x0fff, 0x1fff, 0x3fff, 0x7fff, 0xffff }; //From unzpriv.h struct huft { u8 e; /* number of extra bits or operation */ u8 b; /* number of bits in this code or subcode */ union { u16 n; /* literal, length base, or distance base */ struct huft *t; /* pointer to next level of table */ } v; }; # define redirSlide G.area.Slide //NEIL SPECIFIC END #define PKZIP_BUG_WORKAROUND /* PKZIP 1.93a problem--live with it */ #define __INFLATE_C /* identifies this source module */ /* #define DEBUG */ #define INFMOD /* tell inflate.h to include code to be compiled */ //#include "inflate.h" #if (defined(DLL) && !defined(NO_SLIDE_REDIR)) # define wsize G._wsize /* wsize is a variable */ #else # define wsize WSIZE /* wsize is a constant */ #endif inline int NextByte() { unsigned char c; FileRead(hIn, &c, 1); return c; } #ifndef NEXTBYTE /* default is to simply get a byte from stdin */ # define NEXTBYTE NextByte() #endif #ifndef MESSAGE /* only used twice, for fixed strings--NOT general-purpose */ # define MESSAGE(str,len,flag) fprintf(stderr,(char *)(str)) #endif void inline FLUSH(int n) { FileWrite(hOut, redirSlide, n); CRC(redirSlide, n);} //#ifndef FLUSH /* default is to simply write the buffer to stdout */ //# define FLUSH(n) \ //#endif /* Warning: the fwrite above might not work on 16-bit compilers, since 0x8000 might be interpreted as -32,768 by the library function. */ #ifndef Trace # ifdef DEBUG # define Trace(x) fprintf x # else # define Trace(x) # endif #endif /*---------------------------------------------------------------------------*/ /* Function prototypes */ #ifndef OF # ifdef __STDC__ # define OF(a) a # else # define OF(a) () # endif #endif /* !OF */ int inflate_codes OF((__GPRO__ struct huft *tl, struct huft *td, int bl, int bd)); static int inflate_stored OF((__GPRO)); static int inflate_fixed OF((__GPRO)); static int inflate_dynamic OF((__GPRO)); static int inflate_block OF((__GPRO__ int *e)); /* The inflate algorithm uses a sliding 32K byte window on the uncompressed stream to find repeated byte strings. This is implemented here as a circular buffer. The index is updated simply by incrementing and then and'ing with 0x7fff (32K-1). */ /* It is left to other modules to supply the 32K area. It is assumed to be usable as if it were declared "uch slide[32768];" or as just "uch *slide;" and then malloc'ed in the latter case. The definition must be in unzip.h, included above. */ /* unsigned wp; moved to globals.h */ /* current position in slide */ #define INVALID_CODE 99 #define IS_INVALID_CODE(c) ((c) == INVALID_CODE) /* Tables for deflate from PKZIP's appnote.txt. */ static const uint border[] = { /* Order of the bit length code lengths */ 16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; static const u16 cplens[] = { /* Copy lengths for literal codes 257..285 */ 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0}; /* note: see note #13 above about the 258 in this list. */ static const u16 cplext[] = { /* Extra bits for literal codes 257..285 */ 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, INVALID_CODE, INVALID_CODE}; static const u16 cpdist[] = { /* Copy offsets for distance codes 0..29 */ 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, #ifdef USE_DEFLATE64 8193, 12289, 16385, 24577, 32769, 49153}; #else 8193, 12289, 16385, 24577}; #endif static const u16 cpdext[] = { /* Extra bits for distance codes */ 0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, #ifdef USE_DEFLATE64 12, 12, 13, 13, 14, 14}; #else 12, 12, 13, 13}; #endif #ifdef USE_DEFLATE64 # define NUMDISTS 32 #else # define NUMDISTS 30 #endif /* moved to consts.h (included in unzip.c), resp. funzip.c */ #if 0 /* And'ing with mask_bits[n] masks the lower n bits */ ZCONST u16 near mask_bits[] = { 0x0000, 0x0001, 0x0003, 0x0007, 0x000f, 0x001f, 0x003f, 0x007f, 0x00ff, 0x01ff, 0x03ff, 0x07ff, 0x0fff, 0x1fff, 0x3fff, 0x7fff, 0xffff }; #endif /* 0 */ /* Macros for inflate() bit peeking and grabbing. The usage is: NEEDBITS(j) x = b & mask_bits[j]; DUMPBITS(j) where NEEDBITS makes sure that b has at least j bits in it, and DUMPBITS removes the bits from b. The macros use the variable k for the number of bits in b. Normally, b and k are register variables for speed and are initialized at the begining of a routine that uses these macros from a global bit buffer and count. In order to not ask for more bits than there are in the compressed stream, the Huffman tables are constructed to only ask for just enough bits to make up the end-of-block code (value 256). Then no bytes need to be "returned" to the buffer at the end of the last block. See the huft_build() routine. */ /* These have been moved to globals.h */ #if 0 ulg bb; /* bit buffer */ unsigned bk; /* bits in bit buffer */ #endif //EOF is not a valid //#ifndef CHECK_EOF //# define CHECK_EOF /* default as of 5.13/5.2 */ //#endif #ifndef CHECK_EOF # define NEEDBITS(n) {while(k<(n)){b|=((u32)NEXTBYTE)<>=(n);k-=(n);} /* Huffman code decoding is performed using a multi-level table lookup. The fastest way to decode is to simply build a lookup table whose size is determined by the longest code. However, the time it takes to build this table can also be a factor if the data being decoded are not very long. The most common codes are necessarily the shortest codes, so those codes dominate the decoding time, and hence the speed. The idea is you can have a shorter table that decodes the shorter, more probable codes, and then point to subsidiary tables for the longer codes. The time it costs to decode the longer codes is then traded against the time it takes to make longer tables. This results of this trade are in the variables lbits and dbits below. lbits is the number of bits the first level table for literal/ length codes can decode in one step, and dbits is the same thing for the distance codes. Subsequent tables are also less than or equal to those sizes. These values may be adjusted either when all of the codes are shorter than that, in which case the longest code length in bits is used, or when the shortest code is *longer* than the requested table size, in which case the length of the shortest code in bits is used. There are two different values for the two tables, since they code a different number of possibilities each. The literal/length table codes 286 possible values, or in a flat code, a little over eight bits. The distance table codes 30 possible values, or a little less than five bits, flat. The optimum values for speed end up being about one bit more than those, so lbits is 8+1 and dbits is 5+1. The optimum values may differ though from machine to machine, and possibly even between compilers. Your mileage may vary. */ static const int lbits = 9; /* bits in base literal/length lookup table */ static const int dbits = 6; /* bits in base distance lookup table */ #ifndef ASM_INFLATECODES int inflate_codes(__G__ __GDEF huft* tl, huft* td, int bl, int bd) // __GDEF //struct huft *tl, *td; /* literal/length and distance decoder tables */ //int bl, bd; /* number of bits decoded by tl[] and td[] */ /* inflate (decompress) the codes in a deflated (compressed) block. Return an error code or zero if it all goes ok. */ { register unsigned e; /* table entry flag/number of extra bits */ unsigned n, d; /* length and index for copy */ unsigned w; /* current window position */ struct huft *t; /* pointer to table entry */ unsigned ml, md; /* masks for bl and bd bits */ u32 b; /* bit buffer */ register unsigned k; /* number of bits in bit buffer */ int retval = 0; /* error code returned: initialized to "no error" */ /* make local copies of globals */ b = G.bb; /* initialize bit buffer */ k = G.bk; w = G.wp; /* initialize window position */ /* inflate the coded data */ ml = mask_bits[bl]; /* precompute masks for speed */ md = mask_bits[bd]; while (1) /* do until end of block */ { NEEDBITS((unsigned)bl) if ((e = (t = tl + ((unsigned)b & ml))->e) > 16) do { if (IS_INVALID_CODE(e)) return 1; DUMPBITS(t->b) e -= 16; NEEDBITS(e) } while ((e = (t = t->v.t + ((unsigned)b & mask_bits[e]))->e) > 16); DUMPBITS(t->b) if (e == 16) /* then it's a literal */ { redirSlide[w++] = (u8)t->v.n; if (w == wsize) { FLUSH(w); w = 0; } } else /* it's an EOB or a length */ { /* exit if end of block */ if (e == 15) break; /* get length of block to copy */ NEEDBITS(e) n = t->v.n + ((unsigned)b & mask_bits[e]); DUMPBITS(e) #if (defined(USE_DEFLATE64) && !defined(FUNZIP)) if (n == 258 && G.lrec.compression_method == ENHDEFLATED) { /* fetch length bits */ NEEDBITS(16) n = ((unsigned)b & 0xffff) + 3; DUMPBITS(16) } #endif /* decode distance of block to copy */ NEEDBITS((unsigned)bd) if ((e = (t = td + ((unsigned)b & md))->e) > 16) do { if (IS_INVALID_CODE(e)) return 1; DUMPBITS(t->b) e -= 16; NEEDBITS(e) } while ((e = (t = t->v.t + ((unsigned)b & mask_bits[e]))->e) > 16); DUMPBITS(t->b) NEEDBITS(e) d = w - t->v.n - ((unsigned)b & mask_bits[e]); DUMPBITS(e) /* do the copy */ do { #if (defined(DLL) && !defined(NO_SLIDE_REDIR)) if (G.redirect_slide) {/* &= w/ wsize unnecessary & wrong if redirect */ if (d >= wsize) return 1; /* invalid compressed data */ n -= (e = (e = wsize - (d > w ? d : w)) > n ? n : e); } else #endif n -= (e = (e = wsize - ((d &= wsize-1) > w ? d : w)) > n ? n : e); #ifndef NOMEMCPY if (w - d >= e) /* (this test assumes unsigned comparison) */ { memcpy(redirSlide + w, redirSlide + d, e); w += e; d += e; } else /* do it slowly to avoid memcpy() overlap */ #endif /* !NOMEMCPY */ do { redirSlide[w++] = redirSlide[d++]; } while (--e); if (w == wsize) { FLUSH(w); w = 0; } } while (n); } } /* restore the globals from the locals */ G.wp = w; /* restore global window pointer */ G.bb = b; /* restore global bit buffer */ G.bk = k; return retval; } #endif /* ASM_INFLATECODES */ static int inflate_stored(__G) __GDEF /* "decompress" an inflated type 0 (stored) block. */ { unsigned n; /* number of bytes in block */ unsigned w; /* current window position */ register u32 b; /* bit buffer */ register unsigned k; /* number of bits in bit buffer */ int retval = 0; /* error code returned: initialized to "no error" */ /* make local copies of globals */ Trace((stderr, "\nstored block")); b = G.bb; /* initialize bit buffer */ k = G.bk; w = G.wp; /* initialize window position */ /* go to byte boundary */ n = k & 7; DUMPBITS(n); /* get the length and its complement */ NEEDBITS(16) n = ((unsigned)b & 0xffff); DUMPBITS(16) NEEDBITS(16) if (n != (unsigned)((~b) & 0xffff)) return 1; /* error in compressed data */ DUMPBITS(16) /* read and output the compressed data */ while (n--) { NEEDBITS(8) redirSlide[w++] = (u8)b; if (w == wsize) { FLUSH(w); w = 0; } DUMPBITS(8) } /* restore the globals from the locals */ G.wp = w; /* restore global window pointer */ G.bb = b; /* restore global bit buffer */ G.bk = k; return retval; } /* Globals for literal tables (built once) */ /* Moved to globals.h */ #if 0 struct huft *fixed_tl = (struct huft *)NULL; struct huft *fixed_td; int fixed_bl, fixed_bd; #endif int huft_build(__GPRO__ const uint *b, uint n, uint s, const u16* d, const u16* e, struct huft **t, int *m); int huft_free(huft* t); /* inflate.c */ static int inflate_fixed(__G) __GDEF /* decompress an inflated type 1 (fixed Huffman codes) block. We should either replace this with a custom decoder, or at least precompute the Huffman tables. */ { /* if first time, set up tables for fixed blocks */ Trace((stderr, "\nliteral block")); if (G.fixed_tl == (struct huft *)NULL) { int i; /* temporary variable */ unsigned l[288]; /* length list for huft_build */ /* literal table */ for (i = 0; i < 144; i++) l[i] = 8; for (; i < 256; i++) l[i] = 9; for (; i < 280; i++) l[i] = 7; for (; i < 288; i++) /* make a complete, but wrong code set */ l[i] = 8; G.fixed_bl = 7; if ((i = huft_build(__G__ l, 288, 257, cplens, cplext, &G.fixed_tl, &G.fixed_bl)) != 0) { G.fixed_tl = (struct huft *)NULL; return i; } /* distance table */ for (i = 0; i < NUMDISTS; i++) /* make an incomplete code set */ l[i] = 5; G.fixed_bd = 5; if ((i = huft_build(__G__ l, NUMDISTS, 0, cpdist, cpdext, &G.fixed_td, &G.fixed_bd)) > 1) { huft_free(G.fixed_tl); G.fixed_td = G.fixed_tl = (struct huft *)NULL; return i; } } /* decompress until an end-of-block code */ return inflate_codes(__G__ G.fixed_tl, G.fixed_td, G.fixed_bl, G.fixed_bd); } static int inflate_dynamic(__G) __GDEF /* decompress an inflated type 2 (dynamic Huffman codes) block. */ { int i; /* temporary variables */ unsigned j; unsigned l; /* last length */ unsigned m; /* mask for bit lengths table */ unsigned n; /* number of lengths to get */ struct huft *tl; /* literal/length code table */ struct huft *td; /* distance code table */ int bl; /* lookup bits for tl */ int bd; /* lookup bits for td */ unsigned nb; /* number of bit length codes */ unsigned nl; /* number of literal/length codes */ unsigned nd; /* number of distance codes */ #ifdef PKZIP_BUG_WORKAROUND unsigned ll[288+32]; /* literal/length and distance code lengths */ #else unsigned ll[286+NUMDISTS]; /* literal/length and distance code lengths */ #endif register u32 b; /* bit buffer */ register unsigned k; /* number of bits in bit buffer */ int retval = 0; /* error code returned: initialized to "no error" */ /* make local bit buffer */ Trace((stderr, "\ndynamic block")); b = G.bb; k = G.bk; /* read in table lengths */ NEEDBITS(5) nl = 257 + ((unsigned)b & 0x1f); /* number of literal/length codes */ DUMPBITS(5) NEEDBITS(5) nd = 1 + ((unsigned)b & 0x1f); /* number of distance codes */ DUMPBITS(5) NEEDBITS(4) nb = 4 + ((unsigned)b & 0xf); /* number of bit length codes */ DUMPBITS(4) #ifdef PKZIP_BUG_WORKAROUND if (nl > 288 || nd > 32) #else if (nl > 286 || nd > NUMDISTS) #endif return 1; /* bad lengths */ /* read in bit-length-code lengths */ for (j = 0; j < nb; j++) { NEEDBITS(3) ll[border[j]] = (unsigned)b & 7; DUMPBITS(3) } for (; j < 19; j++) ll[border[j]] = 0; /* build decoding table for trees--single level, 7 bit lookup */ bl = 7; retval = huft_build(__G__ ll, 19, 19, NULL, NULL, &tl, &bl); if (bl == 0) /* no bit lengths */ retval = 1; if (retval) { if (retval == 1) huft_free(tl); return retval; /* incomplete code set */ } /* read in literal and distance code lengths */ n = nl + nd; m = mask_bits[bl]; i = l = 0; while ((unsigned)i < n) { NEEDBITS((unsigned)bl) j = (td = tl + ((unsigned)b & m))->b; DUMPBITS(j) j = td->v.n; if (j < 16) /* length of code in bits (0..15) */ ll[i++] = l = j; /* save last length in l */ else if (j == 16) /* repeat last length 3 to 6 times */ { NEEDBITS(2) j = 3 + ((unsigned)b & 3); DUMPBITS(2) if ((unsigned)i + j > n) return 1; while (j--) ll[i++] = l; } else if (j == 17) /* 3 to 10 zero length codes */ { NEEDBITS(3) j = 3 + ((unsigned)b & 7); DUMPBITS(3) if ((unsigned)i + j > n) return 1; while (j--) ll[i++] = 0; l = 0; } else /* j == 18: 11 to 138 zero length codes */ { NEEDBITS(7) j = 11 + ((unsigned)b & 0x7f); DUMPBITS(7) if ((unsigned)i + j > n) return 1; while (j--) ll[i++] = 0; l = 0; } } /* free decoding table for trees */ huft_free(tl); /* restore the global bit buffer */ G.bb = b; G.bk = k; /* build the decoding tables for literal/length and distance codes */ bl = lbits; retval = huft_build(__G__ ll, nl, 257, cplens, cplext, &tl, &bl); if (bl == 0) /* no literals or lengths */ retval = 1; if (retval) { if (retval == 1) { huft_free(tl); } return retval; /* incomplete code set */ } bd = dbits; retval = huft_build(__G__ ll + nl, nd, 0, cpdist, cpdext, &td, &bd); #ifdef PKZIP_BUG_WORKAROUND if (retval == 1) retval = 0; #endif if (bd == 0 && nl > 257) /* lengths but no distances */ retval = 1; if (retval) { if (retval == 1) { huft_free(td); } huft_free(tl); return retval; } /* decompress until an end-of-block code */ retval = inflate_codes(__G__ tl, td, bl, bd); /* free the decoding tables, return */ huft_free(tl); huft_free(td); return retval; } static int inflate_block(__G__ __GDEF int* e) /* last block flag */ /* decompress an inflated block */ { unsigned t; /* block type */ register u32 b; /* bit buffer */ register unsigned k; /* number of bits in bit buffer */ int retval = 0; /* error code returned: initialized to "no error" */ /* make local bit buffer */ b = G.bb; k = G.bk; /* read in last block bit */ NEEDBITS(1) *e = (int)b & 1; DUMPBITS(1) /* read in block type */ NEEDBITS(2) t = (unsigned)b & 3; DUMPBITS(2) /* restore the global bit buffer */ G.bb = b; G.bk = k; /* inflate that block type */ if (t == 2) return inflate_dynamic(__G); if (t == 0) return inflate_stored(__G); if (t == 1) return inflate_fixed(__G); /* bad block type */ retval = 2; return retval; } int inflate(__G) __GDEF /* decompress an inflated entry */ { int e; /* last block flag */ int r; /* result code */ #ifdef DEBUG unsigned h = 0; /* maximum struct huft's malloc'ed */ #endif #if (defined(DLL) && !defined(NO_SLIDE_REDIR)) if (G.redirect_slide) wsize = G.redirect_size, redirSlide = G.redirect_buffer; else wsize = WSIZE, redirSlide = slide; /* how they're #defined if !DLL */ #endif /* initialize window, bit buffer */ G.wp = 0; G.bk = 0; G.bb = 0; /* decompress until the last block */ do { #ifdef DEBUG G.hufts = 0; #endif if ((r = inflate_block(__G__ &e)) != 0) return r; #ifdef DEBUG if (G.hufts > h) h = G.hufts; #endif } while (!e); Trace((stderr, "\n%u bytes in Huffman tables (%d/entry)\n", h * sizeof(struct huft), sizeof(struct huft))); /* flush out redirSlide and return (success, unless final FLUSH failed) */ FLUSH(G.wp); return 0; } int inflate_free(__G) __GDEF { if (G.fixed_tl != (struct huft *)NULL) { huft_free(G.fixed_td); huft_free(G.fixed_tl); G.fixed_td = G.fixed_tl = (struct huft *)NULL; } return 0; } /* * GRR: moved huft_build() and huft_free() down here; used by explode() * and fUnZip regardless of whether USE_ZLIB defined or not */ /* If BMAX needs to be larger than 16, then h and x[] should be ulg. */ #define BMAX 16 /* maximum bit length of any code (16 for explode) */ #define N_MAX 288 /* maximum number of codes in any set */ int huft_build(__G__ __GDEF const uint* b, uint n, uint s, const u16* d, const u16* e, huft** t, int* m) // __GDEF // const unsigned *b; /* code lengths in bits (all assumed <= BMAX) */ // unsigned n; /* number of codes (assumed <= N_MAX) */ // unsigned s; /* number of simple-valued codes (0..s-1) */ // const u16 *d; /* list of base values for non-simple codes */ // const u16 *e; /* list of extra bits for non-simple codes */ // struct huft **t; /* result: starting table */ // int *m; /* maximum lookup bits, returns actual */ /* Given a list of code lengths and a maximum table size, make a set of tables to decode that set of codes. Return zero on success, one if the given code set is incomplete (the tables are still built in this case), two if the input is invalid (all zero length codes or an oversubscribed set of lengths), and three if not enough memory. The code with value 256 is special, and the tables are constructed so that no bits beyond that code are fetched when that code is decoded. */ { unsigned a; /* counter for codes of length k */ unsigned c[BMAX+1]; /* bit length count table */ unsigned el; /* length of EOB code (value 256) */ unsigned f; /* i repeats in table every f entries */ int g; /* maximum code length */ int h; /* table level */ register unsigned i; /* counter, current code */ register unsigned j; /* counter */ register int k; /* number of bits in current code */ int lx[BMAX+1]; /* memory for l[-1..BMAX-1] */ int *l = lx+1; /* stack of bits per table */ register unsigned *p; /* pointer into c[], b[], or v[] */ register struct huft *q; /* points to current table */ struct huft r; /* table entry for structure assignment */ struct huft *u[BMAX]; /* table stack */ unsigned v[N_MAX]; /* values in order of bit length */ register int w; /* bits before this table == (l * h) */ unsigned x[BMAX+1]; /* bit offsets, then code stack */ unsigned *xp; /* pointer into x */ int y; /* number of dummy codes added */ unsigned z; /* number of entries in current table */ /* Generate counts for each bit length */ el = n > 256 ? b[256] : BMAX; /* set length of EOB code, if any */ memset((char *)c, 0, sizeof(c)); p = (unsigned *)b; i = n; do { c[*p]++; p++; /* assume all entries <= BMAX */ } while (--i); if (c[0] == n) /* null input--all zero length codes */ { *t = (struct huft *)NULL; *m = 0; return 0; } /* Find minimum and maximum length, bound *m by those */ for (j = 1; j <= BMAX; j++) if (c[j]) break; k = j; /* minimum code length */ if ((unsigned)*m < j) *m = j; for (i = BMAX; i; i--) if (c[i]) break; g = i; /* maximum code length */ if ((unsigned)*m > i) *m = i; /* Adjust last length count to fill out codes, if needed */ for (y = 1 << j; j < i; j++, y <<= 1) if ((y -= c[j]) < 0) return 2; /* bad input: more codes than bits */ if ((y -= c[i]) < 0) return 2; c[i] += y; /* Generate starting offsets into the value table for each length */ x[1] = j = 0; p = c + 1; xp = x + 2; while (--i) { /* note that i == g from above */ *xp++ = (j += *p++); } /* Make a table of values in order of bit lengths */ memset((char *)v, 0, sizeof(v)); p = (unsigned *)b; i = 0; do { if ((j = *p++) != 0) v[x[j]++] = i; } while (++i < n); n = x[g]; /* set n to length of v */ /* Generate the Huffman codes and for each, make the table entries */ x[0] = i = 0; /* first Huffman code is zero */ p = v; /* grab values in bit order */ h = -1; /* no tables yet--level -1 */ w = l[-1] = 0; /* no bits decoded yet */ u[0] = (struct huft *)NULL; /* just to keep compilers happy */ q = (struct huft *)NULL; /* ditto */ z = 0; /* ditto */ /* go through the bit lengths (k already is bits in shortest code) */ for (; k <= g; k++) { a = c[k]; while (a--) { /* here i is the Huffman code of length k bits for value *p */ /* make tables up to required level */ while (k > w + l[h]) { w += l[h++]; /* add bits already decoded */ /* compute minimum size table less than or equal to *m bits */ z = (z = g - w) > (unsigned)*m ? *m : z; /* upper limit */ if ((f = 1 << (j = k - w)) > a + 1) /* try a k-w bit table */ { /* too few codes for k-w bit table */ f -= a + 1; /* deduct codes from patterns left */ xp = c + k; while (++j < z) /* try smaller tables up to z bits */ { if ((f <<= 1) <= *++xp) break; /* enough codes to use up j bits */ f -= *xp; /* else deduct codes from patterns */ } } if ((unsigned)w + j > el && (unsigned)w < el) j = el - w; /* make EOB code end at table */ z = 1 << j; /* table entries for j-bit table */ l[h] = j; /* set table size in stack */ /* allocate and link in new table */ if ((q = (struct huft *)malloc((z + 1)*sizeof(struct huft))) == (struct huft *)NULL) { if (h) huft_free(u[0]); return 3; /* not enough memory */ } #ifdef DEBUG G.hufts += z + 1; /* track memory usage */ #endif *t = q + 1; /* link to list for huft_free() */ *(t = &(q->v.t)) = (struct huft *)NULL; u[h] = ++q; /* table starts after link */ /* connect to last table, if there is one */ if (h) { x[h] = i; /* save pattern for backing up */ r.b = (u8)l[h-1]; /* bits to dump before this table */ r.e = (u8)(16 + j); /* bits in this table */ r.v.t = q; /* pointer to this table */ j = (i & ((1 << w) - 1)) >> (w - l[h-1]); u[h-1][j] = r; /* connect to last table */ } } /* set up table entry in r */ r.b = (u8)(k - w); if (p >= v + n) r.e = INVALID_CODE; /* out of values--invalid code */ else if (*p < s) { r.e = (u8)(*p < 256 ? 16 : 15); /* 256 is end-of-block code */ r.v.n = (u16)*p++; /* simple code is just the value */ } else { r.e = (u8)e[*p - s]; /* non-simple--look up in lists */ r.v.n = d[*p++ - s]; } /* fill code-like entries with r */ f = 1 << (k - w); for (j = i >> w; j < z; j += f) q[j] = r; /* backwards increment the k-bit code i */ for (j = 1 << (k - 1); i & j; j >>= 1) i ^= j; i ^= j; /* backup over finished tables */ while ((i & ((1 << w) - 1)) != x[h]) w -= l[--h]; /* don't need to update q */ } } /* return actual size of base table */ *m = l[0]; /* Return true (1) if we were given an incomplete table */ return y != 0 && g != 1; } int huft_free(huft* t) //struct huft *t; /* table to free */ /* Free the malloc'ed tables built by huft_build(), which makes a linked list of the tables it made, with the links in a dummy first entry of each table. */ { register struct huft *p, *q; /* Go through linked list, freeing from the malloced (t[-1]) address. */ p = t; while (p != (struct huft *)NULL) { q = (--p)->v.t; free((void*) p); p = q; } return 0; } hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/Inflate.h0000644006511100651110000003614110321204023022330 0ustar rossross//privzip.h #define WSIZE 0x8000 /* window size--must be a power of two, and */ #define MAX_BITS 13 /* used in unshrink() */ #define HSIZE (1 << MAX_BITS) /* size of global work area */ union work { struct { /* unshrink(): */ int Parent[HSIZE]; /* (8192 * sizeof(shrint)) == 16KB minimum */ u8 value[HSIZE]; /* 8KB */ u8 Stack[HSIZE]; /* 8KB */ } shrink; /* total = 32KB minimum; 80KB on Cray/Alpha */ u8 Slide[WSIZE]; /* explode(), inflate(), unreduce() */ }; /* Copyright (c) 1990-2001 Info-ZIP. All rights reserved. See the accompanying file LICENSE, version 2000-Apr-09 or later (the contents of which are also included in unzip.h) for terms of use. If, for some reason, all these files are missing, the Info-ZIP license also may be found at: ftp://ftp.info-zip.org/pub/infozip/license.html */ /*--------------------------------------------------------------------------- globals.h There is usually no need to include this file since unzip.h includes it. This header file is used by all of the UnZip source files. It contains a struct definition that is used to "house" all of the global variables. This is done to allow for multithreaded environments (OS/2, NT, Win95, Unix) to call UnZip through an API without a semaphore. REENTRANT should be defined for all platforms that require this. GLOBAL CONSTRUCTOR AND DESTRUCTOR (API WRITERS READ THIS!!!) ------------------------------------------------------------ No, it's not C++, but it's as close as we can get with K&R. The main() of each process that uses these globals must include the CONSTRUCTGLOBALS; statement. This will malloc enough memory for the structure and initialize any variables that require it. This must also be done by any API function that jumps into the middle of the code. The DESTROYGLOBALS; statement should be inserted before EVERY "EXIT(n)". Naturally, it also needs to be put before any API returns as well. In fact, it's much more important in API functions since the process will NOT end, and therefore the memory WON'T automatically be freed by the operating system. USING VARIABLES FROM THE STRUCTURE ---------------------------------- All global variables must now be prefixed with `G.' which is either a global struct (in which case it should be the only global variable) or a macro for the value of a local pointer variable that is passed from function to function. Yes, this is a pain. But it's the only way to allow full reentrancy. ADDING VARIABLES TO THE STRUCTURE --------------------------------- If you make the inclusion of any variables conditional, be sure to only check macros that are GUARANTEED to be included in every module. For instance, newzip and pwdarg are needed only if CRYPT is TRUE, but this is defined after unzip.h has been read. If you are not careful, some modules will expect your variable to be part of this struct while others won't. This will cause BIG problems. (Inexplicable crashes at strange times, car fires, etc.) When in doubt, always include it! Note also that UnZipSFX needs a few variables that UnZip doesn't. However, it also includes some object files from UnZip. If we were to conditionally include the extra variables that UnZipSFX needs, the object files from UnZip would not mesh with the UnZipSFX object files. Result: we just include the UnZipSFX variables every time. (It's only an extra 4 bytes so who cares!) ADDING FUNCTIONS ---------------- To support this new global struct, all functions must now conditionally pass the globals pointer (pG) to each other. This is supported by 5 macros: __GPRO, __GPRO__, __G, __G__ and __GDEF. A function that needs no other parameters would look like this: int extract_or_test_files(__G) __GDEF { ... stuff ... } A function with other parameters would look like: int memextract(__G__ tgt, tgtsize, src, srcsize) __GDEF u8 *tgt, *src; u32 tgtsize, srcsize; { ... stuff ... } In the Function Prototypes section of unzpriv.h, you should use __GPRO and __GPRO__ instead: int uz_opts OF((__GPRO__ int *pargc, char ***pargv)); int process_zipfiles OF((__GPRO)); Note that there is NO comma after __G__ or __GPRO__ and no semi-colon after __GDEF. I wish there was another way but I don't think there is. TESTING THE CODE ----------------- Whether your platform requires reentrancy or not, you should always try building with REENTRANT defined if any functions have been added. It is pretty easy to forget a __G__ or a __GDEF and this mistake will only show up if REENTRANT is defined. All platforms should run with REENTRANT defined. Platforms that can't take advantage of it will just be paying a performance penalty needlessly. SIGNAL MADNESS -------------- This whole pointer passing scheme falls apart when it comes to SIGNALs. I handle this situation 2 ways right now. If you define USETHREADID, UnZip will include a 64-entry table. Each entry can hold a global pointer and thread ID for one thread. This should allow up to 64 threads to access UnZip simultaneously. Calling DESTROYGLOBALS() will free the global struct and zero the table entry. If somebody forgets to call DESTROYGLOBALS(), this table will eventually fill up and UnZip will exit with an error message. A good way to test your code to make sure you didn't forget a DESTROYGLOBALS() is to change THREADID_ENTRIES to 3 or 4 in globals.c, making the table real small. Then make a small test program that calls your API a dozen times. Those platforms that don't have threads still need to be able to compile with REENTRANT defined to test and see if new code is correctly written to work either way. For these platforms, I simply keep a global pointer called GG that points to the Globals structure. Good enough for testing. I believe that NT has thread level storage. This could probably be used to store a global pointer for the sake of the signal handler more cleanly than my table approach. ---------------------------------------------------------------------------*/ #ifndef __globals_h #define __globals_h #ifdef USE_ZLIB # include "zlib.h" #endif /*************/ /* Globals */ /*************/ typedef struct Globals { #ifdef DLL zvoid *callerglobs; /* pointer to structure of pass-through global vars */ #endif #ifndef FUNZIP /* command options specific to the high level command line interface */ #ifdef MORE int M_flag; /* -M: built-in "more" function */ #endif /* internal flags and general globals */ #ifdef MORE int height; /* check for SIGWINCH, etc., eventually... */ int lines; /* count of lines displayed on current screen */ # if (defined(SCREENWIDTH) && defined(SCREENLWRAP)) int width; int chars; /* count of screen characters in current line */ # endif #endif /* MORE */ #if (defined(IZ_CHECK_TZ) && defined(USE_EF_UT_TIME)) int tz_is_valid; /* indicates that timezone info can be used */ #endif int noargs; /* did true command line have *any* arguments? */ unsigned filespecs; /* number of real file specifications to be matched */ unsigned xfilespecs; /* number of excluded filespecs to be matched */ int process_all_files; int overwrite_mode; /* 0 - query, 1 - always, 2 - never */ int create_dirs; /* used by main(), mapname(), checkdir() */ int extract_flag; int newzip; /* reset in extract.c; used in crypt.c */ //NEIL: WHAT ARE THESE? //LONGINT real_ecrec_offset; //LONGINT expect_ecrec_offset; long csize; /* used by decompr. (NEXTBYTE): must be signed */ long used_csize; /* used by extract_or_test_member(), explode() */ #ifdef DLL int fValidate; /* true if only validating an archive */ int filenotfound; int redirect_data; /* redirect data to memory buffer */ int redirect_text; /* redirect text output to buffer */ # ifndef NO_SLIDE_REDIR int redirect_slide; /* redirect decompression area to mem buffer */ unsigned _wsize; # endif unsigned redirect_size; /* size of redirected output buffer */ u8 *redirect_buffer; /* pointer to head of allocated buffer */ u8 *redirect_pointer; /* pointer past end of written data */ # ifndef NO_SLIDE_REDIR u8 *redirect_sldptr; /* head of decompression slide buffer */ # endif # ifdef OS2DLL cbList(processExternally); /* call-back list */ # endif #endif /* DLL */ char **pfnames; char **pxnames; char sig[4]; char answerbuf[10]; // min_info info[DIR_BLKSIZ]; // min_info *pInfo; #endif /* !FUNZIP */ union work area; /* see unzpriv.h for definition of work */ #ifdef FUNZIP FILE *in; /* file descriptor of compressed stream */ #endif u8 *inbuf; /* input buffer (any size is OK) */ u8 *inptr; /* pointer into input buffer */ int incnt; #ifndef FUNZIP u32 bitbuf; int bits_left; /* unreduce and unshrink only */ int zipeof; char *argv0; /* used for NT and EXE_EXTENSION */ char *wildzipfn; char *zipfn; /* GRR: WINDLL: must nuke any malloc'd zipfn... */ #ifdef USE_STRM_INPUT FILE *zipfd; /* zipfile file descriptor */ #else int zipfd; /* zipfile file handle */ #endif // LONGINT ziplen; //LONGINT cur_zipfile_bufstart; /* extract_or_test, readbuf, ReadByte */ // LONGINT extra_bytes; /* used in unzip.c, misc.c */ u8 *extra_field; /* Unix, VMS, Mac, OS/2, Acorn, ... */ u8 *hold; // local_file_hdr lrec; /* used in unzip.c, extract.c */ // cdir_file_hdr crec; /* used in unzip.c, extract.c, misc.c */ // ecdir_rec ecrec; /* used in unzip.c, extract.c */ // struct stat statbuf; /* used by main, mapname, check_for_newer */ int mem_mode; u8 *outbufptr; /* extract.c static */ u32 outsize; /* extract.c static */ int reported_backslash; /* extract.c static */ int disk_full; int newfile; int didCRlast; /* fileio static */ u32 numlines; /* fileio static: number of lines printed */ int sol; /* fileio static: at start of line */ int no_ecrec; /* process static */ #ifdef SYMLINKS int symlnk; #endif #ifdef NOVELL_BUG_FAILSAFE int dne; /* true if stat() says file doesn't exist */ #endif FILE *outfile; u8 *outbuf; u8 *realbuf; #ifndef VMS /* if SMALL_MEM, outbuf2 is initialized in */ u8 *outbuf2; /* process_zipfiles() (never changes); */ #endif /* else malloc'd ONLY if unshrink and -a */ #endif /* !FUNZIP */ u8 *outptr; u32 outcnt; /* number of chars stored in outbuf */ #ifndef FUNZIP char filename[MAX_PATH]; /* also used by NT for temporary SFX path */ #ifdef CMS_MVS char *tempfn; /* temp file used; erase on close */ #endif char *key; /* crypt static: decryption password or NULL */ int nopwd; /* crypt static */ #endif /* !FUNZIP */ u32 keys[3]; /* crypt static: keys defining pseudo-random sequence */ #if (!defined(DOS_FLX_H68_NLM_OS2_W32) && !defined(AMIGA) && !defined(RISCOS)) #if (!defined(MACOS) && !defined(ATARI) && !defined(VMS)) int echofd; /* ttyio static: file descriptor whose echo is off */ #endif /* !(MACOS || ATARI || VMS) */ #endif /* !(DOS_FLX_H68_NLM_OS2_W32 || AMIGA || RISCOS) */ unsigned hufts; /* track memory usage */ #ifdef USE_ZLIB int inflInit; /* inflate static: zlib inflate() initialized */ z_stream dstrm; /* inflate global: decompression stream */ #else struct huft *fixed_tl; /* inflate static */ struct huft *fixed_td; /* inflate static */ int fixed_bl, fixed_bd; /* inflate static */ unsigned wp; /* inflate static: current position in slide */ u32 bb; /* inflate static: bit buffer */ unsigned bk; /* inflate static: bits in bit buffer */ #endif /* ?USE_ZLIB */ #ifndef FUNZIP #ifdef SMALL_MEM char rgchBigBuffer[512]; char rgchSmallBuffer[96]; char rgchSmallBuffer2[160]; /* boosted to 160 for local3[] in unzip.c */ #endif // MsgFn *message; //InputFn *input; // PauseFn *mpause; // PasswdFn *decr_passwd; //StatCBFn *statreportcb; #ifdef WINDLL LPUSERFUNCTIONS lpUserFunctions; #endif int incnt_leftover; /* so improved NEXTBYTE does not waste input */ u8 *inptr_leftover; #ifdef VMS_TEXT_CONV int VMS_line_state; /* so native VMS variable-length text files are */ int VMS_line_length; /* readable on other platforms */ int VMS_line_pad; #endif #endif /* !FUNZIP */ #ifdef SYSTEM_SPECIFIC_GLOBALS SYSTEM_SPECIFIC_GLOBALS #endif } Uz_Globs; /* end of struct Globals */ /***************************************************************************/ #ifdef FUNZIP # if (!defined(USE_ZLIB) || defined(USE_OWN_CRCTAB)) extern ZCONST u32 near crc_32_tab[256]; # else extern ZCONST u32 Far *crc_32_tab; # endif # define CRC_32_TAB crc_32_tab #else # define CRC_32_TAB G.crc_32_tab #endif Uz_Globs *globalsCtor(void); /* pseudo constant sigs; they are initialized at runtime so unzip executable * won't look like a zipfile */ extern char local_hdr_sig[4]; extern char central_hdr_sig[4]; extern char end_central_sig[4]; /* extern char extd_local_sig[4]; NOT USED YET */ #ifdef REENTRANT # define G (*(Uz_Globs *)pG) # define __G pG # define __G__ pG, # define __GPRO Uz_Globs *pG # define __GPRO__ Uz_Globs *pG, # define __GDEF Uz_Globs *pG; # ifdef USETHREADID extern int lastScan; void deregisterGlobalPointer OF((__GPRO)); Uz_Globs *getGlobalPointer OF((void)); # define GETGLOBALS() Uz_Globs *pG = getGlobalPointer(); # define DESTROYGLOBALS() {free_G_buffers(pG); deregisterGlobalPointer(pG);} # else extern Uz_Globs *GG; # define GETGLOBALS() Uz_Globs *pG = GG; # define DESTROYGLOBALS() {free_G_buffers(pG); free(pG);} # endif /* ?USETHREADID */ # define CONSTRUCTGLOBALS() Uz_Globs *pG = globalsCtor() #else /* !REENTRANT */ extern Uz_Globs G; # define __G # define __G__ # define __GPRO void # define __GPRO__ # define __GDEF # define GETGLOBALS() # define CONSTRUCTGLOBALS() globalsCtor() # define DESTROYGLOBALS() #endif /* ?REENTRANT */ #define uO G.UzO #endif /* __globals_h */ //COPIED FROM Inflate.cpp by Neil int inflate(); void Neil_Init(File Out, File In); extern struct Globals G; hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/License.txt0000644006511100651110000000520110321204023022711 0ustar rossrossThis is version 1999-Oct-05 of the Info-ZIP copyright and license. The definitive version of this document should be available at ftp://ftp.cdrom.com/pub/infozip/license.html indefinitely. Copyright (c) 1990-1999 Info-ZIP. All rights reserved. For the purposes of this copyright and license, "Info-ZIP" is defined as the following set of individuals: Mark Adler, John Bush, Karl Davis, Harald Denker, Jean-Michel Dubois, Jean-loup Gailly, Hunter Goatley, Ian Gorman, Chris Herborth, Dirk Haase, Greg Hartwig, Robert Heath, Jonathan Hudson, Paul Kienitz, David Kirschbaum, Johnny Lee, Onno van der Linden, Igor Mandrichenko, Steve P. Miller, Sergio Monesi, Keith Owens, George Petrov, Greg Roelofs, Kai Uwe Rommel, Steve Salisbury, Dave Smith, Christian Spieler, Antoine Verheijen, Paul von Behren, Rich Wales, Mike White This software is provided "as is," without warranty of any kind, express or implied. In no event shall Info-ZIP or its contributors be held liable for any direct, indirect, incidental, special or consequential damages arising out of the use of or inability to use this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. Redistributions of source code must retain the above copyright notice, definition, disclaimer, and this list of conditions. 2. Redistributions in binary form must reproduce the above copyright notice, definition, disclaimer, and this list of conditions in documentation and/or other materials provided with the distribution. 3. Altered versions--including, but not limited to, ports to new operating systems, existing ports with new graphical interfaces, and dynamic, shared, or static library versions--must be plainly marked as such and must not be misrepresented as being the original source. Such altered versions also must not be misrepresented as being Info-ZIP releases--including, but not limited to, labeling of the altered versions with the names "Info-ZIP" (or any variation thereof, including, but not limited to, different capitalizations), "Pocket UnZip," "WiZ" or "MacZip" without the explicit permission of Info-ZIP. Such altered versions are further prohibited from misrepresentative use of the Zip-Bugs or Info-ZIP e-mail addresses or of the Info-ZIP URL(s). 4. Info-ZIP retains the right to use the names "Info-ZIP," "Zip," "UnZip," "WiZ," "Pocket UnZip," "Pocket Zip," and "MacZip" for its own source and binary releases. hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/ReadZip.cpp0000644006511100651110000000511410321204023022633 0ustar rossross#include "BlueHead.h" bool BlueZip::Read() { File f = FileOpenRead(FileName); //ZIP file if (!FileValid(f)) { ErrMsg("Failed to open the ZIP file"); return false; } bool Res = ScanZip(f); FileClose(f); return Res; } bool BlueZip::ScanZip(File f) { int i, n; //Global enumeration variable long sig; //signature variable //TASK 1: Find the last occurance of 'sigEnd' in the file //Use a 4096 character buffer for decent sized transfers const int BlockSize = 4096; char* EndBuffer = new char[BlockSize + 3]; //do not overflow int fLen = FileLen(f); EndBuffer[0] = 0; //ensure you do not match already present static do { //Copy over the trailing information EndBuffer[BlockSize+0] = EndBuffer[0]; EndBuffer[BlockSize+1] = EndBuffer[2]; EndBuffer[BlockSize+2] = EndBuffer[1]; if (fLen >= BlockSize) { n = 0; fLen -= BlockSize; SeekBeg(f, fLen); FileRead(f, EndBuffer, BlockSize); } else { n = BlockSize - fLen; SeekBeg(f, 0); FileRead(f, &EndBuffer[n], fLen); fLen = 0; } //Look for the end signature for (i = BlockSize; i >= n; i--) { if (stream32(EndBuffer, i) == sigEnd) { //Use n as a temp variable n = fLen + (i-n) + 4; fLen = -1; SeekBeg(f, n); //Skip over the signature break; //for } } } while (fLen > 0); delete[] EndBuffer; //warn: garbage at the end of the file ignored if (fLen == 0) { ErrMsg("Failed to find the end signature"); return false; } //END TASK 1 //TASK 2: Read in the end header ReadEnd(f); //Check for mutliple disks if (data.DiskNum != data.Count) { ErrMsg("Does not support multiple disk archives"); return false; } //END TASK 2 //TASK 3: Read central header //Goto the central header //This is directly before the footer n -= data.Size + 4; SeekBeg(f, n); FilePosDelta = n - data.Offset; #ifdef _DEBUG i = 0; //do a manual count of the files #endif FileRead(f, &sig, 4); zList** next = &Files; while (sig == sigCentral) { zList* z = new zList; // Insert into list *next = z; next = &z->next; z->ReadCentral(f); #ifdef _DEBUG //Maintain a count of the files i++; #endif // Read next signature FileRead(f, &sig, 4); } //END TASK 3 AssertD(data.Count == i); //Unexpected number of items //Neil alteration //DO NOT READ IN THE LOCAL HEADERS, assume they are correct //and do not contain any different information from the //central ones //Results: Speed up, smaller size // Less code for me to write // Does not detect badly encoded ZIP files (but does maintain them) return true; } hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/Store.cpp0000644006511100651110000000275010321204023022374 0ustar rossross#include "BlueHead.h" #include #include "inflate.h" void FileDataCopy(File From, File To, int Len) { //Optimisation possible, use static buffers from Deflate/Inflate const int BlockSize = 4096; u8 Buffer[BlockSize]; int i; while(Len != 0) { i = min(Len, BlockSize); FileRead(From, Buffer, i); FileWrite(To, Buffer, i); CRC(Buffer, i); //Perform the Len -= i; } } void ReadStore(File In, File Out, zList* z) { //Read from In - the zip file //In is at the start of the file (i.e. sigLocal) //Out is at the begining, currently the length is 0 //z contains the table entry datCentral hLocal; u32 sig; FileRead(In, &sig, 4); Assert(sig == sigLocal); hLocal.ReadLocal(In); //Skip to the begining of the actual data SeekCur(In, hLocal.lFileName + hLocal.lExtra); //Check that WinZip would accept this as a file, that has been stored if (hLocal.CompMode == compStore) { Assert(hLocal.CompSize == hLocal.OrigSize); FileDataCopy(In, Out, hLocal.CompSize); } else { //use the Zip inflate routine //use the global G Neil_Init(Out, In); //If not 0 then a failure, I think inflate(); } } void WriteStore(File In, File Out, zList* z) { //Read from In - the binary file //In is at the begining //Out is the ZIP file, and is ready to receive data //z contains the table entry, including the correct OrigSize //must set CompMode, CompSize z->data.CompMode = compStore; z->data.CompSize = z->data.OrigSize; FileDataCopy(In, Out, z->data.OrigSize); } hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/Structs.cpp0000644006511100651110000000435210321204023022747 0ustar rossross#include "BlueHead.h" #define Set16(pos, res) \ *((u16*) (&data[pos])) = res #define Set32(pos, res) \ *((u32*) (&data[pos])) = res #define Get16(pos) \ *((u16*) (&data[pos])) #define Get32(pos) \ *((u32*) (&data[pos])) void datCentral::ReadLocal(File f) { char data[ldatLocal]; //26 FileRead(f, data, ldatLocal); //16 VerNeed = Get16(0); Flags = Get16(2); CompMode = Get16(4); Time = Get16(6); Date = Get16(8); //32 CRC = Get32(10); CompSize = Get32(14); OrigSize = Get32(18); //16 lFileName = Get16(22); lExtra = Get16(24); } void datCentral::WriteLocal(File f) { char data[ldatLocal]; //26 //16 Set16(0, VerNeed); Set16(2, Flags); Set16(4, CompMode); Set16(6, Time); Set16(8, Date); //32 Set32(10, CRC); Set32(14, CompSize); Set32(18, OrigSize); //16 Set16(22, lFileName); Set16(24, lExtra); FileWrite(f, data, ldatLocal); } void datCentral::Read(File f) { char data[ldatCentral]; //42 FileRead(f, data, ldatCentral); //16 VerMake = Get16(0); VerNeed = Get16(2); Flags = Get16(4); CompMode = Get16(6); Time = Get16(8); Date = Get16(10); //32 CRC = Get32(12); CompSize = Get32(16); OrigSize = Get32(20); //16 lFileName = Get16(24); lExtra = Get16(26); lComment = Get16(28); Disk = Get16(30); IntAttr = Get16(32); //32 ExtAttr = Get32(34); Offset = Get32(38); } void datCentral::Write(File f) { char data[ldatCentral]; //42 //16 Set16(0, VerMake); Set16(2, VerNeed); Set16(4, Flags); Set16(6, CompMode); Set16(8, Time); Set16(10, Date); //32 Set32(12, CRC); Set32(16, CompSize); Set32(20, OrigSize); //16 Set16(24, lFileName); Set16(26, lExtra); Set16(28, lComment); Set16(30, Disk); Set16(32, IntAttr); //32 Set32(34, ExtAttr); Set32(38, Offset); FileWrite(f, data, ldatCentral); } void datEnd::Read(File f) { char data[ldatEnd]; //18 FileRead(f, data, ldatEnd); //16 DiskNo = Get16(0); DiskOne = Get16(2); DiskNum = Get16(4); Count = Get16(6); //32 Size = Get32(8); Offset = Get32(12); //16 lComment = Get16(16); } void datEnd::Write(File f) { char data[ldatEnd]; //18 //16 Set16(0, DiskNo); Set16(2, DiskOne); Set16(4, DiskNum); Set16(6, Count); //32 Set32(8, Size); Set32(12, Offset); //16 Set16(16, lComment); FileWrite(f, data, ldatEnd); } hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/Structs.h0000644006511100651110000000511010321204023022405 0ustar rossross //Compression modes enum CompModes { compStore = 0, compDeflate = 8, }; //Signatures enum Signature { sigLocal = 0x04034b50, sigCentral = 0x02014b50, sigEnd = 0x06054b50, sigExtra = 0x08074b50, //Local }; //Use actual headers //LOCHEAD 26, sizeof(datLocal) = 26 const int ldatLocal = 26; /* Reference only: Use dat Central with some unused fields class datLocal { public: u16 VerNeed; //LOCVER - Version needed to extract u16 Flags; //LOCFLG - encrypt, deflate flags u16 CompMode; //LOCHOW - compression method u16 Time; //LOCTIM - last modified file time, DOS format u16 Date; //LOCDAT - last modified file date, DOS format u32 CRC; //LOCCRC - uncompressed crc-32 for file u32 CompSize; //LOCSIZ - compressed size in zip file u32 OrigSize; //LOCLEN - uncompressed size u16 lFileName; //LOCNAM - length of filename u16 lExtra; //LOCEXT - length of extra field void Read(File f); void Write(File f); }; */ /* NEIL: Not currently required struct datExtra { u32 CRC; //EXTCRC - uncompressed crc-32 for file u32 CompSize; //EXTSIZ - compressed size in zip file u32 OrigSize; //EXTLEN - uncompressed size };*/ //CENHEAD 42, sizeof(datCentral) = 42 const int ldatCentral = 42; class datCentral { public: u16 VerMake; //CENVEM - version made by //SAME AS LOCAL u16 VerNeed; //LOCVER - Version needed to extract u16 Flags; //LOCFLG - encrypt, deflate flags u16 CompMode; //LOCHOW - compression method u16 Time; //LOCTIM - last modified file time, DOS format u16 Date; //LOCDAT - last modified file date, DOS format u32 CRC; //LOCCRC - uncompressed crc-32 for file u32 CompSize; //LOCSIZ - compressed size in zip file u32 OrigSize; //LOCLEN - uncompressed size u16 lFileName; //LOCNAM - length of filename u16 lExtra; //LOCEXT - length of extra field //END u16 lComment; //CENCOM - file comment length u16 Disk; //CENDSK - disk number start u16 IntAttr; //CENATT - internal file attributes u32 ExtAttr; //CENATX - external file attributes u32 Offset; //CENOFF - relative offset of local header void Read(File f); void Write(File f); void ReadLocal(File f); void WriteLocal(File f); }; //ENDHEAD 18, sizeof(datEnd) = 18 const int ldatEnd = 18; class datEnd { public: u16 DiskNo; //ENDDSK - number of this disk u16 DiskOne; //ENDBEG - number of the starting disk u16 DiskNum; //ENDSUB - entries on this disk u16 Count; //ENDTOT - total number of entries u32 Size; //ENDSIZ - size of entire central directory u32 Offset; //ENDOFF - offset of central on starting disk u16 lComment; //ENDCOM - length of zip file comment void Read(File f); void Write(File f); }; hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/Trees.cpp0000644006511100651110000012774110321204023022372 0ustar rossross#include "CompHead.h" #ifndef NO_COMPRESSION /* Copyright (c) 1990-1999 Info-ZIP. All rights reserved. See the accompanying file LICENSE, version 1999-Oct-05 or later (the contents of which are also included in zip.h) for terms of use. If, for some reason, both of these files are missing, the Info-ZIP license also may be found at: ftp://ftp.cdrom.com/pub/infozip/license.html */ /* * trees.c by Jean-loup Gailly * * This is a new version of im_ctree.c originally written by Richard B. Wales * for the defunct implosion method. * The low level bit string handling routines from bits.c (originally * im_bits.c written by Richard B. Wales) have been merged into this version * of trees.c. * * PURPOSE * * Encode various sets of source values using variable-length * binary code trees. * Output the resulting variable-length bit strings. * Compression can be done to a file or to memory. * * DISCUSSION * * The PKZIP "deflation" process uses several Huffman trees. The more * common source values are represented by shorter bit sequences. * * Each code tree is stored in the ZIP file in a compressed form * which is itself a Huffman encoding of the lengths of * all the code strings (in ascending order by source values). * The actual code strings are reconstructed from the lengths in * the UNZIP process, as described in the "application note" * (APPNOTE.TXT) distributed as part of PKWARE's PKZIP program. * * The PKZIP "deflate" file format interprets compressed file data * as a sequence of bits. Multi-bit strings in the file may cross * byte boundaries without restriction. * The first bit of each byte is the low-order bit. * * The routines in this file allow a variable-length bit value to * be output right-to-left (useful for literal values). For * left-to-right output (useful for code strings from the tree routines), * the bits must have been reversed first with bi_reverse(). * * For in-memory compression, the compressed bit stream goes directly * into the requested output buffer. The buffer is limited to 64K on * 16 bit machines; flushing of the output buffer during compression * process is not supported. * The input data is read in blocks by the (*read_buf)() function. * * For more details about input to and output from the deflation routines, * see the actual input functions for (*read_buf)(), flush_outbuf(), and * the filecompress() resp. memcompress() wrapper functions which handle * the I/O setup. * * REFERENCES * * Lynch, Thomas J. * Data Compression: Techniques and Applications, pp. 53-55. * Lifetime Learning Publications, 1985. ISBN 0-534-03418-7. * * Storer, James A. * Data Compression: Methods and Theory, pp. 49-50. * Computer Science Press, 1988. ISBN 0-7167-8156-5. * * Sedgewick, R. * Algorithms, p290. * Addison-Wesley, 1983. ISBN 0-201-06672-6. * * INTERFACE * * void ct_init (ush *attr, int *method) * Allocate the match buffer, initialize the various tables and save * the location of the internal file attribute (ascii/binary) and * method (DEFLATE/STORE) * * void ct_tally (int dist, int lc); * Save the match info and tally the frequency counts. * * u32 flush_block (char *buf, u32 stored_len, int eof) * Determine the best encoding for the current block: dynamic trees, * static trees or store, and output the encoded block to the zip * file. Returns the total compressed length for the file so far. * * void bi_init (char *tgt_buf, unsigned tgt_size, int flsh_allowed) * Initialize the bit string routines. * * Most of the bit string output functions are only used internally * in this source file, they are normally declared as "local" routines: * * local void send_bits (int value, int length) * Write out a bit string, taking the source bits right to * left. * * local unsigned bi_reverse (unsigned code, int len) * Reverse the bits of a bit string, taking the source bits left to * right and emitting them right to left. * * local void bi_windup (void) * Write out any remaining bits in an incomplete byte. * * local void copy_block(char *buf, unsigned len, int header) * Copy a stored block to the zip file, storing first the length and * its one's complement if requested. * * All output that exceeds the bitstring output buffer size (as initialized * by bi_init() is fed through an externally provided transfer routine * which flushes the bitstring output buffer on request and resets the * buffer fill counter: * * extern void flush_outbuf(char *o_buf, unsigned *o_idx); * */ #include /* =========================================================================== * Constants */ const uint MAX_BITS = 15; /* All codes must not exceed MAX_BITS bits */ const uint MAX_BL_BITS = 7; /* Bit length codes must not exceed MAX_BL_BITS bits */ const uint LENGTH_CODES = 29; /* number of length codes, not counting the special END_BLOCK code */ const uint LITERALS = 256; /* number of literal bytes 0..255 */ const uint END_BLOCK = 256; /* end of block literal code */ const uint L_CODES = (LITERALS + 1 + LENGTH_CODES); /* number of Literal or Length codes, including the END_BLOCK code */ const uint D_CODES = 30; /* number of distance codes */ const uint BL_CODES = 19; /* number of codes used to transfer the bit lengths */ int extra_lbits[LENGTH_CODES] /* extra bits for each length code */ = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0}; int extra_dbits[D_CODES] /* extra bits for each distance code */ = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13}; int extra_blbits[BL_CODES]/* extra bits for each bit length code */ = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7}; const uint STORED_BLOCK = 0; const uint STATIC_TREES = 1; const uint DYN_TREES = 2; /* The three kinds of block type */ const uint LIT_BUFSIZE = 0x8000; const uint DIST_BUFSIZE = LIT_BUFSIZE; /* Sizes of match buffers for literals/lengths and distances. There are * 4 reasons for limiting LIT_BUFSIZE to 64K: * - frequencies can be kept in 16 bit counters * - if compression is not successful for the first block, all input data is * still in the window so we can still emit a stored block even when input * comes from standard input. (This can also be done for all blocks if * LIT_BUFSIZE is not greater than 32K.) * - if compression is not successful for a file smaller than 64K, we can * even emit a stored file instead of a stored block (saving 5 bytes). * - creating new Huffman trees less frequently may not provide fast * adaptation to changes in the input data statistics. (Take for * example a binary file with poorly compressible code followed by * a highly compressible string table.) Smaller buffer sizes give * fast adaptation but have of course the overhead of transmitting trees * more frequently. * - I can't count above 4 * The current code is general and allows DIST_BUFSIZE < LIT_BUFSIZE (to save * memory at the expense of compression). Some optimizations would be possible * if we rely on DIST_BUFSIZE == LIT_BUFSIZE. */ const uint REP_3_6 = 16; /* repeat previous bit length 3-6 times (2 bits of repeat count) */ const uint REPZ_3_10 = 17; /* repeat a zero length 3-10 times (3 bits of repeat count) */ const uint REPZ_11_138 = 18; /* repeat a zero length 11-138 times (7 bits of repeat count) */ /* =========================================================================== * Local data */ /* Data structure describing a single value and its code string. */ typedef struct ct_data { union { u16 freq; /* frequency count */ u16 code; /* bit string */ } fc; union { u16 dad; /* father node in Huffman tree */ u16 len; /* length of bit string */ } dl; } ct_data; #define Freq fc.freq #define Code fc.code #define Dad dl.dad #define Len dl.len const uint HEAP_SIZE = (2 * L_CODES) + 1; // maximum heap size ct_data dyn_ltree[HEAP_SIZE]; /* literal and length tree */ ct_data dyn_dtree[2*D_CODES+1]; /* distance tree */ ct_data static_ltree[L_CODES+2]; /* The static literal tree. Since the bit lengths are imposed, there is no * need for the L_CODES extra codes used during heap construction. However * The codes 286 and 287 are needed to build a canonical tree (see ct_init * below). */ ct_data static_dtree[D_CODES]; /* The static distance tree. (Actually a trivial tree since all codes use * 5 bits.) */ ct_data bl_tree[2*BL_CODES+1]; /* Huffman tree for the bit lengths */ struct tree_desc { ct_data near *dyn_tree; /* the dynamic tree */ ct_data near *static_tree; /* corresponding static tree or NULL */ int near *extra_bits; /* extra bits for each code or NULL */ int extra_base; /* base index for extra_bits */ int elems; /* max number of elements in the tree */ int max_length; /* max bit length for the codes */ int max_code; /* largest code with non zero frequency */ }; tree_desc l_desc = {dyn_ltree, static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS, 0}; tree_desc d_desc = {dyn_dtree, static_dtree, extra_dbits, 0, D_CODES, MAX_BITS, 0}; tree_desc bl_desc = {bl_tree, NULL, extra_blbits, 0, BL_CODES, MAX_BL_BITS, 0}; u16 bl_count[MAX_BITS+1]; /* number of codes at each bit length for an optimal tree */ u8 bl_order[BL_CODES] = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15}; /* The lengths of the bit length codes are sent in order of decreasing * probability, to avoid transmitting the lengths for unused bit length codes. */ int heap[2*L_CODES+1]; /* heap used to build the Huffman trees */ int heap_len; /* number of elements in the heap */ int heap_max; /* element of largest frequency */ /* The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used. * The same heap array is used to build all trees. */ u8 near depth[2*L_CODES+1]; /* Depth of each subtree used as tie breaker for trees of equal frequency */ u8 length_code[MaxMatch - MinMatch + 1]; /* length code for each normalized match length (0 == MIN_MATCH) */ u8 dist_code[512]; /* distance codes. The first 256 values correspond to the distances * 3 .. 258, the last 256 values correspond to the top 8 bits of * the 15 bit distances. */ int near base_length[LENGTH_CODES]; /* First normalized length for each code (0 = MIN_MATCH) */ int near base_dist[D_CODES]; /* First normalized distance for each code (0 = distance of 1) */ u8 l_buf[LIT_BUFSIZE]; /* buffer for literals/lengths */ u16 d_buf[DIST_BUFSIZE]; /* buffer for distances */ u8 flag_buf[(LIT_BUFSIZE/8)]; /* flag_buf is a bit array distinguishing literals from lengths in * l_buf, and thus indicating the presence or absence of a distance. */ uint last_lit; /* running index in l_buf */ uint last_dist; /* running index in d_buf */ uint last_flags; /* running index in flag_buf */ u8 flags; /* current flags not yet saved in flag_buf */ u8 flag_bit; /* current bit used in flags */ /* bits are filled in flags starting at bit 0 (least significant). * Note: these flags are overkill in the current code since we don't * take advantage of DIST_BUFSIZE == LIT_BUFSIZE. */ u32 opt_len; /* bit length of current block with optimal trees */ u32 static_len; /* bit length of current block with static trees */ u32 cmpr_bytelen; /* total byte length of compressed file */ u32 cmpr_len_bits; /* number of bits past 'cmpr_bytelen' */ #ifdef _DEBUG u32 input_len; /* total byte length of input file */ /* input_len is for debugging only since we can get it by other means. */ #endif int *file_method; /* pointer to DEFLATE or STORE */ /* =========================================================================== * Local data used by the "bit string" routines. */ int flush_flg; uint bi_buf; /* Output buffer. bits are inserted starting at the bottom (least significant * bits). The width of bi_buf must be at least 16 bits. */ const uint Buf_size = (8 * 2*sizeof(char)); /* Number of bits used within bi_buf. (bi_buf may be implemented on * more than 16 bits on some systems.) */ int bi_valid; /* Number of valid bits in bi_buf. All bits above the last valid bit * are always zero. */ char *out_buf; /* Current output buffer. */ uint out_offset; /* Current offset in output buffer. * On 16 bit machines, the buffer is limited to 64K. */ uint out_size; /* Size of current output buffer */ /* Output a 16 bit value to the bit stream, lower (oldest) byte first */ #define PUTSHORT(w) \ { if (out_offset >= out_size-1) \ flush_outbuf(out_buf, &out_offset); \ out_buf[out_offset++] = (char) ((w) & 0xff); \ out_buf[out_offset++] = (char) ((u16)(w) >> 8); \ } #define PUTBYTE(b) \ { if (out_offset >= out_size) \ flush_outbuf(out_buf, &out_offset); \ out_buf[out_offset++] = (char) (b); \ } #ifdef _DEBUG u32 bits_sent; /* bit length of the compressed data */ extern u32 isize; /* byte length of input file */ #endif extern long BlockStart; /* window offset of current block */ extern uint StrStart; /* window offset of current string */ /* =========================================================================== * Local (static) routines in this file. */ void init_block (void); void pqdownheap (ct_data near *tree, int k); void gen_bitlen (tree_desc near *desc); void gen_codes (ct_data near *tree, int max_code); void build_tree (tree_desc near *desc); void scan_tree (ct_data near *tree, int max_code); void send_tree (ct_data near *tree, int max_code); int build_bl_tree (void); void send_all_trees (int lcodes, int dcodes, int blcodes); void compress_block (ct_data near *ltree, ct_data near *dtree); void set_file_type (void); void send_bits (int value, int length); unsigned bi_reverse (unsigned code, int len); void bi_windup (void); void copy_block (char *buf, unsigned len, int header); #ifndef _DEBUG # define send_code(c, tree) send_bits(tree[c].Code, tree[c].Len) /* Send a code of the given tree. c and tree must not have side effects */ #else /* _DEBUG */ # define send_code(c, tree) \ { ; \ send_bits(tree[c].Code, tree[c].Len); } #endif #define d_code(dist) \ ((dist) < 256 ? dist_code[dist] : dist_code[256+((dist)>>7)]) /* Mapping from a distance to a distance code. dist is the distance - 1 and * must not have side effects. dist_code[256] and dist_code[257] are never * used. */ /* =========================================================================== * Allocate the match buffer, initialize the various tables and save the * location of the internal file attribute (ascii/binary) and method * (DEFLATE/STORE). */ void ct_init(int* method) //ush *attr; /* pointer to internal file attribute */ //int *method; /* pointer to compression method */ { int n; /* iterates over tree elements */ int bits; /* bit counter */ int length; /* length value */ int code; /* code value */ int dist; /* distance index */ file_method = method; cmpr_bytelen = cmpr_len_bits = 0L; #ifdef _DEBUG input_len = 0L; #endif if (static_dtree[0].Len != 0) return; /* ct_init already called */ /* Initialize the mapping length (0..255) -> length code (0..28) */ length = 0; for (code = 0; code < LENGTH_CODES-1; code++) { base_length[code] = length; for (n = 0; n < (1< dist code (0..29) */ dist = 0; for (code = 0 ; code < 16; code++) { base_dist[code] = dist; for (n = 0; n < (1<>= 7; /* from now on, all distances are divided by 128 */ for ( ; code < D_CODES; code++) { base_dist[code] = dist << 7; for (n = 0; n < (1<<(extra_dbits[code]-7)); n++) { dist_code[256 + dist++] = (u8)code; } } Assert(dist == 256);//, "ct_init: 256+dist != 512"); /* Construct the codes of the static literal tree */ for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0; n = 0; while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++; while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++; while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++; while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++; /* Codes 286 and 287 do not exist, but we must include them in the * tree construction to get a canonical Huffman tree (longest code * all ones) */ gen_codes((ct_data near *)static_ltree, L_CODES+1); /* The static distance tree is trivial: */ for (n = 0; n < D_CODES; n++) { static_dtree[n].Len = 5; static_dtree[n].Code = (u16)bi_reverse(n, 5); } /* Initialize the first block of the first file: */ init_block(); } /* =========================================================================== * Initialize a new block. */ void init_block() { int n; /* iterates over tree elements */ /* Initialize the trees. */ for (n = 0; n < L_CODES; n++) dyn_ltree[n].Freq = 0; for (n = 0; n < D_CODES; n++) dyn_dtree[n].Freq = 0; for (n = 0; n < BL_CODES; n++) bl_tree[n].Freq = 0; dyn_ltree[END_BLOCK].Freq = 1; opt_len = static_len = 0L; last_lit = last_dist = last_flags = 0; flags = 0; flag_bit = 1; } #define SMALLEST 1 /* Index within the heap array of least frequent node in the Huffman tree */ /* =========================================================================== * Remove the smallest element from the heap and recreate the heap with * one less element. Updates heap and heap_len. */ #define pqremove(tree, top) \ {\ top = heap[SMALLEST]; \ heap[SMALLEST] = heap[heap_len--]; \ pqdownheap(tree, SMALLEST); \ } /* =========================================================================== * Compares to subtrees, using the tree depth as tie breaker when * the subtrees have equal frequency. This minimizes the worst case length. */ #define smaller(tree, n, m) \ (tree[n].Freq < tree[m].Freq || \ (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m])) /* =========================================================================== * Restore the heap property by moving down the tree starting at node k, * exchanging a node with the smallest of its two sons if necessary, stopping * when the heap property is re-established (each father smaller than its * two sons). */ void pqdownheap(ct_data near *tree, int k) //ct_data near *tree; /* the tree to restore */ //int k; /* node to move down */ { int v = heap[k]; int j = k << 1; /* left son of k */ int htemp; /* required because of bug in SASC compiler */ while (j <= heap_len) { /* Set j to the smallest of the two sons: */ if (j < heap_len && smaller(tree, heap[j+1], heap[j])) j++; /* Exit if v is smaller than both sons */ htemp = heap[j]; if (smaller(tree, v, htemp)) break; /* Exchange v with the smallest son */ heap[k] = htemp; k = j; /* And continue down the tree, setting j to the left son of k */ j <<= 1; } heap[k] = v; } /* =========================================================================== * Compute the optimal bit lengths for a tree and update the total bit length * for the current block. * IN assertion: the fields freq and dad are set, heap[heap_max] and * above are the tree nodes sorted by increasing frequency. * OUT assertions: the field len is set to the optimal bit length, the * array bl_count contains the frequencies for each bit length. * The length opt_len is updated; static_len is also updated if stree is * not null. */ void gen_bitlen(tree_desc near *desc) //tree_desc near *desc; /* the tree descriptor */ { ct_data near *tree = desc->dyn_tree; int near *extra = desc->extra_bits; int base = desc->extra_base; int max_code = desc->max_code; int max_length = desc->max_length; ct_data near *stree = desc->static_tree; int h; /* heap index */ int n, m; /* iterate over the tree elements */ int bits; /* bit length */ int xbits; /* extra bits */ u16 f; /* frequency */ int overflow = 0; /* number of elements with bit length too large */ for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0; /* In a first pass, compute the optimal bit lengths (which may * overflow in the case of the bit length tree). */ tree[heap[heap_max]].Len = 0; /* root of the heap */ for (h = heap_max+1; h < HEAP_SIZE; h++) { n = heap[h]; bits = tree[tree[n].Dad].Len + 1; if (bits > max_length) bits = max_length, overflow++; tree[n].Len = (u16)bits; /* We overwrite tree[n].Dad which is no longer needed */ if (n > max_code) continue; /* not a leaf node */ bl_count[bits]++; xbits = 0; if (n >= base) xbits = extra[n-base]; f = tree[n].Freq; opt_len += (u32)f * (bits + xbits); if (stree) static_len += (u32)f * (stree[n].Len + xbits); } if (overflow == 0) return; /* Find the first bit length which could increase: */ do { bits = max_length-1; while (bl_count[bits] == 0) bits--; bl_count[bits]--; /* move one leaf down the tree */ bl_count[bits+1] += (u16)2; /* move one overflow item as its brother */ bl_count[max_length]--; /* The brother of the overflow item also moves one step up, * but this does not affect bl_count[max_length] */ overflow -= 2; } while (overflow > 0); /* Now recompute all bit lengths, scanning in increasing frequency. * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all * lengths instead of fixing only the wrong ones. This idea is taken * from 'ar' written by Haruhiko Okumura.) */ for (bits = max_length; bits != 0; bits--) { n = bl_count[bits]; while (n != 0) { m = heap[--h]; if (m > max_code) continue; if (tree[m].Len != (u16)bits) { opt_len += ((long)bits-(long)tree[m].Len)*(long)tree[m].Freq; tree[m].Len = (u16)bits; } n--; } } } /* =========================================================================== * Generate the codes for a given tree and bit counts (which need not be * optimal). * IN assertion: the array bl_count contains the bit length statistics for * the given tree and the field len is set for all tree elements. * OUT assertion: the field code is set for all tree elements of non * zero code length. */ void gen_codes (ct_data near *tree, int max_code) //ct_data near *tree; /* the tree to decorate */ //int max_code; /* largest code with non zero frequency */ { u16 next_code[MAX_BITS+1]; /* next code value for each bit length */ u16 code = 0; /* running code value */ int bits; /* bit index */ int n; /* code index */ /* The distribution counts are first used to generate the code values * without bit reversal. */ for (bits = 1; bits <= MAX_BITS; bits++) { next_code[bits] = code = (u16)((code + bl_count[bits-1]) << 1); } /* Check that the bit counts in bl_count are consistent. The last code * must be all ones. */ Assert(code + bl_count[MAX_BITS]-1 == (1<< ((u16) MAX_BITS)) - 1);//inconsistent bit counts for (n = 0; n <= max_code; n++) { int len = tree[n].Len; if (len == 0) continue; /* Now reverse the bits */ tree[n].Code = (u16)bi_reverse(next_code[len]++, len); } } /* =========================================================================== * Construct one Huffman tree and assigns the code bit strings and lengths. * Update the total bit length for the current block. * IN assertion: the field freq is set for all tree elements. * OUT assertions: the fields len and code are set to the optimal bit length * and corresponding code. The length opt_len is updated; static_len is * also updated if stree is not null. The field max_code is set. */ void build_tree(tree_desc near *desc) //tree_desc near *desc; /* the tree descriptor */ { ct_data near *tree = desc->dyn_tree; ct_data near *stree = desc->static_tree; int elems = desc->elems; int n, m; /* iterate over heap elements */ int max_code = -1; /* largest code with non zero frequency */ int node = elems; /* next internal node of the tree */ /* Construct the initial heap, with least frequent element in * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1]. * heap[0] is not used. */ heap_len = 0, heap_max = HEAP_SIZE; for (n = 0; n < elems; n++) { if (tree[n].Freq != 0) { heap[++heap_len] = max_code = n; depth[n] = 0; } else { tree[n].Len = 0; } } /* The pkzip format requires that at least one distance code exists, * and that at least one bit should be sent even if there is only one * possible code. So to avoid special checks later on we force at least * two codes of non zero frequency. */ while (heap_len < 2) { int new_ = heap[++heap_len] = (max_code < 2 ? ++max_code : 0); tree[new_].Freq = 1; depth[new_] = 0; opt_len--; if (stree) static_len -= stree[new_].Len; /* new is 0 or 1 so it does not have extra bits */ } desc->max_code = max_code; /* The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree, * establish sub-heaps of increasing lengths: */ for (n = heap_len/2; n >= 1; n--) pqdownheap(tree, n); /* Construct the Huffman tree by repeatedly combining the least two * frequent nodes. */ do { pqremove(tree, n); /* n = node of least frequency */ m = heap[SMALLEST]; /* m = node of next least frequency */ heap[--heap_max] = n; /* keep the nodes sorted by frequency */ heap[--heap_max] = m; /* Create a new node father of n and m */ tree[node].Freq = (u16)(tree[n].Freq + tree[m].Freq); depth[node] = (u8) (max(depth[n], depth[m]) + 1); tree[n].Dad = tree[m].Dad = (u16)node; /* and insert the new node in the heap */ heap[SMALLEST] = node++; pqdownheap(tree, SMALLEST); } while (heap_len >= 2); heap[--heap_max] = heap[SMALLEST]; /* At this point, the fields freq and dad are set. We can now * generate the bit lengths. */ gen_bitlen((tree_desc near *)desc); /* The field len is now set, we can generate the bit codes */ gen_codes ((ct_data near *)tree, max_code); } /* =========================================================================== * Scan a literal or distance tree to determine the frequencies of the codes * in the bit length tree. Updates opt_len to take into account the repeat * counts. (The contribution of the bit length codes will be added later * during the construction of bl_tree.) */ void scan_tree (ct_data near *tree, int max_code) //ct_data near *tree; /* the tree to be scanned */ //int max_code; /* and its largest code of non zero frequency */ { int n; /* iterates over all tree elements */ int prevlen = -1; /* last emitted length */ int curlen; /* length of current code */ int nextlen = tree[0].Len; /* length of next code */ int count = 0; /* repeat count of the current code */ int max_count = 7; /* max repeat count */ int min_count = 4; /* min repeat count */ if (nextlen == 0) max_count = 138, min_count = 3; tree[max_code+1].Len = (u16)-1; /* guard */ for (n = 0; n <= max_code; n++) { curlen = nextlen; nextlen = tree[n+1].Len; if (++count < max_count && curlen == nextlen) { continue; } else if (count < min_count) { bl_tree[curlen].Freq += (u16)count; } else if (curlen != 0) { if (curlen != prevlen) bl_tree[curlen].Freq++; bl_tree[REP_3_6].Freq++; } else if (count <= 10) { bl_tree[REPZ_3_10].Freq++; } else { bl_tree[REPZ_11_138].Freq++; } count = 0; prevlen = curlen; if (nextlen == 0) { max_count = 138, min_count = 3; } else if (curlen == nextlen) { max_count = 6, min_count = 3; } else { max_count = 7, min_count = 4; } } } /* =========================================================================== * Send a literal or distance tree in compressed form, using the codes in * bl_tree. */ void send_tree (ct_data near *tree, int max_code) //ct_data near *tree; /* the tree to be scanned */ //int max_code; /* and its largest code of non zero frequency */ { int n; /* iterates over all tree elements */ int prevlen = -1; /* last emitted length */ int curlen; /* length of current code */ int nextlen = tree[0].Len; /* length of next code */ int count = 0; /* repeat count of the current code */ int max_count = 7; /* max repeat count */ int min_count = 4; /* min repeat count */ /* tree[max_code+1].Len = -1; */ /* guard already set */ if (nextlen == 0) max_count = 138, min_count = 3; for (n = 0; n <= max_code; n++) { curlen = nextlen; nextlen = tree[n+1].Len; if (++count < max_count && curlen == nextlen) { continue; } else if (count < min_count) { do { send_code(curlen, bl_tree); } while (--count != 0); } else if (curlen != 0) { if (curlen != prevlen) { send_code(curlen, bl_tree); count--; } Assert(count >= 3 && count <= 6);//, " 3_6?"); send_code(REP_3_6, bl_tree); send_bits(count-3, 2); } else if (count <= 10) { send_code(REPZ_3_10, bl_tree); send_bits(count-3, 3); } else { send_code(REPZ_11_138, bl_tree); send_bits(count-11, 7); } count = 0; prevlen = curlen; if (nextlen == 0) { max_count = 138, min_count = 3; } else if (curlen == nextlen) { max_count = 6, min_count = 3; } else { max_count = 7, min_count = 4; } } } /* =========================================================================== * Construct the Huffman tree for the bit lengths and return the index in * bl_order of the last bit length code to send. */ int build_bl_tree() { int max_blindex; /* index of last bit length code of non zero freq */ /* Determine the bit length frequencies for literal and distance trees */ scan_tree((ct_data near *)dyn_ltree, l_desc.max_code); scan_tree((ct_data near *)dyn_dtree, d_desc.max_code); /* Build the bit length tree: */ build_tree((tree_desc near *)(&bl_desc)); /* opt_len now includes the length of the tree representations, except * the lengths of the bit lengths codes and the 5+5+4 bits for the counts. */ /* Determine the number of bit length codes to send. The pkzip format * requires that at least 4 bit length codes be sent. (appnote.txt says * 3 but the actual value used is 4.) */ for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) { if (bl_tree[bl_order[max_blindex]].Len != 0) break; } /* Update opt_len to include the bit length tree and counts */ opt_len += 3*(max_blindex+1) + 5+5+4; return max_blindex; } /* =========================================================================== * Send the header for a block using dynamic Huffman trees: the counts, the * lengths of the bit length codes, the literal tree and the distance tree. * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. */ void send_all_trees(int lcodes, int dcodes, int blcodes) //int lcodes, dcodes, blcodes; /* number of codes for each tree */ { int rank; /* index in bl_order */ Assert(lcodes >= 257 && dcodes >= 1 && blcodes >= 4);//, "not enough codes"); Assert(lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES);//, //"too many codes"); send_bits(lcodes-257, 5); /* not +255 as stated in appnote.txt 1.93a or -256 in 2.04c */ send_bits(dcodes-1, 5); send_bits(blcodes-4, 4); /* not -3 as stated in appnote.txt */ for (rank = 0; rank < blcodes; rank++) { send_bits(bl_tree[bl_order[rank]].Len, 3); } send_tree((ct_data near *)dyn_ltree, lcodes-1); /* send the literal tree */ send_tree((ct_data near *)dyn_dtree, dcodes-1); /* send the distance tree */ } /* =========================================================================== * Determine the best encoding for the current block: dynamic trees, static * trees or store, and output the encoded block to the zip file. This function * returns the total compressed length (in bytes) for the file so far. */ u32 flush_block(char *buf, u32 stored_len, int eof) //char *buf; /* input block, or NULL if too old */ //u32 stored_len; /* length of input block */ //int eof; /* true if this is the last block for a file */ { u32 opt_lenb, static_lenb; /* opt_len and static_len in bytes */ int max_blindex; /* index of last bit length code of non zero freq */ flag_buf[last_flags] = flags; /* Save the flags for the last 8 items */ /* Construct the literal and distance trees */ build_tree((tree_desc near *)(&l_desc)); build_tree((tree_desc near *)(&d_desc)); /* At this point, opt_len and static_len are the total bit lengths of * the compressed block data, excluding the tree representations. */ /* Build the bit length tree for the above two trees, and get the index * in bl_order of the last bit length code to send. */ max_blindex = build_bl_tree(); /* Determine the best encoding. Compute first the block length in bytes */ opt_lenb = (opt_len+3+7)>>3; static_lenb = (static_len+3+7)>>3; #ifdef _DEBUG input_len += stored_len; /* for debugging only */ #endif if (static_lenb <= opt_lenb) opt_lenb = static_lenb; /* If compression failed and this is the first and last block, * the whole file is transformed into a stored file: */ if (stored_len <= opt_lenb && eof && file_method != NULL && cmpr_bytelen == 0L && cmpr_len_bits == 0L) { /* Since LIT_BUFSIZE <= 2*WSIZE, the input data must be there: */ if (buf == NULL) error ("block vanished"); copy_block(buf, (unsigned)stored_len, 0); /* without header */ cmpr_bytelen = stored_len; *file_method = compStore; } else if (stored_len+4 <= opt_lenb && buf != (char*)NULL) { /* 4: two words for the lengths * /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE. * Otherwise we can't have processed more than WSIZE input bytes since * the last block flush, because compression would have been * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to * transform a block into a stored block. */ send_bits((STORED_BLOCK<<1)+eof, 3); /* send block type */ cmpr_bytelen += ((cmpr_len_bits + 3 + 7) >> 3) + stored_len + 4; cmpr_len_bits = 0L; copy_block(buf, (unsigned)stored_len, 1); /* with header */ } else if (static_lenb == opt_lenb) { send_bits((STATIC_TREES<<1)+eof, 3); compress_block((ct_data near *)static_ltree, (ct_data near *)static_dtree); cmpr_len_bits += 3 + static_len; cmpr_bytelen += cmpr_len_bits >> 3; cmpr_len_bits &= 7L; } else { send_bits((DYN_TREES<<1)+eof, 3); send_all_trees(l_desc.max_code+1, d_desc.max_code+1, max_blindex+1); compress_block((ct_data near *)dyn_ltree, (ct_data near *)dyn_dtree); cmpr_len_bits += 3 + opt_len; cmpr_bytelen += cmpr_len_bits >> 3; cmpr_len_bits &= 7L; } AssertD(((cmpr_bytelen << 3) + cmpr_len_bits) == bits_sent);//, //"bad compressed size"); init_block(); if (eof) { AssertD(input_len == isize);//, "bad input size"); bi_windup(); cmpr_len_bits += 7; /* align on byte boundary */ } return cmpr_bytelen + (cmpr_len_bits >> 3); } /* =========================================================================== * Save the match info and tally the frequency counts. Return true if * the current block must be flushed. */ bool ct_tally (int dist, int lc) //int dist; /* distance of matched string */ //int lc; /* match length-MIN_MATCH or unmatched char (if dist==0) */ { l_buf[last_lit++] = (u8)lc; if (dist == 0) { /* lc is the unmatched char */ dyn_ltree[lc].Freq++; } else { /* Here, lc is the match length - MIN_MATCH */ dist--; /* dist = match distance - 1 */ Assert((u16)dist < (u16)MaxDist && (u16)lc <= (u16)(MaxMatch - MinMatch) && (u16)d_code(dist) < (u16)D_CODES);//, "ct_tally: bad match"); dyn_ltree[length_code[lc]+LITERALS+1].Freq++; dyn_dtree[d_code(dist)].Freq++; d_buf[last_dist++] = (u16)dist; flags |= flag_bit; } flag_bit <<= 1; /* Output the flags if they fill a byte: */ if ((last_lit & 7) == 0) { flag_buf[last_flags++] = flags; flags = 0, flag_bit = 1; } /* Try to guess if it is profitable to stop the current block here */ if ((last_lit & 0xfff) == 0) { /* Compute an upper bound for the compressed length */ u32 out_length = (u32)last_lit*8L; u32 in_length = (u32)StrStart-BlockStart; int dcode; for (dcode = 0; dcode < D_CODES; dcode++) { out_length += (u32)dyn_dtree[dcode].Freq*(5L+extra_dbits[dcode]); } out_length >>= 3; if (last_dist < last_lit/2 && out_length < in_length/2) return true; } return ((last_lit == LIT_BUFSIZE-1) || (last_dist == DIST_BUFSIZE)); /* We avoid equality with LIT_BUFSIZE because of wraparound at 64K * on 16 bit machines and because stored blocks are restricted to * 64K-1 bytes. */ } /* =========================================================================== * Send the block data compressed using the given Huffman trees */ void compress_block(ct_data near *ltree, ct_data near *dtree) //ct_data near *ltree; /* literal tree */ //ct_data near *dtree; /* distance tree */ { unsigned dist; /* distance of matched string */ int lc; /* match length or unmatched char (if dist == 0) */ unsigned lx = 0; /* running index in l_buf */ unsigned dx = 0; /* running index in d_buf */ unsigned fx = 0; /* running index in flag_buf */ u8 flag = 0; /* current flags */ unsigned code; /* the code to send */ int extra; /* number of extra bits to send */ if (last_lit != 0) do { if ((lx & 7) == 0) flag = flag_buf[fx++]; lc = l_buf[lx++]; if ((flag & 1) == 0) { send_code(lc, ltree); /* send a literal byte */ } else { /* Here, lc is the match length - MIN_MATCH */ code = length_code[lc]; send_code(code+LITERALS+1, ltree); /* send the length code */ extra = extra_lbits[code]; if (extra != 0) { lc -= base_length[code]; send_bits(lc, extra); /* send the extra length bits */ } dist = d_buf[dx++]; /* Here, dist is the match distance - 1 */ code = d_code(dist); Assert(code < D_CODES);//, "bad d_code"); send_code(code, dtree); /* send the distance code */ extra = extra_dbits[code]; if (extra != 0) { dist -= base_dist[code]; send_bits(dist, extra); /* send the extra distance bits */ } } /* literal or match pair ? */ flag >>= 1; } while (lx < last_lit); send_code(END_BLOCK, ltree); } /* =========================================================================== * Initialize the bit string routines. */ void bi_init (char *tgt_buf, unsigned tgt_size, int flsh_allowed) //char *tgt_buf; //unsigned tgt_size; //int flsh_allowed; { out_buf = tgt_buf; out_size = tgt_size; out_offset = 0; flush_flg = flsh_allowed; bi_buf = 0; bi_valid = 0; #ifdef _DEBUG bits_sent = 0L; #endif } /* =========================================================================== * Send a value on a given number of bits. * IN assertion: length <= 16 and value fits in length bits. */ void send_bits(int value, int length) //int value; /* value to send */ //int length; /* number of bits */ { #ifdef _DEBUG Assert(length > 0 && length <= 15);//, "invalid length"); bits_sent += (u32)length; #endif /* If not enough room in bi_buf, use (bi_valid) bits from bi_buf and * (Buf_size - bi_valid) bits from value to flush the filled bi_buf, * then fill in the rest of (value), leaving (length - (Buf_size-bi_valid)) * unused bits in bi_buf. */ bi_buf |= (value << bi_valid); bi_valid += length; if (bi_valid > (int)Buf_size) { PUTSHORT(bi_buf); bi_valid -= Buf_size; bi_buf = (unsigned)value >> (length - bi_valid); } } /* =========================================================================== * Reverse the first len bits of a code, using straightforward code (a faster * method would use a table) * IN assertion: 1 <= len <= 15 */ unsigned bi_reverse(unsigned code, int len) //unsigned code; /* the value to invert */ //int len; /* its bit length */ { register unsigned res = 0; do { res |= code & 1; code >>= 1, res <<= 1; } while (--len > 0); return res >> 1; } /* =========================================================================== * Write out any remaining bits in an incomplete byte. */ void bi_windup() { if (bi_valid > 8) { PUTSHORT(bi_buf); } else if (bi_valid > 0) { PUTBYTE(bi_buf); } if (flush_flg) { flush_outbuf(out_buf, &out_offset); } bi_buf = 0; bi_valid = 0; #ifdef _DEBUG bits_sent = (bits_sent+7) & ~7; #endif } /* =========================================================================== * Copy a stored block to the zip file, storing first the length and its * one's complement if requested. */ void copy_block(char *block, unsigned len, int header) //char *block; /* the input data */ //unsigned len; /* its length */ //int header; /* true if block header must be written */ { bi_windup(); /* align on byte boundary */ if (header) { PUTSHORT((u16)len); PUTSHORT((u16)~len); #ifdef _DEBUG bits_sent += 2*16; #endif } if (flush_flg) { flush_outbuf(out_buf, &out_offset); out_offset = len; flush_outbuf(block, &out_offset); } else if (out_offset + len > out_size) { error("output buffer too small for in-memory compression"); } else { memcpy(out_buf + out_offset, block, len); out_offset += len; } #ifdef _DEBUG bits_sent += (u32)len<<3; #endif } #endif //!NO_COMPRESSION hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/WriteZip.cpp0000644006511100651110000000423110321204023023051 0ustar rossross#include "BlueHead.h" #ifndef NO_COMPRESSION //Write the file back out, with the changes bool BlueZip::Write(bool Store) { //TODO: Do not use a TempFile, send straight to the output char TempFileName[MAX_PATH]; File f; zList* z; zList** next = &Files; //where to insert the next zList int i, j; //global enumeration variables if ((Files == NULL) && (Pending == NULL)) { ErrMsg("Blank ZIP files not allowed"); return false; } //Always use a temporary file name (they may have the ZIP file on a floppy) f = FileOpenTemp(TempFileName); if (!FileValid(f)) { ErrMsg(Failed to open the temporary file); return false; } if (Files != NULL) { File Orig = FileOpenRead(FileName); if (!FileValid(Orig)) { ErrMsg("Failed to open the reading file"); return false; } const int BlockSize = 4096; char* Buffer = new char[BlockSize]; datCentral hLocal; for (z = Files; z != NULL; z = z->next) { if (!z->Delete) { //Remove any that have dropped out of the list *next = z; next = &z->next; //Perform a ZIP copy SeekBeg(Orig, z->data.Offset + z->FileDeltaPos); z->data.Offset = FilePos(f); u32 sig; FileRead(Orig, &sig, 4); Assert(sig == sigLocal); FileWrite(f, &sig, 4); hLocal.ReadLocal(Orig); hLocal.WriteLocal(f); i = hLocal.CompSize + hLocal.lFileName + hLocal.lExtra; while(i != 0) { j = min(i, BlockSize); FileRead(Orig, Buffer, j); FileWrite(f, Buffer, j); i -= j; } } } FileClose(Orig); delete[] Buffer; } while (Pending != NULL) { fList* fAdd = Pending; Pending = Pending->next; z = fAdd->ZipUp(f, Store); if (z == NULL) { ErrMsg("Failed to add the file"); } else { *next = z; next = &z->next; } delete fAdd; } //Write out the central header data.Count = 0; data.Offset = FilePos(f); for (z = Files; z != NULL; z = z->next, data.Count++) z->WriteCentral(f); data.Size = FilePos(f) - data.Offset; WriteEnd(f); FileClose(f); //Using a temp file if (!FileReplace(FileName, TempFileName)) { ErrMsg("Failed to copy the temporary file"); return false; } return true; } #endif //!NO_COMPRESSION hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/fList.cpp0000644006511100651110000000435610321204023022365 0ustar rossross#include "BlueHead.h" #ifndef NO_COMPRESSION /* : Required by the deflate routines */ void SetupDeftree(File In, File Out, int my_level); u32 filecompress(int* method); u32 GetCRC(); fList::fList(LPCTSTR NewFile, fList* prev) { FileName = CopyString(NewFile); //Replace \ with / int i; for (i = 0; FileName[i] != 0; i++) { if (FileName[i] == '\\') FileName[i] = '/'; } next = prev; } fList::~fList() { if (FileName != NULL) delete[] FileName; } zList* fList::ZipUp(File f, bool Store) { zList* z = new zList; //Open the new file File In = FileOpenRead(FileName); if (!FileValid(In)) { ErrMsg("Failed to open the file to compress in"); return NULL; } z->data.ExtAttr = FileGetAttrib(In, FileName); //Copy over the filename char* s = strrchr(FileName, '/'); if (s == NULL) { z->FileName = FileName; } else { z->FileName = CopyString(&s[1]); delete[] FileName; } FileName = NULL; z->data.lFileName = strlen(z->FileName); //Get some information on the filename //Not implemented properly yet //PK[UN]ZIP 2.0 made these files and will be able to extract them z->data.VerMake = 20; z->data.Disk = 0; z->data.Offset = FilePos(f); z->data.Disk = 0; z->data.IntAttr = 0; //BINARY - like I care if it's text? FileGetDate(In, &z->data); z->data.lExtra = 0; z->data.lComment = 0; z->data.OrigSize = FileLen(In); //Info-Zip would write out the local header here SeekCur(f, 4 + ldatLocal + z->data.lFileName); //Just store it InitCRC(); if (Store) //Just store it WriteStore(In, f, z); else { /* CRC CHECK u8* Buffer = new u8[z->data.CompSize]; SeekBeg(In, 0); FileRead(In, Buffer, z->data.CompSize); FileWrite(f, Buffer, z->data.CompSize); z->data.CRC = CRC(0, Buffer, z->data.CompSize); delete[] Buffer; */ int Method = compDeflate; SetupDeftree(In, f, 9); z->data.CompSize = filecompress(&Method); z->data.CompMode = Method; } z->data.CRC = GetCRC(); z->data.VerNeed = (z->data.CompMode == compDeflate ? 20 : 10); //Version needed is 20, because using compress, 10 for just store //WinZIP compatible hacks z->data.Flags = 2; FileClose(In); int LocalFileEnd = FilePos(f); SeekBeg(f, z->data.Offset); z->WriteLocal(f); SeekBeg(f, LocalFileEnd); return z; } #endif //!NO_COMPRESSION hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/fList.h0000644006511100651110000000030210321204023022015 0ustar rossross #ifndef NO_COMPRESSION class fList { public: char* FileName; fList* next; fList(LPCTSTR FileName, fList* prev); ~fList(); zList* ZipUp(File f, bool Store); }; #endif //!NO_COMPRESSION hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/zList.cpp0000644006511100651110000000227410321204023022406 0ustar rossross#include "BlueHead.h" zList::zList() { FileName = NULL; Extra = NULL; Comment = NULL; next = NULL; Delete = false; } zList::~zList() { if (FileName) delete[] FileName; if (Extra) delete[] Extra; if (Comment) delete[] Comment; } void zList::WriteLocal(File f) { long l = sigLocal; FileWrite(f, &l, 4); data.WriteLocal(f); FileWrite(f, FileName, data.lFileName); if (data.lExtra) FileWrite(f, Extra, data.lExtra); //No comment available, only in central header } void zList::WriteCentral(File f) { long l = sigCentral; FileWrite(f, &l, 4); data.Write(f); FileWrite(f, FileName, data.lFileName); if (data.lExtra) FileWrite(f, Extra, data.lExtra); if (data.lComment) FileWrite(f, Comment, data.lComment); } void zList::ReadCentral(File f) { data.Read(f); // Read file name, extra field and comment field // if (z->nam == 0) then 0 length name error FileName = new char[data.lFileName+1]; FileRead(f, FileName, data.lFileName); FileName[data.lFileName] = '\0'; // terminate name if (data.lExtra) { Extra = new char[data.lExtra]; FileRead(f, Extra, data.lExtra); } if (data.lComment) { Comment = new char[data.lComment]; FileRead(f, Comment, data.lComment); } } hugs98-plus-Sep2006/src/winhugs/installer/BlueZip/zList.h0000644006511100651110000000102410323201411022043 0ustar rossross// Structures for in-memory file information class __declspec(dllexport) zList { public: datCentral data; char* FileName; //File name in zip file char* Extra; //Extra in central char* Comment; //Comment (set only if com != 0) bool Delete; //Should the file be removed on execute zList* next; zList(); ~zList(); void WriteCentral(File f); void ReadCentral(File f); void WriteLocal(File f); int OriginalSize(){return data.OrigSize;} int CompressedSize(){return data.CompSize;} long CRC(){return data.CRC;} }; hugs98-plus-Sep2006/src/winhugs/installer/FileCode.cpp0000644006511100651110000000422510323160370021407 0ustar rossross#include "Header.h" struct FolderItem { char* Folder; FolderItem* Next; }; FolderItem* CreatedFolders = NULL; bool Exists(char* File) { return (GetFileAttributes(File) != 0xffffffff); } bool ExistsDir(char* File) { DWORD Attr = GetFileAttributes(File); return ((Attr != 0xffffffff) && (Attr & FILE_ATTRIBUTE_DIRECTORY)); } bool CanReadWrite(char* File) { HANDLE hFile = CreateFile(File, GENERIC_READ | GENERIC_WRITE, 0, NULL, OPEN_EXISTING, 0, NULL); if (hFile == INVALID_HANDLE_VALUE) return false; CloseHandle(hFile); return true; } void NormalPath(char* File) { for (int i = 0; File[i] != 0; i++) { if (File[i] == '/') File[i] = '\\'; } if (File[i-1] == '\\') File[i-1] = 0; } bool ParentFolder(char* File) { char* s = strrchr(File, '\\'); if (s == NULL) return false; s[0] = 0; return true; } void UnparentFolder(char* File) { File[strlen(File)] = '\\'; } bool EnsureFolder(char* File) { if (ExistsDir(File)) return true; if (ParentFolder(File)) { bool Res = EnsureFolder(File); UnparentFolder(File); if (!Res) return false; } bool Res = (CreateDirectory(File, NULL) != 0); if (Res) { FolderItem* tmp = CreatedFolders; CreatedFolders = new FolderItem; CreatedFolders->Folder = strdup(File); CreatedFolders->Next = tmp; } return Res; } void DeleteFolders() { while (CreatedFolders != NULL) { RemoveDirectory(CreatedFolders->Folder); free(CreatedFolders->Folder); FolderItem* i = CreatedFolders; CreatedFolders = CreatedFolders->Next; delete i; } } void FileSize(__int64 Size, char* Buffer) { //set the number of bytes as a Windows standard file count const TCHAR PreFix[] = "KMGTP"; //make sure to 3 sf if (Size < 1000) { itoa((int) Size, Buffer, 10); strcat(Buffer, " bytes"); } else { int i; __int64 j = 1024; for (i = 0; Size > j * 999; i++) j *= 1024; itoa((int) (Size / j), Buffer, 10); int k = strlen(Buffer); if (k != 3) { Buffer[k] = '.'; j = ((Size % j) * 1000) / j; int l = 100; for (k++; k != 4; k++) { Buffer[k] = (char) (j / l) + '0'; j %= l; l /= 10; } } Buffer[k + 0] = PreFix[i]; Buffer[k + 1] = 'B'; Buffer[k + 2] = 0; } } hugs98-plus-Sep2006/src/winhugs/installer/FileCode.h0000644006511100651110000000036310323160370021053 0ustar rossross bool Exists(char* File); bool ExistsDir(char* File); bool CanReadWrite(char* File); void NormalPath(char* File); bool EnsureFolder(char* File); void DeleteFolders(); void FileSize(__int64 Size, char* Buffer); const int MaxFileSizeBuf = 10; hugs98-plus-Sep2006/src/winhugs/installer/Header.h0000644006511100651110000000012610321204023020556 0ustar rossross#define WIN32_MEAN_AND_LEAN #include const int MyMaxPath = MAX_PATH * 2; hugs98-plus-Sep2006/src/winhugs/installer/InstallLog.cpp0000644006511100651110000000141310323203022021771 0ustar rossross#include "Header.h" HANDLE hFile = INVALID_HANDLE_VALUE; char* FileName = NULL; void StartInstallLog(char* File) { hFile = CreateFile(File, GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); FileName = strdup(File); } void StopInstallLog(bool Delete) { if (hFile != INVALID_HANDLE_VALUE) { CloseHandle(hFile); hFile = INVALID_HANDLE_VALUE; if (Delete) DeleteFile(FileName); } if (FileName != NULL) { free(FileName); FileName = NULL; } } void WriteInstallLog(char* Format, ...) { if (hFile == INVALID_HANDLE_VALUE) return; char Buffer[MyMaxPath]; va_list marker; va_start(marker, Format); wvsprintf(Buffer, Format, marker); strcat(Buffer, "\r\n"); DWORD dw; WriteFile(hFile, Buffer, strlen(Buffer), &dw, NULL); } hugs98-plus-Sep2006/src/winhugs/installer/InstallLog.h0000644006511100651110000000015710323203022021442 0ustar rossross void StartInstallLog(char* File); void StopInstallLog(bool Delete); void WriteInstallLog(char* Format, ...); hugs98-plus-Sep2006/src/winhugs/installer/Installer.rc0000644006511100651110000000770210322463001021513 0ustar rossross// Microsoft Visual C++ generated resource script. // #include "resource.h" #define APSTUDIO_READONLY_SYMBOLS ///////////////////////////////////////////////////////////////////////////// // // Generated from the TEXTINCLUDE 2 resource. // #include "afxres.h" ///////////////////////////////////////////////////////////////////////////// #undef APSTUDIO_READONLY_SYMBOLS ///////////////////////////////////////////////////////////////////////////// // English (U.K.) resources #if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENG) #ifdef _WIN32 LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_UK #pragma code_page(1252) #endif //_WIN32 #ifdef APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // TEXTINCLUDE // 1 TEXTINCLUDE BEGIN "resource.h\0" END 2 TEXTINCLUDE BEGIN "#include ""afxres.h""\r\n" "\0" END 3 TEXTINCLUDE BEGIN "\r\n" "\0" END #endif // APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // Dialog // dlgInstall DIALOGEX 0, 0, 308, 193 STYLE DS_SETFONT | DS_MODALFRAME | DS_FIXEDSYS | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "WinHugs Installer" FONT 8, "MS Shell Dlg", 400, 0, 0x0 BEGIN LTEXT "#",lblInstallTo,7,42,294,10,NOT WS_VISIBLE LTEXT "#",lblInstallFile,7,58,294,8,NOT WS_VISIBLE CONTROL "",barTop,"Static",SS_ETCHEDHORZ,0,33,313,1 LTEXT "This will install WinHugs on your computer\n\nPlease select an installation directory.", lblWelcome,7,42,154,25 EDITTEXT txtEdit,7,74,232,12,ES_AUTOHSCROLL PUSHBUTTON "Browse",cmdBrowse,247,73,54,14 PUSHBUTTON "Cancel",IDCANCEL,191,172,50,14 DEFPUSHBUTTON "Install",IDOK,251,172,50,14 CONTROL "Run program after installation",chkExecute,"Button", BS_AUTOCHECKBOX | WS_TABSTOP,7,140,294,11 CONTROL "Create shortcut on Desktop",chkShortcutDesktop,"Button", BS_AUTOCHECKBOX | WS_TABSTOP,7,114,294,10 CONTROL "",IDC_STATIC,"Static",SS_ETCHEDHORZ,-1,164,311,1 LTEXT "Windows Installer © Neil Mitchell 1999-2005",IDC_STATIC, 7,176,155,10,WS_DISABLED CONTROL "Progress2",prgBar,"msctls_progress32",NOT WS_VISIBLE,7, 74,294,12 CONTROL "Register Haskell files (*.hs,*.lhs) to open with WinHugs", chkRegisterFiles,"Button",BS_AUTOCHECKBOX | WS_TABSTOP,7, 127,294,10 LTEXT "#",lblSpace,7,89,294,9 CONTROL 107,IDC_STATIC,"Static",SS_BITMAP | SS_REALSIZEIMAGE,280, 7,21,20 END ///////////////////////////////////////////////////////////////////////////// // // DESIGNINFO // #ifdef APSTUDIO_INVOKED GUIDELINES DESIGNINFO BEGIN dlgInstall, DIALOG BEGIN LEFTMARGIN, 7 RIGHTMARGIN, 301 TOPMARGIN, 7 BOTTOMMARGIN, 186 END END #endif // APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // Icon // // Icon with lowest ID value placed first to ensure application icon // remains consistent on all systems. IDI_ICON1 ICON "Setup.ico" ///////////////////////////////////////////////////////////////////////////// // // RT_MANIFEST // 1 RT_MANIFEST "WinHugs-Installer.manifest" ///////////////////////////////////////////////////////////////////////////// // // Bitmap // bmpInstaller BITMAP "installer.bmp" #endif // English (U.K.) resources ///////////////////////////////////////////////////////////////////////////// #ifndef APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // Generated from the TEXTINCLUDE 3 resource. // ///////////////////////////////////////////////////////////////////////////// #endif // not APSTUDIO_INVOKED hugs98-plus-Sep2006/src/winhugs/installer/Installer.sln0000644006511100651110000000156610321204023021701 0ustar rossrossMicrosoft Visual Studio Solution File, Format Version 8.00 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "Installer", "Installer.vcproj", "{70CA98C8-54E7-4189-881D-498017510231}" ProjectSection(ProjectDependencies) = postProject EndProjectSection EndProject Global GlobalSection(SolutionConfiguration) = preSolution Debug = Debug Release = Release EndGlobalSection GlobalSection(ProjectConfiguration) = postSolution {70CA98C8-54E7-4189-881D-498017510231}.Debug.ActiveCfg = Debug|Win32 {70CA98C8-54E7-4189-881D-498017510231}.Debug.Build.0 = Debug|Win32 {70CA98C8-54E7-4189-881D-498017510231}.Release.ActiveCfg = Release|Win32 {70CA98C8-54E7-4189-881D-498017510231}.Release.Build.0 = Release|Win32 EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution EndGlobalSection GlobalSection(ExtensibilityAddIns) = postSolution EndGlobalSection EndGlobal hugs98-plus-Sep2006/src/winhugs/installer/Installer.vcproj0000644006511100651110000003040310323203150022402 0ustar rossross hugs98-plus-Sep2006/src/winhugs/installer/Parameters.h0000644006511100651110000000121610432101276021503 0ustar rossross//These are configuration parameters //Default directory //The resulting value will be "C:\Program Files\" + Value #define InstallDir "WinHugs" //Primary program //This is the first file that will be checked for overwrite access //If this is the main .exe it will allow them first refusal if they are currently //running the program //Use NULL for no primary file #define PrimaryFile "WinHugs.exe" //Program name //Text of what your program is called #define ProgramName "WinHugs" #define Description "Haskell 98 Interpreter" #define Copyright "1994-2006" #define Publisher "The Hugs Team" #define Website "http://www.haskell.org/hugs/" hugs98-plus-Sep2006/src/winhugs/installer/Readme.txt0000644006511100651110000000045410321204023021157 0ustar rossrossWindows installer, slightly modified from the one for Pingus . Original and modifications by Neil Mitchell. Please avoid reformatting the source, as Neil wishes to coordinate the two versions. Hopefully the common bits will be split off into a separate package some time. hugs98-plus-Sep2006/src/winhugs/installer/Setup.ico0000644006511100651110000000206610321204023021016 0ustar rossross(& èN( €€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿwwwwww'xˆˆˆˆˆ¨pxDDDDHpx Ì0ÌÈpx û» Èpx ;° °Èpx ; °°Èpx ;»»°Èpx ; °°Èpx û» Èpx Ì30ÌÈpxpxˆˆˆˆˆˆpÿÿÿÿÿÿpwwwwwwp€€À( @€€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿxˆˆpðÿÿwÿÿxpÿÿx‡ÿÿxˆppÿÿÿ÷wwpÿÿxˆ€wˆˆwÿÿxˆ€w€ðˆwpLÌÌAˆ€wˆwpLÌÌD€w‡wwwwˆwpLÌÌDA€wˆˆˆˆˆˆwpLÌÌDDˆÿÿÿÿÿÿwpLÌÌD@wwwwwww‡pÿÿD@xpwÿÿ@wwww"'pw€w‡wwˆð@wˆˆˆª¨wpxxˆwÿˆÿÿÿÿøw‡ˆ€wwpDDDDøwøxÿÿ€L0ÌÄøw€ÿÿ€C»» Äøwðwwp;° °Äøwp ; °°Äøwø Ì;»»°Äøwø ì; °°Äøwø ìû» Äøwø ÌÌ30ÌÄøwøøwøwwwwwwwøwøˆˆˆˆˆˆˆˆwÿÿÿÿÿÿÿÿwˆˆˆˆˆˆˆˆ÷wwwwwwwwwÀàÀ?ðÀøÀÿÿÀÀÀÀÀÀÀÀÀ€€Ââòþþþþþþÿÿ€ÿÀhugs98-plus-Sep2006/src/winhugs/installer/ShellCode.cpp0000644006511100651110000001556210432102215021600 0ustar rossross#include "Header.h" #include "Parameters.h" #include #include "FileCode.h" #include "InstallLog.h" bool OleReady; void ShellInit() { HRESULT hres = OleInitialize(NULL); OleReady = ((hres == S_FALSE) || (hres == S_OK)); } void ShellDest() { if (OleReady) OleUninitialize(); } bool CreateShortcut(char* Destination, char* Target, char* StartIn, char* Parameters, char* Desc) { if (!OleReady) return false; HRESULT hres; IShellLink* psl; // Get a pointer to the IShellLink interface. hres = CoCreateInstance(CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, IID_IShellLink, (LPVOID*)&psl); if (SUCCEEDED(hres)) { IPersistFile* ppf; // Set the path to the shortcut target and add the description. psl->SetPath(Target); if (Parameters != NULL) psl->SetArguments(Parameters); if (Desc != NULL) psl->SetDescription(Desc); if (StartIn != NULL) psl->SetWorkingDirectory(StartIn); // Query IShellLink for the IPersistFile interface for saving the // shortcut in persistent storage. hres = psl->QueryInterface(IID_IPersistFile, (LPVOID*)&ppf); if (SUCCEEDED(hres)) { WCHAR wsz[MAX_PATH]; // Ensure that the string is Unicode. MultiByteToWideChar(CP_ACP, 0, Destination, -1, wsz, MAX_PATH); // Save the link by calling IPersistFile::Save. hres = ppf->Save(wsz, TRUE); ppf->Release(); } psl->Release(); } bool Res = (SUCCEEDED(hres) ? true : false); if (Res) WriteInstallLog("FILE\t%s", Destination); return Res; } bool GetFolder(HWND hDlg, int nFolder, char* Buffer) { LPITEMIDLIST idl; SHGetSpecialFolderLocation(hDlg, nFolder, &idl); if (idl == 0) return false; BOOL res = SHGetPathFromIDList(idl, Buffer); CoTaskMemFree(idl); return (res != FALSE); } bool CreateDesktopShortcut(HWND hDlg, char* Folder) { char Destination[MyMaxPath]; if (!GetFolder(hDlg, CSIDL_DESKTOP, Destination)) return false; int i = strlen(Destination); if (Destination[i-1] == '\\') Destination[i-1] = 0; strcat(Destination, "\\" ProgramName ".lnk"); char Target[MyMaxPath]; strcpy(Target, Folder); strcat(Target, "\\" PrimaryFile); return CreateShortcut(Destination, Target, Folder, NULL, ProgramName " - " Description); } bool CreateStartMenuShortcut(HWND hDlg, char* Folder) { char Destination[MyMaxPath]; if (!GetFolder(hDlg, CSIDL_PROGRAMS, Destination)) return false; strcat(Destination, "\\" ProgramName); if (!EnsureFolder(Destination)) return false; strcat(Destination, "\\"); char* i = &Destination[strlen(Destination)]; char Target[MyMaxPath]; strcpy(Target, Folder); strcat(Target, "\\" PrimaryFile); strcpy(i, ProgramName ".lnk"); bool res = CreateShortcut(Destination, Target, Folder, NULL, ProgramName " - " Description); strcpy(i, "Readme.lnk"); strcpy(&Target[strlen(Folder)+1], "readme.txt"); res &= CreateShortcut(Destination, Target, NULL, NULL, ProgramName " - Read Me"); return res; } void WriteRegistryLog(HKEY Root, char* Path) { char* RootName; if (Root == HKEY_CLASSES_ROOT) RootName = "HKEY_CLASSES_ROOT"; else if (Root == HKEY_LOCAL_MACHINE) RootName = "HKEY_LOCAL_MACHINE"; else RootName = ""; WriteInstallLog("REG\t%s\t%s", RootName, Path); } void WriteRegistryNum(HKEY Root, char* Path, char* Local, DWORD Value) { HKEY hKey; RegCreateKey(Root, Path, &hKey); if (hKey != NULL) { RegSetValueEx(hKey, Local, 0, REG_DWORD, (BYTE*) &Value, sizeof(Value)); RegCloseKey(hKey); WriteRegistryLog(Root, Path); } } void WriteRegistry(HKEY Root, char* Path, char* Local, char* Value) { HKEY hKey; RegCreateKey(Root, Path, &hKey); if (hKey != NULL) { RegSetValueEx(hKey, Local, 0, REG_SZ, (BYTE*) Value, strlen(Value)+1); RegCloseKey(hKey); WriteRegistryLog(Root, Path); } } bool RegisterFiletypes(HWND hDlg, char* Folder) { #define HASKELL_HANDLER "hugs_haskell" char Buffer[MyMaxPath]; Buffer[0] = '\"'; strcpy(&Buffer[1], Folder); char* FileName = &Buffer[strlen(Folder)+1]; FileName[0] = '\\'; FileName++; //Register the two extensions WriteRegistry(HKEY_CLASSES_ROOT, ".hs" , "", HASKELL_HANDLER); WriteRegistry(HKEY_CLASSES_ROOT, ".lhs", "", HASKELL_HANDLER); //Allow the user to create a template WriteRegistry(HKEY_CLASSES_ROOT, ".hs\\ShellNew", "FileName", ""); WriteRegistry(HKEY_CLASSES_ROOT, HASKELL_HANDLER, "", "Haskell Script"); strcpy(FileName, PrimaryFile "\",1"); WriteRegistry(HKEY_CLASSES_ROOT, HASKELL_HANDLER "\\DefaultIcon", "", Buffer); WriteRegistry(HKEY_CLASSES_ROOT, HASKELL_HANDLER "\\shell", "", ""); strcpy(FileName, PrimaryFile "\" \"%1\""); WriteRegistry(HKEY_CLASSES_ROOT, HASKELL_HANDLER "\\shell\\Open", "", ""); WriteRegistry(HKEY_CLASSES_ROOT, HASKELL_HANDLER "\\shell\\Open\\command", "", Buffer); strcpy(FileName, PrimaryFile "\" /edit \"%1\""); WriteRegistry(HKEY_CLASSES_ROOT, HASKELL_HANDLER "\\shell\\Edit", "", ""); WriteRegistry(HKEY_CLASSES_ROOT, HASKELL_HANDLER "\\shell\\Edit\\command", "", Buffer); return true; } void RegisterUninstall(HWND hDlg, char* Folder, DWORD Size) { #define UNINSTALL_ENTRY "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\" ProgramName char Buffer[MyMaxPath]; Buffer[0] = '\"'; strcpy(&Buffer[1], Folder); char* FileName = &Buffer[strlen(Folder)+1]; FileName[0] = '\\'; FileName++; WriteRegistry(HKEY_LOCAL_MACHINE, UNINSTALL_ENTRY, "DisplayName", ProgramName); strcpy(FileName, PrimaryFile "\",0"); WriteRegistry(HKEY_LOCAL_MACHINE, UNINSTALL_ENTRY, "DisplayIcon", Buffer); strcpy(FileName, "uninstaller.exe\""); WriteRegistry(HKEY_LOCAL_MACHINE, UNINSTALL_ENTRY, "UninstallString", Buffer); WriteRegistry(HKEY_LOCAL_MACHINE, UNINSTALL_ENTRY, "Publisher", Publisher); WriteRegistry(HKEY_LOCAL_MACHINE, UNINSTALL_ENTRY, "HelpLink", Website); WriteRegistryNum(HKEY_LOCAL_MACHINE, UNINSTALL_ENTRY, "EstimatedSize", Size); } void GetProgramFiles(HWND hDlg, char* Buffer) { char* s = getenv("PROGRAMFILES"); strcpy(Buffer, (s != NULL ? s : "C:\\Program Files")); } int CALLBACK BrowseCallbackProc(HWND hWnd, UINT uMsg, LPARAM lParam, LPARAM lpData) { switch(uMsg) { case BFFM_INITIALIZED: char Buffer[MyMaxPath]; GetWindowText((HWND) lpData, Buffer, MyMaxPath); SendMessage(hWnd, BFFM_SETSELECTION, TRUE, (LPARAM) Buffer); break; } return 0; } void Browse(HWND hDlg, HWND hText) { const int bif_NEWDIALOGSTYLE = 0x40; BROWSEINFO bi; bi.hwndOwner = hDlg; bi.pidlRoot = NULL; bi.pszDisplayName = NULL; bi.lpszTitle = "Select the installation folder for " ProgramName; bi.ulFlags = BIF_RETURNONLYFSDIRS | bif_NEWDIALOGSTYLE; bi.lpfn = &BrowseCallbackProc; bi.lParam = (LPARAM) hText; bi.iImage = 0; LPITEMIDLIST idl = SHBrowseForFolder(&bi); if (idl != NULL) { char Buffer[MyMaxPath]; SHGetPathFromIDList(idl, Buffer); SetWindowText(hText, Buffer); CoTaskMemFree(idl); } } hugs98-plus-Sep2006/src/winhugs/installer/ShellCode.h0000644006511100651110000000052410331672314021247 0ustar rossross void ShellInit(); void ShellDest(); bool CreateDesktopShortcut(HWND hDlg, char* Folder); bool CreateStartMenuShortcut(HWND hDlg, char* Folder); void Browse(HWND hDlg, HWND hText); void GetProgramFiles(HWND hDlg, char* Buffer); bool RegisterFiletypes(HWND hDlg, char* Folder); void RegisterUninstall(HWND hDlg, char* Folder, DWORD Size); hugs98-plus-Sep2006/src/winhugs/installer/StartCode.cpp0000644006511100651110000002342010331672314021630 0ustar rossross#include "header.h" #include "FileCode.h" #include "ShellCode.h" #include "InstallLog.h" #include #include #define PLAY_NICELY #include "BlueZip\BlueHead.h" #include "resource.h" #include "Parameters.h" #define ErrBox(Msg) MessageBox(hDlg, Msg, ProgramName " Installer", MB_ICONERROR) #define QuestBox(Msg, Flag) MessageBox(hDlg, Msg, ProgramName " Installer", MB_ICONQUESTION | Flag) #define InfoBox(Msg) MessageBox(hDlg, Msg, ProgramName " Installer", MB_ICONINFORMATION) // GLOBAL STATE HINSTANCE hInst; bool InDoEvents = false; bool CancelInstall = false; BlueZip zip; int TotalCompSize; int TotalRealSize; // END GLOBAL STATE //Predefines void PathChanged(HWND hDlg); //end void InitDialog(HWND hDlg) { InitCommonControls(); char Buffer[MyMaxPath]; GetProgramFiles(hDlg, Buffer); strcat(Buffer, "\\"); strcat(Buffer, InstallDir); SetDlgItemText(hDlg, txtEdit, Buffer); CheckDlgButton(hDlg, chkExecute, BST_CHECKED); CheckDlgButton(hDlg, chkShortcutDesktop, BST_CHECKED); CheckDlgButton(hDlg, chkShortcutStart, BST_CHECKED); char ZipFile[MyMaxPath]; GetModuleFileName(hInst, ZipFile, MyMaxPath); #ifdef _DEBUG //make practical debugging a reality strcat(ZipFile, ".zip"); #endif zip.SetZipFile(ZipFile); if (!zip.Read()) { ErrBox("Corrupt installer data, please try redownloading"); DestroyWindow(hDlg); return; } TotalCompSize = 0; TotalRealSize = 0; for (zList* i = zip.Files; i != NULL; i = i->next) { TotalCompSize += i->CompressedSize(); TotalRealSize += i->OriginalSize(); } PathChanged(hDlg); } void PathChanged(HWND hDlg) { static char LastPath = -1; char Buffer[MyMaxPath]; GetDlgItemText(hDlg, txtEdit, Buffer, MyMaxPath); char NewLastPath; if (Buffer[1] == ':') NewLastPath = toupper(Buffer[0]); else NewLastPath = 0; if ((NewLastPath > 'Z') || (NewLastPath < 'A')) NewLastPath = 0; if (LastPath == NewLastPath) return; LastPath = NewLastPath; char Buf[MaxFileSizeBuf]; FileSize(TotalRealSize, Buf); int Len = sprintf(Buffer, "Space required is %s", Buf); if (LastPath != 0) { ULARGE_INTEGER DriveSpace, Tmp1, Tmp2; char Buf[25] = {LastPath, ':', '\\', 0}; if (!GetDiskFreeSpaceEx(Buf, &DriveSpace, &Tmp1, &Tmp2)) DriveSpace.QuadPart = 0; FileSize(DriveSpace.QuadPart, Buf); sprintf(&Buffer[Len], ", installing on drive %c: which has %s free", LastPath, Buf); } SetDlgItemText(hDlg, lblSpace, Buffer); } void PaintDialog(HWND hDlg) { const char* Msg = ProgramName " - " Description "\n© " Copyright; static int MsgLen = strlen(Msg); PAINTSTRUCT ps; HDC hDC = BeginPaint(hDlg, &ps); SelectObject(hDC, GetStockObject(DEFAULT_GUI_FONT)); RECT rc = {0, 0, 463, 54}; Rectangle(hDC, rc.left, rc.top, rc.right, rc.bottom); FillRect(hDC, &rc, (HBRUSH) GetStockObject(WHITE_BRUSH)); rc.top = 13; DrawText(hDC, Msg, MsgLen, &rc, DT_WORDBREAK | DT_CENTER); EndPaint(hDlg, &ps); } void ErrDialog(HWND hDlg, char* Msg, char* Variable) { char ErrBuffer[MyMaxPath * 2]; strcpy(ErrBuffer, Msg); strcat(ErrBuffer, Variable); ErrBox(ErrBuffer); } void DoEvents() { InDoEvents = true; MSG msg; while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE)) { TranslateMessage(&msg); DispatchMessage(&msg); } InDoEvents = false; } bool DoInstall(char* InstallTo, bool RunOnEnd, HWND hDlg) { //Now replace / with \ to make it less confusing //And guarantee it has no trailing slash NormalPath(InstallTo); //Now see if you can create the directory if (ExistsDir(InstallTo)) { if (QuestBox("The directory already exists, continuing may overwrite some files.\n" "\n" "Do you wish to continue?", MB_YESNO) == IDNO) return false; } else { if (!EnsureFolder(InstallTo)) { ErrBox("Could not create the specified directory"); return false; } } strcat(InstallTo, "\\"); int BufLen = strlen(InstallTo); char* BufPos = &InstallTo[BufLen]; //Buffer is C:\\Program Files\\ProgramDir\\ //BufPos is //Now test the primary file int TimeOut = 2; //seconds before giving up and asking the user if (PrimaryFile != NULL) { strcpy(BufPos, PrimaryFile); while (Exists(InstallTo) && !DeleteFile(InstallTo)) { if (TimeOut > 0) { TimeOut--; Sleep(1000); DoEvents(); } else { if (QuestBox("The program \"" PrimaryFile "\" is currently running, please exit it before continuing.", MB_RETRYCANCEL) == IDCANCEL) return false; } } } const int PrgFactor = 4096; SendDlgItemMessage(hDlg, prgBar, PBM_SETRANGE, 0, MAKELPARAM(0, TotalCompSize / PrgFactor)); int Done = 0; // start creating the install log strcpy(BufPos, "install.log"); StartInstallLog(InstallTo); WriteInstallLog("NOTE\tUinstall Log for " ProgramName); WriteInstallLog("FILE\t.\\install.log"); //now you have access to at least the file Str //extract all the files zList* i; for (i = zip.Files; i != NULL; i = i->next) { DoEvents(); if (CancelInstall) break; Done += i->CompressedSize(); strcpy(BufPos, i->FileName); char LastChar = BufPos[strlen(BufPos)-1]; bool IsFolder = ((LastChar == '\\') || (LastChar == '/')); NormalPath(BufPos); SetDlgItemText(hDlg, lblInstallFile, BufPos); DoEvents(); //if the last char is a '\' then directory if (IsFolder) { if (!EnsureFolder(InstallTo)) { ErrDialog(hDlg, "Could not create the directory\n\n", InstallTo); return false; } } else { char* s = strrchr(InstallTo, '\\'); if (s != NULL) { s[0] = 0; if (!EnsureFolder(InstallTo)) { ErrDialog(hDlg, "Could not create the directory\n\n", InstallTo); return false; } s[0] = '\\'; } if ( (Exists(InstallTo) && !DeleteFile(InstallTo)) || (!zip.GetFile(i, InstallTo))) { ErrDialog(hDlg, "Could not extract the file\n\n", InstallTo); return false; } else { WriteInstallLog("FILE\t.\\%s\t%i\t%lX", BufPos, i->OriginalSize(), i->CRC()); } } SendDlgItemMessage(hDlg, prgBar, PBM_SETPOS, Done / PrgFactor, 0); } if (CancelInstall) { DoEvents(); // first delete all the created files for (zList* j = zip.Files; j != i; j = j->next) { Done -= j->CompressedSize(); strcpy(BufPos, j->FileName); char LastChar = BufPos[strlen(BufPos)-1]; bool IsFolder = ((LastChar == '\\') || (LastChar == '/')); NormalPath(BufPos); if (!IsFolder) DeleteFile(InstallTo); SendDlgItemMessage(hDlg, prgBar, PBM_SETPOS, Done / PrgFactor, 0); } // and delete the install log StopInstallLog(true); //now delete all the directories DeleteFolders(); InfoBox("Installation rolled back, " ProgramName " has not been installed yet"); return false; } EnableWindow(GetDlgItem(hDlg, IDCANCEL), FALSE); SetDlgItemText(hDlg, lblInstallFile, "Finalising..."); //now InstallTo is the install directory, plus a \\ character BufPos[-1] = 0; if (IsDlgButtonChecked(hDlg, chkShortcutDesktop) == BST_CHECKED) { if (!CreateDesktopShortcut(hDlg, InstallTo)) ErrBox("Could not create the Desktop shortcut"); } if (TRUE) { if (!CreateStartMenuShortcut(hDlg, InstallTo)) ErrBox("Could not create the Start Menu shortcut"); } if (IsDlgButtonChecked(hDlg, chkRegisterFiles) == BST_CHECKED) { if (!RegisterFiletypes(hDlg, InstallTo)) ErrBox("Could not register file types"); } RegisterUninstall(hDlg, InstallTo, TotalRealSize); BufPos[-1] = '\\'; StopInstallLog(false); //now InstallTo is the directory if (hDlg != NULL) InfoBox(ProgramName " successfully installed"); if (RunOnEnd) { strcpy(BufPos, PrimaryFile); if ((int) ShellExecute(hDlg, NULL, InstallTo, NULL, NULL, SW_SHOWDEFAULT) <= 32) ErrBox("Could not run file " PrimaryFile); } return true; } void ShowProgress(HWND hDlg, bool State) { int Show[] = {txtEdit, cmdBrowse, lblWelcome, 0}; int Hide[] = {prgBar, lblInstallTo, lblInstallFile, 0}; int Enable[] = {chkExecute, chkShortcutDesktop, chkShortcutStart, IDOK, 0}; int i; for (i = 0; Show[i] != 0; i++) ShowWindow(GetDlgItem(hDlg, Show[i]), (State ? SW_HIDE : SW_SHOW)); for (i = 0; Hide[i] != 0; i++) ShowWindow(GetDlgItem(hDlg, Hide[i]), (State ? SW_SHOW : SW_HIDE)); for (i = 0; Enable[i] != 0; i++) EnableWindow(GetDlgItem(hDlg, Enable[i]), !State); DoEvents(); } bool TryInstall(HWND hDlg) { char Buffer[MyMaxPath]; GetDlgItemText(hDlg, txtEdit, Buffer, MyMaxPath); SetDlgItemText(hDlg, lblInstallFile, "Initialising..."); SendDlgItemMessage(hDlg, prgBar, PBM_SETPOS, 0, 0); char Buff2[MyMaxPath]; strcpy(Buff2, "Installing to "); strcat(Buff2, Buffer); SetDlgItemText(hDlg, lblInstallTo, Buff2); ShowProgress(hDlg, true); bool Res = DoInstall(Buffer, IsDlgButtonChecked(hDlg, chkExecute) == BST_CHECKED, hDlg); if (!Res) { //Rollback some variables that may have got modified CancelInstall = false; EnableWindow(GetDlgItem(hDlg, IDCANCEL), TRUE); StopInstallLog(true); } return Res; } int CALLBACK DlgFunc(HWND hDlg, UINT uMsg, WPARAM wParam, LPARAM lParam) { switch(uMsg) { case WM_INITDIALOG: ShellInit(); InitDialog(hDlg); break; case WM_DESTROY: ShellDest(); break; case WM_PAINT: PaintDialog(hDlg); break; case WM_COMMAND: switch (LOWORD(wParam)) { case IDCANCEL: if (!InDoEvents) EndDialog(hDlg, 0); else { CancelInstall = true; SetDlgItemText(hDlg, lblInstallFile, "Cancelling..."); EnableWindow(GetDlgItem(hDlg, IDCANCEL), FALSE); } break; case IDOK: if (TryInstall(hDlg)) EndDialog(hDlg, 0); else ShowProgress(hDlg, false); break; case cmdBrowse: Browse(hDlg, GetDlgItem(hDlg, txtEdit)); break; case txtEdit: if ((HIWORD(wParam) == EN_CHANGE) && (TotalRealSize != 0)) PathChanged(hDlg); break; } break; } return FALSE; } int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow) { hInst = hInstance; DialogBox(hInstance, MAKEINTRESOURCE(dlgInstall), NULL, DlgFunc); return 0; } hugs98-plus-Sep2006/src/winhugs/installer/WinHugs-Installer.manifest0000644006511100651110000000073310321204023024270 0ustar rossross hugs98-plus-Sep2006/src/winhugs/installer/installer.bmp0000644006511100651110000000606610321204023021723 0ustar rossrossBM6 6(  ÿÿÿÿÿÿÿÿÿÿÿÿæƒlãlMßdIßdIÛ\EÛ\EÛ\EÛ\E×UAÔK=×UAÒF:ÒF:ÔK=ÒF:ÒF:ÐC9ÐC9ÐC9Í:5Í:5Í:5Í:5Õa_ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿë´¦ãlMãlMßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÒF:×UAÒF:ÒF:ÔK=ÒF:ÒF:ÐC9ÐC9Í:5Í:5Í:5Í:5Í:5Í:5ߘ˜ÿÿÿÿÿÿÿÿÿë´¦ãlMãlMãlMßdIàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UAÔK=×UAÒF:ÒF:ÒF:ÒF:ÒF:ÐC9ÐC9ÐC9Í:5Í:5Í:5Í74Í74ߘ˜ÿÿÿÿÿÿí|VäsUäsUäsUàfKàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÒF:×UAÒF:ÒF:ÒF:ÒF:ÐC9ÐC9ÐC9ÐC9Í:5Í:5Í74Í74Í:5ÿÿÿì †äsUévRäsUäsUäsUàfKäsUßdIßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UAÔK=×UAÒF:ÒF:ÒF:ÒF:ÐC9ÐC9ÐC9Í:5Í:5Í:5Í74Í74Õa_í|Ví|VévRévRäsUäsUäsUàfKàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÔK=×UAÒF:ÒF:ÒF:ÐC9ÐC9ÐC9ÐC9Í:5Í:5Í:5Í74Í:5í|Ví|VäoQévRévRäsUäsUäsUàfKäsUßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÔK=ÒF:ÒF:ÒF:ÒF:ÐC9ÐC9ÐC9ÐC9Í:5Í:5Í:5Í74í|Ví|Ví|Ví|VévRévRäsUäsUäsUàfKàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÔK=ÔK=ÒF:×UAÒF:ÒF:Í:5Í:5Í:5Í:5Í:5Í:5ò†[í|Ví|Ví|VäoQévRévRäsUäsUäsUàfKäsUßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÔK=ÒF:ÒF:ÒF:ÒF:ÒF:ÒF:Í:5Í:5Í:5Í:5ò†[í[í|Ví|Ví|Ví|VäsUévRäsUäsUäsUàfKàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÔK=ÔK=ÒF:ÔK=ÒF:ÒF:ÒF:Í:5Í:5Í:5ò†[ò†[ò†[í|Ví|Ví|Ví|VévRévRäsUäsUäsUàfKäsUßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÔK=ÒF:ÒF:ÒF:ÒF:ÒF:ÒF:Í:5ÒF:ò†[ò†[ò†[í[í|Ví|Ví|Ví|VäoQévRäsUäsUäsUàfKãlMßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÒF:×UAÒF:ÒF:ÒF:ÒF:Í:5Í:5õ‹]ò†[ò†[ò†[ò†[í|Ví|Ví|Ví|Ví|VäsUäsUäsUäsUàfKãlMßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÒF:ÔK=ÒF:ÒF:ÒF:ÒF:ÒF:õ‹]ò†[õ‹]ò†[í|Vò†[í|Ví|Ví[ò¦ó²žî’täoQäsUäsUàfKãlMßdIäoQêœë¢”áwdÛ\E×UA×UA×UAÔK=ÔK=ÒF:ÔK=ÒF:ÒF:õ‹]õ‹]ò†[ò†[õ‹]í|Ví|VóŽfüëåþüüþüüþüüõõäsUäsUäsUãlMæƒlþôñþüüþüüþôñ뢔Û\EÛ\E×UA×UAÔK=ÒF:ÒF:ÒF:ÒF:õ‹]õ‹]õ‹]õ‹]ò†[ò†[ò†[ûÔÅþüüþüüþüüþüüþüü윂äsUäsUäsUüåÜþüüþüüþüüþüüþüüàp\Û\EÛ\E×UA×UAÔK=ÔK=ÒF:ÔK=ùaõ‹]õ‹]õ‹]ò†[õ‹]ò†[þôñþüüþüüþüüþüüþüüõõäsUäsUí[þüüþüüþüüþüüþüüþüüêœÛ\EÛ\EÛ\E×UA×UAÔK=ÔK=ÔK=ùaùaõ‹]õ‹]õ‹]õ‹]ò†[üëåþüüþüüþüüþüüþüüô¹¥äsUí|VäoQþôñþüüþüüþüüþüüþüüꔀÛ\EÛ\EÛ\EÛ\E×UA×UAÔK=ÔK=ùaùaùaõ‹]õ‹]õ‹]õ‹]ó²žþüüþüüþüüþüüþôñíˆgí|VäsUäsUõõþüüþüüþüüþüüüëåãlMßdIÛ\EßdIÛ\EÛ\E×UA×UAÔK=ü•dõ‹]ü•dõ‹]õ‹]õ‹]õ‹]õ‹]ø½¤þôñþüüüåÜòšzí|Ví|Ví|VévRí|Vô¿°þôñþüü÷×Ïè{\àfKßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAü•dü•dü•dõ‹]õ‹]õ‹]õ‹]õ‹]õ‹]ò†[õ‹]í|Vò†[í|Ví|Ví|VäoQévRévRévRäsUäsUãlMàfKàfKàfKÛ\EßdIÛ\EÛ\E×UA×UAü•dùaü•dü•dü•dõ‹]õ‹]õ‹]õ‹]õ‹]ò†[ò†[ò†[ò†[òkòšzí|Ví|VäoQévRäsUäsUäsUãlMæ~cæƒlàfKßdIÛ\EÛ\EÛ\E×UAü•dü•dü•dü•dü•dùaõ‹]õ‹]õ‹]õ‹]õ‹]ò†[òk÷×Ïþüüþüüþôñò¦í|VäsUévRäsUí‡füåÜþüüþüüüëåæˆsßdIÛ\EÛ\EÛ\Eü•dü•dü•dü•dü•dü•dü•dõ‹]õ‹]õ‹]õ‹]õ‹]ûÔÅþüüþüüþüüþüüþôñíˆgí|VäsUévRüßÒþüüþüüþüüþüüþôñãlMßdIÛ\EÛ\Eü•dü•dü•dùaü•dü•dü•dùaõ‹]õ‹]õ‹]õ‹]þôñþüüþüüþüüþüüþüüó²ží|VévRí‡fþüüþüüþüüþüüþüüþüüꔀßdIßdIÛ\Eü•dü•dü•dü•dü•dü•dü•dü•dü•dõ‹]õ‹]õ‹]þüüþüüþüüþüüþüüþüüó²ží|Ví|Ví‡fþüüþüüþüüþüüþüüþüüꔀßdIàfKßdIü•dü•dü•dü•dü•dü•dü•dü•dü•dùaùaõ‹]ûÔÅþüüþüüþüüþüüþüüòkí|Ví|Ví|VüåÜþüüþüüþüüþüüþôñäoQãlMßdIàfKù³‘ü•dü•dü•dü•dü•dùaü•dü•dü•dùaùaü•düßÒþüüþüüþôñöªŒò†[ò†[í|Ví|VïŒjüåÜþüüþüüüîêî’tãlMãlMàfKåŠsÿÿÿýšiü•dü•dü•dü•dü•dùaùaü•dü•dùaùaùa÷›s÷£~õ‹]ò†[ò†[ò†[í[í[í|Ví|VïŒjî’tévRäsUäsUãlMäoQÿÿÿÿÿÿõ˵ü•dü•dü•dü•dü•dü•dü•dü•dùaü•dùaùaõ‹]õ‹]õ‹]ò†[õ‹]í[ò†[í[í[í|Ví|VévRévRévRãlMäoQì»­ÿÿÿÿÿÿÿÿÿõ˵ýšiü•dü•dü•dü•dùaùaùaùaùaùaùaõ‹]õ‹]õ‹]ò†[õ‹]ò†[ò†[í[í|Ví|Ví|VévRévRí|Vì»­ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿù³‘ü•dü•dü•dü•dü•dü•dùaü•dùaùaùaõ‹]õ‹]õ‹]õ‹]ò†[ò†[ò†[ò†[í|Ví|Vè{\ì †ÿÿÿÿÿÿÿÿÿÿÿÿhugs98-plus-Sep2006/src/winhugs/installer/resource.h0000644006511100651110000000212510321204023021216 0ustar rossross//{{NO_DEPENDENCIES}} // Microsoft Visual C++ generated include file. // Used by Installer.rc // #define dlgInstall 101 #define IDI_ICON1 103 #define bmpInstaller 107 #define txtEdit 1000 #define cmdBrowse 1001 #define chkExecute 1003 #define chkShortcut 1004 #define chkShortcutDesktop 1004 #define chkShortcutStart 1005 #define chkRegisterFiles 1005 #define barTop 1009 #define prgBar 1012 #define lblWelcome 1013 #define lblInstallTo 1014 #define lblInstallFile 1015 #define lblSpace 1016 // Next default values for new objects // #ifdef APSTUDIO_INVOKED #ifndef APSTUDIO_READONLY_SYMBOLS #define _APS_NEXT_RESOURCE_VALUE 108 #define _APS_NEXT_COMMAND_VALUE 40001 #define _APS_NEXT_CONTROL_VALUE 1017 #define _APS_NEXT_SYMED_VALUE 101 #endif #endif hugs98-plus-Sep2006/src/winhugs/DlgAbout.c0000644006511100651110000000514010432100522017070 0ustar rossross#include "Header.h" #include "resrc1.h" #include "Winmenu.h" #include "prelude.h" #include "storage.h" #include "connect.h" const int BmpWidth = 111; const int BmpHeight = 112; const int BmpTransparent = RGB(253,5,255); LPCTSTR AboutText = "Hugs 98: Based on the Haskell 98 standard\n" "Copyright © 1994-2006\n" "Bug reports to: mailto:hugs-bugs@haskell.org\n" "Website: http://www.haskell.org/hugs\n" "\n" "Please see the distribution for License and Credits info\n" "Version: "; typedef struct _AboutData { HIMAGELIST hImgList; } AboutData; INT_PTR CALLBACK AboutDlgProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam); void ShowAboutDialog(HWND hParent) { DialogBox(hThisInstance, MAKEINTRESOURCE(ABOUTDLGBOX), hParent, AboutDlgProc); } INT_PTR CALLBACK AboutDlgProc(HWND hDlg, UINT Msg, WPARAM wParam, LPARAM lParam) { switch (Msg) { case WM_INITDIALOG: { HWND hRTF = GetDlgItem(hDlg, rtfAbout); AboutData* ad = malloc(sizeof(AboutData)); HBITMAP hBmp; SetWindowLongPtr(hDlg, GWL_USERDATA, (LONG) ad); CenterDialogInParent(hDlg); ad->hImgList = ImageList_Create(BmpWidth, BmpHeight, ILC_COLOR24 | ILC_MASK, 1, 1); hBmp = LoadBitmap(hThisInstance, MAKEINTRESOURCE(BMP_ABOUT)); ImageList_AddMasked(ad->hImgList, hBmp, BmpTransparent); DeleteObject(hBmp); SendMessage(hRTF, EM_AUTOURLDETECT, TRUE, 0); SetWindowText(hRTF, AboutText); SendMessage(hRTF, EM_SETSEL, -1, -1); SendMessage(hRTF, EM_REPLACESEL, FALSE, (LPARAM) versionString); SendMessage(hRTF, EM_SETEVENTMASK, 0, ENM_LINK); } return (INT_PTR)TRUE; case WM_PAINT: { PAINTSTRUCT ps; AboutData* ad = (AboutData*) GetWindowLongPtr(hDlg, GWL_USERDATA); BeginPaint(hDlg, &ps); ImageList_Draw(ad->hImgList, 0, ps.hdc, 20, 25, ILD_TRANSPARENT); EndPaint(hDlg, &ps); } break; case WM_COMMAND: switch (LOWORD(wParam)) { case IDOK: case IDCANCEL: EndDialog(hDlg, TRUE); return (INT_PTR)TRUE; } break; case WM_NOTIFY: if (wParam == rtfAbout && ((LPNMHDR) lParam)->code == EN_LINK) { TEXTRANGE tr; char Buffer[1000]; ENLINK* enl = (ENLINK*) lParam; if (enl->msg == WM_LBUTTONUP) { tr.lpstrText = Buffer; tr.chrg.cpMin = enl->chrg.cpMin; tr.chrg.cpMax = enl->chrg.cpMax; SendMessage(enl->nmhdr.hwndFrom, EM_GETTEXTRANGE, 0, (LPARAM) &tr); ExecuteFile(Buffer); } } break; case WM_DESTROY: { AboutData* ad = (AboutData*) GetWindowLongPtr(hDlg, GWL_USERDATA); ImageList_Destroy(ad->hImgList); free(ad); } } return (INT_PTR)FALSE; } hugs98-plus-Sep2006/src/winhugs/DlgMain.c0000644006511100651110000002562710432075331016727 0ustar rossross/* -------------------------------------------------------------------------- * DlgMain.c: José Enrique Gallardo Ruiz, Feb 1999 * Neil Mitchell, 2005 * * This file contains the implementation for a frame window definition * ------------------------------------------------------------------------*/ #include "prelude.h" #include "resrc1.h" #include "Header.h" #include "Winmenu.h" HWND hThisWindow; HACCEL hAccelTable; //copied, most of these are redundant #include #include #include #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "Registry.h" #include "RtfWindow.h" // Is the Interpretter currently going wirrr... BOOL Running = FALSE; INT_PTR CALLBACK MainDlgProc(HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam); // ID's for the items that are not in the resource dialog const int ID_STATUS = 9500; const int ID_TOOLBAR = 9600; void EnableButtons(); int Buttons[] = { // -1 is a separator, 0 is the end ID_OPEN, -1, ID_CUT, ID_COPY, ID_PASTE, -1, ID_RUN, ID_STOP, ID_MAKE, ID_SETOPTIONS, -1, ID_HELPCONTENTS, 0 }; BOOL ShowMainDialog() { HWND hWnd = CreateDialog(hThisInstance, MAKEINTRESOURCE(DLG_MAIN), NULL, &MainDlgProc); if (hWnd == NULL) { MessageBox(NULL, "Failed to create main WinHugs dialog", "WinHugs", MB_ICONERROR); return FALSE; } return TRUE; } void MainInitToolbar(HWND hWnd) { int i; int AnyButtons = 0, RealButtons = 0; TBBUTTON* TbButtons; HWND hToolbar; HIMAGELIST hImgList; HBITMAP hBmp; for (AnyButtons = 0; Buttons[AnyButtons] != 0; AnyButtons++) ; // no code required TbButtons = malloc(sizeof(TBBUTTON) * AnyButtons); for (i = 0; i < AnyButtons; i++) { if (Buttons[i] == -1) { TbButtons[i].iBitmap = 0; TbButtons[i].fsStyle = BTNS_SEP; TbButtons[i].idCommand = 0; } else { TbButtons[i].iBitmap = RealButtons; RealButtons++; TbButtons[i].idCommand = Buttons[i]; TbButtons[i].fsStyle = TBSTYLE_BUTTON; } TbButtons[i].fsState = TBSTATE_ENABLED; TbButtons[i].dwData = (DWORD_PTR) NULL; TbButtons[i].iString = (INT_PTR) NULL; } hToolbar = CreateWindowEx( 0, TOOLBARCLASSNAME, NULL, TBSTYLE_TOOLTIPS | WS_CHILD | WS_VISIBLE | CCS_NODIVIDER | TBSTYLE_FLAT, // TBSTYLE_TOOLTIPS | WS_CHILD | WS_VISIBLE | TBSTYLE_WRAPABLE | /*CCS_NORESIZE |*/ CCS_NODIVIDER | TBSTYLE_FLAT, 0, 0, 600, 28, hWnd, (HMENU) ID_TOOLBAR, hThisInstance, NULL); // create the image list hImgList = ImageList_Create(18, 18, ILC_COLOR4 | ILC_MASK, RealButtons, RealButtons); hBmp = LoadBitmap(hThisInstance, MAKEINTRESOURCE(BMP_TOOLBAR)); ImageList_AddMasked(hImgList, hBmp, RGB(255,0,255)); DeleteObject(hBmp); SendMessage(hToolbar, TB_SETIMAGELIST, 0, (LPARAM) hImgList); // setup the toolbar properties SendMessage(hToolbar, TB_SETBUTTONSIZE, 0, MAKELONG(24,24)); SendMessage(hToolbar, TB_SETBITMAPSIZE, 0, MAKELONG(18,18)); SendMessage(hToolbar, TB_ADDBUTTONS, AnyButtons, (LPARAM) TbButtons); free(TbButtons); } void MainInitDialog(HWND hWnd) { // so external functions can reference it hThisWindow = hWnd; // Setup the icons SendMessage(hWnd, WM_SETICON, ICON_SMALL, (LPARAM) LoadImage(hThisInstance, "HUGS", IMAGE_ICON, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CXSMICON), 0)); SendMessage(hWnd, WM_SETICON, ICON_BIG, (LPARAM) LoadIcon(hThisInstance, "HUGS")); // Create the toolbar MainInitToolbar(hWnd); // Create the status bar CreateStatusWindow(WS_CHILD | WS_VISIBLE, "", hWnd, ID_STATUS); // Call the required init functions RtfWindowInit(GetDlgItem(hWnd, ID_RTF)); MruInit(); RegistryReadWindowPos(hWnd); } char CommandDelayBuffer[1000]; void FireCommandDelay(LPCSTR Command) { strcpy(CommandDelayBuffer, Command); PostMessage(hThisWindow, WM_APP, 0, 0); } void FireCommand(LPCSTR Command); void EnableButton(int id, BOOL Enable) { TBBUTTONINFO tbi; tbi.cbSize = sizeof(tbi); tbi.dwMask = TBIF_STATE; tbi.fsState = (Enable ? TBSTATE_ENABLED : 0); SendDlgItemMessage(hThisWindow, ID_TOOLBAR, TB_SETBUTTONINFO, id, (LPARAM) &tbi); EnableMenuItem(GetMenu(hThisWindow), id, MF_BYCOMMAND | (Enable ? MF_ENABLED : MF_GRAYED)); } void EnableButtons() { int CopyState = (Running ? 0 : RtfWindowCanCutCopy()); EnableButton(ID_STOP, Running); EnableButton(ID_RUN, !Running); EnableButton(ID_CUT, CopyState & DROPEFFECT_MOVE); EnableButton(ID_DELETE, CopyState & DROPEFFECT_MOVE); EnableButton(ID_COPY, CopyState & DROPEFFECT_COPY); EnableButton(ID_PASTE, !Running); EnableButton(ID_CLEARSCREEN, !Running); EnableButton(ID_SELECTALL, !Running); } void ExecutionFinished() { RtfWindowFlushBuffer(); RtfWindowStartInput(); Running = FALSE; EnableButtons(); } void FireCommand(LPCSTR Command) { RtfWindowSetCommand(Command); RtfWindowStartOutput(); AddHistory(Command); Running = TRUE; EnableButtons(); stringInput((LPSTR) Command); input(BREAK); IORemapBegin(); if (doCommand()) SendMessage(hThisWindow, WM_CLOSE, 0, 0); longjmp(catch_error, 1); } void MainSize(HWND hWnd, int x, int y) { RECT rc; HWND hStatus = GetDlgItem(hWnd, ID_STATUS); HWND hToolbar = GetDlgItem(hWnd, ID_TOOLBAR); HWND hRTF = GetDlgItem(hWnd, ID_RTF); int HeightStatus, HeightToolbar; GetClientRect(hStatus, &rc); MoveWindow(hStatus, 0, y - rc.bottom, x, rc.bottom, TRUE); HeightStatus = rc.bottom; GetClientRect(hToolbar, &rc); HeightToolbar = rc.bottom; // hack-o-rama if (HeightToolbar == 26) HeightToolbar = 28; MoveWindow(hRTF, 0, HeightToolbar, x, y - HeightToolbar - HeightStatus, FALSE); } //#define DlgSendMessage(h,c,w,l) SendMessage((h),(c),MAKEWPARAM(w,(HIWORD(l))),(LOWORD(l))) //#define AbortInterpreter input(BREAK); WinPuts(hWndText, "\n") //#define GotoInterpreter longjmp(catch_error, 1); void MainOpenFile(HWND hWnd) { CHAR FileName[MAX_PATH]; CHAR Command[2048]; if (ShowOpenFileDialog(hWnd, FileName)) { wsprintf(Command, ":load %s", ExpandFileName((String)FileName)); FireCommand(Command); } } void AbortExecution() { raise(SIGINT); IORemapEnd(); } void MainCommand(HWND hWnd, int ID) { switch (ID) { case IDCANCEL: EndDialog(hWnd, 0); break; case ID_OPEN: MainOpenFile(hWnd); break; case ID_SCRIPTMAN: ShowScriptMan(); break; case ID_EXIT: FireCommand(":quit\n"); break; /* Load one of the last 10 open files */ case ID_MRU+0: case ID_MRU+1: case ID_MRU+2: case ID_MRU+3: case ID_MRU+4: case ID_MRU+5: case ID_MRU+6: case ID_MRU+7: case ID_MRU+8: case ID_MRU+9: { char Command[1000]; wsprintf(Command, ":load %s", ExpandFileName(MruGetItem(ID-ID_MRU))); FireCommand(Command); } break; // EDIT MENU case ID_CUT: RtfWindowClipboard(WM_CUT); break; case ID_COPY: RtfWindowClipboard(WM_COPY); break; case ID_PASTE: RtfWindowClipboard(WM_PASTE); break; case ID_CLEARSCREEN: RtfWindowClear(); break; case ID_DELETE: RtfWindowDelete(); break; case ID_SELECTALL: RtfWindowSelectAll(); break; case ID_GOPREVIOUS: RtfWindowHistory(-1); break; case ID_GONEXT: RtfWindowHistory(+1); break; // ACTIONS MENU // Reload script files case ID_COMPILE: case ID_MAKE: FireCommand(":reload"); break; case ID_CLEARALL: FireCommand(":load"); break; case ID_GOEDIT: FireCommand(":edit"); break; /* Stop program execution */ case ID_STOP: MessageBeep(0xFFFFFFFF); AbortExecution(); break; /* Evaluate main expression */ case ID_RUN: { char Buffer[1000]; RtfWindowGetCommand(Buffer); if (Buffer[0] == '\0') FireCommand(":main"); else FireCommand(Buffer); } break; /* Set interpreter options using dialog box */ case ID_SETOPTIONS: if (ShowOptionsDialog(hWnd)) RtfWindowUpdateFont(); break; // BROWSE MENU case ID_BROWSEHIERARCHY: DrawClassesHierarchy(); break; case ID_BROWSECLASSES: DoBrowseClasses(); break; case ID_BROWSENAMES: DoBrowseNames(); break; case ID_BROWSETYCONS: DoBrowseTycons(); break; // HELP MENU case ID_HELPCONTENTS: ExecuteFileDocs("hugs98.chm"); break; case ID_HELPCOMMANDS: FireCommand(":?\n"); break; case ID_LIBRARIES: ExecuteFile("http://www.haskell.org/ghc/docs/latest/html/libraries/index.html"); break; case ID_WWWHASKELL: ExecuteFile("http://haskell.org/"); break; case ID_WWWHUGS: ExecuteFile("http://haskell.org/hugs/"); break; case ID_ABOUT: ShowAboutDialog(hWnd); break; } } int MainNotify(HWND hWnd, LPNMHDR nmhdr) { if (nmhdr->code == TBN_GETINFOTIP && nmhdr->idFrom == ID_TOOLBAR) { LPNMTBGETINFOTIP tt = (LPNMTBGETINFOTIP) nmhdr; LoadString(hThisInstance, tt->iItem, tt->pszText, tt->cchTextMax); } else if (nmhdr->idFrom == ID_RTF) return RtfNotify(hWnd, nmhdr); return FALSE; } void SetStatusBar(LPCTSTR Str) { SetDlgItemText(hThisWindow, ID_STATUS, Str); } void MainMenuSelect(HWND hWnd, int ID, int Flags) { CHAR Buffer[100]; if (Flags & MF_POPUP || Flags == 0xFFFF) ID = 0; if (ID == 0 || !LoadString(hThisInstance, ID, Buffer, sizeof(Buffer))) Buffer[0] = 0; SetStatusBar(Buffer); } void MainDropFiles(HWND hWnd, HDROP hDrop) { char Command[MAX_PATH], File[MAX_PATH]; DragQueryFile(hDrop, 0, File, MAX_PATH); DragFinish(hDrop); //Move the current directory //Happens automatically if they use the open dialog //If they directly invoke :load then not necessary SetWorkingDir(File); wsprintf(Command, ":load %s", ExpandFileName((String)File)); FireCommand(Command); } void ShowContextMenu(int x, int y) { HMENU hEdit = GetSubMenu(GetMenu(hThisWindow), 1); if (x == 0xffff && y == 0xffff) { RECT rc; GetWindowRect(GetDlgItem(hThisWindow, ID_RTF), &rc); x = rc.left+2; y = rc.top+2; } TrackPopupMenu(hEdit, 0, x, y, 0, hThisWindow, NULL); CreatePopupMenu(); } INT_PTR CALLBACK MainDlgProc(HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam) { switch (uMsg) { case WM_INITDIALOG: MainInitDialog(hWnd); break; case WM_DROPFILES: MainDropFiles(hWnd, (HDROP) wParam); break; case WM_APP: FireCommand(CommandDelayBuffer); break; case WM_COMMAND: MainCommand(hWnd, LOWORD(wParam)); break; case WM_NOTIFY: return MainNotify(hWnd, (LPNMHDR) lParam); break; case WM_SIZE: MainSize(hWnd, LOWORD(lParam), HIWORD(lParam)); break; case WM_MENUSELECT: MainMenuSelect(hWnd, LOWORD(wParam), HIWORD(wParam)); break; case WM_TIMER: RtfWindowTimer();; break; case WM_CONTEXTMENU: { HWND hParam = (HWND) wParam; HWND hRtfChild = GetDlgItem(hWnd, ID_RTF); if (hParam == hWnd || hParam == hRtfChild) ShowContextMenu(LOWORD(lParam), HIWORD(lParam)); } break; case WM_HELP: MainCommand(hWnd, ID_HELPCONTENTS); break; case WM_CLOSE: RegistryWriteWindowPos(hWnd); if (Running) AbortExecution(); PostQuitMessage(0); break; } return FALSE; } hugs98-plus-Sep2006/src/winhugs/DlgOptions.c0000644006511100651110000002222610320513332017460 0ustar rossross#include "Header.h" #include "prelude.h" #include "resrc1.h" #include "opts.h" #include "storage.h" #include "machdep.h" INT_PTR CALLBACK OptionsHugsProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam); INT_PTR CALLBACK OptionsRuntimeProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam); INT_PTR CALLBACK OptionsCompileProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam); BOOL ShowOptionsDialog(HWND hParent) { const int nPages = 3; PROPSHEETPAGE psp[3]; PROPSHEETHEADER psh; int i; for (i = 0; i < nPages; i++) { psp[i].dwSize = sizeof(psp[i]); psp[i].dwFlags = PSP_DEFAULT; psp[i].hInstance = hThisInstance; } psp[0].pszTemplate = MAKEINTRESOURCE(DLG_OPTCOMPILE); psp[0].pfnDlgProc = OptionsCompileProc; psp[1].pszTemplate = MAKEINTRESOURCE(DLG_OPTRUNTIME); psp[1].pfnDlgProc = OptionsRuntimeProc; psp[2].pszTemplate = MAKEINTRESOURCE(DLG_OPTHUGS); psp[2].pfnDlgProc = OptionsHugsProc; psh.dwSize = sizeof(psh); psh.dwFlags = PSH_NOAPPLYNOW | PSH_PROPSHEETPAGE; psh.hwndParent = hParent; psh.hInstance = hThisInstance; psh.pszCaption = "Hugs Options"; psh.nPages = nPages; psh.nStartPage = 0; psh.ppsp = &psp[0]; PropertySheet(&psh); // Might have changed, no way to know... return TRUE; } BOOL GetDlgItemBool(HWND hDlg, INT CtrlID) { return (IsDlgButtonChecked(hDlg, CtrlID) == BST_CHECKED); } void SetDlgItemBool(HWND hDlg, INT CtrlID, BOOL Value) { CheckDlgButton(hDlg, CtrlID, Value ? BST_CHECKED : BST_UNCHECKED); } ///////////////////////////////////////////////////////////////////// // OPTHUGS related code int CALLBACK ListAllFonts(CONST LOGFONT* lpelfe, CONST TEXTMETRIC* lpntme, DWORD FontType, LPARAM lParam) { HWND hLst = (HWND) lParam; LPCTSTR FontName = (LPCTSTR) lpelfe->lfFaceName; if (SendMessage(hLst, CB_FINDSTRINGEXACT, -1, (LPARAM) FontName) == CB_ERR) SendMessage(hLst, CB_ADDSTRING, 0, (LPARAM) FontName); return 1; } int TwipToPoint(x){return x / 20;} int PointToTwip(x){return x * 20;} void CalculateFont(HWND hDlg, CHARFORMAT* cf) { BOOL ValidSize; int NewSize; int CurSel; HWND hFace = GetDlgItem(hDlg, lstFontFace); RegistryReadFont(cf); CurSel = (int) SendMessage(hFace, CB_GETCURSEL, 0, 0); if (CurSel == CB_ERR) GetWindowText(hFace, cf->szFaceName, 32); else SendMessage(hFace, CB_GETLBTEXT, CurSel, (LPARAM) cf->szFaceName); cf->dwEffects = 0; cf->dwEffects |= (GetDlgItemBool(hDlg, chkFontBold) ? CFE_BOLD : 0); cf->dwEffects |= (GetDlgItemBool(hDlg, chkFontItalic) ? CFE_ITALIC : 0); // check the size NewSize = GetDlgItemInt(hDlg, txtFontSize, &ValidSize, FALSE); if (ValidSize) cf->yHeight = PointToTwip(NewSize); } void UpdateFontPreview(HWND hDlg) { CHARFORMAT cf; HWND hRTF = GetDlgItem(hDlg, rtfPreview); CalculateFont(hDlg, &cf); SendMessage(hRTF, EM_SETCHARFORMAT, SCF_ALL, (LPARAM) &cf); } void InitOptionsFont(HWND hDlg) { // load up the list of fonts HDC hDC = GetDC(hDlg); CHARFORMAT cf; LOGFONT lf; SendDlgItemMessage(hDlg, spnFontSize, UDM_SETRANGE, 0, MAKELONG(72, 6)); lf.lfCharSet = DEFAULT_CHARSET; lf.lfFaceName[0] = 0; lf.lfPitchAndFamily = 0; EnumFontFamiliesEx(hDC, &lf, ListAllFonts, (LPARAM) GetDlgItem(hDlg, lstFontFace), 0); ReleaseDC(hDlg, hDC); SetDlgItemText(hDlg, rtfPreview, "Text Preview ABC abc 123"); // setup the config options RegistryReadFont(&cf); SetDlgItemText(hDlg, lstFontFace, cf.szFaceName); SetDlgItemBool(hDlg, chkFontBold, cf.dwEffects & CFE_BOLD); SetDlgItemBool(hDlg, chkFontItalic, cf.dwEffects & CFE_ITALIC); SetDlgItemInt(hDlg, txtFontSize, TwipToPoint(cf.yHeight), FALSE); UpdateFontPreview(hDlg); } void InitOptionsEditor(HWND hDlg) { HWND hLst = GetDlgItem(hDlg, lstEditor); char* s; char Buffer[MAX_PATH]; int i; // Deal with the async flag s = hugsEdit; while (*s == '&') s++; // now set the text to the remaining commmand // and figure out if it corresponds to any defaults SetDlgItemText(hDlg, txtEditor, s); for (i = 0; ; i++) { LPCTSTR EditorName = GetEditor(i, Buffer); if (EditorName == NULL) break; if (Buffer[0]) { int NewIndex = (int) SendMessage(hLst, CB_ADDSTRING, 0, (LPARAM) EditorName); SendMessage(hLst, CB_SETITEMDATA, NewIndex, i); if (stricmp(Buffer, s) == 0) SendMessage(hLst, CB_SETCURSEL, NewIndex, 0); } } i = (int) SendMessage(hLst, CB_ADDSTRING, 0, (LPARAM) "Custom..."); SendMessage(hLst, CB_SETITEMDATA, i, -1); if (SendMessage(hLst, CB_GETCURSEL, 0, 0) == -1) { SendMessage(hLst, CB_SETCURSEL, i, 0); EnableWindow(GetDlgItem(hDlg, txtEditor), TRUE); } } void WriteOptions() { writeRegString("Options", optionsToStr()); } INT_PTR CALLBACK OptionsHugsProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam) { switch (msg) { case WM_INITDIALOG: InitOptionsFont(hDlg); InitOptionsEditor(hDlg); break; case WM_COMMAND: { int Code = HIWORD(wParam); int Ctrl = LOWORD(wParam); if ((Ctrl == chkFontBold && Code == BN_CLICKED) || (Ctrl == chkFontItalic && Code == BN_CLICKED) || (Ctrl == txtFontSize && Code == EN_CHANGE) || (Ctrl == lstFontFace && (Code == CBN_EDITCHANGE || Code == CBN_SELCHANGE)) ) UpdateFontPreview(hDlg); if (Ctrl == lstEditor && Code == CBN_SELCHANGE) { HWND hLst = GetDlgItem(hDlg, lstEditor); HWND hTxt = GetDlgItem(hDlg, txtEditor); int CurSel = (int) SendMessage(hLst, CB_GETCURSEL, 0, 0); int CurData = (int) SendMessage(hLst, CB_GETITEMDATA, CurSel, 0); EnableWindow(hTxt, CurData == -1); if (CurData != -1) { CHAR Buffer[MAX_PATH]; GetEditor(CurData, Buffer); SetWindowText(hTxt, Buffer); } } } break; case WM_NOTIFY: if (((NMHDR*) lParam)->code == PSN_APPLY) { CHARFORMAT cf; char Buffer[MAX_PATH]; CalculateFont(hDlg, &cf); RegistryWriteFont(&cf); // do the path stuff Buffer[0] = '&'; GetDlgItemText(hDlg, txtEditor, &Buffer[1], MAX_PATH); free(hugsEdit); hugsEdit = strdup(Buffer); WriteOptions(); } break; } return (INT_PTR)FALSE; } ///////////////////////////////////////////////////////////////////// // OPTRUNTIME related code #define MIN_HEAP_SIZE 1 #define MAX_HEAP_SIZE 1000 int Heap2Mb(int heap){return max(1, heap * 8 / (1024 * 1024));} int Mb2Heap(int mb){return (mb * 1024 * 1024) / 8;} INT_PTR CALLBACK OptionsRuntimeProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam) { switch (msg) { case WM_INITDIALOG: // heapSize is 8 byte cells SetDlgItemInt(hDlg, txtHeapSize, Heap2Mb(hpSize), FALSE); SendDlgItemMessage(hDlg, spnHeapSize, UDM_SETRANGE, 0, MAKELONG(MAX_HEAP_SIZE,MIN_HEAP_SIZE)); SetDlgItemBool(hDlg, chkUserShow, useShow); SetDlgItemBool(hDlg, chkPrintStats, showStats); SetDlgItemBool(hDlg, chkPrintType, addType); SetDlgItemBool(hDlg, chkPrintGC, gcMessages); break; case WM_NOTIFY: if (((NMHDR*) lParam)->code == PSN_APPLY) { // apply here int size = GetDlgItemInt(hDlg, txtHeapSize, NULL, FALSE); if (MIN_HEAP_SIZE <= size && size <= MAX_HEAP_SIZE) hpSize = Mb2Heap(size); useShow = GetDlgItemBool(hDlg, chkUserShow); showStats = GetDlgItemBool(hDlg, chkPrintStats); addType = GetDlgItemBool(hDlg, chkPrintType); gcMessages = GetDlgItemBool(hDlg, chkPrintGC); WriteOptions(); } break; } return (INT_PTR)FALSE; } ///////////////////////////////////////////////////////////////////// // OPTCOMPILE related code void EnableHaskellExts(HWND hDlg) { BOOL Ext = GetDlgItemBool(hDlg, optExtensions); EnableWindow(GetDlgItem(hDlg, chkOverlap), Ext); EnableWindow(GetDlgItem(hDlg, chkHereDocs), Ext); EnableWindow(GetDlgItem(hDlg, chkOverlapUnsafe), Ext && GetDlgItemBool(hDlg, chkOverlap)); } INT_PTR CALLBACK OptionsCompileProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam) { switch (msg) { case WM_INITDIALOG: SetDlgItemText(hDlg, txtPath, hugsPath); SetDlgItemBool(hDlg, chkListLoading, listScripts); SetDlgItemBool(hDlg, chkAutoReload, autoLoadFiles); SetDlgItemBool(hDlg, optCompatible, haskell98); SetDlgItemBool(hDlg, optExtensions, !haskell98); SetDlgItemBool(hDlg, chkOverlap, allowOverlap); SetDlgItemBool(hDlg, chkOverlapUnsafe, allowUnsafeOverlap); SetDlgItemBool(hDlg, chkHereDocs, hereDocs); EnableHaskellExts(hDlg); break; case WM_NOTIFY: if (((NMHDR*) lParam)->code == PSN_APPLY) { // apply here int n = GetWindowTextLength(GetDlgItem(hDlg, txtPath)); free(hugsPath); hugsPath = malloc(n+5); GetDlgItemText(hDlg, txtPath, hugsPath, n+3); listScripts = GetDlgItemBool(hDlg, chkListLoading); autoLoadFiles = GetDlgItemBool(hDlg, chkAutoReload); haskell98 = GetDlgItemBool(hDlg, optCompatible); allowOverlap = GetDlgItemBool(hDlg, chkOverlap); allowUnsafeOverlap = GetDlgItemBool(hDlg, chkOverlapUnsafe); hereDocs = GetDlgItemBool(hDlg, chkHereDocs); WriteOptions(); } break; case WM_COMMAND: if (LOWORD(wParam) == chkOverlap || LOWORD(wParam) == optExtensions || LOWORD(wParam) == optCompatible) EnableHaskellExts(hDlg); break; } return (INT_PTR)FALSE; } hugs98-plus-Sep2006/src/winhugs/Editors.c0000644006511100651110000000522510312574356017025 0ustar rossross/* Editors - detect installed editors and their command line Used by the options dialog */ #include "Header.h" #include // HELPER BOOL RegGet(HKEY Key, LPCTSTR Subkey, LPTSTR Buffer) { LONG Size = MAX_PATH; return (RegQueryValue(Key, Subkey, Buffer, &Size) == ERROR_SUCCESS); } // CORE BOOL CalcNotepad(LPTSTR Buffer) { GetWindowsDirectory(Buffer, MAX_PATH); strcat(Buffer, "\\notepad.exe"); return TRUE; } BOOL CalcTextpad(LPTSTR Buffer) { //[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\TextPad.exe] //@="D:\\Program Files\\TextPad 4\\TextPad.exe" char* s; if (!RegGet(HKEY_LOCAL_MACHINE, "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\TextPad.exe", Buffer)) return FALSE; s = strrchr(Buffer, '\\'); if (s == NULL) return FALSE; strcpy(&s[1], "System\\DDEOPN32.EXE TextPad %s(%d)"); return TRUE; } BOOL CalcVim(LPTSTR Buffer) { // x = HKEY_LOCAL_MACHINE\SOFTWARE\Classes\Vim.Application\CLSID // vi = HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\$x$\LocalServer32 // cmd = "$vi$" +%d %s char Buf2[1000]; if (!RegGet(HKEY_LOCAL_MACHINE, "SOFTWARE\\Classes\\Vim.Application\\CLSID", Buffer)) return FALSE; sprintf(Buf2, "SOFTWARE\\Classes\\CLSID\\%s\\LocalServer32", Buffer); if (!RegGet(HKEY_LOCAL_MACHINE, Buf2, &Buffer[1])) return FALSE; Buffer[0] = '\"'; strcat(Buffer, "\" --remote-silent +%d %s"); return TRUE; } BOOL CalcSyn(LPTSTR Buffer) { Buffer[0] = '\"'; if (!RegGet(HKEY_CURRENT_USER, "Software\\Ascher\\Syn", &Buffer[1])) return FALSE; strcat(Buffer, "\" -line %d \"%s\""); return TRUE; } // DRIVER // A list of the editors struct { LPCTSTR Name; BOOL (*Func)(LPSTR Buffer); } const Editors[] = { {"Notepad", CalcNotepad}, {"Textpad (www.textpad.com)", CalcTextpad}, {"Vim (www.vim.org)", CalcVim}, {"Syn (syn.sourceforge.net)", CalcSyn}, {NULL, NULL} }; // Index is 0 based, which editor to return // Buffer is the result, the path to the editor. // Buffer[0] = 0 means this editor is not installed // Return is the name of the editor. // Return = NULL implies no more editors LPCTSTR GetEditor(int Index, LPTSTR Buffer) { Buffer[0] = 0; if (Editors[Index].Name == NULL) return NULL; if (!Editors[Index].Func(Buffer)) Buffer[0] = 0; return Editors[Index].Name; } char* WinHugsPickDefaultEditor() { TCHAR Buffer[MAX_PATH]; int i; for (i = 1; GetEditor(i, Buffer) != NULL; i++) { if (Buffer[0] != 0) return strdup(Buffer); } GetEditor(0, Buffer); if (Buffer[0] == 0) return NULL; else return strdup(Buffer); } hugs98-plus-Sep2006/src/winhugs/General.c0000644006511100651110000001116710332533116016762 0ustar rossross #include #include #include "Header.h" #include "machdep.h" #include "prelude.h" #include "storage.h" #include "connect.h" /* builds a short name for a file path of maximum length MAX_SHORTNAME */ #define MAX_SHORTNAME 40 VOID ShortFileName(CHAR *SrcFileName, CHAR *DestFileName) { CHAR dir[_MAX_PATH], shortDir[_MAX_PATH], shortAux[_MAX_PATH]; CHAR ext[_MAX_EXT]; CHAR drive[_MAX_DRIVE]; CHAR fName[_MAX_FNAME]; CHAR *ptr; BOOL Stop = FALSE; /* try to get path */ _splitpath (SrcFileName, drive, dir, fName, ext); /* delete last '\\' char */ ptr = strrchr(dir,'\\'); if (ptr) *ptr = (CHAR)0; wsprintf(shortDir, "\\%s%s", fName, ext); while (*dir && !Stop) { ptr = strrchr(dir,'\\'); if(strlen(shortDir)+strlen(ptr) < MAX_SHORTNAME) { /* shortDir = ptr ++ shortDir */ sprintf(shortAux, "%s%s", ptr, shortDir); strcpy(shortDir, shortAux); /* delete appended string from dir */ *ptr = (CHAR)0; } else Stop = TRUE; } if (*dir) wsprintf(DestFileName, "%s\\...%s",drive,shortDir); else wsprintf(DestFileName, "%s%s",drive,shortDir); } /* Call this function in WM_INITDIALOG to center the dialog in Parent window */ // Taken from the MSDN, Using Dialog Boxes void CenterDialogInParent(HWND hDlg) { RECT rDlg, rMain; int posX, posY; GetWindowRect(hDlg, &rDlg); GetWindowRect(GetParent(hDlg), &rMain); posX = rMain.left+((rMain.right-rMain.left-(rDlg.right - rDlg.left))/2); posY = rMain.top+((rMain.bottom-rMain.top-(rDlg.bottom - rDlg.top))/2); if (posX < 0) posX = 0; if (posY < 0) posY = 0; SetWindowPos(hDlg, NULL, posX, posY, 0, 0, SWP_NOSIZE | SWP_NOACTIVATE); } /* change working directory */ void SetWorkingDir(LPCSTR Src) { CHAR path[_MAX_PATH]; CHAR drive[_MAX_DRIVE]; CHAR thePath[2*_MAX_PATH]; /* ignore file name and extension */ _splitpath (Src, drive, path, NULL, NULL); wsprintf(thePath,"%s%s",drive,path); /* Set path */ SetCurrentDirectory(thePath); } // Works for HTML Documents, http links etc // if it starts with file:, then fire off the filename void ExecuteFile(LPSTR FileName) { if (strncmp(FileName, "file:", 5) == 0) { //find the line number char Buffer[MAX_PATH]; char* s = strrchr(FileName, ':'); int LineNo; if (s != NULL) { int i; s++; for (i = 0; s[i] != 0; i++) { if (!isdigit(s[i])) { s = NULL; break; } } } if (s == NULL) LineNo = 0; // the null line else { s[-1] = 0; LineNo = atoi(s); } FileName += 5; /* skip over "file:" */ if (strncmp("{Hugs}", FileName, 6) == 0) { strcpy(Buffer, hugsdir()); strcat(Buffer, &FileName[6]); } else if (FileName[0] == '.' && FileName[1] == '\\') { GetCurrentDirectory(MAX_PATH, Buffer); strcat(Buffer, &FileName[1]); } else strcpy(Buffer, FileName); startEdit(LineNo, Buffer); } else { int Res = (int) ShellExecute(hThisWindow, NULL, FileName, NULL, NULL, SW_SHOWNORMAL); if (Res <= 32) { char Buffer[MAX_PATH*2]; strcpy(Buffer, "Failed to launch file:\n"); strcat(Buffer, FileName); MessageBox(hThisWindow, Buffer, "Hugs98", MB_ICONWARNING); } } } // same as ExecuteFile, but relative to the Doc's directory void ExecuteFileDocs(LPSTR FileName) { char Buffer[MAX_PATH*2]; char* s; GetModuleFileName(hThisInstance, Buffer, MAX_PATH); s = strrchr(Buffer, '\\'); if (s == NULL) s = strrchr(Buffer, '/'); if (s != NULL) s[1] = 0; strcat(Buffer, "docs\\"); strcat(Buffer, FileName); ExecuteFile(Buffer); } /* expands characters like \ to \\ in a file name */ LPSTR ExpandFileName(LPSTR what) { static CHAR Expanded[2048]; if (*what == '\"') { strcpy(Expanded, what); } else { LPSTR where, t, unlex; strcpy(Expanded,"\""); for(where = &Expanded[1],t=what; *t; ++t) { unlex = unlexChar(*t,'"'); wsprintf(where, "%s", unlexChar(*t,'"')); where += strlen(unlex); } wsprintf(where, "\"%c", '\0'); } return Expanded; } BOOL ShowOpenFileDialog(HWND hParent, LPSTR FileName) { OPENFILENAME ofn; FileName[0] = 0; memset(&ofn, 0, sizeof(ofn)); ofn.lStructSize = sizeof(OPENFILENAME); ofn.hInstance = hThisInstance; ofn.hwndOwner = hParent; ofn.lpstrFilter = "Haskell Files (*.hs;*.lhs)\0*.hs;*.lhs\0All Files (*.*)\0*.*\0"; ofn.nFilterIndex = 1; ofn.lpstrFile= FileName; ofn.nMaxFile = MAX_PATH; ofn.lpstrFileTitle = NULL; ofn.Flags = OFN_PATHMUSTEXIST | OFN_FILEMUSTEXIST | OFN_HIDEREADONLY | OFN_EXPLORER; ofn.lpfnHook = NULL; ofn.lpstrInitialDir = NULL; return GetOpenFileName(&ofn); } hugs98-plus-Sep2006/src/winhugs/Header.h0000644006511100651110000000336410366405300016602 0ustar rossross#define WIN32_MEAN_AND_LEAN //#define UNICODE //#define _UNICODE #include #include #include #include // Globally shared variables extern HINSTANCE hThisInstance; extern HWND hThisWindow; extern HACCEL hAccelTable; // Exported from General.c void ExecuteFile(LPSTR FileName); void CenterDialogInParent(HWND hDlg); void ExecuteFileDocs(LPSTR FileName); BOOL ShowOpenFileDialog(HWND hParent, LPSTR FileName); // Exported from Registry.c void RegistryReadFont(CHARFORMAT* cf); void RegistryWriteFont(CHARFORMAT* cf); void RegistryReadWindowPos(HWND hWnd); void RegistryWriteWindowPos(HWND hWnd); void RegistryReadMru(LPSTR* Buffer); void RegistryWriteMru(LPSTR* Buffer); // Exported from RtfWindow.c void RtfWindowPutS(LPCTSTR s); void RtfWindowSetCommand(LPCTSTR s); void RtfWindowGetCommand(LPTSTR s); void RtfWindowUpdateFont(); void RtfWindowInit(HWND hNewRTF); void RtfWindowTimer(); //kind of internal void RtfWindowFlushBuffer(); // Exported from DlgMain.c void FireCommandDelay(LPCTSTR Command); void FireCommand(LPCTSTR Command); void ExecutionFinished(); BOOL ShowMainDialog(); void EnableButtons(); void SetStatusBar(LPCTSTR Str); extern BOOL Running; // From MruFiles.c LPSTR MruGetItem(int i); void MruInit(); // Generally around the place void ShowAboutDialog(HWND hParent); BOOL ShowOptionsDialog(HWND hParent); LPSTR ExpandFileName(LPSTR what); LPCTSTR GetEditor(int Index, LPTSTR Buffer); // IORemap, for getChar support void WinHugsReceiveC(int c); void IORemapBegin(); void IORemapEnd(); // From WinBrowse2.c void DrawClassesHierarchy(); void DoBrowseClasses(); void DoBrowseNames(); void DoBrowseTycons(); void ShowScriptMan(); // From History.c void AddHistory(LPCSTR Item); LPCSTR GetHistory(int delta); hugs98-plus-Sep2006/src/winhugs/History.c0000644006511100651110000000310210305571173017041 0ustar rossross#include "Header.h" // The history code // Add to the history, get from the history with a delta // pushing below the bottom one should return blank // pushing above top should return top again // the oldest history is at the lowest number #define HistoryMax 25 LPSTR History[HistoryMax]; int HistoryPos = 0; int HistoryCount = 0; LPCSTR Blank = ""; void AddHistory(LPCSTR Item) { if (HistoryCount != 0 && strcmp(Item, History[HistoryCount-1]) == 0) { HistoryPos = HistoryCount; return; //duplicate, eat it } if (HistoryCount == HistoryMax) { int i; free(History[0]); for (i = 1; i < HistoryCount; i++) History[i-1] = History[i]; HistoryCount--; } // there is now space for it History[HistoryCount] = strdup(Item); HistoryCount++; HistoryPos = HistoryCount; } LPCSTR GetHistory(int delta) { // set a new value, with sanity checks HistoryPos += delta; if (HistoryPos > HistoryCount) HistoryPos = HistoryCount; if (HistoryPos < 0) HistoryPos = 0; if (HistoryPos == HistoryCount) return Blank; else return History[HistoryPos]; } /* void AddHistory(LPCSTR Item) { int i; InitHistory(); if (History[0] != NULL) free(History[0]); for (i = 1; i < HistoryN; i++) History[i-1] = History[i]; History[HistoryN-1] = strdup(Item); HistoryPos = HistoryN; } LPCSTR GetHistory(int delta) { InitHistory(); HistoryPos += delta; if (HistoryPos >= HistoryN) { HistoryPos = HistoryN-1; return Blank; } else if (History[HistoryPos] == NULL) HistoryPos++; return History[HistoryPos]; } */ hugs98-plus-Sep2006/src/winhugs/IORemap.c0000644006511100651110000001037410372163666016715 0ustar rossross#include "Header.h" #include #include "Winhugs.h" #include #include #include // stdstr output definitions #define MAX_STDSTR 1024 int StrInx = 0; FILE *stdstr = NULL; char stdstrbuff[MAX_STDSTR]; // beacuse i need to use it // otherwise you call yourself #undef fputc void WinHugsPutText(FILE* f, char* Buffer, BOOL Char) { char First = Buffer[0]; if (Char && First == 0) Buffer[0] = '\1'; if (f == stderr) { int LastColor = WinHugsColor(RED); RtfWindowPutS(Buffer); WinHugsColor(LastColor); } else if (f == stdout) { RtfWindowPutS(Buffer); } else if (f == stdstr) { int i; for (i = 0; Buffer[i]; i++) { if (Buffer[i] == '\n') { stdstrbuff[StrInx] = 0; StrInx = 0; } else stdstrbuff[StrInx++] = Buffer[i]; } } else { if (Char) fputc(First, f); else fputs(Buffer, f); } } void WinHugsPutS(FILE* f, char* Buffer) { WinHugsPutText(f, Buffer, FALSE); } int WinHugsAnyPrintf(FILE* f, const char* format, va_list* args) { char Buffer[2048]; int Count = vsprintf(Buffer, format, *args); WinHugsPutS(f, Buffer); return Count; } int WinHugsPrintf(const char* format, ...) { va_list args; int Count; va_start(args, format); Count = WinHugsAnyPrintf(stdout, format, &args); va_end(args); return Count; } int WinHugsFPrintf(FILE* f, const char* format, ...) { va_list args; int Count; va_start(args, format); Count = WinHugsAnyPrintf(f, format, &args); va_end(args); return Count; } // Must be an int and not a char // Otherwise -1 return codes get created, and hugs exits int WinHugsPutC(FILE* f, int c) { char Buf[2]; Buf[0] = (char) c; Buf[1] = 0; WinHugsPutText(f, Buf, TRUE); return c; } ///////////////////////////////////////////////////////////////////// // IMPLEMENT getChar and interact BOOL ValidMutexes = FALSE; CRITICAL_SECTION Mutex; HANDLE Contents; #define KeyboardBufferSize 25 CHAR KeyboardBuffer[KeyboardBufferSize]; int KeyboardBufferCount = 0; void EnterContents() { WaitForSingleObject(Contents, INFINITE); } void ExitContents() { ReleaseSemaphore(Contents, 1, NULL); } void IORemapBegin() { // Put the mutexes in a sane state // Kill then create them if (ValidMutexes) { DeleteCriticalSection(&Mutex); CloseHandle(Contents); } InitializeCriticalSection(&Mutex); Contents = CreateSemaphore(NULL, 0, 1, NULL); ValidMutexes = TRUE; } void IORemapEnd() { // Send a dead char, to wake up the semaphore if locked WinHugsReceiveC(0); } // Called when a character gets sent to WinHugs while it is running void WinHugsReceiveC(int c) { EnterCriticalSection(&Mutex); if (KeyboardBufferCount != KeyboardBufferSize) { KeyboardBuffer[KeyboardBufferCount] = c; KeyboardBufferCount++; if (KeyboardBufferCount == 1) ExitContents(); } LeaveCriticalSection(&Mutex); } int WinHugsGetC(FILE* f) { if (f == stdin) { int Res, i; EnterCriticalSection(&Mutex); if (KeyboardBufferCount == 0) { SetStatusBar("Waiting for user input"); LeaveCriticalSection(&Mutex); EnterContents(); EnterCriticalSection(&Mutex); SetStatusBar(""); } Res = KeyboardBuffer[0]; for (i = 1; i < KeyboardBufferSize; i++) KeyboardBuffer[i-1] = KeyboardBuffer[i]; KeyboardBufferCount--; if (KeyboardBufferCount > 0) ExitContents(); LeaveCriticalSection(&Mutex); // fix problem with char/int truncation if (Res < 0) Res += 256; WinHugsPutC(stdout, Res); return Res; // no support for interact } else return fgetc(f); } void WinHugsFilename(const char* FileName, int LineNo) { LPCTSTR HugsDir = hugsdir(); int nHugsDir = strlen(HugsDir); int nCurDir; char Buffer[MAX_PATH], CurDir[MAX_PATH]; nCurDir = GetCurrentDirectory(MAX_PATH, CurDir); strcpy(Buffer, "file:"); if (strncmp(HugsDir, FileName, nHugsDir) == 0) { strcat(Buffer, "{Hugs}"); strcat(Buffer, FileName + nHugsDir); } else if (strnicmp(CurDir, FileName, nCurDir) == 0) { strcat(Buffer, "."); strcat(Buffer, FileName + nCurDir); } else strcat(Buffer, FileName); if (LineNo) { int n = strlen(Buffer); Buffer[n] = ':'; itoa(LineNo, Buffer + n+1, 10); } WinHugsHyperlink(Buffer); } hugs98-plus-Sep2006/src/winhugs/Legacy.c0000644006511100651110000020036210321457317016614 0ustar rossross/* -------------------------------------------------------------------------- * WinBrows.c: José Enrique Gallardo Ruiz, Feb 1999 * With modifications by mpj/adr for Hugs, 1995-97 * * The Hugs 98 system is Copyright (c) Jos€ Enrique Gallardo, Mark P Jones, * Alastair Reid, the Yale Haskell Group, and the OGI School of * Science & Engineering at OHSU, 1994-2003, All rights reserved. It is * distributed as free software under the license in the file "License", * which is included in the distribution. * ------------------------------------------------------------------------*/ // NEIL: // I don't much like the look of this and I'm not going anywhere near it! // Hopefully a hoogle solution can be done in the future // Modified minimally to get it working // Moved out of WinHugs.c and into separate module, a bit of massage to make that work #include "Header.h" #include "Winhugs.h" #include "prelude.h" #include "storage.h" #include "connect.h" #include "errors.h" #include "machdep.h" #include "strutil.h" #include "script.h" #include "opts.h" #include "output.h" #include "evaluator.h" #include "Winmenu.h" # define CMDdata(w,l) (HIWORD(w)) /* decoding WM_COMMAND message */ # define CMDitem(w,l) (LOWORD(w)) # define CMDhwnd(w,l) ((HWND)(l)) //#include "winhugs.h" #include "Header.h" HWND hWndClasses = NULL; #define DlgSendMessage(h,c,w,l) SendMessage((h),(c),MAKEWPARAM(w,(HIWORD(l))),(LOWORD(l))) /* Draws a bitmap on a DC */ VOID DrawBitmap(HDC hDC, HBITMAP hBitmap, UINT left, UINT top) { HBITMAP hOldBitmap; BITMAP bm; HDC hDCMemory; GetObject(hBitmap, sizeof(BITMAP), &bm); hDCMemory = CreateCompatibleDC(hDC); hOldBitmap = SelectObject(hDCMemory, hBitmap); BitBlt(hDC, left, top, bm.bmWidth, bm.bmHeight, hDCMemory, 0, 0, SRCCOPY); SelectObject(hDCMemory, hOldBitmap); DeleteDC(hDCMemory); } BOOL CALLBACK SetDialogFontProc(HWND hwndChild, LPARAM hFont) { SendMessage(hwndChild, WM_SETFONT, (WPARAM) hFont, (DWORD) TRUE); return TRUE; } /* Call this function in WM_INITDIALOG to set a font for every control in the dialog */ VOID SetDialogFont(HWND hDlg, HFONT hFont) { EnumChildWindows(hDlg, SetDialogFontProc, (LPARAM) hFont); } /************************************************************************* * * ChangeBitmapColorDC() * * This function makes all pixels in the given DC that have the * color rgbOld have the color rgbNew. This function is used by * ChangeBitmapColor(). * * Parameters: * * HDC hdcBM - Memory DC containing bitmap * LPBITMAP lpBM - Long pointer to bitmap structure from hdcBM * COLORREF rgbOld - Source color * COLORREF rgbNew - Destination color * * Return value: none. * * History: Date Author Reason * 6/10/91 CKindel Created * 1/23/92 MarkBad Added big nifty comments which explain * how this works, split bitmap graying * code out * *************************************************************************/ static VOID ChangeBitmapColorDC(HDC hdcBM, LPBITMAP lpBM, COLORREF rgbOld, COLORREF rgbNew) { HDC hdcMask; HBITMAP hbmMask, hbmOld; HBRUSH hbrOld; if (!lpBM) return; /* if the bitmap is mono we have nothing to do */ if (lpBM->bmPlanes == 1 && lpBM->bmBitsPixel == 1) return; /* To perform the color switching, we need to create a monochrome // "mask" which is the same size as our color bitmap, but has all // pixels which match the old color (rgbOld) in the bitmap set to 1. // // We then use the ROP code "DSPDxax" to Blt our monochrome // bitmap to the color bitmap. "D" is the Destination color // bitmap, "S" is the source monochrome bitmap, and "P" is the // selected brush (which is set to the replacement color (rgbNew)). // "x" and "a" represent the XOR and AND operators, respectively. // // The DSPDxax ROP code can be explained as having the following // effect: // // "Every place the Source bitmap is 1, we want to replace the // same location in our color bitmap with the new color. All // other colors we leave as is." // // The truth table for DSPDxax is as follows: // // D S P Result // - - - ------ // 0 0 0 0 // 0 0 1 0 // 0 1 0 0 // 0 1 1 1 // 1 0 0 1 // 1 0 1 1 // 1 1 0 0 // 1 1 1 1 // // (Even though the table is assuming monochrome D (Destination color), // S (Source color), & P's (Pattern color), the results apply to color // bitmaps also). // // By examining the table, every place that the Source is 1 // (source bitmap contains a 1), the result is equal to the // Pattern at that location. Where S is zero, the result equals // the Destination. // // See Section 11.2 (page 11-4) of the "Reference -- Volume 2" for more // information on the Termary Raster Operation codes. */ if (hbmMask = CreateBitmap(lpBM->bmWidth, lpBM->bmHeight, 1, 1, NULL)) { if (hdcMask = CreateCompatibleDC(hdcBM)) { /* Select th mask bitmap into the mono DC */ hbmOld = SelectObject(hdcMask, hbmMask); /* Create the brush and select it into the source color DC */ /* this is our "Pattern" or "P" color in our DSPDxax ROP. */ hbrOld = SelectObject(hdcBM, CreateSolidBrush(rgbNew)); /* To create the mask, we will use a feature of BitBlt -- when // converting from Color to Mono bitmaps, all Pixels of the // background colors are set to WHITE (1), and all other pixels // are set to BLACK (0). So all pixels in our bitmap that are // rgbOld color, we set to 1. */ SetBkColor(hdcBM, rgbOld); BitBlt(hdcMask, 0, 0, lpBM->bmWidth, lpBM->bmHeight, hdcBM, 0, 0, SRCCOPY); /* Where the mask is 1, lay down the brush, where it */ /* is 0, leave the destination. */ #define RGBBLACK RGB(0,0,0) #define RGBWHITE RGB(255,255,255) #define DSa 0x008800C6L #define DSo 0x00EE0086L #define DSx 0x00660045L #define DSPDxax 0x00E20746L SetBkColor(hdcBM, RGBWHITE); SetTextColor(hdcBM, RGBBLACK); BitBlt(hdcBM, 0, 0, lpBM->bmWidth, lpBM->bmHeight, hdcMask, 0, 0, DSPDxax); SelectObject(hdcMask, hbmOld); hbrOld = SelectObject(hdcBM, hbrOld); DeleteObject(hbrOld); DeleteDC(hdcMask); } else return; DeleteObject(hbmMask); } else return; } VOID MapBitmap(HBITMAP hbmSrc, COLORREF rgbOld, COLORREF rgbNew) { HDC hDC, hdcMem; BITMAP bmBits; if (hDC = GetDC(NULL)) { if (hdcMem = CreateCompatibleDC(hDC)) { /* Get the bitmap struct needed by ChangeBitmapColorDC() */ GetObject(hbmSrc, sizeof(BITMAP), (LPSTR) & bmBits); /* Select our bitmap into the memory DC */ hbmSrc = SelectObject(hdcMem, hbmSrc); /* Translate the sucker */ ChangeBitmapColorDC(hdcMem, &bmBits, rgbOld, rgbNew); /* Unselect our bitmap before deleting the DC */ hbmSrc = SelectObject(hdcMem, hbmSrc); DeleteDC(hdcMem); } ReleaseDC(NULL, hDC); } } /* Default colors used to map the DIB colors */ /* to the current system colors: */ #define MAPPED_BUTTONTEXT (RGB(000,000,000)) /* black */ #define MAPPED_BUTTONSHADOW (RGB(128,000,000)) /* dark red */ #define MAPPED_BUTTONFACE (RGB(255,000,255)) /* bright magenta */ #define MAPPED_BUTTONHILIGHT (RGB(255,255,255)) /* white */ /* Executes the dialog with DlgId identifier using lpDlgProc */ BOOL ExecDialog(HINSTANCE hInstance, WORD DlgId, DLGPROC lpDlgProc) { return (BOOL) (DialogBox (hInstance, MAKEINTRESOURCE(DlgId), GetFocus(), lpDlgProc)); } /* Loads a bitmap and maps system colors */ HBITMAP LoadMappedBitmap(HINSTANCE hInstance, LPCSTR BitmapName) { HBITMAP hBitmap; hBitmap = LoadBitmap(hInstance, BitmapName); MapBitmap(hBitmap, MAPPED_BUTTONHILIGHT, GetSysColor(COLOR_BTNHIGHLIGHT)); MapBitmap(hBitmap, MAPPED_BUTTONTEXT, GetSysColor(COLOR_BTNTEXT)); MapBitmap(hBitmap, MAPPED_BUTTONSHADOW, GetSysColor(COLOR_BTNSHADOW)); MapBitmap(hBitmap, MAPPED_BUTTONFACE, GetSysColor(COLOR_BTNFACE)); return hBitmap; } HFONT DefaultFont() { return GetStockObject(DEFAULT_GUI_FONT); } /* -------------------------------------------------------------------------- * Browse dialog boxes: * ------------------------------------------------------------------------*/ static VOID SetClass Args((HWND, Class)); static VOID SetName Args((HWND, UINT, List)); static VOID SetTycon Args((HWND, UINT, List)); /* When a class changes to currClass get new list of instances, */ /* members and contexts for the new class */ static local VOID SetClass(HWND hDlg, Class currClass) { INT i; List instances, members; /* Update list of instances */ SendDlgItemMessage(hDlg, LB_INSTANCES, LB_RESETCONTENT, 0, 0L); /* Clear the redraw flag */ SendDlgItemMessage(hDlg, LB_INSTANCES, WM_SETREDRAW, FALSE, 0L); for (instances = cclass(currClass).instances; !isNull(instances); instances = tl(instances)) { if (!isNull(instances)) { SendDlgItemMessage(hDlg, LB_INSTANCES, LB_ADDSTRING, 0, (LONG) (LPSTR) hd(instances)); } SendDlgItemMessage(hDlg, LB_INSTANCES, LB_SETCURSEL, 0, 0L); } /* Set the redraw flag and force repaint. */ SendDlgItemMessage(hDlg, LB_INSTANCES, WM_SETREDRAW, TRUE, 0L); InvalidateRect(GetDlgItem(hDlg, LB_INSTANCES), NULL, TRUE); /* Update list of members */ /* Clear the redraw flag */ SendDlgItemMessage(hDlg, LB_MEMBERS, WM_SETREDRAW, FALSE, 0L); SendDlgItemMessage(hDlg, LB_MEMBERS, LB_RESETCONTENT, 0, 0L); if (cclass(currClass).numMembers > 0) { for (members = cclass(currClass).members, i = 0; i < cclass(currClass).numMembers; members = tl(members), i++) { SendDlgItemMessage(hDlg, LB_MEMBERS, LB_ADDSTRING, 0, (LONG) (LPSTR) hd(members)); } SendDlgItemMessage(hDlg, LB_MEMBERS, LB_SETCURSEL, 0, 0L); } /* Set the redraw flag and force repaint. */ SendDlgItemMessage(hDlg, LB_MEMBERS, WM_SETREDRAW, TRUE, 0L); InvalidateRect(GetDlgItem(hDlg, LB_MEMBERS), NULL, TRUE); /* Update context */ SendDlgItemMessage(hDlg, LB_CONTEXT, LB_RESETCONTENT, 0, 0L); if (nonNull(cclass(currClass).supers)) { printContext(stdstr, cclass(currClass).supers); fprintf(stdstr, "\n"); SendDlgItemMessage(hDlg, LB_CONTEXT, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); } } /* Handles browse classes dialog box */ INT_PTR CALLBACK BrowseClassesDlgProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam) { INT i; static Class currClass; Class theClass; Inst theInst; Name theMember; WORD NotifyCode, wId; HBITMAP hBitmap; RECT aRect, DlgRect; HBITMAP hBmp; BITMAP bm; DRAWITEMSTRUCT FAR *lpdis; LPMEASUREITEMSTRUCT lpmis; LPCOMPAREITEMSTRUCT lpcis; BOOL Selected = FALSE; static HBITMAP hCBm, hCSelBm, hIBm, hISelBm, hMBm, hMSelBm; CHAR string1[256]; NotifyCode = HIWORD(wParam); wId = LOWORD(wParam); switch (msg) { case WM_INITDIALOG: CenterDialogInParent(hDlg); SetDialogFont(hDlg, DefaultFont()); SendDlgItemMessage(hDlg, LB_CLASS, LB_SETHORIZONTALEXTENT, (WPARAM) 300, 0L); SendDlgItemMessage(hDlg, LB_MEMBERS, LB_SETHORIZONTALEXTENT, (WPARAM) 400, 0L); /* Create list of classes and set current class */ for (i = CLASSMIN; i < classMax(); i++) { SendDlgItemMessage(hDlg, LB_CLASS, LB_ADDSTRING, 0, (LPARAM) (LPSTR) i); } SendDlgItemMessage(hDlg, LB_CLASS, LB_SETCURSEL, 0, 0L); currClass = (Class) SendDlgItemMessage(hDlg, LB_CLASS, LB_GETITEMDATA, (WPARAM) SendDlgItemMessage(hDlg, LB_CLASS, LB_GETCURSEL, 0, 0L), 0L); SetClass(hDlg, currClass); /* Create Bitmaps */ hCBm = LoadBitmap(hThisInstance, "CLASSBMP"); MapBitmap(hCBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hCSelBm = LoadBitmap(hThisInstance, "CLASSBMP"); MapBitmap(hCSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hIBm = LoadBitmap(hThisInstance, "INSTANCEBMP"); MapBitmap(hIBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hISelBm = LoadBitmap(hThisInstance, "INSTANCEBMP"); MapBitmap(hISelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hMBm = LoadBitmap(hThisInstance, "MEMBERBMP"); MapBitmap(hMBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hMSelBm = LoadBitmap(hThisInstance, "MEMBERBMP"); MapBitmap(hMSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); return (INT_PTR)TRUE; case WM_DESTROY: /* Destroy Bitmaps */ DeleteObject(hCBm); DeleteObject(hCSelBm); DeleteObject(hIBm); DeleteObject(hISelBm); DeleteObject(hMBm); DeleteObject(hMSelBm); break; case WM_CTLCOLORBTN: case WM_CTLCOLORDLG: case WM_CTLCOLOREDIT: case WM_CTLCOLORLISTBOX: case WM_CTLCOLORMSGBOX: case WM_CTLCOLORSCROLLBAR: case WM_CTLCOLORSTATIC: break; case WM_PAINT: { HDC hDC; PAINTSTRUCT Ps; BeginPaint(hDlg, &Ps); hDC = Ps.hdc; /* Paint classes Bitmap */ GetWindowRect(hDlg, &DlgRect); GetWindowRect(GetDlgItem(hDlg, ID_PLACEBITMAP), &aRect); hBitmap = LoadMappedBitmap(hThisInstance, "CLASSESDLGBMP"); DrawBitmap(hDC, hBitmap, aRect.left - DlgRect.left - GetSystemMetrics(SM_CXDLGFRAME), aRect.top - DlgRect.top - GetSystemMetrics(SM_CYDLGFRAME) - GetSystemMetrics(SM_CYCAPTION)); DeleteObject(hBitmap); EndPaint(hDlg, &Ps); } break; case WM_COMPAREITEM: { lpcis = (COMPAREITEMSTRUCT FAR *) lParam; switch (wParam) { case LB_CLASS: return strcmp(textToStr (cclass(lpcis->itemData1). text), textToStr(cclass (lpcis->itemData2). text)); case LB_INSTANCES: if (nonNull (inst(lpcis->itemData1).specifics)) { printContext(stdstr, inst(lpcis-> itemData1). specifics); fprintf(stdstr, " => "); } printPred(stdstr, inst(lpcis->itemData1).head); fprintf(stdstr, "\n"); strcpy(string1, stdstrbuff); if (nonNull (inst(lpcis->itemData2).specifics)) { printContext(stdstr, inst(lpcis-> itemData2). specifics); fprintf(stdstr, " => "); } printPred(stdstr, inst(lpcis->itemData2).head); fprintf(stdstr, "\n"); return strcmp(string1, stdstrbuff); case LB_MEMBERS: printExp(stdstr, lpcis->itemData1); fprintf(stdstr, "\n"); strcpy(string1, stdstrbuff); printExp(stdstr, lpcis->itemData2); fprintf(stdstr, "\n"); return strcmp(string1, stdstrbuff); } } break; case WM_MEASUREITEM: lpdis = (DRAWITEMSTRUCT FAR *) lParam; if (lpdis->CtlID == LB_CLASS || lpdis->CtlID == LB_INSTANCES || lpdis->CtlID == LB_MEMBERS) { lpmis = (LPMEASUREITEMSTRUCT) lParam; /* Set the height of the list box items to Bitmap height */ hBmp = LoadBitmap(hThisInstance, "CLASSBMP"); GetObject(hBmp, sizeof(BITMAP), &bm); DeleteObject(hBmp); lpmis->itemHeight = bm.bmHeight + 1; lpmis->itemWidth = 50000; return (INT_PTR)TRUE; } break; case WM_DRAWITEM: lpdis = (DRAWITEMSTRUCT FAR *) lParam; if (lpdis->CtlID == LB_CLASS || lpdis->CtlID == LB_INSTANCES || lpdis->CtlID == LB_MEMBERS) { if (lpdis->itemID == (UINT) - 1) { return (INT_PTR)TRUE; } switch (lpdis->itemAction) { case ODA_DRAWENTIRE: case ODA_SELECT: case ODA_FOCUS: if ((lpdis-> itemState & ODS_SELECTED) /*&& (lpdis->itemState & ODS_FOCUS) */ ) { SetBkColor(lpdis->hDC, GetSysColor (COLOR_HIGHLIGHT)); SetTextColor(lpdis->hDC, GetSysColor (COLOR_HIGHLIGHTTEXT)); Selected = TRUE; } else { SetBkColor(lpdis->hDC, GetSysColor (COLOR_WINDOW)); SetTextColor(lpdis->hDC, GetSysColor (COLOR_WINDOWTEXT)); } break; default: return (INT_PTR)FALSE; } switch (lpdis->CtlID) { case LB_CLASS: theClass = (Class) SendDlgItemMessage(hDlg, lpdis-> CtlID, LB_GETITEMDATA, lpdis-> itemID, 0); printPred(stdstr, cclass(theClass).head); fprintf(stdstr, " -- in %s\n", textToStr(module (cclass(theClass).mod). text)); ExtTextOut(lpdis->hDC, lpdis->rcItem.left + 21, lpdis->rcItem.top, ETO_OPAQUE, &(lpdis->rcItem), stdstrbuff, strlen(stdstrbuff), NULL); hBmp = Selected ? hCSelBm : hCBm; break; case LB_INSTANCES: theInst = (Inst) SendDlgItemMessage(hDlg, lpdis-> CtlID, LB_GETITEMDATA, lpdis-> itemID, 0); if (nonNull(inst(theInst).specifics)) { printContext(stdstr, inst(theInst). specifics); fprintf(stdstr, " => "); } printPred(stdstr, inst(theInst).head); fprintf(stdstr, " -- in %s \n", textToStr(module (moduleOfScript (scriptThisInst (theInst))).text)); ExtTextOut(lpdis->hDC, lpdis->rcItem.left + 21, lpdis->rcItem.top, ETO_OPAQUE, &(lpdis->rcItem), stdstrbuff, strlen(stdstrbuff), NULL); hBmp = Selected ? hISelBm : hIBm; break; case LB_MEMBERS: theMember = (Name) SendDlgItemMessage(hDlg, lpdis-> CtlID, LB_GETITEMDATA, lpdis-> itemID, 0); printExp(stdstr, theMember); fprintf(stdstr, " :: "); printType(stdstr, name(theMember).type); fprintf(stdstr, "\n"); ExtTextOut(lpdis->hDC, lpdis->rcItem.left + 21, lpdis->rcItem.top, ETO_OPAQUE, &(lpdis->rcItem), stdstrbuff, strlen(stdstrbuff), NULL); hBmp = Selected ? hMSelBm : hMBm; break; } DrawBitmap(lpdis->hDC, hBmp, (lpdis->rcItem.left) + 4, lpdis->rcItem.top); /* If selected draw rectangle */ if ((lpdis->itemState & ODS_SELECTED) && (lpdis->itemState & ODS_FOCUS)) { DrawFocusRect(lpdis->hDC, &(lpdis->rcItem)); } return (INT_PTR)TRUE; } case WM_COMMAND: switch (wId) { case LB_CLASS: switch (NotifyCode) { case LBN_SELCHANGE: /* select a new class */ currClass = (Class) SendDlgItemMessage(hDlg, LB_CLASS, LB_GETITEMDATA, SendDlgItemMessage (hDlg, LB_CLASS, LB_GETCURSEL, 0, 0L), 0L); SetClass(hDlg, currClass); break; case LBN_DBLCLK: { /* Open in text editor script file with class definition */ currClass = (Class) SendDlgItemMessage(hDlg, LB_CLASS, LB_GETITEMDATA, SendDlgItemMessage (hDlg, LB_CLASS, LB_GETCURSEL, 0, 0L), 0L); currClass = (Class) SendDlgItemMessage(hDlg, LB_CLASS, LB_GETITEMDATA, SendDlgItemMessage (hDlg, LB_CLASS, LB_GETCURSEL, 0, 0L), 0L); setLastEdit(getScriptName (scriptThisClass (currClass)), cclass(currClass). line); runEditor(); } break; } break; case LB_MEMBERS: case LB_INSTANCES: switch (NotifyCode) { /* Open in text editor script file with instance definition */ case LBN_DBLCLK: { Inst currInst; currInst = (Inst) SendDlgItemMessage(hDlg, LB_INSTANCES, LB_GETITEMDATA, SendDlgItemMessage (hDlg, LB_INSTANCES, LB_GETCURSEL, 0, 0L), 0L); /* Find instance module */ setLastEdit(getScriptName (scriptThisInst (currInst)), inst(currInst).line); runEditor(); } break; } break; case ID_HIERARCHY: /* Draw classes hierarchy */ DrawClassesHierarchy(); break; case ID_EDITCLASS: /* Pushed on Edit class button */ if (SendDlgItemMessage (hDlg, LB_CLASS, LB_GETCURSEL, 0, 0L) != LB_ERR) DlgSendMessage(hDlg, WM_COMMAND, LB_CLASS, MAKELONG(0, LBN_DBLCLK)); break; case ID_EDITINSTANCE: /* Pushed on Edit instance button */ if (SendDlgItemMessage (hDlg, LB_INSTANCES, LB_GETCURSEL, 0, 0L) != LB_ERR) DlgSendMessage(hDlg, WM_COMMAND, LB_INSTANCES, MAKELONG(0, LBN_DBLCLK)); break; case IDCANCEL: /* Close dialog */ EndDialog(hDlg, FALSE); return (INT_PTR)TRUE; case IDOK: EndDialog(hDlg, TRUE); return (INT_PTR)TRUE; default: return (INT_PTR)TRUE; } } return (INT_PTR)FALSE; } /* When the name selected changes to currName gets its type and definition */ static local VOID SetName(HWND hDlg, UINT currName, List names) { Name nm = nth(currName, names); if (nonNull(name(nm).type)) printType(stdstr, name(nm).type); else fprintf(stdstr, ""); fprintf(stdstr, "\n"); SendDlgItemMessage(hDlg, LB_NAMESTYPE, LB_RESETCONTENT, 0, 0L); SendDlgItemMessage(hDlg, LB_NAMESTYPE, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); if (isCfun(nm)) fprintf(stdstr, "Data constructor"); else if (isMfun(nm)) fprintf(stdstr, "Class member"); else if (isSfun(nm)) fprintf(stdstr, "Selector function"); else if (name(nm).primDef) fprintf(stdstr, "Primitive"); fprintf(stdstr, "\n"); SendDlgItemMessage(hDlg, LB_NAMESNOTES, LB_RESETCONTENT, 0, 0L); SendDlgItemMessage(hDlg, LB_NAMESNOTES, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); } /* Handles browse names dialog box */ INT_PTR CALLBACK BrowseNamesDlgProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam) { static List namesList = NIL; List names = NIL; struct strName nm; Name n; UINT theName; WORD NotifyCode, wId; RECT aRect, DlgRect; HBITMAP hBitmap; HBITMAP hBmp; BITMAP bm; static HBITMAP hPBm, hPSelBm, hDBm, hDSelBm, hMBm, hMSelBm, hNBm, hNSelBm, hSBm, hSSelBm; CHAR Buffer[300]; DRAWITEMSTRUCT FAR *lpdis; LPMEASUREITEMSTRUCT lpmis; BOOL Selected = FALSE; NotifyCode = HIWORD(wParam); wId = LOWORD(wParam); switch (msg) { case WM_INITDIALOG: CenterDialogInParent(hDlg); SetDialogFont(hDlg, DefaultFont()); namesList = addNamesMatching((String) 0, NIL); /* Clear the redraw flag */ SendDlgItemMessage(hDlg, LB_NAMES, WM_SETREDRAW, FALSE, 0L); for (names = namesList; nonNull(names); names = tl(names)) { if (nonNull(names)) { nm = name(hd(names)); fprintf(stdstr, "%s -- in %s\n", textToStr(nm.text), textToStr(module(nm.mod).text)); SendDlgItemMessage(hDlg, LB_NAMES, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); SendDlgItemMessage(hDlg, LB_NAMES, LB_SETCURSEL, 0, 0L); } } /* Set the redraw flag and force repaint. */ SendDlgItemMessage(hDlg, LB_NAMES, WM_SETREDRAW, TRUE, 0L); InvalidateRect(GetDlgItem(hDlg, LB_NAMES), NULL, TRUE); theName = 0; SetName(hDlg, theName, namesList); hPBm = LoadBitmap(hThisInstance, "PRIMBMP"); MapBitmap(hPBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hPSelBm = LoadBitmap(hThisInstance, "PRIMBMP"); MapBitmap(hPSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hDBm = LoadBitmap(hThisInstance, "DATACONSBMP"); MapBitmap(hDBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hDSelBm = LoadBitmap(hThisInstance, "DATACONSBMP"); MapBitmap(hDSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hMBm = LoadBitmap(hThisInstance, "MEMBERBMP"); MapBitmap(hMBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hMSelBm = LoadBitmap(hThisInstance, "MEMBERBMP"); MapBitmap(hMSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hNBm = LoadBitmap(hThisInstance, "NAMEBMP"); MapBitmap(hNBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hNSelBm = LoadBitmap(hThisInstance, "NAMEBMP"); MapBitmap(hNSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hSBm = LoadBitmap(hThisInstance, "SELECTORBMP"); MapBitmap(hSBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hSSelBm = LoadBitmap(hThisInstance, "SELECTORBMP"); MapBitmap(hSSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); /* set focus to search box (must return FALSE) */ SetFocus(GetDlgItem(hDlg, IDC_SEARCHNAME)); return (INT_PTR)FALSE; case WM_DESTROY: DeleteObject(hPBm); DeleteObject(hPSelBm); DeleteObject(hDBm); DeleteObject(hDSelBm); DeleteObject(hMBm); DeleteObject(hMSelBm); DeleteObject(hNBm); DeleteObject(hNSelBm); DeleteObject(hSBm); DeleteObject(hSSelBm); break; case WM_CTLCOLORBTN: case WM_CTLCOLORDLG: case WM_CTLCOLOREDIT: case WM_CTLCOLORLISTBOX: case WM_CTLCOLORMSGBOX: case WM_CTLCOLORSCROLLBAR: case WM_CTLCOLORSTATIC: break; case WM_MEASUREITEM: lpdis = (DRAWITEMSTRUCT FAR *) lParam; if (lpdis->CtlID == LB_NAMES) { lpmis = (LPMEASUREITEMSTRUCT) lParam; /* Set the height of the list box items to Bitmap height */ hBmp = LoadBitmap(hThisInstance, "PRIMBMP"); GetObject(hBmp, sizeof(BITMAP), &bm); DeleteObject(hBmp); lpmis->itemHeight = bm.bmHeight + 1; return (INT_PTR)TRUE; } break; case WM_DRAWITEM: lpdis = (DRAWITEMSTRUCT FAR *) lParam; if (lpdis->CtlID == LB_NAMES) { if (lpdis->itemID == (UINT) - 1) { return (INT_PTR)TRUE; } switch (lpdis->itemAction) { case ODA_DRAWENTIRE: case ODA_SELECT: case ODA_FOCUS: if ((lpdis-> itemState & ODS_SELECTED) /*&& (lpdis->itemState & ODS_FOCUS) */ ) { SetBkColor(lpdis->hDC, GetSysColor (COLOR_HIGHLIGHT)); SetTextColor(lpdis->hDC, GetSysColor (COLOR_HIGHLIGHTTEXT)); Selected = TRUE; } else { SetBkColor(lpdis->hDC, GetSysColor (COLOR_WINDOW)); SetTextColor(lpdis->hDC, GetSysColor (COLOR_WINDOWTEXT)); } break; default: return (INT_PTR)FALSE; } SendDlgItemMessage(hDlg, lpdis->CtlID, LB_GETTEXT, lpdis->itemID, (LPARAM) Buffer); ExtTextOut(lpdis->hDC, lpdis->rcItem.left + 21, lpdis->rcItem.top, ETO_OPAQUE, &(lpdis->rcItem), Buffer, strlen(Buffer), NULL); n = nth(lpdis->itemID, namesList); if (isCfun(n)) hBmp = Selected ? hDSelBm : hDBm; else if (isMfun(n)) hBmp = Selected ? hMSelBm : hMBm; else if (isSfun(n)) hBmp = Selected ? hSSelBm : hSBm; else if (name(n).primDef) hBmp = Selected ? hPSelBm : hPBm; else hBmp = Selected ? hNSelBm : hNBm; DrawBitmap(lpdis->hDC, hBmp, (lpdis->rcItem.left) + 4, lpdis->rcItem.top); /* If selected draw rectangle */ if ((lpdis->itemState & ODS_SELECTED) && (lpdis->itemState & ODS_FOCUS)) { DrawFocusRect(lpdis->hDC, &(lpdis->rcItem)); } return (INT_PTR)TRUE; } case WM_PAINT: { HDC hDC; PAINTSTRUCT Ps; BeginPaint(hDlg, &Ps); hDC = Ps.hdc; /* Paint classes Bitmap */ GetWindowRect(hDlg, &DlgRect); GetWindowRect(GetDlgItem(hDlg, ID_PLACEBITMAP), &aRect); hBitmap = LoadMappedBitmap(hThisInstance, "NAMESDLGBMP"); DrawBitmap(hDC, hBitmap, aRect.left - DlgRect.left - GetSystemMetrics(SM_CXDLGFRAME), aRect.top - DlgRect.top - GetSystemMetrics(SM_CYDLGFRAME) - GetSystemMetrics(SM_CYCAPTION)); DeleteObject(hBitmap); EndPaint(hDlg, &Ps); } break; case WM_COMMAND: switch (wId) { case LB_NAMES: switch (NotifyCode) { case LBN_SELCHANGE: /* Select a new name */ theName = (UINT) SendDlgItemMessage(hDlg, LB_NAMES, LB_GETCURSEL, 0, 0L); SetName(hDlg, theName, namesList); break; case LBN_DBLCLK: { /* Open in text editor script file with name definition */ Name n; /* Get the selected name */ theName = (UINT) SendDlgItemMessage(hDlg, LB_NAMES, LB_GETCURSEL, 0, 0L); n = nth(theName, namesList); if (!name(n).primDef) { setLastEdit(getScriptName (scriptThisName (n)), name(n).line); runEditor(); } else { InfoBox("Primitive function:\nNo definition available."); } } break; } break; case IDC_SEARCHNAME: /* Search a name */ switch (HIBYTE(NotifyCode)) { case HIBYTE(EN_CHANGE): { CHAR Buffer[300]; /* Get edit control contents */ SendDlgItemMessage(hDlg, IDC_SEARCHNAME, WM_GETTEXT, 300, (LPARAM) ((LPSTR) Buffer)); /* Search in names list box */ SendDlgItemMessage(hDlg, LB_NAMES, LB_SELECTSTRING, 0, (LPARAM) ((LPSTR) Buffer)); /* Update window contents */ DlgSendMessage(hDlg, WM_COMMAND, LB_NAMES, MAKELONG(0, LBN_SELCHANGE)); } break; } break; case ID_EDITNAME: /* Pushed on Edit name button */ if (SendDlgItemMessage (hDlg, LB_NAMES, LB_GETCURSEL, 0, 0L) != LB_ERR) DlgSendMessage(hDlg, WM_COMMAND, LB_NAMES, MAKELONG(0, LBN_DBLCLK)); break; case IDCANCEL: /* Close dialog */ EndDialog(hDlg, FALSE); return (INT_PTR)TRUE; case IDOK: EndDialog(hDlg, TRUE); return (INT_PTR)TRUE; default: return (INT_PTR)TRUE; } } return (INT_PTR)FALSE; } static Int numCfuns; static Int numSfuns; /* A new Tycon was selected */ static local VOID SetTycon(HWND hDlg, UINT currTycon, List tycons) { Tycon tc; Int j; Type t; Inst in; tc = nth(currTycon, tycons); numCfuns = 0; numSfuns = 0; t = tc; for (j = 0; j < tycon(tc).arity; ++j) t = ap(t, mkOffset(j)); switch (tycon(tc).what) { case SYNONYM: fprintf(stdstr, "type "); printType(stdstr, t); fprintf(stdstr, " = "); printType(stdstr, tycon(tc).defn); fprintf(stdstr, "\n"); SendDlgItemMessage(hDlg, LB_CONS, LB_RESETCONTENT, 0, 0L); SendDlgItemMessage(hDlg, LB_DEF, LB_RESETCONTENT, 0, 0L); SendDlgItemMessage(hDlg, LB_DEF, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); break; case NEWTYPE: case DATATYPE: { List cs = tycon(tc).defn; if (tycon(tc).what == DATATYPE) fprintf(stdstr, "data "); else fprintf(stdstr, "newtype "); printType(stdstr, t); fprintf(stdstr, "\n"); SendDlgItemMessage(hDlg, LB_DEF, LB_RESETCONTENT, 0, 0L); SendDlgItemMessage(hDlg, LB_DEF, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); SendDlgItemMessage(hDlg, LB_CONS, LB_RESETCONTENT, 0, 0L); /* Clear the redraw flag */ SendDlgItemMessage(hDlg, LB_CONS, WM_SETREDRAW, FALSE, 0L); for (; nonNull(cs); cs = tl(cs)) { printExp(stdstr, hd(cs)); fprintf(stdstr, " :: "); printType(stdstr, name(hd(cs)).type); fprintf(stdstr, "\n"); SendDlgItemMessage(hDlg, LB_CONS, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); SendDlgItemMessage(hDlg, LB_CONS, LB_SETCURSEL, 0, 0L); if (isCfun(hd(cs))) numCfuns++; else numSfuns++; } /* Set the redraw flag and force repaint. */ SendDlgItemMessage(hDlg, LB_CONS, WM_SETREDRAW, TRUE, 0L); InvalidateRect(GetDlgItem(hDlg, LB_CONS), NULL, TRUE); break; } case RESTRICTSYN: fprintf(stdstr, "type"); printType(stdstr, t); fprintf(stdstr, " = \n"); SendDlgItemMessage(hDlg, LB_CONS, LB_RESETCONTENT, 0, 0L); SendDlgItemMessage(hDlg, LB_DEF, LB_RESETCONTENT, 0, 0L); SendDlgItemMessage(hDlg, LB_DEF, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); break; } /* Set instances */ SendDlgItemMessage(hDlg, LB_TYCONSINST, LB_RESETCONTENT, 0, 0L); /* Clear the redraw flag */ SendDlgItemMessage(hDlg, LB_TYCONSINST, WM_SETREDRAW, FALSE, 0L); if (nonNull(in = findFirstInst(tc))) { do { SendDlgItemMessage(hDlg, LB_TYCONSINST, LB_ADDSTRING, 0, (LONG) (LPSTR) in); SendDlgItemMessage(hDlg, LB_TYCONSINST, LB_SETCURSEL, 0, 0L); in = findNextInst(tc, in); } while (nonNull(in)); } /* Set the redraw flag and force repaint. */ SendDlgItemMessage(hDlg, LB_TYCONSINST, WM_SETREDRAW, TRUE, 0L); InvalidateRect(GetDlgItem(hDlg, LB_TYCONSINST), NULL, TRUE); } /* Handles browse Tycons dialog box */ INT_PTR CALLBACK BrowseTyconsDlgProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam) { static List tyconList = NIL; List tycons = NIL; Tycon tc; UINT theTycon; WORD NotifyCode, wId; RECT aRect, DlgRect; HBITMAP hBitmap; HBITMAP hBmp; BITMAP bm; static HBITMAP hTCBm, hTCSelBm, hDBm, hDSelBm, hTSBm, hTSSelBm, hNTBm, hNTSelBm, hSBm, hSSelBm, hIBm, hISelBm; CHAR Buffer[300]; DRAWITEMSTRUCT FAR *lpdis; LPMEASUREITEMSTRUCT lpmis; BOOL Selected = FALSE; Inst theInst; NotifyCode = HIWORD(wParam); wId = LOWORD(wParam); switch (msg) { case WM_INITDIALOG: CenterDialogInParent(hDlg); SetDialogFont(hDlg, DefaultFont()); tyconList = addTyconsMatching((String) 0, NIL); /* Clear the redraw flag */ SendDlgItemMessage(hDlg, LB_TYCONS, WM_SETREDRAW, FALSE, 0L); for (tycons = tyconList; nonNull(tycons); tycons = tl(tycons)) { if (nonNull(tycons)) { tc = hd(tycons); fprintf(stdstr, "%s -- in %s\n", textToStr(tycon(tc).text), textToStr(module(tycon(tc).mod). text)); SendDlgItemMessage(hDlg, LB_TYCONS, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); SendDlgItemMessage(hDlg, LB_TYCONS, LB_SETCURSEL, 0, 0L); } /* Set the redraw flag and force repaint. */ SendDlgItemMessage(hDlg, LB_TYCONS, WM_SETREDRAW, TRUE, 0L); InvalidateRect(GetDlgItem(hDlg, LB_TYCONS), NULL, TRUE); } theTycon = 0; SetTycon(hDlg, theTycon, tyconList); hTCBm = LoadBitmap(hThisInstance, "TYPECONSBMP"); MapBitmap(hTCBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hTCSelBm = LoadBitmap(hThisInstance, "TYPECONSBMP"); MapBitmap(hTCSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hDBm = LoadBitmap(hThisInstance, "DATACONSBMP"); MapBitmap(hDBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hDSelBm = LoadBitmap(hThisInstance, "DATACONSBMP"); MapBitmap(hDSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hTSBm = LoadBitmap(hThisInstance, "TYPESINBMP"); MapBitmap(hTSBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hTSSelBm = LoadBitmap(hThisInstance, "TYPESINBMP"); MapBitmap(hTSSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hNTBm = LoadBitmap(hThisInstance, "NEWTYPEBMP"); MapBitmap(hNTBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hNTSelBm = LoadBitmap(hThisInstance, "NEWTYPEBMP"); MapBitmap(hNTSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hSBm = LoadBitmap(hThisInstance, "SELECTORBMP"); MapBitmap(hSBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hSSelBm = LoadBitmap(hThisInstance, "SELECTORBMP"); MapBitmap(hSSelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); hIBm = LoadBitmap(hThisInstance, "INSTANCEBMP"); MapBitmap(hIBm, RGB(0, 128, 128), GetSysColor(COLOR_WINDOW)); hISelBm = LoadBitmap(hThisInstance, "INSTANCEBMP"); MapBitmap(hISelBm, RGB(0, 128, 128), GetSysColor(COLOR_HIGHLIGHT)); /* set focus to search box (must return FALSE) */ SetFocus(GetDlgItem(hDlg, IDC_SEARCHTYCON)); return (INT_PTR)FALSE; case WM_DESTROY: DeleteObject(hTCBm); DeleteObject(hTCSelBm); DeleteObject(hDBm); DeleteObject(hDSelBm); DeleteObject(hTSBm); DeleteObject(hTSSelBm); DeleteObject(hNTBm); DeleteObject(hNTSelBm); DeleteObject(hSBm); DeleteObject(hSSelBm); DeleteObject(hIBm); DeleteObject(hISelBm); break; case WM_CTLCOLORBTN: case WM_CTLCOLORDLG: case WM_CTLCOLOREDIT: case WM_CTLCOLORLISTBOX: case WM_CTLCOLORMSGBOX: case WM_CTLCOLORSCROLLBAR: case WM_CTLCOLORSTATIC: break; case WM_MEASUREITEM: lpdis = (DRAWITEMSTRUCT FAR *) lParam; if (lpdis->CtlID == LB_TYCONS || lpdis->CtlID == LB_CONS || lpdis->CtlID == LB_TYCONSINST) { lpmis = (LPMEASUREITEMSTRUCT) lParam; /* Set the height of the list box items to Bitmap height */ hBmp = LoadBitmap(hThisInstance, "CLASSBMP"); GetObject(hBmp, sizeof(BITMAP), &bm); DeleteObject(hBmp); lpmis->itemHeight = bm.bmHeight + 1; return (INT_PTR)TRUE; } break; case WM_DRAWITEM: lpdis = (DRAWITEMSTRUCT FAR *) lParam; if (lpdis->CtlID == LB_TYCONS || lpdis->CtlID == LB_CONS || lpdis->CtlID == LB_TYCONSINST) { if (lpdis->itemID == (UINT) - 1) { return (INT_PTR)TRUE; } switch (lpdis->itemAction) { case ODA_DRAWENTIRE: case ODA_SELECT: case ODA_FOCUS: if ((lpdis-> itemState & ODS_SELECTED) /*&& (lpdis->itemState & ODS_FOCUS) */ ) { SetBkColor(lpdis->hDC, GetSysColor (COLOR_HIGHLIGHT)); SetTextColor(lpdis->hDC, GetSysColor (COLOR_HIGHLIGHTTEXT)); Selected = TRUE; } else { SetBkColor(lpdis->hDC, GetSysColor (COLOR_WINDOW)); SetTextColor(lpdis->hDC, GetSysColor (COLOR_WINDOWTEXT)); } break; default: return (INT_PTR)FALSE; } SendDlgItemMessage(hDlg, lpdis->CtlID, LB_GETTEXT, lpdis->itemID, (LPARAM) Buffer); ExtTextOut(lpdis->hDC, lpdis->rcItem.left + 21, lpdis->rcItem.top, ETO_OPAQUE, &(lpdis->rcItem), Buffer, strlen(Buffer), NULL); switch (lpdis->CtlID) { case LB_TYCONS: theTycon = (UINT) lpdis->itemID; tc = nth(theTycon, tyconList); switch (tycon(tc).what) { case RESTRICTSYN: case SYNONYM: hBmp = Selected ? hTSSelBm : hTSBm; break; case DATATYPE: hBmp = Selected ? hTCSelBm : hTCBm; break; case NEWTYPE: hBmp = Selected ? hNTSelBm : hNTBm; break; } break; case LB_CONS: if (lpdis->itemID >= (UINT) numCfuns) hBmp = Selected ? hSSelBm : hSBm; else hBmp = Selected ? hDSelBm : hDBm; break; case LB_TYCONSINST: theInst = (Inst) SendDlgItemMessage(hDlg, lpdis-> CtlID, LB_GETITEMDATA, lpdis-> itemID, 0); if (nonNull(inst(theInst).specifics)) { printContext(stdstr, inst(theInst). specifics); fprintf(stdstr, " => "); } printPred(stdstr, inst(theInst).head); fprintf(stdstr, " -- in %s \n", textToStr(module (moduleOfScript (scriptThisInst (theInst))).text)); ExtTextOut(lpdis->hDC, lpdis->rcItem.left + 21, lpdis->rcItem.top, ETO_OPAQUE, &(lpdis->rcItem), stdstrbuff, strlen(stdstrbuff), NULL); hBmp = Selected ? hISelBm : hIBm; break; } DrawBitmap(lpdis->hDC, hBmp, (lpdis->rcItem.left) + 4, lpdis->rcItem.top); /* If selected draw rectangle */ if ((lpdis->itemState & ODS_SELECTED) && (lpdis->itemState & ODS_FOCUS)) { DrawFocusRect(lpdis->hDC, &(lpdis->rcItem)); } return (INT_PTR)TRUE; } case WM_PAINT: { HDC hDC; PAINTSTRUCT Ps; BeginPaint(hDlg, &Ps); hDC = Ps.hdc; /* Paint classes Bitmap */ GetWindowRect(hDlg, &DlgRect); GetWindowRect(GetDlgItem(hDlg, ID_PLACEBITMAP), &aRect); hBitmap = LoadMappedBitmap(hThisInstance, "TYCONSDLGBMP"); DrawBitmap(hDC, hBitmap, aRect.left - DlgRect.left - GetSystemMetrics(SM_CXDLGFRAME), aRect.top - DlgRect.top - GetSystemMetrics(SM_CYDLGFRAME) - GetSystemMetrics(SM_CYCAPTION)); DeleteObject(hBitmap); EndPaint(hDlg, &Ps); } break; case WM_COMMAND: switch (LOWORD(wId)) { case LB_TYCONS: switch (NotifyCode) { case LBN_SELCHANGE: { /* A new tycon was selected */ theTycon = (UINT) SendDlgItemMessage(hDlg, LB_TYCONS, LB_GETCURSEL, 0, 0L); SetTycon(hDlg, theTycon, tyconList); } break; case LBN_DBLCLK: { /* Open in text editor script file with instance definition */ INT TheTycon; Tycon tc; /* Get selected tycon */ TheTycon = (UINT) SendDlgItemMessage(hDlg, LB_TYCONS, LB_GETCURSEL, 0, 0L); tc = nth(TheTycon, tyconList); if (isTycon(tc) && tycon(tc).line) { setLastEdit(getScriptName (scriptThisTycon (tc)), tycon(tc). line); runEditor(); } else { InfoBox("Primitive type:\nNo definition available."); } } break; } break; case LB_TYCONSINST: switch (NotifyCode) { case LBN_DBLCLK: { Inst currInst; currInst = (Inst) SendDlgItemMessage(hDlg, LB_TYCONSINST, LB_GETITEMDATA, SendDlgItemMessage (hDlg, LB_TYCONSINST, LB_GETCURSEL, 0, 0L), 0L); /* Find instance module */ setLastEdit(getScriptName (scriptThisInst (currInst)), inst(currInst).line); runEditor(); } break; } break; case IDC_SEARCHTYCON: /* Search a name */ switch (HIBYTE(wId)) { case HIBYTE(EN_CHANGE): { CHAR Buffer[300]; /* Get edit control contents */ SendDlgItemMessage(hDlg, IDC_SEARCHTYCON, WM_GETTEXT, 300, (LPARAM) ((LPSTR) Buffer)); /* Search in names list box */ SendDlgItemMessage(hDlg, LB_TYCONS, LB_SELECTSTRING, 0, (LPARAM) ((LPSTR) Buffer)); /* Update window contents */ DlgSendMessage(hDlg, WM_COMMAND, LB_TYCONS, MAKELONG(0, LBN_SELCHANGE)); } break; } break; case LB_CONS: switch (NotifyCode) { case LBN_DBLCLK: { /* Open in text editor script file with constructor definition */ DlgSendMessage(hDlg, WM_COMMAND, ID_EDITTYCON, 0L); break; } } break; case ID_EDITTYCON: /* Pushed on Edit tycon button */ if (SendDlgItemMessage (hDlg, LB_TYCONS, LB_GETCURSEL, 0, 0L) != LB_ERR) DlgSendMessage(hDlg, WM_COMMAND, LB_TYCONS, MAKELONG(0, LBN_DBLCLK)); break; case ID_EDITTYCONSINST: if (SendDlgItemMessage (hDlg, LB_TYCONSINST, LB_GETCURSEL, 0, 0L) != LB_ERR) DlgSendMessage(hDlg, WM_COMMAND, LB_TYCONSINST, MAKELONG(0, LBN_DBLCLK)); break; case IDCANCEL: /* Close dialog */ EndDialog(hDlg, FALSE); return (INT_PTR)TRUE; case IDOK: EndDialog(hDlg, TRUE); return (INT_PTR)TRUE; default: return (INT_PTR)TRUE; } } return (INT_PTR)FALSE; } /*----------------------------------------------------------------------------- * Class Hierarchy browser * * When the hierarchy browser is created, we call buildClassGraph to * construct a table of class-position pairs. * The positions in the table can be adjusted using left button to drag nodes. * Edges (superclass relationships) are added in as the graph is being drawn. *----------------------------------------------------------------------------*/ static VOID local setClassBrowserSize Args((Void)); static VOID local doCreate_Classes Args((HWND)); static VOID local doDestroy_Classes Args((Void)); static Void local doMove_Classes Args((HWND, INT, INT)); static Void local doSize_Classes Args((HWND, INT, INT)); static Void local doPaint_Classes Args((HWND)); static Void local setOffset_Classes Args((HWND, INT, INT)); static Void local lButtonDown_Classes Args((HWND, INT, INT)); static Void local lButtonUp_Classes Args((HWND, INT, INT)); static Void local doMouseMove_Classes Args((HWND, INT, INT)); static Void local doGetMinMaxInfo_Classes Args((MINMAXINFO FAR *)); /* Layout controls */ #define VERTICAL_SEPARATION 35 #define HORIZONTAL_SEPARATION 55 #define INIT_COLUMN 10 #define INIT_ROW 20 #define MAX_WIDTH 600 #define MAX_HEIGHT 500 /* structure used to draw class hierarchy */ typedef struct { RECT Pos; Class Class; } HierarchyInfo; typedef INT Node; static HierarchyInfo *Nodes = NULL; /* The list of nodes */ static Node LastNode = 0; static Node local findClassInNodes Args((Class)); static Bool local allocNodes Args((INT)); static Void local drawNode Args((HDC, Node)); static Void local drawClassRelations Args((HDC)); static Bool local allocNodes(INT n) { /* Get memory for nodes list */ if (Nodes) free(Nodes); Nodes = calloc((ULONG) (sizeof(HierarchyInfo)), (ULONG) n); LastNode = 0; return (Nodes != NULL); } static Node local findClassInNodes(Class cls) { Node n; for (n = 0; n < LastNode; n++) { if (Nodes[n].Class == cls) { return n; } } return -1; } static Bool local isParentOf(Class parent, Class child) { List supers; for (supers = cclass(child).supers; nonNull(supers); supers = tl(supers)) { if (getHead(hd(supers)) == parent) { return TRUE; } } return FALSE; } /* Add a class and all its children recursive */ /* returns the row for placing next node */ static INT local addClassToGraph(HDC hDC, INT Column, INT startRow, Class ThisClass) { Node newNode = LastNode++; SIZE Size; INT row = startRow; /* Get size of class name on the screen */ fprintf(stdstr, "%s\n", textToStr(cclass(ThisClass).text)); GetTextExtentPoint(hDC, (LPSTR) stdstrbuff, (INT) strlen(stdstrbuff), &Size); Nodes[newNode].Class = ThisClass; Nodes[newNode].Pos.left = Column; Nodes[newNode].Pos.top = startRow; Nodes[newNode].Pos.right = Nodes[newNode].Pos.left + Size.cx; Nodes[newNode].Pos.bottom = Nodes[newNode].Pos.top + Size.cy; /* Add subclasses of ThisClass */ { Class cls; INT col = Nodes[newNode].Pos.right + HORIZONTAL_SEPARATION; INT child = 0; for (cls = CLASSMIN; cls < classMax(); cls++) { if (-1 == findClassInNodes(cls) /* Check for cycles in graph */ &&isParentOf(ThisClass, cls)) { if (child++ > 0) { row += VERTICAL_SEPARATION; } row = addClassToGraph(hDC, col, row, cls); } } } /* Set to average position of children */ { INT height = row - startRow; Nodes[newNode].Pos.top += height / 2; Nodes[newNode].Pos.bottom += height / 2; } return row; } static Void local buildClassGraph(HDC hDC) { INT row = INIT_ROW; Class cls; for (cls = CLASSMIN; cls < classMax(); cls++) { if (cclass(cls).numSupers == 0) { row = addClassToGraph(hDC, INIT_COLUMN, row, cls) + VERTICAL_SEPARATION; } } /* Since Haskell has acyclic class dependencies, we should be done by now; * but it does no harm to make sure. */ for (cls = CLASSMIN; cls < classMax(); cls++) { if (-1 == findClassInNodes(cls)) { /* Not added yet */ row = addClassToGraph(hDC, INIT_COLUMN, row, cls) + VERTICAL_SEPARATION; } } } static Void local drawClassRelations(HDC hDC) { Class cls; for (cls = CLASSMIN; cls < classMax(); cls++) { List supers; for (supers = cclass(cls).supers; nonNull(supers); supers = tl(supers)) { Class parent = getHead(hd(supers)); if (isClass(parent)) { if (parent == cls) { /* child of itself - draw an arc */ Class source = findClassInNodes(cls); Arc(hDC, Nodes[source].Pos.right - 5, Nodes[source].Pos.bottom - 5, Nodes[source].Pos.right + 15, Nodes[source].Pos.bottom + 20, Nodes[source].Pos.right - 5, Nodes[source].Pos.bottom - 5, Nodes[source].Pos.right - 4, Nodes[source].Pos.bottom - 4); } else { /* Join the two classes with a line */ Class source = findClassInNodes(parent); Class target = findClassInNodes(cls); INT sx = Nodes[source].Pos.right + 4; INT sy = Nodes[source].Pos.top + (Nodes[source].Pos.bottom - Nodes[source].Pos.top) / 2; INT tx = Nodes[target].Pos.left - 4; INT ty = Nodes[target].Pos.top + (Nodes[target].Pos.bottom - Nodes[target].Pos.top) / 2; MoveToEx(hDC, sx, sy, NULL); LineTo(hDC, tx, ty); } } } } } static Void local drawNode(HDC hDC, Node n) { /* frame */ Rectangle(hDC, Nodes[n].Pos.left - 4, Nodes[n].Pos.top - 2, Nodes[n].Pos.right + 4, Nodes[n].Pos.bottom + 2); /* frame shadow */ MoveToEx(hDC, Nodes[n].Pos.right + 4, Nodes[n].Pos.top, NULL); LineTo(hDC, Nodes[n].Pos.right + 4, Nodes[n].Pos.bottom + 2); LineTo(hDC, Nodes[n].Pos.left - 2, Nodes[n].Pos.bottom + 2); /* class text */ fprintf(stdstr, "%s\n", textToStr(cclass(Nodes[n].Class).text)); TextOut(hDC, Nodes[n].Pos.left, Nodes[n].Pos.top, (LPSTR) stdstrbuff, (INT) strlen(stdstrbuff)); } typedef struct { HCURSOR hMoveClassCursor; HCURSOR hNormalCursor; Node SelectedClass; BOOL Moved; INT ClassesTopX, ClassesTopY; INT XOffset, YOffset; INT RealWidth, RealHeight; /* size of window */ INT width, height; /* size of total graph */ } ClassBrowserState; static ClassBrowserState cBrowse; /* state of browser */ static VOID local setClassBrowserSize() { Node i; INT width = 0; INT height = 0; for (i = 0; i < LastNode; i++) { width = max(width, Nodes[i].Pos.right); height = max(height, Nodes[i].Pos.bottom); } cBrowse.width = width + 2 * GetSystemMetrics(SM_CXFRAME); cBrowse.height = height + 2 * GetSystemMetrics(SM_CYFRAME) + GetSystemMetrics(SM_CYCAPTION); SetWindowPos(hWndClasses, NULL, 0, 0, cBrowse.width + GetSystemMetrics(SM_CXVSCROLL) + 10, cBrowse.height + GetSystemMetrics(SM_CYHSCROLL) + 10, SWP_NOMOVE | SWP_NOACTIVATE); } static Void local doGetMinMaxInfo_Classes(MINMAXINFO FAR * lpmmi) { lpmmi->ptMinTrackSize.x = 50; lpmmi->ptMinTrackSize.y = 50; lpmmi->ptMaxTrackSize.x = MAX_WIDTH; lpmmi->ptMaxTrackSize.y = MAX_HEIGHT; lpmmi->ptMaxSize.x = MAX_WIDTH; lpmmi->ptMaxSize.y = MAX_HEIGHT; } static Void local doMouseMove_Classes(HWND hWnd, INT x, INT y) { if (cBrowse.SelectedClass < 0) { SetCursor(cBrowse.hNormalCursor); } else { Node n = cBrowse.SelectedClass; INT dx, dy; RECT ClearRect; SetCursor(cBrowse.hMoveClassCursor); /* Don't allow move it out of window */ x = max(5, min(cBrowse.RealWidth - 10, x)); y = max(5, min(cBrowse.RealHeight - 10, y)); dx = x - Nodes[n].Pos.left; dy = y - Nodes[n].Pos.top; ClearRect.left = Nodes[n].Pos.left - 5; ClearRect.right = Nodes[n].Pos.right + 5; ClearRect.top = Nodes[n].Pos.top - 3; ClearRect.bottom = Nodes[n].Pos.bottom + 3; InvalidateRect(hWnd, &ClearRect, FALSE); /* erase old class */ Nodes[n].Pos.left += dx; Nodes[n].Pos.top += dy; Nodes[n].Pos.right += dx; Nodes[n].Pos.bottom += dy; ClearRect.left = Nodes[n].Pos.left - 5; ClearRect.right = Nodes[n].Pos.right + 5; ClearRect.top = Nodes[n].Pos.top - 3; ClearRect.bottom = Nodes[n].Pos.bottom + 3; InvalidateRect(hWnd, &ClearRect, TRUE); /* draw new class */ SendMessage(hWnd, WM_PAINT, 0, 0L); } } #define clamp(_min,_max,x) max(_min,min(_max,x)) static Void local setOffset_Classes(HWND hWnd, INT x, INT y) { Node n; INT dx, dy; x = clamp(-cBrowse.width, 0, x); y = clamp(-cBrowse.height, 0, y); dx = x - cBrowse.XOffset; dy = y - cBrowse.YOffset; for (n = 0; n < LastNode; n++) { Nodes[n].Pos.left += dx; Nodes[n].Pos.right += dx; Nodes[n].Pos.top += dy; Nodes[n].Pos.bottom += dy; } cBrowse.XOffset = x; cBrowse.YOffset = y; SetScrollPos(hWnd, SB_HORZ, -x, TRUE); SetScrollPos(hWnd, SB_VERT, -y, TRUE); ScrollWindow(hWnd, dx, dy, NULL, NULL); InvalidateRect(hWnd, NULL, TRUE); UpdateWindow(hWnd); } #undef clamp static Void local lButtonDown_Classes(HWND hWnd, INT x, INT y) { /* Select a class to drag it */ Node n; for (n = 0; n < LastNode; n++) { if (Nodes[n].Pos.left - 4 < x && Nodes[n].Pos.right + 4 > x && Nodes[n].Pos.top - 2 < y && Nodes[n].Pos.bottom + 2 > y) { SetCursor(cBrowse.hMoveClassCursor); cBrowse.SelectedClass = n; InvalidateRect(hWnd, NULL, TRUE); SetCapture(hWnd); return; } } } static Void local lButtonUp_Classes(HWND hWnd, INT x, INT y) { if (cBrowse.SelectedClass >= 0) { Node n = cBrowse.SelectedClass; INT width = Nodes[n].Pos.right - Nodes[n].Pos.left; INT height = Nodes[n].Pos.bottom - Nodes[n].Pos.top; ReleaseCapture(); if (cBrowse.Moved) { Nodes[n].Pos.left = x; Nodes[n].Pos.top = y; Nodes[n].Pos.right = Nodes[n].Pos.left + width; Nodes[n].Pos.bottom = Nodes[n].Pos.top + height; } cBrowse.SelectedClass = -1; cBrowse.Moved = FALSE; SetCursor(cBrowse.hNormalCursor); InvalidateRect(hWnd, NULL, TRUE); SendMessage(hWnd, WM_PAINT, 0, 0L); setClassBrowserSize(); } } static Void local doPaint_Classes(HWND hWnd) { PAINTSTRUCT ps; HDC hDC; HFONT hSaveFont; COLORREF SaveColor; Node i; hDC = BeginPaint(hWnd, &ps); /* Get font */ hSaveFont = SelectObject(hDC, DefaultFont()); SaveColor = SetTextColor(hDC, RGB(0, 0, 190)); /* Blue Color for text */ if (cBrowse.SelectedClass < 0) { /* not dragging a class */ drawClassRelations(hDC); } for (i = 0; i < LastNode; i++) { drawNode(hDC, i); } SetTextColor(hDC, SaveColor); /* Restore color */ /* Restore font */ SelectObject(hDC, hSaveFont); EndPaint(hWnd, &ps); } static VOID local doCreate_Classes(HWND hWnd) { PAINTSTRUCT ps; HDC hDC; HFONT hSaveFont; INT numClasses = classMax() - CLASSMIN; /* total number of classes */ cBrowse.hNormalCursor = LoadCursor(NULL, IDC_ARROW); cBrowse.hMoveClassCursor = LoadCursor(hThisInstance, "MOVECLASSCURSOR"); cBrowse.SelectedClass = -1; cBrowse.Moved = FALSE; cBrowse.ClassesTopX = 10; cBrowse.ClassesTopY = 10; cBrowse.XOffset = 0; cBrowse.YOffset = 0; if (!allocNodes(numClasses)) { MessageBox(hWnd, "Out of memory: create nodes list", NULL, MB_ICONEXCLAMATION | MB_OK); return; } hDC = BeginPaint(hWnd, &ps); hSaveFont = SelectObject(hDC, DefaultFont()); buildClassGraph(hDC); /* Restore font */ SelectObject(hDC, hSaveFont); EndPaint(hWnd, &ps); /* Show upper-left part of window */ SetScrollPos(hWnd, SB_HORZ, 0, TRUE); SetScrollPos(hWnd, SB_VERT, 0, TRUE); setClassBrowserSize(); } static Void local doDestroy_Classes() { if (Nodes) free(Nodes); Nodes = NULL; LastNode = 0; DestroyCursor(cBrowse.hMoveClassCursor); hWndClasses = NULL; } static Void local doMove_Classes(HWND hWnd, INT x, INT y) { /* WM_MOVE's coords are for the upper-left of the client area; we want the window's upper-left screen coords, so just use GetWindowRect() to get at this. */ RECT r; GetWindowRect(hWndClasses, &r); cBrowse.ClassesTopX = r.left; cBrowse.ClassesTopY = r.top; } static Void local doSize_Classes(HWND hWnd, INT width, INT height) { static BOOL RecursiveCall = FALSE; if (!RecursiveCall) { RecursiveCall = TRUE; cBrowse.RealWidth = width; cBrowse.RealHeight = height; if (cBrowse.RealWidth < cBrowse.width || cBrowse.XOffset) { SetScrollRange(hWnd, SB_HORZ, 0, cBrowse.width, TRUE); } else { /* Hide scroll bar */ SetScrollRange(hWnd, SB_HORZ, 0, 0, TRUE); } if (cBrowse.RealHeight < cBrowse.height || cBrowse.YOffset) { SetScrollRange(hWnd, SB_VERT, 0, cBrowse.height, TRUE); } else { /* Hide scroll bar */ SetScrollRange(hWnd, SB_VERT, 0, 0, TRUE); } RecursiveCall = FALSE; } } /* Hierarchy class window proc */ LRESULT CALLBACK ClassesWndProc(HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam) { switch (msg) { case WM_CREATE: doCreate_Classes(hWnd); break; case WM_DESTROY: doDestroy_Classes(); return (LRESULT) FALSE; case WM_GETMINMAXINFO: doGetMinMaxInfo_Classes((MINMAXINFO FAR *) lParam); break; case WM_SIZE: doSize_Classes(hWnd, (INT) LOWORD(lParam), (INT) HIWORD(lParam)); break; case WM_MOVE: doMove_Classes(hWnd, (INT) LOWORD(lParam), (INT) HIWORD(lParam)); break; case WM_HSCROLL: switch (LOWORD(wParam)) { case SB_PAGEUP: case SB_LINEUP: setOffset_Classes(hWnd, cBrowse.XOffset + 5, cBrowse.YOffset); break; case SB_PAGEDOWN: case SB_LINEDOWN: setOffset_Classes(hWnd, cBrowse.XOffset + 5, cBrowse.YOffset); break; case SB_THUMBPOSITION: setOffset_Classes(hWnd, -HIWORD(wParam), cBrowse.YOffset); break; } break; case WM_VSCROLL: switch (LOWORD(wParam)) { case SB_PAGEUP: case SB_LINEUP: setOffset_Classes(hWnd, cBrowse.XOffset, cBrowse.YOffset + 5); break; case SB_PAGEDOWN: case SB_LINEDOWN: setOffset_Classes(hWnd, cBrowse.XOffset, cBrowse.YOffset - 5); break; case SB_THUMBPOSITION: setOffset_Classes(hWnd, cBrowse.XOffset, -HIWORD(wParam)); break; } break; case WM_PAINT: doPaint_Classes(hWnd); break; case WM_LBUTTONDOWN: lButtonDown_Classes(hWnd, LOWORD(lParam), HIWORD(lParam)); break; case WM_LBUTTONUP: lButtonUp_Classes(hWnd, LOWORD(lParam), HIWORD(lParam)); break; case WM_MOUSEMOVE: doMouseMove_Classes(hWnd, LOWORD(lParam), HIWORD(lParam)); break; default: return DefWindowProc(hWnd, msg, wParam, lParam); } return (LRESULT)TRUE; } /* Create class hierarchy and show it on a window */ void DrawClassesHierarchy() { HWND hActiveWindow; RECT rActive, rWindow; WNDCLASS wc; hActiveWindow = GetActiveWindow(); if (hWndClasses) { /* If window exists keep its position */ GetWindowRect(hWndClasses, &rWindow); DestroyWindow(hWndClasses); } else { GetWindowRect(hActiveWindow, &rActive); rWindow.top = rActive.top + 50; rWindow.left = rActive.left + 50; } wc.style = CS_VREDRAW | CS_HREDRAW; wc.lpfnWndProc = ClassesWndProc; wc.cbClsExtra = 0; wc.cbWndExtra = 0; wc.hInstance = hThisInstance; wc.hIcon = NULL; wc.hCursor = NULL; wc.hbrBackground = GetStockObject(LTGRAY_BRUSH); wc.lpszMenuName = NULL; wc.lpszClassName = "HugsClassesWindow"; RegisterClass(&wc); hWndClasses = CreateWindow("HugsClassesWindow", "Class Hierarchy", WS_CAPTION | WS_BORDER | WS_SYSMENU | WS_THICKFRAME | WS_VSCROLL | WS_HSCROLL, rWindow.left, rWindow.top, 0, 0, (HWND) hActiveWindow, (HMENU) NULL, hThisInstance, (LPSTR) NULL); if (!hWndClasses) { ErrorBox("Error creating window"); return; } setClassBrowserSize(); ShowWindow(hWndClasses, SW_SHOWNORMAL); UpdateWindow(hWndClasses); SetFocus(hWndClasses); return; } // FROM WinHugs.c void DoBrowseClasses() { ExecDialog(hThisInstance, BROWSECLASSESDLGBOX, BrowseClassesDlgProc); } /* Browse Type Constructors ... */ void DoBrowseTycons() { ExecDialog(hThisInstance, BROWSETYCONSDLGBOX, BrowseTyconsDlgProc); } /* Browse Names ... */ void DoBrowseNames() { ExecDialog(hThisInstance, BROWSENAMESDLGBOX, BrowseNamesDlgProc); } /********************************************************* ** SCRIPT MAN *********************************************************/ INT_PTR CALLBACK ScriptManDlgProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam); void ShowScriptMan() { DialogBox(hThisInstance, MAKEINTRESOURCE(SCRIPTMANDLGBOX), hThisWindow, ScriptManDlgProc); } /* -------------------------------------------------------------------------- * Script Manager: * ------------------------------------------------------------------------*/ static INT smLoaded, smUpto; static String smFile[NUM_SCRIPTS]; static INT selScr; static Void local SmSelScr(HWND hDlg, Int i) { selScr = i; SendDlgItemMessage(hDlg, LB_SCRIPTS, LB_SETCURSEL, i, 0L); } static Void local SmAddScr(HWND hDlg, CHAR * s) { smFile[smUpto] = strCopy(s); fprintf(stdstr, "%s\n", smFile[smUpto]); SendDlgItemMessage(hDlg, LB_SCRIPTS, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); SmSelScr(hDlg, smUpto); smUpto++; } INT_PTR CALLBACK ScriptManDlgProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam) { switch (msg) { case WM_INITDIALOG: { Int i; smLoaded = numLoadedScripts(); smUpto = 0; CenterDialogInParent(hDlg); //SetDialogFont (hDlg, hDialogFont); SendDlgItemMessage(hDlg, LB_SCRIPTS, LB_SETHORIZONTALEXTENT, (WPARAM) 1000, 0L); SendDlgItemMessage(hDlg, LB_SCRIPTS, WM_SETREDRAW, FALSE, 0L); for (i = 0; i < getScriptHwMark(); i++) SmAddScr(hDlg, getScriptRealName(i)); SmSelScr(hDlg, 0); SendDlgItemMessage(hDlg, LB_SCRIPTS, LB_SETCURSEL, 0, 0L); SendDlgItemMessage(hDlg, LB_SCRIPTS, WM_SETREDRAW, TRUE, 0L); return TRUE; } case WM_PAINT: { HDC hDC; PAINTSTRUCT Ps; HBITMAP hBitmap; RECT aRect, DlgRect; BeginPaint(hDlg, &Ps); hDC = Ps.hdc; /* Paint classes Bitmap */ GetWindowRect(hDlg, &DlgRect); GetWindowRect(GetDlgItem(hDlg, ID_PLACEBITMAP), &aRect); hBitmap = LoadMappedBitmap(hThisInstance, "SCRIPTMANDLGBMP"); DrawBitmap(hDC, hBitmap, aRect.left - DlgRect.left - GetSystemMetrics(SM_CXDLGFRAME), aRect.top - DlgRect.top - GetSystemMetrics(SM_CYDLGFRAME) - GetSystemMetrics(SM_CYCAPTION)); DeleteObject(hBitmap); EndPaint(hDlg, &Ps); } break; case WM_COMMAND: switch (CMDitem(wParam, lParam)) { case ID_ADDSCRIPT: if (smUpto >= NUM_SCRIPTS) MessageBox(hDlg, "Too many script files", "Add script", MB_ICONEXCLAMATION | MB_OK); else { CHAR Buffer[MAX_PATH]; if (ShowOpenFileDialog(hDlg, Buffer)) SmAddScr(hDlg, Buffer); } return TRUE; case ID_DELSCRIPT: if (selScr < 0) MessageBox(hDlg, "No script file selected", "Remove script", MB_ICONEXCLAMATION | MB_OK); else if (selScr == 0) MessageBox(hDlg, "Cannot remove prelude file", "Remove script", MB_ICONEXCLAMATION | MB_OK); else { Int i; SendDlgItemMessage(hDlg, LB_SCRIPTS, LB_DELETESTRING, selScr, 0L); if (selScr < smLoaded) smLoaded = selScr; if (smFile[selScr]) { free(smFile[selScr]); smFile[selScr] = 0; } for (i = selScr + 1; i < smUpto; ++i) smFile[i - 1] = smFile[i]; smUpto--; SmSelScr(hDlg, -1); } return TRUE; case ID_EDITSCRIPT: if (selScr >= 0) DlgSendMessage(hDlg, WM_COMMAND, LB_SCRIPTS, MAKELONG(0, LBN_DBLCLK)); else MessageBox(hDlg, "No file selected", "Edit", MB_ICONEXCLAMATION | MB_OK); return TRUE; case ID_CLEARSCRIPTS: { Int i; for (i = 1; i < smUpto; ++i) if (smFile[i]) free(smFile[i]); smUpto = smLoaded = 1; SendDlgItemMessage(hDlg, LB_SCRIPTS, LB_RESETCONTENT, 0, 0L); fprintf(stdstr, "%s\n", smFile[0]); SendDlgItemMessage(hDlg, LB_SCRIPTS, LB_ADDSTRING, 0, (LONG) (LPSTR) stdstrbuff); SmSelScr(hDlg, -1); return TRUE; } case LB_SCRIPTS: switch (CMDdata(wParam, lParam)) { case LBN_SELCHANGE: SmSelScr(hDlg, (Int) SendDlgItemMessage(hDlg, LB_SCRIPTS, LB_GETCURSEL, 0, 0L)); return TRUE; case LBN_DBLCLK: { char buffer[_MAX_PATH]; SendDlgItemMessage(hDlg, LB_SCRIPTS, LB_GETTEXT, selScr, (LPARAM) (LPSTR) buffer); setLastEdit((String) buffer, 0); runEditor(); return TRUE; } } break; case IDOK: { Int i; /* Sigh, script stack hackery. */ for (i = 0; i < getScriptHwMark(); i++) if (getScriptName(i)) { free(getScriptName(i)); free(getScriptRealName(i)); } for (i = 0; i < smUpto; i++) { setScriptName(i, smFile[i]); setScriptRealName(i, strCopy(RealPath (smFile [i]))); smFile[i] = 0; } setScriptHwMark(smUpto); setNumLoadedScripts(smLoaded); dropScriptsFrom(smLoaded - 1); PostMessage(hThisWindow, WM_COMMAND, ID_COMPILE, 0L); EndDialog(hDlg, TRUE); return TRUE; } case IDCANCEL: { Int i; for (i = 0; i < smUpto; i++) if (smFile[i]) free(smFile[i]); EndDialog(hDlg, FALSE); return TRUE; } } break; } return FALSE; } hugs98-plus-Sep2006/src/winhugs/Makefile0000644006511100651110000003002510153350401016666 0ustar rossross# Generated automatically from Makefile.in by configure. # -------------------------------------------------------------------------- # Makefile for Hugs # # The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the # Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, # 1994-2004, All rights reserved. It is distributed as # free software under the license in the file "License", which is # included in the distribution. # -------------------------------------------------------------------------- # Targets: # # : make winhugs.exe # install: make and install programs/libraries # winhugs.exe: make minimal working system # runhugs.exe: make batch-mode version of Hugs # clean: delete files not required in running system # distclean: delete files that can be regenerated using C compiler # veryclean: delete all machine generated files # (you need perl, bison/yacc, etc to rebuild these files) # TAGS: build emacs TAGS table CC = cl /nologo VERSTR = -DMONTH_YEAR="\"Nov 2003\"" CFLAGS = -MD -I. $(VERSTR) # When debugging: #CFLAGS = -Zi -MDd -I. $(VERSTR) OPTFLAGS = -O2 RC = rc LD = ld LDFLAGS = DLL_FLAGS = /LD PIC_FLAGS = LIBS = kernel32.lib user32.lib gdi32.lib comdlg32.lib shell32.lib advapi32.lib YACC = bison RM = -del CP = copy EXEEXT = .exe OBJEXT = obj .SUFFIXES : .SUFFIXES : .c .h .$(OBJEXT) WOBJECTS = winhugs.$(OBJEXT) winframe.$(OBJEXT) wintext.$(OBJEXT) \ winhint.$(OBJEXT) winstln.$(OBJEXT) wintoolb.$(OBJEXT) \ winutils.$(OBJEXT) HFILES = HsFFI.h builtin.h char.h command.h config.h connect.h \ errors.h evaluator.h goal.h machdep.h module.h observe.h \ options.h opts.h output.h prelude.h script.h server.h \ storage.h strutil.h subst.h CFILES = hugs.c runhugs.c server.c edit.c observe.c \ builtin.c char.c compiler.c errors.c evaluator.c ffi.c \ goal.c input.c machdep.c machine.c module.c opts.c \ output.c plugin.c script.c static.c storage.c strutil.c \ subst.c type.c version.c \ Winhugs.c INCFILES = array.c bignums.c dirprim.c interns.c iomonad.c \ preds.c printer.c scc.c timeprim.c timer.c YFILES = parser.y SOURCES = $(HFILES) $(CFILES) $(INCFILES) $(YFILES) OBJECTS = builtin.$(OBJEXT) char.$(OBJEXT) compiler.$(OBJEXT) \ errors.$(OBJEXT) evaluator.$(OBJEXT) ffi.$(OBJEXT) \ goal.$(OBJEXT) input.$(OBJEXT) machdep.$(OBJEXT) \ machine.$(OBJEXT) module.$(OBJEXT) opts.$(OBJEXT) \ output.$(OBJEXT) plugin.$(OBJEXT) script.$(OBJEXT) \ static.$(OBJEXT) storage.$(OBJEXT) strutil.$(OBJEXT) \ subst.$(OBJEXT) type.$(OBJEXT) version.$(OBJEXT) \ $(WOBJECTS) IOBJECTS = hugs.$(OBJEXT) edit.$(OBJEXT) observe.$(OBJEXT) $(OBJECTS) ################################################################ # Default target ################################################################ # This rule goes first to make it the default choice default :: all all :: winhugs$(EXEEXT) ################################################################ # Hugs interpreter and standalone evaluator ################################################################ winhugs$(EXEEXT) : $(IOBJECTS) winhugs.res $(CC) $(LDFLAGS) $(IOBJECTS) winhugs.res $(LIBS) -o winhugs$(EXEEXT) -link /subsystem:windows SERVER_OBJECTS = server.$(OBJEXT) $(OBJECTS) runhugs$(EXEEXT) : runhugs.$(OBJEXT) $(SERVER_OBJECTS) $(CC) $(LDFLAGS) runhugs.$(OBJEXT) $(SERVER_OBJECTS) $(LIBS) -o runhugs$(EXEEXT) # # Create all the FFI extension DLLs. # FFIHUGS=..\ffihugs FFIHUGS_OPTS=+G -98 -P .PHONY: ffi-dlls ffi-dlls: $(FFIHUGS) $(FFIHUGS_OPTS) +L../libraries/Hugs/Storable_aux.c Hugs.Storable $(FFIHUGS) $(FFIHUGS_OPTS) Foreign.Marshal.Alloc $(FFIHUGS) $(FFIHUGS_OPTS) Foreign.Marshal.Utils $(FFIHUGS) $(FFIHUGS_OPTS) +L../libraries/Foreign/C/errno.c Foreign.C.Error $(FFIHUGS) $(FFIHUGS_OPTS) +L../libraries/Network/initWinSock.c +L../libraries/Network/winSockErr.c +Lwsock32.lib Network.Socket $(FFIHUGS) $(FFIHUGS_OPTS) +Lwsock32.lib Network.BSD ################################################################ # Clean, distclean, veryclean, TAGS ################################################################ clean :: $(RM) *.o $(RM) *.O $(RM) *.obj $(RM) *.OBJ $(RM) *.LIB $(RM) *.DEF $(RM) *.RES $(RM) *.EXP $(RM) *.ILK $(RM) *.PDB $(RM) *.TD2 $(RM) *.MAP $(RM) *.CSM $(RM) *.TR2 $(RM) *.DSW $(RM) *.aux $(RM) *.hp distclean :: clean distclean :: $(RM) winhugs$(EXEEXT) $(RM) runhugs$(EXEEXT) $(RM) ffihugs$(EXEEXT) $(RM) *.pdf $(RM) TAGS $(RM) *~ veryclean :: distclean veryclean :: $(RM) config.h $(RM) options.h TAGS :: etags *.[ych] ################################################################ # C and Yacc rules ################################################################ .c.$(OBJEXT) : $(CC) -c $(CFLAGS) $(OPTFLAGS) $< # Modules to be compiled without optimization. # (old comment: to avoid optimisation bugs in certain compilers. # This may be overly conservative on some compilers.) # (The following explanation is based on a posting by Alastair Reid.) # These modules allocate cells on the Hugs heap and assume a conservative # garbage collector. On some (especially RISC) architectures, the # optimizer may identify a pointer to a Cell as a common subexpression, # and hold that instead of the Cell. This would then be missed by the # conservative garbage collector's simplistic scan of the C stack. # Modules associated with evaluation are safe because they don't assume # conservative GC (see IMPORTANT NOTICE in builtin.c). compiler.$(OBJEXT) : compiler.c $(CC) -c $(CFLAGS) compiler.c static.$(OBJEXT) : static.c $(CC) -c $(CFLAGS) static.c # parser.c : parser.y # -$(YACC) parser.y # mv y.tab.c parser.c # veryclean :: # $(RM) parser.c #dependencies for these files are incomplete wintext.$(OBJEXT) : $(HFILES) "winhugs\wintext.c" $(CC) -c $(CFLAGS) $(OPTFLAGS) "winhugs\wintext.c" winframe.$(OBJEXT) : $(HFILES) "winhugs\winframe.c" $(CC) -c $(CFLAGS) $(OPTFLAGS) "winhugs\winframe.c" winhint.$(OBJEXT) : $(HFILES) "winhugs\winhint.c" $(CC) -c $(CFLAGS) $(OPTFLAGS) "winhugs\winhint.c" winstln.$(OBJEXT) : $(HFILES) "winhugs\winstln.c" $(CC) -c $(CFLAGS) $(OPTFLAGS) "winhugs\winstln.c" wintoolb.$(OBJEXT) : $(HFILES) "winhugs\wintoolb.c" $(CC) -c $(CFLAGS) $(OPTFLAGS) "winhugs\wintoolb.c" winutils.$(OBJEXT) : $(HFILES) "winhugs\winutils.c" $(CC) -c $(CFLAGS) $(OPTFLAGS) "winhugs\winutils.c" winhugs.$(OBJEXT) : $(HFILES) "winhugs\winhugs.c" $(CC) -c $(CFLAGS) $(OPTFLAGS) "winhugs\winhugs.c" winhugs.res : "winhugs\winhugs.rc" $(RC) -fowinhugs.res "winhugs\winhugs.rc" # WinHugs modules # # The dependencies could be made tighter by not using HFILES throughout, # but individually naming the header files needed by each file. Elect # not to do this due to the overhead of having to keep it up-to-date. winhugs.$(OBJEXT): $(HFILES) \ winhugs/winhugs.c winhugs/menusbm.c winhugs/WinBrows.c winhugs/WinHugs.h \ winhugs/WinFrame.h winhugs/WinToolB.h winhugs/WinSTLN.h winhugs/WinUtils.h winframe.$(OBJEXT): $(HFILES) winhugs/winframe.c \ winhugs/WinFrame.h winhugs/WinSTLN.h winhugs/WinToolB.h winhugs/WinUtils.h winhint.$(OBJEXT): $(HFILES) winhugs/winhint.c \ winhugs/WinHint.h winhugs/WinUtils.h winstln.$(OBJEXT): $(HFILES) winhugs/winstln.c \ winhugs/WinSTLN.h winhugs/WinUtils.h wintoolb.$(OBJEXT): $(HFILES) winhugs/wintoolb.c \ winhugs/WinToolB.h winhugs/WinHint.h winhugs/WinUtils.h winutils.$(OBJEXT): $(HFILES) winhugs/winutils.c winhugs/WinUtils.h ################################################################ # Generated object dependencies (Don't change or delete this line) ################################################################ hugs.$(OBJEXT): hugs.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ command.h connect.h errors.h script.h opts.h strutil.h evaluator.h \ machdep.h output.h module.h timer.c runhugs.$(OBJEXT): runhugs.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h machdep.h observe.h builtin.h evaluator.h errors.h \ server.h HugsAPI.h server.$(OBJEXT): server.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h script.h machdep.h evaluator.h opts.h strutil.h \ errors.h server.h HugsAPI.h edit.$(OBJEXT): edit.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h opts.h strutil.h machdep.h observe.$(OBJEXT): observe.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h command.h errors.h machdep.h builtin.h output.h \ observe.h builtin.$(OBJEXT): builtin.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h machdep.h char.h builtin.h bignums.c \ printer.c iomonad.c timeprim.c dirprim.c interns.c array.c char.$(OBJEXT): char.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h char.h unitable.c compiler.$(OBJEXT): compiler.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h goal.h char.h output.h opts.h errors.$(OBJEXT): errors.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h opts.h goal.h char.h evaluator.h evaluator.$(OBJEXT): evaluator.c prelude.h config.h platform.h options.h \ storage.h HsFFI.h connect.h errors.h script.h output.h strutil.h opts.h \ machdep.h evaluator.h ffi.$(OBJEXT): ffi.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h output.h strutil.h goal.$(OBJEXT): goal.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h machdep.h opts.h goal.h input.$(OBJEXT): input.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h command.h errors.h module.h script.h opts.h goal.h \ machdep.h char.h parser.c machdep.$(OBJEXT): machdep.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h opts.h strutil.h machdep.h char.h \ evaluator.h machine.$(OBJEXT): machine.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h char.h opts.h module.$(OBJEXT): module.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h module.h output.h opts.$(OBJEXT): opts.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h machdep.h strutil.h opts.h char.h output.$(OBJEXT): output.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h char.h plugin.$(OBJEXT): plugin.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h script.$(OBJEXT): script.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h machdep.h opts.h strutil.h script.h static.$(OBJEXT): static.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h machdep.h errors.h output.h subst.h module.h opts.h \ goal.h scc.c storage.$(OBJEXT): storage.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h opts.h errors.h machdep.h evaluator.h strutil.h \ output.h strutil.$(OBJEXT): strutil.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h strutil.h subst.$(OBJEXT): subst.c prelude.h config.h platform.h options.h storage.h \ HsFFI.h connect.h errors.h output.h opts.h subst.h type.$(OBJEXT): type.c prelude.h config.h platform.h options.h storage.h HsFFI.h \ connect.h errors.h output.h subst.h goal.h opts.h preds.c scc.c version.$(OBJEXT): version.c prelude.h config.h platform.h options.h ################################################################ # End of generated object dependencies (Don't change or delete this line) ################################################################ version.$(OBJEXT): echodate.h echodate.h: echodate$(EXEEXT) $(PWD)/echodate$(EXEEXT) > echodate.h echodate$(EXEEXT): msc/echodate.c $(CC) $(LDFLAGS) msc/echodate.c -o $@ ################################################################ # End of Makefile ################################################################ hugs98-plus-Sep2006/src/winhugs/MruFiles.c0000644006511100651110000000313310307567310017132 0ustar rossross#include "prelude.h" #include "Header.h" #include "resrc1.h" #define MruCount 9 // run over by one, so registry code can see the end // always MruBuffer[MruCount] == NULL char* MruBuffer[MruCount+1] = {0}; int MenusShown = 1; // the default one LPSTR MruGetItem(int i) { return MruBuffer[i]; } void ShowMruMenu() { HMENU hMenu = GetSubMenu(GetMenu(hThisWindow), 0); int n, i; //first count the MRU list for (n = 0; MruBuffer[n] != NULL; n++) ; // no code required //add enough entries for (i = MenusShown; i < n; i++) AppendMenu(hMenu, MF_STRING, ID_MRU+i, MruBuffer[i]); MenusShown = (n == 0 ? 1 : n); //then change them for (i = 0; i < n; i++) ModifyMenu(hMenu, ID_MRU+i, MF_BYCOMMAND, ID_MRU+i, MruBuffer[i]); } void MruInit() { RegistryReadMru(MruBuffer); ShowMruMenu(); } // Hook into WinHugs for Hugs void WinHugsAddMruFile(const char* file) { // if its already in the list move it to the top // if its not, add it at the top int i; BOOL Found; // remove from the list if its already there Found = FALSE; for (i = 0; MruBuffer[i] != NULL; i++) { Found = Found || (stricmp(MruBuffer[i], file) == 0); if (Found) MruBuffer[i] = MruBuffer[i+1]; //rely on trailing NULL } // if the last entry would die, kill it now if (MruBuffer[MruCount-1] != NULL) free(MruBuffer[MruCount-1]); // shift everything along by one for (i = MruCount-1; i > 0; i--) MruBuffer[i] = MruBuffer[i-1]; // and put the new file at the top MruBuffer[0] = strdup(file); RegistryWriteMru(MruBuffer); ShowMruMenu(); } hugs98-plus-Sep2006/src/winhugs/Registry.c0000644006511100651110000000514510366410111017210 0ustar rossross #include #include #include "prelude.h" #include "storage.h" #include "connect.h" #include "machdep.h" // Taken from Options.c // allow the font to be specified sensibly int PointToTwip(x); LPSTR readRegStrDup(LPSTR Key, LPSTR Default) { return readRegString(HKEY_CURRENT_USER, hugsRegRoot, Key, Default); } void readRegStr(LPSTR Key, LPSTR Default, LPSTR Buffer) { String res = readRegStrDup(Key, Default); strcpy(Buffer, res); free(res); } void RegistryReadMru(char** Buffer) { int i; char Buf[5] = "Mru1"; for (i = 0; ; i++) { char* Res; Buf[3] = i + '0'; Res = readRegStrDup(Buf, ""); Buffer[i] = Res; if (Res[0] == '\0') { Buffer[i] = NULL; free(Res); break; } } } void RegistryWriteMru(char** Buffer) { int i; char Buf[5] = "Mru1"; for (i = 0; Buffer[i] != NULL; i++) { Buf[3] = i + '0'; writeRegString(Buf, Buffer[i]); } } void RegistryReadFont(CHARFORMAT* cf) { cf->cbSize = sizeof(CHARFORMAT); cf->dwMask = CFM_BOLD | CFM_FACE | CFM_ITALIC | CFM_SIZE; cf->dwEffects = 0; readRegStr("FontName", "Courier New", cf->szFaceName); cf->yHeight = readRegInt("FontSize", PointToTwip(10)); if (readRegInt("FontWeight", 0)) cf->dwEffects |= CFE_BOLD; if (readRegInt("FontItalic", 0)) cf->dwEffects |= CFE_ITALIC; } void RegistryWriteFont(CHARFORMAT* cf) { writeRegString("FontName", cf->szFaceName); writeRegInt("FontSize", cf->yHeight); writeRegInt("FontWeight", (cf->dwEffects & CFE_BOLD ? 1 : 0)); writeRegInt("FontItalic", (cf->dwEffects & CFE_ITALIC ? 1 : 0)); } void RegistryReadWindowPos(HWND hWnd) { int x, y, cx, cy; int Maximized = readRegInt("WindowMaximized", 1); if (Maximized) { ShowWindow(hWnd, SW_MAXIMIZE); return; } x = readRegInt("WindowLeft", -1); y = readRegInt("WindowTop", -1); cx = readRegInt("WindowWidth", -1); cy = readRegInt("WindowHeight", -1); if (x == -1) return; SetWindowPos(hWnd, NULL, x, y, cx, cy, SWP_NOZORDER); } void RegistryWriteWindowPos(HWND hWnd) { RECT rc; int Maximized; // The user has closed while the app is minimized // The current values are wrong, who knows what the correct // ones are, so just be safe and store nothing if (IsIconic(hWnd)) return; Maximized = (IsZoomed(hWnd) ? 1 : 0); writeRegInt("WindowMaximized", Maximized); if (Maximized) return; GetWindowRect(hWnd, &rc); writeRegInt("WindowLeft", rc.left); writeRegInt("WindowTop", rc.top); writeRegInt("WindowWidth", rc.right - rc.left); writeRegInt("WindowHeight", rc.bottom - rc.top); } hugs98-plus-Sep2006/src/winhugs/Registry.h0000644006511100651110000000000110305571173017210 0ustar rossross hugs98-plus-Sep2006/src/winhugs/RtfWindow.c0000644006511100651110000003231410470630722017331 0ustar rossross#include "Header.h" #include #include "Winhugs.h" // have a max of 100Kb in the scroll window // old hugs was about 64Kb #define MAXIMUM_BUFFER 100000 // Buffer the RTF Window Handle // Only allow one RTF Window at a time HWND hRTF; BOOL PuttingChar = FALSE; DWORD Length = 0; DWORD OutputStart; typedef struct _Format { int ForeColor; int BackColor; BOOL Bold; BOOL Italic; BOOL Underline; } Format; BOOL FormatChanged = FALSE; Format DefFormat = {BLACK, WHITE, FALSE, FALSE, FALSE}; Format BufFormat; Format NowFormat; HANDLE hMutex; void RtfWindowInit(HWND hNewRTF) { CHARFORMAT cf; hRTF = hNewRTF; //make it all protected SendMessage(hRTF, EM_SETEVENTMASK, 0, ENM_PROTECTED | ENM_LINK | ENM_KEYEVENTS | ENM_SELCHANGE); cf.cbSize = sizeof(cf); cf.dwEffects = CFE_PROTECTED; cf.dwMask = CFM_PROTECTED; SendMessage(hRTF, EM_SETCHARFORMAT, SCF_ALL, (LPARAM) &cf); // Allow them 1 million characters // the system will sort out overflows later SendMessage(hRTF, EM_LIMITTEXT, 1000000, 0); // Default formatting information BufFormat = DefFormat; NowFormat = DefFormat; // And syncronisation stuff hMutex = CreateMutex(NULL, FALSE, NULL); //update the font RtfWindowUpdateFont(); } void RtfWindowUpdateFont() { CHARFORMAT cf; RegistryReadFont(&cf); SendMessage(hRTF, EM_SETCHARFORMAT, SCF_ALL, (LPARAM) &cf); } int RtfWindowTextLength() { GETTEXTLENGTHEX gtl; gtl.codepage = CP_ACP; gtl.flags = GTL_DEFAULT; return SendMessage(hRTF, EM_GETTEXTLENGTHEX, (WPARAM) >l, 0); } // return a bit mask of DROPEFFECT_NONE, DROPEFFECT_COPY, DROPEFFECT_MOVE int RtfWindowCanCutCopy() { DWORD Start, End; SendMessage(hRTF, EM_GETSEL, (WPARAM) &Start, (WPARAM) &End); if (Start == End) return DROPEFFECT_NONE; else if (Start >= Length) return DROPEFFECT_COPY | DROPEFFECT_MOVE; else return DROPEFFECT_COPY; } void RtfWindowClear() { CHARRANGE cr; int Lines = SendMessage(hRTF, EM_GETLINECOUNT, 0, 0); int ThisLine = SendMessage(hRTF, EM_LINEINDEX, Lines-1, 0); SendMessage(hRTF, EM_EXGETSEL, 0, (LPARAM) &cr); SendMessage(hRTF, EM_SETSEL, 0, ThisLine); PuttingChar = TRUE; SendMessage(hRTF, EM_REPLACESEL, FALSE, (LPARAM) ""); PuttingChar = FALSE; cr.cpMax -= ThisLine; cr.cpMin -= ThisLine; Length -= ThisLine; if (cr.cpMin < 0) SendMessage(hRTF, EM_SETSEL, Length, Length); else SendMessage(hRTF, EM_EXSETSEL, 0, (LPARAM) &cr); } void RtfWindowDelete() { SendMessage(hRTF, EM_REPLACESEL, FALSE, (LPARAM) ""); } void RtfWindowHistory(int Delta) { LPCSTR x = GetHistory(Delta); if (x == NULL) MessageBeep((UINT) -1); else RtfWindowSetCommand(x); } void RtfWindowSelectAll() { SendMessage(hRTF, EM_SETSEL, 0, -1); } BOOL RtfNotify(HWND hDlg, NMHDR* nmhdr) { if (nmhdr->code == EN_PROTECTED && !PuttingChar) { //block ENPROTECTED* enp = (ENPROTECTED*) nmhdr; CHARRANGE cr; int TextLen = RtfWindowTextLength(); BOOL Reset = FALSE, Disallow = FALSE; // just let it go ahead anyway if (enp->msg == WM_COPY) return FALSE; // they hit backspace if (enp->wParam == VK_BACK) { if ((DWORD) enp->chrg.cpMin < Length || ((DWORD) enp->chrg.cpMin == Length && enp->chrg.cpMin == enp->chrg.cpMax)) { Reset = TRUE; Disallow = TRUE; } } else if ((DWORD) enp->chrg.cpMin < Length) { Reset = TRUE; Disallow = (enp->wParam == VK_DELETE); } if (Reset) { cr.cpMin = TextLen; cr.cpMax = cr.cpMin; SendMessage(hRTF, EM_EXSETSEL, 0, (LPARAM) &cr); } // we don't want to paste rich text, as that makes it look weird // so send only plain text paste commands if ((enp->msg == WM_PASTE) && !Disallow) { LPTSTR Buffer = NULL; Disallow = TRUE; if (IsClipboardFormatAvailable(CF_TEXT) && OpenClipboard(hThisWindow)) { HGLOBAL hGlb; LPTSTR str; if ((hGlb = GetClipboardData(CF_TEXT)) != NULL && (str = GlobalLock(hGlb)) != NULL) { Buffer = strdup(str); GlobalUnlock(hGlb); } CloseClipboard(); } if (Buffer != NULL) { // strip trailing new line characters int i; for (i = strlen(Buffer)-1; i >= 0 && (Buffer[i] == '\r' || Buffer[i] == '\n'); i--) Buffer[i] = 0; SendMessage(hRTF, EM_REPLACESEL, FALSE, (LPARAM)Buffer); free(Buffer); } } SetWindowLong(hDlg, DWL_MSGRESULT, (Disallow ? 1 : 0)); return TRUE; } else if (nmhdr->code == EN_LINK) { // should really fire on up // but that screws up the cursor position ENLINK* enl = (ENLINK*) nmhdr; if (enl->msg == WM_LBUTTONDOWN) { TEXTRANGE tr; char Buffer[1000]; tr.lpstrText = Buffer; tr.chrg.cpMin = enl->chrg.cpMin; tr.chrg.cpMax = enl->chrg.cpMax; SendMessage(hRTF, EM_GETTEXTRANGE, 0, (LPARAM) &tr); ExecuteFile(Buffer); SetWindowLong(hDlg, DWL_MSGRESULT, 1); return TRUE; } } else if (nmhdr->code == EN_MSGFILTER) { MSGFILTER* mf = (MSGFILTER*) nmhdr; if (mf->msg == WM_CHAR && Running) { WinHugsReceiveC(mf->wParam == '\r' ? '\n' : mf->wParam); SetWindowLong(hDlg, DWL_MSGRESULT, 1); return TRUE; } else if (Running && mf->msg == WM_KEYDOWN) { SetWindowLong(hDlg, DWL_MSGRESULT, 1); return TRUE; } else if (mf->msg == WM_KEYDOWN && !Running) { BOOL History = (mf->wParam == VK_UP || mf->wParam == VK_DOWN); if (History && (mf->lParam & (1 << 24))) { CHARRANGE cr; SendMessage(hRTF, EM_EXGETSEL, 0, (LPARAM) &cr); if ((DWORD) cr.cpMin >= Length) { RtfWindowHistory(mf->wParam == VK_UP ? -1 : +1); SetWindowLong(hDlg, DWL_MSGRESULT, 1); return TRUE; } } else if (mf->wParam == VK_RETURN) { char Buffer[1000]; RtfWindowGetCommand(Buffer); FireCommandDelay(Buffer); SetWindowLong(hDlg, DWL_MSGRESULT, 1); return TRUE; } else if (mf->wParam == VK_HOME) { CHARRANGE cr; SendMessage(hRTF, EM_EXGETSEL, 0, (LPARAM) &cr); if ((DWORD) cr.cpMin > Length) { SHORT n = GetKeyState(VK_SHIFT); BOOL Shift = (n & (1 << 16)); SetWindowLong(hDlg, DWL_MSGRESULT, 1); cr.cpMin = Length; cr.cpMax = (Shift ? cr.cpMax : Length); SendMessage(hRTF, EM_EXSETSEL, 0, (LPARAM) &cr); SetWindowLong(hDlg, DWL_MSGRESULT, 1); return TRUE; } } } } else if (nmhdr->code == EN_SELCHANGE) { EnableButtons(); } return FALSE; } // Respond to a clipboard message // WM_PASTE, WM_COPY, WM_CUT void RtfWindowClipboard(UINT Msg) { SendMessage(hRTF, Msg, 0, 0); } // NULL means freeze in the existing command void RtfWindowSetCommand(LPCSTR Command) { SendMessage(hRTF, EM_SETSEL, Length, RtfWindowTextLength()); PuttingChar = TRUE; SendMessage(hRTF, EM_REPLACESEL, FALSE, (LPARAM) Command); PuttingChar = FALSE; } void RtfWindowGetCommand(LPSTR Command) { TEXTRANGE tr; tr.lpstrText = Command; tr.chrg.cpMin = Length; tr.chrg.cpMax = RtfWindowTextLength(); if (tr.chrg.cpMin == tr.chrg.cpMax) Command[0] = 0; else SendMessage(hRTF, EM_GETTEXTRANGE, 0, (LPARAM) &tr); } ///////////////////////////////////////////////////////////////////// // BUFFERING AND OUTPUT ///////////////////////////////////////////////////////////////////// const int BufSize = 995; char Buf[1000]; int BufPos = 0; // where to write out in the buffer int BufLen = 0; // how much of the buffer is useful int OutputPos = 0; // how much to delete of the existing thing BOOL IsTimer = FALSE; // buffer to hold an escape character BOOL InEscBuf = FALSE; const int EscBufSize = 100; char EscBuf[100]; int EscBufPos = 0; void EnsureTimer() { if (!IsTimer) { IsTimer = TRUE; SetTimer(GetParent(hRTF), 666, 100, NULL); } } void DestTimer() { KillTimer(GetParent(hRTF), 666); IsTimer = FALSE; } void FixCharFormat(CHARFORMAT2* cf) { if (cf->crTextColor == BLACK) cf->dwEffects |= CFE_AUTOCOLOR; if (cf->crBackColor == WHITE) cf->dwEffects |= CFE_AUTOBACKCOLOR; } void WriteBuffer(LPCTSTR s, int Len) { CHARRANGE cr; CHARFORMAT2 cf; Length = RtfWindowTextLength(); cr.cpMin = max(OutputStart, Length + OutputPos); cr.cpMax = cr.cpMin + BufLen; SendMessage(hRTF, EM_EXSETSEL, 0, (LPARAM) &cr); cf.cbSize = sizeof(cf); cf.dwMask = CFM_COLOR | CFM_BACKCOLOR | CFM_BOLD | CFM_ITALIC | CFM_UNDERLINE; cf.dwEffects = 0; cf.crTextColor = BufFormat.ForeColor; cf.crBackColor = BufFormat.BackColor; cf.dwEffects = (BufFormat.Bold ? CFE_BOLD : 0) | (BufFormat.Italic ? CFE_ITALIC : 0) | (BufFormat.Underline ? CFE_UNDERLINE : 0); FixCharFormat(&cf); SendMessage(hRTF, EM_SETCHARFORMAT, SCF_SELECTION, (LPARAM) &cf); // setcharformat seems to screw up the current selection! SendMessage(hRTF, EM_EXSETSEL, 0, (LPARAM) &cr); PuttingChar = TRUE; SendMessage(hRTF, EM_REPLACESEL, FALSE, (LPARAM) s); PuttingChar = FALSE; Length = RtfWindowTextLength(); if (Length > MAXIMUM_BUFFER) { LPCSTR Blank = ""; CHARRANGE cr; SendMessage(hRTF, EM_HIDESELECTION, TRUE, 0); cr.cpMin = 0; cr.cpMax = (Length - MAXIMUM_BUFFER) + (MAXIMUM_BUFFER / 4); SendMessage(hRTF, EM_EXSETSEL, 0, (LPARAM) &cr); PuttingChar = TRUE; SendMessage(hRTF, EM_REPLACESEL, FALSE, (LPARAM) Blank); PuttingChar = FALSE; cr.cpMin = -1; cr.cpMax = -1; SendMessage(hRTF, EM_EXSETSEL, 0, (LPARAM) &cr); SendMessage(hRTF, EM_HIDESELECTION, FALSE, 0); Length = RtfWindowTextLength(); } } void FlushBuffer(BOOL Force) { DWORD Res = WaitForSingleObject(hMutex, (Force ? INFINITE : 0)); if (Res != WAIT_OBJECT_0) return; //you did not win if (BufLen != 0) { Buf[BufLen] = 0; Buf[BufLen+1] = 0; WriteBuffer(Buf, BufLen); OutputPos = BufPos - BufLen; BufPos = 0; BufLen = 0; } ReleaseMutex(hMutex); } void RtfWindowFlushBuffer() { FlushBuffer(TRUE); } BOOL ParseEscapeCode(Format* f) { int AnsiColor[8] = {BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE}; char* s; int i; EscBuf[EscBufPos] = 0; if (EscBuf[0] != '[') return FALSE; s = &EscBuf[1]; for (i = 1; i <= EscBufPos; i++) { if (EscBuf[i] == ';') EscBuf[i] = 0; if (EscBuf[i] == 0) { int Val = atoi(s); s = &EscBuf[i+1]; if (Val == 0) *f = DefFormat; else if (Val == 1) f->Bold = TRUE; else if (Val == 4) f->Underline = TRUE; else if (Val >= 30 && Val <= 37) f->ForeColor = AnsiColor[Val - 30]; else if (Val >= 40 && Val <= 47) f->BackColor = AnsiColor[Val - 40]; } } return TRUE; } // need to copy from s to Buf void AddToBuffer(LPCTSTR s) { if (FormatChanged) { if (NowFormat.BackColor != BufFormat.BackColor || NowFormat.ForeColor != BufFormat.ForeColor || NowFormat.Bold != BufFormat.Bold || NowFormat.Underline != BufFormat.Underline || NowFormat.Italic != BufFormat.Italic ) { FlushBuffer(TRUE); BufFormat = NowFormat; } FormatChanged = FALSE; } if (InEscBuf) { for (; *s != 0; s++) { if (*s == 'm') { Format f = NowFormat; if (ParseEscapeCode(&f)) { FormatChanged = TRUE; NowFormat = f; } InEscBuf = FALSE; AddToBuffer(s+1); return; } else if ((*s >= '0' && *s <= '9') || (*s == ';') || (*s == '[')) { EscBuf[EscBufPos++] = *s; EscBufPos = min(EscBufPos, EscBufSize); } else { InEscBuf = FALSE; AddToBuffer(EscBuf); break; } } } for (; *s != 0; s++) { if (*s == '\b') { if (BufPos == 0) { OutputPos--; } else BufPos--; } else if (*s == 27) { InEscBuf = TRUE; EscBufPos = 0; AddToBuffer(s+1); return; } else { if (BufLen >= BufSize) FlushBuffer(TRUE); Buf[BufPos++] = *s; BufLen = max(BufLen, BufPos); } } EnsureTimer(); } void RtfWindowTimer() { // if you are doing useful work, why die? if (BufLen == 0) DestTimer(); FlushBuffer(FALSE); } void RtfWindowPutS(LPCTSTR s) { AddToBuffer(s); } void RtfEchoCommand(LPCTSTR s) { RtfWindowPutS(s); RtfWindowPutS("\n"); } void RtfWindowStartOutput() { RtfWindowPutS("\n"); RtfWindowFlushBuffer(); BufFormat = DefFormat; NowFormat = DefFormat; OutputStart = RtfWindowTextLength(); } void RtfWindowStartInput() { CHARRANGE cr; CHARFORMAT cf; cf.cbSize = sizeof(cf); cf.dwMask = CFM_COLOR; cf.dwEffects = 0; cf.crTextColor = BLACK; cr.cpMin = Length; cr.cpMax = -1; SendMessage(hRTF, EM_EXSETSEL, 0, (LPARAM) &cr); SendMessage(hRTF, EM_SETCHARFORMAT, SCF_SELECTION, (LPARAM) &cf); cr.cpMax = cr.cpMin; SendMessage(hRTF, EM_EXSETSEL, 0, (LPARAM) &cr); } int WinHugsColor(int Color) { int PrevColor = NowFormat.ForeColor; FormatChanged = TRUE; NowFormat = DefFormat; NowFormat.ForeColor = Color; InEscBuf = FALSE; return PrevColor; } ///////////////////////////////////////////////////////////////////// // IO REDIRECTORS ///////////////////////////////////////////////////////////////////// void WinHugsHyperlink(const char* msg) { CHARFORMAT2 cf2; FlushBuffer(TRUE); cf2.cbSize = sizeof(cf2); cf2.dwMask = CFM_LINK; cf2.dwEffects = CFE_LINK; SendMessage(hRTF, EM_SETCHARFORMAT, SCF_SELECTION, (LPARAM) &cf2); SendMessage(hRTF, EM_REPLACESEL, FALSE, (LPARAM) msg); Length += strlen(msg); cf2.dwEffects = 0; SendMessage(hRTF, EM_SETCHARFORMAT, SCF_SELECTION, (LPARAM) &cf2); } hugs98-plus-Sep2006/src/winhugs/RtfWindow.h0000644006511100651110000000066110335672526017346 0ustar rossross void RtfWindowInit(HWND hNewRTF); void RtfWindowUpdateFont(); void RtfWindowTextColor(int Color); void RtfWindowPutChar(char c); void RtfWindowPutChars(char* s); BOOL RtfNotify(HWND hDlg, NMHDR* nmhdr); int RtfWindowCanCutCopy(); void RtfWindowClipboard(UINT Msg); void RtfWindowClear(); void RtfWindowDelete(); void RtfWindowHistory(int Delta); void RtfWindowSelectAll(); void RtfWindowStartOutput(); void RtfWindowStartInput(); hugs98-plus-Sep2006/src/winhugs/StartCode.c0000644006511100651110000001635210366405362017306 0ustar rossross#include "Header.h" #include #include #include "Winhugs.h" #include "prelude.h" #include "storage.h" #include "evaluator.h" #include "connect.h" #include "errors.h" #include "machdep.h" #include "opts.h" #include "strutil.h" // store the extern HINSTANCE HINSTANCE hThisInstance; // Command line arguments CHAR **hugs_argv; INT hugs_argc; /* Construct hugs_argc and hugs_argv from lpszCmdLine */ void copyArgs(LPSTR lpszCmdLine) { INT i, currentArg, beginOfArg; CHAR svChar; /* First, get number of args */ /* Rules: */ /* 1) arguments are separates by spaces */ /* 2) A single argument may contain spaces if surrounded by quotes */ /* */ /* For example, a valid command line with two args is */ /* c:> winhugs -98 "c:\program files\test.hs" */ hugs_argc = 0; for(i=0;lpszCmdLine[i];) { if(lpszCmdLine[i]=='"') { /* a "... " argument */ i++; hugs_argc++; while (lpszCmdLine[i] && lpszCmdLine[i] != '"') i++; if (lpszCmdLine[i] != '"') { MessageBox(GetFocus(), "Invalid command line", "", MB_OK); hugs_argc = 0; } } else if(lpszCmdLine[i]!=' ') { i++; hugs_argc++; while (lpszCmdLine[i] && lpszCmdLine[i] != ' ') i++; } if(lpszCmdLine[i]) i++; } hugs_argc++; /* One more for program name */ /* Allocate arguments */ hugs_argv = malloc(hugs_argc*sizeof(CHAR *)); /* First argument must be program name */ hugs_argv[0] = strdup("winhugs.exe"); #define copyCurrentArg { \ svChar = lpszCmdLine[i]; \ lpszCmdLine[i] = '\0'; \ hugs_argv[currentArg++] = strdup(&lpszCmdLine[beginOfArg]);\ lpszCmdLine[i] = svChar; \ } if (hugs_argc > 1) { currentArg = 1; for(i=0;lpszCmdLine[i];) { if(lpszCmdLine[i]=='"') { /* a "... " argument */ beginOfArg = ++i; while (lpszCmdLine[i] != '"') i++; copyCurrentArg; } else if(lpszCmdLine[i]!=' ') { beginOfArg = i; while (lpszCmdLine[i] && lpszCmdLine[i] != ' ') i++; copyCurrentArg; } if(lpszCmdLine[i]) i++; } } #undef copyCurrentArg } int main(int argc,char *argv[]); void RunEditor(LPSTR File) { if (File[0] == 0) { MessageBox(NULL, "Error: /edit option used with no file", "WinHugs", MB_ICONERROR); return; } // do some of the evaluation stuff from initialise() // break before any scripts get loaded startEvaluator(); hugsEdit = strCopy(fromEnv("EDITOR",NULL)); if (hugsEdit == NULL) hugsEdit = WinHugsPickDefaultEditor(); readOptions("-p\"%s> \" -r$$",FALSE); readOptionSettings(); startEdit(0, File); } INT APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpszCmdLine, INT nCmdShow) { int i; if (strnicmp(lpszCmdLine, "/edit", 5) == 0) { lpszCmdLine += 5; while (lpszCmdLine[0] == ' ') lpszCmdLine++; if (lpszCmdLine[0] == '\"') { char* s = strchr(++lpszCmdLine, '\"'); if (s != NULL) s[0] = 0; } RunEditor(lpszCmdLine); return 0; } InitCommonControls(); LoadLibrary("RICHED20.DLL"); // Save application instance hThisInstance = hInstance; hAccelTable = LoadAccelerators(hThisInstance, "HUGSACCELERATORS"); if (!ShowMainDialog()) return 1; // Call hugs main function copyArgs(lpszCmdLine); main(hugs_argc, hugs_argv); // Leaving hugs ... // hWndMain is already destroyed // Free allocated memory for command line for (i=0; iloading files before eval*/ Bool autoLoadFiles = TRUE; /* TRUE => automatically reloaded modified files */ void ErrorBox(LPCSTR Msg) { MessageBox(hThisWindow, Msg, appName, MB_ICONHAND | MB_OK); } void InfoBox(LPCSTR Msg) { MessageBox(hThisWindow, Msg, appName, MB_ICONINFORMATION | MB_OK); } void WinHugsExit() { DestroyWindow(hThisWindow); } #if 1 //USE_THREADS void stopEvaluatorThread(); DWORD evaluatorThreadBody(LPDWORD); HANDLE evaluatorThread=NULL; DWORD evaluatorThreadId; BOOL evaluatorThreadRunning = FALSE; jmp_buf goToEvaluator; void WinHugsMessagePump() { MSG msg; ExecutionFinished(); while (GetMessage(&msg, NULL, 0, 0) > 0) { if (!TranslateAccelerator(hThisWindow, hAccelTable, &msg)) { TranslateMessage(&msg); DispatchMessage(&msg); } } } void loopInBackground() { MSG msg; /* WaitForSingleObject(evaluatorThread, INFINITE); */ while ( evaluatorThreadRunning && GetMessage(&msg, NULL, 0, 0) ) { if (!TranslateAccelerator(hThisWindow, hAccelTable, &msg)) { TranslateMessage(&msg); DispatchMessage(&msg); } } if (evaluatorThreadRunning) PostMessage(msg.hwnd, msg.message, msg.wParam, msg.lParam); } void stopEvaluatorThread() { if(evaluatorThreadRunning){ if(GetCurrentThreadId() != evaluatorThreadId) { MessageBox(NULL, "stopEvaluatorThread executed by main thread !!!","Error", MB_OK); } evaluatorThreadRunning = FALSE; SuspendThread(evaluatorThread); /* stop here until resumed */ longjmp(goToEvaluator,1); } } DWORD evaluatorThreadBody(LPDWORD notUsed) { int evaluatorNumber = setjmp(goToEvaluator); #if defined(_MSC_VER) && !defined(_MANAGED) /* Under Win32 (when compiled with MSVC), we specially * catch and handle SEH stack overflows. */ __try { #endif evaluator(findEvalModule()); stopEvaluatorThread(); #if defined(_MSC_VER) && !defined(_MANAGED) } __except ( ((GetExceptionCode() == EXCEPTION_STACK_OVERFLOW) ? EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) ) { /* Closely based on sample code in Nov 1999 Dr GUI MSDN column */ char* stackPtr; static SYSTEM_INFO si; static MEMORY_BASIC_INFORMATION mi; static DWORD protect; /* get at the current stack pointer */ _asm mov stackPtr, esp; /* query for page size + VM info for the allocation chunk we're currently in. */ GetSystemInfo(&si); VirtualQuery(stackPtr, &mi, sizeof(mi)); /* Abandon the C stack and, most importantly, re-insert the page guard bit. Do this on the page above the current one, not the one where the exception was raised. */ stackPtr = (LPBYTE) (mi.BaseAddress) - si.dwPageSize; if ( VirtualFree(mi.AllocationBase, (LPBYTE)stackPtr - (LPBYTE) mi.AllocationBase, MEM_DECOMMIT) && VirtualProtect(stackPtr, si.dwPageSize, PAGE_GUARD | PAGE_READWRITE, &protect) ) { /* careful not to do a garbage collection here (as it may have caused the overflow). */ WinHugsPutS(stderr, "ERROR - C stack overflow"); errFail(); } else { fatal("C stack overflow; unable to recover."); } } #endif /* not reached*/ return 0; } void startEvaluatorThread() { if (!evaluatorThread) { /* Note: I'm assuming that the reason why _beginthreadex() isn't * used is that there's no need to..? */ evaluatorThread = CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)evaluatorThreadBody, NULL, CREATE_SUSPENDED, &evaluatorThreadId); } evaluatorThreadRunning = TRUE; ResumeThread(evaluatorThread); } #endif /* USE_THREADS */ hugs98-plus-Sep2006/src/winhugs/Winhugs.h0000644006511100651110000000421210372114304017025 0ustar rossross/* external interface of winhugs files */ #ifndef __WINHUGS_H__ #define __WINHUGS_H__ #include // standard definitions for communicating with WinHugs deliberately // pop up the message in an error box extern void ErrorBox(const char* Msg); extern void InfoBox(const char* Msg); extern char* WinHugsPickDefaultEditor(); extern void WinHugsExit(void); extern int InAutoReloadFiles; extern void SetWorkingDir(const char* Src); extern void startEvaluatorThread(void); extern void stopEvaluatorThread(void); extern void loopInBackground(void); // support for Most Recently Used Files extern void WinHugsAddMruFile(const char* file); extern void WinHugsMessagePump(void); // Used for trapping console output and GUI'ifying it // fprintf (stdstr, ...) is used to direct output to the string stdstrbuff extern FILE *stdstr; extern char stdstrbuff[]; // Colours // do not use Windows RGB so you don't introduce a dependancy on Windows.h #define rgb(r,g,b) ((r) | ((g) << 8) | ((b) << 16)) #define BLACK rgb(0,0,0) #define BLUE rgb(0,0,175) #define GREEN rgb(0,135,0) #define CYAN rgb(0,175,175) #define RED rgb(175,0,0) #define MAGENTA rgb(150,0,150) #define YELLOW rgb(175,175,0) #define WHITE rgb(255,255,255) extern int WinHugsColor(int Color); // Redirection of console I/O extern void WinHugsPutS(FILE* f, char* Buffer); extern int WinHugsPrintf(const char* format, ...); extern int WinHugsFPrintf(FILE* f, const char* format, ...); extern int WinHugsPutC(FILE* f, int c); extern int WinHugsGetC(FILE* f); extern void WinHugsHyperlink(const char* msg); extern void WinHugsFilename(const char* FileName, int LineNo); // undefine everything that is a macro already #undef getc #undef getchar #undef putchar #undef putc // output with formatting buffers #define printf WinHugsPrintf #define fprintf WinHugsFPrintf // standard output #define putchar(ch) WinHugsPutC(stdout, ch) #define putc(ch,file) WinHugsPutC(file, ch) #define fputc(ch,file) WinHugsPutC(file, ch) // standard input #define getc(file) WinHugsGetC(file) #define getchar() WinHugsGetC(stdin) #define getch() WinHugsGetC(stdin) #endif /* __WINHUGS_H__ */ hugs98-plus-Sep2006/src/winhugs/Winmenu.h0000644006511100651110000000700007762407152017040 0ustar rossross/* -------------------------------------------------------------------------- * WinMenu.h: José Enrique Gallardo Ruiz, Feb 1999 * * The Hugs 98 system is Copyright (c) José Enrique Gallardo, Mark P Jones, * Alastair Reid, the Yale Haskell Group, and the OGI School of * Science & Engineering at OHSU, 1994-2003, All rights reserved. It is * distributed as free software under the license in the file "License", * which is included in the distribution. * * Defines for menus and dialog boxes * ------------------------------------------------------------------------*/ #ifndef __WINMENU_H__ #define __WINMENU_H__ #define ID_FILESMENU 1 #define ID_EDITMENU 2 #define ID_INTERPRETERMENU 3 #define ID_OPTIONSMENU 10 #define ID_BROWSEMENU 4 #define ID_HELPMENU 5 #define ID_NEW 101 #define ID_OPEN 102 #define ID_SCRIPTMAN 103 #define ID_SAVE 104 #define ID_CLOSE 105 #define ID_PRINT 106 #define ID_OPENSELECTED 107 #define ID_EXIT 108 #define ID_COPY 201 #define ID_PASTE 202 #define ID_GOEDIT 203 #define ID_CUT 204 #define ID_CLEAR 205 #define ID_FIND 206 #define ID_GOPREVIOUS 207 #define ID_GONEXT 208 #define ID_EDITSELECTED 209 #define ID_FONT 199 #define ID_RUN 301 #define ID_STOP 302 #define ID_EVAL 303 #define ID_TYPE 304 #define ID_COMPILE 305 #define ID_MAKE 306 #define ID_CLEARALL 307 #define ID_INFO 308 #define ID_SETOPTIONS 401 #define ID_BROWSECLASSES 501 #define ID_BROWSENAMES 502 #define ID_BROWSETYCONS 503 #define ID_BROWSEHIERARCHY 504 #define ID_HELPINDEX 601 #define ID_HELPFIND 602 #define ID_HELPUSE 603 #define ID_ABOUT 604 #define ID_HELPCOMMANDS 605 #define ID_HELPREPORT 606 #define ID_HELPLIBS 607 #define ID_HELPGENTLE 608 #define ID_HELPDOCS 609 #define ID_HELPEXTS 610 #define ID_HELPHASKELLORG 611 /* Dialog boxes */ #define ABOUTDLGBOX 1 #define OPTIONSDLGBOX 2 #define BROWSECLASSESDLGBOX 3 #define BROWSENAMESDLGBOX 4 #define BROWSETYCONSDLGBOX 5 #define SCRIPTMANDLGBOX 6 #define IDS_FILTERPROJECT 2000 #define IDS_FILTERFILE 2001 /* Options Dialog */ #define ID_OP 150 #define ID_PROMPT 122 #define ID_LASTEXPR 123 #define ID_EDITOR 124 #define ID_PATH 125 #define ID_ROWS 126 #define ID_COLS 127 #define ID_HEAPSIZE 128 #define ID_CUTOFF 129 /* Browse Classes dialog */ #define LB_CLASS 1001 #define LB_INSTANCES 1002 #define LB_MEMBERS 1003 #define LB_CONTEXT 1004 #define ID_HIERARCHY 5001 #define ID_EDITCLASS 5002 #define ID_EDITINSTANCE 5003 /* Browse Names dialog */ #define LB_NAMES 1001 #define LB_NAMESTYPE 1002 #define LB_NAMESNOTES 1003 #define IDC_SEARCHNAME 1004 #define ID_EDITNAME 5001 /* Browse Tycons dialog */ #define LB_TYCONS 1001 #define LB_CONS 1002 #define LB_DEF 1003 #define LB_TYCONSINST 1004 #define IDC_SEARCHTYCON 1005 #define ID_EDITTYCON 5001 #define ID_EDITTYCONSINST 5002 /* About Dialog */ #define ID_FREERESOURCES 1001 #define ID_TOTALMEMORY 1002 /* Script Manager dialog */ #define LB_SCRIPTS 1001 #define ID_ADDSCRIPT 5001 #define ID_DELSCRIPT 5002 #define ID_CLEARSCRIPTS 5003 #define ID_EDITSCRIPT 5004 #define ID_PLACEBITMAP 20000 #endif /* __WINMENU_H__ */ hugs98-plus-Sep2006/src/winhugs/config.h0000644006511100651110000002641410173334363016666 0ustar rossross/* ../config.h. Generated by configure. */ /* ../config.h.in. Generated from configure.ac by autoheader. */ /* platform-specific defines */ #include "platform.h" /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP systems. This function is required for `alloca.c' support on those systems. */ /* #undef CRAY_STACKSEG_END */ /* Define to 1 if using `alloca.c'. */ #define C_ALLOCA 1 /* Define to 1 if floating point arithmetic is supported. */ #define FLOATS_SUPPORTED 1 /* Define to 1 if you have `alloca', as a function or macro. */ /* #undef HAVE_ALLOCA */ /* Define to 1 if you have and it should be used (not on Ultrix). */ /* #undef HAVE_ALLOCA_H */ /* Define to 1 if you have the header file. */ #define HAVE_ASSERT_H 1 /* Define to 1 if you have the `atan' function. */ #define HAVE_ATAN 1 /* Define to 1 if you have /bin/sh */ #define HAVE_BIN_SH 1 /* Define to 1 if you have the header file. */ #define HAVE_CONIO_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_CONSOLE_H */ /* Define to 1 if you have the header file. */ #define HAVE_CTYPE_H 1 /* Define to 1 if you have the declaration of `altzone', and to 0 if you don't. */ /* #undef HAVE_DECL_ALTZONE */ /* Define to 1 if you have the declaration of `timezone', and to 0 if you don't. */ #define HAVE_DECL_TIMEZONE 1 /* Define to 1 if you have the declaration of `_timezone', and to 0 if you don't. */ #define HAVE_DECL__TIMEZONE 1 /* Define to 1 if you have the header file. */ #define HAVE_DIRECT_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_DIRENT_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_DLFCN_H */ /* Define to 1 if you have the `dlopen' function. */ /* #undef HAVE_DLOPEN */ /* Define to 1 if you have the header file. */ /* #undef HAVE_DL_H */ /* Define to 1 if you have the header file. */ #define HAVE_DOS_H 1 /* Define to 1 if you have the `dup' function. */ /* #undef HAVE_DUP */ /* Define to 1 if you have the header file. */ #define HAVE_ERRNO_H 1 /* Define to 1 if you have the `farcalloc' function. */ /* #undef HAVE_FARCALLOC */ /* Define to 1 if you have the header file. */ #define HAVE_FCNTL_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_FILES_H */ /* Define to 1 if you have the header file. */ #define HAVE_FLOAT_H 1 /* Define to 1 if you have the `fseek' function. */ #define HAVE_FSEEK 1 /* Define to 1 if you have the `fstat' function. */ #define HAVE_FSTAT 1 /* Define to 1 if you have the `ftell' function. */ #define HAVE_FTELL 1 /* Define to 1 if you have the `ftime' function. */ /* #undef HAVE_FTIME */ /* Define to 1 if you have the `GetModuleFileName' function. */ #define HAVE_GETMODULEFILENAME 1 /* Define to 1 if you have the `getrusage' function. */ /* #undef HAVE_GETRUSAGE */ /* Define to 1 if you have the `gettimeofday' function. */ /* #undef HAVE_GETTIMEOFDAY */ /* Define to 1 if you have the `gmtime' function. */ #define HAVE_GMTIME 1 /* Define to 1 if heap profiler can (and should) automatically invoke hp2ps to convert heap profile (in "profile.hp") to PostScript. */ /* #undef HAVE_HP2PS */ /* Define to 1 if you have the header file. */ #define HAVE_INTTYPES_H 1 /* Define to 1 if you have the header file. */ #define HAVE_IO_H 1 /* Define to 1 if you have the `isatty' function. */ #define HAVE_ISATTY 1 /* Define to 1 if compiler supports gcc's "labels as values" (aka computed goto) feature (which is used to speed up instruction dispatch in the interpreter). */ #define HAVE_LABELS_AS_VALUES 0 /* Define to 1 if you have the `dl' library (-ldl). */ /* #undef HAVE_LIBDL */ /* Define to 1 if you have the `dld' library (-ldld). */ /* #undef HAVE_LIBDLD */ /* Define to 1 if you have the `m' library (-lm). */ #define HAVE_LIBM 1 /* Define to 1 if you have the header file. */ #define HAVE_LIMITS_H 1 /* Define to 1 if you have the `LoadLibrary' function. */ #define HAVE_LOADLIBRARY 1 /* Define to 1 if you have the header file. */ #define HAVE_LOCALE_H 1 /* Define to 1 if you have the `localtime' function. */ #define HAVE_LOCALTIME 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_MACH_O_DYLD_H */ /* Define to 1 if you have the `macsystem' function. */ /* #undef HAVE_MACSYSTEM */ /* Define to 1 if you have the header file. */ #define HAVE_MEMORY_H 1 /* Define to 1 if you have the `mktime' function. */ #define HAVE_MKTIME 1 /* Define to 1 if you have the `NSCreateObjectFileImageFromFile' function. */ /* #undef HAVE_NSCREATEOBJECTFILEIMAGEFROMFILE */ /* Define to 1 if you have the `pclose' function. */ /* #undef HAVE_PCLOSE */ /* Define to 1 if you have the `poly' function. */ /* #undef HAVE_POLY */ /* Define to 1 if you have the `popen' function. */ /* #undef HAVE_POPEN */ /* Define if you have POSIX threads libraries and header files. */ /* #undef HAVE_PTHREAD */ /* Define to 1 if you have the `realpath' function. */ /* #undef HAVE_REALPATH */ /* Define to 1 if you have the `rindex' function. */ /* #undef HAVE_RINDEX */ /* Define to 1 if you have the `select' function. */ /* #undef HAVE_SELECT */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SGTTY_H */ /* Define to 1 if you have the `shl_load' function. */ /* #undef HAVE_SHL_LOAD */ /* Define to 1 if you have the header file. */ #define HAVE_SIGNAL_H 1 /* Define to 1 if you have the `sigprocmask' function. */ /* #undef HAVE_SIGPROCMASK */ /* Define to 1 if you have the `snprintf' function. */ /* #undef HAVE_SNPRINTF */ /* Define to 1 if you have the header file. */ /* #undef HAVE_STAT_H */ /* Define to 1 if you have the header file. */ #define HAVE_STDARG_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDINT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_STD_H */ /* Define to 1 if you have the `stime' function. */ /* #undef HAVE_STIME */ /* Define to 1 if you have the `strcasecmp' function. */ /* #undef HAVE_STRCASECMP */ /* Define to 1 if you have the `strcmp' function. */ #define HAVE_STRCMP 1 /* Define to 1 if you have the `strcmpi' function. */ #define HAVE_STRCMPI 1 /* Define to 1 if you have the `stricmp' function. */ #define HAVE_STRICMP 1 /* Define to 1 if you have the header file. */ #define HAVE_STRINGS_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRING_H 1 /* Define to 1 if you have the `strrchr' function. */ #define HAVE_STRRCHR 1 /* Define to 1 if `tm_zone' is member of `struct tm'. */ /* #undef HAVE_STRUCT_TM_TM_ZONE */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_IOCTL_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_PARAM_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_RESOURCE_H */ /* Define to 1 if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_TIMEB_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_TIMES_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_SYS_TIME_H */ /* Define to 1 if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define to 1 if you have that is POSIX.1 compatible. */ /* #undef HAVE_SYS_WAIT_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_TERMIOS_H */ /* Define to 1 if you have the header file. */ /* #undef HAVE_TERMIO_H */ /* Define to 1 if you have the `time' function. */ #define HAVE_TIME 1 /* Define to 1 if you have the `times' function. */ /* #undef HAVE_TIMES */ /* Define to 1 if you have the header file. */ #define HAVE_TIME_H 1 /* Define to 1 if your `struct tm' has `tm_zone'. Deprecated, use `HAVE_STRUCT_TM_TM_ZONE' instead. */ /* #undef HAVE_TM_ZONE */ /* Define to 1 if you don't have `tm_zone' but do have the external array `tzname'. */ #define HAVE_TZNAME 1 /* Define to 1 if you have the header file. */ /* #undef HAVE_UNISTD_H */ /* Define to 1 if you have the `valloc' function. */ /* #undef HAVE_VALLOC */ /* Define to 1 if you have the header file. */ /* #undef HAVE_VALUES_H */ /* Define to 1 if you have the `vsnprintf' function. */ /* #undef HAVE_VSNPRINTF */ /* Define to 1 if you have the header file. */ #define HAVE_WCHAR_H 1 /* Define to 1 if you have the header file. */ #define HAVE_WINDOWS_H 1 /* Define to 1 if you have the `WinExec' function. */ #define HAVE_WINEXEC 1 /* Define to 1 if you have malloc.h and it defines _alloca - eg for Visual C++. */ #define HAVE__ALLOCA 1 /* Define to 1 if you have the `_fullpath' function. */ #define HAVE__FULLPATH 1 /* Define to 1 if you have the `_pclose' function. */ #define HAVE__PCLOSE 1 /* Define to 1 if you have the `_popen' function. */ #define HAVE__POPEN 1 /* Define to 1 if you have the `_snprintf' function. */ #define HAVE__SNPRINTF 1 /* Define to 1 if you have the `_stricmp' function. */ #define HAVE__STRICMP 1 /* Define to 1 if you have the `_vsnprintf' function. */ #define HAVE__VSNPRINTF 1 /* Define to 1 if jmpbufs can be treated like arrays. */ #define JMPBUF_ARRAY 1 /* Define to 1 if your C compiler inserts underscores before symbol names. */ /* #undef LEADING_UNDERSCORE */ /* C compiler invocation use to build a dynamically loadable library. Typical value: "gcc -shared". Must evaluate to a literal C string. */ #define MKDLL_CMD "cl /LD /ML /nologo" /* Define to 1 if the C compiler supports function prototypes. */ #define PROTOTYPES 1 /* Define to the necessary symbol if this constant uses a non-standard name on your system. */ /* #undef PTHREAD_CREATE_JOINABLE */ /* Define as the return type of signal handlers (`int' or `void'). */ #define RETSIGTYPE void /* The size of a `double', as computed by sizeof. */ #define SIZEOF_DOUBLE 8 /* The size of a `float', as computed by sizeof. */ #define SIZEOF_FLOAT 4 /* The size of a `int', as computed by sizeof. */ #define SIZEOF_INT 4 /* The size of a `int*', as computed by sizeof. */ #define SIZEOF_INTP 4 /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ #define STACK_DIRECTION -1 /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define to 1 if you can safely include both and . */ /* #undef TIME_WITH_SYS_TIME */ /* Define to 1 if your declares `struct tm'. */ /* #undef TM_IN_SYS_TIME */ /* Define to 1 if signal handlers have type void (*)(int) (Otherwise, they're assumed to have type int (*)(void).) */ #define VOID_INT_SIGNALS 1 /* Define like PROTOTYPES; this can be used by system headers. */ #define __PROTOTYPES 1 /* Define to empty if `const' does not conform to ANSI C. */ /* #undef const */ hugs98-plus-Sep2006/src/winhugs/options.h0000644006511100651110000002025310426134734017110 0ustar rossross/* ../options.h. Generated automatically by configure. */ /* -------------------------------------------------------------------------- * Configuration options * * The Hugs 98 system is Copyright (c) José Enrique Gallardo, Mark P Jones, * Alastair Reid, the Yale Haskell Group, and the OGI School of * Science & Engineering at OHSU, 1994-2003, All rights reserved. It is * distributed as free software under the license in the file "License", * which is included in the distribution. * * $RCSfile: options.h,v $ * $Revision: 1.19 $ * $Date: 2006/05/03 14:10:36 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Hugs paths and directories * ------------------------------------------------------------------------*/ /* Define this as the default setting of HUGSPATH. * Value may contain string "{Hugs}" (for which we will substitute the * value of HUGSDIR) and should be either colon-separated (Unix) * or semicolon-separated (Macintosh, Windows, DOS). Escape * characters in the path string are interpreted according to normal * Haskell conventions. * * This value can be overridden from the command line by setting the * HUGSFLAGS environment variable or by storing an appropriate value * for HUGSFLAGS in the registry (Win32 only). In all cases, use a * string of the form -P"...". */ #define HUGSPATH ".;{Hugs}\\packages\\*" /* The list of suffixes used by Haskell source files, separated either * by colons (Unix) or semicolons (Macintosh, Windows, DOS). * * This value can be overridden using the -S flag. */ #define HUGSSUFFIXES ".hs;.lhs" /* The directory name which is substituted for the string "{Hugs}" * in a path variable. This normally points to where the Hugs libraries * are installed - ie so that the file HUGSDIR/lib/Prelude.hs exists * Typical values are: * "/usr/local/lib/hugs" * "/usr/homes/JFHaskell/hugs" * ".." * * This value is ignored on Windows and Macintosh versions since * it is assumed that the binary is installed in HUGSDIR. * * This value cannot be overridden from the command line or by using * environment variables. This isn't quite as limiting as you'd think * since you can always choose _not_ to use the {Hugs} variable - however, * it's obviously _nicer_ to have it set correctly. */ #ifndef HUGSDIR #define HUGSDIR "" #endif /* -------------------------------------------------------------------------- * User interface options * ------------------------------------------------------------------------*/ /* Define if you want to use the "Hugs for Windows" GUI. * (Windows 3.1 and compatibles only) */ #define HUGS_FOR_WINDOWS 1 /* Define if you want filenames to be converted to normal form by: * o replacing relative pathnames with absolute pathnames and * eliminating .. and . where possible. * o converting to lower case (only in case-insensitive filesystems) */ /* #undef PATH_CANONICALIZATION */ /* Define if a command line editor is available and should be used. * There are two choices of command line editor that can be used with Hugs: * GNU readline and editline (from comp.sources.misc, vol 31, issue 71) */ /* #undef USE_READLINE */ /* Define if you want the small startup banner. */ /* #undef SMALL_BANNER */ /* -------------------------------------------------------------------------- * Making Hugs smaller * ------------------------------------------------------------------------*/ /* Define one of these to select overall size of Hugs * SMALL_HUGS for 16 bit operation on a limited memory PC. * REGULAR_HUGS for 32 bit operation using largish default table sizes. * LARGE_HUGS for 32 bit operation using larger default table sizes. */ /* #undef SMALL_HUGS */ /* #undef REGULAR_HUGS */ #define LARGE_HUGS 1 /* -------------------------------------------------------------------------- * Fancy features * ------------------------------------------------------------------------*/ /* Define to omit Hugs extensions */ /* #undef HASKELL_98_ONLY */ /* Define if :xplain should be enabled */ /* #undef EXPLAIN_INSTANCE_RESOLUTION */ /* Define if heap profiling should be used */ /* #undef PROFILING */ /* Define if you want to run Haskell code through a preprocessor * * Note that there's the import chasing mechanism will not spot any * #includes so you must :load (not :reload) if you change any * (non-Haskell) configurations files. */ /* #undef USE_PREPROCESSOR */ /* Define if you want to time every evaluation. * * Timing is included in the Hugs distribution for the purpose of benchmarking * the Hugs interpreter, comparing its performance across a variety of * different machines, and with other systems for similar languages. * * It would be somewhat foolish to try to use the timings produced in this * way for any other purpose. In particular, using timings to compare the * performance of different versions of an algorithm is likely to give very * misleading results. The current implementation of Hugs as an interpreter, * without any significant optimizations, means that there are much more * significant overheads than can be accounted for by small variations in * Hugs code. */ /* #undef WANT_TIMER */ /* * By default, the Hugs Server API wraps up each value pushed on the stack * as a Dynamic, achieving some run-time type safety when applying these * arguments to a function. This Dynamic layer sometimes gets in the way * for low-level consumers of the Server API (e.g, HaskellScript, Lambada, * mod_haskell), so by setting NO_DYNAMIC_TYPES to 1 you turn off the * use of Dynamics (and assume all the responsibility of debugging any * bad crashes you might see as a result!) */ /* #undef NO_DYNAMIC_TYPES */ /* -------------------------------------------------------------------------- * Debugging options (intended for use by maintainers) * ------------------------------------------------------------------------*/ /* Define if debugging generated bytecodes or the bytecode interpreter */ /* #undef DEBUG_CODE */ /* Define if debugging generated supercombinator definitions or compiler */ /* #undef DEBUG_SHOWSC */ /* Define if you want to use a low-level printer from within a debugger */ /* #undef DEBUG_PRINTER */ /* Define if you want to perform runtime tag-checks as an internal * consistency check. This makes Hugs run very slowly - but is very * effective at detecting and locating subtle bugs. */ /* #undef CHECK_TAGS */ /* -------------------------------------------------------------------------- * Experimental features * These are likely to disappear/change in future versions and should not * be used by most people.. * ------------------------------------------------------------------------*/ /* Define if you want to use the primitives which let you examine Hugs * internals. */ /* #undef INTERNAL_PRIMS */ /* Define if you want to use the primitives which let you examine Hugs * bytecodes (requires INTERNAL_PRIMS). */ /* #undef BYTECODE_PRIMS */ /* In a plain Hugs system, most signals (SIGBUS, SIGTERM, etc) indicate * some kind of error in Hugs - or maybe a stack overflow. Rather than * just crash, Hugs catches these errors and returns to the main loop. * It does this by calling a function "panic" which longjmp's back to the * main loop. * If you're developing a GreenCard library, this may not be the right * behaviour - it's better if Hugs leaves them for your debugger to * catch rather than trapping them and "panicing". */ /* #undef DONT_PANIC */ /* If you get really desperate to understand why your Hugs programs keep * crashing or running out of stack, you might like to set this flag and * recompile Hugs. When you hit a stack error, it will print out a list * of all the objects currently under evaluation. The information isn't * perfect and can be pretty hard to understand but it's better than a * poke in the eye with a blunt stick. * * This is a very experimental feature! */ /* #undef GIMME_STACK_DUMPS */ #define USE_THREADS 1 /* Use a different thread to run the evaluator */ /* ----------------------------------------------------------------------- */ hugs98-plus-Sep2006/src/winhugs/platform.h0000755006511100651110000000137610173332300017235 0ustar rossross/* * configure-sussed platform #defines. */ #ifndef __PLATFORM_H__ #define __PLATFORM_H__ #define HostPlatform i386_unknown_msvc #define TargetPlatform i386_unknown_msvc #define BuildPlatform i386_unknown_msvc /* Definitions suitable for use in CPP conditionals */ #define i386_unknown_msvc_HOST 1 #define i386_unknown_msvc_TARGET 1 #define i386_unknown_msvc_BUILD 1 #define i386_HOST_ARCH 1 #define i386_TARGET_ARCH 1 #define i386_BUILD_ARCH 1 #define msvc_HOST_OS 1 #define msvc_TARGET_OS 1 #define msvc_BUILD_OS 1 /* Definitions of strings for use in C or Haskell code */ #define HOST_ARCH "i686" #define TARGET_ARCH "i686" #define BUILD_ARCH "i686" #define HOST_OS "msvc" #define TARGET_OS "msvc" #define BUILD_OS "msvc" #endif /* __PLATFORM_H__ */ hugs98-plus-Sep2006/src/winhugs/resource.h0000644006511100651110000000066607351722704017255 0ustar rossross//{{NO_DEPENDENCIES}} // Microsoft Developer Studio generated include file. // Used by winhugs.rc // // Next default values for new objects // #ifdef APSTUDIO_INVOKED #ifndef APSTUDIO_READONLY_SYMBOLS #define _APS_NO_MFC 1 #define _APS_NEXT_RESOURCE_VALUE 102 #define _APS_NEXT_COMMAND_VALUE 40001 #define _APS_NEXT_CONTROL_VALUE 1005 #define _APS_NEXT_SYMED_VALUE 101 #endif #endif hugs98-plus-Sep2006/src/winhugs/resrc1.h0000644006511100651110000000471510310057404016607 0ustar rossross//{{NO_DEPENDENCIES}} // Microsoft Visual C++ generated include file. // Used by winhugs.rc // #define DLG_OPTCOMPILE 9 #define BMP_ABOUT 106 #define DLG_OPTRUNTIME 108 #define ID_MRU 150 #define IDS_STRING153 153 #define BMP_TOOLBAR 1004 #define SPN_HEAPSIZE 1004 #define IDC_RICHEDIT21 1005 #define rtfPreview 1005 #define txtPath 1005 #define rtfAbout 1005 #define ID_RTF 1006 #define IDC_CHECK1 1012 #define chkOverlap 1012 #define IDC_CHECK2 1013 #define chkOverlapUnsafe 1013 #define IDC_CHECK3 1014 #define chkHereDocs 1014 #define lstFontFace 1016 #define chkUserShow 1016 #define lstEditor 1017 #define chkFontBold 1018 #define chkFontItalic 1019 #define txtFontSize 1021 #define spnFontSize 1022 #define txtEditor 1024 #define spnHeapSize 1027 #define txtHeapSize 1028 #define chkPrintStats 1029 #define chkPrintGC 1030 #define chkPrintType 1031 #define chkListLoading 1034 #define chkAutoReload 1035 #define optCompatible 1036 #define IDC_RADIO2 1037 #define optExtensions 1037 #define DLG_MAIN 28445 #define DLG_OPTHUGS 28446 #define ID_USERSGUIDE 40007 #define ID_WWWHUGS 40008 #define ID_WWWHASKELL 40009 #define ID_HELPCONTENTS 40010 #define ID_Menu 40016 #define ID_DELETE 40020 #define ID_CLEARSCREEN 40021 #define ID_SELECTALL 40022 #define ID_LIBRARIES 40023 // Next default values for new objects // #ifdef APSTUDIO_INVOKED #ifndef APSTUDIO_READONLY_SYMBOLS #define _APS_NEXT_RESOURCE_VALUE 110 #define _APS_NEXT_COMMAND_VALUE 40024 #define _APS_NEXT_CONTROL_VALUE 1037 #define _APS_NEXT_SYMED_VALUE 101 #endif #endif hugs98-plus-Sep2006/src/winhugs/winhugs.rc0000644006511100651110000004612210366410326017256 0ustar rossross// Microsoft Visual C++ generated resource script. // #include "resrc1.h" #define APSTUDIO_READONLY_SYMBOLS ///////////////////////////////////////////////////////////////////////////// // // Generated from the TEXTINCLUDE 2 resource. // #include "resource.h" #include "afxres.h" #include "winmenu.h" ///////////////////////////////////////////////////////////////////////////// #undef APSTUDIO_READONLY_SYMBOLS ///////////////////////////////////////////////////////////////////////////// // Neutral resources #if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_NEU) #ifdef _WIN32 LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL #pragma code_page(1252) #endif //_WIN32 ///////////////////////////////////////////////////////////////////////////// // // RT_MANIFEST // 1 RT_MANIFEST "resource\\winhugs.manifest" #endif // Neutral resources ///////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////// // English (U.K.) resources #if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENG) #ifdef _WIN32 LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_UK #pragma code_page(1252) #endif //_WIN32 ///////////////////////////////////////////////////////////////////////////// // // Bitmap // CLASSBMP BITMAP "resource\\classbmp.bmp" CLASSESDLGBMP BITMAP "resource\\classesd.bmp" DATACONSBMP BITMAP "resource\\datacons.bmp" INSTANCEBMP BITMAP "resource\\instance.bmp" BMP_ABOUT BITMAP "resource\\logo.bmp" MEMBERBMP BITMAP "resource\\memberbm.bmp" NAMEBMP BITMAP "resource\\namebmp.bmp" NAMESDLGBMP BITMAP "resource\\namesdlg.bmp" NEWTYPEBMP BITMAP "resource\\newtypeb.bmp" PRIMBMP BITMAP "resource\\primbmp.bmp" SELECTORBMP BITMAP "resource\\selector.bmp" TYCONSDLGBMP BITMAP "resource\\tyconsdl.bmp" TYPECONSBMP BITMAP "resource\\typecons.bmp" TYPESINBMP BITMAP "resource\\typesinb.bmp" SCRIPTMANDLGBMP BITMAP "resource\\smand.bmp" BMP_TOOLBAR BITMAP "resource\\toolbar.bmp" ///////////////////////////////////////////////////////////////////////////// // // Menu // HUGSMENU MENU BEGIN POPUP "&File" BEGIN MENUITEM "&Open...\tCtrl+O", ID_OPEN MENUITEM "&Module Manager...", ID_SCRIPTMAN MENUITEM "Options", ID_SETOPTIONS MENUITEM SEPARATOR MENUITEM "&Exit", ID_EXIT MENUITEM SEPARATOR MENUITEM "Recently Used Files", ID_MRU, GRAYED END POPUP "&Edit" BEGIN MENUITEM "Cu&t\tCtrl+X", ID_CUT MENUITEM "&Copy\tCtrl+C", ID_COPY MENUITEM "&Paste\tCtrl+V", ID_PASTE MENUITEM SEPARATOR MENUITEM "Delete\tDel", ID_DELETE MENUITEM "Select All\tCtrl+A", ID_SELECTALL MENUITEM "Clear Screen", ID_CLEARSCREEN MENUITEM SEPARATOR MENUITEM "Previous line\t&Up arrow", ID_GOPREVIOUS MENUITEM "Next line\t&Down arrow", ID_GONEXT END POPUP "&Actions" BEGIN MENUITEM "&Run\tF5", ID_RUN MENUITEM "&Stop", ID_STOP MENUITEM SEPARATOR MENUITEM "Re&load", ID_COMPILE MENUITEM "&Clear Modules", ID_CLEARALL MENUITEM SEPARATOR MENUITEM "Open Text Editor", ID_GOEDIT END POPUP "&Browse" BEGIN MENUITEM "&Classes...", ID_BROWSECLASSES MENUITEM "&Names...", ID_BROWSENAMES MENUITEM "&Type constructors...", ID_BROWSETYCONS MENUITEM SEPARATOR MENUITEM "&Hierarchy", ID_BROWSEHIERARCHY END POPUP "\a&Help" BEGIN MENUITEM "&Contents\tF1 ", ID_HELPCONTENTS MENUITEM "Hugs C&ommands", ID_HELPCOMMANDS MENUITEM "Hierarchical &Libraries", ID_LIBRARIES MENUITEM SEPARATOR MENUITEM "&Hugs Website", ID_WWWHUGS MENUITEM "Haskell &Website", ID_WWWHASKELL MENUITEM SEPARATOR MENUITEM "&About WinHugs...", ID_ABOUT END END ///////////////////////////////////////////////////////////////////////////// // // Dialog // ABOUTDLGBOX DIALOGEX 35, 24, 318, 113 STYLE DS_SETFONT | DS_MODALFRAME | DS_3DLOOK | DS_FIXEDSYS | DS_CENTER | WS_POPUP | WS_CAPTION CAPTION "About Hugs for Windows" FONT 8, "MS Shell Dlg", 400, 0, 0x0 BEGIN PUSHBUTTON "OK",IDOK,252,90,53,16 CONTROL "",rtfAbout,"RichEdit20A",ES_MULTILINE | ES_AUTOHSCROLL | ES_READONLY | WS_TABSTOP,103,17,201,67,WS_EX_TRANSPARENT END BROWSECLASSESDLGBOX DIALOG 65535, 18, 344, 220 STYLE DS_SETFONT | DS_MODALFRAME | DS_3DLOOK | DS_FIXEDSYS | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "Browse Classes" FONT 8, "Ms Sans Serif" BEGIN LISTBOX LB_CLASS,11,13,84,146,LBS_SORT | LBS_OWNERDRAWFIXED | WS_VSCROLL | WS_HSCROLL | WS_TABSTOP LISTBOX LB_INSTANCES,11,180,266,29,LBS_SORT | LBS_OWNERDRAWFIXED | WS_VSCROLL | WS_TABSTOP LISTBOX LB_MEMBERS,119,13,158,113,LBS_SORT | LBS_OWNERDRAWFIXED | WS_VSCROLL | WS_HSCROLL | WS_TABSTOP LISTBOX LB_CONTEXT,121,144,157,15,WS_VSCROLL | WS_TABSTOP PUSHBUTTON "C&lose",IDOK,291,4,47,14 PUSHBUTTON "&Hierarchy",ID_HIERARCHY,291,23,47,14 PUSHBUTTON "Edit &class",ID_EDITCLASS,291,42,47,14 PUSHBUTTON "Edit &instance",ID_EDITINSTANCE,291,62,47,14 LTEXT "",ID_PLACEBITMAP,287,172,49,1 GROUPBOX " Members: ",-1,111,1,173,129 GROUPBOX " Superclasses: ",-1,111,134,173,30 GROUPBOX " Instances: ",-1,4,167,280,47 GROUPBOX " Classes: ",-1,4,1,100,163 END BROWSENAMESDLGBOX DIALOG 24, 39, 288, 160 STYLE DS_SETFONT | DS_MODALFRAME | DS_3DLOOK | DS_FIXEDSYS | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "Browse Names" FONT 8, "Ms Sans Serif" BEGIN LISTBOX LB_NAMES,11,14,214,45,LBS_OWNERDRAWFIXED | LBS_HASSTRINGS | WS_VSCROLL | WS_TABSTOP LTEXT "&Search:",-1,11,67,27,8 EDITTEXT IDC_SEARCHNAME,39,65,186,12 LISTBOX LB_NAMESTYPE,11,103,214,14,WS_VSCROLL | WS_TABSTOP LISTBOX LB_NAMESNOTES,11,139,214,12,WS_VSCROLL | WS_TABSTOP PUSHBUTTON "C&lose",IDOK,238,14,45,14 PUSHBUTTON "Edit &name",ID_EDITNAME,238,35,45,14 GROUPBOX " Names: ",-1,4,2,228,87 GROUPBOX " Type: ",-1,4,92,228,28 GROUPBOX " Notes: ",-1,4,127,228,28 LTEXT "",ID_PLACEBITMAP,235,112,41,1 END BROWSETYCONSDLGBOX DIALOG 16, 16, 312, 226 STYLE DS_SETFONT | DS_MODALFRAME | DS_3DLOOK | DS_FIXEDSYS | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "Browse Type Constructors" FONT 8, "Ms Sans Serif" BEGIN LISTBOX LB_TYCONS,12,17,210,55,LBS_OWNERDRAWFIXED | LBS_HASSTRINGS | WS_VSCROLL | WS_TABSTOP LTEXT "Search:",-1,12,80,28,8 EDITTEXT IDC_SEARCHTYCON,39,78,183,12 LISTBOX LB_DEF,12,113,212,12,WS_VSCROLL | WS_TABSTOP LISTBOX LB_CONS,12,142,210,34,LBS_OWNERDRAWFIXED | LBS_HASSTRINGS | WS_VSCROLL | WS_TABSTOP LISTBOX LB_TYCONSINST,12,189,210,28,LBS_OWNERDRAWFIXED | WS_VSCROLL | WS_TABSTOP PUSHBUTTON "C&lose",IDOK,248,15,58,14 PUSHBUTTON "Edit &type",ID_EDITTYCON,248,34,58,14 PUSHBUTTON "Edit &instance",ID_EDITTYCONSINST,248,53,58,14 LTEXT "",ID_PLACEBITMAP,234,170,73,1 GROUPBOX " Types: ",-1,5,4,226,92 GROUPBOX " Type: ",-1,5,101,226,27 GROUPBOX " Constructors and selectors: ",-1,5,132,226,42 GROUPBOX " Instances: ",-1,5,177,226,45 END SCRIPTMANDLGBOX DIALOGEX 84, 17, 301, 192 STYLE DS_SETFONT | DS_MODALFRAME | DS_3DLOOK | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "Module Manager" FONT 8, "Arial", 0, 0, 0x0 BEGIN GROUPBOX "Module files: ",-1,5,5,220,184 LISTBOX LB_SCRIPTS,11,20,203,167,WS_VSCROLL | WS_HSCROLL | WS_TABSTOP PUSHBUTTON "&Add",ID_ADDSCRIPT,236,11,53,14 PUSHBUTTON "&Remove",ID_DELSCRIPT,236,31,53,14 PUSHBUTTON "&Clear",ID_CLEARSCRIPTS,236,51,53,14 PUSHBUTTON "&Edit",ID_EDITSCRIPT,236,71,53,14 PUSHBUTTON "C&ancel",IDCANCEL,236,151,53,14 DEFPUSHBUTTON "&OK",IDOK,236,171,53,14 LTEXT "",ID_PLACEBITMAP,238,95,73,1 END DLG_MAIN DIALOGEX 0, 0, 443, 258 STYLE DS_SETFONT | DS_FIXEDSYS | WS_MINIMIZEBOX | WS_MAXIMIZEBOX | WS_VISIBLE | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME EXSTYLE WS_EX_ACCEPTFILES | WS_EX_APPWINDOW CAPTION "WinHugs" MENU HUGSMENU FONT 8, "MS Shell Dlg", 400, 0, 0x1 BEGIN CONTROL "",ID_RTF,"RichEdit20A",ES_MULTILINE | ES_AUTOVSCROLL | ES_NUMBER | WS_VSCROLL,48,34,70,72,WS_EX_CLIENTEDGE END DLG_OPTCOMPILE DIALOGEX 0, 0, 291, 150 STYLE DS_SETFONT | DS_MODALFRAME | DS_FIXEDSYS | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "Compile Time" FONT 8, "MS Shell Dlg", 400, 0, 0x1 BEGIN GROUPBOX "Haskell Extensions [Requires restart]",IDC_STATIC,7,68, 277,74 LTEXT "Path:",IDC_STATIC,12,21,42,13 EDITTEXT txtPath,58,17,219,12,ES_AUTOHSCROLL CONTROL "Overlapping instances",chkOverlap,"Button", BS_AUTOCHECKBOX | WS_DISABLED | WS_TABSTOP,23,104,230,12 CONTROL "Unsafe overlapping instances",chkOverlapUnsafe,"Button", BS_AUTOCHECKBOX | WS_DISABLED | WS_TABSTOP,32,115,230,12 CONTROL "Here documents",chkHereDocs,"Button",BS_AUTOCHECKBOX | WS_DISABLED | WS_TABSTOP,23,125,230,12 CONTROL "Show list of scripts being loaded",chkListLoading, "Button",BS_AUTOCHECKBOX | WS_TABSTOP,12,34,261,11 CONTROL "Automatically reload modified files",chkAutoReload, "Button",BS_AUTOCHECKBOX | WS_TABSTOP,12,45,265,10 GROUPBOX "Loading Files",IDC_STATIC,7,7,277,53 CONTROL "Haskell 98 Compatability",optCompatible,"Button", BS_AUTORADIOBUTTON,12,80,252,10 CONTROL "Allow Hugs/Ghc Extensions",optExtensions,"Button", BS_AUTORADIOBUTTON,11,92,252,10 END DLG_OPTRUNTIME DIALOGEX 0, 0, 304, 113 STYLE DS_SETFONT | DS_MODALFRAME | DS_FIXEDSYS | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "Runtime" FONT 8, "MS Shell Dlg", 400, 0, 0x1 BEGIN EDITTEXT txtHeapSize,54,18,60,12 CONTROL "",spnHeapSize,"msctls_updown32",UDS_SETBUDDYINT | UDS_ALIGNRIGHT | UDS_AUTOBUDDY | UDS_ARROWKEYS,115,17,11, 14 LTEXT "Heap size:",IDC_STATIC,16,20,36,8 LTEXT "Mb",IDC_STATIC,131,21,10,8 GROUPBOX "Debugging Options",IDC_STATIC,7,51,290,54 CONTROL "Print statistics (heap cells, reductions) after each computation", chkPrintStats,"Button",BS_AUTOCHECKBOX | WS_TABSTOP,15, 63,214,10 CONTROL "Print garbage collection messages",chkPrintGC,"Button", BS_AUTOCHECKBOX | WS_TABSTOP,15,75,124,10 CONTROL "Print type after evaluation",chkPrintType,"Button", BS_AUTOCHECKBOX | WS_TABSTOP,15,88,101,10 CONTROL "Use Show instance for results",chkUserShow,"Button", BS_AUTOCHECKBOX | WS_TABSTOP,15,33,268,10 GROUPBOX "Runtime Options",IDC_STATIC,7,7,290,40 LTEXT "(Requires WinHugs restart to take effect)",IDC_STATIC, 148,20,134,8 END DLG_OPTHUGS DIALOGEX 0, 0, 304, 131 STYLE DS_SETFONT | DS_MODALFRAME | DS_FIXEDSYS | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "WinHugs" FONT 8, "MS Shell Dlg", 400, 0, 0x1 BEGIN GROUPBOX "Output area / Font",IDC_STATIC,7,7,290,71 LTEXT "Font face:",IDC_STATIC,13,20,34,8 LTEXT "Font size:",IDC_STATIC,14,39,32,8 CONTROL "Bold",chkFontBold,"Button",BS_AUTOCHECKBOX | WS_TABSTOP, 147,36,29,10 CONTROL "Italic",chkFontItalic,"Button",BS_AUTOCHECKBOX | WS_TABSTOP,193,36,31,10 EDITTEXT txtFontSize,59,34,60,12 CONTROL "",spnFontSize,"msctls_updown32",UDS_SETBUDDYINT | UDS_ALIGNRIGHT | UDS_AUTOBUDDY | UDS_ARROWKEYS | UDS_NOTHOUSANDS,121,33,11,14 GROUPBOX "Editor",IDC_STATIC,7,82,290,42 LTEXT "Use:",IDC_STATIC,15,92,29,10 EDITTEXT txtEditor,59,106,225,12,ES_AUTOHSCROLL | WS_DISABLED COMBOBOX lstFontFace,59,17,225,58,CBS_DROPDOWN | CBS_SORT | WS_VSCROLL | WS_TABSTOP CONTROL "",rtfPreview,"RichEdit20A",ES_CENTER | ES_AUTOHSCROLL | ES_READONLY | WS_TABSTOP,13,50,271,22,WS_EX_STATICEDGE COMBOBOX lstEditor,59,89,225,65,CBS_DROPDOWNLIST | WS_VSCROLL | WS_TABSTOP END ///////////////////////////////////////////////////////////////////////////// // // Accelerator // HUGSACCELERATORS ACCELERATORS BEGIN VK_F9, ID_COMPILE, VIRTKEY, NOINVERT VK_F1, ID_HELPINDEX, VIRTKEY, NOINVERT VK_F5, ID_RUN, VIRTKEY, NOINVERT "O", ID_OPEN, VIRTKEY, CONTROL, NOINVERT END ///////////////////////////////////////////////////////////////////////////// // // Cursor // MOVECLASSCURSOR CURSOR "resource\\move.cur" ///////////////////////////////////////////////////////////////////////////// // // Icon // // Icon with lowest ID value placed first to ensure application icon // remains consistent on all systems. HUGS ICON "resource\\hugs1.ico" HUGSDOC ICON "resource\\hugsdoc.ico" ///////////////////////////////////////////////////////////////////////////// // // DESIGNINFO // #ifdef APSTUDIO_INVOKED GUIDELINES DESIGNINFO BEGIN BROWSECLASSESDLGBOX, DIALOG BEGIN BOTTOMMARGIN, 217 END DLG_OPTCOMPILE, DIALOG BEGIN LEFTMARGIN, 7 RIGHTMARGIN, 284 TOPMARGIN, 7 BOTTOMMARGIN, 124 END DLG_OPTRUNTIME, DIALOG BEGIN LEFTMARGIN, 7 RIGHTMARGIN, 297 TOPMARGIN, 7 BOTTOMMARGIN, 106 END DLG_OPTHUGS, DIALOG BEGIN LEFTMARGIN, 7 RIGHTMARGIN, 297 TOPMARGIN, 7 BOTTOMMARGIN, 124 END END #endif // APSTUDIO_INVOKED #ifdef APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // TEXTINCLUDE // 1 TEXTINCLUDE BEGIN "resrc1.h\0" END 2 TEXTINCLUDE BEGIN "#include ""resource.h""\r\n" "#include ""afxres.h""\r\n" "#include ""winmenu.h""\r\n" "\0" END 3 TEXTINCLUDE BEGIN "\r\n" "\0" END #endif // APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // String Table // STRINGTABLE BEGIN ID_NEW "Edit a new script file" ID_OPEN "Load modules from specified file" ID_SCRIPTMAN "Enter Module Manager" ID_SAVE "Load selected file" ID_EXIT "Exit Hugs interpreter" END STRINGTABLE BEGIN ID_COPY "Copy selected text to clipboard" ID_PASTE "Paste text from clipboard" ID_GOEDIT "Run text editor" ID_CUT "Cut selected text" ID_GOPREVIOUS "Edit previous input line" END STRINGTABLE BEGIN ID_GONEXT "Edit next input line" END STRINGTABLE BEGIN ID_RUN "Evaluate ""main"" expression" ID_STOP "Stop program execution" ID_EVAL "Evaluate selected expression" END STRINGTABLE BEGIN ID_TYPE "Show type of selected expression" ID_COMPILE "Reload files" ID_MAKE "Reload files for current project" ID_CLEARALL "Clear all files except prelude" END STRINGTABLE BEGIN ID_SETOPTIONS "Set Hugs interpreter options" END STRINGTABLE BEGIN ID_BROWSECLASSES "Browse defined classes, instances and members" ID_BROWSENAMES "Browse defined names" ID_BROWSETYCONS "Browse defined type constructors" ID_BROWSEHIERARCHY "Show classes hierarchy" END STRINGTABLE BEGIN ID_HELPINDEX "Display help contents" ID_ABOUT "Display version info" ID_HELPCOMMANDS "Summary of Hugs commands" END STRINGTABLE BEGIN 61440 "Changes the size of the window" END STRINGTABLE BEGIN 61456 "Moves the window to another position" END STRINGTABLE BEGIN 61472 "Reduces the window to an icon" END STRINGTABLE BEGIN 61488 "Enlarges the window to it maximum size" END STRINGTABLE BEGIN 61504 "Switches to next window" END STRINGTABLE BEGIN 61536 "Closes the window" END STRINGTABLE BEGIN 61728 "Restores the window to its previous size" END STRINGTABLE BEGIN 61744 "Opens task list" END STRINGTABLE BEGIN ID_MRU "Load recently loaded file" 151 "Load recently loaded file" 152 "Load recently loaded file" 153 "Load recently loaded file" 154 "Load recently loaded file" 155 "Load recently loaded file" 156 "Load recently loaded file" 157 "Load recently loaded file" 158 "Load recently loaded file" 159 "Load recently loaded file" END STRINGTABLE BEGIN ID_DELETE "Delete the currently selected text" ID_CLEARSCREEN "Clear the screen" ID_SELECTALL "Select all the text" ID_LIBRARIES "Information on the Hierarchical Libraries" END STRINGTABLE BEGIN ID_WWWHUGS "Visit the Hugs website, www.haskell.org/hugs" ID_WWWHASKELL "Visit the Haskell website, www.haskell.org" ID_HELPCONTENTS "Show the help contents" END #endif // English (U.K.) resources ///////////////////////////////////////////////////////////////////////////// #ifndef APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // Generated from the TEXTINCLUDE 3 resource. // ///////////////////////////////////////////////////////////////////////////// #endif // not APSTUDIO_INVOKED hugs98-plus-Sep2006/src/winhugs/winhugs.sln0000644006511100651110000000156210307603445017446 0ustar rossrossMicrosoft Visual Studio Solution File, Format Version 8.00 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "winhugs", "winhugs.vcproj", "{83954CE1-BCC8-44BD-8913-4647784582C3}" ProjectSection(ProjectDependencies) = postProject EndProjectSection EndProject Global GlobalSection(SolutionConfiguration) = preSolution Debug = Debug Release = Release EndGlobalSection GlobalSection(ProjectConfiguration) = postSolution {83954CE1-BCC8-44BD-8913-4647784582C3}.Debug.ActiveCfg = Debug|Win32 {83954CE1-BCC8-44BD-8913-4647784582C3}.Debug.Build.0 = Debug|Win32 {83954CE1-BCC8-44BD-8913-4647784582C3}.Release.ActiveCfg = Release|Win32 {83954CE1-BCC8-44BD-8913-4647784582C3}.Release.Build.0 = Release|Win32 EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution EndGlobalSection GlobalSection(ExtensibilityAddIns) = postSolution EndGlobalSection EndGlobal hugs98-plus-Sep2006/src/winhugs/winhugs.vcproj0000644006511100651110000002260010310061025020133 0ustar rossross hugs98-plus-Sep2006/src/winhugs/register/0000755006511100651110000000000010504340137017057 5ustar rossrosshugs98-plus-Sep2006/src/winhugs/register/make.bat0000644006511100651110000000007207371556461020504 0ustar rossrosscl register.c advapi32.lib shell32.lib ole32.lib uuid.lib hugs98-plus-Sep2006/src/winhugs/register/register.c0000644006511100651110000002431510376323220021055 0ustar rossross#include #include #include #include "..\..\version.h" typedef CHAR *String; #define SLASH '\\' #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\") #define WinhugsRoot ("SOFTWARE\\Haskell\\Hugs\\Winhugs" HUGS_VERSION "\\") #define HASKELL_SCRIPT "haskellProgram" #define TEMPLATE expandHugsPath("{Hugs}\\template.hs") #define HASKELL_SCRIPT_ICON expandHugsPath("{Hugs}\\icons\\hsicon.ico") #define HUGS_EXE_ICON expandHugsPath("{Hugs}\\icons\\hugsicon.ico") #define WINHUGS_EXE expandHugsPath("{Hugs}\\winhugs.exe") #define HUGS_EXE expandHugsPath("{Hugs}\\hugs.exe") #define PROGRAM_GROUP "Hugs 98" #define HUGSPATH "{Hugs}\\libraries;{Hugs}\\packages\\*" static char hugsHome[MAX_PATH] = ""; /* hugs folder */ static char programsFolder[MAX_PATH] = ""; /* Start -> Programs folder */ /* get path to Start -> Programs folder */ void getProgramsFolder(String str) { LPITEMIDLIST pidlStartMenu; //get the pidl for the start menu - thgis will be used to intialize the folder browser SHGetSpecialFolderLocation(NULL, CSIDL_PROGRAMS, &pidlStartMenu); //get the path for the folder SHGetPathFromIDList(pidlStartMenu, str); } /* Creates a new folder */ void CreateFolder(String folder) { //create the folder CreateDirectory(folder, NULL); //notify the shell that you made a change SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, folder, 0); } // CreateLink - uses the shell's IShellLink and IPersistFile interfaces // to create and store a shortcut to the specified object. // Returns the result of calling the member functions of the interfaces. HRESULT CreateLink(String destPath, String groupPath, String newLinkPath, String args, String iconPath) { HRESULT hres; IShellLink* psl; char groupAndLinkPath[MAX_PATH]; sprintf(groupAndLinkPath, "%s\\%s", groupPath, newLinkPath); // Get a pointer to the IShellLink interface. hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, &IID_IShellLink, &psl); if (SUCCEEDED(hres)) { IPersistFile* ppf; // Set the path to the shortcut target, and add the // description. psl->lpVtbl->SetPath(psl, destPath); psl->lpVtbl->SetArguments(psl, args); if (iconPath != NULL) { psl->lpVtbl->SetIconLocation(psl, iconPath, 0); } // Query IShellLink for the IPersistFile interface for saving the // shortcut in persistent storage. hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf); if (SUCCEEDED(hres)) { WORD wsz[MAX_PATH]; // Ensure that the string is ANSI. MultiByteToWideChar(CP_ACP, 0, groupAndLinkPath, -1, wsz, MAX_PATH); // Save the link by calling IPersistFile::Save. hres = ppf->lpVtbl->Save(ppf, wsz, TRUE); ppf->lpVtbl->Release(ppf); } psl->lpVtbl->Release(psl); } return hres; } static BOOL createKey(HKEY hKey, String regPath, PHKEY phRootKey, REGSAM samDesired) { DWORD dwDisp; return RegCreateKeyEx(hKey, regPath, 0, "", REG_OPTION_NON_VOLATILE, samDesired, NULL, phRootKey, &dwDisp) == ERROR_SUCCESS; } static BOOL setValue(HKEY hKey, String regPath, String var, DWORD type, LPBYTE buf, DWORD bufSize) { HKEY hRootKey; if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) { return FALSE; } else { LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize); RegCloseKey(hRootKey); return (res == ERROR_SUCCESS); } } /* write String to winhugs registry */ static BOOL writeWinhugsRegString(String var, String val) { if (NULL == val) { val = ""; } return setValue(HKEY_CURRENT_USER, WinhugsRoot, var, REG_SZ, (LPBYTE)val, lstrlen(val)+1); } /* write String to hugs registry */ static BOOL writeHugsRegString(String var, String val) { if (NULL == val) { val = ""; } return setValue(HKEY_CURRENT_USER, HugsRoot, var, REG_SZ, (LPBYTE)val, lstrlen(val)+1); } /* write String to HKEY_CLASSES_ROOT */ static BOOL writeHKCRString(String where, String var, String val) { if (NULL == val) { val = ""; } return setValue(HKEY_CLASSES_ROOT, where, var, REG_SZ, (LPBYTE)val, lstrlen(val)+1); } /* get folder where program is executing */ void getExeHome(String str) { String slash; /* get .exe full path */ GetModuleFileName((HMODULE)0,str,FILENAME_MAX+1); /* truncate after directory name */ if (slash = strrchr(str,SLASH)) *slash = '\0'; strlwr(str); } /* Replaces all occurrences of str "what" by "by" in "in" */ static VOID StrReplace(CHAR *what, CHAR *by, CHAR *in, CHAR *result) { CHAR *ptrIn, *ptrResult; UINT byLength = strlen(by); UINT whatLength = strlen(what); for(ptrIn=in, ptrResult=result; *ptrIn;){ if(strncmp(ptrIn,what,whatLength)==0) { strcpy(ptrResult, by); ptrResult += byLength; ptrIn += whatLength; } else{ *ptrResult = *ptrIn; ptrResult++; ptrIn++; } } *ptrResult = (CHAR)0; } /* Expand "{Hugs}" to real path */ static String expandHugsPath(String toExpand) { #define MAX_RESULTS 5 static CHAR expanded[MAX_RESULTS][2*_MAX_PATH]; static i = 0; /* get next slot */ i++; if(i>=MAX_RESULTS) i = 0; StrReplace("{Hugs}", hugsHome, toExpand, expanded[i]); return expanded[i]; } static String expandSlash(String toExpand) { static CHAR expanded[2*_MAX_PATH]; CHAR *ptr, *ptrDest; for(ptr=toExpand, ptrDest=expanded; *ptr; ) { if(*ptr == SLASH) { ptrDest[0] = SLASH; ptrDest[1] = SLASH; ptr++; ptrDest++; ptrDest++; } else { *ptrDest = *ptr; ptr++; ptrDest++; } } *ptrDest = '\0'; return expanded; } /* Set an editor and path for hugs and winhugs */ static void setOptions (String editorCmd) { static CHAR options[4*_MAX_PATH]; sprintf(options, "-E%s -P%s", editorCmd, HUGSPATH); writeHugsRegString("Options",options); writeWinhugsRegString("Options",options); } /* configuration for winvi32 editor */ static String WinVi32(void) { static CHAR editorCmd[2*_MAX_PATH]; sprintf(editorCmd, "\"\\\"%s\\\\editor\\\\winvi\\\\winvi32.exe\\\" +%cd \\\"%cs\\\"\"", expandSlash(hugsHome), '%', '%'); return editorCmd; } /* configuration for pfe32 editor */ static String Pfe32(void) { static CHAR editorCmd[2*_MAX_PATH]; sprintf(editorCmd, "\"\\\"%s\\\\editor\\\\pfe\\\\pfe32.exe\\\" /g %cd \\\"%cs\\\"\"", expandSlash(hugsHome), '%', '%'); return editorCmd; } /* configuration for ultraedit32 editor */ static String Ultraedit32(void) { static CHAR editorCmd[2*_MAX_PATH]; sprintf(editorCmd, "\"\\\"c:\\\\archivos de programa\\\\ultraedt\\\\uedit32.exe\\\" %cs/%cd/1\"", '%', '%'); return editorCmd; } /* configuration for notepad editor */ static String notepad(void) { static CHAR editorCmd[2*_MAX_PATH]; sprintf(editorCmd, "\"notepad.exe %cs\"", '%'); return editorCmd; } /* configuration for yikes editor */ static String Yikes(void) { static CHAR editorCmd[2*_MAX_PATH]; sprintf(editorCmd, "\"\\\"%s\\\\editor\\\\yikes\\\\yikes.exe\\\" /%cd \\\"%cs\\\"\"", expandSlash(hugsHome), '%', '%'); return editorCmd; } int main(int argc,char *argv[]) { BOOL usePfe32 = FALSE; BOOL useWinVi32 = FALSE; BOOL useUltraedit32 = FALSE; BOOL useYikes = FALSE; UINT i; char groupPath[MAX_PATH]; CoInitialize(NULL); getExeHome(hugsHome); getProgramsFolder(programsFolder); /* process command line */ for(i=1; iÖQ?ÐHEÑLIÑMJÖR@ØVBÙXBÛ\EÜ]FÝaGÞbHÞbIÞiTágJãlMàlUæqPäpRévRéyVì{Uî~WîWãx^ãy_ç}^ìZì[çaåhð‚YñƒYñ„Zò†[ó‡[ô‰]õŠ]öŒ^÷_ë†gæ‚jìŠjìŠkîŒkì‹lõŽcògø`ù‘aú“bû“bû”cü”cü•dü–dêwåŠzñ“rü sû¤yû¤zö©‰ô«‘ñ¯úºžóº¨ó»ªð»°÷ɹôÌÃúÑÀûÞÑûåÞúæàûèâûêåüëåýñìüñíþóîýôðýøöþúùþûûÿÿÿÿÿÿ& *  6  !! .!! .++! ..+!'4 <..;ZaND^aD <<.JaaVNaaP <<<êwwwwwvffffddDD®î§wwwwwwwffFFDJîîî—wwwwwffffFIîîðÀ€€€€Àð( @€Í74Í84Í95Í:5Í96Í:7Î;6Î<6Î=6Ï>7Ï?7Ï@8ÐA8ÐB9ÐC9ÑD9ÑD:ÒF:ÒG:ÓI;ÓK=ÔK=ÔM>ÕN>ÖP?ÖR@×S@×UAØUAÙWBÙXBÚZDÚ[DÛ\EÜ]FÜ_FÝ_GÞaHÞbHßdIÕa_ágJàfKàgLâjLàiOãlMåoNákQäoQáoVæqPçsQäpRætSäsUévRéwTèwVéyUêxTëzUéyVézWí|Ví}Wî~WîWàp\í}Xè{\áwdæ~cï€XïXí€Zí[ð‚YðƒYñ„Zò†[ó‡\óˆ\ò‰_ô‰]õ‰]õŠ]õ‹]ö‹^öŒ^öŒ_÷_éƒgí‡fíˆgæhæƒlç…lïŠhïŒjïŽlõaö`óŽfø`ñŽiù`ùaù‘aú‘aú’aú’bû“bû”cü•cü•dý–dý—dü—eý—eòkñ‘mø•jýšiä‡pæˆsåŠsîpî’tí“wì’x÷›sñ™yòšz÷£~ߘ˜è“ꔀꕀ윂隊êœì †ò£ˆò¦öªŒë¢”꣖ù³‘ô±™õ²™ó²žë´¦ìµ¦ëº¬ì»­ô¹¥øº¡ø½¤ô¿°õÀ°õõõŶõ˵ùÑÂûÔÅüÖÆ÷×ÏûÜÐüßÒúàÙùáÛûâÚùâÜûäÝüåÜýêâúêæüëåûìéüîêýñíüñîüòðüóðýóðþôðþôñþ÷õý÷öþúùþûùþûúþüüþýýÿÿÿÿÿÿ`.''! )š0.(('' ˆš000(*(''!! ˆD444**(('!!  49444*4((''!! )DD99444**(('!!  DD399444*4((''!! DDDD99444**(('!!  PDDD399444*4((''!! PKDDDD49444**(('!! PPPDDD<99444*4(('' PPPKDDDD39444*0'('' ZPPPPDDD<<4444*0(''"ZPZPDPDDK’™344*.'3Ž•HZZPPZDDh³ÅÅÅ¢4440`¹ÅÅ¿•ZZZZPPO¦ÅÅÅÅÅŒ444­ÅÅÅÅÅEiZZZPZO¹ÅÅÅÅÅ¢44KÅÅÅÅÅÅŽiiZZZZO²ÅÅÅÅÅž4D3¿ÅÅÅÅÅŠ$iiiZZZZ™ÅÅÅÅ¿_D44¢ÅÅÅų.''wZn\\ZZZŸ¹Å­†DDD9D¡¹Å©G+''"knnZ\ZZZZOZDODDD3999440+++"'"winnnZZZZZOPOOj…DD394440I`+'"""wnnnniZZZZZOj©ÅŹ‘D494]­Åų}'"""wnnnnnnZZZZZ§ÅÅÅŹ_D49«ÅÅÅŹ.'""wnwinnniZZZZ¿ÅÅÅÅÅ—D:]ÅÅÅÅÅÅŠ''"wwnwnnnnnZZZÅÅÅÅÅÅ—DD]ÅÅÅÅÅÅŠ'+'wwwnwnnnniiZ§ÅÅÅÅÅjDDD­ÅÅÅŹ30'+–wwnnwinnniiwªÅŹ“PPDDe­Åŵ00+|wwwnwiinniii„‡ZPPPKKDDe:4402¥wwwwnwnwiniiZZZPZKPKKDD:::02œ¥|wwwwiiiiiiiZZZPZPPKDDD::Dœ–wwwwwwiwiiiZZZZPPPPDDFðÀ€€€€Àð(0`Í:5ÒH;ÙXCÞaHærPÙwuä|eöŒ_Û…„é™…ð¨‘ñ¸¨öųøÕËúàØþþþ”33#""¤3332""!!CCC32"""dDCC4##""!!! DD443C2"""€DDCC3C32""!!!´DDDD43332""!tttDD3C33#""!!DDDtDD4332"""tttDDDC3332""!!GDDDDDD44#""""GGDtDDD3C332""tttGDDDDCCC32""GGGDDDDD43333""!!wGDtGDtDD3C33"""twGttDDDD4333"""!ttwDtGDDDD43332""wttwDtDtDD43C32""!!!wGwGGDGDDDD4C332""wwtttttDDDD3432"""!!!wwwGGGJÍÇDDD34œÛb""wwwwttïÿÿÄDDDNÿÿû""!!!wwwww}ÿÿÿûDDDßÿÿÿ“""wwwwwÿÿÿÿDDIÿÿÿÿò""wwwwwÎÿÿÿÿ”DLÿÿÿÿô2"!!!wwwwwÏÿÿÿÿ¤DLÿÿÿÿõ2""!!!wwwwwÎÿÿÿÿtDJÿÿÿÿô3#"!!wwwww~ÿÿÿþDttÿÿÿÿÓ32""!!wwwwwzïÿÿçtDD¯ÿÿþC33#""wwwwww}îìwDGDIßÿ´4332"""wwwwwwwwwGGtttDtCC3322""ww§wwwwwwtGDDDDDDCC33"""wwwwwwwwwww—tttDDDHs33""www§wwwwwwßÿëDDDDmÿÿ£3#"w§wwwwwww~ÿÿÿÄttGïÿÿû33"wwwwwwwwwßÿÿÿ÷DDMÿÿÿÿd33wwwzwwwwwïÿÿÿütGOÿÿÿÿ³33w§wwwwzwwÿÿÿÿýGDÿÿÿÿÓ33ww§wzwwwwÿÿÿÿüttOÿÿÿÿÄ33wwwwwwwwwïÿÿÿútG}ÿÿÿÿ“C3—§w§wwwww®ÿÿÿçGtIÿÿÿþD36Çwwwwwwwwzÿÿýtttt¯ÿÿÔD49w§zwzwwww|Ì—wwGtt«·DDD@ wwwwww§zwwwwtttttttDDD §w§zwwwwwwwwwwGGGDDtDF wwww§wwwwwwwGwttttDD`Çw—wwwwwwwwwwGGttGDzÇwwwwwwwwwwwwtttt{ü?ÿÿðÿÿàÿÿÀÿÿ€ÿÿ€ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿ€ÿÿÀÿÿàÿÿðÿÿü?ÿÿ(0`€ Í74Í84Í85Í95Î:5Î;6Î<6Î=6Ï=7Ï>7Ï?7Î<:Ï@7Ð@8ÐA8ÐB8ÐB9ÐC9ÑC9ÑD:ÒF:ÒG;ÒH;ÓI;ÓJ<ÓK=ÔL=ÕM>ÕN>ÕO>ÖP?ÖQ?ÐHEÐKJÖR@×S@×TAØVBÙXBÚYCÚZDÚ[DÛ\EÛ]EÜ]FÜ^FÜ^GÝ_GÝ`GÞbHßcIßdIàeIàeJàfJáhJâiKàhLâkLãlMänNänOåoOåpOãoRåoPàmUæqPçsQãrTápVäsWètQèuSévRêwSêxSëyTëzUì{Uí}Vî~WîWârYãtYäw[çyZçz[äx]ê|Zë}Zê}[í~XîYê]ê~^Ùwuâyeèbâ|jî€Wï€XïXí‚^ðXð‚YðƒYñ„Zñ…Zñ…[ò†[ó‡[ó‡\ôˆ\ô‰]õŠ]ö‹^öŒ^÷Ž_ç€cè€bé‚cìƒ`ì„aì‡eæ‚iç„iæ„mè…hí‹kîŽnð‰côŒbñŠeñ‹fódógôfø`óhðŽk÷‘dö‘fù`ú‘aú’bû”cü”cü•dý–dþ—eýœnäƒpè‹tìtí’ví“wïšð”tõ›vüŸqñ—xñ›~òœ}ôž|ö¢~ø¡{û¥zÛ…„旄엀욅ç‹êš‰ï ˆö¦…ñ£‰ò£ˆò¤Šõ©ùªˆë£–í¦–é¨—ìª–é¬œò¨ñ®šì°÷³—ù²“í³ í¶¤î³©ï·¬ó´ õ¶ ù¾¥õ¼©ð¸¬ó»¬ñ¼¯ô¾­ò½°÷¨öĬøÀªúÅ­õ²òÁ·÷ƵôĶùÈ´úË·óŹöÉ»÷Ê»ù˹ùξôÉÀ÷ÏÂõÏÅôÍÆúÔÅöÒÉ÷ÔÉøÔÉùÖÉø×ÎûØÊüÚËúÚÎûÜÏøÛÓúÝÒøßÙúà×ùàÚúçâýîèüïìûðîýñíýòíþòíüòðýôðþöòýöôþùöþúøþûúþüûþüüÿÿÿªG4210-+)'&%$  !a¸A985321.,*('&%#   ©x=<;985321.,*('&%#  "yD@=<;986321.+*('&%#  "¹IED?=<;985321.+*('&%#  ©\KIED?=<;985321.+*('&%#   ÀNLKIED?=<;985321.,*('&%#  a|ONLKIED?=<;985321.,*('&%#  !QPONMKIED?=<;985321.,*('&%#  RQPONMKIED@=<;985321.,*('&%#  eRQPONLKIED@=<;986321.+*('&%#  geRQPONLKIED?=<;985321.+*('&%#  jieRQPONLKIED?=<;985321.,*('&%#  lkifSQPONLKIED?=<;985321.,*('&%#  mlkifSQPONLKIED?=<;985321.,*('&%#  omlkifSQPONMKIED?=<;985321.,*('&%#  qomlkifSQPONMKIED@=<;987321.,*('&%# rqomlkifRQPONLKIED@=<;987321.+*('&%# srpomlkieRQPONLKIED?=<;985321.+*('&%# tsrqomlkieRQPONLKIED?=<;985321.,*('&%# utsrqomlkifS]³ÙãÑIED?=<;98:®ÒßÃd*('&%# vutsrqomlki„ëÿÿÿÿÿØJED?=<;YìÿÿÿÿþÂ*('&%# wvutsrqomlkèÿÿÿÿÿÿÿËIED@=>îÿÿÿÿÿÿÿ¶*('&%# wwvutsrqom¥ÿÿÿÿÿÿÿÿûZIED@«ÿÿÿÿÿÿÿÿò/*('&%# ‹wwvutsrpoÏÿÿÿÿÿÿÿÿÿžKIEDÉÿÿÿÿÿÿÿÿÿb+*('&%# ‹‹wwvutsrpÕÿÿÿÿÿÿÿÿÿ±LKIEÔÿÿÿÿÿÿÿÿÿ™.+*('&%# ‹‹wwvutsr¾ÿÿÿÿÿÿÿÿÿƒNLKI¼ÿÿÿÿÿÿÿÿýC1.,*('&%# ‘‹‹wwvuts…ôÿÿÿÿÿÿÿëPONLK`ùÿÿÿÿÿÿÿÜ321.,*('&%# ‘‘‹‹wwvuts°úÿÿÿÿÿóQPONMK¯üÿÿÿÿÿïU5321.,*('&%# ’‘‘‹‹wwvuts æüÿ÷Ú‡fSQPONMK›åüÿöÌH985321.,*('&%$’’‘‘‹‹wwvutsrqˆmlkifRQPONLKIEW@=<;986321.+*('&%’’’‘‘‹‹wwvutsrpomlkieRQPONLKIED?=<;985321.+*('&“’’’‘‘‹‹wwvutsrpomlk†¤Ÿ^PONLKIED?=<ü~~üÿÿÿüÿÿÿùÿÿÿùÿÿÿóÿÿÿÇÿÿÿÿÿÿÿÿÿÿÿhugs98-plus-Sep2006/src/winhugs/resource/logo.bmp0000644006511100651110000003246610305571173020542 0ustar rossrossBM656(op1  Ï7(Ñ8*Ì8:Î=2Í9<Î9=Ï>4Ñ>5ÓC+Ò?7ÔD-Ó@9ÕE/ÖF1Î@FÑE?ÓJ6ÒF@ÔK8ÓGBÕK:ÔHCÖL;×M=ÚR3ØN>ÛS5ÒLHÒJQÖSCÖPM×TEÚX=ÙUFÛY>ÒSOÜZ@Ý[AÚSRà`:ÝXKÞ\C×ZLß]Dà^FÜ`GÙYWÝaIÞbJágCßcLÜ\[Ö[bàdMÿýãhEÙ_\äiFåjHÝhPÝeXækIépBçlKêqCânLèmLénMäoMÙciæsEìrEãlVêoOåpOæqPÝl^çrQèsSãuSæyKétTìxLêuUâs\íyMÛnjìvVÝrdîzOçxWåu_ï{Pð|Qáx_ézZñ}Sä|ZÙqtíTî€Uä{cÞyjäxkí}^ïVÞwqè^êƒVð‚WñƒYë…Xè~gò„Zó…[â{uã~oìƒbå‚i÷ŠTõ†]ö‡^ø‹Vï†eçsùŒWáyã„súYó‹`ìŠgûŽZæ‡v÷dðŽløfú”^êsↅù‘gû•_ú’h䊀ü–aõ”hæŽzÞ‡‹ívþ—bÿ˜cð”qê“wø—kë’í–zô˜tÿŸi蔈ð™}ó›ä”–ö {昑盋졈ëžó£„ä™ èžï¢“륓㜨䟣룙ò§õ©‘馡ñª˜ò­’ù¯Ží¬Ÿõ°•ð±›ø³˜ê¬¬ñ°£ã©¶å­²í±©û¶›î´¤õµ ê³°ò¸§ì³¸å°Áë±½ü¾ ö»«ð»¯ò¾ªúÁ¨ë¸ÀõçóǯùƲòüì¾ÊõǸùË»ìÆÎóÇÌöϼõÍÂøÐÄòÍÎúÓÀõÒËúÛÃôÖÓú×ÏûÚÊóÒÞîÓâ÷ÚÖøÝÑøÙÝôÜÜûâÎôÚãüáÕùãÛüèØüæÞ÷åèþèáøæêúìßúæñüëçÿïëúïîûïöþõíÿúéÿõôùòýÿööúöøýúõþúüÿÿòÿþùûýÿüÿþ6666666666666666110/11'//'/%/)*$**$$$$$ 6666666666666666666666666666?;1;:<11551/'/'/$*,*$$**$    6666666666666666666666AA:;:::5122''02///'/'*$/$$$ $$ 666666666666666666AA==A1?:1;:111/0'0//*%*'/%*$$** *   666666666666666>BA?AA=A;;::5:501'12'''/'*)*'$$$ $$$666666666666HKKAAB=A:11;1;511010'///'/'*$***$$* $ 6666666666NK>KABKAA=AAA:::;151221////)*'/,$$$*$$ $j®½ÚÚÚÚ¹Ž 66666666SFKKHMKHBBA==??;11<;5/'215///'*%**%*$$$$$¥ÿÿÿÿÿÿÿÿûû¹666666FFNNKKKHAAAA?AA;;::::51115'''''/'')'*$$$$* $¥ýÿÿÿÿþûÿÿÿÿæ 66666SNNSNNKK>M>AAA====?;51150/'2////'/8'*$$$**$ $$«ÿÿýýýþÿþÿÿÿþÐ6666YFTNFSNKKKHKKHBAAA;;:;::1111/11//*)'*$//*$$$$ ³íÁj#TÖþÿÿÿþ4 666OO[YONFSSKK>HH>ABB?>:::19;12512000'/*'/$%$$$$($$$$éÿÿÿÿ¨   66YYSYNMSNFFKKKA>AAAA>¿¿¿À¹<5<:5²ºººµL''*)/«èÿÿä£(/µµ±±µfjVµÿÿÿÿÐŽÏáÿÿÿùØ #66YYYQYYFQNNSKKKKKKBH<üÿÿþó;1:5'õÿÿûÿ~//'/Õÿþÿÿþÿávÿÿÿÿÿ5Ïýÿÿÿó¨—ÿÿÿûß^ôþûÿÿûþÿÿÿû¬6_]Y`FYTSQKNNFKKIKHHABüÿÿÿó;1:19õÿÿÿýf'/'¥ÿÿÿýÿÿýÿùÿÿÿÿÿ&Oôÿûûþÿþþòÿÿÿþà–ÿÿýÿþýÿýÿÿÿÿ»YO_O__YOTYSSNNKKHK>KBüÿÿûó?:;:5õÿÿÿÿ~1/0åÿûÿÿÿþÿþÿÿÿÿÿÿ#$îÿþýÿýûúúÿÿÿÿþß ‘ýÿÿíÁ­®âÿÿÿÿÿVP_YYYYFYMYSFFNSKKK>AHüÿÿû÷;;=15õÿÿÿÿ~505úÿÿÿû㎿ôÿÿÿÿÿ¥ÿÿÿýÿþäÜùÿûÿÿÿß —þÓV¿ÿÿÿú¬\Y_YYYYSYNOSNSFNKKMMIüÿÿþó:1;:?õÿÿÿÿs'/PÿÿÿÿÿL*'$Oÿÿÿÿÿ.$ Ûÿÿûÿ÷X-Ñÿÿÿþàt    ÉÿÿÿÿÄ___Y_YYYOYYQFSFNSNKHHüÿÿÿó;AA??õÿÿÿÿs1/cÿÿÿÿï$%'*Tÿÿÿýÿ&%úÿÿÿÿ¬—ÿÿÿÿß *„¹ìÿÿÿûù»`YY_Y___Y[OYSONNFFKKIüÿÿþ÷>:B;5õÿÿÿÿ~/7aÿÿÿþæ//*)Fÿÿûþÿ#$AÿÿÿûþV—ÿÿÿûà ¦ðÿÿýûúûúÿÿ’mcccY_YYYYYQNTSKQNNKMüÿÿûó>HA;:õûÿÿÿ~11aÿÿÿÿä'/%'Tÿÿÿýÿ.$_ÿÿÿÿÿ8—ÿÿÿþà$èÿÿÿþûþÿþÿþë__`__`_YY]YY_YFYFNNSIüÿÿþ÷;G=>=üÿÿÿÿ~10uÿÿÿÿæ/%/*Fÿÿÿÿÿ($aÿÿÿÿÿE—ÿÿÿþàÕÿÿûÿýýÿþÿÿÓ#`mmc\cPY_YO]YFQNMNSSGüÿÿÿó>K;AHüÿÿÿÿ~:Ìÿÿÿÿþp;1aÿÿÿýæ'/'/Fÿÿÿÿÿ3*$ÛÿÿÿÿóE—ÿÿÿþßfþÿÿÿ÷ Èmmci`mcYP`__YY_YFYNSHüÿÿÿÿÿòâðÿþûÿÿù5=;oÿÿÿÿä70/0Oÿÿÿÿÿ.$$‘ýÿÿÿÿò©t„Öÿÿÿûà úýÿÿÿ¼*j½úÿnm_m_i__c__YYY]YSYSYFüÿÿÿûÿÿÿÿÿÿýÿûÔ1A1uÿÿûÿæ2/'/Oÿÿÿÿÿ*'**Ûþÿÿûÿþÿþÿÿûýþà·ýþýÿÿÿÿÿýýýþ`mm_c_mm_]P___OY][FSSüÿÿþùÛýÿÿÿÿÿÿÿtA=Hoÿÿýÿæ/27/Pþÿÿýÿ3*$'LîûþýýýÿþÿýÿþûßÖÿþþþÿûýþÿþÿ minmccc``c\]YYYYYOY_YýÿÿþóM³úþÿþÿöBA:;oýþýÿæ11/0Pûýûþÿ8'$/*1ÍÿýÿþÿòÈþþþÿà‘èýþýýÿÿÿóÁnm`mmmccd]c__`_Y_YYSSüÿûþóNMO§¿Â¢[AA=A:;;:;<1551221///***/$)/ L¤µµŽ%$ L‘±±±ŠLnrmimm_mm_m_\cP]_YYYYýÿÿýóFNQKKK>AHHBA=A1?11::112/'0//''''%**$*$$* $  xinmimc__c_mc]__YYY_Süÿÿÿ÷NSFMKHKM>>A?A=A;A:15<511100////*/''*$$$$* *  ilnnmimmccmm`\\\P___\üûýÿóFMFNMKKKHAAAKBA:1?::;11502'''//''%**$*$*$ $ zqqrnmimmc_`imc_]`]YSüýþú÷MTNNSMKH>KKH;A=AA;;;::511/771/'///'$/$/ *$$ *$ rrqxirmimcmcc___c__OYüûÿÿ÷QYYSSFMKKKHH>>?A=:1:115;521200'//''*/)/%$$$ $$ rrnlxinmimcmccmmYYPc_¡¢š¡™Y[SFFQSNKMKKAKAIAAA=::;1110/221/'/*'%*)**$$$$$$  nnrzxlnnmimucdc``mc]Y]_Y_SYOYFQQNFFKH>>KAK;?=:;=;1::011/'00//'//'*$$$*$ zzlrrnxnnmimm_mcd``__PYYY]YNS[TSSNNQKKMHHAAAAA:;::55:1217/'/'/%'*'//*$*$ *$zurqrnxlnnminmm_c_dc\Y\__YOYYFYYFFNNFNKHKKB>BB=A1?1;;:<102'15///*'*)%$$$$* $   qzlzrzmnqnnm`mmcdc__cc_Y\_Y_Y_YNTNSSNFKK>>KKAAA=A;A:15:21/7/'0'''/'**** $ $$$ zznnronzqxmnmimmm_mmm\`Y__YYY_FSYYYFFNNKKKMAHAB=A:1?1:;:;2125/2///%*'$-$***$ ${{zzlqurnlxnnm`mmm__`m_cYP__YYYOOQSSNSNNKKHNAIAA=AA;A:15:15/'1'////'*/)/' $*$ #  zz{umzzrzqqnnmimcmccm_c_cYYYYYYYSYOFKFSNNKAHKAAHA=:1?;:;=:111211/''/'%*)*$$ $   }rzzzrnlrrmqnnmimmcc_m\\_____Y_YY[NSYMFSFKK>IAA>BAAA;B:155520'2''//)//'*%/* *$ $ {{rrq{lznnxzxmnmicmmmc\mm\YY]Y_YYFYYTSSNFNKKKAKBAA==:1;;:;;;11/5/1///)%*$*$$*$* * $   zzzrzznuzzlrlxnnmmcm_cc_`ccYP_Y]__YQYFFQNNNKMKBKHAAAAA1?:111551'/02/'//'/'*$$$$$$  ‡zz{o{qzzrrrrqqnrmmmmcmccd\\c]\\SYYS_N[QSQSMKHMKAKHHB=:A;;:::;12110''/''*,*$* $$* $ r‡}€zzzzunlrqrrmxinmmcm_mm_m__u²ÖâññâÒ³cTFSFSMKHKKA>>AAA:1?:5<1512[²ÜÜÿÜܺf,/-**$ $ #    …r{r{ruzzuozrmwlnrmmmmc_]m{ÊöÿÿÿÿÿÿÿÿöÇmMFNFQM>MBIAAB?=AA;;;1:^ÏÿÿÿÿÿÿÿÿÿÝ)$$$*$*   zz…zz€zzruzmrozqqxinmmmmmm–öÿÿÿÿÿÿÿÿÿÿÿÿö–MNNFFKHKAKHAAA=?1?::¦ÿÿÿÿÿÿÿÿÿÿÿÿÿÏ*/- *$$ *$ …‡ƒ‡…rqzznzlnrrrlnnmmmm¶ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ°YKNNMK>KKHKAH?A;A;Ñÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿä1%$$$$*  z}r{ƒr…}z{rznuznynnqnnhm›ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþ„YQNNNKMMKAA>A=>=²ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÚ***$$$*$  ………z{…€r{zzz{zzrzlzqxnm…öÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèFSFSSFKHH>IBA=A“ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿµ%$$$*$$  zzz…zƒr…z{z{zuqorurnlqqÊÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû¢ONFFNNK>KAKHABáÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûö;//*$$ $$ $z………zz{…€z{zrzznlzmzqöÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿâSNTNNNFMKHKAA™ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ½*))$$**$ ‡zz}…zzƒrƒzzrruzurzry¸ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþý‚YYKNSNFKKMKKÒÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûð'***/$$$ $$ $}ƒ…‡‡zz……{…{€…rozznzrrr×ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿý«SSMYKFNMKKHBðÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýT*'$')$$*$$‡‡ƒzr‡…}zƒ}rrz{rznornâÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÊFOYSYMSNMK>Kÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿ'*/***$$* $ ‡‡y‡……z}z…{…{zz{zrlôÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÒ[YY[OSQFSQKvÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿý¤//'$$$$*$ $  ‡‡…ƒƒz…‡‡zzzƒƒ€€zz{z{zrñÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÖY_YYNOONFFMuÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿ¦/'////*$*$*$ *$ˆ€}…{‡…}r€‡‡…{{rr{zrzrçÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÇYYSSFYNMNNNMÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÿ„''*%$%)'*$$$$$ƒˆ…ˆˆƒ€……‡rrzz…z}rroÙÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþ³_YYOYYYYONNMðÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿý^//'///**$'*$*$$$ˆ‡‡ˆ€ƒ{‡z}r……z…‡}…rzroz¾ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû†_Y_YY[[SSMSSÒÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûýð05///''%'$/*$$$ $‡‡‡‡‡ˆz‡……zz‡r‡r…}z{‡öÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿâP]_Y_YYFOTYFFžÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿ½0'50////*/),$*$* #$$ˆ‡ƒƒƒ‡‡€…ƒzz…‡rz…rƒ{{zÉÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûž_]`\_YYYYYYSMNâÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿöK1//''//%)'%***$$$ $ $‡ƒˆ‡‡‡€…‡‡‡…zz…‡z…zr}€z‡öÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþêmc_P_YY_]\YYTYQ™ûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþ¿5511//''//*'','$*$$$ #$Œˆˆ‡ˆ‡€ˆ‡‡y}z……}rz‡…zrr¡ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýi_]\_`]_YO[SSYTO·ÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿþÖ1:510011//'''8**** $*$ ‡ƒ‡‡ˆˆ‡‡€………zz……zrƒ€z€…¾ýÿûþÿûÿÿÿÿûÿÿÿÿý·c_m_c\PP]YYYOOYYMSÒÿþûÿÿÿÿÿÿÿÿÿýþÿèT:5;510551///'''')/'*$$$ $Œ‡ƒˆƒƒ‡‡zˆˆ}}……zz…z…{{…rržùÿÿýÿýÿÿÿÿýÿþô›ucmc`m__]___YYYYSSYF²ûýýÿÿÿÿÿÿÿÿÿÿÑ1=:;;1151''52/)*****)*$ $$ $ˆƒŒˆƒ‡‡‡‡ˆ‡€…‡ƒz……z‡zzzr…}zÉúÿþÿÿûýûÿöÊ{imm_md]]c_YPY_YYYOYSNF‚ÖÿÿýÿûûÿÿÿÝ™AA;=1::5121/''2/'''''*%'**$ $$ ƒ‡‡‡ˆ‡ƒƒ‡‡‡‡}‡…zz‡r……‡z€ro…¸×åòðçÙ·…nqmmnmc__mm`]_Y_Y_]SYOO_QQ{Àááÿââ¿„HAB=:1;:15:51010/'///***$**$ $$ ˆƒŒƒ”ˆˆ‡ˆ‡ƒ‡‡‡ƒƒ……z…rr‡rz€zrznzzlrnnxinm`mmcmh__cc_`_]O_YQYSTSNNFFKAKK>A?AAAA=::;;101011///%'''/'%$$*$ ˆ‡ˆŒƒƒˆ‡ƒ‡€€‡{‡}z…z…z…r…rr{qzrznrrqzrlxrmmmmcmPmm_`Y_]OYYSYSFYFSSNMKKKHA>KB?=:;;;15:121551''//**%****$*$$$””ƒƒƒŒ‡‡‡‡ˆˆˆzˆƒ‡…}…z‡z…zrzzz{zuzlnmrnnlinm`mm_m]``_cP_YYY_\YYSTFFQNMKH>KKHAAAA:=::15:12''51/')''/$'$' $$$$ƒƒƒŒƒˆˆˆƒƒˆ‡‡‡ˆƒ{ƒ}‡z‡r}‡z………}zuzuuzzqzqqxnmmmmc_cdd\`]`Y_YYOO[FYSQSSMKKKHHAHH??A;=::;55100'0////*$/*/**$*$”Œˆˆ‡ƒˆˆ‡ƒ‡‡‡…‡‡r‡z…zr‡ryy{zzrzzmrnrnnlqnmmmmmm__m__PcY_YYYY_SO[FFSMKMKA>>>AA?:;;;1:;511/02/'''/$$%$$$$*$ŒƒˆƒƒŒŒƒ‡ƒ‡‡ƒ‡‡ˆy€…z…z…z…rzz{rqnzlzrzxqnnnhmm›{cm_cY]__]YYYYSYSFQNFMKH>KKAABBA>::‰:155201''////'//**/*$$”””””ˆ‡ˆƒˆƒƒ‡‡ƒ‡ƒƒƒˆ‡}…z…z…z……zz…rzzummrrlnqn¶Þöÿÿÿÿì·c_Y`O_YY]F[YSSNNSNKMIHKHAO²áÿÿÿÿù×¥11/77'///*'%'')$$$”ƒƒƒƒ‡Œ‡‡‡ˆˆˆˆˆ‡‡ˆ‡‡y‡z…z…zzr‡€€yz{uzzzonx¸ñÿÿÿÿÿÿÿÿÿÿÖ†\__YY__OYFSYFQNFFMHAK[Âöÿÿÿÿÿÿÿÿÿð¦512/100''*/*****””ŒŒˆˆƒ”ŒŒƒƒ‡ˆˆ‡‡€…}‡z…z‡z……rrrƒo{zzruur…×ÿÿÿÿÿÿÿÿÿÿÿÿÿö¢cPc_YYY_YO[TOSNNFKKuèÿÿÿÿÿÿÿÿÿÿÿÿÿÏH/20''//'''%$'%ƒ”Œ‡‡””ƒƒˆ‡‡ƒ‡‡ƒ‡‡}………}…z‡r…zr……rzzrrzzzÞÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ´``_]_YYSYYFYQFNNM‰öÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèT1/21////**//*”””””‡ƒˆˆƒ‡ŒŒŒˆƒ‡ƒ‡ˆ‡ˆ‡‡ƒ…}…€‡…zƒƒz€…z{r¸ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿù“_\PY_]Y[SYNYSSM_èÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÏ51'002'/''%%)•”””ƒ”Œ”‡ˆˆ”ƒƒˆ‡‡ƒ‡ˆ€€}‡€‡}‡r‡{{‡{r}{ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿðc\Y__YOYYYSYSFFÒÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¦10150'/'////”••”ƒƒ”ƒƒ”‡ƒˆƒƒ‡ˆ‡ˆ‡ƒ‡……ƒ‡r‡r…z}rzz{zÙÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¶cc\\_Y_YOO[ON{ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþð51/''0///)')””””””Œƒ”ƒˆˆ‡ˆŒŒƒˆ‡‡‡‡…‡{€…z…z…zz…z…›ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿñh\_\_Y_Y]YYYNÖÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿý¥15171/0/'/*”•••””ƒˆƒˆ‡”‡ƒ‡ƒƒ‡‡ˆ‡ˆ‡}…z…z‡…€z‡yÆÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ›m]c`_YYO\YYYöÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÖ515/21'2//'••Œ”””Œƒƒ”ƒ‡ˆ‡ƒˆƒƒƒ€ƒy‡z…z‡rz{‡rÞÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÀ__c_PY__Y]S“ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿö<;511/'1'/'•••••”””ƒ”””ˆ‡ƒŒŒˆ‡‡ˆˆ‡ˆ……z‡z…z…‡zr‡çÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÊcm_\`Y\\YO_žÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ:115512002/•••”ƒŒ””ƒƒƒƒ‡Œˆƒƒˆ‡‡‡‡‡………}…z…zr……ôÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÝcc`m__c___YÀÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿv1::110/50'•”•••””ŒŒˆˆŒ‡‡ˆˆƒƒƒ‡‡ƒ‡ˆ‡‡}…z……ƒìÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÍmmm`m\_`PYY§ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿT=555511'10•”•••””ƒŒ”””ƒƒŒ‡Œˆˆƒˆƒ€€€}‡z…zzzçÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÎm___d`c]P\_¢ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ1:;;;;5501'””••••”Œ”ƒˆŒƒƒ‡‡ƒ‡‡‡ˆ‡……}‡}……‡Òÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþ§mmcc_i__`_`mÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèA111::;11/2•”””••””ƒŒˆƒŒˆƒŒŒƒˆˆˆ‡‡‡‡………ƒ‡zz´ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿinmccc_mc_YPëÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ=:A=:151551”””•••••”””””ŒŒ””‡ˆƒˆŒƒ‡‡ˆ‡‡ˆ‡‡‡y‡…ƒñÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÒqm`mmmmm`]\c_´ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþpAA:;==::115•””””••”””ƒ””ƒƒŒ‡‡ƒ‡ƒƒƒƒƒƒƒ€ƒy…zzÀÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿnrmimm__himc`\òÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûÿÑAA?=A1;;;515””””•••””””Œƒ”””ŒˆƒƒˆŒ‡‡ˆˆˆˆ‡‡ˆ‡ˆ……z‡…€ìûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûýÎqxinmimcmP____\§þûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿöuI?AA=A111;<1œ”””””••”””””””ƒƒ”ˆˆƒŒŒ‡‡‡ˆ‡‡‡…ˆ…}€úÿÿûÿÿÿÿÿÿÿÿÿÿÿÿÿèqrxlnrmimmccmmmYcÈþýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿšAAAK??A:A::1:””””””••••”””””Œ””ƒ””ƒˆƒƒƒŒˆ‡‡ƒ‡‡‡‡‡z´öÿýûÿÿÿÿÿÿýÿÿÿýç{rnmxinmnmmm_]`m_YÎÿÿÿÿþÿûÿÿÿÿÿûÿö¯BMKAHAA:A:;:=16””Ÿ””•”””””””””ƒ”ƒˆ‡ˆƒˆŒŒƒƒƒƒˆƒƒ€€€y…ŸôÿÿýûÿÿÿÿýþýÿÑurzmmzxlnrn`mm_cmi_Yc¶öþÿûýýýÿÿÿÿÿñ‰FKKHHKAHBA=A:;66”””””••”••”””””Œƒˆ‡Œ””‡Œ‡ƒ‡‡‡‡‡‡ˆ…………}…z¾ôÿÿþÿÿþþÿÙ–zzorzzqyqxinmimcm__mmY_uÊòÿÿþÿþÿýð«FSNMK>KB>>AHABA?66œ”””˜”••••””””””””Œ”ƒƒ”Œˆ‡Œˆˆˆ‡‡‡‡ˆ‡}‡z‡r¡ÊÎÞÒÊ´z{zqnrlnrxlrlnrmimmccm`__Y\_¡ÊÇâÇÀ‰[TKNFNMKK>AKK?>=AB666””””””•••••””””ƒ””ƒ”ˆ”ƒƒƒ‡Œ‡‡ˆ‡ƒ‡‡‡}‡z…zzz…‡z€€zzzzuzrnqmmxinmnmmc_mmmcc`___Y_YYFYYMNSSNKMKHHKHKB6666•””””˜”•””””””””ŒŒŒƒ”ƒ‡ˆ”ƒƒƒƒƒƒƒƒˆƒ€ƒ‡}…z‡‡…€rƒr{…r{{nzulzqzxlnnn`mmcc_`]__P`YYYY_YSQNQNFFFKHKAAAII66666”””””””•••”””””””””Œ””‡ˆˆ‡ŒƒˆˆˆŒˆˆ‡‡‡‡ˆ}‡}…zr}z…{zzrzzzqzrumrxmqmnmimmccim\\`____YYS\YYOKNNNMKBKKIK666666œ”””••˜•••””””””ƒ”””””Œƒ‡‡‡‡ˆ‡‡‡ˆ…}‡}‡………zz…zruzqozzrlxxmmmimucc__m__PY]YYYOO[TNYNNNQNKIIS6666666•””•••••••”””””””””ŒŒƒƒƒƒ”Œ”ƒƒƒƒŒˆ‡‡ˆ‡‡‡ƒ‡r}}€…z‡rƒz€zz{znqrnrxlwmnm`mmmcm_mY`YP__YYSFYYSQSSFFNNQ666666666•””•••˜•””””””””””””””ˆ”Œˆ‡ƒƒˆˆˆˆƒƒƒƒƒƒƒ€}‡€…‡‡‡ƒ‡r…{ƒr{zrzuzzlzrlqqmnmmnm_m`m]c_c\Y]_YYYNSFFFFNSS66666666666”•••””””””ƒ”Œƒ”ˆ‡‡‡‡‡‡‡‡ˆ‡‡‡‡…ƒ‡}zry{r…€zrz{rzrrqmmrnqxmnm`mm_c`m_\___OYYYSYO[[SSSS6666666666666œ•••••˜”””””””””””””ŒŒŒ””ƒ‡Œ””””Œˆˆ‡‡‡‡‡‡{}………………z{……zzzrzlzzzrxmxxnmmmcmmc_mc]Y`Y_____SYYSS6666666666666666•••••˜”””””””””””””””””ƒƒŒ”ƒƒƒƒƒƒƒƒƒˆˆˆˆˆ…}}zzzz…zrƒƒ‡…}zz{{uurnlzllqnm`mc_dm``_cPcYYYYSYSS66666666666666666666”””””””””””””ƒˆ”ƒƒˆˆˆˆˆˆˆˆˆƒƒƒƒƒ€‡‡……………‡{{yr{{{zzzzlzrqqqnnmmmmm_]idc_____\\Y6666666666666666666666666””””””””””””””””ŒŒŒŒŒˆˆ‡‡‡‡‡‡‡‡‡‡‡‡‡‡‡ƒƒƒ€€€€}}}}zzzzzrrrrrrrrqqqnnmmmmmm__`]]\\Y66666666666666hugs98-plus-Sep2006/src/winhugs/resource/makebutt.bmp0000644006511100651110000000051607235676737021431 0ustar rossrossBMNv(Ø€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝ »»»»»°ÝÝ »D»KK°ÝÝ ´»KKK°ÝÝ ´»KKK°ÝÝ ´»KKK°ÝÝ »D»KK°ÝÝ »»»»»°ÝÝ »»»»»°ÝÝ ´´»D»°ÝÝ ´´´»K°ÝÝ ´´´»K°ÝÝ ´´´°ÝÝ ´´»@ÿ ÝÝ »»»°ðÝÝÝ »»»° ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/memberbm.bmp0000644006511100651110000000033607235676737021403 0ustar rossrossBMÞv( h€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿfffffffbˆˆˆˆˆˆfhÝÝÝÝÝÖbÿÝÿÝÿÖhÿÝÿÝÿÖhÿÝÿÝÿÖhÿÝÿÝÿÖhÿÝÿÝÿÖhÿÿýÿýÖhÝÝÝÝÝÖhmÝÝÝÝÝÖhfffffffhfffffffhhugs98-plus-Sep2006/src/winhugs/resource/move.cur0000644006511100651110000000050607235676737020575 0ustar rossross 0( @ÿÿÿà \çÀG80¹¿ÀpŽàsàpÿà~íÿàsüq¿ðààÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿàÿÿÀÿÿ€?ÿ€ÿ€ÿðÿþÿhugs98-plus-Sep2006/src/winhugs/resource/namebmp.bmp0000644006511100651110000000033607235676737021234 0ustar rossrossBMÞv( h€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿfffffffohˆˆˆ†ffohÌÌÌÌffohÏüÏüffohÏüÏüffohÏüÿüffohÏÿÏüffohÏÿÏüffohÏüÏüffohÏüÏüffofÌÌÌÌffofffffffofffffff`hugs98-plus-Sep2006/src/winhugs/resource/namesdlg.bmp0000644006511100651110000000636607235676737021420 0ustar rossrossBMö v(PP€ €€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿòÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿòÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝò"òò"ÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝòÿòòÿ/ÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿ/òòÿ/ÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿòòòÿ/ÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝò"òò"ÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿòÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝüÿüÌÿÏüÌÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝüÿÏÿÏÏÏüÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝüÿÏÿÏÏÏüÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝüÏÏÿÏÏÏüÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝüÿüÌÿÏüÌÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝüÿÿÿÿÏÿüÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÏÿÿÿÏÿüÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿŸÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿŸÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝùÿŸùÿ™Ÿ™ŸÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝùÿŸùùÿŸŸùÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝùÿŸùÿ™ŸŸùð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝùÿŸùÿÿŸŸùðÿðÿ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝù™™Ÿÿ™ÿ™Ÿðÿ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿððÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿðÿ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐ ÝÐ ÝÐ ÝÝÝ ÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝ ÐÝÝÐ ÝÝÐÝÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÐ Ð ÝÝÝÐ ÝÝ Ð Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÐ ÐÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÐ ÝÝÝÐ ÝÝ Ý ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð ÝÝÝÝÐ ÝÝ Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ð ÝÝ ÐÝÝÝÐ Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÐ ÐÝÝÐÝÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÐ Ý ÝÐÝ ÝÝ ÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/newtypeb.bmp0000644006511100651110000000033607235676737021452 0ustar rossrossBMÞv( h€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿfffffffogwwwvffogÝÝÝÝffogßýßýffogßýßýffogßýÿýffogßÿßýffogßÿßýffogßýßýffogßýßýffofÝÝÝÝffofffffffofffffff`hugs98-plus-Sep2006/src/winhugs/resource/noassign.ico0000644006511100651110000000137607235676737021437 0ustar rossross è( @€€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ™™™™ ™™™™™™™™™™™™™™™™™™™™™™™™ ™™™ÿÿÿÿ™™™™™™ÿÿÿÿÿÿ™™™™™Ÿÿÿÿÿÿÿù™™ ™™™ÿÿÿÿÿÿÿ™™™™ù™Ÿÿÿÿÿÿÿù™™™™ÿ™™ÿÿÿÿÿÿÿ™™™™ÿ ™Ÿÿÿÿÿÿÿ™™ ™Ÿð™™ù™ ™Ÿð ™ù™ ™Ÿÿÿ™™ÿÿÿÿÿù™ ™Ÿÿÿÿù™Ÿÿÿÿÿù™ ™Ÿÿÿÿÿ™™Ÿÿÿÿù™ ™Ÿÿÿÿù™™ÿÿÿù™ ™Ÿð ™ù™ ™Ÿð™™ù™™™ÿÿÿÿÿù™Ÿÿ™™™™ÿÿÿÿÿÿÿ™™ÿ™™™™Ÿÿÿÿÿÿÿù™Ÿ™™ ™™ÿÿÿÿÿÿÿ™™™™™Ÿÿÿÿÿÿÿù™™™™™ÿÿÿÿÿÿ™™™ ™™™ÿÿÿÿ™™™™™™™™™™™™™™™™™™™™™ ™™™™™™™™™™ÿÿÿÿÿðÿÿ€ÿÿÿü?øððàÀÀÀ€€€€€€€€ÀÀÀàððøü?ÿÿÿ€ÿÿðÿÿÿÿÿhugs98-plus-Sep2006/src/winhugs/resource/openfile.bmp0000644006511100651110000000051607235676737021416 0ustar rossrossBMNv(Ø€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÝÝÝÐ3333 ÝÝа33330ÝÝÐû3333 Ýп°33330ÝÐûû п¿¿¿¿ ÝÝÐûûûûû ÝÝп° ÝÝÝ ÝÝÝÐÝÝÝÝÝÝÝÝÝÝÝÝÝÐÝÐÐÝÝÝÝÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/openproj.bmp0000644006511100651110000000051607235676737021451 0ustar rossrossBMNv(Ø€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÐÝÝÝÐ3333 ÝÝÐ33330ÝÝÐ3333 Ýа033330ÝÐð3 п3333 ÝÐûÝп¿¿¿¿ ÝÝÐûûûûû ÝÝÐ ÝÝÝ ÝÝÝÔDÝÝÝÝÝÝÝÝDÝÝÝÝÝÔÝÔÔÝÝÝÝÝÝDMÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/optionsb.bmp0000644006511100651110000000051607235676737021452 0ustar rossrossBMNv(Ø€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÎÝÝÝÝÝÝÝÜÌíÝÝÝÝÝÝÌÌíÝÝÝÝÝÜÌìÎÝ ÝÝÝÌÎÝÌÐ ÝÝÝÌÎÝÐÝÝÝÝÜíÝðÝÝÝÝÝÝÐ íÝÝÝÝÐÿ ÎÝÝÝÝðÝÎÝÝÝÐ3ðÝÜíÝÝ3° ÝÝÎÝÐ3;» ÝÝÜí3»°ÝÝÝÝÎ3;» ÝÝÝÝÜ3»°ÝÝÝÝÝÝ;» ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/optionsd.bmp0000644006511100651110000000636607235676737021465 0ustar rossrossBMö v(PP€ €€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÑÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÎÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿüÎïÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÌÌîÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿüÌÌÎïÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÌÌìÌîÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿüÌÎÿÌÀÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÌÌÎÿðïÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿüÌÌïÿðÎÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿð ÎÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿðÿÌïÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿðÿÌïÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿð3ðÿüÎÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿ3°ÿÿÌïÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿð3;»ÿÿüÎÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿ3»°ÿÿÿÿÌÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿð3;»ÿÿÿÿüÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ3»°ÿÿÿÿÿÿÏððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ3;»ÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ3»°ÿÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ;»ÿÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ»°ÿÿÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÐÝÝÝÝÝÝÝÝÝÝÝ Ý Ý Ð ÝÐ ÝÝÐ Ð ÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÐÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝ Ð ÝÐ ÝÝÐ Ð Ý Ð ÝÝÐ ÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÐ ÝÝÝÝÝÝÐÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝ Ý ÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝ ÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/pastebut.bmp0000644006511100651110000000051607235676737021444 0ustar rossrossBMNv(Ø€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÔDDDDMÝÝÝÔÿÿÿÿMÝÝÝÔôDDOMÝÿÿÿÿMЃƒ„ôDDOMÐ884ÿÿÿÿMЃƒ„ôDôDMÐ884ÿÿôôÝЃƒ„ÿÿôMÝÐ884DDD ÝЃƒƒƒƒƒ ÝÐ8ˆ ÝЃwwpƒ ÝÐ80° 8 ÝÝ °ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/primbmp.bmp0000644006511100651110000000033607235676737021263 0ustar rossrossBMÞv( h€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿfffffffohˆˆˆ†ffoh™™™™ffohŸù™™ffohŸù™™ffohŸù™™ffohŸÿÿ™ffohŸùŸùffohŸùŸùffohŸÿÿ™ffof™™™™ffofffffffofffffff`hugs98-plus-Sep2006/src/winhugs/resource/pushedbu.bmp0000644006511100651110000000061207235676737021431 0ustar rossrossBMŠv(€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßÝÝÝÝÝÝÝÝÝÝßßhugs98-plus-Sep2006/src/winhugs/resource/relobutt.bmp0000644006511100651110000000051607235676737021455 0ustar rossrossBMNv(ØÄÄ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝ  Ý ªÝÝÝ  Ý ªª ÝÝÐ Ý ª ÝÝÝÝÝÝЪ ÝÝÝÝÝÝÝ ª ÝÝ ÝÝÝЪ ÝРÝÝÝЪ Ý ª ÝÝЪ Ъª ÝÝЪ Ý ª ÝÝ ª ÝЪ ÝЪ ÝÝЪª ª ÝÝÝ ªªªª ÝÝÝÝ ªªÝÝÝÝÝÐÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/resizeco.bmp0000644006511100651110000000035607235676737021442 0ustar rossrossBMîv(x€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÐñññÝÐßßßÝÐÝñññÐÝßßßÐÝÝñññÐÝÝßßßÐÝÝÝññÐÝÝÝßßÐÝÝÝÝññÐÝÝÝÝßßÐÝÝÝÝÝñÐÝÝÝÝÝßÐÝÝÝÝÝÝñÐÝÝÝÝÝÝßÐhugs98-plus-Sep2006/src/winhugs/resource/rt_manif.bin0000644006511100651110000000072210305571173021361 0ustar rossross hugs98-plus-Sep2006/src/winhugs/resource/runbutto.bmp0000644006511100651110000000051607235676737021477 0ustar rossrossBMNv(Ø€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÐÝÝÝÝ ÝÝÐÝÝÝÝÐÐÝÝ ÝÝÝÝ ÐÝÝÝÝÝ ÐÐ ÝÝÝÝÝÝÝÝÝÝÝÚÝÝÝ ÝÝÝÝ­ÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝ­ ÝÐ ÝÐÝÚÝÐÝÐÝ ­ÝÝ ÐÝÐÝÚÝÐ ÝÝÝ­ÝÝÝÐÝÝÝÚÝÚÝÚÐÝÝ­Ý­Ý­ÐÝÝÝÚÝÚÝÐ ÝÝ­Ý­ÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/selector.bmp0000644006511100651110000000033607235676737021435 0ustar rossrossBMÞv( h€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿfffffffhgwwwvff`g3333ff`g3ÿÿ3ff`g?ó?óff`g33?óff`g3?ÿ3ff`g?ó33ff`g?ó?óffag3ÿÿ3ff`f3333ff`fffffff`fffffff`hugs98-plus-Sep2006/src/winhugs/resource/smanbutt.bmp0000644006511100651110000000051607235676737021452 0ustar rossrossBMNv(Ø€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÝ ÝÝÝÿÿÿÿ ÝÝÿÿÿÿ ÝmalÝÿÿÿÿ  Ýÿÿÿÿ Ýÿÿÿÿ Ýÿÿÿÿ malÝÿÿÿÿ  Ýÿÿÿÿ Ýÿÿð Ýÿÿððÿ ahoÝÿÿðÿ Ýÿÿ õÿÝÝÿÿÿÿ ÝÝ a ÝÝÝÿÿÿÿ ª­ÝÝÝ ÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/smand.bmp0000644006511100651110000000636607235676737020730 0ustar rossrossBMö v(PP€ €€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿðÿðÿ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿðð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿððÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿðÿ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÿÿÿÿÿÿÿÿÿð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ý Ð Ð Ý Ý ÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð ÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð ÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð ÝÐ Ð Ð ÝÐ Ð Ð Ð ÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð ÝÐ Ð Ð ÝÐ Ð Ð Ð Ð ÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð ÐÝÝÝÝÝÝÝÝÝÝÝÝÐÝÝ ÝÝÐÝÝÝÝ ÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÐÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð ÝÝÝ Ý Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ð Ð Ð Ð Ð Ð Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ð Ð Ð Ð Ð Ð Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ð Ð Ð Ð Ð Ð Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÝÝ ÝÝÝ Ð Ð Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÝÝ ÝÝÝÝÝÝÐ ÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐ ÝÝÝÝÝÝÐ ÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐ ÝÝÝÝÝÝÐ ÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/stopbutt.bmp0000644006511100651110000000051607235676737021501 0ustar rossrossBMNv(Ø€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝ ™™™ÝÝÝЙ™™™™ ÝÝ ™™™™™ÝЙ™™™™™™ ÿ™ù™ùŸ™ Ÿ™ùŸŸŸ™ Ÿ™ùŸŸŸ™ ÿ™ùŸŸŸÿ ù™ùŸŸŸŸ ÿŸÿ™ùŸùЙ™™™™™™ Ý ™™™™™ÝÝЙ™™™™ ÝÝÝ ™™™ÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/synonym.bmp0000644006511100651110000000033607235676737021331 0ustar rossrossBMÞv( h€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿfffffffohˆˆˆ†ffoh™™™™ffoh™ÿÿ™ffohŸùŸùffoh™™Ÿùffoh™Ÿÿ™ffohŸù™™ffohŸùŸùffoh™ÿÿ™ffof™™™™ffofffffffofffffff`hugs98-plus-Sep2006/src/winhugs/resource/toolbar.bmp0000644006511100651110000000313610307566641021242 0ustar rossrossBM^v(¢è€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÔDDDDÝÝÝÝÔDDDDMÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÝÝÝÝÝ ÝÝÝÝ€ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÔMÝÝÝÝÝÝÝÝÔÿÿÿôÝÝÝÝÔÿÿÿÿMÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿðÝÝÝÝ Ð ÝÝÿÿÿ0=ÝÐÝÝÝÝÝMÔÝDÝÝÝÝÝÝÔðôÝÝÝÝÔôDDOMÝÝÝÔÝÝÝÝÝÝÝÔDDDMÝÝÝÐÿÿòÿÿðÝÝÓ°030ÝÝÿÿÿ » ÝÐ3333 ÝÝÝÝMÔÔÝMÝÝÐÿÿÿôÝÝÿÿÿÿMÝÝÝÔMÝÝÝÝÝÝÔDDDMÝÝÝÐÿÿ"ÿÿðÝÝÓ°3? 30ÝÝøˆ » Ýа33330ÝÝÝÝMÔÔÝMÝÝÐÿÿôðôÝЃƒ„ôDDOMÝÝÝÔDÝÝÝÝÝÝÔDDDMÝÝÝÐÿò""ÿðÝØ»70?pÝÝÿÿÿ0=ÝÐû3333 ÝÝÝÔDÔÝMÝÝÐðÿÿÿôÝÐ884ÿÿÿÿMÝÝÝÔDMÝÝÝÝÝÔDDDMÝÝÝÐÿÿ"ÿ/ðÝÐ3ÿ»û³ ÝøˆðÝÝÝп°33330ÝÝÝÝÔÔDÝÝÝÐÿÿôðôÝЃƒ„ôDôDMÝÝÝÔDDÝÝÝÝÝÔDDDMÝÝÝÐÿÿòÿ/ðÝÐ3?°{ Ýÿÿÿ8ˆÝÐûû ÝÝÝÔÝÝÝÝÐðÿÿÿôÝÐ884ÿÿôôÝÝÝÝÔDMÝÝÝÝÝÔDDDMÝÝÝÐÿ/ÿÿ/ðÝÓóûˆø€;û Ýøˆ;· Ýп¿¿¿¿ ÝÝÝÝÝÝ ÝÝÝÝÐÿÿôðDDÝЃƒ„ÿÿôMÝÝÝÝÔDÝÝÝÝÝÝÔDDDMÝÝÝÐÿ/òÿÿðÝÓ3?ˆ÷€‹pÝÝÿÿ€;»pÝÐûûûûû ÝÝÝÝÝÐÝÝÝÝÐðÿÿOMÝÐ884DDD ÝÝÝÝÔMÝÝÝÝÝÝÔDDDMÝÝÝÐÿ/ò/ÿðÝÝÐ?øø€û0ÝÝÿÿÿ𻷠п° ÝÝÝÝÝÐÐÝÝÝÝÐÿÿôÿÿDÝÝЃƒƒƒƒƒ ÝÝÝÝÔÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿò""ÿðÝÝÓû¸÷€?°ÝÝÿp8 » Ý ÝÝÝÐÝÝÝÝÐ ÝÝÝÐðDDMÝÝÐ8ˆ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿò/ÿðÝÝÝ3ˆx€ƒÝ݈ˆ€»x‡» ÝÝÝÝÝÝÝÝÝÝÝ Ý ÝÝÝÐÿÿ ÝÝÝÝЃwwpƒ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿòÿÝÝÝÝØÿpÝÝÝÝÝÝÓ»³;» ÝÝÝÝÐÝÐÐÝÝÝÝ Ý ÝÝÝÐÿÿÝÝÝÝÝÐ80° 8 ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿ ÝÝÝÝ݈ÝÝÝÝÝÝÝ;»»·ÝÝÝÝÝ ÝÝÝÝÝ Ý ÝÝÝÐ ÝÝÝÝÝÝ °ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÓ»»sÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝ33=ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/tyconsdl.bmp0000644006511100651110000001146607235676737021462 0ustar rossrossBM6v(xPÀ€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÑÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐðÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ ÌÌÌÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ ÌÌÌÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿðÌÌÀÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿðÌÌÀÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿ ÌÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿ ÌÿðððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿðÀÿÿ𪪪ªððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿ𪪪ªððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿ𪪪ªððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿ𪪪ªððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿ𪪪ªððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿ𪪪ªððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿ𪪪ªððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿ𪪪ªððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿðððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿðÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿ ™™ÿÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿð™™™™ÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ ™™™™ÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ ™™™™ÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ ™™™™ÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿ ™™™™ÿÿÿÿÿððÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿð™™™™ÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿ ™™ÿÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿðÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÿ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿðÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐÿÿÿÿÿÿÿÿÿÿÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝ ÝÝÝÝÝÝÝÐÝÝ ÝÝÐ ÝÝ ÝÝ ÝÝÝÝÝÐÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝ Ð ÝÝÝÐÝÐ Ð ÝÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝ ÐÝÝÝÝÝÐ Ð ÝÝÝÝÐÝ Ð Ð Ý ÐÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐÝÝÝÝÝÝÝÝÐ Ð ÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÐÝÐ ÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÐÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝ ÐÝ ÝÝÝÐ Ð Ý ÝÝÝÝ Ð Ð Ý ÐÝ ÝÝÐ ÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÐ ÝÝ ÝÝÝÐ Ð Ý ÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐÝÝÝÝÐ ÝÐÝ Ð ÝÝÝÝÝ ÝÝÝÐ ÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝ ÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝ ÝÐ ÝÝÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝ ÝÐÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐÝÐÝ ÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐ ÝÐ ÝÐ Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÐ ÝÐ ÝÐ ÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÐ Ð ÝÐ ÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÐ ÐÝ Ð ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÐ ÝÝÐÝÝ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÐ ÝÝÐ ÝÝÐÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÐ ÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝÝhugs98-plus-Sep2006/src/winhugs/resource/typecons.bmp0000644006511100651110000000033607235676737021461 0ustar rossrossBMÞv( h€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿfffffffohˆˆˆ†ffohÌÌÌÌffohÏÿÿÌffohÏüÏüffohÏüÏüffohÏüÏüffohÏüÏüffohÏüÏüffohÏÿÿÌffofÌÌÌÌffofffffffofffffff`hugs98-plus-Sep2006/src/winhugs/resource/typesinb.bmp0000644006511100651110000000033607235676737021452 0ustar rossrossBMÞv( h€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿfffffffohˆˆˆ†ffoh™™™™ffoh™ÿÿ™ffohŸùŸùffoh™™Ÿùffoh™Ÿÿ™ffohŸù™™ffohŸùŸùffoh™ÿÿ™ffof™™™™ffofffffffofffffff`hugs98-plus-Sep2006/src/winhugs/resource/winhugs.manifest0000644006511100651110000000072210305571173022304 0ustar rossross hugs98-plus-Sep2006/src/winhugs/resource/world.ico0000644006511100651110000000137607235676737020745 0ustar rossross è( @€€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿ™™™™™™™ ™™™@H ™™™™™˜D„ ™™™ ™”„„H™™I™H„™€ @™™€HHH™A™„™™E@D™˜D€™„@I™”„„‰”ˆD @€A‰™˜D@I˜ˆ@€@HDD™™HHI˜ƒP@„@„™™D™Aˆ„„„D@I™˜D™ˆˆˆD„€„D‰™”H™ˆ84„H@HHI™™„™ˆˆˆ@@D„T™™I™€ƒˆ„€HHHHH™™™˜ˆˆ„€D@DÉ™™˜ˆˆ@D„„„Y™™˜ˆˆ„€€HDEDD™™€ˆˆˆ€DHD€„ˆ™™ˆ€ˆˆˆ€€HˆˆˆŒ‰™ˆˆ„ˆHˆˆ8Hˆ‰™Œˆˆ@D˜ˆ„ÈÉ™\„ED€DˆƒƒˆŒ‰™ÀD„€°€ˆˆˆˆ‰”„HK °  ˆˆˆI˜E@H°°°‰˜ˆ„™”@„„¿ˆˆˆ™HHD»»û»™Hˆ‰™@DH¿ ˜H™œ„H°°° ™™™˜À ° ™™™°Àÿø >ÿÿ€qþyü<øðààÀÀÀÀ€À€€ÀÀÀààððøü#þÿãÿ€Õÿ€¶ÿÀÿ÷hugs98-plus-Sep2006/src/winhugs/uninstaller/0000755006511100651110000000000010504340137017573 5ustar rossrosshugs98-plus-Sep2006/src/winhugs/uninstaller/Header.h0000644006511100651110000000044710331670527021150 0ustar rossross#define WIN32_MEAN_AND_LEAN #include const int MyMaxPath = MAX_PATH * 2; typedef DWORD u32; typedef BYTE u8; typedef UINT uint; void InitCRC(); u32 GetCRC(); void CRC(const u8* buf, uint len); void DeleteOnReboot(LPCTSTR File); BOOL RegDelnode (HKEY hKeyRoot, LPTSTR lpSubKey); hugs98-plus-Sep2006/src/winhugs/uninstaller/CRC.cpp0000644006511100651110000001057510331471312020714 0ustar rossross#include "Header.h" //Create a CRC value for a buffer //First define the table const u32 CrcTable[256] = { 0x00000000L, 0x77073096L, 0xee0e612cL, 0x990951baL, 0x076dc419L, 0x706af48fL, 0xe963a535L, 0x9e6495a3L, 0x0edb8832L, 0x79dcb8a4L, 0xe0d5e91eL, 0x97d2d988L, 0x09b64c2bL, 0x7eb17cbdL, 0xe7b82d07L, 0x90bf1d91L, 0x1db71064L, 0x6ab020f2L, 0xf3b97148L, 0x84be41deL, 0x1adad47dL, 0x6ddde4ebL, 0xf4d4b551L, 0x83d385c7L, 0x136c9856L, 0x646ba8c0L, 0xfd62f97aL, 0x8a65c9ecL, 0x14015c4fL, 0x63066cd9L, 0xfa0f3d63L, 0x8d080df5L, 0x3b6e20c8L, 0x4c69105eL, 0xd56041e4L, 0xa2677172L, 0x3c03e4d1L, 0x4b04d447L, 0xd20d85fdL, 0xa50ab56bL, 0x35b5a8faL, 0x42b2986cL, 0xdbbbc9d6L, 0xacbcf940L, 0x32d86ce3L, 0x45df5c75L, 0xdcd60dcfL, 0xabd13d59L, 0x26d930acL, 0x51de003aL, 0xc8d75180L, 0xbfd06116L, 0x21b4f4b5L, 0x56b3c423L, 0xcfba9599L, 0xb8bda50fL, 0x2802b89eL, 0x5f058808L, 0xc60cd9b2L, 0xb10be924L, 0x2f6f7c87L, 0x58684c11L, 0xc1611dabL, 0xb6662d3dL, 0x76dc4190L, 0x01db7106L, 0x98d220bcL, 0xefd5102aL, 0x71b18589L, 0x06b6b51fL, 0x9fbfe4a5L, 0xe8b8d433L, 0x7807c9a2L, 0x0f00f934L, 0x9609a88eL, 0xe10e9818L, 0x7f6a0dbbL, 0x086d3d2dL, 0x91646c97L, 0xe6635c01L, 0x6b6b51f4L, 0x1c6c6162L, 0x856530d8L, 0xf262004eL, 0x6c0695edL, 0x1b01a57bL, 0x8208f4c1L, 0xf50fc457L, 0x65b0d9c6L, 0x12b7e950L, 0x8bbeb8eaL, 0xfcb9887cL, 0x62dd1ddfL, 0x15da2d49L, 0x8cd37cf3L, 0xfbd44c65L, 0x4db26158L, 0x3ab551ceL, 0xa3bc0074L, 0xd4bb30e2L, 0x4adfa541L, 0x3dd895d7L, 0xa4d1c46dL, 0xd3d6f4fbL, 0x4369e96aL, 0x346ed9fcL, 0xad678846L, 0xda60b8d0L, 0x44042d73L, 0x33031de5L, 0xaa0a4c5fL, 0xdd0d7cc9L, 0x5005713cL, 0x270241aaL, 0xbe0b1010L, 0xc90c2086L, 0x5768b525L, 0x206f85b3L, 0xb966d409L, 0xce61e49fL, 0x5edef90eL, 0x29d9c998L, 0xb0d09822L, 0xc7d7a8b4L, 0x59b33d17L, 0x2eb40d81L, 0xb7bd5c3bL, 0xc0ba6cadL, 0xedb88320L, 0x9abfb3b6L, 0x03b6e20cL, 0x74b1d29aL, 0xead54739L, 0x9dd277afL, 0x04db2615L, 0x73dc1683L, 0xe3630b12L, 0x94643b84L, 0x0d6d6a3eL, 0x7a6a5aa8L, 0xe40ecf0bL, 0x9309ff9dL, 0x0a00ae27L, 0x7d079eb1L, 0xf00f9344L, 0x8708a3d2L, 0x1e01f268L, 0x6906c2feL, 0xf762575dL, 0x806567cbL, 0x196c3671L, 0x6e6b06e7L, 0xfed41b76L, 0x89d32be0L, 0x10da7a5aL, 0x67dd4accL, 0xf9b9df6fL, 0x8ebeeff9L, 0x17b7be43L, 0x60b08ed5L, 0xd6d6a3e8L, 0xa1d1937eL, 0x38d8c2c4L, 0x4fdff252L, 0xd1bb67f1L, 0xa6bc5767L, 0x3fb506ddL, 0x48b2364bL, 0xd80d2bdaL, 0xaf0a1b4cL, 0x36034af6L, 0x41047a60L, 0xdf60efc3L, 0xa867df55L, 0x316e8eefL, 0x4669be79L, 0xcb61b38cL, 0xbc66831aL, 0x256fd2a0L, 0x5268e236L, 0xcc0c7795L, 0xbb0b4703L, 0x220216b9L, 0x5505262fL, 0xc5ba3bbeL, 0xb2bd0b28L, 0x2bb45a92L, 0x5cb36a04L, 0xc2d7ffa7L, 0xb5d0cf31L, 0x2cd99e8bL, 0x5bdeae1dL, 0x9b64c2b0L, 0xec63f226L, 0x756aa39cL, 0x026d930aL, 0x9c0906a9L, 0xeb0e363fL, 0x72076785L, 0x05005713L, 0x95bf4a82L, 0xe2b87a14L, 0x7bb12baeL, 0x0cb61b38L, 0x92d28e9bL, 0xe5d5be0dL, 0x7cdcefb7L, 0x0bdbdf21L, 0x86d3d2d4L, 0xf1d4e242L, 0x68ddb3f8L, 0x1fda836eL, 0x81be16cdL, 0xf6b9265bL, 0x6fb077e1L, 0x18b74777L, 0x88085ae6L, 0xff0f6a70L, 0x66063bcaL, 0x11010b5cL, 0x8f659effL, 0xf862ae69L, 0x616bffd3L, 0x166ccf45L, 0xa00ae278L, 0xd70dd2eeL, 0x4e048354L, 0x3903b3c2L, 0xa7672661L, 0xd06016f7L, 0x4969474dL, 0x3e6e77dbL, 0xaed16a4aL, 0xd9d65adcL, 0x40df0b66L, 0x37d83bf0L, 0xa9bcae53L, 0xdebb9ec5L, 0x47b2cf7fL, 0x30b5ffe9L, 0xbdbdf21cL, 0xcabac28aL, 0x53b39330L, 0x24b4a3a6L, 0xbad03605L, 0xcdd70693L, 0x54de5729L, 0x23d967bfL, 0xb3667a2eL, 0xc4614ab8L, 0x5d681b02L, 0x2a6f2b94L, 0xb40bbe37L, 0xc30c8ea1L, 0x5a05df1bL, 0x2d02ef8dL }; //One atomic operation #define DO1(buf) CRC32(*buf++) #define DO2(buf) DO1(buf); DO1(buf) #define DO4(buf) DO2(buf); DO2(buf) #define DO8(buf) DO4(buf); DO4(buf) //Local variable holding the CRC value: u32 CrcRegister; void inline CRC32(u8 b) { CrcRegister = CrcTable[((int)CrcRegister ^ b) & 0xff] ^ (CrcRegister >> 8); } void InitCRC() { //Do the inversion at this stage, save the odd clock cycle CrcRegister = 0xffffffffL; } u32 GetCRC() { return ~CrcRegister; } void CRC(const u8* buf, uint len) { //crc - the shift register //buf - the buffer containing the data //len - the length of the buffer // Run a set of bytes through the crc shift register. If buf is a NULL // pointer, then initialize the crc shift register contents instead. // Return the current crc in either case. if (buf == NULL) return; //unroll the loops for (; len >= 8; len -= 8) { //Will be expanded to 8 different calls DO8(buf); } for (; len /* >= 1 */; len--) { DO1(buf); } } hugs98-plus-Sep2006/src/winhugs/uninstaller/DeleteOnReboot.cpp0000644006511100651110000001054010331655776023171 0ustar rossross #include "Header.h" // Code take from NSIS, which has a compatible license // http://nsis.sourceforge.net/ void MoveFileOnReboot(LPCTSTR pszExisting, LPCTSTR pszNew); void DeleteOnReboot(LPCTSTR File) { MoveFileOnReboot(File, NULL); } #define NSISCALL #define CHAR2_TO_WORD(a,b) (((WORD)(a))|((b)<<8)) #define CHAR4_TO_DWORD(a,b,c,d) (((DWORD)CHAR2_TO_WORD(a,b))|(CHAR2_TO_WORD(c,d)<<16)) void * NSISCALL myGetProcAddress(char *dll, char *func) { HMODULE hModule = GetModuleHandle(dll); if (!hModule) hModule = LoadLibrary(dll); if (!hModule) return NULL; return GetProcAddress(hModule, func); } HANDLE NSISCALL myOpenFile(const char *fn, DWORD da, DWORD cd) { int attr = GetFileAttributes(fn); return CreateFile( fn, da, FILE_SHARE_READ, NULL, cd, attr == INVALID_FILE_ATTRIBUTES ? 0 : attr, NULL ); } char * NSISCALL mystrcat(char *out, const char *concat) { return lstrcat(out, concat); } int NSISCALL mystrlen(const char *in) { return lstrlen(in); } char * NSISCALL mystrstri(char *a, char *b) { int l = mystrlen(b); while (mystrlen(a) >= l) { char c = a[l]; a[l] = 0; if (!lstrcmpi(a, b)) { a[l] = c; return a; } a[l] = c; a = CharNext(a); } return NULL; } char * NSISCALL mystrcpy(char *out, const char *in) { return lstrcpy(out, in); } void mini_memcpy(void *o,void*i,int l) { char *oo=(char*)o; char *ii=(char*)i; while (l-- > 0) *oo++=*ii++; } void NSISCALL MoveFileOnReboot(LPCTSTR pszExisting, LPCTSTR pszNew) { BOOL fOk = 0; typedef BOOL (WINAPI *mfea_t)(LPCSTR lpExistingFileName,LPCSTR lpNewFileName,DWORD dwFlags); mfea_t mfea; mfea=(mfea_t) myGetProcAddress("KERNEL32.dll","MoveFileExA"); if (mfea) { fOk=mfea(pszExisting, pszNew, MOVEFILE_DELAY_UNTIL_REBOOT|MOVEFILE_REPLACE_EXISTING); } if (!fOk) { static char szRenameLine[1024]; static char wininit[1024]; static char tmpbuf[1024]; int cchRenameLine; char *szRenameSec = "[Rename]\r\n"; HANDLE hfile, hfilemap; DWORD dwFileSize, dwRenameLinePos; int spn; *(DWORD*)tmpbuf = CHAR4_TO_DWORD('N', 'U', 'L', 0); if (pszNew) { // create the file if it's not already there to prevent GetShortPathName from failing CloseHandle(myOpenFile(pszNew,0,CREATE_NEW)); spn = GetShortPathName(pszNew,tmpbuf,1024); if (!spn || spn > 1024) return; } // wininit is used as a temporary here spn = GetShortPathName(pszExisting,wininit,1024); if (!spn || spn > 1024) return; cchRenameLine = wsprintf(szRenameLine,"%s=%s\r\n",tmpbuf,wininit); GetWindowsDirectory(wininit, 1024-16); mystrcat(wininit, "\\wininit.ini"); hfile = CreateFile(wininit, GENERIC_READ | GENERIC_WRITE, 0, NULL, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL | FILE_FLAG_SEQUENTIAL_SCAN, NULL); if (hfile != INVALID_HANDLE_VALUE) { dwFileSize = GetFileSize(hfile, NULL); hfilemap = CreateFileMapping(hfile, NULL, PAGE_READWRITE, 0, dwFileSize + cchRenameLine + 10, NULL); if (hfilemap != NULL) { LPSTR pszWinInit = (LPSTR) MapViewOfFile(hfilemap, FILE_MAP_WRITE, 0, 0, 0); if (pszWinInit != NULL) { LPSTR pszRenameSecInFile = mystrstri(pszWinInit, szRenameSec); if (pszRenameSecInFile == NULL) { mystrcpy(pszWinInit+dwFileSize, szRenameSec); dwFileSize += 10; dwRenameLinePos = dwFileSize; } else { char *pszFirstRenameLine = pszRenameSecInFile+10; char *pszNextSec = mystrstri(pszFirstRenameLine,"\n["); if (pszNextSec) { char *p = ++pszNextSec; while (p < pszWinInit + dwFileSize) { p[cchRenameLine] = *p; p++; } dwRenameLinePos = pszNextSec - pszWinInit; } // rename section is last, stick item at end of file else dwRenameLinePos = dwFileSize; } mini_memcpy(&pszWinInit[dwRenameLinePos], szRenameLine, cchRenameLine); dwFileSize += cchRenameLine; UnmapViewOfFile(pszWinInit); //fOk++; } CloseHandle(hfilemap); } SetFilePointer(hfile, dwFileSize, NULL, FILE_BEGIN); SetEndOfFile(hfile); CloseHandle(hfile); } } //return fOk; } hugs98-plus-Sep2006/src/winhugs/uninstaller/LinkedList.cpp0000644006511100651110000000073510331471312022344 0ustar rossross #include "header.h" #include "LinkedList.h" LinkedList* NewLinkedList(void* Data, LinkedList* Next) { LinkedList* l = new LinkedList; l->Data = Data; l->Next = Next; return l; } void** LinkedListToArray(LinkedList* Data, int* Size) { //first count them up int n = 0; for (LinkedList* i = Data; i != NULL; i = i->Next) n++; *Size = n; void** Res = new void*[n]; int j = 0; for (LinkedList* i = Data; i != NULL; i = i->Next) Res[j++] = i->Data; return Res; } hugs98-plus-Sep2006/src/winhugs/uninstaller/LinkedList.h0000644006511100651110000000025210331471312022003 0ustar rossross struct LinkedList { void* Data; LinkedList* Next; }; LinkedList* NewLinkedList(void* Data, LinkedList* Next); void** LinkedListToArray(LinkedList* Data, int* Size); hugs98-plus-Sep2006/src/winhugs/uninstaller/LogReader.cpp0000644006511100651110000000502010331670473022147 0ustar rossross #include "header.h" #include "LogReader.h" #include "LinkedList.h" #include char* GetLine(char* Data, int* Pos) { char* Res = &Data[*Pos]; if (Res[0] == 0) return NULL; bool Flag = false; for (int i = *Pos; ; i++) { char c = Data[i]; if (c == '\r' || c == '\n') { Flag = true; Data[i] = 0; } else if (c == 0 || Flag == true) { *Pos = i; return Res; } } } void GetFields(char* Line, char** Fields) { int FieldNo = 1; Fields[0] = Line; for (char* i = Line; *i != 0; i++) { if (*i == '\t') { *i = 0; Fields[FieldNo++] = i+1; } } Fields[FieldNo] = NULL; Fields[FieldNo+1] = NULL; Fields[FieldNo+2] = NULL; } File* ReadLogFile(char** Fields, char* Path, char* Pointer) { char* s; File* f = new File; if (Fields[1][0] == '.' && Fields[1][1] == '\\') { strcpy(Pointer, &Fields[1][2]); f->FileName = strdup(Path); } else f->FileName = strdup(Fields[1]); f->Size = (Fields[2] ? atoi(Fields[2]) : -1); f->CRC = (Fields[3] ? strtoul(Fields[3], &s, 16) : 0); return f; } Registry* ReadLogReg(char** Fields) { Registry* r = new Registry; if (strcmp(Fields[1], "HKEY_CLASSES_ROOT") == 0) r->Root = HKEY_CLASSES_ROOT; else if (strcmp(Fields[1], "HKEY_LOCAL_MACHINE") == 0) r->Root = HKEY_LOCAL_MACHINE; else r->Root = NULL; r->Path = strdup(Fields[2]); return r; } Log* ReadLog(char* Directory, char* FileName) { HANDLE hFile = CreateFile(Directory, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hFile == INVALID_HANDLE_VALUE) return NULL; //now read the thing, line by line DWORD Size = GetFileSize(hFile, NULL); char* Data = new char[Size+1]; DWORD dw; ReadFile(hFile, Data, Size, &dw, NULL); CloseHandle(hFile); if (dw != Size) return NULL; Data[Size] = 0; LinkedList* Regs = NULL; LinkedList* Files = NULL; //now the thing is in memory, lets have a go at parsing int Pos = 0; while(true) { char* Line = GetLine(Data, &Pos); if (Line == NULL) break; char* Fields[10]; GetFields(Line, Fields); //ok, now parse a line if (Fields[0][0] == 0 || strcmp(Fields[0], "NOTE") == 0) ; //discard, a comment else if (strcmp(Fields[0], "FILE") == 0) Files = NewLinkedList(ReadLogFile(Fields, Directory, FileName), Files); else if (strcmp(Fields[0], "REG") == 0) Regs = NewLinkedList(ReadLogReg(Fields), Regs); } //now lets make a Log structure Log* log = new Log; log->Files = (File**) LinkedListToArray(Files, &log->nFile); log->Registrys = (Registry**) LinkedListToArray(Regs, &log->nRegistry); return log; } hugs98-plus-Sep2006/src/winhugs/uninstaller/LogReader.h0000644006511100651110000000056510331655705021626 0ustar rossross // all the data in these structures is intentionally leaked struct Registry { HKEY Root; char* Path; }; struct File { char* FileName; u32 CRC; //0 means no CRC int Size; //-1 means no size //flags for the program bool Modified; }; struct Log { int nRegistry; int nFile; Registry** Registrys; File** Files; }; Log* ReadLog(char* Directory, char* FileName); hugs98-plus-Sep2006/src/winhugs/uninstaller/Parameters.h0000644006511100651110000000121510331471312022044 0ustar rossross//These are configuration parameters //Default directory //The resulting value will be "C:\Program Files\" + Value #define InstallDir "WinHugs" //Primary program //This is the first file that will be checked for overwrite access //If this is the main .exe it will allow them first refusal if they are currently //running the program //Use NULL for no primary file #define PrimaryFile "WinHugs.exe" //Program name //Text of what your program is called #define ProgramName "WinHugs" #define Description "Haskell98 Interpreter" #define Copyright "1994-2005" #define Publisher "The Hugs Team" #define Website "http://www.haskell.org/hugs/" hugs98-plus-Sep2006/src/winhugs/uninstaller/ShellCode.cpp0000644006511100651110000000513510331670527022154 0ustar rossross// Copied from MSDN #include "Header.h" //************************************************************* // // RegDelnodeRecurse() // // Purpose: Deletes a registry key and all it's subkeys / values. // // Parameters: hKeyRoot - Root key // lpSubKey - SubKey to delete // // Return: TRUE if successful. // FALSE if an error occurs. // //************************************************************* BOOL RegDelnodeRecurse (HKEY hKeyRoot, LPTSTR lpSubKey) { LPTSTR lpEnd; LONG lResult; DWORD dwSize; TCHAR szName[MAX_PATH]; HKEY hKey; FILETIME ftWrite; // First, see if we can delete the key without having // to recurse. lResult = RegDeleteKey(hKeyRoot, lpSubKey); if (lResult == ERROR_SUCCESS) return TRUE; lResult = RegOpenKeyEx (hKeyRoot, lpSubKey, 0, KEY_READ, &hKey); if (lResult != ERROR_SUCCESS) { if (lResult == ERROR_FILE_NOT_FOUND) { return TRUE; } else { return FALSE; } } // Check for an ending slash and add one if it is missing. lpEnd = lpSubKey + lstrlen(lpSubKey); if (*(lpEnd - 1) != TEXT('\\')) { *lpEnd = TEXT('\\'); lpEnd++; *lpEnd = TEXT('\0'); } // Enumerate the keys dwSize = MAX_PATH; lResult = RegEnumKeyEx(hKey, 0, szName, &dwSize, NULL, NULL, NULL, &ftWrite); if (lResult == ERROR_SUCCESS) { do { lstrcpy (lpEnd, szName); if (!RegDelnodeRecurse(hKeyRoot, lpSubKey)) { break; } dwSize = MAX_PATH; lResult = RegEnumKeyEx(hKey, 0, szName, &dwSize, NULL, NULL, NULL, &ftWrite); } while (lResult == ERROR_SUCCESS); } lpEnd--; *lpEnd = TEXT('\0'); RegCloseKey (hKey); // Try again to delete the key. lResult = RegDeleteKey(hKeyRoot, lpSubKey); if (lResult == ERROR_SUCCESS) return TRUE; return FALSE; } //************************************************************* // // RegDelnode() // // Purpose: Deletes a registry key and all it's subkeys / values. // // Parameters: hKeyRoot - Root key // lpSubKey - SubKey to delete // // Return: TRUE if successful. // FALSE if an error occurs. // //************************************************************* BOOL RegDelnode (HKEY hKeyRoot, LPTSTR lpSubKey) { TCHAR szDelKey[2 * MAX_PATH]; lstrcpy (szDelKey, lpSubKey); return RegDelnodeRecurse(hKeyRoot, szDelKey); } hugs98-plus-Sep2006/src/winhugs/uninstaller/StartCode.cpp0000644006511100651110000002230310331670571022175 0ustar rossross#include "header.h" #include #include #include "LogReader.h" #include "LinkedList.h" #include "resource.h" #include "Parameters.h" #define ErrBox(Msg) MessageBox(hDlg, Msg, ProgramName " Installer", MB_ICONERROR) #define QuestBox(Msg, Flag) MessageBox(hDlg, Msg, ProgramName " Installer", MB_ICONQUESTION | Flag) #define InfoBox(Msg) MessageBox(hDlg, Msg, ProgramName " Installer", MB_ICONINFORMATION) // GLOBAL STATE HINSTANCE hInst; bool InDoEvents = false; Log* log; int State; // END GLOBAL STATE void CheckDeleteRights(HWND hDlg); void PerformUninstall(HWND hDlg); void DoEvents() { InDoEvents = true; MSG msg; while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE)) { TranslateMessage(&msg); DispatchMessage(&msg); } InDoEvents = false; } bool FileExists(LPCTSTR File) { return (GetFileAttributes(File) == INVALID_FILE_ATTRIBUTES ? false : true); } void PaintDialog(HWND hDlg) { const char* Msg = ProgramName " - " Description "\n© " Copyright; static int MsgLen = strlen(Msg); PAINTSTRUCT ps; HDC hDC = BeginPaint(hDlg, &ps); SelectObject(hDC, GetStockObject(DEFAULT_GUI_FONT)); RECT rc = {0, 0, 463, 54}; Rectangle(hDC, rc.left, rc.top, rc.right, rc.bottom); FillRect(hDC, &rc, (HBRUSH) GetStockObject(WHITE_BRUSH)); rc.top = 13; DrawText(hDC, Msg, MsgLen, &rc, DT_WORDBREAK | DT_CENTER); EndPaint(hDlg, &ps); } void InitDialog(HWND hDlg) { InitCommonControls(); } u32 CalcCRC(char* FileName) { HANDLE hFile = CreateFile(FileName, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hFile == INVALID_HANDLE_VALUE) return 0; DWORD Size = GetFileSize(hFile, NULL); InitCRC(); while (Size != 0) { DWORD dw; u8 Buffer[10000]; DWORD toRead = min(10000, Size); ReadFile(hFile, Buffer, toRead, &dw, NULL); Size -= dw; if (dw == 0) { CloseHandle(hFile); return 0; } CRC(Buffer, dw); } CloseHandle(hFile); return GetCRC(); } void EnableDlgItem(HWND hDlg, int ID, bool Enable) { EnableWindow(GetDlgItem(hDlg, ID), (Enable ? TRUE : FALSE)); } void ShowDlgItem(HWND hDlg, int ID, bool Show) { ShowWindow(GetDlgItem(hDlg, ID), (Show ? SW_SHOW : SW_HIDE)); } void CheckModified(HWND hDlg) { ShowDlgItem(hDlg, lblWelcome, false); EnableDlgItem(hDlg, IDOK, false); EnableDlgItem(hDlg, IDCANCEL, false); SetDlgItemText(hDlg, lblMessage, "Checking for modified files"); SendDlgItemMessage(hDlg, prgBar, PBM_SETRANGE, 0, MAKELPARAM(0, log->nFile)); ShowDlgItem(hDlg, lblMessage, true); ShowDlgItem(hDlg, prgBar, true); int Modified = 0; for (int i = 0; i < log->nFile; i++) { DoEvents(); File* f = log->Files[i]; f->Modified = false; if (f->CRC != 0) { u32 CRC = CalcCRC(f->FileName); if (CRC != 0 && f->CRC != CRC) { f->Modified = true; Modified++; SendDlgItemMessage(hDlg, lstItems, LB_ADDSTRING, 0, (LPARAM) f->FileName); } } SendDlgItemMessage(hDlg, prgBar, PBM_SETPOS, i, 0); } if (Modified != 0) { SetDlgItemText(hDlg, lblMessage, "Modified files found"); ShowDlgItem(hDlg, prgBar, false); EnableDlgItem(hDlg, IDOK, true); EnableDlgItem(hDlg, IDCANCEL, true); ShowDlgItem(hDlg, lstItems, true); ShowDlgItem(hDlg, chkDeleteModified, true); } else { State++; CheckDeleteRights(hDlg); } } void CheckDeleteRights(HWND hDlg) { EnableDlgItem(hDlg, IDOK, false); EnableDlgItem(hDlg, IDCANCEL, false); SetDlgItemText(hDlg, lblMessage, "Checking for locked files"); SendDlgItemMessage(hDlg, prgBar, PBM_SETRANGE, 0, MAKELPARAM(0, log->nFile)); ShowDlgItem(hDlg, lblMessage, true); ShowDlgItem(hDlg, prgBar, true); ShowDlgItem(hDlg, lstItems, false); SendDlgItemMessage(hDlg, lstItems, LB_RESETCONTENT, 0, 0); ShowDlgItem(hDlg, chkDeleteModified, false); int Locked = 0; for (int i = 0; i < log->nFile; i++) { DoEvents(); File* f = log->Files[i]; HANDLE hFile = CreateFile(f->FileName, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, 0, NULL); if (hFile != INVALID_HANDLE_VALUE) CloseHandle(hFile); else if (FileExists(f->FileName)) { Locked++; SendDlgItemMessage(hDlg, lstItems, LB_ADDSTRING, 0, (LPARAM) f->FileName); } SendDlgItemMessage(hDlg, prgBar, PBM_SETPOS, i, 0); } if (Locked != 0) { SetDlgItemText(hDlg, lblMessage, "The following files appear to be in use, continue?"); ShowDlgItem(hDlg, prgBar, false); EnableDlgItem(hDlg, IDOK, true); EnableDlgItem(hDlg, IDCANCEL, true); ShowDlgItem(hDlg, lstItems, true); } else { State++; PerformUninstall(hDlg); } } int compareStr(const void* a, const void* b) { return -strcmp(*((const char**) a), *((const char**) b)); } void PerformUninstall(HWND hDlg) { EnableDlgItem(hDlg, IDOK, false); EnableDlgItem(hDlg, IDCANCEL, false); SetDlgItemText(hDlg, lblMessage, "Deleting files"); SendDlgItemMessage(hDlg, prgBar, PBM_SETRANGE, 0, MAKELPARAM(0, log->nFile)); ShowDlgItem(hDlg, lblMessage, true); ShowDlgItem(hDlg, prgBar, true); ShowDlgItem(hDlg, lstItems, false); SendDlgItemMessage(hDlg, lstItems, LB_RESETCONTENT, 0, 0); bool DeleteModified = (IsDlgButtonChecked(hDlg, chkDeleteModified) == BST_CHECKED); LinkedList* Dirs = NULL; int Alive = 0; for (int i = 0; i < log->nFile; i++) { DoEvents(); File* f = log->Files[i]; if (!f->Modified || DeleteModified) f->Modified = (DeleteFile(f->FileName) ? false : true); if (f->Modified) { if (FileExists(f->FileName)) { Alive++; SendDlgItemMessage(hDlg, lstItems, LB_ADDSTRING, 0, (LPARAM) f->FileName); } else f->Modified = false; } if (!f->Modified) { // calculate all parent directories char Buffer[MAX_PATH], Buffer2[MAX_PATH]; char* in = Buffer; char* out = Buffer2; strcpy(in, f->FileName); char* c; while(strlen(in) > 2) { int res = GetFullPathName(in, MAX_PATH, out, &c); if (res == 0 || c == NULL) break; c[-1] = 0; Dirs = NewLinkedList(strdup(out), Dirs); char* t = in; in = out; out = t; } } SendDlgItemMessage(hDlg, prgBar, PBM_SETPOS, i, 0); } //now go on a directory hunt :) int n; char** DirList = (char**) LinkedListToArray(Dirs, &n); qsort(DirList, n, sizeof(char*), compareStr); //now delete all dupes int j = 0; for (int i = 1; i < n; i++) { if (strcmp(DirList[j], DirList[i]) != 0) DirList[++j] = DirList[i]; } n = j + 1; SetDlgItemText(hDlg, lblMessage, "Deleting directories"); for (int i = 0; i < n; i++) { DoEvents(); RemoveDirectory(DirList[i]); } SetDlgItemText(hDlg, lblMessage, "Deleting registry keys"); for (int i = 0; i < log->nRegistry; i++) { DoEvents(); RegDelnode(log->Registrys[i]->Root, log->Registrys[i]->Path); } if (Alive != 0) { SetDlgItemText(hDlg, lblMessage, "The following files were not deleted"); ShowDlgItem(hDlg, lstItems, true); } else { SetDlgItemText(hDlg, lblMessage, "WinHugs successfully uninstalled"); } ShowDlgItem(hDlg, prgBar, false); EnableDlgItem(hDlg, IDOK, true); SetDlgItemText(hDlg, IDOK, "Finish"); } int CALLBACK DlgFunc(HWND hDlg, UINT uMsg, WPARAM wParam, LPARAM lParam) { switch(uMsg) { case WM_PAINT: PaintDialog(hDlg); break; case WM_COMMAND: switch (LOWORD(wParam)) { case IDCANCEL: EndDialog(hDlg, 0); break; case IDOK: State++; switch (State) { case 1: CheckModified(hDlg); break; case 2: CheckDeleteRights(hDlg); break; case 3: PerformUninstall(hDlg); break; case 4: EndDialog(hDlg, 0); break; } break; } } return FALSE; } // Supported command lines // "" - the user ran the instance next to install.og // /del file - delete the file and exit // /run file - run with file as the uninstaller int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow) { char Self[MyMaxPath]; GetModuleFileName(hInstance, Self, MyMaxPath); if (strncmp(lpCmdLine, "/run ", 5) == 0) { char* OrigExe = &lpCmdLine[5]; char Buffer[MyMaxPath]; char* s; GetFullPathName(OrigExe, MyMaxPath, Buffer, &s); if (s == NULL) log = NULL; else { strcpy(s, "install.log"); log = ReadLog(Buffer, s); } if (log == NULL) MessageBox(NULL, "Failed to load uninstall file \"install.log\"", "WinHugs Uninstaller", MB_ICONERROR); else { InitCommonControls(); DialogBox(hInstance, MAKEINTRESOURCE(dlgInstall), NULL, DlgFunc); } bool Success = false; if (FileExists(OrigExe)) { strcpy(Buffer, "/del "); strcat(Buffer, Self); if ((int) ShellExecute(NULL, NULL, OrigExe, Buffer, NULL, SW_NORMAL) > 32) Success = true; } if (!Success) DeleteOnReboot(Self); } else if (strncmp(lpCmdLine, "/del ", 5) == 0) { //try and delete the file char* File = &lpCmdLine[5]; for (int i = 0; i < 30; i++) { DeleteFile(File); if (!FileExists(File)) break; } } else { char TempPath[MyMaxPath], TempFile[MyMaxPath]; GetTempPath(MyMaxPath, TempPath); GetTempFileName(TempPath, "HUG", 0, TempFile); strcat(TempFile, ".exe"); bool Success = false; if (CopyFile(Self, TempFile, FALSE)) { char CmdLine[MyMaxPath]; strcpy(CmdLine, "/run "); strcat(CmdLine, Self); if ((int) ShellExecute(NULL, NULL, TempFile, CmdLine, TempPath, nCmdShow) > 32) Success = true; } if (!Success) { MessageBox(NULL, "Failed to launch the uninstaller", "WinHugs Uninstaller", MB_ICONERROR); } } return 0; } hugs98-plus-Sep2006/src/winhugs/uninstaller/Uninstaller.rc0000644006511100651110000000603110331471312022417 0ustar rossross// Microsoft Visual C++ generated resource script. // #include "resource.h" #define APSTUDIO_READONLY_SYMBOLS ///////////////////////////////////////////////////////////////////////////// // // Generated from the TEXTINCLUDE 2 resource. // #include "afxres.h" ///////////////////////////////////////////////////////////////////////////// #undef APSTUDIO_READONLY_SYMBOLS ///////////////////////////////////////////////////////////////////////////// // English (U.K.) resources #if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENG) #ifdef _WIN32 LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_UK #pragma code_page(1252) #endif //_WIN32 #ifdef APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // TEXTINCLUDE // 1 TEXTINCLUDE BEGIN "resource.h\0" END 2 TEXTINCLUDE BEGIN "#include ""afxres.h""\r\n" "\0" END 3 TEXTINCLUDE BEGIN "\r\n" "\0" END #endif // APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // Dialog // dlgInstall DIALOGEX 0, 0, 308, 193 STYLE DS_SETFONT | DS_MODALFRAME | DS_FIXEDSYS | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "WinHugs Uninstaller" FONT 8, "MS Shell Dlg", 400, 0, 0x0 BEGIN CONTROL "",barTop,"Static",SS_ETCHEDHORZ,0,33,313,1 LTEXT "Do you want to uninstall WinHugs?\n\nIf you need to reinstall WinHugs, see http://www.haskell.org/hugs", lblWelcome,7,42,257,36 CONTROL "Progress2",prgBar,"msctls_progress32",NOT WS_VISIBLE,7, 54,294,12 CONTROL "",IDC_STATIC,"Static",SS_ETCHEDHORZ,-1,164,311,1 LTEXT "Windows Uninstaller © Neil Mitchell 1999-2005", IDC_STATIC,7,176,163,10,WS_DISABLED LTEXT "Initialisating",lblMessage,7,42,294,9,NOT WS_VISIBLE CONTROL 1003,IDC_STATIC,"Static",SS_BITMAP | SS_REALSIZEIMAGE, 280,7,21,20 DEFPUSHBUTTON "Uninstall",IDOK,251,172,50,14 PUSHBUTTON "Cancel",IDCANCEL,191,172,50,14 LISTBOX lstItems,7,54,294,95,LBS_NOINTEGRALHEIGHT | NOT WS_VISIBLE | WS_VSCROLL | WS_TABSTOP CONTROL "Delete modified files?",chkDeleteModified,"Button", BS_AUTOCHECKBOX | NOT WS_VISIBLE | WS_TABSTOP,7,152,239, 9 END ///////////////////////////////////////////////////////////////////////////// // // RT_MANIFEST // 1 RT_MANIFEST "WinHugs-Uninstaller.manifest" ///////////////////////////////////////////////////////////////////////////// // // Bitmap // bmpLogo BITMAP "logo.bmp" #endif // English (U.K.) resources ///////////////////////////////////////////////////////////////////////////// #ifndef APSTUDIO_INVOKED ///////////////////////////////////////////////////////////////////////////// // // Generated from the TEXTINCLUDE 3 resource. // ///////////////////////////////////////////////////////////////////////////// #endif // not APSTUDIO_INVOKED hugs98-plus-Sep2006/src/winhugs/uninstaller/Uninstaller.sln0000644006511100651110000000157210331471312022614 0ustar rossrossMicrosoft Visual Studio Solution File, Format Version 8.00 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "Uninstaller", "Uninstaller.vcproj", "{70CA98C8-54E7-4189-881D-498017510231}" ProjectSection(ProjectDependencies) = postProject EndProjectSection EndProject Global GlobalSection(SolutionConfiguration) = preSolution Debug = Debug Release = Release EndGlobalSection GlobalSection(ProjectConfiguration) = postSolution {70CA98C8-54E7-4189-881D-498017510231}.Debug.ActiveCfg = Debug|Win32 {70CA98C8-54E7-4189-881D-498017510231}.Debug.Build.0 = Debug|Win32 {70CA98C8-54E7-4189-881D-498017510231}.Release.ActiveCfg = Release|Win32 {70CA98C8-54E7-4189-881D-498017510231}.Release.Build.0 = Release|Win32 EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution EndGlobalSection GlobalSection(ExtensibilityAddIns) = postSolution EndGlobalSection EndGlobal hugs98-plus-Sep2006/src/winhugs/uninstaller/Uninstaller.vcproj0000644006511100651110000001214710331670527023334 0ustar rossross hugs98-plus-Sep2006/src/winhugs/uninstaller/WinHugs-Uninstaller.manifest0000644006511100651110000000073310331471312025206 0ustar rossross hugs98-plus-Sep2006/src/winhugs/uninstaller/logo.bmp0000644006511100651110000000606610331471312021241 0ustar rossrossBM6 6(  ÿÿÿÿÿÿÿÿÿÿÿÿæƒlãlMßdIßdIÛ\EÛ\EÛ\EÛ\E×UAÔK=×UAÒF:ÒF:ÔK=ÒF:ÒF:ÐC9ÐC9ÐC9Í:5Í:5Í:5Í:5Õa_ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿë´¦ãlMãlMßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÒF:×UAÒF:ÒF:ÔK=ÒF:ÒF:ÐC9ÐC9Í:5Í:5Í:5Í:5Í:5Í:5ߘ˜ÿÿÿÿÿÿÿÿÿë´¦ãlMãlMãlMßdIàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UAÔK=×UAÒF:ÒF:ÒF:ÒF:ÒF:ÐC9ÐC9ÐC9Í:5Í:5Í:5Í74Í74ߘ˜ÿÿÿÿÿÿí|VäsUäsUäsUàfKàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÒF:×UAÒF:ÒF:ÒF:ÒF:ÐC9ÐC9ÐC9ÐC9Í:5Í:5Í74Í74Í:5ÿÿÿì †äsUévRäsUäsUäsUàfKäsUßdIßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UAÔK=×UAÒF:ÒF:ÒF:ÒF:ÐC9ÐC9ÐC9Í:5Í:5Í:5Í74Í74Õa_í|Ví|VévRévRäsUäsUäsUàfKàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÔK=×UAÒF:ÒF:ÒF:ÐC9ÐC9ÐC9ÐC9Í:5Í:5Í:5Í74Í:5í|Ví|VäoQévRévRäsUäsUäsUàfKäsUßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÔK=ÒF:ÒF:ÒF:ÒF:ÐC9ÐC9ÐC9ÐC9Í:5Í:5Í:5Í74í|Ví|Ví|Ví|VévRévRäsUäsUäsUàfKàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÔK=ÔK=ÒF:×UAÒF:ÒF:Í:5Í:5Í:5Í:5Í:5Í:5ò†[í|Ví|Ví|VäoQévRévRäsUäsUäsUàfKäsUßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÔK=ÒF:ÒF:ÒF:ÒF:ÒF:ÒF:Í:5Í:5Í:5Í:5ò†[í[í|Ví|Ví|Ví|VäsUévRäsUäsUäsUàfKàfKßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÔK=ÔK=ÒF:ÔK=ÒF:ÒF:ÒF:Í:5Í:5Í:5ò†[ò†[ò†[í|Ví|Ví|Ví|VévRévRäsUäsUäsUàfKäsUßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÔK=ÒF:ÒF:ÒF:ÒF:ÒF:ÒF:Í:5ÒF:ò†[ò†[ò†[í[í|Ví|Ví|Ví|VäoQévRäsUäsUäsUàfKãlMßdIßdIßdIßdIÛ\EÛ\EÛ\E×UA×UAÒF:×UAÒF:ÒF:ÒF:ÒF:Í:5Í:5õ‹]ò†[ò†[ò†[ò†[í|Ví|Ví|Ví|Ví|VäsUäsUäsUäsUàfKãlMßdIßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAÒF:ÔK=ÒF:ÒF:ÒF:ÒF:ÒF:õ‹]ò†[õ‹]ò†[í|Vò†[í|Ví|Ví[ò¦ó²žî’täoQäsUäsUàfKãlMßdIäoQêœë¢”áwdÛ\E×UA×UA×UAÔK=ÔK=ÒF:ÔK=ÒF:ÒF:õ‹]õ‹]ò†[ò†[õ‹]í|Ví|VóŽfüëåþüüþüüþüüõõäsUäsUäsUãlMæƒlþôñþüüþüüþôñ뢔Û\EÛ\E×UA×UAÔK=ÒF:ÒF:ÒF:ÒF:õ‹]õ‹]õ‹]õ‹]ò†[ò†[ò†[ûÔÅþüüþüüþüüþüüþüü윂äsUäsUäsUüåÜþüüþüüþüüþüüþüüàp\Û\EÛ\E×UA×UAÔK=ÔK=ÒF:ÔK=ùaõ‹]õ‹]õ‹]ò†[õ‹]ò†[þôñþüüþüüþüüþüüþüüõõäsUäsUí[þüüþüüþüüþüüþüüþüüêœÛ\EÛ\EÛ\E×UA×UAÔK=ÔK=ÔK=ùaùaõ‹]õ‹]õ‹]õ‹]ò†[üëåþüüþüüþüüþüüþüüô¹¥äsUí|VäoQþôñþüüþüüþüüþüüþüüꔀÛ\EÛ\EÛ\EÛ\E×UA×UAÔK=ÔK=ùaùaùaõ‹]õ‹]õ‹]õ‹]ó²žþüüþüüþüüþüüþôñíˆgí|VäsUäsUõõþüüþüüþüüþüüüëåãlMßdIÛ\EßdIÛ\EÛ\E×UA×UAÔK=ü•dõ‹]ü•dõ‹]õ‹]õ‹]õ‹]õ‹]ø½¤þôñþüüüåÜòšzí|Ví|Ví|VévRí|Vô¿°þôñþüü÷×Ïè{\àfKßdIßdIÛ\EÛ\EÛ\EÛ\E×UA×UAü•dü•dü•dõ‹]õ‹]õ‹]õ‹]õ‹]õ‹]ò†[õ‹]í|Vò†[í|Ví|Ví|VäoQévRévRévRäsUäsUãlMàfKàfKàfKÛ\EßdIÛ\EÛ\E×UA×UAü•dùaü•dü•dü•dõ‹]õ‹]õ‹]õ‹]õ‹]ò†[ò†[ò†[ò†[òkòšzí|Ví|VäoQévRäsUäsUäsUãlMæ~cæƒlàfKßdIÛ\EÛ\EÛ\E×UAü•dü•dü•dü•dü•dùaõ‹]õ‹]õ‹]õ‹]õ‹]ò†[òk÷×Ïþüüþüüþôñò¦í|VäsUévRäsUí‡füåÜþüüþüüüëåæˆsßdIÛ\EÛ\EÛ\Eü•dü•dü•dü•dü•dü•dü•dõ‹]õ‹]õ‹]õ‹]õ‹]ûÔÅþüüþüüþüüþüüþôñíˆgí|VäsUévRüßÒþüüþüüþüüþüüþôñãlMßdIÛ\EÛ\Eü•dü•dü•dùaü•dü•dü•dùaõ‹]õ‹]õ‹]õ‹]þôñþüüþüüþüüþüüþüüó²ží|VévRí‡fþüüþüüþüüþüüþüüþüüꔀßdIßdIÛ\Eü•dü•dü•dü•dü•dü•dü•dü•dü•dõ‹]õ‹]õ‹]þüüþüüþüüþüüþüüþüüó²ží|Ví|Ví‡fþüüþüüþüüþüüþüüþüüꔀßdIàfKßdIü•dü•dü•dü•dü•dü•dü•dü•dü•dùaùaõ‹]ûÔÅþüüþüüþüüþüüþüüòkí|Ví|Ví|VüåÜþüüþüüþüüþüüþôñäoQãlMßdIàfKù³‘ü•dü•dü•dü•dü•dùaü•dü•dü•dùaùaü•düßÒþüüþüüþôñöªŒò†[ò†[í|Ví|VïŒjüåÜþüüþüüüîêî’tãlMãlMàfKåŠsÿÿÿýšiü•dü•dü•dü•dü•dùaùaü•dü•dùaùaùa÷›s÷£~õ‹]ò†[ò†[ò†[í[í[í|Ví|VïŒjî’tévRäsUäsUãlMäoQÿÿÿÿÿÿõ˵ü•dü•dü•dü•dü•dü•dü•dü•dùaü•dùaùaõ‹]õ‹]õ‹]ò†[õ‹]í[ò†[í[í[í|Ví|VévRévRévRãlMäoQì»­ÿÿÿÿÿÿÿÿÿõ˵ýšiü•dü•dü•dü•dùaùaùaùaùaùaùaõ‹]õ‹]õ‹]ò†[õ‹]ò†[ò†[í[í|Ví|Ví|VévRévRí|Vì»­ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿù³‘ü•dü•dü•dü•dü•dü•dùaü•dùaùaùaõ‹]õ‹]õ‹]õ‹]ò†[ò†[ò†[ò†[í|Ví|Vè{\ì †ÿÿÿÿÿÿÿÿÿÿÿÿhugs98-plus-Sep2006/src/winhugs/uninstaller/resource.h0000644006511100651110000000246710331471312021602 0ustar rossross//{{NO_DEPENDENCIES}} // Microsoft Visual C++ generated include file. // Used by Uninstaller.rc // #define dlgInstall 101 #define bmpInstaller 107 #define txtEdit 1000 #define cmdBrowse 1001 #define chkExecute 1003 #define bmpLogo 1003 #define chkShortcut 1004 #define chkShortcutDesktop 1004 #define chkShortcutStart 1005 #define chkRegisterFiles 1005 #define barTop 1009 #define prgBar 1012 #define lblWelcome 1013 #define lblInstallTo 1014 #define lblInstallFile 1015 #define lblSpace 1016 #define lblMessage 1016 #define lstItems 1019 #define chkDeleteModified 1020 #define dlgUninstall -7872 // Next default values for new objects // #ifdef APSTUDIO_INVOKED #ifndef APSTUDIO_READONLY_SYMBOLS #define _APS_NO_MFC 1 #define _APS_NEXT_RESOURCE_VALUE 108 #define _APS_NEXT_COMMAND_VALUE 40001 #define _APS_NEXT_CONTROL_VALUE 1021 #define _APS_NEXT_SYMED_VALUE 101 #endif #endif hugs98-plus-Sep2006/src/parser.c0000644006511100651110000064163010504340630015217 0ustar rossross/* A Bison parser, made by GNU Bison 2.3. */ /* Skeleton implementation for Bison's Yacc-like parsers in C Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice, so long as that work isn't itself a parser generator using the skeleton or a modified version thereof as a parser skeleton. Alternatively, if you modify or redistribute the parser skeleton itself, you may (at your option) remove this special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ /* C LALR(1) parser skeleton written by Richard Stallman, by simplifying the original so-called "semantic" parser. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local variables, as they might otherwise be expanded by user macros. There are some unavoidable exceptions within include files to define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output. */ #define YYBISON 1 /* Bison version. */ #define YYBISON_VERSION "2.3" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 0 /* Using locations. */ #define YYLSP_NEEDED 0 /* Tokens. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE /* Put the tokens into the symbol table, so that GDB and other debuggers know about them. */ enum yytokentype { EXPR = 258, CTXT = 259, SCRIPT = 260, CASEXP = 261, OF = 262, DATA = 263, TYPE = 264, IF = 265, THEN = 266, ELSE = 267, WHERE = 268, LET = 269, IN = 270, INFIXN = 271, INFIXL = 272, INFIXR = 273, PRIMITIVE = 274, TNEWTYPE = 275, DEFAULT = 276, DERIVING = 277, DO = 278, TCLASS = 279, TINSTANCE = 280, MDO = 281, REPEAT = 282, ALL = 283, NUMLIT = 284, CHARLIT = 285, STRINGLIT = 286, VAROP = 287, VARID = 288, CONOP = 289, CONID = 290, QVAROP = 291, QVARID = 292, QCONOP = 293, QCONID = 294, RECSELID = 295, IPVARID = 296, COCO = 297, UPTO = 298, FROM = 299, ARROW = 300, IMPLIES = 301, TMODULE = 302, IMPORT = 303, HIDING = 304, QUALIFIED = 305, ASMOD = 306, NEEDPRIMS = 307, FOREIGN = 308 }; #endif /* Tokens. */ #define EXPR 258 #define CTXT 259 #define SCRIPT 260 #define CASEXP 261 #define OF 262 #define DATA 263 #define TYPE 264 #define IF 265 #define THEN 266 #define ELSE 267 #define WHERE 268 #define LET 269 #define IN 270 #define INFIXN 271 #define INFIXL 272 #define INFIXR 273 #define PRIMITIVE 274 #define TNEWTYPE 275 #define DEFAULT 276 #define DERIVING 277 #define DO 278 #define TCLASS 279 #define TINSTANCE 280 #define MDO 281 #define REPEAT 282 #define ALL 283 #define NUMLIT 284 #define CHARLIT 285 #define STRINGLIT 286 #define VAROP 287 #define VARID 288 #define CONOP 289 #define CONID 290 #define QVAROP 291 #define QVARID 292 #define QCONOP 293 #define QCONID 294 #define RECSELID 295 #define IPVARID 296 #define COCO 297 #define UPTO 298 #define FROM 299 #define ARROW 300 #define IMPLIES 301 #define TMODULE 302 #define IMPORT 303 #define HIDING 304 #define QUALIFIED 305 #define ASMOD 306 #define NEEDPRIMS 307 #define FOREIGN 308 /* Copy the first part of user declarations. */ #line 17 "parser.y" #ifndef lint #define lint #endif #define defTycon(n,l,lhs,rhs,w) tyconDefn(intOf(l),lhs,rhs,w); sp-=n #define sigdecl(l,vs,t) ap(SIGDECL,triple(l,vs,t)) #define fixdecl(l,ops,a,p) ap(FIXDECL,\ triple(l,ops,mkInt(mkSyntax(a,intOf(p))))) #define grded(gs) ap(GUARDED,gs) #define bang(t) ap(BANG,t) #define only(t) ap(ONLY,t) #define letrec(bs,e) (nonNull(bs) ? ap(LETREC,pair(bs,e)) : e) #define qualify(ps,t) (nonNull(ps) ? ap(QUAL,pair(ps,t)) : t) #define exportSelf() singleton(ap(MODULEENT,mkCon(module(currentModule).text))) #define yyerror(s) /* errors handled elsewhere */ #define YYSTYPE Cell #ifdef YYBISON # if !defined(__GNUC__) || __GNUC__ <= 1 static void __yy_memcpy Args((char*,char*, unsigned int)); # endif #endif #ifdef _MANAGED static void yymemcpy (char *yyto, const char *yyfrom, size_t yycount); #endif static Cell local gcShadow Args((Int,Cell)); static Void local syntaxError Args((String)); static String local unexpected Args((Void)); static Cell local checkPrec Args((Cell)); static Cell local buildTuple Args((List)); static List local checkCtxt Args((List)); static Cell local checkPred Args((Cell)); static Pair local checkDo Args((List)); static Cell local checkTyLhs Args((Cell)); static Cell local checkConstr Args((Cell)); #if MUDO static Pair local checkMDo Args((List)); #endif #if !TREX static Void local noTREX Args((String)); #endif #if !IPARAM static Void local noIP Args((String)); #endif #if !MUDO static Void local noMDo Args((String)); #endif /* For the purposes of reasonably portable garbage collection, it is * necessary to simulate the YACC stack on the Hugs stack to keep * track of all intermediate constructs. The lexical analyser * pushes a token onto the stack for each token that is found, with * these elements being removed as reduce actions are performed, * taking account of look-ahead tokens as described by gcShadow() * below. * * Of the non-terminals used below, only start, topDecl & begin * do not leave any values on the Hugs stack. The same is true for the * terminals EXPR and SCRIPT. At the end of a successful parse, there * should only be one element left on the stack, containing the result * of the parse. */ #define gc0(e) gcShadow(0,e) #define gc1(e) gcShadow(1,e) #define gc2(e) gcShadow(2,e) #define gc3(e) gcShadow(3,e) #define gc4(e) gcShadow(4,e) #define gc5(e) gcShadow(5,e) #define gc6(e) gcShadow(6,e) #define gc7(e) gcShadow(7,e) /* Enabling traces. */ #ifndef YYDEBUG # define YYDEBUG 0 #endif /* Enabling verbose error messages. */ #ifdef YYERROR_VERBOSE # undef YYERROR_VERBOSE # define YYERROR_VERBOSE 1 #else # define YYERROR_VERBOSE 0 #endif /* Enabling the token table. */ #ifndef YYTOKEN_TABLE # define YYTOKEN_TABLE 0 #endif #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED typedef int YYSTYPE; # define yystype YYSTYPE /* obsolescent; will be withdrawn */ # define YYSTYPE_IS_DECLARED 1 # define YYSTYPE_IS_TRIVIAL 1 #endif /* Copy the second part of user declarations. */ /* Line 216 of yacc.c. */ #line 290 "y.tab.c" #ifdef short # undef short #endif #ifdef YYTYPE_UINT8 typedef YYTYPE_UINT8 yytype_uint8; #else typedef unsigned char yytype_uint8; #endif #ifdef YYTYPE_INT8 typedef YYTYPE_INT8 yytype_int8; #elif (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) typedef signed char yytype_int8; #else typedef short int yytype_int8; #endif #ifdef YYTYPE_UINT16 typedef YYTYPE_UINT16 yytype_uint16; #else typedef unsigned short int yytype_uint16; #endif #ifdef YYTYPE_INT16 typedef YYTYPE_INT16 yytype_int16; #else typedef short int yytype_int16; #endif #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t # elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else # define YYSIZE_T unsigned int # endif #endif #define YYSIZE_MAXIMUM ((YYSIZE_T) -1) #ifndef YY_ # if YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ # define YY_(msgid) dgettext ("bison-runtime", msgid) # endif # endif # ifndef YY_ # define YY_(msgid) msgid # endif #endif /* Suppress unused-variable warnings by "using" E. */ #if ! defined lint || defined __GNUC__ # define YYUSE(e) ((void) (e)) #else # define YYUSE(e) /* empty */ #endif /* Identity function, used to suppress warnings about constant conditions. */ #ifndef lint # define YYID(n) (n) #else #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static int YYID (int i) #else static int YYID (i) int i; #endif { return i; } #endif #if ! defined yyoverflow || YYERROR_VERBOSE /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca # elif defined __BUILTIN_VA_ARG_INCR # include /* INFRINGES ON USER NAME SPACE */ # elif defined _AIX # define YYSTACK_ALLOC __alloca # elif defined _MSC_VER # include /* INFRINGES ON USER NAME SPACE */ # define alloca _alloca # else # define YYSTACK_ALLOC alloca # if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) # include /* INFRINGES ON USER NAME SPACE */ # ifndef _STDLIB_H # define _STDLIB_H 1 # endif # endif # endif # endif # endif # ifdef YYSTACK_ALLOC /* Pacify GCC's `empty if-body' warning. */ # define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0)) # ifndef YYSTACK_ALLOC_MAXIMUM /* The OS might guarantee only one guard page at the bottom of the stack, and a page size can be as small as 4096 bytes. So we cannot safely invoke alloca (N) if N exceeds 4096. Use a slightly smaller number to allow for a few compiler-allocated temporary stack slots. */ # define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ # endif # else # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE # ifndef YYSTACK_ALLOC_MAXIMUM # define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM # endif # if (defined __cplusplus && ! defined _STDLIB_H \ && ! ((defined YYMALLOC || defined malloc) \ && (defined YYFREE || defined free))) # include /* INFRINGES ON USER NAME SPACE */ # ifndef _STDLIB_H # define _STDLIB_H 1 # endif # endif # ifndef YYMALLOC # define YYMALLOC malloc # if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ # endif # endif # ifndef YYFREE # define YYFREE free # if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) void free (void *); /* INFRINGES ON USER NAME SPACE */ # endif # endif # endif #endif /* ! defined yyoverflow || YYERROR_VERBOSE */ #if (! defined yyoverflow \ && (! defined __cplusplus \ || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { yytype_int16 yyss; YYSTYPE yyvs; }; /* The size of the maximum gap between one aligned stack and the next. */ # define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \ + YYSTACK_GAP_MAXIMUM) /* Copy COUNT objects from FROM to TO. The source and destination do not overlap. */ # ifndef YYCOPY # if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(To, From, Count) \ __builtin_memcpy (To, From, (Count) * sizeof (*(From))) # else # define YYCOPY(To, From, Count) \ do \ { \ YYSIZE_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (To)[yyi] = (From)[yyi]; \ } \ while (YYID (0)) # endif # endif /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ # define YYSTACK_RELOCATE(Stack) \ do \ { \ YYSIZE_T yynewbytes; \ YYCOPY (&yyptr->Stack, Stack, yysize); \ Stack = &yyptr->Stack; \ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / sizeof (*yyptr); \ } \ while (YYID (0)) #endif /* YYFINAL -- State number of the termination state. */ #define YYFINAL 60 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 4043 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 73 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 165 /* YYNRULES -- Number of rules. */ #define YYNRULES 501 /* YYNRULES -- Number of states. */ #define YYNSTATES 891 /* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */ #define YYUNDEFTOK 2 #define YYMAXUTOK 308 #define YYTRANSLATE(YYX) \ ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) /* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */ static const yytype_uint8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 52, 2, 2, 2, 2, 2, 2, 53, 56, 2, 72, 55, 48, 61, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 58, 2, 42, 2, 2, 44, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 57, 46, 59, 2, 71, 60, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 69, 47, 70, 50, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 43, 45, 49, 51, 54, 62, 63, 64, 65, 66, 67, 68 }; #if YYDEBUG /* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in YYRHS. */ static const yytype_uint16 yyprhs[] = { 0, 0, 3, 7, 10, 13, 15, 20, 25, 33, 39, 42, 43, 45, 47, 49, 50, 53, 55, 58, 63, 64, 67, 71, 75, 80, 84, 86, 88, 90, 95, 100, 103, 104, 106, 108, 111, 115, 117, 119, 121, 125, 128, 130, 131, 135, 141, 148, 153, 156, 157, 162, 166, 167, 169, 171, 174, 178, 180, 182, 184, 189, 194, 195, 197, 199, 202, 206, 208, 210, 212, 215, 219, 223, 225, 227, 232, 239, 242, 248, 256, 259, 264, 267, 273, 281, 284, 287, 290, 293, 295, 297, 301, 303, 307, 309, 313, 315, 320, 322, 326, 328, 333, 337, 341, 345, 347, 349, 354, 358, 360, 364, 367, 370, 374, 377, 381, 384, 386, 388, 390, 394, 396, 400, 404, 409, 410, 413, 418, 419, 421, 425, 427, 432, 436, 438, 440, 443, 445, 453, 460, 469, 477, 485, 490, 494, 499, 502, 505, 508, 512, 514, 518, 520, 521, 523, 527, 529, 530, 533, 537, 539, 543, 545, 546, 549, 554, 556, 560, 562, 566, 570, 574, 576, 581, 583, 587, 593, 596, 598, 602, 604, 607, 609, 613, 617, 619, 623, 625, 629, 633, 637, 641, 645, 649, 653, 655, 657, 659, 661, 665, 669, 673, 675, 677, 679, 682, 684, 687, 689, 691, 693, 695, 698, 702, 706, 710, 714, 718, 722, 726, 732, 736, 739, 741, 745, 749, 753, 757, 761, 765, 769, 771, 775, 779, 782, 786, 789, 793, 796, 800, 804, 806, 807, 811, 813, 817, 819, 823, 827, 828, 831, 834, 837, 839, 842, 847, 850, 852, 854, 856, 860, 864, 868, 872, 876, 881, 886, 891, 894, 897, 900, 902, 905, 907, 910, 912, 917, 918, 921, 922, 925, 929, 933, 934, 937, 940, 943, 947, 950, 952, 954, 956, 960, 962, 966, 968, 970, 972, 974, 976, 978, 980, 983, 986, 990, 995, 999, 1004, 1008, 1013, 1017, 1022, 1024, 1026, 1028, 1030, 1033, 1036, 1038, 1040, 1042, 1046, 1048, 1053, 1055, 1057, 1059, 1063, 1067, 1071, 1075, 1078, 1082, 1088, 1092, 1096, 1100, 1102, 1103, 1105, 1109, 1111, 1115, 1117, 1121, 1123, 1127, 1129, 1131, 1135, 1137, 1139, 1141, 1143, 1145, 1147, 1149, 1154, 1158, 1161, 1166, 1170, 1175, 1179, 1182, 1187, 1191, 1198, 1203, 1208, 1210, 1215, 1220, 1225, 1229, 1232, 1236, 1239, 1242, 1244, 1247, 1249, 1251, 1255, 1258, 1260, 1262, 1264, 1269, 1274, 1276, 1278, 1280, 1282, 1286, 1290, 1294, 1300, 1302, 1306, 1311, 1316, 1321, 1325, 1329, 1333, 1335, 1339, 1341, 1344, 1348, 1351, 1353, 1357, 1359, 1362, 1364, 1367, 1369, 1374, 1376, 1379, 1383, 1386, 1388, 1392, 1395, 1397, 1398, 1400, 1404, 1406, 1408, 1412, 1414, 1416, 1419, 1423, 1428, 1431, 1437, 1441, 1444, 1448, 1450, 1454, 1456, 1459, 1461, 1464, 1467, 1471, 1474, 1476, 1478, 1480, 1482, 1484, 1486, 1488, 1490, 1494, 1498, 1502, 1506, 1510, 1512, 1516, 1518, 1520, 1524, 1526, 1530, 1532, 1534, 1536, 1538, 1540, 1542, 1544, 1546, 1548, 1552, 1554, 1556, 1558, 1560, 1562, 1566, 1568, 1570, 1574, 1576, 1580, 1582, 1584, 1586, 1588, 1590, 1591, 1593 }; /* YYRHS -- A `-1'-separated list of the rules' RHS. */ static const yytype_int16 yyrhs[] = { 74, 0, -1, 3, 185, 161, -1, 4, 130, -1, 5, 75, -1, 1, -1, 76, 236, 79, 237, -1, 76, 69, 79, 70, -1, 62, 77, 80, 13, 69, 79, 237, -1, 62, 77, 80, 13, 1, -1, 62, 1, -1, -1, 221, -1, 221, -1, 31, -1, -1, 58, 79, -1, 96, -1, 86, 87, -1, 86, 58, 87, 96, -1, -1, 53, 56, -1, 53, 55, 56, -1, 53, 81, 56, -1, 53, 81, 55, 56, -1, 81, 55, 82, -1, 82, -1, 223, -1, 225, -1, 221, 53, 45, 56, -1, 221, 53, 83, 56, -1, 62, 78, -1, -1, 55, -1, 84, -1, 84, 55, -1, 84, 55, 85, -1, 85, -1, 223, -1, 225, -1, 86, 58, 88, -1, 86, 58, -1, 88, -1, -1, 63, 78, 89, -1, 63, 78, 66, 78, 89, -1, 63, 65, 78, 66, 78, 89, -1, 63, 65, 78, 89, -1, 63, 1, -1, -1, 64, 53, 90, 56, -1, 53, 90, 56, -1, -1, 55, -1, 91, -1, 91, 55, -1, 91, 55, 92, -1, 92, -1, 222, -1, 35, -1, 35, 53, 45, 56, -1, 35, 53, 93, 56, -1, -1, 55, -1, 94, -1, 94, 55, -1, 94, 55, 95, -1, 95, -1, 222, -1, 224, -1, 96, 58, -1, 96, 58, 97, -1, 96, 58, 152, -1, 97, -1, 152, -1, 9, 98, 42, 134, -1, 9, 98, 42, 134, 15, 99, -1, 9, 1, -1, 8, 138, 42, 101, 110, -1, 8, 130, 54, 98, 42, 101, 110, -1, 8, 138, -1, 8, 130, 54, 98, -1, 8, 1, -1, 20, 138, 42, 107, 110, -1, 20, 130, 54, 98, 42, 107, 110, -1, 20, 1, -1, 67, 29, -1, 67, 1, -1, 98, 220, -1, 35, -1, 1, -1, 99, 55, 100, -1, 100, -1, 222, 43, 123, -1, 222, -1, 101, 47, 102, -1, 102, -1, 28, 128, 61, 103, -1, 104, -1, 130, 54, 104, -1, 104, -1, 52, 136, 232, 106, -1, 137, 232, 106, -1, 138, 232, 106, -1, 127, 232, 106, -1, 138, -1, 105, -1, 224, 69, 108, 70, -1, 224, 69, 70, -1, 1, -1, 138, 52, 139, -1, 138, 127, -1, 105, 139, -1, 105, 52, 139, -1, 105, 127, -1, 53, 34, 56, -1, 52, 136, -1, 136, -1, 127, -1, 102, -1, 108, 55, 109, -1, 109, -1, 148, 43, 126, -1, 148, 43, 134, -1, 148, 43, 52, 134, -1, -1, 22, 221, -1, 22, 53, 111, 56, -1, -1, 112, -1, 112, 55, 221, -1, 221, -1, 19, 113, 43, 123, -1, 113, 55, 114, -1, 114, -1, 1, -1, 222, 31, -1, 222, -1, 68, 63, 222, 31, 222, 43, 123, -1, 68, 63, 222, 222, 43, 123, -1, 68, 63, 222, 222, 31, 222, 43, 123, -1, 68, 63, 222, 222, 222, 43, 123, -1, 68, 222, 222, 31, 222, 43, 123, -1, 24, 115, 119, 160, -1, 25, 116, 160, -1, 21, 53, 117, 56, -1, 24, 1, -1, 25, 1, -1, 21, 1, -1, 130, 54, 138, -1, 138, -1, 130, 54, 138, -1, 138, -1, -1, 118, -1, 118, 55, 134, -1, 134, -1, -1, 47, 120, -1, 120, 55, 121, -1, 121, -1, 122, 51, 122, -1, 1, -1, -1, 122, 220, -1, 28, 128, 61, 124, -1, 124, -1, 130, 54, 125, -1, 125, -1, 127, 51, 125, -1, 137, 51, 125, -1, 138, 51, 125, -1, 136, -1, 28, 128, 61, 129, -1, 127, -1, 53, 126, 56, -1, 53, 131, 54, 134, 56, -1, 128, 220, -1, 220, -1, 130, 54, 134, -1, 134, -1, 53, 56, -1, 138, -1, 53, 138, 56, -1, 53, 141, 56, -1, 132, -1, 53, 133, 56, -1, 132, -1, 53, 133, 56, -1, 220, 46, 220, -1, 41, 43, 134, -1, 141, 55, 132, -1, 133, 55, 138, -1, 133, 55, 132, -1, 138, 55, 132, -1, 132, -1, 135, -1, 138, -1, 137, -1, 127, 51, 134, -1, 137, 51, 134, -1, 138, 51, 134, -1, 1, -1, 137, -1, 138, -1, 137, 139, -1, 140, -1, 138, 139, -1, 221, -1, 140, -1, 221, -1, 220, -1, 53, 56, -1, 53, 51, 56, -1, 53, 135, 56, -1, 53, 138, 56, -1, 53, 219, 56, -1, 53, 141, 56, -1, 53, 142, 56, -1, 53, 143, 56, -1, 53, 143, 47, 134, 56, -1, 57, 134, 59, -1, 57, 59, -1, 71, -1, 141, 55, 138, -1, 138, 55, 138, -1, 135, 55, 134, -1, 138, 55, 135, -1, 141, 55, 135, -1, 142, 55, 134, -1, 143, 55, 144, -1, 144, -1, 220, 43, 134, -1, 16, 146, 147, -1, 16, 1, -1, 17, 146, 147, -1, 17, 1, -1, 18, 146, 147, -1, 18, 1, -1, 148, 43, 123, -1, 148, 43, 1, -1, 29, -1, -1, 147, 55, 234, -1, 234, -1, 148, 55, 222, -1, 222, -1, 69, 150, 237, -1, 69, 151, 237, -1, -1, 150, 58, -1, 151, 58, -1, 150, 152, -1, 145, -1, 153, 156, -1, 153, 43, 134, 156, -1, 169, 156, -1, 154, -1, 155, -1, 168, -1, 174, 226, 169, -1, 172, 226, 169, -1, 29, 226, 169, -1, 222, 228, 169, -1, 222, 72, 170, -1, 53, 154, 56, 176, -1, 53, 155, 56, 176, -1, 53, 168, 56, 176, -1, 222, 176, -1, 155, 176, -1, 157, 160, -1, 1, -1, 42, 185, -1, 158, -1, 158, 159, -1, 159, -1, 47, 187, 42, 185, -1, -1, 13, 149, -1, -1, 13, 162, -1, 69, 163, 237, -1, 69, 164, 237, -1, -1, 163, 58, -1, 164, 58, -1, 163, 165, -1, 41, 42, 185, -1, 41, 1, -1, 152, -1, 168, -1, 167, -1, 169, 43, 134, -1, 169, -1, 222, 72, 29, -1, 222, -1, 29, -1, 171, -1, 222, -1, 171, -1, 174, -1, 172, -1, 48, 173, -1, 48, 1, -1, 222, 233, 173, -1, 222, 233, 48, 173, -1, 29, 233, 173, -1, 29, 233, 48, 173, -1, 174, 233, 173, -1, 174, 233, 48, 173, -1, 172, 233, 173, -1, 172, 233, 48, 173, -1, 175, -1, 176, -1, 175, -1, 177, -1, 175, 176, -1, 218, 176, -1, 29, -1, 222, -1, 177, -1, 222, 44, 176, -1, 218, -1, 225, 69, 180, 70, -1, 30, -1, 31, -1, 71, -1, 53, 167, 56, -1, 53, 168, 56, -1, 53, 178, 56, -1, 57, 179, 59, -1, 50, 176, -1, 53, 183, 56, -1, 53, 183, 47, 166, 56, -1, 178, 55, 166, -1, 166, 55, 166, -1, 179, 55, 166, -1, 166, -1, -1, 181, -1, 181, 55, 182, -1, 182, -1, 223, 42, 166, -1, 222, -1, 183, 55, 184, -1, 184, -1, 220, 42, 166, -1, 186, -1, 1, -1, 188, 43, 129, -1, 187, -1, 188, -1, 189, -1, 190, -1, 192, -1, 191, -1, 193, -1, 190, 235, 48, 192, -1, 190, 235, 192, -1, 48, 192, -1, 192, 235, 48, 192, -1, 192, 235, 192, -1, 190, 235, 48, 193, -1, 190, 235, 193, -1, 48, 193, -1, 192, 235, 48, 193, -1, 192, 235, 193, -1, 6, 185, 7, 69, 202, 237, -1, 23, 69, 208, 237, -1, 26, 69, 208, 237, -1, 197, -1, 46, 196, 51, 185, -1, 14, 162, 15, 185, -1, 10, 185, 194, 195, -1, 58, 11, 185, -1, 11, 185, -1, 58, 12, 185, -1, 12, 185, -1, 196, 176, -1, 176, -1, 197, 198, -1, 198, -1, 223, -1, 223, 44, 198, -1, 50, 198, -1, 41, -1, 71, -1, 218, -1, 225, 69, 211, 70, -1, 198, 69, 211, 70, -1, 29, -1, 30, -1, 31, -1, 27, -1, 53, 185, 56, -1, 53, 199, 56, -1, 53, 200, 56, -1, 53, 200, 47, 185, 56, -1, 40, -1, 57, 214, 59, -1, 53, 192, 235, 56, -1, 53, 231, 187, 56, -1, 53, 233, 187, 56, -1, 199, 55, 185, -1, 185, 55, 185, -1, 200, 55, 201, -1, 201, -1, 220, 42, 185, -1, 203, -1, 58, 202, -1, 203, 58, 204, -1, 203, 58, -1, 204, -1, 166, 205, 160, -1, 206, -1, 51, 185, -1, 1, -1, 206, 207, -1, 207, -1, 47, 187, 51, 185, -1, 209, -1, 58, 208, -1, 209, 58, 210, -1, 209, 58, -1, 210, -1, 186, 49, 185, -1, 14, 162, -1, 186, -1, -1, 212, -1, 212, 55, 213, -1, 213, -1, 222, -1, 223, 42, 185, -1, 185, -1, 199, -1, 185, 215, -1, 185, 45, 185, -1, 185, 55, 185, 45, -1, 185, 45, -1, 185, 55, 185, 45, 185, -1, 215, 47, 216, -1, 47, 216, -1, 216, 55, 217, -1, 217, -1, 185, 49, 185, -1, 185, -1, 14, 162, -1, 225, -1, 53, 56, -1, 57, 59, -1, 53, 219, 56, -1, 219, 55, -1, 55, -1, 33, -1, 64, -1, 65, -1, 66, -1, 39, -1, 35, -1, 220, -1, 53, 32, 56, -1, 53, 72, 56, -1, 53, 48, 56, -1, 53, 52, 56, -1, 53, 61, 56, -1, 37, -1, 53, 36, 56, -1, 222, -1, 35, -1, 53, 34, 56, -1, 39, -1, 53, 38, 56, -1, 224, -1, 72, -1, 48, -1, 229, -1, 72, -1, 229, -1, 48, -1, 229, -1, 32, -1, 60, 220, 60, -1, 52, -1, 61, -1, 48, -1, 231, -1, 36, -1, 60, 37, 60, -1, 227, -1, 34, -1, 60, 35, 60, -1, 38, -1, 60, 39, 60, -1, 232, -1, 226, -1, 232, -1, 230, -1, 233, -1, -1, 70, -1, 1, -1 }; /* YYRLINE[YYN] -- source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { 0, 120, 120, 121, 122, 123, 136, 140, 144, 146, 148, 154, 157, 159, 160, 168, 169, 170, 171, 172, 177, 178, 179, 180, 181, 183, 184, 189, 190, 191, 192, 193, 195, 196, 197, 198, 200, 201, 203, 204, 209, 210, 211, 213, 224, 226, 229, 232, 235, 237, 238, 239, 241, 242, 243, 244, 246, 247, 249, 250, 251, 252, 254, 255, 256, 257, 259, 260, 262, 263, 268, 269, 270, 271, 272, 277, 278, 281, 282, 285, 289, 291, 294, 295, 298, 302, 303, 309, 311, 312, 313, 315, 316, 318, 320, 322, 323, 325, 327, 329, 330, 332, 333, 334, 335, 336, 337, 338, 339, 340, 342, 343, 344, 345, 346, 347, 349, 350, 351, 353, 355, 356, 358, 359, 360, 362, 363, 364, 366, 367, 369, 370, 375, 377, 378, 379, 381, 382, 387, 389, 391, 393, 395, 401, 402, 403, 404, 405, 406, 408, 409, 411, 412, 414, 415, 417, 418, 420, 421, 424, 425, 427, 428, 430, 431, 436, 438, 440, 441, 443, 444, 445, 446, 448, 450, 452, 453, 455, 456, 458, 459, 461, 462, 463, 464, 465, 466, 468, 469, 471, 478, 486, 487, 488, 489, 490, 493, 494, 496, 497, 498, 499, 500, 502, 503, 505, 506, 508, 509, 511, 512, 514, 515, 516, 517, 518, 519, 520, 521, 522, 529, 536, 537, 538, 541, 542, 544, 545, 546, 547, 550, 551, 553, 560, 561, 562, 563, 564, 565, 566, 567, 569, 570, 572, 573, 575, 576, 578, 579, 581, 582, 583, 585, 587, 588, 589, 592, 594, 595, 596, 598, 599, 600, 601, 602, 604, 605, 606, 607, 608, 610, 611, 613, 614, 616, 617, 619, 621, 622, 627, 628, 631, 632, 635, 636, 637, 640, 642, 649, 650, 655, 656, 658, 659, 661, 663, 664, 665, 667, 668, 670, 671, 673, 674, 675, 676, 677, 678, 679, 680, 681, 682, 684, 685, 687, 688, 690, 691, 693, 694, 695, 697, 698, 699, 700, 701, 702, 703, 704, 705, 706, 707, 709, 716, 719, 720, 722, 723, 725, 726, 728, 729, 731, 732, 735, 736, 738, 750, 751, 753, 754, 756, 757, 759, 760, 762, 763, 765, 766, 767, 768, 770, 772, 773, 774, 775, 777, 779, 780, 781, 788, 790, 793, 794, 799, 800, 802, 803, 806, 807, 809, 810, 812, 813, 814, 815, 816, 817, 818, 819, 821, 822, 823, 824, 825, 826, 828, 835, 836, 838, 839, 840, 841, 843, 844, 847, 848, 850, 859, 860, 862, 863, 864, 866, 868, 869, 870, 872, 873, 875, 878, 879, 881, 882, 883, 886, 887, 889, 891, 892, 894, 895, 897, 898, 903, 904, 905, 921, 922, 923, 924, 927, 928, 930, 931, 933, 934, 935, 940, 941, 942, 943, 945, 946, 948, 949, 950, 951, 953, 954, 956, 957, 958, 959, 960, 961, 963, 964, 965, 967, 968, 970, 971, 972, 974, 975, 976, 978, 979, 981, 982, 984, 985, 986, 987, 989, 990, 992, 993, 994, 997, 998, 1000, 1001, 1002, 1004, 1005, 1007, 1008, 1013, 1016, 1017 }; #endif #if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "$end", "error", "$undefined", "EXPR", "CTXT", "SCRIPT", "CASEXP", "OF", "DATA", "TYPE", "IF", "THEN", "ELSE", "WHERE", "LET", "IN", "INFIXN", "INFIXL", "INFIXR", "PRIMITIVE", "TNEWTYPE", "DEFAULT", "DERIVING", "DO", "TCLASS", "TINSTANCE", "MDO", "REPEAT", "ALL", "NUMLIT", "CHARLIT", "STRINGLIT", "VAROP", "VARID", "CONOP", "CONID", "QVAROP", "QVARID", "QCONOP", "QCONID", "RECSELID", "IPVARID", "'='", "COCO", "'@'", "UPTO", "'\\\\'", "'|'", "'-'", "FROM", "'~'", "ARROW", "'!'", "'('", "IMPLIES", "','", "')'", "'['", "';'", "']'", "'`'", "'.'", "TMODULE", "IMPORT", "HIDING", "QUALIFIED", "ASMOD", "NEEDPRIMS", "FOREIGN", "'{'", "'}'", "'_'", "'+'", "$accept", "start", "topModule", "startMain", "modname", "modid", "modBody", "expspec", "exports", "export", "qnames", "qnames1", "qname", "impDecls", "chase", "impDecl", "impspec", "imports", "imports1", "import", "names", "names1", "name", "topDecls", "topDecl", "tyLhs", "invars", "invar", "constrs", "pconstr", "qconstr", "constr", "btype3", "bbtype", "nconstr", "fieldspecs", "fieldspec", "deriving", "derivs0", "derivs", "prims", "prim", "crule", "irule", "dtypes", "dtypes1", "fds", "fds1", "fd", "varids0", "topType", "topType0", "topType1", "polyType", "bpolyType", "varids", "sigType", "context", "lcontext", "lacks", "lacks1", "type", "type1", "btype", "btype1", "btype2", "atype", "atype1", "btypes2", "typeTuple", "tfields", "tfield", "gendecl", "optDigit", "ops", "vars", "decls", "decls0", "decls1", "decl", "funlhs", "funlhs0", "funlhs1", "rhs", "rhs1", "gdrhs", "gddef", "wherePart", "lwherePart", "ldecls", "ldecls0", "ldecls1", "ldecl", "pat", "pat_npk", "npk", "pat0", "pat0_INT", "pat0_vI", "infixPat", "pat10", "pat10_vI", "fpat", "apat", "apat_vI", "pats2", "pats1", "patbinds", "patbinds1", "patbind", "patfields", "patfield", "exp", "exp_err", "exp0", "exp0a", "exp0b", "infixExpa", "infixExpb", "exp10a", "exp10b", "then_exp", "else_exp", "pats", "appExp", "aexp", "exps2", "vfields", "vfield", "alts", "alts1", "alt", "altRhs", "guardAlts", "guardAlt", "stmts", "stmts1", "stmt", "fbinds", "fbinds1", "fbind", "list", "zipquals", "quals", "qual", "gcon", "tupCommas", "varid", "qconid", "var", "qvar", "con", "qcon", "varop", "varop_mi", "varop_pl", "varop_mipl", "qvarop", "qvarop_mi", "conop", "qconop", "op", "qop", "begin", "end", 0 }; #endif # ifdef YYPRINT /* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to token YYLEX-NUM. */ static const yytype_uint16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, 61, 297, 64, 298, 92, 124, 45, 299, 126, 300, 33, 40, 301, 44, 41, 91, 59, 93, 96, 46, 302, 303, 304, 305, 306, 307, 308, 123, 125, 95, 43 }; # endif /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ static const yytype_uint8 yyr1[] = { 0, 73, 74, 74, 74, 74, 75, 75, 75, 75, 75, 76, 77, 78, 78, 79, 79, 79, 79, 79, 80, 80, 80, 80, 80, 81, 81, 82, 82, 82, 82, 82, 83, 83, 83, 83, 84, 84, 85, 85, 86, 86, 86, 87, 88, 88, 88, 88, 88, 89, 89, 89, 90, 90, 90, 90, 91, 91, 92, 92, 92, 92, 93, 93, 93, 93, 94, 94, 95, 95, 96, 96, 96, 96, 96, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 98, 98, 98, 99, 99, 100, 100, 101, 101, 102, 102, 103, 103, 104, 104, 104, 104, 104, 104, 104, 104, 104, 105, 105, 105, 105, 105, 105, 106, 106, 106, 107, 108, 108, 109, 109, 109, 110, 110, 110, 111, 111, 112, 112, 97, 113, 113, 113, 114, 114, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 115, 115, 116, 116, 117, 117, 118, 118, 119, 119, 120, 120, 121, 121, 122, 122, 123, 123, 124, 124, 125, 125, 125, 125, 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 130, 130, 130, 130, 131, 131, 132, 132, 133, 133, 133, 133, 133, 134, 134, 135, 135, 135, 135, 135, 136, 136, 137, 137, 138, 138, 139, 139, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 141, 141, 142, 142, 142, 142, 143, 143, 144, 145, 145, 145, 145, 145, 145, 145, 145, 146, 146, 147, 147, 148, 148, 149, 149, 150, 150, 150, 151, 152, 152, 152, 152, 153, 153, 153, 154, 154, 154, 154, 154, 155, 155, 155, 155, 155, 156, 156, 157, 157, 158, 158, 159, 160, 160, 161, 161, 162, 162, 163, 163, 163, 164, 165, 165, 165, 166, 166, 167, 167, 168, 169, 169, 169, 170, 170, 171, 171, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 173, 173, 174, 174, 175, 175, 176, 176, 176, 177, 177, 177, 177, 177, 177, 177, 177, 177, 177, 177, 177, 177, 178, 178, 179, 179, 180, 180, 181, 181, 182, 182, 183, 183, 184, 185, 185, 186, 186, 187, 187, 188, 188, 189, 189, 190, 190, 190, 190, 190, 191, 191, 191, 191, 191, 192, 192, 192, 192, 193, 193, 193, 194, 194, 195, 195, 196, 196, 197, 197, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 199, 199, 200, 200, 201, 202, 202, 203, 203, 203, 204, 205, 205, 205, 206, 206, 207, 208, 208, 209, 209, 209, 210, 210, 210, 211, 211, 212, 212, 213, 213, 214, 214, 214, 214, 214, 214, 214, 215, 215, 216, 216, 217, 217, 217, 218, 218, 218, 218, 219, 219, 220, 220, 220, 220, 221, 221, 222, 222, 222, 222, 222, 222, 223, 223, 223, 224, 224, 225, 225, 225, 226, 226, 226, 227, 227, 228, 228, 229, 229, 229, 229, 230, 230, 231, 231, 231, 232, 232, 233, 233, 233, 234, 234, 235, 235, 236, 237, 237 }; /* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */ static const yytype_uint8 yyr2[] = { 0, 2, 3, 2, 2, 1, 4, 4, 7, 5, 2, 0, 1, 1, 1, 0, 2, 1, 2, 4, 0, 2, 3, 3, 4, 3, 1, 1, 1, 4, 4, 2, 0, 1, 1, 2, 3, 1, 1, 1, 3, 2, 1, 0, 3, 5, 6, 4, 2, 0, 4, 3, 0, 1, 1, 2, 3, 1, 1, 1, 4, 4, 0, 1, 1, 2, 3, 1, 1, 1, 2, 3, 3, 1, 1, 4, 6, 2, 5, 7, 2, 4, 2, 5, 7, 2, 2, 2, 2, 1, 1, 3, 1, 3, 1, 3, 1, 4, 1, 3, 1, 4, 3, 3, 3, 1, 1, 4, 3, 1, 3, 2, 2, 3, 2, 3, 2, 1, 1, 1, 3, 1, 3, 3, 4, 0, 2, 4, 0, 1, 3, 1, 4, 3, 1, 1, 2, 1, 7, 6, 8, 7, 7, 4, 3, 4, 2, 2, 2, 3, 1, 3, 1, 0, 1, 3, 1, 0, 2, 3, 1, 3, 1, 0, 2, 4, 1, 3, 1, 3, 3, 3, 1, 4, 1, 3, 5, 2, 1, 3, 1, 2, 1, 3, 3, 1, 3, 1, 3, 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 3, 3, 3, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 2, 3, 3, 3, 3, 3, 3, 3, 5, 3, 2, 1, 3, 3, 3, 3, 3, 3, 3, 1, 3, 3, 2, 3, 2, 3, 2, 3, 3, 1, 0, 3, 1, 3, 1, 3, 3, 0, 2, 2, 2, 1, 2, 4, 2, 1, 1, 1, 3, 3, 3, 3, 3, 4, 4, 4, 2, 2, 2, 1, 2, 1, 2, 1, 4, 0, 2, 0, 2, 3, 3, 0, 2, 2, 2, 3, 2, 1, 1, 1, 3, 1, 3, 1, 1, 1, 1, 1, 1, 1, 2, 2, 3, 4, 3, 4, 3, 4, 3, 4, 1, 1, 1, 1, 2, 2, 1, 1, 1, 3, 1, 4, 1, 1, 1, 3, 3, 3, 3, 2, 3, 5, 3, 3, 3, 1, 0, 1, 3, 1, 3, 1, 3, 1, 3, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 4, 3, 2, 4, 3, 4, 3, 2, 4, 3, 6, 4, 4, 1, 4, 4, 4, 3, 2, 3, 2, 2, 1, 2, 1, 1, 3, 2, 1, 1, 1, 4, 4, 1, 1, 1, 1, 3, 3, 3, 5, 1, 3, 4, 4, 4, 3, 3, 3, 1, 3, 1, 2, 3, 2, 1, 3, 1, 2, 1, 2, 1, 4, 1, 2, 3, 2, 1, 3, 2, 1, 0, 1, 3, 1, 1, 3, 1, 1, 2, 3, 4, 2, 5, 3, 2, 3, 1, 3, 1, 2, 1, 2, 2, 3, 2, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 1, 3, 1, 1, 3, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1, 3, 1, 1, 3, 1, 3, 1, 1, 1, 1, 1, 0, 1, 1 }; /* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state STATE-NUM when YYTABLE doesn't specify something else to do. Zero means the default is an error. */ static const yytype_uint16 yydefact[] = { 0, 5, 0, 0, 11, 0, 348, 0, 0, 0, 0, 0, 393, 390, 391, 392, 454, 469, 466, 471, 398, 385, 0, 0, 0, 0, 0, 455, 456, 457, 386, 279, 347, 350, 351, 352, 353, 355, 354, 356, 370, 381, 387, 460, 468, 382, 473, 448, 459, 458, 0, 0, 3, 185, 182, 0, 208, 0, 4, 499, 1, 0, 0, 283, 0, 0, 0, 318, 324, 325, 0, 0, 0, 326, 379, 320, 0, 322, 319, 448, 359, 364, 384, 481, 490, 487, 492, 0, 483, 453, 449, 0, 484, 477, 0, 354, 0, 0, 406, 0, 460, 489, 478, 0, 494, 0, 450, 434, 435, 0, 0, 2, 0, 481, 490, 487, 492, 485, 483, 484, 477, 497, 486, 498, 0, 0, 380, 428, 0, 428, 0, 181, 195, 0, 0, 0, 0, 0, 223, 207, 209, 211, 210, 0, 10, 20, 12, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 427, 0, 420, 424, 0, 331, 296, 0, 0, 0, 0, 0, 0, 0, 0, 291, 290, 293, 297, 301, 300, 314, 315, 0, 0, 345, 322, 460, 295, 0, 337, 291, 290, 0, 0, 378, 0, 338, 461, 470, 467, 472, 463, 464, 0, 0, 0, 0, 465, 462, 0, 394, 0, 0, 395, 0, 0, 396, 452, 451, 0, 0, 351, 0, 0, 0, 0, 436, 399, 280, 202, 0, 0, 349, 0, 180, 196, 198, 197, 206, 211, 0, 358, 363, 0, 361, 366, 0, 0, 429, 431, 432, 0, 383, 0, 0, 190, 197, 0, 186, 0, 183, 0, 184, 0, 212, 0, 0, 0, 0, 0, 231, 0, 211, 222, 0, 189, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 296, 0, 15, 0, 0, 0, 0, 43, 42, 17, 73, 253, 0, 74, 0, 257, 258, 259, 0, 301, 300, 295, 0, 0, 375, 0, 0, 0, 373, 501, 0, 284, 500, 289, 286, 281, 285, 282, 372, 426, 421, 0, 368, 423, 369, 0, 0, 303, 302, 312, 313, 0, 327, 328, 0, 0, 0, 316, 0, 329, 0, 0, 332, 317, 0, 0, 0, 0, 330, 371, 321, 0, 339, 341, 343, 0, 491, 488, 493, 482, 404, 400, 403, 0, 405, 0, 407, 401, 402, 437, 0, 446, 442, 444, 404, 0, 0, 0, 212, 0, 174, 0, 195, 0, 0, 211, 0, 0, 0, 205, 0, 357, 362, 360, 365, 0, 0, 389, 0, 0, 388, 187, 193, 192, 194, 225, 191, 224, 213, 0, 214, 0, 215, 0, 217, 0, 218, 0, 0, 219, 216, 0, 221, 459, 471, 0, 0, 21, 0, 0, 26, 0, 27, 28, 0, 82, 0, 80, 90, 89, 0, 234, 241, 0, 236, 0, 238, 0, 135, 0, 0, 134, 137, 85, 0, 182, 148, 0, 146, 157, 0, 150, 147, 277, 0, 152, 475, 0, 474, 0, 476, 0, 0, 290, 295, 16, 48, 14, 0, 49, 13, 87, 86, 0, 0, 7, 43, 18, 70, 0, 0, 271, 0, 0, 0, 254, 277, 273, 275, 269, 256, 0, 0, 479, 0, 268, 0, 480, 6, 0, 0, 0, 408, 412, 374, 377, 0, 288, 0, 425, 422, 0, 306, 335, 292, 0, 310, 0, 308, 334, 0, 344, 0, 346, 294, 0, 304, 336, 323, 0, 0, 397, 447, 0, 0, 0, 441, 0, 178, 0, 0, 0, 175, 0, 0, 215, 0, 217, 199, 179, 200, 201, 430, 433, 226, 227, 225, 228, 224, 229, 0, 230, 0, 232, 22, 31, 0, 23, 32, 9, 15, 0, 0, 0, 88, 0, 233, 495, 496, 244, 235, 237, 0, 0, 136, 0, 0, 0, 154, 156, 0, 277, 0, 0, 144, 0, 262, 295, 0, 0, 328, 49, 52, 0, 0, 44, 0, 0, 0, 40, 71, 72, 240, 0, 239, 166, 168, 0, 0, 172, 203, 204, 245, 272, 0, 0, 270, 274, 261, 260, 294, 264, 299, 298, 263, 409, 416, 0, 0, 277, 414, 418, 367, 411, 376, 287, 307, 311, 309, 333, 305, 340, 342, 445, 443, 440, 0, 177, 188, 0, 220, 24, 25, 0, 33, 0, 34, 37, 38, 39, 0, 90, 81, 109, 0, 0, 0, 125, 96, 98, 106, 0, 0, 105, 0, 75, 0, 132, 133, 0, 119, 125, 145, 0, 162, 158, 160, 0, 143, 149, 249, 278, 151, 265, 266, 267, 0, 47, 59, 53, 0, 54, 57, 58, 52, 49, 0, 0, 0, 19, 0, 0, 0, 0, 0, 255, 0, 0, 415, 413, 417, 410, 173, 176, 29, 30, 35, 8, 0, 0, 0, 203, 204, 0, 0, 0, 78, 0, 114, 112, 0, 0, 0, 0, 111, 0, 0, 0, 243, 0, 83, 155, 0, 163, 164, 0, 0, 49, 62, 51, 55, 0, 45, 0, 0, 0, 0, 0, 0, 169, 204, 167, 170, 171, 276, 0, 36, 125, 0, 0, 115, 128, 126, 95, 113, 0, 104, 118, 117, 102, 110, 103, 108, 0, 121, 0, 246, 76, 92, 94, 125, 159, 161, 250, 252, 247, 251, 248, 46, 0, 0, 63, 0, 64, 67, 68, 69, 56, 50, 0, 0, 139, 0, 0, 165, 419, 79, 0, 97, 100, 0, 105, 101, 0, 129, 131, 116, 0, 107, 0, 0, 0, 84, 60, 61, 65, 138, 0, 141, 142, 0, 127, 0, 120, 0, 122, 123, 91, 93, 66, 140, 99, 130, 124 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int16 yydefgoto[] = { -1, 5, 58, 59, 145, 486, 293, 276, 436, 437, 682, 683, 684, 294, 494, 295, 622, 727, 728, 729, 839, 840, 841, 296, 297, 447, 824, 825, 694, 695, 855, 696, 697, 813, 708, 820, 821, 763, 860, 861, 457, 458, 466, 470, 604, 605, 608, 712, 713, 714, 631, 632, 633, 386, 230, 554, 231, 635, 388, 53, 133, 233, 234, 636, 235, 255, 139, 237, 266, 267, 268, 269, 298, 450, 593, 299, 718, 782, 783, 300, 301, 302, 303, 502, 503, 504, 505, 611, 111, 64, 153, 154, 321, 517, 189, 190, 175, 648, 176, 177, 335, 178, 179, 337, 180, 181, 191, 358, 359, 360, 182, 183, 378, 32, 33, 34, 35, 36, 37, 38, 39, 152, 315, 76, 40, 41, 96, 97, 98, 518, 519, 520, 656, 657, 658, 159, 160, 161, 246, 247, 248, 109, 225, 379, 380, 42, 270, 43, 56, 44, 45, 46, 79, 594, 101, 513, 477, 121, 122, 104, 353, 596, 124, 148, 322 }; /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ #define YYPACT_NINF -763 static const yytype_int16 yypact[] = { 497, -763, 2326, 585, 34, 102, -763, 2326, 2326, 105, 115, 133, -763, -763, -763, -763, -763, -763, -763, -763, -763, -763, 3657, 2885, 3048, 1109, 1971, -763, -763, -763, -763, 158, -763, -763, 178, -763, 780, -763, 780, -763, 3048, 140, -763, -763, -763, 193, -763, 171, -763, -763, 208, 1392, -763, -763, 3916, 225, -763, 58, -763, 221, -763, 302, 67, -763, 241, 2557, 2557, -763, -763, -763, 3657, 3135, 3267, -763, -763, -763, 3345, -763, 270, 248, -763, -763, 140, 273, 276, 283, 297, 2652, 321, -763, -763, 1574, 349, 362, 312, 780, 329, 419, -763, 380, 307, -763, -763, 2701, -763, 2701, -763, 379, 303, 361, 105, -763, 1746, -763, -763, -763, -763, -763, -763, -763, -763, -763, -763, -763, 2747, 2793, 140, 333, 3048, 333, 2511, -763, -763, 472, 3741, 483, 1381, 1033, -763, -763, -763, -763, -763, 565, -763, 377, -763, 2944, 2944, 385, 2326, 445, 87, 1320, 62, 2326, 105, 2557, 413, 25, 409, -763, 25, -763, 138, 273, 276, 297, 1905, 321, 349, 362, 422, 429, 438, 479, -763, 138, 138, 3657, -763, 491, 434, -763, 3657, 487, 284, 1594, -763, -763, -763, 134, 2326, -763, 3657, 333, -763, -763, -763, -763, -763, -763, 465, 474, 482, 488, -763, -763, 2326, -763, 2603, 2326, -763, 2326, 565, -763, -763, -763, 2326, 494, -763, 496, 2234, 2372, 2326, 506, -763, -763, -763, 2133, 505, -763, 509, -763, -763, 1628, 1144, -763, 225, 2885, -763, -763, 2885, -763, -763, 116, 495, 504, -763, 536, 542, 140, 518, 2393, -763, 2088, 1300, -763, 1300, -763, 1300, -763, 538, -763, 519, 3660, 546, 556, 489, -763, 602, 549, -763, 540, -763, 3953, 584, 502, 69, 561, 672, 759, 454, 1005, 53, 1278, 1789, 906, 3179, 2944, 204, 166, 920, 534, 548, -763, 557, -763, -763, 149, -763, 65, -763, 3657, -763, 99, 906, 906, 3091, 25, 3306, -763, 2326, 2326, 605, -763, -763, 68, -763, -763, -763, -763, -763, -763, -763, -763, 241, -763, 2326, -763, 2839, -763, 188, 3384, -763, -763, 3657, -763, 3423, -763, -763, 2511, 3462, 3501, -763, 3423, -763, 3423, 565, -763, -763, 3423, 590, 3540, 3423, -763, -763, -763, 553, 570, -763, 536, 594, -763, -763, -763, -763, -763, -763, -763, 589, -763, 307, -763, -763, -763, -763, 105, 604, 600, -763, 642, 2372, 565, 2393, 637, 636, 505, 644, 645, 3694, 606, 36, 2511, 2511, 2511, -763, 2511, -763, -763, -763, -763, 283, 646, -763, 333, 2326, -763, -763, -763, 3916, -763, 3916, -763, 3916, -763, 2511, -763, 2511, -763, 2511, -763, 2511, -763, 2511, 565, -763, -763, 2511, -763, 203, 647, 899, 649, -763, 411, 616, -763, 655, -763, -763, 57, -763, 656, 3760, 84, -763, 418, -763, -763, 909, -763, 909, -763, 909, -763, 311, 250, -763, 688, -763, 658, 3820, -763, 2453, -763, 674, 668, 3839, -763, 712, 689, 3839, -763, 1389, -763, 3423, -763, 693, 3579, 695, 3223, -763, -763, -763, 411, 249, -763, -763, -763, 676, 676, -763, 60, -763, 3005, 961, 676, -763, 2326, 2511, 2701, -763, 712, 711, -763, -763, -763, 3423, 3423, -763, 3618, -763, 3423, -763, -763, 3306, 100, 25, 699, -763, -763, -763, 2326, -763, 2326, -763, -763, 3657, -763, -763, -763, 3657, -763, 3657, -763, -763, 706, -763, 487, -763, -763, 3657, -763, -763, -763, 333, 3423, -763, 241, 2326, 2372, 2280, 600, 516, -763, 626, 3713, 629, -763, 2511, 2472, 714, 2472, 716, -763, -763, -763, -763, -763, -763, -763, -763, 2088, -763, 2088, -763, 707, -763, 549, -763, -763, -763, 3977, -763, 2181, -763, 2944, 164, 2017, 2511, -763, 336, 717, -763, -763, -763, 717, 717, 575, 676, -763, 164, 2017, 715, 719, -763, 363, 712, 226, 708, -763, 226, -763, 43, 3657, 3657, 3657, 340, 1636, 722, 411, -763, 662, 747, 3005, -763, -763, -763, -763, 565, -763, -763, -763, 731, 729, -763, 3855, 3776, -763, -763, 99, 742, -763, -763, -763, -763, 138, -763, -763, 43, -763, -763, -763, 2701, 2326, 712, 740, -763, -763, 3423, -763, -763, -763, -763, -763, -763, -763, -763, -763, -763, -763, -763, 1746, -763, -763, 739, -763, -763, -763, 741, -763, 744, 743, -763, -763, -763, 25, -763, 681, -763, 565, 3916, 1677, 160, -763, -763, 1475, 30, 3804, 1323, 732, 793, 909, -763, -763, 833, -763, 788, -763, 2511, -763, 758, -763, 614, -763, 3916, -763, -763, 3916, -763, -763, -763, 411, -763, 762, -763, 769, 772, -763, -763, 1636, 293, 676, 611, 676, 557, 784, 3932, 3932, 3932, 3932, -763, 2326, 778, -763, -763, -763, -763, -763, -763, -763, -763, 1483, -763, 2017, 943, 30, 3916, 3916, 774, 210, 2017, -763, 3916, -763, -763, 798, 3876, 3876, 3916, -763, 3876, 211, 676, -763, 2017, -763, -763, 363, -763, -763, 852, 91, 293, 1998, -763, 1043, 779, -763, 791, 676, 575, 794, 796, 3897, -763, 3913, -763, -763, -763, -763, 2326, -763, 160, 1460, 3876, 773, 226, -763, -763, -763, 3916, -763, -763, -763, -763, -763, -763, -763, 21, -763, 257, -763, 799, -763, 815, 788, -763, 565, -763, -763, -763, -763, -763, -763, 803, 444, -763, 805, 809, -763, -763, -763, -763, -763, 575, 824, -763, 575, 575, -763, -763, -763, 1844, -763, -763, 818, 1205, -763, 817, 821, -763, -763, 676, -763, 2432, 676, 575, -763, -763, -763, 1181, -763, 575, -763, -763, 2469, -763, 226, -763, 2511, -763, -763, -763, -763, -763, -763, -763, -763, -763 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { -763, -763, -763, -763, -763, -420, -139, -763, -763, 301, -763, -763, 136, -763, 393, 397, -597, 163, -763, 114, -763, -763, 35, 281, 416, -516, -763, 41, 157, -547, -763, -762, -763, -552, 137, -763, 50, -688, -763, -763, -763, 315, -763, -763, -763, -763, -763, -763, 141, 139, -558, 126, 83, 63, 983, -570, 251, 1, -763, -50, 550, -127, -124, -612, 1375, 187, -185, 710, -49, -763, -763, 507, -763, 229, -44, -728, -763, -763, -763, -145, -763, 648, 651, -294, -763, -763, 426, -465, -763, -104, -763, -763, -763, 170, -66, -64, -134, -763, 437, -130, -180, -119, -2, 52, 1614, -763, -763, -763, -763, 404, -763, 620, 1080, -19, -78, -63, -763, -763, -763, 94, 88, -763, -763, -763, -763, 9, 926, -763, 750, 458, -763, 317, -763, -763, 323, -13, -763, 657, 859, -763, 598, -763, -763, 608, 459, 1578, -9, -3, 838, 709, -97, -373, 1464, -59, -763, -763, -1, -763, 970, -379, 19, 308, 29, -763, -123 }; /* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule which number is the opposite. If zero, do what YYDEFACT says. If YYTABLE_NINF, syntax error. */ #define YYTABLE_NINF -471 static const yytype_int16 yytable[] = { 55, 132, 135, 254, 52, 173, 227, 174, 320, 309, 273, 507, 264, 305, 305, 582, 99, 306, 306, 305, 777, 724, 100, 306, 102, 219, 316, 221, 307, 307, 250, 324, 250, 82, 307, 102, 329, 102, 643, 331, 220, 704, 220, 856, 105, 822, 158, 158, 55, 126, 396, 141, 326, 162, 463, 123, 707, 123, 586, 144, 737, -41, 99, 316, 114, 618, 498, 125, 185, 524, 445, 595, 689, 595, 74, 595, 864, 114, 150, 428, 757, 116, 143, 304, 304, -77, 706, 194, 205, 304, 767, 865, 316, 48, 102, 319, 57, 49, 362, 313, 498, 653, 60, 332, 446, 264, 464, 499, 500, 238, 525, 81, 501, 232, 123, 888, 853, 80, -41, 95, 323, 756, 163, 290, 210, 151, 587, 141, 193, 264, -41, 141, 319, 271, 141, 789, 822, 251, 158, 869, 274, 499, -77, 715, 327, 314, 501, 654, 165, 833, 482, 655, 402, 529, -77, 305, 815, 815, 306, 306, 815, 319, 533, 535, 403, 688, 336, 488, 169, 307, 307, 110, 114, 543, 63, 81, 116, 170, 439, 389, 391, 80, 761, 333, 65, 336, 515, 835, 171, 354, 54, 746, 496, 355, 815, 489, 342, 343, 332, 446, 863, 732, 66, 408, 497, 483, 409, 762, 411, 127, 413, 372, 241, 244, 531, 810, 701, 816, 240, 243, 818, 112, 173, 202, 480, 304, 392, 204, 476, 707, 701, 344, 141, 141, 848, 484, 350, 128, 134, 48, 129, 172, 188, 49, 16, 48, 357, 508, 509, 49, 392, 130, 141, 55, 859, 55, 155, 55, -469, -469, 264, 48, 141, 808, 456, 49, 565, 566, 567, 485, 568, 143, -469, 549, 55, 27, 28, 29, 443, 99, 55, 819, 55, 55, 461, 185, 467, 471, 873, 571, 147, 875, 876, 599, 572, 576, 574, 577, 244, 236, 866, 580, 619, 784, 243, 600, 333, 514, 250, 149, 885, 158, 497, 620, 194, 621, 887, 195, 114, 768, 769, 772, 116, 265, 595, 342, 343, 399, 194, 196, 401, 336, 197, 398, 389, 558, 400, 606, 141, 198, 336, 336, 613, 165, 332, 539, 619, 742, 663, 218, 628, 336, 664, 199, 665, 506, 352, 620, 211, 403, 512, 305, 667, 169, 711, 306, 16, 208, 209, 16, 18, 202, 170, 641, 645, 646, 307, 201, 806, 651, 555, 392, 701, 171, 211, 212, 245, 141, 344, 701, 141, 141, 141, 619, 141, 659, -163, 27, 28, 29, 27, 28, 29, 701, 620, 206, 723, 141, 597, 141, 598, 141, 843, 141, -163, 141, 390, 141, 207, 141, 226, 141, 579, 642, 222, 141, 223, -163, -163, -163, 275, 304, 701, 676, 224, 216, 217, 572, 220, 574, 265, 141, 484, 410, 591, 412, 48, 414, 687, 362, 49, 16, 396, 305, 310, 455, 312, 306, 172, 141, 590, 141, 328, 702, 444, 141, 213, 330, 307, 141, 462, 205, 468, 472, 214, 215, 165, 338, 166, 772, 514, 347, 27, 28, 29, 339, 439, 16, 685, 348, 349, 305, 403, 238, 340, 306, 169, 141, 1, 843, 2, 3, 4, 442, 701, 170, 307, 456, 530, 452, 454, 411, 766, 413, 396, 536, 171, 537, 27, 28, 29, 540, 341, 304, 544, 363, 336, 256, 257, 351, 336, 506, 336, 512, 364, 16, 424, 48, 260, 261, 336, 49, 365, 50, 425, 426, 345, 346, 366, 16, 374, 674, 375, 382, 141, 51, 393, 141, 238, 405, 238, 304, 448, 394, 754, 404, 27, 28, 29, 264, 141, 557, 141, 396, 416, 417, 744, 673, -468, 811, 27, 28, 29, 778, 406, 817, 141, 141, 407, 205, 449, 220, 428, -242, 415, -242, 238, 441, 16, 429, 141, 420, 421, 630, 492, 573, 493, 575, 16, -242, 48, 422, 423, -242, 49, 495, 50, 523, 16, 541, 48, -242, -242, 545, 49, 546, 50, 555, 229, 27, 28, 29, 137, -242, 141, 141, 547, 831, 51, 27, 28, 29, 791, 408, 16, 548, 138, 16, 305, 27, 28, 29, 306, 550, 792, 551, 685, 216, 427, 832, 834, 563, 564, 307, 456, 780, 333, 720, 721, 722, 238, 583, 584, 451, 232, 27, 28, 29, 27, 28, 29, 256, 675, 638, 563, 421, 591, 552, 555, 141, 392, -181, 559, 733, 141, 16, 141, 141, 560, -187, -458, 449, 200, 591, -242, 581, -242, 141, 585, 16, 588, 781, 602, 141, 16, 456, 141, 669, 304, 601, -242, 607, 609, 755, -242, 610, 27, 28, 29, 456, 264, 78, -242, -242, 674, 141, 141, 141, 141, 883, 27, 28, 29, 612, -242, 27, 28, 29, 573, 615, 575, 617, 141, 674, 890, 141, 141, 660, 501, 141, 453, 141, 666, 677, 140, 141, 141, 141, -183, 141, -184, 709, 703, 141, 710, 731, 700, 717, 735, 78, 186, 186, 738, 739, 743, 78, 638, 654, 449, 238, 700, -242, 238, -242, 141, 750, 716, 751, 753, 719, 752, 773, 238, 141, 389, 391, 857, -242, 774, 141, 761, -242, 113, 779, 114, 785, 115, 16, 116, -242, -242, 796, 798, 799, 800, 786, 781, 787, 117, 802, 807, -242, 118, 202, 846, 845, 249, 849, 249, 850, 91, 119, -470, 238, 140, 795, 238, 238, 27, 28, 29, 392, 120, 316, 867, 141, 308, 308, 868, 870, 236, 871, 308, 141, 872, 238, 16, 874, 279, 280, 281, 238, 877, 878, 141, 776, 879, 78, 141, 759, 265, 287, 68, 69, 679, 16, 625, 17, 78, 803, 626, 19, 142, 78, 788, 146, 78, 27, 28, 29, 187, 844, 70, 78, 361, 288, 736, 886, 884, 72, 830, 627, 804, 827, 880, 705, 27, 28, 29, 829, 828, 851, 319, 73, 749, 797, 797, 797, 797, 882, 644, 165, 578, 166, 556, 402, 478, 167, 113, 479, 114, 113, 700, 114, 116, 140, 140, 403, 649, 700, 668, 169, 108, 16, 473, 759, 759, 473, 118, 759, 170, 118, 629, 700, 371, 140, 474, 119, 538, 592, 119, 171, 142, 456, 652, 140, 16, 748, 475, 638, 747, 475, 638, 490, 27, 28, 29, 527, 252, 630, 553, 459, 858, 759, 16, 103, 48, 481, 308, 759, 49, 491, 50, 569, 805, 0, 460, 27, 28, 29, 671, 775, 78, 0, 229, 0, 0, 78, 137, 186, 0, 0, 0, 0, 0, 27, 28, 29, 0, 0, 0, 0, 138, 638, 228, 0, 638, 638, 16, 0, 48, 390, 78, 0, 49, 78, 50, 186, 0, 0, 0, 78, 78, 0, 186, 638, 186, 0, 51, 0, 186, 638, 78, 186, 700, 0, 16, 0, 48, 27, 28, 29, 49, 142, 142, 0, 16, 0, 725, 0, 0, 0, 31, 0, 0, 0, 253, 61, 62, 0, 137, 0, 272, 142, 0, 0, 456, 27, 28, 29, 140, 0, 0, 142, 138, 94, 107, 27, 28, 29, 6, 0, 0, 438, 249, 7, 0, 0, 0, 8, 140, 0, 140, 9, 140, 0, 0, 0, 487, 0, 0, 0, 10, 0, 0, 11, 12, 0, 13, 14, 15, 83, 16, 84, 17, 85, 18, 86, 19, 20, 21, 0, 0, 0, 140, 22, 0, 87, 0, 24, 0, 88, 25, 0, 89, 90, 26, 0, 0, 91, 92, 0, 140, 27, 28, 29, 0, 16, 140, 48, 30, 93, 140, 49, 0, 614, 0, 0, 78, 0, 78, 0, 0, 0, 0, 397, 0, 136, -182, 623, 624, 137, 0, 0, 308, 0, 639, 0, 27, 28, 29, 0, 387, 0, 16, 138, 17, 614, 614, 0, 650, 0, 614, 0, 0, 186, 0, 0, 142, 0, 311, 0, 0, 0, 837, 325, 387, 78, 16, 114, 48, 78, 0, 78, 49, 27, 28, 29, 142, 0, 142, 78, 142, 0, 0, 361, 186, 770, 253, -182, 0, 0, 137, 0, 0, 767, 0, 140, 0, 27, 28, 29, 356, 487, 0, 0, 138, 0, 0, 465, 0, 0, 142, 140, 0, 140, 0, 0, 367, 0, 0, 369, 0, 370, 0, 0, 308, 0, 373, 0, 142, 0, 376, 0, 381, 0, 142, 0, 0, 459, 142, 16, 0, 48, 0, 0, 0, 49, 0, 50, 0, 316, 0, 487, 78, 78, 78, 0, 730, 0, 0, 51, 734, 16, 308, 48, 279, 280, 281, 49, 0, 50, 27, 28, 29, 0, 0, 140, 140, 287, 68, 69, 0, 16, 0, 17, 16, 114, 48, 19, 0, 317, 49, 0, 27, 28, 29, 387, 187, 186, 70, 0, 0, 288, 0, 770, 253, 72, 318, 0, 137, 0, 228, 767, 27, 28, 29, 27, 28, 29, 319, 73, 521, 522, 138, 142, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 140, 526, 140, 140, 142, 0, 142, 16, 0, 48, 0, 0, 0, 49, 438, 16, 0, 202, 16, 140, 48, 204, 140, 0, 49, 262, 50, 253, 0, 89, 263, 137, 0, 730, 0, 790, 793, 794, 27, 28, 29, 131, 0, 0, 0, 138, 27, 28, 29, 27, 28, 29, 487, 0, 690, 0, 0, 0, 0, 47, 0, 140, 140, 0, 47, 47, 0, 140, 142, 142, 0, 0, 634, 140, 0, 823, 826, 0, 0, 570, 47, 47, 47, 47, 308, 0, 16, 842, 430, 730, 0, 0, 49, 847, 50, 0, 0, 47, 0, 0, 140, 16, 0, 48, 0, 692, 854, 49, 0, 16, 137, 17, 0, 18, 0, 19, 0, 27, 28, 29, 764, 253, 47, 47, 138, 137, 0, 0, 142, 432, 142, 142, 27, 28, 29, 0, 0, 0, 0, 138, 27, 28, 29, 0, 47, 0, 0, 142, 0, 0, 142, 0, 0, 0, 487, 0, 0, 0, 0, 0, 47, 140, 47, 0, 0, 698, 823, 0, 0, 826, 0, 0, 640, 0, 842, 634, 0, 0, 0, 698, 0, 47, 47, 0, 0, 47, 0, 0, 334, 142, 142, 0, 809, 77, 0, 142, 661, 0, 662, 0, 16, 142, 202, 0, 203, 0, 204, 47, 0, 0, 0, 0, 47, 0, 47, 0, 67, 68, 69, 0, 16, 0, 17, 670, 0, 672, 19, 0, 142, 75, 0, 27, 28, 29, 0, 0, 0, 70, 0, 862, 71, 77, 184, 184, 72, 0, 0, 77, 0, 47, 0, 27, 28, 29, 16, 0, 48, 0, 73, 0, 49, 0, 16, 0, 725, 47, 0, 47, 47, 387, 47, 228, 395, 765, 136, 47, 771, 75, 137, 47, 47, 47, 456, 75, 726, 27, 28, 29, 0, 142, 0, 0, 138, 27, 28, 29, 47, 0, 383, 47, 0, 0, 0, 16, 760, 48, 0, 0, 0, 49, 889, 50, 0, 0, 634, 634, 634, 634, 184, 184, 0, 262, 0, 384, 184, 89, 263, 137, 745, 0, 0, 698, 440, 0, 27, 28, 29, 0, 698, 184, 228, 138, 0, 0, 814, 814, 0, 0, 814, 0, 77, 0, 698, 0, 0, 77, 0, 0, 184, 0, 0, 0, 0, 0, 0, 77, 0, 0, 634, 47, 47, 634, 16, 0, 48, 75, 0, 0, 49, 0, 50, 698, 814, 469, 0, 47, 75, 47, 0, 0, 0, 75, 229, 0, 75, 0, 137, 0, 0, 0, 0, 75, 0, 27, 28, 29, 0, 0, 0, 0, 138, 0, 0, 0, 0, 16, 801, 48, 0, 0, 0, 49, 634, 50, 0, 634, 634, 0, 0, 0, 387, 0, 0, 0, 771, 51, 0, 0, 228, 47, 0, 0, 387, 0, 634, 0, 27, 28, 29, 0, 634, 0, 0, 698, 0, 0, 0, 0, 0, 184, 184, 0, 0, 47, 637, 383, 0, 0, 0, 0, 16, 760, 48, 0, 77, 852, 49, 0, 50, 77, 0, 184, 0, 0, 0, 0, 0, 0, 262, 0, 384, 0, 89, 385, 137, 0, 0, 0, 0, 334, 0, 27, 28, 29, 184, 0, 0, 77, 138, 184, 75, 0, 0, 184, 184, 75, 184, 0, 184, 0, 0, 0, 184, 0, 184, 184, 0, 67, 68, 69, 0, 16, 0, 17, 0, 0, 0, 19, 0, 0, 75, 0, 0, 75, 0, 0, 0, 0, 70, 75, 75, 71, 0, 0, 200, 72, 47, 699, 47, 0, 75, 0, 27, 28, 29, 6, 0, 637, 0, 73, 7, 699, 0, 0, 8, 0, 0, 0, 9, 0, 47, 0, 47, 0, 0, 0, 0, 10, 0, 0, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 47, 47, 47, 22, 690, 23, 0, 24, 0, 0, 25, 0, 0, 0, 26, 0, 106, 16, 0, 17, 0, 27, 28, 29, 0, 0, 0, 0, 30, 836, 0, 691, 0, 440, 0, 686, 16, 837, 430, 838, 184, 0, 49, 77, 0, 77, 0, 0, 27, 28, 29, 0, 0, 758, 0, 692, 693, 0, 0, 184, 137, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 0, 184, 184, 138, 184, 0, 184, 0, 75, 184, 75, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 184, 0, 0, 0, 184, 0, 184, 637, 637, 637, 637, 0, 47, 47, 184, 16, 0, 48, 0, 184, 0, 49, 0, 0, 699, 0, 0, 0, 228, 0, 0, 699, 0, 397, 0, 136, 75, 758, 758, 137, 75, 758, 75, 0, 0, 699, 27, 28, 29, 0, 75, 0, 0, 138, 0, 383, 0, 0, 0, 184, 16, 637, 48, 0, 637, 0, 49, 0, 50, 0, 0, 0, 0, 0, 699, 758, 0, 0, 262, 0, 384, 758, 89, 385, 137, 0, 0, 77, 77, 77, 0, 27, 28, 29, 0, 0, 0, 184, 138, 0, 0, 47, 0, 0, 0, 0, 0, 0, 16, 0, 17, 686, 18, 0, 19, 637, 0, 0, 637, 637, 680, 0, 0, 75, 75, 75, 0, 0, 432, 6, 681, 0, 184, 0, 7, 0, 0, 637, 8, 27, 28, 29, 9, 637, 0, 0, 699, 0, 0, 0, 0, 10, 0, 0, 11, 12, 0, 13, 14, 15, 47, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 6, 23, 0, 24, 0, 7, 25, 0, 0, 8, 26, 0, -439, 9, 0, 0, 0, 27, 28, 29, 0, 0, 10, 0, 30, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 6, 23, 0, 24, 0, 7, 25, 0, 0, 8, 26, 0, -438, 9, 0, 0, 0, 27, 28, 29, 0, 0, 10, 0, 30, 11, 12, 0, 13, 14, 15, 0, 16, 184, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 6, 23, 0, 24, 0, 7, 25, 0, 0, 8, 26, 0, 0, 377, 0, 0, 0, 27, 28, 29, 0, 228, 10, 0, 30, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 0, 23, 383, 24, 0, 0, 25, 16, 0, 48, 26, 0, 0, 49, 228, 50, 0, 27, 28, 29, 0, 0, 0, 0, 30, 262, 0, 384, 0, 89, 263, 137, 0, 0, 0, 228, 0, 0, 27, 28, 29, 383, 0, 0, 0, 138, 16, 0, 48, 0, 0, 690, 49, 0, 228, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 881, 253, 16, 0, 48, 137, 0, 0, 49, 0, 0, 0, 27, 28, 29, 0, 0, 0, 16, 138, 430, 16, 253, 48, 49, -153, 137, 49, 228, 50, 0, 0, 0, 27, 28, 29, 0, 692, 693, 0, 138, 253, 137, 0, 0, 137, 0, 0, 0, 27, 28, 29, 27, 28, 29, 0, 138, 0, 0, 138, 16, 0, 48, 0, 0, 0, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 253, 0, 0, 8, 137, 0, 0, 156, 0, 0, 0, 27, 28, 29, 0, 0, 10, 0, 138, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 0, 23, 0, 24, 0, 7, 25, 0, 0, 8, 26, 157, 0, 9, 0, 0, 0, 27, 28, 29, 0, 0, 10, 0, 30, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 0, 242, 0, 24, 0, 0, 25, 0, 7, 368, 26, 0, 8, 0, 0, 0, 9, 27, 28, 29, 0, 0, 0, 0, 30, 10, 0, 0, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 0, 0, 0, 24, 0, 0, 25, 0, 7, 200, 26, 0, 8, 0, 0, 0, 9, 27, 28, 29, 0, 0, 0, 0, 30, 10, 0, 0, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 0, 23, 0, 24, 0, 7, 25, 0, 0, 8, 26, 0, 0, 9, 0, 0, 0, 27, 28, 29, 0, 0, 10, 0, 30, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 0, 239, 0, 24, 0, 7, 25, 0, 0, 8, 26, 0, 0, 9, 0, 0, 0, 27, 28, 29, 0, 0, 10, 0, 30, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 0, 242, 0, 24, 0, 7, 25, 0, 0, 8, 26, 0, 0, 156, 0, 0, 0, 27, 28, 29, 0, 0, 10, 0, 30, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 0, 23, 0, 24, 0, 7, 25, 0, 0, 8, 26, 0, 0, 9, 0, 0, 0, 27, 28, 29, 0, 0, 10, 0, 30, 11, 12, 0, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 22, 0, 0, 0, 24, 0, 0, 25, 0, 0, 0, 26, 0, 0, 0, 0, 0, 0, 27, 28, 29, 277, 278, 0, 0, 30, 0, 0, 0, 279, 280, 281, 282, 283, 284, 0, 0, 285, 286, 0, 0, 0, 287, 68, 69, 0, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 187, 0, 70, 0, 0, 288, 0, 0, 0, 72, 289, 0, 0, 0, 0, 290, 27, 28, 29, 291, 292, 277, 278, 73, 0, 0, 0, 0, 0, 279, 280, 281, 282, 283, 284, 0, 0, 285, 286, 0, 0, 0, 287, 68, 69, 0, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 187, 0, 70, 0, 0, 288, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 27, 28, 29, 291, 292, 0, 12, 73, 13, 14, 15, 0, 16, 0, 17, 0, 18, 0, 19, 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 24, 0, 0, 25, 0, 0, 0, 26, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 0, 0, 0, 30, 67, 68, 69, 113, 16, 114, 17, 0, 0, 116, 19, 0, 0, 0, -246, 194, 0, 0, 0, 510, 0, 70, 0, 118, 71, 0, -246, 0, 72, 0, 0, 474, 119, 0, 0, 27, 28, 29, 0, 0, 0, 0, 73, 511, 164, 68, 69, 165, 16, 166, 17, 0, 0, 167, 19, 0, 0, 0, 0, 0, 0, 0, 0, 168, 0, 70, 0, 169, 71, 0, 89, 90, 72, 0, 0, 0, 170, 0, 0, 27, 28, 29, 0, 0, 0, 0, 73, 171, 287, 68, 69, 165, 16, 166, 17, 0, 0, 167, 19, 0, 0, 0, 0, 0, 0, 0, 0, 168, 0, 70, 0, 169, 288, 0, 89, 90, 72, 0, 0, 0, 170, 0, 0, 27, 28, 29, 0, 0, 0, 0, 73, 171, 67, 68, 69, 113, 16, 114, 17, 0, 0, 116, 19, 0, 0, 0, 0, 194, 0, 0, 0, 510, 0, 70, 0, 118, 71, 0, 0, 0, 72, 0, 0, 474, 119, 0, 0, 27, 28, 29, 0, 0, 0, 0, 73, 511, 164, 68, 69, 0, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 187, 0, 70, 0, 0, 71, 0, 0, 0, 72, 0, 106, 0, 0, 0, 0, 27, 28, 29, 0, 164, 68, 69, 73, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 187, 0, 70, 0, 0, 71, 0, 0, 0, 72, 516, 0, 0, 0, 0, 0, 27, 28, 29, 0, 67, 68, 69, 73, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 70, 192, 0, 71, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 67, 68, 69, 73, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 528, 0, 70, 0, 0, 71, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 164, 68, 69, 73, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 187, 0, 70, 0, 0, 71, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 67, 68, 69, 73, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 532, 0, 70, 0, 0, 71, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 67, 68, 69, 73, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 534, 0, 70, 0, 0, 71, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 67, 68, 69, 73, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 542, 0, 70, 0, 0, 71, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 67, 68, 69, 73, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 70, 0, 0, 71, 0, 0, 616, 72, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 647, 68, 69, 73, 16, 0, 17, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 187, 0, 70, 0, 0, 71, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 27, 28, 29, 0, 67, 68, 69, 73, 16, 0, 17, 16, 0, 48, 19, 0, 0, 49, 0, 0, 0, 0, 0, 0, 0, 70, 0, 0, 71, 397, 0, 136, 72, 418, 419, 137, 0, 0, 0, 27, 28, 29, 27, 28, 29, 16, 73, 48, 0, 138, 0, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 397, 16, 136, 48, 561, 562, 137, 49, 0, 0, 0, 0, 0, 27, 28, 29, 0, 0, 0, 397, 138, 136, 0, 561, 419, 137, 0, 0, 0, 16, 0, 48, 27, 28, 29, 49, 0, 0, 0, 138, 0, 0, 0, 0, 0, 0, 0, 0, 16, 136, 48, 258, 259, 137, 49, 0, 0, 589, 0, 0, 27, 28, 29, 0, 16, 0, 48, 138, 136, -182, 49, 0, 137, 0, 0, 0, 0, 0, 0, 27, 28, 29, 741, 0, 136, -182, 138, 0, 137, 0, 0, 0, 16, 114, 48, 27, 28, 29, 49, 0, 0, 0, 138, 0, 0, 0, 0, 0, 16, 0, 48, 0, 136, 0, 49, 0, 137, 603, 0, 767, 0, 0, 0, 27, 28, 29, 0, 16, 136, 48, 138, 0, 137, 49, 0, 0, 0, 0, 0, 27, 28, 29, 0, 16, 0, 48, 138, 136, -182, 49, 0, 137, 0, 0, 0, 0, 0, 0, 27, 28, 29, 740, 0, 136, 16, 138, 48, 137, 0, 0, 49, 0, 0, 0, 27, 28, 29, 0, 0, 0, 0, 138, 0, 812, 253, 16, 0, 48, 137, 0, 0, 49, 0, 50, 0, 27, 28, 29, 0, 0, 0, 16, 138, 48, 16, 229, 48, 49, 0, 137, 49, 0, 0, 0, 0, 0, 27, 28, 29, 741, 16, 136, 48, 138, 136, 137, 49, 0, 137, 0, 0, 0, 27, 28, 29, 27, 28, 29, 0, 138, 253, 16, 138, 430, 137, 18, 0, 431, 0, 0, 0, 27, 28, 29, 0, 0, 0, 0, 138, 0, 0, 432, 0, 433, 434, 16, 0, 430, 0, 18, 435, 431, 27, 28, 29, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 432, 0, 0, 678, 0, 0, 0, 0, 0, 435, 0, 27, 28, 29 }; static const yytype_int16 yycheck[] = { 3, 51, 51, 130, 3, 71, 110, 71, 153, 148, 137, 305, 136, 147, 148, 435, 25, 147, 148, 153, 708, 618, 25, 153, 25, 103, 1, 105, 147, 148, 127, 154, 129, 24, 153, 36, 159, 38, 503, 162, 103, 599, 105, 805, 25, 773, 65, 66, 51, 40, 235, 54, 156, 66, 1, 36, 603, 38, 1, 1, 630, 1, 71, 1, 34, 485, 1, 38, 71, 1, 1, 450, 588, 452, 22, 454, 55, 34, 11, 43, 692, 38, 46, 147, 148, 1, 602, 44, 91, 153, 60, 70, 1, 35, 95, 70, 62, 39, 195, 12, 1, 1, 0, 60, 35, 229, 53, 42, 43, 112, 42, 23, 47, 112, 95, 877, 804, 23, 58, 25, 58, 691, 70, 63, 95, 58, 69, 130, 76, 253, 70, 134, 70, 136, 137, 732, 864, 128, 157, 827, 143, 42, 58, 608, 157, 58, 47, 47, 32, 58, 289, 51, 36, 333, 70, 289, 768, 769, 288, 289, 772, 70, 342, 343, 48, 1, 168, 1, 52, 288, 289, 13, 34, 353, 69, 87, 38, 61, 275, 229, 229, 87, 22, 164, 69, 187, 309, 784, 72, 55, 3, 656, 43, 59, 806, 29, 177, 178, 60, 35, 812, 621, 69, 253, 55, 1, 256, 47, 258, 69, 260, 214, 124, 125, 341, 762, 589, 769, 124, 125, 772, 43, 288, 35, 288, 289, 229, 39, 287, 776, 603, 179, 235, 236, 792, 31, 184, 44, 51, 35, 69, 71, 72, 39, 33, 35, 194, 306, 307, 39, 253, 43, 255, 256, 806, 258, 15, 260, 55, 56, 384, 35, 265, 53, 53, 39, 393, 394, 395, 65, 397, 46, 69, 377, 277, 64, 65, 66, 277, 288, 283, 70, 285, 286, 283, 288, 285, 286, 846, 416, 69, 849, 850, 43, 418, 422, 420, 424, 210, 112, 43, 428, 53, 723, 210, 55, 287, 308, 405, 7, 868, 330, 55, 64, 44, 66, 874, 69, 34, 698, 699, 700, 38, 136, 703, 306, 307, 239, 44, 56, 242, 333, 56, 239, 384, 384, 242, 464, 341, 56, 342, 343, 476, 32, 60, 348, 53, 641, 528, 42, 495, 353, 532, 56, 534, 303, 72, 64, 55, 48, 308, 495, 542, 52, 1, 495, 33, 55, 56, 33, 37, 35, 61, 500, 508, 509, 495, 56, 757, 513, 383, 384, 755, 72, 55, 56, 53, 390, 336, 762, 393, 394, 395, 53, 397, 518, 33, 64, 65, 66, 64, 65, 66, 776, 64, 56, 66, 410, 452, 412, 454, 414, 785, 416, 51, 418, 229, 420, 56, 422, 59, 424, 425, 501, 45, 428, 47, 64, 65, 66, 53, 495, 805, 560, 55, 55, 56, 561, 501, 563, 253, 444, 31, 256, 447, 258, 35, 260, 587, 546, 39, 33, 637, 587, 69, 1, 11, 587, 288, 462, 42, 464, 49, 590, 277, 468, 47, 58, 587, 472, 283, 474, 285, 286, 55, 56, 32, 55, 34, 858, 481, 47, 64, 65, 66, 56, 583, 33, 585, 55, 56, 625, 48, 496, 56, 625, 52, 500, 1, 872, 3, 4, 5, 1, 877, 61, 625, 53, 338, 280, 281, 561, 697, 563, 699, 345, 72, 347, 64, 65, 66, 351, 43, 587, 354, 60, 528, 55, 56, 42, 532, 479, 534, 481, 60, 33, 47, 35, 55, 56, 542, 39, 60, 41, 55, 56, 55, 56, 60, 33, 56, 554, 56, 47, 557, 53, 51, 560, 561, 55, 563, 625, 1, 54, 687, 70, 64, 65, 66, 693, 573, 384, 575, 758, 55, 56, 654, 61, 42, 764, 64, 65, 66, 710, 42, 770, 589, 590, 70, 592, 29, 654, 43, 32, 56, 34, 599, 13, 33, 59, 603, 55, 56, 28, 70, 418, 58, 420, 33, 48, 35, 55, 56, 52, 39, 58, 41, 12, 33, 29, 35, 60, 61, 70, 39, 55, 41, 630, 53, 64, 65, 66, 57, 72, 637, 638, 42, 782, 53, 64, 65, 66, 31, 693, 33, 56, 71, 33, 782, 64, 65, 66, 782, 49, 43, 55, 753, 55, 56, 782, 783, 55, 56, 782, 53, 51, 647, 615, 616, 617, 673, 55, 56, 1, 673, 64, 65, 66, 64, 65, 66, 55, 56, 496, 55, 56, 689, 45, 691, 692, 693, 54, 56, 31, 697, 33, 699, 700, 54, 54, 53, 29, 56, 706, 32, 56, 34, 710, 53, 33, 54, 714, 54, 716, 33, 53, 719, 547, 782, 31, 48, 47, 54, 42, 52, 13, 64, 65, 66, 53, 854, 22, 60, 61, 737, 738, 739, 740, 741, 866, 64, 65, 66, 54, 72, 64, 65, 66, 561, 56, 563, 56, 755, 756, 881, 758, 759, 58, 47, 762, 1, 764, 56, 56, 54, 768, 769, 770, 54, 772, 54, 56, 55, 776, 55, 53, 589, 69, 31, 70, 71, 72, 51, 54, 42, 76, 599, 47, 29, 792, 603, 32, 795, 34, 797, 56, 609, 56, 55, 612, 56, 69, 805, 806, 854, 854, 805, 48, 15, 812, 22, 52, 32, 55, 34, 53, 36, 33, 38, 60, 61, 738, 739, 740, 741, 56, 829, 55, 48, 51, 56, 72, 52, 35, 43, 56, 127, 43, 129, 43, 60, 61, 69, 846, 134, 61, 849, 850, 64, 65, 66, 854, 72, 1, 55, 858, 147, 148, 43, 56, 673, 56, 153, 866, 55, 868, 33, 43, 16, 17, 18, 874, 54, 56, 877, 42, 55, 168, 881, 692, 693, 29, 30, 31, 583, 33, 493, 35, 179, 753, 493, 39, 54, 184, 731, 57, 187, 64, 65, 66, 48, 787, 50, 194, 195, 53, 625, 872, 867, 57, 58, 495, 755, 776, 864, 600, 64, 65, 66, 780, 779, 795, 70, 71, 673, 738, 739, 740, 741, 866, 504, 32, 425, 34, 384, 36, 288, 38, 32, 288, 34, 32, 755, 34, 38, 235, 236, 48, 511, 762, 546, 52, 26, 33, 48, 768, 769, 48, 52, 772, 61, 52, 1, 776, 214, 255, 60, 61, 348, 60, 61, 72, 134, 53, 516, 265, 33, 660, 72, 792, 657, 72, 795, 63, 64, 65, 66, 330, 129, 28, 382, 282, 805, 806, 33, 25, 35, 288, 289, 812, 39, 292, 41, 405, 61, -1, 1, 64, 65, 66, 551, 703, 303, -1, 53, -1, -1, 308, 57, 310, -1, -1, -1, -1, -1, 64, 65, 66, -1, -1, -1, -1, 71, 846, 1, -1, 849, 850, 33, -1, 35, 854, 333, -1, 39, 336, 41, 338, -1, -1, -1, 342, 343, -1, 345, 868, 347, -1, 53, -1, 351, 874, 353, 354, 877, -1, 33, -1, 35, 64, 65, 66, 39, 235, 236, -1, 33, -1, 35, -1, -1, -1, 2, -1, -1, -1, 53, 7, 8, -1, 57, -1, 59, 255, -1, -1, 53, 64, 65, 66, 390, -1, -1, 265, 71, 25, 26, 64, 65, 66, 1, -1, -1, 275, 405, 6, -1, -1, -1, 10, 410, -1, 412, 14, 414, -1, -1, -1, 290, -1, -1, -1, 23, -1, -1, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, -1, -1, -1, 444, 46, -1, 48, -1, 50, -1, 52, 53, -1, 55, 56, 57, -1, -1, 60, 61, -1, 462, 64, 65, 66, -1, 33, 468, 35, 71, 72, 472, 39, -1, 476, -1, -1, 479, -1, 481, -1, -1, -1, -1, 51, -1, 53, 54, 490, 491, 57, -1, -1, 495, -1, 497, -1, 64, 65, 66, -1, 229, -1, 33, 71, 35, 508, 509, -1, 511, -1, 513, -1, -1, 516, -1, -1, 390, -1, 150, -1, -1, -1, 53, 155, 253, 528, 33, 34, 35, 532, -1, 534, 39, 64, 65, 66, 410, -1, 412, 542, 414, -1, -1, 546, 547, 52, 53, 54, -1, -1, 57, -1, -1, 60, -1, 557, -1, 64, 65, 66, 192, 435, -1, -1, 71, -1, -1, 1, -1, -1, 444, 573, -1, 575, -1, -1, 208, -1, -1, 211, -1, 213, -1, -1, 587, -1, 218, -1, 462, -1, 222, -1, 224, -1, 468, -1, -1, 600, 472, 33, -1, 35, -1, -1, -1, 39, -1, 41, -1, 1, -1, 485, 615, 616, 617, -1, 619, -1, -1, 53, 623, 33, 625, 35, 16, 17, 18, 39, -1, 41, 64, 65, 66, -1, -1, 637, 638, 29, 30, 31, -1, 33, -1, 35, 33, 34, 35, 39, -1, 41, 39, -1, 64, 65, 66, 384, 48, 660, 50, -1, -1, 53, -1, 52, 53, 57, 58, -1, 57, -1, 1, 60, 64, 65, 66, 64, 65, 66, 70, 71, 312, 313, 71, 557, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 697, 328, 699, 700, 573, -1, 575, 33, -1, 35, -1, -1, -1, 39, 583, 33, -1, 35, 33, 716, 35, 39, 719, -1, 39, 51, 41, 53, -1, 55, 56, 57, -1, 731, -1, 733, 734, 735, 64, 65, 66, 56, -1, -1, -1, 71, 64, 65, 66, 64, 65, 66, 621, -1, 1, -1, -1, -1, -1, 2, -1, 758, 759, -1, 7, 8, -1, 764, 637, 638, -1, -1, 496, 770, -1, 773, 774, -1, -1, 406, 23, 24, 25, 26, 782, -1, 33, 785, 35, 787, -1, -1, 39, 791, 41, -1, -1, 40, -1, -1, 797, 33, -1, 35, -1, 52, 53, 39, -1, 33, 57, 35, -1, 37, -1, 39, -1, 64, 65, 66, 52, 53, 65, 66, 71, 57, -1, -1, 697, 53, 699, 700, 64, 65, 66, -1, -1, -1, -1, 71, 64, 65, 66, -1, 87, -1, -1, 716, -1, -1, 719, -1, -1, -1, 723, -1, -1, -1, -1, -1, 103, 858, 105, -1, -1, 589, 864, -1, -1, 867, -1, -1, 499, -1, 872, 599, -1, -1, -1, 603, -1, 124, 125, -1, -1, 128, -1, -1, 1, 758, 759, -1, 761, 22, -1, 764, 523, -1, 525, -1, 33, 770, 35, -1, 37, -1, 39, 150, -1, -1, -1, -1, 155, -1, 157, -1, 29, 30, 31, -1, 33, -1, 35, 550, -1, 552, 39, -1, 797, 22, -1, 64, 65, 66, -1, -1, -1, 50, -1, 808, 53, 70, 71, 72, 57, -1, -1, 76, -1, 192, -1, 64, 65, 66, 33, -1, 35, -1, 71, -1, 39, -1, 33, -1, 35, 208, -1, 210, 211, 693, 213, 1, 51, 697, 53, 218, 700, 70, 57, 222, 223, 224, 53, 76, 55, 64, 65, 66, -1, 858, -1, -1, 71, 64, 65, 66, 239, -1, 28, 242, -1, -1, -1, 33, 34, 35, -1, -1, -1, 39, 879, 41, -1, -1, 738, 739, 740, 741, 147, 148, -1, 51, -1, 53, 153, 55, 56, 57, 655, -1, -1, 755, 275, -1, 64, 65, 66, -1, 762, 168, 1, 71, -1, -1, 768, 769, -1, -1, 772, -1, 179, -1, 776, -1, -1, 184, -1, -1, 187, -1, -1, -1, -1, -1, -1, 194, -1, -1, 792, 312, 313, 795, 33, -1, 35, 168, -1, -1, 39, -1, 41, 805, 806, 1, -1, 328, 179, 330, -1, -1, -1, 184, 53, -1, 187, -1, 57, -1, -1, -1, -1, 194, -1, 64, 65, 66, -1, -1, -1, -1, 71, -1, -1, -1, -1, 33, 743, 35, -1, -1, -1, 39, 846, 41, -1, 849, 850, -1, -1, -1, 854, -1, -1, -1, 858, 53, -1, -1, 1, 382, -1, -1, 866, -1, 868, -1, 64, 65, 66, -1, 874, -1, -1, 877, -1, -1, -1, -1, -1, 288, 289, -1, -1, 406, 496, 28, -1, -1, -1, -1, 33, 34, 35, -1, 303, 802, 39, -1, 41, 308, -1, 310, -1, -1, -1, -1, -1, -1, 51, -1, 53, -1, 55, 56, 57, -1, -1, -1, -1, 1, -1, 64, 65, 66, 333, -1, -1, 336, 71, 338, 303, -1, -1, 342, 343, 308, 345, -1, 347, -1, -1, -1, 351, -1, 353, 354, -1, 29, 30, 31, -1, 33, -1, 35, -1, -1, -1, 39, -1, -1, 333, -1, -1, 336, -1, -1, -1, -1, 50, 342, 343, 53, -1, -1, 56, 57, 499, 589, 501, -1, 353, -1, 64, 65, 66, 1, -1, 599, -1, 71, 6, 603, -1, -1, 10, -1, -1, -1, 14, -1, 523, -1, 525, -1, -1, -1, -1, 23, -1, -1, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, 550, 551, 552, 46, 1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, 59, 33, -1, 35, -1, 64, 65, 66, -1, -1, -1, -1, 71, 45, -1, 28, -1, 583, -1, 585, 33, 53, 35, 55, 476, -1, 39, 479, -1, 481, -1, -1, 64, 65, 66, -1, -1, 692, -1, 52, 53, -1, -1, 495, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, -1, 508, 509, 71, 511, -1, 513, -1, 479, 516, 481, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 528, -1, -1, -1, 532, -1, 534, 738, 739, 740, 741, -1, 654, 655, 542, 33, -1, 35, -1, 547, -1, 39, -1, -1, 755, -1, -1, -1, 1, -1, -1, 762, -1, 51, -1, 53, 528, 768, 769, 57, 532, 772, 534, -1, -1, 776, 64, 65, 66, -1, 542, -1, -1, 71, -1, 28, -1, -1, -1, 587, 33, 792, 35, -1, 795, -1, 39, -1, 41, -1, -1, -1, -1, -1, 805, 806, -1, -1, 51, -1, 53, 812, 55, 56, 57, -1, -1, 615, 616, 617, -1, 64, 65, 66, -1, -1, -1, 625, 71, -1, -1, 743, -1, -1, -1, -1, -1, -1, 33, -1, 35, 753, 37, -1, 39, 846, -1, -1, 849, 850, 45, -1, -1, 615, 616, 617, -1, -1, 53, 1, 55, -1, 660, -1, 6, -1, -1, 868, 10, 64, 65, 66, 14, 874, -1, -1, 877, -1, -1, -1, -1, 23, -1, -1, 26, 27, -1, 29, 30, 31, 802, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, 1, 48, -1, 50, -1, 6, 53, -1, -1, 10, 57, -1, 59, 14, -1, -1, -1, 64, 65, 66, -1, -1, 23, -1, 71, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, 1, 48, -1, 50, -1, 6, 53, -1, -1, 10, 57, -1, 59, 14, -1, -1, -1, 64, 65, 66, -1, -1, 23, -1, 71, 26, 27, -1, 29, 30, 31, -1, 33, 782, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, 1, 48, -1, 50, -1, 6, 53, -1, -1, 10, 57, -1, -1, 14, -1, -1, -1, 64, 65, 66, -1, 1, 23, -1, 71, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, -1, 48, 28, 50, -1, -1, 53, 33, -1, 35, 57, -1, -1, 39, 1, 41, -1, 64, 65, 66, -1, -1, -1, -1, 71, 51, -1, 53, -1, 55, 56, 57, -1, -1, -1, 1, -1, -1, 64, 65, 66, 28, -1, -1, -1, 71, 33, -1, 35, -1, -1, 1, 39, -1, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 52, 53, 33, -1, 35, 57, -1, -1, 39, -1, -1, -1, 64, 65, 66, -1, -1, -1, 33, 71, 35, 33, 53, 35, 39, 56, 57, 39, 1, 41, -1, -1, -1, 64, 65, 66, -1, 52, 53, -1, 71, 53, 57, -1, -1, 57, -1, -1, -1, 64, 65, 66, 64, 65, 66, -1, 71, -1, -1, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 6, 53, -1, -1, 10, 57, -1, -1, 14, -1, -1, -1, 64, 65, 66, -1, -1, 23, -1, 71, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, -1, 48, -1, 50, -1, 6, 53, -1, -1, 10, 57, 58, -1, 14, -1, -1, -1, 64, 65, 66, -1, -1, 23, -1, 71, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, -1, 48, -1, 50, -1, -1, 53, -1, 6, 56, 57, -1, 10, -1, -1, -1, 14, 64, 65, 66, -1, -1, -1, -1, 71, 23, -1, -1, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, -1, -1, -1, 50, -1, -1, 53, -1, 6, 56, 57, -1, 10, -1, -1, -1, 14, 64, 65, 66, -1, -1, -1, -1, 71, 23, -1, -1, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, -1, 48, -1, 50, -1, 6, 53, -1, -1, 10, 57, -1, -1, 14, -1, -1, -1, 64, 65, 66, -1, -1, 23, -1, 71, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, -1, 48, -1, 50, -1, 6, 53, -1, -1, 10, 57, -1, -1, 14, -1, -1, -1, 64, 65, 66, -1, -1, 23, -1, 71, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, -1, 48, -1, 50, -1, 6, 53, -1, -1, 10, 57, -1, -1, 14, -1, -1, -1, 64, 65, 66, -1, -1, 23, -1, 71, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, -1, 48, -1, 50, -1, 6, 53, -1, -1, 10, 57, -1, -1, 14, -1, -1, -1, 64, 65, 66, -1, -1, 23, -1, 71, 26, 27, -1, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, 46, -1, -1, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, 8, 9, -1, -1, 71, -1, -1, -1, 16, 17, 18, 19, 20, 21, -1, -1, 24, 25, -1, -1, -1, 29, 30, 31, -1, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, 58, -1, -1, -1, -1, 63, 64, 65, 66, 67, 68, 8, 9, 71, -1, -1, -1, -1, -1, 16, 17, 18, 19, 20, 21, -1, -1, 24, 25, -1, -1, -1, 29, 30, 31, -1, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, 67, 68, -1, 27, 71, 29, 30, 31, -1, 33, -1, 35, -1, 37, -1, 39, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, -1, -1, -1, 71, 29, 30, 31, 32, 33, 34, 35, -1, -1, 38, 39, -1, -1, -1, 43, 44, -1, -1, -1, 48, -1, 50, -1, 52, 53, -1, 55, -1, 57, -1, -1, 60, 61, -1, -1, 64, 65, 66, -1, -1, -1, -1, 71, 72, 29, 30, 31, 32, 33, 34, 35, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, 52, 53, -1, 55, 56, 57, -1, -1, -1, 61, -1, -1, 64, 65, 66, -1, -1, -1, -1, 71, 72, 29, 30, 31, 32, 33, 34, 35, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, 52, 53, -1, 55, 56, 57, -1, -1, -1, 61, -1, -1, 64, 65, 66, -1, -1, -1, -1, 71, 72, 29, 30, 31, 32, 33, 34, 35, -1, -1, 38, 39, -1, -1, -1, -1, 44, -1, -1, -1, 48, -1, 50, -1, 52, 53, -1, -1, -1, 57, -1, -1, 60, 61, -1, -1, 64, 65, 66, -1, -1, -1, -1, 71, 72, 29, 30, 31, -1, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, 59, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, 58, -1, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 50, 51, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 50, -1, -1, 53, -1, -1, 56, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, -1, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, 48, -1, 50, -1, -1, 53, -1, -1, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, -1, 29, 30, 31, 71, 33, -1, 35, 33, -1, 35, 39, -1, -1, 39, -1, -1, -1, -1, -1, -1, -1, 50, -1, -1, 53, 51, -1, 53, 57, 55, 56, 57, -1, -1, -1, 64, 65, 66, 64, 65, 66, 33, 71, 35, -1, 71, -1, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 51, 33, 53, 35, 55, 56, 57, 39, -1, -1, -1, -1, -1, 64, 65, 66, -1, -1, -1, 51, 71, 53, -1, 55, 56, 57, -1, -1, -1, 33, -1, 35, 64, 65, 66, 39, -1, -1, -1, 71, -1, -1, -1, -1, -1, -1, -1, -1, 33, 53, 35, 55, 56, 57, 39, -1, -1, 42, -1, -1, 64, 65, 66, -1, 33, -1, 35, 71, 53, 54, 39, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, 51, -1, 53, 54, 71, -1, 57, -1, -1, -1, 33, 34, 35, 64, 65, 66, 39, -1, -1, -1, 71, -1, -1, -1, -1, -1, 33, -1, 35, -1, 53, -1, 39, -1, 57, 42, -1, 60, -1, -1, -1, 64, 65, 66, -1, 33, 53, 35, 71, -1, 57, 39, -1, -1, -1, -1, -1, 64, 65, 66, -1, 33, -1, 35, 71, 53, 54, 39, -1, 57, -1, -1, -1, -1, -1, -1, 64, 65, 66, 51, -1, 53, 33, 71, 35, 57, -1, -1, 39, -1, -1, -1, 64, 65, 66, -1, -1, -1, -1, 71, -1, 52, 53, 33, -1, 35, 57, -1, -1, 39, -1, 41, -1, 64, 65, 66, -1, -1, -1, 33, 71, 35, 33, 53, 35, 39, -1, 57, 39, -1, -1, -1, -1, -1, 64, 65, 66, 51, 33, 53, 35, 71, 53, 57, 39, -1, 57, -1, -1, -1, 64, 65, 66, 64, 65, 66, -1, 71, 53, 33, 71, 35, 57, 37, -1, 39, -1, -1, -1, 64, 65, 66, -1, -1, -1, -1, 71, -1, -1, 53, -1, 55, 56, 33, -1, 35, -1, 37, 62, 39, 64, 65, 66, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, -1, -1, -1, -1, -1, 62, -1, 64, 65, 66 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing symbol of state STATE-NUM. */ static const yytype_uint8 yystos[] = { 0, 1, 3, 4, 5, 74, 1, 6, 10, 14, 23, 26, 27, 29, 30, 31, 33, 35, 37, 39, 40, 41, 46, 48, 50, 53, 57, 64, 65, 66, 71, 185, 186, 187, 188, 189, 190, 191, 192, 193, 197, 198, 218, 220, 222, 223, 224, 225, 35, 39, 41, 53, 130, 132, 138, 220, 221, 62, 75, 76, 0, 185, 185, 69, 162, 69, 69, 29, 30, 31, 50, 53, 57, 71, 176, 177, 196, 218, 222, 225, 192, 193, 198, 32, 34, 36, 38, 48, 52, 55, 56, 60, 61, 72, 185, 192, 199, 200, 201, 219, 220, 227, 229, 231, 232, 233, 59, 185, 199, 214, 13, 161, 43, 32, 34, 36, 38, 48, 52, 61, 72, 230, 231, 233, 235, 235, 198, 69, 44, 69, 43, 56, 132, 133, 138, 141, 53, 57, 71, 139, 140, 220, 221, 46, 1, 77, 221, 69, 236, 7, 11, 58, 194, 163, 164, 15, 14, 58, 186, 208, 209, 210, 208, 176, 29, 32, 34, 38, 48, 52, 61, 72, 166, 167, 168, 169, 171, 172, 174, 175, 177, 178, 183, 184, 218, 220, 222, 48, 166, 167, 168, 179, 51, 176, 44, 69, 56, 56, 56, 56, 56, 56, 35, 37, 39, 220, 56, 56, 55, 56, 235, 55, 56, 47, 55, 56, 55, 56, 42, 187, 188, 187, 45, 47, 55, 215, 59, 162, 1, 53, 127, 129, 130, 134, 135, 137, 138, 140, 220, 48, 192, 193, 48, 192, 193, 53, 211, 212, 213, 222, 223, 198, 211, 53, 134, 138, 55, 56, 55, 56, 55, 56, 51, 56, 135, 138, 141, 142, 143, 144, 219, 220, 59, 134, 220, 53, 80, 8, 9, 16, 17, 18, 19, 20, 21, 24, 25, 29, 53, 58, 63, 67, 68, 79, 86, 88, 96, 97, 145, 148, 152, 153, 154, 155, 168, 169, 172, 174, 222, 79, 69, 185, 11, 12, 58, 195, 1, 41, 58, 70, 152, 165, 237, 58, 237, 185, 162, 208, 49, 237, 58, 237, 60, 233, 1, 173, 175, 176, 55, 56, 56, 43, 233, 233, 176, 55, 56, 47, 55, 56, 176, 42, 72, 233, 55, 59, 185, 176, 180, 181, 182, 222, 223, 60, 60, 60, 60, 185, 56, 185, 185, 201, 220, 185, 56, 56, 185, 14, 185, 216, 217, 185, 47, 28, 53, 56, 126, 127, 131, 132, 138, 141, 220, 51, 54, 51, 139, 51, 192, 193, 192, 193, 36, 48, 70, 55, 42, 70, 132, 132, 138, 132, 138, 132, 138, 56, 55, 56, 55, 56, 55, 56, 55, 56, 47, 55, 56, 56, 43, 59, 35, 39, 53, 55, 56, 62, 81, 82, 221, 223, 225, 13, 1, 130, 138, 1, 35, 98, 1, 29, 146, 1, 146, 1, 146, 1, 53, 113, 114, 222, 1, 130, 138, 1, 53, 1, 115, 130, 138, 1, 116, 130, 138, 48, 60, 72, 226, 229, 154, 155, 168, 222, 79, 1, 31, 65, 78, 221, 1, 29, 63, 222, 70, 58, 87, 58, 43, 55, 1, 42, 43, 47, 156, 157, 158, 159, 176, 156, 226, 226, 48, 72, 176, 228, 229, 237, 58, 166, 202, 203, 204, 185, 185, 12, 1, 42, 185, 210, 48, 173, 166, 134, 48, 173, 48, 173, 166, 166, 184, 220, 166, 29, 48, 173, 166, 70, 55, 42, 56, 162, 49, 55, 45, 216, 128, 220, 133, 138, 141, 56, 54, 55, 56, 55, 56, 134, 134, 134, 134, 213, 185, 134, 135, 138, 135, 138, 134, 134, 144, 220, 134, 56, 78, 55, 56, 53, 1, 69, 54, 42, 42, 220, 60, 147, 226, 232, 234, 147, 147, 43, 55, 31, 54, 42, 117, 118, 134, 47, 119, 54, 13, 160, 54, 169, 222, 56, 56, 56, 78, 53, 64, 66, 89, 222, 222, 87, 88, 97, 152, 1, 28, 123, 124, 125, 127, 130, 136, 137, 138, 222, 185, 134, 187, 160, 159, 169, 169, 29, 170, 171, 222, 169, 202, 1, 47, 51, 205, 206, 207, 237, 58, 185, 185, 173, 173, 173, 56, 173, 182, 166, 185, 217, 185, 61, 220, 56, 134, 56, 56, 82, 45, 55, 83, 84, 85, 223, 225, 79, 1, 98, 1, 28, 52, 53, 101, 102, 104, 105, 127, 137, 138, 224, 134, 55, 123, 114, 98, 102, 107, 56, 55, 1, 120, 121, 122, 160, 138, 69, 149, 138, 176, 176, 176, 66, 89, 35, 55, 90, 91, 92, 222, 53, 78, 31, 222, 31, 96, 128, 51, 54, 51, 51, 156, 42, 187, 185, 160, 207, 204, 129, 56, 56, 56, 55, 237, 42, 128, 136, 137, 138, 34, 22, 47, 110, 52, 127, 139, 60, 232, 232, 52, 127, 232, 69, 15, 234, 42, 110, 134, 55, 51, 220, 150, 151, 78, 53, 56, 55, 90, 89, 222, 31, 43, 222, 222, 61, 125, 138, 125, 125, 125, 185, 51, 85, 101, 61, 232, 56, 53, 221, 102, 139, 52, 106, 127, 136, 106, 139, 106, 70, 108, 109, 148, 222, 99, 100, 222, 107, 121, 122, 58, 152, 237, 58, 237, 89, 45, 53, 55, 93, 94, 95, 222, 224, 92, 56, 43, 222, 123, 43, 43, 124, 185, 110, 53, 103, 104, 130, 138, 106, 111, 112, 221, 136, 55, 70, 43, 55, 43, 110, 56, 56, 55, 123, 43, 123, 123, 54, 56, 55, 109, 52, 126, 134, 100, 123, 95, 123, 104, 221, 134 }; #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYEMPTY (-2) #define YYEOF 0 #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab /* Like YYERROR except do call yyerror. This remains here temporarily to ease the transition to the new meaning of YYERROR, for GCC. Once GCC version 2 has supplanted version 1, this can go. */ #define YYFAIL goto yyerrlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(Token, Value) \ do \ if (yychar == YYEMPTY && yylen == 1) \ { \ yychar = (Token); \ yylval = (Value); \ yytoken = YYTRANSLATE (yychar); \ YYPOPSTACK (1); \ goto yybackup; \ } \ else \ { \ yyerror (YY_("syntax error: cannot back up")); \ YYERROR; \ } \ while (YYID (0)) #define YYTERROR 1 #define YYERRCODE 256 /* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ #define YYRHSLOC(Rhs, K) ((Rhs)[K]) #ifndef YYLLOC_DEFAULT # define YYLLOC_DEFAULT(Current, Rhs, N) \ do \ if (YYID (N)) \ { \ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ } \ else \ { \ (Current).first_line = (Current).last_line = \ YYRHSLOC (Rhs, 0).last_line; \ (Current).first_column = (Current).last_column = \ YYRHSLOC (Rhs, 0).last_column; \ } \ while (YYID (0)) #endif /* YY_LOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know we won't break user code: when these are the locations we know. */ #ifndef YY_LOCATION_PRINT # if YYLTYPE_IS_TRIVIAL # define YY_LOCATION_PRINT(File, Loc) \ fprintf (File, "%d.%d-%d.%d", \ (Loc).first_line, (Loc).first_column, \ (Loc).last_line, (Loc).last_column) # else # define YY_LOCATION_PRINT(File, Loc) ((void) 0) # endif #endif /* YYLEX -- calling `yylex' with the right arguments. */ #ifdef YYLEX_PARAM # define YYLEX yylex (YYLEX_PARAM) #else # define YYLEX yylex () #endif /* Enable debugging if requested. */ #if YYDEBUG # ifndef YYFPRINTF # include /* INFRINGES ON USER NAME SPACE */ # define YYFPRINTF fprintf # endif # define YYDPRINTF(Args) \ do { \ if (yydebug) \ YYFPRINTF Args; \ } while (YYID (0)) # define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ do { \ if (yydebug) \ { \ YYFPRINTF (stderr, "%s ", Title); \ yy_symbol_print (stderr, \ Type, Value); \ YYFPRINTF (stderr, "\n"); \ } \ } while (YYID (0)) /*--------------------------------. | Print this symbol on YYOUTPUT. | `--------------------------------*/ /*ARGSUSED*/ #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static void yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) #else static void yy_symbol_value_print (yyoutput, yytype, yyvaluep) FILE *yyoutput; int yytype; YYSTYPE const * const yyvaluep; #endif { if (!yyvaluep) return; # ifdef YYPRINT if (yytype < YYNTOKENS) YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); # else YYUSE (yyoutput); # endif switch (yytype) { default: break; } } /*--------------------------------. | Print this symbol on YYOUTPUT. | `--------------------------------*/ #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static void yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) #else static void yy_symbol_print (yyoutput, yytype, yyvaluep) FILE *yyoutput; int yytype; YYSTYPE const * const yyvaluep; #endif { if (yytype < YYNTOKENS) YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); else YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); yy_symbol_value_print (yyoutput, yytype, yyvaluep); YYFPRINTF (yyoutput, ")"); } /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static void yy_stack_print (yytype_int16 *bottom, yytype_int16 *top) #else static void yy_stack_print (bottom, top) yytype_int16 *bottom; yytype_int16 *top; #endif { YYFPRINTF (stderr, "Stack now"); for (; bottom <= top; ++bottom) YYFPRINTF (stderr, " %d", *bottom); YYFPRINTF (stderr, "\n"); } # define YY_STACK_PRINT(Bottom, Top) \ do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ } while (YYID (0)) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static void yy_reduce_print (YYSTYPE *yyvsp, int yyrule) #else static void yy_reduce_print (yyvsp, yyrule) YYSTYPE *yyvsp; int yyrule; #endif { int yynrhs = yyr2[yyrule]; int yyi; unsigned long int yylno = yyrline[yyrule]; YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { fprintf (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], &(yyvsp[(yyi + 1) - (yynrhs)]) ); fprintf (stderr, "\n"); } } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ yy_reduce_print (yyvsp, Rule); \ } while (YYID (0)) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ int yydebug; #else /* !YYDEBUG */ # define YYDPRINTF(Args) # define YY_SYMBOL_PRINT(Title, Type, Value, Location) # define YY_STACK_PRINT(Bottom, Top) # define YY_REDUCE_PRINT(Rule) #endif /* !YYDEBUG */ /* YYINITDEPTH -- initial size of the parser's stacks. */ #ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif /* YYMAXDEPTH -- maximum size the stacks can grow to (effective only if the built-in stack extension method is used). Do not make this value too large; the results are undefined if YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif #if YYERROR_VERBOSE # ifndef yystrlen # if defined __GLIBC__ && defined _STRING_H # define yystrlen strlen # else /* Return the length of YYSTR. */ #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static YYSIZE_T yystrlen (const char *yystr) #else static YYSIZE_T yystrlen (yystr) const char *yystr; #endif { YYSIZE_T yylen; for (yylen = 0; yystr[yylen]; yylen++) continue; return yylen; } # endif # endif # ifndef yystpcpy # if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static char * yystpcpy (char *yydest, const char *yysrc) #else static char * yystpcpy (yydest, yysrc) char *yydest; const char *yysrc; #endif { char *yyd = yydest; const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; return yyd - 1; } # endif # endif # ifndef yytnamerr /* Copy to YYRES the contents of YYSTR after stripping away unnecessary quotes and backslashes, so that it's suitable for yyerror. The heuristic is that double-quoting is unnecessary unless the string contains an apostrophe, a comma, or backslash (other than backslash-backslash). YYSTR is taken from yytname. If YYRES is null, do not copy; instead, return the length of what the result would have been. */ static YYSIZE_T yytnamerr (char *yyres, const char *yystr) { if (*yystr == '"') { YYSIZE_T yyn = 0; char const *yyp = yystr; for (;;) switch (*++yyp) { case '\'': case ',': goto do_not_strip_quotes; case '\\': if (*++yyp != '\\') goto do_not_strip_quotes; /* Fall through. */ default: if (yyres) yyres[yyn] = *yyp; yyn++; break; case '"': if (yyres) yyres[yyn] = '\0'; return yyn; } do_not_strip_quotes: ; } if (! yyres) return yystrlen (yystr); return yystpcpy (yyres, yystr) - yyres; } # endif /* Copy into YYRESULT an error message about the unexpected token YYCHAR while in state YYSTATE. Return the number of bytes copied, including the terminating null byte. If YYRESULT is null, do not copy anything; just return the number of bytes that would be copied. As a special case, return 0 if an ordinary "syntax error" message will do. Return YYSIZE_MAXIMUM if overflow occurs during size calculation. */ static YYSIZE_T yysyntax_error (char *yyresult, int yystate, int yychar) { int yyn = yypact[yystate]; if (! (YYPACT_NINF < yyn && yyn <= YYLAST)) return 0; else { int yytype = YYTRANSLATE (yychar); YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]); YYSIZE_T yysize = yysize0; YYSIZE_T yysize1; int yysize_overflow = 0; enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; int yyx; # if 0 /* This is so xgettext sees the translatable formats that are constructed on the fly. */ YY_("syntax error, unexpected %s"); YY_("syntax error, unexpected %s, expecting %s"); YY_("syntax error, unexpected %s, expecting %s or %s"); YY_("syntax error, unexpected %s, expecting %s or %s or %s"); YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"); # endif char *yyfmt; char const *yyf; static char const yyunexpected[] = "syntax error, unexpected %s"; static char const yyexpecting[] = ", expecting %s"; static char const yyor[] = " or %s"; char yyformat[sizeof yyunexpected + sizeof yyexpecting - 1 + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2) * (sizeof yyor - 1))]; char const *yyprefix = yyexpecting; /* Start YYX at -YYN if negative to avoid negative indexes in YYCHECK. */ int yyxbegin = yyn < 0 ? -yyn : 0; /* Stay within bounds of both yycheck and yytname. */ int yychecklim = YYLAST - yyn + 1; int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; int yycount = 1; yyarg[0] = yytname[yytype]; yyfmt = yystpcpy (yyformat, yyunexpected); for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) { if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) { yycount = 1; yysize = yysize0; yyformat[sizeof yyunexpected - 1] = '\0'; break; } yyarg[yycount++] = yytname[yyx]; yysize1 = yysize + yytnamerr (0, yytname[yyx]); yysize_overflow |= (yysize1 < yysize); yysize = yysize1; yyfmt = yystpcpy (yyfmt, yyprefix); yyprefix = yyor; } yyf = YY_(yyformat); yysize1 = yysize + yystrlen (yyf); yysize_overflow |= (yysize1 < yysize); yysize = yysize1; if (yysize_overflow) return YYSIZE_MAXIMUM; if (yyresult) { /* Avoid sprintf, as that infringes on the user's name space. Don't have undefined behavior even if the translation produced a string with the wrong number of "%s"s. */ char *yyp = yyresult; int yyi = 0; while ((*yyp = *yyf) != '\0') { if (*yyp == '%' && yyf[1] == 's' && yyi < yycount) { yyp += yytnamerr (yyp, yyarg[yyi++]); yyf += 2; } else { yyp++; yyf++; } } } return yysize; } } #endif /* YYERROR_VERBOSE */ /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ /*ARGSUSED*/ #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static void yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep) #else static void yydestruct (yymsg, yytype, yyvaluep) const char *yymsg; int yytype; YYSTYPE *yyvaluep; #endif { YYUSE (yyvaluep); if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); switch (yytype) { default: break; } } /* Prevent warnings from -Wmissing-prototypes. */ #ifdef YYPARSE_PARAM #if defined __STDC__ || defined __cplusplus int yyparse (void *YYPARSE_PARAM); #else int yyparse (); #endif #else /* ! YYPARSE_PARAM */ #if defined __STDC__ || defined __cplusplus int yyparse (void); #else int yyparse (); #endif #endif /* ! YYPARSE_PARAM */ /* The look-ahead symbol. */ int yychar; /* The semantic value of the look-ahead symbol. */ YYSTYPE yylval; /* Number of syntax errors so far. */ int yynerrs; /*----------. | yyparse. | `----------*/ #ifdef YYPARSE_PARAM #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) int yyparse (void *YYPARSE_PARAM) #else int yyparse (YYPARSE_PARAM) void *YYPARSE_PARAM; #endif #else /* ! YYPARSE_PARAM */ #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) int yyparse (void) #else int yyparse () #endif #endif { int yystate; int yyn; int yyresult; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus; /* Look-ahead token as an internal (translated) token number. */ int yytoken = 0; #if YYERROR_VERBOSE /* Buffer for error messages, and its allocated size. */ char yymsgbuf[128]; char *yymsg = yymsgbuf; YYSIZE_T yymsg_alloc = sizeof yymsgbuf; #endif /* Three stacks and their tools: `yyss': related to states, `yyvs': related to semantic values, `yyls': related to locations. Refer to the stacks thru separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* The state stack. */ yytype_int16 yyssa[YYINITDEPTH]; yytype_int16 *yyss = yyssa; yytype_int16 *yyssp; /* The semantic value stack. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs = yyvsa; YYSTYPE *yyvsp; #define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N)) YYSIZE_T yystacksize = YYINITDEPTH; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; YYDPRINTF ((stderr, "Starting parse\n")); yystate = 0; yyerrstatus = 0; yynerrs = 0; yychar = YYEMPTY; /* Cause a token to be read. */ /* Initialize stack pointers. Waste one element of value and location stack so that they stay on the same level as the state stack. The wasted elements are never initialized. */ yyssp = yyss; yyvsp = yyvs; goto yysetstate; /*------------------------------------------------------------. | yynewstate -- Push a new state, which is found in yystate. | `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. So pushing a state here evens the stacks. */ yyssp++; yysetstate: *yyssp = yystate; if (yyss + yystacksize - 1 <= yyssp) { /* Get the current used size of the three stacks, in elements. */ YYSIZE_T yysize = yyssp - yyss + 1; #ifdef yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ YYSTYPE *yyvs1 = yyvs; yytype_int16 *yyss1 = yyss; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow (YY_("memory exhausted"), &yyss1, yysize * sizeof (*yyssp), &yyvs1, yysize * sizeof (*yyvsp), &yystacksize); yyss = yyss1; yyvs = yyvs1; } #else /* no yyoverflow */ # ifndef YYSTACK_RELOCATE goto yyexhaustedlab; # else /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) goto yyexhaustedlab; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { yytype_int16 *yyss1 = yyss; union yyalloc *yyptr = (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); if (! yyptr) goto yyexhaustedlab; YYSTACK_RELOCATE (yyss); YYSTACK_RELOCATE (yyvs); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif #endif /* no yyoverflow */ yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; YYDPRINTF ((stderr, "Stack size increased to %lu\n", (unsigned long int) yystacksize)); if (yyss + yystacksize - 1 <= yyssp) YYABORT; } YYDPRINTF ((stderr, "Entering state %d\n", yystate)); goto yybackup; /*-----------. | yybackup. | `-----------*/ yybackup: /* Do appropriate processing given the current state. Read a look-ahead token if we need one and don't already have one. */ /* First try to decide what to do without reference to look-ahead token. */ yyn = yypact[yystate]; if (yyn == YYPACT_NINF) goto yydefault; /* Not known => get a look-ahead token if don't already have one. */ /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token: ")); yychar = YYLEX; } if (yychar <= YYEOF) { yychar = yytoken = YYEOF; YYDPRINTF ((stderr, "Now at end of input.\n")); } else { yytoken = YYTRANSLATE (yychar); YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); } /* If the proper action on seeing token YYTOKEN is to reduce or to detect an error, take that action. */ yyn += yytoken; if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) goto yydefault; yyn = yytable[yyn]; if (yyn <= 0) { if (yyn == 0 || yyn == YYTABLE_NINF) goto yyerrlab; yyn = -yyn; goto yyreduce; } if (yyn == YYFINAL) YYACCEPT; /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; /* Shift the look-ahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); /* Discard the shifted token unless it is eof. */ if (yychar != YYEOF) yychar = YYEMPTY; yystate = yyn; *++yyvsp = yylval; goto yynewstate; /*-----------------------------------------------------------. | yydefault -- do the default action for the current state. | `-----------------------------------------------------------*/ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; goto yyreduce; /*-----------------------------. | yyreduce -- Do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: `$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; YY_REDUCE_PRINT (yyn); switch (yyn) { case 2: #line 120 "parser.y" {inputExpr = letrec((yyvsp[(3) - (3)]),(yyvsp[(2) - (3)])); sp-=2;} break; case 3: #line 121 "parser.y" {inputContext = (yyvsp[(2) - (2)]); sp-=1;} break; case 4: #line 122 "parser.y" {valDefns = (yyvsp[(2) - (2)]); sp-=1;} break; case 5: #line 123 "parser.y" {syntaxError("input");} break; case 6: #line 136 "parser.y" { setExportList(singleton(ap(MODULEENT,mkCon(module(currentModule).text)))); (yyval) = gc3((yyvsp[(3) - (4)])); } break; case 7: #line 140 "parser.y" { setExportList(singleton(ap(MODULEENT,mkCon(module(currentModule).text)))); (yyval) = gc4((yyvsp[(3) - (4)])); } break; case 8: #line 145 "parser.y" {setExportList((yyvsp[(3) - (7)])); (yyval) = gc7((yyvsp[(6) - (7)]));} break; case 9: #line 147 "parser.y" {syntaxError("declaration");} break; case 10: #line 148 "parser.y" {syntaxError("module definition");} break; case 11: #line 154 "parser.y" {startModule(conMain); (yyval) = gc0(NIL);} break; case 12: #line 157 "parser.y" {startModule(mkCon(mkNestedQual((yyvsp[(1) - (1)])))); (yyval) = gc1(NIL);} break; case 13: #line 159 "parser.y" {(yyval) = mkCon(mkNestedQual((yyvsp[(1) - (1)])));} break; case 14: #line 160 "parser.y" { String modName = findPathname(textToStr(textOf((yyvsp[(1) - (1)])))); if (modName) { /* fillin pathname if known */ (yyval) = mkStr(findText(modName)); } else { (yyval) = (yyvsp[(1) - (1)]); } } break; case 15: #line 168 "parser.y" {(yyval) = gc0(NIL); } break; case 16: #line 169 "parser.y" {(yyval) = gc2((yyvsp[(2) - (2)]));} break; case 17: #line 170 "parser.y" {(yyval) = gc1((yyvsp[(1) - (1)]));} break; case 18: #line 171 "parser.y" {(yyval) = gc2(NIL);} break; case 19: #line 172 "parser.y" {(yyval) = gc4((yyvsp[(4) - (4)]));} break; case 20: #line 177 "parser.y" {(yyval) = gc0(exportSelf());} break; case 21: #line 178 "parser.y" {(yyval) = gc2(NIL);} break; case 22: #line 179 "parser.y" {(yyval) = gc3(NIL);} break; case 23: #line 180 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 24: #line 181 "parser.y" {(yyval) = gc4((yyvsp[(2) - (4)]));} break; case 25: #line 183 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 26: #line 184 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 27: #line 189 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 28: #line 190 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 29: #line 191 "parser.y" {(yyval) = gc4(pair((yyvsp[(1) - (4)]),DOTDOT));} break; case 30: #line 192 "parser.y" {(yyval) = gc4(pair((yyvsp[(1) - (4)]),(yyvsp[(3) - (4)])));} break; case 31: #line 193 "parser.y" {(yyval) = gc2(ap(MODULEENT,(yyvsp[(2) - (2)])));} break; case 32: #line 195 "parser.y" {(yyval) = gc0(NIL);} break; case 33: #line 196 "parser.y" {(yyval) = gc1(NIL);} break; case 34: #line 197 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 35: #line 198 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 36: #line 200 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 37: #line 201 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 38: #line 203 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 39: #line 204 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 40: #line 209 "parser.y" {imps = cons((yyvsp[(3) - (3)]),imps); (yyval)=gc3(NIL);} break; case 41: #line 210 "parser.y" {(yyval) = gc2(NIL); } break; case 42: #line 211 "parser.y" {imps = singleton((yyvsp[(1) - (1)])); (yyval)=gc1(NIL);} break; case 43: #line 213 "parser.y" {if (chase(imps)) { clearStack(); onto(imps); done(); closeAnyInput(); return 0; } (yyval) = gc0(NIL); } break; case 44: #line 224 "parser.y" {addUnqualImport((yyvsp[(2) - (3)]),NIL,(yyvsp[(3) - (3)])); (yyval) = gc3((yyvsp[(2) - (3)]));} break; case 45: #line 227 "parser.y" {addUnqualImport((yyvsp[(2) - (5)]),(yyvsp[(4) - (5)]),(yyvsp[(5) - (5)])); (yyval) = gc5((yyvsp[(2) - (5)]));} break; case 46: #line 230 "parser.y" {addQualImport((yyvsp[(3) - (6)]),(yyvsp[(5) - (6)]),(yyvsp[(6) - (6)])); (yyval) = gc6((yyvsp[(3) - (6)]));} break; case 47: #line 233 "parser.y" {addQualImport((yyvsp[(3) - (4)]),(yyvsp[(3) - (4)]),(yyvsp[(4) - (4)])); (yyval) = gc4((yyvsp[(3) - (4)]));} break; case 48: #line 235 "parser.y" {syntaxError("import declaration");} break; case 49: #line 237 "parser.y" {(yyval) = gc0(DOTDOT);} break; case 50: #line 238 "parser.y" {(yyval) = gc4(ap(HIDDEN,(yyvsp[(3) - (4)])));} break; case 51: #line 239 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 52: #line 241 "parser.y" {(yyval) = gc0(NIL);} break; case 53: #line 242 "parser.y" {(yyval) = gc1(NIL);} break; case 54: #line 243 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 55: #line 244 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 56: #line 246 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 57: #line 247 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 58: #line 249 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 59: #line 250 "parser.y" {(yyval) = gc1(pair((yyvsp[(1) - (1)]),NONE));} break; case 60: #line 251 "parser.y" {(yyval) = gc4(pair((yyvsp[(1) - (4)]),DOTDOT));} break; case 61: #line 252 "parser.y" {(yyval) = gc4(pair((yyvsp[(1) - (4)]),(yyvsp[(3) - (4)])));} break; case 62: #line 254 "parser.y" {(yyval) = gc0(NIL);} break; case 63: #line 255 "parser.y" {(yyval) = gc1(NIL);} break; case 64: #line 256 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 65: #line 257 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 66: #line 259 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 67: #line 260 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 68: #line 262 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 69: #line 263 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 70: #line 268 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 71: #line 269 "parser.y" {(yyval) = gc2((yyvsp[(1) - (3)]));} break; case 72: #line 270 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 73: #line 271 "parser.y" {(yyval) = gc0(NIL);} break; case 74: #line 272 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 75: #line 277 "parser.y" {defTycon(4,(yyvsp[(3) - (4)]),(yyvsp[(2) - (4)]),(yyvsp[(4) - (4)]),SYNONYM);} break; case 76: #line 279 "parser.y" {defTycon(6,(yyvsp[(3) - (6)]),(yyvsp[(2) - (6)]), ap((yyvsp[(4) - (6)]),(yyvsp[(6) - (6)])),RESTRICTSYN);} break; case 77: #line 281 "parser.y" {syntaxError("type declaration");} break; case 78: #line 283 "parser.y" {defTycon(5,(yyvsp[(3) - (5)]),checkTyLhs((yyvsp[(2) - (5)])), ap(rev((yyvsp[(4) - (5)])),(yyvsp[(5) - (5)])),DATATYPE);} break; case 79: #line 286 "parser.y" {defTycon(7,(yyvsp[(5) - (7)]),(yyvsp[(4) - (7)]), ap(qualify((yyvsp[(2) - (7)]),rev((yyvsp[(6) - (7)]))), (yyvsp[(7) - (7)])),DATATYPE);} break; case 80: #line 289 "parser.y" {defTycon(2,(yyvsp[(1) - (2)]),checkTyLhs((yyvsp[(2) - (2)])), ap(NIL,NIL),DATATYPE);} break; case 81: #line 291 "parser.y" {defTycon(4,(yyvsp[(1) - (4)]),(yyvsp[(4) - (4)]), ap(qualify((yyvsp[(2) - (4)]),NIL), NIL),DATATYPE);} break; case 82: #line 294 "parser.y" {syntaxError("data declaration");} break; case 83: #line 296 "parser.y" {defTycon(5,(yyvsp[(3) - (5)]),checkTyLhs((yyvsp[(2) - (5)])), ap((yyvsp[(4) - (5)]),(yyvsp[(5) - (5)])),NEWTYPE);} break; case 84: #line 299 "parser.y" {defTycon(7,(yyvsp[(5) - (7)]),(yyvsp[(4) - (7)]), ap(qualify((yyvsp[(2) - (7)]),(yyvsp[(6) - (7)])), (yyvsp[(7) - (7)])),NEWTYPE);} break; case 85: #line 302 "parser.y" {syntaxError("newtype declaration");} break; case 86: #line 303 "parser.y" {if (isInt((yyvsp[(2) - (2)]))) { needPrims(intOf((yyvsp[(2) - (2)])), NULL); } else { syntaxError("needprims decl"); } sp-=2;} break; case 87: #line 309 "parser.y" {syntaxError("needprims decl");} break; case 88: #line 311 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 89: #line 312 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 90: #line 313 "parser.y" {syntaxError("type defn lhs");} break; case 91: #line 315 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 92: #line 316 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 93: #line 318 "parser.y" {(yyval) = gc3(sigdecl((yyvsp[(2) - (3)]),singleton((yyvsp[(1) - (3)])), (yyvsp[(3) - (3)])));} break; case 94: #line 320 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 95: #line 322 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 96: #line 323 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 97: #line 325 "parser.y" {(yyval) = gc4(ap(POLYTYPE, pair(rev((yyvsp[(2) - (4)])),(yyvsp[(4) - (4)]))));} break; case 98: #line 327 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 99: #line 329 "parser.y" {(yyval) = gc3(qualify((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 100: #line 330 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 101: #line 332 "parser.y" {(yyval) = gc4(ap(ap((yyvsp[(3) - (4)]),bang((yyvsp[(2) - (4)]))),(yyvsp[(4) - (4)])));} break; case 102: #line 333 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)])),(yyvsp[(3) - (3)])));} break; case 103: #line 334 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)])),(yyvsp[(3) - (3)])));} break; case 104: #line 335 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)])),(yyvsp[(3) - (3)])));} break; case 105: #line 336 "parser.y" {(yyval) = checkConstr((yyvsp[(1) - (1)]));} break; case 106: #line 337 "parser.y" {(yyval) = checkConstr((yyvsp[(1) - (1)]));} break; case 107: #line 338 "parser.y" {(yyval) = gc4(ap(LABC,pair((yyvsp[(1) - (4)]),rev((yyvsp[(3) - (4)])))));} break; case 108: #line 339 "parser.y" {(yyval) = gc3(ap(LABC,pair((yyvsp[(1) - (3)]),NIL)));} break; case 109: #line 340 "parser.y" {syntaxError("data type declaration");} break; case 110: #line 342 "parser.y" {(yyval) = gc3(ap((yyvsp[(1) - (3)]),bang((yyvsp[(3) - (3)]))));} break; case 111: #line 343 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 112: #line 344 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 113: #line 345 "parser.y" {(yyval) = gc3(ap((yyvsp[(1) - (3)]),bang((yyvsp[(3) - (3)]))));} break; case 114: #line 346 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 115: #line 347 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 116: #line 349 "parser.y" {(yyval) = gc2(bang((yyvsp[(2) - (2)])));} break; case 117: #line 350 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 118: #line 351 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 119: #line 353 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 120: #line 355 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 121: #line 356 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 122: #line 358 "parser.y" {(yyval) = gc3(pair(rev((yyvsp[(1) - (3)])),(yyvsp[(3) - (3)])));} break; case 123: #line 359 "parser.y" {(yyval) = gc3(pair(rev((yyvsp[(1) - (3)])),(yyvsp[(3) - (3)])));} break; case 124: #line 360 "parser.y" {(yyval) = gc4(pair(rev((yyvsp[(1) - (4)])),bang((yyvsp[(4) - (4)]))));} break; case 125: #line 362 "parser.y" {(yyval) = gc0(NIL);} break; case 126: #line 363 "parser.y" {(yyval) = gc2(singleton((yyvsp[(2) - (2)])));} break; case 127: #line 364 "parser.y" {(yyval) = gc4((yyvsp[(3) - (4)]));} break; case 128: #line 366 "parser.y" {(yyval) = gc0(NIL);} break; case 129: #line 367 "parser.y" {(yyval) = gc1(rev((yyvsp[(1) - (1)])));} break; case 130: #line 369 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 131: #line 370 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 132: #line 375 "parser.y" {primDefn((yyvsp[(1) - (4)]),(yyvsp[(2) - (4)]),(yyvsp[(4) - (4)])); sp-=4;} break; case 133: #line 377 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 134: #line 378 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 135: #line 379 "parser.y" {syntaxError("primitive defn");} break; case 136: #line 381 "parser.y" {(yyval) = gc2(pair((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 137: #line 382 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 138: #line 388 "parser.y" {foreignImport((yyvsp[(1) - (7)]),(yyvsp[(3) - (7)]),NIL,(yyvsp[(4) - (7)]),(yyvsp[(5) - (7)]),(yyvsp[(7) - (7)])); sp-=7;} break; case 139: #line 390 "parser.y" {foreignImport((yyvsp[(1) - (6)]),(yyvsp[(3) - (6)]),NIL,(yyvsp[(4) - (6)]),(yyvsp[(4) - (6)]),(yyvsp[(6) - (6)])); sp-=6;} break; case 140: #line 392 "parser.y" {foreignImport((yyvsp[(1) - (8)]),(yyvsp[(3) - (8)]),(yyvsp[(4) - (8)]),(yyvsp[(5) - (8)]),(yyvsp[(6) - (8)]),(yyvsp[(8) - (8)])); sp-=8;} break; case 141: #line 394 "parser.y" {foreignImport((yyvsp[(1) - (7)]),(yyvsp[(3) - (7)]),(yyvsp[(4) - (7)]),(yyvsp[(5) - (7)]),(yyvsp[(5) - (7)]),(yyvsp[(7) - (7)])); sp-=7;} break; case 142: #line 396 "parser.y" {foreignExport((yyvsp[(1) - (7)]),(yyvsp[(2) - (7)]),(yyvsp[(3) - (7)]),(yyvsp[(4) - (7)]),(yyvsp[(5) - (7)]),(yyvsp[(7) - (7)])); sp-=7;} break; case 143: #line 401 "parser.y" {classDefn(intOf((yyvsp[(1) - (4)])),(yyvsp[(2) - (4)]),(yyvsp[(4) - (4)]),(yyvsp[(3) - (4)])); sp-=4;} break; case 144: #line 402 "parser.y" {instDefn(intOf((yyvsp[(1) - (3)])),(yyvsp[(2) - (3)]),(yyvsp[(3) - (3)])); sp-=3;} break; case 145: #line 403 "parser.y" {defaultDefn(intOf((yyvsp[(1) - (4)])),(yyvsp[(3) - (4)])); sp-=4;} break; case 146: #line 404 "parser.y" {syntaxError("class declaration");} break; case 147: #line 405 "parser.y" {syntaxError("instance declaration");} break; case 148: #line 406 "parser.y" {syntaxError("default declaration");} break; case 149: #line 408 "parser.y" {(yyval) = gc3(pair((yyvsp[(1) - (3)]),checkPred((yyvsp[(3) - (3)]))));} break; case 150: #line 409 "parser.y" {(yyval) = gc1(pair(NIL,checkPred((yyvsp[(1) - (1)]))));} break; case 151: #line 411 "parser.y" {(yyval) = gc3(pair((yyvsp[(1) - (3)]),checkPred((yyvsp[(3) - (3)]))));} break; case 152: #line 412 "parser.y" {(yyval) = gc1(pair(NIL,checkPred((yyvsp[(1) - (1)]))));} break; case 153: #line 414 "parser.y" {(yyval) = gc0(NIL);} break; case 154: #line 415 "parser.y" {(yyval) = gc1(rev((yyvsp[(1) - (1)])));} break; case 155: #line 417 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 156: #line 418 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 157: #line 420 "parser.y" {(yyval) = gc0(NIL);} break; case 158: #line 421 "parser.y" {h98DoesntSupport(row,"dependent parameters"); (yyval) = gc2(rev((yyvsp[(2) - (2)])));} break; case 159: #line 424 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 160: #line 425 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 161: #line 427 "parser.y" {(yyval) = gc3(pair(rev((yyvsp[(1) - (3)])),rev((yyvsp[(3) - (3)]))));} break; case 162: #line 428 "parser.y" {syntaxError("functional dependency");} break; case 163: #line 430 "parser.y" {(yyval) = gc0(NIL);} break; case 164: #line 431 "parser.y" {(yyval) = gc2(cons((yyvsp[(2) - (2)]),(yyvsp[(1) - (2)])));} break; case 165: #line 436 "parser.y" {(yyval) = gc4(ap(POLYTYPE, pair(rev((yyvsp[(2) - (4)])),(yyvsp[(4) - (4)]))));} break; case 166: #line 438 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 167: #line 440 "parser.y" {(yyval) = gc3(qualify((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 168: #line 441 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 169: #line 443 "parser.y" {(yyval) = gc3(fn((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 170: #line 444 "parser.y" {(yyval) = gc3(fn((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 171: #line 445 "parser.y" {(yyval) = gc3(fn((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 172: #line 446 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 173: #line 448 "parser.y" {(yyval) = gc4(ap(POLYTYPE, pair(rev((yyvsp[(2) - (4)])),(yyvsp[(4) - (4)]))));} break; case 174: #line 450 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 175: #line 452 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 176: #line 453 "parser.y" {(yyval) = gc5(qualify((yyvsp[(2) - (5)]),(yyvsp[(4) - (5)])));} break; case 177: #line 455 "parser.y" {(yyval) = gc2(cons((yyvsp[(2) - (2)]),(yyvsp[(1) - (2)])));} break; case 178: #line 456 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 179: #line 458 "parser.y" {(yyval) = gc3(qualify((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 180: #line 459 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 181: #line 461 "parser.y" {(yyval) = gc2(NIL);} break; case 182: #line 462 "parser.y" {(yyval) = gc1(singleton(checkPred((yyvsp[(1) - (1)]))));} break; case 183: #line 463 "parser.y" {(yyval) = gc3(singleton(checkPred((yyvsp[(2) - (3)]))));} break; case 184: #line 464 "parser.y" {(yyval) = gc3(checkCtxt(rev((yyvsp[(2) - (3)]))));} break; case 185: #line 465 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 186: #line 466 "parser.y" {(yyval) = gc3(checkCtxt(rev((yyvsp[(2) - (3)]))));} break; case 187: #line 468 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 188: #line 469 "parser.y" {(yyval) = gc3(checkCtxt(rev((yyvsp[(2) - (3)]))));} break; case 189: #line 471 "parser.y" { #if TREX (yyval) = gc3(ap(mkExt(textOf((yyvsp[(3) - (3)]))),(yyvsp[(1) - (3)]))); #else noTREX("a type context"); #endif } break; case 190: #line 478 "parser.y" { #if IPARAM (yyval) = gc3(pair(mkIParam((yyvsp[(1) - (3)])),(yyvsp[(3) - (3)]))); #else noIP("a type context"); #endif } break; case 191: #line 486 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 192: #line 487 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 193: #line 488 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 194: #line 489 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),cons((yyvsp[(1) - (3)]),NIL)));} break; case 195: #line 490 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 196: #line 493 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 197: #line 494 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 198: #line 496 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 199: #line 497 "parser.y" {(yyval) = gc3(fn((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 200: #line 498 "parser.y" {(yyval) = gc3(fn((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 201: #line 499 "parser.y" {(yyval) = gc3(fn((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 202: #line 500 "parser.y" {syntaxError("type expression");} break; case 203: #line 502 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 204: #line 503 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 205: #line 505 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 206: #line 506 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 207: #line 508 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 208: #line 509 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 209: #line 511 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 210: #line 512 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 211: #line 514 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 212: #line 515 "parser.y" {(yyval) = gc2(typeUnit);} break; case 213: #line 516 "parser.y" {(yyval) = gc3(typeArrow);} break; case 214: #line 517 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 215: #line 518 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 216: #line 519 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 217: #line 520 "parser.y" {(yyval) = gc3(buildTuple((yyvsp[(2) - (3)])));} break; case 218: #line 521 "parser.y" {(yyval) = gc3(buildTuple((yyvsp[(2) - (3)])));} break; case 219: #line 522 "parser.y" { #if TREX (yyval) = gc3(revOnto((yyvsp[(2) - (3)]),typeNoRow)); #else noTREX("a type"); #endif } break; case 220: #line 529 "parser.y" { #if TREX (yyval) = gc5(revOnto((yyvsp[(2) - (5)]),(yyvsp[(4) - (5)]))); #else noTREX("a type"); #endif } break; case 221: #line 536 "parser.y" {(yyval) = gc3(ap(typeList,(yyvsp[(2) - (3)])));} break; case 222: #line 537 "parser.y" {(yyval) = gc2(typeList);} break; case 223: #line 538 "parser.y" {h98DoesntSupport(row,"anonymous type variables"); (yyval) = gc1(inventVar());} break; case 224: #line 541 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 225: #line 542 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),cons((yyvsp[(1) - (3)]),NIL)));} break; case 226: #line 544 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),cons((yyvsp[(1) - (3)]),NIL)));} break; case 227: #line 545 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),cons((yyvsp[(1) - (3)]),NIL)));} break; case 228: #line 546 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 229: #line 547 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 230: #line 550 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 231: #line 551 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 232: #line 553 "parser.y" {h98DoesntSupport(row,"extensible records"); (yyval) = gc3(ap(mkExt(textOf((yyvsp[(1) - (3)]))),(yyvsp[(3) - (3)])));} break; case 233: #line 560 "parser.y" {(yyval) = gc3(fixdecl((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]),NON_ASS,(yyvsp[(2) - (3)])));} break; case 234: #line 561 "parser.y" {syntaxError("fixity decl");} break; case 235: #line 562 "parser.y" {(yyval) = gc3(fixdecl((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]),LEFT_ASS,(yyvsp[(2) - (3)])));} break; case 236: #line 563 "parser.y" {syntaxError("fixity decl");} break; case 237: #line 564 "parser.y" {(yyval) = gc3(fixdecl((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]),RIGHT_ASS,(yyvsp[(2) - (3)])));} break; case 238: #line 565 "parser.y" {syntaxError("fixity decl");} break; case 239: #line 566 "parser.y" {(yyval) = gc3(sigdecl((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 240: #line 567 "parser.y" {syntaxError("type signature");} break; case 241: #line 569 "parser.y" {(yyval) = gc1(checkPrec((yyvsp[(1) - (1)])));} break; case 242: #line 570 "parser.y" {(yyval) = gc0(mkInt(DEF_PREC));} break; case 243: #line 572 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 244: #line 573 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 245: #line 575 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 246: #line 576 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 247: #line 578 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 248: #line 579 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 249: #line 581 "parser.y" {(yyval) = gc0(NIL);} break; case 250: #line 582 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 251: #line 583 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 252: #line 585 "parser.y" {(yyval) = gc2(cons((yyvsp[(2) - (2)]),(yyvsp[(1) - (2)])));} break; case 253: #line 587 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 254: #line 588 "parser.y" {(yyval) = gc2(ap(FUNBIND,pair((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)]))));} break; case 255: #line 589 "parser.y" {(yyval) = gc4(ap(FUNBIND, pair((yyvsp[(1) - (4)]),ap(RSIGN, ap((yyvsp[(4) - (4)]),(yyvsp[(3) - (4)]))))));} break; case 256: #line 592 "parser.y" {(yyval) = gc2(ap(PATBIND,pair((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)]))));} break; case 257: #line 594 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 258: #line 595 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 259: #line 596 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 260: #line 598 "parser.y" {(yyval) = gc3(ap2((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 261: #line 599 "parser.y" {(yyval) = gc3(ap2((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 262: #line 600 "parser.y" {(yyval) = gc3(ap2((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 263: #line 601 "parser.y" {(yyval) = gc3(ap2((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 264: #line 602 "parser.y" {(yyval) = gc3(ap2(varPlus,(yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 265: #line 604 "parser.y" {(yyval) = gc4(ap((yyvsp[(2) - (4)]),(yyvsp[(4) - (4)])));} break; case 266: #line 605 "parser.y" {(yyval) = gc4(ap((yyvsp[(2) - (4)]),(yyvsp[(4) - (4)])));} break; case 267: #line 606 "parser.y" {(yyval) = gc4(ap((yyvsp[(2) - (4)]),(yyvsp[(4) - (4)])));} break; case 268: #line 607 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 269: #line 608 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 270: #line 610 "parser.y" {(yyval) = gc2(letrec((yyvsp[(2) - (2)]),(yyvsp[(1) - (2)])));} break; case 271: #line 611 "parser.y" {syntaxError("declaration");} break; case 272: #line 613 "parser.y" {(yyval) = gc2(pair((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 273: #line 614 "parser.y" {(yyval) = gc1(grded(rev((yyvsp[(1) - (1)]))));} break; case 274: #line 616 "parser.y" {(yyval) = gc2(cons((yyvsp[(2) - (2)]),(yyvsp[(1) - (2)])));} break; case 275: #line 617 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 276: #line 619 "parser.y" {(yyval) = gc4(pair((yyvsp[(3) - (4)]),pair((yyvsp[(2) - (4)]),(yyvsp[(4) - (4)]))));} break; case 277: #line 621 "parser.y" {(yyval) = gc0(NIL);} break; case 278: #line 622 "parser.y" {(yyval) = gc2((yyvsp[(2) - (2)]));} break; case 279: #line 627 "parser.y" {(yyval) = gc0(NIL);} break; case 280: #line 628 "parser.y" {(yyval) = gc2((yyvsp[(2) - (2)]));} break; case 281: #line 631 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 282: #line 632 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 283: #line 635 "parser.y" {(yyval) = gc0(NIL);} break; case 284: #line 636 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 285: #line 637 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 286: #line 640 "parser.y" {(yyval) = gc2(cons((yyvsp[(2) - (2)]),(yyvsp[(1) - (2)])));} break; case 287: #line 642 "parser.y" { #if IPARAM (yyval) = gc3(pair((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]))); #else noIP("a binding"); #endif } break; case 288: #line 649 "parser.y" {syntaxError("a binding");} break; case 289: #line 650 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 290: #line 655 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 291: #line 656 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 292: #line 658 "parser.y" {(yyval) = gc3(ap(ESIGN,pair((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]))));} break; case 293: #line 659 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 294: #line 661 "parser.y" {(yyval) = gc3(ap2(varPlus,(yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 295: #line 663 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 296: #line 664 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 297: #line 665 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 298: #line 667 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 299: #line 668 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 300: #line 670 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 301: #line 671 "parser.y" {(yyval) = gc1(ap(INFIX,(yyvsp[(1) - (1)])));} break; case 302: #line 673 "parser.y" {(yyval) = gc2(ap(NEG,only((yyvsp[(2) - (2)]))));} break; case 303: #line 674 "parser.y" {syntaxError("pattern");} break; case 304: #line 675 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),only((yyvsp[(1) - (3)]))),(yyvsp[(3) - (3)])));} break; case 305: #line 676 "parser.y" {(yyval) = gc4(ap(NEG,ap2((yyvsp[(2) - (4)]),only((yyvsp[(1) - (4)])),(yyvsp[(4) - (4)]))));} break; case 306: #line 677 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),only((yyvsp[(1) - (3)]))),(yyvsp[(3) - (3)])));} break; case 307: #line 678 "parser.y" {(yyval) = gc4(ap(NEG,ap2((yyvsp[(2) - (4)]),only((yyvsp[(1) - (4)])),(yyvsp[(4) - (4)]))));} break; case 308: #line 679 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),only((yyvsp[(1) - (3)]))),(yyvsp[(3) - (3)])));} break; case 309: #line 680 "parser.y" {(yyval) = gc4(ap(NEG,ap2((yyvsp[(2) - (4)]),only((yyvsp[(1) - (4)])),(yyvsp[(4) - (4)]))));} break; case 310: #line 681 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)])),(yyvsp[(3) - (3)])));} break; case 311: #line 682 "parser.y" {(yyval) = gc4(ap(NEG,ap(ap((yyvsp[(2) - (4)]),(yyvsp[(1) - (4)])),(yyvsp[(4) - (4)]))));} break; case 312: #line 684 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 313: #line 685 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 314: #line 687 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 315: #line 688 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 316: #line 690 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 317: #line 691 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 318: #line 693 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 319: #line 694 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 320: #line 695 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 321: #line 697 "parser.y" {(yyval) = gc3(ap(ASPAT,pair((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]))));} break; case 322: #line 698 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 323: #line 699 "parser.y" {(yyval) = gc4(ap(CONFLDS,pair((yyvsp[(1) - (4)]),(yyvsp[(3) - (4)]))));} break; case 324: #line 700 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 325: #line 701 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 326: #line 702 "parser.y" {(yyval) = gc1(WILDCARD);} break; case 327: #line 703 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 328: #line 704 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 329: #line 705 "parser.y" {(yyval) = gc3(buildTuple((yyvsp[(2) - (3)])));} break; case 330: #line 706 "parser.y" {(yyval) = gc3(ap(FINLIST,rev((yyvsp[(2) - (3)]))));} break; case 331: #line 707 "parser.y" {(yyval) = gc2(ap(LAZYPAT,(yyvsp[(2) - (2)])));} break; case 332: #line 709 "parser.y" { #if TREX (yyval) = gc3(revOnto((yyvsp[(2) - (3)]),nameNoRec)); #else (yyval) = gc3(NIL); #endif } break; case 333: #line 716 "parser.y" {(yyval) = gc5(revOnto((yyvsp[(2) - (5)]),(yyvsp[(4) - (5)])));} break; case 334: #line 719 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 335: #line 720 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),singleton((yyvsp[(1) - (3)]))));} break; case 336: #line 722 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 337: #line 723 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 338: #line 725 "parser.y" {(yyval) = gc0(NIL);} break; case 339: #line 726 "parser.y" {(yyval) = gc1(rev((yyvsp[(1) - (1)])));} break; case 340: #line 728 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 341: #line 729 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 342: #line 731 "parser.y" {(yyval) = gc3(pair((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 343: #line 732 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 344: #line 735 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 345: #line 736 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 346: #line 738 "parser.y" { #if TREX (yyval) = gc3(ap(mkExt(textOf((yyvsp[(1) - (3)]))),(yyvsp[(3) - (3)]))); #else noTREX("a pattern"); #endif } break; case 347: #line 750 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 348: #line 751 "parser.y" {syntaxError("expression");} break; case 349: #line 753 "parser.y" {(yyval) = gc3(ap(ESIGN,pair((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]))));} break; case 350: #line 754 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 351: #line 756 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 352: #line 757 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 353: #line 759 "parser.y" {(yyval) = gc1(ap(INFIX,(yyvsp[(1) - (1)])));} break; case 354: #line 760 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 355: #line 762 "parser.y" {(yyval) = gc1(ap(INFIX,(yyvsp[(1) - (1)])));} break; case 356: #line 763 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 357: #line 765 "parser.y" {(yyval) = gc4(ap(NEG,ap(ap((yyvsp[(2) - (4)]),(yyvsp[(1) - (4)])),(yyvsp[(4) - (4)]))));} break; case 358: #line 766 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)])),(yyvsp[(3) - (3)])));} break; case 359: #line 767 "parser.y" {(yyval) = gc2(ap(NEG,only((yyvsp[(2) - (2)]))));} break; case 360: #line 768 "parser.y" {(yyval) = gc4(ap(NEG, ap(ap((yyvsp[(2) - (4)]),only((yyvsp[(1) - (4)]))),(yyvsp[(4) - (4)]))));} break; case 361: #line 770 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),only((yyvsp[(1) - (3)]))),(yyvsp[(3) - (3)])));} break; case 362: #line 772 "parser.y" {(yyval) = gc4(ap(NEG,ap(ap((yyvsp[(2) - (4)]),(yyvsp[(1) - (4)])),(yyvsp[(4) - (4)]))));} break; case 363: #line 773 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),(yyvsp[(1) - (3)])),(yyvsp[(3) - (3)])));} break; case 364: #line 774 "parser.y" {(yyval) = gc2(ap(NEG,only((yyvsp[(2) - (2)]))));} break; case 365: #line 775 "parser.y" {(yyval) = gc4(ap(NEG, ap(ap((yyvsp[(2) - (4)]),only((yyvsp[(1) - (4)]))),(yyvsp[(4) - (4)]))));} break; case 366: #line 777 "parser.y" {(yyval) = gc3(ap(ap((yyvsp[(2) - (3)]),only((yyvsp[(1) - (3)]))),(yyvsp[(3) - (3)])));} break; case 367: #line 779 "parser.y" {(yyval) = gc6(ap(CASE,pair((yyvsp[(2) - (6)]),rev((yyvsp[(5) - (6)])))));} break; case 368: #line 780 "parser.y" {(yyval) = gc4(ap(DOCOMP,checkDo((yyvsp[(3) - (4)]))));} break; case 369: #line 781 "parser.y" { #if MUDO (yyval) = gc4(ap(MDOCOMP, checkMDo((yyvsp[(3) - (4)])))); #else noMDo("an expression"); #endif } break; case 370: #line 788 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 371: #line 790 "parser.y" {(yyval) = gc4(ap(LAMBDA, pair(rev((yyvsp[(2) - (4)])), pair((yyvsp[(3) - (4)]),(yyvsp[(4) - (4)])))));} break; case 372: #line 793 "parser.y" {(yyval) = gc4(letrec((yyvsp[(2) - (4)]),(yyvsp[(4) - (4)])));} break; case 373: #line 794 "parser.y" {(yyval) = gc4(ap(COND,triple((yyvsp[(2) - (4)]),(yyvsp[(3) - (4)]),(yyvsp[(4) - (4)]))));} break; case 374: #line 799 "parser.y" {(yyval) = gc3((yyvsp[(3) - (3)]));} break; case 375: #line 800 "parser.y" {(yyval) = gc2((yyvsp[(2) - (2)]));} break; case 376: #line 802 "parser.y" {(yyval) = gc3((yyvsp[(3) - (3)]));} break; case 377: #line 803 "parser.y" {(yyval) = gc2((yyvsp[(2) - (2)]));} break; case 378: #line 806 "parser.y" {(yyval) = gc2(cons((yyvsp[(2) - (2)]),(yyvsp[(1) - (2)])));} break; case 379: #line 807 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 380: #line 809 "parser.y" {(yyval) = gc2(ap((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 381: #line 810 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 382: #line 812 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 383: #line 813 "parser.y" {(yyval) = gc3(ap(ASPAT,pair((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]))));} break; case 384: #line 814 "parser.y" {(yyval) = gc2(ap(LAZYPAT,(yyvsp[(2) - (2)])));} break; case 385: #line 815 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 386: #line 816 "parser.y" {(yyval) = gc1(WILDCARD);} break; case 387: #line 817 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 388: #line 818 "parser.y" {(yyval) = gc4(ap(CONFLDS,pair((yyvsp[(1) - (4)]),(yyvsp[(3) - (4)]))));} break; case 389: #line 819 "parser.y" {(yyval) = gc4(ap(UPDFLDS, triple((yyvsp[(1) - (4)]),NIL,(yyvsp[(3) - (4)]))));} break; case 390: #line 821 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 391: #line 822 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 392: #line 823 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 393: #line 824 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 394: #line 825 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 395: #line 826 "parser.y" {(yyval) = gc3(buildTuple((yyvsp[(2) - (3)])));} break; case 396: #line 828 "parser.y" { #if TREX (yyval) = gc3(revOnto((yyvsp[(2) - (3)]),nameNoRec)); #else (yyval) = gc3(NIL); #endif } break; case 397: #line 835 "parser.y" {(yyval) = gc5(revOnto((yyvsp[(2) - (5)]),(yyvsp[(4) - (5)])));} break; case 398: #line 836 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 399: #line 838 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 400: #line 839 "parser.y" {(yyval) = gc4(ap((yyvsp[(3) - (4)]),(yyvsp[(2) - (4)])));} break; case 401: #line 840 "parser.y" {(yyval) = gc4(ap(ap(nameFlip,(yyvsp[(2) - (4)])),(yyvsp[(3) - (4)])));} break; case 402: #line 841 "parser.y" {(yyval) = gc4(ap(ap(nameFlip,(yyvsp[(2) - (4)])),(yyvsp[(3) - (4)])));} break; case 403: #line 843 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 404: #line 844 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),cons((yyvsp[(1) - (3)]),NIL)));} break; case 405: #line 847 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 406: #line 848 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 407: #line 850 "parser.y" { #if TREX (yyval) = gc3(ap(mkExt(textOf((yyvsp[(1) - (3)]))),(yyvsp[(3) - (3)]))); #else noTREX("an expression"); #endif } break; case 408: #line 859 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 409: #line 860 "parser.y" {(yyval) = gc2((yyvsp[(2) - (2)]));} break; case 410: #line 862 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 411: #line 863 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 412: #line 864 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 413: #line 866 "parser.y" {(yyval) = gc3(pair((yyvsp[(1) - (3)]),letrec((yyvsp[(3) - (3)]),(yyvsp[(2) - (3)]))));} break; case 414: #line 868 "parser.y" {(yyval) = gc1(grded(rev((yyvsp[(1) - (1)]))));} break; case 415: #line 869 "parser.y" {(yyval) = gc2(pair((yyvsp[(1) - (2)]),(yyvsp[(2) - (2)])));} break; case 416: #line 870 "parser.y" {syntaxError("case expression");} break; case 417: #line 872 "parser.y" {(yyval) = gc2(cons((yyvsp[(2) - (2)]),(yyvsp[(1) - (2)])));} break; case 418: #line 873 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 419: #line 875 "parser.y" {(yyval) = gc4(pair((yyvsp[(3) - (4)]),pair((yyvsp[(2) - (4)]),(yyvsp[(4) - (4)]))));} break; case 420: #line 878 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 421: #line 879 "parser.y" {(yyval) = gc2((yyvsp[(2) - (2)]));} break; case 422: #line 881 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 423: #line 882 "parser.y" {(yyval) = gc2((yyvsp[(1) - (2)]));} break; case 424: #line 883 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 425: #line 886 "parser.y" {(yyval) = gc3(ap(FROMQUAL,pair((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]))));} break; case 426: #line 887 "parser.y" {(yyval) = gc2(ap(QWHERE,(yyvsp[(2) - (2)])));} break; case 427: #line 889 "parser.y" {(yyval) = gc1(ap(DOQUAL,(yyvsp[(1) - (1)])));} break; case 428: #line 891 "parser.y" {(yyval) = gc0(NIL);} break; case 429: #line 892 "parser.y" {(yyval) = gc1(rev((yyvsp[(1) - (1)])));} break; case 430: #line 894 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 431: #line 895 "parser.y" {(yyval) = gc1(singleton((yyvsp[(1) - (1)])));} break; case 432: #line 897 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 433: #line 898 "parser.y" {(yyval) = gc3(pair((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)])));} break; case 434: #line 903 "parser.y" {(yyval) = gc1(ap(FINLIST,cons((yyvsp[(1) - (1)]),NIL)));} break; case 435: #line 904 "parser.y" {(yyval) = gc1(ap(FINLIST,rev((yyvsp[(1) - (1)]))));} break; case 436: #line 905 "parser.y" { #if ZIP_COMP if (length((yyvsp[(2) - (2)]))==1) { (yyval) = gc2(ap(COMP,pair((yyvsp[(1) - (2)]),hd((yyvsp[(2) - (2)]))))); } else { if (haskell98) syntaxError("list comprehension"); (yyval) = gc2(ap(ZCOMP,pair((yyvsp[(1) - (2)]),rev((yyvsp[(2) - (2)]))))); } #else if (length((yyvsp[(2) - (2)]))!=1) { syntaxError("list comprehension"); } (yyval) = gc2(ap(COMP,pair((yyvsp[(1) - (2)]),hd((yyvsp[(2) - (2)]))))); #endif } break; case 437: #line 921 "parser.y" {(yyval) = gc3(ap(ap(nameFromTo,(yyvsp[(1) - (3)])),(yyvsp[(3) - (3)])));} break; case 438: #line 922 "parser.y" {(yyval) = gc4(ap(ap(nameFromThen,(yyvsp[(1) - (4)])),(yyvsp[(3) - (4)])));} break; case 439: #line 923 "parser.y" {(yyval) = gc2(ap(nameFrom,(yyvsp[(1) - (2)])));} break; case 440: #line 924 "parser.y" {(yyval) = gc5(ap(ap(ap(nameFromThenTo, (yyvsp[(1) - (5)])),(yyvsp[(3) - (5)])),(yyvsp[(5) - (5)])));} break; case 441: #line 927 "parser.y" {(yyval) = gc3(cons(rev((yyvsp[(3) - (3)])),(yyvsp[(1) - (3)])));} break; case 442: #line 928 "parser.y" {(yyval) = gc2(cons(rev((yyvsp[(2) - (2)])),NIL));} break; case 443: #line 930 "parser.y" {(yyval) = gc3(cons((yyvsp[(3) - (3)]),(yyvsp[(1) - (3)])));} break; case 444: #line 931 "parser.y" {(yyval) = gc1(cons((yyvsp[(1) - (1)]),NIL));} break; case 445: #line 933 "parser.y" {(yyval) = gc3(ap(FROMQUAL,pair((yyvsp[(1) - (3)]),(yyvsp[(3) - (3)]))));} break; case 446: #line 934 "parser.y" {(yyval) = gc1(ap(BOOLQUAL,(yyvsp[(1) - (1)])));} break; case 447: #line 935 "parser.y" {(yyval) = gc2(ap(QWHERE,(yyvsp[(2) - (2)])));} break; case 448: #line 940 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 449: #line 941 "parser.y" {(yyval) = gc2(nameUnit);} break; case 450: #line 942 "parser.y" {(yyval) = gc2(nameNil);} break; case 451: #line 943 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 452: #line 945 "parser.y" {(yyval) = gc2(mkTuple(tupleOf((yyvsp[(1) - (2)]))+1));} break; case 453: #line 946 "parser.y" {(yyval) = gc1(mkTuple(2));} break; case 454: #line 948 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 455: #line 949 "parser.y" {(yyval) = gc1(varHiding);} break; case 456: #line 950 "parser.y" {(yyval) = gc1(varQualified);} break; case 457: #line 951 "parser.y" {(yyval) = gc1(varAsMod);} break; case 458: #line 953 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 459: #line 954 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 460: #line 956 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 461: #line 957 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 462: #line 958 "parser.y" {(yyval) = gc3(varPlus);} break; case 463: #line 959 "parser.y" {(yyval) = gc3(varMinus);} break; case 464: #line 960 "parser.y" {(yyval) = gc3(varBang);} break; case 465: #line 961 "parser.y" {(yyval) = gc3(varDot);} break; case 466: #line 963 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 467: #line 964 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 468: #line 965 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 469: #line 967 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 470: #line 968 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 471: #line 970 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 472: #line 971 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 473: #line 972 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 474: #line 974 "parser.y" {(yyval) = gc1(varPlus);} break; case 475: #line 975 "parser.y" {(yyval) = gc1(varMinus);} break; case 476: #line 976 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 477: #line 978 "parser.y" {(yyval) = gc1(varPlus);} break; case 478: #line 979 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 479: #line 981 "parser.y" {(yyval) = gc1(varMinus);} break; case 480: #line 982 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 481: #line 984 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 482: #line 985 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 483: #line 986 "parser.y" {(yyval) = gc1(varBang);} break; case 484: #line 987 "parser.y" {(yyval) = gc1(varDot);} break; case 485: #line 989 "parser.y" {(yyval) = gc1(varMinus);} break; case 486: #line 990 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 487: #line 992 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 488: #line 993 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 489: #line 994 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 490: #line 997 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 491: #line 998 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 492: #line 1000 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 493: #line 1001 "parser.y" {(yyval) = gc3((yyvsp[(2) - (3)]));} break; case 494: #line 1002 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 495: #line 1004 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 496: #line 1005 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 497: #line 1007 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 498: #line 1008 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 499: #line 1013 "parser.y" {goOffside(startColumn);} break; case 500: #line 1016 "parser.y" {(yyval) = (yyvsp[(1) - (1)]);} break; case 501: #line 1017 "parser.y" {yyerrok; if (canUnOffside()) { unOffside(); /* insert extra token on stack*/ push(NIL); pushed(0) = pushed(1); pushed(1) = mkInt(column); } else syntaxError("declaration"); } break; /* Line 1267 of yacc.c. */ #line 5619 "y.tab.c" default: break; } YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); *++yyvsp = yyval; /* Now `shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ yyn = yyr1[yyn]; yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) yystate = yytable[yystate]; else yystate = yydefgoto[yyn - YYNTOKENS]; goto yynewstate; /*------------------------------------. | yyerrlab -- here on detecting error | `------------------------------------*/ yyerrlab: /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { ++yynerrs; #if ! YYERROR_VERBOSE yyerror (YY_("syntax error")); #else { YYSIZE_T yysize = yysyntax_error (0, yystate, yychar); if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM) { YYSIZE_T yyalloc = 2 * yysize; if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM)) yyalloc = YYSTACK_ALLOC_MAXIMUM; if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); yymsg = (char *) YYSTACK_ALLOC (yyalloc); if (yymsg) yymsg_alloc = yyalloc; else { yymsg = yymsgbuf; yymsg_alloc = sizeof yymsgbuf; } } if (0 < yysize && yysize <= yymsg_alloc) { (void) yysyntax_error (yymsg, yystate, yychar); yyerror (yymsg); } else { yyerror (YY_("syntax error")); if (yysize != 0) goto yyexhaustedlab; } } #endif } if (yyerrstatus == 3) { /* If just tried and failed to reuse look-ahead token after an error, discard it. */ if (yychar <= YYEOF) { /* Return failure if at end of input. */ if (yychar == YYEOF) YYABORT; } else { yydestruct ("Error: discarding", yytoken, &yylval); yychar = YYEMPTY; } } /* Else will try to reuse look-ahead token after shifting the error token. */ goto yyerrlab1; /*---------------------------------------------------. | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: /* Pacify compilers like GCC when the user code never invokes YYERROR and the label yyerrorlab therefore never appears in user code. */ if (/*CONSTCOND*/ 0) goto yyerrorlab; /* Do not reclaim the symbols of the rule which action triggered this YYERROR. */ YYPOPSTACK (yylen); yylen = 0; YY_STACK_PRINT (yyss, yyssp); yystate = *yyssp; goto yyerrlab1; /*-------------------------------------------------------------. | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: yyerrstatus = 3; /* Each real token shifted decrements this. */ for (;;) { yyn = yypact[yystate]; if (yyn != YYPACT_NINF) { yyn += YYTERROR; if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) { yyn = yytable[yyn]; if (0 < yyn) break; } } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) YYABORT; yydestruct ("Error: popping", yystos[yystate], yyvsp); YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } if (yyn == YYFINAL) YYACCEPT; *++yyvsp = yylval; /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); yystate = yyn; goto yynewstate; /*-------------------------------------. | yyacceptlab -- YYACCEPT comes here. | `-------------------------------------*/ yyacceptlab: yyresult = 0; goto yyreturn; /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yyresult = 1; goto yyreturn; #ifndef yyoverflow /*-------------------------------------------------. | yyexhaustedlab -- memory exhaustion comes here. | `-------------------------------------------------*/ yyexhaustedlab: yyerror (YY_("memory exhausted")); yyresult = 2; /* Fall through. */ #endif yyreturn: if (yychar != YYEOF && yychar != YYEMPTY) yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval); /* Do not reclaim the symbols of the rule which action triggered this YYABORT or YYACCEPT. */ YYPOPSTACK (yylen); YY_STACK_PRINT (yyss, yyssp); while (yyssp != yyss) { yydestruct ("Cleanup: popping", yystos[*yyssp], yyvsp); YYPOPSTACK (1); } #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif #if YYERROR_VERBOSE if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); #endif /* Make sure YYID is used. */ return YYID (yyresult); } #line 1032 "parser.y" static Cell local gcShadow(n,e) /* keep parsed fragments on stack */ Int n; Cell e; { /* If a look ahead token is held then the required stack transformation * is: * pushed: n 1 0 1 0 * x1 | ... | xn | la ===> e | la * top() top() * * Othwerwise, the transformation is: * pushed: n-1 0 0 * x1 | ... | xn ===> e * top() top() */ if (yychar>=0) { pushed(n-1) = top(); pushed(n) = e; } else pushed(n-1) = e; sp -= (n-1); return e; } static Void local syntaxError(s) /* report on syntax error */ String s; { ERRMSG(row) "Syntax error in %s (unexpected %s)", s, unexpected() EEND; } static String local unexpected() { /* find name for unexpected token */ static char buffer[100]; static char *fmt = "%s \"%s\""; static char *kwd = "keyword"; switch (yychar) { case 0 : return "end of input"; #define keyword(kw) sprintf(buffer,fmt,kwd,kw); return buffer; case INFIXL : keyword("infixl"); case INFIXR : keyword("infixr"); case INFIXN : keyword("infix"); case TINSTANCE : keyword("instance"); case TCLASS : keyword("class"); case PRIMITIVE : keyword("primitive"); case CASEXP : keyword("case"); case OF : keyword("of"); case IF : keyword("if"); case THEN : keyword("then"); case ELSE : keyword("else"); case WHERE : keyword("where"); case TYPE : keyword("type"); case DATA : keyword("data"); case TNEWTYPE : keyword("newtype"); case LET : keyword("let"); case IN : keyword("in"); case DERIVING : keyword("deriving"); case DEFAULT : keyword("default"); case IMPORT : keyword("import"); case TMODULE : keyword("module"); case ALL : keyword("forall"); #undef keyword case ARROW : return "`->'"; case '=' : return "`='"; case COCO : return "`::'"; case '-' : return "`-'"; case '!' : return "`!'"; case ',' : return "comma"; case '@' : return "`@'"; case '(' : return "`('"; case ')' : return "`)'"; case '{' : return "`{', possibly due to bad layout"; case '}' : return "`}', possibly due to bad layout"; case '_' : return "`_'"; case '|' : return "`|'"; case '.' : return "`.'"; case ';' : return "`;', possibly due to bad layout"; case UPTO : return "`..'"; case '[' : return "`['"; case ']' : return "`]'"; case FROM : return "`<-'"; case '\\' : return "backslash (lambda)"; case '~' : return "tilde"; case '`' : return "backquote"; #if TREX case RECSELID : sprintf(buffer,"selector \"#%s\"", textToStr(extText(snd(yylval)))); return buffer; #endif #if IPARAM case IPVARID : sprintf(buffer,"implicit parameter \"?%s\"", textToStr(textOf(yylval))); return buffer; #endif case VAROP : case VARID : case CONOP : case CONID : sprintf(buffer,"symbol \"%s\"", textToStr(textOf(yylval))); return buffer; case QVAROP : case QVARID : case QCONOP : case QCONID : sprintf(buffer,"symbol \"%s\"", identToStr(yylval)); return buffer; case HIDING : return "symbol \"hiding\""; case QUALIFIED : return "symbol \"qualified\""; case ASMOD : return "symbol \"as\""; case NUMLIT : return "numeric literal"; case CHARLIT : return "character literal"; case STRINGLIT : return "string literal"; case IMPLIES : return "`=>'"; default : return "token"; } } static Cell local checkPrec(p) /* Check for valid precedence value*/ Cell p; { if (!isInt(p) || intOf(p)MAX_PREC) { ERRMSG(row) "Precedence value must be an integer in the range [%d..%d]", MIN_PREC, MAX_PREC EEND; } return p; } static Cell local buildTuple(tup) /* build tuple (x1,...,xn) from */ List tup; { /* list [xn,...,x1] */ Int n = 0; Cell t = tup; Cell x; do { /* . . */ x = fst(t); /* / \ / \ */ fst(t) = snd(t); /* xn . . xn */ snd(t) = x; /* . ===> . */ x = t; /* . . */ t = fun(x); /* . . */ n++; /* / \ / \ */ } while (nonNull(t)); /* x1 NIL (n) x1 */ fst(x) = mkTuple(n); return tup; } static List local checkCtxt(con) /* validate context */ Type con; { mapOver(checkPred, con); return con; } static Cell local checkPred(c) /* check that type expr is a valid */ Cell c; { /* constraint */ Cell cn = getHead(c); #if TREX if (isExt(cn) && argCount==1) return c; #endif #if IPARAM if (isIP(cn)) return c; #endif if (!isQCon(cn) /*|| argCount==0*/) syntaxError("class expression"); return c; } static Pair local checkDo(dqs) /* convert reversed list of dquals */ List dqs; { /* to an (expr,quals) pair */ if (isNull(dqs) || whatIs(hd(dqs))!=DOQUAL) { ERRMSG(row) "Last generator in do {...} must be an expression" EEND; } fst(dqs) = snd(fst(dqs)); /* put expression in fst of pair */ snd(dqs) = rev(snd(dqs)); /* & reversed list of quals in snd */ return dqs; } #if MUDO static Pair local checkMDo(dqs) /* convert reversed list of dquals */ List dqs; { /* to an (expr,quals) pair */ if (isNull(dqs) || whatIs(hd(dqs))!=DOQUAL) { ERRMSG(row) "Last generator in mdo {...} must be an expression" EEND; } fst(dqs) = snd(fst(dqs)); /* put expression in fst of pair */ snd(dqs) = rev(snd(dqs)); /* & reversed list of quals in snd */ return dqs; } #endif static Cell local checkTyLhs(c) /* check that lhs is of the form */ Cell c; { /* T a1 ... a */ Cell tlhs = c; while (isAp(tlhs) && whatIs(arg(tlhs))==VARIDCELL) { tlhs = fun(tlhs); } if (whatIs(tlhs)!=CONIDCELL) { ERRMSG(row) "Illegal left hand side in data type declaration" EEND; } return c; } static Cell local checkConstr(c) /* check that data constructor has */ Cell c; { /* an unqualified conid as head */ Cell chd = c; while (isAp(chd)) { chd = fun(chd); } if (whatIs(chd)==QUALIDENT) { ERRMSG(row) "Qualified constructor in data type declaration" EEND; } return c; } #if !TREX static Void local noTREX(where) String where; { ERRMSG(row) "Attempt to use TREX records while parsing %s.\n", where ETHEN ERRTEXT "(TREX is disabled in this build of Hugs)" EEND; } #endif #if !IPARAM static Void local noIP(where) String where; { ERRMSG(row) "Attempt to use Implicit Parameters while parsing %s.\n", where ETHEN ERRTEXT "(Implicit Parameters are disabled in this build of Hugs)" EEND; } #endif #if !MUDO /*** Due to the way we implement this stuff, this function will actually never be called. When MUDO is not defined, the lexer thinks that mdo is just another identifier, and hence the MDO token is never returned to the parser: consequently the mdo production is never reduced, making this code unreachable. The alternative is to let the lexer to recognize "mdo" all the time, but that's not Haskell compliant. In any case we keep this function here, even if just for documentation purposes. ***/ static Void local noMDo(where) String where; { ERRMSG(row) "Attempt to use MDO while parsing %s.\n", where ETHEN ERRTEXT "(Recursive monadic bindings are disabled in this build of Hugs)" EEND; } #endif /*-------------------------------------------------------------------------*/ hugs98-plus-Sep2006/src/config.h.in0000644006511100651110000004020510504340734015576 0ustar rossross/* src/config.h.in. Generated from configure.ac by autoheader. */ /* platform-specific defines */ #include "platform.h" /* Define to 1 if you want to use the primitives which let you examine Hugs bytecodes (requires INTERNAL_PRIMS). */ #undef BYTECODE_PRIMS /* Define to 1 to use a Char encoding determined by the locale. */ #undef CHAR_ENCODING_LOCALE /* Define to 1 to use the UTF-8 Char encoding. */ #undef CHAR_ENCODING_UTF8 /* Define to 1 if you want to perform runtime tag-checks as an internal consistency check. This makes Hugs run very slowly - but is very effective at detecting and locating subtle bugs. */ #undef CHECK_TAGS /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP systems. This function is required for `alloca.c' support on those systems. */ #undef CRAY_STACKSEG_END /* Define to 1 if using `alloca.c'. */ #undef C_ALLOCA /* Define to 1 if debugging generated bytecodes or the bytecode interpreter. */ #undef DEBUG_CODE /* Define if you want to use a low-level printer from within a debugger. */ #undef DEBUG_PRINTER /* In a plain Hugs system, most signals (SIGBUS, SIGTERM, etc) indicate some kind of error in Hugs - or maybe a stack overflow. Rather than just crash, Hugs catches these errors and returns to the main loop. It does this by calling a function "panic" which longjmp's back to the main loop. If you're developing a foreign library, this may not be the right behaviour - it's better if Hugs leaves them for your debugger to catch rather than trapping them and "panicking". */ #undef DONT_PANIC /* Define to 1 if floating point arithmetic is supported. */ #undef FLOATS_SUPPORTED /* If you get really desperate to understand why your Hugs programs keep crashing or running out of stack, you might like to set this flag and recompile Hugs. When you hit a stack error, it will print out a list of all the objects currently under evaluation. The information isn't perfect and can be pretty hard to understand but it's better than a poke in the eye with a blunt stick. This is a very experimental feature! */ #undef GIMME_STACK_DUMPS /* Define to 1 to omit Hugs extensions */ #undef HASKELL_98_ONLY /* Define to 1 if you have `alloca', as a function or macro. */ #undef HAVE_ALLOCA /* Define to 1 if you have and it should be used (not on Ultrix). */ #undef HAVE_ALLOCA_H /* Define to 1 if you have the header file. */ #undef HAVE_ASSERT_H /* Define to 1 if you have the `atan' function. */ #undef HAVE_ATAN /* Define to 1 if you have /bin/sh */ #undef HAVE_BIN_SH /* Define to 1 if you have the header file. */ #undef HAVE_CONIO_H /* Define to 1 if you have the header file. */ #undef HAVE_CONSOLE_H /* Define to 1 if you have the header file. */ #undef HAVE_CTYPE_H /* Define to 1 if you have the declaration of `altzone', and to 0 if you don't. */ #undef HAVE_DECL_ALTZONE /* Define to 1 if you have the declaration of `timezone', and to 0 if you don't. */ #undef HAVE_DECL_TIMEZONE /* Define to 1 if you have the declaration of `tzname', and to 0 if you don't. */ #undef HAVE_DECL_TZNAME /* Define to 1 if you have the declaration of `_timezone', and to 0 if you don't. */ #undef HAVE_DECL__TIMEZONE /* Define to 1 if you have the header file. */ #undef HAVE_DIRECT_H /* Define to 1 if you have the header file. */ #undef HAVE_DIRENT_H /* Define to 1 if you have the header file. */ #undef HAVE_DLFCN_H /* Define to 1 if you have the `dlopen' function. */ #undef HAVE_DLOPEN /* Define to 1 if you have the header file. */ #undef HAVE_DL_H /* Define to 1 if you have the header file. */ #undef HAVE_DOS_H /* Define to 1 if you have the `dup' function. */ #undef HAVE_DUP /* Define to 1 if you have the header file. */ #undef HAVE_ERRNO_H /* Define to 1 if you have the `farcalloc' function. */ #undef HAVE_FARCALLOC /* Define to 1 if you have the header file. */ #undef HAVE_FCNTL_H /* Define to 1 if you have the header file. */ #undef HAVE_FILES_H /* Define to 1 if you have the header file. */ #undef HAVE_FLOAT_H /* Define to 1 if you have the `fseek' function. */ #undef HAVE_FSEEK /* Define to 1 if you have the `fstat' function. */ #undef HAVE_FSTAT /* Define to 1 if you have the `ftell' function. */ #undef HAVE_FTELL /* Define to 1 if you have the `ftime' function. */ #undef HAVE_FTIME /* Define to 1 if you have the `GetModuleFileName' function. */ #undef HAVE_GETMODULEFILENAME /* Define to 1 if you have the `getrusage' function. */ #undef HAVE_GETRUSAGE /* Define to 1 if you have the `gettimeofday' function. */ #undef HAVE_GETTIMEOFDAY /* Define to 1 if you have the `gmtime' function. */ #undef HAVE_GMTIME /* Define to 1 if heap profiler can (and should) automatically invoke hp2ps to convert heap profile (in "profile.hp") to PostScript. */ #undef HAVE_HP2PS /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_IO_H /* Define to 1 if you have the `isatty' function. */ #undef HAVE_ISATTY /* Define to 1 if compiler supports gcc's "labels as values" (aka computed goto) feature (which is used to speed up instruction dispatch in the interpreter). */ #undef HAVE_LABELS_AS_VALUES /* Define to 1 if you have the `dl' library (-ldl). */ #undef HAVE_LIBDL /* Define to 1 if you have the `dld' library (-ldld). */ #undef HAVE_LIBDLD /* Define to 1 if you have the `m' library (-lm). */ #undef HAVE_LIBM /* Define to 1 if you have the header file. */ #undef HAVE_LIMITS_H /* Define to 1 if you have the `LoadLibrary' function. */ #undef HAVE_LOADLIBRARY /* Define to 1 if you have the header file. */ #undef HAVE_LOCALE_H /* Define to 1 if you have the `localtime' function. */ #undef HAVE_LOCALTIME /* Define to 1 if you have the header file. */ #undef HAVE_MACH_O_DYLD_H /* Define to 1 if you have the `macsystem' function. */ #undef HAVE_MACSYSTEM /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the `mktime' function. */ #undef HAVE_MKTIME /* Define to 1 if you have the `NSCreateObjectFileImageFromFile' function. */ #undef HAVE_NSCREATEOBJECTFILEIMAGEFROMFILE /* Define to 1 if you have the `pclose' function. */ #undef HAVE_PCLOSE /* Define to 1 if you have the `poly' function. */ #undef HAVE_POLY /* Define to 1 if you have the `popen' function. */ #undef HAVE_POPEN /* Define if you have POSIX threads libraries and header files. */ #undef HAVE_PTHREAD /* Define to 1 if you have the `realpath' function. */ #undef HAVE_REALPATH /* Define to 1 if you have the `rindex' function. */ #undef HAVE_RINDEX /* Define to 1 if you have the `select' function. */ #undef HAVE_SELECT /* Define to 1 if you have the header file. */ #undef HAVE_SGTTY_H /* Define to 1 if you have the `shl_load' function. */ #undef HAVE_SHL_LOAD /* Define to 1 if you have the header file. */ #undef HAVE_SIGNAL_H /* Define to 1 if you have the `sigprocmask' function. */ #undef HAVE_SIGPROCMASK /* Define to 1 if you have the `snprintf' function. */ #undef HAVE_SNPRINTF /* Define to 1 if you have the header file. */ #undef HAVE_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDARG_H /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STD_H /* Define to 1 if you have the `stime' function. */ #undef HAVE_STIME /* Define to 1 if you have the `strcasecmp' function. */ #undef HAVE_STRCASECMP /* Define to 1 if you have the `strcmp' function. */ #undef HAVE_STRCMP /* Define to 1 if you have the `strcmpi' function. */ #undef HAVE_STRCMPI /* Define to 1 if you have the `stricmp' function. */ #undef HAVE_STRICMP /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the `strrchr' function. */ #undef HAVE_STRRCHR /* Define to 1 if `tm_zone' is member of `struct tm'. */ #undef HAVE_STRUCT_TM_TM_ZONE /* Define to 1 if you have the header file. */ #undef HAVE_SYS_IOCTL_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_PARAM_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_RESOURCE_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIMEB_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIMES_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have that is POSIX.1 compatible. */ #undef HAVE_SYS_WAIT_H /* Define to 1 if you have the header file. */ #undef HAVE_TERMIOS_H /* Define to 1 if you have the header file. */ #undef HAVE_TERMIO_H /* Define to 1 if you have the `time' function. */ #undef HAVE_TIME /* Define to 1 if you have the `times' function. */ #undef HAVE_TIMES /* Define to 1 if you have the header file. */ #undef HAVE_TIME_H /* Define to 1 if your `struct tm' has `tm_zone'. Deprecated, use `HAVE_STRUCT_TM_TM_ZONE' instead. */ #undef HAVE_TM_ZONE /* Define to 1 if you don't have `tm_zone' but do have the external array `tzname'. */ #undef HAVE_TZNAME /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to 1 if you have the `valloc' function. */ #undef HAVE_VALLOC /* Define to 1 if you have the header file. */ #undef HAVE_VALUES_H /* Define to 1 if you have the `vsnprintf' function. */ #undef HAVE_VSNPRINTF /* Define to 1 if you have the header file. */ #undef HAVE_WCHAR_H /* Define to 1 if you have the header file. */ #undef HAVE_WINDOWS_H /* Define to 1 if you have the `WinExec' function. */ #undef HAVE_WINEXEC /* Define to 1 if you have malloc.h and it defines _alloca - eg for Visual C++. */ #undef HAVE__ALLOCA /* Define to 1 if you have the `_fullpath' function. */ #undef HAVE__FULLPATH /* Define to 1 if you have the `_pclose' function. */ #undef HAVE__PCLOSE /* Define to 1 if you have the `_popen' function. */ #undef HAVE__POPEN /* Define to 1 if you have the `_snprintf' function. */ #undef HAVE__SNPRINTF /* Define to 1 if you have the `_stricmp' function. */ #undef HAVE__STRICMP /* Define to 1 if you have the `_vsnprintf' function. */ #undef HAVE__VSNPRINTF /* The directory name which is substituted for the string "{Hugs}" in a path variable. This normally points to where the Hugs libraries are installed - ie so that the file HUGSDIR/packages/base/Prelude.hs exists. Typical values are: "/usr/local/lib/hugs", "/usr/homes/JFHaskell/hugs", "../hugsdir". This value is ignored on Windows and old MacOS versions since it is assumed that the binary is installed in HUGSDIR. This value can be overridden using the environment variable HUGSDIR, and you can always choose _not_ to use the {Hugs} variable. */ #undef HUGSDIR /* Define this as the default setting of HUGSPATH. Value may contain string "{Hugs}" (for which we will substitute the value of HUGSDIR) and should be either colon-separated (Unix) or semicolon-separated (Macintosh, Windows, DOS). Escape characters in the path string are interpreted according to normal Haskell conventions. This value can be overridden from the command line by setting the HUGSFLAGS environment variable or by storing an appropriate value for HUGSFLAGS in the registry (Win32 only). In all cases, use a string of the form -P"...". */ #undef HUGSPATH /* The list of suffixes used by Haskell source files, separated either by colons (Unix) or semicolons (Macintosh, Windows, DOS). This value can be overridden using the -S flag. */ #undef HUGSSUFFIXES /* Define to 1 if you want to use the "Hugs for Windows" GUI. (Windows 3.1 and compatibles only) */ #undef HUGS_FOR_WINDOWS /* Define to 1 if you want to use the primitives which let you examine Hugs internals. */ #undef INTERNAL_PRIMS /* Define to 1 if jmpbufs can be treated like arrays. */ #undef JMPBUF_ARRAY /* Define to 1 for 32 bit operation using larger default table sizes. */ #undef LARGE_HUGS /* Define to 1 if your C compiler inserts underscores before symbol names. */ #undef LEADING_UNDERSCORE /* C compiler invocation use to build a dynamically loadable library. Typical value: "gcc -shared". Must evaluate to a literal C string. */ #undef MKDLL_CMD /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Define to 1 if you want filenames to be converted to normal form by: (a) replacing relative pathnames with absolute pathnames and eliminating .. and . where possible. (b) converting to lower case (only in case-insensitive filesystems) */ #undef PATH_CANONICALIZATION /* Define to 1 if heap profiling should be used. */ #undef PROFILING /* Define to 1 if the C compiler supports function prototypes. */ #undef PROTOTYPES /* Define to the necessary symbol if this constant uses a non-standard name on your system. */ #undef PTHREAD_CREATE_JOINABLE /* Define to 1 for 32 bit operation using largish default table sizes. */ #undef REGULAR_HUGS /* Define as the return type of signal handlers (`int' or `void'). */ #undef RETSIGTYPE /* The size of `double', as computed by sizeof. */ #undef SIZEOF_DOUBLE /* The size of `float', as computed by sizeof. */ #undef SIZEOF_FLOAT /* The size of `int', as computed by sizeof. */ #undef SIZEOF_INT /* The size of `int*', as computed by sizeof. */ #undef SIZEOF_INTP /* Define to 1 if you want the small startup banner. */ #undef SMALL_BANNER /* Define to 1 for 16 bit operation on a limited memory PC. */ #undef SMALL_HUGS /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at runtime. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ #undef STACK_DIRECTION /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS /* Define to 1 if you can safely include both and . */ #undef TIME_WITH_SYS_TIME /* Define to 1 if your declares `struct tm'. */ #undef TM_IN_SYS_TIME /* Define to 1 if a command line editor is available and should be used. There are two choices of command line editor that can be used with Hugs: GNU readline and editline (from comp.sources.misc, vol 31, issue 71) */ #undef USE_READLINE /* Define to 1 if signal handlers have type void (*)(int) (Otherwise, they're assumed to have type int (*)(void).) */ #undef VOID_INT_SIGNALS /* Define if you want to time every evaluation. Timing is included in the Hugs distribution for the purpose of benchmarking the Hugs interpreter, comparing its performance across a variety of different machines, and with other systems for similar languages. It would be somewhat foolish to try to use the timings produced in this way for any other purpose. In particular, using timings to compare the performance of different versions of an algorithm is likely to give very misleading results. The current implementation of Hugs as an interpreter, without any significant optimizations, means that there are much more significant overheads than can be accounted for by small variations in Hugs code. */ #undef WANT_TIMER /* Define like PROTOTYPES; this can be used by system headers. */ #undef __PROTOTYPES /* Define to empty if `const' does not conform to ANSI C. */ #undef const hugs98-plus-Sep2006/tools/0000755006511100651110000000000010504340137014120 5ustar rossrosshugs98-plus-Sep2006/tools/ConvertLibs.hs0000644006511100651110000001174107473467443016737 0ustar rossross-- -- Converting fptools/libraries/ into Hugs useable form. -- module Main(main) where import System import IO import Directory import Maybe import List import Monad cpp :: String cpp = "gcc -P -E -xc -traditional" wash :: FilePath -> FilePath -> String -> IO () wash inp outp extraArgs = do hPutStrLn stderr ("Pre-processing: " ++ inp) rc <- System.system cmd case rc of ExitSuccess -> return () ExitFailure{} -> hPutStrLn stderr ("Error: " ++ show rc) where cmd = unwords [ cpp , "-D__HUGS__" , "-D__HASKELL98__" , extraArgs , inp , "-o " ++ outp ] outDir :: String outDir = "c:/src/hugs98/libraries" inpDir :: String inpDir = "c:/fptools/HEAD/libraries" pathSeparator :: Char pathSeparator = '/' isPathSeparator :: Char -> Bool isPathSeparator '/' = True isPathSeparator '\\' = True isPathSeparator _ = False main :: IO () main = do putStrLn "Converting the Haskell hierarchical libraries into Hugs friendly form" putStrLn ("Source directory: " ++ inpDir) putStrLn ("Output directory: " ++ outDir) isThere <- doesDirectoryExist inpDir when (not isThere) (hPutStrLn stderr "input directory does not exist, stopping." >> exitSuccess) isThere <- doesDirectoryExist outDir when (not isThere) (hPutStrLn stderr "output directory does not exist, stopping." >> exitSuccess) fs <- findAllFilesMatching pathFilter fileFilter inpDir print "done" let theFs = mapMaybe ofInterest fs mapM_ washFile theFs return () where pathFilter :: [FilePath] -> Bool pathFilter [] = True pathFilter ("CVS":_) = False pathFilter fs@(x:_) | "_split" `isSuffixOf` x = False pathFilter _ = True fileFilter :: [FilePath] -> Bool fileFilter = withSuffix ["hs", "lhs"] ofInterest :: [String] -> Maybe ([String], Maybe String) ofInterest comps = Just (comps, Nothing) washFile (comps, mbArgs) = do makeDirectory oDir wash (inpDir ++ pathSeparator : relNm) (outDir ++ pathSeparator : relNm) (fromMaybe "" mbArgs) where rcomps = reverse comps relDir = concat (intersperse [pathSeparator] (reverse (tail comps))) relNm = concat (intersperse [pathSeparator] rcomps) oDir = outDir ++ pathSeparator:relDir exitSuccess = exitWith ExitSuccess {- Given a base directory, locate all files satisfying 'pred' in that directory tree. The files returned are all in -} findAllFilesMatching :: ([String] -> Bool) -> ([String] -> Bool) -> FilePath -> IO [[String]] findAllFilesMatching predPath predFile base = go [] where go prefix = do ls <- getDirectoryContents fPath let entries = filter (not.isHereUp) ls stuff <- mapM (\ f -> classifyEntry (f:prefix) (mkFilePath base prefix f)) entries let (dirs, allFiles) = unzipEithers stuff theFiles = filter predFile allFiles print theFiles lss <- mapM go (filter predPath dirs) return (theFiles ++ concat lss) where fPath = mkFilePath base prefix "" makeDirectory :: FilePath -> IO () makeDirectory fpath = do flg <- doesDirectoryExist fpath print (fpath,flg,dirName fpath) if flg then return () else do -- try creating the parent. case dirName fpath of "" -> createDirectory fpath "./" -> createDirectory fpath d -> do flg <- doesDirectoryExist d when (not flg) (makeDirectory d) createDirectory fpath classifyEntry f fpath = do flg <- doesDirectoryExist fpath return ((case flg of { True -> Left; _ -> Right}) f) mkFilePath :: FilePath -> [String] -> String -> FilePath mkFilePath base comps s = foldr (\ x acc -> acc ++ pathSeparator:x) base (consL s comps) where consL [] xs = xs consL x xs = x:xs isHereUp :: FilePath -> Bool isHereUp "." = True isHereUp ".." = True isHereUp _ = False unzipEithers :: [Either a b] -> ([a], [b]) unzipEithers [] = ([], []) unzipEithers (x:xs) = case x of Left v -> (v:as, bs) Right v -> (as, v:bs) where (as,bs) = unzipEithers xs withSuffix :: [String] -> [String] -> Bool withSuffix _ [] = False withSuffix sufs (s:_) = fileSuffix s `elem` sufs hasSuffix [] = False hasSuffix (x:_) = not (null (fileSuffix x)) -- FileUtil outtakes: dirName :: FilePath -> FilePath dirName fname = case revDropWhile (not.isPathSeparator) (revDropWhile isPathSeparator fname) of "" -> "./" -- no separator was found, dir-name is "." xs -> xs revDropWhile :: (a -> Bool) -> [a] -> [a] revDropWhile p = foldr f [] where f x [] = if p x then [] else [x] f x xs = (x:xs) -- suffix _does not_ include the dot. In case there isn't a suffix, -- return empty string. fileSuffix :: FilePath -> String fileSuffix = findLast (=='.') "" findLast :: (Char -> Bool) -> String -> String -> String findLast pred noMatch f = go False f f where go matched acc [] | matched = acc | otherwise = noMatch go matched acc (x:xs) | pred x = go True xs xs | otherwise = go matched acc xs hugs98-plus-Sep2006/tools/hugs-hc0000755006511100651110000000633310464157560015424 0ustar rossross#! /bin/sh # Simulate a Haskell compiler using Hugs # (used to interface to the test suite) # For best results, you also need to modify Hugs.Prelude, using # prelude.patch (also in hugs98/tools). out_file= compile_only=false extra_opts='-k' haskell98=true use_cpp=false cpp='cpp -P -traditional -D__HUGS__' cpp_flags= # flags that also occur in source files handle_flag() { case $1 in -cpp) use_cpp=true ;; -[DI]*) cpp_flags="$cpp_flags $1" ;; -fglasgow-exts) haskell98=false ;; -fimplicit-params) haskell98=false ;; -fallow-overlapping-instances) haskell98=false extra_opts="$extra_opts +o" ;; -fallow-undecidable-instances) haskell98=false extra_opts="$extra_opts +O" ;; esac } cc_args= while [ $# -gt 0 ] do case "$1" in -o) shift out_file="$1" ;; -[Cc]) compile_only=true ;; -package) shift ;; +RTS) shift while [ $# -gt 0 && $1 != -RTS ] do shift done ;; --make) ;; -[dvOW]*) ;; -[lL]*) cc_args="$cc_args $1" ;; -*) handle_flag $1 ;; *.o) cc_args="$cc_args $1" ;; *.c) cc_args="$cc_args $1" ;; *.hs|*.lhs) sources="$sources $1" ;; *) if [ -f $1.hs ] then sources="$sources $1.hs" elif [ -f $1.lhs ] then sources="$sources $1.lhs" fi ;; esac shift done ffi_args="$cpp_flags $cc_args" for f in $sources; do src_opts=`egrep '^>*{-# OPTIONS(_GHC)? ' $f | sed -e 's/.*{-# OPTIONS[_A-Z]* //' -e 's/ #-}//'` for flag in $src_opts do handle_flag $flag done done if $haskell98 then extra_opts="+98 $extra_opts" else extra_opts="-98 $extra_opts" fi for f in $sources; do if grep '^foreign ' $f >/dev/null; then if test -L $f; then # ffihugs doesn't work with symlinks mv $f $f.save cp $f.save $f fi if $use_cpp; then ffihugs -F"$cpp $cpp_flags" $extra_opts $f $ffi_args || exit 1 else ffihugs $extra_opts $f $ffi_args || exit 1 fi fi if $use_cpp; then if hugs -F"$cpp $cpp_flags" $extra_opts $f &2 then exit 1 fi else if hugs $extra_opts $f &2 then exit 1 fi fi stem=`echo $f | sed 's/\.l*hs$//'` # Generate empty "object" file if $compile_only && [ -n "$out_file" ] then echo >$out_file else echo >$stem.o fi # Generate "interface" file containing the name of the source # file, if the source file was a Main module, otherwise nothing, # we can "link" these. if grep 'module[ ][ ]*Main' $f >/dev/null || ( ! grep 'module[ ][ ]*[A-Z]' $f >/dev/null && grep -w main $f >/dev/null ) then main_file="$f" else main_file='' fi case "$main_file" in /*) ;; ?*) main_file="`pwd`/$main_file" ;; esac echo $main_file >$stem.hi interfaces="$interfaces $stem.hi" done # If not -c, generate an "executable" that invokes runhugs on the file # containing the Main module, whose name will be in one of the .hi files. if ! $compile_only then main_file=`cat $interfaces | grep . | sed 1q` case "$main_file" in ?*) : ${out_file:=a.out} ( echo '#! /bin/sh' if $use_cpp then echo runhugs "-F'$cpp $cpp_flags 2>/dev/null'" $extra_opts $main_file '"$@"' else echo runhugs $extra_opts $main_file '"$@"' fi ) >$out_file chmod 755 $out_file ;; esac fi hugs98-plus-Sep2006/tools/prelude.patch0000644006511100651110000000326710232224452016610 0ustar rossrossPatch to make Hugs output more suitable for use with hugs-hc and the fptools testsuite: * show less detail about pattern match failures to make output less brittle. * print top-level exceptions in the same way as GHC-generated programs do. --- Hugs/Prelude.hs 2005-04-14 12:42:12.000000000 +0100 +++ Hugs/Prelude.hs.new 2005-04-22 15:17:26.000000000 +0100 @@ -1618,7 +1618,7 @@ showsPrec _ (IOException err) = shows err showsPrec _ (NoMethodError s) = showException "undefined member" s showsPrec _ NonTermination = showString "<>" - showsPrec _ (PatternMatchFail s) = showException "pattern match failure" s + showsPrec _ (PatternMatchFail s) = showString "pattern match failure" showsPrec _ (RecConError s) = showException "undefined field" s showsPrec _ (RecSelError s) = showException "select of missing field" s showsPrec _ (RecUpdError s) = showException "update of missing field" s @@ -1914,11 +1914,20 @@ exceptionHandler (ExitException ExitSuccess) = primExitWith 0 exceptionHandler (ExitException (ExitFailure n)) = primExitWith n exceptionHandler err = runAndShowError $ do - putChar '\n' - putStr "Program error: " - putStrLn (show err) + pname <- getProgName + let shortName = reverse $ takeWhile (/= '/') $ tail $ + dropWhile (/= '.') $ reverse pname + hPutStr stderr shortName + hPutStr stderr ": " + hPutStr stderr (show err) + hPutChar stderr '\n' primExitWith 1 +primitive getProgName "primGetProgName" :: IO String +primitive stderr :: Handle +primitive hPutChar :: Handle -> Char -> IO () +primitive hPutStr :: Handle -> String -> IO () + basicIORun :: IO a -> IOFinished a basicIORun (IO m) = loop [m hugsReturn] hugs98-plus-Sep2006/fptools/0000755006511100651110000000000010504340141014441 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/0000755006511100651110000000000010504340142015726 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/concurrent/0000755006511100651110000000000010504340141020107 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/concurrent/doc/0000755006511100651110000000000010504340141020654 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/concurrent/doc/concurrent.xml0000644006511100651110000000112310111701543023556 0ustar rossross The <literal>concurrent</literal> package: concurrency support <indexterm><primary>Concurrent Haskell</primary></indexterm> The concurrency libraries (and the associated documentation) have moved. See the module Control.Concurrent in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/concurrent/CVar.lhs0000644006511100651110000000256110053156775021477 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995 % \section[ChannelVar]{Channel variables} Channel variables, are one-element channels described in the Concurrent Haskell paper (available from @ftp://ftp.dcs.gla.ac.uk/pub/glasgow-fp/drafts@) \begin{code} module CVar {-# DEPRECATED "MVar now provides the functionality of CVar" #-} ( -- abstract CVar , newCVar -- :: IO (CVar a) , writeCVar -- :: CVar a -> a -> IO () , readCVar -- :: CVar a -> IO a ) where import Control.Concurrent.MVar \end{code} @MVars@ provide the basic mechanisms for synchronising access to a shared resource. @CVars@, or channel variables, provide an abstraction that guarantee that the producer is not allowed to run riot, but enforces the interleaved access to the channel variable,i.e., a producer is forced to wait up for a consumer to remove the previous value before it can deposit a new one in the @CVar@. \begin{code} data CVar a = CVar (MVar a) -- prod -> cons (MVar ()) -- cons -> prod newCVar :: IO (CVar a) newCVar = newEmptyMVar >>= \ datum -> newMVar () >>= \ ack -> return (CVar datum ack) writeCVar :: CVar a -> a -> IO () writeCVar (CVar datum ack) val = takeMVar ack >> putMVar datum val >> return () readCVar :: CVar a -> IO a readCVar (CVar datum ack) = takeMVar datum >>= \ val -> putMVar ack () >> return val \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/Chan.lhs0000644006511100651110000000025610053156775021514 0ustar rossross\begin{code} module Chan {-# DEPRECATED "Chan has moved to Control.Concurrent.Chan" #-} (module Control.Concurrent.Chan) where import Control.Concurrent.Chan \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/Channel.lhs0000644006511100651110000000026410053156775022212 0ustar rossross\begin{code} module Channel {-# DEPRECATED "Channel has moved to Control.Concurrent.Chan" #-} (module Control.Concurrent.Chan) where import Control.Concurrent.Chan \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/ChannelVar.lhs0000644006511100651110000000022010053156775022653 0ustar rossross\begin{code} module ChannelVar {-# DEPRECATED "MVar now provides the functionality of CVar" #-} (module CVar) where import CVar \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/Concurrent.lhs0000644006511100651110000000025310053156775022762 0ustar rossross\begin{code} module Concurrent {-# DEPRECATED "Concurrent has moved to Control.Concurrent" #-} (module Control.Concurrent) where import Control.Concurrent \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/MVar.lhs0000644006511100651110000000025610053156775021510 0ustar rossross\begin{code} module MVar {-# DEPRECATED "MVar has moved to Control.Concurrent.MVar" #-} (module Control.Concurrent.MVar) where import Control.Concurrent.MVar \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/Makefile0000644006511100651110000000031210151654046021555 0ustar rossross# $Id: Makefile,v 1.11 2004/11/26 16:21:58 simonmar Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk PACKAGE = concurrent VERSION = 1.0 SRC_HC_OPTS += -fglasgow-exts -cpp include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/concurrent/Merge.lhs0000644006511100651110000000030510053156775021675 0ustar rossross\begin{code} module Merge {-# DEPRECATED "mergeIO and nmergeIO have moved to Control.Concurrent" #-} (module Control.Concurrent) where import Control.Concurrent (mergeIO, nmergeIO) \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/Parallel.lhs0000644006511100651110000000024110053156775022371 0ustar rossross\begin{code} module Parallel {-# DEPRECATED "Parallel has moved to Control.Parallel" #-} (module Control.Parallel) where import Control.Parallel \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/QSem.lhs0000644006511100651110000000025610053156775021510 0ustar rossross\begin{code} module QSem {-# DEPRECATED "QSem has moved to Control.Concurrent.QSem" #-} (module Control.Concurrent.QSem) where import Control.Concurrent.QSem \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/QSemN.lhs0000644006511100651110000000026310053156775021624 0ustar rossross\begin{code} module QSemN {-# DEPRECATED "QSemN has moved to Control.Concurrent.QSemN" #-} (module Control.Concurrent.QSemN) where import Control.Concurrent.QSemN \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/SampleVar.lhs0000644006511100651110000000030710053156776022533 0ustar rossross\begin{code} module SampleVar {-# DEPRECATED "SampleVar has moved to Control.Concurrent.SampleVar" #-} (module Control.Concurrent.SampleVar) where import Control.Concurrent.SampleVar \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/Semaphore.lhs0000644006511100651110000000041110053156776022560 0ustar rossross\begin{code} module Semaphore {-# DEPRECATED "See Control.Concurrent.QSem, Control.Concurrent.QSemN" #-} ( module Control.Concurrent.QSem, module Control.Concurrent.QSemN ) where import Control.Concurrent.QSem import Control.Concurrent.QSemN \end{code} hugs98-plus-Sep2006/fptools/hslibs/concurrent/Strategies.lhs0000644006511100651110000007601510053156776022764 0ustar rossrossTime-stamp: <2004-05-20 17:32:01 simonmar> $Id: Strategies.lhs,v 1.6 2004/05/20 16:34:06 simonmar Exp $ This module defines parallel strategy combinators Phil Trinder, Hans-Wolfgang Loidl, Kevin Hammond et al. Based on Version VII (1/5/96) `Strategies96' of type a -> () Author: $Author: simonmar $ Date: $Date: 2004/05/20 16:34:06 $ Revision: $Revision: 1.6 $ Source: $Source: /cvs/fptools/hslibs/concurrent/Strategies.lhs,v $ State: $State: Exp $ This module defines evaluation strategies for controlling the parallel evaluation of non-strict programs. They provide a clean separation between algorithmic and behavioural code. The functions described here, and their use is documented in "Algorithm + Strategy = Parallelism", P.W. Trinder, K. Hammond, H-W. Loidl, S.L. Peyton Jones In Journal of Functional Programming 8(1):23--60, January 1998. URL: http://www.cee.hw.ac.uk/~dsg/gph/papers/ps/strategies.ps.gz This module supports Haskell 1.2, Haskell 1.4 and Haskell98. The distinction is made based on the __HASKELL1__ CPP variable. Parts of the module could be rewritten using constructor classes. ----------------------------------------------------------------------------- The history of the Strategies module: Changelog: $Log: Strategies.lhs,v $ Revision 1.6 2004/05/20 16:34:06 simonmar Deprecations Revision 1.5 2002/10/08 17:54:15 panne Reduce inter-package dependencies a bit by relying on base package directly. Revision 1.4 2001/10/12 20:03:30 sof tidy up Revision 1.3 2001/03/22 03:51:12 hwloidl -*- outline -*- Time-stamp: This commit covers changes in GHC to get GUM (way=mp) and GUM/GdH (way=md) working. It is a merge of my working version of GUM, based on GHC 4.06, with GHC 4.11. Almost all changes are in the RTS (see below). GUM is reasonably stable, we used the 4.06 version in large-ish programs for recent papers. Couple of things I want to change, but nothing urgent. GUM/GdH has just been merged and needs more testing. Hope to do that in the next weeks. It works in our working build but needs tweaking to run. GranSim doesn't work yet (*sigh*). Most of the code should be in, but needs more debugging. ToDo: I still want to make the following minor modifications before the release - Better wrapper skript for parallel execution [ghc/compiler/main] - Update parallel docu: started on it but it's minimal [ghc/docs/users_guide] - Clean up [nofib/parallel]: it's a real mess right now (*sigh*) - Update visualisation tools (minor things only IIRC) [ghc/utils/parallel] - Add a Klingon-English glossary * RTS: Almost all changes are restricted to ghc/rts/parallel and should not interfere with the rest. I only comment on changes outside the parallel dir: - Several changes in Schedule.c (scheduling loop; createThreads etc); should only affect parallel code - Added ghc/rts/hooks/ShutdownEachPEHook.c - ghc/rts/Linker.[ch]: GUM doesn't know about Stable Names (ifdefs)!! - StgMiscClosures.h: END_TSO_QUEUE etc now defined here (from StgMiscClosures.hc) END_ECAF_LIST was missing a leading stg_ - SchedAPI.h: taskStart now defined in here; it's only a wrapper around scheduleThread now, but might use some init, shutdown later - RtsAPI.h: I have nuked the def of rts_evalNothing * Compiler: - ghc/compiler/main/DriverState.hs added PVM-ish flags to the parallel way added new ways for parallel ticky profiling and distributed exec - ghc/compiler/main/DriverPipeline.hs added a fct run_phase_MoveBinary which is called with way=mp after linking; it moves the bin file into a PVM dir and produces a wrapper script for parallel execution maybe cleaner to add a MoveBinary phase in DriverPhases.hs but this way it's less intrusive and MoveBinary makes probably only sense for mp anyway * Nofib: - nofib/spectral/Makefile, nofib/real/Makefile, ghc/tests/programs/Makefile: modified to skip some tests if HWL_NOFIB_HACK is set; only tmp to record which test prgs cause problems in my working build right now Revision 1.2 2000/11/18 02:13:11 hwloidl Now provides explicit def of seq (rather than just re-exporting). Required by the current version of the compiler. Revision 1.1 2000/01/14 13:34:32 hwloidl Module for specifying (parallel) behavioural code. Revision 1.9 1997/10/01 00:27:19 hwloidl Type of par and seq changed to Done -> Done -> Done with Done = () Works for Haskell 1.2 as well as Haskell 1.4 (checks the CPP variable __HASKELL1__ to distinguish setups). Fixed precedences for par and seq for Haskell 1.4 (stronger than using). New infix operators >| and >|| as aliases for par and seq as strategy combinators. Revision 1.8 1997/05/20 21:13:22 hwloidl Revised to use `demanding` and `sparking` (final JFP paper version) Revision 1.7 1997/04/02 21:26:21 hwloidl Minor changes in documentation, none in the code. revision 1.5 Version VII.1; Strategies96; Type: a -> () Minor changes to previous version. CPP flags now separate GUM from GranSim version. Infix declaration for `using` (important for e.g. quicksort where the old version puts parentheses in the wrong way). Moer instances for NFData and markStartegies (in GranSim setup only). revision 1.4 Version VII; Strategies96; Type: a -> () The type has changed again; with the old type it's not possible to describe all the strategies we want (for example seqPair r0 rnf which should not evaluate the first component of the pair at all). The () type acts as info that the strategy has been applied. The function `using` is used as inverse strategy application i.e. on top level we usually have something like res `using` strat where ... The markStrategy hack is included in this version: it attaches an Int value to the currently running strategy (this can be inherited by all sub-strats) It doesn't model the jumps between evaluating producer and consumer properly (for that something like cost centers would be necessary). revision 1.3 Version VI (V-based); Strategies95; Type: a -> a Now uses library modules like FiniteMap with strategies in there. CPP flags for using the same module with GUM and GranSim. A few new strategies. revision 1.2 Version V; Strategies95; Type: a -> a The type of Strategies has changed from a -> () to a -> a All strategies and instances of NFData have been redefined accordingly. This branch started off after discussions between PWT, SLPJ and HWL in mid Nov (start of development of the actual module: 10/1/96) revision 1.1 Initial revision ----------------------------------------------------------------------------- -- To use fakeinfo first replace all %%$ by \@ -- If you have fakeinfo makers in the file you need a slightly modified -- version of the lit-deatify script (called by lit2pgm). You get that -- version on Suns and Alphas in Glasgow by using -- \tr{lit2pgm -H "${HOME}/bin/`hw_os`"} -- in your Makefile ----------------------------------------------------------------------------- --@node Evaluation Strategies, , , --@chapter Evaluation Strategies --@menu --* Imports and infix declarations:: --* Strategy Type and Application:: --* Basic Strategies:: --* Strategic Function Application:: --* Marking a Strategy:: --* Strategy Instances:: --* Lolita-specific Strategies:: --@end menu --@node Imports and infix declarations, Strategy Type and Application, Evaluation Strategies, Evaluation Strategies --@section Imports and infix declarations > module Strategies {-# DEPRECATED "Strategies has moved to Control.Parallel.Strategies" #-} ( >#if (__HASKELL1__>=4) > module Strategies, > module Parallel >#else > Strategies.. >#endif > ) where > >#if defined(GRAN) && !(__HASKELL1__>=4) > import PreludeGlaST -- only needed for markStrat >#endif >#if (__HASKELL1__>=4) <> import Prelude hiding (seq) <> import qualified Parallel > import Parallel >#else > import Parallel renaming (par to par_from_Parallel, seq to seq_from_Parallel) >#endif >#if (__HASKELL1__>=4) > import Data.Ix > import Data.Array >#endif >#if defined(PAR_GRAN_LIST) > import QSort -- tmp (only for parGranList) >#endif I lifted the precedence of @par@ and @seq@ by one level to make @using@ the combinator with the weakest precedence. Oooops, there seems to be a bug in ghc 0.29 prohibiting another infix declaration of @par@ and @seq@ despite renaming the imported versions. >#if (__HASKELL1__>=4) <> infixr 2 `par` -- was: 0 <> infixr 3 `seq` -- was: 1 >#else > infixr 0 `par` -- was: 0 > infixr 1 `seq` -- was: 1 >#endif > infixl 0 `using`,`demanding`,`sparking` -- weakest precedence! > infixr 2 >|| -- another name for par > infixr 3 >| -- another name for seq > infixl 6 $||, $| -- strategic function application (seq and par) > infixl 9 .|, .||, -|, -|| -- strategic (inverse) function composition > strategy_version :: String > strategy_version = "$Revision: 1.6 $" > > strategy_id :: String > strategy_id = "$Id: Strategies.lhs,v 1.6 2004/05/20 16:34:06 simonmar Exp $" ------------------------------------------------------------------------------ Strategy Type, Application and Semantics ------------------------------------------------------------------------------ --@node Strategy Type and Application, Basic Strategies, Imports and infix declarations, Evaluation Strategies --@section Strategy Type and Application --@cindex Strategy > type Done = () > type Strategy a = a -> Done A strategy takes a value and returns a dummy `done' value to indicate that the specifed evaluation has been performed. The basic combinators for strategies are @par@ and @seq@ but with types that indicate that they only combine the results of a strategy application. NB: This version can be used with Haskell 1.4 (GHC 2.05 and beyond), *but* you won't get strategy checking on seq (only on par)! The infix fcts >| and >|| are alternative names for `seq` and `par`. With the introduction of a Prelude function `seq` separating the Prelude function from the Strategy function becomes a pain. The notation also matches the notation for strategic function application. --@cindex par --@cindex seq --@cindex >| --@cindex >|| >#if (__HASKELL1__>=4) par and seq have the same types as before; >| and >|| are more specific and can only be used when composing strategies. <> par :: Done -> Done -> Done <> par = Parallel.par <> seq :: a -> b -> b -- that's the real type of seq defined in Prelude <> seq = Parallel.seq > (>|), (>||) :: Done -> Done -> Done > {-# INLINE (>|) #-} > {-# INLINE (>||) #-} > (>|) = Prelude.seq > (>||) = Parallel.par >#else > par, seq, (>|), (>||) :: Done -> Done -> Done > par = par_from_Parallel > seq = seq_from_Parallel > {-# INLINE (>|) #-} > {-# INLINE (>||) #-} > (>|) = seq > (>||) = par >#endif --@cindex using > using :: a -> Strategy a -> a >#if (__HASKELL1__>=4) > using x s = s x `seq` x >#else > using x s = s x `seq_from_Parallel` x >#endif using takes a strategy and a value, and applies the strategy to the value before returning the value. Used to express data-oriented parallelism x `using` s is a projection on x, i.e. both a retraction: x `using` s [ x - and idempotent: (x `using` s) `using` s = x `using` s demanding and sparking are used to express control-oriented parallelism. Their second argument is usually a sequence of strategy applications combined `par` and `seq`. Sparking should only be used with a singleton sequence as it is not necessarily excuted --@cindex demanding --@cindex sparking > demanding, sparking :: a -> Done -> a >#if (__HASKELL1__>=4) > demanding = flip Parallel.seq > sparking = flip Parallel.par >#else > demanding = flip seq_from_Parallel > sparking = flip par_from_Parallel >#endif sPar and sSeq have been superceded by sparking and demanding: replace e `using` sPar x with e `sparking` x e `using` sSeq x with e `demanding` x e `using` sPar x < <> sPar :: a -> Strategy b <> sPar x y = x `par` () < e `using` sSeq x < <> sSeq :: a -> Strategy b <> sSeq x y = x `seq` () ----------------------------------------------------------------------------- Basic Strategies ----------------------------------------------------------------------------- --@node Basic Strategies, Strategic Function Application, Strategy Type and Application, Evaluation Strategies --@section Basic Strategies r0 performs *no* evaluation on its argument. --@cindex r0 > r0 :: Strategy a > r0 _ = () rwhnf reduces its argument to weak head normal form. --@cindex rwhnf --@cindex rnf --@cindex NFData >#if defined(__HASKELL98__) > rwhnf :: Strategy a > rwhnf x = x `seq` () >#elif (__HASKELL1__==4) > rwhnf :: Eval a => Strategy a > rwhnf x = x `seq` () >#else > rwhnf :: Strategy a > rwhnf x = x `seq_from_Parallel` () >#endif >#if defined(__HASKELL98__) > class NFData a where >#elif (__HASKELL1__>=4) > class Eval a => NFData a where >#else > class NFData a where >#endif > -- rnf reduces its argument to (head) normal form > rnf :: Strategy a > -- Default method. Useful for base types. A specific method is necessay for > -- constructed types > rnf = rwhnf > > class (NFData a, Integral a) => NFDataIntegral a > class (NFData a, Ord a) => NFDataOrd a ------------------------------------------------------------------------------ Strategic Function Application ------------------------------------------------------------------------------ --@node Strategic Function Application, Marking a Strategy, Basic Strategies, Evaluation Strategies --@section Strategic Function Application The two infix functions @$|@ and @$||@ perform sequential and parallel function application, respectively. They are parameterised with a strategy that is applied to the argument of the function application. This is very handy when writing pipeline parallelism as a sequence of @$@, @$|@ and @$||@'s. There is no need of naming intermediate values in this case. The separation of algorithm from strategy is achieved by allowing strategies only as second arguments to @$|@ and @$||@. --@cindex $| --@cindex $|| > ($|), ($||) :: (a -> b) -> Strategy a -> a -> b <> f $| s = \ x -> f x `using` \ _ -> s x `seq` () <> f $|| s = \ x -> f x `using` \ _ -> s x `par` () > f $| s = \ x -> f x `demanding` s x > f $|| s = \ x -> f x `sparking` s x The same thing for function composition (.| and .||) and inverse function composition (-| and -||) for those who read their programs from left to right. --@cindex .| --@cindex .|| --@cindex -| --@cindex -|| > (.|), (.||) :: (b -> c) -> Strategy b -> (a -> b) -> (a -> c) > (-|), (-||) :: (a -> b) -> Strategy b -> (b -> c) -> (a -> c) > (.|) f s g = \ x -> let gx = g x > in f gx `demanding` s gx > (.||) f s g = \ x -> let gx = g x > in f gx `sparking` s gx > (-|) f s g = \ x -> let fx = f x > in g fx `demanding` s fx > (-||) f s g = \ x -> let fx = f x > in g fx `sparking` s fx ------------------------------------------------------------------------------ Marking a Strategy ------------------------------------------------------------------------------ --@node Marking a Strategy, Strategy Instances, Strategic Function Application, Evaluation Strategies --@section Marking a Strategy Marking a strategy. Actually, @markStrat@ sticks a label @n@ into the sparkname field of the thread executing strategy @s@. Together with a runtime-system that supports propagation of sparknames to the children this means that this strategy and all its children have the sparkname @n@ (if the static sparkname field in the @parGlobal@ annotation contains the value 1). Note, that the @SN@ field of starting the marked strategy itself contains the sparkname of the parent thread. The END event contains @n@ as sparkname. --@cindex markStrat >#if defined(GRAN) && !(__HASKELL1__>=4) > markStrat :: Int -> Strategy a -> Strategy a > markStrat n s x = unsafePerformPrimIO ( > _casm_ ``%r = set_sparkname(CurrentTSO, %0);'' n `thenPrimIO` \ z -> > returnPrimIO (s x)) >#endif ----------------------------------------------------------------------------- Strategy Instances and Functions ----------------------------------------------------------------------------- --@node Strategy Instances, Lolita-specific Strategies, Marking a Strategy, Evaluation Strategies --@section Strategy Instances ----------------------------------------------------------------------------- Tuples ----------------------------------------------------------------------------- --@menu --* Tuples:: --* Numbers:: --* Characters:: --* Booleans:: --* Unit:: --* Lists:: --* Arrays:: --@end menu --@node Tuples, Numbers, Strategy Instances, Strategy Instances --@subsection Tuples We currently support up to 9-tuples. If you need longer tuples you have to add the instance explicitly to your program. > instance (NFData a, NFData b) => NFData (a,b) where > rnf (x,y) = rnf x `seq` rnf y > instance (NFData a, NFData b, NFData c) => NFData (a,b,c) where > rnf (x,y,z) = rnf x `seq` rnf y `seq` rnf z > instance (NFData a, NFData b, NFData c, NFData d) => NFData (a,b,c,d) where > rnf (x1,x2,x3,x4) = rnf x1 `seq` > rnf x2 `seq` > rnf x3 `seq` > rnf x4 > -- code automatically inserted by `hwl-insert-NFData-n-tuple' > instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5) => > NFData (a1, a2, a3, a4, a5) where > rnf (x1, x2, x3, x4, x5) = > rnf x1 `seq` > rnf x2 `seq` > rnf x3 `seq` > rnf x4 `seq` > rnf x5 > -- code automatically inserted by `hwl-insert-NFData-n-tuple' > instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6) => > NFData (a1, a2, a3, a4, a5, a6) where > rnf (x1, x2, x3, x4, x5, x6) = > rnf x1 `seq` > rnf x2 `seq` > rnf x3 `seq` > rnf x4 `seq` > rnf x5 `seq` > rnf x6 > -- code automatically inserted by `hwl-insert-NFData-n-tuple' > instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7) => > NFData (a1, a2, a3, a4, a5, a6, a7) where > rnf (x1, x2, x3, x4, x5, x6, x7) = > rnf x1 `seq` > rnf x2 `seq` > rnf x3 `seq` > rnf x4 `seq` > rnf x5 `seq` > rnf x6 `seq` > rnf x7 > -- code automatically inserted by `hwl-insert-NFData-n-tuple' > instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8) => > NFData (a1, a2, a3, a4, a5, a6, a7, a8) where > rnf (x1, x2, x3, x4, x5, x6, x7, x8) = > rnf x1 `seq` > rnf x2 `seq` > rnf x3 `seq` > rnf x4 `seq` > rnf x5 `seq` > rnf x6 `seq` > rnf x7 `seq` > rnf x8 > -- code automatically inserted by `hwl-insert-NFData-n-tuple' > instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8, NFData a9) => > NFData (a1, a2, a3, a4, a5, a6, a7, a8, a9) where > rnf (x1, x2, x3, x4, x5, x6, x7, x8, x9) = > rnf x1 `seq` > rnf x2 `seq` > rnf x3 `seq` > rnf x4 `seq` > rnf x5 `seq` > rnf x6 `seq` > rnf x7 `seq` > rnf x8 `seq` > rnf x9 --@cindex seqPair > seqPair :: Strategy a -> Strategy b -> Strategy (a,b) > seqPair strata stratb (x,y) = strata x `seq` stratb y --@cindex parPair > parPair :: Strategy a -> Strategy b -> Strategy (a,b) > parPair strata stratb (x,y) = strata x `par` stratb y `par` () The reason for the second `par` is so that the strategy terminates quickly. This is important if the strategy is used as the 1st argument of a seq --@cindex seqTriple > seqTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c) > seqTriple strata stratb stratc (x,y,z) = > strata x `seq` > stratb y `seq` > stratc z --@cindex parTriple > parTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c) > parTriple strata stratb stratc (x,y,z) = > strata x `par` > stratb y `par` > stratc z `par` > () ----------------------------------------------------------------------------- Numbers ----------------------------------------------------------------------------- --@node Numbers, Characters, Tuples, Strategy Instances --@subsection Numbers Weak head normal form and normal form are identical for integers, so the default rnf is sufficient. > instance NFData Int > instance NFData Integer > instance NFData Float > instance NFData Double > instance NFDataIntegral Int > instance NFDataOrd Int Rational and complex numbers. >#if !(__HASKELL1__>=4) > instance (NFData a) => NFData (Ratio a) where > rnf (x:%y) = rnf x `seq` > rnf y `seq` > () > instance (NFData a) => NFData (Complex a) where > rnf (x:+y) = rnf x `seq` > rnf y `seq` > () >#endif ----------------------------------------------------------------------------- Characters ----------------------------------------------------------------------------- --@node Characters, Booleans, Numbers, Strategy Instances --@subsection Characters > instance NFData Char ----------------------------------------------------------------------------- Bools ----------------------------------------------------------------------------- --@node Booleans, Unit, Characters, Strategy Instances --@subsection Booleans > instance NFData Bool ----------------------------------------------------------------------------- Unit ----------------------------------------------------------------------------- --@node Unit, Lists, Booleans, Strategy Instances --@subsection Unit > instance NFData () ----------------------------------------------------------------------------- Lists ---------------------------------------------------------------------------- --@node Lists, Arrays, Unit, Strategy Instances --@subsection Lists > instance NFData a => NFData [a] where > rnf [] = () > rnf (x:xs) = rnf x `seq` rnf xs --@menu --* Parallel Strategies for Lists:: --* Sequential Strategies for Lists:: --@end menu ---------------------------------------------------------------------------- Lists: Parallel Strategies ---------------------------------------------------------------------------- --@node Parallel Strategies for Lists, Sequential Strategies for Lists, Lists, Lists --@subsubsection Parallel Strategies for Lists Applies a strategy to every element of a list in parallel --@cindex parList > parList :: Strategy a -> Strategy [a] > parList _strat [] = () > parList strat (x:xs) = strat x `par` (parList strat xs) Applies a strategy to the first n elements of a list in parallel --@cindex parListN > parListN :: (Integral b) => b -> Strategy a -> Strategy [a] > parListN _ _strat [] = () > parListN 0 _strat _xs = () > parListN n strat (x:xs) = strat x `par` (parListN (n-1) strat xs) Evaluates N elements of the spine of the argument list and applies `strat' to the Nth element (if there is one) in parallel with the result. e.g. parListNth 2 [e1, e2, e3] evaluates e2 --@cindex parListNth > parListNth :: Int -> Strategy a -> Strategy [a] > parListNth n strat xs > | null rest = () > | otherwise = strat (head rest) `par` () > where > rest = drop n xs parListChunk sequentially applies a strategy to chunks (sub-sequences) of a list in parallel. Useful to increase grain size --@cindex parListChunk > parListChunk :: Int -> Strategy a -> Strategy [a] > parListChunk _ _strat [] = () > parListChunk n strat xs = seqListN n strat xs `par` > parListChunk n strat (drop n xs) parMap applies a function to each element of the argument list in parallel. The result of the function is evaluated using `strat' --@cindex parMap > parMap :: Strategy b -> (a -> b) -> [a] -> [b] > parMap strat f xs = map f xs `using` parList strat parFlatMap uses parMap to apply a list-valued function to each element of the argument list in parallel. The result of the function is evaluated using `strat' --@cindex parFlatMap > parFlatMap :: Strategy [b] -> (a -> [b]) -> [a] -> [b] > parFlatMap strat f xs = concat (parMap strat f xs) parZipWith zips together two lists with a function z in parallel --@cindex parZipWith > parZipWith :: Strategy c -> (a -> b -> c) -> [a] -> [b] -> [c] > parZipWith strat z as bs = > zipWith z as bs `using` parList strat ---------------------------------------------------------------------------- Lists: Sequential Strategies ---------------------------------------------------------------------------- --@node Sequential Strategies for Lists, , Parallel Strategies for Lists, Lists --@subsubsection Sequential Strategies for Lists Sequentially applies a strategy to each element of a list --@cindex seqList > seqList :: Strategy a -> Strategy [a] > seqList _strat [] = () > seqList strat (x:xs) = strat x `seq` (seqList strat xs) Sequentially applies a strategy to the first n elements of a list --@cindex seqListN > seqListN :: (Integral a) => a -> Strategy b -> Strategy [b] > seqListN _ _strat [] = () > seqListN 0 _strat _xs = () > seqListN n strat (x:xs) = strat x `seq` (seqListN (n-1) strat xs) seqListNth applies a strategy to the Nth element of it's argument (if there is one) before returning the result. e.g. seqListNth 2 [e1, e2, e3] evaluates e2 --@cindex seqListNth >#if (__HASKELL1__>=4) > seqListNth :: Int -> Strategy b -> Strategy [b] >#else > seqListNth :: (Integral a) => a -> Strategy b -> Strategy [b] >#endif > seqListNth n strat xs > | null rest = () > | otherwise = strat (head rest) > where > rest = drop n xs Parallel n-buffer function added for the revised version of the strategies paper. @parBuffer@ supersedes the older @fringeList@. It has the same semantics. --@cindex parBuffer > parBuffer :: Int -> Strategy a -> [a] -> [a] > parBuffer n s xs = > return xs (start n xs) > where > return (a:as) (b:bs) = (a:return as bs) `sparking` s b > return as _ = as > > start _ [] = [] > start 0 bs = bs > start i (b:bs) = start (i-1) bs `sparking` s b fringeList implements a `rolling buffer' of length n, i.e.applies a strategy to the nth element of list when the head is demanded. More precisely: semantics: fringeList n s = id :: [b] -> [b] dynamic behaviour: evalutates the nth element of the list when the head is demanded. The idea is to provide a `rolling buffer' of length n. --@cindex fringeList <> fringeList :: (Integral a) => a -> Strategy b -> [b] -> [b] <> fringeList n strat [] = [] <> fringeList n strat (r:rs) = <> seqListNth n strat rs `par` <> r:fringeList n strat rs ------------------------------------------------------------------------------ Arrays ------------------------------------------------------------------------------ --@node Arrays, , Lists, Strategy Instances --@subsection Arrays > instance (Ix a, NFData a, NFData b) => NFData (Array a b) where > rnf x = rnf (bounds x) `seq` seqList rnf (elems x) `seq` () Apply a strategy to all elements of an array in parallel. This can be done either in sequentially or in parallel (same as with lists, really). > seqArr :: (Ix b) => Strategy a -> Strategy (Array b a) > seqArr s arr = seqList s (elems arr) > parArr :: (Ix b) => Strategy a -> Strategy (Array b a) > parArr s arr = parList s (elems arr) Associations maybe useful even withou mentioning Arrays. See: .../lib/prelude/TyArrays.hs: data Assoc a b = a := b deriving () >#if (__HASKELL1__<4) > instance (NFData a, NFData b) => NFData (Assoc a b) where > rnf (x := y) = rnf x `seq` rnf y `seq` () >#endif ------------------------------------------------------------------------------ Some strategies specific for Lolita ------------------------------------------------------------------------------ --@node Lolita-specific Strategies, Index, Strategy Instances, Evaluation Strategies --@section Lolita-specific Strategies The following is useful in mergePenGroups --@cindex fstPairFstList > fstPairFstList :: (NFData a) => Strategy [(a,b)] > fstPairFstList = seqListN (1::Int) (seqPair rwhnf r0) Some HACKs for Lolita. AFAIK force is just another name for our rnf and sforce is a shortcut (definition here is identical to the one in Force.lhs) > force :: (NFData a) => a -> a > sforce :: (NFData a) => a -> b -> b Same as definition below <> force x = rnf x `seq` x > force = id $| rnf >#if (__HASKELL1__>=4) > sforce x y = force x `seq` y >#else > sforce x y = force x `seq_from_Parallel` y >#endif --@node Bowing-alg specific strategies --@section Bowing-alg specific strategies NB: this strategy currently needs the quicksort implementation from the hbc syslib >#if defined(PAR_GRAN_LIST) > parGranList :: Strategy a -> (a -> Int) -> [a] -> Strategy [a] > parGranList s gran_estim l_in = \ l_out -> > parListByIdx s l_out $ > sortedIdx gran_list (sortLe ( \ (i,_) (j,_) -> i>j) gran_list) > where -- spark list elems of l in the order specified by (i:idxs) > parListByIdx s l [] = () > parListByIdx s l (i:idxs) = parListByIdx s l idxs `sparking` s (l!!i) > -- get the index of y in the list > idx y [] = error "idx: x not in l" > idx y ((x,_):xs) | y==x = 0 > | otherwise = (idx y xs)+1 > -- the `schedule' for sparking: list of indices of sorted input list > sortedIdx l idxs = [ idx x l | (x,_) <- idxs ] > -- add granularity info to elems of the input list > gran_list = map (\ l -> (gran_estim l, l)) l_in >#endif --@node Index, , Lolita-specific Strategies, Evaluation Strategies --@section Index --@index --* $|:: @cindex\s-+$| --* $||:: @cindex\s-+$|| --* -|:: @cindex\s-+-| --* -||:: @cindex\s-+-|| --* .|:: @cindex\s-+.| --* .||:: @cindex\s-+.|| --* NFData:: @cindex\s-+NFData --* Strategy:: @cindex\s-+Strategy --* demanding:: @cindex\s-+demanding --* fringeList:: @cindex\s-+fringeList --* fstPairFstList:: @cindex\s-+fstPairFstList --* markStrat:: @cindex\s-+markStrat --* parBuffer:: @cindex\s-+parBuffer --* parFlatMap:: @cindex\s-+parFlatMap --* parList:: @cindex\s-+parList --* parListChunk:: @cindex\s-+parListChunk --* parListN:: @cindex\s-+parListN --* parListNth:: @cindex\s-+parListNth --* parMap:: @cindex\s-+parMap --* parPair:: @cindex\s-+parPair --* parTriple:: @cindex\s-+parTriple --* parZipWith:: @cindex\s-+parZipWith --* r0:: @cindex\s-+r0 --* rnf:: @cindex\s-+rnf --* rwhnf:: @cindex\s-+rwhnf --* seqList:: @cindex\s-+seqList --* seqListN:: @cindex\s-+seqListN --* seqListNth:: @cindex\s-+seqListNth --* seqPair:: @cindex\s-+seqPair --* seqTriple:: @cindex\s-+seqTriple --* sparking:: @cindex\s-+sparking --* using:: @cindex\s-+using --@end index hugs98-plus-Sep2006/fptools/hslibs/concurrent/package.conf.in0000644006511100651110000000131010205402177022757 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: False exposed-modules: CVar, Chan, Channel, ChannelVar, Concurrent, MVar, Merge, Parallel, QSem, QSemN, SampleVar, Semaphore, Strategies hidden-modules: #ifdef INSTALLING import-dirs: PKG_LIBDIR"/hslibs-imports/concurrent" #else import-dirs: FPTOOLS_TOP_ABS"/hslibs/concurrent" #endif #ifdef INSTALLING library-dirs: PKG_LIBDIR #else library-dirs: FPTOOLS_TOP_ABS"/hslibs/concurrent" #endif hs-libraries: "HSconcurrent" extra-libraries: include-dirs: includes: depends: base hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: haddock-html: hugs98-plus-Sep2006/fptools/hslibs/data/0000755006511100651110000000000010504340141016636 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/data/doc/0000755006511100651110000000000010504340141017403 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/data/doc/Edison.xml0000644006511100651110000000072110111701543021347 0ustar rossross Edison Edison Edison is a complete package of data structures for Haskell. Documentation is available online. hugs98-plus-Sep2006/fptools/hslibs/data/doc/FiniteMap.xml0000644006511100651110000000037610111701544022011 0ustar rossross The <literal>FiniteMap</literal> type This module has moved to Data.FiniteMap in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/data/doc/Set.xml0000644006511100651110000000076110111701544020666 0ustar rossross <literal>Set</literal> Setmodule This module has moved to Data.Set in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/data/doc/data.xml0000644006511100651110000000020010111701544021030 0ustar rossrossThe <literal>data</literal> package: datatypes &edison; &finitemap; &setlib; hugs98-plus-Sep2006/fptools/hslibs/data/FiniteMap.lhs0000644006511100651110000000023210127370674021236 0ustar rossross\begin{code} module FiniteMap {-# DEPRECATED "This module has moved to Data.FiniteMap" #-} (module Data.FiniteMap) where import Data.FiniteMap \end{code} hugs98-plus-Sep2006/fptools/hslibs/data/Makefile0000644006511100651110000000052710151654047020315 0ustar rossross# $Id: Makefile,v 1.11 2004/11/26 16:21:59 simonmar Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk PACKAGE = data VERSION = 1.0 PACKAGE_DEPS = lang util ALL_DIRS = edison edison/Assoc edison/Coll edison/Seq SRC_HC_OPTS += -cpp -fglasgow-exts SRC_HC_OPTS += -fallow-undecidable-instances -funbox-strict-fields include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/data/Set.lhs0000644006511100651110000000020210127370674020112 0ustar rossross\begin{code} module Set {-# DEPRECATED "This module has moved to Data.Set" #-} (module Data.Set) where import Data.Set \end{code} hugs98-plus-Sep2006/fptools/hslibs/data/package.conf.in0000644006511100651110000000254510205402177021521 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: False exposed-modules: FiniteMap, Set, Assoc, AssocDefaults, AssocList, PatriciaLoMap, EdisonPrelude, Collection, CollectionDefaults, CollectionUtils, LazyPairingHeap, LeftistHeap, MinHeap, SkewHeap, SplayHeap, TestOrdBag, TestOrdSet, UnbalancedSet, BankersQueue, BinaryRandList, BraunSeq, JoinList, ListSeq, MyersStack, RandList, RevSeq, Sequence, SequenceDefaults, SimpleQueue, SizedSeq, TestSeq hidden-modules: #ifdef INSTALLING import-dirs: PKG_LIBDIR"/hslibs-imports/data" #else import-dirs: FPTOOLS_TOP_ABS"/hslibs/data" , FPTOOLS_TOP_ABS"/hslibs/data/edison" , FPTOOLS_TOP_ABS"/hslibs/data/edison/Assoc" , FPTOOLS_TOP_ABS"/hslibs/data/edison/Coll" , FPTOOLS_TOP_ABS"/hslibs/data/edison/Seq" #endif #ifdef INSTALLING library-dirs: PKG_LIBDIR #else library-dirs: FPTOOLS_TOP_ABS"/hslibs/data" #endif hs-libraries: "HSdata" extra-libraries: include-dirs: includes: depends: haskell98, lang, util hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: haddock-html: hugs98-plus-Sep2006/fptools/hslibs/data/edison/0000755006511100651110000000000010504340142020120 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/data/edison/Assoc/0000755006511100651110000000000010504340141021167 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/data/edison/Assoc/Assoc.hs0000644006511100651110000001765410130752021022607 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module Assoc {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- associative collections {- -- non-observable classes AssocX(..), OrdAssocX(..), FiniteMapX(..), OrdFiniteMapX(..), -- observable classes Assoc(..), OrdAssoc(..), FiniteMap(..), OrdFiniteMap(..), -- specialize sequence operations to lists fromList, insertList, unionList, deleteList, lookupList, elementsList, unsafeFromOrdList, fromListWith, fromListWithKey, insertListWith, insertListWithKey, unionListWith, toList, keysList, toOrdList, unionListWithKey, -} module Assoc, -- re-export view types from EdisonPrelude for convenience Maybe2(..), Maybe3(..) ) where import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter) import EdisonPrelude(Maybe2(..), Maybe3(..)) import Sequence(Sequence) import ListSeq() -- class (Eq k, Functor (m k)) => AssocX m k class Eq k => AssocX m k where empty :: m k a single :: k -> a -> m k a fromSeq :: Sequence seq => seq (k,a) -> m k a insert :: k -> a -> m k a -> m k a insertSeq :: Sequence seq => seq (k,a) -> m k a -> m k a union :: m k a -> m k a -> m k a unionSeq :: Sequence seq => seq (m k a) -> m k a delete :: k -> m k a -> m k a deleteAll :: k -> m k a -> m k a deleteSeq :: Sequence seq => seq k -> m k a -> m k a null :: m k a -> Bool size :: m k a -> Int member :: m k a -> k -> Bool count :: m k a -> k -> Int lookup :: m k a -> k -> a lookupM :: m k a -> k -> Maybe a lookupAll :: Sequence seq => m k a -> k -> seq a lookupWithDefault :: a -> m k a -> k -> a adjust :: (a -> a) -> k -> m k a -> m k a adjustAll :: (a -> a) -> k -> m k a -> m k a -- only because can't yet put Functor as superclass map :: (a -> b) -> m k a -> m k b fold :: (a -> b -> b) -> b -> m k a -> b fold1 :: (a -> a -> a) -> m k a -> a filter :: (a -> Bool) -> m k a -> m k a partition :: (a -> Bool) -> m k a -> (m k a, m k a) elements :: Sequence seq => m k a -> seq a instanceName :: m k a -> String class (AssocX m k, Ord k) => OrdAssocX m k where minView :: m k a -> Maybe2 a (m k a) minElem :: m k a -> a deleteMin :: m k a -> m k a unsafeInsertMin :: k -> a -> m k a -> m k a maxView :: m k a -> Maybe2 (m k a) a maxElem :: m k a -> a deleteMax :: m k a -> m k a unsafeInsertMax :: m k a -> k -> a -> m k a foldr :: (a -> b -> b) -> b -> m k a -> b foldl :: (b -> a -> b) -> b -> m k a -> b foldr1 :: (a -> a -> a) -> m k a -> m k a foldl1 :: (a -> a -> a) -> m k a -> m k a unsafeFromOrdSeq :: Sequence seq => seq (k,a) -> m k a unsafeAppend :: m k a -> m k a -> m k a filterLT :: k -> m k a -> m k a filterLE :: k -> m k a -> m k a filterGT :: k -> m k a -> m k a filterGE :: k -> m k a -> m k a partitionLT_GE :: k -> m k a -> (m k a, m k a) partitionLE_GT :: k -> m k a -> (m k a, m k a) partitionLT_GT :: k -> m k a -> (m k a, m k a) class AssocX m k => FiniteMapX m k where fromSeqWith :: Sequence seq => (a -> a -> a) -> seq (k,a) -> m k a fromSeqWithKey :: Sequence seq => (k -> a -> a -> a) -> seq (k,a) -> m k a insertWith :: (a -> a -> a) -> k -> a -> m k a -> m k a insertWithKey :: (k -> a -> a -> a) -> k -> a -> m k a -> m k a insertSeqWith :: Sequence seq => (a -> a -> a) -> seq (k,a) -> m k a -> m k a insertSeqWithKey :: Sequence seq => (k -> a -> a -> a) -> seq (k,a) -> m k a -> m k a unionl :: m k a -> m k a -> m k a unionr :: m k a -> m k a -> m k a unionWith :: (a -> a -> a) -> m k a -> m k a -> m k a unionSeqWith :: Sequence seq => (a -> a -> a) -> seq (m k a) -> m k a intersectWith :: (a -> b -> c) -> m k a -> m k b -> m k c difference :: m k a -> m k b -> m k a subset :: m k a -> m k b -> Bool subsetEq :: m k a -> m k b -> Bool class (OrdAssocX m k, FiniteMapX m k) => OrdFiniteMapX m k -- no methods? class AssocX m k => Assoc m k where toSeq :: Sequence seq => m k a -> seq (k,a) keys :: Sequence seq => m k a -> seq k mapWithKey :: (k -> a -> b) -> m k a -> m k b foldWithKey :: (k -> a -> b -> b) -> b -> m k a -> b filterWithKey :: (k -> a -> Bool) -> m k a -> m k a partitionWithKey :: (k -> a -> Bool) -> m k a -> (m k a, m k a) class (Assoc m k, OrdAssocX m k) => OrdAssoc m k where minViewWithKey :: m k a -> Maybe3 k a (m k a) minElemWithKey :: m k a -> (k,a) maxViewWithKey :: m k a -> Maybe3 (m k a) k a maxElemWithKey :: m k a -> (k,a) foldrWithKey :: (k -> a -> b -> b) -> b -> m k a -> b foldlWithKey :: (b -> k -> a -> b) -> b -> m k a -> b toOrdSeq :: Sequence seq => m k a -> seq (k,a) class (Assoc m k, FiniteMapX m k) => FiniteMap m k where unionWithKey :: (k -> a -> a -> a) -> m k a -> m k a -> m k a unionSeqWithKey :: Sequence seq => (k -> a -> a -> a) -> seq (m k a) -> m k a intersectWithKey :: (k -> a -> b -> c) -> m k a -> m k b -> m k c class (OrdAssoc m k, FiniteMap m k) => OrdFiniteMap m k -- no methods -- specialize sequence operations to lists fromList :: AssocX m k => [(k,a)] -> m k a insertList :: AssocX m k => [(k,a)] -> m k a -> m k a unionList :: AssocX m k => [m k a] -> m k a deleteList :: AssocX m k => [k] -> m k a -> m k a lookupList :: AssocX m k => m k a -> k -> [a] elementsList :: AssocX m k => m k a -> [a] unsafeFromOrdList :: OrdAssocX m k => [(k,a)] -> m k a fromListWith :: FiniteMapX m k => (a -> a -> a) -> [(k,a)] -> m k a fromListWithKey :: FiniteMapX m k => (k -> a -> a -> a) -> [(k,a)] -> m k a insertListWith :: FiniteMapX m k => (a -> a -> a) -> [(k,a)] -> m k a -> m k a insertListWithKey :: FiniteMapX m k => (k -> a -> a -> a) -> [(k,a)] -> m k a -> m k a unionListWith :: FiniteMapX m k => (a -> a -> a) -> [m k a] -> m k a toList :: Assoc m k => m k a -> [(k,a)] keysList :: Assoc m k => m k a -> [k] toOrdList :: OrdAssoc m k => m k a -> [(k,a)] unionListWithKey :: FiniteMap m k => (k -> a -> a -> a) -> [m k a] -> m k a fromList = fromSeq insertList = insertSeq unionList = unionSeq deleteList = deleteSeq lookupList = lookupAll elementsList = elements unsafeFromOrdList = unsafeFromOrdSeq fromListWith = fromSeqWith fromListWithKey = fromSeqWithKey insertListWith = insertSeqWith insertListWithKey = insertSeqWithKey unionListWith = unionSeqWith toList = toSeq keysList = keys toOrdList = toOrdSeq unionListWithKey = unionSeqWithKey {- Leave out until somebody asks for: witness???? compose???? nub :: m k a -> m k a -- ??? nubWith :: (a -> a -> a) -> m k a -> m k a nubWithKey :: (k -> a -> a -> a) -> m k a -> m k a group :: m k a -> m k [a] -- ??? ????? unsafeMapMonotonim k :: (a -> a) -> m k a -> m k a -- adjustPartial??? (adjustOrDelete???) -- adjustAll :: (a -> a) -> k -> m k a -> m k a -- unionMap??? -- mapPartial??? anyViewKey :: m k a -> Maybe3 k a (m k a) anyKeyElem :: m k a -> (k,a) -- signals error if collection is empty deleteAny :: m k a -> m k a -- could go in AssocX but no point -- anyKeyElem and deleteAny must be consistent -- do they need to be consistent with anyView? -- unionMap??? -- mapPartial??? deleteAllList :: [k] -> m k a -> m k a disjoint :: m k a -> m k b -> Bool -} hugs98-plus-Sep2006/fptools/hslibs/data/edison/Assoc/AssocDefaults.hs0000644006511100651110000001216410130752021024266 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module AssocDefaults {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} where import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter) import Assoc import qualified Sequence as S -- import qualified ListSeq as L fromSeqUsingInsertSeq :: (AssocX m k,S.Sequence seq) => seq (k,a) -> m k a fromSeqUsingInsertSeq kvs = insertSeq kvs empty insertSeqUsingFoldr :: (AssocX m k,S.Sequence seq) => seq (k,a) -> m k a -> m k a insertSeqUsingFoldr kvs m = S.foldr (uncurry insert) m kvs unionSeqUsingReduce :: (AssocX m k,S.Sequence seq) => seq (m k a) -> m k a unionSeqUsingReduce ms = S.reducel union empty ms deleteSeqUsingFoldr :: (AssocX m k,S.Sequence seq) => seq k -> m k a -> m k a deleteSeqUsingFoldr ks m = S.foldr delete m ks countUsingMember :: AssocX m k => m k a -> k -> Int countUsingMember m k = if member m k then 1 else 0 lookupAllUsingLookupM :: (AssocX m k,S.Sequence seq) => m k a -> k -> seq a lookupAllUsingLookupM m k = case lookupM m k of Just x -> S.single x Nothing -> S.empty lookupWithDefaultUsingLookupM :: AssocX m k => a -> m k a -> k -> a lookupWithDefaultUsingLookupM d m k = case lookupM m k of Just x -> x Nothing -> d partitionUsingFilter :: AssocX m k => (a -> Bool) -> m k a -> (m k a,m k a) partitionUsingFilter f m = (filter f m, filter (not . f) m) elementsUsingFold :: (AssocX m k,S.Sequence seq) => m k a -> seq a elementsUsingFold = fold S.cons S.empty insertWithUsingLookupM :: FiniteMapX m k => (a -> a -> a) -> k -> a -> m k a -> m k a insertWithUsingLookupM f k x m = case lookupM m k of Nothing -> insert k x m Just y -> insert k (f x y) m fromSeqWithUsingInsertSeqWith :: (FiniteMapX m k,S.Sequence seq) => (a -> a -> a) -> seq (k,a) -> m k a fromSeqWithUsingInsertSeqWith f kvs = insertSeqWith f kvs empty fromSeqWithKeyUsingInsertSeqWithKey :: (FiniteMapX m k,S.Sequence seq) => (k -> a -> a -> a) -> seq (k,a) -> m k a fromSeqWithKeyUsingInsertSeqWithKey f kvs = insertSeqWithKey f kvs empty insertWithKeyUsingInsertWith :: FiniteMapX m k => (k -> a -> a -> a) -> k -> a -> m k a -> m k a insertWithKeyUsingInsertWith f k = insertWith (f k) k insertSeqWithUsingInsertWith :: (FiniteMapX m k,S.Sequence seq) => (a -> a -> a) -> seq (k,a) -> m k a -> m k a insertSeqWithUsingInsertWith f kvs m = S.foldr (uncurry (insertWith f)) m kvs insertSeqWithKeyUsingInsertWithKey :: (FiniteMapX m k,S.Sequence seq) => (k -> a -> a -> a) -> seq (k,a) -> m k a -> m k a insertSeqWithKeyUsingInsertWithKey f kvs m = S.foldr (uncurry (insertWithKey f)) m kvs unionSeqWithUsingReduce :: (FiniteMapX m k,S.Sequence seq) => (a -> a -> a) -> seq (m k a) -> m k a unionSeqWithUsingReduce f ms = S.reducel (unionWith f) empty ms unionSeqWithUsingFoldr :: (FiniteMapX m k,S.Sequence seq) => (a -> a -> a) -> seq (m k a) -> m k a unionSeqWithUsingFoldr f ms = S.foldr (unionWith f) empty ms toSeqUsingFoldWithKey :: (Assoc m k,S.Sequence seq) => m k a -> seq (k,a) toSeqUsingFoldWithKey = foldWithKey conspair S.empty where conspair k v kvs = S.cons (k,v) kvs keysUsingFoldWithKey :: (Assoc m k,S.Sequence seq) => m k a -> seq k keysUsingFoldWithKey = foldWithKey conskey S.empty where conskey k v ks = S.cons k ks unionWithUsingInsertWith :: FiniteMap m k => (a -> a -> a) -> m k a -> m k a -> m k a unionWithUsingInsertWith f m1 m2 = foldWithKey (insertWith f) m2 m1 unionWithKeyUsingInsertWithKey :: FiniteMap m k => (k -> a -> a -> a) -> m k a -> m k a -> m k a unionWithKeyUsingInsertWithKey f m1 m2 = foldWithKey (insertWithKey f) m2 m1 unionSeqWithKeyUsingReduce :: (FiniteMap m k,S.Sequence seq) => (k -> a -> a -> a) -> seq (m k a) -> m k a unionSeqWithKeyUsingReduce f ms = S.reducel (unionWithKey f) empty ms unionSeqWithKeyUsingFoldr :: (FiniteMap m k,S.Sequence seq) => (k -> a -> a -> a) -> seq (m k a) -> m k a unionSeqWithKeyUsingFoldr f ms = S.foldr (unionWithKey f) empty ms intersectWithUsingLookupM :: FiniteMap m k => (a -> b -> c) -> m k a -> m k b -> m k c intersectWithUsingLookupM f m1 m2 = foldWithKey ins empty m1 where ins k x m = case lookupM m2 k of Nothing -> m Just y -> insert k (f x y) m intersectWithKeyUsingLookupM :: FiniteMap m k => (k -> a -> b -> c) -> m k a -> m k b -> m k c intersectWithKeyUsingLookupM f m1 m2 = foldWithKey ins empty m1 where ins k x m = case lookupM m2 k of Nothing -> m Just y -> insert k (f k x y) m differenceUsingDelete :: FiniteMap m k => m k a -> m k b -> m k a differenceUsingDelete m1 m2 = foldWithKey del m1 m2 where del k _ m = delete k m subsetUsingSubsetEq :: FiniteMapX m k => m k a -> m k b -> Bool subsetUsingSubsetEq m1 m2 = subsetEq m1 m2 && size m1 < size m2 subsetEqUsingMember :: FiniteMap m k => m k a -> m k b -> Bool subsetEqUsingMember m1 m2 = foldWithKey mem True m1 where mem k _ b = member m2 k && b hugs98-plus-Sep2006/fptools/hslibs/data/edison/Assoc/AssocList.hs0000644006511100651110000002254210130752021023433 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module AssocList {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of simple association lists FM, -- instance of Assoc(X), FiniteMap(X) -- also instance of Functor -- AssocX operations empty,single,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll, deleteSeq,null,size,member,count,lookup,lookupM,lookupAll, lookupWithDefault,adjust,adjustAll,map,fold,fold1,filter,partition,elements, -- Assoc operations toSeq,keys,mapWithKey,foldWithKey,filterWithKey,partitionWithKey, -- FiniteMapX operations fromSeqWith,fromSeqWithKey,insertWith,insertWithKey,insertSeqWith, insertSeqWithKey,unionl,unionr,unionWith,unionSeqWith,intersectWith, difference,subset,subsetEq, -- FiniteMap operations unionWithKey,unionSeqWithKey,intersectWithKey, -- documentation moduleName, -- re-export view types from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter) import EdisonPrelude(Maybe2(..)) import qualified Assoc as A ( AssocX(..), Assoc(..), FiniteMapX(..), FiniteMap(..) ) import qualified Sequence as S import AssocDefaults -- signatures for exported functions moduleName :: String empty :: Eq k => FM k a single :: Eq k => k -> a -> FM k a fromSeq :: (Eq k,S.Sequence seq) => seq (k,a) -> FM k a insert :: Eq k => k -> a -> FM k a -> FM k a insertSeq :: (Eq k,S.Sequence seq) => seq (k,a) -> FM k a -> FM k a union :: Eq k => FM k a -> FM k a -> FM k a unionSeq :: (Eq k,S.Sequence seq) => seq (FM k a) -> FM k a delete :: Eq k => k -> FM k a -> FM k a deleteAll :: Eq k => k -> FM k a -> FM k a deleteSeq :: (Eq k,S.Sequence seq) => seq k -> FM k a -> FM k a null :: Eq k => FM k a -> Bool size :: Eq k => FM k a -> Int member :: Eq k => FM k a -> k -> Bool count :: Eq k => FM k a -> k -> Int lookup :: Eq k => FM k a -> k -> a lookupM :: Eq k => FM k a -> k -> Maybe a lookupAll :: (Eq k,S.Sequence seq) => FM k a -> k -> seq a lookupWithDefault :: Eq k => a -> FM k a -> k -> a adjust :: Eq k => (a -> a) -> k -> FM k a -> FM k a adjustAll :: Eq k => (a -> a) -> k -> FM k a -> FM k a map :: Eq k => (a -> b) -> FM k a -> FM k b fold :: Eq k => (a -> b -> b) -> b -> FM k a -> b fold1 :: Eq k => (a -> a -> a) -> FM k a -> a filter :: Eq k => (a -> Bool) -> FM k a -> FM k a partition :: Eq k => (a -> Bool) -> FM k a -> (FM k a, FM k a) elements :: (Eq k,S.Sequence seq) => FM k a -> seq a fromSeqWith :: (Eq k,S.Sequence seq) => (a -> a -> a) -> seq (k,a) -> FM k a fromSeqWithKey :: (Eq k,S.Sequence seq) => (k -> a -> a -> a) -> seq (k,a) -> FM k a insertWith :: Eq k => (a -> a -> a) -> k -> a -> FM k a -> FM k a insertWithKey :: Eq k => (k -> a -> a -> a) -> k -> a -> FM k a -> FM k a insertSeqWith :: (Eq k,S.Sequence seq) => (a -> a -> a) -> seq (k,a) -> FM k a -> FM k a insertSeqWithKey :: (Eq k,S.Sequence seq) => (k -> a -> a -> a) -> seq (k,a) -> FM k a -> FM k a unionl :: Eq k => FM k a -> FM k a -> FM k a unionr :: Eq k => FM k a -> FM k a -> FM k a unionWith :: Eq k => (a -> a -> a) -> FM k a -> FM k a -> FM k a unionSeqWith :: (Eq k,S.Sequence seq) => (a -> a -> a) -> seq (FM k a) -> FM k a intersectWith :: Eq k => (a -> b -> c) -> FM k a -> FM k b -> FM k c difference :: Eq k => FM k a -> FM k b -> FM k a subset :: Eq k => FM k a -> FM k b -> Bool subsetEq :: Eq k => FM k a -> FM k b -> Bool toSeq :: (Eq k,S.Sequence seq) => FM k a -> seq (k,a) keys :: (Eq k,S.Sequence seq) => FM k a -> seq k mapWithKey :: Eq k => (k -> a -> b) -> FM k a -> FM k b foldWithKey :: Eq k => (k -> a -> b -> b) -> b -> FM k a -> b filterWithKey :: Eq k => (k -> a -> Bool) -> FM k a -> FM k a partitionWithKey :: Eq k => (k -> a -> Bool) -> FM k a -> (FM k a, FM k a) unionWithKey :: Eq k => (k -> a -> a -> a) -> FM k a -> FM k a -> FM k a unionSeqWithKey :: (Eq k,S.Sequence seq) => (k -> a -> a -> a) -> seq (FM k a) -> FM k a intersectWithKey :: Eq k => (k -> a -> b -> c) -> FM k a -> FM k b -> FM k c moduleName = "AssocList" -- Finite maps as simple association lists. -- -- Duplicates are removed conceptually, but not physically. The first -- occurrence of a given key is the one that is considered to be in the map. -- -- The list type is mildly customized to prevent boxing the pairs. data FM k a = E | I k a (FM k a) -- uncurried insert. not exported. uinsert (k,x) = I k x empty = E single k x = I k x E insert = I insertSeq kxs m = S.foldr uinsert m kxs fromSeq = S.foldr uinsert E union m E = m union E m = m union (I k x m1) m2 = I k x (union m1 m2) unionSeq = S.foldr union E deleteAll key E = E deleteAll key (I k x m) | key == k = deleteAll key m | otherwise = I k x (deleteAll key m) delete = deleteAll null E = True null (I k x m) = False size E = 0 size (I k x m) = 1 + size (delete k m) member E key = False member (I k x m) key = key == k || member m key count E key = 0 count (I k x m) key | key == k = 1 | otherwise = count m key lookup E key = error "AssocList.lookup: lookup failed" lookup (I k x m) key | key == k = x | otherwise = lookup m key lookupM E key = Nothing lookupM (I k x m) key | key == k = Just x | otherwise = lookupM m key lookupAll E key = S.empty lookupAll (I k x m) key | key == k = S.single x | otherwise = lookupAll m key lookupWithDefault d E key = d lookupWithDefault d (I k x m) key | key == k = x | otherwise = lookupWithDefault d m key elements E = S.empty elements (I k x m) = S.cons x (elements (delete k m)) adjust f key E = E adjust f key (I k x m) | key == k = I key (f x) m | otherwise = I k x (adjust f key m) adjustAll = adjust map f E = E map f (I k x m) = I k (f x) (map f m) fold f c E = c fold f c (I k x m) = fold f (f x c) (delete k m) fold1 f E = error "AssocList.fold1: empty map" fold1 f (I k x m) = fold f x (delete k m) filter p E = E filter p (I k x m) | p x = I k x (filter p (delete k m)) | otherwise = filter p (delete k m) partition p E = (E, E) partition p (I k x m) | p x = (I k x m1,m2) | otherwise = (m1,I k x m2) where (m1,m2) = partition p (delete k m) toSeq E = S.empty toSeq (I k x m) = S.cons (k,x) (toSeq (delete k m)) keys E = S.empty keys (I k x m) = S.cons k (keys (delete k m)) mapWithKey f E = E mapWithKey f (I k x m) = I k (f k x) (mapWithKey f m) foldWithKey f c E = c foldWithKey f c (I k x m) = foldWithKey f (f k x c) (delete k m) filterWithKey p E = E filterWithKey p (I k x m) | p k x = I k x (filterWithKey p (delete k m)) | otherwise = filterWithKey p (delete k m) partitionWithKey p E = (E, E) partitionWithKey p (I k x m) | p k x = (I k x m1,m2) | otherwise = (m1,I k x m2) where (m1,m2) = partitionWithKey p (delete k m) unionl = union unionr = flip union -- defaults deleteSeq = deleteSeqUsingFoldr insertWith = insertWithUsingLookupM insertSeqWith = insertSeqWithUsingInsertWith insertWithKey = insertWithKeyUsingInsertWith insertSeqWithKey = insertSeqWithKeyUsingInsertWithKey unionWith = unionWithUsingInsertWith unionSeqWith = unionSeqWithUsingFoldr fromSeqWith = fromSeqWithUsingInsertSeqWith fromSeqWithKey = fromSeqWithKeyUsingInsertSeqWithKey intersectWith = intersectWithUsingLookupM difference = differenceUsingDelete subset = subsetUsingSubsetEq subsetEq = subsetEqUsingMember unionWithKey = unionWithKeyUsingInsertWithKey unionSeqWithKey = unionSeqWithKeyUsingFoldr intersectWithKey = intersectWithKeyUsingLookupM -- instance declarations instance Eq k => A.AssocX FM k where {empty = empty; single = single; fromSeq = fromSeq; insert = insert; insertSeq = insertSeq; union = union; unionSeq = unionSeq; delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; null = null; size = size; member = member; count = count; lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; adjust = adjust; adjustAll = adjustAll; map = map; fold = fold; fold1 = fold1; filter = filter; partition = partition; elements = elements; instanceName m = moduleName} instance Eq k => A.Assoc FM k where {toSeq = toSeq; keys = keys; mapWithKey = mapWithKey; foldWithKey = foldWithKey; filterWithKey = filterWithKey; partitionWithKey = partitionWithKey} instance Eq k => A.FiniteMapX FM k where {fromSeqWith = fromSeqWith; fromSeqWithKey = fromSeqWithKey; insertWith = insertWith; insertWithKey = insertWithKey; insertSeqWith = insertSeqWith; insertSeqWithKey = insertSeqWithKey; unionl = unionl; unionr = unionr; unionWith = unionWith; unionSeqWith = unionSeqWith; intersectWith = intersectWith; difference = difference; subset = subset; subsetEq = subsetEq} instance Eq k => A.FiniteMap FM k where {unionWithKey = unionWithKey; unionSeqWithKey = unionSeqWithKey; intersectWithKey = intersectWithKey} instance Eq k => Functor (FM k) where fmap = map hugs98-plus-Sep2006/fptools/hslibs/data/edison/Assoc/COPYRIGHT0000644006511100651110000000205207017267132022476 0ustar rossrossCopyright (c) 1998-1999 Chris Okasaki 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. hugs98-plus-Sep2006/fptools/hslibs/data/edison/Assoc/PatriciaLoMap.hs0000644006511100651110000004327010130752021024215 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module PatriciaLoMap {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of little-endian Patricia trees FM, -- instance of Assoc(X), FiniteMap(X) -- also instance of Functor -- AssocX operations empty,single,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll, deleteSeq,null,size,member,count,lookup,lookupM,lookupAll, lookupWithDefault,adjust,adjustAll,map,fold,fold1,filter,partition,elements, -- Assoc operations toSeq,keys,mapWithKey,foldWithKey,filterWithKey,partitionWithKey, -- FiniteMapX operations fromSeqWith,fromSeqWithKey,insertWith,insertWithKey,insertSeqWith, insertSeqWithKey,unionl,unionr,unionWith,unionSeqWith,intersectWith, difference,subset,subsetEq, -- FiniteMap operations unionWithKey,unionSeqWithKey,intersectWithKey, -- documentation moduleName, -- re-export view types from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter) import EdisonPrelude(Maybe2(..)) import qualified Assoc as A ( AssocX(..), Assoc(..), FiniteMapX(..), FiniteMap(..) ) import qualified Sequence as S import AssocDefaults import Data.Int import Data.Bits moduleName = "PatriciaLoMap" -- Adapted from -- Chris Okasaki and Any Gill. "Fast Mergeable Integer Maps". -- Workshop on ML, September 1998, pages 77-86. data FM k a = -- k is *always* Int E | L Int a | B Int Int !(FM k a) !(FM k a) type IntMap = FM Int -- auxiliary functions makeB p m E t = t makeB p m t E = t makeB p m t0 t1 = B p m t0 t1 lmakeB p m E t = t lmakeB p m t0 t1 = B p m t0 t1 rmakeB p m t E = t rmakeB p m t0 t1 = B p m t0 t1 lowestBit :: Int32 -> Int32 lowestBit x = x .&. (-x) branchingBit :: Int -> Int -> Int branchingBit p0 p1 = fromIntegral (lowestBit (fromIntegral p0 `xor` fromIntegral p1)) mask :: Int -> Int -> Int mask p m = fromIntegral (fromIntegral p .&. (fromIntegral m - (1 :: Int32))) zeroBit :: Int -> Int -> Bool zeroBit p m = (fromIntegral p) .&. (fromIntegral m) == (0 :: Int32) matchPrefix :: Int -> Int -> Int -> Bool matchPrefix k p m = mask k m == p join p0 t0 p1 t1 = let m = branchingBit p0 p1 in if zeroBit p0 m then B (mask p0 m) m t0 t1 else B (mask p0 m) m t1 t0 keepR x y = y -- end auxiliary functions empty :: IntMap a empty = E single :: Int -> a -> IntMap a single k x = L k x fromSeq :: S.Sequence seq => seq (Int,a) -> IntMap a fromSeq = S.foldl (\t (k, x) -> insert k x t) E insert :: Int -> a -> IntMap a -> IntMap a insert k x E = L k x insert k x t@(L j y) = if j == k then L k x else join k (L k x) j t insert k x t@(B p m t0 t1) = if matchPrefix k p m then if zeroBit k m then B p m (insert k x t0) t1 else B p m t0 (insert k x t1) else join k (L k x) p t union :: IntMap a -> IntMap a -> IntMap a union s@(B p m s0 s1) t@(B q n t0 t1) | m < n = if matchPrefix q p m then if zeroBit q m then B p m (union s0 t) s1 else B p m s0 (union s1 t) else join p s q t | m > n = if matchPrefix p q n then if zeroBit p n then B q n (union s t0) t1 else B q n t0 (union s t1) else join p s q t | otherwise = if p == q then B p m (union s0 t0) (union s1 t1) else join p s q t union s@(B p m s0 s1) (L k x) = if matchPrefix k p m then if zeroBit k m then B p m (insert k x s0) s1 else B p m s0 (insert k x s1) else join k (L k x) p s union s@(B _ _ _ _) E = s union (L k x) t = insert k x t union E t = t delete :: Int -> IntMap a -> IntMap a delete k E = E delete k t@(L j x) = if k == j then E else t delete k t@(B p m t0 t1) = if matchPrefix k p m then if zeroBit k m then lmakeB p m (delete k t0) t1 else rmakeB p m t0 (delete k t1) else t null :: IntMap a -> Bool null E = True null _ = False size :: IntMap a -> Int size E = 0 size (L _ _) = 1 size (B _ _ t0 t1) = size t0 + size t1 member :: IntMap a -> Int -> Bool member E k = False member (L j x) k = (j == k) member (B p m t0 t1) k = if zeroBit k m then member t0 k else member t1 k lookup :: IntMap a -> Int -> a lookup E k = error "PatriciaLoMap.lookup: lookup failed" lookup (L j x) k = if j == k then x else error "PatriciaLoMap.lookup: lookup failed" lookup (B p m t0 t1) k = if zeroBit k m then lookup t0 k else lookup t1 k lookupM :: IntMap a -> Int -> Maybe a lookupM E k = Nothing lookupM (L j x) k = if j == k then Just x else Nothing lookupM (B p m t0 t1) k = if zeroBit k m then lookupM t0 k else lookupM t1 k adjust :: (a -> a) -> Int -> IntMap a -> IntMap a adjust f k E = E adjust f k t@(L j x) = if k == j then L k (f x) else t adjust f k t@(B p m t0 t1) = if matchPrefix k p m then if zeroBit k m then B p m (adjust f k t0) t1 else B p m t0 (adjust f k t1) else t map :: (a -> b) -> IntMap a -> IntMap b map f E = E map f (L k x) = L k (f x) map f (B p m t0 t1) = B p m (map f t0) (map f t1) fold :: (a -> b -> b) -> b -> IntMap a -> b fold f c E = c fold f c (L k x) = f x c fold f c (B p m t0 t1) = fold f (fold f c t1) t0 fold1 :: (a -> a -> a) -> IntMap a -> a fold1 f E = error "PatriciaLoMap.fold1: empty map" fold1 f (L k x) = x fold1 f (B p m t0 t1) = f (fold1 f t0) (fold1 f t1) filter :: (a -> Bool) -> IntMap a -> IntMap a filter g E = E filter g t@(L k x) = if g x then t else E filter g (B p m t0 t1) = makeB p m (filter g t0) (filter g t1) partition :: (a -> Bool) -> IntMap a -> (IntMap a, IntMap a) partition g E = (E, E) partition g t@(L k x) = if g x then (t, E) else (E, t) partition g (B p m t0 t1) = let (t0',t0'') = partition g t0 (t1',t1'') = partition g t1 in (makeB p m t0' t1', makeB p m t0'' t1'') fromSeqWith :: S.Sequence seq => (a -> a -> a) -> seq (Int,a) -> IntMap a fromSeqWith f = S.foldl (\t (k, x) -> insertWith f k x t) E insertWith :: (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a insertWith f k x E = L k x insertWith f k x t@(L j y) = if j == k then L k (f x y) else join k (L k x) j t insertWith f k x t@(B p m t0 t1) = if matchPrefix k p m then if zeroBit k m then B p m (insertWith f k x t0) t1 else B p m t0 (insertWith f k x t1) else join k (L k x) p t unionl :: IntMap a -> IntMap a -> IntMap a unionl s@(B p m s0 s1) t@(B q n t0 t1) | m < n = if matchPrefix q p m then if zeroBit q m then B p m (unionl s0 t) s1 else B p m s0 (unionl s1 t) else join p s q t | m > n = if matchPrefix p q n then if zeroBit p n then B q n (unionl s t0) t1 else B q n t0 (unionl s t1) else join p s q t | otherwise = if p == q then B p m (unionl s0 t0) (unionl s1 t1) else join p s q t unionl s@(B p m s0 s1) (L k x) = if matchPrefix k p m then if zeroBit k m then B p m (insertWith keepR k x s0) s1 else B p m s0 (insertWith keepR k x s1) else join k (L k x) p s unionl s@(B _ _ _ _) E = s unionl (L k x) t = insert k x t unionl E t = t unionr :: IntMap a -> IntMap a -> IntMap a unionr s@(B p m s0 s1) t@(B q n t0 t1) | m < n = if matchPrefix q p m then if zeroBit q m then B p m (unionr s0 t) s1 else B p m s0 (unionr s1 t) else join p s q t | m > n = if matchPrefix p q n then if zeroBit p n then B q n (unionr s t0) t1 else B q n t0 (unionr s t1) else join p s q t | otherwise = if p == q then B p m (unionr s0 t0) (unionr s1 t1) else join p s q t unionr s@(B p m s0 s1) (L k x) = if matchPrefix k p m then if zeroBit k m then B p m (insert k x s0) s1 else B p m s0 (insert k x s1) else join k (L k x) p s unionr s@(B _ _ _ _) E = s unionr (L k x) t = insertWith keepR k x t unionr E t = t unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWith f s@(B p m s0 s1) t@(B q n t0 t1) | m < n = if matchPrefix q p m then if zeroBit q m then B p m (unionWith f s0 t) s1 else B p m s0 (unionWith f s1 t) else join p s q t | m > n = if matchPrefix p q n then if zeroBit p n then B q n (unionWith f s t0) t1 else B q n t0 (unionWith f s t1) else join p s q t | otherwise = if p == q then B p m (unionWith f s0 t0) (unionWith f s1 t1) else join p s q t unionWith f s@(B p m s0 s1) (L k x) = if matchPrefix k p m then if zeroBit k m then B p m (insertWith (flip f) k x s0) s1 else B p m s0 (insertWith (flip f) k x s1) else join k (L k x) p s unionWith f s@(B _ _ _ _) E = s unionWith f (L k x) t = insertWith f k x t unionWith f E t = t intersectWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c intersectWith f s@(B p m s0 s1) t@(B q n t0 t1) | m < n = if matchPrefix q p m then if zeroBit q m then intersectWith f s0 t else intersectWith f s1 t else E | m > n = if matchPrefix p q n then if zeroBit p n then intersectWith f s t0 else intersectWith f s t1 else E | otherwise = if p /= q then E else makeB p m (intersectWith f s0 t0) (intersectWith f s1 t1) intersectWith f (B p m s0 s1) (L k y) = case lookupM (if zeroBit k m then s0 else s1) k of Just x -> L k (f x y) Nothing -> E intersectWith f s@(B _ _ _ _) E = E intersectWith f (L k x) t = case lookupM t k of Just y -> L k (f x y) Nothing -> E intersectWith f E t = E difference :: IntMap a -> IntMap b -> IntMap a difference s@(B p m s0 s1) t@(B q n t0 t1) | m < n = if matchPrefix q p m then if zeroBit q m then lmakeB p m (difference s0 t) s1 else rmakeB p m s0 (difference s1 t) else s | m > n = if matchPrefix p q n then if zeroBit p n then difference s t0 else difference s t1 else s | otherwise = if p /= q then s else makeB p m (difference s0 t0) (difference s1 t1) difference s@(B p m s0 s1) (L k y) = if matchPrefix k p m then if zeroBit k m then lmakeB p m (delete k s0) s1 else rmakeB p m s0 (delete k s1) else s difference s@(B _ _ _ _) E = s difference s@(L k x) t = if member t k then E else s difference E t = E subset :: IntMap a -> IntMap b -> Bool subset s t = case subset' s t of {LT -> True; _ -> False} subset' s@(B p m s0 s1) t@(B q n t0 t1) | m < n = GT | m > n = if matchPrefix p q n then if zeroBit p n then subset' s t0 else subset' s t1 else GT | otherwise = if p == q then case (subset' s0 t0,subset' s1 t1) of (GT,_) -> GT (_,GT) -> GT (EQ,EQ) -> EQ (_,_) -> LT else GT subset' (B p m s0 s1) _ = GT subset' (L k x) (L j y) = if k == j then EQ else GT subset' (L k x) t = if member t k then LT else GT subset' E E = EQ subset' E _ = LT subsetEq :: IntMap a -> IntMap b -> Bool subsetEq s@(B p m s0 s1) t@(B q n t0 t1) | m < n = False | m > n = matchPrefix p q n && (if zeroBit p n then subsetEq s t0 else subsetEq s t1) | otherwise = (p == q) && subsetEq s0 t0 && subsetEq s1 t1 subsetEq (B p m s0 s1) _ = False subsetEq (L k x) t = member t k subsetEq E t = True mapWithKey :: (Int -> a -> b) -> IntMap a -> IntMap b mapWithKey f E = E mapWithKey f (L k x) = L k (f k x) mapWithKey f (B p m t0 t1) = B p m (mapWithKey f t0) (mapWithKey f t1) foldWithKey :: (Int -> a -> b -> b) -> b -> IntMap a -> b foldWithKey f c E = c foldWithKey f c (L k x) = f k x c foldWithKey f c (B p m t0 t1) = foldWithKey f (foldWithKey f c t1) t0 filterWithKey :: (Int -> a -> Bool) -> IntMap a -> IntMap a filterWithKey g E = E filterWithKey g t@(L k x) = if g k x then t else E filterWithKey g (B p m t0 t1) = makeB p m (filterWithKey g t0) (filterWithKey g t1) partitionWithKey :: (Int -> a -> Bool) -> IntMap a -> (IntMap a, IntMap a) partitionWithKey g E = (E, E) partitionWithKey g t@(L k x) = if g k x then (t, E) else (E, t) partitionWithKey g (B p m t0 t1) = let (t0',t0'') = partitionWithKey g t0 (t1',t1'') = partitionWithKey g t1 in (makeB p m t0' t1', makeB p m t0'' t1'') unionWithKey :: (Int -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWithKey f s@(B p m s0 s1) t@(B q n t0 t1) | m < n = if matchPrefix q p m then if zeroBit q m then B p m (unionWithKey f s0 t) s1 else B p m s0 (unionWithKey f s1 t) else join p s q t | m > n = if matchPrefix p q n then if zeroBit p n then B q n (unionWithKey f s t0) t1 else B q n t0 (unionWithKey f s t1) else join p s q t | otherwise = if p == q then B p m (unionWithKey f s0 t0) (unionWithKey f s1 t1) else join p s q t unionWithKey f s@(B p m s0 s1) (L k x) = if matchPrefix k p m then if zeroBit k m then B p m (insertWith (flip (f k)) k x s0) s1 else B p m s0 (insertWith (flip (f k)) k x s1) else join k (L k x) p s unionWithKey f s@(B _ _ _ _) E = s unionWithKey f (L k x) t = insertWith (f k) k x t unionWithKey f E t = t intersectWithKey :: (Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c intersectWithKey f s@(B p m s0 s1) t@(B q n t0 t1) | m < n = if matchPrefix q p m then if zeroBit q m then intersectWithKey f s0 t else intersectWithKey f s1 t else E | m > n = if matchPrefix p q n then if zeroBit p n then intersectWithKey f s t0 else intersectWithKey f s t1 else E | otherwise = if p /= q then E else makeB p m (intersectWithKey f s0 t0) (intersectWithKey f s1 t1) intersectWithKey f (B p m s0 s1) (L k y) = case lookupM (if zeroBit k m then s0 else s1) k of Just x -> L k (f k x y) Nothing -> E intersectWithKey f s@(B _ _ _ _) E = E intersectWithKey f (L k x) t = case lookupM t k of Just y -> L k (f k x y) Nothing -> E intersectWithKey f E t = E -- defaults insertSeq :: S.Sequence seq => seq (Int,a) -> IntMap a -> IntMap a insertSeq = insertSeqUsingFoldr unionSeq :: S.Sequence seq => seq (IntMap a) -> IntMap a unionSeq = unionSeqUsingReduce deleteAll :: Int -> IntMap a -> IntMap a deleteAll = delete deleteSeq :: S.Sequence seq => seq Int -> IntMap a -> IntMap a deleteSeq = deleteSeqUsingFoldr count :: IntMap a -> Int -> Int count = countUsingMember lookupAll :: S.Sequence seq => IntMap a -> Int -> seq a lookupAll = lookupAllUsingLookupM lookupWithDefault :: a -> IntMap a -> Int -> a lookupWithDefault = lookupWithDefaultUsingLookupM elements :: S.Sequence seq => IntMap a -> seq a elements = elementsUsingFold fromSeqWithKey :: S.Sequence seq => (Int -> a -> a -> a) -> seq (Int,a) -> IntMap a fromSeqWithKey = fromSeqWithKeyUsingInsertSeqWithKey insertWithKey :: (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a insertWithKey = insertWithKeyUsingInsertWith insertSeqWith :: S.Sequence seq => (a -> a -> a) -> seq (Int,a) -> IntMap a -> IntMap a insertSeqWith = insertSeqWithUsingInsertWith insertSeqWithKey :: S.Sequence seq => (Int -> a -> a -> a) -> seq (Int,a) -> IntMap a -> IntMap a insertSeqWithKey = insertSeqWithKeyUsingInsertWithKey adjustAll :: (a -> a) -> Int -> IntMap a -> IntMap a adjustAll = adjust unionSeqWith :: S.Sequence seq => (a -> a -> a) -> seq (IntMap a) -> IntMap a unionSeqWith = unionSeqWithUsingReduce toSeq :: S.Sequence seq => IntMap a -> seq (Int,a) toSeq = toSeqUsingFoldWithKey keys :: S.Sequence seq => IntMap a -> seq Int keys = keysUsingFoldWithKey unionSeqWithKey :: S.Sequence seq => (Int -> a -> a -> a) -> seq (IntMap a) -> IntMap a unionSeqWithKey = unionSeqWithKeyUsingReduce -- instance declarations instance A.AssocX FM Int where {empty = empty; single = single; fromSeq = fromSeq; insert = insert; insertSeq = insertSeq; union = union; unionSeq = unionSeq; delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; null = null; size = size; member = member; count = count; lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; adjust = adjust; adjustAll = adjustAll; map = map; fold = fold; fold1 = fold1; filter = filter; partition = partition; elements = elements; instanceName m = moduleName} instance A.Assoc FM Int where {toSeq = toSeq; keys = keys; mapWithKey = mapWithKey; foldWithKey = foldWithKey; filterWithKey = filterWithKey; partitionWithKey = partitionWithKey} instance A.FiniteMapX FM Int where {fromSeqWith = fromSeqWith; fromSeqWithKey = fromSeqWithKey; insertWith = insertWith; insertWithKey = insertWithKey; insertSeqWith = insertSeqWith; insertSeqWithKey = insertSeqWithKey; unionl = unionl; unionr = unionr; unionWith = unionWith; unionSeqWith = unionSeqWith; intersectWith = intersectWith; difference = difference; subset = subset; subsetEq = subsetEq} instance A.FiniteMap FM Int where {unionWithKey = unionWithKey; unionSeqWithKey = unionSeqWithKey; intersectWithKey = intersectWithKey} instance Functor (FM Int) where fmap = map hugs98-plus-Sep2006/fptools/hslibs/data/edison/COPYRIGHT0000644006511100651110000000205207017267132021426 0ustar rossrossCopyright (c) 1998-1999 Chris Okasaki 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. hugs98-plus-Sep2006/fptools/hslibs/data/edison/COPYRIGHT.short0000644006511100651110000000013507017267132022564 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. hugs98-plus-Sep2006/fptools/hslibs/data/edison/EdisonPrelude.hs0000644006511100651110000000166710130752020023225 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module EdisonPrelude {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} where data Maybe2 a b = Just2 a b | Nothing2 deriving (Eq,Show) data Maybe3 a b c = Just3 a b c | Nothing3 deriving (Eq,Show) -- utilities on Maybe2 and Maybe3 types??? class Eq a => Hash a where hash :: a -> Int -- forall x,y :: a. (x == y) implies (hash x == hash y) class Hash a => UniqueHash a -- no new methods, just a stronger invariant -- forall x,y :: a. (x == y) iff (hash x == hash y) class UniqueHash a => ReversibleHash a where unhash :: Int -> a -- forall x :: a. unhash (hash x) == x -- Note that -- hash (unhash i) == i -- does not necessarily hold because unhash is not necessarily -- defined for all i, only for all i in the range of hash. -- add a few instance declarations for ints, floats, bools, chars, etc. hugs98-plus-Sep2006/fptools/hslibs/data/edison/Makefile0000644006511100651110000000401307027434240021567 0ustar rossross#----------------------------------------------------------------------------- # directories and files all :: subdirs = . Seq Coll Assoc importdir = Import libdir = Lib VPATH = $(subdirs) $(importdir) $(libdir) fullsources = $(foreach dir, $(subdirs), $(wildcard $(dir)/*.hs)) sources = $(foreach file, $(fullsources), $(notdir $(file))) objects = $(foreach file, $(sources:.hs=.o), $(file)) dependclutter = $(foreach file, $(fullsources:.hs=.hs.i), $(file)) #----------------------------------------------------------------------------- # commands #ghc = /usr/fptools-BUILDS/new-rts-20/ghc/driver/ghc ghc = ghc ghcflags = -recomp -fglasgow-exts -fallow-undecidable-instances -i$(importdir) $(addprefix -i, $(subdirs)) -Wall -fno-warn-unused-matches -fno-warn-name-shadowing -funbox-strict-fields #----------------------------------------------------------------------------- # static pattern rules $(objects) : %.o : %.hs $(ghc) -c $(ghcflags) $< -o $(libdir)/$(notdir $@) touch $(basename $<).hi cp $(basename $<).hi $(importdir) #----------------------------------------------------------------------------- # pattern rules %.hi : %.o @if [ ! -f $@ ] ; then \ echo $(RM) $< ; \ $(RM) $< ; \ set +e ; \ echo $(MAKE) $(notdir $<) ; \ $(MAKE) $(notdir $<) ; \ if [ $$? -ne 0 ] ; then \ exit 1; \ fi ; \ fi #----------------------------------------------------------------------------- # rules .PHONY : echo depend all :: libedison.a libedison.a : $(objects) cd $(libdir); \ ar rcv libedison.a $(objects); \ ranlib libedison.a; \ chmod a+r libedison.a test : @echo $(sources) @echo $(objects) @echo $(dependclutter) @echo $(VPATH) tar : cd ..; \ rm -f edison.tar edison.tar.gz; \ tar -cf edison.tar edison; \ gzip edison.tar depend: $(ghc) -M -optdep-f -optdepEdison.d0 $(ghcflags) $(fullsources) sed -e 's/[^ ]*\///' Edison.d0 | sed -e 's/[^ ]*\///' > Edison.d rm -f Edison.d0 Edison.d0.bak rm -f $(dependclutter) clean : rm -f Import/*.hi Lib/*.o Lib/libedison.a -include Edison.d hugs98-plus-Sep2006/fptools/hslibs/data/edison/README0000644006511100651110000000577607027436731021037 0ustar rossrossEdison: A Library of Efficient Data Structures (Haskell Version 1.1) December 20, 1999 This release updates Edison from Haskell 1.4 to Haskell 98, and removes most of the GHC specific code. Edison should now run under both GHC and Hugs (at least). Note that Edison is still not fully Haskell 98 compliant because of the use of multi-parameter type classes and the occasional use of GHC/Hugs libraries such as Bits. See docs/users.{dvi,ps} for more extensive documentation. Basic instructions for using Edison with GHC or Hugs are included below. See the User's Guide for more discussion about portability. In its current state, Edison is still mostly a framework. That is, I provide signatures, but not yet very many implementations. I intend to populate this framework over time, adding a new module every few weeks. Thus, the library is extremely unstable in the sense that I will continually be modifying existing data structures and adding new ones. However, I hope that the signatures will remain fairly stable over time, making these changes to the implementations mostly transparent to users of the library. If you wish to request a particular data structure or volunteer to provide an implementation, or if you have any other comments or suggestions, send me email at cdo@cs.columbia.edu. Chris Okasaki USING EDISON WITH GHC --------------------- To begin using Edison with GHC, first run make depend make all I recommend using GHC 4.04 or higher (I used GHC 4.04 for testing). To compile a file Foo.hs that uses Edison, type something like ghc -c -fglasgow-exts -iEDHOME/Import Foo.hs where EDHOME should be replaced with the correct path to the Edison home directory. To compile and link, type something like ghc -fglasgow-exts -iEDHOME/Import -LEDHOME/Lib -ledison Foo.hs USING EDISON WITH HUGS ---------------------- To use Edison under Hugs, simply add the Edison directories to the Hugs search path, as in hugs -98 -PEDHOME:EDHOME/Seq:EDHOME/Coll:EDHOME/Assoc: Foo.hs where EDHOME should be replaced with the correct path to the Edison home directory. I do this by aliasing "ehugs" to "hugs -98 -PEDHOME:EDHOME/Seq:EDHOME/Coll:EDHOME/Assoc:" and then typing ehugs Foo.hs There is a problem with this approach in that the built-in Hugs libraries already contain a Sequence module, which is now being shadowed by Edison's Sequence module. It is unlikely that any of your code depends on this built-in module directly, but it may depend on it indirectly through the HugsLibs module. Here is the easiest way to fix the problem. 1. Go the the .../share/hugs/lib/hugs directory. 2. Rename Sequence.hs to HugsSequence.hs. 3. Edit HugsSequence.hs, replacing the line module Sequence( with module HugsSequence( 4. Edit HugsLibs.hs, replacing the line import Sequence with import HugsSequence These directions were tested under the November 1999 release of Hugs. It is likely that the next release of Hugs will rename or eliminate the built-in Sequence module. hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/0000755006511100651110000000000010504340142021011 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/COPYRIGHT0000644006511100651110000000205207017267132022317 0ustar rossrossCopyright (c) 1998-1999 Chris Okasaki 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. hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/Collection.hs0000644006511100651110000002356710130752022023454 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module Collection {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( {- -- non-observable classes CollX(..), OrdCollX(..), SetX(..), OrdSetX(..), -- observable classes Coll(..), OrdColl(..), Set(..), OrdSet(..), -- specialize all the sequence operations to lists fromList, insertList, unionList, deleteList, unsafeFromOrdList, toList, lookupList, toOrdList, fromListWith, insertListWith, unionListWith, -} module Collection, -- re-export view type from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import EdisonPrelude(Maybe2(..)) import Sequence(Sequence) import ListSeq() class Eq a => CollX c a where empty :: c a -- the empty collection single :: a -> c a -- create a singleton collection fromSeq :: Sequence seq => seq a -> c a -- convert a sequence to a collection. For sets, it is unspecified -- which element is kept in case of duplicates. insert :: a -> c a -> c a insertSeq :: Sequence seq => seq a -> c a -> c a -- insert an element or a sequence of elements into a collection. For -- sets, insert keeps the new element in case of duplicates, but -- insertSeq keeps an unspecified element. union :: c a -> c a -> c a unionSeq :: Sequence seq => seq (c a) -> c a -- merge two collections or a sequence of collections. For sets, it -- is unspecified which element is kept in case of duplicates. delete :: a -> c a -> c a deleteAll :: a -> c a -> c a -- delete a single occurrence or all occurrences of the given -- element from a collection. For sets, these will be the same, -- but for bags they may be different. For delete on bags, it -- is unspecified which of several duplicate elements is deleted. deleteSeq :: Sequence seq => seq a -> c a -> c a -- delete a single occurrence of each of the given elements from -- a collection. For bags, there may be multiple occurrences of a -- given element in the collection, in which case it is unspecified -- which is deleted. null :: c a -> Bool size :: c a -> Int -- test whether the collection is empty, or return the number of -- elements in the collection. member :: c a -> a -> Bool count :: c a -> a -> Int -- test whether the given element is in the collection, or how many -- duplicates are in the collection. (For sets, count will always -- return 0 or 1.) instanceName :: c a -> String -- the name of the module implementing c class (CollX c a, Ord a) => OrdCollX c a where deleteMin :: c a -> c a deleteMax :: c a -> c a -- delete the minimum or maximum element from the collection. -- If there is more than one minimum or maximum, it is unspecified which -- is deleted. unsafeInsertMin :: a -> c a -> c a unsafeInsertMax :: c a -> a -> c a -- insert an element that is guaranteed to be <= or >= any existing -- elements in the collection. (For sets, this precondition is -- strengthened to < or >.) unsafeFromOrdSeq :: Sequence seq => seq a -> c a -- convert a sequence in non-decreasing order into a collection. -- (For sets, the sequence must be in increasing order.) unsafeAppend :: c a -> c a -> c a -- union two collections where every element in the first -- collection is <= every element in the second collection. -- (For sets, this precondition is strengthened to <.) filterLT :: a -> c a -> c a filterLE :: a -> c a -> c a filterGT :: a -> c a -> c a filterGE :: a -> c a -> c a -- filterLT x xs = filter (< x) xs -- filterLE x xs = filter (<= x) xs -- filterGT x xs = filter (> x) xs -- filterGE x xs = filter (>= x) xs partitionLT_GE :: a -> c a -> (c a, c a) partitionLE_GT :: a -> c a -> (c a, c a) partitionLT_GT :: a -> c a -> (c a, c a) -- partitionLT_GE x xs = partition (< x) xs -- partitionLE_GT x xs = partition (<= x) xs -- partitionLT_GT x xs = (filterLT x xs, filterGT x xs) class CollX c a => SetX c a where intersect :: c a -> c a -> c a difference :: c a -> c a -> c a -- return the intersection or difference of two sets. For intersect, -- it is unspecified which of the two elements is kept. subset :: c a -> c a -> Bool subsetEq :: c a -> c a -> Bool -- test whether the first set is a proper subset of the second, -- or whether it is a (possibly improper) subset. class (OrdCollX c a, SetX c a) => OrdSetX c a -- no methods class CollX c a => Coll c a where toSeq :: Sequence seq => c a -> seq a -- list the elements of the collection in an unspecified order lookup :: c a -> a -> a lookupM :: c a -> a -> Maybe a lookupAll :: Sequence seq => c a -> a -> seq a lookupWithDefault :: a -> c a -> a -> a -- lookup one or more elements equal to the given element. -- if there is none, then lookup signals an error, lookupM returns -- Nothing, lookupAll returns empty, and lookupWithDefault d returns d. -- if there are mulitiple copies, then lookup/lookupM/lookupWithDefault -- return an unspecified one, and lookupAll returns them all, but -- in an unspecified order. fold :: (a -> b -> b) -> b -> c a -> b fold1 :: (a -> a -> a) -> c a -> a -- fold over all the elements in a collection in unspecified order. -- (fold1 signals an error if the collection is empty.) filter :: (a -> Bool) -> c a -> c a partition :: (a -> Bool) -> c a -> (c a, c a) -- filter removes all elements not satisfying the predicate. -- partition returns two collections, one containing all the -- elements satisfying the predicate, and one containing all the -- elements not satisfying the predicate. class (Coll c a, OrdCollX c a) => OrdColl c a where minView :: c a -> Maybe2 a (c a) minElem :: c a -> a -- return the minimum element in the collection, together with -- the collection without that element in the case of minView. -- If there are multiple copies of the minimum element, it is -- unspecified which is chosen. Note that minView, minElem, and -- deleteMin may make different choices! maxView :: c a -> Maybe2 (c a) a maxElem :: c a -> a -- return the maximum element in the collection, together with -- the collection without that element in the case of maxView. -- If there are multiple copies of the maximum element, it is -- unspecified which is chosen. Note that maxView, maxElem, and -- deleteMax may make different choices! foldr :: (a -> b -> b) -> b -> c a -> b foldl :: (b -> a -> b) -> b -> c a -> b -- fold across the elements in non-decreasing order. -- (For sets, this will always be increasing order.) foldr1 :: (a -> a -> a) -> c a -> a foldl1 :: (a -> a -> a) -> c a -> a -- fold across the elements in non-decreasing order, or signal an -- error if the collection is empty. (For sets, this will always be -- increasing order.) toOrdSeq :: Sequence seq => c a -> seq a -- list the elements in non-decreasing order. class (Coll c a, SetX c a) => Set c a where -- WARNING: Each of the following "With" functions is unsafe. The combining -- functions are required to satisfy the precondition that, given two -- equal elements, they return a third element equal to the other two. fromSeqWith :: Sequence seq => (a -> a -> a) -> seq a -> c a -- same as fromSeq but with a combining function to resolve duplicates. -- Usually, the combining function should be associative. If not, -- the elements will be combined left-to-right, but with an -- unspecified associativity. For example, if x == y == z, -- then fromSeqWith (+) [x,y,z] equals either -- single (x + (y + z)) -- or -- single ((x + y) + z) insertWith :: (a -> a -> a) -> a -> c a -> c a insertSeqWith :: Sequence seq => (a -> a -> a) -> seq a -> c a -> c a -- same as insert/insertSeq but with a combining function to resolve -- duplicates. The comments about associativity apply to insertSeqWith. unionl :: c a -> c a -> c a unionr :: c a -> c a -> c a -- unionl = unionWith (\x y -> x) -- unionr = unionWith (\x y -> y) unionWith :: (a -> a -> a) -> c a -> c a -> c a unionSeqWith :: Sequence seq => (a -> a -> a) -> seq (c a) -> c a -- same as union/unionSeq but with a combining function to resolve -- duplicates. The comments about associativity apply to unionSeqWith. intersectWith :: (a -> a -> a) -> c a -> c a -> c a -- same as intersect but with a combining function to resolve duplicates. class (OrdColl c a, Set c a) => OrdSet c a -- no methods -- specialize all the sequence operations to lists fromList :: CollX c a => [a] -> c a insertList :: CollX c a => [a] -> c a -> c a unionList :: CollX c a => [c a] -> c a deleteList :: CollX c a => [a] -> c a -> c a unsafeFromOrdList :: OrdCollX c a => [a] -> c a toList :: Coll c a => c a -> [a] lookupList :: Coll c a => c a -> a -> [a] toOrdList :: OrdColl c a => c a -> [a] fromListWith :: Set c a => (a -> a -> a) -> [a] -> c a insertListWith :: Set c a => (a -> a -> a) -> [a] -> c a -> c a unionListWith :: Set c a => (a -> a -> a) -> [c a] -> c a fromList = fromSeq insertList = insertSeq unionList = unionSeq deleteList = deleteSeq unsafeFromOrdList = unsafeFromOrdSeq toList = toSeq lookupList = lookupAll toOrdList = toOrdSeq fromListWith = fromSeqWith insertListWith = insertSeqWith unionListWith = unionSeqWith hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/CollectionDefaults.hs0000644006511100651110000001525710130752022025141 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module CollectionDefaults {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} where import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import Collection import qualified Sequence as S import qualified ListSeq as L insertSeqUsingUnion :: (CollX c a,S.Sequence seq) => seq a -> c a -> c a insertSeqUsingUnion xs c = union (fromSeq xs) c insertSeqUsingFoldr :: (CollX c a,S.Sequence seq) => seq a -> c a -> c a insertSeqUsingFoldr xs c = S.foldr insert c xs memberUsingFold :: Coll c a => c a -> a -> Bool memberUsingFold h x = fold (\y ans -> (x == y) || ans) False h countUsingMember :: SetX c a => c a -> a -> Int countUsingMember xs x = if member xs x then 1 else 0 lookupAllUsingLookupM :: (Set c a,S.Sequence seq) => c a -> a -> seq a lookupAllUsingLookupM xs x = case lookupM xs x of Nothing -> S.empty Just y -> S.single y deleteSeqUsingDelete :: (CollX c a,S.Sequence seq) => seq a -> c a -> c a deleteSeqUsingDelete xs c = S.foldr delete c xs unionSeqUsingFoldl :: (CollX c a,S.Sequence seq) => seq (c a) -> c a unionSeqUsingFoldl = S.foldl union empty unionSeqUsingReduce :: (CollX c a,S.Sequence seq) => seq (c a) -> c a unionSeqUsingReduce = S.reducel union empty fromSeqUsingFoldr :: (CollX c a,S.Sequence seq) => seq a -> c a fromSeqUsingFoldr = S.foldr insert empty fromSeqUsingUnionSeq :: (CollX c a,S.Sequence seq) => seq a -> c a fromSeqUsingUnionSeq = unionList . S.foldl singleCons [] where singleCons xs x = S.cons (single x) xs toSeqUsingFold :: (Coll c a,S.Sequence seq) => c a -> seq a toSeqUsingFold = fold S.cons S.empty unsafeInsertMaxUsingUnsafeAppend :: OrdCollX c a => c a -> a -> c a unsafeInsertMaxUsingUnsafeAppend c x = unsafeAppend c (single x) toOrdSeqUsingFoldr :: (OrdColl c a,S.Sequence seq) => c a -> seq a toOrdSeqUsingFoldr = foldr S.cons S.empty unsafeFromOrdSeqUsingUnsafeInsertMin :: (OrdCollX c a,S.Sequence seq) => seq a -> c a unsafeFromOrdSeqUsingUnsafeInsertMin = S.foldr unsafeInsertMin empty disjointUsingToOrdList :: OrdColl c a => c a -> c a -> Bool disjointUsingToOrdList xs ys = disj (toOrdList xs) (toOrdList ys) where disj a@(x:xs) b@(y:ys) = case compare x y of LT -> disj xs b EQ -> False GT -> disj a ys disj _ _ = True intersectWitnessUsingToOrdList :: OrdColl c a => c a -> c a -> Maybe2 a a intersectWitnessUsingToOrdList xs ys = witness (toOrdList xs) (toOrdList ys) where witness a@(x:xs) b@(y:ys) = case compare x y of LT -> witness xs b EQ -> Just2 x y GT -> witness a ys witness _ _ = Nothing2 lookupUsingLookupM :: Coll c a => c a -> a -> a lookupUsingLookupM ys x = case lookupM ys x of Just y -> y Nothing -> error (instanceName ys ++ ".lookup: lookup failed") lookupUsingLookupAll :: Coll c a => c a -> a -> a lookupUsingLookupAll ys x = case lookupAll ys x of (y:_) -> y [] -> error (instanceName ys ++ ".lookup: lookup failed") lookupMUsingLookupAll :: Coll c a => c a -> a -> Maybe a lookupMUsingLookupAll ys x = case lookupAll ys x of (y:_) -> Just y [] -> Nothing lookupWithDefaultUsingLookupAll :: Coll c a => a -> c a -> a -> a lookupWithDefaultUsingLookupAll dflt ys x = case lookupAll ys x of (y:_) -> y [] -> dflt lookupWithDefaultUsingLookupM :: Coll c a => a -> c a -> a -> a lookupWithDefaultUsingLookupM dflt ys x = case lookupM ys x of Just y -> y Nothing -> dflt deleteMaxUsingMaxView :: OrdColl c a => c a -> c a deleteMaxUsingMaxView c = case maxView c of Just2 c' _ -> c' Nothing2 -> c fromSeqWithUsingInsertWith :: (Set c a,S.Sequence seq) => (a -> a -> a) -> seq a -> c a fromSeqWithUsingInsertWith c = S.foldr (insertWith c) empty insertUsingInsertWith :: Set c a => a -> c a -> c a insertUsingInsertWith = insertWith (\x y -> x) unionUsingUnionWith :: Set c a => c a -> c a -> c a unionUsingUnionWith = unionWith (\x y -> x) filterUsingOrdLists :: OrdColl c a => (a -> Bool) -> c a -> c a filterUsingOrdLists p = unsafeFromOrdList . L.filter p . toOrdList partitionUsingOrdLists :: OrdColl c a => (a -> Bool) -> c a -> (c a,c a) partitionUsingOrdLists p xs = (unsafeFromOrdList ys,unsafeFromOrdList zs) where (ys,zs) = L.partition p (toOrdList xs) intersectUsingIntersectWith :: Set c a => c a -> c a -> c a intersectUsingIntersectWith = intersectWith (\x y -> x) differenceUsingOrdLists :: OrdSet c a => c a -> c a -> c a differenceUsingOrdLists xs ys = unsafeFromOrdList (diff (toOrdList xs) (toOrdList ys)) where diff a@(x:xs) b@(y:ys) = case compare x y of LT -> x : diff xs b EQ -> diff xs ys GT -> diff a ys diff a _ = a subsetUsingOrdLists :: OrdSet c a => c a -> c a -> Bool subsetUsingOrdLists xs ys = subsetOnOrdLists (toOrdList xs) (toOrdList ys) subsetEqUsingOrdLists :: OrdSet c a => c a -> c a -> Bool subsetEqUsingOrdLists xs ys = subsetEqOnOrdLists (toOrdList xs) (toOrdList ys) subsetOnOrdLists [] [] = False subsetOnOrdLists [] (_:_) = True subsetOnOrdLists (_:_) [] = False subsetOnOrdLists a@(x:xs) (y:ys) = case compare x y of LT -> False EQ -> subsetOnOrdLists xs ys GT -> subsetEqOnOrdLists a ys subsetEqOnOrdLists [] _ = True subsetEqOnOrdLists (_:_) [] = False subsetEqOnOrdLists a@(x:xs) (y:ys) = case compare x y of LT -> False EQ -> subsetEqOnOrdLists xs ys GT -> subsetEqOnOrdLists a ys insertSeqWithUsingInsertWith :: (Set c a,S.Sequence seq) => (a -> a -> a) -> seq a -> c a -> c a insertSeqWithUsingInsertWith c xs s = S.foldr (insertWith c) s xs unionlUsingUnionWith :: Set c a => c a -> c a -> c a unionlUsingUnionWith xs ys = unionWith (\x y -> x) xs ys unionrUsingUnionWith :: Set c a => c a -> c a -> c a unionrUsingUnionWith xs ys = unionWith (\x y -> y) xs ys unionWithUsingOrdLists :: OrdSet c a => (a -> a -> a) -> c a -> c a -> c a unionWithUsingOrdLists c xs ys = unsafeFromOrdList (merge (toOrdList xs) (toOrdList ys)) where merge a@(x:xs) b@(y:ys) = case compare x y of LT -> x : merge xs b EQ -> c x y : merge xs ys GT -> y : merge a ys merge a@(x:xs) [] = a merge [] b = b unionSeqWithUsingReducer :: (Set c a,S.Sequence seq) => (a -> a -> a) -> seq (c a) -> c a unionSeqWithUsingReducer c = S.reducer (unionWith c) empty intersectWithUsingOrdLists :: OrdSet c a => (a -> a -> a) -> c a -> c a -> c a intersectWithUsingOrdLists c xs ys = unsafeFromOrdList (inter (toOrdList xs) (toOrdList ys)) where inter a@(x:xs) b@(y:ys) = case compare x y of LT -> inter xs b EQ -> c x y : inter xs ys GT -> inter a ys inter _ _ = [] hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/CollectionUtils.hs0000644006511100651110000000167710130752022024473 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module CollectionUtils {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} where import Prelude hiding (map,null,foldr,foldl,foldr1,foldl1,lookup,filter) import Collection map :: (Coll cin a, CollX cout b) => (a -> b) -> (cin a -> cout b) map f xs = fold (\x ys -> insert (f x) ys) empty xs mapPartial :: (Coll cin a, CollX cout b) => (a -> Maybe b) -> (cin a -> cout b) mapPartial f xs = fold (\ x ys -> case f x of Just y -> insert y ys Nothing -> ys) empty xs unsafeMapMonotonic :: (OrdColl cin a, OrdCollX cout b) => (a -> b) -> (cin a -> cout b) unsafeMapMonotonic f xs = foldr (unsafeInsertMin . f) empty xs unionMap :: (Coll cin a, CollX cout b) => (a -> cout b) -> (cin a -> cout b) unionMap f xs = fold (\x ys -> union (f x) ys) empty xs hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/LazyPairingHeap.hs0000644006511100651110000003545610130752022024410 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module LazyPairingHeap {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of pairing heaps Heap, -- instance of Coll/CollX, OrdColl/OrdCollX -- CollX operations empty,single,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll, deleteSeq,null,size,member,count, -- Coll operations toSeq, lookup, lookupM, lookupAll, lookupWithDefault, fold, fold1, filter, partition, -- OrdCollX operations deleteMin,deleteMax,unsafeInsertMin,unsafeInsertMax,unsafeFromOrdSeq, unsafeAppend,filterLT,filterLE,filterGT,filterGE,partitionLT_GE, partitionLE_GT,partitionLT_GT, -- OrdColl operations minView,minElem,maxView,maxElem,foldr,foldl,foldr1,foldl1,toOrdSeq, -- other supported operations unsafeMapMonotonic, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import EdisonPrelude(Maybe2(..)) import qualified Collection as C ( CollX(..), OrdCollX(..), Coll(..), OrdColl(..), toOrdList ) import qualified Sequence as S import CollectionDefaults import List(sort) import Monad import QuickCheck moduleName = "LazyPairingHeap" -- Adapted from -- Chris Okasaki. Purely Functional Data Structures. 1998. -- Section 6.5. data Heap a = E | H1 a (Heap a) | H2 a !(Heap a) (Heap a) -- Invariant: left child of H2 not empty -- second arg is not empty -- not used! link E h = h link (H1 x b) a = H2 x a b link (H2 x a b) a' = H1 x (union (union a a') b) makeH2 x E xs = H1 x xs makeH2 x h xs = H2 x h xs empty :: Heap a empty = E single :: a -> Heap a single x = H1 x E insert :: Ord a => a -> Heap a -> Heap a insert x E = H1 x E insert x h@(H1 y b) | x <= y = H1 x h | otherwise = H2 y (H1 x E) b insert x h@(H2 y a b) | x <= y = H1 x h | otherwise = H1 y (union (insert x a) b) union :: Ord a => Heap a -> Heap a -> Heap a union E h = h union hx@(H1 x xs) E = hx union hx@(H1 x xs) hy@(H1 y ys) | x <= y = H2 x hy xs | otherwise = H2 y hx ys union hx@(H1 x xs) hy@(H2 y a ys) | x <= y = H2 x hy xs | otherwise = H1 y (union (union hx a) ys) union hx@(H2 x a xs) E = hx union hx@(H2 x a xs) hy@(H1 y ys) | x <= y = H1 x (union (union hy a) xs) | otherwise = H2 y hx ys union hx@(H2 x a xs) hy@(H2 y b ys) | x <= y = H1 x (union (union hy a) xs) | otherwise = H1 y (union (union hx b) ys) delete :: Ord a => a -> Heap a -> Heap a delete y h = case del h of Just h' -> h' Nothing -> h where del E = Nothing del (H1 x xs) = case compare x y of LT -> case del xs of Just xs -> Just (H1 x xs) Nothing -> Nothing EQ -> Just xs GT -> Nothing del (H2 x a xs) = case compare x y of LT -> case del a of Just a' -> Just (makeH2 x a' xs) Nothing -> case del xs of Just xs' -> Just (H2 x a xs') Nothing -> Nothing EQ -> Just (union a xs) GT -> Nothing deleteAll :: Ord a => a -> Heap a -> Heap a deleteAll y E = E deleteAll y h@(H1 x xs) = case compare x y of LT -> H1 x (deleteAll y xs) EQ -> deleteAll y xs GT -> h deleteAll y h@(H2 x a xs) = case compare x y of LT -> makeH2 x (deleteAll y a) (deleteAll y xs) EQ -> union (deleteAll y a) (deleteAll y xs) GT -> h deleteSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a -> Heap a deleteSeq = delList . sort . S.toList where delList [] h = h delList (y:ys) h = del y ys h del y ys E = E del y ys h@(H1 x xs) = case compare x y of LT -> H1 x (del y ys xs) EQ -> delList ys xs GT -> delList ys h del y ys h@(H2 x a xs) = case compare x y of LT -> H1 x (del y ys (union a xs)) EQ -> delList ys (union a xs) GT -> delList ys h {- could write the two GT cases as delList (dropWhile (< x) ys) h but this is only a win if we expect many of the ys to be missing from the tree. However, we expect most of the ys to be present. -} null :: Heap a -> Bool null E = True null _ = False size :: Heap a -> Int size E = 0 size (H1 x xs) = 1 + size xs size (H2 x h xs) = 1 + size h + size xs member :: Ord a => Heap a -> a -> Bool member E x = False member (H1 y ys) x = case compare x y of LT -> False EQ -> True GT -> member ys x member (H2 y h ys) x = case compare x y of LT -> False EQ -> True GT -> member h x || member ys x count :: Ord a => Heap a -> a -> Int count E x = 0 count (H1 y ys) x = case compare x y of LT -> 0 EQ -> 1 + count ys x GT -> count ys x count (H2 y h ys) x = case compare x y of LT -> 0 EQ -> 1 + count h x + count ys x GT -> count h x + count ys x deleteMin :: Ord a => Heap a -> Heap a deleteMin E = E deleteMin (H1 x xs) = xs deleteMin (H2 x h xs) = union h xs unsafeInsertMin :: Ord a => a -> Heap a -> Heap a unsafeInsertMin = H1 unsafeInsertMax :: Ord a => Heap a -> a -> Heap a unsafeInsertMax E x = H1 x E unsafeInsertMax (H1 y ys) x = H2 y (H1 x E) ys unsafeInsertMax (H2 y h ys) x = H1 y (union (unsafeInsertMax h x) ys) unsafeAppend :: Ord a => Heap a -> Heap a -> Heap a unsafeAppend h E = h unsafeAppend E h = h unsafeAppend (H1 x xs) h = H2 x h xs unsafeAppend (H2 x a xs) h = H1 x (union (unsafeAppend a h) xs) filterLT :: Ord a => a -> Heap a -> Heap a filterLT y E = E filterLT y (H1 x xs) | x < y = H1 x (filterLT y xs) | otherwise = E filterLT y (H2 x h xs) | x < y = makeH2 x (filterLT y h) (filterLT y xs) | otherwise = E filterLE :: Ord a => a -> Heap a -> Heap a filterLE y E = E filterLE y (H1 x xs) | x <= y = H1 x (filterLE y xs) | otherwise = E filterLE y (H2 x h xs) | x <= y = makeH2 x (filterLE y h) (filterLE y xs) | otherwise = E filterGT :: Ord a => a -> Heap a -> Heap a filterGT y h = fgt h E where fgt E rest = rest fgt h@(H1 x xs) rest | x > y = union h rest | otherwise = fgt xs rest fgt h@(H2 x a xs) rest | x > y = union h rest | otherwise = fgt a (fgt xs rest) filterGE :: Ord a => a -> Heap a -> Heap a filterGE y h = fge h E where fge E rest = rest fge h@(H1 x xs) rest | x >= y = union h rest | otherwise = fge xs rest fge h@(H2 x a xs) rest | x >= y = union h rest | otherwise = fge a (fge xs rest) partitionLT_GE :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLT_GE y E = (E,E) partitionLT_GE y h@(H1 x xs) | x < y = let (xs',xs'') = partitionLT_GE y xs in (H1 x xs',xs'') | otherwise = (E, h) partitionLT_GE y h@(H2 x a xs) | x < y = let (a',a'') = partitionLT_GE y a (xs',xs'') = partitionLT_GE y xs in (makeH2 x a' xs',union a'' xs'') | otherwise = (E, h) partitionLE_GT :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLE_GT y E = (E,E) partitionLE_GT y h@(H1 x xs) | x <= y = let (xs',xs'') = partitionLE_GT y xs in (H1 x xs',xs'') | otherwise = (E, h) partitionLE_GT y h@(H2 x a xs) | x <= y = let (a',a'') = partitionLE_GT y a (xs',xs'') = partitionLE_GT y xs in (makeH2 x a' xs',union a'' xs'') | otherwise = (E, h) partitionLT_GT :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLT_GT y E = (E,E) partitionLT_GT y h@(H1 x xs) = case compare x y of LT -> let (xs',xs'') = partitionLT_GT y xs in (H1 x xs',xs'') EQ -> (E, filterGT y xs) GT -> (E, h) partitionLT_GT y h@(H2 x a xs) = case compare x y of LT -> let (a',a'') = partitionLT_GT y a (xs',xs'') = partitionLT_GT y xs in (makeH2 x a' xs',union a'' xs'') EQ -> (E, union (filterGT y a) (filterGT y xs)) GT -> (E, h) toSeq :: S.Sequence seq => Heap a -> seq a toSeq h = tol h S.empty where tol E rest = rest tol (H1 x xs) rest = S.cons x (tol xs rest) tol (H2 x h xs) rest = S.cons x (tol h (tol xs rest)) fold :: (a -> b -> b) -> b -> Heap a -> b fold f c E = c fold f c (H1 x xs) = f x (fold f c xs) fold f c (H2 x h xs) = f x (fold f (fold f c xs) h) fold1 :: (a -> a -> a) -> Heap a -> a fold1 f E = error "LazyPairingHeap.fold1: empty heap" fold1 f (H1 x xs) = fold f x xs fold1 f (H2 x h xs) = fold f (fold f x xs) h filter :: Ord a => (a -> Bool) -> Heap a -> Heap a filter p E = E filter p (H1 x xs) = if p x then H1 x (filter p xs) else filter p xs filter p (H2 x h xs) = if p x then makeH2 x (filter p h) (filter p xs) else union (filter p h) (filter p xs) partition :: Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a) partition p E = (E, E) partition p (H1 x xs) = if p x then (H1 x xs',xs'') else (xs',H1 x xs'') where (xs',xs'') = partition p xs partition p (H2 x h xs) = if p x then (makeH2 x h' xs', union h'' xs'') else (union h' xs', makeH2 x h'' xs'') where (h',h'') = partition p h (xs',xs'') = partition p xs lookupAll :: (Ord a,S.Sequence seq) => Heap a -> a -> seq a lookupAll h y = look h S.empty where look E rest = rest look (H1 x xs) rest = case compare x y of LT -> look xs rest EQ -> S.cons x (look xs rest) GT -> rest look (H2 x h xs) rest = case compare x y of LT -> look h (look xs rest) EQ -> S.cons x (look h (look xs rest)) GT -> rest minView :: Ord a => Heap a -> Maybe2 a (Heap a) minView E = Nothing2 minView (H1 x xs) = Just2 x xs minView (H2 x h xs) = Just2 x (union h xs) minElem :: Heap a -> a minElem E = error "LazyPairingHeap.minElem: empty heap" minElem (H1 x xs) = x minElem (H2 x h xs) = x maxView :: Ord a => Heap a -> Maybe2 (Heap a) a maxView E = Nothing2 maxView xs = Just2 xs' y where (xs', y) = maxView' xs -- not exported maxView' (H1 x E) = (E, x) maxView' (H1 x xs) = (H1 x xs', y) where (xs', y) = maxView' xs maxView' (H2 x a E) = (H1 x a', y) where (a', y) = maxView' a maxView' (H2 x a xs) = if y > z then (makeH2 x a' xs, y) else (H2 x a xs', z) where (a', y) = maxView' a (xs', z) = maxView' xs maxElem :: Ord a => Heap a -> a maxElem E = error "LazyPairingHeap.maxElem: empty heap" maxElem (H1 x E) = x maxElem (H1 x xs) = maxElem xs maxElem (H2 x h E) = maxElem h maxElem (H2 x h xs) = max (maxElem h) (maxElem xs) foldr :: Ord a => (a -> b -> b) -> b -> Heap a -> b foldr f c E = c foldr f c (H1 x xs) = f x (foldr f c xs) foldr f c (H2 x h xs) = f x (foldr f c (union h xs)) foldl :: Ord a => (b -> a -> b) -> b -> Heap a -> b foldl f c E = c foldl f c (H1 x xs) = foldl f (f c x) xs foldl f c (H2 x h xs) = foldl f (f c x) (union h xs) foldr1 :: Ord a => (a -> a -> a) -> Heap a -> a foldr1 f E = error "LazyPairingHeap.foldr1: empty heap" foldr1 f (H1 x E) = x foldr1 f (H1 x xs) = f x (foldr1 f xs) foldr1 f (H2 x h xs) = f x (foldr1 f (union h xs)) foldl1 :: Ord a => (a -> a -> a) -> Heap a -> a foldl1 f E = error "LazyPairingHeap.foldl1: empty heap" foldl1 f (H1 x xs) = foldl f x xs foldl1 f (H2 x h xs) = foldl f x (union h xs) unsafeMapMonotonic :: (Ord a,Ord b) => (a -> b) -> Heap a -> Heap b unsafeMapMonotonic = mapm where mapm f E = E mapm f (H1 x xs) = H1 (f x) (mapm f xs) mapm f (H2 x h xs) = H2 (f x) (mapm f h) (mapm f xs) -- the remaining functions all use default definitions fromSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a fromSeq = fromSeqUsingFoldr insertSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a -> Heap a insertSeq = insertSeqUsingFoldr unionSeq :: (Ord a,S.Sequence seq) => seq (Heap a) -> Heap a unionSeq = unionSeqUsingFoldl unsafeFromOrdSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a unsafeFromOrdSeq = unsafeFromOrdSeqUsingUnsafeInsertMin deleteMax :: Ord a => Heap a -> Heap a deleteMax = deleteMaxUsingMaxView lookup :: Ord a => Heap a -> a -> a lookup = lookupUsingLookupAll lookupM :: Ord a => Heap a -> a -> Maybe a lookupM = lookupMUsingLookupAll lookupWithDefault :: Ord a => a -> Heap a -> a -> a lookupWithDefault = lookupWithDefaultUsingLookupAll toOrdSeq :: (Ord a,S.Sequence seq) => Heap a -> seq a toOrdSeq = toOrdSeqUsingFoldr -- instance declarations instance Ord a => C.CollX Heap a where {empty = empty; single = single; fromSeq = fromSeq; insert = insert; insertSeq = insertSeq; union = union; unionSeq = unionSeq; delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; null = null; size = size; member = member; count = count; instanceName c = moduleName} instance Ord a => C.OrdCollX Heap a where {deleteMin = deleteMin; deleteMax = deleteMax; unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; filterGE = filterGE; partitionLT_GE = partitionLT_GE; partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT} instance Ord a => C.Coll Heap a where {toSeq = toSeq; lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; fold = fold; fold1 = fold1; filter = filter; partition = partition} instance Ord a => C.OrdColl Heap a where {minView = minView; minElem = minElem; maxView = maxView; maxElem = maxElem; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; toOrdSeq = toOrdSeq} instance Ord a => Eq (Heap a) where xs == ys = C.toOrdList xs == C.toOrdList ys instance (Ord a, Show a) => Show (Heap a) where show xs = show (C.toOrdList xs) instance (Ord a, Arbitrary a) => Arbitrary (Heap a) where arbitrary = sized (\n -> arbTree n) where arbTree 0 = return E arbTree n = frequency [(1, return E), (2, liftM2 sift1 arbitrary (arbTree (n - 1))), (3, liftM3 sift arbitrary (arbTree (n `div` 4)) (arbTree (n `div` 2)))] sift x E a = sift1 x a sift x a E = let H1 x' a' = sift1 x a in H2 x' a' E sift x a b | x <= ma && x <= mb = H2 x a b | ma < x && ma <= mb = H2 ma (siftInto x a) b | otherwise = H2 mb a (siftInto x b) where ma = minElem a mb = minElem b sift1 x E = H1 x E sift1 x a | x <= ma = H1 x a | otherwise = H1 ma (siftInto x a) where ma = minElem a siftInto x (H1 _ a) = sift1 x a siftInto x (H2 _ a b) = sift x a b coarbitrary E = variant 0 coarbitrary (H1 x a) = variant 1 . coarbitrary x . coarbitrary a coarbitrary (H2 x a b) = variant 2 . coarbitrary x . coarbitrary a . coarbitrary b hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/LeftistHeap.hs0000644006511100651110000003116510130752023023563 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module LeftistHeap {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of leftist heaps Heap, -- instance of Coll/CollX, OrdColl/OrdCollX -- CollX operations empty,single,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll, deleteSeq,null,size,member,count, -- Coll operations toSeq, lookup, lookupM, lookupAll, lookupWithDefault, fold, fold1, filter, partition, -- OrdCollX operations deleteMin,deleteMax,unsafeInsertMin,unsafeInsertMax,unsafeFromOrdSeq, unsafeAppend,filterLT,filterLE,filterGT,filterGE,partitionLT_GE, partitionLE_GT,partitionLT_GT, -- OrdColl operations minView,minElem,maxView,maxElem,foldr,foldl,foldr1,foldl1,toOrdSeq, -- other supported operations unsafeMapMonotonic, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import EdisonPrelude(Maybe2(..)) import qualified Collection as C ( CollX(..), OrdCollX(..), Coll(..), OrdColl(..), unionList, toOrdList ) import qualified Sequence as S import CollectionDefaults import Monad import QuickCheck moduleName = "LeftistHeap" -- Adapted from -- Chris Okasaki. Purely Functional Data Structures. 1998. -- Section 3.1. data Heap a = E | L !Int a !(Heap a) !(Heap a) -- want to say !a, but would need Eval a context node x a E = L 1 x a E node x E b = L 1 x b E node x a@(L m _ _ _) b@(L n _ _ _) | m <= n = L (m + 1) x b a | otherwise = L (n + 1) x a b {- Note: when we want to recurse down both sides, and we have a choice, recursing down the smaller side first will minimize stack usage. For delete,deleteAll,filter,partition: could compute fringe and reduce rather that rebuilding with union at every deleted node -} empty :: Ord a => Heap a empty = E single :: Ord a => a -> Heap a single x = L 1 x E E insert :: Ord a => a -> Heap a -> Heap a insert x E = L 1 x E E insert x h@(L m y a b) | x <= y = L 1 x h E | otherwise = node y a (insert x b) union :: Ord a => Heap a -> Heap a -> Heap a union E h = h union h@(L _ x a b) h' = union' h x a b h' where union' h x a b E = h union' hx x a b hy@(L _ y c d) | x <= y = node x a (union' hy y c d b) | otherwise = node y c (union' hx x a b d) {- union E h = h union h E = h union h1@(L _ x a b) h2@(L _ y c d) | x <= y = node x a (union b h2) | otherwise = node y c (union h1 d) -- ??? optimize to catch fact that h1 or h2 is known to be L case? -} delete :: Ord a => a -> Heap a -> Heap a delete x h = case del h of Just h' -> h' Nothing -> h where del (L _ y a b) = case compare x y of LT -> Nothing EQ -> Just (union a b) GT -> case del b of Just b' -> Just (node y a b') Nothing -> case del a of Just a' -> Just (node y a' b) Nothing -> Nothing del E = Nothing deleteAll :: Ord a => a -> Heap a -> Heap a deleteAll x h@(L _ y a b) = case compare x y of LT -> h EQ -> union (deleteAll x a) (deleteAll x b) GT -> node y (deleteAll x a) (deleteAll x b) deleteAll x E = E null :: Ord a => Heap a -> Bool null E = True null _ = False size :: Ord a => Heap a -> Int size h = sz h 0 where sz E i = i sz (L _ _ a b) i = sz a (sz b (i + 1)) member :: Ord a => Heap a -> a -> Bool member E x = False member (L _ y a b) x = case compare x y of LT -> False EQ -> True GT -> member b x || member a x count :: Ord a => Heap a -> a -> Int count E x = 0 count (L _ y a b) x = case compare x y of LT -> 0 EQ -> 1 + count b x + count a x GT -> count b x + count a x toSeq :: (Ord a,S.Sequence seq) => Heap a -> seq a toSeq h = tol h S.empty where tol E rest = rest tol (L _ x a b) rest = S.cons x (tol b (tol a rest)) lookupM :: Ord a => Heap a -> a -> Maybe a lookupM E x = Nothing lookupM (L _ y a b) x = case compare x y of LT -> Nothing EQ -> Just y GT -> lookupM b x `mplus` lookupM a x lookupAll :: (Ord a,S.Sequence seq) => Heap a -> a -> seq a lookupAll h x = look h S.empty where look E ys = ys look (L _ y a b) ys = case compare x y of LT -> ys EQ -> S.cons y (look b (look a ys)) GT -> look b (look a ys) fold :: Ord a => (a -> b -> b) -> b -> Heap a -> b fold f e E = e fold f e (L _ x a b) = f x (fold f (fold f e a) b) fold1 :: Ord a => (a -> a -> a) -> Heap a -> a fold1 f E = error "LeftistHeap.fold1: empty collection" fold1 f (L _ x a b) = fold f (fold f x a) b filter :: Ord a => (a -> Bool) -> Heap a -> Heap a filter p E = E filter p (L _ x a b) | p x = node x (filter p a) (filter p b) | otherwise = union (filter p a) (filter p b) partition :: Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a) partition p E = (E, E) partition p (L _ x a b) | p x = (node x a' b', union a'' b'') | otherwise = (union a' b', node x a'' b'') where (a', a'') = partition p a (b', b'') = partition p b deleteMin :: Ord a => Heap a -> Heap a deleteMin E = E deleteMin (L _ x a b) = union a b deleteMax :: Ord a => Heap a -> Heap a deleteMax h = case maxView h of Nothing2 -> E Just2 h' x -> h' unsafeInsertMin :: Ord a => a -> Heap a -> Heap a unsafeInsertMin x h = L 1 x h E unsafeAppend :: Ord a => Heap a -> Heap a -> Heap a unsafeAppend E h = h unsafeAppend (L _ y a b) h = node y a (unsafeAppend b h) filterLT :: Ord a => a -> Heap a -> Heap a filterLT y (L _ x a b) | x < y = node x (filterLT y a) (filterLT y b) filterLT y _ = E filterLE :: Ord a => a -> Heap a -> Heap a filterLE y (L _ x a b) | x <= y = node x (filterLE y a) (filterLE y b) filterLE y _ = E filterGT :: Ord a => a -> Heap a -> Heap a filterGT y h = C.unionList (collect h []) where collect E hs = hs collect h@(L _ x a b) hs | x > y = h : hs | otherwise = collect a (collect b hs) filterGE :: Ord a => a -> Heap a -> Heap a filterGE y h = C.unionList (collect h []) where collect E hs = hs collect h@(L _ x a b) hs | x >= y = h : hs | otherwise = collect b (collect a hs) partitionLT_GE :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLT_GE y h = (h', C.unionList hs) where (h', hs) = collect h [] collect E hs = (E, hs) collect h@(L _ x a b) hs | x >= y = (E, h:hs) | otherwise = let (a', hs') = collect a hs (b', hs'') = collect b hs' in (node x a' b', hs'') partitionLE_GT :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLE_GT y h = (h', C.unionList hs) where (h', hs) = collect h [] collect E hs = (E, hs) collect h@(L _ x a b) hs | x > y = (E, h:hs) | otherwise = let (a', hs') = collect a hs (b', hs'') = collect b hs' in (node x a' b', hs'') partitionLT_GT :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLT_GT y h = (h', C.unionList hs) where (h', hs) = collect h [] collect E hs = (E, hs) collect h@(L _ x a b) hs = case compare x y of GT -> (E, h:hs) EQ -> let (a', hs') = collect a hs (b', hs'') = collect b hs' in (union a' b', hs'') LT -> let (a', hs') = collect a hs (b', hs'') = collect b hs' in (node x a' b', hs'') minView :: Ord a => Heap a -> Maybe2 a (Heap a) minView E = Nothing2 minView (L _ x a b) = Just2 x (union a b) minElem :: Ord a => Heap a -> a minElem E = error "LeftistHeap.minElem: empty collection" minElem (L _ x a b) = x maxView :: Ord a => Heap a -> Maybe2 (Heap a) a maxView E = Nothing2 maxView (L _ x E _) = Just2 E x maxView (L _ x a E) = Just2 (L 1 x a' E) y where Just2 a' y = maxView a maxView (L _ x a b) | y >= z = Just2 (node x a' b) y | otherwise = Just2 (node x a b') z where Just2 a' y = maxView a Just2 b' z = maxView b -- warning: maxView and maxElem may disagree if root is equal to max! maxElem :: Ord a => Heap a -> a maxElem E = error "LeftistHeap.maxElem: empty collection" maxElem (L _ x E _) = x maxElem (L _ x a b) = findMax b (findLeaf a) where findMax E m = m findMax (L _ x E _) m | m >= x = m | otherwise = x findMax (L _ x a b) m = findMax a (findMax b m) findLeaf E = error "LeftistHeap.maxElem: bug" findLeaf (L _ x E _) = x findLeaf (L _ x a b) = findMax b (findLeaf a) foldr :: Ord a => (a -> b -> b) -> b -> Heap a -> b foldr f e E = e foldr f e (L _ x a b) = f x (foldr f e (union a b)) foldl :: Ord a => (b -> a -> b) -> b -> Heap a -> b foldl f e E = e foldl f e (L _ x a b) = foldl f (f e x) (union a b) foldr1 :: Ord a => (a -> a -> a) -> Heap a -> a foldr1 f E = error "LeftistHeap.foldr1: empty collection" foldr1 f (L _ x E _) = x foldr1 f (L _ x a b) = f x (foldr1 f (union a b)) foldl1 :: Ord a => (a -> a -> a) -> Heap a -> a foldl1 f E = error "LeftistHeap.foldl1: empty collection" foldl1 f (L _ x a b) = foldl f x (union a b) {- ???? -} unsafeMapMonotonic :: Ord a => (a -> a) -> Heap a -> Heap a unsafeMapMonotonic f E = E unsafeMapMonotonic f (L i x a b) = L i (f x) (unsafeMapMonotonic f a) (unsafeMapMonotonic f b) -- the remaining functions all use default definitions fromSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a fromSeq = fromSeqUsingUnionSeq insertSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a -> Heap a insertSeq = insertSeqUsingUnion unionSeq :: (Ord a,S.Sequence seq) => seq (Heap a) -> Heap a unionSeq = unionSeqUsingReduce deleteSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a -> Heap a deleteSeq = deleteSeqUsingDelete lookup :: Ord a => Heap a -> a -> a lookup = lookupUsingLookupM lookupWithDefault :: Ord a => a -> Heap a -> a -> a lookupWithDefault = lookupWithDefaultUsingLookupM unsafeInsertMax :: Ord a => Heap a -> a -> Heap a unsafeInsertMax = unsafeInsertMaxUsingUnsafeAppend unsafeFromOrdSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a unsafeFromOrdSeq = unsafeFromOrdSeqUsingUnsafeInsertMin toOrdSeq :: (Ord a,S.Sequence seq) => Heap a -> seq a toOrdSeq = toOrdSeqUsingFoldr -- instance declarations instance Ord a => C.CollX Heap a where {empty = empty; single = single; fromSeq = fromSeq; insert = insert; insertSeq = insertSeq; union = union; unionSeq = unionSeq; delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; null = null; size = size; member = member; count = count; instanceName c = moduleName} instance Ord a => C.OrdCollX Heap a where {deleteMin = deleteMin; deleteMax = deleteMax; unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; filterGE = filterGE; partitionLT_GE = partitionLT_GE; partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT} instance Ord a => C.Coll Heap a where {toSeq = toSeq; lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; fold = fold; fold1 = fold1; filter = filter; partition = partition} instance Ord a => C.OrdColl Heap a where {minView = minView; minElem = minElem; maxView = maxView; maxElem = maxElem; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; toOrdSeq = toOrdSeq} instance Ord a => Eq (Heap a) where xs == ys = C.toOrdList xs == C.toOrdList ys instance (Ord a, Show a) => Show (Heap a) where show xs = show (C.toOrdList xs) instance (Ord a, Arbitrary a) => Arbitrary (Heap a) where arbitrary = sized (\n -> arbTree n) where arbTree 0 = return E arbTree n = frequency [(1, return E), (4, liftM3 snode arbitrary (arbTree (n `div` 2)) (arbTree (n `div` 4)))] snode x a b = sift (node x a b) sift E = E sift t@(L _ x a E) | a == E || x <= minElem a = t sift (L r x (L r' y a b) E) = L r y (sift (L r' x a b)) E sift t@(L r x a b) | x <= minElem a && x <= minElem b = t sift (L r x (L r' y a b) c) | y <= minElem c = L r y (sift (L r' x a b)) c sift (L r x a (L r' y b c)) = L r y a (sift (L r' x b c)) coarbitrary E = variant 0 coarbitrary (L _ x a b) = variant 1 . coarbitrary x . coarbitrary a . coarbitrary b hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/MinHeap.hs0000644006511100651110000002467710130752023022706 0ustar rossross-- Copyright (c) 1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module MinHeap {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- generic adaptor for bags to keep the minimum element separately Min, -- instance of Coll/CollX, OrdColl/OrdCollX -- CollX operations empty,single,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll, deleteSeq,null,size,member,count, -- Coll operations toSeq, lookup, lookupM, lookupAll, lookupWithDefault, fold, fold1, filter, partition, -- OrdCollX operations deleteMin,deleteMax,unsafeInsertMin,unsafeInsertMax,unsafeFromOrdSeq, unsafeAppend,filterLT,filterLE,filterGT,filterGE,partitionLT_GE, partitionLE_GT,partitionLT_GT, -- OrdColl operations minView,minElem,maxView,maxElem,foldr,foldl,foldr1,foldl1,toOrdSeq, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import EdisonPrelude(Maybe2(..)) import qualified Collection as C import qualified Sequence as S import CollectionDefaults import Monad import QuickCheck data Min h a = E | M a (h a) deriving (Eq) -- NB: this 'deriving' will only work if we have -- -fallow-undecidable-instances -- The derived instance decl has form -- instance (Eq a, Eq (h a)) => Eq (Min h a) -- which needs the undecidable instances flag. moduleName = "MinHeap" instanceName E = "MinHeap(empty)" instanceName (M x h) = "MinHeap(" ++ C.instanceName h ++ ")" empty :: Min h a single :: (C.CollX h a,Ord a) => a -> Min h a fromSeq :: (C.OrdColl h a,Ord a,S.Sequence s) => s a -> Min h a insert :: (C.OrdCollX h a,Ord a) => a -> Min h a -> Min h a insertSeq :: (C.OrdColl h a,Ord a,S.Sequence s) => s a -> Min h a -> Min h a union :: (C.OrdCollX h a,Ord a) => Min h a -> Min h a -> Min h a unionSeq :: (C.OrdColl h a,Ord a,S.Sequence s) => s (Min h a) -> Min h a delete :: (C.OrdColl h a,Ord a) => a -> Min h a -> Min h a deleteAll :: (C.OrdColl h a,Ord a) => a -> Min h a -> Min h a deleteSeq :: (C.OrdColl h a,Ord a,S.Sequence s) => s a -> Min h a -> Min h a null :: Min h a -> Bool size :: C.CollX h a => Min h a -> Int member :: (C.CollX h a,Ord a) => Min h a -> a -> Bool count :: (C.CollX h a,Ord a) => Min h a -> a -> Int toSeq :: (C.Coll h a,S.Sequence s) => Min h a -> s a lookup :: (C.Coll h a,Ord a) => Min h a -> a -> a lookupM :: (C.Coll h a,Ord a) => Min h a -> a -> Maybe a lookupAll :: (C.Coll h a,Ord a,S.Sequence s) => Min h a -> a -> s a lookupWithDefault :: (C.Coll h a,Ord a) => a -> Min h a -> a -> a fold :: (C.Coll h a) => (a -> b -> b) -> b -> Min h a -> b fold1 :: (C.Coll h a) => (a -> a -> a) -> Min h a -> a filter :: (C.OrdColl h a) => (a -> Bool) -> Min h a -> Min h a partition :: (C.OrdColl h a) => (a -> Bool) -> Min h a -> (Min h a, Min h a) deleteMin :: (C.OrdColl h a,Ord a) => Min h a -> Min h a deleteMax :: (C.OrdCollX h a,Ord a) => Min h a -> Min h a unsafeInsertMin :: (C.OrdCollX h a,Ord a) => a -> Min h a -> Min h a unsafeInsertMax :: (C.OrdCollX h a,Ord a) => Min h a -> a -> Min h a unsafeFromOrdSeq :: (C.OrdCollX h a,Ord a,S.Sequence s) => s a -> Min h a unsafeAppend :: (C.OrdCollX h a,Ord a) => Min h a -> Min h a -> Min h a filterLT :: (C.OrdCollX h a,Ord a) => a -> Min h a -> Min h a filterLE :: (C.OrdCollX h a,Ord a) => a -> Min h a -> Min h a filterGT :: (C.OrdColl h a,Ord a) => a -> Min h a -> Min h a filterGE :: (C.OrdColl h a,Ord a) => a -> Min h a -> Min h a partitionLT_GE :: (C.OrdColl h a,Ord a) => a -> Min h a -> (Min h a, Min h a) partitionLE_GT :: (C.OrdColl h a,Ord a) => a -> Min h a -> (Min h a, Min h a) partitionLT_GT :: (C.OrdColl h a,Ord a) => a -> Min h a -> (Min h a, Min h a) minView :: (C.OrdColl h a,Ord a) => Min h a -> Maybe2 a (Min h a) minElem :: (C.OrdColl h a,Ord a) => Min h a -> a maxView :: (C.OrdColl h a,Ord a) => Min h a -> Maybe2 (Min h a) a maxElem :: (C.OrdColl h a,Ord a) => Min h a -> a foldr :: (C.OrdColl h a,Ord a) => (a -> b -> b) -> b -> Min h a -> b foldl :: (C.OrdColl h a,Ord a) => (b -> a -> b) -> b -> Min h a -> b foldr1 :: (C.OrdColl h a,Ord a) => (a -> a -> a) -> Min h a -> a foldl1 :: (C.OrdColl h a,Ord a) => (a -> a -> a) -> Min h a -> a toOrdSeq :: (C.OrdColl h a,Ord a,S.Sequence s) => Min h a -> s a -- export? fromPrim xs = case C.minView xs of Nothing2 -> E Just2 x xs' -> M x xs' -- export? toPrim E = C.empty toPrim (M x xs) = C.unsafeInsertMin x xs empty = E single x = M x C.empty fromSeq = fromPrim . C.fromSeq insert x E = M x C.empty insert x (M y xs) | x <= y = M x (C.unsafeInsertMin y xs) | otherwise = M y (C.insert x xs) insertSeq xs E = fromSeq xs insertSeq xs (M y ys) = case C.minView xs_ys of Nothing2 -> M y C.empty Just2 x rest | x < y -> M x (C.insert y rest) | otherwise -> M y xs_ys where xs_ys = C.insertSeq xs ys union E ys = ys union xs E = xs union (M x xs) (M y ys) | x <= y = M x (C.union xs (C.unsafeInsertMin y ys)) | otherwise = M y (C.union (C.unsafeInsertMin x xs) ys) unionSeq = unionSeqUsingReduce delete x E = E delete x m@(M y ys) | x > y = M y (C.delete x ys) | x == y = fromPrim ys | otherwise = m deleteAll x E = E deleteAll x m@(M y ys) | x > y = M y (C.deleteAll x ys) | x == y = fromPrim (C.deleteAll x ys) | otherwise = m deleteSeq = deleteSeqUsingDelete null E = True null (M x xs) = False size E = 0 size (M x xs) = 1 + C.size xs member E x = False member (M y ys) x | x > y = C.member ys x | otherwise = (x == y) count E x = 0 count (M y ys) x | x > y = C.count ys x | x == y = 1 + C.count ys x | otherwise = 0 toSeq E = S.empty toSeq (M x xs) = S.cons x (C.toSeq xs) lookup (M y ys) x | x > y = C.lookup ys x | x == y = y lookup _ _ = error "MinHeap.lookup: empty heap" lookupM (M y ys) x | x > y = C.lookupM ys x | x == y = Just y lookupM _ _ = Nothing lookupAll (M y ys) x | x > y = C.lookupAll ys x | x == y = S.cons y (C.lookupAll ys x) lookupAll _ _ = S.empty lookupWithDefault d (M y ys) x | x > y = C.lookupWithDefault d ys x | x == y = y lookupWithDefault d _ _ = d fold f e E = e fold f e (M x xs) = f x (C.fold f e xs) fold1 f E = error "MinHeap.fold1: empty heap" fold1 f (M x xs) = C.fold f x xs filter p E = E filter p (M x xs) | p x = M x (C.filter p xs) | otherwise = fromPrim (C.filter p xs) partition p E = (E, E) partition p (M x xs) | p x = (M x ys, fromPrim zs) | otherwise = (fromPrim ys, M x zs) where (ys,zs) = C.partition p xs deleteMin E = E deleteMin (M x xs) = fromPrim xs deleteMax E = E deleteMax (M x xs) | C.null xs = E | otherwise = M x (C.deleteMax xs) unsafeInsertMin x xs = M x (toPrim xs) unsafeInsertMax E x = M x C.empty unsafeInsertMax (M y ys) x = M y (C.unsafeInsertMax ys x) unsafeFromOrdSeq xs = case S.lview xs of Nothing2 -> E Just2 x xs' -> M x (C.unsafeFromOrdSeq xs') unsafeAppend E ys = ys unsafeAppend (M x xs) ys = M x (C.unsafeAppend xs (toPrim ys)) filterLT x (M y ys) | y < x = M y (C.filterLT x ys) filterLT _ _ = E filterLE x (M y ys) | y <= x = M y (C.filterLE x ys) filterLE _ _ = E filterGT x (M y ys) | y <= x = fromPrim (C.filterGT x ys) filterGT x h = h filterGE x (M y ys) | y < x = fromPrim (C.filterGE x ys) filterGE x h = h partitionLT_GE x (M y ys) | y < x = (M y lows, fromPrim highs) where (lows,highs) = C.partitionLT_GE x ys partitionLT_GE x h = (E, h) partitionLE_GT x (M y ys) | y <= x = (M y lows, fromPrim highs) where (lows,highs) = C.partitionLE_GT x ys partitionLE_GT x h = (E, h) partitionLT_GT x (M y ys) | y < x = let (lows,highs) = C.partitionLT_GT x ys in (M y lows, fromPrim highs) | y == x = (E, fromPrim (C.filterGT x ys)) partitionLT_GT x h = (E, h) minView E = Nothing2 minView (M x xs) = Just2 x (fromPrim xs) minElem E = error "MinHeap.minElem: empty heap" minElem (M x xs) = x maxView E = Nothing2 maxView (M x xs) = case C.maxView xs of Nothing2 -> Just2 E x Just2 ys y -> Just2 (M x ys) y maxElem E = error "MinHeap.minElem: empty heap" maxElem (M x xs) | C.null xs = x | otherwise = C.maxElem xs foldr f e E = e foldr f e (M x xs) = f x (C.foldr f e xs) foldl f e E = e foldl f e (M x xs) = C.foldl f (f e x) xs foldr1 f E = error "MinHeap.foldr1: empty heap" foldr1 f (M x xs) | C.null xs = x | otherwise = f x (C.foldr1 f xs) foldl1 f E = error "MinHeap.foldl1: empty heap" foldl1 f (M x xs) = C.foldl f x xs toOrdSeq E = S.empty toOrdSeq (M x xs) = S.cons x (C.toOrdSeq xs) -- instance declarations instance (C.OrdColl h a, Ord a) => C.CollX (Min h) a where {empty = empty; single = single; fromSeq = fromSeq; insert = insert; insertSeq = insertSeq; union = union; unionSeq = unionSeq; delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; null = null; size = size; member = member; count = count; instanceName c = moduleName} instance (C.OrdColl h a, Ord a) => C.OrdCollX (Min h) a where {deleteMin = deleteMin; deleteMax = deleteMax; unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; filterGE = filterGE; partitionLT_GE = partitionLT_GE; partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT} instance (C.OrdColl h a, Ord a) => C.Coll (Min h) a where {toSeq = toSeq; lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; fold = fold; fold1 = fold1; filter = filter; partition = partition} instance (C.OrdColl h a, Ord a) => C.OrdColl (Min h) a where {minView = minView; minElem = minElem; maxView = maxView; maxElem = maxElem; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; toOrdSeq = toOrdSeq} -- instance Eq is derived instance (C.OrdColl h a, Show a) => Show (Min h a) where show xs = show (C.toOrdList xs) instance (C.OrdColl h a,Arbitrary (h a),Arbitrary a) => Arbitrary (Min h a) where arbitrary = do xs <- arbitrary x <- arbitrary i <- arbitrary :: Gen Int return (if C.null xs || x <= C.minElem xs then M x xs else if odd i then M (C.minElem xs) xs else fromPrim xs) coarbitrary E = variant 0 coarbitrary (M x xs) = variant 1 . coarbitrary x . coarbitrary xs hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/SkewHeap.hs0000644006511100651110000002771010130752023023063 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module SkewHeap {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of skew heaps Heap, -- instance of Coll/CollX, OrdColl/OrdCollX -- CollX operations empty,single,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll, deleteSeq,null,size,member,count, -- Coll operations toSeq, lookup, lookupM, lookupAll, lookupWithDefault, fold, fold1, filter, partition, -- OrdCollX operations deleteMin,deleteMax,unsafeInsertMin,unsafeInsertMax,unsafeFromOrdSeq, unsafeAppend,filterLT,filterLE,filterGT,filterGE,partitionLT_GE, partitionLE_GT,partitionLT_GT, -- OrdColl operations minView,minElem,maxView,maxElem,foldr,foldl,foldr1,foldl1,toOrdSeq, -- other supported operations unsafeMapMonotonic, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import EdisonPrelude(Maybe2(..)) import qualified Collection as C import qualified Sequence as S import CollectionDefaults import Monad import QuickCheck moduleName = "SkewHeap" -- Adapted from -- Daniel Sleator and Robert Tarjan. "Self-Adjusting Heaps". -- SIAM Journal on Computing, 15(1):52-69, February 1986. data Heap a = E | T a (Heap a) (Heap a) {- For delete,deleteAll,filter,partition: could compute fringe and reduce rather that rebuilding with union at every deleted node -} empty :: Ord a => Heap a empty = E single :: Ord a => a -> Heap a single x = T x E E insert :: Ord a => a -> Heap a -> Heap a insert x E = T x E E insert x h@(T y a b) | x <= y = T x h E | otherwise = T y (insert x b) a union :: Ord a => Heap a -> Heap a -> Heap a union E h = h union h@(T x a b) h' = union' h x a b h' where union' h x a b E = h union' hx x a b hy@(T y c d) | x <= y = T x (union' hy y c d b) a | otherwise = T y (union' hx x a b d) c delete :: Ord a => a -> Heap a -> Heap a delete x h = case del h of Just h' -> h' Nothing -> h where del (T y a b) = case compare x y of LT -> Nothing EQ -> Just (union a b) GT -> case del b of Just b' -> Just (T y a b') Nothing -> case del a of Just a' -> Just (T y a' b) Nothing -> Nothing del E = Nothing deleteAll :: Ord a => a -> Heap a -> Heap a deleteAll x h@(T y a b) = case compare x y of LT -> h EQ -> union (deleteAll x a) (deleteAll x b) GT -> T y (deleteAll x a) (deleteAll x b) deleteAll x E = E null :: Ord a => Heap a -> Bool null E = True null _ = False size :: Ord a => Heap a -> Int size h = sz h 0 where sz E i = i sz (T _ a b) i = sz a (sz b (i + 1)) member :: Ord a => Heap a -> a -> Bool member E x = False member (T y a b) x = case compare x y of LT -> False EQ -> True GT -> member b x || member a x count :: Ord a => Heap a -> a -> Int count E x = 0 count (T y a b) x = case compare x y of LT -> 0 EQ -> 1 + count b x + count a x GT -> count b x + count a x toSeq :: (Ord a,S.Sequence seq) => Heap a -> seq a toSeq h = tol h S.empty where tol E rest = rest tol (T x a b) rest = S.cons x (tol b (tol a rest)) lookupM :: Ord a => Heap a -> a -> Maybe a lookupM E x = Nothing lookupM (T y a b) x = case compare x y of LT -> Nothing EQ -> Just y GT -> lookupM b x `mplus` lookupM a x lookupAll :: (Ord a,S.Sequence seq) => Heap a -> a -> seq a lookupAll h x = look h S.empty where look E ys = ys look (T y a b) ys = case compare x y of LT -> ys EQ -> S.cons y (look b (look a ys)) GT -> look b (look a ys) fold :: Ord a => (a -> b -> b) -> b -> Heap a -> b fold f e E = e fold f e (T x a b) = f x (fold f (fold f e a) b) fold1 :: Ord a => (a -> a -> a) -> Heap a -> a fold1 f E = error "SkewHeap.fold1: empty collection" fold1 f (T x a b) = fold f (fold f x a) b filter :: Ord a => (a -> Bool) -> Heap a -> Heap a filter p E = E filter p (T x a b) | p x = T x (filter p a) (filter p b) | otherwise = union (filter p a) (filter p b) partition :: Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a) partition p E = (E, E) partition p (T x a b) | p x = (T x a' b', union a'' b'') | otherwise = (union a' b', T x a'' b'') where (a', a'') = partition p a (b', b'') = partition p b deleteMin :: Ord a => Heap a -> Heap a deleteMin E = E deleteMin (T x a b) = union a b deleteMax :: Ord a => Heap a -> Heap a deleteMax h = case maxView h of Nothing2 -> E Just2 h' x -> h' unsafeInsertMin :: Ord a => a -> Heap a -> Heap a unsafeInsertMin x h = T x h E unsafeAppend :: Ord a => Heap a -> Heap a -> Heap a unsafeAppend E h = h unsafeAppend (T x a b) h = T x (unsafeAppend b h) a filterLT :: Ord a => a -> Heap a -> Heap a filterLT y (T x a b) | x < y = T x (filterLT y a) (filterLT y b) filterLT y _ = E filterLE :: Ord a => a -> Heap a -> Heap a filterLE y (T x a b) | x <= y = T x (filterLE y a) (filterLE y b) filterLE y _ = E filterGT :: Ord a => a -> Heap a -> Heap a filterGT y h = C.unionList (collect h []) where collect E hs = hs collect h@(T x a b) hs | x > y = h : hs | otherwise = collect a (collect b hs) filterGE :: Ord a => a -> Heap a -> Heap a filterGE y h = C.unionList (collect h []) where collect E hs = hs collect h@(T x a b) hs | x >= y = h : hs | otherwise = collect b (collect a hs) partitionLT_GE :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLT_GE y h = (h', C.unionList hs) where (h', hs) = collect h [] collect E hs = (E, hs) collect h@(T x a b) hs | x >= y = (E, h:hs) | otherwise = let (a', hs') = collect a hs (b', hs'') = collect b hs' in (T x a' b', hs'') partitionLE_GT :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLE_GT y h = (h', C.unionList hs) where (h', hs) = collect h [] collect E hs = (E, hs) collect h@(T x a b) hs | x > y = (E, h:hs) | otherwise = let (a', hs') = collect a hs (b', hs'') = collect b hs' in (T x a' b', hs'') partitionLT_GT :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLT_GT y h = (h', C.unionList hs) where (h', hs) = collect h [] collect E hs = (E, hs) collect h@(T x a b) hs = case compare x y of GT -> (E, h:hs) EQ -> let (a', hs') = collect a hs (b', hs'') = collect b hs' in (union a' b', hs'') LT -> let (a', hs') = collect a hs (b', hs'') = collect b hs' in (T x a' b', hs'') minView :: Ord a => Heap a -> Maybe2 a (Heap a) minView E = Nothing2 minView (T x a b) = Just2 x (union a b) minElem :: Ord a => Heap a -> a minElem E = error "SkewHeap.minElem: empty collection" minElem (T x a b) = x maxView :: Ord a => Heap a -> Maybe2 (Heap a) a maxView E = Nothing2 maxView (T x E E) = Just2 E x maxView (T x a E) = Just2 (T x a' E) y where Just2 a' y = maxView a maxView (T x E a) = Just2 (T x a' E) y where Just2 a' y = maxView a maxView (T x a b) | y >= z = Just2 (T x a' b) y | otherwise = Just2 (T x a b') z where Just2 a' y = maxView a Just2 b' z = maxView b -- warning: maxView and maxElem may disagree if root is equal to max! maxElem :: Ord a => Heap a -> a maxElem E = error "SkewHeap.maxElem: empty collection" maxElem (T x E E) = x maxElem (T x a E) = maxElem a maxElem (T x E a) = maxElem a maxElem (T x a b) = findMax b (findLeaf a) where findMax E m = m findMax (T x E E) m | m >= x = m | otherwise = x findMax (T x a E) m = findMax a m findMax (T x E a) m = findMax a m findMax (T x a b) m = findMax a (findMax b m) findLeaf E = error "SkewHeap.maxElem: bug" findLeaf (T x E E) = x findLeaf (T x a E) = findLeaf a findLeaf (T x E a) = findLeaf a findLeaf (T x a b) = findMax b (findLeaf a) foldr :: Ord a => (a -> b -> b) -> b -> Heap a -> b foldr f e E = e foldr f e (T x a b) = f x (foldr f e (union a b)) foldl :: Ord a => (b -> a -> b) -> b -> Heap a -> b foldl f e E = e foldl f e (T x a b) = foldl f (f e x) (union a b) foldr1 :: Ord a => (a -> a -> a) -> Heap a -> a foldr1 f E = error "SkewHeap.foldr1: empty collection" foldr1 f (T x E E) = x foldr1 f (T x a b) = f x (foldr1 f (union a b)) foldl1 :: Ord a => (a -> a -> a) -> Heap a -> a foldl1 f E = error "SkewHeap.foldl1: empty collection" foldl1 f (T x a b) = foldl f x (union a b) {- ???? -} unsafeMapMonotonic :: Ord a => (a -> a) -> Heap a -> Heap a unsafeMapMonotonic f E = E unsafeMapMonotonic f (T x a b) = T (f x) (unsafeMapMonotonic f a) (unsafeMapMonotonic f b) -- the remaining functions all use default definitions fromSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a fromSeq = fromSeqUsingUnionSeq insertSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a -> Heap a insertSeq = insertSeqUsingUnion unionSeq :: (Ord a,S.Sequence seq) => seq (Heap a) -> Heap a unionSeq = unionSeqUsingReduce deleteSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a -> Heap a deleteSeq = deleteSeqUsingDelete lookup :: Ord a => Heap a -> a -> a lookup = lookupUsingLookupM lookupWithDefault :: Ord a => a -> Heap a -> a -> a lookupWithDefault = lookupWithDefaultUsingLookupM unsafeInsertMax :: Ord a => Heap a -> a -> Heap a unsafeInsertMax = unsafeInsertMaxUsingUnsafeAppend unsafeFromOrdSeq :: (Ord a,S.Sequence seq) => seq a -> Heap a unsafeFromOrdSeq = unsafeFromOrdSeqUsingUnsafeInsertMin toOrdSeq :: (Ord a,S.Sequence seq) => Heap a -> seq a toOrdSeq = toOrdSeqUsingFoldr -- instance declarations instance Ord a => C.CollX Heap a where {empty = empty; single = single; fromSeq = fromSeq; insert = insert; insertSeq = insertSeq; union = union; unionSeq = unionSeq; delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; null = null; size = size; member = member; count = count; instanceName c = moduleName} instance Ord a => C.OrdCollX Heap a where {deleteMin = deleteMin; deleteMax = deleteMax; unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; filterGE = filterGE; partitionLT_GE = partitionLT_GE; partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT} instance Ord a => C.Coll Heap a where {toSeq = toSeq; lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; fold = fold; fold1 = fold1; filter = filter; partition = partition} instance Ord a => C.OrdColl Heap a where {minView = minView; minElem = minElem; maxView = maxView; maxElem = maxElem; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; toOrdSeq = toOrdSeq} instance Ord a => Eq (Heap a) where xs == ys = C.toOrdList xs == C.toOrdList ys instance (Ord a, Show a) => Show (Heap a) where show xs = show (C.toOrdList xs) instance (Ord a, Arbitrary a) => Arbitrary (Heap a) where arbitrary = sized (\n -> arbTree n) where arbTree 0 = return E arbTree n = frequency [(1, return E), (4, liftM3 sift arbitrary (arbTree (n `div` 2)) (arbTree (n `div` 4)))] sift x s@(T y a b) E | y < x = T y (sift x a b) E sift x E s@(T y a b) | y < x = T y E (sift x a b) sift x s@(T y a b) t@(T z c d) | y < x && y <= z = T y (sift x a b) t | z < x = T z s (sift x c d) sift x a b = T x a b coarbitrary E = variant 0 coarbitrary (T x a b) = variant 1 . coarbitrary x . coarbitrary a . coarbitrary b hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/SplayHeap.hs0000644006511100651110000003066310130752023023243 0ustar rossross-- Copyright (c) 1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module SplayHeap {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of splay heaps Heap, -- instance of Coll/CollX, OrdColl/OrdCollX -- CollX operations empty,single,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll, deleteSeq,null,size,member,count, -- Coll operations toSeq, lookup, lookupM, lookupAll, lookupWithDefault, fold, fold1, filter, partition, -- OrdCollX operations deleteMin,deleteMax,unsafeInsertMin,unsafeInsertMax,unsafeFromOrdSeq, unsafeAppend,filterLT,filterLE,filterGT,filterGE,partitionLT_GE, partitionLE_GT,partitionLT_GT, -- OrdColl operations minView,minElem,maxView,maxElem,foldr,foldl,foldr1,foldl1,toOrdSeq, -- other supported operations unsafeMapMonotonic, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import EdisonPrelude(Maybe2(..)) import qualified Collection as C import qualified Sequence as S import CollectionDefaults import Monad import QuickCheck moduleName = "SplayHeap" -- Adapted from -- Chris Okasaki. Purely Functional Data Structures. 1998. -- Section 5.4. -- -- If minElem is called frequently, then SplayHeap should -- be used in conjunction with MinHeap. data Heap a = E | T (Heap a) a (Heap a) empty :: Heap a single :: a -> Heap a fromSeq :: (Ord a,S.Sequence s) => s a -> Heap a insert :: Ord a => a -> Heap a -> Heap a insertSeq :: (Ord a,S.Sequence s) => s a -> Heap a -> Heap a union :: Ord a => Heap a -> Heap a -> Heap a unionSeq :: (Ord a,S.Sequence s) => s (Heap a) -> Heap a delete :: Ord a => a -> Heap a -> Heap a deleteAll :: Ord a => a -> Heap a -> Heap a deleteSeq :: (Ord a,S.Sequence s) => s a -> Heap a -> Heap a null :: Heap a -> Bool size :: Heap a -> Int member :: Ord a => Heap a -> a -> Bool count :: Ord a => Heap a -> a -> Int toSeq :: (Ord a, S.Sequence s) => Heap a -> s a lookup :: Ord a => Heap a -> a -> a lookupM :: Ord a => Heap a -> a -> Maybe a lookupAll :: (Ord a,S.Sequence s) => Heap a -> a -> s a lookupWithDefault :: Ord a => a -> Heap a -> a -> a fold :: Ord a => (a -> b -> b) -> b -> Heap a -> b fold1 :: Ord a => (a -> a -> a) -> Heap a -> a filter :: Ord a => (a -> Bool) -> Heap a -> Heap a partition :: Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a) deleteMin :: Ord a => Heap a -> Heap a deleteMax :: Ord a => Heap a -> Heap a unsafeInsertMin :: Ord a => a -> Heap a -> Heap a unsafeInsertMax :: Ord a => Heap a -> a -> Heap a unsafeFromOrdSeq :: (Ord a,S.Sequence s) => s a -> Heap a unsafeAppend :: Ord a => Heap a -> Heap a -> Heap a filterLT :: Ord a => a -> Heap a -> Heap a filterLE :: Ord a => a -> Heap a -> Heap a filterGT :: Ord a => a -> Heap a -> Heap a filterGE :: Ord a => a -> Heap a -> Heap a partitionLT_GE :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLE_GT :: Ord a => a -> Heap a -> (Heap a, Heap a) partitionLT_GT :: Ord a => a -> Heap a -> (Heap a, Heap a) minView :: Ord a => Heap a -> Maybe2 a (Heap a) minElem :: Ord a => Heap a -> a maxView :: Ord a => Heap a -> Maybe2 (Heap a) a maxElem :: Ord a => Heap a -> a foldr :: Ord a => (a -> b -> b) -> b -> Heap a -> b foldl :: Ord a => (b -> a -> b) -> b -> Heap a -> b foldr1 :: Ord a => (a -> a -> a) -> Heap a -> a foldl1 :: Ord a => (a -> a -> a) -> Heap a -> a toOrdSeq :: (Ord a,S.Sequence s) => Heap a -> s a unsafeMapMonotonic :: (a -> b) -> Heap a -> Heap b empty = E single x = T E x E insert x xs = T a x b where (a,b) = partitionLE_GT x xs union E ys = ys union (T a x b) ys = T (union c a) x (union d b) where (c,d) = partitionLE_GT x ys delete x xs = let (a,b) = partitionLE_GT x xs in case maxView a of Nothing2 -> b Just2 a' y | x > y -> T a' y b | otherwise -> unsafeAppend a' b deleteAll x xs = unsafeAppend a b where (a,b) = partitionLT_GT x xs null E = True null (T a x b) = False size = sz 0 where sz n E = n sz n (T a x b) = sz (sz (1+n) a) b member E x = False member (T a y b) x = if x < y then member a x else x==y || member b x count = cnt 0 where cnt n E x = n cnt n (T a y b) x | x < y = cnt n a x | x > y = cnt n b x | otherwise = cnt (cnt (1+n) a x) b x toSeq xs = tos xs S.empty where tos E rest = rest tos (T a x b) rest = S.cons x (tos a (tos b rest)) lookup E x = error "SplayHeap.lookup: empty heap" lookup (T a y b) x | x < y = lookup a x | x > y = lookup b x | otherwise = y lookupM E x = Nothing lookupM (T a y b) x | x < y = lookupM a x | x > y = lookupM b x | otherwise = Just y lookupWithDefault d E x = d lookupWithDefault d (T a y b) x | x < y = lookupWithDefault d a x | x > y = lookupWithDefault d b x | otherwise = y lookupAll xs x = look xs x S.empty where look E x rest = rest look (T a y b) x rest | x < y = look a x rest | x > y = look b x rest | otherwise = look a x (S.cons y (look b x rest)) fold f e E = e fold f e (T a x b) = f x (fold f (fold f e b) a) fold1 f E = error "SplayHeap.fold1: empty heap" fold1 f (T a x b) = fold f (fold f x b) a filter p E = E filter p (T a x b) | p x = T (filter p a) x (filter p b) | otherwise = unsafeAppend (filter p a) (filter p b) partition p E = (E, E) partition p (T a x b) | p x = (T a0 x b0, unsafeAppend a1 b1) | otherwise = (unsafeAppend a0 b0, T a1 x b1) where (a0,a1) = partition p a (b0,b1) = partition p b deleteMin E = E deleteMin (T a x b) = del a x b where del E x b = b del (T E x b) y c = T b y c del (T (T a x b) y c) z d = T (del a x b) y (T c z d) deleteMax E = E deleteMax (T a x b) = del a x b where del a x E = a del a x (T b y E) = T a x b del a x (T b y (T c z d)) = T (T a x b) y (del c z d) unsafeInsertMin x xs = T E x xs unsafeInsertMax xs x = T xs x E unsafeAppend a b = case maxView a of Nothing2 -> b Just2 a' x -> T a' x b filterLT k E = E filterLT k t@(T a x b) = if x >= k then filterLT k a else case b of E -> t T ba y bb -> if y >= k then T a x (filterLT k ba) else T (T a x ba) y (filterLT k bb) filterLE k E = E filterLE k t@(T a x b) = if x > k then filterLE k a else case b of E -> t T ba y bb -> if y > k then T a x (filterLE k ba) else T (T a x ba) y (filterLE k bb) filterGT k E = E filterGT k t@(T a x b) = if x <= k then filterGT k b else case a of E -> t T aa y ab -> if y <= k then T (filterGT k ab) x b else T (filterGT k aa) y (T ab x b) filterGE k E = E filterGE k t@(T a x b) = if x < k then filterGE k b else case a of E -> t T aa y ab -> if y < k then T (filterGE k ab) x b else T (filterGE k aa) y (T ab x b) partitionLT_GE k E = (E,E) partitionLT_GE k t@(T a x b) = if x >= k then case a of E -> (E,t) T aa y ab -> if y >= k then let (small,big) = partitionLT_GE k aa in (small, T big y (T ab x b)) else let (small,big) = partitionLT_GE k ab in (T aa y small, T big x b) else case b of E -> (t,E) T ba y bb -> if y >= k then let (small,big) = partitionLT_GE k ba in (T a x small, T big y bb) else let (small,big) = partitionLT_GE k bb in (T (T a x ba) y small, big) partitionLE_GT k E = (E,E) partitionLE_GT k t@(T a x b) = if x > k then case a of E -> (E,t) T aa y ab -> if y > k then let (small,big) = partitionLE_GT k aa in (small, T big y (T ab x b)) else let (small,big) = partitionLE_GT k ab in (T aa y small, T big x b) else case b of E -> (t,E) T ba y bb -> if y > k then let (small,big) = partitionLE_GT k ba in (T a x small, T big y bb) else let (small,big) = partitionLE_GT k bb in (T (T a x ba) y small, big) -- could specialize calls to filterLT/filterGT partitionLT_GT k E = (E,E) partitionLT_GT k t@(T a x b) = if x > k then case a of E -> (E,t) T aa y ab -> if y > k then let (small,big) = partitionLT_GT k aa in (small, T big y (T ab x b)) else if y < k then let (small,big) = partitionLT_GT k ab in (T aa y small, T big x b) else (filterLT k aa, T (filterGT k ab) x b) else if x < k then case b of E -> (t,E) T ba y bb -> if y > k then let (small,big) = partitionLT_GT k ba in (T a x small, T big y bb) else if y < k then let (small,big) = partitionLT_GT k bb in (T (T a x ba) y small, big) else (T a x (filterLT k ba), filterGT k bb) else (filterLT k a, filterGT k b) minView E = Nothing2 minView (T a x b) = Just2 y ys where (y,ys) = minv a x b minv E x b = (x,b) minv (T E x b) y c = (x,T b y c) minv (T (T a x b) y c) z d = (w,T ab y (T c z d)) where (w,ab) = minv a x b minElem E = error "SplayHeap.minElem: empty heap" minElem (T a x b) = minel a x where minel E x = x minel (T a x b) _ = minel a x maxView E = Nothing2 maxView (T a x b) = Just2 ys y where (ys,y) = maxv a x b maxv a x E = (a,x) maxv a x (T b y E) = (T a x b,y) maxv a x (T b y (T c z d)) = (T (T a x b) y cd,w) where (cd,w) = maxv c z d maxElem E = error "SplayHeap.minElem: empty heap" maxElem (T a x b) = maxel x b where maxel x E = x maxel _ (T a x b) = maxel x b foldr f e E = e foldr f e (T a x b) = foldr f (f x (foldr f e b)) a foldl f e E = e foldl f e (T a x b) = foldl f (f (foldl f e a) x) b foldr1 f E = error "SplayHeap.foldr1: empty heap" foldr1 f (T a x b) = foldr f (myfold f x b) a where myfold f x E = x myfold f x (T a y b) = f x (foldr f (myfold f y b) a) foldl1 f E = error "SplayHeap.foldl1: empty heap" foldl1 f (T a x b) = foldl f (myfold f a x) b where myfold f E x = x myfold f (T a x b) y = f (foldl f (myfold f a x) b) y toOrdSeq xs = tos xs S.empty where tos E rest = rest tos (T a x b) rest = tos a (S.cons x (tos b rest)) unsafeMapMonotonic f E = E unsafeMapMonotonic f (T a x b) = T (unsafeMapMonotonic f a) (f x) (unsafeMapMonotonic f b) -- the remaining functions all use defaults fromSeq = fromSeqUsingFoldr insertSeq = insertSeqUsingFoldr unionSeq = unionSeqUsingReduce deleteSeq = deleteSeqUsingDelete unsafeFromOrdSeq = unsafeFromOrdSeqUsingUnsafeInsertMin -- instance declarations instance Ord a => C.CollX (Heap) a where {empty = empty; single = single; fromSeq = fromSeq; insert = insert; insertSeq = insertSeq; union = union; unionSeq = unionSeq; delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; null = null; size = size; member = member; count = count; instanceName c = moduleName} instance Ord a => C.OrdCollX (Heap) a where {deleteMin = deleteMin; deleteMax = deleteMax; unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; filterGE = filterGE; partitionLT_GE = partitionLT_GE; partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT} instance Ord a => C.Coll (Heap) a where {toSeq = toSeq; lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; fold = fold; fold1 = fold1; filter = filter; partition = partition} instance Ord a => C.OrdColl (Heap) a where {minView = minView; minElem = minElem; maxView = maxView; maxElem = maxElem; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; toOrdSeq = toOrdSeq} instance Ord a => Eq (Heap a) where xs == ys = C.toOrdList xs == C.toOrdList ys instance (Ord a, Show a) => Show (Heap a) where show xs = show (C.toOrdList xs) instance (Ord a,Arbitrary a) => Arbitrary (Heap a) where arbitrary = do xs <- arbitrary return (C.fromList xs) coarbitrary E = variant 0 coarbitrary (T a x b) = variant 1 . coarbitrary a . coarbitrary x . coarbitrary b hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/TestOrdBag.hs0000644006511100651110000001422510130752024023350 0ustar rossross-- Copyright (c) 1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module TestOrdBag {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import qualified Prelude import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Collection as C import qualified List -- not ListSeq! import qualified ListSeq as L import QuickCheck import LazyPairingHeap -- the bag module being tested import qualified JoinList as S -- the sequence module being tested -- To different modules, simply replace the names above. -- To test a bag module that does not name its type constructor "Bag", -- you also need to define a type synonym -- type Bag a = ... -- You may also need to adjust the Seq type synonym. type Bag a = Heap a type Seq a = S.Seq a tol :: Bag Int -> [Int] tol = C.toOrdList lmerge :: [Int] -> [Int] -> [Int] lmerge xs [] = xs lmerge [] ys = ys lmerge xs@(x:xs') ys@(y:ys') | x <= y = x : lmerge xs' ys | otherwise = y : lmerge xs ys' -- CollX operations prop_single :: Int -> Bool prop_single x = tol (single x) == [x] prop_fromSeq :: Seq Int -> Bool prop_fromSeq xs = fromSeq xs == S.foldr insert empty xs prop_insert :: Int -> Bag Int -> Bool prop_insert x xs = tol (insert x xs) == List.insert x (tol xs) prop_insertSeq :: Seq Int -> Bag Int -> Bool prop_insertSeq xs ys = insertSeq xs ys == union (fromSeq xs) ys prop_union :: Bag Int -> Bag Int -> Bool prop_union xs ys = tol (union xs ys) == lmerge (tol xs) (tol ys) prop_unionSeq :: Seq (Bag Int) -> Bool prop_unionSeq xss = unionSeq xss == S.foldr union empty xss prop_delete :: Int -> Bag Int -> Bool prop_delete x xs = tol (delete x xs) == List.delete x (tol xs) prop_deleteAll :: Int -> Bag Int -> Bool prop_deleteAll x xs = tol (deleteAll x xs) == Prelude.filter (/= x) (tol xs) prop_deleteSeq :: Seq Int -> Bag Int -> Bool prop_deleteSeq xs ys = deleteSeq xs ys == S.foldr delete ys xs prop_null_size :: Bag Int -> Bool prop_null_size xs = null xs == (size xs == 0) && size xs == Prelude.length (tol xs) prop_member_count :: Bag Int -> Int -> Bool prop_member_count xs x = member xs x == (c > 0) && c == Prelude.length (Prelude.filter (== x) (tol xs)) where c = count xs x -- Coll operations prop_toSeq :: Bag Int -> Bool prop_toSeq xs = List.sort (S.toList (toSeq xs)) == tol xs prop_lookup :: Bag Int -> Int -> Bool prop_lookup xs x = if member xs x then lookup xs x == x && lookupM xs x == Just x && lookupWithDefault 999 xs x == x && lookupAll xs x == Prelude.take (count xs x) (repeat x) else lookupM xs x == Nothing && lookupWithDefault 999 xs x == 999 && lookupAll xs x == [] prop_fold :: Bag Int -> Bool prop_fold xs = List.sort (fold (:) [] xs) == tol xs && (null xs || fold1 (+) xs == sum (tol xs)) prop_filter_partition :: Bag Int -> Bool prop_filter_partition xs = tol (filter p xs) == Prelude.filter p (tol xs) && partition p xs == (filter p xs, filter (not . p) xs) where p x = x `mod` 3 == 2 -- OrdCollX operations prop_deleteMin_Max :: Bag Int -> Bool prop_deleteMin_Max xs = tol (deleteMin xs) == L.ltail (tol xs) && tol (deleteMax xs) == L.rtail (tol xs) prop_unsafeInsertMin_Max :: Int -> Bag Int -> Bool prop_unsafeInsertMin_Max i xs = if null xs then unsafeInsertMin 0 xs == single 0 && unsafeInsertMax xs 0 == single 0 else unsafeInsertMin lo xs == insert lo xs && unsafeInsertMax xs hi == insert hi xs where lo = minElem xs - (if odd i then 1 else 0) hi = maxElem xs + (if odd i then 1 else 0) prop_unsafeFromOrdSeq :: [Int] -> Bool prop_unsafeFromOrdSeq xs = tol (unsafeFromOrdSeq xs') == xs' where xs' = List.sort xs prop_unsafeAppend :: Int -> Bag Int -> Bag Int -> Bool prop_unsafeAppend i xs ys = if null xs || null ys then unsafeAppend xs ys == union xs ys else unsafeAppend xs ys' == union xs ys' where delta = maxElem xs - minElem ys + (if odd i then 1 else 0) ys' = unsafeMapMonotonic (+delta) ys -- if unsafeMapMonotonic does any reorganizing in addition -- to simply replacing the elements, then this test will -- not provide even coverage prop_filter :: Int -> Bag Int -> Bool prop_filter x xs = tol (filterLT x xs) == Prelude.filter (< x) (tol xs) && tol (filterLE x xs) == Prelude.filter (<= x) (tol xs) && tol (filterGT x xs) == Prelude.filter (> x) (tol xs) && tol (filterGE x xs) == Prelude.filter (>= x) (tol xs) prop_partition :: Int -> Bag Int -> Bool prop_partition x xs = partitionLT_GE x xs == (filterLT x xs, filterGE x xs) && partitionLE_GT x xs == (filterLE x xs, filterGT x xs) && partitionLT_GT x xs == (filterLT x xs, filterGT x xs) -- OrdColl operations prop_minView_maxView :: Bag Int -> Bool prop_minView_maxView xs = minView xs == (if null xs then Nothing2 else Just2 (minElem xs) (deleteMin xs)) && maxView xs == (if null xs then Nothing2 else Just2 (deleteMax xs) (maxElem xs)) prop_minElem_maxElem :: Bag Int -> Property prop_minElem_maxElem xs = not (null xs) ==> minElem xs == Prelude.head (tol xs) && maxElem xs == Prelude.last (tol xs) prop_foldr_foldl :: Bag Int -> Bool prop_foldr_foldl xs = foldr (:) [] xs == tol xs && foldl (flip (:)) [] xs == Prelude.reverse (tol xs) prop_foldr1_foldl1 :: Bag Int -> Property prop_foldr1_foldl1 xs = not (null xs) ==> foldr1 f xs == foldr f 1333 xs && foldl1 (flip f) xs == foldl (flip f) 1333 xs where f x 1333 = x f x y = 3*x - 7*y prop_toOrdSeq :: Bag Int -> Bool prop_toOrdSeq xs = S.toList (toOrdSeq xs) == tol xs -- bonus operation, not supported by all ordered collections prop_unsafeMapMonotonic :: Bag Int -> Bool prop_unsafeMapMonotonic xs = tol (unsafeMapMonotonic (2*) xs) == Prelude.map (2*) (tol xs) hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/TestOrdSet.hs0000644006511100651110000001732010130752024023411 0ustar rossross-- Copyright (c) 1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. -- WARNING: The Set operations (insertWith...) are not adequately tested. -- To be thorough, they should be tested on a type where distinguishable -- values can still be "equal", and the results should be tested to make -- sure that the "With" function was called on the right values. module TestOrdSet {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import qualified Prelude import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Collection as C import qualified List -- not ListSeq! import qualified ListSeq as L import QuickCheck import UnbalancedSet -- the set module being tested import qualified JoinList as S -- the sequence module being tested -- To different modules, simply replace the names above. -- To test a set module that does not name its type constructor "Set", -- you also need to define a type synonym -- type Set a = ... -- You may also need to adjust the Seq type synonym. type Seq a = S.Seq a tol :: Set Int -> [Int] tol = C.toOrdList lmerge :: [Int] -> [Int] -> [Int] lmerge xs [] = xs lmerge [] ys = ys lmerge xs@(x:xs') ys@(y:ys') | x < y = x : lmerge xs' ys | y < x = y : lmerge xs ys' | otherwise = x : lmerge xs' ys' nub :: [Int] -> [Int] nub (x : xs@(x' : _)) = if x==x' then nub xs else x : nub xs nub xs = xs sort = nub . List.sort -- CollX operations prop_single :: Int -> Bool prop_single x = tol (single x) == [x] prop_fromSeq :: Seq Int -> Bool prop_fromSeq xs = tol (fromSeq xs) == sort (S.toList xs) prop_insert :: Int -> Set Int -> Bool prop_insert x xs = if member xs x then tol (insert x xs) == tol xs else tol (insert x xs) == List.insert x (tol xs) prop_insertSeq :: Seq Int -> Set Int -> Bool prop_insertSeq xs ys = insertSeq xs ys == union (fromSeq xs) ys prop_union :: Set Int -> Set Int -> Bool prop_union xs ys = tol (union xs ys) == lmerge (tol xs) (tol ys) prop_unionSeq :: Seq (Set Int) -> Bool prop_unionSeq xss = unionSeq xss == S.foldr union empty xss prop_delete :: Int -> Set Int -> Bool prop_delete x xs = tol (delete x xs) == List.delete x (tol xs) prop_deleteAll :: Int -> Set Int -> Bool prop_deleteAll x xs = deleteAll x xs == delete x xs prop_deleteSeq :: Seq Int -> Set Int -> Bool prop_deleteSeq xs ys = deleteSeq xs ys == S.foldr delete ys xs prop_null_size :: Set Int -> Bool prop_null_size xs = null xs == (size xs == 0) && size xs == Prelude.length (tol xs) prop_member_count :: Set Int -> Int -> Bool prop_member_count xs x = mem == not (Prelude.null (Prelude.filter (== x) (tol xs))) && count xs x == (if mem then 1 else 0) where mem = member xs x -- Coll operations prop_toSeq :: Set Int -> Bool prop_toSeq xs = List.sort (S.toList (toSeq xs)) == tol xs prop_lookup :: Set Int -> Int -> Bool prop_lookup xs x = if member xs x then lookup xs x == x && lookupM xs x == Just x && lookupWithDefault 999 xs x == x && lookupAll xs x == Prelude.take (count xs x) (repeat x) else lookupM xs x == Nothing && lookupWithDefault 999 xs x == 999 && lookupAll xs x == [] prop_fold :: Set Int -> Bool prop_fold xs = List.sort (fold (:) [] xs) == tol xs && (null xs || fold1 (+) xs == sum (tol xs)) prop_filter_partition :: Set Int -> Bool prop_filter_partition xs = tol (filter p xs) == Prelude.filter p (tol xs) && partition p xs == (filter p xs, filter (not . p) xs) where p x = x `mod` 3 == 2 -- OrdCollX operations prop_deleteMin_Max :: Set Int -> Bool prop_deleteMin_Max xs = tol (deleteMin xs) == L.ltail (tol xs) && tol (deleteMax xs) == L.rtail (tol xs) prop_unsafeInsertMin_Max :: Int -> Set Int -> Bool prop_unsafeInsertMin_Max i xs = if null xs then unsafeInsertMin 0 xs == single 0 && unsafeInsertMax xs 0 == single 0 else unsafeInsertMin lo xs == insert lo xs && unsafeInsertMax xs hi == insert hi xs where lo = minElem xs - 1 hi = maxElem xs + 1 prop_unsafeFromOrdSeq :: [Int] -> Bool prop_unsafeFromOrdSeq xs = unsafeFromOrdSeq (sort xs) == fromSeq xs prop_unsafeAppend :: Int -> Set Int -> Set Int -> Bool prop_unsafeAppend i xs ys = if null xs || null ys then unsafeAppend xs ys == union xs ys else unsafeAppend xs ys' == union xs ys' where delta = maxElem xs - minElem ys + 1 ys' = unsafeMapMonotonic (+delta) ys -- if unsafeMapMonotonic does any reorganizing in addition -- to simply replacing the elements, then this test will -- not provide even coverage prop_filter :: Int -> Set Int -> Bool prop_filter x xs = tol (filterLT x xs) == Prelude.filter (< x) (tol xs) && tol (filterLE x xs) == Prelude.filter (<= x) (tol xs) && tol (filterGT x xs) == Prelude.filter (> x) (tol xs) && tol (filterGE x xs) == Prelude.filter (>= x) (tol xs) prop_partition :: Int -> Set Int -> Bool prop_partition x xs = partitionLT_GE x xs == (filterLT x xs, filterGE x xs) && partitionLE_GT x xs == (filterLE x xs, filterGT x xs) && partitionLT_GT x xs == (filterLT x xs, filterGT x xs) -- OrdColl operations prop_minView_maxView :: Set Int -> Bool prop_minView_maxView xs = minView xs == (if null xs then Nothing2 else Just2 (minElem xs) (deleteMin xs)) && maxView xs == (if null xs then Nothing2 else Just2 (deleteMax xs) (maxElem xs)) prop_minElem_maxElem :: Set Int -> Property prop_minElem_maxElem xs = not (null xs) ==> minElem xs == Prelude.head (tol xs) && maxElem xs == Prelude.last (tol xs) prop_foldr_foldl :: Set Int -> Bool prop_foldr_foldl xs = foldr (:) [] xs == tol xs && foldl (flip (:)) [] xs == Prelude.reverse (tol xs) prop_foldr1_foldl1 :: Set Int -> Property prop_foldr1_foldl1 xs = not (null xs) ==> foldr1 f xs == foldr f 1333 xs && foldl1 (flip f) xs == foldl (flip f) 1333 xs where f x 1333 = x f x y = 3*x - 7*y prop_toOrdSeq :: Set Int -> Bool prop_toOrdSeq xs = S.toList (toOrdSeq xs) == tol xs -- SetX operations prop_intersect_difference :: Set Int -> Set Int -> Bool prop_intersect_difference xs ys = intersect xs ys == filter (member xs) ys && difference xs ys == filter (not . member ys) xs prop_subset_subsetEq :: Set Int -> Set Int -> Bool prop_subset_subsetEq xs ys = subset xs ys == (subsetEq xs ys && xs /= ys) && subsetEq xs ys == (intersect xs ys == xs) -- Set operations prop_fromSeqWith :: Seq Int -> Bool prop_fromSeqWith xs = fromSeqWith const xs == fromSeq xs prop_insertWith :: Int -> Set Int -> Bool prop_insertWith x xs = insertWith const x xs == insert x xs prop_insertSeqWith :: Seq Int -> Set Int -> Bool prop_insertSeqWith xs ys = insertSeqWith const xs ys == insertSeq xs ys prop_unionl_unionr_unionWith :: Set Int -> Set Int -> Bool prop_unionl_unionr_unionWith xs ys = unionl xs ys == u && unionr xs ys == u && unionWith const xs ys == u where u = union xs ys prop_unionSeqWith :: Seq (Set Int) -> Bool prop_unionSeqWith xss = unionSeqWith const xss == unionSeq xss prop_intersectWith :: Set Int -> Set Int -> Bool prop_intersectWith xs ys = intersectWith const xs ys == intersect xs ys -- bonus operation, not supported by all ordered collections prop_unsafeMapMonotonic :: Set Int -> Bool prop_unsafeMapMonotonic xs = tol (unsafeMapMonotonic (2*) xs) == Prelude.map (2*) (tol xs) hugs98-plus-Sep2006/fptools/hslibs/data/edison/Coll/UnbalancedSet.hs0000644006511100651110000002620510130752024024063 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. -- defaults can be improved! module UnbalancedSet {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- types Set, -- instance of Coll/CollX, OrdColl/OrdCollX, Set/SetX, OrdSet/OrdSetX -- CollX operations empty,single,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll, deleteSeq,null,size,member,count, -- Coll operations toSeq,lookup,lookupM,lookupAll,lookupWithDefault,fold,fold1, filter,partition, -- OrdCollX operations deleteMin,deleteMax,unsafeInsertMin,unsafeInsertMax,unsafeFromOrdSeq, unsafeAppend,filterLT,filterLE,filterGT,filterGE,partitionLT_GE, partitionLE_GT,partitionLT_GT, -- OrdColl operations minView,minElem,maxView,maxElem,foldr,foldl,foldr1,foldl1,toOrdSeq, -- SetX operations intersect,difference,subset,subsetEq, -- Set operations fromSeqWith,insertWith,insertSeqWith,unionl,unionr,unionWith, unionSeqWith,intersectWith, -- other supported operations unsafeMapMonotonic, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import qualified Prelude import EdisonPrelude(Maybe2(..)) import qualified Collection as C import qualified Sequence as S import qualified ListSeq as L import CollectionDefaults import QuickCheck -- signatures for exported functions moduleName :: String empty :: Set a single :: a -> Set a fromSeq :: (Ord a,S.Sequence seq) => seq a -> Set a insert :: Ord a => a -> Set a -> Set a insertSeq :: (Ord a,S.Sequence seq) => seq a -> Set a -> Set a union :: Ord a => Set a -> Set a -> Set a unionSeq :: (Ord a,S.Sequence seq) => seq (Set a) -> Set a delete :: Ord a => a -> Set a -> Set a deleteAll :: Ord a => a -> Set a -> Set a deleteSeq :: (Ord a,S.Sequence seq) => seq a -> Set a -> Set a null :: Set a -> Bool size :: Set a -> Int member :: Ord a => Set a -> a -> Bool count :: Ord a => Set a -> a -> Int toSeq :: (Ord a,S.Sequence seq) => Set a -> seq a lookup :: Ord a => Set a -> a -> a lookupM :: Ord a => Set a -> a -> Maybe a lookupAll :: (Ord a,S.Sequence seq) => Set a -> a -> seq a lookupWithDefault :: Ord a => a -> Set a -> a -> a fold :: (a -> b -> b) -> b -> Set a -> b fold1 :: (a -> a -> a) -> Set a -> a filter :: Ord a => (a -> Bool) -> Set a -> Set a partition :: Ord a => (a -> Bool) -> Set a -> (Set a, Set a) deleteMin :: Ord a => Set a -> Set a deleteMax :: Ord a => Set a -> Set a unsafeInsertMin :: Ord a => a -> Set a -> Set a unsafeInsertMax :: Ord a => Set a -> a -> Set a unsafeFromOrdSeq :: (Ord a,S.Sequence seq) => seq a -> Set a unsafeAppend :: Ord a => Set a -> Set a -> Set a filterLT :: Ord a => a -> Set a -> Set a filterLE :: Ord a => a -> Set a -> Set a filterGT :: Ord a => a -> Set a -> Set a filterGE :: Ord a => a -> Set a -> Set a partitionLT_GE :: Ord a => a -> Set a -> (Set a, Set a) partitionLE_GT :: Ord a => a -> Set a -> (Set a, Set a) partitionLT_GT :: Ord a => a -> Set a -> (Set a, Set a) minView :: Set a -> Maybe2 a (Set a) minElem :: Set a -> a maxView :: Set a -> Maybe2 (Set a) a maxElem :: Set a -> a foldr :: (a -> b -> b) -> b -> Set a -> b foldl :: (b -> a -> b) -> b -> Set a -> b foldr1 :: (a -> a -> a) -> Set a -> a foldl1 :: (a -> a -> a) -> Set a -> a toOrdSeq :: (Ord a,S.Sequence seq) => Set a -> seq a intersect :: Ord a => Set a -> Set a -> Set a difference :: Ord a => Set a -> Set a -> Set a subset :: Ord a => Set a -> Set a -> Bool subsetEq :: Ord a => Set a -> Set a -> Bool fromSeqWith :: (Ord a,S.Sequence seq) => (a -> a -> a) -> seq a -> Set a insertWith :: Ord a => (a -> a -> a) -> a -> Set a -> Set a insertSeqWith :: (Ord a,S.Sequence seq) => (a -> a -> a) -> seq a -> Set a -> Set a unionl :: Ord a => Set a -> Set a -> Set a unionr :: Ord a => Set a -> Set a -> Set a unionWith :: Ord a => (a -> a -> a) -> Set a -> Set a -> Set a unionSeqWith :: (Ord a,S.Sequence seq) => (a -> a -> a) -> seq (Set a) -> Set a intersectWith :: Ord a => (a -> a -> a) -> Set a -> Set a -> Set a unsafeMapMonotonic :: Ord a => (a -> a) -> Set a -> Set a moduleName = "UnbalancedSet" data Set a = E | T (Set a) a (Set a) deriving (Show) empty = E single x = T E x E insertWith c x = ins where ins E = T E x E ins (T a y b) = case compare x y of LT -> T (ins a) y b EQ -> T a (c x y) b GT -> T a y (ins b) delete x E = E delete x (T a y b) = case compare x y of LT -> T (delete x a) y b EQ -> unsafeAppend a b GT -> T a y (delete x b) null E = True null (T _ _ _) = False size t = sz t 0 where sz E i = i sz (T a x b) i = sz a (sz b (i+1)) member E x = False member (T a y b) x = case compare x y of LT -> member a x EQ -> True GT -> member b x lookupM E x = Nothing lookupM (T a y b) x = case compare x y of LT -> lookupM a x EQ -> Just y GT -> lookupM b x fold f e E = e fold f e (T a x b) = f x (fold f (fold f e a) b) fold1 f E = error "UnbalancedSet.fold1: empty collection" fold1 f (T a x b) = fold f (fold f x a) b deleteMin E = E deleteMin (T E x b) = b deleteMin (T a x b) = T (deleteMin a) x b deleteMax E = E deleteMax (T a x E) = a deleteMax (T a x b) = T a x (deleteMax b) unsafeInsertMin x t = T E x t unsafeInsertMax t x = T t x E unsafeFromOrdSeq xs = fst (ins xs (S.size xs)) where ins xs 0 = (E,xs) ins xs n = let m = n `div` 2 (a,xs') = ins xs m Just2 x xs'' = S.lview xs' (b,xs''') = ins xs'' (n - m - 1) in (T a x b,xs''') unsafeAppend a b = case minView b of Nothing2 -> a Just2 x b' -> T a x b' filterLT y E = E filterLT y (T a x b) = case compare x y of LT -> T a x (filterLT y b) EQ -> a GT -> filterLT y a filterLE y E = E filterLE y (T a x b) = case compare x y of LT -> T a x (filterLE y b) EQ -> T a x E GT -> filterLE y a filterGT y E = E filterGT y (T a x b) = case compare x y of LT -> filterGT y b EQ -> b GT -> T (filterGT y a) x b filterGE y E = E filterGE y (T a x b) = case compare x y of LT -> filterGE y b EQ -> T E x b GT -> T (filterGE y a) x b partitionLT_GE y E = (E,E) partitionLT_GE y (T a x b) = case compare x y of LT -> (T a x b0,b1) where (b0,b1) = partitionLT_GE y b EQ -> (a,T E x b) GT -> (a0,T a1 x b) where (a0,a1) = partitionLT_GE y a partitionLE_GT y E = (E,E) partitionLE_GT y (T a x b) = case compare x y of LT -> (T a x b0,b1) where (b0,b1) = partitionLE_GT y b EQ -> (T a x E,b) GT -> (a0,T a1 x b) where (a0,a1) = partitionLE_GT y a partitionLT_GT y E = (E,E) partitionLT_GT y (T a x b) = case compare x y of LT -> (T a x b0,b1) where (b0,b1) = partitionLT_GT y b EQ -> (a,b) GT -> (a0,T a1 x b) where (a0,a1) = partitionLT_GT y a minView E = Nothing2 minView (T E x b) = Just2 x b minView (T a x b) = Just2 y (T a' x b) where Just2 y a' = minView a minElem E = error "UnbalancedSet.minElem: empty collection" minElem (T E x b) = x minElem (T a x b) = minElem a maxView E = Nothing2 maxView (T a x E) = Just2 a x maxView (T a x b) = Just2 (T a x b') y where Just2 b' y = maxView b maxElem E = error "UnbalancedSet.maxElem: empty collection" maxElem (T a x E) = x maxElem (T a x b) = maxElem b foldr f e E = e foldr f e (T a x b) = foldr f (f x (foldr f e b)) a foldl f e E = e foldl f e (T a x b) = foldl f (f (foldl f e a) x) b foldr1 f E = error "UnbalancedSet.foldr1: empty collection" foldr1 f (T a x E) = foldr f x a foldr1 f (T a x b) = foldr f (f x (foldr1 f b)) a foldl1 f E = error "UnbalancedSet.foldl1: empty collection" foldl1 f (T E x b) = foldl f x b foldl1 f (T a x b) = foldl f (f (foldl1 f a) x) b unsafeMapMonotonic f E = E unsafeMapMonotonic f (T a x b) = T (unsafeMapMonotonic f a) (f x) (unsafeMapMonotonic f b) -- the remaining functions all use default definitions fromSeq = fromSeqUsingUnionSeq insert = insertUsingInsertWith insertSeq = insertSeqUsingUnion union = unionUsingUnionWith unionSeq = unionSeqUsingReduce deleteAll = delete deleteSeq = deleteSeqUsingDelete count = countUsingMember toSeq = toSeqUsingFold lookup = lookupUsingLookupM lookupAll = lookupAllUsingLookupM lookupWithDefault = lookupWithDefaultUsingLookupM filter = filterUsingOrdLists partition = partitionUsingOrdLists toOrdSeq = toOrdSeqUsingFoldr intersect = intersectUsingIntersectWith difference = differenceUsingOrdLists subset = subsetUsingOrdLists subsetEq = subsetEqUsingOrdLists fromSeqWith = fromSeqWithUsingInsertWith insertSeqWith = insertSeqWithUsingInsertWith unionl = unionlUsingUnionWith unionr = unionrUsingUnionWith unionWith = unionWithUsingOrdLists unionSeqWith = unionSeqWithUsingReducer intersectWith = intersectWithUsingOrdLists -- instance declarations instance Ord a => C.CollX Set a where {empty = empty; single = single; fromSeq = fromSeq; insert = insert; insertSeq = insertSeq; union = union; unionSeq = unionSeq; delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; null = null; size = size; member = member; count = count; instanceName c = moduleName} instance Ord a => C.OrdCollX Set a where {deleteMin = deleteMin; deleteMax = deleteMax; unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; filterGE = filterGE; partitionLT_GE = partitionLT_GE; partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT} instance Ord a => C.Coll Set a where {toSeq = toSeq; lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; fold = fold; fold1 = fold1; filter = filter; partition = partition} instance Ord a => C.OrdColl Set a where {minView = minView; minElem = minElem; maxView = maxView; maxElem = maxElem; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; toOrdSeq = toOrdSeq} instance Ord a => C.SetX Set a where {intersect = intersect; difference = difference; subset = subset; subsetEq = subsetEq} instance Ord a => C.Set Set a where {fromSeqWith = fromSeqWith; insertWith = insertWith; insertSeqWith = insertSeqWith; unionl = unionl; unionr = unionr; unionWith= unionWith; unionSeqWith = unionSeqWith; intersectWith = intersectWith} instance Ord a => C.OrdSetX Set a instance Ord a => C.OrdSet Set a instance Ord a => Eq (Set a) where xs == ys = C.toOrdList xs == C.toOrdList ys --instance (Ord a, Show a) => Show (Set a) where -- show xs = show (C.toOrdList xs) instance (Ord a, Arbitrary a) => Arbitrary (Set a) where arbitrary = do xs <- arbitrary return (Prelude.foldr insert empty xs) coarbitrary E = variant 0 coarbitrary (T a x b) = variant 1 . coarbitrary a . coarbitrary x . coarbitrary b hugs98-plus-Sep2006/fptools/hslibs/data/edison/Import/0000755006511100651110000000000010504340142021372 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/data/edison/Import/DUMMY0000644006511100651110000000013007017267134022220 0ustar rossrossThis file is here only to force CVS to create the Import directory in the distribution. hugs98-plus-Sep2006/fptools/hslibs/data/edison/Lib/0000755006511100651110000000000010504340142020626 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/data/edison/Lib/DUMMY0000644006511100651110000000012507017267134021460 0ustar rossrossThis file is here only to force CVS to create the Lib directory in the distribution. hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/0000755006511100651110000000000010504340142020650 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/BankersQueue.hs0000644006511100651110000002541410130752025023606 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module BankersQueue {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of banker's queues Seq, -- instance of Sequence, Functor, Monad, MonadPlus -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Sequence as S ( Sequence(..) ) import SequenceDefaults import qualified ListSeq as L import Monad import QuickCheck -- signatures for exported functions moduleName :: String empty :: Seq a single :: a -> Seq a cons :: a -> Seq a -> Seq a snoc :: Seq a -> a -> Seq a append :: Seq a -> Seq a -> Seq a lview :: Seq a -> Maybe2 a (Seq a) lhead :: Seq a -> a ltail :: Seq a -> Seq a rview :: Seq a -> Maybe2 (Seq a) a rhead :: Seq a -> a rtail :: Seq a -> Seq a null :: Seq a -> Bool size :: Seq a -> Int concat :: Seq (Seq a) -> Seq a reverse :: Seq a -> Seq a reverseOnto :: Seq a -> Seq a -> Seq a fromList :: [a] -> Seq a toList :: Seq a -> [a] map :: (a -> b) -> Seq a -> Seq b concatMap :: (a -> Seq b) -> Seq a -> Seq b foldr :: (a -> b -> b) -> b -> Seq a -> b foldl :: (b -> a -> b) -> b -> Seq a -> b foldr1 :: (a -> a -> a) -> Seq a -> a foldl1 :: (a -> a -> a) -> Seq a -> a reducer :: (a -> a -> a) -> a -> Seq a -> a reducel :: (a -> a -> a) -> a -> Seq a -> a reduce1 :: (a -> a -> a) -> Seq a -> a copy :: Int -> a -> Seq a tabulate :: Int -> (Int -> a) -> Seq a inBounds :: Seq a -> Int -> Bool lookup :: Seq a -> Int -> a lookupM :: Seq a -> Int -> Maybe a lookupWithDefault :: a -> Seq a -> Int -> a update :: Int -> a -> Seq a -> Seq a adjust :: (a -> a) -> Int -> Seq a -> Seq a mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b take :: Int -> Seq a -> Seq a drop :: Int -> Seq a -> Seq a splitAt :: Int -> Seq a -> (Seq a, Seq a) subseq :: Int -> Int -> Seq a -> Seq a filter :: (a -> Bool) -> Seq a -> Seq a partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a) takeWhile :: (a -> Bool) -> Seq a -> Seq a dropWhile :: (a -> Bool) -> Seq a -> Seq a splitWhile :: (a -> Bool) -> Seq a -> (Seq a, Seq a) zip :: Seq a -> Seq b -> Seq (a,b) zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c) zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d unzip :: Seq (a,b) -> (Seq a, Seq b) unzip3 :: Seq (a,b,c) -> (Seq a, Seq b, Seq c) unzipWith :: (a -> b) -> (a -> c) -> Seq a -> (Seq b, Seq c) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> Seq a -> (Seq b, Seq c, Seq d) moduleName = "BankersQueue" -- Adapted from -- Chris Okasaki. Purely Functional Data Structures. 1998. -- Section 6.3.2. -- and -- Chris Okasaki. "Simple and Efficient Purely Functional Queues and Deques". -- Journal of Functional Programming, 5(4):583-592, October 1995. data Seq a = Q !Int [a] [a] !Int -- invariant: front at least as long as rear -- not exported makeQ i xs ys j | j > i = Q (i + j) (xs ++ L.reverse ys) [] 0 | otherwise = Q i xs ys j -- not exported inc i = i + 1 -- not exported dec i = i - 1 empty = Q 0 [] [] 0 single x = Q 1 [x] [] 0 cons x (Q i xs ys j) = Q (inc i) (x:xs) ys j snoc (Q i xs ys j) y = makeQ i xs (y:ys) (inc j) append (Q i1 xs1 ys1 j1) (Q i2 xs2 ys2 j2) = Q (i1 + j1 + i2) (xs1 ++ L.reverseOnto ys1 xs2) ys2 j2 lview (Q _ [] _ _) = Nothing2 lview (Q i (x:xs) ys j) = Just2 x (makeQ (dec i) xs ys j) lhead (Q _ [] _ _) = error "BankersQueue.lhead: empty sequence" lhead (Q _ (x:xs) _ _) = x ltail (Q i (x:xs) ys j) = makeQ (dec i) xs ys j ltail q = q -- empty case rview (Q i xs (y:ys) j) = Just2 (Q i xs ys (dec j)) y rview (Q i xs [] _) = case L.rview xs of Nothing2 -> Nothing2 Just2 xs' x -> Just2 (Q (dec i) xs' [] 0) x rhead (Q i xs (y:ys) j) = y rhead (Q _ [] [] _) = error "BankersQueue.rhead: empty sequence" rhead (Q i xs [] _) = L.rhead xs rtail (Q i xs (y:ys) j) = Q i xs ys (dec j) rtail q@(Q _ [] [] _) = q -- empty case rtail (Q i xs [] _) = Q (dec i) (L.rtail xs) [] 0 null (Q i _ _ _) = (i == 0) size (Q i xs ys j) = i + j reverse (Q i xs ys j) = makeQ j ys xs i reverseOnto (Q i1 xs1 ys1 j1) (Q i2 xs2 ys2 j2) = Q (i1 + j1 + i2) (ys1 ++ L.reverseOnto xs1 xs2) ys2 j2 fromList xs = Q (length xs) xs [] 0 toList (Q i xs ys j) | j == 0 = xs | otherwise = xs ++ L.reverse ys map f (Q i xs ys j) = Q i (L.map f xs) (L.map f ys) j -- local fn on lists revfoldr f e [] = e revfoldr f e (x:xs) = revfoldr f (f x e) xs -- local fn on lists revfoldl f e [] = e revfoldl f e (x:xs) = f (revfoldl f e xs) x foldr f e (Q i xs ys j) = L.foldr f (revfoldr f e ys) xs foldl f e (Q i xs ys j) = revfoldl f (L.foldl f e xs) ys foldr1 f (Q i xs (y:ys) j) = L.foldr f (revfoldr f y ys) xs foldr1 f (Q i xs [] _) | i == 0 = error "BankersQueue.foldr1: empty sequence" | otherwise = L.foldr1 f xs foldl1 f (Q i (x:xs) ys j) = revfoldl f (L.foldl f x xs) ys foldl1 f _ = error "BankersQueue.foldl1: empty sequence" copy n x | n < 0 = empty | otherwise = Q n (L.copy n x) [] 0 tabulate n f | n < 0 = empty | otherwise = Q n (L.tabulate n f) [] 0 -- reduce1: given sizes could do more effective job of dividing evenly! lookup (Q i xs ys j) idx | idx < i = L.lookup xs idx | otherwise = L.lookup ys (j - (idx - i) - 1) lookupM (Q i xs ys j) idx | idx < i = L.lookupM xs idx | otherwise = L.lookupM ys (j - (idx - i) - 1) lookupWithDefault d (Q i xs ys j) idx | idx < i = L.lookupWithDefault d xs idx | otherwise = L.lookupWithDefault d ys (j - (idx - i) - 1) update idx e q@(Q i xs ys j) | idx < i = if idx < 0 then q else Q i (L.update idx e xs) ys j | otherwise = let k' = j - (idx - i) - 1 in if k' < 0 then q else Q i xs (L.update k' e ys) j adjust f idx q@(Q i xs ys j) | idx < i = if idx < 0 then q else Q i (L.adjust f idx xs) ys j | otherwise = let k' = j - (idx - i) - 1 in if k' < 0 then q else Q i xs (L.adjust f k' ys) j {- could do mapWithIndex :: (Int -> a -> b) -> s a -> s b foldrWithIndex :: (Int -> a -> b -> b) -> b -> s a -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> s a -> b but don't bother for now -} take len q@(Q i xs ys j) = if len <= i then if len <= 0 then empty else Q len (L.take len xs) [] 0 else let len' = len - i in if len' >= j then q else Q i xs (L.drop (j - len') ys) len' drop len q@(Q i xs ys j) = if len <= i then if len <= 0 then q else makeQ (i - len) (L.drop len xs) ys j else let len' = len - i in if len' >= j then empty else Q (j - len') (L.reverse (L.take (j - len') ys)) [] 0 -- could write more efficient version of reverse (take ...) splitAt idx q@(Q i xs ys j) = if idx <= i then if idx <= 0 then (empty, q) else let (xs',xs'') = L.splitAt idx xs in (Q idx xs' [] 0, makeQ (i - idx) xs'' ys j) else let idx' = idx - i in if idx' >= j then (q, empty) else let (ys', ys'') = L.splitAt (j - idx') ys in (Q i xs ys'' idx', Q (j - idx') (L.reverse ys') [] 0) -- could do splitAt followed by reverse more efficiently... -- the remaining functions all use defaults concat = concatUsingFoldr concatMap = concatMapUsingFoldr reducer = reducerUsingReduce1 reducel = reducelUsingReduce1 reduce1 = reduce1UsingLists inBounds = inBoundsUsingSize mapWithIndex = mapWithIndexUsingLists foldrWithIndex = foldrWithIndexUsingLists foldlWithIndex = foldlWithIndexUsingLists subseq = subseqDefault filter = filterUsingLists partition = partitionUsingLists takeWhile = takeWhileUsingLview dropWhile = dropWhileUsingLview splitWhile = splitWhileUsingLview zip = zipUsingLists zip3 = zip3UsingLists zipWith = zipWithUsingLists zipWith3 = zipWith3UsingLists unzip = unzipUsingLists unzip3 = unzip3UsingLists unzipWith = unzipWithUsingLists unzipWith3 = unzipWith3UsingLists -- instances instance S.Sequence Seq where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName s = moduleName} instance Functor Seq where fmap = map instance Monad Seq where return = single xs >>= k = concatMap k xs instance MonadPlus Seq where mplus = append mzero = empty instance Eq a => Eq (Seq a) where q1 == q2 = (size q1 == size q2) && (toList q1 == toList q2) instance Show a => Show (Seq a) where show q = show (toList q) instance Arbitrary a => Arbitrary (Seq a) where arbitrary = do xs <- arbitrary ys <- arbitrary return (let i = L.size xs j = L.size ys in if i >= j then Q i xs ys j else Q j ys xs i) coarbitrary (Q i xs ys j) = coarbitrary xs . coarbitrary ys hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/BinaryRandList.hs0000644006511100651110000002561610162405440024106 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module BinaryRandList {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type Seq, -- instance of Sequence, Functor, Monad, MonadPlus -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Sequence as S ( Sequence(..) ) import SequenceDefaults import Monad import QuickCheck -- signatures for exported functions moduleName :: String empty :: Seq a single :: a -> Seq a cons :: a -> Seq a -> Seq a snoc :: Seq a -> a -> Seq a append :: Seq a -> Seq a -> Seq a lview :: Seq a -> Maybe2 a (Seq a) lhead :: Seq a -> a ltail :: Seq a -> Seq a rview :: Seq a -> Maybe2 (Seq a) a rhead :: Seq a -> a rtail :: Seq a -> Seq a null :: Seq a -> Bool size :: Seq a -> Int concat :: Seq (Seq a) -> Seq a reverse :: Seq a -> Seq a reverseOnto :: Seq a -> Seq a -> Seq a fromList :: [a] -> Seq a toList :: Seq a -> [a] map :: (a -> b) -> Seq a -> Seq b concatMap :: (a -> Seq b) -> Seq a -> Seq b foldr :: (a -> b -> b) -> b -> Seq a -> b foldl :: (b -> a -> b) -> b -> Seq a -> b foldr1 :: (a -> a -> a) -> Seq a -> a foldl1 :: (a -> a -> a) -> Seq a -> a reducer :: (a -> a -> a) -> a -> Seq a -> a reducel :: (a -> a -> a) -> a -> Seq a -> a reduce1 :: (a -> a -> a) -> Seq a -> a copy :: Int -> a -> Seq a tabulate :: Int -> (Int -> a) -> Seq a inBounds :: Seq a -> Int -> Bool lookup :: Seq a -> Int -> a lookupM :: Seq a -> Int -> Maybe a lookupWithDefault :: a -> Seq a -> Int -> a update :: Int -> a -> Seq a -> Seq a adjust :: (a -> a) -> Int -> Seq a -> Seq a mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b take :: Int -> Seq a -> Seq a drop :: Int -> Seq a -> Seq a splitAt :: Int -> Seq a -> (Seq a, Seq a) subseq :: Int -> Int -> Seq a -> Seq a filter :: (a -> Bool) -> Seq a -> Seq a partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a) takeWhile :: (a -> Bool) -> Seq a -> Seq a dropWhile :: (a -> Bool) -> Seq a -> Seq a splitWhile :: (a -> Bool) -> Seq a -> (Seq a, Seq a) zip :: Seq a -> Seq b -> Seq (a,b) zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c) zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d unzip :: Seq (a,b) -> (Seq a, Seq b) unzip3 :: Seq (a,b,c) -> (Seq a, Seq b, Seq c) unzipWith :: (a -> b) -> (a -> c) -> Seq a -> (Seq b, Seq c) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> Seq a -> (Seq b, Seq c, Seq d) moduleName = "BinaryRandList" -- Adapted from -- Chris Okasaki. Purely Functional Data Structures. 1998. -- Section 10.1.2. data Seq a = E | Even (Seq (a,a)) | Odd a (Seq (a,a)) deriving (Eq) -- not exported, rewrite as bit ops? --even n = (n `mod` 2) == 0 --odd n = (n `mod` 2) <> 0 half n = n `div` 2 mkEven E = E mkEven ps = Even ps empty = E single x = Odd x E cons x E = Odd x E cons x (Even ps) = Odd x ps cons x (Odd y ps) = Even (cons (x,y) ps) append xs E = xs append xs ys@(Even pys) = case xs of E -> ys Even pxs -> Even (append pxs pys) Odd x pxs -> Odd x (append pxs pys) append xs ys@(Odd _ _) = foldr cons ys xs copy n x | n <= 0 = E | otherwise = cp n x where cp :: Int -> a' -> Seq a' cp n x | odd n = Odd x (cp (half n) (x,x)) | n == 0 = E | otherwise = Even (cp (half n) (x,x)) lview E = Nothing2 lview (Even ps) = case lview ps of Just2 (x,y) ps' -> Just2 x (Odd y ps') lview (Odd x ps) = Just2 x (mkEven ps) lhead E = error "BinaryRandList.lhead: empty sequence" lhead (Even ps) = fst (lhead ps) lhead (Odd x ps) = x ltail E = E ltail (Even ps) = case lview ps of Just2 (x,y) ps' -> Odd y ps' ltail (Odd x ps) = mkEven ps rhead E = error "BinaryRandList.rhead: empty sequence" rhead (Even ps) = snd (rhead ps) rhead (Odd x E) = x rhead (Odd x ps) = snd (rhead ps) null E = True null _ = False size E = 0 size (Even ps) = 2 * size ps size (Odd x ps) = 1 + 2 * size ps map f E = E map f (Even ps) = Even (map (\(x,y) -> (f x,f y)) ps) map f (Odd x ps) = Odd (f x) (map (\(x,y) -> (f x,f y)) ps) foldr f e E = e foldr f e (Even ps) = foldr (\(x,y) e -> f x (f y e)) e ps foldr f e (Odd x ps) = f x (foldr (\(x,y) e -> f x (f y e)) e ps) foldl f e E = e foldl f e (Even ps) = foldl (\e (x,y) -> f (f e x) y) e ps foldl f e (Odd x ps) = foldl (\e (x,y) -> f (f e x) y) (f e x) ps reduce1 f E = error "BinaryRandList.reduce1: empty seq" reduce1 f (Even ps) = reduce1 f (map (uncurry f) ps) reduce1 f (Odd x E) = x reduce1 f (Odd x ps) = f x (reduce1 f (map (uncurry f) ps)) inBounds xs i = (i >= 0) && inb xs i where inb :: Seq a' -> Int -> Bool inb E i = False inb (Even ps) i = inb ps (half i) inb (Odd x ps) i = (i == 0) || inb ps (half (i-1)) lookup xs i | i < 0 = error "BinaryRandList.lookup: bad subscript" | otherwise = look xs i where look :: Seq a' -> Int -> a' look E i = error "BinaryRandList.lookup: bad subscript" look (Even ps) i = if even i then x else y where (x,y) = look ps (half i) look (Odd x ps) i | odd i = fst (look ps (half (i-1))) | i == 0 = x | otherwise = snd (look ps (half (i-1))) lookupM xs i | i < 0 = Nothing | otherwise = lookFun Nothing xs i Just lookupWithDefault d xs i | i < 0 = d | otherwise = lookFun d xs i id -- not exported lookFun :: b -> Seq a -> Int -> (a -> b) -> b lookFun d E i f = d lookFun d (Even ps) i f | even i = lookFun d ps (half i) (f . fst) | otherwise = lookFun d ps (half i) (f . snd) lookFun d (Odd x ps) i f | odd i = lookFun d ps (half (i-1)) (f . fst) | i == 0 = f x | otherwise = lookFun d ps (half (i-1)) (f . snd) adjust f i xs | i < 0 = xs | otherwise = adj f i xs where adj :: (a' -> a') -> Int -> Seq a' -> Seq a' adj f i E = E adj f i (Even ps) | even i = Even (adj (mapFst f) (half i) ps) | otherwise = Even (adj (mapSnd f) (half i) ps) adj f i (Odd x ps) | odd i = Odd x (adj (mapFst f) (half (i-1)) ps) | i == 0 = Odd (f x) ps | otherwise = Odd x (adj (mapSnd f) (half (i-1)) ps) -- not exported mapFst f (x,y) = (f x,y) mapSnd f (x,y) = (x,f y) take n xs = if n <= 0 then E else tak n xs where tak :: Int -> Seq a' -> Seq a' tak 0 xs = E tak i E = E tak i (Even ps) | even i = Even (tak (half i) ps) tak i (Odd x ps) | odd i = Odd x (tak (half (i-1)) ps) tak i xs = takeUsingLists i xs -- drop is O(log^2 n) instead of O(log n)?? drop n xs = if n <= 0 then xs else drp n xs where drp :: Int -> Seq a' -> Seq a' drp 0 xs = xs drp i E = E drp i (Even ps) | even i = mkEven (drp (half i) ps) | otherwise = ltail (mkEven (drp (half i) ps)) drp i (Odd _ ps) | odd i = mkEven (drp (half (i-1)) ps) | otherwise = ltail (mkEven (drp (half (i-1)) ps)) -- the remaining functions all use defaults snoc = snocUsingFoldr rview = rviewDefault rtail = rtailUsingLview concat = concatUsingFoldr reverse = reverseUsingReverseOnto reverseOnto = reverseOntoUsingFoldl fromList = fromListUsingCons toList = toListUsingFoldr concatMap = concatMapUsingFoldr foldr1 = foldr1UsingLview foldl1 = foldl1UsingFoldl reducer = reducerUsingReduce1 reducel = reducelUsingReduce1 tabulate = tabulateUsingLists update = updateUsingAdjust mapWithIndex = mapWithIndexUsingLists foldrWithIndex = foldrWithIndexUsingLists foldlWithIndex = foldlWithIndexUsingLists splitAt = splitAtDefault filter = filterUsingFoldr partition = partitionUsingFoldr subseq = subseqDefault takeWhile = takeWhileUsingLview dropWhile = dropWhileUsingLview splitWhile = splitWhileUsingLview -- for zips, could optimize by calculating which one is shorter and -- retaining its shape zip = zipUsingLists zip3 = zip3UsingLists zipWith = zipWithUsingLists zipWith3 = zipWith3UsingLists unzip = unzipUsingLists unzip3 = unzip3UsingLists unzipWith = unzipWithUsingLists unzipWith3 = unzipWith3UsingLists -- instances instance S.Sequence Seq where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName s = moduleName} instance Functor Seq where fmap = map instance Monad Seq where return = single xs >>= k = concatMap k xs instance MonadPlus Seq where mplus = append mzero = empty -- instance Eq (Seq a) is derived instance Show a => Show (Seq a) where show xs = show (toList xs) instance Arbitrary a => Arbitrary (Seq a) where arbitrary = do xs <- arbitrary return (fromList xs) coarbitrary E = variant 0 coarbitrary (Even ps) = variant 1 . coarbitrary ps coarbitrary (Odd x ps) = variant 2 . coarbitrary x . coarbitrary ps hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/BraunSeq.hs0000644006511100651110000003367610130752025022745 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. -- These Braun sequences support cons in O(log n) -- time, but snoc in O(log^2 n) time. By keeping -- track of the size, we could get snoc down to O(log n) -- as well. module BraunSeq {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of one-sided Braun sequences Seq, -- instance of Sequence, Functor, Monad, MonadPlus -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Sequence as S ( Sequence(..) ) import SequenceDefaults import qualified ListSeq as L import Monad import QuickCheck -- signatures for exported functions moduleName :: String empty :: Seq a single :: a -> Seq a cons :: a -> Seq a -> Seq a snoc :: Seq a -> a -> Seq a append :: Seq a -> Seq a -> Seq a lview :: Seq a -> Maybe2 a (Seq a) lhead :: Seq a -> a ltail :: Seq a -> Seq a rview :: Seq a -> Maybe2 (Seq a) a rhead :: Seq a -> a rtail :: Seq a -> Seq a null :: Seq a -> Bool size :: Seq a -> Int concat :: Seq (Seq a) -> Seq a reverse :: Seq a -> Seq a reverseOnto :: Seq a -> Seq a -> Seq a fromList :: [a] -> Seq a toList :: Seq a -> [a] map :: (a -> b) -> Seq a -> Seq b concatMap :: (a -> Seq b) -> Seq a -> Seq b foldr :: (a -> b -> b) -> b -> Seq a -> b foldl :: (b -> a -> b) -> b -> Seq a -> b foldr1 :: (a -> a -> a) -> Seq a -> a foldl1 :: (a -> a -> a) -> Seq a -> a reducer :: (a -> a -> a) -> a -> Seq a -> a reducel :: (a -> a -> a) -> a -> Seq a -> a reduce1 :: (a -> a -> a) -> Seq a -> a copy :: Int -> a -> Seq a tabulate :: Int -> (Int -> a) -> Seq a inBounds :: Seq a -> Int -> Bool lookup :: Seq a -> Int -> a lookupM :: Seq a -> Int -> Maybe a lookupWithDefault :: a -> Seq a -> Int -> a update :: Int -> a -> Seq a -> Seq a adjust :: (a -> a) -> Int -> Seq a -> Seq a mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b take :: Int -> Seq a -> Seq a drop :: Int -> Seq a -> Seq a splitAt :: Int -> Seq a -> (Seq a, Seq a) subseq :: Int -> Int -> Seq a -> Seq a filter :: (a -> Bool) -> Seq a -> Seq a partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a) takeWhile :: (a -> Bool) -> Seq a -> Seq a dropWhile :: (a -> Bool) -> Seq a -> Seq a splitWhile :: (a -> Bool) -> Seq a -> (Seq a, Seq a) zip :: Seq a -> Seq b -> Seq (a,b) zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c) zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d unzip :: Seq (a,b) -> (Seq a, Seq b) unzip3 :: Seq (a,b,c) -> (Seq a, Seq b, Seq c) unzipWith :: (a -> b) -> (a -> c) -> Seq a -> (Seq b, Seq c) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> Seq a -> (Seq b, Seq c, Seq d) moduleName = "BraunSeq" -- Adapted from -- Rob Hoogerwoord. "A Logarithmic Implementation of Flexible Arrays". -- Mathematics of Program Construction (MPC'92), pages 191-207. -- and -- Chris Okasaki. "Three algorithms on Braun Trees". -- JFP 7(6):661-666. Novemebr 1997. data Seq a = E | B a (Seq a) (Seq a) deriving (Eq) half :: Int -> Int half n = n `quot` 2 -- use a shift? empty = E single x = B x E E cons x E = single x cons x (B y a b) = B x (cons y b) a snoc ys y = insAt (size ys) ys where insAt 0 _ = single y insAt i (B x a b) | odd i = B x (insAt (half i) a) b | otherwise = B x a (insAt (half i - 1) b) insAt _ _ = error "BraunSeq.snoc: bug. Impossible case!" append xs E = xs append xs ys = app (size xs) xs ys where app 0 xs ys = ys app n xs E = xs app n (B x a b) (B y c d) | odd n = B x (app m a (cons y d)) (app m b c) | otherwise = B x (app m a c) (app (m-1) b (cons y d)) where m = half n -- how does it compare to converting to/from lists? lview E = Nothing2 lview (B x a b) = Just2 x (combine a b) -- not exported combine E _ = E combine (B x a b) c = B x c (combine a b) lhead E = error "BraunSeq.lhead: empty sequence" lhead (B x a b) = x ltail E = E ltail (B x a b) = combine a b -- not exported -- precondition: i >= 0 delAt 0 _ = E delAt i (B x a b) | odd i = B x (delAt (half i) a) b | otherwise = B x a (delAt (half i - 1) b) delAt _ _ = error "BraunSeq.delAt: bug. Impossible case!" rview E = Nothing2 rview xs = Just2 (delAt m xs) (lookup xs m) where m = size xs - 1 rhead E = error "BraunSeq.rhead: empty sequence" rhead xs = lookup xs (size xs - 1) rtail E = E rtail xs = delAt (size xs - 1) xs null E = True null _ = False size E = 0 size (B x a b) = 1 + n + n + diff n a where n = size b diff 0 E = 0 diff 0 (B x a b) = 1 diff i (B x a b) | odd i = diff (half i) a | otherwise = diff (half i - 1) b diff _ _ = error "BraunSeq.size: bug. Impossible case in diff!" reverse xs = rev00 (size xs) xs where rev00 n xs | n <= 1 = xs rev00 n (B x a b) | odd n = let a' = rev00 m a (x',b') = rev11 m x b in B x' a' b' | otherwise = let (x',a') = rev01 m a b' = rev10 (m-1) x b in B x' b' a' where m = half n rev11 n x E = (x,E) rev11 n x (B y a b) | odd n = let (x',a') = rev11 m x a (y',b') = rev11 m y b in (y', B x' b' a') | otherwise = let (x',a') = rev11 m x a (y',b') = rev11 (m-1) y b in (x', B y' a' b') where m = half n rev01 n E = error "BraunSeq.reverse: bug!" rev01 n (B x a b) | n == 1 = (x, E) | odd n = let (y',a') = rev01 m a (x',b') = rev11 m x b in (x', B y' b' a') | otherwise = let (y',a') = rev01 m a (x',b') = rev11 (m-1) x b in (y', B x' a' b') where m = half n rev10 n x E = B x E E rev10 n x (B y a b) | odd n = let a' = rev10 m x a (y',b') = rev11 m y b in B y' a' b' | otherwise = let (x',a') = rev11 m x a b' = rev10 (m-1) y b in B x' b' a' where m = half n fromList = L.lhead . L.foldr build [E] . rows 1 where rows k [] = [] rows k xs = (k, ys) : rows (k+k) zs where (ys,zs) = L.splitAt k xs build (k,xs) ts = zipWithB xs ts1 ts2 where (ts1, ts2) = L.splitAt k ts zipWithB [] _ _ = [] zipWithB (x:xs) [] _ = single x : L.map single xs zipWithB (x:xs) (t:ts) [] = B x t E : zipWithB xs ts [] zipWithB (x:xs) (t1:ts1) (t2:ts2) = B x t1 t2 : zipWithB xs ts1 ts2 toList E = [] toList t = tol [t] where tol [] = [] tol ts = xs ++ tol (ts1 ++ ts2) where xs = L.map root ts (ts1,ts2) = children ts children [] = ([],[]) children (B x E _ : ts) = ([],[]) children (B x a E : ts) = (a : leftChildren ts, []) children (B x a b : ts) = (a : ts1, b : ts2) where (ts1, ts2) = children ts leftChildren [] = [] leftChildren (B x E _ : ts) = [] leftChildren (B x a b : ts) = a : leftChildren ts root (B x a b) = x left (B x a b) = a map f E = E map f (B x a b) = B (f x) (map f a) (map f b) copy n x = if n <= 0 then empty else fst (copy2 n) where copy2 n | odd n = (B x a a, B x b a) | n == 0 = (E, single x) | otherwise = (B x b a, B x b b) where (a, b) = copy2 (half (n-1)) tabulate n f = if n <= 0 then empty else tab 0 1 where tab i d | i >= n = E | otherwise = B (f i) (tab (i+d) dd) (tab (i+dd) dd) where dd = d+d inBounds xs i = (i >= 0) && inb xs i where inb E i = False inb (B x a b) i | odd i = inb a (half i) | i == 0 = True | otherwise = inb b (half i - 1) lookup xs i = if i < 0 then error "BraunSeq.lookup: bad subscript" else look xs i where look E i = error "BraunSeq.lookup: bad subscript" look (B x a b) i | odd i = look a (half i) | i == 0 = x | otherwise = look b (half i - 1) lookupM xs i = if i < 0 then Nothing else look xs i where look E i = Nothing look (B x a b) i | odd i = look a (half i) | i == 0 = Just x | otherwise = look b (half i - 1) lookupWithDefault d xs i = if i < 0 then d else look xs i where look E i = d look (B x a b) i | odd i = look a (half i) | i == 0 = x | otherwise = look b (half i - 1) update i y xs = if i < 0 then xs else upd i xs where upd i E = E upd i (B x a b) | odd i = B x (upd (half i) a) b | i == 0 = B y a b | otherwise = B x a (upd (half i - 1) b) adjust f i xs = if i < 0 then xs else adj i xs where adj i E = E adj i (B x a b) | odd i = B x (adj (half i) a) b | i == 0 = B (f x) a b | otherwise = B x a (adj (half i - 1) b) mapWithIndex f xs = mwi 0 1 xs where mwi i d E = E mwi i d (B x a b) = B (f i x) (mwi (i+d) dd a) (mwi (i+dd) dd b) where dd = d+d take n xs = if n <= 0 then E else ta n xs where ta n E = E ta n (B x a b) | odd n = B x (ta m a) (ta m b) | n == 0 = E | otherwise = B x (ta m a) (ta (m-1) b) where m = half n drop n xs = if n <= 0 then xs else dr n xs where dr n E = E dr n t@(B x a b) | odd n = combine (dr m a) (dr m b) | n == 0 = t | otherwise = combine (dr (m-1) b) (dr m a) where m = half n zip (B x a b) (B y c d) = B (x,y) (zip a c) (zip b d) zip _ _ = E zip3 (B x a b) (B y c d) (B z e f) = B (x,y,z) (zip3 a c e) (zip3 b d f) zip3 _ _ _ = E zipWith f (B x a b) (B y c d) = B (f x y) (zipWith f a c) (zipWith f b d) zipWith f _ _ = E zipWith3 fn (B x a b) (B y c d) (B z e f) = B (fn x y z) (zipWith3 fn a c e) (zipWith3 fn b d f) zipWith3 fn _ _ _ = E unzip E = (E, E) unzip (B (x,y) a b) = (B x a1 b1, B y a2 b2) where (a1,a2) = unzip a (b1,b2) = unzip b unzip3 E = (E, E, E) unzip3 (B (x,y,z) a b) = (B x a1 b1, B y a2 b2, B z a3 b3) where (a1,a2,a3) = unzip3 a (b1,b2,b3) = unzip3 b unzipWith f g E = (E, E) unzipWith f g (B x a b) = (B (f x) a1 b1, B (g x) a2 b2) where (a1,a2) = unzipWith f g a (b1,b2) = unzipWith f g b unzipWith3 f g h E = (E, E, E) unzipWith3 f g h (B x a b) = (B (f x) a1 b1, B (g x) a2 b2, B (h x) a3 b3) where (a1,a2,a3) = unzipWith3 f g h a (b1,b2,b3) = unzipWith3 f g h b -- the remaining functions all use defaults concat = concatUsingFoldr reverseOnto = reverseOntoUsingReverse concatMap = concatMapUsingFoldr foldr = foldrUsingLists foldl = foldlUsingLists foldr1 = foldr1UsingLists foldl1 = foldl1UsingLists reducer = reducerUsingReduce1 reducel = reducelUsingReduce1 reduce1 = reduce1UsingLists foldrWithIndex = foldrWithIndexUsingLists foldlWithIndex = foldlWithIndexUsingLists splitAt = splitAtDefault subseq = subseqDefault filter = filterUsingLists partition = partitionUsingLists takeWhile = takeWhileUsingLview dropWhile = dropWhileUsingLview splitWhile = splitWhileUsingLview -- instances instance S.Sequence Seq where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName s = moduleName} instance Functor Seq where fmap = map instance Monad Seq where return = single xs >>= k = concatMap k xs instance MonadPlus Seq where mplus = append mzero = empty -- instance Eq (Seq a) is derived instance Show a => Show (Seq a) where show xs = show (toList xs) instance Arbitrary a => Arbitrary (Seq a) where arbitrary = arbitrary >>= (return . fromList) coarbitrary xs = coarbitrary (toList xs) hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/COPYRIGHT0000644006511100651110000000205207017267134022160 0ustar rossrossCopyright (c) 1998-1999 Chris Okasaki 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. hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/JoinList.hs0000644006511100651110000002264210130752025022747 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module JoinList {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of join lists Seq, -- instance of Sequence, Functor, Monad, MonadPlus -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Sequence as S ( Sequence(..) ) import SequenceDefaults import Monad import QuickCheck -- signatures for exported functions moduleName :: String empty :: Seq a single :: a -> Seq a cons :: a -> Seq a -> Seq a snoc :: Seq a -> a -> Seq a append :: Seq a -> Seq a -> Seq a lview :: Seq a -> Maybe2 a (Seq a) lhead :: Seq a -> a ltail :: Seq a -> Seq a rview :: Seq a -> Maybe2 (Seq a) a rhead :: Seq a -> a rtail :: Seq a -> Seq a null :: Seq a -> Bool size :: Seq a -> Int concat :: Seq (Seq a) -> Seq a reverse :: Seq a -> Seq a reverseOnto :: Seq a -> Seq a -> Seq a fromList :: [a] -> Seq a toList :: Seq a -> [a] map :: (a -> b) -> Seq a -> Seq b concatMap :: (a -> Seq b) -> Seq a -> Seq b foldr :: (a -> b -> b) -> b -> Seq a -> b foldl :: (b -> a -> b) -> b -> Seq a -> b foldr1 :: (a -> a -> a) -> Seq a -> a foldl1 :: (a -> a -> a) -> Seq a -> a reducer :: (a -> a -> a) -> a -> Seq a -> a reducel :: (a -> a -> a) -> a -> Seq a -> a reduce1 :: (a -> a -> a) -> Seq a -> a copy :: Int -> a -> Seq a tabulate :: Int -> (Int -> a) -> Seq a inBounds :: Seq a -> Int -> Bool lookup :: Seq a -> Int -> a lookupM :: Seq a -> Int -> Maybe a lookupWithDefault :: a -> Seq a -> Int -> a update :: Int -> a -> Seq a -> Seq a adjust :: (a -> a) -> Int -> Seq a -> Seq a mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b take :: Int -> Seq a -> Seq a drop :: Int -> Seq a -> Seq a splitAt :: Int -> Seq a -> (Seq a, Seq a) subseq :: Int -> Int -> Seq a -> Seq a filter :: (a -> Bool) -> Seq a -> Seq a partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a) takeWhile :: (a -> Bool) -> Seq a -> Seq a dropWhile :: (a -> Bool) -> Seq a -> Seq a splitWhile :: (a -> Bool) -> Seq a -> (Seq a, Seq a) zip :: Seq a -> Seq b -> Seq (a,b) zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c) zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d unzip :: Seq (a,b) -> (Seq a, Seq b) unzip3 :: Seq (a,b,c) -> (Seq a, Seq b, Seq c) unzipWith :: (a -> b) -> (a -> c) -> Seq a -> (Seq b, Seq c) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> Seq a -> (Seq b, Seq c, Seq d) moduleName = "JoinList" data Seq a = E | L a | A (Seq a) (Seq a) -- invariant: E never a child of A half :: Int -> Int half n = n `div` 2 empty = E single = L cons x E = L x cons x xs = A (L x) xs snoc E x = L x snoc xs x = A xs (L x) append E ys = ys append xs E = xs append xs ys = A xs ys -- path reversal on lview/ltail lview E = Nothing2 lview (L x) = Just2 x E lview (A xs ys) = lvw xs ys where lvw E zs = error "JoinList.lvw: bug" lvw (L x) zs = Just2 x zs lvw (A xs ys) zs = lvw xs (A ys zs) lhead E = error "JoinList.lhead: empty sequence" lhead (L x) = x lhead (A xs ys) = lhead xs ltail E = E ltail (L x) = E ltail (A xs ys) = ltl xs ys where ltl E zs = error "JoinList.ltl: bug" ltl (L x) zs = zs ltl (A xs ys) zs = ltl xs (A ys zs) -- Don't want to do plain path reversal on rview/rtail because of expectation -- that left accesses are more common, so we would prefer to keep the left -- spine short. rview E = Nothing2 rview (L x) = Just2 E x rview (A xs ys) = rvw xs ys where rvw xs (A ys (A zs s)) = rvw (A xs (A ys zs)) s rvw xs (A ys (L x)) = Just2 (A xs ys) x rvw xs (L x) = Just2 xs x rvw xs _ = error "JoinList.rvw: bug" rhead E = error "JoinList.rhead: empty sequence" rhead (L x) = x rhead (A xs ys) = rhead ys rtail E = E rtail (L x) = E rtail (A xs ys) = rtl xs ys where rtl xs (A ys (A zs s)) = A (A xs ys) (rtl zs s) rtl xs (A ys (L _)) = A xs ys rtl xs (L x) = xs rtl xs _ = error "JoinList.rtl: bug" null E = True null _ = False size xs = sz xs (0::Int) where sz E n = n sz (L x) n = n + (1::Int) sz (A xs ys) n = sz xs (sz ys n) reverse (A xs ys) = A (reverse ys) (reverse xs) reverse xs = xs -- L x or E toList xs = tol xs [] where tol E rest = rest tol (L x) rest = x:rest tol (A xs ys) rest = tol xs (tol ys rest) map f E = E map f (L x) = L (f x) map f (A xs ys) = A (map f xs) (map f ys) foldr f e E = e foldr f e (L x) = f x e foldr f e (A xs ys) = foldr f (foldr f e ys) xs foldl f e E = e foldl f e (L x) = f e x foldl f e (A xs ys) = foldl f (foldl f e xs) ys foldr1 f E = error "JoinList.foldr1: empty sequence" foldr1 f (L x) = x foldr1 f (A xs ys) = foldr f (foldr1 f ys) xs foldl1 f E = error "JoinList.foldl1: empty sequence" foldl1 f (L x) = x foldl1 f (A xs ys) = foldl f (foldl1 f xs) ys copy n x | n <= 0 = E | otherwise = cpy n x where cpy n x -- n > 0 | even n = let xs = cpy (half n) x in A xs xs | n == 1 = L x | otherwise = let xs = cpy (half n) x in A (L x) (A xs xs) tabulate n f | n <= 0 = E | otherwise = tab 0 where m = n-1 tab i = if i == m then L (f i) else A (L (f i)) (tab (i+1)) -- the remaining functions all use defaults concat = concatUsingFoldr reverseOnto = reverseOntoUsingReverse fromList = fromListUsingCons concatMap = concatMapUsingFoldr reducer = reducerUsingReduce1 reducel = reducelUsingReduce1 reduce1 = reduce1UsingLists inBounds = inBoundsUsingDrop lookup = lookupUsingDrop lookupM = lookupMUsingDrop lookupWithDefault = lookupWithDefaultUsingDrop update = updateUsingSplitAt adjust = adjustUsingSplitAt mapWithIndex = mapWithIndexUsingLists foldrWithIndex = foldrWithIndexUsingLists foldlWithIndex = foldlWithIndexUsingLists take = takeUsingLview drop = dropUsingLtail splitAt = splitAtUsingLview subseq = subseqDefault filter = filterUsingLview partition = partitionUsingFoldr takeWhile = takeWhileUsingLview dropWhile = dropWhileUsingLview splitWhile = splitWhileUsingLview zip = zipUsingLview zip3 = zip3UsingLview zipWith = zipWithUsingLview zipWith3 = zipWith3UsingLview unzip = unzipUsingFoldr unzip3 = unzip3UsingFoldr unzipWith = unzipWithUsingFoldr unzipWith3 = unzipWith3UsingFoldr -- instances instance S.Sequence Seq where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName s = moduleName} instance Functor Seq where fmap = map instance Monad Seq where return = single xs >>= k = concatMap k xs instance MonadPlus Seq where mplus = append mzero = empty instance Eq a => Eq (Seq a) where xs == ys = toList xs == toList ys instance Show a => Show (Seq a) where show xs = show (toList xs) instance Arbitrary a => Arbitrary (Seq a) where arbitrary = sized arbTree where arbTree 0 = return E arbTree 1 = liftM L arbitrary arbTree n = frequency [(1, liftM L arbitrary), (4, liftM2 A (arbTree (n `div` 2)) (arbTree (n `div` 2)))] coarbitrary E = variant 0 coarbitrary (L x) = variant 1 . coarbitrary x coarbitrary (A xs ys) = variant 2 . coarbitrary xs . coarbitrary ys hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/ListSeq.hs0000644006511100651110000002030710130752025022574 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module ListSeq {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type synonym Seq, -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import qualified Prelude import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified List(partition) import qualified Sequence as S ( Sequence(..) ) -- signatures for exported functions moduleName :: String empty :: [a] single :: a -> [a] cons :: a -> [a] -> [a] snoc :: [a] -> a -> [a] append :: [a] -> [a] -> [a] lview :: [a] -> Maybe2 a ([a]) lhead :: [a] -> a ltail :: [a] -> [a] rview :: [a] -> Maybe2 ([a]) a rhead :: [a] -> a rtail :: [a] -> [a] null :: [a] -> Bool size :: [a] -> Int concat :: [[a]] -> [a] reverse :: [a] -> [a] reverseOnto :: [a] -> [a] -> [a] fromList :: [a] -> [a] toList :: [a] -> [a] map :: (a -> b) -> [a] -> [b] concatMap :: (a -> [b]) -> [a] -> [b] foldr :: (a -> b -> b) -> b -> [a] -> b foldl :: (b -> a -> b) -> b -> [a] -> b foldr1 :: (a -> a -> a) -> [a] -> a foldl1 :: (a -> a -> a) -> [a] -> a reducer :: (a -> a -> a) -> a -> [a] -> a reducel :: (a -> a -> a) -> a -> [a] -> a reduce1 :: (a -> a -> a) -> [a] -> a copy :: Int -> a -> [a] tabulate :: Int -> (Int -> a) -> [a] inBounds :: [a] -> Int -> Bool lookup :: [a] -> Int -> a lookupM :: [a] -> Int -> Maybe a lookupWithDefault :: a -> [a] -> Int -> a update :: Int -> a -> [a] -> [a] adjust :: (a -> a) -> Int -> [a] -> [a] mapWithIndex :: (Int -> a -> b) -> [a] -> [b] foldrWithIndex :: (Int -> a -> b -> b) -> b -> [a] -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> [a] -> b take :: Int -> [a] -> [a] drop :: Int -> [a] -> [a] splitAt :: Int -> [a] -> ([a], [a]) subseq :: Int -> Int -> [a] -> [a] filter :: (a -> Bool) -> [a] -> [a] partition :: (a -> Bool) -> [a] -> ([a], [a]) takeWhile :: (a -> Bool) -> [a] -> [a] dropWhile :: (a -> Bool) -> [a] -> [a] splitWhile :: (a -> Bool) -> [a] -> ([a], [a]) zip :: [a] -> [b] -> [(a,b)] zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] unzip :: [(a,b)] -> ([a], [b]) unzip3 :: [(a,b,c)] -> ([a], [b], [c]) unzipWith :: (a -> b) -> (a -> c) -> [a] -> ([b], [c]) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> [a] -> ([b], [c], [d]) moduleName = "ListSeq" type Seq a = [a] empty = [] single x = [x] cons = (:) snoc s x = s ++ [x] append = (++) lview [] = Nothing2 lview (x:xs) = Just2 x xs lhead [] = error "ListSeq.lhead: empty sequence" lhead (x:xs) = x ltail [] = [] ltail (x:xs) = xs rview [] = Nothing2 rview xs = Just2 (rtail xs) (rhead xs) rhead [] = error "ListSeq.rhead: empty sequence" rhead (x:xs) = rh x xs where rh y [] = y rh y (x:xs) = rh x xs rtail [] = [] rtail (x:xs) = rt x xs where rt y [] = [] rt y (x:xs) = y : rt x xs null = Prelude.null size = length concat = foldr append empty reverse = Prelude.reverse reverseOnto [] ys = ys reverseOnto (x:xs) ys = reverseOnto xs (x:ys) fromList xs = xs toList xs = xs map = Prelude.map concatMap = Prelude.concatMap foldr = Prelude.foldr foldl = Prelude.foldl foldr1 f [] = error "ListSeq.foldr1: empty sequence" foldr1 f (x:xs) = fr x xs where fr y [] = y fr y (x:xs) = f y (fr x xs) foldl1 f [] = error "ListSeq.foldl1: empty sequence" foldl1 f (x:xs) = foldl f x xs reducer f e [] = e reducer f e xs = f (reduce1 f xs) e reducel f e [] = e reducel f e xs = f e (reduce1 f xs) reduce1 f [] = error "ListSeq.reduce1: empty sequence" reduce1 f [x] = x reduce1 f (x1 : x2 : xs) = reduce1 f (f x1 x2 : pairup xs) where pairup (x1 : x2 : xs) = f x1 x2 : pairup xs pairup xs = xs -- can be improved using a counter and bit ops! copy n x | n <= 0 = [] | otherwise = x : copy (n-1) x -- depends on n to be unboxed, should test this! tabulate n f = tab 0 where tab i | i >= n = [] | otherwise = f i : tab (i+1) -- depends on i (and n?) being unboxed, should check this! inBounds xs i | i >= 0 = not (null (drop i xs)) | otherwise = False lookup xs i | i < 0 = error "ListSeq.lookup: bad subscript" | otherwise = case drop i xs of [] -> error "ListSeq.lookup: bad subscript" (x:_) -> x lookupM xs i | i < 0 = Nothing | otherwise = case drop i xs of [] -> Nothing (x:_) -> Just x lookupWithDefault d xs i | i < 0 = d | otherwise = case drop i xs of [] -> d (x:_) -> x update i y xs | i < 0 = xs | otherwise = upd i xs where upd _ [] = [] upd i (x:xs) | i > 0 = x : upd (i - 1) xs | otherwise = y : xs adjust f i xs | i < 0 = xs | otherwise = adj i xs where adj _ [] = [] adj i (x:xs) | i > 0 = x : adj (i - 1) xs | otherwise = f x : xs mapWithIndex f = mapi 0 where mapi i [] = [] mapi i (x:xs) = f i x : mapi (i + 1) xs foldrWithIndex f e = foldi 0 where foldi i [] = e foldi i (x:xs) = f i x (foldi (i + 1) xs) foldlWithIndex f = foldi 0 where foldi i e [] = e foldi i e (x:xs) = foldi (i + 1) (f e i x) xs take i xs | i <= 0 = [] | otherwise = Prelude.take i xs drop i xs | i <= 0 = xs | otherwise = Prelude.drop i xs splitAt i xs | i <= 0 = ([], xs) | otherwise = Prelude.splitAt i xs subseq i len xs = take len (drop i xs) filter = Prelude.filter partition = List.partition takeWhile = Prelude.takeWhile dropWhile = Prelude.dropWhile splitWhile = Prelude.span zip = Prelude.zip zip3 = Prelude.zip3 zipWith = Prelude.zipWith zipWith3 = Prelude.zipWith3 unzip = Prelude.unzip unzip3 = Prelude.unzip3 unzipWith f g = foldr consfg ([], []) where consfg a (bs, cs) = (f a : bs, g a : cs) -- could put ~ on tuple unzipWith3 f g h = foldr consfgh ([], [], []) where consfgh a (bs, cs, ds) = (f a : bs, g a : cs, h a : ds) -- could put ~ on tuple -- declare the instance instance S.Sequence [] where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName s = moduleName} hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/MyersStack.hs0000644006511100651110000002502510130752025023277 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module MyersStack {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type Seq, -- instance of Sequence, Functor, Monad, MonadPlus -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Sequence as S ( Sequence(..) ) import SequenceDefaults import Monad import QuickCheck -- signatures for exported functions moduleName :: String empty :: Seq a single :: a -> Seq a cons :: a -> Seq a -> Seq a snoc :: Seq a -> a -> Seq a append :: Seq a -> Seq a -> Seq a lview :: Seq a -> Maybe2 a (Seq a) lhead :: Seq a -> a ltail :: Seq a -> Seq a rview :: Seq a -> Maybe2 (Seq a) a rhead :: Seq a -> a rtail :: Seq a -> Seq a null :: Seq a -> Bool size :: Seq a -> Int concat :: Seq (Seq a) -> Seq a reverse :: Seq a -> Seq a reverseOnto :: Seq a -> Seq a -> Seq a fromList :: [a] -> Seq a toList :: Seq a -> [a] map :: (a -> b) -> Seq a -> Seq b concatMap :: (a -> Seq b) -> Seq a -> Seq b foldr :: (a -> b -> b) -> b -> Seq a -> b foldl :: (b -> a -> b) -> b -> Seq a -> b foldr1 :: (a -> a -> a) -> Seq a -> a foldl1 :: (a -> a -> a) -> Seq a -> a reducer :: (a -> a -> a) -> a -> Seq a -> a reducel :: (a -> a -> a) -> a -> Seq a -> a reduce1 :: (a -> a -> a) -> Seq a -> a copy :: Int -> a -> Seq a tabulate :: Int -> (Int -> a) -> Seq a inBounds :: Seq a -> Int -> Bool lookup :: Seq a -> Int -> a lookupM :: Seq a -> Int -> Maybe a lookupWithDefault :: a -> Seq a -> Int -> a update :: Int -> a -> Seq a -> Seq a adjust :: (a -> a) -> Int -> Seq a -> Seq a mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b take :: Int -> Seq a -> Seq a drop :: Int -> Seq a -> Seq a splitAt :: Int -> Seq a -> (Seq a, Seq a) subseq :: Int -> Int -> Seq a -> Seq a filter :: (a -> Bool) -> Seq a -> Seq a partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a) takeWhile :: (a -> Bool) -> Seq a -> Seq a dropWhile :: (a -> Bool) -> Seq a -> Seq a splitWhile :: (a -> Bool) -> Seq a -> (Seq a, Seq a) zip :: Seq a -> Seq b -> Seq (a,b) zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c) zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d unzip :: Seq (a,b) -> (Seq a, Seq b) unzip3 :: Seq (a,b,c) -> (Seq a, Seq b, Seq c) unzipWith :: (a -> b) -> (a -> c) -> Seq a -> (Seq b, Seq c) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> Seq a -> (Seq b, Seq c, Seq d) moduleName = "MyersStack" -- Adapted from -- Eugene Myers. "An applicative random-access stack". Information -- Processing Letters, 17(5):241-248, December 1983. data Seq a = E | C !Int a (Seq a) (Seq a) -- what about strictness flags on tail and jump-tail? -- auxiliary function jump (C _ _ _ (C _ _ _ xs')) = xs' empty = E single x = C 1 x E E cons x xs@(C i _ _ (C j _ _ xs')) | i == j = C (1 + i + j) x xs xs' cons x xs = C 1 x xs xs lview E = Nothing2 lview (C _ x xs _) = Just2 x xs lhead E = error "MyersStack.lhead: empty sequence" lhead (C _ x xs _) = x ltail E = E ltail (C _ x xs _) = xs rview E = Nothing2 rview xs = Just2 (rtail xs) (rhead xs) rhead E = error "MyersStack.rhead: empty sequence" rhead (C _ x xs xs') = rh x xs xs' where rh x xs (C _ y ys ys') = rh y ys ys' rh x (C _ y ys ys') E = rh y ys ys' rh x E E = x rtail E = E rtail (C _ x xs _) = rt x xs where rt y E = E rt y (C _ x xs _) = cons y (rt x xs) null E = True null _ = False size xs = go xs where go E = (0::Int) go (C j x xs xs') = j + size xs' reverseOnto E ys = ys reverseOnto (C _ x xs _) ys = reverseOnto xs (cons x ys) map f E = E map f (C j x xs xs') | j == 1 = C j (f x) ys ys | otherwise = C j (f x) ys (jump ys) where ys = map f xs foldr f e E = e foldr f e (C _ x xs _) = f x (foldr f e xs) foldl f e E = e foldl f e (C _ x xs _) = foldl f (f e x) xs foldr1 f E = error "MyersStack.foldr1: empty sequence" foldr1 f (C _ x xs _) = fr x xs where fr y E = y fr y (C _ x xs _) = f y (fr x xs) foldl1 f E = error "MyersStack.foldl1: empty sequence" foldl1 f (C _ x xs _) = foldl f x xs inBounds xs i = inb xs i where inb E i = False inb (C j x xs xs') i | i < j = (i >= 0) | otherwise = inb xs' (i - j) lookup xs i = look xs i where look E i = error "MyersStack.lookup: bad subscript" look (C j x xs xs') i | i >= j = look xs' (i - j) | i > 0 = look xs (i - 1) | i == 0 = x | otherwise = error "MyersStack.lookup: bad subscript" lookupM xs i = look xs i where look E i = Nothing look (C j x xs xs') i | i >= j = look xs' (i - j) | i > 0 = look xs (i - 1) | i == 0 = Just x | otherwise = Nothing lookupWithDefault d xs i = look xs i where look E i = d look (C j x xs xs') i | i >= j = look xs' (i - j) | i > 0 = look xs (i - 1) | i == 0 = x | otherwise = d update i y xs = upd i xs where upd i E = E upd 0 (C j x xs xs') = C j y xs xs' upd i (C j x xs _) | j == 1 = C j x ys ys | otherwise = C j x ys (jump ys) where ys = upd (i - 1) xs adjust f i xs = adj i xs where adj i E = E adj 0 (C j x xs xs') = C j (f x) xs xs' adj i (C j x xs _) | j == 1 = C j x ys ys | otherwise = C j x ys (jump ys) where ys = adj (i - (1::Int)) xs drop n xs = drp n xs where drp n xs | n <= 0 = xs drp n E = E drp n (C j x xs xs') | n < j = drp (n - 1) xs | otherwise = drp (n - j) xs' unzip E = (E, E) unzip (C j (x,y) ps ps') | j == 1 = (C j x xs xs, C j y ys ys) | otherwise = (C j x xs (jump xs), C j y ys (jump ys)) where (xs,ys) = unzip ps unzip3 E = (E, E, E) unzip3 (C j (x,y,z) ts ts') | j == 1 = (C j x xs xs, C j y ys ys, C j z zs zs) | otherwise = (C j x xs (jump xs), C j y ys (jump ys), C j z zs (jump zs)) where (xs,ys,zs) = unzip3 ts unzipWith f g E = (E, E) unzipWith f g (C j x xs _) | j == 1 = (C j (f x) as as, C j (g x) bs bs) | otherwise = (C j (f x) as (jump as), C j (g x) bs (jump bs)) where (as,bs) = unzipWith f g xs unzipWith3 f g h E = (E, E, E) unzipWith3 f g h (C j x xs _) | j == 1 = (C j (f x) as as, C j (g x) bs bs, C j (h x) cs cs) | otherwise = (C j (f x) as (jump as), C j (g x) bs (jump bs), C j (h x) cs (jump cs)) where (as,bs,cs) = unzipWith3 f g h xs -- the remaining functions all use defaults snoc = snocUsingFoldr append = appendUsingFoldr concat = concatUsingFoldr reverse = reverseUsingReverseOnto fromList = fromListUsingCons toList = toListUsingFoldr concatMap = concatMapUsingFoldr reducer = reducerUsingReduce1 reducel = reducelUsingReduce1 reduce1 = reduce1UsingLists copy = copyUsingLists tabulate = tabulateUsingLists mapWithIndex = mapWithIndexUsingLists foldrWithIndex = foldrWithIndexUsingLists foldlWithIndex = foldlWithIndexUsingLists take = takeUsingLists splitAt = splitAtDefault filter = filterUsingFoldr partition = partitionUsingFoldr subseq = subseqDefault takeWhile = takeWhileUsingLview dropWhile = dropWhileUsingLview splitWhile = splitWhileUsingLview -- for zips, could optimize by calculating which one is shorter and -- retaining its shape zip = zipUsingLists zip3 = zip3UsingLists zipWith = zipWithUsingLists zipWith3 = zipWith3UsingLists -- instances instance S.Sequence Seq where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName s = moduleName} instance Functor Seq where fmap = map instance Monad Seq where return = single xs >>= k = concatMap k xs instance MonadPlus Seq where mplus = append mzero = empty instance Eq a => Eq (Seq a) where xs == ys = (size xs == size ys) && (toList xs == toList ys) instance Show a => Show (Seq a) where show xs = show (toList xs) instance Arbitrary a => Arbitrary (Seq a) where arbitrary = do xs <- arbitrary return (fromList xs) coarbitrary xs = coarbitrary (toList xs) ------------- {- questions: - any benefit to E | C1 x xs | CJ Int# x xs xs' - any benefit to length instead of delta? - any benefit to delta not counting x (i.e., base 0 instead of base 1)? I don't believe any will do any better, except possibly the first -} hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/RandList.hs0000644006511100651110000002750210130752026022735 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module RandList {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type Seq, -- instance of Sequence, Functor, Monad, MonadPlus -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Sequence as S( Sequence(..) ) import SequenceDefaults import Monad import QuickCheck -- signatures for exported functions moduleName :: String empty :: Seq a single :: a -> Seq a cons :: a -> Seq a -> Seq a snoc :: Seq a -> a -> Seq a append :: Seq a -> Seq a -> Seq a lview :: Seq a -> Maybe2 a (Seq a) lhead :: Seq a -> a ltail :: Seq a -> Seq a rview :: Seq a -> Maybe2 (Seq a) a rhead :: Seq a -> a rtail :: Seq a -> Seq a null :: Seq a -> Bool size :: Seq a -> Int concat :: Seq (Seq a) -> Seq a reverse :: Seq a -> Seq a reverseOnto :: Seq a -> Seq a -> Seq a fromList :: [a] -> Seq a toList :: Seq a -> [a] map :: (a -> b) -> Seq a -> Seq b concatMap :: (a -> Seq b) -> Seq a -> Seq b foldr :: (a -> b -> b) -> b -> Seq a -> b foldl :: (b -> a -> b) -> b -> Seq a -> b foldr1 :: (a -> a -> a) -> Seq a -> a foldl1 :: (a -> a -> a) -> Seq a -> a reducer :: (a -> a -> a) -> a -> Seq a -> a reducel :: (a -> a -> a) -> a -> Seq a -> a reduce1 :: (a -> a -> a) -> Seq a -> a copy :: Int -> a -> Seq a tabulate :: Int -> (Int -> a) -> Seq a inBounds :: Seq a -> Int -> Bool lookup :: Seq a -> Int -> a lookupM :: Seq a -> Int -> Maybe a lookupWithDefault :: a -> Seq a -> Int -> a update :: Int -> a -> Seq a -> Seq a adjust :: (a -> a) -> Int -> Seq a -> Seq a mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b take :: Int -> Seq a -> Seq a drop :: Int -> Seq a -> Seq a splitAt :: Int -> Seq a -> (Seq a, Seq a) subseq :: Int -> Int -> Seq a -> Seq a filter :: (a -> Bool) -> Seq a -> Seq a partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a) takeWhile :: (a -> Bool) -> Seq a -> Seq a dropWhile :: (a -> Bool) -> Seq a -> Seq a splitWhile :: (a -> Bool) -> Seq a -> (Seq a, Seq a) zip :: Seq a -> Seq b -> Seq (a,b) zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c) zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d unzip :: Seq (a,b) -> (Seq a, Seq b) unzip3 :: Seq (a,b,c) -> (Seq a, Seq b, Seq c) unzipWith :: (a -> b) -> (a -> c) -> Seq a -> (Seq b, Seq c) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> Seq a -> (Seq b, Seq c, Seq d) moduleName = "RandList" -- Adapted from -- Chris Okasaki. Purely Functional Data Structures. 1998. -- Section 9.3.1. -- and -- Chris Okasaki. "Purely Functional Random Access Lists". FPCA'95, -- pages 86-95. data Tree a = L a | T a (Tree a) (Tree a) deriving (Eq) data Seq a = E | C !Int (Tree a) (Seq a) --deriving (Eq) -- want to derive Eq but can't because of GHC bug half :: Int -> Int half n = n `quot` 2 -- use a shift? empty = E single x = C 1 (L x) E cons x xs@(C i s (C j t xs')) | i == j = C (1 + i + j) (T x s t) xs' cons x xs = C 1 (L x) xs copy n x = if n <= 0 then E else buildTrees (1::Int) (L x) where buildTrees j t | j > n = takeTrees n (half j) (child t) E | otherwise = buildTrees (1 + j + j) (T x t t) takeTrees i j t xs | i >= j = takeTrees (i - j) j t (C j t xs) | i > 0 = takeTrees i (half j) (child t) xs | otherwise = xs child (T x s t) = t lview E = Nothing2 lview (C _ (L x) xs) = Just2 x xs lview (C i (T x s t) xs) = Just2 x (C j s (C j t xs)) where j = half i lhead E = error "RandList.lhead: empty sequence" lhead (C _ (L x) xs) = x lhead (C _ (T x s t) xs) = x ltail E = E ltail (C _ (L x) xs) = xs ltail (C i (T x s t) xs) = C j s (C j t xs) where j = half i rhead E = error "RandList.rhead: empty sequence" rhead (C _ t E) = treeLast t where treeLast (L x) = x treeLast (T x s t) = treeLast t rhead (C _ t xs) = rhead xs null E = True null _ = False size xs = sz xs where sz E = (0::Int) sz (C j t xs) = j + sz xs reverseOnto E ys = ys reverseOnto (C _ t xs) ys = reverseOnto xs (revTree t ys) where revTree (L x) ys = cons x ys revTree (T x s t) ys = revTree t (revTree s (cons x ys)) map f E = E map f (C j t xs) = C j (mapTree f t) (map f xs) where mapTree f (L x) = L (f x) mapTree f (T x s t) = T (f x) (mapTree f s) (mapTree f t) foldr f e E = e foldr f e (C _ t xs) = foldTree t (foldr f e xs) where foldTree (L x) e = f x e foldTree (T x s t) e = f x (foldTree s (foldTree t e)) foldl f e E = e foldl f e (C _ t xs) = foldl f (foldTree e t) xs where foldTree e (L x) = f e x foldTree e (T x s t) = foldTree (foldTree (f e x) s) t reduce1 f xs = case lview xs of Nothing2 -> error "RandList.reduce1: empty seq" Just2 x xs -> red1 x xs where red1 x E = x red1 x (C j t xs) = red1 (redTree x t) xs redTree x (L y) = f x y redTree x (T y s t) = redTree (redTree (f x y) s) t inBounds xs i = inb xs i where inb E i = False inb (C j t xs) i | i < j = (i >= 0) | otherwise = inb xs (i - j) lookup xs i = look xs i where look E i = error "RandList.lookup: bad subscript" look (C j t xs) i | i < j = lookTree j t i | otherwise = look xs (i - j) lookTree _ (L x) i | i == 0 = x | otherwise = error "RandList.lookup: bad subscript" lookTree j (T x s t) i | i > k = lookTree k t (i - 1 - k) | i /= 0 = lookTree k s (i - 1) | otherwise = x where k = half j lookupM xs i = look xs i where look E i = Nothing look (C j t xs) i | i < j = lookTree j t i | otherwise = look xs (i - j) lookTree _ (L x) i | i == 0 = Just x | otherwise = Nothing lookTree j (T x s t) i | i > k = lookTree k t (i - 1 - k) | i /= 0 = lookTree k s (i - 1) | otherwise = Just x where k = half j lookupWithDefault d xs i = look xs i where look E i = d look (C j t xs) i | i < j = lookTree j t i | otherwise = look xs (i - j) lookTree _ (L x) i | i == 0 = x | otherwise = d lookTree j (T x s t) i | i > k = lookTree k t (i - 1 - k) | i /= 0 = lookTree k s (i - 1) | otherwise = x where k = half j update i y xs = upd i xs where upd i E = E upd i (C j t xs) | i < j = C j (updTree i j t) xs | otherwise = C j t (upd (i - j) xs) updTree i j t@(L x) | i == 0 = L y | otherwise = t updTree i j (T x s t) | i > k = T x s (updTree (i - 1 - k) k t) | i /= 0 = T x (updTree (i - 1) k s) t | otherwise = T y s t where k = half j adjust f i xs = adj i xs where adj i E = E adj i (C j t xs) | i < j = C j (adjTree i j t) xs | otherwise = C j t (adj (i - j) xs) adjTree i j t@(L x) | i == 0 = L (f x) | otherwise = t adjTree i j (T x s t) | i > k = T x s (adjTree (i - 1 - k) k t) | i /= 0 = T x (adjTree (i - 1) k s) t | otherwise = T (f x) s t where k = half j drop n xs = if n < 0 then xs else drp n xs where drp i E = E drp i (C j t xs) | i < j = drpTree i j t xs | otherwise = drp (i - j) xs drpTree 0 j t xs = C j t xs drpTree i j (L x) xs = error "RandList.drop: bug. Impossible case!" drpTree i j (T x s t) xs | i > k = drpTree (i - 1 - k) k t xs | otherwise = drpTree (i - 1) k s (C k t xs) where k = half j -- the remaining functions all use defaults snoc = snocUsingFoldr append = appendUsingFoldr rview = rviewDefault rtail = rtailUsingLview concat = concatUsingFoldr reverse = reverseUsingReverseOnto fromList = fromListUsingCons toList = toListUsingFoldr concatMap = concatMapUsingFoldr foldr1 = foldr1UsingLview foldl1 = foldl1UsingFoldl reducer = reducerUsingReduce1 reducel = reducelUsingReduce1 tabulate = tabulateUsingLists mapWithIndex = mapWithIndexUsingLists foldrWithIndex = foldrWithIndexUsingLists foldlWithIndex = foldlWithIndexUsingLists take = takeUsingLists splitAt = splitAtDefault filter = filterUsingFoldr partition = partitionUsingFoldr subseq = subseqDefault takeWhile = takeWhileUsingLview dropWhile = dropWhileUsingLview splitWhile = splitWhileUsingLview -- for zips, could optimize by calculating which one is shorter and -- retaining its shape zip = zipUsingLists zip3 = zip3UsingLists zipWith = zipWithUsingLists zipWith3 = zipWith3UsingLists unzip = unzipUsingLists unzip3 = unzip3UsingLists unzipWith = unzipWithUsingLists unzipWith3 = unzipWith3UsingLists -- instances instance S.Sequence Seq where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName s = moduleName} instance Functor Seq where fmap = map instance Monad Seq where return = single xs >>= k = concatMap k xs instance MonadPlus Seq where mplus = append mzero = empty -- want to derive the following instance but can't because of GHC bug instance Eq a => Eq (Seq a) where C i tx xs == C j ty ys = (i == j) && (tx == ty) && (xs == ys) E == E = True _ == _ = False instance Show a => Show (Seq a) where show xs = show (toList xs) instance Arbitrary a => Arbitrary (Seq a) where arbitrary = do xs <- arbitrary return (fromList xs) coarbitrary xs = coarbitrary (toList xs) hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/RevSeq.hs0000644006511100651110000002724310130752026022424 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module RevSeq {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- generic adaptor for sequences to keep them in the opposite order Rev, -- Rev s instance of Sequence, Functor, Monad, MonadPlus -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName,instanceName, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Sequence as S ( Sequence(..) ) import qualified ListSeq as L import SequenceDefaults -- only used by concatMap import Monad -- This module defines a sequence adaptor Rev s. -- If s is a sequence type constructor, then Rev s -- is a sequence type constructor that is identical to s, -- except that it is kept in the opposite order. -- Also keeps explicit track of the size of the sequence, -- similar to the Sized adaptor in SizedSeq.hs. -- -- This module is most useful when s is a sequence type -- that offers fast access to the front but slow access -- to the rear, and your application needs the opposite -- (i.e., fast access to the rear but slow access to the -- front). -- signatures for exported functions moduleName :: String instanceName :: S.Sequence s => Rev s a -> String empty :: S.Sequence s => Rev s a single :: S.Sequence s => a -> Rev s a cons :: S.Sequence s => a -> Rev s a -> Rev s a snoc :: S.Sequence s => Rev s a -> a -> Rev s a append :: S.Sequence s => Rev s a -> Rev s a -> Rev s a lview :: S.Sequence s => Rev s a -> Maybe2 a (Rev s a) lhead :: S.Sequence s => Rev s a -> a ltail :: S.Sequence s => Rev s a -> Rev s a rview :: S.Sequence s => Rev s a -> Maybe2 (Rev s a) a rhead :: S.Sequence s => Rev s a -> a rtail :: S.Sequence s => Rev s a -> Rev s a null :: S.Sequence s => Rev s a -> Bool size :: S.Sequence s => Rev s a -> Int concat :: S.Sequence s => Rev s (Rev s a) -> Rev s a reverse :: S.Sequence s => Rev s a -> Rev s a reverseOnto :: S.Sequence s => Rev s a -> Rev s a -> Rev s a fromList :: S.Sequence s => [a] -> Rev s a toList :: S.Sequence s => Rev s a -> [a] map :: S.Sequence s => (a -> b) -> Rev s a -> Rev s b concatMap :: S.Sequence s => (a -> Rev s b) -> Rev s a -> Rev s b foldr :: S.Sequence s => (a -> b -> b) -> b -> Rev s a -> b foldl :: S.Sequence s => (b -> a -> b) -> b -> Rev s a -> b foldr1 :: S.Sequence s => (a -> a -> a) -> Rev s a -> a foldl1 :: S.Sequence s => (a -> a -> a) -> Rev s a -> a reducer :: S.Sequence s => (a -> a -> a) -> a -> Rev s a -> a reducel :: S.Sequence s => (a -> a -> a) -> a -> Rev s a -> a reduce1 :: S.Sequence s => (a -> a -> a) -> Rev s a -> a copy :: S.Sequence s => Int -> a -> Rev s a tabulate :: S.Sequence s => Int -> (Int -> a) -> Rev s a inBounds :: S.Sequence s => Rev s a -> Int -> Bool lookup :: S.Sequence s => Rev s a -> Int -> a lookupM :: S.Sequence s => Rev s a -> Int -> Maybe a lookupWithDefault :: S.Sequence s => a -> Rev s a -> Int -> a update :: S.Sequence s => Int -> a -> Rev s a -> Rev s a adjust :: S.Sequence s => (a -> a) -> Int -> Rev s a -> Rev s a mapWithIndex :: S.Sequence s => (Int -> a -> b) -> Rev s a -> Rev s b foldrWithIndex :: S.Sequence s => (Int -> a -> b -> b) -> b -> Rev s a -> b foldlWithIndex :: S.Sequence s => (b -> Int -> a -> b) -> b -> Rev s a -> b take :: S.Sequence s => Int -> Rev s a -> Rev s a drop :: S.Sequence s => Int -> Rev s a -> Rev s a splitAt :: S.Sequence s => Int -> Rev s a -> (Rev s a, Rev s a) subseq :: S.Sequence s => Int -> Int -> Rev s a -> Rev s a filter :: S.Sequence s => (a -> Bool) -> Rev s a -> Rev s a partition :: S.Sequence s => (a -> Bool) -> Rev s a -> (Rev s a, Rev s a) takeWhile :: S.Sequence s => (a -> Bool) -> Rev s a -> Rev s a dropWhile :: S.Sequence s => (a -> Bool) -> Rev s a -> Rev s a splitWhile :: S.Sequence s => (a -> Bool) -> Rev s a -> (Rev s a, Rev s a) zip :: S.Sequence s => Rev s a -> Rev s b -> Rev s (a,b) zip3 :: S.Sequence s => Rev s a -> Rev s b -> Rev s c -> Rev s (a,b,c) zipWith :: S.Sequence s => (a -> b -> c) -> Rev s a -> Rev s b -> Rev s c zipWith3 :: S.Sequence s => (a -> b -> c -> d) -> Rev s a -> Rev s b -> Rev s c -> Rev s d unzip :: S.Sequence s => Rev s (a,b) -> (Rev s a, Rev s b) unzip3 :: S.Sequence s => Rev s (a,b,c) -> (Rev s a, Rev s b, Rev s c) unzipWith :: S.Sequence s => (a -> b) -> (a -> c) -> Rev s a -> (Rev s b, Rev s c) unzipWith3 :: S.Sequence s => (a -> b) -> (a -> c) -> (a -> d) -> Rev s a -> (Rev s b, Rev s c, Rev s d) moduleName = "RevSeq" instanceName (N m s) = "RevSeq(" ++ S.instanceName s ++ ")" data Rev s a = N !Int (s a) -- The Int is the size minus one. The "minus one" makes indexing -- calculations easier. fromSeq xs = N (S.size xs - 1) xs toSeq (N m xs) = xs empty = N (-1) S.empty single x = N 0 (S.single x) cons x (N m xs) = N (m+1) (S.snoc xs x) snoc (N m xs) x = N (m+1) (S.cons x xs) append (N m xs) (N n ys) = N (m+n+1) (S.append ys xs) lview (N m xs) = case S.rview xs of Nothing2 -> Nothing2 Just2 xs x -> Just2 x (N (m-1) xs) lhead (N m xs) = S.rhead xs ltail (N (-1) xs) = error "RevSeq.ltail: empty sequence" ltail (N m xs) = N (m-1) (S.rtail xs) rview (N m xs) = case S.lview xs of Nothing2 -> Nothing2 Just2 x xs -> Just2 (N (m-1) xs) x rhead (N m xs) = S.lhead xs rtail (N (-1) xs) = error "RevSeq.rtail: empty sequence" rtail (N m xs) = N (m-1) (S.ltail xs) null (N m xs) = m == -1 size (N m xs) = m+1 concat (N m xss) = fromSeq (S.concat (S.map toSeq xss)) reverse (N m xs) = N m (S.reverse xs) reverseOnto (N m xs) (N n ys) = N (m+n+1) (S.append ys (S.reverse xs)) fromList = fromSeq . S.fromList . L.reverse toList (N m xs) = S.foldl (flip (:)) [] xs map f (N m xs) = N m (S.map f xs) concatMap = concatMapUsingFoldr -- only function that uses a default foldr f e (N m xs) = S.foldl (flip f) e xs foldl f e (N m xs) = S.foldr (flip f) e xs foldr1 f (N m xs) = S.foldl1 (flip f) xs foldl1 f (N m xs) = S.foldr1 (flip f) xs reducer f e (N m xs) = S.reducel (flip f) e xs reducel f e (N m xs) = S.reducer (flip f) e xs reduce1 f (N m xs) = S.reduce1 (flip f) xs copy n x | n <= 0 = empty | otherwise = N (n-1) (S.copy n x) tabulate n f | n <= 0 = empty | otherwise = N m (S.tabulate n (f . (m -))) where m = n-1 inBounds (N m xs) i = (i >= 0) && (i <= m) lookup (N m xs) i = S.lookup xs (m-i) lookupM (N m xs) i = S.lookupM xs (m-i) lookupWithDefault d (N m xs) i = S.lookupWithDefault d xs (m-i) update i x (N m xs) = N m (S.update (m-i) x xs) adjust f i (N m xs) = N m (S.adjust f (m-i) xs) mapWithIndex f (N m xs) = N m (S.mapWithIndex (f . (m-)) xs) foldrWithIndex f e (N m xs) = S.foldlWithIndex f' e xs where f' xs i x = f (m-i) x xs foldlWithIndex f e (N m xs) = S.foldrWithIndex f' e xs where f' i x xs = f xs (m-i) x take i original@(N m xs) | i <= 0 = empty | i > m = original | otherwise = N (i-1) (S.drop (m-i+1) xs) drop i original@(N m xs) | i <= 0 = original | i > m = empty | otherwise = N (m-i) (S.take (m-i+1) xs) splitAt i original@(N m xs) | i <= 0 = (empty, original) | i > m = (original, empty) | otherwise = let (ys,zs) = S.splitAt (m-i+1) xs in (N (i-1) zs, N (m-i) ys) subseq i len original@(N m xs) | i <= 0 = take len original | i > m = empty | i+len > m = N (m-i) (S.take (m-i+1) xs) | otherwise = N (len-1) (S.subseq (m-i-len+1) len xs) filter p = fromSeq . S.filter p . toSeq partition p (N m xs) = (N (k-1) ys, N (m-k) zs) where (ys,zs) = S.partition p xs k = S.size ys takeWhile p = fromSeq . S.reverse . S.takeWhile p . S.reverse . toSeq dropWhile p = fromSeq . S.reverse . S.dropWhile p . S.reverse . toSeq splitWhile p (N m xs) = (N (k-1) (S.reverse ys), N (m-k) (S.reverse zs)) where (ys,zs) = S.splitWhile p (S.reverse xs) k = S.size ys zip (N m xs) (N n ys) | m < n = N m (S.zip xs (S.drop (n-m) ys)) | m > n = N n (S.zip (S.drop (m-n) xs) ys) | otherwise = N m (S.zip xs ys) zip3 (N l xs) (N m ys) (N n zs) = N k (S.zip3 xs' ys' zs') where k = min l (min m n) xs' = if l == k then xs else S.drop (l-k) xs ys' = if m == k then ys else S.drop (m-k) ys zs' = if n == k then zs else S.drop (n-k) zs zipWith f (N m xs) (N n ys) | m < n = N m (S.zipWith f xs (S.drop (n-m) ys)) | m > n = N n (S.zipWith f (S.drop (m-n) xs) ys) | otherwise = N m (S.zipWith f xs ys) zipWith3 f (N l xs) (N m ys) (N n zs) = N k (S.zipWith3 f xs' ys' zs') where k = min l (min m n) xs' = if l == k then xs else S.drop (l-k) xs ys' = if m == k then ys else S.drop (m-k) ys zs' = if n == k then zs else S.drop (n-k) zs unzip (N m xys) = (N m xs, N m ys) where (xs,ys) = S.unzip xys unzip3 (N m xyzs) = (N m xs, N m ys, N m zs) where (xs,ys,zs) = S.unzip3 xyzs unzipWith f g (N m xys) = (N m xs, N m ys) where (xs,ys) = S.unzipWith f g xys unzipWith3 f g h (N m xyzs) = (N m xs, N m ys, N m zs) where (xs,ys,zs) = S.unzipWith3 f g h xyzs -- instances instance S.Sequence s => S.Sequence (Rev s) where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName = instanceName} instance S.Sequence s => Functor (Rev s) where fmap = map instance S.Sequence s => Monad (Rev s) where return = single xs >>= k = concatMap k xs instance S.Sequence s => MonadPlus (Rev s) where mplus = append mzero = empty -- want to say -- instance Eq (s a) => Eq (Rev s a) where -- (N m xs) == (N n ys) = (m == n) && (xs == ys) -- but can't because can't write Eq (s a) context instance (S.Sequence s, Eq a) => Eq (Rev s a) where (N m xs) == (N n ys) = (m == n) && (S.toList xs == S.toList ys) instance (S.Sequence s, Show a) => Show (Rev s a) where show xs = show (toList xs) hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/Sequence.hs0000644006511100651110000002351510130752026022765 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module Sequence {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- class definition + method wrappers module Sequence, -- re-export view type from EdisonPrelude for convenience Maybe2(..) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import Monad import EdisonPrelude(Maybe2(..)) -- naming convention: instances of Sequence are named Seq whenever possible class (Functor s, MonadPlus s) => Sequence s where -- in addition to Functor, Monad, and MonadPlus, -- sequences should also be instances of Eq and Show ---------------------------------------------------------------------- -- Constructors empty :: s a single :: a -> s a -- empty = <> -- single x = cons :: a -> s a -> s a snoc :: s a -> a -> s a append :: s a -> s a -> s a -- cons x = -- snoc x = -- append = fromList :: [a] -> s a -- fromList [x0,...,xn-1] = -- initialize a sequence copy :: Int -> a -> s a -- returns empty if size is negative tabulate :: Int -> (Int -> a) -> s a -- returns empty if size is negative -- copy n x = -- n copies -- tabulate f n = ---------------------------------------------------------------------- -- Destructors -- view the left element lview :: s a -> Maybe2 a (s a) lhead :: s a -> a -- signals error if sequence is empty ltail :: s a -> s a -- returns empty if sequence is empty -- lview | n==0 = Nothing2 -- | n>0 = Just2 x0 -- lhead | n==0 = error "ModuleName.lhead: empty sequence" -- | n>0 = x0 -- ltail | n==0 = <> -- | n>0 = -- view the right element rview :: s a -> Maybe2 (s a) a rhead :: s a -> a -- signals error if sequence is empty rtail :: s a -> s a -- returns empty if sequence is empty -- rview | n==0 = Nothing2 -- | n>0 = Just2 xn-1 -- rhead | n==0 = error "ModuleName.rhead: empty sequence" -- | n>0 = xn-1 -- rtail | n==0 = <> -- | n>0 = ---------------------------------------------------------------------- -- Observers null :: s a -> Bool size :: s a -> Int -- null = (n==0) -- size = n toList :: s a -> [a] -- toList = [x0,...,xn-1] ---------------------------------------------------------------------- -- Concat and revers -- flattening a sequence concat :: s (s a) -> s a -- concat xss = foldr append empty xss -- reversing a sequence reverse :: s a -> s a reverseOnto :: s a -> s a -> s a -- reverse = -- reverseOnto = ---------------------------------------------------------------------- -- Maps and folds map :: (a -> b) -> s a -> s b concatMap :: (a -> s b) -> s a -> s b -- map f = -- concatMap f xs = concat (map f xs) foldr :: (a -> b -> b) -> b -> s a -> b foldl :: (b -> a -> b) -> b -> s a -> b -- foldr (+) c = x0 + (x1 + ... + (xn-1 + c)) -- foldl (+) c = ((c + x0) + x1) + ... + xn-1 foldr1 :: (a -> a -> a) -> s a -> a -- signals error if sequence is empty foldl1 :: (a -> a -> a) -> s a -> a -- signals error if sequence is empty -- foldr1 (+) -- | n==0 = error "ModuleName.foldr1: empty sequence" -- | n>0 = x0 + (x1 + ... + xn-1) -- foldl1 (+) -- | n==0 = error "ModuleName.foldl1: empty sequence" -- | n>0 = (x0 + x1) + ... + xn-1 reducer :: (a -> a -> a) -> a -> s a -> a reducel :: (a -> a -> a) -> a -> s a -> a reduce1 :: (a -> a -> a) -> s a -> a -- signals error if sequence is empty -- reduce is similar to fold, but combines elements in a balanced fashion -- the combining function should usually be associative -- -- reducer (+) x xs = reduce1 (+) (cons x xs) -- reducel (+) x xs = reduce1 (+) (snoc xs x) -- -- reduce1 (+) = x -- reduce1 (+) = -- (reduce1 (+) ) + (reduce1 (+) ) -- for some i such that 0 <= i && i < n-1 -- -- Although the exact value of i is unspecified it tends toward n/2 -- so that the depth of calls to + is at most logarithmic ---------------------------------------------------------------------- -- Subsequences take :: Int -> s a -> s a drop :: Int -> s a -> s a splitAt :: Int -> s a -> (s a, s a) -- take i xs = fst (splitAt i xs) -- drop i xs = snd (splitAt i xs) -- -- splitAt i xs -- | i < 0 = (<> , ) -- | i < n = (, ) -- | i >= n = (, <> ) subseq :: Int -> Int -> s a -> s a -- args are index/length rather than start index/end index -- -- subseq i len xs = take len (drop i xs) ---------------------------------------------------------------------- -- Predicate-based operations filter :: (a -> Bool) -> s a -> s a partition :: (a -> Bool) -> s a -> (s a, s a) -- filter p xs = foldr pcons empty xs -- where pcons x xs = if p x then cons x xs else xs -- -- partition p xs = (filter p xs, filter (not . p) xs) takeWhile :: (a -> Bool) -> s a -> s a dropWhile :: (a -> Bool) -> s a -> s a splitWhile :: (a -> Bool) -> s a -> (s a, s a) -- takeWhile p xs = fst (splitWhile p xs) -- dropWhile p xs = snd (splitWhile p xs) -- -- splitWhile p = (, ) -- where i = min j such that p xj (or n if no such j) ---------------------------------------------------------------------- -- Index-based operations (zero-based) inBounds :: s a -> Int -> Bool -- inBounds i = (0 <= i && i < n) lookup :: s a -> Int -> a -- signals error if index out of bounds lookupM :: s a -> Int -> Maybe a lookupWithDefault :: a -> s a -> Int -> a -- lookup xs@ i -- | inBounds xs = xi -- | otherwise = error "ModuleName.lookup: index out of bounds" -- lookupM xs@ i -- | inBounds xs = Just xi -- | otherwise = Nothing -- lookupWithDefault d xs@ i -- | inBounds xs = xi -- | otherwise = d update :: Int -> a -> s a -> s a adjust :: (a -> a) -> Int -> s a -> s a -- map a single element -- both return original sequence if index out of bounds -- -- update i y xs@ -- | inBounds xs = -- | otherwise = xs -- adjust f i xs@ -- | inBounds xs = -- | otherwise = xs mapWithIndex :: (Int -> a -> b) -> s a -> s b foldrWithIndex :: (Int -> a -> b -> b) -> b -> s a -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> s a -> b -- mapWithIndex f = -- foldrWithIndex f c = -- f 0 x0 (f 1 x1 (... (f (n-1) xn-1 c))) -- foldlWithIndex f c = -- f (...(f (f c 0 x0) 1 x1)...) (n-1) xn-1) ---------------------------------------------------------------------- -- Zips and unzips zip :: s a -> s b -> s (a,b) zip3 :: s a -> s b -> s c -> s (a,b,c) -- zip = <(x0,y0),...,(xj-1,yj-1)> -- where j = min {n,m} -- zip3 = -- <(x0,y0,z0),...,(xj-1,yj-1,zj-1)> -- where j = min {n,m,k} zipWith :: (a -> b -> c) -> s a -> s b -> s c zipWith3 :: (a -> b -> c -> d) -> s a -> s b -> s c -> s d -- zipWith f xs ys = map (uncurry f) (zip xs ys) -- zipWith3 f xs ys zs = map (uncurry f) (zip3 xs ys zs) unzip :: s (a,b) -> (s a, s b) unzip3 :: s (a,b,c) -> (s a, s b, s c) -- unzip xs = (map fst xs, map snd xs) -- unzip3 xs = (map fst3 xs, map snd3 xs, map thd3 xs) -- where fst3 (x,y,z) = x -- snd3 (x,y,z) = y -- thd3 (x,y,z) = z unzipWith :: (a -> b) -> (a -> c) -> s a -> (s b, s c) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> s a -> (s b, s c, s d) -- unzipWith f g xs = (map f xs, map g xs) -- unzipWith3 f g h xs = (map f xs, map g xs, map h xs) ---------------------------------------------------------------------- -- Documentation instanceName :: s a -> String -- The name of the module implementing s. ---------------------------------------------------------------------- -- Other possible operations not currently included {- insertAt :: Int -> a -> s a -> s a -- adds to front or rear if index out of bounds -- -- insertAt i y xs@ -- | i < 0 = cons y xs -- | i >= n = snoc xs y -- | otherwise = deleteAt :: Int -> s a -> s a -- returns original sequence if index out of bounds -- -- deleteAt i xs@ -- | i < 0 = xs -- | i >= n = xs -- | otherwise = insertAt i x s = append before (cons x after) where (before, after) = splitAt i s deleteAt i s = if i < 0 then s else append before (ltail after) where (before, after) = splitAt i s -} hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/SequenceDefaults.hs0000644006511100651110000003072410130752027024456 0ustar rossross-- Copyright (c) 1998 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module SequenceDefaults {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(..)) import Sequence import qualified ListSeq as L snocUsingAppend :: Sequence s => s a -> a -> s a snocUsingAppend s x = append s (single x) snocUsingFoldr :: Sequence s => s a -> a -> s a snocUsingFoldr s x = foldr cons (single x) s appendUsingFoldr :: Sequence s => s a -> s a -> s a appendUsingFoldr s t | null t = s | otherwise = foldr cons t s rviewDefault :: Sequence s => s a -> Maybe2 (s a) a rviewDefault xs = if null xs then Nothing2 else Just2 (rtail xs) (rhead xs) rtailUsingLview :: Sequence s => s a -> s a rtailUsingLview xs = case lview xs of Nothing2 -> empty Just2 x xs -> rt x xs where rt x xs = case lview xs of Nothing2 -> empty Just2 y ys -> cons x (rt y ys) concatUsingFoldr :: Sequence s => s (s a) -> s a concatUsingFoldr = foldr append empty reverseUsingReverseOnto :: Sequence s => s a -> s a reverseUsingReverseOnto s = reverseOnto s empty reverseUsingLists :: Sequence s => s a -> s a reverseUsingLists = fromList . L.reverse . toList reverseOntoUsingFoldl :: Sequence s => s a -> s a -> s a reverseOntoUsingFoldl xs ys = foldl (flip cons) ys xs reverseOntoUsingReverse :: Sequence s => s a -> s a -> s a reverseOntoUsingReverse = append . reverse fromListUsingCons :: Sequence s => [a] -> s a fromListUsingCons = L.foldr cons empty toListUsingFoldr :: Sequence s => s a -> [a] toListUsingFoldr = foldr (:) [] mapUsingFoldr :: Sequence s => (a -> b) -> s a -> s b mapUsingFoldr f = foldr (cons . f) empty concatMapUsingFoldr :: Sequence s => (a -> s b) -> s a -> s b concatMapUsingFoldr f = foldr (append . f) empty foldrUsingLists :: Sequence s => (a -> b -> b) -> b -> s a -> b foldrUsingLists f e xs = L.foldr f e (toList xs) foldlUsingLists :: Sequence s => (b -> a -> b) -> b -> s a -> b foldlUsingLists f e xs = L.foldl f e (toList xs) foldr1UsingLists :: Sequence s => (a -> a -> a) -> s a -> a foldr1UsingLists f xs = L.foldr1 f (toList xs) foldl1UsingLists :: Sequence s => (a -> a -> a) -> s a -> a foldl1UsingLists f xs = L.foldl1 f (toList xs) foldr1UsingLview :: Sequence s => (a -> a -> a) -> s a -> a foldr1UsingLview f xs = case lview xs of Nothing2 -> error (instanceName xs ++ ".foldr1: empty sequence") Just2 x xs -> fr1 x xs where fr1 x xs = case lview xs of Nothing2 -> x Just2 y ys -> f x (fr1 y ys) foldl1UsingFoldl :: Sequence s => (a -> a -> a) -> s a -> a foldl1UsingFoldl f xs = case lview xs of Nothing2 -> error (instanceName xs ++ ".foldl1: empty sequence") Just2 x xs -> foldl f x xs reducerUsingReduce1 :: Sequence s => (a -> a -> a) -> a -> s a -> a reducerUsingReduce1 f e s | null s = e | otherwise = f (reduce1 f s) e reducelUsingReduce1 :: Sequence s => (a -> a -> a) -> a -> s a -> a reducelUsingReduce1 f e s | null s = e | otherwise = f e (reduce1 f s) reduce1UsingLists :: Sequence s => (a -> a -> a) -> s a -> a reduce1UsingLists f s = L.reduce1 f (toList s) copyUsingLists :: Sequence s => Int -> a -> s a copyUsingLists n x = fromList (L.copy n x) tabulateUsingLists :: Sequence s => Int -> (Int -> a) -> s a tabulateUsingLists n f = fromList (L.tabulate n f) tabulateUsingCons :: Sequence s => Int -> (Int -> a) -> s a tabulateUsingCons n f | n <= 0 = empty | otherwise = tab 0 where tab i = if i == n then empty else cons (f i) (tab (i+1)) inBoundsUsingDrop :: Sequence s => s a -> Int -> Bool inBoundsUsingDrop s i = i >= 0 && not (null (drop i s)) inBoundsUsingLookupM :: Sequence s => s a -> Int -> Bool inBoundsUsingLookupM s i = case lookupM s i of Just x -> True Nothing -> False inBoundsUsingSize :: Sequence s => s a -> Int -> Bool inBoundsUsingSize s i = i >= 0 && i < size s lookupUsingLookupM :: Sequence s => s a -> Int -> a lookupUsingLookupM s i = case lookupM s i of Nothing -> error (instanceName s ++ ".lookup: bad subscript") Just x -> x lookupUsingDrop :: Sequence s => s a -> Int -> a lookupUsingDrop s i | i < 0 || null s' = error (instanceName s ++ ".lookup: bad subscript") | otherwise = lhead s' where s' = drop i s lookupWithDefaultUsingLookupM :: Sequence s => a -> s a -> Int -> a lookupWithDefaultUsingLookupM d s i = case lookupM s i of Nothing -> d Just x -> x lookupWithDefaultUsingDrop :: Sequence s => a -> s a -> Int -> a lookupWithDefaultUsingDrop d s i | i < 0 || null s' = d | otherwise = lhead s' where s' = drop i s lookupMUsingDrop :: Sequence s => s a -> Int -> Maybe a lookupMUsingDrop s i | i < 0 || null s' = Nothing | otherwise = Just (lhead s') where s' = drop i s filterUsingLview :: Sequence s => (a -> Bool) -> s a -> s a filterUsingLview p xs = case lview xs of Nothing2 -> empty Just2 x xs -> if p x then cons x (filter p xs) else filter p xs filterUsingLists :: Sequence s => (a -> Bool) -> s a -> s a filterUsingLists p xs = fromList (L.filter p (toList xs)) filterUsingFoldr :: Sequence s => (a -> Bool) -> s a -> s a filterUsingFoldr p = foldr pcons empty where pcons x xs = if p x then cons x xs else xs partitionUsingLists :: Sequence s => (a -> Bool) -> s a -> (s a, s a) partitionUsingLists p xs = let (ys,zs) = L.partition p (toList xs) in (fromList ys, fromList zs) partitionUsingFoldr :: Sequence s => (a -> Bool) -> s a -> (s a, s a) partitionUsingFoldr p = foldr pcons (empty, empty) where pcons x (xs, xs') = if p x then (cons x xs, xs') else (xs, cons x xs') updateUsingAdjust :: Sequence s => Int -> a -> s a -> s a updateUsingAdjust i y = adjust (const y) i updateUsingSplitAt :: Sequence s => Int -> a -> s a -> s a updateUsingSplitAt i x xs | i < 0 = xs | otherwise = let (ys,zs) = splitAt i xs in if null zs then xs else append ys (cons x (ltail zs)) adjustUsingLists :: Sequence s => (a -> a) -> Int -> s a -> s a adjustUsingLists f i xs = fromList (L.adjust f i (toList xs)) adjustUsingSplitAt :: Sequence s => (a -> a) -> Int -> s a -> s a adjustUsingSplitAt f i xs | i < 0 = xs | otherwise = let (ys,zs) = splitAt i xs in case lview zs of Nothing2 -> xs Just2 z zs' -> append ys (cons (f z) zs') {- insertAtUsingLists :: Sequence s => Int -> a -> s a -> s a insertAtUsingLists i x xs = fromList (L.insertAt i x (toList xs)) insertAtUsingSplitAt :: Sequence s => Int -> a -> s a -> s a insertAtUsingSplitAt i x xs | (xs_before, xs_after) <- splitAt i xs = append xs_before (cons x xs_after) deleteAtUsingLists :: Sequence s => Int -> s a -> s a deleteAtUsingLists i xs = fromList (L.deleteAt i (toList xs)) deleteAtUsingSplitAt :: Sequence s => Int -> s a -> s a deleteAtUsingSplitAt i xs | (xs_before, xs_after) <- splitAt i xs = append xs_before (ltail xs_after) -} mapWithIndexUsingLists :: Sequence s => (Int -> a -> b) -> s a -> s b mapWithIndexUsingLists f xs = fromList (L.mapWithIndex f (toList xs)) foldrWithIndexUsingLists :: Sequence s => (Int -> a -> b -> b) -> b -> s a -> b foldrWithIndexUsingLists f e xs = L.foldrWithIndex f e (toList xs) foldlWithIndexUsingLists :: Sequence s => (b -> Int -> a -> b) -> b -> s a -> b foldlWithIndexUsingLists f e xs = L.foldlWithIndex f e (toList xs) takeUsingLists :: Sequence s => Int -> s a -> s a takeUsingLists i s = fromList (L.take i (toList s)) takeUsingLview :: Sequence s => Int -> s a -> s a takeUsingLview i xs | i <= 0 = empty | otherwise = case lview xs of Nothing2 -> empty Just2 x xs' -> cons x (take (i-1) xs') dropUsingLists :: Sequence s => Int -> s a -> s a dropUsingLists i s = fromList (L.drop i (toList s)) dropUsingLtail :: Sequence s => Int -> s a -> s a dropUsingLtail i xs | i <= 0 || null xs = xs | otherwise = dropUsingLtail (i-1) (ltail xs) splitAtDefault :: Sequence s => Int -> s a -> (s a, s a) splitAtDefault i s = (take i s, drop i s) splitAtUsingLview :: Sequence s => Int -> s a -> (s a, s a) splitAtUsingLview i xs | i <= 0 = (empty,xs) | otherwise = case lview xs of Nothing2 -> (empty,empty) Just2 x xs' -> (cons x ys,zs) where (ys,zs) = splitAtUsingLview (i-1) xs' subseqDefault :: Sequence s => Int -> Int -> s a -> s a subseqDefault i len xs = take len (drop i xs) takeWhileUsingLview :: Sequence s => (a -> Bool) -> s a -> s a takeWhileUsingLview p xs = case lview xs of Just2 x xs' | p x -> cons x (takeWhileUsingLview p xs') _ -> empty dropWhileUsingLview :: Sequence s => (a -> Bool) -> s a -> s a dropWhileUsingLview p xs = case lview xs of Just2 x xs' | p x -> dropWhileUsingLview p xs' _ -> xs splitWhileUsingLview :: Sequence s => (a -> Bool) -> s a -> (s a, s a) splitWhileUsingLview p xs = case lview xs of Just2 x xs' | p x -> let (front, back) = splitWhileUsingLview p xs' in (cons x front, back) _ -> (empty, xs) zipUsingLview :: Sequence s => s a -> s b -> s (a,b) zipUsingLview xs ys = case lview xs of Nothing2 -> empty Just2 x xs' -> case lview ys of Nothing2 -> empty Just2 y ys' -> cons (x,y) (zipUsingLview xs' ys') zip3UsingLview :: Sequence s => s a -> s b -> s c -> s (a,b,c) zip3UsingLview xs ys zs = case lview xs of Nothing2 -> empty Just2 x xs' -> case lview ys of Nothing2 -> empty Just2 y ys' -> case lview zs of Nothing2 -> empty Just2 z zs' -> cons (x,y,z) (zip3UsingLview xs' ys' zs') zipWithUsingLview :: Sequence s => (a -> b -> c) -> s a -> s b -> s c zipWithUsingLview f xs ys = case lview xs of Nothing2 -> empty Just2 x xs' -> case lview ys of Nothing2 -> empty Just2 y ys' -> cons (f x y) (zipWithUsingLview f xs' ys') zipWith3UsingLview :: Sequence s => (a -> b -> c -> d) -> s a -> s b -> s c -> s d zipWith3UsingLview f xs ys zs = case lview xs of Nothing2 -> empty Just2 x xs' -> case lview ys of Nothing2 -> empty Just2 y ys' -> case lview zs of Nothing2 -> empty Just2 z zs' -> cons (f x y z) (zipWith3UsingLview f xs' ys' zs') zipUsingLists :: Sequence s => s a -> s b -> s (a,b) zipUsingLists xs ys = fromList (L.zip (toList xs) (toList ys)) zip3UsingLists :: Sequence s => s a -> s b -> s c -> s (a,b,c) zip3UsingLists xs ys zs = fromList (L.zip3 (toList xs) (toList ys) (toList zs)) zipWithUsingLists :: Sequence s => (a -> b -> c) -> s a -> s b -> s c zipWithUsingLists f xs ys = fromList (L.zipWith f (toList xs) (toList ys)) zipWith3UsingLists :: Sequence s => (a -> b -> c -> d) -> s a -> s b -> s c -> s d zipWith3UsingLists f xs ys zs = fromList (L.zipWith3 f (toList xs) (toList ys) (toList zs)) unzipUsingLists :: Sequence s => s (a,b) -> (s a, s b) unzipUsingLists xys = case L.unzip (toList xys) of (xs, ys) -> (fromList xs, fromList ys) unzipUsingFoldr :: Sequence s => s (a,b) -> (s a, s b) unzipUsingFoldr = foldr pcons (empty,empty) where pcons (x,y) (xs,ys) = (cons x xs,cons y ys) unzip3UsingLists :: Sequence s => s (a,b,c) -> (s a, s b, s c) unzip3UsingLists xyzs = case L.unzip3 (toList xyzs) of (xs, ys, zs) -> (fromList xs, fromList ys, fromList zs) unzip3UsingFoldr :: Sequence s => s (a,b,c) -> (s a, s b, s c) unzip3UsingFoldr = foldr tcons (empty,empty,empty) where tcons (x,y,z) (xs,ys,zs) = (cons x xs,cons y ys,cons z zs) unzipWithUsingLists :: Sequence s => (a -> b) -> (a -> c) -> s a -> (s b, s c) unzipWithUsingLists f g xys = case L.unzipWith f g (toList xys) of (xs, ys) -> (fromList xs, fromList ys) unzipWithUsingFoldr :: Sequence s => (a -> b) -> (a -> c) -> s a -> (s b, s c) unzipWithUsingFoldr f g = foldr pcons (empty,empty) where pcons e (xs,ys) = (cons (f e) xs,cons (g e) ys) unzipWith3UsingLists :: Sequence s => (a -> b) -> (a -> c) -> (a -> d) -> s a -> (s b, s c, s d) unzipWith3UsingLists f g h xyzs = case L.unzipWith3 f g h (toList xyzs) of (xs, ys, zs) -> (fromList xs, fromList ys, fromList zs) unzipWith3UsingFoldr :: Sequence s => (a -> b) -> (a -> c) -> (a -> d) -> s a -> (s b, s c, s d) unzipWith3UsingFoldr f g h = foldr tcons (empty,empty,empty) where tcons e (xs,ys,zs) = (cons (f e) xs,cons (g e) ys,cons (h e) zs) hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/SimpleQueue.hs0000644006511100651110000002130010130752027023442 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module SimpleQueue {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- type of simple queues Seq, -- instance of Sequence, Functor, Monad, MonadPlus -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Sequence as S ( Sequence(..) ) import SequenceDefaults import qualified ListSeq as L import Monad import QuickCheck -- signatures for exported functions moduleName :: String empty :: Seq a single :: a -> Seq a cons :: a -> Seq a -> Seq a snoc :: Seq a -> a -> Seq a append :: Seq a -> Seq a -> Seq a lview :: Seq a -> Maybe2 a (Seq a) lhead :: Seq a -> a ltail :: Seq a -> Seq a rview :: Seq a -> Maybe2 (Seq a) a rhead :: Seq a -> a rtail :: Seq a -> Seq a null :: Seq a -> Bool size :: Seq a -> Int concat :: Seq (Seq a) -> Seq a reverse :: Seq a -> Seq a reverseOnto :: Seq a -> Seq a -> Seq a fromList :: [a] -> Seq a toList :: Seq a -> [a] map :: (a -> b) -> Seq a -> Seq b concatMap :: (a -> Seq b) -> Seq a -> Seq b foldr :: (a -> b -> b) -> b -> Seq a -> b foldl :: (b -> a -> b) -> b -> Seq a -> b foldr1 :: (a -> a -> a) -> Seq a -> a foldl1 :: (a -> a -> a) -> Seq a -> a reducer :: (a -> a -> a) -> a -> Seq a -> a reducel :: (a -> a -> a) -> a -> Seq a -> a reduce1 :: (a -> a -> a) -> Seq a -> a copy :: Int -> a -> Seq a tabulate :: Int -> (Int -> a) -> Seq a inBounds :: Seq a -> Int -> Bool lookup :: Seq a -> Int -> a lookupM :: Seq a -> Int -> Maybe a lookupWithDefault :: a -> Seq a -> Int -> a update :: Int -> a -> Seq a -> Seq a adjust :: (a -> a) -> Int -> Seq a -> Seq a mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b take :: Int -> Seq a -> Seq a drop :: Int -> Seq a -> Seq a splitAt :: Int -> Seq a -> (Seq a, Seq a) subseq :: Int -> Int -> Seq a -> Seq a filter :: (a -> Bool) -> Seq a -> Seq a partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a) takeWhile :: (a -> Bool) -> Seq a -> Seq a dropWhile :: (a -> Bool) -> Seq a -> Seq a splitWhile :: (a -> Bool) -> Seq a -> (Seq a, Seq a) zip :: Seq a -> Seq b -> Seq (a,b) zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c) zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d unzip :: Seq (a,b) -> (Seq a, Seq b) unzip3 :: Seq (a,b,c) -> (Seq a, Seq b, Seq c) unzipWith :: (a -> b) -> (a -> c) -> Seq a -> (Seq b, Seq c) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> Seq a -> (Seq b, Seq c, Seq d) moduleName = "SimpleQueue" -- Adapted from -- Chris Okasaki. Purely Functional Data Structures. 1998. -- Section 5.2. -- and -- F. Warren Burton. "An efficient functional implementation of FIFO queues". -- Information Processing Letters, 14(5):205-206, July 1982. data Seq a = Q [a] [a] -- invariant: front empty only if rear also empty -- not exported makeQ [] ys = Q (L.reverse ys) [] makeQ xs ys = Q xs ys empty = Q [] [] single x = Q [x] [] cons x (Q xs ys) = Q (x:xs) ys snoc (Q [] _) y = Q [y] [] snoc (Q xs ys) y = Q xs (y:ys) append (Q xs1 ys1) (Q xs2 ys2) = Q (xs1 ++ L.reverseOnto ys1 xs2) ys2 lview (Q [] _) = Nothing2 lview (Q [x] ys) = Just2 x (Q (L.reverse ys) []) lview (Q (x:xs) ys) = Just2 x (Q xs ys) lhead (Q [] _) = error "SimpleQueue.lhead: empty sequence" lhead (Q (x:xs) _) = x ltail (Q [x] ys) = Q (L.reverse ys) [] ltail (Q (x:xs) ys) = Q xs ys ltail q@(Q [] _) = q rview (Q xs (y:ys)) = Just2 (Q xs ys) y rview (Q xs []) = case L.rview xs of Nothing2 -> Nothing2 Just2 xs' x -> Just2 (Q xs' []) x rhead (Q xs (y:ys)) = y rhead (Q [] []) = error "SimpleQueue.rhead: empty sequence" rhead (Q xs []) = L.rhead xs rtail (Q xs (y:ys)) = Q xs ys rtail q@(Q [] []) = q rtail (Q xs []) = Q (L.rtail xs) [] null (Q [] _) = True null _ = False size (Q xs ys) = length xs + length ys reverse (Q xs []) = Q (L.reverse xs) [] reverse (Q xs ys) = Q ys xs reverseOnto (Q xs1 ys1) (Q xs2 ys2) = Q (ys1 ++ L.reverseOnto xs1 xs2) ys2 fromList xs = Q xs [] toList (Q xs []) = xs toList (Q xs ys) = xs ++ L.reverse ys map f (Q xs ys) = Q (L.map f xs) (L.map f ys) -- local fn on lists revfoldr f e [] = e revfoldr f e (x:xs) = revfoldr f (f x e) xs -- local fn on lists revfoldl f e [] = e revfoldl f e (x:xs) = f (revfoldl f e xs) x foldr f e (Q xs ys) = L.foldr f (revfoldr f e ys) xs foldl f e (Q xs ys) = revfoldl f (L.foldl f e xs) ys foldr1 f (Q xs (y:ys)) = L.foldr f (revfoldr f y ys) xs foldr1 f (Q [] []) = error "SimpleQueue.foldr1: empty sequence" foldr1 f (Q xs []) = L.foldr1 f xs foldl1 f (Q (x:xs) ys) = revfoldl f (L.foldl f x xs) ys foldl1 f (Q [] _) = error "SimpleQueue.foldl1: empty sequence" filter p (Q xs ys) = makeQ (L.filter p xs) (L.filter p ys) partition p (Q xs ys) = (makeQ xsT ysT, makeQ xsF ysF) where (xsT,xsF) = L.partition p xs (ysT,ysF) = L.partition p ys -- the remaining functions all use defaults concat = concatUsingFoldr concatMap = concatMapUsingFoldr reducer = reducerUsingReduce1 reducel = reducelUsingReduce1 reduce1 = reduce1UsingLists copy = copyUsingLists tabulate = tabulateUsingLists inBounds = inBoundsUsingLookupM lookup = lookupUsingLookupM lookupM = lookupMUsingDrop lookupWithDefault = lookupWithDefaultUsingLookupM update = updateUsingAdjust adjust = adjustUsingLists mapWithIndex = mapWithIndexUsingLists foldrWithIndex = foldrWithIndexUsingLists foldlWithIndex = foldlWithIndexUsingLists take = takeUsingLists drop = dropUsingLists splitAt = splitAtDefault subseq = subseqDefault takeWhile = takeWhileUsingLview dropWhile = dropWhileUsingLview splitWhile = splitWhileUsingLview zip = zipUsingLists zip3 = zip3UsingLists zipWith = zipWithUsingLists zipWith3 = zipWith3UsingLists unzip = unzipUsingLists unzip3 = unzip3UsingLists unzipWith = unzipWithUsingLists unzipWith3 = unzipWith3UsingLists -- instances instance S.Sequence Seq where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName s = moduleName} instance Functor Seq where fmap = map instance Monad Seq where return = single xs >>= k = concatMap k xs instance MonadPlus Seq where mplus = append mzero = empty instance Eq a => Eq (Seq a) where q1 == q2 = toList q1 == toList q2 instance Show a => Show (Seq a) where show q = show (toList q) instance Arbitrary a => Arbitrary (Seq a) where arbitrary = do xs <- arbitrary ys <- arbitrary return (if L.null xs then Q ys [] else Q xs ys) coarbitrary (Q xs ys) = coarbitrary xs . coarbitrary ys hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/SizedSeq.hs0000644006511100651110000002566010130752027022750 0ustar rossross-- Copyright (c) 1998-1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module SizedSeq {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( -- generic adaptor for sequences to keep track of the current size Sized, -- Sized s instance of Sequence, Functor, Monad, MonadPlus -- sequence operations empty,single,cons,snoc,append,lview,lhead,ltail,rview,rhead,rtail, null,size,concat,reverse,reverseOnto,fromList,toList, map,concatMap,foldr,foldl,foldr1,foldl1,reducer,reducel,reduce1, copy,tabulate,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldlWithIndex, take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, -- documentation moduleName,instanceName, -- other supported operations fromSeq,toSeq, -- re-export view type from EdisonPrelude for convenience Maybe2(Just2,Nothing2) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import EdisonPrelude(Maybe2(Just2,Nothing2)) import qualified Sequence as S ( Sequence(..) ) import qualified Sequence as S import SequenceDefaults -- only used by concatMap import Monad import QuickCheck -- This module defines a sequence adaptor Sized s. -- If s is a sequence type constructor, then Sized s -- is a sequence type constructor that is identical to s, -- except that it also keeps track of the current size of -- each sequence. -- signatures for exported functions moduleName :: String instanceName :: S.Sequence s => Sized s a -> String empty :: S.Sequence s => Sized s a single :: S.Sequence s => a -> Sized s a cons :: S.Sequence s => a -> Sized s a -> Sized s a snoc :: S.Sequence s => Sized s a -> a -> Sized s a append :: S.Sequence s => Sized s a -> Sized s a -> Sized s a lview :: S.Sequence s => Sized s a -> Maybe2 a (Sized s a) lhead :: S.Sequence s => Sized s a -> a ltail :: S.Sequence s => Sized s a -> Sized s a rview :: S.Sequence s => Sized s a -> Maybe2 (Sized s a) a rhead :: S.Sequence s => Sized s a -> a rtail :: S.Sequence s => Sized s a -> Sized s a null :: S.Sequence s => Sized s a -> Bool size :: S.Sequence s => Sized s a -> Int concat :: S.Sequence s => Sized s (Sized s a) -> Sized s a reverse :: S.Sequence s => Sized s a -> Sized s a reverseOnto :: S.Sequence s => Sized s a -> Sized s a -> Sized s a fromList :: S.Sequence s => [a] -> Sized s a toList :: S.Sequence s => Sized s a -> [a] map :: S.Sequence s => (a -> b) -> Sized s a -> Sized s b concatMap :: S.Sequence s => (a -> Sized s b) -> Sized s a -> Sized s b foldr :: S.Sequence s => (a -> b -> b) -> b -> Sized s a -> b foldl :: S.Sequence s => (b -> a -> b) -> b -> Sized s a -> b foldr1 :: S.Sequence s => (a -> a -> a) -> Sized s a -> a foldl1 :: S.Sequence s => (a -> a -> a) -> Sized s a -> a reducer :: S.Sequence s => (a -> a -> a) -> a -> Sized s a -> a reducel :: S.Sequence s => (a -> a -> a) -> a -> Sized s a -> a reduce1 :: S.Sequence s => (a -> a -> a) -> Sized s a -> a copy :: S.Sequence s => Int -> a -> Sized s a tabulate :: S.Sequence s => Int -> (Int -> a) -> Sized s a inBounds :: S.Sequence s => Sized s a -> Int -> Bool lookup :: S.Sequence s => Sized s a -> Int -> a lookupM :: S.Sequence s => Sized s a -> Int -> Maybe a lookupWithDefault :: S.Sequence s => a -> Sized s a -> Int -> a update :: S.Sequence s => Int -> a -> Sized s a -> Sized s a adjust :: S.Sequence s => (a -> a) -> Int -> Sized s a -> Sized s a mapWithIndex :: S.Sequence s => (Int -> a -> b) -> Sized s a -> Sized s b foldrWithIndex :: S.Sequence s => (Int -> a -> b -> b) -> b -> Sized s a -> b foldlWithIndex :: S.Sequence s => (b -> Int -> a -> b) -> b -> Sized s a -> b take :: S.Sequence s => Int -> Sized s a -> Sized s a drop :: S.Sequence s => Int -> Sized s a -> Sized s a splitAt :: S.Sequence s => Int -> Sized s a -> (Sized s a, Sized s a) subseq :: S.Sequence s => Int -> Int -> Sized s a -> Sized s a filter :: S.Sequence s => (a -> Bool) -> Sized s a -> Sized s a partition :: S.Sequence s => (a -> Bool) -> Sized s a -> (Sized s a, Sized s a) takeWhile :: S.Sequence s => (a -> Bool) -> Sized s a -> Sized s a dropWhile :: S.Sequence s => (a -> Bool) -> Sized s a -> Sized s a splitWhile :: S.Sequence s => (a -> Bool) -> Sized s a -> (Sized s a, Sized s a) zip :: S.Sequence s => Sized s a -> Sized s b -> Sized s (a,b) zip3 :: S.Sequence s => Sized s a -> Sized s b -> Sized s c -> Sized s (a,b,c) zipWith :: S.Sequence s => (a -> b -> c) -> Sized s a -> Sized s b -> Sized s c zipWith3 :: S.Sequence s => (a -> b -> c -> d) -> Sized s a -> Sized s b -> Sized s c -> Sized s d unzip :: S.Sequence s => Sized s (a,b) -> (Sized s a, Sized s b) unzip3 :: S.Sequence s => Sized s (a,b,c) -> (Sized s a, Sized s b, Sized s c) unzipWith :: S.Sequence s => (a -> b) -> (a -> c) -> Sized s a -> (Sized s b, Sized s c) unzipWith3 :: S.Sequence s => (a -> b) -> (a -> c) -> (a -> d) -> Sized s a -> (Sized s b, Sized s c, Sized s d) -- bonus functions, not in Sequence signature fromSeq :: S.Sequence s => s a -> Sized s a toSeq :: S.Sequence s => Sized s a -> s a moduleName = "SizedSeq" instanceName (N n s) = "SizedSeq(" ++ S.instanceName s ++ ")" data Sized s a = N !Int (s a) fromSeq xs = N (S.size xs) xs toSeq (N n xs) = xs empty = N 0 S.empty single x = N 1 (S.single x) cons x (N n xs) = N (n+1) (S.cons x xs) snoc (N n xs) x = N (n+1) (S.snoc xs x) append (N m xs) (N n ys) = N (m+n) (S.append xs ys) lview (N n xs) = case S.lview xs of Nothing2 -> Nothing2 Just2 x xs -> Just2 x (N (n-1) xs) lhead (N n xs) = S.lhead xs ltail (N 0 xs) = empty ltail (N n xs) = N (n-1) (S.ltail xs) rview (N n xs) = case S.rview xs of Nothing2 -> Nothing2 Just2 xs x -> Just2 (N (n-1) xs) x rhead (N n xs) = S.rhead xs rtail (N 0 xs) = empty rtail (N n xs) = N (n-1) (S.rtail xs) null (N n xs) = n == 0 size (N n xs) = n concat (N n xss) = fromSeq (S.concat (S.map toSeq xss)) reverse (N n xs) = N n (S.reverse xs) reverseOnto (N m xs) (N n ys) = N (m+n) (S.reverseOnto xs ys) fromList = fromSeq . S.fromList toList (N n xs) = S.toList xs map f (N n xs) = N n (S.map f xs) concatMap = concatMapUsingFoldr -- only function that uses a default foldr f e (N n xs) = S.foldr f e xs foldl f e (N n xs) = S.foldl f e xs foldr1 f (N n xs) = S.foldr1 f xs foldl1 f (N n xs) = S.foldl1 f xs reducer f e (N n xs) = S.reducer f e xs reducel f e (N n xs) = S.reducel f e xs reduce1 f (N n xs) = S.reduce1 f xs copy n x | n <= 0 = empty | otherwise = N n (S.copy n x) tabulate n f | n <= 0 = empty | otherwise = N n (S.tabulate n f) inBounds (N n xs) i = (i >= 0) && (i < n) lookup (N n xs) = S.lookup xs lookupM (N n xs) = S.lookupM xs lookupWithDefault d (N n xs) = S.lookupWithDefault d xs update i x (N n xs) = N n (S.update i x xs) adjust f i (N n xs) = N n (S.adjust f i xs) mapWithIndex f (N n xs) = N n (S.mapWithIndex f xs) foldrWithIndex f e (N n xs) = S.foldrWithIndex f e xs foldlWithIndex f e (N n xs) = S.foldlWithIndex f e xs take i original@(N n xs) | i <= 0 = empty | i >= n = original | otherwise = N i (S.take i xs) drop i original@(N n xs) | i <= 0 = original | i >= n = empty | otherwise = N (n-i) (S.drop i xs) splitAt i original@(N n xs) | i <= 0 = (empty, original) | i >= n = (original, empty) | otherwise = let (ys,zs) = S.splitAt i xs in (N i ys, N (n-i) zs) subseq i len original@(N n xs) | i <= 0 = take len original | i >= n || len <= 0 = empty | i+len >= n = N (n-i) (S.drop i xs) | otherwise = N len (S.subseq i len xs) filter p = fromSeq . S.filter p . toSeq partition p (N n xs) = (N m ys, N (n-m) zs) where (ys,zs) = S.partition p xs m = S.size ys takeWhile p = fromSeq . S.takeWhile p . toSeq dropWhile p = fromSeq . S.dropWhile p . toSeq splitWhile p (N n xs) = (N m ys, N (n-m) zs) where (ys,zs) = S.splitWhile p xs m = S.size ys zip (N m xs) (N n ys) = N (min m n) (S.zip xs ys) zip3 (N l xs) (N m ys) (N n zs) = N (min l (min m n)) (S.zip3 xs ys zs) zipWith f (N m xs) (N n ys) = N (min m n) (S.zipWith f xs ys) zipWith3 f (N l xs) (N m ys) (N n zs) = N (min l (min m n)) (S.zipWith3 f xs ys zs) unzip (N n xys) = (N n xs, N n ys) where (xs,ys) = S.unzip xys unzip3 (N n xyzs) = (N n xs, N n ys, N n zs) where (xs,ys,zs) = S.unzip3 xyzs unzipWith f g (N n xys) = (N n xs, N n ys) where (xs,ys) = S.unzipWith f g xys unzipWith3 f g h (N n xyzs) = (N n xs, N n ys, N n zs) where (xs,ys,zs) = S.unzipWith3 f g h xyzs -- instances instance S.Sequence s => S.Sequence (Sized s) where {empty = empty; single = single; cons = cons; snoc = snoc; append = append; lview = lview; lhead = lhead; ltail = ltail; rview = rview; rhead = rhead; rtail = rtail; null = null; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; map = map; concatMap = concatMap; foldr = foldr; foldl = foldl; foldr1 = foldr1; foldl1 = foldl1; reducer = reducer; reducel = reducel; reduce1 = reduce1; copy = copy; tabulate = tabulate; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldlWithIndex = foldlWithIndex; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; instanceName = instanceName} instance S.Sequence s => Functor (Sized s) where fmap = map instance S.Sequence s => Monad (Sized s) where return = single xs >>= k = concatMap k xs instance S.Sequence s => MonadPlus (Sized s) where mplus = append mzero = empty instance Eq (s a) => Eq (Sized s a) where (N m xs) == (N n ys) = (m == n) && (xs == ys) -- this is probably identical to the code that would be -- generated by "deriving (Eq)", but I wanted to be *sure* -- that the sizes were compared before the inner sequences instance (S.Sequence s, Show (s a)) => Show (Sized s a) where show xs = show (toSeq xs) instance (S.Sequence s, Arbitrary (s a)) => Arbitrary (Sized s a) where arbitrary = do xs <- arbitrary return (fromSeq xs) coarbitrary xs = coarbitrary (toSeq xs) hugs98-plus-Sep2006/fptools/hslibs/data/edison/Seq/TestSeq.hs0000644006511100651110000001525410130752027022607 0ustar rossross-- Copyright (c) 1999 Chris Okasaki. -- See COPYRIGHT file for terms and conditions. module TestSeq {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import qualified Prelude import EdisonPrelude(Maybe2(Just2,Nothing2)) import QuickCheck import SimpleQueue -- the module being tested -- To test a different module, simply replace the name above. -- To test a module that does not name its type constructor "Seq", -- you also need to define a type synonym -- type Seq a = ... prop_equals :: Seq Int -> Seq Int -> Bool prop_equals xs ys = (xs == ys) == (toList xs == toList ys) prop_fromList :: [Int] -> Bool prop_fromList xs = fromList xs == (Prelude.foldr cons empty xs :: Seq Int) && toList (fromList xs :: Seq Int) == xs prop_toList :: Seq Int -> Bool prop_toList xs = toList xs == foldr (:) [] xs && fromList (toList xs) == xs prop_single :: Int -> Bool prop_single x = toList (single x :: Seq Int) == [x] prop_cons_snoc :: Int -> Seq Int -> Bool prop_cons_snoc x xs = cons x xs == append (single x) xs && snoc xs x == append xs (single x) prop_lview_rview :: Seq Int -> Bool prop_lview_rview xs = lview xs == (if null xs then Nothing2 else Just2 (lhead xs) (ltail xs)) && rview xs == (if null xs then Nothing2 else Just2 (rtail xs) (rhead xs)) prop_lhead_rhead :: Seq Int -> Property prop_lhead_rhead xs = not (null xs) ==> lhead xs == Prelude.head (toList xs) && rhead xs == Prelude.last (toList xs) prop_ltail_rtail :: Seq Int -> Bool prop_ltail_rtail xs = toList (ltail xs) == (if null xs then [] else Prelude.tail (toList xs)) && toList (rtail xs) == (if null xs then [] else Prelude.init (toList xs)) prop_append :: Seq Int -> Seq Int -> Bool prop_append xs ys = toList (append xs ys) == toList xs ++ toList ys prop_null_size :: Seq Int -> Bool prop_null_size xs = null xs == (size xs == 0) && size xs == Prelude.length (toList xs) prop_reverse :: Seq Int -> Bool prop_reverse xs = toList (reverse xs) == Prelude.reverse (toList xs) prop_reverseOnto :: Seq Int -> Seq Int -> Bool prop_reverseOnto xs ys = reverseOnto xs ys == append (reverse xs) ys prop_map :: Seq Int -> Bool prop_map xs = toList (map (+1) xs) == Prelude.map (+1) (toList xs) prop_fold :: Seq Int -> Bool prop_fold xs = foldr (:) [99] xs == toList xs ++ [99] && foldl (flip (:)) [99] xs == Prelude.reverse (toList xs) ++ [99] prop_fold1 :: Seq Int -> Property prop_fold1 xs = not (null xs) ==> foldr1 f xs == Prelude.foldr1 f (toList xs) && foldl1 f xs == Prelude.foldl1 f (toList xs) where f x y = 3*x - 2*y prop_reduce :: Seq Int -> Bool prop_reduce xs = reducel append (single 93) (map single xs) == append (single 93) xs && reducer append (single 93) (map single xs) == append xs (single 93) prop_reduce1 :: Seq Int -> Property prop_reduce1 xs = not (null xs) ==> reduce1 append (map single xs) == xs prop_copy_tabulate :: Int -> Bool prop_copy_tabulate n = toList (copy n 'x' :: Seq Char) == (if n <= 0 then [] else Prelude.take n (repeat 'x')) && toList (tabulate n (+13) :: Seq Int) == (if n <= 0 then [] else Prelude.take n [13..]) prop_inBounds_lookup :: Int -> Seq Int -> Bool prop_inBounds_lookup i xs = inBounds xs i == (0 <= i && i < size xs) && (if inBounds xs i then lookup xs i == lhead (drop i xs) && lookupM xs i == Just (lookup xs i) && lookupWithDefault 99 xs i == lookup xs i else lookupM xs i == Nothing && lookupWithDefault 99 xs i == 99) prop_update_adjust :: Int -> Seq Int -> Bool prop_update_adjust i xs = if inBounds xs i then let ys = take i xs zs = drop (i+1) xs x = lookup xs i in update i 99 xs == append ys (cons 99 zs) && adjust (+1) i xs == append ys (cons (x+1) zs) else update i 99 xs == xs && adjust (+1) i xs == xs prop_withIndex :: Seq Int -> Bool prop_withIndex xs = toList (mapWithIndex (+) xs) == Prelude.map (uncurry (+)) ixs && foldrWithIndex f [] xs == ixs && foldlWithIndex g [] xs == Prelude.reverse ixs where ixs = Prelude.zip [0..] (toList xs) f i x xs = (i,x):xs g xs i x = (i,x):xs prop_take_drop_splitAt :: Int -> Seq Int -> Bool prop_take_drop_splitAt n xs = size (take n xs) == max 0 (min n (size xs)) && append (take n xs) (drop n xs) == xs && splitAt n xs == (take n xs, drop n xs) prop_subseq :: Int -> Int -> Seq Int -> Bool prop_subseq i len xs = subseq i len xs == take len (drop i xs) prop_filter_takeWhile_dropWhile :: Int -> Seq Int -> Bool prop_filter_takeWhile_dropWhile x xs = toList (filter p xs) == Prelude.filter p (toList xs) && toList (takeWhile p xs) == Prelude.takeWhile p (toList xs) && toList (dropWhile p xs) == Prelude.dropWhile p (toList xs) where p = (< x) prop_partition_splitWhile :: Int -> Seq Int -> Bool prop_partition_splitWhile x xs = partition p xs == (filter p xs, filter (not . p) xs) && splitWhile p xs == (takeWhile p xs, dropWhile p xs) where p = (< x) prop_zip_zipWith :: Seq Int -> Seq Int -> Bool prop_zip_zipWith xs ys = toList (zip xs ys) == xys && toList (zipWith (,) xs ys) == xys where xys = Prelude.zip (toList xs) (toList ys) prop_zip3_zipWith3 :: Seq Int -> Seq Int -> Seq Int -> Bool prop_zip3_zipWith3 xs ys zs = toList (zip3 xs ys zs) == xyzs && toList (zipWith3 (,,) xs ys zs) == xyzs where xyzs = Prelude.zip3 (toList xs) (toList ys) (toList zs) prop_unzip_unzipWith :: Seq (Int,Int) -> Bool prop_unzip_unzipWith xys = unzip xys == (xs, ys) && unzipWith fst snd xys == (xs, ys) where xs = map fst xys ys = map snd xys prop_unzip3_unzipWith3 :: Seq (Int,Int,Int) -> Bool prop_unzip3_unzipWith3 xyzs = unzip3 xyzs == (xs, ys, zs) && unzipWith3 fst3 snd3 thd3 xyzs == (xs, ys, zs) where xs = map fst3 xyzs ys = map snd3 xyzs zs = map thd3 xyzs fst3 (x,y,z) = x snd3 (x,y,z) = y thd3 (x,y,z) = z prop_concat :: Property prop_concat = forAll genss $ \xss -> concat xss == foldr append empty xss genss :: Gen (Seq (Seq Int)) genss = sized (\n -> resize (min 20 n) arbitrary) prop_concatMap :: Seq Int -> Property prop_concatMap xs = forAll genss check where check xss = concatMap f xs == concat (map f xs) where f = lookupWithDefault empty xss hugs98-plus-Sep2006/fptools/hslibs/data/edison/doc/0000755006511100651110000000000010504340142020665 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/data/edison/doc/changes.html0000644006511100651110000000062407210434145023174 0ustar rossross Edison Change Log

Recent Changes to Edison

(Haskell Version)

5/26/99 Fixed CVS problem that prevented the empty Lib and Import directories from appearing in the release. Added AssocList, an implementation of finite maps as association lists.

5/21/99 Initial release. hugs98-plus-Sep2006/fptools/hslibs/data/edison/doc/users.hva0000644006511100651110000000023707210434145022537 0ustar rossross\newcommand{\hrule}{\rule{1ex}{1ex}} \newcommand{\xspace}{ } \newcommand{\is}{:: } \newcommand{\spec}[1]{\item[\cd{#1}]\nl} \newcommand{\Longrightarrow}{--\>} hugs98-plus-Sep2006/fptools/hslibs/data/edison/doc/users.tex0000644006511100651110000024375607210434145022600 0ustar rossross\documentclass{report} \setlength{\oddsidemargin}{0in} \setlength{\topmargin}{-50pt} \setlength{\textheight}{8.5in} \setlength{\textwidth}{6.5in} \newcommand{\CopyrightNotice} {Copyright \copyright{} 1998--1999 Chris Okasaki 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. } \title{Edison User's Guide\thanks{\CopyrightNotice} \\ (Haskell version)} \author{Chris Okasaki} \usepackage{xspace} \newcommand{\ignore}[1]{} \newcommand{\cd}{\texttt} \newcommand{\arrow}{\ensuremath{\rightarrow}\xspace} \newcommand{\Arrow}{\ensuremath{\Rightarrow}\xspace} \newcommand{\Equiv}{\ensuremath{\equiv}\xspace} \newcommand{\Implies}{\ensuremath{\Longrightarrow}\xspace} \newcommand{\is}{:$\!$:$$\xspace} \newcommand{\Section}[1]{Section~\ref{#1}} \newcommand{\Chapter}[1]{Chapter~\ref{#1}} \newcommand{\Figure}[1]{Figure~\ref{#1}} \newcommand{\nl}{\hspace*{0pt}\\} \newcommand{\spec}[1]{\item[\cd{\begin{tabular}{@{}l} #1 \end{tabular}}] \nl} \newcommand{\impl}[1]{\item \texttt{#1}:} \newcommand{\axioms}[1]{ \par \noindent \textbf{Axioms:} \\ \hspace*{20pt}{\ttfamily \begin{tabular}{l} #1 \end{tabular}}} \newcommand{\eff}[1]{ \par \noindent \textbf{Default running time:} $#1$} \newcommand{\efftext}[1]{ \par \noindent \textbf{Default running time:} #1} \newcommand{\List}[1]{{[}#1{]}} \newcommand{\AC}{\textsc{ac}\xspace} \newcommand{\ACs}{\textsc{ac}s\xspace} \newcommand{\hsp}{\hspace*{15pt}} \begin{document} \maketitle \tableofcontents \listoffigures \chapter{Introduction} Edison is a library of efficient data structures suitable for implementation and use in functional programming languages. It is named after Thomas Alva Edison and for the mnemonic value of {\bf ED}i{\bf S}on ({\bf E}fficient {\bf D}ata {\bf S}trucutres). The current version of the library supports Haskell. Future versions of the library will also support Standard ML and possibly Scheme. Edison provides several families of abstractions, each with multiple implementations, along with guidance on how to choose the best implementation for your particular application. The main abstractions currently supported by Edison are \begin{itemize} \item \emph{sequences} (e.g., stacks, queues, deques), \item \emph{collections} (e.g., sets, bags, priority queues where the priority is the element), and \item \emph{associative collections} (e.g., finite maps, priority queues where the priority and element are distinct). \end{itemize} Note that, in its current state, the library is mostly a framework. That is, I provide signatures, but not yet very many implementations. I intend to populate this framework over time, adding a new module every few weeks. Thus, the library is extremely unstable in the sense that I will continually be modifying existing data structures and adding new ones. However, I hope that the signatures will remain fairly stable over time, making these changes to the implementations mostly transparent to users of the library. If you wish to request a particular data structure or volunteer to provide an implementation, send me email at \texttt{cdo@cs.columbia.edu}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Installation and Use} Download the compressed tar file and uncompress/untar it in the location of your choice. It will create a directory called \texttt{edison} with several subdirectories containing the actual source code. Now, \cd{cd} to the \cd{edison} directory and type \begin{verbatim} make all \end{verbatim} I recommend using GHC 4.00 or higher (I used GHC 4.00 for testing). See \Section{portability} for a discussion of portability issues. To compile a file \cd{Foo.hs} that uses Edison, type something like \begin{verbatim} ghc -c -i/usr/local/edison/Import Foo.hs \end{verbatim} where \cd{/usr/local} should be replaced with the correct path to the \cd{edison} directory. To compile and link, type something like \begin{verbatim} ghc -i/usr/local/edison/Import -L/usr/local/edison/Lib -ledison Foo.hs \end{verbatim} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Conventions} In this section, I describe the general conventions I have followed in designing Edison. I include only those conventions that affect users of the library. Conventions that affect developers are described in the separate \emph{Edison Developer's Guide}. \section{Use of modules} \label{use-of-modules} Each data structure is implemented as a Haskell module. These modules should always be imported \cd{qualified} to prevent a flood of name clashes (see \Section{name-clashes}). I recommend renaming each imported module (using the \cd{as} keyword) both to reduce the overhead of qualified names and to make substituting one module for another as painless as possible. The one Edison module that is typically imported unqualified is the \cd{EdisonPrelude}. \bigskip \noindent Example use of an Edison data structure: \begin{verbatim} module Foo where import EdisonPrelude import qualified SimpleQueue as Q data Tree a = Empty | Node a (Tree a) (Tree a) breadthFirst :: Tree a -> [a] breadthFirst t = bfs (Q.single t) where bfs q = case Q.lview q of Just2 (Node x l r) q' -> x : bfs (Q.snoc (Q.snoc q' l) r) Just2 Empty q' -> bfs q' Nothing2 -> [] \end{verbatim} \section{Reuse of names} \label{name-clashes} I have attempted to choose names that are as standard as possible. This means that operations for different abstractions frequently share the same name (\cd{empty}, \cd{null}, \cd{size}, etc.). It also means that in many cases I have reused names from the Prelude. However, these name clashes should not be a problem because I expect Edison modules to be imported \cd{qualified} (see \Section{use-of-modules}). If, for some reason, you choose to import Edison modules unqualified, you will usually need to import the Prelude \cd{hiding} the relevant names. Edison modules also frequently share type names. For example, every sequence type constructor is named \cd{Seq} unless there is a good reason otherwise. This makes substituting one module for another fairly painless, especially when imported modules are renamed as in the previous section. An example of ``a good reason otherwise'' for not using the standard type name is when the type constructor has the wrong kind. This usually happens when one data structure is parameterized by another. For example, an implementation of sequences that is parameterized on another implementation of sequences might be given as \begin{verbatim} data HigherOrderSeq seq a = ... instance Sequence seq => Sequence (HigherOrderSeq seq) where ... \end{verbatim} However, even modules such as these will typically define \cd{Seq} as a type synonym for some good default choice, e.g., \begin{verbatim} type Seq = HigherOrderSeq BankersQueue.Seq \end{verbatim} \section{Use and non-use of classes} Each family of abstractions is defined as a set of classes---a main class that every implementation of that abstraction should support and several auxiliary subclasses that an implementation may or may not support. However, not all applications need the power of classes, so each method is also accessible directly from the implementation module. For example, an implementation of sequences will typically define and export a type \cd{Seq~a} together with all the relevant functions on that type (using the same names as the corresponding methods!), and, in addition, declare \cd{Seq} to be an instance of the \cd{Sequence} class. Thus, you can choose to use overloading or not, as appropriate for your particular application. For example, in the following module, \begin{verbatim} module Foo where import qualified Sequence as S import qualified HoodMelvilleQueue as Q ... \end{verbatim} I could refer to the empty queue of type \cd{Q.Seq~a} as either \cd{S.empty} or \cd{Q.empty}. The former refers to the empty method of the \cd{Sequence} class (which might be resolved using a type signature to be of type \cd{Q.Seq~a}) and the latter refers directly to the empty value from \cd{Q}, without going through the class mechanism. Note that this example is somewhat unrealistic. In practice, you would very rarely need to import both modules in their entirety. Usually, you would either import only the implementation module \begin{verbatim} import qualified HoodMelvilleQueue as Q \end{verbatim} or import the class module together with the type from the implementation module \begin{verbatim} import qualified Sequence as S import HoodMelvilleQueue (Seq) \end{verbatim} Note that in the last line, I imported \cd{HoodMelvilleQueue} unqualified. Normally, this would produce a flood of name clashes, but it is acceptable when you are selectively importing only a type name or two. \section{Bonus Operations} Some implementations export a few extra operations beyond those included in the relevant classes. These are typically operations that are particularly efficient for that implementation, but which are not general enough to warrant inclusion in a class. An example of this is the function \cd{unsafeMapMonotonic} that is supported by many priority queues. \section{Fixity} Since qualified infix symbols are fairly ugly, I avoid infix symbols as much as possible. For example, I call the sequence catenation function \cd{append} instead of \cd{++}. \section{Error handling} Since Haskell has no good way to recover from errors, I avoid signalling errors if there is any reasonable alternative. For many functions, it is easy to avoid this by returning the \cd{Maybe} type (or something similar), but sometimes, as with the \cd{head} function on lists and the corresponding \cd{lhead} function on sequences, this approach is just too painful. For \cd{lhead} of an empty sequence, there really is no choice but to signal an error, but other times there is a reasonable alternative. For example, I define both \cd{ltail} of the empty sequence and \cd{take} of a negative argument to return the empty sequence even though the corresponding Prelude functions would signal errors in both of these cases. \section{(Lack of) Portability} \label{portability} Edison does not conform to either Haskell 1.4 or Haskell98. It will hopefully conform to Haskell 2. For now, it is guaranteed to run only under GHC. There are three non-standard language features that I use. Of these, only the first is critical. The other two affect some fraction of the individual modules, and could be eliminated fairly easily. \begin{itemize} \item \emph{Multi-parameter type classes.} Fortunately, this is also the least controversial. Some form of multi-parameter type classes seems certain to make it into Haskell 2, and I expect it to be easy to adapt Edison's signatures accordingly. \item \emph{Unboxed integers.} I frequently use unboxed integers when, for example, every node in a tree needs to maintain some sort of size field. I could simply declare these fields to be strict, but using unboxed integers in these situations is significantly faster. \item \emph{Pattern guards.} I occasionally use pattern guards. Getting by without them would not be difficult, but, since pattern guards also seem likely to make it into Haskell 2, I have not bothered. \end{itemize} If your compiler does not support unboxed integers or pattern guards, you will still be able to use most of Edison---just not those individual data structures that use these features. If your compiler does not support multi-parameter type classes, then you are in much bigger trouble---you will only be able to use the sequence data structures, not collections or associative collections. \section{Unsafe operations} Consider converting a list of elements into a binary search tree. This can be implemented particularly efficiently if we know that the list is already sorted. And in fact, it often is already sorted in practice. This special case, and a handful of similar cases, are common enough and important enough to deserve their own functions. These are functions with non-trivial preconditions that are too expensive to check at runtime, so we simply make their behavior undefined if the preconditions are not satisfied. Violating the preconditions may break the implementations in horrible ways, so we adopt a special naming convention to emphasize that these operations are unsafe---almost all such functions are given names beginning with the word \cd{unsafe} (\cd{unsafeFromOrdList}, \cd{unsafeInsertMin}, etc.). The one place where I have violated this convention is in the \cd{Set} class, where there is a whole family of operations with names like \cd{insertWith} and \cd{unionWith}. These functions take a combining function that is used to resolve collisions. For example, when inserting an element into a set that already contains that element, the combining function is called on the new and old elements to determine which element will remain in the new set.\footnote{ Such a combining function is useful only when nominally equal elements are distinguishable in other ways---that is, when the ``equality'' relation is really an equivalence relation. However, this is extremely common. } The combining functions typically return one element or the other, but they can also combine the elements in non-trivial ways. These combining functions are required to satisfy the precondition that, given two equal elements, they return a third element that is equal to the other two. \section{Currying} All types in Edison are fully curried. \section{Order of arguments} Whenever a function takes multiple arguments, there is a choice as to the order of the arguments. I have tried to make these choices according to the following rules, in decreasing order of importance: \begin{itemize} \item \emph{Favor an order that is more useful for partial applications.} For example, the \cd{member} function \begin{verbatim} member :: CollX c a => c a -> a -> Bool \end{verbatim} takes the collection first and the element second, rather than the other way around, because it is much more commonly partially applied to a collection than to an element. \item \emph{Favor an order with significant mnemonic value.} For example, the \cd{cons} and \cd{snoc} functions \begin{verbatim} cons :: Sequence s => a -> s a -> s a snoc :: Sequence s => s a -> a -> s a \end{verbatim} take their arguments in opposite orders because \cd{cons} adds an element to the left of a sequence and \cd{snoc} adds an element to the right of a sequence. \item \emph{Functions that modify a collection should take the collection last.} For example, the \cd{insert} function has type \begin{verbatim} insert :: CollX c a => a -> c a -> c a \end{verbatim} Taking the collection last supports a convenient style of stringing several update operations in a row using the \cd{\$} combinator, as in \begin{verbatim} insert 1 $ insert 2 $ insert 3 ns \end{verbatim} rather than \begin{verbatim} insert (insert (insert ns 3) 2) 1 \end{verbatim} \item \emph{Consistency with similar operations.} \item \emph{Personal taste.} \end{itemize} \section{Completeness} In designing a library, there is always a delicate question of how much to put in, and how much to leave out. Including too much can lead to code bloat, and make the library somewhat harder to learn. Including too little can make the library significantly less useful. I have tried to err on the side of including too much, rather than too little. Note that this can have an affect on efficiency. Because the classes in Edison have many methods, the dictionaries for the classes will be large, and so building these dictionaries dynamically will be expensive. Fortunately, most dictionaries can be built statically. The exceptions often involve things like non-regular datatypes and polymorphic recursion. This is not to say don't use these features; just don't mix them with overloading and expect the result to be efficient. \section{(In)Efficiency} In text books on data structures and algorithms, data structures are often organized into hierarchies according to efficiency. For example, a hierarchy of sequences might include such entries as \begin{itemize} \item \emph{queues} support efficicent insertions at the rear and deletions from the front \item \emph{steques} (stack-ended queues, also known as output-restricted deques) are queues that additionally support efficient insertions at the front \item \emph{deques} (double-ended queues) are steques that additionally support efficient deletions from the back \end{itemize} Unfortunately, a class hierarchy structured along these lines is so fine-grained that it is nearly impossible to use. In Edison, the class hierarchies are determined by functionality, not by efficiency. For example, the hierarchy for sequences contains only a single class \cd{Sequence}, because all the sequence operations are possible on all the sequence implementations, even if some of the operations are inefficient for some of the implementations. Similarly, the root class for collections--which include sets, bags, and priority queues--contains a \cd{member} method, even though this function is rather inefficient for most priority queues. At some later date, we may support a special mode that prints out a warning whenever one of the particularly inefficient operations is called. This would be implemented by replacing the relevant default definitions (the inefficient operations almost always just use one of the defaults) with calls to a warning function, such as \begin{verbatim} foo = warn moduleName "foo" fooDefault \end{verbatim} instead of \begin{verbatim} foo = fooDefault \end{verbatim} The \cd{warn} function would either print out a message and then return its third argument, or simply return the third argument without printing a message, depending perhaps on a compiler flag, or on which library you linked in. \emph{Let me emphasize that we do nothing like this yet.} \section{Strictness} Most of the operations on most of the data structures are strict. This is inevitable for data structures with non-trivial invariants. Even given that, however, many of the operations are stricter than necessary. In fact, I never \emph{deliberately} make any computations lazy, unless the laziness is required by the algorithm (as often happens with amortized data structures, for instance). In particular, I never use irrefutable patterns to make something lazier. Note, however, that the various sequence implementations are always lazy in their elements. Similarly, associative collections are always lazy in their elements (but usually strict in their keys). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{The Edison Prelude} The \cd{EdisonPrelude} module defines a few widely-used utility types and classes. It is imported by every other module in Edison, and by most clients. (It would be imported by all clients, except that many modules re-export the relevant prelude entries.) Currently, the \cd{EdisonPrelude} defines two types in the \cd{Maybe} family, and three classes related to hashing. % \begin{verbatim} data Maybe2 a b = Just2 a b | Nothing2 data Maybe3 a b c = Just3 a b c | Nothing3 class Eq a => Hash a where hash :: a -> Int -- forall x,y :: a. (x == y) implies (hash x == hash y) class Hash a => UniqueHash a -- no new methods, just a stronger invariant -- forall x,y :: a. (x == y) iff (hash x == hash y) class UniqueHash a => ReversibleHash a where unhash :: Int -> a -- forall x :: a. unhash (hash x) == x \end{verbatim} % The \cd{Maybe2} and \cd{Maybe3} types are used as the return types of functions that destructure a container, returning the element (or a key and element) together with the remaining container. The \cd{Hash} classes are used to build functional analogs to traditional imperative hash tables. This module will gradually be expanded to include utility functions on the \cd{Maybe2} and \cd{Maybe3} types, and perhaps a few other widely-used types or functions (such as \cd{warn}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Sequences} The \emph{sequence} abstraction is usually viewed as a hierarchy of ADTs including lists, queues, deques, catenable lists, etc. However, such a hierarchy is based on efficiency rather than functionality. For example, a list supports all the operations that a deque supports, even though some of the operations may be inefficient. Hence, in Edison, all sequence data structures are defined as instances of the single \cd{Sequence} class: \begin{verbatim} class (Functor s, MonadPlus s) => Sequence s \end{verbatim} All sequences are also instances of \cd{Functor}, \cd{Monad}, and \cd{MonadPlus}. In addition, all sequences are expected to be instances of \cd{Eq} and \cd{Show}, although this is not enforced (in fact, is not enforceable in any reasonable way). We follow the naming convention that every module implementing sequences defines a type constructor named \cd{Seq}. \Figure{seq-methods} summarizes all the methods on sequences. We next describe each of these methods in more detail. \begin{figure} \begin{center} \large\bfseries Sequence Methods \end{center} \hrule \begin{description} \item[Constructors:] \nl \cd{empty}, \cd{single}, \cd{cons}, \cd{snoc}, \cd{append}, \cd{fromList}, \cd{copy}, \cd{tabulate} \item[Destructors:] \nl \cd{lview}, \cd{lhead}, \cd{ltail}, \cd{rview}, \cd{rhead}, \cd{rtail} \item[Observers:] \nl \cd{null}, \cd{size}, \cd{toList} \item[Concat and reverse:] \nl \cd{concat}, \cd{reverse}, \cd{reverseOnto} \item[Maps and folds:] \nl \cd{map}, \cd{concatMap}, \cd{foldr}, \cd{foldl}, \cd{foldr1}, \cd{foldl1}, \cd{reducer}, \cd{reducel}, \cd{reduce1} \item[Subsequences:] \nl \cd{take}, \cd{drop}, \cd{splitAt}, \cd{subseq} \item[Predicate-based operations:] \nl \cd{filter}, \cd{partition}, \cd{takeWhile}, \cd{dropWhile}, \cd{splitWhile} \item[Index-based operations:] \nl \cd{inBounds}, \cd{lookup}, \cd{lookupM}, \cd{lookupWithDefault}, \cd{update}, \cd{adjust}, \\ \cd{mapWithIndex}, \cd{foldrWithIndex}, \cd{foldlWithIndex} \item[Zips and unzips:] \nl \cd{zip}, \cd{zip3}, \cd{zipWith}, \cd{zipWith3}, \cd{unzip}, \cd{unzip3}, \cd{unzipWith}, \cd{unzipWith3} \end{description} \hrule \caption{Summary of methods for the \cd{Sequence} class.} \label{seq-methods} \end{figure} \section{Constructors} \begin{description} \spec{empty \is seq a} The empty sequence. \spec{single \is a \arrow seq a} Create a singleton sequence. \axioms{single x \Equiv cons x empty \Equiv snoc empty x} \eff{O(1)} \spec{cons \is a \arrow seq a \arrow seq a} Add a new element to the front/left of a sequence. \axioms{cons x xs \Equiv append (single x) xs} \eff{O(1)} \spec{snoc \is seq a \arrow a \arrow seq a} Add a new element to the rear/right of a sequence. \axioms{snoc xs x \Equiv append xs (single x)} \eff{O(n)} \spec{append \is seq a \arrow seq a \arrow seq a} Append two sequences, with the first argument on the left and the second argument on the right. \axioms{append xs ys \Equiv foldr cons ys xs} \eff{O(n_1)} \spec{fromList \is \List{a} \arrow seq a} Convert a list to a sequence. \axioms{fromList xs \Equiv foldr cons empty xs} \eff{O(n)} \spec{copy \is Int \arrow a \arrow seq a} Create a sequence containing $n$ copies of the given element. Return \cd{empty} if $n<0$. \axioms{ n > 0 \Implies copy n x \Equiv cons x (copy (n-1) x) \\ n <= 0 \Implies copy n x \Equiv empty} \eff{O(n)} \spec{tabulate \is Int \arrow (Int \arrow a) \arrow seq a} Create a sequence containing the results of applying the given function to the integers $0\ldots n-1$. Return \cd{empty} if $n<0$. \axioms{ n > 0 \Implies tabulate n f \Equiv map f (fromList [0..n-1]) \\ n <= 0 \Implies tabulate n f \Equiv empty} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \end{description} \section{Destructors} \begin{description} \spec{lview \is seq a \arrow Maybe2 a (seq a)} Separate a sequence into its first element and the remaining sequence. Return \cd{Nothing2} if the sequence is empty. \axioms{lview empty \Equiv Nothing2 \\ lview (cons x xs) \Equiv Just2 x xs} \eff{O(1)} \spec{lhead \is seq a \arrow a} Return the first element of the sequence. Signal an error if the sequence is empty. \axioms{lhead empty \Equiv \emph{error} \\ lhead (cons x xs) \Equiv x} \eff{O(1)} \spec{ltail \is seq a \arrow seq a} Delete the first element of the sequence. Return \cd{empty} if the sequence is already empty. \axioms{ltail empty \Equiv empty \\ ltail (cons x xs) \Equiv xs} \eff{O(1)} \spec{rview \is seq a \arrow Maybe2 (seq a) a} Separate a sequence into its last element and the remaining sequence. Return \cd{Nothing2} if the sequence is empty. \axioms{rview empty \Equiv Nothing2 \\ rview (snoc xs x) \Equiv Just2 xs x} \eff{O(n)} \spec{rhead \is seq a \arrow a} Return the first element of the sequence. Signal an error if the sequence is empty. \axioms{rhead empty \Equiv \emph{error} \\ rhead (snoc xs x) \Equiv x} \eff{O(n)} \spec{rtail \is seq a \arrow seq a} Delete the first element of the sequence. Return \cd{empty} if the sequence is already empty. \axioms{rtail empty \Equiv empty \\ rtail (snoc xs x) \Equiv xs} \eff{O(n)} \end{description} \section{Observers} \begin{description} \spec{null \is seq a \arrow Bool} Return \cd{True} if the sequence is empty and \cd{False} otherwise. \axioms{null xs \Equiv (size xs == 0)} \eff{O(1)} \spec{size \is seq a \arrow Int} Return the length of the sequence. \axioms{size empty \Equiv 0 \\ size (cons x xs) \Equiv 1 + size xs} \eff{O(n)} \spec{toList \is seq a \arrow \List{a}} Convert a sequence to a list. \axioms{toList empty \Equiv [] \\ toList (cons x xs) \Equiv x : toList xs} \eff{O(n)} \end{description} \section{Concat and reverse} \begin{description} \spec{concat \is seq (seq a) \arrow seq a} Flatten a sequence of sequences into a simple sequence. \axioms{concat xss \Equiv foldr append empty xss} \efftext{$O(n + m)$, where $n$ is the length of the input sequence and $m$ is the length of the output sequence (usually $n < m$, but if the input sequence contains many empties, then $n$ may be larger)} \spec{reverse \is seq a \arrow seq a} Reverse the order of a sequence. \axioms{reverse empty \Equiv empty \\ reverse (cons x xs) \Equiv snoc (reverse xs) x} \eff{O(n)} \spec{reverseOnto \is seq a \arrow seq a \arrow seq a} Reverse a sequence onto the front of another sequence. \axioms{reverseOnto xs ys \Equiv append (reverse xs) ys} \eff{O(n_1)} \end{description} \section{Maps and folds} \begin{description} \spec{map \is (a \arrow b) \arrow seq a \arrow seq b} Return the result of applying a function to every element of a sequence. \axioms{map f empty \Equiv empty \\ map f (cons x xs) \Equiv cons (f x) (map f xs)} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \spec{concatMap \is (a \arrow seq b) \arrow seq a \arrow seq b} Apply a sequence-producing function to every element of a sequence and flatten the result. Note that \cd{concatMap} is the ``bind'' operation of the sequence monad (but with the arguments in the opposite order). \axioms{concatMap f xs \Equiv concat (map f xs)} \efftext{$O(nt + m)$, where $n$ is the length of the input sequence, $m$ is the length of the output sequence, and $t$ is the running time of \cd{f}} \spec{foldr \is (a \arrow b \arrow b) \arrow b \arrow seq a \arrow b} Combine all the elements of a sequence into a single value, given a right-associative combining function and an initial value. Note that \[\cd{foldr}\; (\oplus)\; \epsilon\; [x_0,x_1,\ldots,x_{n-1}] \;\equiv\; x_0 \oplus (x_1 \oplus \cdots \oplus (x_{n-1} \oplus \epsilon)) \] \axioms{foldr f c empty \Equiv c \\ foldr f c (cons x xs) = f x (foldr f c xs)} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \spec{foldl \is (b \arrow a \arrow b) \arrow b \arrow seq a \arrow b} Combine all the elements of a sequence into a single value, given a left-associative combining function and an initial value. Note that \[\cd{foldl}\; (\oplus)\; \epsilon\; [x_0,x_1,\ldots,x_{n-1}] \;\equiv\; ((\epsilon \oplus x_0) \oplus x_1) \oplus \cdots \oplus x_{n-1} \] \axioms{foldl f c empty \Equiv c \\ foldl f c (cons x xs) = foldl f (f c x) xs} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \spec{foldr1 \is (a \arrow a \arrow a) \arrow seq a \arrow seq a} Combine all the elements of a non-empty sequence into a single value, given a right-associative combining function. Signal an error if the sequence is empty. \axioms{foldr1 f empty \Equiv \emph{error} \\ foldr1 f (snoc xs x) \Equiv foldr f x xs} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \spec{foldl1 \is (a \arrow a \arrow a) \arrow seq a \arrow seq a} Combine all the elements of a non-empty sequence into a single value, given a left-associative combining function. Signal an error if the sequence is empty. \axioms{foldl1 f empty \Equiv \emph{error} \\ foldl1 f (cons x xs) \Equiv foldl f x xs} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \spec{reducer \is (a \arrow a \arrow a) \arrow a \arrow seq a \arrow seq a \\ reducel \is (a \arrow a \arrow a) \arrow a \arrow seq a \arrow seq a \\ reduce1 \is (a \arrow a \arrow a) \arrow seq a \arrow seq a} Like the various folds, but combine the elements in a balanced fashion rather than linearly from right-to-left or left-to-right. Usually, the combining function is associative, in which case the various reduces yield the same answers as the corresponding folds (albeit perhaps more efficiently). \cd{reduce1} signals an error if the sequence is empty. What do I mean by ``in a balanced fashion''? I mean that $\cd{reduce1}\; (\oplus)\; [x_0,\ldots,x_{n-1}]$ equals some complete parenthesization of $x_0 \oplus \cdots \oplus x_{n-1}$, such that the nesting depth of parentheses is $O(\log n)$. The precise shape of this parenthesization is unspecified. For example, the following are all typical answers for $\cd{reduce1}\; (\oplus)\; [a,b,c,d,e,f]$: \[\begin{array}{l} (a \oplus b) \oplus ((c \oplus d) \oplus (e \oplus f)) \\ ((a \oplus b) \oplus (c \oplus d)) \oplus (e \oplus f) \\ (a \oplus (b \oplus c)) \oplus (d \oplus (e \oplus f)) \\ ((a \oplus b) \oplus c) \oplus ((d \oplus e) \oplus f) \end{array}\] \emph{Note that these are the only sequence operations for which different implementations are permitted to yield different answers.}\footnote{ For all the other sequence operations, implementations may differ only in efficiency and strictness/order of evaluation.} Also note that a single implementation may choose different parenthesizations for different sequences, even if they are the same length. This will typically happen when the lists were constructed differently (e.g., one using \cd{cons} and the other using \cd{snoc}). The canonical applications of the \cd{reduce} functions are algorithms like \cd{mergesort}, where \begin{verbatim} mergesort :: (Ord a,Sequence s) => s a -> s a mergesort xs = reducer merge empty (map single xs) \end{verbatim} \axioms{ reduce1 ($\oplus$) empty \Equiv \emph{error} \\ $\forall x,y,z.\; x \oplus (y \oplus z) \Equiv (x \oplus y) \oplus z$ \ \Implies \\ \hspace*{20pt} reduce1 ($\oplus$) xs \Equiv foldr1 ($\oplus$) xs \Equiv foldl1 ($\oplus$) xs \\ \hspace*{20pt} reducer ($\oplus$) c xs \Equiv foldr ($\oplus$) c xs \\ \hspace*{20pt} reducel ($\oplus$) c xs \Equiv foldl ($\oplus$) c xs} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \end{description} \section{Subsequences} \begin{description} \spec{take \is Int \arrow seq a \arrow seq a} Extract a prefix of length $i$ from a sequence. Return \cd{empty} if $i$ is negative, or the entire sequence if $i$ is too large. \axioms{i < 0 \Implies take i xs \Equiv empty \\ i > size xs \Implies take i xs \Equiv xs \\ size xs == i \Implies take i (append xs ys) \Equiv xs} \eff{O(i)} \spec{drop \is Int \arrow seq a \arrow seq a} Delete a prefix of length $i$ from a sequence. Return the entire sequence if $i$ is negative, or \cd{empty} if $i$ is too large. \axioms{i < 0 \Implies drop i xs \Equiv xs \\ i > size xs \Implies drop i xs \Equiv empty \\ size xs == i \Implies drop i (append xs ys) \Equiv ys} \eff{O(i)} \spec{splitAt \is Int \arrow seq a \arrow (seq a, seq a)} Split a sequence into a prefix of length $i$ and the remaining sequence. Behaves the same as the corresponding calls to \cd{take} and \cd{drop} is $i$ is negative or too large. \axioms{splitAt i xs \Equiv (take i xs, drop i xs)} \eff{O(i)} \spec{subseq \is Int \arrow Int \arrow seq a \arrow seq a} Extract a subsequence from a sequence. The integer arguments are ``start index'' and ``length'' rather than ``start index'' and ``end index''. Behaves the same as the corresponding calls to \cd{take} and \cd{drop} if the start index or length are negative or too large. \axioms{subseq i len xs \Equiv take len (drop i xs)} \eff{O(i + len)} \end{description} \section{Predicate-based operations} \begin{description} \spec{filter \is (a \arrow Bool) \arrow seq a \arrow seq a} Extract the elements of a sequence that satisfy the given predicate, retaining the relative ordering of elements from the original sequence. \axioms{filter p empty \Equiv empty \\ filter p (cons x xs) \Equiv if p x then cons x (filter p xs) else filter p xs} \efftext{$O(nt)$, where $t$ is the running time of \cd{p}} \spec{partition \is (a \arrow Bool) \arrow seq a \arrow (seq a, seq a)} Separate the elements of a sequence into those that satisfy the given predicate and those that do not, retaining the relative ordering of elements from the original sequence. \axioms{partition p xs \Equiv (filter p xs, filter (not .\ p) xs)} \efftext{$O(nt)$, where $t$ is the running time of \cd{p}} \spec{takeWhile \is (a \arrow Bool) \arrow seq a \arrow seq a} Extract the maximal prefix of elements satisfying the given predicate. \axioms{takeWhile p empty \Equiv empty \\ takeWhile p (cons x xs) \Equiv if p x then cons x (takeWhile p xs) else empty} \efftext{$O(nt)$, where $t$ is the running time of \cd{p}} \spec{dropWhile \is (a \arrow Bool) \arrow seq a \arrow seq a} Delete the maximal prefix of elements satisfying the given predicate. \axioms{dropWhile p empty \Equiv empty \\ dropWhile p (cons x xs) \Equiv if p x then dropWhile p xs else cons x xs} \efftext{$O(nt)$, where $t$ is the running time of \cd{p}} \spec{splitWhile \is (a \arrow Bool) \arrow seq a \arrow seq a} Split a sequence into the maximal prefix of elements satisfying the given predicate, and the remaining sequence. \axioms{splitWhile p xs \Equiv (takeWhile p xs, dropWhile p xs)} \efftext{$O(nt)$, where $t$ is the running time of \cd{p}} \end{description} \section{Index-based operations} The following operations all assume zero-based indexing. \begin{description} \spec{inBounds \is seq a \arrow Int \arrow Bool} Test whether an index is valid for the given sequence. \axioms{inBounds xs i \Equiv (0 <= i \&\& i < size xs)} \eff{O(i)} \spec{lookup \is seq a \arrow Int \arrow a} Return the element at the given index. Signal an error if the index is out of bounds. \axioms{not (inBounds xs i) \Implies lookup xs i \Equiv \emph{error} \\ size xs == i \Implies lookup (append xs (cons x ys)) i \Equiv x} \eff{O(i)} \spec{lookupM \is seq a \arrow Int \arrow Maybe a} Return \cd{Just} of the element at the given index, or \cd{Nothing} if the index is out of bounds. \axioms{not (inBounds xs i) \Implies lookupM xs i \Equiv Nothing \\ size xs == i \Implies lookupM (append xs (cons x ys)) i \Equiv Just x} \eff{O(i)} \spec{lookupWithDefault \is a \arrow seq a \arrow Int \arrow a} Return the element at the given index, or the default argument if the index is out of bounds. \axioms{not (inBounds xs i) \Implies lookupWithDefault d xs i \Equiv d \\ size xs == i \Implies lookupWithDefault d (append xs (cons x ys)) i \Equiv x} \eff{O(i)} \spec{update \is Int \arrow a \arrow seq a \arrow seq a} Replace the element at the given index, or return the original sequence if the index is out of bounds. \axioms{not (inBounds xs i) \Implies update i y xs \Equiv xs \\ size xs == i \Implies update i y (append xs (cons x ys)) \Equiv append xs (cons y ys)} \eff{O(i)} \spec{adjust \is (a \arrow a) \arrow Int \arrow seq a \arrow seq a} Apply a function to the element at the given index, or return the original sequence if the index is out of bounds. \axioms{not (inBounds xs i) \Implies adjust f i xs \Equiv xs \\ size xs == i \Implies adjust f i (append xs (cons x ys)) \Equiv append xs (cons (f x) ys)} \efftext{$O(i + t)$, where $t$ is the running time of \cd{f}} \spec{mapWithIndex \is (Int \arrow a \arrow b) \arrow seq a \arrow seq b} Like \cd{map}, but include the index with each element. \axioms{mapWithIndex f empty \Equiv empty \\ mapWithIndex f (snoc xs x) \Equiv snoc (mapWithIndex f xs) (f (size xs) x)} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \spec{foldrWithIndex \is (Int \arrow a \arrow b \arrow b) \arrow b \arrow seq a \arrow b} Like \cd{foldr}, but include the index with each element. \axioms{foldrWithIndex f c empty \Equiv c \\ foldrWithIndex f c (snoc xs x) \Equiv foldrWithIndex f (f (size xs) x c) xs} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \spec{foldlWithIndex \is (b \arrow Int \arrow a \arrow b) \arrow b \arrow seq a \arrow b} Like \cd{foldl}, but include the index with each element. \axioms{foldlWithIndex f c empty \Equiv c \\ foldlWithIndex f c (snoc xs x) \Equiv f (foldlWithIndex f c xs) (size xs) x} \efftext{$O(nt)$, where $t$ is the running time of \cd{f}} \end{description} \section{Zips and unzips} \begin{description} \spec{zip \is seq a \arrow seq b \arrow seq (a,b) \\ zip3 \is seq a \arrow seq b \arrow seq c \arrow seq (a,b,c)} Combine two (or three) sequences into a sequence of pairs (or triples). If the sequences are of different lengths, the excess elements of the longer sequence (or sequences) are discarded. \axioms{zip xs ys \Equiv zipWith ($\lambda$ x y \arrow (x,y)) xs ys \\ zip3 xs ys zs \Equiv zipWith3 ($\lambda$ x y z \arrow (x,y,z)) xs ys zs} \eff{O(\min \{n_1,n_2\}), O(\min \{n_1,n_2,n_3\})} \spec{zipWith \is (a \arrow b \arrow c) \arrow seq a \arrow seq b \arrow seq c \\ zipWith3 \is (a \arrow b \arrow c \arrow d) \arrow seq a \arrow seq b \arrow seq c \arrow seq d} Combine two (or three) sequences into a single sequence by mapping a combining function across corresponding elements. If the sequences are of different lengths, the excess elements of the longer sequence (or sequences) are discarded. \axioms{zipWith f (cons x xs) (cons y ys) \Equiv cons (f x y) (zipWith f xs ys) \\ (null xs $\vee$ null ys) \Implies zipWith f xs ys \Equiv empty \\ zipWith3 f (cons x xs) (cons y ys) (cons z zs) \Equiv cons (f x y z) (zipWith3 f xs ys zs) \\ (null xs $\vee$ null ys $\vee$ null zs) \Implies zipWith3 f xs ys zs \Equiv empty} \efftext{$O(t \cdot \min \{n_1,n_2\}), O(t \cdot \min \{n_1,n_2,n_3\})$, where $t$ is the running time of \cd{f}} \spec{unzip \is seq (a,b) \arrow (seq a, seq b) \\ unzip3 \is seq (a,b,c) \arrow (seq a, seq b, seq c)} Transpose a sequence of pairs (or triples) into a pair (or triple) of sequences. \axioms{unzip xys \Equiv (map fst xys, map snd xys) \\ unzip3 xyzs \Equiv (map fst3 xyzs, map snd3 xyzs, map thd3 xyzs)} \eff{O(n)} \spec{unzipWith \is (a \arrow b) \arrow (a \arrow c) \arrow seq a \arrow (seq b, seq c) \\ unzipWith3 \is (a \arrow b) \arrow (a \arrow c) \arrow (a \arrow d) \arrow seq a \arrow (seq b, seq c, seq d)} Map two (or three) functions across every element of a sequence, yielding a pair (or triple) of sequences. \axioms{unzipWith f g xs \Equiv (map f xs, map g xs) \\ unzipWith3 f g h xs \Equiv (map f xs, map g xs, map h xs)} \efftext{$O(nt)$, where $t$ is the maximum running time of \cd{f}, \cd{g}, and \cd{h}} \end{description} \section{Implementations} The following implementations are available or planned. I list with each implementation the major operations whose running times differ from the default (either better or worse). \begin{description} \item[Available:] \nl \vspace*{-15pt} \begin{itemize} \impl{ListSeq} Ordinary lists. \impl{SimpleQueue} Burton, IPL'82. \\ \hsp $O(1)$ \cd{snoc}. \\ \hsp $O(1)$ \cd{lview/ltail} if single-threaded, $O(n)$ otherwise. \impl{BankersQueue} Okasaki, JFP'95. \\ \hsp $O(1)$ \cd{snoc}. \impl{MyersStack} Myers, IPL'93. \\ \hsp $O(\log n)$ \cd{lookup}. \impl{RandList} Okasaki, FPCA'95. \\ \hsp $O(\log n)$ \cd{lookup}, \cd{update}. \impl{BinaryRandList} Okasaki, PFDS (Chapter 10.1.2). \\ \hsp $O(\log n)$ \cd{lookup}, \cd{update}. \impl{JoinList} \\ \hsp $O(1)$ \cd{snoc/append}. \\ \hsp $O(n)$ \cd{lview/ltail/rview/rtail}, but $O(1)$ in practice. \end{itemize} \item[Planned:] \nl \vspace*{-15pt} \begin{itemize} \impl{StrictList} Strict lists. \impl{BootstrappedQueue} Okasaki, PFDS. \\ \hsp $O(1)$ \cd{snoc}. \impl{SimpleDeque} Hoogerwoord, JFP'92. \\ \hsp $O(1)$ \cd{snoc}. \\ \hsp $O(1)$ \cd{lview/ltail/rview/rtail} if single-threaded, $O(n)$ otherwise. \impl{CatenableList} Okasaki, FOCS'95. \\ \hsp $O(1)$ \cd{snoc}, \cd{append}. \impl{CatenableDeque} Okasaki, ICFP'97. \\ \hsp $O(1)$ \cd{snoc}, \cd{rview/rhead/rtail}, \cd{append}. \impl{BraunSeq} Hoogerwoord, MPC'92. \\ \hsp $O(\log n)$ \cd{cons/lview/ltail}. \\ \hsp $O(\log^2 n)$ \cd{snoc/rview/rhead/rtail}. \\ \hsp $O(\log i)$ \cd{lookup}, \cd{update}. \end{itemize} \end{description} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Collections} \label{sec:coll} The \emph{collection} abstraction includes sets, bags, and priority queues (heaps). Collections are defined in Edison as a set of eight classes, organized in the hierarchy shown in \Figure{collection-hierarchy}. These classes make essential use of multi-parameter type classes. All collections assume at least an equality relation on elements, and many also assume an ordering relation. The use of multi-parameter type classes allows any particular instance to assume further properties as necessary (such as hashability). \begin{figure} \small \begin{center} %BEGIN IMAGE \begin{picture}(200,200)(0,0) \put(100,200){\makebox(0,0){\cd{Eq $a$}}} \put(20,150){\makebox(0,0){\cd{Ord $a$}}} \put(100,168){\line(0,1){24}} \put(100,160){\makebox(0,0){\cd{CollX $c$ $a$}}} \put(20,118){\line(0,1){24}} \put(26,118){\line(2,1){68}} \put(20,110){\makebox(0,0){\cd{OrdCollX $c$ $a$}}} \put(174,118){\line(-2,1){68}} \put(180,110){\makebox(0,0){\cd{SetX $c$ $a$}}} \put(106,68){\line(2,1){68}} \put(94,68){\line(-2,1){68}} \put(100,60){\makebox(0,0){\cd{OrdSetX $c$ $a$}}} \put(100,108){\line(0,0){44}} \put(100,100){\makebox(0,0){\cd{Coll $c$ $a$}}} \put(20,58){\line(0,0){44}} \put(26,58){\line(2,1){68}} \put(20,50){\makebox(0,0){\cd{OrdColl $c$ $a$}}} \put(180,58){\line(0,0){44}} \put(174,58){\line(-2,1){68}} \put(180,50){\makebox(0,0){\cd{Set $c$ $a$}}} \put(106,8){\line(2,1){68}} \put(94,8){\line(-2,1){68}} \put(100,0){\makebox(0,0){\cd{OrdSet $c$ $a$}}} \end{picture} \\[40pt] %END IMAGE %HEVEA\imageflush \ttfamily \begin{tabular}{cccc} CollX & OrdCollX & SetX & OrdSetX \\ \hline empty,insert & deleteMin & intersect & \textit{no methods} \\ union,delete & unsafeInsertMin & difference & \\ null,size & filterLT & subset & \\ member,count & $\cdots$ & subsetEq & \\ $\cdots$ & & & \\[20pt] Coll & OrdColl & Set & OrdSet \\ \hline toSeq & minElem & insertWith & \textit{no methods} \\ lookup & foldr,foldl & unionWith & \\ fold & toOrdSeq & intersectWith & \\ filter & $\cdots$ & $\cdots$ & \\ $\cdots$ & & & \\ \end{tabular} \end{center} \normalsize \caption{The collection class hierarchy, with typical methods for each class.} \label{collection-hierarchy} \end{figure} The hierarchy contains a root class, \cd{CollX}, together with seven subclasses satisfying one or more of three common sub-properties: % \begin{itemize} \item \emph{Uniqueness}. Each element in the collection is unique (i.e., no two elements in the collection are equal). These subclasses, indicated by the name \cd{Set}, represent sets rather than bags. \item \emph{Ordering}. The elements have a total ordering and it is possible to process the elements in non-decreasing order. These subclasses, indicated by the \cd{Ord} prefix, typically represent either priority queues (heaps) or sets/bags implemented as binary search trees. \item \emph{Observability}. An observable collection is one in which it is possible to view the elements in a collection. The \cd{X} suffix indicates lack of observability. This property is discussed in greater detail below in \Section{observability}. \end{itemize} Because collections encompass a wide range of abstractions, there is no single name that is suitable for all collection type constructors. However, most modules implementing collections will define a type constructor named either \cd{Bag}, \cd{Set}, or \cd{Heap}. \Figure{coll-methods} summarizes all the methods on collections. These methods will be described in more detail in the sections on each subclass in the hierarchy. \begin{figure} \begin{center} \large\bfseries Collection Methods \end{center} \hrule \begin{description} \item[Constructors:] \nl \cd{CollX}: \cd{empty}, \cd{single}, \cd{insert}, \cd{insertSeq}, \cd{union}, \cd{unionSeq}, \cd{fromSeq} \\ \cd{OrdCollX}: \cd{unsafeInsertMin}, \cd{unsafeInsertMax}, \cd{unsafeFromOrdSeq}, \cd{unsafeAppend} \\ \cd{Set}: \cd{insertWith}, \cd{insertSeqWith}, \cd{unionl}, \cd{unionr}, \cd{unionWith}, \cd{unionSeqWith}, \cd{fromSeqWith} \item[Destructors:] \nl \cd{OrdColl}: \cd{minView}, \cd{minElem}, \cd{maxView}, \cd{maxElem} \item[Deletions:] \nl \cd{CollX}: \cd{delete}, \cd{deleteAll}, \cd{deleteSeq} \\ \cd{OrdCollX}: \cd{deleteMin}, \cd{deleteMax} \item[Observers:] \nl \cd{CollX}: \cd{null}, \cd{size}, \cd{member}, \cd{count} \\ \cd{Coll}: \cd{lookup}, \cd{lookupM}, \cd{lookupAll}, \cd{lookupWithDefault}, \cd{toSeq} \\ \cd{OrdColl}: \cd{toOrdSeq} \item[Filters and partitions:] \nl \cd{OrdCollX}: \cd{filterLT}, \cd{filterLE}, \cd{filterGT}, \cd{filterGE}, \\ \hspace*{20pt} \cd{partitionLT\_GE}, \cd{partitionLE\_GT}, \cd{partitionLT\_GT} \\ \cd{Coll}: \cd{filter}, \cd{partition} \item[Set operations:] \nl \cd{SetX}: \cd{intersect}, \cd{difference}, \cd{subset}, \cd{subsetEq} \\ \cd{Set}: \cd{intersectWith} \item[Folds:] \nl \cd{Coll}: \cd{fold}, \cd{fold1} \\ \cd{OrdColl}: \cd{foldr}, \cd{foldl}, \cd{foldr1}, \cd{foldl1} \end{description} \hrule \caption{Summary of methods for the collections classes.} \label{coll-methods} \end{figure} \section{Observability} \label{observability} Note that the equality relation defined by the \cd{Eq} class is not necessarily true equality. Very often it is merely an equivalence relation, where equivalent values may be distinguishable by other means. For example, we might consider two binary search trees to be equal if they contain the same elements, even if their shapes are different. Because of this phenomenon, implementations of observable collections (i.e., collections where it is possible to inspect the elements) are rather constrained. Such an implementation must retain the actual elements that were inserted. For example, it is not possible in general to represent an observable bag as a finite map from elements to counts, because even if we know that a given bag contains, say, three elements from some equivalence class, we do not necessarily know \emph{which} three. On the other hand, implementations of \emph{non-observable} collections have much greater freedom to choose abstract representations of each equivalence class. For example, representing a bag as a finite map from elements to counts works fine if we never need to know \emph{which} representatives from an equivalence class are actually present. As another example, consider the \cd{UniqueHash} class defined in the Edison Prelude. If we know that the \cd{hash} function yields a unique integer for each equivalence class, then we can represent a collection of hashable elements simply as a collection of integers. With such a representation, we can still do many useful things like testing for membership---we just can't support functions like \cd{fold} or \cd{filter} that require the elements themselves, rather than the hashed values.\footnote{In fact, we can even support \cd{fold} and \cd{filter} if the hashing function is \emph{reversible}, but this is relatively uncommon.} \section{\cd{CollX}} \begin{verbatim} class Eq a => CollX c a \end{verbatim} % This is the root class of the hierarchy. However, it is perfectly adequate for many applications that use sets or bags. \subsection{Constructors} \begin{description} \spec{empty \is coll a} The empty collection. % \axioms{size empty \Equiv 0 \\ % count empty x \Equiv 0} \spec{single \is a \arrow coll a} Create a singleton collection. % \axioms{size (single x) \Equiv 1 \\ % count (single x) y \Equiv if x == y then 1 else 0} \spec{insert \is a \arrow coll a \arrow coll a \\ insertSeq \is Sequence seq \Arrow seq a \arrow coll a \arrow coll a} Add an element or a sequence of elements to a collection. For sets, \cd{insert} keeps the new element in the case of duplicates, but \cd{insertSeq} keeps an unspecified element. See also \cd{insertWith} and \cd{insertSeqWith} in \cd{Set}. \ignore{ \axioms{\textrm{For bags:} \\ \hspace*{20pt} size (insert x xs) \Equiv 1 + size xs \\ \hspace*{20pt} count (insert x xs) y \Equiv if x == y then 1 + count xs y else count xs y \\ \textrm{For sets:} \\ \hspace*{20pt} size (insert x xs) \Equiv if member xs x then size xs else 1 + size xs \\ \hspace*{20pt} count (insert x xs) y \Equiv if x == y then 1 else count xs y \\ \textrm{For observable sets:} \\ \hspace*{20pt} insert x xs \Equiv insert x (delete x xs)} } \spec{union \is coll a \arrow coll a \arrow coll a \\ unionSeq \is Sequence seq \Arrow seq a \arrow seq (coll a) \arrow coll a} Merge two collections or a sequence of collections. For sets, it is unspecified which element is kept in the case of duplicates. See also \cd{unionl}, \cd{unionr}, \cd{unionWith}, and \cd{unionSeqWith} in \cd{Set}. \spec{fromSeq \is Sequence seq \Arrow seq a \arrow coll a} Convert a sequence of elements into a collection. For sets, it is unspecified which element is kept in the case of duplicates. See also \cd{fromSeqWith} in \cd{Set}. \end{description} \subsection{Deletions} \begin{description} \spec{delete \is a \arrow coll a \arrow coll a \\ deleteAll \is a \arrow coll a \arrow coll a} Delete a single occurrence or all occurences of the given element from a collection. If the element does not appear in the collection, then leave the collection unchanged. For sets, these functions will be the same, but for bags they may be different. For \cd{delete} on bags, it is unspecified which of several duplicate elements is deleted. \spec{deleteSeq \is Sequence seq \arrow seq a \arrow coll a \arrow coll a} Delete a single occurrence of each of the given elements from a collection, ignoring those elements in the sequence that do not appear in the collection. For bags, there may be multiple occurrences of a given element in the collection, in which case it is unspecified which is deleted. \end{description} \subsection{Observers} \begin{description} \spec{null \is coll a \arrow Bool} Test whether the collection is empty. \axioms{null xs \Equiv (size xs == 0)} \spec{size \is coll a \arrow Int} Return the number of elements in the collection. \spec{member \is coll a \arrow a \arrow Bool} Test whether the given element is in the collection. \axioms{member xs x \Equiv (count xs x > 0)} \spec{count \is coll a \arrow a \arrow Int} Count how many copies of the given element are in the collection. \end{description} \section{\cd{OrdCollX}} \begin{verbatim} class (CollX c a, Ord a) => OrdCollX c a \end{verbatim} \subsection{Constructors} \begin{description} \spec{unsafeInsertMin \is a \arrow coll a \arrow coll a \\ unsafeInsertMax \is coll a \arrow a \arrow coll a} Insert an element into a collection with the precondition that the new element is $\leq$ or $\geq$ any existing elements. For sets, this precondition is strengthened to $<$ or $>$. \spec{unsafeFromOrdSeq \is Sequence seq \Arrow seq a \arrow coll a} Convert a sequence of elements into a collection with the precondition that the sequence is already sorted into non-decreasing order. For sets, this precondition is strengthened to increasing order. \spec{unsafeAppend \is coll a \arrow coll a \arrow coll a} Merge two collections with the precondition that every element in the first collection is $\leq$ every element in the second collection. For sets, this precondition is strengthened to $<$. \end{description} \subsection{Deletions} \begin{description} \spec{deleteMin \is coll a \arrow coll a \\ deleteMax \is coll a \arrow coll a} Delete the minimum or maximum element from the collection, or return \cd{empty} if the collection is empty. If there is more than one minimum or maximum, it is unspecified which is deleted. See also \cd{minView}, \cd{minElem}, \cd{maxView}, and \cd{maxElem} in \cd{OrdColl}. \end{description} \subsection{Filters and partitions} \begin{description} \spec{filterLT \is a \arrow coll a \arrow coll a \\ filterLE \is a \arrow coll a \arrow coll a \\ filterGT \is a \arrow coll a \arrow coll a \\ filterGE \is a \arrow coll a \arrow coll a} Extract the subcollection of elements $<$, $\leq$, $>$, or $\geq$ the given element. Equivalent to the corresponding calls to \cd{filter} (in \cd{Coll}), but may be much more efficient. \axioms{filterLT x xs \Equiv filter (< x) xs \\ filterLE x xs \Equiv filter (<= x) xs \\ filterGT x xs \Equiv filter (> x) xs \\ filterGE x xs \Equiv filter (>= x) xs} \spec{partitionLT\_GE \is a \arrow coll a \arrow (coll a, coll a) \\ partitionLE\_GT \is a \arrow coll a \arrow (coll a, coll a) \\ partitionLT\_GT \is a \arrow coll a \arrow (coll a, coll a)} Split a collection into those elements $<$, $\leq$, or $<$ the given element, and those elements $\ge$, $>$, or $>$ the given element. \cd{partitionLT\_GE} and \cd{partitionLE\_GT} are equivalent to the corresponding calls to \cd{partition} (in \cd{Coll}), but may be much more efficient. \cd{partitionLT\_GT} cannot be expressed as a single call to \cd{partition} because it discards elements equal to the given element. \axioms{partitionLT\_GE x xs \Equiv partition (< x) xs \\ partitionLE\_GT x xs \Equiv partition (<= x) xs \\ partitionLT\_GT x xs \Equiv (filterLT x xs, filterGT x xs)} \end{description} \section{\cd{SetX}} \begin{verbatim} class CollX c a => SetX c a \end{verbatim} \subsection{Set operations} \begin{description} \spec{intersect \is coll a \arrow coll a \arrow coll a} Computes the intersection of two sets. It is unspecified which of the two elements is kept. \spec{difference \is coll a \arrow coll a \arrow coll a} Computes the difference of two sets (i.e., the set of all elements in the first set that are not in the second set). \spec{subset \is coll a \arrow coll a \arrow Bool \\ subsetEq \is coll a \arrow coll a \arrow Bool} Test whether every element in the first set is also in the second set. \cd{subset} additionally tests whether the second set contains at least one element that is not in the first set. \end{description} \section{\cd{OrdSetX}} \begin{verbatim} class (OrdCollX c a, SetX c a) => OrdSetX c a \end{verbatim} % This class contains no methods. It exists only as an abbreviation for the context \begin{center} \cd{(OrdCollX c a, SetX c a)} \end{center} \section{\cd{Coll}} \begin{verbatim} class CollX c a => Coll c a \end{verbatim} \subsection{Observers} \begin{description} \spec{lookup \is coll a \arrow a \arrow a \\ lookupM \is coll a \arrow a \arrow Maybe a \\ lookupAll \is Sequence seq \Arrow coll a \arrow a \arrow seq a \\ lookupWithDefault \is a \arrow coll a \arrow a \arrow a} Search for an element in the set that is equal to the given element. \cd{lookup} signals an error if no such element exists, while \cd{lookupWithDefault} returns a default value (provided as its first argument). For bags, it is unspecified which of several duplicates is chosen by \cd{lookup}, \cd{lookupM}, or \cd{lookupWithDefault}. \cd{lookupAll} returns all the duplicates, but in an unspecified order. \spec{toSeq \is Sequence seq \Arrow coll a \arrow seq a} Return a sequence of all the elements in a collection, in an unspecified order. \end{description} \subsection{Filters and partitions} \begin{description} \spec{filter \is (a \arrow Bool) \arrow coll a \arrow coll a} Extract all the elements satisfying the given predicate. \spec{partition \is (a \arrow Bool) \arrow coll a \arrow (coll a, coll a)} Split a collection into those elements satisfying the given predicate, and those elements not satisfying the predicate. \end{description} \subsection{Folds} \begin{description} \spec{fold \is (a \arrow b \arrow b) \arrow b \arrow coll a \arrow b} Combine all the elements in a collection into a single value, given a combining function and an initial value. Processes the elements in an unspecified order. \spec{fold1 \is (a \arrow a \arrow a) \arrow coll a \arrow a} Combine all the elements in a non-empty collection into a single value using the given combining function. Signals an error if the collection is empty. Processes the elements in an unspecified order. An implementation may choose to process the elements linearly or in a balanced fashion (like \cd{reduce1} on sequences). \end{description} \section{\cd{OrdColl}} \begin{verbatim} class (Coll c a, OrdCollX c a) => OrdColl c a \end{verbatim} \subsection{Destructors} \begin{description} \spec{minView \is coll a \arrow Maybe2 a (coll a) \\ maxView \is coll a \arrow Maybe2 (coll a) a} Separate a collection into its minimum/maximum element and the remaining collection. Return \cd{Nothing2} if the collection is empty. If there is more than one minimum/maximum, choose an unspecified one. \spec{minElem \is coll a \arrow a \\ maxElem \is coll a \arrow a} Return the minimum/maximum element in the collection, or signal an error if the collection is empty. If there is more than one minimum/maximum, choose an unspecified one. \end{description} \subsection{Observers} \begin{description} \spec{toOrdSeq \is Sequence seq \arrow coll a \arrow seq a} Convert a collection into a non-decreasing sequence of elements. The order in which clusters of equal elements are listed is unspecified. (For sets, the order will always be increasing.) \end{description} \subsection{Folds} \begin{description} \spec{foldr \is (a \arrow b \arrow b) \arrow b \arrow coll a \arrow b \\ foldl \is (b \arrow a \arrow b) \arrow b \arrow coll a \arrow b} Fold across the elements in non-decreasing order (increasing order in the case of sets). The order in which clusters of equal elements are processed is unspecified. \spec{foldr1 \is (a \arrow a \arrow a) \arrow coll a \arrow a \\ foldl1 \is (a \arrow a \arrow a) \arrow coll a \arrow a} Fold across the elements in non-decreasing order (increasing order in the case of sets), or signal an error if the collection is empty. The order in which clusters of equal elements are processed is unspecified. \end{description} \section{\cd{Set}} \begin{verbatim} class (Coll c a, SetX c a) => Set c a \end{verbatim} % \emph{Warning: each of the following ``With'' functions is unsafe.} Each takes a combining function that is used to choose which element is kept in the case of duplicates. This combining function must satisfy the precondition that, given two equal elements, it returns a third element that is equal to both. Usually, the combining function just returns its first or second argument, but it can combine the elements in non-trivial ways. The combining function should usually be associative. If not, the elements will be combined left-to-right, but with an unspecified associativity. For example, it \cd{x~==~y~==~z}, then \cd{fromList~($\oplus$)~[x,y,z]} equals either \begin{center} \cd{single (x $\oplus$ (y $\oplus$ z))} \hspace{20pt}or\hspace{20pt} \cd{single ((x $\oplus$ y) $\oplus$ z)}. \end{center} \subsection{Constructors} \begin{description} \spec{insertWith \is (a \arrow a \arrow a) \arrow a \arrow coll a \arrow coll a \\ insertSeqWith \is Sequence seq \Arrow (a \arrow a \arrow a) \arrow seq a \arrow coll a \arrow coll a} Same as \cd{insert} and \cd{insertSeq}, but with a combining function to resolve duplicates. See the comments about associativity for \cd{insertSeqWith}. \spec{unionl \is coll a \arrow coll a \arrow coll a \\ unionr \is coll a \arrow coll a \arrow coll a} Same as \cd{union} but keep the element from the left/right collection in the case of duplicates. \axioms{unionl xs ys \Equiv unionWith ($\lambda$ x y \arrow x) xs ys \\ unionr xs ys \Equiv unionWith ($\lambda$ x y \arrow y) xs ys} \spec{unionWith \is (a \arrow a \arrow a) \arrow coll a \arrow coll a \arrow coll a \\ unionSeqWith \is Sequence seq \Arrow (a \arrow a \arrow a) \arrow seq (coll) a \arrow coll a} Same as \cd{union} and \cd{unionSeq}, but with a combining function to resolve duplicates. See the comments about associativity for \cd{unionSeqWith}. \spec{fromSeqWith \is Sequence seq \Arrow (a \arrow a \arrow a) \arrow seq a \arrow coll a} Same as \cd{fromSeq}, but with a combining function to resolve duplicates. See the comments about associativity. \end{description} \subsection{Set operations} \begin{description} \spec{intersectWith \is (a \arrow a \arrow a) \arrow coll a \arrow coll a} Same as \cd{intersect}, but with a combining function to resolve duplicates. \end{description} \section{\cd{OrdSet}} \begin{verbatim} class (OrdColl c a, Set c a) => OrdSet c a \end{verbatim} % This class contains no methods. It exists only as an abbreviation for the context \begin{center} \cd{(OrdColl c a, Set c a)} \end{center} \section{Specialized operations on lists} For each of the collection methods that involve sequences (e.g., \cd{insertSeq}, \cd{toOrdSeq}, \cd{lookupAll}), there is a specialized version that operates on lists. The specialized versions are obtained by replacing the name \cd{Seq} with \cd{List} (e.g., \cd{insertSeq} becomes \cd{insertList}). The sole exception to this naming scheme is the specialized version of \cd{lookupAll}, which is named \cd{lookupList}. These functions are defined in the \cd{Collections} module and rely on overloading (as opposed to being accessible directly from each implementation module). The types of these functions are \begin{quote}\ttfamily \begin{tabular}{l@{$\;$\is}l} fromList & CollX c a \Arrow [a] \arrow c a \\ insertList & CollX c a \Arrow [a] \arrow c a \arrow c a \\ unionList & CollX c a \Arrow [c a] \arrow c a \\ deleteList & CollX c a \Arrow [a] \arrow c a \arrow c a \\ unsafeFromOrdList & OrdCollX c a \Arrow [a] \arrow c a \\ toList & Coll c a \Arrow c a \arrow [a] \\ lookupList & Coll c a \Arrow c a \arrow a \arrow [a] \\ toOrdList & OrdColl c a \Arrow c a \arrow [a] \\ fromListWith & Set c a \Arrow (a \arrow a \arrow a) \arrow [a] \arrow c a \\ insertListWith & Set c a \Arrow (a \arrow a \arrow a) \arrow [a] \arrow c a \arrow c a \\ unionListWith & Set c a \Arrow (a \arrow a \arrow a) \arrow [c a] \arrow c a \end{tabular} \end{quote} \section{Utility functions} The module \cd{CollectionUtils} contains several utility functions. This module will likely expand in the future. \begin{description} \spec{map \is (Coll cin a, CollX cout b) \Arrow (a \arrow b) \arrow (cin a \arrow cout b)} Map a function across every element in a collection. Note that both the element type and the collection type may change. \spec{mapPartial \is (Coll cin a, CollX cout b) \Arrow (a \arrow Maybe b) \arrow (cin a \arrow cout b)} Map a partial function across every element in a collection, discarding \cd{Nothing} results. Note that both the element type and the collection type may change. \spec{unsafeMapMonotonic \is (OrdColl cin a, OrdCollX cout b) \Arrow (a \arrow b) \arrow (cin a \arrow cout b)} Map a monotonic function across every element in a collection. Note that both the element type and the collection type may change. The function \cd{f} must satisfy the precondition that \begin{center}\ttfamily x <= y \Implies f x <= f y \end{center} For sets this precondition is strengthened to \begin{center}\ttfamily x < y \Implies f x < f y \end{center} \spec{unionMap \is (Coll cin a, CollX cout b) \Arrow (a \arrow cout b) \arrow (cin a \arrow cout b)} Apply a collection-producing function to every element in a collection, and merge the results. Note that both the element type and the collection type may change. \cd{unionMap} is essentially equivalent to the bind operation on monads, except that collections cannot be monads because of the use of multi-parameter type classes. \end{description} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Associative Collections} The \emph{associative-collection} abstraction includes finite maps, finite relations, and priority queues where the priority is separate from element. Associative collections are defined in Edison as a set of eight classes, organized in the hierarchy shown in \Figure{assoc-hierarchy}. Notice that this hierarchy mirrors the hierarchy for collections, but with the addition of \cd{Functor} as a superclass of every associative collection. Like collections, associative collections depend heavily on multi-parameter type classes. \begin{figure} \small \begin{center} %BEGIN IMAGE \begin{picture}(200,200)(0,0) \put(70,200){\makebox(0,0){\cd{Eq $k$}}} \put(130,200){\makebox(0,0){\cd{Functor ($m \; k$)}}} \put(96,168){\line(-1,1){24}} \put(104,168){\line(1,1){24}} \put(100,160){\makebox(0,0){\cd{AssocX $m$ $k$}}} \put(20,118){\line(0,1){24}} \put(26,118){\line(2,1){68}} \put(20,150){\makebox(0,0){\cd{Ord $k$}}} \put(20,110){\makebox(0,0){\cd{OrdAssocX $m$ $k$}}} \put(174,118){\line(-2,1){68}} \put(180,110){\makebox(0,0){\cd{FiniteMapX $m$ $k$}}} \put(106,68){\line(2,1){68}} \put(94,68){\line(-2,1){68}} \put(100,60){\makebox(0,0){\cd{OrdFiniteMapX $m$ $k$}}} \put(100,108){\line(0,0){44}} \put(100,100){\makebox(0,0){\cd{Assoc $m$ $k$}}} \put(20,58){\line(0,0){44}} \put(26,58){\line(2,1){68}} \put(20,50){\makebox(0,0){\cd{OrdAssoc $m$ $k$}}} \put(180,58){\line(0,0){44}} \put(174,58){\line(-2,1){68}} \put(180,50){\makebox(0,0){\cd{FiniteMap $m$ $k$}}} \put(106,8){\line(2,1){68}} \put(94,8){\line(-2,1){68}} \put(100,0){\makebox(0,0){\cd{OrdFiniteMap $m$ $k$}}} \end{picture} \\[40pt] %END IMAGE %HEVEA\imageflush \ttfamily \begin{tabular}{cccc} AssocX & OrdAssocX & FiniteMapX & OrdFiniteMapX \\ \hline empty,insert & minElem & insertWith & \textit{no methods} \\ union,delete & deleteMin & unionWith & \\ null,size & unsafeInsertMin & intersectWith & \\ lookup & foldr,foldl & difference & \\ map,fold & filterLT & subset & \\ filter & $\cdots$ & $\cdots$ & \\ $\cdots$ & & & \\[20pt] Assoc & OrdAssoc & FiniteMap & OrdFiniteMap \\ \hline toSeq & minElemWithKey & unionWithKey&\textit{no methods} \\ mapWithKey & foldrWithKey & intersectWithKey & \\ foldWithKey & toOrdSeq & $\cdots$ & \\ filterWithKey& $\cdots$ & & \\ $\cdots$ & & & \\ \end{tabular} \end{center} \normalsize \caption{The associative-collection class hierarchy, with typical methods for each class.} \label{assoc-hierarchy} \end{figure} The operations on associative collections are similar to the operations on collections. The differences arise from having a separate key and element, rather than just an element. One significant implication of this separation is that many of the methods move up in the hierarchy, because elements are always observable for associative collections (even though keys may not be). \begin{figure} \begin{center} \large\bfseries Associative-Collection Methods \end{center} \hrule \begin{description} \item[Constructors:] \nl \cd{AssocX}: \cd{empty}, \cd{single}, \cd{insert}, \cd{insertSeq}, \cd{union}, \cd{unionSeq}, \cd{fromSeq} \\ \cd{OrdAssocX}: \cd{unsafeInsertMin}, \cd{unsafeInsertMax}, \cd{unsafeFromOrdSeq}, \cd{unsafeAppend} \\ \cd{FiniteMapX}: \cd{insertWith}, \cd{insertWithKey}, \cd{insertSeqWith}, \cd{insertSeqWithKey}, \\ \hspace*{20pt} \cd{unionl}, \cd{unionr}, \cd{unionWith}, \cd{unionSeqWith}, \cd{fromSeqWith}, \cd{fromSeqWithKey} \\ \cd{FiniteMap}: \cd{unionWithKey}, \cd{unionSeqWithKey} \item[Destructors:] \nl \cd{OrdAssocX}: \cd{minView}, \cd{minElem}, \cd{maxView}, \cd{maxElem} \\ \cd{OrdAssoc}: \cd{minViewWithKey}, \cd{minElemWithKey}, \cd{maxViewWithKey}, \cd{maxElemWithKey} \item[Deletions:] \nl \cd{AssocX}: \cd{delete}, \cd{deleteAll}, \cd{deleteSeq} \\ \cd{OrdAssocX}: \cd{deleteMin}, \cd{deleteMax} \item[Observers:] \nl \cd{AssocX}: \cd{null}, \cd{size}, \cd{member}, \cd{count}, \cd{lookup}, \cd{lookupM}, \cd{lookupAll}, \cd{lookupWithDefault}, \cd{elements} \\ \cd{Assoc}: \cd{toSeq}, \cd{keys} \\ \cd{OrdAssoc}: \cd{toOrdSeq} \item[Modifiers:] \nl \cd{AssocX}: \cd{adjust}, \cd{adjustAll} \item[Maps and folds:] \nl \cd{AssocX}: \cd{map}, \cd{fold}, \cd{fold1} \\ \cd{OrdAssocX}: \cd{foldr}, \cd{foldl}, \cd{foldr1}, \cd{foldl1} \\ \cd{Assoc}: \cd{mapWithKey}, \cd{foldWithKey} \\ \cd{OrdAssoc}: \cd{foldrWithKey}, \cd{foldlWithKey} \item[Filters and partitions:] \nl \cd{AssocX}: \cd{filter}, \cd{partition} \\ \cd{OrdAssocX}: \cd{filterLT}, \cd{filterLE}, \cd{filterGT}, \cd{filterGE}, \\ \hspace*{20pt} \cd{partitionLT\_GE}, \cd{partitionLE\_GT}, \cd{partitionLT\_GT} \\ \cd{Assoc}: \cd{filterWithKey}, \cd{partitionWithKey} \item[Set-like operations:] \nl \cd{FiniteMapX}: \cd{intersectWith}, \cd{difference}, \cd{subset}, \cd{subsetEq} \\ \cd{FiniteMap}: \cd{intersectWithKey} \end{description} \hrule \caption{Summary of methods for the associative-collection classes.} \label{assoc-methods} \end{figure} \Figure{assoc-methods} summarizes all the methods on associative collections. These methods will be described in more detail in the sections on each subclass in the hierarchy. I will frequently abbreviate ``associative collection'' as \AC. I will also refer jointly to a key and element as a \emph{binding}. \section{\cd{AssocX}} \begin{verbatim} class Eq k => AssocX m k \end{verbatim} \subsection{Constructors} \begin{description} \spec{empty \is m k a} The empty \AC. \spec{single \is k \arrow a \arrow m k a} Create an \AC with a single binding. \spec{insert \is k \arrow a \arrow m k a \arrow m k a \\ insertSeq \is Sequence seq \Arrow seq (k,a) \arrow m k a \arrow m k a} Add a binding or a sequence of bindings to a collection. For finite maps, \cd{insert} keeps the new element in the case of duplicate keys, but \cd{insertSeq} keeps an unspecified element. Which key is kept is also unspecified for both methods. See also \cd{insertWith}, \cd{insertWithKey}, \cd{insertSeqWith}, and \cd{insertSeqWithKey} in \cd{FiniteMapX}. \spec{union \is m k a \arrow m k a \arrow m k a \\ unionSeq \is Sequence seq \Arrow seq (m k a) \arrow m k a} Merge two \ACs or a sequence of \ACs. Which element and which key to keep in the case of duplicate keys is unspecified. See also \cd{unionWith} and \cd{unionSeqWith} in \cd{FiniteMapX} and \cd{unionWithKey} and \cd{unionSeqWithKey} in \cd{FiniteMap}. \spec{fromSeq \is Sequence seq \Arrow seq (k,a) \arrow m k a} Convert a list of bindings to an \AC. Which element and which key to keep in the case of duplicate keys is unspecified. \end{description} \subsection{Deletions} \begin{description} \spec{delete \is k \arrow m k a \arrow m k a \\ deleteAll \is k \arrow m k a \arrow m k a} Delete one binding or all bindings with the given key, or leave the \AC unchanged if it does not contain the key. For bag-like \ACs (i.e., those that allow multiple bindings with the same key), it is unspecified which binding will be removed by \cd{delete}. \spec{deleteSeq \is Sequence seq \Arrow seq k \arrow m k a \arrow m k a} Delete a single occurrence of each of the given keys from an \AC, ignoring those keys that do not appear in the \AC. For bag-like \ACs, there may be multiple bindings with a given key, in which case it is unspecified which is deleted. \end{description} \subsection{Observers} \begin{description} \spec{null \is m k a \arrow Bool} Test whether the \AC is empty. \axioms{null m \Equiv (size m == 0)} \spec{size \is m k a \arrow Int} Return the number of bindings in the \AC. \spec{member \is m k a \arrow k \arrow Bool} Test whether the given key is bound in the \AC. \axioms{member m k \Equiv (count xs k > 0)} \spec{count \is m k a \arrow k \arrow Int} Return the number of bindings with the given key. \spec{lookup \is m k a \arrow k \arrow a \\ lookupM \is m k a \arrow k \arrow Maybe a \\ lookupAll \is Sequence seq \Arrow m k a \arrow k \arrow seq a \\ lookupWithDefault \is a \arrow m k a \arrow k \arrow a} Find the element associated with the given given. \cd{lookup} signals an error if the key is not bound, while \cd{lookupWithDefault} returns a default value (provided as its first argument). If there is more than one binding with the given key, it is unspecified which element is chosen by \cd{lookup}, \cd{lookupM}, or \cd{lookupWithDefault}. \cd{lookupAll} returns all elements bound to the given key, but in an unspecified order. \spec{elements \is Sequence seq \Arrow m k a \arrow seq a} Return all elements in the given \AC, in an unspecified order. \end{description} \subsection{Modifiers} \begin{description} \spec{adjust \is (a \arrow a) \arrow k \arrow m k a \arrow m k a \\ adjustAll \is (a \arrow a) \arrow k \arrow m k a \arrow m k a} Change a single binding or all bindings for the given key by applying a function to its element(s). If more than one binding has the same key, it is unspecified which is modified by \cd{adjust}. \end{description} \subsection{Maps and folds} \begin{description} \spec{map \is (a \arrow b) \arrow m k a \arrow m k b} Apply a function to the elements of every binding in an \AC. This method appears both in \cd{AssocX} and in \cd{Functor}. \spec{fold \is (a \arrow b \arrow b) \arrow b \arrow m k a \arrow b} Combine all the elements in an \AC, given a combining function and an initial value. The elements are processed in an unspecified order. Note that \cd{fold} ignores the keys. \spec{fold1 \is (a \arrow a \arrow a) \arrow m k a \arrow a} Combine all the elements in a non-empty \AC using the given combining function. Signals an error if the \AC is empty. The elements are processed in an unspecified order. An implementation may choose to process the elements linearly or in a balanced fashion (like \cd{reduce1} on sequences). Note that \cd{fold1} ignores the keys. \end{description} \subsection{Filters and partitions} \begin{description} \spec{filter \is (a \arrow Bool) \arrow m k a \arrow m k a} Extract all the bindings whose elements satisfy the given predicate. \spec{partition \is (a \arrow Bool) \arrow m k a \arrow (m k a, m k a)} Split an \AC into those bindings whose elements satisfy the given predicate, and those bindings whose elements do not satisfy the predicate. \end{description} \section{\cd{OrdAssocX}} \begin{verbatim} class (AssocX m k, Ord k) => OrdAssocX m k \end{verbatim} \subsection{Constructors} \begin{description} \spec{unsafeInsertMin \is k \arrow a \arrow m k a \arrow m k a \\ unsafeInsertMax \is m k a \arrow k \arrow a \arrow m k a} Insert a binding into an \AC with the precondition that the given key is $\leq$ or $\geq$ any exisiting keys. For finite maps, this precondition is strengthened to $<$ or $>$. \spec{unsafeFromOrdSeq \is Sequence seq \arrow seq (k,a) \arrow m k a} Convert a sequence of bindings into an \AC with the precondition that the sequence is sorted into non-decreasing order by key. For finite maps, this precondition is strengthened to increasing order. \spec{unsafeAppend \is m k a \arrow m k a \arrow m k a} Merge two \ACs with the precondition that every key in the first \AC is $\leq$ every key in the second \AC. For finite maps, this precondition is strengthened to $<$. \end{description} \subsection{Destructors} \begin{description} \spec{minView \is m k a \arrow Maybe2 a (m k a) \\ maxView \is m k a \arrow Maybe2 (m k a) a} Remove the binding with the minimum or maximum key, and return its element together with the remaining \AC. Return \cd{Nothing2} if the \AC is empty. Which binding is removed if there is more than one minimum or maximum is unspecified. See also \cd{minViewWithKey} and \cd{maxViewWithKey} in \cd{OrdAssoc}. \spec{minElem \is m k a \arrow a \\ maxElem \is m k a \arrow a} Return the element associated with the minimum or maximum key, or signal an error if the \AC is empty. Which element is chosen if there is more than one minimum or maximum is unspecified. See also \cd{minElemWithKey} and \cd{maxElemWithKey} in \cd{OrdAssoc}. \end{description} \subsection{Deletions} \begin{description} \spec{deleteMin \is m k a \arrow m k a \\ deleteMax \is m k a \arrow m k a} Delete the binding with the minimum or maximum key, or return \cd{empty} if the \AC is already empty. Which binding is chosen if there is more than one minimum or maximum is unspecified. \end{description} \subsection{Maps and Folds} \begin{description} \spec{foldr \is (a \arrow b \arrow b) \arrow b \arrow m k a \arrow b \\ foldl \is (b \arrow a \arrow b) \arrow b \arrow m k a \arrow b} Fold across the elements in non-decreasing order by key. \spec{foldr1 \is (a \arrow a \arrow a) \arrow m k a \arrow a \\ foldl1 \is (a \arrow a \arrow a) \arrow m k a \arrow a} Fold across the elements in non-decreasing order by key, or signal an error if the \AC is empty. \end{description} \subsection{Filters and partitions} \begin{description} \spec{filterLT \\ filterLE \\ filterGT \\ filterGE} \spec{partitionLT\_GE \\ partitionLE\_GT \\ partitionLT\_GT} \end{description} \section{\cd{FiniteMapX}} \begin{verbatim} class AssocX m k => FiniteMapX m k \end{verbatim} \subsection{Constructors} \begin{description} \spec{insertWith \\ insertSeqWith} \spec{insertWithKey \\ insertSeqWithKey} \spec{unionl \\ unionr} \spec{unionWith \\ unionSeqWith} \spec{fromSeqWith \\ fromSeqWithKey} \end{description} \subsection{Set-like operations} \begin{description} \spec{intersectWith} \spec{difference} \spec{subset} \spec{subsetEq} \end{description} \section{\cd{OrdFiniteMapX}} \begin{verbatim} class (OrdAssocX m k, FiniteMapX m k) => OrdFiniteMapX m k \end{verbatim} % This class contains no methods. It exists only as an abbreviation for the context \begin{center} \cd{(OrdAssocX m k, FiniteMapX m k)} \end{center} \section{\cd{Assoc}} \begin{verbatim} class AssocX m k => Assoc m k \end{verbatim} \subsection{Observers} \begin{description} \spec{toSeq} \spec{keys} \end{description} \subsection{Maps and folds} \begin{description} \spec{mapWithKey} \spec{foldWithKey} \end{description} \subsection{Filters and partitions} \begin{description} \spec{filterWithKey} \spec{partitionWithKey} \end{description} \section{\cd{OrdAssoc}} \begin{verbatim} class (Assoc m k, OrdAssocX m k) => OrdAssoc m k \end{verbatim} \subsection{Destructors} \begin{description} \spec{minViewWithKey} \spec{minElemWithKey} \spec{maxViewWithKey} \spec{maxElemWithKey} \end{description} \subsection{Observers} \begin{description} \spec{toOrdSeq} \end{description} \subsection{Maps and folds} \begin{description} \spec{foldrWithKey \\ foldlWithKey} \end{description} \section{\cd{FiniteMap}} \begin{verbatim} class (Assoc m k, FiniteMapX m k) => FiniteMap m k \end{verbatim} \subsection{Constructors} \begin{description} \spec{unionWithKey \\ unionSeqWithKey} \end{description} \subsection{Set-like operations} \begin{description} \spec{intersectWithKey} \end{description} \section{\cd{OrdFiniteMap}} \begin{verbatim} class (OrdAssoc m k, FiniteMap m k) => OrdFiniteMap m k \end{verbatim} % This class contains no methods. It exists only as an abbreviation for the context \begin{center} \cd{(OrdAssoc m k, FiniteMap m k)} \end{center} \end{document} hugs98-plus-Sep2006/fptools/hslibs/hssource/0000755006511100651110000000000010504340142017561 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/hssource/HsLexer.hs0000644006511100651110000000023010127370675021501 0ustar rossrossmodule HsLexer {-# DEPRECATED "This module has moved to Language.Haskell.Lexer" #-} (module Language.Haskell.Lexer) where import Language.Haskell.Lexer hugs98-plus-Sep2006/fptools/hslibs/hssource/HsParseMonad.hs0000644006511100651110000000025410127370675022461 0ustar rossrossmodule HsParseMonad {-# DEPRECATED "This module has moved to Language.Haskell.ParseMonad" #-} (module Language.Haskell.ParseMonad) where import Language.Haskell.ParseMonad hugs98-plus-Sep2006/fptools/hslibs/hssource/HsParseUtils.hs0000644006511100651110000000025410127370675022523 0ustar rossrossmodule HsParseUtils {-# DEPRECATED "This module has moved to Language.Haskell.ParseUtils" #-} (module Language.Haskell.ParseUtils) where import Language.Haskell.ParseUtils hugs98-plus-Sep2006/fptools/hslibs/hssource/HsParser.hs0000644006511100651110000000023410127370675021662 0ustar rossrossmodule HsParser {-# DEPRECATED "This module has moved to Language.Haskell.Parser" #-} (module Language.Haskell.Parser) where import Language.Haskell.Parser hugs98-plus-Sep2006/fptools/hslibs/hssource/HsPretty.hs0000644006511100651110000000023410127370675021715 0ustar rossrossmodule HsPretty {-# DEPRECATED "This module has moved to Language.Haskell.Pretty" #-} (module Language.Haskell.Pretty) where import Language.Haskell.Pretty hugs98-plus-Sep2006/fptools/hslibs/hssource/HsSyn.hs0000644006511100651110000000023110127370676021175 0ustar rossrossmodule HsSyn {-# DEPRECATED "This module has moved to Language.Haskell.Syntax" #-} (module Language.Haskell.Syntax) where import Language.Haskell.Syntax hugs98-plus-Sep2006/fptools/hslibs/hssource/Makefile0000644006511100651110000000027710151654047021241 0ustar rossross# $Id: Makefile,v 1.13 2004/11/26 16:21:59 simonmar Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk PACKAGE = hssource VERSION = 1.0 PACKAGE_DEPS = haskell-src include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/hssource/package.conf.in0000644006511100651110000000127410205402177022441 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: False exposed-modules: HsLexer, HsParseMonad, HsParseUtils, HsParser, HsPretty, HsSyn hidden-modules: #ifdef INSTALLING import-dirs: PKG_LIBDIR"/hslibs-imports/hssource" #else import-dirs: FPTOOLS_TOP_ABS"/hslibs/hssource" #endif #ifdef INSTALLING library-dirs: PKG_LIBDIR #else library-dirs: FPTOOLS_TOP_ABS"/hslibs/hssource" #endif hs-libraries: "HShssource" extra-libraries: include-dirs: includes: depends: base, haskell-src hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: haddock-html: hugs98-plus-Sep2006/fptools/hslibs/lang/0000755006511100651110000000000010504340142016647 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/lang/cbits/0000755006511100651110000000000010504340142017753 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/lang/cbits/HsLang.h0000644006511100651110000000126607363740066021327 0ustar rossross/* ----------------------------------------------------------------------------- * $Id: HsLang.h,v 1.4 2001/10/19 05:55:02 sof Exp $ * * Definitions for package `lang' which are visible in Haskell land. * * ---------------------------------------------------------------------------*/ #ifndef HSLANG_H #define HSLANG_H /* PackedString.c */ extern StgInt byteArrayHasNUL__ (StgByteArray ba, StgInt len); /* rawSystem.c */ extern HsInt rawSystemCmd(HsAddr cmd); /* envHelper.c */ extern HsAddr getEnvBlock(); /* copyFile.c */ extern HsInt primCopyFile(char* from, char* to); #ifdef _WIN32 extern HsAddr primGetLastErrorString(); extern void primLocalFree(HsAddr ptr); #endif #endif hugs98-plus-Sep2006/fptools/hslibs/lang/cbits/Makefile0000644006511100651110000000060110145141505021413 0ustar rossross# $Id: Makefile,v 1.14 2004/11/12 14:05:57 simonmar Exp $ TOP = ../.. include $(TOP)/mk/boilerplate.mk SRC_CC_OPTS += -Wall -DCOMPILING_STDLIB SRC_CC_OPTS += -I$(GHC_INCLUDE_DIR) -I$(GHC_RUNTIME_DIR) \ -I$(FPTOOLS_TOP)/libraries/base/include LIBRARY = libHSlang_cbits.a LIBOBJS = $(C_OBJS) includedir = $(libdir)/include INSTALL_INCLUDES = HsLang.h include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/lang/cbits/PackedString.c0000644006511100651110000000077307575665044022535 0ustar rossross/* ----------------------------------------------------------------------------- * $Id: PackedString.c,v 1.3 2002/12/11 16:39:00 simonmar Exp $ * * PackedString C bits * * (c) The GHC Team 1998 * -------------------------------------------------------------------------- */ #include "HsFFI.h" #include "HsLang.h" HsInt byteArrayHasNUL__ (char *ba, HsInt len) { HsInt i; for (i = 0; i < len; i++) { if (*(ba + i) == '\0') { return(1); /* true */ } } return(0); /* false */ } hugs98-plus-Sep2006/fptools/hslibs/lang/cbits/envHelper.c0000644006511100651110000000046307432231013022054 0ustar rossross/* * (c) The University of Glasgow 2002 * * environment operations */ #include "HsBase.h" #include "HsLang.h" #include /* ToDo: write a feature test that doesn't assume 'environ' to be in scope at link-time. */ extern char** environ; HsAddr getEnvBlock() { return (HsAddr)environ; } hugs98-plus-Sep2006/fptools/hslibs/lang/Addr.lhs0000644006511100651110000003173310176376673020267 0ustar rossross% % (c) The AQUA Project, Glasgow University, 1994-2000 % \section[Addr]{Module @Addr@} \begin{code} {-# OPTIONS -monly-3-regs #-} #include "MachDeps.h" module Addr {-# DEPRECATED "This library will go away soon; use Foreign.Ptr instead" #-} ( Addr(..) -- abstract, instance of Eq, Ord, Show, Typeable , nullAddr -- :: Addr , alignAddr -- :: Addr -> Int -> Addr , plusAddr -- :: Addr -> Int -> Addr , minusAddr -- :: Addr -> Addr -> Int -- SUP: deprecated in the new FFI, index/read/write???OffAddr are -- subsumed by the Storable class -- NOTE: The functions for ForeignObj, StablePtr, and Word have -- officially never been part of this module. , indexCharOffAddr -- :: Addr -> Int -> Char , indexIntOffAddr -- :: Addr -> Int -> Int , indexAddrOffAddr -- :: Addr -> Int -> Addr , indexFloatOffAddr -- :: Addr -> Int -> Float , indexDoubleOffAddr -- :: Addr -> Int -> Double , indexWord8OffAddr -- :: Addr -> Int -> Word8 , indexWord16OffAddr -- :: Addr -> Int -> Word16 , indexWord32OffAddr -- :: Addr -> Int -> Word32 , indexWord64OffAddr -- :: Addr -> Int -> Word64 , indexInt8OffAddr -- :: Addr -> Int -> Int8 , indexInt16OffAddr -- :: Addr -> Int -> Int16 , indexInt32OffAddr -- :: Addr -> Int -> Int32 , indexInt64OffAddr -- :: Addr -> Int -> Int64 , indexStablePtrOffAddr -- :: Addr -> Int -> StablePtr a , indexWordOffAddr -- :: Addr -> Int -> Word , readCharOffAddr -- :: Addr -> Int -> IO Char , readIntOffAddr -- :: Addr -> Int -> IO Int , readAddrOffAddr -- :: Addr -> Int -> IO Addr , readFloatOffAddr -- :: Addr -> Int -> IO Float , readDoubleOffAddr -- :: Addr -> Int -> IO Double , readWord8OffAddr -- :: Addr -> Int -> IO Word8 , readWord16OffAddr -- :: Addr -> Int -> IO Word16 , readWord32OffAddr -- :: Addr -> Int -> IO Word32 , readWord64OffAddr -- :: Addr -> Int -> IO Word64 , readInt8OffAddr -- :: Addr -> Int -> IO Int8 , readInt16OffAddr -- :: Addr -> Int -> IO Int16 , readInt32OffAddr -- :: Addr -> Int -> IO Int32 , readInt64OffAddr -- :: Addr -> Int -> IO Int64 , readStablePtrOffAddr -- :: Addr -> Int -> IO (StablePtr a) , readWordOffAddr -- :: Addr -> Int -> IO Word , writeCharOffAddr -- :: Addr -> Int -> Char -> IO () , writeIntOffAddr -- :: Addr -> Int -> Int -> IO () , writeAddrOffAddr -- :: Addr -> Int -> Addr -> IO () , writeFloatOffAddr -- :: Addr -> Int -> Float -> IO () , writeDoubleOffAddr -- :: Addr -> Int -> Double -> IO () , writeWord8OffAddr -- :: Addr -> Int -> Word8 -> IO () , writeWord16OffAddr -- :: Addr -> Int -> Word16 -> IO () , writeWord32OffAddr -- :: Addr -> Int -> Word32 -> IO () , writeWord64OffAddr -- :: Addr -> Int -> Word64 -> IO () , writeInt8OffAddr -- :: Addr -> Int -> Int8 -> IO () , writeInt16OffAddr -- :: Addr -> Int -> Int16 -> IO () , writeInt32OffAddr -- :: Addr -> Int -> Int32 -> IO () , writeInt64OffAddr -- :: Addr -> Int -> Int64 -> IO () , writeStablePtrOffAddr -- :: Addr -> Int -> StablePtr a -> IO () #ifndef __PARALLEL_HASKELL__ -- ForeignObj imports lots of stuff from Addr, so it makes -- a horrible module loop to export writeForeignObjOffAddr here -- Just import ForeignObj if you want it -- , writeForeignObjOffAddr -- :: Addr -> Int -> ForeignObj -> IO () #endif , writeWordOffAddr -- :: Addr -> Int -> Word -> IO () -- deprecated (non-standard) coercions #if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64) , addrToInt -- :: Addr -> Int , intToAddr -- :: Int -> Addr #endif , Word(..) , wordToInt -- :: Word -> Int , intToWord -- :: Int -> Word , addrToPtr -- :: Addr -> Ptr a , ptrToAddr -- :: Ptr a -> Addr ) where import GHC.Ptr ( Ptr(..) ) import Numeric ( showHex ) import Foreign import GHC.Int import GHC.Word import GHC.Float ( Float(..), Double(..) ) import GHC.Stable ( StablePtr(..) ) import GHC.Base import GHC.IOBase ( IO(..) ) import GHC.Num ( Integer(J#) ) \end{code} \begin{code} data Addr = A# Addr# deriving (Eq, Ord) nullAddr :: Addr nullAddr = A# nullAddr# alignAddr :: Addr -> Int -> Addr alignAddr addr@(A# a) (I# i) = case remAddr# a i of { 0# -> addr; n -> A# (plusAddr# a (i -# n)) } plusAddr :: Addr -> Int -> Addr plusAddr (A# addr) (I# off) = A# (plusAddr# addr off) minusAddr :: Addr -> Addr -> Int minusAddr (A# a1) (A# a2) = I# (minusAddr# a1 a2) #if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64) instance Show Addr where showsPrec p (A# addr) rs = pad_out (showHex (word2Integer(int2Word#(addr2Int# addr))) "") rs where -- want 0s prefixed to pad it out to a fixed length. pad_out ls rs = '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs -- word2Integer :: Word# -> Integer (stolen from Word.lhs) word2Integer w = case word2Integer# w of (# s, d #) -> J# s d #endif instance Storable Addr where sizeOf _ = SIZEOF_HSPTR alignment _ = ALIGNMENT_HSPTR peekElemOff (Ptr a) i = readAddrOffAddr (A# a) i pokeElemOff (Ptr a) i x = writeAddrOffAddr (A# a) i x indexAddrOffAddr :: Addr -> Int -> Addr indexAddrOffAddr (A# addr#) n = case n of { I# n# -> case indexAddrOffAddr# addr# n# of { r# -> (A# r#)}} \end{code} Word Type \begin{code} {-# DEPRECATED wordToInt "use fromIntegral instead" #-} wordToInt :: Word -> Int wordToInt (W# w#) = I# (word2Int# w#) {-# DEPRECATED intToWord "use fromIntegral instead" #-} intToWord :: Int -> Word intToWord (I# i#) = W# (int2Word# i#) \end{code} Coercing between machine ints and Addrs (deprecated) \begin{code} addrToInt :: Addr -> Int intToAddr :: Int -> Addr #if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64) addrToInt (A# a#) = I# (addr2Int# a#) intToAddr (I# i#) = A# (int2Addr# i#) #endif \end{code} @Addr@ is still around, accommodate conversions to/from Ptrs. \begin{code} addrToPtr :: Addr -> Ptr a addrToPtr (A# a) = Ptr a ptrToAddr :: Ptr a -> Addr ptrToAddr (Ptr x) = A# x \end{code} Indexing immutable memory: SUP: deprecated in the new FFI, subsumed by the Storable class \begin{code} indexCharOffAddr :: Addr -> Int -> Char indexIntOffAddr :: Addr -> Int -> Int indexWordOffAddr :: Addr -> Int -> Word --in PrelAddr: indexAddrOffAddr :: Addr -> Int -> Addr indexFloatOffAddr :: Addr -> Int -> Float indexDoubleOffAddr :: Addr -> Int -> Double indexStablePtrOffAddr :: Addr -> Int -> StablePtr a indexInt8OffAddr :: Addr -> Int -> Int8 indexInt16OffAddr :: Addr -> Int -> Int16 indexInt32OffAddr :: Addr -> Int -> Int32 indexInt64OffAddr :: Addr -> Int -> Int64 indexWord8OffAddr :: Addr -> Int -> Word8 indexWord16OffAddr :: Addr -> Int -> Word16 indexWord32OffAddr :: Addr -> Int -> Word32 indexWord64OffAddr :: Addr -> Int -> Word64 indexCharOffAddr (A# addr#) (I# n#) = C# (indexCharOffAddr# addr# n#) indexIntOffAddr (A# addr#) (I# n#) = I# (indexIntOffAddr# addr# n#) indexWordOffAddr (A# addr#) (I# n#) = W# (indexWordOffAddr# addr# n#) indexFloatOffAddr (A# addr#) (I# n#) = F# (indexFloatOffAddr# addr# n#) indexDoubleOffAddr (A# addr#) (I# n#) = D# (indexDoubleOffAddr# addr# n#) indexStablePtrOffAddr (A# addr#) (I# n#) = StablePtr (indexStablePtrOffAddr# addr# n#) indexInt8OffAddr (A# a#) (I# i#) = I8# (indexInt8OffAddr# a# i#) indexInt16OffAddr (A# a#) (I# i#) = I16# (indexInt16OffAddr# a# i#) indexInt32OffAddr (A# a#) (I# i#) = I32# (indexInt32OffAddr# a# i#) indexInt64OffAddr (A# a#) (I# i#) = I64# (indexInt64OffAddr# a# i#) indexWord8OffAddr (A# a#) (I# i#) = W8# (indexWord8OffAddr# a# i#) indexWord16OffAddr (A# a#) (I# i#) = W16# (indexWord16OffAddr# a# i#) indexWord32OffAddr (A# a#) (I# i#) = W32# (indexWord32OffAddr# a# i#) indexWord64OffAddr (A# a#) (I# i#) = W64# (indexWord64OffAddr# a# i#) \end{code} Indexing mutable memory: SUP: deprecated in the new FFI, subsumed by the Storable class \begin{code} readCharOffAddr :: Addr -> Int -> IO Char readIntOffAddr :: Addr -> Int -> IO Int readWordOffAddr :: Addr -> Int -> IO Word readAddrOffAddr :: Addr -> Int -> IO Addr readFloatOffAddr :: Addr -> Int -> IO Float readDoubleOffAddr :: Addr -> Int -> IO Double readStablePtrOffAddr :: Addr -> Int -> IO (StablePtr a) readInt8OffAddr :: Addr -> Int -> IO Int8 readInt16OffAddr :: Addr -> Int -> IO Int16 readInt32OffAddr :: Addr -> Int -> IO Int32 readInt64OffAddr :: Addr -> Int -> IO Int64 readWord8OffAddr :: Addr -> Int -> IO Word8 readWord16OffAddr :: Addr -> Int -> IO Word16 readWord32OffAddr :: Addr -> Int -> IO Word32 readWord64OffAddr :: Addr -> Int -> IO Word64 readCharOffAddr (A# a) (I# i) = IO $ \s -> case readCharOffAddr# a i s of { (# s,x #) -> (# s, C# x #) } readIntOffAddr (A# a) (I# i) = IO $ \s -> case readIntOffAddr# a i s of { (# s,x #) -> (# s, I# x #) } readWordOffAddr (A# a) (I# i) = IO $ \s -> case readWordOffAddr# a i s of { (# s,x #) -> (# s, W# x #) } readAddrOffAddr (A# a) (I# i) = IO $ \s -> case readAddrOffAddr# a i s of { (# s,x #) -> (# s, A# x #) } readFloatOffAddr (A# a) (I# i) = IO $ \s -> case readFloatOffAddr# a i s of { (# s,x #) -> (# s, F# x #) } readDoubleOffAddr (A# a) (I# i) = IO $ \s -> case readDoubleOffAddr# a i s of { (# s,x #) -> (# s, D# x #) } readStablePtrOffAddr (A# a) (I# i) = IO $ \s -> case readStablePtrOffAddr# a i s of { (# s,x #) -> (# s, StablePtr x #) } readInt8OffAddr (A# a) (I# i) = IO $ \s -> case readInt8OffAddr# a i s of (# s, w #) -> (# s, I8# w #) readInt16OffAddr (A# a) (I# i) = IO $ \s -> case readInt16OffAddr# a i s of (# s, w #) -> (# s, I16# w #) readInt32OffAddr (A# a) (I# i) = IO $ \s -> case readInt32OffAddr# a i s of (# s, w #) -> (# s, I32# w #) readInt64OffAddr (A# a) (I# i) = IO $ \s -> case readInt64OffAddr# a i s of (# s, w #) -> (# s, I64# w #) readWord8OffAddr (A# a) (I# i) = IO $ \s -> case readWord8OffAddr# a i s of (# s, w #) -> (# s, W8# w #) readWord16OffAddr (A# a) (I# i) = IO $ \s -> case readWord16OffAddr# a i s of (# s, w #) -> (# s, W16# w #) readWord32OffAddr (A# a) (I# i) = IO $ \s -> case readWord32OffAddr# a i s of (# s, w #) -> (# s, W32# w #) readWord64OffAddr (A# a) (I# i) = IO $ \s -> case readWord64OffAddr# a i s of (# s, w #) -> (# s, W64# w #) \end{code} SUP: deprecated in the new FFI, subsumed by the Storable class \begin{code} writeCharOffAddr :: Addr -> Int -> Char -> IO () writeIntOffAddr :: Addr -> Int -> Int -> IO () writeWordOffAddr :: Addr -> Int -> Word -> IO () writeAddrOffAddr :: Addr -> Int -> Addr -> IO () writeFloatOffAddr :: Addr -> Int -> Float -> IO () writeDoubleOffAddr :: Addr -> Int -> Double -> IO () writeStablePtrOffAddr :: Addr -> Int -> StablePtr a -> IO () writeInt8OffAddr :: Addr -> Int -> Int8 -> IO () writeInt16OffAddr :: Addr -> Int -> Int16 -> IO () writeInt32OffAddr :: Addr -> Int -> Int32 -> IO () writeInt64OffAddr :: Addr -> Int -> Int64 -> IO () writeWord8OffAddr :: Addr -> Int -> Word8 -> IO () writeWord16OffAddr :: Addr -> Int -> Word16 -> IO () writeWord32OffAddr :: Addr -> Int -> Word32 -> IO () writeWord64OffAddr :: Addr -> Int -> Word64 -> IO () writeCharOffAddr (A# a#) (I# i#) (C# c#) = IO $ \ s# -> case (writeCharOffAddr# a# i# c# s#) of s2# -> (# s2#, () #) writeIntOffAddr (A# a#) (I# i#) (I# e#) = IO $ \ s# -> case (writeIntOffAddr# a# i# e# s#) of s2# -> (# s2#, () #) writeWordOffAddr (A# a#) (I# i#) (W# e#) = IO $ \ s# -> case (writeWordOffAddr# a# i# e# s#) of s2# -> (# s2#, () #) writeAddrOffAddr (A# a#) (I# i#) (A# e#) = IO $ \ s# -> case (writeAddrOffAddr# a# i# e# s#) of s2# -> (# s2#, () #) writeFloatOffAddr (A# a#) (I# i#) (F# e#) = IO $ \ s# -> case (writeFloatOffAddr# a# i# e# s#) of s2# -> (# s2#, () #) writeDoubleOffAddr (A# a#) (I# i#) (D# e#) = IO $ \ s# -> case (writeDoubleOffAddr# a# i# e# s#) of s2# -> (# s2#, () #) writeStablePtrOffAddr (A# a#) (I# i#) (StablePtr e#) = IO $ \ s# -> case (writeStablePtrOffAddr# a# i# e# s#) of s2# -> (# s2# , () #) writeInt8OffAddr (A# a#) (I# i#) (I8# w#) = IO $ \ s# -> case (writeInt8OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) writeInt16OffAddr (A# a#) (I# i#) (I16# w#) = IO $ \ s# -> case (writeInt16OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) writeInt32OffAddr (A# a#) (I# i#) (I32# w#) = IO $ \ s# -> case (writeInt32OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) writeInt64OffAddr (A# a#) (I# i#) (I64# w#) = IO $ \ s# -> case (writeInt64OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) writeWord8OffAddr (A# a#) (I# i#) (W8# w#) = IO $ \ s# -> case (writeWord8OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) writeWord16OffAddr (A# a#) (I# i#) (W16# w#) = IO $ \ s# -> case (writeWord16OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) writeWord32OffAddr (A# a#) (I# i#) (W32# w#) = IO $ \ s# -> case (writeWord32OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) writeWord64OffAddr (A# a#) (I# i#) (W64# w#) = IO $ \ s# -> case (writeWord64OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/ArrayBase.hs0000644006511100651110000000020510127370676021071 0ustar rossrossmodule ArrayBase {-# DEPRECATED "This module has moved to Data.Array.Base" #-} (module Data.Array.Base) where import Data.Array.Base hugs98-plus-Sep2006/fptools/hslibs/lang/Arrow.hs0000644006511100651110000000022310053156772020307 0ustar rossrossmodule Arrow {-# DEPRECATED "This library will go away soon; use Control.Arrow instead" #-} (module Control.Arrow) where import Control.Arrow hugs98-plus-Sep2006/fptools/hslibs/lang/ByteArray.lhs0000644006511100651110000000617310053156772021305 0ustar rossross% % (c) The AQUA Project, Glasgow University, 1994-1997 % \section[ByteArray]{The @ByteArray@ interface} Immutable, read-only chunks of bytes, the @ByteArray@ collects together the definitions in @PrelArr@ & @PrelByteArr@ and exports them as one. \begin{code} module ByteArray {-# DEPRECATED "This library will go away soon; use Data.Array.Unboxed instead" #-} ( -- This module is DEPRECATED. Use IArray instead. ByteArray(..), -- not abstract, for now. Instance of : CCallable, Eq. Ix, newByteArray, -- :: Ix ix => (ix,ix) -> ST s (ByteArray ix) --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here. indexCharArray, -- :: Ix ix => ByteArray ix -> ix -> Char indexIntArray, -- :: Ix ix => ByteArray ix -> ix -> Int indexWordArray, -- :: Ix ix => ByteArray ix -> ix -> Word indexAddrArray, -- :: Ix ix => ByteArray ix -> ix -> Addr indexFloatArray, -- :: Ix ix => ByteArray ix -> ix -> Float indexDoubleArray, -- :: Ix ix => ByteArray ix -> ix -> Double indexStablePtrArray, -- :: Ix ix => ByteArray ix -> ix -> (StablePtr a) sizeofByteArray, -- :: Ix ix => ByteArray ix -> Int boundsOfByteArray -- :: Ix ix => ByteArray ix -> (ix, ix) ) where import PrelByteArr import Addr import GHC.Word import GHC.Arr import GHC.Base import GHC.Stable( StablePtr(..) ) import GHC.ST import Data.Ix \end{code} \begin{code} indexStablePtrArray :: Ix ix => ByteArray ix -> ix -> (StablePtr a) indexStablePtrArray (ByteArray l u barr#) n = case (index (l,u) n) of { I# n# -> case indexStablePtrArray# barr# n# of { r# -> (StablePtr r#)}} \end{code} The size returned is in bytes. \begin{code} sizeofByteArray :: Ix ix => ByteArray ix -> Int sizeofByteArray (ByteArray _ _ arr#) = case (sizeofByteArray# arr#) of i# -> (I# i#) boundsOfByteArray :: Ix ix => ByteArray ix -> (ix, ix) boundsOfByteArray (ByteArray l u _) = (l,u) \end{code} \begin{code} newByteArray :: Ix ix => (ix,ix) -> ST s (ByteArray ix) newByteArray ixs = do m_arr <- newCharArray ixs unsafeFreezeByteArray m_arr \end{code} If it should turn out to be an issue, could probably be speeded up quite a bit. \begin{code} instance Ix ix => Eq (ByteArray ix) where b1 == b2 = eqByteArray b1 b2 eqByteArray :: Ix ix => ByteArray ix -> ByteArray ix -> Bool eqByteArray b1 b2 = sizeofByteArray b1 == sizeofByteArray b2 && all (\ x -> indexCharArray b1 x == indexCharArray b2 x) (range (boundsOfByteArray b1)) \end{code} \begin{code} indexAddrArray :: Ix ix => ByteArray ix -> ix -> Addr indexWordArray :: Ix ix => ByteArray ix -> ix -> Word {-# SPECIALIZE indexAddrArray :: ByteArray Int -> Int -> Addr #-} {-# SPECIALIZE indexWordArray :: ByteArray Int -> Int -> Word #-} indexAddrArray (ByteArray l u barr#) n = case (index (l,u) n) of { I# n# -> case indexAddrArray# barr# n# of { r# -> (A# r#)}} indexWordArray (ByteArray l u barr#) n = case (index (l,u) n) of { I# n# -> case indexWordArray# barr# n# of { r# -> (W# r#)}} \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/CTypesISO.hs0000644006511100651110000000064410053156773021007 0ustar rossrossmodule CTypesISO {-# DEPRECATED "This library will go away soon; use Foreign.C.Types instead" #-} (module Foreign.C.Types) where import Foreign.C.Types #ifndef __NHC__ ( CPtrdiff, CSize, CWchar, CSigAtomic , CClock, CTime ) #else -- For nhc98, these are exported non-abstractly to work around -- an interface-file problem. ( CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..), CClock(..), CTime(..) #endif hugs98-plus-Sep2006/fptools/hslibs/lang/DiffArray.hs0000644006511100651110000000021210053156773021063 0ustar rossrossmodule DiffArray {-# DEPRECATED "This module has moved to Data.Array.Diff" #-} (module Data.Array.Diff) where import Data.Array.Diff hugs98-plus-Sep2006/fptools/hslibs/lang/DirectoryExts.hs0000644006511100651110000000023310130461771022020 0ustar rossrossmodule DirectoryExts {-# DEPRECATED "Use System.Directory instead" #-} ( copyFile -- :: FilePath -> FilePath -> IO () ) where import System.Directory hugs98-plus-Sep2006/fptools/hslibs/lang/Dynamic.hs0000644006511100651110000000020110053156773020576 0ustar rossrossmodule Dynamic {-# DEPRECATED "This library has moved to Data.Dynamic" #-} (module Data.Dynamic) where import Data.Dynamic hugs98-plus-Sep2006/fptools/hslibs/lang/Exception.hs0000644006511100651110000000022110053156773021152 0ustar rossrossmodule Exception {-# DEPRECATED "This library has moved to Control.Exception" #-} (module Control.Exception) where import Control.Exception hugs98-plus-Sep2006/fptools/hslibs/lang/Generics.hs0000644006511100651110000000020410053156773020754 0ustar rossrossmodule Generics {-# DEPRECATED "This library has moved to Data.Generics" #-} (module Data.Generics) where import Data.Generics hugs98-plus-Sep2006/fptools/hslibs/lang/GlaExts.lhs0000644006511100651110000000464710053156773020757 0ustar rossross% % (c) The AQUA Project, Glasgow University, 1994-1996 % \section[GlaExts]{The @GlaExts@ interface} Compatibility cruft: Deprecated! Don't use! This rug will dissappear from underneath your feet very soon. This module will eventually be the interface to GHC-ONLY extensions: i.e. unboxery and primitive operations over unboxed values. OLD: The @GlaExts@ packages up various Glasgow extensions and exports them all through one interface. The Idea being that a Haskell program using a Glasgow extension doesn't have to selective import of obscure/likely-to-move (believe me, we really like to move functions around for the prelude bits!) GHC interfaces - instead import the GlaExts rag bag and you should be away! \begin{code} module GlaExts {-# DEPRECATED "This library will go away soon; use GHC.Exts instead" #-} ( unsafePerformIO, unsafeInterleaveIO, -- operations for interfacing IO and ST -- stToIO, -- :: ST RealWorld a -> IO a ioToST, -- :: IO a -> ST RealWorld a -- Everything from module ByteArray: module ByteArray, -- Same for Mutable(Byte)Array interface: module MutableArray, -- the representation of some basic types: Int(..),Addr(..),Word(..),Float(..),Double(..),Integer(..),Char(..), -- Fusion build, augment, -- misc bits trace, -- shifty wrappers from PrelBase shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#, -- and finally, all the unboxed primops of GHC.Prim! module GHC.Prim ) where import GHC.Prim import GHC.Base import GHC.Word import GHC.Num ( Integer(..) ) import GHC.Float( Float(..), Double(..) ) import IOExts import GHC.IOBase import ByteArray import MutableArray hiding ( Ix ) import Addr import Control.Monad import Debug.Trace ( trace ) type PrimIO a = IO a primIOToIO :: PrimIO a -> IO a primIOToIO io = io ioToPrimIO :: IO a -> PrimIO a ioToPrimIO io = io unsafePerformPrimIO :: PrimIO a -> a unsafePerformPrimIO = unsafePerformIO thenPrimIO :: PrimIO a -> (a -> PrimIO b) -> PrimIO b thenPrimIO = (>>=) seqPrimIO :: PrimIO a -> PrimIO b -> PrimIO b seqPrimIO = (>>) returnPrimIO :: a -> PrimIO a returnPrimIO = return thenIO_Prim :: PrimIO a -> (a -> IO b) -> IO b thenIO_Prim = (>>=) -- ST compatibility stubs. thenST :: ST s a -> ( a -> ST s b) -> ST s b thenST = (>>=) seqST :: ST s a -> ST s b -> ST s b seqST = (>>) returnST :: a -> ST s a returnST = return \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/IArray.hs0000644006511100651110000000021510053156773020406 0ustar rossrossmodule IArray {-# DEPRECATED "This module has moved to Data.Array.IArray" #-} (module Data.Array.IArray) where import Data.Array.IArray hugs98-plus-Sep2006/fptools/hslibs/lang/IOExts.hs0000644006511100651110000001361610176437211020376 0ustar rossrossmodule IOExts {-# DEPRECATED "This library will go away soon; see Data.Array.IO, Data.IORef, and System.IO" #-} ( module System.IO.Unsafe, IOArray, newIOArray, boundsIOArray, readIOArray, writeIOArray, freezeIOArray, thawIOArray, unsafeFreezeIOArray, unsafeThawIOArray, module Data.IORef, System.IO.fixIO, IOModeEx(..), openFileEx, hSetBinaryMode , hGetBuf -- :: Handle -> Ptr a -> Int -> IO Int , hGetBufBA -- :: Handle -> MutableByteArray RealWorld a -- -> Int -> IO Int , hPutBuf -- :: Handle -> Ptr a -> Int -> IO () , hPutBufBA -- :: Handle -> MutableByteArray RealWorld a -- -> Int -> IO () , slurpFile , trace -- :: String -> a -> a , hIsTerminalDevice -- :: Handle -> IO Bool , hSetEcho -- :: Handle -> Bool -> IO () , hGetEcho -- :: Handle -> IO Bool , performGC , hTell -- :: Handle -> IO Integer {- unsafePtrEq -- :: a -> a -> Bool freeHaskellFunctionPtr extended IOError predicates isHardwareFault -- :: IOError -> Bool isInappropriateType -- :: IOError -> Bool isInterrupted -- :: IOError -> Bool isInvalidArgument -- :: IOError -> Bool isOtherError -- :: IOError -> Bool isProtocolError -- :: IOError -> Bool isResourceVanished -- :: IOError -> Bool isSystemError -- :: IOError -> Bool isTimeExpired -- :: IOError -> Bool isUnsatisfiedConstraints -- :: IOError -> Bool isUnsupportedOperation -- :: IOError -> Bool #if defined(cygwin32_HOST_OS) || defined(mingw32_HOST_OS) isComError -- :: IOError -> Bool #endif -} ) where import GHC.IOBase import System.IO import System.IO.Unsafe import System.Mem ( performGC ) import Data.Array.IO import Data.IORef import Debug.Trace ( trace ) import Data.Array ( Array ) import GHC.Base ( RealWorld ) import GHC.IO ( slurpFile, memcpy_ba_baoff, memcpy_baoff_ba ) import GHC.Handle import MutableArray import Control.Monad ( liftM ) -- --------------------------------------------------------------------------- -- IOArray compat. unsafeThawIOArray :: Ix ix => Array ix elt -> IO (IOArray ix elt) unsafeThawIOArray = unsafeThaw unsafeFreezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt) unsafeFreezeIOArray = unsafeFreeze thawIOArray :: Ix ix => Array ix elt -> IO (IOArray ix elt) thawIOArray = thaw freezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt) freezeIOArray = freeze boundsIOArray :: Ix ix => IOArray ix elt -> (ix, ix) boundsIOArray = bounds -- --------------------------------------------------------------------------- -- hGetBufBA hGetBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int hGetBufBA handle (MutableByteArray _ _ ptr) count | count <= 0 = illegalBufferSize handle "hGetBuf" count | otherwise = wantReadableHandle "hGetBuf" handle $ \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=isStream } -> do buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref if bufferEmpty buf then readChunkBA fd isStream ptr 0 count else do let avail = w - r copied <- if (count >= avail) then do memcpy_ba_baoff ptr raw r (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return avail else do memcpy_ba_baoff ptr raw r (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return count let remaining = count - copied if remaining > 0 then do rest <- readChunkBA fd isStream ptr copied remaining return (rest + copied) else return count readChunkBA :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int readChunkBA fd is_stream ptr init_off bytes = loop init_off bytes where loop :: Int -> Int -> IO Int loop off bytes | bytes <= 0 = return (off - init_off) loop off bytes = do r <- fromIntegral `liftM` readRawBuffer "IOExts.readChunk" (fromIntegral fd) is_stream ptr (fromIntegral off) (fromIntegral bytes) if r == 0 then return (off - init_off) else loop (off + r) (bytes - r) -- ----------------------------------------------------------------------------- -- hPutBufBA hPutBufBA :: Handle -- handle to write to -> MutableByteArray RealWorld a -- buffer -> Int -- number of bytes of data in buffer -> IO () hPutBufBA handle (MutableByteArray _ _ raw) count | count <= 0 = illegalBufferSize handle "hPutBufBA" count | otherwise = do wantWritableHandle "hPutBufBA" handle $ \ handle_@Handle__{ haFD=fd, haBuffer=ref } -> do old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size } <- readIORef ref -- enough room in handle buffer? if (size - w > count) -- There's enough room in the buffer: -- just copy the data in and update bufWPtr. then do memcpy_baoff_ba old_raw w raw (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return () -- else, we have to flush else do flushed_buf <- flushWriteBuffer fd (haIsStream handle_) old_buf writeIORef ref flushed_buf let this_buf = Buffer{ bufBuf=raw, bufState=WriteBuffer, bufRPtr=0, bufWPtr=count, bufSize=count } flushWriteBuffer fd (haIsStream handle_) this_buf return () ----------------------------------------------------------------------------- -- Internal Utils illegalBufferSize :: Handle -> String -> Int -> IO a illegalBufferSize handle fn (sz :: Int) = ioException (IOError (Just handle) InvalidArgument fn ("illegal buffer size " ++ showsPrec 9 sz []) Nothing) -- ----------------------------------------------------------------------------- -- openFileEx {-# DEPRECATED openFileEx, IOModeEx "use System.IO.openBinaryFile instead" #-} data IOModeEx = BinaryMode IOMode | TextMode IOMode deriving (Eq, Read, Show) openFileEx :: FilePath -> IOModeEx -> IO Handle openFileEx path (TextMode mode) = openFile path mode openFileEx path (BinaryMode mode) = openBinaryFile path mode hugs98-plus-Sep2006/fptools/hslibs/lang/IORef.hs0000644006511100651110000000016710053156773020171 0ustar rossrossmodule IORef {-# DEPRECATED "This module has moved to Data.IORef" #-} (module Data.IORef) where import Data.IORef hugs98-plus-Sep2006/fptools/hslibs/lang/LazyST.hs0000644006511100651110000000250710053156773020413 0ustar rossrossmodule LazyST {-# DEPRECATED "This module has moved to Control.Monad.ST.Lazy" #-} ( module Control.Monad.ST.Lazy , module Data.STRef.Lazy , module LazyST , STArray ) where import Control.Monad.ST.Lazy import Data.STRef.Lazy import Data.Ix ( Ix ) import Data.Array ( Array ) import ST ( STArray ) import qualified ST newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt) readSTArray :: Ix ix => STArray s ix elt -> ix -> ST s elt writeSTArray :: Ix ix => STArray s ix elt -> ix -> elt -> ST s () boundsSTArray :: Ix ix => STArray s ix elt -> (ix, ix) thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt) freezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt) unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt) newSTArray ixs init = strictToLazyST (ST.newSTArray ixs init) readSTArray arr ix = strictToLazyST (ST.readSTArray arr ix) writeSTArray arr ix v = strictToLazyST (ST.writeSTArray arr ix v) boundsSTArray arr = ST.boundsSTArray arr thawSTArray arr = strictToLazyST (ST.thawSTArray arr) freezeSTArray arr = strictToLazyST (ST.freezeSTArray arr) unsafeFreezeSTArray arr = strictToLazyST (ST.unsafeFreezeSTArray arr) unsafeThawSTArray arr = strictToLazyST (ST.unsafeThawSTArray arr) hugs98-plus-Sep2006/fptools/hslibs/lang/MArray.hs0000644006511100651110000002516010053156773020420 0ustar rossrossmodule MArray {-# DEPRECATED "This module has moved to Data.Array.MArray" #-} ( module Data.Array.MArray, castSTUArray, -- :: STUArray s i a -> ST s (STUArray s i b) castIOUArray, -- :: IOUArray i a -> IO (IOUArray i b) -- Legacy non-overloaded byte array interface -- (CharArrays here work on bytes, not Chars!) newCharArray, -- :: Ix i => (i,i) -> ST s (STUArray s i Char) newIntArray, -- :: Ix i => (i,i) -> ST s (STUArray s i Int) newWordArray, -- :: Ix i => (i,i) -> ST s (STUArray s i Word) newAddrArray, -- :: Ix i => (i,i) -> ST s (STUArray s i Addr) newFloatArray, -- :: Ix i => (i,i) -> ST s (STUArray s i Float) newDoubleArray, -- :: Ix i => (i,i) -> ST s (STUArray s i Double) newStablePtrArray, -- :: Ix i => (i,i) -> ST s (STUArray s i (StablePtr a)) newInt8Array, -- :: Ix i => (i,i) -> ST s (STUArray s i Int8) newInt16Array, -- :: Ix i => (i,i) -> ST s (STUArray s i Int16) newInt32Array, -- :: Ix i => (i,i) -> ST s (STUArray s i Int32) newInt64Array, -- :: Ix i => (i,i) -> ST s (STUArray s i Int64) newWord8Array, -- :: Ix i => (i,i) -> ST s (STUArray s i Word8) newWord16Array, -- :: Ix i => (i,i) -> ST s (STUArray s i Word16) newWord32Array, -- :: Ix i => (i,i) -> ST s (STUArray s i Word32) newWord64Array, -- :: Ix i => (i,i) -> ST s (STUArray s i Word64) readCharArray, -- :: Ix i => STUArray s i Char -> i -> ST s Char readIntArray, -- :: Ix i => STUArray s i Int -> i -> ST s Int readWordArray, -- :: Ix i => STUArray s i Word -> i -> ST s Word readAddrArray, -- :: Ix i => STUArray s i Addr -> i -> ST s Addr readFloatArray, -- :: Ix i => STUArray s i Float -> i -> ST s Float readDoubleArray, -- :: Ix i => STUArray s i Double -> i -> ST s Double readStablePtrArray, -- :: Ix i => STUArray s i (StablePtr a) -> i -> ST s (StablePtr a) readInt8Array, -- :: Ix i => STUArray s i Int8 -> i -> ST s Int8 readInt16Array, -- :: Ix i => STUArray s i Int16 -> i -> ST s Int16 readInt32Array, -- :: Ix i => STUArray s i Int32 -> i -> ST s Int32 readInt64Array, -- :: Ix i => STUArray s i Int64 -> i -> ST s Int64 readWord8Array, -- :: Ix i => STUArray s i Word8 -> i -> ST s Word8 readWord16Array, -- :: Ix i => STUArray s i Word16 -> i -> ST s Word16 readWord32Array, -- :: Ix i => STUArray s i Word32 -> i -> ST s Word32 readWord64Array, -- :: Ix i => STUArray s i Word64 -> i -> ST s Word64 writeCharArray, -- :: Ix i => STUArray s i Char -> i -> Char -> ST s () writeIntArray, -- :: Ix i => STUArray s i Int -> i -> Int -> ST s () writeWordArray, -- :: Ix i => STUArray s i Word -> i -> Word -> ST s () writeAddrArray, -- :: Ix i => STUArray s i Addr -> i -> Addr -> ST s () writeFloatArray, -- :: Ix i => STUArray s i Float -> i -> Float -> ST s () writeDoubleArray, -- :: Ix i => STUArray s i Double -> i -> Double -> ST s () writeStablePtrArray, -- :: Ix i => STUArray s i (StablePtr a) -> i -> StablePtr a -> ST s () writeInt8Array, -- :: Ix i => STUArray s i Int8 -> i -> Int8 -> ST s () writeInt16Array, -- :: Ix i => STUArray s i Int16 -> i -> Int16 -> ST s () writeInt32Array, -- :: Ix i => STUArray s i Int32 -> i -> Int32 -> ST s () writeInt64Array, -- :: Ix i => STUArray s i Int64 -> i -> Int64 -> ST s () writeWord8Array, -- :: Ix i => STUArray s i Word8 -> i -> Word8 -> ST s () writeWord16Array, -- :: Ix i => STUArray s i Word16 -> i -> Word16 -> ST s () writeWord32Array, -- :: Ix i => STUArray s i Word32 -> i -> Word32 -> ST s () writeWord64Array -- :: Ix i => STUArray s i Word64 -> i -> Word64 -> ST s () ) where import Data.Array.MArray import Data.Array.IO import Data.Array.ST import Control.Monad.ST import Data.Int import Data.Word import Data.Array.Base ( STUArray(..), MArray(..) ) import Addr import Foreign.StablePtr import GHC.Exts ( Int(I#), Char(C#) ) import GHC.ST ( ST(..) ) import GHC.Prim ( newByteArray#, readCharArray#, writeCharArray#, readAddrArray#, writeAddrArray#, (*#) ) #include "MachDeps.h" ----------------------------------------------------------------------------- -- Addr instances instance MArray (STUArray s) Addr (ST s) where {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readAddrArray# marr# i# s1# of { (# s2#, e# #) -> (# s2#, A# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (A# e#) = ST $ \s1# -> case writeAddrArray# marr# i# e# s1# of { s2# -> (# s2#, () #) } wORD_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSWORD ----------------------------------------------------------------------------- -- Legacy non-overloaded byte array interface newCharArray :: Ix i => (i,i) -> ST s (STUArray s i Char) newIntArray :: Ix i => (i,i) -> ST s (STUArray s i Int) newWordArray :: Ix i => (i,i) -> ST s (STUArray s i Word) newAddrArray :: Ix i => (i,i) -> ST s (STUArray s i Addr) newFloatArray :: Ix i => (i,i) -> ST s (STUArray s i Float) newDoubleArray :: Ix i => (i,i) -> ST s (STUArray s i Double) newStablePtrArray :: Ix i => (i,i) -> ST s (STUArray s i (StablePtr a)) newInt8Array :: Ix i => (i,i) -> ST s (STUArray s i Int8) newInt16Array :: Ix i => (i,i) -> ST s (STUArray s i Int16) newInt32Array :: Ix i => (i,i) -> ST s (STUArray s i Int32) newInt64Array :: Ix i => (i,i) -> ST s (STUArray s i Int64) newWord8Array :: Ix i => (i,i) -> ST s (STUArray s i Word8) newWord16Array :: Ix i => (i,i) -> ST s (STUArray s i Word16) newWord32Array :: Ix i => (i,i) -> ST s (STUArray s i Word32) newWord64Array :: Ix i => (i,i) -> ST s (STUArray s i Word64) newCharArray (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# n# s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} newIntArray = newArray_ newWordArray = newArray_ newAddrArray = newArray_ newFloatArray = newArray_ newDoubleArray = newArray_ newStablePtrArray = newArray_ newInt8Array = newArray_ newInt16Array = newArray_ newInt32Array = newArray_ newInt64Array = newArray_ newWord8Array = newArray_ newWord16Array = newArray_ newWord32Array = newArray_ newWord64Array = newArray_ readCharArray :: Ix i => STUArray s i Char -> i -> ST s Char readIntArray :: Ix i => STUArray s i Int -> i -> ST s Int readWordArray :: Ix i => STUArray s i Word -> i -> ST s Word readAddrArray :: Ix i => STUArray s i Addr -> i -> ST s Addr readFloatArray :: Ix i => STUArray s i Float -> i -> ST s Float readDoubleArray :: Ix i => STUArray s i Double -> i -> ST s Double readStablePtrArray :: Ix i => STUArray s i (StablePtr a) -> i -> ST s (StablePtr a) readInt8Array :: Ix i => STUArray s i Int8 -> i -> ST s Int8 readInt16Array :: Ix i => STUArray s i Int16 -> i -> ST s Int16 readInt32Array :: Ix i => STUArray s i Int32 -> i -> ST s Int32 readInt64Array :: Ix i => STUArray s i Int64 -> i -> ST s Int64 readWord8Array :: Ix i => STUArray s i Word8 -> i -> ST s Word8 readWord16Array :: Ix i => STUArray s i Word16 -> i -> ST s Word16 readWord32Array :: Ix i => STUArray s i Word32 -> i -> ST s Word32 readWord64Array :: Ix i => STUArray s i Word64 -> i -> ST s Word64 readCharArray (STUArray l u marr#) i = ST $ \s1# -> case index (l,u) i of { I# i# -> case readCharArray# marr# i# s1# of { (# s2#, e# #) -> (# s2#, C# e# #) }} readIntArray = readArray readWordArray = readArray readAddrArray = readArray readFloatArray = readArray readDoubleArray = readArray readStablePtrArray = readArray readInt8Array = readArray readInt16Array = readArray readInt32Array = readArray readInt64Array = readArray readWord8Array = readArray readWord16Array = readArray readWord32Array = readArray readWord64Array = readArray writeCharArray :: Ix i => STUArray s i Char -> i -> Char -> ST s () writeIntArray :: Ix i => STUArray s i Int -> i -> Int -> ST s () writeWordArray :: Ix i => STUArray s i Word -> i -> Word -> ST s () writeAddrArray :: Ix i => STUArray s i Addr -> i -> Addr -> ST s () writeFloatArray :: Ix i => STUArray s i Float -> i -> Float -> ST s () writeDoubleArray :: Ix i => STUArray s i Double -> i -> Double -> ST s () writeStablePtrArray :: Ix i => STUArray s i (StablePtr a) -> i -> StablePtr a -> ST s () writeInt8Array :: Ix i => STUArray s i Int8 -> i -> Int8 -> ST s () writeInt16Array :: Ix i => STUArray s i Int16 -> i -> Int16 -> ST s () writeInt32Array :: Ix i => STUArray s i Int32 -> i -> Int32 -> ST s () writeInt64Array :: Ix i => STUArray s i Int64 -> i -> Int64 -> ST s () writeWord8Array :: Ix i => STUArray s i Word8 -> i -> Word8 -> ST s () writeWord16Array :: Ix i => STUArray s i Word16 -> i -> Word16 -> ST s () writeWord32Array :: Ix i => STUArray s i Word32 -> i -> Word32 -> ST s () writeWord64Array :: Ix i => STUArray s i Word64 -> i -> Word64 -> ST s () writeCharArray (STUArray l u marr#) i (C# e#) = ST $ \s1# -> case index (l,u) i of { I# i# -> case writeCharArray# marr# i# e# s1# of { s2# -> (# s2#, () #) }} writeIntArray = writeArray writeWordArray = writeArray writeAddrArray = writeArray writeFloatArray = writeArray writeDoubleArray = writeArray writeStablePtrArray = writeArray writeInt8Array = writeArray writeInt16Array = writeArray writeInt32Array = writeArray writeInt64Array = writeArray writeWord8Array = writeArray writeWord16Array = writeArray writeWord32Array = writeArray writeWord64Array = writeArray hugs98-plus-Sep2006/fptools/hslibs/lang/Makefile0000644006511100651110000000057310151654050020320 0ustar rossross# -----------------------------------------------------------------------------= # $Id: Makefile,v 1.22 2004/11/26 16:22:00 simonmar Exp $ # # (c) The University of Glasgow 2002 # TOP=.. include $(TOP)/mk/boilerplate.mk PACKAGE = lang VERSION = 1.0 PACKAGE_DEPS = mtl SUBDIRS = cbits ALL_DIRS = monads SRC_HC_OPTS += -cpp -fglasgow-exts -Icbits include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/lang/MutableArray.lhs0000644006511100651110000004006410053156773021771 0ustar rossross% % (c) The AQUA Project, Glasgow University, 1997 % \section[MutableArray]{The @MutableArray@ interface} Mutable (byte)arrays interface, re-exports type types and operations over them from @ArrBase@. Have to be used in conjunction with @ST@. \begin{code} module MutableArray {-# DEPRECATED "This library will go away soon; use Data.Array.ST instead" #-} ( -- This module is DEPRECATED. Use MArray instead. MutableByteArray(..), ST, Ix, -- Creators: newCharArray, newIntArray, newAddrArray, newFloatArray, newDoubleArray, newStablePtrArray, -- :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) boundsOfMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> (ix, ix) readCharArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Char readIntArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int readAddrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr readFloatArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Float readDoubleArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Double readStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a) writeCharArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () writeIntArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Int -> ST s () writeAddrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s () writeFloatArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () writeDoubleArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () writeStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a -> ST s () freezeByteArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) unsafeFreezeByteArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) thawByteArray, -- :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix) unsafeThawByteArray, -- :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix) -- the sizes are reported back are *in bytes*. sizeofMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> Int readWord8Array, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Word8 readWord16Array, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Word16 readWord32Array, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Word32 readWord64Array, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Word64 writeWord8Array, -- :: Ix ix => MutableByteArray s ix -> ix -> Word8 -> ST s () writeWord16Array, -- :: Ix ix => MutableByteArray s ix -> ix -> Word16 -> ST s () writeWord32Array, -- :: Ix ix => MutableByteArray s ix -> ix -> Word32 -> ST s () writeWord64Array, -- :: Ix ix => MutableByteArray s ix -> ix -> Word64 -> ST s () readInt8Array, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int8 readInt16Array, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int16 readInt32Array, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int32 readInt64Array, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int64 writeInt8Array, -- :: Ix ix => MutableByteArray s ix -> ix -> Int8 -> ST s () writeInt16Array, -- :: Ix ix => MutableByteArray s ix -> ix -> Int16 -> ST s () writeInt32Array, -- :: Ix ix => MutableByteArray s ix -> ix -> Int32 -> ST s () writeInt64Array -- :: Ix ix => MutableByteArray s ix -> ix -> Int64 -> ST s () ) where import PrelByteArr import Addr import GHC.Base import GHC.Arr import GHC.Stable import GHC.ST import GHC.Prim (unsafeCoerce#) import GHC.Word import Control.Monad.ST import Data.Ix import Data.Word import Data.Int \end{code} Note: the absence of operations to read/write ForeignObjs to a mutable array is not accidental; storing foreign objs in a mutable array is not supported. \begin{code} sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int sizeofMutableByteArray (MutableByteArray _ _ arr#) = case (sizeofMutableByteArray# arr#) of i# -> (I# i#) \end{code} \begin{code} newStablePtrArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) newStablePtrArray ixs@(l,u) = ST $ \ s# -> case rangeSize ixs of { I# n# -> case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) -> (# s2#, (MutableByteArray l u barr#) #) }} readStablePtrArray :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a) readStablePtrArray (MutableByteArray l u barr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readStablePtrArray# barr# n# s# of { (# s2#, r# #) -> (# s2# , (StablePtr r#) #) }} writeStablePtrArray :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a -> ST s () writeStablePtrArray (MutableByteArray l u barr#) n (StablePtr sp#) = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case writeStablePtrArray# barr# n# sp# s# of { s2# -> (# s2# , () #) }} \end{code} Reminder: indexing an array at some base type is done in units of the size of the type being; *not* in bytes. \begin{code} readWord8Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Word8 readWord16Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Word16 readWord32Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Word32 readWord8Array (MutableByteArray l u arr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readCharArray# arr# n# s# of { (# s2# , r# #) -> (# s2# , fromIntegral (I# (ord# r#)) #) }} readWord16Array (MutableByteArray l u arr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readWordArray# arr# (n# `quotInt#` 2#) s# of { (# s2# , w# #) -> case n# `remInt#` 2# of 0# -> (# s2# , fromIntegral (W# w#) #) -- the double byte hides in the lower half of the wrd. 1# -> (# s2# , fromIntegral (W# (uncheckedShiftRL# w# 16#)) #) -- take the upper 16 bits. }} readWord32Array (MutableByteArray l u arr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readWordArray# arr# n# s# of { (# s2# , w# #) -> (# s2# , fromIntegral (W# w#) #) }} -- FIXME, Num shouldn't be required, but it makes my life easier. readWord64Array :: (Num ix, Ix ix) => MutableByteArray s ix -> ix -> ST s Word64 readWord64Array mb n = do l <- readWord32Array mb (2*n) h <- readWord32Array mb (2*n + 1) #ifdef WORDS_BIGENDIAN return ( fromIntegral h + fromIntegral l * fromIntegral (maxBound::Word32)) #else return ( fromIntegral l + fromIntegral h * fromIntegral (maxBound::Word32)) #endif writeWord8Array :: (Ix ix) => MutableByteArray s ix -> ix -> Word8 -> ST s () writeWord16Array :: (Ix ix) => MutableByteArray s ix -> ix -> Word16 -> ST s () writeWord32Array :: (Ix ix) => MutableByteArray s ix -> ix -> Word32 -> ST s () writeWord8Array (MutableByteArray l u arr#) n w = ST $ \ s# -> case fromIntegral w of W# w# -> case index (l,u) n of I# n# -> case writeCharArray# arr# n# (chr# (word2Int# w#)) s# of s2# -> (# s2# , () #) writeWord16Array (MutableByteArray l u arr#) n w = ST $ \ s# -> case (index (l,u) n) of I# n# -> let w# = let W# w' = fromIntegral w in case n# `remInt#` 2# of 0# -> w' 1# -> uncheckedShiftL# w' 16# mask = case n# `remInt#` 2# of {- 0# -> case ``0xffff0000'' of W# x -> x -- writing to the lower half of the word. -} 0# -> int2Word# 0xffff0000# -- should be ok 1# -> int2Word# 0x0000ffff# in case readWordArray# arr# (n# `quotInt#` 2#) s# of (# s2# , v# #) -> case writeWordArray# arr# (n# `quotInt#` 2#) (w# `or#` (v# `and#` mask )) s2# of s3# -> (# s3# , () #) writeWord32Array (MutableByteArray l u arr#) n w = ST $ \ s# -> case (index (l,u) n) of I# n# -> case writeWordArray# arr# n# w# s# of s2# -> (# s2# , () #) where W# w# = fromIntegral w -- FIXME, Num shouldn't be required, but it makes my life easier. writeWord64Array :: (Num ix, Ix ix) => MutableByteArray s ix -> ix -> Word64 -> ST s () writeWord64Array mb n w = do #ifdef WORDS_BIGENDIAN writeWord32Array mb (n*2) h writeWord32Array mb (n*2+1) l #else writeWord32Array mb (n*2) l writeWord32Array mb (n*2+1) h #endif where h = fromIntegral h' l = fromIntegral l' (h',l') = w `divMod` (fromIntegral (maxBound::Word32) + 1) \end{code} \begin{code} readInt8Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Int8 readInt16Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Int16 readInt32Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Int32 readInt8Array (MutableByteArray l u arr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readCharArray# arr# n# s# of { (# s2# , r# #) -> (# s2# , fromIntegral (I# (ord# r#)) #) }} readInt16Array (MutableByteArray l u arr#) n = ST $ \ s# -> case (index (l,u) n) of I# n# -> case readIntArray# arr# (n# `quotInt#` 2#) s# of (# s2# , i# #) -> case n# `remInt#` 2# of 0# -> (# s2# , fromIntegral (I# i#) #) 1# -> (# s2# , fromIntegral (I# (word2Int# (uncheckedShiftRL# (int2Word# i#) 16# ))) #) readInt32Array (MutableByteArray l u arr#) n = ST $ \ s# -> case (index (l,u) n) of I# n# -> case readIntArray# arr# n# s# of (# s2# , i# #) -> (# s2# , fromIntegral (I# i#) #) readInt64Array :: (Num ix, Ix ix) => MutableByteArray s ix -> ix -> ST s Int64 readInt64Array mb n = do l <- readInt32Array mb (2*n) h <- readInt32Array mb (2*n + 1) #ifdef WORDS_BIGENDIAN return ( fromIntegral h + fromIntegral l * fromIntegral (maxBound::Int32)) #else return ( fromIntegral l + fromIntegral h * fromIntegral (maxBound::Int32)) #endif writeInt8Array :: (Ix ix) => MutableByteArray s ix -> ix -> Int8 -> ST s () writeInt16Array :: (Ix ix) => MutableByteArray s ix -> ix -> Int16 -> ST s () writeInt32Array :: (Ix ix) => MutableByteArray s ix -> ix -> Int32 -> ST s () writeInt8Array (MutableByteArray l u arr#) n i = ST $ \ s# -> case (index (l,u) n) of I# n# -> case writeCharArray# arr# n# ch s# of s2# -> (# s2# , () #) where ch = case fromIntegral i of { I# j -> chr# j } writeInt16Array (MutableByteArray l u arr#) n i = ST $ \ s# -> case (index (l,u) n) of I# n# -> let i# = let I# i' = fromIntegral i in case n# `remInt#` 2# of 0# -> i' 1# -> uncheckedIShiftL# i' 16# mask = case n# `remInt#` 2# of {- 0# -> case ``0xffff0000'' of W# x -> x -- writing to the lower half of the word. -} 0# -> int2Word# 0xffff0000# -- should be ok 1# -> int2Word# 0x0000ffff# in case readIntArray# arr# (n# `quotInt#` 2#) s# of (# s2# , v# #) -> let w' = word2Int# (int2Word# i# `or#` (int2Word# v# `and#` mask)) in case writeIntArray# arr# (n# `quotInt#` 2#) w' s2# of s2# -> (# s2# , () #) writeInt32Array (MutableByteArray l u arr#) n i = ST $ \ s# -> case (index (l,u) n) of I# n# -> case writeIntArray# arr# n# i# s# of s2# -> (# s2# , () #) where I# i# = fromIntegral i writeInt64Array :: (Num ix, Ix ix) => MutableByteArray s ix -> ix -> Int64 -> ST s () writeInt64Array mb n w = do #ifdef WORDS_BIGENDIAN writeInt32Array mb (n*2) h writeInt32Array mb (n*2+1) l #else writeInt32Array mb (n*2) l writeInt32Array mb (n*2+1) h #endif where h = fromIntegral h' l = fromIntegral l' (h',l') = w `divMod` (fromIntegral (maxBound::Int32) * 2 - 1) \end{code} \begin{code} {-# SPECIALIZE boundsOfMutableByteArray :: MutableByteArray s Int -> IPr #-} boundsOfMutableByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix) boundsOfMutableByteArray (MutableByteArray l u _) = (l,u) \end{code} \begin{code} thawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix) thawByteArray (ByteArray l u barr#) = {- The implementation is made more complex by the fact that the indexes are in units of whatever base types that's stored in the byte array. -} case (sizeofByteArray# barr#) of i# -> do marr <- newCharArray (0,I# i#) mapM_ (\ idx@(I# idx#) -> writeCharArray marr idx (C# (indexCharArray# barr# idx#))) [0..] let (MutableByteArray _ _ arr#) = marr return (MutableByteArray l u arr#) {- in-place conversion of immutable arrays to mutable ones places a proof obligation on the user: no other parts of your code can have a reference to the array at the point where you unsafely thaw it (and, subsequently mutate it, I suspect.) -} unsafeThawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix) unsafeThawByteArray (ByteArray l u barr#) = return (MutableByteArray l u (unsafeCoerce# barr#)) \end{code} \begin{code} newWordArray, newAddrArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) {-# SPECIALIZE newAddrArray :: IPr -> ST s (MutableByteArray s Int) #-} {-# SPECIALIZE newWordArray :: IPr -> ST s (MutableByteArray s Int) #-} newAddrArray (l,u) = ST $ \ s# -> case rangeSize (l,u) of { I# n# -> case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) -> (# s2#, MutableByteArray l u barr# #) }} newWordArray (l,u) = ST $ \ s# -> case rangeSize (l,u) of { I# n# -> case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) -> (# s2#, MutableByteArray l u barr# #) }} readAddrArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr readWordArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Word {-# SPECIALIZE readAddrArray :: MutableByteArray s Int -> Int -> ST s Addr #-} {-# SPECIALIZE readWordArray :: MutableByteArray s Int -> Int -> ST s Word #-} readAddrArray (MutableByteArray l u barr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readAddrArray# barr# n# s# of { (# s2#, r# #) -> (# s2#, A# r# #) }} readWordArray (MutableByteArray l u barr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readWordArray# barr# n# s# of { (# s2#, r# #) -> (# s2#, W# r# #) }} writeAddrArray :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s () writeWordArray :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s () {-# SPECIALIZE writeAddrArray :: MutableByteArray s Int -> Int -> Addr -> ST s () #-} {-# SPECIALIZE writeWordArray :: MutableByteArray s Int -> Int -> Word -> ST s () #-} writeAddrArray (MutableByteArray l u barr#) n (A# ele) = ST $ \ s# -> case index (l,u) n of { I# n# -> case writeAddrArray# barr# n# ele s# of { s2# -> (# s2#, () #) }} writeWordArray (MutableByteArray l u barr#) n (W# ele) = ST $ \ s# -> case index (l,u) n of { I# n# -> case writeWordArray# barr# n# ele s# of { s2# -> (# s2#, () #) }} \end{code} %********************************************************* %* * \subsection{Moving between mutable and immutable} %* * %********************************************************* \begin{code} freezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) {-# SPECIALISE freezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-} -- This coercion of memcpy to the ST monad is safe, because memcpy -- only modifies its destination operand, which is already MutableByteArray. freezeByteArray (MutableByteArray l u arr) = ST $ \ s -> let n = sizeofMutableByteArray# arr in case (newByteArray# n s) of { (# s, newarr #) -> case ((unsafeCoerce# memcpy) newarr arr n s) of { (# s, () #) -> case unsafeFreezeByteArray# newarr s of { (# s, frozen #) -> (# s, ByteArray l u frozen #) }}} foreign import "memcpy" unsafe memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO () \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/NativeInfo.hs0000644006511100651110000000017710053156774021271 0ustar rossrossmodule NativeInfo {-# DEPRECATED "This module has moved to System.Info" #-} (module System.Info) where import System.Info hugs98-plus-Sep2006/fptools/hslibs/lang/NumExts.lhs0000644006511100651110000000252710053156774021007 0ustar rossross% % (c) The AQUA Project, Glasgow University, 1998 % \section[NumExts]{Misc numeric bits} \begin{code} module NumExts {-# DEPRECATED "Use Numeric instead" #-} ( doubleToFloat -- :: Double -> Float , floatToDouble -- :: Float -> Double , showHex -- :: Integral a => a -> ShowS , showOct -- :: Integral a => a -> ShowS , showBin -- :: Integral a => a -> ShowS -- general purpose number->string converter. , showIntAtBase -- :: Integral a -- => a -- base -- -> (a -> Char) -- digit to char -- -> a -- number to show. -- -> ShowS , showListWith -- :: (a -> ShowS) -- -> [a] -- -> ShowS ) where import Data.Char ( intToDigit ) import Numeric ( showHex, showOct, showIntAtBase ) import Text.Show ( showListWith ) #ifdef __GLASGOW_HASKELL__ import GHC.Exts #endif \end{code} \begin{code} #ifdef __HUGS__ primitive doubleToFloat :: Double -> Float primitive floatToDouble :: Float -> Double #endif #ifdef __GLASGOW_HASKELL__ doubleToFloat :: Double -> Float floatToDouble :: Float -> Double doubleToFloat (D# d#) = F# (double2Float# d#) floatToDouble (F# f#) = D# (float2Double# f#) #endif /* __GLASGOW_HASKELL__ */ showBin :: Integral a => a -> ShowS showBin = showIntAtBase 2 (intToDigit.fromIntegral) \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/PackedString.lhs0000644006511100651110000000061210053156774021753 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 % \section{Packed strings} This sits on top of the sequencing/arrays world, notably @ByteArray#@s. Glorious hacking (all the hard work) by Bryan O'Sullivan. \begin{code} module PackedString {-# DEPRECATED "This module has moved to Data.PackedString" #-} ( module Data.PackedString ) where import Data.PackedString \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/PrelByteArr.lhs0000644006511100651110000001622410127370677021600 0ustar rossross% ----------------------------------------------------------------------------- % $Id: PrelByteArr.lhs,v 1.5 2004/10/02 00:09:35 ross Exp $ % % (c) The University of Glasgow, 1994-2000 % \section[PrelByteArr]{Module @PrelByteArr@} Byte-arrays are flat arrays of non-pointers only. \begin{code} {-# OPTIONS -fno-implicit-prelude #-} module PrelByteArr {-# DEPRECATED "This functionality is now available from Data.Array.Unboxed and Data.Array.ST" #-} where import GHC.Num import GHC.Arr import GHC.Float import GHC.ST import GHC.Base \end{code} %********************************************************* %* * \subsection{The @Array@ types} %* * %********************************************************* \begin{code} data ByteArray ix = ByteArray ix ix ByteArray# data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s) instance Eq (MutableByteArray s ix) where MutableByteArray _ _ arr1# == MutableByteArray _ _ arr2# = sameMutableByteArray# arr1# arr2# \end{code} %********************************************************* %* * \subsection{Operations on mutable arrays} %* * %********************************************************* \begin{code} newCharArray, newIntArray, newFloatArray, newDoubleArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) {-# SPECIALIZE newCharArray :: IPr -> ST s (MutableByteArray s Int) #-} {-# SPECIALIZE newIntArray :: IPr -> ST s (MutableByteArray s Int) #-} {-# SPECIALIZE newFloatArray :: IPr -> ST s (MutableByteArray s Int) #-} {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-} newCharArray (l,u) = ST $ \ s# -> case rangeSize (l,u) of { I# n# -> case (newByteArray# (cHAR_SCALE n#) s#) of { (# s2#, barr# #) -> (# s2#, MutableByteArray l u barr# #) }} newIntArray (l,u) = ST $ \ s# -> case rangeSize (l,u) of { I# n# -> case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) -> (# s2#, MutableByteArray l u barr# #) }} newWordArray (l,u) = ST $ \ s# -> case rangeSize (l,u) of { I# n# -> case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) -> (# s2#, MutableByteArray l u barr# #) }} newFloatArray (l,u) = ST $ \ s# -> case rangeSize (l,u) of { I# n# -> case (newByteArray# (fLOAT_SCALE n#) s#) of { (# s2#, barr# #) -> (# s2#, MutableByteArray l u barr# #) }} newDoubleArray (l,u) = ST $ \ s# -> case rangeSize (l,u) of { I# n# -> case (newByteArray# (dOUBLE_SCALE n#) s#) of { (# s2#, barr# #) -> (# s2#, MutableByteArray l u barr# #) }} #include "ghcconfig.h" -- Char arrays really contain only 8-bit bytes for compatibility. cHAR_SCALE n = 1# *# n wORD_SCALE n = (case SIZEOF_VOID_P :: Int of I# x -> x *# n) dOUBLE_SCALE n = (case SIZEOF_DOUBLE :: Int of I# x -> x *# n) fLOAT_SCALE n = (case SIZEOF_FLOAT :: Int of I# x -> x *# n) readCharArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Char readIntArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Int readFloatArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Float readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double {-# SPECIALIZE readCharArray :: MutableByteArray s Int -> Int -> ST s Char #-} {-# SPECIALIZE readIntArray :: MutableByteArray s Int -> Int -> ST s Int #-} --NO:{-# SPECIALIZE readFloatArray :: MutableByteArray s Int -> Int -> ST s Float #-} {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-} readCharArray (MutableByteArray l u barr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readCharArray# barr# n# s# of { (# s2#, r# #) -> (# s2#, C# r# #) }} readIntArray (MutableByteArray l u barr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readIntArray# barr# n# s# of { (# s2#, r# #) -> (# s2#, I# r# #) }} readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readFloatArray# barr# n# s# of { (# s2#, r# #) -> (# s2#, F# r# #) }} readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# -> case (index (l,u) n) of { I# n# -> case readDoubleArray# barr# n# s# of { (# s2#, r# #) -> (# s2#, D# r# #) }} --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here. indexCharArray :: Ix ix => ByteArray ix -> ix -> Char indexIntArray :: Ix ix => ByteArray ix -> ix -> Int indexFloatArray :: Ix ix => ByteArray ix -> ix -> Float indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double {-# SPECIALIZE indexCharArray :: ByteArray Int -> Int -> Char #-} {-# SPECIALIZE indexIntArray :: ByteArray Int -> Int -> Int #-} --NO:{-# SPECIALIZE indexFloatArray :: ByteArray Int -> Int -> Float #-} {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-} indexCharArray (ByteArray l u barr#) n = case (index (l,u) n) of { I# n# -> case indexCharArray# barr# n# of { r# -> (C# r#)}} indexIntArray (ByteArray l u barr#) n = case (index (l,u) n) of { I# n# -> case indexIntArray# barr# n# of { r# -> (I# r#)}} indexFloatArray (ByteArray l u barr#) n = case (index (l,u) n) of { I# n# -> case indexFloatArray# barr# n# of { r# -> (F# r#)}} indexDoubleArray (ByteArray l u barr#) n = case (index (l,u) n) of { I# n# -> case indexDoubleArray# barr# n# of { r# -> (D# r#)}} writeCharArray :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () writeIntArray :: Ix ix => MutableByteArray s ix -> ix -> Int -> ST s () writeFloatArray :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () {-# SPECIALIZE writeCharArray :: MutableByteArray s Int -> Int -> Char -> ST s () #-} {-# SPECIALIZE writeIntArray :: MutableByteArray s Int -> Int -> Int -> ST s () #-} --NO:{-# SPECIALIZE writeFloatArray :: MutableByteArray s Int -> Int -> Float -> ST s () #-} {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-} writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# -> case index (l,u) n of { I# n# -> case writeCharArray# barr# n# ele s# of { s2# -> (# s2#, () #) }} writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# -> case index (l,u) n of { I# n# -> case writeIntArray# barr# n# ele s# of { s2# -> (# s2#, () #) }} writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# -> case index (l,u) n of { I# n# -> case writeFloatArray# barr# n# ele s# of { s2# -> (# s2#, () #) }} writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# -> case index (l,u) n of { I# n# -> case writeDoubleArray# barr# n# ele s# of { s2# -> (# s2#, () #) }} \end{code} \begin{code} unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix) {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-} unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# -> case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) -> (# s2#, ByteArray l u frozen# #) } \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/ST.hs0000644006511100651110000000063310053156774017552 0ustar rossrossmodule ST {-# DEPRECATED "This functionality is now available from Control.Monad.ST, Data.STRef, and Data.Array.ST" #-} ( module Control.Monad.ST, module Data.STRef, STArray, newSTArray, readSTArray, writeSTArray, boundsSTArray, thawSTArray, freezeSTArray, unsafeFreezeSTArray, unsafeThawSTArray, ) where import Control.Monad.ST import Data.Array.ST import Data.STRef import GHC.Arr hugs98-plus-Sep2006/fptools/hslibs/lang/ShowFunctions.hs0000644006511100651110000000020510053156774022030 0ustar rossrossmodule ShowFunctions {-# DEPRECATED "See Text.Show.Functions" #-} (module Text.Show.Functions) where import Text.Show.Functions hugs98-plus-Sep2006/fptools/hslibs/lang/Stable.hs0000644006511100651110000000036310053156774020436 0ustar rossrossmodule Stable {-# DEPRECATED "This functionality is now available from Foreign.StablePtr and System.Mem.StableName" #-} (module Foreign.StablePtr, module System.Mem.StableName) where import Foreign.StablePtr import System.Mem.StableName hugs98-plus-Sep2006/fptools/hslibs/lang/StableName.hs0000644006511100651110000000023510053156774021235 0ustar rossrossmodule StableName {-# DEPRECATED "This module has moved to System.Mem.StableName" #-} (module System.Mem.StableName) where import System.Mem.StableName hugs98-plus-Sep2006/fptools/hslibs/lang/StorableArray.hs0000644006511100651110000000023210053156774021771 0ustar rossrossmodule StorableArray {-# DEPRECATED "This module has moved to Data.Array.Storable" #-} (module Data.Array.Storable) where import Data.Array.Storable hugs98-plus-Sep2006/fptools/hslibs/lang/SystemExts.lhs0000644006511100651110000000114510130751577021525 0ustar rossross% ----------------------------------------------------------------------------- % $Id: SystemExts.lhs,v 1.9 2004/10/06 11:14:07 ross Exp $ % % (c) The GHC Team, 2001 % Systemy extensions. \begin{code} {-# OPTIONS -#include "HsLang.h" #-} module SystemExts {-# DEPRECATED "This functionality is now available from System.Cmd and System.Environment" #-} ( rawSystem, -- :: String -> IO ExitCode , withArgs -- :: [String] -> IO a -> IO a , withProgName -- :: String -> IO a -> IO a , getEnvironment -- :: IO [(String, String)] ) where import System.Cmd import System.Environment \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/TimeExts.lhs0000644006511100651110000003436510130752030021132 0ustar rossross% ----------------------------------------------------------------------------- % $Id: TimeExts.lhs,v 1.3 2004/10/06 11:16:40 ross Exp $ {- TimeExts.lhs implements more useful time differences for Glasgow Haskell times. Time differences can be in picoseconds, seconds, minutes, hours, days, months or years. So for example you can add/subtract N months to a date, or find someone's age in days given the current date and their date of birth. Note on Timezones ----------------- We use UTC where necessary. This will occasionally matter. For example if it is 1am April 1st local time and 11pm March 31st UTC, then adding 1 month will give "11pm April 31st UTC", which will get rolled over to "11pm May 1st UTC", or "1am May 2nd local time", assuming a constant time difference between local time and UTC. Adding 1 month in local time would instead give "1am May 1st local time". It would not be too hard to use local time, but (a) I doubt if anyone will really notice the difference; (b) this sort of thing really ought not to be done unless Haskell has a proper notion of time-zones; (c) I'm not quite sure what to do about daylight saving time. -} \begin{code} module TimeExts {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( DiffPico(..), DiffSecond(..), DiffMinute(..), DiffHour(..), DiffDay(..), DiffMonth(..), DiffYear(..), TimeAddable, addClock, diffClock, addClockPico, diffClockPico, addClockSecond, diffClockSecond, addClockMinute, diffClockMinute, addClockHour, diffClockHour, addClockDay, diffClockDay, addClockMonth, diffClockMonth, addClockYear, diffClockYear ) where import System.Time -- Time difference types data DiffPico = DiffPico Integer data DiffSecond = DiffSecond Integer data DiffMinute = DiffMinute Integer data DiffHour = DiffHour Int -- 2^31 hours is more than 200000 years so Int is probably enough. data DiffDay = DiffDay Int data DiffMonth = DiffMonth Int data DiffYear = DiffYear Int -- this class is implemented for each of the above types. class TimeAddable diffType where addClock :: ClockTime -> diffType -> ClockTime -- add given time difference. Where necessary, lower fields -- are rolled over to higher ones. For example -- adding 1 month to March 31st gives May 1st. diffClock :: ClockTime -> ClockTime -> diffType -- diffClock timeTo timeFrom -- returns the time difference from timeFrom to timeTo. -- for example, if diffType is DayDiff, -- diffClock ("23:00:00 on January 2nd") ("00:00:00 on January 1st") -- will be "DayDiff 1", since 1 whole day (plus a bit extra) has -- elapsed from the second date to the first. -- For those who don't like the overloading in the above, we also -- provide monomorphic versions of each of these functions for each type. addClockPico :: ClockTime -> DiffPico -> ClockTime diffClockPico :: ClockTime -> ClockTime -> DiffPico addClockSecond :: ClockTime -> DiffSecond -> ClockTime diffClockSecond :: ClockTime -> ClockTime -> DiffSecond addClockMinute :: ClockTime -> DiffMinute -> ClockTime diffClockMinute :: ClockTime -> ClockTime -> DiffMinute addClockHour :: ClockTime -> DiffHour -> ClockTime diffClockHour :: ClockTime -> ClockTime -> DiffHour addClockDay :: ClockTime -> DiffDay -> ClockTime diffClockDay :: ClockTime -> ClockTime -> DiffDay addClockMonth :: ClockTime -> DiffMonth -> ClockTime diffClockMonth :: ClockTime -> ClockTime -> DiffMonth addClockYear :: ClockTime -> DiffYear -> ClockTime diffClockYear :: ClockTime -> ClockTime -> DiffYear --- END OF SPECIFICATION instance TimeAddable DiffPico where addClock = addClockPico diffClock = diffClockPico instance TimeAddable DiffSecond where addClock = addClockSecond diffClock = diffClockSecond instance TimeAddable DiffMinute where addClock = addClockMinute diffClock = diffClockMinute instance TimeAddable DiffHour where addClock = addClockHour diffClock = diffClockHour instance TimeAddable DiffDay where addClock = addClockDay diffClock = diffClockDay instance TimeAddable DiffMonth where addClock = addClockMonth diffClock = diffClockMonth instance TimeAddable DiffYear where addClock = addClockYear diffClock = diffClockYear -- Now we have to implement these functions. We have two strategies. -- (1) For DiffPico and DiffSecond this can be done trivially -- by extracting the fields of the ClockTime type, which gives -- seconds and picoseconds directly. -- (2) For other types we convert to CalendarTime and use -- Gregorian calendar calculations. {- DiffPico -} nPicos = 1000000000000 addClockPico (TOD seconds picos) (DiffPico diffPicos) = let (diffSeconds,diffRestPicos) = divMod diffPicos nPicos seconds' = seconds + diffSeconds picos' = picos + diffRestPicos (seconds'',picos'') = if picos' >= nPicos then (seconds'+1,picos'-nPicos) else (seconds',picos') in TOD seconds'' picos'' diffClockPico (TOD secondsTo picosTo) (TOD secondsFrom picosFrom) = DiffPico((picosTo-picosFrom) + nPicos * (secondsTo - secondsFrom)) {- DiffSecond -} addClockSecond (TOD seconds picos) (DiffSecond diffSeconds) = TOD (seconds + diffSeconds) picos diffClockSecond (TOD secondsTo picosTo) (TOD secondsFrom picosFrom) = DiffSecond(if picosTo >= picosFrom then (secondsTo - secondsFrom) else -- borrow (secondsTo - secondsFrom - 1) ) {- DiffMinute -} -- The remaining functions use the Gregorian Calendar code which -- is shoved down to the end of this file. addClockMinute clockTo (DiffMinute diffMinutes) = let calTo @ (CalendarTime {ctYear=ctYear,ctMonth=ctMonth,ctDay=ctDay, ctHour=ctHour,ctMin=ctMin}) = toUTCTime clockTo -- we will leave the other fields unchanged and hope that -- toClockTime will ignore them. (Which it does, for GHC.) (diffHours',diffRestMinutes) = divMod diffMinutes 60 minute' = ctMin + fromInteger diffRestMinutes (diffHours,minute) = if minute'<60 then (diffHours',minute') else (diffHours'+1,minute'-60) (diffDays',diffRestHours) = divMod diffHours 24 hour' = ctHour + fromInteger diffRestHours (diffDays,hour) = if hour'<24 then (diffDays',hour') else (diffDays+1,hour'-24) (year,month,day) = addDateDays (ctYear,ctMonth,ctDay) (fromInteger diffDays) in toClockTime (calTo {ctYear=year,ctMonth=month,ctDay=day, ctHour=hour,ctMin=minute }) diffClockMinute clockTo clockFrom = let CalendarTime {ctYear=toYear,ctMonth=toMonth,ctDay=toDay,ctHour=toHour, ctMin=toMinute,ctSec=toSec,ctPicosec=toPicosec} = toUTCTime clockTo CalendarTime {ctYear=fromYear,ctMonth=fromMonth,ctDay=fromDay, ctHour=fromHour,ctMin=fromMinute,ctSec=fromSec, ctPicosec=fromPicosec} = toUTCTime clockFrom borrow = (toSec,toPicosec) < (fromSec,toPicosec) diff' = (24*60) * (toInteger (diffDates (toYear,toMonth,toDay) (fromYear,fromMonth,fromDay))) + 60*(toInteger(toHour-fromHour)) + toInteger(toMinute-fromMinute) in DiffMinute(if borrow then diff'-1 else diff') {- DiffHour We're lazy and just call the minute functions for hours and days. -} addClockHour clockTo (DiffHour diffHours) = addClockMinute clockTo (DiffMinute (60*(toInteger diffHours))) diffClockHour clockTo clockFrom = let DiffMinute diffMinutes = diffClockMinute clockTo clockFrom in DiffHour(fromInteger(diffMinutes `div` 60)) {- DiffDay We're lazy and just call the minute functions for hours and days. For days at least this involves unnecessary multiplication and division, unless the compiler is very clever. -} addClockDay clockTo (DiffDay diffDays) = addClockMinute clockTo (DiffMinute ((24*60)*(toInteger diffDays))) diffClockDay clockTo clockFrom = let DiffMinute diffMinutes = diffClockMinute clockTo clockFrom in DiffDay(fromInteger(diffMinutes `div` (24*60))) {- DiffMonth Here we assume that toClockTime will roll over illegal dates, as when you add 1 month to March 31st and get April 31st. This is avoidable by doing some Gregorian calendar calculations; the equivalent situation when you roll over a leap second is not. -} addClockMonth clockTo (DiffMonth diffMonths) = let calTo @ (CalendarTime {ctYear=ctYear,ctMonth=ctMonth}) = toUTCTime clockTo mn = (fromEnum ctMonth) + diffMonths (yearDiff,monthNo) = divMod mn 12 in toClockTime(calTo {ctYear=ctYear+yearDiff,ctMonth=toEnum monthNo}) diffClockMonth clockTo clockFrom = let CalendarTime {ctYear=toYear,ctMonth=toMonth,ctDay=toDay,ctHour=toHour, ctMin=toMinute,ctSec=toSec,ctPicosec=toPicosec} = toUTCTime clockTo CalendarTime {ctYear=fromYear,ctMonth=fromMonth,ctDay=fromDay, ctHour=fromHour,ctMin=fromMinute,ctSec=fromSec, ctPicosec=fromPicosec} = toUTCTime clockFrom borrow = -- hack around GHC failure to order tuples with -- more than 5 elements. (toDay,toHour,toMinute,toDay,(toSec,toPicosec)) < (fromDay,fromHour,fromMinute,fromDay,(fromSec,fromPicosec)) diff' = 12*(toYear-fromYear) + (fromEnum toMonth - fromEnum fromMonth) in DiffMonth(if borrow then diff' -1 else diff') {- DiffYear It's getting late so waste CPU time/leave it to the compiler and use the month functions -} addClockYear clockTo (DiffYear diffYears) = addClockMonth clockTo (DiffMonth (12*diffYears)) diffClockYear clockTo clockFrom = let DiffMonth diffMonths = diffClockMonth clockTo clockFrom in DiffYear(diffMonths `div` 12) {- Magic code for implementing the Gregorian Calendar -} -- Here are two ways of representing a date type Date = (Int,Month,Int) -- year, month, day type NDays = Int -- Counts days starting at 1st March Year 0 -- (in the Gregorian Calendar). So the 1st March Year 0 is -- day 0, and so on. We start years at March as that means -- leap days always come at the end. -- The difficult bit of this module is converting from Date to -- NDays. We do this by going via a YDPair: type YDPair = (Int,Int) -- a YDPair is the number of whole years since 0th March Year 0 -- plus the number of days after that. So the YDPair for -- 29th Feb 2000 is (1999,360) and the YDPair for 1st Mar 2000 is -- (2000,0). addDateDays date n = nDaysToDate ( dateToNDays date + n) diffDates dateTo dateFrom = (dateToNDays dateTo - dateToNDays dateFrom) dateToNDays = ydPairToNDays . dateToYDPair nDaysToDate = ydPairToDate . nDaysToYDPair ydPairToNDays :: YDPair -> NDays ydPairToNDays (years,days) = days + years * 365 + (years `div` 4) - (years `div` 100) + (years `div` 400) nDaysToYDPair :: NDays -> YDPair nDaysToYDPair ndays = -- there must be a neater way of writing this! (400*q + 100*r + 4*s + t,days) where -- the idea being that 0<=r<4, 0<=s<25, 0<=t<4, -- and so ndays = q*qd + r*rd + s*sd + t*td + days -- where days is as small as possible while still being non-negative. qd = 4*rd +1 -- days in 400 years rd = 25*sd - 1 -- days in 100 years sd = 4*td + 1 -- days in 4 years td = 365 -- days in 1 year. (q,qrest) = divMod ndays qd (r',rrest) = divMod qrest rd (s',srest) = divMod rrest sd (t',days') = divMod srest td -- r',s',t',days' are not quite the right values of r,s,t if there's -- a leap day, which gives rise to d=0 and r=4 or t=4. (r,s,t,days) = if days'/=0 then (r',s',t',days') else -- March 1st or leap day if t'==4 then -- leap day (r',s',3,365) else if r'==4 then -- leap day of year divisible by 400 (3,24,3,365) else -- March 1st (r',s',t',days') -- magic numbers to subtract from a day number in a year -- (remember March 1st is day 0) to get a date in a month. nMarch = -1 nApril = 30 nMay = 60 nJune = 91 nJuly = 121 nAugust = 152 nSeptember = 183 nOctober = 213 nNovember = 244 nDecember = 274 nJanuary = 305 nFebruary = 336 dateToYDPair :: Date -> YDPair dateToYDPair (year,month,date) = case month of March -> (year,date+nMarch) April -> (year,date+nApril) May -> (year,date+nMay) June -> (year,date+nJune) July -> (year,date+nJuly) August -> (year,date+nAugust) September -> (year,date+nSeptember) October -> (year,date+nOctober) November -> (year,date+nNovember) December -> (year,date+nDecember) January -> (year-1,date+nJanuary) February -> (year-1,date+nFebruary) ydPairToDate :: YDPair -> Date ydPairToDate (years,days) = if days<=nSeptember then if days<=nJune then if days<=nMay then if days<=nApril then -- March (years,March,days-nMarch) else -- April (years,April,days-nApril) else -- May (years,May,days-nMay) else if days<=nAugust then if days<=nJuly then -- June (years,June,days-nJune) else -- July (years,July,days-nJuly) else -- August (years,August,days-nAugust) else if days<=nDecember then if days<=nNovember then if days<=nOctober then -- September (years,September,days-nSeptember) else -- October (years,October,days-nOctober) else -- November (years,November,days-nNovember) else if days<=nFebruary then if days<=nJanuary then -- December (years,December,days-nDecember) else -- January (years+1,January,days-nJanuary) else -- February (years+1,February,days-nFebruary) \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/Weak.hs0000644006511100651110000000020510053156774020106 0ustar rossrossmodule Weak {-# DEPRECATED "This module has moved to System.Mem.Weak" #-} (module System.Mem.Weak) where import System.Mem.Weak hugs98-plus-Sep2006/fptools/hslibs/lang/package.conf.in0000644006511100651110000000275310205402200021515 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: False exposed-modules: Addr, ArrayBase, Arrow, ByteArray, CTypesISO, DiffArray, DirectoryExts, Dynamic, Exception, ForeignObj, Generics, GlaExts, IArray, IOExts, IORef, LazyST, MArray, MutableArray, NativeInfo, NumExts, PackedString, PrelByteArr, ST, ShowFunctions, Stable, StableName, StorableArray, SystemExts, TimeExts, Weak, MonadCont, MonadEither, MonadError, MonadFix, MonadIdentity, MonadList, MonadRWS, MonadReader, MonadState, MonadTrans, MonadWriter, Monoid hidden-modules: #ifdef INSTALLING import-dirs: PKG_LIBDIR"/hslibs-imports/lang" #else import-dirs: FPTOOLS_TOP_ABS"/hslibs/lang", FPTOOLS_TOP_ABS"/hslibs/lang/monads" #endif #ifdef INSTALLING library-dirs: PKG_LIBDIR #else library-dirs: FPTOOLS_TOP_ABS"/hslibs/lang", FPTOOLS_TOP_ABS"/hslibs/lang/cbits" #endif hs-libraries: "HSlang" extra-libraries: #ifdef INSTALLING include-dirs: #else include-dirs: FPTOOLS_TOP_ABS"/hslibs/lang/cbits" #endif includes: HsLang.h depends: base, mtl hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: haddock-html: hugs98-plus-Sep2006/fptools/hslibs/lang/doc/0000755006511100651110000000000010504340142017414 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/lang/doc/Bits.xml0000644006511100651110000000071310111701547021044 0ustar rossross <literal>Bits</literal> Bits This module has moved to Data.Bits in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/CError.xml0000644006511100651110000000075610111701547021346 0ustar rossross <literal>CError</literal> CError This module has moved to Foreign.C.Error in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/CForeign.xml0000644006511100651110000000043710111701547021642 0ustar rossross <literal>CForeign</literal><indexterm><primary>CForeign</primary></indexterm> This module has moved to Foreign.C in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/CString.xml0000644006511100651110000000076310111701547021521 0ustar rossross <literal>CString</literal> CString This module has moved to Foreign.C.String in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/CTypes.xml0000644006511100651110000000044410111701550021345 0ustar rossross <literal>CTypes</literal><indexterm><primary>CTypes</primary></indexterm> This module has moved to Foreign.C.Types in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/CTypesISO.xml0000644006511100651110000000046610111701550021724 0ustar rossross <literal>CTypesISO</literal><indexterm><primary>CTypesISO</primary></indexterm> This module has been merged into Foreign.C.Types in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/DiffArray.xml0000644006511100651110000000100110111701550021773 0ustar rossross <literal>DiffArray</literal> DiffArraymodule This module has moved to Data.Array.Diff in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/DirectoryExts.xml0000644006511100651110000000262010111701550022744 0ustar rossross <literal>DirectoryExts</literal> <indexterm> <primary>DirectoryExts</primary> <secondary>library</secondary> </indexterm> The DirectoryExts module follows the footstep of other 'Exts' modules and provides functionality that goes beyond what the Haskell 98 module Directory offers. That is, functionality that provides access to file/directory operations in an OS-independent manner. DirectoryExts currently exports the following: copyFile :: FilePath -> FilePath -> IO () copyFile file copying Notes: copyFile lets you copy a file to another non-existent file. File copying is done external to Haskell, and is for natural reasons quicker as a result and, most importantly, file copying handles the number of the OS-specific error conditions that might arise as a result of trying to perform the file copy operation. Should the file copying operation for some reason not succeed, the action copyFile raises an IO exception to signal the fact. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/Dynamic.xml0000644006511100651110000000044210111701551021521 0ustar rossross <literal>Dynamic</literal><indexterm><primary>Dynamic</primary></indexterm> This module has moved to Data.Dynamic in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/Exception.xml0000644006511100651110000000074710111701554022106 0ustar rossross <literal>Exception</literal><indexterm><primary>Exception</primary></indexterm> This module has moved to Control.Exception in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/Foreign.xml0000644006511100651110000000043110111701554021527 0ustar rossross <literal>Foreign</literal><indexterm><primary>Foreign</primary></indexterm> This module has moved to Foreign in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/ForeignPtr.xml0000644006511100651110000000103610111701555022220 0ustar rossross <literal>ForeignPtr</literal> ForeignPtrmodule This module has moved to Foreign.ForeignPtr in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/GlaExts.xml0000644006511100651110000000035010111701555021506 0ustar rossross <literal>GlaExts</literal> This module has moved to GHC.Exts in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/IArray.xml0000644006511100651110000000077510111701555021341 0ustar rossross <literal>IArray</literal> IArraymodule This module has moved to Data.Array.IArray in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/IOExts.xml0000644006511100651110000003525010111701556021322 0ustar rossross <literal>IOExts</literal><indexterm><primary>IOExts</primary></indexterm> This library is the home for miscellaneous IO-related extensions. IO monad extensions fixIO :: (a -> IO a) -> IO a fixIO fixIO allows recursive IO operations to be defined. The first argument to fixIO should be a function that takes its own output as an argument (sometimes called "tying the knot"). unsafePerformIO :: IO a -> a unsafePerformIO This is the "back door" into the IO monad, allowing IO computation to be performed at any time. For this to be safe, the IO computation should be free of side effects and independent of its environment. If the I/O computation wrapped in unsafePerformIO performs side effects, then the relative order in which those side effects take place (relative to the main I/O trunk, or other calls to unsafePerformIO) is indeterminate. However, it is less well known that unsafePerformIO is not type safe. For example: test :: IORef [a] test = unsafePerformIO $ newIORef [] main = do writeIORef test [42] bang <- readIORef test print (bang :: [Char]) This program will core dump. This problem with polymorphic references is well known in the ML community, and does not arise with normal monadic use of references. There is no easy way to make it impossible once you use unsafePerformIO. Indeed, it is possible to write coerce :: a -> b with the help of unsafePerformIO. So be careful! unsafeInterleaveIO :: IO a -> IO a unsafeInterleaveIO unsafeInterleaveIO allows IO computation to be deferred lazily. When passed a value of type IO a, the IO will only be performed when the value of the a is demanded. This is used to implement lazy file reading, see IO.hGetContents. Mutable Variables mutable variables data IORef -- instance of: Eq newIORef :: a -> IO (IORef a) readIORef :: IORef a -> IO a writeIORef :: IORef a -> a -> IO () modifyIORef :: IORef a -> (a -> a) -> IO () mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a)) -- deprecated, use modifyIORef updateIORef :: IORef a -> (a -> a) -> IO () IORef type newIORef readIORef writeIORef modifyIORef Mutable Arrays mutable arrays data IOArray -- instance of: Eq newIOArray :: Ix ix => (ix,ix) -> elt -> IO (IOArray ix elt) boundsIOArray :: Ix ix => IOArray ix elt -> (ix, ix) readIOArray :: Ix ix => IOArray ix elt -> ix -> IO elt writeIOArray :: Ix ix => IOArray ix elt -> ix -> elt -> IO () freezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt) thawIOArray :: Ix ix => Array ix elt -> IO (IOArray ix elt) unsafeFreezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt) unsafeThawIOArray :: Ix ix => Array ix elt -> IO (IOArray ix elt) IOArray newIOArray boundsIOArray readIOArray writeIOArray freezeIOArray thawIOArray unsafeFreezeIOArray unsafeThawIOArray Note: unsafeFreezeIOArray and unsafeThawIOArray are not provided by Hugs. Extended file modes file modesextended data IOModeEx = BinaryMode IOMode | TextMode IOMode deriving (Eq, Read, Show) openFileEx :: FilePath -> IOModeEx -> IO Handle hSetBinaryMode :: Handle -> Bool -> IO Bool IOModeEx BinaryMode TextMode openFileEx hSetBinaryMode GHC's implementation of the IO library distinguishes between binary- and text-mode files. This unfortunate hack is imposed on us by the need to support Win32 platforms. On Win32, files opened in text mode are subject to CR-LF translation. When reading a handle in text mode, CR-LF sequences in the physical file are translated into lone LFs in the stream presented to the Haskell program. Writes to a text mode handle are subject to the inverse transformation. On Unix platforms there is no such translation. What you get is exactly the contents of the file, and vice versa. Unfortunately this behaviour makes it difficult to correctly implement file-positioning operations in text mode on Win32. If you want to use such operations, you must first place the handle in binary mode. Failure to do so results in IO exceptions being raised. This applies only to Win32, and not to any other platforms. If your programs use seek operations and you want them to be portable between Unix and Win32, you need to ensure the relevant handles are in binary mode. You can get hold of a binary-mode file handle one of two ways. Either open the file with openFileEx, which allows the mode to be specified. Or, if you already have an open handle, use hSetBinaryMode to change its mode. Also as a result of this, note that on Win32 there are also several operations which, whist still allowed, may give different results in text mode than their Unix counterparts. These are: changing buffering modes of a handle (hSetBuffering), and writing to a read-write handle. In both cases, the read-buffer associated with the handle needs to be flushed, and, due to the Win32 text mode translation, the resulting physical file position following the flush may be wrong. This issue of seeking in the presence of a non-identity transform between file and buffer contents will need to be revisited when the library is re-done to properly support Unicode. The present arrangement is the least-worst kludge we could come up with at present. Bulk transfers bulk transfers hGetBuf :: Handle -> Addr -> Int -> IO Int hPutBuf :: Handle -> Addr -> Int -> IO () hGetBuf hPutBuf These functions read and write chunks of data to/from a handle. They will return only when either the full buffer has been transfered, or the end of file is reached (in the case of hGetBuf. hGetBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int hPutBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO () hGetBufBA hPutBufBA These functions mirror the previous two functions, but operate on MutableByteArrays instead of Addrs. This may be more convenient and/or faster, depending on the circumstances. Terminal control terminal control hIsTerminalDevice :: Handle -> IO Bool hSetEcho :: Handle -> Bool -> IO () hGetEcho :: Handle -> IO Bool hIsTerminalDevice hSetEcho hGetEcho Redirecting handles withHandleFor :: Handle -> Handle -> IO a -> IO a withStdout :: Handle -> IO a -> IO a withStdin :: Handle -> IO a -> IO a withStderr :: Handle -> IO a -> IO a withHandleFor withStdout withStdin withStderr Trace trace :: String -> a -> a trace When called, trace prints the string in its first argument to standard error, before returning the second argument as its result. The trace function is not referentially transparent, and should only be used for debugging, or for monitoring execution. Some implementations of trace may decorate the string that's output to indicate that you're tracing. trace is implemented using unsafePerformIO. Extra <literal>IOError</literal> Predicates IOError The IO module provides several predicates over the IOError type, such as isEOFError, isDoesNotExistError, and so on. Here we define an extended set of these predicates, taking into account more types of error: isHardwareFault :: IOError -> Bool isInappropriateType :: IOError -> Bool isInterrupted :: IOError -> Bool isInvalidArgument :: IOError -> Bool isOtherError :: IOError -> Bool isProtocolError :: IOError -> Bool isResourceVanished :: IOError -> Bool isSystemError :: IOError -> Bool isTimeExpired :: IOError -> Bool isUnsatisfiedConstraints :: IOError -> Bool isUnsupportedOperation :: IOError -> Bool isDynIOError :: IOError -> Bool Miscellany unsafePtrEq :: a -> a -> Bool slurpFile :: FilePath -> IO (Addr, Int) hConnectTo :: Handle -> Handle -> IO () performGC :: IO () freeHaskellFunctionPtr :: Addr -> IO () getDynIOError :: IOError -> Maybe Dynamic.Dynamic mkWeakIORef unsafePtrEq slurpFile hConnectTo performGC freeHaskellFunctionPtr getDynIOError performGC triggers an immediate garbage collection unsafePtrEq compares two values for pointer equality without evaluating them. The results are not referentially transparent and may vary significantly from one compiler to another or in the face of semantics-preserving program changes. However, pointer equality is useful in creating a number of referentially transparent constructs such as this simplified memoisation function: > cache :: (a -> b) -> (a -> b) > cache f = \x -> unsafePerformIO (check x) > where > ref = unsafePerformIO (newIORef (error "cache", error "cache")) > check x = readIORef ref >>= \ (x',a) -> > if x `unsafePtrEq` x' then > return a > else > let a = f x in > writeIORef ref (x, a) >> > return a getDynIOError takes an IOError as argument. If it is a dynamic IO error, it returns Just d, where d is the dynamic value. Of (some) use by library providers to provide their own IOError types. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/Int.xml0000644006511100651110000000045510111701557020701 0ustar rossross <literal>Int</literal> <indexterm><primary>Int</primary><secondary>module</secondary></indexterm> This module has moved to Data.Int in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/LazyST.xml0000644006511100651110000000062010111701557021327 0ustar rossross <literal>LazyST</literal><indexterm><primary>LazyST</primary></indexterm> The contents of this module can now be found in Control.Monad.ST.Lazy, and Data.STRef.Lazy. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/MArray.xml0000644006511100651110000000102210111701557021331 0ustar rossross <literal>MArray</literal> MArraymodule This module has moved to Data.Array.MArray in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/MarshalAlloc.xml0000644006511100651110000000101610111701557022503 0ustar rossross <literal>MarshalAlloc</literal> MarshalAlloc This module has moved to Foreign.Marshal.Alloc in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/MarshalArray.xml0000644006511100651110000000077010111701557022535 0ustar rossross <literal>MarshalArray</literal> MarshalArray This module has moved to Foreign.Marshal.Array in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/MarshalError.xml0000644006511100651110000000101510111701557022541 0ustar rossross <literal>MarshalError</literal> MarshalError This module has moved to Foreign.Marshal.Error in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/MarshalUtils.xml0000644006511100651110000000101510111701560022542 0ustar rossross <literal>MarshalUtils</literal> MarshalUtils This module has moved to Foreign.Marshal.Utils in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/NumExts.xml0000644006511100651110000000556310111701560021551 0ustar rossross <literal>NumExts</literal><indexterm><primary>NumExts</primary></indexterm> The NumExts interface collect together various numeric operations that have proven to be commonly useful -- Going between Doubles and Floats: doubleToFloat :: Double -> Float floatToDouble :: Float -> Double showHex :: Integral a => a -> ShowS showOct :: Integral a => a -> ShowS showBin :: Integral a => a -> ShowS showIntAtBase :: Integral a => a -- base -> (a -> Char) -- digit to char -> a -- number to show. -> ShowS showListWith :: (a -> ShowS) -> [a] -> ShowS Notes: If doubleToFloat is applied to a Double that is within the representable range for Float, the result may be the next higher or lower representable Float value. If the Double is out of range, the result is undefined. No loss of precision occurs in the other direction with floatToDouble, the floating value remains unchanged. showOct, showHex and showBin will prefix 0o, 0x and 0b, respectively. Like Numeric.showInt, these show functions work on positive numbers only. showIntAtBase is the more general function for converting a number at some base into a series of characters. The above show* functions use it, for instance, here's how showHex could be defined showHex :: Integral a => a -> ShowS showHex n r = showString "0x" $ showIntAtBase 16 (toChrHex) n r where toChrHex d | d < 10 = chr (ord '0' + fromIntegral d) | otherwise = chr (ord 'a' + fromIntegral (d - 10)) showListWith is strictly speaking not a 'NumExts' kind of function, but it's sometimes useful in conjunction with the other show* functions that NumExts exports. It is the non-overloaded version of showList, allowing you to supply the shows function to use per list element. For instance, putStrLn (NumExts.showListWith NumExts.showHex [0..16]) will print out the elements of [0..16] in hexadecimal form. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/PackedString.xml0000644006511100651110000000040010111701560022505 0ustar rossross <literal>PackedString</literal> This module has moved to Data.PackedString in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/Ptr.xml0000644006511100651110000000073510111701561020710 0ustar rossross <literal>Ptr</literal> Ptr This module has moved to Foreign.Ptr in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/ST.xml0000644006511100651110000000075710111701561020475 0ustar rossross <literal>ST</literal><indexterm><primary>ST</primary></indexterm> The contents of this module can now be found in Control.Monad.ST, Data.STRef, and Data.Array.ST in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/ShowFunctions.xml0000644006511100651110000000054710111701561022755 0ustar rossross <literal>ShowFunctions</literal> <indexterm> <primary>ShowFunctions</primary> <secondary>library</secondary> </indexterm> This module has moved to Text.Show.Functions in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/StableName.xml0000644006511100651110000000047710111701561022161 0ustar rossross <literal>StableName</literal><indexterm><primary>StableName</primary></indexterm> This module has moved to System.Mem.StableName in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/StablePtr.xml0000644006511100651110000000047610111701562022046 0ustar rossross <literal>StablePtr</literal><indexterm><primary>Stable Pointers</primary></indexterm> This module has moved to Foreign.StablePtr in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/Storable.xml0000644006511100651110000000076610111701563021724 0ustar rossross <literal>Storable</literal> Storable This module has moved to Foreign.Storable in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/StorableArray.xml0000644006511100651110000000102510111701564022711 0ustar rossross <literal>StorableArray</literal> StorableArraymodule This module has moved to Data.Array.Storable in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/SystemExts.xml0000644006511100651110000000621710111701564022277 0ustar rossross <literal>SystemExts</literal> <indexterm> <primary>SystemExts</primary> <secondary>library</secondary> </indexterm> The SystemExts module contains functionality that goes beyond what the Haskell 98 module System provides. That is, functionality that provides access to the underlying OS' facilities in an OS-independent manner. Notice that SystemExts shares the goal of System. That is, it aims to provide functionality that's supported by all platforms. So, if you're looking to do serious system programming for a particular (family) of platforms, you really want to check out the libraries provided for the platform in question as well. e.g., The Posix library for POSIX.1-conforming platforms, the Win32 library for Win32 platforms. SystemExts exports the following: rawSystem :: String -> IO ExitCode withArgs :: [String] -> IO a -> IO a withProgName :: String -> IO a -> IO a getEnvironment :: IO [(String, String)] rawSystem execute system commands sans command shell withArgs change command-line arguments withProgName change program name Notes: rawSystem provides the exact same behaviour as System.system, except that the system command isn't invoked via a shell / command interpreter. Not involving your platform's shell / command interpreter is quicker if you don't need its functionality, and it avoids running into limitations imposed by the shell / command interpreter. For instance, Win32 command interpreters place a limit on the length of the command they can execute (~4k), which sometimes gets in the way of what you want to do. The withArgs action lets you change the value returned by System.getArgs while executing an IO action. When the action has finished executing (or if it raises an exception), the argument vector of System.getArgs is restored. The withProgName action lets you change the program name string returned by System.getProgName while executing an IO action. As withArgs, when the action has finished executing (or if it raises an exception), the program name string System.getArgs is restored. The getEnvironment action returns all the environment values present in your process' environment block. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/Weak.xml0000644006511100651110000000072110111701565021031 0ustar rossross <literal>Weak</literal><indexterm><primary>Weak</primary></indexterm> This module has moved to System.Mem.Weak in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/Word.xml0000644006511100651110000000042210111701565021053 0ustar rossross <literal>Word</literal><indexterm><primary>Word</primary></indexterm> This module has moved to Data.Word in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/lang/doc/lang.xml0000644006511100651110000000073210111701565021065 0ustar rossrossThe <literal>lang</literal> package: language support &bits; &cerror; &cforeign; &ctypes; &ctypesiso; &cstring; &diffarray; &directoryexts; &dynamic; &exception; &foreign; &foreignptr; &glaexts; &iarray; &xint; &ioexts; &lazyst; &marray; &marshalalloc; &marshalarray; &marshalerror; &marshalutils; &numexts; &packed; &ptr; &showfunctions; &st; &stablename; &stableptr; &storable; &storablearray; &systemexts; &weak; &word; hugs98-plus-Sep2006/fptools/hslibs/lang/doc/refs.bib0000644006511100651110000000743207037325622021054 0ustar rossross @article{Haskell1.2, author = "Hudak, P. and Peyton Jones, S. and Wadler (editors), P.", title = "Report on the {P}rogramming {L}anguage {H}askell, {A} {N}on-strict {P}urely {F}unctional {L}anguage ({V}ersion 1.2)", journal = "ACM SIGPLAN Notices", volume = "27", number = "5", month = "May", year = "1992" } @techreport{Haskell1.4, author = "Peterson, J. and Hammond (editors), K.", title = "Report on the {P}rogramming {L}anguage {H}askell 1.4, {A} {N}on-strict {P}urely {F}unctional {L}anguage", institution = "Yale University", address = "Department of Computer Science", type = "Research Report", number = "YALEU/DCS/RR-1106", month = "April", year = "1997" } @techreport{Haskell1.4libs, author = "Peterson, J. and Hammond (editors), K.", title = "The {Haskell} library report version 1.4", institution = "Yale University", address = "Department of Computer Science", type = "Research Report", number = "YALEU/DCS/RR-1105", month = "April", year = "1997" } @inproceedings{ImperativeFP, author = "Peyton Jones, S. and Wadler, P.", title = "Imperative Functional Programming", booktitle = "Proceedings 20th Symposium on Principles of Programming Languages", organization = "ACM", month = "January", year = "1993" } @inproceedings{LazyStateThreads, author = "Launchbury, J. and Peyton Jones, S.L.", title = "Lazy functional state threads", booktitle = "Conference on Programming Language Design and Implementation", address = "Orlando, FL", year = "1994", month = "June" } @book{BW, author = "Bird, R. and Wadler, P.", title = "Introduction to functional programming", publisher = "Prentice Hall", year = "1988" } @article{GentleIntro, author = "Hudak, P. and Fasel, J.", title = "A gentle introduction to {Haskell}", journal = "ACM SIGPLAN Notices", volume = "27", number = "5", month = "May", year = "1992", note = "Also available as Research Report YALEU/DCS/RR-901, Yale University, Department of Computer Science, April 1992." } @techreport{Gofer, author = "Jones, M.P.", title = "The implementation of the {G}ofer functional programming system", institution = "Yale University", year = "1994", month = "May", address = "New Haven, Connecticut, USA", type = "Research Report", number = "YALEU/DCS/RR-1030", note = "Available on the World-Wide Web from {\tt http://www.cs.nott.ac.uk/Department/Staff/mpj/pubs.html}" } @unpublished{MonParse, title = "Monadic parser combinators", author = "Hutton, G. and Meijer, E.", note = "Available from {\tt http://www.cs.nott.ac.uk/Department/Staff/gmh/bib.html}", year = "1996" } @inproceedings{concurrentHaskell:popl96, author = "Simon {Peyton Jones} and Andrew Gordon and Sigbj\orn Finne", title = "Concurrent {H}askell", pages = "295--308", booktitle = "Conference record of {POPL '96}: 23rd {ACM SIGPLAN-SIGACT} {S}ymposium on {P}rinciples of {P}rogramming {L}anguages", publisher = "ACM press", address = "St. Petersburg Beach, FL", year = "1996", month = "January" } @inproceedings{Wadler:Essence, author = "P. Wadler", title = "The essence of functional programming (invited talk)", booktitle = "Conference record of the Nineteenth annual {ACM} {SIGPLAN-SIGACT} symposium on {P}rinciples of {P}rogramming {L}anguages", month = "Jan", year = "1992", pages = "1--14" } hugs98-plus-Sep2006/fptools/hslibs/lang/monads/0000755006511100651110000000000010504340142020130 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadCont.lhs0000644006511100651110000000024610127370700022530 0ustar rossross\begin{code} module MonadCont {-# DEPRECATED "This module has moved to Control.Monad.Cont" #-} (module Control.Monad.Cont) where import Control.Monad.Cont \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadEither.lhs0000644006511100651110000000025310127370700023043 0ustar rossross\begin{code} module MonadEither {-# DEPRECATED "This module has moved to Control.Monad.Error" #-} (module Control.Monad.Error) where import Control.Monad.Error \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadError.lhs0000644006511100651110000000025210127370700022713 0ustar rossross\begin{code} module MonadError {-# DEPRECATED "This module has moved to Control.Monad.Error" #-} (module Control.Monad.Error) where import Control.Monad.Error \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadFix.lhs0000644006511100651110000000024210127370700022347 0ustar rossross\begin{code} module MonadFix {-# DEPRECATED "This module has moved to Control.Monad.Fix" #-} (module Control.Monad.Fix) where import Control.Monad.Fix \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadIdentity.lhs0000644006511100651110000000026610127370700023420 0ustar rossross\begin{code} module MonadIdentity {-# DEPRECATED "This module has moved to Control.Monad.Identity" #-} (module Control.Monad.Identity) where import Control.Monad.Identity \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadList.lhs0000644006511100651110000000024610127370701022541 0ustar rossross\begin{code} module MonadList {-# DEPRECATED "This module has moved to Control.Monad.List" #-} (module Control.Monad.List) where import Control.Monad.List \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadRWS.lhs0000644006511100651110000000024210127370701022275 0ustar rossross\begin{code} module MonadRWS {-# DEPRECATED "This module has moved to Control.Monad.RWS" #-} (module Control.Monad.RWS) where import Control.Monad.RWS \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadReader.lhs0000644006511100651110000000025610127370701023031 0ustar rossross\begin{code} module MonadReader {-# DEPRECATED "This module has moved to Control.Monad.Reader" #-} (module Control.Monad.Reader) where import Control.Monad.Reader \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadState.lhs0000644006511100651110000000025210127370701022703 0ustar rossross\begin{code} module MonadState {-# DEPRECATED "This module has moved to Control.Monad.State" #-} (module Control.Monad.State) where import Control.Monad.State \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadTrans.lhs0000644006511100651110000000025210127370701022712 0ustar rossross\begin{code} module MonadTrans {-# DEPRECATED "This module has moved to Control.Monad.Trans" #-} (module Control.Monad.Trans) where import Control.Monad.Trans \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/MonadWriter.lhs0000644006511100651110000000025610127370701023103 0ustar rossross\begin{code} module MonadWriter {-# DEPRECATED "This module has moved to Control.Monad.Writer" #-} (module Control.Monad.Writer) where import Control.Monad.Writer \end{code} hugs98-plus-Sep2006/fptools/hslibs/lang/monads/Monoid.lhs0000644006511100651110000000021610127370702022072 0ustar rossross\begin{code} module Monoid {-# DEPRECATED "This module has moved to Data.Monoid" #-} (module Data.Monoid) where import Data.Monoid \end{code} hugs98-plus-Sep2006/fptools/hslibs/net/0000755006511100651110000000000010504340142016514 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/net/Makefile0000644006511100651110000000026610151654051020165 0ustar rossross# $Id: Makefile,v 1.27 2004/11/26 16:22:01 simonmar Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk PACKAGE = net VERSION = 1.0 PACKAGE_DEPS = network include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/net/BSD.hs0000644006511100651110000000016310127370702017466 0ustar rossrossmodule BSD {-# DEPRECATED "This module has moved to Network.BSD" #-} (module Network.BSD) where import Network.BSD hugs98-plus-Sep2006/fptools/hslibs/net/CGI.lhs0000644006511100651110000000022210127370702017630 0ustar rossross\begin{code} module CGI {-# DEPRECATED "This module has moved to Network.CGI" #-} (module Network.CGI) where import Network.CGI \end{code} hugs98-plus-Sep2006/fptools/hslibs/net/doc/0000755006511100651110000000000010504340142017261 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/net/doc/Socket.xml0000644006511100651110000000102310127561444021242 0ustar rossross <literal>Socket</literal>: The high-level networking interface Socket This module has moved to Network (package network) in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/net/doc/BSD.xml0000644006511100651110000000052010127561444020423 0ustar rossross <literal>BSD</literal>: System database info <indexterm><primary>BSD</primary></indexterm> This module has moved to Network.BSD (package network) in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/net/doc/SocketPrim.xml0000644006511100651110000000056310127561444022102 0ustar rossross <literal>SocketPrim</literal>: The low-level socket binding <indexterm><primary>SocketPrim</primary></indexterm> This module has moved to Network.Socket (package network) in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/net/doc/URI.xml0000644006511100651110000000056710127561444020465 0ustar rossross <literal>URI</literal> URI library This module has moved to Network.URI (package network) in the hierarchical libraries. hugs98-plus-Sep2006/fptools/hslibs/net/doc/net.xml0000644006511100651110000000033110111701567020574 0ustar rossrossThe <literal>net</literal> package: networking support (Darren Moffat supplied the initial version of this library.) &bsd; &socket; &socketprim; &uri; hugs98-plus-Sep2006/fptools/hslibs/net/Socket.lhs0000644006511100651110000000021110127370703020455 0ustar rossross\begin{code} module Socket {-# DEPRECATED "This module has moved to Network.Socket" #-} (module Network) where import Network \end{code} hugs98-plus-Sep2006/fptools/hslibs/net/SocketPrim.hs0000644006511100651110000000020310127370703021132 0ustar rossrossmodule SocketPrim {-# DEPRECATED "This module has moved to Network.Socket" #-} (module Network.Socket) where import Network.Socket hugs98-plus-Sep2006/fptools/hslibs/net/URI.hs0000644006511100651110000000016310127370703017516 0ustar rossrossmodule URI {-# DEPRECATED "This module has moved to Network.URI" #-} (module Network.URI) where import Network.URI hugs98-plus-Sep2006/fptools/hslibs/net/package.conf.in0000644006511100651110000000117110205402200021353 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: False exposed-modules: BSD, CGI, Socket, SocketPrim, URI hidden-modules: #ifdef INSTALLING import-dirs: PKG_LIBDIR"/hslibs-imports/net" #else import-dirs: FPTOOLS_TOP_ABS"/hslibs/net" #endif #ifdef INSTALLING library-dirs: PKG_LIBDIR #else library-dirs: FPTOOLS_TOP_ABS"/hslibs/net" #endif hs-libraries: "HSnet" extra-libraries: include-dirs: includes: depends: network hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: haddock-html: hugs98-plus-Sep2006/fptools/hslibs/text/0000755006511100651110000000000010504340142016712 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/text/doc/0000755006511100651110000000000010504340142017457 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/text/doc/MatchPS.xml0000644006511100651110000000055210111701577021511 0ustar rossross <literal>MatchPS</literal>: The Perl-like matching interface <indexterm><primary>MatchPS library (misc syslib)</primary></indexterm> The MatchPS library is no longer available, please use Text.Regex instead. hugs98-plus-Sep2006/fptools/hslibs/text/doc/Parsec.xml0000644006511100651110000000115110127561444021427 0ustar rossross <literal>Parsec</literal>: Parsing combinators <indexterm><primary>Parsec</primary></indexterm> The Parsec library has been moved to the hierarchical libraries; it can be found in Text.ParserCombinators.Parsec in the parsec package. hugs98-plus-Sep2006/fptools/hslibs/text/doc/Pretty.xml0000644006511100651110000000066210111701600021466 0ustar rossross <literal>Pretty</literal>: Pretty printing combimators <indexterm><primary>Pretty</primary></indexterm> The Pretty library has been moved to the hierarchical libraries; it can be found in Text.PrettyPrint.HughesPJ in the base package. hugs98-plus-Sep2006/fptools/hslibs/text/doc/Regex.xml0000644006511100651110000000050310111701601021244 0ustar rossross <literal>Regex</literal>: The low-level regex matching interface The Regex library has been removed. Please use Text.Regex in the base package. hugs98-plus-Sep2006/fptools/hslibs/text/doc/RegexString.xml0000644006511100651110000000104110111701601022431 0ustar rossross <literal>RegexString</literal>: Regex matching made simple The RegexString library has been moved to the hierarchical libraries; it can be found in Text.Regex in the base package. hugs98-plus-Sep2006/fptools/hslibs/text/doc/text.xml0000644006511100651110000000023410111701601021157 0ustar rossrossThe <literal>text</literal> package: text manipulation &matchps; &parsec; &pretty; ®ex; ®exstring; hugs98-plus-Sep2006/fptools/hslibs/text/html/0000755006511100651110000000000010504340142017656 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/text/html/doc/0000755006511100651110000000000010504340142020423 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/text/html/doc/Html.htm0000644006511100651110000114421107017267317022066 0ustar rossross
Name
Html
Version
0.1
Description
Main import module for the Html combinators
License
The Haskell Html Library is Copyright © Andy Gill, and the Oregon Graduate Institute of Science and Technology, 1999, All rights reserved, and is distributed as free software under the license in the file "License", which is included in the distribution.
Author
Andy Gill
Restrictions
This works with all Haskell 98 compilers.
Tested
Hugs98, GHC 4.03

module Html (
      module Html,
      ) where

import qualified HtmlBlockTable as BT

infixr 3 </>  -- combining table cells 
infixr 4 <->  -- combining table cells
infixr 2 +++  -- combining Html
infixr 7 <<   -- nesting Html
infixl 8 !    -- adding optional arguments

A important property of Html is that all strings inside the structure are already in Html friendly format. For example, use of >,etc.
data Html
{-
 -    ..just..plain..normal..text... but using &copy; and &amb;, etc.
 -}
      = HtmlString String
{-
 -    <thetag {..attrs..}> ..inside.. </thetag>
 -}
      | HtmlTag {                     -- tag with an internal html
              thetag      :: String,
              attrs       :: [HtmlAttr],
              innerHtml :: [Html]
              }

{- These are the index-value pairs.
 - The empty string is a synonym for tags with no arguments.
 - (not strictly HTML, but anyway).
 -}

data HtmlAttr = HtmlAttr String String

Read MARKUP as the class of things that can be validly rendered inside MARKUP tag brackets. So this can be one or more Html's, or a String, for example.
class MARKUP a where
      markup     :: a -> [Html]
      markupList :: [a] -> [Html]

      markup _      = []
      markupList xs = concat (map markup xs)

instance MARKUP Html where
      markup a    = [a]

instance MARKUP Char where
      markup       a = markup [a]
      markupList []  = []
      markupList str = [HtmlString (stringToHtmlString str)]

instance (MARKUP a) => MARKUP [a] where
      markup xs = markupList xs

class ADDATTRS a where
      (!) :: a -> [HtmlAttr] -> a

instance (ADDATTRS b) => ADDATTRS (a -> b) where
      fn ! attr = \ arg -> fn arg ! attr

instance ADDATTRS Html where
      html@(HtmlTag {}) ! newAttrs 
               = html { attrs = attrs html ++ newAttrs }
      html ! _ = html

(<<)            :: (MARKUP a) => ([Html] -> b) -> a        -> b
fn << arg = fn (markup arg)

a +++ b       = concat [markup a,markup b]

noHtmls :: [Html]
noHtmls = [] 

tag  :: String -> [Html] -> Html
tag str       htmls =
      HtmlTag {
              thetag = str,
              attrs = [],
              innerHtml = htmls }

itag :: String -> Html
itag str = tag str []

emptyAttr :: String -> HtmlAttr
emptyAttr s = HtmlAttr s ""

intAttr :: String -> Int -> HtmlAttr
intAttr s i = HtmlAttr s (show i)

strAttr :: String -> String -> HtmlAttr
strAttr s t = HtmlAttr s t

foldHtml :: (String -> [HtmlAttr] -> [a] -> a) 
      -> (String -> a)
      -> Html
      -> a
foldHtml f g (HtmlTag str attr fmls) 
      = f str attr (map (foldHtml f g) fmls) 
foldHtml f g (HtmlString  str)           
      = g str

-- Processing Strings into Html friendly things.
-- This converts a String to a Html String.
stringToHtmlString :: String -> String
stringToHtmlString = concatMap fixChar
    where
      fixChar '<' = "&lt;"
      fixChar '>' = "&gt;"
      fixChar '&' = "&amp;"
      fixChar '"' = "&quot;"
      fixChar c   = [c]               

Classes

instance Show Html where
      showsPrec _ html = showString (prettyHtml html)
      showList htmls   = showString (concat (map show htmls))

instance Show HtmlAttr where
      showsPrec _ (HtmlAttr str val) = 
              showString str .
              showString "=" .
              shows val

Data types

type URL = String

Basic primitives

This is not processed for special chars. use stringToHtml or lineToHtml instead, for user strings, because they understand special chars, like '<'.
primHtml      :: String                                -> Html
primHtml      = HtmlString

Basic Combinators

stringToHtml          :: String                       -> Html
stringToHtml = primHtml . stringToHtmlString 

This converts a string, but keeps spaces as non-line-breakable
lineToHtml            :: String                       -> Html
lineToHtml = primHtml . concatMap htmlizeChar2 . stringToHtmlString 
   where 
      htmlizeChar2 ' ' = "&nbsp;"
      htmlizeChar2 c   = [c]

Html Constructors

-- (automatically generated)

address             :: [Html] -> Html
anchor              :: [Html] -> Html
applet              :: [Html] -> Html
area                ::           Html
basefont            ::           Html
big                 :: [Html] -> Html
blockquote          :: [Html] -> Html
body                :: [Html] -> Html
bold                :: [Html] -> Html
br                  ::           Html
caption             :: [Html] -> Html
center              :: [Html] -> Html
cite                :: [Html] -> Html
ddef                :: [Html] -> Html
define              :: [Html] -> Html
dlist               :: [Html] -> Html
dterm               :: [Html] -> Html
emphasize           :: [Html] -> Html
fieldset            :: [Html] -> Html
font                :: [Html] -> Html
form                :: [Html] -> Html
frame               :: [Html] -> Html
frameset            :: [Html] -> Html
h1                  :: [Html] -> Html
h2                  :: [Html] -> Html
h3                  :: [Html] -> Html
h4                  :: [Html] -> Html
h5                  :: [Html] -> Html
h6                  :: [Html] -> Html
header              :: [Html] -> Html
hr                  ::           Html
image               ::           Html
input               ::           Html
italics             :: [Html] -> Html
keyboard            :: [Html] -> Html
legend              :: [Html] -> Html
li                  :: [Html] -> Html
meta                ::           Html
noframes            :: [Html] -> Html
olist               :: [Html] -> Html
option              :: [Html] -> Html
paragraph           :: [Html] -> Html
param               ::           Html
pre                 :: [Html] -> Html
sample              :: [Html] -> Html
select              :: [Html] -> Html
small               :: [Html] -> Html
strong              :: [Html] -> Html
style               :: [Html] -> Html
sub                 :: [Html] -> Html
sup                 :: [Html] -> Html
table               :: [Html] -> Html
td                  :: [Html] -> Html
textarea            :: [Html] -> Html
th                  :: [Html] -> Html
thebase             ::           Html
thecode             :: [Html] -> Html
thediv              :: [Html] -> Html
thehtml             :: [Html] -> Html
thelink             :: [Html] -> Html
themap              :: [Html] -> Html
thetitle            :: [Html] -> Html
tr                  :: [Html] -> Html
tt                  :: [Html] -> Html
ulist               :: [Html] -> Html
underline           :: [Html] -> Html
variable            :: [Html] -> Html

address             =  tag "ADDRESS"
anchor              =  tag "A"
applet              =  tag "APPLET"
area                = itag "AREA"
basefont            = itag "BASEFONT"
big                 =  tag "BIG"
blockquote          =  tag "BLOCKQUOTE"
body                =  tag "BODY"
bold                =  tag "B"
br                  = itag "BR"
caption             =  tag "CAPTION"
center              =  tag "CENTER"
cite                =  tag "CITE"
ddef                =  tag "DD"
define              =  tag "DFN"
dlist               =  tag "DL"
dterm               =  tag "DT"
emphasize           =  tag "EM"
fieldset            =  tag "FIELDSET"
font                =  tag "FONT"
form                =  tag "FORM"
frame               =  tag "FRAME"
frameset            =  tag "FRAMESET"
h1                  =  tag "H1"
h2                  =  tag "H2"
h3                  =  tag "H3"
h4                  =  tag "H4"
h5                  =  tag "H5"
h6                  =  tag "H6"
header              =  tag "HEAD"
hr                  = itag "HR"
image               = itag "IMG"
input               = itag "INPUT"
italics             =  tag "I"
keyboard            =  tag "KBD"
legend              =  tag "LEGEND"
li                  =  tag "LI"
meta                = itag "META"
noframes            =  tag "NOFRAMES"
olist               =  tag "OL"
option              =  tag "OPTION"
paragraph           =  tag "P"
param               = itag "PARAM"
pre                 =  tag "PRE"
sample              =  tag "SAMP"
select              =  tag "SELECT"
small               =  tag "SMALL"
strong              =  tag "STRONG"
style               =  tag "STYLE"
sub                 =  tag "SUB"
sup                 =  tag "SUP"
table               =  tag "TABLE"
td                  =  tag "TD"
textarea            =  tag "TEXTAREA"
th                  =  tag "TH"
thebase             = itag "BASE"
thecode             =  tag "CODE"
thediv              =  tag "DIV"
thehtml             =  tag "HTML"
thelink             =  tag "LINK"
themap              =  tag "MAP"
thetitle            =  tag "TITLE"
tr                  =  tag "TR"
tt                  =  tag "TT"
ulist               =  tag "UL"
underline           =  tag "U"
variable            =  tag "VAR"

Html Attributes

-- (automatically generated)

action              :: String -> HtmlAttr
align               :: String -> HtmlAttr
alink               :: String -> HtmlAttr
alt                 :: String -> HtmlAttr
altcode             :: String -> HtmlAttr
archive             :: String -> HtmlAttr
background          :: String -> HtmlAttr
base                :: String -> HtmlAttr
bgcolor             :: String -> HtmlAttr
border              :: Int    -> HtmlAttr
bordercolor         :: String -> HtmlAttr
cellpadding         :: Int    -> HtmlAttr
cellspacing         :: Int    -> HtmlAttr
checked             ::           HtmlAttr
clear               :: String -> HtmlAttr
code                :: String -> HtmlAttr
codebase            :: String -> HtmlAttr
color               :: String -> HtmlAttr
cols                :: String -> HtmlAttr
colspan             :: Int    -> HtmlAttr
compact             ::           HtmlAttr
content             :: String -> HtmlAttr
coords              :: String -> HtmlAttr
enctype             :: String -> HtmlAttr
face                :: String -> HtmlAttr
frameborder         :: Int    -> HtmlAttr
height              :: Int    -> HtmlAttr
href                :: String -> HtmlAttr
hspace              :: Int    -> HtmlAttr
httpequiv           :: String -> HtmlAttr
identity            :: String -> HtmlAttr
ismap               ::           HtmlAttr
lang                :: String -> HtmlAttr
link                :: String -> HtmlAttr
marginheight        :: Int    -> HtmlAttr
marginwidth         :: Int    -> HtmlAttr
maxlength           :: Int    -> HtmlAttr
method              :: String -> HtmlAttr
multiple            ::           HtmlAttr
name                :: String -> HtmlAttr
nohref              ::           HtmlAttr
noresize            ::           HtmlAttr
noshade             ::           HtmlAttr
nowrap              ::           HtmlAttr
rel                 :: String -> HtmlAttr
rev                 :: String -> HtmlAttr
rows                :: String -> HtmlAttr
rowspan             :: Int    -> HtmlAttr
rules               :: String -> HtmlAttr
scrolling           :: String -> HtmlAttr
selected            ::           HtmlAttr
shape               :: String -> HtmlAttr
size                :: String -> HtmlAttr
src                 :: String -> HtmlAttr
start               :: Int    -> HtmlAttr
target              :: String -> HtmlAttr
text                :: String -> HtmlAttr
theclass            :: String -> HtmlAttr
thestyle            :: String -> HtmlAttr
thetype             :: String -> HtmlAttr
title               :: String -> HtmlAttr
usemap              :: String -> HtmlAttr
valign              :: String -> HtmlAttr
value               :: String -> HtmlAttr
version             :: String -> HtmlAttr
vlink               :: String -> HtmlAttr
vspace              :: Int    -> HtmlAttr
width               :: String -> HtmlAttr

action              =   strAttr "ACTION"
align               =   strAttr "ALIGN"
alink               =   strAttr "ALINK"
alt                 =   strAttr "ALT"
altcode             =   strAttr "ALTCODE"
archive             =   strAttr "ARCHIVE"
background          =   strAttr "BACKGROUND"
base                =   strAttr "BASE"
bgcolor             =   strAttr "BGCOLOR"
border              =   intAttr "BORDER"
bordercolor         =   strAttr "BORDERCOLOR"
cellpadding         =   intAttr "CELLPADDING"
cellspacing         =   intAttr "CELLSPACING"
checked             = emptyAttr "CHECKED"
clear               =   strAttr "CLEAR"
code                =   strAttr "CODE"
codebase            =   strAttr "CODEBASE"
color               =   strAttr "COLOR"
cols                =   strAttr "COLS"
colspan             =   intAttr "COLSPAN"
compact             = emptyAttr "COMPACT"
content             =   strAttr "CONTENT"
coords              =   strAttr "COORDS"
enctype             =   strAttr "ENCTYPE"
face                =   strAttr "FACE"
frameborder         =   intAttr "FRAMEBORDER"
height              =   intAttr "HEIGHT"
href                =   strAttr "HREF"
hspace              =   intAttr "HSPACE"
httpequiv           =   strAttr "HTTPEQUIV"
identity            =   strAttr "ID"
ismap               = emptyAttr "ISMAP"
lang                =   strAttr "LANG"
link                =   strAttr "LINK"
marginheight        =   intAttr "MARGINHEIGHT"
marginwidth         =   intAttr "MARGINWIDTH"
maxlength           =   intAttr "MAXLENGTH"
method              =   strAttr "METHOD"
multiple            = emptyAttr "MULTIPLE"
name                =   strAttr "NAME"
nohref              = emptyAttr "NOHREF"
noresize            = emptyAttr "NORESIZE"
noshade             = emptyAttr "NOSHADE"
nowrap              = emptyAttr "NOWRAP"
rel                 =   strAttr "REL"
rev                 =   strAttr "REV"
rows                =   strAttr "ROWS"
rowspan             =   intAttr "ROWSPAN"
rules               =   strAttr "RULES"
scrolling           =   strAttr "SCROLLING"
selected            = emptyAttr "SELECTED"
shape               =   strAttr "SHAPE"
size                =   strAttr "SIZE"
src                 =   strAttr "SRC"
start               =   intAttr "START"
target              =   strAttr "TARGET"
text                =   strAttr "TEXT"
theclass            =   strAttr "CLASS"
thestyle            =   strAttr "STYLE"
thetype             =   strAttr "TYPE"
title               =   strAttr "TITLE"
usemap              =   strAttr "USEMAP"
valign              =   strAttr "VALIGN"
value               =   strAttr "VALUE"
version             =   strAttr "VERSION"
vlink               =   strAttr "VLINK"
vspace              =   intAttr "VSPACE"
width               =   strAttr "WIDTH"

-- (automatically generated)

validHtmlTags :: [String]
validHtmlTags = [
      "ADDRESS",
      "A",
      "APPLET",
      "BIG",
      "BLOCKQUOTE",
      "BODY",
      "B",
      "CAPTION",
      "CENTER",
      "CITE",
      "DD",
      "DFN",
      "DL",
      "DT",
      "EM",
      "FIELDSET",
      "FONT",
      "FORM",
      "FRAME",
      "FRAMESET",
      "H1",
      "H2",
      "H3",
      "H4",
      "H5",
      "H6",
      "HEAD",
      "I",
      "KBD",
      "LEGEND",
      "LI",
      "NOFRAMES",
      "OL",
      "OPTION",
      "P",
      "PRE",
      "SAMP",
      "SELECT",
      "SMALL",
      "STRONG",
      "STYLE",
      "SUB",
      "SUP",
      "TABLE",
      "TD",
      "TEXTAREA",
      "TH",
      "CODE",
      "DIV",
      "HTML",
      "LINK",
      "MAP",
      "TITLE",
      "TR",
      "TT",
      "UL",
      "U",
      "VAR"]

validHtmlITags :: [String]
validHtmlITags = [
      "AREA",
      "BASEFONT",
      "BR",
      "HR",
      "IMG",
      "INPUT",
      "META",
      "PARAM",
      "BASE"]

validHtmlAttrs :: [String]
validHtmlAttrs = [
      "ACTION",
      "ALIGN",
      "ALINK",
      "ALT",
      "ALTCODE",
      "ARCHIVE",
      "BACKGROUND",
      "BASE",
      "BGCOLOR",
      "BORDER",
      "BORDERCOLOR",
      "CELLPADDING",
      "CELLSPACING",
      "CHECKED",
      "CLEAR",
      "CODE",
      "CODEBASE",
      "COLOR",
      "COLS",
      "COLSPAN",
      "COMPACT",
      "CONTENT",
      "COORDS",
      "ENCTYPE",
      "FACE",
      "FRAMEBORDER",
      "HEIGHT",
      "HREF",
      "HSPACE",
      "HTTPEQUIV",
      "ID",
      "ISMAP",
      "LANG",
      "LINK",
      "MARGINHEIGHT",
      "MARGINWIDTH",
      "MAXLENGTH",
      "METHOD",
      "MULTIPLE",
      "NAME",
      "NOHREF",
      "NORESIZE",
      "NOSHADE",
      "NOWRAP",
      "REL",
      "REV",
      "ROWS",
      "ROWSPAN",
      "RULES",
      "SCROLLING",
      "SELECTED",
      "SHAPE",
      "SIZE",
      "SRC",
      "START",
      "TARGET",
      "TEXT",
      "CLASS",
      "STYLE",
      "TYPE",
      "TITLE",
      "USEMAP",
      "VALIGN",
      "VALUE",
      "VERSION",
      "VLINK",
      "VSPACE",
      "WIDTH"]

Html colors

aqua          :: String
black         :: String
blue          :: String
fuchsia       :: String
gray          :: String
green         :: String
lime          :: String
maroon        :: String
navy          :: String
olive         :: String
purple        :: String
red           :: String
silver        :: String
teal          :: String
yellow        :: String
white         :: String

aqua          = "aqua"
black         = "black"
blue          = "blue"
fuchsia       = "fuchsia"
gray          = "gray"
green         = "green"
lime          = "lime"
maroon        = "maroon"
navy          = "navy"
olive         = "olive"
purple        = "purple"
red           = "red"
silver        = "silver"
teal          = "teal"
yellow        = "yellow"
white         = "white"

Basic Combinators

linesToHtml :: [String]       -> [Html]

linesToHtml []     = []
linesToHtml (x:[]) = [lineToHtml x]
linesToHtml (x:xs) = lineToHtml x +++ br +++ linesToHtml xs

Html abbriviations

primHtmlChar  :: String -> Html
copyright     :: Html
spaceHtml     :: Html
bullet        :: Html
p             :: [Html] -> Html

primHtmlChar  = \ x -> primHtml ("&" ++ x ++ ";")
copyright     = primHtmlChar "copy"
spaceHtml     = primHtmlChar "nbsp"
bullet        = primHtmlChar "#149"

p             = paragraph

Html tables

class HTMLTABLE ht where
      cell :: ht -> HtmlTable

instance HTMLTABLE HtmlTable where
      cell = id

instance HTMLTABLE Html where
      cell h = 
         let
              cellFn x y = h ! (add x colspan $ add y rowspan $ [])
              add 1 fn rest = rest
              add n fn rest = fn n : rest
              r = BT.single cellFn
         in 
              mkHtmlTable r

We internally represent the Cell inside a Table with an object of the type 
 	Int -> Int -> Html
When we render it later, we find out how many columns or rows this cell will span over, and can include the correct colspan/rowspan command.
newtype HtmlTable 
      = HtmlTable (BT.BlockTable (Int -> Int -> Html))


(</>),above,(<->),beside :: (HTMLTABLE ht1,HTMLTABLE ht2)
                       => ht1 -> ht2 -> HtmlTable
aboves,besides                 :: (HTMLTABLE ht) => [ht] -> HtmlTable
simpleTable            :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html


mkHtmlTable :: BT.BlockTable (Int -> Int -> Html) -> HtmlTable
mkHtmlTable r = HtmlTable r

We give both infix and nonfix, take your pick. Notice that there is no concept of a row/column of zero items.
above   a b = combine BT.above (cell a) (cell b)
(</>)         = above
beside  a b = combine BT.beside (cell a) (cell b)
(<->) = beside

combine fn (HtmlTable a) (HtmlTable b) = mkHtmlTable (a `fn` b)

Both aboves and besides presume a non-empty list. here is no concept of a empty row or column in these table combinators.
aboves []  = error "aboves []"
aboves xs  = foldr1 (</>) (map cell xs)
besides [] = error "besides []"
besides xs = foldr1 (<->) (map cell xs)

renderTable takes the HtmlTable, and renders it back into and Html object.
renderTable :: BT.BlockTable (Int -> Int -> Html) -> [Html]
renderTable theTable
      = [tr [theCell x y | (theCell,(x,y)) <- theRow ]
                      | theRow <- BT.getMatrix theTable]

instance MARKUP HtmlTable where
      markup (HtmlTable tab) = renderTable tab

instance Show HtmlTable where
      showsPrec _ (HtmlTable tab) = shows (renderTable tab)

If you can't be bothered with the above, then you can build simple tables with simpleTable. Just provide the attributes for the whole table, attributes for the cells (same for every cell), and a list of lists of cell contents, and this function will build the table for you. It does presume that all the lists are non-empty, and there is at least one list. Different length lists means that the last cell gets padded. If you want more power, then use the system above, or build tables explicitly.
simpleTable attr cellAttr lst
      = table ! attr 
          <<  (aboves 
              . map (besides . map ((td ! cellAttr) . markup))
              ) lst

Tree Displaying Combinators

The basic idea is you render your structure in the form of this tree, and then use treeHtml to turn it into a Html object with the structure explicit.
data HtmlTree
      = HtmlLeaf [Html]
      | HtmlNode [Html] [HtmlTree] [Html]

treeHtml :: [String] -> HtmlTree -> Html
treeHtml colors h = table ! [
                    border 0,
                    cellpadding 0,
                    cellspacing 2] << treeHtml' colors h
     where
      manycolors = scanr (:) []

      treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable
      treeHtmls c ts = aboves (zipWith treeHtml' c ts)

      treeHtml' :: [String] -> HtmlTree -> HtmlTable
      treeHtml' (c:_) (HtmlLeaf leaf) = cell
                                         (td ! [width "100%"] 
                                            << bold  
                                               << leaf)
      treeHtml' (c:cs@(c2:_)) (HtmlNode hopen ts hclose) =
          if null ts && null hclose
          then
              cell hd 
          else if null ts
          then
              hd </> bar `beside` (td ! [bgcolor c2] << spaceHtml)
                 </> tl
          else
              hd </> (bar `beside` treeHtmls morecolors ts)
                 </> tl
        where
              -- This stops a column of colors being the same
              -- color as the immeduately outside nesting bar.
              morecolors = filter ((/= c).head) (manycolors cs)
              bar = td ! [bgcolor c,width "10"] << spaceHtml
              hd = td ! [bgcolor c] << hopen
              tl = td ! [bgcolor c] << hclose
      treeHtml' _ _ = error "The imposible happens"

instance MARKUP HtmlTree where
      markup x = [treeHtml treeColors x]

-- type "length treeColors" to see how many colors are here.
treeColors = ["#88ccff","#ffffaa","#ffaaff","#ccffff"] ++ treeColors

Html Debugging Combinators

This uses the above tree rendering function, and displays the Html as a tree structure, allowing debugging of what is actually getting produced.
debugHtml :: (MARKUP a) => a -> Html
debugHtml obj = table ! [border 0] << 
                  ( th ! [bgcolor "#008888"] 
                     << underline
                       << "Debugging Output"
               </>  td << (map (markup . debug) hobj)
              )
  where
      hobj = markup obj

      debug :: Html -> HtmlTree
      debug (HtmlString str) = HtmlLeaf (spaceHtml : markup str)
      debug (HtmlTag {
              thetag = thetag,
              innerHtml = innerHtml,
              attrs  = attrs
              }) = 
              case innerHtml of
                [] -> HtmlNode [hd] [] []
                xs -> HtmlNode [hd] (map debug xs) [tl]
        where
              args = unwords (map show attrs)
              hd = font ! [size "1"] << ("<" ++ thetag ++ " " ++ args ++ ">")
              tl = font ! [size "1"] << ("</" ++ thetag ++ ">")

Hotlink datatype

data HotLink = HotLink {
      hotLinkURL        :: URL,
      hotLinkContents   :: [Html],
      hotLinkAttributes :: [HtmlAttr]
      } deriving Show

instance MARKUP HotLink where
      markup hl = [anchor ! (href (hotLinkURL hl) : hotLinkAttributes hl)
                      << hotLinkContents hl]

hotlink :: URL -> [Html] -> HotLink
hotlink url h = HotLink {
      hotLinkURL = url,
      hotLinkContents = h,
      hotLinkAttributes = [] }

More Combinators

-- (Abridged from Erik Meijer's Original Html library)

ordList   :: (MARKUP a) => [a] -> Html
ordList items = olist << map (li <<) items

unordList :: (MARKUP a) => [a] -> Html
unordList items = ulist << map (li <<) items

defList   :: (MARKUP a,MARKUP b) => [(a,b)] -> Html
defList items
 = dlist << [ [ dterm << bold << dt, ddef << dd ] | (dt,dd) <- items ]


widget :: String -> String -> [HtmlAttr] -> Html
widget w n attrs = input ! ([thetype w,name n] ++ attrs)

checkbox :: String -> String -> Html
hidden   :: String -> String -> Html
radio    :: String -> String -> Html
reset    :: String -> String -> Html
submit   :: String -> String -> Html
password :: String           -> Html
textfield :: String          -> Html
afile    :: String           -> Html
clickmap :: String           -> Html

checkbox n v = widget "CHECKBOX" n [value v]
hidden   n v = widget "HIDDEN"   n [value v]
radio    n v = widget "RADIO"    n [value v]
reset    n v = widget "RESET"    n [value v]
submit   n v = widget "SUBMIT"   n [value v]
password n   = widget "PASSWORD" n []
textfield n  = widget "TEXT"     n []
afile    n   = widget "FILE"     n []
clickmap n   = widget "IMAGE"    n []

menu :: String -> [Html] -> Html
menu n choices
   = select ! [name n] << [ option << p << choice | choice <- choices ]

gui :: String -> [Html] -> Html
gui act = form ! [action act,method "POST"]

Html Rendering

Uses the append trick to optimize appending. The output is quite messy, because space matters in HTML, so we must not generate needless spaces.
renderHtml :: (MARKUP html) => html -> String
renderHtml theHtml =
      renderMessage ++ renderHtml' 0 (tag "HTML" << theHtml) "\n"

renderMessage =
      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 FINAL//EN\">\n" ++
      "<!--Rendered using the Haskell Html Library v0.1-->\n"

Warning: spaces matters in HTML. You are better using renderHtml. This is intentually very inefficent to "encorage" this, but the neater version in easier when debugging.
-- Local Utilities
prettyHtml :: (MARKUP html) => html -> String
prettyHtml theHtml = unlines $ concat $ map prettyHtml' $ markup theHtml

renderHtml' :: Int -> Html -> ShowS
renderHtml' _ (HtmlString str) = (++) str
renderHtml' n (HtmlTag
              { thetag = name,
                innerHtml = html,
                attrs = attrs })
      = if null html && elem name validHtmlITags
        then renderTag True name attrs n
        else (renderTag True name attrs n
             . foldr (.) id (map (renderHtml' (n+2)) html)
             . renderTag False name [] n)

prettyHtml' :: Html -> [String]
prettyHtml' (HtmlString str) = [str]
prettyHtml' (HtmlTag
              { thetag = name,
                innerHtml = html,
                attrs = attrs })
      = if null html && elem name validHtmlITags
        then 
         [rmNL (renderTag True name attrs 0 "")]
        else
         [rmNL (renderTag True name attrs 0 "")] ++ 
          shift (concat (map prettyHtml' html)) ++
         [rmNL (renderTag False name [] 0 "")]


shift = map (\x -> "   " ++ x)
rmNL = filter (/= '\n')

This prints the Tags The lack of spaces in intentunal, because Html is actually space dependant.
renderTag :: Bool -> String -> [HtmlAttr] -> Int -> ShowS
renderTag x name attrs n r
      = open ++ name ++ rest attrs ++ ">" ++ r
  where
      open = if x then "<" else "</"
      
      nl = "\n" ++ replicate (n `div` 8) '\t' 
                ++ replicate (n `mod` 8) ' '

      rest []   = nl
      rest attr = " " ++ unwords (map showPair attr) ++ nl

      showPair :: HtmlAttr -> String
      showPair (HtmlAttr tag val)
              = tag ++ " = \"" ++ val  ++ "\""

-- End of Local Utilities

hugs98-plus-Sep2006/fptools/hslibs/text/html/doc/HtmlBlockTable.htm0000644006511100651110000007324207017267317024015 0ustar rossross
Name
HtmlBlockTable
Version
0.1
Description
Provides support for building abstract (block) tables.
License
The Haskell Html Library is Copyright © Andy Gill, and the Oregon Graduate Institute of Science and Technology, 1999, All rights reserved, and is distributed as free software under the license in the file "License", which is included in the distribution.
Author
Andy Gill
Restrictions
This works with all Haskell 98 compilers.
Tested
Hugs98, GHC 4.03

module HtmlBlockTable (

-- Datatypes:

      BlockTable,             -- abstract

-- Contruction Functions: 

      single,
      above,
      beside,

-- Investigation Functions: 

      getMatrix,
      showsTable,
      showTable,

      ) where

infixr 4 `beside`
infixr 3 `above`

These combinators can be used to build formated 2D tables. The specific target useage is for HTML table generation. 
   Examples of use:

  	> table1 :: BlockTable String
  	> table1 = single "Hello"	+-----+
					|Hello|
	  This is a 1x1 cell		+-----+
	  Note: single has type
	 
		single :: a -> BlockTable a
	
	  So the cells can contain anything.
	
	> table2 :: BlockTable String
	> table2 = single "World"	+-----+
					|World|
					+-----+


	> table3 :: BlockTable String
	> table3 = table1 %-% table2	+-----%-----+
					|Hello%World|
	 % is used to indicate		+-----%-----+
	 the join edge between
	 the two Tables.  

	> table4 :: BlockTable String
	> table4 = table3 %/% table2	+-----+-----+
					|Hello|World|
	  Notice the padding on the	%%%%%%%%%%%%%
	  smaller (bottom) cell to	|World      |
	  force the table to be a	+-----------+
	  rectangle.

	> table5 :: BlockTable String
	> table5 = table1 %-% table4	+-----%-----+-----+
					|Hello%Hello|World|
	  Notice the padding on the	|     %-----+-----+
	  leftmost cell, again to	|     %World      |
	  force the table to be a	+-----%-----------+
	  rectangle.
 
   Now the table can be rendered with processTable, for example:
	Main> processTable table5
	[[("Hello",(1,2)),
	  ("Hello",(1,1)),
	  ("World",(1,1))],
	 [("World",(2,1))]] :: [[([Char],(Int,Int))]]
	Main>

Contruction Functions

Perhaps one day I'll write the Show instance to show boxes aka the above ascii renditions.
instance (Show a) => Show (BlockTable a) where
      showsPrec p = showsTable

type TableI a = [[(a,(Int,Int))]] -> [[(a,(Int,Int))]]

data BlockTable a = Table (Int -> Int -> TableI a) Int Int

You can create a (1x1) table entry
single :: a -> BlockTable a
single a = Table (\ x y z -> [(a,(x+1,y+1))] : z) 1 1

You can compose tables, horizonally and vertically
above  :: BlockTable a -> BlockTable a -> BlockTable a
beside :: BlockTable a -> BlockTable a -> BlockTable a

t1 `above` t2 = trans (combine (trans t1) (trans t2) (.))

t1 `beside` t2 = combine t1 t2 (\ lst1 lst2 r ->
    let
      -- Note this depends on the fact that
      -- that the result has the same number
      -- of lines as the y dimention; one list
      -- per line. This is not true in general
      -- but is always true for these combinators.
      -- I should assert this!
      -- I should even prove this.
      beside (x:xs) (y:ys) = (x ++ y) : beside xs ys
      beside (x:xs) []     = x        : xs ++ r
      beside []     (y:ys) = y        : ys ++ r
      beside []     []     =                  r
    in
      beside (lst1 []) (lst2 []))

trans flips (transposes) over the x and y axis of the table. It is only used internally, and typically in pairs, ie. (flip ... munge ... (un)flip).
trans :: BlockTable a -> BlockTable a
trans (Table f1 x1 y1) = Table (flip f1) y1 x1

combine :: BlockTable a 
      -> BlockTable b 
      -> (TableI a -> TableI b -> TableI c) 
      -> BlockTable c
combine (Table f1 x1 y1) (Table f2 x2 y2) comb = Table new_fn (x1+x2) max_y
    where
      max_y = max y1 y2
      new_fn x y =
         case compare y1 y2 of
          EQ -> comb (f1 0 y)             (f2 x y)
          GT -> comb (f1 0 y)             (f2 x (y + y1 - y2))
          LT -> comb (f1 0 (y + y2 - y1)) (f2 x y)

Investigation Functions

This is the other thing you can do with a Table; turn it into a 2D list, tagged with the (x,y) sizes of each cell in the table.
getMatrix :: BlockTable a -> [[(a,(Int,Int))]]
getMatrix (Table r _ _) = r 0 0 []

You can also look at a table
showsTable :: (Show a) => BlockTable a -> ShowS
showsTable table = shows (getMatrix table)

showTable :: (Show a) => BlockTable a -> String
showTable table = showsTable table ""

hugs98-plus-Sep2006/fptools/hslibs/text/html/doc/HtmlExample.htm0000644006511100651110000002665507017267317023414 0ustar rossross This defines an example Html page.
import Html

We define our page as:

htmlPage :: [Html]
htmlPage
      = header
        << thetitle 
           << "My Haskell Home Page"
   +++ body ! [bgcolor "#aaff88"] << theBody

The definition of htmlPage reads: First we have a header, which contains a title, which contain the text "My Haskell Home Page". After this, we have a body, with attribute bgcolor set to #aaff88, and this body contains the Html defined by theBody. Don't worry about the type of things right now, just try get a feel for what the combinators look like.
theBody :: [Html]
theBody =
      table ! [border 0] << tableContents
  +++ br
  +++ p << message
message 
 = "Haskell is a general purpose, purely functional programming language."

This reads: the body is a table (with a border), the contents of the table are defined by tableContents. This is followed by a br (an explicit line break), and a paragraph containing a message.

Now need to define the tableContents. For this we use our special table combinators.

tableContents :: HtmlTable
tableContents = (haskell `above` purely) `beside` lambda
    where
      haskell = td ! [align "center"]
                  << font ![size "7",face "Arial Black"] 
                      << "Haskell"
      purely  = td << font ! [size "6"] 
                      << "A Purely Functional Language"
      lambda  = td << image ! [src "lambda.gif"]

This produces a table of cells, which nest like this:

haskell lambda
purely

Even though the lambda box sits over two rows, the semantics of above and beside handle this correctly.

Now we can render our HTML page.
main = writeFile "example.htm" (renderHtml htmlPage)

hugs98-plus-Sep2006/fptools/hslibs/text/html/doc/doc.htm0000644006511100651110000016634407017267317021741 0ustar rossross Haskell Libraries : Html Library Documentation

Here are some notes on using the HTML libraries. This is rather sketchy right now; hopefully it will improve over time.

A First Example

As a first example, lets print the following page.

Haskell
A Purely Functional Language

Haskell is a general purpose, purely functional programming language.

First, you just import the module Html to use these combinators.

import Html

We define our page as:

htmlPage :: [Html]
htmlPage
      = header
        << thetitle 
           << "My Haskell Home Page"
   +++ body ! [bgcolor "#aaff88"] << theBody

The definition of htmlPage reads: First we have a header, which contains a title, which contains the text "My Haskell Home Page". After this, we have a body, with attribute bgcolor set to #aaff88, and this body contains the Html defined by theBody. Don't worry about the type of things right now, just try get a feel for what the combinators look like.
theBody :: [Html]
theBody =
      table ! [border 0] << tableContents
  +++ br
  +++ p << message
message 
 = "Haskell is a general purpose, purely functional programming language."

This reads: the body is a table (with a border), the contents of the table are defined by tableContents. This is followed by a br (an explicit line break), and a paragraph containing a message.

Now need to define the tableContents. For this we use our special table combinators.

tableContents :: HtmlTable
tableContents = (haskell `above` purely) `beside` lambda
    where
      haskell = td ! [align "center"]
                  << font ![size "7",face "Arial Black"] 
                      << "Haskell"
      purely  = td << font ! [size "6"] 
                      << "A Purely Functional Language"
      lambda  = td << image ! [src "lambda.gif"]

This produces a table of cells, which nest like this:

haskell lambda
purely

Even though the lambda box sits over two rows, the semantics of above and beside handle this correctly.

Now we can render our HTML page.
main = writeFile "example.htm" (renderHtml htmlPage)

The whole page (put in a box) looks like this:
Haskell
A Purely Functional Language

Haskell is a general purpose, purely functional programming language.
The raw Html produce by these macros is: 
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 FINAL//EN">
<!--Rendered using the Haskell Html Library v0.1-->
<HTML
><HEAD
  ><TITLE
    >My Haskell Home Page</TITLE
    ></HEAD
  ><BODY BGCOLOR = "#aaff88"
  ><TABLE BORDER = "1"
    ><TR
      ><TD ALIGN = "center"
	><FONT SIZE = "7" FACE = "Arial Black"
	  >Haskell</FONT
	  ></TD
	><TD ROWSPAN = "2"
	><IMG SRC = "lambda.gif"
	  ></TD
	></TR
      ><TR
      ><TD
	><FONT SIZE = "6"
	  >A Purely Functional Language</FONT
	  ></TD
	></TR
      ></TABLE
    ><BR
    ><P
    >Haskell is a general purpose, purely functional programming language.</P
    ></BODY
  ></HTML
>
This might look strange, but in HTML, space matters, and this layout style (borrowed from the York XML team) is used to avoid extra spaces.

Domain Specific Combinators for HTML

Lets look at the type of some combinators.
header              :: [Html] -> Html
thetitle            :: [Html] -> Html
body                :: [Html] -> Html
stringToHtml        :: String -> Html

These all take a list of Html (the Html inside the specific constructor). Ignoring the bgcolor argument for now, we could write htmlPage as:
htmlPage :: [Html]
htmlPage = 
    [header [thetitle [stringToHtml "My Haskell Home Page"]],
     body theBody]

Some simple combinators, however, make things much clearer.
class MARKUP a where { markup  :: a -> [Html] }
infixr 7 <<
(<<) :: (MARKUP a) => ([Html] -> b) -> a  -> b
fn << arg = fn (markup arg)

This nesting takes a function that maps a list of Html to something, and inserts a conversion function (called markup) round the second argument, then completes the application.

MARKUP is overloaded at Html, [Html], and String, meaning that any of them are a valid second argument to <<.

So we can write:
htmlPage :: [Html]
htmlPage = 
   [header 
      << thetitle 
         << "My Haskell Home Page",
     body << theBody]

Which expresses the nesting in a clear way. Now we need a way of appending two MARKUP objects:

infixr 2 +++  -- combining Html
(+++) :: (MARKUP a,MARKUP b) => a -> b -> [Html]
a +++ b = concat [markup a,markup b]

So we can now write:
htmlPage :: [Html]
htmlPage = 
   header 
      << thetitle 
         << "My Haskell Home Page",
  +++ body << theBody

Now we need to be able to add arguments.

infixl 8 !    -- adding optional arguments
class ADDATTRS a where
      (!) :: a -> [HtmlAttr] -> a

This says that we can use ! to add arguments. ADDATTRS is overloaded for (a -> Html) and Html. (We actually jump through a few hoops here to allow Haskell98 complience). So ...
(body ! [bgcolor "orange"]) :: [Html] -> Html

... but the body also has the attribute, bgcolor "orange". So we can now say:
htmlPage :: [Html]
htmlPage = 
   header 
      << thetitle 
         << "My Haskell Home Page",
  +++ body ! [ bgcolor "orange"] << theBody

This library provides many specific functions like header and thetitle, as well as attribute builders, like bgcolor. Look at the source for more details.

Building Tables

We provide the following to help build tables.
cell :: (HTMLTABLE ht) => ht -> HtmlTable
(</>),above,(<->),beside 
     :: (HTMLTABLE ht1,HTMLTABLE ht2) => ht1 -> ht2 -> HtmlTable
aboves,besides
     :: (HTMLTABLE ht) => [ht] -> HtmlTable

HTML has instances for both Html and HtmlTable. cell can be used to wrap up individual elements as (small) tables. above, aboves, etc, can be used to construct larger tables. In many cases, the overloading allows the cell construct to be omitted.
tableContents = (haskell `above` purely) `beside` lambda
      haskell = td ! [align "center"]
                  << font ![size "7",face "Arial Black"] 
                      << "Haskell"
      purely  = td << font ! [size "6"] 
                      << "A Purely Functional Language"
      lambda  = td << image ! [src "lambda.gif"]

Here we have implicit cell's being inserted because we are using above and beside.

To get a table contents from a HtmlTable, just use markup, or its DSL sibling, <<, because HtmlTable is also an instance of MARKUP.

example :: Html
example = table ! [border 0] << tableContents

Debugging and Displaying Nested Structures

Consider if we now want to debug the above example.
example :: Html
example = table ! [border 0] << tableContents

How can we do this? Html is an instance of Show, giving. 
<TABLE BORDER = "0">
   <TR>
      <TD ALIGN = "center">
         <FONT SIZE = "7" FACE = "Arial Black">
            Haskell
         </FONT>
      </TD>
      <TD ROWSPAN = "2">
         <IMG SRC = "lambda.gif">
      </TD>
   </TR>
   <TR>
      <TD>
         <FONT SIZE = "6">
            A Purely Functional Language
         </FONT>
      </TD>
   </TR>
</TABLE>
However, we can do better. This is pure ASCII. Why not use HTML to debug HTML?
example2 :: Html
example2 = debugHtml example

Rendering example2 gives:
Debugging Output
<TABLE BORDER="0">
 <TR >
 <TD ALIGN="center">
 <FONT SIZE="7" FACE="Arial Black">
  Haskell
</FONT>
</TD>
<TD ROWSPAN="2">
 <IMG SRC="lambda.gif">
</TD>
</TR>
<TR >
 <TD >
 <FONT SIZE="6">
  A Purely Functional Language
</FONT>
</TD>
</TR>
</TABLE>

The nesting here is explicit. This is especially useful when you have a non-trivial piece of code that generates Html, and you want to see whats actually happening.

You can use the mechanism used by the debugHtml function to display your own nesting structures! Just translate your data into an HtmlTree structure.

data HtmlTree
      = HtmlLeaf [Html]
      | HtmlNode [Html] [HtmlTree] [Html]

HtmlLeaf are printed without background color, and HtmlNode displays the first [Html] as a header, the subtrees nested, and the second [Html] as a footer. Here is how we transliterate the Html structure in the debugging code

debug :: Html -> HtmlTree
debug (HtmlString str) = HtmlLeaf (spaceHtml : markup str)
debug (HtmlTag {
        thetag = thetag,
        innerHtml = innerHtml,
        attrs  = attrs
        }) = 
        case innerHtml of
          [] -> HtmlNode [hd] [] []
          xs -> HtmlNode [hd] (map debug xs) [tl]
  where
        args = unwords (map show attrs)
        hd = font ! [size "1"] << ("<" ++ thetag ++ " " ++ args ++ ">")
        tl = font ! [size "1"] << ("</" ++ thetag ++ ">")

HtmlTree is an instance of MARKUP, so if you have a tree called treeExample, you can use:

exampleTree :: HtmlTree
example :: [Html]
example = br +++ exampleTree +++ br

hugs98-plus-Sep2006/fptools/hslibs/text/html/doc/intro.htm0000644006511100651110000000464307017267317022320 0ustar rossross Haskell Libraries : Html Library

The Haskell Html Library

This is the first release of the Haskell Html combinators. (Version 0.1)

Using HTML is a great way of displaying structured data, allowing neat presentation using tricks like boxing, color, fonts and indentation levels. This library is a collection of combinators, allowing your Haskell programs to generate HTML.

This release has
  • Full support for HTML 3.2, which is the version of HTML supported by most browsers.
  • An HTML DSL language. Overloaded combinators are used to allow clean specification of your HTML text.
  • Special support for generating tables.
  • Tree displaying functions, where depth is represented by indentation of tables.
  • Debugging functions, that let you view your HTML, as explicit nested structures.

We also have a LICENSE and copyright to protect the truly paranoid. I've used these modules for several months now, and find them very useful. I hope you do too.

Enjoy!

Andy Gill

Modules in HTML Library

HtmlBlockTable
Generic support for 2-D tables.
Html
The main interface for the HTML library, including the HTML DSL.

Extra Modules

HtmlExample
Example of use of the library.
hugs98-plus-Sep2006/fptools/hslibs/text/html/doc/lambda.gif0000644006511100651110000000767607017267317022373 0ustar rossrossGIF87aÙô÷3f™Ìÿ3333f3™3Ì3ÿff3fff™fÌfÿ™™3™f™™™Ì™ÿÌÌ3ÌfÌ™ÌÌÌÿÿÿ3ÿfÿ™ÿÌÿÿ3333f3™3Ì3ÿ3333333f33™33Ì33ÿ3f3f33ff3f™3fÌ3fÿ3™3™33™f3™™3™Ì3™ÿ3Ì3Ì33Ìf3Ì™3ÌÌ3Ìÿ3ÿ3ÿ33ÿf3ÿ™3ÿÌ3ÿÿff3fff™fÌfÿf3f33f3ff3™f3Ìf3ÿffff3fffff™ffÌffÿf™f™3f™ff™™f™Ìf™ÿfÌfÌ3fÌffÌ™fÌÌfÌÿfÿfÿ3fÿffÿ™fÿÌfÿÿ™™3™f™™™Ì™ÿ™3™33™3f™3™™3Ì™3ÿ™f™f3™ff™f™™fÌ™fÿ™™™™3™™f™™™™™Ì™™ÿ™Ì™Ì3™Ìf™Ì™™ÌÌ™Ìÿ™ÿ™ÿ3™ÿf™ÿ™™ÿÌ™ÿÿÌÌ3ÌfÌ™ÌÌÌÿÌ3Ì33Ì3fÌ3™Ì3ÌÌ3ÿÌfÌf3ÌffÌf™ÌfÌÌfÿ̙̙3Ì™fÌ™™Ì™ÌÌ™ÿÌÌÌÌ3ÌÌfÌÌ™ÌÌÌÌÌÿÌÿÌÿ3ÌÿfÌÿ™ÌÿÌÌÿÿÿÿ3ÿfÿ™ÿÌÿÿÿ3ÿ33ÿ3fÿ3™ÿ3Ìÿ3ÿÿfÿf3ÿffÿf™ÿfÌÿfÿÿ™ÿ™3ÿ™fÿ™™ÿ™Ìÿ™ÿÿÌÿÌ3ÿÌfÿÌ™ÿÌÌÿÌÿÿÿÿÿ3ÿÿfÿÿ™ÿÿÌÿÿÿ (((555CCCPPP]]]kkkxxx†††“““¡¡¡®®®»»»ÉÉÉÖÖÖäääñññÿÿÿ!ù×,Ùôþ¯ H° Áƒ´Â°¡Ã‡JœH±¢Å‹3jÜÈ!D( CŠ ÑJÇ“(Sª\ɲ¢Ã‘0cŽŒØ²¦Í›8U6”©¤§ÏŸ@•Ìt˜³¨Ñ£FwŠš-€§P£FýI’(Ò«X³ZT r›¶¯ÚšŠ•J–¬Ïª µª]«–aH%Ûâ‚ +ÖiÙ»S…‚lȶ¯ß›VÞÂ+l]¼ˆ¡öÜ›ö¯ãÇCéÉ­2a¯†Ç&N| _È C{œ¬Ä[eË„çÒÀºµëÍy…~M²ÛÒÞrŸævù«ëßÀYÃ~ºØ³ÉÚÈû2ì™»ùnÂÁ£K°Yoãäد.Wòí[sݧ§þ‹Î™qöóE·wïþ½òø÷äñZ?Ž¾>K+=ׯo¿pÄ‹]g߀áÎúuçß‚ÿÝ jdà®Çà…¿É'[„Rá„Ca…–Øš†v¨"A †(âˆ&ÆHƒÆ­h£@“¹â2ö8£YžÝ¸"~:ºè£eY'd‡-yä‘IÖ¸$M:ù$’@Ò7e}Jâ•P–µ×–õUi$˜aJµ!™çui%šiN$›É™ù%œOŠ™" ‰ã§Žx^¥–|B…Ÿˆ†(˜bÎY(dˆFº¨ Y>jh¤~NÊh¥–þ…i¦šæ©g§~A1Î8’†J©šŽ’ªÕ©ÿ°¢ &9䔳è]­ºŠU¬§Æèç©´[k9ækì9¢²ª«VJð:†.þ:Ž°´–C¬±Åž£-–dåºlQÎ^Haˆˆ+¬µØš£íºÈÊå·H™Êë‚ÝK®8æ‹.¶ìj‹:1â ïQJÛk¹­go8âL”-»ÿþ0E-97§ðñÇ% \1NÔö×ÍÉwwÒÇ cøîÈ6•üÞÉ47§Ë-/(2Ì,]üÞi4wÓ’8K¬óË<«ä³xÛìÆÍÉ6 ðÑÝ&½’ÌÓ]¶NRS­¦Õ)-õeÛ(aÎ Þ6JbGÖeH¡íßÎkk„µtª•·Üþð9X7Gw—jÚ`Åwßeým÷¹âÕVV‡G·âUk­­ÒÕ%–VEÏmå]~ùtš7¥Väâ© zE¢[›yéfŸÎ²çRº:B­c.xél±Ü.âRAqûD¹K÷”æ}ýËnI/QëÆCUW_ýþþ^Y¶;?ôñE•MöXUÏ5 *ŽV“¤× hT¬˜´¥SñsO´¦•ŽZ5ëIÝ:Ö¢s«h%ê]•ŠSº r¡ÜÄ«[SºWÎÔ¯u-¨8{¤SF/«°d¬²áØ'µ—`=+š¶•DaZS²=¢leÑYJfv®pjʺڨ֯Êu©hR-gþÇH¯ª´2Ëj;k[0ÞF¨W2Ý5v‹ÇÒþ·1ÚÜpg[Ü‘š–¯“îrGKÅ©ô6ŠÈ5‘r§ËÚÖ&2»%Ú®@ˆÛ\ѕîx™{H%\—‡àÅx×KÝ,Úõ¼A kj³q9Ò¼pŒï…æ;ò¶×‘f Ì^Tv•¿=llÕ[ÿ:X±zLð‚Ìà?ÀV<-l'Ìß„XøÂJ|¯ö4ìÄÀ(öl€_Û×ý–X"'þðe±‹ÞE¹øÅ0~,`CLcSØÄA¶¬ŠA'âÛ¸"+ô0i1LdÃêL?6HŽ§ìÜ ²¸ÅGVÈ–¹ìÞ-ö8PYÖr’Éþ¼äº}>Ó»H”ë{¢ªÞ0ÂWÆr˜'2æêÙƒo~OšÒgûÖÖˆôžù\è:“õίMï3âI{¹Èh4BæÌÚ2úÌxÒ4’¥ÌfH[Y³Á5¡Ø‹VP2m%1J*Íe¯.ÑSõ¦YÝjOßפÓõ®yíÓƒúÉ*¡µŸ©<<`¿nÑ”æuZ÷D9X÷IÂV§“è­jc:ÔÙNÈœéÜjßÎÙщ3K”mè§ïÜÇ&ñ¤“-mÂÞúÛ6ž·JÆ=Ç6[J2§±žõ½ovÿõÁÞ¸À±î‰ð›¶‡VºÓ íYÜÑŠy·(KÂq«¤'Þ'øJ9ÿªw¼ã¾Ä·¼‹òðò¦X9'?yz@¢pI‹|%-/¯P6.“ž‡dæ wrÈ2nr¿µÛ¾”ŒÏe²L•¯Ü($·w,•¾t˜àϨNuÅq~qŒé3¯zÏãt­ß¼&EŸ#دð ¸=(6øµ¤n¢G=/þ–PÛßÎ÷žt3èFÞzK"É)í|8,&àv›ä¼½kû(•à@ħQ' 7;³î®÷æ}+m·–åE¸’‰yYI»Ú?ï’ЋÞò¥§ùÜ'Ûð“^MžGŠ[H#:Ø+>Öfo import Html

We define our page as: > htmlPage :: Html > htmlPage > = header > << thetitle > << "My Haskell Home Page" > +++ body ! [bgcolor "#aaff88"] << theBody The definition of htmlPage reads: First we have a header, which contains a title, which contain the text "My Haskell Home Page". After this, we have a body, with attribute bgcolor set to #aaff88, and this body contains the Html defined by theBody. Don't worry about the type of things right now, just try get a feel for what the combinators look like. > theBody :: Html > theBody = > table ! [border 0] << tableContents > +++ br > +++ p << message > message > = "Haskell is a general purpose, purely functional programming language."

This reads: the body is a table (with a border), the contents of the table are defined by <:h>tableContents. This is followed by a br (an explicit line break), and a paragraph containing a message.

Now need to define the tableContents. For this we use our special table combinators. > tableContents :: HtmlTable > tableContents = (haskell `above` purely) `beside` lambda > where > haskell = td ! [align "center"] > << font ![size "7",face "Arial Black"] > << "Haskell" > purely = td << font ! [size "6"] > << "A Purely Functional Language" > lambda = td << image ! [src "lambda.gif"]

This produces a table of cells, which nest like this:
haskell lambda
purely

Even though the lambda box sits over two rows, the semantics of above and beside handle this correctly. Now we can render our HTML page. > main = writeFile "example.htm" (renderHtml htmlPage) hugs98-plus-Sep2006/fptools/hslibs/text/Makefile0000644006511100651110000000051010151654052020354 0ustar rossross# $Id: Makefile,v 1.23 2004/11/26 16:22:02 simonmar Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk PACKAGE = text VERSION = 1.0 PACKAGE_DEPS = lang data ALL_DIRS = html parsec SRC_HC_OPTS += -cpp -fvia-C parsec/ParsecToken_HC_OPTS += -fglasgow-exts parsec/ParsecPerm_HC_OPTS += -fglasgow-exts include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/text/Pretty.lhs0000644006511100651110000000027010127370707020723 0ustar rossross\begin{code} module Pretty {-# DEPRECATED "This module has moved to Text.PrettyPrint.HughesPJ" #-} (module Text.PrettyPrint.HughesPJ) where import Text.PrettyPrint.HughesPJ \end{code} hugs98-plus-Sep2006/fptools/hslibs/text/RegexString.lhs0000644006511100651110000000223510127370710021672 0ustar rossross----------------------------------------------------------------------------- A simple high-level interface to Regex (c) Simon Marlow 1997-1999 Modified 1999 by Ian Jackson to fix an apparent fatal bug (?!) and to provide matchRegexAll. ----------------------------------------------------------------------------- > module RegexString > {-# DEPRECATED "This module has moved to Text.Regex" #-} > ( Regex > , mkRegex -- :: String -> Regex > , mkRegexWithOpts -- :: String -> Bool -> Bool -> Regex > , matchRegex -- :: Regex -> String -> Maybe [String] > , matchRegexAll -- :: Regex > -- -> String > -- -> Maybe ( String -- before match > -- , String -- the matched string > -- , String -- after match > -- , String -- matched by last grouping > -- , [String] -- $1 .. $n group matches > -- ) > > ) where > import Text.Regex hugs98-plus-Sep2006/fptools/hslibs/text/package.conf.in0000644006511100651110000000163710205402200021560 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: False exposed-modules: Pretty, RegexString, Html, HtmlBlockTable, Parsec, ParsecChar, ParsecCombinator, ParsecError, ParsecExpr, ParsecLanguage, ParsecPerm, ParsecPos, ParsecPrim, ParsecToken hidden-modules: #ifdef INSTALLING import-dirs: PKG_LIBDIR"/hslibs-imports/text" #else import-dirs: FPTOOLS_TOP_ABS"/hslibs/text", FPTOOLS_TOP_ABS"/hslibs/text/html", FPTOOLS_TOP_ABS"/hslibs/text/parsec" #endif #ifdef INSTALLING library-dirs: PKG_LIBDIR #else library-dirs: FPTOOLS_TOP_ABS"/hslibs/text" #endif hs-libraries: "HStext" extra-libraries: include-dirs: includes: depends: lang, parsec hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: haddock-html: hugs98-plus-Sep2006/fptools/hslibs/text/parsec/0000755006511100651110000000000010504340142020167 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/text/parsec/Parsec.hs0000644006511100651110000000025410127370712021750 0ustar rossrossmodule Parsec {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec" #-} (module Text.ParserCombinators.Parsec) where import Text.ParserCombinators.Parsec hugs98-plus-Sep2006/fptools/hslibs/text/parsec/ParsecChar.hs0000644006511100651110000000027710127370712022553 0ustar rossrossmodule ParsecChar {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec.Char" #-} (module Text.ParserCombinators.Parsec.Char) where import Text.ParserCombinators.Parsec.Char hugs98-plus-Sep2006/fptools/hslibs/text/parsec/ParsecCombinator.hs0000644006511100651110000000032710127370712023767 0ustar rossrossmodule ParsecCombinator {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec.Combinator" #-} (module Text.ParserCombinators.Parsec.Combinator) where import Text.ParserCombinators.Parsec.Combinator hugs98-plus-Sep2006/fptools/hslibs/text/parsec/ParsecError.hs0000644006511100651110000000030310127370712022755 0ustar rossrossmodule ParsecError {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec.Error" #-} (module Text.ParserCombinators.Parsec.Error) where import Text.ParserCombinators.Parsec.Error hugs98-plus-Sep2006/fptools/hslibs/text/parsec/ParsecExpr.hs0000644006511100651110000000027710127370712022614 0ustar rossrossmodule ParsecExpr {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec.Expr" #-} (module Text.ParserCombinators.Parsec.Expr) where import Text.ParserCombinators.Parsec.Expr hugs98-plus-Sep2006/fptools/hslibs/text/parsec/ParsecLanguage.hs0000644006511100651110000000031710127370713023415 0ustar rossrossmodule ParsecLanguage {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec.Language" #-} (module Text.ParserCombinators.Parsec.Language) where import Text.ParserCombinators.Parsec.Language hugs98-plus-Sep2006/fptools/hslibs/text/parsec/ParsecPerm.hs0000644006511100651110000000027710127370713022602 0ustar rossrossmodule ParsecPerm {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec.Perm" #-} (module Text.ParserCombinators.Parsec.Perm) where import Text.ParserCombinators.Parsec.Perm hugs98-plus-Sep2006/fptools/hslibs/text/parsec/ParsecPos.hs0000644006511100651110000000027310127370713022434 0ustar rossrossmodule ParsecPos {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec.Pos" #-} (module Text.ParserCombinators.Parsec.Pos) where import Text.ParserCombinators.Parsec.Pos hugs98-plus-Sep2006/fptools/hslibs/text/parsec/ParsecPrim.hs0000644006511100651110000000027710127370713022606 0ustar rossrossmodule ParsecPrim {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec.Prim" #-} (module Text.ParserCombinators.Parsec.Prim) where import Text.ParserCombinators.Parsec.Prim hugs98-plus-Sep2006/fptools/hslibs/text/parsec/ParsecToken.hs0000644006511100651110000000030310127370713022745 0ustar rossrossmodule ParsecToken {-# DEPRECATED "This module has moved to Text.ParserCombinators.Parsec.Token" #-} (module Text.ParserCombinators.Parsec.Token) where import Text.ParserCombinators.Parsec.Token hugs98-plus-Sep2006/fptools/hslibs/util/0000755006511100651110000000000010504340142016703 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/util/cbits/0000755006511100651110000000000010504340142020007 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/util/cbits/HsUtil.h0000644006511100651110000000126507731547001021407 0ustar rossross/* ----------------------------------------------------------------------------- * $Id: HsUtil.h,v 1.3 2003/09/16 08:46:57 simonmar Exp $ * * Definitions for package `util' which are visible in Haskell land. * * ---------------------------------------------------------------------------*/ #ifndef HSUTIL_H #define HSUTIL_H /* selectFrom.c */ extern StgInt sizeof_fd_set__(); extern void fd_zero__(StgByteArray fds); extern void fd_set__(StgByteArray a, StgInt fd); extern StgInt is_fd_set__(StgByteArray a, StgInt fd); extern StgInt selectFrom__ ( StgByteArray rfd , StgByteArray wfd , StgByteArray efd , StgInt mFd , StgInt tout ); #endif hugs98-plus-Sep2006/fptools/hslibs/util/cbits/Makefile0000644006511100651110000000112510145141607021454 0ustar rossross# $Id: Makefile,v 1.21 2004/11/12 14:07:03 simonmar Exp $ TOP = ../.. include $(TOP)/mk/boilerplate.mk ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" EXCLUDED_SRCS += selectFrom.c endif SRC_CC_OPTS += -Wall SRC_CC_OPTS += -I$(GHC_INCLUDE_DIR) -I$(GHC_RUNTIME_DIR) \ -I$(FPTOOLS_TOP)/libraries/base/include # No files reqd for mingw any longer; a defined, but empty C_OBJS confuses # the mk/ setup. ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32" LIBRARY = libHSutil_cbits.a LIBOBJS = $(C_OBJS) endif includedir = $(libdir)/include INSTALL_INCLUDES = HsUtil.h include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/util/cbits/selectFrom.c0000644006511100651110000000210207746635070022276 0ustar rossross/* * (c) sof, 1999 * * Stubs to help implement Select module. */ /* we're outside the realms of POSIX here... */ /* #include "PosixSource.h" */ #include "Rts.h" #include "HsUtil.h" #include #include # if defined(HAVE_SYS_TYPES_H) # include # endif # ifdef HAVE_SYS_TIME_H # include # endif # ifdef HAVE_UNISTD_H # include # endif /* Helpers for the Haskell-side unmarshalling */ StgInt sizeof_fd_set__() { return (sizeof(fd_set)); } void fd_zero__(StgByteArray a) { FD_ZERO((fd_set*)a); } void fd_set__(StgByteArray a, StgInt fd) { FD_SET(fd,(fd_set*)a); } StgInt is_fd_set__(StgByteArray a, StgInt fd) { return FD_ISSET(fd,(fd_set*)a); } StgInt selectFrom__( StgByteArray rfd , StgByteArray wfd , StgByteArray efd , StgInt mFd , StgInt tout ) { int rc; struct timeval tv; if (tout != (-1)) { tv.tv_sec = tout / 1000000; tv.tv_usec = tout % 1000000; } rc = select(mFd, (fd_set*)rfd, (fd_set*)wfd, (fd_set*)efd, (tout == -1 ? NULL : &tv)); return rc; } hugs98-plus-Sep2006/fptools/hslibs/util/GetOpt.lhs0000644006511100651110000000025410127370714020627 0ustar rossross\begin{code} module GetOpt {-# DEPRECATED "This module has moved to System.Console.GetOpt" #-} (module System.Console.GetOpt) where import System.Console.GetOpt \end{code} hugs98-plus-Sep2006/fptools/hslibs/util/Makefile0000644006511100651110000000176310207632177020366 0ustar rossross# ----------------------------------------------------------------------------- # # (c) The University of Glasgow 2002 # TOP=.. include $(TOP)/mk/boilerplate.mk SUBDIRS = cbits ALL_DIRS = check PACKAGE = util VERSION = 1.0 PACKAGE_DEPS = lang concurrent # We omit the Readline library on mingw32, because it can't be loaded # into GHCi due to the lack of a readline DLL, and that prevents the # util package from being loadable in GHCi too. On Windows you can still # get the Readline library from the readline package (System.Console.Readline). ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" EXCLUDED_SRCS += Readline.hs else ifeq "$(GhcLibsWithReadline)" "YES" PACKAGE_DEPS += readline else EXCLUDED_SRCS += Readline.hs endif endif SRC_HC_OPTS += -cpp SRC_CC_OPTS += -I$(GHC_INCLUDE_DIR) Memo_HC_OPTS += -funbox-strict-fields ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" EXCLUDED_SRCS += Select.lhs PACKAGE_DEPS := $(filter-out posix, $(PACKAGE_DEPS)) endif include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/util/Memo.lhs0000644006511100651110000001111010130752030020300 0ustar rossross% $Id: Memo.lhs,v 1.8 2004/10/06 11:16:40 ross Exp $ % % (c) The GHC Team, 1999 % % Hashing memo tables. \begin{code} {-# OPTIONS -fglasgow-exts #-} module Memo {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} #ifndef __PARALLEL_HASKELL__ ( memo -- :: (a -> b) -> a -> b , memoSized -- :: Int -> (a -> b) -> a -> b ) #endif where #ifndef __PARALLEL_HASKELL__ import System.Mem.StableName ( StableName, makeStableName, hashStableName ) import System.Mem.Weak ( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize ) import Data.Array.IO ( IOArray, newArray, readArray, writeArray ) import System.IO.Unsafe ( unsafePerformIO ) import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar ) \end{code} ----------------------------------------------------------------------------- Memo table representation. The representation is this: a fixed-size hash table where each bucket is a list of table entries, of the form (key,value). The key in this case is (StableName key), and we use hashStableName to hash it. It's important that we can garbage collect old entries in the table when the key is no longer reachable in the heap. Hence the value part of each table entry is (Weak val), where the weak pointer "key" is the key for our memo table, and 'val' is the value of this memo table entry. When the key becomes unreachable, a finalizer will fire and remove this entry from the hash bucket, and further attempts to dereference the weak pointer will return Nothing. References from 'val' to the key are ignored (see the semantics of weak pointers in the documentation). \begin{code} type MemoTable key val = MVar ( Int, -- current table size IOArray Int [MemoEntry key val] -- hash table ) -- a memo table entry: compile with -funbox-strict-fields to eliminate -- the boxes around the StableName and Weak fields. data MemoEntry key val = MemoEntry !(StableName key) !(Weak val) \end{code} We use an MVar to the hash table, so that several threads may safely access it concurrently. This includes the finalization threads that remove entries from the table. ToDo: Can efficiency be improved at all? \begin{code} memo :: (a -> b) -> a -> b memo f = memoSized default_table_size f default_table_size = 1001 -- Our memo functions are *strict*. Lazy memo functions tend to be -- less useful because it is less likely you'll get a memo table hit -- for a thunk. This change was made to match Hugs's Memo -- implementation, and as the result of feedback from Conal Elliot -- . memoSized :: Int -> (a -> b) -> a -> b memoSized size f = strict (lazyMemoSized size f) strict = ($!) lazyMemoSized :: Int -> (a -> b) -> a -> b lazyMemoSized size f = let (table,weak) = unsafePerformIO ( do { tbl <- newArray (0,size) [] ; mvar <- newMVar (size,tbl) ; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size)) ; return (mvar,weak) }) in memo' f table weak table_finalizer :: IOArray Int [MemoEntry key val] -> Int -> IO () table_finalizer table size = sequence_ [ finalizeBucket i | i <- [0..size] ] where finalizeBucket i = do bucket <- readArray table i sequence_ [ finalize w | MemoEntry _ w <- bucket ] memo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b memo' f ref weak_ref = \k -> unsafePerformIO $ do stable_key <- makeStableName k (size, table) <- takeMVar ref let hash_key = hashStableName stable_key `mod` size bucket <- readArray table hash_key lkp <- lookupSN stable_key bucket case lkp of Just result -> do putMVar ref (size,table) return result Nothing -> do let result = f k weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref)) writeArray table hash_key (MemoEntry stable_key weak : bucket) putMVar ref (size,table) return result finalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO () finalizer hash_key stable_key weak_ref = do r <- deRefWeak weak_ref case r of Nothing -> return () Just mvar -> do (size,table) <- takeMVar mvar bucket <- readArray table hash_key let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket, sn /= stable_key ] writeArray table hash_key new_bucket putMVar mvar (size,table) lookupSN :: StableName key -> [MemoEntry key val] -> IO (Maybe val) lookupSN sn [] = sn `seq` return Nothing -- make it strict in sn lookupSN sn (MemoEntry sn' weak : xs) | sn == sn' = do maybe_item <- deRefWeak weak case maybe_item of Nothing -> error ("dead weak pair: " ++ show (hashStableName sn)) Just v -> return (Just v) | otherwise = lookupSN sn xs #endif \end{code} hugs98-plus-Sep2006/fptools/hslibs/util/Observe.lhs0000644006511100651110000007002610130752030021023 0ustar rossross/* * $Revision: 1.7 $ * $Date: 2004/10/06 11:16:40 $ */ The file is part of the Haskell Object Observation Debugger, (HOOD) July 2000 release. Actually this is all of this version of HOOD, apart from the documentation and examples... HOOD is a small post-mortem debugger for the lazy functional language Haskell. It is based on the concept of observation of intermediate data structures, rather than the more traditional stepping and variable examination paradigm used by imperative language debuggers. Copyright (c) Andy Gill, 1992-2000 All rights reserved. HOOD is distributed as free software under the license in the file "License", which available from the HOOD web page, http://www.haskell.org/hood This module produces CDS's, based on the observation made on Haskell objects, including base types, constructors and functions. WARNING: unrestricted use of unsafePerformIO below. We presume the Haskell compiler has an IOExts library :-) There are two types of pre-processor type. (1) Each compilers each have a flag ** These are used only for different import directives, etc. ** * GHC => "__GLASGOW_HASKELL__" (by default in GHC) * Hugs => "__HUGS__" * STG Hugs => "__STG_HUGS__" (2) specific extension are supported by different flags * Observing Exceptions ==> "__EXCEPTIONS__" * Concurrency support ==> "__CONCURRENT__" * Forall's in datatypes ==> "__FORALL__" * Enable Quickcheck for testing ==> "__QUICKCHECK__" (only for developers) The make file stores what compiler compiles with what option. #define __EXCEPTIONS__ 1 #define __CONCURRENT__ 1 #define __FORALL__ 1 %************************************************************************ %* * \subsection{Exports} %* * %************************************************************************ \begin{code} {-# OPTIONS -fglasgow-exts #-} module Observe {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( observe -- (Observable a) => String -> a -> a , Observer(..) -- contains a 'forall' typed observe (if supported). , Observing -- a -> a , Observable(..) -- Class , runO -- IO a -> IO () , printO -- a -> IO () , putStrO -- String -> IO () -- ------------------------------------------------------------ -- For advanced users, that want to render their own datatypes. -- * The infix (<<) is a shortcut for constructor arguments. -- * thunk is for marking suspensions. -- * send sends a packet to the observation agent. , (<<) -- (Observable a) => ObserverM (a -> b) -> a -> ObserverM b , thunk -- (Observable a) => a -> ObserverM a , send , observeBase , observeOpaque -- ------------------------------------------------------------ -- For users that want to write there own render drivers. , debugO -- IO a -> IO [CDS] , CDS(..) ) where \end{code} %************************************************************************ %* * \subsection{Imports and infixing} %* * %************************************************************************ \begin{code} import System.IO ( hPutStrLn, stderr ) import Data.Ix ( Ix ) import Data.Array ( Array, array, bounds, assocs, (!), accumArray ) import Data.List ( sort, sortBy ) -- The only non standard one we assume import System.IO.Unsafe ( unsafePerformIO ) import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) \end{code} #ifdef __CONCURRENT__ \begin{code} import Control.Concurrent.MVar( MVar, newMVar, takeMVar, putMVar ) \end{code} #endif #ifdef __EXCEPTIONS__ \begin{code} import Control.Exception( catch, Exception(..), throw ) import Data.Dynamic ( Dynamic ) \end{code} #endif #ifdef __QUICKCHECK__ \begin{code} import QuickCheck infixr 5 :<|> infixr 6 :<> infixr 6 <> \end{code} #endif \begin{code} infixl 9 << \end{code} %************************************************************************ %* * \subsection{External start functions} %* * %************************************************************************ Run the observe ridden code. \begin{code} debugO :: IO a -> IO [CDS] debugO program = do { initUniq ; startEventStream ; let errorMsg e = "[Escaping Exception in Code : " ++ show e ++ "]" ; ourCatchAllIO (do { program ; return () }) (hPutStrLn stderr . errorMsg) ; events <- endEventStream ; return (eventsToCDS events) } printO :: (Show a) => a -> IO () printO expr = runO (print expr) putStrO :: String -> IO () putStrO expr = runO (putStr expr) runO :: IO a -> IO () runO program = do { cdss <- debugO program ; let cdss1 = rmEntrySet cdss ; let cdss2 = simplifyCDSSet cdss1 ; let output1 = cdssToOutput cdss2 ; let output2 = commonOutput output1 ; let ptyout = pretty 80 (foldr (<>) nil (map renderTop output2)) ; hPutStrLn stderr "" ; hPutStrLn stderr ptyout } \end{code} %************************************************************************ %* * \subsection{Simulations} %* * %************************************************************************ Here we provide stubs for the functionally that is not supported by some compilers, and provide some combinators of various flavors. #ifndef __EXCEPTIONS__ \begin{code} ourCatchAllIO :: IO a -> (() -> IO a) -> IO a ourCatchAllIO = const handleExc :: (Observable a) => Parent -> () -> IO a handleExc = undefined \end{code} #else \begin{code} ourCatchAllIO :: IO a -> (Exception -> IO a) -> IO a ourCatchAllIO = Control.Exception.catch handleExc :: (Observable a) => Parent -> Exception -> IO a handleExc context exc = return (send "throw" (return throw << exc) context) \end{code} #endif #ifndef __CONCURRENT__ Trival stubs of non-blocking MVar's. \begin{code} data MVar a = MVar newMVar :: () -> IO (MVar ()) newMVar a = return MVar takeMVar :: MVar () -> IO () takeMVar MVar = return () putMVar :: MVar () -> () -> IO () putMVar MVar () = return () \end{code} #endif %************************************************************************ %* * \subsection{Instances} %* * %************************************************************************ The Haskell Base types \begin{code} instance Observable Int where { observer = observeBase } instance Observable Bool where { observer = observeBase } instance Observable Integer where { observer = observeBase } instance Observable Float where { observer = observeBase } instance Observable Double where { observer = observeBase } instance Observable Char where { observer = observeBase } instance Observable () where { observer = observeOpaque "()" } -- utilities for base types. -- The strictness (by using seq) is the same -- as the pattern matching done on other constructors. -- we evalute to WHNF, and not further. observeBase :: (Show a) => a -> Parent -> a observeBase lit cxt = seq lit $ send (show lit) (return lit) cxt observeOpaque :: String -> a -> Parent -> a observeOpaque str val cxt = seq val $ send str (return val) cxt \end{code} The Constructors. \begin{code} instance (Observable a,Observable b) => Observable (a,b) where observer (a,b) = send "," (return (,) << a << b) instance (Observable a,Observable b,Observable c) => Observable (a,b,c) where observer (a,b,c) = send "," (return (,,) << a << b << c) instance (Observable a,Observable b,Observable c,Observable d) => Observable (a,b,c,d) where observer (a,b,c,d) = send "," (return (,,,) << a << b << c << d) instance (Observable a,Observable b,Observable c,Observable d,Observable e) => Observable (a,b,c,d,e) where observer (a,b,c,d,e) = send "," (return (,,,,) << a << b << c << d << e) instance (Observable a) => Observable [a] where observer (a:as) = send ":" (return (:) << a << as) observer [] = send "[]" (return []) instance (Observable a) => Observable (Maybe a) where observer (Just a) = send "Just" (return Just << a) observer Nothing = send "Nothing" (return Nothing) instance (Observable a,Observable b) => Observable (Either a b) where observer (Left a) = send "Left" (return Left << a) observer (Right a) = send "Right" (return Right << a) \end{code} Arrays. \begin{code} instance (Ix a,Observable a,Observable b) => Observable (Data.Array.Array a b) where observer arr = send "array" (return Data.Array.array << Data.Array.bounds arr << Data.Array.assocs arr ) \end{code} IO monad. \begin{code} instance (Observable a) => Observable (IO a) where observer fn cxt = do res <- fn send "" (return return << res) cxt \end{code} We treat IOError this like a base value. Cheating a bit, but if you generate an IOError with a bottom in it, your just asking for trouble. #if __GLASGOW_HASKELL__ < 500 \begin{code} instance Observable IOError where { observer = observeBase } \end{code} #endif Functions. \begin{code} instance (Observable a,Observable b) => Observable (a -> b) where observer fn cxt arg = sendObserveFnPacket ( do arg <- thunk arg thunk (fn arg)) cxt observers = defaultFnObservers \end{code} The Exception *datatype* (not exceptions themselves!). For now, we only display IOExceptions and calls to Error. #ifdef __EXCEPTIONS__ #if __GLASGOW_HASKELL__ < 500 \begin{code} instance Observable Exception where observer (IOException a) = send "IOException" (return IOException << a) observer (ErrorCall a) = send "ErrorCall" (return ErrorCall << a) observer other = send "" (return other) instance Observable Dynamic where { observer = observeOpaque "" } \end{code} #else \begin{code} instance Observable Exception where observer (IOException a) = observeOpaque "IOException" (IOException a) observer (ErrorCall a) = send "ErrorCall" (return ErrorCall << a) observer other = send "" (return other) instance Observable Dynamic where { observer = observeOpaque "" } \end{code} #endif #endif %************************************************************************ %* * \subsection{Classes and Data Defintions} %* * %************************************************************************ \begin{code} class Observable a where {- - This reveals the name of a specific constructor. - and gets ready to explain the sub-components. - - We put the context second so we can do eta-reduction - with some of our definitions. -} observer :: a -> Parent -> a {- - This used used to group several observer instances together. -} observers :: String -> (Observer -> a) -> a observers label arg = defaultObservers label arg type Observing a = a -> a \end{code} \begin{code} newtype Observer = O (forall a . (Observable a) => String -> a -> a) defaultObservers :: (Observable a) => String -> (Observer -> a) -> a defaultObservers label fn = unsafeWithUniq $ \ node -> do { sendEvent node (Parent 0 0) (Observe label) ; let observe' sublabel a = unsafeWithUniq $ \ subnode -> do { sendEvent subnode (Parent node 0) (Observe sublabel) ; return (observer_ a (Parent { observeParent = subnode , observePort = 0 })) } ; return (observer_ (fn (O observe')) (Parent { observeParent = node , observePort = 0 })) } defaultFnObservers :: (Observable a,Observable b) => String -> (Observer -> a -> b) -> a -> b defaultFnObservers label fn arg = unsafeWithUniq $ \ node -> do { sendEvent node (Parent 0 0) (Observe label) ; let observe' sublabel a = unsafeWithUniq $ \ subnode -> do { sendEvent subnode (Parent node 0) (Observe sublabel) ; return (observer_ a (Parent { observeParent = subnode , observePort = 0 })) } ; return (observer_ (fn (O observe')) (Parent { observeParent = node , observePort = 0 }) arg) } \end{code} %************************************************************************ %* * \subsection{The ObserveM Monad} %* * %************************************************************************ The Observer monad, a simple state monad, for placing numbers on sub-observations. \begin{code} newtype ObserverM a = ObserverM { runMO :: Int -> Int -> (a,Int) } instance Monad ObserverM where return a = ObserverM (\ c i -> (a,i)) fn >>= k = ObserverM (\ c i -> case runMO fn c i of (r,i2) -> runMO (k r) c i2 ) thunk :: (Observable a) => a -> ObserverM a thunk a = ObserverM $ \ parent port -> ( observer_ a (Parent { observeParent = parent , observePort = port }) , port+1 ) (<<) :: (Observable a) => ObserverM (a -> b) -> a -> ObserverM b fn << a = do { fn' <- fn ; a' <- thunk a ; return (fn' a') } \end{code} %************************************************************************ %* * \subsection{observe and friends} %* * %************************************************************************ Our principle function and class \begin{code} {-# NOINLINE observe #-} observe :: (Observable a) => String -> a -> a observe name a = generateContext name a {- This gets called before observer, allowing us to mark - we are entering a, before we do case analysis on - our object. -} {-# NOINLINE observer_ #-} observer_ :: (Observable a) => a -> Parent -> a observer_ a context = sendEnterPacket a context \end{code} \begin{code} data Parent = Parent { observeParent :: !Int -- my parent , observePort :: !Int -- my branch number } deriving Show root = Parent 0 0 \end{code} The functions that output the data. All are dirty. \begin{code} unsafeWithUniq :: (Int -> IO a) -> a unsafeWithUniq fn = unsafePerformIO $ do { node <- getUniq ; fn node } \end{code} \begin{code} generateContext :: (Observable a) => String -> a -> a generateContext label orig = unsafeWithUniq $ \ node -> do { sendEvent node (Parent 0 0) (Observe label) ; return (observer_ orig (Parent { observeParent = node , observePort = 0 }) ) } send :: String -> ObserverM a -> Parent -> a send consLabel fn context = unsafeWithUniq $ \ node -> do { let (r,portCount) = runMO fn node 0 ; sendEvent node context (Cons portCount consLabel) ; return r } sendEnterPacket :: (Observable a) => a -> Parent -> a sendEnterPacket r context = unsafeWithUniq $ \ node -> do { sendEvent node context Enter ; ourCatchAllIO (evaluate (observer r context)) (handleExc context) } evaluate :: a -> IO a evaluate a = a `seq` return a sendObserveFnPacket :: ObserverM a -> Parent -> a sendObserveFnPacket fn context = unsafeWithUniq $ \ node -> do { let (r,_) = runMO fn node 0 ; sendEvent node context Fun ; return r } \end{code} %************************************************************************ %* * \subsection{Event stream} %* * %************************************************************************ Trival output functions \begin{code} data Event = Event { portId :: !Int , parent :: !Parent , change :: !Change } deriving Show data Change = Observe !String | Cons !Int !String | Enter | Fun deriving Show startEventStream :: IO () startEventStream = writeIORef events [] endEventStream :: IO [Event] endEventStream = do { es <- readIORef events ; writeIORef events badEvents ; return es } sendEvent :: Int -> Parent -> Change -> IO () sendEvent nodeId parent change = do { nodeId `seq` parent `seq` return () ; change `seq` return () ; takeMVar sendSem ; es <- readIORef events ; let event = Event nodeId parent change ; writeIORef events (event `seq` (event : es)) ; putMVar sendSem () } -- local events :: IORef [Event] events = unsafePerformIO $ newIORef badEvents badEvents :: [Event] badEvents = error "Bad Event Stream" -- use as a trivial semiphore {-# NOINLINE sendSem #-} sendSem :: MVar () sendSem = unsafePerformIO $ newMVar () -- end local \end{code} %************************************************************************ %* * \subsection{unique name supply code} %* * %************************************************************************ Use the single threaded version \begin{code} initUniq :: IO () initUniq = writeIORef uniq 1 getUniq :: IO Int getUniq = do { takeMVar uniqSem ; n <- readIORef uniq ; writeIORef uniq $! (n + 1) ; putMVar uniqSem () ; return n } peepUniq :: IO Int peepUniq = readIORef uniq -- locals {-# NOINLINE uniq #-} uniq :: IORef Int uniq = unsafePerformIO $ newIORef 1 {-# NOINLINE uniqSem #-} uniqSem :: MVar () uniqSem = unsafePerformIO $ newMVar () \end{code} %************************************************************************ %* * \subsection{Global, initualizers, etc} %* * %************************************************************************ \begin{code} openObserveGlobal :: IO () openObserveGlobal = do { initUniq ; startEventStream } closeObserveGlobal :: IO [Event] closeObserveGlobal = do { evs <- endEventStream ; putStrLn "" ; return evs } \end{code} %************************************************************************ %* * \subsection{The CVS and converting functions} %* * %************************************************************************ \begin{code} data CDS = CDSNamed String CDSSet | CDSCons Int String [CDSSet] | CDSFun Int CDSSet CDSSet | CDSEntered Int deriving (Show,Eq,Ord) type CDSSet = [CDS] eventsToCDS :: [Event] -> CDSSet eventsToCDS pairs = getChild 0 0 where res i = (!) out_arr i bnds = (0, length pairs) mid_arr :: Array Int [(Int,CDS)] mid_arr = accumArray (flip (:)) [] bnds [ (pnode,(pport,res node)) | (Event node (Parent pnode pport) _) <- pairs ] out_arr = array bnds -- never uses 0 index [ (node,getNode'' node change) | (Event node _ change) <- pairs ] getNode'' :: Int -> Change -> CDS getNode'' node change = case change of (Observe str) -> CDSNamed str (getChild node 0) (Enter) -> CDSEntered node (Fun) -> CDSFun node (getChild node 0) (getChild node 1) (Cons portc cons) -> CDSCons node cons [ getChild node n | n <- [0..(portc-1)]] getChild :: Int -> Int -> CDSSet getChild pnode pport = [ content | (pport',content) <- (!) mid_arr pnode , pport == pport' ] render :: Int -> Bool -> CDS -> DOC render prec par (CDSCons _ ":" [cds1,cds2]) = if (par && not needParen) then doc -- dont use paren (..) because we dont want a grp here! else paren needParen doc where doc = grp (brk <> renderSet' 5 False cds1 <> text " : ") <> renderSet' 4 True cds2 needParen = prec > 4 render prec par (CDSCons _ "," cdss) | length cdss > 0 = nest 2 (text "(" <> foldl1 (\ a b -> a <> text ", " <> b) (map renderSet cdss) <> text ")") render prec par (CDSCons _ name cdss) = paren (length cdss > 0 && prec /= 0) (nest 2 (text name <> foldr (<>) nil [ sep <> renderSet' 10 False cds | cds <- cdss ] ) ) {- renderSet handles the various styles of CDSSet. -} renderSet :: CDSSet -> DOC renderSet = renderSet' 0 False renderSet' :: Int -> Bool -> CDSSet -> DOC renderSet' _ _ [] = text "_" renderSet' prec par [cons@(CDSCons {})] = render prec par cons renderSet' prec par cdss = nest 0 (text "{ " <> foldl1 (\ a b -> a <> line <> text ", " <> b) (map renderFn pairs) <> line <> text "}") where pairs = nub (sort (findFn cdss)) -- local nub for sorted lists nub [] = [] nub (a:a':as) | a == a' = nub (a' : as) nub (a:as) = a : nub as renderFn :: ([CDSSet],CDSSet) -> DOC renderFn (args,res) = grp (nest 3 (text "\\ " <> foldr (\ a b -> nest 0 (renderSet' 10 False a) <> sp <> b) nil args <> sep <> text "-> " <> renderSet' 0 False res ) ) findFn :: CDSSet -> [([CDSSet],CDSSet)] findFn = foldr findFn' [] findFn' (CDSFun _ arg res) rest = case findFn res of [(args',res')] -> (arg : args', res') : rest _ -> ([arg], res) : rest findFn' other rest = ([],[other]) : rest renderTops [] = nil renderTops tops = line <> foldr (<>) nil (map renderTop tops) renderTop :: Output -> DOC renderTop (OutLabel str set extras) = nest 2 (text ("-- " ++ str) <> line <> renderSet set <> renderTops extras) <> line rmEntry :: CDS -> CDS rmEntry (CDSNamed str set) = CDSNamed str (rmEntrySet set) rmEntry (CDSCons i str sets) = CDSCons i str (map rmEntrySet sets) rmEntry (CDSFun i a b) = CDSFun i (rmEntrySet a) (rmEntrySet b) rmEntry (CDSEntered i) = error "found bad CDSEntered" rmEntrySet = map rmEntry . filter noEntered where noEntered (CDSEntered _) = False noEntered _ = True simplifyCDS :: CDS -> CDS simplifyCDS (CDSNamed str set) = CDSNamed str (simplifyCDSSet set) simplifyCDS (CDSCons _ "throw" [[CDSCons _ "ErrorCall" set]] ) = simplifyCDS (CDSCons 0 "error" set) simplifyCDS cons@(CDSCons i str sets) = case spotString [cons] of Just str | not (null str) -> CDSCons 0 (show str) [] _ -> CDSCons 0 str (map simplifyCDSSet sets) simplifyCDS (CDSFun i a b) = CDSFun 0 (simplifyCDSSet a) (simplifyCDSSet b) -- replace with -- CDSCons i "->" [simplifyCDSSet a,simplifyCDSSet b] -- for turning off the function stuff. simplifyCDSSet = map simplifyCDS spotString :: CDSSet -> Maybe String spotString [CDSCons _ ":" [[CDSCons _ str []] ,rest ] ] = do { ch <- case reads str of [(ch,"")] -> return ch _ -> Nothing ; more <- spotString rest ; return (ch : more) } spotString [CDSCons _ "[]" []] = return [] spotString other = Nothing paren :: Bool -> DOC -> DOC paren False doc = grp (nest 0 doc) paren True doc = grp (nest 0 (text "(" <> nest 0 doc <> brk <> text ")")) sp :: DOC sp = text " " data Output = OutLabel String CDSSet [Output] | OutData CDS deriving (Eq,Ord) commonOutput :: [Output] -> [Output] commonOutput = sortBy byLabel where byLabel (OutLabel lab _ _) (OutLabel lab' _ _) = compare lab lab' cdssToOutput :: CDSSet -> [Output] cdssToOutput = map cdsToOutput cdsToOutput (CDSNamed name cdsset) = OutLabel name res1 res2 where res1 = [ cdss | (OutData cdss) <- res ] res2 = [ out | out@(OutLabel {}) <- res ] res = cdssToOutput cdsset cdsToOutput cons@(CDSCons {}) = OutData cons cdsToOutput fn@(CDSFun {}) = OutData fn \end{code} %************************************************************************ %* * \subsection{Quickcheck stuff} %* * %************************************************************************ #ifdef __QUICKCHECK__ \begin{code} prop_eventsToCDS changes = label (classBy 10 (length changes)) $ eventsToCDS changes == ref_eventsToCDS changes where types = (changes :: [Event]) classBy :: Int -> Int -> String classBy n x = show t2 ++ "-" ++ show t3 where t1 = (x `div` n) t2 = t1 * n t3 = (t1 + 1) * n - 1 -- Now a straightforward implementation ref_eventsToCDS changes = getChildren (reverse changes) 0 0 getNode :: [Event] -> Int -> CDS getNode pairs node = case change of Observe str -> CDSNamed str (getChildren pairs portId 0) Enter -> CDSEntered portId Fun -> CDSFun portId (getChild 0) (getChild 1) Cons portc cons -> CDSCons portId cons [ getChild n | n <- [0..(portc-1)]] where getChild :: Int -> CDSSet getChild = getChildren pairs portId Event { portId = portId , change = change } = lookup node pairs lookup id (e@Event { portId = portId }:_) | id == portId = e lookup id (_:r) = lookup id r lookup id [] = error "bad lookup" getChildren :: [Event] -> Int -> Int -> CDSSet getChildren pairs pnode pport = [ getNode pairs node' | (Event node' (Parent pnode' pport') _) <- pairs , pnode == pnode' && pport == pport' ] instance Arbitrary [Event] where arbitrary = do t <- oneof [return FunT,return ThunkT] r <- genChange [(t,1,0)] 2 return (Event 1 root (Observe "obs") : r) {- - genChange is vital to testing. It generates typical - obsevations of the internal structure. - The first boolean is true if this is a fun hook - The second boolean is true if the node has never been entered. - -} data NodeType = FunT -- functional node | ThunkT -- unevaluated (pre entry) | ConsT -- been entered, waiting for Cons -- FunT do not require an enter, but can have one if needed. genChange :: [(NodeType,Int,Int)] -> Int -> Gen [Event] genChange [] _ = return [] genChange hooks count = sized $ \ n -> if n < count then return [] else do { n <- choose (0::Int,length hooks - 1) ; let (ty,pnode,pport) = hooks !! n ; (case ty of FunT -> genFun ThunkT -> genEnter ConsT -> genCons ) n pnode pport (take n hooks ++ drop (n+1) hooks) } where vec n = sequence [ oneof [return FunT,return ThunkT] | i <- [1..n] ] genCons n pnode pport hooks = do { m <- choose (0::Int,5) ; bs <- vec m ; let hooks' = [ (b,count,port) | (b,port) <- zip bs [0..(m-1)] ] ; res <- genChange (hooks ++ hooks') (count + 1) ; return (Event { portId = count , parent = (Parent pnode pport) , change = Cons m ("Cons" ++ show m) } : res) } genFun n pnode pport hooks = do { bs <- vec 2 ; let hooks' = [ (b,count,port) | (b,port) <- zip bs [0..1] ] ; res <- genChange (hooks ++ hooks' ++ [(FunT,pnode,pport)]) (count + 1) ; return (Event { portId = count , parent = (Parent pnode pport) , change = Fun } : res) } genEnter n pnode pport hooks = do { res <- genChange (hooks ++ [ (ConsT,pnode,pport) ]) (count + 1) ; return (Event { portId = count , parent = (Parent pnode pport) , change = Enter } : res) } \end{code} #endif %************************************************************************ %* * \subsection{A Pretty Printer} %* * %************************************************************************ This pretty printer is based on Wadler's pretty printer. \begin{code} data DOC = NIL -- nil | DOC :<> DOC -- beside | NEST Int DOC | TEXT String | LINE -- always "\n" | SEP -- " " or "\n" | BREAK -- "" or "\n" | DOC :<|> DOC -- choose one deriving (Eq,Show) data Doc = Nil | Text Int String Doc | Line Int Int Doc deriving (Show,Eq) mkText :: String -> Doc -> Doc mkText s d = Text (toplen d + length s) s d mkLine :: Int -> Doc -> Doc mkLine i d = Line (toplen d + i) i d toplen :: Doc -> Int toplen Nil = 0 toplen (Text w s x) = w toplen (Line w s x) = 0 nil = NIL x <> y = x :<> y nest i x = NEST i x text s = TEXT s line = LINE sep = SEP brk = BREAK fold x = grp (brk <> x) grp :: DOC -> DOC grp x = case flatten x of Just x' -> x' :<|> x Nothing -> x flatten :: DOC -> Maybe DOC flatten NIL = return NIL flatten (x :<> y) = do x' <- flatten x y' <- flatten y return (x' :<> y') flatten (NEST i x) = do x' <- flatten x return (NEST i x') flatten (TEXT s) = return (TEXT s) flatten LINE = Nothing -- abort flatten SEP = return (TEXT " ") -- SEP is space flatten BREAK = return NIL -- BREAK is nil flatten (x :<|> y) = flatten x layout :: Doc -> String layout Nil = "" layout (Text _ s x) = s ++ layout x layout (Line _ i x) = '\n' : replicate i ' ' ++ layout x best w k doc = be w k [(0,doc)] be :: Int -> Int -> [(Int,DOC)] -> Doc be w k [] = Nil be w k ((i,NIL):z) = be w k z be w k ((i,x :<> y):z) = be w k ((i,x):(i,y):z) be w k ((i,NEST j x):z) = be w k ((k+j,x):z) be w k ((i,TEXT s):z) = s `mkText` be w (k+length s) z be w k ((i,LINE):z) = i `mkLine` be w i z be w k ((i,SEP):z) = i `mkLine` be w i z be w k ((i,BREAK):z) = i `mkLine` be w i z be w k ((i,x :<|> y):z) = better w k (be w k ((i,x):z)) (be w k ((i,y):z)) better :: Int -> Int -> Doc -> Doc -> Doc better w k x y = if (w-k) >= toplen x then x else y pretty :: Int -> DOC -> String pretty w x = layout (best w 0 x) \end{code} hugs98-plus-Sep2006/fptools/hslibs/util/Readline.hs0000644006511100651110000000023610203153466020772 0ustar rossrossmodule Readline {-# DEPRECATED "This module has moved to System.Console.Readline" #-} ( module System.Console.Readline ) where import System.Console.Readline hugs98-plus-Sep2006/fptools/hslibs/util/Select.lhs0000644006511100651110000000715710130752031020643 0ustar rossross% % (c) sof, 1999 % Haskell wrapper for select() OS functionality. It's use shouldn't be all that common in a Haskell system that implements IO in such a way that's thread friendly, but still. \begin{code} {-# OPTIONS -fglasgow-exts -#include "cbits/HsUtil.h" #-} module Select {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-} ( hSelect -- :: [Handle] -- -> [Handle] -- -> [Handle] -- -> TimeOut -- -> IO SelectResult , TimeOut -- type _ = Maybe Int , SelectResult ) where import Foreign.C.Error ( throwErrnoIfMinus1Retry ) import GHC.IOBase ( FD, haFD ) import GHC.Handle ( withHandle_ ) import System.IO ( Handle ) import Control.Monad ( foldM ) import Data.Maybe ( catMaybes ) import System.IO.Unsafe ( unsafePerformIO ) import Control.Monad.ST ( RealWorld, stToIO ) -- ToDo: Nuke these import MutableArray ( MutableByteArray, newCharArray, unsafeFreezeByteArray ) import ByteArray ( ByteArray ) \end{code} This stuff should really be done using HDirect. \begin{code} type TimeOut = Maybe Int -- Nothing => wait indefinitely. -- Just x | x >= 0 => block waiting for 'x' micro seconds. -- | otherwise => block waiting for '-x' micro seconds. type SelectResult = ([Handle], [Handle], [Handle]) hSelect :: [Handle] -- input/read handles -> [Handle] -- output/write handles -> [Handle] -- exceptional handles -> TimeOut -> IO SelectResult hSelect ins outs excps timeout = do ins_ <- mapM getFd ins outs_ <- mapM getFd outs excps_ <- mapM getFd excps (max_in, fds_ins) <- marshallFDs ins_ (max_out, fds_outs) <- marshallFDs outs_ (max_excp,fds_excps) <- marshallFDs excps_ tout <- marshallTimeout timeout let max_fd = max_in `max` max_out `max` max_excp throwErrnoIfMinus1Retry "hSelect" $ selectFrom__ fds_ins fds_outs fds_excps (max_fd+1) tout let -- thunk these so that we only pay unmarshalling costs if demanded. ins_ready = unsafePerformIO (getReadyOnes fds_ins ins_) outs_ready = unsafePerformIO (getReadyOnes fds_outs outs_) excps_ready = unsafePerformIO (getReadyOnes fds_outs outs_) return (ins_ready, outs_ready, excps_ready) getFd :: Handle -> IO (FD,Handle) getFd h = withHandle_ "getFd" h $ \ handle -> return ((haFD handle),h) foreign import "selectFrom__" unsafe selectFrom__ :: ByteArray Int -> ByteArray Int -> ByteArray Int -> Int -> Int -> IO Int marshallTimeout :: Maybe Int -> IO Int marshallTimeout Nothing = return (-1) marshallTimeout (Just x) = return (abs x) getReadyOnes :: ByteArray Int -> [(FD,Handle)] -> IO [Handle] getReadyOnes ba ls = do xs <- mapM isReady ls return (catMaybes xs) where isReady (f,h) = do let fi = fromIntegral f flg <- is_fd_set ba fi if (flg /= 0) then return (Just h) else return Nothing marshallFDs :: [(FD,Handle)] -> IO (Int, ByteArray Int) marshallFDs ls = do ba <- stToIO (newCharArray (0, sizeof_fd_set)) fd_zero ba let fillIn acc (f,_) = do let fi = fromIntegral f fd_set ba fi return (max acc fi) x <- foldM fillIn 0 ls ba <- stToIO (unsafeFreezeByteArray ba) return (x, ba) foreign import "is_fd_set__" unsafe is_fd_set :: ByteArray Int -> Int -> IO Int foreign import "fd_zero__" unsafe fd_zero :: MutableByteArray RealWorld Int -> IO () foreign import "fd_set__" unsafe fd_set :: MutableByteArray RealWorld Int -> Int -> IO () foreign import "sizeof_fd_set__" unsafe sizeof_fd_set :: Int \end{code} hugs98-plus-Sep2006/fptools/hslibs/util/Unique.lhs0000644006511100651110000000021710127370714020672 0ustar rossross\begin{code} module Unique {-# DEPRECATED "This module has moved to Data.Unique" #-} (module Data.Unique) where import Data.Unique \end{code} hugs98-plus-Sep2006/fptools/hslibs/util/package.conf.in0000644006511100651110000000222510207632177021567 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: False exposed-modules: GetOpt, Memo, Observe, Readline, Select, Unique, QuickCheck, QuickCheckBatch, QuickCheckPoly, QuickCheckUtils hidden-modules: #ifdef INSTALLING import-dirs: PKG_LIBDIR"/hslibs-imports/util" #else import-dirs: FPTOOLS_TOP_ABS"/hslibs/util", FPTOOLS_TOP_ABS"/hslibs/util/check" #endif #ifdef INSTALLING library-dirs: PKG_LIBDIR #else library-dirs: FPTOOLS_TOP_ABS"/hslibs/util" #ifndef mingw32_HOST_OS , FPTOOLS_TOP_ABS"/hslibs/util/cbits" #endif #endif hs-libraries: "HSutil" #ifndef mingw32_HOST_OS extra-libraries: "HSutil_cbits" #else extra-libraries: #endif #ifdef INSTALLING include-dirs: #else include-dirs: FPTOOLS_TOP_ABS"/hslibs/util/cbits" #endif includes: HsUtil.h depends: lang, QuickCheck #if HAVE_READLINE_HEADERS != 0 && !defined(mingw32_HOST_OS) , readline #endif #ifndef mingw32_HOST_OS , posix #endif hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: haddock-html: hugs98-plus-Sep2006/fptools/hslibs/util/check/0000755006511100651110000000000010504340142017760 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/util/check/QuickCheck.hs0000644006511100651110000000021110127370714022331 0ustar rossrossmodule QuickCheck {-# DEPRECATED "This module has moved to Debug.QuickCheck" #-} (module Debug.QuickCheck) where import Debug.QuickCheck hugs98-plus-Sep2006/fptools/hslibs/util/check/QuickCheckBatch.hs0000644006511100651110000000024010127370715023276 0ustar rossrossmodule QuickCheckBatch {-# DEPRECATED "This module has moved to Debug.QuickCheck.Batch" #-} (module Debug.QuickCheck.Batch) where import Debug.QuickCheck.Batch hugs98-plus-Sep2006/fptools/hslibs/util/check/QuickCheckPoly.hs0000644006511100651110000000023410127370715023203 0ustar rossrossmodule QuickCheckPoly {-# DEPRECATED "This module has moved to Debug.QuickCheck.Poly" #-} (module Debug.QuickCheck.Poly) where import Debug.QuickCheck.Poly hugs98-plus-Sep2006/fptools/hslibs/util/check/QuickCheckUtils.hs0000644006511100651110000000024010127370716023356 0ustar rossrossmodule QuickCheckUtils {-# DEPRECATED "This module has moved to Debug.QuickCheck.Utils" #-} (module Debug.QuickCheck.Utils) where import Debug.QuickCheck.Utils hugs98-plus-Sep2006/fptools/hslibs/util/doc/0000755006511100651110000000000010504340142017450 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/util/doc/GetOpt.xml0000644006511100651110000000064310111701602021373 0ustar rossross <literal>GetOpt</literal>: Command line parsing <indexterm><primary>GetOpt</primary></indexterm> The GetOpt library has been moved to the hierarchical libraries; it can be found in System.Console.GetOpt in the base package. hugs98-plus-Sep2006/fptools/hslibs/util/doc/Memo.xml0000644006511100651110000000336710111701602021074 0ustar rossross <literal>Memo</literal>: Fast memo functions <indexterm><primary>Memo</primary></indexterm> The Memo library provides fast polymorphic memo functions using hash tables. The interface is: memo :: (a -> b) -> a -> b So, for example, memo f is a version of f that caches the results of previous calls. The searching is very fast, being based on pointer equality. One consequence of this is that the caching will only be effective if exactly the same argument is passed again to the memoised function. This means not just a copy of a previous argument, but the same instance. It's not useful to memoise integer functions using this interface, because integers are generally copied a lot and two instances of '27' are unlikely to refer to the same object. This memoisation library works well when the keys are large (or even infinite). The memo table implementation uses weak pointers and stable names (see the GHC/Hugs library document) to avoid space leaks and allow hashing for arbitrary Haskell objects. NOTE: while individual memo table entries will be garbage collected if the associated key becomes garbage, the memo table itself will not be collected if the function becomes garbage. We plan to fix this in a future version. There's another version of memo if you want to explicitly give a size for the hash table (the default size is 1001 buckets): memoSized :: Int -> (a -> b) -> a -> b hugs98-plus-Sep2006/fptools/hslibs/util/doc/QuickCheck.xml0000644006511100651110000000055010127561445022220 0ustar rossross <literal>QuickCheck</literal> The QuickCheck library has been moved to the hierarchical libraries; it can be found in Test.QuickCheck in the QuickCheck package. hugs98-plus-Sep2006/fptools/hslibs/util/doc/Readline.xml0000644006511100651110000000354210111701602021715 0ustar rossross <literal>Readline</literal>: Command line editing Readline library (misc syslib) command-line editing library (Darren Moffat supplied the initial version of the Readline module.) The Readline module is a straightforward interface to the GNU Readline library. As such, you will need to look at the GNU documentation (and have a libreadline.a file around somewhere…) The main function you'll use is: readline :: String{-the prompt-} -> IO (Maybe String) If you want to mess around with Full Readline G(l)ory, we also provide: type KeyCode = Char type CallbackFunction = (Int -> -- Numeric Argument KeyCode -> -- KeyCode of pressed Key IO Int) -- What's this? initialize :: IO () addHistory :: String -> IO () bindKey :: KeyCode -> CallbackFunction -> IO () addDefun :: String -> CallbackFunction -> Maybe KeyCode -> IO () getReadlineName :: IO String setReadlineName :: String -> IO () getLineBuffer :: IO String setLineBuffer :: String -> IO () getPoint :: IO Int setPoint :: Int -> IO () getEnd :: IO Int setEnd :: Int -> IO () getMark :: IO Int setMark :: Int -> IO () setDone :: Bool -> IO () setPendingInput :: KeyCode -> IO () getPrompt :: IO String getTerminalName :: IO String inStream :: Handle outStream :: Handle (All those names are just Haskellised versions of what you will see in the GNU readline documentation.) hugs98-plus-Sep2006/fptools/hslibs/util/doc/Select.xml0000644006511100651110000000442410111701602021411 0ustar rossross <literal>Select</literal>: Synchronous I/O multiplexing <indexterm><primary>Select interface</primary></indexterm> The Select interface provides a Haskell wrapper for the select() OS call supplied by many modern UNIX variants. Select exports the following: type TimeOut = Maybe Int -- Nothing => wait indefinitely. -- Just x | x >= 0 => block waiting for 'x' micro seconds. -- | otherwise => block waiting for '-x' micro seconds. hSelect :: [Handle] -> [Handle] -> [Handle] -> TimeOut -> IO SelectResult type SelectResult = ( [Handle] -- input handles ready , [Handle] -- output handles ready , [Handle] -- exc. handles ready ) Here's an example of how it could be used: module Main(main) where import Select import IO main :: IO () main = do hSetBuffering stdin NoBuffering putStrLn "waiting for input to appear" hSelect [stdin] [] [] Nothing putStrLn "input ready, let's try reading" x <- getChar print x where the call to hSelect makes the process go to sleep until there's input available on stdin. Using <literal>hSelect</literal> with Concurrent Haskell In brief: don't. For two reasons: hSelect will cause all your Haskell threads to block until the hSelect returns, much like any call to a foreign function. You don't need to. Concurrent Haskell will let you do I/O on multiple file handles concurrently by forking threads, and if you need to assign a timeout, then this can be done using a combination of threadDelay and asynchronous exceptions. hugs98-plus-Sep2006/fptools/hslibs/util/doc/Unique.xml0000644006511100651110000000120110111701602021426 0ustar rossross <literal>Unique</literal>: Generating unique symbols Unique module The Unique library has been moved to the hierarchical libraries; it can be found in Data.Unique in the base package. hugs98-plus-Sep2006/fptools/hslibs/util/doc/util.xml0000644006511100651110000000024110111701602021140 0ustar rossrossThe <literal>util</literal> package: miscellaneous utilities &getopt; &memo; &quickcheck; &readline; &select; hugs98-plus-Sep2006/fptools/hslibs/posix/0000755006511100651110000000000010504340143017071 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/posix/cbits/0000755006511100651110000000000010504340143020175 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/posix/cbits/HsPosix.h0000644006511100651110000000344410213226762021757 0ustar rossross/* ----------------------------------------------------------------------------- * $Id: HsPosix.h,v 1.8 2005/03/08 04:45:38 wolfgang Exp $ * * Definitions for package `posix' which are visible in Haskell land. * * ---------------------------------------------------------------------------*/ #ifndef HSPOSIX_H #define HSPOSIX_H #ifdef HAVE_SYS_WAIT_H #include #endif /* HAVE_SYS_WAIT_H */ #ifdef HAVE_SIGNAL_H #include #endif /* HAVE_SIGNAL_H */ #ifdef HAVE_SYS_UTSNAME_H #include #endif /* HAVE_SYS_UTSNAME_H */ #ifdef HAVE_SYS_TIMES_H #include #endif /* HAVE_SYS_TIMES_H */ #ifdef HAVE_DIRENT_H #include #endif /* HAVE_DIRENT_H */ #ifdef HAVE_SYS_STAT_H #include #endif /* HAVE_SYS_STAT_H */ #ifdef HAVE_FCNTL_H #include #endif /* HAVE_FCNTL_H */ #ifdef HAVE_UNISTD_H #include #endif /* HAVE_UNISTD_H */ #ifdef HAVE_UTIME_H #include #endif /* HAVE_UTIME_H */ #ifdef HAVE_TERMIOS_H #include #endif /* HAVE_TERMIOS_H */ #ifdef HAVE_GRP_H #include #endif /* HAVE_GRP_H */ #ifdef HAVE_PWD_H #include #endif /* HAVE_PWD_H */ #if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif #include #ifndef _POSIX_VDISABLE #define _POSIX_VDISABLE '\0' /* Just a guess...but it works for Suns */ #endif extern I_ nocldstop; extern char *strDup(const char *); extern char **environ; extern int setenviron(char **); extern int copyenv(void); extern int _setenv(char *); extern int delenv(char *); extern void stg_sigaddset(StgByteArray newset, StgByteArray oldset, int signum); extern void stg_sigdelset(StgByteArray newset, StgByteArray oldset, int signum); #endif hugs98-plus-Sep2006/fptools/hslibs/posix/cbits/Makefile0000644006511100651110000000050310276331555021650 0ustar rossross# $Id: Makefile,v 1.18 2005/08/10 07:57:33 simonmar Exp $ TOP = ../.. include $(TOP)/mk/boilerplate.mk SRC_CC_OPTS += -Wall SRC_CC_OPTS += -I$(GHC_INCLUDE_DIR) -I$(GHC_RUNTIME_DIR) LIBRARY = libHSposix_cbits.a LIBOBJS = $(C_OBJS) includedir = $(libdir)/include INSTALL_INCLUDES = HsPosix.h include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/posix/cbits/env.c0000644006511100651110000000741510176437212021151 0ustar rossross/* * (c) The GRASP/AQUA Project, Glasgow University, 1995-1996 * * \subsection[env.lc]{Environment Handling for LibPosix} * * Many useful environment functions are not necessarily provided by libc. * To get around this problem, we introduce our own. The first time that * you modify your environment, we copy the environment wholesale into * malloc'ed locations, so that subsequent modifications can do proper * memory management. The $environ$ variable is updated with a pointer * to the current environment so that the normal $getenv$ and $exec*$ functions * should continue to work properly. */ #include "Rts.h" #include "HsPosix.h" #include #include #include #include /* Switch this on once we've moved the environment to the malloc arena */ int dirtyEnv = 0; /* * For some reason, OSF turns off the prototype for this if we're * _POSIX_SOURCE. Seems to me that this ought to be an ANSI-ism * rather than a POSIX-ism, but no matter. (JSM(?)) */ char * strDup(const char *src) { int len = strlen(src) + 1; char *dst; if ((dst = malloc(len)) != NULL) memcpy(dst, src, len); return dst; } /* Replace the entire environment */ int setenviron(char **envp) { char **old = environ; int dirtyOld = dirtyEnv; int i; /* A quick hack to move the strings out of the heap */ environ = envp; if (copyenv() != 0) { environ = old; errno = ENOMEM; return -1; } /* Release the old space if we allocated it ourselves earlier */ if (dirtyOld) { for (i = 0; old[i] != NULL; i++) free(old[i]); free(old); } return 0; } /* Copy initial environment into malloc arena */ int copyenv(void) { char **new; int i; for (i = 0; environ[i] != NULL; i++) ; if ((new = (char **) malloc((i + 1) * sizeof(char *))) == NULL) { errno = ENOMEM; return -1; } new[i] = NULL; while (--i >= 0) { if ((new[i] = strDup(environ[i])) == NULL) { while (new[++i] != NULL) free(new[i]); free(new); errno = ENOMEM; return -1; } } environ = new; dirtyEnv = 1; return 0; } /* Set or replace an environment variable * simonm 14/2/96 - this is different to the standard C library * implementation and the prototypes clash, so I'm calling it _setenv. */ int _setenv(char *mapping) { int i, keylen; char *p; char **new; /* We must have a non-empty key and an '=' */ if (mapping[0] == '=' || (p = strchr(mapping, '=')) == NULL) { errno = EINVAL; return -1; } /* Include through the '=' for matching */ keylen = p - mapping + 1; if (!dirtyEnv && copyenv() != 0) return -1; if ((p = strDup(mapping)) == NULL) return -1; /* Look for an existing key that matches */ for (i = 0; environ[i] != NULL && strncmp(environ[i], p, keylen) != 0; i++); if (environ[i] != NULL) { free(environ[i]); environ[i] = p; } else { /* We want to grow the table by *two*, one for the new entry, one for the terminator */ if ((new = (char **) realloc((void*)environ, (i + 2) * sizeof(char *))) == NULL) { free(p); return -1; } new[i] = p; new[i + 1] = NULL; environ = new; } return 0; } /* Delete a variable from the environment */ int delenv(char *name) { int i, keylen; if (strchr(name, '=') != NULL) { errno = EINVAL; return -1; } keylen = strlen(name); if (!dirtyEnv && copyenv() != 0) return -1; /* Look for a matching key */ for (i = 0; environ[i] != NULL && (strncmp(environ[i], name, keylen) != 0 || environ[i][keylen] != '='); i++); /* Don't complain if it wasn't there to begin with */ if (environ[i] == NULL) { return 0; } free(environ[i]); do { environ[i] = environ[i + 1]; i++; } while (environ[i] != NULL); return 0; } hugs98-plus-Sep2006/fptools/hslibs/posix/cbits/signal.c0000644006511100651110000000140507115221151021617 0ustar rossross/* * (c) Juan Quintela, Universidade da Corunha 1998 * * wrappers for signal funcions * * sigset_t is a struct in some UNIXes (LINUX/glibc for instance) * and it is not posible to do the inline (_casm_). These functions * aren't inline because it causes gcc to run out of registers on x86. * * Ugly casting added by SUP to avoid C compiler warnings about * incompatible pointer types. */ #include "Rts.h" #include "HsPosix.h" void stg_sigaddset(StgByteArray newset, StgByteArray oldset, int signum) { *((sigset_t *)newset) = *((sigset_t *)oldset); sigaddset((sigset_t *)newset, signum); } void stg_sigdelset(StgByteArray newset, StgByteArray oldset, int signum) { *((sigset_t *)newset) = *((sigset_t *)oldset); sigdelset((sigset_t *)newset, signum); } hugs98-plus-Sep2006/fptools/hslibs/posix/.cvsignore0000644006511100651110000000004407755674703021121 0ustar rossrossDLPrim.hs DLPrim_hsc.c DLPrim_hsc.h hugs98-plus-Sep2006/fptools/hslibs/posix/DL.hs0000644006511100651110000000705310127310576017741 0ustar rossross{-# OPTIONS -#include "HsPosix.h" #-} -- Haskell Binding for dl{open,sym,...} -*-haskell-*- -- -- Author : Volker Stolz -- -- Created: 2001-11-22 -- -- Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs -- I left the API more or less the same, mostly the flags are different. -- -- License: BSD -- -- Usage: -- ****** -- -- Let's assume you want to open a local shared library 'foo' (./libfoo.so) -- offering a function -- char * mogrify (char*,int) -- and invoke str = mogrify("test",1): -- -- type Fun = CString -> Int -> IO CString -- foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun -- -- withModule (Just ".") ("libfoo.so") [RTLD_NOW] $ \ mod -> do -- funptr <- moduleSymbol mod "mogrify" -- let fun = fun__ funptr -- withCString "test" $ \ str -> do -- strptr <- fun str 1 -- strstr <- peekCString strptr -- ... module DL {-# DEPRECATED "Use System.Posix.DynamicLinker and System.Posix.DynamicLinker.Prim.Module instead" #-} ( module DLPrim , moduleOpen -- :: String -> ModuleFlags -> IO Module , moduleSymbol -- :: Source -> String -> IO (FunPtr a) , moduleClose -- :: Module -> IO Bool , moduleError -- :: IO String , withModule -- :: Maybe String -- -> String -- -> [ModuleFlags ] -- -> (Module -> IO a) -- -> IO a , withModule_ -- :: Maybe String -- -> String -- -> [ModuleFlags] -- -> (Module -> IO a) -- -> IO () ) where import DLPrim import Foreign.Ptr ( Ptr, nullPtr, FunPtr, nullFunPtr ) import Foreign.C.String ( CString, withCString, peekCString ) -- abstract handle for dynamically loaded module (EXPORTED) -- newtype Module = Module (Ptr ()) unModule :: Module -> (Ptr ()) unModule (Module adr) = adr -- Opens a module (EXPORTED) -- moduleOpen :: String -> [ModuleFlags] -> IO Module moduleOpen mod flags = do modPtr <- withCString mod $ \ modAddr -> dlopen modAddr (packModuleFlags flags) if (modPtr == nullPtr) then moduleError >>= \ err -> ioError (userError ("dlopen: " ++ err)) else return $ Module modPtr -- Gets a symbol pointer from a module (EXPORTED) -- moduleSymbol :: Module -> String -> IO (FunPtr a) moduleSymbol mod sym = do withCString sym $ \ symPtr -> do ptr <- dlsym (unModule mod) symPtr if (ptr /= nullFunPtr) then return ptr else moduleError >>= \ err -> ioError (userError ("dlsym: " ++ err)) -- Closes a module (EXPORTED) -- moduleClose :: Module -> IO () moduleClose mod = dlclose (unModule mod) -- Gets a string describing the last module error (EXPORTED) -- moduleError :: IO String moduleError = peekCString =<< dlerror -- Convenience function, cares for module open- & closing -- additionally returns status of `moduleClose' (EXPORTED) -- withModule :: Maybe String -> String -> [ModuleFlags] -> (Module -> IO a) -> IO a withModule dir mod flags p = do let modPath = case dir of Nothing -> mod Just p -> p ++ if ((head (reverse p)) == '/') then mod else ('/':mod) mod <- moduleOpen modPath flags result <- p mod moduleClose mod return result withModule_ :: Maybe String -> String -> [ModuleFlags] -> (Module -> IO a) -> IO () withModule_ dir mod flags p = withModule dir mod flags p >>= \ _ -> return () hugs98-plus-Sep2006/fptools/hslibs/posix/DLPrim.hs0000644006511100651110000000250010314034325020552 0ustar rossross-- Haskell Binding for dl{open,sym,...} -*-haskell-*- -- -- Author : Volker Stolz -- -- Created: 2001-11-22 -- -- Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs -- I left the API more or less the same, mostly the flags are different. -- -- License: BSD -- module DLPrim {-# DEPRECATED "Use System.Posix.DynamicLinker.Prim instead" #-} ( dlopen, dlsym, dlerror, dlclose, -- dlAddr, -- XXX NYI haveRtldNext, haveRtldLocal, packModuleFlags, ModuleFlags, RTLDFlags(..), Source(..) ) where import Foreign.Ptr ( Ptr, FunPtr ) import Foreign.C.Types ( CInt ) import Foreign.C.String ( CString ) import System.Posix.DynamicLinker.Prim ( haveRtldNext, haveRtldLocal, RTLDFlags(..), packRTLDFlags ) -- data type definition -- -------------------- -- flags passed to `moduleOpen' (EXPORTED) -- type ModuleFlags = RTLDFlags foreign import ccall unsafe "dlopen" dlopen :: CString -> CInt -> IO (Ptr ()) foreign import ccall unsafe "dlsym" dlsym :: (Ptr ()) -> CString -> IO (FunPtr a) foreign import ccall unsafe "dlerror" dlerror :: IO CString foreign import ccall unsafe "dlclose" dlclose :: (Ptr ()) -> IO () packModuleFlags :: [ModuleFlags] -> CInt packModuleFlags = packRTLDFlags data Source = Null | Next | Default | Name CString hugs98-plus-Sep2006/fptools/hslibs/posix/Makefile0000644006511100651110000000043610314034325020535 0ustar rossross# $Id: Makefile,v 1.34 2005/09/20 16:29:09 ross Exp $ TOP=.. include $(TOP)/mk/boilerplate.mk PACKAGE = posix VERSION = 1.0 PACKAGE_DEPS = lang unix SUBDIRS = cbits SRC_HC_OPTS += -cpp -fglasgow-exts -fvia-C -Icbits SRC_CC_OPTS += -I../../ghc/includes include $(TOP)/mk/target.mk hugs98-plus-Sep2006/fptools/hslibs/posix/POpen.hs0000644006511100651110000000666710130736254020474 0ustar rossross----------------------------------------------------------------------------- -- -- Module : POpen -- Copyright : (c) The University of Glasgow 2002 -- (c) 2001-2002 Jens-Ulrik Holger Petersen -- License : BSD-style -- -- Maintainer : petersen@haskell.org -- Stability : experimental -- Portability : non-portable (requires POSIX support from the OS) -- -- $Id: POpen.hs,v 1.6 2004/10/06 09:36:44 ross Exp $ -- -- Convenient string input to and output from a subprocess -- ----------------------------------------------------------------------------- -- -- Description -- -- POpen provides a convenient way of sending string input to a -- subprocess and reading output from it lazily. -- -- It provides two functions popen and popenEnvDir. -- -- * popen gives lazy output and error streams from a -- subprocess command, and optionally can direct input from a -- string to the process. -- -- * popenEnvDir in addition lets one specify the environment -- and directory in which to run the subprocess command. -- -- This code is originally based on Posix.runProcess, but it -- uses file descriptors and pipes internally instead of -- handles and returns the output and error streams lazily as -- strings and also the pid of forked process. module POpen {-# DEPRECATED "This functionality is now available from System.Process" #-} (popen, popenEnvDir) where import PosixIO ( createPipe, dupTo, fdClose, fdToHandle ) import PosixProcPrim ( executeFile, forkProcess ) import System.Posix ( ProcessID, Fd, ProcessID, stdInput, stdOutput, stdError ) import System.Directory ( setCurrentDirectory ) import System.IO ( hGetContents, hPutStr, hClose ) import Data.Maybe ( fromJust, isJust ) import Control.Monad ( when ) popen :: FilePath -- Command -> [String] -- Arguments -> Maybe String -- Input -> IO (String, String, ProcessID) -- (stdout, stderr, pid) popen path args inpt = popenEnvDir path args inpt Nothing Nothing popenEnvDir :: FilePath -- Command -> [String] -- Arguments -> Maybe String -- Input -> Maybe [(String, String)] -- Environment -> Maybe FilePath -- Working directory -> IO (String, String, ProcessID) -- (stdout, stderr, pid) popenEnvDir path args inpt env dir = do inr <- if (isJust inpt) then do (inr', inw) <- createPipe hin <- fdToHandle inw hPutStr hin $ fromJust inpt hClose hin return $ Just inr' else return Nothing (outr, outw) <- createPipe (errr, errw) <- createPipe p <- forkProcess (doTheBusiness inr outw errw) -- close other end of pipes in here when (isJust inr) $ fdClose $ fromJust inr fdClose outw fdClose errw hout <- fdToHandle outr outstrm <- hGetContents hout herr <- fdToHandle errr errstrm <- hGetContents herr return (outstrm, errstrm , p) where doTheBusiness :: Maybe Fd -- stdin -> Fd -- stdout -> Fd -- stderr -> IO () doTheBusiness inr outw errw = do maybeChangeWorkingDirectory dir when (isJust inr) $ (do dupTo (fromJust inr) stdInput; return ()) dupTo outw stdOutput dupTo errw stdError executeFile path True args env -- for typing, should never actually run error "executeFile failed!" maybeChangeWorkingDirectory :: Maybe FilePath -> IO () maybeChangeWorkingDirectory dir = case dir of Nothing -> return () Just x -> setCurrentDirectory x hugs98-plus-Sep2006/fptools/hslibs/posix/Posix.lhs0000644006511100651110000000651310127370704020717 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996 % \section[Posix]{Haskell 1.3 POSIX bindings} \begin{code} {-# OPTIONS -#include "HsPosix.h" #-} module Posix {-# DEPRECATED "This functionality is now available from System.Posix" #-} ( module PosixDB, module PosixErr, module PosixFiles, module PosixIO, module PosixProcEnv, module PosixProcPrim, module PosixTTY, module POpen, runProcess, ByteCount, Fd, intToFd, fdToInt, ClockTick, EpochTime, FileOffset, GroupID, Limit, LinkCount, ProcessID, ProcessGroupID, UserID ) where import System.Posix import GHC.Base import GHC.IOBase import PosixDB import PosixErr import PosixFiles import PosixIO import PosixProcEnv import PosixProcPrim import PosixTTY import PosixUtil import POpen -- [OLD COMMENT:] -- runProcess is our candidate for the high-level OS-independent primitive -- If accepted, it will be moved out of Posix into LibSystem. -- -- ***NOTE***: make sure you completely force the evaluation of the path -- and arguments to the child before calling runProcess. If you don't do -- this *and* the arguments from runProcess are read in from a file lazily, -- be prepared for some rather weird parent-child file I/O behaviour. -- -- [If you don't force the args, consider the case where the -- arguments emanate from a file that is read lazily, using hGetContents -- or some such. Since a child of a fork() inherits the opened files of -- the parent, the child can force the evaluation of the arguments and -- read them off the file without any problems. The problem is that -- while the child share a file table with the parent, it has -- separate buffers, so a child may fill up its (copy of) the buffer, but -- only read it partially. When the *parent* tries to read from the shared file again, -- the (shared) file offset will have been stepped on by whatever number of chars -- that was copied into the file buffer of the child. i.e., the unused parts of the -- buffer will *not* be seen, resulting in random/unpredicatable results. -- -- Based on a true (, debugged :-) story. -- ] import System.Directory ( setCurrentDirectory ) fdToInt :: Fd -> Int fdToInt = fromIntegral intToFd :: Int -> Fd intToFd = fromIntegral runProcess :: FilePath -- Command -> [String] -- Arguments -> Maybe [(String, String)] -- Environment -> Maybe FilePath -- Working directory -> Maybe Handle -- stdin -> Maybe Handle -- stdout -> Maybe Handle -- stderr -> IO () runProcess path args env dir stdin stdout stderr = do forkProcess doTheBusiness return () where doTheBusiness :: IO () doTheBusiness = do maybeChangeWorkingDirectory maybeDup2 0 stdin maybeDup2 1 stdout maybeDup2 2 stderr executeFile path True args env syserr "runProcess" maybeChangeWorkingDirectory :: IO () maybeChangeWorkingDirectory = case dir of Nothing -> return () Just x -> setCurrentDirectory x maybeDup2 :: Int -> Maybe Handle -> IO () maybeDup2 dest h = case h of Nothing -> return () Just x -> do src <- handleToFd x dupTo src (intToFd dest) return () \end{code} hugs98-plus-Sep2006/fptools/hslibs/posix/PosixDB.lhs0000644006511100651110000000103410127370704021116 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995-1997 % \section[PosixDB]{Haskell 1.4 POSIX System Databases} \begin{code} module PosixDB {-# DEPRECATED "This module has been superseded by System.Posix.User" #-} ( GroupEntry(..), UserEntry(..), getUserEntryForID, -- :: UserID -> IO UserEntry getUserEntryForName, -- :: String -> IO UserEntry getGroupEntryForID, -- :: GroupID -> IO GroupEntry getGroupEntryForName -- :: String -> IO GroupEntry ) where import System.Posix \end{code} hugs98-plus-Sep2006/fptools/hslibs/posix/PosixErr.lhs0000644006511100651110000000661210127370704021370 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996 % \section[PosixErr]{Haskell 1.3 POSIX Error Codes} \begin{code} {-# OPTIONS -#include "HsPosix.h" #-} module PosixErr {-# DEPRECATED "This functionality is now available from Foreign.C.Error" #-} ( ErrorCode, getErrorCode, noError, argumentListTooLong, e2BIG, badFd, eBADF, brokenPipe, ePIPE, directoryNotEmpty, eNOTEMPTY, execFormatError, eNOEXEC, fileAlreadyExists, eEXIST, fileTooLarge, eFBIG, filenameTooLong, eNAMETOOLONG, improperLink, eXDEV, inappropriateIOControlOperation, eNOTTY, inputOutputError, eIO, interruptedOperation, eINTR, invalidArgument, eINVAL, invalidSeek, eSPIPE, isADirectory, eISDIR, noChildProcess, eCHILD, noLocksAvailable, eNOLCK, noSpaceLeftOnDevice, eNOSPC, noSuchOperationOnDevice, eNODEV, noSuchDeviceOrAddress, eNXIO, noSuchFileOrDirectory, eNOENT, noSuchProcess, eSRCH, notADirectory, eNOTDIR, notEnoughMemory, eNOMEM, operationNotImplemented, eNOSYS, operationNotPermitted, ePERM, permissionDenied, eACCES, readOnlyFileSystem, eROFS, resourceBusy, eBUSY, resourceDeadlockAvoided, eDEADLK, resourceTemporarilyUnavailable, eAGAIN, tooManyLinks, eMLINK, tooManyOpenFiles, eMFILE, tooManyOpenFilesInSystem, eNFILE, ) where import GHC.IOBase import Foreign.C.Error type ErrorCode = Errno getErrorCode :: IO ErrorCode getErrorCode = getErrno noError :: ErrorCode noError = eOK argumentListTooLong :: ErrorCode argumentListTooLong = e2BIG badFd :: ErrorCode badFd = eBADF brokenPipe :: ErrorCode brokenPipe = ePIPE directoryNotEmpty :: ErrorCode directoryNotEmpty = eNOTEMPTY execFormatError :: ErrorCode execFormatError = eNOEXEC fileAlreadyExists :: ErrorCode fileAlreadyExists = eEXIST fileTooLarge :: ErrorCode fileTooLarge = eFBIG filenameTooLong :: ErrorCode filenameTooLong = eNAMETOOLONG improperLink :: ErrorCode improperLink = eXDEV inappropriateIOControlOperation :: ErrorCode inappropriateIOControlOperation = eNOTTY inputOutputError :: ErrorCode inputOutputError = eIO interruptedOperation :: ErrorCode interruptedOperation = eINTR invalidArgument :: ErrorCode invalidArgument = eINVAL invalidSeek :: ErrorCode invalidSeek = eSPIPE isADirectory :: ErrorCode isADirectory = eISDIR noChildProcess :: ErrorCode noChildProcess = eCHILD noLocksAvailable :: ErrorCode noLocksAvailable = eNOLCK noSpaceLeftOnDevice :: ErrorCode noSpaceLeftOnDevice = eNOSPC noSuchOperationOnDevice :: ErrorCode noSuchOperationOnDevice = eNODEV noSuchDeviceOrAddress :: ErrorCode noSuchDeviceOrAddress = eNXIO noSuchFileOrDirectory :: ErrorCode noSuchFileOrDirectory = eNOENT noSuchProcess :: ErrorCode noSuchProcess = eSRCH notADirectory :: ErrorCode notADirectory = eNOTDIR notEnoughMemory :: ErrorCode notEnoughMemory = eNOMEM operationNotImplemented :: ErrorCode operationNotImplemented = eNOSYS operationNotPermitted :: ErrorCode operationNotPermitted = ePERM permissionDenied :: ErrorCode permissionDenied = eACCES readOnlyFileSystem :: ErrorCode readOnlyFileSystem = eROFS resourceBusy :: ErrorCode resourceBusy = eBUSY resourceDeadlockAvoided :: ErrorCode resourceDeadlockAvoided = eDEADLK resourceTemporarilyUnavailable :: ErrorCode resourceTemporarilyUnavailable = eAGAIN tooManyLinks :: ErrorCode tooManyLinks = eMLINK tooManyOpenFiles :: ErrorCode tooManyOpenFiles = eMFILE tooManyOpenFilesInSystem :: ErrorCode tooManyOpenFilesInSystem = eNFILE \end{code} hugs98-plus-Sep2006/fptools/hslibs/posix/PosixFiles.lhs0000644006511100651110000000372610127370704021705 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996 % \section[PosixFiles]{Haskell 1.3 POSIX File and Directory Operations} \begin{code} {-# OPTIONS -#include "HsPosix.h" #-} module PosixFiles {-# DEPRECATED "This functionality is now available from System.Posix.Directory and System.Posix.Files" #-} ( -- Directory streams DirStream, openDirStream, closeDirStream, readDirStream, rewindDirStream, -- set/get process' working directory. getWorkingDirectory, changeWorkingDirectory, -- File modes/permissions FileMode, nullFileMode, ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes, groupReadMode, groupWriteMode, groupExecuteMode, groupModes, otherReadMode, otherWriteMode, otherExecuteMode, otherModes, setUserIDMode, setGroupIDMode, stdFileMode, accessModes, unionFileModes, intersectFileModes, -- File operations on descriptors stdInput, stdOutput, stdError, OpenMode(..), OpenFileFlags(..), defaultFileFlags, openFd, createFile, -- other file&directory operations setFileCreationMask, createLink, removeLink, createDirectory, removeDirectory, createNamedPipe, rename, -- FileStatus FileStatus, getFileStatus, getFdStatus, fileExist, fileAccess, setFileMode, fileMode, fileID, FileID, deviceID, DeviceID, linkCount, fileOwner, fileGroup, fileSize, accessTime, modificationTime, statusChangeTime, isDirectory, isCharacterDevice, isBlockDevice, isRegularFile, isNamedPipe, setOwnerAndGroup, -- chown (might be restricted) setFileTimes, -- set access and modification time touchFile, -- set access and modification time to current time. -- run-time limit & POSIX feature testing PathVar(..), getPathVar, getFileVar ) where import System.Posix import System.Directory ( removeDirectory ) getFileVar = getFdPathVar \end{code} hugs98-plus-Sep2006/fptools/hslibs/posix/PosixIO.lhs0000644006511100651110000000114210127370705021141 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996 % \section[PosixIO]{Haskell 1.3 POSIX Input/Output Primitives} \begin{code} {-# OPTIONS -#include "HsPosix.h" #-} module PosixIO {-# DEPRECATED "This module has been superseded by System.Posix.IO" #-} ( FdOption(..), FileLock, LockRequest(..), fdClose, createPipe, dup, dupTo, fdRead, fdWrite, fdSeek, queryFdOption, setFdOption, getLock, setLock, waitToSetLock, -- Handle <-> Fd handleToFd, fdToHandle, ) where import System.Posix fdClose = closeFd \end{code} hugs98-plus-Sep2006/fptools/hslibs/posix/PosixProcEnv.lhs0000644006511100651110000000167710176437211022223 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996 % \section[PosixProcEnv]{Haskell 1.3 POSIX Process Environment} \begin{code} {-# OPTIONS -#include "HsPosix.h" #-} #include "ghcconfig.h" module PosixProcEnv {-# DEPRECATED "This module has been superseded by System.Posix.Process" #-} ( ProcessTimes(..), SysVar(..), SystemID(..), createProcessGroup, createSession, epochTime, #if !defined(cygwin32_HOST_OS) getControllingTerminalName, #endif getEffectiveGroupID, getEffectiveUserID, getEffectiveUserName, #if !defined(cygwin32_HOST_OS) getGroups, #endif getLoginName, getParentProcessID, getProcessGroupID, getProcessID, getProcessTimes, getRealGroupID, getRealUserID, getSysVar, getSystemID, getTerminalName, joinProcessGroup, queryTerminal, setGroupID, setProcessGroupID, setUserID ) where import System.Posix \end{code} hugs98-plus-Sep2006/fptools/hslibs/posix/PosixProcPrim.lhs0000644006511100651110000000441010176437212022367 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995-1997 % \section[PosixProcPrim]{Haskell 1.3 POSIX Process Primitives} \begin{code} {-# OPTIONS -#include "HsPosix.h" #-} #include "ghcconfig.h" module PosixProcPrim {-# DEPRECATED "This module has been superseded by System.Posix.Process and System.Posix.Env" #-} ( Handler(..), SignalSet, Signal, ProcessStatus(..), addSignal, #ifndef cygwin32_HOST_OS awaitSignal, #endif backgroundRead, backgroundWrite, blockSignals, #ifndef cygwin32_HOST_OS continueProcess, #endif deleteSignal, emptySignalSet, executeFile, exitImmediately, floatingPointException, forkProcess, fullSignalSet, getAnyProcessStatus, getEnvVar, getEnvironment, getGroupProcessStatus, getPendingSignals, getProcessStatus, getSignalMask, illegalInstruction, inSignalSet, installHandler, internalAbort, keyboardSignal, keyboardStop, keyboardTermination, killProcess, lostConnection, nullSignal, openEndedPipe, processStatusChanged, queryStoppedChildFlag, raiseSignal, realTimeAlarm, removeEnvVar, scheduleAlarm, segmentationViolation, setEnvVar, setSignalMask, setStoppedChildFlag, sigABRT, sigALRM, sigCHLD, #ifndef cygwin32_HOST_OS sigCONT, #endif sigFPE, sigHUP, sigILL, sigINT, sigKILL, sigPIPE, sigQUIT, sigSEGV, sigSTOP, sigTERM, sigTSTP, sigTTIN, sigTTOU, sigUSR1, sigUSR2, signalProcess, signalProcessGroup, sleep, softwareStop, softwareTermination, unBlockSignals, userDefinedSignal1, userDefinedSignal2, ExitCode ) where import System.Posix import System.Posix.Env import GHC.IOBase import GlaExts import Foreign getEnvVar :: String -> IO String getEnvVar name = do value <- System.Posix.Env.getEnv name case value of Nothing -> ioError (userError $ "getEnvVar: no such environment variable " ++ name) Just v -> return v setEnvVar :: String -> String -> IO () setEnvVar name value = System.Posix.Env.setEnv name value True{-overwrite-} removeEnvVar :: String -> IO () removeEnvVar = System.Posix.Env.unsetEnv unBlockSignals = unblockSignals \end{code} hugs98-plus-Sep2006/fptools/hslibs/posix/PosixTTY.lhs0000644006511100651110000000163510127370706021322 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996 % \section[PosixTTY]{Haskell 1.3 POSIX Device-Specific Functions} \begin{code} {-# OPTIONS -#include "HsPosix.h" #-} module PosixTTY {-# DEPRECATED "This module has been superseded by System.Posix.Terminal" #-} ( BaudRate(..), ControlCharacter(..), FlowAction(..), QueueSelector(..), TerminalAttributes, TerminalMode(..), TerminalState(..), bitsPerByte, controlChar, controlFlow, discardData, drainOutput, getTerminalAttributes, getTerminalProcessGroupID, inputSpeed, inputTime, minInput, outputSpeed, sendBreak, setTerminalAttributes, setTerminalProcessGroupID, terminalMode, withBits, withCC, withInputSpeed, withMinInput, withMode, withOutputSpeed, withTime, withoutCC, withoutMode ) where import System.Posix \end{code} hugs98-plus-Sep2006/fptools/hslibs/posix/PosixUtil.lhs0000644006511100651110000000240710127370706021555 0ustar rossross% % (c) The GRASP/AQUA Project, Glasgow University, 1995-1999 % \section[PosixUtil]{(Glasgow) Haskell POSIX utilities} \begin{code} {-# OPTIONS -#include "HsPosix.h" #-} module PosixUtil {-# DEPRECATED "This functionality is now available from Foreign.Marshal.Error" #-} where import System.Posix.Types import GlaExts import GHC.IOBase -- IOError representation \end{code} Now some local functions that shouldn't go outside this library. Fail with a SystemError. Normally, we do not try to re-interpret POSIX error numbers, so most routines in this file will only fail with SystemError. The only exceptions are (1) those routines where failure of some kind may be considered ``normal''...e.g. getpwnam() for a non-existent user, or (2) those routines which do not set errno. \begin{code} syserr :: String -> IO a syserr str = ioException (IOError Nothing -- ToDo: better SystemError str "" Nothing) -- common templates for system calls nonzero_error :: IO Int -> String -> IO () nonzero_error io err = do rc <- io if rc == 0 then return () else syserr err minusone_error :: IO Int -> String -> IO () minusone_error io err = do rc <- io if rc /= -1 then return () else syserr err \end{code} hugs98-plus-Sep2006/fptools/hslibs/posix/package.conf.in0000644006511100651110000000176310205402200021736 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: False exposed-modules: DL, DLPrim, POpen, Posix, PosixDB, PosixErr, PosixFiles, PosixIO, PosixProcEnv, PosixProcPrim, PosixTTY, PosixUtil hidden-modules: #ifdef INSTALLING import-dirs: PKG_LIBDIR"/hslibs-imports/posix" #else import-dirs: FPTOOLS_TOP_ABS"/hslibs/posix" #endif #ifdef INSTALLING library-dirs: PKG_LIBDIR #else library-dirs: FPTOOLS_TOP_ABS"/hslibs/posix", FPTOOLS_TOP_ABS"/hslibs/posix/cbits" #endif hs-libraries: "HSposix" extra-libraries: "HSposix_cbits" #if !defined(HAVE_FRAMEWORK_HASKELLSUPPORT) && defined(HAVE_LIBDL) , "dl" #endif #ifdef INSTALLING include-dirs: #else include-dirs: FPTOOLS_TOP_ABS"/hslibs/posix/cbits" #endif includes: HsPosix.h depends: lang, unix hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: haddock-html: hugs98-plus-Sep2006/fptools/hslibs/posix/doc/0000755006511100651110000000000010504340143017636 5ustar rossrosshugs98-plus-Sep2006/fptools/hslibs/posix/doc/posix.xml0000644006511100651110000017236410111701576021544 0ustar rossrossThe <literal>posix</literal> package: POSIX support Posix library libraries, Posix The Posix interface gives you access to the set of OS services standardised by POSIX 1003.1b (or the IEEE Portable Operating System Interface for Computing Environments - IEEE Std. 1003.1). The interface is accessed by import Posix and adding on your command-line. The Posix package is not supported under Windows. We've looked into various ways of providing support, and other than using Cygwin, none is particularly attractive. If you want Posix support under Windows, try building GHC for Cygwin; we don't currently do this, but it is mostly supported. Posix data types Posix, data types data ByteCount -- instances of : Eq Ord Num Real Integral Ix Enum Show A ByteCount is a primitive of type unsigned. At a minimum, an conforming implementation must support values in the range [0, UINT_MAX]. data ClockTick -- instances of : Eq Ord Num Real Integral Ix Enum Show A ClockTick is a primitive of type clock_t, which is used to measure intervals of time in fractions of a second. The resolution is determined by getSysVar ClockTick. data DeviceID -- instances of : Eq Ord Num Real Integral Ix Enum Show A DeviceID is a primitive of type dev_t. It must be an arithmetic type. data EpochTime -- instances of : Eq Ord Num Real Integral Ix Enum Show A EpochTime is a primitive of type time_t, which is used to measure seconds since the Epoch. At a minimum, the implementation must support values in the range [0, INT_MAX]. data FileID -- instances of : Eq Ord Num Real Integral Ix Enum Show A FileID is a primitive of type ino_t. It must be an arithmetic type. data FileMode -- instance of : Eq A FileMode is a primitive of type mode_t. It must be an arithmetic type. data FileOffset -- instances of : Eq Ord Num Real Integral Ix Enum Show A FileOffset is a primitive of type off_t. It must be an arithmetic type. data GroupID -- instances of : Eq Ord Num Real Integral Ix Enum Show A GroupID is a primitive of type gid_t. It must be an arithmetic type. data Limit -- instances of : Eq Ord Num Real Integral Ix Enum Show A Limit is a primitive of type long. At a minimum, the implementation must support values in the range [LONG_MIN, LONG_MAX]. data LinkCount -- instances of : Eq Ord Num Real Integral Ix Enum Show A LinkCount is a primitive of type nlink_t. It must be an arithmetic type. data ProcessID -- instances of : Eq Ord Num Real Integral Ix Enum Show type ProcessGroupID = ProcessID A ProcessID is a primitive of type pid_t. It must be a signed arithmetic type. data UserID -- instances of : Eq Ord Num Real Integral Ix Enum Show A UserID is a primitive of type uid_t. It must be an arithmetic type. data DirStream A DirStream is a primitive of type DIR *. data FileStatus A FileStatus is a primitive of type struct stat. data GroupEntry A GroupEntry is a primitive of type struct group. data ProcessTimes ProcessTimes is a primitive structure containing a clock_t and a struct tms. data SignalSet An SignalSet is a primitive of type sigset_t. data SystemID A SystemID is a primitive of type struct utsname. data TerminalAttributes TerminalAttributes is a primitive of type struct termios. data UserEntry A UserEntry is a primitive of type struct passwd. data BaudRate = B0 | B50 | B75 | B110 | B134 | B150 | B200 | B300 | B600 | B1200 | B1800 | B2400 | B4800 | B9600 | B19200 | B38400 deriving (Eq, Show) data Fd instance Eq Fd instance Show Fd intToFd :: Int -> Fd -- use with care. fdToInt :: Fd -> Int -- ditto. data FdOption = AppendOnWrite | CloseOnExec | NonBlockingRead data ControlCharacter = EndOfFile | EndOfLine | Erase | Interrupt | Kill | Quit | Suspend | Start | Stop type ErrorCode = Int type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset) -- whence start length data FlowAction = SuspendOutput | RestartOutput | TransmitStop | TransmitStart data Handler = Default | Ignore | Catch (IO ()) data LockRequest = ReadLock | WriteLock | Unlock deriving (Eq, Show) data OpenMode = ReadOnly | WriteOnly | ReadWrite data PathVar = LinkLimit | InputLineLimit | InputQueueLimit | FileNameLimit | PathNameLimit | PipeBufferLimit | SetOwnerAndGroupIsRestricted | FileNamesAreNotTruncated data QueueSelector = InputQueue | OutputQueue | BothQueues type Signal = Int data SysVar = ArgumentLimit | ChildLimit | ClockTick | GroupLimit | OpenFileLimit | PosixVersion | HasSavedIDs | HasJobControl data TerminalMode = InterruptOnBreak -- BRKINT | MapCRtoLF -- ICRNL | IgnoreBreak -- IGNBRK | IgnoreCR -- IGNCR | IgnoreParityErrors -- IGNPAR | MapLFtoCR -- INLCR | CheckParity -- INPCK | StripHighBit -- ISTRIP | StartStopInput -- IXOFF | StartStopOutput -- IXON | MarkParityErrors -- PARMRK | ProcessOutput -- OPOST | LocalMode -- CLOCAL | ReadEnable -- CREAD | TwoStopBits -- CSTOPB | HangupOnClose -- HUPCL | EnableParity -- PARENB | OddParity -- PARODD | EnableEcho -- ECHO | EchoErase -- ECHOE | EchoKill -- ECHOK | EchoLF -- ECHONL | ProcessInput -- ICANON | ExtendedFunctions -- IEXTEN | KeyboardInterrupts -- ISIG | NoFlushOnInterrupt -- NOFLSH | BackgroundWriteInterrupt -- TOSTOP data TerminalState = Immediately | WhenDrained | WhenFlushed data ProcessStatus = Exited ExitCode | Terminated Signal | Stopped Signal deriving (Eq, Show) Posix Process Primitives forkProcess :: IO (Maybe ProcessID) forkProcess calls fork, returning Just pid to the parent, where pid is the ProcessID of the child, and returning Nothing to the child. executeFile :: FilePath -- Command -> Bool -- Search PATH? -> [String] -- Arguments -> Maybe [(String, String)] -- Environment -> IO () executeFile cmd args env calls one of the execv* family, depending on whether or not the current PATH is to be searched for the command, and whether or not an environment is provided to supersede the process's current environment. The basename (leading directory names suppressed) of the command is passed to execv* as arg[0]; the argument list passed to executeFile therefore begins with arg[1]. Search PATH? Supersede environ? Call ~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~ ~~~~~~~ False False execv False True execve True False execvp True True execvpe* Note that execvpe is not provided by the POSIX standard, and must be written by hand. Care must be taken to ensure that the search path is extracted from the original environment, and not from the environment to be passed on to the new image. NOTE: In general, sharing open files between parent and child processes is potential bug farm, and should be avoided unless you really depend on this `feature' of POSIX' fork() semantics. Using Haskell, there's the extra complication that arguments to executeFile might come from files that are read lazily (using hGetContents, or some such.) If this is the case, then for your own sanity, please ensure that the arguments to executeFile have been fully evaluated before calling forkProcess (followed by executeFile.) Consider yourself warned :-) A successful executeFile overlays the current process image with a new one, so it only returns on failure. runProcess :: FilePath -- Command -> [String] -- Arguments -> Maybe [(String, String)] -- Environment (Nothing -> Inherited) -> Maybe FilePath -- Working directory (Nothing -> inherited) -> Maybe Handle -- stdin (Nothing -> inherited) -> Maybe Handle -- stdout (Nothing -> inherited) -> Maybe Handle -- stderr (Nothing -> inherited) -> IO () runProcess is our candidate for the high-level OS-independent primitive. runProcess cmd args env wd inhdl outhdl errhdl runs cmd (searching the current PATH) with arguments args. If env is Just pairs, the command is executed with the environment specified by pairs of variables and values; otherwise, the command is executed with the current environment. If wd is Just dir, the command is executed with working directory dir; otherwise, the command is executed in the current working directory. If {in,out,errhdl} is Just handle, the command is executed with the Fd for std{in,out,err} attached to the specified handle; otherwise, the Fd for std{in,out,err} is left unchanged. getProcessStatus :: Bool -- Block? -> Bool -- Stopped processes? -> ProcessID -> IO (Maybe ProcessStatus) getProcessStatus blk stopped pid calls waitpid, returning Just tc, the ProcessStatus for process pid if it is available, Nothing otherwise. If blk is False, then WNOHANG is set in the options for waitpid, otherwise not. If stopped is True, then WUNTRACED is set in the options for waitpid, otherwise not. getGroupProcessStatus :: Bool -- Block? -> Bool -- Stopped processes? -> ProcessGroupID -> IO (Maybe (ProcessID, ProcessStatus)) getGroupProcessStatus blk stopped pgid calls waitpid, returning Just (pid, tc), the ProcessID and ProcessStatus for any process in group pgid if one is available, Nothing otherwise. If blk is False, then WNOHANG is set in the options for waitpid, otherwise not. If stopped is True, then WUNTRACED is set in the options for waitpid, otherwise not. getAnyProcessStatus :: Bool -- Block? -> Bool -- Stopped processes? -> IO (Maybe (ProcessID, ProcessStatus)) getAnyProcessStatus blk stopped calls waitpid, returning Just (pid, tc), the ProcessID and ProcessStatus for any child process if one is available, Nothing otherwise. If blk is False, then WNOHANG is set in the options for waitpid, otherwise not. If stopped is True, then WUNTRACED is set in the options for waitpid, otherwise not. exitImmediately :: ExitCode -> IO () exitImmediately status calls _exit to terminate the process with the indicated exit status. The operation never returns. getEnvironment :: IO [(String, String)] getEnvironment parses the environment variable mapping provided by environ, returning (variable, value) pairs. The operation never fails. setEnvironment :: [(String, String)] -> IO () setEnvironment replaces the process environment with the provided mapping of (variable, value) pairs. getEnvVar :: String -> IO String getEnvVar var returns the value associated with variable var in the current environment (identical functionality provided through standard Haskell library function System.getEnv). The operation may fail with: NoSuchThing The variable has no mapping in the current environment. setEnvVar :: String -> String -> IO () setEnvVar var val sets the value associated with variable var in the current environment to be val. Any previous mapping is superseded. removeEnvVar :: String -> IO () removeEnvVar var removes any value associated with variable var in the current environment. Deleting a variable for which there is no mapping does not generate an error. nullSignal :: Signal nullSignal = 0 backgroundRead, sigTTIN :: Signal backgroundWrite, sigTTOU :: Signal continueProcess, sigCONT :: Signal floatingPointException, sigFPE :: Signal illegalInstruction, sigILL :: Signal internalAbort, sigABRT :: Signal keyboardSignal, sigINT :: Signal keyboardStop, sigTSTP :: Signal keyboardTermination, sigQUIT :: Signal killProcess, sigKILL :: Signal lostConnection, sigHUP :: Signal openEndedPipe, sigPIPE :: Signal processStatusChanged, sigCHLD :: Signal realTimeAlarm, sigALRM :: Signal segmentationViolation, sigSEGV :: Signal softwareStop, sigSTOP :: Signal softwareTermination, sigTERM :: Signal userDefinedSignal1, sigUSR1 :: Signal userDefinedSignal2, sigUSR2 :: Signal signalProcess :: Signal -> ProcessID -> IO () signalProcess int pid calls kill to signal process pid with interrupt signal int. raiseSignal :: Signal -> IO () raiseSignal int calls kill to signal the current process with interrupt signal int. signalProcessGroup :: Signal -> ProcessGroupID -> IO () signalProcessGroup int pgid calls kill to signal all processes in group pgid with interrupt signal int. setStoppedChildFlag :: Bool -> IO Bool setStoppedChildFlag bool sets a flag which controls whether or not the NOCLDSTOP option will be used the next time a signal handler is installed for SIGCHLD. If bool is True (the default), NOCLDSTOP will not be used; otherwise it will be. The operation never fails. queryStoppedChildFlag :: IO Bool queryStoppedChildFlag queries the flag which controls whether or not the NOCLDSTOP option will be used the next time a signal handler is installed for SIGCHLD. If NOCLDSTOP will be used, it returns False; otherwise (the default) it returns True. The operation never fails. emptySignalSet :: SignalSet fullSignalSet :: SignalSet addSignal :: Signal -> SignalSet -> SignalSet deleteSignal :: Signal -> SignalSet -> SignalSet inSignalSet :: Signal -> SignalSet -> Bool installHandler :: Signal -> Handler -> Maybe SignalSet -- other signals to block -> IO Handler -- old handler installHandler int handler iset calls sigaction to install an interrupt handler for signal int. If handler is Default, SIG_DFL is installed; if handler is Ignore, SIG_IGN is installed; if handler is Catch action, a handler is installed which will invoke action in a new thread when (or shortly after) the signal is received. See for details on how to communicate between threads. If iset is Just s, then the sa_mask of the sigaction structure is set to s; otherwise it is cleared. The previously installed signal handler for int is returned. getSignalMask :: IO SignalSet getSignalMask calls sigprocmask to determine the set of interrupts which are currently being blocked. setSignalMask :: SignalSet -> IO SignalSet setSignalMask mask calls sigprocmask with SIG_SETMASK to block all interrupts in mask. The previous set of blocked interrupts is returned. blockSignals :: SignalSet -> IO SignalSet setSignalMask mask calls sigprocmask with SIG_BLOCK to add all interrupts in mask to the set of blocked interrupts. The previous set of blocked interrupts is returned. unBlockSignals :: SignalSet -> IO SignalSet setSignalMask mask calls sigprocmask with SIG_UNBLOCK to remove all interrupts in mask from the set of blocked interrupts. The previous set of blocked interrupts is returned. getPendingSignals :: IO SignalSet getPendingSignals calls sigpending to obtain the set of interrupts which have been received but are currently blocked. awaitSignal :: Maybe SignalSet -> IO () awaitSignal iset suspends execution until an interrupt is received. If iset is Just s, awaitSignal calls sigsuspend, installing s as the new signal mask before suspending execution; otherwise, it calls pause. awaitSignal returns on receipt of a signal. If you have installed any signal handlers with installHandler, it may be wise to call yield directly after awaitSignal to ensure that the signal handler runs as promptly. scheduleAlarm :: Int -> IO Int scheduleAlarm i calls alarm to schedule a real time alarm at least i seconds in the future. sleep :: Int -> IO () sleep i calls sleep to suspend execution of the program until at least i seconds have elapsed or a signal is received. Posix Process Environment Posix, process environment getProcessID :: IO ProcessID getProcessID calls getpid to obtain the ProcessID for the current process. getParentProcessID :: IO ProcessID getProcessID calls getppid to obtain the ProcessID for the parent of the current process. getRealUserID :: IO UserID getRealUserID calls getuid to obtain the real UserID associated with the current process. getEffectiveUserID :: IO UserID getEffectiveUserID calls geteuid to obtain the effective UserID associated with the current process. setUserID :: UserID -> IO () setUserID uid calls setuid to set the real, effective, and saved set-user-id associated with the current process to uid. getLoginName :: IO String getLoginName calls getlogin to obtain the login name associated with the current process. getRealGroupID :: IO GroupID getRealGroupID calls getgid to obtain the real GroupID associated with the current process. getEffectiveGroupID :: IO GroupID getEffectiveGroupID calls getegid to obtain the effective GroupID associated with the current process. setGroupID :: GroupID -> IO () setGroupID gid calls setgid to set the real, effective, and saved set-group-id associated with the current process to gid. getGroups :: IO [GroupID] getGroups calls getgroups to obtain the list of supplementary GroupIDs associated with the current process. getEffectiveUserName :: IO String getEffectiveUserName calls cuserid to obtain a name associated with the effective UserID of the process. getProcessGroupID :: IO ProcessGroupID getProcessGroupID calls getpgrp to obtain the ProcessGroupID for the current process. createProcessGroup :: ProcessID -> IO ProcessGroupID createProcessGroup pid calls setpgid to make process pid a new process group leader. joinProcessGroup :: ProcessGroupID -> IO ProcessGroupID joinProcessGroup pgid calls setpgid to set the ProcessGroupID of the current process to pgid. setProcessGroupID :: ProcessID -> ProcessGroupID -> IO () setProcessGroupID pid pgid calls setpgid to set the ProcessGroupID for process pid to pgid. createSession :: IO ProcessGroupID createSession calls setsid to create a new session with the current process as session leader. systemName :: SystemID -> String nodeName :: SystemID -> String release :: SystemID -> String version :: SystemID -> String machine :: SystemID -> String getSystemID :: IO SystemID getSystemID calls uname to obtain information about the current operating system. > epochTime :: IO EpochTime epochTime calls time to obtain the number of seconds that have elapsed since the epoch (Jan 01 00:00:00 GMT 1970). elapsedTime :: ProcessTimes -> ClockTick userTime :: ProcessTimes -> ClockTick systemTime :: ProcessTimes -> ClockTick childUserTime :: ProcessTimes -> ClockTick childSystemTime :: ProcessTimes -> ClockTick getProcessTimes :: IO ProcessTimes getProcessTimes calls times to obtain time-accounting information for the current process and its children. getControllingTerminalName :: IO FilePath getControllingTerminalName calls ctermid to obtain a name associated with the controlling terminal for the process. If a controlling terminal exists, getControllingTerminalName returns the name of the controlling terminal. The operation may fail with: NoSuchThing There is no controlling terminal, or its name cannot be determined. SystemError Various other causes. getTerminalName :: Fd -> IO FilePath getTerminalName fd calls ttyname to obtain a name associated with the terminal for Fd fd. If fd is associated with a terminal, getTerminalName returns the name of the terminal. The operation may fail with: InappropriateType The channel is not associated with a terminal. NoSuchThing The channel is associated with a terminal, but it has no name. SystemError Various other causes. queryTerminal :: Fd -> IO Bool queryTerminal fd calls isatty to determine whether or not Fd fd is associated with a terminal. getSysVar :: SysVar -> IO Limit getSysVar var calls sysconf to obtain the dynamic value of the requested configurable system limit or option. For defined system limits, getSysVar returns the associated value. For defined system options, the result of getSysVar is undefined, but not failure. The operation may fail with: NoSuchThing The requested system limit or option is undefined. Posix operations on files and directories Posix, files and directories openDirStream :: FilePath -> IO DirStream openDirStream dir calls opendir to obtain a directory stream for dir. readDirStream :: DirStream -> IO String readDirStream dp calls readdir to obtain the next directory entry (struct dirent) for the open directory stream dp, and returns the d_name member of that structure. The operation may fail with: EOF End of file has been reached. SystemError Various other causes. rewindDirStream :: DirStream -> IO () rewindDirStream dp calls rewinddir to reposition the directory stream dp at the beginning of the directory. closeDirStream :: DirStream -> IO () closeDirStream dp calls closedir to close the directory stream dp. getWorkingDirectory :: IO FilePath getWorkingDirectory calls getcwd to obtain the name of the current working directory. changeWorkingDirectory :: FilePath -> IO () changeWorkingDirectory dir calls chdir to change the current working directory to dir. nullFileMode :: FileMode -- --------- ownerReadMode :: FileMode -- r-------- ownerWriteMode :: FileMode -- -w------- ownerExecuteMode :: FileMode -- --x------ groupReadMode :: FileMode -- ---r----- groupWriteMode :: FileMode -- ----w---- groupExecuteMode :: FileMode -- -----x--- otherReadMode :: FileMode -- ------r-- otherWriteMode :: FileMode -- -------w- otherExecuteMode :: FileMode -- --------x setUserIDMode :: FileMode -- --S------ setGroupIDMode :: FileMode -- -----S--- stdFileMode :: FileMode -- rw-rw-rw- ownerModes :: FileMode -- rwx------ groupModes :: FileMode -- ---rwx--- otherModes :: FileMode -- ------rwx accessModes :: FileMode -- rwxrwxrwx unionFileModes :: FileMode -> FileMode -> FileMode intersectFileModes :: FileMode -> FileMode -> FileMode stdInput :: Fd stdInput = intToFd 0 stdOutput :: Fd stdOutput = intToFd 1 stdError :: Fd stdError = intToFd 2 data OpenFileFlags = OpenFileFlags { append :: Bool, exclusive :: Bool, noctty :: Bool, nonBlock :: Bool, trunc :: Bool } openFd :: FilePath -> OpenMode -> Maybe FileMode -- Just x => O_CREAT, Nothing => must exist -> OpenFileFlags -> IO Fd openFd path acc mode (OpenFileFlags app excl noctty nonblock trunc) calls open to obtain a Fd for the file path with access mode acc. If mode is Just m, the O_CREAT flag is set and the file's permissions will be based on m if it does not already exist; otherwise, the O_CREAT flag is not set. The arguments app, excl, noctty, nonblock, and trunc control whether or not the flags O_APPEND, O_EXCL, O_NOCTTY, O_NONBLOCK, and O_TRUNC are set, respectively. createFile :: FilePath -> FileMode -> IO Fd createFile path mode calls creat to obtain a Fd for file path, which will be created with permissions based on mode if it does not already exist. setFileCreationMask :: FileMode -> IO FileMode setFileCreationMask mode calls umask to set the process's file creation mask to mode. The previous file creation mask is returned. createLink :: FilePath -> FilePath -> IO () createLink old new calls link to create a new path, new, linked to an existing file, old. createDirectory :: FilePath -> FileMode -> IO () createDirectory dir mode calls mkdir to create a new directory, dir, with permissions based on mode. createNamedPipe :: FilePath -> FileMode -> IO () createNamedPipe fifo mode calls mkfifo to create a new named pipe, fifo, with permissions based on mode. removeLink :: FilePath -> IO () removeLink path calls unlink to remove the link named path. removeDirectory :: FilePath -> IO () removeDirectory dir calls rmdir to remove the directory named dir. rename :: FilePath -> FilePath -> IO () rename old new calls rename to rename a file or directory from old to new. fileMode :: FileStatus -> FileMode fileID :: FileStatus -> FileID deviceID :: FileStatus -> DeviceID linkCount :: FileStatus -> LinkCount fileOwner :: FileStatus -> UserID fileGroup :: FileStatus -> GroupID fileSize :: FileStatus -> FileOffset accessTime :: FileStatus -> EpochTime modificationTime :: FileStatus -> EpochTime statusChangeTime :: FileStatus -> EpochTime isDirectory :: FileStatus -> Bool isCharacterDevice :: FileStatus -> Bool isBlockDevice :: FileStatus -> Bool isRegularFile :: FileStatus -> Bool isNamedPipe :: FileStatus -> Bool getFileStatus :: FilePath -> IO FileStatus getFileStatus path calls stat to get the FileStatus information for the file path. getFdStatus :: Fd -> IO FileStatus getFdStatus fd calls fstat to get the FileStatus information for the file associated with Fd fd. queryAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool queryAccess path r w x calls access to test the access permissions for file path. The three arguments, r, w, and x control whether or not access is called with R_OK, W_OK, and X_OK respectively. queryFile :: FilePath -> IO Bool queryFile path calls access with F_OK to test for the existence for file path. setFileMode :: FilePath -> FileMode -> IO () setFileMode path mode calls chmod to set the permission bits associated with file path to mode. setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () setOwnerAndGroup path uid gid calls chown to set the UserID and GroupID associated with file path to uid and gid, respectively. setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO () setFileTimes path atime mtime calls utime to set the access and modification times associated with file path to atime and mtime, respectively. touchFile :: FilePath -> IO () touchFile path calls utime to set the access and modification times associated with file path to the current time. getPathVar :: PathVar -> FilePath -> IO Limit getPathVar var path calls pathconf to obtain the dynamic value of the requested configurable file limit or option associated with file or directory path. For defined file limits, getPathVar returns the associated value. For defined file options, the result of getPathVar is undefined, but not failure. The operation may fail with: NoSuchThing The requested file limit or option is undefined. SystemError Various other causes. getFdVar :: PathVar -> Fd -> IO Limit getFdVar var fd calls fpathconf to obtain the dynamic value of the requested configurable file limit or option associated with the file or directory attached to the open channel fd. For defined file limits, getFdVar returns the associated value. For defined file options, the result of getFdVar is undefined, but not failure. The operation may fail with: NoSuchThing The requested file limit or option is undefined. SystemError Various other causes. Posix Input and Output Primitives Posix, input/output createPipe :: IO (Fd, Fd) createPipe calls pipe to create a pipe and returns a pair of Fds, the first for reading and the second for writing. dup :: Fd -> IO Fd dup fd calls dup to duplicate Fd fd to another Fd. dupTo :: Fd -> Fd -> IO () dupTo src dst calls dup2 to duplicate Fd src to Fd dst. fdClose :: Fd -> IO () fdClose fd calls close to close Fd fd. fdRead :: Fd -> ByteCount -> IO (String, ByteCount) fdRead fd nbytes calls read to read at most nbytes bytes from Fd fd, and returns the result as a string paired with the number of bytes actually read. The operation may fail with: EOF End of file has been reached. SystemError Various other causes. fdWrite :: Fd -> String -> IO ByteCount fdWrite fd s calls write to write the string s to Fd fd as a contiguous sequence of bytes. It returns the number of bytes successfully written. queryFdOption :: FdOption -> Fd -> IO Bool getFdOption opt fd calls fcntl to determine whether or not the flag associated with FdOption opt is set for Fd fd. setFdOption :: Fd -> FdOption -> Bool -> IO () setFdOption fd opt val calls fcntl to set the flag associated with FdOption opt on Fd fd to val. getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock)) getLock fd lock calls fcntl to get the first FileLock for Fd fd which blocks the FileLock lock. If no such FileLock exists, getLock returns Nothing. Otherwise, it returns Just (pid, block), where block is the blocking FileLock and pid is the ProcessID of the process holding the blocking FileLock. setLock :: Fd -> FileLock -> IO () setLock fd lock calls fcntl with F_SETLK to set or clear a lock segment for Fd fd as indicated by the FileLock lock. setLock does not block, but fails with SystemError if the request cannot be satisfied immediately. waitToSetLock :: Fd -> FileLock -> IO () waitToSetLock fd lock calls fcntl with F_SETLKW to set or clear a lock segment for Fd fd as indicated by the FileLock lock. If the request cannot be satisfied immediately, waitToSetLock blocks until the request can be satisfied. fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset fdSeek fd whence offset calls lseek to position the Fd fd at the given offset from the starting location indicated by whence. It returns the resulting offset from the start of the file in bytes. Posix, Device- and Class-Specific Functions Posix, device and class-specific functions terminalMode :: TerminalMode -> TerminalAttributes -> Bool withMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes withoutMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes bitsPerByte :: TerminalAttributes -> Int withBits :: TerminalAttributes -> Int -> TerminalAttributes controlChar :: TerminalAttributes -> ControlCharacter -> Maybe Char withCC :: TerminalAttributes -> (ControlCharacter, Char) -> TerminalAttributes withoutCC :: TerminalAttributes -> ControlCharacter -> TerminalAttributes inputTime :: TerminalAttributes -> Int withTime :: TerminalAttributes -> Int -> TerminalAttributes minInput :: TerminalAttributes -> Int withMinInput :: TerminalAttributes -> Int -> TerminalAttributes inputSpeed :: TerminalAttributes -> BaudRate withInputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes outputSpeed :: TerminalAttributes -> BaudRate withOutputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes getTerminalAttributes :: Fd -> IO TerminalAttributes getTerminalAttributes fd calls tcgetattr to obtain the TerminalAttributes associated with Fd fd. setTerminalAttributes :: Fd -> TerminalAttributes -> TerminalState -> IO () setTerminalAttributes fd attr ts calls tcsetattr to change the TerminalAttributes associated with Fd fd to attr, when the terminal is in the state indicated by ts. sendBreak :: Fd -> Int -> IO () sendBreak fd duration calls tcsendbreak to transmit a continuous stream of zero-valued bits on Fd fd for the specified implementation-dependent duration. drainOutput :: Fd -> IO () drainOutput fd calls tcdrain to block until all output written to Fd fd has been transmitted. discardData :: Fd -> QueueSelector -> IO () discardData fd queues calls tcflush to discard pending input and/or output for Fd fd, as indicated by the QueueSelector queues. controlFlow :: Fd -> FlowAction -> IO () controlFlow fd action calls tcflow to control the flow of data on Fd fd, as indicated by action. getTerminalProcessGroupID :: Fd -> IO ProcessGroupID getTerminalProcessGroupID fd calls tcgetpgrp to obtain the ProcessGroupID of the foreground process group associated with the terminal attached to Fd fd. setTerminalProcessGroupID :: Fd -> ProcessGroupID -> IO () setTerminalProcessGroupID fd pgid calls tcsetpgrp to set the ProcessGroupID of the foreground process group associated with the terminal attached to Fd fd to pgid. Posix System Databases Posix, system databases groupName :: GroupEntry -> String groupID :: GroupEntry -> GroupID groupMembers :: GroupEntry -> [String] getGroupEntryForID :: GroupID -> IO GroupEntry getGroupEntryForID gid calls getgrgid to obtain the GroupEntry information associated with GroupID gid. The operation may fail with: NoSuchThing There is no group entry for the GroupID. getGroupEntryForName :: String -> IO GroupEntry getGroupEntryForName name calls getgrnam to obtain the GroupEntry information associated with the group called name. The operation may fail with: NoSuchThing There is no group entry for the name. userName :: UserEntry -> String userID :: UserEntry -> UserID userGroupID :: UserEntry -> GroupID homeDirectory :: UserEntry -> String userShell :: UserEntry -> String getUserEntryForID :: UserID -> IO UserEntry getUserEntryForID gid calls getpwuid to obtain the UserEntry information associated with UserID uid. The operation may fail with: NoSuchThing There is no user entry for the UserID. getUserEntryForName :: String -> IO UserEntry getUserEntryForName name calls getpwnam to obtain the UserEntry information associated with the user login name. The operation may fail with: NoSuchThing There is no user entry for the name. POSIX Errors Posix, errors getErrorCode :: IO ErrorCode getErrorCode returns the current value of the external variable errno. It never fails. setErrorCode :: ErrorCode -> IO () setErrorCode err sets the external variable errno to err. It never fails. noError :: ErrorCode noError = 0 argumentListTooLong, e2BIG :: ErrorCode badFd, eBADF :: ErrorCode brokenPipe, ePIPE :: ErrorCode directoryNotEmpty, eNOTEMPTY :: ErrorCode execFormatError, eNOEXEC :: ErrorCode fileAlreadyExists, eEXIST :: ErrorCode fileTooLarge, eFBIG :: ErrorCode filenameTooLong, eNAMETOOLONG :: ErrorCode improperLink, eXDEV :: ErrorCode inappropriateIOControlOperation, eNOTTY :: ErrorCode inputOutputError, eIO :: ErrorCode interruptedOperation, eINTR :: ErrorCode invalidArgument, eINVAL :: ErrorCode invalidSeek, eSPIPE :: ErrorCode isADirectory, eISDIR :: ErrorCode noChildProcess, eCHILD :: ErrorCode noLocksAvailable, eNOLCK :: ErrorCode noSpaceLeftOnDevice, eNOSPC :: ErrorCode noSuchOperationOnDevice, eNODEV :: ErrorCode noSuchDeviceOrAddress, eNXIO :: ErrorCode noSuchFileOrDirectory, eNOENT :: ErrorCode noSuchProcess, eSRCH :: ErrorCode notADirectory, eNOTDIR :: ErrorCode notEnoughMemory, eNOMEM :: ErrorCode operationNotImplemented, eNOSYS :: ErrorCode operationNotPermitted, ePERM :: ErrorCode permissionDenied, eACCES :: ErrorCode readOnlyFileSystem, eROFS :: ErrorCode resourceBusy, eBUSY :: ErrorCode resourceDeadlockAvoided, eDEADLK :: ErrorCode resourceTemporarilyUnavailable, eAGAIN :: ErrorCode tooManyLinks, eMLINK :: ErrorCode tooManyOpenFiles, eMFILE :: ErrorCode tooManyOpenFilesInSystem, eNFILE :: ErrorCode POpen POpen POpen provides a convenient way of sending string input to a subprocess and reading output from it lazily. popen :: FilePath -- Command -> [String] -- Arguments -> Maybe String -- Input -> IO (String, String, ProcessID) -- (stdout, stderr, pid) popen cmd args inp executes cmd with args in a forked process. If inp is Just str then str in sent in a pipe to the standard input of the process. The output and error streams from the process are returned, together with the process id. popenEnvDir :: FilePath -- Command -> [String] -- Arguments -> Maybe String -- Input -> Maybe [(String, String)] -- Environment -> Maybe FilePath -- Working directory -> IO (String, String, ProcessID) -- (stdout, stderr, pid) popenEnvDir cmd args inp env dir like popen executes cmd with args in a forked process. If inp is Just str then str in sent in a pipe to the standard input of the process. If env is Just pairs, the command in executed in the environment specified by pairs, instead of the current one. If dir is Just d the command is executed in directory d instead of the current directory. The output and error streams from the process are returned, together with the process id. hugs98-plus-Sep2006/packages/0000755006511100651110000000000010504340553014540 5ustar rossrosshugs98-plus-Sep2006/packages/base/0000755006511100651110000000000010504340734015453 5ustar rossrosshugs98-plus-Sep2006/packages/base/Control/0000755006511100651110000000000010504340226017067 5ustar rossrosshugs98-plus-Sep2006/packages/base/Control/Concurrent/0000755006511100651110000000000010504340222021205 5ustar rossrosshugs98-plus-Sep2006/packages/base/Control/Concurrent/SampleVar.hs0000644006511100651110000000645110504340221023440 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.SampleVar -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (concurrency) -- -- Sample variables -- ----------------------------------------------------------------------------- module Control.Concurrent.SampleVar ( -- * Sample Variables SampleVar, -- :: type _ = newEmptySampleVar, -- :: IO (SampleVar a) newSampleVar, -- :: a -> IO (SampleVar a) emptySampleVar, -- :: SampleVar a -> IO () readSampleVar, -- :: SampleVar a -> IO a writeSampleVar, -- :: SampleVar a -> a -> IO () isEmptySampleVar, -- :: SampleVar a -> IO Bool ) where import Prelude import Control.Concurrent.MVar -- | -- Sample variables are slightly different from a normal 'MVar': -- -- * Reading an empty 'SampleVar' causes the reader to block. -- (same as 'takeMVar' on empty 'MVar') -- -- * Reading a filled 'SampleVar' empties it and returns value. -- (same as 'takeMVar') -- -- * Writing to an empty 'SampleVar' fills it with a value, and -- potentially, wakes up a blocked reader (same as for 'putMVar' on -- empty 'MVar'). -- -- * Writing to a filled 'SampleVar' overwrites the current value. -- (different from 'putMVar' on full 'MVar'.) type SampleVar a = MVar (Int, -- 1 == full -- 0 == empty -- <0 no of readers blocked MVar a) -- |Build a new, empty, 'SampleVar' newEmptySampleVar :: IO (SampleVar a) newEmptySampleVar = do v <- newEmptyMVar newMVar (0,v) -- |Build a 'SampleVar' with an initial value. newSampleVar :: a -> IO (SampleVar a) newSampleVar a = do v <- newEmptyMVar putMVar v a newMVar (1,v) -- |If the SampleVar is full, leave it empty. Otherwise, do nothing. emptySampleVar :: SampleVar a -> IO () emptySampleVar v = do (readers, var) <- takeMVar v if readers > 0 then do takeMVar var putMVar v (0,var) else putMVar v (readers,var) -- |Wait for a value to become available, then take it and return. readSampleVar :: SampleVar a -> IO a readSampleVar svar = do -- -- filled => make empty and grab sample -- not filled => try to grab value, empty when read val. -- (readers,val) <- takeMVar svar putMVar svar (readers-1,val) takeMVar val -- |Write a value into the 'SampleVar', overwriting any previous value that -- was there. writeSampleVar :: SampleVar a -> a -> IO () writeSampleVar svar v = do -- -- filled => overwrite -- not filled => fill, write val -- (readers,val) <- takeMVar svar case readers of 1 -> swapMVar val v >> putMVar svar (1,val) _ -> putMVar val v >> putMVar svar (min 1 (readers+1), val) -- | Returns 'True' if the 'SampleVar' is currently empty. -- -- Note that this function is only useful if you know that no other -- threads can be modifying the state of the 'SampleVar', because -- otherwise the state of the 'SampleVar' may have changed by the time -- you see the result of 'isEmptySampleVar'. -- isEmptySampleVar :: SampleVar a -> IO Bool isEmptySampleVar svar = do (readers,val) <- readMVar svar return (readers == 0) hugs98-plus-Sep2006/packages/base/Control/Concurrent/Chan.hs0000644006511100651110000000777310504340221022427 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.Chan -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (concurrency) -- -- Unbounded channels. -- ----------------------------------------------------------------------------- module Control.Concurrent.Chan ( -- * The 'Chan' type Chan, -- abstract -- * Operations newChan, -- :: IO (Chan a) writeChan, -- :: Chan a -> a -> IO () readChan, -- :: Chan a -> IO a dupChan, -- :: Chan a -> IO (Chan a) unGetChan, -- :: Chan a -> a -> IO () isEmptyChan, -- :: Chan a -> IO Bool -- * Stream interface getChanContents, -- :: Chan a -> IO [a] writeList2Chan, -- :: Chan a -> [a] -> IO () ) where import Prelude import System.IO.Unsafe ( unsafeInterleaveIO ) import Control.Concurrent.MVar import Data.Typeable #include "Typeable.h" -- A channel is represented by two @MVar@s keeping track of the two ends -- of the channel contents,i.e., the read- and write ends. Empty @MVar@s -- are used to handle consumers trying to read from an empty channel. -- |'Chan' is an abstract type representing an unbounded FIFO channel. data Chan a = Chan (MVar (Stream a)) (MVar (Stream a)) INSTANCE_TYPEABLE1(Chan,chanTc,"Chan") type Stream a = MVar (ChItem a) data ChItem a = ChItem a (Stream a) -- See the Concurrent Haskell paper for a diagram explaining the -- how the different channel operations proceed. -- @newChan@ sets up the read and write end of a channel by initialising -- these two @MVar@s with an empty @MVar@. -- |Build and returns a new instance of 'Chan'. newChan :: IO (Chan a) newChan = do hole <- newEmptyMVar read <- newMVar hole write <- newMVar hole return (Chan read write) -- To put an element on a channel, a new hole at the write end is created. -- What was previously the empty @MVar@ at the back of the channel is then -- filled in with a new stream element holding the entered value and the -- new hole. -- |Write a value to a 'Chan'. writeChan :: Chan a -> a -> IO () writeChan (Chan _read write) val = do new_hole <- newEmptyMVar modifyMVar_ write $ \old_hole -> do putMVar old_hole (ChItem val new_hole) return new_hole -- |Read the next value from the 'Chan'. readChan :: Chan a -> IO a readChan (Chan read _write) = do modifyMVar read $ \read_end -> do (ChItem val new_read_end) <- readMVar read_end -- Use readMVar here, not takeMVar, -- else dupChan doesn't work return (new_read_end, val) -- |Duplicate a 'Chan': the duplicate channel begins empty, but data written to -- either channel from then on will be available from both. Hence this creates -- a kind of broadcast channel, where data written by anyone is seen by -- everyone else. dupChan :: Chan a -> IO (Chan a) dupChan (Chan _read write) = do hole <- readMVar write new_read <- newMVar hole return (Chan new_read write) -- |Put a data item back onto a channel, where it will be the next item read. unGetChan :: Chan a -> a -> IO () unGetChan (Chan read _write) val = do new_read_end <- newEmptyMVar modifyMVar_ read $ \read_end -> do putMVar new_read_end (ChItem val read_end) return new_read_end -- |Returns 'True' if the supplied 'Chan' is empty. isEmptyChan :: Chan a -> IO Bool isEmptyChan (Chan read write) = do withMVar read $ \r -> do w <- readMVar write let eq = r == w eq `seq` return eq -- Operators for interfacing with functional streams. -- |Return a lazy list representing the contents of the supplied -- 'Chan', much like 'System.IO.hGetContents'. getChanContents :: Chan a -> IO [a] getChanContents ch = unsafeInterleaveIO (do x <- readChan ch xs <- getChanContents ch return (x:xs) ) -- |Write an entire list of items to a 'Chan'. writeList2Chan :: Chan a -> [a] -> IO () writeList2Chan ch ls = sequence_ (map (writeChan ch) ls) hugs98-plus-Sep2006/packages/base/Control/Concurrent/MVar.hs0000644006511100651110000000637410504340222022420 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.MVar -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (concurrency) -- -- Synchronising variables -- ----------------------------------------------------------------------------- module Control.Concurrent.MVar ( -- * @MVar@s MVar -- abstract , newEmptyMVar -- :: IO (MVar a) , newMVar -- :: a -> IO (MVar a) , takeMVar -- :: MVar a -> IO a , putMVar -- :: MVar a -> a -> IO () , readMVar -- :: MVar a -> IO a , swapMVar -- :: MVar a -> a -> IO a , tryTakeMVar -- :: MVar a -> IO (Maybe a) , tryPutMVar -- :: MVar a -> a -> IO Bool , isEmptyMVar -- :: MVar a -> IO Bool , withMVar -- :: MVar a -> (a -> IO b) -> IO b , modifyMVar_ -- :: MVar a -> (a -> IO a) -> IO () , modifyMVar -- :: MVar a -> (a -> IO (a,b)) -> IO b #ifndef __HUGS__ , addMVarFinalizer -- :: MVar a -> IO () -> IO () #endif ) where #ifdef __HUGS__ import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, tryTakeMVar, tryPutMVar, isEmptyMVar, ) #endif #ifdef __GLASGOW_HASKELL__ import GHC.Conc ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer ) #endif import Prelude import Control.Exception as Exception {-| This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value from the 'MVar', puts it back, and also returns it. -} readMVar :: MVar a -> IO a readMVar m = block $ do a <- takeMVar m putMVar m a return a -- |Swap the contents of an 'MVar' for a new value. swapMVar :: MVar a -> a -> IO a swapMVar mvar new = block $ do old <- takeMVar mvar putMVar mvar new return old {-| 'withMVar' is a safe wrapper for operating on the contents of an 'MVar'. This operation is exception-safe: it will replace the original contents of the 'MVar' if an exception is raised (see "Control.Exception"). -} {-# INLINE withMVar #-} -- inlining has been reported to have dramatic effects; see -- http://www.haskell.org//pipermail/haskell/2006-May/017907.html withMVar :: MVar a -> (a -> IO b) -> IO b withMVar m io = block $ do a <- takeMVar m b <- Exception.catch (unblock (io a)) (\e -> do putMVar m a; throw e) putMVar m a return b {-| A safe wrapper for modifying the contents of an 'MVar'. Like 'withMVar', 'modifyMVar' will replace the original contents of the 'MVar' if an exception is raised during the operation. -} {-# INLINE modifyMVar_ #-} modifyMVar_ :: MVar a -> (a -> IO a) -> IO () modifyMVar_ m io = block $ do a <- takeMVar m a' <- Exception.catch (unblock (io a)) (\e -> do putMVar m a; throw e) putMVar m a' {-| A slight variation on 'modifyMVar_' that allows a value to be returned (@b@) in addition to the modified value of the 'MVar'. -} {-# INLINE modifyMVar #-} modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b modifyMVar m io = block $ do a <- takeMVar m (a',b) <- Exception.catch (unblock (io a)) (\e -> do putMVar m a; throw e) putMVar m a' return b hugs98-plus-Sep2006/packages/base/Control/Concurrent/QSem.hs0000644006511100651110000000442410504340221022411 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.QSem -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (concurrency) -- -- Simple quantity semaphores. -- ----------------------------------------------------------------------------- module Control.Concurrent.QSem ( -- * Simple Quantity Semaphores QSem, -- abstract newQSem, -- :: Int -> IO QSem waitQSem, -- :: QSem -> IO () signalQSem -- :: QSem -> IO () ) where import Prelude import Control.Concurrent.MVar import Data.Typeable #include "Typeable.h" -- General semaphores are also implemented readily in terms of shared -- @MVar@s, only have to catch the case when the semaphore is tried -- waited on when it is empty (==0). Implement this in the same way as -- shared variables are implemented - maintaining a list of @MVar@s -- representing threads currently waiting. The counter is a shared -- variable, ensuring the mutual exclusion on its access. -- |A 'QSem' is a simple quantity semaphore, in which the available -- \"quantity\" is always dealt with in units of one. newtype QSem = QSem (MVar (Int, [MVar ()])) INSTANCE_TYPEABLE0(QSem,qSemTc,"QSem") -- |Build a new 'QSem' newQSem :: Int -> IO QSem newQSem init = do sem <- newMVar (init,[]) return (QSem sem) -- |Wait for a unit to become available waitQSem :: QSem -> IO () waitQSem (QSem sem) = do (avail,blocked) <- takeMVar sem -- gain ex. access if avail > 0 then putMVar sem (avail-1,[]) else do block <- newEmptyMVar {- Stuff the reader at the back of the queue, so as to preserve waiting order. A signalling process then only have to pick the MVar at the front of the blocked list. The version of waitQSem given in the paper could lead to starvation. -} putMVar sem (0, blocked++[block]) takeMVar block -- |Signal that a unit of the 'QSem' is available signalQSem :: QSem -> IO () signalQSem (QSem sem) = do (avail,blocked) <- takeMVar sem case blocked of [] -> putMVar sem (avail+1,[]) (block:blocked') -> do putMVar sem (0,blocked') putMVar block () hugs98-plus-Sep2006/packages/base/Control/Concurrent/QSemN.hs0000644006511100651110000000421710504340221022527 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.QSemN -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (concurrency) -- -- Quantity semaphores in which each thread may wait for an arbitrary -- \"amount\". -- ----------------------------------------------------------------------------- module Control.Concurrent.QSemN ( -- * General Quantity Semaphores QSemN, -- abstract newQSemN, -- :: Int -> IO QSemN waitQSemN, -- :: QSemN -> Int -> IO () signalQSemN -- :: QSemN -> Int -> IO () ) where import Prelude import Control.Concurrent.MVar import Data.Typeable #include "Typeable.h" -- |A 'QSemN' is a quantity semaphore, in which the available -- \"quantity\" may be signalled or waited for in arbitrary amounts. newtype QSemN = QSemN (MVar (Int,[(Int,MVar ())])) INSTANCE_TYPEABLE0(QSemN,qSemNTc,"QSemN") -- |Build a new 'QSemN' with a supplied initial quantity. newQSemN :: Int -> IO QSemN newQSemN init = do sem <- newMVar (init,[]) return (QSemN sem) -- |Wait for the specified quantity to become available waitQSemN :: QSemN -> Int -> IO () waitQSemN (QSemN sem) sz = do (avail,blocked) <- takeMVar sem -- gain ex. access if (avail - sz) >= 0 then -- discharging 'sz' still leaves the semaphore -- in an 'unblocked' state. putMVar sem (avail-sz,blocked) else do block <- newEmptyMVar putMVar sem (avail, blocked++[(sz,block)]) takeMVar block -- |Signal that a given quantity is now available from the 'QSemN'. signalQSemN :: QSemN -> Int -> IO () signalQSemN (QSemN sem) n = do (avail,blocked) <- takeMVar sem (avail',blocked') <- free (avail+n) blocked putMVar sem (avail',blocked') where free avail [] = return (avail,[]) free avail ((req,block):blocked) | avail >= req = do putMVar block () free (avail-req) blocked | otherwise = do (avail',blocked') <- free avail blocked return (avail',(req,block):blocked') hugs98-plus-Sep2006/packages/base/Control/Applicative.hs0000644006511100651110000001371210504340225021667 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Applicative -- Copyright : Conor McBride and Ross Paterson 2005 -- License : BSD-style (see the LICENSE file in the distribution) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- This module describes a structure intermediate between a functor and -- a monad: it provides pure expressions and sequencing, but no binding. -- (Technically, a strong lax monoidal functor.) For more details, see -- /Applicative Programming with Effects/, -- by Conor McBride and Ross Paterson, online at -- . -- -- This interface was introduced for parsers by Niklas Röjemo, because -- it admits more sharing than the monadic interface. The names here are -- mostly based on recent parsing work by Doaitse Swierstra. -- -- This class is also useful with instances of the -- 'Data.Traversable.Traversable' class. module Control.Applicative ( -- * Applicative functors Applicative(..), -- * Alternatives Alternative(..), -- * Instances Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..), -- * Utility functions (<$>), (<$), (*>), (<*), (<**>), liftA, liftA2, liftA3, optional, some, many ) where #ifdef __HADDOCK__ import Prelude #endif import Control.Arrow (Arrow(arr, (>>>), (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>))) import Control.Monad (liftM, ap, MonadPlus(..)) import Control.Monad.Instances () import Data.Monoid (Monoid(..)) infixl 3 <|> infixl 4 <$>, <$ infixl 4 <*>, <*, *>, <**> -- | A functor with application. -- -- Instances should satisfy the following laws: -- -- [/identity/] -- @'pure' 'id' '<*>' v = v@ -- -- [/composition/] -- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ -- -- [/homomorphism/] -- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ -- -- [/interchange/] -- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ -- -- The 'Functor' instance should satisfy -- -- @ -- 'fmap' f x = 'pure' f '<*>' x -- @ -- -- If @f@ is also a 'Monad', define @'pure' = 'return'@ and @('<*>') = 'ap'@. class Functor f => Applicative f where -- | Lift a value. pure :: a -> f a -- | Sequential application. (<*>) :: f (a -> b) -> f a -> f b -- | A monoid on applicative functors. class Applicative f => Alternative f where -- | The identity of '<|>' empty :: f a -- | An associative binary operation (<|>) :: f a -> f a -> f a -- instances for Prelude types instance Applicative Maybe where pure = return (<*>) = ap instance Alternative Maybe where empty = Nothing Nothing <|> p = p Just x <|> _ = Just x instance Applicative [] where pure = return (<*>) = ap instance Alternative [] where empty = [] (<|>) = (++) instance Applicative IO where pure = return (<*>) = ap instance Applicative ((->) a) where pure = const (<*>) f g x = f x (g x) instance Monoid a => Applicative ((,) a) where pure x = (mempty, x) (u, f) <*> (v, x) = (u `mappend` v, f x) -- new instances newtype Const a b = Const { getConst :: a } instance Functor (Const m) where fmap _ (Const v) = Const v instance Monoid m => Applicative (Const m) where pure _ = Const mempty Const f <*> Const v = Const (f `mappend` v) newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a } instance Monad m => Functor (WrappedMonad m) where fmap f (WrapMonad v) = WrapMonad (liftM f v) instance Monad m => Applicative (WrappedMonad m) where pure = WrapMonad . return WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v) instance MonadPlus m => Alternative (WrappedMonad m) where empty = WrapMonad mzero WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v) newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c } instance Arrow a => Functor (WrappedArrow a b) where fmap f (WrapArrow a) = WrapArrow (a >>> arr f) instance Arrow a => Applicative (WrappedArrow a b) where pure x = WrapArrow (arr (const x)) WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id)) instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where empty = WrapArrow zeroArrow WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v) -- | Lists, but with an 'Applicative' functor based on zipping, so that -- -- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@ -- newtype ZipList a = ZipList { getZipList :: [a] } instance Functor ZipList where fmap f (ZipList xs) = ZipList (map f xs) instance Applicative ZipList where pure x = ZipList (repeat x) ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs) -- extra functions -- | A synonym for 'fmap'. (<$>) :: Functor f => (a -> b) -> f a -> f b f <$> a = fmap f a -- | Replace the value. (<$) :: Functor f => a -> f b -> f a (<$) = (<$>) . const -- | Sequence actions, discarding the value of the first argument. (*>) :: Applicative f => f a -> f b -> f b (*>) = liftA2 (const id) -- | Sequence actions, discarding the value of the second argument. (<*) :: Applicative f => f a -> f b -> f a (<*) = liftA2 const -- | A variant of '<*>' with the arguments reversed. (<**>) :: Applicative f => f a -> f (a -> b) -> f b (<**>) = liftA2 (flip ($)) -- | Lift a function to actions. -- This function may be used as a value for `fmap` in a `Functor` instance. liftA :: Applicative f => (a -> b) -> f a -> f b liftA f a = pure f <*> a -- | Lift a binary function to actions. liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 f a b = f <$> a <*> b -- | Lift a ternary function to actions. liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d liftA3 f a b c = f <$> a <*> b <*> c -- | One or none. optional :: Alternative f => f a -> f (Maybe a) optional v = Just <$> v <|> pure Nothing -- | One or more. some :: Alternative f => f a -> f [a] some v = some_v where many_v = some_v <|> pure [] some_v = (:) <$> v <*> many_v -- | Zero or more. many :: Alternative f => f a -> f [a] many v = many_v where many_v = some_v <|> pure [] some_v = (:) <$> v <*> many_v hugs98-plus-Sep2006/packages/base/Control/Arrow.hs0000644006511100651110000002070710504340221020516 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Arrow -- Copyright : (c) Ross Paterson 2002 -- License : BSD-style (see the LICENSE file in the distribution) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- Basic arrow definitions, based on -- /Generalising Monads to Arrows/, by John Hughes, -- /Science of Computer Programming/ 37, pp67-111, May 2000. -- plus a couple of definitions ('returnA' and 'loop') from -- /A New Notation for Arrows/, by Ross Paterson, in /ICFP 2001/, -- Firenze, Italy, pp229-240. -- See these papers for the equations these combinators are expected to -- satisfy. These papers and more information on arrows can be found at -- . module Control.Arrow ( -- * Arrows Arrow(..), Kleisli(..), -- ** Derived combinators returnA, (^>>), (>>^), -- ** Right-to-left variants (<<<), (<<^), (^<<), -- * Monoid operations ArrowZero(..), ArrowPlus(..), -- * Conditionals ArrowChoice(..), -- * Arrow application ArrowApply(..), ArrowMonad(..), leftApp, -- * Feedback ArrowLoop(..) ) where import Prelude import Control.Monad import Control.Monad.Fix infixr 5 <+> infixr 3 *** infixr 3 &&& infixr 2 +++ infixr 2 ||| infixr 1 >>>, ^>>, >>^ infixr 1 <<<, ^<<, <<^ -- | The basic arrow class. -- Any instance must define either 'arr' or 'pure' (which are synonyms), -- as well as '>>>' and 'first'. The other combinators have sensible -- default definitions, which may be overridden for efficiency. class Arrow a where -- | Lift a function to an arrow: you must define either this -- or 'pure'. arr :: (b -> c) -> a b c arr = pure -- | A synonym for 'arr': you must define one or other of them. pure :: (b -> c) -> a b c pure = arr -- | Left-to-right composition of arrows. (>>>) :: a b c -> a c d -> a b d -- | Send the first component of the input through the argument -- arrow, and copy the rest unchanged to the output. first :: a b c -> a (b,d) (c,d) -- | A mirror image of 'first'. -- -- The default definition may be overridden with a more efficient -- version if desired. second :: a b c -> a (d,b) (d,c) second f = arr swap >>> first f >>> arr swap where swap ~(x,y) = (y,x) -- | Split the input between the two argument arrows and combine -- their output. Note that this is in general not a functor. -- -- The default definition may be overridden with a more efficient -- version if desired. (***) :: a b c -> a b' c' -> a (b,b') (c,c') f *** g = first f >>> second g -- | Fanout: send the input to both argument arrows and combine -- their output. -- -- The default definition may be overridden with a more efficient -- version if desired. (&&&) :: a b c -> a b c' -> a b (c,c') f &&& g = arr (\b -> (b,b)) >>> f *** g {-# RULES "compose/arr" forall f g . arr f >>> arr g = arr (f >>> g) "first/arr" forall f . first (arr f) = arr (first f) "second/arr" forall f . second (arr f) = arr (second f) "product/arr" forall f g . arr f *** arr g = arr (f *** g) "fanout/arr" forall f g . arr f &&& arr g = arr (f &&& g) "compose/first" forall f g . first f >>> first g = first (f >>> g) "compose/second" forall f g . second f >>> second g = second (f >>> g) #-} -- Ordinary functions are arrows. instance Arrow (->) where arr f = f f >>> g = g . f first f = f *** id second f = id *** f -- (f *** g) ~(x,y) = (f x, g y) -- sorry, although the above defn is fully H'98, nhc98 can't parse it. (***) f g ~(x,y) = (f x, g y) -- | Kleisli arrows of a monad. newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b } instance Monad m => Arrow (Kleisli m) where arr f = Kleisli (return . f) Kleisli f >>> Kleisli g = Kleisli (\b -> f b >>= g) first (Kleisli f) = Kleisli (\ ~(b,d) -> f b >>= \c -> return (c,d)) second (Kleisli f) = Kleisli (\ ~(d,b) -> f b >>= \c -> return (d,c)) -- | The identity arrow, which plays the role of 'return' in arrow notation. returnA :: Arrow a => a b b returnA = arr id -- | Precomposition with a pure function. (^>>) :: Arrow a => (b -> c) -> a c d -> a b d f ^>> a = arr f >>> a -- | Postcomposition with a pure function. (>>^) :: Arrow a => a b c -> (c -> d) -> a b d a >>^ f = a >>> arr f -- | Right-to-left composition, for a better fit with arrow notation. (<<<) :: Arrow a => a c d -> a b c -> a b d f <<< g = g >>> f -- | Precomposition with a pure function (right-to-left variant). (<<^) :: Arrow a => a c d -> (b -> c) -> a b d a <<^ f = a <<< arr f -- | Postcomposition with a pure function (right-to-left variant). (^<<) :: Arrow a => (c -> d) -> a b c -> a b d f ^<< a = arr f <<< a class Arrow a => ArrowZero a where zeroArrow :: a b c instance MonadPlus m => ArrowZero (Kleisli m) where zeroArrow = Kleisli (\x -> mzero) class ArrowZero a => ArrowPlus a where (<+>) :: a b c -> a b c -> a b c instance MonadPlus m => ArrowPlus (Kleisli m) where Kleisli f <+> Kleisli g = Kleisli (\x -> f x `mplus` g x) -- | Choice, for arrows that support it. This class underlies the -- @if@ and @case@ constructs in arrow notation. -- Any instance must define 'left'. The other combinators have sensible -- default definitions, which may be overridden for efficiency. class Arrow a => ArrowChoice a where -- | Feed marked inputs through the argument arrow, passing the -- rest through unchanged to the output. left :: a b c -> a (Either b d) (Either c d) -- | A mirror image of 'left'. -- -- The default definition may be overridden with a more efficient -- version if desired. right :: a b c -> a (Either d b) (Either d c) right f = arr mirror >>> left f >>> arr mirror where mirror (Left x) = Right x mirror (Right y) = Left y -- | Split the input between the two argument arrows, retagging -- and merging their outputs. -- Note that this is in general not a functor. -- -- The default definition may be overridden with a more efficient -- version if desired. (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c') f +++ g = left f >>> right g -- | Fanin: Split the input between the two argument arrows and -- merge their outputs. -- -- The default definition may be overridden with a more efficient -- version if desired. (|||) :: a b d -> a c d -> a (Either b c) d f ||| g = f +++ g >>> arr untag where untag (Left x) = x untag (Right y) = y {-# RULES "left/arr" forall f . left (arr f) = arr (left f) "right/arr" forall f . right (arr f) = arr (right f) "sum/arr" forall f g . arr f +++ arr g = arr (f +++ g) "fanin/arr" forall f g . arr f ||| arr g = arr (f ||| g) "compose/left" forall f g . left f >>> left g = left (f >>> g) "compose/right" forall f g . right f >>> right g = right (f >>> g) #-} instance ArrowChoice (->) where left f = f +++ id right f = id +++ f f +++ g = (Left . f) ||| (Right . g) (|||) = either instance Monad m => ArrowChoice (Kleisli m) where left f = f +++ arr id right f = arr id +++ f f +++ g = (f >>> arr Left) ||| (g >>> arr Right) Kleisli f ||| Kleisli g = Kleisli (either f g) -- | Some arrows allow application of arrow inputs to other inputs. class Arrow a => ArrowApply a where app :: a (a b c, b) c instance ArrowApply (->) where app (f,x) = f x instance Monad m => ArrowApply (Kleisli m) where app = Kleisli (\(Kleisli f, x) -> f x) -- | The 'ArrowApply' class is equivalent to 'Monad': any monad gives rise -- to a 'Kleisli' arrow, and any instance of 'ArrowApply' defines a monad. newtype ArrowApply a => ArrowMonad a b = ArrowMonad (a () b) instance ArrowApply a => Monad (ArrowMonad a) where return x = ArrowMonad (arr (\z -> x)) ArrowMonad m >>= f = ArrowMonad (m >>> arr (\x -> let ArrowMonad h = f x in (h, ())) >>> app) -- | Any instance of 'ArrowApply' can be made into an instance of -- 'ArrowChoice' by defining 'left' = 'leftApp'. leftApp :: ArrowApply a => a b c -> a (Either b d) (Either c d) leftApp f = arr ((\b -> (arr (\() -> b) >>> f >>> arr Left, ())) ||| (\d -> (arr (\() -> d) >>> arr Right, ()))) >>> app -- | The 'loop' operator expresses computations in which an output value is -- fed back as input, even though the computation occurs only once. -- It underlies the @rec@ value recursion construct in arrow notation. class Arrow a => ArrowLoop a where loop :: a (b,d) (c,d) -> a b c instance ArrowLoop (->) where loop f b = let (c,d) = f (b,d) in c instance MonadFix m => ArrowLoop (Kleisli m) where loop (Kleisli f) = Kleisli (liftM fst . mfix . f') where f' x y = f (x, snd y) hugs98-plus-Sep2006/packages/base/Control/Monad/0000755006511100651110000000000010504340224020123 5ustar rossrosshugs98-plus-Sep2006/packages/base/Control/Monad/ST/0000755006511100651110000000000010504340221020446 5ustar rossrosshugs98-plus-Sep2006/packages/base/Control/Monad/ST/Lazy.hs0000644006511100651110000001026710504340221021727 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Monad.ST.Lazy -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires universal quantification for runST) -- -- This module presents an identical interface to "Control.Monad.ST", -- except that the monad delays evaluation of state operations until -- a value depending on them is required. -- ----------------------------------------------------------------------------- module Control.Monad.ST.Lazy ( -- * The 'ST' monad ST, runST, fixST, -- * Converting between strict and lazy 'ST' strictToLazyST, lazyToStrictST, -- * Converting 'ST' To 'IO' RealWorld, stToIO, -- * Unsafe operations unsafeInterleaveST, unsafeIOToST ) where import Prelude import Control.Monad.Fix import Control.Monad.ST (RealWorld) import qualified Control.Monad.ST as ST #ifdef __GLASGOW_HASKELL__ import qualified GHC.ST import GHC.Base import Control.Monad #endif #ifdef __HUGS__ import Hugs.LazyST #endif #ifdef __GLASGOW_HASKELL__ -- | The lazy state-transformer monad. -- A computation of type @'ST' s a@ transforms an internal state indexed -- by @s@, and returns a value of type @a@. -- The @s@ parameter is either -- -- * an unstantiated type variable (inside invocations of 'runST'), or -- -- * 'RealWorld' (inside invocations of 'stToIO'). -- -- It serves to keep the internal states of different invocations of -- 'runST' separate from each other and from invocations of 'stToIO'. -- -- The '>>=' and '>>' operations are not strict in the state. For example, -- -- @'runST' (writeSTRef _|_ v >>= readSTRef _|_ >> return 2) = 2@ newtype ST s a = ST (State s -> (a, State s)) data State s = S# (State# s) instance Functor (ST s) where fmap f m = ST $ \ s -> let ST m_a = m (r,new_s) = m_a s in (f r,new_s) instance Monad (ST s) where return a = ST $ \ s -> (a,s) m >> k = m >>= \ _ -> k fail s = error s (ST m) >>= k = ST $ \ s -> let (r,new_s) = m s ST k_a = k r in k_a new_s {-# NOINLINE runST #-} -- | Return the value computed by a state transformer computation. -- The @forall@ ensures that the internal state used by the 'ST' -- computation is inaccessible to the rest of the program. runST :: (forall s. ST s a) -> a runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r -- | Allow the result of a state transformer computation to be used (lazily) -- inside the computation. -- Note that if @f@ is strict, @'fixST' f = _|_@. fixST :: (a -> ST s a) -> ST s a fixST m = ST (\ s -> let ST m_r = m r (r,s') = m_r s in (r,s')) #endif instance MonadFix (ST s) where mfix = fixST -- --------------------------------------------------------------------------- -- Strict <--> Lazy #ifdef __GLASGOW_HASKELL__ {-| Convert a strict 'ST' computation into a lazy one. The strict state thread passed to 'strictToLazyST' is not performed until the result of the lazy state thread it returns is demanded. -} strictToLazyST :: ST.ST s a -> ST s a strictToLazyST m = ST $ \s -> let pr = case s of { S# s# -> GHC.ST.liftST m s# } r = case pr of { GHC.ST.STret _ v -> v } s' = case pr of { GHC.ST.STret s2# _ -> S# s2# } in (r, s') {-| Convert a lazy 'ST' computation into a strict one. -} lazyToStrictST :: ST s a -> ST.ST s a lazyToStrictST (ST m) = GHC.ST.ST $ \s -> case (m (S# s)) of (a, S# s') -> (# s', a #) unsafeInterleaveST :: ST s a -> ST s a unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST #endif unsafeIOToST :: IO a -> ST s a unsafeIOToST = strictToLazyST . ST.unsafeIOToST -- | A monad transformer embedding lazy state transformers in the 'IO' -- monad. The 'RealWorld' parameter indicates that the internal state -- used by the 'ST' computation is a special one supplied by the 'IO' -- monad, and thus distinct from those used by invocations of 'runST'. stToIO :: ST RealWorld a -> IO a stToIO = ST.stToIO . lazyToStrictST hugs98-plus-Sep2006/packages/base/Control/Monad/ST/Strict.hs0000644006511100651110000000120610504340221022251 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Monad.ST.Strict -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires universal quantification for runST) -- -- The strict ST monad (re-export of "Control.Monad.ST") -- ----------------------------------------------------------------------------- module Control.Monad.ST.Strict ( module Control.Monad.ST ) where import Prelude import Control.Monad.ST hugs98-plus-Sep2006/packages/base/Control/Monad/Fix.hs0000644006511100651110000000443510504340222021211 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Fix -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Monadic fixpoints. -- -- For a detailed discussion, see Levent Erkok's thesis, -- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002. -- ----------------------------------------------------------------------------- module Control.Monad.Fix ( MonadFix( mfix -- :: (a -> m a) -> m a ), fix -- :: (a -> a) -> a ) where import Prelude import System.IO import Control.Monad.Instances () -- | @'fix' f@ is the least fixed point of the function @f@, -- i.e. the least defined @x@ such that @f x = x@. fix :: (a -> a) -> a fix f = let x = f x in x -- | Monads having fixed points with a \'knot-tying\' semantics. -- Instances of 'MonadFix' should satisfy the following laws: -- -- [/purity/] -- @'mfix' ('return' . h) = 'return' ('fix' h)@ -- -- [/left shrinking/ (or /tightening/)] -- @'mfix' (\\x -> a >>= \\y -> f x y) = a >>= \\y -> 'mfix' (\\x -> f x y)@ -- -- [/sliding/] -- @'mfix' ('Control.Monad.liftM' h . f) = 'Control.Monad.liftM' h ('mfix' (f . h))@, -- for strict @h@. -- -- [/nesting/] -- @'mfix' (\\x -> 'mfix' (\\y -> f x y)) = 'mfix' (\\x -> f x x)@ -- -- This class is used in the translation of the recursive @do@ notation -- supported by GHC and Hugs. class (Monad m) => MonadFix m where -- | The fixed point of a monadic computation. -- @'mfix' f@ executes the action @f@ only once, with the eventual -- output fed back as the input. Hence @f@ should not be strict, -- for then @'mfix' f@ would diverge. mfix :: (a -> m a) -> m a -- Instances of MonadFix for Prelude monads -- Maybe: instance MonadFix Maybe where mfix f = let a = f (unJust a) in a where unJust (Just x) = x -- List: instance MonadFix [] where mfix f = case fix (f . head) of [] -> [] (x:_) -> x : mfix (tail . f) -- IO: instance MonadFix IO where mfix = fixIO instance MonadFix ((->) r) where mfix f = \ r -> let a = f a r in a hugs98-plus-Sep2006/packages/base/Control/Monad/ST.hs0000644006511100651110000000343110504340222021004 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Monad.ST -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (requires universal quantification for runST) -- -- This library provides support for /strict/ state threads, as -- described in the PLDI \'94 paper by John Launchbury and Simon Peyton -- Jones /Lazy Functional State Threads/. -- ----------------------------------------------------------------------------- module Control.Monad.ST ( -- * The 'ST' Monad ST, -- abstract, instance of Functor, Monad, Typeable. runST, -- :: (forall s. ST s a) -> a fixST, -- :: (a -> ST s a) -> ST s a -- * Converting 'ST' to 'IO' RealWorld, -- abstract stToIO, -- :: ST RealWorld a -> IO a -- * Unsafe operations unsafeInterleaveST, -- :: ST s a -> ST s a unsafeIOToST, -- :: IO a -> ST s a unsafeSTToIO -- :: ST s a -> IO a ) where import Prelude import Control.Monad.Fix #include "Typeable.h" #ifdef __HUGS__ import Data.Typeable import Hugs.ST import qualified Hugs.LazyST as LazyST INSTANCE_TYPEABLE2(ST,sTTc,"ST") INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld") fixST :: (a -> ST s a) -> ST s a fixST f = LazyST.lazyToStrictST (LazyST.fixST (LazyST.strictToLazyST . f)) unsafeInterleaveST :: ST s a -> ST s a unsafeInterleaveST = LazyST.lazyToStrictST . LazyST.unsafeInterleaveST . LazyST.strictToLazyST #endif #ifdef __GLASGOW_HASKELL__ import GHC.ST ( ST, runST, fixST, unsafeInterleaveST ) import GHC.Base ( RealWorld ) import GHC.IOBase ( stToIO, unsafeIOToST, unsafeSTToIO ) #endif instance MonadFix (ST s) where mfix = fixST hugs98-plus-Sep2006/packages/base/Control/Monad/Instances.hs0000644006511100651110000000147710504340224022417 0ustar rossross{-# OPTIONS_NHC98 -prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Instances -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- 'Functor' and 'Monad' instances for @(->) r@ and -- 'Functor' instances for @(,) a@ and @'Either' a@. module Control.Monad.Instances (Functor(..),Monad(..)) where import Prelude instance Functor ((->) r) where fmap = (.) instance Monad ((->) r) where return = const f >>= k = \ r -> k (f r) r instance Functor ((,) a) where fmap f (x,y) = (x, f y) instance Functor (Either a) where fmap _ (Left x) = Left x fmap f (Right y) = Right (f y) hugs98-plus-Sep2006/packages/base/Control/Concurrent.hs0000644006511100651110000004322110504340223021544 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (concurrency) -- -- A common interface to a collection of useful concurrency -- abstractions. -- ----------------------------------------------------------------------------- module Control.Concurrent ( -- * Concurrent Haskell -- $conc_intro -- * Basic concurrency operations ThreadId, #ifdef __GLASGOW_HASKELL__ myThreadId, #endif forkIO, #ifdef __GLASGOW_HASKELL__ killThread, throwTo, #endif -- * Scheduling -- $conc_scheduling yield, -- :: IO () -- ** Blocking -- $blocking #ifdef __GLASGOW_HASKELL__ -- ** Waiting threadDelay, -- :: Int -> IO () threadWaitRead, -- :: Int -> IO () threadWaitWrite, -- :: Int -> IO () #endif -- * Communication abstractions module Control.Concurrent.MVar, module Control.Concurrent.Chan, module Control.Concurrent.QSem, module Control.Concurrent.QSemN, module Control.Concurrent.SampleVar, -- * Merging of streams #ifndef __HUGS__ mergeIO, -- :: [a] -> [a] -> IO [a] nmergeIO, -- :: [[a]] -> IO [a] #endif -- $merge #ifdef __GLASGOW_HASKELL__ -- * Bound Threads -- $boundthreads rtsSupportsBoundThreads, forkOS, isCurrentThreadBound, runInBoundThread, runInUnboundThread #endif -- * GHC's implementation of concurrency -- |This section describes features specific to GHC's -- implementation of Concurrent Haskell. -- ** Haskell threads and Operating System threads -- $osthreads -- ** Terminating the program -- $termination -- ** Pre-emption -- $preemption ) where import Prelude import Control.Exception as Exception #ifdef __GLASGOW_HASKELL__ import GHC.Conc ( ThreadId(..), myThreadId, killThread, yield, threadDelay, threadWaitRead, threadWaitWrite, forkIO, childHandler ) import GHC.TopHandler ( reportStackOverflow, reportError ) import GHC.IOBase ( IO(..) ) import GHC.IOBase ( unsafeInterleaveIO ) import GHC.IOBase ( newIORef, readIORef, writeIORef ) import GHC.Base import Foreign.StablePtr import Foreign.C.Types ( CInt ) import Control.Monad ( when ) #endif #ifdef __HUGS__ import Hugs.ConcBase #endif import Control.Concurrent.MVar import Control.Concurrent.Chan import Control.Concurrent.QSem import Control.Concurrent.QSemN import Control.Concurrent.SampleVar #ifdef __HUGS__ type ThreadId = () #endif {- $conc_intro The concurrency extension for Haskell is described in the paper /Concurrent Haskell/ . Concurrency is \"lightweight\", which means that both thread creation and context switching overheads are extremely low. Scheduling of Haskell threads is done internally in the Haskell runtime system, and doesn't make use of any operating system-supplied thread packages. However, if you want to interact with a foreign library that expects your program to use the operating system-supplied thread package, you can do so by using 'forkOS' instead of 'forkIO'. Haskell threads can communicate via 'MVar's, a kind of synchronised mutable variable (see "Control.Concurrent.MVar"). Several common concurrency abstractions can be built from 'MVar's, and these are provided by the "Control.Concurrent" library. In GHC, threads may also communicate via exceptions. -} {- $conc_scheduling Scheduling may be either pre-emptive or co-operative, depending on the implementation of Concurrent Haskell (see below for information related to specific compilers). In a co-operative system, context switches only occur when you use one of the primitives defined in this module. This means that programs such as: > main = forkIO (write 'a') >> write 'b' > where write c = putChar c >> write c will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@, instead of some random interleaving of @a@s and @b@s. In practice, cooperative multitasking is sufficient for writing simple graphical user interfaces. -} {- $blocking Calling a foreign C procedure (such as @getchar@) that blocks waiting for input will block /all/ threads, unless the @threadsafe@ attribute is used on the foreign call (and your compiler \/ operating system supports it). GHC's I\/O system uses non-blocking I\/O internally to implement thread-friendly I\/O, so calling standard Haskell I\/O functions blocks only the thread making the call. -} #ifndef __HUGS__ max_buff_size :: Int max_buff_size = 1 mergeIO :: [a] -> [a] -> IO [a] nmergeIO :: [[a]] -> IO [a] -- $merge -- The 'mergeIO' and 'nmergeIO' functions fork one thread for each -- input list that concurrently evaluates that list; the results are -- merged into a single output list. -- -- Note: Hugs does not provide these functions, since they require -- preemptive multitasking. mergeIO ls rs = newEmptyMVar >>= \ tail_node -> newMVar tail_node >>= \ tail_list -> newQSem max_buff_size >>= \ e -> newMVar 2 >>= \ branches_running -> let buff = (tail_list,e) in forkIO (suckIO branches_running buff ls) >> forkIO (suckIO branches_running buff rs) >> takeMVar tail_node >>= \ val -> signalQSem e >> return val type Buffer a = (MVar (MVar [a]), QSem) suckIO :: MVar Int -> Buffer a -> [a] -> IO () suckIO branches_running buff@(tail_list,e) vs = case vs of [] -> takeMVar branches_running >>= \ val -> if val == 1 then takeMVar tail_list >>= \ node -> putMVar node [] >> putMVar tail_list node else putMVar branches_running (val-1) (x:xs) -> waitQSem e >> takeMVar tail_list >>= \ node -> newEmptyMVar >>= \ next_node -> unsafeInterleaveIO ( takeMVar next_node >>= \ y -> signalQSem e >> return y) >>= \ next_node_val -> putMVar node (x:next_node_val) >> putMVar tail_list next_node >> suckIO branches_running buff xs nmergeIO lss = let len = length lss in newEmptyMVar >>= \ tail_node -> newMVar tail_node >>= \ tail_list -> newQSem max_buff_size >>= \ e -> newMVar len >>= \ branches_running -> let buff = (tail_list,e) in mapIO (\ x -> forkIO (suckIO branches_running buff x)) lss >> takeMVar tail_node >>= \ val -> signalQSem e >> return val where mapIO f xs = sequence (map f xs) #endif /* __HUGS__ */ #ifdef __GLASGOW_HASKELL__ -- --------------------------------------------------------------------------- -- Bound Threads {- $boundthreads Support for multiple operating system threads and bound threads as described below is currently only available in the GHC runtime system if you use the /-threaded/ option when linking. Other Haskell systems do not currently support multiple operating system threads. A bound thread is a haskell thread that is /bound/ to an operating system thread. While the bound thread is still scheduled by the Haskell run-time system, the operating system thread takes care of all the foreign calls made by the bound thread. To a foreign library, the bound thread will look exactly like an ordinary operating system thread created using OS functions like @pthread_create@ or @CreateThread@. Bound threads can be created using the 'forkOS' function below. All foreign exported functions are run in a bound thread (bound to the OS thread that called the function). Also, the @main@ action of every Haskell program is run in a bound thread. Why do we need this? Because if a foreign library is called from a thread created using 'forkIO', it won't have access to any /thread-local state/ - state variables that have specific values for each OS thread (see POSIX's @pthread_key_create@ or Win32's @TlsAlloc@). Therefore, some libraries (OpenGL, for example) will not work from a thread created using 'forkIO'. They work fine in threads created using 'forkOS' or when called from @main@ or from a @foreign export@. -} -- | 'True' if bound threads are supported. -- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound' -- will always return 'False' and both 'forkOS' and 'runInBoundThread' will -- fail. foreign import ccall rtsSupportsBoundThreads :: Bool {- | Like 'forkIO', this sparks off a new thread to run the 'IO' computation passed as the first argument, and returns the 'ThreadId' of the newly created thread. However, @forkOS@ uses operating system-supplied multithreading support to create a new operating system thread. The new thread is /bound/, which means that all foreign calls made by the 'IO' computation are guaranteed to be executed in this new operating system thread; also, the operating system thread is not used for any other foreign calls. This means that you can use all kinds of foreign libraries from this thread (even those that rely on thread-local state), without the limitations of 'forkIO'. Just to clarify, 'forkOS' is /only/ necessary if you need to associate a Haskell thread with a particular OS thread. It is not necessary if you only need to make non-blocking foreign calls (see "Control.Concurrent#osthreads"). -} forkOS :: IO () -> IO ThreadId foreign export ccall forkOS_entry :: StablePtr (IO ()) -> IO () foreign import ccall "forkOS_entry" forkOS_entry_reimported :: StablePtr (IO ()) -> IO () forkOS_entry stableAction = do action <- deRefStablePtr stableAction action foreign import ccall forkOS_createThread :: StablePtr (IO ()) -> IO CInt failNonThreaded = fail $ "RTS doesn't support multiple OS threads " ++"(use ghc -threaded when linking)" forkOS action | rtsSupportsBoundThreads = do mv <- newEmptyMVar let action_plus = Exception.catch action childHandler entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus) err <- forkOS_createThread entry when (err /= 0) $ fail "Cannot create OS thread." tid <- takeMVar mv freeStablePtr entry return tid | otherwise = failNonThreaded -- | Returns 'True' if the calling thread is /bound/, that is, if it is -- safe to use foreign libraries that rely on thread-local state from the -- calling thread. isCurrentThreadBound :: IO Bool isCurrentThreadBound = IO $ \ s# -> case isCurrentThreadBound# s# of (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #) {- | Run the 'IO' computation passed as the first argument. If the calling thread is not /bound/, a bound thread is created temporarily. @runInBoundThread@ doesn't finish until the 'IO' computation finishes. You can wrap a series of foreign function calls that rely on thread-local state with @runInBoundThread@ so that you can use them without knowing whether the current thread is /bound/. -} runInBoundThread :: IO a -> IO a runInBoundThread action | rtsSupportsBoundThreads = do bound <- isCurrentThreadBound if bound then action else do ref <- newIORef undefined let action_plus = Exception.try action >>= writeIORef ref resultOrException <- bracket (newStablePtr action_plus) freeStablePtr (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref) case resultOrException of Left exception -> Exception.throw exception Right result -> return result | otherwise = failNonThreaded {- | Run the 'IO' computation passed as the first argument. If the calling thread is /bound/, an unbound thread is created temporarily using 'forkIO'. @runInBoundThread@ doesn't finish until the 'IO' computation finishes. Use this function /only/ in the rare case that you have actually observed a performance loss due to the use of bound threads. A program that doesn't need it's main thread to be bound and makes /heavy/ use of concurrency (e.g. a web server), might want to wrap it's @main@ action in @runInUnboundThread@. -} runInUnboundThread :: IO a -> IO a runInUnboundThread action = do bound <- isCurrentThreadBound if bound then do mv <- newEmptyMVar forkIO (Exception.try action >>= putMVar mv) takeMVar mv >>= \either -> case either of Left exception -> Exception.throw exception Right result -> return result else action #endif /* __GLASGOW_HASKELL__ */ -- --------------------------------------------------------------------------- -- More docs {- $osthreads #osthreads# In GHC, threads created by 'forkIO' are lightweight threads, and are managed entirely by the GHC runtime. Typically Haskell threads are an order of magnitude or two more efficient (in terms of both time and space) than operating system threads. The downside of having lightweight threads is that only one can run at a time, so if one thread blocks in a foreign call, for example, the other threads cannot continue. The GHC runtime works around this by making use of full OS threads where necessary. When the program is built with the @-threaded@ option (to link against the multithreaded version of the runtime), a thread making a @safe@ foreign call will not block the other threads in the system; another OS thread will take over running Haskell threads until the original call returns. The runtime maintains a pool of these /worker/ threads so that multiple Haskell threads can be involved in external calls simultaneously. The "System.IO" library manages multiplexing in its own way. On Windows systems it uses @safe@ foreign calls to ensure that threads doing I\/O operations don't block the whole runtime, whereas on Unix systems all the currently blocked I\/O reqwests are managed by a single thread (the /IO manager thread/) using @select@. The runtime will run a Haskell thread using any of the available worker OS threads. If you need control over which particular OS thread is used to run a given Haskell thread, perhaps because you need to call a foreign library that uses OS-thread-local state, then you need "bound threads" (see above). If you don't use the @-threaded@ option, then the runtime does not make use of multiple OS threads. Foreign calls will block all other running Haskell threads until the call returns. The "System.IO" library still does multiplexing, so there can be multiple threads doing I\/O, and this is handled internally by the runtime using @select@. -} {- $termination In a standalone GHC program, only the main thread is required to terminate in order for the process to terminate. Thus all other forked threads will simply terminate at the same time as the main thread (the terminology for this kind of behaviour is \"daemonic threads\"). If you want the program to wait for child threads to finish before exiting, you need to program this yourself. A simple mechanism is to have each child thread write to an 'MVar' when it completes, and have the main thread wait on all the 'MVar's before exiting: > myForkIO :: IO () -> IO (MVar ()) > myForkIO io = do > mvar <- newEmptyMVar > forkIO (io `finally` putMVar mvar ()) > return mvar Note that we use 'finally' from the "Control.Exception" module to make sure that the 'MVar' is written to even if the thread dies or is killed for some reason. A better method is to keep a global list of all child threads which we should wait for at the end of the program: > children :: MVar [MVar ()] > children = unsafePerformIO (newMVar []) > > waitForChildren :: IO () > waitForChildren = do > cs <- takeMVar children > case cs of > [] -> return () > m:ms -> do > putMVar children ms > takeMVar m > waitForChildren > > forkChild :: IO () -> IO () > forkChild io = do > mvar <- newEmptyMVar > childs <- takeMVar children > putMVar children (mvar:childs) > forkIO (io `finally` putMVar mvar ()) > > main = > later waitForChildren $ > ... The main thread principle also applies to calls to Haskell from outside, using @foreign export@. When the @foreign export@ed function is invoked, it starts a new main thread, and it returns when this main thread terminates. If the call causes new threads to be forked, they may remain in the system after the @foreign export@ed function has returned. -} {- $preemption GHC implements pre-emptive multitasking: the execution of threads are interleaved in a random fashion. More specifically, a thread may be pre-empted whenever it allocates some memory, which unfortunately means that tight loops which do no allocation tend to lock out other threads (this only seems to happen with pathological benchmark-style code, however). The rescheduling timer runs on a 20ms granularity by default, but this may be altered using the @-i\@ RTS option. After a rescheduling \"tick\" the running thread is pre-empted as soon as possible. One final note: the @aaaa@ @bbbb@ example may not work too well on GHC (see Scheduling, above), due to the locking on a 'System.IO.Handle'. Only one thread may hold the lock on a 'System.IO.Handle' at any one time, so if a reschedule happens while a thread is holding the lock, the other thread won't be able to run. The upshot is that the switch from @aaaa@ to @bbbbb@ happens infrequently. It can be improved by lowering the reschedule tick period. We also have a patch that causes a reschedule whenever a thread waiting on a lock is woken up, but haven't found it to be useful for anything other than this example :-) -} hugs98-plus-Sep2006/packages/base/Control/Exception.hs0000644006511100651110000004470510504340226021373 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Exception -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (extended exceptions) -- -- This module provides support for raising and catching both built-in -- and user-defined exceptions. -- -- In addition to exceptions thrown by 'IO' operations, exceptions may -- be thrown by pure code (imprecise exceptions) or by external events -- (asynchronous exceptions), but may only be caught in the 'IO' monad. -- For more details, see: -- -- * /A semantics for imprecise exceptions/, by Simon Peyton Jones, -- Alastair Reid, Tony Hoare, Simon Marlow, Fergus Henderson, -- in /PLDI'99/. -- -- * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton -- Jones, Andy Moran and John Reppy, in /PLDI'01/. -- ----------------------------------------------------------------------------- module Control.Exception ( -- * The Exception type Exception(..), -- instance Eq, Ord, Show, Typeable IOException, -- instance Eq, Ord, Show, Typeable ArithException(..), -- instance Eq, Ord, Show, Typeable ArrayException(..), -- instance Eq, Ord, Show, Typeable AsyncException(..), -- instance Eq, Ord, Show, Typeable -- * Throwing exceptions throwIO, -- :: Exception -> IO a throw, -- :: Exception -> a ioError, -- :: IOError -> IO a #ifdef __GLASGOW_HASKELL__ throwTo, -- :: ThreadId -> Exception -> a #endif -- * Catching Exceptions -- |There are several functions for catching and examining -- exceptions; all of them may only be used from within the -- 'IO' monad. -- ** The @catch@ functions catch, -- :: IO a -> (Exception -> IO a) -> IO a catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a -- ** The @handle@ functions handle, -- :: (Exception -> IO a) -> IO a -> IO a handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a -- ** The @try@ functions try, -- :: IO a -> IO (Either Exception a) tryJust, -- :: (Exception -> Maybe b) -> a -> IO (Either b a) -- ** The @evaluate@ function evaluate, -- :: a -> IO a -- ** The @mapException@ function mapException, -- :: (Exception -> Exception) -> a -> a -- ** Exception predicates -- $preds ioErrors, -- :: Exception -> Maybe IOError arithExceptions, -- :: Exception -> Maybe ArithException errorCalls, -- :: Exception -> Maybe String dynExceptions, -- :: Exception -> Maybe Dynamic assertions, -- :: Exception -> Maybe String asyncExceptions, -- :: Exception -> Maybe AsyncException userErrors, -- :: Exception -> Maybe String -- * Dynamic exceptions -- $dynamic throwDyn, -- :: Typeable ex => ex -> b #ifdef __GLASGOW_HASKELL__ throwDynTo, -- :: Typeable ex => ThreadId -> ex -> b #endif catchDyn, -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a -- * Asynchronous Exceptions -- $async -- ** Asynchronous exception control -- |The following two functions allow a thread to control delivery of -- asynchronous exceptions during a critical region. block, -- :: IO a -> IO a unblock, -- :: IO a -> IO a -- *** Applying @block@ to an exception handler -- $block_handler -- *** Interruptible operations -- $interruptible -- * Assertions assert, -- :: Bool -> a -> a -- * Utilities bracket, -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO () bracket_, -- :: IO a -> IO b -> IO c -> IO () bracketOnError, finally, -- :: IO a -> IO b -> IO a #ifdef __GLASGOW_HASKELL__ setUncaughtExceptionHandler, -- :: (Exception -> IO ()) -> IO () getUncaughtExceptionHandler -- :: IO (Exception -> IO ()) #endif ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base ( assert ) import GHC.Exception as ExceptionBase hiding (catch) import GHC.Conc ( throwTo, ThreadId ) import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) import Foreign.C.String ( CString, withCString ) import System.IO ( stdout, hFlush ) #endif #ifdef __HUGS__ import Hugs.Exception as ExceptionBase #endif import Prelude hiding ( catch ) import System.IO.Error hiding ( catch, try ) import System.IO.Unsafe (unsafePerformIO) import Data.Dynamic ----------------------------------------------------------------------------- -- Catching exceptions -- |This is the simplest of the exception-catching functions. It -- takes a single argument, runs it, and if an exception is raised -- the \"handler\" is executed, with the value of the exception passed as an -- argument. Otherwise, the result is returned as normal. For example: -- -- > catch (openFile f ReadMode) -- > (\e -> hPutStr stderr ("Couldn't open "++f++": " ++ show e)) -- -- For catching exceptions in pure (non-'IO') expressions, see the -- function 'evaluate'. -- -- Note that due to Haskell\'s unspecified evaluation order, an -- expression may return one of several possible exceptions: consider -- the expression @error \"urk\" + 1 \`div\` 0@. Does -- 'catch' execute the handler passing -- @ErrorCall \"urk\"@, or @ArithError DivideByZero@? -- -- The answer is \"either\": 'catch' makes a -- non-deterministic choice about which exception to catch. If you -- call it again, you might get a different exception back. This is -- ok, because 'catch' is an 'IO' computation. -- -- Note that 'catch' catches all types of exceptions, and is generally -- used for \"cleaning up\" before passing on the exception using -- 'throwIO'. It is not good practice to discard the exception and -- continue, without first checking the type of the exception (it -- might be a 'ThreadKilled', for example). In this case it is usually better -- to use 'catchJust' and select the kinds of exceptions to catch. -- -- Also note that the "Prelude" also exports a function called -- 'Prelude.catch' with a similar type to 'Control.Exception.catch', -- except that the "Prelude" version only catches the IO and user -- families of exceptions (as required by Haskell 98). -- -- We recommend either hiding the "Prelude" version of 'Prelude.catch' -- when importing "Control.Exception": -- -- > import Prelude hiding (catch) -- -- or importing "Control.Exception" qualified, to avoid name-clashes: -- -- > import qualified Control.Exception as C -- -- and then using @C.catch@ -- catch :: IO a -- ^ The computation to run -> (Exception -> IO a) -- ^ Handler to invoke if an exception is raised -> IO a catch = ExceptionBase.catchException -- | The function 'catchJust' is like 'catch', but it takes an extra -- argument which is an /exception predicate/, a function which -- selects which type of exceptions we\'re interested in. There are -- some predefined exception predicates for useful subsets of -- exceptions: 'ioErrors', 'arithExceptions', and so on. For example, -- to catch just calls to the 'error' function, we could use -- -- > result <- catchJust errorCalls thing_to_try handler -- -- Any other exceptions which are not matched by the predicate -- are re-raised, and may be caught by an enclosing -- 'catch' or 'catchJust'. catchJust :: (Exception -> Maybe b) -- ^ Predicate to select exceptions -> IO a -- ^ Computation to run -> (b -> IO a) -- ^ Handler -> IO a catchJust p a handler = catch a handler' where handler' e = case p e of Nothing -> throw e Just b -> handler b -- | A version of 'catch' with the arguments swapped around; useful in -- situations where the code for the handler is shorter. For example: -- -- > do handle (\e -> exitWith (ExitFailure 1)) $ -- > ... handle :: (Exception -> IO a) -> IO a -> IO a handle = flip catch -- | A version of 'catchJust' with the arguments swapped around (see -- 'handle'). handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a handleJust p = flip (catchJust p) ----------------------------------------------------------------------------- -- 'mapException' -- | This function maps one exception into another as proposed in the -- paper \"A semantics for imprecise exceptions\". -- Notice that the usage of 'unsafePerformIO' is safe here. mapException :: (Exception -> Exception) -> a -> a mapException f v = unsafePerformIO (catch (evaluate v) (\x -> throw (f x))) ----------------------------------------------------------------------------- -- 'try' and variations. -- | Similar to 'catch', but returns an 'Either' result which is -- @('Right' a)@ if no exception was raised, or @('Left' e)@ if an -- exception was raised and its value is @e@. -- -- > try a = catch (Right `liftM` a) (return . Left) -- -- Note: as with 'catch', it is only polite to use this variant if you intend -- to re-throw the exception after performing whatever cleanup is needed. -- Otherwise, 'tryJust' is generally considered to be better. -- -- Also note that "System.IO.Error" also exports a function called -- 'System.IO.Error.try' with a similar type to 'Control.Exception.try', -- except that it catches only the IO and user families of exceptions -- (as required by the Haskell 98 @IO@ module). try :: IO a -> IO (Either Exception a) try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e)) -- | A variant of 'try' that takes an exception predicate to select -- which exceptions are caught (c.f. 'catchJust'). If the exception -- does not match the predicate, it is re-thrown. tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a) tryJust p a = do r <- try a case r of Right v -> return (Right v) Left e -> case p e of Nothing -> throw e Just b -> return (Left b) ----------------------------------------------------------------------------- -- Dynamic exceptions -- $dynamic -- #DynamicExceptions# Because the 'Exception' datatype is not extensible, there is an -- interface for throwing and catching exceptions of type 'Dynamic' -- (see "Data.Dynamic") which allows exception values of any type in -- the 'Typeable' class to be thrown and caught. -- | Raise any value as an exception, provided it is in the -- 'Typeable' class. throwDyn :: Typeable exception => exception -> b throwDyn exception = throw (DynException (toDyn exception)) #ifdef __GLASGOW_HASKELL__ -- | A variant of 'throwDyn' that throws the dynamic exception to an -- arbitrary thread (GHC only: c.f. 'throwTo'). throwDynTo :: Typeable exception => ThreadId -> exception -> IO () throwDynTo t exception = throwTo t (DynException (toDyn exception)) #endif /* __GLASGOW_HASKELL__ */ -- | Catch dynamic exceptions of the required type. All other -- exceptions are re-thrown, including dynamic exceptions of the wrong -- type. -- -- When using dynamic exceptions it is advisable to define a new -- datatype to use for your exception type, to avoid possible clashes -- with dynamic exceptions used in other libraries. -- catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a catchDyn m k = catchException m handle where handle ex = case ex of (DynException dyn) -> case fromDynamic dyn of Just exception -> k exception Nothing -> throw ex _ -> throw ex ----------------------------------------------------------------------------- -- Exception Predicates -- $preds -- These pre-defined predicates may be used as the first argument to -- 'catchJust', 'tryJust', or 'handleJust' to select certain common -- classes of exceptions. ioErrors :: Exception -> Maybe IOError arithExceptions :: Exception -> Maybe ArithException errorCalls :: Exception -> Maybe String assertions :: Exception -> Maybe String dynExceptions :: Exception -> Maybe Dynamic asyncExceptions :: Exception -> Maybe AsyncException userErrors :: Exception -> Maybe String ioErrors (IOException e) = Just e ioErrors _ = Nothing arithExceptions (ArithException e) = Just e arithExceptions _ = Nothing errorCalls (ErrorCall e) = Just e errorCalls _ = Nothing assertions (AssertionFailed e) = Just e assertions _ = Nothing dynExceptions (DynException e) = Just e dynExceptions _ = Nothing asyncExceptions (AsyncException e) = Just e asyncExceptions _ = Nothing userErrors (IOException e) | isUserError e = Just (ioeGetErrorString e) userErrors _ = Nothing ----------------------------------------------------------------------------- -- Some Useful Functions -- | When you want to acquire a resource, do some work with it, and -- then release the resource, it is a good idea to use 'bracket', -- because 'bracket' will install the necessary exception handler to -- release the resource in the event that an exception is raised -- during the computation. If an exception is raised, then 'bracket' will -- re-raise the exception (after performing the release). -- -- A common example is opening a file: -- -- > bracket -- > (openFile "filename" ReadMode) -- > (hClose) -- > (\handle -> do { ... }) -- -- The arguments to 'bracket' are in this order so that we can partially apply -- it, e.g.: -- -- > withFile name = bracket (openFile name) hClose -- bracket :: IO a -- ^ computation to run first (\"acquire resource\") -> (a -> IO b) -- ^ computation to run last (\"release resource\") -> (a -> IO c) -- ^ computation to run in-between -> IO c -- returns the value from the in-between computation bracket before after thing = block (do a <- before r <- catch (unblock (thing a)) (\e -> do { after a; throw e }) after a return r ) -- | A specialised variant of 'bracket' with just a computation to run -- afterward. -- finally :: IO a -- ^ computation to run first -> IO b -- ^ computation to run afterward (even if an exception -- was raised) -> IO a -- returns the value from the first computation a `finally` sequel = block (do r <- catch (unblock a) (\e -> do { sequel; throw e }) sequel return r ) -- | A variant of 'bracket' where the return value from the first computation -- is not required. bracket_ :: IO a -> IO b -> IO c -> IO c bracket_ before after thing = bracket before (const after) (const thing) -- | Like bracket, but only performs the final action if there was an -- exception raised by the in-between computation. bracketOnError :: IO a -- ^ computation to run first (\"acquire resource\") -> (a -> IO b) -- ^ computation to run last (\"release resource\") -> (a -> IO c) -- ^ computation to run in-between -> IO c -- returns the value from the in-between computation bracketOnError before after thing = block (do a <- before catch (unblock (thing a)) (\e -> do { after a; throw e }) ) -- ----------------------------------------------------------------------------- -- Asynchronous exceptions {- $async #AsynchronousExceptions# Asynchronous exceptions are so-called because they arise due to external influences, and can be raised at any point during execution. 'StackOverflow' and 'HeapOverflow' are two examples of system-generated asynchronous exceptions. The primary source of asynchronous exceptions, however, is 'throwTo': > throwTo :: ThreadId -> Exception -> IO () 'throwTo' (also 'throwDynTo' and 'Control.Concurrent.killThread') allows one running thread to raise an arbitrary exception in another thread. The exception is therefore asynchronous with respect to the target thread, which could be doing anything at the time it receives the exception. Great care should be taken with asynchronous exceptions; it is all too easy to introduce race conditions by the over zealous use of 'throwTo'. -} {- $block_handler There\'s an implied 'block' around every exception handler in a call to one of the 'catch' family of functions. This is because that is what you want most of the time - it eliminates a common race condition in starting an exception handler, because there may be no exception handler on the stack to handle another exception if one arrives immediately. If asynchronous exceptions are blocked on entering the handler, though, we have time to install a new exception handler before being interrupted. If this weren\'t the default, one would have to write something like > block ( > catch (unblock (...)) > (\e -> handler) > ) If you need to unblock asynchronous exceptions again in the exception handler, just use 'unblock' as normal. Note that 'try' and friends /do not/ have a similar default, because there is no exception handler in this case. If you want to use 'try' in an asynchronous-exception-safe way, you will need to use 'block'. -} {- $interruptible Some operations are /interruptible/, which means that they can receive asynchronous exceptions even in the scope of a 'block'. Any function which may itself block is defined as interruptible; this includes 'Control.Concurrent.MVar.takeMVar' (but not 'Control.Concurrent.MVar.tryTakeMVar'), and most operations which perform some I\/O with the outside world. The reason for having interruptible operations is so that we can write things like > block ( > a <- takeMVar m > catch (unblock (...)) > (\e -> ...) > ) if the 'Control.Concurrent.MVar.takeMVar' was not interruptible, then this particular combination could lead to deadlock, because the thread itself would be blocked in a state where it can\'t receive any asynchronous exceptions. With 'Control.Concurrent.MVar.takeMVar' interruptible, however, we can be safe in the knowledge that the thread can receive exceptions right up until the point when the 'Control.Concurrent.MVar.takeMVar' succeeds. Similar arguments apply for other interruptible operations like 'System.IO.openFile'. -} #ifndef __GLASGOW_HASKELL__ assert :: Bool -> a -> a assert True x = x assert False _ = throw (AssertionFailed "") #endif #ifdef __GLASGOW_HASKELL__ {-# NOINLINE uncaughtExceptionHandler #-} uncaughtExceptionHandler :: IORef (Exception -> IO ()) uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler) where defaultHandler :: Exception -> IO () defaultHandler ex = do (hFlush stdout) `catchException` (\ _ -> return ()) let msg = case ex of Deadlock -> "no threads to run: infinite loop or deadlock?" ErrorCall s -> s other -> showsPrec 0 other "\n" withCString "%s" $ \cfmt -> withCString msg $ \cmsg -> errorBelch cfmt cmsg foreign import ccall unsafe "RtsMessages.h errorBelch" errorBelch :: CString -> CString -> IO () setUncaughtExceptionHandler :: (Exception -> IO ()) -> IO () setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler getUncaughtExceptionHandler :: IO (Exception -> IO ()) getUncaughtExceptionHandler = readIORef uncaughtExceptionHandler #endif hugs98-plus-Sep2006/packages/base/Control/Parallel/0000755006511100651110000000000010504340221020616 5ustar rossrosshugs98-plus-Sep2006/packages/base/Control/Parallel/Strategies.hs0000644006511100651110000004045210504340221023271 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Parallel.Strategies -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable -- -- Parallel strategy combinators -- ----------------------------------------------------------------------------- module Control.Parallel.Strategies where -- based on hslibs/concurrent/Strategies.lhs; see it for more detailed -- code comments. Original authors: -- -- Phil Trinder, Hans-Wolfgang Loidl, Kevin Hammond et al. -- #ifdef __HADDOCK__ import Prelude #endif import Control.Parallel as Parallel import Data.Ix import Data.Array import Data.Complex import Data.Ratio -- not a terribly portable way of getting at Ratio rep. #ifdef __GLASGOW_HASKELL__ import GHC.Real (Ratio(..)) -- The basic defns for Ratio #endif #ifdef __HUGS__ import Hugs.Prelude(Ratio(..) ) #endif #ifdef __NHC__ import Ratio (Ratio(..) ) #endif infixl 0 `using`,`demanding`,`sparking` -- weakest precedence! infixr 2 >|| -- another name for par infixr 3 >| -- another name for seq infixl 6 $||, $| -- strategic function application (seq and par) infixl 9 .|, .||, -|, -|| -- strategic (inverse) function composition ------------------------------------------------------------------------------ -- Strategy Type, Application and Semantics ------------------------------------------------------------------------------ type Done = () type Strategy a = a -> Done {- A strategy takes a value and returns a dummy `done' value to indicate that the specifed evaluation has been performed. The basic combinators for strategies are @par@ and @seq@ but with types that indicate that they only combine the results of a strategy application. NB: This version can be used with Haskell 1.4 (GHC 2.05 and beyond), *but* you won't get strategy checking on seq (only on par)! The infix fcts >| and >|| are alternative names for `seq` and `par`. With the introduction of a Prelude function `seq` separating the Prelude function from the Strategy function becomes a pain. The notation also matches the notation for strategic function application. -} {- par and seq have the same types as before; >| and >|| are more specific and can only be used when composing strategies. -} (>|), (>||) :: Done -> Done -> Done {-# INLINE (>|) #-} {-# INLINE (>||) #-} (>|) = Prelude.seq (>||) = Parallel.par using :: a -> Strategy a -> a using x s = s x `seq` x {- using takes a strategy and a value, and applies the strategy to the value before returning the value. Used to express data-oriented parallelism x `using` s is a projection on x, i.e. both a retraction: x `using` s [ x - and idempotent: (x `using` s) `using` s = x `using` s demanding and sparking are used to express control-oriented parallelism. Their second argument is usually a sequence of strategy applications combined `par` and `seq`. Sparking should only be used with a singleton sequence as it is not necessarily excuted -} demanding, sparking :: a -> Done -> a demanding = flip Parallel.seq sparking = flip Parallel.par {- sPar and sSeq have been superceded by sparking and demanding: replace e `using` sPar x with e `sparking` x e `using` sSeq x with e `demanding` x sPar is a strategy corresponding to par. i.e. x `par` e <=> e `using` sPar x -} sPar :: a -> Strategy b sPar x y = x `par` () {- sSeq is a strategy corresponding to seq. i.e. x `seq` e <=> e `using` sSeq x -} sSeq :: a -> Strategy b sSeq x y = x `seq` () ----------------------------------------------------------------------------- -- Basic Strategies ----------------------------------------------------------------------------- -- r0 performs *no* evaluation on its argument. r0 :: Strategy a r0 x = () --rwhnf reduces its argument to weak head normal form. rwhnf :: Strategy a rwhnf x = x `seq` () class NFData a where -- rnf reduces its argument to (head) normal form rnf :: Strategy a -- Default method. Useful for base types. A specific method is necessay for -- constructed types rnf = rwhnf class (NFData a, Integral a) => NFDataIntegral a class (NFData a, Ord a) => NFDataOrd a ------------------------------------------------------------------------------ -- Strategic Function Application ------------------------------------------------------------------------------ {- The two infix functions @$|@ and @$||@ perform sequential and parallel function application, respectively. They are parameterised with a strategy that is applied to the argument of the function application. This is very handy when writing pipeline parallelism as a sequence of @$@, @$|@ and @$||@'s. There is no need of naming intermediate values in this case. The separation of algorithm from strategy is achieved by allowing strategies only as second arguments to @$|@ and @$||@. -} ($|), ($||) :: (a -> b) -> Strategy a -> a -> b f $| s = \ x -> f x `demanding` s x f $|| s = \ x -> f x `sparking` s x {- The same thing for function composition (.| and .||) and inverse function composition (-| and -||) for those who read their programs from left to right. -} (.|), (.||) :: (b -> c) -> Strategy b -> (a -> b) -> (a -> c) (-|), (-||) :: (a -> b) -> Strategy b -> (b -> c) -> (a -> c) (.|) f s g = \ x -> let gx = g x in f gx `demanding` s gx (.||) f s g = \ x -> let gx = g x in f gx `sparking` s gx (-|) f s g = \ x -> let fx = f x in g fx `demanding` s fx (-||) f s g = \ x -> let fx = f x in g fx `sparking` s fx ------------------------------------------------------------------------------ -- Marking a Strategy ------------------------------------------------------------------------------ {- Marking a strategy. Actually, @markStrat@ sticks a label @n@ into the sparkname field of the thread executing strategy @s@. Together with a runtime-system that supports propagation of sparknames to the children this means that this strategy and all its children have the sparkname @n@ (if the static sparkname field in the @parGlobal@ annotation contains the value 1). Note, that the @SN@ field of starting the marked strategy itself contains the sparkname of the parent thread. The END event contains @n@ as sparkname. -} #if 0 markStrat :: Int -> Strategy a -> Strategy a markStrat n s x = unsafePerformPrimIO ( _casm_ ``%r = set_sparkname(CurrentTSO, %0);'' n `thenPrimIO` \ z -> returnPrimIO (s x)) #endif ----------------------------------------------------------------------------- -- Strategy Instances and Functions ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- Tuples ----------------------------------------------------------------------------- {- We currently support up to 9-tuples. If you need longer tuples you have to add the instance explicitly to your program. -} instance (NFData a, NFData b) => NFData (a,b) where rnf (x,y) = rnf x `seq` rnf y instance (NFData a, NFData b, NFData c) => NFData (a,b,c) where rnf (x,y,z) = rnf x `seq` rnf y `seq` rnf z instance (NFData a, NFData b, NFData c, NFData d) => NFData (a,b,c,d) where rnf (x1,x2,x3,x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5) => NFData (a1, a2, a3, a4, a5) where rnf (x1, x2, x3, x4, x5) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6) => NFData (a1, a2, a3, a4, a5, a6) where rnf (x1, x2, x3, x4, x5, x6) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7) => NFData (a1, a2, a3, a4, a5, a6, a7) where rnf (x1, x2, x3, x4, x5, x6, x7) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` rnf x7 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8) => NFData (a1, a2, a3, a4, a5, a6, a7, a8) where rnf (x1, x2, x3, x4, x5, x6, x7, x8) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` rnf x7 `seq` rnf x8 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8, NFData a9) => NFData (a1, a2, a3, a4, a5, a6, a7, a8, a9) where rnf (x1, x2, x3, x4, x5, x6, x7, x8, x9) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 seqPair :: Strategy a -> Strategy b -> Strategy (a,b) seqPair strata stratb (x,y) = strata x `seq` stratb y parPair :: Strategy a -> Strategy b -> Strategy (a,b) parPair strata stratb (x,y) = strata x `par` stratb y `par` () {- The reason for the second `par` is so that the strategy terminates quickly. This is important if the strategy is used as the 1st argument of a seq -} seqTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c) seqTriple strata stratb stratc p@(x,y,z) = strata x `seq` stratb y `seq` stratc z parTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c) parTriple strata stratb stratc (x,y,z) = strata x `par` stratb y `par` stratc z `par` () {- Weak head normal form and normal form are identical for integers, so the default rnf is sufficient. -} instance NFData Int instance NFData Integer instance NFData Float instance NFData Double instance NFDataIntegral Int instance NFDataOrd Int --Rational and complex numbers. instance (Integral a, NFData a) => NFData (Ratio a) where rnf (x:%y) = rnf x `seq` rnf y `seq` () instance (RealFloat a, NFData a) => NFData (Complex a) where rnf (x:+y) = rnf x `seq` rnf y `seq` () instance NFData Char instance NFData Bool instance NFData () ----------------------------------------------------------------------------- -- Lists ---------------------------------------------------------------------------- instance NFData a => NFData [a] where rnf [] = () rnf (x:xs) = rnf x `seq` rnf xs ---------------------------------------------------------------------------- -- Lists: Parallel Strategies ---------------------------------------------------------------------------- -- | Applies a strategy to every element of a list in parallel parList :: Strategy a -> Strategy [a] parList strat [] = () parList strat (x:xs) = strat x `par` (parList strat xs) -- | Applies a strategy to the first n elements of a list in parallel parListN :: (Integral b) => b -> Strategy a -> Strategy [a] parListN n strat [] = () parListN 0 strat xs = () parListN n strat (x:xs) = strat x `par` (parListN (n-1) strat xs) -- | Evaluates N elements of the spine of the argument list and applies -- the given strategy to the Nth element (if there is one) in parallel with -- the result. e.g. parListNth 2 [e1, e2, e3] evaluates e2 parListNth :: Int -> Strategy a -> Strategy [a] parListNth n strat xs | null rest = () | otherwise = strat (head rest) `par` () where rest = drop n xs -- | 'parListChunk' sequentially applies a strategy to chunks -- (sub-sequences) of a list in parallel. Useful to increase grain size parListChunk :: Int -> Strategy a -> Strategy [a] parListChunk n strat [] = () parListChunk n strat xs = seqListN n strat xs `par` parListChunk n strat (drop n xs) -- | 'parMap' applies a function to each element of the argument list in -- parallel. The result of the function is evaluated using the given -- strategy. parMap :: Strategy b -> (a -> b) -> [a] -> [b] parMap strat f xs = map f xs `using` parList strat -- | 'parFlatMap' uses 'parMap' to apply a list-valued function to each -- element of the argument list in parallel. The result of the function -- is evaluated using the given strategy. parFlatMap :: Strategy [b] -> (a -> [b]) -> [a] -> [b] parFlatMap strat f xs = concat (parMap strat f xs) -- | 'parZipWith' zips together two lists with a function z in parallel parZipWith :: Strategy c -> (a -> b -> c) -> [a] -> [b] -> [c] parZipWith strat z as bs = zipWith z as bs `using` parList strat ---------------------------------------------------------------------------- -- Lists: Sequential Strategies ---------------------------------------------------------------------------- -- | Sequentially applies a strategy to each element of a list seqList :: Strategy a -> Strategy [a] seqList strat [] = () seqList strat (x:xs) = strat x `seq` (seqList strat xs) -- | Sequentially applies a strategy to the first n elements of a list seqListN :: (Integral a) => a -> Strategy b -> Strategy [b] seqListN n strat [] = () seqListN 0 strat xs = () seqListN n strat (x:xs) = strat x `seq` (seqListN (n-1) strat xs) -- | 'seqListNth' applies a strategy to the Nth element of it's argument -- (if there is one) before returning the result. e.g. seqListNth 2 [e1, -- e2, e3] evaluates e2 seqListNth :: Int -> Strategy b -> Strategy [b] seqListNth n strat xs | null rest = () | otherwise = strat (head rest) where rest = drop n xs -- | Parallel n-buffer function added for the revised version of the strategies -- paper. 'parBuffer' supersedes the older @fringeList@. It has the same -- semantics. parBuffer :: Int -> Strategy a -> [a] -> [a] parBuffer n s xs = return xs (start n xs) where return (x:xs) (y:ys) = (x:return xs ys) `sparking` s y return xs [] = xs start n [] = [] start 0 ys = ys start n (y:ys) = start (n-1) ys `sparking` s y {- 'fringeList' implements a `rolling buffer' of length n, i.e.applies a strategy to the nth element of list when the head is demanded. More precisely: semantics: fringeList n s = id :: [b] -> [b] dynamic behaviour: evalutates the nth element of the list when the head is demanded. The idea is to provide a `rolling buffer' of length n. fringeList :: (Integral a) => a -> Strategy b -> [b] -> [b] fringeList n strat [] = [] fringeList n strat (r:rs) = seqListNth n strat rs `par` r:fringeList n strat rs -} ------------------------------------------------------------------------------ -- Arrays ------------------------------------------------------------------------------ instance (Ix a, NFData a, NFData b) => NFData (Array a b) where rnf x = rnf (bounds x) `seq` seqList rnf (elems x) `seq` () -- | Apply a strategy to all elements of an array in parallel. This can be done -- either in sequentially or in parallel (same as with lists, really). seqArr :: (Ix b) => Strategy a -> Strategy (Array b a) seqArr s arr = seqList s (elems arr) parArr :: (Ix b) => Strategy a -> Strategy (Array b a) parArr s arr = parList s (elems arr) -- Associations maybe useful even without mentioning Arrays. data Assoc a b = a := b deriving () instance (NFData a, NFData b) => NFData (Assoc a b) where rnf (x := y) = rnf x `seq` rnf y `seq` () ------------------------------------------------------------------------------ -- Some strategies specific for Lolita ------------------------------------------------------------------------------ fstPairFstList :: (NFData a) => Strategy [(a,b)] fstPairFstList = seqListN 1 (seqPair rwhnf r0) -- Some HACKs for Lolita. AFAIK force is just another name for our rnf and -- sforce is a shortcut (definition here is identical to the one in Force.lhs) force :: (NFData a) => a -> a sforce :: (NFData a) => a -> b -> b force = id $| rnf sforce x y = force x `seq` y hugs98-plus-Sep2006/packages/base/Control/Monad.hs0000644006511100651110000002457210504340226020473 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Monad -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- The 'Functor', 'Monad' and 'MonadPlus' classes, -- with some useful operations on monads. module Control.Monad ( -- * Functor and monad classes Functor(fmap) , Monad((>>=), (>>), return, fail) , MonadPlus ( -- class context: Monad mzero -- :: (MonadPlus m) => m a , mplus -- :: (MonadPlus m) => m a -> m a -> m a ) -- * Functions -- ** Naming conventions -- $naming -- ** Basic functions from the "Prelude" , mapM -- :: (Monad m) => (a -> m b) -> [a] -> m [b] , mapM_ -- :: (Monad m) => (a -> m b) -> [a] -> m () , forM -- :: (Monad m) => [a] -> (a -> m b) -> m [b] , forM_ -- :: (Monad m) => [a] -> (a -> m b) -> m () , sequence -- :: (Monad m) => [m a] -> m [a] , sequence_ -- :: (Monad m) => [m a] -> m () , (=<<) -- :: (Monad m) => (a -> m b) -> m a -> m b -- ** Generalisations of list functions , join -- :: (Monad m) => m (m a) -> m a , msum -- :: (MonadPlus m) => [m a] -> m a , filterM -- :: (Monad m) => (a -> m Bool) -> [a] -> m [a] , mapAndUnzipM -- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c]) , zipWithM -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c] , zipWithM_ -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m () , foldM -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a , foldM_ -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m () , replicateM -- :: (Monad m) => Int -> m a -> m [a] , replicateM_ -- :: (Monad m) => Int -> m a -> m () -- ** Conditional execution of monadic expressions , guard -- :: (MonadPlus m) => Bool -> m () , when -- :: (Monad m) => Bool -> m () -> m () , unless -- :: (Monad m) => Bool -> m () -> m () -- ** Monadic lifting operators , liftM -- :: (Monad m) => (a -> b) -> (m a -> m b) , liftM2 -- :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c) , liftM3 -- :: ... , liftM4 -- :: ... , liftM5 -- :: ... , ap -- :: (Monad m) => m (a -> b) -> m a -> m b ) where import Data.Maybe #ifdef __GLASGOW_HASKELL__ import GHC.List import GHC.Base #endif #ifdef __GLASGOW_HASKELL__ infixr 1 =<< -- ----------------------------------------------------------------------------- -- Prelude monad functions -- | Same as '>>=', but with the arguments interchanged. {-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-} (=<<) :: Monad m => (a -> m b) -> m a -> m b f =<< x = x >>= f -- | Evaluate each action in the sequence from left to right, -- and collect the results. sequence :: Monad m => [m a] -> m [a] {-# INLINE sequence #-} sequence ms = foldr k (return []) ms where k m m' = do { x <- m; xs <- m'; return (x:xs) } -- | Evaluate each action in the sequence from left to right, -- and ignore the results. sequence_ :: Monad m => [m a] -> m () {-# INLINE sequence_ #-} sequence_ ms = foldr (>>) (return ()) ms -- | @'mapM' f@ is equivalent to @'sequence' . 'map' f@. mapM :: Monad m => (a -> m b) -> [a] -> m [b] {-# INLINE mapM #-} mapM f as = sequence (map f as) -- | @'mapM_' f@ is equivalent to @'sequence_' . 'map' f@. mapM_ :: Monad m => (a -> m b) -> [a] -> m () {-# INLINE mapM_ #-} mapM_ f as = sequence_ (map f as) #endif /* __GLASGOW_HASKELL__ */ -- ----------------------------------------------------------------------------- -- The MonadPlus class definition -- | Monads that also support choice and failure. class Monad m => MonadPlus m where -- | the identity of 'mplus'. It should also satisfy the equations -- -- > mzero >>= f = mzero -- > v >> mzero = mzero -- -- (but the instance for 'System.IO.IO' defined in "Control.Monad.Error" -- does not satisfy the second one). mzero :: m a -- | an associative operation mplus :: m a -> m a -> m a instance MonadPlus [] where mzero = [] mplus = (++) instance MonadPlus Maybe where mzero = Nothing Nothing `mplus` ys = ys xs `mplus` _ys = xs -- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude -- | @'guard' b@ is @'return' ()@ if @b@ is 'True', -- and 'mzero' if @b@ is 'False'. guard :: (MonadPlus m) => Bool -> m () guard True = return () guard False = mzero -- | This generalizes the list-based 'filter' function. filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a] filterM _ [] = return [] filterM p (x:xs) = do flg <- p x ys <- filterM p xs return (if flg then x:ys else ys) -- | 'forM' is 'mapM' with its arguments flipped forM :: Monad m => [a] -> (a -> m b) -> m [b] {-# INLINE forM #-} forM = flip mapM -- | 'forM_' is 'mapM_' with its arguments flipped forM_ :: Monad m => [a] -> (a -> m b) -> m () {-# INLINE forM_ #-} forM_ = flip mapM_ -- | This generalizes the list-based 'concat' function. msum :: MonadPlus m => [m a] -> m a {-# INLINE msum #-} msum = foldr mplus mzero -- ----------------------------------------------------------------------------- -- Other monad functions -- | The 'join' function is the conventional monad join operator. It is used to -- remove one level of monadic structure, projecting its bound argument into the -- outer level. join :: (Monad m) => m (m a) -> m a join x = x >>= id -- | The 'mapAndUnzipM' function maps its first argument over a list, returning -- the result as a pair of lists. This function is mainly used with complicated -- data structures or a state-transforming monad. mapAndUnzipM :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c]) mapAndUnzipM f xs = sequence (map f xs) >>= return . unzip -- | The 'zipWithM' function generalizes 'zipWith' to arbitrary monads. zipWithM :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c] zipWithM f xs ys = sequence (zipWith f xs ys) -- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result. zipWithM_ :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m () zipWithM_ f xs ys = sequence_ (zipWith f xs ys) {- | The 'foldM' function is analogous to 'foldl', except that its result is encapsulated in a monad. Note that 'foldM' works from left-to-right over the list arguments. This could be an issue where '(>>)' and the `folded function' are not commutative. > foldM f a1 [x1, x2, ..., xm ] == > do > a2 <- f a1 x1 > a3 <- f a2 x2 > ... > f am xm If right-to-left evaluation is required, the input list should be reversed. -} foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a foldM _ a [] = return a foldM f a (x:xs) = f a x >>= \fax -> foldM f fax xs -- | Like 'foldM', but discards the result. foldM_ :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m () foldM_ f a xs = foldM f a xs >> return () -- | @'replicateM' n act@ performs the action @n@ times, -- gathering the results. replicateM :: (Monad m) => Int -> m a -> m [a] replicateM n x = sequence (replicate n x) -- | Like 'replicateM', but discards the result. replicateM_ :: (Monad m) => Int -> m a -> m () replicateM_ n x = sequence_ (replicate n x) {- | Conditional execution of monadic expressions. For example, > when debug (putStr "Debugging\n") will output the string @Debugging\\n@ if the Boolean value @debug@ is 'True', and otherwise do nothing. -} when :: (Monad m) => Bool -> m () -> m () when p s = if p then s else return () -- | The reverse of 'when'. unless :: (Monad m) => Bool -> m () -> m () unless p s = if p then return () else s -- | Promote a function to a monad. liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r liftM f m1 = do { x1 <- m1; return (f x1) } -- | Promote a function to a monad, scanning the monadic arguments from -- left to right. For example, -- -- > liftM2 (+) [0,1] [0,2] = [0,2,1,3] -- > liftM2 (+) (Just 1) Nothing = Nothing -- liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) } -- | Promote a function to a monad, scanning the monadic arguments from -- left to right (cf. 'liftM2'). liftM3 :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) } -- | Promote a function to a monad, scanning the monadic arguments from -- left to right (cf. 'liftM2'). liftM4 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) } -- | Promote a function to a monad, scanning the monadic arguments from -- left to right (cf. 'liftM2'). liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) } {- | In many situations, the 'liftM' operations can be replaced by uses of 'ap', which promotes function application. > return f `ap` x1 `ap` ... `ap` xn is equivalent to > liftMn f x1 x2 ... xn -} ap :: (Monad m) => m (a -> b) -> m a -> m b ap = liftM2 id {- $naming The functions in this library use the following naming conventions: * A postfix \'@M@\' always stands for a function in the Kleisli category: The monad type constructor @m@ is added to function results (modulo currying) and nowhere else. So, for example, > filter :: (a -> Bool) -> [a] -> [a] > filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a] * A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@. Thus, for example: > sequence :: Monad m => [m a] -> m [a] > sequence_ :: Monad m => [m a] -> m () * A prefix \'@m@\' generalizes an existing function to a monadic form. Thus, for example: > sum :: Num a => [a] -> a > msum :: MonadPlus m => [m a] -> m a -} hugs98-plus-Sep2006/packages/base/Control/Parallel.hs0000644006511100651110000000555510504340226021171 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Parallel -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable -- -- Parallel Constructs -- ----------------------------------------------------------------------------- module Control.Parallel ( par, seq -- re-exported #if defined(__GRANSIM__) , parGlobal, parLocal, parAt, parAtAbs, parAtRel, parAtForNow #endif ) where import Prelude #ifdef __GLASGOW_HASKELL__ import qualified GHC.Conc ( par ) #endif #if defined(__GRANSIM__) import PrelBase import PrelErr ( parError ) import PrelGHC ( parGlobal#, parLocal#, parAt#, parAtAbs#, parAtRel#, parAtForNow# ) {-# INLINE parGlobal #-} {-# INLINE parLocal #-} {-# INLINE parAt #-} {-# INLINE parAtAbs #-} {-# INLINE parAtRel #-} {-# INLINE parAtForNow #-} parGlobal :: Int -> Int -> Int -> Int -> a -> b -> b parLocal :: Int -> Int -> Int -> Int -> a -> b -> b parAt :: Int -> Int -> Int -> Int -> a -> b -> c -> c parAtAbs :: Int -> Int -> Int -> Int -> Int -> a -> b -> b parAtRel :: Int -> Int -> Int -> Int -> Int -> a -> b -> b parAtForNow :: Int -> Int -> Int -> Int -> a -> b -> c -> c parGlobal (I# w) (I# g) (I# s) (I# p) x y = case (parGlobal# x w g s p y) of { 0# -> parError; _ -> y } parLocal (I# w) (I# g) (I# s) (I# p) x y = case (parLocal# x w g s p y) of { 0# -> parError; _ -> y } parAt (I# w) (I# g) (I# s) (I# p) v x y = case (parAt# x v w g s p y) of { 0# -> parError; _ -> y } parAtAbs (I# w) (I# g) (I# s) (I# p) (I# q) x y = case (parAtAbs# x q w g s p y) of { 0# -> parError; _ -> y } parAtRel (I# w) (I# g) (I# s) (I# p) (I# q) x y = case (parAtRel# x q w g s p y) of { 0# -> parError; _ -> y } parAtForNow (I# w) (I# g) (I# s) (I# p) v x y = case (parAtForNow# x v w g s p y) of { 0# -> parError; _ -> y } #endif -- Maybe parIO and the like could be added here later. -- | Indicates that it may be beneficial to evaluate the first -- argument in parallel with the second. Returns the value of the -- second argument. -- -- @a `par` b@ is exactly equivalent semantically to @b@. -- -- @par@ is generally used when the value of @a@ is likely to be -- required later, but not immediately. Also it is a good idea to -- ensure that @a@ is not a trivial computation, otherwise the cost of -- spawning it in parallel overshadows the benefits obtained by -- running it in parallel. -- -- Note that actual parallelism is only supported by certain -- implementations (GHC with the @-threaded@ option, and GPH, for -- now). On other implementations, @par a b = b@. -- par :: a -> b -> b #ifdef __GLASGOW_HASKELL__ par = GHC.Conc.par #else -- For now, Hugs does not support par properly. par a b = b #endif hugs98-plus-Sep2006/packages/base/Data/0000755006511100651110000000000010504340226016320 5ustar rossrosshugs98-plus-Sep2006/packages/base/Data/Array/0000755006511100651110000000000010504340225017375 5ustar rossrosshugs98-plus-Sep2006/packages/base/Data/Array/IO/0000755006511100651110000000000010504340225017704 5ustar rossrosshugs98-plus-Sep2006/packages/base/Data/Array/IO/Internals.hs0000644006511100651110000002714210504340225022205 0ustar rossross{-# OPTIONS_GHC -#include "HsBase.h" #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Array.IO.Internal -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Array.Base) -- -- Mutable boxed and unboxed arrays in the IO monad. -- ----------------------------------------------------------------------------- -- #hide module Data.Array.IO.Internals ( IOArray(..), -- instance of: Eq, Typeable IOUArray(..), -- instance of: Eq, Typeable castIOUArray, -- :: IOUArray ix a -> IO (IOUArray ix b) ) where import Prelude import Data.Array.MArray import Data.Int import Data.Word import Data.Typeable #ifdef __HUGS__ import Hugs.IOArray #endif import Control.Monad.ST ( RealWorld, stToIO ) import Foreign.Ptr ( Ptr, FunPtr ) import Foreign.StablePtr ( StablePtr ) import Data.Array.Base #ifdef __GLASGOW_HASKELL__ import GHC.IOBase import GHC.Base #endif /* __GLASGOW_HASKELL__ */ #include "Typeable.h" INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray") ----------------------------------------------------------------------------- -- | Instance declarations for 'IOArray's instance MArray IOArray e IO where #if defined(__HUGS__) getBounds = return . boundsIOArray #elif defined(__GLASGOW_HASKELL__) {-# INLINE getBounds #-} getBounds (IOArray marr) = stToIO $ getBounds marr #endif newArray = newIOArray unsafeRead = unsafeReadIOArray unsafeWrite = unsafeWriteIOArray ----------------------------------------------------------------------------- -- Flat unboxed mutable arrays (IO monad) -- | Mutable, unboxed, strict arrays in the 'IO' monad. The type -- arguments are as follows: -- -- * @i@: the index type of the array (should be an instance of 'Ix') -- -- * @e@: the element type of the array. Only certain element types -- are supported: see "Data.Array.MArray" for a list of instances. -- newtype IOUArray i e = IOUArray (STUArray RealWorld i e) INSTANCE_TYPEABLE2(IOUArray,iOUArrayTc,"IOUArray") instance MArray IOUArray Bool IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Char IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Int IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Word IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray (Ptr a) IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray (FunPtr a) IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Float IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Double IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray (StablePtr a) IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Int8 IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Int16 IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Int32 IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Int64 IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Word8 IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Word16 IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Word32 IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) instance MArray IOUArray Word64 IO where {-# INLINE getBounds #-} getBounds (IOUArray arr) = stToIO $ getBounds arr {-# INLINE newArray #-} newArray lu init = stToIO $ do marr <- newArray lu init; return (IOUArray marr) {-# INLINE newArray_ #-} newArray_ lu = stToIO $ do marr <- newArray_ lu; return (IOUArray marr) {-# INLINE unsafeRead #-} unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) -- | Casts an 'IOUArray' with one element type into one with a -- different element type. All the elements of the resulting array -- are undefined (unless you know what you\'re doing...). castIOUArray :: IOUArray ix a -> IO (IOUArray ix b) castIOUArray (IOUArray marr) = stToIO $ do marr' <- castSTUArray marr return (IOUArray marr') hugs98-plus-Sep2006/packages/base/Data/Array/Base.hs0000644006511100651110000017525010504340225020615 0ustar rossross{-# OPTIONS_GHC -fno-bang-patterns #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Array.Base -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (MPTCs, uses Control.Monad.ST) -- -- Basis for IArray and MArray. Not intended for external consumption; -- use IArray or MArray instead. -- ----------------------------------------------------------------------------- -- #hide module Data.Array.Base where import Prelude import Control.Monad.ST.Lazy ( strictToLazyST ) import qualified Control.Monad.ST.Lazy as Lazy (ST) import Data.Ix ( Ix, range, index, rangeSize ) import Data.Int import Data.Word import Foreign.Ptr import Foreign.StablePtr #ifdef __GLASGOW_HASKELL__ import GHC.Arr ( STArray, unsafeIndex ) import qualified GHC.Arr as Arr import qualified GHC.Arr as ArrST import GHC.ST ( ST(..), runST ) import GHC.Base import GHC.Word ( Word(..) ) import GHC.Ptr ( Ptr(..), FunPtr(..), nullPtr, nullFunPtr ) import GHC.Float ( Float(..), Double(..) ) import GHC.Stable ( StablePtr(..) ) import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) ) import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) ) #endif #ifdef __HUGS__ import Data.Bits import Foreign.Storable import qualified Hugs.Array as Arr import qualified Hugs.ST as ArrST import Hugs.Array ( unsafeIndex ) import Hugs.ST ( STArray, ST(..), runST ) import Hugs.ByteArray #endif import Data.Typeable #include "Typeable.h" #include "MachDeps.h" ----------------------------------------------------------------------------- -- Class of immutable arrays {- | Class of immutable array types. An array type has the form @(a i e)@ where @a@ is the array type constructor (kind @* -> * -> *@), @i@ is the index type (a member of the class 'Ix'), and @e@ is the element type. The @IArray@ class is parameterised over both @a@ and @e@, so that instances specialised to certain element types can be defined. -} class IArray a e where -- | Extracts the bounds of an immutable array bounds :: Ix i => a i e -> (i,i) unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> a i e unsafeAt :: Ix i => a i e -> Int -> e unsafeReplace :: Ix i => a i e -> [(Int, e)] -> a i e unsafeAccum :: Ix i => (e -> e' -> e) -> a i e -> [(Int, e')] -> a i e unsafeAccumArray :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> a i e unsafeReplace arr ies = runST (unsafeReplaceST arr ies >>= unsafeFreeze) unsafeAccum f arr ies = runST (unsafeAccumST f arr ies >>= unsafeFreeze) unsafeAccumArray f e lu ies = runST (unsafeAccumArrayST f e lu ies >>= unsafeFreeze) {-# INLINE unsafeReplaceST #-} unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e) unsafeReplaceST arr ies = do marr <- thaw arr sequence_ [unsafeWrite marr i e | (i, e) <- ies] return marr {-# INLINE unsafeAccumST #-} unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e) unsafeAccumST f arr ies = do marr <- thaw arr sequence_ [do old <- unsafeRead marr i unsafeWrite marr i (f old new) | (i, new) <- ies] return marr {-# INLINE unsafeAccumArrayST #-} unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e) unsafeAccumArrayST f e (l,u) ies = do marr <- newArray (l,u) e sequence_ [do old <- unsafeRead marr i unsafeWrite marr i (f old new) | (i, new) <- ies] return marr {-# INLINE array #-} {-| Constructs an immutable array from a pair of bounds and a list of initial associations. The bounds are specified as a pair of the lowest and highest bounds in the array respectively. For example, a one-origin vector of length 10 has bounds (1,10), and a one-origin 10 by 10 matrix has bounds ((1,1),(10,10)). An association is a pair of the form @(i,x)@, which defines the value of the array at index @i@ to be @x@. The array is undefined if any index in the list is out of bounds. If any two associations in the list have the same index, the value at that index is implementation-dependent. (In GHC, the last value specified for that index is used. Other implementations will also do this for unboxed arrays, but Haskell 98 requires that for 'Array' the value at such indices is bottom.) Because the indices must be checked for these errors, 'array' is strict in the bounds argument and in the indices of the association list. Whether @array@ is strict or non-strict in the elements depends on the array type: 'Data.Array.Array' is a non-strict array type, but all of the 'Data.Array.Unboxed.UArray' arrays are strict. Thus in a non-strict array, recurrences such as the following are possible: > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i \<- [2..100]]) Not every index within the bounds of the array need appear in the association list, but the values associated with indices that do not appear will be undefined. If, in any dimension, the lower bound is greater than the upper bound, then the array is legal, but empty. Indexing an empty array always gives an array-bounds error, but 'bounds' still yields the bounds with which the array was constructed. -} array :: (IArray a e, Ix i) => (i,i) -- ^ bounds of the array: (lowest,highest) -> [(i, e)] -- ^ list of associations -> a i e array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies] -- Since unsafeFreeze is not guaranteed to be only a cast, we will -- use unsafeArray and zip instead of a specialized loop to implement -- listArray, unlike Array.listArray, even though it generates some -- unnecessary heap allocation. Will use the loop only when we have -- fast unsafeFreeze, namely for Array and UArray (well, they cover -- almost all cases). {-# INLINE listArray #-} -- | Constructs an immutable array from a list of initial elements. -- The list gives the elements of the array in ascending order -- beginning with the lowest index. listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es) {-# INLINE listArrayST #-} listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e) listArrayST (l,u) es = do marr <- newArray_ (l,u) let n = rangeSize (l,u) let fillFromList i xs | i == n = return () | otherwise = case xs of [] -> return () y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys fillFromList 0 es return marr {-# RULES "listArray/Array" listArray = \lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray) #-} {-# INLINE listUArrayST #-} listUArrayST :: (MArray (STUArray s) e (ST s), Ix i) => (i,i) -> [e] -> ST s (STUArray s i e) listUArrayST (l,u) es = do marr <- newArray_ (l,u) let n = rangeSize (l,u) let fillFromList i xs | i == n = return () | otherwise = case xs of [] -> return () y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys fillFromList 0 es return marr -- I don't know how to write a single rule for listUArrayST, because -- the type looks like constrained over 's', which runST doesn't -- like. In fact all MArray (STUArray s) instances are polymorphic -- wrt. 's', but runST can't know that. -- -- More precisely, we'd like to write this: -- listUArray :: (forall s. MArray (STUArray s) e (ST s), Ix i) -- => (i,i) -> [e] -> UArray i e -- listUArray lu = runST (listUArrayST lu es >>= unsafeFreezeSTUArray) -- {-# RULES listArray = listUArray -- Then we could call listUArray at any type 'e' that had a suitable -- MArray instance. But sadly we can't, because we don't have quantified -- constraints. Hence the mass of rules below. -- I would like also to write a rule for listUArrayST (or listArray or -- whatever) applied to unpackCString#. Unfortunately unpackCString# -- calls seem to be floated out, then floated back into the middle -- of listUArrayST, so I was not able to do this. #ifdef __GLASGOW_HASKELL__ type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e {-# RULES "listArray/UArray/Bool" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Bool "listArray/UArray/Char" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Char "listArray/UArray/Int" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int "listArray/UArray/Word" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word "listArray/UArray/Ptr" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (Ptr a) "listArray/UArray/FunPtr" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (FunPtr a) "listArray/UArray/Float" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Float "listArray/UArray/Double" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Double "listArray/UArray/StablePtr" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (StablePtr a) "listArray/UArray/Int8" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int8 "listArray/UArray/Int16" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int16 "listArray/UArray/Int32" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int32 "listArray/UArray/Int64" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int64 "listArray/UArray/Word8" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word8 "listArray/UArray/Word16" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word16 "listArray/UArray/Word32" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word32 "listArray/UArray/Word64" listArray = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word64 #-} #endif {-# INLINE (!) #-} -- | Returns the element of an immutable array at the specified index. (!) :: (IArray a e, Ix i) => a i e -> i -> e arr ! i = case bounds arr of (l,u) -> unsafeAt arr (index (l,u) i) {-# INLINE indices #-} -- | Returns a list of all the valid indices in an array. indices :: (IArray a e, Ix i) => a i e -> [i] indices arr = case bounds arr of (l,u) -> range (l,u) {-# INLINE elems #-} -- | Returns a list of all the elements of an array, in the same order -- as their indices. elems :: (IArray a e, Ix i) => a i e -> [e] elems arr = case bounds arr of (l,u) -> [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]] {-# INLINE assocs #-} -- | Returns the contents of an array as a list of associations. assocs :: (IArray a e, Ix i) => a i e -> [(i, e)] assocs arr = case bounds arr of (l,u) -> [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)] {-# INLINE accumArray #-} {-| Constructs an immutable array from a list of associations. Unlike 'array', the same index is allowed to occur multiple times in the list of associations; an /accumulating function/ is used to combine the values of elements with the same index. For example, given a list of values of some index type, hist produces a histogram of the number of occurrences of each index within a specified range: > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i\<-is, inRange bnds i] -} accumArray :: (IArray a e, Ix i) => (e -> e' -> e) -- ^ An accumulating function -> e -- ^ A default element -> (i,i) -- ^ The bounds of the array -> [(i, e')] -- ^ List of associations -> a i e -- ^ Returns: the array accumArray f init (l,u) ies = unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE (//) #-} {-| Takes an array and a list of pairs and returns an array identical to the left argument except that it has been updated by the associations in the right argument. For example, if m is a 1-origin, n by n matrix, then @m\/\/[((i,i), 0) | i \<- [1..n]]@ is the same matrix, except with the diagonal zeroed. As with the 'array' function, if any two associations in the list have the same index, the value at that index is implementation-dependent. (In GHC, the last value specified for that index is used. Other implementations will also do this for unboxed arrays, but Haskell 98 requires that for 'Array' the value at such indices is bottom.) For most array types, this operation is O(/n/) where /n/ is the size of the array. However, the 'Data.Array.Diff.DiffArray' type provides this operation with complexity linear in the number of updates. -} (//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e arr // ies = case bounds arr of (l,u) -> unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE accum #-} {-| @accum f@ takes an array and an association list and accumulates pairs from the list into the array with the accumulating function @f@. Thus 'accumArray' can be defined using 'accum': > accumArray f z b = accum f (array b [(i, z) | i \<- range b]) -} accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e accum f arr ies = case bounds arr of (l,u) -> unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE amap #-} -- | Returns a new array derived from the original array by applying a -- function to each of the elements. amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e amap f arr = case bounds arr of (l,u) -> unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]] {-# INLINE ixmap #-} -- | Returns a new array derived from the original array by applying a -- function to each of the indices. ixmap :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e ixmap (l,u) f arr = unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)] ----------------------------------------------------------------------------- -- Normal polymorphic arrays instance IArray Arr.Array e where {-# INLINE bounds #-} bounds = Arr.bounds {-# INLINE unsafeArray #-} unsafeArray = Arr.unsafeArray {-# INLINE unsafeAt #-} unsafeAt = Arr.unsafeAt {-# INLINE unsafeReplace #-} unsafeReplace = Arr.unsafeReplace {-# INLINE unsafeAccum #-} unsafeAccum = Arr.unsafeAccum {-# INLINE unsafeAccumArray #-} unsafeAccumArray = Arr.unsafeAccumArray ----------------------------------------------------------------------------- -- Flat unboxed arrays -- | Arrays with unboxed elements. Instances of 'IArray' are provided -- for 'UArray' with certain element types ('Int', 'Float', 'Char', -- etc.; see the 'UArray' class for a full list). -- -- A 'UArray' will generally be more efficient (in terms of both time -- and space) than the equivalent 'Data.Array.Array' with the same -- element type. However, 'UArray' is strict in its elements - so -- don\'t use 'UArray' if you require the non-strictness that -- 'Data.Array.Array' provides. -- -- Because the @IArray@ interface provides operations overloaded on -- the type of the array, it should be possible to just change the -- array type being used by a program from say @Array@ to @UArray@ to -- get the benefits of unboxed arrays (don\'t forget to import -- "Data.Array.Unboxed" instead of "Data.Array"). -- #ifdef __GLASGOW_HASKELL__ data UArray i e = UArray !i !i ByteArray# #endif #ifdef __HUGS__ data UArray i e = UArray !i !i !ByteArray #endif INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray") {-# INLINE unsafeArrayUArray #-} unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i) => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e) unsafeArrayUArray (l,u) ies default_elem = do marr <- newArray (l,u) default_elem sequence_ [unsafeWrite marr i e | (i, e) <- ies] unsafeFreezeSTUArray marr #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeFreezeSTUArray #-} unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e) unsafeFreezeSTUArray (STUArray l u marr#) = ST $ \s1# -> case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) -> (# s2#, UArray l u arr# #) } #endif #ifdef __HUGS__ unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e) unsafeFreezeSTUArray (STUArray l u marr) = do arr <- unsafeFreezeMutableByteArray marr return (UArray l u arr) #endif {-# INLINE unsafeReplaceUArray #-} unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i) => UArray i e -> [(Int, e)] -> ST s (UArray i e) unsafeReplaceUArray arr ies = do marr <- thawSTUArray arr sequence_ [unsafeWrite marr i e | (i, e) <- ies] unsafeFreezeSTUArray marr {-# INLINE unsafeAccumUArray #-} unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i) => (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e) unsafeAccumUArray f arr ies = do marr <- thawSTUArray arr sequence_ [do old <- unsafeRead marr i unsafeWrite marr i (f old new) | (i, new) <- ies] unsafeFreezeSTUArray marr {-# INLINE unsafeAccumArrayUArray #-} unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i) => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e) unsafeAccumArrayUArray f init (l,u) ies = do marr <- newArray (l,u) init sequence_ [do old <- unsafeRead marr i unsafeWrite marr i (f old new) | (i, new) <- ies] unsafeFreezeSTUArray marr {-# INLINE eqUArray #-} eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool eqUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) = if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else l1 == l2 && u1 == u2 && and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]] {-# INLINE cmpUArray #-} cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2) {-# INLINE cmpIntUArray #-} cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering cmpIntUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) = if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else if rangeSize (l2,u2) == 0 then GT else case compare l1 l2 of EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1] other -> other where cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of EQ -> rest other -> other {-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-} ----------------------------------------------------------------------------- -- Showing IArrays {-# SPECIALISE showsIArray :: (IArray UArray e, Ix i, Show i, Show e) => Int -> UArray i e -> ShowS #-} showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS showsIArray p a = showParen (p > 9) $ showString "array " . shows (bounds a) . showChar ' ' . shows (assocs a) ----------------------------------------------------------------------------- -- Flat unboxed arrays: instances #ifdef __HUGS__ unsafeAtBArray :: Storable e => UArray i e -> Int -> e unsafeAtBArray (UArray _ _ arr) = readByteArray arr #endif instance IArray UArray Bool where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies False) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = (indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #endif #ifdef __HUGS__ unsafeAt (UArray _ _ arr) i = testBit (readByteArray arr (bOOL_INDEX i)::BitSet) (bOOL_SUBINDEX i) #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Char where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0') {-# INLINE unsafeAt #-} #ifdef __GLASGOW_HASKELL__ unsafeAt (UArray _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Int where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Word where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray (Ptr a) where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr) {-# INLINE unsafeAt #-} #ifdef __GLASGOW_HASKELL__ unsafeAt (UArray _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray (FunPtr a) where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Float where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Double where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray (StablePtr a) where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) -- bogus StablePtr value for initialising a UArray of StablePtr. #ifdef __GLASGOW_HASKELL__ nullStablePtr = StablePtr (unsafeCoerce# 0#) #endif #ifdef __HUGS__ nullStablePtr = castPtrToStablePtr nullPtr #endif instance IArray UArray Int8 where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Int16 where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Int32 where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Int64 where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Word8 where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Word16 where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Word32 where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance IArray UArray Word64 where {-# INLINE bounds #-} bounds (UArray l u _) = (l,u) {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeAt #-} unsafeAt (UArray _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#) #endif #ifdef __HUGS__ unsafeAt = unsafeAtBArray #endif {-# INLINE unsafeReplace #-} unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where (==) = eqUArray instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where compare = cmpUArray instance (Ix ix, Show ix, Show e, IArray UArray e) => Show (UArray ix e) where showsPrec = showsIArray ----------------------------------------------------------------------------- -- Mutable arrays {-# NOINLINE arrEleBottom #-} arrEleBottom :: a arrEleBottom = error "MArray: undefined array element" {-| Class of mutable array types. An array type has the form @(a i e)@ where @a@ is the array type constructor (kind @* -> * -> *@), @i@ is the index type (a member of the class 'Ix'), and @e@ is the element type. The @MArray@ class is parameterised over both @a@ and @e@ (so that instances specialised to certain element types can be defined, in the same way as for 'IArray'), and also over the type of the monad, @m@, in which the mutable array will be manipulated. -} class (Monad m) => MArray a e m where -- | Returns the bounds of the array getBounds :: Ix i => a i e -> m (i,i) -- | Builds a new array, with every element initialised to the supplied -- value. newArray :: Ix i => (i,i) -> e -> m (a i e) -- | Builds a new array, with every element initialised to undefined. newArray_ :: Ix i => (i,i) -> m (a i e) unsafeRead :: Ix i => a i e -> Int -> m e unsafeWrite :: Ix i => a i e -> Int -> e -> m () {-# INLINE newArray #-} -- The INLINE is crucial, because until we know at least which monad -- we are in, the code below allocates like crazy. So inline it, -- in the hope that the context will know the monad. newArray (l,u) init = do marr <- newArray_ (l,u) sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]] return marr newArray_ (l,u) = newArray (l,u) arrEleBottom -- newArray takes an initialiser which all elements of -- the newly created array are initialised to. newArray_ takes -- no initialiser, it is assumed that the array is initialised with -- "undefined" values. -- why not omit newArray_? Because in the unboxed array case we would -- like to omit the initialisation altogether if possible. We can't do -- this for boxed arrays, because the elements must all have valid values -- at all times in case of garbage collection. -- why not omit newArray? Because in the boxed case, we can omit the -- default initialisation with undefined values if we *do* know the -- initial value and it is constant for all elements. {-# INLINE newListArray #-} -- | Constructs a mutable array from a list of initial elements. -- The list gives the elements of the array in ascending order -- beginning with the lowest index. newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e) newListArray (l,u) es = do marr <- newArray_ (l,u) let n = rangeSize (l,u) let fillFromList i xs | i == n = return () | otherwise = case xs of [] -> return () y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys fillFromList 0 es return marr {-# INLINE readArray #-} -- | Read an element from a mutable array readArray :: (MArray a e m, Ix i) => a i e -> i -> m e readArray marr i = do (l,u) <- getBounds marr unsafeRead marr (index (l,u) i) {-# INLINE writeArray #-} -- | Write an element in a mutable array writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m () writeArray marr i e = do (l,u) <- getBounds marr unsafeWrite marr (index (l,u) i) e {-# INLINE getElems #-} -- | Return a list of all the elements of a mutable array getElems :: (MArray a e m, Ix i) => a i e -> m [e] getElems marr = do (l,u) <- getBounds marr sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]] {-# INLINE getAssocs #-} -- | Return a list of all the associations of a mutable array, in -- index order. getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)] getAssocs marr = do (l,u) <- getBounds marr sequence [ do e <- unsafeRead marr (index (l,u) i); return (i,e) | i <- range (l,u)] {-# INLINE mapArray #-} -- | Constructs a new array derived from the original array by applying a -- function to each of the elements. mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e) mapArray f marr = do (l,u) <- getBounds marr marr' <- newArray_ (l,u) sequence_ [do e <- unsafeRead marr i unsafeWrite marr' i (f e) | i <- [0 .. rangeSize (l,u) - 1]] return marr' {-# INLINE mapIndices #-} -- | Constructs a new array derived from the original array by applying a -- function to each of the indices. mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e) mapIndices (l,u) f marr = do marr' <- newArray_ (l,u) sequence_ [do e <- readArray marr (f i) unsafeWrite marr' (unsafeIndex (l,u) i) e | i <- range (l,u)] return marr' ----------------------------------------------------------------------------- -- Polymorphic non-strict mutable arrays (ST monad) instance MArray (STArray s) e (ST s) where {-# INLINE getBounds #-} getBounds arr = return $! ArrST.boundsSTArray arr {-# INLINE newArray #-} newArray = ArrST.newSTArray {-# INLINE unsafeRead #-} unsafeRead = ArrST.unsafeReadSTArray {-# INLINE unsafeWrite #-} unsafeWrite = ArrST.unsafeWriteSTArray instance MArray (STArray s) e (Lazy.ST s) where {-# INLINE getBounds #-} getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr) {-# INLINE newArray #-} newArray (l,u) e = strictToLazyST (ArrST.newSTArray (l,u) e) {-# INLINE unsafeRead #-} unsafeRead arr i = strictToLazyST (ArrST.unsafeReadSTArray arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e) #ifdef __HUGS__ INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray") #endif ----------------------------------------------------------------------------- -- Flat unboxed mutable arrays (ST monad) -- | A mutable array with unboxed elements, that can be manipulated in -- the 'ST' monad. The type arguments are as follows: -- -- * @s@: the state variable argument for the 'ST' type -- -- * @i@: the index type of the array (should be an instance of @Ix@) -- -- * @e@: the element type of the array. Only certain element types -- are supported. -- -- An 'STUArray' will generally be more efficient (in terms of both time -- and space) than the equivalent boxed version ('STArray') with the same -- element type. However, 'STUArray' is strict in its elements - so -- don\'t use 'STUArray' if you require the non-strictness that -- 'STArray' provides. #ifdef __GLASGOW_HASKELL__ data STUArray s i a = STUArray !i !i (MutableByteArray# s) #endif #ifdef __HUGS__ data STUArray s i a = STUArray !i !i !(MutableByteArray s) #endif INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray") #ifdef __GLASGOW_HASKELL__ instance MArray (STUArray s) Bool (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray #-} newArray (l,u) init = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) -> case bOOL_WORD_SCALE n# of { n'# -> let loop i# s3# | i# ==# n'# = s3# | otherwise = case writeWordArray# marr# i# e# s3# of { s4# -> loop (i# +# 1#) s4# } in case loop 0# s2# of { s3# -> (# s3#, STUArray l u marr# #) }}}} where W# e# = if init then maxBound else 0 {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) -> (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# -> case bOOL_INDEX i# of { j# -> case readWordArray# marr# j# s1# of { (# s2#, old# #) -> case if e then old# `or#` bOOL_BIT i# else old# `and#` bOOL_NOT_BIT i# of { e# -> case writeWordArray# marr# j# e# s2# of { s3# -> (# s3#, () #) }}}} instance MArray (STUArray s) Char (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readWideCharArray# marr# i# s1# of { (# s2#, e# #) -> (# s2#, C# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# -> case writeWideCharArray# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Int (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readIntArray# marr# i# s1# of { (# s2#, e# #) -> (# s2#, I# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# -> case writeIntArray# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Word (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readWordArray# marr# i# s1# of { (# s2#, e# #) -> (# s2#, W# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# -> case writeWordArray# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) (Ptr a) (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readAddrArray# marr# i# s1# of { (# s2#, e# #) -> (# s2#, Ptr e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# -> case writeAddrArray# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) (FunPtr a) (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readAddrArray# marr# i# s1# of { (# s2#, e# #) -> (# s2#, FunPtr e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# -> case writeAddrArray# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Float (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readFloatArray# marr# i# s1# of { (# s2#, e# #) -> (# s2#, F# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# -> case writeFloatArray# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Double (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readDoubleArray# marr# i# s1# of { (# s2#, e# #) -> (# s2#, D# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# -> case writeDoubleArray# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) (StablePtr a) (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) -> (# s2# , StablePtr e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# -> case writeStablePtrArray# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Int8 (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# n# s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readInt8Array# marr# i# s1# of { (# s2#, e# #) -> (# s2#, I8# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# -> case writeInt8Array# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Int16 (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readInt16Array# marr# i# s1# of { (# s2#, e# #) -> (# s2#, I16# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# -> case writeInt16Array# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Int32 (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readInt32Array# marr# i# s1# of { (# s2#, e# #) -> (# s2#, I32# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# -> case writeInt32Array# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Int64 (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readInt64Array# marr# i# s1# of { (# s2#, e# #) -> (# s2#, I64# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# -> case writeInt64Array# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Word8 (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# n# s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readWord8Array# marr# i# s1# of { (# s2#, e# #) -> (# s2#, W8# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# -> case writeWord8Array# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Word16 (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readWord16Array# marr# i# s1# of { (# s2#, e# #) -> (# s2#, W16# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# -> case writeWord16Array# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Word32 (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readWord32Array# marr# i# s1# of { (# s2#, e# #) -> (# s2#, W32# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# -> case writeWord32Array# marr# i# e# s1# of { s2# -> (# s2#, () #) } instance MArray (STUArray s) Word64 (ST s) where {-# INLINE getBounds #-} getBounds (STUArray l u _) = return (l,u) {-# INLINE newArray_ #-} newArray_ (l,u) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) -> (# s2#, STUArray l u marr# #) }} {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> case readWord64Array# marr# i# s1# of { (# s2#, e# #) -> (# s2#, W64# e# #) } {-# INLINE unsafeWrite #-} unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# -> case writeWord64Array# marr# i# e# s1# of { s2# -> (# s2#, () #) } ----------------------------------------------------------------------------- -- Translation between elements and bytes bOOL_SCALE, bOOL_WORD_SCALE, wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int# bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3# where I# last# = SIZEOF_HSWORD * 8 - 1 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#) where I# last# = SIZEOF_HSWORD * 8 - 1 wORD_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSWORD dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE fLOAT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT bOOL_INDEX :: Int# -> Int# #if SIZEOF_HSWORD == 4 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5# #elif SIZEOF_HSWORD == 8 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6# #endif bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word# bOOL_BIT n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#)) where W# mask# = SIZEOF_HSWORD * 8 - 1 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound #endif /* __GLASGOW_HASKELL__ */ #ifdef __HUGS__ newMBArray_ :: (Ix i, Storable e) => (i,i) -> ST s (STUArray s i e) newMBArray_ = makeArray undefined where makeArray :: (Ix i, Storable e) => e -> (i,i) -> ST s (STUArray s i e) makeArray dummy (l,u) = do marr <- newMutableByteArray (rangeSize (l,u) * sizeOf dummy) return (STUArray l u marr) unsafeReadMBArray :: Storable e => STUArray s i e -> Int -> ST s e unsafeReadMBArray (STUArray _ _ marr) = readMutableByteArray marr unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s () unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray marr getBoundsMBArray (STUArray l u _) = return (l,u) instance MArray (STUArray s) Bool (ST s) where getBounds = getBoundsMBArray newArray_ (l,u) = do marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u))) return (STUArray l u marr) unsafeRead (STUArray _ _ marr) i = do let ix = bOOL_INDEX i bit = bOOL_SUBINDEX i w <- readMutableByteArray marr ix return (testBit (w::BitSet) bit) unsafeWrite (STUArray _ _ marr) i e = do let ix = bOOL_INDEX i bit = bOOL_SUBINDEX i w <- readMutableByteArray marr ix writeMutableByteArray marr ix (if e then setBit (w::BitSet) bit else clearBit w bit) instance MArray (STUArray s) Char (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Int (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Word (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) (Ptr a) (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) (FunPtr a) (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Float (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Double (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) (StablePtr a) (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Int8 (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Int16 (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Int32 (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Int64 (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Word8 (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Word16 (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Word32 (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray instance MArray (STUArray s) Word64 (ST s) where getBounds = getBoundsMBArray newArray_ = newMBArray_ unsafeRead = unsafeReadMBArray unsafeWrite = unsafeWriteMBArray type BitSet = Word8 bitSetSize = bitSize (0::BitSet) bOOL_SCALE :: Int -> Int bOOL_SCALE n = (n + bitSetSize - 1) `div` bitSetSize bOOL_INDEX :: Int -> Int bOOL_INDEX i = i `div` bitSetSize bOOL_SUBINDEX :: Int -> Int bOOL_SUBINDEX i = i `mod` bitSetSize #endif /* __HUGS__ */ ----------------------------------------------------------------------------- -- Freezing -- | Converts a mutable array (any instance of 'MArray') to an -- immutable array (any instance of 'IArray') by taking a complete -- copy of it. freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) freeze marr = do (l,u) <- getBounds marr ies <- sequence [do e <- unsafeRead marr i; return (i,e) | i <- [0 .. rangeSize (l,u) - 1]] return (unsafeArray (l,u) ies) #ifdef __GLASGOW_HASKELL__ freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e) freezeSTUArray (STUArray l u marr#) = ST $ \s1# -> case sizeofMutableByteArray# marr# of { n# -> case newByteArray# n# s1# of { (# s2#, marr'# #) -> case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) -> case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) -> (# s4#, UArray l u arr# #) }}}} {-# RULES "freeze/STArray" freeze = ArrST.freezeSTArray "freeze/STUArray" freeze = freezeSTUArray #-} #endif /* __GLASGOW_HASKELL__ */ -- In-place conversion of mutable arrays to immutable ones places -- a proof obligation on the user: no other parts of your code can -- have a reference to the array at the point where you unsafely -- freeze it (and, subsequently mutate it, I suspect). {- | Converts an mutable array into an immutable array. The implementation may either simply cast the array from one type to the other without copying the array, or it may take a full copy of the array. Note that because the array is possibly not copied, any subsequent modifications made to the mutable version of the array may be shared with the immutable version. It is safe to use, therefore, if the mutable version is never modified after the freeze operation. The non-copying implementation is supported between certain pairs of array types only; one constraint is that the array types must have identical representations. In GHC, The following pairs of array types have a non-copying O(1) implementation of 'unsafeFreeze'. Because the optimised versions are enabled by specialisations, you will need to compile with optimisation (-O) to get them. * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray' * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray' * 'Data.Array.IO.IOArray' -> 'Data.Array.Array' * 'Data.Array.ST.STArray' -> 'Data.Array.Array' -} {-# INLINE unsafeFreeze #-} unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) unsafeFreeze = freeze {-# RULES "unsafeFreeze/STArray" unsafeFreeze = ArrST.unsafeFreezeSTArray "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray #-} ----------------------------------------------------------------------------- -- Thawing -- | Converts an immutable array (any instance of 'IArray') into a -- mutable array (any instance of 'MArray') by taking a complete copy -- of it. thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) thaw arr = case bounds arr of (l,u) -> do marr <- newArray_ (l,u) sequence_ [unsafeWrite marr i (unsafeAt arr i) | i <- [0 .. rangeSize (l,u) - 1]] return marr #ifdef __GLASGOW_HASKELL__ thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e) thawSTUArray (UArray l u arr#) = ST $ \s1# -> case sizeofByteArray# arr# of { n# -> case newByteArray# n# s1# of { (# s2#, marr# #) -> case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) -> (# s3#, STUArray l u marr# #) }}} foreign import ccall unsafe "memcpy" memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO () {-# RULES "thaw/STArray" thaw = ArrST.thawSTArray "thaw/STUArray" thaw = thawSTUArray #-} #endif /* __GLASGOW_HASKELL__ */ #ifdef __HUGS__ thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e) thawSTUArray (UArray l u arr) = do marr <- thawByteArray arr return (STUArray l u marr) #endif -- In-place conversion of immutable arrays to mutable ones places -- a proof obligation on the user: no other parts of your code can -- have a reference to the array at the point where you unsafely -- thaw it (and, subsequently mutate it, I suspect). {- | Converts an immutable array into a mutable array. The implementation may either simply cast the array from one type to the other without copying the array, or it may take a full copy of the array. Note that because the array is possibly not copied, any subsequent modifications made to the mutable version of the array may be shared with the immutable version. It is only safe to use, therefore, if the immutable array is never referenced again in this thread, and there is no possibility that it can be also referenced in another thread. If you use an unsafeThaw/write/unsafeFreeze sequence in a multi-threaded setting, then you must ensure that this sequence is atomic with respect to other threads, or a garbage collector crash may result (because the write may be writing to a frozen array). The non-copying implementation is supported between certain pairs of array types only; one constraint is that the array types must have identical representations. In GHC, The following pairs of array types have a non-copying O(1) implementation of 'unsafeThaw'. Because the optimised versions are enabled by specialisations, you will need to compile with optimisation (-O) to get them. * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray' * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray' * 'Data.Array.Array' -> 'Data.Array.IO.IOArray' * 'Data.Array.Array' -> 'Data.Array.ST.STArray' -} {-# INLINE unsafeThaw #-} unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) unsafeThaw = thaw #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeThawSTUArray #-} unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e) unsafeThawSTUArray (UArray l u marr#) = return (STUArray l u (unsafeCoerce# marr#)) {-# RULES "unsafeThaw/STArray" unsafeThaw = ArrST.unsafeThawSTArray "unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray #-} #endif /* __GLASGOW_HASKELL__ */ -- | Casts an 'STUArray' with one element type into one with a -- different element type. All the elements of the resulting array -- are undefined (unless you know what you\'re doing...). #ifdef __GLASGOW_HASKELL__ castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b) castSTUArray (STUArray l u marr#) = return (STUArray l u marr#) #endif #ifdef __HUGS__ castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b) castSTUArray (STUArray l u marr) = return (STUArray l u marr) #endif hugs98-plus-Sep2006/packages/base/Data/Array/Diff.hs0000644006511100651110000004034110504340225020603 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Array.Diff -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Array.IArray) -- -- Functional arrays with constant-time update. -- ----------------------------------------------------------------------------- module Data.Array.Diff ( -- * Diff array types -- | Diff arrays have an immutable interface, but rely on internal -- updates in place to provide fast functional update operator -- '//'. -- -- When the '//' operator is applied to a diff array, its contents -- are physically updated in place. The old array silently changes -- its representation without changing the visible behavior: -- it stores a link to the new current array along with the -- difference to be applied to get the old contents. -- -- So if a diff array is used in a single-threaded style, -- i.e. after '//' application the old version is no longer used, -- @a'!'i@ takes O(1) time and @a '//' d@ takes O(@length d@). -- Accessing elements of older versions gradually becomes slower. -- -- Updating an array which is not current makes a physical copy. -- The resulting array is unlinked from the old family. So you -- can obtain a version which is guaranteed to be current and -- thus have fast element access by @a '//' []@. -- Possible improvement for the future (not implemented now): -- make it possible to say "I will make an update now, but when -- I later return to the old version, I want it to mutate back -- instead of being copied". IOToDiffArray, -- data IOToDiffArray -- (a :: * -> * -> *) -- internal mutable array -- (i :: *) -- indices -- (e :: *) -- elements -- | Type synonyms for the two most important IO array types. -- Two most important diff array types are fully polymorphic -- lazy boxed DiffArray: DiffArray, -- = IOToDiffArray IOArray -- ...and strict unboxed DiffUArray, working only for elements -- of primitive types but more compact and usually faster: DiffUArray, -- = IOToDiffArray IOUArray -- * Overloaded immutable array interface -- | Module "Data.Array.IArray" provides the interface of diff arrays. -- They are instances of class 'IArray'. module Data.Array.IArray, -- * Low-level interface -- | These are really internal functions, but you will need them -- to make further 'IArray' instances of various diff array types -- (for either more 'MArray' types or more unboxed element types). newDiffArray, readDiffArray, replaceDiffArray ) where ------------------------------------------------------------------------ -- Imports. import Prelude import Data.Ix import Data.Array.Base import Data.Array.IArray import Data.Array.IO import Foreign.Ptr ( Ptr, FunPtr ) import Foreign.StablePtr ( StablePtr ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word, Word8, Word16, Word32, Word64 ) import System.IO.Unsafe ( unsafePerformIO ) import Control.Exception ( evaluate ) import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar ) ------------------------------------------------------------------------ -- Diff array types. -- | An arbitrary 'MArray' type living in the 'IO' monad can be converted -- to a diff array. newtype IOToDiffArray a i e = DiffArray {varDiffArray :: MVar (DiffArrayData a i e)} -- Internal representation: either a mutable array, or a link to -- another diff array patched with a list of index+element pairs. data DiffArrayData a i e = Current (a i e) | Diff (IOToDiffArray a i e) [(Int, e)] -- | Fully polymorphic lazy boxed diff array. type DiffArray = IOToDiffArray IOArray -- | Strict unboxed diff array, working only for elements -- of primitive types but more compact and usually faster than 'DiffArray'. type DiffUArray = IOToDiffArray IOUArray -- Having 'MArray a e IO' in instance context would require -- -fallow-undecidable-instances, so each instance is separate here. ------------------------------------------------------------------------ -- Showing DiffArrays instance (Ix ix, Show ix, Show e) => Show (DiffArray ix e) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Char) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Int) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Word) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Float) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Double) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Int8) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Int16) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Int32) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Int64) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Word8) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Word16) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Word32) where showsPrec = showsIArray instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where showsPrec = showsIArray ------------------------------------------------------------------------ -- Boring instances. instance IArray (IOToDiffArray IOArray) e where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray1` ies instance IArray (IOToDiffArray IOUArray) Char where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Int where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Word where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) (Ptr a) where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) (FunPtr a) where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Float where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Double where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) (StablePtr a) where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Int8 where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Int16 where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Int32 where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Int64 where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Word8 where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Word16 where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Word32 where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies instance IArray (IOToDiffArray IOUArray) Word64 where bounds a = unsafePerformIO $ boundsDiffArray a unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies ------------------------------------------------------------------------ -- The important stuff. newDiffArray :: (MArray a e IO, Ix i) => (i,i) -> [(Int, e)] -> IO (IOToDiffArray a i e) newDiffArray (l,u) ies = do a <- newArray_ (l,u) sequence_ [unsafeWrite a i e | (i, e) <- ies] var <- newMVar (Current a) return (DiffArray var) readDiffArray :: (MArray a e IO, Ix i) => IOToDiffArray a i e -> Int -> IO e a `readDiffArray` i = do d <- readMVar (varDiffArray a) case d of Current a' -> unsafeRead a' i Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies) replaceDiffArray :: (MArray a e IO, Ix i) => IOToDiffArray a i e -> [(Int, e)] -> IO (IOToDiffArray a i e) a `replaceDiffArray` ies = do d <- takeMVar (varDiffArray a) case d of Current a' -> case ies of [] -> do -- We don't do the copy when there is nothing to change -- and this is the current version. But see below. putMVar (varDiffArray a) d return a _:_ -> do diff <- sequence [do e <- unsafeRead a' i; return (i, e) | (i, _) <- ies] sequence_ [unsafeWrite a' i e | (i, e) <- ies] var' <- newMVar (Current a') putMVar (varDiffArray a) (Diff (DiffArray var') diff) return (DiffArray var') Diff _ _ -> do -- We still do the copy when there is nothing to change -- but this is not the current version. So you can use -- 'a // []' to make sure that the resulting array has -- fast element access. putMVar (varDiffArray a) d a' <- thawDiffArray a -- thawDiffArray gives a fresh array which we can -- safely mutate. sequence_ [unsafeWrite a' i e | (i, e) <- ies] var' <- newMVar (Current a') return (DiffArray var') -- The elements of the diff list might recursively reference the -- array, so we must seq them before taking the MVar to avoid -- deadlock. replaceDiffArray1 :: (MArray a e IO, Ix i) => IOToDiffArray a i e -> [(Int, e)] -> IO (IOToDiffArray a i e) a `replaceDiffArray1` ies = do mapM_ (evaluate . fst) ies a `replaceDiffArray` ies -- If the array contains unboxed elements, then the elements of the -- diff list may also recursively reference the array from inside -- replaceDiffArray, so we must seq them too. replaceDiffArray2 :: (MArray a e IO, Ix i) => IOToDiffArray a i e -> [(Int, e)] -> IO (IOToDiffArray a i e) a `replaceDiffArray2` ies = do mapM_ (\(a,b) -> do evaluate a; evaluate b) ies a `replaceDiffArray` ies boundsDiffArray :: (MArray a e IO, Ix ix) => IOToDiffArray a ix e -> IO (ix,ix) boundsDiffArray a = do d <- readMVar (varDiffArray a) case d of Current a' -> getBounds a' Diff a' _ -> boundsDiffArray a' freezeDiffArray :: (MArray a e IO, Ix ix) => a ix e -> IO (IOToDiffArray a ix e) freezeDiffArray a = do (l,u) <- getBounds a a' <- newArray_ (l,u) sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]] var <- newMVar (Current a') return (DiffArray var) {-# RULES "freeze/DiffArray" freeze = freezeDiffArray #-} -- unsafeFreezeDiffArray is really unsafe. Better don't use the old -- array at all after freezing. The contents of the source array will -- be changed when '//' is applied to the resulting array. unsafeFreezeDiffArray :: (MArray a e IO, Ix ix) => a ix e -> IO (IOToDiffArray a ix e) unsafeFreezeDiffArray a = do var <- newMVar (Current a) return (DiffArray var) {-# RULES "unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray #-} thawDiffArray :: (MArray a e IO, Ix ix) => IOToDiffArray a ix e -> IO (a ix e) thawDiffArray a = do d <- readMVar (varDiffArray a) case d of Current a' -> do (l,u) <- getBounds a' a'' <- newArray_ (l,u) sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize (l,u) - 1]] return a'' Diff a' ies -> do a'' <- thawDiffArray a' sequence_ [unsafeWrite a'' i e | (i, e) <- ies] return a'' {-# RULES "thaw/DiffArray" thaw = thawDiffArray #-} -- unsafeThawDiffArray is really unsafe. Better don't use the old -- array at all after thawing. The contents of the resulting array -- will be changed when '//' is applied to the source array. unsafeThawDiffArray :: (MArray a e IO, Ix ix) => IOToDiffArray a ix e -> IO (a ix e) unsafeThawDiffArray a = do d <- readMVar (varDiffArray a) case d of Current a' -> return a' Diff a' ies -> do a'' <- unsafeThawDiffArray a' sequence_ [unsafeWrite a'' i e | (i, e) <- ies] return a'' {-# RULES "unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray #-} hugs98-plus-Sep2006/packages/base/Data/Array/IArray.hs0000644006511100651110000000360410504340225021123 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Array.IArray -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Array.Base) -- -- Immutable arrays, with an overloaded interface. For array types which -- can be used with this interface, see the 'Array' type exported by this -- module, and the "Data.Array.Unboxed" and "Data.Array.Diff" modules. -- ----------------------------------------------------------------------------- module Data.Array.IArray ( -- * Array classes IArray, -- :: (* -> * -> *) -> * -> class module Data.Ix, -- * Immutable non-strict (boxed) arrays Array, -- * Array construction array, -- :: (IArray a e, Ix i) => (i,i) -> [(i, e)] -> a i e listArray, -- :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e accumArray, -- :: (IArray a e, Ix i) => (e -> e' -> e) -> e -> (i,i) -> [(i, e')] -> a i e -- * Accessing arrays (!), -- :: (IArray a e, Ix i) => a i e -> i -> e bounds, -- :: (HasBounds a, Ix i) => a i e -> (i,i) indices, -- :: (HasBounds a, Ix i) => a i e -> [i] elems, -- :: (IArray a e, Ix i) => a i e -> [e] assocs, -- :: (IArray a e, Ix i) => a i e -> [(i, e)] -- * Incremental array updates (//), -- :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e accum, -- :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e -- * Derived arrays amap, -- :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e ixmap, -- :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e ) where import Prelude import Data.Ix import Data.Array (Array) import Data.Array.Base hugs98-plus-Sep2006/packages/base/Data/Array/IO.hs0000644006511100651110000002001010504340225020231 0ustar rossross{-# OPTIONS_GHC -#include "HsBase.h" #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Array.IO -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Array.MArray) -- -- Mutable boxed and unboxed arrays in the IO monad. -- ----------------------------------------------------------------------------- module Data.Array.IO ( -- * @IO@ arrays with boxed elements IOArray, -- instance of: Eq, Typeable -- * @IO@ arrays with unboxed elements IOUArray, -- instance of: Eq, Typeable castIOUArray, -- :: IOUArray i a -> IO (IOUArray i b) -- * Overloaded mutable array interface module Data.Array.MArray, -- * Doing I\/O with @IOUArray@s hGetArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int hPutArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO () ) where import Prelude import Data.Array.Base import Data.Array.IO.Internals import Data.Array ( Array ) import Data.Array.MArray import Data.Int import Data.Word #ifdef __GLASGOW_HASKELL__ import Foreign import Foreign.C import GHC.Arr import GHC.IOBase import GHC.Handle #else import Data.Char import System.IO import System.IO.Error #endif #ifdef __GLASGOW_HASKELL__ ----------------------------------------------------------------------------- -- Freezing freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e) freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr) freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e) freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr) {-# RULES "freeze/IOArray" freeze = freezeIOArray "freeze/IOUArray" freeze = freezeIOUArray #-} {-# INLINE unsafeFreezeIOArray #-} unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e) unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr) {-# INLINE unsafeFreezeIOUArray #-} unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e) unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr) {-# RULES "unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray "unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray #-} ----------------------------------------------------------------------------- -- Thawing thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e) thawIOArray arr = stToIO $ do marr <- thawSTArray arr return (IOArray marr) thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e) thawIOUArray arr = stToIO $ do marr <- thawSTUArray arr return (IOUArray marr) {-# RULES "thaw/IOArray" thaw = thawIOArray "thaw/IOUArray" thaw = thawIOUArray #-} {-# INLINE unsafeThawIOArray #-} unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e) unsafeThawIOArray arr = stToIO $ do marr <- unsafeThawSTArray arr return (IOArray marr) {-# INLINE unsafeThawIOUArray #-} unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e) unsafeThawIOUArray arr = stToIO $ do marr <- unsafeThawSTUArray arr return (IOUArray marr) {-# RULES "unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray #-} -- --------------------------------------------------------------------------- -- hGetArray -- | Reads a number of 'Word8's from the specified 'Handle' directly -- into an array. hGetArray :: Handle -- ^ Handle to read from -> IOUArray Int Word8 -- ^ Array in which to place the values -> Int -- ^ Number of 'Word8's to read -> IO Int -- ^ Returns: the number of 'Word8's actually -- read, which might be smaller than the number requested -- if the end of file was reached. hGetArray handle (IOUArray (STUArray l u ptr)) count | count == 0 = return 0 | count < 0 || count > rangeSize (l,u) = illegalBufferSize handle "hGetArray" count | otherwise = do wantReadableHandle "hGetArray" handle $ \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref if bufferEmpty buf then readChunk fd is_stream ptr 0 count else do let avail = w - r copied <- if (count >= avail) then do memcpy_ba_baoff ptr raw r (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return avail else do memcpy_ba_baoff ptr raw r (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return count let remaining = count - copied if remaining > 0 then do rest <- readChunk fd is_stream ptr copied remaining return (rest + copied) else return count readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int readChunk fd is_stream ptr init_off bytes = loop init_off bytes where loop :: Int -> Int -> IO Int loop off bytes | bytes <= 0 = return (off - init_off) loop off bytes = do r' <- readRawBuffer "readChunk" (fromIntegral fd) is_stream ptr (fromIntegral off) (fromIntegral bytes) let r = fromIntegral r' if r == 0 then return (off - init_off) else loop (off + r) (bytes - r) -- --------------------------------------------------------------------------- -- hPutArray -- | Writes an array of 'Word8' to the specified 'Handle'. hPutArray :: Handle -- ^ Handle to write to -> IOUArray Int Word8 -- ^ Array to write from -> Int -- ^ Number of 'Word8's to write -> IO () hPutArray handle (IOUArray (STUArray l u raw)) count | count == 0 = return () | count < 0 || count > rangeSize (l,u) = illegalBufferSize handle "hPutArray" count | otherwise = do wantWritableHandle "hPutArray" handle $ \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size } <- readIORef ref -- enough room in handle buffer? if (size - w > count) -- There's enough room in the buffer: -- just copy the data in and update bufWPtr. then do memcpy_baoff_ba old_raw w raw (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return () -- else, we have to flush else do flushed_buf <- flushWriteBuffer fd stream old_buf writeIORef ref flushed_buf let this_buf = Buffer{ bufBuf=raw, bufState=WriteBuffer, bufRPtr=0, bufWPtr=count, bufSize=count } flushWriteBuffer fd stream this_buf return () -- --------------------------------------------------------------------------- -- Internal Utils foreign import ccall unsafe "__hscore_memcpy_dst_off" memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_src_off" memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ()) illegalBufferSize :: Handle -> String -> Int -> IO a illegalBufferSize handle fn sz = ioException (IOError (Just handle) InvalidArgument fn ("illegal buffer size " ++ showsPrec 9 (sz::Int) []) Nothing) #else /* !__GLASGOW_HASKELL__ */ hGetArray :: Handle -> IOUArray Int Word8 -> Int -> IO Int hGetArray handle arr count = do bds <- getBounds arr if count < 0 || count > rangeSize bds then illegalBufferSize handle "hGetArray" count else get 0 where get i | i == count = return i | otherwise = do error_or_c <- try (hGetChar handle) case error_or_c of Left ex | isEOFError ex -> return i | otherwise -> ioError ex Right c -> do unsafeWrite arr i (fromIntegral (ord c)) get (i+1) hPutArray :: Handle -> IOUArray Int Word8 -> Int -> IO () hPutArray handle arr count = do bds <- getBounds arr if count < 0 || count > rangeSize bds then illegalBufferSize handle "hPutArray" count else put 0 where put i | i == count = return () | otherwise = do w <- unsafeRead arr i hPutChar handle (chr (fromIntegral w)) put (i+1) illegalBufferSize :: Handle -> String -> Int -> IO a illegalBufferSize _ fn sz = ioError $ userError (fn ++ ": illegal buffer size " ++ showsPrec 9 (sz::Int) []) #endif /* !__GLASGOW_HASKELL__ */ hugs98-plus-Sep2006/packages/base/Data/Array/ST.hs0000644006511100651110000000477010504340221020263 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Array.ST -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Array.MArray) -- -- Mutable boxed and unboxed arrays in the 'Control.Monad.ST.ST' monad. -- ----------------------------------------------------------------------------- module Data.Array.ST ( -- * Boxed arrays STArray, -- instance of: Eq, MArray runSTArray, -- * Unboxed arrays STUArray, -- instance of: Eq, MArray runSTUArray, castSTUArray, -- :: STUArray s i a -> ST s (STUArray s i b) -- * Overloaded mutable array interface module Data.Array.MArray, ) where import Prelude import Data.Array.MArray import Data.Array.Base ( STUArray, castSTUArray, UArray, unsafeFreezeSTUArray ) import Control.Monad.ST ( ST, runST ) #ifdef __HUGS__ import Hugs.Array ( Array ) import Hugs.ST ( STArray, unsafeFreezeSTArray ) #endif #ifdef __GLASGOW_HASKELL__ import GHC.Arr ( STArray, Array, unsafeFreezeSTArray ) #endif -- | A safe way to create and work with a mutable array before returning an -- immutable array for later perusal. This function avoids copying -- the array before returning it - it uses 'unsafeFreeze' internally, but -- this wrapper is a safe interface to that function. -- runSTArray :: (Ix i) => (forall s . ST s (STArray s i e)) -> Array i e runSTArray st = runST (st >>= unsafeFreezeSTArray) -- | A safe way to create and work with an unboxed mutable array before -- returning an immutable array for later perusal. This function -- avoids copying the array before returning it - it uses -- 'unsafeFreeze' internally, but this wrapper is a safe interface to -- that function. -- runSTUArray :: (Ix i) => (forall s . ST s (STUArray s i e)) -> UArray i e runSTUArray st = runST (st >>= unsafeFreezeSTUArray) -- INTERESTING... this is the type we'd like to give to runSTUArray: -- -- runSTUArray :: (Ix i, IArray UArray e, -- forall s. MArray (STUArray s) e (ST s)) -- => (forall s . ST s (STUArray s i e)) -- -> UArray i e -- -- Note the quantified constraint. We dodged the problem by using -- unsafeFreezeSTUArray directly in the defn of runSTUArray above, but -- this essentially constrains us to a single unsafeFreeze for all STUArrays -- (in theory we might have a different one for certain element types). hugs98-plus-Sep2006/packages/base/Data/Array/MArray.hs0000644006511100651110000000422010504340225021122 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Array.MArray -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Array.Base) -- -- An overloaded interface to mutable arrays. For array types which can be -- used with this interface, see "Data.Array.IO", "Data.Array.ST", -- and "Data.Array.Storable". -- ----------------------------------------------------------------------------- module Data.Array.MArray ( -- * Class of mutable array types MArray, -- :: (* -> * -> *) -> * -> (* -> *) -> class -- * The @Ix@ class and operations module Data.Ix, -- * Constructing mutable arrays newArray, -- :: (MArray a e m, Ix i) => (i,i) -> e -> m (a i e) newArray_, -- :: (MArray a e m, Ix i) => (i,i) -> m (a i e) newListArray, -- :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e) -- * Reading and writing mutable arrays readArray, -- :: (MArray a e m, Ix i) => a i e -> i -> m e writeArray, -- :: (MArray a e m, Ix i) => a i e -> i -> e -> m () -- * Derived arrays mapArray, -- :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e) mapIndices, -- :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e) -- * Deconstructing mutable arrays getBounds, -- :: (MArray a e m, Ix i) => a i e -> m (i,i) getElems, -- :: (MArray a e m, Ix i) => a i e -> m [e] getAssocs, -- :: (MArray a e m, Ix i) => a i e -> m [(i, e)] -- * Conversions between mutable and immutable arrays freeze, -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) unsafeFreeze, -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) thaw, -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) unsafeThaw, -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) ) where import Prelude import Data.Ix #ifdef __HADDOCK__ import Data.Array.IArray #endif import Data.Array.Base hugs98-plus-Sep2006/packages/base/Data/Array/Storable.hs0000644006511100651110000000660510504340225021513 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Array.Storable -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Array.MArray) -- -- A storable array is an IO-mutable array which stores its -- contents in a contiguous memory block living in the C -- heap. Elements are stored according to the class 'Storable'. -- You can obtain the pointer to the array contents to manipulate -- elements from languages like C. -- -- It is similar to 'Data.Array.IO.IOUArray' but slower. -- Its advantage is that it's compatible with C. -- ----------------------------------------------------------------------------- module Data.Array.Storable ( -- * Arrays of 'Storable' things. StorableArray, -- data StorableArray index element -- -- index type must be in class Ix -- -- element type must be in class Storable -- * Overloaded mutable array interface -- | Module "Data.Array.MArray" provides the interface of storable arrays. -- They are instances of class 'MArray' (with the 'IO' monad). module Data.Array.MArray, -- * Accessing the pointer to the array contents withStorableArray, -- :: StorableArray i e -> (Ptr e -> IO a) -> IO a touchStorableArray, -- :: StorableArray i e -> IO () unsafeForeignPtrToStorableArray ) where import Prelude import Data.Array.Base import Data.Array.MArray import Foreign hiding (newArray) -- |The array type data StorableArray i e = StorableArray !i !i !(ForeignPtr e) instance Storable e => MArray StorableArray e IO where getBounds (StorableArray l u _) = return (l,u) newArray (l,u) init = do fp <- mallocForeignPtrArray size withForeignPtr fp $ \a -> sequence_ [pokeElemOff a i init | i <- [0..size-1]] return (StorableArray l u fp) where size = rangeSize (l,u) newArray_ (l,u) = do fp <- mallocForeignPtrArray (rangeSize (l,u)) return (StorableArray l u fp) unsafeRead (StorableArray _ _ fp) i = withForeignPtr fp $ \a -> peekElemOff a i unsafeWrite (StorableArray _ _ fp) i e = withForeignPtr fp $ \a -> pokeElemOff a i e -- |The pointer to the array contents is obtained by 'withStorableArray'. -- The idea is similar to 'ForeignPtr' (used internally here). -- The pointer should be used only during execution of the 'IO' action -- retured by the function passed as argument to 'withStorableArray'. withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a withStorableArray (StorableArray _ _ fp) f = withForeignPtr fp f -- |If you want to use it afterwards, ensure that you -- 'touchStorableArray' after the last use of the pointer, -- so the array is not freed too early. touchStorableArray :: StorableArray i e -> IO () touchStorableArray (StorableArray _ _ fp) = touchForeignPtr fp -- |Construct a 'StorableArray' from an arbitrary 'ForeignPtr'. It is -- the caller's responsibility to ensure that the 'ForeignPtr' points to -- an area of memory sufficient for the specified bounds. unsafeForeignPtrToStorableArray :: ForeignPtr e -> (i,i) -> IO (StorableArray i e) unsafeForeignPtrToStorableArray p (l,u) = return (StorableArray l u p) hugs98-plus-Sep2006/packages/base/Data/Array/Unboxed.hs0000644006511100651110000000131110504340221021325 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Array.Unboxed -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Array.IArray) -- -- Unboxed immutable arrays. -- ----------------------------------------------------------------------------- module Data.Array.Unboxed ( -- * Arrays with unboxed elements UArray, -- * The overloaded immutable array interface module Data.Array.IArray, ) where import Prelude import Data.Array.IArray import Data.Array.Base hugs98-plus-Sep2006/packages/base/Data/Array.hs0000644006511100651110000000614610504340221017734 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Array -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Basic non-strict arrays. -- -- /Note:/ The "Data.Array.IArray" module provides more general interface -- to immutable arrays: it defines operations with the same names as -- those defined below, but with more general types, and also defines -- 'Array' instances of the relevant classes. To use that more general -- interface, import "Data.Array.IArray" but not "Data.Array". ----------------------------------------------------------------------------- module Data.Array ( -- * Immutable non-strict arrays -- $intro module Data.Ix -- export all of Ix , Array -- Array type is abstract -- * Array construction , array -- :: (Ix a) => (a,a) -> [(a,b)] -> Array a b , listArray -- :: (Ix a) => (a,a) -> [b] -> Array a b , accumArray -- :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b -- * Accessing arrays , (!) -- :: (Ix a) => Array a b -> a -> b , bounds -- :: (Ix a) => Array a b -> (a,a) , indices -- :: (Ix a) => Array a b -> [a] , elems -- :: (Ix a) => Array a b -> [b] , assocs -- :: (Ix a) => Array a b -> [(a,b)] -- * Incremental array updates , (//) -- :: (Ix a) => Array a b -> [(a,b)] -> Array a b , accum -- :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b -- * Derived arrays , ixmap -- :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a b -- Array instances: -- -- Ix a => Functor (Array a) -- (Ix a, Eq b) => Eq (Array a b) -- (Ix a, Ord b) => Ord (Array a b) -- (Ix a, Show a, Show b) => Show (Array a b) -- (Ix a, Read a, Read b) => Read (Array a b) -- -- Implementation checked wrt. Haskell 98 lib report, 1/99. ) where import Data.Ix #ifdef __GLASGOW_HASKELL__ import GHC.Arr -- Most of the hard work is done here import Data.Generics.Basics -- To provide a Data instance import Data.Generics.Instances -- To provide a Data instance import GHC.Err ( error ) -- Needed for Data instance #endif #ifdef __HUGS__ import Hugs.Array #endif #ifdef __NHC__ import Array -- Haskell'98 arrays #endif import Data.Typeable {- $intro Haskell provides indexable /arrays/, which may be thought of as functions whose domains are isomorphic to contiguous subsets of the integers. Functions restricted in this way can be implemented efficiently; in particular, a programmer may reasonably expect rapid access to the components. To ensure the possibility of such an implementation, arrays are treated as data, not as general functions. Since most array functions involve the class 'Ix', this module is exported from "Data.Array" so that modules need not import both "Data.Array" and "Data.Ix". -} hugs98-plus-Sep2006/packages/base/Data/Bits.hs0000644006511100651110000002672210504340226017566 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Bits -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- This module defines bitwise operations for signed and unsigned -- integers. Instances of the class 'Bits' for the 'Int' and -- 'Integer' types are available from this module, and instances for -- explicitly sized integral types are available from the -- "Data.Int" and "Data.Word" modules. -- ----------------------------------------------------------------------------- module Data.Bits ( Bits( (.&.), (.|.), xor, -- :: a -> a -> a complement, -- :: a -> a shift, -- :: a -> Int -> a rotate, -- :: a -> Int -> a bit, -- :: Int -> a setBit, -- :: a -> Int -> a clearBit, -- :: a -> Int -> a complementBit, -- :: a -> Int -> a testBit, -- :: a -> Int -> Bool bitSize, -- :: a -> Int isSigned, -- :: a -> Bool shiftL, shiftR, -- :: a -> Int -> a rotateL, rotateR -- :: a -> Int -> a ) -- instance Bits Int -- instance Bits Integer ) where -- Defines the @Bits@ class containing bit-based operations. -- See library document for details on the semantics of the -- individual operations. #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) #include "MachDeps.h" #endif #ifdef __GLASGOW_HASKELL__ import GHC.Num import GHC.Real import GHC.Base #endif #ifdef __HUGS__ import Hugs.Bits #endif infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR` infixl 7 .&. infixl 6 `xor` infixl 5 .|. {-| The 'Bits' class defines bitwise operations over integral types. * Bits are numbered from 0 with bit 0 being the least significant bit. Minimal complete definition: '.&.', '.|.', 'xor', 'complement', ('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')), 'bitSize' and 'isSigned'. -} class Num a => Bits a where -- | Bitwise \"and\" (.&.) :: a -> a -> a -- | Bitwise \"or\" (.|.) :: a -> a -> a -- | Bitwise \"xor\" xor :: a -> a -> a {-| Reverse all the bits in the argument -} complement :: a -> a {-| Shift the argument left by the specified number of bits. Right shifts (signed) are specified by giving a negative value. An instance can define either this unified 'shift' or 'shiftL' and 'shiftR', depending on which is more convenient for the type in question. -} shift :: a -> Int -> a x `shift` i | i<0 = x `shiftR` (-i) | i==0 = x | i>0 = x `shiftL` i {-| Rotate the argument left by the specified number of bits. Right rotates are specified by giving a negative value. For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'. An instance can define either this unified 'rotate' or 'rotateL' and 'rotateR', depending on which is more convenient for the type in question. -} rotate :: a -> Int -> a x `rotate` i | i<0 = x `rotateR` (-i) | i==0 = x | i>0 = x `rotateL` i {- -- Rotation can be implemented in terms of two shifts, but care is -- needed for negative values. This suggested implementation assumes -- 2's-complement arithmetic. It is commented out because it would -- require an extra context (Ord a) on the signature of 'rotate'. x `rotate` i | i<0 && isSigned x && x<0 = let left = i+bitSize x in ((x `shift` i) .&. complement ((-1) `shift` left)) .|. (x `shift` left) | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x)) | i==0 = x | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x)) -} -- | @bit i@ is a value with the @i@th bit set bit :: Int -> a -- | @x \`setBit\` i@ is the same as @x .|. bit i@ setBit :: a -> Int -> a -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@ clearBit :: a -> Int -> a -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@ complementBit :: a -> Int -> a -- | Return 'True' if the @n@th bit of the argument is 1 testBit :: a -> Int -> Bool {-| Return the number of bits in the type of the argument. The actual value of the argument is ignored. The function 'bitSize' is undefined for types that do not have a fixed bitsize, like 'Integer'. -} bitSize :: a -> Int {-| Return 'True' if the argument is a signed type. The actual value of the argument is ignored -} isSigned :: a -> Bool bit i = 1 `shiftL` i x `setBit` i = x .|. bit i x `clearBit` i = x .&. complement (bit i) x `complementBit` i = x `xor` bit i x `testBit` i = (x .&. bit i) /= 0 {-| Shift the argument left by the specified number of bits (which must be non-negative). An instance can define either this and 'shiftR' or the unified 'shift', depending on which is more convenient for the type in question. -} shiftL :: a -> Int -> a x `shiftL` i = x `shift` i {-| Shift the argument right (signed) by the specified number of bits (which must be non-negative). An instance can define either this and 'shiftL' or the unified 'shift', depending on which is more convenient for the type in question. -} shiftR :: a -> Int -> a x `shiftR` i = x `shift` (-i) {-| Rotate the argument left by the specified number of bits (which must be non-negative). An instance can define either this and 'rotateR' or the unified 'rotate', depending on which is more convenient for the type in question. -} rotateL :: a -> Int -> a x `rotateL` i = x `rotate` i {-| Rotate the argument right by the specified number of bits (which must be non-negative). An instance can define either this and 'rotateL' or the unified 'rotate', depending on which is more convenient for the type in question. -} rotateR :: a -> Int -> a x `rotateR` i = x `rotate` (-i) instance Bits Int where #ifdef __GLASGOW_HASKELL__ (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#)) (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#)) complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#))) (I# x#) `shift` (I# i#) | i# >=# 0# = I# (x# `iShiftL#` i#) | otherwise = I# (x# `iShiftRA#` negateInt# i#) (I# x#) `rotate` (I# i#) = I# (word2Int# ((x'# `shiftL#` i'#) `or#` (x'# `shiftRL#` (wsib -# i'#)))) where x'# = int2Word# x# i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#)) wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} bitSize _ = WORD_SIZE_IN_BITS #else /* !__GLASGOW_HASKELL__ */ #ifdef __HUGS__ (.&.) = primAndInt (.|.) = primOrInt xor = primXorInt complement = primComplementInt shift = primShiftInt bit = primBitInt testBit = primTestInt bitSize _ = SIZEOF_HSINT*8 #elif defined(__NHC__) (.&.) = nhc_primIntAnd (.|.) = nhc_primIntOr xor = nhc_primIntXor complement = nhc_primIntCompl shiftL = nhc_primIntLsh shiftR = nhc_primIntRsh bitSize _ = 32 #endif /* __NHC__ */ x `rotate` i | i<0 && x<0 = let left = i+bitSize x in ((x `shift` i) .&. complement ((-1) `shift` left)) .|. (x `shift` left) | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x)) | i==0 = x | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x)) #endif /* !__GLASGOW_HASKELL__ */ isSigned _ = True #ifdef __NHC__ foreign import ccall nhc_primIntAnd :: Int -> Int -> Int foreign import ccall nhc_primIntOr :: Int -> Int -> Int foreign import ccall nhc_primIntXor :: Int -> Int -> Int foreign import ccall nhc_primIntLsh :: Int -> Int -> Int foreign import ccall nhc_primIntRsh :: Int -> Int -> Int foreign import ccall nhc_primIntCompl :: Int -> Int #endif /* __NHC__ */ instance Bits Integer where #ifdef __GLASGOW_HASKELL__ (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y)) x@(S# _) .&. y = toBig x .&. y x .&. y@(S# _) = x .&. toBig y (J# s1 d1) .&. (J# s2 d2) = case andInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y)) x@(S# _) .|. y = toBig x .|. y x .|. y@(S# _) = x .|. toBig y (J# s1 d1) .|. (J# s2 d2) = case orInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y)) x@(S# _) `xor` y = toBig x `xor` y x `xor` y@(S# _) = x `xor` toBig y (J# s1 d1) `xor` (J# s2 d2) = case xorInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#))) complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d #else -- reduce bitwise binary operations to special cases we can handle x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y) | otherwise = x `posAnd` y x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y) | otherwise = x `posOr` y x `xor` y | x<0 && y<0 = complement x `posXOr` complement y | x<0 = complement (complement x `posXOr` y) | y<0 = complement (x `posXOr` complement y) | otherwise = x `posXOr` y -- assuming infinite 2's-complement arithmetic complement a = -1 - a #endif shift x i | i >= 0 = x * 2^i | otherwise = x `div` 2^(-i) rotate x i = shift x i -- since an Integer never wraps around bitSize _ = error "Data.Bits.bitSize(Integer)" isSigned _ = True #ifndef __GLASGOW_HASKELL__ -- Crude implementation of bitwise operations on Integers: convert them -- to finite lists of Ints (least significant first), zip and convert -- back again. -- posAnd requires at least one argument non-negative -- posOr and posXOr require both arguments non-negative posAnd, posOr, posXOr :: Integer -> Integer -> Integer posAnd x y = fromInts $ zipWith (.&.) (toInts x) (toInts y) posOr x y = fromInts $ longZipWith (.|.) (toInts x) (toInts y) posXOr x y = fromInts $ longZipWith xor (toInts x) (toInts y) longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a] longZipWith f xs [] = xs longZipWith f [] ys = ys longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys toInts :: Integer -> [Int] toInts n | n == 0 = [] | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts) where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts) | otherwise = fromInteger n fromInts :: [Int] -> Integer fromInts = foldr catInt 0 where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1 #endif /* !__GLASGOW_HASKELL__ */ hugs98-plus-Sep2006/packages/base/Data/Bool.hs0000644006511100651110000000154310504340221017545 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Bool -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- The 'Bool' type and related functions. -- ----------------------------------------------------------------------------- module Data.Bool ( -- * Booleans Bool(..), -- ** Operations (&&), -- :: Bool -> Bool -> Bool (||), -- :: Bool -> Bool -> Bool not, -- :: Bool -> Bool otherwise, -- :: Bool ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base #endif #ifdef __NHC__ import Prelude import Prelude ( Bool(..) , (&&) , (||) , not , otherwise ) #endif hugs98-plus-Sep2006/packages/base/Data/Char.hs0000644006511100651110000001651110504340221017530 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Char -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- The Char type and associated operations. -- ----------------------------------------------------------------------------- module Data.Char ( Char , String -- * Character classification -- | Unicode characters are divided into letters, numbers, marks, -- punctuation, symbols, separators (including spaces) and others -- (including control characters). , isControl, isSpace , isLower, isUpper, isAlpha, isAlphaNum, isPrint , isDigit, isOctDigit, isHexDigit , isLetter, isMark, isNumber, isPunctuation, isSymbol, isSeparator -- ** Subranges , isAscii, isLatin1 , isAsciiUpper, isAsciiLower -- ** Unicode general categories , GeneralCategory(..), generalCategory -- * Case conversion , toUpper, toLower, toTitle -- :: Char -> Char -- * Single digit characters , digitToInt -- :: Char -> Int , intToDigit -- :: Int -> Char -- * Numeric representations , ord -- :: Char -> Int , chr -- :: Int -> Char -- * String representations , showLitChar -- :: Char -> ShowS , lexLitChar -- :: ReadS String , readLitChar -- :: ReadS Char -- Implementation checked wrt. Haskell 98 lib report, 1/99. ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Arr (Ix) import GHC.Real (fromIntegral) import GHC.Show import GHC.Read (Read, readLitChar, lexLitChar) import GHC.Unicode import GHC.Num import GHC.Enum #endif #ifdef __HUGS__ import Hugs.Prelude (Ix) import Hugs.Char #endif #ifdef __NHC__ import Prelude import Prelude(Char,String) import Char import Ix import NHC.FFI (CInt) foreign import ccall unsafe "WCsubst.h u_gencat" wgencat :: CInt -> Int #endif -- | Convert a single digit 'Char' to the corresponding 'Int'. -- This function fails unless its argument satisfies 'isHexDigit', -- but recognises both upper and lower-case hexadecimal digits -- (i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@). digitToInt :: Char -> Int digitToInt c | isDigit c = ord c - ord '0' | c >= 'a' && c <= 'f' = ord c - ord 'a' + 10 | c >= 'A' && c <= 'F' = ord c - ord 'A' + 10 | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh #ifndef __GLASGOW_HASKELL__ isAsciiUpper, isAsciiLower :: Char -> Bool isAsciiLower c = c >= 'a' && c <= 'z' isAsciiUpper c = c >= 'A' && c <= 'Z' #endif -- | Unicode General Categories (column 2 of the UnicodeData table) -- in the order they are listed in the Unicode standard. data GeneralCategory = UppercaseLetter -- ^ Lu: Letter, Uppercase | LowercaseLetter -- ^ Ll: Letter, Lowercase | TitlecaseLetter -- ^ Lt: Letter, Titlecase | ModifierLetter -- ^ Lm: Letter, Modifier | OtherLetter -- ^ Lo: Letter, Other | NonSpacingMark -- ^ Mn: Mark, Non-Spacing | SpacingCombiningMark -- ^ Mc: Mark, Spacing Combining | EnclosingMark -- ^ Me: Mark, Enclosing | DecimalNumber -- ^ Nd: Number, Decimal | LetterNumber -- ^ Nl: Number, Letter | OtherNumber -- ^ No: Number, Other | ConnectorPunctuation -- ^ Pc: Punctuation, Connector | DashPunctuation -- ^ Pd: Punctuation, Dash | OpenPunctuation -- ^ Ps: Punctuation, Open | ClosePunctuation -- ^ Pe: Punctuation, Close | InitialQuote -- ^ Pi: Punctuation, Initial quote | FinalQuote -- ^ Pf: Punctuation, Final quote | OtherPunctuation -- ^ Po: Punctuation, Other | MathSymbol -- ^ Sm: Symbol, Math | CurrencySymbol -- ^ Sc: Symbol, Currency | ModifierSymbol -- ^ Sk: Symbol, Modifier | OtherSymbol -- ^ So: Symbol, Other | Space -- ^ Zs: Separator, Space | LineSeparator -- ^ Zl: Separator, Line | ParagraphSeparator -- ^ Zp: Separator, Paragraph | Control -- ^ Cc: Other, Control | Format -- ^ Cf: Other, Format | Surrogate -- ^ Cs: Other, Surrogate | PrivateUse -- ^ Co: Other, Private Use | NotAssigned -- ^ Cn: Other, Not Assigned deriving (Eq, Ord, Enum, Read, Show, Bounded, Ix) -- | The Unicode general category of the character. generalCategory :: Char -> GeneralCategory #if defined(__GLASGOW_HASKELL__) || defined(__NHC__) generalCategory c = toEnum (wgencat (fromIntegral (ord c))) #endif #ifdef __HUGS__ generalCategory c = toEnum (primUniGenCat c) #endif -- derived character classifiers -- | Selects alphabetic Unicode characters (lower-case, upper-case and -- title-case letters, plus letters of caseless scripts and modifiers letters). -- This function is equivalent to 'Data.Char.isAlpha'. isLetter :: Char -> Bool isLetter c = case generalCategory c of UppercaseLetter -> True LowercaseLetter -> True TitlecaseLetter -> True ModifierLetter -> True OtherLetter -> True _ -> False -- | Selects Unicode mark characters, e.g. accents and the like, which -- combine with preceding letters. isMark :: Char -> Bool isMark c = case generalCategory c of NonSpacingMark -> True SpacingCombiningMark -> True EnclosingMark -> True _ -> False -- | Selects Unicode numeric characters, including digits from various -- scripts, Roman numerals, etc. isNumber :: Char -> Bool isNumber c = case generalCategory c of DecimalNumber -> True LetterNumber -> True OtherNumber -> True _ -> False -- | Selects Unicode punctuation characters, including various kinds -- of connectors, brackets and quotes. isPunctuation :: Char -> Bool isPunctuation c = case generalCategory c of ConnectorPunctuation -> True DashPunctuation -> True OpenPunctuation -> True ClosePunctuation -> True InitialQuote -> True FinalQuote -> True OtherPunctuation -> True _ -> False -- | Selects Unicode symbol characters, including mathematical and -- currency symbols. isSymbol :: Char -> Bool isSymbol c = case generalCategory c of MathSymbol -> True CurrencySymbol -> True ModifierSymbol -> True OtherSymbol -> True _ -> False -- | Selects Unicode space and separator characters. isSeparator :: Char -> Bool isSeparator c = case generalCategory c of Space -> True LineSeparator -> True ParagraphSeparator -> True _ -> False #ifdef __NHC__ -- dummy implementation toTitle :: Char -> Char toTitle = toUpper #endif hugs98-plus-Sep2006/packages/base/Data/Complex.hs0000644006511100651110000001561010504340221020261 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Complex -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Complex numbers. -- ----------------------------------------------------------------------------- module Data.Complex ( -- * Rectangular form Complex((:+)) , realPart -- :: (RealFloat a) => Complex a -> a , imagPart -- :: (RealFloat a) => Complex a -> a -- * Polar form , mkPolar -- :: (RealFloat a) => a -> a -> Complex a , cis -- :: (RealFloat a) => a -> Complex a , polar -- :: (RealFloat a) => Complex a -> (a,a) , magnitude -- :: (RealFloat a) => Complex a -> a , phase -- :: (RealFloat a) => Complex a -> a -- * Conjugate , conjugate -- :: (RealFloat a) => Complex a -> Complex a -- Complex instances: -- -- (RealFloat a) => Eq (Complex a) -- (RealFloat a) => Read (Complex a) -- (RealFloat a) => Show (Complex a) -- (RealFloat a) => Num (Complex a) -- (RealFloat a) => Fractional (Complex a) -- (RealFloat a) => Floating (Complex a) -- -- Implementation checked wrt. Haskell 98 lib report, 1/99. ) where import Prelude import Data.Typeable #ifdef __HUGS__ import Hugs.Prelude(Num(fromInt), Fractional(fromDouble)) #endif infix 6 :+ -- ----------------------------------------------------------------------------- -- The Complex type -- | Complex numbers are an algebraic type. -- -- For a complex number @z@, @'abs' z@ is a number with the magnitude of @z@, -- but oriented in the positive real direction, whereas @'signum' z@ -- has the phase of @z@, but unit magnitude. data (RealFloat a) => Complex a = !a :+ !a -- ^ forms a complex number from its real and imaginary -- rectangular components. deriving (Eq, Read, Show) -- ----------------------------------------------------------------------------- -- Functions over Complex -- | Extracts the real part of a complex number. realPart :: (RealFloat a) => Complex a -> a realPart (x :+ _) = x -- | Extracts the imaginary part of a complex number. imagPart :: (RealFloat a) => Complex a -> a imagPart (_ :+ y) = y -- | The conjugate of a complex number. {-# SPECIALISE conjugate :: Complex Double -> Complex Double #-} conjugate :: (RealFloat a) => Complex a -> Complex a conjugate (x:+y) = x :+ (-y) -- | Form a complex number from polar components of magnitude and phase. {-# SPECIALISE mkPolar :: Double -> Double -> Complex Double #-} mkPolar :: (RealFloat a) => a -> a -> Complex a mkPolar r theta = r * cos theta :+ r * sin theta -- | @'cis' t@ is a complex value with magnitude @1@ -- and phase @t@ (modulo @2*'pi'@). {-# SPECIALISE cis :: Double -> Complex Double #-} cis :: (RealFloat a) => a -> Complex a cis theta = cos theta :+ sin theta -- | The function 'polar' takes a complex number and -- returns a (magnitude, phase) pair in canonical form: -- the magnitude is nonnegative, and the phase in the range @(-'pi', 'pi']@; -- if the magnitude is zero, then so is the phase. {-# SPECIALISE polar :: Complex Double -> (Double,Double) #-} polar :: (RealFloat a) => Complex a -> (a,a) polar z = (magnitude z, phase z) -- | The nonnegative magnitude of a complex number. {-# SPECIALISE magnitude :: Complex Double -> Double #-} magnitude :: (RealFloat a) => Complex a -> a magnitude (x:+y) = scaleFloat k (sqrt ((scaleFloat mk x)^(2::Int) + (scaleFloat mk y)^(2::Int))) where k = max (exponent x) (exponent y) mk = - k -- | The phase of a complex number, in the range @(-'pi', 'pi']@. -- If the magnitude is zero, then so is the phase. {-# SPECIALISE phase :: Complex Double -> Double #-} phase :: (RealFloat a) => Complex a -> a phase (0 :+ 0) = 0 -- SLPJ July 97 from John Peterson phase (x:+y) = atan2 y x -- ----------------------------------------------------------------------------- -- Instances of Complex #include "Typeable.h" INSTANCE_TYPEABLE1(Complex,complexTc,"Complex") instance (RealFloat a) => Num (Complex a) where {-# SPECIALISE instance Num (Complex Float) #-} {-# SPECIALISE instance Num (Complex Double) #-} (x:+y) + (x':+y') = (x+x') :+ (y+y') (x:+y) - (x':+y') = (x-x') :+ (y-y') (x:+y) * (x':+y') = (x*x'-y*y') :+ (x*y'+y*x') negate (x:+y) = negate x :+ negate y abs z = magnitude z :+ 0 signum 0 = 0 signum z@(x:+y) = x/r :+ y/r where r = magnitude z fromInteger n = fromInteger n :+ 0 #ifdef __HUGS__ fromInt n = fromInt n :+ 0 #endif instance (RealFloat a) => Fractional (Complex a) where {-# SPECIALISE instance Fractional (Complex Float) #-} {-# SPECIALISE instance Fractional (Complex Double) #-} (x:+y) / (x':+y') = (x*x''+y*y'') / d :+ (y*x''-x*y'') / d where x'' = scaleFloat k x' y'' = scaleFloat k y' k = - max (exponent x') (exponent y') d = x'*x'' + y'*y'' fromRational a = fromRational a :+ 0 #ifdef __HUGS__ fromDouble a = fromDouble a :+ 0 #endif instance (RealFloat a) => Floating (Complex a) where {-# SPECIALISE instance Floating (Complex Float) #-} {-# SPECIALISE instance Floating (Complex Double) #-} pi = pi :+ 0 exp (x:+y) = expx * cos y :+ expx * sin y where expx = exp x log z = log (magnitude z) :+ phase z sqrt 0 = 0 sqrt z@(x:+y) = u :+ (if y < 0 then -v else v) where (u,v) = if x < 0 then (v',u') else (u',v') v' = abs y / (u'*2) u' = sqrt ((magnitude z + abs x) / 2) sin (x:+y) = sin x * cosh y :+ cos x * sinh y cos (x:+y) = cos x * cosh y :+ (- sin x * sinh y) tan (x:+y) = (sinx*coshy:+cosx*sinhy)/(cosx*coshy:+(-sinx*sinhy)) where sinx = sin x cosx = cos x sinhy = sinh y coshy = cosh y sinh (x:+y) = cos y * sinh x :+ sin y * cosh x cosh (x:+y) = cos y * cosh x :+ sin y * sinh x tanh (x:+y) = (cosy*sinhx:+siny*coshx)/(cosy*coshx:+siny*sinhx) where siny = sin y cosy = cos y sinhx = sinh x coshx = cosh x asin z@(x:+y) = y':+(-x') where (x':+y') = log (((-y):+x) + sqrt (1 - z*z)) acos z = y'':+(-x'') where (x'':+y'') = log (z + ((-y'):+x')) (x':+y') = sqrt (1 - z*z) atan z@(x:+y) = y':+(-x') where (x':+y') = log (((1-y):+x) / sqrt (1+z*z)) asinh z = log (z + sqrt (1+z*z)) acosh z = log (z + (z+1) * sqrt ((z-1)/(z+1))) atanh z = log ((1+z) / sqrt (1-z*z)) hugs98-plus-Sep2006/packages/base/Data/Dynamic.hs0000644006511100651110000001173010504340221020235 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Dynamic -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- The Dynamic interface provides basic support for dynamic types. -- -- Operations for injecting values of arbitrary type into -- a dynamically typed value, Dynamic, are provided, together -- with operations for converting dynamic values into a concrete -- (monomorphic) type. -- ----------------------------------------------------------------------------- module Data.Dynamic ( -- Module Data.Typeable re-exported for convenience module Data.Typeable, -- * The @Dynamic@ type Dynamic, -- abstract, instance of: Show, Typeable -- * Converting to and from @Dynamic@ toDyn, -- :: Typeable a => a -> Dynamic fromDyn, -- :: Typeable a => Dynamic -> a -> a fromDynamic, -- :: Typeable a => Dynamic -> Maybe a -- * Applying functions of dynamic type dynApply, dynApp, dynTypeRep ) where import Data.Typeable import Data.Maybe #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Show import GHC.Err import GHC.Num #endif #ifdef __HUGS__ import Hugs.Prelude import Hugs.IO import Hugs.IORef import Hugs.IOExts #endif #ifdef __GLASGOW_HASKELL__ unsafeCoerce :: a -> b unsafeCoerce = unsafeCoerce# #endif #ifdef __NHC__ import NonStdUnsafeCoerce (unsafeCoerce) import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO) #endif #include "Typeable.h" ------------------------------------------------------------- -- -- The type Dynamic -- ------------------------------------------------------------- {-| A value of type 'Dynamic' is an object encapsulated together with its type. A 'Dynamic' may only represent a monomorphic value; an attempt to create a value of type 'Dynamic' from a polymorphically-typed expression will result in an ambiguity error (see 'toDyn'). 'Show'ing a value of type 'Dynamic' returns a pretty-printed representation of the object\'s type; useful for debugging. -} #ifndef __HUGS__ data Dynamic = Dynamic TypeRep Obj #endif INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic") instance Show Dynamic where -- the instance just prints the type representation. showsPrec _ (Dynamic t _) = showString "<<" . showsPrec 0 t . showString ">>" #ifdef __GLASGOW_HASKELL__ type Obj = forall a . a -- Dummy type to hold the dynamically typed value. -- -- In GHC's new eval/apply execution model this type must -- be polymorphic. It can't be a constructor, because then -- GHC will use the constructor convention when evaluating it, -- and this will go wrong if the object is really a function. On -- the other hand, if we use a polymorphic type, GHC will use -- a fallback convention for evaluating it that works for all types. -- (using a function type here would also work). #elif !defined(__HUGS__) data Obj = Obj #endif -- | Converts an arbitrary value into an object of type 'Dynamic'. -- -- The type of the object must be an instance of 'Typeable', which -- ensures that only monomorphically-typed objects may be converted to -- 'Dynamic'. To convert a polymorphic object into 'Dynamic', give it -- a monomorphic type signature. For example: -- -- > toDyn (id :: Int -> Int) -- toDyn :: Typeable a => a -> Dynamic toDyn v = Dynamic (typeOf v) (unsafeCoerce v) -- | Converts a 'Dynamic' object back into an ordinary Haskell value of -- the correct type. See also 'fromDynamic'. fromDyn :: Typeable a => Dynamic -- ^ the dynamically-typed object -> a -- ^ a default value -> a -- ^ returns: the value of the first argument, if -- it has the correct type, otherwise the value of -- the second argument. fromDyn (Dynamic t v) def | typeOf def == t = unsafeCoerce v | otherwise = def -- | Converts a 'Dynamic' object back into an ordinary Haskell value of -- the correct type. See also 'fromDyn'. fromDynamic :: Typeable a => Dynamic -- ^ the dynamically-typed object -> Maybe a -- ^ returns: @'Just' a@, if the dynamically-typed -- object has the correct type (and @a@ is its value), -- or 'Nothing' otherwise. fromDynamic (Dynamic t v) = case unsafeCoerce v of r | t == typeOf r -> Just r | otherwise -> Nothing -- (f::(a->b)) `dynApply` (x::a) = (f a)::b dynApply :: Dynamic -> Dynamic -> Maybe Dynamic dynApply (Dynamic t1 f) (Dynamic t2 x) = case funResultTy t1 t2 of Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x)) Nothing -> Nothing dynApp :: Dynamic -> Dynamic -> Dynamic dynApp f x = case dynApply f x of Just r -> r Nothing -> error ("Type error in dynamic application.\n" ++ "Can't apply function " ++ show f ++ " to argument " ++ show x) dynTypeRep :: Dynamic -> TypeRep dynTypeRep (Dynamic tr _) = tr hugs98-plus-Sep2006/packages/base/Data/Either.hs0000644006511100651110000000264710504340221020100 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Either -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- The Either type, and associated operations. -- ----------------------------------------------------------------------------- module Data.Either ( Either(..), either -- :: (a -> c) -> (b -> c) -> Either a b -> c ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base {-| The 'Either' type represents values with two possibilities: a value of type @'Either' a b@ is either @'Left' a@ or @'Right' b@. The 'Either' type is sometimes used to represent a value which is either correct or an error; by convention, the 'Left' constructor is used to hold an error value and the 'Right' constructor is used to hold a correct value (mnemonic: \"right\" also means \"correct\"). -} data Either a b = Left a | Right b deriving (Eq, Ord ) -- | Case analysis for the 'Either' type. -- If the value is @'Left' a@, apply the first function to @a@; -- if it is @'Right' b@, apply the second function to @b@. either :: (a -> c) -> (b -> c) -> Either a b -> c either f _ (Left x) = f x either _ g (Right y) = g y #endif /* __GLASGOW_HASKELL__ */ hugs98-plus-Sep2006/packages/base/Data/Dynamic.hs-boot0000644006511100651110000000023410504340222021174 0ustar rossross{-# OPTIONS -fno-implicit-prelude #-} module Data.Dynamic where import {-# SOURCE #-} Data.Typeable (TypeRep) data Dynamic dynTypeRep :: Dynamic -> TypeRep hugs98-plus-Sep2006/packages/base/Data/Eq.hs0000644006511100651110000000104410504340221017213 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Eq -- Copyright : (c) The University of Glasgow 2005 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- Equality -- ----------------------------------------------------------------------------- module Data.Eq ( Eq(..), ) where #if __GLASGOW_HASKELL__ import GHC.Base #endif hugs98-plus-Sep2006/packages/base/Data/Generics/0000755006511100651110000000000010504340221020052 5ustar rossrosshugs98-plus-Sep2006/packages/base/Data/Generics/Instances.hs0000644006511100651110000004423010504340221022340 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Generics.Instances -- Copyright : (c) The University of Glasgow, CWI 2001--2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Generics.Basics) -- -- \"Scrap your boilerplate\" --- Generic programming in Haskell -- See . The present module -- instantiates the class Data for Prelude-like datatypes. -- (This module does not export anything. It really just defines instances.) -- ----------------------------------------------------------------------------- module Data.Generics.Instances where ------------------------------------------------------------------------------ #ifdef __HADDOCK__ import Prelude #endif import Data.Generics.Basics import Data.Typeable import Data.Int -- So we can give Data instance for Int8, ... import Data.Word -- So we can give Data instance for Word8, ... import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio import GHC.IOBase -- So we can give Data instance for IO, Handle import GHC.Ptr -- So we can give Data instance for Ptr import GHC.ForeignPtr -- So we can give Data instance for ForeignPtr import GHC.Stable -- So we can give Data instance for StablePtr import GHC.ST -- So we can give Data instance for ST import GHC.Conc -- So we can give Data instance for MVar & Co. import GHC.Arr -- So we can give Data instance for Array #include "Typeable.h" ------------------------------------------------------------------------------ -- -- Instances of the Data class for Prelude-like types. -- We define top-level definitions for representations. -- ------------------------------------------------------------------------------ falseConstr = mkConstr boolDataType "False" [] Prefix trueConstr = mkConstr boolDataType "True" [] Prefix boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr] instance Data Bool where toConstr False = falseConstr toConstr True = trueConstr gunfold k z c = case constrIndex c of 1 -> z False 2 -> z True _ -> error "gunfold" dataTypeOf _ = boolDataType ------------------------------------------------------------------------------ charType = mkStringType "Prelude.Char" instance Data Char where toConstr x = mkStringConstr charType [x] gunfold k z c = case constrRep c of (StringConstr [x]) -> z x _ -> error "gunfold" dataTypeOf _ = charType ------------------------------------------------------------------------------ floatType = mkFloatType "Prelude.Float" instance Data Float where toConstr x = mkFloatConstr floatType (realToFrac x) gunfold k z c = case constrRep c of (FloatConstr x) -> z (realToFrac x) _ -> error "gunfold" dataTypeOf _ = floatType ------------------------------------------------------------------------------ doubleType = mkFloatType "Prelude.Double" instance Data Double where toConstr = mkFloatConstr floatType gunfold k z c = case constrRep c of (FloatConstr x) -> z x _ -> error "gunfold" dataTypeOf _ = doubleType ------------------------------------------------------------------------------ intType = mkIntType "Prelude.Int" instance Data Int where toConstr x = mkIntConstr intType (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = intType ------------------------------------------------------------------------------ integerType = mkIntType "Prelude.Integer" instance Data Integer where toConstr = mkIntConstr integerType gunfold k z c = case constrRep c of (IntConstr x) -> z x _ -> error "gunfold" dataTypeOf _ = integerType ------------------------------------------------------------------------------ int8Type = mkIntType "Data.Int.Int8" instance Data Int8 where toConstr x = mkIntConstr int8Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = int8Type ------------------------------------------------------------------------------ int16Type = mkIntType "Data.Int.Int16" instance Data Int16 where toConstr x = mkIntConstr int16Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = int16Type ------------------------------------------------------------------------------ int32Type = mkIntType "Data.Int.Int32" instance Data Int32 where toConstr x = mkIntConstr int32Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = int32Type ------------------------------------------------------------------------------ int64Type = mkIntType "Data.Int.Int64" instance Data Int64 where toConstr x = mkIntConstr int64Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = int64Type ------------------------------------------------------------------------------ wordType = mkIntType "Data.Word.Word" instance Data Word where toConstr x = mkIntConstr wordType (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = wordType ------------------------------------------------------------------------------ word8Type = mkIntType "Data.Word.Word8" instance Data Word8 where toConstr x = mkIntConstr word8Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = word8Type ------------------------------------------------------------------------------ word16Type = mkIntType "Data.Word.Word16" instance Data Word16 where toConstr x = mkIntConstr word16Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = word16Type ------------------------------------------------------------------------------ word32Type = mkIntType "Data.Word.Word32" instance Data Word32 where toConstr x = mkIntConstr word32Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = word32Type ------------------------------------------------------------------------------ word64Type = mkIntType "Data.Word.Word64" instance Data Word64 where toConstr x = mkIntConstr word64Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = word64Type ------------------------------------------------------------------------------ ratioConstr = mkConstr ratioDataType ":%" [] Infix ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr] instance (Data a, Integral a) => Data (Ratio a) where toConstr _ = ratioConstr gunfold k z c | constrIndex c == 1 = k (k (z (:%))) gunfold _ _ _ = error "gunfold" dataTypeOf _ = ratioDataType ------------------------------------------------------------------------------ nilConstr = mkConstr listDataType "[]" [] Prefix consConstr = mkConstr listDataType "(:)" [] Infix listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr] instance Data a => Data [a] where gfoldl f z [] = z [] gfoldl f z (x:xs) = z (:) `f` x `f` xs toConstr [] = nilConstr toConstr (_:_) = consConstr gunfold k z c = case constrIndex c of 1 -> z [] 2 -> k (k (z (:))) _ -> error "gunfold" dataTypeOf _ = listDataType dataCast1 f = gcast1 f -- -- The gmaps are given as an illustration. -- This shows that the gmaps for lists are different from list maps. -- gmapT f [] = [] gmapT f (x:xs) = (f x:f xs) gmapQ f [] = [] gmapQ f (x:xs) = [f x,f xs] gmapM f [] = return [] gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs') ------------------------------------------------------------------------------ nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix justConstr = mkConstr maybeDataType "Just" [] Prefix maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr] instance Data a => Data (Maybe a) where gfoldl f z Nothing = z Nothing gfoldl f z (Just x) = z Just `f` x toConstr Nothing = nothingConstr toConstr (Just _) = justConstr gunfold k z c = case constrIndex c of 1 -> z Nothing 2 -> k (z Just) _ -> error "gunfold" dataTypeOf _ = maybeDataType dataCast1 f = gcast1 f ------------------------------------------------------------------------------ ltConstr = mkConstr orderingDataType "LT" [] Prefix eqConstr = mkConstr orderingDataType "EQ" [] Prefix gtConstr = mkConstr orderingDataType "GT" [] Prefix orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr] instance Data Ordering where gfoldl f z LT = z LT gfoldl f z EQ = z EQ gfoldl f z GT = z GT toConstr LT = ltConstr toConstr EQ = eqConstr toConstr GT = gtConstr gunfold k z c = case constrIndex c of 1 -> z LT 2 -> z EQ 3 -> z GT _ -> error "gunfold" dataTypeOf _ = orderingDataType ------------------------------------------------------------------------------ leftConstr = mkConstr eitherDataType "Left" [] Prefix rightConstr = mkConstr eitherDataType "Right" [] Prefix eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr] instance (Data a, Data b) => Data (Either a b) where gfoldl f z (Left a) = z Left `f` a gfoldl f z (Right a) = z Right `f` a toConstr (Left _) = leftConstr toConstr (Right _) = rightConstr gunfold k z c = case constrIndex c of 1 -> k (z Left) 2 -> k (z Right) _ -> error "gunfold" dataTypeOf _ = eitherDataType dataCast2 f = gcast2 f ------------------------------------------------------------------------------ -- -- A last resort for functions -- instance (Data a, Data b) => Data (a -> b) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Prelude.(->)" dataCast2 f = gcast2 f ------------------------------------------------------------------------------ tuple0Constr = mkConstr tuple0DataType "()" [] Prefix tuple0DataType = mkDataType "Prelude.()" [tuple0Constr] instance Data () where toConstr () = tuple0Constr gunfold k z c | constrIndex c == 1 = z () gunfold _ _ _ = error "gunfold" dataTypeOf _ = tuple0DataType ------------------------------------------------------------------------------ tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr] instance (Data a, Data b) => Data (a,b) where gfoldl f z (a,b) = z (,) `f` a `f` b toConstr (a,b) = tuple2Constr gunfold k z c | constrIndex c == 1 = k (k (z (,))) gunfold _ _ _ = error "gunfold" dataTypeOf _ = tuple2DataType dataCast2 f = gcast2 f ------------------------------------------------------------------------------ tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix tuple3DataType = mkDataType "Prelude.(,)" [tuple3Constr] instance (Data a, Data b, Data c) => Data (a,b,c) where gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c toConstr (a,b,c) = tuple3Constr gunfold k z c | constrIndex c == 1 = k (k (k (z (,,)))) gunfold _ _ _ = error "gunfold" dataTypeOf _ = tuple3DataType ------------------------------------------------------------------------------ tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr] instance (Data a, Data b, Data c, Data d) => Data (a,b,c,d) where gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d toConstr (a,b,c,d) = tuple4Constr gunfold k z c = case constrIndex c of 1 -> k (k (k (k (z (,,,))))) _ -> error "gunfold" dataTypeOf _ = tuple4DataType ------------------------------------------------------------------------------ tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr] instance (Data a, Data b, Data c, Data d, Data e) => Data (a,b,c,d,e) where gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e toConstr (a,b,c,d,e) = tuple5Constr gunfold k z c = case constrIndex c of 1 -> k (k (k (k (k (z (,,,,)))))) _ -> error "gunfold" dataTypeOf _ = tuple5DataType ------------------------------------------------------------------------------ tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr] instance (Data a, Data b, Data c, Data d, Data e, Data f) => Data (a,b,c,d,e,f) where gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' toConstr (a,b,c,d,e,f) = tuple6Constr gunfold k z c = case constrIndex c of 1 -> k (k (k (k (k (k (z (,,,,,))))))) _ -> error "gunfold" dataTypeOf _ = tuple6DataType ------------------------------------------------------------------------------ tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr] instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g) => Data (a,b,c,d,e,f,g) where gfoldl f z (a,b,c,d,e,f',g) = z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g toConstr (a,b,c,d,e,f,g) = tuple7Constr gunfold k z c = case constrIndex c of 1 -> k (k (k (k (k (k (k (z (,,,,,,)))))))) _ -> error "gunfold" dataTypeOf _ = tuple7DataType ------------------------------------------------------------------------------ instance Data TypeRep where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep" ------------------------------------------------------------------------------ instance Data TyCon where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Typeable.TyCon" ------------------------------------------------------------------------------ INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType") instance Data DataType where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType" ------------------------------------------------------------------------------ instance Typeable a => Data (IO a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.IOBase.IO" ------------------------------------------------------------------------------ instance Data Handle where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.IOBase.Handle" ------------------------------------------------------------------------------ instance Typeable a => Data (Ptr a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr" ------------------------------------------------------------------------------ instance Typeable a => Data (StablePtr a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr" ------------------------------------------------------------------------------ instance Typeable a => Data (IORef a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.IOBase.IORef" ------------------------------------------------------------------------------ instance Typeable a => Data (ForeignPtr a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.ForeignPtr.ForeignPtr" ------------------------------------------------------------------------------ instance (Typeable s, Typeable a) => Data (ST s a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.ST.ST" ------------------------------------------------------------------------------ instance Data ThreadId where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Conc.ThreadId" ------------------------------------------------------------------------------ instance Typeable a => Data (TVar a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Conc.TVar" ------------------------------------------------------------------------------ instance Typeable a => Data (MVar a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Conc.MVar" ------------------------------------------------------------------------------ instance Typeable a => Data (STM a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Conc.STM" ------------------------------------------------------------------------------ -- The Data instance for Array preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction. instance (Typeable a, Data b, Ix a) => Data (Array a b) where gfoldl f z a = z (listArray (bounds a)) `f` (elems a) toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Array.Array" hugs98-plus-Sep2006/packages/base/Data/Generics/Aliases.hs0000644006511100651110000002117510504340221021775 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Generics.Aliases -- Copyright : (c) The University of Glasgow, CWI 2001--2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (local universal quantification) -- -- \"Scrap your boilerplate\" --- Generic programming in Haskell -- See . The present module provides -- a number of declarations for typical generic function types, -- corresponding type case, and others. -- ----------------------------------------------------------------------------- module Data.Generics.Aliases ( -- * Combinators to \"make\" generic functions via cast mkT, mkQ, mkM, mkMp, mkR, ext0, extT, extQ, extM, extMp, extB, extR, -- * Type synonyms for generic function types GenericT, GenericQ, GenericM, GenericB, GenericR, Generic, Generic'(..), GenericT'(..), GenericQ'(..), GenericM'(..), -- * Inredients of generic functions orElse, -- * Function combinators on generic functions recoverMp, recoverQ, choiceMp, choiceQ, -- * Type extension for unary type constructors ext1T, ext1M, ext1Q, ext1R ) where #ifdef __HADDOCK__ import Prelude #endif import Control.Monad import Data.Generics.Basics ------------------------------------------------------------------------------ -- -- Combinators to "make" generic functions -- We use type-safe cast in a number of ways to make generic functions. -- ------------------------------------------------------------------------------ -- | Make a generic transformation; -- start from a type-specific case; -- preserve the term otherwise -- mkT :: ( Typeable a , Typeable b ) => (b -> b) -> a -> a mkT = extT id -- | Make a generic query; -- start from a type-specific case; -- return a constant otherwise -- mkQ :: ( Typeable a , Typeable b ) => r -> (b -> r) -> a -> r (r `mkQ` br) a = case cast a of Just b -> br b Nothing -> r -- | Make a generic monadic transformation; -- start from a type-specific case; -- resort to return otherwise -- mkM :: ( Monad m , Typeable a , Typeable b ) => (b -> m b) -> a -> m a mkM = extM return {- For the remaining definitions, we stick to a more concise style, i.e., we fold maybies with "maybe" instead of case ... of ..., and we also use a point-free style whenever possible. -} -- | Make a generic monadic transformation for MonadPlus; -- use \"const mzero\" (i.e., failure) instead of return as default. -- mkMp :: ( MonadPlus m , Typeable a , Typeable b ) => (b -> m b) -> a -> m a mkMp = extM (const mzero) -- | Make a generic builder; -- start from a type-specific ase; -- resort to no build (i.e., mzero) otherwise -- mkR :: ( MonadPlus m , Typeable a , Typeable b ) => m b -> m a mkR f = mzero `extR` f -- | Flexible type extension ext0 :: (Typeable a, Typeable b) => c a -> c b -> c a ext0 def ext = maybe def id (gcast ext) -- | Extend a generic transformation by a type-specific case extT :: ( Typeable a , Typeable b ) => (a -> a) -> (b -> b) -> a -> a extT def ext = unT ((T def) `ext0` (T ext)) -- | Extend a generic query by a type-specific case extQ :: ( Typeable a , Typeable b ) => (a -> q) -> (b -> q) -> a -> q extQ f g a = maybe (f a) g (cast a) -- | Extend a generic monadic transformation by a type-specific case extM :: ( Monad m , Typeable a , Typeable b ) => (a -> m a) -> (b -> m b) -> a -> m a extM def ext = unM ((M def) `ext0` (M ext)) -- | Extend a generic MonadPlus transformation by a type-specific case extMp :: ( MonadPlus m , Typeable a , Typeable b ) => (a -> m a) -> (b -> m b) -> a -> m a extMp = extM -- | Extend a generic builder extB :: ( Typeable a , Typeable b ) => a -> b -> a extB a = maybe a id . cast -- | Extend a generic reader extR :: ( Monad m , Typeable a , Typeable b ) => m a -> m b -> m a extR def ext = unR ((R def) `ext0` (R ext)) ------------------------------------------------------------------------------ -- -- Type synonyms for generic function types -- ------------------------------------------------------------------------------ -- | Generic transformations, -- i.e., take an \"a\" and return an \"a\" -- type GenericT = forall a. Data a => a -> a -- | Generic queries of type \"r\", -- i.e., take any \"a\" and return an \"r\" -- type GenericQ r = forall a. Data a => a -> r -- | Generic monadic transformations, -- i.e., take an \"a\" and compute an \"a\" -- type GenericM m = forall a. Data a => a -> m a -- | Generic builders -- i.e., produce an \"a\". -- type GenericB = forall a. Data a => a -- | Generic readers, say monadic builders, -- i.e., produce an \"a\" with the help of a monad \"m\". -- type GenericR m = forall a. Data a => m a -- | The general scheme underlying generic functions -- assumed by gfoldl; there are isomorphisms such as -- GenericT = Generic T. -- type Generic c = forall a. Data a => a -> c a -- | Wrapped generic functions; -- recall: [Generic c] would be legal but [Generic' c] not. -- data Generic' c = Generic' { unGeneric' :: Generic c } -- | Other first-class polymorphic wrappers newtype GenericT' = GT { unGT :: Data a => a -> a } newtype GenericQ' r = GQ { unGQ :: GenericQ r } newtype GenericM' m = GM { unGM :: Data a => a -> m a } -- | Left-biased choice on maybies orElse :: Maybe a -> Maybe a -> Maybe a x `orElse` y = case x of Just _ -> x Nothing -> y {- The following variations take "orElse" to the function level. Furthermore, we generalise from "Maybe" to any "MonadPlus". This makes sense for monadic transformations and queries. We say that the resulting combinators modell choice. We also provide a prime example of choice, that is, recovery from failure. In the case of transformations, we recover via return whereas for queries a given constant is returned. -} -- | Choice for monadic transformations choiceMp :: MonadPlus m => GenericM m -> GenericM m -> GenericM m choiceMp f g x = f x `mplus` g x -- | Choice for monadic queries choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r) choiceQ f g x = f x `mplus` g x -- | Recover from the failure of monadic transformation by identity recoverMp :: MonadPlus m => GenericM m -> GenericM m recoverMp f = f `choiceMp` return -- | Recover from the failure of monadic query by a constant recoverQ :: MonadPlus m => r -> GenericQ (m r) -> GenericQ (m r) recoverQ r f = f `choiceQ` const (return r) ------------------------------------------------------------------------------ -- -- Type extension for unary type constructors -- ------------------------------------------------------------------------------ -- | Flexible type extension ext1 :: (Data a, Typeable1 t) => c a -> (forall a. Data a => c (t a)) -> c a ext1 def ext = maybe def id (dataCast1 ext) -- | Type extension of transformations for unary type constructors ext1T :: (Data d, Typeable1 t) => (forall d. Data d => d -> d) -> (forall d. Data d => t d -> t d) -> d -> d ext1T def ext = unT ((T def) `ext1` (T ext)) -- | Type extension of monadic transformations for type constructors ext1M :: (Monad m, Data d, Typeable1 t) => (forall d. Data d => d -> m d) -> (forall d. Data d => t d -> m (t d)) -> d -> m d ext1M def ext = unM ((M def) `ext1` (M ext)) -- | Type extension of queries for type constructors ext1Q :: (Data d, Typeable1 t) => (d -> q) -> (forall d. Data d => t d -> q) -> d -> q ext1Q def ext = unQ ((Q def) `ext1` (Q ext)) -- | Type extension of readers for type constructors ext1R :: (Monad m, Data d, Typeable1 t) => m d -> (forall d. Data d => m (t d)) -> m d ext1R def ext = unR ((R def) `ext1` (R ext)) ------------------------------------------------------------------------------ -- -- Type constructors for type-level lambdas -- ------------------------------------------------------------------------------ -- | The type constructor for transformations newtype T x = T { unT :: x -> x } -- | The type constructor for transformations newtype M m x = M { unM :: x -> m x } -- | The type constructor for queries newtype Q q x = Q { unQ :: x -> q } -- | The type constructor for readers newtype R m x = R { unR :: m x } hugs98-plus-Sep2006/packages/base/Data/Generics/Basics.hs0000644006511100651110000005516410504340221021625 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Generics.Basics -- Copyright : (c) The University of Glasgow, CWI 2001--2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (local universal quantification) -- -- \"Scrap your boilerplate\" --- Generic programming in Haskell. -- See . This module provides -- the 'Data' class with its primitives for generic programming. -- ----------------------------------------------------------------------------- module Data.Generics.Basics ( -- * Module Data.Typeable re-exported for convenience module Data.Typeable, -- * The Data class for processing constructor applications Data( gfoldl, -- :: ... -> a -> c a gunfold, -- :: ... -> Constr -> c a toConstr, -- :: a -> Constr dataTypeOf, -- :: a -> DataType dataCast1, -- mediate types and unary type constructors dataCast2, -- mediate types and binary type constructors -- Generic maps defined in terms of gfoldl gmapT, gmapQ, gmapQl, gmapQr, gmapQi, gmapM, gmapMp, gmapMo ), -- * Datatype representations DataType, -- abstract, instance of: Show -- ** Constructors mkDataType, -- :: String -> [Constr] -> DataType mkIntType, -- :: String -> DataType mkFloatType, -- :: String -> DataType mkStringType, -- :: String -> DataType mkNorepType, -- :: String -> DataType -- ** Observers dataTypeName, -- :: DataType -> String DataRep(..), -- instance of: Eq, Show dataTypeRep, -- :: DataType -> DataRep -- ** Convenience functions repConstr, -- :: DataType -> ConstrRep -> Constr isAlgType, -- :: DataType -> Bool dataTypeConstrs,-- :: DataType -> [Constr] indexConstr, -- :: DataType -> ConIndex -> Constr maxConstrIndex, -- :: DataType -> ConIndex isNorepType, -- :: DataType -> Bool -- * Data constructor representations Constr, -- abstract, instance of: Eq, Show ConIndex, -- alias for Int, start at 1 Fixity(..), -- instance of: Eq, Show -- ** Constructors mkConstr, -- :: DataType -> String -> Fixity -> Constr mkIntConstr, -- :: DataType -> Integer -> Constr mkFloatConstr, -- :: DataType -> Double -> Constr mkStringConstr, -- :: DataType -> String -> Constr -- ** Observers constrType, -- :: Constr -> DataType ConstrRep(..), -- instance of: Eq, Show constrRep, -- :: Constr -> ConstrRep constrFields, -- :: Constr -> [String] constrFixity, -- :: Constr -> Fixity -- ** Convenience function: algebraic data types constrIndex, -- :: Constr -> ConIndex -- ** From strings to constructors and vice versa: all data types showConstr, -- :: Constr -> String readConstr, -- :: DataType -> String -> Maybe Constr -- * Convenience functions: take type constructors apart tyconUQname, -- :: String -> String tyconModule, -- :: String -> String -- * Generic operations defined in terms of 'gunfold' fromConstr, -- :: Constr -> a fromConstrB, -- :: ... -> Constr -> a fromConstrM -- :: Monad m => ... -> Constr -> m a ) where ------------------------------------------------------------------------------ import Prelude -- necessary to get dependencies right import Data.Typeable import Data.Maybe import Control.Monad ------------------------------------------------------------------------------ -- -- The Data class -- ------------------------------------------------------------------------------ {- | The 'Data' class comprehends a fundamental primitive 'gfoldl' for folding over constructor applications, say terms. This primitive can be instantiated in several ways to map over the immediate subterms of a term; see the @gmap@ combinators later in this class. Indeed, a generic programmer does not necessarily need to use the ingenious gfoldl primitive but rather the intuitive @gmap@ combinators. The 'gfoldl' primitive is completed by means to query top-level constructors, to turn constructor representations into proper terms, and to list all possible datatype constructors. This completion allows us to serve generic programming scenarios like read, show, equality, term generation. The combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with default definitions in terms of 'gfoldl', leaving open the opportunity to provide datatype-specific definitions. (The inclusion of the @gmap@ combinators as members of class 'Data' allows the programmer or the compiler to derive specialised, and maybe more efficient code per datatype. /Note/: 'gfoldl' is more higher-order than the @gmap@ combinators. This is subject to ongoing benchmarking experiments. It might turn out that the @gmap@ combinators will be moved out of the class 'Data'.) Conceptually, the definition of the @gmap@ combinators in terms of the primitive 'gfoldl' requires the identification of the 'gfoldl' function arguments. Technically, we also need to identify the type constructor @c@ for the construction of the result type from the folded term type. In the definition of @gmapQ@/x/ combinators, we use phantom type constructors for the @c@ in the type of 'gfoldl' because the result type of a query does not involve the (polymorphic) type of the term argument. In the definition of 'gmapQl' we simply use the plain constant type constructor because 'gfoldl' is left-associative anyway and so it is readily suited to fold a left-associative binary operation over the immediate subterms. In the definition of gmapQr, extra effort is needed. We use a higher-order accumulation trick to mediate between left-associative constructor application vs. right-associative binary operation (e.g., @(:)@). When the query is meant to compute a value of type @r@, then the result type withing generic folding is @r -> r@. So the result of folding is a function to which we finally pass the right unit. With the @-fglasgow-exts@ option, GHC can generate instances of the 'Data' class automatically. For example, given the declaration > data T a b = C1 a b | C2 deriving (Typeable, Data) GHC will generate an instance that is equivalent to > instance (Data a, Data b) => Data (T a b) where > gfoldl k z (C1 a b) = z C1 `k` a `k` b > gfoldl k z C2 = z C2 > > gunfold k z c = case constrIndex c of > 1 -> k (k (z C1)) > 2 -> z C2 > > toConstr (C1 _ _) = con_C1 > toConstr C2 = con_C2 > > dataTypeOf _ = ty_T > > con_C1 = mkConstr ty_T "C1" [] Prefix > con_C2 = mkConstr ty_T "C2" [] Prefix > ty_T = mkDataType "Module.T" [con_C1, con_C2] This is suitable for datatypes that are exported transparently. -} class Typeable a => Data a where -- | Left-associative fold operation for constructor applications. -- -- The type of 'gfoldl' is a headache, but operationally it is a simple -- generalisation of a list fold. -- -- The default definition for 'gfoldl' is @'const' 'id'@, which is -- suitable for abstract datatypes with no substructures. gfoldl :: (forall a b. Data a => c (a -> b) -> a -> c b) -- ^ defines how nonempty constructor applications are -- folded. It takes the folded tail of the constructor -- application and its head, i.e., an immediate subterm, -- and combines them in some way. -> (forall g. g -> c g) -- ^ defines how the empty constructor application is -- folded, like the neutral \/ start element for list -- folding. -> a -- ^ structure to be folded. -> c a -- ^ result, with a type defined in terms of @a@, but -- variability is achieved by means of type constructor -- @c@ for the construction of the actual result type. -- See the 'Data' instances in this file for an illustration of 'gfoldl'. gfoldl _ z = z -- | Unfolding constructor applications gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a -- | Obtaining the constructor from a given datum. -- For proper terms, this is meant to be the top-level constructor. -- Primitive datatypes are here viewed as potentially infinite sets of -- values (i.e., constructors). toConstr :: a -> Constr -- | The outer type constructor of the type dataTypeOf :: a -> DataType ------------------------------------------------------------------------------ -- -- Mediate types and type constructors -- ------------------------------------------------------------------------------ -- | Mediate types and unary type constructors. -- In 'Data' instances of the form @T a@, 'dataCast1' should be defined -- as 'gcast1'. -- -- The default definition is @'const' 'Nothing'@, which is appropriate -- for non-unary type constructors. dataCast1 :: Typeable1 t => (forall a. Data a => c (t a)) -> Maybe (c a) dataCast1 _ = Nothing -- | Mediate types and binary type constructors. -- In 'Data' instances of the form @T a b@, 'dataCast2' should be -- defined as 'gcast2'. -- -- The default definition is @'const' 'Nothing'@, which is appropriate -- for non-binary type constructors. dataCast2 :: Typeable2 t => (forall a b. (Data a, Data b) => c (t a b)) -> Maybe (c a) dataCast2 _ = Nothing ------------------------------------------------------------------------------ -- -- Typical generic maps defined in terms of gfoldl -- ------------------------------------------------------------------------------ -- | A generic transformation that maps over the immediate subterms -- -- The default definition instantiates the type constructor @c@ in the -- type of 'gfoldl' to an identity datatype constructor, using the -- isomorphism pair as injection and projection. gmapT :: (forall b. Data b => b -> b) -> a -> a -- Use an identity datatype constructor ID (see below) -- to instantiate the type constructor c in the type of gfoldl, -- and perform injections ID and projections unID accordingly. -- gmapT f x = unID (gfoldl k ID x) where k (ID c) x = ID (c (f x)) -- | A generic query with a left-associative binary operator gmapQl :: (r -> r' -> r) -> r -> (forall a. Data a => a -> r') -> a -> r gmapQl o r f = unCONST . gfoldl k z where k c x = CONST $ (unCONST c) `o` f x z _ = CONST r -- | A generic query with a right-associative binary operator gmapQr :: (r' -> r -> r) -> r -> (forall a. Data a => a -> r') -> a -> r gmapQr o r f x = unQr (gfoldl k (const (Qr id)) x) r where k (Qr c) x = Qr (\r -> c (f x `o` r)) -- | A generic query that processes the immediate subterms and returns a list gmapQ :: (forall a. Data a => a -> u) -> a -> [u] gmapQ f = gmapQr (:) [] f -- | A generic query that processes one child by index (zero-based) gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q } where k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q) z f = Qi 0 Nothing -- | A generic monadic transformation that maps over the immediate subterms -- -- The default definition instantiates the type constructor @c@ in -- the type of 'gfoldl' to the monad datatype constructor, defining -- injection and projection using 'return' and '>>='. gmapM :: Monad m => (forall a. Data a => a -> m a) -> a -> m a -- Use immediately the monad datatype constructor -- to instantiate the type constructor c in the type of gfoldl, -- so injection and projection is done by return and >>=. -- gmapM f = gfoldl k return where k c x = do c' <- c x' <- f x return (c' x') -- | Transformation of at least one immediate subterm does not fail gmapMp :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a {- The type constructor that we use here simply keeps track of the fact if we already succeeded for an immediate subterm; see Mp below. To this end, we couple the monadic computation with a Boolean. -} gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) -> if b then return x' else mzero where z g = Mp (return (g,False)) k (Mp c) x = Mp ( c >>= \(h,b) -> (f x >>= \x' -> return (h x',True)) `mplus` return (h x,b) ) -- | Transformation of one immediate subterm with success gmapMo :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a {- We use the same pairing trick as for gmapMp, i.e., we use an extra Bool component to keep track of the fact whether an immediate subterm was processed successfully. However, we cut of mapping over subterms once a first subterm was transformed successfully. -} gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) -> if b then return x' else mzero where z g = Mp (return (g,False)) k (Mp c) x = Mp ( c >>= \(h,b) -> if b then return (h x,b) else (f x >>= \x' -> return (h x',True)) `mplus` return (h x,b) ) -- | The identity type constructor needed for the definition of gmapT newtype ID x = ID { unID :: x } -- | The constant type constructor needed for the definition of gmapQl newtype CONST c a = CONST { unCONST :: c } -- | Type constructor for adding counters to queries data Qi q a = Qi Int (Maybe q) -- | The type constructor used in definition of gmapQr newtype Qr r a = Qr { unQr :: r -> r } -- | The type constructor used in definition of gmapMp newtype Mp m x = Mp { unMp :: m (x, Bool) } ------------------------------------------------------------------------------ -- -- Generic unfolding -- ------------------------------------------------------------------------------ -- | Build a term skeleton fromConstr :: Data a => Constr -> a fromConstr = fromConstrB undefined -- | Build a term and use a generic function for subterms fromConstrB :: Data a => (forall a. Data a => a) -> Constr -> a fromConstrB f = unID . gunfold k z where k c = ID (unID c f) z = ID -- | Monadic variation on 'fromConstrB' fromConstrM :: (Monad m, Data a) => (forall a. Data a => m a) -> Constr -> m a fromConstrM f = gunfold k z where k c = do { c' <- c; b <- f; return (c' b) } z = return ------------------------------------------------------------------------------ -- -- Datatype and constructor representations -- ------------------------------------------------------------------------------ -- -- | Representation of datatypes. -- A package of constructor representations with names of type and module. -- data DataType = DataType { tycon :: String , datarep :: DataRep } deriving Show -- | Representation of constructors data Constr = Constr { conrep :: ConstrRep , constring :: String , confields :: [String] -- for AlgRep only , confixity :: Fixity -- for AlgRep only , datatype :: DataType } instance Show Constr where show = constring -- | Equality of constructors instance Eq Constr where c == c' = constrRep c == constrRep c' -- | Public representation of datatypes data DataRep = AlgRep [Constr] | IntRep | FloatRep | StringRep | NoRep deriving (Eq,Show) -- The list of constructors could be an array, a balanced tree, or others. -- | Public representation of constructors data ConstrRep = AlgConstr ConIndex | IntConstr Integer | FloatConstr Double | StringConstr String deriving (Eq,Show) -- | Unique index for datatype constructors, -- counting from 1 in the order they are given in the program text. type ConIndex = Int -- | Fixity of constructors data Fixity = Prefix | Infix -- Later: add associativity and precedence deriving (Eq,Show) ------------------------------------------------------------------------------ -- -- Observers for datatype representations -- ------------------------------------------------------------------------------ -- | Gets the type constructor including the module dataTypeName :: DataType -> String dataTypeName = tycon -- | Gets the public presentation of a datatype dataTypeRep :: DataType -> DataRep dataTypeRep = datarep -- | Gets the datatype of a constructor constrType :: Constr -> DataType constrType = datatype -- | Gets the public presentation of constructors constrRep :: Constr -> ConstrRep constrRep = conrep -- | Look up a constructor by its representation repConstr :: DataType -> ConstrRep -> Constr repConstr dt cr = case (dataTypeRep dt, cr) of (AlgRep cs, AlgConstr i) -> cs !! (i-1) (IntRep, IntConstr i) -> mkIntConstr dt i (FloatRep, FloatConstr f) -> mkFloatConstr dt f (StringRep, StringConstr str) -> mkStringConstr dt str _ -> error "repConstr" ------------------------------------------------------------------------------ -- -- Representations of algebraic data types -- ------------------------------------------------------------------------------ -- | Constructs an algebraic datatype mkDataType :: String -> [Constr] -> DataType mkDataType str cs = DataType { tycon = str , datarep = AlgRep cs } -- | Constructs a constructor mkConstr :: DataType -> String -> [String] -> Fixity -> Constr mkConstr dt str fields fix = Constr { conrep = AlgConstr idx , constring = str , confields = fields , confixity = fix , datatype = dt } where idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..], showConstr c == str ] -- | Gets the constructors of an algebraic datatype dataTypeConstrs :: DataType -> [Constr] dataTypeConstrs dt = case datarep dt of (AlgRep cons) -> cons _ -> error "dataTypeConstrs" -- | Gets the field labels of a constructor constrFields :: Constr -> [String] constrFields = confields -- | Gets the fixity of a constructor constrFixity :: Constr -> Fixity constrFixity = confixity ------------------------------------------------------------------------------ -- -- From strings to constr's and vice versa: all data types -- ------------------------------------------------------------------------------ -- | Gets the string for a constructor showConstr :: Constr -> String showConstr = constring -- | Lookup a constructor via a string readConstr :: DataType -> String -> Maybe Constr readConstr dt str = case dataTypeRep dt of AlgRep cons -> idx cons IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i))) FloatRep -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f))) StringRep -> Just (mkStringConstr dt str) NoRep -> Nothing where -- Read a value and build a constructor mkReadCon :: Read t => (t -> Constr) -> Maybe Constr mkReadCon f = case (reads str) of [(t,"")] -> Just (f t) _ -> Nothing -- Traverse list of algebraic datatype constructors idx :: [Constr] -> Maybe Constr idx cons = let fit = filter ((==) str . showConstr) cons in if fit == [] then Nothing else Just (head fit) ------------------------------------------------------------------------------ -- -- Convenience funtions: algebraic data types -- ------------------------------------------------------------------------------ -- | Test for an algebraic type isAlgType :: DataType -> Bool isAlgType dt = case datarep dt of (AlgRep _) -> True _ -> False -- | Gets the constructor for an index (algebraic datatypes only) indexConstr :: DataType -> ConIndex -> Constr indexConstr dt idx = case datarep dt of (AlgRep cs) -> cs !! (idx-1) _ -> error "indexConstr" -- | Gets the index of a constructor (algebraic datatypes only) constrIndex :: Constr -> ConIndex constrIndex con = case constrRep con of (AlgConstr idx) -> idx _ -> error "constrIndex" -- | Gets the maximum constructor index of an algebraic datatype maxConstrIndex :: DataType -> ConIndex maxConstrIndex dt = case dataTypeRep dt of AlgRep cs -> length cs _ -> error "maxConstrIndex" ------------------------------------------------------------------------------ -- -- Representation of primitive types -- ------------------------------------------------------------------------------ -- | Constructs the 'Int' type mkIntType :: String -> DataType mkIntType = mkPrimType IntRep -- | Constructs the 'Float' type mkFloatType :: String -> DataType mkFloatType = mkPrimType FloatRep -- | Constructs the 'String' type mkStringType :: String -> DataType mkStringType = mkPrimType StringRep -- | Helper for 'mkIntType', 'mkFloatType', 'mkStringType' mkPrimType :: DataRep -> String -> DataType mkPrimType dr str = DataType { tycon = str , datarep = dr } -- Makes a constructor for primitive types mkPrimCon :: DataType -> String -> ConstrRep -> Constr mkPrimCon dt str cr = Constr { datatype = dt , conrep = cr , constring = str , confields = error "constrFields" , confixity = error "constrFixity" } mkIntConstr :: DataType -> Integer -> Constr mkIntConstr dt i = case datarep dt of IntRep -> mkPrimCon dt (show i) (IntConstr i) _ -> error "mkIntConstr" mkFloatConstr :: DataType -> Double -> Constr mkFloatConstr dt f = case datarep dt of FloatRep -> mkPrimCon dt (show f) (FloatConstr f) _ -> error "mkFloatConstr" mkStringConstr :: DataType -> String -> Constr mkStringConstr dt str = case datarep dt of StringRep -> mkPrimCon dt str (StringConstr str) _ -> error "mkStringConstr" ------------------------------------------------------------------------------ -- -- Non-representations for non-presentable types -- ------------------------------------------------------------------------------ -- | Constructs a non-representation for a non-presentable type mkNorepType :: String -> DataType mkNorepType str = DataType { tycon = str , datarep = NoRep } -- | Test for a non-representable type isNorepType :: DataType -> Bool isNorepType dt = case datarep dt of NoRep -> True _ -> False ------------------------------------------------------------------------------ -- -- Convenience for qualified type constructors -- ------------------------------------------------------------------------------ -- | Gets the unqualified type constructor: -- drop *.*.*... before name -- tyconUQname :: String -> String tyconUQname x = let x' = dropWhile (not . (==) '.') x in if x' == [] then x else tyconUQname (tail x') -- | Gets the module of a type constructor: -- take *.*.*... before name tyconModule :: String -> String tyconModule x = let (a,b) = break ((==) '.') x in if b == "" then b else a ++ tyconModule' (tail b) where tyconModule' x = let x' = tyconModule x in if x' == "" then "" else ('.':x') hugs98-plus-Sep2006/packages/base/Data/Generics/Schemes.hs0000644006511100651110000001135110504340221021776 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Generics.Schemes -- Copyright : (c) The University of Glasgow, CWI 2001--2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (local universal quantification) -- -- \"Scrap your boilerplate\" --- Generic programming in Haskell -- See . The present module provides -- frequently used generic traversal schemes. -- ----------------------------------------------------------------------------- module Data.Generics.Schemes ( everywhere, everywhere', everywhereBut, everywhereM, somewhere, everything, listify, something, synthesize, gsize, glength, gdepth, gcount, gnodecount, gtypecount, gfindtype ) where ------------------------------------------------------------------------------ #ifdef __HADDOCK__ import Prelude #endif import Data.Generics.Basics import Data.Generics.Aliases import Control.Monad -- | Apply a transformation everywhere in bottom-up manner everywhere :: (forall a. Data a => a -> a) -> (forall a. Data a => a -> a) -- Use gmapT to recurse into immediate subterms; -- recall: gmapT preserves the outermost constructor; -- post-process recursively transformed result via f -- everywhere f = f . gmapT (everywhere f) -- | Apply a transformation everywhere in top-down manner everywhere' :: (forall a. Data a => a -> a) -> (forall a. Data a => a -> a) -- Arguments of (.) are flipped compared to everywhere everywhere' f = gmapT (everywhere' f) . f -- | Variation on everywhere with an extra stop condition everywhereBut :: GenericQ Bool -> GenericT -> GenericT -- Guarded to let traversal cease if predicate q holds for x everywhereBut q f x | q x = x | otherwise = f (gmapT (everywhereBut q f) x) -- | Monadic variation on everywhere everywhereM :: Monad m => GenericM m -> GenericM m -- Bottom-up order is also reflected in order of do-actions everywhereM f x = do x' <- gmapM (everywhereM f) x f x' -- | Apply a monadic transformation at least somewhere somewhere :: MonadPlus m => GenericM m -> GenericM m -- We try "f" in top-down manner, but descent into "x" when we fail -- at the root of the term. The transformation fails if "f" fails -- everywhere, say succeeds nowhere. -- somewhere f x = f x `mplus` gmapMp (somewhere f) x -- | Summarise all nodes in top-down, left-to-right order everything :: (r -> r -> r) -> GenericQ r -> GenericQ r -- Apply f to x to summarise top-level node; -- use gmapQ to recurse into immediate subterms; -- use ordinary foldl to reduce list of intermediate results -- everything k f x = foldl k (f x) (gmapQ (everything k f) x) -- | Get a list of all entities that meet a predicate listify :: Typeable r => (r -> Bool) -> GenericQ [r] listify p = everything (++) ([] `mkQ` (\x -> if p x then [x] else [])) -- | Look up a subterm by means of a maybe-typed filter something :: GenericQ (Maybe u) -> GenericQ (Maybe u) -- "something" can be defined in terms of "everything" -- when a suitable "choice" operator is used for reduction -- something = everything orElse -- | Bottom-up synthesis of a data structure; -- 1st argument z is the initial element for the synthesis; -- 2nd argument o is for reduction of results from subterms; -- 3rd argument f updates the synthesised data according to the given term -- synthesize :: s -> (s -> s -> s) -> GenericQ (s -> s) -> GenericQ s synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x)) -- | Compute size of an arbitrary data structure gsize :: Data a => a -> Int gsize t = 1 + sum (gmapQ gsize t) -- | Count the number of immediate subterms of the given term glength :: GenericQ Int glength = length . gmapQ (const ()) -- | Determine depth of the given term gdepth :: GenericQ Int gdepth = (+) 1 . foldr max 0 . gmapQ gdepth -- | Determine the number of all suitable nodes in a given term gcount :: GenericQ Bool -> GenericQ Int gcount p = everything (+) (\x -> if p x then 1 else 0) -- | Determine the number of all nodes in a given term gnodecount :: GenericQ Int gnodecount = gcount (const True) -- | Determine the number of nodes of a given type in a given term gtypecount :: Typeable a => a -> GenericQ Int gtypecount (_::a) = gcount (False `mkQ` (\(_::a) -> True)) -- | Find (unambiguously) an immediate subterm of a given type gfindtype :: (Data x, Typeable y) => x -> Maybe y gfindtype = singleton . foldl unJust [] . gmapQ (Nothing `mkQ` Just) where unJust l (Just x) = x:l unJust l Nothing = l singleton [s] = Just s singleton _ = Nothing hugs98-plus-Sep2006/packages/base/Data/Generics/Text.hs0000644006511100651110000000704710504340221021342 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Generics.Text -- Copyright : (c) The University of Glasgow, CWI 2001--2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Generics.Basics) -- -- \"Scrap your boilerplate\" --- Generic programming in Haskell -- See . The present module provides -- generic operations for text serialisation of terms. -- ----------------------------------------------------------------------------- module Data.Generics.Text ( gshow, gread ) where ------------------------------------------------------------------------------ #ifdef __HADDOCK__ import Prelude #endif import Control.Monad import Data.Maybe import Data.Generics.Basics import Data.Generics.Aliases import Text.ParserCombinators.ReadP ------------------------------------------------------------------------------ -- | Generic show: an alternative to \"deriving Show\" gshow :: Data a => a -> String -- This is a prefix-show using surrounding "(" and ")", -- where we recurse into subterms with gmapQ. -- gshow = ( \t -> "(" ++ showConstr (toConstr t) ++ concat (gmapQ ((++) " " . gshow) t) ++ ")" ) `extQ` (show :: String -> String) -- | Generic read: an alternative to \"deriving Read\" gread :: Data a => ReadS a {- This is a read operation which insists on prefix notation. (The Haskell 98 read deals with infix operators subject to associativity and precedence as well.) We use fromConstrM to "parse" the input. To be precise, fromConstrM is used for all types except String. The type-specific case for String uses basic String read. -} gread = readP_to_S gread' where -- Helper for recursive read gread' :: Data a' => ReadP a' gread' = allButString `extR` stringCase where -- A specific case for strings stringCase :: ReadP String stringCase = readS_to_P reads -- Determine result type myDataType = dataTypeOf (getArg allButString) where getArg :: ReadP a'' -> a'' getArg = undefined -- The generic default for gread allButString = do -- Drop " ( " skipSpaces -- Discard leading space char '(' -- Parse '(' skipSpaces -- Discard following space -- Do the real work str <- parseConstr -- Get a lexeme for the constructor con <- str2con str -- Convert it to a Constr (may fail) x <- fromConstrM gread' con -- Read the children -- Drop " ) " skipSpaces -- Discard leading space char ')' -- Parse ')' skipSpaces -- Discard following space return x -- Turn string into constructor driven by the requested result type, -- failing in the monad if it isn't a constructor of this data type str2con :: String -> ReadP Constr str2con = maybe mzero return . readConstr myDataType -- Get a Constr's string at the front of an input string parseConstr :: ReadP String parseConstr = string "[]" -- Compound lexeme "[]" <++ infixOp -- Infix operator in parantheses <++ readS_to_P lex -- Ordinary constructors and literals -- Handle infix operators such as (:) infixOp :: ReadP String infixOp = do c1 <- char '(' str <- munch1 (not . (==) ')') c2 <- char ')' return $ [c1] ++ str ++ [c2] hugs98-plus-Sep2006/packages/base/Data/Generics/Twins.hs0000644006511100651110000001570110504340221021516 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Generics.Twins -- Copyright : (c) The University of Glasgow, CWI 2001--2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (local universal quantification) -- -- \"Scrap your boilerplate\" --- Generic programming in Haskell -- See . The present module -- provides support for multi-parameter traversal, which is also -- demonstrated with generic operations like equality. -- ----------------------------------------------------------------------------- module Data.Generics.Twins ( -- * Generic folds and maps that also accumulate gfoldlAccum, gmapAccumT, gmapAccumM, gmapAccumQl, gmapAccumQr, gmapAccumQ, -- * Mapping combinators for twin traversal gzipWithT, gzipWithM, gzipWithQ, -- * Typical twin traversals geq, gzip ) where ------------------------------------------------------------------------------ #ifdef __HADDOCK__ import Prelude #endif import Data.Generics.Basics import Data.Generics.Aliases #ifdef __GLASGOW_HASKELL__ import Prelude hiding ( GT ) #endif ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- -- Generic folds and maps that also accumulate -- ------------------------------------------------------------------------------ {-------------------------------------------------------------- A list map can be elaborated to perform accumulation. In the same sense, we can elaborate generic maps over terms. We recall the type of map: map :: (a -> b) -> [a] -> [b] We recall the type of an accumulating map (see Data.List): mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c]) Applying the same scheme we obtain an accumulating gfoldl. --------------------------------------------------------------} -- | gfoldl with accumulation gfoldlAccum :: Data d => (forall d r. Data d => a -> c (d -> r) -> d -> (a, c r)) -> (forall g. a -> g -> (a, c g)) -> a -> d -> (a, c d) gfoldlAccum k z a d = unA (gfoldl k' z' d) a where k' c y = A (\a -> let (a', c') = unA c a in k a' c' y) z' f = A (\a -> z a f) -- | A type constructor for accumulation newtype A a c d = A { unA :: a -> (a, c d) } -- | gmapT with accumulation gmapAccumT :: Data d => (forall d. Data d => a -> d -> (a,d)) -> a -> d -> (a, d) gmapAccumT f a d = let (a',d') = gfoldlAccum k z a d in (a',unID d') where k a (ID c) d = let (a',d') = f a d in (a', ID (c d')) z a x = (a, ID x) -- | gmapM with accumulation gmapAccumM :: (Data d, Monad m) => (forall d. Data d => a -> d -> (a, m d)) -> a -> d -> (a, m d) gmapAccumM f = gfoldlAccum k z where k a c d = let (a',d') = f a d in (a', d' >>= \d'' -> c >>= \c' -> return (c' d'')) z a x = (a, return x) -- | gmapQl with accumulation gmapAccumQl :: Data d => (r -> r' -> r) -> r -> (forall d. Data d => a -> d -> (a,r')) -> a -> d -> (a, r) gmapAccumQl o r f a d = let (a',r) = gfoldlAccum k z a d in (a',unCONST r) where k a (CONST c) d = let (a',r') = f a d in (a', CONST (c `o` r')) z a _ = (a, CONST r) -- | gmapQr with accumulation gmapAccumQr :: Data d => (r' -> r -> r) -> r -> (forall d. Data d => a -> d -> (a,r')) -> a -> d -> (a, r) gmapAccumQr o r f a d = let (a',l) = gfoldlAccum k z a d in (a',unQr l r) where k a (Qr c) d = let (a',r') = f a d in (a', Qr (\r -> c (r' `o` r))) z a _ = (a, Qr id) -- | gmapQ with accumulation gmapAccumQ :: Data d => (forall d. Data d => a -> d -> (a,q)) -> a -> d -> (a, [q]) gmapAccumQ f = gmapAccumQr (:) [] f ------------------------------------------------------------------------------ -- -- Helper type constructors -- ------------------------------------------------------------------------------ -- | The identity type constructor needed for the definition of gmapAccumT newtype ID x = ID { unID :: x } -- | The constant type constructor needed for the definition of gmapAccumQl newtype CONST c a = CONST { unCONST :: c } -- | The type constructor needed for the definition of gmapAccumQr newtype Qr r a = Qr { unQr :: r -> r } ------------------------------------------------------------------------------ -- -- Mapping combinators for twin traversal -- ------------------------------------------------------------------------------ -- | Twin map for transformation gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT) gzipWithT f x y = case gmapAccumT perkid funs y of ([], c) -> c _ -> error "gzipWithT" where perkid a d = (tail a, unGT (head a) d) funs = gmapQ (\k -> GT (f k)) x -- | Twin map for monadic transformation gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m) gzipWithM f x y = case gmapAccumM perkid funs y of ([], c) -> c _ -> error "gzipWithM" where perkid a d = (tail a, unGM (head a) d) funs = gmapQ (\k -> GM (f k)) x -- | Twin map for queries gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r]) gzipWithQ f x y = case gmapAccumQ perkid funs y of ([], r) -> r _ -> error "gzipWithQ" where perkid a d = (tail a, unGQ (head a) d) funs = gmapQ (\k -> GQ (f k)) x ------------------------------------------------------------------------------ -- -- Typical twin traversals -- ------------------------------------------------------------------------------ -- | Generic equality: an alternative to \"deriving Eq\" geq :: Data a => a -> a -> Bool {- Testing for equality of two terms goes like this. Firstly, we establish the equality of the two top-level datatype constructors. Secondly, we use a twin gmap combinator, namely tgmapQ, to compare the two lists of immediate subterms. (Note for the experts: the type of the worker geq' is rather general but precision is recovered via the restrictive type of the top-level operation geq. The imprecision of geq' is caused by the type system's unability to express the type equivalence for the corresponding couples of immediate subterms from the two given input terms.) -} geq x y = geq' x y where geq' :: GenericQ (GenericQ Bool) geq' x y = (toConstr x == toConstr y) && and (gzipWithQ geq' x y) -- | Generic zip controlled by a function with type-specific branches gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe) -- See testsuite/.../Generics/gzip.hs for an illustration gzip f x y = f x y `orElse` if toConstr x == toConstr y then gzipWithM (gzip f) x y else Nothing hugs98-plus-Sep2006/packages/base/Data/Foldable.hs0000644006511100651110000002206710504340226020373 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Foldable -- Copyright : Ross Paterson 2005 -- License : BSD-style (see the LICENSE file in the distribution) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- Class of data structures that can be folded to a summary value. -- -- Many of these functions generalize "Prelude", "Control.Monad" and -- "Data.List" functions of the same names from lists to any 'Foldable' -- functor. To avoid ambiguity, either import those modules hiding -- these names or qualify uses of these function names with an alias -- for this module. module Data.Foldable ( -- * Folds Foldable(..), -- ** Special biased folds foldr', foldl', foldrM, foldlM, -- ** Folding actions -- *** Applicative actions traverse_, for_, sequenceA_, asum, -- *** Monadic actions mapM_, forM_, sequence_, msum, -- ** Specialized folds toList, concat, concatMap, and, or, any, all, sum, product, maximum, maximumBy, minimum, minimumBy, -- ** Searches elem, notElem, find ) where import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_, elem, notElem, concat, concatMap, and, or, any, all, sum, product, maximum, minimum) import qualified Prelude (foldl, foldr, foldl1, foldr1) import Control.Applicative import Control.Monad (MonadPlus(..)) import Data.Maybe (fromMaybe, listToMaybe) import Data.Monoid import Data.Array #ifdef __NHC__ import Control.Arrow (ArrowZero(..)) -- work around nhc98 typechecker problem #endif #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) #endif -- | Data structures that can be folded. -- -- Minimal complete definition: 'foldMap' or 'foldr'. -- -- For example, given a data type -- -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) -- -- a suitable instance would be -- -- > instance Foldable Tree -- > foldMap f Empty = mempty -- > foldMap f (Leaf x) = f x -- > foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r -- -- This is suitable even for abstract types, as the monoid is assumed -- to satisfy the monoid laws. -- class Foldable t where -- | Combine the elements of a structure using a monoid. fold :: Monoid m => t m -> m fold = foldMap id -- | Map each element of the structure to a monoid, -- and combine the results. foldMap :: Monoid m => (a -> m) -> t a -> m foldMap f = foldr (mappend . f) mempty -- | Right-associative fold of a structure. -- -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@ foldr :: (a -> b -> b) -> b -> t a -> b foldr f z t = appEndo (foldMap (Endo . f) t) z -- | Left-associative fold of a structure. -- -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@ foldl :: (a -> b -> a) -> a -> t b -> a foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z -- | A variant of 'foldr' that has no base case, -- and thus may only be applied to non-empty structures. -- -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@ foldr1 :: (a -> a -> a) -> t a -> a foldr1 f xs = fromMaybe (error "foldr1: empty structure") (foldr mf Nothing xs) where mf x Nothing = Just x mf x (Just y) = Just (f x y) -- | A variant of 'foldl' that has no base case, -- and thus may only be applied to non-empty structures. -- -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@ foldl1 :: (a -> a -> a) -> t a -> a foldl1 f xs = fromMaybe (error "foldl1: empty structure") (foldl mf Nothing xs) where mf Nothing y = Just y mf (Just x) y = Just (f x y) -- instances for Prelude types instance Foldable Maybe where foldr f z Nothing = z foldr f z (Just x) = f x z foldl f z Nothing = z foldl f z (Just x) = f z x instance Foldable [] where foldr = Prelude.foldr foldl = Prelude.foldl foldr1 = Prelude.foldr1 foldl1 = Prelude.foldl1 instance Ix i => Foldable (Array i) where foldr f z = Prelude.foldr f z . elems -- | Fold over the elements of a structure, -- associating to the right, but strictly. foldr' :: Foldable t => (a -> b -> b) -> b -> t a -> b foldr' f z xs = foldl f' id xs z where f' k x z = k $! f x z -- | Monadic fold over the elements of a structure, -- associating to the right, i.e. from right to left. foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b foldrM f z xs = foldl f' return xs z where f' k x z = f x z >>= k -- | Fold over the elements of a structure, -- associating to the left, but strictly. foldl' :: Foldable t => (a -> b -> a) -> a -> t b -> a foldl' f z xs = foldr f' id xs z where f' x k z = k $! f z x -- | Monadic fold over the elements of a structure, -- associating to the left, i.e. from left to right. foldlM :: (Foldable t, Monad m) => (a -> b -> m a) -> a -> t b -> m a foldlM f z xs = foldr f' return xs z where f' x k z = f z x >>= k -- | Map each element of a structure to an action, evaluate -- these actions from left to right, and ignore the results. traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ f = foldr ((*>) . f) (pure ()) -- | 'for_' is 'traverse_' with its arguments flipped. for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f () {-# INLINE for_ #-} for_ = flip traverse_ -- | Map each element of a structure to an monadic action, evaluate -- these actions from left to right, and ignore the results. mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ f = foldr ((>>) . f) (return ()) -- | 'forM_' is 'mapM_' with its arguments flipped. forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m () {-# INLINE forM_ #-} forM_ = flip mapM_ -- | Evaluate each action in the structure from left to right, -- and ignore the results. sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f () sequenceA_ = foldr (*>) (pure ()) -- | Evaluate each monadic action in the structure from left to right, -- and ignore the results. sequence_ :: (Foldable t, Monad m) => t (m a) -> m () sequence_ = foldr (>>) (return ()) -- | The sum of a collection of actions, generalizing 'concat'. asum :: (Foldable t, Alternative f) => t (f a) -> f a {-# INLINE asum #-} asum = foldr (<|>) empty -- | The sum of a collection of actions, generalizing 'concat'. msum :: (Foldable t, MonadPlus m) => t (m a) -> m a {-# INLINE msum #-} msum = foldr mplus mzero -- These use foldr rather than foldMap to avoid repeated concatenation. -- | List of elements of a structure. toList :: Foldable t => t a -> [a] #ifdef __GLASGOW_HASKELL__ toList t = build (\ c n -> foldr c n t) #else toList = foldr (:) [] #endif -- | The concatenation of all the elements of a container of lists. concat :: Foldable t => t [a] -> [a] concat = fold -- | Map a function over all the elements of a container and concatenate -- the resulting lists. concatMap :: Foldable t => (a -> [b]) -> t a -> [b] concatMap = foldMap -- | 'and' returns the conjunction of a container of Bools. For the -- result to be 'True', the container must be finite; 'False', however, -- results from a 'False' value finitely far from the left end. and :: Foldable t => t Bool -> Bool and = getAll . foldMap All -- | 'or' returns the disjunction of a container of Bools. For the -- result to be 'False', the container must be finite; 'True', however, -- results from a 'True' value finitely far from the left end. or :: Foldable t => t Bool -> Bool or = getAny . foldMap Any -- | Determines whether any element of the structure satisfies the predicate. any :: Foldable t => (a -> Bool) -> t a -> Bool any p = getAny . foldMap (Any . p) -- | Determines whether all elements of the structure satisfy the predicate. all :: Foldable t => (a -> Bool) -> t a -> Bool all p = getAll . foldMap (All . p) -- | The 'sum' function computes the sum of the numbers of a structure. sum :: (Foldable t, Num a) => t a -> a sum = getSum . foldMap Sum -- | The 'product' function computes the product of the numbers of a structure. product :: (Foldable t, Num a) => t a -> a product = getProduct . foldMap Product -- | The largest element of a non-empty structure. maximum :: (Foldable t, Ord a) => t a -> a maximum = foldr1 max -- | The largest element of a non-empty structure with respect to the -- given comparison function. maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a maximumBy cmp = foldr1 max' where max' x y = case cmp x y of GT -> x _ -> y -- | The least element of a non-empty structure. minimum :: (Foldable t, Ord a) => t a -> a minimum = foldr1 min -- | The least element of a non-empty structure with respect to the -- given comparison function. minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a minimumBy cmp = foldr1 min' where min' x y = case cmp x y of GT -> y _ -> x -- | Does the element occur in the structure? elem :: (Foldable t, Eq a) => a -> t a -> Bool elem = any . (==) -- | 'notElem' is the negation of 'elem'. notElem :: (Foldable t, Eq a) => a -> t a -> Bool notElem x = not . elem x -- | The 'find' function takes a predicate and a structure and returns -- the leftmost element of the structure matching the predicate, or -- 'Nothing' if there is no such element. find :: Foldable t => (a -> Bool) -> t a -> Maybe a find p = listToMaybe . concatMap (\ x -> if p x then [x] else []) hugs98-plus-Sep2006/packages/base/Data/FunctorM.hs0000644006511100651110000000251010504340222020403 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.FunctorM -- Copyright : (c) The University of Glasgow 2005 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- fmapM generalises fmap, just as mapM generalises map. -- -- NOTE: This module is DEPRECATED. -- The classes in "Data.Foldable" and "Data.Traversable" provide a -- more general interface. -- ----------------------------------------------------------------------------- module Data.FunctorM {-# DEPRECATED "Use the more general Data.Foldable and Data.Traversable instead" #-} (FunctorM(..)) where import Prelude import Data.Array class FunctorM f where fmapM :: Monad m => (a -> m b) -> f a -> m (f b) fmapM_ :: Monad m => (a -> m b) -> f a -> m () fmapM_ f t = fmapM f t >> return () instance FunctorM [] where fmapM = mapM fmapM_ = mapM_ instance FunctorM Maybe where fmapM _ Nothing = return Nothing fmapM f (Just x) = f x >>= return . Just fmapM_ _ Nothing = return () fmapM_ f (Just x) = f x >> return () instance Ix i => FunctorM (Array i) where fmapM f a = do a' <- sequence [ f e >>= return . (,) i | (i,e) <- assocs a] return (array (bounds a) a') hugs98-plus-Sep2006/packages/base/Data/PackedString.hs0000644006511100651110000003776510504340224021252 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.PackedString -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- This API is deprecated. You might be able to use "Data.ByteString" -- or "Data.ByteString.Char8", provided you don't need full Unicode support. -- The long term aim is to provide a Unicode layer on "Data.ByteString", -- and then to provide a replacement for this "Data.PackedString" API based on -- that. -- ----------------------------------------------------------------------------- -- Original GHC implementation by Bryan O\'Sullivan, -- rewritten to use UArray by Simon Marlow. module Data.PackedString {-# DEPRECATED "use Data.ByteString, Data.ByteString.Char8, or plain String." #-} ( -- * The @PackedString@ type PackedString, -- abstract, instances: Eq, Ord, Show, Typeable -- * Converting to and from @PackedString@s packString, -- :: String -> PackedString unpackPS, -- :: PackedString -> String #ifndef __NHC__ -- * I\/O with @PackedString@s hPutPS, -- :: Handle -> PackedString -> IO () hGetPS, -- :: Handle -> Int -> IO PackedString #endif -- * List-like manipulation functions nilPS, -- :: PackedString consPS, -- :: Char -> PackedString -> PackedString headPS, -- :: PackedString -> Char tailPS, -- :: PackedString -> PackedString nullPS, -- :: PackedString -> Bool appendPS, -- :: PackedString -> PackedString -> PackedString lengthPS, -- :: PackedString -> Int indexPS, -- :: PackedString -> Int -> Char mapPS, -- :: (Char -> Char) -> PackedString -> PackedString filterPS, -- :: (Char -> Bool) -> PackedString -> PackedString reversePS, -- :: PackedString -> PackedString concatPS, -- :: [PackedString] -> PackedString elemPS, -- :: Char -> PackedString -> Bool substrPS, -- :: PackedString -> Int -> Int -> PackedString takePS, -- :: Int -> PackedString -> PackedString dropPS, -- :: Int -> PackedString -> PackedString splitAtPS, -- :: Int -> PackedString -> (PackedString, PackedString) foldlPS, -- :: (a -> Char -> a) -> a -> PackedString -> a foldrPS, -- :: (Char -> a -> a) -> a -> PackedString -> a takeWhilePS, -- :: (Char -> Bool) -> PackedString -> PackedString dropWhilePS, -- :: (Char -> Bool) -> PackedString -> PackedString spanPS, -- :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) breakPS, -- :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) linesPS, -- :: PackedString -> [PackedString] unlinesPS, -- :: [PackedString] -> PackedString wordsPS, -- :: PackedString -> [PackedString] unwordsPS, -- :: [PackedString] -> PackedString splitPS, -- :: Char -> PackedString -> [PackedString] splitWithPS, -- :: (Char -> Bool) -> PackedString -> [PackedString] joinPS, -- :: PackedString -> [PackedString] -> PackedString ) where import Prelude #ifndef __NHC__ import Data.Array.Unboxed import Data.Array.IO import Data.Typeable import Data.Char import System.IO -- ----------------------------------------------------------------------------- -- PackedString type declaration -- | A space-efficient representation of a 'String', which supports various -- efficient operations. A 'PackedString' contains full Unicode 'Char's. newtype PackedString = PS (UArray Int Char) -- ToDo: we could support "slices", i.e. include offset and length fields into -- the string, so that operations like take/drop could be O(1). Perhaps making -- a slice should be conditional on the ratio of the slice/string size to -- limit memory leaks. instance Eq PackedString where (PS x) == (PS y) = x == y instance Ord PackedString where compare (PS x) (PS y) = compare x y --instance Read PackedString: ToDo instance Show PackedString where showsPrec p ps r = showsPrec p (unpackPS ps) r #include "Typeable.h" INSTANCE_TYPEABLE0(PackedString,packedStringTc,"PackedString") -- ----------------------------------------------------------------------------- -- Constructor functions -- | The 'nilPS' value is the empty string. nilPS :: PackedString nilPS = PS (array (0,-1) []) -- | The 'consPS' function prepends the given character to the -- given string. consPS :: Char -> PackedString -> PackedString consPS c cs = packString (c : (unpackPS cs)) -- ToDo:better -- | Convert a 'String' into a 'PackedString' packString :: String -> PackedString packString str = packNChars (length str) str -- | The 'packNChars' function creates a 'PackedString' out of the -- first @len@ elements of the given 'String'. packNChars :: Int -> [Char] -> PackedString packNChars len str = PS (listArray (0,len-1) str) -- ----------------------------------------------------------------------------- -- Destructor functions (taking PackedStrings apart) -- | Convert a 'PackedString' into a 'String' unpackPS :: PackedString -> String unpackPS (PS ps) = elems ps -- ----------------------------------------------------------------------------- -- List-mimicking functions for PackedStrings -- | The 'lengthPS' function returns the length of the input list. Analogous to 'length'. lengthPS :: PackedString -> Int lengthPS (PS ps) = rangeSize (bounds ps) -- | The 'indexPS' function returns the character in the string at the given position. indexPS :: PackedString -> Int -> Char indexPS (PS ps) i = ps ! i -- | The 'headPS' function returns the first element of a 'PackedString' or throws an -- error if the string is empty. headPS :: PackedString -> Char headPS ps | nullPS ps = error "Data.PackedString.headPS: head []" | otherwise = indexPS ps 0 -- | The 'tailPS' function returns the tail of a 'PackedString' or throws an error -- if the string is empty. tailPS :: PackedString -> PackedString tailPS ps | len <= 0 = error "Data.PackedString.tailPS: tail []" | len == 1 = nilPS | otherwise = substrPS ps 1 (len - 1) where len = lengthPS ps -- | The 'nullPS' function returns True iff the argument is null. nullPS :: PackedString -> Bool nullPS (PS ps) = rangeSize (bounds ps) == 0 -- | The 'appendPS' function appends the second string onto the first. appendPS :: PackedString -> PackedString -> PackedString appendPS xs ys | nullPS xs = ys | nullPS ys = xs | otherwise = concatPS [xs,ys] -- | The 'mapPS' function applies a function to each character in the string. mapPS :: (Char -> Char) -> PackedString -> PackedString mapPS f (PS ps) = PS (amap f ps) -- | The 'filterPS' function filters out the appropriate substring. filterPS :: (Char -> Bool) -> PackedString -> PackedString {-or String?-} filterPS pred ps = packString (filter pred (unpackPS ps)) -- | The 'foldlPS' function behaves like 'foldl' on 'PackedString's. foldlPS :: (a -> Char -> a) -> a -> PackedString -> a foldlPS f b ps = foldl f b (unpackPS ps) -- | The 'foldrPS' function behaves like 'foldr' on 'PackedString's. foldrPS :: (Char -> a -> a) -> a -> PackedString -> a foldrPS f v ps = foldr f v (unpackPS ps) -- | The 'takePS' function takes the first @n@ characters of a 'PackedString'. takePS :: Int -> PackedString -> PackedString takePS n ps = substrPS ps 0 (n-1) -- | The 'dropPS' function drops the first @n@ characters of a 'PackedString'. dropPS :: Int -> PackedString -> PackedString dropPS n ps = substrPS ps n (lengthPS ps - 1) -- | The 'splitWithPS' function splits a 'PackedString' at a given index. splitAtPS :: Int -> PackedString -> (PackedString, PackedString) splitAtPS n ps = (takePS n ps, dropPS n ps) -- | The 'takeWhilePS' function is analogous to the 'takeWhile' function. takeWhilePS :: (Char -> Bool) -> PackedString -> PackedString takeWhilePS pred ps = packString (takeWhile pred (unpackPS ps)) -- | The 'dropWhilePS' function is analogous to the 'dropWhile' function. dropWhilePS :: (Char -> Bool) -> PackedString -> PackedString dropWhilePS pred ps = packString (dropWhile pred (unpackPS ps)) -- | The 'elemPS' function returns True iff the given element is in the string. elemPS :: Char -> PackedString -> Bool elemPS c ps = c `elem` unpackPS ps -- | The 'spanPS' function returns a pair containing the result of -- running both 'takeWhilePS' and 'dropWhilePS'. spanPS :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) spanPS p ps = (takeWhilePS p ps, dropWhilePS p ps) -- | The 'breakPS' function breaks a string at the first position which -- satisfies the predicate. breakPS :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) breakPS p ps = spanPS (not . p) ps -- | The 'linesPS' function splits the input on line-breaks. linesPS :: PackedString -> [PackedString] linesPS ps = splitPS '\n' ps -- | The 'unlinesPS' function concatenates the input list after -- interspersing newlines. unlinesPS :: [PackedString] -> PackedString unlinesPS = joinPS (packString "\n") -- | The 'wordsPS' function is analogous to the 'words' function. wordsPS :: PackedString -> [PackedString] wordsPS ps = filter (not.nullPS) (splitWithPS isSpace ps) -- | The 'unwordsPS' function is analogous to the 'unwords' function. unwordsPS :: [PackedString] -> PackedString unwordsPS = joinPS (packString " ") -- | The 'reversePS' function reverses the string. reversePS :: PackedString -> PackedString reversePS ps = packString (reverse (unpackPS ps)) -- | The 'concatPS' function concatenates a list of 'PackedString's. concatPS :: [PackedString] -> PackedString concatPS pss = packString (concat (map unpackPS pss)) ------------------------------------------------------------ -- | The 'joinPS' function takes a 'PackedString' and a list of 'PackedString's -- and concatenates the list after interspersing the first argument between -- each element of the list. joinPS :: PackedString -> [PackedString] -> PackedString joinPS filler pss = concatPS (splice pss) where splice [] = [] splice [x] = [x] splice (x:y:xs) = x:filler:splice (y:xs) -- ToDo: the obvious generalisation {- Some properties that hold: * splitPS x ls = ls' where False = any (map (x `elemPS`) ls') * joinPS (packString [x]) (splitPS x ls) = ls -} -- | The 'splitPS' function splits the input string on each occurrence of the given 'Char'. splitPS :: Char -> PackedString -> [PackedString] splitPS c = splitWithPS (== c) -- | The 'splitWithPS' function takes a character predicate and splits the input string -- at each character which satisfies the predicate. splitWithPS :: (Char -> Bool) -> PackedString -> [PackedString] splitWithPS pred (PS ps) = splitify 0 where len = lengthPS (PS ps) splitify n | n >= len = [] | otherwise = let break_pt = first_pos_that_satisfies pred ps len n in if break_pt == n then -- immediate match, empty substring nilPS : splitify (break_pt + 1) else substrPS (PS ps) n (break_pt - 1) -- leave out the matching character : splitify (break_pt + 1) first_pos_that_satisfies pred ps len n = case [ m | m <- [n..len-1], pred (ps ! m) ] of [] -> len (m:_) -> m -- ----------------------------------------------------------------------------- -- Local utility functions -- The definition of @_substrPS@ is essentially: -- @take (end - begin + 1) (drop begin str)@. -- | The 'substrPS' function takes a 'PackedString' and two indices -- and returns the substring of the input string between (and including) -- these indices. substrPS :: PackedString -> Int -> Int -> PackedString substrPS (PS ps) begin end = packString [ ps ! i | i <- [begin..end] ] -- ----------------------------------------------------------------------------- -- hPutPS -- | Outputs a 'PackedString' to the specified 'Handle'. -- -- NOTE: the representation of the 'PackedString' in the file is assumed to -- be in the ISO-8859-1 encoding. In other words, only the least significant -- byte is taken from each character in the 'PackedString'. hPutPS :: Handle -> PackedString -> IO () hPutPS h (PS ps) = do let l = lengthPS (PS ps) arr <- newArray_ (0, l-1) sequence_ [ writeArray arr i (fromIntegral (ord (ps ! i))) | i <- [0..l-1] ] hPutArray h arr l -- ----------------------------------------------------------------------------- -- hGetPS -- | Read a 'PackedString' directly from the specified 'Handle'. -- This is far more efficient than reading the characters into a 'String' -- and then using 'packString'. -- -- NOTE: as with 'hPutPS', the string representation in the file is -- assumed to be ISO-8859-1. hGetPS :: Handle -> Int -> IO PackedString hGetPS h i = do arr <- newArray_ (0, i-1) l <- hGetArray h arr i chars <- mapM (\i -> readArray arr i >>= return.chr.fromIntegral) [0..l-1] return (packNChars l chars) #else /* __NHC__ */ --import Prelude hiding (append, break, concat, cons, drop, dropWhile, -- filter, foldl, foldr, head, length, lines, map, -- nil, null, reverse, span, splitAt, subst, tail, -- take, takeWhile, unlines, unwords, words) -- also hiding: Ix(..), Functor(..) import qualified NHC.PackedString import NHC.PackedString (PackedString,packString,unpackPS) import List (intersperse) nilPS :: PackedString consPS :: Char -> PackedString -> PackedString headPS :: PackedString -> Char tailPS :: PackedString -> PackedString nullPS :: PackedString -> Bool appendPS :: PackedString -> PackedString -> PackedString lengthPS :: PackedString -> Int indexPS :: PackedString -> Int -> Char mapPS :: (Char -> Char) -> PackedString -> PackedString filterPS :: (Char -> Bool) -> PackedString -> PackedString reversePS :: PackedString -> PackedString concatPS :: [PackedString] -> PackedString elemPS :: Char -> PackedString -> Bool substrPS :: PackedString -> Int -> Int -> PackedString takePS :: Int -> PackedString -> PackedString dropPS :: Int -> PackedString -> PackedString splitAtPS :: Int -> PackedString -> (PackedString, PackedString) foldlPS :: (a -> Char -> a) -> a -> PackedString -> a foldrPS :: (Char -> a -> a) -> a -> PackedString -> a takeWhilePS :: (Char -> Bool) -> PackedString -> PackedString dropWhilePS :: (Char -> Bool) -> PackedString -> PackedString spanPS :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) breakPS :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) linesPS :: PackedString -> [PackedString] unlinesPS :: [PackedString] -> PackedString wordsPS :: PackedString -> [PackedString] unwordsPS :: [PackedString] -> PackedString splitPS :: Char -> PackedString -> [PackedString] splitWithPS :: (Char -> Bool) -> PackedString -> [PackedString] joinPS :: PackedString -> [PackedString] -> PackedString nilPS = NHC.PackedString.nil consPS = NHC.PackedString.cons headPS = NHC.PackedString.head tailPS = NHC.PackedString.tail nullPS = NHC.PackedString.null appendPS = NHC.PackedString.append lengthPS = NHC.PackedString.length indexPS p i = (unpackPS p) !! i mapPS = NHC.PackedString.map filterPS = NHC.PackedString.filter reversePS = NHC.PackedString.reverse concatPS = NHC.PackedString.concat elemPS c p = c `elem` unpackPS p substrPS = NHC.PackedString.substr takePS = NHC.PackedString.take dropPS = NHC.PackedString.drop splitAtPS = NHC.PackedString.splitAt foldlPS = NHC.PackedString.foldl foldrPS = NHC.PackedString.foldr takeWhilePS = NHC.PackedString.takeWhile dropWhilePS = NHC.PackedString.dropWhile spanPS = NHC.PackedString.span breakPS = NHC.PackedString.break linesPS = NHC.PackedString.lines unlinesPS = NHC.PackedString.unlines wordsPS = NHC.PackedString.words unwordsPS = NHC.PackedString.unwords splitPS c = splitWithPS (==c) splitWithPS p = map packString . split' p [] . unpackPS where split' :: (Char->Bool) -> String -> String -> [String] split' pred [] [] = [] split' pred acc [] = [reverse acc] split' pred acc (x:xs) | pred x = reverse acc: split' pred [] xs | otherwise = split' pred (x:acc) xs joinPS sep = concatPS . intersperse sep #endif hugs98-plus-Sep2006/packages/base/Data/Generics.hs0000644006511100651110000000352310504340225020415 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Generics -- Copyright : (c) The University of Glasgow, CWI 2001--2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Generics.Basics) -- -- \"Scrap your boilerplate\" --- Generic programming in Haskell -- See . To scrap your boilerplate it -- is sufficient to import the present module, which simply re-exports all -- themes of the Data.Generics library. -- ----------------------------------------------------------------------------- module Data.Generics ( -- * All Data.Generics modules module Data.Generics.Basics, -- primitives module Data.Generics.Instances, -- instances of Data class module Data.Generics.Aliases, -- aliases for type case, generic types module Data.Generics.Schemes, -- traversal schemes (everywhere etc.) module Data.Generics.Text, -- generic read and show module Data.Generics.Twins, -- twin traversal, e.g., generic eq #ifndef __HADDOCK__ -- Data types for the sum-of-products type encoding; -- included for backwards compatibility; maybe obsolete. (:*:)(..), (:+:)(..), Unit(..) #endif ) where ------------------------------------------------------------------------------ import Prelude -- So that 'make depend' works #ifdef __GLASGOW_HASKELL__ #ifndef __HADDOCK__ -- Data types for the sum-of-products type encoding; -- included for backwards compatibility; maybe obsolete. import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) ) #endif #endif import Data.Generics.Basics import Data.Generics.Instances import Data.Generics.Aliases import Data.Generics.Schemes import Data.Generics.Text import Data.Generics.Twins hugs98-plus-Sep2006/packages/base/Data/Graph.hs0000644006511100651110000003142210504340221017712 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Graph -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Control.Monad.ST) -- -- A version of the graph algorithms described in: -- -- /Lazy Depth-First Search and Linear Graph Algorithms in Haskell/, -- by David King and John Launchbury. -- ----------------------------------------------------------------------------- module Data.Graph( -- * External interface -- At present the only one with a "nice" external interface stronglyConnComp, stronglyConnCompR, SCC(..), flattenSCC, flattenSCCs, -- * Graphs Graph, Table, Bounds, Edge, Vertex, -- ** Building graphs graphFromEdges, graphFromEdges', buildG, transposeG, -- reverseE, -- ** Graph properties vertices, edges, outdegree, indegree, -- * Algorithms dfs, dff, topSort, components, scc, bcc, -- tree, back, cross, forward, reachable, path, module Data.Tree ) where -- Extensions import Control.Monad.ST import Data.Array.ST (STArray, newArray, readArray, writeArray) import Data.Tree (Tree(Node), Forest) -- std interfaces import Data.Maybe import Data.Array import Data.List #ifdef __HADDOCK__ import Prelude #endif ------------------------------------------------------------------------- -- - -- External interface -- - ------------------------------------------------------------------------- -- | Strongly connected component. data SCC vertex = AcyclicSCC vertex -- ^ A single vertex that is not -- in any cycle. | CyclicSCC [vertex] -- ^ A maximal set of mutually -- reachable vertices. -- | The vertices of a list of strongly connected components. flattenSCCs :: [SCC a] -> [a] flattenSCCs = concatMap flattenSCC -- | The vertices of a strongly connected component. flattenSCC :: SCC vertex -> [vertex] flattenSCC (AcyclicSCC v) = [v] flattenSCC (CyclicSCC vs) = vs -- | The strongly connected components of a directed graph, topologically -- sorted. stronglyConnComp :: Ord key => [(node, key, [key])] -- ^ The graph: a list of nodes uniquely identified by keys, -- with a list of keys of nodes this node has edges to. -- The out-list may contain keys that don't correspond to -- nodes of the graph; such edges are ignored. -> [SCC node] stronglyConnComp edges0 = map get_node (stronglyConnCompR edges0) where get_node (AcyclicSCC (n, _, _)) = AcyclicSCC n get_node (CyclicSCC triples) = CyclicSCC [n | (n,_,_) <- triples] -- | The strongly connected components of a directed graph, topologically -- sorted. The function is the same as 'stronglyConnComp', except that -- all the information about each node retained. -- This interface is used when you expect to apply 'SCC' to -- (some of) the result of 'SCC', so you don't want to lose the -- dependency information. stronglyConnCompR :: Ord key => [(node, key, [key])] -- ^ The graph: a list of nodes uniquely identified by keys, -- with a list of keys of nodes this node has edges to. -- The out-list may contain keys that don't correspond to -- nodes of the graph; such edges are ignored. -> [SCC (node, key, [key])] -- ^ Topologically sorted stronglyConnCompR [] = [] -- added to avoid creating empty array in graphFromEdges -- SOF stronglyConnCompR edges0 = map decode forest where (graph, vertex_fn,_) = graphFromEdges edges0 forest = scc graph decode (Node v []) | mentions_itself v = CyclicSCC [vertex_fn v] | otherwise = AcyclicSCC (vertex_fn v) decode other = CyclicSCC (dec other []) where dec (Node v ts) vs = vertex_fn v : foldr dec vs ts mentions_itself v = v `elem` (graph ! v) ------------------------------------------------------------------------- -- - -- Graphs -- - ------------------------------------------------------------------------- -- | Abstract representation of vertices. type Vertex = Int -- | Table indexed by a contiguous set of vertices. type Table a = Array Vertex a -- | Adjacency list representation of a graph, mapping each vertex to its -- list of successors. type Graph = Table [Vertex] -- | The bounds of a 'Table'. type Bounds = (Vertex, Vertex) -- | An edge from the first vertex to the second. type Edge = (Vertex, Vertex) -- | All vertices of a graph. vertices :: Graph -> [Vertex] vertices = indices -- | All edges of a graph. edges :: Graph -> [Edge] edges g = [ (v, w) | v <- vertices g, w <- g!v ] mapT :: (Vertex -> a -> b) -> Table a -> Table b mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ] -- | Build a graph from a list of edges. buildG :: Bounds -> [Edge] -> Graph buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 edges0 -- | The graph obtained by reversing all edges. transposeG :: Graph -> Graph transposeG g = buildG (bounds g) (reverseE g) reverseE :: Graph -> [Edge] reverseE g = [ (w, v) | (v, w) <- edges g ] -- | A table of the count of edges from each node. outdegree :: Graph -> Table Int outdegree = mapT numEdges where numEdges _ ws = length ws -- | A table of the count of edges into each node. indegree :: Graph -> Table Int indegree = outdegree . transposeG -- | Identical to 'graphFromEdges', except that the return value -- does not include the function which maps keys to vertices. This -- version of 'graphFromEdges' is for backwards compatibility. graphFromEdges' :: Ord key => [(node, key, [key])] -> (Graph, Vertex -> (node, key, [key])) graphFromEdges' x = (a,b) where (a,b,_) = graphFromEdges x -- | Build a graph from a list of nodes uniquely identified by keys, -- with a list of keys of nodes this node should have edges to. -- The out-list may contain keys that don't correspond to -- nodes of the graph; they are ignored. graphFromEdges :: Ord key => [(node, key, [key])] -> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex) graphFromEdges edges0 = (graph, \v -> vertex_map ! v, key_vertex) where max_v = length edges0 - 1 bounds0 = (0,max_v) :: (Vertex, Vertex) sorted_edges = sortBy lt edges0 edges1 = zipWith (,) [0..] sorted_edges graph = array bounds0 [(,) v (mapMaybe key_vertex ks) | (,) v (_, _, ks) <- edges1] key_map = array bounds0 [(,) v k | (,) v (_, k, _ ) <- edges1] vertex_map = array bounds0 edges1 (_,k1,_) `lt` (_,k2,_) = k1 `compare` k2 -- key_vertex :: key -> Maybe Vertex -- returns Nothing for non-interesting vertices key_vertex k = findVertex 0 max_v where findVertex a b | a > b = Nothing findVertex a b = case compare k (key_map ! mid) of LT -> findVertex a (mid-1) EQ -> Just mid GT -> findVertex (mid+1) b where mid = (a + b) `div` 2 ------------------------------------------------------------------------- -- - -- Depth first search -- - ------------------------------------------------------------------------- type Set s = STArray s Vertex Bool mkEmpty :: Bounds -> ST s (Set s) mkEmpty bnds = newArray bnds False contains :: Set s -> Vertex -> ST s Bool contains m v = readArray m v include :: Set s -> Vertex -> ST s () include m v = writeArray m v True -- | A spanning forest of the graph, obtained from a depth-first search of -- the graph starting from each vertex in an unspecified order. dff :: Graph -> Forest Vertex dff g = dfs g (vertices g) -- | A spanning forest of the part of the graph reachable from the listed -- vertices, obtained from a depth-first search of the graph starting at -- each of the listed vertices in order. dfs :: Graph -> [Vertex] -> Forest Vertex dfs g vs = prune (bounds g) (map (generate g) vs) generate :: Graph -> Vertex -> Tree Vertex generate g v = Node v (map (generate g) (g!v)) prune :: Bounds -> Forest Vertex -> Forest Vertex prune bnds ts = runST (mkEmpty bnds >>= \m -> chop m ts) chop :: Set s -> Forest Vertex -> ST s (Forest Vertex) chop _ [] = return [] chop m (Node v ts : us) = contains m v >>= \visited -> if visited then chop m us else include m v >>= \_ -> chop m ts >>= \as -> chop m us >>= \bs -> return (Node v as : bs) ------------------------------------------------------------------------- -- - -- Algorithms -- - ------------------------------------------------------------------------- ------------------------------------------------------------ -- Algorithm 1: depth first search numbering ------------------------------------------------------------ preorder :: Tree a -> [a] preorder (Node a ts) = a : preorderF ts preorderF :: Forest a -> [a] preorderF ts = concat (map preorder ts) tabulate :: Bounds -> [Vertex] -> Table Int tabulate bnds vs = array bnds (zipWith (,) vs [1..]) preArr :: Bounds -> Forest Vertex -> Table Int preArr bnds = tabulate bnds . preorderF ------------------------------------------------------------ -- Algorithm 2: topological sorting ------------------------------------------------------------ postorder :: Tree a -> [a] postorder (Node a ts) = postorderF ts ++ [a] postorderF :: Forest a -> [a] postorderF ts = concat (map postorder ts) postOrd :: Graph -> [Vertex] postOrd = postorderF . dff -- | A topological sort of the graph. -- The order is partially specified by the condition that a vertex /i/ -- precedes /j/ whenever /j/ is reachable from /i/ but not vice versa. topSort :: Graph -> [Vertex] topSort = reverse . postOrd ------------------------------------------------------------ -- Algorithm 3: connected components ------------------------------------------------------------ -- | The connected components of a graph. -- Two vertices are connected if there is a path between them, traversing -- edges in either direction. components :: Graph -> Forest Vertex components = dff . undirected undirected :: Graph -> Graph undirected g = buildG (bounds g) (edges g ++ reverseE g) -- Algorithm 4: strongly connected components -- | The strongly connected components of a graph. scc :: Graph -> Forest Vertex scc g = dfs g (reverse (postOrd (transposeG g))) ------------------------------------------------------------ -- Algorithm 5: Classifying edges ------------------------------------------------------------ tree :: Bounds -> Forest Vertex -> Graph tree bnds ts = buildG bnds (concat (map flat ts)) where flat (Node v ts) = [ (v, w) | Node w _us <- ts ] ++ concat (map flat ts) back :: Graph -> Table Int -> Graph back g post = mapT select g where select v ws = [ w | w <- ws, post!v < post!w ] cross :: Graph -> Table Int -> Table Int -> Graph cross g pre post = mapT select g where select v ws = [ w | w <- ws, post!v > post!w, pre!v > pre!w ] forward :: Graph -> Graph -> Table Int -> Graph forward g tree pre = mapT select g where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree!v ------------------------------------------------------------ -- Algorithm 6: Finding reachable vertices ------------------------------------------------------------ -- | A list of vertices reachable from a given vertex. reachable :: Graph -> Vertex -> [Vertex] reachable g v = preorderF (dfs g [v]) -- | Is the second vertex reachable from the first? path :: Graph -> Vertex -> Vertex -> Bool path g v w = w `elem` (reachable g v) ------------------------------------------------------------ -- Algorithm 7: Biconnected components ------------------------------------------------------------ -- | The biconnected components of a graph. -- An undirected graph is biconnected if the deletion of any vertex -- leaves it connected. bcc :: Graph -> Forest [Vertex] bcc g = (concat . map bicomps . map (do_label g dnum)) forest where forest = dff g dnum = preArr (bounds g) forest do_label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int) do_label g dnum (Node v ts) = Node (v,dnum!v,lv) us where us = map (do_label g dnum) ts lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v] ++ [lu | Node (u,du,lu) xs <- us]) bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex] bicomps (Node (v,_,_) ts) = [ Node (v:vs) us | (l,Node vs us) <- map collect ts] collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex]) collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs) where collected = map collect ts vs = concat [ ws | (lw, Node ws us) <- collected, lw Int32 -> IO a writeMutArray :: MutArray a -> Int32 -> a -> IO () freezeArray :: MutArray a -> IO (HTArray a) thawArray :: HTArray a -> IO (MutArray a) newMutArray :: (Int32, Int32) -> a -> IO (MutArray a) #if defined(DEBUG) || defined(__NHC__) type MutArray a = IOArray Int32 a type HTArray a = MutArray a newMutArray = newIOArray readHTArray = readIOArray writeMutArray = writeIOArray freezeArray = return thawArray = return #else type MutArray a = IOArray Int32 a type HTArray a = MutArray a -- Array Int32 a newMutArray = newIOArray readHTArray arr i = readMutArray arr i -- return $! (unsafeAt arr (fromIntegral i)) readMutArray :: MutArray a -> Int32 -> IO a readMutArray arr i = unsafeReadIOArray arr (fromIntegral i) writeMutArray arr i x = unsafeWriteIOArray arr (fromIntegral i) x freezeArray = return -- unsafeFreeze thawArray = return -- unsafeThaw #endif data HashTable key val = HashTable { cmp :: !(key -> key -> Bool), hash_fn :: !(key -> Int32), tab :: !(IORef (HT key val)) } -- TODO: the IORef should really be an MVar. data HT key val = HT { kcount :: !Int32, -- Total number of keys. bmask :: !Int32, buckets :: !(HTArray [(key,val)]) } -- ------------------------------------------------------------ -- Instrumentation for performance tuning -- This ought to be roundly ignored after optimization when -- iNSTRUMENTED=False. -- STRICT version of modifyIORef! modifyIORef :: IORef a -> (a -> a) -> IO () modifyIORef r f = do v <- readIORef r let z = f v in z `seq` writeIORef r z data HashData = HD { tables :: !Integer, insertions :: !Integer, lookups :: !Integer, totBuckets :: !Integer, maxEntries :: !Int32, maxChain :: !Int, maxBuckets :: !Int32 } deriving (Eq, Show) {-# NOINLINE hashData #-} hashData :: IORef HashData hashData = unsafePerformIO (newIORef (HD { tables=0, insertions=0, lookups=0, totBuckets=0, maxEntries=0, maxChain=0, maxBuckets=tABLE_MIN } )) instrument :: (HashData -> HashData) -> IO () instrument i | iNSTRUMENTED = modifyIORef hashData i | otherwise = return () recordNew :: IO () recordNew = instrument rec where rec hd@HD{ tables=t, totBuckets=b } = hd{ tables=t+1, totBuckets=b+fromIntegral tABLE_MIN } recordIns :: Int32 -> Int32 -> [a] -> IO () recordIns i sz bkt = instrument rec where rec hd@HD{ insertions=ins, maxEntries=mx, maxChain=mc } = hd{ insertions=ins+fromIntegral i, maxEntries=mx `max` sz, maxChain=mc `max` length bkt } recordResize :: Int32 -> Int32 -> IO () recordResize older newer = instrument rec where rec hd@HD{ totBuckets=b, maxBuckets=mx } = hd{ totBuckets=b+fromIntegral (newer-older), maxBuckets=mx `max` newer } recordLookup :: IO () recordLookup = instrument lkup where lkup hd@HD{ lookups=l } = hd{ lookups=l+1 } -- stats :: IO String -- stats = fmap show $ readIORef hashData -- ----------------------------------------------------------------------------- -- Sample hash functions -- $hash_functions -- -- This implementation of hash tables uses the low-order /n/ bits of the hash -- value for a key, where /n/ varies as the hash table grows. A good hash -- function therefore will give an even distribution regardless of /n/. -- -- If your keyspace is integrals such that the low-order bits between -- keys are highly variable, then you could get away with using 'id' -- as the hash function. -- -- We provide some sample hash functions for 'Int' and 'String' below. golden :: Int32 golden = -1640531527 -- | A sample (and useful) hash function for Int and Int32, -- implemented by extracting the uppermost 32 bits of the 64-bit -- result of multiplying by a 32-bit constant. The constant is from -- Knuth, derived from the golden ratio: -- -- > golden = round ((sqrt 5 - 1) * 2^31) :: Int hashInt :: Int -> Int32 hashInt x = mulHi (fromIntegral x) golden -- hi 32 bits of a x-bit * 32 bit -> 64-bit multiply mulHi :: Int32 -> Int32 -> Int32 mulHi a b = fromIntegral (r `shiftR` 32) where r :: Int64 r = fromIntegral a * fromIntegral b :: Int64 -- | A sample hash function for Strings. We keep multiplying by the -- golden ratio and adding. The implementation is: -- -- > hashString = foldl' f 0 -- > where f m c = fromIntegral (ord c) + mulHi m golden -- -- Note that this has not been extensively tested for reasonability, -- but Knuth argues that repeated multiplication by the golden ratio -- will minimize gaps in the hash space. hashString :: String -> Int32 hashString = foldl' f 0 where f m c = fromIntegral (ord c) + mulHi m golden -- | A prime larger than the maximum hash table size prime :: Int32 prime = 33554467 -- ----------------------------------------------------------------------------- -- Parameters tABLE_MAX :: Int32 tABLE_MAX = 32 * 1024 * 1024 -- Maximum size of hash table tABLE_MIN :: Int32 tABLE_MIN = 8 hLOAD :: Int32 hLOAD = 7 -- Maximum average load of a single hash bucket hYSTERESIS :: Int32 hYSTERESIS = 64 -- entries to ignore in load computation {- Hysteresis favors long association-list-like behavior for small tables. -} -- ----------------------------------------------------------------------------- -- Creating a new hash table -- | Creates a new hash table. The following property should hold for the @eq@ -- and @hash@ functions passed to 'new': -- -- > eq A B => hash A == hash B -- new :: (key -> key -> Bool) -- ^ @eq@: An equality comparison on keys -> (key -> Int32) -- ^ @hash@: A hash function on keys -> IO (HashTable key val) -- ^ Returns: an empty hash table new cmpr hash = do recordNew -- make a new hash table with a single, empty, segment let mask = tABLE_MIN-1 bkts' <- newMutArray (0,mask) [] bkts <- freezeArray bkts' let kcnt = 0 ht = HT { buckets=bkts, kcount=kcnt, bmask=mask } table <- newIORef ht return (HashTable { tab=table, hash_fn=hash, cmp=cmpr }) -- ----------------------------------------------------------------------------- -- Inserting a key\/value pair into the hash table -- | Inserts a key\/value mapping into the hash table. -- -- Note that 'insert' doesn't remove the old entry from the table - -- the behaviour is like an association list, where 'lookup' returns -- the most-recently-inserted mapping for a key in the table. The -- reason for this is to keep 'insert' as efficient as possible. If -- you need to update a mapping, then we provide 'update'. -- insert :: HashTable key val -> key -> val -> IO () insert ht key val = updatingBucket CanInsert (\bucket -> ((key,val):bucket, 1, ())) ht key -- ------------------------------------------------------------ -- The core of the implementation is lurking down here, in findBucket, -- updatingBucket, and expandHashTable. tooBig :: Int32 -> Int32 -> Bool tooBig k b = k-hYSTERESIS > hLOAD * b -- index of bucket within table. bucketIndex :: Int32 -> Int32 -> Int32 bucketIndex mask h = h .&. mask -- find the bucket in which the key belongs. -- returns (key equality, bucket index, bucket) -- -- This rather grab-bag approach gives enough power to do pretty much -- any bucket-finding thing you might want to do. We rely on inlining -- to throw away the stuff we don't want. I'm proud to say that this -- plus updatingBucket below reduce most of the other definitions to a -- few lines of code, while actually speeding up the hashtable -- implementation when compared with a version which does everything -- from scratch. {-# INLINE findBucket #-} findBucket :: HashTable key val -> key -> IO (HT key val, Int32, [(key,val)]) findBucket HashTable{ tab=ref, hash_fn=hash} key = do table@HT{ buckets=bkts, bmask=b } <- readIORef ref let indx = bucketIndex b (hash key) bucket <- readHTArray bkts indx return (table, indx, bucket) data Inserts = CanInsert | Can'tInsert deriving (Eq) -- updatingBucket is the real workhorse of all single-element table -- updates. It takes a hashtable and a key, along with a function -- describing what to do with the bucket in which that key belongs. A -- flag indicates whether this function may perform table insertions. -- The function returns the new contents of the bucket, the number of -- bucket entries inserted (negative if entries were deleted), and a -- value which becomes the return value for the function as a whole. -- The table sizing is enforced here, calling out to expandSubTable as -- necessary. -- This function is intended to be inlined and specialized for every -- calling context (eg every provided bucketFn). {-# INLINE updatingBucket #-} updatingBucket :: Inserts -> ([(key,val)] -> ([(key,val)], Int32, a)) -> HashTable key val -> key -> IO a updatingBucket canEnlarge bucketFn ht@HashTable{ tab=ref, hash_fn=hash } key = do (table@HT{ kcount=k, buckets=bkts, bmask=b }, indx, bckt) <- findBucket ht key (bckt', inserts, result) <- return $ bucketFn bckt let k' = k + inserts table1 = table { kcount=k' } bkts' <- thawArray bkts writeMutArray bkts' indx bckt' freezeArray bkts' table2 <- if canEnlarge == CanInsert && inserts > 0 then do recordIns inserts k' bckt' if tooBig k' b then expandHashTable hash table1 else return table1 else return table1 writeIORef ref table2 return result expandHashTable :: (key -> Int32) -> HT key val -> IO (HT key val) expandHashTable hash table@HT{ buckets=bkts, bmask=mask } = do let oldsize = mask + 1 newmask = mask + mask + 1 recordResize oldsize (newmask+1) -- if newmask > tABLE_MAX-1 then return table else do -- newbkts' <- newMutArray (0,newmask) [] let splitBucket oldindex = do bucket <- readHTArray bkts oldindex let (oldb,newb) = partition ((oldindex==). bucketIndex newmask . hash . fst) bucket writeMutArray newbkts' oldindex oldb writeMutArray newbkts' (oldindex + oldsize) newb mapM_ splitBucket [0..mask] newbkts <- freezeArray newbkts' return ( table{ buckets=newbkts, bmask=newmask } ) -- ----------------------------------------------------------------------------- -- Deleting a mapping from the hash table -- Remove a key from a bucket deleteBucket :: (key -> Bool) -> [(key,val)] -> ([(key, val)], Int32, ()) deleteBucket _ [] = ([],0,()) deleteBucket del (pair@(k,_):bucket) = case deleteBucket del bucket of (bucket', dels, _) | del k -> dels' `seq` (bucket', dels', ()) | otherwise -> (pair:bucket', dels, ()) where dels' = dels - 1 -- | Remove an entry from the hash table. delete :: HashTable key val -> key -> IO () delete ht@HashTable{ cmp=eq } key = updatingBucket Can'tInsert (deleteBucket (eq key)) ht key -- ----------------------------------------------------------------------------- -- Updating a mapping in the hash table -- | Updates an entry in the hash table, returning 'True' if there was -- already an entry for this key, or 'False' otherwise. After 'update' -- there will always be exactly one entry for the given key in the table. -- -- 'insert' is more efficient than 'update' if you don't care about -- multiple entries, or you know for sure that multiple entries can't -- occur. However, 'update' is more efficient than 'delete' followed -- by 'insert'. update :: HashTable key val -> key -> val -> IO Bool update ht@HashTable{ cmp=eq } key val = updatingBucket CanInsert (\bucket -> let (bucket', dels, _) = deleteBucket (eq key) bucket in ((key,val):bucket', 1+dels, dels/=0)) ht key -- ----------------------------------------------------------------------------- -- Looking up an entry in the hash table -- | Looks up the value of a key in the hash table. lookup :: HashTable key val -> key -> IO (Maybe val) lookup ht@HashTable{ cmp=eq } key = do recordLookup (_, _, bucket) <- findBucket ht key let firstHit (k,v) r | eq key k = Just v | otherwise = r return (foldr firstHit Nothing bucket) -- ----------------------------------------------------------------------------- -- Converting to/from lists -- | Convert a list of key\/value pairs into a hash table. Equality on keys -- is taken from the Eq instance for the key type. -- fromList :: (Eq key) => (key -> Int32) -> [(key,val)] -> IO (HashTable key val) fromList hash list = do table <- new (==) hash sequence_ [ insert table k v | (k,v) <- list ] return table -- | Converts a hash table to a list of key\/value pairs. -- toList :: HashTable key val -> IO [(key,val)] toList = mapReduce id concat {-# INLINE mapReduce #-} mapReduce :: ([(key,val)] -> r) -> ([r] -> r) -> HashTable key val -> IO r mapReduce m r HashTable{ tab=ref } = do HT{ buckets=bckts, bmask=b } <- readIORef ref fmap r (mapM (fmap m . readHTArray bckts) [0..b]) -- ----------------------------------------------------------------------------- -- Diagnostics -- | This function is useful for determining whether your hash -- function is working well for your data set. It returns the longest -- chain of key\/value pairs in the hash table for which all the keys -- hash to the same bucket. If this chain is particularly long (say, -- longer than 14 elements or so), then it might be a good idea to try -- a different hash function. -- longestChain :: HashTable key val -> IO [(key,val)] longestChain = mapReduce id (maximumBy lengthCmp) where lengthCmp (_:x)(_:y) = lengthCmp x y lengthCmp [] [] = EQ lengthCmp [] _ = LT lengthCmp _ [] = GT hugs98-plus-Sep2006/packages/base/Data/IORef.hs0000644006511100651110000000540610504340221017620 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.IORef -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Mutable references in the IO monad. -- ----------------------------------------------------------------------------- module Data.IORef ( -- * IORefs IORef, -- abstract, instance of: Eq, Typeable newIORef, -- :: a -> IO (IORef a) readIORef, -- :: IORef a -> IO a writeIORef, -- :: IORef a -> a -> IO () modifyIORef, -- :: IORef a -> (a -> a) -> IO () atomicModifyIORef, -- :: IORef a -> (a -> (a,b)) -> IO b #if !defined(__PARALLEL_HASKELL__) && defined(__GLASGOW_HASKELL__) mkWeakIORef, -- :: IORef a -> IO () -> IO (Weak (IORef a)) #endif ) where import Prelude -- Explicit dependency helps 'make depend' do the right thing #ifdef __HUGS__ import Hugs.IORef #endif #ifdef __GLASGOW_HASKELL__ import GHC.Base ( mkWeak#, atomicModifyMutVar# ) import GHC.STRef import GHC.IOBase #if !defined(__PARALLEL_HASKELL__) import GHC.Weak #endif #endif /* __GLASGOW_HASKELL__ */ #ifdef __NHC__ import NHC.IOExtras ( IORef , newIORef , readIORef , writeIORef , excludeFinalisers ) #endif #if defined(__GLASGOW_HASKELL__) && !defined(__PARALLEL_HASKELL__) -- |Make a 'Weak' pointer to an 'IORef' mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a)) mkWeakIORef r@(IORef (STRef r#)) f = IO $ \s -> case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #) #endif -- |Mutate the contents of an 'IORef' modifyIORef :: IORef a -> (a -> a) -> IO () modifyIORef ref f = writeIORef ref . f =<< readIORef ref -- |Atomically modifies the contents of an 'IORef'. -- -- This function is useful for using 'IORef' in a safe way in a multithreaded -- program. If you only have one 'IORef', then using 'atomicModifyIORef' to -- access and modify it will prevent race conditions. -- -- Extending the atomicity to multiple 'IORef's is problematic, so it -- is recommended that if you need to do anything more complicated -- then using 'Control.Concurrent.MVar.MVar' instead is a good idea. -- atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b #if defined(__GLASGOW_HASKELL__) atomicModifyIORef (IORef (STRef r#)) f = IO $ \s -> atomicModifyMutVar# r# f s #elif defined(__HUGS__) atomicModifyIORef = plainModifyIORef -- Hugs has no preemption where plainModifyIORef r f = do a <- readIORef r case f a of (a',b) -> writeIORef r a' >> return b #elif defined(__NHC__) atomicModifyIORef r f = excludeFinalisers $ do a <- readIORef r let (a',b) = f a writeIORef r a' return b #endif hugs98-plus-Sep2006/packages/base/Data/Int.hs0000644006511100651110000000360710504340221017407 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Int -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Signed integer types -- ----------------------------------------------------------------------------- module Data.Int ( -- * Signed integer types Int, Int8, Int16, Int32, Int64, -- * Notes -- $notes ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base ( Int ) import GHC.Int ( Int8, Int16, Int32, Int64 ) #endif #ifdef __HUGS__ import Hugs.Int ( Int8, Int16, Int32, Int64 ) #endif #ifdef __NHC__ import Prelude import Prelude (Int) import NHC.FFI (Int8, Int16, Int32, Int64) import NHC.SizedTypes (Int8, Int16, Int32, Int64) -- instances of Bits #endif {- $notes * All arithmetic is performed modulo 2^n, where @n@ is the number of bits in the type. * For coercing between any two integer types, use 'Prelude.fromIntegral', which is specialized for all the common cases so should be fast enough. Coercing word types (see "Data.Word") to and from integer types preserves representation, not sign. * The rules that hold for 'Prelude.Enum' instances over a bounded type such as 'Int' (see the section of the Haskell report dealing with arithmetic sequences) also hold for the 'Prelude.Enum' instances over the various 'Int' types defined here. * Right and left shifts by amounts greater than or equal to the width of the type result in either zero or -1, depending on the sign of the value being shifted. This is contrary to the behaviour in C, which is undefined; a common interpretation is to truncate the shift count to the width of the type, for example @1 \<\< 32 == 1@ in some C implementations. -} hugs98-plus-Sep2006/packages/base/Data/IntMap.hs0000644006511100651110000014071510504340226020054 0ustar rossross{-# OPTIONS -cpp -fglasgow-exts -fno-bang-patterns #-} ----------------------------------------------------------------------------- -- | -- Module : Data.IntMap -- Copyright : (c) Daan Leijen 2002 -- License : BSD-style -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- An efficient implementation of maps from integer keys to values. -- -- Since many function names (but not the type name) clash with -- "Prelude" names, this module is usually imported @qualified@, e.g. -- -- > import Data.IntMap (IntMap) -- > import qualified Data.IntMap as IntMap -- -- The implementation is based on /big-endian patricia trees/. This data -- structure performs especially well on binary operations like 'union' -- and 'intersection'. However, my benchmarks show that it is also -- (much) faster on insertions and deletions when compared to a generic -- size-balanced map implementation (see "Data.Map" and "Data.FiniteMap"). -- -- * Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\", -- Workshop on ML, September 1998, pages 77-86, -- -- -- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve -- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4), -- October 1968, pages 514-534. -- -- Many operations have a worst-case complexity of /O(min(n,W))/. -- This means that the operation can become linear in the number of -- elements with a maximum of /W/ -- the number of bits in an 'Int' -- (32 or 64). ----------------------------------------------------------------------------- module Data.IntMap ( -- * Map type IntMap, Key -- instance Eq,Show -- * Operators , (!), (\\) -- * Query , null , size , member , notMember , lookup , findWithDefault -- * Construction , empty , singleton -- ** Insertion , insert , insertWith, insertWithKey, insertLookupWithKey -- ** Delete\/Update , delete , adjust , adjustWithKey , update , updateWithKey , updateLookupWithKey , alter -- * Combine -- ** Union , union , unionWith , unionWithKey , unions , unionsWith -- ** Difference , difference , differenceWith , differenceWithKey -- ** Intersection , intersection , intersectionWith , intersectionWithKey -- * Traversal -- ** Map , map , mapWithKey , mapAccum , mapAccumWithKey -- ** Fold , fold , foldWithKey -- * Conversion , elems , keys , keysSet , assocs -- ** Lists , toList , fromList , fromListWith , fromListWithKey -- ** Ordered lists , toAscList , fromAscList , fromAscListWith , fromAscListWithKey , fromDistinctAscList -- * Filter , filter , filterWithKey , partition , partitionWithKey , mapMaybe , mapMaybeWithKey , mapEither , mapEitherWithKey , split , splitLookup -- * Submap , isSubmapOf, isSubmapOfBy , isProperSubmapOf, isProperSubmapOfBy -- * Debugging , showTree , showTreeWith ) where import Prelude hiding (lookup,map,filter,foldr,foldl,null) import Data.Bits import Data.Int import qualified Data.IntSet as IntSet import Data.Monoid (Monoid(..)) import Data.Typeable import Data.Foldable (Foldable(foldMap)) {- -- just for testing import qualified Prelude import Debug.QuickCheck import List (nub,sort) import qualified List -} #if __GLASGOW_HASKELL__ import Text.Read import Data.Generics.Basics import Data.Generics.Instances #endif #if __GLASGOW_HASKELL__ >= 503 import GHC.Word import GHC.Exts ( Word(..), Int(..), shiftRL# ) #elif __GLASGOW_HASKELL__ import Word import GlaExts ( Word(..), Int(..), shiftRL# ) #else import Data.Word #endif infixl 9 \\{-This comment teaches CPP correct behaviour -} -- A "Nat" is a natural machine word (an unsigned Int) type Nat = Word natFromInt :: Key -> Nat natFromInt i = fromIntegral i intFromNat :: Nat -> Key intFromNat w = fromIntegral w shiftRL :: Nat -> Key -> Nat #if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- GHC: use unboxing to get @shiftRL@ inlined. --------------------------------------------------------------------} shiftRL (W# x) (I# i) = W# (shiftRL# x i) #else shiftRL x i = shiftR x i #endif {-------------------------------------------------------------------- Operators --------------------------------------------------------------------} -- | /O(min(n,W))/. Find the value at a key. -- Calls 'error' when the element can not be found. (!) :: IntMap a -> Key -> a m ! k = find' k m -- | /O(n+m)/. See 'difference'. (\\) :: IntMap a -> IntMap b -> IntMap a m1 \\ m2 = difference m1 m2 {-------------------------------------------------------------------- Types --------------------------------------------------------------------} -- | A map of integers to values @a@. data IntMap a = Nil | Tip {-# UNPACK #-} !Key a | Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a) !(IntMap a) type Prefix = Int type Mask = Int type Key = Int instance Monoid (IntMap a) where mempty = empty mappend = union mconcat = unions instance Foldable IntMap where foldMap f Nil = mempty foldMap f (Tip _k v) = f v foldMap f (Bin _ _ l r) = foldMap f l `mappend` foldMap f r #if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- A Data instance --------------------------------------------------------------------} -- This instance preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction. instance Data a => Data (IntMap a) where gfoldl f z im = z fromList `f` (toList im) toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.IntMap.IntMap" dataCast1 f = gcast1 f #endif {-------------------------------------------------------------------- Query --------------------------------------------------------------------} -- | /O(1)/. Is the map empty? null :: IntMap a -> Bool null Nil = True null other = False -- | /O(n)/. Number of elements in the map. size :: IntMap a -> Int size t = case t of Bin p m l r -> size l + size r Tip k x -> 1 Nil -> 0 -- | /O(min(n,W))/. Is the key a member of the map? member :: Key -> IntMap a -> Bool member k m = case lookup k m of Nothing -> False Just x -> True -- | /O(log n)/. Is the key not a member of the map? notMember :: Key -> IntMap a -> Bool notMember k m = not $ member k m -- | /O(min(n,W))/. Lookup the value at a key in the map. lookup :: (Monad m) => Key -> IntMap a -> m a lookup k t = case lookup' k t of Just x -> return x Nothing -> fail "Data.IntMap.lookup: Key not found" lookup' :: Key -> IntMap a -> Maybe a lookup' k t = let nk = natFromInt k in seq nk (lookupN nk t) lookupN :: Nat -> IntMap a -> Maybe a lookupN k t = case t of Bin p m l r | zeroN k (natFromInt m) -> lookupN k l | otherwise -> lookupN k r Tip kx x | (k == natFromInt kx) -> Just x | otherwise -> Nothing Nil -> Nothing find' :: Key -> IntMap a -> a find' k m = case lookup k m of Nothing -> error ("IntMap.find: key " ++ show k ++ " is not an element of the map") Just x -> x -- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@ -- returns the value at key @k@ or returns @def@ when the key is not an -- element of the map. findWithDefault :: a -> Key -> IntMap a -> a findWithDefault def k m = case lookup k m of Nothing -> def Just x -> x {-------------------------------------------------------------------- Construction --------------------------------------------------------------------} -- | /O(1)/. The empty map. empty :: IntMap a empty = Nil -- | /O(1)/. A map of one element. singleton :: Key -> a -> IntMap a singleton k x = Tip k x {-------------------------------------------------------------------- Insert --------------------------------------------------------------------} -- | /O(min(n,W))/. Insert a new key\/value pair in the map. -- If the key is already present in the map, the associated value is -- replaced with the supplied value, i.e. 'insert' is equivalent to -- @'insertWith' 'const'@. insert :: Key -> a -> IntMap a -> IntMap a insert k x t = case t of Bin p m l r | nomatch k p m -> join k (Tip k x) p t | zero k m -> Bin p m (insert k x l) r | otherwise -> Bin p m l (insert k x r) Tip ky y | k==ky -> Tip k x | otherwise -> join k (Tip k x) ky t Nil -> Tip k x -- right-biased insertion, used by 'union' -- | /O(min(n,W))/. Insert with a combining function. -- @'insertWith' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will -- insert @f new_value old_value@. insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWith f k x t = insertWithKey (\k x y -> f x y) k x t -- | /O(min(n,W))/. Insert with a combining function. -- @'insertWithKey' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will -- insert @f key new_value old_value@. insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWithKey f k x t = case t of Bin p m l r | nomatch k p m -> join k (Tip k x) p t | zero k m -> Bin p m (insertWithKey f k x l) r | otherwise -> Bin p m l (insertWithKey f k x r) Tip ky y | k==ky -> Tip k (f k x y) | otherwise -> join k (Tip k x) ky t Nil -> Tip k x -- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@) -- is a pair where the first element is equal to (@'lookup' k map@) -- and the second element equal to (@'insertWithKey' f k x map@). insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a) insertLookupWithKey f k x t = case t of Bin p m l r | nomatch k p m -> (Nothing,join k (Tip k x) p t) | zero k m -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r) | otherwise -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r') Tip ky y | k==ky -> (Just y,Tip k (f k x y)) | otherwise -> (Nothing,join k (Tip k x) ky t) Nil -> (Nothing,Tip k x) {-------------------------------------------------------------------- Deletion [delete] is the inlined version of [deleteWith (\k x -> Nothing)] --------------------------------------------------------------------} -- | /O(min(n,W))/. Delete a key and its value from the map. When the key is not -- a member of the map, the original map is returned. delete :: Key -> IntMap a -> IntMap a delete k t = case t of Bin p m l r | nomatch k p m -> t | zero k m -> bin p m (delete k l) r | otherwise -> bin p m l (delete k r) Tip ky y | k==ky -> Nil | otherwise -> t Nil -> Nil -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. adjust :: (a -> a) -> Key -> IntMap a -> IntMap a adjust f k m = adjustWithKey (\k x -> f x) k m -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a adjustWithKey f k m = updateWithKey (\k x -> Just (f k x)) k m -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@ -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. update :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a update f k m = updateWithKey (\k x -> f x) k m -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@ -- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a updateWithKey f k t = case t of Bin p m l r | nomatch k p m -> t | zero k m -> bin p m (updateWithKey f k l) r | otherwise -> bin p m l (updateWithKey f k r) Tip ky y | k==ky -> case (f k y) of Just y' -> Tip ky y' Nothing -> Nil | otherwise -> t Nil -> Nil -- | /O(min(n,W))/. Lookup and update. updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a) updateLookupWithKey f k t = case t of Bin p m l r | nomatch k p m -> (Nothing,t) | zero k m -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r) | otherwise -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r') Tip ky y | k==ky -> case (f k y) of Just y' -> (Just y,Tip ky y') Nothing -> (Just y,Nil) | otherwise -> (Nothing,t) Nil -> (Nothing,Nil) -- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof. -- 'alter' can be used to insert, delete, or update a value in a 'Map'. -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@ alter f k t = case t of Bin p m l r | nomatch k p m -> case f Nothing of Nothing -> t Just x -> join k (Tip k x) p t | zero k m -> bin p m (alter f k l) r | otherwise -> bin p m l (alter f k r) Tip ky y | k==ky -> case f (Just y) of Just x -> Tip ky x Nothing -> Nil | otherwise -> case f Nothing of Just x -> join k (Tip k x) ky t Nothing -> Tip ky y Nil -> case f Nothing of Just x -> Tip k x Nothing -> Nil {-------------------------------------------------------------------- Union --------------------------------------------------------------------} -- | The union of a list of maps. unions :: [IntMap a] -> IntMap a unions xs = foldlStrict union empty xs -- | The union of a list of maps, with a combining operation unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a unionsWith f ts = foldlStrict (unionWith f) empty ts -- | /O(n+m)/. The (left-biased) union of two maps. -- It prefers the first map when duplicate keys are encountered, -- i.e. (@'union' == 'unionWith' 'const'@). union :: IntMap a -> IntMap a -> IntMap a union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = union1 | shorter m2 m1 = union2 | p1 == p2 = Bin p1 m1 (union l1 l2) (union r1 r2) | otherwise = join p1 t1 p2 t2 where union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2 | zero p2 m1 = Bin p1 m1 (union l1 t2) r1 | otherwise = Bin p1 m1 l1 (union r1 t2) union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2 | zero p1 m2 = Bin p2 m2 (union t1 l2) r2 | otherwise = Bin p2 m2 l2 (union t1 r2) union (Tip k x) t = insert k x t union t (Tip k x) = insertWith (\x y -> y) k x t -- right bias union Nil t = t union t Nil = t -- | /O(n+m)/. The union with a combining function. unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWith f m1 m2 = unionWithKey (\k x y -> f x y) m1 m2 -- | /O(n+m)/. The union with a combining function. unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = union1 | shorter m2 m1 = union2 | p1 == p2 = Bin p1 m1 (unionWithKey f l1 l2) (unionWithKey f r1 r2) | otherwise = join p1 t1 p2 t2 where union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2 | zero p2 m1 = Bin p1 m1 (unionWithKey f l1 t2) r1 | otherwise = Bin p1 m1 l1 (unionWithKey f r1 t2) union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2 | zero p1 m2 = Bin p2 m2 (unionWithKey f t1 l2) r2 | otherwise = Bin p2 m2 l2 (unionWithKey f t1 r2) unionWithKey f (Tip k x) t = insertWithKey f k x t unionWithKey f t (Tip k x) = insertWithKey (\k x y -> f k y x) k x t -- right bias unionWithKey f Nil t = t unionWithKey f t Nil = t {-------------------------------------------------------------------- Difference --------------------------------------------------------------------} -- | /O(n+m)/. Difference between two maps (based on keys). difference :: IntMap a -> IntMap b -> IntMap a difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = difference1 | shorter m2 m1 = difference2 | p1 == p2 = bin p1 m1 (difference l1 l2) (difference r1 r2) | otherwise = t1 where difference1 | nomatch p2 p1 m1 = t1 | zero p2 m1 = bin p1 m1 (difference l1 t2) r1 | otherwise = bin p1 m1 l1 (difference r1 t2) difference2 | nomatch p1 p2 m2 = t1 | zero p1 m2 = difference t1 l2 | otherwise = difference t1 r2 difference t1@(Tip k x) t2 | member k t2 = Nil | otherwise = t1 difference Nil t = Nil difference t (Tip k x) = delete k t difference t Nil = t -- | /O(n+m)/. Difference with a combining function. differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a differenceWith f m1 m2 = differenceWithKey (\k x y -> f x y) m1 m2 -- | /O(n+m)/. Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the key and both values. -- If it returns 'Nothing', the element is discarded (proper set difference). -- If it returns (@'Just' y@), the element is updated with a new value @y@. differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a differenceWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = difference1 | shorter m2 m1 = difference2 | p1 == p2 = bin p1 m1 (differenceWithKey f l1 l2) (differenceWithKey f r1 r2) | otherwise = t1 where difference1 | nomatch p2 p1 m1 = t1 | zero p2 m1 = bin p1 m1 (differenceWithKey f l1 t2) r1 | otherwise = bin p1 m1 l1 (differenceWithKey f r1 t2) difference2 | nomatch p1 p2 m2 = t1 | zero p1 m2 = differenceWithKey f t1 l2 | otherwise = differenceWithKey f t1 r2 differenceWithKey f t1@(Tip k x) t2 = case lookup k t2 of Just y -> case f k x y of Just y' -> Tip k y' Nothing -> Nil Nothing -> t1 differenceWithKey f Nil t = Nil differenceWithKey f t (Tip k y) = updateWithKey (\k x -> f k x y) k t differenceWithKey f t Nil = t {-------------------------------------------------------------------- Intersection --------------------------------------------------------------------} -- | /O(n+m)/. The (left-biased) intersection of two maps (based on keys). intersection :: IntMap a -> IntMap b -> IntMap a intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = intersection1 | shorter m2 m1 = intersection2 | p1 == p2 = bin p1 m1 (intersection l1 l2) (intersection r1 r2) | otherwise = Nil where intersection1 | nomatch p2 p1 m1 = Nil | zero p2 m1 = intersection l1 t2 | otherwise = intersection r1 t2 intersection2 | nomatch p1 p2 m2 = Nil | zero p1 m2 = intersection t1 l2 | otherwise = intersection t1 r2 intersection t1@(Tip k x) t2 | member k t2 = t1 | otherwise = Nil intersection t (Tip k x) = case lookup k t of Just y -> Tip k y Nothing -> Nil intersection Nil t = Nil intersection t Nil = Nil -- | /O(n+m)/. The intersection with a combining function. intersectionWith :: (a -> b -> a) -> IntMap a -> IntMap b -> IntMap a intersectionWith f m1 m2 = intersectionWithKey (\k x y -> f x y) m1 m2 -- | /O(n+m)/. The intersection with a combining function. intersectionWithKey :: (Key -> a -> b -> a) -> IntMap a -> IntMap b -> IntMap a intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = intersection1 | shorter m2 m1 = intersection2 | p1 == p2 = bin p1 m1 (intersectionWithKey f l1 l2) (intersectionWithKey f r1 r2) | otherwise = Nil where intersection1 | nomatch p2 p1 m1 = Nil | zero p2 m1 = intersectionWithKey f l1 t2 | otherwise = intersectionWithKey f r1 t2 intersection2 | nomatch p1 p2 m2 = Nil | zero p1 m2 = intersectionWithKey f t1 l2 | otherwise = intersectionWithKey f t1 r2 intersectionWithKey f t1@(Tip k x) t2 = case lookup k t2 of Just y -> Tip k (f k x y) Nothing -> Nil intersectionWithKey f t1 (Tip k y) = case lookup k t1 of Just x -> Tip k (f k x y) Nothing -> Nil intersectionWithKey f Nil t = Nil intersectionWithKey f t Nil = Nil {-------------------------------------------------------------------- Submap --------------------------------------------------------------------} -- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@). isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool isProperSubmapOf m1 m2 = isProperSubmapOfBy (==) m1 m2 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, and when @f@ returns 'True' when applied to their respective values. For example, the following expressions are all 'True': > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) But the following are all 'False': > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) > isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) -} isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool isProperSubmapOfBy pred t1 t2 = case submapCmp pred t1 t2 of LT -> True ge -> False submapCmp pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = GT | shorter m2 m1 = submapCmpLt | p1 == p2 = submapCmpEq | otherwise = GT -- disjoint where submapCmpLt | nomatch p1 p2 m2 = GT | zero p1 m2 = submapCmp pred t1 l2 | otherwise = submapCmp pred t1 r2 submapCmpEq = case (submapCmp pred l1 l2, submapCmp pred r1 r2) of (GT,_ ) -> GT (_ ,GT) -> GT (EQ,EQ) -> EQ other -> LT submapCmp pred (Bin p m l r) t = GT submapCmp pred (Tip kx x) (Tip ky y) | (kx == ky) && pred x y = EQ | otherwise = GT -- disjoint submapCmp pred (Tip k x) t = case lookup k t of Just y | pred x y -> LT other -> GT -- disjoint submapCmp pred Nil Nil = EQ submapCmp pred Nil t = LT -- | /O(n+m)/. Is this a submap? -- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool isSubmapOf m1 m2 = isSubmapOfBy (==) m1 m2 {- | /O(n+m)/. The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if all keys in @m1@ are in @m2@, and when @f@ returns 'True' when applied to their respective values. For example, the following expressions are all 'True': > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) But the following are all 'False': > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)]) > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) -} isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool isSubmapOfBy pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = False | shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy pred t1 l2 else isSubmapOfBy pred t1 r2) | otherwise = (p1==p2) && isSubmapOfBy pred l1 l2 && isSubmapOfBy pred r1 r2 isSubmapOfBy pred (Bin p m l r) t = False isSubmapOfBy pred (Tip k x) t = case lookup k t of Just y -> pred x y Nothing -> False isSubmapOfBy pred Nil t = True {-------------------------------------------------------------------- Mapping --------------------------------------------------------------------} -- | /O(n)/. Map a function over all values in the map. map :: (a -> b) -> IntMap a -> IntMap b map f m = mapWithKey (\k x -> f x) m -- | /O(n)/. Map a function over all values in the map. mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b mapWithKey f t = case t of Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r) Tip k x -> Tip k (f k x) Nil -> Nil -- | /O(n)/. The function @'mapAccum'@ threads an accumulating -- argument through the map in ascending order of keys. mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c) mapAccum f a m = mapAccumWithKey (\a k x -> f a x) a m -- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating -- argument through the map in ascending order of keys. mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c) mapAccumWithKey f a t = mapAccumL f a t -- | /O(n)/. The function @'mapAccumL'@ threads an accumulating -- argument through the map in ascending order of keys. mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c) mapAccumL f a t = case t of Bin p m l r -> let (a1,l') = mapAccumL f a l (a2,r') = mapAccumL f a1 r in (a2,Bin p m l' r') Tip k x -> let (a',x') = f a k x in (a',Tip k x') Nil -> (a,Nil) -- | /O(n)/. The function @'mapAccumR'@ threads an accumulating -- argument throught the map in descending order of keys. mapAccumR :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c) mapAccumR f a t = case t of Bin p m l r -> let (a1,r') = mapAccumR f a r (a2,l') = mapAccumR f a1 l in (a2,Bin p m l' r') Tip k x -> let (a',x') = f a k x in (a',Tip k x') Nil -> (a,Nil) {-------------------------------------------------------------------- Filter --------------------------------------------------------------------} -- | /O(n)/. Filter all values that satisfy some predicate. filter :: (a -> Bool) -> IntMap a -> IntMap a filter p m = filterWithKey (\k x -> p x) m -- | /O(n)/. Filter all keys\/values that satisfy some predicate. filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a filterWithKey pred t = case t of Bin p m l r -> bin p m (filterWithKey pred l) (filterWithKey pred r) Tip k x | pred k x -> t | otherwise -> Nil Nil -> Nil -- | /O(n)/. partition the map according to some predicate. The first -- map contains all elements that satisfy the predicate, the second all -- elements that fail the predicate. See also 'split'. partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a) partition p m = partitionWithKey (\k x -> p x) m -- | /O(n)/. partition the map according to some predicate. The first -- map contains all elements that satisfy the predicate, the second all -- elements that fail the predicate. See also 'split'. partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a) partitionWithKey pred t = case t of Bin p m l r -> let (l1,l2) = partitionWithKey pred l (r1,r2) = partitionWithKey pred r in (bin p m l1 r1, bin p m l2 r2) Tip k x | pred k x -> (t,Nil) | otherwise -> (Nil,t) Nil -> (Nil,Nil) -- | /O(n)/. Map values and collect the 'Just' results. mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b mapMaybe f m = mapMaybeWithKey (\k x -> f x) m -- | /O(n)/. Map keys\/values and collect the 'Just' results. mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b mapMaybeWithKey f (Bin p m l r) = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r) mapMaybeWithKey f (Tip k x) = case f k x of Just y -> Tip k y Nothing -> Nil mapMaybeWithKey f Nil = Nil -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c) mapEither f m = mapEitherWithKey (\k x -> f x) m -- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results. mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c) mapEitherWithKey f (Bin p m l r) = (bin p m l1 r1, bin p m l2 r2) where (l1,l2) = mapEitherWithKey f l (r1,r2) = mapEitherWithKey f r mapEitherWithKey f (Tip k x) = case f k x of Left y -> (Tip k y, Nil) Right z -> (Nil, Tip k z) mapEitherWithKey f Nil = (Nil, Nil) -- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@ -- where all keys in @map1@ are lower than @k@ and all keys in -- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@. split :: Key -> IntMap a -> (IntMap a,IntMap a) split k t = case t of Bin p m l r | m < 0 -> (if k >= 0 -- handle negative numbers. then let (lt,gt) = split' k l in (union r lt, gt) else let (lt,gt) = split' k r in (lt, union gt l)) | otherwise -> split' k t Tip ky y | k>ky -> (t,Nil) | k (Nil,t) | otherwise -> (Nil,Nil) Nil -> (Nil,Nil) split' :: Key -> IntMap a -> (IntMap a,IntMap a) split' k t = case t of Bin p m l r | nomatch k p m -> if k>p then (t,Nil) else (Nil,t) | zero k m -> let (lt,gt) = split k l in (lt,union gt r) | otherwise -> let (lt,gt) = split k r in (union l lt,gt) Tip ky y | k>ky -> (t,Nil) | k (Nil,t) | otherwise -> (Nil,Nil) Nil -> (Nil,Nil) -- | /O(log n)/. Performs a 'split' but also returns whether the pivot -- key was found in the original map. splitLookup :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a) splitLookup k t = case t of Bin p m l r | m < 0 -> (if k >= 0 -- handle negative numbers. then let (lt,found,gt) = splitLookup' k l in (union r lt,found, gt) else let (lt,found,gt) = splitLookup' k r in (lt,found, union gt l)) | otherwise -> splitLookup' k t Tip ky y | k>ky -> (t,Nothing,Nil) | k (Nil,Nothing,t) | otherwise -> (Nil,Just y,Nil) Nil -> (Nil,Nothing,Nil) splitLookup' :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a) splitLookup' k t = case t of Bin p m l r | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t) | zero k m -> let (lt,found,gt) = splitLookup k l in (lt,found,union gt r) | otherwise -> let (lt,found,gt) = splitLookup k r in (union l lt,found,gt) Tip ky y | k>ky -> (t,Nothing,Nil) | k (Nil,Nothing,t) | otherwise -> (Nil,Just y,Nil) Nil -> (Nil,Nothing,Nil) {-------------------------------------------------------------------- Fold --------------------------------------------------------------------} -- | /O(n)/. Fold the values in the map, such that -- @'fold' f z == 'Prelude.foldr' f z . 'elems'@. -- For example, -- -- > elems map = fold (:) [] map -- fold :: (a -> b -> b) -> b -> IntMap a -> b fold f z t = foldWithKey (\k x y -> f x y) z t -- | /O(n)/. Fold the keys and values in the map, such that -- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. -- For example, -- -- > keys map = foldWithKey (\k x ks -> k:ks) [] map -- foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b foldWithKey f z t = foldr f z t foldr :: (Key -> a -> b -> b) -> b -> IntMap a -> b foldr f z t = case t of Bin 0 m l r | m < 0 -> foldr' f (foldr' f z l) r -- put negative numbers before. Bin _ _ _ _ -> foldr' f z t Tip k x -> f k x z Nil -> z foldr' :: (Key -> a -> b -> b) -> b -> IntMap a -> b foldr' f z t = case t of Bin p m l r -> foldr' f (foldr' f z r) l Tip k x -> f k x z Nil -> z {-------------------------------------------------------------------- List variations --------------------------------------------------------------------} -- | /O(n)/. -- Return all elements of the map in the ascending order of their keys. elems :: IntMap a -> [a] elems m = foldWithKey (\k x xs -> x:xs) [] m -- | /O(n)/. Return all keys of the map in ascending order. keys :: IntMap a -> [Key] keys m = foldWithKey (\k x ks -> k:ks) [] m -- | /O(n*min(n,W))/. The set of all keys of the map. keysSet :: IntMap a -> IntSet.IntSet keysSet m = IntSet.fromDistinctAscList (keys m) -- | /O(n)/. Return all key\/value pairs in the map in ascending key order. assocs :: IntMap a -> [(Key,a)] assocs m = toList m {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} -- | /O(n)/. Convert the map to a list of key\/value pairs. toList :: IntMap a -> [(Key,a)] toList t = foldWithKey (\k x xs -> (k,x):xs) [] t -- | /O(n)/. Convert the map to a list of key\/value pairs where the -- keys are in ascending order. toAscList :: IntMap a -> [(Key,a)] toAscList t = -- NOTE: the following algorithm only works for big-endian trees let (pos,neg) = span (\(k,x) -> k >=0) (foldr (\k x xs -> (k,x):xs) [] t) in neg ++ pos -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs. fromList :: [(Key,a)] -> IntMap a fromList xs = foldlStrict ins empty xs where ins t (k,x) = insert k x t -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromListWith f xs = fromListWithKey (\k x y -> f x y) xs -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'. fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromListWithKey f xs = foldlStrict ins empty xs where ins t (k,x) = insertWithKey f k x t -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where -- the keys are in ascending order. fromAscList :: [(Key,a)] -> IntMap a fromAscList xs = fromList xs -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where -- the keys are in ascending order, with a combining function on equal keys. fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWith f xs = fromListWith f xs -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where -- the keys are in ascending order, with a combining function on equal keys. fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWithKey f xs = fromListWithKey f xs -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where -- the keys are in ascending order and all distinct. fromDistinctAscList :: [(Key,a)] -> IntMap a fromDistinctAscList xs = fromList xs {-------------------------------------------------------------------- Eq --------------------------------------------------------------------} instance Eq a => Eq (IntMap a) where t1 == t2 = equal t1 t2 t1 /= t2 = nequal t1 t2 equal :: Eq a => IntMap a -> IntMap a -> Bool equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2) = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2) equal (Tip kx x) (Tip ky y) = (kx == ky) && (x==y) equal Nil Nil = True equal t1 t2 = False nequal :: Eq a => IntMap a -> IntMap a -> Bool nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2) = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2) nequal (Tip kx x) (Tip ky y) = (kx /= ky) || (x/=y) nequal Nil Nil = False nequal t1 t2 = True {-------------------------------------------------------------------- Ord --------------------------------------------------------------------} instance Ord a => Ord (IntMap a) where compare m1 m2 = compare (toList m1) (toList m2) {-------------------------------------------------------------------- Functor --------------------------------------------------------------------} instance Functor IntMap where fmap = map {-------------------------------------------------------------------- Show --------------------------------------------------------------------} instance Show a => Show (IntMap a) where showsPrec d m = showParen (d > 10) $ showString "fromList " . shows (toList m) showMap :: (Show a) => [(Key,a)] -> ShowS showMap [] = showString "{}" showMap (x:xs) = showChar '{' . showElem x . showTail xs where showTail [] = showChar '}' showTail (x:xs) = showChar ',' . showElem x . showTail xs showElem (k,x) = shows k . showString ":=" . shows x {-------------------------------------------------------------------- Read --------------------------------------------------------------------} instance (Read e) => Read (IntMap e) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \ r -> do ("fromList",s) <- lex r (xs,t) <- reads s return (fromList xs,t) #endif {-------------------------------------------------------------------- Typeable --------------------------------------------------------------------} #include "Typeable.h" INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap") {-------------------------------------------------------------------- Debugging --------------------------------------------------------------------} -- | /O(n)/. Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. showTree :: Show a => IntMap a -> String showTree s = showTreeWith True False s {- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows the tree that implements the map. If @hang@ is 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If @wide@ is 'True', an extra wide version is shown. -} showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String showTreeWith hang wide t | hang = (showsTreeHang wide [] t) "" | otherwise = (showsTree wide [] [] t) "" showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS showsTree wide lbars rbars t = case t of Bin p m l r -> showsTree wide (withBar rbars) (withEmpty rbars) r . showWide wide rbars . showsBars lbars . showString (showBin p m) . showString "\n" . showWide wide lbars . showsTree wide (withEmpty lbars) (withBar lbars) l Tip k x -> showsBars lbars . showString " " . shows k . showString ":=" . shows x . showString "\n" Nil -> showsBars lbars . showString "|\n" showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS showsTreeHang wide bars t = case t of Bin p m l r -> showsBars bars . showString (showBin p m) . showString "\n" . showWide wide bars . showsTreeHang wide (withBar bars) l . showWide wide bars . showsTreeHang wide (withEmpty bars) r Tip k x -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n" Nil -> showsBars bars . showString "|\n" showBin p m = "*" -- ++ show (p,m) showWide wide bars | wide = showString (concat (reverse bars)) . showString "|\n" | otherwise = id showsBars :: [String] -> ShowS showsBars bars = case bars of [] -> id _ -> showString (concat (reverse (tail bars))) . showString node node = "+--" withBar bars = "| ":bars withEmpty bars = " ":bars {-------------------------------------------------------------------- Helpers --------------------------------------------------------------------} {-------------------------------------------------------------------- Join --------------------------------------------------------------------} join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a join p1 t1 p2 t2 | zero p1 m = Bin p m t1 t2 | otherwise = Bin p m t2 t1 where m = branchMask p1 p2 p = mask p1 m {-------------------------------------------------------------------- @bin@ assures that we never have empty trees within a tree. --------------------------------------------------------------------} bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a bin p m l Nil = l bin p m Nil r = r bin p m l r = Bin p m l r {-------------------------------------------------------------------- Endian independent bit twiddling --------------------------------------------------------------------} zero :: Key -> Mask -> Bool zero i m = (natFromInt i) .&. (natFromInt m) == 0 nomatch,match :: Key -> Prefix -> Mask -> Bool nomatch i p m = (mask i m) /= p match i p m = (mask i m) == p mask :: Key -> Mask -> Prefix mask i m = maskW (natFromInt i) (natFromInt m) zeroN :: Nat -> Nat -> Bool zeroN i m = (i .&. m) == 0 {-------------------------------------------------------------------- Big endian operations --------------------------------------------------------------------} maskW :: Nat -> Nat -> Prefix maskW i m = intFromNat (i .&. (complement (m-1) `xor` m)) shorter :: Mask -> Mask -> Bool shorter m1 m2 = (natFromInt m1) > (natFromInt m2) branchMask :: Prefix -> Prefix -> Mask branchMask p1 p2 = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2)) {---------------------------------------------------------------------- Finding the highest bit (mask) in a word [x] can be done efficiently in three ways: * convert to a floating point value and the mantissa tells us the [log2(x)] that corresponds with the highest bit position. The mantissa is retrieved either via the standard C function [frexp] or by some bit twiddling on IEEE compatible numbers (float). Note that one needs to use at least [double] precision for an accurate mantissa of 32 bit numbers. * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit). * use processor specific assembler instruction (asm). The most portable way would be [bit], but is it efficient enough? I have measured the cycle counts of the different methods on an AMD Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction: highestBitMask: method cycles -------------- frexp 200 float 33 bit 11 asm 12 highestBit: method cycles -------------- frexp 195 float 33 bit 11 asm 11 Wow, the bit twiddling is on today's RISC like machines even faster than a single CISC instruction (BSR)! ----------------------------------------------------------------------} {---------------------------------------------------------------------- [highestBitMask] returns a word where only the highest bit is set. It is found by first setting all bits in lower positions than the highest bit and than taking an exclusive or with the original value. Allthough the function may look expensive, GHC compiles this into excellent C code that subsequently compiled into highly efficient machine code. The algorithm is derived from Jorg Arndt's FXT library. ----------------------------------------------------------------------} highestBitMask :: Nat -> Nat highestBitMask x = case (x .|. shiftRL x 1) of x -> case (x .|. shiftRL x 2) of x -> case (x .|. shiftRL x 4) of x -> case (x .|. shiftRL x 8) of x -> case (x .|. shiftRL x 16) of x -> case (x .|. shiftRL x 32) of -- for 64 bit platforms x -> (x `xor` (shiftRL x 1)) {-------------------------------------------------------------------- Utilities --------------------------------------------------------------------} foldlStrict f z xs = case xs of [] -> z (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx) {- {-------------------------------------------------------------------- Testing --------------------------------------------------------------------} testTree :: [Int] -> IntMap Int testTree xs = fromList [(x,x*x*30696 `mod` 65521) | x <- xs] test1 = testTree [1..20] test2 = testTree [30,29..10] test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3] {-------------------------------------------------------------------- QuickCheck --------------------------------------------------------------------} qcheck prop = check config prop where config = Config { configMaxTest = 500 , configMaxFail = 5000 , configSize = \n -> (div n 2 + 3) , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ] } {-------------------------------------------------------------------- Arbitrary, reasonably balanced trees --------------------------------------------------------------------} instance Arbitrary a => Arbitrary (IntMap a) where arbitrary = do{ ks <- arbitrary ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks ; return (fromList xs) } {-------------------------------------------------------------------- Single, Insert, Delete --------------------------------------------------------------------} prop_Single :: Key -> Int -> Bool prop_Single k x = (insert k x empty == singleton k x) prop_InsertDelete :: Key -> Int -> IntMap Int -> Property prop_InsertDelete k x t = not (member k t) ==> delete k (insert k x t) == t prop_UpdateDelete :: Key -> IntMap Int -> Bool prop_UpdateDelete k t = update (const Nothing) k t == delete k t {-------------------------------------------------------------------- Union --------------------------------------------------------------------} prop_UnionInsert :: Key -> Int -> IntMap Int -> Bool prop_UnionInsert k x t = union (singleton k x) t == insert k x t prop_UnionAssoc :: IntMap Int -> IntMap Int -> IntMap Int -> Bool prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3 prop_UnionComm :: IntMap Int -> IntMap Int -> Bool prop_UnionComm t1 t2 = (union t1 t2 == unionWith (\x y -> y) t2 t1) prop_Diff :: [(Key,Int)] -> [(Key,Int)] -> Bool prop_Diff xs ys = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys))) == List.sort ((List.\\) (nub (Prelude.map fst xs)) (nub (Prelude.map fst ys))) prop_Int :: [(Key,Int)] -> [(Key,Int)] -> Bool prop_Int xs ys = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys))) == List.sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys))) {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} prop_Ordered = forAll (choose (5,100)) $ \n -> let xs = [(x,()) | x <- [0..n::Int]] in fromAscList xs == fromList xs prop_List :: [Key] -> Bool prop_List xs = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])]) -} hugs98-plus-Sep2006/packages/base/Data/IntSet.hs0000644006511100651110000007163310504340226020074 0ustar rossross{-# OPTIONS -cpp -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module : Data.IntSet -- Copyright : (c) Daan Leijen 2002 -- License : BSD-style -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- An efficient implementation of integer sets. -- -- Since many function names (but not the type name) clash with -- "Prelude" names, this module is usually imported @qualified@, e.g. -- -- > import Data.IntSet (IntSet) -- > import qualified Data.IntSet as IntSet -- -- The implementation is based on /big-endian patricia trees/. This data -- structure performs especially well on binary operations like 'union' -- and 'intersection'. However, my benchmarks show that it is also -- (much) faster on insertions and deletions when compared to a generic -- size-balanced set implementation (see "Data.Set"). -- -- * Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\", -- Workshop on ML, September 1998, pages 77-86, -- -- -- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve -- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4), -- October 1968, pages 514-534. -- -- Many operations have a worst-case complexity of /O(min(n,W))/. -- This means that the operation can become linear in the number of -- elements with a maximum of /W/ -- the number of bits in an 'Int' -- (32 or 64). ----------------------------------------------------------------------------- module Data.IntSet ( -- * Set type IntSet -- instance Eq,Show -- * Operators , (\\) -- * Query , null , size , member , notMember , isSubsetOf , isProperSubsetOf -- * Construction , empty , singleton , insert , delete -- * Combine , union, unions , difference , intersection -- * Filter , filter , partition , split , splitMember -- * Map , map -- * Fold , fold -- * Conversion -- ** List , elems , toList , fromList -- ** Ordered list , toAscList , fromAscList , fromDistinctAscList -- * Debugging , showTree , showTreeWith ) where import Prelude hiding (lookup,filter,foldr,foldl,null,map) import Data.Bits import Data.Int import qualified Data.List as List import Data.Monoid (Monoid(..)) import Data.Typeable {- -- just for testing import QuickCheck import List (nub,sort) import qualified List -} #if __GLASGOW_HASKELL__ import Text.Read import Data.Generics.Basics import Data.Generics.Instances #endif #if __GLASGOW_HASKELL__ >= 503 import GHC.Word import GHC.Exts ( Word(..), Int(..), shiftRL# ) #elif __GLASGOW_HASKELL__ import Word import GlaExts ( Word(..), Int(..), shiftRL# ) #else import Data.Word #endif infixl 9 \\{-This comment teaches CPP correct behaviour -} -- A "Nat" is a natural machine word (an unsigned Int) type Nat = Word natFromInt :: Int -> Nat natFromInt i = fromIntegral i intFromNat :: Nat -> Int intFromNat w = fromIntegral w shiftRL :: Nat -> Int -> Nat #if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- GHC: use unboxing to get @shiftRL@ inlined. --------------------------------------------------------------------} shiftRL (W# x) (I# i) = W# (shiftRL# x i) #else shiftRL x i = shiftR x i #endif {-------------------------------------------------------------------- Operators --------------------------------------------------------------------} -- | /O(n+m)/. See 'difference'. (\\) :: IntSet -> IntSet -> IntSet m1 \\ m2 = difference m1 m2 {-------------------------------------------------------------------- Types --------------------------------------------------------------------} -- | A set of integers. data IntSet = Nil | Tip {-# UNPACK #-} !Int | Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet type Prefix = Int type Mask = Int instance Monoid IntSet where mempty = empty mappend = union mconcat = unions #if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- A Data instance --------------------------------------------------------------------} -- This instance preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction. instance Data IntSet where gfoldl f z is = z fromList `f` (toList is) toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.IntSet.IntSet" #endif {-------------------------------------------------------------------- Query --------------------------------------------------------------------} -- | /O(1)/. Is the set empty? null :: IntSet -> Bool null Nil = True null other = False -- | /O(n)/. Cardinality of the set. size :: IntSet -> Int size t = case t of Bin p m l r -> size l + size r Tip y -> 1 Nil -> 0 -- | /O(min(n,W))/. Is the value a member of the set? member :: Int -> IntSet -> Bool member x t = case t of Bin p m l r | nomatch x p m -> False | zero x m -> member x l | otherwise -> member x r Tip y -> (x==y) Nil -> False -- | /O(log n)/. Is the element not in the set? notMember :: Int -> IntSet -> Bool notMember k = not . member k -- 'lookup' is used by 'intersection' for left-biasing lookup :: Int -> IntSet -> Maybe Int lookup k t = let nk = natFromInt k in seq nk (lookupN nk t) lookupN :: Nat -> IntSet -> Maybe Int lookupN k t = case t of Bin p m l r | zeroN k (natFromInt m) -> lookupN k l | otherwise -> lookupN k r Tip kx | (k == natFromInt kx) -> Just kx | otherwise -> Nothing Nil -> Nothing {-------------------------------------------------------------------- Construction --------------------------------------------------------------------} -- | /O(1)/. The empty set. empty :: IntSet empty = Nil -- | /O(1)/. A set of one element. singleton :: Int -> IntSet singleton x = Tip x {-------------------------------------------------------------------- Insert --------------------------------------------------------------------} -- | /O(min(n,W))/. Add a value to the set. When the value is already -- an element of the set, it is replaced by the new one, ie. 'insert' -- is left-biased. insert :: Int -> IntSet -> IntSet insert x t = case t of Bin p m l r | nomatch x p m -> join x (Tip x) p t | zero x m -> Bin p m (insert x l) r | otherwise -> Bin p m l (insert x r) Tip y | x==y -> Tip x | otherwise -> join x (Tip x) y t Nil -> Tip x -- right-biased insertion, used by 'union' insertR :: Int -> IntSet -> IntSet insertR x t = case t of Bin p m l r | nomatch x p m -> join x (Tip x) p t | zero x m -> Bin p m (insert x l) r | otherwise -> Bin p m l (insert x r) Tip y | x==y -> t | otherwise -> join x (Tip x) y t Nil -> Tip x -- | /O(min(n,W))/. Delete a value in the set. Returns the -- original set when the value was not present. delete :: Int -> IntSet -> IntSet delete x t = case t of Bin p m l r | nomatch x p m -> t | zero x m -> bin p m (delete x l) r | otherwise -> bin p m l (delete x r) Tip y | x==y -> Nil | otherwise -> t Nil -> Nil {-------------------------------------------------------------------- Union --------------------------------------------------------------------} -- | The union of a list of sets. unions :: [IntSet] -> IntSet unions xs = foldlStrict union empty xs -- | /O(n+m)/. The union of two sets. union :: IntSet -> IntSet -> IntSet union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = union1 | shorter m2 m1 = union2 | p1 == p2 = Bin p1 m1 (union l1 l2) (union r1 r2) | otherwise = join p1 t1 p2 t2 where union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2 | zero p2 m1 = Bin p1 m1 (union l1 t2) r1 | otherwise = Bin p1 m1 l1 (union r1 t2) union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2 | zero p1 m2 = Bin p2 m2 (union t1 l2) r2 | otherwise = Bin p2 m2 l2 (union t1 r2) union (Tip x) t = insert x t union t (Tip x) = insertR x t -- right bias union Nil t = t union t Nil = t {-------------------------------------------------------------------- Difference --------------------------------------------------------------------} -- | /O(n+m)/. Difference between two sets. difference :: IntSet -> IntSet -> IntSet difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = difference1 | shorter m2 m1 = difference2 | p1 == p2 = bin p1 m1 (difference l1 l2) (difference r1 r2) | otherwise = t1 where difference1 | nomatch p2 p1 m1 = t1 | zero p2 m1 = bin p1 m1 (difference l1 t2) r1 | otherwise = bin p1 m1 l1 (difference r1 t2) difference2 | nomatch p1 p2 m2 = t1 | zero p1 m2 = difference t1 l2 | otherwise = difference t1 r2 difference t1@(Tip x) t2 | member x t2 = Nil | otherwise = t1 difference Nil t = Nil difference t (Tip x) = delete x t difference t Nil = t {-------------------------------------------------------------------- Intersection --------------------------------------------------------------------} -- | /O(n+m)/. The intersection of two sets. intersection :: IntSet -> IntSet -> IntSet intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = intersection1 | shorter m2 m1 = intersection2 | p1 == p2 = bin p1 m1 (intersection l1 l2) (intersection r1 r2) | otherwise = Nil where intersection1 | nomatch p2 p1 m1 = Nil | zero p2 m1 = intersection l1 t2 | otherwise = intersection r1 t2 intersection2 | nomatch p1 p2 m2 = Nil | zero p1 m2 = intersection t1 l2 | otherwise = intersection t1 r2 intersection t1@(Tip x) t2 | member x t2 = t1 | otherwise = Nil intersection t (Tip x) = case lookup x t of Just y -> Tip y Nothing -> Nil intersection Nil t = Nil intersection t Nil = Nil {-------------------------------------------------------------------- Subset --------------------------------------------------------------------} -- | /O(n+m)/. Is this a proper subset? (ie. a subset but not equal). isProperSubsetOf :: IntSet -> IntSet -> Bool isProperSubsetOf t1 t2 = case subsetCmp t1 t2 of LT -> True ge -> False subsetCmp t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = GT | shorter m2 m1 = subsetCmpLt | p1 == p2 = subsetCmpEq | otherwise = GT -- disjoint where subsetCmpLt | nomatch p1 p2 m2 = GT | zero p1 m2 = subsetCmp t1 l2 | otherwise = subsetCmp t1 r2 subsetCmpEq = case (subsetCmp l1 l2, subsetCmp r1 r2) of (GT,_ ) -> GT (_ ,GT) -> GT (EQ,EQ) -> EQ other -> LT subsetCmp (Bin p m l r) t = GT subsetCmp (Tip x) (Tip y) | x==y = EQ | otherwise = GT -- disjoint subsetCmp (Tip x) t | member x t = LT | otherwise = GT -- disjoint subsetCmp Nil Nil = EQ subsetCmp Nil t = LT -- | /O(n+m)/. Is this a subset? -- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@. isSubsetOf :: IntSet -> IntSet -> Bool isSubsetOf t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | shorter m1 m2 = False | shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then isSubsetOf t1 l2 else isSubsetOf t1 r2) | otherwise = (p1==p2) && isSubsetOf l1 l2 && isSubsetOf r1 r2 isSubsetOf (Bin p m l r) t = False isSubsetOf (Tip x) t = member x t isSubsetOf Nil t = True {-------------------------------------------------------------------- Filter --------------------------------------------------------------------} -- | /O(n)/. Filter all elements that satisfy some predicate. filter :: (Int -> Bool) -> IntSet -> IntSet filter pred t = case t of Bin p m l r -> bin p m (filter pred l) (filter pred r) Tip x | pred x -> t | otherwise -> Nil Nil -> Nil -- | /O(n)/. partition the set according to some predicate. partition :: (Int -> Bool) -> IntSet -> (IntSet,IntSet) partition pred t = case t of Bin p m l r -> let (l1,l2) = partition pred l (r1,r2) = partition pred r in (bin p m l1 r1, bin p m l2 r2) Tip x | pred x -> (t,Nil) | otherwise -> (Nil,t) Nil -> (Nil,Nil) -- | /O(log n)/. The expression (@'split' x set@) is a pair @(set1,set2)@ -- where all elements in @set1@ are lower than @x@ and all elements in -- @set2@ larger than @x@. -- -- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [3,4]) split :: Int -> IntSet -> (IntSet,IntSet) split x t = case t of Bin p m l r | m < 0 -> if x >= 0 then let (lt,gt) = split' x l in (union r lt, gt) else let (lt,gt) = split' x r in (lt, union gt l) -- handle negative numbers. | otherwise -> split' x t Tip y | x>y -> (t,Nil) | x (Nil,t) | otherwise -> (Nil,Nil) Nil -> (Nil, Nil) split' :: Int -> IntSet -> (IntSet,IntSet) split' x t = case t of Bin p m l r | match x p m -> if zero x m then let (lt,gt) = split' x l in (lt,union gt r) else let (lt,gt) = split' x r in (union l lt,gt) | otherwise -> if x < p then (Nil, t) else (t, Nil) Tip y | x>y -> (t,Nil) | x (Nil,t) | otherwise -> (Nil,Nil) Nil -> (Nil,Nil) -- | /O(log n)/. Performs a 'split' but also returns whether the pivot -- element was found in the original set. splitMember :: Int -> IntSet -> (IntSet,Bool,IntSet) splitMember x t = case t of Bin p m l r | m < 0 -> if x >= 0 then let (lt,found,gt) = splitMember' x l in (union r lt, found, gt) else let (lt,found,gt) = splitMember' x r in (lt, found, union gt l) -- handle negative numbers. | otherwise -> splitMember' x t Tip y | x>y -> (t,False,Nil) | x (Nil,False,t) | otherwise -> (Nil,True,Nil) Nil -> (Nil,False,Nil) splitMember' :: Int -> IntSet -> (IntSet,Bool,IntSet) splitMember' x t = case t of Bin p m l r | match x p m -> if zero x m then let (lt,found,gt) = splitMember x l in (lt,found,union gt r) else let (lt,found,gt) = splitMember x r in (union l lt,found,gt) | otherwise -> if x < p then (Nil, False, t) else (t, False, Nil) Tip y | x>y -> (t,False,Nil) | x (Nil,False,t) | otherwise -> (Nil,True,Nil) Nil -> (Nil,False,Nil) {---------------------------------------------------------------------- Map ----------------------------------------------------------------------} -- | /O(n*min(n,W))/. -- @'map' f s@ is the set obtained by applying @f@ to each element of @s@. -- -- It's worth noting that the size of the result may be smaller if, -- for some @(x,y)@, @x \/= y && f x == f y@ map :: (Int->Int) -> IntSet -> IntSet map f = fromList . List.map f . toList {-------------------------------------------------------------------- Fold --------------------------------------------------------------------} -- | /O(n)/. Fold over the elements of a set in an unspecified order. -- -- > sum set == fold (+) 0 set -- > elems set == fold (:) [] set fold :: (Int -> b -> b) -> b -> IntSet -> b fold f z t = case t of Bin 0 m l r | m < 0 -> foldr f (foldr f z l) r -- put negative numbers before. Bin p m l r -> foldr f z t Tip x -> f x z Nil -> z foldr :: (Int -> b -> b) -> b -> IntSet -> b foldr f z t = case t of Bin p m l r -> foldr f (foldr f z r) l Tip x -> f x z Nil -> z {-------------------------------------------------------------------- List variations --------------------------------------------------------------------} -- | /O(n)/. The elements of a set. (For sets, this is equivalent to toList) elems :: IntSet -> [Int] elems s = toList s {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} -- | /O(n)/. Convert the set to a list of elements. toList :: IntSet -> [Int] toList t = fold (:) [] t -- | /O(n)/. Convert the set to an ascending list of elements. toAscList :: IntSet -> [Int] toAscList t = toList t -- | /O(n*min(n,W))/. Create a set from a list of integers. fromList :: [Int] -> IntSet fromList xs = foldlStrict ins empty xs where ins t x = insert x t -- | /O(n*min(n,W))/. Build a set from an ascending list of elements. fromAscList :: [Int] -> IntSet fromAscList xs = fromList xs -- | /O(n*min(n,W))/. Build a set from an ascending list of distinct elements. fromDistinctAscList :: [Int] -> IntSet fromDistinctAscList xs = fromList xs {-------------------------------------------------------------------- Eq --------------------------------------------------------------------} instance Eq IntSet where t1 == t2 = equal t1 t2 t1 /= t2 = nequal t1 t2 equal :: IntSet -> IntSet -> Bool equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2) = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2) equal (Tip x) (Tip y) = (x==y) equal Nil Nil = True equal t1 t2 = False nequal :: IntSet -> IntSet -> Bool nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2) = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2) nequal (Tip x) (Tip y) = (x/=y) nequal Nil Nil = False nequal t1 t2 = True {-------------------------------------------------------------------- Ord --------------------------------------------------------------------} instance Ord IntSet where compare s1 s2 = compare (toAscList s1) (toAscList s2) -- tentative implementation. See if more efficient exists. {-------------------------------------------------------------------- Show --------------------------------------------------------------------} instance Show IntSet where showsPrec p xs = showParen (p > 10) $ showString "fromList " . shows (toList xs) showSet :: [Int] -> ShowS showSet [] = showString "{}" showSet (x:xs) = showChar '{' . shows x . showTail xs where showTail [] = showChar '}' showTail (x:xs) = showChar ',' . shows x . showTail xs {-------------------------------------------------------------------- Read --------------------------------------------------------------------} instance Read IntSet where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \ r -> do ("fromList",s) <- lex r (xs,t) <- reads s return (fromList xs,t) #endif {-------------------------------------------------------------------- Typeable --------------------------------------------------------------------} #include "Typeable.h" INSTANCE_TYPEABLE0(IntSet,intSetTc,"IntSet") {-------------------------------------------------------------------- Debugging --------------------------------------------------------------------} -- | /O(n)/. Show the tree that implements the set. The tree is shown -- in a compressed, hanging format. showTree :: IntSet -> String showTree s = showTreeWith True False s {- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows the tree that implements the set. If @hang@ is 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If @wide@ is 'True', an extra wide version is shown. -} showTreeWith :: Bool -> Bool -> IntSet -> String showTreeWith hang wide t | hang = (showsTreeHang wide [] t) "" | otherwise = (showsTree wide [] [] t) "" showsTree :: Bool -> [String] -> [String] -> IntSet -> ShowS showsTree wide lbars rbars t = case t of Bin p m l r -> showsTree wide (withBar rbars) (withEmpty rbars) r . showWide wide rbars . showsBars lbars . showString (showBin p m) . showString "\n" . showWide wide lbars . showsTree wide (withEmpty lbars) (withBar lbars) l Tip x -> showsBars lbars . showString " " . shows x . showString "\n" Nil -> showsBars lbars . showString "|\n" showsTreeHang :: Bool -> [String] -> IntSet -> ShowS showsTreeHang wide bars t = case t of Bin p m l r -> showsBars bars . showString (showBin p m) . showString "\n" . showWide wide bars . showsTreeHang wide (withBar bars) l . showWide wide bars . showsTreeHang wide (withEmpty bars) r Tip x -> showsBars bars . showString " " . shows x . showString "\n" Nil -> showsBars bars . showString "|\n" showBin p m = "*" -- ++ show (p,m) showWide wide bars | wide = showString (concat (reverse bars)) . showString "|\n" | otherwise = id showsBars :: [String] -> ShowS showsBars bars = case bars of [] -> id _ -> showString (concat (reverse (tail bars))) . showString node node = "+--" withBar bars = "| ":bars withEmpty bars = " ":bars {-------------------------------------------------------------------- Helpers --------------------------------------------------------------------} {-------------------------------------------------------------------- Join --------------------------------------------------------------------} join :: Prefix -> IntSet -> Prefix -> IntSet -> IntSet join p1 t1 p2 t2 | zero p1 m = Bin p m t1 t2 | otherwise = Bin p m t2 t1 where m = branchMask p1 p2 p = mask p1 m {-------------------------------------------------------------------- @bin@ assures that we never have empty trees within a tree. --------------------------------------------------------------------} bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet bin p m l Nil = l bin p m Nil r = r bin p m l r = Bin p m l r {-------------------------------------------------------------------- Endian independent bit twiddling --------------------------------------------------------------------} zero :: Int -> Mask -> Bool zero i m = (natFromInt i) .&. (natFromInt m) == 0 nomatch,match :: Int -> Prefix -> Mask -> Bool nomatch i p m = (mask i m) /= p match i p m = (mask i m) == p mask :: Int -> Mask -> Prefix mask i m = maskW (natFromInt i) (natFromInt m) zeroN :: Nat -> Nat -> Bool zeroN i m = (i .&. m) == 0 {-------------------------------------------------------------------- Big endian operations --------------------------------------------------------------------} maskW :: Nat -> Nat -> Prefix maskW i m = intFromNat (i .&. (complement (m-1) `xor` m)) shorter :: Mask -> Mask -> Bool shorter m1 m2 = (natFromInt m1) > (natFromInt m2) branchMask :: Prefix -> Prefix -> Mask branchMask p1 p2 = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2)) {---------------------------------------------------------------------- Finding the highest bit (mask) in a word [x] can be done efficiently in three ways: * convert to a floating point value and the mantissa tells us the [log2(x)] that corresponds with the highest bit position. The mantissa is retrieved either via the standard C function [frexp] or by some bit twiddling on IEEE compatible numbers (float). Note that one needs to use at least [double] precision for an accurate mantissa of 32 bit numbers. * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit). * use processor specific assembler instruction (asm). The most portable way would be [bit], but is it efficient enough? I have measured the cycle counts of the different methods on an AMD Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction: highestBitMask: method cycles -------------- frexp 200 float 33 bit 11 asm 12 highestBit: method cycles -------------- frexp 195 float 33 bit 11 asm 11 Wow, the bit twiddling is on today's RISC like machines even faster than a single CISC instruction (BSR)! ----------------------------------------------------------------------} {---------------------------------------------------------------------- [highestBitMask] returns a word where only the highest bit is set. It is found by first setting all bits in lower positions than the highest bit and than taking an exclusive or with the original value. Allthough the function may look expensive, GHC compiles this into excellent C code that subsequently compiled into highly efficient machine code. The algorithm is derived from Jorg Arndt's FXT library. ----------------------------------------------------------------------} highestBitMask :: Nat -> Nat highestBitMask x = case (x .|. shiftRL x 1) of x -> case (x .|. shiftRL x 2) of x -> case (x .|. shiftRL x 4) of x -> case (x .|. shiftRL x 8) of x -> case (x .|. shiftRL x 16) of x -> case (x .|. shiftRL x 32) of -- for 64 bit platforms x -> (x `xor` (shiftRL x 1)) {-------------------------------------------------------------------- Utilities --------------------------------------------------------------------} foldlStrict f z xs = case xs of [] -> z (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx) {- {-------------------------------------------------------------------- Testing --------------------------------------------------------------------} testTree :: [Int] -> IntSet testTree xs = fromList xs test1 = testTree [1..20] test2 = testTree [30,29..10] test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3] {-------------------------------------------------------------------- QuickCheck --------------------------------------------------------------------} qcheck prop = check config prop where config = Config { configMaxTest = 500 , configMaxFail = 5000 , configSize = \n -> (div n 2 + 3) , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ] } {-------------------------------------------------------------------- Arbitrary, reasonably balanced trees --------------------------------------------------------------------} instance Arbitrary IntSet where arbitrary = do{ xs <- arbitrary ; return (fromList xs) } {-------------------------------------------------------------------- Single, Insert, Delete --------------------------------------------------------------------} prop_Single :: Int -> Bool prop_Single x = (insert x empty == singleton x) prop_InsertDelete :: Int -> IntSet -> Property prop_InsertDelete k t = not (member k t) ==> delete k (insert k t) == t {-------------------------------------------------------------------- Union --------------------------------------------------------------------} prop_UnionInsert :: Int -> IntSet -> Bool prop_UnionInsert x t = union t (singleton x) == insert x t prop_UnionAssoc :: IntSet -> IntSet -> IntSet -> Bool prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3 prop_UnionComm :: IntSet -> IntSet -> Bool prop_UnionComm t1 t2 = (union t1 t2 == union t2 t1) prop_Diff :: [Int] -> [Int] -> Bool prop_Diff xs ys = toAscList (difference (fromList xs) (fromList ys)) == List.sort ((List.\\) (nub xs) (nub ys)) prop_Int :: [Int] -> [Int] -> Bool prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys)) == List.sort (nub ((List.intersect) (xs) (ys))) {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} prop_Ordered = forAll (choose (5,100)) $ \n -> let xs = [0..n::Int] in fromAscList xs == fromList xs prop_List :: [Int] -> Bool prop_List xs = (sort (nub xs) == toAscList (fromList xs)) -} hugs98-plus-Sep2006/packages/base/Data/Ix.hs0000644006511100651110000000442110504340221017230 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Ix -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- The 'Ix' class is used to map a contiguous subrange of values in -- type onto integers. It is used primarily for array indexing -- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray"). -- ----------------------------------------------------------------------------- module Data.Ix ( -- * The 'Ix' class Ix ( range -- :: (Ix a) => (a,a) -> [a] , index -- :: (Ix a) => (a,a) -> a -> Int , inRange -- :: (Ix a) => (a,a) -> a -> Bool , rangeSize -- :: (Ix a) => (a,a) -> Int ) -- Ix instances: -- -- Ix Char -- Ix Int -- Ix Integer -- Ix Bool -- Ix Ordering -- Ix () -- (Ix a, Ix b) => Ix (a, b) -- ... -- Implementation checked wrt. Haskell 98 lib report, 1/99. -- * Deriving Instances of 'Ix' -- | Derived instance declarations for the class 'Ix' are only possible -- for enumerations (i.e. datatypes having only nullary constructors) -- and single-constructor datatypes, including arbitrarily large tuples, -- whose constituent types are instances of 'Ix'. -- -- * For an enumeration, the nullary constructors are assumed to be -- numbered left-to-right with the indices being 0 to n-1 inclusive. This -- is the same numbering defined by the 'Enum' class. For example, given -- the datatype: -- -- > data Colour = Red | Orange | Yellow | Green | Blue | Indigo | Violet -- -- we would have: -- -- > range (Yellow,Blue) == [Yellow,Green,Blue] -- > index (Yellow,Blue) Green == 1 -- > inRange (Yellow,Blue) Red == False -- -- * For single-constructor datatypes, the derived instance declarations -- are as shown for tuples in Figure 1 -- . ) where import Prelude #ifdef __GLASGOW_HASKELL__ import GHC.Arr #endif #ifdef __HUGS__ import Hugs.Prelude( Ix(..) ) #endif #ifdef __NHC__ import Ix (Ix(..)) #endif hugs98-plus-Sep2006/packages/base/Data/List.hs0000644006511100651110000010375310504340226017600 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.List -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- Operations on lists. -- ----------------------------------------------------------------------------- module Data.List ( #ifdef __NHC__ [] (..) , #endif -- * Basic functions (++) -- :: [a] -> [a] -> [a] , head -- :: [a] -> a , last -- :: [a] -> a , tail -- :: [a] -> [a] , init -- :: [a] -> [a] , null -- :: [a] -> Bool , length -- :: [a] -> Int -- * List transformations , map -- :: (a -> b) -> [a] -> [b] , reverse -- :: [a] -> [a] , intersperse -- :: a -> [a] -> [a] , transpose -- :: [[a]] -> [[a]] -- * Reducing lists (folds) , foldl -- :: (a -> b -> a) -> a -> [b] -> a , foldl' -- :: (a -> b -> a) -> a -> [b] -> a , foldl1 -- :: (a -> a -> a) -> [a] -> a , foldl1' -- :: (a -> a -> a) -> [a] -> a , foldr -- :: (a -> b -> b) -> b -> [a] -> b , foldr1 -- :: (a -> a -> a) -> [a] -> a -- ** Special folds , concat -- :: [[a]] -> [a] , concatMap -- :: (a -> [b]) -> [a] -> [b] , and -- :: [Bool] -> Bool , or -- :: [Bool] -> Bool , any -- :: (a -> Bool) -> [a] -> Bool , all -- :: (a -> Bool) -> [a] -> Bool , sum -- :: (Num a) => [a] -> a , product -- :: (Num a) => [a] -> a , maximum -- :: (Ord a) => [a] -> a , minimum -- :: (Ord a) => [a] -> a -- * Building lists -- ** Scans , scanl -- :: (a -> b -> a) -> a -> [b] -> [a] , scanl1 -- :: (a -> a -> a) -> [a] -> [a] , scanr -- :: (a -> b -> b) -> b -> [a] -> [b] , scanr1 -- :: (a -> a -> a) -> [a] -> [a] -- ** Accumulating maps , mapAccumL -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c]) , mapAccumR -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c]) -- ** Infinite lists , iterate -- :: (a -> a) -> a -> [a] , repeat -- :: a -> [a] , replicate -- :: Int -> a -> [a] , cycle -- :: [a] -> [a] -- ** Unfolding , unfoldr -- :: (b -> Maybe (a, b)) -> b -> [a] -- * Sublists -- ** Extracting sublists , take -- :: Int -> [a] -> [a] , drop -- :: Int -> [a] -> [a] , splitAt -- :: Int -> [a] -> ([a], [a]) , takeWhile -- :: (a -> Bool) -> [a] -> [a] , dropWhile -- :: (a -> Bool) -> [a] -> [a] , span -- :: (a -> Bool) -> [a] -> ([a], [a]) , break -- :: (a -> Bool) -> [a] -> ([a], [a]) , group -- :: Eq a => [a] -> [[a]] , inits -- :: [a] -> [[a]] , tails -- :: [a] -> [[a]] -- ** Predicates , isPrefixOf -- :: (Eq a) => [a] -> [a] -> Bool , isSuffixOf -- :: (Eq a) => [a] -> [a] -> Bool , isInfixOf -- :: (Eq a) => [a] -> [a] -> Bool -- * Searching lists -- ** Searching by equality , elem -- :: a -> [a] -> Bool , notElem -- :: a -> [a] -> Bool , lookup -- :: (Eq a) => a -> [(a,b)] -> Maybe b -- ** Searching with a predicate , find -- :: (a -> Bool) -> [a] -> Maybe a , filter -- :: (a -> Bool) -> [a] -> [a] , partition -- :: (a -> Bool) -> [a] -> ([a], [a]) -- * Indexing lists -- | These functions treat a list @xs@ as a indexed collection, -- with indices ranging from 0 to @'length' xs - 1@. , (!!) -- :: [a] -> Int -> a , elemIndex -- :: (Eq a) => a -> [a] -> Maybe Int , elemIndices -- :: (Eq a) => a -> [a] -> [Int] , findIndex -- :: (a -> Bool) -> [a] -> Maybe Int , findIndices -- :: (a -> Bool) -> [a] -> [Int] -- * Zipping and unzipping lists , zip -- :: [a] -> [b] -> [(a,b)] , zip3 , zip4, zip5, zip6, zip7 , zipWith -- :: (a -> b -> c) -> [a] -> [b] -> [c] , zipWith3 , zipWith4, zipWith5, zipWith6, zipWith7 , unzip -- :: [(a,b)] -> ([a],[b]) , unzip3 , unzip4, unzip5, unzip6, unzip7 -- * Special lists -- ** Functions on strings , lines -- :: String -> [String] , words -- :: String -> [String] , unlines -- :: [String] -> String , unwords -- :: [String] -> String -- ** \"Set\" operations , nub -- :: (Eq a) => [a] -> [a] , delete -- :: (Eq a) => a -> [a] -> [a] , (\\) -- :: (Eq a) => [a] -> [a] -> [a] , union -- :: (Eq a) => [a] -> [a] -> [a] , intersect -- :: (Eq a) => [a] -> [a] -> [a] -- ** Ordered lists , sort -- :: (Ord a) => [a] -> [a] , insert -- :: (Ord a) => a -> [a] -> [a] -- * Generalized functions -- ** The \"@By@\" operations -- | By convention, overloaded functions have a non-overloaded -- counterpart whose name is suffixed with \`@By@\'. -- *** User-supplied equality (replacing an @Eq@ context) -- | The predicate is assumed to define an equivalence. , nubBy -- :: (a -> a -> Bool) -> [a] -> [a] , deleteBy -- :: (a -> a -> Bool) -> a -> [a] -> [a] , deleteFirstsBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a] , unionBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a] , intersectBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a] , groupBy -- :: (a -> a -> Bool) -> [a] -> [[a]] -- *** User-supplied comparison (replacing an @Ord@ context) -- | The function is assumed to define a total ordering. , sortBy -- :: (a -> a -> Ordering) -> [a] -> [a] , insertBy -- :: (a -> a -> Ordering) -> a -> [a] -> [a] , maximumBy -- :: (a -> a -> Ordering) -> [a] -> a , minimumBy -- :: (a -> a -> Ordering) -> [a] -> a -- ** The \"@generic@\" operations -- | The prefix \`@generic@\' indicates an overloaded function that -- is a generalized version of a "Prelude" function. , genericLength -- :: (Integral a) => [b] -> a , genericTake -- :: (Integral a) => a -> [b] -> [b] , genericDrop -- :: (Integral a) => a -> [b] -> [b] , genericSplitAt -- :: (Integral a) => a -> [b] -> ([b], [b]) , genericIndex -- :: (Integral a) => [b] -> a -> b , genericReplicate -- :: (Integral a) => a -> b -> [b] ) where #ifdef __NHC__ import Prelude hiding (Maybe(..)) #endif import Data.Maybe import Data.Char ( isSpace ) #ifdef __GLASGOW_HASKELL__ import GHC.Num import GHC.Real import GHC.List import GHC.Base #endif infix 5 \\ -- comment to fool cpp -- ----------------------------------------------------------------------------- -- List functions -- | The 'elemIndex' function returns the index of the first element -- in the given list which is equal (by '==') to the query element, -- or 'Nothing' if there is no such element. elemIndex :: Eq a => a -> [a] -> Maybe Int elemIndex x = findIndex (x==) -- | The 'elemIndices' function extends 'elemIndex', by returning the -- indices of all elements equal to the query element, in ascending order. elemIndices :: Eq a => a -> [a] -> [Int] elemIndices x = findIndices (x==) -- | The 'find' function takes a predicate and a list and returns the -- first element in the list matching the predicate, or 'Nothing' if -- there is no such element. find :: (a -> Bool) -> [a] -> Maybe a find p = listToMaybe . filter p -- | The 'findIndex' function takes a predicate and a list and returns -- the index of the first element in the list satisfying the predicate, -- or 'Nothing' if there is no such element. findIndex :: (a -> Bool) -> [a] -> Maybe Int findIndex p = listToMaybe . findIndices p -- | The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (a -> Bool) -> [a] -> [Int] #if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__) findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] #else -- Efficient definition findIndices p ls = loop 0# ls where loop _ [] = [] loop n (x:xs) | p x = I# n : loop (n +# 1#) xs | otherwise = loop (n +# 1#) xs #endif /* USE_REPORT_PRELUDE */ -- | The 'isPrefixOf' function takes two lists and returns 'True' -- iff the first list is a prefix of the second. isPrefixOf :: (Eq a) => [a] -> [a] -> Bool isPrefixOf [] _ = True isPrefixOf _ [] = False isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys -- | The 'isSuffixOf' function takes two lists and returns 'True' -- iff the first list is a suffix of the second. -- Both lists must be finite. isSuffixOf :: (Eq a) => [a] -> [a] -> Bool isSuffixOf x y = reverse x `isPrefixOf` reverse y -- | The 'isInfixOf' function takes two lists and returns 'True' -- iff the first list is contained, wholly and intact, -- anywhere within the second. -- -- Example: -- -- >isInfixOf "Haskell" "I really like Haskell." -> True -- >isInfixOf "Ial" "I really like Haskell." -> False isInfixOf :: (Eq a) => [a] -> [a] -> Bool isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- | The 'nub' function removes duplicate elements from a list. -- In particular, it keeps only the first occurrence of each element. -- (The name 'nub' means \`essence\'.) -- It is a special case of 'nubBy', which allows the programmer to supply -- their own equality test. nub :: (Eq a) => [a] -> [a] #ifdef USE_REPORT_PRELUDE nub = nubBy (==) #else -- stolen from HBC nub l = nub' l [] -- ' where nub' [] _ = [] -- ' nub' (x:xs) ls -- ' | x `elem` ls = nub' xs ls -- ' | otherwise = x : nub' xs (x:ls) -- ' #endif -- | The 'nubBy' function behaves just like 'nub', except it uses a -- user-supplied equality predicate instead of the overloaded '==' -- function. nubBy :: (a -> a -> Bool) -> [a] -> [a] #ifdef USE_REPORT_PRELUDE nubBy eq [] = [] nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs) #else nubBy eq l = nubBy' l [] where nubBy' [] _ = [] nubBy' (y:ys) xs | elem_by eq y xs = nubBy' ys xs | otherwise = y : nubBy' ys (y:xs) -- Not exported: -- Note that we keep the call to `eq` with arguments in the -- same order as in the reference implementation -- 'xs' is the list of things we've seen so far, -- 'y' is the potential new element elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool elem_by _ _ [] = False elem_by eq y (x:xs) = x `eq` y || elem_by eq y xs #endif -- | 'delete' @x@ removes the first occurrence of @x@ from its list argument. -- For example, -- -- > delete 'a' "banana" == "bnana" -- -- It is a special case of 'deleteBy', which allows the programmer to -- supply their own equality test. delete :: (Eq a) => a -> [a] -> [a] delete = deleteBy (==) -- | The 'deleteBy' function behaves like 'delete', but takes a -- user-supplied equality predicate. deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] deleteBy _ _ [] = [] deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys -- | The '\\' function is list difference ((non-associative). -- In the result of @xs@ '\\' @ys@, the first occurrence of each element of -- @ys@ in turn (if any) has been removed from @xs@. Thus -- -- > (xs ++ ys) \\ xs == ys. -- -- It is a special case of 'deleteFirstsBy', which allows the programmer -- to supply their own equality test. (\\) :: (Eq a) => [a] -> [a] -> [a] (\\) = foldl (flip delete) -- | The 'union' function returns the list union of the two lists. -- For example, -- -- > "dog" `union` "cow" == "dogcw" -- -- Duplicates, and elements of the first list, are removed from the -- the second list, but if the first list contains duplicates, so will -- the result. -- It is a special case of 'unionBy', which allows the programmer to supply -- their own equality test. union :: (Eq a) => [a] -> [a] -> [a] union = unionBy (==) -- | The 'unionBy' function is the non-overloaded version of 'union'. unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs -- | The 'intersect' function takes the list intersection of two lists. -- For example, -- -- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4] -- -- If the first list contains duplicates, so will the result. -- It is a special case of 'intersectBy', which allows the programmer to -- supply their own equality test. intersect :: (Eq a) => [a] -> [a] -> [a] intersect = intersectBy (==) -- | The 'intersectBy' function is the non-overloaded version of 'intersect'. intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] -- | The 'intersperse' function takes an element and a list and -- \`intersperses\' that element between the elements of the list. -- For example, -- -- > intersperse ',' "abcde" == "a,b,c,d,e" intersperse :: a -> [a] -> [a] intersperse _ [] = [] intersperse _ [x] = [x] intersperse sep (x:xs) = x : sep : intersperse sep xs -- | The 'transpose' function transposes the rows and columns of its argument. -- For example, -- -- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]] transpose :: [[a]] -> [[a]] transpose [] = [] transpose ([] : xss) = transpose xss transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss]) -- | The 'partition' function takes a predicate a list and returns -- the pair of lists of elements which do and do not satisfy the -- predicate, respectively; i.e., -- -- > partition p xs == (filter p xs, filter (not . p) xs) partition :: (a -> Bool) -> [a] -> ([a],[a]) {-# INLINE partition #-} partition p xs = foldr (select p) ([],[]) xs select p x ~(ts,fs) | p x = (x:ts,fs) | otherwise = (ts, x:fs) -- | The 'mapAccumL' function behaves like a combination of 'map' and -- 'foldl'; it applies a function to each element of a list, passing -- an accumulating parameter from left to right, and returning a final -- value of this accumulator together with the new list. mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list -- and accumulator, returning new -- accumulator and elt of result list -> acc -- Initial accumulator -> [x] -- Input list -> (acc, [y]) -- Final accumulator and result list mapAccumL _ s [] = (s, []) mapAccumL f s (x:xs) = (s'',y:ys) where (s', y ) = f s x (s'',ys) = mapAccumL f s' xs -- | The 'mapAccumR' function behaves like a combination of 'map' and -- 'foldr'; it applies a function to each element of a list, passing -- an accumulating parameter from right to left, and returning a final -- value of this accumulator together with the new list. mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list -- and accumulator, returning new -- accumulator and elt of result list -> acc -- Initial accumulator -> [x] -- Input list -> (acc, [y]) -- Final accumulator and result list mapAccumR _ s [] = (s, []) mapAccumR f s (x:xs) = (s'', y:ys) where (s'',y ) = f s' x (s', ys) = mapAccumR f s xs -- | The 'insert' function takes an element and a list and inserts the -- element into the list at the last position where it is still less -- than or equal to the next element. In particular, if the list -- is sorted before the call, the result will also be sorted. -- It is a special case of 'insertBy', which allows the programmer to -- supply their own comparison function. insert :: Ord a => a -> [a] -> [a] insert e ls = insertBy (compare) e ls -- | The non-overloaded version of 'insert'. insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] insertBy _ x [] = [x] insertBy cmp x ys@(y:ys') = case cmp x y of GT -> y : insertBy cmp x ys' _ -> x : ys #ifdef __GLASGOW_HASKELL__ -- | 'maximum' returns the maximum value from a list, -- which must be non-empty, finite, and of an ordered type. -- It is a special case of 'Data.List.maximumBy', which allows the -- programmer to supply their own comparison function. maximum :: (Ord a) => [a] -> a maximum [] = errorEmptyList "maximum" maximum xs = foldl1 max xs {-# RULES "maximumInt" maximum = (strictMaximum :: [Int] -> Int); "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer) #-} -- We can't make the overloaded version of maximum strict without -- changing its semantics (max might not be strict), but we can for -- the version specialised to 'Int'. strictMaximum :: (Ord a) => [a] -> a strictMaximum [] = errorEmptyList "maximum" strictMaximum xs = foldl1' max xs -- | 'minimum' returns the minimum value from a list, -- which must be non-empty, finite, and of an ordered type. -- It is a special case of 'Data.List.minimumBy', which allows the -- programmer to supply their own comparison function. minimum :: (Ord a) => [a] -> a minimum [] = errorEmptyList "minimum" minimum xs = foldl1 min xs {-# RULES "minimumInt" minimum = (strictMinimum :: [Int] -> Int); "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer) #-} strictMinimum :: (Ord a) => [a] -> a strictMinimum [] = errorEmptyList "minimum" strictMinimum xs = foldl1' min xs #endif /* __GLASGOW_HASKELL__ */ -- | The 'maximumBy' function takes a comparison function and a list -- and returns the greatest element of the list by the comparison function. -- The list must be finite and non-empty. maximumBy :: (a -> a -> Ordering) -> [a] -> a maximumBy _ [] = error "List.maximumBy: empty list" maximumBy cmp xs = foldl1 max xs where max x y = case cmp x y of GT -> x _ -> y -- | The 'minimumBy' function takes a comparison function and a list -- and returns the least element of the list by the comparison function. -- The list must be finite and non-empty. minimumBy :: (a -> a -> Ordering) -> [a] -> a minimumBy _ [] = error "List.minimumBy: empty list" minimumBy cmp xs = foldl1 min xs where min x y = case cmp x y of GT -> y _ -> x -- | The 'genericLength' function is an overloaded version of 'length'. In -- particular, instead of returning an 'Int', it returns any type which is -- an instance of 'Num'. It is, however, less efficient than 'length'. genericLength :: (Num i) => [b] -> i genericLength [] = 0 genericLength (_:l) = 1 + genericLength l -- | The 'genericTake' function is an overloaded version of 'take', which -- accepts any 'Integral' value as the number of elements to take. genericTake :: (Integral i) => i -> [a] -> [a] genericTake 0 _ = [] genericTake _ [] = [] genericTake n (x:xs) | n > 0 = x : genericTake (n-1) xs genericTake _ _ = error "List.genericTake: negative argument" -- | The 'genericDrop' function is an overloaded version of 'drop', which -- accepts any 'Integral' value as the number of elements to drop. genericDrop :: (Integral i) => i -> [a] -> [a] genericDrop 0 xs = xs genericDrop _ [] = [] genericDrop n (_:xs) | n > 0 = genericDrop (n-1) xs genericDrop _ _ = error "List.genericDrop: negative argument" -- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which -- accepts any 'Integral' value as the position at which to split. genericSplitAt :: (Integral i) => i -> [b] -> ([b],[b]) genericSplitAt 0 xs = ([],xs) genericSplitAt _ [] = ([],[]) genericSplitAt n (x:xs) | n > 0 = (x:xs',xs'') where (xs',xs'') = genericSplitAt (n-1) xs genericSplitAt _ _ = error "List.genericSplitAt: negative argument" -- | The 'genericIndex' function is an overloaded version of '!!', which -- accepts any 'Integral' value as the index. genericIndex :: (Integral a) => [b] -> a -> b genericIndex (x:_) 0 = x genericIndex (_:xs) n | n > 0 = genericIndex xs (n-1) | otherwise = error "List.genericIndex: negative argument." genericIndex _ _ = error "List.genericIndex: index too large." -- | The 'genericReplicate' function is an overloaded version of 'replicate', -- which accepts any 'Integral' value as the number of repetitions to make. genericReplicate :: (Integral i) => i -> a -> [a] genericReplicate n x = genericTake n (repeat x) -- | The 'zip4' function takes four lists and returns a list of -- quadruples, analogous to 'zip'. zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] zip4 = zipWith4 (,,,) -- | The 'zip5' function takes five lists and returns a list of -- five-tuples, analogous to 'zip'. zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] zip5 = zipWith5 (,,,,) -- | The 'zip6' function takes six lists and returns a list of six-tuples, -- analogous to 'zip'. zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)] zip6 = zipWith6 (,,,,,) -- | The 'zip7' function takes seven lists and returns a list of -- seven-tuples, analogous to 'zip'. zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)] zip7 = zipWith7 (,,,,,,) -- | The 'zipWith4' function takes a function which combines four -- elements, as well as four lists and returns a list of their point-wise -- combination, analogous to 'zipWith'. zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) = z a b c d : zipWith4 z as bs cs ds zipWith4 _ _ _ _ _ = [] -- | The 'zipWith5' function takes a function which combines five -- elements, as well as five lists and returns a list of their point-wise -- combination, analogous to 'zipWith'. zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f] zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) = z a b c d e : zipWith5 z as bs cs ds es zipWith5 _ _ _ _ _ _ = [] -- | The 'zipWith6' function takes a function which combines six -- elements, as well as six lists and returns a list of their point-wise -- combination, analogous to 'zipWith'. zipWith6 :: (a->b->c->d->e->f->g) -> [a]->[b]->[c]->[d]->[e]->[f]->[g] zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) = z a b c d e f : zipWith6 z as bs cs ds es fs zipWith6 _ _ _ _ _ _ _ = [] -- | The 'zipWith7' function takes a function which combines seven -- elements, as well as seven lists and returns a list of their point-wise -- combination, analogous to 'zipWith'. zipWith7 :: (a->b->c->d->e->f->g->h) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) = z a b c d e f g : zipWith7 z as bs cs ds es fs gs zipWith7 _ _ _ _ _ _ _ _ = [] -- | The 'unzip4' function takes a list of quadruples and returns four -- lists, analogous to 'unzip'. unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d]) unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) -> (a:as,b:bs,c:cs,d:ds)) ([],[],[],[]) -- | The 'unzip5' function takes a list of five-tuples and returns five -- lists, analogous to 'unzip'. unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e]) unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) -> (a:as,b:bs,c:cs,d:ds,e:es)) ([],[],[],[],[]) -- | The 'unzip6' function takes a list of six-tuples and returns six -- lists, analogous to 'unzip'. unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f]) unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) -> (a:as,b:bs,c:cs,d:ds,e:es,f:fs)) ([],[],[],[],[],[]) -- | The 'unzip7' function takes a list of seven-tuples and returns -- seven lists, analogous to 'unzip'. unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g]) unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) -> (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs)) ([],[],[],[],[],[],[]) -- | The 'deleteFirstsBy' function takes a predicate and two lists and -- returns the first list with the first occurrence of each element of -- the second list removed. deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] deleteFirstsBy eq = foldl (flip (deleteBy eq)) -- | The 'group' function takes a list and returns a list of lists such -- that the concatenation of the result is equal to the argument. Moreover, -- each sublist in the result contains only equal elements. For example, -- -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] -- -- It is a special case of 'groupBy', which allows the programmer to supply -- their own equality test. group :: Eq a => [a] -> [[a]] group = groupBy (==) -- | The 'groupBy' function is the non-overloaded version of 'group'. groupBy :: (a -> a -> Bool) -> [a] -> [[a]] groupBy _ [] = [] groupBy eq (x:xs) = (x:ys) : groupBy eq zs where (ys,zs) = span (eq x) xs -- | The 'inits' function returns all initial segments of the argument, -- shortest first. For example, -- -- > inits "abc" == ["","a","ab","abc"] -- inits :: [a] -> [[a]] inits [] = [[]] inits (x:xs) = [[]] ++ map (x:) (inits xs) -- | The 'tails' function returns all final segments of the argument, -- longest first. For example, -- -- > tails "abc" == ["abc", "bc", "c",""] -- tails :: [a] -> [[a]] tails [] = [[]] tails xxs@(_:xs) = xxs : tails xs ------------------------------------------------------------------------------ -- Quick Sort algorithm taken from HBC's QSort library. -- | The 'sort' function implements a stable sorting algorithm. -- It is a special case of 'sortBy', which allows the programmer to supply -- their own comparison function. sort :: (Ord a) => [a] -> [a] -- | The 'sortBy' function is the non-overloaded version of 'sort'. sortBy :: (a -> a -> Ordering) -> [a] -> [a] #ifdef USE_REPORT_PRELUDE sort = sortBy compare sortBy cmp = foldr (insertBy cmp) [] #else sortBy cmp l = mergesort cmp l sort l = mergesort compare l {- Quicksort replaced by mergesort, 14/5/2002. From: Ian Lynagh I am curious as to why the List.sort implementation in GHC is a quicksort algorithm rather than an algorithm that guarantees n log n time in the worst case? I have attached a mergesort implementation along with a few scripts to time it's performance, the results of which are shown below (* means it didn't finish successfully - in all cases this was due to a stack overflow). If I heap profile the random_list case with only 10000 then I see random_list peaks at using about 2.5M of memory, whereas in the same program using List.sort it uses only 100k. Input style Input length Sort data Sort alg User time stdin 10000 random_list sort 2.82 stdin 10000 random_list mergesort 2.96 stdin 10000 sorted sort 31.37 stdin 10000 sorted mergesort 1.90 stdin 10000 revsorted sort 31.21 stdin 10000 revsorted mergesort 1.88 stdin 100000 random_list sort * stdin 100000 random_list mergesort * stdin 100000 sorted sort * stdin 100000 sorted mergesort * stdin 100000 revsorted sort * stdin 100000 revsorted mergesort * func 10000 random_list sort 0.31 func 10000 random_list mergesort 0.91 func 10000 sorted sort 19.09 func 10000 sorted mergesort 0.15 func 10000 revsorted sort 19.17 func 10000 revsorted mergesort 0.16 func 100000 random_list sort 3.85 func 100000 random_list mergesort * func 100000 sorted sort 5831.47 func 100000 sorted mergesort 2.23 func 100000 revsorted sort 5872.34 func 100000 revsorted mergesort 2.24 -} mergesort :: (a -> a -> Ordering) -> [a] -> [a] mergesort cmp = mergesort' cmp . map wrap mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a] mergesort' cmp [] = [] mergesort' cmp [xs] = xs mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss) merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]] merge_pairs cmp [] = [] merge_pairs cmp [xs] = [xs] merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a] merge cmp xs [] = xs merge cmp [] ys = ys merge cmp (x:xs) (y:ys) = case x `cmp` y of GT -> y : merge cmp (x:xs) ys _ -> x : merge cmp xs (y:ys) wrap :: a -> [a] wrap x = [x] {- OLD: qsort version -- qsort is stable and does not concatenate. qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] qsort _ [] r = r qsort _ [x] r = x:r qsort cmp (x:xs) r = qpart cmp x xs [] [] r -- qpart partitions and sorts the sublists qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a] qpart cmp x [] rlt rge r = -- rlt and rge are in reverse order and must be sorted with an -- anti-stable sorting rqsort cmp rlt (x:rqsort cmp rge r) qpart cmp x (y:ys) rlt rge r = case cmp x y of GT -> qpart cmp x ys (y:rlt) rge r _ -> qpart cmp x ys rlt (y:rge) r -- rqsort is as qsort but anti-stable, i.e. reverses equal elements rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] rqsort _ [] r = r rqsort _ [x] r = x:r rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a] rqpart cmp x [] rle rgt r = qsort cmp rle (x:qsort cmp rgt r) rqpart cmp x (y:ys) rle rgt r = case cmp y x of GT -> rqpart cmp x ys rle (y:rgt) r _ -> rqpart cmp x ys (y:rle) rgt r -} #endif /* USE_REPORT_PRELUDE */ -- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr' -- reduces a list to a summary value, 'unfoldr' builds a list from -- a seed value. The function takes the element and returns 'Nothing' -- if it is done producing the list or returns 'Just' @(a,b)@, in which -- case, @a@ is a prepended to the list and @b@ is used as the next -- element in a recursive call. For example, -- -- > iterate f == unfoldr (\x -> Just (x, f x)) -- -- In some cases, 'unfoldr' can undo a 'foldr' operation: -- -- > unfoldr f' (foldr f z xs) == xs -- -- if the following holds: -- -- > f' (f x y) = Just (x,y) -- > f' z = Nothing unfoldr :: (b -> Maybe (a, b)) -> b -> [a] unfoldr f b = case f b of Just (a,new_b) -> a : unfoldr f new_b Nothing -> [] -- ----------------------------------------------------------------------------- -- | A strict version of 'foldl'. foldl' :: (a -> b -> a) -> a -> [b] -> a foldl' f a [] = a foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs #ifdef __GLASGOW_HASKELL__ -- | 'foldl1' is a variant of 'foldl' that has no starting value argument, -- and thus must be applied to non-empty lists. foldl1 :: (a -> a -> a) -> [a] -> a foldl1 f (x:xs) = foldl f x xs foldl1 _ [] = errorEmptyList "foldl1" #endif /* __GLASGOW_HASKELL__ */ -- | A strict version of 'foldl1' foldl1' :: (a -> a -> a) -> [a] -> a foldl1' f (x:xs) = foldl' f x xs foldl1' _ [] = errorEmptyList "foldl1'" #ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- List sum and product {-# SPECIALISE sum :: [Int] -> Int #-} {-# SPECIALISE sum :: [Integer] -> Integer #-} {-# SPECIALISE product :: [Int] -> Int #-} {-# SPECIALISE product :: [Integer] -> Integer #-} -- | The 'sum' function computes the sum of a finite list of numbers. sum :: (Num a) => [a] -> a -- | The 'product' function computes the product of a finite list of numbers. product :: (Num a) => [a] -> a #ifdef USE_REPORT_PRELUDE sum = foldl (+) 0 product = foldl (*) 1 #else sum l = sum' l 0 where sum' [] a = a sum' (x:xs) a = sum' xs (a+x) product l = prod l 1 where prod [] a = a prod (x:xs) a = prod xs (a*x) #endif -- ----------------------------------------------------------------------------- -- Functions on strings -- | 'lines' breaks a string up into a list of strings at newline -- characters. The resulting strings do not contain newlines. lines :: String -> [String] lines "" = [] lines s = let (l, s') = break (== '\n') s in l : case s' of [] -> [] (_:s'') -> lines s'' -- | 'unlines' is an inverse operation to 'lines'. -- It joins lines, after appending a terminating newline to each. unlines :: [String] -> String #ifdef USE_REPORT_PRELUDE unlines = concatMap (++ "\n") #else -- HBC version (stolen) -- here's a more efficient version unlines [] = [] unlines (l:ls) = l ++ '\n' : unlines ls #endif -- | 'words' breaks a string up into a list of words, which were delimited -- by white space. words :: String -> [String] words s = case dropWhile {-partain:Char.-}isSpace s of "" -> [] s' -> w : words s'' where (w, s'') = break {-partain:Char.-}isSpace s' -- | 'unwords' is an inverse operation to 'words'. -- It joins words with separating spaces. unwords :: [String] -> String #ifdef USE_REPORT_PRELUDE unwords [] = "" unwords ws = foldr1 (\w s -> w ++ ' ':s) ws #else -- HBC version (stolen) -- here's a more efficient version unwords [] = "" unwords [w] = w unwords (w:ws) = w ++ ' ' : unwords ws #endif #else /* !__GLASGOW_HASKELL__ */ errorEmptyList :: String -> a errorEmptyList fun = error ("Prelude." ++ fun ++ ": empty list") #endif /* !__GLASGOW_HASKELL__ */ hugs98-plus-Sep2006/packages/base/Data/Map.hs0000644006511100651110000017775510504340226017417 0ustar rossross{-# OPTIONS_GHC -fno-bang-patterns #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Map -- Copyright : (c) Daan Leijen 2002 -- License : BSD-style -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- An efficient implementation of maps from keys to values (dictionaries). -- -- Since many function names (but not the type name) clash with -- "Prelude" names, this module is usually imported @qualified@, e.g. -- -- > import Data.Map (Map) -- > import qualified Data.Map as Map -- -- The implementation of 'Map' is based on /size balanced/ binary trees (or -- trees of /bounded balance/) as described by: -- -- * Stephen Adams, \"/Efficient sets: a balancing act/\", -- Journal of Functional Programming 3(4):553-562, October 1993, -- . -- -- * J. Nievergelt and E.M. Reingold, -- \"/Binary search trees of bounded balance/\", -- SIAM journal of computing 2(1), March 1973. -- -- Note that the implementation is /left-biased/ -- the elements of a -- first argument are always preferred to the second, for example in -- 'union' or 'insert'. ----------------------------------------------------------------------------- module Data.Map ( -- * Map type Map -- instance Eq,Show,Read -- * Operators , (!), (\\) -- * Query , null , size , member , notMember , lookup , findWithDefault -- * Construction , empty , singleton -- ** Insertion , insert , insertWith, insertWithKey, insertLookupWithKey , insertWith', insertWithKey' -- ** Delete\/Update , delete , adjust , adjustWithKey , update , updateWithKey , updateLookupWithKey , alter -- * Combine -- ** Union , union , unionWith , unionWithKey , unions , unionsWith -- ** Difference , difference , differenceWith , differenceWithKey -- ** Intersection , intersection , intersectionWith , intersectionWithKey -- * Traversal -- ** Map , map , mapWithKey , mapAccum , mapAccumWithKey , mapKeys , mapKeysWith , mapKeysMonotonic -- ** Fold , fold , foldWithKey -- * Conversion , elems , keys , keysSet , assocs -- ** Lists , toList , fromList , fromListWith , fromListWithKey -- ** Ordered lists , toAscList , fromAscList , fromAscListWith , fromAscListWithKey , fromDistinctAscList -- * Filter , filter , filterWithKey , partition , partitionWithKey , mapMaybe , mapMaybeWithKey , mapEither , mapEitherWithKey , split , splitLookup -- * Submap , isSubmapOf, isSubmapOfBy , isProperSubmapOf, isProperSubmapOfBy -- * Indexed , lookupIndex , findIndex , elemAt , updateAt , deleteAt -- * Min\/Max , findMin , findMax , deleteMin , deleteMax , deleteFindMin , deleteFindMax , updateMin , updateMax , updateMinWithKey , updateMaxWithKey , minView , maxView -- * Debugging , showTree , showTreeWith , valid ) where import Prelude hiding (lookup,map,filter,foldr,foldl,null) import qualified Data.Set as Set import qualified Data.List as List import Data.Monoid (Monoid(..)) import Data.Typeable import Control.Applicative (Applicative(..), (<$>)) import Data.Traversable (Traversable(traverse)) import Data.Foldable (Foldable(foldMap)) {- -- for quick check import qualified Prelude import qualified List import Debug.QuickCheck import List(nub,sort) -} #if __GLASGOW_HASKELL__ import Text.Read import Data.Generics.Basics import Data.Generics.Instances #endif {-------------------------------------------------------------------- Operators --------------------------------------------------------------------} infixl 9 !,\\ -- -- | /O(log n)/. Find the value at a key. -- Calls 'error' when the element can not be found. (!) :: Ord k => Map k a -> k -> a m ! k = find k m -- | /O(n+m)/. See 'difference'. (\\) :: Ord k => Map k a -> Map k b -> Map k a m1 \\ m2 = difference m1 m2 {-------------------------------------------------------------------- Size balanced trees. --------------------------------------------------------------------} -- | A Map from keys @k@ to values @a@. data Map k a = Tip | Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a) type Size = Int instance (Ord k) => Monoid (Map k v) where mempty = empty mappend = union mconcat = unions #if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- A Data instance --------------------------------------------------------------------} -- This instance preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction. instance (Data k, Data a, Ord k) => Data (Map k a) where gfoldl f z map = z fromList `f` (toList map) toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Map.Map" dataCast2 f = gcast2 f #endif {-------------------------------------------------------------------- Query --------------------------------------------------------------------} -- | /O(1)/. Is the map empty? null :: Map k a -> Bool null t = case t of Tip -> True Bin sz k x l r -> False -- | /O(1)/. The number of elements in the map. size :: Map k a -> Int size t = case t of Tip -> 0 Bin sz k x l r -> sz -- | /O(log n)/. Lookup the value at a key in the map. -- -- The function will -- @return@ the result in the monad or @fail@ in it the key isn't in the -- map. Often, the monad to use is 'Maybe', so you get either -- @('Just' result)@ or @'Nothing'@. lookup :: (Monad m,Ord k) => k -> Map k a -> m a lookup k t = case lookup' k t of Just x -> return x Nothing -> fail "Data.Map.lookup: Key not found" lookup' :: Ord k => k -> Map k a -> Maybe a lookup' k t = case t of Tip -> Nothing Bin sz kx x l r -> case compare k kx of LT -> lookup' k l GT -> lookup' k r EQ -> Just x lookupAssoc :: Ord k => k -> Map k a -> Maybe (k,a) lookupAssoc k t = case t of Tip -> Nothing Bin sz kx x l r -> case compare k kx of LT -> lookupAssoc k l GT -> lookupAssoc k r EQ -> Just (kx,x) -- | /O(log n)/. Is the key a member of the map? member :: Ord k => k -> Map k a -> Bool member k m = case lookup k m of Nothing -> False Just x -> True -- | /O(log n)/. Is the key not a member of the map? notMember :: Ord k => k -> Map k a -> Bool notMember k m = not $ member k m -- | /O(log n)/. Find the value at a key. -- Calls 'error' when the element can not be found. find :: Ord k => k -> Map k a -> a find k m = case lookup k m of Nothing -> error "Map.find: element not in the map" Just x -> x -- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns -- the value at key @k@ or returns @def@ when the key is not in the map. findWithDefault :: Ord k => a -> k -> Map k a -> a findWithDefault def k m = case lookup k m of Nothing -> def Just x -> x {-------------------------------------------------------------------- Construction --------------------------------------------------------------------} -- | /O(1)/. The empty map. empty :: Map k a empty = Tip -- | /O(1)/. A map with a single element. singleton :: k -> a -> Map k a singleton k x = Bin 1 k x Tip Tip {-------------------------------------------------------------------- Insertion --------------------------------------------------------------------} -- | /O(log n)/. Insert a new key and value in the map. -- If the key is already present in the map, the associated value is -- replaced with the supplied value, i.e. 'insert' is equivalent to -- @'insertWith' 'const'@. insert :: Ord k => k -> a -> Map k a -> Map k a insert kx x t = case t of Tip -> singleton kx x Bin sz ky y l r -> case compare kx ky of LT -> balance ky y (insert kx x l) r GT -> balance ky y l (insert kx x r) EQ -> Bin sz kx x l r -- | /O(log n)/. Insert with a combining function. -- @'insertWith' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will -- insert the pair @(key, f new_value old_value)@. insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith f k x m = insertWithKey (\k x y -> f x y) k x m -- | Same as 'insertWith', but the combining function is applied strictly. insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith' f k x m = insertWithKey' (\k x y -> f x y) k x m -- | /O(log n)/. Insert with a combining function. -- @'insertWithKey' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will -- insert the pair @(key,f key new_value old_value)@. -- Note that the key passed to f is the same key passed to 'insertWithKey'. insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithKey f kx x t = case t of Tip -> singleton kx x Bin sy ky y l r -> case compare kx ky of LT -> balance ky y (insertWithKey f kx x l) r GT -> balance ky y l (insertWithKey f kx x r) EQ -> Bin sy kx (f kx x y) l r -- | Same as 'insertWithKey', but the combining function is applied strictly. insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithKey' f kx x t = case t of Tip -> singleton kx x Bin sy ky y l r -> case compare kx ky of LT -> balance ky y (insertWithKey' f kx x l) r GT -> balance ky y l (insertWithKey' f kx x r) EQ -> let x' = f kx x y in seq x' (Bin sy kx x' l r) -- | /O(log n)/. The expression (@'insertLookupWithKey' f k x map@) -- is a pair where the first element is equal to (@'lookup' k map@) -- and the second element equal to (@'insertWithKey' f k x map@). insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a,Map k a) insertLookupWithKey f kx x t = case t of Tip -> (Nothing, singleton kx x) Bin sy ky y l r -> case compare kx ky of LT -> let (found,l') = insertLookupWithKey f kx x l in (found,balance ky y l' r) GT -> let (found,r') = insertLookupWithKey f kx x r in (found,balance ky y l r') EQ -> (Just y, Bin sy kx (f kx x y) l r) {-------------------------------------------------------------------- Deletion [delete] is the inlined version of [deleteWith (\k x -> Nothing)] --------------------------------------------------------------------} -- | /O(log n)/. Delete a key and its value from the map. When the key is not -- a member of the map, the original map is returned. delete :: Ord k => k -> Map k a -> Map k a delete k t = case t of Tip -> Tip Bin sx kx x l r -> case compare k kx of LT -> balance kx x (delete k l) r GT -> balance kx x l (delete k r) EQ -> glue l r -- | /O(log n)/. Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. adjust :: Ord k => (a -> a) -> k -> Map k a -> Map k a adjust f k m = adjustWithKey (\k x -> f x) k m -- | /O(log n)/. Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. adjustWithKey :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a adjustWithKey f k m = updateWithKey (\k x -> Just (f k x)) k m -- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@ -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a update f k m = updateWithKey (\k x -> f x) k m -- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the -- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing', -- the element is deleted. If it is (@'Just' y@), the key @k@ is bound -- to the new value @y@. updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a updateWithKey f k t = case t of Tip -> Tip Bin sx kx x l r -> case compare k kx of LT -> balance kx x (updateWithKey f k l) r GT -> balance kx x l (updateWithKey f k r) EQ -> case f kx x of Just x' -> Bin sx kx x' l r Nothing -> glue l r -- | /O(log n)/. Lookup and update. updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a,Map k a) updateLookupWithKey f k t = case t of Tip -> (Nothing,Tip) Bin sx kx x l r -> case compare k kx of LT -> let (found,l') = updateLookupWithKey f k l in (found,balance kx x l' r) GT -> let (found,r') = updateLookupWithKey f k r in (found,balance kx x l r') EQ -> case f kx x of Just x' -> (Just x',Bin sx kx x' l r) Nothing -> (Just x,glue l r) -- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof. -- 'alter' can be used to insert, delete, or update a value in a 'Map'. -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@ alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a alter f k t = case t of Tip -> case f Nothing of Nothing -> Tip Just x -> singleton k x Bin sx kx x l r -> case compare k kx of LT -> balance kx x (alter f k l) r GT -> balance kx x l (alter f k r) EQ -> case f (Just x) of Just x' -> Bin sx kx x' l r Nothing -> glue l r {-------------------------------------------------------------------- Indexing --------------------------------------------------------------------} -- | /O(log n)/. Return the /index/ of a key. The index is a number from -- /0/ up to, but not including, the 'size' of the map. Calls 'error' when -- the key is not a 'member' of the map. findIndex :: Ord k => k -> Map k a -> Int findIndex k t = case lookupIndex k t of Nothing -> error "Map.findIndex: element is not in the map" Just idx -> idx -- | /O(log n)/. Lookup the /index/ of a key. The index is a number from -- /0/ up to, but not including, the 'size' of the map. lookupIndex :: (Monad m,Ord k) => k -> Map k a -> m Int lookupIndex k t = case lookup 0 t of Nothing -> fail "Data.Map.lookupIndex: Key not found." Just x -> return x where lookup idx Tip = Nothing lookup idx (Bin _ kx x l r) = case compare k kx of LT -> lookup idx l GT -> lookup (idx + size l + 1) r EQ -> Just (idx + size l) -- | /O(log n)/. Retrieve an element by /index/. Calls 'error' when an -- invalid index is used. elemAt :: Int -> Map k a -> (k,a) elemAt i Tip = error "Map.elemAt: index out of range" elemAt i (Bin _ kx x l r) = case compare i sizeL of LT -> elemAt i l GT -> elemAt (i-sizeL-1) r EQ -> (kx,x) where sizeL = size l -- | /O(log n)/. Update the element at /index/. Calls 'error' when an -- invalid index is used. updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a updateAt f i Tip = error "Map.updateAt: index out of range" updateAt f i (Bin sx kx x l r) = case compare i sizeL of LT -> updateAt f i l GT -> updateAt f (i-sizeL-1) r EQ -> case f kx x of Just x' -> Bin sx kx x' l r Nothing -> glue l r where sizeL = size l -- | /O(log n)/. Delete the element at /index/. -- Defined as (@'deleteAt' i map = 'updateAt' (\k x -> 'Nothing') i map@). deleteAt :: Int -> Map k a -> Map k a deleteAt i map = updateAt (\k x -> Nothing) i map {-------------------------------------------------------------------- Minimal, Maximal --------------------------------------------------------------------} -- | /O(log n)/. The minimal key of the map. findMin :: Map k a -> (k,a) findMin (Bin _ kx x Tip r) = (kx,x) findMin (Bin _ kx x l r) = findMin l findMin Tip = error "Map.findMin: empty map has no minimal element" -- | /O(log n)/. The maximal key of the map. findMax :: Map k a -> (k,a) findMax (Bin _ kx x l Tip) = (kx,x) findMax (Bin _ kx x l r) = findMax r findMax Tip = error "Map.findMax: empty map has no maximal element" -- | /O(log n)/. Delete the minimal key. deleteMin :: Map k a -> Map k a deleteMin (Bin _ kx x Tip r) = r deleteMin (Bin _ kx x l r) = balance kx x (deleteMin l) r deleteMin Tip = Tip -- | /O(log n)/. Delete the maximal key. deleteMax :: Map k a -> Map k a deleteMax (Bin _ kx x l Tip) = l deleteMax (Bin _ kx x l r) = balance kx x l (deleteMax r) deleteMax Tip = Tip -- | /O(log n)/. Update the value at the minimal key. updateMin :: (a -> Maybe a) -> Map k a -> Map k a updateMin f m = updateMinWithKey (\k x -> f x) m -- | /O(log n)/. Update the value at the maximal key. updateMax :: (a -> Maybe a) -> Map k a -> Map k a updateMax f m = updateMaxWithKey (\k x -> f x) m -- | /O(log n)/. Update the value at the minimal key. updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a updateMinWithKey f t = case t of Bin sx kx x Tip r -> case f kx x of Nothing -> r Just x' -> Bin sx kx x' Tip r Bin sx kx x l r -> balance kx x (updateMinWithKey f l) r Tip -> Tip -- | /O(log n)/. Update the value at the maximal key. updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a updateMaxWithKey f t = case t of Bin sx kx x l Tip -> case f kx x of Nothing -> l Just x' -> Bin sx kx x' l Tip Bin sx kx x l r -> balance kx x l (updateMaxWithKey f r) Tip -> Tip -- | /O(log n)/. Retrieves the minimal key of the map, and the map stripped from that element -- @fail@s (in the monad) when passed an empty map. minView :: Monad m => Map k a -> m (Map k a, (k,a)) minView Tip = fail "Map.minView: empty map" minView x = return (swap $ deleteFindMin x) -- | /O(log n)/. Retrieves the maximal key of the map, and the map stripped from that element -- @fail@s (in the monad) when passed an empty map. maxView :: Monad m => Map k a -> m (Map k a, (k,a)) maxView Tip = fail "Map.maxView: empty map" maxView x = return (swap $ deleteFindMax x) swap (a,b) = (b,a) {-------------------------------------------------------------------- Union. --------------------------------------------------------------------} -- | The union of a list of maps: -- (@'unions' == 'Prelude.foldl' 'union' 'empty'@). unions :: Ord k => [Map k a] -> Map k a unions ts = foldlStrict union empty ts -- | The union of a list of maps, with a combining operation: -- (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@). unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a unionsWith f ts = foldlStrict (unionWith f) empty ts -- | /O(n+m)/. -- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. -- It prefers @t1@ when duplicate keys are encountered, -- i.e. (@'union' == 'unionWith' 'const'@). -- The implementation uses the efficient /hedge-union/ algorithm. -- Hedge-union is more efficient on (bigset `union` smallset) union :: Ord k => Map k a -> Map k a -> Map k a union Tip t2 = t2 union t1 Tip = t1 union t1 t2 = hedgeUnionL (const LT) (const GT) t1 t2 -- left-biased hedge union hedgeUnionL cmplo cmphi t1 Tip = t1 hedgeUnionL cmplo cmphi Tip (Bin _ kx x l r) = join kx x (filterGt cmplo l) (filterLt cmphi r) hedgeUnionL cmplo cmphi (Bin _ kx x l r) t2 = join kx x (hedgeUnionL cmplo cmpkx l (trim cmplo cmpkx t2)) (hedgeUnionL cmpkx cmphi r (trim cmpkx cmphi t2)) where cmpkx k = compare kx k -- right-biased hedge union hedgeUnionR cmplo cmphi t1 Tip = t1 hedgeUnionR cmplo cmphi Tip (Bin _ kx x l r) = join kx x (filterGt cmplo l) (filterLt cmphi r) hedgeUnionR cmplo cmphi (Bin _ kx x l r) t2 = join kx newx (hedgeUnionR cmplo cmpkx l lt) (hedgeUnionR cmpkx cmphi r gt) where cmpkx k = compare kx k lt = trim cmplo cmpkx t2 (found,gt) = trimLookupLo kx cmphi t2 newx = case found of Nothing -> x Just (_,y) -> y {-------------------------------------------------------------------- Union with a combining function --------------------------------------------------------------------} -- | /O(n+m)/. Union with a combining function. The implementation uses the efficient /hedge-union/ algorithm. unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a unionWith f m1 m2 = unionWithKey (\k x y -> f x y) m1 m2 -- | /O(n+m)/. -- Union with a combining function. The implementation uses the efficient /hedge-union/ algorithm. -- Hedge-union is more efficient on (bigset `union` smallset). unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a unionWithKey f Tip t2 = t2 unionWithKey f t1 Tip = t1 unionWithKey f t1 t2 = hedgeUnionWithKey f (const LT) (const GT) t1 t2 hedgeUnionWithKey f cmplo cmphi t1 Tip = t1 hedgeUnionWithKey f cmplo cmphi Tip (Bin _ kx x l r) = join kx x (filterGt cmplo l) (filterLt cmphi r) hedgeUnionWithKey f cmplo cmphi (Bin _ kx x l r) t2 = join kx newx (hedgeUnionWithKey f cmplo cmpkx l lt) (hedgeUnionWithKey f cmpkx cmphi r gt) where cmpkx k = compare kx k lt = trim cmplo cmpkx t2 (found,gt) = trimLookupLo kx cmphi t2 newx = case found of Nothing -> x Just (_,y) -> f kx x y {-------------------------------------------------------------------- Difference --------------------------------------------------------------------} -- | /O(n+m)/. Difference of two maps. -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/. difference :: Ord k => Map k a -> Map k b -> Map k a difference Tip t2 = Tip difference t1 Tip = t1 difference t1 t2 = hedgeDiff (const LT) (const GT) t1 t2 hedgeDiff cmplo cmphi Tip t = Tip hedgeDiff cmplo cmphi (Bin _ kx x l r) Tip = join kx x (filterGt cmplo l) (filterLt cmphi r) hedgeDiff cmplo cmphi t (Bin _ kx x l r) = merge (hedgeDiff cmplo cmpkx (trim cmplo cmpkx t) l) (hedgeDiff cmpkx cmphi (trim cmpkx cmphi t) r) where cmpkx k = compare kx k -- | /O(n+m)/. Difference with a combining function. -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/. differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a differenceWith f m1 m2 = differenceWithKey (\k x y -> f x y) m1 m2 -- | /O(n+m)/. Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the key and both values. -- If it returns 'Nothing', the element is discarded (proper set difference). If -- it returns (@'Just' y@), the element is updated with a new value @y@. -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/. differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a differenceWithKey f Tip t2 = Tip differenceWithKey f t1 Tip = t1 differenceWithKey f t1 t2 = hedgeDiffWithKey f (const LT) (const GT) t1 t2 hedgeDiffWithKey f cmplo cmphi Tip t = Tip hedgeDiffWithKey f cmplo cmphi (Bin _ kx x l r) Tip = join kx x (filterGt cmplo l) (filterLt cmphi r) hedgeDiffWithKey f cmplo cmphi t (Bin _ kx x l r) = case found of Nothing -> merge tl tr Just (ky,y) -> case f ky y x of Nothing -> merge tl tr Just z -> join ky z tl tr where cmpkx k = compare kx k lt = trim cmplo cmpkx t (found,gt) = trimLookupLo kx cmphi t tl = hedgeDiffWithKey f cmplo cmpkx lt l tr = hedgeDiffWithKey f cmpkx cmphi gt r {-------------------------------------------------------------------- Intersection --------------------------------------------------------------------} -- | /O(n+m)/. Intersection of two maps. The values in the first -- map are returned, i.e. (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). intersection :: Ord k => Map k a -> Map k b -> Map k a intersection m1 m2 = intersectionWithKey (\k x y -> x) m1 m2 -- | /O(n+m)/. Intersection with a combining function. intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c intersectionWith f m1 m2 = intersectionWithKey (\k x y -> f x y) m1 m2 -- | /O(n+m)/. Intersection with a combining function. -- Intersection is more efficient on (bigset `intersection` smallset) --intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c --intersectionWithKey f Tip t = Tip --intersectionWithKey f t Tip = Tip --intersectionWithKey f t1 t2 = intersectWithKey f t1 t2 -- --intersectWithKey f Tip t = Tip --intersectWithKey f t Tip = Tip --intersectWithKey f t (Bin _ kx x l r) -- = case found of -- Nothing -> merge tl tr -- Just y -> join kx (f kx y x) tl tr -- where -- (lt,found,gt) = splitLookup kx t -- tl = intersectWithKey f lt l -- tr = intersectWithKey f gt r intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c intersectionWithKey f Tip t = Tip intersectionWithKey f t Tip = Tip intersectionWithKey f t1@(Bin s1 k1 x1 l1 r1) t2@(Bin s2 k2 x2 l2 r2) = if s1 >= s2 then let (lt,found,gt) = splitLookupWithKey k2 t1 tl = intersectionWithKey f lt l2 tr = intersectionWithKey f gt r2 in case found of Just (k,x) -> join k (f k x x2) tl tr Nothing -> merge tl tr else let (lt,found,gt) = splitLookup k1 t2 tl = intersectionWithKey f l1 lt tr = intersectionWithKey f r1 gt in case found of Just x -> join k1 (f k1 x1 x) tl tr Nothing -> merge tl tr {-------------------------------------------------------------------- Submap --------------------------------------------------------------------} -- | /O(n+m)/. -- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool isSubmapOf m1 m2 = isSubmapOfBy (==) m1 m2 {- | /O(n+m)/. The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when applied to their respective values. For example, the following expressions are all 'True': > isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) > isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)]) But the following are all 'False': > isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)]) > isSubmapOfBy (<) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1)]) -} isSubmapOfBy :: Ord k => (a->b->Bool) -> Map k a -> Map k b -> Bool isSubmapOfBy f t1 t2 = (size t1 <= size t2) && (submap' f t1 t2) submap' f Tip t = True submap' f t Tip = False submap' f (Bin _ kx x l r) t = case found of Nothing -> False Just y -> f x y && submap' f l lt && submap' f r gt where (lt,found,gt) = splitLookup kx t -- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@). isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool isProperSubmapOf m1 m2 = isProperSubmapOfBy (==) m1 m2 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, and when @f@ returns 'True' when applied to their respective values. For example, the following expressions are all 'True': > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) But the following are all 'False': > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) > isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) -} isProperSubmapOfBy :: Ord k => (a -> b -> Bool) -> Map k a -> Map k b -> Bool isProperSubmapOfBy f t1 t2 = (size t1 < size t2) && (submap' f t1 t2) {-------------------------------------------------------------------- Filter and partition --------------------------------------------------------------------} -- | /O(n)/. Filter all values that satisfy the predicate. filter :: Ord k => (a -> Bool) -> Map k a -> Map k a filter p m = filterWithKey (\k x -> p x) m -- | /O(n)/. Filter all keys\/values that satisfy the predicate. filterWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> Map k a filterWithKey p Tip = Tip filterWithKey p (Bin _ kx x l r) | p kx x = join kx x (filterWithKey p l) (filterWithKey p r) | otherwise = merge (filterWithKey p l) (filterWithKey p r) -- | /O(n)/. partition the map according to a predicate. The first -- map contains all elements that satisfy the predicate, the second all -- elements that fail the predicate. See also 'split'. partition :: Ord k => (a -> Bool) -> Map k a -> (Map k a,Map k a) partition p m = partitionWithKey (\k x -> p x) m -- | /O(n)/. partition the map according to a predicate. The first -- map contains all elements that satisfy the predicate, the second all -- elements that fail the predicate. See also 'split'. partitionWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> (Map k a,Map k a) partitionWithKey p Tip = (Tip,Tip) partitionWithKey p (Bin _ kx x l r) | p kx x = (join kx x l1 r1,merge l2 r2) | otherwise = (merge l1 r1,join kx x l2 r2) where (l1,l2) = partitionWithKey p l (r1,r2) = partitionWithKey p r -- | /O(n)/. Map values and collect the 'Just' results. mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b mapMaybe f m = mapMaybeWithKey (\k x -> f x) m -- | /O(n)/. Map keys\/values and collect the 'Just' results. mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b mapMaybeWithKey f Tip = Tip mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of Just y -> join kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r) Nothing -> merge (mapMaybeWithKey f l) (mapMaybeWithKey f r) -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. mapEither :: Ord k => (a -> Either b c) -> Map k a -> (Map k b, Map k c) mapEither f m = mapEitherWithKey (\k x -> f x) m -- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results. mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c) mapEitherWithKey f Tip = (Tip, Tip) mapEitherWithKey f (Bin _ kx x l r) = case f kx x of Left y -> (join kx y l1 r1, merge l2 r2) Right z -> (merge l1 r1, join kx z l2 r2) where (l1,l2) = mapEitherWithKey f l (r1,r2) = mapEitherWithKey f r {-------------------------------------------------------------------- Mapping --------------------------------------------------------------------} -- | /O(n)/. Map a function over all values in the map. map :: (a -> b) -> Map k a -> Map k b map f m = mapWithKey (\k x -> f x) m -- | /O(n)/. Map a function over all values in the map. mapWithKey :: (k -> a -> b) -> Map k a -> Map k b mapWithKey f Tip = Tip mapWithKey f (Bin sx kx x l r) = Bin sx kx (f kx x) (mapWithKey f l) (mapWithKey f r) -- | /O(n)/. The function 'mapAccum' threads an accumulating -- argument through the map in ascending order of keys. mapAccum :: (a -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccum f a m = mapAccumWithKey (\a k x -> f a x) a m -- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating -- argument through the map in ascending order of keys. mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccumWithKey f a t = mapAccumL f a t -- | /O(n)/. The function 'mapAccumL' threads an accumulating -- argument throught the map in ascending order of keys. mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccumL f a t = case t of Tip -> (a,Tip) Bin sx kx x l r -> let (a1,l') = mapAccumL f a l (a2,x') = f a1 kx x (a3,r') = mapAccumL f a2 r in (a3,Bin sx kx x' l' r') -- | /O(n)/. The function 'mapAccumR' threads an accumulating -- argument throught the map in descending order of keys. mapAccumR :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccumR f a t = case t of Tip -> (a,Tip) Bin sx kx x l r -> let (a1,r') = mapAccumR f a r (a2,x') = f a1 kx x (a3,l') = mapAccumR f a2 l in (a3,Bin sx kx x' l' r') -- | /O(n*log n)/. -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. -- -- The size of the result may be smaller if @f@ maps two or more distinct -- keys to the same new key. In this case the value at the smallest of -- these keys is retained. mapKeys :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a mapKeys = mapKeysWith (\x y->x) -- | /O(n*log n)/. -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. -- -- The size of the result may be smaller if @f@ maps two or more distinct -- keys to the same new key. In this case the associated values will be -- combined using @c@. mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a mapKeysWith c f = fromListWith c . List.map fFirst . toList where fFirst (x,y) = (f x, y) -- | /O(n)/. -- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ -- is strictly monotonic. -- /The precondition is not checked./ -- Semi-formally, we have: -- -- > and [x < y ==> f x < f y | x <- ls, y <- ls] -- > ==> mapKeysMonotonic f s == mapKeys f s -- > where ls = keys s mapKeysMonotonic :: (k1->k2) -> Map k1 a -> Map k2 a mapKeysMonotonic f Tip = Tip mapKeysMonotonic f (Bin sz k x l r) = Bin sz (f k) x (mapKeysMonotonic f l) (mapKeysMonotonic f r) {-------------------------------------------------------------------- Folds --------------------------------------------------------------------} -- | /O(n)/. Fold the values in the map, such that -- @'fold' f z == 'Prelude.foldr' f z . 'elems'@. -- For example, -- -- > elems map = fold (:) [] map -- fold :: (a -> b -> b) -> b -> Map k a -> b fold f z m = foldWithKey (\k x z -> f x z) z m -- | /O(n)/. Fold the keys and values in the map, such that -- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. -- For example, -- -- > keys map = foldWithKey (\k x ks -> k:ks) [] map -- foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b foldWithKey f z t = foldr f z t -- | /O(n)/. In-order fold. foldi :: (k -> a -> b -> b -> b) -> b -> Map k a -> b foldi f z Tip = z foldi f z (Bin _ kx x l r) = f kx x (foldi f z l) (foldi f z r) -- | /O(n)/. Post-order fold. foldr :: (k -> a -> b -> b) -> b -> Map k a -> b foldr f z Tip = z foldr f z (Bin _ kx x l r) = foldr f (f kx x (foldr f z r)) l -- | /O(n)/. Pre-order fold. foldl :: (b -> k -> a -> b) -> b -> Map k a -> b foldl f z Tip = z foldl f z (Bin _ kx x l r) = foldl f (f (foldl f z l) kx x) r {-------------------------------------------------------------------- List variations --------------------------------------------------------------------} -- | /O(n)/. -- Return all elements of the map in the ascending order of their keys. elems :: Map k a -> [a] elems m = [x | (k,x) <- assocs m] -- | /O(n)/. Return all keys of the map in ascending order. keys :: Map k a -> [k] keys m = [k | (k,x) <- assocs m] -- | /O(n)/. The set of all keys of the map. keysSet :: Map k a -> Set.Set k keysSet m = Set.fromDistinctAscList (keys m) -- | /O(n)/. Return all key\/value pairs in the map in ascending key order. assocs :: Map k a -> [(k,a)] assocs m = toList m {-------------------------------------------------------------------- Lists use [foldlStrict] to reduce demand on the control-stack --------------------------------------------------------------------} -- | /O(n*log n)/. Build a map from a list of key\/value pairs. See also 'fromAscList'. fromList :: Ord k => [(k,a)] -> Map k a fromList xs = foldlStrict ins empty xs where ins t (k,x) = insert k x t -- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a fromListWith f xs = fromListWithKey (\k x y -> f x y) xs -- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'. fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromListWithKey f xs = foldlStrict ins empty xs where ins t (k,x) = insertWithKey f k x t -- | /O(n)/. Convert to a list of key\/value pairs. toList :: Map k a -> [(k,a)] toList t = toAscList t -- | /O(n)/. Convert to an ascending list. toAscList :: Map k a -> [(k,a)] toAscList t = foldr (\k x xs -> (k,x):xs) [] t -- | /O(n)/. toDescList :: Map k a -> [(k,a)] toDescList t = foldl (\xs k x -> (k,x):xs) [] t {-------------------------------------------------------------------- Building trees from ascending/descending lists can be done in linear time. Note that if [xs] is ascending that: fromAscList xs == fromList xs fromAscListWith f xs == fromListWith f xs --------------------------------------------------------------------} -- | /O(n)/. Build a map from an ascending list in linear time. -- /The precondition (input list is ascending) is not checked./ fromAscList :: Eq k => [(k,a)] -> Map k a fromAscList xs = fromAscListWithKey (\k x y -> x) xs -- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys. -- /The precondition (input list is ascending) is not checked./ fromAscListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a fromAscListWith f xs = fromAscListWithKey (\k x y -> f x y) xs -- | /O(n)/. Build a map from an ascending list in linear time with a -- combining function for equal keys. -- /The precondition (input list is ascending) is not checked./ fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromAscListWithKey f xs = fromDistinctAscList (combineEq f xs) where -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs] combineEq f xs = case xs of [] -> [] [x] -> [x] (x:xx) -> combineEq' x xx combineEq' z [] = [z] combineEq' z@(kz,zz) (x@(kx,xx):xs) | kx==kz = let yy = f kx xx zz in combineEq' (kx,yy) xs | otherwise = z:combineEq' x xs -- | /O(n)/. Build a map from an ascending list of distinct elements in linear time. -- /The precondition is not checked./ fromDistinctAscList :: [(k,a)] -> Map k a fromDistinctAscList xs = build const (length xs) xs where -- 1) use continutations so that we use heap space instead of stack space. -- 2) special case for n==5 to build bushier trees. build c 0 xs = c Tip xs build c 5 xs = case xs of ((k1,x1):(k2,x2):(k3,x3):(k4,x4):(k5,x5):xx) -> c (bin k4 x4 (bin k2 x2 (singleton k1 x1) (singleton k3 x3)) (singleton k5 x5)) xx build c n xs = seq nr $ build (buildR nr c) nl xs where nl = n `div` 2 nr = n - nl - 1 buildR n c l ((k,x):ys) = build (buildB l k x c) n ys buildB l k x c r zs = c (bin k x l r) zs {-------------------------------------------------------------------- Utility functions that return sub-ranges of the original tree. Some functions take a comparison function as argument to allow comparisons against infinite values. A function [cmplo k] should be read as [compare lo k]. [trim cmplo cmphi t] A tree that is either empty or where [cmplo k == LT] and [cmphi k == GT] for the key [k] of the root. [filterGt cmp t] A tree where for all keys [k]. [cmp k == LT] [filterLt cmp t] A tree where for all keys [k]. [cmp k == GT] [split k t] Returns two trees [l] and [r] where all keys in [l] are <[k] and all keys in [r] are >[k]. [splitLookup k t] Just like [split] but also returns whether [k] was found in the tree. --------------------------------------------------------------------} {-------------------------------------------------------------------- [trim lo hi t] trims away all subtrees that surely contain no values between the range [lo] to [hi]. The returned tree is either empty or the key of the root is between @lo@ and @hi@. --------------------------------------------------------------------} trim :: (k -> Ordering) -> (k -> Ordering) -> Map k a -> Map k a trim cmplo cmphi Tip = Tip trim cmplo cmphi t@(Bin sx kx x l r) = case cmplo kx of LT -> case cmphi kx of GT -> t le -> trim cmplo cmphi l ge -> trim cmplo cmphi r trimLookupLo :: Ord k => k -> (k -> Ordering) -> Map k a -> (Maybe (k,a), Map k a) trimLookupLo lo cmphi Tip = (Nothing,Tip) trimLookupLo lo cmphi t@(Bin sx kx x l r) = case compare lo kx of LT -> case cmphi kx of GT -> (lookupAssoc lo t, t) le -> trimLookupLo lo cmphi l GT -> trimLookupLo lo cmphi r EQ -> (Just (kx,x),trim (compare lo) cmphi r) {-------------------------------------------------------------------- [filterGt k t] filter all keys >[k] from tree [t] [filterLt k t] filter all keys <[k] from tree [t] --------------------------------------------------------------------} filterGt :: Ord k => (k -> Ordering) -> Map k a -> Map k a filterGt cmp Tip = Tip filterGt cmp (Bin sx kx x l r) = case cmp kx of LT -> join kx x (filterGt cmp l) r GT -> filterGt cmp r EQ -> r filterLt :: Ord k => (k -> Ordering) -> Map k a -> Map k a filterLt cmp Tip = Tip filterLt cmp (Bin sx kx x l r) = case cmp kx of LT -> filterLt cmp l GT -> join kx x l (filterLt cmp r) EQ -> l {-------------------------------------------------------------------- Split --------------------------------------------------------------------} -- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@ where -- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@. split :: Ord k => k -> Map k a -> (Map k a,Map k a) split k Tip = (Tip,Tip) split k (Bin sx kx x l r) = case compare k kx of LT -> let (lt,gt) = split k l in (lt,join kx x gt r) GT -> let (lt,gt) = split k r in (join kx x l lt,gt) EQ -> (l,r) -- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just -- like 'split' but also returns @'lookup' k map@. splitLookup :: Ord k => k -> Map k a -> (Map k a,Maybe a,Map k a) splitLookup k Tip = (Tip,Nothing,Tip) splitLookup k (Bin sx kx x l r) = case compare k kx of LT -> let (lt,z,gt) = splitLookup k l in (lt,z,join kx x gt r) GT -> let (lt,z,gt) = splitLookup k r in (join kx x l lt,z,gt) EQ -> (l,Just x,r) -- | /O(log n)/. splitLookupWithKey :: Ord k => k -> Map k a -> (Map k a,Maybe (k,a),Map k a) splitLookupWithKey k Tip = (Tip,Nothing,Tip) splitLookupWithKey k (Bin sx kx x l r) = case compare k kx of LT -> let (lt,z,gt) = splitLookupWithKey k l in (lt,z,join kx x gt r) GT -> let (lt,z,gt) = splitLookupWithKey k r in (join kx x l lt,z,gt) EQ -> (l,Just (kx, x),r) -- | /O(log n)/. Performs a 'split' but also returns whether the pivot -- element was found in the original set. splitMember :: Ord k => k -> Map k a -> (Map k a,Bool,Map k a) splitMember x t = let (l,m,r) = splitLookup x t in (l,maybe False (const True) m,r) {-------------------------------------------------------------------- Utility functions that maintain the balance properties of the tree. All constructors assume that all values in [l] < [k] and all values in [r] > [k], and that [l] and [r] are valid trees. In order of sophistication: [Bin sz k x l r] The type constructor. [bin k x l r] Maintains the correct size, assumes that both [l] and [r] are balanced with respect to each other. [balance k x l r] Restores the balance and size. Assumes that the original tree was balanced and that [l] or [r] has changed by at most one element. [join k x l r] Restores balance and size. Furthermore, we can construct a new tree from two trees. Both operations assume that all values in [l] < all values in [r] and that [l] and [r] are valid: [glue l r] Glues [l] and [r] together. Assumes that [l] and [r] are already balanced with respect to each other. [merge l r] Merges two trees and restores balance. Note: in contrast to Adam's paper, we use (<=) comparisons instead of (<) comparisons in [join], [merge] and [balance]. Quickcheck (on [difference]) showed that this was necessary in order to maintain the invariants. It is quite unsatisfactory that I haven't been able to find out why this is actually the case! Fortunately, it doesn't hurt to be a bit more conservative. --------------------------------------------------------------------} {-------------------------------------------------------------------- Join --------------------------------------------------------------------} join :: Ord k => k -> a -> Map k a -> Map k a -> Map k a join kx x Tip r = insertMin kx x r join kx x l Tip = insertMax kx x l join kx x l@(Bin sizeL ky y ly ry) r@(Bin sizeR kz z lz rz) | delta*sizeL <= sizeR = balance kz z (join kx x l lz) rz | delta*sizeR <= sizeL = balance ky y ly (join kx x ry r) | otherwise = bin kx x l r -- insertMin and insertMax don't perform potentially expensive comparisons. insertMax,insertMin :: k -> a -> Map k a -> Map k a insertMax kx x t = case t of Tip -> singleton kx x Bin sz ky y l r -> balance ky y l (insertMax kx x r) insertMin kx x t = case t of Tip -> singleton kx x Bin sz ky y l r -> balance ky y (insertMin kx x l) r {-------------------------------------------------------------------- [merge l r]: merges two trees. --------------------------------------------------------------------} merge :: Map k a -> Map k a -> Map k a merge Tip r = r merge l Tip = l merge l@(Bin sizeL kx x lx rx) r@(Bin sizeR ky y ly ry) | delta*sizeL <= sizeR = balance ky y (merge l ly) ry | delta*sizeR <= sizeL = balance kx x lx (merge rx r) | otherwise = glue l r {-------------------------------------------------------------------- [glue l r]: glues two trees together. Assumes that [l] and [r] are already balanced with respect to each other. --------------------------------------------------------------------} glue :: Map k a -> Map k a -> Map k a glue Tip r = r glue l Tip = l glue l r | size l > size r = let ((km,m),l') = deleteFindMax l in balance km m l' r | otherwise = let ((km,m),r') = deleteFindMin r in balance km m l r' -- | /O(log n)/. Delete and find the minimal element. deleteFindMin :: Map k a -> ((k,a),Map k a) deleteFindMin t = case t of Bin _ k x Tip r -> ((k,x),r) Bin _ k x l r -> let (km,l') = deleteFindMin l in (km,balance k x l' r) Tip -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip) -- | /O(log n)/. Delete and find the maximal element. deleteFindMax :: Map k a -> ((k,a),Map k a) deleteFindMax t = case t of Bin _ k x l Tip -> ((k,x),l) Bin _ k x l r -> let (km,r') = deleteFindMax r in (km,balance k x l r') Tip -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip) {-------------------------------------------------------------------- [balance l x r] balances two trees with value x. The sizes of the trees should balance after decreasing the size of one of them. (a rotation). [delta] is the maximal relative difference between the sizes of two trees, it corresponds with the [w] in Adams' paper. [ratio] is the ratio between an outer and inner sibling of the heavier subtree in an unbalanced setting. It determines whether a double or single rotation should be performed to restore balance. It is correspondes with the inverse of $\alpha$ in Adam's article. Note that: - [delta] should be larger than 4.646 with a [ratio] of 2. - [delta] should be larger than 3.745 with a [ratio] of 1.534. - A lower [delta] leads to a more 'perfectly' balanced tree. - A higher [delta] performs less rebalancing. - Balancing is automatic for random data and a balancing scheme is only necessary to avoid pathological worst cases. Almost any choice will do, and in practice, a rather large [delta] may perform better than smaller one. Note: in contrast to Adam's paper, we use a ratio of (at least) [2] to decide whether a single or double rotation is needed. Allthough he actually proves that this ratio is needed to maintain the invariants, his implementation uses an invalid ratio of [1]. --------------------------------------------------------------------} delta,ratio :: Int delta = 5 ratio = 2 balance :: k -> a -> Map k a -> Map k a -> Map k a balance k x l r | sizeL + sizeR <= 1 = Bin sizeX k x l r | sizeR >= delta*sizeL = rotateL k x l r | sizeL >= delta*sizeR = rotateR k x l r | otherwise = Bin sizeX k x l r where sizeL = size l sizeR = size r sizeX = sizeL + sizeR + 1 -- rotate rotateL k x l r@(Bin _ _ _ ly ry) | size ly < ratio*size ry = singleL k x l r | otherwise = doubleL k x l r rotateR k x l@(Bin _ _ _ ly ry) r | size ry < ratio*size ly = singleR k x l r | otherwise = doubleR k x l r -- basic rotations singleL k1 x1 t1 (Bin _ k2 x2 t2 t3) = bin k2 x2 (bin k1 x1 t1 t2) t3 singleR k1 x1 (Bin _ k2 x2 t1 t2) t3 = bin k2 x2 t1 (bin k1 x1 t2 t3) doubleL k1 x1 t1 (Bin _ k2 x2 (Bin _ k3 x3 t2 t3) t4) = bin k3 x3 (bin k1 x1 t1 t2) (bin k2 x2 t3 t4) doubleR k1 x1 (Bin _ k2 x2 t1 (Bin _ k3 x3 t2 t3)) t4 = bin k3 x3 (bin k2 x2 t1 t2) (bin k1 x1 t3 t4) {-------------------------------------------------------------------- The bin constructor maintains the size of the tree --------------------------------------------------------------------} bin :: k -> a -> Map k a -> Map k a -> Map k a bin k x l r = Bin (size l + size r + 1) k x l r {-------------------------------------------------------------------- Eq converts the tree to a list. In a lazy setting, this actually seems one of the faster methods to compare two trees and it is certainly the simplest :-) --------------------------------------------------------------------} instance (Eq k,Eq a) => Eq (Map k a) where t1 == t2 = (size t1 == size t2) && (toAscList t1 == toAscList t2) {-------------------------------------------------------------------- Ord --------------------------------------------------------------------} instance (Ord k, Ord v) => Ord (Map k v) where compare m1 m2 = compare (toAscList m1) (toAscList m2) {-------------------------------------------------------------------- Functor --------------------------------------------------------------------} instance Functor (Map k) where fmap f m = map f m instance Traversable (Map k) where traverse f Tip = pure Tip traverse f (Bin s k v l r) = flip (Bin s k) <$> traverse f l <*> f v <*> traverse f r instance Foldable (Map k) where foldMap _f Tip = mempty foldMap f (Bin _s _k v l r) = foldMap f l `mappend` f v `mappend` foldMap f r {-------------------------------------------------------------------- Read --------------------------------------------------------------------} instance (Ord k, Read k, Read e) => Read (Map k e) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \ r -> do ("fromList",s) <- lex r (xs,t) <- reads s return (fromList xs,t) #endif -- parses a pair of things with the syntax a:=b readPair :: (Read a, Read b) => ReadS (a,b) readPair s = do (a, ct1) <- reads s (":=", ct2) <- lex ct1 (b, ct3) <- reads ct2 return ((a,b), ct3) {-------------------------------------------------------------------- Show --------------------------------------------------------------------} instance (Show k, Show a) => Show (Map k a) where showsPrec d m = showParen (d > 10) $ showString "fromList " . shows (toList m) showMap :: (Show k,Show a) => [(k,a)] -> ShowS showMap [] = showString "{}" showMap (x:xs) = showChar '{' . showElem x . showTail xs where showTail [] = showChar '}' showTail (x:xs) = showString ", " . showElem x . showTail xs showElem (k,x) = shows k . showString " := " . shows x -- | /O(n)/. Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. showTree :: (Show k,Show a) => Map k a -> String showTree m = showTreeWith showElem True False m where showElem k x = show k ++ ":=" ++ show x {- | /O(n)/. The expression (@'showTreeWith' showelem hang wide map@) shows the tree that implements the map. Elements are shown using the @showElem@ function. If @hang@ is 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If @wide@ is 'True', an extra wide version is shown. > Map> let t = fromDistinctAscList [(x,()) | x <- [1..5]] > Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True False t > (4,()) > +--(2,()) > | +--(1,()) > | +--(3,()) > +--(5,()) > > Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True True t > (4,()) > | > +--(2,()) > | | > | +--(1,()) > | | > | +--(3,()) > | > +--(5,()) > > Map> putStrLn $ showTreeWith (\k x -> show (k,x)) False True t > +--(5,()) > | > (4,()) > | > | +--(3,()) > | | > +--(2,()) > | > +--(1,()) -} showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String showTreeWith showelem hang wide t | hang = (showsTreeHang showelem wide [] t) "" | otherwise = (showsTree showelem wide [] [] t) "" showsTree :: (k -> a -> String) -> Bool -> [String] -> [String] -> Map k a -> ShowS showsTree showelem wide lbars rbars t = case t of Tip -> showsBars lbars . showString "|\n" Bin sz kx x Tip Tip -> showsBars lbars . showString (showelem kx x) . showString "\n" Bin sz kx x l r -> showsTree showelem wide (withBar rbars) (withEmpty rbars) r . showWide wide rbars . showsBars lbars . showString (showelem kx x) . showString "\n" . showWide wide lbars . showsTree showelem wide (withEmpty lbars) (withBar lbars) l showsTreeHang :: (k -> a -> String) -> Bool -> [String] -> Map k a -> ShowS showsTreeHang showelem wide bars t = case t of Tip -> showsBars bars . showString "|\n" Bin sz kx x Tip Tip -> showsBars bars . showString (showelem kx x) . showString "\n" Bin sz kx x l r -> showsBars bars . showString (showelem kx x) . showString "\n" . showWide wide bars . showsTreeHang showelem wide (withBar bars) l . showWide wide bars . showsTreeHang showelem wide (withEmpty bars) r showWide wide bars | wide = showString (concat (reverse bars)) . showString "|\n" | otherwise = id showsBars :: [String] -> ShowS showsBars bars = case bars of [] -> id _ -> showString (concat (reverse (tail bars))) . showString node node = "+--" withBar bars = "| ":bars withEmpty bars = " ":bars {-------------------------------------------------------------------- Typeable --------------------------------------------------------------------} #include "Typeable.h" INSTANCE_TYPEABLE2(Map,mapTc,"Map") {-------------------------------------------------------------------- Assertions --------------------------------------------------------------------} -- | /O(n)/. Test if the internal map structure is valid. valid :: Ord k => Map k a -> Bool valid t = balanced t && ordered t && validsize t ordered t = bounded (const True) (const True) t where bounded lo hi t = case t of Tip -> True Bin sz kx x l r -> (lo kx) && (hi kx) && bounded lo (kx) hi r -- | Exported only for "Debug.QuickCheck" balanced :: Map k a -> Bool balanced t = case t of Tip -> True Bin sz kx x l r -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) && balanced l && balanced r validsize t = (realsize t == Just (size t)) where realsize t = case t of Tip -> Just 0 Bin sz kx x l r -> case (realsize l,realsize r) of (Just n,Just m) | n+m+1 == sz -> Just sz other -> Nothing {-------------------------------------------------------------------- Utilities --------------------------------------------------------------------} foldlStrict f z xs = case xs of [] -> z (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx) {- {-------------------------------------------------------------------- Testing --------------------------------------------------------------------} testTree xs = fromList [(x,"*") | x <- xs] test1 = testTree [1..20] test2 = testTree [30,29..10] test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3] {-------------------------------------------------------------------- QuickCheck --------------------------------------------------------------------} qcheck prop = check config prop where config = Config { configMaxTest = 500 , configMaxFail = 5000 , configSize = \n -> (div n 2 + 3) , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ] } {-------------------------------------------------------------------- Arbitrary, reasonably balanced trees --------------------------------------------------------------------} instance (Enum k,Arbitrary a) => Arbitrary (Map k a) where arbitrary = sized (arbtree 0 maxkey) where maxkey = 10000 arbtree :: (Enum k,Arbitrary a) => Int -> Int -> Int -> Gen (Map k a) arbtree lo hi n | n <= 0 = return Tip | lo >= hi = return Tip | otherwise = do{ x <- arbitrary ; i <- choose (lo,hi) ; m <- choose (1,30) ; let (ml,mr) | m==(1::Int)= (1,2) | m==2 = (2,1) | m==3 = (1,1) | otherwise = (2,2) ; l <- arbtree lo (i-1) (n `div` ml) ; r <- arbtree (i+1) hi (n `div` mr) ; return (bin (toEnum i) x l r) } {-------------------------------------------------------------------- Valid tree's --------------------------------------------------------------------} forValid :: (Show k,Enum k,Show a,Arbitrary a,Testable b) => (Map k a -> b) -> Property forValid f = forAll arbitrary $ \t -> -- classify (balanced t) "balanced" $ classify (size t == 0) "empty" $ classify (size t > 0 && size t <= 10) "small" $ classify (size t > 10 && size t <= 64) "medium" $ classify (size t > 64) "large" $ balanced t ==> f t forValidIntTree :: Testable a => (Map Int Int -> a) -> Property forValidIntTree f = forValid f forValidUnitTree :: Testable a => (Map Int () -> a) -> Property forValidUnitTree f = forValid f prop_Valid = forValidUnitTree $ \t -> valid t {-------------------------------------------------------------------- Single, Insert, Delete --------------------------------------------------------------------} prop_Single :: Int -> Int -> Bool prop_Single k x = (insert k x empty == singleton k x) prop_InsertValid :: Int -> Property prop_InsertValid k = forValidUnitTree $ \t -> valid (insert k () t) prop_InsertDelete :: Int -> Map Int () -> Property prop_InsertDelete k t = (lookup k t == Nothing) ==> delete k (insert k () t) == t prop_DeleteValid :: Int -> Property prop_DeleteValid k = forValidUnitTree $ \t -> valid (delete k (insert k () t)) {-------------------------------------------------------------------- Balance --------------------------------------------------------------------} prop_Join :: Int -> Property prop_Join k = forValidUnitTree $ \t -> let (l,r) = split k t in valid (join k () l r) prop_Merge :: Int -> Property prop_Merge k = forValidUnitTree $ \t -> let (l,r) = split k t in valid (merge l r) {-------------------------------------------------------------------- Union --------------------------------------------------------------------} prop_UnionValid :: Property prop_UnionValid = forValidUnitTree $ \t1 -> forValidUnitTree $ \t2 -> valid (union t1 t2) prop_UnionInsert :: Int -> Int -> Map Int Int -> Bool prop_UnionInsert k x t = union (singleton k x) t == insert k x t prop_UnionAssoc :: Map Int Int -> Map Int Int -> Map Int Int -> Bool prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3 prop_UnionComm :: Map Int Int -> Map Int Int -> Bool prop_UnionComm t1 t2 = (union t1 t2 == unionWith (\x y -> y) t2 t1) prop_UnionWithValid = forValidIntTree $ \t1 -> forValidIntTree $ \t2 -> valid (unionWithKey (\k x y -> x+y) t1 t2) prop_UnionWith :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_UnionWith xs ys = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys))) == (sum (Prelude.map snd xs) + sum (Prelude.map snd ys)) prop_DiffValid = forValidUnitTree $ \t1 -> forValidUnitTree $ \t2 -> valid (difference t1 t2) prop_Diff :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_Diff xs ys = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys))) == List.sort ((List.\\) (nub (Prelude.map fst xs)) (nub (Prelude.map fst ys))) prop_IntValid = forValidUnitTree $ \t1 -> forValidUnitTree $ \t2 -> valid (intersection t1 t2) prop_Int :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_Int xs ys = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys))) == List.sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys))) {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} prop_Ordered = forAll (choose (5,100)) $ \n -> let xs = [(x,()) | x <- [0..n::Int]] in fromAscList xs == fromList xs prop_List :: [Int] -> Bool prop_List xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])]) -} hugs98-plus-Sep2006/packages/base/Data/Maybe.hs0000644006511100651110000001131710504340221017707 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Maybe -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- The Maybe type, and associated operations. -- ----------------------------------------------------------------------------- module Data.Maybe ( Maybe(Nothing,Just)-- instance of: Eq, Ord, Show, Read, -- Functor, Monad, MonadPlus , maybe -- :: b -> (a -> b) -> Maybe a -> b , isJust -- :: Maybe a -> Bool , isNothing -- :: Maybe a -> Bool , fromJust -- :: Maybe a -> a , fromMaybe -- :: a -> Maybe a -> a , listToMaybe -- :: [a] -> Maybe a , maybeToList -- :: Maybe a -> [a] , catMaybes -- :: [Maybe a] -> [a] , mapMaybe -- :: (a -> Maybe b) -> [a] -> [b] ) where #ifdef __GLASGOW_HASKELL__ import {-# SOURCE #-} GHC.Err ( error ) import GHC.Base #endif #ifdef __NHC__ import Prelude import Prelude (Maybe(..), maybe) import Maybe ( isJust , isNothing , fromJust , fromMaybe , listToMaybe , maybeToList , catMaybes , mapMaybe ) #else #ifndef __HUGS__ -- --------------------------------------------------------------------------- -- The Maybe type, and instances -- | The 'Maybe' type encapsulates an optional value. A value of type -- @'Maybe' a@ either contains a value of type @a@ (represented as @'Just' a@), -- or it is empty (represented as 'Nothing'). Using 'Maybe' is a good way to -- deal with errors or exceptional cases without resorting to drastic -- measures such as 'error'. -- -- The 'Maybe' type is also a monad. It is a simple kind of error -- monad, where all errors are represented by 'Nothing'. A richer -- error monad can be built using the 'Data.Either.Either' type. data Maybe a = Nothing | Just a deriving (Eq, Ord) instance Functor Maybe where fmap _ Nothing = Nothing fmap f (Just a) = Just (f a) instance Monad Maybe where (Just x) >>= k = k x Nothing >>= _ = Nothing (Just _) >> k = k Nothing >> _ = Nothing return = Just fail _ = Nothing -- --------------------------------------------------------------------------- -- Functions over Maybe -- | The 'maybe' function takes a default value, a function, and a 'Maybe' -- value. If the 'Maybe' value is 'Nothing', the function returns the -- default value. Otherwise, it applies the function to the value inside -- the 'Just' and returns the result. maybe :: b -> (a -> b) -> Maybe a -> b maybe n _ Nothing = n maybe _ f (Just x) = f x #endif /* __HUGS__ */ -- | The 'isJust' function returns 'True' iff its argument is of the -- form @Just _@. isJust :: Maybe a -> Bool isJust Nothing = False isJust _ = True -- | The 'isNothing' function returns 'True' iff its argument is 'Nothing'. isNothing :: Maybe a -> Bool isNothing Nothing = True isNothing _ = False -- | The 'fromJust' function extracts the element out of a 'Just' and -- throws an error if its argument is 'Nothing'. fromJust :: Maybe a -> a fromJust Nothing = error "Maybe.fromJust: Nothing" -- yuck fromJust (Just x) = x -- | The 'fromMaybe' function takes a default value and and 'Maybe' -- value. If the 'Maybe' is 'Nothing', it returns the default values; -- otherwise, it returns the value contained in the 'Maybe'. fromMaybe :: a -> Maybe a -> a fromMaybe d x = case x of {Nothing -> d;Just v -> v} -- | The 'maybeToList' function returns an empty list when given -- 'Nothing' or a singleton list when not given 'Nothing'. maybeToList :: Maybe a -> [a] maybeToList Nothing = [] maybeToList (Just x) = [x] -- | The 'listToMaybe' function returns 'Nothing' on an empty list -- or @'Just' a@ where @a@ is the first element of the list. listToMaybe :: [a] -> Maybe a listToMaybe [] = Nothing listToMaybe (a:_) = Just a -- | The 'catMaybes' function takes a list of 'Maybe's and returns -- a list of all the 'Just' values. catMaybes :: [Maybe a] -> [a] catMaybes ls = [x | Just x <- ls] -- | The 'mapMaybe' function is a version of 'map' which can throw -- out elements. In particular, the functional argument returns -- something of type @'Maybe' b@. If this is 'Nothing', no element -- is added on to the result list. If it just @'Just' b@, then @b@ is -- included in the result list. mapMaybe :: (a -> Maybe b) -> [a] -> [b] mapMaybe _ [] = [] mapMaybe f (x:xs) = let rs = mapMaybe f xs in case f x of Nothing -> rs Just r -> r:rs #endif /* else not __NHC__ */ hugs98-plus-Sep2006/packages/base/Data/Monoid.hs0000644006511100651110000000771510504340222020107 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Monoid -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- The Monoid class with various general-purpose instances. -- -- Inspired by the paper -- /Functional Programming with Overloading and -- Higher-Order Polymorphism/, -- Mark P Jones () -- Advanced School of Functional Programming, 1995. ----------------------------------------------------------------------------- module Data.Monoid ( Monoid(..), Dual(..), Endo(..), All(..), Any(..), Sum(..), Product(..) ) where import Prelude -- --------------------------------------------------------------------------- -- | The monoid class. -- A minimal complete definition must supply 'mempty' and 'mappend', -- and these should satisfy the monoid laws. class Monoid a where mempty :: a -- ^ Identity of 'mappend' mappend :: a -> a -> a -- ^ An associative operation mconcat :: [a] -> a -- ^ Fold a list using the monoid. -- For most types, the default definition for 'mconcat' will be -- used, but the function is included in the class definition so -- that an optimized version can be provided for specific types. mconcat = foldr mappend mempty -- Monoid instances. instance Monoid [a] where mempty = [] mappend = (++) instance Monoid b => Monoid (a -> b) where mempty _ = mempty mappend f g x = f x `mappend` g x instance Monoid () where -- Should it be strict? mempty = () _ `mappend` _ = () mconcat _ = () instance (Monoid a, Monoid b) => Monoid (a,b) where mempty = (mempty, mempty) (a1,b1) `mappend` (a2,b2) = (a1 `mappend` a2, b1 `mappend` b2) instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where mempty = (mempty, mempty, mempty) (a1,b1,c1) `mappend` (a2,b2,c2) = (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2) instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where mempty = (mempty, mempty, mempty, mempty) (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) = (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2, d1 `mappend` d2) instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a,b,c,d,e) where mempty = (mempty, mempty, mempty, mempty, mempty) (a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) = (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2, d1 `mappend` d2, e1 `mappend` e2) -- lexicographical ordering instance Monoid Ordering where mempty = EQ LT `mappend` _ = LT EQ `mappend` y = y GT `mappend` _ = GT -- | The dual of a monoid, obtained by swapping the arguments of 'mappend'. newtype Dual a = Dual { getDual :: a } instance Monoid a => Monoid (Dual a) where mempty = Dual mempty Dual x `mappend` Dual y = Dual (y `mappend` x) -- | The monoid of endomorphisms under composition. newtype Endo a = Endo { appEndo :: a -> a } instance Monoid (Endo a) where mempty = Endo id Endo f `mappend` Endo g = Endo (f . g) -- | Boolean monoid under conjunction. newtype All = All { getAll :: Bool } deriving (Eq, Ord, Read, Show, Bounded) instance Monoid All where mempty = All True All x `mappend` All y = All (x && y) -- | Boolean monoid under disjunction. newtype Any = Any { getAny :: Bool } deriving (Eq, Ord, Read, Show, Bounded) instance Monoid Any where mempty = Any False Any x `mappend` Any y = Any (x || y) -- | Monoid under addition. newtype Sum a = Sum { getSum :: a } deriving (Eq, Ord, Read, Show, Bounded) instance Num a => Monoid (Sum a) where mempty = Sum 0 Sum x `mappend` Sum y = Sum (x + y) -- | Monoid under multiplication. newtype Product a = Product { getProduct :: a } deriving (Eq, Ord, Read, Show, Bounded) instance Num a => Monoid (Product a) where mempty = Product 1 Product x `mappend` Product y = Product (x * y) hugs98-plus-Sep2006/packages/base/Data/Ord.hs0000644006511100651110000000156510504340221017402 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Ord -- Copyright : (c) The University of Glasgow 2005 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- Orderings -- ----------------------------------------------------------------------------- module Data.Ord ( Ord(..), Ordering(..), comparing, ) where #if __GLASGOW_HASKELL__ import GHC.Base #endif -- | -- > comparing p x y = compare (p x) (p y) -- -- Useful combinator for use in conjunction with the @xxxBy@ family -- of functions from "Data.List", for example: -- -- > ... sortBy (comparing fst) ... comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering comparing p x y = compare (p x) (p y) hugs98-plus-Sep2006/packages/base/Data/STRef/0000755006511100651110000000000010504340221017276 5ustar rossrosshugs98-plus-Sep2006/packages/base/Data/STRef/Lazy.hs0000644006511100651110000000224210504340221020551 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.STRef.Lazy -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Control.Monad.ST.Lazy) -- -- Mutable references in the lazy ST monad. -- ----------------------------------------------------------------------------- module Data.STRef.Lazy ( -- * STRefs ST.STRef, -- abstract, instance Eq newSTRef, -- :: a -> ST s (STRef s a) readSTRef, -- :: STRef s a -> ST s a writeSTRef, -- :: STRef s a -> a -> ST s () modifySTRef -- :: STRef s a -> (a -> a) -> ST s () ) where import Control.Monad.ST.Lazy import qualified Data.STRef as ST newSTRef :: a -> ST s (ST.STRef s a) readSTRef :: ST.STRef s a -> ST s a writeSTRef :: ST.STRef s a -> a -> ST s () modifySTRef :: ST.STRef s a -> (a -> a) -> ST s () newSTRef = strictToLazyST . ST.newSTRef readSTRef = strictToLazyST . ST.readSTRef writeSTRef r a = strictToLazyST (ST.writeSTRef r a) modifySTRef r f = strictToLazyST (ST.modifySTRef r f) hugs98-plus-Sep2006/packages/base/Data/STRef/Strict.hs0000644006511100651110000000116110504340221021101 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.STRef.Strict -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (uses Control.Monad.ST.Strict) -- -- Mutable references in the (strict) ST monad (re-export of "Data.STRef") -- ----------------------------------------------------------------------------- module Data.STRef.Strict ( module Data.STRef ) where import Prelude import Data.STRef hugs98-plus-Sep2006/packages/base/Data/Queue.hs0000644006511100651110000000546310504340221017743 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Queue -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- NOTE: This module is DEPRECATED. -- The data structure in "Data.Sequence" is a faster queue and also -- supports a wider variety of operations. -- -- Queues with constant time operations, from -- /Simple and efficient purely functional queues and deques/, -- by Chris Okasaki, /JFP/ 5(4):583-592, October 1995. -- ----------------------------------------------------------------------------- module Data.Queue {-# DEPRECATED "Use Data.Sequence instead: it's faster and has more operations" #-} (Queue, -- * Primitive operations -- | Each of these requires /O(1)/ time in the worst case. emptyQueue, addToQueue, deQueue, -- * Queues and lists listToQueue, queueToList ) where import Prelude -- necessary to get dependencies right import Data.Typeable -- | The type of FIFO queues. data Queue a = Q [a] [a] [a] #include "Typeable.h" INSTANCE_TYPEABLE1(Queue,queueTc,"Queue") -- Invariants for Q xs ys xs': -- length xs = length ys + length xs' -- xs' = drop (length ys) xs -- in fact, shared (except after fmap) -- The queue then represents the list xs ++ reverse ys instance Functor Queue where fmap f (Q xs ys xs') = Q (map f xs) (map f ys) (map f xs') -- The new xs' does not share the tail of the new xs, but it does -- share the tail of the old xs, so it still forces the rotations. -- Note that elements of xs' are ignored. -- | The empty queue. emptyQueue :: Queue a emptyQueue = Q [] [] [] -- | Add an element to the back of a queue. addToQueue :: Queue a -> a -> Queue a addToQueue (Q xs ys xs') y = makeQ xs (y:ys) xs' -- | Attempt to extract the front element from a queue. -- If the queue is empty, 'Nothing', -- otherwise the first element paired with the remainder of the queue. deQueue :: Queue a -> Maybe (a, Queue a) deQueue (Q [] _ _) = Nothing deQueue (Q (x:xs) ys xs') = Just (x, makeQ xs ys xs') -- Assuming -- length ys <= length xs + 1 -- xs' = drop (length ys - 1) xs -- construct a queue respecting the invariant. makeQ :: [a] -> [a] -> [a] -> Queue a makeQ xs ys [] = listToQueue (rotate xs ys []) makeQ xs ys (_:xs') = Q xs ys xs' -- Assuming length ys = length xs + 1, -- rotate xs ys zs = xs ++ reverse ys ++ zs rotate :: [a] -> [a] -> [a] -> [a] rotate [] (y:_) zs = y : zs -- the _ here must be [] rotate (x:xs) (y:ys) zs = x : rotate xs ys (y:zs) -- | A queue with the same elements as the list. listToQueue :: [a] -> Queue a listToQueue xs = Q xs [] xs -- | The elements of a queue, front first. queueToList :: Queue a -> [a] queueToList (Q xs ys _) = xs ++ reverse ys hugs98-plus-Sep2006/packages/base/Data/Ratio.hs0000644006511100651110000000620610504340221017731 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Ratio -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- Standard functions on rational numbers -- ----------------------------------------------------------------------------- module Data.Ratio ( Ratio , Rational , (%) -- :: (Integral a) => a -> a -> Ratio a , numerator -- :: (Integral a) => Ratio a -> a , denominator -- :: (Integral a) => Ratio a -> a , approxRational -- :: (RealFrac a) => a -> a -> Rational -- Ratio instances: -- (Integral a) => Eq (Ratio a) -- (Integral a) => Ord (Ratio a) -- (Integral a) => Num (Ratio a) -- (Integral a) => Real (Ratio a) -- (Integral a) => Fractional (Ratio a) -- (Integral a) => RealFrac (Ratio a) -- (Integral a) => Enum (Ratio a) -- (Read a, Integral a) => Read (Ratio a) -- (Integral a) => Show (Ratio a) ) where import Prelude #ifdef __GLASGOW_HASKELL__ import GHC.Real -- The basic defns for Ratio #endif #ifdef __HUGS__ import Hugs.Prelude(Ratio(..), (%), numerator, denominator) #endif #ifdef __NHC__ import Ratio (Ratio(..), (%), numerator, denominator, approxRational) #else -- ----------------------------------------------------------------------------- -- approxRational -- | 'approxRational', applied to two real fractional numbers @x@ and @epsilon@, -- returns the simplest rational number within @epsilon@ of @x@. -- A rational number @y@ is said to be /simpler/ than another @y'@ if -- -- * @'abs' ('numerator' y) <= 'abs' ('numerator' y')@, and -- -- * @'denominator' y <= 'denominator' y'@. -- -- Any real interval contains a unique simplest rational; -- in particular, note that @0\/1@ is the simplest rational of all. -- Implementation details: Here, for simplicity, we assume a closed rational -- interval. If such an interval includes at least one whole number, then -- the simplest rational is the absolutely least whole number. Otherwise, -- the bounds are of the form q%1 + r%d and q%1 + r'%d', where abs r < d -- and abs r' < d', and the simplest rational is q%1 + the reciprocal of -- the simplest rational between d'%r' and d%r. approxRational :: (RealFrac a) => a -> a -> Rational approxRational rat eps = simplest (rat-eps) (rat+eps) where simplest x y | y < x = simplest y x | x == y = xr | x > 0 = simplest' n d n' d' | y < 0 = - simplest' (-n') d' (-n) d | otherwise = 0 :% 1 where xr = toRational x n = numerator xr d = denominator xr nd' = toRational y n' = numerator nd' d' = denominator nd' simplest' n d n' d' -- assumes 0 < n%d < n'%d' | r == 0 = q :% 1 | q /= q' = (q+1) :% 1 | otherwise = (q*n''+d'') :% n'' where (q,r) = quotRem n d (q',r') = quotRem n' d' nd'' = simplest' d' r' d r n'' = numerator nd'' d'' = denominator nd'' #endif hugs98-plus-Sep2006/packages/base/Data/Sequence.hs0000644006511100651110000011635310504340222020431 0ustar rossross{-# OPTIONS -cpp -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Sequence -- Copyright : (c) Ross Paterson 2005 -- License : BSD-style -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- General purpose finite sequences. -- Apart from being finite and having strict operations, sequences -- also differ from lists in supporting a wider variety of operations -- efficiently. -- -- An amortized running time is given for each operation, with /n/ referring -- to the length of the sequence and /i/ being the integral index used by -- some operations. These bounds hold even in a persistent (shared) setting. -- -- The implementation uses 2-3 finger trees annotated with sizes, -- as described in section 4.2 of -- -- * Ralf Hinze and Ross Paterson, -- \"Finger trees: a simple general-purpose data structure\", -- /Journal of Functional Programming/ 16:2 (2006) pp 197-217. -- -- -- /Note/: Many of these operations have the same names as similar -- operations on lists in the "Prelude". The ambiguity may be resolved -- using either qualification or the @hiding@ clause. -- ----------------------------------------------------------------------------- module Data.Sequence ( Seq, -- * Construction empty, -- :: Seq a singleton, -- :: a -> Seq a (<|), -- :: a -> Seq a -> Seq a (|>), -- :: Seq a -> a -> Seq a (><), -- :: Seq a -> Seq a -> Seq a fromList, -- :: [a] -> Seq a -- * Deconstruction -- ** Queries null, -- :: Seq a -> Bool length, -- :: Seq a -> Int -- ** Views ViewL(..), viewl, -- :: Seq a -> ViewL a ViewR(..), viewr, -- :: Seq a -> ViewR a -- ** Indexing index, -- :: Seq a -> Int -> a adjust, -- :: (a -> a) -> Int -> Seq a -> Seq a update, -- :: Int -> a -> Seq a -> Seq a take, -- :: Int -> Seq a -> Seq a drop, -- :: Int -> Seq a -> Seq a splitAt, -- :: Int -> Seq a -> (Seq a, Seq a) -- * Transformations reverse, -- :: Seq a -> Seq a #if TESTING valid, #endif ) where import Prelude hiding ( null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1, reverse) import qualified Data.List (foldl') import Control.Applicative (Applicative(..), (<$>)) import Control.Monad (MonadPlus(..)) import Data.Monoid (Monoid(..)) import Data.Foldable import Data.Traversable import Data.Typeable #ifdef __GLASGOW_HASKELL__ import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec, readListPrecDefault) import Data.Generics.Basics (Data(..), Fixity(..), constrIndex, mkConstr, mkDataType) #endif #if TESTING import Control.Monad (liftM, liftM3, liftM4) import Test.QuickCheck #endif infixr 5 `consTree` infixl 5 `snocTree` infixr 5 >< infixr 5 <|, :< infixl 5 |>, :> class Sized a where size :: a -> Int -- | General-purpose finite sequences. newtype Seq a = Seq (FingerTree (Elem a)) instance Functor Seq where fmap f (Seq xs) = Seq (fmap (fmap f) xs) instance Foldable Seq where foldr f z (Seq xs) = foldr (flip (foldr f)) z xs foldl f z (Seq xs) = foldl (foldl f) z xs foldr1 f (Seq xs) = getElem (foldr1 f' xs) where f' (Elem x) (Elem y) = Elem (f x y) foldl1 f (Seq xs) = getElem (foldl1 f' xs) where f' (Elem x) (Elem y) = Elem (f x y) instance Traversable Seq where traverse f (Seq xs) = Seq <$> traverse (traverse f) xs instance Monad Seq where return = singleton xs >>= f = foldl' add empty xs where add ys x = ys >< f x instance MonadPlus Seq where mzero = empty mplus = (><) instance Eq a => Eq (Seq a) where xs == ys = length xs == length ys && toList xs == toList ys instance Ord a => Ord (Seq a) where compare xs ys = compare (toList xs) (toList ys) #if TESTING instance Show a => Show (Seq a) where showsPrec p (Seq x) = showsPrec p x #else instance Show a => Show (Seq a) where showsPrec p xs = showParen (p > 10) $ showString "fromList " . shows (toList xs) #endif instance Read a => Read (Seq a) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \ r -> do ("fromList",s) <- lex r (xs,t) <- reads s return (fromList xs,t) #endif instance Monoid (Seq a) where mempty = empty mappend = (><) #include "Typeable.h" INSTANCE_TYPEABLE1(Seq,seqTc,"Seq") #if __GLASGOW_HASKELL__ instance Data a => Data (Seq a) where gfoldl f z s = case viewl s of EmptyL -> z empty x :< xs -> z (<|) `f` x `f` xs gunfold k z c = case constrIndex c of 1 -> z empty 2 -> k (k (z (<|))) _ -> error "gunfold" toConstr xs | null xs = emptyConstr | otherwise = consConstr dataTypeOf _ = seqDataType dataCast1 f = gcast1 f emptyConstr = mkConstr seqDataType "empty" [] Prefix consConstr = mkConstr seqDataType "<|" [] Infix seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr] #endif -- Finger trees data FingerTree a = Empty | Single a | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a) #if TESTING deriving Show #endif instance Sized a => Sized (FingerTree a) where {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-} {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-} size Empty = 0 size (Single x) = size x size (Deep v _ _ _) = v instance Foldable FingerTree where foldr _ z Empty = z foldr f z (Single x) = x `f` z foldr f z (Deep _ pr m sf) = foldr f (foldr (flip (foldr f)) (foldr f z sf) m) pr foldl _ z Empty = z foldl f z (Single x) = z `f` x foldl f z (Deep _ pr m sf) = foldl f (foldl (foldl f) (foldl f z pr) m) sf foldr1 _ Empty = error "foldr1: empty sequence" foldr1 _ (Single x) = x foldr1 f (Deep _ pr m sf) = foldr f (foldr (flip (foldr f)) (foldr1 f sf) m) pr foldl1 _ Empty = error "foldl1: empty sequence" foldl1 _ (Single x) = x foldl1 f (Deep _ pr m sf) = foldl f (foldl (foldl f) (foldl1 f pr) m) sf instance Functor FingerTree where fmap _ Empty = Empty fmap f (Single x) = Single (f x) fmap f (Deep v pr m sf) = Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf) instance Traversable FingerTree where traverse _ Empty = pure Empty traverse f (Single x) = Single <$> f x traverse f (Deep v pr m sf) = Deep v <$> traverse f pr <*> traverse (traverse f) m <*> traverse f sf {-# INLINE deep #-} {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a deep pr m sf = Deep (size pr + size m + size sf) pr m sf -- Digits data Digit a = One a | Two a a | Three a a a | Four a a a a #if TESTING deriving Show #endif instance Foldable Digit where foldr f z (One a) = a `f` z foldr f z (Two a b) = a `f` (b `f` z) foldr f z (Three a b c) = a `f` (b `f` (c `f` z)) foldr f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z))) foldl f z (One a) = z `f` a foldl f z (Two a b) = (z `f` a) `f` b foldl f z (Three a b c) = ((z `f` a) `f` b) `f` c foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d foldr1 f (One a) = a foldr1 f (Two a b) = a `f` b foldr1 f (Three a b c) = a `f` (b `f` c) foldr1 f (Four a b c d) = a `f` (b `f` (c `f` d)) foldl1 f (One a) = a foldl1 f (Two a b) = a `f` b foldl1 f (Three a b c) = (a `f` b) `f` c foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d instance Functor Digit where fmap = fmapDefault instance Traversable Digit where traverse f (One a) = One <$> f a traverse f (Two a b) = Two <$> f a <*> f b traverse f (Three a b c) = Three <$> f a <*> f b <*> f c traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d instance Sized a => Sized (Digit a) where {-# SPECIALIZE instance Sized (Digit (Elem a)) #-} {-# SPECIALIZE instance Sized (Digit (Node a)) #-} size xs = foldl (\ i x -> i + size x) 0 xs {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-} {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-} digitToTree :: Sized a => Digit a -> FingerTree a digitToTree (One a) = Single a digitToTree (Two a b) = deep (One a) Empty (One b) digitToTree (Three a b c) = deep (Two a b) Empty (One c) digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d) -- Nodes data Node a = Node2 {-# UNPACK #-} !Int a a | Node3 {-# UNPACK #-} !Int a a a #if TESTING deriving Show #endif instance Foldable Node where foldr f z (Node2 _ a b) = a `f` (b `f` z) foldr f z (Node3 _ a b c) = a `f` (b `f` (c `f` z)) foldl f z (Node2 _ a b) = (z `f` a) `f` b foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c instance Functor Node where fmap = fmapDefault instance Traversable Node where traverse f (Node2 v a b) = Node2 v <$> f a <*> f b traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c instance Sized (Node a) where size (Node2 v _ _) = v size (Node3 v _ _ _) = v {-# INLINE node2 #-} {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-} {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-} node2 :: Sized a => a -> a -> Node a node2 a b = Node2 (size a + size b) a b {-# INLINE node3 #-} {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-} {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-} node3 :: Sized a => a -> a -> a -> Node a node3 a b c = Node3 (size a + size b + size c) a b c nodeToDigit :: Node a -> Digit a nodeToDigit (Node2 _ a b) = Two a b nodeToDigit (Node3 _ a b c) = Three a b c -- Elements newtype Elem a = Elem { getElem :: a } instance Sized (Elem a) where size _ = 1 instance Functor Elem where fmap f (Elem x) = Elem (f x) instance Foldable Elem where foldr f z (Elem x) = f x z foldl f z (Elem x) = f z x instance Traversable Elem where traverse f (Elem x) = Elem <$> f x #ifdef TESTING instance (Show a) => Show (Elem a) where showsPrec p (Elem x) = showsPrec p x #endif ------------------------------------------------------------------------ -- Construction ------------------------------------------------------------------------ -- | /O(1)/. The empty sequence. empty :: Seq a empty = Seq Empty -- | /O(1)/. A singleton sequence. singleton :: a -> Seq a singleton x = Seq (Single (Elem x)) -- | /O(1)/. Add an element to the left end of a sequence. -- Mnemonic: a triangle with the single element at the pointy end. (<|) :: a -> Seq a -> Seq a x <| Seq xs = Seq (Elem x `consTree` xs) {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-} {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-} consTree :: Sized a => a -> FingerTree a -> FingerTree a consTree a Empty = Single a consTree a (Single b) = deep (One a) Empty (One b) consTree a (Deep s (Four b c d e) m sf) = m `seq` Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf consTree a (Deep s (Three b c d) m sf) = Deep (size a + s) (Four a b c d) m sf consTree a (Deep s (Two b c) m sf) = Deep (size a + s) (Three a b c) m sf consTree a (Deep s (One b) m sf) = Deep (size a + s) (Two a b) m sf -- | /O(1)/. Add an element to the right end of a sequence. -- Mnemonic: a triangle with the single element at the pointy end. (|>) :: Seq a -> a -> Seq a Seq xs |> x = Seq (xs `snocTree` Elem x) {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-} {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-} snocTree :: Sized a => FingerTree a -> a -> FingerTree a snocTree Empty a = Single a snocTree (Single a) b = deep (One a) Empty (One b) snocTree (Deep s pr m (Four a b c d)) e = m `seq` Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e) snocTree (Deep s pr m (Three a b c)) d = Deep (s + size d) pr m (Four a b c d) snocTree (Deep s pr m (Two a b)) c = Deep (s + size c) pr m (Three a b c) snocTree (Deep s pr m (One a)) b = Deep (s + size b) pr m (Two a b) -- | /O(log(min(n1,n2)))/. Concatenate two sequences. (><) :: Seq a -> Seq a -> Seq a Seq xs >< Seq ys = Seq (appendTree0 xs ys) -- The appendTree/addDigits gunk below is machine generated appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a) appendTree0 Empty xs = xs appendTree0 xs Empty = xs appendTree0 (Single x) xs = x `consTree` xs appendTree0 xs (Single x) = xs `snocTree` x appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) = Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a)) addDigits0 m1 (One a) (One b) m2 = appendTree1 m1 (node2 a b) m2 addDigits0 m1 (One a) (Two b c) m2 = appendTree1 m1 (node3 a b c) m2 addDigits0 m1 (One a) (Three b c d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits0 m1 (One a) (Four b c d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Two a b) (One c) m2 = appendTree1 m1 (node3 a b c) m2 addDigits0 m1 (Two a b) (Two c d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits0 m1 (Two a b) (Three c d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Two a b) (Four c d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits0 m1 (Three a b c) (One d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits0 m1 (Three a b c) (Two d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Three a b c) (Three d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits0 m1 (Three a b c) (Four d e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits0 m1 (Four a b c d) (One e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Four a b c d) (Two e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits0 m1 (Four a b c d) (Three e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits0 m1 (Four a b c d) (Four e f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a) appendTree1 Empty a xs = a `consTree` xs appendTree1 xs a Empty = xs `snocTree` a appendTree1 (Single x) a xs = x `consTree` a `consTree` xs appendTree1 xs a (Single x) = xs `snocTree` a `snocTree` x appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) = Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a)) addDigits1 m1 (One a) b (One c) m2 = appendTree1 m1 (node3 a b c) m2 addDigits1 m1 (One a) b (Two c d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits1 m1 (One a) b (Three c d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits1 m1 (One a) b (Four c d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Two a b) c (One d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits1 m1 (Two a b) c (Two d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits1 m1 (Two a b) c (Three d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Two a b) c (Four d e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits1 m1 (Three a b c) d (One e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits1 m1 (Three a b c) d (Two e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Three a b c) d (Three e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits1 m1 (Three a b c) d (Four e f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits1 m1 (Four a b c d) e (One f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Four a b c d) e (Two f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits1 m1 (Four a b c d) e (Three f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a) appendTree2 Empty a b xs = a `consTree` b `consTree` xs appendTree2 xs a b Empty = xs `snocTree` a `snocTree` b appendTree2 (Single x) a b xs = x `consTree` a `consTree` b `consTree` xs appendTree2 xs a b (Single x) = xs `snocTree` a `snocTree` b `snocTree` x appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) = Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a)) addDigits2 m1 (One a) b c (One d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits2 m1 (One a) b c (Two d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits2 m1 (One a) b c (Three d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits2 m1 (One a) b c (Four d e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Two a b) c d (One e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits2 m1 (Two a b) c d (Two e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits2 m1 (Two a b) c d (Three e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Two a b) c d (Four e f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits2 m1 (Three a b c) d e (One f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits2 m1 (Three a b c) d e (Two f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Three a b c) d e (Three f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits2 m1 (Four a b c d) e f (One g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Four a b c d) e f (Two g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a) appendTree3 Empty a b c xs = a `consTree` b `consTree` c `consTree` xs appendTree3 xs a b c Empty = xs `snocTree` a `snocTree` b `snocTree` c appendTree3 (Single x) a b c xs = x `consTree` a `consTree` b `consTree` c `consTree` xs appendTree3 xs a b c (Single x) = xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) = Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2 addDigits3 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a)) addDigits3 m1 (One a) b c d (One e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits3 m1 (One a) b c d (Two e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits3 m1 (One a) b c d (Three e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits3 m1 (One a) b c d (Four e f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Two a b) c d e (One f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits3 m1 (Two a b) c d e (Two f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits3 m1 (Two a b) c d e (Three f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits3 m1 (Three a b c) d e f (One g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits3 m1 (Three a b c) d e f (Two g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits3 m1 (Four a b c d) e f g (One h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a) appendTree4 Empty a b c d xs = a `consTree` b `consTree` c `consTree` d `consTree` xs appendTree4 xs a b c d Empty = xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d appendTree4 (Single x) a b c d xs = x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs appendTree4 xs a b c d (Single x) = xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) = Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2 addDigits4 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a)) addDigits4 m1 (One a) b c d e (One f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits4 m1 (One a) b c d e (Two f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits4 m1 (One a) b c d e (Three f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits4 m1 (One a) b c d e (Four f g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Two a b) c d e f (One g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits4 m1 (Two a b) c d e f (Two g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits4 m1 (Three a b c) d e f g (One h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2 addDigits4 m1 (Four a b c d) e f g h (One i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2 ------------------------------------------------------------------------ -- Deconstruction ------------------------------------------------------------------------ -- | /O(1)/. Is this the empty sequence? null :: Seq a -> Bool null (Seq Empty) = True null _ = False -- | /O(1)/. The number of elements in the sequence. length :: Seq a -> Int length (Seq xs) = size xs -- Views data Maybe2 a b = Nothing2 | Just2 a b -- | View of the left end of a sequence. data ViewL a = EmptyL -- ^ empty sequence | a :< Seq a -- ^ leftmost element and the rest of the sequence #ifndef __HADDOCK__ # if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Read, Data) # else deriving (Eq, Ord, Show, Read) # endif #else instance Eq a => Eq (ViewL a) instance Ord a => Ord (ViewL a) instance Show a => Show (ViewL a) instance Read a => Read (ViewL a) instance Data a => Data (ViewL a) #endif INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL") instance Functor ViewL where fmap = fmapDefault instance Foldable ViewL where foldr f z EmptyL = z foldr f z (x :< xs) = f x (foldr f z xs) foldl f z EmptyL = z foldl f z (x :< xs) = foldl f (f z x) xs foldl1 f EmptyL = error "foldl1: empty view" foldl1 f (x :< xs) = foldl f x xs instance Traversable ViewL where traverse _ EmptyL = pure EmptyL traverse f (x :< xs) = (:<) <$> f x <*> traverse f xs -- | /O(1)/. Analyse the left end of a sequence. viewl :: Seq a -> ViewL a viewl (Seq xs) = case viewLTree xs of Nothing2 -> EmptyL Just2 (Elem x) xs' -> x :< Seq xs' {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-} {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-} viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a) viewLTree Empty = Nothing2 viewLTree (Single a) = Just2 a Empty viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of Nothing2 -> digitToTree sf Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf) viewLTree (Deep s (Two a b) m sf) = Just2 a (Deep (s - size a) (One b) m sf) viewLTree (Deep s (Three a b c) m sf) = Just2 a (Deep (s - size a) (Two b c) m sf) viewLTree (Deep s (Four a b c d) m sf) = Just2 a (Deep (s - size a) (Three b c d) m sf) -- | View of the right end of a sequence. data ViewR a = EmptyR -- ^ empty sequence | Seq a :> a -- ^ the sequence minus the rightmost element, -- and the rightmost element #ifndef __HADDOCK__ # if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Read, Data) # else deriving (Eq, Ord, Show, Read) # endif #else instance Eq a => Eq (ViewR a) instance Ord a => Ord (ViewR a) instance Show a => Show (ViewR a) instance Read a => Read (ViewR a) instance Data a => Data (ViewR a) #endif INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR") instance Functor ViewR where fmap = fmapDefault instance Foldable ViewR where foldr f z EmptyR = z foldr f z (xs :> x) = foldr f (f x z) xs foldl f z EmptyR = z foldl f z (xs :> x) = f (foldl f z xs) x foldr1 f EmptyR = error "foldr1: empty view" foldr1 f (xs :> x) = foldr f x xs instance Traversable ViewR where traverse _ EmptyR = pure EmptyR traverse f (xs :> x) = (:>) <$> traverse f xs <*> f x -- | /O(1)/. Analyse the right end of a sequence. viewr :: Seq a -> ViewR a viewr (Seq xs) = case viewRTree xs of Nothing2 -> EmptyR Just2 xs' (Elem x) -> Seq xs' :> x {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-} {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-} viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a viewRTree Empty = Nothing2 viewRTree (Single z) = Just2 Empty z viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of Nothing2 -> digitToTree pr Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z viewRTree (Deep s pr m (Two y z)) = Just2 (Deep (s - size z) pr m (One y)) z viewRTree (Deep s pr m (Three x y z)) = Just2 (Deep (s - size z) pr m (Two x y)) z viewRTree (Deep s pr m (Four w x y z)) = Just2 (Deep (s - size z) pr m (Three w x y)) z -- Indexing -- | /O(log(min(i,n-i)))/. The element at the specified position index :: Seq a -> Int -> a index (Seq xs) i | 0 <= i && i < size xs = case lookupTree i xs of Place _ (Elem x) -> x | otherwise = error "index out of bounds" data Place a = Place {-# UNPACK #-} !Int a #if TESTING deriving Show #endif {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-} {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-} lookupTree :: Sized a => Int -> FingerTree a -> Place a lookupTree _ Empty = error "lookupTree of empty tree" lookupTree i (Single x) = Place i x lookupTree i (Deep _ pr m sf) | i < spr = lookupDigit i pr | i < spm = case lookupTree (i - spr) m of Place i' xs -> lookupNode i' xs | otherwise = lookupDigit (i - spm) sf where spr = size pr spm = spr + size m {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-} {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-} lookupNode :: Sized a => Int -> Node a -> Place a lookupNode i (Node2 _ a b) | i < sa = Place i a | otherwise = Place (i - sa) b where sa = size a lookupNode i (Node3 _ a b c) | i < sa = Place i a | i < sab = Place (i - sa) b | otherwise = Place (i - sab) c where sa = size a sab = sa + size b {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-} {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-} lookupDigit :: Sized a => Int -> Digit a -> Place a lookupDigit i (One a) = Place i a lookupDigit i (Two a b) | i < sa = Place i a | otherwise = Place (i - sa) b where sa = size a lookupDigit i (Three a b c) | i < sa = Place i a | i < sab = Place (i - sa) b | otherwise = Place (i - sab) c where sa = size a sab = sa + size b lookupDigit i (Four a b c d) | i < sa = Place i a | i < sab = Place (i - sa) b | i < sabc = Place (i - sab) c | otherwise = Place (i - sabc) d where sa = size a sab = sa + size b sabc = sab + size c -- | /O(log(min(i,n-i)))/. Replace the element at the specified position update :: Int -> a -> Seq a -> Seq a update i x = adjust (const x) i -- | /O(log(min(i,n-i)))/. Update the element at the specified position adjust :: (a -> a) -> Int -> Seq a -> Seq a adjust f i (Seq xs) | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) i xs) | otherwise = Seq xs {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-} {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-} adjustTree :: Sized a => (Int -> a -> a) -> Int -> FingerTree a -> FingerTree a adjustTree _ _ Empty = error "adjustTree of empty tree" adjustTree f i (Single x) = Single (f i x) adjustTree f i (Deep s pr m sf) | i < spr = Deep s (adjustDigit f i pr) m sf | i < spm = Deep s pr (adjustTree (adjustNode f) (i - spr) m) sf | otherwise = Deep s pr m (adjustDigit f (i - spm) sf) where spr = size pr spm = spr + size m {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-} {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-} adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a adjustNode f i (Node2 s a b) | i < sa = Node2 s (f i a) b | otherwise = Node2 s a (f (i - sa) b) where sa = size a adjustNode f i (Node3 s a b c) | i < sa = Node3 s (f i a) b c | i < sab = Node3 s a (f (i - sa) b) c | otherwise = Node3 s a b (f (i - sab) c) where sa = size a sab = sa + size b {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-} {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-} adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a adjustDigit f i (One a) = One (f i a) adjustDigit f i (Two a b) | i < sa = Two (f i a) b | otherwise = Two a (f (i - sa) b) where sa = size a adjustDigit f i (Three a b c) | i < sa = Three (f i a) b c | i < sab = Three a (f (i - sa) b) c | otherwise = Three a b (f (i - sab) c) where sa = size a sab = sa + size b adjustDigit f i (Four a b c d) | i < sa = Four (f i a) b c d | i < sab = Four a (f (i - sa) b) c d | i < sabc = Four a b (f (i - sab) c) d | otherwise = Four a b c (f (i- sabc) d) where sa = size a sab = sa + size b sabc = sab + size c -- Splitting -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence. take :: Int -> Seq a -> Seq a take i = fst . splitAt i -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@. drop :: Int -> Seq a -> Seq a drop i = snd . splitAt i -- | /O(log(min(i,n-i)))/. Split a sequence at a given position. splitAt :: Int -> Seq a -> (Seq a, Seq a) splitAt i (Seq xs) = (Seq l, Seq r) where (l, r) = split i xs split :: Int -> FingerTree (Elem a) -> (FingerTree (Elem a), FingerTree (Elem a)) split i Empty = i `seq` (Empty, Empty) split i xs | size xs > i = (l, consTree x r) | otherwise = (xs, Empty) where Split l x r = splitTree i xs data Split t a = Split t a t #if TESTING deriving Show #endif {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-} {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-} splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a splitTree _ Empty = error "splitTree of empty tree" splitTree i (Single x) = i `seq` Split Empty x Empty splitTree i (Deep _ pr m sf) | i < spr = case splitDigit i pr of Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf) | i < spm = case splitTree im m of Split ml xs mr -> case splitNode (im - size ml) xs of Split l x r -> Split (deepR pr ml l) x (deepL r mr sf) | otherwise = case splitDigit (i - spm) sf of Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r) where spr = size pr spm = spr + size m im = i - spr {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a deepL Nothing m sf = case viewLTree m of Nothing2 -> digitToTree sf Just2 a m' -> deep (nodeToDigit a) m' sf deepL (Just pr) m sf = deep pr m sf {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-} {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-} deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a deepR pr m Nothing = case viewRTree m of Nothing2 -> digitToTree pr Just2 m' a -> deep pr m' (nodeToDigit a) deepR pr m (Just sf) = deep pr m sf {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-} {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-} splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a splitNode i (Node2 _ a b) | i < sa = Split Nothing a (Just (One b)) | otherwise = Split (Just (One a)) b Nothing where sa = size a splitNode i (Node3 _ a b c) | i < sa = Split Nothing a (Just (Two b c)) | i < sab = Split (Just (One a)) b (Just (One c)) | otherwise = Split (Just (Two a b)) c Nothing where sa = size a sab = sa + size b {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-} {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-} splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a splitDigit i (One a) = i `seq` Split Nothing a Nothing splitDigit i (Two a b) | i < sa = Split Nothing a (Just (One b)) | otherwise = Split (Just (One a)) b Nothing where sa = size a splitDigit i (Three a b c) | i < sa = Split Nothing a (Just (Two b c)) | i < sab = Split (Just (One a)) b (Just (One c)) | otherwise = Split (Just (Two a b)) c Nothing where sa = size a sab = sa + size b splitDigit i (Four a b c d) | i < sa = Split Nothing a (Just (Three b c d)) | i < sab = Split (Just (One a)) b (Just (Two c d)) | i < sabc = Split (Just (Two a b)) c (Just (One d)) | otherwise = Split (Just (Three a b c)) d Nothing where sa = size a sab = sa + size b sabc = sab + size c ------------------------------------------------------------------------ -- Lists ------------------------------------------------------------------------ -- | /O(n)/. Create a sequence from a finite list of elements. fromList :: [a] -> Seq a fromList = Data.List.foldl' (|>) empty ------------------------------------------------------------------------ -- Reverse ------------------------------------------------------------------------ -- | /O(n)/. The reverse of a sequence. reverse :: Seq a -> Seq a reverse (Seq xs) = Seq (reverseTree id xs) reverseTree :: (a -> a) -> FingerTree a -> FingerTree a reverseTree _ Empty = Empty reverseTree f (Single x) = Single (f x) reverseTree f (Deep s pr m sf) = Deep s (reverseDigit f sf) (reverseTree (reverseNode f) m) (reverseDigit f pr) reverseDigit :: (a -> a) -> Digit a -> Digit a reverseDigit f (One a) = One (f a) reverseDigit f (Two a b) = Two (f b) (f a) reverseDigit f (Three a b c) = Three (f c) (f b) (f a) reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a) reverseNode :: (a -> a) -> Node a -> Node a reverseNode f (Node2 s a b) = Node2 s (f b) (f a) reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a) #if TESTING ------------------------------------------------------------------------ -- QuickCheck ------------------------------------------------------------------------ instance Arbitrary a => Arbitrary (Seq a) where arbitrary = liftM Seq arbitrary coarbitrary (Seq x) = coarbitrary x instance Arbitrary a => Arbitrary (Elem a) where arbitrary = liftM Elem arbitrary coarbitrary (Elem x) = coarbitrary x instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where arbitrary = sized arb where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a) arb 0 = return Empty arb 1 = liftM Single arbitrary arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary coarbitrary Empty = variant 0 coarbitrary (Single x) = variant 1 . coarbitrary x coarbitrary (Deep _ pr m sf) = variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf instance (Arbitrary a, Sized a) => Arbitrary (Node a) where arbitrary = oneof [ liftM2 node2 arbitrary arbitrary, liftM3 node3 arbitrary arbitrary arbitrary] coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b coarbitrary (Node3 _ a b c) = variant 1 . coarbitrary a . coarbitrary b . coarbitrary c instance Arbitrary a => Arbitrary (Digit a) where arbitrary = oneof [ liftM One arbitrary, liftM2 Two arbitrary arbitrary, liftM3 Three arbitrary arbitrary arbitrary, liftM4 Four arbitrary arbitrary arbitrary arbitrary] coarbitrary (One a) = variant 0 . coarbitrary a coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b coarbitrary (Three a b c) = variant 2 . coarbitrary a . coarbitrary b . coarbitrary c coarbitrary (Four a b c d) = variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d ------------------------------------------------------------------------ -- Valid trees ------------------------------------------------------------------------ class Valid a where valid :: a -> Bool instance Valid (Elem a) where valid _ = True instance Valid (Seq a) where valid (Seq xs) = valid xs instance (Sized a, Valid a) => Valid (FingerTree a) where valid Empty = True valid (Single x) = valid x valid (Deep s pr m sf) = s == size pr + size m + size sf && valid pr && valid m && valid sf instance (Sized a, Valid a) => Valid (Node a) where valid (Node2 s a b) = s == size a + size b && valid a && valid b valid (Node3 s a b c) = s == size a + size b + size c && valid a && valid b && valid c instance Valid a => Valid (Digit a) where valid (One a) = valid a valid (Two a b) = valid a && valid b valid (Three a b c) = valid a && valid b && valid c valid (Four a b c d) = valid a && valid b && valid c && valid d #endif hugs98-plus-Sep2006/packages/base/Data/STRef.hs0000644006511100651110000000210710504340221017632 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.STRef -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Control.Monad.ST) -- -- Mutable references in the (strict) ST monad. -- ----------------------------------------------------------------------------- module Data.STRef ( -- * STRefs STRef, -- abstract, instance Eq newSTRef, -- :: a -> ST s (STRef s a) readSTRef, -- :: STRef s a -> ST s a writeSTRef, -- :: STRef s a -> a -> ST s () modifySTRef -- :: STRef s a -> (a -> a) -> ST s () ) where import Prelude #ifdef __GLASGOW_HASKELL__ import GHC.ST import GHC.STRef #endif #ifdef __HUGS__ import Hugs.ST import Data.Typeable #include "Typeable.h" INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef") #endif -- |Mutate the contents of an 'STRef' modifySTRef :: STRef s a -> (a -> a) -> ST s () modifySTRef ref f = writeSTRef ref . f =<< readSTRef ref hugs98-plus-Sep2006/packages/base/Data/Tree.hs0000644006511100651110000001141710504340224017555 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Tree -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Multi-way trees (/aka/ rose trees) and forests. -- ----------------------------------------------------------------------------- module Data.Tree( Tree(..), Forest, -- * Two-dimensional drawing drawTree, drawForest, -- * Extraction flatten, levels, -- * Building trees unfoldTree, unfoldForest, unfoldTreeM, unfoldForestM, unfoldTreeM_BF, unfoldForestM_BF, ) where #ifdef __HADDOCK__ import Prelude #endif import Control.Applicative (Applicative(..), (<$>)) import Control.Monad import Data.Monoid (Monoid(..)) import Data.Sequence (Seq, empty, singleton, (<|), (|>), fromList, ViewL(..), ViewR(..), viewl, viewr) import Data.Foldable (Foldable(foldMap), toList) import Data.Traversable (Traversable(traverse)) import Data.Typeable #ifdef __GLASGOW_HASKELL__ import Data.Generics.Basics (Data) #endif -- | Multi-way trees, also known as /rose trees/. data Tree a = Node { rootLabel :: a, -- ^ label value subForest :: Forest a -- ^ zero or more child trees } #ifndef __HADDOCK__ # ifdef __GLASGOW_HASKELL__ deriving (Eq, Read, Show, Data) # else deriving (Eq, Read, Show) # endif #else /* __HADDOCK__ (which can't figure these out by itself) */ instance Eq a => Eq (Tree a) instance Read a => Read (Tree a) instance Show a => Show (Tree a) instance Data a => Data (Tree a) #endif type Forest a = [Tree a] #include "Typeable.h" INSTANCE_TYPEABLE1(Tree,treeTc,"Tree") instance Functor Tree where fmap f (Node x ts) = Node (f x) (map (fmap f) ts) instance Traversable Tree where traverse f (Node x ts) = Node <$> f x <*> traverse (traverse f) ts instance Foldable Tree where foldMap f (Node x ts) = f x `mappend` foldMap (foldMap f) ts -- | Neat 2-dimensional drawing of a tree. drawTree :: Tree String -> String drawTree = unlines . draw -- | Neat 2-dimensional drawing of a forest. drawForest :: Forest String -> String drawForest = unlines . map drawTree draw :: Tree String -> [String] draw (Node x ts0) = x : drawSubTrees ts0 where drawSubTrees [] = [] drawSubTrees [t] = "|" : shift "`- " " " (draw t) drawSubTrees (t:ts) = "|" : shift "+- " "| " (draw t) ++ drawSubTrees ts shift first other = zipWith (++) (first : repeat other) -- | The elements of a tree in pre-order. flatten :: Tree a -> [a] flatten t = squish t [] where squish (Node x ts) xs = x:Prelude.foldr squish xs ts -- | Lists of nodes at each level of the tree. levels :: Tree a -> [[a]] levels t = map (map rootLabel) $ takeWhile (not . null) $ iterate (concatMap subForest) [t] -- | Build a tree from a seed value unfoldTree :: (b -> (a, [b])) -> b -> Tree a unfoldTree f b = let (a, bs) = f b in Node a (unfoldForest f bs) -- | Build a forest from a list of seed values unfoldForest :: (b -> (a, [b])) -> [b] -> Forest a unfoldForest f = map (unfoldTree f) -- | Monadic tree builder, in depth-first order unfoldTreeM :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a) unfoldTreeM f b = do (a, bs) <- f b ts <- unfoldForestM f bs return (Node a ts) -- | Monadic forest builder, in depth-first order #ifndef __NHC__ unfoldForestM :: Monad m => (b -> m (a, [b])) -> [b] -> m (Forest a) #endif unfoldForestM f = Prelude.mapM (unfoldTreeM f) -- | Monadic tree builder, in breadth-first order, -- using an algorithm adapted from -- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/, -- by Chris Okasaki, /ICFP'00/. unfoldTreeM_BF :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a) unfoldTreeM_BF f b = liftM getElement $ unfoldForestQ f (singleton b) where getElement xs = case viewl xs of x :< _ -> x EmptyL -> error "unfoldTreeM_BF" -- | Monadic forest builder, in breadth-first order, -- using an algorithm adapted from -- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/, -- by Chris Okasaki, /ICFP'00/. unfoldForestM_BF :: Monad m => (b -> m (a, [b])) -> [b] -> m (Forest a) unfoldForestM_BF f = liftM toList . unfoldForestQ f . fromList -- takes a sequence (queue) of seeds -- produces a sequence (reversed queue) of trees of the same length unfoldForestQ :: Monad m => (b -> m (a, [b])) -> Seq b -> m (Seq (Tree a)) unfoldForestQ f aQ = case viewl aQ of EmptyL -> return empty a :< aQ -> do (b, as) <- f a tQ <- unfoldForestQ f (Prelude.foldl (|>) aQ as) let (tQ', ts) = splitOnto [] as tQ return (Node b ts <| tQ') where splitOnto :: [a'] -> [b'] -> Seq a' -> (Seq a', [a']) splitOnto as [] q = (q, as) splitOnto as (_:bs) q = case viewr q of q' :> a -> splitOnto (a:as) bs q' EmptyR -> error "unfoldForestQ" hugs98-plus-Sep2006/packages/base/Data/Set.hs0000644006511100651110000011222710504340226017414 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Set -- Copyright : (c) Daan Leijen 2002 -- License : BSD-style -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- An efficient implementation of sets. -- -- Since many function names (but not the type name) clash with -- "Prelude" names, this module is usually imported @qualified@, e.g. -- -- > import Data.Set (Set) -- > import qualified Data.Set as Set -- -- The implementation of 'Set' is based on /size balanced/ binary trees (or -- trees of /bounded balance/) as described by: -- -- * Stephen Adams, \"/Efficient sets: a balancing act/\", -- Journal of Functional Programming 3(4):553-562, October 1993, -- . -- -- * J. Nievergelt and E.M. Reingold, -- \"/Binary search trees of bounded balance/\", -- SIAM journal of computing 2(1), March 1973. -- -- Note that the implementation is /left-biased/ -- the elements of a -- first argument are always preferred to the second, for example in -- 'union' or 'insert'. Of course, left-biasing can only be observed -- when equality is an equivalence relation instead of structural -- equality. ----------------------------------------------------------------------------- module Data.Set ( -- * Set type Set -- instance Eq,Ord,Show,Read,Data,Typeable -- * Operators , (\\) -- * Query , null , size , member , notMember , isSubsetOf , isProperSubsetOf -- * Construction , empty , singleton , insert , delete -- * Combine , union, unions , difference , intersection -- * Filter , filter , partition , split , splitMember -- * Map , map , mapMonotonic -- * Fold , fold -- * Min\/Max , findMin , findMax , deleteMin , deleteMax , deleteFindMin , deleteFindMax , maxView , minView -- * Conversion -- ** List , elems , toList , fromList -- ** Ordered list , toAscList , fromAscList , fromDistinctAscList -- * Debugging , showTree , showTreeWith , valid ) where import Prelude hiding (filter,foldr,null,map) import qualified Data.List as List import Data.Monoid (Monoid(..)) import Data.Typeable import Data.Foldable (Foldable(foldMap)) {- -- just for testing import QuickCheck import List (nub,sort) import qualified List -} #if __GLASGOW_HASKELL__ import Text.Read import Data.Generics.Basics import Data.Generics.Instances #endif {-------------------------------------------------------------------- Operators --------------------------------------------------------------------} infixl 9 \\ -- -- | /O(n+m)/. See 'difference'. (\\) :: Ord a => Set a -> Set a -> Set a m1 \\ m2 = difference m1 m2 {-------------------------------------------------------------------- Sets are size balanced trees --------------------------------------------------------------------} -- | A set of values @a@. data Set a = Tip | Bin {-# UNPACK #-} !Size a !(Set a) !(Set a) type Size = Int instance Ord a => Monoid (Set a) where mempty = empty mappend = union mconcat = unions instance Foldable Set where foldMap f Tip = mempty foldMap f (Bin _s k l r) = foldMap f l `mappend` f k `mappend` foldMap f r #if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- A Data instance --------------------------------------------------------------------} -- This instance preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction. instance (Data a, Ord a) => Data (Set a) where gfoldl f z set = z fromList `f` (toList set) toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Set.Set" dataCast1 f = gcast1 f #endif {-------------------------------------------------------------------- Query --------------------------------------------------------------------} -- | /O(1)/. Is this the empty set? null :: Set a -> Bool null t = case t of Tip -> True Bin sz x l r -> False -- | /O(1)/. The number of elements in the set. size :: Set a -> Int size t = case t of Tip -> 0 Bin sz x l r -> sz -- | /O(log n)/. Is the element in the set? member :: Ord a => a -> Set a -> Bool member x t = case t of Tip -> False Bin sz y l r -> case compare x y of LT -> member x l GT -> member x r EQ -> True -- | /O(log n)/. Is the element not in the set? notMember :: Ord a => a -> Set a -> Bool notMember x t = not $ member x t {-------------------------------------------------------------------- Construction --------------------------------------------------------------------} -- | /O(1)/. The empty set. empty :: Set a empty = Tip -- | /O(1)/. Create a singleton set. singleton :: a -> Set a singleton x = Bin 1 x Tip Tip {-------------------------------------------------------------------- Insertion, Deletion --------------------------------------------------------------------} -- | /O(log n)/. Insert an element in a set. -- If the set already contains an element equal to the given value, -- it is replaced with the new value. insert :: Ord a => a -> Set a -> Set a insert x t = case t of Tip -> singleton x Bin sz y l r -> case compare x y of LT -> balance y (insert x l) r GT -> balance y l (insert x r) EQ -> Bin sz x l r -- | /O(log n)/. Delete an element from a set. delete :: Ord a => a -> Set a -> Set a delete x t = case t of Tip -> Tip Bin sz y l r -> case compare x y of LT -> balance y (delete x l) r GT -> balance y l (delete x r) EQ -> glue l r {-------------------------------------------------------------------- Subset --------------------------------------------------------------------} -- | /O(n+m)/. Is this a proper subset? (ie. a subset but not equal). isProperSubsetOf :: Ord a => Set a -> Set a -> Bool isProperSubsetOf s1 s2 = (size s1 < size s2) && (isSubsetOf s1 s2) -- | /O(n+m)/. Is this a subset? -- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@. isSubsetOf :: Ord a => Set a -> Set a -> Bool isSubsetOf t1 t2 = (size t1 <= size t2) && (isSubsetOfX t1 t2) isSubsetOfX Tip t = True isSubsetOfX t Tip = False isSubsetOfX (Bin _ x l r) t = found && isSubsetOfX l lt && isSubsetOfX r gt where (lt,found,gt) = splitMember x t {-------------------------------------------------------------------- Minimal, Maximal --------------------------------------------------------------------} -- | /O(log n)/. The minimal element of a set. findMin :: Set a -> a findMin (Bin _ x Tip r) = x findMin (Bin _ x l r) = findMin l findMin Tip = error "Set.findMin: empty set has no minimal element" -- | /O(log n)/. The maximal element of a set. findMax :: Set a -> a findMax (Bin _ x l Tip) = x findMax (Bin _ x l r) = findMax r findMax Tip = error "Set.findMax: empty set has no maximal element" -- | /O(log n)/. Delete the minimal element. deleteMin :: Set a -> Set a deleteMin (Bin _ x Tip r) = r deleteMin (Bin _ x l r) = balance x (deleteMin l) r deleteMin Tip = Tip -- | /O(log n)/. Delete the maximal element. deleteMax :: Set a -> Set a deleteMax (Bin _ x l Tip) = l deleteMax (Bin _ x l r) = balance x l (deleteMax r) deleteMax Tip = Tip {-------------------------------------------------------------------- Union. --------------------------------------------------------------------} -- | The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@). unions :: Ord a => [Set a] -> Set a unions ts = foldlStrict union empty ts -- | /O(n+m)/. The union of two sets, preferring the first set when -- equal elements are encountered. -- The implementation uses the efficient /hedge-union/ algorithm. -- Hedge-union is more efficient on (bigset `union` smallset). union :: Ord a => Set a -> Set a -> Set a union Tip t2 = t2 union t1 Tip = t1 union t1 t2 = hedgeUnion (const LT) (const GT) t1 t2 hedgeUnion cmplo cmphi t1 Tip = t1 hedgeUnion cmplo cmphi Tip (Bin _ x l r) = join x (filterGt cmplo l) (filterLt cmphi r) hedgeUnion cmplo cmphi (Bin _ x l r) t2 = join x (hedgeUnion cmplo cmpx l (trim cmplo cmpx t2)) (hedgeUnion cmpx cmphi r (trim cmpx cmphi t2)) where cmpx y = compare x y {-------------------------------------------------------------------- Difference --------------------------------------------------------------------} -- | /O(n+m)/. Difference of two sets. -- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/. difference :: Ord a => Set a -> Set a -> Set a difference Tip t2 = Tip difference t1 Tip = t1 difference t1 t2 = hedgeDiff (const LT) (const GT) t1 t2 hedgeDiff cmplo cmphi Tip t = Tip hedgeDiff cmplo cmphi (Bin _ x l r) Tip = join x (filterGt cmplo l) (filterLt cmphi r) hedgeDiff cmplo cmphi t (Bin _ x l r) = merge (hedgeDiff cmplo cmpx (trim cmplo cmpx t) l) (hedgeDiff cmpx cmphi (trim cmpx cmphi t) r) where cmpx y = compare x y {-------------------------------------------------------------------- Intersection --------------------------------------------------------------------} -- | /O(n+m)/. The intersection of two sets. -- Elements of the result come from the first set. intersection :: Ord a => Set a -> Set a -> Set a intersection Tip t = Tip intersection t Tip = Tip intersection t1@(Bin s1 x1 l1 r1) t2@(Bin s2 x2 l2 r2) = if s1 >= s2 then let (lt,found,gt) = splitLookup x2 t1 tl = intersection lt l2 tr = intersection gt r2 in case found of Just x -> join x tl tr Nothing -> merge tl tr else let (lt,found,gt) = splitMember x1 t2 tl = intersection l1 lt tr = intersection r1 gt in if found then join x1 tl tr else merge tl tr {-------------------------------------------------------------------- Filter and partition --------------------------------------------------------------------} -- | /O(n)/. Filter all elements that satisfy the predicate. filter :: Ord a => (a -> Bool) -> Set a -> Set a filter p Tip = Tip filter p (Bin _ x l r) | p x = join x (filter p l) (filter p r) | otherwise = merge (filter p l) (filter p r) -- | /O(n)/. Partition the set into two sets, one with all elements that satisfy -- the predicate and one with all elements that don't satisfy the predicate. -- See also 'split'. partition :: Ord a => (a -> Bool) -> Set a -> (Set a,Set a) partition p Tip = (Tip,Tip) partition p (Bin _ x l r) | p x = (join x l1 r1,merge l2 r2) | otherwise = (merge l1 r1,join x l2 r2) where (l1,l2) = partition p l (r1,r2) = partition p r {---------------------------------------------------------------------- Map ----------------------------------------------------------------------} -- | /O(n*log n)/. -- @'map' f s@ is the set obtained by applying @f@ to each element of @s@. -- -- It's worth noting that the size of the result may be smaller if, -- for some @(x,y)@, @x \/= y && f x == f y@ map :: (Ord a, Ord b) => (a->b) -> Set a -> Set b map f = fromList . List.map f . toList -- | /O(n)/. The -- -- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is monotonic. -- /The precondition is not checked./ -- Semi-formally, we have: -- -- > and [x < y ==> f x < f y | x <- ls, y <- ls] -- > ==> mapMonotonic f s == map f s -- > where ls = toList s mapMonotonic :: (a->b) -> Set a -> Set b mapMonotonic f Tip = Tip mapMonotonic f (Bin sz x l r) = Bin sz (f x) (mapMonotonic f l) (mapMonotonic f r) {-------------------------------------------------------------------- Fold --------------------------------------------------------------------} -- | /O(n)/. Fold over the elements of a set in an unspecified order. fold :: (a -> b -> b) -> b -> Set a -> b fold f z s = foldr f z s -- | /O(n)/. Post-order fold. foldr :: (a -> b -> b) -> b -> Set a -> b foldr f z Tip = z foldr f z (Bin _ x l r) = foldr f (f x (foldr f z r)) l {-------------------------------------------------------------------- List variations --------------------------------------------------------------------} -- | /O(n)/. The elements of a set. elems :: Set a -> [a] elems s = toList s {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} -- | /O(n)/. Convert the set to a list of elements. toList :: Set a -> [a] toList s = toAscList s -- | /O(n)/. Convert the set to an ascending list of elements. toAscList :: Set a -> [a] toAscList t = foldr (:) [] t -- | /O(n*log n)/. Create a set from a list of elements. fromList :: Ord a => [a] -> Set a fromList xs = foldlStrict ins empty xs where ins t x = insert x t {-------------------------------------------------------------------- Building trees from ascending/descending lists can be done in linear time. Note that if [xs] is ascending that: fromAscList xs == fromList xs --------------------------------------------------------------------} -- | /O(n)/. Build a set from an ascending list in linear time. -- /The precondition (input list is ascending) is not checked./ fromAscList :: Eq a => [a] -> Set a fromAscList xs = fromDistinctAscList (combineEq xs) where -- [combineEq xs] combines equal elements with [const] in an ordered list [xs] combineEq xs = case xs of [] -> [] [x] -> [x] (x:xx) -> combineEq' x xx combineEq' z [] = [z] combineEq' z (x:xs) | z==x = combineEq' z xs | otherwise = z:combineEq' x xs -- | /O(n)/. Build a set from an ascending list of distinct elements in linear time. -- /The precondition (input list is strictly ascending) is not checked./ fromDistinctAscList :: [a] -> Set a fromDistinctAscList xs = build const (length xs) xs where -- 1) use continutations so that we use heap space instead of stack space. -- 2) special case for n==5 to build bushier trees. build c 0 xs = c Tip xs build c 5 xs = case xs of (x1:x2:x3:x4:x5:xx) -> c (bin x4 (bin x2 (singleton x1) (singleton x3)) (singleton x5)) xx build c n xs = seq nr $ build (buildR nr c) nl xs where nl = n `div` 2 nr = n - nl - 1 buildR n c l (x:ys) = build (buildB l x c) n ys buildB l x c r zs = c (bin x l r) zs {-------------------------------------------------------------------- Eq converts the set to a list. In a lazy setting, this actually seems one of the faster methods to compare two trees and it is certainly the simplest :-) --------------------------------------------------------------------} instance Eq a => Eq (Set a) where t1 == t2 = (size t1 == size t2) && (toAscList t1 == toAscList t2) {-------------------------------------------------------------------- Ord --------------------------------------------------------------------} instance Ord a => Ord (Set a) where compare s1 s2 = compare (toAscList s1) (toAscList s2) {-------------------------------------------------------------------- Show --------------------------------------------------------------------} instance Show a => Show (Set a) where showsPrec p xs = showParen (p > 10) $ showString "fromList " . shows (toList xs) showSet :: (Show a) => [a] -> ShowS showSet [] = showString "{}" showSet (x:xs) = showChar '{' . shows x . showTail xs where showTail [] = showChar '}' showTail (x:xs) = showChar ',' . shows x . showTail xs {-------------------------------------------------------------------- Read --------------------------------------------------------------------} instance (Read a, Ord a) => Read (Set a) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \ r -> do ("fromList",s) <- lex r (xs,t) <- reads s return (fromList xs,t) #endif {-------------------------------------------------------------------- Typeable/Data --------------------------------------------------------------------} #include "Typeable.h" INSTANCE_TYPEABLE1(Set,setTc,"Set") {-------------------------------------------------------------------- Utility functions that return sub-ranges of the original tree. Some functions take a comparison function as argument to allow comparisons against infinite values. A function [cmplo x] should be read as [compare lo x]. [trim cmplo cmphi t] A tree that is either empty or where [cmplo x == LT] and [cmphi x == GT] for the value [x] of the root. [filterGt cmp t] A tree where for all values [k]. [cmp k == LT] [filterLt cmp t] A tree where for all values [k]. [cmp k == GT] [split k t] Returns two trees [l] and [r] where all values in [l] are <[k] and all keys in [r] are >[k]. [splitMember k t] Just like [split] but also returns whether [k] was found in the tree. --------------------------------------------------------------------} {-------------------------------------------------------------------- [trim lo hi t] trims away all subtrees that surely contain no values between the range [lo] to [hi]. The returned tree is either empty or the key of the root is between @lo@ and @hi@. --------------------------------------------------------------------} trim :: (a -> Ordering) -> (a -> Ordering) -> Set a -> Set a trim cmplo cmphi Tip = Tip trim cmplo cmphi t@(Bin sx x l r) = case cmplo x of LT -> case cmphi x of GT -> t le -> trim cmplo cmphi l ge -> trim cmplo cmphi r trimMemberLo :: Ord a => a -> (a -> Ordering) -> Set a -> (Bool, Set a) trimMemberLo lo cmphi Tip = (False,Tip) trimMemberLo lo cmphi t@(Bin sx x l r) = case compare lo x of LT -> case cmphi x of GT -> (member lo t, t) le -> trimMemberLo lo cmphi l GT -> trimMemberLo lo cmphi r EQ -> (True,trim (compare lo) cmphi r) {-------------------------------------------------------------------- [filterGt x t] filter all values >[x] from tree [t] [filterLt x t] filter all values <[x] from tree [t] --------------------------------------------------------------------} filterGt :: (a -> Ordering) -> Set a -> Set a filterGt cmp Tip = Tip filterGt cmp (Bin sx x l r) = case cmp x of LT -> join x (filterGt cmp l) r GT -> filterGt cmp r EQ -> r filterLt :: (a -> Ordering) -> Set a -> Set a filterLt cmp Tip = Tip filterLt cmp (Bin sx x l r) = case cmp x of LT -> filterLt cmp l GT -> join x l (filterLt cmp r) EQ -> l {-------------------------------------------------------------------- Split --------------------------------------------------------------------} -- | /O(log n)/. The expression (@'split' x set@) is a pair @(set1,set2)@ -- where all elements in @set1@ are lower than @x@ and all elements in -- @set2@ larger than @x@. @x@ is not found in neither @set1@ nor @set2@. split :: Ord a => a -> Set a -> (Set a,Set a) split x Tip = (Tip,Tip) split x (Bin sy y l r) = case compare x y of LT -> let (lt,gt) = split x l in (lt,join y gt r) GT -> let (lt,gt) = split x r in (join y l lt,gt) EQ -> (l,r) -- | /O(log n)/. Performs a 'split' but also returns whether the pivot -- element was found in the original set. splitMember :: Ord a => a -> Set a -> (Set a,Bool,Set a) splitMember x t = let (l,m,r) = splitLookup x t in (l,maybe False (const True) m,r) -- | /O(log n)/. Performs a 'split' but also returns the pivot -- element that was found in the original set. splitLookup :: Ord a => a -> Set a -> (Set a,Maybe a,Set a) splitLookup x Tip = (Tip,Nothing,Tip) splitLookup x (Bin sy y l r) = case compare x y of LT -> let (lt,found,gt) = splitLookup x l in (lt,found,join y gt r) GT -> let (lt,found,gt) = splitLookup x r in (join y l lt,found,gt) EQ -> (l,Just y,r) {-------------------------------------------------------------------- Utility functions that maintain the balance properties of the tree. All constructors assume that all values in [l] < [x] and all values in [r] > [x], and that [l] and [r] are valid trees. In order of sophistication: [Bin sz x l r] The type constructor. [bin x l r] Maintains the correct size, assumes that both [l] and [r] are balanced with respect to each other. [balance x l r] Restores the balance and size. Assumes that the original tree was balanced and that [l] or [r] has changed by at most one element. [join x l r] Restores balance and size. Furthermore, we can construct a new tree from two trees. Both operations assume that all values in [l] < all values in [r] and that [l] and [r] are valid: [glue l r] Glues [l] and [r] together. Assumes that [l] and [r] are already balanced with respect to each other. [merge l r] Merges two trees and restores balance. Note: in contrast to Adam's paper, we use (<=) comparisons instead of (<) comparisons in [join], [merge] and [balance]. Quickcheck (on [difference]) showed that this was necessary in order to maintain the invariants. It is quite unsatisfactory that I haven't been able to find out why this is actually the case! Fortunately, it doesn't hurt to be a bit more conservative. --------------------------------------------------------------------} {-------------------------------------------------------------------- Join --------------------------------------------------------------------} join :: a -> Set a -> Set a -> Set a join x Tip r = insertMin x r join x l Tip = insertMax x l join x l@(Bin sizeL y ly ry) r@(Bin sizeR z lz rz) | delta*sizeL <= sizeR = balance z (join x l lz) rz | delta*sizeR <= sizeL = balance y ly (join x ry r) | otherwise = bin x l r -- insertMin and insertMax don't perform potentially expensive comparisons. insertMax,insertMin :: a -> Set a -> Set a insertMax x t = case t of Tip -> singleton x Bin sz y l r -> balance y l (insertMax x r) insertMin x t = case t of Tip -> singleton x Bin sz y l r -> balance y (insertMin x l) r {-------------------------------------------------------------------- [merge l r]: merges two trees. --------------------------------------------------------------------} merge :: Set a -> Set a -> Set a merge Tip r = r merge l Tip = l merge l@(Bin sizeL x lx rx) r@(Bin sizeR y ly ry) | delta*sizeL <= sizeR = balance y (merge l ly) ry | delta*sizeR <= sizeL = balance x lx (merge rx r) | otherwise = glue l r {-------------------------------------------------------------------- [glue l r]: glues two trees together. Assumes that [l] and [r] are already balanced with respect to each other. --------------------------------------------------------------------} glue :: Set a -> Set a -> Set a glue Tip r = r glue l Tip = l glue l r | size l > size r = let (m,l') = deleteFindMax l in balance m l' r | otherwise = let (m,r') = deleteFindMin r in balance m l r' -- | /O(log n)/. Delete and find the minimal element. -- -- > deleteFindMin set = (findMin set, deleteMin set) deleteFindMin :: Set a -> (a,Set a) deleteFindMin t = case t of Bin _ x Tip r -> (x,r) Bin _ x l r -> let (xm,l') = deleteFindMin l in (xm,balance x l' r) Tip -> (error "Set.deleteFindMin: can not return the minimal element of an empty set", Tip) -- | /O(log n)/. Delete and find the maximal element. -- -- > deleteFindMax set = (findMax set, deleteMax set) deleteFindMax :: Set a -> (a,Set a) deleteFindMax t = case t of Bin _ x l Tip -> (x,l) Bin _ x l r -> let (xm,r') = deleteFindMax r in (xm,balance x l r') Tip -> (error "Set.deleteFindMax: can not return the maximal element of an empty set", Tip) -- | /O(log n)/. Retrieves the minimal key of the set, and the set stripped from that element -- @fail@s (in the monad) when passed an empty set. minView :: Monad m => Set a -> m (Set a, a) minView Tip = fail "Set.minView: empty set" minView x = return (swap $ deleteFindMin x) -- | /O(log n)/. Retrieves the maximal key of the set, and the set stripped from that element -- @fail@s (in the monad) when passed an empty set. maxView :: Monad m => Set a -> m (Set a, a) maxView Tip = fail "Set.maxView: empty set" maxView x = return (swap $ deleteFindMax x) swap (a,b) = (b,a) {-------------------------------------------------------------------- [balance x l r] balances two trees with value x. The sizes of the trees should balance after decreasing the size of one of them. (a rotation). [delta] is the maximal relative difference between the sizes of two trees, it corresponds with the [w] in Adams' paper, or equivalently, [1/delta] corresponds with the $\alpha$ in Nievergelt's paper. Adams shows that [delta] should be larger than 3.745 in order to garantee that the rotations can always restore balance. [ratio] is the ratio between an outer and inner sibling of the heavier subtree in an unbalanced setting. It determines whether a double or single rotation should be performed to restore balance. It is correspondes with the inverse of $\alpha$ in Adam's article. Note that: - [delta] should be larger than 4.646 with a [ratio] of 2. - [delta] should be larger than 3.745 with a [ratio] of 1.534. - A lower [delta] leads to a more 'perfectly' balanced tree. - A higher [delta] performs less rebalancing. - Balancing is automatic for random data and a balancing scheme is only necessary to avoid pathological worst cases. Almost any choice will do in practice - Allthough it seems that a rather large [delta] may perform better than smaller one, measurements have shown that the smallest [delta] of 4 is actually the fastest on a wide range of operations. It especially improves performance on worst-case scenarios like a sequence of ordered insertions. Note: in contrast to Adams' paper, we use a ratio of (at least) 2 to decide whether a single or double rotation is needed. Allthough he actually proves that this ratio is needed to maintain the invariants, his implementation uses a (invalid) ratio of 1. He is aware of the problem though since he has put a comment in his original source code that he doesn't care about generating a slightly inbalanced tree since it doesn't seem to matter in practice. However (since we use quickcheck :-) we will stick to strictly balanced trees. --------------------------------------------------------------------} delta,ratio :: Int delta = 4 ratio = 2 balance :: a -> Set a -> Set a -> Set a balance x l r | sizeL + sizeR <= 1 = Bin sizeX x l r | sizeR >= delta*sizeL = rotateL x l r | sizeL >= delta*sizeR = rotateR x l r | otherwise = Bin sizeX x l r where sizeL = size l sizeR = size r sizeX = sizeL + sizeR + 1 -- rotate rotateL x l r@(Bin _ _ ly ry) | size ly < ratio*size ry = singleL x l r | otherwise = doubleL x l r rotateR x l@(Bin _ _ ly ry) r | size ry < ratio*size ly = singleR x l r | otherwise = doubleR x l r -- basic rotations singleL x1 t1 (Bin _ x2 t2 t3) = bin x2 (bin x1 t1 t2) t3 singleR x1 (Bin _ x2 t1 t2) t3 = bin x2 t1 (bin x1 t2 t3) doubleL x1 t1 (Bin _ x2 (Bin _ x3 t2 t3) t4) = bin x3 (bin x1 t1 t2) (bin x2 t3 t4) doubleR x1 (Bin _ x2 t1 (Bin _ x3 t2 t3)) t4 = bin x3 (bin x2 t1 t2) (bin x1 t3 t4) {-------------------------------------------------------------------- The bin constructor maintains the size of the tree --------------------------------------------------------------------} bin :: a -> Set a -> Set a -> Set a bin x l r = Bin (size l + size r + 1) x l r {-------------------------------------------------------------------- Utilities --------------------------------------------------------------------} foldlStrict f z xs = case xs of [] -> z (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx) {-------------------------------------------------------------------- Debugging --------------------------------------------------------------------} -- | /O(n)/. Show the tree that implements the set. The tree is shown -- in a compressed, hanging format. showTree :: Show a => Set a -> String showTree s = showTreeWith True False s {- | /O(n)/. The expression (@showTreeWith hang wide map@) shows the tree that implements the set. If @hang@ is @True@, a /hanging/ tree is shown otherwise a rotated tree is shown. If @wide@ is 'True', an extra wide version is shown. > Set> putStrLn $ showTreeWith True False $ fromDistinctAscList [1..5] > 4 > +--2 > | +--1 > | +--3 > +--5 > > Set> putStrLn $ showTreeWith True True $ fromDistinctAscList [1..5] > 4 > | > +--2 > | | > | +--1 > | | > | +--3 > | > +--5 > > Set> putStrLn $ showTreeWith False True $ fromDistinctAscList [1..5] > +--5 > | > 4 > | > | +--3 > | | > +--2 > | > +--1 -} showTreeWith :: Show a => Bool -> Bool -> Set a -> String showTreeWith hang wide t | hang = (showsTreeHang wide [] t) "" | otherwise = (showsTree wide [] [] t) "" showsTree :: Show a => Bool -> [String] -> [String] -> Set a -> ShowS showsTree wide lbars rbars t = case t of Tip -> showsBars lbars . showString "|\n" Bin sz x Tip Tip -> showsBars lbars . shows x . showString "\n" Bin sz x l r -> showsTree wide (withBar rbars) (withEmpty rbars) r . showWide wide rbars . showsBars lbars . shows x . showString "\n" . showWide wide lbars . showsTree wide (withEmpty lbars) (withBar lbars) l showsTreeHang :: Show a => Bool -> [String] -> Set a -> ShowS showsTreeHang wide bars t = case t of Tip -> showsBars bars . showString "|\n" Bin sz x Tip Tip -> showsBars bars . shows x . showString "\n" Bin sz x l r -> showsBars bars . shows x . showString "\n" . showWide wide bars . showsTreeHang wide (withBar bars) l . showWide wide bars . showsTreeHang wide (withEmpty bars) r showWide wide bars | wide = showString (concat (reverse bars)) . showString "|\n" | otherwise = id showsBars :: [String] -> ShowS showsBars bars = case bars of [] -> id _ -> showString (concat (reverse (tail bars))) . showString node node = "+--" withBar bars = "| ":bars withEmpty bars = " ":bars {-------------------------------------------------------------------- Assertions --------------------------------------------------------------------} -- | /O(n)/. Test if the internal set structure is valid. valid :: Ord a => Set a -> Bool valid t = balanced t && ordered t && validsize t ordered t = bounded (const True) (const True) t where bounded lo hi t = case t of Tip -> True Bin sz x l r -> (lo x) && (hi x) && bounded lo (x) hi r balanced :: Set a -> Bool balanced t = case t of Tip -> True Bin sz x l r -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) && balanced l && balanced r validsize t = (realsize t == Just (size t)) where realsize t = case t of Tip -> Just 0 Bin sz x l r -> case (realsize l,realsize r) of (Just n,Just m) | n+m+1 == sz -> Just sz other -> Nothing {- {-------------------------------------------------------------------- Testing --------------------------------------------------------------------} testTree :: [Int] -> Set Int testTree xs = fromList xs test1 = testTree [1..20] test2 = testTree [30,29..10] test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3] {-------------------------------------------------------------------- QuickCheck --------------------------------------------------------------------} qcheck prop = check config prop where config = Config { configMaxTest = 500 , configMaxFail = 5000 , configSize = \n -> (div n 2 + 3) , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ] } {-------------------------------------------------------------------- Arbitrary, reasonably balanced trees --------------------------------------------------------------------} instance (Enum a) => Arbitrary (Set a) where arbitrary = sized (arbtree 0 maxkey) where maxkey = 10000 arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set a) arbtree lo hi n | n <= 0 = return Tip | lo >= hi = return Tip | otherwise = do{ i <- choose (lo,hi) ; m <- choose (1,30) ; let (ml,mr) | m==(1::Int)= (1,2) | m==2 = (2,1) | m==3 = (1,1) | otherwise = (2,2) ; l <- arbtree lo (i-1) (n `div` ml) ; r <- arbtree (i+1) hi (n `div` mr) ; return (bin (toEnum i) l r) } {-------------------------------------------------------------------- Valid tree's --------------------------------------------------------------------} forValid :: (Enum a,Show a,Testable b) => (Set a -> b) -> Property forValid f = forAll arbitrary $ \t -> -- classify (balanced t) "balanced" $ classify (size t == 0) "empty" $ classify (size t > 0 && size t <= 10) "small" $ classify (size t > 10 && size t <= 64) "medium" $ classify (size t > 64) "large" $ balanced t ==> f t forValidIntTree :: Testable a => (Set Int -> a) -> Property forValidIntTree f = forValid f forValidUnitTree :: Testable a => (Set Int -> a) -> Property forValidUnitTree f = forValid f prop_Valid = forValidUnitTree $ \t -> valid t {-------------------------------------------------------------------- Single, Insert, Delete --------------------------------------------------------------------} prop_Single :: Int -> Bool prop_Single x = (insert x empty == singleton x) prop_InsertValid :: Int -> Property prop_InsertValid k = forValidUnitTree $ \t -> valid (insert k t) prop_InsertDelete :: Int -> Set Int -> Property prop_InsertDelete k t = not (member k t) ==> delete k (insert k t) == t prop_DeleteValid :: Int -> Property prop_DeleteValid k = forValidUnitTree $ \t -> valid (delete k (insert k t)) {-------------------------------------------------------------------- Balance --------------------------------------------------------------------} prop_Join :: Int -> Property prop_Join x = forValidUnitTree $ \t -> let (l,r) = split x t in valid (join x l r) prop_Merge :: Int -> Property prop_Merge x = forValidUnitTree $ \t -> let (l,r) = split x t in valid (merge l r) {-------------------------------------------------------------------- Union --------------------------------------------------------------------} prop_UnionValid :: Property prop_UnionValid = forValidUnitTree $ \t1 -> forValidUnitTree $ \t2 -> valid (union t1 t2) prop_UnionInsert :: Int -> Set Int -> Bool prop_UnionInsert x t = union t (singleton x) == insert x t prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3 prop_UnionComm :: Set Int -> Set Int -> Bool prop_UnionComm t1 t2 = (union t1 t2 == union t2 t1) prop_DiffValid = forValidUnitTree $ \t1 -> forValidUnitTree $ \t2 -> valid (difference t1 t2) prop_Diff :: [Int] -> [Int] -> Bool prop_Diff xs ys = toAscList (difference (fromList xs) (fromList ys)) == List.sort ((List.\\) (nub xs) (nub ys)) prop_IntValid = forValidUnitTree $ \t1 -> forValidUnitTree $ \t2 -> valid (intersection t1 t2) prop_Int :: [Int] -> [Int] -> Bool prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys)) == List.sort (nub ((List.intersect) (xs) (ys))) {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} prop_Ordered = forAll (choose (5,100)) $ \n -> let xs = [0..n::Int] in fromAscList xs == fromList xs prop_List :: [Int] -> Bool prop_List xs = (sort (nub xs) == toList (fromList xs)) -} hugs98-plus-Sep2006/packages/base/Data/Typeable.hs-boot0000644006511100651110000000011610504340222021354 0ustar rossross{-# OPTIONS -fno-implicit-prelude #-} module Data.Typeable where data TypeRep hugs98-plus-Sep2006/packages/base/Data/Traversable.hs0000644006511100651110000001074310504340226021133 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Traversable -- Copyright : Conor McBride and Ross Paterson 2005 -- License : BSD-style (see the LICENSE file in the distribution) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- Class of data structures that can be traversed from left to right, -- performing an action on each element. -- -- See also -- -- * /Applicative Programming with Effects/, -- by Conor McBride and Ross Paterson, online at -- . -- -- * /The Essence of the Iterator Pattern/, -- by Jeremy Gibbons and Bruno Oliveira, -- in /Mathematically-Structured Functional Programming/, 2006, and online at -- . -- -- Note that the functions 'mapM' and 'sequence' generalize "Prelude" -- functions of the same names from lists to any 'Traversable' functor. -- To avoid ambiguity, either import the "Prelude" hiding these names -- or qualify uses of these function names with an alias for this module. module Data.Traversable ( Traversable(..), for, forM, fmapDefault, foldMapDefault, ) where import Prelude hiding (mapM, sequence, foldr) import qualified Prelude (mapM, foldr) import Control.Applicative import Data.Foldable (Foldable()) import Data.Monoid (Monoid) import Data.Array -- | Functors representing data structures that can be traversed from -- left to right. -- -- Minimal complete definition: 'traverse' or 'sequenceA'. -- -- Instances are similar to 'Functor', e.g. given a data type -- -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) -- -- a suitable instance would be -- -- > instance Traversable Tree -- > traverse f Empty = pure Empty -- > traverse f (Leaf x) = Leaf <$> f x -- > traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r -- -- This is suitable even for abstract types, as the laws for '<*>' -- imply a form of associativity. -- -- The superclass instances should satisfy the following: -- -- * In the 'Functor' instance, 'fmap' should be equivalent to traversal -- with the identity applicative functor ('fmapDefault'). -- -- * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be -- equivalent to traversal with a constant applicative functor -- ('foldMapDefault'). -- class (Functor t, Foldable t) => Traversable t where -- | Map each element of a structure to an action, evaluate -- these actions from left to right, and collect the results. traverse :: Applicative f => (a -> f b) -> t a -> f (t b) traverse f = sequenceA . fmap f -- | Evaluate each action in the structure from left to right, -- and collect the results. sequenceA :: Applicative f => t (f a) -> f (t a) sequenceA = traverse id -- | Map each element of a structure to an monadic action, evaluate -- these actions from left to right, and collect the results. mapM :: Monad m => (a -> m b) -> t a -> m (t b) mapM f = unwrapMonad . traverse (WrapMonad . f) -- | Evaluate each monadic action in the structure from left to right, -- and collect the results. sequence :: Monad m => t (m a) -> m (t a) sequence = mapM id -- instances for Prelude types instance Traversable Maybe where traverse f Nothing = pure Nothing traverse f (Just x) = Just <$> f x instance Traversable [] where traverse f = Prelude.foldr cons_f (pure []) where cons_f x ys = (:) <$> f x <*> ys mapM = Prelude.mapM instance Ix i => Traversable (Array i) where traverse f arr = listArray (bounds arr) <$> traverse f (elems arr) -- general functions -- | 'for' is 'traverse' with its arguments flipped. for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b) {-# INLINE for #-} for = flip traverse -- | 'forM' is 'mapM' with its arguments flipped. forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) {-# INLINE forM #-} forM = flip mapM -- | This function may be used as a value for `fmap` in a `Functor` instance. fmapDefault :: Traversable t => (a -> b) -> t a -> t b fmapDefault f = getId . traverse (Id . f) -- | This function may be used as a value for `Data.Foldable.foldMap` -- in a `Foldable` instance. foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m foldMapDefault f = getConst . traverse (Const . f) -- local instances newtype Id a = Id { getId :: a } instance Functor Id where fmap f (Id x) = Id (f x) instance Applicative Id where pure = Id Id f <*> Id x = Id (f x) hugs98-plus-Sep2006/packages/base/Data/Tuple.hs0000644006511100651110000012276310504340221017753 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Tuple -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- The tuple data types, and associated functions. -- ----------------------------------------------------------------------------- module Data.Tuple ( fst -- :: (a,b) -> a , snd -- :: (a,b) -> a , curry -- :: ((a, b) -> c) -> a -> b -> c , uncurry -- :: (a -> b -> c) -> ((a, b) -> c) #ifdef __NHC__ , (,)(..) , (,,)(..) , (,,,)(..) , (,,,,)(..) , (,,,,,)(..) , (,,,,,,)(..) , (,,,,,,,)(..) , (,,,,,,,,)(..) , (,,,,,,,,,)(..) , (,,,,,,,,,,)(..) , (,,,,,,,,,,,)(..) , (,,,,,,,,,,,,)(..) , (,,,,,,,,,,,,,)(..) , (,,,,,,,,,,,,,,)(..) #endif ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base #endif /* __GLASGOW_HASKELL__ */ #ifdef __NHC__ import Prelude import Prelude ( (,)(..) , (,,)(..) , (,,,)(..) , (,,,,)(..) , (,,,,,)(..) , (,,,,,,)(..) , (,,,,,,,)(..) , (,,,,,,,,)(..) , (,,,,,,,,,)(..) , (,,,,,,,,,,)(..) , (,,,,,,,,,,,)(..) , (,,,,,,,,,,,,)(..) , (,,,,,,,,,,,,,)(..) , (,,,,,,,,,,,,,,)(..) -- nhc98's prelude only supplies tuple instances up to size 15 , fst, snd , curry, uncurry ) #endif default () -- Double isn't available yet #ifdef __GLASGOW_HASKELL__ data (,) a b = (,) a b deriving (Eq, Ord) data (,,) a b c = (,,) a b c deriving (Eq, Ord) data (,,,) a b c d = (,,,) a b c d deriving (Eq, Ord) data (,,,,) a b c d e = (,,,,) a b c d e deriving (Eq, Ord) data (,,,,,) a b c d e f = (,,,,,) a b c d e f deriving (Eq, Ord) data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g deriving (Eq, Ord) data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h deriving (Eq, Ord) data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i deriving (Eq, Ord) data (,,,,,,,,,) a b c d e f g h i j = (,,,,,,,,,) a b c d e f g h i j deriving (Eq, Ord) data (,,,,,,,,,,) a b c d e f g h i j k = (,,,,,,,,,,) a b c d e f g h i j k deriving (Eq, Ord) data (,,,,,,,,,,,) a b c d e f g h i j k l = (,,,,,,,,,,,) a b c d e f g h i j k l deriving (Eq, Ord) data (,,,,,,,,,,,,) a b c d e f g h i j k l m = (,,,,,,,,,,,,) a b c d e f g h i j k l m deriving (Eq, Ord) data (,,,,,,,,,,,,,) a b c d e f g h i j k l m n = (,,,,,,,,,,,,,) a b c d e f g h i j k l m n deriving (Eq, Ord) data (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o = (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o deriving (Eq, Ord) data (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p = (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p data (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q = (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q data (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r = (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r data (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s = (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s data (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t = (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t data (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u = (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u data (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v = (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v data (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w = (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w data (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x = (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x data (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y = (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y data (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z = (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z data (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ {- Manuel says: Including one more declaration gives a segmentation fault. data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___ v___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___ v___ -} #endif /* __GLASGOW_HASKELL__ */ -- --------------------------------------------------------------------------- -- Standard functions over tuples #if !defined(__HUGS__) && !defined(__NHC__) -- | Extract the first component of a pair. fst :: (a,b) -> a fst (x,_) = x -- | Extract the second component of a pair. snd :: (a,b) -> b snd (_,y) = y -- | 'curry' converts an uncurried function to a curried function. curry :: ((a, b) -> c) -> a -> b -> c curry f x y = f (x, y) -- | 'uncurry' converts a curried function to a function on pairs. uncurry :: (a -> b -> c) -> ((a, b) -> c) uncurry f p = f (fst p) (snd p) #endif /* neither __HUGS__ nor __NHC__ */ hugs98-plus-Sep2006/packages/base/Data/Typeable.hs0000644006511100651110000005106510504340226020430 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude -fallow-overlapping-instances #-} -- The -fallow-overlapping-instances flag allows the user to over-ride -- the instances for Typeable given here. In particular, we provide an instance -- instance ... => Typeable (s a) -- But a user might want to say -- instance ... => Typeable (MyType a b) ----------------------------------------------------------------------------- -- | -- Module : Data.Typeable -- Copyright : (c) The University of Glasgow, CWI 2001--2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- The 'Typeable' class reifies types to some extent by associating type -- representations to types. These type representations can be compared, -- and one can in turn define a type-safe cast operation. To this end, -- an unsafe cast is guarded by a test for type (representation) -- equivalence. The module "Data.Dynamic" uses Typeable for an -- implementation of dynamics. The module "Data.Generics" uses Typeable -- and type-safe cast (but not dynamics) to support the \"Scrap your -- boilerplate\" style of generic programming. -- ----------------------------------------------------------------------------- module Data.Typeable ( -- * The Typeable class Typeable( typeOf ), -- :: a -> TypeRep -- * Type-safe cast cast, -- :: (Typeable a, Typeable b) => a -> Maybe b gcast, -- a generalisation of cast -- * Type representations TypeRep, -- abstract, instance of: Eq, Show, Typeable TyCon, -- abstract, instance of: Eq, Show, Typeable -- * Construction of type representations mkTyCon, -- :: String -> TyCon mkTyConApp, -- :: TyCon -> [TypeRep] -> TypeRep mkAppTy, -- :: TypeRep -> TypeRep -> TypeRep mkFunTy, -- :: TypeRep -> TypeRep -> TypeRep -- * Observation of type representations splitTyConApp, -- :: TypeRep -> (TyCon, [TypeRep]) funResultTy, -- :: TypeRep -> TypeRep -> Maybe TypeRep typeRepTyCon, -- :: TypeRep -> TyCon typeRepArgs, -- :: TypeRep -> [TypeRep] tyConString, -- :: TyCon -> String -- * The other Typeable classes -- | /Note:/ The general instances are provided for GHC only. Typeable1( typeOf1 ), -- :: t a -> TypeRep Typeable2( typeOf2 ), -- :: t a b -> TypeRep Typeable3( typeOf3 ), -- :: t a b c -> TypeRep Typeable4( typeOf4 ), -- :: t a b c d -> TypeRep Typeable5( typeOf5 ), -- :: t a b c d e -> TypeRep Typeable6( typeOf6 ), -- :: t a b c d e f -> TypeRep Typeable7( typeOf7 ), -- :: t a b c d e f g -> TypeRep gcast1, -- :: ... => c (t a) -> Maybe (c (t' a)) gcast2, -- :: ... => c (t a b) -> Maybe (c (t' a b)) -- * Default instances -- | /Note:/ These are not needed by GHC, for which these instances -- are generated by general instance declarations. typeOfDefault, -- :: (Typeable1 t, Typeable a) => t a -> TypeRep typeOf1Default, -- :: (Typeable2 t, Typeable a) => t a b -> TypeRep typeOf2Default, -- :: (Typeable3 t, Typeable a) => t a b c -> TypeRep typeOf3Default, -- :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep typeOf4Default, -- :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep typeOf5Default, -- :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep typeOf6Default -- :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep ) where import qualified Data.HashTable as HT import Data.Maybe import Data.Either import Data.Int import Data.Word import Data.List( foldl ) #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Show import GHC.Err import GHC.Num import GHC.Float import GHC.Real ( rem, Ratio ) import GHC.IOBase (IORef,newIORef,unsafePerformIO) -- These imports are so we can define Typeable instances -- It'd be better to give Typeable instances in the modules themselves -- but they all have to be compiled before Typeable import GHC.IOBase ( IO, MVar, Exception, ArithException, IOException, ArrayException, AsyncException, Handle ) import GHC.ST ( ST ) import GHC.STRef ( STRef ) import GHC.Ptr ( Ptr, FunPtr ) import GHC.ForeignPtr ( ForeignPtr ) import GHC.Stable ( StablePtr, newStablePtr, freeStablePtr, deRefStablePtr, castStablePtrToPtr, castPtrToStablePtr ) import GHC.Exception ( block ) import GHC.Arr ( Array, STArray ) #endif #ifdef __HUGS__ import Hugs.Prelude ( Key(..), TypeRep(..), TyCon(..), Ratio, Exception, ArithException, IOException, ArrayException, AsyncException, Handle, Ptr, FunPtr, ForeignPtr, StablePtr ) import Hugs.IORef ( IORef, newIORef, readIORef, writeIORef ) import Hugs.IOExts ( unsafePerformIO, unsafeCoerce ) -- For the Typeable instance import Hugs.Array ( Array ) import Hugs.ConcBase ( MVar ) #endif #ifdef __GLASGOW_HASKELL__ unsafeCoerce :: a -> b unsafeCoerce = unsafeCoerce# #endif #ifdef __NHC__ import NonStdUnsafeCoerce (unsafeCoerce) import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO) import IO (Handle) import Ratio (Ratio) -- For the Typeable instance import NHC.FFI ( Ptr,FunPtr,StablePtr,ForeignPtr ) import Array ( Array ) #endif #include "Typeable.h" #ifndef __HUGS__ ------------------------------------------------------------- -- -- Type representations -- ------------------------------------------------------------- -- | A concrete representation of a (monomorphic) type. 'TypeRep' -- supports reasonably efficient equality. data TypeRep = TypeRep !Key TyCon [TypeRep] -- Compare keys for equality instance Eq TypeRep where (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2 -- | An abstract representation of a type constructor. 'TyCon' objects can -- be built using 'mkTyCon'. data TyCon = TyCon !Key String instance Eq TyCon where (TyCon t1 _) == (TyCon t2 _) = t1 == t2 #endif -- -- let fTy = mkTyCon "Foo" in show (mkTyConApp (mkTyCon ",,") -- [fTy,fTy,fTy]) -- -- returns "(Foo,Foo,Foo)" -- -- The TypeRep Show instance promises to print tuple types -- correctly. Tuple type constructors are specified by a -- sequence of commas, e.g., (mkTyCon ",,,,") returns -- the 5-tuple tycon. ----------------- Construction -------------------- -- | Applies a type constructor to a sequence of types mkTyConApp :: TyCon -> [TypeRep] -> TypeRep mkTyConApp tc@(TyCon tc_k _) args = TypeRep (appKeys tc_k arg_ks) tc args where arg_ks = [k | TypeRep k _ _ <- args] -- | A special case of 'mkTyConApp', which applies the function -- type constructor to a pair of types. mkFunTy :: TypeRep -> TypeRep -> TypeRep mkFunTy f a = mkTyConApp funTc [f,a] -- | Splits a type constructor application splitTyConApp :: TypeRep -> (TyCon,[TypeRep]) splitTyConApp (TypeRep _ tc trs) = (tc,trs) -- | Applies a type to a function type. Returns: @'Just' u@ if the -- first argument represents a function of type @t -> u@ and the -- second argument represents a function of type @t@. Otherwise, -- returns 'Nothing'. funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep funResultTy trFun trArg = case splitTyConApp trFun of (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2 _ -> Nothing -- | Adds a TypeRep argument to a TypeRep. mkAppTy :: TypeRep -> TypeRep -> TypeRep mkAppTy (TypeRep tr_k tc trs) arg_tr = let (TypeRep arg_k _ _) = arg_tr in TypeRep (appKey tr_k arg_k) tc (trs++[arg_tr]) -- If we enforce the restriction that there is only one -- @TyCon@ for a type & it is shared among all its uses, -- we can map them onto Ints very simply. The benefit is, -- of course, that @TyCon@s can then be compared efficiently. -- Provided the implementor of other @Typeable@ instances -- takes care of making all the @TyCon@s CAFs (toplevel constants), -- this will work. -- If this constraint does turn out to be a sore thumb, changing -- the Eq instance for TyCons is trivial. -- | Builds a 'TyCon' object representing a type constructor. An -- implementation of "Data.Typeable" should ensure that the following holds: -- -- > mkTyCon "a" == mkTyCon "a" -- mkTyCon :: String -- ^ the name of the type constructor (should be unique -- in the program, so it might be wise to use the -- fully qualified name). -> TyCon -- ^ A unique 'TyCon' object mkTyCon str = TyCon (mkTyConKey str) str ----------------- Observation --------------------- -- | Observe the type constructor of a type representation typeRepTyCon :: TypeRep -> TyCon typeRepTyCon (TypeRep _ tc _) = tc -- | Observe the argument types of a type representation typeRepArgs :: TypeRep -> [TypeRep] typeRepArgs (TypeRep _ _ args) = args -- | Observe string encoding of a type representation tyConString :: TyCon -> String tyConString (TyCon _ str) = str ----------------- Showing TypeReps -------------------- instance Show TypeRep where showsPrec p (TypeRep _ tycon tys) = case tys of [] -> showsPrec p tycon [x] | tycon == listTc -> showChar '[' . shows x . showChar ']' [a,r] | tycon == funTc -> showParen (p > 8) $ showsPrec 9 a . showString " -> " . showsPrec 8 r xs | isTupleTyCon tycon -> showTuple tycon xs | otherwise -> showParen (p > 9) $ showsPrec p tycon . showChar ' ' . showArgs tys instance Show TyCon where showsPrec _ (TyCon _ s) = showString s isTupleTyCon :: TyCon -> Bool isTupleTyCon (TyCon _ (',':_)) = True isTupleTyCon _ = False -- Some (Show.TypeRep) helpers: showArgs :: Show a => [a] -> ShowS showArgs [] = id showArgs [a] = showsPrec 10 a showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as showTuple :: TyCon -> [TypeRep] -> ShowS showTuple (TyCon _ str) args = showChar '(' . go str args where go [] [a] = showsPrec 10 a . showChar ')' go _ [] = showChar ')' -- a failure condition, really. go (',':xs) (a:as) = showsPrec 10 a . showChar ',' . go xs as go _ _ = showChar ')' ------------------------------------------------------------- -- -- The Typeable class and friends -- ------------------------------------------------------------- -- | The class 'Typeable' allows a concrete representation of a type to -- be calculated. class Typeable a where typeOf :: a -> TypeRep -- ^ Takes a value of type @a@ and returns a concrete representation -- of that type. The /value/ of the argument should be ignored by -- any instance of 'Typeable', so that it is safe to pass 'undefined' as -- the argument. -- | Variant for unary type constructors class Typeable1 t where typeOf1 :: t a -> TypeRep -- | For defining a 'Typeable' instance from any 'Typeable1' instance. typeOfDefault :: (Typeable1 t, Typeable a) => t a -> TypeRep typeOfDefault x = typeOf1 x `mkAppTy` typeOf (argType x) where argType :: t a -> a argType = undefined -- | Variant for binary type constructors class Typeable2 t where typeOf2 :: t a b -> TypeRep -- | For defining a 'Typeable1' instance from any 'Typeable2' instance. typeOf1Default :: (Typeable2 t, Typeable a) => t a b -> TypeRep typeOf1Default x = typeOf2 x `mkAppTy` typeOf (argType x) where argType :: t a b -> a argType = undefined -- | Variant for 3-ary type constructors class Typeable3 t where typeOf3 :: t a b c -> TypeRep -- | For defining a 'Typeable2' instance from any 'Typeable3' instance. typeOf2Default :: (Typeable3 t, Typeable a) => t a b c -> TypeRep typeOf2Default x = typeOf3 x `mkAppTy` typeOf (argType x) where argType :: t a b c -> a argType = undefined -- | Variant for 4-ary type constructors class Typeable4 t where typeOf4 :: t a b c d -> TypeRep -- | For defining a 'Typeable3' instance from any 'Typeable4' instance. typeOf3Default :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep typeOf3Default x = typeOf4 x `mkAppTy` typeOf (argType x) where argType :: t a b c d -> a argType = undefined -- | Variant for 5-ary type constructors class Typeable5 t where typeOf5 :: t a b c d e -> TypeRep -- | For defining a 'Typeable4' instance from any 'Typeable5' instance. typeOf4Default :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep typeOf4Default x = typeOf5 x `mkAppTy` typeOf (argType x) where argType :: t a b c d e -> a argType = undefined -- | Variant for 6-ary type constructors class Typeable6 t where typeOf6 :: t a b c d e f -> TypeRep -- | For defining a 'Typeable5' instance from any 'Typeable6' instance. typeOf5Default :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep typeOf5Default x = typeOf6 x `mkAppTy` typeOf (argType x) where argType :: t a b c d e f -> a argType = undefined -- | Variant for 7-ary type constructors class Typeable7 t where typeOf7 :: t a b c d e f g -> TypeRep -- | For defining a 'Typeable6' instance from any 'Typeable7' instance. typeOf6Default :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep typeOf6Default x = typeOf7 x `mkAppTy` typeOf (argType x) where argType :: t a b c d e f g -> a argType = undefined #ifdef __GLASGOW_HASKELL__ -- Given a @Typeable@/n/ instance for an /n/-ary type constructor, -- define the instances for partial applications. -- Programmers using non-GHC implementations must do this manually -- for each type constructor. -- (The INSTANCE_TYPEABLE/n/ macros in Typeable.h include this.) -- | One Typeable instance for all Typeable1 instances instance (Typeable1 s, Typeable a) => Typeable (s a) where typeOf = typeOfDefault -- | One Typeable1 instance for all Typeable2 instances instance (Typeable2 s, Typeable a) => Typeable1 (s a) where typeOf1 = typeOf1Default -- | One Typeable2 instance for all Typeable3 instances instance (Typeable3 s, Typeable a) => Typeable2 (s a) where typeOf2 = typeOf2Default -- | One Typeable3 instance for all Typeable4 instances instance (Typeable4 s, Typeable a) => Typeable3 (s a) where typeOf3 = typeOf3Default -- | One Typeable4 instance for all Typeable5 instances instance (Typeable5 s, Typeable a) => Typeable4 (s a) where typeOf4 = typeOf4Default -- | One Typeable5 instance for all Typeable6 instances instance (Typeable6 s, Typeable a) => Typeable5 (s a) where typeOf5 = typeOf5Default -- | One Typeable6 instance for all Typeable7 instances instance (Typeable7 s, Typeable a) => Typeable6 (s a) where typeOf6 = typeOf6Default #endif /* __GLASGOW_HASKELL__ */ ------------------------------------------------------------- -- -- Type-safe cast -- ------------------------------------------------------------- -- | The type-safe cast operation cast :: (Typeable a, Typeable b) => a -> Maybe b cast x = r where r = if typeOf x == typeOf (fromJust r) then Just $ unsafeCoerce x else Nothing -- | A flexible variation parameterised in a type constructor gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b) gcast x = r where r = if typeOf (getArg x) == typeOf (getArg (fromJust r)) then Just $ unsafeCoerce x else Nothing getArg :: c x -> x getArg = undefined -- | Cast for * -> * gcast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a)) gcast1 x = r where r = if typeOf1 (getArg x) == typeOf1 (getArg (fromJust r)) then Just $ unsafeCoerce x else Nothing getArg :: c x -> x getArg = undefined -- | Cast for * -> * -> * gcast2 :: (Typeable2 t, Typeable2 t') => c (t a b) -> Maybe (c (t' a b)) gcast2 x = r where r = if typeOf2 (getArg x) == typeOf2 (getArg (fromJust r)) then Just $ unsafeCoerce x else Nothing getArg :: c x -> x getArg = undefined ------------------------------------------------------------- -- -- Instances of the Typeable classes for Prelude types -- ------------------------------------------------------------- INSTANCE_TYPEABLE0((),unitTc,"()") INSTANCE_TYPEABLE1([],listTc,"[]") INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe") INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio") INSTANCE_TYPEABLE2(Either,eitherTc,"Either") INSTANCE_TYPEABLE2((->),funTc,"->") INSTANCE_TYPEABLE1(IO,ioTc,"IO") #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -- Types defined in GHC.IOBase INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" ) INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception") INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException") INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException") INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException") INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException") #endif -- Types defined in GHC.Arr INSTANCE_TYPEABLE2(Array,arrayTc,"Array") #ifdef __GLASGOW_HASKELL__ -- Hugs has these too, but their Typeable instances are defined -- elsewhere to keep this module within Haskell 98. -- This is important because every invocation of runhugs or ffihugs -- uses this module via Data.Dynamic. INSTANCE_TYPEABLE2(ST,stTc,"ST") INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef") INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray") #endif #ifndef __NHC__ INSTANCE_TYPEABLE2((,),pairTc,",") INSTANCE_TYPEABLE3((,,),tup3Tc,",,") tup4Tc :: TyCon tup4Tc = mkTyCon ",,," instance Typeable4 (,,,) where typeOf4 tu = mkTyConApp tup4Tc [] tup5Tc :: TyCon tup5Tc = mkTyCon ",,,," instance Typeable5 (,,,,) where typeOf5 tu = mkTyConApp tup5Tc [] tup6Tc :: TyCon tup6Tc = mkTyCon ",,,,," instance Typeable6 (,,,,,) where typeOf6 tu = mkTyConApp tup6Tc [] tup7Tc :: TyCon tup7Tc = mkTyCon ",,,,,," instance Typeable7 (,,,,,,) where typeOf7 tu = mkTyConApp tup7Tc [] #endif /* __NHC__ */ INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr") INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr") INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr") INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef") ------------------------------------------------------- -- -- Generate Typeable instances for standard datatypes -- ------------------------------------------------------- INSTANCE_TYPEABLE0(Bool,boolTc,"Bool") INSTANCE_TYPEABLE0(Char,charTc,"Char") INSTANCE_TYPEABLE0(Float,floatTc,"Float") INSTANCE_TYPEABLE0(Double,doubleTc,"Double") INSTANCE_TYPEABLE0(Int,intTc,"Int") #ifndef __NHC__ INSTANCE_TYPEABLE0(Word,wordTc,"Word" ) #endif INSTANCE_TYPEABLE0(Integer,integerTc,"Integer") INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering") INSTANCE_TYPEABLE0(Handle,handleTc,"Handle") INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8") INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16") INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32") INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64") INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" ) INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16") INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32") INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64") INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon") INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep") #ifdef __GLASGOW_HASKELL__ INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld") #endif --------------------------------------------- -- -- Internals -- --------------------------------------------- #ifndef __HUGS__ newtype Key = Key Int deriving( Eq ) #endif data KeyPr = KeyPr !Key !Key deriving( Eq ) hashKP :: KeyPr -> Int32 hashKP (KeyPr (Key k1) (Key k2)) = (HT.hashInt k1 + HT.hashInt k2) `rem` HT.prime data Cache = Cache { next_key :: !(IORef Key), -- Not used by GHC (calls genSym instead) tc_tbl :: !(HT.HashTable String Key), ap_tbl :: !(HT.HashTable KeyPr Key) } {-# NOINLINE cache #-} #ifdef __GLASGOW_HASKELL__ foreign import ccall unsafe "RtsTypeable.h getOrSetTypeableStore" getOrSetTypeableStore :: Ptr a -> IO (Ptr a) #endif cache :: Cache cache = unsafePerformIO $ do empty_tc_tbl <- HT.new (==) HT.hashString empty_ap_tbl <- HT.new (==) hashKP key_loc <- newIORef (Key 1) let ret = Cache { next_key = key_loc, tc_tbl = empty_tc_tbl, ap_tbl = empty_ap_tbl } #ifdef __GLASGOW_HASKELL__ block $ do stable_ref <- newStablePtr ret let ref = castStablePtrToPtr stable_ref ref2 <- getOrSetTypeableStore ref if ref==ref2 then deRefStablePtr stable_ref else do freeStablePtr stable_ref deRefStablePtr (castPtrToStablePtr ref2) #else return ret #endif newKey :: IORef Key -> IO Key #ifdef __GLASGOW_HASKELL__ newKey kloc = do i <- genSym; return (Key i) #else newKey kloc = do { k@(Key i) <- readIORef kloc ; writeIORef kloc (Key (i+1)) ; return k } #endif #ifdef __GLASGOW_HASKELL__ foreign import ccall unsafe "genSymZh" genSym :: IO Int #endif mkTyConKey :: String -> Key mkTyConKey str = unsafePerformIO $ do let Cache {next_key = kloc, tc_tbl = tbl} = cache mb_k <- HT.lookup tbl str case mb_k of Just k -> return k Nothing -> do { k <- newKey kloc ; HT.insert tbl str k ; return k } appKey :: Key -> Key -> Key appKey k1 k2 = unsafePerformIO $ do let Cache {next_key = kloc, ap_tbl = tbl} = cache mb_k <- HT.lookup tbl kpr case mb_k of Just k -> return k Nothing -> do { k <- newKey kloc ; HT.insert tbl kpr k ; return k } where kpr = KeyPr k1 k2 appKeys :: Key -> [Key] -> Key appKeys k ks = foldl appKey k ks hugs98-plus-Sep2006/packages/base/Data/Unique.hs0000644006511100651110000000356710504340221020130 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Unique -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable -- -- An abstract interface to a unique symbol generator. -- ----------------------------------------------------------------------------- module Data.Unique ( -- * Unique objects Unique, -- instance (Eq, Ord) newUnique, -- :: IO Unique hashUnique -- :: Unique -> Int ) where import Prelude import Control.Concurrent.MVar import System.IO.Unsafe (unsafePerformIO) #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Num ( Integer(..) ) #endif -- | An abstract unique object. Objects of type 'Unique' may be -- compared for equality and ordering and hashed into 'Int'. newtype Unique = Unique Integer deriving (Eq,Ord) uniqSource :: MVar Integer uniqSource = unsafePerformIO (newMVar 0) {-# NOINLINE uniqSource #-} -- | Creates a new object of type 'Unique'. The value returned will -- not compare equal to any other value of type 'Unique' returned by -- previous calls to 'newUnique'. There is no limit on the number of -- times 'newUnique' may be called. newUnique :: IO Unique newUnique = do val <- takeMVar uniqSource let next = val+1 putMVar uniqSource next return (Unique next) -- | Hashes a 'Unique' into an 'Int'. Two 'Unique's may hash to the -- same value, although in practice this is unlikely. The 'Int' -- returned makes a good hash key. hashUnique :: Unique -> Int #ifdef __GLASGOW_HASKELL__ hashUnique (Unique (S# i)) = I# i hashUnique (Unique (J# s d)) | s ==# 0# = 0 | otherwise = I# (indexIntArray# d 0#) #else hashUnique (Unique u) = fromInteger (u `mod` (toInteger (maxBound :: Int) + 1)) #endif hugs98-plus-Sep2006/packages/base/Data/Version.hs0000644006511100651110000001332110504340221020274 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Data.Version -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (local universal quantification in ReadP) -- -- A general library for representation and manipulation of versions. -- -- Versioning schemes are many and varied, so the version -- representation provided by this library is intended to be a -- compromise between complete generality, where almost no common -- functionality could reasonably be provided, and fixing a particular -- versioning scheme, which would probably be too restrictive. -- -- So the approach taken here is to provide a representation which -- subsumes many of the versioning schemes commonly in use, and we -- provide implementations of 'Eq', 'Ord' and conversion to\/from 'String' -- which will be appropriate for some applications, but not all. -- ----------------------------------------------------------------------------- module Data.Version ( -- * The @Version@ type Version(..), -- * A concrete representation of @Version@ showVersion, parseVersion, ) where import Prelude -- necessary to get dependencies right -- These #ifdefs are necessary because this code might be compiled as -- part of ghc/lib/compat, and hence might be compiled by an older version -- of GHC. In which case, we might need to pick up ReadP from -- Distribution.Compat.ReadP, because the version in -- Text.ParserCombinators.ReadP doesn't have all the combinators we need. #if __GLASGOW_HASKELL__ >= 603 || __HUGS__ || __NHC__ import Text.ParserCombinators.ReadP #else import Distribution.Compat.ReadP #endif #if !__GLASGOW_HASKELL__ import Data.Typeable ( Typeable, TyCon, mkTyCon, mkTyConApp ) #elif __GLASGOW_HASKELL__ < 602 import Data.Dynamic ( Typeable(..), TyCon, mkTyCon, mkAppTy ) #else import Data.Typeable ( Typeable ) #endif import Data.List ( intersperse, sort ) import Control.Monad ( liftM ) import Data.Char ( isDigit, isAlphaNum ) {- | A 'Version' represents the version of a software entity. An instance of 'Eq' is provided, which implements exact equality modulo reordering of the tags in the 'versionTags' field. An instance of 'Ord' is also provided, which gives lexicographic ordering on the 'versionBranch' fields (i.e. 2.1 > 2.0, 1.2.3 > 1.2.2, etc.). This is expected to be sufficient for many uses, but note that you may need to use a more specific ordering for your versioning scheme. For example, some versioning schemes may include pre-releases which have tags @\"pre1\"@, @\"pre2\"@, and so on, and these would need to be taken into account when determining ordering. In some cases, date ordering may be more appropriate, so the application would have to look for @date@ tags in the 'versionTags' field and compare those. The bottom line is, don't always assume that 'compare' and other 'Ord' operations are the right thing for every 'Version'. Similarly, concrete representations of versions may differ. One possible concrete representation is provided (see 'showVersion' and 'parseVersion'), but depending on the application a different concrete representation may be more appropriate. -} data Version = Version { versionBranch :: [Int], -- ^ The numeric branch for this version. This reflects the -- fact that most software versions are tree-structured; there -- is a main trunk which is tagged with versions at various -- points (1,2,3...), and the first branch off the trunk after -- version 3 is 3.1, the second branch off the trunk after -- version 3 is 3.2, and so on. The tree can be branched -- arbitrarily, just by adding more digits. -- -- We represent the branch as a list of 'Int', so -- version 3.2.1 becomes [3,2,1]. Lexicographic ordering -- (i.e. the default instance of 'Ord' for @[Int]@) gives -- the natural ordering of branches. versionTags :: [String] -- really a bag -- ^ A version can be tagged with an arbitrary list of strings. -- The interpretation of the list of tags is entirely dependent -- on the entity that this version applies to. } deriving (Read,Show #if __GLASGOW_HASKELL__ >= 602 ,Typeable #endif ) #if !__GLASGOW_HASKELL__ versionTc :: TyCon versionTc = mkTyCon "Version" instance Typeable Version where typeOf _ = mkTyConApp versionTc [] #elif __GLASGOW_HASKELL__ < 602 versionTc :: TyCon versionTc = mkTyCon "Version" instance Typeable Version where typeOf _ = mkAppTy versionTc [] #endif instance Eq Version where v1 == v2 = versionBranch v1 == versionBranch v2 && sort (versionTags v1) == sort (versionTags v2) -- tags may be in any order instance Ord Version where v1 `compare` v2 = versionBranch v1 `compare` versionBranch v2 -- ----------------------------------------------------------------------------- -- A concrete representation of 'Version' -- | Provides one possible concrete representation for 'Version'. For -- a version with 'versionBranch' @= [1,2,3]@ and 'versionTags' -- @= [\"tag1\",\"tag2\"]@, the output will be @1.2.3-tag1-tag2@. -- showVersion :: Version -> String showVersion (Version branch tags) = concat (intersperse "." (map show branch)) ++ concatMap ('-':) tags -- | A parser for versions in the format produced by 'showVersion'. -- #if __GLASGOW_HASKELL__ >= 603 || __HUGS__ parseVersion :: ReadP Version #elif __NHC__ parseVersion :: ReadPN r Version #else parseVersion :: ReadP r Version #endif parseVersion = do branch <- sepBy1 (liftM read $ munch1 isDigit) (char '.') tags <- many (char '-' >> munch1 isAlphaNum) return Version{versionBranch=branch, versionTags=tags} hugs98-plus-Sep2006/packages/base/Data/Word.hs0000644006511100651110000000411710504340221017565 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Word -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Unsigned integer types. -- ----------------------------------------------------------------------------- module Data.Word ( -- * Unsigned integral types Word, Word8, Word16, Word32, Word64, -- * Notes -- $notes ) where #ifdef __GLASGOW_HASKELL__ import GHC.Word #endif #ifdef __HUGS__ import Hugs.Word #endif #ifdef __NHC__ import NHC.FFI (Word8, Word16, Word32, Word64) import NHC.SizedTypes (Word8, Word16, Word32, Word64) -- instances of Bits type Word = Word32 #endif {- $notes * All arithmetic is performed modulo 2^n, where n is the number of bits in the type. One non-obvious consequence of this is that 'Prelude.negate' should /not/ raise an error on negative arguments. * For coercing between any two integer types, use 'Prelude.fromIntegral', which is specialized for all the common cases so should be fast enough. Coercing word types to and from integer types preserves representation, not sign. * It would be very natural to add a type @Natural@ providing an unbounded size unsigned integer, just as 'Prelude.Integer' provides unbounded size signed integers. We do not do that yet since there is no demand for it. * The rules that hold for 'Prelude.Enum' instances over a bounded type such as 'Prelude.Int' (see the section of the Haskell report dealing with arithmetic sequences) also hold for the 'Prelude.Enum' instances over the various 'Word' types defined here. * Right and left shifts by amounts greater than or equal to the width of the type result in a zero result. This is contrary to the behaviour in C, which is undefined; a common interpretation is to truncate the shift count to the width of the type, for example @1 \<\< 32 == 1@ in some C implementations. -} hugs98-plus-Sep2006/packages/base/Data/ByteString/0000755006511100651110000000000010504340226020412 5ustar rossrosshugs98-plus-Sep2006/packages/base/Data/ByteString/Lazy/0000755006511100651110000000000010504340226021331 5ustar rossrosshugs98-plus-Sep2006/packages/base/Data/ByteString/Lazy/Char8.hs0000644006511100651110000007417310504340226022646 0ustar rossross{-# OPTIONS_GHC -cpp -fno-warn-orphans #-} -- -- Module : Data.ByteString.Lazy.Char8 -- Copyright : (c) Don Stewart 2006 -- License : BSD-style -- -- Maintainer : dons@cse.unsw.edu.au -- Stability : experimental -- Portability : portable (tested with GHC>=6.4.1 and Hugs 2005) -- -- -- | Manipulate /lazy/ 'ByteString's using 'Char' operations. All Chars will -- be truncated to 8 bits. It can be expected that these functions will -- run at identical speeds to their Word8 equivalents in -- "Data.ByteString.Lazy". -- -- This module is intended to be imported @qualified@, to avoid name -- clashes with "Prelude" functions. eg. -- -- > import qualified Data.ByteString.Lazy.Char8 as C -- module Data.ByteString.Lazy.Char8 ( -- * The @ByteString@ type ByteString, -- instances: Eq, Ord, Show, Read, Data, Typeable -- * Introducing and eliminating 'ByteString's empty, -- :: ByteString singleton, -- :: Char -> ByteString pack, -- :: String -> ByteString unpack, -- :: ByteString -> String fromChunks, -- :: [Strict.ByteString] -> ByteString toChunks, -- :: ByteString -> [Strict.ByteString] -- * Basic interface cons, -- :: Char -> ByteString -> ByteString snoc, -- :: ByteString -> Char -> ByteString append, -- :: ByteString -> ByteString -> ByteString head, -- :: ByteString -> Char last, -- :: ByteString -> Char tail, -- :: ByteString -> ByteString init, -- :: ByteString -> ByteString null, -- :: ByteString -> Bool length, -- :: ByteString -> Int64 -- * Transformating ByteStrings map, -- :: (Char -> Char) -> ByteString -> ByteString reverse, -- :: ByteString -> ByteString -- intersperse, -- :: Char -> ByteString -> ByteString transpose, -- :: [ByteString] -> [ByteString] -- * Reducing 'ByteString's (folds) foldl, -- :: (a -> Char -> a) -> a -> ByteString -> a foldl', -- :: (a -> Char -> a) -> a -> ByteString -> a foldl1, -- :: (Char -> Char -> Char) -> ByteString -> Char foldl1', -- :: (Char -> Char -> Char) -> ByteString -> Char foldr, -- :: (Char -> a -> a) -> a -> ByteString -> a foldr1, -- :: (Char -> Char -> Char) -> ByteString -> Char -- ** Special folds concat, -- :: [ByteString] -> ByteString concatMap, -- :: (Char -> ByteString) -> ByteString -> ByteString any, -- :: (Char -> Bool) -> ByteString -> Bool all, -- :: (Char -> Bool) -> ByteString -> Bool maximum, -- :: ByteString -> Char minimum, -- :: ByteString -> Char -- * Building ByteStrings -- ** Scans scanl, -- :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString -- scanl1, -- :: (Char -> Char -> Char) -> ByteString -> ByteString -- scanr, -- :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString -- scanr1, -- :: (Char -> Char -> Char) -> ByteString -> ByteString -- ** Accumulating maps mapAccumL, -- :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString) mapIndexed, -- :: (Int64 -> Char -> Char) -> ByteString -> ByteString -- ** Infinite ByteStrings repeat, -- :: Char -> ByteString replicate, -- :: Int64 -> Char -> ByteString cycle, -- :: ByteString -> ByteString iterate, -- :: (Char -> Char) -> Char -> ByteString -- ** Unfolding unfoldr, -- :: (a -> Maybe (Char, a)) -> a -> ByteString -- * Substrings -- ** Breaking strings take, -- :: Int64 -> ByteString -> ByteString drop, -- :: Int64 -> ByteString -> ByteString splitAt, -- :: Int64 -> ByteString -> (ByteString, ByteString) takeWhile, -- :: (Char -> Bool) -> ByteString -> ByteString dropWhile, -- :: (Char -> Bool) -> ByteString -> ByteString span, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) break, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) group, -- :: ByteString -> [ByteString] groupBy, -- :: (Char -> Char -> Bool) -> ByteString -> [ByteString] inits, -- :: ByteString -> [ByteString] tails, -- :: ByteString -> [ByteString] -- ** Breaking into many substrings split, -- :: Char -> ByteString -> [ByteString] splitWith, -- :: (Char -> Bool) -> ByteString -> [ByteString] -- ** Breaking into lines and words lines, -- :: ByteString -> [ByteString] words, -- :: ByteString -> [ByteString] unlines, -- :: [ByteString] -> ByteString unwords, -- :: ByteString -> [ByteString] -- ** Joining strings join, -- :: ByteString -> [ByteString] -> ByteString -- * Predicates isPrefixOf, -- :: ByteString -> ByteString -> Bool -- isSuffixOf, -- :: ByteString -> ByteString -> Bool -- * Searching ByteStrings -- ** Searching by equality elem, -- :: Char -> ByteString -> Bool notElem, -- :: Char -> ByteString -> Bool -- ** Searching with a predicate find, -- :: (Char -> Bool) -> ByteString -> Maybe Char filter, -- :: (Char -> Bool) -> ByteString -> ByteString -- partition -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) -- * Indexing ByteStrings index, -- :: ByteString -> Int64 -> Char elemIndex, -- :: Char -> ByteString -> Maybe Int64 elemIndices, -- :: Char -> ByteString -> [Int64] findIndex, -- :: (Char -> Bool) -> ByteString -> Maybe Int64 findIndices, -- :: (Char -> Bool) -> ByteString -> [Int64] count, -- :: Char -> ByteString -> Int64 -- * Zipping and unzipping ByteStrings zip, -- :: ByteString -> ByteString -> [(Char,Char)] zipWith, -- :: (Char -> Char -> c) -> ByteString -> ByteString -> [c] -- unzip, -- :: [(Char,Char)] -> (ByteString,ByteString) -- * Ordered ByteStrings -- sort, -- :: ByteString -> ByteString copy, -- :: ByteString -> ByteString -- * Reading from ByteStrings readInt, readInteger, -- * I\/O with 'ByteString's -- ** Standard input and output getContents, -- :: IO ByteString putStr, -- :: ByteString -> IO () putStrLn, -- :: ByteString -> IO () interact, -- :: (ByteString -> ByteString) -> IO () -- ** Files readFile, -- :: FilePath -> IO ByteString writeFile, -- :: FilePath -> ByteString -> IO () appendFile, -- :: FilePath -> ByteString -> IO () -- ** I\/O with Handles hGetContents, -- :: Handle -> IO ByteString hGet, -- :: Handle -> Int64 -> IO ByteString hPut, -- :: Handle -> ByteString -> IO () hGetNonBlocking, -- :: Handle -> IO ByteString -- hGetN, -- :: Int -> Handle -> Int64 -> IO ByteString -- hGetContentsN, -- :: Int -> Handle -> IO ByteString -- hGetNonBlockingN, -- :: Int -> Handle -> IO ByteString ) where -- Functions transparently exported import Data.ByteString.Lazy (ByteString, fromChunks, toChunks ,empty,null,length,tail,init,append,reverse,transpose ,concat,take,drop,splitAt,join,isPrefixOf,group,inits,tails,copy ,hGetContents, hGet, hPut, getContents ,hGetNonBlocking ,putStr, putStrLn, interact) -- Functions we need to wrap. import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B import qualified Data.ByteString.Base as B import Data.ByteString.Base (LazyByteString(LPS)) import Data.ByteString.Base (w2c, c2w, isSpaceWord8) import Data.Int (Int64) import qualified Data.List as List (intersperse) import qualified Prelude as P import Prelude hiding (reverse,head,tail,last,init,null,length,map,lines,foldl,foldr,unlines ,concat,any,take,drop,splitAt,takeWhile,dropWhile,span,break,elem,filter ,unwords,words,maximum,minimum,all,concatMap,scanl,scanl1,foldl1,foldr1 ,readFile,writeFile,appendFile,replicate,getContents,getLine,putStr,putStrLn ,zip,zipWith,unzip,notElem,repeat,iterate,interact) import System.IO (hClose,openFile,IOMode(..)) import Control.Exception (bracket) #define STRICT1(f) f a | a `seq` False = undefined #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined #define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined #define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined ------------------------------------------------------------------------ -- | /O(1)/ Convert a 'Char' into a 'ByteString' singleton :: Char -> ByteString singleton = L.singleton . c2w {-# INLINE singleton #-} -- | /O(n)/ Convert a 'String' into a 'ByteString'. pack :: [Char] -> ByteString pack = L.pack. P.map c2w -- | /O(n)/ Converts a 'ByteString' to a 'String'. unpack :: ByteString -> [Char] unpack = P.map w2c . L.unpack {-# INLINE unpack #-} -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires a memcpy. cons :: Char -> ByteString -> ByteString cons = L.cons . c2w {-# INLINE cons #-} -- | /O(n)/ Append a Char to the end of a 'ByteString'. Similar to -- 'cons', this function performs a memcpy. snoc :: ByteString -> Char -> ByteString snoc p = L.snoc p . c2w {-# INLINE snoc #-} -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. head :: ByteString -> Char head = w2c . L.head {-# INLINE head #-} -- | /O(1)/ Extract the last element of a packed string, which must be non-empty. last :: ByteString -> Char last = w2c . L.last {-# INLINE last #-} -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each element of @xs@ map :: (Char -> Char) -> ByteString -> ByteString map f = L.map (c2w . f . w2c) {-# INLINE map #-} -- | 'foldl', applied to a binary operator, a starting value (typically -- the left-identity of the operator), and a ByteString, reduces the -- ByteString using the binary operator, from left to right. foldl :: (a -> Char -> a) -> a -> ByteString -> a foldl f = L.foldl (\a c -> f a (w2c c)) {-# INLINE foldl #-} -- | 'foldl\'' is like foldl, but strict in the accumulator. foldl' :: (a -> Char -> a) -> a -> ByteString -> a foldl' f = L.foldl' (\a c -> f a (w2c c)) {-# INLINE foldl' #-} -- | 'foldr', applied to a binary operator, a starting value -- (typically the right-identity of the operator), and a packed string, -- reduces the packed string using the binary operator, from right to left. foldr :: (Char -> a -> a) -> a -> ByteString -> a foldr f = L.foldr (\c a -> f (w2c c) a) {-# INLINE foldr #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'ByteStrings'. foldl1 :: (Char -> Char -> Char) -> ByteString -> Char foldl1 f ps = w2c (L.foldl1 (\x y -> c2w (f (w2c x) (w2c y))) ps) {-# INLINE foldl1 #-} -- | 'foldl1\'' is like 'foldl1', but strict in the accumulator. foldl1' :: (Char -> Char -> Char) -> ByteString -> Char foldl1' f ps = w2c (L.foldl1' (\x y -> c2w (f (w2c x) (w2c y))) ps) -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty 'ByteString's foldr1 :: (Char -> Char -> Char) -> ByteString -> Char foldr1 f ps = w2c (L.foldr1 (\x y -> c2w (f (w2c x) (w2c y))) ps) {-# INLINE foldr1 #-} -- | Map a function over a 'ByteString' and concatenate the results concatMap :: (Char -> ByteString) -> ByteString -> ByteString concatMap f = L.concatMap (f . w2c) {-# INLINE concatMap #-} -- | Applied to a predicate and a ByteString, 'any' determines if -- any element of the 'ByteString' satisfies the predicate. any :: (Char -> Bool) -> ByteString -> Bool any f = L.any (f . w2c) {-# INLINE any #-} -- | Applied to a predicate and a 'ByteString', 'all' determines if -- all elements of the 'ByteString' satisfy the predicate. all :: (Char -> Bool) -> ByteString -> Bool all f = L.all (f . w2c) {-# INLINE all #-} -- | 'maximum' returns the maximum value from a 'ByteString' maximum :: ByteString -> Char maximum = w2c . L.maximum {-# INLINE maximum #-} -- | 'minimum' returns the minimum value from a 'ByteString' minimum :: ByteString -> Char minimum = w2c . L.minimum {-# INLINE minimum #-} -- --------------------------------------------------------------------- -- Building ByteStrings -- | 'scanl' is similar to 'foldl', but returns a list of successive -- reduced values from the left. This function will fuse. -- -- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] -- -- Note that -- -- > last (scanl f z xs) == foldl f z xs. scanl :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString scanl f z = L.scanl (\a b -> c2w (f (w2c a) (w2c b))) (c2w z) -- | The 'mapAccumL' function behaves like a combination of 'map' and -- 'foldl'; it applies a function to each element of a ByteString, -- passing an accumulating parameter from left to right, and returning a -- final value of this accumulator together with the new ByteString. mapAccumL :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString) mapAccumL f = L.mapAccumL (\a w -> case f a (w2c w) of (a',c) -> (a', c2w c)) -- | /O(n)/ map Char functions, provided with the index at each position mapIndexed :: (Int -> Char -> Char) -> ByteString -> ByteString mapIndexed f = L.mapIndexed (\i w -> c2w (f i (w2c w))) ------------------------------------------------------------------------ -- Generating and unfolding ByteStrings -- | @'iterate' f x@ returns an infinite ByteString of repeated applications -- of @f@ to @x@: -- -- > iterate f x == [x, f x, f (f x), ...] -- iterate :: (Char -> Char) -> Char -> ByteString iterate f = L.iterate (c2w . f . w2c) . c2w -- | @'repeat' x@ is an infinite ByteString, with @x@ the value of every -- element. -- repeat :: Char -> ByteString repeat = L.repeat . c2w -- | /O(n)/ @'replicate' n x@ is a ByteString of length @n@ with @x@ -- the value of every element. -- replicate :: Int64 -> Char -> ByteString replicate w c = L.replicate w (c2w c) -- | /O(n)/ The 'unfoldr' function is analogous to the List \'unfoldr\'. -- 'unfoldr' builds a ByteString from a seed value. The function takes -- the element and returns 'Nothing' if it is done producing the -- ByteString or returns 'Just' @(a,b)@, in which case, @a@ is a -- prepending to the ByteString and @b@ is used as the next element in a -- recursive call. unfoldr :: (a -> Maybe (Char, a)) -> a -> ByteString unfoldr f = L.unfoldr $ \a -> case f a of Nothing -> Nothing Just (c, a') -> Just (c2w c, a') ------------------------------------------------------------------------ -- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@, -- returns the longest prefix (possibly empty) of @xs@ of elements that -- satisfy @p@. takeWhile :: (Char -> Bool) -> ByteString -> ByteString takeWhile f = L.takeWhile (f . w2c) {-# INLINE takeWhile #-} -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. dropWhile :: (Char -> Bool) -> ByteString -> ByteString dropWhile f = L.dropWhile (f . w2c) {-# INLINE dropWhile #-} -- | 'break' @p@ is equivalent to @'span' ('not' . p)@. break :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) break f = L.break (f . w2c) {-# INLINE break #-} -- | 'span' @p xs@ breaks the ByteString into two segments. It is -- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ span :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) span f = L.span (f . w2c) {-# INLINE span #-} {- -- | 'breakChar' breaks its ByteString argument at the first occurence -- of the specified Char. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. -- -- > break (=='c') "abcd" == breakChar 'c' "abcd" -- breakChar :: Char -> ByteString -> (ByteString, ByteString) breakChar = L.breakByte . c2w {-# INLINE breakChar #-} -- | 'spanChar' breaks its ByteString argument at the first -- occurence of a Char other than its argument. It is more efficient -- than 'span (==)' -- -- > span (=='c') "abcd" == spanByte 'c' "abcd" -- spanChar :: Char -> ByteString -> (ByteString, ByteString) spanChar = L.spanByte . c2w {-# INLINE spanChar #-} -} -- -- TODO, more rules for breakChar* -- -- | /O(n)/ Break a 'ByteString' into pieces separated by the byte -- argument, consuming the delimiter. I.e. -- -- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"] -- > split 'a' "aXaXaXa" == ["","X","X","X"] -- > split 'x' "x" == ["",""] -- -- and -- -- > join [c] . split c == id -- > split == splitWith . (==) -- -- As for all splitting functions in this library, this function does -- not copy the substrings, it just constructs new 'ByteStrings' that -- are slices of the original. -- split :: Char -> ByteString -> [ByteString] split = L.split . c2w {-# INLINE split #-} -- | /O(n)/ Splits a 'ByteString' into components delimited by -- separators, where the predicate returns True for a separator element. -- The resulting components do not contain the separators. Two adjacent -- separators result in an empty component in the output. eg. -- -- > splitWith (=='a') "aabbaca" == ["","","bb","c",""] -- splitWith :: (Char -> Bool) -> ByteString -> [ByteString] splitWith f = L.splitWith (f . w2c) {-# INLINE splitWith #-} -- | The 'groupBy' function is the non-overloaded version of 'group'. groupBy :: (Char -> Char -> Bool) -> ByteString -> [ByteString] groupBy k = L.groupBy (\a b -> k (w2c a) (w2c b)) -- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0. index :: ByteString -> Int64 -> Char index = (w2c .) . L.index {-# INLINE index #-} -- | /O(n)/ The 'elemIndex' function returns the index of the first -- element in the given 'ByteString' which is equal (by memchr) to the -- query element, or 'Nothing' if there is no such element. elemIndex :: Char -> ByteString -> Maybe Int64 elemIndex = L.elemIndex . c2w {-# INLINE elemIndex #-} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. elemIndices :: Char -> ByteString -> [Int64] elemIndices = L.elemIndices . c2w {-# INLINE elemIndices #-} -- | The 'findIndex' function takes a predicate and a 'ByteString' and -- returns the index of the first element in the ByteString satisfying the predicate. findIndex :: (Char -> Bool) -> ByteString -> Maybe Int64 findIndex f = L.findIndex (f . w2c) {-# INLINE findIndex #-} -- | The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (Char -> Bool) -> ByteString -> [Int64] findIndices f = L.findIndices (f . w2c) -- | count returns the number of times its argument appears in the ByteString -- -- > count == length . elemIndices -- > count '\n' == length . lines -- -- But more efficiently than using length on the intermediate list. count :: Char -> ByteString -> Int64 count c = L.count (c2w c) -- | /O(n)/ 'elem' is the 'ByteString' membership predicate. This -- implementation uses @memchr(3)@. elem :: Char -> ByteString -> Bool elem c = L.elem (c2w c) {-# INLINE elem #-} -- | /O(n)/ 'notElem' is the inverse of 'elem' notElem :: Char -> ByteString -> Bool notElem c = L.notElem (c2w c) {-# INLINE notElem #-} -- | /O(n)/ 'filter', applied to a predicate and a ByteString, -- returns a ByteString containing those characters that satisfy the -- predicate. filter :: (Char -> Bool) -> ByteString -> ByteString filter f = L.filter (f . w2c) {-# INLINE filter #-} -- | /O(n)/ The 'find' function takes a predicate and a ByteString, -- and returns the first element in matching the predicate, or 'Nothing' -- if there is no such element. find :: (Char -> Bool) -> ByteString -> Maybe Char find f ps = w2c `fmap` L.find (f . w2c) ps {-# INLINE find #-} {- -- | /O(n)/ A first order equivalent of /filter . (==)/, for the common -- case of filtering a single Char. It is more efficient to use -- filterChar in this case. -- -- > filterChar == filter . (==) -- -- filterChar is around 10x faster, and uses much less space, than its -- filter equivalent -- filterChar :: Char -> ByteString -> ByteString filterChar c = L.filterByte (c2w c) {-# INLINE filterChar #-} -- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common -- case of filtering a single Char out of a list. It is more efficient -- to use /filterNotChar/ in this case. -- -- > filterNotChar == filter . (/=) -- -- filterNotChar is around 3x faster, and uses much less space, than its -- filter equivalent -- filterNotChar :: Char -> ByteString -> ByteString filterNotChar c = L.filterNotByte (c2w c) {-# INLINE filterNotChar #-} -} -- | /O(n)/ 'zip' takes two ByteStrings and returns a list of -- corresponding pairs of Chars. If one input ByteString is short, -- excess elements of the longer ByteString are discarded. This is -- equivalent to a pair of 'unpack' operations, and so space -- usage may be large for multi-megabyte ByteStrings zip :: ByteString -> ByteString -> [(Char,Char)] zip ps qs | L.null ps || L.null qs = [] | otherwise = (head ps, head qs) : zip (L.tail ps) (L.tail qs) -- | 'zipWith' generalises 'zip' by zipping with the function given as -- the first argument, instead of a tupling function. For example, -- @'zipWith' (+)@ is applied to two ByteStrings to produce the list -- of corresponding sums. zipWith :: (Char -> Char -> a) -> ByteString -> ByteString -> [a] zipWith f = L.zipWith ((. w2c) . f . w2c) -- | 'lines' breaks a ByteString up into a list of ByteStrings at -- newline Chars. The resulting strings do not contain newlines. -- lines :: ByteString -> [ByteString] lines (LPS []) = [] lines (LPS (x:xs)) = loop0 x xs where -- this is a really performance sensitive function but the -- chunked representation makes the general case a bit expensive -- however assuming a large chunk size and normalish line lengths -- we will find line endings much more frequently than chunk -- endings so it makes sense to optimise for that common case. -- So we partition into two special cases depending on whether we -- are keeping back a list of chunks that will eventually be output -- once we get to the end of the current line. -- the common special case where we have no existing chunks of -- the current line loop0 :: B.ByteString -> [B.ByteString] -> [ByteString] STRICT2(loop0) loop0 ps pss = case B.elemIndex (c2w '\n') ps of Nothing -> case pss of [] | B.null ps -> [] | otherwise -> LPS [ps] : [] (ps':pss') | B.null ps -> loop0 ps' pss' | otherwise -> loop ps' [ps] pss' Just n | n /= 0 -> LPS [B.unsafeTake n ps] : loop0 (B.unsafeDrop (n+1) ps) pss | otherwise -> loop0 (B.unsafeTail ps) pss -- the general case when we are building a list of chunks that are -- part of the same line loop :: B.ByteString -> [B.ByteString] -> [B.ByteString] -> [ByteString] STRICT3(loop) loop ps line pss = case B.elemIndex (c2w '\n') ps of Nothing -> case pss of [] -> let ps' | B.null ps = P.reverse line | otherwise = P.reverse (ps : line) in ps' `seq` (LPS ps' : []) (ps':pss') | B.null ps -> loop ps' line pss' | otherwise -> loop ps' (ps : line) pss' Just n -> let ps' | n == 0 = P.reverse line | otherwise = P.reverse (B.unsafeTake n ps : line) in ps' `seq` (LPS ps' : loop0 (B.unsafeDrop (n+1) ps) pss) -- | 'unlines' is an inverse operation to 'lines'. It joins lines, -- after appending a terminating newline to each. unlines :: [ByteString] -> ByteString unlines [] = empty unlines ss = (concat $ List.intersperse nl ss) `append` nl -- half as much space where nl = singleton '\n' -- | 'words' breaks a ByteString up into a list of words, which -- were delimited by Chars representing white space. And -- -- > tokens isSpace = words -- words :: ByteString -> [ByteString] words = P.filter (not . L.null) . L.splitWith isSpaceWord8 {-# INLINE words #-} -- | The 'unwords' function is analogous to the 'unlines' function, on words. unwords :: [ByteString] -> ByteString unwords = join (singleton ' ') {-# INLINE unwords #-} -- | readInt reads an Int from the beginning of the ByteString. If -- there is no integer at the beginning of the string, it returns -- Nothing, otherwise it just returns the int read, and the rest of the -- string. readInt :: ByteString -> Maybe (Int, ByteString) readInt (LPS []) = Nothing readInt (LPS (x:xs)) = case w2c (B.unsafeHead x) of '-' -> loop True 0 0 (B.unsafeTail x) xs '+' -> loop False 0 0 (B.unsafeTail x) xs _ -> loop False 0 0 x xs where loop :: Bool -> Int -> Int -> B.ByteString -> [B.ByteString] -> Maybe (Int, ByteString) STRICT5(loop) loop neg i n ps pss | B.null ps = case pss of [] -> end neg i n ps pss (ps':pss') -> loop neg i n ps' pss' | otherwise = case B.unsafeHead ps of w | w >= 0x30 && w <= 0x39 -> loop neg (i+1) (n * 10 + (fromIntegral w - 0x30)) (B.unsafeTail ps) pss | otherwise -> end neg i n ps pss end _ 0 _ _ _ = Nothing end neg _ n ps pss = let n' | neg = negate n | otherwise = n ps' | B.null ps = pss | otherwise = ps:pss in n' `seq` ps' `seq` Just $! (n', LPS ps') -- | readInteger reads an Integer from the beginning of the ByteString. If -- there is no integer at the beginning of the string, it returns Nothing, -- otherwise it just returns the int read, and the rest of the string. readInteger :: ByteString -> Maybe (Integer, ByteString) readInteger (LPS []) = Nothing readInteger (LPS (x:xs)) = case w2c (B.unsafeHead x) of '-' -> first (B.unsafeTail x) xs >>= \(n, bs) -> return (-n, bs) '+' -> first (B.unsafeTail x) xs _ -> first x xs where first ps pss | B.null ps = case pss of [] -> Nothing (ps':pss') -> first' ps' pss' | otherwise = first' ps pss first' ps pss = case B.unsafeHead ps of w | w >= 0x30 && w <= 0x39 -> Just $ loop 1 (fromIntegral w - 0x30) [] (B.unsafeTail ps) pss | otherwise -> Nothing loop :: Int -> Int -> [Integer] -> B.ByteString -> [B.ByteString] -> (Integer, ByteString) STRICT5(loop) loop d acc ns ps pss | B.null ps = case pss of [] -> combine d acc ns ps pss (ps':pss') -> loop d acc ns ps' pss' | otherwise = case B.unsafeHead ps of w | w >= 0x30 && w <= 0x39 -> if d < 9 then loop (d+1) (10*acc + (fromIntegral w - 0x30)) ns (B.unsafeTail ps) pss else loop 1 (fromIntegral w - 0x30) (fromIntegral acc : ns) (B.unsafeTail ps) pss | otherwise -> combine d acc ns ps pss combine _ acc [] ps pss = end (fromIntegral acc) ps pss combine d acc ns ps pss = end (10^d * combine1 1000000000 ns + fromIntegral acc) ps pss combine1 _ [n] = n combine1 b ns = combine1 (b*b) $ combine2 b ns combine2 b (n:m:ns) = let t = n+m*b in t `seq` (t : combine2 b ns) combine2 _ ns = ns end n ps pss = let ps' | B.null ps = pss | otherwise = ps:pss in ps' `seq` (n, LPS ps') -- | Read an entire file /lazily/ into a 'ByteString'. Use 'text mode' -- on Windows to interpret newlines readFile :: FilePath -> IO ByteString readFile f = openFile f ReadMode >>= hGetContents -- | Write a 'ByteString' to a file. writeFile :: FilePath -> ByteString -> IO () writeFile f txt = bracket (openFile f WriteMode) hClose (\hdl -> hPut hdl txt) -- | Append a 'ByteString' to a file. appendFile :: FilePath -> ByteString -> IO () appendFile f txt = bracket (openFile f AppendMode) hClose (\hdl -> hPut hdl txt) hugs98-plus-Sep2006/packages/base/Data/ByteString/Char8.hs0000644006511100651110000011475210504340226021725 0ustar rossross{-# OPTIONS_GHC -cpp -fglasgow-exts #-} -- -- Module : Data.ByteString.Char8 -- Copyright : (c) Don Stewart 2006 -- License : BSD-style -- -- Maintainer : dons@cse.unsw.edu.au -- Stability : experimental -- Portability : portable (tested with GHC>=6.4.1 and Hugs 2005) -- -- -- | Manipulate 'ByteString's using 'Char' operations. All Chars will be -- truncated to 8 bits. It can be expected that these functions will run -- at identical speeds to their 'Word8' equivalents in "Data.ByteString". -- -- More specifically these byte strings are taken to be in the -- subset of Unicode covered by code points 0-255. This covers -- Unicode Basic Latin, Latin-1 Supplement and C0+C1 Controls. -- -- See: -- -- * -- -- * -- -- * -- -- This module is intended to be imported @qualified@, to avoid name -- clashes with "Prelude" functions. eg. -- -- > import qualified Data.ByteString.Char8 as B -- module Data.ByteString.Char8 ( -- * The @ByteString@ type ByteString, -- abstract, instances: Eq, Ord, Show, Read, Data, Typeable, Monoid -- * Introducing and eliminating 'ByteString's empty, -- :: ByteString singleton, -- :: Char -> ByteString pack, -- :: String -> ByteString unpack, -- :: ByteString -> String -- * Basic interface cons, -- :: Char -> ByteString -> ByteString snoc, -- :: ByteString -> Char -> ByteString append, -- :: ByteString -> ByteString -> ByteString head, -- :: ByteString -> Char last, -- :: ByteString -> Char tail, -- :: ByteString -> ByteString init, -- :: ByteString -> ByteString null, -- :: ByteString -> Bool length, -- :: ByteString -> Int -- * Transformating ByteStrings map, -- :: (Char -> Char) -> ByteString -> ByteString reverse, -- :: ByteString -> ByteString intersperse, -- :: Char -> ByteString -> ByteString transpose, -- :: [ByteString] -> [ByteString] -- * Reducing 'ByteString's (folds) foldl, -- :: (a -> Char -> a) -> a -> ByteString -> a foldl', -- :: (a -> Char -> a) -> a -> ByteString -> a foldl1, -- :: (Char -> Char -> Char) -> ByteString -> Char foldl1', -- :: (Char -> Char -> Char) -> ByteString -> Char foldr, -- :: (Char -> a -> a) -> a -> ByteString -> a foldr', -- :: (Char -> a -> a) -> a -> ByteString -> a foldr1, -- :: (Char -> Char -> Char) -> ByteString -> Char foldr1', -- :: (Char -> Char -> Char) -> ByteString -> Char -- ** Special folds concat, -- :: [ByteString] -> ByteString concatMap, -- :: (Char -> ByteString) -> ByteString -> ByteString any, -- :: (Char -> Bool) -> ByteString -> Bool all, -- :: (Char -> Bool) -> ByteString -> Bool maximum, -- :: ByteString -> Char minimum, -- :: ByteString -> Char -- * Building ByteStrings -- ** Scans scanl, -- :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString scanl1, -- :: (Char -> Char -> Char) -> ByteString -> ByteString scanr, -- :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString scanr1, -- :: (Char -> Char -> Char) -> ByteString -> ByteString -- ** Accumulating maps mapAccumL, -- :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString) mapAccumR, -- :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString) mapIndexed, -- :: (Int -> Char -> Char) -> ByteString -> ByteString -- * Generating and unfolding ByteStrings replicate, -- :: Int -> Char -> ByteString unfoldr, -- :: (a -> Maybe (Char, a)) -> a -> ByteString unfoldrN, -- :: Int -> (a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a) -- * Substrings -- ** Breaking strings take, -- :: Int -> ByteString -> ByteString drop, -- :: Int -> ByteString -> ByteString splitAt, -- :: Int -> ByteString -> (ByteString, ByteString) takeWhile, -- :: (Char -> Bool) -> ByteString -> ByteString dropWhile, -- :: (Char -> Bool) -> ByteString -> ByteString span, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) spanEnd, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) break, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) breakEnd, -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) group, -- :: ByteString -> [ByteString] groupBy, -- :: (Char -> Char -> Bool) -> ByteString -> [ByteString] inits, -- :: ByteString -> [ByteString] tails, -- :: ByteString -> [ByteString] -- ** Breaking into many substrings split, -- :: Char -> ByteString -> [ByteString] splitWith, -- :: (Char -> Bool) -> ByteString -> [ByteString] -- ** Breaking into lines and words lines, -- :: ByteString -> [ByteString] words, -- :: ByteString -> [ByteString] unlines, -- :: [ByteString] -> ByteString unwords, -- :: ByteString -> [ByteString] -- ** Joining strings join, -- :: ByteString -> [ByteString] -> ByteString -- ** Searching for substrings isPrefixOf, -- :: ByteString -> ByteString -> Bool isSuffixOf, -- :: ByteString -> ByteString -> Bool isSubstringOf, -- :: ByteString -> ByteString -> Bool findSubstring, -- :: ByteString -> ByteString -> Maybe Int findSubstrings, -- :: ByteString -> ByteString -> [Int] -- * Searching ByteStrings -- ** Searching by equality elem, -- :: Char -> ByteString -> Bool notElem, -- :: Char -> ByteString -> Bool -- ** Searching with a predicate find, -- :: (Char -> Bool) -> ByteString -> Maybe Char filter, -- :: (Char -> Bool) -> ByteString -> ByteString -- partition -- :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) -- * Indexing ByteStrings index, -- :: ByteString -> Int -> Char elemIndex, -- :: Char -> ByteString -> Maybe Int elemIndices, -- :: Char -> ByteString -> [Int] elemIndexEnd, -- :: Char -> ByteString -> Maybe Int findIndex, -- :: (Char -> Bool) -> ByteString -> Maybe Int findIndices, -- :: (Char -> Bool) -> ByteString -> [Int] count, -- :: Char -> ByteString -> Int -- * Zipping and unzipping ByteStrings zip, -- :: ByteString -> ByteString -> [(Char,Char)] zipWith, -- :: (Char -> Char -> c) -> ByteString -> ByteString -> [c] unzip, -- :: [(Char,Char)] -> (ByteString,ByteString) -- * Ordered ByteStrings sort, -- :: ByteString -> ByteString -- * Reading from ByteStrings readInt, -- :: ByteString -> Maybe (Int, ByteString) readInteger, -- :: ByteString -> Maybe (Integer, ByteString) -- * Low level CString conversions -- ** Packing CStrings and pointers packCString, -- :: CString -> ByteString packCStringLen, -- :: CString -> ByteString packMallocCString, -- :: CString -> ByteString -- ** Using ByteStrings as CStrings useAsCString, -- :: ByteString -> (CString -> IO a) -> IO a useAsCStringLen, -- :: ByteString -> (CStringLen -> IO a) -> IO a -- * Copying ByteStrings copy, -- :: ByteString -> ByteString copyCString, -- :: CString -> IO ByteString copyCStringLen, -- :: CStringLen -> IO ByteString -- * I\/O with @ByteString@s -- ** Standard input and output getLine, -- :: IO ByteString getContents, -- :: IO ByteString putStr, -- :: ByteString -> IO () putStrLn, -- :: ByteString -> IO () interact, -- :: (ByteString -> ByteString) -> IO () -- ** Files readFile, -- :: FilePath -> IO ByteString writeFile, -- :: FilePath -> ByteString -> IO () appendFile, -- :: FilePath -> ByteString -> IO () -- mmapFile, -- :: FilePath -> IO ByteString -- ** I\/O with Handles hGetLine, -- :: Handle -> IO ByteString hGetNonBlocking, -- :: Handle -> Int -> IO ByteString hGetContents, -- :: Handle -> IO ByteString hGet, -- :: Handle -> Int -> IO ByteString hPut, -- :: Handle -> ByteString -> IO () hPutStr, -- :: Handle -> ByteString -> IO () hPutStrLn, -- :: Handle -> ByteString -> IO () #if defined(__GLASGOW_HASKELL__) -- * Low level construction -- | For constructors from foreign language types see "Data.ByteString" packAddress, -- :: Addr# -> ByteString unsafePackAddress, -- :: Int -> Addr# -> ByteString #endif -- * Utilities (needed for array fusion) #if defined(__GLASGOW_HASKELL__) unpackList, #endif ) where import qualified Prelude as P import Prelude hiding (reverse,head,tail,last,init,null ,length,map,lines,foldl,foldr,unlines ,concat,any,take,drop,splitAt,takeWhile ,dropWhile,span,break,elem,filter,unwords ,words,maximum,minimum,all,concatMap ,scanl,scanl1,scanr,scanr1 ,appendFile,readFile,writeFile ,foldl1,foldr1,replicate ,getContents,getLine,putStr,putStrLn,interact ,zip,zipWith,unzip,notElem) import qualified Data.ByteString as B import qualified Data.ByteString.Base as B -- Listy functions transparently exported import Data.ByteString (empty,null,length,tail,init,append ,inits,tails,reverse,transpose ,concat,take,drop,splitAt,join ,sort,isPrefixOf,isSuffixOf,isSubstringOf,findSubstring ,findSubstrings,copy,group ,getLine, getContents, putStr, putStrLn, interact ,hGetContents, hGet, hPut, hPutStr, hPutStrLn ,hGetLine, hGetNonBlocking ,packCString,packCStringLen, packMallocCString ,useAsCString,useAsCStringLen, copyCString,copyCStringLen #if defined(__GLASGOW_HASKELL__) ,unpackList #endif ) import Data.ByteString.Base ( ByteString(..) #if defined(__GLASGOW_HASKELL__) ,packAddress, unsafePackAddress #endif ,c2w, w2c, unsafeTail, isSpaceWord8, inlinePerformIO ) import Data.Char ( isSpace ) import qualified Data.List as List (intersperse) import System.IO (openFile,hClose,hFileSize,IOMode(..)) import Control.Exception (bracket) import Foreign #if defined(__GLASGOW_HASKELL__) import GHC.Base (Char(..),unpackCString#,unsafeCoerce#) import GHC.IOBase (IO(..),stToIO) import GHC.Prim (Addr#,writeWord8OffAddr#,plusAddr#) import GHC.Ptr (Ptr(..)) import GHC.ST (ST(..)) #endif #define STRICT1(f) f a | a `seq` False = undefined #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined #define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined ------------------------------------------------------------------------ -- | /O(1)/ Convert a 'Char' into a 'ByteString' singleton :: Char -> ByteString singleton = B.singleton . c2w {-# INLINE singleton #-} -- | /O(n)/ Convert a 'String' into a 'ByteString' -- -- For applications with large numbers of string literals, pack can be a -- bottleneck. In such cases, consider using packAddress (GHC only). pack :: String -> ByteString #if !defined(__GLASGOW_HASKELL__) pack str = B.unsafeCreate (P.length str) $ \p -> go p str where go _ [] = return () go p (x:xs) = poke p (c2w x) >> go (p `plusPtr` 1) xs #else /* hack away */ pack str = B.unsafeCreate (P.length str) $ \(Ptr p) -> stToIO (go p str) where go :: Addr# -> [Char] -> ST a () go _ [] = return () go p (C# c:cs) = writeByte p (unsafeCoerce# c) >> go (p `plusAddr#` 1#) cs writeByte p c = ST $ \s# -> case writeWord8OffAddr# p 0# c s# of s2# -> (# s2#, () #) {-# INLINE writeByte #-} {-# INLINE [1] pack #-} {-# RULES "FPS pack/packAddress" forall s . pack (unpackCString# s) = B.packAddress s #-} #endif -- | /O(n)/ Converts a 'ByteString' to a 'String'. unpack :: ByteString -> [Char] unpack = P.map w2c . B.unpack {-# INLINE unpack #-} -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires a memcpy. cons :: Char -> ByteString -> ByteString cons = B.cons . c2w {-# INLINE cons #-} -- | /O(n)/ Append a Char to the end of a 'ByteString'. Similar to -- 'cons', this function performs a memcpy. snoc :: ByteString -> Char -> ByteString snoc p = B.snoc p . c2w {-# INLINE snoc #-} -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. head :: ByteString -> Char head = w2c . B.head {-# INLINE head #-} -- | /O(1)/ Extract the last element of a packed string, which must be non-empty. last :: ByteString -> Char last = w2c . B.last {-# INLINE last #-} -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each element of @xs@ map :: (Char -> Char) -> ByteString -> ByteString map f = B.map (c2w . f . w2c) {-# INLINE map #-} -- | /O(n)/ The 'intersperse' function takes a Char and a 'ByteString' -- and \`intersperses\' that Char between the elements of the -- 'ByteString'. It is analogous to the intersperse function on Lists. intersperse :: Char -> ByteString -> ByteString intersperse = B.intersperse . c2w {-# INLINE intersperse #-} -- | 'foldl', applied to a binary operator, a starting value (typically -- the left-identity of the operator), and a ByteString, reduces the -- ByteString using the binary operator, from left to right. foldl :: (a -> Char -> a) -> a -> ByteString -> a foldl f = B.foldl (\a c -> f a (w2c c)) {-# INLINE foldl #-} -- | 'foldl\'' is like foldl, but strict in the accumulator. foldl' :: (a -> Char -> a) -> a -> ByteString -> a foldl' f = B.foldl' (\a c -> f a (w2c c)) {-# INLINE foldl' #-} -- | 'foldr', applied to a binary operator, a starting value -- (typically the right-identity of the operator), and a packed string, -- reduces the packed string using the binary operator, from right to left. foldr :: (Char -> a -> a) -> a -> ByteString -> a foldr f = B.foldr (\c a -> f (w2c c) a) {-# INLINE foldr #-} -- | 'foldr\'' is a strict variant of foldr foldr' :: (Char -> a -> a) -> a -> ByteString -> a foldr' f = B.foldr' (\c a -> f (w2c c) a) {-# INLINE foldr' #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'ByteStrings'. foldl1 :: (Char -> Char -> Char) -> ByteString -> Char foldl1 f ps = w2c (B.foldl1 (\x y -> c2w (f (w2c x) (w2c y))) ps) {-# INLINE foldl1 #-} -- | A strict version of 'foldl1' foldl1' :: (Char -> Char -> Char) -> ByteString -> Char foldl1' f ps = w2c (B.foldl1' (\x y -> c2w (f (w2c x) (w2c y))) ps) {-# INLINE foldl1' #-} -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty 'ByteString's foldr1 :: (Char -> Char -> Char) -> ByteString -> Char foldr1 f ps = w2c (B.foldr1 (\x y -> c2w (f (w2c x) (w2c y))) ps) {-# INLINE foldr1 #-} -- | A strict variant of foldr1 foldr1' :: (Char -> Char -> Char) -> ByteString -> Char foldr1' f ps = w2c (B.foldr1' (\x y -> c2w (f (w2c x) (w2c y))) ps) {-# INLINE foldr1' #-} -- | Map a function over a 'ByteString' and concatenate the results concatMap :: (Char -> ByteString) -> ByteString -> ByteString concatMap f = B.concatMap (f . w2c) {-# INLINE concatMap #-} -- | Applied to a predicate and a ByteString, 'any' determines if -- any element of the 'ByteString' satisfies the predicate. any :: (Char -> Bool) -> ByteString -> Bool any f = B.any (f . w2c) {-# INLINE any #-} -- | Applied to a predicate and a 'ByteString', 'all' determines if -- all elements of the 'ByteString' satisfy the predicate. all :: (Char -> Bool) -> ByteString -> Bool all f = B.all (f . w2c) {-# INLINE all #-} -- | 'maximum' returns the maximum value from a 'ByteString' maximum :: ByteString -> Char maximum = w2c . B.maximum {-# INLINE maximum #-} -- | 'minimum' returns the minimum value from a 'ByteString' minimum :: ByteString -> Char minimum = w2c . B.minimum {-# INLINE minimum #-} -- | /O(n)/ map Char functions, provided with the index at each position mapIndexed :: (Int -> Char -> Char) -> ByteString -> ByteString mapIndexed f = B.mapIndexed (\i c -> c2w (f i (w2c c))) {-# INLINE mapIndexed #-} -- | The 'mapAccumL' function behaves like a combination of 'map' and -- 'foldl'; it applies a function to each element of a ByteString, -- passing an accumulating parameter from left to right, and returning a -- final value of this accumulator together with the new list. mapAccumL :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString) mapAccumL f = B.mapAccumL (\acc w -> case f acc (w2c w) of (acc', c) -> (acc', c2w c)) -- | The 'mapAccumR' function behaves like a combination of 'map' and -- 'foldr'; it applies a function to each element of a ByteString, -- passing an accumulating parameter from right to left, and returning a -- final value of this accumulator together with the new ByteString. mapAccumR :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString) mapAccumR f = B.mapAccumR (\acc w -> case f acc (w2c w) of (acc', c) -> (acc', c2w c)) -- | 'scanl' is similar to 'foldl', but returns a list of successive -- reduced values from the left: -- -- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] -- -- Note that -- -- > last (scanl f z xs) == foldl f z xs. scanl :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString scanl f z = B.scanl (\a b -> c2w (f (w2c a) (w2c b))) (c2w z) -- | 'scanl1' is a variant of 'scanl' that has no starting value argument: -- -- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] scanl1 :: (Char -> Char -> Char) -> ByteString -> ByteString scanl1 f = B.scanl1 (\a b -> c2w (f (w2c a) (w2c b))) -- | scanr is the right-to-left dual of scanl. scanr :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString scanr f z = B.scanr (\a b -> c2w (f (w2c a) (w2c b))) (c2w z) -- | 'scanr1' is a variant of 'scanr' that has no starting value argument. scanr1 :: (Char -> Char -> Char) -> ByteString -> ByteString scanr1 f = B.scanr1 (\a b -> c2w (f (w2c a) (w2c b))) -- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@ -- the value of every element. The following holds: -- -- > replicate w c = unfoldr w (\u -> Just (u,u)) c -- -- This implemenation uses @memset(3)@ replicate :: Int -> Char -> ByteString replicate w = B.replicate w . c2w {-# INLINE replicate #-} -- | /O(n)/, where /n/ is the length of the result. The 'unfoldr' -- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a -- ByteString from a seed value. The function takes the element and -- returns 'Nothing' if it is done producing the ByteString or returns -- 'Just' @(a,b)@, in which case, @a@ is the next character in the string, -- and @b@ is the seed value for further production. -- -- Examples: -- -- > unfoldr (\x -> if x <= '9' then Just (x, succ x) else Nothing) '0' == "0123456789" unfoldr :: (a -> Maybe (Char, a)) -> a -> ByteString unfoldr f x0 = B.unfoldr (fmap k . f) x0 where k (i, j) = (c2w i, j) -- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ByteString from a seed -- value. However, the length of the result is limited by the first -- argument to 'unfoldrN'. This function is more efficient than 'unfoldr' -- when the maximum length of the result is known. -- -- The following equation relates 'unfoldrN' and 'unfoldr': -- -- > unfoldrN n f s == take n (unfoldr f s) unfoldrN :: Int -> (a -> Maybe (Char, a)) -> a -> (ByteString, Maybe a) unfoldrN n f w = B.unfoldrN n ((k `fmap`) . f) w where k (i,j) = (c2w i, j) {-# INLINE unfoldrN #-} -- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@, -- returns the longest prefix (possibly empty) of @xs@ of elements that -- satisfy @p@. takeWhile :: (Char -> Bool) -> ByteString -> ByteString takeWhile f = B.takeWhile (f . w2c) {-# INLINE takeWhile #-} -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. dropWhile :: (Char -> Bool) -> ByteString -> ByteString dropWhile f = B.dropWhile (f . w2c) #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] dropWhile #-} #endif -- | 'break' @p@ is equivalent to @'span' ('not' . p)@. break :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) break f = B.break (f . w2c) #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] break #-} #endif -- | 'span' @p xs@ breaks the ByteString into two segments. It is -- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ span :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) span f = B.span (f . w2c) {-# INLINE span #-} -- | 'spanEnd' behaves like 'span' but from the end of the 'ByteString'. -- We have -- -- > spanEnd (not.isSpace) "x y z" == ("x y ","z") -- -- and -- -- > spanEnd (not . isSpace) ps -- > == -- > let (x,y) = span (not.isSpace) (reverse ps) in (reverse y, reverse x) -- spanEnd :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) spanEnd f = B.spanEnd (f . w2c) {-# INLINE spanEnd #-} -- | 'breakEnd' behaves like 'break' but from the end of the 'ByteString' -- -- breakEnd p == spanEnd (not.p) breakEnd :: (Char -> Bool) -> ByteString -> (ByteString, ByteString) breakEnd f = B.breakEnd (f . w2c) {-# INLINE breakEnd #-} {- -- | 'breakChar' breaks its ByteString argument at the first occurence -- of the specified Char. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. -- -- > break (=='c') "abcd" == breakChar 'c' "abcd" -- breakChar :: Char -> ByteString -> (ByteString, ByteString) breakChar = B.breakByte . c2w {-# INLINE breakChar #-} -- | 'spanChar' breaks its ByteString argument at the first -- occurence of a Char other than its argument. It is more efficient -- than 'span (==)' -- -- > span (=='c') "abcd" == spanByte 'c' "abcd" -- spanChar :: Char -> ByteString -> (ByteString, ByteString) spanChar = B.spanByte . c2w {-# INLINE spanChar #-} -} -- | /O(n)/ Break a 'ByteString' into pieces separated by the byte -- argument, consuming the delimiter. I.e. -- -- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"] -- > split 'a' "aXaXaXa" == ["","X","X","X"] -- > split 'x' "x" == ["",""] -- -- and -- -- > join [c] . split c == id -- > split == splitWith . (==) -- -- As for all splitting functions in this library, this function does -- not copy the substrings, it just constructs new 'ByteStrings' that -- are slices of the original. -- split :: Char -> ByteString -> [ByteString] split = B.split . c2w {-# INLINE split #-} -- | /O(n)/ Splits a 'ByteString' into components delimited by -- separators, where the predicate returns True for a separator element. -- The resulting components do not contain the separators. Two adjacent -- separators result in an empty component in the output. eg. -- -- > splitWith (=='a') "aabbaca" == ["","","bb","c",""] -- splitWith :: (Char -> Bool) -> ByteString -> [ByteString] splitWith f = B.splitWith (f . w2c) {-# INLINE splitWith #-} -- the inline makes a big difference here. {- -- | Like 'splitWith', except that sequences of adjacent separators are -- treated as a single separator. eg. -- -- > tokens (=='a') "aabbaca" == ["bb","c"] -- tokens :: (Char -> Bool) -> ByteString -> [ByteString] tokens f = B.tokens (f . w2c) {-# INLINE tokens #-} -} -- | The 'groupBy' function is the non-overloaded version of 'group'. groupBy :: (Char -> Char -> Bool) -> ByteString -> [ByteString] groupBy k = B.groupBy (\a b -> k (w2c a) (w2c b)) {- -- | /O(n)/ joinWithChar. An efficient way to join to two ByteStrings with a -- char. Around 4 times faster than the generalised join. -- joinWithChar :: Char -> ByteString -> ByteString -> ByteString joinWithChar = B.joinWithByte . c2w {-# INLINE joinWithChar #-} -} -- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0. index :: ByteString -> Int -> Char index = (w2c .) . B.index {-# INLINE index #-} -- | /O(n)/ The 'elemIndex' function returns the index of the first -- element in the given 'ByteString' which is equal (by memchr) to the -- query element, or 'Nothing' if there is no such element. elemIndex :: Char -> ByteString -> Maybe Int elemIndex = B.elemIndex . c2w {-# INLINE elemIndex #-} -- | /O(n)/ The 'elemIndexEnd' function returns the last index of the -- element in the given 'ByteString' which is equal to the query -- element, or 'Nothing' if there is no such element. The following -- holds: -- -- > elemIndexEnd c xs == -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs) -- elemIndexEnd :: Char -> ByteString -> Maybe Int elemIndexEnd = B.elemIndexEnd . c2w {-# INLINE elemIndexEnd #-} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. elemIndices :: Char -> ByteString -> [Int] elemIndices = B.elemIndices . c2w {-# INLINE elemIndices #-} -- | The 'findIndex' function takes a predicate and a 'ByteString' and -- returns the index of the first element in the ByteString satisfying the predicate. findIndex :: (Char -> Bool) -> ByteString -> Maybe Int findIndex f = B.findIndex (f . w2c) {-# INLINE findIndex #-} -- | The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (Char -> Bool) -> ByteString -> [Int] findIndices f = B.findIndices (f . w2c) -- | count returns the number of times its argument appears in the ByteString -- -- > count = length . elemIndices -- -- Also -- -- > count '\n' == length . lines -- -- But more efficiently than using length on the intermediate list. count :: Char -> ByteString -> Int count c = B.count (c2w c) -- | /O(n)/ 'elem' is the 'ByteString' membership predicate. This -- implementation uses @memchr(3)@. elem :: Char -> ByteString -> Bool elem c = B.elem (c2w c) {-# INLINE elem #-} -- | /O(n)/ 'notElem' is the inverse of 'elem' notElem :: Char -> ByteString -> Bool notElem c = B.notElem (c2w c) {-# INLINE notElem #-} -- | /O(n)/ 'filter', applied to a predicate and a ByteString, -- returns a ByteString containing those characters that satisfy the -- predicate. filter :: (Char -> Bool) -> ByteString -> ByteString filter f = B.filter (f . w2c) {-# INLINE filter #-} -- | /O(n)/ The 'find' function takes a predicate and a ByteString, -- and returns the first element in matching the predicate, or 'Nothing' -- if there is no such element. find :: (Char -> Bool) -> ByteString -> Maybe Char find f ps = w2c `fmap` B.find (f . w2c) ps {-# INLINE find #-} {- -- | /O(n)/ A first order equivalent of /filter . (==)/, for the common -- case of filtering a single Char. It is more efficient to use -- filterChar in this case. -- -- > filterChar == filter . (==) -- -- filterChar is around 10x faster, and uses much less space, than its -- filter equivalent -- filterChar :: Char -> ByteString -> ByteString filterChar c = B.filterByte (c2w c) {-# INLINE filterChar #-} -- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common -- case of filtering a single Char out of a list. It is more efficient -- to use /filterNotChar/ in this case. -- -- > filterNotChar == filter . (/=) -- -- filterNotChar is around 3x faster, and uses much less space, than its -- filter equivalent -- filterNotChar :: Char -> ByteString -> ByteString filterNotChar c = B.filterNotByte (c2w c) {-# INLINE filterNotChar #-} -} -- | /O(n)/ 'zip' takes two ByteStrings and returns a list of -- corresponding pairs of Chars. If one input ByteString is short, -- excess elements of the longer ByteString are discarded. This is -- equivalent to a pair of 'unpack' operations, and so space -- usage may be large for multi-megabyte ByteStrings zip :: ByteString -> ByteString -> [(Char,Char)] zip ps qs | B.null ps || B.null qs = [] | otherwise = (unsafeHead ps, unsafeHead qs) : zip (B.unsafeTail ps) (B.unsafeTail qs) -- | 'zipWith' generalises 'zip' by zipping with the function given as -- the first argument, instead of a tupling function. For example, -- @'zipWith' (+)@ is applied to two ByteStrings to produce the list -- of corresponding sums. zipWith :: (Char -> Char -> a) -> ByteString -> ByteString -> [a] zipWith f = B.zipWith ((. w2c) . f . w2c) -- | 'unzip' transforms a list of pairs of Chars into a pair of -- ByteStrings. Note that this performs two 'pack' operations. unzip :: [(Char,Char)] -> (ByteString,ByteString) unzip ls = (pack (P.map fst ls), pack (P.map snd ls)) {-# INLINE unzip #-} -- | A variety of 'head' for non-empty ByteStrings. 'unsafeHead' omits -- the check for the empty case, which is good for performance, but -- there is an obligation on the programmer to provide a proof that the -- ByteString is non-empty. unsafeHead :: ByteString -> Char unsafeHead = w2c . B.unsafeHead {-# INLINE unsafeHead #-} -- --------------------------------------------------------------------- -- Things that depend on the encoding {-# RULES "FPS specialise break -> breakSpace" break isSpace = breakSpace #-} -- | 'breakSpace' returns the pair of ByteStrings when the argument is -- broken at the first whitespace byte. I.e. -- -- > break isSpace == breakSpace -- breakSpace :: ByteString -> (ByteString,ByteString) breakSpace (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do i <- firstspace (p `plusPtr` s) 0 l return $! case () of {_ | i == 0 -> (empty, PS x s l) | i == l -> (PS x s l, empty) | otherwise -> (PS x s i, PS x (s+i) (l-i)) } {-# INLINE breakSpace #-} firstspace :: Ptr Word8 -> Int -> Int -> IO Int STRICT3(firstspace) firstspace ptr n m | n >= m = return n | otherwise = do w <- peekByteOff ptr n if (not . isSpaceWord8) w then firstspace ptr (n+1) m else return n {-# RULES "FPS specialise dropWhile isSpace -> dropSpace" dropWhile isSpace = dropSpace #-} -- | 'dropSpace' efficiently returns the 'ByteString' argument with -- white space Chars removed from the front. It is more efficient than -- calling dropWhile for removing whitespace. I.e. -- -- > dropWhile isSpace == dropSpace -- dropSpace :: ByteString -> ByteString dropSpace (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do i <- firstnonspace (p `plusPtr` s) 0 l return $! if i == l then empty else PS x (s+i) (l-i) {-# INLINE dropSpace #-} firstnonspace :: Ptr Word8 -> Int -> Int -> IO Int STRICT3(firstnonspace) firstnonspace ptr n m | n >= m = return n | otherwise = do w <- peekElemOff ptr n if isSpaceWord8 w then firstnonspace ptr (n+1) m else return n {- -- | 'dropSpaceEnd' efficiently returns the 'ByteString' argument with -- white space removed from the end. I.e. -- -- > reverse . (dropWhile isSpace) . reverse == dropSpaceEnd -- -- but it is more efficient than using multiple reverses. -- dropSpaceEnd :: ByteString -> ByteString dropSpaceEnd (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do i <- lastnonspace (p `plusPtr` s) (l-1) return $! if i == (-1) then empty else PS x s (i+1) {-# INLINE dropSpaceEnd #-} lastnonspace :: Ptr Word8 -> Int -> IO Int STRICT2(lastnonspace) lastnonspace ptr n | n < 0 = return n | otherwise = do w <- peekElemOff ptr n if isSpaceWord8 w then lastnonspace ptr (n-1) else return n -} -- | 'lines' breaks a ByteString up into a list of ByteStrings at -- newline Chars. The resulting strings do not contain newlines. -- lines :: ByteString -> [ByteString] lines ps | null ps = [] | otherwise = case search ps of Nothing -> [ps] Just n -> take n ps : lines (drop (n+1) ps) where search = elemIndex '\n' {-# INLINE lines #-} {- -- Just as fast, but more complex. Should be much faster, I thought. lines :: ByteString -> [ByteString] lines (PS _ _ 0) = [] lines (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do let ptr = p `plusPtr` s STRICT1(loop) loop n = do let q = memchr (ptr `plusPtr` n) 0x0a (fromIntegral (l-n)) if q == nullPtr then return [PS x (s+n) (l-n)] else do let i = q `minusPtr` ptr ls <- loop (i+1) return $! PS x (s+n) (i-n) : ls loop 0 -} -- | 'unlines' is an inverse operation to 'lines'. It joins lines, -- after appending a terminating newline to each. unlines :: [ByteString] -> ByteString unlines [] = empty unlines ss = (concat $ List.intersperse nl ss) `append` nl -- half as much space where nl = singleton '\n' -- | 'words' breaks a ByteString up into a list of words, which -- were delimited by Chars representing white space. And -- -- > tokens isSpace = words -- words :: ByteString -> [ByteString] words = P.filter (not . B.null) . B.splitWith isSpaceWord8 {-# INLINE words #-} -- | The 'unwords' function is analogous to the 'unlines' function, on words. unwords :: [ByteString] -> ByteString unwords = join (singleton ' ') {-# INLINE unwords #-} -- --------------------------------------------------------------------- -- Reading from ByteStrings -- | readInt reads an Int from the beginning of the ByteString. If there is no -- integer at the beginning of the string, it returns Nothing, otherwise -- it just returns the int read, and the rest of the string. readInt :: ByteString -> Maybe (Int, ByteString) readInt as | null as = Nothing | otherwise = case unsafeHead as of '-' -> loop True 0 0 (unsafeTail as) '+' -> loop False 0 0 (unsafeTail as) _ -> loop False 0 0 as where loop :: Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString) STRICT4(loop) loop neg i n ps | null ps = end neg i n ps | otherwise = case B.unsafeHead ps of w | w >= 0x30 && w <= 0x39 -> loop neg (i+1) (n * 10 + (fromIntegral w - 0x30)) (unsafeTail ps) | otherwise -> end neg i n ps end _ 0 _ _ = Nothing end True _ n ps = Just (negate n, ps) end _ _ n ps = Just (n, ps) -- | readInteger reads an Integer from the beginning of the ByteString. If -- there is no integer at the beginning of the string, it returns Nothing, -- otherwise it just returns the int read, and the rest of the string. readInteger :: ByteString -> Maybe (Integer, ByteString) readInteger as | null as = Nothing | otherwise = case unsafeHead as of '-' -> first (unsafeTail as) >>= \(n, bs) -> return (-n, bs) '+' -> first (unsafeTail as) _ -> first as where first ps | null ps = Nothing | otherwise = case B.unsafeHead ps of w | w >= 0x30 && w <= 0x39 -> Just $ loop 1 (fromIntegral w - 0x30) [] (unsafeTail ps) | otherwise -> Nothing loop :: Int -> Int -> [Integer] -> ByteString -> (Integer, ByteString) STRICT4(loop) loop d acc ns ps | null ps = combine d acc ns empty | otherwise = case B.unsafeHead ps of w | w >= 0x30 && w <= 0x39 -> if d == 9 then loop 1 (fromIntegral w - 0x30) (toInteger acc : ns) (unsafeTail ps) else loop (d+1) (10*acc + (fromIntegral w - 0x30)) ns (unsafeTail ps) | otherwise -> combine d acc ns ps combine _ acc [] ps = (toInteger acc, ps) combine d acc ns ps = ((10^d * combine1 1000000000 ns + toInteger acc), ps) combine1 _ [n] = n combine1 b ns = combine1 (b*b) $ combine2 b ns combine2 b (n:m:ns) = let t = m*b + n in t `seq` (t : combine2 b ns) combine2 _ ns = ns -- | Read an entire file strictly into a 'ByteString'. This is far more -- efficient than reading the characters into a 'String' and then using -- 'pack'. It also may be more efficient than opening the file and -- reading it using hGet. readFile :: FilePath -> IO ByteString readFile f = bracket (openFile f ReadMode) hClose (\h -> hFileSize h >>= hGet h . fromIntegral) -- | Write a 'ByteString' to a file. writeFile :: FilePath -> ByteString -> IO () writeFile f txt = bracket (openFile f WriteMode) hClose (\h -> hPut h txt) -- | Append a 'ByteString' to a file. appendFile :: FilePath -> ByteString -> IO () appendFile f txt = bracket (openFile f AppendMode) hClose (\h -> hPut h txt) hugs98-plus-Sep2006/packages/base/Data/ByteString/Base.hs0000644006511100651110000004715310504340226021632 0ustar rossross{-# OPTIONS_GHC -cpp -fglasgow-exts #-} -- -- Module : ByteString.Base -- License : BSD-style -- Maintainer : dons@cse.unsw.edu.au -- Stability : experimental -- Portability : portable, requires ffi and cpp -- Tested with : GHC 6.4.1 and Hugs March 2005 -- -- | A module containing semi-public ByteString internals. This exposes -- the ByteString representation and low level construction functions. -- Modules which extend the ByteString system will need to use this module -- while ideally most users will be able to make do with the public interface -- modules. -- module Data.ByteString.Base ( -- * The @ByteString@ type and representation ByteString(..), -- instances: Eq, Ord, Show, Read, Data, Typeable LazyByteString(..), -- instances: Eq, Ord, Show, Read, Data, Typeable -- * Unchecked access unsafeHead, -- :: ByteString -> Word8 unsafeTail, -- :: ByteString -> ByteString unsafeIndex, -- :: ByteString -> Int -> Word8 unsafeTake, -- :: Int -> ByteString -> ByteString unsafeDrop, -- :: Int -> ByteString -> ByteString -- * Low level introduction and elimination empty, -- :: ByteString create, -- :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString createAndTrim, -- :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString createAndTrim', -- :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a) mallocByteString, -- :: Int -> IO (ForeignPtr a) unsafeCreate, -- :: Int -> (Ptr Word8 -> IO ()) -> ByteString unsafeUseAsCString, -- :: ByteString -> (CString -> IO a) -> IO a unsafeUseAsCStringLen, -- :: ByteString -> (CStringLen -> IO a) -> IO a fromForeignPtr, -- :: ForeignPtr Word8 -> Int -> ByteString toForeignPtr, -- :: ByteString -> (ForeignPtr Word8, Int, Int) #if defined(__GLASGOW_HASKELL__) packCStringFinalizer, -- :: Ptr Word8 -> Int -> IO () -> IO ByteString packAddress, -- :: Addr# -> ByteString unsafePackAddress, -- :: Int -> Addr# -> ByteString unsafeFinalize, -- :: ByteString -> IO () #endif -- * Utilities inlinePerformIO, -- :: IO a -> a nullForeignPtr, -- :: ForeignPtr Word8 countOccurrences, -- :: (Storable a, Num a) => Ptr a -> Ptr Word8 -> Int -> IO () -- * Standard C Functions c_strlen, -- :: CString -> IO CInt c_malloc, -- :: CInt -> IO (Ptr Word8) c_free, -- :: Ptr Word8 -> IO () c_free_finalizer, -- :: FunPtr (Ptr Word8 -> IO ()) memchr, -- :: Ptr Word8 -> Word8 -> CSize -> IO Ptr Word8 memcmp, -- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt memcpy, -- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () memmove, -- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () memset, -- :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) -- * cbits functions c_reverse, -- :: Ptr Word8 -> Ptr Word8 -> CInt -> IO () c_intersperse, -- :: Ptr Word8 -> Ptr Word8 -> CInt -> Word8 -> IO () c_maximum, -- :: Ptr Word8 -> CInt -> IO Word8 c_minimum, -- :: Ptr Word8 -> CInt -> IO Word8 c_count, -- :: Ptr Word8 -> CInt -> Word8 -> IO CInt -- * Internal GHC magic #if defined(__GLASGOW_HASKELL__) memcpy_ptr_baoff, -- :: Ptr a -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) #endif -- * Chars w2c, c2w, isSpaceWord8 ) where import Foreign.ForeignPtr (ForeignPtr, newForeignPtr_, withForeignPtr) import Foreign.Ptr (Ptr, FunPtr, plusPtr, castPtr) import Foreign.Storable (Storable(..)) import Foreign.C.Types (CInt, CSize, CULong) import Foreign.C.String (CString, CStringLen) import Control.Exception (assert) import Data.Char (ord) import Data.Word (Word8) #if defined(__GLASGOW_HASKELL__) import qualified Foreign.ForeignPtr as FC (finalizeForeignPtr) import qualified Foreign.Concurrent as FC (newForeignPtr) import Data.Generics (Data(..), Typeable(..)) import GHC.Prim (Addr#) import GHC.Ptr (Ptr(..)) import GHC.Base (realWorld#,unsafeChr) import GHC.IOBase (IO(IO), unsafePerformIO, RawBuffer) #else import Data.Char (chr) import System.IO.Unsafe (unsafePerformIO) #endif #if __GLASGOW_HASKELL__ >= 605 && !defined(SLOW_FOREIGN_PTR) import GHC.ForeignPtr (mallocPlainForeignPtrBytes) #else import Foreign.ForeignPtr (mallocForeignPtrBytes) #endif #if __GLASGOW_HASKELL__>=605 import GHC.ForeignPtr (ForeignPtr(ForeignPtr)) import GHC.Base (nullAddr#) #else import Foreign.Ptr (nullPtr) #endif -- CFILES stuff is Hugs only {-# CFILES cbits/fpstring.c #-} -- ----------------------------------------------------------------------------- -- -- Useful macros, until we have bang patterns -- #define STRICT1(f) f a | a `seq` False = undefined #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined #define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined #define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined -- ----------------------------------------------------------------------------- -- | A space-efficient representation of a Word8 vector, supporting many -- efficient operations. A 'ByteString' contains 8-bit characters only. -- -- Instances of Eq, Ord, Read, Show, Data, Typeable -- data ByteString = PS {-# UNPACK #-} !(ForeignPtr Word8) {-# UNPACK #-} !Int -- offset {-# UNPACK #-} !Int -- length #if defined(__GLASGOW_HASKELL__) deriving (Data, Typeable) #endif instance Show ByteString where showsPrec p ps r = showsPrec p (unpackWith w2c ps) r instance Read ByteString where readsPrec p str = [ (packWith c2w x, y) | (x, y) <- readsPrec p str ] -- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function. unpackWith :: (Word8 -> a) -> ByteString -> [a] unpackWith _ (PS _ _ 0) = [] unpackWith k (PS ps s l) = inlinePerformIO $ withForeignPtr ps $ \p -> go (p `plusPtr` s) (l - 1) [] where STRICT3(go) go p 0 acc = peek p >>= \e -> return (k e : acc) go p n acc = peekByteOff p n >>= \e -> go p (n-1) (k e : acc) {-# INLINE unpackWith #-} {-# SPECIALIZE unpackWith :: (Word8 -> Char) -> ByteString -> [Char] #-} -- | /O(n)/ Convert a '[a]' into a 'ByteString' using some -- conversion function packWith :: (a -> Word8) -> [a] -> ByteString packWith k str = unsafeCreate (length str) $ \p -> go p str where STRICT2(go) go _ [] = return () go p (x:xs) = poke p (k x) >> go (p `plusPtr` 1) xs -- less space than pokeElemOff {-# INLINE packWith #-} {-# SPECIALIZE packWith :: (Char -> Word8) -> [Char] -> ByteString #-} ------------------------------------------------------------------------ -- | A space-efficient representation of a Word8 vector, supporting many -- efficient operations. A 'ByteString' contains 8-bit characters only. -- -- Instances of Eq, Ord, Read, Show, Data, Typeable -- newtype LazyByteString = LPS [ByteString] -- LPS for lazy packed string deriving (Show,Read #if defined(__GLASGOW_HASKELL__) ,Data, Typeable #endif ) ------------------------------------------------------------------------ -- | /O(1)/ The empty 'ByteString' empty :: ByteString empty = PS nullForeignPtr 0 0 nullForeignPtr :: ForeignPtr Word8 #if __GLASGOW_HASKELL__>=605 nullForeignPtr = ForeignPtr nullAddr# undefined --TODO: should ForeignPtrContents be strict? #else nullForeignPtr = unsafePerformIO $ newForeignPtr_ nullPtr {-# NOINLINE nullForeignPtr #-} #endif -- --------------------------------------------------------------------- -- -- Extensions to the basic interface -- -- | A variety of 'head' for non-empty ByteStrings. 'unsafeHead' omits the -- check for the empty case, so there is an obligation on the programmer -- to provide a proof that the ByteString is non-empty. unsafeHead :: ByteString -> Word8 unsafeHead (PS x s l) = assert (l > 0) $ inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s {-# INLINE unsafeHead #-} -- | A variety of 'tail' for non-empty ByteStrings. 'unsafeTail' omits the -- check for the empty case. As with 'unsafeHead', the programmer must -- provide a separate proof that the ByteString is non-empty. unsafeTail :: ByteString -> ByteString unsafeTail (PS ps s l) = assert (l > 0) $ PS ps (s+1) (l-1) {-# INLINE unsafeTail #-} -- | Unsafe 'ByteString' index (subscript) operator, starting from 0, returning a 'Word8' -- This omits the bounds check, which means there is an accompanying -- obligation on the programmer to ensure the bounds are checked in some -- other way. unsafeIndex :: ByteString -> Int -> Word8 unsafeIndex (PS x s l) i = assert (i >= 0 && i < l) $ inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+i) {-# INLINE unsafeIndex #-} -- | A variety of 'take' which omits the checks on @n@ so there is an -- obligation on the programmer to provide a proof that @0 <= n <= 'length' xs@. unsafeTake :: Int -> ByteString -> ByteString unsafeTake n (PS x s l) = assert (0 <= n && n <= l) $ PS x s n {-# INLINE unsafeTake #-} -- | A variety of 'drop' which omits the checks on @n@ so there is an -- obligation on the programmer to provide a proof that @0 <= n <= 'length' xs@. unsafeDrop :: Int -> ByteString -> ByteString unsafeDrop n (PS x s l) = assert (0 <= n && n <= l) $ PS x (s+n) (l-n) {-# INLINE unsafeDrop #-} -- --------------------------------------------------------------------- -- Low level constructors -- | /O(1)/ Build a ByteString from a ForeignPtr fromForeignPtr :: ForeignPtr Word8 -> Int -> ByteString fromForeignPtr fp l = PS fp 0 l -- | /O(1)/ Deconstruct a ForeignPtr from a ByteString toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int) toForeignPtr (PS ps s l) = (ps, s, l) -- | A way of creating ByteStrings outside the IO monad. The @Int@ -- argument gives the final size of the ByteString. Unlike -- 'createAndTrim' the ByteString is not reallocated if the final size -- is less than the estimated size. unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString unsafeCreate l f = unsafePerformIO (create l f) {-# INLINE unsafeCreate #-} -- | Create ByteString of size @l@ and use action @f@ to fill it's contents. create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString create l f = do fp <- mallocByteString l withForeignPtr fp $ \p -> f p return $! PS fp 0 l -- | Given the maximum size needed and a function to make the contents -- of a ByteString, createAndTrim makes the 'ByteString'. The generating -- function is required to return the actual final size (<= the maximum -- size), and the resulting byte array is realloced to this size. -- -- createAndTrim is the main mechanism for creating custom, efficient -- ByteString functions, using Haskell or C functions to fill the space. -- createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString createAndTrim l f = do fp <- mallocByteString l withForeignPtr fp $ \p -> do l' <- f p if assert (l' <= l) $ l' >= l then return $! PS fp 0 l else create l' $ \p' -> memcpy p' p (fromIntegral l') createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a) createAndTrim' l f = do fp <- mallocByteString l withForeignPtr fp $ \p -> do (off, l', res) <- f p if assert (l' <= l) $ l' >= l then return $! (PS fp 0 l, res) else do ps <- create l' $ \p' -> memcpy p' (p `plusPtr` off) (fromIntegral l') return $! (ps, res) -- | Wrapper of mallocForeignPtrBytes with faster implementation -- for GHC 6.5 builds newer than 06/06/06 mallocByteString :: Int -> IO (ForeignPtr a) mallocByteString l = do #if __GLASGOW_HASKELL__ >= 605 && !defined(SLOW_FOREIGN_PTR) mallocPlainForeignPtrBytes l #else mallocForeignPtrBytes l #endif #if defined(__GLASGOW_HASKELL__) -- | /O(n)/ Pack a null-terminated sequence of bytes, pointed to by an -- Addr\# (an arbitrary machine address assumed to point outside the -- garbage-collected heap) into a @ByteString@. A much faster way to -- create an Addr\# is with an unboxed string literal, than to pack a -- boxed string. A unboxed string literal is compiled to a static @char -- []@ by GHC. Establishing the length of the string requires a call to -- @strlen(3)@, so the Addr# must point to a null-terminated buffer (as -- is the case with "string"# literals in GHC). Use 'unsafePackAddress' -- if you know the length of the string statically. -- -- An example: -- -- > literalFS = packAddress "literal"# -- packAddress :: Addr# -> ByteString packAddress addr# = inlinePerformIO $ do p <- newForeignPtr_ cstr l <- c_strlen cstr return $ PS p 0 (fromIntegral l) where cstr = Ptr addr# {-# INLINE packAddress #-} -- | /O(1)/ 'unsafePackAddress' provides constant-time construction of -- 'ByteStrings' -- which is ideal for string literals. It packs a -- null-terminated sequence of bytes into a 'ByteString', given a raw -- 'Addr\#' to the string, and the length of the string. Make sure the -- length is correct, otherwise use the safer 'packAddress' (where the -- length will be calculated once at runtime). unsafePackAddress :: Int -> Addr# -> ByteString unsafePackAddress len addr# = inlinePerformIO $ do p <- newForeignPtr_ cstr return $ PS p 0 len where cstr = Ptr addr# -- | /O(1)/ Construct a 'ByteString' given a C Ptr Word8 buffer, a -- length, and an IO action representing a finalizer. This function is -- not available on Hugs. -- packCStringFinalizer :: Ptr Word8 -> Int -> IO () -> IO ByteString packCStringFinalizer p l f = do fp <- FC.newForeignPtr p f return $ PS fp 0 l -- | Explicitly run the finaliser associated with a 'ByteString'. -- Further references to this value may generate invalid memory -- references. This operation is unsafe, as there may be other -- 'ByteStrings' referring to the same underlying pages. If you use -- this, you need to have a proof of some kind that all 'ByteString's -- ever generated from the underlying byte array are no longer live. unsafeFinalize :: ByteString -> IO () unsafeFinalize (PS p _ _) = FC.finalizeForeignPtr p #endif ------------------------------------------------------------------------ -- | Conversion between 'Word8' and 'Char'. Should compile to a no-op. w2c :: Word8 -> Char #if !defined(__GLASGOW_HASKELL__) w2c = chr . fromIntegral #else w2c = unsafeChr . fromIntegral #endif {-# INLINE w2c #-} -- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and -- silently truncates to 8 bits Chars > '\255'. It is provided as -- convenience for ByteString construction. c2w :: Char -> Word8 c2w = fromIntegral . ord {-# INLINE c2w #-} -- Selects white-space characters in the Latin-1 range -- ordered by frequency -- Idea from Ketil isSpaceWord8 :: Word8 -> Bool isSpaceWord8 w = case w of 0x20 -> True -- SPACE 0x0A -> True -- LF, \n 0x09 -> True -- HT, \t 0x0C -> True -- FF, \f 0x0D -> True -- CR, \r 0x0B -> True -- VT, \v 0xA0 -> True -- spotted by QC.. _ -> False {-# INLINE isSpaceWord8 #-} ------------------------------------------------------------------------ -- | Just like unsafePerformIO, but we inline it. Big performance gains as -- it exposes lots of things to further inlining -- {-# INLINE inlinePerformIO #-} inlinePerformIO :: IO a -> a #if defined(__GLASGOW_HASKELL__) inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r #else inlinePerformIO = unsafePerformIO #endif -- | Count the number of occurrences of each byte. -- {-# SPECIALIZE countOccurrences :: Ptr CSize -> Ptr Word8 -> Int -> IO () #-} countOccurrences :: (Storable a, Num a) => Ptr a -> Ptr Word8 -> Int -> IO () STRICT3(countOccurrences) countOccurrences counts str l = go 0 where STRICT1(go) go i | i == l = return () | otherwise = do k <- fromIntegral `fmap` peekElemOff str i x <- peekElemOff counts k pokeElemOff counts k (x + 1) go (i + 1) -- | /O(1) construction/ Use a @ByteString@ with a function requiring a -- @CString@. Warning: modifying the @CString@ will affect the -- @ByteString@. Why is this function unsafe? It relies on the null -- byte at the end of the ByteString to be there. Unless you can -- guarantee the null byte, you should use the safe version, which will -- copy the string first. unsafeUseAsCString :: ByteString -> (CString -> IO a) -> IO a unsafeUseAsCString (PS ps s _) ac = withForeignPtr ps $ \p -> ac (castPtr p `plusPtr` s) -- | /O(1) construction/ Use a @ByteString@ with a function requiring a -- @CStringLen@. unsafeUseAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a unsafeUseAsCStringLen (PS ps s l) f = withForeignPtr ps $ \p -> f (castPtr p `plusPtr` s,l) -- --------------------------------------------------------------------- -- -- Standard C functions -- foreign import ccall unsafe "string.h strlen" c_strlen :: CString -> IO CSize foreign import ccall unsafe "stdlib.h malloc" c_malloc :: CSize -> IO (Ptr Word8) foreign import ccall unsafe "static stdlib.h free" c_free :: Ptr Word8 -> IO () foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer :: FunPtr (Ptr Word8 -> IO ()) foreign import ccall unsafe "string.h memchr" memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) foreign import ccall unsafe "string.h memcmp" memcmp :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt foreign import ccall unsafe "string.h memcpy" memcpy :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () foreign import ccall unsafe "string.h memmove" memmove :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () foreign import ccall unsafe "string.h memset" memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) -- --------------------------------------------------------------------- -- -- Uses our C code -- foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse :: Ptr Word8 -> Ptr Word8 -> CULong -> IO () foreign import ccall unsafe "static fpstring.h fps_intersperse" c_intersperse :: Ptr Word8 -> Ptr Word8 -> CULong -> Word8 -> IO () foreign import ccall unsafe "static fpstring.h fps_maximum" c_maximum :: Ptr Word8 -> CULong -> IO Word8 foreign import ccall unsafe "static fpstring.h fps_minimum" c_minimum :: Ptr Word8 -> CULong -> IO Word8 foreign import ccall unsafe "static fpstring.h fps_count" c_count :: Ptr Word8 -> CULong -> Word8 -> IO CULong -- --------------------------------------------------------------------- -- MMap {- foreign import ccall unsafe "static fpstring.h my_mmap" my_mmap :: Int -> Int -> IO (Ptr Word8) foreign import ccall unsafe "static unistd.h close" c_close :: Int -> IO Int # if !defined(__OpenBSD__) foreign import ccall unsafe "static sys/mman.h munmap" c_munmap :: Ptr Word8 -> Int -> IO Int # endif -} -- --------------------------------------------------------------------- -- Internal GHC Haskell magic #if defined(__GLASGOW_HASKELL__) foreign import ccall unsafe "__hscore_memcpy_src_off" memcpy_ptr_baoff :: Ptr a -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) #endif hugs98-plus-Sep2006/packages/base/Data/ByteString/Fusion.hs0000644006511100651110000005677510504340226022235 0ustar rossross{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-} -- -- Module : Data.ByteString.Fusion -- License : BSD-style -- Maintainer : dons@cse.unsw.edu.au -- Stability : experimental -- Portability : portable, requires ffi and cpp -- Tested with : GHC 6.4.1 and Hugs March 2005 -- -- #hide -- | Functional array fusion for ByteStrings. -- -- Originally based on code from the Data Parallel Haskell project, -- -- module Data.ByteString.Fusion ( -- * Fusion utilities loopU, loopL, fuseEFL, NoAcc(NoAcc), loopArr, loopAcc, loopSndAcc, unSP, mapEFL, filterEFL, foldEFL, foldEFL', scanEFL, mapAccumEFL, mapIndexEFL, -- ** Alternative Fusion stuff -- | This replaces 'loopU' with 'loopUp' -- and adds several further special cases of loops. loopUp, loopDown, loopNoAcc, loopMap, loopFilter, loopWrapper, sequenceLoops, doUpLoop, doDownLoop, doNoAccLoop, doMapLoop, doFilterLoop, -- | These are the special fusion cases for combining each loop form perfectly. fuseAccAccEFL, fuseAccNoAccEFL, fuseNoAccAccEFL, fuseNoAccNoAccEFL, fuseMapAccEFL, fuseAccMapEFL, fuseMapNoAccEFL, fuseNoAccMapEFL, fuseMapMapEFL, fuseAccFilterEFL, fuseFilterAccEFL, fuseNoAccFilterEFL, fuseFilterNoAccEFL, fuseFilterFilterEFL, fuseMapFilterEFL, fuseFilterMapEFL, -- * Strict pairs and sums PairS(..), MaybeS(..) ) where import Data.ByteString.Base import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable (Storable(..)) import Data.Word (Word8) import System.IO.Unsafe (unsafePerformIO) -- ----------------------------------------------------------------------------- -- -- Useful macros, until we have bang patterns -- #define STRICT1(f) f a | a `seq` False = undefined #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined #define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined #define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined infixl 2 :*: -- |Strict pair data PairS a b = !a :*: !b deriving (Eq,Ord,Show) -- |Strict Maybe data MaybeS a = NothingS | JustS !a deriving (Eq,Ord,Show) -- |Data type for accumulators which can be ignored. The rewrite rules rely on -- the fact that no bottoms of this type are ever constructed; hence, we can -- assume @(_ :: NoAcc) `seq` x = x@. -- data NoAcc = NoAcc -- |Type of loop functions type AccEFL acc = acc -> Word8 -> (PairS acc (MaybeS Word8)) type NoAccEFL = Word8 -> MaybeS Word8 type MapEFL = Word8 -> Word8 type FilterEFL = Word8 -> Bool infixr 9 `fuseEFL` -- |Fuse to flat loop functions fuseEFL :: AccEFL acc1 -> AccEFL acc2 -> AccEFL (PairS acc1 acc2) fuseEFL f g (acc1 :*: acc2) e1 = case f acc1 e1 of acc1' :*: NothingS -> (acc1' :*: acc2) :*: NothingS acc1' :*: JustS e2 -> case g acc2 e2 of acc2' :*: res -> (acc1' :*: acc2') :*: res #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] fuseEFL #-} #endif -- | Special forms of loop arguments -- -- * These are common special cases for the three function arguments of gen -- and loop; we give them special names to make it easier to trigger RULES -- applying in the special cases represented by these arguments. The -- "INLINE [1]" makes sure that these functions are only inlined in the last -- two simplifier phases. -- -- * In the case where the accumulator is not needed, it is better to always -- explicitly return a value `()', rather than just copy the input to the -- output, as the former gives GHC better local information. -- -- | Element function expressing a mapping only #if !defined(LOOPNOACC_FUSION) mapEFL :: (Word8 -> Word8) -> AccEFL NoAcc mapEFL f = \_ e -> (NoAcc :*: (JustS $ f e)) #else mapEFL :: (Word8 -> Word8) -> NoAccEFL mapEFL f = \e -> JustS (f e) #endif #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] mapEFL #-} #endif -- | Element function implementing a filter function only #if !defined(LOOPNOACC_FUSION) filterEFL :: (Word8 -> Bool) -> AccEFL NoAcc filterEFL p = \_ e -> if p e then (NoAcc :*: JustS e) else (NoAcc :*: NothingS) #else filterEFL :: (Word8 -> Bool) -> NoAccEFL filterEFL p = \e -> if p e then JustS e else NothingS #endif #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] filterEFL #-} #endif -- |Element function expressing a reduction only foldEFL :: (acc -> Word8 -> acc) -> AccEFL acc foldEFL f = \a e -> (f a e :*: NothingS) #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] foldEFL #-} #endif -- | A strict foldEFL. foldEFL' :: (acc -> Word8 -> acc) -> AccEFL acc foldEFL' f = \a e -> let a' = f a e in a' `seq` (a' :*: NothingS) #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] foldEFL' #-} #endif -- | Element function expressing a prefix reduction only -- scanEFL :: (Word8 -> Word8 -> Word8) -> AccEFL Word8 scanEFL f = \a e -> (f a e :*: JustS a) #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] scanEFL #-} #endif -- | Element function implementing a map and fold -- mapAccumEFL :: (acc -> Word8 -> (acc, Word8)) -> AccEFL acc mapAccumEFL f = \a e -> case f a e of (a', e') -> (a' :*: JustS e') #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] mapAccumEFL #-} #endif -- | Element function implementing a map with index -- mapIndexEFL :: (Int -> Word8 -> Word8) -> AccEFL Int mapIndexEFL f = \i e -> let i' = i+1 in i' `seq` (i' :*: JustS (f i e)) #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] mapIndexEFL #-} #endif -- | Projection functions that are fusion friendly (as in, we determine when -- they are inlined) loopArr :: (PairS acc arr) -> arr loopArr (_ :*: arr) = arr #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] loopArr #-} #endif loopAcc :: (PairS acc arr) -> acc loopAcc (acc :*: _) = acc #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] loopAcc #-} #endif loopSndAcc :: (PairS (PairS acc1 acc2) arr) -> (PairS acc2 arr) loopSndAcc ((_ :*: acc) :*: arr) = (acc :*: arr) #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] loopSndAcc #-} #endif unSP :: (PairS acc arr) -> (acc, arr) unSP (acc :*: arr) = (acc, arr) #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] unSP #-} #endif ------------------------------------------------------------------------ -- -- Loop combinator and fusion rules for flat arrays -- |Iteration over over ByteStrings -- | Iteration over over ByteStrings loopU :: AccEFL acc -- ^ mapping & folding, once per elem -> acc -- ^ initial acc value -> ByteString -- ^ input ByteString -> (PairS acc ByteString) loopU f start (PS z s i) = unsafePerformIO $ withForeignPtr z $ \a -> do (ps, acc) <- createAndTrim' i $ \p -> do (acc' :*: i') <- go (a `plusPtr` s) p start return (0, i', acc') return (acc :*: ps) where go p ma = trans 0 0 where STRICT3(trans) trans a_off ma_off acc | a_off >= i = return (acc :*: ma_off) | otherwise = do x <- peekByteOff p a_off let (acc' :*: oe) = f acc x ma_off' <- case oe of NothingS -> return ma_off JustS e -> do pokeByteOff ma ma_off e return $ ma_off + 1 trans (a_off+1) ma_off' acc' #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] loopU #-} #endif {-# RULES "FPS loop/loop fusion!" forall em1 em2 start1 start2 arr. loopU em2 start2 (loopArr (loopU em1 start1 arr)) = loopSndAcc (loopU (em1 `fuseEFL` em2) (start1 :*: start2) arr) #-} -- -- Functional list/array fusion for lazy ByteStrings. -- loopL :: AccEFL acc -- ^ mapping & folding, once per elem -> acc -- ^ initial acc value -> [ByteString] -- ^ input ByteString -> PairS acc [ByteString] loopL f = loop where loop s [] = (s :*: []) loop s (x:xs) | l == 0 = (s'' :*: ys) | otherwise = (s'' :*: y:ys) where (s' :*: y@(PS _ _ l)) = loopU f s x -- avoid circular dep on P.null (s'' :*: ys) = loop s' xs #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] loopL #-} #endif {-# RULES "FPS lazy loop/loop fusion!" forall em1 em2 start1 start2 arr. loopL em2 start2 (loopArr (loopL em1 start1 arr)) = loopSndAcc (loopL (em1 `fuseEFL` em2) (start1 :*: start2) arr) #-} {- Alternate experimental formulation of loopU which partitions it into an allocating wrapper and an imperitive array-mutating loop. The point in doing this split is that we might be able to fuse multiple loops into a single wrapper. This would save reallocating another buffer. It should also give better cache locality by reusing the buffer. Note that this stuff needs ghc-6.5 from May 26 or later for the RULES to really work reliably. -} loopUp :: AccEFL acc -> acc -> ByteString -> PairS acc ByteString loopUp f a arr = loopWrapper (doUpLoop f a) arr {-# INLINE loopUp #-} loopDown :: AccEFL acc -> acc -> ByteString -> PairS acc ByteString loopDown f a arr = loopWrapper (doDownLoop f a) arr {-# INLINE loopDown #-} loopNoAcc :: NoAccEFL -> ByteString -> PairS NoAcc ByteString loopNoAcc f arr = loopWrapper (doNoAccLoop f NoAcc) arr {-# INLINE loopNoAcc #-} loopMap :: MapEFL -> ByteString -> PairS NoAcc ByteString loopMap f arr = loopWrapper (doMapLoop f NoAcc) arr {-# INLINE loopMap #-} loopFilter :: FilterEFL -> ByteString -> PairS NoAcc ByteString loopFilter f arr = loopWrapper (doFilterLoop f NoAcc) arr {-# INLINE loopFilter #-} -- The type of imperitive loops that fill in a destination array by -- reading a source array. They may not fill in the whole of the dest -- array if the loop is behaving as a filter, this is why we return -- the length that was filled in. The loop may also accumulate some -- value as it loops over the source array. -- type ImperativeLoop acc = Ptr Word8 -- pointer to the start of the source byte array -> Ptr Word8 -- pointer to ther start of the destination byte array -> Int -- length of the source byte array -> IO (PairS (PairS acc Int) Int) -- result and offset, length of dest that was filled loopWrapper :: ImperativeLoop acc -> ByteString -> PairS acc ByteString loopWrapper body (PS srcFPtr srcOffset srcLen) = unsafePerformIO $ withForeignPtr srcFPtr $ \srcPtr -> do (ps, acc) <- createAndTrim' srcLen $ \destPtr -> do (acc :*: destOffset :*: destLen) <- body (srcPtr `plusPtr` srcOffset) destPtr srcLen return (destOffset, destLen, acc) return (acc :*: ps) doUpLoop :: AccEFL acc -> acc -> ImperativeLoop acc doUpLoop f acc0 src dest len = loop 0 0 acc0 where STRICT3(loop) loop src_off dest_off acc | src_off >= len = return (acc :*: 0 :*: dest_off) | otherwise = do x <- peekByteOff src src_off case f acc x of (acc' :*: NothingS) -> loop (src_off+1) dest_off acc' (acc' :*: JustS x') -> pokeByteOff dest dest_off x' >> loop (src_off+1) (dest_off+1) acc' doDownLoop :: AccEFL acc -> acc -> ImperativeLoop acc doDownLoop f acc0 src dest len = loop (len-1) (len-1) acc0 where STRICT3(loop) loop src_off dest_off acc | src_off < 0 = return (acc :*: dest_off + 1 :*: len - (dest_off + 1)) | otherwise = do x <- peekByteOff src src_off case f acc x of (acc' :*: NothingS) -> loop (src_off-1) dest_off acc' (acc' :*: JustS x') -> pokeByteOff dest dest_off x' >> loop (src_off-1) (dest_off-1) acc' doNoAccLoop :: NoAccEFL -> noAcc -> ImperativeLoop noAcc doNoAccLoop f noAcc src dest len = loop 0 0 where STRICT2(loop) loop src_off dest_off | src_off >= len = return (noAcc :*: 0 :*: dest_off) | otherwise = do x <- peekByteOff src src_off case f x of NothingS -> loop (src_off+1) dest_off JustS x' -> pokeByteOff dest dest_off x' >> loop (src_off+1) (dest_off+1) doMapLoop :: MapEFL -> noAcc -> ImperativeLoop noAcc doMapLoop f noAcc src dest len = loop 0 where STRICT1(loop) loop n | n >= len = return (noAcc :*: 0 :*: len) | otherwise = do x <- peekByteOff src n pokeByteOff dest n (f x) loop (n+1) -- offset always the same, only pass 1 arg doFilterLoop :: FilterEFL -> noAcc -> ImperativeLoop noAcc doFilterLoop f noAcc src dest len = loop 0 0 where STRICT2(loop) loop src_off dest_off | src_off >= len = return (noAcc :*: 0 :*: dest_off) | otherwise = do x <- peekByteOff src src_off if f x then pokeByteOff dest dest_off x >> loop (src_off+1) (dest_off+1) else loop (src_off+1) dest_off -- run two loops in sequence, -- think of it as: loop1 >> loop2 sequenceLoops :: ImperativeLoop acc1 -> ImperativeLoop acc2 -> ImperativeLoop (PairS acc1 acc2) sequenceLoops loop1 loop2 src dest len0 = do (acc1 :*: off1 :*: len1) <- loop1 src dest len0 (acc2 :*: off2 :*: len2) <- let src' = dest `plusPtr` off1 dest' = src' -- note that we are using dest == src -- for the second loop as we are -- mutating the dest array in-place! in loop2 src' dest' len1 return ((acc1 :*: acc2) :*: off1 + off2 :*: len2) -- TODO: prove that this is associative! (I think it is) -- since we can't be sure how the RULES will combine loops. #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] doUpLoop #-} {-# INLINE [1] doDownLoop #-} {-# INLINE [1] doNoAccLoop #-} {-# INLINE [1] doMapLoop #-} {-# INLINE [1] doFilterLoop #-} {-# INLINE [1] loopWrapper #-} {-# INLINE [1] sequenceLoops #-} {-# INLINE [1] fuseAccAccEFL #-} {-# INLINE [1] fuseAccNoAccEFL #-} {-# INLINE [1] fuseNoAccAccEFL #-} {-# INLINE [1] fuseNoAccNoAccEFL #-} {-# INLINE [1] fuseMapAccEFL #-} {-# INLINE [1] fuseAccMapEFL #-} {-# INLINE [1] fuseMapNoAccEFL #-} {-# INLINE [1] fuseNoAccMapEFL #-} {-# INLINE [1] fuseMapMapEFL #-} {-# INLINE [1] fuseAccFilterEFL #-} {-# INLINE [1] fuseFilterAccEFL #-} {-# INLINE [1] fuseNoAccFilterEFL #-} {-# INLINE [1] fuseFilterNoAccEFL #-} {-# INLINE [1] fuseFilterFilterEFL #-} {-# INLINE [1] fuseMapFilterEFL #-} {-# INLINE [1] fuseFilterMapEFL #-} #endif {-# RULES "FPS loopArr/loopSndAcc" forall x. loopArr (loopSndAcc x) = loopArr x "FPS seq/NoAcc" forall (u::NoAcc) e. u `seq` e = e "FPS loop/loop wrapper elimination" forall loop1 loop2 arr. loopWrapper loop2 (loopArr (loopWrapper loop1 arr)) = loopSndAcc (loopWrapper (sequenceLoops loop1 loop2) arr) -- -- n.b in the following, when reading n/m fusion, recall sequenceLoops -- is monadic, so its really n >> m fusion (i.e. m.n), not n . m fusion. -- "FPS up/up loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doUpLoop f1 acc1) (doUpLoop f2 acc2) = doUpLoop (f1 `fuseAccAccEFL` f2) (acc1 :*: acc2) "FPS map/map loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doMapLoop f1 acc1) (doMapLoop f2 acc2) = doMapLoop (f1 `fuseMapMapEFL` f2) (acc1 :*: acc2) "FPS filter/filter loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doFilterLoop f1 acc1) (doFilterLoop f2 acc2) = doFilterLoop (f1 `fuseFilterFilterEFL` f2) (acc1 :*: acc2) "FPS map/filter loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doMapLoop f1 acc1) (doFilterLoop f2 acc2) = doNoAccLoop (f1 `fuseMapFilterEFL` f2) (acc1 :*: acc2) "FPS filter/map loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doFilterLoop f1 acc1) (doMapLoop f2 acc2) = doNoAccLoop (f1 `fuseFilterMapEFL` f2) (acc1 :*: acc2) "FPS map/up loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doMapLoop f1 acc1) (doUpLoop f2 acc2) = doUpLoop (f1 `fuseMapAccEFL` f2) (acc1 :*: acc2) "FPS up/map loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doUpLoop f1 acc1) (doMapLoop f2 acc2) = doUpLoop (f1 `fuseAccMapEFL` f2) (acc1 :*: acc2) "FPS filter/up loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doFilterLoop f1 acc1) (doUpLoop f2 acc2) = doUpLoop (f1 `fuseFilterAccEFL` f2) (acc1 :*: acc2) "FPS up/filter loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doUpLoop f1 acc1) (doFilterLoop f2 acc2) = doUpLoop (f1 `fuseAccFilterEFL` f2) (acc1 :*: acc2) "FPS down/down loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doDownLoop f1 acc1) (doDownLoop f2 acc2) = doDownLoop (f1 `fuseAccAccEFL` f2) (acc1 :*: acc2) "FPS map/down fusion" forall f1 f2 acc1 acc2. sequenceLoops (doMapLoop f1 acc1) (doDownLoop f2 acc2) = doDownLoop (f1 `fuseMapAccEFL` f2) (acc1 :*: acc2) "FPS down/map loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doDownLoop f1 acc1) (doMapLoop f2 acc2) = doDownLoop (f1 `fuseAccMapEFL` f2) (acc1 :*: acc2) "FPS filter/down fusion" forall f1 f2 acc1 acc2. sequenceLoops (doFilterLoop f1 acc1) (doDownLoop f2 acc2) = doDownLoop (f1 `fuseFilterAccEFL` f2) (acc1 :*: acc2) "FPS down/filter loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doDownLoop f1 acc1) (doFilterLoop f2 acc2) = doDownLoop (f1 `fuseAccFilterEFL` f2) (acc1 :*: acc2) "FPS noAcc/noAcc loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doNoAccLoop f1 acc1) (doNoAccLoop f2 acc2) = doNoAccLoop (f1 `fuseNoAccNoAccEFL` f2) (acc1 :*: acc2) "FPS noAcc/up loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doNoAccLoop f1 acc1) (doUpLoop f2 acc2) = doUpLoop (f1 `fuseNoAccAccEFL` f2) (acc1 :*: acc2) "FPS up/noAcc loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doUpLoop f1 acc1) (doNoAccLoop f2 acc2) = doUpLoop (f1 `fuseAccNoAccEFL` f2) (acc1 :*: acc2) "FPS map/noAcc loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doMapLoop f1 acc1) (doNoAccLoop f2 acc2) = doNoAccLoop (f1 `fuseMapNoAccEFL` f2) (acc1 :*: acc2) "FPS noAcc/map loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doNoAccLoop f1 acc1) (doMapLoop f2 acc2) = doNoAccLoop (f1 `fuseNoAccMapEFL` f2) (acc1 :*: acc2) "FPS filter/noAcc loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doFilterLoop f1 acc1) (doNoAccLoop f2 acc2) = doNoAccLoop (f1 `fuseFilterNoAccEFL` f2) (acc1 :*: acc2) "FPS noAcc/filter loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doNoAccLoop f1 acc1) (doFilterLoop f2 acc2) = doNoAccLoop (f1 `fuseNoAccFilterEFL` f2) (acc1 :*: acc2) "FPS noAcc/down loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doNoAccLoop f1 acc1) (doDownLoop f2 acc2) = doDownLoop (f1 `fuseNoAccAccEFL` f2) (acc1 :*: acc2) "FPS down/noAcc loop fusion" forall f1 f2 acc1 acc2. sequenceLoops (doDownLoop f1 acc1) (doNoAccLoop f2 acc2) = doDownLoop (f1 `fuseAccNoAccEFL` f2) (acc1 :*: acc2) #-} {- up = up loop down = down loop map = map special case filter = filter special case noAcc = noAcc undirectional loop (unused) heirarchy: up down ^ ^ \ / noAcc ^ ^ / \ map filter each is a special case of the things above so we get rules that combine things on the same level and rules that combine things on different levels to get something on the higher level so all the cases: up/up --> up fuseAccAccEFL down/down --> down fuseAccAccEFL noAcc/noAcc --> noAcc fuseNoAccNoAccEFL noAcc/up --> up fuseNoAccAccEFL up/noAcc --> up fuseAccNoAccEFL noAcc/down --> down fuseNoAccAccEFL down/noAcc --> down fuseAccNoAccEFL and if we do the map, filter special cases then it adds a load more: map/map --> map fuseMapMapEFL filter/filter --> filter fuseFilterFilterEFL map/filter --> noAcc fuseMapFilterEFL filter/map --> noAcc fuseFilterMapEFL map/noAcc --> noAcc fuseMapNoAccEFL noAcc/map --> noAcc fuseNoAccMapEFL map/up --> up fuseMapAccEFL up/map --> up fuseAccMapEFL map/down --> down fuseMapAccEFL down/map --> down fuseAccMapEFL filter/noAcc --> noAcc fuseNoAccFilterEFL noAcc/filter --> noAcc fuseFilterNoAccEFL filter/up --> up fuseFilterAccEFL up/filter --> up fuseAccFilterEFL filter/down --> down fuseFilterAccEFL down/filter --> down fuseAccFilterEFL -} fuseAccAccEFL :: AccEFL acc1 -> AccEFL acc2 -> AccEFL (PairS acc1 acc2) fuseAccAccEFL f g (acc1 :*: acc2) e1 = case f acc1 e1 of acc1' :*: NothingS -> (acc1' :*: acc2) :*: NothingS acc1' :*: JustS e2 -> case g acc2 e2 of acc2' :*: res -> (acc1' :*: acc2') :*: res fuseAccNoAccEFL :: AccEFL acc -> NoAccEFL -> AccEFL (PairS acc noAcc) fuseAccNoAccEFL f g (acc :*: noAcc) e1 = case f acc e1 of acc' :*: NothingS -> (acc' :*: noAcc) :*: NothingS acc' :*: JustS e2 -> (acc' :*: noAcc) :*: g e2 fuseNoAccAccEFL :: NoAccEFL -> AccEFL acc -> AccEFL (PairS noAcc acc) fuseNoAccAccEFL f g (noAcc :*: acc) e1 = case f e1 of NothingS -> (noAcc :*: acc) :*: NothingS JustS e2 -> case g acc e2 of acc' :*: res -> (noAcc :*: acc') :*: res fuseNoAccNoAccEFL :: NoAccEFL -> NoAccEFL -> NoAccEFL fuseNoAccNoAccEFL f g e1 = case f e1 of NothingS -> NothingS JustS e2 -> g e2 fuseMapAccEFL :: MapEFL -> AccEFL acc -> AccEFL (PairS noAcc acc) fuseMapAccEFL f g (noAcc :*: acc) e1 = case g acc (f e1) of (acc' :*: res) -> (noAcc :*: acc') :*: res fuseAccMapEFL :: AccEFL acc -> MapEFL -> AccEFL (PairS acc noAcc) fuseAccMapEFL f g (acc :*: noAcc) e1 = case f acc e1 of (acc' :*: NothingS) -> (acc' :*: noAcc) :*: NothingS (acc' :*: JustS e2) -> (acc' :*: noAcc) :*: JustS (g e2) fuseMapMapEFL :: MapEFL -> MapEFL -> MapEFL fuseMapMapEFL f g e1 = g (f e1) -- n.b. perfect fusion fuseMapNoAccEFL :: MapEFL -> NoAccEFL -> NoAccEFL fuseMapNoAccEFL f g e1 = g (f e1) fuseNoAccMapEFL :: NoAccEFL -> MapEFL -> NoAccEFL fuseNoAccMapEFL f g e1 = case f e1 of NothingS -> NothingS JustS e2 -> JustS (g e2) fuseAccFilterEFL :: AccEFL acc -> FilterEFL -> AccEFL (PairS acc noAcc) fuseAccFilterEFL f g (acc :*: noAcc) e1 = case f acc e1 of acc' :*: NothingS -> (acc' :*: noAcc) :*: NothingS acc' :*: JustS e2 -> case g e2 of False -> (acc' :*: noAcc) :*: NothingS True -> (acc' :*: noAcc) :*: JustS e2 fuseFilterAccEFL :: FilterEFL -> AccEFL acc -> AccEFL (PairS noAcc acc) fuseFilterAccEFL f g (noAcc :*: acc) e1 = case f e1 of False -> (noAcc :*: acc) :*: NothingS True -> case g acc e1 of acc' :*: res -> (noAcc :*: acc') :*: res fuseNoAccFilterEFL :: NoAccEFL -> FilterEFL -> NoAccEFL fuseNoAccFilterEFL f g e1 = case f e1 of NothingS -> NothingS JustS e2 -> case g e2 of False -> NothingS True -> JustS e2 fuseFilterNoAccEFL :: FilterEFL -> NoAccEFL -> NoAccEFL fuseFilterNoAccEFL f g e1 = case f e1 of False -> NothingS True -> g e1 fuseFilterFilterEFL :: FilterEFL -> FilterEFL -> FilterEFL fuseFilterFilterEFL f g e1 = f e1 && g e1 fuseMapFilterEFL :: MapEFL -> FilterEFL -> NoAccEFL fuseMapFilterEFL f g e1 = case f e1 of e2 -> case g e2 of False -> NothingS True -> JustS e2 fuseFilterMapEFL :: FilterEFL -> MapEFL -> NoAccEFL fuseFilterMapEFL f g e1 = case f e1 of False -> NothingS True -> JustS (g e1) hugs98-plus-Sep2006/packages/base/Data/ByteString/Lazy.hs0000644006511100651110000014632210504340226021675 0ustar rossross{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans -fno-warn-incomplete-patterns #-} -- -- Module : ByteString.Lazy -- Copyright : (c) Don Stewart 2006 -- (c) Duncan Coutts 2006 -- License : BSD-style -- -- Maintainer : dons@cse.unsw.edu.au -- Stability : experimental -- Portability : portable, requires ffi and cpp -- Tested with : GHC 6.4.1 and Hugs March 2005 -- -- -- | A time and space-efficient implementation of lazy byte vectors -- using lists of packed 'Word8' arrays, suitable for high performance -- use, both in terms of large data quantities, or high speed -- requirements. Byte vectors are encoded as lazy lists of strict 'Word8' -- arrays of bytes. They provide a means to manipulate large byte vectors -- without requiring the entire vector be resident in memory. -- -- Some operations, such as concat, append, reverse and cons, have -- better complexity than their "Data.ByteString" equivalents, due to -- optimisations resulting from the list spine structure. And for other -- operations Lazy ByteStrings are usually within a few percent of -- strict ones, but with better heap usage. For data larger than the -- available memory, or if you have tight memory constraints, this -- module will be the only option. The default chunk size is 64k, which -- should be good in most circumstances. For people with large L2 -- caches, you may want to increase this to fit your cache. -- -- This module is intended to be imported @qualified@, to avoid name -- clashes with "Prelude" functions. eg. -- -- > import qualified Data.ByteString.Lazy as B -- -- Original GHC implementation by Bryan O\'Sullivan. Rewritten to use -- UArray by Simon Marlow. Rewritten to support slices and use -- ForeignPtr by David Roundy. Polished and extended by Don Stewart. -- Lazy variant by Duncan Coutts and Don Stewart. -- module Data.ByteString.Lazy ( -- * The @ByteString@ type ByteString, -- instances: Eq, Ord, Show, Read, Data, Typeable -- * Introducing and eliminating 'ByteString's empty, -- :: ByteString singleton, -- :: Word8 -> ByteString pack, -- :: [Word8] -> ByteString unpack, -- :: ByteString -> [Word8] fromChunks, -- :: [Strict.ByteString] -> ByteString toChunks, -- :: ByteString -> [Strict.ByteString] -- * Basic interface cons, -- :: Word8 -> ByteString -> ByteString snoc, -- :: ByteString -> Word8 -> ByteString append, -- :: ByteString -> ByteString -> ByteString head, -- :: ByteString -> Word8 last, -- :: ByteString -> Word8 tail, -- :: ByteString -> ByteString init, -- :: ByteString -> ByteString null, -- :: ByteString -> Bool length, -- :: ByteString -> Int64 -- * Transformating ByteStrings map, -- :: (Word8 -> Word8) -> ByteString -> ByteString reverse, -- :: ByteString -> ByteString -- intersperse, -- :: Word8 -> ByteString -> ByteString transpose, -- :: [ByteString] -> [ByteString] -- * Reducing 'ByteString's (folds) foldl, -- :: (a -> Word8 -> a) -> a -> ByteString -> a foldl', -- :: (a -> Word8 -> a) -> a -> ByteString -> a foldl1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1', -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldr, -- :: (Word8 -> a -> a) -> a -> ByteString -> a foldr1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 -- ** Special folds concat, -- :: [ByteString] -> ByteString concatMap, -- :: (Word8 -> ByteString) -> ByteString -> ByteString any, -- :: (Word8 -> Bool) -> ByteString -> Bool all, -- :: (Word8 -> Bool) -> ByteString -> Bool maximum, -- :: ByteString -> Word8 minimum, -- :: ByteString -> Word8 -- * Building ByteStrings -- ** Scans scanl, -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString -- scanl1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -- scanr, -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString -- scanr1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -- ** Accumulating maps mapAccumL, -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) mapIndexed, -- :: (Int64 -> Word8 -> Word8) -> ByteString -> ByteString -- ** Infinite ByteStrings repeat, -- :: Word8 -> ByteString replicate, -- :: Int64 -> Word8 -> ByteString cycle, -- :: ByteString -> ByteString iterate, -- :: (Word8 -> Word8) -> Word8 -> ByteString -- ** Unfolding unfoldr, -- :: (a -> Maybe (Word8, a)) -> a -> ByteString -- * Substrings -- ** Breaking strings take, -- :: Int64 -> ByteString -> ByteString drop, -- :: Int64 -> ByteString -> ByteString splitAt, -- :: Int64 -> ByteString -> (ByteString, ByteString) takeWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString dropWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString span, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) break, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) group, -- :: ByteString -> [ByteString] groupBy, -- :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString] inits, -- :: ByteString -> [ByteString] tails, -- :: ByteString -> [ByteString] -- ** Breaking into many substrings split, -- :: Word8 -> ByteString -> [ByteString] splitWith, -- :: (Word8 -> Bool) -> ByteString -> [ByteString] -- ** Joining strings join, -- :: ByteString -> [ByteString] -> ByteString -- * Predicates isPrefixOf, -- :: ByteString -> ByteString -> Bool -- isSuffixOf, -- :: ByteString -> ByteString -> Bool -- * Searching ByteStrings -- ** Searching by equality elem, -- :: Word8 -> ByteString -> Bool notElem, -- :: Word8 -> ByteString -> Bool -- ** Searching with a predicate find, -- :: (Word8 -> Bool) -> ByteString -> Maybe Word8 filter, -- :: (Word8 -> Bool) -> ByteString -> ByteString -- partition -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) -- * Indexing ByteStrings index, -- :: ByteString -> Int64 -> Word8 elemIndex, -- :: Word8 -> ByteString -> Maybe Int64 elemIndices, -- :: Word8 -> ByteString -> [Int64] findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int64 findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int64] count, -- :: Word8 -> ByteString -> Int64 -- * Zipping and unzipping ByteStrings zip, -- :: ByteString -> ByteString -> [(Word8,Word8)] zipWith, -- :: (Word8 -> Word8 -> c) -> ByteString -> ByteString -> [c] -- unzip, -- :: [(Word8,Word8)] -> (ByteString,ByteString) -- * Ordered ByteStrings -- sort, -- :: ByteString -> ByteString copy, -- :: ByteString -> ByteString -- * I\/O with 'ByteString's -- ** Standard input and output getContents, -- :: IO ByteString putStr, -- :: ByteString -> IO () putStrLn, -- :: ByteString -> IO () interact, -- :: (ByteString -> ByteString) -> IO () -- ** Files readFile, -- :: FilePath -> IO ByteString writeFile, -- :: FilePath -> ByteString -> IO () appendFile, -- :: FilePath -> ByteString -> IO () -- ** I\/O with Handles hGetContents, -- :: Handle -> IO ByteString hGet, -- :: Handle -> Int -> IO ByteString hPut, -- :: Handle -> ByteString -> IO () hGetNonBlocking, -- :: Handle -> IO ByteString -- hGetN, -- :: Int -> Handle -> Int -> IO ByteString -- hGetContentsN, -- :: Int -> Handle -> IO ByteString -- hGetNonBlockingN, -- :: Int -> Handle -> IO ByteString ) where import qualified Prelude import Prelude hiding (reverse,head,tail,last,init,null,length,map,lines,foldl,foldr,unlines ,concat,any,take,drop,splitAt,takeWhile,dropWhile,span,break,elem,filter,maximum ,minimum,all,concatMap,foldl1,foldr1,scanl, scanl1, scanr, scanr1 ,repeat, cycle, interact, iterate,readFile,writeFile,appendFile,replicate ,getContents,getLine,putStr,putStrLn ,zip,zipWith,unzip,notElem) import qualified Data.List as L -- L for list/lazy import qualified Data.ByteString as P -- P for packed import qualified Data.ByteString.Base as P import Data.ByteString.Base (LazyByteString(..)) import qualified Data.ByteString.Fusion as P import Data.ByteString.Fusion (PairS(..),loopL) import Data.Monoid (Monoid(..)) import Data.Word (Word8) import Data.Int (Int64) import System.IO (Handle,stdin,stdout,openBinaryFile,IOMode(..) ,hClose,hWaitForInput,hIsEOF) import System.IO.Unsafe import Control.Exception (bracket) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr import Foreign.Storable -- ----------------------------------------------------------------------------- -- -- Useful macros, until we have bang patterns -- #define STRICT1(f) f a | a `seq` False = undefined #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined #define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined #define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined -- ----------------------------------------------------------------------------- type ByteString = LazyByteString -- -- hmm, what about getting the PS constructor unpacked into the cons cell? -- -- data List = Nil | Cons {-# UNPACK #-} !P.ByteString List -- -- Would avoid one indirection per chunk. -- unLPS :: ByteString -> [P.ByteString] unLPS (LPS xs) = xs {-# INLINE unLPS #-} instance Eq ByteString where (==) = eq instance Ord ByteString where compare = compareBytes instance Monoid ByteString where mempty = empty mappend = append mconcat = concat ------------------------------------------------------------------------ -- XXX -- The data type invariant: -- Every ByteString is either empty or consists of non-null ByteStrings. -- All functions must preserve this, and the QC properties must check this. -- _invariant :: ByteString -> Bool _invariant (LPS []) = True _invariant (LPS xs) = L.all (not . P.null) xs -- In a form useful for QC testing _checkInvariant :: ByteString -> ByteString _checkInvariant lps | _invariant lps = lps | otherwise = moduleError "invariant" ("violation: " ++ show lps) -- The Data abstraction function -- _abstr :: ByteString -> P.ByteString _abstr (LPS []) = P.empty _abstr (LPS xs) = P.concat xs -- The representation uses lists of packed chunks. When we have to convert from -- a lazy list to the chunked representation, then by default we'll use this -- chunk size. Some functions give you more control over the chunk size. -- -- Measurements here: -- http://www.cse.unsw.edu.au/~dons/tmp/chunksize_v_cache.png -- -- indicate that a value around 0.5 to 1 x your L2 cache is best. -- The following value assumes people have something greater than 128k, -- and need to share the cache with other programs. -- defaultChunkSize :: Int defaultChunkSize = 32 * k - overhead where k = 1024 overhead = 2 * sizeOf (undefined :: Int) smallChunkSize :: Int smallChunkSize = 4 * k - overhead where k = 1024 overhead = 2 * sizeOf (undefined :: Int) -- defaultChunkSize = 1 ------------------------------------------------------------------------ eq :: ByteString -> ByteString -> Bool eq (LPS xs) (LPS ys) = eq' xs ys where eq' [] [] = True eq' [] _ = False eq' _ [] = False eq' (a:as) (b:bs) = case compare (P.length a) (P.length b) of LT -> a == (P.take (P.length a) b) && eq' as (P.drop (P.length a) b : bs) EQ -> a == b && eq' as bs GT -> (P.take (P.length b) a) == b && eq' (P.drop (P.length b) a : as) bs compareBytes :: ByteString -> ByteString -> Ordering compareBytes (LPS xs) (LPS ys) = cmp xs ys where cmp [] [] = EQ cmp [] _ = LT cmp _ [] = GT cmp (a:as) (b:bs) = case compare (P.length a) (P.length b) of LT -> case compare a (P.take (P.length a) b) of EQ -> cmp as (P.drop (P.length a) b : bs) result -> result EQ -> case compare a b of EQ -> cmp as bs result -> result GT -> case compare (P.take (P.length b) a) b of EQ -> cmp (P.drop (P.length b) a : as) bs result -> result -- ----------------------------------------------------------------------------- -- Introducing and eliminating 'ByteString's -- | /O(1)/ The empty 'ByteString' empty :: ByteString empty = LPS [] {-# NOINLINE empty #-} -- | /O(1)/ Convert a 'Word8' into a 'ByteString' singleton :: Word8 -> ByteString singleton c = LPS [P.singleton c] {-# NOINLINE singleton #-} -- | /O(n)/ Convert a '[Word8]' into a 'ByteString'. pack :: [Word8] -> ByteString pack str = LPS $ L.map P.pack (chunk defaultChunkSize str) -- ? chunk :: Int -> [a] -> [[a]] chunk _ [] = [] chunk size xs = case L.splitAt size xs of (xs', xs'') -> xs' : chunk size xs'' -- | /O(n)/ Converts a 'ByteString' to a '[Word8]'. unpack :: ByteString -> [Word8] unpack (LPS ss) = L.concatMap P.unpack ss {-# INLINE unpack #-} -- | /O(c)/ Convert a list of strict 'ByteString' into a lazy 'ByteString' fromChunks :: [P.ByteString] -> ByteString fromChunks ls = LPS $ L.filter (not . P.null) ls -- | /O(n)/ Convert a lazy 'ByteString' into a list of strict 'ByteString' toChunks :: ByteString -> [P.ByteString] toChunks (LPS s) = s ------------------------------------------------------------------------ {- -- | /O(n)/ Convert a '[a]' into a 'ByteString' using some -- conversion function packWith :: (a -> Word8) -> [a] -> ByteString packWith k str = LPS $ L.map (P.packWith k) (chunk defaultChunkSize str) {-# INLINE packWith #-} {-# SPECIALIZE packWith :: (Char -> Word8) -> [Char] -> ByteString #-} -- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function. unpackWith :: (Word8 -> a) -> ByteString -> [a] unpackWith k (LPS ss) = L.concatMap (P.unpackWith k) ss {-# INLINE unpackWith #-} {-# SPECIALIZE unpackWith :: (Word8 -> Char) -> ByteString -> [Char] #-} -} -- --------------------------------------------------------------------- -- Basic interface -- | /O(1)/ Test whether a ByteString is empty. null :: ByteString -> Bool null (LPS []) = True null (_) = False {-# INLINE null #-} -- | /O(n\/c)/ 'length' returns the length of a ByteString as an 'Int64' length :: ByteString -> Int64 length (LPS ss) = L.foldl' (\n ps -> n + fromIntegral (P.length ps)) 0 ss -- avoid the intermediate list? -- length (LPS ss) = L.foldl lengthF 0 ss -- where lengthF n s = let m = n + fromIntegral (P.length s) in m `seq` m {-# INLINE length #-} -- | /O(1)/ 'cons' is analogous to '(:)' for lists. Unlike '(:)' however it is -- strict in the ByteString that we are consing onto. More precisely, it forces -- the head and the first chunk. It does this because, for space efficiency, it -- may coalesce the new byte onto the first \'chunk\' rather than starting a -- new \'chunk\'. -- -- So that means you can't use a lazy recursive contruction like this: -- -- > let xs = cons c xs in xs -- -- You can however use 'repeat' and 'cycle' to build infinite lazy ByteStrings. -- cons :: Word8 -> ByteString -> ByteString cons c (LPS (s:ss)) | P.length s <= 16 = LPS (P.cons c s : ss) cons c (LPS ss) = LPS (P.singleton c : ss) {-# INLINE cons #-} -- | /O(n\/c)/ Append a byte to the end of a 'ByteString' snoc :: ByteString -> Word8 -> ByteString snoc (LPS ss) c = LPS (ss ++ [P.singleton c]) {-# INLINE snoc #-} -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. head :: ByteString -> Word8 head (LPS []) = errorEmptyList "head" head (LPS (x:_)) = P.unsafeHead x {-# INLINE head #-} -- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty. tail :: ByteString -> ByteString tail (LPS []) = errorEmptyList "tail" tail (LPS (x:xs)) | P.length x == 1 = LPS xs | otherwise = LPS (P.unsafeTail x : xs) {-# INLINE tail #-} -- | /O(n\/c)/ Extract the last element of a ByteString, which must be finite and non-empty. last :: ByteString -> Word8 last (LPS []) = errorEmptyList "last" last (LPS xs) = P.last (L.last xs) {-# INLINE last #-} -- | /O(n\/c)/ Return all the elements of a 'ByteString' except the last one. init :: ByteString -> ByteString init (LPS []) = errorEmptyList "init" init (LPS xs) | P.length y == 1 = LPS ys | otherwise = LPS (ys ++ [P.init y]) where (y,ys) = (L.last xs, L.init xs) {-# INLINE init #-} -- | /O(n)/ Append two ByteStrings append :: ByteString -> ByteString -> ByteString append (LPS []) (LPS ys) = LPS ys append (LPS xs) (LPS []) = LPS xs append (LPS xs) (LPS ys) = LPS (xs ++ ys) {-# INLINE append #-} -- --------------------------------------------------------------------- -- Transformations -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each -- element of @xs@. map :: (Word8 -> Word8) -> ByteString -> ByteString --map f (LPS xs) = LPS (L.map (P.map' f) xs) map f = LPS . P.loopArr . loopL (P.mapEFL f) P.NoAcc . unLPS {-# INLINE map #-} -- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order. reverse :: ByteString -> ByteString reverse (LPS ps) = LPS (rev [] ps) where rev a [] = a rev a (x:xs) = rev (P.reverse x:a) xs -- note, here is one example where the extra element lazyness is an advantage. -- we can reerse the list of chunks strictly but reverse each chunk lazily -- so while we may force the whole lot into memory we do not need to copy -- each chunk until it is used. {-# INLINE reverse #-} -- The 'intersperse' function takes a 'Word8' and a 'ByteString' and -- \`intersperses\' that byte between the elements of the 'ByteString'. -- It is analogous to the intersperse function on Lists. -- intersperse :: Word8 -> ByteString -> ByteString -- intersperse = error "FIXME: not yet implemented" {- intersperse c (LPS []) = LPS [] intersperse c (LPS (x:xs)) = LPS (P.intersperse c x : L.map intersperse') where intersperse' c ps@(PS x s l) = P.create (2*l) $ \p -> withForeignPtr x $ \f -> poke p c c_intersperse (p `plusPtr` 1) (f `plusPtr` s) l c -} -- | The 'transpose' function transposes the rows and columns of its -- 'ByteString' argument. transpose :: [ByteString] -> [ByteString] transpose s = L.map (\ss -> LPS [P.pack ss]) (L.transpose (L.map unpack s)) -- --------------------------------------------------------------------- -- Reducing 'ByteString's -- | 'foldl', applied to a binary operator, a starting value (typically -- the left-identity of the operator), and a ByteString, reduces the -- ByteString using the binary operator, from left to right. foldl :: (a -> Word8 -> a) -> a -> ByteString -> a --foldl f z (LPS xs) = L.foldl (P.foldl f) z xs foldl f z = P.loopAcc . loopL (P.foldEFL f) z . unLPS {-# INLINE foldl #-} -- | 'foldl\'' is like 'foldl', but strict in the accumulator. foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a --foldl' f z (LPS xs) = L.foldl' (P.foldl' f) z xs foldl' f z = P.loopAcc . loopL (P.foldEFL' f) z . unLPS {-# INLINE foldl' #-} -- | 'foldr', applied to a binary operator, a starting value -- (typically the right-identity of the operator), and a ByteString, -- reduces the ByteString using the binary operator, from right to left. foldr :: (Word8 -> a -> a) -> a -> ByteString -> a foldr k z (LPS xs) = L.foldr (flip (P.foldr k)) z xs {-# INLINE foldr #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'ByteStrings'. -- This function is subject to array fusion. foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1 _ (LPS []) = errorEmptyList "foldl1" foldl1 f (LPS (x:xs)) = foldl f (P.unsafeHead x) (LPS (P.unsafeTail x : xs)) -- | 'foldl1\'' is like 'foldl1', but strict in the accumulator. foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1' _ (LPS []) = errorEmptyList "foldl1'" foldl1' f (LPS (x:xs)) = foldl' f (P.unsafeHead x) (LPS (P.unsafeTail x : xs)) -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty 'ByteString's foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldr1 _ (LPS []) = errorEmptyList "foldr1" foldr1 f (LPS ps) = foldr1' ps where foldr1' (x:[]) = P.foldr1 f x foldr1' (x:xs) = P.foldr f (foldr1' xs) x -- --------------------------------------------------------------------- -- Special folds -- | /O(n)/ Concatenate a list of ByteStrings. concat :: [ByteString] -> ByteString concat lpss = LPS (L.concatMap (\(LPS xs) -> xs) lpss) -- | Map a function over a 'ByteString' and concatenate the results concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString concatMap f (LPS lps) = LPS (filterMap (P.concatMap k) lps) where k w = case f w of LPS xs -> P.concat xs -- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if -- any element of the 'ByteString' satisfies the predicate. any :: (Word8 -> Bool) -> ByteString -> Bool any f (LPS xs) = L.or (L.map (P.any f) xs) -- todo fuse -- | /O(n)/ Applied to a predicate and a 'ByteString', 'all' determines -- if all elements of the 'ByteString' satisfy the predicate. all :: (Word8 -> Bool) -> ByteString -> Bool all f (LPS xs) = L.and (L.map (P.all f) xs) -- todo fuse -- | /O(n)/ 'maximum' returns the maximum value from a 'ByteString' maximum :: ByteString -> Word8 maximum (LPS []) = errorEmptyList "maximum" maximum (LPS (x:xs)) = L.foldl' (\n ps -> n `max` P.maximum ps) (P.maximum x) xs {-# INLINE maximum #-} -- | /O(n)/ 'minimum' returns the minimum value from a 'ByteString' minimum :: ByteString -> Word8 minimum (LPS []) = errorEmptyList "minimum" minimum (LPS (x:xs)) = L.foldl' (\n ps -> n `min` P.minimum ps) (P.minimum x) xs {-# INLINE minimum #-} -- | The 'mapAccumL' function behaves like a combination of 'map' and -- 'foldl'; it applies a function to each element of a ByteString, -- passing an accumulating parameter from left to right, and returning a -- final value of this accumulator together with the new ByteString. mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) mapAccumL f z = (\(a :*: ps) -> (a, LPS ps)) . loopL (P.mapAccumEFL f) z . unLPS -- | /O(n)/ map Word8 functions, provided with the index at each position mapIndexed :: (Int -> Word8 -> Word8) -> ByteString -> ByteString mapIndexed f = LPS . P.loopArr . loopL (P.mapIndexEFL f) 0 . unLPS -- --------------------------------------------------------------------- -- Building ByteStrings -- | 'scanl' is similar to 'foldl', but returns a list of successive -- reduced values from the left. This function will fuse. -- -- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] -- -- Note that -- -- > last (scanl f z xs) == foldl f z xs. scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString scanl f z ps = LPS . P.loopArr . loopL (P.scanEFL f) z . unLPS $ (ps `snoc` 0) {-# INLINE scanl #-} -- --------------------------------------------------------------------- -- Unfolds and replicates -- | @'iterate' f x@ returns an infinite ByteString of repeated applications -- of @f@ to @x@: -- -- > iterate f x == [x, f x, f (f x), ...] -- iterate :: (Word8 -> Word8) -> Word8 -> ByteString iterate f = unfoldr (\x -> case f x of x' -> x' `seq` Just (x', x')) -- | @'repeat' x@ is an infinite ByteString, with @x@ the value of every -- element. -- repeat :: Word8 -> ByteString repeat c = LPS (L.repeat block) where block = P.replicate smallChunkSize c -- | /O(n)/ @'replicate' n x@ is a ByteString of length @n@ with @x@ -- the value of every element. -- replicate :: Int64 -> Word8 -> ByteString replicate w c | w <= 0 = empty | w < fromIntegral smallChunkSize = LPS [P.replicate (fromIntegral w) c] | r == 0 = LPS (L.genericReplicate q s) -- preserve invariant | otherwise = LPS (P.unsafeTake (fromIntegral r) s : L.genericReplicate q s) where s = P.replicate smallChunkSize c (q, r) = quotRem w (fromIntegral smallChunkSize) -- | 'cycle' ties a finite ByteString into a circular one, or equivalently, -- the infinite repetition of the original ByteString. -- cycle :: ByteString -> ByteString cycle (LPS []) = errorEmptyList "cycle" cycle (LPS xs) = LPS (L.cycle xs) -- | /O(n)/ The 'unfoldr' function is analogous to the List \'unfoldr\'. -- 'unfoldr' builds a ByteString from a seed value. The function takes -- the element and returns 'Nothing' if it is done producing the -- ByteString or returns 'Just' @(a,b)@, in which case, @a@ is a -- prepending to the ByteString and @b@ is used as the next element in a -- recursive call. unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString unfoldr f = LPS . unfoldChunk 32 where unfoldChunk n x = case P.unfoldrN n f x of (s, Nothing) | P.null s -> [] | otherwise -> s : [] (s, Just x') -> s : unfoldChunk ((n*2) `min` smallChunkSize) x' -- --------------------------------------------------------------------- -- Substrings -- | /O(n\/c)/ 'take' @n@, applied to a ByteString @xs@, returns the prefix -- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@. take :: Int64 -> ByteString -> ByteString take n _ | n < 0 = empty take i (LPS ps) = LPS (take' i ps) where take' _ [] = [] take' 0 _ = [] take' n (x:xs) = if n < fromIntegral (P.length x) then P.take (fromIntegral n) x : [] else x : take' (n - fromIntegral (P.length x)) xs -- | /O(n\/c)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@ -- elements, or @[]@ if @n > 'length' xs@. drop :: Int64 -> ByteString -> ByteString drop i p | i <= 0 = p drop i (LPS ps) = LPS (drop' i ps) where drop' _ [] = [] drop' 0 xs = xs drop' n (x:xs) = if n < fromIntegral (P.length x) then P.drop (fromIntegral n) x : xs else drop' (n - fromIntegral (P.length x)) xs -- | /O(n\/c)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. splitAt :: Int64 -> ByteString -> (ByteString, ByteString) splitAt i p | i <= 0 = (empty, p) splitAt i (LPS ps) = case splitAt' i ps of (a,b) -> (LPS a, LPS b) where splitAt' _ [] = ([], []) splitAt' 0 xs = ([], xs) splitAt' n (x:xs) = if n < fromIntegral (P.length x) then (P.take (fromIntegral n) x : [], P.drop (fromIntegral n) x : xs) else let (xs', xs'') = splitAt' (n - fromIntegral (P.length x)) xs in (x:xs', xs'') -- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@, -- returns the longest prefix (possibly empty) of @xs@ of elements that -- satisfy @p@. takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString takeWhile f (LPS ps) = LPS (takeWhile' ps) where takeWhile' [] = [] takeWhile' (x:xs) = case findIndexOrEnd (not . f) x of 0 -> [] n | n < P.length x -> P.take n x : [] | otherwise -> x : takeWhile' xs -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString dropWhile f (LPS ps) = LPS (dropWhile' ps) where dropWhile' [] = [] dropWhile' (x:xs) = case findIndexOrEnd (not . f) x of n | n < P.length x -> P.drop n x : xs | otherwise -> dropWhile' xs -- | 'break' @p@ is equivalent to @'span' ('not' . p)@. break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) break f (LPS ps) = case (break' ps) of (a,b) -> (LPS a, LPS b) where break' [] = ([], []) break' (x:xs) = case findIndexOrEnd f x of 0 -> ([], x : xs) n | n < P.length x -> (P.take n x : [], P.drop n x : xs) | otherwise -> let (xs', xs'') = break' xs in (x : xs', xs'') -- -- TODO -- -- Add rules -- {- -- | 'breakByte' breaks its ByteString argument at the first occurence -- of the specified byte. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. -- -- > break (=='c') "abcd" == breakByte 'c' "abcd" -- breakByte :: Word8 -> ByteString -> (ByteString, ByteString) breakByte c (LPS ps) = case (breakByte' ps) of (a,b) -> (LPS a, LPS b) where breakByte' [] = ([], []) breakByte' (x:xs) = case P.elemIndex c x of Just 0 -> ([], x : xs) Just n -> (P.take n x : [], P.drop n x : xs) Nothing -> let (xs', xs'') = breakByte' xs in (x : xs', xs'') -- | 'spanByte' breaks its ByteString argument at the first -- occurence of a byte other than its argument. It is more efficient -- than 'span (==)' -- -- > span (=='c') "abcd" == spanByte 'c' "abcd" -- spanByte :: Word8 -> ByteString -> (ByteString, ByteString) spanByte c (LPS ps) = case (spanByte' ps) of (a,b) -> (LPS a, LPS b) where spanByte' [] = ([], []) spanByte' (x:xs) = case P.spanByte c x of (x', x'') | P.null x' -> ([], x : xs) | P.null x'' -> let (xs', xs'') = spanByte' xs in (x : xs', xs'') | otherwise -> (x' : [], x'' : xs) -} -- | 'span' @p xs@ breaks the ByteString into two segments. It is -- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) span p = break (not . p) -- | /O(n)/ Splits a 'ByteString' into components delimited by -- separators, where the predicate returns True for a separator element. -- The resulting components do not contain the separators. Two adjacent -- separators result in an empty component in the output. eg. -- -- > splitWith (=='a') "aabbaca" == ["","","bb","c",""] -- > splitWith (=='a') [] == [] -- splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString] splitWith _ (LPS []) = [] splitWith p (LPS (a:as)) = comb [] (P.splitWith p a) as where comb :: [P.ByteString] -> [P.ByteString] -> [P.ByteString] -> [ByteString] comb acc (s:[]) [] = LPS (L.reverse (cons' s acc)) : [] comb acc (s:[]) (x:xs) = comb (cons' s acc) (P.splitWith p x) xs comb acc (s:ss) xs = LPS (L.reverse (cons' s acc)) : comb [] ss xs cons' x xs | P.null x = xs | otherwise = x:xs {-# INLINE cons' #-} {-# INLINE splitWith #-} -- | /O(n)/ Break a 'ByteString' into pieces separated by the byte -- argument, consuming the delimiter. I.e. -- -- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"] -- > split 'a' "aXaXaXa" == ["","X","X","X"] -- > split 'x' "x" == ["",""] -- -- and -- -- > join [c] . split c == id -- > split == splitWith . (==) -- -- As for all splitting functions in this library, this function does -- not copy the substrings, it just constructs new 'ByteStrings' that -- are slices of the original. -- split :: Word8 -> ByteString -> [ByteString] split _ (LPS []) = [] split c (LPS (a:as)) = comb [] (P.split c a) as where comb :: [P.ByteString] -> [P.ByteString] -> [P.ByteString] -> [ByteString] comb acc (s:[]) [] = LPS (L.reverse (cons' s acc)) : [] comb acc (s:[]) (x:xs) = comb (cons' s acc) (P.split c x) xs comb acc (s:ss) xs = LPS (L.reverse (cons' s acc)) : comb [] ss xs cons' x xs | P.null x = xs | otherwise = x:xs {-# INLINE cons' #-} {-# INLINE split #-} {- -- | Like 'splitWith', except that sequences of adjacent separators are -- treated as a single separator. eg. -- -- > tokens (=='a') "aabbaca" == ["bb","c"] -- tokens :: (Word8 -> Bool) -> ByteString -> [ByteString] tokens f = L.filter (not.null) . splitWith f -} -- | The 'group' function takes a ByteString and returns a list of -- ByteStrings such that the concatenation of the result is equal to the -- argument. Moreover, each sublist in the result contains only equal -- elements. For example, -- -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] -- -- It is a special case of 'groupBy', which allows the programmer to -- supply their own equality test. group :: ByteString -> [ByteString] group (LPS []) = [] group (LPS (a:as)) = group' [] (P.group a) as where group' :: [P.ByteString] -> [P.ByteString] -> [P.ByteString] -> [ByteString] group' acc@(s':_) ss@(s:_) xs | P.unsafeHead s' /= P.unsafeHead s = LPS (L.reverse acc) : group' [] ss xs group' acc (s:[]) [] = LPS (L.reverse (s : acc)) : [] group' acc (s:[]) (x:xs) = group' (s:acc) (P.group x) xs group' acc (s:ss) xs = LPS (L.reverse (s : acc)) : group' [] ss xs {- TODO: check if something like this might be faster group :: ByteString -> [ByteString] group xs | null xs = [] | otherwise = ys : group zs where (ys, zs) = spanByte (unsafeHead xs) xs -} -- | The 'groupBy' function is the non-overloaded version of 'group'. -- groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString] groupBy = error "Data.ByteString.Lazy.groupBy: unimplemented" {- groupBy _ (LPS []) = [] groupBy k (LPS (a:as)) = groupBy' [] 0 (P.groupBy k a) as where groupBy' :: [P.ByteString] -> Word8 -> [P.ByteString] -> [P.ByteString] -> [ByteString] groupBy' acc@(_:_) c ss@(s:_) xs | not (c `k` P.unsafeHead s) = LPS (L.reverse acc) : groupBy' [] 0 ss xs groupBy' acc _ (s:[]) [] = LPS (L.reverse (s : acc)) : [] groupBy' [] _ (s:[]) (x:xs) = groupBy' (s:[]) (P.unsafeHead s) (P.groupBy k x) xs groupBy' acc c (s:[]) (x:xs) = groupBy' (s:acc) c (P.groupBy k x) xs groupBy' acc _ (s:ss) xs = LPS (L.reverse (s : acc)) : groupBy' [] 0 ss xs -} {- TODO: check if something like this might be faster groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString] groupBy k xs | null xs = [] | otherwise = take n xs : groupBy k (drop n xs) where n = 1 + findIndexOrEnd (not . k (head xs)) (tail xs) -} -- | /O(n)/ The 'join' function takes a 'ByteString' and a list of -- 'ByteString's and concatenates the list after interspersing the first -- argument between each element of the list. join :: ByteString -> [ByteString] -> ByteString join s = concat . (L.intersperse s) -- --------------------------------------------------------------------- -- Indexing ByteStrings -- | /O(c)/ 'ByteString' index (subscript) operator, starting from 0. index :: ByteString -> Int64 -> Word8 index _ i | i < 0 = moduleError "index" ("negative index: " ++ show i) index (LPS ps) i = index' ps i where index' [] n = moduleError "index" ("index too large: " ++ show n) index' (x:xs) n | n >= fromIntegral (P.length x) = index' xs (n - fromIntegral (P.length x)) | otherwise = P.unsafeIndex x (fromIntegral n) -- | /O(n)/ The 'elemIndex' function returns the index of the first -- element in the given 'ByteString' which is equal to the query -- element, or 'Nothing' if there is no such element. -- This implementation uses memchr(3). elemIndex :: Word8 -> ByteString -> Maybe Int64 elemIndex c (LPS ps) = elemIndex' 0 ps where elemIndex' _ [] = Nothing elemIndex' n (x:xs) = case P.elemIndex c x of Nothing -> elemIndex' (n + fromIntegral (P.length x)) xs Just i -> Just (n + fromIntegral i) {- -- | /O(n)/ The 'elemIndexEnd' function returns the last index of the -- element in the given 'ByteString' which is equal to the query -- element, or 'Nothing' if there is no such element. The following -- holds: -- -- > elemIndexEnd c xs == -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs) -- elemIndexEnd :: Word8 -> ByteString -> Maybe Int elemIndexEnd ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> go (p `plusPtr` s) (l-1) where STRICT2(go) go p i | i < 0 = return Nothing | otherwise = do ch' <- peekByteOff p i if ch == ch' then return $ Just i else go p (i-1) -} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. -- This implementation uses memchr(3). elemIndices :: Word8 -> ByteString -> [Int64] elemIndices c (LPS ps) = elemIndices' 0 ps where elemIndices' _ [] = [] elemIndices' n (x:xs) = L.map ((+n).fromIntegral) (P.elemIndices c x) ++ elemIndices' (n + fromIntegral (P.length x)) xs -- | count returns the number of times its argument appears in the ByteString -- -- > count = length . elemIndices -- -- But more efficiently than using length on the intermediate list. count :: Word8 -> ByteString -> Int64 count w (LPS xs) = L.foldl' (\n ps -> n + fromIntegral (P.count w ps)) 0 xs -- | The 'findIndex' function takes a predicate and a 'ByteString' and -- returns the index of the first element in the ByteString -- satisfying the predicate. findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int64 findIndex k (LPS ps) = findIndex' 0 ps where findIndex' _ [] = Nothing findIndex' n (x:xs) = case P.findIndex k x of Nothing -> findIndex' (n + fromIntegral (P.length x)) xs Just i -> Just (n + fromIntegral i) {-# INLINE findIndex #-} -- | /O(n)/ The 'find' function takes a predicate and a ByteString, -- and returns the first element in matching the predicate, or 'Nothing' -- if there is no such element. -- -- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing -- find :: (Word8 -> Bool) -> ByteString -> Maybe Word8 find f (LPS ps) = find' ps where find' [] = Nothing find' (x:xs) = case P.find f x of Nothing -> find' xs Just w -> Just w {-# INLINE find #-} -- | The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (Word8 -> Bool) -> ByteString -> [Int64] findIndices k (LPS ps) = findIndices' 0 ps where findIndices' _ [] = [] findIndices' n (x:xs) = L.map ((+n).fromIntegral) (P.findIndices k x) ++ findIndices' (n + fromIntegral (P.length x)) xs -- --------------------------------------------------------------------- -- Searching ByteStrings -- | /O(n)/ 'elem' is the 'ByteString' membership predicate. elem :: Word8 -> ByteString -> Bool elem c ps = case elemIndex c ps of Nothing -> False ; _ -> True -- | /O(n)/ 'notElem' is the inverse of 'elem' notElem :: Word8 -> ByteString -> Bool notElem c ps = not (elem c ps) -- | /O(n)/ 'filter', applied to a predicate and a ByteString, -- returns a ByteString containing those characters that satisfy the -- predicate. filter :: (Word8 -> Bool) -> ByteString -> ByteString --filter f (LPS xs) = LPS (filterMap (P.filter' f) xs) filter p = LPS . P.loopArr . loopL (P.filterEFL p) P.NoAcc . unLPS {-# INLINE filter #-} {- -- | /O(n)/ and /O(n\/c) space/ A first order equivalent of /filter . -- (==)/, for the common case of filtering a single byte. It is more -- efficient to use /filterByte/ in this case. -- -- > filterByte == filter . (==) -- -- filterByte is around 10x faster, and uses much less space, than its -- filter equivalent filterByte :: Word8 -> ByteString -> ByteString filterByte w ps = replicate (count w ps) w -- filterByte w (LPS xs) = LPS (filterMap (P.filterByte w) xs) -- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common -- case of filtering a single byte out of a list. It is more efficient -- to use /filterNotByte/ in this case. -- -- > filterNotByte == filter . (/=) -- -- filterNotByte is around 2x faster than its filter equivalent. filterNotByte :: Word8 -> ByteString -> ByteString filterNotByte w (LPS xs) = LPS (filterMap (P.filterNotByte w) xs) -} -- --------------------------------------------------------------------- -- Searching for substrings -- | /O(n)/ The 'isPrefixOf' function takes two ByteStrings and returns 'True' -- iff the first is a prefix of the second. isPrefixOf :: ByteString -> ByteString -> Bool isPrefixOf (LPS as) (LPS bs) = isPrefixL as bs where isPrefixL [] _ = True isPrefixL _ [] = False isPrefixL (x:xs) (y:ys) | P.length x == P.length y = x == y && isPrefixL xs ys | P.length x < P.length y = x == yh && isPrefixL xs (yt:ys) | otherwise = xh == y && isPrefixL (xt:xs) ys where (xh,xt) = P.splitAt (P.length y) x (yh,yt) = P.splitAt (P.length x) y -- | /O(n)/ The 'isSuffixOf' function takes two ByteStrings and returns 'True' -- iff the first is a suffix of the second. -- -- The following holds: -- -- > isSuffixOf x y == reverse x `isPrefixOf` reverse y -- -- However, the real implemenation uses memcmp to compare the end of the -- string only, with no reverse required.. -- --isSuffixOf :: ByteString -> ByteString -> Bool --isSuffixOf = error "not yet implemented" -- --------------------------------------------------------------------- -- Zipping -- | /O(n)/ 'zip' takes two ByteStrings and returns a list of -- corresponding pairs of bytes. If one input ByteString is short, -- excess elements of the longer ByteString are discarded. This is -- equivalent to a pair of 'unpack' operations. zip :: ByteString -> ByteString -> [(Word8,Word8)] zip = zipWith (,) -- | 'zipWith' generalises 'zip' by zipping with the function given as -- the first argument, instead of a tupling function. For example, -- @'zipWith' (+)@ is applied to two ByteStrings to produce the list of -- corresponding sums. zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a] zipWith _ (LPS []) (LPS _) = [] zipWith _ (LPS _) (LPS []) = [] zipWith f (LPS (a:as)) (LPS (b:bs)) = zipWith' a as b bs where zipWith' x xs y ys = (f (P.unsafeHead x) (P.unsafeHead y) : zipWith'' (P.unsafeTail x) xs (P.unsafeTail y) ys) zipWith'' x [] _ _ | P.null x = [] zipWith'' _ _ y [] | P.null y = [] zipWith'' x xs y ys | not (P.null x) && not (P.null y) = zipWith' x xs y ys zipWith'' x xs _ (y':ys) | not (P.null x) = zipWith' x xs y' ys zipWith'' _ (x':xs) y ys | not (P.null y) = zipWith' x' xs y ys zipWith'' _ (x':xs) _ (y':ys) = zipWith' x' xs y' ys -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of -- ByteStrings. Note that this performs two 'pack' operations. {- unzip :: [(Word8,Word8)] -> (ByteString,ByteString) unzip _ls = error "not yet implemented" {-# INLINE unzip #-} -} -- --------------------------------------------------------------------- -- Special lists -- | /O(n)/ Return all initial segments of the given 'ByteString', shortest first. inits :: ByteString -> [ByteString] inits = (LPS [] :) . inits' . unLPS where inits' [] = [] inits' (x:xs) = L.map (\x' -> LPS [x']) (L.tail (P.inits x)) ++ L.map (\(LPS xs') -> LPS (x:xs')) (inits' xs) -- | /O(n)/ Return all final segments of the given 'ByteString', longest first. tails :: ByteString -> [ByteString] tails = tails' . unLPS where tails' [] = LPS [] : [] tails' xs@(x:xs') | P.length x == 1 = LPS xs : tails' xs' | otherwise = LPS xs : tails' (P.unsafeTail x : xs') -- --------------------------------------------------------------------- -- Low level constructors -- | /O(n)/ Make a copy of the 'ByteString' with its own storage. -- This is mainly useful to allow the rest of the data pointed -- to by the 'ByteString' to be garbage collected, for example -- if a large string has been read in, and only a small part of it -- is needed in the rest of the program. copy :: ByteString -> ByteString copy (LPS lps) = LPS (L.map P.copy lps) --TODO, we could coalese small blocks here --FIXME: probably not strict enough, if we're doing this to avoid retaining -- the parent blocks then we'd better copy strictly. -- --------------------------------------------------------------------- -- TODO defrag func that concatenates block together that are below a threshold -- defrag :: Int -> ByteString -> ByteString -- --------------------------------------------------------------------- -- Lazy ByteString IO -- | Read entire handle contents /lazily/ into a 'ByteString'. Chunks -- are read on demand, in at most @k@-sized chunks. It does not block -- waiting for a whole @k@-sized chunk, so if less than @k@ bytes are -- available then they will be returned immediately as a smaller chunk. hGetContentsN :: Int -> Handle -> IO ByteString hGetContentsN k h = lazyRead >>= return . LPS where lazyRead = unsafeInterleaveIO loop loop = do ps <- P.hGetNonBlocking h k --TODO: I think this should distinguish EOF from no data available -- the otherlying POSIX call makes this distincion, returning either -- 0 or EAGAIN if P.null ps then do eof <- hIsEOF h if eof then return [] else hWaitForInput h (-1) >> loop else do pss <- lazyRead return (ps : pss) -- | Read @n@ bytes into a 'ByteString', directly from the -- specified 'Handle', in chunks of size @k@. hGetN :: Int -> Handle -> Int -> IO ByteString hGetN _ _ 0 = return empty hGetN k h n = readChunks n >>= return . LPS where STRICT1(readChunks) readChunks i = do ps <- P.hGet h (min k i) case P.length ps of 0 -> return [] m -> do pss <- readChunks (i - m) return (ps : pss) -- | hGetNonBlockingN is similar to 'hGetContentsN', except that it will never block -- waiting for data to become available, instead it returns only whatever data -- is available. Chunks are read on demand, in @k@-sized chunks. hGetNonBlockingN :: Int -> Handle -> Int -> IO ByteString #if defined(__GLASGOW_HASKELL__) hGetNonBlockingN _ _ 0 = return empty hGetNonBlockingN k h n = readChunks n >>= return . LPS where STRICT1(readChunks) readChunks i = do ps <- P.hGetNonBlocking h (min k i) case P.length ps of 0 -> return [] m -> do pss <- readChunks (i - m) return (ps : pss) #else hGetNonBlockingN = hGetN #endif -- | Read entire handle contents /lazily/ into a 'ByteString'. Chunks -- are read on demand, using the default chunk size. hGetContents :: Handle -> IO ByteString hGetContents = hGetContentsN defaultChunkSize -- | Read @n@ bytes into a 'ByteString', directly from the specified 'Handle'. hGet :: Handle -> Int -> IO ByteString hGet = hGetN defaultChunkSize -- | hGetNonBlocking is similar to 'hGet', except that it will never block -- waiting for data to become available, instead it returns only whatever data -- is available. #if defined(__GLASGOW_HASKELL__) hGetNonBlocking :: Handle -> Int -> IO ByteString hGetNonBlocking = hGetNonBlockingN defaultChunkSize #else hGetNonBlocking = hGet #endif -- | Read an entire file /lazily/ into a 'ByteString'. readFile :: FilePath -> IO ByteString readFile f = openBinaryFile f ReadMode >>= hGetContents -- | Write a 'ByteString' to a file. writeFile :: FilePath -> ByteString -> IO () writeFile f txt = bracket (openBinaryFile f WriteMode) hClose (\hdl -> hPut hdl txt) -- | Append a 'ByteString' to a file. appendFile :: FilePath -> ByteString -> IO () appendFile f txt = bracket (openBinaryFile f AppendMode) hClose (\hdl -> hPut hdl txt) -- | getContents. Equivalent to hGetContents stdin. Will read /lazily/ getContents :: IO ByteString getContents = hGetContents stdin -- | Outputs a 'ByteString' to the specified 'Handle'. hPut :: Handle -> ByteString -> IO () hPut h (LPS xs) = mapM_ (P.hPut h) xs -- | Write a ByteString to stdout putStr :: ByteString -> IO () putStr = hPut stdout -- | Write a ByteString to stdout, appending a newline byte putStrLn :: ByteString -> IO () putStrLn ps = hPut stdout ps >> hPut stdout (singleton 0x0a) -- | The interact function takes a function of type @ByteString -> ByteString@ -- as its argument. The entire input from the standard input device is passed -- to this function as its argument, and the resulting string is output on the -- standard output device. It's great for writing one line programs! interact :: (ByteString -> ByteString) -> IO () interact transformer = putStr . transformer =<< getContents -- --------------------------------------------------------------------- -- Internal utilities -- Common up near identical calls to `error' to reduce the number -- constant strings created when compiled: errorEmptyList :: String -> a errorEmptyList fun = moduleError fun "empty ByteString" moduleError :: String -> String -> a moduleError fun msg = error ("Data.ByteString.Lazy." ++ fun ++ ':':' ':msg) -- A manually fused version of "filter (not.null) . map f", since they -- don't seem to fuse themselves. Really helps out filter*, concatMap. -- -- TODO fuse. -- filterMap :: (P.ByteString -> P.ByteString) -> [P.ByteString] -> [P.ByteString] filterMap _ [] = [] filterMap f (x:xs) = case f x of y | P.null y -> filterMap f xs -- manually fuse the invariant filter | otherwise -> y : filterMap f xs {-# INLINE filterMap #-} -- | 'findIndexOrEnd' is a variant of findIndex, that returns the length -- of the string if no element is found, rather than Nothing. findIndexOrEnd :: (Word8 -> Bool) -> P.ByteString -> Int findIndexOrEnd k (P.PS x s l) = P.inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0 where STRICT2(go) go ptr n | n >= l = return l | otherwise = do w <- peek ptr if k w then return n else go (ptr `plusPtr` 1) (n+1) {-# INLINE findIndexOrEnd #-} hugs98-plus-Sep2006/packages/base/Data/Fixed.hs0000644006511100651110000001131510504340222017710 0ustar rossross{-# OPTIONS -Wall -Werror -fno-warn-unused-binds #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Fixed -- Copyright : (c) Ashley Yakeley 2005, 2006 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Ashley Yakeley -- Stability : experimental -- Portability : portable -- -- This module defines a "Fixed" type for fixed-precision arithmetic. -- The parameter to Fixed is any type that's an instance of HasResolution. -- HasResolution has a single method that gives the resolution of the Fixed type. -- Parameter types E6 and E12 (for 10^6 and 10^12) are defined, as well as -- type synonyms for Fixed E6 and Fixed E12. -- -- This module also contains generalisations of div, mod, and divmod to work -- with any Real instance. -- ----------------------------------------------------------------------------- module Data.Fixed ( div',mod',divMod', Fixed,HasResolution(..), showFixed, E6,Micro, E12,Pico ) where import Prelude -- necessary to get dependencies right -- | generalisation of 'div' to any instance of Real div' :: (Real a,Integral b) => a -> a -> b div' n d = floor ((toRational n) / (toRational d)) -- | generalisation of 'divMod' to any instance of Real divMod' :: (Real a,Integral b) => a -> a -> (b,a) divMod' n d = (f,n - (fromIntegral f) * d) where f = div' n d -- | generalisation of 'mod' to any instance of Real mod' :: (Real a) => a -> a -> a mod' n d = n - (fromInteger f) * d where f = div' n d newtype Fixed a = MkFixed Integer deriving (Eq,Ord) class HasResolution a where resolution :: a -> Integer fixedResolution :: (HasResolution a) => Fixed a -> Integer fixedResolution fa = resolution (uf fa) where uf :: Fixed a -> a uf _ = undefined withType :: (a -> f a) -> f a withType foo = foo undefined withResolution :: (HasResolution a) => (Integer -> f a) -> f a withResolution foo = withType (foo . resolution) instance Enum (Fixed a) where succ (MkFixed a) = MkFixed (succ a) pred (MkFixed a) = MkFixed (pred a) toEnum = MkFixed . toEnum fromEnum (MkFixed a) = fromEnum a enumFrom (MkFixed a) = fmap MkFixed (enumFrom a) enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b) enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b) enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c) instance (HasResolution a) => Num (Fixed a) where (MkFixed a) + (MkFixed b) = MkFixed (a + b) (MkFixed a) - (MkFixed b) = MkFixed (a - b) fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (fixedResolution fa)) negate (MkFixed a) = MkFixed (negate a) abs (MkFixed a) = MkFixed (abs a) signum (MkFixed a) = fromInteger (signum a) fromInteger i = withResolution (\res -> MkFixed (i * res)) instance (HasResolution a) => Real (Fixed a) where toRational fa@(MkFixed a) = (toRational a) / (toRational (fixedResolution fa)) instance (HasResolution a) => Fractional (Fixed a) where fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (fixedResolution fa)) b) recip fa@(MkFixed a) = MkFixed (div (res * res) a) where res = fixedResolution fa fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res)))) instance (HasResolution a) => RealFrac (Fixed a) where properFraction a = (i,a - (fromIntegral i)) where i = truncate a truncate f = truncate (toRational f) round f = round (toRational f) ceiling f = ceiling (toRational f) floor f = floor (toRational f) chopZeros :: Integer -> String chopZeros 0 = "" chopZeros a | mod a 10 == 0 = chopZeros (div a 10) chopZeros a = show a -- only works for positive a showIntegerZeros :: Bool -> Int -> Integer -> String showIntegerZeros True _ 0 = "" showIntegerZeros chopTrailingZeros digits a = replicate (digits - length s) '0' ++ s' where s = show a s' = if chopTrailingZeros then chopZeros a else s withDot :: String -> String withDot "" = "" withDot s = '.':s -- | First arg is whether to chop off trailing zeros showFixed :: (HasResolution a) => Bool -> Fixed a -> String showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa)) showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where res = fixedResolution fa (i,d) = divMod a res -- enough digits to be unambiguous digits = ceiling (logBase 10 (fromInteger res) :: Double) maxnum = 10 ^ digits fracNum = div (d * maxnum) res instance (HasResolution a) => Show (Fixed a) where show = showFixed False data E6 = E6 instance HasResolution E6 where resolution _ = 1000000 type Micro = Fixed E6 data E12 = E12 instance HasResolution E12 where resolution _ = 1000000000000 type Pico = Fixed E12 hugs98-plus-Sep2006/packages/base/Data/ByteString.hs0000644006511100651110000022405110504340226020752 0ustar rossross{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-} -- -- Module : ByteString -- Copyright : (c) The University of Glasgow 2001, -- (c) David Roundy 2003-2005, -- (c) Simon Marlow 2005 -- (c) Don Stewart 2005-2006 -- (c) Bjorn Bringert 2006 -- -- Array fusion code: -- (c) 2001,2002 Manuel M T Chakravarty & Gabriele Keller -- (c) 2006 Manuel M T Chakravarty & Roman Leshchinskiy -- -- License : BSD-style -- -- Maintainer : dons@cse.unsw.edu.au -- Stability : experimental -- Portability : portable, requires ffi and cpp -- Tested with : GHC 6.4.1 and Hugs March 2005 -- -- -- | A time and space-efficient implementation of byte vectors using -- packed Word8 arrays, suitable for high performance use, both in terms -- of large data quantities, or high speed requirements. Byte vectors -- are encoded as strict 'Word8' arrays of bytes, held in a 'ForeignPtr', -- and can be passed between C and Haskell with little effort. -- -- This module is intended to be imported @qualified@, to avoid name -- clashes with "Prelude" functions. eg. -- -- > import qualified Data.ByteString as B -- -- Original GHC implementation by Bryan O\'Sullivan. Rewritten to use -- UArray by Simon Marlow. Rewritten to support slices and use -- ForeignPtr by David Roundy. Polished and extended by Don Stewart. -- module Data.ByteString ( -- * The @ByteString@ type ByteString, -- abstract, instances: Eq, Ord, Show, Read, Data, Typeable, Monoid -- * Introducing and eliminating 'ByteString's empty, -- :: ByteString singleton, -- :: Word8 -> ByteString pack, -- :: [Word8] -> ByteString unpack, -- :: ByteString -> [Word8] -- * Basic interface cons, -- :: Word8 -> ByteString -> ByteString snoc, -- :: ByteString -> Word8 -> ByteString append, -- :: ByteString -> ByteString -> ByteString head, -- :: ByteString -> Word8 last, -- :: ByteString -> Word8 tail, -- :: ByteString -> ByteString init, -- :: ByteString -> ByteString null, -- :: ByteString -> Bool length, -- :: ByteString -> Int -- * Transformating ByteStrings map, -- :: (Word8 -> Word8) -> ByteString -> ByteString reverse, -- :: ByteString -> ByteString intersperse, -- :: Word8 -> ByteString -> ByteString transpose, -- :: [ByteString] -> [ByteString] -- * Reducing 'ByteString's (folds) foldl, -- :: (a -> Word8 -> a) -> a -> ByteString -> a foldl', -- :: (a -> Word8 -> a) -> a -> ByteString -> a foldl1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1', -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldr, -- :: (Word8 -> a -> a) -> a -> ByteString -> a foldr', -- :: (Word8 -> a -> a) -> a -> ByteString -> a foldr1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldr1', -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 -- ** Special folds concat, -- :: [ByteString] -> ByteString concatMap, -- :: (Word8 -> ByteString) -> ByteString -> ByteString any, -- :: (Word8 -> Bool) -> ByteString -> Bool all, -- :: (Word8 -> Bool) -> ByteString -> Bool maximum, -- :: ByteString -> Word8 minimum, -- :: ByteString -> Word8 -- * Building ByteStrings -- ** Scans scanl, -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString scanl1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString scanr, -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString scanr1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -- ** Accumulating maps mapAccumL, -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) mapAccumR, -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) mapIndexed, -- :: (Int -> Word8 -> Word8) -> ByteString -> ByteString -- ** Unfolding ByteStrings replicate, -- :: Int -> Word8 -> ByteString unfoldr, -- :: (a -> Maybe (Word8, a)) -> a -> ByteString unfoldrN, -- :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a) -- * Substrings -- ** Breaking strings take, -- :: Int -> ByteString -> ByteString drop, -- :: Int -> ByteString -> ByteString splitAt, -- :: Int -> ByteString -> (ByteString, ByteString) takeWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString dropWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString span, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) spanEnd, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) break, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) breakEnd, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) group, -- :: ByteString -> [ByteString] groupBy, -- :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString] inits, -- :: ByteString -> [ByteString] tails, -- :: ByteString -> [ByteString] -- ** Breaking into many substrings split, -- :: Word8 -> ByteString -> [ByteString] splitWith, -- :: (Word8 -> Bool) -> ByteString -> [ByteString] -- ** Joining strings join, -- :: ByteString -> [ByteString] -> ByteString -- * Predicates isPrefixOf, -- :: ByteString -> ByteString -> Bool isSuffixOf, -- :: ByteString -> ByteString -> Bool -- ** Search for arbitrary substrings isSubstringOf, -- :: ByteString -> ByteString -> Bool findSubstring, -- :: ByteString -> ByteString -> Maybe Int findSubstrings, -- :: ByteString -> ByteString -> [Int] -- * Searching ByteStrings -- ** Searching by equality -- | These functions use memchr(3) to efficiently search the ByteString elem, -- :: Word8 -> ByteString -> Bool notElem, -- :: Word8 -> ByteString -> Bool -- ** Searching with a predicate find, -- :: (Word8 -> Bool) -> ByteString -> Maybe Word8 filter, -- :: (Word8 -> Bool) -> ByteString -> ByteString -- partition -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) -- * Indexing ByteStrings index, -- :: ByteString -> Int -> Word8 elemIndex, -- :: Word8 -> ByteString -> Maybe Int elemIndices, -- :: Word8 -> ByteString -> [Int] elemIndexEnd, -- :: Word8 -> ByteString -> Maybe Int findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int] count, -- :: Word8 -> ByteString -> Int -- * Zipping and unzipping ByteStrings zip, -- :: ByteString -> ByteString -> [(Word8,Word8)] zipWith, -- :: (Word8 -> Word8 -> c) -> ByteString -> ByteString -> [c] unzip, -- :: [(Word8,Word8)] -> (ByteString,ByteString) -- * Ordered ByteStrings sort, -- :: ByteString -> ByteString -- * Low level CString conversions -- ** Packing CStrings and pointers packCString, -- :: CString -> ByteString packCStringLen, -- :: CString -> ByteString packMallocCString, -- :: CString -> ByteString -- ** Using ByteStrings as CStrings useAsCString, -- :: ByteString -> (CString -> IO a) -> IO a useAsCStringLen, -- :: ByteString -> (CStringLen -> IO a) -> IO a -- ** Copying ByteStrings -- | These functions perform memcpy(3) operations copy, -- :: ByteString -> ByteString copyCString, -- :: CString -> IO ByteString copyCStringLen, -- :: CStringLen -> IO ByteString -- * I\/O with 'ByteString's -- ** Standard input and output getLine, -- :: IO ByteString getContents, -- :: IO ByteString putStr, -- :: ByteString -> IO () putStrLn, -- :: ByteString -> IO () interact, -- :: (ByteString -> ByteString) -> IO () -- ** Files readFile, -- :: FilePath -> IO ByteString writeFile, -- :: FilePath -> ByteString -> IO () appendFile, -- :: FilePath -> ByteString -> IO () -- mmapFile, -- :: FilePath -> IO ByteString -- ** I\/O with Handles hGetLine, -- :: Handle -> IO ByteString hGetContents, -- :: Handle -> IO ByteString hGet, -- :: Handle -> Int -> IO ByteString hGetNonBlocking, -- :: Handle -> Int -> IO ByteString hPut, -- :: Handle -> ByteString -> IO () hPutStr, -- :: Handle -> ByteString -> IO () hPutStrLn, -- :: Handle -> ByteString -> IO () #if defined(__GLASGOW_HASKELL__) -- * Fusion utilities unpackList, -- eek, otherwise it gets thrown away by the simplifier lengthU, maximumU, minimumU #endif ) where import qualified Prelude as P import Prelude hiding (reverse,head,tail,last,init,null ,length,map,lines,foldl,foldr,unlines ,concat,any,take,drop,splitAt,takeWhile ,dropWhile,span,break,elem,filter,maximum ,minimum,all,concatMap,foldl1,foldr1 ,scanl,scanl1,scanr,scanr1 ,readFile,writeFile,appendFile,replicate ,getContents,getLine,putStr,putStrLn,interact ,zip,zipWith,unzip,notElem) import Data.ByteString.Base import Data.ByteString.Fusion import qualified Data.List as List import Data.Word (Word8) import Data.Maybe (listToMaybe) import Data.Array (listArray) import qualified Data.Array as Array ((!)) -- Control.Exception.bracket not available in yhc or nhc import Control.Exception (bracket, assert) import qualified Control.Exception as Exception import Control.Monad (when) import Foreign.C.String (CString, CStringLen) import Foreign.C.Types (CSize) import Foreign.ForeignPtr import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable (Storable(..)) -- hGetBuf and hPutBuf not available in yhc or nhc import System.IO (stdin,stdout,hClose,hFileSize ,hGetBuf,hPutBuf,openBinaryFile ,Handle,IOMode(..)) import Data.Monoid (Monoid, mempty, mappend, mconcat) #if !defined(__GLASGOW_HASKELL__) import System.IO.Unsafe import qualified System.Environment import qualified System.IO (hGetLine) #endif #if defined(__GLASGOW_HASKELL__) import System.IO (hGetBufNonBlocking) import System.IO.Error (isEOFError) import GHC.Handle import GHC.Prim (Word#, (+#), writeWord8OffAddr#) import GHC.Base (build) import GHC.Word hiding (Word8) import GHC.Ptr (Ptr(..)) import GHC.ST (ST(..)) import GHC.IOBase #endif -- ----------------------------------------------------------------------------- -- -- Useful macros, until we have bang patterns -- #define STRICT1(f) f a | a `seq` False = undefined #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined #define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined #define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined -- ----------------------------------------------------------------------------- instance Eq ByteString where (==) = eq instance Ord ByteString where compare = compareBytes instance Monoid ByteString where mempty = empty mappend = append mconcat = concat {- instance Arbitrary PackedString where arbitrary = P.pack `fmap` arbitrary coarbitrary s = coarbitrary (P.unpack s) -} -- | /O(n)/ Equality on the 'ByteString' type. eq :: ByteString -> ByteString -> Bool eq a@(PS p s l) b@(PS p' s' l') | l /= l' = False -- short cut on length | p == p' && s == s' = True -- short cut for the same string | otherwise = compareBytes a b == EQ {-# INLINE eq #-} -- | /O(n)/ 'compareBytes' provides an 'Ordering' for 'ByteStrings' supporting slices. compareBytes :: ByteString -> ByteString -> Ordering compareBytes (PS x1 s1 l1) (PS x2 s2 l2) | l1 == 0 && l2 == 0 = EQ -- short cut for empty strings | x1 == x2 && s1 == s2 && l1 == l2 = EQ -- short cut for the same string | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral $ min l1 l2) return $! case i `compare` 0 of EQ -> l1 `compare` l2 x -> x {-# INLINE compareBytes #-} {- -- -- About 4x slower over 32M -- compareBytes :: ByteString -> ByteString -> Ordering compareBytes (PS fp1 off1 len1) (PS fp2 off2 len2) = inlinePerformIO $ withForeignPtr fp1 $ \p1 -> withForeignPtr fp2 $ \p2 -> cmp (p1 `plusPtr` off1) (p2 `plusPtr` off2) 0 len1 len2 cmp :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> Int-> IO Ordering STRICT5(cmp) cmp p1 p2 n len1 len2 | n == len1 = if n == len2 then return EQ else return LT | n == len2 = return GT | otherwise = do (a :: Word8) <- peekByteOff p1 n (b :: Word8) <- peekByteOff p2 n case a `compare` b of EQ -> cmp p1 p2 (n+1) len1 len2 LT -> return LT GT -> return GT {-# INLINE compareBytes #-} -} -- ----------------------------------------------------------------------------- -- Introducing and eliminating 'ByteString's -- | /O(1)/ Convert a 'Word8' into a 'ByteString' singleton :: Word8 -> ByteString singleton c = unsafeCreate 1 $ \p -> poke p c {-# INLINE [1] singleton #-} -- -- XXX The unsafePerformIO is critical! -- -- Otherwise: -- -- singleton 255 `compare` singleton 127 -- -- is compiled to: -- -- case mallocByteString 2 of -- ForeignPtr f internals -> -- case writeWord8OffAddr# f 0 255 of _ -> -- case writeWord8OffAddr# f 0 127 of _ -> -- case eqAddr# f f of -- False -> case compare (GHC.Prim.plusAddr# f 0) -- (GHC.Prim.plusAddr# f 0) -- -- -- | /O(n)/ Convert a '[Word8]' into a 'ByteString'. -- -- For applications with large numbers of string literals, pack can be a -- bottleneck. In such cases, consider using packAddress (GHC only). pack :: [Word8] -> ByteString #if !defined(__GLASGOW_HASKELL__) pack str = unsafeCreate (P.length str) $ \p -> go p str where go _ [] = return () go p (x:xs) = poke p x >> go (p `plusPtr` 1) xs -- less space than pokeElemOff #else /* hack away */ pack str = unsafeCreate (P.length str) $ \(Ptr p) -> stToIO (go p 0# str) where go _ _ [] = return () go p i (W8# c:cs) = writeByte p i c >> go p (i +# 1#) cs writeByte p i c = ST $ \s# -> case writeWord8OffAddr# p i c s# of s2# -> (# s2#, () #) #endif -- | /O(n)/ Converts a 'ByteString' to a '[Word8]'. unpack :: ByteString -> [Word8] #if !defined(__GLASGOW_HASKELL__) unpack (PS _ _ 0) = [] unpack (PS ps s l) = inlinePerformIO $ withForeignPtr ps $ \p -> go (p `plusPtr` s) (l - 1) [] where STRICT3(go) go p 0 acc = peek p >>= \e -> return (e : acc) go p n acc = peekByteOff p n >>= \e -> go p (n-1) (e : acc) {-# INLINE unpack #-} #else unpack ps = build (unpackFoldr ps) {-# INLINE unpack #-} -- -- critical this isn't strict in the acc -- as it will break in the presence of list fusion. this is a known -- issue with seq and build/foldr rewrite rules, which rely on lazy -- demanding to avoid bottoms in the list. -- unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a unpackFoldr (PS fp off len) f ch = withPtr fp $ \p -> do let loop q n _ | q `seq` n `seq` False = undefined -- n.b. loop _ (-1) acc = return acc loop q n acc = do a <- peekByteOff q n loop q (n-1) (a `f` acc) loop (p `plusPtr` off) (len-1) ch {-# INLINE [0] unpackFoldr #-} unpackList :: ByteString -> [Word8] unpackList (PS fp off len) = withPtr fp $ \p -> do let STRICT3(loop) loop _ (-1) acc = return acc loop q n acc = do a <- peekByteOff q n loop q (n-1) (a : acc) loop (p `plusPtr` off) (len-1) [] {-# RULES "FPS unpack-list" [1] forall p . unpackFoldr p (:) [] = unpackList p #-} #endif -- --------------------------------------------------------------------- -- Basic interface -- | /O(1)/ Test whether a ByteString is empty. null :: ByteString -> Bool null (PS _ _ l) = assert (l >= 0) $ l <= 0 {-# INLINE null #-} -- --------------------------------------------------------------------- -- | /O(1)/ 'length' returns the length of a ByteString as an 'Int'. length :: ByteString -> Int length (PS _ _ l) = assert (l >= 0) $ l -- -- length/loop fusion. When taking the length of any fuseable loop, -- rewrite it as a foldl', and thus avoid allocating the result buffer -- worth around 10% in speed testing. -- #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] length #-} #endif lengthU :: ByteString -> Int lengthU = foldl' (const . (+1)) (0::Int) {-# INLINE lengthU #-} {-# RULES -- v2 fusion "FPS length/loop" forall loop s . length (loopArr (loopWrapper loop s)) = lengthU (loopArr (loopWrapper loop s)) #-} ------------------------------------------------------------------------ -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires a memcpy. cons :: Word8 -> ByteString -> ByteString cons c (PS x s l) = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do poke p c memcpy (p `plusPtr` 1) (f `plusPtr` s) (fromIntegral l) {-# INLINE cons #-} -- | /O(n)/ Append a byte to the end of a 'ByteString' snoc :: ByteString -> Word8 -> ByteString snoc (PS x s l) c = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do memcpy p (f `plusPtr` s) (fromIntegral l) poke (p `plusPtr` l) c {-# INLINE snoc #-} -- todo fuse -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. -- An exception will be thrown in the case of an empty ByteString. head :: ByteString -> Word8 head (PS x s l) | l <= 0 = errorEmptyList "head" | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s {-# INLINE head #-} -- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty. -- An exception will be thrown in the case of an empty ByteString. tail :: ByteString -> ByteString tail (PS p s l) | l <= 0 = errorEmptyList "tail" | otherwise = PS p (s+1) (l-1) {-# INLINE tail #-} -- | /O(1)/ Extract the last element of a ByteString, which must be finite and non-empty. -- An exception will be thrown in the case of an empty ByteString. last :: ByteString -> Word8 last ps@(PS x s l) | null ps = errorEmptyList "last" | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+l-1) {-# INLINE last #-} -- | /O(1)/ Return all the elements of a 'ByteString' except the last one. -- An exception will be thrown in the case of an empty ByteString. init :: ByteString -> ByteString init ps@(PS p s l) | null ps = errorEmptyList "init" | otherwise = PS p s (l-1) {-# INLINE init #-} -- | /O(n)/ Append two ByteStrings append :: ByteString -> ByteString -> ByteString append xs ys | null xs = ys | null ys = xs | otherwise = concat [xs,ys] {-# INLINE append #-} -- --------------------------------------------------------------------- -- Transformations -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each -- element of @xs@. This function is subject to array fusion. map :: (Word8 -> Word8) -> ByteString -> ByteString #if defined(LOOPU_FUSION) map f = loopArr . loopU (mapEFL f) NoAcc #elif defined(LOOPUP_FUSION) map f = loopArr . loopUp (mapEFL f) NoAcc #elif defined(LOOPNOACC_FUSION) map f = loopArr . loopNoAcc (mapEFL f) #else map f = loopArr . loopMap f #endif {-# INLINE map #-} {- -- | /O(n)/ Like 'map', but not fuseable. The benefit is that it is -- slightly faster for one-shot cases. map' :: (Word8 -> Word8) -> ByteString -> ByteString map' f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a -> create len $ map_ 0 (a `plusPtr` s) where map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO () STRICT3(map_) map_ n p1 p2 | n >= len = return () | otherwise = do x <- peekByteOff p1 n pokeByteOff p2 n (f x) map_ (n+1) p1 p2 {-# INLINE map' #-} -} -- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order. reverse :: ByteString -> ByteString reverse (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> c_reverse p (f `plusPtr` s) (fromIntegral l) -- todo, fuseable version -- | /O(n)/ The 'intersperse' function takes a 'Word8' and a -- 'ByteString' and \`intersperses\' that byte between the elements of -- the 'ByteString'. It is analogous to the intersperse function on -- Lists. intersperse :: Word8 -> ByteString -> ByteString intersperse c ps@(PS x s l) | length ps < 2 = ps | otherwise = unsafeCreate (2*l-1) $ \p -> withForeignPtr x $ \f -> c_intersperse p (f `plusPtr` s) (fromIntegral l) c {- intersperse c = pack . List.intersperse c . unpack -} -- | The 'transpose' function transposes the rows and columns of its -- 'ByteString' argument. transpose :: [ByteString] -> [ByteString] transpose ps = P.map pack (List.transpose (P.map unpack ps)) -- --------------------------------------------------------------------- -- Reducing 'ByteString's -- | 'foldl', applied to a binary operator, a starting value (typically -- the left-identity of the operator), and a ByteString, reduces the -- ByteString using the binary operator, from left to right. -- This function is subject to array fusion. foldl :: (a -> Word8 -> a) -> a -> ByteString -> a #if !defined(LOOPU_FUSION) foldl f z = loopAcc . loopUp (foldEFL f) z #else foldl f z = loopAcc . loopU (foldEFL f) z #endif {-# INLINE foldl #-} {- -- -- About twice as fast with 6.4.1, but not fuseable -- A simple fold . map is enough to make it worth while. -- foldl f v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr -> lgo v (ptr `plusPtr` s) (ptr `plusPtr` (s+l)) where STRICT3(lgo) lgo z p q | p == q = return z | otherwise = do c <- peek p lgo (f z c) (p `plusPtr` 1) q -} -- | 'foldl\'' is like 'foldl', but strict in the accumulator. -- Though actually foldl is also strict in the accumulator. foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a foldl' = foldl -- foldl' f z = loopAcc . loopU (foldEFL' f) z {-# INLINE foldl' #-} -- | 'foldr', applied to a binary operator, a starting value -- (typically the right-identity of the operator), and a ByteString, -- reduces the ByteString using the binary operator, from right to left. foldr :: (Word8 -> a -> a) -> a -> ByteString -> a foldr k z = loopAcc . loopDown (foldEFL (flip k)) z {-# INLINE foldr #-} -- | 'foldr\'' is like 'foldr', but strict in the accumulator. foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a foldr' k v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr -> go v (ptr `plusPtr` (s+l-1)) (ptr `plusPtr` (s-1)) where STRICT3(go) go z p q | p == q = return z | otherwise = do c <- peek p go (c `k` z) (p `plusPtr` (-1)) q -- tail recursive {-# INLINE [1] foldr' #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'ByteStrings'. -- This function is subject to array fusion. -- An exception will be thrown in the case of an empty ByteString. foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1 f ps | null ps = errorEmptyList "foldl1" | otherwise = foldl f (unsafeHead ps) (unsafeTail ps) {-# INLINE foldl1 #-} -- | 'foldl1\'' is like 'foldl1', but strict in the accumulator. -- An exception will be thrown in the case of an empty ByteString. foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1' f ps | null ps = errorEmptyList "foldl1'" | otherwise = foldl' f (unsafeHead ps) (unsafeTail ps) {-# INLINE foldl1' #-} -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty 'ByteString's -- An exception will be thrown in the case of an empty ByteString. foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldr1 f ps | null ps = errorEmptyList "foldr1" | otherwise = foldr f (last ps) (init ps) {-# INLINE foldr1 #-} -- | 'foldr1\'' is a variant of 'foldr1', but is strict in the -- accumulator. foldr1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldr1' f ps | null ps = errorEmptyList "foldr1" | otherwise = foldr' f (last ps) (init ps) {-# INLINE [1] foldr1' #-} -- --------------------------------------------------------------------- -- Special folds -- | /O(n)/ Concatenate a list of ByteStrings. concat :: [ByteString] -> ByteString concat [] = empty concat [ps] = ps concat xs = unsafeCreate len $ \ptr -> go xs ptr where len = P.sum . P.map length $ xs STRICT2(go) go [] _ = return () go (PS p s l:ps) ptr = do withForeignPtr p $ \fp -> memcpy ptr (fp `plusPtr` s) (fromIntegral l) go ps (ptr `plusPtr` l) -- | Map a function over a 'ByteString' and concatenate the results concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString concatMap f = concat . foldr ((:) . f) [] -- foldr (append . f) empty -- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if -- any element of the 'ByteString' satisfies the predicate. any :: (Word8 -> Bool) -> ByteString -> Bool any _ (PS _ _ 0) = False any f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr -> go (ptr `plusPtr` s) (ptr `plusPtr` (s+l)) where STRICT2(go) go p q | p == q = return False | otherwise = do c <- peek p if f c then return True else go (p `plusPtr` 1) q -- todo fuse -- | /O(n)/ Applied to a predicate and a 'ByteString', 'all' determines -- if all elements of the 'ByteString' satisfy the predicate. all :: (Word8 -> Bool) -> ByteString -> Bool all _ (PS _ _ 0) = True all f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr -> go (ptr `plusPtr` s) (ptr `plusPtr` (s+l)) where STRICT2(go) go p q | p == q = return True -- end of list | otherwise = do c <- peek p if f c then go (p `plusPtr` 1) q else return False ------------------------------------------------------------------------ -- | /O(n)/ 'maximum' returns the maximum value from a 'ByteString' -- This function will fuse. -- An exception will be thrown in the case of an empty ByteString. maximum :: ByteString -> Word8 maximum xs@(PS x s l) | null xs = errorEmptyList "maximum" | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> c_maximum (p `plusPtr` s) (fromIntegral l) -- | /O(n)/ 'minimum' returns the minimum value from a 'ByteString' -- This function will fuse. -- An exception will be thrown in the case of an empty ByteString. minimum :: ByteString -> Word8 minimum xs@(PS x s l) | null xs = errorEmptyList "minimum" | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> c_minimum (p `plusPtr` s) (fromIntegral l) -- -- minimum/maximum/loop fusion. As for length (and other folds), when we -- see we're applied after a fuseable op, switch from using the C -- version, to the fuseable version. The result should then avoid -- allocating a buffer. -- #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] minimum #-} {-# INLINE [1] maximum #-} #endif maximumU :: ByteString -> Word8 maximumU = foldl1' max {-# INLINE maximumU #-} minimumU :: ByteString -> Word8 minimumU = foldl1' min {-# INLINE minimumU #-} {-# RULES "FPS minimum/loop" forall loop s . minimum (loopArr (loopWrapper loop s)) = minimumU (loopArr (loopWrapper loop s)) "FPS maximum/loop" forall loop s . maximum (loopArr (loopWrapper loop s)) = maximumU (loopArr (loopWrapper loop s)) #-} ------------------------------------------------------------------------ -- | The 'mapAccumL' function behaves like a combination of 'map' and -- 'foldl'; it applies a function to each element of a ByteString, -- passing an accumulating parameter from left to right, and returning a -- final value of this accumulator together with the new list. mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) #if !defined(LOOPU_FUSION) mapAccumL f z = unSP . loopUp (mapAccumEFL f) z #else mapAccumL f z = unSP . loopU (mapAccumEFL f) z #endif {-# INLINE mapAccumL #-} -- | The 'mapAccumR' function behaves like a combination of 'map' and -- 'foldr'; it applies a function to each element of a ByteString, -- passing an accumulating parameter from right to left, and returning a -- final value of this accumulator together with the new ByteString. mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) mapAccumR f z = unSP . loopDown (mapAccumEFL f) z {-# INLINE mapAccumR #-} -- | /O(n)/ map Word8 functions, provided with the index at each position mapIndexed :: (Int -> Word8 -> Word8) -> ByteString -> ByteString mapIndexed f = loopArr . loopUp (mapIndexEFL f) 0 {-# INLINE mapIndexed #-} -- --------------------------------------------------------------------- -- Building ByteStrings -- | 'scanl' is similar to 'foldl', but returns a list of successive -- reduced values from the left. This function will fuse. -- -- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] -- -- Note that -- -- > last (scanl f z xs) == foldl f z xs. scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString #if !defined(LOOPU_FUSION) scanl f z ps = loopArr . loopUp (scanEFL f) z $ (ps `snoc` 0) #else scanl f z ps = loopArr . loopU (scanEFL f) z $ (ps `snoc` 0) #endif -- n.b. haskell's List scan returns a list one bigger than the -- input, so we need to snoc here to get some extra space, however, -- it breaks map/up fusion (i.e. scanl . map no longer fuses) {-# INLINE scanl #-} -- | 'scanl1' is a variant of 'scanl' that has no starting value argument. -- This function will fuse. -- -- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString scanl1 f ps | null ps = empty | otherwise = scanl f (unsafeHead ps) (unsafeTail ps) {-# INLINE scanl1 #-} -- | scanr is the right-to-left dual of scanl. scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString scanr f z ps = loopArr . loopDown (scanEFL (flip f)) z $ (0 `cons` ps) -- extra space {-# INLINE scanr #-} -- | 'scanr1' is a variant of 'scanr' that has no starting value argument. scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString scanr1 f ps | null ps = empty | otherwise = scanr f (last ps) (init ps) -- todo, unsafe versions {-# INLINE scanr1 #-} -- --------------------------------------------------------------------- -- Unfolds and replicates -- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@ -- the value of every element. The following holds: -- -- > replicate w c = unfoldr w (\u -> Just (u,u)) c -- -- This implemenation uses @memset(3)@ replicate :: Int -> Word8 -> ByteString replicate w c | w <= 0 = empty | otherwise = unsafeCreate w $ \ptr -> memset ptr c (fromIntegral w) >> return () -- | /O(n)/, where /n/ is the length of the result. The 'unfoldr' -- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a -- ByteString from a seed value. The function takes the element and -- returns 'Nothing' if it is done producing the ByteString or returns -- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string, -- and @b@ is the seed value for further production. -- -- Examples: -- -- > unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0 -- > == pack [0, 1, 2, 3, 4, 5] -- unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString unfoldr f = concat . unfoldChunk 32 64 where unfoldChunk n n' x = case unfoldrN n f x of (s, Nothing) -> s : [] (s, Just x') -> s : unfoldChunk n' (n+n') x' -- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ByteString from a seed -- value. However, the length of the result is limited by the first -- argument to 'unfoldrN'. This function is more efficient than 'unfoldr' -- when the maximum length of the result is known. -- -- The following equation relates 'unfoldrN' and 'unfoldr': -- -- > unfoldrN n f s == take n (unfoldr f s) -- unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a) unfoldrN i f x0 | i < 0 = (empty, Just x0) | otherwise = unsafePerformIO $ createAndTrim' i $ \p -> go p x0 0 where STRICT3(go) go p x n = case f x of Nothing -> return (0, n, Nothing) Just (w,x') | n == i -> return (0, n, Just x) | otherwise -> do poke p w go (p `plusPtr` 1) x' (n+1) -- --------------------------------------------------------------------- -- Substrings -- | /O(1)/ 'take' @n@, applied to a ByteString @xs@, returns the prefix -- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@. take :: Int -> ByteString -> ByteString take n ps@(PS x s l) | n <= 0 = empty | n >= l = ps | otherwise = PS x s n {-# INLINE take #-} -- | /O(1)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@ -- elements, or @[]@ if @n > 'length' xs@. drop :: Int -> ByteString -> ByteString drop n ps@(PS x s l) | n <= 0 = ps | n >= l = empty | otherwise = PS x (s+n) (l-n) {-# INLINE drop #-} -- | /O(1)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. splitAt :: Int -> ByteString -> (ByteString, ByteString) splitAt n ps@(PS x s l) | n <= 0 = (empty, ps) | n >= l = (ps, empty) | otherwise = (PS x s n, PS x (s+n) (l-n)) {-# INLINE splitAt #-} -- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@, -- returns the longest prefix (possibly empty) of @xs@ of elements that -- satisfy @p@. takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString takeWhile f ps = unsafeTake (findIndexOrEnd (not . f) ps) ps {-# INLINE takeWhile #-} -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString dropWhile f ps = unsafeDrop (findIndexOrEnd (not . f) ps) ps {-# INLINE dropWhile #-} -- | 'break' @p@ is equivalent to @'span' ('not' . p)@. break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) break p ps = case findIndexOrEnd p ps of n -> (unsafeTake n ps, unsafeDrop n ps) {-# INLINE [1] break #-} {-# RULES "FPS specialise break (x==)" forall x. break ((==) x) = breakByte x #-} #if __GLASGOW_HASKELL__ >= 605 {-# RULES "FPS specialise break (==x)" forall x. break (==x) = breakByte x #-} #endif -- | 'breakByte' breaks its ByteString argument at the first occurence -- of the specified byte. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. -- -- > break (=='c') "abcd" == breakByte 'c' "abcd" -- breakByte :: Word8 -> ByteString -> (ByteString, ByteString) breakByte c p = case elemIndex c p of Nothing -> (p,empty) Just n -> (unsafeTake n p, unsafeDrop n p) {-# INLINE breakByte #-} -- | 'breakEnd' behaves like 'break' but from the end of the 'ByteString' -- -- breakEnd p == spanEnd (not.p) breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) breakEnd p ps = splitAt (findFromEndUntil p ps) ps -- | 'span' @p xs@ breaks the ByteString into two segments. It is -- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) span p ps = break (not . p) ps {-# INLINE [1] span #-} -- | 'spanByte' breaks its ByteString argument at the first -- occurence of a byte other than its argument. It is more efficient -- than 'span (==)' -- -- > span (=='c') "abcd" == spanByte 'c' "abcd" -- spanByte :: Word8 -> ByteString -> (ByteString, ByteString) spanByte c ps@(PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> go (p `plusPtr` s) 0 where STRICT2(go) go p i | i >= l = return (ps, empty) | otherwise = do c' <- peekByteOff p i if c /= c' then return (unsafeTake i ps, unsafeDrop i ps) else go p (i+1) {-# INLINE spanByte #-} {-# RULES "FPS specialise span (x==)" forall x. span ((==) x) = spanByte x #-} #if __GLASGOW_HASKELL__ >= 605 {-# RULES "FPS specialise span (==x)" forall x. span (==x) = spanByte x #-} #endif -- | 'spanEnd' behaves like 'span' but from the end of the 'ByteString'. -- We have -- -- > spanEnd (not.isSpace) "x y z" == ("x y ","z") -- -- and -- -- > spanEnd (not . isSpace) ps -- > == -- > let (x,y) = span (not.isSpace) (reverse ps) in (reverse y, reverse x) -- spanEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) spanEnd p ps = splitAt (findFromEndUntil (not.p) ps) ps -- | /O(n)/ Splits a 'ByteString' into components delimited by -- separators, where the predicate returns True for a separator element. -- The resulting components do not contain the separators. Two adjacent -- separators result in an empty component in the output. eg. -- -- > splitWith (=='a') "aabbaca" == ["","","bb","c",""] -- > splitWith (=='a') [] == [] -- splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString] #if defined(__GLASGOW_HASKELL__) splitWith _pred (PS _ _ 0) = [] splitWith pred_ (PS fp off len) = splitWith0 pred# off len fp where pred# c# = pred_ (W8# c#) STRICT4(splitWith0) splitWith0 pred' off' len' fp' = withPtr fp $ \p -> splitLoop pred' p 0 off' len' fp' splitLoop :: (Word# -> Bool) -> Ptr Word8 -> Int -> Int -> Int -> ForeignPtr Word8 -> IO [ByteString] splitLoop pred' p idx' off' len' fp' | pred' `seq` p `seq` idx' `seq` off' `seq` len' `seq` fp' `seq` False = undefined | idx' >= len' = return [PS fp' off' idx'] | otherwise = do w <- peekElemOff p (off'+idx') if pred' (case w of W8# w# -> w#) then return (PS fp' off' idx' : splitWith0 pred' (off'+idx'+1) (len'-idx'-1) fp') else splitLoop pred' p (idx'+1) off' len' fp' {-# INLINE splitWith #-} #else splitWith _ (PS _ _ 0) = [] splitWith p ps = loop p ps where STRICT2(loop) loop q qs = if null rest then [chunk] else chunk : loop q (unsafeTail rest) where (chunk,rest) = break q qs #endif -- | /O(n)/ Break a 'ByteString' into pieces separated by the byte -- argument, consuming the delimiter. I.e. -- -- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"] -- > split 'a' "aXaXaXa" == ["","X","X","X"] -- > split 'x' "x" == ["",""] -- -- and -- -- > join [c] . split c == id -- > split == splitWith . (==) -- -- As for all splitting functions in this library, this function does -- not copy the substrings, it just constructs new 'ByteStrings' that -- are slices of the original. -- split :: Word8 -> ByteString -> [ByteString] split _ (PS _ _ 0) = [] split w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do let ptr = p `plusPtr` s STRICT1(loop) loop n = let q = inlinePerformIO $ memchr (ptr `plusPtr` n) w (fromIntegral (l-n)) in if q == nullPtr then [PS x (s+n) (l-n)] else let i = q `minusPtr` ptr in PS x (s+n) (i-n) : loop (i+1) return (loop 0) {-# INLINE split #-} {- -- slower. but stays inside Haskell. split _ (PS _ _ 0) = [] split (W8# w#) (PS fp off len) = splitWith' off len fp where splitWith' off' len' fp' = withPtr fp $ \p -> splitLoop p 0 off' len' fp' splitLoop :: Ptr Word8 -> Int -> Int -> Int -> ForeignPtr Word8 -> IO [ByteString] STRICT5(splitLoop) splitLoop p idx' off' len' fp' | p `seq` idx' `seq` off' `seq` len' `seq` fp' `seq` False = undefined | idx' >= len' = return [PS fp' off' idx'] | otherwise = do (W8# x#) <- peekElemOff p (off'+idx') if word2Int# w# ==# word2Int# x# then return (PS fp' off' idx' : splitWith' (off'+idx'+1) (len'-idx'-1) fp') else splitLoop p (idx'+1) off' len' fp' -} {- -- | Like 'splitWith', except that sequences of adjacent separators are -- treated as a single separator. eg. -- -- > tokens (=='a') "aabbaca" == ["bb","c"] -- tokens :: (Word8 -> Bool) -> ByteString -> [ByteString] tokens f = P.filter (not.null) . splitWith f {-# INLINE tokens #-} -} -- | The 'group' function takes a ByteString and returns a list of -- ByteStrings such that the concatenation of the result is equal to the -- argument. Moreover, each sublist in the result contains only equal -- elements. For example, -- -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] -- -- It is a special case of 'groupBy', which allows the programmer to -- supply their own equality test. It is about 40% faster than -- /groupBy (==)/ group :: ByteString -> [ByteString] group xs | null xs = [] | otherwise = ys : group zs where (ys, zs) = spanByte (unsafeHead xs) xs -- | The 'groupBy' function is the non-overloaded version of 'group'. groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString] groupBy k xs | null xs = [] | otherwise = unsafeTake n xs : groupBy k (unsafeDrop n xs) where n = 1 + findIndexOrEnd (not . k (unsafeHead xs)) (unsafeTail xs) -- | /O(n)/ The 'join' function takes a 'ByteString' and a list of -- 'ByteString's and concatenates the list after interspersing the first -- argument between each element of the list. join :: ByteString -> [ByteString] -> ByteString join s = concat . (List.intersperse s) {-# INLINE [1] join #-} {-# RULES "FPS specialise join c -> joinByte" forall c s1 s2 . join (singleton c) (s1 : s2 : []) = joinWithByte c s1 s2 #-} -- -- | /O(n)/ joinWithByte. An efficient way to join to two ByteStrings -- with a char. Around 4 times faster than the generalised join. -- joinWithByte :: Word8 -> ByteString -> ByteString -> ByteString joinWithByte c f@(PS ffp s l) g@(PS fgp t m) = unsafeCreate len $ \ptr -> withForeignPtr ffp $ \fp -> withForeignPtr fgp $ \gp -> do memcpy ptr (fp `plusPtr` s) (fromIntegral l) poke (ptr `plusPtr` l) c memcpy (ptr `plusPtr` (l + 1)) (gp `plusPtr` t) (fromIntegral m) where len = length f + length g + 1 {-# INLINE joinWithByte #-} -- --------------------------------------------------------------------- -- Indexing ByteStrings -- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0. index :: ByteString -> Int -> Word8 index ps n | n < 0 = moduleError "index" ("negative index: " ++ show n) | n >= length ps = moduleError "index" ("index too large: " ++ show n ++ ", length = " ++ show (length ps)) | otherwise = ps `unsafeIndex` n {-# INLINE index #-} -- | /O(n)/ The 'elemIndex' function returns the index of the first -- element in the given 'ByteString' which is equal to the query -- element, or 'Nothing' if there is no such element. -- This implementation uses memchr(3). elemIndex :: Word8 -> ByteString -> Maybe Int elemIndex c (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do let p' = p `plusPtr` s q <- memchr p' c (fromIntegral l) return $! if q == nullPtr then Nothing else Just $! q `minusPtr` p' {-# INLINE elemIndex #-} -- | /O(n)/ The 'elemIndexEnd' function returns the last index of the -- element in the given 'ByteString' which is equal to the query -- element, or 'Nothing' if there is no such element. The following -- holds: -- -- > elemIndexEnd c xs == -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs) -- elemIndexEnd :: Word8 -> ByteString -> Maybe Int elemIndexEnd ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> go (p `plusPtr` s) (l-1) where STRICT2(go) go p i | i < 0 = return Nothing | otherwise = do ch' <- peekByteOff p i if ch == ch' then return $ Just i else go p (i-1) {-# INLINE elemIndexEnd #-} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. -- This implementation uses memchr(3). elemIndices :: Word8 -> ByteString -> [Int] elemIndices w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do let ptr = p `plusPtr` s STRICT1(loop) loop n = let q = inlinePerformIO $ memchr (ptr `plusPtr` n) w (fromIntegral (l - n)) in if q == nullPtr then [] else let i = q `minusPtr` ptr in i : loop (i+1) return $! loop 0 {-# INLINE elemIndices #-} {- -- much slower elemIndices :: Word8 -> ByteString -> [Int] elemIndices c ps = loop 0 ps where STRICT2(loop) loop _ ps' | null ps' = [] loop n ps' | c == unsafeHead ps' = n : loop (n+1) (unsafeTail ps') | otherwise = loop (n+1) (unsafeTail ps') -} -- | count returns the number of times its argument appears in the ByteString -- -- > count = length . elemIndices -- -- But more efficiently than using length on the intermediate list. count :: Word8 -> ByteString -> Int count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p -> fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w {-# INLINE count #-} {- -- -- around 30% slower -- count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p -> go (p `plusPtr` s) (fromIntegral m) 0 where go :: Ptr Word8 -> CSize -> Int -> IO Int STRICT3(go) go p l i = do q <- memchr p w l if q == nullPtr then return i else do let k = fromIntegral $ q `minusPtr` p go (q `plusPtr` 1) (l-k-1) (i+1) -} -- | The 'findIndex' function takes a predicate and a 'ByteString' and -- returns the index of the first element in the ByteString -- satisfying the predicate. findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int findIndex k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0 where STRICT2(go) go ptr n | n >= l = return Nothing | otherwise = do w <- peek ptr if k w then return (Just n) else go (ptr `plusPtr` 1) (n+1) {-# INLINE findIndex #-} -- | The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (Word8 -> Bool) -> ByteString -> [Int] findIndices p ps = loop 0 ps where STRICT2(loop) loop n qs | null qs = [] | p (unsafeHead qs) = n : loop (n+1) (unsafeTail qs) | otherwise = loop (n+1) (unsafeTail qs) -- --------------------------------------------------------------------- -- Searching ByteStrings -- | /O(n)/ 'elem' is the 'ByteString' membership predicate. elem :: Word8 -> ByteString -> Bool elem c ps = case elemIndex c ps of Nothing -> False ; _ -> True {-# INLINE elem #-} -- | /O(n)/ 'notElem' is the inverse of 'elem' notElem :: Word8 -> ByteString -> Bool notElem c ps = not (elem c ps) {-# INLINE notElem #-} -- | /O(n)/ 'filter', applied to a predicate and a ByteString, -- returns a ByteString containing those characters that satisfy the -- predicate. This function is subject to array fusion. filter :: (Word8 -> Bool) -> ByteString -> ByteString #if defined(LOOPU_FUSION) filter p = loopArr . loopU (filterEFL p) NoAcc #elif defined(LOOPUP_FUSION) filter p = loopArr . loopUp (filterEFL p) NoAcc #elif defined(LOOPNOACC_FUSION) filter p = loopArr . loopNoAcc (filterEFL p) #else filter f = loopArr . loopFilter f #endif {-# INLINE filter #-} {- -- | /O(n)/ 'filter\'' is a non-fuseable version of filter, that may be -- around 2x faster for some one-shot applications. filter' :: (Word8 -> Bool) -> ByteString -> ByteString filter' k ps@(PS x s l) | null ps = ps | otherwise = unsafePerformIO $ createAndTrim l $ \p -> withForeignPtr x $ \f -> do t <- go (f `plusPtr` s) p (f `plusPtr` (s + l)) return $! t `minusPtr` p -- actual length where STRICT3(go) go f t end | f == end = return t | otherwise = do w <- peek f if k w then poke t w >> go (f `plusPtr` 1) (t `plusPtr` 1) end else go (f `plusPtr` 1) t end {-# INLINE filter' #-} -} -- -- | /O(n)/ A first order equivalent of /filter . (==)/, for the common -- case of filtering a single byte. It is more efficient to use -- /filterByte/ in this case. -- -- > filterByte == filter . (==) -- -- filterByte is around 10x faster, and uses much less space, than its -- filter equivalent filterByte :: Word8 -> ByteString -> ByteString filterByte w ps = replicate (count w ps) w {-# INLINE filterByte #-} {-# RULES "FPS specialise filter (== x)" forall x. filter ((==) x) = filterByte x #-} #if __GLASGOW_HASKELL__ >= 605 {-# RULES "FPS specialise filter (== x)" forall x. filter (== x) = filterByte x #-} #endif -- -- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common -- case of filtering a single byte out of a list. It is more efficient -- to use /filterNotByte/ in this case. -- -- > filterNotByte == filter . (/=) -- -- filterNotByte is around 2x faster than its filter equivalent. filterNotByte :: Word8 -> ByteString -> ByteString filterNotByte w = filter (/= w) {-# INLINE filterNotByte #-} {-# RULES "FPS specialise filter (x /=)" forall x. filter ((/=) x) = filterNotByte x #-} #if __GLASGOW_HASKELL__ >= 605 {-# RULES "FPS specialise filter (/= x)" forall x. filter (/= x) = filterNotByte x #-} #endif -- | /O(n)/ The 'find' function takes a predicate and a ByteString, -- and returns the first element in matching the predicate, or 'Nothing' -- if there is no such element. -- -- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing -- find :: (Word8 -> Bool) -> ByteString -> Maybe Word8 find f p = case findIndex f p of Just n -> Just (p `unsafeIndex` n) _ -> Nothing {-# INLINE find #-} {- -- -- fuseable, but we don't want to walk the whole array. -- find k = foldl findEFL Nothing where findEFL a@(Just _) _ = a findEFL _ c | k c = Just c | otherwise = Nothing -} -- --------------------------------------------------------------------- -- Searching for substrings -- | /O(n)/ The 'isPrefixOf' function takes two ByteStrings and returns 'True' -- iff the first is a prefix of the second. isPrefixOf :: ByteString -> ByteString -> Bool isPrefixOf (PS x1 s1 l1) (PS x2 s2 l2) | l1 == 0 = True | l2 < l1 = False | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral l1) return $! i == 0 -- | /O(n)/ The 'isSuffixOf' function takes two ByteStrings and returns 'True' -- iff the first is a suffix of the second. -- -- The following holds: -- -- > isSuffixOf x y == reverse x `isPrefixOf` reverse y -- -- However, the real implemenation uses memcmp to compare the end of the -- string only, with no reverse required.. isSuffixOf :: ByteString -> ByteString -> Bool isSuffixOf (PS x1 s1 l1) (PS x2 s2 l2) | l1 == 0 = True | l2 < l1 = False | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2 `plusPtr` (l2 - l1)) (fromIntegral l1) return $! i == 0 -- | Check whether one string is a substring of another. @isSubstringOf -- p s@ is equivalent to @not (null (findSubstrings p s))@. isSubstringOf :: ByteString -- ^ String to search for. -> ByteString -- ^ String to search in. -> Bool isSubstringOf p s = not $ P.null $ findSubstrings p s -- | Get the first index of a substring in another string, -- or 'Nothing' if the string is not found. -- @findSubstring p s@ is equivalent to @listToMaybe (findSubstrings p s)@. findSubstring :: ByteString -- ^ String to search for. -> ByteString -- ^ String to seach in. -> Maybe Int findSubstring = (listToMaybe .) . findSubstrings -- | Find the indexes of all (possibly overlapping) occurances of a -- substring in a string. This function uses the Knuth-Morris-Pratt -- string matching algorithm. findSubstrings :: ByteString -- ^ String to search for. -> ByteString -- ^ String to seach in. -> [Int] findSubstrings pat@(PS _ _ m) str@(PS _ _ n) = search 0 0 where patc x = pat `unsafeIndex` x strc x = str `unsafeIndex` x -- maybe we should make kmpNext a UArray before using it in search? kmpNext = listArray (0,m) (-1:kmpNextL pat (-1)) kmpNextL p _ | null p = [] kmpNextL p j = let j' = next (unsafeHead p) j + 1 ps = unsafeTail p x = if not (null ps) && unsafeHead ps == patc j' then kmpNext Array.! j' else j' in x:kmpNextL ps j' search i j = match ++ rest -- i: position in string, j: position in pattern where match = if j == m then [(i - j)] else [] rest = if i == n then [] else search (i+1) (next (strc i) j + 1) next c j | j >= 0 && (j == m || c /= patc j) = next c (kmpNext Array.! j) | otherwise = j -- --------------------------------------------------------------------- -- Zipping -- | /O(n)/ 'zip' takes two ByteStrings and returns a list of -- corresponding pairs of bytes. If one input ByteString is short, -- excess elements of the longer ByteString are discarded. This is -- equivalent to a pair of 'unpack' operations. zip :: ByteString -> ByteString -> [(Word8,Word8)] zip ps qs | null ps || null qs = [] | otherwise = (unsafeHead ps, unsafeHead qs) : zip (unsafeTail ps) (unsafeTail qs) -- | 'zipWith' generalises 'zip' by zipping with the function given as -- the first argument, instead of a tupling function. For example, -- @'zipWith' (+)@ is applied to two ByteStrings to produce the list of -- corresponding sums. zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a] zipWith f ps qs | null ps || null qs = [] | otherwise = f (unsafeHead ps) (unsafeHead qs) : zipWith f (unsafeTail ps) (unsafeTail qs) #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] zipWith #-} #endif -- -- | A specialised version of zipWith for the common case of a -- simultaneous map over two bytestrings, to build a 3rd. Rewrite rules -- are used to automatically covert zipWith into zipWith' when a pack is -- performed on the result of zipWith, but we also export it for -- convenience. -- zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString zipWith' f (PS fp s l) (PS fq t m) = inlinePerformIO $ withForeignPtr fp $ \a -> withForeignPtr fq $ \b -> create len $ zipWith_ 0 (a `plusPtr` s) (b `plusPtr` t) where zipWith_ :: Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () STRICT4(zipWith_) zipWith_ n p1 p2 r | n >= len = return () | otherwise = do x <- peekByteOff p1 n y <- peekByteOff p2 n pokeByteOff r n (f x y) zipWith_ (n+1) p1 p2 r len = min l m {-# INLINE zipWith' #-} {-# RULES "FPS specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q . zipWith f p q = unpack (zipWith' f p q) #-} -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of -- ByteStrings. Note that this performs two 'pack' operations. unzip :: [(Word8,Word8)] -> (ByteString,ByteString) unzip ls = (pack (P.map fst ls), pack (P.map snd ls)) {-# INLINE unzip #-} -- --------------------------------------------------------------------- -- Special lists -- | /O(n)/ Return all initial segments of the given 'ByteString', shortest first. inits :: ByteString -> [ByteString] inits (PS x s l) = [PS x s n | n <- [0..l]] -- | /O(n)/ Return all final segments of the given 'ByteString', longest first. tails :: ByteString -> [ByteString] tails p | null p = [empty] | otherwise = p : tails (unsafeTail p) -- less efficent spacewise: tails (PS x s l) = [PS x (s+n) (l-n) | n <- [0..l]] -- --------------------------------------------------------------------- -- ** Ordered 'ByteString's -- | /O(n)/ Sort a ByteString efficiently, using counting sort. sort :: ByteString -> ByteString sort (PS input s l) = unsafeCreate l $ \p -> allocaArray 256 $ \arr -> do memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize))) withForeignPtr input (\x -> countOccurrences arr (x `plusPtr` s) l) let STRICT2(go) go 256 _ = return () go i ptr = do n <- peekElemOff arr i when (n /= 0) $ memset ptr (fromIntegral i) n >> return () go (i + 1) (ptr `plusPtr` (fromIntegral n)) go 0 p {- sort :: ByteString -> ByteString sort (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> do memcpy p (f `plusPtr` s) l c_qsort p l -- inplace -} -- | The 'sortBy' function is the non-overloaded version of 'sort'. -- -- Try some linear sorts: radix, counting -- Or mergesort. -- -- sortBy :: (Word8 -> Word8 -> Ordering) -> ByteString -> ByteString -- sortBy f ps = undefined -- --------------------------------------------------------------------- -- Low level constructors -- | /O(n)/ Build a @ByteString@ from a @CString@. This value will have /no/ -- finalizer associated to it. The ByteString length is calculated using -- /strlen(3)/, and thus the complexity is a /O(n)/. packCString :: CString -> ByteString packCString cstr = unsafePerformIO $ do fp <- newForeignPtr_ (castPtr cstr) l <- c_strlen cstr return $! PS fp 0 (fromIntegral l) -- | /O(1)/ Build a @ByteString@ from a @CStringLen@. This value will -- have /no/ finalizer associated with it. This operation has /O(1)/ -- complexity as we already know the final size, so no /strlen(3)/ is -- required. packCStringLen :: CStringLen -> ByteString packCStringLen (ptr,len) = unsafePerformIO $ do fp <- newForeignPtr_ (castPtr ptr) return $! PS fp 0 (fromIntegral len) -- | /O(n)/ Build a @ByteString@ from a malloced @CString@. This value will -- have a @free(3)@ finalizer associated to it. packMallocCString :: CString -> ByteString packMallocCString cstr = unsafePerformIO $ do fp <- newForeignFreePtr (castPtr cstr) len <- c_strlen cstr return $! PS fp 0 (fromIntegral len) -- | /O(n) construction/ Use a @ByteString@ with a function requiring a -- null-terminated @CString@. The @CString@ will be freed -- automatically. This is a memcpy(3). useAsCString :: ByteString -> (CString -> IO a) -> IO a useAsCString (PS ps s l) = bracket alloc (c_free.castPtr) where alloc = withForeignPtr ps $ \p -> do buf <- c_malloc (fromIntegral l+1) memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l) poke (buf `plusPtr` l) (0::Word8) -- n.b. return (castPtr buf) -- | /O(1) construction/ Use a @ByteString@ with a function requiring a @CStringLen@. useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a useAsCStringLen = unsafeUseAsCStringLen -- -- why were we doing this? -- -- useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a -- useAsCStringLen (PS ps s l) = bracket alloc (c_free.castPtr.fst) -- where -- alloc = withForeignPtr ps $ \p -> do -- buf <- c_malloc (fromIntegral l+1) -- memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l) -- poke (buf `plusPtr` l) (0::Word8) -- n.b. -- return $! (castPtr buf, l) -- -- | /O(n)/ Make a copy of the 'ByteString' with its own storage. -- This is mainly useful to allow the rest of the data pointed -- to by the 'ByteString' to be garbage collected, for example -- if a large string has been read in, and only a small part of it -- is needed in the rest of the program. copy :: ByteString -> ByteString copy (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> memcpy p (f `plusPtr` s) (fromIntegral l) -- | /O(n)/ Duplicate a CString as a ByteString. Useful if you know the -- CString is going to be deallocated from C land. copyCString :: CString -> IO ByteString copyCString cstr = do len <- c_strlen cstr copyCStringLen (cstr, fromIntegral len) -- | /O(n)/ Same as copyCString, but saves a strlen call when the length is known. copyCStringLen :: CStringLen -> IO ByteString copyCStringLen (cstr, len) = create len $ \p -> memcpy p (castPtr cstr) (fromIntegral len) -- --------------------------------------------------------------------- -- line IO -- | Read a line from stdin. getLine :: IO ByteString getLine = hGetLine stdin {- -- | Lazily construct a list of lines of ByteStrings. This will be much -- better on memory consumption than using 'hGetContents >>= lines' -- If you're considering this, a better choice might be to use -- Data.ByteString.Lazy hGetLines :: Handle -> IO [ByteString] hGetLines h = go where go = unsafeInterleaveIO $ do e <- hIsEOF h if e then return [] else do x <- hGetLine h xs <- go return (x:xs) -} -- | Read a line from a handle hGetLine :: Handle -> IO ByteString #if !defined(__GLASGOW_HASKELL__) hGetLine h = System.IO.hGetLine h >>= return . pack . P.map c2w #else hGetLine h = wantReadableHandle "Data.ByteString.hGetLine" h $ \ handle_ -> do case haBufferMode handle_ of NoBuffering -> error "no buffering" _other -> hGetLineBuffered handle_ where hGetLineBuffered handle_ = do let ref = haBuffer handle_ buf <- readIORef ref hGetLineBufferedLoop handle_ ref buf 0 [] hGetLineBufferedLoop handle_ ref buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } len xss = len `seq` do off <- findEOL r w raw let new_len = len + off - r xs <- mkPS raw r off -- if eol == True, then off is the offset of the '\n' -- otherwise off == w and the buffer is now empty. if off /= w then do if (w == off + 1) then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } else writeIORef ref buf{ bufRPtr = off + 1 } mkBigPS new_len (xs:xss) else do maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_) buf{ bufWPtr=0, bufRPtr=0 } case maybe_buf of -- Nothing indicates we caught an EOF, and we may have a -- partial line to return. Nothing -> do writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } if new_len > 0 then mkBigPS new_len (xs:xss) else ioe_EOF Just new_buf -> hGetLineBufferedLoop handle_ ref new_buf new_len (xs:xss) -- find the end-of-line character, if there is one findEOL r w raw | r == w = return w | otherwise = do (c,r') <- readCharFromBuffer raw r if c == '\n' then return r -- NB. not r': don't include the '\n' else findEOL r' w raw maybeFillReadBuffer fd is_line is_stream buf = catch (do buf' <- fillReadBuffer fd is_line is_stream buf return (Just buf')) (\e -> if isEOFError e then return Nothing else ioError e) -- TODO, rewrite to use normal memcpy mkPS :: RawBuffer -> Int -> Int -> IO ByteString mkPS buf start end = let len = end - start in create len $ \p -> do memcpy_ptr_baoff p buf (fromIntegral start) (fromIntegral len) return () mkBigPS :: Int -> [ByteString] -> IO ByteString mkBigPS _ [ps] = return ps mkBigPS _ pss = return $! concat (P.reverse pss) #endif -- --------------------------------------------------------------------- -- Block IO -- | Outputs a 'ByteString' to the specified 'Handle'. hPut :: Handle -> ByteString -> IO () hPut _ (PS _ _ 0) = return () hPut h (PS ps s l) = withForeignPtr ps $ \p-> hPutBuf h (p `plusPtr` s) l -- | A synonym for @hPut@, for compatibility hPutStr :: Handle -> ByteString -> IO () hPutStr = hPut -- | Write a ByteString to a handle, appending a newline byte hPutStrLn :: Handle -> ByteString -> IO () hPutStrLn h ps | length ps < 1024 = hPut h (ps `snoc` 0x0a) | otherwise = hPut h ps >> hPut h (singleton (0x0a)) -- don't copy -- | Write a ByteString to stdout putStr :: ByteString -> IO () putStr = hPut stdout -- | Write a ByteString to stdout, appending a newline byte putStrLn :: ByteString -> IO () putStrLn = hPutStrLn stdout -- | Read a 'ByteString' directly from the specified 'Handle'. This -- is far more efficient than reading the characters into a 'String' -- and then using 'pack'. hGet :: Handle -> Int -> IO ByteString hGet _ 0 = return empty hGet h i = createAndTrim i $ \p -> hGetBuf h p i -- | hGetNonBlocking is identical to 'hGet', except that it will never block -- waiting for data to become available, instead it returns only whatever data -- is available. hGetNonBlocking :: Handle -> Int -> IO ByteString #if defined(__GLASGOW_HASKELL__) hGetNonBlocking _ 0 = return empty hGetNonBlocking h i = createAndTrim i $ \p -> hGetBufNonBlocking h p i #else hGetNonBlocking = hGet #endif -- | Read entire handle contents into a 'ByteString'. -- This function reads chunks at a time, doubling the chunksize on each -- read. The final buffer is then realloced to the appropriate size. For -- files > half of available memory, this may lead to memory exhaustion. -- Consider using 'readFile' in this case. -- -- As with 'hGet', the string representation in the file is assumed to -- be ISO-8859-1. -- hGetContents :: Handle -> IO ByteString hGetContents h = do let start_size = 1024 p <- mallocArray start_size i <- hGetBuf h p start_size if i < start_size then do p' <- reallocArray p i fp <- newForeignFreePtr p' return $! PS fp 0 i else f p start_size where f p s = do let s' = 2 * s p' <- reallocArray p s' i <- hGetBuf h (p' `plusPtr` s) s if i < s then do let i' = s + i p'' <- reallocArray p' i' fp <- newForeignFreePtr p'' return $! PS fp 0 i' else f p' s' -- | getContents. Equivalent to hGetContents stdin getContents :: IO ByteString getContents = hGetContents stdin -- | The interact function takes a function of type @ByteString -> ByteString@ -- as its argument. The entire input from the standard input device is passed -- to this function as its argument, and the resulting string is output on the -- standard output device. It's great for writing one line programs! interact :: (ByteString -> ByteString) -> IO () interact transformer = putStr . transformer =<< getContents -- | Read an entire file strictly into a 'ByteString'. This is far more -- efficient than reading the characters into a 'String' and then using -- 'pack'. It also may be more efficient than opening the file and -- reading it using hGet. Files are read using 'binary mode' on Windows, -- for 'text mode' use the Char8 version of this function. readFile :: FilePath -> IO ByteString readFile f = bracket (openBinaryFile f ReadMode) hClose (\h -> hFileSize h >>= hGet h . fromIntegral) -- | Write a 'ByteString' to a file. writeFile :: FilePath -> ByteString -> IO () writeFile f txt = bracket (openBinaryFile f WriteMode) hClose (\h -> hPut h txt) -- | Append a 'ByteString' to a file. appendFile :: FilePath -> ByteString -> IO () appendFile f txt = bracket (openBinaryFile f AppendMode) hClose (\h -> hPut h txt) {- -- -- Disable until we can move it into a portable .hsc file -- -- | Like readFile, this reads an entire file directly into a -- 'ByteString', but it is even more efficient. It involves directly -- mapping the file to memory. This has the advantage that the contents -- of the file never need to be copied. Also, under memory pressure the -- page may simply be discarded, while in the case of readFile it would -- need to be written to swap. If you read many small files, mmapFile -- will be less memory-efficient than readFile, since each mmapFile -- takes up a separate page of memory. Also, you can run into bus -- errors if the file is modified. As with 'readFile', the string -- representation in the file is assumed to be ISO-8859-1. -- -- On systems without mmap, this is the same as a readFile. -- mmapFile :: FilePath -> IO ByteString mmapFile f = mmap f >>= \(fp,l) -> return $! PS fp 0 l mmap :: FilePath -> IO (ForeignPtr Word8, Int) mmap f = do h <- openBinaryFile f ReadMode l <- fromIntegral `fmap` hFileSize h -- Don't bother mmaping small files because each mmapped file takes up -- at least one full VM block. if l < mmap_limit then do thefp <- mallocByteString l withForeignPtr thefp $ \p-> hGetBuf h p l hClose h return (thefp, l) else do -- unix only :( fd <- fromIntegral `fmap` handleToFd h p <- my_mmap l fd fp <- if p == nullPtr then do thefp <- mallocByteString l withForeignPtr thefp $ \p' -> hGetBuf h p' l return thefp else do -- The munmap leads to crashes on OpenBSD. -- maybe there's a use after unmap in there somewhere? -- Bulat suggests adding the hClose to the -- finalizer, excellent idea. #if !defined(__OpenBSD__) let unmap = c_munmap p l >> return () #else let unmap = return () #endif fp <- newForeignPtr p unmap return fp c_close fd hClose h return (fp, l) where mmap_limit = 16*1024 -} -- --------------------------------------------------------------------- -- Internal utilities -- | 'findIndexOrEnd' is a variant of findIndex, that returns the length -- of the string if no element is found, rather than Nothing. findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int findIndexOrEnd k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0 where STRICT2(go) go ptr n | n >= l = return l | otherwise = do w <- peek ptr if k w then return n else go (ptr `plusPtr` 1) (n+1) {-# INLINE findIndexOrEnd #-} -- | Perform an operation with a temporary ByteString withPtr :: ForeignPtr a -> (Ptr a -> IO b) -> b withPtr fp io = inlinePerformIO (withForeignPtr fp io) {-# INLINE withPtr #-} -- Common up near identical calls to `error' to reduce the number -- constant strings created when compiled: errorEmptyList :: String -> a errorEmptyList fun = moduleError fun "empty ByteString" {-# NOINLINE errorEmptyList #-} moduleError :: String -> String -> a moduleError fun msg = error ("Data.ByteString." ++ fun ++ ':':' ':msg) {-# NOINLINE moduleError #-} -- Find from the end of the string using predicate findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int STRICT2(findFromEndUntil) findFromEndUntil f ps@(PS x s l) = if null ps then 0 else if f (last ps) then l else findFromEndUntil f (PS x s (l-1)) {-# INLINE newForeignFreePtr #-} newForeignFreePtr :: Ptr Word8 -> IO (ForeignPtr Word8) newForeignFreePtr p = newForeignPtr c_free_finalizer p hugs98-plus-Sep2006/packages/base/Debug/0000755006511100651110000000000010504340225016474 5ustar rossrosshugs98-plus-Sep2006/packages/base/Debug/Trace.hs0000644006511100651110000000370010504340225020066 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Debug.Trace -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- The 'trace' function. -- ----------------------------------------------------------------------------- module Debug.Trace ( -- * Tracing putTraceMsg, -- :: String -> IO () trace -- :: String -> a -> a ) where import Prelude import System.IO.Unsafe #ifdef __GLASGOW_HASKELL__ import Foreign.C.String #else import System.IO (hPutStrLn,stderr) #endif -- | 'putTraceMsg' function outputs the trace message from IO monad. -- Usually the output stream is 'System.IO.stderr' but if the function is called -- from Windows GUI application then the output will be directed to the Windows -- debug console. putTraceMsg :: String -> IO () putTraceMsg msg = do #ifndef __GLASGOW_HASKELL__ hPutStrLn stderr msg #else withCString "%s\n" $ \cfmt -> withCString msg $ \cmsg -> debugBelch cfmt cmsg foreign import ccall unsafe "RtsMessages.h debugBelch" debugBelch :: CString -> CString -> IO () #endif {-# NOINLINE trace #-} {-| When called, 'trace' outputs the string in its first argument, before returning the second argument as its result. The 'trace' function is not referentially transparent, and should only be used for debugging, or for monitoring execution. Some implementations of 'trace' may decorate the string that\'s output to indicate that you\'re tracing. The function is implemented on top of 'putTraceMsg'. -} trace :: String -> a -> a trace string expr = unsafePerformIO $ do putTraceMsg string return expr {-| Like 'trace', but uses 'show' on the argument to convert it to a 'String'. > traceShow = trace . show -} traceShow :: (Show a) => a -> b -> b traceShow = trace . show hugs98-plus-Sep2006/packages/base/Foreign/0000755006511100651110000000000010504340222017034 5ustar rossrosshugs98-plus-Sep2006/packages/base/Foreign/C/0000755006511100651110000000000010504340225017221 5ustar rossrosshugs98-plus-Sep2006/packages/base/Foreign/C/Error.hs0000644006511100651110000005225710504340221020655 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.C.Error -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- C-specific Marshalling support: Handling of C \"errno\" error codes. -- ----------------------------------------------------------------------------- module Foreign.C.Error ( -- * Haskell representations of @errno@ values Errno(..), -- instance: Eq -- ** Common @errno@ symbols -- | Different operating systems and\/or C libraries often support -- different values of @errno@. This module defines the common values, -- but due to the open definition of 'Errno' users may add definitions -- which are not predefined. eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED, eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT, eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ, eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK, eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH, eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK, eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS, eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO, eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL, ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE, eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV, -- ** 'Errno' functions -- :: Errno isValidErrno, -- :: Errno -> Bool -- access to the current thread's "errno" value -- getErrno, -- :: IO Errno resetErrno, -- :: IO () -- conversion of an "errno" value into IO error -- errnoToIOError, -- :: String -- location -- -> Errno -- errno -- -> Maybe Handle -- handle -- -> Maybe String -- filename -- -> IOError -- throw current "errno" value -- throwErrno, -- :: String -> IO a -- ** Guards for IO operations that may fail throwErrnoIf, -- :: (a -> Bool) -> String -> IO a -> IO a throwErrnoIf_, -- :: (a -> Bool) -> String -> IO a -> IO () throwErrnoIfRetry, -- :: (a -> Bool) -> String -> IO a -> IO a throwErrnoIfRetry_, -- :: (a -> Bool) -> String -> IO a -> IO () throwErrnoIfMinus1, -- :: Num a -- => String -> IO a -> IO a throwErrnoIfMinus1_, -- :: Num a -- => String -> IO a -> IO () throwErrnoIfMinus1Retry, -- :: Num a -- => String -> IO a -> IO a throwErrnoIfMinus1Retry_, -- :: Num a -- => String -> IO a -> IO () throwErrnoIfNull, -- :: String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfNullRetry,-- :: String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfRetryMayBlock, throwErrnoIfRetryMayBlock_, throwErrnoIfMinus1RetryMayBlock, throwErrnoIfMinus1RetryMayBlock_, throwErrnoIfNullRetryMayBlock ) where -- this is were we get the CONST_XXX definitions from that configure -- calculated for us -- #ifndef __NHC__ #include "HsBaseConfig.h" #endif -- system dependent imports -- ------------------------ -- GHC allows us to get at the guts inside IO errors/exceptions -- #if __GLASGOW_HASKELL__ import GHC.IOBase (IOException(..), IOErrorType(..)) #endif /* __GLASGOW_HASKELL__ */ -- regular imports -- --------------- import Foreign.Storable import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Foreign.Marshal.Error ( void ) import Data.Maybe #if __GLASGOW_HASKELL__ import GHC.IOBase import GHC.Num import GHC.Base #else import System.IO ( Handle ) import System.IO.Error ( IOError, ioError ) import System.IO.Unsafe ( unsafePerformIO ) #endif #ifdef __HUGS__ {-# CFILES cbits/PrelIOUtils.c #-} #endif -- "errno" type -- ------------ -- | Haskell representation for @errno@ values. -- The implementation is deliberately exposed, to allow users to add -- their own definitions of 'Errno' values. newtype Errno = Errno CInt instance Eq Errno where errno1@(Errno no1) == errno2@(Errno no2) | isValidErrno errno1 && isValidErrno errno2 = no1 == no2 | otherwise = False -- common "errno" symbols -- eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED, eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT, eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ, eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK, eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH, eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK, eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS, eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO, eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL, ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE, eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV :: Errno -- -- the cCONST_XXX identifiers are cpp symbols whose value is computed by -- configure -- eOK = Errno 0 #ifdef __NHC__ #include "Errno.hs" #else e2BIG = Errno (CONST_E2BIG) eACCES = Errno (CONST_EACCES) eADDRINUSE = Errno (CONST_EADDRINUSE) eADDRNOTAVAIL = Errno (CONST_EADDRNOTAVAIL) eADV = Errno (CONST_EADV) eAFNOSUPPORT = Errno (CONST_EAFNOSUPPORT) eAGAIN = Errno (CONST_EAGAIN) eALREADY = Errno (CONST_EALREADY) eBADF = Errno (CONST_EBADF) eBADMSG = Errno (CONST_EBADMSG) eBADRPC = Errno (CONST_EBADRPC) eBUSY = Errno (CONST_EBUSY) eCHILD = Errno (CONST_ECHILD) eCOMM = Errno (CONST_ECOMM) eCONNABORTED = Errno (CONST_ECONNABORTED) eCONNREFUSED = Errno (CONST_ECONNREFUSED) eCONNRESET = Errno (CONST_ECONNRESET) eDEADLK = Errno (CONST_EDEADLK) eDESTADDRREQ = Errno (CONST_EDESTADDRREQ) eDIRTY = Errno (CONST_EDIRTY) eDOM = Errno (CONST_EDOM) eDQUOT = Errno (CONST_EDQUOT) eEXIST = Errno (CONST_EEXIST) eFAULT = Errno (CONST_EFAULT) eFBIG = Errno (CONST_EFBIG) eFTYPE = Errno (CONST_EFTYPE) eHOSTDOWN = Errno (CONST_EHOSTDOWN) eHOSTUNREACH = Errno (CONST_EHOSTUNREACH) eIDRM = Errno (CONST_EIDRM) eILSEQ = Errno (CONST_EILSEQ) eINPROGRESS = Errno (CONST_EINPROGRESS) eINTR = Errno (CONST_EINTR) eINVAL = Errno (CONST_EINVAL) eIO = Errno (CONST_EIO) eISCONN = Errno (CONST_EISCONN) eISDIR = Errno (CONST_EISDIR) eLOOP = Errno (CONST_ELOOP) eMFILE = Errno (CONST_EMFILE) eMLINK = Errno (CONST_EMLINK) eMSGSIZE = Errno (CONST_EMSGSIZE) eMULTIHOP = Errno (CONST_EMULTIHOP) eNAMETOOLONG = Errno (CONST_ENAMETOOLONG) eNETDOWN = Errno (CONST_ENETDOWN) eNETRESET = Errno (CONST_ENETRESET) eNETUNREACH = Errno (CONST_ENETUNREACH) eNFILE = Errno (CONST_ENFILE) eNOBUFS = Errno (CONST_ENOBUFS) eNODATA = Errno (CONST_ENODATA) eNODEV = Errno (CONST_ENODEV) eNOENT = Errno (CONST_ENOENT) eNOEXEC = Errno (CONST_ENOEXEC) eNOLCK = Errno (CONST_ENOLCK) eNOLINK = Errno (CONST_ENOLINK) eNOMEM = Errno (CONST_ENOMEM) eNOMSG = Errno (CONST_ENOMSG) eNONET = Errno (CONST_ENONET) eNOPROTOOPT = Errno (CONST_ENOPROTOOPT) eNOSPC = Errno (CONST_ENOSPC) eNOSR = Errno (CONST_ENOSR) eNOSTR = Errno (CONST_ENOSTR) eNOSYS = Errno (CONST_ENOSYS) eNOTBLK = Errno (CONST_ENOTBLK) eNOTCONN = Errno (CONST_ENOTCONN) eNOTDIR = Errno (CONST_ENOTDIR) eNOTEMPTY = Errno (CONST_ENOTEMPTY) eNOTSOCK = Errno (CONST_ENOTSOCK) eNOTTY = Errno (CONST_ENOTTY) eNXIO = Errno (CONST_ENXIO) eOPNOTSUPP = Errno (CONST_EOPNOTSUPP) ePERM = Errno (CONST_EPERM) ePFNOSUPPORT = Errno (CONST_EPFNOSUPPORT) ePIPE = Errno (CONST_EPIPE) ePROCLIM = Errno (CONST_EPROCLIM) ePROCUNAVAIL = Errno (CONST_EPROCUNAVAIL) ePROGMISMATCH = Errno (CONST_EPROGMISMATCH) ePROGUNAVAIL = Errno (CONST_EPROGUNAVAIL) ePROTO = Errno (CONST_EPROTO) ePROTONOSUPPORT = Errno (CONST_EPROTONOSUPPORT) ePROTOTYPE = Errno (CONST_EPROTOTYPE) eRANGE = Errno (CONST_ERANGE) eREMCHG = Errno (CONST_EREMCHG) eREMOTE = Errno (CONST_EREMOTE) eROFS = Errno (CONST_EROFS) eRPCMISMATCH = Errno (CONST_ERPCMISMATCH) eRREMOTE = Errno (CONST_ERREMOTE) eSHUTDOWN = Errno (CONST_ESHUTDOWN) eSOCKTNOSUPPORT = Errno (CONST_ESOCKTNOSUPPORT) eSPIPE = Errno (CONST_ESPIPE) eSRCH = Errno (CONST_ESRCH) eSRMNT = Errno (CONST_ESRMNT) eSTALE = Errno (CONST_ESTALE) eTIME = Errno (CONST_ETIME) eTIMEDOUT = Errno (CONST_ETIMEDOUT) eTOOMANYREFS = Errno (CONST_ETOOMANYREFS) eTXTBSY = Errno (CONST_ETXTBSY) eUSERS = Errno (CONST_EUSERS) eWOULDBLOCK = Errno (CONST_EWOULDBLOCK) eXDEV = Errno (CONST_EXDEV) #endif -- | Yield 'True' if the given 'Errno' value is valid on the system. -- This implies that the 'Eq' instance of 'Errno' is also system dependent -- as it is only defined for valid values of 'Errno'. -- isValidErrno :: Errno -> Bool -- -- the configure script sets all invalid "errno"s to -1 -- isValidErrno (Errno errno) = errno /= -1 -- access to the current thread's "errno" value -- -------------------------------------------- -- | Get the current value of @errno@ in the current thread. -- getErrno :: IO Errno -- We must call a C function to get the value of errno in general. On -- threaded systems, errno is hidden behind a C macro so that each OS -- thread gets its own copy. #ifdef __NHC__ getErrno = do e <- peek _errno; return (Errno e) foreign import ccall unsafe "errno.h &errno" _errno :: Ptr CInt #else getErrno = do e <- get_errno; return (Errno e) foreign import ccall unsafe "HsBase.h __hscore_get_errno" get_errno :: IO CInt #endif -- | Reset the current thread\'s @errno@ value to 'eOK'. -- resetErrno :: IO () -- Again, setting errno has to be done via a C function. #ifdef __NHC__ resetErrno = poke _errno 0 #else resetErrno = set_errno 0 foreign import ccall unsafe "HsBase.h __hscore_set_errno" set_errno :: CInt -> IO () #endif -- throw current "errno" value -- --------------------------- -- | Throw an 'IOError' corresponding to the current value of 'getErrno'. -- throwErrno :: String -- ^ textual description of the error location -> IO a throwErrno loc = do errno <- getErrno ioError (errnoToIOError loc errno Nothing Nothing) -- guards for IO operations that may fail -- -------------------------------------- -- | Throw an 'IOError' corresponding to the current value of 'getErrno' -- if the result value of the 'IO' action meets the given predicate. -- throwErrnoIf :: (a -> Bool) -- ^ predicate to apply to the result value -- of the 'IO' operation -> String -- ^ textual description of the location -> IO a -- ^ the 'IO' operation to be executed -> IO a throwErrnoIf pred loc f = do res <- f if pred res then throwErrno loc else return res -- | as 'throwErrnoIf', but discards the result of the 'IO' action after -- error handling. -- throwErrnoIf_ :: (a -> Bool) -> String -> IO a -> IO () throwErrnoIf_ pred loc f = void $ throwErrnoIf pred loc f -- | as 'throwErrnoIf', but retry the 'IO' action when it yields the -- error code 'eINTR' - this amounts to the standard retry loop for -- interrupted POSIX system calls. -- throwErrnoIfRetry :: (a -> Bool) -> String -> IO a -> IO a throwErrnoIfRetry pred loc f = do res <- f if pred res then do err <- getErrno if err == eINTR then throwErrnoIfRetry pred loc f else throwErrno loc else return res -- | as 'throwErrnoIfRetry', but checks for operations that would block and -- executes an alternative action before retrying in that case. -- throwErrnoIfRetryMayBlock :: (a -> Bool) -- ^ predicate to apply to the result value -- of the 'IO' operation -> String -- ^ textual description of the location -> IO a -- ^ the 'IO' operation to be executed -> IO b -- ^ action to execute before retrying if -- an immediate retry would block -> IO a throwErrnoIfRetryMayBlock pred loc f on_block = do res <- f if pred res then do err <- getErrno if err == eINTR then throwErrnoIfRetryMayBlock pred loc f on_block else if err == eWOULDBLOCK || err == eAGAIN then do on_block; throwErrnoIfRetryMayBlock pred loc f on_block else throwErrno loc else return res -- | as 'throwErrnoIfRetry', but discards the result. -- throwErrnoIfRetry_ :: (a -> Bool) -> String -> IO a -> IO () throwErrnoIfRetry_ pred loc f = void $ throwErrnoIfRetry pred loc f -- | as 'throwErrnoIfRetryMayBlock', but discards the result. -- throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO () throwErrnoIfRetryMayBlock_ pred loc f on_block = void $ throwErrnoIfRetryMayBlock pred loc f on_block -- | Throw an 'IOError' corresponding to the current value of 'getErrno' -- if the 'IO' action returns a result of @-1@. -- throwErrnoIfMinus1 :: Num a => String -> IO a -> IO a throwErrnoIfMinus1 = throwErrnoIf (== -1) -- | as 'throwErrnoIfMinus1', but discards the result. -- throwErrnoIfMinus1_ :: Num a => String -> IO a -> IO () throwErrnoIfMinus1_ = throwErrnoIf_ (== -1) -- | Throw an 'IOError' corresponding to the current value of 'getErrno' -- if the 'IO' action returns a result of @-1@, but retries in case of -- an interrupted operation. -- throwErrnoIfMinus1Retry :: Num a => String -> IO a -> IO a throwErrnoIfMinus1Retry = throwErrnoIfRetry (== -1) -- | as 'throwErrnoIfMinus1', but discards the result. -- throwErrnoIfMinus1Retry_ :: Num a => String -> IO a -> IO () throwErrnoIfMinus1Retry_ = throwErrnoIfRetry_ (== -1) -- | as 'throwErrnoIfMinus1Retry', but checks for operations that would block. -- throwErrnoIfMinus1RetryMayBlock :: Num a => String -> IO a -> IO b -> IO a throwErrnoIfMinus1RetryMayBlock = throwErrnoIfRetryMayBlock (== -1) -- | as 'throwErrnoIfMinus1RetryMayBlock', but discards the result. -- throwErrnoIfMinus1RetryMayBlock_ :: Num a => String -> IO a -> IO b -> IO () throwErrnoIfMinus1RetryMayBlock_ = throwErrnoIfRetryMayBlock_ (== -1) -- | Throw an 'IOError' corresponding to the current value of 'getErrno' -- if the 'IO' action returns 'nullPtr'. -- throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfNull = throwErrnoIf (== nullPtr) -- | Throw an 'IOError' corresponding to the current value of 'getErrno' -- if the 'IO' action returns 'nullPtr', -- but retry in case of an interrupted operation. -- throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfNullRetry = throwErrnoIfRetry (== nullPtr) -- | as 'throwErrnoIfNullRetry', but checks for operations that would block. -- throwErrnoIfNullRetryMayBlock :: String -> IO (Ptr a) -> IO b -> IO (Ptr a) throwErrnoIfNullRetryMayBlock = throwErrnoIfRetryMayBlock (== nullPtr) -- conversion of an "errno" value into IO error -- -------------------------------------------- -- | Construct a Haskell 98 I\/O error based on the given 'Errno' value. -- The optional information can be used to improve the accuracy of -- error messages. -- errnoToIOError :: String -- ^ the location where the error occurred -> Errno -- ^ the error number -> Maybe Handle -- ^ optional handle associated with the error -> Maybe String -- ^ optional filename associated with the error -> IOError errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do str <- strerror errno >>= peekCString #if __GLASGOW_HASKELL__ return (IOError maybeHdl errType loc str maybeName) where errType | errno == eOK = OtherError | errno == e2BIG = ResourceExhausted | errno == eACCES = PermissionDenied | errno == eADDRINUSE = ResourceBusy | errno == eADDRNOTAVAIL = UnsupportedOperation | errno == eADV = OtherError | errno == eAFNOSUPPORT = UnsupportedOperation | errno == eAGAIN = ResourceExhausted | errno == eALREADY = AlreadyExists | errno == eBADF = InvalidArgument | errno == eBADMSG = InappropriateType | errno == eBADRPC = OtherError | errno == eBUSY = ResourceBusy | errno == eCHILD = NoSuchThing | errno == eCOMM = ResourceVanished | errno == eCONNABORTED = OtherError | errno == eCONNREFUSED = NoSuchThing | errno == eCONNRESET = ResourceVanished | errno == eDEADLK = ResourceBusy | errno == eDESTADDRREQ = InvalidArgument | errno == eDIRTY = UnsatisfiedConstraints | errno == eDOM = InvalidArgument | errno == eDQUOT = PermissionDenied | errno == eEXIST = AlreadyExists | errno == eFAULT = OtherError | errno == eFBIG = PermissionDenied | errno == eFTYPE = InappropriateType | errno == eHOSTDOWN = NoSuchThing | errno == eHOSTUNREACH = NoSuchThing | errno == eIDRM = ResourceVanished | errno == eILSEQ = InvalidArgument | errno == eINPROGRESS = AlreadyExists | errno == eINTR = Interrupted | errno == eINVAL = InvalidArgument | errno == eIO = HardwareFault | errno == eISCONN = AlreadyExists | errno == eISDIR = InappropriateType | errno == eLOOP = InvalidArgument | errno == eMFILE = ResourceExhausted | errno == eMLINK = ResourceExhausted | errno == eMSGSIZE = ResourceExhausted | errno == eMULTIHOP = UnsupportedOperation | errno == eNAMETOOLONG = InvalidArgument | errno == eNETDOWN = ResourceVanished | errno == eNETRESET = ResourceVanished | errno == eNETUNREACH = NoSuchThing | errno == eNFILE = ResourceExhausted | errno == eNOBUFS = ResourceExhausted | errno == eNODATA = NoSuchThing | errno == eNODEV = UnsupportedOperation | errno == eNOENT = NoSuchThing | errno == eNOEXEC = InvalidArgument | errno == eNOLCK = ResourceExhausted | errno == eNOLINK = ResourceVanished | errno == eNOMEM = ResourceExhausted | errno == eNOMSG = NoSuchThing | errno == eNONET = NoSuchThing | errno == eNOPROTOOPT = UnsupportedOperation | errno == eNOSPC = ResourceExhausted | errno == eNOSR = ResourceExhausted | errno == eNOSTR = InvalidArgument | errno == eNOSYS = UnsupportedOperation | errno == eNOTBLK = InvalidArgument | errno == eNOTCONN = InvalidArgument | errno == eNOTDIR = InappropriateType | errno == eNOTEMPTY = UnsatisfiedConstraints | errno == eNOTSOCK = InvalidArgument | errno == eNOTTY = IllegalOperation | errno == eNXIO = NoSuchThing | errno == eOPNOTSUPP = UnsupportedOperation | errno == ePERM = PermissionDenied | errno == ePFNOSUPPORT = UnsupportedOperation | errno == ePIPE = ResourceVanished | errno == ePROCLIM = PermissionDenied | errno == ePROCUNAVAIL = UnsupportedOperation | errno == ePROGMISMATCH = ProtocolError | errno == ePROGUNAVAIL = UnsupportedOperation | errno == ePROTO = ProtocolError | errno == ePROTONOSUPPORT = ProtocolError | errno == ePROTOTYPE = ProtocolError | errno == eRANGE = UnsupportedOperation | errno == eREMCHG = ResourceVanished | errno == eREMOTE = IllegalOperation | errno == eROFS = PermissionDenied | errno == eRPCMISMATCH = ProtocolError | errno == eRREMOTE = IllegalOperation | errno == eSHUTDOWN = IllegalOperation | errno == eSOCKTNOSUPPORT = UnsupportedOperation | errno == eSPIPE = UnsupportedOperation | errno == eSRCH = NoSuchThing | errno == eSRMNT = UnsatisfiedConstraints | errno == eSTALE = ResourceVanished | errno == eTIME = TimeExpired | errno == eTIMEDOUT = TimeExpired | errno == eTOOMANYREFS = ResourceExhausted | errno == eTXTBSY = ResourceBusy | errno == eUSERS = ResourceExhausted | errno == eWOULDBLOCK = OtherError | errno == eXDEV = UnsupportedOperation | otherwise = OtherError #else return (userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName)) #endif foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar) hugs98-plus-Sep2006/packages/base/Foreign/C/String.hs0000644006511100651110000003546010504340225021033 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.C.String -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- Utilities for primitive marshalling of C strings. -- -- The marshalling converts each Haskell character, representing a Unicode -- code point, to one or more bytes in a manner that, by default, is -- determined by the current locale. As a consequence, no guarantees -- can be made about the relative length of a Haskell string and its -- corresponding C string, and therefore all the marshalling routines -- include memory allocation. The translation between Unicode and the -- encoding of the current locale may be lossy. -- ----------------------------------------------------------------------------- module Foreign.C.String ( -- representation of strings in C -- * C strings CString, -- = Ptr CChar CStringLen, -- = (Ptr CChar, Int) -- ** Using a locale-dependent encoding -- | Currently these functions are identical to their @CAString@ counterparts; -- eventually they will use an encoding determined by the current locale. -- conversion of C strings into Haskell strings -- peekCString, -- :: CString -> IO String peekCStringLen, -- :: CStringLen -> IO String -- conversion of Haskell strings into C strings -- newCString, -- :: String -> IO CString newCStringLen, -- :: String -> IO CStringLen -- conversion of Haskell strings into C strings using temporary storage -- withCString, -- :: String -> (CString -> IO a) -> IO a withCStringLen, -- :: String -> (CStringLen -> IO a) -> IO a charIsRepresentable, -- :: Char -> IO Bool -- ** Using 8-bit characters -- | These variants of the above functions are for use with C libraries -- that are ignorant of Unicode. These functions should be used with -- care, as a loss of information can occur. castCharToCChar, -- :: Char -> CChar castCCharToChar, -- :: CChar -> Char peekCAString, -- :: CString -> IO String peekCAStringLen, -- :: CStringLen -> IO String newCAString, -- :: String -> IO CString newCAStringLen, -- :: String -> IO CStringLen withCAString, -- :: String -> (CString -> IO a) -> IO a withCAStringLen, -- :: String -> (CStringLen -> IO a) -> IO a -- * C wide strings -- | These variants of the above functions are for use with C libraries -- that encode Unicode using the C @wchar_t@ type in a system-dependent -- way. The only encodings supported are -- -- * UTF-32 (the C compiler defines @__STDC_ISO_10646__@), or -- -- * UTF-16 (as used on Windows systems). CWString, -- = Ptr CWchar CWStringLen, -- = (Ptr CWchar, Int) peekCWString, -- :: CWString -> IO String peekCWStringLen, -- :: CWStringLen -> IO String newCWString, -- :: String -> IO CWString newCWStringLen, -- :: String -> IO CWStringLen withCWString, -- :: String -> (CWString -> IO a) -> IO a withCWStringLen, -- :: String -> (CWStringLen -> IO a) -> IO a ) where import Foreign.Marshal.Array import Foreign.C.Types import Foreign.Ptr import Foreign.Storable import Data.Word #ifdef __GLASGOW_HASKELL__ import GHC.List import GHC.Real import GHC.Num import GHC.IOBase import GHC.Base #else import Data.Char ( chr, ord ) #define unsafeChr chr #endif ----------------------------------------------------------------------------- -- Strings -- representation of strings in C -- ------------------------------ -- | A C string is a reference to an array of C characters terminated by NUL. type CString = Ptr CChar -- | A string with explicit length information in bytes instead of a -- terminating NUL (allowing NUL characters in the middle of the string). type CStringLen = (Ptr CChar, Int) -- exported functions -- ------------------ -- -- * the following routines apply the default conversion when converting the -- C-land character encoding into the Haskell-land character encoding -- | Marshal a NUL terminated C string into a Haskell string. -- peekCString :: CString -> IO String peekCString = peekCAString -- | Marshal a C string with explicit length into a Haskell string. -- peekCStringLen :: CStringLen -> IO String peekCStringLen = peekCAStringLen -- | Marshal a Haskell string into a NUL terminated C string. -- -- * the Haskell string may /not/ contain any NUL characters -- -- * new storage is allocated for the C string and must be -- explicitly freed using 'Foreign.Marshal.Alloc.free' or -- 'Foreign.Marshal.Alloc.finalizerFree'. -- newCString :: String -> IO CString newCString = newCAString -- | Marshal a Haskell string into a C string (ie, character array) with -- explicit length information. -- -- * new storage is allocated for the C string and must be -- explicitly freed using 'Foreign.Marshal.Alloc.free' or -- 'Foreign.Marshal.Alloc.finalizerFree'. -- newCStringLen :: String -> IO CStringLen newCStringLen = newCAStringLen -- | Marshal a Haskell string into a NUL terminated C string using temporary -- storage. -- -- * the Haskell string may /not/ contain any NUL characters -- -- * the memory is freed when the subcomputation terminates (either -- normally or via an exception), so the pointer to the temporary -- storage must /not/ be used after this. -- withCString :: String -> (CString -> IO a) -> IO a withCString = withCAString -- | Marshal a Haskell string into a C string (ie, character array) -- in temporary storage, with explicit length information. -- -- * the memory is freed when the subcomputation terminates (either -- normally or via an exception), so the pointer to the temporary -- storage must /not/ be used after this. -- withCStringLen :: String -> (CStringLen -> IO a) -> IO a withCStringLen = withCAStringLen -- | Determines whether a character can be accurately encoded in a 'CString'. -- Unrepresentable characters are converted to @\'?\'@. -- -- Currently only Latin-1 characters are representable. charIsRepresentable :: Char -> IO Bool charIsRepresentable c = return (ord c < 256) -- single byte characters -- ---------------------- -- -- ** NOTE: These routines don't handle conversions! ** -- | Convert a C byte, representing a Latin-1 character, to the corresponding -- Haskell character. castCCharToChar :: CChar -> Char castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8)) -- | Convert a Haskell character to a C character. -- This function is only safe on the first 256 characters. castCharToCChar :: Char -> CChar castCharToCChar ch = fromIntegral (ord ch) -- | Marshal a NUL terminated C string into a Haskell string. -- peekCAString :: CString -> IO String #ifndef __GLASGOW_HASKELL__ peekCAString cp = do cs <- peekArray0 nUL cp return (cCharsToChars cs) #else peekCAString cp = do l <- lengthArray0 nUL cp if l <= 0 then return "" else loop "" (l-1) where loop s i = do xval <- peekElemOff cp i let val = castCCharToChar xval val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1) #endif -- | Marshal a C string with explicit length into a Haskell string. -- peekCAStringLen :: CStringLen -> IO String #ifndef __GLASGOW_HASKELL__ peekCAStringLen (cp, len) = do cs <- peekArray len cp return (cCharsToChars cs) #else peekCAStringLen (cp, len) | len <= 0 = return "" -- being (too?) nice. | otherwise = loop [] (len-1) where loop acc i = do xval <- peekElemOff cp i let val = castCCharToChar xval -- blow away the coercion ASAP. if (val `seq` (i == 0)) then return (val:acc) else loop (val:acc) (i-1) #endif -- | Marshal a Haskell string into a NUL terminated C string. -- -- * the Haskell string may /not/ contain any NUL characters -- -- * new storage is allocated for the C string and must be -- explicitly freed using 'Foreign.Marshal.Alloc.free' or -- 'Foreign.Marshal.Alloc.finalizerFree'. -- newCAString :: String -> IO CString #ifndef __GLASGOW_HASKELL__ newCAString = newArray0 nUL . charsToCChars #else newCAString str = do ptr <- mallocArray0 (length str) let go [] n = pokeElemOff ptr n nUL go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) go str 0 return ptr #endif -- | Marshal a Haskell string into a C string (ie, character array) with -- explicit length information. -- -- * new storage is allocated for the C string and must be -- explicitly freed using 'Foreign.Marshal.Alloc.free' or -- 'Foreign.Marshal.Alloc.finalizerFree'. -- newCAStringLen :: String -> IO CStringLen #ifndef __GLASGOW_HASKELL__ newCAStringLen str = do a <- newArray (charsToCChars str) return (pairLength str a) #else newCAStringLen str = do ptr <- mallocArray0 len let go [] n = n `seq` return () -- make it strict in n go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) go str 0 return (ptr, len) where len = length str #endif -- | Marshal a Haskell string into a NUL terminated C string using temporary -- storage. -- -- * the Haskell string may /not/ contain any NUL characters -- -- * the memory is freed when the subcomputation terminates (either -- normally or via an exception), so the pointer to the temporary -- storage must /not/ be used after this. -- withCAString :: String -> (CString -> IO a) -> IO a #ifndef __GLASGOW_HASKELL__ withCAString = withArray0 nUL . charsToCChars #else withCAString str f = allocaArray0 (length str) $ \ptr -> let go [] n = pokeElemOff ptr n nUL go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) in do go str 0 f ptr #endif -- | Marshal a Haskell string into a C string (ie, character array) -- in temporary storage, with explicit length information. -- -- * the memory is freed when the subcomputation terminates (either -- normally or via an exception), so the pointer to the temporary -- storage must /not/ be used after this. -- withCAStringLen :: String -> (CStringLen -> IO a) -> IO a #ifndef __GLASGOW_HASKELL__ withCAStringLen str act = withArray (charsToCChars str) $ act . pairLength str #else withCAStringLen str f = allocaArray len $ \ptr -> let go [] n = n `seq` return () -- make it strict in n go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) in do go str 0 f (ptr,len) where len = length str #endif -- auxiliary definitions -- ---------------------- -- C's end of string character -- nUL :: CChar nUL = 0 -- pair a C string with the length of the given Haskell string -- pairLength :: String -> a -> (a, Int) pairLength = flip (,) . length #ifndef __GLASGOW_HASKELL__ -- cast [CChar] to [Char] -- cCharsToChars :: [CChar] -> [Char] cCharsToChars xs = map castCCharToChar xs -- cast [Char] to [CChar] -- charsToCChars :: [Char] -> [CChar] charsToCChars xs = map castCharToCChar xs #endif ----------------------------------------------------------------------------- -- Wide strings -- representation of wide strings in C -- ----------------------------------- -- | A C wide string is a reference to an array of C wide characters -- terminated by NUL. type CWString = Ptr CWchar -- | A wide character string with explicit length information in bytes -- instead of a terminating NUL (allowing NUL characters in the middle -- of the string). type CWStringLen = (Ptr CWchar, Int) -- | Marshal a NUL terminated C wide string into a Haskell string. -- peekCWString :: CWString -> IO String peekCWString cp = do cs <- peekArray0 wNUL cp return (cWcharsToChars cs) -- | Marshal a C wide string with explicit length into a Haskell string. -- peekCWStringLen :: CWStringLen -> IO String peekCWStringLen (cp, len) = do cs <- peekArray len cp return (cWcharsToChars cs) -- | Marshal a Haskell string into a NUL terminated C wide string. -- -- * the Haskell string may /not/ contain any NUL characters -- -- * new storage is allocated for the C wide string and must -- be explicitly freed using 'Foreign.Marshal.Alloc.free' or -- 'Foreign.Marshal.Alloc.finalizerFree'. -- newCWString :: String -> IO CWString newCWString = newArray0 wNUL . charsToCWchars -- | Marshal a Haskell string into a C wide string (ie, wide character array) -- with explicit length information. -- -- * new storage is allocated for the C wide string and must -- be explicitly freed using 'Foreign.Marshal.Alloc.free' or -- 'Foreign.Marshal.Alloc.finalizerFree'. -- newCWStringLen :: String -> IO CWStringLen newCWStringLen str = do a <- newArray (charsToCWchars str) return (pairLength str a) -- | Marshal a Haskell string into a NUL terminated C wide string using -- temporary storage. -- -- * the Haskell string may /not/ contain any NUL characters -- -- * the memory is freed when the subcomputation terminates (either -- normally or via an exception), so the pointer to the temporary -- storage must /not/ be used after this. -- withCWString :: String -> (CWString -> IO a) -> IO a withCWString = withArray0 wNUL . charsToCWchars -- | Marshal a Haskell string into a NUL terminated C wide string using -- temporary storage. -- -- * the Haskell string may /not/ contain any NUL characters -- -- * the memory is freed when the subcomputation terminates (either -- normally or via an exception), so the pointer to the temporary -- storage must /not/ be used after this. -- withCWStringLen :: String -> (CWStringLen -> IO a) -> IO a withCWStringLen str act = withArray (charsToCWchars str) $ act . pairLength str -- auxiliary definitions -- ---------------------- wNUL :: CWchar wNUL = 0 cWcharsToChars :: [CWchar] -> [Char] charsToCWchars :: [Char] -> [CWchar] #ifdef mingw32_HOST_OS -- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding. -- coding errors generate Chars in the surrogate range cWcharsToChars = map chr . fromUTF16 . map fromIntegral where fromUTF16 (c1:c2:wcs) | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff = ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs fromUTF16 (c:wcs) = c : fromUTF16 wcs fromUTF16 [] = [] charsToCWchars = foldr utf16Char [] . map ord where utf16Char c wcs | c < 0x10000 = fromIntegral c : wcs | otherwise = let c' = c - 0x10000 in fromIntegral (c' `div` 0x400 + 0xd800) : fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs #else /* !mingw32_HOST_OS */ cWcharsToChars xs = map castCWcharToChar xs charsToCWchars xs = map castCharToCWchar xs -- These conversions only make sense if __STDC_ISO_10646__ is defined -- (meaning that wchar_t is ISO 10646, aka Unicode) castCWcharToChar :: CWchar -> Char castCWcharToChar ch = chr (fromIntegral ch ) castCharToCWchar :: Char -> CWchar castCharToCWchar ch = fromIntegral (ord ch) #endif /* !mingw32_HOST_OS */ hugs98-plus-Sep2006/packages/base/Foreign/C/Types.hs0000644006511100651110000002731210504340222020663 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.C.Types -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- Mapping of C types to corresponding Haskell types. -- ----------------------------------------------------------------------------- module Foreign.C.Types ( -- * Representations of C types #ifndef __NHC__ -- $ctypes -- ** Integral types -- | These types are are represented as @newtype@s of -- types in "Data.Int" and "Data.Word", and are instances of -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read', -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable', -- 'Prelude.Bounded', 'Prelude.Real', 'Prelude.Integral' and -- 'Bits'. CChar, CSChar, CUChar , CShort, CUShort, CInt, CUInt , CLong, CULong , CPtrdiff, CSize, CWchar, CSigAtomic , CLLong, CULLong , CIntPtr, CUIntPtr , CIntMax, CUIntMax -- ** Numeric types -- | These types are are represented as @newtype@s of basic -- foreign types, and are instances of -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read', -- 'Prelude.Show', 'Prelude.Enum', 'Typeable' and 'Storable'. , CClock, CTime -- ** Floating types -- | These types are are represented as @newtype@s of -- 'Prelude.Float' and 'Prelude.Double', and are instances of -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read', -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable', -- 'Prelude.Real', 'Prelude.Fractional', 'Prelude.Floating', -- 'Prelude.RealFrac' and 'Prelude.RealFloat'. , CFloat, CDouble, CLDouble #else -- Exported non-abstractly in nhc98 to fix an interface file problem. CChar(..), CSChar(..), CUChar(..) , CShort(..), CUShort(..), CInt(..), CUInt(..) , CLong(..), CULong(..) , CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..) , CLLong(..), CULLong(..) , CClock(..), CTime(..) , CFloat(..), CDouble(..), CLDouble(..) #endif -- ** Other types -- Instances of: Eq and Storable , CFile, CFpos, CJmpBuf ) where #ifndef __NHC__ import Foreign.Storable import Data.Bits ( Bits(..) ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word64 ) import Data.Typeable #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Float import GHC.Enum import GHC.Real import GHC.Show import GHC.Read import GHC.Num #else import Control.Monad ( liftM ) #endif #ifdef __HUGS__ import Hugs.Ptr ( castPtr ) #endif #include "HsBaseConfig.h" #include "CTypes.h" -- | Haskell type representing the C @char@ type. INTEGRAL_TYPE(CChar,tyConCChar,"CChar",HTYPE_CHAR) -- | Haskell type representing the C @signed char@ type. INTEGRAL_TYPE(CSChar,tyConCSChar,"CSChar",HTYPE_SIGNED_CHAR) -- | Haskell type representing the C @unsigned char@ type. INTEGRAL_TYPE(CUChar,tyConCUChar,"CUChar",HTYPE_UNSIGNED_CHAR) -- | Haskell type representing the C @short@ type. INTEGRAL_TYPE(CShort,tyConCShort,"CShort",HTYPE_SHORT) -- | Haskell type representing the C @unsigned short@ type. INTEGRAL_TYPE(CUShort,tyConCUShort,"CUShort",HTYPE_UNSIGNED_SHORT) -- | Haskell type representing the C @int@ type. INTEGRAL_TYPE(CInt,tyConCInt,"CInt",HTYPE_INT) -- | Haskell type representing the C @unsigned int@ type. INTEGRAL_TYPE(CUInt,tyConCUInt,"CUInt",HTYPE_UNSIGNED_INT) -- | Haskell type representing the C @long@ type. INTEGRAL_TYPE(CLong,tyConCLong,"CLong",HTYPE_LONG) -- | Haskell type representing the C @unsigned long@ type. INTEGRAL_TYPE(CULong,tyConCULong,"CULong",HTYPE_UNSIGNED_LONG) -- | Haskell type representing the C @long long@ type. INTEGRAL_TYPE(CLLong,tyConCLLong,"CLLong",HTYPE_LONG_LONG) -- | Haskell type representing the C @unsigned long long@ type. INTEGRAL_TYPE(CULLong,tyConCULLong,"CULLong",HTYPE_UNSIGNED_LONG_LONG) {-# RULES "fromIntegral/a->CChar" fromIntegral = \x -> CChar (fromIntegral x) "fromIntegral/a->CSChar" fromIntegral = \x -> CSChar (fromIntegral x) "fromIntegral/a->CUChar" fromIntegral = \x -> CUChar (fromIntegral x) "fromIntegral/a->CShort" fromIntegral = \x -> CShort (fromIntegral x) "fromIntegral/a->CUShort" fromIntegral = \x -> CUShort (fromIntegral x) "fromIntegral/a->CInt" fromIntegral = \x -> CInt (fromIntegral x) "fromIntegral/a->CUInt" fromIntegral = \x -> CUInt (fromIntegral x) "fromIntegral/a->CLong" fromIntegral = \x -> CLong (fromIntegral x) "fromIntegral/a->CULong" fromIntegral = \x -> CULong (fromIntegral x) "fromIntegral/a->CLLong" fromIntegral = \x -> CLLong (fromIntegral x) "fromIntegral/a->CULLong" fromIntegral = \x -> CULLong (fromIntegral x) "fromIntegral/CChar->a" fromIntegral = \(CChar x) -> fromIntegral x "fromIntegral/CSChar->a" fromIntegral = \(CSChar x) -> fromIntegral x "fromIntegral/CUChar->a" fromIntegral = \(CUChar x) -> fromIntegral x "fromIntegral/CShort->a" fromIntegral = \(CShort x) -> fromIntegral x "fromIntegral/CUShort->a" fromIntegral = \(CUShort x) -> fromIntegral x "fromIntegral/CInt->a" fromIntegral = \(CInt x) -> fromIntegral x "fromIntegral/CUInt->a" fromIntegral = \(CUInt x) -> fromIntegral x "fromIntegral/CLong->a" fromIntegral = \(CLong x) -> fromIntegral x "fromIntegral/CULong->a" fromIntegral = \(CULong x) -> fromIntegral x "fromIntegral/CLLong->a" fromIntegral = \(CLLong x) -> fromIntegral x "fromIntegral/CULLong->a" fromIntegral = \(CULLong x) -> fromIntegral x #-} -- | Haskell type representing the C @float@ type. FLOATING_TYPE(CFloat,tyConCFloat,"CFloat",HTYPE_FLOAT) -- | Haskell type representing the C @double@ type. FLOATING_TYPE(CDouble,tyConCDouble,"CDouble",HTYPE_DOUBLE) -- HACK: Currently no long double in the FFI, so we simply re-use double -- | Haskell type representing the C @long double@ type. FLOATING_TYPE(CLDouble,tyConCLDouble,"CLDouble",HTYPE_DOUBLE) {-# RULES "realToFrac/a->CFloat" realToFrac = \x -> CFloat (realToFrac x) "realToFrac/a->CDouble" realToFrac = \x -> CDouble (realToFrac x) "realToFrac/a->CLDouble" realToFrac = \x -> CLDouble (realToFrac x) "realToFrac/CFloat->a" realToFrac = \(CFloat x) -> realToFrac x "realToFrac/CDouble->a" realToFrac = \(CDouble x) -> realToFrac x "realToFrac/CLDouble->a" realToFrac = \(CLDouble x) -> realToFrac x #-} -- | Haskell type representing the C @ptrdiff_t@ type. INTEGRAL_TYPE(CPtrdiff,tyConCPtrdiff,"CPtrdiff",HTYPE_PTRDIFF_T) -- | Haskell type representing the C @size_t@ type. INTEGRAL_TYPE(CSize,tyConCSize,"CSize",HTYPE_SIZE_T) -- | Haskell type representing the C @wchar_t@ type. INTEGRAL_TYPE(CWchar,tyConCWchar,"CWchar",HTYPE_WCHAR_T) -- | Haskell type representing the C @sig_atomic_t@ type. INTEGRAL_TYPE(CSigAtomic,tyConCSigAtomic,"CSigAtomic",HTYPE_SIG_ATOMIC_T) {-# RULES "fromIntegral/a->CPtrdiff" fromIntegral = \x -> CPtrdiff (fromIntegral x) "fromIntegral/a->CSize" fromIntegral = \x -> CSize (fromIntegral x) "fromIntegral/a->CWchar" fromIntegral = \x -> CWchar (fromIntegral x) "fromIntegral/a->CSigAtomic" fromIntegral = \x -> CSigAtomic (fromIntegral x) "fromIntegral/CPtrdiff->a" fromIntegral = \(CPtrdiff x) -> fromIntegral x "fromIntegral/CSize->a" fromIntegral = \(CSize x) -> fromIntegral x "fromIntegral/CWchar->a" fromIntegral = \(CWchar x) -> fromIntegral x "fromIntegral/CSigAtomic->a" fromIntegral = \(CSigAtomic x) -> fromIntegral x #-} -- | Haskell type representing the C @clock_t@ type. ARITHMETIC_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T) -- | Haskell type representing the C @time_t@ type. ARITHMETIC_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T) -- FIXME: Implement and provide instances for Eq and Storable -- | Haskell type representing the C @FILE@ type. data CFile = CFile -- | Haskell type representing the C @fpos_t@ type. data CFpos = CFpos -- | Haskell type representing the C @jmp_buf@ type. data CJmpBuf = CJmpBuf INTEGRAL_TYPE(CIntPtr,tyConCIntPtr,"CIntPtr",HTYPE_INTPTR_T) INTEGRAL_TYPE(CUIntPtr,tyConCUIntPtr,"CUIntPtr",HTYPE_UINTPTR_T) INTEGRAL_TYPE(CIntMax,tyConCIntMax,"CIntMax",HTYPE_INTMAX_T) INTEGRAL_TYPE(CUIntMax,tyConCUIntMax,"CUIntMax",HTYPE_UINTMAX_T) {-# RULES "fromIntegral/a->CIntPtr" fromIntegral = \x -> CIntPtr (fromIntegral x) "fromIntegral/a->CUIntPtr" fromIntegral = \x -> CUIntPtr (fromIntegral x) "fromIntegral/a->CIntMax" fromIntegral = \x -> CIntMax (fromIntegral x) "fromIntegral/a->CUIntMax" fromIntegral = \x -> CUIntMax (fromIntegral x) #-} -- C99 types which are still missing include: -- wint_t, wctrans_t, wctype_t {- $ctypes These types are needed to accurately represent C function prototypes, in order to access C library interfaces in Haskell. The Haskell system is not required to represent those types exactly as C does, but the following guarantees are provided concerning a Haskell type @CT@ representing a C type @t@: * If a C function prototype has @t@ as an argument or result type, the use of @CT@ in the corresponding position in a foreign declaration permits the Haskell program to access the full range of values encoded by the C type; and conversely, any Haskell value for @CT@ has a valid representation in C. * @'sizeOf' ('Prelude.undefined' :: CT)@ will yield the same value as @sizeof (t)@ in C. * @'alignment' ('Prelude.undefined' :: CT)@ matches the alignment constraint enforced by the C implementation for @t@. * The members 'peek' and 'poke' of the 'Storable' class map all values of @CT@ to the corresponding value of @t@ and vice versa. * When an instance of 'Prelude.Bounded' is defined for @CT@, the values of 'Prelude.minBound' and 'Prelude.maxBound' coincide with @t_MIN@ and @t_MAX@ in C. * When an instance of 'Prelude.Eq' or 'Prelude.Ord' is defined for @CT@, the predicates defined by the type class implement the same relation as the corresponding predicate in C on @t@. * When an instance of 'Prelude.Num', 'Prelude.Read', 'Prelude.Integral', 'Prelude.Fractional', 'Prelude.Floating', 'Prelude.RealFrac', or 'Prelude.RealFloat' is defined for @CT@, the arithmetic operations defined by the type class implement the same function as the corresponding arithmetic operations (if available) in C on @t@. * When an instance of 'Bits' is defined for @CT@, the bitwise operation defined by the type class implement the same function as the corresponding bitwise operation in C on @t@. -} #else /* __NHC__ */ import NHC.FFI ( CChar(..), CSChar(..), CUChar(..) , CShort(..), CUShort(..), CInt(..), CUInt(..) , CLong(..), CULong(..), CLLong(..), CULLong(..) , CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..) , CClock(..), CTime(..) , CFloat(..), CDouble(..), CLDouble(..) , CFile, CFpos, CJmpBuf , Storable(..) ) import Data.Bits import NHC.SizedTypes #define INSTANCE_BITS(T) \ instance Bits T where { \ (T x) .&. (T y) = T (x .&. y) ; \ (T x) .|. (T y) = T (x .|. y) ; \ (T x) `xor` (T y) = T (x `xor` y) ; \ complement (T x) = T (complement x) ; \ shift (T x) n = T (shift x n) ; \ rotate (T x) n = T (rotate x n) ; \ bit n = T (bit n) ; \ setBit (T x) n = T (setBit x n) ; \ clearBit (T x) n = T (clearBit x n) ; \ complementBit (T x) n = T (complementBit x n) ; \ testBit (T x) n = testBit x n ; \ bitSize (T x) = bitSize x ; \ isSigned (T x) = isSigned x } INSTANCE_BITS(CChar) INSTANCE_BITS(CSChar) INSTANCE_BITS(CUChar) INSTANCE_BITS(CShort) INSTANCE_BITS(CUShort) INSTANCE_BITS(CInt) INSTANCE_BITS(CUInt) INSTANCE_BITS(CLong) INSTANCE_BITS(CULong) INSTANCE_BITS(CLLong) INSTANCE_BITS(CULLong) INSTANCE_BITS(CPtrdiff) INSTANCE_BITS(CWchar) INSTANCE_BITS(CSigAtomic) INSTANCE_BITS(CSize) #endif hugs98-plus-Sep2006/packages/base/Foreign/Marshal/0000755006511100651110000000000010504340225020426 5ustar rossrosshugs98-plus-Sep2006/packages/base/Foreign/Marshal/Alloc.hs0000644006511100651110000001564310504340221022021 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Marshal.Alloc -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- Marshalling support: basic routines for memory allocation -- ----------------------------------------------------------------------------- module Foreign.Marshal.Alloc ( -- * Memory allocation -- ** Local allocation alloca, -- :: Storable a => (Ptr a -> IO b) -> IO b allocaBytes, -- :: Int -> (Ptr a -> IO b) -> IO b -- ** Dynamic allocation malloc, -- :: Storable a => IO (Ptr a) mallocBytes, -- :: Int -> IO (Ptr a) realloc, -- :: Storable b => Ptr a -> IO (Ptr b) reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a) free, -- :: Ptr a -> IO () finalizerFree -- :: FinalizerPtr a ) where import Data.Maybe import Foreign.Ptr ( Ptr, nullPtr, FunPtr ) import Foreign.C.Types ( CSize ) import Foreign.Storable ( Storable(sizeOf) ) #ifdef __GLASGOW_HASKELL__ import Foreign.ForeignPtr ( FinalizerPtr ) import GHC.IOBase import GHC.Real import GHC.Ptr import GHC.Err import GHC.Base import GHC.Num #elif defined(__NHC__) import NHC.FFI ( FinalizerPtr, CInt(..) ) import IO ( bracket ) #else import Control.Exception ( bracket ) #endif #ifdef __HUGS__ import Hugs.Prelude ( IOException(IOError), IOErrorType(ResourceExhausted) ) import Hugs.ForeignPtr ( FinalizerPtr ) #endif -- exported functions -- ------------------ -- |Allocate a block of memory that is sufficient to hold values of type -- @a@. The size of the area allocated is determined by the 'sizeOf' -- method from the instance of 'Storable' for the appropriate type. -- -- The memory may be deallocated using 'free' or 'finalizerFree' when -- no longer required. -- malloc :: Storable a => IO (Ptr a) malloc = doMalloc undefined where doMalloc :: Storable b => b -> IO (Ptr b) doMalloc dummy = mallocBytes (sizeOf dummy) -- |Allocate a block of memory of the given number of bytes. -- The block of memory is sufficiently aligned for any of the basic -- foreign types that fits into a memory block of the allocated size. -- -- The memory may be deallocated using 'free' or 'finalizerFree' when -- no longer required. -- mallocBytes :: Int -> IO (Ptr a) mallocBytes size = failWhenNULL "malloc" (_malloc (fromIntegral size)) -- |@'alloca' f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory sufficient to -- hold values of type @a@. -- -- The memory is freed when @f@ terminates (either normally or via an -- exception), so the pointer passed to @f@ must /not/ be used after this. -- alloca :: Storable a => (Ptr a -> IO b) -> IO b alloca = doAlloca undefined where doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b' doAlloca dummy = allocaBytes (sizeOf dummy) -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory of @n@ bytes. -- The block of memory is sufficiently aligned for any of the basic -- foreign types that fits into a memory block of the allocated size. -- -- The memory is freed when @f@ terminates (either normally or via an -- exception), so the pointer passed to @f@ must /not/ be used after this. -- #ifdef __GLASGOW_HASKELL__ allocaBytes :: Int -> (Ptr a -> IO b) -> IO b allocaBytes (I# size) action = IO $ \ s -> case newPinnedByteArray# size s of { (# s, mbarr# #) -> case unsafeFreezeByteArray# mbarr# s of { (# s, barr# #) -> let addr = Ptr (byteArrayContents# barr#) in case action addr of { IO action -> case action s of { (# s, r #) -> case touch# barr# s of { s -> (# s, r #) }}}}} #else allocaBytes :: Int -> (Ptr a -> IO b) -> IO b allocaBytes size = bracket (mallocBytes size) free #endif -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b@. The returned pointer -- may refer to an entirely different memory area, but will be suitably -- aligned to hold values of type @b@. The contents of the referenced -- memory area will be the same as of the original pointer up to the -- minimum of the original size and the size of values of type @b@. -- -- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like -- 'malloc'. -- realloc :: Storable b => Ptr a -> IO (Ptr b) realloc = doRealloc undefined where doRealloc :: Storable b' => b' -> Ptr a' -> IO (Ptr b') doRealloc dummy ptr = let size = fromIntegral (sizeOf dummy) in failWhenNULL "realloc" (_realloc ptr size) -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the given size. The returned pointer may refer to an entirely -- different memory area, but will be sufficiently aligned for any of the -- basic foreign types that fits into a memory block of the given size. -- The contents of the referenced memory area will be the same as of -- the original pointer up to the minimum of the original size and the -- given size. -- -- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes' -- behaves like 'malloc'. If the requested size is 0, 'reallocBytes' -- behaves like 'free'. -- reallocBytes :: Ptr a -> Int -> IO (Ptr a) reallocBytes ptr 0 = do free ptr; return nullPtr reallocBytes ptr size = failWhenNULL "realloc" (_realloc ptr (fromIntegral size)) -- |Free a block of memory that was allocated with 'malloc', -- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new' -- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or -- "Foreign.C.String". -- free :: Ptr a -> IO () free = _free -- auxilliary routines -- ------------------- -- asserts that the pointer returned from the action in the second argument is -- non-null -- failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a) failWhenNULL name f = do addr <- f if addr == nullPtr #if __GLASGOW_HASKELL__ || __HUGS__ then ioError (IOError Nothing ResourceExhausted name "out of memory" Nothing) #else then ioError (userError (name++": out of memory")) #endif else return addr -- basic C routines needed for memory allocation -- foreign import ccall unsafe "stdlib.h malloc" _malloc :: CSize -> IO (Ptr a) foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b) foreign import ccall unsafe "stdlib.h free" _free :: Ptr a -> IO () -- | A pointer to a foreign function equivalent to 'free', which may be -- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage -- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'. foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a hugs98-plus-Sep2006/packages/base/Foreign/Marshal/Array.hs0000644006511100651110000002170610504340221022042 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Marshal.Array -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- Marshalling support: routines allocating, storing, and retrieving Haskell -- lists that are represented as arrays in the foreign language -- ----------------------------------------------------------------------------- module Foreign.Marshal.Array ( -- * Marshalling arrays -- ** Allocation -- mallocArray, -- :: Storable a => Int -> IO (Ptr a) mallocArray0, -- :: Storable a => Int -> IO (Ptr a) allocaArray, -- :: Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray0, -- :: Storable a => Int -> (Ptr a -> IO b) -> IO b reallocArray, -- :: Storable a => Ptr a -> Int -> IO (Ptr a) reallocArray0, -- :: Storable a => Ptr a -> Int -> IO (Ptr a) -- ** Marshalling -- peekArray, -- :: Storable a => Int -> Ptr a -> IO [a] peekArray0, -- :: (Storable a, Eq a) => a -> Ptr a -> IO [a] pokeArray, -- :: Storable a => Ptr a -> [a] -> IO () pokeArray0, -- :: Storable a => a -> Ptr a -> [a] -> IO () -- ** Combined allocation and marshalling -- newArray, -- :: Storable a => [a] -> IO (Ptr a) newArray0, -- :: Storable a => a -> [a] -> IO (Ptr a) withArray, -- :: Storable a => [a] -> (Ptr a -> IO b) -> IO b withArray0, -- :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b withArrayLen, -- :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b withArrayLen0, -- :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b -- ** Copying -- | (argument order: destination, source) copyArray, -- :: Storable a => Ptr a -> Ptr a -> Int -> IO () moveArray, -- :: Storable a => Ptr a -> Ptr a -> Int -> IO () -- ** Finding the length -- lengthArray0, -- :: (Storable a, Eq a) => a -> Ptr a -> IO Int -- ** Indexing -- advancePtr, -- :: Storable a => Ptr a -> Int -> Ptr a ) where import Control.Monad import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (Storable(sizeOf,peekElemOff,pokeElemOff)) import Foreign.Marshal.Alloc (mallocBytes, allocaBytes, reallocBytes) import Foreign.Marshal.Utils (copyBytes, moveBytes) #ifdef __GLASGOW_HASKELL__ import GHC.IOBase import GHC.Num import GHC.List import GHC.Err import GHC.Base #endif -- allocation -- ---------- -- |Allocate storage for the given number of elements of a storable type -- (like 'Foreign.Marshal.Alloc.malloc', but for multiple elements). -- mallocArray :: Storable a => Int -> IO (Ptr a) mallocArray = doMalloc undefined where doMalloc :: Storable a' => a' -> Int -> IO (Ptr a') doMalloc dummy size = mallocBytes (size * sizeOf dummy) -- |Like 'mallocArray', but add an extra position to hold a special -- termination element. -- mallocArray0 :: Storable a => Int -> IO (Ptr a) mallocArray0 size = mallocArray (size + 1) -- |Temporarily allocate space for the given number of elements -- (like 'Foreign.Marshal.Alloc.alloca', but for multiple elements). -- allocaArray :: Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray = doAlloca undefined where doAlloca :: Storable a' => a' -> Int -> (Ptr a' -> IO b') -> IO b' doAlloca dummy size = allocaBytes (size * sizeOf dummy) -- |Like 'allocaArray', but add an extra position to hold a special -- termination element. -- allocaArray0 :: Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray0 size = allocaArray (size + 1) -- |Adjust the size of an array -- reallocArray :: Storable a => Ptr a -> Int -> IO (Ptr a) reallocArray = doRealloc undefined where doRealloc :: Storable a' => a' -> Ptr a' -> Int -> IO (Ptr a') doRealloc dummy ptr size = reallocBytes ptr (size * sizeOf dummy) -- |Adjust the size of an array including an extra position for the end marker. -- reallocArray0 :: Storable a => Ptr a -> Int -> IO (Ptr a) reallocArray0 ptr size = reallocArray ptr (size + 1) -- marshalling -- ----------- -- |Convert an array of given length into a Haskell list. This version -- traverses the array backwards using an accumulating parameter, -- which uses constant stack space. The previous version using mapM -- needed linear stack space. -- peekArray :: Storable a => Int -> Ptr a -> IO [a] peekArray size ptr | size <= 0 = return [] | otherwise = f (size-1) [] where f 0 acc = do e <- peekElemOff ptr 0; return (e:acc) f n acc = do e <- peekElemOff ptr n; f (n-1) (e:acc) -- |Convert an array terminated by the given end marker into a Haskell list -- peekArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO [a] peekArray0 marker ptr = do size <- lengthArray0 marker ptr peekArray size ptr -- |Write the list elements consecutive into memory -- pokeArray :: Storable a => Ptr a -> [a] -> IO () #ifndef __GLASGOW_HASKELL__ pokeArray ptr vals = zipWithM_ (pokeElemOff ptr) [0..] vals #else pokeArray ptr vals = go vals 0# where go [] n# = return () go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#) #endif -- |Write the list elements consecutive into memory and terminate them with the -- given marker element -- pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO () #ifndef __GLASGOW_HASKELL__ pokeArray0 marker ptr vals = do pokeArray ptr vals pokeElemOff ptr (length vals) marker #else pokeArray0 marker ptr vals = go vals 0# where go [] n# = pokeElemOff ptr (I# n#) marker go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#) #endif -- combined allocation and marshalling -- ----------------------------------- -- |Write a list of storable elements into a newly allocated, consecutive -- sequence of storable values -- (like 'Foreign.Marshal.Utils.new', but for multiple elements). -- newArray :: Storable a => [a] -> IO (Ptr a) newArray vals = do ptr <- mallocArray (length vals) pokeArray ptr vals return ptr -- |Write a list of storable elements into a newly allocated, consecutive -- sequence of storable values, where the end is fixed by the given end marker -- newArray0 :: Storable a => a -> [a] -> IO (Ptr a) newArray0 marker vals = do ptr <- mallocArray0 (length vals) pokeArray0 marker ptr vals return ptr -- |Temporarily store a list of storable values in memory -- (like 'Foreign.Marshal.Utils.with', but for multiple elements). -- withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b withArray vals = withArrayLen vals . const -- |Like 'withArray', but the action gets the number of values -- as an additional parameter -- withArrayLen :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b withArrayLen vals f = allocaArray len $ \ptr -> do pokeArray ptr vals res <- f len ptr return res where len = length vals -- |Like 'withArray', but a terminator indicates where the array ends -- withArray0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b withArray0 marker vals = withArrayLen0 marker vals . const -- |Like 'withArrayLen', but a terminator indicates where the array ends -- withArrayLen0 :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b withArrayLen0 marker vals f = allocaArray0 len $ \ptr -> do pokeArray0 marker ptr vals res <- f len ptr return res where len = length vals -- copying (argument order: destination, source) -- ------- -- |Copy the given number of elements from the second array (source) into the -- first array (destination); the copied areas may /not/ overlap -- copyArray :: Storable a => Ptr a -> Ptr a -> Int -> IO () copyArray = doCopy undefined where doCopy :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO () doCopy dummy dest src size = copyBytes dest src (size * sizeOf dummy) -- |Copy the given number of elements from the second array (source) into the -- first array (destination); the copied areas /may/ overlap -- moveArray :: Storable a => Ptr a -> Ptr a -> Int -> IO () moveArray = doMove undefined where doMove :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO () doMove dummy dest src size = moveBytes dest src (size * sizeOf dummy) -- finding the length -- ------------------ -- |Return the number of elements in an array, excluding the terminator -- lengthArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO Int lengthArray0 marker ptr = loop 0 where loop i = do val <- peekElemOff ptr i if val == marker then return i else loop (i+1) -- indexing -- -------- -- |Advance a pointer into an array by the given number of elements -- advancePtr :: Storable a => Ptr a -> Int -> Ptr a advancePtr = doAdvance undefined where doAdvance :: Storable a' => a' -> Ptr a' -> Int -> Ptr a' doAdvance dummy ptr i = ptr `plusPtr` (i * sizeOf dummy) hugs98-plus-Sep2006/packages/base/Foreign/Marshal/Error.hs0000644006511100651110000000505110504340221022050 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Marshal.Error -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- Routines for testing return values and raising a 'userError' exception -- in case of values indicating an error state. -- ----------------------------------------------------------------------------- module Foreign.Marshal.Error ( throwIf, -- :: (a -> Bool) -> (a -> String) -> IO a -> IO a throwIf_, -- :: (a -> Bool) -> (a -> String) -> IO a -> IO () throwIfNeg, -- :: (Ord a, Num a) -- => (a -> String) -> IO a -> IO a throwIfNeg_, -- :: (Ord a, Num a) -- => (a -> String) -> IO a -> IO () throwIfNull, -- :: String -> IO (Ptr a) -> IO (Ptr a) -- Discard return value -- void -- IO a -> IO () ) where import Foreign.Ptr #ifdef __GLASGOW_HASKELL__ #ifdef __HADDOCK__ import Data.Bool import System.IO.Error #endif import GHC.Base import GHC.Num import GHC.IOBase #endif -- exported functions -- ------------------ -- |Execute an 'IO' action, throwing a 'userError' if the predicate yields -- 'True' when applied to the result returned by the 'IO' action. -- If no exception is raised, return the result of the computation. -- throwIf :: (a -> Bool) -- ^ error condition on the result of the 'IO' action -> (a -> String) -- ^ computes an error message from erroneous results -- of the 'IO' action -> IO a -- ^ the 'IO' action to be executed -> IO a throwIf pred msgfct act = do res <- act (if pred res then ioError . userError . msgfct else return) res -- |Like 'throwIf', but discarding the result -- throwIf_ :: (a -> Bool) -> (a -> String) -> IO a -> IO () throwIf_ pred msgfct act = void $ throwIf pred msgfct act -- |Guards against negative result values -- throwIfNeg :: (Ord a, Num a) => (a -> String) -> IO a -> IO a throwIfNeg = throwIf (< 0) -- |Like 'throwIfNeg', but discarding the result -- throwIfNeg_ :: (Ord a, Num a) => (a -> String) -> IO a -> IO () throwIfNeg_ = throwIf_ (< 0) -- |Guards against null pointers -- throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a) throwIfNull = throwIf (== nullPtr) . const -- |Discard the return value of an 'IO' action -- void :: IO a -> IO () void act = act >> return () hugs98-plus-Sep2006/packages/base/Foreign/Marshal/Pool.hs0000644006511100651110000001705010504340221021672 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} -------------------------------------------------------------------------------- -- | -- Module : Foreign.Marshal.Pool -- Copyright : (c) Sven Panne 2002-2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : sven.panne@aedion.de -- Stability : provisional -- Portability : portable -- -- This module contains support for pooled memory management. Under this scheme, -- (re-)allocations belong to a given pool, and everything in a pool is -- deallocated when the pool itself is deallocated. This is useful when -- 'Foreign.Marshal.Alloc.alloca' with its implicit allocation and deallocation -- is not flexible enough, but explicit uses of 'Foreign.Marshal.Alloc.malloc' -- and 'free' are too awkward. -- -------------------------------------------------------------------------------- module Foreign.Marshal.Pool ( -- * Pool management Pool, newPool, -- :: IO Pool freePool, -- :: Pool -> IO () withPool, -- :: (Pool -> IO b) -> IO b -- * (Re-)Allocation within a pool pooledMalloc, -- :: Storable a => Pool -> IO (Ptr a) pooledMallocBytes, -- :: Pool -> Int -> IO (Ptr a) pooledRealloc, -- :: Storable a => Pool -> Ptr a -> IO (Ptr a) pooledReallocBytes, -- :: Pool -> Ptr a -> Int -> IO (Ptr a) pooledMallocArray, -- :: Storable a => Pool -> Int -> IO (Ptr a) pooledMallocArray0, -- :: Storable a => Pool -> Int -> IO (Ptr a) pooledReallocArray, -- :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a) pooledReallocArray0, -- :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a) -- * Combined allocation and marshalling pooledNew, -- :: Storable a => Pool -> a -> IO (Ptr a) pooledNewArray, -- :: Storable a => Pool -> [a] -> IO (Ptr a) pooledNewArray0 -- :: Storable a => Pool -> a -> [a] -> IO (Ptr a) ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base ( Int, Monad(..), (.), not ) import GHC.Err ( undefined ) import GHC.Exception ( block, unblock, throw, catchException ) import GHC.IOBase ( IO, IORef, newIORef, readIORef, writeIORef, ) import GHC.List ( elem, length ) import GHC.Num ( Num(..) ) #else import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) #if defined(__NHC__) import IO ( bracket ) #else import Control.Exception ( bracket ) #endif #endif import Control.Monad ( liftM ) import Data.List ( delete ) import Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free ) import Foreign.Marshal.Array ( pokeArray, pokeArray0 ) import Foreign.Marshal.Error ( throwIf ) import Foreign.Ptr ( Ptr, castPtr ) import Foreign.Storable ( Storable(sizeOf, poke) ) -------------------------------------------------------------------------------- -- To avoid non-H98 stuff like existentially quantified data constructors, we -- simply use pointers to () below. Not very nice, but... -- | A memory pool. newtype Pool = Pool (IORef [Ptr ()]) -- | Allocate a fresh memory pool. newPool :: IO Pool newPool = liftM Pool (newIORef []) -- | Deallocate a memory pool and everything which has been allocated in the -- pool itself. freePool :: Pool -> IO () freePool (Pool pool) = readIORef pool >>= freeAll where freeAll [] = return () freeAll (p:ps) = free p >> freeAll ps -- | Execute an action with a fresh memory pool, which gets automatically -- deallocated (including its contents) after the action has finished. withPool :: (Pool -> IO b) -> IO b #ifdef __GLASGOW_HASKELL__ withPool act = -- ATTENTION: cut-n-paste from Control.Exception below! block (do pool <- newPool val <- catchException (unblock (act pool)) (\e -> do freePool pool; throw e) freePool pool return val) #else withPool = bracket newPool freePool #endif -------------------------------------------------------------------------------- -- | Allocate space for storable type in the given pool. The size of the area -- allocated is determined by the 'sizeOf' method from the instance of -- 'Storable' for the appropriate type. pooledMalloc :: Storable a => Pool -> IO (Ptr a) pooledMalloc = pm undefined where pm :: Storable a' => a' -> Pool -> IO (Ptr a') pm dummy pool = pooledMallocBytes pool (sizeOf dummy) -- | Allocate the given number of bytes of storage in the pool. pooledMallocBytes :: Pool -> Int -> IO (Ptr a) pooledMallocBytes (Pool pool) size = do ptr <- mallocBytes size ptrs <- readIORef pool writeIORef pool (ptr:ptrs) return (castPtr ptr) -- | Adjust the storage area for an element in the pool to the given size of -- the required type. pooledRealloc :: Storable a => Pool -> Ptr a -> IO (Ptr a) pooledRealloc = pr undefined where pr :: Storable a' => a' -> Pool -> Ptr a' -> IO (Ptr a') pr dummy pool ptr = pooledReallocBytes pool ptr (sizeOf dummy) -- | Adjust the storage area for an element in the pool to the given size. pooledReallocBytes :: Pool -> Ptr a -> Int -> IO (Ptr a) pooledReallocBytes (Pool pool) ptr size = do let cPtr = castPtr ptr throwIf (not . (cPtr `elem`)) (\_ -> "pointer not in pool") (readIORef pool) newPtr <- reallocBytes cPtr size ptrs <- readIORef pool writeIORef pool (newPtr : delete cPtr ptrs) return (castPtr newPtr) -- | Allocate storage for the given number of elements of a storable type in the -- pool. pooledMallocArray :: Storable a => Pool -> Int -> IO (Ptr a) pooledMallocArray = pma undefined where pma :: Storable a' => a' -> Pool -> Int -> IO (Ptr a') pma dummy pool size = pooledMallocBytes pool (size * sizeOf dummy) -- | Allocate storage for the given number of elements of a storable type in the -- pool, but leave room for an extra element to signal the end of the array. pooledMallocArray0 :: Storable a => Pool -> Int -> IO (Ptr a) pooledMallocArray0 pool size = pooledMallocArray pool (size + 1) -- | Adjust the size of an array in the given pool. pooledReallocArray :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a) pooledReallocArray = pra undefined where pra :: Storable a' => a' -> Pool -> Ptr a' -> Int -> IO (Ptr a') pra dummy pool ptr size = pooledReallocBytes pool ptr (size * sizeOf dummy) -- | Adjust the size of an array with an end marker in the given pool. pooledReallocArray0 :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a) pooledReallocArray0 pool ptr size = pooledReallocArray pool ptr (size + 1) -------------------------------------------------------------------------------- -- | Allocate storage for a value in the given pool and marshal the value into -- this storage. pooledNew :: Storable a => Pool -> a -> IO (Ptr a) pooledNew pool val = do ptr <- pooledMalloc pool poke ptr val return ptr -- | Allocate consecutive storage for a list of values in the given pool and -- marshal these values into it. pooledNewArray :: Storable a => Pool -> [a] -> IO (Ptr a) pooledNewArray pool vals = do ptr <- pooledMallocArray pool (length vals) pokeArray ptr vals return ptr -- | Allocate consecutive storage for a list of values in the given pool and -- marshal these values into it, terminating the end with the given marker. pooledNewArray0 :: Storable a => Pool -> a -> [a] -> IO (Ptr a) pooledNewArray0 pool marker vals = do ptr <- pooledMallocArray0 pool (length vals) pokeArray0 marker ptr vals return ptr hugs98-plus-Sep2006/packages/base/Foreign/Marshal/Utils.hs0000644006511100651110000001272210504340225022066 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Marshal.Utils -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- Utilities for primitive marshaling -- ----------------------------------------------------------------------------- module Foreign.Marshal.Utils ( -- * General marshalling utilities -- ** Combined allocation and marshalling -- with, -- :: Storable a => a -> (Ptr a -> IO b) -> IO b new, -- :: Storable a => a -> IO (Ptr a) -- ** Marshalling of Boolean values (non-zero corresponds to 'True') -- fromBool, -- :: Num a => Bool -> a toBool, -- :: Num a => a -> Bool -- ** Marshalling of Maybe values -- maybeNew, -- :: ( a -> IO (Ptr a)) -- -> (Maybe a -> IO (Ptr a)) maybeWith, -- :: ( a -> (Ptr b -> IO c) -> IO c) -- -> (Maybe a -> (Ptr b -> IO c) -> IO c) maybePeek, -- :: (Ptr a -> IO b ) -- -> (Ptr a -> IO (Maybe b)) -- ** Marshalling lists of storable objects -- withMany, -- :: (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res -- ** Haskellish interface to memcpy and memmove -- | (argument order: destination, source) -- copyBytes, -- :: Ptr a -> Ptr a -> Int -> IO () moveBytes, -- :: Ptr a -> Ptr a -> Int -> IO () ) where import Data.Maybe import Foreign.Ptr ( Ptr, nullPtr ) import Foreign.Storable ( Storable(poke) ) import Foreign.C.Types ( CSize ) import Foreign.Marshal.Alloc ( malloc, alloca ) #ifdef __GLASGOW_HASKELL__ import GHC.IOBase import GHC.Real ( fromIntegral ) import GHC.Num import GHC.Base #endif #ifdef __NHC__ import Foreign.C.Types ( CInt(..) ) #endif -- combined allocation and marshalling -- ----------------------------------- -- |Allocate a block of memory and marshal a value into it -- (the combination of 'malloc' and 'poke'). -- The size of the area allocated is determined by the 'Foreign.Storable.sizeOf' -- method from the instance of 'Storable' for the appropriate type. -- -- The memory may be deallocated using 'Foreign.Marshal.Alloc.free' or -- 'Foreign.Marshal.Alloc.finalizerFree' when no longer required. -- new :: Storable a => a -> IO (Ptr a) new val = do ptr <- malloc poke ptr val return ptr -- |@'with' val f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory into which -- @val@ has been marshalled (the combination of 'alloca' and 'poke'). -- -- The memory is freed when @f@ terminates (either normally or via an -- exception), so the pointer passed to @f@ must /not/ be used after this. -- with :: Storable a => a -> (Ptr a -> IO b) -> IO b with val f = alloca $ \ptr -> do poke ptr val res <- f ptr return res -- marshalling of Boolean values (non-zero corresponds to 'True') -- ----------------------------- -- |Convert a Haskell 'Bool' to its numeric representation -- fromBool :: Num a => Bool -> a fromBool False = 0 fromBool True = 1 -- |Convert a Boolean in numeric representation to a Haskell value -- toBool :: Num a => a -> Bool toBool = (/= 0) -- marshalling of Maybe values -- --------------------------- -- |Allocate storage and marshall a storable value wrapped into a 'Maybe' -- -- * the 'nullPtr' is used to represent 'Nothing' -- maybeNew :: ( a -> IO (Ptr a)) -> (Maybe a -> IO (Ptr a)) maybeNew = maybe (return nullPtr) -- |Converts a @withXXX@ combinator into one marshalling a value wrapped -- into a 'Maybe', using 'nullPtr' to represent 'Nothing'. -- maybeWith :: ( a -> (Ptr b -> IO c) -> IO c) -> (Maybe a -> (Ptr b -> IO c) -> IO c) maybeWith = maybe ($ nullPtr) -- |Convert a peek combinator into a one returning 'Nothing' if applied to a -- 'nullPtr' -- maybePeek :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b) maybePeek peek ptr | ptr == nullPtr = return Nothing | otherwise = do a <- peek ptr; return (Just a) -- marshalling lists of storable objects -- ------------------------------------- -- |Replicates a @withXXX@ combinator over a list of objects, yielding a list of -- marshalled objects -- withMany :: (a -> (b -> res) -> res) -- withXXX combinator for one object -> [a] -- storable objects -> ([b] -> res) -- action on list of marshalled obj.s -> res withMany _ [] f = f [] withMany withFoo (x:xs) f = withFoo x $ \x' -> withMany withFoo xs (\xs' -> f (x':xs')) -- Haskellish interface to memcpy and memmove -- ------------------------------------------ -- |Copies the given number of bytes from the second area (source) into the -- first (destination); the copied areas may /not/ overlap -- copyBytes :: Ptr a -> Ptr a -> Int -> IO () copyBytes dest src size = memcpy dest src (fromIntegral size) -- |Copies the given number of elements from the second area (source) into the -- first (destination); the copied areas /may/ overlap -- moveBytes :: Ptr a -> Ptr a -> Int -> IO () moveBytes dest src size = memmove dest src (fromIntegral size) -- auxilliary routines -- ------------------- -- |Basic C routines needed for memory copying -- foreign import ccall unsafe "string.h" memcpy :: Ptr a -> Ptr a -> CSize -> IO () foreign import ccall unsafe "string.h" memmove :: Ptr a -> Ptr a -> CSize -> IO () hugs98-plus-Sep2006/packages/base/Foreign/C.hs0000644006511100651110000000125710504340221017556 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.C -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- Bundles the C specific FFI library functionality -- ----------------------------------------------------------------------------- module Foreign.C ( module Foreign.C.Types , module Foreign.C.String , module Foreign.C.Error ) where import Foreign.C.Types import Foreign.C.String import Foreign.C.Error hugs98-plus-Sep2006/packages/base/Foreign/Concurrent.hs0000644006511100651110000000411310504340221021510 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Concurrent -- Copyright : (c) The University of Glasgow 2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- FFI datatypes and operations that use or require concurrency (GHC only). -- ----------------------------------------------------------------------------- module Foreign.Concurrent ( -- * Concurrency-based 'ForeignPtr' operations -- | These functions generalize their namesakes in the portable -- "Foreign.ForeignPtr" module by allowing arbitrary 'IO' actions -- as finalizers. These finalizers necessarily run in a separate -- thread, cf. /Destructors, Finalizers and Synchronization/, -- by Hans Boehm, /POPL/, 2003. newForeignPtr, addForeignPtrFinalizer, ) where #ifdef __GLASGOW_HASKELL__ import GHC.IOBase ( IO ) import GHC.Ptr ( Ptr ) import GHC.ForeignPtr ( ForeignPtr ) import qualified GHC.ForeignPtr #endif #ifdef __GLASGOW_HASKELL__ newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a) -- ^Turns a plain memory reference into a foreign object by associating -- a finalizer - given by the monadic operation - with the reference. -- The finalizer will be executed after the last reference to the -- foreign object is dropped. Note that there is no guarantee on how -- soon the finalizer is executed after the last reference was dropped; -- this depends on the details of the Haskell storage manager. The only -- guarantee is that the finalizer runs before the program terminates. newForeignPtr = GHC.ForeignPtr.newConcForeignPtr addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO () -- ^This function adds a finalizer to the given 'ForeignPtr'. -- The finalizer will run after the last reference to the foreign object -- is dropped, but /before/ all previously registered finalizers for the -- same object. addForeignPtrFinalizer = GHC.ForeignPtr.addForeignPtrConcFinalizer #endif hugs98-plus-Sep2006/packages/base/Foreign/ForeignPtr.hs0000644006511100651110000001470710504340222021460 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.ForeignPtr -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- The 'ForeignPtr' type and operations. This module is part of the -- Foreign Function Interface (FFI) and will usually be imported via -- the "Foreign" module. -- ----------------------------------------------------------------------------- module Foreign.ForeignPtr ( -- * Finalised data pointers ForeignPtr , FinalizerPtr #if defined(__HUGS__) || defined(__GLASGOW_HASKELL__) , FinalizerEnvPtr #endif -- ** Basic operations , newForeignPtr , newForeignPtr_ , addForeignPtrFinalizer #if defined(__HUGS__) || defined(__GLASGOW_HASKELL__) , newForeignPtrEnv , addForeignPtrFinalizerEnv #endif , withForeignPtr #ifdef __GLASGOW_HASKELL__ , finalizeForeignPtr #endif -- ** Low-level operations , unsafeForeignPtrToPtr , touchForeignPtr , castForeignPtr -- ** Allocating managed memory , mallocForeignPtr , mallocForeignPtrBytes , mallocForeignPtrArray , mallocForeignPtrArray0 ) where import Foreign.Ptr #ifdef __NHC__ import NHC.FFI ( ForeignPtr , FinalizerPtr , newForeignPtr , newForeignPtr_ , addForeignPtrFinalizer , withForeignPtr , unsafeForeignPtrToPtr , touchForeignPtr , castForeignPtr , Storable(sizeOf) , malloc, mallocBytes, finalizerFree ) #endif #ifdef __HUGS__ import Hugs.ForeignPtr #endif #ifndef __NHC__ import Foreign.Storable ( Storable(sizeOf) ) #endif #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.IOBase import GHC.Num import GHC.Err ( undefined ) import GHC.ForeignPtr #endif #if !defined(__NHC__) && !defined(__GLASGOW_HASKELL__) import Foreign.Marshal.Alloc ( malloc, mallocBytes, finalizerFree ) instance Eq (ForeignPtr a) where p == q = unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q instance Ord (ForeignPtr a) where compare p q = compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q) instance Show (ForeignPtr a) where showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f) #endif #ifndef __NHC__ newForeignPtr :: FinalizerPtr a -> Ptr a -> IO (ForeignPtr a) -- ^Turns a plain memory reference into a foreign pointer, and -- associates a finaliser with the reference. The finaliser will be executed -- after the last reference to the foreign object is dropped. Note that there -- is no guarantee on how soon the finaliser is executed after the last -- reference was dropped; this depends on the details of the Haskell storage -- manager. The only guarantee is that the finaliser runs before the program -- terminates. newForeignPtr finalizer p = do fObj <- newForeignPtr_ p addForeignPtrFinalizer finalizer fObj return fObj withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -- ^This is a way to look at the pointer living inside a -- foreign object. This function takes a function which is -- applied to that pointer. The resulting 'IO' action is then -- executed. The foreign object is kept alive at least during -- the whole action, even if it is not used directly -- inside. Note that it is not safe to return the pointer from -- the action and use it after the action completes. All uses -- of the pointer should be inside the -- 'withForeignPtr' bracket. The reason for -- this unsafeness is the same as for -- 'unsafeForeignPtrToPtr' below: the finalizer -- may run earlier than expected, because the compiler can only -- track usage of the 'ForeignPtr' object, not -- a 'Ptr' object made from it. -- -- This function is normally used for marshalling data to -- or from the object pointed to by the -- 'ForeignPtr', using the operations from the -- 'Storable' class. withForeignPtr fo io = do r <- io (unsafeForeignPtrToPtr fo) touchForeignPtr fo return r #endif /* ! __NHC__ */ #if defined(__HUGS__) || defined(__GLASGOW_HASKELL__) -- | This variant of 'newForeignPtr' adds a finalizer that expects an -- environment in addition to the finalized pointer. The environment -- that will be passed to the finalizer is fixed by the second argument to -- 'newForeignPtrEnv'. newForeignPtrEnv :: FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a) newForeignPtrEnv finalizer env p = do fObj <- newForeignPtr_ p addForeignPtrFinalizerEnv finalizer env fObj return fObj #endif /* __HUGS__ */ #ifdef __GLASGOW_HASKELL__ type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> IO ()) -- | like 'addForeignPtrFinalizerEnv' but allows the finalizer to be -- passed an additional environment parameter to be passed to the -- finalizer. The environment passed to the finalizer is fixed by the -- second argument to 'addForeignPtrFinalizerEnv' addForeignPtrFinalizerEnv :: FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO () addForeignPtrFinalizerEnv finalizer env fptr = addForeignPtrConcFinalizer fptr (mkFinalizerEnv finalizer env (unsafeForeignPtrToPtr fptr)) foreign import ccall "dynamic" mkFinalizerEnv :: FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO () #endif #ifndef __GLASGOW_HASKELL__ mallocForeignPtr :: Storable a => IO (ForeignPtr a) mallocForeignPtr = do r <- malloc newForeignPtr finalizerFree r mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) mallocForeignPtrBytes n = do r <- mallocBytes n newForeignPtr finalizerFree r #endif /* !__GLASGOW_HASKELL__ */ -- | This function is similar to 'Foreign.Marshal.Array.mallocArray', -- but yields a memory area that has a finalizer attached that releases -- the memory area. As with 'mallocForeignPtr', it is not guaranteed that -- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'. mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a) mallocForeignPtrArray = doMalloc undefined where doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) doMalloc dummy size = mallocForeignPtrBytes (size * sizeOf dummy) -- | This function is similar to 'Foreign.Marshal.Array.mallocArray0', -- but yields a memory area that has a finalizer attached that releases -- the memory area. As with 'mallocForeignPtr', it is not guaranteed that -- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'. mallocForeignPtrArray0 :: Storable a => Int -> IO (ForeignPtr a) mallocForeignPtrArray0 size = mallocForeignPtrArray (size + 1) hugs98-plus-Sep2006/packages/base/Foreign/Marshal.hs0000644006511100651110000000152410504340221020760 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Marshal -- Copyright : (c) The FFI task force 2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- Marshalling support -- ----------------------------------------------------------------------------- module Foreign.Marshal ( module Foreign.Marshal.Alloc , module Foreign.Marshal.Array , module Foreign.Marshal.Error , module Foreign.Marshal.Pool , module Foreign.Marshal.Utils ) where import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Marshal.Error import Foreign.Marshal.Pool import Foreign.Marshal.Utils hugs98-plus-Sep2006/packages/base/Foreign/Ptr.hs0000644006511100651110000000775710504340222020155 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Ptr -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- This module provides typed pointers to foreign data. It is part -- of the Foreign Function Interface (FFI) and will normally be -- imported via the "Foreign" module. -- ----------------------------------------------------------------------------- module Foreign.Ptr ( -- * Data pointers Ptr, -- data Ptr a nullPtr, -- :: Ptr a castPtr, -- :: Ptr a -> Ptr b plusPtr, -- :: Ptr a -> Int -> Ptr b alignPtr, -- :: Ptr a -> Int -> Ptr a minusPtr, -- :: Ptr a -> Ptr b -> Int -- * Function pointers FunPtr, -- data FunPtr a nullFunPtr, -- :: FunPtr a castFunPtr, -- :: FunPtr a -> FunPtr b castFunPtrToPtr, -- :: FunPtr a -> Ptr b castPtrToFunPtr, -- :: Ptr a -> FunPtr b freeHaskellFunPtr, -- :: FunPtr a -> IO () -- Free the function pointer created by foreign export dynamic. #ifndef __NHC__ -- * Integral types with lossless conversion to and from pointers IntPtr, ptrToIntPtr, intPtrToPtr, WordPtr, ptrToWordPtr, wordPtrToPtr #endif ) where #ifdef __GLASGOW_HASKELL__ import GHC.Ptr import GHC.IOBase import GHC.Base import GHC.Num import GHC.Read import GHC.Real import GHC.Show import GHC.Enum import GHC.Word ( Word(..) ) import Data.Int import Data.Word #else import Foreign.C.Types #endif import Control.Monad ( liftM ) import Data.Bits import Data.Typeable ( Typeable(..), mkTyCon, mkTyConApp ) import Foreign.Storable ( Storable(..) ) #ifdef __NHC__ import NHC.FFI ( Ptr , nullPtr , castPtr , plusPtr , alignPtr , minusPtr , FunPtr , nullFunPtr , castFunPtr , castFunPtrToPtr , castPtrToFunPtr , freeHaskellFunPtr ) #endif #ifdef __HUGS__ import Hugs.Ptr #endif #ifdef __GLASGOW_HASKELL__ -- | Release the storage associated with the given 'FunPtr', which -- must have been obtained from a wrapper stub. This should be called -- whenever the return value from a foreign import wrapper function is -- no longer required; otherwise, the storage it uses will leak. foreign import ccall unsafe "freeHaskellFunctionPtr" freeHaskellFunPtr :: FunPtr a -> IO () #endif #ifndef __NHC__ # include "HsBaseConfig.h" # include "CTypes.h" # ifdef __GLASGOW_HASKELL__ -- | An unsigned integral type that can be losslessly converted to and from -- @Ptr@. INTEGRAL_TYPE(WordPtr,tyConWordPtr,"WordPtr",Word) -- Word and Int are guaranteed pointer-sized in GHC -- | A signed integral type that can be losslessly converted to and from -- @Ptr@. INTEGRAL_TYPE(IntPtr,tyConIntPtr,"IntPtr",Int) -- Word and Int are guaranteed pointer-sized in GHC -- | casts a @Ptr@ to a @WordPtr@ ptrToWordPtr :: Ptr a -> WordPtr ptrToWordPtr (Ptr a#) = WordPtr (W# (int2Word# (addr2Int# a#))) -- | casts a @WordPtr@ to a @Ptr@ wordPtrToPtr :: WordPtr -> Ptr a wordPtrToPtr (WordPtr (W# w#)) = Ptr (int2Addr# (word2Int# w#)) -- | casts a @Ptr@ to an @IntPtr@ ptrToIntPtr :: Ptr a -> IntPtr ptrToIntPtr (Ptr a#) = IntPtr (I# (addr2Int# a#)) -- | casts an @IntPtr@ to a @Ptr@ intPtrToPtr :: IntPtr -> Ptr a intPtrToPtr (IntPtr (I# i#)) = Ptr (int2Addr# i#) # else /* !__GLASGOW_HASKELL__ */ INTEGRAL_TYPE(WordPtr,tyConWordPtr,"WordPtr",CUIntPtr) INTEGRAL_TYPE(IntPtr,tyConIntPtr,"IntPtr",CIntPtr) {-# CFILES cbits/PrelIOUtils.c #-} foreign import ccall unsafe "__hscore_to_uintptr" ptrToWordPtr :: Ptr a -> WordPtr foreign import ccall unsafe "__hscore_from_uintptr" wordPtrToPtr :: WordPtr -> Ptr a foreign import ccall unsafe "__hscore_to_intptr" ptrToIntPtr :: Ptr a -> IntPtr foreign import ccall unsafe "__hscore_from_intptr" intPtrToPtr :: IntPtr -> Ptr a # endif /* !__GLASGOW_HASKELL__ */ #endif /* !__NHC_ */ hugs98-plus-Sep2006/packages/base/Foreign/StablePtr.hs0000644006511100651110000000352610504340221021275 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.StablePtr -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- This module is part of the Foreign Function Interface (FFI) and will usually -- be imported via the module "Foreign". -- ----------------------------------------------------------------------------- module Foreign.StablePtr ( -- * Stable references to Haskell values StablePtr -- abstract , newStablePtr -- :: a -> IO (StablePtr a) , deRefStablePtr -- :: StablePtr a -> IO a , freeStablePtr -- :: StablePtr a -> IO () , castStablePtrToPtr -- :: StablePtr a -> Ptr () , castPtrToStablePtr -- :: Ptr () -> StablePtr a , -- ** The C-side interface -- $cinterface ) where #ifdef __GLASGOW_HASKELL__ import GHC.Stable import GHC.Err #endif #ifdef __HUGS__ import Hugs.StablePtr #endif #ifdef __NHC__ import NHC.FFI ( StablePtr , newStablePtr , deRefStablePtr , freeStablePtr , castStablePtrToPtr , castPtrToStablePtr ) #endif -- $cinterface -- -- The following definition is available to C programs inter-operating with -- Haskell code when including the header @HsFFI.h@. -- -- > typedef void *HsStablePtr; /* C representation of a StablePtr */ -- -- Note that no assumptions may be made about the values representing stable -- pointers. In fact, they need not even be valid memory addresses. The only -- guarantee provided is that if they are passed back to Haskell land, the -- function 'deRefStablePtr' will be able to reconstruct the -- Haskell value referred to by the stable pointer. hugs98-plus-Sep2006/packages/base/Foreign/Storable.hs0000644006511100651110000002032510504340222021145 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Storable -- Copyright : (c) The FFI task force 2001 -- License : see libraries/base/LICENSE -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- The module "Foreign.Storable" provides most elementary support for -- marshalling and is part of the language-independent portion of the -- Foreign Function Interface (FFI), and will normally be imported via -- the "Foreign" module. -- ----------------------------------------------------------------------------- module Foreign.Storable ( Storable( sizeOf, -- :: a -> Int alignment, -- :: a -> Int peekElemOff, -- :: Ptr a -> Int -> IO a pokeElemOff, -- :: Ptr a -> Int -> a -> IO () peekByteOff, -- :: Ptr b -> Int -> IO a pokeByteOff, -- :: Ptr b -> Int -> a -> IO () peek, -- :: Ptr a -> IO a poke) -- :: Ptr a -> a -> IO () ) where #ifdef __NHC__ import NHC.FFI (Storable(..),Ptr,FunPtr,StablePtr ,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64) #else import Control.Monad ( liftM ) #include "MachDeps.h" #include "HsBaseConfig.h" #ifdef __GLASGOW_HASKELL__ import GHC.Storable import GHC.Stable ( StablePtr ) import GHC.Num import GHC.Int import GHC.Word import GHC.Stable import GHC.Ptr import GHC.Float import GHC.Err import GHC.IOBase import GHC.Base #else import Data.Int import Data.Word import Foreign.StablePtr #endif #ifdef __HUGS__ import Hugs.Prelude import Hugs.Ptr import Hugs.Storable #endif {- | The member functions of this class facilitate writing values of primitive types to raw memory (which may have been allocated with the above mentioned routines) and reading values from blocks of raw memory. The class, furthermore, includes support for computing the storage requirements and alignment restrictions of storable types. Memory addresses are represented as values of type @'Ptr' a@, for some @a@ which is an instance of class 'Storable'. The type argument to 'Ptr' helps provide some valuable type safety in FFI code (you can\'t mix pointers of different types without an explicit cast), while helping the Haskell type system figure out which marshalling method is needed for a given pointer. All marshalling between Haskell and a foreign language ultimately boils down to translating Haskell data structures into the binary representation of a corresponding data structure of the foreign language and vice versa. To code this marshalling in Haskell, it is necessary to manipulate primitive data types stored in unstructured memory blocks. The class 'Storable' facilitates this manipulation on all types for which it is instantiated, which are the standard basic types of Haskell, the fixed size @Int@ types ('Int8', 'Int16', 'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16', 'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types", as well as 'Ptr'. Minimal complete definition: 'sizeOf', 'alignment', one of 'peek', 'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and 'pokeByteOff'. -} class Storable a where sizeOf :: a -> Int -- ^ Computes the storage requirements (in bytes) of the argument. -- The value of the argument is not used. alignment :: a -> Int -- ^ Computes the alignment constraint of the argument. An -- alignment constraint @x@ is fulfilled by any address divisible -- by @x@. The value of the argument is not used. peekElemOff :: Ptr a -> Int -> IO a -- ^ Read a value from a memory area regarded as an array -- of values of the same kind. The first argument specifies -- the start address of the array and the second the index into -- the array (the first element of the array has index -- @0@). The following equality holds, -- -- > peekElemOff addr idx = IOExts.fixIO $ \result -> -- > peek (addr `plusPtr` (idx * sizeOf result)) -- -- Note that this is only a specification, not -- necessarily the concrete implementation of the -- function. pokeElemOff :: Ptr a -> Int -> a -> IO () -- ^ Write a value to a memory area regarded as an array of -- values of the same kind. The following equality holds: -- -- > pokeElemOff addr idx x = -- > poke (addr `plusPtr` (idx * sizeOf x)) x peekByteOff :: Ptr b -> Int -> IO a -- ^ Read a value from a memory location given by a base -- address and offset. The following equality holds: -- -- > peekByteOff addr off = peek (addr `plusPtr` off) pokeByteOff :: Ptr b -> Int -> a -> IO () -- ^ Write a value to a memory location given by a base -- address and offset. The following equality holds: -- -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x peek :: Ptr a -> IO a -- ^ Read a value from the given memory location. -- -- Note that the peek and poke functions might require properly -- aligned addresses to function correctly. This is architecture -- dependent; thus, portable code should ensure that when peeking or -- poking values of some type @a@, the alignment -- constraint for @a@, as given by the function -- 'alignment' is fulfilled. poke :: Ptr a -> a -> IO () -- ^ Write the given value to the given memory location. Alignment -- restrictions might apply; see 'peek'. -- circular default instances #ifdef __GLASGOW_HASKELL__ peekElemOff = peekElemOff_ undefined where peekElemOff_ :: a -> Ptr a -> Int -> IO a peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef) #else peekElemOff ptr off = peekByteOff ptr (off * sizeOfPtr ptr undefined) #endif pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val peekByteOff ptr off = peek (ptr `plusPtr` off) pokeByteOff ptr off = poke (ptr `plusPtr` off) peek ptr = peekElemOff ptr 0 poke ptr = pokeElemOff ptr 0 #ifndef __GLASGOW_HASKELL__ sizeOfPtr :: Storable a => Ptr a -> a -> Int sizeOfPtr px x = sizeOf x #endif -- System-dependent, but rather obvious instances instance Storable Bool where sizeOf _ = sizeOf (undefined::HTYPE_INT) alignment _ = alignment (undefined::HTYPE_INT) peekElemOff p i = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT) #define STORABLE(T,size,align,read,write) \ instance Storable (T) where { \ sizeOf _ = size; \ alignment _ = align; \ peekElemOff = read; \ pokeElemOff = write } #ifdef __GLASGOW_HASKELL__ STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32, readWideCharOffPtr,writeWideCharOffPtr) #elif defined(__HUGS__) STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR, readCharOffPtr,writeCharOffPtr) #endif STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT, readIntOffPtr,writeIntOffPtr) #ifndef __NHC__ STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD, readWordOffPtr,writeWordOffPtr) #endif STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR, readPtrOffPtr,writePtrOffPtr) STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR, readFunPtrOffPtr,writeFunPtrOffPtr) STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR, readStablePtrOffPtr,writeStablePtrOffPtr) STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT, readFloatOffPtr,writeFloatOffPtr) STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE, readDoubleOffPtr,writeDoubleOffPtr) STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8, readWord8OffPtr,writeWord8OffPtr) STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16, readWord16OffPtr,writeWord16OffPtr) STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32, readWord32OffPtr,writeWord32OffPtr) STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64, readWord64OffPtr,writeWord64OffPtr) STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8, readInt8OffPtr,writeInt8OffPtr) STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16, readInt16OffPtr,writeInt16OffPtr) STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32, readInt32OffPtr,writeInt32OffPtr) STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64, readInt64OffPtr,writeInt64OffPtr) #endif hugs98-plus-Sep2006/packages/base/GHC/0000755006511100651110000000000010504340226016050 5ustar rossrosshugs98-plus-Sep2006/packages/base/GHC/Err.lhs-boot0000644006511100651110000000156110504340221020247 0ustar rossross\begin{code} {-# OPTIONS -fno-implicit-prelude #-} --------------------------------------------------------------------------- -- Ghc.Err.hs-boot --------------------------------------------------------------------------- module GHC.Err( error, divZeroError ) where -- The type signature for 'error' is a gross hack. -- First, we can't give an accurate type for error, because it mentions -- an open type variable. -- Second, we can't even say error :: [Char] -> a, because Char is defined -- in GHC.Base, and that would make Err.lhs-boot mutually recursive -- with GHC.Base. -- Fortunately it doesn't matter what type we give here because the -- compiler will use its wired-in version. But we have -- to mention 'error' so that it gets exported from this .hi-boot -- file. error :: a -- divide by zero is needed quite early divZeroError :: a \end{code} hugs98-plus-Sep2006/packages/base/GHC/Arr.lhs0000644006511100651110000006007310504340221017305 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Arr -- Copyright : (c) The University of Glasgow, 1994-2000 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- GHC\'s array implementation. -- ----------------------------------------------------------------------------- -- #hide module GHC.Arr where import {-# SOURCE #-} GHC.Err ( error ) import GHC.Enum import GHC.Num import GHC.ST import GHC.Base import GHC.List import GHC.Show infixl 9 !, // default () \end{code} %********************************************************* %* * \subsection{The @Ix@ class} %* * %********************************************************* \begin{code} -- | The 'Ix' class is used to map a contiguous subrange of values in -- a type onto integers. It is used primarily for array indexing -- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray"). -- -- The first argument @(l,u)@ of each of these operations is a pair -- specifying the lower and upper bounds of a contiguous subrange of values. -- -- An implementation is entitled to assume the following laws about these -- operations: -- -- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@ -- -- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@ -- -- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@ -- -- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@ -- -- Minimal complete instance: 'range', 'index' and 'inRange'. -- class (Ord a) => Ix a where -- | The list of values in the subrange defined by a bounding pair. range :: (a,a) -> [a] -- | The position of a subscript in the subrange. index :: (a,a) -> a -> Int -- | Like 'index', but without checking that the value is in range. unsafeIndex :: (a,a) -> a -> Int -- | Returns 'True' the given subscript lies in the range defined -- the bounding pair. inRange :: (a,a) -> a -> Bool -- | The size of the subrange defined by a bounding pair. rangeSize :: (a,a) -> Int -- | like 'rangeSize', but without checking that the upper bound is -- in range. unsafeRangeSize :: (a,a) -> Int -- Must specify one of index, unsafeIndex index b i | inRange b i = unsafeIndex b i | otherwise = error "Error in array index" unsafeIndex b i = index b i rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1 | otherwise = 0 -- This case is only here to -- check for an empty range -- NB: replacing (inRange b h) by (l <= h) fails for -- tuples. E.g. (1,2) <= (2,1) but the range is empty unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1 \end{code} Note that the following is NOT right rangeSize (l,h) | l <= h = index b h + 1 | otherwise = 0 Because it might be the case that l (a,a) -> a -> String -> b indexError rng i tp = error (showString "Ix{" . showString tp . showString "}.index: Index " . showParen True (showsPrec 0 i) . showString " out of range " $ showParen True (showsPrec 0 rng) "") ---------------------------------------------------------------------- instance Ix Char where {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = fromEnum i - fromEnum m index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Char" inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- instance Ix Int where {-# INLINE range #-} -- The INLINE stops the build in the RHS from getting inlined, -- so that callers can fuse with the result of range range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = i - m index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Int" {-# INLINE inRange #-} inRange (I# m,I# n) (I# i) = m <=# i && i <=# n ---------------------------------------------------------------------- instance Ix Integer where {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = fromInteger (i - m) index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Integer" inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- instance Ix Bool where -- as derived {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (l,_) i = fromEnum i - fromEnum l index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Bool" inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- instance Ix Ordering where -- as derived {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (l,_) i = fromEnum i - fromEnum l index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Ordering" inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- instance Ix () where {-# INLINE range #-} range ((), ()) = [()] {-# INLINE unsafeIndex #-} unsafeIndex ((), ()) () = 0 {-# INLINE inRange #-} inRange ((), ()) () = True {-# INLINE index #-} index b i = unsafeIndex b i ---------------------------------------------------------------------- instance (Ix a, Ix b) => Ix (a, b) where -- as derived {-# SPECIALISE instance Ix (Int,Int) #-} {- INLINE range #-} range ((l1,l2),(u1,u2)) = [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ] {- INLINE unsafeIndex #-} unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) = unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2 {- INLINE inRange #-} inRange ((l1,l2),(u1,u2)) (i1,i2) = inRange (l1,u1) i1 && inRange (l2,u2) i2 -- Default method for index ---------------------------------------------------------------------- instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where {-# SPECIALISE instance Ix (Int,Int,Int) #-} range ((l1,l2,l3),(u1,u2,u3)) = [(i1,i2,i3) | i1 <- range (l1,u1), i2 <- range (l2,u2), i3 <- range (l3,u3)] unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) = unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( unsafeIndex (l1,u1) i1)) inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) = inRange (l1,u1) i1 && inRange (l2,u2) i2 && inRange (l3,u3) i3 -- Default method for index ---------------------------------------------------------------------- instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where range ((l1,l2,l3,l4),(u1,u2,u3,u4)) = [(i1,i2,i3,i4) | i1 <- range (l1,u1), i2 <- range (l2,u2), i3 <- range (l3,u3), i4 <- range (l4,u4)] unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) = unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( unsafeIndex (l1,u1) i1))) inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) = inRange (l1,u1) i1 && inRange (l2,u2) i2 && inRange (l3,u3) i3 && inRange (l4,u4) i4 -- Default method for index instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) = [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1), i2 <- range (l2,u2), i3 <- range (l3,u3), i4 <- range (l4,u4), i5 <- range (l5,u5)] unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) = unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( unsafeIndex (l1,u1) i1)))) inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) = inRange (l1,u1) i1 && inRange (l2,u2) i2 && inRange (l3,u3) i3 && inRange (l4,u4) i4 && inRange (l5,u5) i5 -- Default method for index \end{code} %********************************************************* %* * \subsection{The @Array@ types} %* * %********************************************************* \begin{code} type IPr = (Int, Int) -- | The type of immutable non-strict (boxed) arrays -- with indices in @i@ and elements in @e@. data Ix i => Array i e = Array !i !i (Array# e) -- | Mutable, boxed, non-strict arrays in the 'ST' monad. The type -- arguments are as follows: -- -- * @s@: the state variable argument for the 'ST' type -- -- * @i@: the index type of the array (should be an instance of 'Ix') -- -- * @e@: the element type of the array. -- data STArray s i e = STArray !i !i (MutableArray# s e) -- No Ix context for STArray. They are stupid, -- and force an Ix context on the equality instance. -- Just pointer equality on mutable arrays: instance Eq (STArray s i e) where STArray _ _ arr1# == STArray _ _ arr2# = sameMutableArray# arr1# arr2# \end{code} %********************************************************* %* * \subsection{Operations on immutable arrays} %* * %********************************************************* \begin{code} {-# NOINLINE arrEleBottom #-} arrEleBottom :: a arrEleBottom = error "(Array.!): undefined array element" -- | Construct an array with the specified bounds and containing values -- for given indices within these bounds. -- -- The array is undefined (i.e. bottom) if any index in the list is -- out of bounds. The Haskell 98 Report further specifies that if any -- two associations in the list have the same index, the value at that -- index is undefined (i.e. bottom). However in GHC's implementation, -- the value at such an index is the value part of the last association -- with that index in the list. -- -- Because the indices must be checked for these errors, 'array' is -- strict in the bounds argument and in the indices of the association -- list, but nonstrict in the values. Thus, recurrences such as the -- following are possible: -- -- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]]) -- -- Not every index within the bounds of the array need appear in the -- association list, but the values associated with indices that do not -- appear will be undefined (i.e. bottom). -- -- If, in any dimension, the lower bound is greater than the upper bound, -- then the array is legal, but empty. Indexing an empty array always -- gives an array-bounds error, but 'bounds' still yields the bounds -- with which the array was constructed. {-# INLINE array #-} array :: Ix i => (i,i) -- ^ a pair of /bounds/, each of the index type -- of the array. These bounds are the lowest and -- highest indices in the array, in that order. -- For example, a one-origin vector of length -- '10' has bounds '(1,10)', and a one-origin '10' -- by '10' matrix has bounds '((1,1),(10,10))'. -> [(i, e)] -- ^ a list of /associations/ of the form -- (/index/, /value/). Typically, this list will -- be expressed as a comprehension. An -- association '(i, x)' defines the value of -- the array at index 'i' to be 'x'. -> Array i e array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeArray #-} unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e unsafeArray (l,u) ies = runST (ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) -> foldr (fill marr#) (done l u marr#) ies s2# }}) {-# INLINE fill #-} fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a fill marr# (I# i#, e) next s1# = case writeArray# marr# i# e s1# of { s2# -> next s2# } {-# INLINE done #-} done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e) done l u marr# s1# = case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) -> (# s2#, Array l u arr# #) } -- This is inefficient and I'm not sure why: -- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es) -- The code below is better. It still doesn't enable foldr/build -- transformation on the list of elements; I guess it's impossible -- using mechanisms currently available. -- | Construct an array from a pair of bounds and a list of values in -- index order. {-# INLINE listArray #-} listArray :: Ix i => (i,i) -> [e] -> Array i e listArray (l,u) es = runST (ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) -> let fillFromList i# xs s3# | i# ==# n# = s3# | otherwise = case xs of [] -> s3# y:ys -> case writeArray# marr# i# y s3# of { s4# -> fillFromList (i# +# 1#) ys s4# } in case fillFromList 0# es s2# of { s3# -> done l u marr# s3# }}}) -- | The value at the given index in an array. {-# INLINE (!) #-} (!) :: Ix i => Array i e -> i -> e arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i) {-# INLINE unsafeAt #-} unsafeAt :: Ix i => Array i e -> Int -> e unsafeAt (Array _ _ arr#) (I# i#) = case indexArray# arr# i# of (# e #) -> e -- | The bounds with which an array was constructed. {-# INLINE bounds #-} bounds :: Ix i => Array i e -> (i,i) bounds (Array l u _) = (l,u) -- | The list of indices of an array in ascending order. {-# INLINE indices #-} indices :: Ix i => Array i e -> [i] indices (Array l u _) = range (l,u) -- | The list of elements of an array in index order. {-# INLINE elems #-} elems :: Ix i => Array i e -> [e] elems arr@(Array l u _) = [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]] -- | The list of associations of an array in index order. {-# INLINE assocs #-} assocs :: Ix i => Array i e -> [(i, e)] assocs arr@(Array l u _) = [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)] -- | The 'accumArray' deals with repeated indices in the association -- list using an /accumulating function/ which combines the values of -- associations with the same index. -- For example, given a list of values of some index type, @hist@ -- produces a histogram of the number of occurrences of each index within -- a specified range: -- -- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b -- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i] -- -- If the accumulating function is strict, then 'accumArray' is strict in -- the values, as well as the indices, in the association list. Thus, -- unlike ordinary arrays built with 'array', accumulated arrays should -- not in general be recursive. {-# INLINE accumArray #-} accumArray :: Ix i => (e -> a -> e) -- ^ accumulating function -> e -- ^ initial value -> (i,i) -- ^ bounds of the array -> [(i, a)] -- ^ association list -> Array i e accumArray f init (l,u) ies = unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeAccumArray #-} unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# init s1# of { (# s2#, marr# #) -> foldr (adjust f marr#) (done l u marr#) ies s2# }}) {-# INLINE adjust #-} adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b adjust f marr# (I# i#, new) next s1# = case readArray# marr# i# s1# of { (# s2#, old #) -> case writeArray# marr# i# (f old new) s2# of { s3# -> next s3# }} -- | Constructs an array identical to the first argument except that it has -- been updated by the associations in the right argument. -- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then -- -- > m//[((i,i), 0) | i <- [1..n]] -- -- is the same matrix, except with the diagonal zeroed. -- -- Repeated indices in the association list are handled as for 'array': -- Haskell 98 specifies that the resulting array is undefined (i.e. bottom), -- but GHC's implementation uses the last association for each index. {-# INLINE (//) #-} (//) :: Ix i => Array i e -> [(i, e)] -> Array i e arr@(Array l u _) // ies = unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeReplace #-} unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e unsafeReplace arr@(Array l u _) ies = runST (do STArray _ _ marr# <- thawSTArray arr ST (foldr (fill marr#) (done l u marr#) ies)) -- | @'accum' f@ takes an array and an association list and accumulates -- pairs from the list into the array with the accumulating function @f@. -- Thus 'accumArray' can be defined using 'accum': -- -- > accumArray f z b = accum f (array b [(i, z) | i <- range b]) -- {-# INLINE accum #-} accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e accum f arr@(Array l u _) ies = unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeAccum #-} unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e unsafeAccum f arr@(Array l u _) ies = runST (do STArray _ _ marr# <- thawSTArray arr ST (foldr (adjust f marr#) (done l u marr#) ies)) {-# INLINE amap #-} amap :: Ix i => (a -> b) -> Array i a -> Array i b amap f arr@(Array l u _) = unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]] -- | 'ixmap' allows for transformations on array indices. -- It may be thought of as providing function composition on the right -- with the mapping that the original array embodies. -- -- A similar transformation of array values may be achieved using 'fmap' -- from the 'Array' instance of the 'Functor' class. {-# INLINE ixmap #-} ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e ixmap (l,u) f arr = unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)] {-# INLINE eqArray #-} eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) = if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else l1 == l2 && u1 == u2 && and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]] {-# INLINE cmpArray #-} cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2) {-# INLINE cmpIntArray #-} cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) = if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else if rangeSize (l2,u2) == 0 then GT else case compare l1 l2 of EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1] other -> other where cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of EQ -> rest other -> other {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-} \end{code} %********************************************************* %* * \subsection{Array instances} %* * %********************************************************* \begin{code} instance Ix i => Functor (Array i) where fmap = amap instance (Ix i, Eq e) => Eq (Array i e) where (==) = eqArray instance (Ix i, Ord e) => Ord (Array i e) where compare = cmpArray instance (Ix a, Show a, Show b) => Show (Array a b) where showsPrec p a = showParen (p > appPrec) $ showString "array " . showsPrec appPrec1 (bounds a) . showChar ' ' . showsPrec appPrec1 (assocs a) -- Precedence of 'array' is the precedence of application -- The Read instance is in GHC.Read \end{code} %********************************************************* %* * \subsection{Operations on mutable arrays} %* * %********************************************************* Idle ADR question: What's the tradeoff here between flattening these datatypes into @STArray ix ix (MutableArray# s elt)@ and using it as is? As I see it, the former uses slightly less heap and provides faster access to the individual parts of the bounds while the code used has the benefit of providing a ready-made @(lo, hi)@ pair as required by many array-related functions. Which wins? Is the difference significant (probably not). Idle AJG answer: When I looked at the outputted code (though it was 2 years ago) it seems like you often needed the tuple, and we build it frequently. Now we've got the overloading specialiser things might be different, though. \begin{code} {-# INLINE newSTArray #-} newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e) newSTArray (l,u) init = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# init s1# of { (# s2#, marr# #) -> (# s2#, STArray l u marr# #) }} {-# INLINE boundsSTArray #-} boundsSTArray :: STArray s i e -> (i,i) boundsSTArray (STArray l u _) = (l,u) {-# INLINE readSTArray #-} readSTArray :: Ix i => STArray s i e -> i -> ST s e readSTArray marr@(STArray l u _) i = unsafeReadSTArray marr (index (l,u) i) {-# INLINE unsafeReadSTArray #-} unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# -> readArray# marr# i# s1# {-# INLINE writeSTArray #-} writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s () writeSTArray marr@(STArray l u _) i e = unsafeWriteSTArray marr (index (l,u) i) e {-# INLINE unsafeWriteSTArray #-} unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s () unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# -> case writeArray# marr# i# e s1# of { s2# -> (# s2#, () #) } \end{code} %********************************************************* %* * \subsection{Moving between mutable and immutable} %* * %********************************************************* \begin{code} freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e) freezeSTArray (STArray l u marr#) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) -> let copy i# s3# | i# ==# n# = s3# | otherwise = case readArray# marr# i# s3# of { (# s4#, e #) -> case writeArray# marr'# i# e s4# of { s5# -> copy (i# +# 1#) s5# }} in case copy 0# s2# of { s3# -> case unsafeFreezeArray# marr'# s3# of { (# s4#, arr# #) -> (# s4#, Array l u arr# #) }}}} {-# INLINE unsafeFreezeSTArray #-} unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e) unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# -> case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) -> (# s2#, Array l u arr# #) } thawSTArray :: Ix i => Array i e -> ST s (STArray s i e) thawSTArray (Array l u arr#) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) -> let copy i# s3# | i# ==# n# = s3# | otherwise = case indexArray# arr# i# of { (# e #) -> case writeArray# marr# i# e s3# of { s4# -> copy (i# +# 1#) s4# }} in case copy 0# s2# of { s3# -> (# s3#, STArray l u marr# #) }}} {-# INLINE unsafeThawSTArray #-} unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e) unsafeThawSTArray (Array l u arr#) = ST $ \s1# -> case unsafeThawArray# arr# s1# of { (# s2#, marr# #) -> (# s2#, STArray l u marr# #) } \end{code} hugs98-plus-Sep2006/packages/base/GHC/Base.lhs0000644006511100651110000010320610504340224017432 0ustar rossross\section[GHC.Base]{Module @GHC.Base@} The overall structure of the GHC Prelude is a bit tricky. a) We want to avoid "orphan modules", i.e. ones with instance decls that don't belong either to a tycon or a class defined in the same module b) We want to avoid giant modules So the rough structure is as follows, in (linearised) dependency order GHC.Prim Has no implementation. It defines built-in things, and by importing it you bring them into scope. The source file is GHC.Prim.hi-boot, which is just copied to make GHC.Prim.hi GHC.Base Classes: Eq, Ord, Functor, Monad Types: list, (), Int, Bool, Ordering, Char, String Data.Tup Types: tuples, plus instances for GHC.Base classes GHC.Show Class: Show, plus instances for GHC.Base/GHC.Tup types GHC.Enum Class: Enum, plus instances for GHC.Base/GHC.Tup types Data.Maybe Type: Maybe, plus instances for GHC.Base classes GHC.Num Class: Num, plus instances for Int Type: Integer, plus instances for all classes so far (Eq, Ord, Num, Show) Integer is needed here because it is mentioned in the signature of 'fromInteger' in class Num GHC.Real Classes: Real, Integral, Fractional, RealFrac plus instances for Int, Integer Types: Ratio, Rational plus intances for classes so far Rational is needed here because it is mentioned in the signature of 'toRational' in class Real Ix Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples GHC.Arr Types: Array, MutableArray, MutableVar Does *not* contain any ByteArray stuff (see GHC.ByteArr) Arrays are used by a function in GHC.Float GHC.Float Classes: Floating, RealFloat Types: Float, Double, plus instances of all classes so far This module contains everything to do with floating point. It is a big module (900 lines) With a bit of luck, many modules can be compiled without ever reading GHC.Float.hi GHC.ByteArr Types: ByteArray, MutableByteArray We want this one to be after GHC.Float, because it defines arrays of unboxed floats. Other Prelude modules are much easier with fewer complex dependencies. \begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Base -- Copyright : (c) The University of Glasgow, 1992-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- Basic data types and classes. -- ----------------------------------------------------------------------------- #include "MachDeps.h" -- #hide module GHC.Base ( module GHC.Base, module GHC.Prim, -- Re-export GHC.Prim and GHC.Err, to avoid lots module GHC.Err -- of people having to import it explicitly ) where import GHC.Prim import {-# SOURCE #-} GHC.Err infixr 9 . infixr 5 ++, : infix 4 ==, /=, <, <=, >=, > infixr 3 && infixr 2 || infixl 1 >>, >>= infixr 0 $ default () -- Double isn't available yet \end{code} %********************************************************* %* * \subsection{DEBUGGING STUFF} %* (for use when compiling GHC.Base itself doesn't work) %* * %********************************************************* \begin{code} {- data Bool = False | True data Ordering = LT | EQ | GT data Char = C# Char# type String = [Char] data Int = I# Int# data () = () data [] a = MkNil not True = False (&&) True True = True otherwise = True build = error "urk" foldr = error "urk" unpackCString# :: Addr# -> [Char] unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a unpackAppendCString# :: Addr# -> [Char] -> [Char] unpackCStringUtf8# :: Addr# -> [Char] unpackCString# a = error "urk" unpackFoldrCString# a = error "urk" unpackAppendCString# a = error "urk" unpackCStringUtf8# a = error "urk" -} \end{code} %********************************************************* %* * \subsection{Standard classes @Eq@, @Ord@} %* * %********************************************************* \begin{code} -- | The 'Eq' class defines equality ('==') and inequality ('/='). -- All the basic datatypes exported by the "Prelude" are instances of 'Eq', -- and 'Eq' may be derived for any datatype whose constituents are also -- instances of 'Eq'. -- -- Minimal complete definition: either '==' or '/='. -- class Eq a where (==), (/=) :: a -> a -> Bool x /= y = not (x == y) x == y = not (x /= y) -- | The 'Ord' class is used for totally ordered datatypes. -- -- Instances of 'Ord' can be derived for any user-defined -- datatype whose constituent types are in 'Ord'. The declared order -- of the constructors in the data declaration determines the ordering -- in derived 'Ord' instances. The 'Ordering' datatype allows a single -- comparison to determine the precise ordering of two objects. -- -- Minimal complete definition: either 'compare' or '<='. -- Using 'compare' can be more efficient for complex types. -- class (Eq a) => Ord a where compare :: a -> a -> Ordering (<), (<=), (>), (>=) :: a -> a -> Bool max, min :: a -> a -> a compare x y | x == y = EQ | x <= y = LT -- NB: must be '<=' not '<' to validate the -- above claim about the minimal things that -- can be defined for an instance of Ord | otherwise = GT x < y = case compare x y of { LT -> True; _other -> False } x <= y = case compare x y of { GT -> False; _other -> True } x > y = case compare x y of { GT -> True; _other -> False } x >= y = case compare x y of { LT -> False; _other -> True } -- These two default methods use '<=' rather than 'compare' -- because the latter is often more expensive max x y = if x <= y then y else x min x y = if x <= y then x else y \end{code} %********************************************************* %* * \subsection{Monadic classes @Functor@, @Monad@ } %* * %********************************************************* \begin{code} {- | The 'Functor' class is used for types that can be mapped over. Instances of 'Functor' should satisfy the following laws: > fmap id == id > fmap (f . g) == fmap f . fmap g The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' defined in the "Prelude" satisfy these laws. -} class Functor f where fmap :: (a -> b) -> f a -> f b {- | The 'Monad' class defines the basic operations over a /monad/, a concept from a branch of mathematics known as /category theory/. From the perspective of a Haskell programmer, however, it is best to think of a monad as an /abstract datatype/ of actions. Haskell's @do@ expressions provide a convenient syntax for writing monadic expressions. Minimal complete definition: '>>=' and 'return'. Instances of 'Monad' should satisfy the following laws: > return a >>= k == k a > m >>= return == m > m >>= (\x -> k x >>= h) == (m >>= k) >>= h Instances of both 'Monad' and 'Functor' should additionally satisfy the law: > fmap f xs == xs >>= return . f The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' defined in the "Prelude" satisfy these laws. -} class Monad m where -- | Sequentially compose two actions, passing any value produced -- by the first as an argument to the second. (>>=) :: forall a b. m a -> (a -> m b) -> m b -- | Sequentially compose two actions, discarding any value produced -- by the first, like sequencing operators (such as the semicolon) -- in imperative languages. (>>) :: forall a b. m a -> m b -> m b -- Explicit for-alls so that we know what order to -- give type arguments when desugaring -- | Inject a value into the monadic type. return :: a -> m a -- | Fail with a message. This operation is not part of the -- mathematical definition of a monad, but is invoked on pattern-match -- failure in a @do@ expression. fail :: String -> m a m >> k = m >>= \_ -> k fail s = error s \end{code} %********************************************************* %* * \subsection{The list type} %* * %********************************************************* \begin{code} data [] a = [] | a : [a] -- do explicitly: deriving (Eq, Ord) -- to avoid weird names like con2tag_[]# instance (Eq a) => Eq [a] where {-# SPECIALISE instance Eq [Char] #-} [] == [] = True (x:xs) == (y:ys) = x == y && xs == ys _xs == _ys = False instance (Ord a) => Ord [a] where {-# SPECIALISE instance Ord [Char] #-} compare [] [] = EQ compare [] (_:_) = LT compare (_:_) [] = GT compare (x:xs) (y:ys) = case compare x y of EQ -> compare xs ys other -> other instance Functor [] where fmap = map instance Monad [] where m >>= k = foldr ((++) . k) [] m m >> k = foldr ((++) . (\ _ -> k)) [] m return x = [x] fail _ = [] \end{code} A few list functions that appear here because they are used here. The rest of the prelude list functions are in GHC.List. ---------------------------------------------- -- foldr/build/augment ---------------------------------------------- \begin{code} -- | 'foldr', applied to a binary operator, a starting value (typically -- the right-identity of the operator), and a list, reduces the list -- using the binary operator, from right to left: -- -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) foldr :: (a -> b -> b) -> b -> [a] -> b -- foldr _ z [] = z -- foldr f z (x:xs) = f x (foldr f z xs) {-# INLINE [0] foldr #-} -- Inline only in the final stage, after the foldr/cons rule has had a chance foldr k z xs = go xs where go [] = z go (y:ys) = y `k` go ys -- | A list producer that can be fused with 'foldr'. -- This function is merely -- -- > build g = g (:) [] -- -- but GHC's simplifier will transform an expression of the form -- @'foldr' k z ('build' g)@, which may arise after inlining, to @g k z@, -- which avoids producing an intermediate list. build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] {-# INLINE [1] build #-} -- The INLINE is important, even though build is tiny, -- because it prevents [] getting inlined in the version that -- appears in the interface file. If [] *is* inlined, it -- won't match with [] appearing in rules in an importing module. -- -- The "1" says to inline in phase 1 build g = g (:) [] -- | A list producer that can be fused with 'foldr'. -- This function is merely -- -- > augment g xs = g (:) xs -- -- but GHC's simplifier will transform an expression of the form -- @'foldr' k z ('augment' g xs)@, which may arise after inlining, to -- @g k ('foldr' k z xs)@, which avoids producing an intermediate list. augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a] {-# INLINE [1] augment #-} augment g xs = g (:) xs {-# RULES "fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) . foldr k z (build g) = g k z "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . foldr k z (augment g xs) = g k (foldr k z xs) "foldr/id" foldr (:) [] = \x -> x "foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys -- Only activate this from phase 1, because that's -- when we disable the rule that expands (++) into foldr -- The foldr/cons rule looks nice, but it can give disastrously -- bloated code when commpiling -- array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] -- i.e. when there are very very long literal lists -- So I've disabled it for now. We could have special cases -- for short lists, I suppose. -- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs) "foldr/single" forall k z x. foldr k z [x] = k x z "foldr/nil" forall k z. foldr k z [] = z "augment/build" forall (g::forall b. (a->b->b) -> b -> b) (h::forall b. (a->b->b) -> b -> b) . augment g (build h) = build (\c n -> g c (h c n)) "augment/nil" forall (g::forall b. (a->b->b) -> b -> b) . augment g [] = build g #-} -- This rule is true, but not (I think) useful: -- augment g (augment h t) = augment (\cn -> g c (h c n)) t \end{code} ---------------------------------------------- -- map ---------------------------------------------- \begin{code} -- | 'map' @f xs@ is the list obtained by applying @f@ to each element -- of @xs@, i.e., -- -- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn] -- > map f [x1, x2, ...] == [f x1, f x2, ...] map :: (a -> b) -> [a] -> [b] map _ [] = [] map f (x:xs) = f x : map f xs -- Note eta expanded mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst {-# INLINE [0] mapFB #-} mapFB c f x ys = c (f x) ys -- The rules for map work like this. -- -- Up to (but not including) phase 1, we use the "map" rule to -- rewrite all saturated applications of map with its build/fold -- form, hoping for fusion to happen. -- In phase 1 and 0, we switch off that rule, inline build, and -- switch on the "mapList" rule, which rewrites the foldr/mapFB -- thing back into plain map. -- -- It's important that these two rules aren't both active at once -- (along with build's unfolding) else we'd get an infinite loop -- in the rules. Hence the activation control below. -- -- The "mapFB" rule optimises compositions of map. -- -- This same pattern is followed by many other functions: -- e.g. append, filter, iterate, repeat, etc. {-# RULES "map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs) "mapList" [1] forall f. foldr (mapFB (:) f) [] = map f "mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g) #-} \end{code} ---------------------------------------------- -- append ---------------------------------------------- \begin{code} -- | Append two lists, i.e., -- -- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] -- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] -- -- If the first list is not finite, the result is the first list. (++) :: [a] -> [a] -> [a] (++) [] ys = ys (++) (x:xs) ys = x : xs ++ ys {-# RULES "++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys #-} \end{code} %********************************************************* %* * \subsection{Type @Bool@} %* * %********************************************************* \begin{code} -- |The 'Bool' type is an enumeration. It is defined with 'False' -- first so that the corresponding 'Prelude.Enum' instance will give -- 'Prelude.fromEnum' 'False' the value zero, and -- 'Prelude.fromEnum' 'True' the value 1. data Bool = False | True deriving (Eq, Ord) -- Read in GHC.Read, Show in GHC.Show -- Boolean functions -- | Boolean \"and\" (&&) :: Bool -> Bool -> Bool True && x = x False && _ = False -- | Boolean \"or\" (||) :: Bool -> Bool -> Bool True || _ = True False || x = x -- | Boolean \"not\" not :: Bool -> Bool not True = False not False = True -- |'otherwise' is defined as the value 'True'. It helps to make -- guards more readable. eg. -- -- > f x | x < 0 = ... -- > | otherwise = ... otherwise :: Bool otherwise = True \end{code} %********************************************************* %* * \subsection{The @()@ type} %* * %********************************************************* The Unit type is here because virtually any program needs it (whereas some programs may get away without consulting GHC.Tup). Furthermore, the renamer currently *always* asks for () to be in scope, so that ccalls can use () as their default type; so when compiling GHC.Base we need (). (We could arrange suck in () only if -fglasgow-exts, but putting it here seems more direct.) \begin{code} -- | The unit datatype @()@ has one non-undefined member, the nullary -- constructor @()@. data () = () instance Eq () where () == () = True () /= () = False instance Ord () where () <= () = True () < () = False () >= () = True () > () = False max () () = () min () () = () compare () () = EQ \end{code} %********************************************************* %* * \subsection{Type @Ordering@} %* * %********************************************************* \begin{code} -- | Represents an ordering relationship between two values: less -- than, equal to, or greater than. An 'Ordering' is returned by -- 'compare'. data Ordering = LT | EQ | GT deriving (Eq, Ord) -- Read in GHC.Read, Show in GHC.Show \end{code} %********************************************************* %* * \subsection{Type @Char@ and @String@} %* * %********************************************************* \begin{code} -- | A 'String' is a list of characters. String constants in Haskell are values -- of type 'String'. -- type String = [Char] {-| The character type 'Char' is an enumeration whose values represent Unicode (or equivalently ISO\/IEC 10646) characters (see for details). This set extends the ISO 8859-1 (Latin-1) character set (the first 256 charachers), which is itself an extension of the ASCII character set (the first 128 characters). A character literal in Haskell has type 'Char'. To convert a 'Char' to or from the corresponding 'Int' value defined by Unicode, use 'Prelude.toEnum' and 'Prelude.fromEnum' from the 'Prelude.Enum' class respectively (or equivalently 'ord' and 'chr'). -} data Char = C# Char# -- We don't use deriving for Eq and Ord, because for Ord the derived -- instance defines only compare, which takes two primops. Then -- '>' uses compare, and therefore takes two primops instead of one. instance Eq Char where (C# c1) == (C# c2) = c1 `eqChar#` c2 (C# c1) /= (C# c2) = c1 `neChar#` c2 instance Ord Char where (C# c1) > (C# c2) = c1 `gtChar#` c2 (C# c1) >= (C# c2) = c1 `geChar#` c2 (C# c1) <= (C# c2) = c1 `leChar#` c2 (C# c1) < (C# c2) = c1 `ltChar#` c2 {-# RULES "x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True "x# `neChar#` x#" forall x#. x# `neChar#` x# = False "x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False "x# `geChar#` x#" forall x#. x# `geChar#` x# = True "x# `leChar#` x#" forall x#. x# `leChar#` x# = True "x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False #-} -- | The 'Prelude.toEnum' method restricted to the type 'Data.Char.Char'. chr :: Int -> Char chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#) | otherwise = error "Prelude.chr: bad argument" unsafeChr :: Int -> Char unsafeChr (I# i#) = C# (chr# i#) -- | The 'Prelude.fromEnum' method restricted to the type 'Data.Char.Char'. ord :: Char -> Int ord (C# c#) = I# (ord# c#) \end{code} String equality is used when desugaring pattern-matches against strings. \begin{code} eqString :: String -> String -> Bool eqString [] [] = True eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 eqString cs1 cs2 = False {-# RULES "eqString" (==) = eqString #-} -- eqString also has a BuiltInRule in PrelRules.lhs: -- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2 \end{code} %********************************************************* %* * \subsection{Type @Int@} %* * %********************************************************* \begin{code} data Int = I# Int# -- ^A fixed-precision integer type with at least the range @[-2^29 .. 2^29-1]@. -- The exact range for a given implementation can be determined by using -- 'Prelude.minBound' and 'Prelude.maxBound' from the 'Prelude.Bounded' class. zeroInt, oneInt, twoInt, maxInt, minInt :: Int zeroInt = I# 0# oneInt = I# 1# twoInt = I# 2# {- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -} #if WORD_SIZE_IN_BITS == 31 minInt = I# (-0x40000000#) maxInt = I# 0x3FFFFFFF# #elif WORD_SIZE_IN_BITS == 32 minInt = I# (-0x80000000#) maxInt = I# 0x7FFFFFFF# #else minInt = I# (-0x8000000000000000#) maxInt = I# 0x7FFFFFFFFFFFFFFF# #endif instance Eq Int where (==) = eqInt (/=) = neInt instance Ord Int where compare = compareInt (<) = ltInt (<=) = leInt (>=) = geInt (>) = gtInt compareInt :: Int -> Int -> Ordering (I# x#) `compareInt` (I# y#) = compareInt# x# y# compareInt# :: Int# -> Int# -> Ordering compareInt# x# y# | x# <# y# = LT | x# ==# y# = EQ | otherwise = GT \end{code} %********************************************************* %* * \subsection{The function type} %* * %********************************************************* \begin{code} -- | Identity function. id :: a -> a id x = x -- | The call '(lazy e)' means the same as 'e', but 'lazy' has a -- magical strictness property: it is lazy in its first argument, -- even though its semantics is strict. lazy :: a -> a lazy x = x -- Implementation note: its strictness and unfolding are over-ridden -- by the definition in MkId.lhs; in both cases to nothing at all. -- That way, 'lazy' does not get inlined, and the strictness analyser -- sees it as lazy. Then the worker/wrapper phase inlines it. -- Result: happiness -- | The call '(inline f)' reduces to 'f', but 'inline' has a BuiltInRule -- that tries to inline 'f' (if it has an unfolding) unconditionally -- The 'NOINLINE' pragma arranges that inline only gets inlined (and -- hence eliminated) late in compilation, after the rule has had -- a god chance to fire. inline :: a -> a {-# NOINLINE[0] inline #-} inline x = x -- Assertion function. This simply ignores its boolean argument. -- The compiler may rewrite it to @('assertError' line)@. -- | If the first argument evaluates to 'True', then the result is the -- second argument. Otherwise an 'AssertionFailed' exception is raised, -- containing a 'String' with the source file and line number of the -- call to 'assert'. -- -- Assertions can normally be turned on or off with a compiler flag -- (for GHC, assertions are normally on unless optimisation is turned on -- with @-O@ or the @-fignore-asserts@ -- option is given). When assertions are turned off, the first -- argument to 'assert' is ignored, and the second argument is -- returned as the result. -- SLPJ: in 5.04 etc 'assert' is in GHC.Prim, -- but from Template Haskell onwards it's simply -- defined here in Base.lhs assert :: Bool -> a -> a assert pred r = r breakpoint :: a -> a breakpoint r = r breakpointCond :: Bool -> a -> a breakpointCond _ r = r -- | Constant function. const :: a -> b -> a const x _ = x -- | Function composition. {-# INLINE (.) #-} (.) :: (b -> c) -> (a -> b) -> a -> c (.) f g x = f (g x) -- | @'flip' f@ takes its (first) two arguments in the reverse order of @f@. flip :: (a -> b -> c) -> b -> a -> c flip f x y = f y x -- | Application operator. This operator is redundant, since ordinary -- application @(f x)@ means the same as @(f '$' x)@. However, '$' has -- low, right-associative binding precedence, so it sometimes allows -- parentheses to be omitted; for example: -- -- > f $ g $ h x = f (g (h x)) -- -- It is also useful in higher-order situations, such as @'map' ('$' 0) xs@, -- or @'Data.List.zipWith' ('$') fs xs@. {-# INLINE ($) #-} ($) :: (a -> b) -> a -> b f $ x = f x -- | @'until' p f@ yields the result of applying @f@ until @p@ holds. until :: (a -> Bool) -> (a -> a) -> a -> a until p f x | p x = x | otherwise = until p f (f x) -- | 'asTypeOf' is a type-restricted version of 'const'. It is usually -- used as an infix operator, and its typing forces its first argument -- (which is usually overloaded) to have the same type as the second. asTypeOf :: a -> a -> a asTypeOf = const \end{code} %********************************************************* %* * \subsection{Generics} %* * %********************************************************* \begin{code} data Unit = Unit #ifndef __HADDOCK__ data (:+:) a b = Inl a | Inr b data (:*:) a b = a :*: b #endif \end{code} %********************************************************* %* * \subsection{@getTag@} %* * %********************************************************* Returns the 'tag' of a constructor application; this function is used by the deriving code for Eq, Ord and Enum. The primitive dataToTag# requires an evaluated constructor application as its argument, so we provide getTag as a wrapper that performs the evaluation before calling dataToTag#. We could have dataToTag# evaluate its argument, but we prefer to do it this way because (a) dataToTag# can be an inline primop if it doesn't need to do any evaluation, and (b) we want to expose the evaluation to the simplifier, because it might be possible to eliminate the evaluation in the case when the argument is already known to be evaluated. \begin{code} {-# INLINE getTag #-} getTag :: a -> Int# getTag x = x `seq` dataToTag# x \end{code} %********************************************************* %* * \subsection{Numeric primops} %* * %********************************************************* \begin{code} divInt# :: Int# -> Int# -> Int# x# `divInt#` y# -- Be careful NOT to overflow if we do any additional arithmetic -- on the arguments... the following previous version of this -- code has problems with overflow: -- | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y# -- | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y# | (x# ># 0#) && (y# <# 0#) = ((x# -# 1#) `quotInt#` y#) -# 1# | (x# <# 0#) && (y# ># 0#) = ((x# +# 1#) `quotInt#` y#) -# 1# | otherwise = x# `quotInt#` y# modInt# :: Int# -> Int# -> Int# x# `modInt#` y# | (x# ># 0#) && (y# <# 0#) || (x# <# 0#) && (y# ># 0#) = if r# /=# 0# then r# +# y# else 0# | otherwise = r# where r# = x# `remInt#` y# \end{code} Definitions of the boxed PrimOps; these will be used in the case of partial applications, etc. \begin{code} {-# INLINE eqInt #-} {-# INLINE neInt #-} {-# INLINE gtInt #-} {-# INLINE geInt #-} {-# INLINE ltInt #-} {-# INLINE leInt #-} {-# INLINE plusInt #-} {-# INLINE minusInt #-} {-# INLINE timesInt #-} {-# INLINE quotInt #-} {-# INLINE remInt #-} {-# INLINE negateInt #-} plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int (I# x) `plusInt` (I# y) = I# (x +# y) (I# x) `minusInt` (I# y) = I# (x -# y) (I# x) `timesInt` (I# y) = I# (x *# y) (I# x) `quotInt` (I# y) = I# (x `quotInt#` y) (I# x) `remInt` (I# y) = I# (x `remInt#` y) (I# x) `divInt` (I# y) = I# (x `divInt#` y) (I# x) `modInt` (I# y) = I# (x `modInt#` y) {-# RULES "x# +# 0#" forall x#. x# +# 0# = x# "0# +# x#" forall x#. 0# +# x# = x# "x# -# 0#" forall x#. x# -# 0# = x# "x# -# x#" forall x#. x# -# x# = 0# "x# *# 0#" forall x#. x# *# 0# = 0# "0# *# x#" forall x#. 0# *# x# = 0# "x# *# 1#" forall x#. x# *# 1# = x# "1# *# x#" forall x#. 1# *# x# = x# #-} gcdInt (I# a) (I# b) = g a b where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined" g 0# _ = I# absB g _ 0# = I# absA g _ _ = I# (gcdInt# absA absB) absInt x = if x <# 0# then negateInt# x else x absA = absInt a absB = absInt b negateInt :: Int -> Int negateInt (I# x) = I# (negateInt# x) gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool (I# x) `gtInt` (I# y) = x ># y (I# x) `geInt` (I# y) = x >=# y (I# x) `eqInt` (I# y) = x ==# y (I# x) `neInt` (I# y) = x /=# y (I# x) `ltInt` (I# y) = x <# y (I# x) `leInt` (I# y) = x <=# y {-# RULES "x# ># x#" forall x#. x# ># x# = False "x# >=# x#" forall x#. x# >=# x# = True "x# ==# x#" forall x#. x# ==# x# = True "x# /=# x#" forall x#. x# /=# x# = False "x# <# x#" forall x#. x# <# x# = False "x# <=# x#" forall x#. x# <=# x# = True #-} {-# RULES "plusFloat x 0.0" forall x#. plusFloat# x# 0.0# = x# "plusFloat 0.0 x" forall x#. plusFloat# 0.0# x# = x# "minusFloat x 0.0" forall x#. minusFloat# x# 0.0# = x# "minusFloat x x" forall x#. minusFloat# x# x# = 0.0# "timesFloat x 0.0" forall x#. timesFloat# x# 0.0# = 0.0# "timesFloat0.0 x" forall x#. timesFloat# 0.0# x# = 0.0# "timesFloat x 1.0" forall x#. timesFloat# x# 1.0# = x# "timesFloat 1.0 x" forall x#. timesFloat# 1.0# x# = x# "divideFloat x 1.0" forall x#. divideFloat# x# 1.0# = x# #-} {-# RULES "plusDouble x 0.0" forall x#. (+##) x# 0.0## = x# "plusDouble 0.0 x" forall x#. (+##) 0.0## x# = x# "minusDouble x 0.0" forall x#. (-##) x# 0.0## = x# "minusDouble x x" forall x#. (-##) x# x# = 0.0## "timesDouble x 0.0" forall x#. (*##) x# 0.0## = 0.0## "timesDouble 0.0 x" forall x#. (*##) 0.0## x# = 0.0## "timesDouble x 1.0" forall x#. (*##) x# 1.0## = x# "timesDouble 1.0 x" forall x#. (*##) 1.0## x# = x# "divideDouble x 1.0" forall x#. (/##) x# 1.0## = x# #-} -- Wrappers for the shift operations. The uncheckedShift# family are -- undefined when the amount being shifted by is greater than the size -- in bits of Int#, so these wrappers perform a check and return -- either zero or -1 appropriately. -- -- Note that these wrappers still produce undefined results when the -- second argument (the shift amount) is negative. -- | Shift the argument left by the specified number of bits -- (which must be non-negative). shiftL# :: Word# -> Int# -> Word# a `shiftL#` b | b >=# WORD_SIZE_IN_BITS# = int2Word# 0# | otherwise = a `uncheckedShiftL#` b -- | Shift the argument right by the specified number of bits -- (which must be non-negative). shiftRL# :: Word# -> Int# -> Word# a `shiftRL#` b | b >=# WORD_SIZE_IN_BITS# = int2Word# 0# | otherwise = a `uncheckedShiftRL#` b -- | Shift the argument left by the specified number of bits -- (which must be non-negative). iShiftL# :: Int# -> Int# -> Int# a `iShiftL#` b | b >=# WORD_SIZE_IN_BITS# = 0# | otherwise = a `uncheckedIShiftL#` b -- | Shift the argument right (signed) by the specified number of bits -- (which must be non-negative). iShiftRA# :: Int# -> Int# -> Int# a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0# | otherwise = a `uncheckedIShiftRA#` b -- | Shift the argument right (unsigned) by the specified number of bits -- (which must be non-negative). iShiftRL# :: Int# -> Int# -> Int# a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0# | otherwise = a `uncheckedIShiftRL#` b #if WORD_SIZE_IN_BITS == 32 {-# RULES "narrow32Int#" forall x#. narrow32Int# x# = x# "narrow32Word#" forall x#. narrow32Word# x# = x# #-} #endif {-# RULES "int2Word2Int" forall x#. int2Word# (word2Int# x#) = x# "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x# #-} \end{code} %******************************************************** %* * \subsection{Unpacking C strings} %* * %******************************************************** This code is needed for virtually all programs, since it's used for unpacking the strings of error messages. \begin{code} unpackCString# :: Addr# -> [Char] {-# NOINLINE [1] unpackCString# #-} unpackCString# addr = unpack 0# where unpack nh | ch `eqChar#` '\0'# = [] | otherwise = C# ch : unpack (nh +# 1#) where ch = indexCharOffAddr# addr nh unpackAppendCString# :: Addr# -> [Char] -> [Char] unpackAppendCString# addr rest = unpack 0# where unpack nh | ch `eqChar#` '\0'# = rest | otherwise = C# ch : unpack (nh +# 1#) where ch = indexCharOffAddr# addr nh unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a {-# NOINLINE [0] unpackFoldrCString# #-} -- Don't inline till right at the end; -- usually the unpack-list rule turns it into unpackCStringList -- It also has a BuiltInRule in PrelRules.lhs: -- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) -- = unpackFoldrCString# "foobaz" c n unpackFoldrCString# addr f z = unpack 0# where unpack nh | ch `eqChar#` '\0'# = z | otherwise = C# ch `f` unpack (nh +# 1#) where ch = indexCharOffAddr# addr nh unpackCStringUtf8# :: Addr# -> [Char] unpackCStringUtf8# addr = unpack 0# where unpack nh | ch `eqChar#` '\0'# = [] | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#) | ch `leChar#` '\xDF'# = C# (chr# (((ord# ch -# 0xC0#) `uncheckedIShiftL#` 6#) +# (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) : unpack (nh +# 2#) | ch `leChar#` '\xEF'# = C# (chr# (((ord# ch -# 0xE0#) `uncheckedIShiftL#` 12#) +# ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 6#) +# (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) : unpack (nh +# 3#) | otherwise = C# (chr# (((ord# ch -# 0xF0#) `uncheckedIShiftL#` 18#) +# ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +# ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#` 6#) +# (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) : unpack (nh +# 4#) where ch = indexCharOffAddr# addr nh unpackNBytes# :: Addr# -> Int# -> [Char] unpackNBytes# _addr 0# = [] unpackNBytes# addr len# = unpack [] (len# -# 1#) where unpack acc i# | i# <# 0# = acc | otherwise = case indexCharOffAddr# addr i# of ch -> unpack (C# ch : acc) (i# -# 1#) {-# RULES "unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a) "unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a "unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n -- There's a built-in rule (in PrelRules.lhs) for -- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n #-} \end{code} #ifdef __HADDOCK__ \begin{code} -- | A special argument for the 'Control.Monad.ST.ST' type constructor, -- indexing a state embedded in the 'Prelude.IO' monad by -- 'Control.Monad.ST.stToIO'. data RealWorld \end{code} #endif hugs98-plus-Sep2006/packages/base/GHC/Conc.lhs0000644006511100651110000007577410504340226017466 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Conc -- Copyright : (c) The University of Glasgow, 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- Basic concurrency stuff. -- ----------------------------------------------------------------------------- -- No: #hide, because bits of this module are exposed by the stm package. -- However, we don't want this module to be the home location for the -- bits it exports, we'd rather have Control.Concurrent and the other -- higher level modules be the home. Hence: #include "Typeable.h" -- #not-home module GHC.Conc ( ThreadId(..) -- * Forking and suchlike , forkIO -- :: IO a -> IO ThreadId , forkOnIO -- :: Int -> IO a -> IO ThreadId , childHandler -- :: Exception -> IO () , myThreadId -- :: IO ThreadId , killThread -- :: ThreadId -> IO () , throwTo -- :: ThreadId -> Exception -> IO () , par -- :: a -> b -> b , pseq -- :: a -> b -> b , yield -- :: IO () , labelThread -- :: ThreadId -> String -> IO () -- * Waiting , threadDelay -- :: Int -> IO () , registerDelay -- :: Int -> IO (TVar Bool) , threadWaitRead -- :: Int -> IO () , threadWaitWrite -- :: Int -> IO () -- * MVars , MVar -- abstract , newMVar -- :: a -> IO (MVar a) , newEmptyMVar -- :: IO (MVar a) , takeMVar -- :: MVar a -> IO a , putMVar -- :: MVar a -> a -> IO () , tryTakeMVar -- :: MVar a -> IO (Maybe a) , tryPutMVar -- :: MVar a -> a -> IO Bool , isEmptyMVar -- :: MVar a -> IO Bool , addMVarFinalizer -- :: MVar a -> IO () -> IO () -- * TVars , STM -- abstract , atomically -- :: STM a -> IO a , retry -- :: STM a , orElse -- :: STM a -> STM a -> STM a , catchSTM -- :: STM a -> (Exception -> STM a) -> STM a , TVar -- abstract , newTVar -- :: a -> STM (TVar a) , newTVarIO -- :: a -> STM (TVar a) , readTVar -- :: TVar a -> STM a , writeTVar -- :: a -> TVar a -> STM () , unsafeIOToSTM -- :: IO a -> STM a -- * Miscellaneous #ifdef mingw32_HOST_OS , asyncRead -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int) , asyncWrite -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int) , asyncDoProc -- :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int , asyncReadBA -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int) , asyncWriteBA -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int) #endif #ifndef mingw32_HOST_OS , ensureIOManagerIsRunning #endif ) where import System.Posix.Types import System.Posix.Internals import Foreign import Foreign.C #ifndef __HADDOCK__ import {-# SOURCE #-} GHC.TopHandler ( reportError, reportStackOverflow ) #endif import Data.Maybe import GHC.Base import GHC.IOBase import GHC.Num ( Num(..) ) import GHC.Real ( fromIntegral, quot ) import GHC.Base ( Int(..) ) import GHC.Exception ( catchException, Exception(..), AsyncException(..) ) import GHC.Pack ( packCString# ) import GHC.Ptr ( Ptr(..), plusPtr, FunPtr(..) ) import GHC.STRef import GHC.Show ( Show(..), showString ) import Data.Typeable infixr 0 `par`, `pseq` \end{code} %************************************************************************ %* * \subsection{@ThreadId@, @par@, and @fork@} %* * %************************************************************************ \begin{code} data ThreadId = ThreadId ThreadId# deriving( Typeable ) -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. {- ^ A 'ThreadId' is an abstract type representing a handle to a thread. 'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where the 'Ord' instance implements an arbitrary total ordering over 'ThreadId's. The 'Show' instance lets you convert an arbitrary-valued 'ThreadId' to string form; showing a 'ThreadId' value is occasionally useful when debugging or diagnosing the behaviour of a concurrent program. /Note/: in GHC, if you have a 'ThreadId', you essentially have a pointer to the thread itself. This means the thread itself can\'t be garbage collected until you drop the 'ThreadId'. This misfeature will hopefully be corrected at a later date. /Note/: Hugs does not provide any operations on other threads; it defines 'ThreadId' as a synonym for (). -} instance Show ThreadId where showsPrec d t = showString "ThreadId " . showsPrec d (getThreadId (id2TSO t)) foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> Int id2TSO :: ThreadId -> ThreadId# id2TSO (ThreadId t) = t foreign import ccall unsafe "cmp_thread" cmp_thread :: ThreadId# -> ThreadId# -> CInt -- Returns -1, 0, 1 cmpThread :: ThreadId -> ThreadId -> Ordering cmpThread t1 t2 = case cmp_thread (id2TSO t1) (id2TSO t2) of -1 -> LT 0 -> EQ _ -> GT -- must be 1 instance Eq ThreadId where t1 == t2 = case t1 `cmpThread` t2 of EQ -> True _ -> False instance Ord ThreadId where compare = cmpThread {- | This sparks off a new thread to run the 'IO' computation passed as the first argument, and returns the 'ThreadId' of the newly created thread. The new thread will be a lightweight thread; if you want to use a foreign library that uses thread-local storage, use 'forkOS' instead. -} forkIO :: IO () -> IO ThreadId forkIO action = IO $ \ s -> case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #) where action_plus = catchException action childHandler forkOnIO :: Int -> IO () -> IO ThreadId forkOnIO (I# cpu) action = IO $ \ s -> case (forkOn# cpu action_plus s) of (# s1, id #) -> (# s1, ThreadId id #) where action_plus = catchException action childHandler childHandler :: Exception -> IO () childHandler err = catchException (real_handler err) childHandler real_handler :: Exception -> IO () real_handler ex = case ex of -- ignore thread GC and killThread exceptions: BlockedOnDeadMVar -> return () BlockedIndefinitely -> return () AsyncException ThreadKilled -> return () -- report all others: AsyncException StackOverflow -> reportStackOverflow other -> reportError other {- | 'killThread' terminates the given thread (GHC only). Any work already done by the thread isn\'t lost: the computation is suspended until required by another thread. The memory used by the thread will be garbage collected if it isn\'t referenced from anywhere. The 'killThread' function is defined in terms of 'throwTo': > killThread tid = throwTo tid (AsyncException ThreadKilled) -} killThread :: ThreadId -> IO () killThread tid = throwTo tid (AsyncException ThreadKilled) {- | 'throwTo' raises an arbitrary exception in the target thread (GHC only). 'throwTo' does not return until the exception has been raised in the target thread. The calling thread can thus be certain that the target thread has received the exception. This is a useful property to know when dealing with race conditions: eg. if there are two threads that can kill each other, it is guaranteed that only one of the threads will get to kill the other. If the target thread is currently making a foreign call, then the exception will not be raised (and hence 'throwTo' will not return) until the call has completed. This is the case regardless of whether the call is inside a 'block' or not. -} throwTo :: ThreadId -> Exception -> IO () throwTo (ThreadId id) ex = IO $ \ s -> case (killThread# id ex s) of s1 -> (# s1, () #) -- | Returns the 'ThreadId' of the calling thread (GHC only). myThreadId :: IO ThreadId myThreadId = IO $ \s -> case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #) -- |The 'yield' action allows (forces, in a co-operative multitasking -- implementation) a context-switch to any other currently runnable -- threads (if any), and is occasionally useful when implementing -- concurrency abstractions. yield :: IO () yield = IO $ \s -> case (yield# s) of s1 -> (# s1, () #) {- | 'labelThread' stores a string as identifier for this thread if you built a RTS with debugging support. This identifier will be used in the debugging output to make distinction of different threads easier (otherwise you only have the thread state object\'s address in the heap). Other applications like the graphical Concurrent Haskell Debugger () may choose to overload 'labelThread' for their purposes as well. -} labelThread :: ThreadId -> String -> IO () labelThread (ThreadId t) str = IO $ \ s -> let ps = packCString# str adr = byteArrayContents# ps in case (labelThread# t adr s) of s1 -> (# s1, () #) -- Nota Bene: 'pseq' used to be 'seq' -- but 'seq' is now defined in PrelGHC -- -- "pseq" is defined a bit weirdly (see below) -- -- The reason for the strange "lazy" call is that -- it fools the compiler into thinking that pseq and par are non-strict in -- their second argument (even if it inlines pseq at the call site). -- If it thinks pseq is strict in "y", then it often evaluates -- "y" before "x", which is totally wrong. {-# INLINE pseq #-} pseq :: a -> b -> b pseq x y = x `seq` lazy y {-# INLINE par #-} par :: a -> b -> b par x y = case (par# x) of { _ -> lazy y } \end{code} %************************************************************************ %* * \subsection[stm]{Transactional heap operations} %* * %************************************************************************ TVars are shared memory locations which support atomic memory transactions. \begin{code} -- |A monad supporting atomic memory transactions. newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #)) unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #)) unSTM (STM a) = a INSTANCE_TYPEABLE1(STM,stmTc,"STM") instance Functor STM where fmap f x = x >>= (return . f) instance Monad STM where {-# INLINE return #-} {-# INLINE (>>) #-} {-# INLINE (>>=) #-} m >> k = thenSTM m k return x = returnSTM x m >>= k = bindSTM m k bindSTM :: STM a -> (a -> STM b) -> STM b bindSTM (STM m) k = STM ( \s -> case m s of (# new_s, a #) -> unSTM (k a) new_s ) thenSTM :: STM a -> STM b -> STM b thenSTM (STM m) k = STM ( \s -> case m s of (# new_s, a #) -> unSTM k new_s ) returnSTM :: a -> STM a returnSTM x = STM (\s -> (# s, x #)) -- | Unsafely performs IO in the STM monad. unsafeIOToSTM :: IO a -> STM a unsafeIOToSTM (IO m) = STM m -- |Perform a series of STM actions atomically. -- -- You cannot use 'atomically' inside an 'unsafePerformIO' or 'unsafeInterleaveIO'. -- Any attempt to do so will result in a runtime error. (Reason: allowing -- this would effectively allow a transaction inside a transaction, depending -- on exactly when the thunk is evaluated.) -- -- However, see 'newTVarIO', which can be called inside 'unsafePerformIO', -- and which allows top-level TVars to be allocated. atomically :: STM a -> IO a atomically (STM m) = IO (\s -> (atomically# m) s ) -- |Retry execution of the current memory transaction because it has seen -- values in TVars which mean that it should not continue (e.g. the TVars -- represent a shared buffer that is now empty). The implementation may -- block the thread until one of the TVars that it has read from has been -- udpated. (GHC only) retry :: STM a retry = STM $ \s# -> retry# s# -- |Compose two alternative STM actions (GHC only). If the first action -- completes without retrying then it forms the result of the orElse. -- Otherwise, if the first action retries, then the second action is -- tried in its place. If both actions retry then the orElse as a -- whole retries. orElse :: STM a -> STM a -> STM a orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s -- |Exception handling within STM actions. catchSTM :: STM a -> (Exception -> STM a) -> STM a catchSTM (STM m) k = STM $ \s -> catchSTM# m (\ex -> unSTM (k ex)) s -- |Shared memory locations that support atomic memory transactions. data TVar a = TVar (TVar# RealWorld a) INSTANCE_TYPEABLE1(TVar,tvarTc,"TVar") instance Eq (TVar a) where (TVar tvar1#) == (TVar tvar2#) = sameTVar# tvar1# tvar2# -- |Create a new TVar holding a value supplied newTVar :: a -> STM (TVar a) newTVar val = STM $ \s1# -> case newTVar# val s1# of (# s2#, tvar# #) -> (# s2#, TVar tvar# #) -- |@IO@ version of 'newTVar'. This is useful for creating top-level -- 'TVar's using 'System.IO.Unsafe.unsafePerformIO', because using -- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't -- possible. newTVarIO :: a -> IO (TVar a) newTVarIO val = IO $ \s1# -> case newTVar# val s1# of (# s2#, tvar# #) -> (# s2#, TVar tvar# #) -- |Return the current value stored in a TVar readTVar :: TVar a -> STM a readTVar (TVar tvar#) = STM $ \s# -> readTVar# tvar# s# -- |Write the supplied value into a TVar writeTVar :: TVar a -> a -> STM () writeTVar (TVar tvar#) val = STM $ \s1# -> case writeTVar# tvar# val s1# of s2# -> (# s2#, () #) \end{code} %************************************************************************ %* * \subsection[mvars]{M-Structures} %* * %************************************************************************ M-Vars are rendezvous points for concurrent threads. They begin empty, and any attempt to read an empty M-Var blocks. When an M-Var is written, a single blocked thread may be freed. Reading an M-Var toggles its state from full back to empty. Therefore, any value written to an M-Var may only be read once. Multiple reads and writes are allowed, but there must be at least one read between any two writes. \begin{code} --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a) -- |Create an 'MVar' which is initially empty. newEmptyMVar :: IO (MVar a) newEmptyMVar = IO $ \ s# -> case newMVar# s# of (# s2#, svar# #) -> (# s2#, MVar svar# #) -- |Create an 'MVar' which contains the supplied value. newMVar :: a -> IO (MVar a) newMVar value = newEmptyMVar >>= \ mvar -> putMVar mvar value >> return mvar -- |Return the contents of the 'MVar'. If the 'MVar' is currently -- empty, 'takeMVar' will wait until it is full. After a 'takeMVar', -- the 'MVar' is left empty. -- -- There are two further important properties of 'takeMVar': -- -- * 'takeMVar' is single-wakeup. That is, if there are multiple -- threads blocked in 'takeMVar', and the 'MVar' becomes full, -- only one thread will be woken up. The runtime guarantees that -- the woken thread completes its 'takeMVar' operation. -- -- * When multiple threads are blocked on an 'MVar', they are -- woken up in FIFO order. This is useful for providing -- fairness properties of abstractions built using 'MVar's. -- takeMVar :: MVar a -> IO a takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s# -- |Put a value into an 'MVar'. If the 'MVar' is currently full, -- 'putMVar' will wait until it becomes empty. -- -- There are two further important properties of 'putMVar': -- -- * 'putMVar' is single-wakeup. That is, if there are multiple -- threads blocked in 'putMVar', and the 'MVar' becomes empty, -- only one thread will be woken up. The runtime guarantees that -- the woken thread completes its 'putMVar' operation. -- -- * When multiple threads are blocked on an 'MVar', they are -- woken up in FIFO order. This is useful for providing -- fairness properties of abstractions built using 'MVar's. -- putMVar :: MVar a -> a -> IO () putMVar (MVar mvar#) x = IO $ \ s# -> case putMVar# mvar# x s# of s2# -> (# s2#, () #) -- |A non-blocking version of 'takeMVar'. The 'tryTakeMVar' function -- returns immediately, with 'Nothing' if the 'MVar' was empty, or -- @'Just' a@ if the 'MVar' was full with contents @a@. After 'tryTakeMVar', -- the 'MVar' is left empty. tryTakeMVar :: MVar a -> IO (Maybe a) tryTakeMVar (MVar m) = IO $ \ s -> case tryTakeMVar# m s of (# s, 0#, _ #) -> (# s, Nothing #) -- MVar is empty (# s, _, a #) -> (# s, Just a #) -- MVar is full -- |A non-blocking version of 'putMVar'. The 'tryPutMVar' function -- attempts to put the value @a@ into the 'MVar', returning 'True' if -- it was successful, or 'False' otherwise. tryPutMVar :: MVar a -> a -> IO Bool tryPutMVar (MVar mvar#) x = IO $ \ s# -> case tryPutMVar# mvar# x s# of (# s, 0# #) -> (# s, False #) (# s, _ #) -> (# s, True #) -- |Check whether a given 'MVar' is empty. -- -- Notice that the boolean value returned is just a snapshot of -- the state of the MVar. By the time you get to react on its result, -- the MVar may have been filled (or emptied) - so be extremely -- careful when using this operation. Use 'tryTakeMVar' instead if possible. isEmptyMVar :: MVar a -> IO Bool isEmptyMVar (MVar mv#) = IO $ \ s# -> case isEmptyMVar# mv# s# of (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #) -- |Add a finalizer to an 'MVar' (GHC only). See "Foreign.ForeignPtr" and -- "System.Mem.Weak" for more about finalizers. addMVarFinalizer :: MVar a -> IO () -> IO () addMVarFinalizer (MVar m) finalizer = IO $ \s -> case mkWeak# m () finalizer s of { (# s1, w #) -> (# s1, () #) } \end{code} %************************************************************************ %* * \subsection{Thread waiting} %* * %************************************************************************ \begin{code} #ifdef mingw32_HOST_OS -- Note: threadDelay, threadWaitRead and threadWaitWrite aren't really functional -- on Win32, but left in there because lib code (still) uses them (the manner -- in which they're used doesn't cause problems on a Win32 platform though.) asyncRead :: Int -> Int -> Int -> Ptr a -> IO (Int, Int) asyncRead (I# fd) (I# isSock) (I# len) (Ptr buf) = IO $ \s -> case asyncRead# fd isSock len buf s of (# s, len#, err# #) -> (# s, (I# len#, I# err#) #) asyncWrite :: Int -> Int -> Int -> Ptr a -> IO (Int, Int) asyncWrite (I# fd) (I# isSock) (I# len) (Ptr buf) = IO $ \s -> case asyncWrite# fd isSock len buf s of (# s, len#, err# #) -> (# s, (I# len#, I# err#) #) asyncDoProc :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int asyncDoProc (FunPtr proc) (Ptr param) = -- the 'length' value is ignored; simplifies implementation of -- the async*# primops to have them all return the same result. IO $ \s -> case asyncDoProc# proc param s of (# s, len#, err# #) -> (# s, I# err# #) -- to aid the use of these primops by the IO Handle implementation, -- provide the following convenience funs: -- this better be a pinned byte array! asyncReadBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int) asyncReadBA fd isSock len off bufB = asyncRead fd isSock len ((Ptr (byteArrayContents# (unsafeCoerce# bufB))) `plusPtr` off) asyncWriteBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int) asyncWriteBA fd isSock len off bufB = asyncWrite fd isSock len ((Ptr (byteArrayContents# (unsafeCoerce# bufB))) `plusPtr` off) #endif -- ----------------------------------------------------------------------------- -- Thread IO API -- | Block the current thread until data is available to read on the -- given file descriptor (GHC only). threadWaitRead :: Fd -> IO () threadWaitRead fd #ifndef mingw32_HOST_OS | threaded = waitForReadEvent fd #endif | otherwise = IO $ \s -> case fromIntegral fd of { I# fd# -> case waitRead# fd# s of { s -> (# s, () #) }} -- | Block the current thread until data can be written to the -- given file descriptor (GHC only). threadWaitWrite :: Fd -> IO () threadWaitWrite fd #ifndef mingw32_HOST_OS | threaded = waitForWriteEvent fd #endif | otherwise = IO $ \s -> case fromIntegral fd of { I# fd# -> case waitWrite# fd# s of { s -> (# s, () #) }} -- | Suspends the current thread for a given number of microseconds -- (GHC only). -- -- Note that the resolution used by the Haskell runtime system's -- internal timer is 1\/50 second, and 'threadDelay' will round its -- argument up to the nearest multiple of this resolution. -- -- There is no guarantee that the thread will be rescheduled promptly -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. -- threadDelay :: Int -> IO () threadDelay time #ifndef mingw32_HOST_OS | threaded = waitForDelayEvent time #else | threaded = c_Sleep (fromIntegral (time `quot` 1000)) #endif | otherwise = IO $ \s -> case fromIntegral time of { I# time# -> case delay# time# s of { s -> (# s, () #) }} registerDelay :: Int -> IO (TVar Bool) registerDelay usecs #ifndef mingw32_HOST_OS | threaded = waitForDelayEventSTM usecs | otherwise = error "registerDelay: requires -threaded" #else = error "registerDelay: not currently supported on Windows" #endif -- On Windows, we just make a safe call to 'Sleep' to implement threadDelay. #ifdef mingw32_HOST_OS foreign import stdcall safe "Sleep" c_Sleep :: CInt -> IO () #endif foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool -- ---------------------------------------------------------------------------- -- Threaded RTS implementation of threadWaitRead, threadWaitWrite, threadDelay -- In the threaded RTS, we employ a single IO Manager thread to wait -- for all outstanding IO requests (threadWaitRead,threadWaitWrite) -- and delays (threadDelay). -- -- We can do this because in the threaded RTS the IO Manager can make -- a non-blocking call to select(), so we don't have to do select() in -- the scheduler as we have to in the non-threaded RTS. We get performance -- benefits from doing it this way, because we only have to restart the select() -- when a new request arrives, rather than doing one select() each time -- around the scheduler loop. Furthermore, the scheduler can be simplified -- by not having to check for completed IO requests. -- Issues, possible problems: -- -- - we might want bound threads to just do the blocking -- operation rather than communicating with the IO manager -- thread. This would prevent simgle-threaded programs which do -- IO from requiring multiple OS threads. However, it would also -- prevent bound threads waiting on IO from being killed or sent -- exceptions. -- -- - Apprently exec() doesn't work on Linux in a multithreaded program. -- I couldn't repeat this. -- -- - How do we handle signal delivery in the multithreaded RTS? -- -- - forkProcess will kill the IO manager thread. Let's just -- hope we don't need to do any blocking IO between fork & exec. #ifndef mingw32_HOST_OS data IOReq = Read {-# UNPACK #-} !Fd {-# UNPACK #-} !(MVar ()) | Write {-# UNPACK #-} !Fd {-# UNPACK #-} !(MVar ()) data DelayReq = Delay {-# UNPACK #-} !Int {-# UNPACK #-} !(MVar ()) | DelaySTM {-# UNPACK #-} !Int {-# UNPACK #-} !(TVar Bool) pendingEvents :: IORef [IOReq] pendingDelays :: IORef [DelayReq] -- could use a strict list or array here {-# NOINLINE pendingEvents #-} {-# NOINLINE pendingDelays #-} (pendingEvents,pendingDelays) = unsafePerformIO $ do startIOManagerThread reqs <- newIORef [] dels <- newIORef [] return (reqs, dels) -- the first time we schedule an IO request, the service thread -- will be created (cool, huh?) ensureIOManagerIsRunning :: IO () ensureIOManagerIsRunning | threaded = seq pendingEvents $ return () | otherwise = return () startIOManagerThread :: IO () startIOManagerThread = do allocaArray 2 $ \fds -> do throwErrnoIfMinus1 "startIOManagerThread" (c_pipe fds) rd_end <- peekElemOff fds 0 wr_end <- peekElemOff fds 1 writeIORef stick (fromIntegral wr_end) c_setIOManagerPipe wr_end forkIO $ do allocaBytes sizeofFdSet $ \readfds -> do allocaBytes sizeofFdSet $ \writefds -> do allocaBytes sizeofTimeVal $ \timeval -> do service_loop (fromIntegral rd_end) readfds writefds timeval [] [] return () service_loop :: Fd -- listen to this for wakeup calls -> Ptr CFdSet -> Ptr CFdSet -> Ptr CTimeVal -> [IOReq] -> [DelayReq] -> IO () service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do -- pick up new IO requests new_reqs <- atomicModifyIORef pendingEvents (\a -> ([],a)) let reqs = new_reqs ++ old_reqs -- pick up new delay requests new_delays <- atomicModifyIORef pendingDelays (\a -> ([],a)) let delays = foldr insertDelay old_delays new_delays -- build the FDSets for select() fdZero readfds fdZero writefds fdSet wakeup readfds maxfd <- buildFdSets 0 readfds writefds reqs -- perform the select() let do_select delays = do -- check the current time and wake up any thread in -- threadDelay whose timeout has expired. Also find the -- timeout value for the select() call. now <- getTicksOfDay (delays', timeout) <- getDelay now ptimeval delays res <- c_select ((max wakeup maxfd)+1) readfds writefds nullPtr timeout if (res == -1) then do err <- getErrno case err of _ | err == eINTR -> do_select delays' -- EINTR: just redo the select() _ | err == eBADF -> return (True, delays) -- EBADF: one of the file descriptors is closed or bad, -- we don't know which one, so wake everyone up. _ | otherwise -> throwErrno "select" -- otherwise (ENOMEM or EINVAL) something has gone -- wrong; report the error. else return (False,delays') (wakeup_all,delays') <- do_select delays exit <- if wakeup_all then return False else do b <- fdIsSet wakeup readfds if b == 0 then return False else alloca $ \p -> do c_read (fromIntegral wakeup) p 1; return () s <- peek p case s of _ | s == io_MANAGER_WAKEUP -> return False _ | s == io_MANAGER_DIE -> return True _ -> do handler_tbl <- peek handlers sp <- peekElemOff handler_tbl (fromIntegral s) forkIO (do io <- deRefStablePtr sp; io) return False if exit then return () else do takeMVar prodding putMVar prodding False reqs' <- if wakeup_all then do wakeupAll reqs; return [] else completeRequests reqs readfds writefds [] service_loop wakeup readfds writefds ptimeval reqs' delays' stick :: IORef Fd {-# NOINLINE stick #-} stick = unsafePerformIO (newIORef 0) io_MANAGER_WAKEUP = 0xff :: CChar io_MANAGER_DIE = 0xfe :: CChar prodding :: MVar Bool {-# NOINLINE prodding #-} prodding = unsafePerformIO (newMVar False) prodServiceThread :: IO () prodServiceThread = do b <- takeMVar prodding if (not b) then do fd <- readIORef stick with io_MANAGER_WAKEUP $ \pbuf -> do c_write (fromIntegral fd) pbuf 1; return () else return () putMVar prodding True foreign import ccall "&signal_handlers" handlers :: Ptr (Ptr (StablePtr (IO ()))) foreign import ccall "setIOManagerPipe" c_setIOManagerPipe :: CInt -> IO () -- ----------------------------------------------------------------------------- -- IO requests buildFdSets maxfd readfds writefds [] = return maxfd buildFdSets maxfd readfds writefds (Read fd m : reqs) | fd >= fD_SETSIZE = error "buildFdSets: file descriptor out of range" | otherwise = do fdSet fd readfds buildFdSets (max maxfd fd) readfds writefds reqs buildFdSets maxfd readfds writefds (Write fd m : reqs) | fd >= fD_SETSIZE = error "buildFdSets: file descriptor out of range" | otherwise = do fdSet fd writefds buildFdSets (max maxfd fd) readfds writefds reqs completeRequests [] _ _ reqs' = return reqs' completeRequests (Read fd m : reqs) readfds writefds reqs' = do b <- fdIsSet fd readfds if b /= 0 then do putMVar m (); completeRequests reqs readfds writefds reqs' else completeRequests reqs readfds writefds (Read fd m : reqs') completeRequests (Write fd m : reqs) readfds writefds reqs' = do b <- fdIsSet fd writefds if b /= 0 then do putMVar m (); completeRequests reqs readfds writefds reqs' else completeRequests reqs readfds writefds (Write fd m : reqs') wakeupAll [] = return () wakeupAll (Read fd m : reqs) = do putMVar m (); wakeupAll reqs wakeupAll (Write fd m : reqs) = do putMVar m (); wakeupAll reqs waitForReadEvent :: Fd -> IO () waitForReadEvent fd = do m <- newEmptyMVar atomicModifyIORef pendingEvents (\xs -> (Read fd m : xs, ())) prodServiceThread takeMVar m waitForWriteEvent :: Fd -> IO () waitForWriteEvent fd = do m <- newEmptyMVar atomicModifyIORef pendingEvents (\xs -> (Write fd m : xs, ())) prodServiceThread takeMVar m -- XXX: move into GHC.IOBase from Data.IORef? atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b atomicModifyIORef (IORef (STRef r#)) f = IO $ \s -> atomicModifyMutVar# r# f s -- ----------------------------------------------------------------------------- -- Delays waitForDelayEvent :: Int -> IO () waitForDelayEvent usecs = do m <- newEmptyMVar now <- getTicksOfDay let target = now + usecs `quot` tick_usecs atomicModifyIORef pendingDelays (\xs -> (Delay target m : xs, ())) prodServiceThread takeMVar m -- Delays for use in STM waitForDelayEventSTM :: Int -> IO (TVar Bool) waitForDelayEventSTM usecs = do t <- atomically $ newTVar False now <- getTicksOfDay let target = now + usecs `quot` tick_usecs atomicModifyIORef pendingDelays (\xs -> (DelaySTM target t : xs, ())) prodServiceThread return t -- Walk the queue of pending delays, waking up any that have passed -- and return the smallest delay to wait for. The queue of pending -- delays is kept ordered. getDelay :: Ticks -> Ptr CTimeVal -> [DelayReq] -> IO ([DelayReq], Ptr CTimeVal) getDelay now ptimeval [] = return ([],nullPtr) getDelay now ptimeval all@(d : rest) = case d of Delay time m | now >= time -> do putMVar m () getDelay now ptimeval rest DelaySTM time t | now >= time -> do atomically $ writeTVar t True getDelay now ptimeval rest _otherwise -> do setTimevalTicks ptimeval (delayTime d - now) return (all,ptimeval) insertDelay :: DelayReq -> [DelayReq] -> [DelayReq] insertDelay d [] = [d] insertDelay d1 ds@(d2 : rest) | delayTime d1 <= delayTime d2 = d1 : ds | otherwise = d2 : insertDelay d1 rest delayTime (Delay t _) = t delayTime (DelaySTM t _) = t type Ticks = Int tick_freq = 50 :: Ticks -- accuracy of threadDelay (ticks per sec) tick_usecs = 1000000 `quot` tick_freq :: Int newtype CTimeVal = CTimeVal () foreign import ccall unsafe "sizeofTimeVal" sizeofTimeVal :: Int foreign import ccall unsafe "getTicksOfDay" getTicksOfDay :: IO Ticks foreign import ccall unsafe "setTimevalTicks" setTimevalTicks :: Ptr CTimeVal -> Ticks -> IO () -- ---------------------------------------------------------------------------- -- select() interface -- ToDo: move to System.Posix.Internals? newtype CFdSet = CFdSet () foreign import ccall safe "select" c_select :: Fd -> Ptr CFdSet -> Ptr CFdSet -> Ptr CFdSet -> Ptr CTimeVal -> IO CInt foreign import ccall unsafe "hsFD_SETSIZE" fD_SETSIZE :: Fd foreign import ccall unsafe "hsFD_CLR" fdClr :: Fd -> Ptr CFdSet -> IO () foreign import ccall unsafe "hsFD_ISSET" fdIsSet :: Fd -> Ptr CFdSet -> IO CInt foreign import ccall unsafe "hsFD_SET" fdSet :: Fd -> Ptr CFdSet -> IO () foreign import ccall unsafe "hsFD_ZERO" fdZero :: Ptr CFdSet -> IO () foreign import ccall unsafe "sizeof_fd_set" sizeofFdSet :: Int #endif \end{code} hugs98-plus-Sep2006/packages/base/GHC/Dotnet.hs0000644006511100651110000000343310504340221017637 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Dotnet -- Copyright : (c) sof, 2003 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- Primitive operations and types for doing .NET interop -- ----------------------------------------------------------------------------- module GHC.Dotnet ( Object , unmarshalObject , marshalObject , unmarshalString , marshalString , checkResult ) where import GHC.Prim import GHC.Base import GHC.IO import GHC.IOBase import GHC.Ptr import Foreign.Marshal.Array import Foreign.Marshal.Alloc import Foreign.Storable import Foreign.C.String data Object a = Object Addr# checkResult :: (State# RealWorld -> (# State# RealWorld, a, Addr# #)) -> IO a checkResult fun = IO $ \ st -> case fun st of (# st1, res, err #) | err `eqAddr#` nullAddr# -> (# st1, res #) | otherwise -> throw (IOException (raiseError err)) st1 -- ToDo: attach finaliser. unmarshalObject :: Addr# -> Object a unmarshalObject x = Object x marshalObject :: Object a -> (Addr# -> IO b) -> IO b marshalObject (Object x) cont = cont x -- dotnet interop support passing and returning -- strings. marshalString :: String -> (Addr# -> IO a) -> IO a marshalString str cont = withCString str (\ (Ptr x) -> cont x) -- char** received back from a .NET interop layer. unmarshalString :: Addr# -> String unmarshalString p = unsafePerformIO $ do let ptr = Ptr p str <- peekCString ptr free ptr return str -- room for improvement.. raiseError :: Addr# -> IOError raiseError p = userError (".NET error: " ++ unmarshalString p) hugs98-plus-Sep2006/packages/base/GHC/ConsoleHandler.hs0000644006511100651110000000613410504340225021307 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.ConsoleHandler -- Copyright : (c) The University of Glasgow -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- NB. the contents of this module are only available on Windows. -- -- Installing Win32 console handlers. -- ----------------------------------------------------------------------------- module GHC.ConsoleHandler #if !defined(mingw32_HOST_OS) && !defined(__HADDOCK__) where import Prelude -- necessary to get dependencies right #else /* whole file */ ( Handler(..) , installHandler , ConsoleEvent(..) , flushConsole ) where {- #include "Signals.h" -} import Prelude -- necessary to get dependencies right import Foreign import Foreign.C import GHC.IOBase import GHC.Handle data Handler = Default | Ignore | Catch (ConsoleEvent -> IO ()) data ConsoleEvent = ControlC | Break | Close -- these are sent to Services only. | Logoff | Shutdown installHandler :: Handler -> IO Handler installHandler handler = alloca $ \ p_sp -> do rc <- case handler of Default -> rts_installHandler STG_SIG_DFL p_sp Ignore -> rts_installHandler STG_SIG_IGN p_sp Catch h -> do v <- newStablePtr (toHandler h) poke p_sp v rts_installHandler STG_SIG_HAN p_sp case rc of STG_SIG_DFL -> return Default STG_SIG_IGN -> return Ignore STG_SIG_HAN -> do osptr <- peek p_sp oldh <- deRefStablePtr osptr -- stable pointer is no longer in use, free it. freeStablePtr osptr return (Catch (\ ev -> oldh (fromConsoleEvent ev))) where toConsoleEvent ev = case ev of 0 {- CTRL_C_EVENT-} -> Just ControlC 1 {- CTRL_BREAK_EVENT-} -> Just Break 2 {- CTRL_CLOSE_EVENT-} -> Just Close 5 {- CTRL_LOGOFF_EVENT-} -> Just Logoff 6 {- CTRL_SHUTDOWN_EVENT-} -> Just Shutdown _ -> Nothing fromConsoleEvent ev = case ev of ControlC -> 0 {- CTRL_C_EVENT-} Break -> 1 {- CTRL_BREAK_EVENT-} Close -> 2 {- CTRL_CLOSE_EVENT-} Logoff -> 5 {- CTRL_LOGOFF_EVENT-} Shutdown -> 6 {- CTRL_SHUTDOWN_EVENT-} toHandler hdlr ev = do case toConsoleEvent ev of -- see rts/win32/ConsoleHandler.c for comments as to why -- rts_ConsoleHandlerDone is called here. Just x -> hdlr x >> rts_ConsoleHandlerDone ev Nothing -> return () -- silently ignore.. foreign import ccall unsafe "RtsExternal.h rts_InstallConsoleEvent" rts_installHandler :: CInt -> Ptr (StablePtr (CInt -> IO ())) -> IO CInt foreign import ccall unsafe "RtsExternal.h rts_ConsoleHandlerDone" rts_ConsoleHandlerDone :: CInt -> IO () flushConsole :: Handle -> IO () flushConsole h = wantReadableHandle "flushConsole" h $ \ h_ -> throwErrnoIfMinus1Retry_ "flushConsole" (flush_console_fd (fromIntegral (haFD h_))) foreign import ccall unsafe "consUtils.h flush_input_console__" flush_console_fd :: CInt -> IO CInt #endif /* mingw32_HOST_OS */ hugs98-plus-Sep2006/packages/base/GHC/Enum.lhs0000644006511100651110000004353710504340221017473 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Enum -- Copyright : (c) The University of Glasgow, 1992-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- The 'Enum' and 'Bounded' classes. -- ----------------------------------------------------------------------------- -- #hide module GHC.Enum( Bounded(..), Enum(..), boundedEnumFrom, boundedEnumFromThen, -- Instances for Bounded and Enum: (), Char, Int ) where import GHC.Base import Data.Tuple () -- for dependencies default () -- Double isn't available yet \end{code} %********************************************************* %* * \subsection{Class declarations} %* * %********************************************************* \begin{code} -- | The 'Bounded' class is used to name the upper and lower limits of a -- type. 'Ord' is not a superclass of 'Bounded' since types that are not -- totally ordered may also have upper and lower bounds. -- -- The 'Bounded' class may be derived for any enumeration type; -- 'minBound' is the first constructor listed in the @data@ declaration -- and 'maxBound' is the last. -- 'Bounded' may also be derived for single-constructor datatypes whose -- constituent types are in 'Bounded'. class Bounded a where minBound, maxBound :: a -- | Class 'Enum' defines operations on sequentially ordered types. -- -- The @enumFrom@... methods are used in Haskell's translation of -- arithmetic sequences. -- -- Instances of 'Enum' may be derived for any enumeration type (types -- whose constructors have no fields). The nullary constructors are -- assumed to be numbered left-to-right by 'fromEnum' from @0@ through @n-1@. -- See Chapter 10 of the /Haskell Report/ for more details. -- -- For any type that is an instance of class 'Bounded' as well as 'Enum', -- the following should hold: -- -- * The calls @'succ' 'maxBound'@ and @'pred' 'minBound'@ should result in -- a runtime error. -- -- * 'fromEnum' and 'toEnum' should give a runtime error if the -- result value is not representable in the result type. -- For example, @'toEnum' 7 :: 'Bool'@ is an error. -- -- * 'enumFrom' and 'enumFromThen' should be defined with an implicit bound, -- thus: -- -- > enumFrom x = enumFromTo x maxBound -- > enumFromThen x y = enumFromThenTo x y bound -- > where -- > bound | fromEnum y >= fromEnum x = maxBound -- > | otherwise = minBound -- class Enum a where -- | the successor of a value. For numeric types, 'succ' adds 1. succ :: a -> a -- | the predecessor of a value. For numeric types, 'pred' subtracts 1. pred :: a -> a -- | Convert from an 'Int'. toEnum :: Int -> a -- | Convert to an 'Int'. -- It is implementation-dependent what 'fromEnum' returns when -- applied to a value that is too large to fit in an 'Int'. fromEnum :: a -> Int -- | Used in Haskell's translation of @[n..]@. enumFrom :: a -> [a] -- | Used in Haskell's translation of @[n,n'..]@. enumFromThen :: a -> a -> [a] -- | Used in Haskell's translation of @[n..m]@. enumFromTo :: a -> a -> [a] -- | Used in Haskell's translation of @[n,n'..m]@. enumFromThenTo :: a -> a -> a -> [a] succ = toEnum . (`plusInt` oneInt) . fromEnum pred = toEnum . (`minusInt` oneInt) . fromEnum enumFrom x = map toEnum [fromEnum x ..] enumFromThen x y = map toEnum [fromEnum x, fromEnum y ..] enumFromTo x y = map toEnum [fromEnum x .. fromEnum y] enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y] -- Default methods for bounded enumerations boundedEnumFrom :: (Enum a, Bounded a) => a -> [a] boundedEnumFrom n = map toEnum [fromEnum n .. fromEnum (maxBound `asTypeOf` n)] boundedEnumFromThen :: (Enum a, Bounded a) => a -> a -> [a] boundedEnumFromThen n1 n2 | i_n2 >= i_n1 = map toEnum [i_n1, i_n2 .. fromEnum (maxBound `asTypeOf` n1)] | otherwise = map toEnum [i_n1, i_n2 .. fromEnum (minBound `asTypeOf` n1)] where i_n1 = fromEnum n1 i_n2 = fromEnum n2 \end{code} %********************************************************* %* * \subsection{Tuples} %* * %********************************************************* \begin{code} instance Bounded () where minBound = () maxBound = () instance Enum () where succ _ = error "Prelude.Enum.().succ: bad argument" pred _ = error "Prelude.Enum.().pred: bad argument" toEnum x | x == zeroInt = () | otherwise = error "Prelude.Enum.().toEnum: bad argument" fromEnum () = zeroInt enumFrom () = [()] enumFromThen () () = let many = ():many in many enumFromTo () () = [()] enumFromThenTo () () () = let many = ():many in many \end{code} \begin{code} -- Report requires instances up to 15 instance (Bounded a, Bounded b) => Bounded (a,b) where minBound = (minBound, minBound) maxBound = (maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c) => Bounded (a,b,c) where minBound = (minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a,b,c,d) where minBound = (minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e) => Bounded (a,b,c,d,e) where minBound = (minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f) => Bounded (a,b,c,d,e,f) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g) => Bounded (a,b,c,d,e,f,g) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h) => Bounded (a,b,c,d,e,f,g,h) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i) => Bounded (a,b,c,d,e,f,g,h,i) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j) => Bounded (a,b,c,d,e,f,g,h,i,j) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k) => Bounded (a,b,c,d,e,f,g,h,i,j,k) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n, Bounded o) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound) maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound) \end{code} %********************************************************* %* * \subsection{Type @Bool@} %* * %********************************************************* \begin{code} instance Bounded Bool where minBound = False maxBound = True instance Enum Bool where succ False = True succ True = error "Prelude.Enum.Bool.succ: bad argument" pred True = False pred False = error "Prelude.Enum.Bool.pred: bad argument" toEnum n | n == zeroInt = False | n == oneInt = True | otherwise = error "Prelude.Enum.Bool.toEnum: bad argument" fromEnum False = zeroInt fromEnum True = oneInt -- Use defaults for the rest enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen \end{code} %********************************************************* %* * \subsection{Type @Ordering@} %* * %********************************************************* \begin{code} instance Bounded Ordering where minBound = LT maxBound = GT instance Enum Ordering where succ LT = EQ succ EQ = GT succ GT = error "Prelude.Enum.Ordering.succ: bad argument" pred GT = EQ pred EQ = LT pred LT = error "Prelude.Enum.Ordering.pred: bad argument" toEnum n | n == zeroInt = LT | n == oneInt = EQ | n == twoInt = GT toEnum _ = error "Prelude.Enum.Ordering.toEnum: bad argument" fromEnum LT = zeroInt fromEnum EQ = oneInt fromEnum GT = twoInt -- Use defaults for the rest enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen \end{code} %********************************************************* %* * \subsection{Type @Char@} %* * %********************************************************* \begin{code} instance Bounded Char where minBound = '\0' maxBound = '\x10FFFF' instance Enum Char where succ (C# c#) | not (ord# c# ==# 0x10FFFF#) = C# (chr# (ord# c# +# 1#)) | otherwise = error ("Prelude.Enum.Char.succ: bad argument") pred (C# c#) | not (ord# c# ==# 0#) = C# (chr# (ord# c# -# 1#)) | otherwise = error ("Prelude.Enum.Char.pred: bad argument") toEnum = chr fromEnum = ord {-# INLINE enumFrom #-} enumFrom (C# x) = eftChar (ord# x) 0x10FFFF# -- Blarg: technically I guess enumFrom isn't strict! {-# INLINE enumFromTo #-} enumFromTo (C# x) (C# y) = eftChar (ord# x) (ord# y) {-# INLINE enumFromThen #-} enumFromThen (C# x1) (C# x2) = efdChar (ord# x1) (ord# x2) {-# INLINE enumFromThenTo #-} enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y) {-# RULES "eftChar" [~1] forall x y. eftChar x y = build (\c n -> eftCharFB c n x y) "efdChar" [~1] forall x1 x2. efdChar x1 x2 = build (\ c n -> efdCharFB c n x1 x2) "efdtChar" [~1] forall x1 x2 l. efdtChar x1 x2 l = build (\ c n -> efdtCharFB c n x1 x2 l) "eftCharList" [1] eftCharFB (:) [] = eftChar "efdCharList" [1] efdCharFB (:) [] = efdChar "efdtCharList" [1] efdtCharFB (:) [] = efdtChar #-} -- We can do better than for Ints because we don't -- have hassles about arithmetic overflow at maxBound {-# INLINE [0] eftCharFB #-} eftCharFB c n x y = go x where go x | x ># y = n | otherwise = C# (chr# x) `c` go (x +# 1#) eftChar x y | x ># y = [] | otherwise = C# (chr# x) : eftChar (x +# 1#) y -- For enumFromThenTo we give up on inlining {-# NOINLINE [0] efdCharFB #-} efdCharFB c n x1 x2 | delta >=# 0# = go_up_char_fb c n x1 delta 0x10FFFF# | otherwise = go_dn_char_fb c n x1 delta 0# where delta = x2 -# x1 efdChar x1 x2 | delta >=# 0# = go_up_char_list x1 delta 0x10FFFF# | otherwise = go_dn_char_list x1 delta 0# where delta = x2 -# x1 {-# NOINLINE [0] efdtCharFB #-} efdtCharFB c n x1 x2 lim | delta >=# 0# = go_up_char_fb c n x1 delta lim | otherwise = go_dn_char_fb c n x1 delta lim where delta = x2 -# x1 efdtChar x1 x2 lim | delta >=# 0# = go_up_char_list x1 delta lim | otherwise = go_dn_char_list x1 delta lim where delta = x2 -# x1 go_up_char_fb c n x delta lim = go_up x where go_up x | x ># lim = n | otherwise = C# (chr# x) `c` go_up (x +# delta) go_dn_char_fb c n x delta lim = go_dn x where go_dn x | x <# lim = n | otherwise = C# (chr# x) `c` go_dn (x +# delta) go_up_char_list x delta lim = go_up x where go_up x | x ># lim = [] | otherwise = C# (chr# x) : go_up (x +# delta) go_dn_char_list x delta lim = go_dn x where go_dn x | x <# lim = [] | otherwise = C# (chr# x) : go_dn (x +# delta) \end{code} %********************************************************* %* * \subsection{Type @Int@} %* * %********************************************************* Be careful about these instances. (a) remember that you have to count down as well as up e.g. [13,12..0] (b) be careful of Int overflow (c) remember that Int is bounded, so [1..] terminates at maxInt Also NB that the Num class isn't available in this module. \begin{code} instance Bounded Int where minBound = minInt maxBound = maxInt instance Enum Int where succ x | x == maxBound = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound" | otherwise = x `plusInt` oneInt pred x | x == minBound = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound" | otherwise = x `minusInt` oneInt toEnum x = x fromEnum x = x {-# INLINE enumFrom #-} enumFrom (I# x) = eftInt x maxInt# where I# maxInt# = maxInt -- Blarg: technically I guess enumFrom isn't strict! {-# INLINE enumFromTo #-} enumFromTo (I# x) (I# y) = eftInt x y {-# INLINE enumFromThen #-} enumFromThen (I# x1) (I# x2) = efdInt x1 x2 {-# INLINE enumFromThenTo #-} enumFromThenTo (I# x1) (I# x2) (I# y) = efdtInt x1 x2 y ----------------------------------------------------- -- eftInt and eftIntFB deal with [a..b], which is the -- most common form, so we take a lot of care -- In particular, we have rules for deforestation {-# RULES "eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y) "eftIntList" [1] eftIntFB (:) [] = eftInt #-} eftInt :: Int# -> Int# -> [Int] -- [x1..x2] eftInt x y | x ># y = [] | otherwise = go x where go x = I# x : if x ==# y then [] else go (x +# 1#) {-# INLINE [0] eftIntFB #-} eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r eftIntFB c n x y | x ># y = n | otherwise = go x where go x = I# x `c` if x ==# y then n else go (x +# 1#) -- Watch out for y=maxBound; hence ==, not > -- Be very careful not to have more than one "c" -- so that when eftInfFB is inlined we can inline -- whatver is bound to "c" ----------------------------------------------------- -- efdInt and efdtInt deal with [a,b..] and [a,b..c], which are much less common -- so we are less elaborate. The code is more complicated anyway, because -- of worries about Int overflow, so we don't both with rules and deforestation efdInt :: Int# -> Int# -> [Int] -- [x1,x2..maxInt] efdInt x1 x2 | x2 >=# x1 = case maxInt of I# y -> efdtIntUp x1 x2 y | otherwise = case minInt of I# y -> efdtIntDn x1 x2 y efdtInt :: Int# -> Int# -> Int# -> [Int] -- [x1,x2..y] efdtInt x1 x2 y | x2 >=# x1 = efdtIntUp x1 x2 y | otherwise = efdtIntDn x1 x2 y efdtIntUp :: Int# -> Int# -> Int# -> [Int] efdtIntUp x1 x2 y -- Be careful about overflow! | y <# x2 = if y <# x1 then [] else [I# x1] | otherwise = -- Common case: x1 < x2 <= y let delta = x2 -# x1 y' = y -# delta -- NB: x1 <= y'; hence y' is representable -- Invariant: x <= y; and x+delta won't overflow go_up x | x ># y' = [I# x] | otherwise = I# x : go_up (x +# delta) in I# x1 : go_up x2 efdtIntDn :: Int# -> Int# -> Int# -> [Int] efdtIntDn x1 x2 y -- x2 < x1 | y ># x2 = if y ># x1 then [] else [I# x1] | otherwise = -- Common case: x1 > x2 >= y let delta = x2 -# x1 y' = y -# delta -- NB: x1 <= y'; hence y' is representable -- Invariant: x >= y; and x+delta won't overflow go_dn x | x <# y' = [I# x] | otherwise = I# x : go_dn (x +# delta) in I# x1 : go_dn x2 \end{code} hugs98-plus-Sep2006/packages/base/GHC/Err.lhs0000644006511100651110000001007410504340221017305 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Err -- Copyright : (c) The University of Glasgow, 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- The "GHC.Err" module defines the code for the wired-in error functions, -- which have a special type in the compiler (with \"open tyvars\"). -- -- We cannot define these functions in a module where they might be used -- (e.g., "GHC.Base"), because the magical wired-in type will get confused -- with what the typechecker figures out. -- ----------------------------------------------------------------------------- -- #hide module GHC.Err ( irrefutPatError , noMethodBindingError , nonExhaustiveGuardsError , patError , recSelError , recConError , runtimeError -- :: Addr# -> a -- Addr# points to UTF8 encoded C string , absentErr -- :: a , divZeroError -- :: a , error -- :: String -> a , assertError -- :: String -> Bool -> a -> a , undefined -- :: a ) where #ifndef __HADDOCK__ import GHC.Base import GHC.List ( span ) import GHC.Exception #endif \end{code} %********************************************************* %* * \subsection{Error-ish functions} %* * %********************************************************* \begin{code} -- | 'error' stops execution and displays an error message. error :: String -> a error s = throw (ErrorCall s) -- | A special case of 'error'. -- It is expected that compilers will recognize this and insert error -- messages which are more appropriate to the context in which 'undefined' -- appears. undefined :: a undefined = error "Prelude.undefined" \end{code} %********************************************************* %* * \subsection{Compiler generated errors + local utils} %* * %********************************************************* Used for compiler-generated error message; encoding saves bytes of string junk. \begin{code} absentErr :: a absentErr = error "Oops! The program has entered an `absent' argument!\n" \end{code} \begin{code} recSelError, recConError, irrefutPatError, runtimeError, nonExhaustiveGuardsError, patError, noMethodBindingError :: Addr# -> a -- All take a UTF8-encoded C string recSelError s = throw (RecSelError (unpackCStringUtf8# s)) -- No location info unfortunately runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in")) irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern")) recConError s = throw (RecConError (untangle s "Missing field in record construction")) noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation")) patError s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in")) assertError :: Addr# -> Bool -> a -> a assertError str pred v | pred = v | otherwise = throw (AssertionFailed (untangle str "Assertion failed")) \end{code} (untangle coded message) expects "coded" to be of the form "location|details" It prints location message details \begin{code} untangle :: Addr# -> String -> String untangle coded message = location ++ ": " ++ message ++ details ++ "\n" where coded_str = unpackCStringUtf8# coded (location, details) = case (span not_bar coded_str) of { (loc, rest) -> case rest of ('|':det) -> (loc, ' ' : det) _ -> (loc, "") } not_bar c = c /= '|' \end{code} Divide by zero. We put it here because it is needed relatively early in the libraries before the Exception type has been defined yet. \begin{code} {-# NOINLINE divZeroError #-} divZeroError :: a divZeroError = throw (ArithException DivideByZero) \end{code} hugs98-plus-Sep2006/packages/base/GHC/Unicode.hs-boot0000644006511100651110000000062210504340221020726 0ustar rossross{-# OPTIONS -fno-implicit-prelude #-} module GHC.Unicode where import GHC.Base( Char, Bool ) isAscii :: Char -> Bool isLatin1 :: Char -> Bool isControl :: Char -> Bool isPrint :: Char -> Bool isSpace :: Char -> Bool isUpper :: Char -> Bool isLower :: Char -> Bool isAlpha :: Char -> Bool isDigit :: Char -> Bool isOctDigit :: Char -> Bool isHexDigit :: Char -> Bool isAlphaNum :: Char -> Bool hugs98-plus-Sep2006/packages/base/GHC/Exception.lhs0000644006511100651110000001040210504340226020513 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Exception -- Copyright : (c) The University of Glasgow, 1998-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- Exceptions and exception-handling functions. -- ----------------------------------------------------------------------------- -- #hide module GHC.Exception ( module GHC.Exception, Exception(..), AsyncException(..), IOException(..), ArithException(..), ArrayException(..), throw, throwIO, ioError ) where import GHC.Base import GHC.IOBase \end{code} %********************************************************* %* * \subsection{Primitive catch} %* * %********************************************************* catchException used to handle the passing around of the state to the action and the handler. This turned out to be a bad idea - it meant that we had to wrap both arguments in thunks so they could be entered as normal (remember IO returns an unboxed pair...). Now catch# has type catch# :: IO a -> (b -> IO a) -> IO a (well almost; the compiler doesn't know about the IO newtype so we have to work around that in the definition of catchException below). \begin{code} catchException :: IO a -> (Exception -> IO a) -> IO a catchException (IO m) k = IO $ \s -> catch# m (\ex -> unIO (k ex)) s -- | The 'catch' function establishes a handler that receives any 'IOError' -- raised in the action protected by 'catch'. An 'IOError' is caught by -- the most recent handler established by 'catch'. These handlers are -- not selective: all 'IOError's are caught. Exception propagation -- must be explicitly provided in a handler by re-raising any unwanted -- exceptions. For example, in -- -- > f = catch g (\e -> if IO.isEOFError e then return [] else ioError e) -- -- the function @f@ returns @[]@ when an end-of-file exception -- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the -- exception is propagated to the next outer handler. -- -- When an exception propagates outside the main program, the Haskell -- system prints the associated 'IOError' value and exits the program. -- -- Non-I\/O exceptions are not caught by this variant; to catch all -- exceptions, use 'Control.Exception.catch' from "Control.Exception". catch :: IO a -> (IOError -> IO a) -> IO a catch m k = catchException m handler where handler (IOException err) = k err handler other = throw other \end{code} %********************************************************* %* * \subsection{Controlling asynchronous exception delivery} %* * %********************************************************* \begin{code} -- | Applying 'block' to a computation will -- execute that computation with asynchronous exceptions -- /blocked/. That is, any thread which -- attempts to raise an exception in the current thread will be -- blocked until asynchronous exceptions are enabled again. There\'s -- no need to worry about re-enabling asynchronous exceptions; that is -- done automatically on exiting the scope of -- 'block'. block :: IO a -> IO a -- | To re-enable asynchronous exceptions inside the scope of -- 'block', 'unblock' can be -- used. It scopes in exactly the same way, so on exit from -- 'unblock' asynchronous exception delivery will -- be disabled again. unblock :: IO a -> IO a block (IO io) = IO $ blockAsyncExceptions# io unblock (IO io) = IO $ unblockAsyncExceptions# io \end{code} \begin{code} -- | Forces its argument to be evaluated, and returns the result in -- the 'IO' monad. It can be used to order evaluation with respect to -- other 'IO' operations; its semantics are given by -- -- > evaluate x `seq` y ==> y -- > evaluate x `catch` f ==> (return $! x) `catch` f -- > evaluate x >>= f ==> (return $! x) >>= f -- -- /Note:/ the first equation implies that @(evaluate x)@ is /not/ the -- same as @(return $! x)@. evaluate :: a -> IO a evaluate a = IO $ \s -> case a `seq` () of () -> (# s, a #) -- NB. can't write -- a `seq` (# s, a #) -- because we can't have an unboxed tuple as a function argument \end{code} hugs98-plus-Sep2006/packages/base/GHC/Exts.hs0000644006511100651110000000212510504340223017324 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : GHC.Exts -- Copyright : (c) The University of Glasgow 2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- GHC Extensions: this is the Approved Way to get at GHC-specific extensions. -- ----------------------------------------------------------------------------- module GHC.Exts ( -- * Representations of some basic types Int(..),Word(..),Float(..),Double(..),Integer(..),Char(..), Ptr(..), FunPtr(..), -- * Primitive operations module GHC.Prim, shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#, -- * Fusion build, augment, -- * Linear implicit parameter support Splittable(..), -- * Debugging breakpoint, -- * Ids with special behaviour lazy, inline, ) where import Prelude import GHC.Prim import GHC.Base import GHC.Word import GHC.Num import GHC.Float import GHC.Ptr class Splittable t where split :: t -> (t,t) hugs98-plus-Sep2006/packages/base/GHC/Float.lhs0000644006511100651110000007464510504340221017640 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Float -- Copyright : (c) The University of Glasgow 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The types 'Float' and 'Double', and the classes 'Floating' and 'RealFloat'. -- ----------------------------------------------------------------------------- #include "ieee-flpt.h" -- #hide module GHC.Float( module GHC.Float, Float#, Double# ) where import Data.Maybe import GHC.Base import GHC.List import GHC.Enum import GHC.Show import GHC.Num import GHC.Real import GHC.Arr infixr 8 ** \end{code} %********************************************************* %* * \subsection{Standard numeric classes} %* * %********************************************************* \begin{code} -- | Trigonometric and hyperbolic functions and related functions. -- -- Minimal complete definition: -- 'pi', 'exp', 'log', 'sin', 'cos', 'sinh', 'cosh' -- 'asin', 'acos', 'atan', 'asinh', 'acosh' and 'atanh' class (Fractional a) => Floating a where pi :: a exp, log, sqrt :: a -> a (**), logBase :: a -> a -> a sin, cos, tan :: a -> a asin, acos, atan :: a -> a sinh, cosh, tanh :: a -> a asinh, acosh, atanh :: a -> a x ** y = exp (log x * y) logBase x y = log y / log x sqrt x = x ** 0.5 tan x = sin x / cos x tanh x = sinh x / cosh x -- | Efficient, machine-independent access to the components of a -- floating-point number. -- -- Minimal complete definition: -- all except 'exponent', 'significand', 'scaleFloat' and 'atan2' class (RealFrac a, Floating a) => RealFloat a where -- | a constant function, returning the radix of the representation -- (often @2@) floatRadix :: a -> Integer -- | a constant function, returning the number of digits of -- 'floatRadix' in the significand floatDigits :: a -> Int -- | a constant function, returning the lowest and highest values -- the exponent may assume floatRange :: a -> (Int,Int) -- | The function 'decodeFloat' applied to a real floating-point -- number returns the significand expressed as an 'Integer' and an -- appropriately scaled exponent (an 'Int'). If @'decodeFloat' x@ -- yields @(m,n)@, then @x@ is equal in value to @m*b^^n@, where @b@ -- is the floating-point radix, and furthermore, either @m@ and @n@ -- are both zero or else @b^(d-1) <= m < b^d@, where @d@ is the value -- of @'floatDigits' x@. In particular, @'decodeFloat' 0 = (0,0)@. decodeFloat :: a -> (Integer,Int) -- | 'encodeFloat' performs the inverse of 'decodeFloat' encodeFloat :: Integer -> Int -> a -- | the second component of 'decodeFloat'. exponent :: a -> Int -- | the first component of 'decodeFloat', scaled to lie in the open -- interval (@-1@,@1@) significand :: a -> a -- | multiplies a floating-point number by an integer power of the radix scaleFloat :: Int -> a -> a -- | 'True' if the argument is an IEEE \"not-a-number\" (NaN) value isNaN :: a -> Bool -- | 'True' if the argument is an IEEE infinity or negative infinity isInfinite :: a -> Bool -- | 'True' if the argument is too small to be represented in -- normalized format isDenormalized :: a -> Bool -- | 'True' if the argument is an IEEE negative zero isNegativeZero :: a -> Bool -- | 'True' if the argument is an IEEE floating point number isIEEE :: a -> Bool -- | a version of arctangent taking two real floating-point arguments. -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle -- (from the positive x-axis) of the vector from the origin to the -- point @(x,y)@. @'atan2' y x@ returns a value in the range [@-pi@, -- @pi@]. It follows the Common Lisp semantics for the origin when -- signed zeroes are supported. @'atan2' y 1@, with @y@ in a type -- that is 'RealFloat', should return the same value as @'atan' y@. -- A default definition of 'atan2' is provided, but implementors -- can provide a more accurate implementation. atan2 :: a -> a -> a exponent x = if m == 0 then 0 else n + floatDigits x where (m,n) = decodeFloat x significand x = encodeFloat m (negate (floatDigits x)) where (m,_) = decodeFloat x scaleFloat k x = encodeFloat m (n+k) where (m,n) = decodeFloat x atan2 y x | x > 0 = atan (y/x) | x == 0 && y > 0 = pi/2 | x < 0 && y > 0 = pi + atan (y/x) |(x <= 0 && y < 0) || (x < 0 && isNegativeZero y) || (isNegativeZero x && isNegativeZero y) = -atan2 (-y) x | y == 0 && (x < 0 || isNegativeZero x) = pi -- must be after the previous test on zero y | x==0 && y==0 = y -- must be after the other double zero tests | otherwise = x + y -- x or y is a NaN, return a NaN (via +) \end{code} %********************************************************* %* * \subsection{Type @Integer@, @Float@, @Double@} %* * %********************************************************* \begin{code} -- | Single-precision floating point numbers. -- It is desirable that this type be at least equal in range and precision -- to the IEEE single-precision type. data Float = F# Float# -- | Double-precision floating point numbers. -- It is desirable that this type be at least equal in range and precision -- to the IEEE double-precision type. data Double = D# Double# \end{code} %********************************************************* %* * \subsection{Type @Float@} %* * %********************************************************* \begin{code} instance Eq Float where (F# x) == (F# y) = x `eqFloat#` y instance Ord Float where (F# x) `compare` (F# y) | x `ltFloat#` y = LT | x `eqFloat#` y = EQ | otherwise = GT (F# x) < (F# y) = x `ltFloat#` y (F# x) <= (F# y) = x `leFloat#` y (F# x) >= (F# y) = x `geFloat#` y (F# x) > (F# y) = x `gtFloat#` y instance Num Float where (+) x y = plusFloat x y (-) x y = minusFloat x y negate x = negateFloat x (*) x y = timesFloat x y abs x | x >= 0.0 = x | otherwise = negateFloat x signum x | x == 0.0 = 0 | x > 0.0 = 1 | otherwise = negate 1 {-# INLINE fromInteger #-} fromInteger (S# i#) = case (int2Float# i#) of { d# -> F# d# } fromInteger (J# s# d#) = encodeFloat# s# d# 0 -- previous code: fromInteger n = encodeFloat n 0 -- doesn't work too well, because encodeFloat is defined in -- terms of ccalls which can never be simplified away. We -- want simple literals like (fromInteger 3 :: Float) to turn -- into (F# 3.0), hence the special case for S# here. instance Real Float where toRational x = (m%1)*(b%1)^^n where (m,n) = decodeFloat x b = floatRadix x instance Fractional Float where (/) x y = divideFloat x y fromRational x = fromRat x recip x = 1.0 / x {-# RULES "truncate/Float->Int" truncate = float2Int #-} instance RealFrac Float where {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-} {-# SPECIALIZE round :: Float -> Int #-} {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-} {-# SPECIALIZE round :: Float -> Integer #-} -- ceiling, floor, and truncate are all small {-# INLINE ceiling #-} {-# INLINE floor #-} {-# INLINE truncate #-} properFraction x = case (decodeFloat x) of { (m,n) -> let b = floatRadix x in if n >= 0 then (fromInteger m * fromInteger b ^ n, 0.0) else case (quotRem m (b^(negate n))) of { (w,r) -> (fromInteger w, encodeFloat r n) } } truncate x = case properFraction x of (n,_) -> n round x = case properFraction x of (n,r) -> let m = if r < 0.0 then n - 1 else n + 1 half_down = abs r - 0.5 in case (compare half_down 0.0) of LT -> n EQ -> if even n then n else m GT -> m ceiling x = case properFraction x of (n,r) -> if r > 0.0 then n + 1 else n floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n instance Floating Float where pi = 3.141592653589793238 exp x = expFloat x log x = logFloat x sqrt x = sqrtFloat x sin x = sinFloat x cos x = cosFloat x tan x = tanFloat x asin x = asinFloat x acos x = acosFloat x atan x = atanFloat x sinh x = sinhFloat x cosh x = coshFloat x tanh x = tanhFloat x (**) x y = powerFloat x y logBase x y = log y / log x asinh x = log (x + sqrt (1.0+x*x)) acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0))) atanh x = log ((x+1.0) / sqrt (1.0-x*x)) instance RealFloat Float where floatRadix _ = FLT_RADIX -- from float.h floatDigits _ = FLT_MANT_DIG -- ditto floatRange _ = (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto decodeFloat (F# f#) = case decodeFloat# f# of (# exp#, s#, d# #) -> (J# s# d#, I# exp#) encodeFloat (S# i) j = int_encodeFloat# i j encodeFloat (J# s# d#) e = encodeFloat# s# d# e exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x significand x = case decodeFloat x of (m,_) -> encodeFloat m (negate (floatDigits x)) scaleFloat k x = case decodeFloat x of (m,n) -> encodeFloat m (n+k) isNaN x = 0 /= isFloatNaN x isInfinite x = 0 /= isFloatInfinite x isDenormalized x = 0 /= isFloatDenormalized x isNegativeZero x = 0 /= isFloatNegativeZero x isIEEE _ = True instance Show Float where showsPrec x = showSigned showFloat x showList = showList__ (showsPrec 0) \end{code} %********************************************************* %* * \subsection{Type @Double@} %* * %********************************************************* \begin{code} instance Eq Double where (D# x) == (D# y) = x ==## y instance Ord Double where (D# x) `compare` (D# y) | x <## y = LT | x ==## y = EQ | otherwise = GT (D# x) < (D# y) = x <## y (D# x) <= (D# y) = x <=## y (D# x) >= (D# y) = x >=## y (D# x) > (D# y) = x >## y instance Num Double where (+) x y = plusDouble x y (-) x y = minusDouble x y negate x = negateDouble x (*) x y = timesDouble x y abs x | x >= 0.0 = x | otherwise = negateDouble x signum x | x == 0.0 = 0 | x > 0.0 = 1 | otherwise = negate 1 {-# INLINE fromInteger #-} -- See comments with Num Float fromInteger (S# i#) = case (int2Double# i#) of { d# -> D# d# } fromInteger (J# s# d#) = encodeDouble# s# d# 0 instance Real Double where toRational x = (m%1)*(b%1)^^n where (m,n) = decodeFloat x b = floatRadix x instance Fractional Double where (/) x y = divideDouble x y fromRational x = fromRat x recip x = 1.0 / x instance Floating Double where pi = 3.141592653589793238 exp x = expDouble x log x = logDouble x sqrt x = sqrtDouble x sin x = sinDouble x cos x = cosDouble x tan x = tanDouble x asin x = asinDouble x acos x = acosDouble x atan x = atanDouble x sinh x = sinhDouble x cosh x = coshDouble x tanh x = tanhDouble x (**) x y = powerDouble x y logBase x y = log y / log x asinh x = log (x + sqrt (1.0+x*x)) acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0))) atanh x = log ((x+1.0) / sqrt (1.0-x*x)) {-# RULES "truncate/Double->Int" truncate = double2Int #-} instance RealFrac Double where {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-} {-# SPECIALIZE round :: Double -> Int #-} {-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-} {-# SPECIALIZE round :: Double -> Integer #-} -- ceiling, floor, and truncate are all small {-# INLINE ceiling #-} {-# INLINE floor #-} {-# INLINE truncate #-} properFraction x = case (decodeFloat x) of { (m,n) -> let b = floatRadix x in if n >= 0 then (fromInteger m * fromInteger b ^ n, 0.0) else case (quotRem m (b^(negate n))) of { (w,r) -> (fromInteger w, encodeFloat r n) } } truncate x = case properFraction x of (n,_) -> n round x = case properFraction x of (n,r) -> let m = if r < 0.0 then n - 1 else n + 1 half_down = abs r - 0.5 in case (compare half_down 0.0) of LT -> n EQ -> if even n then n else m GT -> m ceiling x = case properFraction x of (n,r) -> if r > 0.0 then n + 1 else n floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n instance RealFloat Double where floatRadix _ = FLT_RADIX -- from float.h floatDigits _ = DBL_MANT_DIG -- ditto floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto decodeFloat (D# x#) = case decodeDouble# x# of (# exp#, s#, d# #) -> (J# s# d#, I# exp#) encodeFloat (S# i) j = int_encodeDouble# i j encodeFloat (J# s# d#) e = encodeDouble# s# d# e exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x significand x = case decodeFloat x of (m,_) -> encodeFloat m (negate (floatDigits x)) scaleFloat k x = case decodeFloat x of (m,n) -> encodeFloat m (n+k) isNaN x = 0 /= isDoubleNaN x isInfinite x = 0 /= isDoubleInfinite x isDenormalized x = 0 /= isDoubleDenormalized x isNegativeZero x = 0 /= isDoubleNegativeZero x isIEEE _ = True instance Show Double where showsPrec x = showSigned showFloat x showList = showList__ (showsPrec 0) \end{code} %********************************************************* %* * \subsection{@Enum@ instances} %* * %********************************************************* The @Enum@ instances for Floats and Doubles are slightly unusual. The @toEnum@ function truncates numbers to Int. The definitions of @enumFrom@ and @enumFromThen@ allow floats to be used in arithmetic series: [0,0.1 .. 1.0]. However, roundoff errors make these somewhat dubious. This example may have either 10 or 11 elements, depending on how 0.1 is represented. NOTE: The instances for Float and Double do not make use of the default methods for @enumFromTo@ and @enumFromThenTo@, as these rely on there being a `non-lossy' conversion to and from Ints. Instead we make use of the 1.2 default methods (back in the days when Enum had Ord as a superclass) for these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.) \begin{code} instance Enum Float where succ x = x + 1 pred x = x - 1 toEnum = int2Float fromEnum = fromInteger . truncate -- may overflow enumFrom = numericEnumFrom enumFromTo = numericEnumFromTo enumFromThen = numericEnumFromThen enumFromThenTo = numericEnumFromThenTo instance Enum Double where succ x = x + 1 pred x = x - 1 toEnum = int2Double fromEnum = fromInteger . truncate -- may overflow enumFrom = numericEnumFrom enumFromTo = numericEnumFromTo enumFromThen = numericEnumFromThen enumFromThenTo = numericEnumFromThenTo \end{code} %********************************************************* %* * \subsection{Printing floating point} %* * %********************************************************* \begin{code} -- | Show a signed 'RealFloat' value to full precision -- using standard decimal notation for arguments whose absolute value lies -- between @0.1@ and @9,999,999@, and scientific notation otherwise. showFloat :: (RealFloat a) => a -> ShowS showFloat x = showString (formatRealFloat FFGeneric Nothing x) -- These are the format types. This type is not exported. data FFFormat = FFExponent | FFFixed | FFGeneric formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String formatRealFloat fmt decs x | isNaN x = "NaN" | isInfinite x = if x < 0 then "-Infinity" else "Infinity" | x < 0 || isNegativeZero x = '-':doFmt fmt (floatToDigits (toInteger base) (-x)) | otherwise = doFmt fmt (floatToDigits (toInteger base) x) where base = 10 doFmt format (is, e) = let ds = map intToDigit is in case format of FFGeneric -> doFmt (if e < 0 || e > 7 then FFExponent else FFFixed) (is,e) FFExponent -> case decs of Nothing -> let show_e' = show (e-1) in case ds of "0" -> "0.0e0" [d] -> d : ".0e" ++ show_e' (d:ds') -> d : '.' : ds' ++ "e" ++ show_e' Just dec -> let dec' = max dec 1 in case is of [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0" _ -> let (ei,is') = roundTo base (dec'+1) is (d:ds') = map intToDigit (if ei > 0 then init is' else is') in d:'.':ds' ++ 'e':show (e-1+ei) FFFixed -> let mk0 ls = case ls of { "" -> "0" ; _ -> ls} in case decs of Nothing | e <= 0 -> "0." ++ replicate (-e) '0' ++ ds | otherwise -> let f 0 s rs = mk0 (reverse s) ++ '.':mk0 rs f n s "" = f (n-1) ('0':s) "" f n s (r:rs) = f (n-1) (r:s) rs in f e "" ds Just dec -> let dec' = max dec 0 in if e >= 0 then let (ei,is') = roundTo base (dec' + e) is (ls,rs) = splitAt (e+ei) (map intToDigit is') in mk0 ls ++ (if null rs then "" else '.':rs) else let (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is) d:ds' = map intToDigit (if ei > 0 then is' else 0:is') in d : (if null ds' then "" else '.':ds') roundTo :: Int -> Int -> [Int] -> (Int,[Int]) roundTo base d is = case f d is of x@(0,_) -> x (1,xs) -> (1, 1:xs) where b2 = base `div` 2 f n [] = (0, replicate n 0) f 0 (x:_) = (if x >= b2 then 1 else 0, []) f n (i:xs) | i' == base = (1,0:ds) | otherwise = (0,i':ds) where (c,ds) = f (n-1) xs i' = c + i -- Based on "Printing Floating-Point Numbers Quickly and Accurately" -- by R.G. Burger and R.K. Dybvig in PLDI 96. -- This version uses a much slower logarithm estimator. It should be improved. -- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number, -- and returns a list of digits and an exponent. -- In particular, if @x>=0@, and -- -- > floatToDigits base x = ([d1,d2,...,dn], e) -- -- then -- -- (1) @n >= 1@ -- -- (2) @x = 0.d1d2...dn * (base**e)@ -- -- (3) @0 <= di <= base-1@ floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int) floatToDigits _ 0 = ([0], 0) floatToDigits base x = let (f0, e0) = decodeFloat x (minExp0, _) = floatRange x p = floatDigits x b = floatRadix x minExp = minExp0 - p -- the real minimum exponent -- Haskell requires that f be adjusted so denormalized numbers -- will have an impossibly low exponent. Adjust for this. (f, e) = let n = minExp - e0 in if n > 0 then (f0 `div` (b^n), e0+n) else (f0, e0) (r, s, mUp, mDn) = if e >= 0 then let be = b^ e in if f == b^(p-1) then (f*be*b*2, 2*b, be*b, b) else (f*be*2, 2, be, be) else if e > minExp && f == b^(p-1) then (f*b*2, b^(-e+1)*2, b, 1) else (f*2, b^(-e)*2, 1, 1) k = let k0 = if b == 2 && base == 10 then -- logBase 10 2 is slightly bigger than 3/10 so -- the following will err on the low side. Ignoring -- the fraction will make it err even more. -- Haskell promises that p-1 <= logBase b f < p. (p - 1 + e0) * 3 `div` 10 else ceiling ((log (fromInteger (f+1)) + fromInteger (int2Integer e) * log (fromInteger b)) / log (fromInteger base)) --WAS: fromInt e * log (fromInteger b)) fixup n = if n >= 0 then if r + mUp <= expt base n * s then n else fixup (n+1) else if expt base (-n) * (r + mUp) <= s then n else fixup (n+1) in fixup k0 gen ds rn sN mUpN mDnN = let (dn, rn') = (rn * base) `divMod` sN mUpN' = mUpN * base mDnN' = mDnN * base in case (rn' < mDnN', rn' + mUpN' > sN) of (True, False) -> dn : ds (False, True) -> dn+1 : ds (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN' rds = if k >= 0 then gen [] r (s * expt base k) mUp mDn else let bk = expt base (-k) in gen [] (r * bk) s (mUp * bk) (mDn * bk) in (map fromIntegral (reverse rds), k) \end{code} %********************************************************* %* * \subsection{Converting from a Rational to a RealFloat %* * %********************************************************* [In response to a request for documentation of how fromRational works, Joe Fasel writes:] A quite reasonable request! This code was added to the Prelude just before the 1.2 release, when Lennart, working with an early version of hbi, noticed that (read . show) was not the identity for floating-point numbers. (There was a one-bit error about half the time.) The original version of the conversion function was in fact simply a floating-point divide, as you suggest above. The new version is, I grant you, somewhat denser. Unfortunately, Joe's code doesn't work! Here's an example: main = putStr (shows (1.82173691287639817263897126389712638972163e-300::Double) "\n") This program prints 0.0000000000000000 instead of 1.8217369128763981e-300 Here's Joe's code: \begin{pseudocode} fromRat :: (RealFloat a) => Rational -> a fromRat x = x' where x' = f e -- If the exponent of the nearest floating-point number to x -- is e, then the significand is the integer nearest xb^(-e), -- where b is the floating-point radix. We start with a good -- guess for e, and if it is correct, the exponent of the -- floating-point number we construct will again be e. If -- not, one more iteration is needed. f e = if e' == e then y else f e' where y = encodeFloat (round (x * (1 % b)^^e)) e (_,e') = decodeFloat y b = floatRadix x' -- We obtain a trial exponent by doing a floating-point -- division of x's numerator by its denominator. The -- result of this division may not itself be the ultimate -- result, because of an accumulation of three rounding -- errors. (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x' / fromInteger (denominator x)) \end{pseudocode} Now, here's Lennart's code (which works) \begin{code} -- | Converts a 'Rational' value into any type in class 'RealFloat'. {-# SPECIALISE fromRat :: Rational -> Double, Rational -> Float #-} fromRat :: (RealFloat a) => Rational -> a -- Deal with special cases first, delegating the real work to fromRat' fromRat (n :% 0) | n > 0 = 1/0 -- +Infinity | n == 0 = 0/0 -- NaN | n < 0 = -1/0 -- -Infinity fromRat (n :% d) | n > 0 = fromRat' (n :% d) | n == 0 = encodeFloat 0 0 -- Zero | n < 0 = - fromRat' ((-n) :% d) -- Conversion process: -- Scale the rational number by the RealFloat base until -- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat). -- Then round the rational to an Integer and encode it with the exponent -- that we got from the scaling. -- To speed up the scaling process we compute the log2 of the number to get -- a first guess of the exponent. fromRat' :: (RealFloat a) => Rational -> a -- Invariant: argument is strictly positive fromRat' x = r where b = floatRadix r p = floatDigits r (minExp0, _) = floatRange r minExp = minExp0 - p -- the real minimum exponent xMin = toRational (expt b (p-1)) xMax = toRational (expt b p) p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1 (x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f) r = encodeFloat (round x') p' -- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp. scaleRat :: Rational -> Int -> Rational -> Rational -> Int -> Rational -> (Rational, Int) scaleRat b minExp xMin xMax p x | p <= minExp = (x, p) | x >= xMax = scaleRat b minExp xMin xMax (p+1) (x/b) | x < xMin = scaleRat b minExp xMin xMax (p-1) (x*b) | otherwise = (x, p) -- Exponentiation with a cache for the most common numbers. minExpt, maxExpt :: Int minExpt = 0 maxExpt = 1100 expt :: Integer -> Int -> Integer expt base n = if base == 2 && n >= minExpt && n <= maxExpt then expts!n else base^n expts :: Array Int Integer expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]] -- Compute the (floor of the) log of i in base b. -- Simplest way would be just divide i by b until it's smaller then b, but that would -- be very slow! We are just slightly more clever. integerLogBase :: Integer -> Integer -> Int integerLogBase b i | i < b = 0 | otherwise = doDiv (i `div` (b^l)) l where -- Try squaring the base first to cut down the number of divisions. l = 2 * integerLogBase (b*b) i doDiv :: Integer -> Int -> Int doDiv x y | x < b = y | otherwise = doDiv (x `div` b) (y+1) \end{code} %********************************************************* %* * \subsection{Floating point numeric primops} %* * %********************************************************* Definitions of the boxed PrimOps; these will be used in the case of partial applications, etc. \begin{code} plusFloat, minusFloat, timesFloat, divideFloat :: Float -> Float -> Float plusFloat (F# x) (F# y) = F# (plusFloat# x y) minusFloat (F# x) (F# y) = F# (minusFloat# x y) timesFloat (F# x) (F# y) = F# (timesFloat# x y) divideFloat (F# x) (F# y) = F# (divideFloat# x y) negateFloat :: Float -> Float negateFloat (F# x) = F# (negateFloat# x) gtFloat, geFloat, eqFloat, neFloat, ltFloat, leFloat :: Float -> Float -> Bool gtFloat (F# x) (F# y) = gtFloat# x y geFloat (F# x) (F# y) = geFloat# x y eqFloat (F# x) (F# y) = eqFloat# x y neFloat (F# x) (F# y) = neFloat# x y ltFloat (F# x) (F# y) = ltFloat# x y leFloat (F# x) (F# y) = leFloat# x y float2Int :: Float -> Int float2Int (F# x) = I# (float2Int# x) int2Float :: Int -> Float int2Float (I# x) = F# (int2Float# x) expFloat, logFloat, sqrtFloat :: Float -> Float sinFloat, cosFloat, tanFloat :: Float -> Float asinFloat, acosFloat, atanFloat :: Float -> Float sinhFloat, coshFloat, tanhFloat :: Float -> Float expFloat (F# x) = F# (expFloat# x) logFloat (F# x) = F# (logFloat# x) sqrtFloat (F# x) = F# (sqrtFloat# x) sinFloat (F# x) = F# (sinFloat# x) cosFloat (F# x) = F# (cosFloat# x) tanFloat (F# x) = F# (tanFloat# x) asinFloat (F# x) = F# (asinFloat# x) acosFloat (F# x) = F# (acosFloat# x) atanFloat (F# x) = F# (atanFloat# x) sinhFloat (F# x) = F# (sinhFloat# x) coshFloat (F# x) = F# (coshFloat# x) tanhFloat (F# x) = F# (tanhFloat# x) powerFloat :: Float -> Float -> Float powerFloat (F# x) (F# y) = F# (powerFloat# x y) -- definitions of the boxed PrimOps; these will be -- used in the case of partial applications, etc. plusDouble, minusDouble, timesDouble, divideDouble :: Double -> Double -> Double plusDouble (D# x) (D# y) = D# (x +## y) minusDouble (D# x) (D# y) = D# (x -## y) timesDouble (D# x) (D# y) = D# (x *## y) divideDouble (D# x) (D# y) = D# (x /## y) negateDouble :: Double -> Double negateDouble (D# x) = D# (negateDouble# x) gtDouble, geDouble, eqDouble, neDouble, leDouble, ltDouble :: Double -> Double -> Bool gtDouble (D# x) (D# y) = x >## y geDouble (D# x) (D# y) = x >=## y eqDouble (D# x) (D# y) = x ==## y neDouble (D# x) (D# y) = x /=## y ltDouble (D# x) (D# y) = x <## y leDouble (D# x) (D# y) = x <=## y double2Int :: Double -> Int double2Int (D# x) = I# (double2Int# x) int2Double :: Int -> Double int2Double (I# x) = D# (int2Double# x) double2Float :: Double -> Float double2Float (D# x) = F# (double2Float# x) float2Double :: Float -> Double float2Double (F# x) = D# (float2Double# x) expDouble, logDouble, sqrtDouble :: Double -> Double sinDouble, cosDouble, tanDouble :: Double -> Double asinDouble, acosDouble, atanDouble :: Double -> Double sinhDouble, coshDouble, tanhDouble :: Double -> Double expDouble (D# x) = D# (expDouble# x) logDouble (D# x) = D# (logDouble# x) sqrtDouble (D# x) = D# (sqrtDouble# x) sinDouble (D# x) = D# (sinDouble# x) cosDouble (D# x) = D# (cosDouble# x) tanDouble (D# x) = D# (tanDouble# x) asinDouble (D# x) = D# (asinDouble# x) acosDouble (D# x) = D# (acosDouble# x) atanDouble (D# x) = D# (atanDouble# x) sinhDouble (D# x) = D# (sinhDouble# x) coshDouble (D# x) = D# (coshDouble# x) tanhDouble (D# x) = D# (tanhDouble# x) powerDouble :: Double -> Double -> Double powerDouble (D# x) (D# y) = D# (x **## y) \end{code} \begin{code} foreign import ccall unsafe "__encodeFloat" encodeFloat# :: Int# -> ByteArray# -> Int -> Float foreign import ccall unsafe "__int_encodeFloat" int_encodeFloat# :: Int# -> Int -> Float foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int foreign import ccall unsafe "__encodeDouble" encodeDouble# :: Int# -> ByteArray# -> Int -> Double foreign import ccall unsafe "__int_encodeDouble" int_encodeDouble# :: Int# -> Int -> Double foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int \end{code} %********************************************************* %* * \subsection{Coercion rules} %* * %********************************************************* \begin{code} {-# RULES "fromIntegral/Int->Float" fromIntegral = int2Float "fromIntegral/Int->Double" fromIntegral = int2Double "realToFrac/Float->Float" realToFrac = id :: Float -> Float "realToFrac/Float->Double" realToFrac = float2Double "realToFrac/Double->Float" realToFrac = double2Float "realToFrac/Double->Double" realToFrac = id :: Double -> Double #-} \end{code} hugs98-plus-Sep2006/packages/base/GHC/ForeignPtr.hs0000644006511100651110000003241510504340224020466 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.ForeignPtr -- Copyright : (c) The University of Glasgow, 1992-2003 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- GHC's implementation of the 'ForeignPtr' data type. -- ----------------------------------------------------------------------------- -- #hide module GHC.ForeignPtr ( ForeignPtr(..), FinalizerPtr, newForeignPtr_, mallocForeignPtr, mallocPlainForeignPtr, mallocForeignPtrBytes, mallocPlainForeignPtrBytes, addForeignPtrFinalizer, touchForeignPtr, unsafeForeignPtrToPtr, castForeignPtr, newConcForeignPtr, addForeignPtrConcFinalizer, finalizeForeignPtr ) where import Control.Monad ( sequence_ ) import Foreign.Storable import Numeric ( showHex ) import GHC.Show import GHC.Num import GHC.List ( null, replicate, length ) import GHC.Base import GHC.IOBase import GHC.STRef ( STRef(..) ) import GHC.Ptr ( Ptr(..), FunPtr, castFunPtrToPtr ) import GHC.Err -- |The type 'ForeignPtr' represents references to objects that are -- maintained in a foreign language, i.e., that are not part of the -- data structures usually managed by the Haskell storage manager. -- The essential difference between 'ForeignPtr's and vanilla memory -- references of type @Ptr a@ is that the former may be associated -- with /finalizers/. A finalizer is a routine that is invoked when -- the Haskell storage manager detects that - within the Haskell heap -- and stack - there are no more references left that are pointing to -- the 'ForeignPtr'. Typically, the finalizer will, then, invoke -- routines in the foreign language that free the resources bound by -- the foreign object. -- -- The 'ForeignPtr' is parameterised in the same way as 'Ptr'. The -- type argument of 'ForeignPtr' should normally be an instance of -- class 'Storable'. -- data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents -- we cache the Addr# in the ForeignPtr object, but attach -- the finalizer to the IORef (or the MutableByteArray# in -- the case of a MallocPtr). The aim of the representation -- is to make withForeignPtr efficient; in fact, withForeignPtr -- should be just as efficient as unpacking a Ptr, and multiple -- withForeignPtrs can share an unpacked ForeignPtr. Note -- that touchForeignPtr only has to touch the ForeignPtrContents -- object, because that ensures that whatever the finalizer is -- attached to is kept alive. data ForeignPtrContents = PlainForeignPtr !(IORef [IO ()]) | MallocPtr (MutableByteArray# RealWorld) !(IORef [IO ()]) | PlainPtr (MutableByteArray# RealWorld) instance Eq (ForeignPtr a) where p == q = unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q instance Ord (ForeignPtr a) where compare p q = compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q) instance Show (ForeignPtr a) where showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f) #include "MachDeps.h" #if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64) instance Show (Ptr a) where showsPrec p (Ptr a) rs = pad_out (showHex (word2Integer(int2Word#(addr2Int# a))) "") rs where -- want 0s prefixed to pad it out to a fixed length. pad_out ls rs = '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs -- word2Integer :: Word# -> Integer (stolen from Word.lhs) word2Integer w = case word2Integer# w of (# s, d #) -> J# s d instance Show (FunPtr a) where showsPrec p = showsPrec p . castFunPtrToPtr #endif -- |A Finalizer is represented as a pointer to a foreign function that, at -- finalisation time, gets as an argument a plain pointer variant of the -- foreign pointer that the finalizer is associated with. -- type FinalizerPtr a = FunPtr (Ptr a -> IO ()) newConcForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a) -- -- ^Turns a plain memory reference into a foreign object by -- associating a finalizer - given by the monadic operation - with the -- reference. The storage manager will start the finalizer, in a -- separate thread, some time after the last reference to the -- @ForeignPtr@ is dropped. There is no guarantee of promptness, and -- in fact there is no guarantee that the finalizer will eventually -- run at all. -- -- Note that references from a finalizer do not necessarily prevent -- another object from being finalized. If A's finalizer refers to B -- (perhaps using 'touchForeignPtr', then the only guarantee is that -- B's finalizer will never be started before A's. If both A and B -- are unreachable, then both finalizers will start together. See -- 'touchForeignPtr' for more on finalizer ordering. -- newConcForeignPtr p finalizer = do fObj <- newForeignPtr_ p addForeignPtrConcFinalizer fObj finalizer return fObj mallocForeignPtr :: Storable a => IO (ForeignPtr a) -- ^ Allocate some memory and return a 'ForeignPtr' to it. The memory -- will be released automatically when the 'ForeignPtr' is discarded. -- -- 'mallocForeignPtr' is equivalent to -- -- > do { p <- malloc; newForeignPtr finalizerFree p } -- -- although it may be implemented differently internally: you may not -- assume that the memory returned by 'mallocForeignPtr' has been -- allocated with 'Foreign.Marshal.Alloc.malloc'. -- -- GHC notes: 'mallocForeignPtr' has a heavily optimised -- implementation in GHC. It uses pinned memory in the garbage -- collected heap, so the 'ForeignPtr' does not require a finalizer to -- free the memory. Use of 'mallocForeignPtr' and associated -- functions is strongly recommended in preference to 'newForeignPtr' -- with a finalizer. -- mallocForeignPtr = doMalloc undefined where doMalloc :: Storable b => b -> IO (ForeignPtr b) doMalloc a = do r <- newIORef [] IO $ \s -> case newPinnedByteArray# size s of { (# s, mbarr# #) -> (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) (MallocPtr mbarr# r) #) } where (I# size) = sizeOf a -- | This function is similar to 'mallocForeignPtr', except that the -- size of the memory required is given explicitly as a number of bytes. mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) mallocForeignPtrBytes (I# size) = do r <- newIORef [] IO $ \s -> case newPinnedByteArray# size s of { (# s, mbarr# #) -> (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) (MallocPtr mbarr# r) #) } -- | Allocate some memory and return a 'ForeignPtr' to it. The memory -- will be released automatically when the 'ForeignPtr' is discarded. -- -- GHC notes: 'mallocPlainForeignPtr' has a heavily optimised -- implementation in GHC. It uses pinned memory in the garbage -- collected heap, as for mallocForeignPtr. Unlike mallocForeignPtr, a -- ForeignPtr created with mallocPlainForeignPtr carries no finalizers. -- It is not possible to add a finalizer to a ForeignPtr created with -- mallocPlainForeignPtr. This is useful for ForeignPtrs that will live -- only inside Haskell (such as those created for packed strings). -- Attempts to add a finalizer to a ForeignPtr created this way, or to -- finalize such a pointer, will throw an exception. -- mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a) mallocPlainForeignPtr = doMalloc undefined where doMalloc :: Storable b => b -> IO (ForeignPtr b) doMalloc a = IO $ \s -> case newPinnedByteArray# size s of { (# s, mbarr# #) -> (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) (PlainPtr mbarr#) #) } where (I# size) = sizeOf a -- | This function is similar to 'mallocForeignPtrBytes', except that -- the internally an optimised ForeignPtr representation with no -- finalizer is used. Attempts to add a finalizer will cause an -- exception to be thrown. mallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a) mallocPlainForeignPtrBytes (I# size) = IO $ \s -> case newPinnedByteArray# size s of { (# s, mbarr# #) -> (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) (PlainPtr mbarr#) #) } addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO () -- ^This function adds a finalizer to the given foreign object. The -- finalizer will run /before/ all other finalizers for the same -- object which have already been registered. addForeignPtrFinalizer finalizer fptr = addForeignPtrConcFinalizer fptr (mkFinalizer finalizer (unsafeForeignPtrToPtr fptr)) addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO () -- ^This function adds a finalizer to the given @ForeignPtr@. The -- finalizer will run /before/ all other finalizers for the same -- object which have already been registered. -- -- This is a variant of @addForeignPtrFinalizer@, where the finalizer -- is an arbitrary @IO@ action. When it is invoked, the finalizer -- will run in a new thread. -- -- NB. Be very careful with these finalizers. One common trap is that -- if a finalizer references another finalized value, it does not -- prevent that value from being finalized. In particular, 'Handle's -- are finalized objects, so a finalizer should not refer to a 'Handle' -- (including @stdout@, @stdin@ or @stderr@). -- addForeignPtrConcFinalizer (ForeignPtr a c) finalizer = addForeignPtrConcFinalizer_ c finalizer addForeignPtrConcFinalizer_ f@(PlainForeignPtr r) finalizer = do fs <- readIORef r writeIORef r (finalizer : fs) if (null fs) then IO $ \s -> case r of { IORef (STRef r#) -> case mkWeak# r# () (foreignPtrFinalizer r) s of { (# s1, w #) -> (# s1, () #) }} else return () addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do fs <- readIORef r writeIORef r (finalizer : fs) if (null fs) then IO $ \s -> case mkWeak# fo () (do foreignPtrFinalizer r; touch f) s of (# s1, w #) -> (# s1, () #) else return () addForeignPtrConcFinalizer_ _ _ = error "GHC.ForeignPtr: attempt to add a finalizer to plain pointer" foreign import ccall "dynamic" mkFinalizer :: FinalizerPtr a -> Ptr a -> IO () foreignPtrFinalizer :: IORef [IO ()] -> IO () foreignPtrFinalizer r = do fs <- readIORef r; sequence_ fs newForeignPtr_ :: Ptr a -> IO (ForeignPtr a) -- ^Turns a plain memory reference into a foreign pointer that may be -- associated with finalizers by using 'addForeignPtrFinalizer'. newForeignPtr_ (Ptr obj) = do r <- newIORef [] return (ForeignPtr obj (PlainForeignPtr r)) touchForeignPtr :: ForeignPtr a -> IO () -- ^This function ensures that the foreign object in -- question is alive at the given place in the sequence of IO -- actions. In particular 'Foreign.ForeignPtr.withForeignPtr' -- does a 'touchForeignPtr' after it -- executes the user action. -- -- Note that this function should not be used to express dependencies -- between finalizers on 'ForeignPtr's. For example, if the finalizer -- for a 'ForeignPtr' @F1@ calls 'touchForeignPtr' on a second -- 'ForeignPtr' @F2@, then the only guarantee is that the finalizer -- for @F2@ is never started before the finalizer for @F1@. They -- might be started together if for example both @F1@ and @F2@ are -- otherwise unreachable, and in that case the scheduler might end up -- running the finalizer for @F2@ first. -- -- In general, it is not recommended to use finalizers on separate -- objects with ordering constraints between them. To express the -- ordering robustly requires explicit synchronisation using @MVar@s -- between the finalizers, but even then the runtime sometimes runs -- multiple finalizers sequentially in a single thread (for -- performance reasons), so synchronisation between finalizers could -- result in artificial deadlock. Another alternative is to use -- explicit reference counting. -- touchForeignPtr (ForeignPtr fo r) = touch r touch r = IO $ \s -> case touch# r s of s -> (# s, () #) unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a -- ^This function extracts the pointer component of a foreign -- pointer. This is a potentially dangerous operations, as if the -- argument to 'unsafeForeignPtrToPtr' is the last usage -- occurrence of the given foreign pointer, then its finalizer(s) will -- be run, which potentially invalidates the plain pointer just -- obtained. Hence, 'touchForeignPtr' must be used -- wherever it has to be guaranteed that the pointer lives on - i.e., -- has another usage occurrence. -- -- To avoid subtle coding errors, hand written marshalling code -- should preferably use 'Foreign.ForeignPtr.withForeignPtr' rather -- than combinations of 'unsafeForeignPtrToPtr' and -- 'touchForeignPtr'. However, the later routines -- are occasionally preferred in tool generated marshalling code. unsafeForeignPtrToPtr (ForeignPtr fo r) = Ptr fo castForeignPtr :: ForeignPtr a -> ForeignPtr b -- ^This function casts a 'ForeignPtr' -- parameterised by one type into another type. castForeignPtr f = unsafeCoerce# f -- | Causes the finalizers associated with a foreign pointer to be run -- immediately. finalizeForeignPtr :: ForeignPtr a -> IO () finalizeForeignPtr (ForeignPtr _ (PlainPtr _)) = return () -- no effect finalizeForeignPtr (ForeignPtr _ foreignPtr) = do finalizers <- readIORef refFinalizers sequence_ finalizers writeIORef refFinalizers [] where refFinalizers = case foreignPtr of (PlainForeignPtr ref) -> ref (MallocPtr _ ref) -> ref hugs98-plus-Sep2006/packages/base/GHC/Handle.hs0000644006511100651110000016332010504340226017604 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-} #undef DEBUG_DUMP #undef DEBUG ----------------------------------------------------------------------------- -- | -- Module : GHC.Handle -- Copyright : (c) The University of Glasgow, 1994-2001 -- License : see libraries/base/LICENSE -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable -- -- This module defines the basic operations on I\/O \"handles\". -- ----------------------------------------------------------------------------- -- #hide module GHC.Handle ( withHandle, withHandle', withHandle_, wantWritableHandle, wantReadableHandle, wantSeekableHandle, newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer, flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer, fillReadBufferWithoutBlocking, readRawBuffer, readRawBufferPtr, writeRawBuffer, writeRawBufferPtr, #ifndef mingw32_HOST_OS unlockFile, #endif ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable, stdin, stdout, stderr, IOMode(..), openFile, openBinaryFile, openTempFile, openBinaryTempFile, openFd, fdToHandle, hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode, hFlush, hDuplicate, hDuplicateTo, hClose, hClose_help, HandlePosition, HandlePosn(..), hGetPosn, hSetPosn, SeekMode(..), hSeek, hTell, hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable, hSetEcho, hGetEcho, hIsTerminalDevice, hShow, #ifdef DEBUG_DUMP puts, #endif ) where import System.Directory.Internals import Control.Monad import Data.Bits import Data.Maybe import Foreign import Foreign.C import System.IO.Error import System.Posix.Internals import GHC.Real import GHC.Arr import GHC.Base import GHC.Read ( Read ) import GHC.List import GHC.IOBase import GHC.Exception import GHC.Enum import GHC.Num ( Integer(..), Num(..) ) import GHC.Show import GHC.Real ( toInteger ) #if defined(DEBUG_DUMP) import GHC.Pack #endif import GHC.Conc -- ----------------------------------------------------------------------------- -- TODO: -- hWaitForInput blocks (should use a timeout) -- unbuffered hGetLine is a bit dodgy -- hSetBuffering: can't change buffering on a stream, -- when the read buffer is non-empty? (no way to flush the buffer) -- --------------------------------------------------------------------------- -- Are files opened by default in text or binary mode, if the user doesn't -- specify? dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool -- --------------------------------------------------------------------------- -- Creating a new handle newFileHandle :: FilePath -> (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle newFileHandle filepath finalizer hc = do m <- newMVar hc addMVarFinalizer m (finalizer m) return (FileHandle filepath m) -- --------------------------------------------------------------------------- -- Working with Handles {- In the concurrent world, handles are locked during use. This is done by wrapping an MVar around the handle which acts as a mutex over operations on the handle. To avoid races, we use the following bracketing operations. The idea is to obtain the lock, do some operation and replace the lock again, whether the operation succeeded or failed. We also want to handle the case where the thread receives an exception while processing the IO operation: in these cases we also want to relinquish the lock. There are three versions of @withHandle@: corresponding to the three possible combinations of: - the operation may side-effect the handle - the operation may return a result If the operation generates an error or an exception is raised, the original handle is always replaced [ this is the case at the moment, but we might want to revisit this in the future --SDM ]. -} {-# INLINE withHandle #-} withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act withHandle' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO (Handle__,a)) -> IO a withHandle' fun h m act = block $ do h_ <- takeMVar m checkBufferInvariants h_ (h',v) <- catchException (act h_) (\ err -> putMVar m h_ >> case err of IOException ex -> ioError (augmentIOError ex fun h) _ -> throw err) checkBufferInvariants h' putMVar m h' return v {-# INLINE withHandle_ #-} withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act withHandle_' fun h m act = block $ do h_ <- takeMVar m checkBufferInvariants h_ v <- catchException (act h_) (\ err -> putMVar m h_ >> case err of IOException ex -> ioError (augmentIOError ex fun h) _ -> throw err) checkBufferInvariants h_ putMVar m h_ return v withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO () withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act withAllHandles__ fun h@(DuplexHandle _ r w) act = do withHandle__' fun h r act withHandle__' fun h w act withHandle__' fun h m act = block $ do h_ <- takeMVar m checkBufferInvariants h_ h' <- catchException (act h_) (\ err -> putMVar m h_ >> case err of IOException ex -> ioError (augmentIOError ex fun h) _ -> throw err) checkBufferInvariants h' putMVar m h' return () augmentIOError (IOError _ iot _ str fp) fun h = IOError (Just h) iot fun str filepath where filepath | Just _ <- fp = fp | otherwise = case h of FileHandle fp _ -> Just fp DuplexHandle fp _ _ -> Just fp -- --------------------------------------------------------------------------- -- Wrapper for write operations. wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a wantWritableHandle fun h@(FileHandle _ m) act = wantWritableHandle' fun h m act wantWritableHandle fun h@(DuplexHandle _ _ m) act = wantWritableHandle' fun h m act -- ToDo: in the Duplex case, we don't need to checkWritableHandle wantWritableHandle' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a wantWritableHandle' fun h m act = withHandle_' fun h m (checkWritableHandle act) checkWritableHandle act handle_ = case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle ReadHandle -> ioe_notWritable ReadWriteHandle -> do let ref = haBuffer handle_ buf <- readIORef ref new_buf <- if not (bufferIsWritable buf) then do b <- flushReadBuffer (haFD handle_) buf return b{ bufState=WriteBuffer } else return buf writeIORef ref new_buf act handle_ _other -> act handle_ -- --------------------------------------------------------------------------- -- Wrapper for read operations. wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a wantReadableHandle fun h@(FileHandle _ m) act = wantReadableHandle' fun h m act wantReadableHandle fun h@(DuplexHandle _ m _) act = wantReadableHandle' fun h m act -- ToDo: in the Duplex case, we don't need to checkReadableHandle wantReadableHandle' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a wantReadableHandle' fun h m act = withHandle_' fun h m (checkReadableHandle act) checkReadableHandle act handle_ = case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle AppendHandle -> ioe_notReadable WriteHandle -> ioe_notReadable ReadWriteHandle -> do let ref = haBuffer handle_ buf <- readIORef ref when (bufferIsWritable buf) $ do new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf writeIORef ref new_buf{ bufState=ReadBuffer } act handle_ _other -> act handle_ -- --------------------------------------------------------------------------- -- Wrapper for seek operations. wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a wantSeekableHandle fun h@(DuplexHandle _ _ _) _act = ioException (IOError (Just h) IllegalOperation fun "handle is not seekable" Nothing) wantSeekableHandle fun h@(FileHandle _ m) act = withHandle_' fun h m (checkSeekableHandle act) checkSeekableHandle act handle_ = case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle AppendHandle -> ioe_notSeekable _ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_ | otherwise -> ioe_notSeekable_notBin -- ----------------------------------------------------------------------------- -- Handy IOErrors ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable, ioe_notSeekable, ioe_notSeekable_notBin :: IO a ioe_closedHandle = ioException (IOError Nothing IllegalOperation "" "handle is closed" Nothing) ioe_EOF = ioException (IOError Nothing EOF "" "" Nothing) ioe_notReadable = ioException (IOError Nothing IllegalOperation "" "handle is not open for reading" Nothing) ioe_notWritable = ioException (IOError Nothing IllegalOperation "" "handle is not open for writing" Nothing) ioe_notSeekable = ioException (IOError Nothing IllegalOperation "" "handle is not seekable" Nothing) ioe_notSeekable_notBin = ioException (IOError Nothing IllegalOperation "" "seek operations on text-mode handles are not allowed on this platform" Nothing) ioe_finalizedHandle fp = throw (IOException (IOError Nothing IllegalOperation "" "handle is finalized" (Just fp))) ioe_bufsiz :: Int -> IO a ioe_bufsiz n = ioException (IOError Nothing InvalidArgument "hSetBuffering" ("illegal buffer size " ++ showsPrec 9 n []) Nothing) -- 9 => should be parens'ified. -- ----------------------------------------------------------------------------- -- Handle Finalizers -- For a duplex handle, we arrange that the read side points to the write side -- (and hence keeps it alive if the read side is alive). This is done by -- having the haOtherSide field of the read side point to the read side. -- The finalizer is then placed on the write side, and the handle only gets -- finalized once, when both sides are no longer required. -- NOTE about finalized handles: It's possible that a handle can be -- finalized and then we try to use it later, for example if the -- handle is referenced from another finalizer, or from a thread that -- has become unreferenced and then resurrected (arguably in the -- latter case we shouldn't finalize the Handle...). Anyway, -- we try to emit a helpful message which is better than nothing. stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO () stdHandleFinalizer fp m = do h_ <- takeMVar m flushWriteBufferOnly h_ putMVar m (ioe_finalizedHandle fp) handleFinalizer :: FilePath -> MVar Handle__ -> IO () handleFinalizer fp m = do handle_ <- takeMVar m case haType handle_ of ClosedHandle -> return () _ -> do flushWriteBufferOnly handle_ `catchException` \_ -> return () -- ignore errors and async exceptions, and close the -- descriptor anyway... hClose_handle_ handle_ return () putMVar m (ioe_finalizedHandle fp) -- --------------------------------------------------------------------------- -- Grimy buffer operations #ifdef DEBUG checkBufferInvariants h_ = do let ref = haBuffer h_ Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref if not ( size > 0 && r <= w && w <= size && ( r /= w || (r == 0 && w == 0) ) && ( state /= WriteBuffer || r == 0 ) && ( state /= WriteBuffer || w < size ) -- write buffer is never full ) then error "buffer invariant violation" else return () #else checkBufferInvariants h_ = return () #endif newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer newEmptyBuffer b state size = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state } allocateBuffer :: Int -> BufferState -> IO Buffer allocateBuffer sz@(I# size) state = IO $ \s -> #ifdef mingw32_HOST_OS -- To implement asynchronous I/O under Win32, we have to pass -- buffer references to external threads that handles the -- filling/emptying of their contents. Hence, the buffer cannot -- be moved around by the GC. case newPinnedByteArray# size s of { (# s, b #) -> #else case newByteArray# size s of { (# s, b #) -> #endif (# s, newEmptyBuffer b state sz #) } writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int writeCharIntoBuffer slab (I# off) (C# c) = IO $ \s -> case writeCharArray# slab off c s of s -> (# s, I# (off +# 1#) #) readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int) readCharFromBuffer slab (I# off) = IO $ \s -> case readCharArray# slab off s of (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #) getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode) getBuffer fd state = do buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state ioref <- newIORef buffer is_tty <- fdIsTTY fd let buffer_mode | is_tty = LineBuffering | otherwise = BlockBuffering Nothing return (ioref, buffer_mode) mkUnBuffer :: IO (IORef Buffer) mkUnBuffer = do buffer <- allocateBuffer 1 ReadBuffer newIORef buffer -- flushWriteBufferOnly flushes the buffer iff it contains pending write data. flushWriteBufferOnly :: Handle__ -> IO () flushWriteBufferOnly h_ = do let fd = haFD h_ ref = haBuffer h_ buf <- readIORef ref new_buf <- if bufferIsWritable buf then flushWriteBuffer fd (haIsStream h_) buf else return buf writeIORef ref new_buf -- flushBuffer syncs the file with the buffer, including moving the -- file pointer backwards in the case of a read buffer. flushBuffer :: Handle__ -> IO () flushBuffer h_ = do let ref = haBuffer h_ buf <- readIORef ref flushed_buf <- case bufState buf of ReadBuffer -> flushReadBuffer (haFD h_) buf WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf writeIORef ref flushed_buf -- When flushing a read buffer, we seek backwards by the number of -- characters in the buffer. The file descriptor must therefore be -- seekable: attempting to flush the read buffer on an unseekable -- handle is not allowed. flushReadBuffer :: FD -> Buffer -> IO Buffer flushReadBuffer fd buf | bufferEmpty buf = return buf | otherwise = do let off = negate (bufWPtr buf - bufRPtr buf) # ifdef DEBUG_DUMP puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n") # endif throwErrnoIfMinus1Retry "flushReadBuffer" (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR) return buf{ bufWPtr=0, bufRPtr=0 } flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = seq fd $ do -- strictness hack let bytes = w - r #ifdef DEBUG_DUMP puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n") #endif if bytes == 0 then return (buf{ bufRPtr=0, bufWPtr=0 }) else do res <- writeRawBuffer "flushWriteBuffer" (fromIntegral fd) is_stream b (fromIntegral r) (fromIntegral bytes) let res' = fromIntegral res if res' < bytes then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' }) else return buf{ bufRPtr=0, bufWPtr=0 } fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer fillReadBuffer fd is_line is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } = -- buffer better be empty: assert (r == 0 && w == 0) $ do fillReadBufferLoop fd is_line is_stream buf b w size -- For a line buffer, we just get the first chunk of data to arrive, -- and don't wait for the whole buffer to be full (but we *do* wait -- until some data arrives). This isn't really line buffering, but it -- appears to be what GHC has done for a long time, and I suspect it -- is more useful than line buffering in most cases. fillReadBufferLoop fd is_line is_stream buf b w size = do let bytes = size - w if bytes == 0 -- buffer full? then return buf{ bufRPtr=0, bufWPtr=w } else do #ifdef DEBUG_DUMP puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n") #endif res <- readRawBuffer "fillReadBuffer" fd is_stream b (fromIntegral w) (fromIntegral bytes) let res' = fromIntegral res #ifdef DEBUG_DUMP puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n") #endif if res' == 0 then if w == 0 then ioe_EOF else return buf{ bufRPtr=0, bufWPtr=w } else if res' < bytes && not is_line then fillReadBufferLoop fd is_line is_stream buf b (w+res') size else return buf{ bufRPtr=0, bufWPtr=w+res' } fillReadBufferWithoutBlocking :: FD -> Bool -> Buffer -> IO Buffer fillReadBufferWithoutBlocking fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } = -- buffer better be empty: assert (r == 0 && w == 0) $ do #ifdef DEBUG_DUMP puts ("fillReadBufferLoopNoBlock: bytes = " ++ show size ++ "\n") #endif res <- readRawBufferNoBlock "fillReadBuffer" fd is_stream b 0 (fromIntegral size) let res' = fromIntegral res #ifdef DEBUG_DUMP puts ("fillReadBufferLoopNoBlock: res' = " ++ show res' ++ "\n") #endif return buf{ bufRPtr=0, bufWPtr=res' } -- Low level routines for reading/writing to (raw)buffers: #ifndef mingw32_HOST_OS readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt readRawBuffer loc fd is_stream buf off len = throwErrnoIfMinus1RetryMayBlock loc (read_rawBuffer fd buf off len) (threadWaitRead (fromIntegral fd)) readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt readRawBufferNoBlock loc fd is_stream buf off len = throwErrnoIfMinus1RetryOnBlock loc (read_rawBuffer fd buf off len) (return 0) readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt readRawBufferPtr loc fd is_stream buf off len = throwErrnoIfMinus1RetryMayBlock loc (read_off fd buf off len) (threadWaitRead (fromIntegral fd)) writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt writeRawBuffer loc fd is_stream buf off len = throwErrnoIfMinus1RetryMayBlock loc (write_rawBuffer (fromIntegral fd) buf off len) (threadWaitWrite (fromIntegral fd)) writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt writeRawBufferPtr loc fd is_stream buf off len = throwErrnoIfMinus1RetryMayBlock loc (write_off (fromIntegral fd) buf off len) (threadWaitWrite (fromIntegral fd)) foreign import ccall unsafe "__hscore_PrelHandle_read" read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt foreign import ccall unsafe "__hscore_PrelHandle_read" read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt foreign import ccall unsafe "__hscore_PrelHandle_write" write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt foreign import ccall unsafe "__hscore_PrelHandle_write" write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt #else /* mingw32_HOST_OS.... */ readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt readRawBuffer loc fd is_stream buf off len | threaded = blockingReadRawBuffer loc fd is_stream buf off len | otherwise = asyncReadRawBuffer loc fd is_stream buf off len readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt readRawBufferPtr loc fd is_stream buf off len | threaded = blockingReadRawBufferPtr loc fd is_stream buf off len | otherwise = asyncReadRawBufferPtr loc fd is_stream buf off len writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt writeRawBuffer loc fd is_stream buf off len | threaded = blockingWriteRawBuffer loc fd is_stream buf off len | otherwise = asyncWriteRawBuffer loc fd is_stream buf off len writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt writeRawBufferPtr loc fd is_stream buf off len | threaded = blockingWriteRawBufferPtr loc fd is_stream buf off len | otherwise = asyncWriteRawBufferPtr loc fd is_stream buf off len -- ToDo: we don't have a non-blocking primitve read on Win32 readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt readRawBufferNoBlock = readRawBufferNoBlock -- Async versions of the read/write primitives, for the non-threaded RTS asyncReadRawBuffer loc fd is_stream buf off len = do (l, rc) <- asyncReadBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf if l == (-1) then ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) asyncReadRawBufferPtr loc fd is_stream buf off len = do (l, rc) <- asyncRead fd (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off) if l == (-1) then ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) asyncWriteRawBuffer loc fd is_stream buf off len = do (l, rc) <- asyncWriteBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf if l == (-1) then ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) asyncWriteRawBufferPtr loc fd is_stream buf off len = do (l, rc) <- asyncWrite fd (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off) if l == (-1) then ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) -- Blocking versions of the read/write primitives, for the threaded RTS blockingReadRawBuffer loc fd True buf off len = throwErrnoIfMinus1Retry loc $ recv_rawBuffer fd buf off len blockingReadRawBuffer loc fd False buf off len = throwErrnoIfMinus1Retry loc $ read_rawBuffer fd buf off len blockingReadRawBufferPtr loc fd True buf off len = throwErrnoIfMinus1Retry loc $ recv_off fd buf off len blockingReadRawBufferPtr loc fd False buf off len = throwErrnoIfMinus1Retry loc $ read_off fd buf off len blockingWriteRawBuffer loc fd True buf off len = throwErrnoIfMinus1Retry loc $ send_rawBuffer (fromIntegral fd) buf off len blockingWriteRawBuffer loc fd False buf off len = throwErrnoIfMinus1Retry loc $ write_rawBuffer (fromIntegral fd) buf off len blockingWriteRawBufferPtr loc fd True buf off len = throwErrnoIfMinus1Retry loc $ send_off (fromIntegral fd) buf off len blockingWriteRawBufferPtr loc fd False buf off len = throwErrnoIfMinus1Retry loc $ write_off (fromIntegral fd) buf off len -- NOTE: "safe" versions of the read/write calls for use by the threaded RTS. -- These calls may block, but that's ok. foreign import ccall safe "__hscore_PrelHandle_read" read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt foreign import ccall safe "__hscore_PrelHandle_read" read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt foreign import ccall safe "__hscore_PrelHandle_write" write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt foreign import ccall safe "__hscore_PrelHandle_write" write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt foreign import ccall safe "__hscore_PrelHandle_recv" recv_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt foreign import ccall safe "__hscore_PrelHandle_recv" recv_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt foreign import ccall safe "__hscore_PrelHandle_send" send_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt foreign import ccall safe "__hscore_PrelHandle_send" send_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool #endif -- --------------------------------------------------------------------------- -- Standard Handles -- Three handles are allocated during program initialisation. The first -- two manage input or output from the Haskell program's standard input -- or output channel respectively. The third manages output to the -- standard error channel. These handles are initially open. fd_stdin = 0 :: FD fd_stdout = 1 :: FD fd_stderr = 2 :: FD -- | A handle managing input from the Haskell program's standard input channel. stdin :: Handle stdin = unsafePerformIO $ do -- ToDo: acquire lock setNonBlockingFD fd_stdin (buf, bmode) <- getBuffer fd_stdin ReadBuffer mkStdHandle fd_stdin "" ReadHandle buf bmode -- | A handle managing output to the Haskell program's standard output channel. stdout :: Handle stdout = unsafePerformIO $ do -- ToDo: acquire lock -- We don't set non-blocking mode on stdout or sterr, because -- some shells don't recover properly. -- setNonBlockingFD fd_stdout (buf, bmode) <- getBuffer fd_stdout WriteBuffer mkStdHandle fd_stdout "" WriteHandle buf bmode -- | A handle managing output to the Haskell program's standard error channel. stderr :: Handle stderr = unsafePerformIO $ do -- ToDo: acquire lock -- We don't set non-blocking mode on stdout or sterr, because -- some shells don't recover properly. -- setNonBlockingFD fd_stderr buf <- mkUnBuffer mkStdHandle fd_stderr "" WriteHandle buf NoBuffering -- --------------------------------------------------------------------------- -- Opening and Closing Files addFilePathToIOError fun fp (IOError h iot _ str _) = IOError h iot fun str (Just fp) -- | Computation 'openFile' @file mode@ allocates and returns a new, open -- handle to manage the file @file@. It manages input if @mode@ -- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode', -- and both input and output if mode is 'ReadWriteMode'. -- -- If the file does not exist and it is opened for output, it should be -- created as a new file. If @mode@ is 'WriteMode' and the file -- already exists, then it should be truncated to zero length. -- Some operating systems delete empty files, so there is no guarantee -- that the file will exist following an 'openFile' with @mode@ -- 'WriteMode' unless it is subsequently written to successfully. -- The handle is positioned at the end of the file if @mode@ is -- 'AppendMode', and otherwise at the beginning (in which case its -- internal position is 0). -- The initial buffer mode is implementation-dependent. -- -- This operation may fail with: -- -- * 'isAlreadyInUseError' if the file is already open and cannot be reopened; -- -- * 'isDoesNotExistError' if the file does not exist; or -- -- * 'isPermissionError' if the user does not have permission to open the file. -- -- Note: if you will be working with files containing binary data, you'll want to -- be using 'openBinaryFile'. openFile :: FilePath -> IOMode -> IO Handle openFile fp im = catch (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE) (\e -> ioError (addFilePathToIOError "openFile" fp e)) -- | Like 'openFile', but open the file in binary mode. -- On Windows, reading a file in text mode (which is the default) -- will translate CRLF to LF, and writing will translate LF to CRLF. -- This is usually what you want with text files. With binary files -- this is undesirable; also, as usual under Microsoft operating systems, -- text mode treats control-Z as EOF. Binary mode turns off all special -- treatment of end-of-line and end-of-file characters. -- (See also 'hSetBinaryMode'.) openBinaryFile :: FilePath -> IOMode -> IO Handle openBinaryFile fp m = catch (openFile' fp m True) (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e)) openFile' filepath mode binary = withCString filepath $ \ f -> let oflags1 = case mode of ReadMode -> read_flags #ifdef mingw32_HOST_OS WriteMode -> write_flags .|. o_TRUNC #else WriteMode -> write_flags #endif ReadWriteMode -> rw_flags AppendMode -> append_flags binary_flags | binary = o_BINARY | otherwise = 0 oflags = oflags1 .|. binary_flags in do -- the old implementation had a complicated series of three opens, -- which is perhaps because we have to be careful not to open -- directories. However, the man pages I've read say that open() -- always returns EISDIR if the file is a directory and was opened -- for writing, so I think we're ok with a single open() here... fd <- fromIntegral `liftM` throwErrnoIfMinus1Retry "openFile" (c_open f (fromIntegral oflags) 0o666) fd_type <- fdType fd h <- openFd fd (Just fd_type) False filepath mode binary `catchException` \e -> do c_close (fromIntegral fd); throw e -- NB. don't forget to close the FD if openFd fails, otherwise -- this FD leaks. -- ASSERT: if we just created the file, then openFd won't fail -- (so we don't need to worry about removing the newly created file -- in the event of an error). #ifndef mingw32_HOST_OS -- we want to truncate() if this is an open in WriteMode, but only -- if the target is a RegularFile. ftruncate() fails on special files -- like /dev/null. if mode == WriteMode && fd_type == RegularFile then throwErrnoIf (/=0) "openFile" (c_ftruncate (fromIntegral fd) 0) else return 0 #endif return h -- | The function creates a temporary file in ReadWrite mode. -- The created file isn\'t deleted automatically, so you need to delete it manually. openTempFile :: FilePath -- ^ Directory in which to create the file -> String -- ^ File name template. If the template is \"foo.ext\" then -- the create file will be \"fooXXX.ext\" where XXX is some -- random number. -> IO (FilePath, Handle) openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template dEFAULT_OPEN_IN_BINARY_MODE -- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments. openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle) openBinaryTempFile tmp_dir template = openTempFile' "openBinaryTempFile" tmp_dir template True openTempFile' :: String -> FilePath -> String -> Bool -> IO (FilePath, Handle) openTempFile' loc tmp_dir template binary = do pid <- c_getpid findTempName pid where (prefix,suffix) = break (=='.') template oflags1 = rw_flags .|. o_EXCL binary_flags | binary = o_BINARY | otherwise = 0 oflags = oflags1 .|. binary_flags findTempName x = do fd <- withCString filepath $ \ f -> c_open f oflags 0o666 if fd < 0 then do errno <- getErrno if errno == eEXIST then findTempName (x+1) else ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) else do h <- openFd (fromIntegral fd) Nothing False filepath ReadWriteMode True `catchException` \e -> do c_close (fromIntegral fd); throw e return (filepath, h) where filename = prefix ++ show x ++ suffix filepath = tmp_dir `joinFileName` filename std_flags = o_NONBLOCK .|. o_NOCTTY output_flags = std_flags .|. o_CREAT read_flags = std_flags .|. o_RDONLY write_flags = output_flags .|. o_WRONLY rw_flags = output_flags .|. o_RDWR append_flags = write_flags .|. o_APPEND -- --------------------------------------------------------------------------- -- openFd openFd :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool -> IO Handle openFd fd mb_fd_type is_socket filepath mode binary = do -- turn on non-blocking mode setNonBlockingFD fd let (ha_type, write) = case mode of ReadMode -> ( ReadHandle, False ) WriteMode -> ( WriteHandle, True ) ReadWriteMode -> ( ReadWriteHandle, True ) AppendMode -> ( AppendHandle, True ) -- open() won't tell us if it was a directory if we only opened for -- reading, so check again. fd_type <- case mb_fd_type of Just x -> return x Nothing -> fdType fd case fd_type of Directory -> ioException (IOError Nothing InappropriateType "openFile" "is a directory" Nothing) -- regular files need to be locked RegularFile -> do #ifndef mingw32_HOST_OS r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-} when (r == -1) $ ioException (IOError Nothing ResourceBusy "openFile" "file is locked" Nothing) #endif mkFileHandle fd is_socket filepath ha_type binary Stream -- only *Streams* can be DuplexHandles. Other read/write -- Handles must share a buffer. | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_socket filepath binary | otherwise -> mkFileHandle fd is_socket filepath ha_type binary RawDevice -> mkFileHandle fd is_socket filepath ha_type binary fdToHandle :: FD -> IO Handle fdToHandle fd = do mode <- fdGetMode fd let fd_str = "" openFd fd Nothing False{-XXX!-} fd_str mode True{-bin mode-} #ifndef mingw32_HOST_OS foreign import ccall unsafe "lockFile" lockFile :: CInt -> CInt -> CInt -> IO CInt foreign import ccall unsafe "unlockFile" unlockFile :: CInt -> IO CInt #endif mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode -> IO Handle mkStdHandle fd filepath ha_type buf bmode = do spares <- newIORef BufferListNil newFileHandle filepath (stdHandleFinalizer filepath) (Handle__ { haFD = fd, haType = ha_type, haIsBin = dEFAULT_OPEN_IN_BINARY_MODE, haIsStream = False, haBufferMode = bmode, haBuffer = buf, haBuffers = spares, haOtherSide = Nothing }) mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle mkFileHandle fd is_stream filepath ha_type binary = do (buf, bmode) <- getBuffer fd (initBufferState ha_type) #ifdef mingw32_HOST_OS -- On Windows, if this is a read/write handle and we are in text mode, -- turn off buffering. We don't correctly handle the case of switching -- from read mode to write mode on a buffered text-mode handle, see bug -- #679. bmode <- case ha_type of ReadWriteHandle | not binary -> return NoBuffering _other -> return bmode #endif spares <- newIORef BufferListNil newFileHandle filepath (handleFinalizer filepath) (Handle__ { haFD = fd, haType = ha_type, haIsBin = binary, haIsStream = is_stream, haBufferMode = bmode, haBuffer = buf, haBuffers = spares, haOtherSide = Nothing }) mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle mkDuplexHandle fd is_stream filepath binary = do (w_buf, w_bmode) <- getBuffer fd WriteBuffer w_spares <- newIORef BufferListNil let w_handle_ = Handle__ { haFD = fd, haType = WriteHandle, haIsBin = binary, haIsStream = is_stream, haBufferMode = w_bmode, haBuffer = w_buf, haBuffers = w_spares, haOtherSide = Nothing } write_side <- newMVar w_handle_ (r_buf, r_bmode) <- getBuffer fd ReadBuffer r_spares <- newIORef BufferListNil let r_handle_ = Handle__ { haFD = fd, haType = ReadHandle, haIsBin = binary, haIsStream = is_stream, haBufferMode = r_bmode, haBuffer = r_buf, haBuffers = r_spares, haOtherSide = Just write_side } read_side <- newMVar r_handle_ addMVarFinalizer write_side (handleFinalizer filepath write_side) return (DuplexHandle filepath read_side write_side) initBufferState ReadHandle = ReadBuffer initBufferState _ = WriteBuffer -- --------------------------------------------------------------------------- -- Closing a handle -- | Computation 'hClose' @hdl@ makes handle @hdl@ closed. Before the -- computation finishes, if @hdl@ is writable its buffer is flushed as -- for 'hFlush'. -- Performing 'hClose' on a handle that has already been closed has no effect; -- doing so not an error. All other operations on a closed handle will fail. -- If 'hClose' fails for any reason, any further operations (apart from -- 'hClose') on the handle will still fail as if @hdl@ had been successfully -- closed. hClose :: Handle -> IO () hClose h@(FileHandle _ m) = hClose' h m hClose h@(DuplexHandle _ r w) = hClose' h w >> hClose' h r hClose' h m = withHandle__' "hClose" h m $ hClose_help -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read -- or an IO error occurs on a lazy stream. The semi-closed Handle is -- then closed immediately. We have to be careful with DuplexHandles -- though: we have to leave the closing to the finalizer in that case, -- because the write side may still be in use. hClose_help :: Handle__ -> IO Handle__ hClose_help handle_ = case haType handle_ of ClosedHandle -> return handle_ _ -> do flushWriteBufferOnly handle_ -- interruptible hClose_handle_ handle_ hClose_handle_ handle_ = do let fd = haFD handle_ c_fd = fromIntegral fd -- close the file descriptor, but not when this is the read -- side of a duplex handle. case haOtherSide handle_ of Nothing -> throwErrnoIfMinus1Retry_ "hClose" #ifdef mingw32_HOST_OS (closeFd (haIsStream handle_) c_fd) #else (c_close c_fd) #endif Just _ -> return () -- free the spare buffers writeIORef (haBuffers handle_) BufferListNil #ifndef mingw32_HOST_OS -- unlock it unlockFile c_fd #endif -- we must set the fd to -1, because the finalizer is going -- to run eventually and try to close/unlock it. return (handle_{ haFD = -1, haType = ClosedHandle }) ----------------------------------------------------------------------------- -- Detecting and changing the size of a file -- | For a handle @hdl@ which attached to a physical file, -- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes. hFileSize :: Handle -> IO Integer hFileSize handle = withHandle_ "hFileSize" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle _ -> do flushWriteBufferOnly handle_ r <- fdFileSize (haFD handle_) if r /= -1 then return r else ioException (IOError Nothing InappropriateType "hFileSize" "not a regular file" Nothing) -- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes. hSetFileSize :: Handle -> Integer -> IO () hSetFileSize handle size = withHandle_ "hSetFileSize" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle _ -> do flushWriteBufferOnly handle_ throwErrnoIf (/=0) "hSetFileSize" (c_ftruncate (fromIntegral (haFD handle_)) (fromIntegral size)) return () -- --------------------------------------------------------------------------- -- Detecting the End of Input -- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns -- 'True' if no further input can be taken from @hdl@ or for a -- physical file, if the current I\/O position is equal to the length of -- the file. Otherwise, it returns 'False'. hIsEOF :: Handle -> IO Bool hIsEOF handle = catch (do hLookAhead handle; return False) (\e -> if isEOFError e then return True else ioError e) -- | The computation 'isEOF' is identical to 'hIsEOF', -- except that it works only on 'stdin'. isEOF :: IO Bool isEOF = hIsEOF stdin -- --------------------------------------------------------------------------- -- Looking ahead -- | Computation 'hLookAhead' returns the next character from the handle -- without removing it from the input buffer, blocking until a character -- is available. -- -- This operation may fail with: -- -- * 'isEOFError' if the end of file has been reached. hLookAhead :: Handle -> IO Char hLookAhead handle = do wantReadableHandle "hLookAhead" handle $ \handle_ -> do let ref = haBuffer handle_ fd = haFD handle_ is_line = haBufferMode handle_ == LineBuffering buf <- readIORef ref -- fill up the read buffer if necessary new_buf <- if bufferEmpty buf then fillReadBuffer fd True (haIsStream handle_) buf else return buf writeIORef ref new_buf (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf) return c -- --------------------------------------------------------------------------- -- Buffering Operations -- Three kinds of buffering are supported: line-buffering, -- block-buffering or no-buffering. See GHC.IOBase for definition and -- further explanation of what the type represent. -- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for -- handle @hdl@ on subsequent reads and writes. -- -- If the buffer mode is changed from 'BlockBuffering' or -- 'LineBuffering' to 'NoBuffering', then -- -- * if @hdl@ is writable, the buffer is flushed as for 'hFlush'; -- -- * if @hdl@ is not writable, the contents of the buffer is discarded. -- -- This operation may fail with: -- -- * 'isPermissionError' if the handle has already been used for reading -- or writing and the implementation does not allow the buffering mode -- to be changed. hSetBuffering :: Handle -> BufferMode -> IO () hSetBuffering handle mode = withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle _ -> do {- Note: - we flush the old buffer regardless of whether the new buffer could fit the contents of the old buffer or not. - allow a handle's buffering to change even if IO has occurred (ANSI C spec. does not allow this, nor did the previous implementation of IO.hSetBuffering). - a non-standard extension is to allow the buffering of semi-closed handles to change [sof 6/98] -} flushBuffer handle_ let state = initBufferState (haType handle_) new_buf <- case mode of -- we always have a 1-character read buffer for -- unbuffered handles: it's needed to -- support hLookAhead. NoBuffering -> allocateBuffer 1 ReadBuffer LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n | otherwise -> allocateBuffer n state writeIORef (haBuffer handle_) new_buf -- for input terminals we need to put the terminal into -- cooked or raw mode depending on the type of buffering. is_tty <- fdIsTTY (haFD handle_) when (is_tty && isReadableHandleType (haType handle_)) $ case mode of #ifndef mingw32_HOST_OS -- 'raw' mode under win32 is a bit too specialised (and troublesome -- for most common uses), so simply disable its use here. NoBuffering -> setCooked (haFD handle_) False #else NoBuffering -> return () #endif _ -> setCooked (haFD handle_) True -- throw away spare buffers, they might be the wrong size writeIORef (haBuffers handle_) BufferListNil return (handle_{ haBufferMode = mode }) -- ----------------------------------------------------------------------------- -- hFlush -- | The action 'hFlush' @hdl@ causes any items buffered for output -- in handle @hdl@ to be sent immediately to the operating system. -- -- This operation may fail with: -- -- * 'isFullError' if the device is full; -- -- * 'isPermissionError' if a system resource limit would be exceeded. -- It is unspecified whether the characters in the buffer are discarded -- or retained under these circumstances. hFlush :: Handle -> IO () hFlush handle = wantWritableHandle "hFlush" handle $ \ handle_ -> do buf <- readIORef (haBuffer handle_) if bufferIsWritable buf && not (bufferEmpty buf) then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf writeIORef (haBuffer handle_) flushed_buf else return () -- ----------------------------------------------------------------------------- -- Repositioning Handles data HandlePosn = HandlePosn Handle HandlePosition instance Eq HandlePosn where (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2 instance Show HandlePosn where showsPrec p (HandlePosn h pos) = showsPrec p h . showString " at position " . shows pos -- HandlePosition is the Haskell equivalent of POSIX' off_t. -- We represent it as an Integer on the Haskell side, but -- cheat slightly in that hGetPosn calls upon a C helper -- that reports the position back via (merely) an Int. type HandlePosition = Integer -- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of -- @hdl@ as a value of the abstract type 'HandlePosn'. hGetPosn :: Handle -> IO HandlePosn hGetPosn handle = do posn <- hTell handle return (HandlePosn handle posn) -- | If a call to 'hGetPosn' @hdl@ returns a position @p@, -- then computation 'hSetPosn' @p@ sets the position of @hdl@ -- to the position it held at the time of the call to 'hGetPosn'. -- -- This operation may fail with: -- -- * 'isPermissionError' if a system resource limit would be exceeded. hSetPosn :: HandlePosn -> IO () hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i -- --------------------------------------------------------------------------- -- hSeek -- | A mode that determines the effect of 'hSeek' @hdl mode i@, as follows: data SeekMode = AbsoluteSeek -- ^ the position of @hdl@ is set to @i@. | RelativeSeek -- ^ the position of @hdl@ is set to offset @i@ -- from the current position. | SeekFromEnd -- ^ the position of @hdl@ is set to offset @i@ -- from the end of the file. deriving (Eq, Ord, Ix, Enum, Read, Show) {- Note: - when seeking using `SeekFromEnd', positive offsets (>=0) means seeking at or past EOF. - we possibly deviate from the report on the issue of seeking within the buffer and whether to flush it or not. The report isn't exactly clear here. -} -- | Computation 'hSeek' @hdl mode i@ sets the position of handle -- @hdl@ depending on @mode@. -- The offset @i@ is given in terms of 8-bit bytes. -- -- If @hdl@ is block- or line-buffered, then seeking to a position which is not -- in the current buffer will first cause any items in the output buffer to be -- written to the device, and then cause the input buffer to be discarded. -- Some handles may not be seekable (see 'hIsSeekable'), or only support a -- subset of the possible positioning operations (for instance, it may only -- be possible to seek to the end of a tape, or to a positive offset from -- the beginning or current position). -- It is not possible to set a negative I\/O position, or for -- a physical file, an I\/O position beyond the current end-of-file. -- -- This operation may fail with: -- -- * 'isPermissionError' if a system resource limit would be exceeded. hSeek :: Handle -> SeekMode -> Integer -> IO () hSeek handle mode offset = wantSeekableHandle "hSeek" handle $ \ handle_ -> do # ifdef DEBUG_DUMP puts ("hSeek " ++ show (mode,offset) ++ "\n") # endif let ref = haBuffer handle_ buf <- readIORef ref let r = bufRPtr buf w = bufWPtr buf fd = haFD handle_ let do_seek = throwErrnoIfMinus1Retry_ "hSeek" (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence) whence :: CInt whence = case mode of AbsoluteSeek -> sEEK_SET RelativeSeek -> sEEK_CUR SeekFromEnd -> sEEK_END if bufferIsWritable buf then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf writeIORef ref new_buf do_seek else do if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r) then writeIORef ref buf{ bufRPtr = r + fromIntegral offset } else do new_buf <- flushReadBuffer (haFD handle_) buf writeIORef ref new_buf do_seek hTell :: Handle -> IO Integer hTell handle = wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do #if defined(mingw32_HOST_OS) -- urgh, on Windows we have to worry about \n -> \r\n translation, -- so we can't easily calculate the file position using the -- current buffer size. Just flush instead. flushBuffer handle_ #endif let fd = fromIntegral (haFD handle_) posn <- fromIntegral `liftM` throwErrnoIfMinus1Retry "hGetPosn" (c_lseek fd 0 sEEK_CUR) let ref = haBuffer handle_ buf <- readIORef ref let real_posn | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf) | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf) # ifdef DEBUG_DUMP puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n") puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n") # endif return real_posn -- ----------------------------------------------------------------------------- -- Handle Properties -- A number of operations return information about the properties of a -- handle. Each of these operations returns `True' if the handle has -- the specified property, and `False' otherwise. hIsOpen :: Handle -> IO Bool hIsOpen handle = withHandle_ "hIsOpen" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> return False SemiClosedHandle -> return False _ -> return True hIsClosed :: Handle -> IO Bool hIsClosed handle = withHandle_ "hIsClosed" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> return True _ -> return False {- not defined, nor exported, but mentioned here for documentation purposes: hSemiClosed :: Handle -> IO Bool hSemiClosed h = do ho <- hIsOpen h hc <- hIsClosed h return (not (ho || hc)) -} hIsReadable :: Handle -> IO Bool hIsReadable (DuplexHandle _ _ _) = return True hIsReadable handle = withHandle_ "hIsReadable" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle htype -> return (isReadableHandleType htype) hIsWritable :: Handle -> IO Bool hIsWritable (DuplexHandle _ _ _) = return True hIsWritable handle = withHandle_ "hIsWritable" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle htype -> return (isWritableHandleType htype) -- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode -- for @hdl@. hGetBuffering :: Handle -> IO BufferMode hGetBuffering handle = withHandle_ "hGetBuffering" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle _ -> -- We're being non-standard here, and allow the buffering -- of a semi-closed handle to be queried. -- sof 6/98 return (haBufferMode handle_) -- could be stricter.. hIsSeekable :: Handle -> IO Bool hIsSeekable handle = withHandle_ "hIsSeekable" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle AppendHandle -> return False _ -> do t <- fdType (haFD handle_) return ((t == RegularFile || t == RawDevice) && (haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED)) -- ----------------------------------------------------------------------------- -- Changing echo status (Non-standard GHC extensions) -- | Set the echoing status of a handle connected to a terminal. hSetEcho :: Handle -> Bool -> IO () hSetEcho handle on = do isT <- hIsTerminalDevice handle if not isT then return () else withHandle_ "hSetEcho" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle _ -> setEcho (haFD handle_) on -- | Get the echoing status of a handle connected to a terminal. hGetEcho :: Handle -> IO Bool hGetEcho handle = do isT <- hIsTerminalDevice handle if not isT then return False else withHandle_ "hGetEcho" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle _ -> getEcho (haFD handle_) -- | Is the handle connected to a terminal? hIsTerminalDevice :: Handle -> IO Bool hIsTerminalDevice handle = do withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> ioe_closedHandle _ -> fdIsTTY (haFD handle_) -- ----------------------------------------------------------------------------- -- hSetBinaryMode -- | Select binary mode ('True') or text mode ('False') on a open handle. -- (See also 'openBinaryFile'.) hSetBinaryMode :: Handle -> Bool -> IO () hSetBinaryMode handle bin = withAllHandles__ "hSetBinaryMode" handle $ \ handle_ -> do throwErrnoIfMinus1_ "hSetBinaryMode" (setmode (fromIntegral (haFD handle_)) bin) return handle_{haIsBin=bin} foreign import ccall unsafe "__hscore_setmode" setmode :: CInt -> Bool -> IO CInt -- ----------------------------------------------------------------------------- -- Duplicating a Handle -- | Returns a duplicate of the original handle, with its own buffer. -- The two Handles will share a file pointer, however. The original -- handle's buffer is flushed, including discarding any input data, -- before the handle is duplicated. hDuplicate :: Handle -> IO Handle hDuplicate h@(FileHandle path m) = do new_h_ <- withHandle' "hDuplicate" h m (dupHandle Nothing) newFileHandle path (handleFinalizer path) new_h_ hDuplicate h@(DuplexHandle path r w) = do new_w_ <- withHandle' "hDuplicate" h w (dupHandle Nothing) new_w <- newMVar new_w_ new_r_ <- withHandle' "hDuplicate" h r (dupHandle (Just new_w)) new_r <- newMVar new_r_ addMVarFinalizer new_w (handleFinalizer path new_w) return (DuplexHandle path new_r new_w) dupHandle other_side h_ = do -- flush the buffer first, so we don't have to copy its contents flushBuffer h_ new_fd <- throwErrnoIfMinus1 "dupHandle" $ c_dup (fromIntegral (haFD h_)) dupHandle_ other_side h_ new_fd dupHandleTo other_side hto_ h_ = do flushBuffer h_ -- Windows' dup2 does not return the new descriptor, unlike Unix throwErrnoIfMinus1 "dupHandleTo" $ c_dup2 (fromIntegral (haFD h_)) (fromIntegral (haFD hto_)) dupHandle_ other_side h_ (haFD hto_) dupHandle_ other_side h_ new_fd = do buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_)) ioref <- newIORef buffer ioref_buffers <- newIORef BufferListNil let new_handle_ = h_{ haFD = fromIntegral new_fd, haBuffer = ioref, haBuffers = ioref_buffers, haOtherSide = other_side } return (h_, new_handle_) -- ----------------------------------------------------------------------------- -- Replacing a Handle {- | Makes the second handle a duplicate of the first handle. The second handle will be closed first, if it is not already. This can be used to retarget the standard Handles, for example: > do h <- openFile "mystdout" WriteMode > hDuplicateTo h stdout -} hDuplicateTo :: Handle -> Handle -> IO () hDuplicateTo h1@(FileHandle _ m1) h2@(FileHandle _ m2) = do withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do _ <- hClose_help h2_ withHandle' "hDuplicateTo" h1 m1 (dupHandleTo Nothing h2_) hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2) = do withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do _ <- hClose_help w2_ withHandle' "hDuplicateTo" h1 r1 (dupHandleTo Nothing w2_) withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do _ <- hClose_help r2_ withHandle' "hDuplicateTo" h1 r1 (dupHandleTo (Just w1) r2_) hDuplicateTo h1 _ = ioException (IOError (Just h1) IllegalOperation "hDuplicateTo" "handles are incompatible" Nothing) -- --------------------------------------------------------------------------- -- showing Handles. -- -- | 'hShow' is in the 'IO' monad, and gives more comprehensive output -- than the (pure) instance of 'Show' for 'Handle'. hShow :: Handle -> IO String hShow h@(FileHandle path _) = showHandle' path False h hShow h@(DuplexHandle path _ _) = showHandle' path True h showHandle' filepath is_duplex h = withHandle_ "showHandle" h $ \hdl_ -> let showType | is_duplex = showString "duplex (read-write)" | otherwise = shows (haType hdl_) in return (( showChar '{' . showHdl (haType hdl_) (showString "loc=" . showString filepath . showChar ',' . showString "type=" . showType . showChar ',' . showString "binary=" . shows (haIsBin hdl_) . showChar ',' . showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" ) ) "") where showHdl :: HandleType -> ShowS -> ShowS showHdl ht cont = case ht of ClosedHandle -> shows ht . showString "}" _ -> cont showBufMode :: Buffer -> BufferMode -> ShowS showBufMode buf bmo = case bmo of NoBuffering -> showString "none" LineBuffering -> showString "line" BlockBuffering (Just n) -> showString "block " . showParen True (shows n) BlockBuffering Nothing -> showString "block " . showParen True (shows def) where def :: Int def = bufSize buf -- --------------------------------------------------------------------------- -- debugging #if defined(DEBUG_DUMP) puts :: String -> IO () puts s = do write_rawBuffer 1 (unsafeCoerce# (packCString# s)) 0 (fromIntegral (length s)) return () #endif -- ----------------------------------------------------------------------------- -- utils throwErrnoIfMinus1RetryOnBlock :: String -> IO CInt -> IO CInt -> IO CInt throwErrnoIfMinus1RetryOnBlock loc f on_block = do res <- f if (res :: CInt) == -1 then do err <- getErrno if err == eINTR then throwErrnoIfMinus1RetryOnBlock loc f on_block else if err == eWOULDBLOCK || err == eAGAIN then do on_block else throwErrno loc else return res -- ----------------------------------------------------------------------------- -- wrappers to platform-specific constants: foreign import ccall unsafe "__hscore_supportsTextMode" tEXT_MODE_SEEK_ALLOWED :: Bool foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt hugs98-plus-Sep2006/packages/base/GHC/IO.hs0000644006511100651110000007600010504340221016711 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-} #undef DEBUG_DUMP ----------------------------------------------------------------------------- -- | -- Module : GHC.IO -- Copyright : (c) The University of Glasgow, 1992-2001 -- License : see libraries/base/LICENSE -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable -- -- String I\/O functions -- ----------------------------------------------------------------------------- -- #hide module GHC.IO ( hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr, commitBuffer', -- hack, see below hGetcBuffered, -- needed by ghc/compiler/utils/StringBuffer.lhs hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking, slurpFile, memcpy_ba_baoff, memcpy_ptr_baoff, memcpy_baoff_ba, memcpy_baoff_ptr, ) where import Foreign import Foreign.C import System.IO.Error import Data.Maybe import Control.Monad import System.Posix.Internals import GHC.Enum import GHC.Base import GHC.IOBase import GHC.Handle -- much of the real stuff is in here import GHC.Real import GHC.Num import GHC.Show import GHC.List import GHC.Exception ( ioError, catch ) #ifdef mingw32_HOST_OS import GHC.Conc #endif -- --------------------------------------------------------------------------- -- Simple input operations -- If hWaitForInput finds anything in the Handle's buffer, it -- immediately returns. If not, it tries to read from the underlying -- OS handle. Notice that for buffered Handles connected to terminals -- this means waiting until a complete line is available. -- | Computation 'hWaitForInput' @hdl t@ -- waits until input is available on handle @hdl@. -- It returns 'True' as soon as input is available on @hdl@, -- or 'False' if no input is available within @t@ milliseconds. -- -- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely. -- NOTE: in the current implementation, this is the only case that works -- correctly (if @t@ is non-zero, then all other concurrent threads are -- blocked until data is available). -- -- This operation may fail with: -- -- * 'isEOFError' if the end of file has been reached. hWaitForInput :: Handle -> Int -> IO Bool hWaitForInput h msecs = do wantReadableHandle "hWaitForInput" h $ \ handle_ -> do let ref = haBuffer handle_ buf <- readIORef ref if not (bufferEmpty buf) then return True else do if msecs < 0 then do buf' <- fillReadBuffer (haFD handle_) True (haIsStream handle_) buf writeIORef ref buf' return True else do r <- throwErrnoIfMinus1Retry "hWaitForInput" $ inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs) (haIsStream handle_) return (r /= 0) foreign import ccall safe "inputReady" inputReady :: CInt -> CInt -> Bool -> IO CInt -- --------------------------------------------------------------------------- -- hGetChar -- | Computation 'hGetChar' @hdl@ reads a character from the file or -- channel managed by @hdl@, blocking until a character is available. -- -- This operation may fail with: -- -- * 'isEOFError' if the end of file has been reached. hGetChar :: Handle -> IO Char hGetChar handle = wantReadableHandle "hGetChar" handle $ \handle_ -> do let fd = haFD handle_ ref = haBuffer handle_ buf <- readIORef ref if not (bufferEmpty buf) then hGetcBuffered fd ref buf else do -- buffer is empty. case haBufferMode handle_ of LineBuffering -> do new_buf <- fillReadBuffer fd True (haIsStream handle_) buf hGetcBuffered fd ref new_buf BlockBuffering _ -> do new_buf <- fillReadBuffer fd True (haIsStream handle_) buf -- ^^^^ -- don't wait for a completely full buffer. hGetcBuffered fd ref new_buf NoBuffering -> do -- make use of the minimal buffer we already have let raw = bufBuf buf r <- readRawBuffer "hGetChar" (fromIntegral fd) (haIsStream handle_) raw 0 1 if r == 0 then ioe_EOF else do (c,_) <- readCharFromBuffer raw 0 return c hGetcBuffered fd ref buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do (c,r) <- readCharFromBuffer b r let new_buf | r == w = buf{ bufRPtr=0, bufWPtr=0 } | otherwise = buf{ bufRPtr=r } writeIORef ref new_buf return c -- --------------------------------------------------------------------------- -- hGetLine -- ToDo: the unbuffered case is wrong: it doesn't lock the handle for -- the duration. -- | Computation 'hGetLine' @hdl@ reads a line from the file or -- channel managed by @hdl@. -- -- This operation may fail with: -- -- * 'isEOFError' if the end of file is encountered when reading -- the /first/ character of the line. -- -- If 'hGetLine' encounters end-of-file at any other point while reading -- in a line, it is treated as a line terminator and the (partial) -- line is returned. hGetLine :: Handle -> IO String hGetLine h = do m <- wantReadableHandle "hGetLine" h $ \ handle_ -> do case haBufferMode handle_ of NoBuffering -> return Nothing LineBuffering -> do l <- hGetLineBuffered handle_ return (Just l) BlockBuffering _ -> do l <- hGetLineBuffered handle_ return (Just l) case m of Nothing -> hGetLineUnBuffered h Just l -> return l hGetLineBuffered handle_ = do let ref = haBuffer handle_ buf <- readIORef ref hGetLineBufferedLoop handle_ ref buf [] hGetLineBufferedLoop handle_ ref buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss = let -- find the end-of-line character, if there is one loop raw r | r == w = return (False, w) | otherwise = do (c,r') <- readCharFromBuffer raw r if c == '\n' then return (True, r) -- NB. not r': don't include the '\n' else loop raw r' in do (eol, off) <- loop raw r #ifdef DEBUG_DUMP puts ("hGetLineBufferedLoop: r=" ++ show r ++ ", w=" ++ show w ++ ", off=" ++ show off ++ "\n") #endif xs <- unpack raw r off -- if eol == True, then off is the offset of the '\n' -- otherwise off == w and the buffer is now empty. if eol then do if (w == off + 1) then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } else writeIORef ref buf{ bufRPtr = off + 1 } return (concat (reverse (xs:xss))) else do maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_) buf{ bufWPtr=0, bufRPtr=0 } case maybe_buf of -- Nothing indicates we caught an EOF, and we may have a -- partial line to return. Nothing -> do writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } let str = concat (reverse (xs:xss)) if not (null str) then return str else ioe_EOF Just new_buf -> hGetLineBufferedLoop handle_ ref new_buf (xs:xss) maybeFillReadBuffer fd is_line is_stream buf = catch (do buf <- fillReadBuffer fd is_line is_stream buf return (Just buf) ) (\e -> do if isEOFError e then return Nothing else ioError e) unpack :: RawBuffer -> Int -> Int -> IO [Char] unpack buf r 0 = return "" unpack buf (I# r) (I# len) = IO $ \s -> unpack [] (len -# 1#) s where unpack acc i s | i <# r = (# s, acc #) | otherwise = case readCharArray# buf i s of (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s hGetLineUnBuffered :: Handle -> IO String hGetLineUnBuffered h = do c <- hGetChar h if c == '\n' then return "" else do l <- getRest return (c:l) where getRest = do c <- catch (hGetChar h) (\ err -> do if isEOFError err then return '\n' else ioError err) if c == '\n' then return "" else do s <- getRest return (c:s) -- ----------------------------------------------------------------------------- -- hGetContents -- hGetContents on a DuplexHandle only affects the read side: you can -- carry on writing to it afterwards. -- | Computation 'hGetContents' @hdl@ returns the list of characters -- corresponding to the unread portion of the channel or file managed -- by @hdl@, which is put into an intermediate state, /semi-closed/. -- In this state, @hdl@ is effectively closed, -- but items are read from @hdl@ on demand and accumulated in a special -- list returned by 'hGetContents' @hdl@. -- -- Any operation that fails because a handle is closed, -- also fails if a handle is semi-closed. The only exception is 'hClose'. -- A semi-closed handle becomes closed: -- -- * if 'hClose' is applied to it; -- -- * if an I\/O error occurs when reading an item from the handle; -- -- * or once the entire contents of the handle has been read. -- -- Once a semi-closed handle becomes closed, the contents of the -- associated list becomes fixed. The contents of this final list is -- only partially specified: it will contain at least all the items of -- the stream that were evaluated prior to the handle becoming closed. -- -- Any I\/O errors encountered while a handle is semi-closed are simply -- discarded. -- -- This operation may fail with: -- -- * 'isEOFError' if the end of file has been reached. hGetContents :: Handle -> IO String hGetContents handle = withHandle "hGetContents" handle $ \handle_ -> case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle AppendHandle -> ioe_notReadable WriteHandle -> ioe_notReadable _ -> do xs <- lazyRead handle return (handle_{ haType=SemiClosedHandle}, xs ) -- Note that someone may close the semi-closed handle (or change its -- buffering), so each time these lazy read functions are pulled on, -- they have to check whether the handle has indeed been closed. lazyRead :: Handle -> IO String lazyRead handle = unsafeInterleaveIO $ withHandle "lazyRead" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> return (handle_, "") SemiClosedHandle -> lazyRead' handle handle_ _ -> ioException (IOError (Just handle) IllegalOperation "lazyRead" "illegal handle type" Nothing) lazyRead' h handle_ = do let ref = haBuffer handle_ fd = haFD handle_ -- even a NoBuffering handle can have a char in the buffer... -- (see hLookAhead) buf <- readIORef ref if not (bufferEmpty buf) then lazyReadHaveBuffer h handle_ fd ref buf else do case haBufferMode handle_ of NoBuffering -> do -- make use of the minimal buffer we already have let raw = bufBuf buf r <- readRawBuffer "lazyRead" (fromIntegral fd) (haIsStream handle_) raw 0 1 if r == 0 then do handle_ <- hClose_help handle_ return (handle_, "") else do (c,_) <- readCharFromBuffer raw 0 rest <- lazyRead h return (handle_, c : rest) LineBuffering -> lazyReadBuffered h handle_ fd ref buf BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf -- we never want to block during the read, so we call fillReadBuffer with -- is_line==True, which tells it to "just read what there is". lazyReadBuffered h handle_ fd ref buf = do catch (do buf <- fillReadBuffer fd True{-is_line-} (haIsStream handle_) buf lazyReadHaveBuffer h handle_ fd ref buf ) -- all I/O errors are discarded. Additionally, we close the handle. (\e -> do handle_ <- hClose_help handle_ return (handle_, "") ) lazyReadHaveBuffer h handle_ fd ref buf = do more <- lazyRead h writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more return (handle_, s) unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char] unpackAcc buf r 0 acc = return acc unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s where unpack acc i s | i <# r = (# s, acc #) | otherwise = case readCharArray# buf i s of (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s -- --------------------------------------------------------------------------- -- hPutChar -- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the -- file or channel managed by @hdl@. Characters may be buffered if -- buffering is enabled for @hdl@. -- -- This operation may fail with: -- -- * 'isFullError' if the device is full; or -- -- * 'isPermissionError' if another system resource limit would be exceeded. hPutChar :: Handle -> Char -> IO () hPutChar handle c = do c `seq` return () wantWritableHandle "hPutChar" handle $ \ handle_ -> do let fd = haFD handle_ case haBufferMode handle_ of LineBuffering -> hPutcBuffered handle_ True c BlockBuffering _ -> hPutcBuffered handle_ False c NoBuffering -> with (castCharToCChar c) $ \buf -> do writeRawBufferPtr "hPutChar" (fromIntegral fd) (haIsStream handle_) buf 0 1 return () hPutcBuffered handle_ is_line c = do let ref = haBuffer handle_ buf <- readIORef ref let w = bufWPtr buf w' <- writeCharIntoBuffer (bufBuf buf) w c let new_buf = buf{ bufWPtr = w' } if bufferFull new_buf || is_line && c == '\n' then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) new_buf writeIORef ref flushed_buf else do writeIORef ref new_buf hPutChars :: Handle -> [Char] -> IO () hPutChars handle [] = return () hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs -- --------------------------------------------------------------------------- -- hPutStr -- We go to some trouble to avoid keeping the handle locked while we're -- evaluating the string argument to hPutStr, in case doing so triggers another -- I/O operation on the same handle which would lead to deadlock. The classic -- case is -- -- putStr (trace "hello" "world") -- -- so the basic scheme is this: -- -- * copy the string into a fresh buffer, -- * "commit" the buffer to the handle. -- -- Committing may involve simply copying the contents of the new -- buffer into the handle's buffer, flushing one or both buffers, or -- maybe just swapping the buffers over (if the handle's buffer was -- empty). See commitBuffer below. -- | Computation 'hPutStr' @hdl s@ writes the string -- @s@ to the file or channel managed by @hdl@. -- -- This operation may fail with: -- -- * 'isFullError' if the device is full; or -- -- * 'isPermissionError' if another system resource limit would be exceeded. hPutStr :: Handle -> String -> IO () hPutStr handle str = do buffer_mode <- wantWritableHandle "hPutStr" handle (\ handle_ -> do getSpareBuffer handle_) case buffer_mode of (NoBuffering, _) -> do hPutChars handle str -- v. slow, but we don't care (LineBuffering, buf) -> do writeLines handle buf str (BlockBuffering _, buf) -> do writeBlocks handle buf str getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer) getSpareBuffer Handle__{haBuffer=ref, haBuffers=spare_ref, haBufferMode=mode} = do case mode of NoBuffering -> return (mode, error "no buffer!") _ -> do bufs <- readIORef spare_ref buf <- readIORef ref case bufs of BufferListCons b rest -> do writeIORef spare_ref rest return ( mode, newEmptyBuffer b WriteBuffer (bufSize buf)) BufferListNil -> do new_buf <- allocateBuffer (bufSize buf) WriteBuffer return (mode, new_buf) writeLines :: Handle -> Buffer -> String -> IO () writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s = let shoveString :: Int -> [Char] -> IO () -- check n == len first, to ensure that shoveString is strict in n. shoveString n cs | n == len = do new_buf <- commitBuffer hdl raw len n True{-needs flush-} False writeLines hdl new_buf cs shoveString n [] = do commitBuffer hdl raw len n False{-no flush-} True{-release-} return () shoveString n (c:cs) = do n' <- writeCharIntoBuffer raw n c if (c == '\n') then do new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False writeLines hdl new_buf cs else shoveString n' cs in shoveString 0 s writeBlocks :: Handle -> Buffer -> String -> IO () writeBlocks hdl Buffer{ bufBuf=raw, bufSize=len } s = let shoveString :: Int -> [Char] -> IO () -- check n == len first, to ensure that shoveString is strict in n. shoveString n cs | n == len = do new_buf <- commitBuffer hdl raw len n True{-needs flush-} False writeBlocks hdl new_buf cs shoveString n [] = do commitBuffer hdl raw len n False{-no flush-} True{-release-} return () shoveString n (c:cs) = do n' <- writeCharIntoBuffer raw n c shoveString n' cs in shoveString 0 s -- ----------------------------------------------------------------------------- -- commitBuffer handle buf sz count flush release -- -- Write the contents of the buffer 'buf' ('sz' bytes long, containing -- 'count' bytes of data) to handle (handle must be block or line buffered). -- -- Implementation: -- -- for block/line buffering, -- 1. If there isn't room in the handle buffer, flush the handle -- buffer. -- -- 2. If the handle buffer is empty, -- if flush, -- then write buf directly to the device. -- else swap the handle buffer with buf. -- -- 3. If the handle buffer is non-empty, copy buf into the -- handle buffer. Then, if flush != 0, flush -- the buffer. commitBuffer :: Handle -- handle to commit to -> RawBuffer -> Int -- address and size (in bytes) of buffer -> Int -- number of bytes of data in buffer -> Bool -- True <=> flush the handle afterward -> Bool -- release the buffer? -> IO Buffer commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do wantWritableHandle "commitAndReleaseBuffer" hdl $ commitBuffer' raw sz count flush release -- Explicitly lambda-lift this function to subvert GHC's full laziness -- optimisations, which otherwise tends to float out subexpressions -- past the \handle, which is really a pessimisation in this case because -- that lambda is a one-shot lambda. -- -- Don't forget to export the function, to stop it being inlined too -- (this appears to be better than NOINLINE, because the strictness -- analyser still gets to worker-wrapper it). -- -- This hack is a fairly big win for hPutStr performance. --SDM 18/9/2001 -- commitBuffer' raw sz@(I# _) count@(I# _) flush release handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do #ifdef DEBUG_DUMP puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n") #endif old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size } <- readIORef ref buf_ret <- -- enough room in handle buffer? if (not flush && (size - w > count)) -- The > is to be sure that we never exactly fill -- up the buffer, which would require a flush. So -- if copying the new data into the buffer would -- make the buffer full, we just flush the existing -- buffer and the new data immediately, rather than -- copying before flushing. -- not flushing, and there's enough room in the buffer: -- just copy the data in and update bufWPtr. then do memcpy_baoff_ba old_raw w raw (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return (newEmptyBuffer raw WriteBuffer sz) -- else, we have to flush else do flushed_buf <- flushWriteBuffer fd (haIsStream handle_) old_buf let this_buf = Buffer{ bufBuf=raw, bufState=WriteBuffer, bufRPtr=0, bufWPtr=count, bufSize=sz } -- if: (a) we don't have to flush, and -- (b) size(new buffer) == size(old buffer), and -- (c) new buffer is not full, -- we can just just swap them over... if (not flush && sz == size && count /= sz) then do writeIORef ref this_buf return flushed_buf -- otherwise, we have to flush the new data too, -- and start with a fresh buffer else do flushWriteBuffer fd (haIsStream handle_) this_buf writeIORef ref flushed_buf -- if the sizes were different, then allocate -- a new buffer of the correct size. if sz == size then return (newEmptyBuffer raw WriteBuffer sz) else allocateBuffer size WriteBuffer -- release the buffer if necessary case buf_ret of Buffer{ bufSize=buf_ret_sz, bufBuf=buf_ret_raw } -> do if release && buf_ret_sz == size then do spare_bufs <- readIORef spare_buf_ref writeIORef spare_buf_ref (BufferListCons buf_ret_raw spare_bufs) return buf_ret else return buf_ret -- --------------------------------------------------------------------------- -- Reading/writing sequences of bytes. -- --------------------------------------------------------------------------- -- hPutBuf -- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the -- buffer @buf@ to the handle @hdl@. It returns (). -- -- This operation may fail with: -- -- * 'ResourceVanished' if the handle is a pipe or socket, and the -- reading end is closed. (If this is a POSIX system, and the program -- has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered -- instead, whose default action is to terminate the program). hPutBuf :: Handle -- handle to write to -> Ptr a -- address of buffer -> Int -- number of bytes of data in buffer -> IO () hPutBuf h ptr count = do hPutBuf' h ptr count True; return () hPutBufNonBlocking :: Handle -- handle to write to -> Ptr a -- address of buffer -> Int -- number of bytes of data in buffer -> IO Int -- returns: number of bytes written hPutBufNonBlocking h ptr count = hPutBuf' h ptr count False hPutBuf':: Handle -- handle to write to -> Ptr a -- address of buffer -> Int -- number of bytes of data in buffer -> Bool -- allow blocking? -> IO Int hPutBuf' handle ptr count can_block | count == 0 = return 0 | count < 0 = illegalBufferSize handle "hPutBuf" count | otherwise = wantWritableHandle "hPutBuf" handle $ \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> bufWrite fd ref is_stream ptr count can_block bufWrite fd ref is_stream ptr count can_block = seq count $ seq fd $ do -- strictness hack old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size } <- readIORef ref -- enough room in handle buffer? if (size - w > count) -- There's enough room in the buffer: -- just copy the data in and update bufWPtr. then do memcpy_baoff_ptr old_raw w ptr (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return count -- else, we have to flush else do flushed_buf <- flushWriteBuffer fd is_stream old_buf -- TODO: we should do a non-blocking flush here writeIORef ref flushed_buf -- if we can fit in the buffer, then just loop if count < size then bufWrite fd ref is_stream ptr count can_block else if can_block then do writeChunk fd is_stream (castPtr ptr) count return count else writeChunkNonBlocking fd is_stream ptr count writeChunk :: FD -> Bool -> Ptr CChar -> Int -> IO () writeChunk fd is_stream ptr bytes = loop 0 bytes where loop :: Int -> Int -> IO () loop _ bytes | bytes <= 0 = return () loop off bytes = do r <- fromIntegral `liftM` writeRawBufferPtr "writeChunk" (fromIntegral fd) is_stream ptr off (fromIntegral bytes) -- write can't return 0 loop (off + r) (bytes - r) writeChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes where loop :: Int -> Int -> IO Int loop off bytes | bytes <= 0 = return off loop off bytes = do #ifndef mingw32_HOST_OS ssize <- c_write (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1) then do errno <- getErrno if (errno == eAGAIN || errno == eWOULDBLOCK) then return off else throwErrno "writeChunk" else loop (off + r) (bytes - r) #else (ssize, rc) <- asyncWrite fd (fromIntegral $ fromEnum is_stream) (fromIntegral bytes) (ptr `plusPtr` off) let r = fromIntegral ssize :: Int if r == (-1) then ioError (errnoToIOError "hPutBufNonBlocking" (Errno (fromIntegral rc)) Nothing Nothing) else loop (off + r) (bytes - r) #endif -- --------------------------------------------------------------------------- -- hGetBuf -- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@ -- into the buffer @buf@ until either EOF is reached or -- @count@ 8-bit bytes have been read. -- It returns the number of bytes actually read. This may be zero if -- EOF was reached before any data was read (or if @count@ is zero). -- -- 'hGetBuf' never raises an EOF exception, instead it returns a value -- smaller than @count@. -- -- If the handle is a pipe or socket, and the writing end -- is closed, 'hGetBuf' will behave as if EOF was reached. hGetBuf :: Handle -> Ptr a -> Int -> IO Int hGetBuf h ptr count | count == 0 = return 0 | count < 0 = illegalBufferSize h "hGetBuf" count | otherwise = wantReadableHandle "hGetBuf" h $ \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do bufRead fd ref is_stream ptr 0 count -- small reads go through the buffer, large reads are satisfied by -- taking data first from the buffer and then direct from the file -- descriptor. bufRead fd ref is_stream ptr so_far count = seq fd $ seq so_far $ seq count $ do -- strictness hack buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref if bufferEmpty buf then if count > sz -- small read? then do rest <- readChunk fd is_stream ptr count return (so_far + rest) else do mb_buf <- maybeFillReadBuffer fd True is_stream buf case mb_buf of Nothing -> return so_far -- got nothing, we're done Just buf' -> do writeIORef ref buf' bufRead fd ref is_stream ptr so_far count else do let avail = w - r if (count == avail) then do memcpy_ptr_baoff ptr raw r (fromIntegral count) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return (so_far + count) else do if (count < avail) then do memcpy_ptr_baoff ptr raw r (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return (so_far + count) else do memcpy_ptr_baoff ptr raw r (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } let remaining = count - avail so_far' = so_far + avail ptr' = ptr `plusPtr` avail if remaining < sz then bufRead fd ref is_stream ptr' so_far' remaining else do rest <- readChunk fd is_stream ptr' remaining return (so_far' + rest) readChunk :: FD -> Bool -> Ptr a -> Int -> IO Int readChunk fd is_stream ptr bytes = loop 0 bytes where loop :: Int -> Int -> IO Int loop off bytes | bytes <= 0 = return off loop off bytes = do r <- fromIntegral `liftM` readRawBufferPtr "readChunk" (fromIntegral fd) is_stream (castPtr ptr) off (fromIntegral bytes) if r == 0 then return off else loop (off + r) (bytes - r) -- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@ -- into the buffer @buf@ until either EOF is reached, or -- @count@ 8-bit bytes have been read, or there is no more data available -- to read immediately. -- -- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will -- never block waiting for data to become available, instead it returns -- only whatever data is available. To wait for data to arrive before -- calling 'hGetBufNonBlocking', use 'hWaitForInput'. -- -- If the handle is a pipe or socket, and the writing end -- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached. -- hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int hGetBufNonBlocking h ptr count | count == 0 = return 0 | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count | otherwise = wantReadableHandle "hGetBufNonBlocking" h $ \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do bufReadNonBlocking fd ref is_stream ptr 0 count bufReadNonBlocking fd ref is_stream ptr so_far count = seq fd $ seq so_far $ seq count $ do -- strictness hack buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref if bufferEmpty buf then if count > sz -- large read? then do rest <- readChunkNonBlocking fd is_stream ptr count return (so_far + rest) else do buf' <- fillReadBufferWithoutBlocking fd is_stream buf case buf' of { Buffer{ bufWPtr=w } -> if (w == 0) then return so_far else do writeIORef ref buf' bufReadNonBlocking fd ref is_stream ptr so_far (min count w) -- NOTE: new count is 'min count w' -- so we will just copy the contents of the -- buffer in the recursive call, and not -- loop again. } else do let avail = w - r if (count == avail) then do memcpy_ptr_baoff ptr raw r (fromIntegral count) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return (so_far + count) else do if (count < avail) then do memcpy_ptr_baoff ptr raw r (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return (so_far + count) else do memcpy_ptr_baoff ptr raw r (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } let remaining = count - avail so_far' = so_far + avail ptr' = ptr `plusPtr` avail -- we haven't attempted to read anything yet if we get to here. if remaining < sz then bufReadNonBlocking fd ref is_stream ptr' so_far' remaining else do rest <- readChunkNonBlocking fd is_stream ptr' remaining return (so_far' + rest) readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int readChunkNonBlocking fd is_stream ptr bytes = do #ifndef mingw32_HOST_OS ssize <- c_read (fromIntegral fd) (castPtr ptr) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1) then do errno <- getErrno if (errno == eAGAIN || errno == eWOULDBLOCK) then return 0 else throwErrno "readChunk" else return r #else (ssize, rc) <- asyncRead fd (fromIntegral $ fromEnum is_stream) (fromIntegral bytes) ptr let r = fromIntegral ssize :: Int if r == (-1) then ioError (errnoToIOError "hGetBufNonBlocking" (Errno (fromIntegral rc)) Nothing Nothing) else return r #endif slurpFile :: FilePath -> IO (Ptr (), Int) slurpFile fname = do handle <- openFile fname ReadMode sz <- hFileSize handle if sz > fromIntegral (maxBound::Int) then ioError (userError "slurpFile: file too big") else do let sz_i = fromIntegral sz if sz_i == 0 then return (nullPtr, 0) else do chunk <- mallocBytes sz_i r <- hGetBuf handle chunk sz_i hClose handle return (chunk, r) -- --------------------------------------------------------------------------- -- memcpy wrappers foreign import ccall unsafe "__hscore_memcpy_src_off" memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_src_off" memcpy_ptr_baoff :: Ptr a -> RawBuffer -> Int -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_dst_off" memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_dst_off" memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ()) ----------------------------------------------------------------------------- -- Internal Utils illegalBufferSize :: Handle -> String -> Int -> IO a illegalBufferSize handle fn (sz :: Int) = ioException (IOError (Just handle) InvalidArgument fn ("illegal buffer size " ++ showsPrec 9 sz []) Nothing) hugs98-plus-Sep2006/packages/base/GHC/IOBase.lhs0000644006511100651110000010572610504340226017675 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.IOBase -- Copyright : (c) The University of Glasgow 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- Definitions for the 'IO' monad and its friends. -- ----------------------------------------------------------------------------- -- #hide module GHC.IOBase( IO(..), unIO, failIO, liftIO, bindIO, thenIO, returnIO, unsafePerformIO, unsafeInterleaveIO, -- To and from from ST stToIO, ioToST, unsafeIOToST, unsafeSTToIO, -- References IORef(..), newIORef, readIORef, writeIORef, IOArray(..), newIOArray, readIOArray, writeIOArray, unsafeReadIOArray, unsafeWriteIOArray, MVar(..), -- Handles, file descriptors, FilePath, Handle(..), Handle__(..), HandleType(..), IOMode(..), FD, isReadableHandleType, isWritableHandleType, isReadWriteHandleType, showHandle, -- Buffers Buffer(..), RawBuffer, BufferState(..), BufferList(..), BufferMode(..), bufferIsWritable, bufferEmpty, bufferFull, -- Exceptions Exception(..), ArithException(..), AsyncException(..), ArrayException(..), stackOverflow, heapOverflow, throw, throwIO, ioException, IOError, IOException(..), IOErrorType(..), ioError, userError, ExitCode(..) ) where import GHC.ST import GHC.Arr -- to derive Ix class import GHC.Enum -- to derive Enum class import GHC.STRef import GHC.Base -- import GHC.Num -- To get fromInteger etc, needed because of -fno-implicit-prelude import Data.Maybe ( Maybe(..) ) import GHC.Show import GHC.List import GHC.Read #ifndef __HADDOCK__ import {-# SOURCE #-} GHC.Dynamic #endif -- --------------------------------------------------------------------------- -- The IO Monad {- The IO Monad is just an instance of the ST monad, where the state is the real world. We use the exception mechanism (in GHC.Exception) to implement IO exceptions. NOTE: The IO representation is deeply wired in to various parts of the system. The following list may or may not be exhaustive: Compiler - types of various primitives in PrimOp.lhs RTS - forceIO (StgMiscClosures.hc) - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast (Exceptions.hc) - raiseAsync (Schedule.c) Prelude - GHC.IOBase.lhs, and several other places including GHC.Exception.lhs. Libraries - parts of hslibs/lang. --SDM -} {-| A value of type @'IO' a@ is a computation which, when performed, does some I\/O before returning a value of type @a@. There is really only one way to \"perform\" an I\/O action: bind it to @Main.main@ in your program. When your program is run, the I\/O will be performed. It isn't possible to perform I\/O from an arbitrary function, unless that function is itself in the 'IO' monad and called at some point, directly or indirectly, from @Main.main@. 'IO' is a monad, so 'IO' actions can be combined using either the do-notation or the '>>' and '>>=' operations from the 'Monad' class. -} newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #)) unIO (IO a) = a instance Functor IO where fmap f x = x >>= (return . f) instance Monad IO where {-# INLINE return #-} {-# INLINE (>>) #-} {-# INLINE (>>=) #-} m >> k = m >>= \ _ -> k return x = returnIO x m >>= k = bindIO m k fail s = failIO s failIO :: String -> IO a failIO s = ioError (userError s) liftIO :: IO a -> State# RealWorld -> STret RealWorld a liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r bindIO :: IO a -> (a -> IO b) -> IO b bindIO (IO m) k = IO ( \ s -> case m s of (# new_s, a #) -> unIO (k a) new_s ) thenIO :: IO a -> IO b -> IO b thenIO (IO m) k = IO ( \ s -> case m s of (# new_s, a #) -> unIO k new_s ) returnIO :: a -> IO a returnIO x = IO (\ s -> (# s, x #)) -- --------------------------------------------------------------------------- -- Coercions between IO and ST -- | A monad transformer embedding strict state transformers in the 'IO' -- monad. The 'RealWorld' parameter indicates that the internal state -- used by the 'ST' computation is a special one supplied by the 'IO' -- monad, and thus distinct from those used by invocations of 'runST'. stToIO :: ST RealWorld a -> IO a stToIO (ST m) = IO m ioToST :: IO a -> ST RealWorld a ioToST (IO m) = (ST m) -- This relies on IO and ST having the same representation modulo the -- constraint on the type of the state -- unsafeIOToST :: IO a -> ST s a unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s unsafeSTToIO :: ST s a -> IO a unsafeSTToIO (ST m) = IO (unsafeCoerce# m) -- --------------------------------------------------------------------------- -- Unsafe IO operations {-| This is the \"back door\" into the 'IO' monad, allowing 'IO' computation to be performed at any time. For this to be safe, the 'IO' computation should be free of side effects and independent of its environment. If the I\/O computation wrapped in 'unsafePerformIO' performs side effects, then the relative order in which those side effects take place (relative to the main I\/O trunk, or other calls to 'unsafePerformIO') is indeterminate. You have to be careful when writing and compiling modules that use 'unsafePerformIO': * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@ that calls 'unsafePerformIO'. If the call is inlined, the I\/O may be performed more than once. * Use the compiler flag @-fno-cse@ to prevent common sub-expression elimination being performed on the module, which might combine two side effects that were meant to be separate. A good example is using multiple global variables (like @test@ in the example below). * Make sure that the either you switch off let-floating, or that the call to 'unsafePerformIO' cannot float outside a lambda. For example, if you say: @ f x = unsafePerformIO (newIORef []) @ you may get only one reference cell shared between all calls to @f@. Better would be @ f x = unsafePerformIO (newIORef [x]) @ because now it can't float outside the lambda. It is less well known that 'unsafePerformIO' is not type safe. For example: > test :: IORef [a] > test = unsafePerformIO $ newIORef [] > > main = do > writeIORef test [42] > bang <- readIORef test > print (bang :: [Char]) This program will core dump. This problem with polymorphic references is well known in the ML community, and does not arise with normal monadic use of references. There is no easy way to make it impossible once you use 'unsafePerformIO'. Indeed, it is possible to write @coerce :: a -> b@ with the help of 'unsafePerformIO'. So be careful! -} {-# NOINLINE unsafePerformIO #-} unsafePerformIO :: IO a -> a unsafePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r) -- Why do we NOINLINE unsafePerformIO? See the comment with -- GHC.ST.runST. Essentially the issue is that the IO computation -- inside unsafePerformIO must be atomic: it must either all run, or -- not at all. If we let the compiler see the application of the IO -- to realWorld#, it might float out part of the IO. -- Why is there a call to 'lazy' in unsafePerformIO? -- If we don't have it, the demand analyser discovers the following strictness -- for unsafePerformIO: C(U(AV)) -- But then consider -- unsafePerformIO (\s -> let r = f x in -- case writeIORef v r s of (# s1, _ #) -> -- (# s1, r #) -- The strictness analyser will find that the binding for r is strict, -- (becuase of uPIO's strictness sig), and so it'll evaluate it before -- doing the writeIORef. This actually makes tests/lib/should_run/memo002 -- get a deadlock! -- -- Solution: don't expose the strictness of unsafePerformIO, -- by hiding it with 'lazy' {-| 'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily. When passed a value of type @IO a@, the 'IO' will only be performed when the value of the @a@ is demanded. This is used to implement lazy file reading, see 'System.IO.hGetContents'. -} {-# INLINE unsafeInterleaveIO #-} unsafeInterleaveIO :: IO a -> IO a unsafeInterleaveIO (IO m) = IO ( \ s -> let r = case m s of (# _, res #) -> res in (# s, r #)) -- We believe that INLINE on unsafeInterleaveIO is safe, because the -- state from this IO thread is passed explicitly to the interleaved -- IO, so it cannot be floated out and shared. -- --------------------------------------------------------------------------- -- Handle type data MVar a = MVar (MVar# RealWorld a) {- ^ An 'MVar' (pronounced \"em-var\") is a synchronising variable, used for communication between concurrent threads. It can be thought of as a a box, which may be empty or full. -} -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module instance Eq (MVar a) where (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2# -- A Handle is represented by (a reference to) a record -- containing the state of the I/O port/device. We record -- the following pieces of info: -- * type (read,write,closed etc.) -- * the underlying file descriptor -- * buffering mode -- * buffer, and spare buffers -- * user-friendly name (usually the -- FilePath used when IO.openFile was called) -- Note: when a Handle is garbage collected, we want to flush its buffer -- and close the OS file handle, so as to free up a (precious) resource. -- | Haskell defines operations to read and write characters from and to files, -- represented by values of type @Handle@. Each value of this type is a -- /handle/: a record used by the Haskell run-time system to /manage/ I\/O -- with file system objects. A handle has at least the following properties: -- -- * whether it manages input or output or both; -- -- * whether it is /open/, /closed/ or /semi-closed/; -- -- * whether the object is seekable; -- -- * whether buffering is disabled, or enabled on a line or block basis; -- -- * a buffer (whose length may be zero). -- -- Most handles will also have a current I\/O position indicating where the next -- input or output operation will occur. A handle is /readable/ if it -- manages only input or both input and output; likewise, it is /writable/ if -- it manages only output or both input and output. A handle is /open/ when -- first allocated. -- Once it is closed it can no longer be used for either input or output, -- though an implementation cannot re-use its storage while references -- remain to it. Handles are in the 'Show' and 'Eq' classes. The string -- produced by showing a handle is system dependent; it should include -- enough information to identify the handle for debugging. A handle is -- equal according to '==' only to itself; no attempt -- is made to compare the internal state of different handles for equality. -- -- GHC note: a 'Handle' will be automatically closed when the garbage -- collector detects that it has become unreferenced by the program. -- However, relying on this behaviour is not generally recommended: -- the garbage collector is unpredictable. If possible, use explicit -- an explicit 'hClose' to close 'Handle's when they are no longer -- required. GHC does not currently attempt to free up file -- descriptors when they have run out, it is your responsibility to -- ensure that this doesn't happen. data Handle = FileHandle -- A normal handle to a file FilePath -- the file (invariant) !(MVar Handle__) | DuplexHandle -- A handle to a read/write stream FilePath -- file for a FIFO, otherwise some -- descriptive string. !(MVar Handle__) -- The read side !(MVar Handle__) -- The write side -- NOTES: -- * A 'FileHandle' is seekable. A 'DuplexHandle' may or may not be -- seekable. instance Eq Handle where (FileHandle _ h1) == (FileHandle _ h2) = h1 == h2 (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2 _ == _ = False type FD = Int -- XXX ToDo: should be CInt data Handle__ = Handle__ { haFD :: !FD, -- file descriptor haType :: HandleType, -- type (read/write/append etc.) haIsBin :: Bool, -- binary mode? haIsStream :: Bool, -- is this a stream handle? haBufferMode :: BufferMode, -- buffer contains read/write data? haBuffer :: !(IORef Buffer), -- the current buffer haBuffers :: !(IORef BufferList), -- spare buffers haOtherSide :: Maybe (MVar Handle__) -- ptr to the write side of a -- duplex handle. } -- --------------------------------------------------------------------------- -- Buffers -- The buffer is represented by a mutable variable containing a -- record, where the record contains the raw buffer and the start/end -- points of the filled portion. We use a mutable variable so that -- the common operation of writing (or reading) some data from (to) -- the buffer doesn't need to modify, and hence copy, the handle -- itself, it just updates the buffer. -- There will be some allocation involved in a simple hPutChar in -- order to create the new Buffer structure (below), but this is -- relatively small, and this only has to be done once per write -- operation. -- The buffer contains its size - we could also get the size by -- calling sizeOfMutableByteArray# on the raw buffer, but that tends -- to be rounded up to the nearest Word. type RawBuffer = MutableByteArray# RealWorld -- INVARIANTS on a Buffer: -- -- * A handle *always* has a buffer, even if it is only 1 character long -- (an unbuffered handle needs a 1 character buffer in order to support -- hLookAhead and hIsEOF). -- * r <= w -- * if r == w, then r == 0 && w == 0 -- * if state == WriteBuffer, then r == 0 -- * a write buffer is never full. If an operation -- fills up the buffer, it will always flush it before -- returning. -- * a read buffer may be full as a result of hLookAhead. In normal -- operation, a read buffer always has at least one character of space. data Buffer = Buffer { bufBuf :: RawBuffer, bufRPtr :: !Int, bufWPtr :: !Int, bufSize :: !Int, bufState :: BufferState } data BufferState = ReadBuffer | WriteBuffer deriving (Eq) -- we keep a few spare buffers around in a handle to avoid allocating -- a new one for each hPutStr. These buffers are *guaranteed* to be the -- same size as the main buffer. data BufferList = BufferListNil | BufferListCons RawBuffer BufferList bufferIsWritable :: Buffer -> Bool bufferIsWritable Buffer{ bufState=WriteBuffer } = True bufferIsWritable _other = False bufferEmpty :: Buffer -> Bool bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w -- only makes sense for a write buffer bufferFull :: Buffer -> Bool bufferFull b@Buffer{ bufWPtr=w } = w >= bufSize b -- Internally, we classify handles as being one -- of the following: data HandleType = ClosedHandle | SemiClosedHandle | ReadHandle | WriteHandle | AppendHandle | ReadWriteHandle isReadableHandleType ReadHandle = True isReadableHandleType ReadWriteHandle = True isReadableHandleType _ = False isWritableHandleType AppendHandle = True isWritableHandleType WriteHandle = True isWritableHandleType ReadWriteHandle = True isWritableHandleType _ = False isReadWriteHandleType ReadWriteHandle{} = True isReadWriteHandleType _ = False -- | File and directory names are values of type 'String', whose precise -- meaning is operating system dependent. Files can be opened, yielding a -- handle which can then be used to operate on the contents of that file. type FilePath = String -- --------------------------------------------------------------------------- -- Buffering modes -- | Three kinds of buffering are supported: line-buffering, -- block-buffering or no-buffering. These modes have the following -- effects. For output, items are written out, or /flushed/, -- from the internal buffer according to the buffer mode: -- -- * /line-buffering/: the entire output buffer is flushed -- whenever a newline is output, the buffer overflows, -- a 'System.IO.hFlush' is issued, or the handle is closed. -- -- * /block-buffering/: the entire buffer is written out whenever it -- overflows, a 'System.IO.hFlush' is issued, or the handle is closed. -- -- * /no-buffering/: output is written immediately, and never stored -- in the buffer. -- -- An implementation is free to flush the buffer more frequently, -- but not less frequently, than specified above. -- The output buffer is emptied as soon as it has been written out. -- -- Similarly, input occurs according to the buffer mode for the handle: -- -- * /line-buffering/: when the buffer for the handle is not empty, -- the next item is obtained from the buffer; otherwise, when the -- buffer is empty, characters up to and including the next newline -- character are read into the buffer. No characters are available -- until the newline character is available or the buffer is full. -- -- * /block-buffering/: when the buffer for the handle becomes empty, -- the next block of data is read into the buffer. -- -- * /no-buffering/: the next input item is read and returned. -- The 'System.IO.hLookAhead' operation implies that even a no-buffered -- handle may require a one-character buffer. -- -- The default buffering mode when a handle is opened is -- implementation-dependent and may depend on the file system object -- which is attached to that handle. -- For most implementations, physical files will normally be block-buffered -- and terminals will normally be line-buffered. data BufferMode = NoBuffering -- ^ buffering is disabled if possible. | LineBuffering -- ^ line-buffering should be enabled if possible. | BlockBuffering (Maybe Int) -- ^ block-buffering should be enabled if possible. -- The size of the buffer is @n@ items if the argument -- is 'Just' @n@ and is otherwise implementation-dependent. deriving (Eq, Ord, Read, Show) -- --------------------------------------------------------------------------- -- IORefs -- |A mutable variable in the 'IO' monad newtype IORef a = IORef (STRef RealWorld a) -- explicit instance because Haddock can't figure out a derived one instance Eq (IORef a) where IORef x == IORef y = x == y -- |Build a new 'IORef' newIORef :: a -> IO (IORef a) newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var) -- |Read the value of an 'IORef' readIORef :: IORef a -> IO a readIORef (IORef var) = stToIO (readSTRef var) -- |Write a new value into an 'IORef' writeIORef :: IORef a -> a -> IO () writeIORef (IORef var) v = stToIO (writeSTRef var v) -- --------------------------------------------------------------------------- -- | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad. -- The type arguments are as follows: -- -- * @i@: the index type of the array (should be an instance of 'Ix') -- -- * @e@: the element type of the array. -- -- newtype IOArray i e = IOArray (STArray RealWorld i e) -- explicit instance because Haddock can't figure out a derived one instance Eq (IOArray i e) where IOArray x == IOArray y = x == y -- |Build a new 'IOArray' newIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e) {-# INLINE newIOArray #-} newIOArray lu init = stToIO $ do {marr <- newSTArray lu init; return (IOArray marr)} -- | Read a value from an 'IOArray' unsafeReadIOArray :: Ix i => IOArray i e -> Int -> IO e {-# INLINE unsafeReadIOArray #-} unsafeReadIOArray (IOArray marr) i = stToIO (unsafeReadSTArray marr i) -- | Write a new value into an 'IOArray' unsafeWriteIOArray :: Ix i => IOArray i e -> Int -> e -> IO () {-# INLINE unsafeWriteIOArray #-} unsafeWriteIOArray (IOArray marr) i e = stToIO (unsafeWriteSTArray marr i e) -- | Read a value from an 'IOArray' readIOArray :: Ix i => IOArray i e -> i -> IO e readIOArray (IOArray marr) i = stToIO (readSTArray marr i) -- | Write a new value into an 'IOArray' writeIOArray :: Ix i => IOArray i e -> i -> e -> IO () writeIOArray (IOArray marr) i e = stToIO (writeSTArray marr i e) -- --------------------------------------------------------------------------- -- Show instance for Handles -- handle types are 'show'n when printing error msgs, so -- we provide a more user-friendly Show instance for it -- than the derived one. instance Show HandleType where showsPrec p t = case t of ClosedHandle -> showString "closed" SemiClosedHandle -> showString "semi-closed" ReadHandle -> showString "readable" WriteHandle -> showString "writable" AppendHandle -> showString "writable (append)" ReadWriteHandle -> showString "read-writable" instance Show Handle where showsPrec p (FileHandle file _) = showHandle file showsPrec p (DuplexHandle file _ _) = showHandle file showHandle file = showString "{handle: " . showString file . showString "}" -- ------------------------------------------------------------------------ -- Exception datatype and operations -- |The type of exceptions. Every kind of system-generated exception -- has a constructor in the 'Exception' type, and values of other -- types may be injected into 'Exception' by coercing them to -- 'Data.Dynamic.Dynamic' (see the section on Dynamic Exceptions: -- "Control.Exception\#DynamicExceptions"). data Exception = ArithException ArithException -- ^Exceptions raised by arithmetic -- operations. (NOTE: GHC currently does not throw -- 'ArithException's except for 'DivideByZero'). | ArrayException ArrayException -- ^Exceptions raised by array-related -- operations. (NOTE: GHC currently does not throw -- 'ArrayException's). | AssertionFailed String -- ^This exception is thrown by the -- 'assert' operation when the condition -- fails. The 'String' argument contains the -- location of the assertion in the source program. | AsyncException AsyncException -- ^Asynchronous exceptions (see section on Asynchronous Exceptions: "Control.Exception\#AsynchronousExceptions"). | BlockedOnDeadMVar -- ^The current thread was executing a call to -- 'Control.Concurrent.MVar.takeMVar' that could never return, -- because there are no other references to this 'MVar'. | BlockedIndefinitely -- ^The current thread was waiting to retry an atomic memory transaction -- that could never become possible to complete because there are no other -- threads referring to any of teh TVars involved. | NestedAtomically -- ^The runtime detected an attempt to nest one STM transaction -- inside another one, presumably due to the use of -- 'unsafePeformIO' with 'atomically'. | Deadlock -- ^There are no runnable threads, so the program is -- deadlocked. The 'Deadlock' exception is -- raised in the main thread only (see also: "Control.Concurrent"). | DynException Dynamic -- ^Dynamically typed exceptions (see section on Dynamic Exceptions: "Control.Exception\#DynamicExceptions"). | ErrorCall String -- ^The 'ErrorCall' exception is thrown by 'error'. The 'String' -- argument of 'ErrorCall' is the string passed to 'error' when it was -- called. | ExitException ExitCode -- ^The 'ExitException' exception is thrown by 'System.Exit.exitWith' (and -- 'System.Exit.exitFailure'). The 'ExitCode' argument is the value passed -- to 'System.Exit.exitWith'. An unhandled 'ExitException' exception in the -- main thread will cause the program to be terminated with the given -- exit code. | IOException IOException -- ^These are the standard IO exceptions generated by -- Haskell\'s @IO@ operations. See also "System.IO.Error". | NoMethodError String -- ^An attempt was made to invoke a class method which has -- no definition in this instance, and there was no default -- definition given in the class declaration. GHC issues a -- warning when you compile an instance which has missing -- methods. | NonTermination -- ^The current thread is stuck in an infinite loop. This -- exception may or may not be thrown when the program is -- non-terminating. | PatternMatchFail String -- ^A pattern matching failure. The 'String' argument should contain a -- descriptive message including the function name, source file -- and line number. | RecConError String -- ^An attempt was made to evaluate a field of a record -- for which no value was given at construction time. The -- 'String' argument gives the location of the -- record construction in the source program. | RecSelError String -- ^A field selection was attempted on a constructor that -- doesn\'t have the requested field. This can happen with -- multi-constructor records when one or more fields are -- missing from some of the constructors. The -- 'String' argument gives the location of the -- record selection in the source program. | RecUpdError String -- ^An attempt was made to update a field in a record, -- where the record doesn\'t have the requested field. This can -- only occur with multi-constructor records, when one or more -- fields are missing from some of the constructors. The -- 'String' argument gives the location of the -- record update in the source program. -- |The type of arithmetic exceptions data ArithException = Overflow | Underflow | LossOfPrecision | DivideByZero | Denormal deriving (Eq, Ord) -- |Asynchronous exceptions data AsyncException = StackOverflow -- ^The current thread\'s stack exceeded its limit. -- Since an exception has been raised, the thread\'s stack -- will certainly be below its limit again, but the -- programmer should take remedial action -- immediately. | HeapOverflow -- ^The program\'s heap is reaching its limit, and -- the program should take action to reduce the amount of -- live data it has. Notes: -- -- * It is undefined which thread receives this exception. -- -- * GHC currently does not throw 'HeapOverflow' exceptions. | ThreadKilled -- ^This exception is raised by another thread -- calling 'Control.Concurrent.killThread', or by the system -- if it needs to terminate the thread for some -- reason. deriving (Eq, Ord) -- | Exceptions generated by array operations data ArrayException = IndexOutOfBounds String -- ^An attempt was made to index an array outside -- its declared bounds. | UndefinedElement String -- ^An attempt was made to evaluate an element of an -- array that had not been initialized. deriving (Eq, Ord) stackOverflow, heapOverflow :: Exception -- for the RTS stackOverflow = AsyncException StackOverflow heapOverflow = AsyncException HeapOverflow instance Show ArithException where showsPrec _ Overflow = showString "arithmetic overflow" showsPrec _ Underflow = showString "arithmetic underflow" showsPrec _ LossOfPrecision = showString "loss of precision" showsPrec _ DivideByZero = showString "divide by zero" showsPrec _ Denormal = showString "denormal" instance Show AsyncException where showsPrec _ StackOverflow = showString "stack overflow" showsPrec _ HeapOverflow = showString "heap overflow" showsPrec _ ThreadKilled = showString "thread killed" instance Show ArrayException where showsPrec _ (IndexOutOfBounds s) = showString "array index out of range" . (if not (null s) then showString ": " . showString s else id) showsPrec _ (UndefinedElement s) = showString "undefined array element" . (if not (null s) then showString ": " . showString s else id) instance Show Exception where showsPrec _ (IOException err) = shows err showsPrec _ (ArithException err) = shows err showsPrec _ (ArrayException err) = shows err showsPrec _ (ErrorCall err) = showString err showsPrec _ (ExitException err) = showString "exit: " . shows err showsPrec _ (NoMethodError err) = showString err showsPrec _ (PatternMatchFail err) = showString err showsPrec _ (RecSelError err) = showString err showsPrec _ (RecConError err) = showString err showsPrec _ (RecUpdError err) = showString err showsPrec _ (AssertionFailed err) = showString err showsPrec _ (DynException err) = showString "exception :: " . showsTypeRep (dynTypeRep err) showsPrec _ (AsyncException e) = shows e showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely" showsPrec _ (BlockedIndefinitely) = showString "thread blocked indefinitely" showsPrec _ (NestedAtomically) = showString "Control.Concurrent.STM.atomically was nested" showsPrec _ (NonTermination) = showString "<>" showsPrec _ (Deadlock) = showString "<>" instance Eq Exception where IOException e1 == IOException e2 = e1 == e2 ArithException e1 == ArithException e2 = e1 == e2 ArrayException e1 == ArrayException e2 = e1 == e2 ErrorCall e1 == ErrorCall e2 = e1 == e2 ExitException e1 == ExitException e2 = e1 == e2 NoMethodError e1 == NoMethodError e2 = e1 == e2 PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2 RecSelError e1 == RecSelError e2 = e1 == e2 RecConError e1 == RecConError e2 = e1 == e2 RecUpdError e1 == RecUpdError e2 = e1 == e2 AssertionFailed e1 == AssertionFailed e2 = e1 == e2 DynException _ == DynException _ = False -- incomparable AsyncException e1 == AsyncException e2 = e1 == e2 BlockedOnDeadMVar == BlockedOnDeadMVar = True NonTermination == NonTermination = True NestedAtomically == NestedAtomically = True Deadlock == Deadlock = True _ == _ = False -- ----------------------------------------------------------------------------- -- The ExitCode type -- We need it here because it is used in ExitException in the -- Exception datatype (above). data ExitCode = ExitSuccess -- ^ indicates successful termination; | ExitFailure Int -- ^ indicates program failure with an exit code. -- The exact interpretation of the code is -- operating-system dependent. In particular, some values -- may be prohibited (e.g. 0 on a POSIX-compliant system). deriving (Eq, Ord, Read, Show) -- -------------------------------------------------------------------------- -- Primitive throw -- | Throw an exception. Exceptions may be thrown from purely -- functional code, but may only be caught within the 'IO' monad. throw :: Exception -> a throw exception = raise# exception -- | A variant of 'throw' that can be used within the 'IO' monad. -- -- Although 'throwIO' has a type that is an instance of the type of 'throw', the -- two functions are subtly different: -- -- > throw e `seq` x ===> throw e -- > throwIO e `seq` x ===> x -- -- The first example will cause the exception @e@ to be raised, -- whereas the second one won\'t. In fact, 'throwIO' will only cause -- an exception to be raised when it is used within the 'IO' monad. -- The 'throwIO' variant should be used in preference to 'throw' to -- raise an exception within the 'IO' monad because it guarantees -- ordering with respect to other 'IO' operations, whereas 'throw' -- does not. throwIO :: Exception -> IO a throwIO err = IO $ raiseIO# err ioException :: IOException -> IO a ioException err = IO $ raiseIO# (IOException err) -- | Raise an 'IOError' in the 'IO' monad. ioError :: IOError -> IO a ioError = ioException -- --------------------------------------------------------------------------- -- IOError type -- | The Haskell 98 type for exceptions in the 'IO' monad. -- Any I\/O operation may raise an 'IOError' instead of returning a result. -- For a more general type of exception, including also those that arise -- in pure code, see 'Control.Exception.Exception'. -- -- In Haskell 98, this is an opaque type. type IOError = IOException -- |Exceptions that occur in the @IO@ monad. -- An @IOException@ records a more specific error type, a descriptive -- string and maybe the handle that was used when the error was -- flagged. data IOException = IOError { ioe_handle :: Maybe Handle, -- the handle used by the action flagging -- the error. ioe_type :: IOErrorType, -- what it was. ioe_location :: String, -- location. ioe_description :: String, -- error type specific information. ioe_filename :: Maybe FilePath -- filename the error is related to. } instance Eq IOException where (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) = e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2 -- | An abstract type that contains a value for each variant of 'IOError'. data IOErrorType -- Haskell 98: = AlreadyExists | NoSuchThing | ResourceBusy | ResourceExhausted | EOF | IllegalOperation | PermissionDenied | UserError -- GHC only: | UnsatisfiedConstraints | SystemError | ProtocolError | OtherError | InvalidArgument | InappropriateType | HardwareFault | UnsupportedOperation | TimeExpired | ResourceVanished | Interrupted | DynIOError Dynamic -- cheap&cheerful extensible IO error type. instance Eq IOErrorType where x == y = case x of DynIOError{} -> False -- from a strictness POV, compatible with a derived Eq inst? _ -> getTag x ==# getTag y instance Show IOErrorType where showsPrec _ e = showString $ case e of AlreadyExists -> "already exists" NoSuchThing -> "does not exist" ResourceBusy -> "resource busy" ResourceExhausted -> "resource exhausted" EOF -> "end of file" IllegalOperation -> "illegal operation" PermissionDenied -> "permission denied" UserError -> "user error" HardwareFault -> "hardware fault" InappropriateType -> "inappropriate type" Interrupted -> "interrupted" InvalidArgument -> "invalid argument" OtherError -> "failed" ProtocolError -> "protocol error" ResourceVanished -> "resource vanished" SystemError -> "system error" TimeExpired -> "timeout" UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise! UnsupportedOperation -> "unsupported operation" DynIOError{} -> "unknown IO error" -- | Construct an 'IOError' value with a string describing the error. -- The 'fail' method of the 'IO' instance of the 'Monad' class raises a -- 'userError', thus: -- -- > instance Monad IO where -- > ... -- > fail s = ioError (userError s) -- userError :: String -> IOError userError str = IOError Nothing UserError "" str Nothing -- --------------------------------------------------------------------------- -- Showing IOErrors instance Show IOException where showsPrec p (IOError hdl iot loc s fn) = (case fn of Nothing -> case hdl of Nothing -> id Just h -> showsPrec p h . showString ": " Just name -> showString name . showString ": ") . (case loc of "" -> id _ -> showString loc . showString ": ") . showsPrec p iot . (case s of "" -> id _ -> showString " (" . showString s . showString ")") -- ----------------------------------------------------------------------------- -- IOMode type data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode deriving (Eq, Ord, Ix, Enum, Read, Show) \end{code} hugs98-plus-Sep2006/packages/base/GHC/Int.hs0000644006511100651110000010202310504340224017132 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Int -- Copyright : (c) The University of Glasgow 1997-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The sized integral datatypes, 'Int8', 'Int16', 'Int32', and 'Int64'. -- ----------------------------------------------------------------------------- #include "MachDeps.h" -- #hide module GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..)) where import Data.Bits import {-# SOURCE #-} GHC.Err import GHC.Base import GHC.Enum import GHC.Num import GHC.Real import GHC.Read import GHC.Arr import GHC.Word import GHC.Show ------------------------------------------------------------------------ -- type Int8 ------------------------------------------------------------------------ -- Int8 is represented in the same way as Int. Operations may assume -- and must ensure that it holds only values from its logical range. data Int8 = I8# Int# deriving (Eq, Ord) -- ^ 8-bit signed integer type instance Show Int8 where showsPrec p x = showsPrec p (fromIntegral x :: Int) instance Num Int8 where (I8# x#) + (I8# y#) = I8# (narrow8Int# (x# +# y#)) (I8# x#) - (I8# y#) = I8# (narrow8Int# (x# -# y#)) (I8# x#) * (I8# y#) = I8# (narrow8Int# (x# *# y#)) negate (I8# x#) = I8# (narrow8Int# (negateInt# x#)) abs x | x >= 0 = x | otherwise = negate x signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 fromInteger (S# i#) = I8# (narrow8Int# i#) fromInteger (J# s# d#) = I8# (narrow8Int# (integer2Int# s# d#)) instance Real Int8 where toRational x = toInteger x % 1 instance Enum Int8 where succ x | x /= maxBound = x + 1 | otherwise = succError "Int8" pred x | x /= minBound = x - 1 | otherwise = predError "Int8" toEnum i@(I# i#) | i >= fromIntegral (minBound::Int8) && i <= fromIntegral (maxBound::Int8) = I8# i# | otherwise = toEnumError "Int8" i (minBound::Int8, maxBound::Int8) fromEnum (I8# x#) = I# x# enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Integral Int8 where quot x@(I8# x#) y@(I8# y#) | y /= 0 = I8# (narrow8Int# (x# `quotInt#` y#)) | otherwise = divZeroError rem x@(I8# x#) y@(I8# y#) | y /= 0 = I8# (narrow8Int# (x# `remInt#` y#)) | otherwise = divZeroError div x@(I8# x#) y@(I8# y#) | y /= 0 = I8# (narrow8Int# (x# `divInt#` y#)) | otherwise = divZeroError mod x@(I8# x#) y@(I8# y#) | y /= 0 = I8# (narrow8Int# (x# `modInt#` y#)) | otherwise = divZeroError quotRem x@(I8# x#) y@(I8# y#) | y /= 0 = (I8# (narrow8Int# (x# `quotInt#` y#)), I8# (narrow8Int# (x# `remInt#` y#))) | otherwise = divZeroError divMod x@(I8# x#) y@(I8# y#) | y /= 0 = (I8# (narrow8Int# (x# `divInt#` y#)), I8# (narrow8Int# (x# `modInt#` y#))) | otherwise = divZeroError toInteger (I8# x#) = S# x# instance Bounded Int8 where minBound = -0x80 maxBound = 0x7F instance Ix Int8 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral i - fromIntegral m inRange (m,n) i = m <= i && i <= n instance Read Int8 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] instance Bits Int8 where (I8# x#) .&. (I8# y#) = I8# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I8# x#) .|. (I8# y#) = I8# (word2Int# (int2Word# x# `or#` int2Word# y#)) (I8# x#) `xor` (I8# y#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# y#)) complement (I8# x#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# (-1#))) (I8# x#) `shift` (I# i#) | i# >=# 0# = I8# (narrow8Int# (x# `iShiftL#` i#)) | otherwise = I8# (x# `iShiftRA#` negateInt# i#) (I8# x#) `rotate` (I# i#) | i'# ==# 0# = I8# x# | otherwise = I8# (narrow8Int# (word2Int# ((x'# `shiftL#` i'#) `or#` (x'# `shiftRL#` (8# -# i'#))))) where x'# = narrow8Word# (int2Word# x#) i'# = word2Int# (int2Word# i# `and#` int2Word# 7#) bitSize _ = 8 isSigned _ = True {-# RULES "fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8 "fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#) "fromIntegral/Int8->a" fromIntegral = \(I8# x#) -> fromIntegral (I# x#) #-} ------------------------------------------------------------------------ -- type Int16 ------------------------------------------------------------------------ -- Int16 is represented in the same way as Int. Operations may assume -- and must ensure that it holds only values from its logical range. data Int16 = I16# Int# deriving (Eq, Ord) -- ^ 16-bit signed integer type instance Show Int16 where showsPrec p x = showsPrec p (fromIntegral x :: Int) instance Num Int16 where (I16# x#) + (I16# y#) = I16# (narrow16Int# (x# +# y#)) (I16# x#) - (I16# y#) = I16# (narrow16Int# (x# -# y#)) (I16# x#) * (I16# y#) = I16# (narrow16Int# (x# *# y#)) negate (I16# x#) = I16# (narrow16Int# (negateInt# x#)) abs x | x >= 0 = x | otherwise = negate x signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 fromInteger (S# i#) = I16# (narrow16Int# i#) fromInteger (J# s# d#) = I16# (narrow16Int# (integer2Int# s# d#)) instance Real Int16 where toRational x = toInteger x % 1 instance Enum Int16 where succ x | x /= maxBound = x + 1 | otherwise = succError "Int16" pred x | x /= minBound = x - 1 | otherwise = predError "Int16" toEnum i@(I# i#) | i >= fromIntegral (minBound::Int16) && i <= fromIntegral (maxBound::Int16) = I16# i# | otherwise = toEnumError "Int16" i (minBound::Int16, maxBound::Int16) fromEnum (I16# x#) = I# x# enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Integral Int16 where quot x@(I16# x#) y@(I16# y#) | y /= 0 = I16# (narrow16Int# (x# `quotInt#` y#)) | otherwise = divZeroError rem x@(I16# x#) y@(I16# y#) | y /= 0 = I16# (narrow16Int# (x# `remInt#` y#)) | otherwise = divZeroError div x@(I16# x#) y@(I16# y#) | y /= 0 = I16# (narrow16Int# (x# `divInt#` y#)) | otherwise = divZeroError mod x@(I16# x#) y@(I16# y#) | y /= 0 = I16# (narrow16Int# (x# `modInt#` y#)) | otherwise = divZeroError quotRem x@(I16# x#) y@(I16# y#) | y /= 0 = (I16# (narrow16Int# (x# `quotInt#` y#)), I16# (narrow16Int# (x# `remInt#` y#))) | otherwise = divZeroError divMod x@(I16# x#) y@(I16# y#) | y /= 0 = (I16# (narrow16Int# (x# `divInt#` y#)), I16# (narrow16Int# (x# `modInt#` y#))) | otherwise = divZeroError toInteger (I16# x#) = S# x# instance Bounded Int16 where minBound = -0x8000 maxBound = 0x7FFF instance Ix Int16 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral i - fromIntegral m inRange (m,n) i = m <= i && i <= n instance Read Int16 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] instance Bits Int16 where (I16# x#) .&. (I16# y#) = I16# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I16# x#) .|. (I16# y#) = I16# (word2Int# (int2Word# x# `or#` int2Word# y#)) (I16# x#) `xor` (I16# y#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# y#)) complement (I16# x#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# (-1#))) (I16# x#) `shift` (I# i#) | i# >=# 0# = I16# (narrow16Int# (x# `iShiftL#` i#)) | otherwise = I16# (x# `iShiftRA#` negateInt# i#) (I16# x#) `rotate` (I# i#) | i'# ==# 0# = I16# x# | otherwise = I16# (narrow16Int# (word2Int# ((x'# `shiftL#` i'#) `or#` (x'# `shiftRL#` (16# -# i'#))))) where x'# = narrow16Word# (int2Word# x#) i'# = word2Int# (int2Word# i# `and#` int2Word# 15#) bitSize _ = 16 isSigned _ = True {-# RULES "fromIntegral/Word8->Int16" fromIntegral = \(W8# x#) -> I16# (word2Int# x#) "fromIntegral/Int8->Int16" fromIntegral = \(I8# x#) -> I16# x# "fromIntegral/Int16->Int16" fromIntegral = id :: Int16 -> Int16 "fromIntegral/a->Int16" fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (narrow16Int# x#) "fromIntegral/Int16->a" fromIntegral = \(I16# x#) -> fromIntegral (I# x#) #-} ------------------------------------------------------------------------ -- type Int32 ------------------------------------------------------------------------ #if WORD_SIZE_IN_BITS < 32 data Int32 = I32# Int32# -- ^ 32-bit signed integer type instance Eq Int32 where (I32# x#) == (I32# y#) = x# `eqInt32#` y# (I32# x#) /= (I32# y#) = x# `neInt32#` y# instance Ord Int32 where (I32# x#) < (I32# y#) = x# `ltInt32#` y# (I32# x#) <= (I32# y#) = x# `leInt32#` y# (I32# x#) > (I32# y#) = x# `gtInt32#` y# (I32# x#) >= (I32# y#) = x# `geInt32#` y# instance Show Int32 where showsPrec p x = showsPrec p (toInteger x) instance Num Int32 where (I32# x#) + (I32# y#) = I32# (x# `plusInt32#` y#) (I32# x#) - (I32# y#) = I32# (x# `minusInt32#` y#) (I32# x#) * (I32# y#) = I32# (x# `timesInt32#` y#) negate (I32# x#) = I32# (negateInt32# x#) abs x | x >= 0 = x | otherwise = negate x signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 fromInteger (S# i#) = I32# (intToInt32# i#) fromInteger (J# s# d#) = I32# (integerToInt32# s# d#) instance Enum Int32 where succ x | x /= maxBound = x + 1 | otherwise = succError "Int32" pred x | x /= minBound = x - 1 | otherwise = predError "Int32" toEnum (I# i#) = I32# (intToInt32# i#) fromEnum x@(I32# x#) | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = I# (int32ToInt# x#) | otherwise = fromEnumError "Int32" x enumFrom = integralEnumFrom enumFromThen = integralEnumFromThen enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo instance Integral Int32 where quot x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (x# `quotInt32#` y#) | otherwise = divZeroError rem x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (x# `remInt32#` y#) | otherwise = divZeroError div x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (x# `divInt32#` y#) | otherwise = divZeroError mod x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (x# `modInt32#` y#) | otherwise = divZeroError quotRem x@(I32# x#) y@(I32# y#) | y /= 0 = (I32# (x# `quotInt32#` y#), I32# (x# `remInt32#` y#)) | otherwise = divZeroError divMod x@(I32# x#) y@(I32# y#) | y /= 0 = (I32# (x# `divInt32#` y#), I32# (x# `modInt32#` y#)) | otherwise = divZeroError toInteger x@(I32# x#) | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = S# (int32ToInt# x#) | otherwise = case int32ToInteger# x# of (# s, d #) -> J# s d divInt32#, modInt32# :: Int32# -> Int32# -> Int32# x# `divInt32#` y# | (x# `gtInt32#` intToInt32# 0#) && (y# `ltInt32#` intToInt32# 0#) = ((x# `minusInt32#` y#) `minusInt32#` intToInt32# 1#) `quotInt32#` y# | (x# `ltInt32#` intToInt32# 0#) && (y# `gtInt32#` intToInt32# 0#) = ((x# `minusInt32#` y#) `plusInt32#` intToInt32# 1#) `quotInt32#` y# | otherwise = x# `quotInt32#` y# x# `modInt32#` y# | (x# `gtInt32#` intToInt32# 0#) && (y# `ltInt32#` intToInt32# 0#) || (x# `ltInt32#` intToInt32# 0#) && (y# `gtInt32#` intToInt32# 0#) = if r# `neInt32#` intToInt32# 0# then r# `plusInt32#` y# else intToInt32# 0# | otherwise = r# where r# = x# `remInt32#` y# instance Read Int32 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] instance Bits Int32 where (I32# x#) .&. (I32# y#) = I32# (word32ToInt32# (int32ToWord32# x# `and32#` int32ToWord32# y#)) (I32# x#) .|. (I32# y#) = I32# (word32ToInt32# (int32ToWord32# x# `or32#` int32ToWord32# y#)) (I32# x#) `xor` (I32# y#) = I32# (word32ToInt32# (int32ToWord32# x# `xor32#` int32ToWord32# y#)) complement (I32# x#) = I32# (word32ToInt32# (not32# (int32ToWord32# x#))) (I32# x#) `shift` (I# i#) | i# >=# 0# = I32# (x# `iShiftL32#` i#) | otherwise = I32# (x# `iShiftRA32#` negateInt# i#) (I32# x#) `rotate` (I# i#) | i'# ==# 0# = I32# x# | otherwise = I32# (word32ToInt32# ((x'# `shiftL32#` i'#) `or32#` (x'# `shiftRL32#` (32# -# i'#)))) where x'# = int32ToWord32# x# i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) bitSize _ = 32 isSigned _ = True foreign import "stg_eqInt32" unsafe eqInt32# :: Int32# -> Int32# -> Bool foreign import "stg_neInt32" unsafe neInt32# :: Int32# -> Int32# -> Bool foreign import "stg_ltInt32" unsafe ltInt32# :: Int32# -> Int32# -> Bool foreign import "stg_leInt32" unsafe leInt32# :: Int32# -> Int32# -> Bool foreign import "stg_gtInt32" unsafe gtInt32# :: Int32# -> Int32# -> Bool foreign import "stg_geInt32" unsafe geInt32# :: Int32# -> Int32# -> Bool foreign import "stg_plusInt32" unsafe plusInt32# :: Int32# -> Int32# -> Int32# foreign import "stg_minusInt32" unsafe minusInt32# :: Int32# -> Int32# -> Int32# foreign import "stg_timesInt32" unsafe timesInt32# :: Int32# -> Int32# -> Int32# foreign import "stg_negateInt32" unsafe negateInt32# :: Int32# -> Int32# foreign import "stg_quotInt32" unsafe quotInt32# :: Int32# -> Int32# -> Int32# foreign import "stg_remInt32" unsafe remInt32# :: Int32# -> Int32# -> Int32# foreign import "stg_intToInt32" unsafe intToInt32# :: Int# -> Int32# foreign import "stg_int32ToInt" unsafe int32ToInt# :: Int32# -> Int# foreign import "stg_wordToWord32" unsafe wordToWord32# :: Word# -> Word32# foreign import "stg_int32ToWord32" unsafe int32ToWord32# :: Int32# -> Word32# foreign import "stg_word32ToInt32" unsafe word32ToInt32# :: Word32# -> Int32# foreign import "stg_and32" unsafe and32# :: Word32# -> Word32# -> Word32# foreign import "stg_or32" unsafe or32# :: Word32# -> Word32# -> Word32# foreign import "stg_xor32" unsafe xor32# :: Word32# -> Word32# -> Word32# foreign import "stg_not32" unsafe not32# :: Word32# -> Word32# foreign import "stg_iShiftL32" unsafe iShiftL32# :: Int32# -> Int# -> Int32# foreign import "stg_iShiftRA32" unsafe iShiftRA32# :: Int32# -> Int# -> Int32# foreign import "stg_shiftL32" unsafe shiftL32# :: Word32# -> Int# -> Word32# foreign import "stg_shiftRL32" unsafe shiftRL32# :: Word32# -> Int# -> Word32# {-# RULES "fromIntegral/Int->Int32" fromIntegral = \(I# x#) -> I32# (intToInt32# x#) "fromIntegral/Word->Int32" fromIntegral = \(W# x#) -> I32# (word32ToInt32# (wordToWord32# x#)) "fromIntegral/Word32->Int32" fromIntegral = \(W32# x#) -> I32# (word32ToInt32# x#) "fromIntegral/Int32->Int" fromIntegral = \(I32# x#) -> I# (int32ToInt# x#) "fromIntegral/Int32->Word" fromIntegral = \(I32# x#) -> W# (int2Word# (int32ToInt# x#)) "fromIntegral/Int32->Word32" fromIntegral = \(I32# x#) -> W32# (int32ToWord32# x#) "fromIntegral/Int32->Int32" fromIntegral = id :: Int32 -> Int32 #-} #else -- Int32 is represented in the same way as Int. #if WORD_SIZE_IN_BITS > 32 -- Operations may assume and must ensure that it holds only values -- from its logical range. #endif data Int32 = I32# Int# deriving (Eq, Ord) -- ^ 32-bit signed integer type instance Show Int32 where showsPrec p x = showsPrec p (fromIntegral x :: Int) instance Num Int32 where (I32# x#) + (I32# y#) = I32# (narrow32Int# (x# +# y#)) (I32# x#) - (I32# y#) = I32# (narrow32Int# (x# -# y#)) (I32# x#) * (I32# y#) = I32# (narrow32Int# (x# *# y#)) negate (I32# x#) = I32# (narrow32Int# (negateInt# x#)) abs x | x >= 0 = x | otherwise = negate x signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 fromInteger (S# i#) = I32# (narrow32Int# i#) fromInteger (J# s# d#) = I32# (narrow32Int# (integer2Int# s# d#)) instance Enum Int32 where succ x | x /= maxBound = x + 1 | otherwise = succError "Int32" pred x | x /= minBound = x - 1 | otherwise = predError "Int32" #if WORD_SIZE_IN_BITS == 32 toEnum (I# i#) = I32# i# #else toEnum i@(I# i#) | i >= fromIntegral (minBound::Int32) && i <= fromIntegral (maxBound::Int32) = I32# i# | otherwise = toEnumError "Int32" i (minBound::Int32, maxBound::Int32) #endif fromEnum (I32# x#) = I# x# enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Integral Int32 where quot x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (narrow32Int# (x# `quotInt#` y#)) | otherwise = divZeroError rem x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (narrow32Int# (x# `remInt#` y#)) | otherwise = divZeroError div x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (narrow32Int# (x# `divInt#` y#)) | otherwise = divZeroError mod x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (narrow32Int# (x# `modInt#` y#)) | otherwise = divZeroError quotRem x@(I32# x#) y@(I32# y#) | y /= 0 = (I32# (narrow32Int# (x# `quotInt#` y#)), I32# (narrow32Int# (x# `remInt#` y#))) | otherwise = divZeroError divMod x@(I32# x#) y@(I32# y#) | y /= 0 = (I32# (narrow32Int# (x# `divInt#` y#)), I32# (narrow32Int# (x# `modInt#` y#))) | otherwise = divZeroError toInteger (I32# x#) = S# x# instance Read Int32 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] instance Bits Int32 where (I32# x#) .&. (I32# y#) = I32# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I32# x#) .|. (I32# y#) = I32# (word2Int# (int2Word# x# `or#` int2Word# y#)) (I32# x#) `xor` (I32# y#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# y#)) complement (I32# x#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# (-1#))) (I32# x#) `shift` (I# i#) | i# >=# 0# = I32# (narrow32Int# (x# `iShiftL#` i#)) | otherwise = I32# (x# `iShiftRA#` negateInt# i#) (I32# x#) `rotate` (I# i#) | i'# ==# 0# = I32# x# | otherwise = I32# (narrow32Int# (word2Int# ((x'# `shiftL#` i'#) `or#` (x'# `shiftRL#` (32# -# i'#))))) where x'# = narrow32Word# (int2Word# x#) i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) bitSize _ = 32 isSigned _ = True {-# RULES "fromIntegral/Word8->Int32" fromIntegral = \(W8# x#) -> I32# (word2Int# x#) "fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (word2Int# x#) "fromIntegral/Int8->Int32" fromIntegral = \(I8# x#) -> I32# x# "fromIntegral/Int16->Int32" fromIntegral = \(I16# x#) -> I32# x# "fromIntegral/Int32->Int32" fromIntegral = id :: Int32 -> Int32 "fromIntegral/a->Int32" fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (narrow32Int# x#) "fromIntegral/Int32->a" fromIntegral = \(I32# x#) -> fromIntegral (I# x#) #-} #endif instance Real Int32 where toRational x = toInteger x % 1 instance Bounded Int32 where minBound = -0x80000000 maxBound = 0x7FFFFFFF instance Ix Int32 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral i - fromIntegral m inRange (m,n) i = m <= i && i <= n ------------------------------------------------------------------------ -- type Int64 ------------------------------------------------------------------------ #if WORD_SIZE_IN_BITS < 64 data Int64 = I64# Int64# -- ^ 64-bit signed integer type instance Eq Int64 where (I64# x#) == (I64# y#) = x# `eqInt64#` y# (I64# x#) /= (I64# y#) = x# `neInt64#` y# instance Ord Int64 where (I64# x#) < (I64# y#) = x# `ltInt64#` y# (I64# x#) <= (I64# y#) = x# `leInt64#` y# (I64# x#) > (I64# y#) = x# `gtInt64#` y# (I64# x#) >= (I64# y#) = x# `geInt64#` y# instance Show Int64 where showsPrec p x = showsPrec p (toInteger x) instance Num Int64 where (I64# x#) + (I64# y#) = I64# (x# `plusInt64#` y#) (I64# x#) - (I64# y#) = I64# (x# `minusInt64#` y#) (I64# x#) * (I64# y#) = I64# (x# `timesInt64#` y#) negate (I64# x#) = I64# (negateInt64# x#) abs x | x >= 0 = x | otherwise = negate x signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 fromInteger (S# i#) = I64# (intToInt64# i#) fromInteger (J# s# d#) = I64# (integerToInt64# s# d#) instance Enum Int64 where succ x | x /= maxBound = x + 1 | otherwise = succError "Int64" pred x | x /= minBound = x - 1 | otherwise = predError "Int64" toEnum (I# i#) = I64# (intToInt64# i#) fromEnum x@(I64# x#) | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = I# (int64ToInt# x#) | otherwise = fromEnumError "Int64" x enumFrom = integralEnumFrom enumFromThen = integralEnumFromThen enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `quotInt64#` y#) | otherwise = divZeroError rem x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `remInt64#` y#) | otherwise = divZeroError div x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `divInt64#` y#) | otherwise = divZeroError mod x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `modInt64#` y#) | otherwise = divZeroError quotRem x@(I64# x#) y@(I64# y#) | y /= 0 = (I64# (x# `quotInt64#` y#), I64# (x# `remInt64#` y#)) | otherwise = divZeroError divMod x@(I64# x#) y@(I64# y#) | y /= 0 = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#)) | otherwise = divZeroError toInteger x@(I64# x#) | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = S# (int64ToInt# x#) | otherwise = case int64ToInteger# x# of (# s, d #) -> J# s d divInt64#, modInt64# :: Int64# -> Int64# -> Int64# x# `divInt64#` y# | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#) = ((x# `minusInt64#` y#) `minusInt64#` intToInt64# 1#) `quotInt64#` y# | (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#) = ((x# `minusInt64#` y#) `plusInt64#` intToInt64# 1#) `quotInt64#` y# | otherwise = x# `quotInt64#` y# x# `modInt64#` y# | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#) || (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#) = if r# `neInt64#` intToInt64# 0# then r# `plusInt64#` y# else intToInt64# 0# | otherwise = r# where r# = x# `remInt64#` y# instance Read Int64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] instance Bits Int64 where (I64# x#) .&. (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `and64#` int64ToWord64# y#)) (I64# x#) .|. (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `or64#` int64ToWord64# y#)) (I64# x#) `xor` (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#)) complement (I64# x#) = I64# (word64ToInt64# (not64# (int64ToWord64# x#))) (I64# x#) `shift` (I# i#) | i# >=# 0# = I64# (x# `iShiftL64#` i#) | otherwise = I64# (x# `iShiftRA64#` negateInt# i#) (I64# x#) `rotate` (I# i#) | i'# ==# 0# = I64# x# | otherwise = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#` (x'# `uncheckedShiftRL64#` (64# -# i'#)))) where x'# = int64ToWord64# x# i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = True -- give the 64-bit shift operations the same treatment as the 32-bit -- ones (see GHC.Base), namely we wrap them in tests to catch the -- cases when we're shifting more than 64 bits to avoid unspecified -- behaviour in the C shift operations. iShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64# a `iShiftL64#` b | b >=# 64# = intToInt64# 0# | otherwise = a `uncheckedIShiftL64#` b a `iShiftRA64#` b | b >=# 64# = if a `ltInt64#` (intToInt64# 0#) then intToInt64# (-1#) else intToInt64# 0# | otherwise = a `uncheckedIShiftRA64#` b foreign import ccall unsafe "stg_eqInt64" eqInt64# :: Int64# -> Int64# -> Bool foreign import ccall unsafe "stg_neInt64" neInt64# :: Int64# -> Int64# -> Bool foreign import ccall unsafe "stg_ltInt64" ltInt64# :: Int64# -> Int64# -> Bool foreign import ccall unsafe "stg_leInt64" leInt64# :: Int64# -> Int64# -> Bool foreign import ccall unsafe "stg_gtInt64" gtInt64# :: Int64# -> Int64# -> Bool foreign import ccall unsafe "stg_geInt64" geInt64# :: Int64# -> Int64# -> Bool foreign import ccall unsafe "stg_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64# foreign import ccall unsafe "stg_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64# foreign import ccall unsafe "stg_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64# foreign import ccall unsafe "stg_negateInt64" negateInt64# :: Int64# -> Int64# foreign import ccall unsafe "stg_quotInt64" quotInt64# :: Int64# -> Int64# -> Int64# foreign import ccall unsafe "stg_remInt64" remInt64# :: Int64# -> Int64# -> Int64# foreign import ccall unsafe "stg_intToInt64" intToInt64# :: Int# -> Int64# foreign import ccall unsafe "stg_int64ToInt" int64ToInt# :: Int64# -> Int# foreign import ccall unsafe "stg_wordToWord64" wordToWord64# :: Word# -> Word64# foreign import ccall unsafe "stg_int64ToWord64" int64ToWord64# :: Int64# -> Word64# foreign import ccall unsafe "stg_word64ToInt64" word64ToInt64# :: Word64# -> Int64# foreign import ccall unsafe "stg_and64" and64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_or64" or64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_xor64" xor64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_not64" not64# :: Word64# -> Word64# foreign import ccall unsafe "stg_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# foreign import ccall unsafe "stg_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# foreign import ccall unsafe "stg_uncheckedIShiftL64" uncheckedIShiftL64# :: Int64# -> Int# -> Int64# foreign import ccall unsafe "stg_uncheckedIShiftRA64" uncheckedIShiftRA64# :: Int64# -> Int# -> Int64# foreign import ccall unsafe "stg_integerToInt64" integerToInt64# :: Int# -> ByteArray# -> Int64# {-# RULES "fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#) "fromIntegral/Word->Int64" fromIntegral = \(W# x#) -> I64# (word64ToInt64# (wordToWord64# x#)) "fromIntegral/Word64->Int64" fromIntegral = \(W64# x#) -> I64# (word64ToInt64# x#) "fromIntegral/Int64->Int" fromIntegral = \(I64# x#) -> I# (int64ToInt# x#) "fromIntegral/Int64->Word" fromIntegral = \(I64# x#) -> W# (int2Word# (int64ToInt# x#)) "fromIntegral/Int64->Word64" fromIntegral = \(I64# x#) -> W64# (int64ToWord64# x#) "fromIntegral/Int64->Int64" fromIntegral = id :: Int64 -> Int64 #-} #else -- Int64 is represented in the same way as Int. -- Operations may assume and must ensure that it holds only values -- from its logical range. data Int64 = I64# Int# deriving (Eq, Ord) -- ^ 64-bit signed integer type instance Show Int64 where showsPrec p x = showsPrec p (fromIntegral x :: Int) instance Num Int64 where (I64# x#) + (I64# y#) = I64# (x# +# y#) (I64# x#) - (I64# y#) = I64# (x# -# y#) (I64# x#) * (I64# y#) = I64# (x# *# y#) negate (I64# x#) = I64# (negateInt# x#) abs x | x >= 0 = x | otherwise = negate x signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 fromInteger (S# i#) = I64# i# fromInteger (J# s# d#) = I64# (integer2Int# s# d#) instance Enum Int64 where succ x | x /= maxBound = x + 1 | otherwise = succError "Int64" pred x | x /= minBound = x - 1 | otherwise = predError "Int64" toEnum (I# i#) = I64# i# fromEnum (I64# x#) = I# x# enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `quotInt#` y#) | otherwise = divZeroError rem x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `remInt#` y#) | otherwise = divZeroError div x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `divInt#` y#) | otherwise = divZeroError mod x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `modInt#` y#) | otherwise = divZeroError quotRem x@(I64# x#) y@(I64# y#) | y /= 0 = (I64# (x# `quotInt#` y#), I64# (x# `remInt#` y#)) | otherwise = divZeroError divMod x@(I64# x#) y@(I64# y#) | y /= 0 = (I64# (x# `divInt#` y#), I64# (x# `modInt#` y#)) | otherwise = divZeroError toInteger (I64# x#) = S# x# instance Read Int64 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] instance Bits Int64 where (I64# x#) .&. (I64# y#) = I64# (word2Int# (int2Word# x# `and#` int2Word# y#)) (I64# x#) .|. (I64# y#) = I64# (word2Int# (int2Word# x# `or#` int2Word# y#)) (I64# x#) `xor` (I64# y#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# y#)) complement (I64# x#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#))) (I64# x#) `shift` (I# i#) | i# >=# 0# = I64# (x# `iShiftL#` i#) | otherwise = I64# (x# `iShiftRA#` negateInt# i#) (I64# x#) `rotate` (I# i#) | i'# ==# 0# = I64# x# | otherwise = I64# (word2Int# ((x'# `shiftL#` i'#) `or#` (x'# `shiftRL#` (64# -# i'#)))) where x'# = int2Word# x# i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = True {-# RULES "fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x# "fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#) #-} #endif instance Real Int64 where toRational x = toInteger x % 1 instance Bounded Int64 where minBound = -0x8000000000000000 maxBound = 0x7FFFFFFFFFFFFFFF instance Ix Int64 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral i - fromIntegral m inRange (m,n) i = m <= i && i <= n hugs98-plus-Sep2006/packages/base/GHC/List.lhs0000644006511100651110000005034010504340226017475 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.List -- Copyright : (c) The University of Glasgow 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The List data type and its operations -- ----------------------------------------------------------------------------- -- #hide module GHC.List ( -- [] (..), -- Not Haskell 98; built in syntax map, (++), filter, concat, head, last, tail, init, null, length, (!!), foldl, scanl, scanl1, foldr, foldr1, scanr, scanr1, iterate, repeat, replicate, cycle, take, drop, splitAt, takeWhile, dropWhile, span, break, reverse, and, or, any, all, elem, notElem, lookup, concatMap, zip, zip3, zipWith, zipWith3, unzip, unzip3, errorEmptyList, #ifndef USE_REPORT_PRELUDE -- non-standard, but hidden when creating the Prelude -- export list. takeUInt_append #endif ) where import {-# SOURCE #-} GHC.Err ( error ) import Data.Tuple() -- Instances import Data.Maybe import GHC.Base infixl 9 !! infix 4 `elem`, `notElem` \end{code} %********************************************************* %* * \subsection{List-manipulation functions} %* * %********************************************************* \begin{code} -- | Extract the first element of a list, which must be non-empty. head :: [a] -> a head (x:_) = x head [] = badHead badHead = errorEmptyList "head" -- This rule is useful in cases like -- head [y | (x,y) <- ps, x==t] {-# RULES "head/build" forall (g::forall b.(a->b->b)->b->b) . head (build g) = g (\x _ -> x) badHead "head/augment" forall xs (g::forall b. (a->b->b) -> b -> b) . head (augment g xs) = g (\x _ -> x) (head xs) #-} -- | Extract the elements after the head of a list, which must be non-empty. tail :: [a] -> [a] tail (_:xs) = xs tail [] = errorEmptyList "tail" -- | Extract the last element of a list, which must be finite and non-empty. last :: [a] -> a #ifdef USE_REPORT_PRELUDE last [x] = x last (_:xs) = last xs last [] = errorEmptyList "last" #else -- eliminate repeated cases last [] = errorEmptyList "last" last (x:xs) = last' x xs where last' y [] = y last' _ (y:ys) = last' y ys #endif -- | Return all the elements of a list except the last one. -- The list must be finite and non-empty. init :: [a] -> [a] #ifdef USE_REPORT_PRELUDE init [x] = [] init (x:xs) = x : init xs init [] = errorEmptyList "init" #else -- eliminate repeated cases init [] = errorEmptyList "init" init (x:xs) = init' x xs where init' _ [] = [] init' y (z:zs) = y : init' z zs #endif -- | Test whether a list is empty. null :: [a] -> Bool null [] = True null (_:_) = False -- | 'length' returns the length of a finite list as an 'Int'. -- It is an instance of the more general 'Data.List.genericLength', -- the result type of which may be any kind of number. length :: [a] -> Int length l = len l 0# where len :: [a] -> Int# -> Int len [] a# = I# a# len (_:xs) a# = len xs (a# +# 1#) -- | 'filter', applied to a predicate and a list, returns the list of -- those elements that satisfy the predicate; i.e., -- -- > filter p xs = [ x | x <- xs, p x] filter :: (a -> Bool) -> [a] -> [a] filter _pred [] = [] filter pred (x:xs) | pred x = x : filter pred xs | otherwise = filter pred xs {-# NOINLINE [0] filterFB #-} filterFB c p x r | p x = x `c` r | otherwise = r {-# RULES "filter" [~1] forall p xs. filter p xs = build (\c n -> foldr (filterFB c p) n xs) "filterList" [1] forall p. foldr (filterFB (:) p) [] = filter p "filterFB" forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> q x && p x) #-} -- Note the filterFB rule, which has p and q the "wrong way round" in the RHS. -- filterFB (filterFB c p) q a b -- = if q a then filterFB c p a b else b -- = if q a then (if p a then c a b else b) else b -- = if q a && p a then c a b else b -- = filterFB c (\x -> q x && p x) a b -- I originally wrote (\x -> p x && q x), which is wrong, and actually -- gave rise to a live bug report. SLPJ. -- | 'foldl', applied to a binary operator, a starting value (typically -- the left-identity of the operator), and a list, reduces the list -- using the binary operator, from left to right: -- -- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn -- -- The list must be finite. -- We write foldl as a non-recursive thing, so that it -- can be inlined, and then (often) strictness-analysed, -- and hence the classic space leak on foldl (+) 0 xs foldl :: (a -> b -> a) -> a -> [b] -> a foldl f z xs = lgo z xs where lgo z [] = z lgo z (x:xs) = lgo (f z x) xs -- | 'scanl' is similar to 'foldl', but returns a list of successive -- reduced values from the left: -- -- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] -- -- Note that -- -- > last (scanl f z xs) == foldl f z xs. scanl :: (a -> b -> a) -> a -> [b] -> [a] scanl f q ls = q : (case ls of [] -> [] x:xs -> scanl f (f q x) xs) -- | 'scanl1' is a variant of 'scanl' that has no starting value argument: -- -- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] scanl1 :: (a -> a -> a) -> [a] -> [a] scanl1 f (x:xs) = scanl f x xs scanl1 _ [] = [] -- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the -- above functions. -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty lists. foldr1 :: (a -> a -> a) -> [a] -> a foldr1 _ [x] = x foldr1 f (x:xs) = f x (foldr1 f xs) foldr1 _ [] = errorEmptyList "foldr1" -- | 'scanr' is the right-to-left dual of 'scanl'. -- Note that -- -- > head (scanr f z xs) == foldr f z xs. scanr :: (a -> b -> b) -> b -> [a] -> [b] scanr _ q0 [] = [q0] scanr f q0 (x:xs) = f x q : qs where qs@(q:_) = scanr f q0 xs -- | 'scanr1' is a variant of 'scanr' that has no starting value argument. scanr1 :: (a -> a -> a) -> [a] -> [a] scanr1 f [] = [] scanr1 f [x] = [x] scanr1 f (x:xs) = f x q : qs where qs@(q:_) = scanr1 f xs -- | 'iterate' @f x@ returns an infinite list of repeated applications -- of @f@ to @x@: -- -- > iterate f x == [x, f x, f (f x), ...] iterate :: (a -> a) -> a -> [a] iterate f x = x : iterate f (f x) iterateFB c f x = x `c` iterateFB c f (f x) {-# RULES "iterate" [~1] forall f x. iterate f x = build (\c _n -> iterateFB c f x) "iterateFB" [1] iterateFB (:) = iterate #-} -- | 'repeat' @x@ is an infinite list, with @x@ the value of every element. repeat :: a -> [a] {-# INLINE [0] repeat #-} -- The pragma just gives the rules more chance to fire repeat x = xs where xs = x : xs {-# INLINE [0] repeatFB #-} -- ditto repeatFB c x = xs where xs = x `c` xs {-# RULES "repeat" [~1] forall x. repeat x = build (\c _n -> repeatFB c x) "repeatFB" [1] repeatFB (:) = repeat #-} -- | 'replicate' @n x@ is a list of length @n@ with @x@ the value of -- every element. -- It is an instance of the more general 'Data.List.genericReplicate', -- in which @n@ may be of any integral type. {-# INLINE replicate #-} replicate :: Int -> a -> [a] replicate n x = take n (repeat x) -- | 'cycle' ties a finite list into a circular one, or equivalently, -- the infinite repetition of the original list. It is the identity -- on infinite lists. cycle :: [a] -> [a] cycle [] = error "Prelude.cycle: empty list" cycle xs = xs' where xs' = xs ++ xs' -- | 'takeWhile', applied to a predicate @p@ and a list @xs@, returns the -- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@. takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile _ [] = [] takeWhile p (x:xs) | p x = x : takeWhile p xs | otherwise = [] -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile _ [] = [] dropWhile p xs@(x:xs') | p x = dropWhile p xs' | otherwise = xs -- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@ -- of length @n@, or @xs@ itself if @n > 'length' xs@. -- It is an instance of the more general 'Data.List.genericTake', -- in which @n@ may be of any integral type. take :: Int -> [a] -> [a] -- | 'drop' @n xs@ returns the suffix of @xs@ -- after the first @n@ elements, or @[]@ if @n > 'length' xs@. -- It is an instance of the more general 'Data.List.genericDrop', -- in which @n@ may be of any integral type. drop :: Int -> [a] -> [a] -- | 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. -- It is an instance of the more general 'Data.List.genericSplitAt', -- in which @n@ may be of any integral type. splitAt :: Int -> [a] -> ([a],[a]) #ifdef USE_REPORT_PRELUDE take n _ | n <= 0 = [] take _ [] = [] take n (x:xs) = x : take (n-1) xs drop n xs | n <= 0 = xs drop _ [] = [] drop n (_:xs) = drop (n-1) xs splitAt n xs = (take n xs, drop n xs) #else /* hack away */ {-# RULES "take" [~1] forall n xs . take n xs = case n of I# n# -> build (\c nil -> foldr (takeFB c nil) (takeConst nil) xs n#) "takeList" [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n = takeUInt n xs #-} {-# NOINLINE [0] takeConst #-} -- just a version of const that doesn't get inlined too early, so we -- can spot it in rules. Also we need a type sig due to the unboxed Int#. takeConst :: a -> Int# -> a takeConst x _ = x {-# NOINLINE [0] takeFB #-} takeFB :: (a -> b -> c) -> c -> a -> (Int# -> b) -> Int# -> c takeFB c n x xs m | m <=# 0# = n | otherwise = x `c` xs (m -# 1#) {-# INLINE [0] take #-} take (I# n#) xs = takeUInt n# xs -- The general code for take, below, checks n <= maxInt -- No need to check for maxInt overflow when specialised -- at type Int or Int# since the Int must be <= maxInt takeUInt :: Int# -> [b] -> [b] takeUInt n xs | n >=# 0# = take_unsafe_UInt n xs | otherwise = [] take_unsafe_UInt :: Int# -> [b] -> [b] take_unsafe_UInt 0# _ = [] take_unsafe_UInt m ls = case ls of [] -> [] (x:xs) -> x : take_unsafe_UInt (m -# 1#) xs takeUInt_append :: Int# -> [b] -> [b] -> [b] takeUInt_append n xs rs | n >=# 0# = take_unsafe_UInt_append n xs rs | otherwise = [] take_unsafe_UInt_append :: Int# -> [b] -> [b] -> [b] take_unsafe_UInt_append 0# _ rs = rs take_unsafe_UInt_append m ls rs = case ls of [] -> rs (x:xs) -> x : take_unsafe_UInt_append (m -# 1#) xs rs drop (I# n#) ls | n# <# 0# = ls | otherwise = drop# n# ls where drop# :: Int# -> [a] -> [a] drop# 0# xs = xs drop# _ xs@[] = xs drop# m# (_:xs) = drop# (m# -# 1#) xs splitAt (I# n#) ls | n# <# 0# = ([], ls) | otherwise = splitAt# n# ls where splitAt# :: Int# -> [a] -> ([a], [a]) splitAt# 0# xs = ([], xs) splitAt# _ xs@[] = (xs, xs) splitAt# m# (x:xs) = (x:xs', xs'') where (xs', xs'') = splitAt# (m# -# 1#) xs #endif /* USE_REPORT_PRELUDE */ -- | 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ span :: (a -> Bool) -> [a] -> ([a],[a]) span _ xs@[] = (xs, xs) span p xs@(x:xs') | p x = let (ys,zs) = span p xs' in (x:ys,zs) | otherwise = ([],xs) -- | 'break' @p@ is equivalent to @'span' ('not' . p)@. break :: (a -> Bool) -> [a] -> ([a],[a]) #ifdef USE_REPORT_PRELUDE break p = span (not . p) #else -- HBC version (stolen) break _ xs@[] = (xs, xs) break p xs@(x:xs') | p x = ([],xs) | otherwise = let (ys,zs) = break p xs' in (x:ys,zs) #endif -- | 'reverse' @xs@ returns the elements of @xs@ in reverse order. -- @xs@ must be finite. reverse :: [a] -> [a] #ifdef USE_REPORT_PRELUDE reverse = foldl (flip (:)) [] #else reverse l = rev l [] where rev [] a = a rev (x:xs) a = rev xs (x:a) #endif -- | 'and' returns the conjunction of a Boolean list. For the result to be -- 'True', the list must be finite; 'False', however, results from a 'False' -- value at a finite index of a finite or infinite list. and :: [Bool] -> Bool -- | 'or' returns the disjunction of a Boolean list. For the result to be -- 'False', the list must be finite; 'True', however, results from a 'True' -- value at a finite index of a finite or infinite list. or :: [Bool] -> Bool #ifdef USE_REPORT_PRELUDE and = foldr (&&) True or = foldr (||) False #else and [] = True and (x:xs) = x && and xs or [] = False or (x:xs) = x || or xs {-# RULES "and/build" forall (g::forall b.(Bool->b->b)->b->b) . and (build g) = g (&&) True "or/build" forall (g::forall b.(Bool->b->b)->b->b) . or (build g) = g (||) False #-} #endif -- | Applied to a predicate and a list, 'any' determines if any element -- of the list satisfies the predicate. any :: (a -> Bool) -> [a] -> Bool -- | Applied to a predicate and a list, 'all' determines if all elements -- of the list satisfy the predicate. all :: (a -> Bool) -> [a] -> Bool #ifdef USE_REPORT_PRELUDE any p = or . map p all p = and . map p #else any _ [] = False any p (x:xs) = p x || any p xs all _ [] = True all p (x:xs) = p x && all p xs {-# RULES "any/build" forall p (g::forall b.(a->b->b)->b->b) . any p (build g) = g ((||) . p) False "all/build" forall p (g::forall b.(a->b->b)->b->b) . all p (build g) = g ((&&) . p) True #-} #endif -- | 'elem' is the list membership predicate, usually written in infix form, -- e.g., @x `elem` xs@. elem :: (Eq a) => a -> [a] -> Bool -- | 'notElem' is the negation of 'elem'. notElem :: (Eq a) => a -> [a] -> Bool #ifdef USE_REPORT_PRELUDE elem x = any (== x) notElem x = all (/= x) #else elem _ [] = False elem x (y:ys) = x==y || elem x ys notElem _ [] = True notElem x (y:ys)= x /= y && notElem x ys #endif -- | 'lookup' @key assocs@ looks up a key in an association list. lookup :: (Eq a) => a -> [(a,b)] -> Maybe b lookup _key [] = Nothing lookup key ((x,y):xys) | key == x = Just y | otherwise = lookup key xys -- | Map a function over a list and concatenate the results. concatMap :: (a -> [b]) -> [a] -> [b] concatMap f = foldr ((++) . f) [] -- | Concatenate a list of lists. concat :: [[a]] -> [a] concat = foldr (++) [] {-# RULES "concat" forall xs. concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs) -- We don't bother to turn non-fusible applications of concat back into concat #-} \end{code} \begin{code} -- | List index (subscript) operator, starting from 0. -- It is an instance of the more general 'Data.List.genericIndex', -- which takes an index of any integral type. (!!) :: [a] -> Int -> a #ifdef USE_REPORT_PRELUDE xs !! n | n < 0 = error "Prelude.!!: negative index" [] !! _ = error "Prelude.!!: index too large" (x:_) !! 0 = x (_:xs) !! n = xs !! (n-1) #else -- HBC version (stolen), then unboxified -- The semantics is not quite the same for error conditions -- in the more efficient version. -- xs !! (I# n) | n <# 0# = error "Prelude.(!!): negative index\n" | otherwise = sub xs n where sub :: [a] -> Int# -> a sub [] _ = error "Prelude.(!!): index too large\n" sub (y:ys) n = if n ==# 0# then y else sub ys (n -# 1#) #endif \end{code} %********************************************************* %* * \subsection{The zip family} %* * %********************************************************* \begin{code} foldr2 _k z [] _ys = z foldr2 _k z _xs [] = z foldr2 k z (x:xs) (y:ys) = k x y (foldr2 k z xs ys) foldr2_left _k z _x _r [] = z foldr2_left k _z x r (y:ys) = k x y (r ys) foldr2_right _k z _y _r [] = z foldr2_right k _z y r (x:xs) = k x y (r xs) -- foldr2 k z xs ys = foldr (foldr2_left k z) (\_ -> z) xs ys -- foldr2 k z xs ys = foldr (foldr2_right k z) (\_ -> z) ys xs {-# RULES "foldr2/left" forall k z ys (g::forall b.(a->b->b)->b->b) . foldr2 k z (build g) ys = g (foldr2_left k z) (\_ -> z) ys "foldr2/right" forall k z xs (g::forall b.(a->b->b)->b->b) . foldr2 k z xs (build g) = g (foldr2_right k z) (\_ -> z) xs #-} \end{code} The foldr2/right rule isn't exactly right, because it changes the strictness of foldr2 (and thereby zip) E.g. main = print (null (zip nonobviousNil (build undefined))) where nonobviousNil = f 3 f n = if n == 0 then [] else f (n-1) I'm going to leave it though. Zips for larger tuples are in the List module. \begin{code} ---------------------------------------------- -- | 'zip' takes two lists and returns a list of corresponding pairs. -- If one input list is short, excess elements of the longer list are -- discarded. zip :: [a] -> [b] -> [(a,b)] zip (a:as) (b:bs) = (a,b) : zip as bs zip _ _ = [] {-# INLINE [0] zipFB #-} zipFB c x y r = (x,y) `c` r {-# RULES "zip" [~1] forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys) "zipList" [1] foldr2 (zipFB (:)) [] = zip #-} \end{code} \begin{code} ---------------------------------------------- -- | 'zip3' takes three lists and returns a list of triples, analogous to -- 'zip'. zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] -- Specification -- zip3 = zipWith3 (,,) zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs zip3 _ _ _ = [] \end{code} -- The zipWith family generalises the zip family by zipping with the -- function given as the first argument, instead of a tupling function. \begin{code} ---------------------------------------------- -- | 'zipWith' generalises 'zip' by zipping with the function given -- as the first argument, instead of a tupling function. -- For example, @'zipWith' (+)@ is applied to two lists to produce the -- list of corresponding sums. zipWith :: (a->b->c) -> [a]->[b]->[c] zipWith f (a:as) (b:bs) = f a b : zipWith f as bs zipWith _ _ _ = [] {-# INLINE [0] zipWithFB #-} zipWithFB c f x y r = (x `f` y) `c` r {-# RULES "zipWith" [~1] forall f xs ys. zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys) "zipWithList" [1] forall f. foldr2 (zipWithFB (:) f) [] = zipWith f #-} \end{code} \begin{code} -- | The 'zipWith3' function takes a function which combines three -- elements, as well as three lists and returns a list of their point-wise -- combination, analogous to 'zipWith'. zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs zipWith3 _ _ _ _ = [] -- | 'unzip' transforms a list of pairs into a list of first components -- and a list of second components. unzip :: [(a,b)] -> ([a],[b]) {-# INLINE unzip #-} unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[]) -- | The 'unzip3' function takes a list of triples and returns three -- lists, analogous to 'unzip'. unzip3 :: [(a,b,c)] -> ([a],[b],[c]) {-# INLINE unzip3 #-} unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[]) \end{code} %********************************************************* %* * \subsection{Error code} %* * %********************************************************* Common up near identical calls to `error' to reduce the number constant strings created when compiled: \begin{code} errorEmptyList :: String -> a errorEmptyList fun = error (prel_list_str ++ fun ++ ": empty list") prel_list_str :: String prel_list_str = "Prelude." \end{code} hugs98-plus-Sep2006/packages/base/GHC/Num.lhs0000644006511100651110000004305310504340222017320 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Num -- Copyright : (c) The University of Glasgow 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The 'Num' class and the 'Integer' type. -- ----------------------------------------------------------------------------- #include "MachDeps.h" #if SIZEOF_HSWORD == 4 #define LEFTMOST_BIT 2147483648 #define DIGITS 9 #define BASE 1000000000 #elif SIZEOF_HSWORD == 8 #define LEFTMOST_BIT 9223372036854775808 #define DIGITS 18 #define BASE 1000000000000000000 #else #error Please define LEFTMOST_BIT to be 2^(SIZEOF_HSWORD*8-1) -- DIGITS should be the largest integer such that 10^DIGITS < LEFTMOST_BIT -- BASE should be 10^DIGITS. Note that ^ is not available yet. #endif -- #hide module GHC.Num where import {-# SOURCE #-} GHC.Err import GHC.Base import GHC.Enum import GHC.Show infixl 7 * infixl 6 +, - default () -- Double isn't available yet, -- and we shouldn't be using defaults anyway \end{code} %********************************************************* %* * \subsection{Standard numeric class} %* * %********************************************************* \begin{code} -- | Basic numeric class. -- -- Minimal complete definition: all except 'negate' or @(-)@ class (Eq a, Show a) => Num a where (+), (-), (*) :: a -> a -> a -- | Unary negation. negate :: a -> a -- | Absolute value. abs :: a -> a -- | Sign of a number. -- The functions 'abs' and 'signum' should satisfy the law: -- -- > abs x * signum x == x -- -- For real numbers, the 'signum' is either @-1@ (negative), @0@ (zero) -- or @1@ (positive). signum :: a -> a -- | Conversion from an 'Integer'. -- An integer literal represents the application of the function -- 'fromInteger' to the appropriate value of type 'Integer', -- so such literals have type @('Num' a) => a@. fromInteger :: Integer -> a x - y = x + negate y negate x = 0 - x -- | the same as @'flip' ('-')@. -- -- Because @-@ is treated specially in the Haskell grammar, -- @(-@ /e/@)@ is not a section, but an application of prefix negation. -- However, @('subtract'@ /exp/@)@ is equivalent to the disallowed section. {-# INLINE subtract #-} subtract :: (Num a) => a -> a -> a subtract x y = y - x \end{code} %********************************************************* %* * \subsection{Instances for @Int@} %* * %********************************************************* \begin{code} instance Num Int where (+) = plusInt (-) = minusInt negate = negateInt (*) = timesInt abs n = if n `geInt` 0 then n else negateInt n signum n | n `ltInt` 0 = negateInt 1 | n `eqInt` 0 = 0 | otherwise = 1 fromInteger = integer2Int quotRemInt :: Int -> Int -> (Int, Int) quotRemInt a@(I# _) b@(I# _) = (a `quotInt` b, a `remInt` b) -- OK, so I made it a little stricter. Shoot me. (WDP 94/10) divModInt :: Int -> Int -> (Int, Int) divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y) -- Stricter. Sorry if you don't like it. (WDP 94/10) \end{code} %********************************************************* %* * \subsection{The @Integer@ type} %* * %********************************************************* \begin{code} -- | Arbitrary-precision integers. data Integer = S# Int# -- small integers #ifndef ILX | J# Int# ByteArray# -- large integers #else | J# Void BigInteger -- .NET big ints foreign type dotnet "BigInteger" BigInteger #endif \end{code} Convenient boxed Integer PrimOps. \begin{code} zeroInteger :: Integer zeroInteger = S# 0# int2Integer :: Int -> Integer {-# INLINE int2Integer #-} int2Integer (I# i) = S# i integer2Int :: Integer -> Int integer2Int (S# i) = I# i integer2Int (J# s d) = case (integer2Int# s d) of { n# -> I# n# } toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d } toBig i@(J# _ _) = i \end{code} %********************************************************* %* * \subsection{Dividing @Integers@} %* * %********************************************************* \begin{code} quotRemInteger :: Integer -> Integer -> (Integer, Integer) quotRemInteger a@(S# (-LEFTMOST_BIT#)) b = quotRemInteger (toBig a) b quotRemInteger (S# i) (S# j) = case quotRemInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j ) quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2) quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2 quotRemInteger (J# s1 d1) (J# s2 d2) = case (quotRemInteger# s1 d1 s2 d2) of (# s3, d3, s4, d4 #) -> (J# s3 d3, J# s4 d4) divModInteger a@(S# (-LEFTMOST_BIT#)) b = divModInteger (toBig a) b divModInteger (S# i) (S# j) = case divModInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j) divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2) divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2 divModInteger (J# s1 d1) (J# s2 d2) = case (divModInteger# s1 d1 s2 d2) of (# s3, d3, s4, d4 #) -> (J# s3 d3, J# s4 d4) remInteger :: Integer -> Integer -> Integer remInteger ia 0 = error "Prelude.Integral.rem{Integer}: divide by 0" remInteger a@(S# (-LEFTMOST_BIT#)) b = remInteger (toBig a) b remInteger (S# a) (S# b) = S# (remInt# a b) {- Special case doesn't work, because a 1-element J# has the range -(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1) remInteger ia@(S# a) (J# sb b) | sb ==# 1# = S# (remInt# a (word2Int# (integer2Word# sb b))) | sb ==# -1# = S# (remInt# a (0# -# (word2Int# (integer2Word# sb b)))) | 0# <# sb = ia | otherwise = S# (0# -# a) -} remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib remInteger (J# sa a) (S# b) = case int2Integer# b of { (# sb, b #) -> case remInteger# sa a sb b of { (# sr, r #) -> S# (integer2Int# sr r) }} remInteger (J# sa a) (J# sb b) = case remInteger# sa a sb b of (# sr, r #) -> J# sr r quotInteger :: Integer -> Integer -> Integer quotInteger ia 0 = error "Prelude.Integral.quot{Integer}: divide by 0" quotInteger a@(S# (-LEFTMOST_BIT#)) b = quotInteger (toBig a) b quotInteger (S# a) (S# b) = S# (quotInt# a b) {- Special case disabled, see remInteger above quotInteger (S# a) (J# sb b) | sb ==# 1# = S# (quotInt# a (word2Int# (integer2Word# sb b))) | sb ==# -1# = S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b)))) | otherwise = zeroInteger -} quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib quotInteger (J# sa a) (S# b) = case int2Integer# b of { (# sb, b #) -> case quotInteger# sa a sb b of (# sq, q #) -> J# sq q } quotInteger (J# sa a) (J# sb b) = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g \end{code} \begin{code} gcdInteger :: Integer -> Integer -> Integer -- SUP: Do we really need the first two cases? gcdInteger a@(S# (-LEFTMOST_BIT#)) b = gcdInteger (toBig a) b gcdInteger a b@(S# (-LEFTMOST_BIT#)) = gcdInteger a (toBig b) gcdInteger (S# a) (S# b) = case gcdInt (I# a) (I# b) of { I# c -> S# c } gcdInteger ia@(S# 0#) ib@(J# 0# _) = error "GHC.Num.gcdInteger: gcd 0 0 is undefined" gcdInteger ia@(S# a) ib@(J# sb b) | a ==# 0# = abs ib | sb ==# 0# = abs ia | otherwise = S# (gcdIntegerInt# absSb b absA) where absA = if a <# 0# then negateInt# a else a absSb = if sb <# 0# then negateInt# sb else sb gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia gcdInteger (J# 0# _) (J# 0# _) = error "GHC.Num.gcdInteger: gcd 0 0 is undefined" gcdInteger (J# sa a) (J# sb b) = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g lcmInteger :: Integer -> Integer -> Integer lcmInteger a 0 = zeroInteger lcmInteger 0 b = zeroInteger lcmInteger a b = (divExact aa (gcdInteger aa ab)) * ab where aa = abs a ab = abs b divExact :: Integer -> Integer -> Integer divExact a@(S# (-LEFTMOST_BIT#)) b = divExact (toBig a) b divExact (S# a) (S# b) = S# (quotInt# a b) divExact (S# a) (J# sb b) = S# (quotInt# a (integer2Int# sb b)) divExact (J# sa a) (S# b) = case int2Integer# b of (# sb, b #) -> case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d divExact (J# sa a) (J# sb b) = case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d \end{code} %********************************************************* %* * \subsection{The @Integer@ instances for @Eq@, @Ord@} %* * %********************************************************* \begin{code} instance Eq Integer where (S# i) == (S# j) = i ==# j (S# i) == (J# s d) = cmpIntegerInt# s d i ==# 0# (J# s d) == (S# i) = cmpIntegerInt# s d i ==# 0# (J# s1 d1) == (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0# (S# i) /= (S# j) = i /=# j (S# i) /= (J# s d) = cmpIntegerInt# s d i /=# 0# (J# s d) /= (S# i) = cmpIntegerInt# s d i /=# 0# (J# s1 d1) /= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0# ------------------------------------------------------------------------ instance Ord Integer where (S# i) <= (S# j) = i <=# j (J# s d) <= (S# i) = cmpIntegerInt# s d i <=# 0# (S# i) <= (J# s d) = cmpIntegerInt# s d i >=# 0# (J# s1 d1) <= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0# (S# i) > (S# j) = i ># j (J# s d) > (S# i) = cmpIntegerInt# s d i ># 0# (S# i) > (J# s d) = cmpIntegerInt# s d i <# 0# (J# s1 d1) > (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0# (S# i) < (S# j) = i <# j (J# s d) < (S# i) = cmpIntegerInt# s d i <# 0# (S# i) < (J# s d) = cmpIntegerInt# s d i ># 0# (J# s1 d1) < (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0# (S# i) >= (S# j) = i >=# j (J# s d) >= (S# i) = cmpIntegerInt# s d i >=# 0# (S# i) >= (J# s d) = cmpIntegerInt# s d i <=# 0# (J# s1 d1) >= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0# compare (S# i) (S# j) | i ==# j = EQ | i <=# j = LT | otherwise = GT compare (J# s d) (S# i) = case cmpIntegerInt# s d i of { res# -> if res# <# 0# then LT else if res# ># 0# then GT else EQ } compare (S# i) (J# s d) = case cmpIntegerInt# s d i of { res# -> if res# ># 0# then LT else if res# <# 0# then GT else EQ } compare (J# s1 d1) (J# s2 d2) = case cmpInteger# s1 d1 s2 d2 of { res# -> if res# <# 0# then LT else if res# ># 0# then GT else EQ } \end{code} %********************************************************* %* * \subsection{The @Integer@ instances for @Num@} %* * %********************************************************* \begin{code} instance Num Integer where (+) = plusInteger (-) = minusInteger (*) = timesInteger negate = negateInteger fromInteger x = x -- ORIG: abs n = if n >= 0 then n else -n abs (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT abs (S# i) = case abs (I# i) of I# j -> S# j abs n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d signum (S# i) = case signum (I# i) of I# j -> S# j signum (J# s d) = let cmp = cmpIntegerInt# s d 0# in if cmp ># 0# then S# 1# else if cmp ==# 0# then S# 0# else S# (negateInt# 1#) plusInteger i1@(S# i) i2@(S# j) = case addIntC# i j of { (# r, c #) -> if c ==# 0# then S# r else toBig i1 + toBig i2 } plusInteger i1@(J# _ _) i2@(S# _) = i1 + toBig i2 plusInteger i1@(S# _) i2@(J# _ _) = toBig i1 + i2 plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d minusInteger i1@(S# i) i2@(S# j) = case subIntC# i j of { (# r, c #) -> if c ==# 0# then S# r else toBig i1 - toBig i2 } minusInteger i1@(J# _ _) i2@(S# _) = i1 - toBig i2 minusInteger i1@(S# _) i2@(J# _ _) = toBig i1 - i2 minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d timesInteger i1@(S# i) i2@(S# j) = if mulIntMayOflo# i j ==# 0# then S# (i *# j) else toBig i1 * toBig i2 timesInteger i1@(J# _ _) i2@(S# _) = i1 * toBig i2 timesInteger i1@(S# _) i2@(J# _ _) = toBig i1 * i2 timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d negateInteger (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT negateInteger (S# i) = S# (negateInt# i) negateInteger (J# s d) = J# (negateInt# s) d \end{code} %********************************************************* %* * \subsection{The @Integer@ instance for @Enum@} %* * %********************************************************* \begin{code} instance Enum Integer where succ x = x + 1 pred x = x - 1 toEnum n = int2Integer n fromEnum n = integer2Int n {-# INLINE enumFrom #-} {-# INLINE enumFromThen #-} {-# INLINE enumFromTo #-} {-# INLINE enumFromThenTo #-} enumFrom x = enumDeltaInteger x 1 enumFromThen x y = enumDeltaInteger x (y-x) enumFromTo x lim = enumDeltaToInteger x 1 lim enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim {-# RULES "enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y) "efdtInteger" [~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l) "enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger "enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger #-} enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d enumDeltaInteger :: Integer -> Integer -> [Integer] enumDeltaInteger x d = x : enumDeltaInteger (x+d) d enumDeltaToIntegerFB c n x delta lim | delta >= 0 = up_fb c n x delta lim | otherwise = dn_fb c n x delta lim enumDeltaToInteger x delta lim | delta >= 0 = up_list x delta lim | otherwise = dn_list x delta lim up_fb c n x delta lim = go (x::Integer) where go x | x > lim = n | otherwise = x `c` go (x+delta) dn_fb c n x delta lim = go (x::Integer) where go x | x < lim = n | otherwise = x `c` go (x+delta) up_list x delta lim = go (x::Integer) where go x | x > lim = [] | otherwise = x : go (x+delta) dn_list x delta lim = go (x::Integer) where go x | x < lim = [] | otherwise = x : go (x+delta) \end{code} %********************************************************* %* * \subsection{The @Integer@ instances for @Show@} %* * %********************************************************* \begin{code} instance Show Integer where showsPrec p n r | p > 6 && n < 0 = '(' : jtos n (')' : r) -- Minor point: testing p first gives better code -- in the not-uncommon case where the p argument -- is a constant | otherwise = jtos n r showList = showList__ (showsPrec 0) -- Divide an conquer implementation of string conversion jtos :: Integer -> String -> String jtos n cs | n < 0 = '-' : jtos' (-n) cs | otherwise = jtos' n cs where jtos' :: Integer -> String -> String jtos' n cs | n < BASE = jhead (fromInteger n) cs | otherwise = jprinth (jsplitf (BASE*BASE) n) cs -- Split n into digits in base p. We first split n into digits -- in base p*p and then split each of these digits into two. -- Note that the first 'digit' modulo p*p may have a leading zero -- in base p that we need to drop - this is what jsplith takes care of. -- jsplitb the handles the remaining digits. jsplitf :: Integer -> Integer -> [Integer] jsplitf p n | p > n = [n] | otherwise = jsplith p (jsplitf (p*p) n) jsplith :: Integer -> [Integer] -> [Integer] jsplith p (n:ns) = if q > 0 then fromInteger q : fromInteger r : jsplitb p ns else fromInteger r : jsplitb p ns where (q, r) = n `quotRemInteger` p jsplitb :: Integer -> [Integer] -> [Integer] jsplitb p [] = [] jsplitb p (n:ns) = q : r : jsplitb p ns where (q, r) = n `quotRemInteger` p -- Convert a number that has been split into digits in base BASE^2 -- this includes a last splitting step and then conversion of digits -- that all fit into a machine word. jprinth :: [Integer] -> String -> String jprinth (n:ns) cs = if q > 0 then jhead q $ jblock r $ jprintb ns cs else jhead r $ jprintb ns cs where (q', r') = n `quotRemInteger` BASE q = fromInteger q' r = fromInteger r' jprintb :: [Integer] -> String -> String jprintb [] cs = cs jprintb (n:ns) cs = jblock q $ jblock r $ jprintb ns cs where (q', r') = n `quotRemInteger` BASE q = fromInteger q' r = fromInteger r' -- Convert an integer that fits into a machine word. Again, we have two -- functions, one that drops leading zeros (jhead) and one that doesn't -- (jblock) jhead :: Int -> String -> String jhead n cs | n < 10 = case unsafeChr (ord '0' + n) of c@(C# _) -> c : cs | otherwise = case unsafeChr (ord '0' + r) of c@(C# _) -> jhead q (c : cs) where (q, r) = n `quotRemInt` 10 jblock = jblock' {- ' -} DIGITS jblock' :: Int -> Int -> String -> String jblock' d n cs | d == 1 = case unsafeChr (ord '0' + n) of c@(C# _) -> c : cs | otherwise = case unsafeChr (ord '0' + r) of c@(C# _) -> jblock' (d - 1) q (c : cs) where (q, r) = n `quotRemInt` 10 \end{code} hugs98-plus-Sep2006/packages/base/GHC/PArr.hs0000644006511100651110000005256710504340221017262 0ustar rossross{-# OPTIONS_GHC -fparr #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.PArr -- Copyright : (c) 2001-2002 Manuel M T Chakravarty & Gabriele Keller -- License : see libraries/base/LICENSE -- -- Maintainer : Manuel M. T. Chakravarty -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- Basic implementation of Parallel Arrays. -- -- This module has two functions: (1) It defines the interface to the -- parallel array extension of the Prelude and (2) it provides a vanilla -- implementation of parallel arrays that does not require to flatten the -- array code. The implementation is not very optimised. -- --- DOCU ---------------------------------------------------------------------- -- -- Language: Haskell 98 plus unboxed values and parallel arrays -- -- The semantic difference between standard Haskell arrays (aka "lazy -- arrays") and parallel arrays (aka "strict arrays") is that the evaluation -- of two different elements of a lazy array is independent, whereas in a -- strict array either non or all elements are evaluated. In other words, -- when a parallel array is evaluated to WHNF, all its elements will be -- evaluated to WHNF. The name parallel array indicates that all array -- elements may, in general, be evaluated to WHNF in parallel without any -- need to resort to speculative evaluation. This parallel evaluation -- semantics is also beneficial in the sequential case, as it facilitates -- loop-based array processing as known from classic array-based languages, -- such as Fortran. -- -- The interface of this module is essentially a variant of the list -- component of the Prelude, but also includes some functions (such as -- permutations) that are not provided for lists. The following list -- operations are not supported on parallel arrays, as they would require the -- availability of infinite parallel arrays: `iterate', `repeat', and `cycle'. -- -- The current implementation is quite simple and entirely based on boxed -- arrays. One disadvantage of boxed arrays is that they require to -- immediately initialise all newly allocated arrays with an error thunk to -- keep the garbage collector happy, even if it is guaranteed that the array -- is fully initialised with different values before passing over the -- user-visible interface boundary. Currently, no effort is made to use -- raw memory copy operations to speed things up. -- --- TODO ---------------------------------------------------------------------- -- -- * We probably want a standard library `PArray' in addition to the prelude -- extension in the same way as the standard library `List' complements the -- list functions from the prelude. -- -- * Currently, functions that emphasis the constructor-based definition of -- lists (such as, head, last, tail, and init) are not supported. -- -- Is it worthwhile to support the string processing functions lines, -- words, unlines, and unwords? (Currently, they are not implemented.) -- -- It can, however, be argued that it would be worthwhile to include them -- for completeness' sake; maybe only in the standard library `PArray'. -- -- * Prescans are often more useful for array programming than scans. Shall -- we include them into the Prelude or the library? -- -- * Due to the use of the iterator `loop', we could define some fusion rules -- in this module. -- -- * We might want to add bounds checks that can be deactivated. -- module GHC.PArr ( -- [::], -- Built-in syntax mapP, -- :: (a -> b) -> [:a:] -> [:b:] (+:+), -- :: [:a:] -> [:a:] -> [:a:] filterP, -- :: (a -> Bool) -> [:a:] -> [:a:] concatP, -- :: [:[:a:]:] -> [:a:] concatMapP, -- :: (a -> [:b:]) -> [:a:] -> [:b:] -- head, last, tail, init, -- it's not wise to use them on arrays nullP, -- :: [:a:] -> Bool lengthP, -- :: [:a:] -> Int (!:), -- :: [:a:] -> Int -> a foldlP, -- :: (a -> b -> a) -> a -> [:b:] -> a foldl1P, -- :: (a -> a -> a) -> [:a:] -> a scanlP, -- :: (a -> b -> a) -> a -> [:b:] -> [:a:] scanl1P, -- :: (a -> a -> a) -> [:a:] -> [:a:] foldrP, -- :: (a -> b -> b) -> b -> [:a:] -> b foldr1P, -- :: (a -> a -> a) -> [:a:] -> a scanrP, -- :: (a -> b -> b) -> b -> [:a:] -> [:b:] scanr1P, -- :: (a -> a -> a) -> [:a:] -> [:a:] -- iterate, repeat, -- parallel arrays must be finite replicateP, -- :: Int -> a -> [:a:] -- cycle, -- parallel arrays must be finite takeP, -- :: Int -> [:a:] -> [:a:] dropP, -- :: Int -> [:a:] -> [:a:] splitAtP, -- :: Int -> [:a:] -> ([:a:],[:a:]) takeWhileP, -- :: (a -> Bool) -> [:a:] -> [:a:] dropWhileP, -- :: (a -> Bool) -> [:a:] -> [:a:] spanP, -- :: (a -> Bool) -> [:a:] -> ([:a:], [:a:]) breakP, -- :: (a -> Bool) -> [:a:] -> ([:a:], [:a:]) -- lines, words, unlines, unwords, -- is string processing really needed reverseP, -- :: [:a:] -> [:a:] andP, -- :: [:Bool:] -> Bool orP, -- :: [:Bool:] -> Bool anyP, -- :: (a -> Bool) -> [:a:] -> Bool allP, -- :: (a -> Bool) -> [:a:] -> Bool elemP, -- :: (Eq a) => a -> [:a:] -> Bool notElemP, -- :: (Eq a) => a -> [:a:] -> Bool lookupP, -- :: (Eq a) => a -> [:(a, b):] -> Maybe b sumP, -- :: (Num a) => [:a:] -> a productP, -- :: (Num a) => [:a:] -> a maximumP, -- :: (Ord a) => [:a:] -> a minimumP, -- :: (Ord a) => [:a:] -> a zipP, -- :: [:a:] -> [:b:] -> [:(a, b) :] zip3P, -- :: [:a:] -> [:b:] -> [:c:] -> [:(a, b, c):] zipWithP, -- :: (a -> b -> c) -> [:a:] -> [:b:] -> [:c:] zipWith3P, -- :: (a -> b -> c -> d) -> [:a:]->[:b:]->[:c:]->[:d:] unzipP, -- :: [:(a, b) :] -> ([:a:], [:b:]) unzip3P, -- :: [:(a, b, c):] -> ([:a:], [:b:], [:c:]) -- overloaded functions -- enumFromToP, -- :: Enum a => a -> a -> [:a:] enumFromThenToP, -- :: Enum a => a -> a -> a -> [:a:] -- the following functions are not available on lists -- toP, -- :: [a] -> [:a:] fromP, -- :: [:a:] -> [a] sliceP, -- :: Int -> Int -> [:e:] -> [:e:] foldP, -- :: (e -> e -> e) -> e -> [:e:] -> e fold1P, -- :: (e -> e -> e) -> [:e:] -> e permuteP, -- :: [:Int:] -> [:e:] -> [:e:] bpermuteP, -- :: [:Int:] -> [:e:] -> [:e:] bpermuteDftP, -- :: [:Int:] -> [:e:] -> [:e:] -> [:e:] crossP, -- :: [:a:] -> [:b:] -> [:(a, b):] indexOfP -- :: (a -> Bool) -> [:a:] -> [:Int:] ) where import Prelude import GHC.ST ( ST(..), STRep, runST ) import GHC.Exts ( Int#, Array#, Int(I#), MutableArray#, newArray#, unsafeFreezeArray#, indexArray#, writeArray# ) infixl 9 !: infixr 5 +:+ infix 4 `elemP`, `notElemP` -- representation of parallel arrays -- --------------------------------- -- this rather straight forward implementation maps parallel arrays to the -- internal representation used for standard Haskell arrays in GHC's Prelude -- (EXPORTED ABSTRACTLY) -- -- * This definition *must* be kept in sync with `TysWiredIn.parrTyCon'! -- data [::] e = PArr Int# (Array# e) -- exported operations on parallel arrays -- -------------------------------------- -- operations corresponding to list operations -- mapP :: (a -> b) -> [:a:] -> [:b:] mapP f = fst . loop (mapEFL f) noAL (+:+) :: [:a:] -> [:a:] -> [:a:] a1 +:+ a2 = fst $ loop (mapEFL sel) noAL (enumFromToP 0 (len1 + len2 - 1)) -- we can't use the [:x..y:] form here for tedious -- reasons to do with the typechecker and the fact that -- `enumFromToP' is defined in the same module where len1 = lengthP a1 len2 = lengthP a2 -- sel i | i < len1 = a1!:i | otherwise = a2!:(i - len1) filterP :: (a -> Bool) -> [:a:] -> [:a:] filterP p = fst . loop (filterEFL p) noAL concatP :: [:[:a:]:] -> [:a:] concatP xss = foldlP (+:+) [::] xss concatMapP :: (a -> [:b:]) -> [:a:] -> [:b:] concatMapP f = concatP . mapP f -- head, last, tail, init, -- it's not wise to use them on arrays nullP :: [:a:] -> Bool nullP [::] = True nullP _ = False lengthP :: [:a:] -> Int lengthP (PArr n# _) = I# n# (!:) :: [:a:] -> Int -> a (!:) = indexPArr foldlP :: (a -> b -> a) -> a -> [:b:] -> a foldlP f z = snd . loop (foldEFL (flip f)) z foldl1P :: (a -> a -> a) -> [:a:] -> a foldl1P f [::] = error "Prelude.foldl1P: empty array" foldl1P f a = snd $ loopFromTo 1 (lengthP a - 1) (foldEFL f) (a!:0) a scanlP :: (a -> b -> a) -> a -> [:b:] -> [:a:] scanlP f z = fst . loop (scanEFL (flip f)) z scanl1P :: (a -> a -> a) -> [:a:] -> [:a:] scanl1P f [::] = error "Prelude.scanl1P: empty array" scanl1P f a = fst $ loopFromTo 1 (lengthP a - 1) (scanEFL f) (a!:0) a foldrP :: (a -> b -> b) -> b -> [:a:] -> b foldrP = error "Prelude.foldrP: not implemented yet" -- FIXME foldr1P :: (a -> a -> a) -> [:a:] -> a foldr1P = error "Prelude.foldr1P: not implemented yet" -- FIXME scanrP :: (a -> b -> b) -> b -> [:a:] -> [:b:] scanrP = error "Prelude.scanrP: not implemented yet" -- FIXME scanr1P :: (a -> a -> a) -> [:a:] -> [:a:] scanr1P = error "Prelude.scanr1P: not implemented yet" -- FIXME -- iterate, repeat -- parallel arrays must be finite replicateP :: Int -> a -> [:a:] {-# INLINE replicateP #-} replicateP n e = runST (do marr# <- newArray n e mkPArr n marr#) -- cycle -- parallel arrays must be finite takeP :: Int -> [:a:] -> [:a:] takeP n = sliceP 0 (n - 1) dropP :: Int -> [:a:] -> [:a:] dropP n a = sliceP (n - 1) (lengthP a - 1) a splitAtP :: Int -> [:a:] -> ([:a:],[:a:]) splitAtP n xs = (takeP n xs, dropP n xs) takeWhileP :: (a -> Bool) -> [:a:] -> [:a:] takeWhileP = error "Prelude.takeWhileP: not implemented yet" -- FIXME dropWhileP :: (a -> Bool) -> [:a:] -> [:a:] dropWhileP = error "Prelude.dropWhileP: not implemented yet" -- FIXME spanP :: (a -> Bool) -> [:a:] -> ([:a:], [:a:]) spanP = error "Prelude.spanP: not implemented yet" -- FIXME breakP :: (a -> Bool) -> [:a:] -> ([:a:], [:a:]) breakP p = spanP (not . p) -- lines, words, unlines, unwords, -- is string processing really needed reverseP :: [:a:] -> [:a:] reverseP a = permuteP (enumFromThenToP (len - 1) (len - 2) 0) a -- we can't use the [:x, y..z:] form here for tedious -- reasons to do with the typechecker and the fact that -- `enumFromThenToP' is defined in the same module where len = lengthP a andP :: [:Bool:] -> Bool andP = foldP (&&) True orP :: [:Bool:] -> Bool orP = foldP (||) True anyP :: (a -> Bool) -> [:a:] -> Bool anyP p = orP . mapP p allP :: (a -> Bool) -> [:a:] -> Bool allP p = andP . mapP p elemP :: (Eq a) => a -> [:a:] -> Bool elemP x = anyP (== x) notElemP :: (Eq a) => a -> [:a:] -> Bool notElemP x = allP (/= x) lookupP :: (Eq a) => a -> [:(a, b):] -> Maybe b lookupP = error "Prelude.lookupP: not implemented yet" -- FIXME sumP :: (Num a) => [:a:] -> a sumP = foldP (+) 0 productP :: (Num a) => [:a:] -> a productP = foldP (*) 1 maximumP :: (Ord a) => [:a:] -> a maximumP [::] = error "Prelude.maximumP: empty parallel array" maximumP xs = fold1P max xs minimumP :: (Ord a) => [:a:] -> a minimumP [::] = error "Prelude.minimumP: empty parallel array" minimumP xs = fold1P min xs zipP :: [:a:] -> [:b:] -> [:(a, b):] zipP = zipWithP (,) zip3P :: [:a:] -> [:b:] -> [:c:] -> [:(a, b, c):] zip3P = zipWith3P (,,) zipWithP :: (a -> b -> c) -> [:a:] -> [:b:] -> [:c:] zipWithP f a1 a2 = let len1 = lengthP a1 len2 = lengthP a2 len = len1 `min` len2 in fst $ loopFromTo 0 (len - 1) combine 0 a1 where combine e1 i = (Just $ f e1 (a2!:i), i + 1) zipWith3P :: (a -> b -> c -> d) -> [:a:]->[:b:]->[:c:]->[:d:] zipWith3P f a1 a2 a3 = let len1 = lengthP a1 len2 = lengthP a2 len3 = lengthP a3 len = len1 `min` len2 `min` len3 in fst $ loopFromTo 0 (len - 1) combine 0 a1 where combine e1 i = (Just $ f e1 (a2!:i) (a3!:i), i + 1) unzipP :: [:(a, b):] -> ([:a:], [:b:]) unzipP a = (fst $ loop (mapEFL fst) noAL a, fst $ loop (mapEFL snd) noAL a) -- FIXME: these two functions should be optimised using a tupled custom loop unzip3P :: [:(a, b, c):] -> ([:a:], [:b:], [:c:]) unzip3P a = (fst $ loop (mapEFL fst3) noAL a, fst $ loop (mapEFL snd3) noAL a, fst $ loop (mapEFL trd3) noAL a) where fst3 (a, _, _) = a snd3 (_, b, _) = b trd3 (_, _, c) = c -- instances -- instance Eq a => Eq [:a:] where a1 == a2 | lengthP a1 == lengthP a2 = andP (zipWithP (==) a1 a2) | otherwise = False instance Ord a => Ord [:a:] where compare a1 a2 = case foldlP combineOrdering EQ (zipWithP compare a1 a2) of EQ | lengthP a1 == lengthP a2 -> EQ | lengthP a1 < lengthP a2 -> LT | otherwise -> GT where combineOrdering EQ EQ = EQ combineOrdering EQ other = other combineOrdering other _ = other instance Functor [::] where fmap = mapP instance Monad [::] where m >>= k = foldrP ((+:+) . k ) [::] m m >> k = foldrP ((+:+) . const k) [::] m return x = [:x:] fail _ = [::] instance Show a => Show [:a:] where showsPrec _ = showPArr . fromP where showPArr [] s = "[::]" ++ s showPArr (x:xs) s = "[:" ++ shows x (showPArr' xs s) showPArr' [] s = ":]" ++ s showPArr' (y:ys) s = ',' : shows y (showPArr' ys s) instance Read a => Read [:a:] where readsPrec _ a = [(toP v, rest) | (v, rest) <- readPArr a] where readPArr = readParen False (\r -> do ("[:",s) <- lex r readPArr1 s) readPArr1 s = (do { (":]", t) <- lex s; return ([], t) }) ++ (do { (x, t) <- reads s; (xs, u) <- readPArr2 t; return (x:xs, u) }) readPArr2 s = (do { (":]", t) <- lex s; return ([], t) }) ++ (do { (",", t) <- lex s; (x, u) <- reads t; (xs, v) <- readPArr2 u; return (x:xs, v) }) -- overloaded functions -- -- Ideally, we would like `enumFromToP' and `enumFromThenToP' to be members of -- `Enum'. On the other hand, we really do not want to change `Enum'. Thus, -- for the moment, we hope that the compiler is sufficiently clever to -- properly fuse the following definitions. enumFromToP :: Enum a => a -> a -> [:a:] enumFromToP x y = mapP toEnum (eftInt (fromEnum x) (fromEnum y)) where eftInt x y = scanlP (+) x $ replicateP (y - x + 1) 1 enumFromThenToP :: Enum a => a -> a -> a -> [:a:] enumFromThenToP x y z = mapP toEnum (efttInt (fromEnum x) (fromEnum y) (fromEnum z)) where efttInt x y z = scanlP (+) x $ replicateP (abs (z - x) `div` abs delta + 1) delta where delta = y - x -- the following functions are not available on lists -- -- create an array from a list (EXPORTED) -- toP :: [a] -> [:a:] toP l = fst $ loop store l (replicateP (length l) ()) where store _ (x:xs) = (Just x, xs) -- convert an array to a list (EXPORTED) -- fromP :: [:a:] -> [a] fromP a = [a!:i | i <- [0..lengthP a - 1]] -- cut a subarray out of an array (EXPORTED) -- sliceP :: Int -> Int -> [:e:] -> [:e:] sliceP from to a = fst $ loopFromTo (0 `max` from) (to `min` (lengthP a - 1)) (mapEFL id) noAL a -- parallel folding (EXPORTED) -- -- * the first argument must be associative; otherwise, the result is undefined -- foldP :: (e -> e -> e) -> e -> [:e:] -> e foldP = foldlP -- parallel folding without explicit neutral (EXPORTED) -- -- * the first argument must be associative; otherwise, the result is undefined -- fold1P :: (e -> e -> e) -> [:e:] -> e fold1P = foldl1P -- permute an array according to the permutation vector in the first argument -- (EXPORTED) -- permuteP :: [:Int:] -> [:e:] -> [:e:] permuteP is es = fst $ loop (mapEFL (es!:)) noAL is -- permute an array according to the back-permutation vector in the first -- argument (EXPORTED) -- -- * the permutation vector must represent a surjective function; otherwise, -- the result is undefined -- bpermuteP :: [:Int:] -> [:e:] -> [:e:] bpermuteP is es = error "Prelude.bpermuteP: not implemented yet" -- FIXME -- permute an array according to the back-permutation vector in the first -- argument, which need not be surjective (EXPORTED) -- -- * any elements in the result that are not covered by the back-permutation -- vector assume the value of the corresponding position of the third -- argument -- bpermuteDftP :: [:Int:] -> [:e:] -> [:e:] -> [:e:] bpermuteDftP is es = error "Prelude.bpermuteDftP: not implemented yet"-- FIXME -- computes the cross combination of two arrays (EXPORTED) -- crossP :: [:a:] -> [:b:] -> [:(a, b):] crossP a1 a2 = fst $ loop combine (0, 0) $ replicateP len () where len1 = lengthP a1 len2 = lengthP a2 len = len1 * len2 -- combine _ (i, j) = (Just $ (a1!:i, a2!:j), next) where next | (i + 1) == len1 = (0 , j + 1) | otherwise = (i + 1, j) {- An alternative implementation * The one above is certainly better for flattened code, but here where we are handling boxed arrays, the trade off is less clear. However, I think, the above one is still better. crossP a1 a2 = let len1 = lengthP a1 len2 = lengthP a2 x1 = concatP $ mapP (replicateP len2) a1 x2 = concatP $ replicateP len1 a2 in zipP x1 x2 -} -- computes an index array for all elements of the second argument for which -- the predicate yields `True' (EXPORTED) -- indexOfP :: (a -> Bool) -> [:a:] -> [:Int:] indexOfP p a = fst $ loop calcIdx 0 a where calcIdx e idx | p e = (Just idx, idx + 1) | otherwise = (Nothing , idx ) -- auxiliary functions -- ------------------- -- internally used mutable boxed arrays -- data MPArr s e = MPArr Int# (MutableArray# s e) -- allocate a new mutable array that is pre-initialised with a given value -- newArray :: Int -> e -> ST s (MPArr s e) {-# INLINE newArray #-} newArray (I# n#) e = ST $ \s1# -> case newArray# n# e s1# of { (# s2#, marr# #) -> (# s2#, MPArr n# marr# #)} -- convert a mutable array into the external parallel array representation -- mkPArr :: Int -> MPArr s e -> ST s [:e:] {-# INLINE mkPArr #-} mkPArr (I# n#) (MPArr _ marr#) = ST $ \s1# -> case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) -> (# s2#, PArr n# arr# #) } -- general array iterator -- -- * corresponds to `loopA' from ``Functional Array Fusion'', Chakravarty & -- Keller, ICFP 2001 -- loop :: (e -> acc -> (Maybe e', acc)) -- mapping & folding, once per element -> acc -- initial acc value -> [:e:] -- input array -> ([:e':], acc) {-# INLINE loop #-} loop mf acc arr = loopFromTo 0 (lengthP arr - 1) mf acc arr -- general array iterator with bounds -- loopFromTo :: Int -- from index -> Int -- to index -> (e -> acc -> (Maybe e', acc)) -> acc -> [:e:] -> ([:e':], acc) {-# INLINE loopFromTo #-} loopFromTo from to mf start arr = runST (do marr <- newArray (to - from + 1) noElem (n', acc) <- trans from to marr arr mf start arr <- mkPArr n' marr return (arr, acc)) where noElem = error "PrelPArr.loopFromTo: I do not exist!" -- unlike standard Haskell arrays, this value represents an -- internal error -- actual loop body of `loop' -- -- * for this to be really efficient, it has to be translated with the -- constructor specialisation phase "SpecConstr" switched on; as of GHC 5.03 -- this requires an optimisation level of at least -O2 -- trans :: Int -- index of first elem to process -> Int -- index of last elem to process -> MPArr s e' -- destination array -> [:e:] -- source array -> (e -> acc -> (Maybe e', acc)) -- mutator -> acc -- initial accumulator -> ST s (Int, acc) -- final destination length/final acc {-# INLINE trans #-} trans from to marr arr mf start = trans' from 0 start where trans' arrOff marrOff acc | arrOff > to = return (marrOff, acc) | otherwise = do let (oe', acc') = mf (arr `indexPArr` arrOff) acc marrOff' <- case oe' of Nothing -> return marrOff Just e' -> do writeMPArr marr marrOff e' return $ marrOff + 1 trans' (arrOff + 1) marrOff' acc' -- common patterns for using `loop' -- -- initial value for the accumulator when the accumulator is not needed -- noAL :: () noAL = () -- `loop' mutator maps a function over array elements -- mapEFL :: (e -> e') -> (e -> () -> (Maybe e', ())) {-# INLINE mapEFL #-} mapEFL f = \e a -> (Just $ f e, ()) -- `loop' mutator that filter elements according to a predicate -- filterEFL :: (e -> Bool) -> (e -> () -> (Maybe e, ())) {-# INLINE filterEFL #-} filterEFL p = \e a -> if p e then (Just e, ()) else (Nothing, ()) -- `loop' mutator for array folding -- foldEFL :: (e -> acc -> acc) -> (e -> acc -> (Maybe (), acc)) {-# INLINE foldEFL #-} foldEFL f = \e a -> (Nothing, f e a) -- `loop' mutator for array scanning -- scanEFL :: (e -> acc -> acc) -> (e -> acc -> (Maybe acc, acc)) {-# INLINE scanEFL #-} scanEFL f = \e a -> (Just a, f e a) -- elementary array operations -- -- unlifted array indexing -- indexPArr :: [:e:] -> Int -> e {-# INLINE indexPArr #-} indexPArr (PArr _ arr#) (I# i#) = case indexArray# arr# i# of (# e #) -> e -- encapsulate writing into a mutable array into the `ST' monad -- writeMPArr :: MPArr s e -> Int -> e -> ST s () {-# INLINE writeMPArr #-} writeMPArr (MPArr _ marr#) (I# i#) e = ST $ \s# -> case writeArray# marr# i# e s# of s'# -> (# s'#, () #) hugs98-plus-Sep2006/packages/base/GHC/Pack.lhs0000644006511100651110000000622410504340221017435 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Pack -- Copyright : (c) The University of Glasgow 1997-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- This module provides a small set of low-level functions for packing -- and unpacking a chunk of bytes. Used by code emitted by the compiler -- plus the prelude libraries. -- -- The programmer level view of packed strings is provided by a GHC -- system library PackedString. -- ----------------------------------------------------------------------------- -- #hide module GHC.Pack ( -- (**) - emitted by compiler. packCString#, -- :: [Char] -> ByteArray# (**) unpackCString, unpackCString#, -- :: Addr# -> [Char] (**) unpackNBytes#, -- :: Addr# -> Int# -> [Char] (**) unpackFoldrCString#, -- (**) unpackAppendCString#, -- (**) ) where import GHC.Base import {-# SOURCE #-} GHC.Err ( error ) import GHC.List ( length ) import GHC.ST import GHC.Num import GHC.Ptr data ByteArray ix = ByteArray ix ix ByteArray# data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s) unpackCString :: Ptr a -> [Char] unpackCString a@(Ptr addr) | a == nullPtr = [] | otherwise = unpackCString# addr packCString# :: [Char] -> ByteArray# packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes } packString :: [Char] -> ByteArray Int packString str = runST (packStringST str) packStringST :: [Char] -> ST s (ByteArray Int) packStringST str = let len = length str in packNBytesST len str packNBytesST :: Int -> [Char] -> ST s (ByteArray Int) packNBytesST (I# length#) str = {- allocate an array that will hold the string (not forgetting the NUL byte at the end) -} new_ps_array (length# +# 1#) >>= \ ch_array -> -- fill in packed string from "str" fill_in ch_array 0# str >> -- freeze the puppy: freeze_ps_array ch_array length# where fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s () fill_in arr_in# idx [] = write_ps_array arr_in# idx (chr# 0#) >> return () fill_in arr_in# idx (C# c : cs) = write_ps_array arr_in# idx c >> fill_in arr_in# (idx +# 1#) cs -- (Very :-) ``Specialised'' versions of some CharArray things... new_ps_array :: Int# -> ST s (MutableByteArray s Int) write_ps_array :: MutableByteArray s Int -> Int# -> Char# -> ST s () freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int) new_ps_array size = ST $ \ s -> case (newByteArray# size s) of { (# s2#, barr# #) -> (# s2#, MutableByteArray bot bot barr# #) } where bot = error "new_ps_array" write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# -> case writeCharArray# barr# n ch s# of { s2# -> (# s2#, () #) } -- same as unsafeFreezeByteArray freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# -> case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) -> (# s2#, ByteArray 0 (I# len#) frozen# #) } \end{code} hugs98-plus-Sep2006/packages/base/GHC/Ptr.lhs0000644006511100651110000001205410504340221017322 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Ptr -- Copyright : (c) The FFI Task Force, 2000-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : ffi@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The 'Ptr' and 'FunPtr' types and operations. -- ----------------------------------------------------------------------------- -- #hide module GHC.Ptr where import GHC.Base ------------------------------------------------------------------------ -- Data pointers. data Ptr a = Ptr Addr# deriving (Eq, Ord) -- ^ A value of type @'Ptr' a@ represents a pointer to an object, or an -- array of objects, which may be marshalled to or from Haskell values -- of type @a@. -- -- The type @a@ will often be an instance of class -- 'Foreign.Storable.Storable' which provides the marshalling operations. -- However this is not essential, and you can provide your own operations -- to access the pointer. For example you might write small foreign -- functions to get or set the fields of a C @struct@. -- |The constant 'nullPtr' contains a distinguished value of 'Ptr' -- that is not associated with a valid memory location. nullPtr :: Ptr a nullPtr = Ptr nullAddr# -- |The 'castPtr' function casts a pointer from one type to another. castPtr :: Ptr a -> Ptr b castPtr (Ptr addr) = Ptr addr -- |Advances the given address by the given offset in bytes. plusPtr :: Ptr a -> Int -> Ptr b plusPtr (Ptr addr) (I# d) = Ptr (plusAddr# addr d) -- |Given an arbitrary address and an alignment constraint, -- 'alignPtr' yields the next higher address that fulfills the -- alignment constraint. An alignment constraint @x@ is fulfilled by -- any address divisible by @x@. This operation is idempotent. alignPtr :: Ptr a -> Int -> Ptr a alignPtr addr@(Ptr a) (I# i) = case remAddr# a i of { 0# -> addr; n -> Ptr (plusAddr# a (i -# n)) } -- |Computes the offset required to get from the first to the second -- argument. We have -- -- > p2 == p1 `plusPtr` (p2 `minusPtr` p1) minusPtr :: Ptr a -> Ptr b -> Int minusPtr (Ptr a1) (Ptr a2) = I# (minusAddr# a1 a2) ------------------------------------------------------------------------ -- Function pointers for the default calling convention. data FunPtr a = FunPtr Addr# deriving (Eq, Ord) -- ^ A value of type @'FunPtr' a@ is a pointer to a function callable -- from foreign code. The type @a@ will normally be a /foreign type/, -- a function type with zero or more arguments where -- -- * the argument types are /marshallable foreign types/, -- i.e. 'Char', 'Int', 'Prelude.Double', 'Prelude.Float', -- 'Bool', 'Data.Int.Int8', 'Data.Int.Int16', 'Data.Int.Int32', -- 'Data.Int.Int64', 'Data.Word.Word8', 'Data.Word.Word16', -- 'Data.Word.Word32', 'Data.Word.Word64', @'Ptr' a@, @'FunPtr' a@, -- @'Foreign.StablePtr.StablePtr' a@ or a renaming of any of these -- using @newtype@. -- -- * the return type is either a marshallable foreign type or has the form -- @'Prelude.IO' t@ where @t@ is a marshallable foreign type or @()@. -- -- A value of type @'FunPtr' a@ may be a pointer to a foreign function, -- either returned by another foreign function or imported with a -- a static address import like -- -- > foreign import ccall "stdlib.h &free" -- > p_free :: FunPtr (Ptr a -> IO ()) -- -- or a pointer to a Haskell function created using a /wrapper/ stub -- declared to produce a 'FunPtr' of the correct type. For example: -- -- > type Compare = Int -> Int -> Bool -- > foreign import ccall "wrapper" -- > mkCompare :: Compare -> IO (FunPtr Compare) -- -- Calls to wrapper stubs like @mkCompare@ allocate storage, which -- should be released with 'Foreign.Ptr.freeHaskellFunPtr' when no -- longer required. -- -- To convert 'FunPtr' values to corresponding Haskell functions, one -- can define a /dynamic/ stub for the specific foreign type, e.g. -- -- > type IntFunction = CInt -> IO () -- > foreign import ccall "dynamic" -- > mkFun :: FunPtr IntFunction -> IntFunction -- |The constant 'nullFunPtr' contains a -- distinguished value of 'FunPtr' that is not -- associated with a valid memory location. nullFunPtr :: FunPtr a nullFunPtr = FunPtr nullAddr# -- |Casts a 'FunPtr' to a 'FunPtr' of a different type. castFunPtr :: FunPtr a -> FunPtr b castFunPtr (FunPtr addr) = FunPtr addr -- |Casts a 'FunPtr' to a 'Ptr'. -- -- /Note:/ this is valid only on architectures where data and function -- pointers range over the same set of addresses, and should only be used -- for bindings to external libraries whose interface already relies on -- this assumption. castFunPtrToPtr :: FunPtr a -> Ptr b castFunPtrToPtr (FunPtr addr) = Ptr addr -- |Casts a 'Ptr' to a 'FunPtr'. -- -- /Note:/ this is valid only on architectures where data and function -- pointers range over the same set of addresses, and should only be used -- for bindings to external libraries whose interface already relies on -- this assumption. castPtrToFunPtr :: Ptr a -> FunPtr b castPtrToFunPtr (Ptr addr) = FunPtr addr \end{code} hugs98-plus-Sep2006/packages/base/GHC/Read.lhs0000644006511100651110000005345210504340221017437 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Read -- Copyright : (c) The University of Glasgow, 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The 'Read' class and instances for basic data types. -- ----------------------------------------------------------------------------- -- #hide module GHC.Read ( Read(..) -- class -- ReadS type , ReadS -- :: *; = String -> [(a,String)] -- utility functions , reads -- :: Read a => ReadS a , readp -- :: Read a => ReadP a , readEither -- :: Read a => String -> Either String a , read -- :: Read a => String -> a -- H98 compatibility , lex -- :: ReadS String , lexLitChar -- :: ReadS String , readLitChar -- :: ReadS Char , lexDigits -- :: ReadS String -- defining readers , lexP -- :: ReadPrec Lexeme , paren -- :: ReadPrec a -> ReadPrec a , parens -- :: ReadPrec a -> ReadPrec a , list -- :: ReadPrec a -> ReadPrec [a] , choose -- :: [(String, ReadPrec a)] -> ReadPrec a , readListDefault, readListPrecDefault -- Temporary , readParen ) where import qualified Text.ParserCombinators.ReadP as P import Text.ParserCombinators.ReadP ( ReadP , ReadS , readP_to_S ) import qualified Text.Read.Lex as L -- Lex exports 'lex', which is also defined here, -- hence the qualified import. -- We can't import *anything* unqualified, because that -- confuses Haddock. import Text.ParserCombinators.ReadPrec import Data.Maybe import Data.Either import {-# SOURCE #-} GHC.Err ( error ) #ifndef __HADDOCK__ import {-# SOURCE #-} GHC.Unicode ( isDigit ) #endif import GHC.Num import GHC.Real import GHC.Float import GHC.Show import GHC.Base import GHC.Arr \end{code} \begin{code} -- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with -- parentheses. -- -- @'readParen' 'False' p@ parses what @p@ parses, but optionally -- surrounded with parentheses. readParen :: Bool -> ReadS a -> ReadS a -- A Haskell 98 function readParen b g = if b then mandatory else optional where optional r = g r ++ mandatory r mandatory r = do ("(",s) <- lex r (x,t) <- optional s (")",u) <- lex t return (x,u) \end{code} %********************************************************* %* * \subsection{The @Read@ class} %* * %********************************************************* \begin{code} ------------------------------------------------------------------------ -- class Read -- | Parsing of 'String's, producing values. -- -- Minimal complete definition: 'readsPrec' (or, for GHC only, 'readPrec') -- -- Derived instances of 'Read' make the following assumptions, which -- derived instances of 'Text.Show.Show' obey: -- -- * If the constructor is defined to be an infix operator, then the -- derived 'Read' instance will parse only infix applications of -- the constructor (not the prefix form). -- -- * Associativity is not used to reduce the occurrence of parentheses, -- although precedence may be. -- -- * If the constructor is defined using record syntax, the derived 'Read' -- will parse only the record-syntax form, and furthermore, the fields -- must be given in the same order as the original declaration. -- -- * The derived 'Read' instance allows arbitrary Haskell whitespace -- between tokens of the input string. Extra parentheses are also -- allowed. -- -- For example, given the declarations -- -- > infixr 5 :^: -- > data Tree a = Leaf a | Tree a :^: Tree a -- -- the derived instance of 'Read' in Haskell 98 is equivalent to -- -- > instance (Read a) => Read (Tree a) where -- > -- > readsPrec d r = readParen (d > app_prec) -- > (\r -> [(Leaf m,t) | -- > ("Leaf",s) <- lex r, -- > (m,t) <- readsPrec (app_prec+1) s]) r -- > -- > ++ readParen (d > up_prec) -- > (\r -> [(u:^:v,w) | -- > (u,s) <- readsPrec (up_prec+1) r, -- > (":^:",t) <- lex s, -- > (v,w) <- readsPrec (up_prec+1) t]) r -- > -- > where app_prec = 10 -- > up_prec = 5 -- -- Note that right-associativity of @:^:@ is unused. -- -- The derived instance in GHC is equivalent to -- -- > instance (Read a) => Read (Tree a) where -- > -- > readPrec = parens $ (prec app_prec $ do -- > Ident "Leaf" <- lexP -- > m <- step readPrec -- > return (Leaf m)) -- > -- > +++ (prec up_prec $ do -- > u <- step readPrec -- > Symbol ":^:" <- lexP -- > v <- step readPrec -- > return (u :^: v)) -- > -- > where app_prec = 10 -- > up_prec = 5 -- > -- > readListPrec = readListPrecDefault class Read a where -- | attempts to parse a value from the front of the string, returning -- a list of (parsed value, remaining string) pairs. If there is no -- successful parse, the returned list is empty. -- -- Derived instances of 'Read' and 'Text.Show.Show' satisfy the following: -- -- * @(x,\"\")@ is an element of -- @('readsPrec' d ('Text.Show.showsPrec' d x \"\"))@. -- -- That is, 'readsPrec' parses the string produced by -- 'Text.Show.showsPrec', and delivers the value that -- 'Text.Show.showsPrec' started with. readsPrec :: Int -- ^ the operator precedence of the enclosing -- context (a number from @0@ to @11@). -- Function application has precedence @10@. -> ReadS a -- | The method 'readList' is provided to allow the programmer to -- give a specialised way of parsing lists of values. -- For example, this is used by the predefined 'Read' instance of -- the 'Char' type, where values of type 'String' should be are -- expected to use double quotes, rather than square brackets. readList :: ReadS [a] -- | Proposed replacement for 'readsPrec' using new-style parsers (GHC only). readPrec :: ReadPrec a -- | Proposed replacement for 'readList' using new-style parsers (GHC only). -- The default definition uses 'readList'. Instances that define 'readPrec' -- should also define 'readListPrec' as 'readListPrecDefault'. readListPrec :: ReadPrec [a] -- default definitions readsPrec = readPrec_to_S readPrec readList = readPrec_to_S (list readPrec) 0 readPrec = readS_to_Prec readsPrec readListPrec = readS_to_Prec (\_ -> readList) readListDefault :: Read a => ReadS [a] -- ^ A possible replacement definition for the 'readList' method (GHC only). -- This is only needed for GHC, and even then only for 'Read' instances -- where 'readListPrec' isn't defined as 'readListPrecDefault'. readListDefault = readPrec_to_S readListPrec 0 readListPrecDefault :: Read a => ReadPrec [a] -- ^ A possible replacement definition for the 'readListPrec' method, -- defined using 'readPrec' (GHC only). readListPrecDefault = list readPrec ------------------------------------------------------------------------ -- utility functions -- | equivalent to 'readsPrec' with a precedence of 0. reads :: Read a => ReadS a reads = readsPrec minPrec readp :: Read a => ReadP a readp = readPrec_to_P readPrec minPrec readEither :: Read a => String -> Either String a readEither s = case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of [x] -> Right x [] -> Left "Prelude.read: no parse" _ -> Left "Prelude.read: ambiguous parse" where read' = do x <- readPrec lift P.skipSpaces return x -- | The 'read' function reads input from a string, which must be -- completely consumed by the input process. read :: Read a => String -> a read s = either error id (readEither s) ------------------------------------------------------------------------ -- H98 compatibility -- | The 'lex' function reads a single lexeme from the input, discarding -- initial white space, and returning the characters that constitute the -- lexeme. If the input string contains only white space, 'lex' returns a -- single successful \`lexeme\' consisting of the empty string. (Thus -- @'lex' \"\" = [(\"\",\"\")]@.) If there is no legal lexeme at the -- beginning of the input string, 'lex' fails (i.e. returns @[]@). -- -- This lexer is not completely faithful to the Haskell lexical syntax -- in the following respects: -- -- * Qualified names are not handled properly -- -- * Octal and hexadecimal numerics are not recognized as a single token -- -- * Comments are not treated properly lex :: ReadS String -- As defined by H98 lex s = readP_to_S L.hsLex s -- | Read a string representation of a character, using Haskell -- source-language escape conventions. For example: -- -- > lexLitChar "\\nHello" = [("\\n", "Hello")] -- lexLitChar :: ReadS String -- As defined by H98 lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ; return s }) -- There was a skipSpaces before the P.gather L.lexChar, -- but that seems inconsistent with readLitChar -- | Read a string representation of a character, using Haskell -- source-language escape conventions, and convert it to the character -- that it encodes. For example: -- -- > readLitChar "\\nHello" = [('\n', "Hello")] -- readLitChar :: ReadS Char -- As defined by H98 readLitChar = readP_to_S L.lexChar -- | Reads a non-empty string of decimal digits. lexDigits :: ReadS String lexDigits = readP_to_S (P.munch1 isDigit) ------------------------------------------------------------------------ -- utility parsers lexP :: ReadPrec L.Lexeme -- ^ Parse a single lexeme lexP = lift L.lex paren :: ReadPrec a -> ReadPrec a -- ^ @(paren p)@ parses \"(P0)\" -- where @p@ parses \"P0\" in precedence context zero paren p = do L.Punc "(" <- lexP x <- reset p L.Punc ")" <- lexP return x parens :: ReadPrec a -> ReadPrec a -- ^ @(parens p)@ parses \"P\", \"(P0)\", \"((P0))\", etc, -- where @p@ parses \"P\" in the current precedence context -- and parses \"P0\" in precedence context zero parens p = optional where optional = p +++ mandatory mandatory = paren optional list :: ReadPrec a -> ReadPrec [a] -- ^ @(list p)@ parses a list of things parsed by @p@, -- using the usual square-bracket syntax. list readx = parens ( do L.Punc "[" <- lexP (listRest False +++ listNext) ) where listRest started = do L.Punc c <- lexP case c of "]" -> return [] "," | started -> listNext _ -> pfail listNext = do x <- reset readx xs <- listRest True return (x:xs) choose :: [(String, ReadPrec a)] -> ReadPrec a -- ^ Parse the specified lexeme and continue as specified. -- Esp useful for nullary constructors; e.g. -- @choose [(\"A\", return A), (\"B\", return B)]@ choose sps = foldr ((+++) . try_one) pfail sps where try_one (s,p) = do { L.Ident s' <- lexP ; if s == s' then p else pfail } \end{code} %********************************************************* %* * \subsection{Simple instances of Read} %* * %********************************************************* \begin{code} instance Read Char where readPrec = parens ( do L.Char c <- lexP return c ) readListPrec = parens ( do L.String s <- lexP -- Looks for "foo" return s +++ readListPrecDefault -- Looks for ['f','o','o'] ) -- (more generous than H98 spec) readList = readListDefault instance Read Bool where readPrec = parens ( do L.Ident s <- lexP case s of "True" -> return True "False" -> return False _ -> pfail ) readListPrec = readListPrecDefault readList = readListDefault instance Read Ordering where readPrec = parens ( do L.Ident s <- lexP case s of "LT" -> return LT "EQ" -> return EQ "GT" -> return GT _ -> pfail ) readListPrec = readListPrecDefault readList = readListDefault \end{code} %********************************************************* %* * \subsection{Structure instances of Read: Maybe, List etc} %* * %********************************************************* For structured instances of Read we start using the precedences. The idea is then that 'parens (prec k p)' will fail immediately when trying to parse it in a context with a higher precedence level than k. But if there is one parenthesis parsed, then the required precedence level drops to 0 again, and parsing inside p may succeed. 'appPrec' is just the precedence level of function application. So, if we are parsing function application, we'd better require the precedence level to be at least 'appPrec'. Otherwise, we have to put parentheses around it. 'step' is used to increase the precedence levels inside a parser, and can be used to express left- or right- associativity. For example, % is defined to be left associative, so we only increase precedence on the right hand side. Note how step is used in for example the Maybe parser to increase the precedence beyond appPrec, so that basically only literals and parenthesis-like objects such as (...) and [...] can be an argument to 'Just'. \begin{code} instance Read a => Read (Maybe a) where readPrec = parens (do L.Ident "Nothing" <- lexP return Nothing +++ prec appPrec ( do L.Ident "Just" <- lexP x <- step readPrec return (Just x)) ) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b) => Read (Either a b) where readPrec = parens ( prec appPrec ( do L.Ident "Left" <- lexP x <- step readPrec return (Left x) +++ do L.Ident "Right" <- lexP y <- step readPrec return (Right y) ) ) readListPrec = readListPrecDefault readList = readListDefault instance Read a => Read [a] where readPrec = readListPrec readListPrec = readListPrecDefault readList = readListDefault instance (Ix a, Read a, Read b) => Read (Array a b) where readPrec = parens $ prec appPrec $ do L.Ident "array" <- lexP bounds <- step readPrec vals <- step readPrec return (array bounds vals) readListPrec = readListPrecDefault readList = readListDefault instance Read L.Lexeme where readPrec = lexP readListPrec = readListPrecDefault readList = readListDefault \end{code} %********************************************************* %* * \subsection{Numeric instances of Read} %* * %********************************************************* \begin{code} readNumber :: Num a => (L.Lexeme -> Maybe a) -> ReadPrec a -- Read a signed number readNumber convert = parens ( do x <- lexP case x of L.Symbol "-" -> do n <- readNumber convert return (negate n) _ -> case convert x of Just n -> return n Nothing -> pfail ) convertInt :: Num a => L.Lexeme -> Maybe a convertInt (L.Int i) = Just (fromInteger i) convertInt _ = Nothing convertFrac :: Fractional a => L.Lexeme -> Maybe a convertFrac (L.Int i) = Just (fromInteger i) convertFrac (L.Rat r) = Just (fromRational r) convertFrac _ = Nothing instance Read Int where readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault instance Read Integer where readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault instance Read Float where readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault instance Read Double where readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault instance (Integral a, Read a) => Read (Ratio a) where readPrec = parens ( prec ratioPrec ( do x <- step readPrec L.Symbol "%" <- lexP y <- step readPrec return (x % y) ) ) readListPrec = readListPrecDefault readList = readListDefault \end{code} %********************************************************* %* * Tuple instances of Read, up to size 15 %* * %********************************************************* \begin{code} instance Read () where readPrec = parens ( paren ( return () ) ) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b) => Read (a,b) where readPrec = wrap_tup read_tup2 readListPrec = readListPrecDefault readList = readListDefault wrap_tup :: ReadPrec a -> ReadPrec a wrap_tup p = parens (paren p) read_comma :: ReadPrec () read_comma = do { L.Punc "," <- lexP; return () } read_tup2 :: (Read a, Read b) => ReadPrec (a,b) -- Reads "a , b" no parens! read_tup2 = do x <- readPrec read_comma y <- readPrec return (x,y) read_tup4 :: (Read a, Read b, Read c, Read d) => ReadPrec (a,b,c,d) read_tup4 = do (a,b) <- read_tup2 read_comma (c,d) <- read_tup2 return (a,b,c,d) read_tup8 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) => ReadPrec (a,b,c,d,e,f,g,h) read_tup8 = do (a,b,c,d) <- read_tup4 read_comma (e,f,g,h) <- read_tup4 return (a,b,c,d,e,f,g,h) instance (Read a, Read b, Read c) => Read (a, b, c) where readPrec = wrap_tup (do { (a,b) <- read_tup2; read_comma ; c <- readPrec ; return (a,b,c) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where readPrec = wrap_tup read_tup4 readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma ; e <- readPrec ; return (a,b,c,d,e) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f) => Read (a, b, c, d, e, f) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma ; (e,f) <- read_tup2 ; return (a,b,c,d,e,f) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) => Read (a, b, c, d, e, f, g) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma ; (e,f) <- read_tup2; read_comma ; g <- readPrec ; return (a,b,c,d,e,f,g) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) => Read (a, b, c, d, e, f, g, h) where readPrec = wrap_tup read_tup8 readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i) => Read (a, b, c, d, e, f, g, h, i) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; i <- readPrec ; return (a,b,c,d,e,f,g,h,i) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j) => Read (a, b, c, d, e, f, g, h, i, j) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j) <- read_tup2 ; return (a,b,c,d,e,f,g,h,i,j) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k) => Read (a, b, c, d, e, f, g, h, i, j, k) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j) <- read_tup2; read_comma ; k <- readPrec ; return (a,b,c,d,e,f,g,h,i,j,k) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l) => Read (a, b, c, d, e, f, g, h, i, j, k, l) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j,k,l) <- read_tup4 ; return (a,b,c,d,e,f,g,h,i,j,k,l) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j,k,l) <- read_tup4; read_comma ; m <- readPrec ; return (a,b,c,d,e,f,g,h,i,j,k,l,m) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m, Read n) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j,k,l) <- read_tup4; read_comma ; (m,n) <- read_tup2 ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m, Read n, Read o) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j,k,l) <- read_tup4; read_comma ; (m,n) <- read_tup2; read_comma ; o <- readPrec ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) }) readListPrec = readListPrecDefault readList = readListDefault \end{code} hugs98-plus-Sep2006/packages/base/GHC/Real.lhs0000644006511100651110000003323210504340221017441 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Real -- Copyright : (c) The FFI Task Force, 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The types 'Ratio' and 'Rational', and the classes 'Real', 'Fractional', -- 'Integral', and 'RealFrac'. -- ----------------------------------------------------------------------------- -- #hide module GHC.Real where import {-# SOURCE #-} GHC.Err import GHC.Base import GHC.Num import GHC.List import GHC.Enum import GHC.Show infixr 8 ^, ^^ infixl 7 /, `quot`, `rem`, `div`, `mod` infixl 7 % default () -- Double isn't available yet, -- and we shouldn't be using defaults anyway \end{code} %********************************************************* %* * \subsection{The @Ratio@ and @Rational@ types} %* * %********************************************************* \begin{code} -- | Rational numbers, with numerator and denominator of some 'Integral' type. data (Integral a) => Ratio a = !a :% !a deriving (Eq) -- | Arbitrary-precision rational numbers, represented as a ratio of -- two 'Integer' values. A rational number may be constructed using -- the '%' operator. type Rational = Ratio Integer ratioPrec, ratioPrec1 :: Int ratioPrec = 7 -- Precedence of ':%' constructor ratioPrec1 = ratioPrec + 1 infinity, notANumber :: Rational infinity = 1 :% 0 notANumber = 0 :% 0 -- Use :%, not % for Inf/NaN; the latter would -- immediately lead to a runtime error, because it normalises. \end{code} \begin{code} -- | Forms the ratio of two integral numbers. {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-} (%) :: (Integral a) => a -> a -> Ratio a -- | Extract the numerator of the ratio in reduced form: -- the numerator and denominator have no common factor and the denominator -- is positive. numerator :: (Integral a) => Ratio a -> a -- | Extract the denominator of the ratio in reduced form: -- the numerator and denominator have no common factor and the denominator -- is positive. denominator :: (Integral a) => Ratio a -> a \end{code} \tr{reduce} is a subsidiary function used only in this module . It normalises a ratio by dividing both numerator and denominator by their greatest common divisor. \begin{code} reduce :: (Integral a) => a -> a -> Ratio a {-# SPECIALISE reduce :: Integer -> Integer -> Rational #-} reduce _ 0 = error "Ratio.%: zero denominator" reduce x y = (x `quot` d) :% (y `quot` d) where d = gcd x y \end{code} \begin{code} x % y = reduce (x * signum y) (abs y) numerator (x :% _) = x denominator (_ :% y) = y \end{code} %********************************************************* %* * \subsection{Standard numeric classes} %* * %********************************************************* \begin{code} class (Num a, Ord a) => Real a where -- | the rational equivalent of its real argument with full precision toRational :: a -> Rational -- | Integral numbers, supporting integer division. -- -- Minimal complete definition: 'quotRem' and 'toInteger' class (Real a, Enum a) => Integral a where -- | integer division truncated toward zero quot :: a -> a -> a -- | integer remainder, satisfying -- -- > (x `quot` y)*y + (x `rem` y) == x rem :: a -> a -> a -- | integer division truncated toward negative infinity div :: a -> a -> a -- | integer modulus, satisfying -- -- > (x `div` y)*y + (x `mod` y) == x mod :: a -> a -> a -- | simultaneous 'quot' and 'rem' quotRem :: a -> a -> (a,a) -- | simultaneous 'div' and 'mod' divMod :: a -> a -> (a,a) -- | conversion to 'Integer' toInteger :: a -> Integer n `quot` d = q where (q,_) = quotRem n d n `rem` d = r where (_,r) = quotRem n d n `div` d = q where (q,_) = divMod n d n `mod` d = r where (_,r) = divMod n d divMod n d = if signum r == negate (signum d) then (q-1, r+d) else qr where qr@(q,r) = quotRem n d -- | Fractional numbers, supporting real division. -- -- Minimal complete definition: 'fromRational' and ('recip' or @('/')@) class (Num a) => Fractional a where -- | fractional division (/) :: a -> a -> a -- | reciprocal fraction recip :: a -> a -- | Conversion from a 'Rational' (that is @'Ratio' 'Integer'@). -- A floating literal stands for an application of 'fromRational' -- to a value of type 'Rational', so such literals have type -- @('Fractional' a) => a@. fromRational :: Rational -> a recip x = 1 / x x / y = x * recip y -- | Extracting components of fractions. -- -- Minimal complete definition: 'properFraction' class (Real a, Fractional a) => RealFrac a where -- | The function 'properFraction' takes a real fractional number @x@ -- and returns a pair @(n,f)@ such that @x = n+f@, and: -- -- * @n@ is an integral number with the same sign as @x@; and -- -- * @f@ is a fraction with the same type and sign as @x@, -- and with absolute value less than @1@. -- -- The default definitions of the 'ceiling', 'floor', 'truncate' -- and 'round' functions are in terms of 'properFraction'. properFraction :: (Integral b) => a -> (b,a) -- | @'truncate' x@ returns the integer nearest @x@ between zero and @x@ truncate :: (Integral b) => a -> b -- | @'round' x@ returns the nearest integer to @x@ round :: (Integral b) => a -> b -- | @'ceiling' x@ returns the least integer not less than @x@ ceiling :: (Integral b) => a -> b -- | @'floor' x@ returns the greatest integer not greater than @x@ floor :: (Integral b) => a -> b truncate x = m where (m,_) = properFraction x round x = let (n,r) = properFraction x m = if r < 0 then n - 1 else n + 1 in case signum (abs r - 0.5) of -1 -> n 0 -> if even n then n else m 1 -> m ceiling x = if r > 0 then n + 1 else n where (n,r) = properFraction x floor x = if r < 0 then n - 1 else n where (n,r) = properFraction x \end{code} These 'numeric' enumerations come straight from the Report \begin{code} numericEnumFrom :: (Fractional a) => a -> [a] numericEnumFrom = iterate (+1) numericEnumFromThen :: (Fractional a) => a -> a -> [a] numericEnumFromThen n m = iterate (+(m-n)) n numericEnumFromTo :: (Ord a, Fractional a) => a -> a -> [a] numericEnumFromTo n m = takeWhile (<= m + 1/2) (numericEnumFrom n) numericEnumFromThenTo :: (Ord a, Fractional a) => a -> a -> a -> [a] numericEnumFromThenTo e1 e2 e3 = takeWhile pred (numericEnumFromThen e1 e2) where mid = (e2 - e1) / 2 pred | e2 >= e1 = (<= e3 + mid) | otherwise = (>= e3 + mid) \end{code} %********************************************************* %* * \subsection{Instances for @Int@} %* * %********************************************************* \begin{code} instance Real Int where toRational x = toInteger x % 1 instance Integral Int where toInteger i = int2Integer i -- give back a full-blown Integer a `quot` 0 = divZeroError a `quot` b = a `quotInt` b a `rem` 0 = divZeroError a `rem` b = a `remInt` b a `div` 0 = divZeroError a `div` b = a `divInt` b a `mod` 0 = divZeroError a `mod` b = a `modInt` b a `quotRem` 0 = divZeroError a `quotRem` b = a `quotRemInt` b a `divMod` 0 = divZeroError a `divMod` b = a `divModInt` b \end{code} %********************************************************* %* * \subsection{Instances for @Integer@} %* * %********************************************************* \begin{code} instance Real Integer where toRational x = x % 1 instance Integral Integer where toInteger n = n a `quot` 0 = divZeroError n `quot` d = n `quotInteger` d a `rem` 0 = divZeroError n `rem` d = n `remInteger` d a `divMod` 0 = divZeroError a `divMod` b = a `divModInteger` b a `quotRem` 0 = divZeroError a `quotRem` b = a `quotRemInteger` b -- use the defaults for div & mod \end{code} %********************************************************* %* * \subsection{Instances for @Ratio@} %* * %********************************************************* \begin{code} instance (Integral a) => Ord (Ratio a) where {-# SPECIALIZE instance Ord Rational #-} (x:%y) <= (x':%y') = x * y' <= x' * y (x:%y) < (x':%y') = x * y' < x' * y instance (Integral a) => Num (Ratio a) where {-# SPECIALIZE instance Num Rational #-} (x:%y) + (x':%y') = reduce (x*y' + x'*y) (y*y') (x:%y) - (x':%y') = reduce (x*y' - x'*y) (y*y') (x:%y) * (x':%y') = reduce (x * x') (y * y') negate (x:%y) = (-x) :% y abs (x:%y) = abs x :% y signum (x:%_) = signum x :% 1 fromInteger x = fromInteger x :% 1 instance (Integral a) => Fractional (Ratio a) where {-# SPECIALIZE instance Fractional Rational #-} (x:%y) / (x':%y') = (x*y') % (y*x') recip (x:%y) = y % x fromRational (x:%y) = fromInteger x :% fromInteger y instance (Integral a) => Real (Ratio a) where {-# SPECIALIZE instance Real Rational #-} toRational (x:%y) = toInteger x :% toInteger y instance (Integral a) => RealFrac (Ratio a) where {-# SPECIALIZE instance RealFrac Rational #-} properFraction (x:%y) = (fromInteger (toInteger q), r:%y) where (q,r) = quotRem x y instance (Integral a) => Show (Ratio a) where {-# SPECIALIZE instance Show Rational #-} showsPrec p (x:%y) = showParen (p > ratioPrec) $ showsPrec ratioPrec1 x . showString "%" . -- H98 report has spaces round the % -- but we removed them [May 04] showsPrec ratioPrec1 y instance (Integral a) => Enum (Ratio a) where {-# SPECIALIZE instance Enum Rational #-} succ x = x + 1 pred x = x - 1 toEnum n = fromInteger (int2Integer n) :% 1 fromEnum = fromInteger . truncate enumFrom = numericEnumFrom enumFromThen = numericEnumFromThen enumFromTo = numericEnumFromTo enumFromThenTo = numericEnumFromThenTo \end{code} %********************************************************* %* * \subsection{Coercions} %* * %********************************************************* \begin{code} -- | general coercion from integral types fromIntegral :: (Integral a, Num b) => a -> b fromIntegral = fromInteger . toInteger {-# RULES "fromIntegral/Int->Int" fromIntegral = id :: Int -> Int #-} -- | general coercion to fractional types realToFrac :: (Real a, Fractional b) => a -> b realToFrac = fromRational . toRational {-# RULES "realToFrac/Int->Int" realToFrac = id :: Int -> Int #-} \end{code} %********************************************************* %* * \subsection{Overloaded numeric functions} %* * %********************************************************* \begin{code} -- | Converts a possibly-negative 'Real' value to a string. showSigned :: (Real a) => (a -> ShowS) -- ^ a function that can show unsigned values -> Int -- ^ the precedence of the enclosing context -> a -- ^ the value to show -> ShowS showSigned showPos p x | x < 0 = showParen (p > 6) (showChar '-' . showPos (-x)) | otherwise = showPos x even, odd :: (Integral a) => a -> Bool even n = n `rem` 2 == 0 odd = not . even ------------------------------------------------------- -- | raise a number to a non-negative integral power {-# SPECIALISE (^) :: Integer -> Integer -> Integer, Integer -> Int -> Integer, Int -> Int -> Int #-} (^) :: (Num a, Integral b) => a -> b -> a _ ^ 0 = 1 x ^ n | n > 0 = f x (n-1) x where f _ 0 y = y f a d y = g a d where g b i | even i = g (b*b) (i `quot` 2) | otherwise = f b (i-1) (b*y) _ ^ _ = error "Prelude.^: negative exponent" -- | raise a number to an integral power {-# SPECIALISE (^^) :: Rational -> Int -> Rational #-} (^^) :: (Fractional a, Integral b) => a -> b -> a x ^^ n = if n >= 0 then x^n else recip (x^(negate n)) ------------------------------------------------------- -- | @'gcd' x y@ is the greatest (positive) integer that divides both @x@ -- and @y@; for example @'gcd' (-3) 6@ = @3@, @'gcd' (-3) (-6)@ = @3@, -- @'gcd' 0 4@ = @4@. @'gcd' 0 0@ raises a runtime error. gcd :: (Integral a) => a -> a -> a gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined" gcd x y = gcd' (abs x) (abs y) where gcd' a 0 = a gcd' a b = gcd' b (a `rem` b) -- | @'lcm' x y@ is the smallest positive integer that both @x@ and @y@ divide. lcm :: (Integral a) => a -> a -> a {-# SPECIALISE lcm :: Int -> Int -> Int #-} lcm _ 0 = 0 lcm 0 _ = 0 lcm x y = abs ((x `quot` (gcd x y)) * y) {-# RULES "gcd/Int->Int->Int" gcd = gcdInt "gcd/Integer->Integer->Integer" gcd = gcdInteger "lcm/Integer->Integer->Integer" lcm = lcmInteger #-} integralEnumFrom :: (Integral a, Bounded a) => a -> [a] integralEnumFrom n = map fromInteger [toInteger n .. toInteger (maxBound `asTypeOf` n)] integralEnumFromThen :: (Integral a, Bounded a) => a -> a -> [a] integralEnumFromThen n1 n2 | i_n2 >= i_n1 = map fromInteger [i_n1, i_n2 .. toInteger (maxBound `asTypeOf` n1)] | otherwise = map fromInteger [i_n1, i_n2 .. toInteger (minBound `asTypeOf` n1)] where i_n1 = toInteger n1 i_n2 = toInteger n2 integralEnumFromTo :: Integral a => a -> a -> [a] integralEnumFromTo n m = map fromInteger [toInteger n .. toInteger m] integralEnumFromThenTo :: Integral a => a -> a -> a -> [a] integralEnumFromThenTo n1 n2 m = map fromInteger [toInteger n1, toInteger n2 .. toInteger m] \end{code} hugs98-plus-Sep2006/packages/base/GHC/ST.lhs0000644006511100651110000001135210504340221017103 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.ST -- Copyright : (c) The University of Glasgow, 1992-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The 'ST' Monad. -- ----------------------------------------------------------------------------- -- #hide module GHC.ST where import GHC.Base import GHC.Show import GHC.Num default () \end{code} %********************************************************* %* * \subsection{The @ST@ monad} %* * %********************************************************* The state-transformer monad proper. By default the monad is strict; too many people got bitten by space leaks when it was lazy. \begin{code} -- | The strict state-transformer monad. -- A computation of type @'ST' s a@ transforms an internal state indexed -- by @s@, and returns a value of type @a@. -- The @s@ parameter is either -- -- * an uninstantiated type variable (inside invocations of 'runST'), or -- -- * 'RealWorld' (inside invocations of 'Control.Monad.ST.stToIO'). -- -- It serves to keep the internal states of different invocations -- of 'runST' separate from each other and from invocations of -- 'Control.Monad.ST.stToIO'. -- -- The '>>=' and '>>' operations are strict in the state (though not in -- values stored in the state). For example, -- -- @'runST' (writeSTRef _|_ v >>= f) = _|_@ newtype ST s a = ST (STRep s a) type STRep s a = State# s -> (# State# s, a #) instance Functor (ST s) where fmap f (ST m) = ST $ \ s -> case (m s) of { (# new_s, r #) -> (# new_s, f r #) } instance Monad (ST s) where {-# INLINE return #-} {-# INLINE (>>) #-} {-# INLINE (>>=) #-} return x = ST (\ s -> (# s, x #)) m >> k = m >>= \ _ -> k (ST m) >>= k = ST (\ s -> case (m s) of { (# new_s, r #) -> case (k r) of { ST k2 -> (k2 new_s) }}) data STret s a = STret (State# s) a -- liftST is useful when we want a lifted result from an ST computation. See -- fixST below. liftST :: ST s a -> State# s -> STret s a liftST (ST m) = \s -> case m s of (# s', r #) -> STret s' r {-# NOINLINE unsafeInterleaveST #-} unsafeInterleaveST :: ST s a -> ST s a unsafeInterleaveST (ST m) = ST ( \ s -> let r = case m s of (# _, res #) -> res in (# s, r #) ) -- | Allow the result of a state transformer computation to be used (lazily) -- inside the computation. -- Note that if @f@ is strict, @'fixST' f = _|_@. fixST :: (a -> ST s a) -> ST s a fixST k = ST $ \ s -> let ans = liftST (k r) s STret _ r = ans in case ans of STret s' x -> (# s', x #) instance Show (ST s a) where showsPrec _ _ = showString "<>" showList = showList__ (showsPrec 0) \end{code} Definition of runST ~~~~~~~~~~~~~~~~~~~ SLPJ 95/04: Why @runST@ must not have an unfolding; consider: \begin{verbatim} f x = runST ( \ s -> let (a, s') = newArray# 100 [] s (_, s'') = fill_in_array_or_something a x s' in freezeArray# a s'' ) \end{verbatim} If we inline @runST@, we'll get: \begin{verbatim} f x = let (a, s') = newArray# 100 [] realWorld#{-NB-} (_, s'') = fill_in_array_or_something a x s' in freezeArray# a s'' \end{verbatim} And now the @newArray#@ binding can be floated to become a CAF, which is totally and utterly wrong: \begin{verbatim} f = let (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!! in \ x -> let (_, s'') = fill_in_array_or_something a x s' in freezeArray# a s'' \end{verbatim} All calls to @f@ will share a {\em single} array! End SLPJ 95/04. \begin{code} {-# INLINE runST #-} -- The INLINE prevents runSTRep getting inlined in *this* module -- so that it is still visible when runST is inlined in an importing -- module. Regrettably delicate. runST is behaving like a wrapper. -- | Return the value computed by a state transformer computation. -- The @forall@ ensures that the internal state used by the 'ST' -- computation is inaccessible to the rest of the program. runST :: (forall s. ST s a) -> a runST st = runSTRep (case st of { ST st_rep -> st_rep }) -- I'm only letting runSTRep be inlined right at the end, in particular *after* full laziness -- That's what the "INLINE [0]" says. -- SLPJ Apr 99 -- {-# INLINE [0] runSTRep #-} -- SDM: further to the above, inline phase 0 is run *before* -- full-laziness at the moment, which means that the above comment is -- invalid. Inlining runSTRep doesn't make a huge amount of -- difference, anyway. Hence: {-# NOINLINE runSTRep #-} runSTRep :: (forall s. STRep s a) -> a runSTRep st_rep = case st_rep realWorld# of (# _, r #) -> r \end{code} hugs98-plus-Sep2006/packages/base/GHC/STRef.lhs0000644006511100651110000000254710504340221017546 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.STRef -- Copyright : (c) The University of Glasgow, 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- References in the 'ST' monad. -- ----------------------------------------------------------------------------- -- #hide module GHC.STRef where import GHC.ST import GHC.Base data STRef s a = STRef (MutVar# s a) -- ^ a value of type @STRef s a@ is a mutable variable in state thread @s@, -- containing a value of type @a@ -- |Build a new 'STRef' in the current state thread newSTRef :: a -> ST s (STRef s a) newSTRef init = ST $ \s1# -> case newMutVar# init s1# of { (# s2#, var# #) -> (# s2#, STRef var# #) } -- |Read the value of an 'STRef' readSTRef :: STRef s a -> ST s a readSTRef (STRef var#) = ST $ \s1# -> readMutVar# var# s1# -- |Write a new value into an 'STRef' writeSTRef :: STRef s a -> a -> ST s () writeSTRef (STRef var#) val = ST $ \s1# -> case writeMutVar# var# val s1# of { s2# -> (# s2#, () #) } -- Just pointer equality on mutable references: instance Eq (STRef s a) where STRef v1# == STRef v2# = sameMutVar# v1# v2# \end{code} hugs98-plus-Sep2006/packages/base/GHC/Show.lhs0000644006511100651110000003524110504340222017501 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Show -- Copyright : (c) The University of Glasgow, 1992-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The 'Show' class, and related operations. -- ----------------------------------------------------------------------------- -- #hide module GHC.Show ( Show(..), ShowS, -- Instances for Show: (), [], Bool, Ordering, Int, Char -- Show support code shows, showChar, showString, showParen, showList__, showSpace, showLitChar, protectEsc, intToDigit, showSignedInt, appPrec, appPrec1, -- Character operations asciiTab, ) where import GHC.Base import Data.Maybe import Data.Either import GHC.List ( (!!), foldr1 #ifdef USE_REPORT_PRELUDE , concatMap #endif ) \end{code} %********************************************************* %* * \subsection{The @Show@ class} %* * %********************************************************* \begin{code} -- | The @shows@ functions return a function that prepends the -- output 'String' to an existing 'String'. This allows constant-time -- concatenation of results using function composition. type ShowS = String -> String -- | Conversion of values to readable 'String's. -- -- Minimal complete definition: 'showsPrec' or 'show'. -- -- Derived instances of 'Show' have the following properties, which -- are compatible with derived instances of 'Text.Read.Read': -- -- * The result of 'show' is a syntactically correct Haskell -- expression containing only constants, given the fixity -- declarations in force at the point where the type is declared. -- It contains only the constructor names defined in the data type, -- parentheses, and spaces. When labelled constructor fields are -- used, braces, commas, field names, and equal signs are also used. -- -- * If the constructor is defined to be an infix operator, then -- 'showsPrec' will produce infix applications of the constructor. -- -- * the representation will be enclosed in parentheses if the -- precedence of the top-level constructor in @x@ is less than @d@ -- (associativity is ignored). Thus, if @d@ is @0@ then the result -- is never surrounded in parentheses; if @d@ is @11@ it is always -- surrounded in parentheses, unless it is an atomic expression. -- -- * If the constructor is defined using record syntax, then 'show' -- will produce the record-syntax form, with the fields given in the -- same order as the original declaration. -- -- For example, given the declarations -- -- > infixr 5 :^: -- > data Tree a = Leaf a | Tree a :^: Tree a -- -- the derived instance of 'Show' is equivalent to -- -- > instance (Show a) => Show (Tree a) where -- > -- > showsPrec d (Leaf m) = showParen (d > app_prec) $ -- > showString "Leaf " . showsPrec (app_prec+1) m -- > where app_prec = 10 -- > -- > showsPrec d (u :^: v) = showParen (d > up_prec) $ -- > showsPrec (up_prec+1) u . -- > showString " :^: " . -- > showsPrec (up_prec+1) v -- > where up_prec = 5 -- -- Note that right-associativity of @:^:@ is ignored. For example, -- -- * @'show' (Leaf 1 :^: Leaf 2 :^: Leaf 3)@ produces the string -- @\"Leaf 1 :^: (Leaf 2 :^: Leaf 3)\"@. class Show a where -- | Convert a value to a readable 'String'. -- -- 'showsPrec' should satisfy the law -- -- > showsPrec d x r ++ s == showsPrec d x (r ++ s) -- -- Derived instances of 'Text.Read.Read' and 'Show' satisfy the following: -- -- * @(x,\"\")@ is an element of -- @('Text.Read.readsPrec' d ('showsPrec' d x \"\"))@. -- -- That is, 'Text.Read.readsPrec' parses the string produced by -- 'showsPrec', and delivers the value that 'showsPrec' started with. showsPrec :: Int -- ^ the operator precedence of the enclosing -- context (a number from @0@ to @11@). -- Function application has precedence @10@. -> a -- ^ the value to be converted to a 'String' -> ShowS -- | A specialised variant of 'showsPrec', using precedence context -- zero, and returning an ordinary 'String'. show :: a -> String -- | The method 'showList' is provided to allow the programmer to -- give a specialised way of showing lists of values. -- For example, this is used by the predefined 'Show' instance of -- the 'Char' type, where values of type 'String' should be shown -- in double quotes, rather than between square brackets. showList :: [a] -> ShowS showsPrec _ x s = show x ++ s show x = shows x "" showList ls s = showList__ shows ls s showList__ :: (a -> ShowS) -> [a] -> ShowS showList__ _ [] s = "[]" ++ s showList__ showx (x:xs) s = '[' : showx x (showl xs) where showl [] = ']' : s showl (y:ys) = ',' : showx y (showl ys) appPrec, appPrec1 :: Int -- Use unboxed stuff because we don't have overloaded numerics yet appPrec = I# 10# -- Precedence of application: -- one more than the maximum operator precedence of 9 appPrec1 = I# 11# -- appPrec + 1 \end{code} %********************************************************* %* * \subsection{Simple Instances} %* * %********************************************************* \begin{code} instance Show () where showsPrec _ () = showString "()" instance Show a => Show [a] where showsPrec _ = showList instance Show Bool where showsPrec _ True = showString "True" showsPrec _ False = showString "False" instance Show Ordering where showsPrec _ LT = showString "LT" showsPrec _ EQ = showString "EQ" showsPrec _ GT = showString "GT" instance Show Char where showsPrec _ '\'' = showString "'\\''" showsPrec _ c = showChar '\'' . showLitChar c . showChar '\'' showList cs = showChar '"' . showl cs where showl "" s = showChar '"' s showl ('"':xs) s = showString "\\\"" (showl xs s) showl (x:xs) s = showLitChar x (showl xs s) -- Making 's' an explicit parameter makes it clear to GHC -- that showl has arity 2, which avoids it allocating an extra lambda -- The sticking point is the recursive call to (showl xs), which -- it can't figure out would be ok with arity 2. instance Show Int where showsPrec = showSignedInt instance Show a => Show (Maybe a) where showsPrec _p Nothing s = showString "Nothing" s showsPrec p (Just x) s = (showParen (p > appPrec) $ showString "Just " . showsPrec appPrec1 x) s instance (Show a, Show b) => Show (Either a b) where showsPrec p e s = (showParen (p > appPrec) $ case e of Left a -> showString "Left " . showsPrec appPrec1 a Right b -> showString "Right " . showsPrec appPrec1 b) s \end{code} %********************************************************* %* * \subsection{Show instances for the first few tuples %* * %********************************************************* \begin{code} -- The explicit 's' parameters are important -- Otherwise GHC thinks that "shows x" might take a lot of work to compute -- and generates defns like -- showsPrec _ (x,y) = let sx = shows x; sy = shows y in -- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s)))) instance (Show a, Show b) => Show (a,b) where showsPrec _ (a,b) s = show_tuple [shows a, shows b] s instance (Show a, Show b, Show c) => Show (a, b, c) where showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) => Show (a,b,c,d,e,f,g) where showsPrec _ (a,b,c,d,e,f,g) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) => Show (a,b,c,d,e,f,g,h) where showsPrec _ (a,b,c,d,e,f,g,h) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) => Show (a,b,c,d,e,f,g,h,i) where showsPrec _ (a,b,c,d,e,f,g,h,i) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j) => Show (a,b,c,d,e,f,g,h,i,j) where showsPrec _ (a,b,c,d,e,f,g,h,i,j) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k) => Show (a,b,c,d,e,f,g,h,i,j,k) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l) => Show (a,b,c,d,e,f,g,h,i,j,k,l) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m) => Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l, shows m] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n) => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l, shows m, shows n] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n, Show o) => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l, shows m, shows n, shows o] s show_tuple :: [ShowS] -> ShowS show_tuple ss = showChar '(' . foldr1 (\s r -> s . showChar ',' . r) ss . showChar ')' \end{code} %********************************************************* %* * \subsection{Support code for @Show@} %* * %********************************************************* \begin{code} -- | equivalent to 'showsPrec' with a precedence of 0. shows :: (Show a) => a -> ShowS shows = showsPrec zeroInt -- | utility function converting a 'Char' to a show function that -- simply prepends the character unchanged. showChar :: Char -> ShowS showChar = (:) -- | utility function converting a 'String' to a show function that -- simply prepends the string unchanged. showString :: String -> ShowS showString = (++) -- | utility function that surrounds the inner show function with -- parentheses when the 'Bool' parameter is 'True'. showParen :: Bool -> ShowS -> ShowS showParen b p = if b then showChar '(' . p . showChar ')' else p showSpace :: ShowS showSpace = {-showChar ' '-} \ xs -> ' ' : xs \end{code} Code specific for characters \begin{code} -- | Convert a character to a string using only printable characters, -- using Haskell source-language escape conventions. For example: -- -- > showLitChar '\n' s = "\\n" ++ s -- showLitChar :: Char -> ShowS showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows (ord c)) s) showLitChar '\DEL' s = showString "\\DEL" s showLitChar '\\' s = showString "\\\\" s showLitChar c s | c >= ' ' = showChar c s showLitChar '\a' s = showString "\\a" s showLitChar '\b' s = showString "\\b" s showLitChar '\f' s = showString "\\f" s showLitChar '\n' s = showString "\\n" s showLitChar '\r' s = showString "\\r" s showLitChar '\t' s = showString "\\t" s showLitChar '\v' s = showString "\\v" s showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s showLitChar c s = showString ('\\' : asciiTab!!ord c) s -- I've done manual eta-expansion here, becuase otherwise it's -- impossible to stop (asciiTab!!ord) getting floated out as an MFE isDec c = c >= '0' && c <= '9' protectEsc :: (Char -> Bool) -> ShowS -> ShowS protectEsc p f = f . cont where cont s@(c:_) | p c = "\\&" ++ s cont s = s asciiTab :: [String] asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ') ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI", "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", "SP"] \end{code} Code specific for Ints. \begin{code} -- | Convert an 'Int' in the range @0@..@15@ to the corresponding single -- digit 'Char'. This function fails on other inputs, and generates -- lower-case hexadecimal digits. intToDigit :: Int -> Char intToDigit (I# i) | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i) | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` ten `plusInt` I# i) | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i)) ten = I# 10# showSignedInt :: Int -> Int -> ShowS showSignedInt (I# p) (I# n) r | n <# 0# && p ># 6# = '(' : itos n (')' : r) | otherwise = itos n r itos :: Int# -> String -> String itos n# cs | n# <# 0# = let I# minInt# = minInt in if n# ==# minInt# -- negateInt# minInt overflows, so we can't do that: then '-' : itos' (negateInt# (n# `quotInt#` 10#)) (itos' (negateInt# (n# `remInt#` 10#)) cs) else '-' : itos' (negateInt# n#) cs | otherwise = itos' n# cs where itos' :: Int# -> String -> String itos' n# cs | n# <# 10# = C# (chr# (ord# '0'# +# n#)) : cs | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# -> itos' (n# `quotInt#` 10#) (C# c# : cs) } \end{code} hugs98-plus-Sep2006/packages/base/GHC/Stable.lhs0000644006511100651110000000733410504340221017774 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Stable -- Copyright : (c) The University of Glasgow, 1992-2004 -- License : see libraries/base/LICENSE -- -- Maintainer : ffi@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- Stable pointers. -- ----------------------------------------------------------------------------- -- #hide module GHC.Stable ( StablePtr(..) , newStablePtr -- :: a -> IO (StablePtr a) , deRefStablePtr -- :: StablePtr a -> a , freeStablePtr -- :: StablePtr a -> IO () , castStablePtrToPtr -- :: StablePtr a -> Ptr () , castPtrToStablePtr -- :: Ptr () -> StablePtr a ) where import GHC.Ptr import GHC.Base import GHC.IOBase ----------------------------------------------------------------------------- -- Stable Pointers {- | A /stable pointer/ is a reference to a Haskell expression that is guaranteed not to be affected by garbage collection, i.e., it will neither be deallocated nor will the value of the stable pointer itself change during garbage collection (ordinary references may be relocated during garbage collection). Consequently, stable pointers can be passed to foreign code, which can treat it as an opaque reference to a Haskell value. A value of type @StablePtr a@ is a stable pointer to a Haskell expression of type @a@. -} data StablePtr a = StablePtr (StablePtr# a) -- | -- Create a stable pointer referring to the given Haskell value. -- newStablePtr :: a -> IO (StablePtr a) newStablePtr a = IO $ \ s -> case makeStablePtr# a s of (# s', sp #) -> (# s', StablePtr sp #) -- | -- Obtain the Haskell value referenced by a stable pointer, i.e., the -- same value that was passed to the corresponding call to -- 'makeStablePtr'. If the argument to 'deRefStablePtr' has -- already been freed using 'freeStablePtr', the behaviour of -- 'deRefStablePtr' is undefined. -- deRefStablePtr :: StablePtr a -> IO a deRefStablePtr (StablePtr sp) = IO $ \s -> deRefStablePtr# sp s -- | -- Dissolve the association between the stable pointer and the Haskell -- value. Afterwards, if the stable pointer is passed to -- 'deRefStablePtr' or 'freeStablePtr', the behaviour is -- undefined. However, the stable pointer may still be passed to -- 'castStablePtrToPtr', but the @'Foreign.Ptr.Ptr' ()@ value returned -- by 'castStablePtrToPtr', in this case, is undefined (in particular, -- it may be 'Foreign.Ptr.nullPtr'). Nevertheless, the call -- to 'castStablePtrToPtr' is guaranteed not to diverge. -- foreign import ccall unsafe "hs_free_stable_ptr" freeStablePtr :: StablePtr a -> IO () -- | -- Coerce a stable pointer to an address. No guarantees are made about -- the resulting value, except that the original stable pointer can be -- recovered by 'castPtrToStablePtr'. In particular, the address may not -- refer to an accessible memory location and any attempt to pass it to -- the member functions of the class 'Foreign.Storable.Storable' leads to -- undefined behaviour. -- castStablePtrToPtr :: StablePtr a -> Ptr () castStablePtrToPtr (StablePtr s) = Ptr (unsafeCoerce# s) -- | -- The inverse of 'castStablePtrToPtr', i.e., we have the identity -- -- > sp == castPtrToStablePtr (castStablePtrToPtr sp) -- -- for any stable pointer @sp@ on which 'freeStablePtr' has -- not been executed yet. Moreover, 'castPtrToStablePtr' may -- only be applied to pointers that have been produced by -- 'castStablePtrToPtr'. -- castPtrToStablePtr :: Ptr () -> StablePtr a castPtrToStablePtr (Ptr a) = StablePtr (unsafeCoerce# a) instance Eq (StablePtr a) where (StablePtr sp1) == (StablePtr sp2) = case eqStablePtr# sp1 sp2 of 0# -> False _ -> True \end{code} hugs98-plus-Sep2006/packages/base/GHC/Storable.lhs0000644006511100651110000001620410504340221020331 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Storable -- Copyright : (c) The FFI task force, 2000-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : ffi@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- Helper functions for "Foreign.Storable" -- ----------------------------------------------------------------------------- -- #hide module GHC.Storable ( readWideCharOffPtr , readIntOffPtr , readWordOffPtr , readPtrOffPtr , readFunPtrOffPtr , readFloatOffPtr , readDoubleOffPtr , readStablePtrOffPtr , readInt8OffPtr , readInt16OffPtr , readInt32OffPtr , readInt64OffPtr , readWord8OffPtr , readWord16OffPtr , readWord32OffPtr , readWord64OffPtr , writeWideCharOffPtr , writeIntOffPtr , writeWordOffPtr , writePtrOffPtr , writeFunPtrOffPtr , writeFloatOffPtr , writeDoubleOffPtr , writeStablePtrOffPtr , writeInt8OffPtr , writeInt16OffPtr , writeInt32OffPtr , writeInt64OffPtr , writeWord8OffPtr , writeWord16OffPtr , writeWord32OffPtr , writeWord64OffPtr ) where import GHC.Stable ( StablePtr ) import GHC.Int import GHC.Word import GHC.Stable import GHC.Ptr import GHC.Float import GHC.IOBase import GHC.Base \end{code} \begin{code} readWideCharOffPtr :: Ptr Char -> Int -> IO Char readIntOffPtr :: Ptr Int -> Int -> IO Int readWordOffPtr :: Ptr Word -> Int -> IO Word readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a) readFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> IO (FunPtr a) readFloatOffPtr :: Ptr Float -> Int -> IO Float readDoubleOffPtr :: Ptr Double -> Int -> IO Double readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a) readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8 readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16 readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32 readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64 readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8 readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16 readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32 readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64 readWideCharOffPtr (Ptr a) (I# i) = IO $ \s -> case readWideCharOffAddr# a i s of (# s2, x #) -> (# s2, C# x #) readIntOffPtr (Ptr a) (I# i) = IO $ \s -> case readIntOffAddr# a i s of (# s2, x #) -> (# s2, I# x #) readWordOffPtr (Ptr a) (I# i) = IO $ \s -> case readWordOffAddr# a i s of (# s2, x #) -> (# s2, W# x #) readPtrOffPtr (Ptr a) (I# i) = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, Ptr x #) readFunPtrOffPtr (Ptr a) (I# i) = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, FunPtr x #) readFloatOffPtr (Ptr a) (I# i) = IO $ \s -> case readFloatOffAddr# a i s of (# s2, x #) -> (# s2, F# x #) readDoubleOffPtr (Ptr a) (I# i) = IO $ \s -> case readDoubleOffAddr# a i s of (# s2, x #) -> (# s2, D# x #) readStablePtrOffPtr (Ptr a) (I# i) = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #) readInt8OffPtr (Ptr a) (I# i) = IO $ \s -> case readInt8OffAddr# a i s of (# s2, x #) -> (# s2, I8# x #) readWord8OffPtr (Ptr a) (I# i) = IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# x #) readInt16OffPtr (Ptr a) (I# i) = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #) readWord16OffPtr (Ptr a) (I# i) = IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# x #) readInt32OffPtr (Ptr a) (I# i) = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #) readWord32OffPtr (Ptr a) (I# i) = IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #) readInt64OffPtr (Ptr a) (I# i) = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #) readWord64OffPtr (Ptr a) (I# i) = IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# x #) writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO () writeIntOffPtr :: Ptr Int -> Int -> Int -> IO () writeWordOffPtr :: Ptr Word -> Int -> Word -> IO () writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO () writeFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> FunPtr a -> IO () writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO () writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO () writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO () writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO () writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO () writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO () writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO () writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO () writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO () writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO () writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO () writeWideCharOffPtr (Ptr a) (I# i) (C# x) = IO $ \s -> case writeWideCharOffAddr# a i x s of s2 -> (# s2, () #) writeIntOffPtr (Ptr a) (I# i) (I# x) = IO $ \s -> case writeIntOffAddr# a i x s of s2 -> (# s2, () #) writeWordOffPtr (Ptr a) (I# i) (W# x) = IO $ \s -> case writeWordOffAddr# a i x s of s2 -> (# s2, () #) writePtrOffPtr (Ptr a) (I# i) (Ptr x) = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #) writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x) = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #) writeFloatOffPtr (Ptr a) (I# i) (F# x) = IO $ \s -> case writeFloatOffAddr# a i x s of s2 -> (# s2, () #) writeDoubleOffPtr (Ptr a) (I# i) (D# x) = IO $ \s -> case writeDoubleOffAddr# a i x s of s2 -> (# s2, () #) writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x) = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #) writeInt8OffPtr (Ptr a) (I# i) (I8# x) = IO $ \s -> case writeInt8OffAddr# a i x s of s2 -> (# s2, () #) writeWord8OffPtr (Ptr a) (I# i) (W8# x) = IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #) writeInt16OffPtr (Ptr a) (I# i) (I16# x) = IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #) writeWord16OffPtr (Ptr a) (I# i) (W16# x) = IO $ \s -> case writeWord16OffAddr# a i x s of s2 -> (# s2, () #) writeInt32OffPtr (Ptr a) (I# i) (I32# x) = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #) writeWord32OffPtr (Ptr a) (I# i) (W32# x) = IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #) writeInt64OffPtr (Ptr a) (I# i) (I64# x) = IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #) writeWord64OffPtr (Ptr a) (I# i) (W64# x) = IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #) \end{code} hugs98-plus-Sep2006/packages/base/GHC/TopHandler.lhs0000644006511100651110000001104010504340225020613 0ustar rossross\begin{code} ----------------------------------------------------------------------------- -- | -- Module : GHC.TopHandler -- Copyright : (c) The University of Glasgow, 2001-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- Support for catching exceptions raised during top-level computations -- (e.g. @Main.main@, 'Control.Concurrent.forkIO', and foreign exports) -- ----------------------------------------------------------------------------- -- #hide module GHC.TopHandler ( runMainIO, runIO, runIOFastExit, runNonIO, reportStackOverflow, reportError ) where import Prelude import System.IO import Control.Exception import Foreign.C ( CInt ) import GHC.IOBase import GHC.Exception import GHC.Prim (unsafeCoerce#) -- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is -- called in the program). It catches otherwise uncaught exceptions, -- and also flushes stdout\/stderr before exiting. runMainIO :: IO a -> IO a runMainIO main = (do a <- main; cleanUp; return a) `catchException` topHandler -- | 'runIO' is wrapped around every @foreign export@ and @foreign -- import \"wrapper\"@ to mop up any uncaught exceptions. Thus, the -- result of running 'System.Exit.exitWith' in a foreign-exported -- function is the same as in the main thread: it terminates the -- program. -- runIO :: IO a -> IO a runIO main = catchException main topHandler -- | Like 'runIO', but in the event of an exception that causes an exit, -- we don't shut down the system cleanly, we just exit. This is -- useful in some cases, because the safe exit version will give other -- threads a chance to clean up first, which might shut down the -- system in a different way. For example, try -- -- main = forkIO (runIO (exitWith (ExitFailure 1))) >> threadDelay 10000 -- -- This will sometimes exit with "interrupted" and code 0, because the -- main thread is given a chance to shut down when the child thread calls -- safeExit. There is a race to shut down between the main and child threads. -- runIOFastExit :: IO a -> IO a runIOFastExit main = catchException main topHandlerFastExit -- NB. this is used by the testsuite driver -- | The same as 'runIO', but for non-IO computations. Used for -- wrapping @foreign export@ and @foreign import \"wrapper\"@ when these -- are used to export Haskell functions with non-IO types. -- runNonIO :: a -> IO a runNonIO a = catchException (a `seq` return a) topHandler topHandler :: Exception -> IO a topHandler err = catchException (real_handler safeExit err) topHandler topHandlerFastExit :: Exception -> IO a topHandlerFastExit err = catchException (real_handler fastExit err) topHandlerFastExit -- Make sure we handle errors while reporting the error! -- (e.g. evaluating the string passed to 'error' might generate -- another error, etc.) -- real_handler :: (Int -> IO a) -> Exception -> IO a real_handler exit exn = cleanUp >> case exn of AsyncException StackOverflow -> do reportStackOverflow exit 2 -- only the main thread gets ExitException exceptions ExitException ExitSuccess -> exit 0 ExitException (ExitFailure n) -> exit n other -> do reportError other exit 1 reportStackOverflow :: IO a reportStackOverflow = do callStackOverflowHook; return undefined reportError :: Exception -> IO a reportError ex = do handler <- getUncaughtExceptionHandler handler ex return undefined -- SUP: Are the hooks allowed to re-enter Haskell land? If so, remove -- the unsafe below. foreign import ccall unsafe "stackOverflow" callStackOverflowHook :: IO () -- try to flush stdout/stderr, but don't worry if we fail -- (these handles might have errors, and we don't want to go into -- an infinite loop). cleanUp :: IO () cleanUp = do hFlush stdout `catchException` \_ -> return () hFlush stderr `catchException` \_ -> return () cleanUpAndExit :: Int -> IO a cleanUpAndExit r = do cleanUp; safeExit r -- we have to use unsafeCoerce# to get the 'IO a' result type, since the -- compiler doesn't let us declare that as the result type of a foreign export. safeExit :: Int -> IO a safeExit r = unsafeCoerce# (shutdownHaskellAndExit r) -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can* -- re-enter Haskell land through finalizers. foreign import ccall "Rts.h shutdownHaskellAndExit" shutdownHaskellAndExit :: Int -> IO () fastExit :: Int -> IO a fastExit r = unsafeCoerce# (stg_exit (fromIntegral r)) foreign import ccall "Rts.h stg_exit" stg_exit :: CInt -> IO () \end{code} hugs98-plus-Sep2006/packages/base/GHC/Unicode.hs0000644006511100651110000001673610504340221020002 0ustar rossross{-# OPTIONS -fno-implicit-prelude #-} {-# OPTIONS -#include "WCsubst.h" #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Unicode -- Copyright : (c) The University of Glasgow, 2003 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- Implementations for the character predicates (isLower, isUpper, etc.) -- and the conversions (toUpper, toLower). The implementation uses -- libunicode on Unix systems if that is available. -- ----------------------------------------------------------------------------- -- #hide module GHC.Unicode ( isAscii, isLatin1, isControl, isAsciiUpper, isAsciiLower, isPrint, isSpace, isUpper, isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum, toUpper, toLower, toTitle, wgencat, ) where import GHC.Base import GHC.Real (fromIntegral) import GHC.Int import GHC.Word import GHC.Num (fromInteger) #include "HsBaseConfig.h" -- | Selects the first 128 characters of the Unicode character set, -- corresponding to the ASCII character set. isAscii :: Char -> Bool isAscii c = c < '\x80' -- | Selects the first 256 characters of the Unicode character set, -- corresponding to the ISO 8859-1 (Latin-1) character set. isLatin1 :: Char -> Bool isLatin1 c = c <= '\xff' -- | Selects ASCII lower-case letters, -- i.e. characters satisfying both 'isAscii' and 'isLower'. isAsciiLower :: Char -> Bool isAsciiLower c = c >= 'a' && c <= 'z' -- | Selects ASCII upper-case letters, -- i.e. characters satisfying both 'isAscii' and 'isUpper'. isAsciiUpper :: Char -> Bool isAsciiUpper c = c >= 'A' && c <= 'Z' -- | Selects control characters, which are the non-printing characters of -- the Latin-1 subset of Unicode. isControl :: Char -> Bool -- | Selects printable Unicode characters -- (letters, numbers, marks, punctuation, symbols and spaces). isPrint :: Char -> Bool -- | Selects white-space characters in the Latin-1 range. -- (In Unicode terms, this includes spaces and some control characters.) isSpace :: Char -> Bool -- isSpace includes non-breaking space -- Done with explicit equalities both for efficiency, and to avoid a tiresome -- recursion with GHC.List elem isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f' || c == '\v' || c == '\xa0' || iswspace (fromIntegral (ord c)) /= 0 -- | Selects upper-case or title-case alphabetic Unicode characters (letters). -- Title case is used by a small number of letter ligatures like the -- single-character form of /Lj/. isUpper :: Char -> Bool -- | Selects lower-case alphabetic Unicode characters (letters). isLower :: Char -> Bool -- | Selects alphabetic Unicode characters (lower-case, upper-case and -- title-case letters, plus letters of caseless scripts and modifiers letters). -- This function is equivalent to 'Data.Char.isLetter'. isAlpha :: Char -> Bool -- | Selects alphabetic or numeric digit Unicode characters. -- -- Note that numeric digits outside the ASCII range are selected by this -- function but not by 'isDigit'. Such digits may be part of identifiers -- but are not used by the printer and reader to represent numbers. isAlphaNum :: Char -> Bool -- | Selects ASCII digits, i.e. @\'0\'@..@\'9\'@. isDigit :: Char -> Bool isDigit c = c >= '0' && c <= '9' -- | Selects ASCII octal digits, i.e. @\'0\'@..@\'7\'@. isOctDigit :: Char -> Bool isOctDigit c = c >= '0' && c <= '7' -- | Selects ASCII hexadecimal digits, -- i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@. isHexDigit :: Char -> Bool isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || c >= 'a' && c <= 'f' -- | Convert a letter to the corresponding upper-case letter, if any. -- Any other character is returned unchanged. toUpper :: Char -> Char -- | Convert a letter to the corresponding lower-case letter, if any. -- Any other character is returned unchanged. toLower :: Char -> Char -- | Convert a letter to the corresponding title-case or upper-case -- letter, if any. (Title case differs from upper case only for a small -- number of ligature letters.) -- Any other character is returned unchanged. toTitle :: Char -> Char -- ----------------------------------------------------------------------------- -- Implementation with the supplied auto-generated Unicode character properties -- table (default) #if 1 -- Regardless of the O/S and Library, use the functions contained in WCsubst.c type CInt = HTYPE_INT isAlpha c = iswalpha (fromIntegral (ord c)) /= 0 isAlphaNum c = iswalnum (fromIntegral (ord c)) /= 0 --isSpace c = iswspace (fromIntegral (ord c)) /= 0 isControl c = iswcntrl (fromIntegral (ord c)) /= 0 isPrint c = iswprint (fromIntegral (ord c)) /= 0 isUpper c = iswupper (fromIntegral (ord c)) /= 0 isLower c = iswlower (fromIntegral (ord c)) /= 0 toLower c = chr (fromIntegral (towlower (fromIntegral (ord c)))) toUpper c = chr (fromIntegral (towupper (fromIntegral (ord c)))) toTitle c = chr (fromIntegral (towtitle (fromIntegral (ord c)))) foreign import ccall unsafe "u_iswdigit" iswdigit :: CInt -> CInt foreign import ccall unsafe "u_iswalpha" iswalpha :: CInt -> CInt foreign import ccall unsafe "u_iswalnum" iswalnum :: CInt -> CInt foreign import ccall unsafe "u_iswcntrl" iswcntrl :: CInt -> CInt foreign import ccall unsafe "u_iswspace" iswspace :: CInt -> CInt foreign import ccall unsafe "u_iswprint" iswprint :: CInt -> CInt foreign import ccall unsafe "u_iswlower" iswlower :: CInt -> CInt foreign import ccall unsafe "u_iswupper" iswupper :: CInt -> CInt foreign import ccall unsafe "u_towlower" towlower :: CInt -> CInt foreign import ccall unsafe "u_towupper" towupper :: CInt -> CInt foreign import ccall unsafe "u_towtitle" towtitle :: CInt -> CInt foreign import ccall unsafe "u_gencat" wgencat :: CInt -> Int -- ----------------------------------------------------------------------------- -- No libunicode, so fall back to the ASCII-only implementation (never used, indeed) #else isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f' isPrint c = not (isControl c) -- The upper case ISO characters have the multiplication sign dumped -- randomly in the middle of the range. Go figure. isUpper c = c >= 'A' && c <= 'Z' || c >= '\xC0' && c <= '\xD6' || c >= '\xD8' && c <= '\xDE' -- The lower case ISO characters have the division sign dumped -- randomly in the middle of the range. Go figure. isLower c = c >= 'a' && c <= 'z' || c >= '\xDF' && c <= '\xF6' || c >= '\xF8' && c <= '\xFF' isAlpha c = isLower c || isUpper c isAlphaNum c = isAlpha c || isDigit c -- Case-changing operations toUpper c@(C# c#) | isAsciiLower c = C# (chr# (ord# c# -# 32#)) | isAscii c = c -- fall-through to the slower stuff. | isLower c && c /= '\xDF' && c /= '\xFF' = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A') | otherwise = c toLower c@(C# c#) | isAsciiUpper c = C# (chr# (ord# c# +# 32#)) | isAscii c = c | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a') | otherwise = c #endif hugs98-plus-Sep2006/packages/base/GHC/TopHandler.lhs-boot0000644006511100651110000000037510504340221021561 0ustar rossross\begin{code} {-# OPTIONS -fno-implicit-prelude #-} module GHC.TopHandler ( reportError, reportStackOverflow ) where import GHC.Exception ( Exception ) import GHC.IOBase ( IO ) reportError :: Exception -> IO a reportStackOverflow :: IO a \end{code} hugs98-plus-Sep2006/packages/base/GHC/Weak.lhs0000644006511100651110000001070610504340221017446 0ustar rossross\begin{code} {-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Weak -- Copyright : (c) The University of Glasgow, 1998-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- Weak pointers. -- ----------------------------------------------------------------------------- -- #hide module GHC.Weak where import GHC.Base import Data.Maybe import GHC.IOBase ( IO(..), unIO ) import Data.Typeable ( Typeable1(..), mkTyCon, mkTyConApp ) {-| A weak pointer object with a key and a value. The value has type @v@. A weak pointer expresses a relationship between two objects, the /key/ and the /value/: if the key is considered to be alive by the garbage collector, then the value is also alive. A reference from the value to the key does /not/ keep the key alive. A weak pointer may also have a finalizer of type @IO ()@; if it does, then the finalizer will be run at most once, at a time after the key has become unreachable by the program (\"dead\"). The storage manager attempts to run the finalizer(s) for an object soon after the object dies, but promptness is not guaranteed. It is not guaranteed that a finalizer will eventually run, and no attempt is made to run outstanding finalizers when the program exits. Therefore finalizers should not be relied on to clean up resources - other methods (eg. exception handlers) should be employed, possibly in addition to finalisers. References from the finalizer to the key are treated in the same way as references from the value to the key: they do not keep the key alive. A finalizer may therefore ressurrect the key, perhaps by storing it in the same data structure. The finalizer, and the relationship between the key and the value, exist regardless of whether the program keeps a reference to the 'Weak' object or not. There may be multiple weak pointers with the same key. In this case, the finalizers for each of these weak pointers will all be run in some arbitrary order, or perhaps concurrently, when the key dies. If the programmer specifies a finalizer that assumes it has the only reference to an object (for example, a file that it wishes to close), then the programmer must ensure that there is only one such finalizer. If there are no other threads to run, the runtime system will check for runnable finalizers before declaring the system to be deadlocked. -} data Weak v = Weak (Weak# v) #include "Typeable.h" INSTANCE_TYPEABLE1(Weak,weakTc,"Weak") -- | Establishes a weak pointer to @k@, with value @v@ and a finalizer. -- -- This is the most general interface for building a weak pointer. -- mkWeak :: k -- ^ key -> v -- ^ value -> Maybe (IO ()) -- ^ finalizer -> IO (Weak v) -- ^ returns: a weak pointer object mkWeak key val (Just finalizer) = IO $ \s -> case mkWeak# key val finalizer s of { (# s1, w #) -> (# s1, Weak w #) } mkWeak key val Nothing = IO $ \s -> case mkWeak# key val (unsafeCoerce# 0#) s of { (# s1, w #) -> (# s1, Weak w #) } {-| Dereferences a weak pointer. If the key is still alive, then @'Just' v@ is returned (where @v@ is the /value/ in the weak pointer), otherwise 'Nothing' is returned. The return value of 'deRefWeak' depends on when the garbage collector runs, hence it is in the 'IO' monad. -} deRefWeak :: Weak v -> IO (Maybe v) deRefWeak (Weak w) = IO $ \s -> case deRefWeak# w s of (# s1, flag, p #) -> case flag of 0# -> (# s1, Nothing #) _ -> (# s1, Just p #) -- | Causes a the finalizer associated with a weak pointer to be run -- immediately. finalize :: Weak v -> IO () finalize (Weak w) = IO $ \s -> case finalizeWeak# w s of (# s1, 0#, _ #) -> (# s1, () #) -- already dead, or no finaliser (# s1, _, f #) -> f s1 {- Instance Eq (Weak v) where (Weak w1) == (Weak w2) = w1 `sameWeak#` w2 -} -- run a batch of finalizers from the garbage collector. We're given -- an array of finalizers and the length of the array, and we just -- call each one in turn. -- -- the IO primitives are inlined by hand here to get the optimal -- code (sigh) --SDM. runFinalizerBatch :: Int -> Array# (IO ()) -> IO () runFinalizerBatch (I# n) arr = let go m = IO $ \s -> case m of 0# -> (# s, () #) _ -> let m' = m -# 1# in case indexArray# arr m' of { (# io #) -> case unIO io s of { (# s, _ #) -> unIO (go m') s }} in go n \end{code} hugs98-plus-Sep2006/packages/base/GHC/Word.hs0000644006511100651110000010763110504340221017322 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Word -- Copyright : (c) The University of Glasgow, 1997-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- Sized unsigned integral types: 'Word', 'Word8', 'Word16', 'Word32', and -- 'Word64'. -- ----------------------------------------------------------------------------- #include "MachDeps.h" -- #hide module GHC.Word ( Word(..), Word8(..), Word16(..), Word32(..), Word64(..), toEnumError, fromEnumError, succError, predError) where import Data.Bits import {-# SOURCE #-} GHC.Err import GHC.Base import GHC.Enum import GHC.Num import GHC.Real import GHC.Read import GHC.Arr import GHC.Show ------------------------------------------------------------------------ -- Helper functions ------------------------------------------------------------------------ {-# NOINLINE toEnumError #-} toEnumError :: (Show a) => String -> Int -> (a,a) -> b toEnumError inst_ty i bnds = error $ "Enum.toEnum{" ++ inst_ty ++ "}: tag (" ++ show i ++ ") is outside of bounds " ++ show bnds {-# NOINLINE fromEnumError #-} fromEnumError :: (Show a) => String -> a -> b fromEnumError inst_ty x = error $ "Enum.fromEnum{" ++ inst_ty ++ "}: value (" ++ show x ++ ") is outside of Int's bounds " ++ show (minBound::Int, maxBound::Int) {-# NOINLINE succError #-} succError :: String -> a succError inst_ty = error $ "Enum.succ{" ++ inst_ty ++ "}: tried to take `succ' of maxBound" {-# NOINLINE predError #-} predError :: String -> a predError inst_ty = error $ "Enum.pred{" ++ inst_ty ++ "}: tried to take `pred' of minBound" ------------------------------------------------------------------------ -- type Word ------------------------------------------------------------------------ -- |A 'Word' is an unsigned integral type, with the same size as 'Int'. data Word = W# Word# deriving (Eq, Ord) instance Show Word where showsPrec p x = showsPrec p (toInteger x) instance Num Word where (W# x#) + (W# y#) = W# (x# `plusWord#` y#) (W# x#) - (W# y#) = W# (x# `minusWord#` y#) (W# x#) * (W# y#) = W# (x# `timesWord#` y#) negate (W# x#) = W# (int2Word# (negateInt# (word2Int# x#))) abs x = x signum 0 = 0 signum _ = 1 fromInteger (S# i#) = W# (int2Word# i#) fromInteger (J# s# d#) = W# (integer2Word# s# d#) instance Real Word where toRational x = toInteger x % 1 instance Enum Word where succ x | x /= maxBound = x + 1 | otherwise = succError "Word" pred x | x /= minBound = x - 1 | otherwise = predError "Word" toEnum i@(I# i#) | i >= 0 = W# (int2Word# i#) | otherwise = toEnumError "Word" i (minBound::Word, maxBound::Word) fromEnum x@(W# x#) | x <= fromIntegral (maxBound::Int) = I# (word2Int# x#) | otherwise = fromEnumError "Word" x enumFrom = integralEnumFrom enumFromThen = integralEnumFromThen enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo instance Integral Word where quot x@(W# x#) y@(W# y#) | y /= 0 = W# (x# `quotWord#` y#) | otherwise = divZeroError rem x@(W# x#) y@(W# y#) | y /= 0 = W# (x# `remWord#` y#) | otherwise = divZeroError div x@(W# x#) y@(W# y#) | y /= 0 = W# (x# `quotWord#` y#) | otherwise = divZeroError mod x@(W# x#) y@(W# y#) | y /= 0 = W# (x# `remWord#` y#) | otherwise = divZeroError quotRem x@(W# x#) y@(W# y#) | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) | otherwise = divZeroError divMod x@(W# x#) y@(W# y#) | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) | otherwise = divZeroError toInteger (W# x#) | i# >=# 0# = S# i# | otherwise = case word2Integer# x# of (# s, d #) -> J# s d where i# = word2Int# x# instance Bounded Word where minBound = 0 -- use unboxed literals for maxBound, because GHC doesn't optimise -- (fromInteger 0xffffffff :: Word). #if WORD_SIZE_IN_BITS == 31 maxBound = W# (int2Word# 0x7FFFFFFF#) #elif WORD_SIZE_IN_BITS == 32 maxBound = W# (int2Word# 0xFFFFFFFF#) #else maxBound = W# (int2Word# 0xFFFFFFFFFFFFFFFF#) #endif instance Ix Word where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n instance Read Word where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] instance Bits Word where (W# x#) .&. (W# y#) = W# (x# `and#` y#) (W# x#) .|. (W# y#) = W# (x# `or#` y#) (W# x#) `xor` (W# y#) = W# (x# `xor#` y#) complement (W# x#) = W# (x# `xor#` mb#) where W# mb# = maxBound (W# x#) `shift` (I# i#) | i# >=# 0# = W# (x# `shiftL#` i#) | otherwise = W# (x# `shiftRL#` negateInt# i#) (W# x#) `rotate` (I# i#) | i'# ==# 0# = W# x# | otherwise = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (wsib -# i'#))) where i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#)) wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} bitSize _ = WORD_SIZE_IN_BITS isSigned _ = False {-# RULES "fromIntegral/Int->Word" fromIntegral = \(I# x#) -> W# (int2Word# x#) "fromIntegral/Word->Int" fromIntegral = \(W# x#) -> I# (word2Int# x#) "fromIntegral/Word->Word" fromIntegral = id :: Word -> Word #-} ------------------------------------------------------------------------ -- type Word8 ------------------------------------------------------------------------ -- Word8 is represented in the same way as Word. Operations may assume -- and must ensure that it holds only values from its logical range. data Word8 = W8# Word# deriving (Eq, Ord) -- ^ 8-bit unsigned integer type instance Show Word8 where showsPrec p x = showsPrec p (fromIntegral x :: Int) instance Num Word8 where (W8# x#) + (W8# y#) = W8# (narrow8Word# (x# `plusWord#` y#)) (W8# x#) - (W8# y#) = W8# (narrow8Word# (x# `minusWord#` y#)) (W8# x#) * (W8# y#) = W8# (narrow8Word# (x# `timesWord#` y#)) negate (W8# x#) = W8# (narrow8Word# (int2Word# (negateInt# (word2Int# x#)))) abs x = x signum 0 = 0 signum _ = 1 fromInteger (S# i#) = W8# (narrow8Word# (int2Word# i#)) fromInteger (J# s# d#) = W8# (narrow8Word# (integer2Word# s# d#)) instance Real Word8 where toRational x = toInteger x % 1 instance Enum Word8 where succ x | x /= maxBound = x + 1 | otherwise = succError "Word8" pred x | x /= minBound = x - 1 | otherwise = predError "Word8" toEnum i@(I# i#) | i >= 0 && i <= fromIntegral (maxBound::Word8) = W8# (int2Word# i#) | otherwise = toEnumError "Word8" i (minBound::Word8, maxBound::Word8) fromEnum (W8# x#) = I# (word2Int# x#) enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Integral Word8 where quot x@(W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `quotWord#` y#) | otherwise = divZeroError rem x@(W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `remWord#` y#) | otherwise = divZeroError div x@(W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `quotWord#` y#) | otherwise = divZeroError mod x@(W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `remWord#` y#) | otherwise = divZeroError quotRem x@(W8# x#) y@(W8# y#) | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#)) | otherwise = divZeroError divMod x@(W8# x#) y@(W8# y#) | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#)) | otherwise = divZeroError toInteger (W8# x#) = S# (word2Int# x#) instance Bounded Word8 where minBound = 0 maxBound = 0xFF instance Ix Word8 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n instance Read Word8 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] instance Bits Word8 where (W8# x#) .&. (W8# y#) = W8# (x# `and#` y#) (W8# x#) .|. (W8# y#) = W8# (x# `or#` y#) (W8# x#) `xor` (W8# y#) = W8# (x# `xor#` y#) complement (W8# x#) = W8# (x# `xor#` mb#) where W8# mb# = maxBound (W8# x#) `shift` (I# i#) | i# >=# 0# = W8# (narrow8Word# (x# `shiftL#` i#)) | otherwise = W8# (x# `shiftRL#` negateInt# i#) (W8# x#) `rotate` (I# i#) | i'# ==# 0# = W8# x# | otherwise = W8# (narrow8Word# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (8# -# i'#)))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 7#) bitSize _ = 8 isSigned _ = False {-# RULES "fromIntegral/Word8->Word8" fromIntegral = id :: Word8 -> Word8 "fromIntegral/Word8->Integer" fromIntegral = toInteger :: Word8 -> Integer "fromIntegral/a->Word8" fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (narrow8Word# x#) "fromIntegral/Word8->a" fromIntegral = \(W8# x#) -> fromIntegral (W# x#) #-} ------------------------------------------------------------------------ -- type Word16 ------------------------------------------------------------------------ -- Word16 is represented in the same way as Word. Operations may assume -- and must ensure that it holds only values from its logical range. data Word16 = W16# Word# deriving (Eq, Ord) -- ^ 16-bit unsigned integer type instance Show Word16 where showsPrec p x = showsPrec p (fromIntegral x :: Int) instance Num Word16 where (W16# x#) + (W16# y#) = W16# (narrow16Word# (x# `plusWord#` y#)) (W16# x#) - (W16# y#) = W16# (narrow16Word# (x# `minusWord#` y#)) (W16# x#) * (W16# y#) = W16# (narrow16Word# (x# `timesWord#` y#)) negate (W16# x#) = W16# (narrow16Word# (int2Word# (negateInt# (word2Int# x#)))) abs x = x signum 0 = 0 signum _ = 1 fromInteger (S# i#) = W16# (narrow16Word# (int2Word# i#)) fromInteger (J# s# d#) = W16# (narrow16Word# (integer2Word# s# d#)) instance Real Word16 where toRational x = toInteger x % 1 instance Enum Word16 where succ x | x /= maxBound = x + 1 | otherwise = succError "Word16" pred x | x /= minBound = x - 1 | otherwise = predError "Word16" toEnum i@(I# i#) | i >= 0 && i <= fromIntegral (maxBound::Word16) = W16# (int2Word# i#) | otherwise = toEnumError "Word16" i (minBound::Word16, maxBound::Word16) fromEnum (W16# x#) = I# (word2Int# x#) enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen instance Integral Word16 where quot x@(W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `quotWord#` y#) | otherwise = divZeroError rem x@(W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `remWord#` y#) | otherwise = divZeroError div x@(W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `quotWord#` y#) | otherwise = divZeroError mod x@(W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `remWord#` y#) | otherwise = divZeroError quotRem x@(W16# x#) y@(W16# y#) | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#)) | otherwise = divZeroError divMod x@(W16# x#) y@(W16# y#) | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#)) | otherwise = divZeroError toInteger (W16# x#) = S# (word2Int# x#) instance Bounded Word16 where minBound = 0 maxBound = 0xFFFF instance Ix Word16 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n instance Read Word16 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] instance Bits Word16 where (W16# x#) .&. (W16# y#) = W16# (x# `and#` y#) (W16# x#) .|. (W16# y#) = W16# (x# `or#` y#) (W16# x#) `xor` (W16# y#) = W16# (x# `xor#` y#) complement (W16# x#) = W16# (x# `xor#` mb#) where W16# mb# = maxBound (W16# x#) `shift` (I# i#) | i# >=# 0# = W16# (narrow16Word# (x# `shiftL#` i#)) | otherwise = W16# (x# `shiftRL#` negateInt# i#) (W16# x#) `rotate` (I# i#) | i'# ==# 0# = W16# x# | otherwise = W16# (narrow16Word# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (16# -# i'#)))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 15#) bitSize _ = 16 isSigned _ = False {-# RULES "fromIntegral/Word8->Word16" fromIntegral = \(W8# x#) -> W16# x# "fromIntegral/Word16->Word16" fromIntegral = id :: Word16 -> Word16 "fromIntegral/Word16->Integer" fromIntegral = toInteger :: Word16 -> Integer "fromIntegral/a->Word16" fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (narrow16Word# x#) "fromIntegral/Word16->a" fromIntegral = \(W16# x#) -> fromIntegral (W# x#) #-} ------------------------------------------------------------------------ -- type Word32 ------------------------------------------------------------------------ #if WORD_SIZE_IN_BITS < 32 data Word32 = W32# Word32# -- ^ 32-bit unsigned integer type instance Eq Word32 where (W32# x#) == (W32# y#) = x# `eqWord32#` y# (W32# x#) /= (W32# y#) = x# `neWord32#` y# instance Ord Word32 where (W32# x#) < (W32# y#) = x# `ltWord32#` y# (W32# x#) <= (W32# y#) = x# `leWord32#` y# (W32# x#) > (W32# y#) = x# `gtWord32#` y# (W32# x#) >= (W32# y#) = x# `geWord32#` y# instance Num Word32 where (W32# x#) + (W32# y#) = W32# (int32ToWord32# (word32ToInt32# x# `plusInt32#` word32ToInt32# y#)) (W32# x#) - (W32# y#) = W32# (int32ToWord32# (word32ToInt32# x# `minusInt32#` word32ToInt32# y#)) (W32# x#) * (W32# y#) = W32# (int32ToWord32# (word32ToInt32# x# `timesInt32#` word32ToInt32# y#)) negate (W32# x#) = W32# (int32ToWord32# (negateInt32# (word32ToInt32# x#))) abs x = x signum 0 = 0 signum _ = 1 fromInteger (S# i#) = W32# (int32ToWord32# (intToInt32# i#)) fromInteger (J# s# d#) = W32# (integerToWord32# s# d#) instance Enum Word32 where succ x | x /= maxBound = x + 1 | otherwise = succError "Word32" pred x | x /= minBound = x - 1 | otherwise = predError "Word32" toEnum i@(I# i#) | i >= 0 = W32# (wordToWord32# (int2Word# i#)) | otherwise = toEnumError "Word32" i (minBound::Word32, maxBound::Word32) fromEnum x@(W32# x#) | x <= fromIntegral (maxBound::Int) = I# (word2Int# (word32ToWord# x#)) | otherwise = fromEnumError "Word32" x enumFrom = integralEnumFrom enumFromThen = integralEnumFromThen enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo instance Integral Word32 where quot x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord32#` y#) | otherwise = divZeroError rem x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `remWord32#` y#) | otherwise = divZeroError div x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord32#` y#) | otherwise = divZeroError mod x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `remWord32#` y#) | otherwise = divZeroError quotRem x@(W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord32#` y#), W32# (x# `remWord32#` y#)) | otherwise = divZeroError divMod x@(W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord32#` y#), W32# (x# `remWord32#` y#)) | otherwise = divZeroError toInteger x@(W32# x#) | x <= fromIntegral (maxBound::Int) = S# (word2Int# (word32ToWord# x#)) | otherwise = case word32ToInteger# x# of (# s, d #) -> J# s d instance Bits Word32 where (W32# x#) .&. (W32# y#) = W32# (x# `and32#` y#) (W32# x#) .|. (W32# y#) = W32# (x# `or32#` y#) (W32# x#) `xor` (W32# y#) = W32# (x# `xor32#` y#) complement (W32# x#) = W32# (not32# x#) (W32# x#) `shift` (I# i#) | i# >=# 0# = W32# (x# `shiftL32#` i#) | otherwise = W32# (x# `shiftRL32#` negateInt# i#) (W32# x#) `rotate` (I# i#) | i'# ==# 0# = W32# x# | otherwise = W32# ((x# `shiftL32#` i'#) `or32#` (x# `shiftRL32#` (32# -# i'#))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) bitSize _ = 32 isSigned _ = False foreign import unsafe "stg_eqWord32" eqWord32# :: Word32# -> Word32# -> Bool foreign import unsafe "stg_neWord32" neWord32# :: Word32# -> Word32# -> Bool foreign import unsafe "stg_ltWord32" ltWord32# :: Word32# -> Word32# -> Bool foreign import unsafe "stg_leWord32" leWord32# :: Word32# -> Word32# -> Bool foreign import unsafe "stg_gtWord32" gtWord32# :: Word32# -> Word32# -> Bool foreign import unsafe "stg_geWord32" geWord32# :: Word32# -> Word32# -> Bool foreign import unsafe "stg_int32ToWord32" int32ToWord32# :: Int32# -> Word32# foreign import unsafe "stg_word32ToInt32" word32ToInt32# :: Word32# -> Int32# foreign import unsafe "stg_intToInt32" intToInt32# :: Int# -> Int32# foreign import unsafe "stg_wordToWord32" wordToWord32# :: Word# -> Word32# foreign import unsafe "stg_word32ToWord" word32ToWord# :: Word32# -> Word# foreign import unsafe "stg_plusInt32" plusInt32# :: Int32# -> Int32# -> Int32# foreign import unsafe "stg_minusInt32" minusInt32# :: Int32# -> Int32# -> Int32# foreign import unsafe "stg_timesInt32" timesInt32# :: Int32# -> Int32# -> Int32# foreign import unsafe "stg_negateInt32" negateInt32# :: Int32# -> Int32# foreign import unsafe "stg_quotWord32" quotWord32# :: Word32# -> Word32# -> Word32# foreign import unsafe "stg_remWord32" remWord32# :: Word32# -> Word32# -> Word32# foreign import unsafe "stg_and32" and32# :: Word32# -> Word32# -> Word32# foreign import unsafe "stg_or32" or32# :: Word32# -> Word32# -> Word32# foreign import unsafe "stg_xor32" xor32# :: Word32# -> Word32# -> Word32# foreign import unsafe "stg_not32" not32# :: Word32# -> Word32# foreign import unsafe "stg_shiftL32" shiftL32# :: Word32# -> Int# -> Word32# foreign import unsafe "stg_shiftRL32" shiftRL32# :: Word32# -> Int# -> Word32# {-# RULES "fromIntegral/Int->Word32" fromIntegral = \(I# x#) -> W32# (int32ToWord32# (intToInt32# x#)) "fromIntegral/Word->Word32" fromIntegral = \(W# x#) -> W32# (wordToWord32# x#) "fromIntegral/Word32->Int" fromIntegral = \(W32# x#) -> I# (word2Int# (word32ToWord# x#)) "fromIntegral/Word32->Word" fromIntegral = \(W32# x#) -> W# (word32ToWord# x#) "fromIntegral/Word32->Word32" fromIntegral = id :: Word32 -> Word32 #-} #else -- Word32 is represented in the same way as Word. #if WORD_SIZE_IN_BITS > 32 -- Operations may assume and must ensure that it holds only values -- from its logical range. #endif data Word32 = W32# Word# deriving (Eq, Ord) -- ^ 32-bit unsigned integer type instance Num Word32 where (W32# x#) + (W32# y#) = W32# (narrow32Word# (x# `plusWord#` y#)) (W32# x#) - (W32# y#) = W32# (narrow32Word# (x# `minusWord#` y#)) (W32# x#) * (W32# y#) = W32# (narrow32Word# (x# `timesWord#` y#)) negate (W32# x#) = W32# (narrow32Word# (int2Word# (negateInt# (word2Int# x#)))) abs x = x signum 0 = 0 signum _ = 1 fromInteger (S# i#) = W32# (narrow32Word# (int2Word# i#)) fromInteger (J# s# d#) = W32# (narrow32Word# (integer2Word# s# d#)) instance Enum Word32 where succ x | x /= maxBound = x + 1 | otherwise = succError "Word32" pred x | x /= minBound = x - 1 | otherwise = predError "Word32" toEnum i@(I# i#) | i >= 0 #if WORD_SIZE_IN_BITS > 32 && i <= fromIntegral (maxBound::Word32) #endif = W32# (int2Word# i#) | otherwise = toEnumError "Word32" i (minBound::Word32, maxBound::Word32) #if WORD_SIZE_IN_BITS == 32 fromEnum x@(W32# x#) | x <= fromIntegral (maxBound::Int) = I# (word2Int# x#) | otherwise = fromEnumError "Word32" x enumFrom = integralEnumFrom enumFromThen = integralEnumFromThen enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo #else fromEnum (W32# x#) = I# (word2Int# x#) enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen #endif instance Integral Word32 where quot x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord#` y#) | otherwise = divZeroError rem x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `remWord#` y#) | otherwise = divZeroError div x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord#` y#) | otherwise = divZeroError mod x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `remWord#` y#) | otherwise = divZeroError quotRem x@(W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#)) | otherwise = divZeroError divMod x@(W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#)) | otherwise = divZeroError toInteger (W32# x#) #if WORD_SIZE_IN_BITS == 32 | i# >=# 0# = S# i# | otherwise = case word2Integer# x# of (# s, d #) -> J# s d where i# = word2Int# x# #else = S# (word2Int# x#) #endif instance Bits Word32 where (W32# x#) .&. (W32# y#) = W32# (x# `and#` y#) (W32# x#) .|. (W32# y#) = W32# (x# `or#` y#) (W32# x#) `xor` (W32# y#) = W32# (x# `xor#` y#) complement (W32# x#) = W32# (x# `xor#` mb#) where W32# mb# = maxBound (W32# x#) `shift` (I# i#) | i# >=# 0# = W32# (narrow32Word# (x# `shiftL#` i#)) | otherwise = W32# (x# `shiftRL#` negateInt# i#) (W32# x#) `rotate` (I# i#) | i'# ==# 0# = W32# x# | otherwise = W32# (narrow32Word# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (32# -# i'#)))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) bitSize _ = 32 isSigned _ = False {-# RULES "fromIntegral/Word8->Word32" fromIntegral = \(W8# x#) -> W32# x# "fromIntegral/Word16->Word32" fromIntegral = \(W16# x#) -> W32# x# "fromIntegral/Word32->Word32" fromIntegral = id :: Word32 -> Word32 "fromIntegral/Word32->Integer" fromIntegral = toInteger :: Word32 -> Integer "fromIntegral/a->Word32" fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (narrow32Word# x#) "fromIntegral/Word32->a" fromIntegral = \(W32# x#) -> fromIntegral (W# x#) #-} #endif instance Show Word32 where #if WORD_SIZE_IN_BITS < 33 showsPrec p x = showsPrec p (toInteger x) #else showsPrec p x = showsPrec p (fromIntegral x :: Int) #endif instance Real Word32 where toRational x = toInteger x % 1 instance Bounded Word32 where minBound = 0 maxBound = 0xFFFFFFFF instance Ix Word32 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n instance Read Word32 where #if WORD_SIZE_IN_BITS < 33 readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] #else readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] #endif ------------------------------------------------------------------------ -- type Word64 ------------------------------------------------------------------------ #if WORD_SIZE_IN_BITS < 64 data Word64 = W64# Word64# -- ^ 64-bit unsigned integer type instance Eq Word64 where (W64# x#) == (W64# y#) = x# `eqWord64#` y# (W64# x#) /= (W64# y#) = x# `neWord64#` y# instance Ord Word64 where (W64# x#) < (W64# y#) = x# `ltWord64#` y# (W64# x#) <= (W64# y#) = x# `leWord64#` y# (W64# x#) > (W64# y#) = x# `gtWord64#` y# (W64# x#) >= (W64# y#) = x# `geWord64#` y# instance Num Word64 where (W64# x#) + (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `plusInt64#` word64ToInt64# y#)) (W64# x#) - (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `minusInt64#` word64ToInt64# y#)) (W64# x#) * (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `timesInt64#` word64ToInt64# y#)) negate (W64# x#) = W64# (int64ToWord64# (negateInt64# (word64ToInt64# x#))) abs x = x signum 0 = 0 signum _ = 1 fromInteger (S# i#) = W64# (int64ToWord64# (intToInt64# i#)) fromInteger (J# s# d#) = W64# (integerToWord64# s# d#) instance Enum Word64 where succ x | x /= maxBound = x + 1 | otherwise = succError "Word64" pred x | x /= minBound = x - 1 | otherwise = predError "Word64" toEnum i@(I# i#) | i >= 0 = W64# (wordToWord64# (int2Word# i#)) | otherwise = toEnumError "Word64" i (minBound::Word64, maxBound::Word64) fromEnum x@(W64# x#) | x <= fromIntegral (maxBound::Int) = I# (word2Int# (word64ToWord# x#)) | otherwise = fromEnumError "Word64" x enumFrom = integralEnumFrom enumFromThen = integralEnumFromThen enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo instance Integral Word64 where quot x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord64#` y#) | otherwise = divZeroError rem x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `remWord64#` y#) | otherwise = divZeroError div x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord64#` y#) | otherwise = divZeroError mod x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `remWord64#` y#) | otherwise = divZeroError quotRem x@(W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#)) | otherwise = divZeroError divMod x@(W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#)) | otherwise = divZeroError toInteger x@(W64# x#) | x <= 0x7FFFFFFF = S# (word2Int# (word64ToWord# x#)) | otherwise = case word64ToInteger# x# of (# s, d #) -> J# s d instance Bits Word64 where (W64# x#) .&. (W64# y#) = W64# (x# `and64#` y#) (W64# x#) .|. (W64# y#) = W64# (x# `or64#` y#) (W64# x#) `xor` (W64# y#) = W64# (x# `xor64#` y#) complement (W64# x#) = W64# (not64# x#) (W64# x#) `shift` (I# i#) | i# >=# 0# = W64# (x# `shiftL64#` i#) | otherwise = W64# (x# `shiftRL64#` negateInt# i#) (W64# x#) `rotate` (I# i#) | i'# ==# 0# = W64# x# | otherwise = W64# ((x# `uncheckedShiftL64#` i'#) `or64#` (x# `uncheckedShiftRL64#` (64# -# i'#))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = False -- give the 64-bit shift operations the same treatment as the 32-bit -- ones (see GHC.Base), namely we wrap them in tests to catch the -- cases when we're shifting more than 64 bits to avoid unspecified -- behaviour in the C shift operations. shiftL64#, shiftRL64# :: Word64# -> Int# -> Word64# a `shiftL64#` b | b >=# 64# = wordToWord64# (int2Word# 0#) | otherwise = a `uncheckedShiftL64#` b a `shiftRL64#` b | b >=# 64# = wordToWord64# (int2Word# 0#) | otherwise = a `uncheckedShiftRL64#` b foreign import ccall unsafe "stg_eqWord64" eqWord64# :: Word64# -> Word64# -> Bool foreign import ccall unsafe "stg_neWord64" neWord64# :: Word64# -> Word64# -> Bool foreign import ccall unsafe "stg_ltWord64" ltWord64# :: Word64# -> Word64# -> Bool foreign import ccall unsafe "stg_leWord64" leWord64# :: Word64# -> Word64# -> Bool foreign import ccall unsafe "stg_gtWord64" gtWord64# :: Word64# -> Word64# -> Bool foreign import ccall unsafe "stg_geWord64" geWord64# :: Word64# -> Word64# -> Bool foreign import ccall unsafe "stg_int64ToWord64" int64ToWord64# :: Int64# -> Word64# foreign import ccall unsafe "stg_word64ToInt64" word64ToInt64# :: Word64# -> Int64# foreign import ccall unsafe "stg_intToInt64" intToInt64# :: Int# -> Int64# foreign import ccall unsafe "stg_wordToWord64" wordToWord64# :: Word# -> Word64# foreign import ccall unsafe "stg_word64ToWord" word64ToWord# :: Word64# -> Word# foreign import ccall unsafe "stg_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64# foreign import ccall unsafe "stg_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64# foreign import ccall unsafe "stg_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64# foreign import ccall unsafe "stg_negateInt64" negateInt64# :: Int64# -> Int64# foreign import ccall unsafe "stg_quotWord64" quotWord64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_remWord64" remWord64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_and64" and64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_or64" or64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_xor64" xor64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_not64" not64# :: Word64# -> Word64# foreign import ccall unsafe "stg_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# foreign import ccall unsafe "stg_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# foreign import ccall unsafe "stg_integerToWord64" integerToWord64# :: Int# -> ByteArray# -> Word64# {-# RULES "fromIntegral/Int->Word64" fromIntegral = \(I# x#) -> W64# (int64ToWord64# (intToInt64# x#)) "fromIntegral/Word->Word64" fromIntegral = \(W# x#) -> W64# (wordToWord64# x#) "fromIntegral/Word64->Int" fromIntegral = \(W64# x#) -> I# (word2Int# (word64ToWord# x#)) "fromIntegral/Word64->Word" fromIntegral = \(W64# x#) -> W# (word64ToWord# x#) "fromIntegral/Word64->Word64" fromIntegral = id :: Word64 -> Word64 #-} #else -- Word64 is represented in the same way as Word. -- Operations may assume and must ensure that it holds only values -- from its logical range. data Word64 = W64# Word# deriving (Eq, Ord) -- ^ 64-bit unsigned integer type instance Num Word64 where (W64# x#) + (W64# y#) = W64# (x# `plusWord#` y#) (W64# x#) - (W64# y#) = W64# (x# `minusWord#` y#) (W64# x#) * (W64# y#) = W64# (x# `timesWord#` y#) negate (W64# x#) = W64# (int2Word# (negateInt# (word2Int# x#))) abs x = x signum 0 = 0 signum _ = 1 fromInteger (S# i#) = W64# (int2Word# i#) fromInteger (J# s# d#) = W64# (integer2Word# s# d#) instance Enum Word64 where succ x | x /= maxBound = x + 1 | otherwise = succError "Word64" pred x | x /= minBound = x - 1 | otherwise = predError "Word64" toEnum i@(I# i#) | i >= 0 = W64# (int2Word# i#) | otherwise = toEnumError "Word64" i (minBound::Word64, maxBound::Word64) fromEnum x@(W64# x#) | x <= fromIntegral (maxBound::Int) = I# (word2Int# x#) | otherwise = fromEnumError "Word64" x enumFrom = integralEnumFrom enumFromThen = integralEnumFromThen enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo instance Integral Word64 where quot x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord#` y#) | otherwise = divZeroError rem x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `remWord#` y#) | otherwise = divZeroError div x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord#` y#) | otherwise = divZeroError mod x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `remWord#` y#) | otherwise = divZeroError quotRem x@(W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) | otherwise = divZeroError divMod x@(W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) | otherwise = divZeroError toInteger (W64# x#) | i# >=# 0# = S# i# | otherwise = case word2Integer# x# of (# s, d #) -> J# s d where i# = word2Int# x# instance Bits Word64 where (W64# x#) .&. (W64# y#) = W64# (x# `and#` y#) (W64# x#) .|. (W64# y#) = W64# (x# `or#` y#) (W64# x#) `xor` (W64# y#) = W64# (x# `xor#` y#) complement (W64# x#) = W64# (x# `xor#` mb#) where W64# mb# = maxBound (W64# x#) `shift` (I# i#) | i# >=# 0# = W64# (x# `shiftL#` i#) | otherwise = W64# (x# `shiftRL#` negateInt# i#) (W64# x#) `rotate` (I# i#) | i'# ==# 0# = W64# x# | otherwise = W64# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (64# -# i'#))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = False {-# RULES "fromIntegral/a->Word64" fromIntegral = \x -> case fromIntegral x of W# x# -> W64# x# "fromIntegral/Word64->a" fromIntegral = \(W64# x#) -> fromIntegral (W# x#) #-} #endif instance Show Word64 where showsPrec p x = showsPrec p (toInteger x) instance Real Word64 where toRational x = toInteger x % 1 instance Bounded Word64 where minBound = 0 maxBound = 0xFFFFFFFFFFFFFFFF instance Ix Word64 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n instance Read Word64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] hugs98-plus-Sep2006/packages/base/GHC/Dynamic.hs0000644006511100651110000000043010504340222017761 0ustar rossross{-# OPTIONS -fno-implicit-prelude #-} module GHC.Dynamic ( Dynamic, TypeRep, dynTypeRep, showsTypeRep ) where import Data.Dynamic ( Dynamic, dynTypeRep ) import Data.Typeable ( TypeRep ) import GHC.Show ( ShowS, shows ) showsTypeRep :: TypeRep -> ShowS showsTypeRep = shows hugs98-plus-Sep2006/packages/base/GHC/Dynamic.hs-boot0000644006511100651110000000043310504340222020725 0ustar rossross{-# OPTIONS -fno-implicit-prelude #-} module GHC.Dynamic ( Dynamic, TypeRep, dynTypeRep, showsTypeRep ) where import {-# SOURCE #-} Data.Dynamic ( Dynamic, dynTypeRep ) import {-# SOURCE #-} Data.Typeable ( TypeRep ) import GHC.Show ( ShowS ) showsTypeRep :: TypeRep -> ShowS hugs98-plus-Sep2006/packages/base/Foreign.hs0000644006511100651110000000225110504340221017367 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of data types, classes, and functions for interfacing -- with another programming language. -- ----------------------------------------------------------------------------- module Foreign ( module Data.Bits , module Data.Int , module Data.Word , module Foreign.Ptr , module Foreign.ForeignPtr , module Foreign.StablePtr , module Foreign.Storable , module Foreign.Marshal -- | For compatibility with the FFI addendum only. The recommended -- place to get this from is "System.IO.Unsafe". , unsafePerformIO ) where import Data.Bits import Data.Int import Data.Word import Foreign.Ptr import Foreign.ForeignPtr import Foreign.StablePtr import Foreign.Storable import Foreign.Marshal import System.IO.Unsafe (unsafePerformIO) hugs98-plus-Sep2006/packages/base/Makefile.inc0000644006511100651110000000022310504340221017647 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/base/LICENSE0000644006511100651110000000745110504340221016456 0ustar rossrossThis library (libraries/base) is derived from code from several sources: * Code from the GHC project which is largely (c) The University of Glasgow, and distributable under a BSD-style license (see below), * Code from the Haskell 98 Report which is (c) Simon Peyton Jones and freely redistributable (but see the full license for restrictions). * Code from the Haskell Foreign Function Interface specification, which is (c) Manuel M. T. Chakravarty and freely redistributable (but see the full license for restrictions). The full text of these licenses is reproduced below. All of the licenses are BSD-style or compatible. ----------------------------------------------------------------------------- The Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------- Code derived from the document "Report on the Programming Language Haskell 98", is distributed under the following license: Copyright (c) 2002 Simon Peyton Jones The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Language. ----------------------------------------------------------------------------- Code derived from the document "The Haskell 98 Foreign Function Interface, An Addendum to the Haskell 98 Report" is distributed under the following license: Copyright (c) 2002 Manuel M. T. Chakravarty The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Foreign Function Interface. ----------------------------------------------------------------------------- hugs98-plus-Sep2006/packages/base/Makefile0000644006511100651110000000710110504340226017106 0ustar rossrossTOP=.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- SUBDIRS = cbits include ALL_DIRS = \ Control \ Control/Concurrent \ Control/Parallel \ Control/Monad \ Control/Monad/ST \ Data \ Data/ByteString \ Data/ByteString/Lazy \ Data/Generics \ Data/Array \ Data/Array/IO \ Data/STRef \ Debug \ Foreign \ Foreign/C \ Foreign/Marshal \ GHC \ System \ System/Console \ System/Mem \ System/IO \ System/Posix \ System/Process \ System/Directory \ Text \ Text/PrettyPrint \ Text/ParserCombinators \ Text/Show \ Text/Read PACKAGE = base VERSION = 2.0 SRC_HC_OPTS += -fglasgow-exts -cpp -Iinclude -"\#include" HsBase.h SRC_HSC2HS_OPTS += -Iinclude -I$(GHC_INCLUDE_DIR) # ----------------------------------------------------------------------------- # Per-module flags # ESSENTIAL, for getting reasonable performance from the I/O library: SRC_HC_OPTS += -funbox-strict-fields # ----------------------------------------------------------------------------- # PrimOpWrappers # These two lines are required for pre-processing compiler/prelude/primops.txt SRC_CPP_OPTS += -I$(GHC_INCLUDE_DIR) SRC_CPP_OPTS += ${GhcCppOpts} ifeq "$(BootingFromHc)" "YES" GHC/PrimopWrappers.hs: GHC/Prim.hs touch GHC/PrimopWrappers.hs else GHC/PrimopWrappers.hs: $(GHC_COMPILER_DIR)/prelude/primops.txt GHC/Prim.hs @$(RM) $@ $(GENPRIMOP) --make-haskell-wrappers < $< > $@ endif GHC/Prim.hs: $(GHC_COMPILER_DIR)/prelude/primops.txt @$(RM) $@ $(GENPRIMOP) --make-haskell-source < $< > $@ EXCLUDED_SRCS = GHC/Prim.hs EXTRA_HADDOCK_SRCS = GHC/Prim.hs boot :: GHC/PrimopWrappers.hs EXTRA_SRCS += GHC/PrimopWrappers.hs CLEAN_FILES += GHC/PrimopWrappers.hs # ----------------------------------------------------------------------------- ifneq "$(BootingFromHc)" "YES" STUBOBJS += \ Control/Concurrent_stub.$(way_)o CLEAN_FILES += $(STUBOBJS) \ Control/Concurrent_stub.[ch] endif #----------------------------------------------------------------------------- # Building the library for GHCi # # The procedure differs from that in fptools/mk/target.mk in one way: # (*) on Win32 we must split it into two, because a single .o file can't # have more than 65536 relocations in it [due to a bug in the GNU # linker.] OBJECT_FILEFORMAT=unknown ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" OBJECT_FILEFORMAT=PEi endif ifeq "$(TARGETPLATFORM)" "i386-unknown-cygwin32" OBJECT_FILEFORMAT=PEi endif ifeq "$(OBJECT_FILEFORMAT)" "PEi" # Turn off standard rule which creates HSbase.o from LIBOBJS. #DONT_WANT_STD_GHCI_LIB_RULE=YES GHCI_LIBOBJS = $(HS_OBJS) INSTALL_LIBS += HSbase.o endif # OBJECT_FILEFORMAT = PEi # ----------------------------------------------------------------------------- # Doc building with Haddock EXCLUDED_HADDOCK_SRCS = \ GHC/PrimopWrappers.hs \ GHC/PArr.hs SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" \ --no-implicit-prelude # ----------------------------------------------------------------------------- GHC/ForeignPtr.o Data/Array/IO/Internals.o Data/Array/Base.o \ Data/Generics/Instances.o Data/Complex.o Data/Array.o Data/STRef.o \ Data/Dynamic.o Data/Typeable.o Data/PackedString.o System/Mem/Weak.o \ System/Mem/StableName.o System/Posix/Types.o Control/Monad/ST.o \ Control/Exception.o Foreign/C/Types.o Foreign/ForeignPtr.o: include/Typeable.h System/Posix/Types.o Foreign/C/Types.o: include/CTypes.h # ----------------------------------------------------------------------------- DIST_CLEAN_FILES += base.buildinfo config.cache config.status include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/base/NHC/0000755006511100651110000000000010504340221016052 5ustar rossrosshugs98-plus-Sep2006/packages/base/NHC/Makefile0000644006511100651110000000000010504340221017500 0ustar rossrosshugs98-plus-Sep2006/packages/base/NHC/SizedTypes.hs0000644006511100651110000000265010504340221020514 0ustar rossrossmodule NHC.SizedTypes -- This module just adds instances of Bits for Int/Word[8,16,32,64] ( Int8, Int16, Int32, Int64 , Word8, Word16, Word32, Word64 ) where {- Note explicit braces and semicolons here - layout is corrupted by cpp. -} { import NHC.FFI (Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64) ; import Data.Bits #define SIZED_TYPE(T,BS,S) \ ; FOREIGNS(T) \ ; INSTANCE_BITS(T,BS,S) #define FOREIGNS(T) \ ; foreign import ccall nhc_prim/**/T/**/And :: T -> T -> T \ ; foreign import ccall nhc_prim/**/T/**/Or :: T -> T -> T \ ; foreign import ccall nhc_prim/**/T/**/Xor :: T -> T -> T \ ; foreign import ccall nhc_prim/**/T/**/Lsh :: T -> Int -> T \ ; foreign import ccall nhc_prim/**/T/**/Rsh :: T -> Int -> T \ ; foreign import ccall nhc_prim/**/T/**/Compl :: T -> T #define INSTANCE_BITS(T,BS,S) \ ; instance Bits T where \ { (.&.) = nhc_prim/**/T/**/And \ ; (.|.) = nhc_prim/**/T/**/Or \ ; xor = nhc_prim/**/T/**/Xor \ ; complement = nhc_prim/**/T/**/Compl \ ; shiftL = nhc_prim/**/T/**/Lsh \ ; shiftR = nhc_prim/**/T/**/Rsh \ ; bitSize _ = BS \ ; isSigned _ = S \ } SIZED_TYPE(Int8,8,True) SIZED_TYPE(Int16,16,True) SIZED_TYPE(Int32,32,True) SIZED_TYPE(Int64,64,True) SIZED_TYPE(Word8,8,False) SIZED_TYPE(Word16,16,False) SIZED_TYPE(Word32,32,False) SIZED_TYPE(Word64,64,False) } hugs98-plus-Sep2006/packages/base/Text/0000755006511100651110000000000010504340226016373 5ustar rossrosshugs98-plus-Sep2006/packages/base/Text/PrettyPrint/0000755006511100651110000000000010504340222020673 5ustar rossrosshugs98-plus-Sep2006/packages/base/Text/PrettyPrint/HughesPJ.hs0000644006511100651110000010257010504340222022711 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.PrettyPrint.HughesPJ -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- John Hughes's and Simon Peyton Jones's Pretty Printer Combinators -- -- Based on /The Design of a Pretty-printing Library/ -- in Advanced Functional Programming, -- Johan Jeuring and Erik Meijer (eds), LNCS 925 -- -- -- Heavily modified by Simon Peyton Jones, Dec 96 -- ----------------------------------------------------------------------------- {- Version 3.0 28 May 1997 * Cured massive performance bug. If you write foldl <> empty (map (text.show) [1..10000]) you get quadratic behaviour with V2.0. Why? For just the same reason as you get quadratic behaviour with left-associated (++) chains. This is really bad news. One thing a pretty-printer abstraction should certainly guarantee is insensivity to associativity. It matters: suddenly GHC's compilation times went up by a factor of 100 when I switched to the new pretty printer. I fixed it with a bit of a hack (because I wanted to get GHC back on the road). I added two new constructors to the Doc type, Above and Beside: <> = Beside $$ = Above Then, where I need to get to a "TextBeside" or "NilAbove" form I "force" the Doc to squeeze out these suspended calls to Beside and Above; but in so doing I re-associate. It's quite simple, but I'm not satisfied that I've done the best possible job. I'll send you the code if you are interested. * Added new exports: punctuate, hang int, integer, float, double, rational, lparen, rparen, lbrack, rbrack, lbrace, rbrace, * fullRender's type signature has changed. Rather than producing a string it now takes an extra couple of arguments that tells it how to glue fragments of output together: fullRender :: Mode -> Int -- Line length -> Float -- Ribbons per line -> (TextDetails -> a -> a) -- What to do with text -> a -- What to do at the end -> Doc -> a -- Result The "fragments" are encapsulated in the TextDetails data type: data TextDetails = Chr Char | Str String | PStr FAST_STRING The Chr and Str constructors are obvious enough. The PStr constructor has a packed string (FAST_STRING) inside it. It's generated by using the new "ptext" export. An advantage of this new setup is that you can get the renderer to do output directly (by passing in a function of type (TextDetails -> IO () -> IO ()), rather than producing a string that you then print. Version 2.0 24 April 1997 * Made empty into a left unit for <> as well as a right unit; it is also now true that nest k empty = empty which wasn't true before. * Fixed an obscure bug in sep that occassionally gave very weird behaviour * Added $+$ * Corrected and tidied up the laws and invariants ====================================================================== Relative to John's original paper, there are the following new features: 1. There's an empty document, "empty". It's a left and right unit for both <> and $$, and anywhere in the argument list for sep, hcat, hsep, vcat, fcat etc. It is Really Useful in practice. 2. There is a paragraph-fill combinator, fsep, that's much like sep, only it keeps fitting things on one line until it can't fit any more. 3. Some random useful extra combinators are provided. <+> puts its arguments beside each other with a space between them, unless either argument is empty in which case it returns the other hcat is a list version of <> hsep is a list version of <+> vcat is a list version of $$ sep (separate) is either like hsep or like vcat, depending on what fits cat behaves like sep, but it uses <> for horizontal conposition fcat behaves like fsep, but it uses <> for horizontal conposition These new ones do the obvious things: char, semi, comma, colon, space, parens, brackets, braces, quotes, doubleQuotes 4. The "above" combinator, $$, now overlaps its two arguments if the last line of the top argument stops before the first line of the second begins. For example: text "hi" $$ nest 5 (text "there") lays out as hi there rather than hi there There are two places this is really useful a) When making labelled blocks, like this: Left -> code for left Right -> code for right LongLongLongLabel -> code for longlonglonglabel The block is on the same line as the label if the label is short, but on the next line otherwise. b) When laying out lists like this: [ first , second , third ] which some people like. But if the list fits on one line you want [first, second, third]. You can't do this with John's original combinators, but it's quite easy with the new $$. The combinator $+$ gives the original "never-overlap" behaviour. 5. Several different renderers are provided: * a standard one * one that uses cut-marks to avoid deeply-nested documents simply piling up in the right-hand margin * one that ignores indentation (fewer chars output; good for machines) * one that ignores indentation and newlines (ditto, only more so) 6. Numerous implementation tidy-ups Use of unboxed data types to speed up the implementation -} module Text.PrettyPrint.HughesPJ ( -- * The document type Doc, -- Abstract -- * Constructing documents -- ** Converting values into documents char, text, ptext, int, integer, float, double, rational, -- ** Simple derived documents semi, comma, colon, space, equals, lparen, rparen, lbrack, rbrack, lbrace, rbrace, -- ** Wrapping documents in delimiters parens, brackets, braces, quotes, doubleQuotes, -- ** Combining documents empty, (<>), (<+>), hcat, hsep, ($$), ($+$), vcat, sep, cat, fsep, fcat, nest, hang, punctuate, -- * Predicates on documents isEmpty, -- * Rendering documents -- ** Default rendering render, -- ** Rendering with a particular style Style(..), style, renderStyle, -- ** General rendering fullRender, Mode(..), TextDetails(..), ) where import Prelude infixl 6 <> infixl 6 <+> infixl 5 $$, $+$ -- --------------------------------------------------------------------------- -- The interface -- The primitive Doc values isEmpty :: Doc -> Bool; -- ^ Returns 'True' if the document is empty -- | The empty document, with no height and no width. -- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere -- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc. empty :: Doc semi :: Doc; -- ^ A ';' character comma :: Doc; -- ^ A ',' character colon :: Doc; -- ^ A ':' character space :: Doc; -- ^ A space character equals :: Doc; -- ^ A '=' character lparen :: Doc; -- ^ A '(' character rparen :: Doc; -- ^ A ')' character lbrack :: Doc; -- ^ A '[' character rbrack :: Doc; -- ^ A ']' character lbrace :: Doc; -- ^ A '{' character rbrace :: Doc; -- ^ A '}' character -- | A document of height and width 1, containing a literal character. char :: Char -> Doc -- | A document of height 1 containing a literal string. -- 'text' satisfies the following laws: -- -- * @'text' s '<>' 'text' t = 'text' (s'++'t)@ -- -- * @'text' \"\" '<>' x = x@, if @x@ non-empty -- -- The side condition on the last law is necessary because @'text' \"\"@ -- has height 1, while 'empty' has no height. text :: String -> Doc -- | An obsolete function, now identical to 'text'. ptext :: String -> Doc int :: Int -> Doc; -- ^ @int n = text (show n)@ integer :: Integer -> Doc; -- ^ @integer n = text (show n)@ float :: Float -> Doc; -- ^ @float n = text (show n)@ double :: Double -> Doc; -- ^ @double n = text (show n)@ rational :: Rational -> Doc; -- ^ @rational n = text (show n)@ parens :: Doc -> Doc; -- ^ Wrap document in @(...)@ brackets :: Doc -> Doc; -- ^ Wrap document in @[...]@ braces :: Doc -> Doc; -- ^ Wrap document in @{...}@ quotes :: Doc -> Doc; -- ^ Wrap document in @\'...\'@ doubleQuotes :: Doc -> Doc; -- ^ Wrap document in @\"...\"@ -- Combining @Doc@ values -- | Beside. -- '<>' is associative, with identity 'empty'. (<>) :: Doc -> Doc -> Doc -- | Beside, separated by space, unless one of the arguments is 'empty'. -- '<+>' is associative, with identity 'empty'. (<+>) :: Doc -> Doc -> Doc -- | Above, except that if the last line of the first argument stops -- at least one position before the first line of the second begins, -- these two lines are overlapped. For example: -- -- > text "hi" $$ nest 5 (text "there") -- -- lays out as -- -- > hi there -- -- rather than -- -- > hi -- > there -- -- '$$' is associative, with identity 'empty', and also satisfies -- -- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty. -- ($$) :: Doc -> Doc -> Doc -- | Above, with no overlapping. -- '$+$' is associative, with identity 'empty'. ($+$) :: Doc -> Doc -> Doc hcat :: [Doc] -> Doc; -- ^List version of '<>'. hsep :: [Doc] -> Doc; -- ^List version of '<+>'. vcat :: [Doc] -> Doc; -- ^List version of '$$'. cat :: [Doc] -> Doc; -- ^ Either 'hcat' or 'vcat'. sep :: [Doc] -> Doc; -- ^ Either 'hsep' or 'vcat'. fcat :: [Doc] -> Doc; -- ^ \"Paragraph fill\" version of 'cat'. fsep :: [Doc] -> Doc; -- ^ \"Paragraph fill\" version of 'sep'. -- | Nest (or indent) a document by a given number of positions -- (which may also be negative). 'nest' satisfies the laws: -- -- * @'nest' 0 x = x@ -- -- * @'nest' k ('nest' k' x) = 'nest' (k+k') x@ -- -- * @'nest' k (x '<>' y) = 'nest' k z '<>' 'nest' k y@ -- -- * @'nest' k (x '$$' y) = 'nest' k x '$$' 'nest' k y@ -- -- * @'nest' k 'empty' = 'empty'@ -- -- * @x '<>' 'nest' k y = x '<>' y@, if @x@ non-empty -- -- The side condition on the last law is needed because -- 'empty' is a left identity for '<>'. nest :: Int -> Doc -> Doc -- GHC-specific ones. -- | @hang d1 n d2 = sep [d1, nest n d2]@ hang :: Doc -> Int -> Doc -> Doc -- | @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@ punctuate :: Doc -> [Doc] -> [Doc] -- Displaying @Doc@ values. instance Show Doc where showsPrec prec doc cont = showDoc doc cont -- | Renders the document as a string using the default 'style'. render :: Doc -> String -- | The general rendering interface. fullRender :: Mode -- ^Rendering mode -> Int -- ^Line length -> Float -- ^Ribbons per line -> (TextDetails -> a -> a) -- ^What to do with text -> a -- ^What to do at the end -> Doc -- ^The document -> a -- ^Result -- | Render the document as a string using a specified style. renderStyle :: Style -> Doc -> String -- | A rendering style. data Style = Style { mode :: Mode -- ^ The rendering mode , lineLength :: Int -- ^ Length of line, in chars , ribbonsPerLine :: Float -- ^ Ratio of ribbon length to line length } -- | The default style (@mode=PageMode, lineLength=100, ribbonsPerLine=1.5@). style :: Style style = Style { lineLength = 100, ribbonsPerLine = 1.5, mode = PageMode } -- | Rendering mode. data Mode = PageMode -- ^Normal | ZigZagMode -- ^With zig-zag cuts | LeftMode -- ^No indentation, infinitely long lines | OneLineMode -- ^All on one line -- --------------------------------------------------------------------------- -- The Doc calculus -- The Doc combinators satisfy the following laws: {- Laws for $$ ~~~~~~~~~~~ (x $$ y) $$ z = x $$ (y $$ z) empty $$ x = x x $$ empty = x ...ditto $+$... Laws for <> ~~~~~~~~~~~ (x <> y) <> z = x <> (y <> z) empty <> x = empty x <> empty = x ...ditto <+>... Laws for text ~~~~~~~~~~~~~ text s <> text t = text (s++t) text "" <> x = x, if x non-empty Laws for nest ~~~~~~~~~~~~~ nest 0 x = x nest k (nest k' x) = nest (k+k') x nest k (x <> y) = nest k z <> nest k y nest k (x $$ y) = nest k x $$ nest k y nest k empty = empty x <> nest k y = x <> y, if x non-empty ** Note the side condition on ! It is this that ** makes it OK for empty to be a left unit for <>. Miscellaneous ~~~~~~~~~~~~~ (text s <> x) $$ y = text s <> ((text "" <> x)) $$ nest (-length s) y) (x $$ y) <> z = x $$ (y <> z) if y non-empty Laws for list versions ~~~~~~~~~~~~~~~~~~~~~~ sep (ps++[empty]++qs) = sep (ps ++ qs) ...ditto hsep, hcat, vcat, fill... nest k (sep ps) = sep (map (nest k) ps) ...ditto hsep, hcat, vcat, fill... Laws for oneLiner ~~~~~~~~~~~~~~~~~ oneLiner (nest k p) = nest k (oneLiner p) oneLiner (x <> y) = oneLiner x <> oneLiner y You might think that the following verion of would be neater: <3 NO> (text s <> x) $$ y = text s <> ((empty <> x)) $$ nest (-length s) y) But it doesn't work, for if x=empty, we would have text s $$ y = text s <> (empty $$ nest (-length s) y) = text s <> nest (-length s) y -} -- --------------------------------------------------------------------------- -- Simple derived definitions semi = char ';' colon = char ':' comma = char ',' space = char ' ' equals = char '=' lparen = char '(' rparen = char ')' lbrack = char '[' rbrack = char ']' lbrace = char '{' rbrace = char '}' int n = text (show n) integer n = text (show n) float n = text (show n) double n = text (show n) rational n = text (show n) -- SIGBJORN wrote instead: -- rational n = text (show (fromRationalX n)) quotes p = char '\'' <> p <> char '\'' doubleQuotes p = char '"' <> p <> char '"' parens p = char '(' <> p <> char ')' brackets p = char '[' <> p <> char ']' braces p = char '{' <> p <> char '}' hcat = foldr (<>) empty hsep = foldr (<+>) empty vcat = foldr ($$) empty hang d1 n d2 = sep [d1, nest n d2] punctuate p [] = [] punctuate p (d:ds) = go d ds where go d [] = [d] go d (e:es) = (d <> p) : go e es -- --------------------------------------------------------------------------- -- The Doc data type -- A Doc represents a *set* of layouts. A Doc with -- no occurrences of Union or NoDoc represents just one layout. -- | The abstract type of documents. -- The 'Show' instance is equivalent to using 'render'. data Doc = Empty -- empty | NilAbove Doc -- text "" $$ x | TextBeside TextDetails !Int Doc -- text s <> x | Nest !Int Doc -- nest k x | Union Doc Doc -- ul `union` ur | NoDoc -- The empty set of documents | Beside Doc Bool Doc -- True <=> space between | Above Doc Bool Doc -- True <=> never overlap type RDoc = Doc -- RDoc is a "reduced Doc", guaranteed not to have a top-level Above or Beside reduceDoc :: Doc -> RDoc reduceDoc (Beside p g q) = beside p g (reduceDoc q) reduceDoc (Above p g q) = above p g (reduceDoc q) reduceDoc p = p data TextDetails = Chr Char | Str String | PStr String space_text = Chr ' ' nl_text = Chr '\n' {- Here are the invariants: * The argument of NilAbove is never Empty. Therefore a NilAbove occupies at least two lines. * The arugment of @TextBeside@ is never @Nest@. * The layouts of the two arguments of @Union@ both flatten to the same string. * The arguments of @Union@ are either @TextBeside@, or @NilAbove@. * The right argument of a union cannot be equivalent to the empty set (@NoDoc@). If the left argument of a union is equivalent to the empty set (@NoDoc@), then the @NoDoc@ appears in the first line. * An empty document is always represented by @Empty@. It can't be hidden inside a @Nest@, or a @Union@ of two @Empty@s. * The first line of every layout in the left argument of @Union@ is longer than the first line of any layout in the right argument. (1) ensures that the left argument has a first line. In view of (3), this invariant means that the right argument must have at least two lines. -} -- Arg of a NilAbove is always an RDoc nilAbove_ p = NilAbove p -- Arg of a TextBeside is always an RDoc textBeside_ s sl p = TextBeside s sl p -- Arg of Nest is always an RDoc nest_ k p = Nest k p -- Args of union are always RDocs union_ p q = Union p q -- Notice the difference between -- * NoDoc (no documents) -- * Empty (one empty document; no height and no width) -- * text "" (a document containing the empty string; -- one line high, but has no width) -- --------------------------------------------------------------------------- -- @empty@, @text@, @nest@, @union@ empty = Empty isEmpty Empty = True isEmpty _ = False char c = textBeside_ (Chr c) 1 Empty text s = case length s of {sl -> textBeside_ (Str s) sl Empty} ptext s = case length s of {sl -> textBeside_ (PStr s) sl Empty} nest k p = mkNest k (reduceDoc p) -- Externally callable version -- mkNest checks for Nest's invariant that it doesn't have an Empty inside it mkNest k _ | k `seq` False = undefined mkNest k (Nest k1 p) = mkNest (k + k1) p mkNest k NoDoc = NoDoc mkNest k Empty = Empty mkNest 0 p = p -- Worth a try! mkNest k p = nest_ k p -- mkUnion checks for an empty document mkUnion Empty q = Empty mkUnion p q = p `union_` q -- --------------------------------------------------------------------------- -- Vertical composition @$$@ above_ :: Doc -> Bool -> Doc -> Doc above_ p _ Empty = p above_ Empty _ q = q above_ p g q = Above p g q p $$ q = above_ p False q p $+$ q = above_ p True q above :: Doc -> Bool -> RDoc -> RDoc above (Above p g1 q1) g2 q2 = above p g1 (above q1 g2 q2) above p@(Beside _ _ _) g q = aboveNest (reduceDoc p) g 0 (reduceDoc q) above p g q = aboveNest p g 0 (reduceDoc q) aboveNest :: RDoc -> Bool -> Int -> RDoc -> RDoc -- Specfication: aboveNest p g k q = p $g$ (nest k q) aboveNest _ _ k _ | k `seq` False = undefined aboveNest NoDoc g k q = NoDoc aboveNest (p1 `Union` p2) g k q = aboveNest p1 g k q `union_` aboveNest p2 g k q aboveNest Empty g k q = mkNest k q aboveNest (Nest k1 p) g k q = nest_ k1 (aboveNest p g (k - k1) q) -- p can't be Empty, so no need for mkNest aboveNest (NilAbove p) g k q = nilAbove_ (aboveNest p g k q) aboveNest (TextBeside s sl p) g k q = k1 `seq` textBeside_ s sl rest where k1 = k - sl rest = case p of Empty -> nilAboveNest g k1 q other -> aboveNest p g k1 q nilAboveNest :: Bool -> Int -> RDoc -> RDoc -- Specification: text s <> nilaboveNest g k q -- = text s <> (text "" $g$ nest k q) nilAboveNest _ k _ | k `seq` False = undefined nilAboveNest g k Empty = Empty -- Here's why the "text s <>" is in the spec! nilAboveNest g k (Nest k1 q) = nilAboveNest g (k + k1) q nilAboveNest g k q | (not g) && (k > 0) -- No newline if no overlap = textBeside_ (Str (spaces k)) k q | otherwise -- Put them really above = nilAbove_ (mkNest k q) -- --------------------------------------------------------------------------- -- Horizontal composition @<>@ beside_ :: Doc -> Bool -> Doc -> Doc beside_ p _ Empty = p beside_ Empty _ q = q beside_ p g q = Beside p g q p <> q = beside_ p False q p <+> q = beside_ p True q beside :: Doc -> Bool -> RDoc -> RDoc -- Specification: beside g p q = p q beside NoDoc g q = NoDoc beside (p1 `Union` p2) g q = (beside p1 g q) `union_` (beside p2 g q) beside Empty g q = q beside (Nest k p) g q = nest_ k (beside p g q) -- p non-empty beside p@(Beside p1 g1 q1) g2 q2 {- (A `op1` B) `op2` C == A `op1` (B `op2` C) iff op1 == op2 [ && (op1 == <> || op1 == <+>) ] -} | g1 == g2 = beside p1 g1 (beside q1 g2 q2) | otherwise = beside (reduceDoc p) g2 q2 beside p@(Above _ _ _) g q = beside (reduceDoc p) g q beside (NilAbove p) g q = nilAbove_ (beside p g q) beside (TextBeside s sl p) g q = textBeside_ s sl rest where rest = case p of Empty -> nilBeside g q other -> beside p g q nilBeside :: Bool -> RDoc -> RDoc -- Specification: text "" <> nilBeside g p -- = text "" p nilBeside g Empty = Empty -- Hence the text "" in the spec nilBeside g (Nest _ p) = nilBeside g p nilBeside g p | g = textBeside_ space_text 1 p | otherwise = p -- --------------------------------------------------------------------------- -- Separate, @sep@, Hughes version -- Specification: sep ps = oneLiner (hsep ps) -- `union` -- vcat ps sep = sepX True -- Separate with spaces cat = sepX False -- Don't sepX x [] = empty sepX x (p:ps) = sep1 x (reduceDoc p) 0 ps -- Specification: sep1 g k ys = sep (x : map (nest k) ys) -- = oneLiner (x nest k (hsep ys)) -- `union` x $$ nest k (vcat ys) sep1 :: Bool -> RDoc -> Int -> [Doc] -> RDoc sep1 g _ k ys | k `seq` False = undefined sep1 g NoDoc k ys = NoDoc sep1 g (p `Union` q) k ys = sep1 g p k ys `union_` (aboveNest q False k (reduceDoc (vcat ys))) sep1 g Empty k ys = mkNest k (sepX g ys) sep1 g (Nest n p) k ys = nest_ n (sep1 g p (k - n) ys) sep1 g (NilAbove p) k ys = nilAbove_ (aboveNest p False k (reduceDoc (vcat ys))) sep1 g (TextBeside s sl p) k ys = textBeside_ s sl (sepNB g p (k - sl) ys) -- Specification: sepNB p k ys = sep1 (text "" <> p) k ys -- Called when we have already found some text in the first item -- We have to eat up nests sepNB g (Nest _ p) k ys = sepNB g p k ys sepNB g Empty k ys = oneLiner (nilBeside g (reduceDoc rest)) `mkUnion` nilAboveNest False k (reduceDoc (vcat ys)) where rest | g = hsep ys | otherwise = hcat ys sepNB g p k ys = sep1 g p k ys -- --------------------------------------------------------------------------- -- @fill@ fsep = fill True fcat = fill False -- Specification: -- fill [] = empty -- fill [p] = p -- fill (p1:p2:ps) = oneLiner p1 <#> nest (length p1) -- (fill (oneLiner p2 : ps)) -- `union` -- p1 $$ fill ps fill g [] = empty fill g (p:ps) = fill1 g (reduceDoc p) 0 ps fill1 :: Bool -> RDoc -> Int -> [Doc] -> Doc fill1 g _ k ys | k `seq` False = undefined fill1 g NoDoc k ys = NoDoc fill1 g (p `Union` q) k ys = fill1 g p k ys `union_` (aboveNest q False k (fill g ys)) fill1 g Empty k ys = mkNest k (fill g ys) fill1 g (Nest n p) k ys = nest_ n (fill1 g p (k - n) ys) fill1 g (NilAbove p) k ys = nilAbove_ (aboveNest p False k (fill g ys)) fill1 g (TextBeside s sl p) k ys = textBeside_ s sl (fillNB g p (k - sl) ys) fillNB g _ k ys | k `seq` False = undefined fillNB g (Nest _ p) k ys = fillNB g p k ys fillNB g Empty k [] = Empty fillNB g Empty k (y:ys) = nilBeside g (fill1 g (oneLiner (reduceDoc y)) k1 ys) `mkUnion` nilAboveNest False k (fill g (y:ys)) where k1 | g = k - 1 | otherwise = k fillNB g p k ys = fill1 g p k ys -- --------------------------------------------------------------------------- -- Selecting the best layout best :: Mode -> Int -- Line length -> Int -- Ribbon length -> RDoc -> RDoc -- No unions in here! best OneLineMode w r p = get p where get Empty = Empty get NoDoc = NoDoc get (NilAbove p) = nilAbove_ (get p) get (TextBeside s sl p) = textBeside_ s sl (get p) get (Nest k p) = get p -- Elide nest get (p `Union` q) = first (get p) (get q) best mode w r p = get w p where get :: Int -- (Remaining) width of line -> Doc -> Doc get w _ | w==0 && False = undefined get w Empty = Empty get w NoDoc = NoDoc get w (NilAbove p) = nilAbove_ (get w p) get w (TextBeside s sl p) = textBeside_ s sl (get1 w sl p) get w (Nest k p) = nest_ k (get (w - k) p) get w (p `Union` q) = nicest w r (get w p) (get w q) get1 :: Int -- (Remaining) width of line -> Int -- Amount of first line already eaten up -> Doc -- This is an argument to TextBeside => eat Nests -> Doc -- No unions in here! get1 w _ _ | w==0 && False = undefined get1 w sl Empty = Empty get1 w sl NoDoc = NoDoc get1 w sl (NilAbove p) = nilAbove_ (get (w - sl) p) get1 w sl (TextBeside t tl p) = textBeside_ t tl (get1 w (sl + tl) p) get1 w sl (Nest k p) = get1 w sl p get1 w sl (p `Union` q) = nicest1 w r sl (get1 w sl p) (get1 w sl q) nicest w r p q = nicest1 w r 0 p q nicest1 w r sl p q | fits ((w `minn` r) - sl) p = p | otherwise = q fits :: Int -- Space available -> Doc -> Bool -- True if *first line* of Doc fits in space available fits n p | n < 0 = False fits n NoDoc = False fits n Empty = True fits n (NilAbove _) = True fits n (TextBeside _ sl p) = fits (n - sl) p minn x y | x < y = x | otherwise = y -- @first@ and @nonEmptySet@ are similar to @nicest@ and @fits@, only simpler. -- @first@ returns its first argument if it is non-empty, otherwise its second. first p q | nonEmptySet p = p | otherwise = q nonEmptySet NoDoc = False nonEmptySet (p `Union` q) = True nonEmptySet Empty = True nonEmptySet (NilAbove p) = True -- NoDoc always in first line nonEmptySet (TextBeside _ _ p) = nonEmptySet p nonEmptySet (Nest _ p) = nonEmptySet p -- @oneLiner@ returns the one-line members of the given set of @Doc@s. oneLiner :: Doc -> Doc oneLiner NoDoc = NoDoc oneLiner Empty = Empty oneLiner (NilAbove p) = NoDoc oneLiner (TextBeside s sl p) = textBeside_ s sl (oneLiner p) oneLiner (Nest k p) = nest_ k (oneLiner p) oneLiner (p `Union` q) = oneLiner p -- --------------------------------------------------------------------------- -- Displaying the best layout renderStyle style doc = fullRender (mode style) (lineLength style) (ribbonsPerLine style) string_txt "" doc render doc = showDoc doc "" showDoc doc rest = fullRender PageMode 100 1.5 string_txt rest doc string_txt (Chr c) s = c:s string_txt (Str s1) s2 = s1 ++ s2 string_txt (PStr s1) s2 = s1 ++ s2 fullRender OneLineMode _ _ txt end doc = easy_display space_text txt end (reduceDoc doc) fullRender LeftMode _ _ txt end doc = easy_display nl_text txt end (reduceDoc doc) fullRender mode line_length ribbons_per_line txt end doc = display mode line_length ribbon_length txt end best_doc where best_doc = best mode hacked_line_length ribbon_length (reduceDoc doc) hacked_line_length, ribbon_length :: Int ribbon_length = round (fromIntegral line_length / ribbons_per_line) hacked_line_length = case mode of { ZigZagMode -> maxBound; other -> line_length } display mode page_width ribbon_width txt end doc = case page_width - ribbon_width of { gap_width -> case gap_width `quot` 2 of { shift -> let lay k _ | k `seq` False = undefined lay k (Nest k1 p) = lay (k + k1) p lay k Empty = end lay k (NilAbove p) = nl_text `txt` lay k p lay k (TextBeside s sl p) = case mode of ZigZagMode | k >= gap_width -> nl_text `txt` ( Str (multi_ch shift '/') `txt` ( nl_text `txt` ( lay1 (k - shift) s sl p))) | k < 0 -> nl_text `txt` ( Str (multi_ch shift '\\') `txt` ( nl_text `txt` ( lay1 (k + shift) s sl p ))) other -> lay1 k s sl p lay1 k _ sl _ | k+sl `seq` False = undefined lay1 k s sl p = Str (indent k) `txt` (s `txt` lay2 (k + sl) p) lay2 k _ | k `seq` False = undefined lay2 k (NilAbove p) = nl_text `txt` lay k p lay2 k (TextBeside s sl p) = s `txt` (lay2 (k + sl) p) lay2 k (Nest _ p) = lay2 k p lay2 k Empty = end in lay 0 doc }} cant_fail = error "easy_display: NoDoc" easy_display nl_text txt end doc = lay doc cant_fail where lay NoDoc no_doc = no_doc lay (Union p q) no_doc = {- lay p -} (lay q cant_fail) -- Second arg can't be NoDoc lay (Nest k p) no_doc = lay p no_doc lay Empty no_doc = end lay (NilAbove p) no_doc = nl_text `txt` lay p cant_fail -- NoDoc always on first line lay (TextBeside s sl p) no_doc = s `txt` lay p no_doc -- OLD version: we shouldn't rely on tabs being 8 columns apart in the output. -- indent n | n >= 8 = '\t' : indent (n - 8) -- | otherwise = spaces n indent n = spaces n multi_ch 0 ch = "" multi_ch n ch = ch : multi_ch (n - 1) ch -- (spaces n) generates a list of n spaces -- -- It should never be called with 'n' < 0, but that can happen for reasons I don't understand -- Here's a test case: -- ncat x y = nest 4 $ cat [ x, y ] -- d1 = foldl1 ncat $ take 50 $ repeat $ char 'a' -- d2 = parens $ sep [ d1, text "+" , d1 ] -- main = print d2 -- I don't feel motivated enough to find the Real Bug, so meanwhile we just test for n<=0 spaces n | n <= 0 = "" | otherwise = ' ' : spaces (n - 1) {- Comments from Johannes Waldmann about what the problem might be: In the example above, d2 and d1 are deeply nested, but `text "+"' is not, so the layout function tries to "out-dent" it. when I look at the Doc values that are generated, there are lots of Nest constructors with negative arguments. see this sample output of d1 (obtained with hugs, :s -u) tBeside (TextDetails_Chr 'a') 1 Doc_Empty) (Doc_NilAbove (Doc_Nest (-241) (Doc_TextBeside (TextDetails_Chr 'a') 1 Doc_Empty))))) (Doc_NilAbove (Doc_Nest (-236) (Doc_TextBeside (TextDetails_Chr 'a') 1 (Doc_NilAbove (Doc_Nest (-5) (Doc_TextBeside (TextDetails_Chr 'a') 1 Doc_Empty)))))))) (Doc_NilAbove (Doc_Nest (-231) (Doc_TextBeside (TextDetails_Chr 'a') 1 (Doc_NilAbove (Doc_Nest (-5) (Doc_TextBeside (TextDetails_Chr 'a') 1 (Doc_NilAbove (Doc_Nest (-5) (Doc_TextBeside (TextDetails_Chr 'a') 1 Doc_Empty))))))))))) (Doc_NilAbove (Doc_Nest -} hugs98-plus-Sep2006/packages/base/Text/ParserCombinators/0000755006511100651110000000000010504340221022023 5ustar rossrosshugs98-plus-Sep2006/packages/base/Text/ParserCombinators/ReadPrec.hs0000644006511100651110000001072410504340221024050 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.ReadPrec -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (uses Text.ParserCombinators.ReadP) -- -- This library defines parser combinators for precedence parsing. ----------------------------------------------------------------------------- module Text.ParserCombinators.ReadPrec ( ReadPrec, -- :: * -> *; instance Functor, Monad, MonadPlus -- * Precedences Prec, -- :: *; = Int minPrec, -- :: Prec; = 0 -- * Precedence operations lift, -- :: ReadP a -> ReadPrec a prec, -- :: Prec -> ReadPrec a -> ReadPrec a step, -- :: ReadPrec a -> ReadPrec a reset, -- :: ReadPrec a -> ReadPrec a -- * Other operations -- | All are based directly on their similarly-named 'ReadP' counterparts. get, -- :: ReadPrec Char look, -- :: ReadPrec String (+++), -- :: ReadPrec a -> ReadPrec a -> ReadPrec a (<++), -- :: ReadPrec a -> ReadPrec a -> ReadPrec a pfail, -- :: ReadPrec a choice, -- :: [ReadPrec a] -> ReadPrec a -- * Converters readPrec_to_P, -- :: ReadPrec a -> (Int -> ReadP a) readP_to_Prec, -- :: (Int -> ReadP a) -> ReadPrec a readPrec_to_S, -- :: ReadPrec a -> (Int -> ReadS a) readS_to_Prec, -- :: (Int -> ReadS a) -> ReadPrec a ) where import Text.ParserCombinators.ReadP ( ReadP , ReadS , readP_to_S , readS_to_P ) import qualified Text.ParserCombinators.ReadP as ReadP ( get , look , (+++), (<++) , pfail ) import Control.Monad( MonadPlus(..) ) #ifdef __GLASGOW_HASKELL__ import GHC.Num( Num(..) ) import GHC.Base #endif -- --------------------------------------------------------------------------- -- The readPrec type newtype ReadPrec a = P { unP :: Prec -> ReadP a } -- Functor, Monad, MonadPlus instance Functor ReadPrec where fmap h (P f) = P (\n -> fmap h (f n)) instance Monad ReadPrec where return x = P (\_ -> return x) fail s = P (\_ -> fail s) P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n) instance MonadPlus ReadPrec where mzero = pfail mplus = (+++) -- precedences type Prec = Int minPrec :: Prec minPrec = 0 -- --------------------------------------------------------------------------- -- Operations over ReadPrec lift :: ReadP a -> ReadPrec a -- ^ Lift a precedence-insensitive 'ReadP' to a 'ReadPrec'. lift m = P (\_ -> m) step :: ReadPrec a -> ReadPrec a -- ^ Increases the precedence context by one. step (P f) = P (\n -> f (n+1)) reset :: ReadPrec a -> ReadPrec a -- ^ Resets the precedence context to zero. reset (P f) = P (\n -> f minPrec) prec :: Prec -> ReadPrec a -> ReadPrec a -- ^ @(prec n p)@ checks whether the precedence context is -- less than or equal to @n@, and -- -- * if not, fails -- -- * if so, parses @p@ in context @n@. prec n (P f) = P (\c -> if c <= n then f n else ReadP.pfail) -- --------------------------------------------------------------------------- -- Derived operations get :: ReadPrec Char -- ^ Consumes and returns the next character. -- Fails if there is no input left. get = lift ReadP.get look :: ReadPrec String -- ^ Look-ahead: returns the part of the input that is left, without -- consuming it. look = lift ReadP.look (+++) :: ReadPrec a -> ReadPrec a -> ReadPrec a -- ^ Symmetric choice. P f1 +++ P f2 = P (\n -> f1 n ReadP.+++ f2 n) (<++) :: ReadPrec a -> ReadPrec a -> ReadPrec a -- ^ Local, exclusive, left-biased choice: If left parser -- locally produces any result at all, then right parser is -- not used. P f1 <++ P f2 = P (\n -> f1 n ReadP.<++ f2 n) pfail :: ReadPrec a -- ^ Always fails. pfail = lift ReadP.pfail choice :: [ReadPrec a] -> ReadPrec a -- ^ Combines all parsers in the specified list. choice ps = foldr (+++) pfail ps -- --------------------------------------------------------------------------- -- Converting between ReadPrec and Read readPrec_to_P :: ReadPrec a -> (Int -> ReadP a) readPrec_to_P (P f) = f readP_to_Prec :: (Int -> ReadP a) -> ReadPrec a readP_to_Prec f = P f readPrec_to_S :: ReadPrec a -> (Int -> ReadS a) readPrec_to_S (P f) n = readP_to_S (f n) readS_to_Prec :: (Int -> ReadS a) -> ReadPrec a readS_to_Prec f = P (\n -> readS_to_P (f n)) hugs98-plus-Sep2006/packages/base/Text/ParserCombinators/ReadP.hs0000644006511100651110000004014110504340221023352 0ustar rossross{-# OPTIONS_GHC -fglasgow-exts -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.ReadP -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (local universal quantification) -- -- This is a library of parser combinators, originally written by Koen Claessen. -- It parses all alternatives in parallel, so it never keeps hold of -- the beginning of the input string, a common source of space leaks with -- other parsers. The '(+++)' choice combinator is genuinely commutative; -- it makes no difference which branch is \"shorter\". ----------------------------------------------------------------------------- module Text.ParserCombinators.ReadP ( -- * The 'ReadP' type #ifndef __NHC__ ReadP, -- :: * -> *; instance Functor, Monad, MonadPlus #else ReadPN, -- :: * -> * -> *; instance Functor, Monad, MonadPlus #endif -- * Primitive operations get, -- :: ReadP Char look, -- :: ReadP String (+++), -- :: ReadP a -> ReadP a -> ReadP a (<++), -- :: ReadP a -> ReadP a -> ReadP a gather, -- :: ReadP a -> ReadP (String, a) -- * Other operations pfail, -- :: ReadP a satisfy, -- :: (Char -> Bool) -> ReadP Char char, -- :: Char -> ReadP Char string, -- :: String -> ReadP String munch, -- :: (Char -> Bool) -> ReadP String munch1, -- :: (Char -> Bool) -> ReadP String skipSpaces, -- :: ReadP () choice, -- :: [ReadP a] -> ReadP a count, -- :: Int -> ReadP a -> ReadP [a] between, -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a option, -- :: a -> ReadP a -> ReadP a optional, -- :: ReadP a -> ReadP () many, -- :: ReadP a -> ReadP [a] many1, -- :: ReadP a -> ReadP [a] skipMany, -- :: ReadP a -> ReadP () skipMany1, -- :: ReadP a -> ReadP () sepBy, -- :: ReadP a -> ReadP sep -> ReadP [a] sepBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] endBy, -- :: ReadP a -> ReadP sep -> ReadP [a] endBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] chainr, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a chainl, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a chainl1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a chainr1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a manyTill, -- :: ReadP a -> ReadP end -> ReadP [a] -- * Running a parser ReadS, -- :: *; = String -> [(a,String)] readP_to_S, -- :: ReadP a -> ReadS a readS_to_P, -- :: ReadS a -> ReadP a -- * Properties -- $properties ) where import Control.Monad( MonadPlus(..), sequence, liftM2 ) #ifdef __GLASGOW_HASKELL__ #ifndef __HADDOCK__ import {-# SOURCE #-} GHC.Unicode ( isSpace ) #endif import GHC.List ( replicate ) import GHC.Base #else import Data.Char( isSpace ) #endif infixr 5 +++, <++ #ifdef __GLASGOW_HASKELL__ ------------------------------------------------------------------------ -- ReadS -- | A parser for a type @a@, represented as a function that takes a -- 'String' and returns a list of possible parses as @(a,'String')@ pairs. -- -- Note that this kind of backtracking parser is very inefficient; -- reading a large structure may be quite slow (cf 'ReadP'). type ReadS a = String -> [(a,String)] #endif -- --------------------------------------------------------------------------- -- The P type -- is representation type -- should be kept abstract data P a = Get (Char -> P a) | Look (String -> P a) | Fail | Result a (P a) | Final [(a,String)] -- invariant: list is non-empty! -- Monad, MonadPlus instance Monad P where return x = Result x Fail (Get f) >>= k = Get (\c -> f c >>= k) (Look f) >>= k = Look (\s -> f s >>= k) Fail >>= k = Fail (Result x p) >>= k = k x `mplus` (p >>= k) (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s] fail _ = Fail instance MonadPlus P where mzero = Fail -- most common case: two gets are combined Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c) -- results are delivered as soon as possible Result x p `mplus` q = Result x (p `mplus` q) p `mplus` Result x q = Result x (p `mplus` q) -- fail disappears Fail `mplus` p = p p `mplus` Fail = p -- two finals are combined -- final + look becomes one look and one final (=optimization) -- final + sthg else becomes one look and one final Final r `mplus` Final t = Final (r ++ t) Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s)) Final r `mplus` p = Look (\s -> Final (r ++ run p s)) Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r)) p `mplus` Final r = Look (\s -> Final (run p s ++ r)) -- two looks are combined (=optimization) -- look + sthg else floats upwards Look f `mplus` Look g = Look (\s -> f s `mplus` g s) Look f `mplus` p = Look (\s -> f s `mplus` p) p `mplus` Look f = Look (\s -> p `mplus` f s) -- --------------------------------------------------------------------------- -- The ReadP type #ifndef __NHC__ newtype ReadP a = R (forall b . (a -> P b) -> P b) #else #define ReadP (ReadPN b) newtype ReadPN b a = R ((a -> P b) -> P b) #endif -- Functor, Monad, MonadPlus instance Functor ReadP where fmap h (R f) = R (\k -> f (k . h)) instance Monad ReadP where return x = R (\k -> k x) fail _ = R (\_ -> Fail) R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k)) instance MonadPlus ReadP where mzero = pfail mplus = (+++) -- --------------------------------------------------------------------------- -- Operations over P final :: [(a,String)] -> P a -- Maintains invariant for Final constructor final [] = Fail final r = Final r run :: P a -> ReadS a run (Get f) (c:s) = run (f c) s run (Look f) s = run (f s) s run (Result x p) s = (x,s) : run p s run (Final r) _ = r run _ _ = [] -- --------------------------------------------------------------------------- -- Operations over ReadP get :: ReadP Char -- ^ Consumes and returns the next character. -- Fails if there is no input left. get = R Get look :: ReadP String -- ^ Look-ahead: returns the part of the input that is left, without -- consuming it. look = R Look pfail :: ReadP a -- ^ Always fails. pfail = R (\_ -> Fail) (+++) :: ReadP a -> ReadP a -> ReadP a -- ^ Symmetric choice. R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k) #ifndef __NHC__ (<++) :: ReadP a -> ReadP a -> ReadP a #else (<++) :: ReadPN a a -> ReadPN a a -> ReadPN a a #endif -- ^ Local, exclusive, left-biased choice: If left parser -- locally produces any result at all, then right parser is -- not used. #ifdef __GLASGOW_HASKELL__ R f <++ q = do s <- look probe (f return) s 0# where probe (Get f) (c:s) n = probe (f c) s (n+#1#) probe (Look f) s n = probe (f s) s n probe p@(Result _ _) _ n = discard n >> R (p >>=) probe (Final r) _ _ = R (Final r >>=) probe _ _ _ = q discard 0# = return () discard n = get >> discard (n-#1#) #else R f <++ q = do s <- look probe (f return) s 0 where probe (Get f) (c:s) n = probe (f c) s (n+1) probe (Look f) s n = probe (f s) s n probe p@(Result _ _) _ n = discard n >> R (p >>=) probe (Final r) _ _ = R (Final r >>=) probe _ _ _ = q discard 0 = return () discard n = get >> discard (n-1) #endif #ifndef __NHC__ gather :: ReadP a -> ReadP (String, a) #else -- gather :: ReadPN (String->P b) a -> ReadPN (String->P b) (String, a) #endif -- ^ Transforms a parser into one that does the same, but -- in addition returns the exact characters read. -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument -- is built using any occurrences of readS_to_P. gather (R m) = R (\k -> gath id (m (\a -> return (\s -> k (s,a))))) where gath l (Get f) = Get (\c -> gath (l.(c:)) (f c)) gath l Fail = Fail gath l (Look f) = Look (\s -> gath l (f s)) gath l (Result k p) = k (l []) `mplus` gath l p gath l (Final r) = error "do not use readS_to_P in gather!" -- --------------------------------------------------------------------------- -- Derived operations satisfy :: (Char -> Bool) -> ReadP Char -- ^ Consumes and returns the next character, if it satisfies the -- specified predicate. satisfy p = do c <- get; if p c then return c else pfail char :: Char -> ReadP Char -- ^ Parses and returns the specified character. char c = satisfy (c ==) string :: String -> ReadP String -- ^ Parses and returns the specified string. string this = do s <- look; scan this s where scan [] _ = do return this scan (x:xs) (y:ys) | x == y = do get; scan xs ys scan _ _ = do pfail munch :: (Char -> Bool) -> ReadP String -- ^ Parses the first zero or more characters satisfying the predicate. munch p = do s <- look scan s where scan (c:cs) | p c = do get; s <- scan cs; return (c:s) scan _ = do return "" munch1 :: (Char -> Bool) -> ReadP String -- ^ Parses the first one or more characters satisfying the predicate. munch1 p = do c <- get if p c then do s <- munch p; return (c:s) else pfail choice :: [ReadP a] -> ReadP a -- ^ Combines all parsers in the specified list. choice [] = pfail choice [p] = p choice (p:ps) = p +++ choice ps skipSpaces :: ReadP () -- ^ Skips all whitespace. skipSpaces = do s <- look skip s where skip (c:s) | isSpace c = do get; skip s skip _ = do return () count :: Int -> ReadP a -> ReadP [a] -- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of -- results is returned. count n p = sequence (replicate n p) between :: ReadP open -> ReadP close -> ReadP a -> ReadP a -- ^ @between open close p@ parses @open@, followed by @p@ and finally -- @close@. Only the value of @p@ is returned. between open close p = do open x <- p close return x option :: a -> ReadP a -> ReadP a -- ^ @option x p@ will either parse @p@ or return @x@ without consuming -- any input. option x p = p +++ return x optional :: ReadP a -> ReadP () -- ^ @optional p@ optionally parses @p@ and always returns @()@. optional p = (p >> return ()) +++ return () many :: ReadP a -> ReadP [a] -- ^ Parses zero or more occurrences of the given parser. many p = return [] +++ many1 p many1 :: ReadP a -> ReadP [a] -- ^ Parses one or more occurrences of the given parser. many1 p = liftM2 (:) p (many p) skipMany :: ReadP a -> ReadP () -- ^ Like 'many', but discards the result. skipMany p = many p >> return () skipMany1 :: ReadP a -> ReadP () -- ^ Like 'many1', but discards the result. skipMany1 p = p >> skipMany p sepBy :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@. -- Returns a list of values returned by @p@. sepBy p sep = sepBy1 p sep +++ return [] sepBy1 :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@. -- Returns a list of values returned by @p@. sepBy1 p sep = liftM2 (:) p (many (sep >> p)) endBy :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended -- by @sep@. endBy p sep = many (do x <- p ; sep ; return x) endBy1 :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended -- by @sep@. endBy1 p sep = many1 (do x <- p ; sep ; return x) chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@. -- Returns a value produced by a /right/ associative application of all -- functions returned by @op@. If there are no occurrences of @p@, @x@ is -- returned. chainr p op x = chainr1 p op +++ return x chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a -- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@. -- Returns a value produced by a /left/ associative application of all -- functions returned by @op@. If there are no occurrences of @p@, @x@ is -- returned. chainl p op x = chainl1 p op +++ return x chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a -- ^ Like 'chainr', but parses one or more occurrences of @p@. chainr1 p op = scan where scan = p >>= rest rest x = do f <- op y <- scan return (f x y) +++ return x chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a -- ^ Like 'chainl', but parses one or more occurrences of @p@. chainl1 p op = p >>= rest where rest x = do f <- op y <- p rest (f x y) +++ return x #ifndef __NHC__ manyTill :: ReadP a -> ReadP end -> ReadP [a] #else manyTill :: ReadPN [a] a -> ReadPN [a] end -> ReadPN [a] [a] #endif -- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@ -- succeeds. Returns a list of values returned by @p@. manyTill p end = scan where scan = (end >> return []) <++ (liftM2 (:) p scan) -- --------------------------------------------------------------------------- -- Converting between ReadP and Read #ifndef __NHC__ readP_to_S :: ReadP a -> ReadS a #else readP_to_S :: ReadPN a a -> ReadS a #endif -- ^ Converts a parser into a Haskell ReadS-style function. -- This is the main way in which you can \"run\" a 'ReadP' parser: -- the expanded type is -- @ readP_to_S :: ReadP a -> String -> [(a,String)] @ readP_to_S (R f) = run (f return) readS_to_P :: ReadS a -> ReadP a -- ^ Converts a Haskell ReadS-style function into a parser. -- Warning: This introduces local backtracking in the resulting -- parser, and therefore a possible inefficiency. readS_to_P r = R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s'])) -- --------------------------------------------------------------------------- -- QuickCheck properties that hold for the combinators {- $properties The following are QuickCheck specifications of what the combinators do. These can be seen as formal specifications of the behavior of the combinators. We use bags to give semantics to the combinators. > type Bag a = [a] Equality on bags does not care about the order of elements. > (=~) :: Ord a => Bag a -> Bag a -> Bool > xs =~ ys = sort xs == sort ys A special equality operator to avoid unresolved overloading when testing the properties. > (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool > (=~.) = (=~) Here follow the properties: > prop_Get_Nil = > readP_to_S get [] =~ [] > > prop_Get_Cons c s = > readP_to_S get (c:s) =~ [(c,s)] > > prop_Look s = > readP_to_S look s =~ [(s,s)] > > prop_Fail s = > readP_to_S pfail s =~. [] > > prop_Return x s = > readP_to_S (return x) s =~. [(x,s)] > > prop_Bind p k s = > readP_to_S (p >>= k) s =~. > [ ys'' > | (x,s') <- readP_to_S p s > , ys'' <- readP_to_S (k (x::Int)) s' > ] > > prop_Plus p q s = > readP_to_S (p +++ q) s =~. > (readP_to_S p s ++ readP_to_S q s) > > prop_LeftPlus p q s = > readP_to_S (p <++ q) s =~. > (readP_to_S p s +<+ readP_to_S q s) > where > [] +<+ ys = ys > xs +<+ _ = xs > > prop_Gather s = > forAll readPWithoutReadS $ \p -> > readP_to_S (gather p) s =~ > [ ((pre,x::Int),s') > | (x,s') <- readP_to_S p s > , let pre = take (length s - length s') s > ] > > prop_String_Yes this s = > readP_to_S (string this) (this ++ s) =~ > [(this,s)] > > prop_String_Maybe this s = > readP_to_S (string this) s =~ > [(this, drop (length this) s) | this `isPrefixOf` s] > > prop_Munch p s = > readP_to_S (munch p) s =~ > [(takeWhile p s, dropWhile p s)] > > prop_Munch1 p s = > readP_to_S (munch1 p) s =~ > [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)] > > prop_Choice ps s = > readP_to_S (choice ps) s =~. > readP_to_S (foldr (+++) pfail ps) s > > prop_ReadS r s = > readP_to_S (readS_to_P r) s =~. r s -} hugs98-plus-Sep2006/packages/base/Text/Read/0000755006511100651110000000000010504340221017241 5ustar rossrosshugs98-plus-Sep2006/packages/base/Text/Read/Lex.hs0000644006511100651110000003027210504340221020331 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Text.Read.Lex -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (uses Text.ParserCombinators.ReadP) -- -- The cut-down Haskell lexer, used by Text.Read -- ----------------------------------------------------------------------------- module Text.Read.Lex -- lexing types ( Lexeme(..) -- :: *; Show, Eq -- lexer , lex -- :: ReadP Lexeme Skips leading spaces , hsLex -- :: ReadP String , lexChar -- :: ReadP Char Reads just one char, with H98 escapes , readIntP -- :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a , readOctP -- :: Num a => ReadP a , readDecP -- :: Num a => ReadP a , readHexP -- :: Num a => ReadP a ) where import Text.ParserCombinators.ReadP #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Num( Num(..), Integer ) import GHC.Show( Show(..) ) #ifndef __HADDOCK__ import {-# SOURCE #-} GHC.Unicode ( isSpace, isAlpha, isAlphaNum ) #endif import GHC.Real( Ratio(..), Integral, Rational, (%), fromIntegral, toInteger, (^), (^^), infinity, notANumber ) import GHC.List import GHC.Enum( maxBound ) #else import Prelude hiding ( lex ) import Data.Char( chr, ord, isSpace, isAlpha, isAlphaNum ) import Data.Ratio( Ratio, (%) ) #endif #ifdef __HUGS__ import Hugs.Prelude( Ratio(..) ) #endif import Data.Maybe import Control.Monad -- ----------------------------------------------------------------------------- -- Lexing types -- ^ Haskell lexemes. data Lexeme = Char Char -- ^ Character literal | String String -- ^ String literal, with escapes interpreted | Punc String -- ^ Punctuation or reserved symbol, e.g. @(@, @::@ | Ident String -- ^ Haskell identifier, e.g. @foo@, @Baz@ | Symbol String -- ^ Haskell symbol, e.g. @>>@, @:%@ | Int Integer -- ^ Integer literal | Rat Rational -- ^ Floating point literal | EOF deriving (Eq, Show) -- ----------------------------------------------------------------------------- -- Lexing lex :: ReadP Lexeme lex = skipSpaces >> lexToken hsLex :: ReadP String -- ^ Haskell lexer: returns the lexed string, rather than the lexeme hsLex = do skipSpaces (s,_) <- gather lexToken return s lexToken :: ReadP Lexeme lexToken = lexEOF +++ lexLitChar +++ lexString +++ lexPunc +++ lexSymbol +++ lexId +++ lexNumber -- ---------------------------------------------------------------------- -- End of file lexEOF :: ReadP Lexeme lexEOF = do s <- look guard (null s) return EOF -- --------------------------------------------------------------------------- -- Single character lexemes lexPunc :: ReadP Lexeme lexPunc = do c <- satisfy isPuncChar return (Punc [c]) where isPuncChar c = c `elem` ",;()[]{}`" -- ---------------------------------------------------------------------- -- Symbols lexSymbol :: ReadP Lexeme lexSymbol = do s <- munch1 isSymbolChar if s `elem` reserved_ops then return (Punc s) -- Reserved-ops count as punctuation else return (Symbol s) where isSymbolChar c = c `elem` "!@#$%&*+./<=>?\\^|:-~" reserved_ops = ["..", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>"] -- ---------------------------------------------------------------------- -- identifiers lexId :: ReadP Lexeme lexId = lex_nan <++ lex_id where -- NaN and Infinity look like identifiers, so -- we parse them first. lex_nan = (string "NaN" >> return (Rat notANumber)) +++ (string "Infinity" >> return (Rat infinity)) lex_id = do c <- satisfy isIdsChar s <- munch isIdfChar return (Ident (c:s)) -- Identifiers can start with a '_' isIdsChar c = isAlpha c || c == '_' isIdfChar c = isAlphaNum c || c `elem` "_'" #ifndef __GLASGOW_HASKELL__ infinity, notANumber :: Rational infinity = 1 :% 0 notANumber = 0 :% 0 #endif -- --------------------------------------------------------------------------- -- Lexing character literals lexLitChar :: ReadP Lexeme lexLitChar = do char '\'' (c,esc) <- lexCharE guard (esc || c /= '\'') -- Eliminate '' possibility char '\'' return (Char c) lexChar :: ReadP Char lexChar = do { (c,_) <- lexCharE; return c } lexCharE :: ReadP (Char, Bool) -- "escaped or not"? lexCharE = do c <- get if c == '\\' then do c <- lexEsc; return (c, True) else do return (c, False) where lexEsc = lexEscChar +++ lexNumeric +++ lexCntrlChar +++ lexAscii lexEscChar = do c <- get case c of 'a' -> return '\a' 'b' -> return '\b' 'f' -> return '\f' 'n' -> return '\n' 'r' -> return '\r' 't' -> return '\t' 'v' -> return '\v' '\\' -> return '\\' '\"' -> return '\"' '\'' -> return '\'' _ -> pfail lexNumeric = do base <- lexBaseChar <++ return 10 n <- lexInteger base guard (n <= toInteger (ord maxBound)) return (chr (fromInteger n)) lexCntrlChar = do char '^' c <- get case c of '@' -> return '\^@' 'A' -> return '\^A' 'B' -> return '\^B' 'C' -> return '\^C' 'D' -> return '\^D' 'E' -> return '\^E' 'F' -> return '\^F' 'G' -> return '\^G' 'H' -> return '\^H' 'I' -> return '\^I' 'J' -> return '\^J' 'K' -> return '\^K' 'L' -> return '\^L' 'M' -> return '\^M' 'N' -> return '\^N' 'O' -> return '\^O' 'P' -> return '\^P' 'Q' -> return '\^Q' 'R' -> return '\^R' 'S' -> return '\^S' 'T' -> return '\^T' 'U' -> return '\^U' 'V' -> return '\^V' 'W' -> return '\^W' 'X' -> return '\^X' 'Y' -> return '\^Y' 'Z' -> return '\^Z' '[' -> return '\^[' '\\' -> return '\^\' ']' -> return '\^]' '^' -> return '\^^' '_' -> return '\^_' _ -> pfail lexAscii = do choice [ (string "SOH" >> return '\SOH') <++ (string "SO" >> return '\SO') -- \SO and \SOH need maximal-munch treatment -- See the Haskell report Sect 2.6 , string "NUL" >> return '\NUL' , string "STX" >> return '\STX' , string "ETX" >> return '\ETX' , string "EOT" >> return '\EOT' , string "ENQ" >> return '\ENQ' , string "ACK" >> return '\ACK' , string "BEL" >> return '\BEL' , string "BS" >> return '\BS' , string "HT" >> return '\HT' , string "LF" >> return '\LF' , string "VT" >> return '\VT' , string "FF" >> return '\FF' , string "CR" >> return '\CR' , string "SI" >> return '\SI' , string "DLE" >> return '\DLE' , string "DC1" >> return '\DC1' , string "DC2" >> return '\DC2' , string "DC3" >> return '\DC3' , string "DC4" >> return '\DC4' , string "NAK" >> return '\NAK' , string "SYN" >> return '\SYN' , string "ETB" >> return '\ETB' , string "CAN" >> return '\CAN' , string "EM" >> return '\EM' , string "SUB" >> return '\SUB' , string "ESC" >> return '\ESC' , string "FS" >> return '\FS' , string "GS" >> return '\GS' , string "RS" >> return '\RS' , string "US" >> return '\US' , string "SP" >> return '\SP' , string "DEL" >> return '\DEL' ] -- --------------------------------------------------------------------------- -- string literal lexString :: ReadP Lexeme lexString = do char '"' body id where body f = do (c,esc) <- lexStrItem if c /= '"' || esc then body (f.(c:)) else let s = f "" in return (String s) lexStrItem = (lexEmpty >> lexStrItem) +++ lexCharE lexEmpty = do char '\\' c <- get case c of '&' -> do return () _ | isSpace c -> do skipSpaces; char '\\'; return () _ -> do pfail -- --------------------------------------------------------------------------- -- Lexing numbers type Base = Int type Digits = [Int] lexNumber :: ReadP Lexeme lexNumber = lexHexOct <++ -- First try for hex or octal 0x, 0o etc -- If that fails, try for a decimal number lexDecNumber -- Start with ordinary digits lexHexOct :: ReadP Lexeme lexHexOct = do char '0' base <- lexBaseChar digits <- lexDigits base return (Int (val (fromIntegral base) 0 digits)) lexBaseChar :: ReadP Int -- Lex a single character indicating the base; fail if not there lexBaseChar = do { c <- get; case c of 'o' -> return 8 'O' -> return 8 'x' -> return 16 'X' -> return 16 _ -> pfail } lexDecNumber :: ReadP Lexeme lexDecNumber = do xs <- lexDigits 10 mFrac <- lexFrac <++ return Nothing mExp <- lexExp <++ return Nothing return (value xs mFrac mExp) where value xs mFrac mExp = valueFracExp (val 10 0 xs) mFrac mExp valueFracExp :: Integer -> Maybe Digits -> Maybe Integer -> Lexeme valueFracExp a Nothing Nothing = Int a -- 43 valueFracExp a Nothing (Just exp) | exp >= 0 = Int (a * (10 ^ exp)) -- 43e7 | otherwise = Rat (valExp (fromInteger a) exp) -- 43e-7 valueFracExp a (Just fs) mExp = case mExp of Nothing -> Rat rat -- 4.3 Just exp -> Rat (valExp rat exp) -- 4.3e-4 where rat :: Rational rat = fromInteger a + frac 10 0 1 fs valExp :: Rational -> Integer -> Rational valExp rat exp = rat * (10 ^^ exp) lexFrac :: ReadP (Maybe Digits) -- Read the fractional part; fail if it doesn't -- start ".d" where d is a digit lexFrac = do char '.' frac <- lexDigits 10 return (Just frac) lexExp :: ReadP (Maybe Integer) lexExp = do char 'e' +++ char 'E' exp <- signedExp +++ lexInteger 10 return (Just exp) where signedExp = do c <- char '-' +++ char '+' n <- lexInteger 10 return (if c == '-' then -n else n) lexDigits :: Int -> ReadP Digits -- Lex a non-empty sequence of digits in specified base lexDigits base = do s <- look xs <- scan s id guard (not (null xs)) return xs where scan (c:cs) f = case valDig base c of Just n -> do get; scan cs (f.(n:)) Nothing -> do return (f []) scan [] f = do return (f []) lexInteger :: Base -> ReadP Integer lexInteger base = do xs <- lexDigits base return (val (fromIntegral base) 0 xs) val :: Num a => a -> a -> Digits -> a -- val base y [d1,..,dn] = y ++ [d1,..,dn], as it were val base y [] = y val base y (x:xs) = y' `seq` val base y' xs where y' = y * base + fromIntegral x frac :: Integral a => a -> a -> a -> Digits -> Ratio a frac base a b [] = a % b frac base a b (x:xs) = a' `seq` b' `seq` frac base a' b' xs where a' = a * base + fromIntegral x b' = b * base valDig :: Num a => a -> Char -> Maybe Int valDig 8 c | '0' <= c && c <= '7' = Just (ord c - ord '0') | otherwise = Nothing valDig 10 c = valDecDig c valDig 16 c | '0' <= c && c <= '9' = Just (ord c - ord '0') | 'a' <= c && c <= 'f' = Just (ord c - ord 'a' + 10) | 'A' <= c && c <= 'F' = Just (ord c - ord 'A' + 10) | otherwise = Nothing valDecDig c | '0' <= c && c <= '9' = Just (ord c - ord '0') | otherwise = Nothing -- ---------------------------------------------------------------------- -- other numeric lexing functions readIntP :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a readIntP base isDigit valDigit = do s <- munch1 isDigit return (val base 0 (map valDigit s)) readIntP' :: Num a => a -> ReadP a readIntP' base = readIntP base isDigit valDigit where isDigit c = maybe False (const True) (valDig base c) valDigit c = maybe 0 id (valDig base c) readOctP, readDecP, readHexP :: Num a => ReadP a readOctP = readIntP' 8 readDecP = readIntP' 10 readHexP = readIntP' 16 hugs98-plus-Sep2006/packages/base/Text/Show/0000755006511100651110000000000010504340221017306 5ustar rossrosshugs98-plus-Sep2006/packages/base/Text/Show/Functions.hs0000644006511100651110000000131310504340221021610 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.Show.Functions -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Optional instance of 'Text.Show.Show' for functions: -- -- > instance Show (a -> b) where -- > showsPrec _ _ = showString \"\\" -- ----------------------------------------------------------------------------- module Text.Show.Functions () where import Prelude #ifndef __NHC__ instance Show (a -> b) where showsPrec _ _ = showString "" #endif hugs98-plus-Sep2006/packages/base/Text/PrettyPrint.hs0000644006511100651110000000132710504340221021231 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.PrettyPrint -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Re-export of "Text.PrettyPrint.HughesPJ" to provide a default -- pretty-printing library. Marked experimental at the moment; the -- default library might change at a later date. -- ----------------------------------------------------------------------------- module Text.PrettyPrint ( module Text.PrettyPrint.HughesPJ ) where import Prelude import Text.PrettyPrint.HughesPJ hugs98-plus-Sep2006/packages/base/Text/Printf.hs0000644006511100651110000002043210504340221020165 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.Printf -- Copyright : (c) Lennart Augustsson, 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : lennart@augustsson.net -- Stability : provisional -- Portability : portable -- -- A C printf like formatter. -- ----------------------------------------------------------------------------- module Text.Printf( printf, hPrintf, PrintfType, HPrintfType, PrintfArg, IsChar ) where import Prelude import Data.Array import Data.Char import Numeric(showEFloat, showFFloat, showGFloat) import System.IO ------------------- -- | Format a variable number of arguments with the C-style formatting string. -- The return value is either 'String' or @('IO' a)@. -- -- The format string consists of ordinary characters and /conversion -- specifications/, which specify how to format one of the arguments -- to printf in the output string. A conversion specification begins with the -- character @%@, followed by one or more of the following flags: -- -- > - left adjust (default is right adjust) -- > 0 pad with zeroes rather than spaces -- -- followed optionally by a field width: -- -- > num field width -- > * as num, but taken from argument list -- -- followed optionally by a precision: -- -- > .num precision (number of decimal places) -- -- and finally, a format character: -- -- > c character Char, Int, Integer -- > d decimal Char, Int, Integer -- > o octal Char, Int, Integer -- > x hexadecimal Char, Int, Integer -- > u unsigned decimal Char, Int, Integer -- > f floating point Float, Double -- > g general format float Float, Double -- > e exponent format float Float, Double -- > s string String -- -- Mismatch between the argument types and the format string will cause -- an exception to be thrown at runtime. -- -- Examples: -- -- > > printf "%d\n" (23::Int) -- > 23 -- > > printf "%s %s\n" "Hello" "World" -- > Hello World -- > > printf "%.2f\n" pi -- > 3.14 -- printf :: (PrintfType r) => String -> r printf fmt = spr fmt [] -- | Similar to 'printf', except that output is via the specified -- 'Handle'. The return type is restricted to @('IO' a)@. hPrintf :: (HPrintfType r) => Handle -> String -> r hPrintf hdl fmt = hspr hdl fmt [] -- |The 'PrintfType' class provides the variable argument magic for -- 'printf'. Its implementation is intentionally not visible from -- this module. If you attempt to pass an argument of a type which -- is not an instance of this class to 'printf' or 'hPrintf', then -- the compiler will report it as a missing instance of 'PrintfArg'. class PrintfType t where spr :: String -> [UPrintf] -> t -- | The 'HPrintfType' class provides the variable argument magic for -- 'hPrintf'. Its implementation is intentionally not visible from -- this module. class HPrintfType t where hspr :: Handle -> String -> [UPrintf] -> t {- not allowed in Haskell 98 instance PrintfType String where spr fmt args = uprintf fmt (reverse args) -} instance (IsChar c) => PrintfType [c] where spr fmt args = map fromChar (uprintf fmt (reverse args)) instance PrintfType (IO a) where spr fmt args = do putStr (uprintf fmt (reverse args)) return undefined instance HPrintfType (IO a) where hspr hdl fmt args = do hPutStr hdl (uprintf fmt (reverse args)) return undefined instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where spr fmt args = \ a -> spr fmt (toUPrintf a : args) instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where hspr hdl fmt args = \ a -> hspr hdl fmt (toUPrintf a : args) class PrintfArg a where toUPrintf :: a -> UPrintf instance PrintfArg Char where toUPrintf c = UChar c {- not allowed in Haskell 98 instance PrintfArg String where toUPrintf s = UString s -} instance (IsChar c) => PrintfArg [c] where toUPrintf s = UString (map toChar s) instance PrintfArg Int where toUPrintf i = UInt i instance PrintfArg Integer where toUPrintf i = UInteger i instance PrintfArg Float where toUPrintf f = UFloat f instance PrintfArg Double where toUPrintf d = UDouble d class IsChar c where toChar :: c -> Char fromChar :: Char -> c instance IsChar Char where toChar c = c fromChar c = c ------------------- data UPrintf = UChar Char | UString String | UInt Int | UInteger Integer | UFloat Float | UDouble Double uprintf :: String -> [UPrintf] -> String uprintf "" [] = "" uprintf "" (_:_) = fmterr uprintf ('%':'%':cs) us = '%':uprintf cs us uprintf ('%':_) [] = argerr uprintf ('%':cs) us@(_:_) = fmt cs us uprintf (c:cs) us = c:uprintf cs us fmt :: String -> [UPrintf] -> String fmt cs us = let (width, prec, ladj, zero, cs', us') = getSpecs False False cs us adjust (pre, str) = let lstr = length str lpre = length pre fill = if lstr+lpre < width then take (width-(lstr+lpre)) (repeat (if zero then '0' else ' ')) else "" in if ladj then pre ++ str ++ fill else if zero then pre ++ fill ++ str else fill ++ pre ++ str in case cs' of [] -> fmterr c:cs'' -> case us' of [] -> argerr u:us'' -> (case c of 'c' -> adjust ("", [toEnum (toint u)]) 'd' -> adjust (fmti u) 'x' -> adjust ("", fmtu 16 u) 'o' -> adjust ("", fmtu 8 u) 'u' -> adjust ("", fmtu 10 u) 'e' -> adjust (dfmt' c prec u) 'f' -> adjust (dfmt' c prec u) 'g' -> adjust (dfmt' c prec u) 's' -> adjust ("", tostr u) c -> perror ("bad formatting char " ++ [c]) ) ++ uprintf cs'' us'' fmti (UInt i) = if i < 0 then if i == -i then fmti (UInteger (toInteger i)) else ("-", itos (-i)) else ("", itos i) fmti (UInteger i) = if i < 0 then ("-", itos (-i)) else ("", itos i) fmti (UChar c) = fmti (UInt (fromEnum c)) fmti u = baderr fmtu b (UInt i) = if i < 0 then if i == -i then itosb b (maxi - toInteger (i+1) - 1) else itosb b (maxi - toInteger (-i)) else itosb b (toInteger i) fmtu b (UInteger i) = itosb b i fmtu b (UChar c) = itosb b (toInteger (fromEnum c)) fmtu b u = baderr maxi :: Integer maxi = (toInteger (maxBound::Int) + 1) * 2 toint (UInt i) = i toint (UInteger i) = toInt i toint (UChar c) = fromEnum c toint u = baderr tostr (UString s) = s tostr u = baderr itos n = if n < 10 then [toEnum (fromEnum '0' + toInt n)] else let (q, r) = quotRem n 10 in itos q ++ [toEnum (fromEnum '0' + toInt r)] chars = array (0,15) (zipWith (,) [0..] "0123456789abcdef") itosb :: Integer -> Integer -> String itosb b n = if n < b then [chars!n] else let (q, r) = quotRem n b in itosb b q ++ [chars!r] stoi :: Int -> String -> (Int, String) stoi a (c:cs) | isDigit c = stoi (a*10 + fromEnum c - fromEnum '0') cs stoi a cs = (a, cs) getSpecs :: Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool, String, [UPrintf]) getSpecs l z ('-':cs) us = getSpecs True z cs us getSpecs l z ('0':cs) us = getSpecs l True cs us getSpecs l z ('*':cs) us = case us of [] -> argerr nu : us' -> let n = toint nu (p, cs'', us'') = case cs of '.':'*':r -> case us' of { [] -> argerr; pu:us'' -> (toint pu, r, us'') } '.':r -> let (n, cs') = stoi 0 r in (n, cs', us') _ -> (-1, cs, us') in (n, p, l, z, cs'', us'') getSpecs l z ('.':cs) us = let (p, cs') = stoi 0 cs in (0, p, l, z, cs', us) getSpecs l z cs@(c:_) us | isDigit c = let (n, cs') = stoi 0 cs (p, cs'') = case cs' of '.':r -> stoi 0 r _ -> (-1, cs') in (n, p, l, z, cs'', us) getSpecs l z cs us = (0, -1, l, z, cs, us) dfmt' c p (UDouble d) = dfmt c p d dfmt' c p (UFloat f) = dfmt c p f dfmt' c p u = baderr dfmt c p d = case (case c of 'e' -> showEFloat; 'f' -> showFFloat; 'g' -> showGFloat) (if p < 0 then Nothing else Just p) d "" of '-':cs -> ("-", cs) cs -> ("" , cs) perror s = error ("Printf.printf: "++s) fmterr = perror "formatting string ended prematurely" argerr = perror "argument list ended prematurely" baderr = perror "bad argument" toInt :: (Integral a) => a -> Int toInt x = fromInteger (toInteger x) hugs98-plus-Sep2006/packages/base/Text/Read.hs0000644006511100651110000000374410504340221017605 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Text.Read -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (uses Text.ParserCombinators.ReadP) -- -- Converting strings to values. -- -- The "Text.Read" library is the canonical library to import for -- 'Read'-class facilities. For GHC only, it offers an extended and much -- improved 'Read' class, which constitutes a proposed alternative to the -- Haskell 98 'Read'. In particular, writing parsers is easier, and -- the parsers are much more efficient. -- ----------------------------------------------------------------------------- module Text.Read ( -- * The 'Read' class Read(..), -- The Read class ReadS, -- String -> Maybe (a,String) -- * Haskell 98 functions reads, -- :: (Read a) => ReadS a read, -- :: (Read a) => String -> a readParen, -- :: Bool -> ReadS a -> ReadS a lex, -- :: ReadS String #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -- * New parsing functions module Text.ParserCombinators.ReadPrec, L.Lexeme(..), lexP, -- :: ReadPrec Lexeme parens, -- :: ReadPrec a -> ReadPrec a #endif #ifdef __GLASGOW_HASKELL__ readListDefault, -- :: Read a => ReadS [a] readListPrecDefault, -- :: Read a => ReadPrec [a] #endif ) where #ifdef __GLASGOW_HASKELL__ import GHC.Read #endif #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) import Text.ParserCombinators.ReadPrec import qualified Text.Read.Lex as L #endif #ifdef __HUGS__ -- copied from GHC.Read lexP :: ReadPrec L.Lexeme lexP = lift L.lex parens :: ReadPrec a -> ReadPrec a parens p = optional where optional = p +++ mandatory mandatory = do L.Punc "(" <- lexP x <- reset optional L.Punc ")" <- lexP return x #endif hugs98-plus-Sep2006/packages/base/Text/Show.hs0000644006511100651110000000260510504340221017645 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Text.Show -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Converting values to readable strings: -- the 'Show' class and associated functions. -- ----------------------------------------------------------------------------- module Text.Show ( ShowS, -- String -> String Show( showsPrec, -- :: Int -> a -> ShowS show, -- :: a -> String showList -- :: [a] -> ShowS ), shows, -- :: (Show a) => a -> ShowS showChar, -- :: Char -> ShowS showString, -- :: String -> ShowS showParen, -- :: Bool -> ShowS -> ShowS showListWith, -- :: (a -> ShowS) -> [a] -> ShowS ) where #ifdef __GLASGOW_HASKELL__ import GHC.Show #endif -- | Show a list (using square brackets and commas), given a function -- for showing elements. showListWith :: (a -> ShowS) -> [a] -> ShowS showListWith = showList__ #ifndef __GLASGOW_HASKELL__ showList__ :: (a -> ShowS) -> [a] -> ShowS showList__ _ [] s = "[]" ++ s showList__ showx (x:xs) s = '[' : showx x (showl xs) where showl [] = ']' : s showl (y:ys) = ',' : showx y (showl ys) #endif hugs98-plus-Sep2006/packages/base/Makefile.nhc980000644006511100651110000000417610504340226020047 0ustar rossrossTHISPKG = base SEARCH = -I$(TOPDIR)/targets/$(MACHINE) -Iinclude EXTRA_H_FLAGS = -H4M -K2M EXTRA_HBC_FLAGS = -H16M -A1M SRCS = \ Data/Bits.hs Data/Bool.hs Data/Char.hs Data/Complex.hs \ Data/Either.hs Data/FiniteMap.hs Data/IORef.hs Data/Int.hs \ Data/Ix.hs Data/List.hs Data/Maybe.hs Data/PackedString.hs \ Data/Ratio.hs Data/Set.hs Data/Tuple.hs Data/Word.hs Data/Array.hs \ Data/HashTable.hs Data/Typeable.hs Data/Dynamic.hs \ Data/Monoid.hs Data/Queue.hs Data/Tree.hs \ Data/Map.hs Data/IntMap.hs Data/IntSet.hs Data/FunctorM.hs \ Data/Eq.hs Data/Ord.hs \ Control/Monad.hs Control/Monad/Fix.hs \ Control/Arrow.hs Debug/Trace.hs \ NHC/SizedTypes.hs \ System/IO.hs System/IO/Error.hs System/IO/Unsafe.hs \ System/Environment.hs System/Exit.hs System/Locale.hs \ System/Directory.hs System/Mem.hs System/Cmd.hs System/Info.hs \ System/Console/GetOpt.hs System/Random.hs \ System/CPUTime.hsc System/Time.hsc \ System/Directory/Internals.hs \ Foreign/Ptr.hs Foreign/StablePtr.hs Foreign/Storable.hs \ Foreign/ForeignPtr.hs Foreign/C/Types.hs \ Foreign/Marshal/Alloc.hs Foreign/Marshal/Array.hs \ Foreign/Marshal/Utils.hs Foreign/Marshal/Error.hs \ Foreign/Marshal/Pool.hs Foreign/Marshal.hs \ Foreign/C/String.hs Foreign/C/Error.hs Foreign/C.hs Foreign.hs \ Text/PrettyPrint/HughesPJ.hs Text/PrettyPrint.hs \ Text/Printf.hs \ Text/Read.hs Text/Show.hs Text/Show/Functions.hs \ Text/ParserCombinators/ReadP.hs Data/Version.hs \ WCsubst.c # Text/Regex/Posix.hsc Text/Regex.hs \ # Text/ParserCombinators/ReadPrec.hs # [Data/Dynamic.hs] Data/Generics.hs Data/STRef.hs Data/Unique.hs # System/Mem.hs System/Mem/StableName.hs System/Mem/Weak.hs # System/Posix/Types.hs System/Posix/Signals.hsc # Text/Read/Lex.hs # System/FilePath.hs # Here are the main rules. include ../Makefile.common # some extra rules extra: if [ -f Prelude.hs ]; then mv Prelude.hs Prelude.hs.unused; fi if [ -f Numeric.hs ]; then mv Numeric.hs Numeric.hs.unused; fi extracfiles: if [ -f Prelude.hs ]; then mv Prelude.hs Prelude.hs.unused; fi if [ -f Numeric.hs ]; then mv Numeric.hs Numeric.hs.unused; fi # Here are any extra dependencies. # C-files dependencies. hugs98-plus-Sep2006/packages/base/System/0000755006511100651110000000000010504340226016733 5ustar rossrosshugs98-plus-Sep2006/packages/base/System/Console/0000755006511100651110000000000010504340224020333 5ustar rossrosshugs98-plus-Sep2006/packages/base/System/Console/GetOpt.hs0000644006511100651110000003177610504340224022107 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Console.GetOpt -- Copyright : (c) Sven Panne 2002-2005 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- This library provides facilities for parsing the command-line options -- in a standalone program. It is essentially a Haskell port of the GNU -- @getopt@ library. -- ----------------------------------------------------------------------------- {- Sven Panne Oct. 1996 (small changes Dec. 1997) Two rather obscure features are missing: The Bash 2.0 non-option hack (if you don't already know it, you probably don't want to hear about it...) and the recognition of long options with a single dash (e.g. '-help' is recognised as '--help', as long as there is no short option 'h'). Other differences between GNU's getopt and this implementation: * To enforce a coherent description of options and arguments, there are explanation fields in the option/argument descriptor. * Error messages are now more informative, but no longer POSIX compliant... :-( And a final Haskell advertisement: The GNU C implementation uses well over 1100 lines, we need only 195 here, including a 46 line example! :-) -} module System.Console.GetOpt ( -- * GetOpt getOpt, getOpt', usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..), -- * Example -- $example ) where import Prelude -- necessary to get dependencies right import Data.List ( isPrefixOf ) -- |What to do with options following non-options data ArgOrder a = RequireOrder -- ^ no option processing after first non-option | Permute -- ^ freely intersperse options and non-options | ReturnInOrder (String -> a) -- ^ wrap non-options into options {-| Each 'OptDescr' describes a single option. The arguments to 'Option' are: * list of short option characters * list of long option strings (without \"--\") * argument descriptor * explanation of option for user -} data OptDescr a = -- description of a single options: Option [Char] -- list of short option characters [String] -- list of long option strings (without "--") (ArgDescr a) -- argument descriptor String -- explanation of option for user -- |Describes whether an option takes an argument or not, and if so -- how the argument is injected into a value of type @a@. data ArgDescr a = NoArg a -- ^ no argument expected | ReqArg (String -> a) String -- ^ option requires argument | OptArg (Maybe String -> a) String -- ^ optional argument data OptKind a -- kind of cmd line arg (internal use only): = Opt a -- an option | UnreqOpt String -- an un-recognized option | NonOpt String -- a non-option | EndOfOpts -- end-of-options marker (i.e. "--") | OptErr String -- something went wrong... -- | Return a string describing the usage of a command, derived from -- the header (first argument) and the options described by the -- second argument. usageInfo :: String -- header -> [OptDescr a] -- option descriptors -> String -- nicely formatted decription of options usageInfo header optDescr = unlines (header:table) where (ss,ls,ds) = (unzip3 . concatMap fmtOpt) optDescr table = zipWith3 paste (sameLen ss) (sameLen ls) ds paste x y z = " " ++ x ++ " " ++ y ++ " " ++ z sameLen xs = flushLeft ((maximum . map length) xs) xs flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ] fmtOpt :: OptDescr a -> [(String,String,String)] fmtOpt (Option sos los ad descr) = case lines descr of [] -> [(sosFmt,losFmt,"")] (d:ds) -> (sosFmt,losFmt,d) : [ ("","",d') | d' <- ds ] where sepBy _ [] = "" sepBy _ [x] = x sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs sosFmt = sepBy ',' (map (fmtShort ad) sos) losFmt = sepBy ',' (map (fmtLong ad) los) fmtShort :: ArgDescr a -> Char -> String fmtShort (NoArg _ ) so = "-" ++ [so] fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]" fmtLong :: ArgDescr a -> String -> String fmtLong (NoArg _ ) lo = "--" ++ lo fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]" {-| Process the command-line, and return the list of values that matched (and those that didn\'t). The arguments are: * The order requirements (see 'ArgOrder') * The option descriptions (see 'OptDescr') * The actual command line arguments (presumably got from 'System.Environment.getArgs'). 'getOpt' returns a triple consisting of the option arguments, a list of non-options, and a list of error messages. -} getOpt :: ArgOrder a -- non-option handling -> [OptDescr a] -- option descriptors -> [String] -- the command-line arguments -> ([a],[String],[String]) -- (options,non-options,error messages) getOpt ordering optDescr args = (os,xs,es ++ map errUnrec us) where (os,xs,us,es) = getOpt' ordering optDescr args {-| This is almost the same as 'getOpt', but returns a quadruple consisting of the option arguments, a list of non-options, a list of unrecognized options, and a list of error messages. -} getOpt' :: ArgOrder a -- non-option handling -> [OptDescr a] -- option descriptors -> [String] -- the command-line arguments -> ([a],[String], [String] ,[String]) -- (options,non-options,unrecognized,error messages) getOpt' _ _ [] = ([],[],[],[]) getOpt' ordering optDescr (arg:args) = procNextOpt opt ordering where procNextOpt (Opt o) _ = (o:os,xs,us,es) procNextOpt (UnreqOpt u) _ = (os,xs,u:us,es) procNextOpt (NonOpt x) RequireOrder = ([],x:rest,[],[]) procNextOpt (NonOpt x) Permute = (os,x:xs,us,es) procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,us,es) procNextOpt EndOfOpts RequireOrder = ([],rest,[],[]) procNextOpt EndOfOpts Permute = ([],rest,[],[]) procNextOpt EndOfOpts (ReturnInOrder f) = (map f rest,[],[],[]) procNextOpt (OptErr e) _ = (os,xs,us,e:es) (opt,rest) = getNext arg args optDescr (os,xs,us,es) = getOpt' ordering optDescr rest -- take a look at the next cmd line arg and decide what to do with it getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) getNext ('-':'-':[]) rest _ = (EndOfOpts,rest) getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr getNext ('-': x :xs) rest optDescr = shortOpt x xs rest optDescr getNext a rest _ = (NonOpt a,rest) -- handle long option longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) longOpt ls rs optDescr = long ads arg rs where (opt,arg) = break (=='=') ls getWith p = [ o | o@(Option _ xs _ _) <- optDescr, x <- xs, opt `p` x ] exact = getWith (==) options = if null exact then getWith isPrefixOf else exact ads = [ ad | Option _ _ ad _ <- options ] optStr = ("--"++opt) long (_:_:_) _ rest = (errAmbig options optStr,rest) long [NoArg a ] [] rest = (Opt a,rest) long [NoArg _ ] ('=':_) rest = (errNoArg optStr,rest) long [ReqArg _ d] [] [] = (errReq d optStr,[]) long [ReqArg f _] [] (r:rest) = (Opt (f r),rest) long [ReqArg f _] ('=':xs) rest = (Opt (f xs),rest) long [OptArg f _] [] rest = (Opt (f Nothing),rest) long [OptArg f _] ('=':xs) rest = (Opt (f (Just xs)),rest) long _ _ rest = (UnreqOpt ("--"++ls),rest) -- handle short option shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String]) shortOpt y ys rs optDescr = short ads ys rs where options = [ o | o@(Option ss _ _ _) <- optDescr, s <- ss, y == s ] ads = [ ad | Option _ _ ad _ <- options ] optStr = '-':[y] short (_:_:_) _ rest = (errAmbig options optStr,rest) short (NoArg a :_) [] rest = (Opt a,rest) short (NoArg a :_) xs rest = (Opt a,('-':xs):rest) short (ReqArg _ d:_) [] [] = (errReq d optStr,[]) short (ReqArg f _:_) [] (r:rest) = (Opt (f r),rest) short (ReqArg f _:_) xs rest = (Opt (f xs),rest) short (OptArg f _:_) [] rest = (Opt (f Nothing),rest) short (OptArg f _:_) xs rest = (Opt (f (Just xs)),rest) short [] [] rest = (UnreqOpt optStr,rest) short [] xs rest = (UnreqOpt optStr,('-':xs):rest) -- miscellaneous error formatting errAmbig :: [OptDescr a] -> String -> OptKind a errAmbig ods optStr = OptErr (usageInfo header ods) where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:" errReq :: String -> String -> OptKind a errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n") errUnrec :: String -> String errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n" errNoArg :: String -> OptKind a errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n") {- ----------------------------------------------------------------------------------------- -- and here a small and hopefully enlightening example: data Flag = Verbose | Version | Name String | Output String | Arg String deriving Show options :: [OptDescr Flag] options = [Option ['v'] ["verbose"] (NoArg Verbose) "verbosely list files", Option ['V','?'] ["version","release"] (NoArg Version) "show version info", Option ['o'] ["output"] (OptArg out "FILE") "use FILE for dump", Option ['n'] ["name"] (ReqArg Name "USER") "only dump USER's files"] out :: Maybe String -> Flag out Nothing = Output "stdout" out (Just o) = Output o test :: ArgOrder Flag -> [String] -> String test order cmdline = case getOpt order options cmdline of (o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n ++ "\n" (_,_,errs) -> concat errs ++ usageInfo header options where header = "Usage: foobar [OPTION...] files..." -- example runs: -- putStr (test RequireOrder ["foo","-v"]) -- ==> options=[] args=["foo", "-v"] -- putStr (test Permute ["foo","-v"]) -- ==> options=[Verbose] args=["foo"] -- putStr (test (ReturnInOrder Arg) ["foo","-v"]) -- ==> options=[Arg "foo", Verbose] args=[] -- putStr (test Permute ["foo","--","-v"]) -- ==> options=[] args=["foo", "-v"] -- putStr (test Permute ["-?o","--name","bar","--na=baz"]) -- ==> options=[Version, Output "stdout", Name "bar", Name "baz"] args=[] -- putStr (test Permute ["--ver","foo"]) -- ==> option `--ver' is ambiguous; could be one of: -- -v --verbose verbosely list files -- -V, -? --version, --release show version info -- Usage: foobar [OPTION...] files... -- -v --verbose verbosely list files -- -V, -? --version, --release show version info -- -o[FILE] --output[=FILE] use FILE for dump -- -n USER --name=USER only dump USER's files ----------------------------------------------------------------------------------------- -} {- $example To hopefully illuminate the role of the different data structures, here\'s the command-line options for a (very simple) compiler: > module Opts where > > import System.Console.GetOpt > import Data.Maybe ( fromMaybe ) > > data Flag > = Verbose | Version > | Input String | Output String | LibDir String > deriving Show > > options :: [OptDescr Flag] > options = > [ Option ['v'] ["verbose"] (NoArg Verbose) "chatty output on stderr" > , Option ['V','?'] ["version"] (NoArg Version) "show version number" > , Option ['o'] ["output"] (OptArg outp "FILE") "output FILE" > , Option ['c'] [] (OptArg inp "FILE") "input FILE" > , Option ['L'] ["libdir"] (ReqArg LibDir "DIR") "library directory" > ] > > inp,outp :: Maybe String -> Flag > outp = Output . fromMaybe "stdout" > inp = Input . fromMaybe "stdin" > > compilerOpts :: [String] -> IO ([Flag], [String]) > compilerOpts argv = > case getOpt Permute options argv of > (o,n,[] ) -> return (o,n) > (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) > where header = "Usage: ic [OPTION...] files..." -} hugs98-plus-Sep2006/packages/base/System/CPUTime.hsc0000644006511100651110000001205010504340221020671 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.CPUTime -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- The standard CPUTime library. -- ----------------------------------------------------------------------------- module System.CPUTime ( getCPUTime, -- :: IO Integer cpuTimePrecision -- :: Integer ) where import Prelude import Data.Ratio #ifdef __HUGS__ import Hugs.Time ( getCPUTime, clockTicks ) #endif #ifdef __NHC__ import CPUTime ( getCPUTime, cpuTimePrecision ) #endif #ifdef __GLASGOW_HASKELL__ import Foreign import Foreign.C #include "HsBase.h" #endif #ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- |Computation 'getCPUTime' returns the number of picoseconds CPU time -- used by the current program. The precision of this result is -- implementation-dependent. getCPUTime :: IO Integer getCPUTime = do #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) -- getrusage() is right royal pain to deal with when targetting multiple -- versions of Solaris, since some versions supply it in libc (2.3 and 2.5), -- while 2.4 has got it in libucb (I wouldn't be too surprised if it was back -- again in libucb in 2.6..) -- -- Avoid the problem by resorting to times() instead. -- #if defined(HAVE_GETRUSAGE) && ! irix_HOST_OS && ! solaris2_HOST_OS allocaBytes (#const sizeof(struct rusage)) $ \ p_rusage -> do getrusage (#const RUSAGE_SELF) p_rusage let ru_utime = (#ptr struct rusage, ru_utime) p_rusage let ru_stime = (#ptr struct rusage, ru_stime) p_rusage u_sec <- (#peek struct timeval,tv_sec) ru_utime :: IO CTime u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CTime s_sec <- (#peek struct timeval,tv_sec) ru_stime :: IO CTime s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CTime let realToInteger = round . realToFrac :: Real a => a -> Integer return ((realToInteger u_sec * 1000000 + realToInteger u_usec + realToInteger s_sec * 1000000 + realToInteger s_usec) * 1000000) type CRUsage = () foreign import ccall unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt #else # if defined(HAVE_TIMES) allocaBytes (#const sizeof(struct tms)) $ \ p_tms -> do times p_tms u_ticks <- (#peek struct tms,tms_utime) p_tms :: IO CClock s_ticks <- (#peek struct tms,tms_stime) p_tms :: IO CClock let realToInteger = round . realToFrac :: Real a => a -> Integer return (( (realToInteger u_ticks + realToInteger s_ticks) * 1000000000000) `div` fromIntegral clockTicks) type CTms = () foreign import ccall unsafe times :: Ptr CTms -> IO CClock # else ioException (IOError Nothing UnsupportedOperation "getCPUTime" "can't get CPU time" Nothing) # endif #endif #else /* win32 */ -- NOTE: GetProcessTimes() is only supported on NT-based OSes. -- The counts reported by GetProcessTimes() are in 100-ns (10^-7) units. allocaBytes (#const sizeof(FILETIME)) $ \ p_creationTime -> do allocaBytes (#const sizeof(FILETIME)) $ \ p_exitTime -> do allocaBytes (#const sizeof(FILETIME)) $ \ p_kernelTime -> do allocaBytes (#const sizeof(FILETIME)) $ \ p_userTime -> do pid <- getCurrentProcess ok <- getProcessTimes pid p_creationTime p_exitTime p_kernelTime p_userTime if toBool ok then do ut <- ft2psecs p_userTime kt <- ft2psecs p_kernelTime return (ut + kt) else return 0 where ft2psecs :: Ptr FILETIME -> IO Integer ft2psecs ft = do high <- (#peek FILETIME,dwHighDateTime) ft :: IO CLong low <- (#peek FILETIME,dwLowDateTime) ft :: IO CLong -- Convert 100-ns units to picosecs (10^-12) -- => multiply by 10^5. return (((fromIntegral high) * (2^32) + (fromIntegral low)) * 100000) -- ToDo: pin down elapsed times to just the OS thread(s) that -- are evaluating/managing Haskell code. type FILETIME = () type HANDLE = () -- need proper Haskell names (initial lower-case character) foreign import stdcall unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE) foreign import stdcall unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt #endif /* not _WIN32 */ #endif /* __GLASGOW_HASKELL__ */ -- |The 'cpuTimePrecision' constant is the smallest measurable difference -- in CPU time that the implementation can record, and is given as an -- integral number of picoseconds. #ifndef __NHC__ cpuTimePrecision :: Integer cpuTimePrecision = round ((1000000000000::Integer) % fromIntegral (clockTicks)) #endif #ifdef __GLASGOW_HASKELL__ clockTicks :: Int clockTicks = #if defined(CLK_TCK) (#const CLK_TCK) #else unsafePerformIO (sysconf (#const _SC_CLK_TCK) >>= return . fromIntegral) foreign import ccall unsafe sysconf :: CInt -> IO CLong #endif #endif /* __GLASGOW_HASKELL__ */ hugs98-plus-Sep2006/packages/base/System/Cmd.hs0000644006511100651110000001103410504340221017764 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Cmd -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Executing an external command. -- ----------------------------------------------------------------------------- module System.Cmd ( system, -- :: String -> IO ExitCode rawSystem, -- :: FilePath -> [String] -> IO ExitCode ) where import Prelude import System.Exit ( ExitCode ) #ifdef __GLASGOW_HASKELL__ import System.Process import GHC.IOBase ( ioException, IOException(..), IOErrorType(..) ) #if !defined(mingw32_HOST_OS) import System.Process.Internals import System.Posix.Signals #endif #endif #ifdef __HUGS__ import Hugs.System #endif #ifdef __NHC__ import System (system) #endif -- --------------------------------------------------------------------------- -- system {-| Computation @system cmd@ returns the exit code produced when the operating system processes the command @cmd@. This computation may fail with * @PermissionDenied@: The process has insufficient privileges to perform the operation. * @ResourceExhausted@: Insufficient resources are available to perform the operation. * @UnsupportedOperation@: The implementation does not support system calls. On Windows, 'system' is implemented using Windows's native system call, which ignores the @SHELL@ environment variable, and always passes the command to the Windows command interpreter (@CMD.EXE@ or @COMMAND.COM@), hence Unixy shell tricks will not work. -} #ifdef __GLASGOW_HASKELL__ system :: String -> IO ExitCode system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing) system str = do #if mingw32_HOST_OS p <- runCommand str waitForProcess p #else -- The POSIX version of system needs to do some manipulation of signal -- handlers. Since we're going to be synchronously waiting for the child, -- we want to ignore ^C in the parent, but handle it the default way -- in the child (using SIG_DFL isn't really correct, it should be the -- original signal handler, but the GHC RTS will have already set up -- its own handler and we don't want to use that). old_int <- installHandler sigINT Ignore Nothing old_quit <- installHandler sigQUIT Ignore Nothing (cmd,args) <- commandToProcess str p <- runProcessPosix "runCommand" cmd args Nothing Nothing Nothing Nothing Nothing (Just defaultSignal) (Just defaultSignal) r <- waitForProcess p installHandler sigINT old_int Nothing installHandler sigQUIT old_quit Nothing return r #endif /* mingw32_HOST_OS */ #endif /* __GLASGOW_HASKELL__ */ {-| The computation @'rawSystem' cmd args@ runs the operating system command @cmd@ in such a way that it receives as arguments the @args@ strings exactly as given, with no funny escaping or shell meta-syntax expansion. It will therefore behave more portably between operating systems than 'system'. The return codes and possible failures are the same as for 'system'. -} rawSystem :: String -> [String] -> IO ExitCode #ifdef __GLASGOW_HASKELL__ rawSystem cmd args = do #if mingw32_HOST_OS p <- runProcess cmd args Nothing Nothing Nothing Nothing Nothing waitForProcess p #else old_int <- installHandler sigINT Ignore Nothing old_quit <- installHandler sigQUIT Ignore Nothing p <- runProcessPosix "rawSystem" cmd args Nothing Nothing Nothing Nothing Nothing (Just defaultSignal) (Just defaultSignal) r <- waitForProcess p installHandler sigINT old_int Nothing installHandler sigQUIT old_quit Nothing return r #endif #elif !mingw32_HOST_OS -- crude fallback implementation: could do much better than this under Unix rawSystem cmd args = system (unwords (map translate (cmd:args))) translate :: String -> String translate str = '\'' : foldr escape "'" str where escape '\'' = showString "'\\''" escape c = showChar c #else /* mingw32_HOST_OS && ! __GLASGOW_HASKELL__ */ # if __HUGS__ rawSystem cmd args = system (unwords (cmd : map translate args)) # else rawSystem cmd args = system (unwords (map translate (cmd:args))) #endif -- copied from System.Process (qv) translate :: String -> String translate str = '"' : snd (foldr escape (True,"\"") str) where escape '"' (b, str) = (True, '\\' : '"' : str) escape '\\' (True, str) = (True, '\\' : '\\' : str) escape '\\' (False, str) = (False, '\\' : str) escape c (b, str) = (False, c : str) #endif hugs98-plus-Sep2006/packages/base/System/Directory/0000755006511100651110000000000010504340221020672 5ustar rossrosshugs98-plus-Sep2006/packages/base/System/Directory/Internals.hs0000644006511100651110000001402710504340221023171 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : System.Directory.Internals -- Copyright : (c) The University of Glasgow 2005 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : hidden -- Portability : portable -- -- System-independent pathname manipulations. -- ----------------------------------------------------------------------------- -- #hide module System.Directory.Internals ( joinFileName, joinFileExt, parseSearchPath, pathParents, exeExtension, ) where #if __GLASGOW_HASKELL__ import GHC.Base import GHC.IOBase (FilePath) #endif import Data.List -- | The 'joinFileName' function is the opposite of 'splitFileName'. -- It joins directory and file names to form a complete file path. -- -- The general rule is: -- -- > dir `joinFileName` basename == path -- > where -- > (dir,basename) = splitFileName path -- -- There might be an exceptions to the rule but in any case the -- reconstructed path will refer to the same object (file or directory). -- An example exception is that on Windows some slashes might be converted -- to backslashes. joinFileName :: String -> String -> FilePath joinFileName "" fname = fname joinFileName "." fname = fname joinFileName dir "" = dir joinFileName dir fname | isPathSeparator (last dir) = dir++fname | otherwise = dir++pathSeparator:fname -- | The 'joinFileExt' function is the opposite of 'splitFileExt'. -- It joins a file name and an extension to form a complete file path. -- -- The general rule is: -- -- > filename `joinFileExt` ext == path -- > where -- > (filename,ext) = splitFileExt path joinFileExt :: String -> String -> FilePath joinFileExt path "" = path joinFileExt path ext = path ++ '.':ext -- | Gets this path and all its parents. -- The function is useful in case if you want to create -- some file but you aren\'t sure whether all directories -- in the path exist or if you want to search upward for some file. -- -- Some examples: -- -- \[Posix\] -- -- > pathParents "/" == ["/"] -- > pathParents "/dir1" == ["/", "/dir1"] -- > pathParents "/dir1/dir2" == ["/", "/dir1", "/dir1/dir2"] -- > pathParents "dir1" == [".", "dir1"] -- > pathParents "dir1/dir2" == [".", "dir1", "dir1/dir2"] -- -- \[Windows\] -- -- > pathParents "c:" == ["c:."] -- > pathParents "c:\\" == ["c:\\"] -- > pathParents "c:\\dir1" == ["c:\\", "c:\\dir1"] -- > pathParents "c:\\dir1\\dir2" == ["c:\\", "c:\\dir1", "c:\\dir1\\dir2"] -- > pathParents "c:dir1" == ["c:.","c:dir1"] -- > pathParents "dir1\\dir2" == [".", "dir1", "dir1\\dir2"] -- -- Note that if the file is relative then the current directory (\".\") -- will be explicitly listed. pathParents :: FilePath -> [FilePath] pathParents p = root'' : map ((++) root') (dropEmptyPath $ inits path') where #ifdef mingw32_HOST_OS (root,path) = case break (== ':') p of (path, "") -> ("",path) (root,_:path) -> (root++":",path) #else (root,path) = ("",p) #endif (root',root'',path') = case path of (c:path) | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path) _ -> (root ,root++"." ,path) dropEmptyPath ("":paths) = paths dropEmptyPath paths = paths inits :: String -> [String] inits [] = [""] inits cs = case pre of "." -> inits suf ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf) _ -> "" : map (joinFileName pre) (inits suf) where (pre,suf) = case break isPathSeparator cs of (pre,"") -> (pre, "") (pre,_:suf) -> (pre,suf) -------------------------------------------------------------- -- * Search path -------------------------------------------------------------- -- | The function splits the given string to substrings -- using the 'searchPathSeparator'. parseSearchPath :: String -> [FilePath] parseSearchPath path = split path where split :: String -> [String] split s = case rest' of [] -> [chunk] _:rest -> chunk : split rest where chunk = case chunk' of #ifdef mingw32_HOST_OS ('\"':xs@(_:_)) | last xs == '\"' -> init xs #endif _ -> chunk' (chunk', rest') = break (==searchPathSeparator) s -------------------------------------------------------------- -- * Separators -------------------------------------------------------------- -- | Checks whether the character is a valid path separator for the host -- platform. The valid character is a 'pathSeparator' but since the Windows -- operating system also accepts a slash (\"\/\") since DOS 2, the function -- checks for it on this platform, too. isPathSeparator :: Char -> Bool isPathSeparator ch = ch == pathSeparator || ch == '/' -- | Provides a platform-specific character used to separate directory levels in -- a path string that reflects a hierarchical file system organization. The -- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash -- (@\"\\\"@) on the Windows operating system. pathSeparator :: Char #ifdef mingw32_HOST_OS pathSeparator = '\\' #else pathSeparator = '/' #endif -- ToDo: This should be determined via autoconf (PATH_SEPARATOR) -- | A platform-specific character used to separate search path strings in -- environment variables. The separator is a colon (@\":\"@) on Unix and -- Macintosh, and a semicolon (@\";\"@) on the Windows operating system. searchPathSeparator :: Char #ifdef mingw32_HOST_OS searchPathSeparator = ';' #else searchPathSeparator = ':' #endif -- ToDo: This should be determined via autoconf (AC_EXEEXT) -- | Extension for executable files -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2) exeExtension :: String #ifdef mingw32_HOST_OS exeExtension = "exe" #else exeExtension = "" #endif hugs98-plus-Sep2006/packages/base/System/IO/0000755006511100651110000000000010504340221017235 5ustar rossrosshugs98-plus-Sep2006/packages/base/System/IO/Error.hs0000644006511100651110000003130010504340221020657 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : System.IO.Error -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Standard IO Errors. -- ----------------------------------------------------------------------------- module System.IO.Error ( -- * I\/O errors IOError, -- = IOException userError, -- :: String -> IOError #ifndef __NHC__ mkIOError, -- :: IOErrorType -> String -> Maybe Handle -- -> Maybe FilePath -> IOError annotateIOError, -- :: IOError -> String -> Maybe Handle -- -> Maybe FilePath -> IOError #endif -- ** Classifying I\/O errors isAlreadyExistsError, -- :: IOError -> Bool isDoesNotExistError, isAlreadyInUseError, isFullError, isEOFError, isIllegalOperation, isPermissionError, isUserError, -- ** Attributes of I\/O errors #ifndef __NHC__ ioeGetErrorType, -- :: IOError -> IOErrorType #endif ioeGetErrorString, -- :: IOError -> String ioeGetHandle, -- :: IOError -> Maybe Handle ioeGetFileName, -- :: IOError -> Maybe FilePath #ifndef __NHC__ ioeSetErrorType, -- :: IOError -> IOErrorType -> IOError ioeSetErrorString, -- :: IOError -> String -> IOError ioeSetHandle, -- :: IOError -> Handle -> IOError ioeSetFileName, -- :: IOError -> FilePath -> IOError #endif -- * Types of I\/O error IOErrorType, -- abstract alreadyExistsErrorType, -- :: IOErrorType doesNotExistErrorType, alreadyInUseErrorType, fullErrorType, eofErrorType, illegalOperationErrorType, permissionErrorType, userErrorType, -- ** 'IOErrorType' predicates isAlreadyExistsErrorType, -- :: IOErrorType -> Bool isDoesNotExistErrorType, isAlreadyInUseErrorType, isFullErrorType, isEOFErrorType, isIllegalOperationErrorType, isPermissionErrorType, isUserErrorType, -- * Throwing and catching I\/O errors ioError, -- :: IOError -> IO a catch, -- :: IO a -> (IOError -> IO a) -> IO a try, -- :: IO a -> IO (Either IOError a) #ifndef __NHC__ modifyIOError, -- :: (IOError -> IOError) -> IO a -> IO a #endif ) where import Data.Either import Data.Maybe #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.IOBase import GHC.Exception import Text.Show #endif #ifdef __HUGS__ import Hugs.Prelude(Handle, IOException(..), IOErrorType(..)) #endif #ifdef __NHC__ import IO ( IOError () , try , ioError , userError , isAlreadyExistsError -- :: IOError -> Bool , isDoesNotExistError , isAlreadyInUseError , isFullError , isEOFError , isIllegalOperation , isPermissionError , isUserError , ioeGetErrorString -- :: IOError -> String , ioeGetHandle -- :: IOError -> Maybe Handle , ioeGetFileName -- :: IOError -> Maybe FilePath ) --import Data.Maybe (fromJust) --import Control.Monad (MonadPlus(mplus)) #endif -- | The construct 'try' @comp@ exposes IO errors which occur within a -- computation, and which are not fully handled. -- -- Non-I\/O exceptions are not caught by this variant; to catch all -- exceptions, use 'Control.Exception.try' from "Control.Exception". #ifndef __NHC__ try :: IO a -> IO (Either IOError a) try f = catch (do r <- f return (Right r)) (return . Left) #endif #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -- ----------------------------------------------------------------------------- -- Constructing an IOError -- | Construct an 'IOError' of the given type where the second argument -- describes the error location and the third and fourth argument -- contain the file handle and file path of the file involved in the -- error if applicable. mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError mkIOError t location maybe_hdl maybe_filename = IOError{ ioe_type = t, ioe_location = location, ioe_description = "", ioe_handle = maybe_hdl, ioe_filename = maybe_filename } #ifdef __NHC__ mkIOError EOF location maybe_hdl maybe_filename = EOFError location (fromJust maybe_hdl) mkIOError UserError location maybe_hdl maybe_filename = UserError location "" mkIOError t location maybe_hdl maybe_filename = NHC.FFI.mkIOError location maybe_filename maybe_handle (ioeTypeToInt t) where ioeTypeToInt AlreadyExists = fromEnum EEXIST ioeTypeToInt NoSuchThing = fromEnum ENOENT ioeTypeToInt ResourceBusy = fromEnum EBUSY ioeTypeToInt ResourceExhausted = fromEnum ENOSPC ioeTypeToInt IllegalOperation = fromEnum EPERM ioeTypeToInt PermissionDenied = fromEnum EACCES #endif #endif /* __GLASGOW_HASKELL__ || __HUGS__ */ #ifndef __NHC__ -- ----------------------------------------------------------------------------- -- IOErrorType -- | An error indicating that an 'IO' operation failed because -- one of its arguments already exists. isAlreadyExistsError :: IOError -> Bool isAlreadyExistsError = isAlreadyExistsErrorType . ioeGetErrorType -- | An error indicating that an 'IO' operation failed because -- one of its arguments does not exist. isDoesNotExistError :: IOError -> Bool isDoesNotExistError = isDoesNotExistErrorType . ioeGetErrorType -- | An error indicating that an 'IO' operation failed because -- one of its arguments is a single-use resource, which is already -- being used (for example, opening the same file twice for writing -- might give this error). isAlreadyInUseError :: IOError -> Bool isAlreadyInUseError = isAlreadyInUseErrorType . ioeGetErrorType -- | An error indicating that an 'IO' operation failed because -- the device is full. isFullError :: IOError -> Bool isFullError = isFullErrorType . ioeGetErrorType -- | An error indicating that an 'IO' operation failed because -- the end of file has been reached. isEOFError :: IOError -> Bool isEOFError = isEOFErrorType . ioeGetErrorType -- | An error indicating that an 'IO' operation failed because -- the operation was not possible. -- Any computation which returns an 'IO' result may fail with -- 'isIllegalOperation'. In some cases, an implementation will not be -- able to distinguish between the possible error causes. In this case -- it should fail with 'isIllegalOperation'. isIllegalOperation :: IOError -> Bool isIllegalOperation = isIllegalOperationErrorType . ioeGetErrorType -- | An error indicating that an 'IO' operation failed because -- the user does not have sufficient operating system privilege -- to perform that operation. isPermissionError :: IOError -> Bool isPermissionError = isPermissionErrorType . ioeGetErrorType -- | A programmer-defined error value constructed using 'userError'. isUserError :: IOError -> Bool isUserError = isUserErrorType . ioeGetErrorType #endif /* __NHC__ */ -- ----------------------------------------------------------------------------- -- IOErrorTypes #ifdef __NHC__ data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy | ResourceExhausted | EOF | IllegalOperation | PermissionDenied | UserError #endif -- | I\/O error where the operation failed because one of its arguments -- already exists. alreadyExistsErrorType :: IOErrorType alreadyExistsErrorType = AlreadyExists -- | I\/O error where the operation failed because one of its arguments -- does not exist. doesNotExistErrorType :: IOErrorType doesNotExistErrorType = NoSuchThing -- | I\/O error where the operation failed because one of its arguments -- is a single-use resource, which is already being used. alreadyInUseErrorType :: IOErrorType alreadyInUseErrorType = ResourceBusy -- | I\/O error where the operation failed because the device is full. fullErrorType :: IOErrorType fullErrorType = ResourceExhausted -- | I\/O error where the operation failed because the end of file has -- been reached. eofErrorType :: IOErrorType eofErrorType = EOF -- | I\/O error where the operation is not possible. illegalOperationErrorType :: IOErrorType illegalOperationErrorType = IllegalOperation -- | I\/O error where the operation failed because the user does not -- have sufficient operating system privilege to perform that operation. permissionErrorType :: IOErrorType permissionErrorType = PermissionDenied -- | I\/O error that is programmer-defined. userErrorType :: IOErrorType userErrorType = UserError -- ----------------------------------------------------------------------------- -- IOErrorType predicates -- | I\/O error where the operation failed because one of its arguments -- already exists. isAlreadyExistsErrorType :: IOErrorType -> Bool isAlreadyExistsErrorType AlreadyExists = True isAlreadyExistsErrorType _ = False -- | I\/O error where the operation failed because one of its arguments -- does not exist. isDoesNotExistErrorType :: IOErrorType -> Bool isDoesNotExistErrorType NoSuchThing = True isDoesNotExistErrorType _ = False -- | I\/O error where the operation failed because one of its arguments -- is a single-use resource, which is already being used. isAlreadyInUseErrorType :: IOErrorType -> Bool isAlreadyInUseErrorType ResourceBusy = True isAlreadyInUseErrorType _ = False -- | I\/O error where the operation failed because the device is full. isFullErrorType :: IOErrorType -> Bool isFullErrorType ResourceExhausted = True isFullErrorType _ = False -- | I\/O error where the operation failed because the end of file has -- been reached. isEOFErrorType :: IOErrorType -> Bool isEOFErrorType EOF = True isEOFErrorType _ = False -- | I\/O error where the operation is not possible. isIllegalOperationErrorType :: IOErrorType -> Bool isIllegalOperationErrorType IllegalOperation = True isIllegalOperationErrorType _ = False -- | I\/O error where the operation failed because the user does not -- have sufficient operating system privilege to perform that operation. isPermissionErrorType :: IOErrorType -> Bool isPermissionErrorType PermissionDenied = True isPermissionErrorType _ = False -- | I\/O error that is programmer-defined. isUserErrorType :: IOErrorType -> Bool isUserErrorType UserError = True isUserErrorType _ = False -- ----------------------------------------------------------------------------- -- Miscellaneous #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) ioeGetErrorType :: IOError -> IOErrorType ioeGetErrorString :: IOError -> String ioeGetHandle :: IOError -> Maybe Handle ioeGetFileName :: IOError -> Maybe FilePath ioeGetErrorType ioe = ioe_type ioe ioeGetErrorString ioe | isUserErrorType (ioe_type ioe) = ioe_description ioe | otherwise = show (ioe_type ioe) ioeGetHandle ioe = ioe_handle ioe ioeGetFileName ioe = ioe_filename ioe ioeSetErrorType :: IOError -> IOErrorType -> IOError ioeSetErrorString :: IOError -> String -> IOError ioeSetHandle :: IOError -> Handle -> IOError ioeSetFileName :: IOError -> FilePath -> IOError ioeSetErrorType ioe errtype = ioe{ ioe_type = errtype } ioeSetErrorString ioe str = ioe{ ioe_description = str } ioeSetHandle ioe hdl = ioe{ ioe_handle = Just hdl } ioeSetFileName ioe filename = ioe{ ioe_filename = Just filename } -- | Catch any 'IOError' that occurs in the computation and throw a -- modified version. modifyIOError :: (IOError -> IOError) -> IO a -> IO a modifyIOError f io = catch io (\e -> ioError (f e)) -- ----------------------------------------------------------------------------- -- annotating an IOError -- | Adds a location description and maybe a file path and file handle -- to an 'IOError'. If any of the file handle or file path is not given -- the corresponding value in the 'IOError' remains unaltered. annotateIOError :: IOError -> String -> Maybe Handle -> Maybe FilePath -> IOError annotateIOError (IOError ohdl errTy _ str opath) loc hdl path = IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath) where Nothing `mplus` ys = ys xs `mplus` _ = xs #endif /* __GLASGOW_HASKELL__ || __HUGS__ */ #if 0 /*__NHC__*/ annotateIOError (IOError msg file hdl code) msg' file' hdl' = IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code annotateIOError (EOFError msg hdl) msg' file' hdl' = EOFError (msg++'\n':msg') (hdl`mplus`hdl') annotateIOError (UserError loc msg) msg' file' hdl' = UserError loc (msg++'\n':msg') annotateIOError (PatternError loc) msg' file' hdl' = PatternError (loc++'\n':msg') #endif hugs98-plus-Sep2006/packages/base/System/IO/Unsafe.hs0000644006511100651110000000176510504340221021023 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : System.IO.Unsafe -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- \"Unsafe\" IO operations. -- ----------------------------------------------------------------------------- module System.IO.Unsafe ( -- * Unsafe 'System.IO.IO' operations unsafePerformIO, -- :: IO a -> a unsafeInterleaveIO, -- :: IO a -> IO a ) where #ifdef __GLASGOW_HASKELL__ import GHC.IOBase (unsafePerformIO, unsafeInterleaveIO) #endif #ifdef __HUGS__ import Hugs.IOExts (unsafePerformIO, unsafeInterleaveIO) #endif #ifdef __NHC__ import NHC.Internal (unsafePerformIO) #endif #if !__GLASGOW_HASKELL__ && !__HUGS__ unsafeInterleaveIO :: IO a -> IO a unsafeInterleaveIO f = return (unsafePerformIO f) #endif hugs98-plus-Sep2006/packages/base/System/Mem/0000755006511100651110000000000010504340221017444 5ustar rossrosshugs98-plus-Sep2006/packages/base/System/Mem/StableName.hs0000644006511100651110000000734610504340221022025 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Mem.StableName -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable -- -- Stable names are a way of performing fast (O(1)), not-quite-exact -- comparison between objects. -- -- Stable names solve the following problem: suppose you want to build -- a hash table with Haskell objects as keys, but you want to use -- pointer equality for comparison; maybe because the keys are large -- and hashing would be slow, or perhaps because the keys are infinite -- in size. We can\'t build a hash table using the address of the -- object as the key, because objects get moved around by the garbage -- collector, meaning a re-hash would be necessary after every garbage -- collection. -- ------------------------------------------------------------------------------- module System.Mem.StableName ( -- * Stable Names StableName, makeStableName, hashStableName, ) where import Prelude import Data.Typeable #ifdef __HUGS__ import Hugs.Stable #endif #ifdef __GLASGOW_HASKELL__ import GHC.IOBase ( IO(..) ) import GHC.Base ( Int(..), StableName#, makeStableName# , eqStableName#, stableNameToInt# ) ----------------------------------------------------------------------------- -- Stable Names {-| An abstract name for an object, that supports equality and hashing. Stable names have the following property: * If @sn1 :: StableName@ and @sn2 :: StableName@ and @sn1 == sn2@ then @sn1@ and @sn2@ were created by calls to @makeStableName@ on the same object. The reverse is not necessarily true: if two stable names are not equal, then the objects they name may still be equal. Stable Names are similar to Stable Pointers ("Foreign.StablePtr"), but differ in the following ways: * There is no @freeStableName@ operation, unlike "Foreign.StablePtr"s. Stable names are reclaimed by the runtime system when they are no longer needed. * There is no @deRefStableName@ operation. You can\'t get back from a stable name to the original Haskell object. The reason for this is that the existence of a stable name for an object does not guarantee the existence of the object itself; it can still be garbage collected. -} data StableName a = StableName (StableName# a) -- | Makes a 'StableName' for an arbitrary object. The object passed as -- the first argument is not evaluated by 'makeStableName'. makeStableName :: a -> IO (StableName a) #if defined(__PARALLEL_HASKELL__) makeStableName a = error "makeStableName not implemented in parallel Haskell" #else makeStableName a = IO $ \ s -> case makeStableName# a s of (# s', sn #) -> (# s', StableName sn #) #endif -- | Convert a 'StableName' to an 'Int'. The 'Int' returned is not -- necessarily unique; several 'StableName's may map to the same 'Int' -- (in practice however, the chances of this are small, so the result -- of 'hashStableName' makes a good hash key). hashStableName :: StableName a -> Int #if defined(__PARALLEL_HASKELL__) hashStableName (StableName sn) = error "hashStableName not implemented in parallel Haskell" #else hashStableName (StableName sn) = I# (stableNameToInt# sn) #endif instance Eq (StableName a) where #if defined(__PARALLEL_HASKELL__) (StableName sn1) == (StableName sn2) = error "eqStableName not implemented in parallel Haskell" #else (StableName sn1) == (StableName sn2) = case eqStableName# sn1 sn2 of 0# -> False _ -> True #endif #endif /* __GLASGOW_HASKELL__ */ #include "Typeable.h" INSTANCE_TYPEABLE1(StableName,stableNameTc,"StableName") hugs98-plus-Sep2006/packages/base/System/Mem/Weak.hs0000644006511100651110000001336110504340221020673 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Mem.Weak -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable -- -- In general terms, a weak pointer is a reference to an object that is -- not followed by the garbage collector - that is, the existence of a -- weak pointer to an object has no effect on the lifetime of that -- object. A weak pointer can be de-referenced to find out -- whether the object it refers to is still alive or not, and if so -- to return the object itself. -- -- Weak pointers are particularly useful for caches and memo tables. -- To build a memo table, you build a data structure -- mapping from the function argument (the key) to its result (the -- value). When you apply the function to a new argument you first -- check whether the key\/value pair is already in the memo table. -- The key point is that the memo table itself should not keep the -- key and value alive. So the table should contain a weak pointer -- to the key, not an ordinary pointer. The pointer to the value must -- not be weak, because the only reference to the value might indeed be -- from the memo table. -- -- So it looks as if the memo table will keep all its values -- alive for ever. One way to solve this is to purge the table -- occasionally, by deleting entries whose keys have died. -- -- The weak pointers in this library -- support another approach, called /finalization/. -- When the key referred to by a weak pointer dies, the storage manager -- arranges to run a programmer-specified finalizer. In the case of memo -- tables, for example, the finalizer could remove the key\/value pair -- from the memo table. -- -- Another difficulty with the memo table is that the value of a -- key\/value pair might itself contain a pointer to the key. -- So the memo table keeps the value alive, which keeps the key alive, -- even though there may be no other references to the key so both should -- die. The weak pointers in this library provide a slight -- generalisation of the basic weak-pointer idea, in which each -- weak pointer actually contains both a key and a value. -- ----------------------------------------------------------------------------- module System.Mem.Weak ( -- * The @Weak@ type Weak, -- abstract -- * The general interface mkWeak, -- :: k -> v -> Maybe (IO ()) -> IO (Weak v) deRefWeak, -- :: Weak v -> IO (Maybe v) finalize, -- :: Weak v -> IO () -- * Specialised versions mkWeakPtr, -- :: k -> Maybe (IO ()) -> IO (Weak k) addFinalizer, -- :: key -> IO () -> IO () mkWeakPair, -- :: k -> v -> Maybe (IO ()) -> IO (Weak (k,v)) -- replaceFinaliser -- :: Weak v -> IO () -> IO () -- * A precise semantics -- $precise ) where import Prelude import Data.Typeable #ifdef __HUGS__ import Hugs.Weak #endif #ifdef __GLASGOW_HASKELL__ import GHC.Weak #endif -- | A specialised version of 'mkWeak', where the key and the value are -- the same object: -- -- > mkWeakPtr key finalizer = mkWeak key key finalizer -- mkWeakPtr :: k -> Maybe (IO ()) -> IO (Weak k) mkWeakPtr key finalizer = mkWeak key key finalizer {-| A specialised version of 'mkWeakPtr', where the 'Weak' object returned is simply thrown away (however the finalizer will be remembered by the garbage collector, and will still be run when the key becomes unreachable). Note: adding a finalizer to a 'Foreign.ForeignPtr.ForeignPtr' using 'addFinalizer' won't work as well as using the specialised version 'Foreign.ForeignPtr.addForeignPtrFinalizer' because the latter version adds the finalizer to the primitive 'ForeignPtr#' object inside, whereas the generic 'addFinalizer' will add the finalizer to the box. Optimisations tend to remove the box, which may cause the finalizer to run earlier than you intended. The same motivation justifies the existence of 'Control.Concurrent.MVar.addMVarFinalizer' and 'Data.IORef.mkWeakIORef' (the non-uniformity is accidental). -} addFinalizer :: key -> IO () -> IO () addFinalizer key finalizer = do mkWeakPtr key (Just finalizer) -- throw it away return () -- | A specialised version of 'mkWeak' where the value is actually a pair -- of the key and value passed to 'mkWeakPair': -- -- > mkWeakPair key val finalizer = mkWeak key (key,val) finalizer -- -- The advantage of this is that the key can be retrieved by 'deRefWeak' -- in addition to the value. mkWeakPair :: k -> v -> Maybe (IO ()) -> IO (Weak (k,v)) mkWeakPair key val finalizer = mkWeak key (key,val) finalizer {- $precise The above informal specification is fine for simple situations, but matters can get complicated. In particular, it needs to be clear exactly when a key dies, so that any weak pointers that refer to it can be finalized. Suppose, for example, the value of one weak pointer refers to the key of another...does that keep the key alive? The behaviour is simply this: * If a weak pointer (object) refers to an /unreachable/ key, it may be finalized. * Finalization means (a) arrange that subsequent calls to 'deRefWeak' return 'Nothing'; and (b) run the finalizer. This behaviour depends on what it means for a key to be reachable. Informally, something is reachable if it can be reached by following ordinary pointers from the root set, but not following weak pointers. We define reachability more precisely as follows A heap object is reachable if: * It is a member of the /root set/. * It is directly pointed to by a reachable object, other than a weak pointer object. * It is a weak pointer object whose key is reachable. * It is the value or finalizer of an object whose key is reachable. -} hugs98-plus-Sep2006/packages/base/System/Directory.hs0000644006511100651110000007672110504340225021247 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Directory -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- System-independent interface to directory manipulation. -- ----------------------------------------------------------------------------- module System.Directory ( -- $intro -- * Actions on directories createDirectory -- :: FilePath -> IO () , createDirectoryIfMissing -- :: Bool -> FilePath -> IO () , removeDirectory -- :: FilePath -> IO () , removeDirectoryRecursive -- :: FilePath -> IO () , renameDirectory -- :: FilePath -> FilePath -> IO () , getDirectoryContents -- :: FilePath -> IO [FilePath] , getCurrentDirectory -- :: IO FilePath , setCurrentDirectory -- :: FilePath -> IO () -- * Pre-defined directories , getHomeDirectory , getAppUserDataDirectory , getUserDocumentsDirectory , getTemporaryDirectory -- * Actions on files , removeFile -- :: FilePath -> IO () , renameFile -- :: FilePath -> FilePath -> IO () , copyFile -- :: FilePath -> FilePath -> IO () , canonicalizePath , findExecutable -- * Existence tests , doesFileExist -- :: FilePath -> IO Bool , doesDirectoryExist -- :: FilePath -> IO Bool -- * Permissions -- $permissions , Permissions( Permissions, readable, -- :: Permissions -> Bool writable, -- :: Permissions -> Bool executable, -- :: Permissions -> Bool searchable -- :: Permissions -> Bool ) , getPermissions -- :: FilePath -> IO Permissions , setPermissions -- :: FilePath -> Permissions -> IO () -- * Timestamps , getModificationTime -- :: FilePath -> IO ClockTime ) where import System.Directory.Internals import System.Environment ( getEnv ) import System.IO.Error import Control.Monad ( when, unless ) #ifdef __NHC__ import Directory import NHC.FFI #endif /* __NHC__ */ #ifdef __HUGS__ import Hugs.Directory #endif /* __HUGS__ */ #if defined(__GLASGOW_HASKELL__) || defined(mingw32_HOST_OS) import Foreign import Foreign.C #endif #ifdef __GLASGOW_HASKELL__ import Prelude import Control.Exception ( bracket ) import System.Posix.Types import System.Posix.Internals import System.Time ( ClockTime(..) ) import System.IO import GHC.IOBase ( IOException(..), IOErrorType(..), ioException ) {- $intro A directory contains a series of entries, each of which is a named reference to a file system object (file, directory etc.). Some entries may be hidden, inaccessible, or have some administrative function (e.g. `.' or `..' under POSIX ), but in this standard all such entries are considered to form part of the directory contents. Entries in sub-directories are not, however, considered to form part of the directory contents. Each file system object is referenced by a /path/. There is normally at least one absolute path to each file system object. In some operating systems, it may also be possible to have paths which are relative to the current directory. -} ----------------------------------------------------------------------------- -- Permissions {- $permissions The 'Permissions' type is used to record whether certain operations are permissible on a file\/directory. 'getPermissions' and 'setPermissions' get and set these permissions, respectively. Permissions apply both to files and directories. For directories, the executable field will be 'False', and for files the searchable field will be 'False'. Note that directories may be searchable without being readable, if permission has been given to use them as part of a path, but not to examine the directory contents. Note that to change some, but not all permissions, a construct on the following lines must be used. > makeReadable f = do > p <- getPermissions f > setPermissions f (p {readable = True}) -} data Permissions = Permissions { readable, writable, executable, searchable :: Bool } deriving (Eq, Ord, Read, Show) {- |The 'getPermissions' operation returns the permissions for the file or directory. The operation may fail with: * 'isPermissionError' if the user is not permitted to access the permissions; or * 'isDoesNotExistError' if the file or directory does not exist. -} getPermissions :: FilePath -> IO Permissions getPermissions name = do withCString name $ \s -> do read <- c_access s r_OK write <- c_access s w_OK exec <- c_access s x_OK withFileStatus "getPermissions" name $ \st -> do is_dir <- isDirectory st return ( Permissions { readable = read == 0, writable = write == 0, executable = not is_dir && exec == 0, searchable = is_dir && exec == 0 } ) {- |The 'setPermissions' operation sets the permissions for the file or directory. The operation may fail with: * 'isPermissionError' if the user is not permitted to set the permissions; or * 'isDoesNotExistError' if the file or directory does not exist. -} setPermissions :: FilePath -> Permissions -> IO () setPermissions name (Permissions r w e s) = do allocaBytes sizeof_stat $ \ p_stat -> do withCString name $ \p_name -> do throwErrnoIfMinus1_ "setPermissions" $ do c_stat p_name p_stat mode <- st_mode p_stat let mode1 = modifyBit r mode s_IRUSR let mode2 = modifyBit w mode1 s_IWUSR let mode3 = modifyBit (e || s) mode2 s_IXUSR c_chmod p_name mode3 where modifyBit :: Bool -> CMode -> CMode -> CMode modifyBit False m b = m .&. (complement b) modifyBit True m b = m .|. b copyPermissions :: FilePath -> FilePath -> IO () copyPermissions source dest = do allocaBytes sizeof_stat $ \ p_stat -> do withCString source $ \p_source -> do withCString dest $ \p_dest -> do throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat mode <- st_mode p_stat throwErrnoIfMinus1_ "copyPermissions" $ c_chmod p_dest mode ----------------------------------------------------------------------------- -- Implementation {- |@'createDirectory' dir@ creates a new directory @dir@ which is initially empty, or as near to empty as the operating system allows. The operation may fail with: * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES]@ * 'isAlreadyExistsError' \/ 'AlreadyExists' The operand refers to a directory that already exists. @ [EEXIST]@ * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' The operand is not a valid directory name. @[ENAMETOOLONG, ELOOP]@ * 'NoSuchThing' There is no path to the directory. @[ENOENT, ENOTDIR]@ * 'ResourceExhausted' Insufficient resources (virtual memory, process file descriptors, physical disk space, etc.) are available to perform the operation. @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ * 'InappropriateType' The path refers to an existing non-directory object. @[EEXIST]@ -} createDirectory :: FilePath -> IO () createDirectory path = do modifyIOError (`ioeSetFileName` path) $ withCString path $ \s -> do throwErrnoIfMinus1Retry_ "createDirectory" $ mkdir s 0o777 #else /* !__GLASGOW_HASKELL__ */ copyPermissions :: FilePath -> FilePath -> IO () copyPermissions fromFPath toFPath = getPermissions fromFPath >>= setPermissions toFPath #endif -- | @'createDirectoryIfMissing' parents dir@ creates a new directory -- @dir@ if it doesn\'t exist. If the first argument is 'True' -- the function will also create all parent directories if they are missing. createDirectoryIfMissing :: Bool -- ^ Create its parents too? -> FilePath -- ^ The path to the directory you want to make -> IO () createDirectoryIfMissing parents file = do b <- doesDirectoryExist file case (b,parents, file) of (_, _, "") -> return () (True, _, _) -> return () (_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file)) (_, False, _) -> createDirectory file #if __GLASGOW_HASKELL__ {- | @'removeDirectory' dir@ removes an existing directory /dir/. The implementation may specify additional constraints which must be satisfied before a directory can be removed (e.g. the directory has to be empty, or may not be in use by other processes). It is not legal for an implementation to partially remove a directory unless the entire directory is removed. A conformant implementation need not support directory removal in all situations (e.g. removal of the root directory). The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. EIO * 'InvalidArgument' The operand is not a valid directory name. [ENAMETOOLONG, ELOOP] * 'isDoesNotExistError' \/ 'NoSuchThing' The directory does not exist. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES, EPERM]@ * 'UnsatisfiedConstraints' Implementation-dependent constraints are not satisfied. @[EBUSY, ENOTEMPTY, EEXIST]@ * 'UnsupportedOperation' The implementation does not support removal in this situation. @[EINVAL]@ * 'InappropriateType' The operand refers to an existing non-directory object. @[ENOTDIR]@ -} removeDirectory :: FilePath -> IO () removeDirectory path = do modifyIOError (`ioeSetFileName` path) $ withCString path $ \s -> throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s) #endif -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/ -- together with its content and all subdirectories. Be careful, -- if the directory contains symlinks, the function will follow them. removeDirectoryRecursive :: FilePath -> IO () removeDirectoryRecursive startLoc = do cont <- getDirectoryContents startLoc sequence_ [rm (startLoc `joinFileName` x) | x <- cont, x /= "." && x /= ".."] removeDirectory startLoc where rm :: FilePath -> IO () rm f = do temp <- try (removeFile f) case temp of Left e -> do isDir <- doesDirectoryExist f -- If f is not a directory, re-throw the error unless isDir $ ioError e removeDirectoryRecursive f Right _ -> return () #if __GLASGOW_HASKELL__ {- |'removeFile' /file/ removes the directory entry for an existing file /file/, where /file/ is not itself a directory. The implementation may specify additional constraints which must be satisfied before a file can be removed (e.g. the file may not be in use by other processes). The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' The operand is not a valid file name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The file does not exist. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES, EPERM]@ * 'UnsatisfiedConstraints' Implementation-dependent constraints are not satisfied. @[EBUSY]@ * 'InappropriateType' The operand refers to an existing directory. @[EPERM, EINVAL]@ -} removeFile :: FilePath -> IO () removeFile path = do modifyIOError (`ioeSetFileName` path) $ withCString path $ \s -> throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s) {- |@'renameDirectory' old new@ changes the name of an existing directory from /old/ to /new/. If the /new/ directory already exists, it is atomically replaced by the /old/ directory. If the /new/ directory is neither the /old/ directory nor an alias of the /old/ directory, it is removed as if by 'removeDirectory'. A conformant implementation need not support renaming directories in all situations (e.g. renaming to an existing directory, or across different physical devices), but the constraints must be documented. On Win32 platforms, @renameDirectory@ fails if the /new/ directory already exists. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' Either operand is not a valid directory name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The original directory does not exist, or there is no path to the target. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES, EPERM]@ * 'ResourceExhausted' Insufficient resources are available to perform the operation. @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ * 'UnsatisfiedConstraints' Implementation-dependent constraints are not satisfied. @[EBUSY, ENOTEMPTY, EEXIST]@ * 'UnsupportedOperation' The implementation does not support renaming in this situation. @[EINVAL, EXDEV]@ * 'InappropriateType' Either path refers to an existing non-directory object. @[ENOTDIR, EISDIR]@ -} renameDirectory :: FilePath -> FilePath -> IO () renameDirectory opath npath = withFileStatus "renameDirectory" opath $ \st -> do is_dir <- isDirectory st if (not is_dir) then ioException (IOError Nothing InappropriateType "renameDirectory" ("not a directory") (Just opath)) else do withCString opath $ \s1 -> withCString npath $ \s2 -> throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2) {- |@'renameFile' old new@ changes the name of an existing file system object from /old/ to /new/. If the /new/ object already exists, it is atomically replaced by the /old/ object. Neither path may refer to an existing directory. A conformant implementation need not support renaming files in all situations (e.g. renaming across different physical devices), but the constraints must be documented. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' Either operand is not a valid file name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The original file does not exist, or there is no path to the target. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EROFS, EACCES, EPERM]@ * 'ResourceExhausted' Insufficient resources are available to perform the operation. @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ * 'UnsatisfiedConstraints' Implementation-dependent constraints are not satisfied. @[EBUSY]@ * 'UnsupportedOperation' The implementation does not support renaming in this situation. @[EXDEV]@ * 'InappropriateType' Either path refers to an existing directory. @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@ -} renameFile :: FilePath -> FilePath -> IO () renameFile opath npath = withFileOrSymlinkStatus "renameFile" opath $ \st -> do is_dir <- isDirectory st if is_dir then ioException (IOError Nothing InappropriateType "renameFile" "is a directory" (Just opath)) else do withCString opath $ \s1 -> withCString npath $ \s2 -> throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2) #endif /* __GLASGOW_HASKELL__ */ {- |@'copyFile' old new@ copies the existing file from /old/ to /new/. If the /new/ file already exists, it is atomically replaced by the /old/ file. Neither path may refer to an existing directory. The permissions of /old/ are copied to /new/, if possible. -} {- NOTES: It's tempting to try to remove the target file before opening it for writing. This could be useful: for example if the target file is an executable that is in use, writing will fail, but unlinking first would succeed. However, it certainly isn't always what you want. * if the target file is hardlinked, removing it would break the hard link, but just opening would preserve it. * opening and truncating will preserve permissions and ACLs on the target. * If the destination file is read-only in a writable directory, we might want copyFile to fail. Removing the target first would succeed, however. * If the destination file is special (eg. /dev/null), removing it is probably not the right thing. Copying to /dev/null should leave /dev/null intact, not replace it with a plain file. * There's a small race condition between removing the target and opening it for writing during which time someone might create it again. -} copyFile :: FilePath -> FilePath -> IO () copyFile fromFPath toFPath = #if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600)) do readFile fromFPath >>= writeFile toFPath try (copyPermissions fromFPath toFPath) return () #else (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom -> bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo -> allocaBytes bufferSize $ \buffer -> do copyContents hFrom hTo buffer try (copyPermissions fromFPath toFPath) return ()) `catch` (ioError . changeFunName) where bufferSize = 1024 changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp copyContents hFrom hTo buffer = do count <- hGetBuf hFrom buffer bufferSize when (count > 0) $ do hPutBuf hTo buffer count copyContents hFrom hTo buffer #endif #ifdef __GLASGOW_HASKELL__ -- | Given path referring to a file or directory, returns a -- canonicalized path, with the intent that two paths referring -- to the same file\/directory will map to the same canonicalized -- path. Note that it is impossible to guarantee that the -- implication (same file\/dir \<=\> same canonicalizedPath) holds -- in either direction: this function can make only a best-effort -- attempt. canonicalizePath :: FilePath -> IO FilePath canonicalizePath fpath = withCString fpath $ \pInPath -> allocaBytes long_path_size $ \pOutPath -> #if defined(mingw32_HOST_OS) alloca $ \ppFilePart -> do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart #else do c_realpath pInPath pOutPath #endif peekCString pOutPath #if defined(mingw32_HOST_OS) foreign import stdcall unsafe "GetFullPathNameA" c_GetFullPathName :: CString -> CInt -> CString -> Ptr CString -> IO CInt #else foreign import ccall unsafe "realpath" c_realpath :: CString -> CString -> IO CString #endif #else /* !__GLASGOW_HASKELL__ */ -- dummy implementation canonicalizePath :: FilePath -> IO FilePath canonicalizePath fpath = return fpath #endif /* !__GLASGOW_HASKELL__ */ -- | Given an executable file name, searches for such file -- in the directories listed in system PATH. The returned value -- is the path to the found executable or Nothing if there isn't -- such executable. For example (findExecutable \"ghc\") -- gives you the path to GHC. findExecutable :: String -> IO (Maybe FilePath) findExecutable binary = #if defined(mingw32_HOST_OS) withCString binary $ \c_binary -> withCString ('.':exeExtension) $ \c_ext -> allocaBytes long_path_size $ \pOutPath -> alloca $ \ppFilePart -> do res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart if res > 0 && res < fromIntegral long_path_size then do fpath <- peekCString pOutPath return (Just fpath) else return Nothing foreign import stdcall unsafe "SearchPathA" c_SearchPath :: CString -> CString -> CString -> CInt -> CString -> Ptr CString -> IO CInt # if !defined(__GLASGOW_HASKELL__) long_path_size :: Int long_path_size = 4096 # endif #else do path <- getEnv "PATH" search (parseSearchPath path) where fileName = binary `joinFileExt` exeExtension search :: [FilePath] -> IO (Maybe FilePath) search [] = return Nothing search (d:ds) = do let path = d `joinFileName` fileName b <- doesFileExist path if b then return (Just path) else search ds #endif #ifdef __GLASGOW_HASKELL__ {- |@'getDirectoryContents' dir@ returns a list of /all/ entries in /dir/. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' The operand is not a valid directory name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The directory does not exist. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EACCES]@ * 'ResourceExhausted' Insufficient resources are available to perform the operation. @[EMFILE, ENFILE]@ * 'InappropriateType' The path refers to an existing non-directory object. @[ENOTDIR]@ -} getDirectoryContents :: FilePath -> IO [FilePath] getDirectoryContents path = do modifyIOError (`ioeSetFileName` path) $ alloca $ \ ptr_dEnt -> bracket (withCString path $ \s -> throwErrnoIfNullRetry desc (c_opendir s)) (\p -> throwErrnoIfMinus1_ desc (c_closedir p)) (\p -> loop ptr_dEnt p) where desc = "getDirectoryContents" loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String] loop ptr_dEnt dir = do resetErrno r <- readdir dir ptr_dEnt if (r == 0) then do dEnt <- peek ptr_dEnt if (dEnt == nullPtr) then return [] else do entry <- (d_name dEnt >>= peekCString) freeDirEnt dEnt entries <- loop ptr_dEnt dir return (entry:entries) else do errno <- getErrno if (errno == eINTR) then loop ptr_dEnt dir else do let (Errno eo) = errno if (eo == end_of_dir) then return [] else throwErrno desc {- |If the operating system has a notion of current directories, 'getCurrentDirectory' returns an absolute path to the current directory of the calling process. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'isDoesNotExistError' \/ 'NoSuchThing' There is no path referring to the current directory. @[EPERM, ENOENT, ESTALE...]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EACCES]@ * 'ResourceExhausted' Insufficient resources are available to perform the operation. * 'UnsupportedOperation' The operating system has no notion of current directory. -} getCurrentDirectory :: IO FilePath getCurrentDirectory = do p <- mallocBytes long_path_size go p long_path_size where go p bytes = do p' <- c_getcwd p (fromIntegral bytes) if p' /= nullPtr then do s <- peekCString p' free p' return s else do errno <- getErrno if errno == eRANGE then do let bytes' = bytes * 2 p' <- reallocBytes p bytes' go p' bytes' else throwErrno "getCurrentDirectory" {- |If the operating system has a notion of current directories, @'setCurrentDirectory' dir@ changes the current directory of the calling process to /dir/. The operation may fail with: * 'HardwareFault' A physical I\/O error has occurred. @[EIO]@ * 'InvalidArgument' The operand is not a valid directory name. @[ENAMETOOLONG, ELOOP]@ * 'isDoesNotExistError' \/ 'NoSuchThing' The directory does not exist. @[ENOENT, ENOTDIR]@ * 'isPermissionError' \/ 'PermissionDenied' The process has insufficient privileges to perform the operation. @[EACCES]@ * 'UnsupportedOperation' The operating system has no notion of current directory, or the current directory cannot be dynamically changed. * 'InappropriateType' The path refers to an existing non-directory object. @[ENOTDIR]@ -} setCurrentDirectory :: FilePath -> IO () setCurrentDirectory path = do modifyIOError (`ioeSetFileName` path) $ withCString path $ \s -> throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s) -- ToDo: add path to error {- |The operation 'doesDirectoryExist' returns 'True' if the argument file exists and is a directory, and 'False' otherwise. -} doesDirectoryExist :: FilePath -> IO Bool doesDirectoryExist name = catch (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st) (\ _ -> return False) {- |The operation 'doesFileExist' returns 'True' if the argument file exists and is not a directory, and 'False' otherwise. -} doesFileExist :: FilePath -> IO Bool doesFileExist name = do catch (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b)) (\ _ -> return False) {- |The 'getModificationTime' operation returns the clock time at which the file or directory was last modified. The operation may fail with: * 'isPermissionError' if the user is not permitted to access the modification time; or * 'isDoesNotExistError' if the file or directory does not exist. -} getModificationTime :: FilePath -> IO ClockTime getModificationTime name = withFileStatus "getModificationTime" name $ \ st -> modificationTime st withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a withFileStatus loc name f = do modifyIOError (`ioeSetFileName` name) $ allocaBytes sizeof_stat $ \p -> withCString (fileNameEndClean name) $ \s -> do throwErrnoIfMinus1Retry_ loc (c_stat s p) f p withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a withFileOrSymlinkStatus loc name f = do modifyIOError (`ioeSetFileName` name) $ allocaBytes sizeof_stat $ \p -> withCString name $ \s -> do throwErrnoIfMinus1Retry_ loc (lstat s p) f p modificationTime :: Ptr CStat -> IO ClockTime modificationTime stat = do mtime <- st_mtime stat let realToInteger = round . realToFrac :: Real a => a -> Integer return (TOD (realToInteger (mtime :: CTime)) 0) isDirectory :: Ptr CStat -> IO Bool isDirectory stat = do mode <- st_mode stat return (s_isdir mode) fileNameEndClean :: String -> String fileNameEndClean name = if i > 0 && (ec == '\\' || ec == '/') then fileNameEndClean (take i name) else name where i = (length name) - 1 ec = name !! i foreign import ccall unsafe "__hscore_long_path_size" long_path_size :: Int foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode #endif /* __GLASGOW_HASKELL__ */ {- | Returns the current user's home directory. The directory returned is expected to be writable by the current user, but note that it isn't generally considered good practice to store application-specific data here; use 'getAppUserDataDirectory' instead. On Unix, 'getHomeDirectory' returns the value of the @HOME@ environment variable. On Windows, the system is queried for a suitable path; a typical path might be @C:/Documents And Settings/user@. The operation may fail with: * 'UnsupportedOperation' The operating system has no notion of home directory. * 'isDoesNotExistError' The home directory for the current user does not exist, or cannot be found. -} getHomeDirectory :: IO FilePath getHomeDirectory = #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) allocaBytes long_path_size $ \pPath -> do r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath if (r < 0) then do r <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath when (r < 0) (raiseUnsupported "System.Directory.getHomeDirectory") else return () peekCString pPath #else getEnv "HOME" #endif {- | Returns the pathname of a directory in which application-specific data for the current user can be stored. The result of 'getAppUserDataDirectory' for a given application is specific to the current user. The argument should be the name of the application, which will be used to construct the pathname (so avoid using unusual characters that might result in an invalid pathname). Note: the directory may not actually exist, and may need to be created first. It is expected that the parent directory exists and is writable. On Unix, this function returns @$HOME\/.appName@. On Windows, a typical path might be > C:/Documents And Settings/user/Application Data/appName The operation may fail with: * 'UnsupportedOperation' The operating system has no notion of application-specific data directory. * 'isDoesNotExistError' The home directory for the current user does not exist, or cannot be found. -} getAppUserDataDirectory :: String -> IO FilePath getAppUserDataDirectory appName = do #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) allocaBytes long_path_size $ \pPath -> do r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory") s <- peekCString pPath return (s++'\\':appName) #else path <- getEnv "HOME" return (path++'/':'.':appName) #endif {- | Returns the current user's document directory. The directory returned is expected to be writable by the current user, but note that it isn't generally considered good practice to store application-specific data here; use 'getAppUserDataDirectory' instead. On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@ environment variable. On Windows, the system is queried for a suitable path; a typical path might be @C:\/Documents and Settings\/user\/My Documents@. The operation may fail with: * 'UnsupportedOperation' The operating system has no notion of document directory. * 'isDoesNotExistError' The document directory for the current user does not exist, or cannot be found. -} getUserDocumentsDirectory :: IO FilePath getUserDocumentsDirectory = do #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) allocaBytes long_path_size $ \pPath -> do r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory") peekCString pPath #else getEnv "HOME" #endif {- | Returns the current directory for temporary files. On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@ environment variable or \"\/tmp\" if the variable isn\'t defined. On Windows, the function checks for the existence of environment variables in the following order and uses the first path found: * TMP environment variable. * TEMP environment variable. * USERPROFILE environment variable. * The Windows directory The operation may fail with: * 'UnsupportedOperation' The operating system has no notion of temporary directory. The function doesn\'t verify whether the path exists. -} getTemporaryDirectory :: IO FilePath getTemporaryDirectory = do #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) allocaBytes long_path_size $ \pPath -> do r <- c_GetTempPath (fromIntegral long_path_size) pPath peekCString pPath #else catch (getEnv "TMPDIR") (\ex -> return "/tmp") #endif #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) foreign import ccall unsafe "__hscore_getFolderPath" c_SHGetFolderPath :: Ptr () -> CInt -> Ptr () -> CInt -> CString -> IO CInt foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt raiseUnsupported loc = ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing) #endif hugs98-plus-Sep2006/packages/base/System/Environment.hs0000644006511100651110000001226710504340221021576 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Environment -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Miscellaneous information about the system environment. -- ----------------------------------------------------------------------------- module System.Environment ( getArgs, -- :: IO [String] getProgName, -- :: IO String getEnv, -- :: String -> IO String #ifndef __NHC__ withArgs, withProgName, #endif #ifdef __GLASGOW_HASKELL__ getEnvironment, #endif ) where import Prelude #ifdef __GLASGOW_HASKELL__ import Foreign import Foreign.C import Control.Exception ( bracket ) import Control.Monad import GHC.IOBase #endif #ifdef __HUGS__ import Hugs.System #endif #ifdef __NHC__ import System ( getArgs , getProgName , getEnv ) #endif -- --------------------------------------------------------------------------- -- getArgs, getProgName, getEnv -- | Computation 'getArgs' returns a list of the program's command -- line arguments (not including the program name). #ifdef __GLASGOW_HASKELL__ getArgs :: IO [String] getArgs = alloca $ \ p_argc -> alloca $ \ p_argv -> do getProgArgv p_argc p_argv p <- fromIntegral `liftM` peek p_argc argv <- peek p_argv peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString foreign import ccall unsafe "getProgArgv" getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO () {-| Computation 'getProgName' returns the name of the program as it was invoked. However, this is hard-to-impossible to implement on some non-Unix OSes, so instead, for maximum portability, we just return the leafname of the program as invoked. Even then there are some differences between platforms: on Windows, for example, a program invoked as foo is probably really @FOO.EXE@, and that is what 'getProgName' will return. -} getProgName :: IO String getProgName = alloca $ \ p_argc -> alloca $ \ p_argv -> do getProgArgv p_argc p_argv argv <- peek p_argv unpackProgName argv unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0] unpackProgName argv = do s <- peekElemOff argv 0 >>= peekCString return (basename s) where basename :: String -> String basename f = go f f where go acc [] = acc go acc (x:xs) | isPathSeparator x = go xs xs | otherwise = go acc xs isPathSeparator :: Char -> Bool isPathSeparator '/' = True #ifdef mingw32_HOST_OS isPathSeparator '\\' = True #endif isPathSeparator _ = False -- | Computation 'getEnv' @var@ returns the value -- of the environment variable @var@. -- -- This computation may fail with: -- -- * 'System.IO.Error.isDoesNotExistError' if the environment variable -- does not exist. getEnv :: String -> IO String getEnv name = withCString name $ \s -> do litstring <- c_getenv s if litstring /= nullPtr then peekCString litstring else ioException (IOError Nothing NoSuchThing "getEnv" "no environment variable" (Just name)) foreign import ccall unsafe "getenv" c_getenv :: CString -> IO (Ptr CChar) {-| 'withArgs' @args act@ - while executing action @act@, have 'getArgs' return @args@. -} withArgs :: [String] -> IO a -> IO a withArgs xs act = do p <- System.Environment.getProgName withArgv (p:xs) act {-| 'withProgName' @name act@ - while executing action @act@, have 'getProgName' return @name@. -} withProgName :: String -> IO a -> IO a withProgName nm act = do xs <- System.Environment.getArgs withArgv (nm:xs) act -- Worker routine which marshals and replaces an argv vector for -- the duration of an action. withArgv :: [String] -> IO a -> IO a withArgv new_args act = do pName <- System.Environment.getProgName existing_args <- System.Environment.getArgs bracket (setArgs new_args) (\argv -> do setArgs (pName:existing_args); freeArgv argv) (const act) freeArgv :: Ptr CString -> IO () freeArgv argv = do size <- lengthArray0 nullPtr argv sequence_ [peek (argv `advancePtr` i) >>= free | i <- [size, size-1 .. 0]] free argv setArgs :: [String] -> IO (Ptr CString) setArgs argv = do vs <- mapM newCString argv >>= newArray0 nullPtr setArgsPrim (length argv) vs return vs foreign import ccall unsafe "setProgArgv" setArgsPrim :: Int -> Ptr CString -> IO () -- |'getEnvironment' retrieves the entire environment as a -- list of @(key,value)@ pairs. -- -- If an environment entry does not contain an @\'=\'@ character, -- the @key@ is the whole entry and the @value@ is the empty string. getEnvironment :: IO [(String, String)] getEnvironment = do pBlock <- getEnvBlock if pBlock == nullPtr then return [] else do stuff <- peekArray0 nullPtr pBlock >>= mapM peekCString return (map divvy stuff) where divvy str = case break (=='=') str of (xs,[]) -> (xs,[]) -- don't barf (like Posix.getEnvironment) (name,_:value) -> (name,value) foreign import ccall unsafe "__hscore_environ" getEnvBlock :: IO (Ptr CString) #endif /* __GLASGOW_HASKELL__ */ hugs98-plus-Sep2006/packages/base/System/Exit.hs0000644006511100651110000000441110504340221020173 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Exit -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Exiting the program. -- ----------------------------------------------------------------------------- module System.Exit ( ExitCode(ExitSuccess,ExitFailure) , exitWith -- :: ExitCode -> IO a , exitFailure -- :: IO a ) where import Prelude #ifdef __GLASGOW_HASKELL__ import GHC.IOBase #endif #ifdef __HUGS__ import Hugs.Prelude import Hugs.Exception #endif #ifdef __NHC__ import System ( ExitCode(..) , exitWith ) #endif -- --------------------------------------------------------------------------- -- exitWith -- | Computation 'exitWith' @code@ throws 'ExitException' @code@. -- Normally this terminates the program, returning @code@ to the -- program's caller. Before the program terminates, any open or -- semi-closed handles are first closed. -- -- A program that fails in any other way is treated as if it had -- called 'exitFailure'. -- A program that terminates successfully without calling 'exitWith' -- explicitly is treated as it it had called 'exitWith' 'ExitSuccess'. -- -- As an 'ExitException' is not an 'IOError', 'exitWith' bypasses -- the error handling in the 'IO' monad and cannot be intercepted by -- 'catch' from the "Prelude". However it is an 'Exception', and can -- be caught using the functions of "Control.Exception". This means -- that cleanup computations added with 'Control.Exception.bracket' -- (from "Control.Exception") are also executed properly on 'exitWith'. #ifndef __NHC__ exitWith :: ExitCode -> IO a exitWith ExitSuccess = throwIO (ExitException ExitSuccess) exitWith code@(ExitFailure n) | n /= 0 = throwIO (ExitException code) #ifdef __GLASGOW_HASKELL__ | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing) #endif #endif /* ! __NHC__ */ -- | The computation 'exitFailure' is equivalent to -- 'exitWith' @(@'ExitFailure' /exitfail/@)@, -- where /exitfail/ is implementation-dependent. exitFailure :: IO a exitFailure = exitWith (ExitFailure 1) hugs98-plus-Sep2006/packages/base/System/Info.hs0000644006511100651110000000323710504340221020162 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Info -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Information about the characteristics of the host -- system lucky enough to run your program. -- ----------------------------------------------------------------------------- module System.Info ( os, -- :: String arch, -- :: String compilerName, -- :: String compilerVersion -- :: Version ) where import Prelude import Data.Version -- | The version of 'compilerName' with which the program was compiled -- or is being interpreted. compilerVersion :: Version compilerVersion = Version {versionBranch=[maj,min], versionTags=[]} where (maj,min) = compilerVersionRaw `divMod` 100 -- | The operating system on which the program is running. os :: String -- | The machine architecture on which the program is running. arch :: String -- | The Haskell implementation with which the program was compiled -- or is being interpreted. compilerName :: String compilerVersionRaw :: Int #if defined(__NHC__) #include "OSInfo.hs" compilerName = "nhc98" compilerVersionRaw = __NHC__ #elif defined(__GLASGOW_HASKELL__) #include "ghcplatform.h" os = HOST_OS arch = HOST_ARCH compilerName = "ghc" compilerVersionRaw = __GLASGOW_HASKELL__ #elif defined(__HUGS__) #include "platform.h" os = HOST_OS arch = HOST_ARCH compilerName = "hugs" compilerVersionRaw = 0 -- ToDo #else #error Unknown compiler name #endif hugs98-plus-Sep2006/packages/base/System/IO.hs0000644006511100651110000003313310504340222017575 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : System.IO -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- The standard IO library. -- ----------------------------------------------------------------------------- module System.IO ( -- * The IO monad IO, -- instance MonadFix fixIO, -- :: (a -> IO a) -> IO a -- * Files and handles FilePath, -- :: String Handle, -- abstract, instance of: Eq, Show. -- ** Standard handles -- | Three handles are allocated during program initialisation, -- and are initially open. stdin, stdout, stderr, -- :: Handle -- * Opening and closing files -- ** Opening files openFile, -- :: FilePath -> IOMode -> IO Handle IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode), -- ** Closing files hClose, -- :: Handle -> IO () -- ** Special cases -- | These functions are also exported by the "Prelude". readFile, -- :: FilePath -> IO String writeFile, -- :: FilePath -> String -> IO () appendFile, -- :: FilePath -> String -> IO () -- ** File locking -- $locking -- * Operations on handles -- ** Determining and changing the size of a file hFileSize, -- :: Handle -> IO Integer #ifdef __GLASGOW_HASKELL__ hSetFileSize, -- :: Handle -> Integer -> IO () #endif -- ** Detecting the end of input hIsEOF, -- :: Handle -> IO Bool isEOF, -- :: IO Bool -- ** Buffering operations BufferMode(NoBuffering,LineBuffering,BlockBuffering), hSetBuffering, -- :: Handle -> BufferMode -> IO () hGetBuffering, -- :: Handle -> IO BufferMode hFlush, -- :: Handle -> IO () -- ** Repositioning handles hGetPosn, -- :: Handle -> IO HandlePosn hSetPosn, -- :: HandlePosn -> IO () HandlePosn, -- abstract, instance of: Eq, Show. hSeek, -- :: Handle -> SeekMode -> Integer -> IO () SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd), #if !defined(__NHC__) hTell, -- :: Handle -> IO Integer #endif -- ** Handle properties hIsOpen, hIsClosed, -- :: Handle -> IO Bool hIsReadable, hIsWritable, -- :: Handle -> IO Bool hIsSeekable, -- :: Handle -> IO Bool -- ** Terminal operations #if !defined(__NHC__) hIsTerminalDevice, -- :: Handle -> IO Bool hSetEcho, -- :: Handle -> Bool -> IO () hGetEcho, -- :: Handle -> IO Bool #endif -- ** Showing handle state #ifdef __GLASGOW_HASKELL__ hShow, -- :: Handle -> IO String #endif -- * Text input and output -- ** Text input hWaitForInput, -- :: Handle -> Int -> IO Bool hReady, -- :: Handle -> IO Bool hGetChar, -- :: Handle -> IO Char hGetLine, -- :: Handle -> IO [Char] hLookAhead, -- :: Handle -> IO Char hGetContents, -- :: Handle -> IO [Char] -- ** Text output hPutChar, -- :: Handle -> Char -> IO () hPutStr, -- :: Handle -> [Char] -> IO () hPutStrLn, -- :: Handle -> [Char] -> IO () hPrint, -- :: Show a => Handle -> a -> IO () -- ** Special cases for standard input and output -- | These functions are also exported by the "Prelude". interact, -- :: (String -> String) -> IO () putChar, -- :: Char -> IO () putStr, -- :: String -> IO () putStrLn, -- :: String -> IO () print, -- :: Show a => a -> IO () getChar, -- :: IO Char getLine, -- :: IO String getContents, -- :: IO String readIO, -- :: Read a => String -> IO a readLn, -- :: Read a => IO a -- * Binary input and output openBinaryFile, -- :: FilePath -> IOMode -> IO Handle hSetBinaryMode, -- :: Handle -> Bool -> IO () #if !defined(__NHC__) hPutBuf, -- :: Handle -> Ptr a -> Int -> IO () hGetBuf, -- :: Handle -> Ptr a -> Int -> IO Int #endif #if !defined(__NHC__) && !defined(__HUGS__) hPutBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int hGetBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int #endif -- * Temporary files #ifdef __GLASGOW_HASKELL__ openTempFile, openBinaryTempFile, #endif ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.IOBase -- Together these four Prelude modules define import GHC.Handle -- all the stuff exported by IO for the GHC version import GHC.IO import GHC.Exception import GHC.Num import GHC.Read import GHC.Show #endif #ifdef __HUGS__ import Hugs.IO import Hugs.IOExts import Hugs.IORef import Hugs.Prelude ( throw, Exception(NonTermination) ) import System.IO.Unsafe ( unsafeInterleaveIO ) #endif #ifdef __NHC__ import IO ( Handle () , HandlePosn () , IOMode (ReadMode,WriteMode,AppendMode,ReadWriteMode) , BufferMode (NoBuffering,LineBuffering,BlockBuffering) , SeekMode (AbsoluteSeek,RelativeSeek,SeekFromEnd) , stdin, stdout, stderr , openFile -- :: FilePath -> IOMode -> IO Handle , hClose -- :: Handle -> IO () , hFileSize -- :: Handle -> IO Integer , hIsEOF -- :: Handle -> IO Bool , isEOF -- :: IO Bool , hSetBuffering -- :: Handle -> BufferMode -> IO () , hGetBuffering -- :: Handle -> IO BufferMode , hFlush -- :: Handle -> IO () , hGetPosn -- :: Handle -> IO HandlePosn , hSetPosn -- :: HandlePosn -> IO () , hSeek -- :: Handle -> SeekMode -> Integer -> IO () , hWaitForInput -- :: Handle -> Int -> IO Bool , hGetChar -- :: Handle -> IO Char , hGetLine -- :: Handle -> IO [Char] , hLookAhead -- :: Handle -> IO Char , hGetContents -- :: Handle -> IO [Char] , hPutChar -- :: Handle -> Char -> IO () , hPutStr -- :: Handle -> [Char] -> IO () , hPutStrLn -- :: Handle -> [Char] -> IO () , hPrint -- :: Handle -> [Char] -> IO () , hReady -- :: Handle -> [Char] -> IO () , hIsOpen, hIsClosed -- :: Handle -> IO Bool , hIsReadable, hIsWritable -- :: Handle -> IO Bool , hIsSeekable -- :: Handle -> IO Bool , IO () , FilePath -- :: String ) import NHC.IOExtras (fixIO) #endif -- ----------------------------------------------------------------------------- -- Standard IO #ifdef __GLASGOW_HASKELL__ -- | Write a character to the standard output device -- (same as 'hPutChar' 'stdout'). putChar :: Char -> IO () putChar c = hPutChar stdout c -- | Write a string to the standard output device -- (same as 'hPutStr' 'stdout'). putStr :: String -> IO () putStr s = hPutStr stdout s -- | The same as 'putStr', but adds a newline character. putStrLn :: String -> IO () putStrLn s = do putStr s putChar '\n' -- | The 'print' function outputs a value of any printable type to the -- standard output device. -- Printable types are those that are instances of class 'Show'; 'print' -- converts values to strings for output using the 'show' operation and -- adds a newline. -- -- For example, a program to print the first 20 integers and their -- powers of 2 could be written as: -- -- > main = print ([(n, 2^n) | n <- [0..19]]) print :: Show a => a -> IO () print x = putStrLn (show x) -- | Read a character from the standard input device -- (same as 'hGetChar' 'stdin'). getChar :: IO Char getChar = hGetChar stdin -- | Read a line from the standard input device -- (same as 'hGetLine' 'stdin'). getLine :: IO String getLine = hGetLine stdin -- | The 'getContents' operation returns all user input as a single string, -- which is read lazily as it is needed -- (same as 'hGetContents' 'stdin'). getContents :: IO String getContents = hGetContents stdin -- | The 'interact' function takes a function of type @String->String@ -- as its argument. The entire input from the standard input device is -- passed to this function as its argument, and the resulting string is -- output on the standard output device. interact :: (String -> String) -> IO () interact f = do s <- getContents putStr (f s) -- | The 'readFile' function reads a file and -- returns the contents of the file as a string. -- The file is read lazily, on demand, as with 'getContents'. readFile :: FilePath -> IO String readFile name = openFile name ReadMode >>= hGetContents -- | The computation 'writeFile' @file str@ function writes the string @str@, -- to the file @file@. writeFile :: FilePath -> String -> IO () writeFile f txt = bracket (openFile f WriteMode) hClose (\hdl -> hPutStr hdl txt) -- | The computation 'appendFile' @file str@ function appends the string @str@, -- to the file @file@. -- -- Note that 'writeFile' and 'appendFile' write a literal string -- to a file. To write a value of any printable type, as with 'print', -- use the 'show' function to convert the value to a string first. -- -- > main = appendFile "squares" (show [(x,x*x) | x <- [0,0.1..2]]) appendFile :: FilePath -> String -> IO () appendFile f txt = bracket (openFile f AppendMode) hClose (\hdl -> hPutStr hdl txt) -- | The 'readLn' function combines 'getLine' and 'readIO'. readLn :: Read a => IO a readLn = do l <- getLine r <- readIO l return r -- | The 'readIO' function is similar to 'read' except that it signals -- parse failure to the 'IO' monad instead of terminating the program. readIO :: Read a => String -> IO a readIO s = case (do { (x,t) <- reads s ; ("","") <- lex t ; return x }) of [x] -> return x [] -> ioError (userError "Prelude.readIO: no parse") _ -> ioError (userError "Prelude.readIO: ambiguous parse") #endif /* __GLASGOW_HASKELL__ */ #ifndef __NHC__ -- | Computation 'hReady' @hdl@ indicates whether at least one item is -- available for input from handle @hdl@. -- -- This operation may fail with: -- -- * 'System.IO.Error.isEOFError' if the end of file has been reached. hReady :: Handle -> IO Bool hReady h = hWaitForInput h 0 -- | The same as 'hPutStr', but adds a newline character. hPutStrLn :: Handle -> String -> IO () hPutStrLn hndl str = do hPutStr hndl str hPutChar hndl '\n' -- | Computation 'hPrint' @hdl t@ writes the string representation of @t@ -- given by the 'shows' function to the file or channel managed by @hdl@ -- and appends a newline. -- -- This operation may fail with: -- -- * 'System.IO.Error.isFullError' if the device is full; or -- -- * 'System.IO.Error.isPermissionError' if another system resource limit would be exceeded. hPrint :: Show a => Handle -> a -> IO () hPrint hdl = hPutStrLn hdl . show #endif /* !__NHC__ */ -- --------------------------------------------------------------------------- -- fixIO #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) fixIO :: (a -> IO a) -> IO a fixIO k = do ref <- newIORef (throw NonTermination) ans <- unsafeInterleaveIO (readIORef ref) result <- k ans writeIORef ref result return result -- NOTE: we do our own explicit black holing here, because GHC's lazy -- blackholing isn't enough. In an infinite loop, GHC may run the IO -- computation a few times before it notices the loop, which is wrong. #endif #if defined(__NHC__) -- Assume a unix platform, where text and binary I/O are identical. openBinaryFile = openFile hSetBinaryMode _ _ = return () #endif -- $locking -- Implementations should enforce as far as possible, at least locally to the -- Haskell process, multiple-reader single-writer locking on files. -- That is, /there may either be many handles on the same file which manage -- input, or just one handle on the file which manages output/. If any -- open or semi-closed handle is managing a file for output, no new -- handle can be allocated for that file. If any open or semi-closed -- handle is managing a file for input, new handles can only be allocated -- if they do not manage output. Whether two files are the same is -- implementation-dependent, but they should normally be the same if they -- have the same absolute path name and neither has been renamed, for -- example. -- -- /Warning/: the 'readFile' operation holds a semi-closed handle on -- the file until the entire contents of the file have been consumed. -- It follows that an attempt to write to a file (using 'writeFile', for -- example) that was earlier opened by 'readFile' will usually result in -- failure with 'System.IO.Error.isAlreadyInUseError'. -- ----------------------------------------------------------------------------- -- Utils #ifdef __GLASGOW_HASKELL__ -- Copied here to avoid recursive dependency with Control.Exception bracket :: IO a -- ^ computation to run first (\"acquire resource\") -> (a -> IO b) -- ^ computation to run last (\"release resource\") -> (a -> IO c) -- ^ computation to run in-between -> IO c -- returns the value from the in-between computation bracket before after thing = block (do a <- before r <- catchException (unblock (thing a)) (\e -> do { after a; throw e }) after a return r ) #endif hugs98-plus-Sep2006/packages/base/System/Posix/0000755006511100651110000000000010504340225020034 5ustar rossrosshugs98-plus-Sep2006/packages/base/System/Posix/Internals.hs0000644006511100651110000004165310504340225022340 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Internals -- Copyright : (c) The University of Glasgow, 1992-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (requires POSIX) -- -- POSIX support layer for the standard libraries. -- This library is built on *every* platform, including Win32. -- -- Non-posix compliant in order to support the following features: -- * S_ISSOCK (no sockets in POSIX) -- ----------------------------------------------------------------------------- -- #hide module System.Posix.Internals where #include "HsBaseConfig.h" import Control.Monad import System.Posix.Types import Foreign import Foreign.C import Data.Bits import Data.Maybe #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Num import GHC.Real import GHC.IOBase #else import System.IO #endif #ifdef __HUGS__ import Hugs.Prelude (IOException(..), IOErrorType(..)) {-# CFILES cbits/PrelIOUtils.c cbits/dirUtils.c cbits/consUtils.c #-} #endif -- --------------------------------------------------------------------------- -- Types type CDir = () type CDirent = () type CFLock = () type CGroup = () type CLconv = () type CPasswd = () type CSigaction = () type CSigset = () type CStat = () type CTermios = () type CTm = () type CTms = () type CUtimbuf = () type CUtsname = () #ifndef __GLASGOW_HASKELL__ type FD = Int #endif -- --------------------------------------------------------------------------- -- stat()-related stuff fdFileSize :: Int -> IO Integer fdFileSize fd = allocaBytes sizeof_stat $ \ p_stat -> do throwErrnoIfMinus1Retry "fileSize" $ c_fstat (fromIntegral fd) p_stat c_mode <- st_mode p_stat :: IO CMode if not (s_isreg c_mode) then return (-1) else do c_size <- st_size p_stat :: IO COff return (fromIntegral c_size) data FDType = Directory | Stream | RegularFile | RawDevice deriving (Eq) fileType :: FilePath -> IO FDType fileType file = allocaBytes sizeof_stat $ \ p_stat -> do withCString file $ \p_file -> do throwErrnoIfMinus1Retry "fileType" $ c_stat p_file p_stat statGetType p_stat -- NOTE: On Win32 platforms, this will only work with file descriptors -- referring to file handles. i.e., it'll fail for socket FDs. fdType :: Int -> IO FDType fdType fd = allocaBytes sizeof_stat $ \ p_stat -> do throwErrnoIfMinus1Retry "fdType" $ c_fstat (fromIntegral fd) p_stat statGetType p_stat statGetType p_stat = do c_mode <- st_mode p_stat :: IO CMode case () of _ | s_isdir c_mode -> return Directory | s_isfifo c_mode || s_issock c_mode || s_ischr c_mode -> return Stream | s_isreg c_mode -> return RegularFile -- Q: map char devices to RawDevice too? | s_isblk c_mode -> return RawDevice | otherwise -> ioError ioe_unknownfiletype ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType" "unknown file type" Nothing #if __GLASGOW_HASKELL__ && (defined(mingw32_HOST_OS) || defined(__MINGW32__)) closeFd :: Bool -> CInt -> IO CInt closeFd isStream fd | isStream = c_closesocket fd | otherwise = c_close fd foreign import stdcall unsafe "HsBase.h closesocket" c_closesocket :: CInt -> IO CInt #endif fdGetMode :: Int -> IO IOMode fdGetMode fd = do #if defined(mingw32_HOST_OS) || defined(__MINGW32__) -- XXX: this code is *BROKEN*, _setmode only deals with O_TEXT/O_BINARY flags1 <- throwErrnoIfMinus1Retry "fdGetMode" (c__setmode (fromIntegral fd) (fromIntegral o_WRONLY)) flags <- throwErrnoIfMinus1Retry "fdGetMode" (c__setmode (fromIntegral fd) (fromIntegral flags1)) #else flags <- throwErrnoIfMinus1Retry "fdGetMode" (c_fcntl_read (fromIntegral fd) const_f_getfl) #endif let wH = (flags .&. o_WRONLY) /= 0 aH = (flags .&. o_APPEND) /= 0 rwH = (flags .&. o_RDWR) /= 0 mode | wH && aH = AppendMode | wH = WriteMode | rwH = ReadWriteMode | otherwise = ReadMode return mode -- --------------------------------------------------------------------------- -- Terminal-related stuff fdIsTTY :: Int -> IO Bool fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool #if defined(HTYPE_TCFLAG_T) setEcho :: Int -> Bool -> IO () setEcho fd on = do tcSetAttr fd $ \ p_tios -> do c_lflag <- c_lflag p_tios :: IO CTcflag let new_c_lflag | on = c_lflag .|. fromIntegral const_echo | otherwise = c_lflag .&. complement (fromIntegral const_echo) poke_c_lflag p_tios (new_c_lflag :: CTcflag) getEcho :: Int -> IO Bool getEcho fd = do tcSetAttr fd $ \ p_tios -> do c_lflag <- c_lflag p_tios :: IO CTcflag return ((c_lflag .&. fromIntegral const_echo) /= 0) setCooked :: Int -> Bool -> IO () setCooked fd cooked = tcSetAttr fd $ \ p_tios -> do -- turn on/off ICANON c_lflag <- c_lflag p_tios :: IO CTcflag let new_c_lflag | cooked = c_lflag .|. (fromIntegral const_icanon) | otherwise = c_lflag .&. complement (fromIntegral const_icanon) poke_c_lflag p_tios (new_c_lflag :: CTcflag) -- set VMIN & VTIME to 1/0 respectively when (not cooked) $ do c_cc <- ptr_c_cc p_tios let vmin = (c_cc `plusPtr` (fromIntegral const_vmin)) :: Ptr Word8 vtime = (c_cc `plusPtr` (fromIntegral const_vtime)) :: Ptr Word8 poke vmin 1 poke vtime 0 tcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a tcSetAttr fd fun = do allocaBytes sizeof_termios $ \p_tios -> do throwErrnoIfMinus1Retry "tcSetAttr" (c_tcgetattr (fromIntegral fd) p_tios) #ifdef __GLASGOW_HASKELL__ -- Save a copy of termios, if this is a standard file descriptor. -- These terminal settings are restored in hs_exit(). when (fd <= 2) $ do p <- get_saved_termios fd when (p == nullPtr) $ do saved_tios <- mallocBytes sizeof_termios copyBytes saved_tios p_tios sizeof_termios set_saved_termios fd saved_tios #endif -- tcsetattr() when invoked by a background process causes the process -- to be sent SIGTTOU regardless of whether the process has TOSTOP set -- in its terminal flags (try it...). This function provides a -- wrapper which temporarily blocks SIGTTOU around the call, making it -- transparent. allocaBytes sizeof_sigset_t $ \ p_sigset -> do allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do c_sigemptyset p_sigset c_sigaddset p_sigset const_sigttou c_sigprocmask const_sig_block p_sigset p_old_sigset r <- fun p_tios -- do the business throwErrnoIfMinus1Retry_ "tcSetAttr" $ c_tcsetattr (fromIntegral fd) const_tcsanow p_tios c_sigprocmask const_sig_setmask p_old_sigset nullPtr return r #ifdef __GLASGOW_HASKELL__ foreign import ccall unsafe "HsBase.h __hscore_get_saved_termios" get_saved_termios :: Int -> IO (Ptr CTermios) foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios" set_saved_termios :: Int -> (Ptr CTermios) -> IO () #endif #else -- 'raw' mode for Win32 means turn off 'line input' (=> buffering and -- character translation for the console.) The Win32 API for doing -- this is GetConsoleMode(), which also requires echoing to be disabled -- when turning off 'line input' processing. Notice that turning off -- 'line input' implies enter/return is reported as '\r' (and it won't -- report that character until another character is input..odd.) This -- latter feature doesn't sit too well with IO actions like IO.hGetLine.. -- consider yourself warned. setCooked :: Int -> Bool -> IO () setCooked fd cooked = do x <- set_console_buffering (fromIntegral fd) (if cooked then 1 else 0) if (x /= 0) then ioError (ioe_unk_error "setCooked" "failed to set buffering") else return () ioe_unk_error loc msg = IOError Nothing OtherError loc msg Nothing -- Note: echoing goes hand in hand with enabling 'line input' / raw-ness -- for Win32 consoles, hence setEcho ends up being the inverse of setCooked. setEcho :: Int -> Bool -> IO () setEcho fd on = do x <- set_console_echo (fromIntegral fd) (if on then 1 else 0) if (x /= 0) then ioError (ioe_unk_error "setEcho" "failed to set echoing") else return () getEcho :: Int -> IO Bool getEcho fd = do r <- get_console_echo (fromIntegral fd) if (r == (-1)) then ioError (ioe_unk_error "getEcho" "failed to get echoing") else return (r == 1) foreign import ccall unsafe "consUtils.h set_console_buffering__" set_console_buffering :: CInt -> CInt -> IO CInt foreign import ccall unsafe "consUtils.h set_console_echo__" set_console_echo :: CInt -> CInt -> IO CInt foreign import ccall unsafe "consUtils.h get_console_echo__" get_console_echo :: CInt -> IO CInt #endif -- --------------------------------------------------------------------------- -- Turning on non-blocking for a file descriptor #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) setNonBlockingFD fd = do flags <- throwErrnoIfMinus1Retry "setNonBlockingFD" (c_fcntl_read (fromIntegral fd) const_f_getfl) -- An error when setting O_NONBLOCK isn't fatal: on some systems -- there are certain file handles on which this will fail (eg. /dev/null -- on FreeBSD) so we throw away the return code from fcntl_write. unless (testBit flags (fromIntegral o_NONBLOCK)) $ do c_fcntl_write (fromIntegral fd) const_f_setfl (flags .|. o_NONBLOCK) return () #else -- bogus defns for win32 setNonBlockingFD fd = return () #endif -- ----------------------------------------------------------------------------- -- foreign imports foreign import ccall unsafe "HsBase.h access" c_access :: CString -> CMode -> IO CInt foreign import ccall unsafe "HsBase.h chmod" c_chmod :: CString -> CMode -> IO CInt foreign import ccall unsafe "HsBase.h chdir" c_chdir :: CString -> IO CInt foreign import ccall unsafe "HsBase.h close" c_close :: CInt -> IO CInt foreign import ccall unsafe "HsBase.h closedir" c_closedir :: Ptr CDir -> IO CInt foreign import ccall unsafe "HsBase.h creat" c_creat :: CString -> CMode -> IO CInt foreign import ccall unsafe "HsBase.h dup" c_dup :: CInt -> IO CInt foreign import ccall unsafe "HsBase.h dup2" c_dup2 :: CInt -> CInt -> IO CInt foreign import ccall unsafe "HsBase.h __hscore_fstat" c_fstat :: CInt -> Ptr CStat -> IO CInt foreign import ccall unsafe "HsBase.h getcwd" c_getcwd :: Ptr CChar -> CInt -> IO (Ptr CChar) foreign import ccall unsafe "HsBase.h isatty" c_isatty :: CInt -> IO CInt foreign import ccall unsafe "HsBase.h __hscore_lseek" c_lseek :: CInt -> COff -> CInt -> IO COff foreign import ccall unsafe "HsBase.h __hscore_lstat" lstat :: CString -> Ptr CStat -> IO CInt foreign import ccall unsafe "HsBase.h __hscore_open" c_open :: CString -> CInt -> CMode -> IO CInt foreign import ccall unsafe "HsBase.h opendir" c_opendir :: CString -> IO (Ptr CDir) foreign import ccall unsafe "HsBase.h __hscore_mkdir" mkdir :: CString -> CInt -> IO CInt foreign import ccall unsafe "HsBase.h read" c_read :: CInt -> Ptr CChar -> CSize -> IO CSsize foreign import ccall unsafe "dirUtils.h __hscore_renameFile" c_rename :: CString -> CString -> IO CInt foreign import ccall unsafe "HsBase.h rewinddir" c_rewinddir :: Ptr CDir -> IO () foreign import ccall unsafe "HsBase.h rmdir" c_rmdir :: CString -> IO CInt foreign import ccall unsafe "HsBase.h __hscore_stat" c_stat :: CString -> Ptr CStat -> IO CInt foreign import ccall unsafe "HsBase.h umask" c_umask :: CMode -> IO CMode foreign import ccall unsafe "HsBase.h write" c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize foreign import ccall unsafe "HsBase.h __hscore_ftruncate" c_ftruncate :: CInt -> COff -> IO CInt foreign import ccall unsafe "HsBase.h unlink" c_unlink :: CString -> IO CInt foreign import ccall unsafe "HsBase.h getpid" c_getpid :: IO CPid #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) foreign import ccall unsafe "HsBase.h fcntl" c_fcntl_read :: CInt -> CInt -> IO CInt foreign import ccall unsafe "HsBase.h fcntl" c_fcntl_write :: CInt -> CInt -> CInt -> IO CInt foreign import ccall unsafe "HsBase.h fcntl" c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt foreign import ccall unsafe "HsBase.h fork" c_fork :: IO CPid foreign import ccall unsafe "HsBase.h link" c_link :: CString -> CString -> IO CInt foreign import ccall unsafe "HsBase.h mkfifo" c_mkfifo :: CString -> CMode -> IO CInt foreign import ccall unsafe "HsBase.h pipe" c_pipe :: Ptr CInt -> IO CInt foreign import ccall unsafe "HsBase.h __hscore_sigemptyset" c_sigemptyset :: Ptr CSigset -> IO CInt foreign import ccall unsafe "HsBase.h __hscore_sigaddset" c_sigaddset :: Ptr CSigset -> CInt -> IO CInt foreign import ccall unsafe "HsBase.h sigprocmask" c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt foreign import ccall unsafe "HsBase.h tcgetattr" c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt foreign import ccall unsafe "HsBase.h tcsetattr" c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt foreign import ccall unsafe "HsBase.h utime" c_utime :: CString -> Ptr CUtimbuf -> IO CMode foreign import ccall unsafe "HsBase.h waitpid" c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid #else foreign import ccall unsafe "HsBase.h _setmode" c__setmode :: CInt -> CInt -> IO CInt -- /* Set "stdin" to have binary mode: */ -- result = _setmode( _fileno( stdin ), _O_BINARY ); -- if( result == -1 ) -- perror( "Cannot set mode" ); -- else -- printf( "'stdin' successfully changed to binary mode\n" ); #endif -- traversing directories foreign import ccall unsafe "dirUtils.h __hscore_readdir" readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt foreign import ccall unsafe "HsBase.h __hscore_free_dirent" freeDirEnt :: Ptr CDirent -> IO () foreign import ccall unsafe "HsBase.h __hscore_end_of_dir" end_of_dir :: CInt foreign import ccall unsafe "HsBase.h __hscore_d_name" d_name :: Ptr CDirent -> IO CString -- POSIX flags only: foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_wronly" o_WRONLY :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_rdwr" o_RDWR :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_append" o_APPEND :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_creat" o_CREAT :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_excl" o_EXCL :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_trunc" o_TRUNC :: CInt -- non-POSIX flags. foreign import ccall unsafe "HsBase.h __hscore_o_noctty" o_NOCTTY :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_nonblock" o_NONBLOCK :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_binary" o_BINARY :: CInt foreign import ccall unsafe "HsBase.h __hscore_s_isreg" s_isreg :: CMode -> Bool foreign import ccall unsafe "HsBase.h __hscore_s_ischr" s_ischr :: CMode -> Bool foreign import ccall unsafe "HsBase.h __hscore_s_isblk" s_isblk :: CMode -> Bool foreign import ccall unsafe "HsBase.h __hscore_s_isdir" s_isdir :: CMode -> Bool foreign import ccall unsafe "HsBase.h __hscore_s_isfifo" s_isfifo :: CMode -> Bool foreign import ccall unsafe "HsBase.h __hscore_sizeof_stat" sizeof_stat :: Int foreign import ccall unsafe "HsBase.h __hscore_st_mtime" st_mtime :: Ptr CStat -> IO CTime foreign import ccall unsafe "HsBase.h __hscore_st_size" st_size :: Ptr CStat -> IO COff foreign import ccall unsafe "HsBase.h __hscore_st_mode" st_mode :: Ptr CStat -> IO CMode foreign import ccall unsafe "HsBase.h __hscore_echo" const_echo :: CInt foreign import ccall unsafe "HsBase.h __hscore_tcsanow" const_tcsanow :: CInt foreign import ccall unsafe "HsBase.h __hscore_icanon" const_icanon :: CInt foreign import ccall unsafe "HsBase.h __hscore_vmin" const_vmin :: CInt foreign import ccall unsafe "HsBase.h __hscore_vtime" const_vtime :: CInt foreign import ccall unsafe "HsBase.h __hscore_sigttou" const_sigttou :: CInt foreign import ccall unsafe "HsBase.h __hscore_sig_block" const_sig_block :: CInt foreign import ccall unsafe "HsBase.h __hscore_sig_setmask" const_sig_setmask :: CInt foreign import ccall unsafe "HsBase.h __hscore_f_getfl" const_f_getfl :: CInt foreign import ccall unsafe "HsBase.h __hscore_f_setfl" const_f_setfl :: CInt #if defined(HTYPE_TCFLAG_T) foreign import ccall unsafe "HsBase.h __hscore_sizeof_termios" sizeof_termios :: Int foreign import ccall unsafe "HsBase.h __hscore_sizeof_sigset_t" sizeof_sigset_t :: Int foreign import ccall unsafe "HsBase.h __hscore_lflag" c_lflag :: Ptr CTermios -> IO CTcflag foreign import ccall unsafe "HsBase.h __hscore_poke_lflag" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO () foreign import ccall unsafe "HsBase.h __hscore_ptr_c_cc" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8) #endif #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) foreign import ccall unsafe "HsBase.h __hscore_s_issock" s_issock :: CMode -> Bool #else s_issock :: CMode -> Bool s_issock cmode = False #endif hugs98-plus-Sep2006/packages/base/System/Posix/Signals.hs0000644006511100651110000003536110504340221021774 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Posix.Signals -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX signal support -- ----------------------------------------------------------------------------- #include "HsBaseConfig.h" module System.Posix.Signals ( #ifndef mingw32_HOST_OS -- * The Signal type Signal, -- * Specific signals nullSignal, internalAbort, sigABRT, realTimeAlarm, sigALRM, busError, sigBUS, processStatusChanged, sigCHLD, continueProcess, sigCONT, floatingPointException, sigFPE, lostConnection, sigHUP, illegalInstruction, sigILL, keyboardSignal, sigINT, killProcess, sigKILL, openEndedPipe, sigPIPE, keyboardTermination, sigQUIT, segmentationViolation, sigSEGV, softwareStop, sigSTOP, softwareTermination, sigTERM, keyboardStop, sigTSTP, backgroundRead, sigTTIN, backgroundWrite, sigTTOU, userDefinedSignal1, sigUSR1, userDefinedSignal2, sigUSR2, #if CONST_SIGPOLL != -1 pollableEvent, sigPOLL, #endif profilingTimerExpired, sigPROF, badSystemCall, sigSYS, breakpointTrap, sigTRAP, urgentDataAvailable, sigURG, virtualTimerExpired, sigVTALRM, cpuTimeLimitExceeded, sigXCPU, fileSizeLimitExceeded, sigXFSZ, -- * Sending signals raiseSignal, signalProcess, signalProcessGroup, #ifdef __GLASGOW_HASKELL__ -- * Handling signals Handler(..), installHandler, #endif -- * Signal sets SignalSet, emptySignalSet, fullSignalSet, addSignal, deleteSignal, inSignalSet, -- * The process signal mask getSignalMask, setSignalMask, blockSignals, unblockSignals, -- * The alarm timer scheduleAlarm, -- * Waiting for signals getPendingSignals, #ifndef cygwin32_HOST_OS awaitSignal, #endif #ifdef __GLASGOW_HASKELL__ -- * The @NOCLDSTOP@ flag setStoppedChildFlag, queryStoppedChildFlag, #endif -- MISSING FUNCTIONALITY: -- sigaction(), (inc. the sigaction structure + flags etc.) -- the siginfo structure -- sigaltstack() -- sighold, sigignore, sigpause, sigrelse, sigset -- siginterrupt #endif ) where import Prelude -- necessary to get dependencies right import Foreign import Foreign.C import System.IO.Unsafe import System.Posix.Types import System.Posix.Internals #ifndef mingw32_HOST_OS -- WHOLE FILE... #ifdef __GLASGOW_HASKELL__ #include "Signals.h" import GHC.Conc ( ensureIOManagerIsRunning ) #endif -- ----------------------------------------------------------------------------- -- Specific signals type Signal = CInt nullSignal :: Signal nullSignal = 0 sigABRT :: CInt sigABRT = CONST_SIGABRT sigALRM :: CInt sigALRM = CONST_SIGALRM sigBUS :: CInt sigBUS = CONST_SIGBUS sigCHLD :: CInt sigCHLD = CONST_SIGCHLD sigCONT :: CInt sigCONT = CONST_SIGCONT sigFPE :: CInt sigFPE = CONST_SIGFPE sigHUP :: CInt sigHUP = CONST_SIGHUP sigILL :: CInt sigILL = CONST_SIGILL sigINT :: CInt sigINT = CONST_SIGINT sigKILL :: CInt sigKILL = CONST_SIGKILL sigPIPE :: CInt sigPIPE = CONST_SIGPIPE sigQUIT :: CInt sigQUIT = CONST_SIGQUIT sigSEGV :: CInt sigSEGV = CONST_SIGSEGV sigSTOP :: CInt sigSTOP = CONST_SIGSTOP sigTERM :: CInt sigTERM = CONST_SIGTERM sigTSTP :: CInt sigTSTP = CONST_SIGTSTP sigTTIN :: CInt sigTTIN = CONST_SIGTTIN sigTTOU :: CInt sigTTOU = CONST_SIGTTOU sigUSR1 :: CInt sigUSR1 = CONST_SIGUSR1 sigUSR2 :: CInt sigUSR2 = CONST_SIGUSR2 sigPOLL :: CInt sigPOLL = CONST_SIGPOLL sigPROF :: CInt sigPROF = CONST_SIGPROF sigSYS :: CInt sigSYS = CONST_SIGSYS sigTRAP :: CInt sigTRAP = CONST_SIGTRAP sigURG :: CInt sigURG = CONST_SIGURG sigVTALRM :: CInt sigVTALRM = CONST_SIGVTALRM sigXCPU :: CInt sigXCPU = CONST_SIGXCPU sigXFSZ :: CInt sigXFSZ = CONST_SIGXFSZ internalAbort ::Signal internalAbort = sigABRT realTimeAlarm :: Signal realTimeAlarm = sigALRM busError :: Signal busError = sigBUS processStatusChanged :: Signal processStatusChanged = sigCHLD continueProcess :: Signal continueProcess = sigCONT floatingPointException :: Signal floatingPointException = sigFPE lostConnection :: Signal lostConnection = sigHUP illegalInstruction :: Signal illegalInstruction = sigILL keyboardSignal :: Signal keyboardSignal = sigINT killProcess :: Signal killProcess = sigKILL openEndedPipe :: Signal openEndedPipe = sigPIPE keyboardTermination :: Signal keyboardTermination = sigQUIT segmentationViolation :: Signal segmentationViolation = sigSEGV softwareStop :: Signal softwareStop = sigSTOP softwareTermination :: Signal softwareTermination = sigTERM keyboardStop :: Signal keyboardStop = sigTSTP backgroundRead :: Signal backgroundRead = sigTTIN backgroundWrite :: Signal backgroundWrite = sigTTOU userDefinedSignal1 :: Signal userDefinedSignal1 = sigUSR1 userDefinedSignal2 :: Signal userDefinedSignal2 = sigUSR2 #if CONST_SIGPOLL != -1 pollableEvent :: Signal pollableEvent = sigPOLL #endif profilingTimerExpired :: Signal profilingTimerExpired = sigPROF badSystemCall :: Signal badSystemCall = sigSYS breakpointTrap :: Signal breakpointTrap = sigTRAP urgentDataAvailable :: Signal urgentDataAvailable = sigURG virtualTimerExpired :: Signal virtualTimerExpired = sigVTALRM cpuTimeLimitExceeded :: Signal cpuTimeLimitExceeded = sigXCPU fileSizeLimitExceeded :: Signal fileSizeLimitExceeded = sigXFSZ -- ----------------------------------------------------------------------------- -- Signal-related functions -- | @signalProcess int pid@ calls @kill@ to signal process @pid@ -- with interrupt signal @int@. signalProcess :: Signal -> ProcessID -> IO () signalProcess sig pid = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig) foreign import ccall unsafe "kill" c_kill :: CPid -> CInt -> IO CInt -- | @signalProcessGroup int pgid@ calls @kill@ to signal -- all processes in group @pgid@ with interrupt signal @int@. signalProcessGroup :: Signal -> ProcessGroupID -> IO () signalProcessGroup sig pgid = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig) foreign import ccall unsafe "killpg" c_killpg :: CPid -> CInt -> IO CInt -- | @raiseSignal int@ calls @kill@ to signal the current process -- with interrupt signal @int@. raiseSignal :: Signal -> IO () raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig) #if defined(__GLASGOW_HASKELL__) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS)) foreign import ccall unsafe "genericRaise" c_raise :: CInt -> IO CInt #else foreign import ccall unsafe "raise" c_raise :: CInt -> IO CInt #endif #ifdef __GLASGOW_HASKELL__ data Handler = Default | Ignore -- not yet: | Hold | Catch (IO ()) | CatchOnce (IO ()) -- | @installHandler int handler iset@ calls @sigaction@ to install an -- interrupt handler for signal @int@. If @handler@ is @Default@, -- @SIG_DFL@ is installed; if @handler@ is @Ignore@, @SIG_IGN@ is -- installed; if @handler@ is @Catch action@, a handler is installed -- which will invoke @action@ in a new thread when (or shortly after) the -- signal is received. -- If @iset@ is @Just s@, then the @sa_mask@ of the @sigaction@ structure -- is set to @s@; otherwise it is cleared. The previously installed -- signal handler for @int@ is returned installHandler :: Signal -> Handler -> Maybe SignalSet -- ^ other signals to block -> IO Handler -- ^ old handler #ifdef __PARALLEL_HASKELL__ installHandler = error "installHandler: not available for Parallel Haskell" #else installHandler int handler maybe_mask = do ensureIOManagerIsRunning -- for the threaded RTS case maybe_mask of Nothing -> install' nullPtr Just (SignalSet x) -> withForeignPtr x $ install' where install' mask = alloca $ \p_sp -> do rc <- case handler of Default -> stg_sig_install int STG_SIG_DFL p_sp mask Ignore -> stg_sig_install int STG_SIG_IGN p_sp mask Catch m -> hinstall m p_sp mask int STG_SIG_HAN CatchOnce m -> hinstall m p_sp mask int STG_SIG_RST case rc of STG_SIG_DFL -> return Default STG_SIG_IGN -> return Ignore STG_SIG_ERR -> throwErrno "installHandler" STG_SIG_HAN -> do m <- peekHandler p_sp return (Catch m) STG_SIG_RST -> do m <- peekHandler p_sp return (CatchOnce m) _other -> error "internal error: System.Posix.Signals.installHandler" hinstall m p_sp mask int reset = do sptr <- newStablePtr m poke p_sp sptr stg_sig_install int reset p_sp mask peekHandler p_sp = do osptr <- peek p_sp deRefStablePtr osptr foreign import ccall unsafe stg_sig_install :: CInt -- sig no. -> CInt -- action code (STG_SIG_HAN etc.) -> Ptr (StablePtr (IO ())) -- (in, out) Haskell handler -> Ptr CSigset -- (in, out) blocked -> IO CInt -- (ret) action code #endif /* !__PARALLEL_HASKELL__ */ #endif /* __GLASGOW_HASKELL__ */ -- ----------------------------------------------------------------------------- -- Alarms -- | @scheduleAlarm i@ calls @alarm@ to schedule a real time -- alarm at least @i@ seconds in the future. scheduleAlarm :: Int -> IO Int scheduleAlarm secs = do r <- c_alarm (fromIntegral secs) return (fromIntegral r) foreign import ccall unsafe "alarm" c_alarm :: CUInt -> IO CUInt #ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- The NOCLDSTOP flag foreign import ccall "&nocldstop" nocldstop :: Ptr Int -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when -- installing new signal handlers. setStoppedChildFlag :: Bool -> IO Bool setStoppedChildFlag b = do rc <- peek nocldstop poke nocldstop $ fromEnum (not b) return (rc == (0::Int)) -- | Queries the current state of the stopped child flag. queryStoppedChildFlag :: IO Bool queryStoppedChildFlag = do rc <- peek nocldstop return (rc == (0::Int)) #endif /* __GLASGOW_HASKELL__ */ -- ----------------------------------------------------------------------------- -- Manipulating signal sets newtype SignalSet = SignalSet (ForeignPtr CSigset) emptySignalSet :: SignalSet emptySignalSet = unsafePerformIO $ do fp <- mallocForeignPtrBytes sizeof_sigset_t throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset) return (SignalSet fp) fullSignalSet :: SignalSet fullSignalSet = unsafePerformIO $ do fp <- mallocForeignPtrBytes sizeof_sigset_t throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset) return (SignalSet fp) infixr `addSignal`, `deleteSignal` addSignal :: Signal -> SignalSet -> SignalSet addSignal sig (SignalSet fp1) = unsafePerformIO $ do fp2 <- mallocForeignPtrBytes sizeof_sigset_t withForeignPtr fp1 $ \p1 -> withForeignPtr fp2 $ \p2 -> do copyBytes p2 p1 sizeof_sigset_t throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig) return (SignalSet fp2) deleteSignal :: Signal -> SignalSet -> SignalSet deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do fp2 <- mallocForeignPtrBytes sizeof_sigset_t withForeignPtr fp1 $ \p1 -> withForeignPtr fp2 $ \p2 -> do copyBytes p2 p1 sizeof_sigset_t throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig) return (SignalSet fp2) inSignalSet :: Signal -> SignalSet -> Bool inSignalSet sig (SignalSet fp) = unsafePerformIO $ withForeignPtr fp $ \p -> do r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig) return (r /= 0) -- | @getSignalMask@ calls @sigprocmask@ to determine the -- set of interrupts which are currently being blocked. getSignalMask :: IO SignalSet getSignalMask = do fp <- mallocForeignPtrBytes sizeof_sigset_t withForeignPtr fp $ \p -> throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p) return (SignalSet fp) sigProcMask :: String -> CInt -> SignalSet -> IO () sigProcMask fn how (SignalSet set) = withForeignPtr set $ \p_set -> throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr) -- | @setSignalMask mask@ calls @sigprocmask@ with -- @SIG_SETMASK@ to block all interrupts in @mask@. setSignalMask :: SignalSet -> IO () setSignalMask set = sigProcMask "setSignalMask" (CONST_SIG_SETMASK :: CInt) set -- | @blockSignals mask@ calls @sigprocmask@ with -- @SIG_BLOCK@ to add all interrupts in @mask@ to the -- set of blocked interrupts. blockSignals :: SignalSet -> IO () blockSignals set = sigProcMask "blockSignals" (CONST_SIG_BLOCK :: CInt) set -- | @unblockSignals mask@ calls @sigprocmask@ with -- @SIG_UNBLOCK@ to remove all interrupts in @mask@ from the -- set of blocked interrupts. unblockSignals :: SignalSet -> IO () unblockSignals set = sigProcMask "unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set -- | @getPendingSignals@ calls @sigpending@ to obtain -- the set of interrupts which have been received but are currently blocked. getPendingSignals :: IO SignalSet getPendingSignals = do fp <- mallocForeignPtrBytes sizeof_sigset_t withForeignPtr fp $ \p -> throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p) return (SignalSet fp) #ifndef cygwin32_HOST_OS -- | @awaitSignal iset@ suspends execution until an interrupt is received. -- If @iset@ is @Just s@, @awaitSignal@ calls @sigsuspend@, installing -- @s@ as the new signal mask before suspending execution; otherwise, it -- calls @pause@. @awaitSignal@ returns on receipt of a signal. If you -- have installed any signal handlers with @installHandler@, it may be -- wise to call @yield@ directly after @awaitSignal@ to ensure that the -- signal handler runs as promptly as possible. awaitSignal :: Maybe SignalSet -> IO () awaitSignal maybe_sigset = do fp <- case maybe_sigset of Nothing -> do SignalSet fp <- getSignalMask; return fp Just (SignalSet fp) -> return fp withForeignPtr fp $ \p -> do c_sigsuspend p return () -- ignore the return value; according to the docs it can only ever be -- (-1) with errno set to EINTR. foreign import ccall unsafe "sigsuspend" c_sigsuspend :: Ptr CSigset -> IO CInt #endif #ifdef __HUGS__ foreign import ccall unsafe "sigdelset" c_sigdelset :: Ptr CSigset -> CInt -> IO CInt foreign import ccall unsafe "sigfillset" c_sigfillset :: Ptr CSigset -> IO CInt foreign import ccall unsafe "sigismember" c_sigismember :: Ptr CSigset -> CInt -> IO CInt #else foreign import ccall unsafe "__hscore_sigdelset" c_sigdelset :: Ptr CSigset -> CInt -> IO CInt foreign import ccall unsafe "__hscore_sigfillset" c_sigfillset :: Ptr CSigset -> IO CInt foreign import ccall unsafe "__hscore_sigismember" c_sigismember :: Ptr CSigset -> CInt -> IO CInt #endif /* __HUGS__ */ foreign import ccall unsafe "sigpending" c_sigpending :: Ptr CSigset -> IO CInt #endif /* mingw32_HOST_OS */ hugs98-plus-Sep2006/packages/base/System/Posix/Types.hs0000644006511100651110000000703010504340221021470 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Types -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX data types: Haskell equivalents of the types defined by the -- @\@ C header on a POSIX system. -- ----------------------------------------------------------------------------- #include "HsBaseConfig.h" module System.Posix.Types ( -- * POSIX data types #if defined(HTYPE_DEV_T) CDev, #endif #if defined(HTYPE_INO_T) CIno, #endif #if defined(HTYPE_MODE_T) CMode, #endif #if defined(HTYPE_OFF_T) COff, #endif #if defined(HTYPE_PID_T) CPid, #endif #if defined(HTYPE_SSIZE_T) CSsize, #endif #if defined(HTYPE_GID_T) CGid, #endif #if defined(HTYPE_NLINK_T) CNlink, #endif #if defined(HTYPE_UID_T) CUid, #endif #if defined(HTYPE_CC_T) CCc, #endif #if defined(HTYPE_SPEED_T) CSpeed, #endif #if defined(HTYPE_TCFLAG_T) CTcflag, #endif #if defined(HTYPE_RLIM_T) CRLim, #endif Fd(..), #if defined(HTYPE_NLINK_T) LinkCount, #endif #if defined(HTYPE_UID_T) UserID, #endif #if defined(HTYPE_GID_T) GroupID, #endif ByteCount, ClockTick, EpochTime, FileOffset, ProcessID, ProcessGroupID, DeviceID, FileID, FileMode, Limit ) where import Foreign import Foreign.C import Data.Typeable import Data.Bits #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Enum import GHC.Num import GHC.Real import GHC.Prim import GHC.Read import GHC.Show #else import Control.Monad #endif #include "CTypes.h" #if defined(HTYPE_DEV_T) ARITHMETIC_TYPE(CDev,tyConCDev,"CDev",HTYPE_DEV_T) #endif #if defined(HTYPE_INO_T) INTEGRAL_TYPE(CIno,tyConCIno,"CIno",HTYPE_INO_T) #endif #if defined(HTYPE_MODE_T) INTEGRAL_TYPE(CMode,tyConCMode,"CMode",HTYPE_MODE_T) #endif #if defined(HTYPE_OFF_T) INTEGRAL_TYPE(COff,tyConCOff,"COff",HTYPE_OFF_T) #endif #if defined(HTYPE_PID_T) INTEGRAL_TYPE(CPid,tyConCPid,"CPid",HTYPE_PID_T) #endif #if defined(HTYPE_SSIZE_T) INTEGRAL_TYPE(CSsize,tyConCSsize,"CSsize",HTYPE_SSIZE_T) #endif #if defined(HTYPE_GID_T) INTEGRAL_TYPE(CGid,tyConCGid,"CGid",HTYPE_GID_T) #endif #if defined(HTYPE_NLINK_T) INTEGRAL_TYPE(CNlink,tyConCNlink,"CNlink",HTYPE_NLINK_T) #endif #if defined(HTYPE_UID_T) INTEGRAL_TYPE(CUid,tyConCUid,"CUid",HTYPE_UID_T) #endif #if defined(HTYPE_CC_T) ARITHMETIC_TYPE(CCc,tyConCCc,"CCc",HTYPE_CC_T) #endif #if defined(HTYPE_SPEED_T) ARITHMETIC_TYPE(CSpeed,tyConCSpeed,"CSpeed",HTYPE_SPEED_T) #endif #if defined(HTYPE_TCFLAG_T) INTEGRAL_TYPE(CTcflag,tyConCTcflag,"CTcflag",HTYPE_TCFLAG_T) #endif #if defined(HTYPE_RLIM_T) INTEGRAL_TYPE(CRLim,tyConCRlim,"CRLim",HTYPE_RLIM_T) #endif -- ToDo: blksize_t, clockid_t, blkcnt_t, fsblkcnt_t, fsfilcnt_t, id_t, key_t -- suseconds_t, timer_t, useconds_t -- Make an Fd type rather than using CInt everywhere INTEGRAL_TYPE(Fd,tyConFd,"Fd",CInt) -- nicer names, and backwards compatibility with POSIX library: #if defined(HTYPE_NLINK_T) type LinkCount = CNlink #endif #if defined(HTYPE_UID_T) type UserID = CUid #endif #if defined(HTYPE_GID_T) type GroupID = CGid #endif type ByteCount = CSize type ClockTick = CClock type EpochTime = CTime type DeviceID = CDev type FileID = CIno type FileMode = CMode type ProcessID = CPid type FileOffset = COff type ProcessGroupID = CPid type Limit = CLong hugs98-plus-Sep2006/packages/base/System/Locale.hs0000644006511100651110000000513310504340221020463 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Locale -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- This module provides the ability to adapt to local conventions. -- At present, it supports only time and date information as used by -- 'System.Time.calendarTimeToString' from the "System.Time" module. -- ----------------------------------------------------------------------------- module System.Locale ( TimeLocale(..) , defaultTimeLocale , iso8601DateFormat , rfc822DateFormat ) where import Prelude data TimeLocale = TimeLocale { -- |full and abbreviated week days wDays :: [(String, String)], -- |full and abbreviated months months :: [(String, String)], intervals :: [(String, String)], -- |AM\/PM symbols amPm :: (String, String), -- |formatting strings dateTimeFmt, dateFmt, timeFmt, time12Fmt :: String } deriving (Eq, Ord, Show) defaultTimeLocale :: TimeLocale defaultTimeLocale = TimeLocale { wDays = [("Sunday", "Sun"), ("Monday", "Mon"), ("Tuesday", "Tue"), ("Wednesday", "Wed"), ("Thursday", "Thu"), ("Friday", "Fri"), ("Saturday", "Sat")], months = [("January", "Jan"), ("February", "Feb"), ("March", "Mar"), ("April", "Apr"), ("May", "May"), ("June", "Jun"), ("July", "Jul"), ("August", "Aug"), ("September", "Sep"), ("October", "Oct"), ("November", "Nov"), ("December", "Dec")], intervals = [ ("year","years") , ("month", "months") , ("day","days") , ("hour","hours") , ("min","mins") , ("sec","secs") , ("usec","usecs") ], amPm = ("AM", "PM"), dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y", dateFmt = "%m/%d/%y", timeFmt = "%H:%M:%S", time12Fmt = "%I:%M:%S %p" } -- |Normally, ISO-8601 just defines YYYY-MM-DD -- but we can add a time spec. iso8601DateFormat :: Maybe String -> String iso8601DateFormat timeFmt = "%Y-%m-%d" ++ case timeFmt of Nothing -> "" Just fmt -> ' ' : fmt rfc822DateFormat :: String rfc822DateFormat = "%a, %_d %b %Y %H:%M:%S %Z" hugs98-plus-Sep2006/packages/base/System/Mem.hs0000644006511100651110000000137610504340221020007 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Mem -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Memory-related system things. -- ----------------------------------------------------------------------------- module System.Mem ( performGC -- :: IO () ) where import Prelude #ifdef __HUGS__ import Hugs.IOExts #endif #ifdef __GLASGOW_HASKELL__ -- | Triggers an immediate garbage collection foreign import ccall {-safe-} "performMajorGC" performGC :: IO () #endif #ifdef __NHC__ import NHC.IOExtras (performGC) #endif hugs98-plus-Sep2006/packages/base/System/Process/0000755006511100651110000000000010504340225020350 5ustar rossrosshugs98-plus-Sep2006/packages/base/System/Process/Internals.hs0000644006511100651110000003445410504340225022655 0ustar rossross{-# OPTIONS_GHC -cpp -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Process.Internals -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Operations for creating and interacting with sub-processes. -- ----------------------------------------------------------------------------- -- #hide module System.Process.Internals ( #ifndef __HUGS__ ProcessHandle(..), ProcessHandle__(..), PHANDLE, closePHANDLE, mkProcessHandle, withProcessHandle, withProcessHandle_, #endif #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) pPrPr_disableITimers, c_execvpe, # ifdef __GLASGOW_HASKELL__ runProcessPosix, # endif ignoreSignal, defaultSignal, #else # ifdef __GLASGOW_HASKELL__ runProcessWin32, translate, # endif #endif #ifndef __HUGS__ commandToProcess, #endif withFilePathException, withCEnvironment ) where import Prelude -- necessary to get dependencies right #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) import System.Posix.Types ( CPid ) import System.IO ( Handle ) #else import Data.Word ( Word32 ) import Data.IORef #endif import System.Exit ( ExitCode ) import Data.Maybe ( fromMaybe ) # ifdef __GLASGOW_HASKELL__ import GHC.IOBase ( haFD, FD, Exception(..), IOException(..) ) import GHC.Handle ( stdin, stdout, stderr, withHandle_ ) # elif __HUGS__ import Hugs.Exception ( Exception(..), IOException(..) ) # endif import Control.Concurrent import Control.Exception ( handle, throwIO ) import Foreign.C import Foreign #if defined(mingw32_HOST_OS) import Control.Monad ( when ) import System.Directory ( doesFileExist ) import Control.Exception ( catchJust, ioErrors ) import System.IO.Error ( isDoesNotExistError, doesNotExistErrorType, mkIOError ) import System.Environment ( getEnv ) import System.Directory.Internals ( parseSearchPath, joinFileName ) #endif #ifdef __HUGS__ {-# CFILES cbits/execvpe.c #-} #endif #include "HsBaseConfig.h" #ifndef __HUGS__ -- ---------------------------------------------------------------------------- -- ProcessHandle type {- | A handle to a process, which can be used to wait for termination of the process using 'waitForProcess'. None of the process-creation functions in this library wait for termination: they all return a 'ProcessHandle' which may be used to wait for the process later. -} data ProcessHandle__ = OpenHandle PHANDLE | ClosedHandle ExitCode newtype ProcessHandle = ProcessHandle (MVar ProcessHandle__) withProcessHandle :: ProcessHandle -> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a withProcessHandle (ProcessHandle m) io = modifyMVar m io withProcessHandle_ :: ProcessHandle -> (ProcessHandle__ -> IO ProcessHandle__) -> IO () withProcessHandle_ (ProcessHandle m) io = modifyMVar_ m io #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) type PHANDLE = CPid mkProcessHandle :: PHANDLE -> IO ProcessHandle mkProcessHandle p = do m <- newMVar (OpenHandle p) return (ProcessHandle m) closePHANDLE :: PHANDLE -> IO () closePHANDLE _ = return () #else type PHANDLE = Word32 -- On Windows, we have to close this HANDLE when it is no longer required, -- hence we add a finalizer to it, using an IORef as the box on which to -- attach the finalizer. mkProcessHandle :: PHANDLE -> IO ProcessHandle mkProcessHandle h = do m <- newMVar (OpenHandle h) addMVarFinalizer m (processHandleFinaliser m) return (ProcessHandle m) processHandleFinaliser m = modifyMVar_ m $ \p_ -> do case p_ of OpenHandle ph -> closePHANDLE ph _ -> return () return (error "closed process handle") closePHANDLE :: PHANDLE -> IO () closePHANDLE ph = c_CloseHandle ph foreign import stdcall unsafe "CloseHandle" c_CloseHandle :: PHANDLE -> IO () #endif #endif /* !__HUGS__ */ -- ---------------------------------------------------------------------------- #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) -- this function disables the itimer, which would otherwise cause confusing -- signals to be sent to the new process. foreign import ccall unsafe "pPrPr_disableITimers" pPrPr_disableITimers :: IO () foreign import ccall unsafe "execvpe" c_execvpe :: CString -> Ptr CString -> Ptr CString -> IO CInt #endif #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) #ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- POSIX runProcess with signal handling in the child runProcessPosix :: String -> FilePath -- ^ Filename of the executable -> [String] -- ^ Arguments to pass to the executable -> Maybe FilePath -- ^ Optional path to the working directory -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit) -> Maybe Handle -- ^ Handle to use for @stdin@ -> Maybe Handle -- ^ Handle to use for @stdout@ -> Maybe Handle -- ^ Handle to use for @stderr@ -> Maybe CLong -- handler for SIGINT -> Maybe CLong -- handler for SIGQUIT -> IO ProcessHandle runProcessPosix fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr mb_sigint mb_sigquit = withFilePathException cmd $ do fd_stdin <- withHandle_ fun (fromMaybe stdin mb_stdin) $ return . haFD fd_stdout <- withHandle_ fun (fromMaybe stdout mb_stdout) $ return . haFD fd_stderr <- withHandle_ fun (fromMaybe stderr mb_stderr) $ return . haFD -- some of these might refer to the same Handle, so don't do -- nested withHandle_'s (that will deadlock). maybeWith withCEnvironment mb_env $ \pEnv -> do maybeWith withCString mb_cwd $ \pWorkDir -> do withMany withCString (cmd:args) $ \cstrs -> do let (set_int, inthand) = case mb_sigint of Nothing -> (0, 0) Just hand -> (1, hand) (set_quit, quithand) = case mb_sigquit of Nothing -> (0, 0) Just hand -> (1, hand) withArray0 nullPtr cstrs $ \pargs -> do ph <- throwErrnoIfMinus1 fun $ c_runProcess pargs pWorkDir pEnv fd_stdin fd_stdout fd_stderr set_int inthand set_quit quithand mkProcessHandle ph foreign import ccall unsafe "runProcess" c_runProcess :: Ptr CString -- args -> CString -- working directory (or NULL) -> Ptr CString -- env (or NULL) -> FD -- stdin -> FD -- stdout -> FD -- stderr -> CInt -- non-zero: set child's SIGINT handler -> CLong -- SIGINT handler -> CInt -- non-zero: set child's SIGQUIT handler -> CLong -- SIGQUIT handler -> IO PHANDLE #endif /* __GLASGOW_HASKELL__ */ ignoreSignal = CONST_SIG_IGN :: CLong defaultSignal = CONST_SIG_DFL :: CLong #else #ifdef __GLASGOW_HASKELL__ runProcessWin32 fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr extra_cmdline = withFilePathException cmd $ do fd_stdin <- withHandle_ fun (fromMaybe stdin mb_stdin) $ return . haFD fd_stdout <- withHandle_ fun (fromMaybe stdout mb_stdout) $ return . haFD fd_stderr <- withHandle_ fun (fromMaybe stderr mb_stderr) $ return . haFD -- some of these might refer to the same Handle, so don't do -- nested withHandle_'s (that will deadlock). maybeWith withCEnvironment mb_env $ \pEnv -> do maybeWith withCString mb_cwd $ \pWorkDir -> do let cmdline = translate cmd ++ concat (map ((' ':) . translate) args) ++ (if null extra_cmdline then "" else ' ':extra_cmdline) withCString cmdline $ \pcmdline -> do proc_handle <- throwErrnoIfMinus1 fun (c_runProcess pcmdline pWorkDir pEnv fd_stdin fd_stdout fd_stderr) mkProcessHandle proc_handle foreign import ccall unsafe "runProcess" c_runProcess :: CString -> CString -> Ptr () -> FD -> FD -> FD -> IO PHANDLE -- ------------------------------------------------------------------------ -- Passing commands to the OS on Windows {- On Windows this is tricky. We use CreateProcess, passing a single command-line string (lpCommandLine) as its argument. (CreateProcess is well documented on http://msdn.microsoft/com.) - It parses the beginning of the string to find the command. If the file name has embedded spaces, it must be quoted, using double quotes thus "foo\this that\cmd" arg1 arg2 - The invoked command can in turn access the entire lpCommandLine string, and the C runtime does indeed do so, parsing it to generate the traditional argument vector argv[0], argv[1], etc. It does this using a complex and arcane set of rules which are described here: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp (if this URL stops working, you might be able to find it by searching for "Parsing C Command-Line Arguments" on MSDN. Also, the code in the Microsoft C runtime that does this translation is shipped with VC++). Our goal in runProcess is to take a command filename and list of arguments, and construct a string which inverts the translatsions described above, such that the program at the other end sees exactly the same arguments in its argv[] that we passed to rawSystem. This inverse translation is implemented by 'translate' below. Here are some pages that give informations on Windows-related limitations and deviations from Unix conventions: http://support.microsoft.com/default.aspx?scid=kb;en-us;830473 Command lines and environment variables effectively limited to 8191 characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x): http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp Command-line substitution under Windows XP. IIRC these facilities (or at least a large subset of them) are available on Win NT and 2000. Some might be available on Win 9x. http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp How CMD.EXE processes command lines. Note: CreateProcess does have a separate argument (lpApplicationName) with which you can specify the command, but we have to slap the command into lpCommandLine anyway, so that argv[0] is what a C program expects (namely the application name). So it seems simpler to just use lpCommandLine alone, which CreateProcess supports. -} -- Translate command-line arguments for passing to CreateProcess(). translate :: String -> String translate str = '"' : snd (foldr escape (True,"\"") str) where escape '"' (b, str) = (True, '\\' : '"' : str) escape '\\' (True, str) = (True, '\\' : '\\' : str) escape '\\' (False, str) = (False, '\\' : str) escape c (b, str) = (False, c : str) -- See long comment above for what this function is trying to do. -- -- The Bool passed back along the string is True iff the -- rest of the string is a sequence of backslashes followed by -- a double quote. #endif /* __GLASGOW_HASKELL__ */ #endif #ifndef __HUGS__ -- ---------------------------------------------------------------------------- -- commandToProcess {- | Turns a shell command into a raw command. Usually this involves wrapping it in an invocation of the shell. There's a difference in the signature of commandToProcess between the Windows and Unix versions. On Unix, exec takes a list of strings, and we want to pass our command to /bin/sh as a single argument. On Windows, CreateProcess takes a single string for the command, which is later decomposed by cmd.exe. In this case, we just want to prepend @\"c:\WINDOWS\CMD.EXE \/c\"@ to our command line. The command-line translation that we normally do for arguments on Windows isn't required (or desirable) here. -} #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) commandToProcess :: String -> IO (FilePath,[String]) commandToProcess string = return ("/bin/sh", ["-c", string]) #else commandToProcess :: String -> IO (FilePath,String) commandToProcess string = do cmd <- findCommandInterpreter return (cmd, "/c "++string) -- We don't want to put the cmd into a single -- argument, because cmd.exe will not try to split it up. Instead, -- we just tack the command on the end of the cmd.exe command line, -- which partly works. There seem to be some quoting issues, but -- I don't have the energy to find+fix them right now (ToDo). --SDM -- (later) Now I don't know what the above comment means. sigh. -- Find CMD.EXE (or COMMAND.COM on Win98). We use the same algorithm as -- system() in the VC++ CRT (Vc7/crt/src/system.c in a VC++ installation). findCommandInterpreter :: IO FilePath findCommandInterpreter = do -- try COMSPEC first catchJust ioErrors (getEnv "COMSPEC") $ \e -> do when (not (isDoesNotExistError e)) $ ioError e -- try to find CMD.EXE or COMMAND.COM osver <- c_get_osver let filename | osver .&. 0x8000 /= 0 = "command.com" | otherwise = "cmd.exe" path <- getEnv "PATH" let -- use our own version of System.Directory.findExecutable, because -- that assumes the .exe suffix. search :: [FilePath] -> IO (Maybe FilePath) search [] = return Nothing search (d:ds) = do let path = d `joinFileName` filename b <- doesFileExist path if b then return (Just path) else search ds -- mb_path <- search (parseSearchPath path) case mb_path of Nothing -> ioError (mkIOError doesNotExistErrorType "findCommandInterpreter" Nothing Nothing) Just cmd -> return cmd foreign import ccall unsafe "__hscore_get_osver" c_get_osver :: IO CUInt #endif #endif /* __HUGS__ */ -- ---------------------------------------------------------------------------- -- Utils withFilePathException :: FilePath -> IO a -> IO a withFilePathException fpath act = handle mapEx act where mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath)) mapEx e = throwIO e #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) withCEnvironment :: [(String,String)] -> (Ptr CString -> IO a) -> IO a withCEnvironment env act = let env' = map (\(name, val) -> name ++ ('=':val)) env in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act) #else withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a withCEnvironment env act = let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" env in withCString env' (act . castPtr) #endif hugs98-plus-Sep2006/packages/base/System/Process.hs0000644006511100651110000002472710504340221020714 0ustar rossross{-# OPTIONS_GHC -cpp -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Process -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Operations for creating and interacting with sub-processes. -- ----------------------------------------------------------------------------- -- ToDo: -- * Flag to control whether exiting the parent also kills the child. -- * Windows impl of runProcess should close the Handles. -- * Add system/rawSystem replacements {- NOTES on createPipe: createPipe is no longer exported, because of the following problems: - it wasn't used to implement runInteractiveProcess on Unix, because the file descriptors for the unused ends of the pipe need to be closed in the child process. - on Windows, a special version of createPipe is needed that sets the inheritance flags correctly on the ends of the pipe (see mkAnonPipe below). -} module System.Process ( -- * Running sub-processes ProcessHandle, runCommand, runProcess, runInteractiveCommand, runInteractiveProcess, -- * Process completion waitForProcess, getProcessExitCode, terminateProcess, ) where import Prelude import System.Process.Internals import Foreign import Foreign.C import System.IO ( IOMode(..), Handle, hClose ) import System.Exit ( ExitCode(..) ) import System.Posix.Internals import GHC.IOBase ( FD ) import GHC.Handle ( openFd ) -- ---------------------------------------------------------------------------- -- runCommand {- | Runs a command using the shell. -} runCommand :: String -> IO ProcessHandle runCommand string = do (cmd,args) <- commandToProcess string #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) runProcessPosix "runCommand" cmd args Nothing Nothing Nothing Nothing Nothing Nothing Nothing #else runProcessWin32 "runCommand" cmd [] Nothing Nothing Nothing Nothing Nothing args #endif -- ---------------------------------------------------------------------------- -- runProcess {- | Runs a raw command, optionally specifying 'Handle's from which to take the @stdin@, @stdout@ and @stderr@ channels for the new process. Any 'Handle's passed to 'runProcess' are placed immediately in the closed state. -} runProcess :: FilePath -- ^ Filename of the executable -> [String] -- ^ Arguments to pass to the executable -> Maybe FilePath -- ^ Optional path to the working directory -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit) -> Maybe Handle -- ^ Handle to use for @stdin@ -> Maybe Handle -- ^ Handle to use for @stdout@ -> Maybe Handle -- ^ Handle to use for @stderr@ -> IO ProcessHandle runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) h <- runProcessPosix "runProcess" cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr Nothing Nothing #else h <- runProcessWin32 "runProcess" cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr "" #endif maybe (return ()) hClose mb_stdin maybe (return ()) hClose mb_stdout maybe (return ()) hClose mb_stderr return h -- ---------------------------------------------------------------------------- -- runInteractiveCommand {- | Runs a command using the shell, and returns 'Handle's that may be used to communicate with the process via its @stdin@, @stdout@, and @stderr@ respectively. -} runInteractiveCommand :: String -> IO (Handle,Handle,Handle,ProcessHandle) runInteractiveCommand string = do (cmd,args) <- commandToProcess string #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) runInteractiveProcess1 "runInteractiveCommand" cmd args Nothing Nothing #else runInteractiveProcess1 "runInteractiveCommand" cmd [] Nothing Nothing args #endif -- ---------------------------------------------------------------------------- -- runInteractiveProcess {- | Runs a raw command, and returns 'Handle's that may be used to communicate with the process via its @stdin@, @stdout@ and @stderr@ respectively. For example, to start a process and feed a string to its stdin: > (inp,out,err,pid) <- runInteractiveProcess "..." > forkIO (hPutStr inp str) -} runInteractiveProcess :: FilePath -- ^ Filename of the executable -> [String] -- ^ Arguments to pass to the executable -> Maybe FilePath -- ^ Optional path to the working directory -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit) -> IO (Handle,Handle,Handle,ProcessHandle) #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) runInteractiveProcess cmd args mb_cwd mb_env = runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env runInteractiveProcess1 fun cmd args mb_cwd mb_env = do withFilePathException cmd $ alloca $ \ pfdStdInput -> alloca $ \ pfdStdOutput -> alloca $ \ pfdStdError -> maybeWith withCEnvironment mb_env $ \pEnv -> maybeWith withCString mb_cwd $ \pWorkDir -> withMany withCString (cmd:args) $ \cstrs -> withArray0 nullPtr cstrs $ \pargs -> do proc_handle <- throwErrnoIfMinus1 fun (c_runInteractiveProcess pargs pWorkDir pEnv pfdStdInput pfdStdOutput pfdStdError) hndStdInput <- fdToHandle pfdStdInput WriteMode hndStdOutput <- fdToHandle pfdStdOutput ReadMode hndStdError <- fdToHandle pfdStdError ReadMode ph <- mkProcessHandle proc_handle return (hndStdInput, hndStdOutput, hndStdError, ph) foreign import ccall unsafe "runInteractiveProcess" c_runInteractiveProcess :: Ptr CString -> CString -> Ptr CString -> Ptr FD -> Ptr FD -> Ptr FD -> IO PHANDLE #else runInteractiveProcess cmd args mb_cwd mb_env = runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env "" runInteractiveProcess1 fun cmd args workDir env extra_cmdline = withFilePathException cmd $ do let cmdline = translate cmd ++ concat (map ((' ':) . translate) args) ++ (if null extra_cmdline then "" else ' ':extra_cmdline) withCString cmdline $ \pcmdline -> alloca $ \ pfdStdInput -> alloca $ \ pfdStdOutput -> alloca $ \ pfdStdError -> do maybeWith withCEnvironment env $ \pEnv -> do maybeWith withCString workDir $ \pWorkDir -> do proc_handle <- throwErrnoIfMinus1 fun $ c_runInteractiveProcess pcmdline pWorkDir pEnv pfdStdInput pfdStdOutput pfdStdError hndStdInput <- fdToHandle pfdStdInput WriteMode hndStdOutput <- fdToHandle pfdStdOutput ReadMode hndStdError <- fdToHandle pfdStdError ReadMode ph <- mkProcessHandle proc_handle return (hndStdInput, hndStdOutput, hndStdError, ph) foreign import ccall unsafe "runInteractiveProcess" c_runInteractiveProcess :: CString -> CString -> Ptr () -> Ptr FD -> Ptr FD -> Ptr FD -> IO PHANDLE #endif fdToHandle :: Ptr FD -> IOMode -> IO Handle fdToHandle pfd mode = do fd <- peek pfd openFd fd (Just Stream) False{-not a socket-} ("fd:" ++ show fd) mode True{-binary-} -- ---------------------------------------------------------------------------- -- waitForProcess {- | Waits for the specified process to terminate, and returns its exit code. GHC Note: in order to call @waitForProcess@ without blocking all the other threads in the system, you must compile the program with @-threaded@. -} waitForProcess :: ProcessHandle -> IO ExitCode waitForProcess ph = do p_ <- withProcessHandle ph $ \p_ -> return (p_,p_) case p_ of ClosedHandle e -> return e OpenHandle h -> do -- don't hold the MVar while we call c_waitForProcess... -- (XXX but there's a small race window here during which another -- thread could close the handle or call waitForProcess) code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess h) withProcessHandle ph $ \p_ -> case p_ of ClosedHandle e -> return (p_,e) OpenHandle ph -> do closePHANDLE ph let e = if (code == 0) then ExitSuccess else (ExitFailure (fromIntegral code)) return (ClosedHandle e, e) -- ---------------------------------------------------------------------------- -- terminateProcess -- | Attempts to terminate the specified process. This function should -- not be used under normal circumstances - no guarantees are given regarding -- how cleanly the process is terminated. To check whether the process -- has indeed terminated, use 'getProcessExitCode'. -- -- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal. -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing -- an exit code of 1. terminateProcess :: ProcessHandle -> IO () terminateProcess ph = do withProcessHandle_ ph $ \p_ -> case p_ of ClosedHandle _ -> return p_ OpenHandle h -> do throwErrnoIfMinus1_ "terminateProcess" $ c_terminateProcess h return p_ -- does not close the handle, we might want to try terminating it -- again, or get its exit code. -- ---------------------------------------------------------------------------- -- getProcessExitCode {- | This is a non-blocking version of 'waitForProcess'. If the process is still running, 'Nothing' is returned. If the process has exited, then @'Just' e@ is returned where @e@ is the exit code of the process. Subsequent calls to @getProcessExitStatus@ always return @'Just' 'ExitSuccess'@, regardless of what the original exit code was. -} getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode) getProcessExitCode ph = do withProcessHandle ph $ \p_ -> case p_ of ClosedHandle e -> return (p_, Just e) OpenHandle h -> alloca $ \pExitCode -> do res <- throwErrnoIfMinus1 "getProcessExitCode" $ c_getProcessExitCode h pExitCode code <- peek pExitCode if res == 0 then return (p_, Nothing) else do closePHANDLE h let e | code == 0 = ExitSuccess | otherwise = ExitFailure (fromIntegral code) return (ClosedHandle e, Just e) -- ---------------------------------------------------------------------------- -- Interface to C bits foreign import ccall unsafe "terminateProcess" c_terminateProcess :: PHANDLE -> IO CInt foreign import ccall unsafe "getProcessExitCode" c_getProcessExitCode :: PHANDLE -> Ptr CInt -> IO CInt foreign import ccall safe "waitForProcess" -- NB. safe - can block c_waitForProcess :: PHANDLE -> IO CInt hugs98-plus-Sep2006/packages/base/System/Random.hs0000644006511100651110000003411410504340226020512 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Random -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- Random numbers. -- ----------------------------------------------------------------------------- module System.Random ( -- $intro -- * The 'RandomGen' class, and the 'StdGen' generator RandomGen(next, split, genRange) , StdGen , mkStdGen -- * The 'Random' class , Random ( random, randomR, randoms, randomRs, randomIO, randomRIO ) -- * The global random number generator -- $globalrng , getStdRandom , getStdGen , setStdGen , newStdGen -- * References -- $references ) where import Prelude #ifdef __NHC__ import CPUTime ( getCPUTime ) import Foreign.Ptr ( Ptr, nullPtr ) #else import System.CPUTime ( getCPUTime ) import System.Time ( getClockTime, ClockTime(..) ) #endif import Data.Char ( isSpace, chr, ord ) import System.IO.Unsafe ( unsafePerformIO ) import Data.IORef import Numeric ( readDec ) -- The standard nhc98 implementation of Time.ClockTime does not match -- the extended one expected in this module, so we lash-up a quick -- replacement here. #ifdef __NHC__ data ClockTime = TOD Integer () foreign import ccall "time.h time" readtime :: Ptr () -> IO Int getClockTime :: IO ClockTime getClockTime = do t <- readtime nullPtr; return (TOD (toInteger t) ()) #endif {- $intro This library deals with the common task of pseudo-random number generation. The library makes it possible to generate repeatable results, by starting with a specified initial random number generator; or to get different results on each run by using the system-initialised generator, or by supplying a seed from some other source. The library is split into two layers: * A core /random number generator/ provides a supply of bits. The class 'RandomGen' provides a common interface to such generators. * The class 'Random' provides a way to extract particular values from a random number generator. For example, the 'Float' instance of 'Random' allows one to generate random values of type 'Float'. This implementation uses the Portable Combined Generator of L'Ecuyer ["System.Random\#LEcuyer"] for 32-bit computers, transliterated by Lennart Augustsson. It has a period of roughly 2.30584e18. -} -- | The class 'RandomGen' provides a common interface to random number -- generators. class RandomGen g where -- |The 'next' operation returns an 'Int' that is uniformly distributed -- in the range returned by 'genRange' (including both end points), -- and a new generator. next :: g -> (Int, g) -- |The 'split' operation allows one to obtain two distinct random number -- generators. This is very useful in functional programs (for example, when -- passing a random number generator down to recursive calls), but very -- little work has been done on statistically robust implementations of -- 'split' (["System.Random\#Burton", "System.Random\#Hellekalek"] -- are the only examples we know of). split :: g -> (g, g) -- |The 'genRange' operation yields the range of values returned by -- the generator. -- -- It is required that: -- -- * If @(a,b) = 'genRange' g@, then @a < b@. -- -- * 'genRange' is not strict. -- -- The second condition ensures that 'genRange' cannot examine its -- argument, and hence the value it returns can be determined only by the -- instance of 'RandomGen'. That in turn allows an implementation to make -- a single call to 'genRange' to establish a generator's range, without -- being concerned that the generator returned by (say) 'next' might have -- a different range to the generator passed to 'next'. genRange :: g -> (Int,Int) -- default method genRange g = (minBound,maxBound) {- |The "System.Random" library provides one instance of 'RandomGen', the abstract data type 'StdGen'. The 'StdGen' instance of 'RandomGen' has a 'genRange' of at least 30 bits. The result of repeatedly using 'next' should be at least as statistically robust as the /Minimal Standard Random Number Generator/ described by ["System.Random\#Park", "System.Random\#Carta"]. Until more is known about implementations of 'split', all we require is that 'split' deliver generators that are (a) not identical and (b) independently robust in the sense just given. The 'Show' and 'Read' instances of 'StdGen' provide a primitive way to save the state of a random number generator. It is required that @'read' ('show' g) == g@. In addition, 'read' may be used to map an arbitrary string (not necessarily one produced by 'show') onto a value of type 'StdGen'. In general, the 'read' instance of 'StdGen' has the following properties: * It guarantees to succeed on any string. * It guarantees to consume only a finite portion of the string. * Different argument strings are likely to result in different results. -} data StdGen = StdGen Int Int instance RandomGen StdGen where next = stdNext split = stdSplit genRange _ = stdRange instance Show StdGen where showsPrec p (StdGen s1 s2) = showsPrec p s1 . showChar ' ' . showsPrec p s2 instance Read StdGen where readsPrec _p = \ r -> case try_read r of r@[_] -> r _ -> [stdFromString r] -- because it shouldn't ever fail. where try_read r = do (s1, r1) <- readDec (dropWhile isSpace r) (s2, r2) <- readDec (dropWhile isSpace r1) return (StdGen s1 s2, r2) {- If we cannot unravel the StdGen from a string, create one based on the string given. -} stdFromString :: String -> (StdGen, String) stdFromString s = (mkStdGen num, rest) where (cs, rest) = splitAt 6 s num = foldl (\a x -> x + 3 * a) 1 (map ord cs) {- | The function 'mkStdGen' provides an alternative way of producing an initial generator, by mapping an 'Int' into a generator. Again, distinct arguments should be likely to produce distinct generators. Programmers may, of course, supply their own instances of 'RandomGen'. -} mkStdGen :: Int -> StdGen -- why not Integer ? mkStdGen s | s < 0 = mkStdGen (-s) | otherwise = StdGen (s1+1) (s2+1) where (q, s1) = s `divMod` 2147483562 s2 = q `mod` 2147483398 createStdGen :: Integer -> StdGen createStdGen s | s < 0 = createStdGen (-s) | otherwise = StdGen (fromInteger (s1+1)) (fromInteger (s2+1)) where (q, s1) = s `divMod` 2147483562 s2 = q `mod` 2147483398 -- FIXME: 1/2/3 below should be ** (vs@30082002) XXX {- | With a source of random number supply in hand, the 'Random' class allows the programmer to extract random values of a variety of types. Minimal complete definition: 'randomR' and 'random'. -} class Random a where -- | Takes a range /(lo,hi)/ and a random number generator -- /g/, and returns a random value uniformly distributed in the closed -- interval /[lo,hi]/, together with a new generator. It is unspecified -- what happens if /lo>hi/. For continuous types there is no requirement -- that the values /lo/ and /hi/ are ever produced, but they may be, -- depending on the implementation and the interval. randomR :: RandomGen g => (a,a) -> g -> (a,g) -- | The same as 'randomR', but using a default range determined by the type: -- -- * For bounded types (instances of 'Bounded', such as 'Char'), -- the range is normally the whole type. -- -- * For fractional types, the range is normally the semi-closed interval -- @[0,1)@. -- -- * For 'Integer', the range is (arbitrarily) the range of 'Int'. random :: RandomGen g => g -> (a, g) -- | Plural variant of 'randomR', producing an infinite list of -- random values instead of returning a new generator. randomRs :: RandomGen g => (a,a) -> g -> [a] randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g -- | Plural variant of 'random', producing an infinite list of -- random values instead of returning a new generator. randoms :: RandomGen g => g -> [a] randoms g = (\(x,g') -> x : randoms g') (random g) -- | A variant of 'randomR' that uses the global random number generator -- (see "System.Random#globalrng"). randomRIO :: (a,a) -> IO a randomRIO range = getStdRandom (randomR range) -- | A variant of 'random' that uses the global random number generator -- (see "System.Random#globalrng"). randomIO :: IO a randomIO = getStdRandom random instance Random Int where randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g random g = randomR (minBound,maxBound) g instance Random Char where randomR (a,b) g = case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of (x,g) -> (chr x, g) random g = randomR (minBound,maxBound) g instance Random Bool where randomR (a,b) g = case (randomIvalInteger (toInteger (bool2Int a), toInteger (bool2Int b)) g) of (x, g) -> (int2Bool x, g) where bool2Int False = 0 bool2Int True = 1 int2Bool 0 = False int2Bool _ = True random g = randomR (minBound,maxBound) g instance Random Integer where randomR ival g = randomIvalInteger ival g random g = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g instance Random Double where randomR ival g = randomIvalDouble ival id g random g = randomR (0::Double,1) g -- hah, so you thought you were saving cycles by using Float? instance Random Float where random g = randomIvalDouble (0::Double,1) realToFrac g randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g mkStdRNG :: Integer -> IO StdGen mkStdRNG o = do ct <- getCPUTime (TOD sec _) <- getClockTime return (createStdGen (sec * 12345 + ct + o)) randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g) randomIvalInteger (l,h) rng | l > h = randomIvalInteger (h,l) rng | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng') where k = h - l + 1 b = 2147483561 n = iLogBase b k f 0 acc g = (acc, g) f n acc g = let (x,g') = next g in f (n-1) (fromIntegral x + acc * b) g' randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g) randomIvalDouble (l,h) fromDouble rng | l > h = randomIvalDouble (h,l) fromDouble rng | otherwise = case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of (x, rng') -> let scaled_x = fromDouble ((l+h)/2) + fromDouble ((h-l) / realToFrac intRange) * fromIntegral (x::Int) in (scaled_x, rng') intRange :: Integer intRange = toInteger (maxBound::Int) - toInteger (minBound::Int) iLogBase :: Integer -> Integer -> Integer iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b) stdRange :: (Int,Int) stdRange = (0, 2147483562) stdNext :: StdGen -> (Int, StdGen) -- Returns values in the range stdRange stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'') where z' = if z < 1 then z + 2147483562 else z z = s1'' - s2'' k = s1 `quot` 53668 s1' = 40014 * (s1 - k * 53668) - k * 12211 s1'' = if s1' < 0 then s1' + 2147483563 else s1' k' = s2 `quot` 52774 s2' = 40692 * (s2 - k' * 52774) - k' * 3791 s2'' = if s2' < 0 then s2' + 2147483399 else s2' stdSplit :: StdGen -> (StdGen, StdGen) stdSplit std@(StdGen s1 s2) = (left, right) where -- no statistical foundation for this! left = StdGen new_s1 t2 right = StdGen t1 new_s2 new_s1 | s1 == 2147483562 = 1 | otherwise = s1 + 1 new_s2 | s2 == 1 = 2147483398 | otherwise = s2 - 1 StdGen t1 t2 = snd (next std) -- The global random number generator {- $globalrng #globalrng# There is a single, implicit, global random number generator of type 'StdGen', held in some global variable maintained by the 'IO' monad. It is initialised automatically in some system-dependent fashion, for example, by using the time of day, or Linux's kernel random number generator. To get deterministic behaviour, use 'setStdGen'. -} -- |Sets the global random number generator. setStdGen :: StdGen -> IO () setStdGen sgen = writeIORef theStdGen sgen -- |Gets the global random number generator. getStdGen :: IO StdGen getStdGen = readIORef theStdGen theStdGen :: IORef StdGen theStdGen = unsafePerformIO $ do rng <- mkStdRNG 0 newIORef rng -- |Applies 'split' to the current global random generator, -- updates it with one of the results, and returns the other. newStdGen :: IO StdGen newStdGen = do rng <- getStdGen let (a,b) = split rng setStdGen a return b {- |Uses the supplied function to get a value from the current global random generator, and updates the global generator with the new generator returned by the function. For example, @rollDice@ gets a random integer between 1 and 6: > rollDice :: IO Int > rollDice = getStdRandom (randomR (1,6)) -} getStdRandom :: (StdGen -> (a,StdGen)) -> IO a getStdRandom f = do rng <- getStdGen let (v, new_rng) = f rng setStdGen new_rng return v {- $references 1. FW #Burton# Burton and RL Page, /Distributed random number generation/, Journal of Functional Programming, 2(2):203-212, April 1992. 2. SK #Park# Park, and KW Miller, /Random number generators - good ones are hard to find/, Comm ACM 31(10), Oct 1988, pp1192-1201. 3. DG #Carta# Carta, /Two fast implementations of the minimal standard random number generator/, Comm ACM, 33(1), Jan 1990, pp87-88. 4. P #Hellekalek# Hellekalek, /Don\'t trust parallel Monte Carlo/, Department of Mathematics, University of Salzburg, , 1998. 5. Pierre #LEcuyer# L'Ecuyer, /Efficient and portable combined random number generators/, Comm ACM, 31(6), Jun 1988, pp742-749. The Web site is a great source of information. -} hugs98-plus-Sep2006/packages/base/System/Time.hsc0000644006511100651110000006542410504340221020336 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Time -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- The standard Time library, providing standard functionality for clock -- times, including timezone information (i.e, the functionality of -- \"@time.h@\", adapted to the Haskell environment). It follows RFC -- 1129 in its use of Coordinated Universal Time (UTC). ----------------------------------------------------------------------------- {- Haskell 98 Time of Day Library ------------------------------ 2000/06/17 : RESTRICTIONS: * min./max. time diff currently is restricted to [minBound::Int, maxBound::Int] * surely other restrictions wrt. min/max bounds NOTES: * printing times `showTime' (used in `instance Show ClockTime') always prints time converted to the local timezone (even if it is taken from `(toClockTime . toUTCTime)'), whereas `calendarTimeToString' honors the tzone & tz fields and prints UTC or whatever timezone is stored inside CalendarTime. Maybe `showTime' should be changed to use UTC, since it would better correspond to the actual representation of `ClockTime' (can be done by replacing localtime(3) by gmtime(3)). BUGS: * add proper handling of microsecs, currently, they're mostly ignored * `formatFOO' case of `%s' is currently broken... TODO: * check for unusual date cases, like 1970/1/1 00:00h, and conversions between different timezone's etc. * check, what needs to be in the IO monad, the current situation seems to be a bit inconsistent to me * check whether `isDst = -1' works as expected on other arch's (Solaris anyone?) * add functions to parse strings to `CalendarTime' (some day...) * implement padding capabilities ("%_", "%-") in `formatFOO' * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO' -} module System.Time ( -- * Clock times ClockTime(..) -- non-standard, lib. report gives this as abstract -- instance Eq, Ord -- instance Show (non-standard) , getClockTime -- * Time differences , TimeDiff(..) , noTimeDiff -- non-standard (but useful when constructing TimeDiff vals.) , diffClockTimes , addToClockTime , normalizeTimeDiff -- non-standard , timeDiffToString -- non-standard , formatTimeDiff -- non-standard -- * Calendar times , CalendarTime(..) , Month(..) , Day(..) , toCalendarTime , toUTCTime , toClockTime , calendarTimeToString , formatCalendarTime ) where #ifdef __GLASGOW_HASKELL__ #include "HsBase.h" #endif #ifdef __NHC__ #include # if defined(__sun) || defined(__CYGWIN32__) # define HAVE_TZNAME 1 # else # define HAVE_TM_ZONE 1 # endif import Ix #endif import Prelude import Data.Ix import System.Locale import System.IO.Unsafe #ifdef __HUGS__ import Hugs.Time ( getClockTimePrim, toCalTimePrim, toClockTimePrim ) #else import Foreign import Foreign.C #endif -- One way to partition and give name to chunks of a year and a week: -- | A month of the year. data Month = January | February | March | April | May | June | July | August | September | October | November | December deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) -- | A day of the week. data Day = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) -- | A representation of the internal clock time. -- Clock times may be compared, converted to strings, or converted to an -- external calendar time 'CalendarTime' for I\/O or other manipulations. data ClockTime = TOD Integer Integer -- ^ Construct a clock time. The arguments are a number -- of seconds since 00:00:00 (UTC) on 1 January 1970, -- and an additional number of picoseconds. -- -- In Haskell 98, the 'ClockTime' type is abstract. deriving (Eq, Ord) -- When a ClockTime is shown, it is converted to a CalendarTime in the current -- timezone and then printed. FIXME: This is arguably wrong, since we can't -- get the current timezone without being in the IO monad. instance Show ClockTime where showsPrec _ t = showString (calendarTimeToString (unsafePerformIO (toCalendarTime t))) {- The numeric fields have the following ranges. \begin{verbatim} Value Range Comments ----- ----- -------- year -maxInt .. maxInt [Pre-Gregorian dates are inaccurate] day 1 .. 31 hour 0 .. 23 min 0 .. 59 sec 0 .. 61 [Allows for two leap seconds] picosec 0 .. (10^12)-1 [This could be over-precise?] yday 0 .. 365 [364 in non-Leap years] tz -43200 .. 43200 [Variation from UTC in seconds] \end{verbatim} -} -- | 'CalendarTime' is a user-readable and manipulable -- representation of the internal 'ClockTime' type. data CalendarTime = CalendarTime { ctYear :: Int -- ^ Year (pre-Gregorian dates are inaccurate) , ctMonth :: Month -- ^ Month of the year , ctDay :: Int -- ^ Day of the month (1 to 31) , ctHour :: Int -- ^ Hour of the day (0 to 23) , ctMin :: Int -- ^ Minutes (0 to 59) , ctSec :: Int -- ^ Seconds (0 to 61, allowing for up to -- two leap seconds) , ctPicosec :: Integer -- ^ Picoseconds , ctWDay :: Day -- ^ Day of the week , ctYDay :: Int -- ^ Day of the year -- (0 to 364, or 365 in leap years) , ctTZName :: String -- ^ Name of the time zone , ctTZ :: Int -- ^ Variation from UTC in seconds , ctIsDST :: Bool -- ^ 'True' if Daylight Savings Time would -- be in effect, and 'False' otherwise } deriving (Eq,Ord,Read,Show) -- | records the difference between two clock times in a user-readable way. data TimeDiff = TimeDiff { tdYear :: Int, tdMonth :: Int, tdDay :: Int, tdHour :: Int, tdMin :: Int, tdSec :: Int, tdPicosec :: Integer -- not standard } deriving (Eq,Ord,Read,Show) -- | null time difference. noTimeDiff :: TimeDiff noTimeDiff = TimeDiff 0 0 0 0 0 0 0 -- ----------------------------------------------------------------------------- -- | returns the current time in its internal representation. getClockTime :: IO ClockTime #ifdef __HUGS__ getClockTime = do (sec,usec) <- getClockTimePrim return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000000)) #elif HAVE_GETTIMEOFDAY getClockTime = do let realToInteger = round . realToFrac :: Real a => a -> Integer allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr sec <- (#peek struct timeval,tv_sec) p_timeval :: IO CTime usec <- (#peek struct timeval,tv_usec) p_timeval :: IO CTime return (TOD (realToInteger sec) ((realToInteger usec) * 1000000)) #elif HAVE_FTIME getClockTime = do let realToInteger = round . realToFrac :: Real a => a -> Integer allocaBytes (#const sizeof(struct timeb)) $ \ p_timeb -> do ftime p_timeb sec <- (#peek struct timeb,time) p_timeb :: IO CTime msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort return (TOD (realToInteger sec) (fromIntegral msec * 1000000000)) #else /* use POSIX time() */ getClockTime = do secs <- time nullPtr -- can't fail, according to POSIX let realToInteger = round . realToFrac :: Real a => a -> Integer return (TOD (realToInteger secs) 0) #endif -- ----------------------------------------------------------------------------- -- | @'addToClockTime' d t@ adds a time difference @d@ and a -- clock time @t@ to yield a new clock time. The difference @d@ -- may be either positive or negative. addToClockTime :: TimeDiff -> ClockTime -> ClockTime addToClockTime (TimeDiff year mon day hour min sec psec) (TOD c_sec c_psec) = let sec_diff = toInteger sec + 60 * toInteger min + 3600 * toInteger hour + 24 * 3600 * toInteger day (d_sec, d_psec) = (c_psec + psec) `quotRem` 1000000000000 cal = toUTCTime (TOD (c_sec + sec_diff + d_sec) d_psec) new_mon = fromEnum (ctMonth cal) + r_mon month' = fst tmp yr_diff = snd tmp tmp | new_mon < 0 = (toEnum (12 + new_mon), (-1)) | new_mon > 11 = (toEnum (new_mon `mod` 12), 1) | otherwise = (toEnum new_mon, 0) (r_yr, r_mon) = mon `quotRem` 12 year' = ctYear cal + year + r_yr + yr_diff in toClockTime cal{ctMonth=month', ctYear=year'} -- | @'diffClockTimes' t1 t2@ returns the difference between two clock -- times @t1@ and @t2@ as a 'TimeDiff'. diffClockTimes :: ClockTime -> ClockTime -> TimeDiff -- diffClockTimes is meant to be the dual to `addToClockTime'. -- If you want to have the TimeDiff properly splitted, use -- `normalizeTimeDiff' on this function's result -- -- CAVEAT: see comment of normalizeTimeDiff diffClockTimes (TOD sa pa) (TOD sb pb) = noTimeDiff{ tdSec = fromIntegral (sa - sb) -- FIXME: can handle just 68 years... , tdPicosec = pa - pb } -- | converts a time difference to normal form. normalizeTimeDiff :: TimeDiff -> TimeDiff -- FIXME: handle psecs properly -- FIXME: ?should be called by formatTimeDiff automagically? -- -- when applied to something coming out of `diffClockTimes', you loose -- the duality to `addToClockTime', since a year does not always have -- 365 days, etc. -- -- apply this function as late as possible to prevent those "rounding" -- errors normalizeTimeDiff td = let rest0 = toInteger (tdSec td) + 60 * (toInteger (tdMin td) + 60 * (toInteger (tdHour td) + 24 * (toInteger (tdDay td) + 30 * toInteger (tdMonth td) + 365 * toInteger (tdYear td)))) (diffYears, rest1) = rest0 `quotRem` (365 * 24 * 3600) (diffMonths, rest2) = rest1 `quotRem` (30 * 24 * 3600) (diffDays, rest3) = rest2 `quotRem` (24 * 3600) (diffHours, rest4) = rest3 `quotRem` 3600 (diffMins, diffSecs) = rest4 `quotRem` 60 in td{ tdYear = fromInteger diffYears , tdMonth = fromInteger diffMonths , tdDay = fromInteger diffDays , tdHour = fromInteger diffHours , tdMin = fromInteger diffMins , tdSec = fromInteger diffSecs } #ifndef __HUGS__ -- ----------------------------------------------------------------------------- -- How do we deal with timezones on this architecture? -- The POSIX way to do it is through the global variable tzname[]. -- But that's crap, so we do it The BSD Way if we can: namely use the -- tm_zone and tm_gmtoff fields of struct tm, if they're available. zone :: Ptr CTm -> IO (Ptr CChar) gmtoff :: Ptr CTm -> IO CLong #if HAVE_TM_ZONE zone x = (#peek struct tm,tm_zone) x gmtoff x = (#peek struct tm,tm_gmtoff) x #else /* ! HAVE_TM_ZONE */ # if HAVE_TZNAME || defined(_WIN32) # if cygwin32_HOST_OS # define tzname _tzname # endif # ifndef mingw32_HOST_OS foreign import ccall unsafe "time.h &tzname" tzname :: Ptr (Ptr CChar) # else foreign import ccall unsafe "__hscore_timezone" timezone :: Ptr CLong foreign import ccall unsafe "__hscore_tzname" tzname :: Ptr (Ptr CChar) # endif zone x = do dst <- (#peek struct tm,tm_isdst) x if dst then peekElemOff tzname 1 else peekElemOff tzname 0 # else /* ! HAVE_TZNAME */ -- We're in trouble. If you should end up here, please report this as a bug. # error "Don't know how to get at timezone name on your OS." # endif /* ! HAVE_TZNAME */ -- Get the offset in secs from UTC, if (struct tm) doesn't supply it. */ # if HAVE_DECL_ALTZONE foreign import ccall "&altzone" altzone :: Ptr CTime foreign import ccall "&timezone" timezone :: Ptr CTime gmtoff x = do dst <- (#peek struct tm,tm_isdst) x tz <- if dst then peek altzone else peek timezone let realToInteger = round . realToFrac :: Real a => a -> Integer return (-fromIntegral (realToInteger tz)) # else /* ! HAVE_DECL_ALTZONE */ #if !defined(mingw32_HOST_OS) foreign import ccall "time.h &timezone" timezone :: Ptr CLong #endif -- Assume that DST offset is 1 hour ... gmtoff x = do dst <- (#peek struct tm,tm_isdst) x tz <- peek timezone -- According to the documentation for tzset(), -- http://www.opengroup.org/onlinepubs/007908799/xsh/tzset.html -- timezone offsets are > 0 west of the Prime Meridian. -- -- This module assumes the interpretation of tm_gmtoff, i.e., offsets -- are > 0 East of the Prime Meridian, so flip the sign. return (- (if dst then (fromIntegral tz - 3600) else tz)) # endif /* ! HAVE_DECL_ALTZONE */ #endif /* ! HAVE_TM_ZONE */ #endif /* ! __HUGS__ */ -- ----------------------------------------------------------------------------- -- | converts an internal clock time to a local time, modified by the -- timezone and daylight savings time settings in force at the time -- of conversion. Because of this dependence on the local environment, -- 'toCalendarTime' is in the 'IO' monad. toCalendarTime :: ClockTime -> IO CalendarTime #ifdef __HUGS__ toCalendarTime = toCalTime False #elif HAVE_LOCALTIME_R toCalendarTime = clockToCalendarTime_reentrant (throwAwayReturnPointer localtime_r) False #else toCalendarTime = clockToCalendarTime_static localtime False #endif -- | converts an internal clock time into a 'CalendarTime' in standard -- UTC format. toUTCTime :: ClockTime -> CalendarTime #ifdef __HUGS__ toUTCTime = unsafePerformIO . toCalTime True #elif HAVE_GMTIME_R toUTCTime = unsafePerformIO . clockToCalendarTime_reentrant (throwAwayReturnPointer gmtime_r) True #else toUTCTime = unsafePerformIO . clockToCalendarTime_static gmtime True #endif #ifdef __HUGS__ toCalTime :: Bool -> ClockTime -> IO CalendarTime toCalTime toUTC (TOD s psecs) | (s > fromIntegral (maxBound :: Int)) || (s < fromIntegral (minBound :: Int)) = error ((if toUTC then "toUTCTime: " else "toCalendarTime: ") ++ "clock secs out of range") | otherwise = do (sec,min,hour,mday,mon,year,wday,yday,isdst,zone,off) <- toCalTimePrim (if toUTC then 1 else 0) (fromIntegral s) return (CalendarTime{ ctYear=1900+year , ctMonth=toEnum mon , ctDay=mday , ctHour=hour , ctMin=min , ctSec=sec , ctPicosec=psecs , ctWDay=toEnum wday , ctYDay=yday , ctTZName=(if toUTC then "UTC" else zone) , ctTZ=(if toUTC then 0 else off) , ctIsDST=not toUTC && (isdst/=0) }) #else /* ! __HUGS__ */ throwAwayReturnPointer :: (Ptr CTime -> Ptr CTm -> IO (Ptr CTm)) -> (Ptr CTime -> Ptr CTm -> IO ( )) throwAwayReturnPointer fun x y = fun x y >> return () #if !HAVE_LOCALTIME_R || !HAVE_GMTIME_R clockToCalendarTime_static :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime -> IO CalendarTime clockToCalendarTime_static fun is_utc (TOD secs psec) = do with (fromIntegral secs :: CTime) $ \ p_timer -> do p_tm <- fun p_timer -- can't fail, according to POSIX clockToCalendarTime_aux is_utc p_tm psec #endif #if HAVE_LOCALTIME_R || HAVE_GMTIME_R clockToCalendarTime_reentrant :: (Ptr CTime -> Ptr CTm -> IO ()) -> Bool -> ClockTime -> IO CalendarTime clockToCalendarTime_reentrant fun is_utc (TOD secs psec) = do with (fromIntegral secs :: CTime) $ \ p_timer -> do allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do fun p_timer p_tm clockToCalendarTime_aux is_utc p_tm psec #endif clockToCalendarTime_aux :: Bool -> Ptr CTm -> Integer -> IO CalendarTime clockToCalendarTime_aux is_utc p_tm psec = do sec <- (#peek struct tm,tm_sec ) p_tm :: IO CInt min <- (#peek struct tm,tm_min ) p_tm :: IO CInt hour <- (#peek struct tm,tm_hour ) p_tm :: IO CInt mday <- (#peek struct tm,tm_mday ) p_tm :: IO CInt mon <- (#peek struct tm,tm_mon ) p_tm :: IO CInt year <- (#peek struct tm,tm_year ) p_tm :: IO CInt wday <- (#peek struct tm,tm_wday ) p_tm :: IO CInt yday <- (#peek struct tm,tm_yday ) p_tm :: IO CInt isdst <- (#peek struct tm,tm_isdst) p_tm :: IO CInt zone <- zone p_tm tz <- gmtoff p_tm tzname <- peekCString zone let month | mon >= 0 && mon <= 11 = toEnum (fromIntegral mon) | otherwise = error ("toCalendarTime: illegal month value: " ++ show mon) return (CalendarTime (1900 + fromIntegral year) month (fromIntegral mday) (fromIntegral hour) (fromIntegral min) (fromIntegral sec) psec (toEnum (fromIntegral wday)) (fromIntegral yday) (if is_utc then "UTC" else tzname) (if is_utc then 0 else fromIntegral tz) (if is_utc then False else isdst /= 0)) #endif /* ! __HUGS__ */ -- | converts a 'CalendarTime' into the corresponding internal -- 'ClockTime', ignoring the contents of the 'ctWDay', 'ctYDay', -- 'ctTZName' and 'ctIsDST' fields. toClockTime :: CalendarTime -> ClockTime #ifdef __HUGS__ toClockTime (CalendarTime yr mon mday hour min sec psec _wday _yday _tzname tz _isdst) = unsafePerformIO $ do s <- toClockTimePrim (yr-1900) (fromEnum mon) mday hour min sec tz return (TOD (fromIntegral s) psec) #else /* ! __HUGS__ */ toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz isdst) = -- `isDst' causes the date to be wrong by one hour... -- FIXME: check, whether this works on other arch's than Linux, too... -- -- so we set it to (-1) (means `unknown') and let `mktime' determine -- the real value... let isDst = -1 :: CInt in -- if isdst then (1::Int) else 0 if psec < 0 || psec > 999999999999 then error "Time.toClockTime: picoseconds out of range" else if tz < -43200 || tz > 43200 then error "Time.toClockTime: timezone offset out of range" else unsafePerformIO $ do allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do (#poke struct tm,tm_sec ) p_tm (fromIntegral sec :: CInt) (#poke struct tm,tm_min ) p_tm (fromIntegral min :: CInt) (#poke struct tm,tm_hour ) p_tm (fromIntegral hour :: CInt) (#poke struct tm,tm_mday ) p_tm (fromIntegral mday :: CInt) (#poke struct tm,tm_mon ) p_tm (fromIntegral (fromEnum mon) :: CInt) (#poke struct tm,tm_year ) p_tm (fromIntegral year - 1900 :: CInt) (#poke struct tm,tm_isdst) p_tm isDst t <- throwIf (== -1) (\_ -> "Time.toClockTime: invalid input") (mktime p_tm) -- -- mktime expects its argument to be in the local timezone, but -- toUTCTime makes UTC-encoded CalendarTime's ... -- -- Since there is no any_tz_struct_tm-to-time_t conversion -- function, we have to fake one... :-) If not in all, it works in -- most cases (before, it was the other way round...) -- -- Luckily, mktime tells us, what it *thinks* the timezone is, so, -- to compensate, we add the timezone difference to mktime's -- result. -- gmtoff <- gmtoff p_tm let realToInteger = round . realToFrac :: Real a => a -> Integer res = realToInteger t - fromIntegral tz + fromIntegral gmtoff return (TOD res psec) #endif /* ! __HUGS__ */ -- ----------------------------------------------------------------------------- -- Converting time values to strings. -- | formats calendar times using local conventions. calendarTimeToString :: CalendarTime -> String calendarTimeToString = formatCalendarTime defaultTimeLocale "%c" -- | formats calendar times using local conventions and a formatting string. -- The formatting string is that understood by the ISO C @strftime()@ -- function. formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String formatCalendarTime l fmt (CalendarTime year mon day hour min sec _ wday yday tzname _ _) = doFmt fmt where doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented doFmt ('%':c:cs) = decode c ++ doFmt cs doFmt (c:cs) = c : doFmt cs doFmt "" = "" decode 'A' = fst (wDays l !! fromEnum wday) -- day of the week, full name decode 'a' = snd (wDays l !! fromEnum wday) -- day of the week, abbrev. decode 'B' = fst (months l !! fromEnum mon) -- month, full name decode 'b' = snd (months l !! fromEnum mon) -- month, abbrev decode 'h' = snd (months l !! fromEnum mon) -- ditto decode 'C' = show2 (year `quot` 100) -- century decode 'c' = doFmt (dateTimeFmt l) -- locale's data and time format. decode 'D' = doFmt "%m/%d/%y" decode 'd' = show2 day -- day of the month decode 'e' = show2' day -- ditto, padded decode 'H' = show2 hour -- hours, 24-hour clock, padded decode 'I' = show2 (to12 hour) -- hours, 12-hour clock decode 'j' = show3 yday -- day of the year decode 'k' = show2' hour -- hours, 24-hour clock, no padding decode 'l' = show2' (to12 hour) -- hours, 12-hour clock, no padding decode 'M' = show2 min -- minutes decode 'm' = show2 (fromEnum mon+1) -- numeric month decode 'n' = "\n" decode 'p' = (if hour < 12 then fst else snd) (amPm l) -- am or pm decode 'R' = doFmt "%H:%M" decode 'r' = doFmt (time12Fmt l) decode 'T' = doFmt "%H:%M:%S" decode 't' = "\t" decode 'S' = show2 sec -- seconds decode 's' = show2 sec -- number of secs since Epoch. (ToDo.) decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) -- week number, starting on Sunday. decode 'u' = show (let n = fromEnum wday in -- numeric day of the week (1=Monday, 7=Sunday) if n == 0 then 7 else n) decode 'V' = -- week number (as per ISO-8601.) let (week, days) = -- [yep, I've always wanted to be able to display that too.] (yday + 7 - if fromEnum wday > 0 then fromEnum wday - 1 else 6) `divMod` 7 in show2 (if days >= 4 then week+1 else if week == 0 then 53 else week) decode 'W' = -- week number, weeks starting on monday show2 ((yday + 7 - if fromEnum wday > 0 then fromEnum wday - 1 else 6) `div` 7) decode 'w' = show (fromEnum wday) -- numeric day of the week, weeks starting on Sunday. decode 'X' = doFmt (timeFmt l) -- locale's preferred way of printing time. decode 'x' = doFmt (dateFmt l) -- locale's preferred way of printing dates. decode 'Y' = show year -- year, including century. decode 'y' = show2 (year `rem` 100) -- year, within century. decode 'Z' = tzname -- timezone name decode '%' = "%" decode c = [c] show2, show2', show3 :: Int -> String show2 x | x' < 10 = '0': show x' | otherwise = show x' where x' = x `rem` 100 show2' x | x' < 10 = ' ': show x' | otherwise = show x' where x' = x `rem` 100 show3 x = show (x `quot` 100) ++ show2 (x `rem` 100) to12 :: Int -> Int to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h' -- Useful extensions for formatting TimeDiffs. -- | formats time differences using local conventions. timeDiffToString :: TimeDiff -> String timeDiffToString = formatTimeDiff defaultTimeLocale "%c" -- | formats time differences using local conventions and a formatting string. -- The formatting string is that understood by the ISO C @strftime()@ -- function. formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _) = doFmt fmt where doFmt "" = "" doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented doFmt ('%':c:cs) = decode c ++ doFmt cs doFmt (c:cs) = c : doFmt cs decode spec = case spec of 'B' -> fst (months l !! fromEnum month) 'b' -> snd (months l !! fromEnum month) 'h' -> snd (months l !! fromEnum month) 'c' -> defaultTimeDiffFmt td 'C' -> show2 (year `quot` 100) 'D' -> doFmt "%m/%d/%y" 'd' -> show2 day 'e' -> show2' day 'H' -> show2 hour 'I' -> show2 (to12 hour) 'k' -> show2' hour 'l' -> show2' (to12 hour) 'M' -> show2 min 'm' -> show2 (fromEnum month + 1) 'n' -> "\n" 'p' -> (if hour < 12 then fst else snd) (amPm l) 'R' -> doFmt "%H:%M" 'r' -> doFmt (time12Fmt l) 'T' -> doFmt "%H:%M:%S" 't' -> "\t" 'S' -> show2 sec 's' -> show2 sec -- Implementation-dependent, sez the lib doc.. 'X' -> doFmt (timeFmt l) 'x' -> doFmt (dateFmt l) 'Y' -> show year 'y' -> show2 (year `rem` 100) '%' -> "%" c -> [c] defaultTimeDiffFmt (TimeDiff year month day hour min sec _) = foldr (\ (v,s) rest -> (if v /= 0 then show v ++ ' ':(addS v s) ++ if null rest then "" else ", " else "") ++ rest ) "" (zip [year, month, day, hour, min, sec] (intervals l)) addS v s = if abs v == 1 then fst s else snd s #ifndef __HUGS__ -- ----------------------------------------------------------------------------- -- Foreign time interface (POSIX) type CTm = () -- struct tm #if HAVE_LOCALTIME_R foreign import ccall unsafe "time.h localtime_r" localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else foreign import ccall unsafe "time.h localtime" localtime :: Ptr CTime -> IO (Ptr CTm) #endif #if HAVE_GMTIME_R foreign import ccall unsafe "time.h gmtime_r" gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else foreign import ccall unsafe "time.h gmtime" gmtime :: Ptr CTime -> IO (Ptr CTm) #endif foreign import ccall unsafe "time.h mktime" mktime :: Ptr CTm -> IO CTime #if HAVE_GETTIMEOFDAY type CTimeVal = () foreign import ccall unsafe "time.h gettimeofday" gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt #elif HAVE_FTIME type CTimeB = () #ifndef mingw32_HOST_OS foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO CInt #else foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO () #endif #else foreign import ccall unsafe "time.h time" time :: Ptr CTime -> IO CTime #endif #endif /* ! __HUGS__ */ hugs98-plus-Sep2006/packages/base/Numeric.hs0000644006511100651110000001634510504340221017411 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Numeric -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Odds and ends, mostly functions for reading and showing -- 'RealFloat'-like kind of values. -- ----------------------------------------------------------------------------- module Numeric ( -- * Showing showSigned, -- :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS showIntAtBase, -- :: Integral a => a -> (a -> Char) -> a -> ShowS showInt, -- :: Integral a => a -> ShowS showHex, -- :: Integral a => a -> ShowS showOct, -- :: Integral a => a -> ShowS showEFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS showFFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS showGFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS showFloat, -- :: (RealFloat a) => a -> ShowS floatToDigits, -- :: (RealFloat a) => Integer -> a -> ([Int], Int) -- * Reading -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase', -- and 'readDec' is the \`dual\' of 'showInt'. -- The inconsistent naming is a historical accident. readSigned, -- :: (Real a) => ReadS a -> ReadS a readInt, -- :: (Integral a) => a -> (Char -> Bool) -- -> (Char -> Int) -> ReadS a readDec, -- :: (Integral a) => ReadS a readOct, -- :: (Integral a) => ReadS a readHex, -- :: (Integral a) => ReadS a readFloat, -- :: (RealFloat a) => ReadS a lexDigits, -- :: ReadS String -- * Miscellaneous fromRat, -- :: (RealFloat a) => Rational -> a ) where #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Read import GHC.Real import GHC.Float import GHC.Num import GHC.Show import Data.Maybe import Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail ) import qualified Text.Read.Lex as L #else import Data.Char #endif #ifdef __HUGS__ import Hugs.Prelude import Hugs.Numeric #endif #ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- Reading -- | Reads an /unsigned/ 'Integral' value in an arbitrary base. readInt :: Num a => a -- ^ the base -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int' -> ReadS a readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit) -- | Read an unsigned number in octal notation. readOct :: Num a => ReadS a readOct = readP_to_S L.readOctP -- | Read an unsigned number in decimal notation. readDec :: Num a => ReadS a readDec = readP_to_S L.readDecP -- | Read an unsigned number in hexadecimal notation. -- Both upper or lower case letters are allowed. readHex :: Num a => ReadS a readHex = readP_to_S L.readHexP -- | Reads an /unsigned/ 'RealFrac' value, -- expressed in decimal scientific notation. readFloat :: RealFrac a => ReadS a readFloat = readP_to_S readFloatP readFloatP :: RealFrac a => ReadP a readFloatP = do tok <- L.lex case tok of L.Rat y -> return (fromRational y) L.Int i -> return (fromInteger i) other -> pfail -- It's turgid to have readSigned work using list comprehensions, -- but it's specified as a ReadS to ReadS transformer -- With a bit of luck no one will use it. -- | Reads a /signed/ 'Real' value, given a reader for an unsigned value. readSigned :: (Real a) => ReadS a -> ReadS a readSigned readPos = readParen False read' where read' r = read'' r ++ (do ("-",s) <- lex r (x,t) <- read'' s return (-x,t)) read'' r = do (str,s) <- lex r (n,"") <- readPos str return (n,s) -- ----------------------------------------------------------------------------- -- Showing -- | Show /non-negative/ 'Integral' numbers in base 10. showInt :: Integral a => a -> ShowS showInt n cs | n < 0 = error "Numeric.showInt: can't show negative numbers" | otherwise = go n cs where go n cs | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of c@(C# _) -> c:cs | otherwise = case unsafeChr (ord '0' + fromIntegral r) of c@(C# _) -> go q (c:cs) where (q,r) = n `quotRem` 10 -- Controlling the format and precision of floats. The code that -- implements the formatting itself is in @PrelNum@ to avoid -- mutual module deps. {-# SPECIALIZE showEFloat :: Maybe Int -> Float -> ShowS, Maybe Int -> Double -> ShowS #-} {-# SPECIALIZE showFFloat :: Maybe Int -> Float -> ShowS, Maybe Int -> Double -> ShowS #-} {-# SPECIALIZE showGFloat :: Maybe Int -> Float -> ShowS, Maybe Int -> Double -> ShowS #-} -- | Show a signed 'RealFloat' value -- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@). -- -- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing', -- the value is shown to full precision; if @digs@ is @'Just' d@, -- then at most @d@ digits after the decimal point are shown. showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS -- | Show a signed 'RealFloat' value -- using standard decimal notation (e.g. @245000@, @0.0015@). -- -- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing', -- the value is shown to full precision; if @digs@ is @'Just' d@, -- then at most @d@ digits after the decimal point are shown. showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS -- | Show a signed 'RealFloat' value -- using standard decimal notation for arguments whose absolute value lies -- between @0.1@ and @9,999,999@, and scientific notation otherwise. -- -- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing', -- the value is shown to full precision; if @digs@ is @'Just' d@, -- then at most @d@ digits after the decimal point are shown. showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS showEFloat d x = showString (formatRealFloat FFExponent d x) showFFloat d x = showString (formatRealFloat FFFixed d x) showGFloat d x = showString (formatRealFloat FFGeneric d x) #endif /* __GLASGOW_HASKELL__ */ -- --------------------------------------------------------------------------- -- Integer printing functions -- | Shows a /non-negative/ 'Integral' number using the base specified by the -- first argument, and the character representation specified by the second. showIntAtBase :: Integral a => a -> (Int -> Char) -> a -> ShowS showIntAtBase base toChr n r | base <= 1 = error ("Numeric.showIntAtBase: applied to unsupported base " ++ show base) | n < 0 = error ("Numeric.showIntAtBase: applied to negative number " ++ show n) | otherwise = showIt (quotRem n base) r where showIt (n,d) r = seq c $ -- stricter than necessary case n of 0 -> r' _ -> showIt (quotRem n base) r' where c = toChr (fromIntegral d) r' = c : r -- | Show /non-negative/ 'Integral' numbers in base 16. showHex :: Integral a => a -> ShowS showHex = showIntAtBase 16 intToDigit -- | Show /non-negative/ 'Integral' numbers in base 8. showOct :: Integral a => a -> ShowS showOct = showIntAtBase 8 intToDigit hugs98-plus-Sep2006/packages/base/Prelude.hs0000644006511100651110000001224010504340221017375 0ustar rossross{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Prelude -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- The Prelude: a standard module imported by default into all Haskell -- modules. For more documentation, see the Haskell 98 Report -- . -- ----------------------------------------------------------------------------- module Prelude ( -- * Standard types, classes and related functions -- ** Basic data types Bool(False, True), (&&), (||), not, otherwise, Maybe(Nothing, Just), maybe, Either(Left, Right), either, Ordering(LT, EQ, GT), Char, String, -- *** Tuples fst, snd, curry, uncurry, #if defined(__NHC__) []((:), []), -- Not legal Haskell 98; -- ... available through built-in syntax module Data.Tuple, -- Includes tuple types ()(..), -- Not legal Haskell 98 (->), -- ... available through built-in syntax #endif #ifdef __HUGS__ (:), -- Not legal Haskell 98 #endif -- ** Basic type classes Eq((==), (/=)), Ord(compare, (<), (<=), (>=), (>), max, min), Enum(succ, pred, toEnum, fromEnum, enumFrom, enumFromThen, enumFromTo, enumFromThenTo), Bounded(minBound, maxBound), -- ** Numbers -- *** Numeric types Int, Integer, Float, Double, Rational, -- *** Numeric type classes Num((+), (-), (*), negate, abs, signum, fromInteger), Real(toRational), Integral(quot, rem, div, mod, quotRem, divMod, toInteger), Fractional((/), recip, fromRational), Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh), RealFrac(properFraction, truncate, round, ceiling, floor), RealFloat(floatRadix, floatDigits, floatRange, decodeFloat, encodeFloat, exponent, significand, scaleFloat, isNaN, isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2), -- *** Numeric functions subtract, even, odd, gcd, lcm, (^), (^^), fromIntegral, realToFrac, -- ** Monads and functors Monad((>>=), (>>), return, fail), Functor(fmap), mapM, mapM_, sequence, sequence_, (=<<), -- ** Miscellaneous functions id, const, (.), flip, ($), until, asTypeOf, error, undefined, seq, ($!), -- * List operations map, (++), filter, head, last, tail, init, null, length, (!!), reverse, -- ** Reducing lists (folds) foldl, foldl1, foldr, foldr1, -- *** Special folds and, or, any, all, sum, product, concat, concatMap, maximum, minimum, -- ** Building lists -- *** Scans scanl, scanl1, scanr, scanr1, -- *** Infinite lists iterate, repeat, replicate, cycle, -- ** Sublists take, drop, splitAt, takeWhile, dropWhile, span, break, -- ** Searching lists elem, notElem, lookup, -- ** Zipping and unzipping lists zip, zip3, zipWith, zipWith3, unzip, unzip3, -- ** Functions on strings lines, words, unlines, unwords, -- * Converting to and from @String@ -- ** Converting to @String@ ShowS, Show(showsPrec, showList, show), shows, showChar, showString, showParen, -- ** Converting from @String@ ReadS, Read(readsPrec, readList), reads, readParen, read, lex, -- * Basic Input and output IO, -- ** Simple I\/O operations -- All I/O functions defined here are character oriented. The -- treatment of the newline character will vary on different systems. -- For example, two characters of input, return and linefeed, may -- read as a single newline character. These functions cannot be -- used portably for binary I/O. -- *** Output functions putChar, putStr, putStrLn, print, -- *** Input functions getChar, getLine, getContents, interact, -- *** Files FilePath, readFile, writeFile, appendFile, readIO, readLn, -- ** Exception handling in the I\/O monad IOError, ioError, userError, catch ) where #ifndef __HUGS__ import Control.Monad import System.IO import Text.Read import Text.Show import Data.List import Data.Either import Data.Maybe import Data.Bool import Data.Tuple import Data.Eq import Data.Ord #endif #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.IOBase import GHC.Exception import GHC.Read import GHC.Enum import GHC.Num import GHC.Real import GHC.Float import GHC.Show import GHC.Err ( error, undefined ) #endif #ifdef __HUGS__ import Hugs.Prelude #endif #ifndef __HUGS__ infixr 0 $! -- ----------------------------------------------------------------------------- -- Miscellaneous functions -- | Strict (call-by-value) application, defined in terms of 'seq'. ($!) :: (a -> b) -> a -> b f $! x = x `seq` f x #endif #ifdef __HADDOCK__ -- | The value of @'seq' a b@ is bottom if @a@ is bottom, and otherwise -- equal to @b@. 'seq' is usually introduced to improve performance by -- avoiding unneeded laziness. seq :: a -> b -> b seq _ y = y #endif hugs98-plus-Sep2006/packages/base/cbits/0000755006511100651110000000000010504340226016553 5ustar rossrosshugs98-plus-Sep2006/packages/base/cbits/consUtils.c0000644006511100651110000000365310504340225020710 0ustar rossross/* * (c) The University of Glasgow 2002 * * Win32 Console API support */ #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) || defined(__CYGWIN__) /* to the end */ #include "consUtils.h" #include #include #if defined(__CYGWIN__) #define _get_osfhandle get_osfhandle #endif int set_console_buffering__(int fd, int cooked) { HANDLE h; DWORD st; /* According to GetConsoleMode() docs, it is not possible to leave ECHO_INPUT enabled without also having LINE_INPUT, so we have to turn both off here. */ DWORD flgs = ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT; if ( (h = (HANDLE)_get_osfhandle(fd)) != INVALID_HANDLE_VALUE ) { if ( GetConsoleMode(h,&st) && SetConsoleMode(h, cooked ? (st | ENABLE_LINE_INPUT) : st & ~flgs) ) { return 0; } } return -1; } int set_console_echo__(int fd, int on) { HANDLE h; DWORD st; DWORD flgs = ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT; if ( (h = (HANDLE)_get_osfhandle(fd)) != INVALID_HANDLE_VALUE ) { if ( GetConsoleMode(h,&st) && SetConsoleMode(h,( on ? (st | flgs) : (st & ~ENABLE_ECHO_INPUT))) ) { return 0; } } return -1; } int get_console_echo__(int fd) { HANDLE h; DWORD st; if ( (h = (HANDLE)_get_osfhandle(fd)) != INVALID_HANDLE_VALUE ) { if ( GetConsoleMode(h,&st) ) { return (st & ENABLE_ECHO_INPUT ? 1 : 0); } } return -1; } int flush_input_console__(int fd) { HANDLE h = (HANDLE)_get_osfhandle(fd); if ( h != INVALID_HANDLE_VALUE ) { /* If the 'fd' isn't connected to a console; treat the flush * operation as a NOP. */ DWORD unused; if ( !GetConsoleMode(h,&unused) && GetLastError() == ERROR_INVALID_HANDLE ) { return 0; } if ( FlushConsoleInputBuffer(h) ) { return 0; } } /* ToDo: translate GetLastError() into something errno-friendly */ return -1; } #endif /* defined(__MINGW32__) || ... */ hugs98-plus-Sep2006/packages/base/cbits/Makefile0000644006511100651110000000063310504340226020215 0ustar rossross# $Id: Makefile,v 1.14 2005/02/01 00:52:22 ross Exp $ TOP = ../.. include $(TOP)/mk/boilerplate.mk HC = $(GHC_INPLACE) UseGhcForCc = YES ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32" EXCLUDED_SRCS += consUtils.c endif SRC_CC_OPTS += -Wall -DCOMPILING_STDLIB SRC_CC_OPTS += -I$(GHC_INCLUDE_DIR) -I$(GHC_RTS_DIR) -I../include LIBRARY = libHSbase_cbits.a LIBOBJS = $(C_OBJS) include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/base/cbits/WCsubst.c0000644006511100651110000021644310504340221020316 0ustar rossross/*------------------------------------------------------------------------- This is an automatically generated file: do not edit Generated by udconfc at Mon Jan 31 23:37:36 EST 2005 -------------------------------------------------------------------------*/ #include "WCsubst.h" /* Unicode general categories, listed in the same order as in the Unicode * standard -- this must be the same order as in GHC.Unicode. */ enum { NUMCAT_LU, /* Letter, Uppercase */ NUMCAT_LL, /* Letter, Lowercase */ NUMCAT_LT, /* Letter, Titlecase */ NUMCAT_LM, /* Letter, Modifier */ NUMCAT_LO, /* Letter, Other */ NUMCAT_MN, /* Mark, Non-Spacing */ NUMCAT_MC, /* Mark, Spacing Combining */ NUMCAT_ME, /* Mark, Enclosing */ NUMCAT_ND, /* Number, Decimal */ NUMCAT_NL, /* Number, Letter */ NUMCAT_NO, /* Number, Other */ NUMCAT_PC, /* Punctuation, Connector */ NUMCAT_PD, /* Punctuation, Dash */ NUMCAT_PS, /* Punctuation, Open */ NUMCAT_PE, /* Punctuation, Close */ NUMCAT_PI, /* Punctuation, Initial quote */ NUMCAT_PF, /* Punctuation, Final quote */ NUMCAT_PO, /* Punctuation, Other */ NUMCAT_SM, /* Symbol, Math */ NUMCAT_SC, /* Symbol, Currency */ NUMCAT_SK, /* Symbol, Modifier */ NUMCAT_SO, /* Symbol, Other */ NUMCAT_ZS, /* Separator, Space */ NUMCAT_ZL, /* Separator, Line */ NUMCAT_ZP, /* Separator, Paragraph */ NUMCAT_CC, /* Other, Control */ NUMCAT_CF, /* Other, Format */ NUMCAT_CS, /* Other, Surrogate */ NUMCAT_CO, /* Other, Private Use */ NUMCAT_CN /* Other, Not Assigned */ }; struct _convrule_ { unsigned int category; unsigned int catnumber; int possible; int updist; int lowdist; int titledist; }; struct _charblock_ { int start; int length; const struct _convrule_ *rule; }; #define GENCAT_ZP 67108864 #define GENCAT_MC 8388608 #define GENCAT_NO 65536 #define GENCAT_SK 1024 #define GENCAT_CO 268435456 #define GENCAT_ME 4194304 #define GENCAT_ND 256 #define GENCAT_PO 4 #define GENCAT_LT 524288 #define GENCAT_PC 2048 #define GENCAT_SM 64 #define GENCAT_ZS 2 #define GENCAT_CC 1 #define GENCAT_LU 512 #define GENCAT_PD 128 #define GENCAT_SO 8192 #define GENCAT_PE 32 #define GENCAT_CS 134217728 #define GENCAT_PF 131072 #define GENCAT_CF 32768 #define GENCAT_PS 16 #define GENCAT_SC 8 #define GENCAT_LL 4096 #define GENCAT_ZL 33554432 #define GENCAT_LM 1048576 #define GENCAT_PI 16384 #define GENCAT_NL 16777216 #define GENCAT_MN 2097152 #define GENCAT_LO 262144 #define MAX_UNI_CHAR 1114109 #define NUM_BLOCKS 1916 #define NUM_CONVBLOCKS 835 #define NUM_SPACEBLOCKS 8 #define NUM_LAT1BLOCKS 63 #define NUM_RULES 126 static const struct _convrule_ rule116={GENCAT_LU, NUMCAT_LU, 1, 0, -8383, 0}; static const struct _convrule_ rule108={GENCAT_LU, NUMCAT_LU, 1, 0, -86, 0}; static const struct _convrule_ rule88={GENCAT_LU, NUMCAT_LU, 1, 0, 80, 0}; static const struct _convrule_ rule86={GENCAT_LL, NUMCAT_LL, 1, -96, 0, -96}; static const struct _convrule_ rule79={GENCAT_LU, NUMCAT_LU, 0, 0, 0, 0}; static const struct _convrule_ rule56={GENCAT_LL, NUMCAT_LL, 1, -203, 0, -203}; static const struct _convrule_ rule54={GENCAT_LL, NUMCAT_LL, 1, -205, 0, -205}; static const struct _convrule_ rule48={GENCAT_LL, NUMCAT_LL, 1, -79, 0, -79}; static const struct _convrule_ rule40={GENCAT_LU, NUMCAT_LU, 1, 0, 218, 0}; static const struct _convrule_ rule113={GENCAT_ZL, NUMCAT_ZL, 0, 0, 0, 0}; static const struct _convrule_ rule103={GENCAT_LT, NUMCAT_LT, 1, 0, -8, 0}; static const struct _convrule_ rule98={GENCAT_LL, NUMCAT_LL, 1, 86, 0, 86}; static const struct _convrule_ rule95={GENCAT_LL, NUMCAT_LL, 1, 8, 0, 8}; static const struct _convrule_ rule39={GENCAT_LU, NUMCAT_LU, 1, 0, 214, 0}; static const struct _convrule_ rule119={GENCAT_NL, NUMCAT_NL, 1, -16, 0, -16}; static const struct _convrule_ rule101={GENCAT_LL, NUMCAT_LL, 1, 112, 0, 112}; static const struct _convrule_ rule93={GENCAT_NL, NUMCAT_NL, 0, 0, 0, 0}; static const struct _convrule_ rule60={GENCAT_LL, NUMCAT_LL, 1, -213, 0, -213}; static const struct _convrule_ rule59={GENCAT_LL, NUMCAT_LL, 1, -211, 0, -211}; static const struct _convrule_ rule42={GENCAT_LU, NUMCAT_LU, 1, 0, 219, 0}; static const struct _convrule_ rule38={GENCAT_LL, NUMCAT_LL, 1, 130, 0, 130}; static const struct _convrule_ rule34={GENCAT_LL, NUMCAT_LL, 1, 97, 0, 97}; static const struct _convrule_ rule25={GENCAT_LU, NUMCAT_LU, 1, 0, -121, 0}; static const struct _convrule_ rule24={GENCAT_LL, NUMCAT_LL, 1, -232, 0, -232}; static const struct _convrule_ rule20={GENCAT_LL, NUMCAT_LL, 1, 121, 0, 121}; static const struct _convrule_ rule16={GENCAT_CF, NUMCAT_CF, 0, 0, 0, 0}; static const struct _convrule_ rule4={GENCAT_PS, NUMCAT_PS, 0, 0, 0, 0}; static const struct _convrule_ rule123={GENCAT_CO, NUMCAT_CO, 0, 0, 0, 0}; static const struct _convrule_ rule112={GENCAT_LU, NUMCAT_LU, 1, 0, -126, 0}; static const struct _convrule_ rule106={GENCAT_LT, NUMCAT_LT, 1, 0, -9, 0}; static const struct _convrule_ rule105={GENCAT_LU, NUMCAT_LU, 1, 0, -74, 0}; static const struct _convrule_ rule97={GENCAT_LL, NUMCAT_LL, 1, 74, 0, 74}; static const struct _convrule_ rule65={GENCAT_LM, NUMCAT_LM, 0, 0, 0, 0}; static const struct _convrule_ rule30={GENCAT_LU, NUMCAT_LU, 1, 0, 79, 0}; static const struct _convrule_ rule5={GENCAT_PE, NUMCAT_PE, 0, 0, 0, 0}; static const struct _convrule_ rule114={GENCAT_ZP, NUMCAT_ZP, 0, 0, 0, 0}; static const struct _convrule_ rule104={GENCAT_LL, NUMCAT_LL, 1, 9, 0, 9}; static const struct _convrule_ rule94={GENCAT_LL, NUMCAT_LL, 1, -59, 0, -59}; static const struct _convrule_ rule92={GENCAT_MC, NUMCAT_MC, 0, 0, 0, 0}; static const struct _convrule_ rule91={GENCAT_LL, NUMCAT_LL, 1, -48, 0, -48}; static const struct _convrule_ rule82={GENCAT_LL, NUMCAT_LL, 1, -86, 0, -86}; static const struct _convrule_ rule78={GENCAT_LL, NUMCAT_LL, 1, -57, 0, -57}; static const struct _convrule_ rule66={GENCAT_MN, NUMCAT_MN, 0, 0, 0, 0}; static const struct _convrule_ rule55={GENCAT_LL, NUMCAT_LL, 1, -202, 0, -202}; static const struct _convrule_ rule50={GENCAT_LU, NUMCAT_LU, 1, 0, -56, 0}; static const struct _convrule_ rule45={GENCAT_LU, NUMCAT_LU, 1, 0, 2, 1}; static const struct _convrule_ rule31={GENCAT_LU, NUMCAT_LU, 1, 0, 202, 0}; static const struct _convrule_ rule6={GENCAT_SM, NUMCAT_SM, 0, 0, 0, 0}; static const struct _convrule_ rule107={GENCAT_LL, NUMCAT_LL, 1, -7205, 0, -7205}; static const struct _convrule_ rule90={GENCAT_LU, NUMCAT_LU, 1, 0, 48, 0}; static const struct _convrule_ rule87={GENCAT_LU, NUMCAT_LU, 1, 0, -7, 0}; static const struct _convrule_ rule44={GENCAT_LL, NUMCAT_LL, 1, 56, 0, 56}; static const struct _convrule_ rule33={GENCAT_LU, NUMCAT_LU, 1, 0, 207, 0}; static const struct _convrule_ rule18={GENCAT_LL, NUMCAT_LL, 1, 743, 0, 743}; static const struct _convrule_ rule17={GENCAT_NO, NUMCAT_NO, 0, 0, 0, 0}; static const struct _convrule_ rule10={GENCAT_SK, NUMCAT_SK, 0, 0, 0, 0}; static const struct _convrule_ rule8={GENCAT_ND, NUMCAT_ND, 0, 0, 0, 0}; static const struct _convrule_ rule122={GENCAT_CS, NUMCAT_CS, 0, 0, 0, 0}; static const struct _convrule_ rule99={GENCAT_LL, NUMCAT_LL, 1, 100, 0, 100}; static const struct _convrule_ rule67={GENCAT_MN, NUMCAT_MN, 1, 84, 0, 84}; static const struct _convrule_ rule52={GENCAT_LL, NUMCAT_LL, 1, -210, 0, -210}; static const struct _convrule_ rule51={GENCAT_LU, NUMCAT_LU, 1, 0, -130, 0}; static const struct _convrule_ rule32={GENCAT_LU, NUMCAT_LU, 1, 0, 203, 0}; static const struct _convrule_ rule27={GENCAT_LU, NUMCAT_LU, 1, 0, 210, 0}; static const struct _convrule_ rule15={GENCAT_PI, NUMCAT_PI, 0, 0, 0, 0}; static const struct _convrule_ rule111={GENCAT_LU, NUMCAT_LU, 1, 0, -128, 0}; static const struct _convrule_ rule96={GENCAT_LU, NUMCAT_LU, 1, 0, -8, 0}; static const struct _convrule_ rule71={GENCAT_LU, NUMCAT_LU, 1, 0, 63, 0}; static const struct _convrule_ rule64={GENCAT_LL, NUMCAT_LL, 1, -219, 0, -219}; static const struct _convrule_ rule62={GENCAT_LL, NUMCAT_LL, 1, -218, 0, -218}; static const struct _convrule_ rule23={GENCAT_LU, NUMCAT_LU, 1, 0, -199, 0}; static const struct _convrule_ rule19={GENCAT_PF, NUMCAT_PF, 0, 0, 0, 0}; static const struct _convrule_ rule1={GENCAT_ZS, NUMCAT_ZS, 0, 0, 0, 0}; static const struct _convrule_ rule120={GENCAT_SO, NUMCAT_SO, 1, 0, 26, 0}; static const struct _convrule_ rule115={GENCAT_LU, NUMCAT_LU, 1, 0, -7517, 0}; static const struct _convrule_ rule83={GENCAT_LL, NUMCAT_LL, 1, -80, 0, -80}; static const struct _convrule_ rule81={GENCAT_LL, NUMCAT_LL, 1, -54, 0, -54}; static const struct _convrule_ rule80={GENCAT_LL, NUMCAT_LL, 1, -47, 0, -47}; static const struct _convrule_ rule77={GENCAT_LL, NUMCAT_LL, 1, -62, 0, -62}; static const struct _convrule_ rule76={GENCAT_LL, NUMCAT_LL, 1, -63, 0, -63}; static const struct _convrule_ rule75={GENCAT_LL, NUMCAT_LL, 1, -64, 0, -64}; static const struct _convrule_ rule73={GENCAT_LL, NUMCAT_LL, 1, -37, 0, -37}; static const struct _convrule_ rule72={GENCAT_LL, NUMCAT_LL, 1, -38, 0, -38}; static const struct _convrule_ rule35={GENCAT_LU, NUMCAT_LU, 1, 0, 211, 0}; static const struct _convrule_ rule14={GENCAT_LL, NUMCAT_LL, 0, 0, 0, 0}; static const struct _convrule_ rule11={GENCAT_PC, NUMCAT_PC, 0, 0, 0, 0}; static const struct _convrule_ rule3={GENCAT_SC, NUMCAT_SC, 0, 0, 0, 0}; static const struct _convrule_ rule2={GENCAT_PO, NUMCAT_PO, 0, 0, 0, 0}; static const struct _convrule_ rule70={GENCAT_LU, NUMCAT_LU, 1, 0, 64, 0}; static const struct _convrule_ rule58={GENCAT_LL, NUMCAT_LL, 1, -209, 0, -209}; static const struct _convrule_ rule57={GENCAT_LL, NUMCAT_LL, 1, -207, 0, -207}; static const struct _convrule_ rule53={GENCAT_LL, NUMCAT_LL, 1, -206, 0, -206}; static const struct _convrule_ rule46={GENCAT_LT, NUMCAT_LT, 1, -1, 1, 0}; static const struct _convrule_ rule36={GENCAT_LU, NUMCAT_LU, 1, 0, 209, 0}; static const struct _convrule_ rule26={GENCAT_LL, NUMCAT_LL, 1, -300, 0, -300}; static const struct _convrule_ rule9={GENCAT_LU, NUMCAT_LU, 1, 0, 32, 0}; static const struct _convrule_ rule121={GENCAT_SO, NUMCAT_SO, 1, -26, 0, -26}; static const struct _convrule_ rule117={GENCAT_LU, NUMCAT_LU, 1, 0, -8262, 0}; static const struct _convrule_ rule109={GENCAT_LU, NUMCAT_LU, 1, 0, -100, 0}; static const struct _convrule_ rule69={GENCAT_LU, NUMCAT_LU, 1, 0, 37, 0}; static const struct _convrule_ rule29={GENCAT_LU, NUMCAT_LU, 1, 0, 205, 0}; static const struct _convrule_ rule21={GENCAT_LU, NUMCAT_LU, 1, 0, 1, 0}; static const struct _convrule_ rule124={GENCAT_LU, NUMCAT_LU, 1, 0, 40, 0}; static const struct _convrule_ rule110={GENCAT_LU, NUMCAT_LU, 1, 0, -112, 0}; static const struct _convrule_ rule102={GENCAT_LL, NUMCAT_LL, 1, 126, 0, 126}; static const struct _convrule_ rule100={GENCAT_LL, NUMCAT_LL, 1, 128, 0, 128}; static const struct _convrule_ rule85={GENCAT_LU, NUMCAT_LU, 1, 0, -60, 0}; static const struct _convrule_ rule84={GENCAT_LL, NUMCAT_LL, 1, 7, 0, 7}; static const struct _convrule_ rule63={GENCAT_LL, NUMCAT_LL, 1, -217, 0, -217}; static const struct _convrule_ rule61={GENCAT_LL, NUMCAT_LL, 1, -214, 0, -214}; static const struct _convrule_ rule43={GENCAT_LO, NUMCAT_LO, 0, 0, 0, 0}; static const struct _convrule_ rule41={GENCAT_LU, NUMCAT_LU, 1, 0, 217, 0}; static const struct _convrule_ rule125={GENCAT_LL, NUMCAT_LL, 1, -40, 0, -40}; static const struct _convrule_ rule118={GENCAT_NL, NUMCAT_NL, 1, 0, 16, 0}; static const struct _convrule_ rule89={GENCAT_ME, NUMCAT_ME, 0, 0, 0, 0}; static const struct _convrule_ rule74={GENCAT_LL, NUMCAT_LL, 1, -31, 0, -31}; static const struct _convrule_ rule68={GENCAT_LU, NUMCAT_LU, 1, 0, 38, 0}; static const struct _convrule_ rule49={GENCAT_LU, NUMCAT_LU, 1, 0, -97, 0}; static const struct _convrule_ rule47={GENCAT_LL, NUMCAT_LL, 1, -2, 0, -1}; static const struct _convrule_ rule37={GENCAT_LU, NUMCAT_LU, 1, 0, 213, 0}; static const struct _convrule_ rule28={GENCAT_LU, NUMCAT_LU, 1, 0, 206, 0}; static const struct _convrule_ rule22={GENCAT_LL, NUMCAT_LL, 1, -1, 0, -1}; static const struct _convrule_ rule13={GENCAT_SO, NUMCAT_SO, 0, 0, 0, 0}; static const struct _convrule_ rule12={GENCAT_LL, NUMCAT_LL, 1, -32, 0, -32}; static const struct _convrule_ rule7={GENCAT_PD, NUMCAT_PD, 0, 0, 0, 0}; static const struct _convrule_ rule0={GENCAT_CC, NUMCAT_CC, 0, 0, 0, 0}; static const struct _charblock_ allchars[]={ {0, 32, &rule0}, {32, 1, &rule1}, {33, 3, &rule2}, {36, 1, &rule3}, {37, 3, &rule2}, {40, 1, &rule4}, {41, 1, &rule5}, {42, 1, &rule2}, {43, 1, &rule6}, {44, 1, &rule2}, {45, 1, &rule7}, {46, 2, &rule2}, {48, 10, &rule8}, {58, 2, &rule2}, {60, 3, &rule6}, {63, 2, &rule2}, {65, 26, &rule9}, {91, 1, &rule4}, {92, 1, &rule2}, {93, 1, &rule5}, {94, 1, &rule10}, {95, 1, &rule11}, {96, 1, &rule10}, {97, 26, &rule12}, {123, 1, &rule4}, {124, 1, &rule6}, {125, 1, &rule5}, {126, 1, &rule6}, {127, 33, &rule0}, {160, 1, &rule1}, {161, 1, &rule2}, {162, 4, &rule3}, {166, 2, &rule13}, {168, 1, &rule10}, {169, 1, &rule13}, {170, 1, &rule14}, {171, 1, &rule15}, {172, 1, &rule6}, {173, 1, &rule16}, {174, 1, &rule13}, {175, 1, &rule10}, {176, 1, &rule13}, {177, 1, &rule6}, {178, 2, &rule17}, {180, 1, &rule10}, {181, 1, &rule18}, {182, 1, &rule13}, {183, 1, &rule2}, {184, 1, &rule10}, {185, 1, &rule17}, {186, 1, &rule14}, {187, 1, &rule19}, {188, 3, &rule17}, {191, 1, &rule2}, {192, 23, &rule9}, {215, 1, &rule6}, {216, 7, &rule9}, {223, 1, &rule14}, {224, 23, &rule12}, {247, 1, &rule6}, {248, 7, &rule12}, {255, 1, &rule20}, {256, 1, &rule21}, {257, 1, &rule22}, {258, 1, &rule21}, {259, 1, &rule22}, {260, 1, &rule21}, {261, 1, &rule22}, {262, 1, &rule21}, {263, 1, &rule22}, {264, 1, &rule21}, {265, 1, &rule22}, {266, 1, &rule21}, {267, 1, &rule22}, {268, 1, &rule21}, {269, 1, &rule22}, {270, 1, &rule21}, {271, 1, &rule22}, {272, 1, &rule21}, {273, 1, &rule22}, {274, 1, &rule21}, {275, 1, &rule22}, {276, 1, &rule21}, {277, 1, &rule22}, {278, 1, &rule21}, {279, 1, &rule22}, {280, 1, &rule21}, {281, 1, &rule22}, {282, 1, &rule21}, {283, 1, &rule22}, {284, 1, &rule21}, {285, 1, &rule22}, {286, 1, &rule21}, {287, 1, &rule22}, {288, 1, &rule21}, {289, 1, &rule22}, {290, 1, &rule21}, {291, 1, &rule22}, {292, 1, &rule21}, {293, 1, &rule22}, {294, 1, &rule21}, {295, 1, &rule22}, {296, 1, &rule21}, {297, 1, &rule22}, {298, 1, &rule21}, {299, 1, &rule22}, {300, 1, &rule21}, {301, 1, &rule22}, {302, 1, &rule21}, {303, 1, &rule22}, {304, 1, &rule23}, {305, 1, &rule24}, {306, 1, &rule21}, {307, 1, &rule22}, {308, 1, &rule21}, {309, 1, &rule22}, {310, 1, &rule21}, {311, 1, &rule22}, {312, 1, &rule14}, {313, 1, &rule21}, {314, 1, &rule22}, {315, 1, &rule21}, {316, 1, &rule22}, {317, 1, &rule21}, {318, 1, &rule22}, {319, 1, &rule21}, {320, 1, &rule22}, {321, 1, &rule21}, {322, 1, &rule22}, {323, 1, &rule21}, {324, 1, &rule22}, {325, 1, &rule21}, {326, 1, &rule22}, {327, 1, &rule21}, {328, 1, &rule22}, {329, 1, &rule14}, {330, 1, &rule21}, {331, 1, &rule22}, {332, 1, &rule21}, {333, 1, &rule22}, {334, 1, &rule21}, {335, 1, &rule22}, {336, 1, &rule21}, {337, 1, &rule22}, {338, 1, &rule21}, {339, 1, &rule22}, {340, 1, &rule21}, {341, 1, &rule22}, {342, 1, &rule21}, {343, 1, &rule22}, {344, 1, &rule21}, {345, 1, &rule22}, {346, 1, &rule21}, {347, 1, &rule22}, {348, 1, &rule21}, {349, 1, &rule22}, {350, 1, &rule21}, {351, 1, &rule22}, {352, 1, &rule21}, {353, 1, &rule22}, {354, 1, &rule21}, {355, 1, &rule22}, {356, 1, &rule21}, {357, 1, &rule22}, {358, 1, &rule21}, {359, 1, &rule22}, {360, 1, &rule21}, {361, 1, &rule22}, {362, 1, &rule21}, {363, 1, &rule22}, {364, 1, &rule21}, {365, 1, &rule22}, {366, 1, &rule21}, {367, 1, &rule22}, {368, 1, &rule21}, {369, 1, &rule22}, {370, 1, &rule21}, {371, 1, &rule22}, {372, 1, &rule21}, {373, 1, &rule22}, {374, 1, &rule21}, {375, 1, &rule22}, {376, 1, &rule25}, {377, 1, &rule21}, {378, 1, &rule22}, {379, 1, &rule21}, {380, 1, &rule22}, {381, 1, &rule21}, {382, 1, &rule22}, {383, 1, &rule26}, {384, 1, &rule14}, {385, 1, &rule27}, {386, 1, &rule21}, {387, 1, &rule22}, {388, 1, &rule21}, {389, 1, &rule22}, {390, 1, &rule28}, {391, 1, &rule21}, {392, 1, &rule22}, {393, 2, &rule29}, {395, 1, &rule21}, {396, 1, &rule22}, {397, 1, &rule14}, {398, 1, &rule30}, {399, 1, &rule31}, {400, 1, &rule32}, {401, 1, &rule21}, {402, 1, &rule22}, {403, 1, &rule29}, {404, 1, &rule33}, {405, 1, &rule34}, {406, 1, &rule35}, {407, 1, &rule36}, {408, 1, &rule21}, {409, 1, &rule22}, {410, 2, &rule14}, {412, 1, &rule35}, {413, 1, &rule37}, {414, 1, &rule38}, {415, 1, &rule39}, {416, 1, &rule21}, {417, 1, &rule22}, {418, 1, &rule21}, {419, 1, &rule22}, {420, 1, &rule21}, {421, 1, &rule22}, {422, 1, &rule40}, {423, 1, &rule21}, {424, 1, &rule22}, {425, 1, &rule40}, {426, 2, &rule14}, {428, 1, &rule21}, {429, 1, &rule22}, {430, 1, &rule40}, {431, 1, &rule21}, {432, 1, &rule22}, {433, 2, &rule41}, {435, 1, &rule21}, {436, 1, &rule22}, {437, 1, &rule21}, {438, 1, &rule22}, {439, 1, &rule42}, {440, 1, &rule21}, {441, 1, &rule22}, {442, 1, &rule14}, {443, 1, &rule43}, {444, 1, &rule21}, {445, 1, &rule22}, {446, 1, &rule14}, {447, 1, &rule44}, {448, 4, &rule43}, {452, 1, &rule45}, {453, 1, &rule46}, {454, 1, &rule47}, {455, 1, &rule45}, {456, 1, &rule46}, {457, 1, &rule47}, {458, 1, &rule45}, {459, 1, &rule46}, {460, 1, &rule47}, {461, 1, &rule21}, {462, 1, &rule22}, {463, 1, &rule21}, {464, 1, &rule22}, {465, 1, &rule21}, {466, 1, &rule22}, {467, 1, &rule21}, {468, 1, &rule22}, {469, 1, &rule21}, {470, 1, &rule22}, {471, 1, &rule21}, {472, 1, &rule22}, {473, 1, &rule21}, {474, 1, &rule22}, {475, 1, &rule21}, {476, 1, &rule22}, {477, 1, &rule48}, {478, 1, &rule21}, {479, 1, &rule22}, {480, 1, &rule21}, {481, 1, &rule22}, {482, 1, &rule21}, {483, 1, &rule22}, {484, 1, &rule21}, {485, 1, &rule22}, {486, 1, &rule21}, {487, 1, &rule22}, {488, 1, &rule21}, {489, 1, &rule22}, {490, 1, &rule21}, {491, 1, &rule22}, {492, 1, &rule21}, {493, 1, &rule22}, {494, 1, &rule21}, {495, 1, &rule22}, {496, 1, &rule14}, {497, 1, &rule45}, {498, 1, &rule46}, {499, 1, &rule47}, {500, 1, &rule21}, {501, 1, &rule22}, {502, 1, &rule49}, {503, 1, &rule50}, {504, 1, &rule21}, {505, 1, &rule22}, {506, 1, &rule21}, {507, 1, &rule22}, {508, 1, &rule21}, {509, 1, &rule22}, {510, 1, &rule21}, {511, 1, &rule22}, {512, 1, &rule21}, {513, 1, &rule22}, {514, 1, &rule21}, {515, 1, &rule22}, {516, 1, &rule21}, {517, 1, &rule22}, {518, 1, &rule21}, {519, 1, &rule22}, {520, 1, &rule21}, {521, 1, &rule22}, {522, 1, &rule21}, {523, 1, &rule22}, {524, 1, &rule21}, {525, 1, &rule22}, {526, 1, &rule21}, {527, 1, &rule22}, {528, 1, &rule21}, {529, 1, &rule22}, {530, 1, &rule21}, {531, 1, &rule22}, {532, 1, &rule21}, {533, 1, &rule22}, {534, 1, &rule21}, {535, 1, &rule22}, {536, 1, &rule21}, {537, 1, &rule22}, {538, 1, &rule21}, {539, 1, &rule22}, {540, 1, &rule21}, {541, 1, &rule22}, {542, 1, &rule21}, {543, 1, &rule22}, {544, 1, &rule51}, {545, 1, &rule14}, {546, 1, &rule21}, {547, 1, &rule22}, {548, 1, &rule21}, {549, 1, &rule22}, {550, 1, &rule21}, {551, 1, &rule22}, {552, 1, &rule21}, {553, 1, &rule22}, {554, 1, &rule21}, {555, 1, &rule22}, {556, 1, &rule21}, {557, 1, &rule22}, {558, 1, &rule21}, {559, 1, &rule22}, {560, 1, &rule21}, {561, 1, &rule22}, {562, 1, &rule21}, {563, 1, &rule22}, {564, 3, &rule14}, {592, 3, &rule14}, {595, 1, &rule52}, {596, 1, &rule53}, {597, 1, &rule14}, {598, 2, &rule54}, {600, 1, &rule14}, {601, 1, &rule55}, {602, 1, &rule14}, {603, 1, &rule56}, {604, 4, &rule14}, {608, 1, &rule54}, {609, 2, &rule14}, {611, 1, &rule57}, {612, 4, &rule14}, {616, 1, &rule58}, {617, 1, &rule59}, {618, 5, &rule14}, {623, 1, &rule59}, {624, 2, &rule14}, {626, 1, &rule60}, {627, 2, &rule14}, {629, 1, &rule61}, {630, 10, &rule14}, {640, 1, &rule62}, {641, 2, &rule14}, {643, 1, &rule62}, {644, 4, &rule14}, {648, 1, &rule62}, {649, 1, &rule14}, {650, 2, &rule63}, {652, 6, &rule14}, {658, 1, &rule64}, {659, 29, &rule14}, {688, 18, &rule65}, {706, 4, &rule10}, {710, 12, &rule65}, {722, 14, &rule10}, {736, 5, &rule65}, {741, 9, &rule10}, {750, 1, &rule65}, {751, 17, &rule10}, {768, 69, &rule66}, {837, 1, &rule67}, {838, 18, &rule66}, {861, 19, &rule66}, {884, 2, &rule10}, {890, 1, &rule65}, {894, 1, &rule2}, {900, 2, &rule10}, {902, 1, &rule68}, {903, 1, &rule2}, {904, 3, &rule69}, {908, 1, &rule70}, {910, 2, &rule71}, {912, 1, &rule14}, {913, 17, &rule9}, {931, 9, &rule9}, {940, 1, &rule72}, {941, 3, &rule73}, {944, 1, &rule14}, {945, 17, &rule12}, {962, 1, &rule74}, {963, 9, &rule12}, {972, 1, &rule75}, {973, 2, &rule76}, {976, 1, &rule77}, {977, 1, &rule78}, {978, 3, &rule79}, {981, 1, &rule80}, {982, 1, &rule81}, {983, 1, &rule14}, {984, 1, &rule21}, {985, 1, &rule22}, {986, 1, &rule21}, {987, 1, &rule22}, {988, 1, &rule21}, {989, 1, &rule22}, {990, 1, &rule21}, {991, 1, &rule22}, {992, 1, &rule21}, {993, 1, &rule22}, {994, 1, &rule21}, {995, 1, &rule22}, {996, 1, &rule21}, {997, 1, &rule22}, {998, 1, &rule21}, {999, 1, &rule22}, {1000, 1, &rule21}, {1001, 1, &rule22}, {1002, 1, &rule21}, {1003, 1, &rule22}, {1004, 1, &rule21}, {1005, 1, &rule22}, {1006, 1, &rule21}, {1007, 1, &rule22}, {1008, 1, &rule82}, {1009, 1, &rule83}, {1010, 1, &rule84}, {1011, 1, &rule14}, {1012, 1, &rule85}, {1013, 1, &rule86}, {1014, 1, &rule6}, {1015, 1, &rule21}, {1016, 1, &rule22}, {1017, 1, &rule87}, {1018, 1, &rule21}, {1019, 1, &rule22}, {1024, 16, &rule88}, {1040, 32, &rule9}, {1072, 32, &rule12}, {1104, 16, &rule83}, {1120, 1, &rule21}, {1121, 1, &rule22}, {1122, 1, &rule21}, {1123, 1, &rule22}, {1124, 1, &rule21}, {1125, 1, &rule22}, {1126, 1, &rule21}, {1127, 1, &rule22}, {1128, 1, &rule21}, {1129, 1, &rule22}, {1130, 1, &rule21}, {1131, 1, &rule22}, {1132, 1, &rule21}, {1133, 1, &rule22}, {1134, 1, &rule21}, {1135, 1, &rule22}, {1136, 1, &rule21}, {1137, 1, &rule22}, {1138, 1, &rule21}, {1139, 1, &rule22}, {1140, 1, &rule21}, {1141, 1, &rule22}, {1142, 1, &rule21}, {1143, 1, &rule22}, {1144, 1, &rule21}, {1145, 1, &rule22}, {1146, 1, &rule21}, {1147, 1, &rule22}, {1148, 1, &rule21}, {1149, 1, &rule22}, {1150, 1, &rule21}, {1151, 1, &rule22}, {1152, 1, &rule21}, {1153, 1, &rule22}, {1154, 1, &rule13}, {1155, 4, &rule66}, {1160, 2, &rule89}, {1162, 1, &rule21}, {1163, 1, &rule22}, {1164, 1, &rule21}, {1165, 1, &rule22}, {1166, 1, &rule21}, {1167, 1, &rule22}, {1168, 1, &rule21}, {1169, 1, &rule22}, {1170, 1, &rule21}, {1171, 1, &rule22}, {1172, 1, &rule21}, {1173, 1, &rule22}, {1174, 1, &rule21}, {1175, 1, &rule22}, {1176, 1, &rule21}, {1177, 1, &rule22}, {1178, 1, &rule21}, {1179, 1, &rule22}, {1180, 1, &rule21}, {1181, 1, &rule22}, {1182, 1, &rule21}, {1183, 1, &rule22}, {1184, 1, &rule21}, {1185, 1, &rule22}, {1186, 1, &rule21}, {1187, 1, &rule22}, {1188, 1, &rule21}, {1189, 1, &rule22}, {1190, 1, &rule21}, {1191, 1, &rule22}, {1192, 1, &rule21}, {1193, 1, &rule22}, {1194, 1, &rule21}, {1195, 1, &rule22}, {1196, 1, &rule21}, {1197, 1, &rule22}, {1198, 1, &rule21}, {1199, 1, &rule22}, {1200, 1, &rule21}, {1201, 1, &rule22}, {1202, 1, &rule21}, {1203, 1, &rule22}, {1204, 1, &rule21}, {1205, 1, &rule22}, {1206, 1, &rule21}, {1207, 1, &rule22}, {1208, 1, &rule21}, {1209, 1, &rule22}, {1210, 1, &rule21}, {1211, 1, &rule22}, {1212, 1, &rule21}, {1213, 1, &rule22}, {1214, 1, &rule21}, {1215, 1, &rule22}, {1216, 1, &rule79}, {1217, 1, &rule21}, {1218, 1, &rule22}, {1219, 1, &rule21}, {1220, 1, &rule22}, {1221, 1, &rule21}, {1222, 1, &rule22}, {1223, 1, &rule21}, {1224, 1, &rule22}, {1225, 1, &rule21}, {1226, 1, &rule22}, {1227, 1, &rule21}, {1228, 1, &rule22}, {1229, 1, &rule21}, {1230, 1, &rule22}, {1232, 1, &rule21}, {1233, 1, &rule22}, {1234, 1, &rule21}, {1235, 1, &rule22}, {1236, 1, &rule21}, {1237, 1, &rule22}, {1238, 1, &rule21}, {1239, 1, &rule22}, {1240, 1, &rule21}, {1241, 1, &rule22}, {1242, 1, &rule21}, {1243, 1, &rule22}, {1244, 1, &rule21}, {1245, 1, &rule22}, {1246, 1, &rule21}, {1247, 1, &rule22}, {1248, 1, &rule21}, {1249, 1, &rule22}, {1250, 1, &rule21}, {1251, 1, &rule22}, {1252, 1, &rule21}, {1253, 1, &rule22}, {1254, 1, &rule21}, {1255, 1, &rule22}, {1256, 1, &rule21}, {1257, 1, &rule22}, {1258, 1, &rule21}, {1259, 1, &rule22}, {1260, 1, &rule21}, {1261, 1, &rule22}, {1262, 1, &rule21}, {1263, 1, &rule22}, {1264, 1, &rule21}, {1265, 1, &rule22}, {1266, 1, &rule21}, {1267, 1, &rule22}, {1268, 1, &rule21}, {1269, 1, &rule22}, {1272, 1, &rule21}, {1273, 1, &rule22}, {1280, 1, &rule21}, {1281, 1, &rule22}, {1282, 1, &rule21}, {1283, 1, &rule22}, {1284, 1, &rule21}, {1285, 1, &rule22}, {1286, 1, &rule21}, {1287, 1, &rule22}, {1288, 1, &rule21}, {1289, 1, &rule22}, {1290, 1, &rule21}, {1291, 1, &rule22}, {1292, 1, &rule21}, {1293, 1, &rule22}, {1294, 1, &rule21}, {1295, 1, &rule22}, {1329, 38, &rule90}, {1369, 1, &rule65}, {1370, 6, &rule2}, {1377, 38, &rule91}, {1415, 1, &rule14}, {1417, 1, &rule2}, {1418, 1, &rule7}, {1425, 17, &rule66}, {1443, 23, &rule66}, {1467, 3, &rule66}, {1470, 1, &rule2}, {1471, 1, &rule66}, {1472, 1, &rule2}, {1473, 2, &rule66}, {1475, 1, &rule2}, {1476, 1, &rule66}, {1488, 27, &rule43}, {1520, 3, &rule43}, {1523, 2, &rule2}, {1536, 4, &rule16}, {1548, 2, &rule2}, {1550, 2, &rule13}, {1552, 6, &rule66}, {1563, 1, &rule2}, {1567, 1, &rule2}, {1569, 26, &rule43}, {1600, 1, &rule65}, {1601, 10, &rule43}, {1611, 14, &rule66}, {1632, 10, &rule8}, {1642, 4, &rule2}, {1646, 2, &rule43}, {1648, 1, &rule66}, {1649, 99, &rule43}, {1748, 1, &rule2}, {1749, 1, &rule43}, {1750, 7, &rule66}, {1757, 1, &rule16}, {1758, 1, &rule89}, {1759, 6, &rule66}, {1765, 2, &rule65}, {1767, 2, &rule66}, {1769, 1, &rule13}, {1770, 4, &rule66}, {1774, 2, &rule43}, {1776, 10, &rule8}, {1786, 3, &rule43}, {1789, 2, &rule13}, {1791, 1, &rule43}, {1792, 14, &rule2}, {1807, 1, &rule16}, {1808, 1, &rule43}, {1809, 1, &rule66}, {1810, 30, &rule43}, {1840, 27, &rule66}, {1869, 3, &rule43}, {1920, 38, &rule43}, {1958, 11, &rule66}, {1969, 1, &rule43}, {2305, 2, &rule66}, {2307, 1, &rule92}, {2308, 54, &rule43}, {2364, 1, &rule66}, {2365, 1, &rule43}, {2366, 3, &rule92}, {2369, 8, &rule66}, {2377, 4, &rule92}, {2381, 1, &rule66}, {2384, 1, &rule43}, {2385, 4, &rule66}, {2392, 10, &rule43}, {2402, 2, &rule66}, {2404, 2, &rule2}, {2406, 10, &rule8}, {2416, 1, &rule2}, {2433, 1, &rule66}, {2434, 2, &rule92}, {2437, 8, &rule43}, {2447, 2, &rule43}, {2451, 22, &rule43}, {2474, 7, &rule43}, {2482, 1, &rule43}, {2486, 4, &rule43}, {2492, 1, &rule66}, {2493, 1, &rule43}, {2494, 3, &rule92}, {2497, 4, &rule66}, {2503, 2, &rule92}, {2507, 2, &rule92}, {2509, 1, &rule66}, {2519, 1, &rule92}, {2524, 2, &rule43}, {2527, 3, &rule43}, {2530, 2, &rule66}, {2534, 10, &rule8}, {2544, 2, &rule43}, {2546, 2, &rule3}, {2548, 6, &rule17}, {2554, 1, &rule13}, {2561, 2, &rule66}, {2563, 1, &rule92}, {2565, 6, &rule43}, {2575, 2, &rule43}, {2579, 22, &rule43}, {2602, 7, &rule43}, {2610, 2, &rule43}, {2613, 2, &rule43}, {2616, 2, &rule43}, {2620, 1, &rule66}, {2622, 3, &rule92}, {2625, 2, &rule66}, {2631, 2, &rule66}, {2635, 3, &rule66}, {2649, 4, &rule43}, {2654, 1, &rule43}, {2662, 10, &rule8}, {2672, 2, &rule66}, {2674, 3, &rule43}, {2689, 2, &rule66}, {2691, 1, &rule92}, {2693, 9, &rule43}, {2703, 3, &rule43}, {2707, 22, &rule43}, {2730, 7, &rule43}, {2738, 2, &rule43}, {2741, 5, &rule43}, {2748, 1, &rule66}, {2749, 1, &rule43}, {2750, 3, &rule92}, {2753, 5, &rule66}, {2759, 2, &rule66}, {2761, 1, &rule92}, {2763, 2, &rule92}, {2765, 1, &rule66}, {2768, 1, &rule43}, {2784, 2, &rule43}, {2786, 2, &rule66}, {2790, 10, &rule8}, {2801, 1, &rule3}, {2817, 1, &rule66}, {2818, 2, &rule92}, {2821, 8, &rule43}, {2831, 2, &rule43}, {2835, 22, &rule43}, {2858, 7, &rule43}, {2866, 2, &rule43}, {2869, 5, &rule43}, {2876, 1, &rule66}, {2877, 1, &rule43}, {2878, 1, &rule92}, {2879, 1, &rule66}, {2880, 1, &rule92}, {2881, 3, &rule66}, {2887, 2, &rule92}, {2891, 2, &rule92}, {2893, 1, &rule66}, {2902, 1, &rule66}, {2903, 1, &rule92}, {2908, 2, &rule43}, {2911, 3, &rule43}, {2918, 10, &rule8}, {2928, 1, &rule13}, {2929, 1, &rule43}, {2946, 1, &rule66}, {2947, 1, &rule43}, {2949, 6, &rule43}, {2958, 3, &rule43}, {2962, 4, &rule43}, {2969, 2, &rule43}, {2972, 1, &rule43}, {2974, 2, &rule43}, {2979, 2, &rule43}, {2984, 3, &rule43}, {2990, 8, &rule43}, {2999, 3, &rule43}, {3006, 2, &rule92}, {3008, 1, &rule66}, {3009, 2, &rule92}, {3014, 3, &rule92}, {3018, 3, &rule92}, {3021, 1, &rule66}, {3031, 1, &rule92}, {3047, 9, &rule8}, {3056, 3, &rule17}, {3059, 6, &rule13}, {3065, 1, &rule3}, {3066, 1, &rule13}, {3073, 3, &rule92}, {3077, 8, &rule43}, {3086, 3, &rule43}, {3090, 23, &rule43}, {3114, 10, &rule43}, {3125, 5, &rule43}, {3134, 3, &rule66}, {3137, 4, &rule92}, {3142, 3, &rule66}, {3146, 4, &rule66}, {3157, 2, &rule66}, {3168, 2, &rule43}, {3174, 10, &rule8}, {3202, 2, &rule92}, {3205, 8, &rule43}, {3214, 3, &rule43}, {3218, 23, &rule43}, {3242, 10, &rule43}, {3253, 5, &rule43}, {3260, 1, &rule66}, {3261, 1, &rule43}, {3262, 1, &rule92}, {3263, 1, &rule66}, {3264, 5, &rule92}, {3270, 1, &rule66}, {3271, 2, &rule92}, {3274, 2, &rule92}, {3276, 2, &rule66}, {3285, 2, &rule92}, {3294, 1, &rule43}, {3296, 2, &rule43}, {3302, 10, &rule8}, {3330, 2, &rule92}, {3333, 8, &rule43}, {3342, 3, &rule43}, {3346, 23, &rule43}, {3370, 16, &rule43}, {3390, 3, &rule92}, {3393, 3, &rule66}, {3398, 3, &rule92}, {3402, 3, &rule92}, {3405, 1, &rule66}, {3415, 1, &rule92}, {3424, 2, &rule43}, {3430, 10, &rule8}, {3458, 2, &rule92}, {3461, 18, &rule43}, {3482, 24, &rule43}, {3507, 9, &rule43}, {3517, 1, &rule43}, {3520, 7, &rule43}, {3530, 1, &rule66}, {3535, 3, &rule92}, {3538, 3, &rule66}, {3542, 1, &rule66}, {3544, 8, &rule92}, {3570, 2, &rule92}, {3572, 1, &rule2}, {3585, 48, &rule43}, {3633, 1, &rule66}, {3634, 2, &rule43}, {3636, 7, &rule66}, {3647, 1, &rule3}, {3648, 6, &rule43}, {3654, 1, &rule65}, {3655, 8, &rule66}, {3663, 1, &rule2}, {3664, 10, &rule8}, {3674, 2, &rule2}, {3713, 2, &rule43}, {3716, 1, &rule43}, {3719, 2, &rule43}, {3722, 1, &rule43}, {3725, 1, &rule43}, {3732, 4, &rule43}, {3737, 7, &rule43}, {3745, 3, &rule43}, {3749, 1, &rule43}, {3751, 1, &rule43}, {3754, 2, &rule43}, {3757, 4, &rule43}, {3761, 1, &rule66}, {3762, 2, &rule43}, {3764, 6, &rule66}, {3771, 2, &rule66}, {3773, 1, &rule43}, {3776, 5, &rule43}, {3782, 1, &rule65}, {3784, 6, &rule66}, {3792, 10, &rule8}, {3804, 2, &rule43}, {3840, 1, &rule43}, {3841, 3, &rule13}, {3844, 15, &rule2}, {3859, 5, &rule13}, {3864, 2, &rule66}, {3866, 6, &rule13}, {3872, 10, &rule8}, {3882, 10, &rule17}, {3892, 1, &rule13}, {3893, 1, &rule66}, {3894, 1, &rule13}, {3895, 1, &rule66}, {3896, 1, &rule13}, {3897, 1, &rule66}, {3898, 1, &rule4}, {3899, 1, &rule5}, {3900, 1, &rule4}, {3901, 1, &rule5}, {3902, 2, &rule92}, {3904, 8, &rule43}, {3913, 34, &rule43}, {3953, 14, &rule66}, {3967, 1, &rule92}, {3968, 5, &rule66}, {3973, 1, &rule2}, {3974, 2, &rule66}, {3976, 4, &rule43}, {3984, 8, &rule66}, {3993, 36, &rule66}, {4030, 8, &rule13}, {4038, 1, &rule66}, {4039, 6, &rule13}, {4047, 1, &rule13}, {4096, 34, &rule43}, {4131, 5, &rule43}, {4137, 2, &rule43}, {4140, 1, &rule92}, {4141, 4, &rule66}, {4145, 1, &rule92}, {4146, 1, &rule66}, {4150, 2, &rule66}, {4152, 1, &rule92}, {4153, 1, &rule66}, {4160, 10, &rule8}, {4170, 6, &rule2}, {4176, 6, &rule43}, {4182, 2, &rule92}, {4184, 2, &rule66}, {4256, 38, &rule79}, {4304, 41, &rule43}, {4347, 1, &rule2}, {4352, 90, &rule43}, {4447, 68, &rule43}, {4520, 82, &rule43}, {4608, 7, &rule43}, {4616, 63, &rule43}, {4680, 1, &rule43}, {4682, 4, &rule43}, {4688, 7, &rule43}, {4696, 1, &rule43}, {4698, 4, &rule43}, {4704, 39, &rule43}, {4744, 1, &rule43}, {4746, 4, &rule43}, {4752, 31, &rule43}, {4784, 1, &rule43}, {4786, 4, &rule43}, {4792, 7, &rule43}, {4800, 1, &rule43}, {4802, 4, &rule43}, {4808, 7, &rule43}, {4816, 7, &rule43}, {4824, 23, &rule43}, {4848, 31, &rule43}, {4880, 1, &rule43}, {4882, 4, &rule43}, {4888, 7, &rule43}, {4896, 39, &rule43}, {4936, 19, &rule43}, {4961, 8, &rule2}, {4969, 9, &rule8}, {4978, 11, &rule17}, {5024, 85, &rule43}, {5121, 620, &rule43}, {5741, 2, &rule2}, {5743, 8, &rule43}, {5760, 1, &rule1}, {5761, 26, &rule43}, {5787, 1, &rule4}, {5788, 1, &rule5}, {5792, 75, &rule43}, {5867, 3, &rule2}, {5870, 3, &rule93}, {5888, 13, &rule43}, {5902, 4, &rule43}, {5906, 3, &rule66}, {5920, 18, &rule43}, {5938, 3, &rule66}, {5941, 2, &rule2}, {5952, 18, &rule43}, {5970, 2, &rule66}, {5984, 13, &rule43}, {5998, 3, &rule43}, {6002, 2, &rule66}, {6016, 52, &rule43}, {6068, 2, &rule16}, {6070, 1, &rule92}, {6071, 7, &rule66}, {6078, 8, &rule92}, {6086, 1, &rule66}, {6087, 2, &rule92}, {6089, 11, &rule66}, {6100, 3, &rule2}, {6103, 1, &rule65}, {6104, 3, &rule2}, {6107, 1, &rule3}, {6108, 1, &rule43}, {6109, 1, &rule66}, {6112, 10, &rule8}, {6128, 10, &rule17}, {6144, 6, &rule2}, {6150, 1, &rule7}, {6151, 4, &rule2}, {6155, 3, &rule66}, {6158, 1, &rule1}, {6160, 10, &rule8}, {6176, 35, &rule43}, {6211, 1, &rule65}, {6212, 52, &rule43}, {6272, 41, &rule43}, {6313, 1, &rule66}, {6400, 29, &rule43}, {6432, 3, &rule66}, {6435, 4, &rule92}, {6439, 2, &rule66}, {6441, 3, &rule92}, {6448, 2, &rule92}, {6450, 1, &rule66}, {6451, 6, &rule92}, {6457, 3, &rule66}, {6464, 1, &rule13}, {6468, 2, &rule2}, {6470, 10, &rule8}, {6480, 30, &rule43}, {6512, 5, &rule43}, {6624, 32, &rule13}, {7424, 44, &rule14}, {7468, 54, &rule65}, {7522, 10, &rule14}, {7680, 1, &rule21}, {7681, 1, &rule22}, {7682, 1, &rule21}, {7683, 1, &rule22}, {7684, 1, &rule21}, {7685, 1, &rule22}, {7686, 1, &rule21}, {7687, 1, &rule22}, {7688, 1, &rule21}, {7689, 1, &rule22}, {7690, 1, &rule21}, {7691, 1, &rule22}, {7692, 1, &rule21}, {7693, 1, &rule22}, {7694, 1, &rule21}, {7695, 1, &rule22}, {7696, 1, &rule21}, {7697, 1, &rule22}, {7698, 1, &rule21}, {7699, 1, &rule22}, {7700, 1, &rule21}, {7701, 1, &rule22}, {7702, 1, &rule21}, {7703, 1, &rule22}, {7704, 1, &rule21}, {7705, 1, &rule22}, {7706, 1, &rule21}, {7707, 1, &rule22}, {7708, 1, &rule21}, {7709, 1, &rule22}, {7710, 1, &rule21}, {7711, 1, &rule22}, {7712, 1, &rule21}, {7713, 1, &rule22}, {7714, 1, &rule21}, {7715, 1, &rule22}, {7716, 1, &rule21}, {7717, 1, &rule22}, {7718, 1, &rule21}, {7719, 1, &rule22}, {7720, 1, &rule21}, {7721, 1, &rule22}, {7722, 1, &rule21}, {7723, 1, &rule22}, {7724, 1, &rule21}, {7725, 1, &rule22}, {7726, 1, &rule21}, {7727, 1, &rule22}, {7728, 1, &rule21}, {7729, 1, &rule22}, {7730, 1, &rule21}, {7731, 1, &rule22}, {7732, 1, &rule21}, {7733, 1, &rule22}, {7734, 1, &rule21}, {7735, 1, &rule22}, {7736, 1, &rule21}, {7737, 1, &rule22}, {7738, 1, &rule21}, {7739, 1, &rule22}, {7740, 1, &rule21}, {7741, 1, &rule22}, {7742, 1, &rule21}, {7743, 1, &rule22}, {7744, 1, &rule21}, {7745, 1, &rule22}, {7746, 1, &rule21}, {7747, 1, &rule22}, {7748, 1, &rule21}, {7749, 1, &rule22}, {7750, 1, &rule21}, {7751, 1, &rule22}, {7752, 1, &rule21}, {7753, 1, &rule22}, {7754, 1, &rule21}, {7755, 1, &rule22}, {7756, 1, &rule21}, {7757, 1, &rule22}, {7758, 1, &rule21}, {7759, 1, &rule22}, {7760, 1, &rule21}, {7761, 1, &rule22}, {7762, 1, &rule21}, {7763, 1, &rule22}, {7764, 1, &rule21}, {7765, 1, &rule22}, {7766, 1, &rule21}, {7767, 1, &rule22}, {7768, 1, &rule21}, {7769, 1, &rule22}, {7770, 1, &rule21}, {7771, 1, &rule22}, {7772, 1, &rule21}, {7773, 1, &rule22}, {7774, 1, &rule21}, {7775, 1, &rule22}, {7776, 1, &rule21}, {7777, 1, &rule22}, {7778, 1, &rule21}, {7779, 1, &rule22}, {7780, 1, &rule21}, {7781, 1, &rule22}, {7782, 1, &rule21}, {7783, 1, &rule22}, {7784, 1, &rule21}, {7785, 1, &rule22}, {7786, 1, &rule21}, {7787, 1, &rule22}, {7788, 1, &rule21}, {7789, 1, &rule22}, {7790, 1, &rule21}, {7791, 1, &rule22}, {7792, 1, &rule21}, {7793, 1, &rule22}, {7794, 1, &rule21}, {7795, 1, &rule22}, {7796, 1, &rule21}, {7797, 1, &rule22}, {7798, 1, &rule21}, {7799, 1, &rule22}, {7800, 1, &rule21}, {7801, 1, &rule22}, {7802, 1, &rule21}, {7803, 1, &rule22}, {7804, 1, &rule21}, {7805, 1, &rule22}, {7806, 1, &rule21}, {7807, 1, &rule22}, {7808, 1, &rule21}, {7809, 1, &rule22}, {7810, 1, &rule21}, {7811, 1, &rule22}, {7812, 1, &rule21}, {7813, 1, &rule22}, {7814, 1, &rule21}, {7815, 1, &rule22}, {7816, 1, &rule21}, {7817, 1, &rule22}, {7818, 1, &rule21}, {7819, 1, &rule22}, {7820, 1, &rule21}, {7821, 1, &rule22}, {7822, 1, &rule21}, {7823, 1, &rule22}, {7824, 1, &rule21}, {7825, 1, &rule22}, {7826, 1, &rule21}, {7827, 1, &rule22}, {7828, 1, &rule21}, {7829, 1, &rule22}, {7830, 5, &rule14}, {7835, 1, &rule94}, {7840, 1, &rule21}, {7841, 1, &rule22}, {7842, 1, &rule21}, {7843, 1, &rule22}, {7844, 1, &rule21}, {7845, 1, &rule22}, {7846, 1, &rule21}, {7847, 1, &rule22}, {7848, 1, &rule21}, {7849, 1, &rule22}, {7850, 1, &rule21}, {7851, 1, &rule22}, {7852, 1, &rule21}, {7853, 1, &rule22}, {7854, 1, &rule21}, {7855, 1, &rule22}, {7856, 1, &rule21}, {7857, 1, &rule22}, {7858, 1, &rule21}, {7859, 1, &rule22}, {7860, 1, &rule21}, {7861, 1, &rule22}, {7862, 1, &rule21}, {7863, 1, &rule22}, {7864, 1, &rule21}, {7865, 1, &rule22}, {7866, 1, &rule21}, {7867, 1, &rule22}, {7868, 1, &rule21}, {7869, 1, &rule22}, {7870, 1, &rule21}, {7871, 1, &rule22}, {7872, 1, &rule21}, {7873, 1, &rule22}, {7874, 1, &rule21}, {7875, 1, &rule22}, {7876, 1, &rule21}, {7877, 1, &rule22}, {7878, 1, &rule21}, {7879, 1, &rule22}, {7880, 1, &rule21}, {7881, 1, &rule22}, {7882, 1, &rule21}, {7883, 1, &rule22}, {7884, 1, &rule21}, {7885, 1, &rule22}, {7886, 1, &rule21}, {7887, 1, &rule22}, {7888, 1, &rule21}, {7889, 1, &rule22}, {7890, 1, &rule21}, {7891, 1, &rule22}, {7892, 1, &rule21}, {7893, 1, &rule22}, {7894, 1, &rule21}, {7895, 1, &rule22}, {7896, 1, &rule21}, {7897, 1, &rule22}, {7898, 1, &rule21}, {7899, 1, &rule22}, {7900, 1, &rule21}, {7901, 1, &rule22}, {7902, 1, &rule21}, {7903, 1, &rule22}, {7904, 1, &rule21}, {7905, 1, &rule22}, {7906, 1, &rule21}, {7907, 1, &rule22}, {7908, 1, &rule21}, {7909, 1, &rule22}, {7910, 1, &rule21}, {7911, 1, &rule22}, {7912, 1, &rule21}, {7913, 1, &rule22}, {7914, 1, &rule21}, {7915, 1, &rule22}, {7916, 1, &rule21}, {7917, 1, &rule22}, {7918, 1, &rule21}, {7919, 1, &rule22}, {7920, 1, &rule21}, {7921, 1, &rule22}, {7922, 1, &rule21}, {7923, 1, &rule22}, {7924, 1, &rule21}, {7925, 1, &rule22}, {7926, 1, &rule21}, {7927, 1, &rule22}, {7928, 1, &rule21}, {7929, 1, &rule22}, {7936, 8, &rule95}, {7944, 8, &rule96}, {7952, 6, &rule95}, {7960, 6, &rule96}, {7968, 8, &rule95}, {7976, 8, &rule96}, {7984, 8, &rule95}, {7992, 8, &rule96}, {8000, 6, &rule95}, {8008, 6, &rule96}, {8016, 1, &rule14}, {8017, 1, &rule95}, {8018, 1, &rule14}, {8019, 1, &rule95}, {8020, 1, &rule14}, {8021, 1, &rule95}, {8022, 1, &rule14}, {8023, 1, &rule95}, {8025, 1, &rule96}, {8027, 1, &rule96}, {8029, 1, &rule96}, {8031, 1, &rule96}, {8032, 8, &rule95}, {8040, 8, &rule96}, {8048, 2, &rule97}, {8050, 4, &rule98}, {8054, 2, &rule99}, {8056, 2, &rule100}, {8058, 2, &rule101}, {8060, 2, &rule102}, {8064, 8, &rule95}, {8072, 8, &rule103}, {8080, 8, &rule95}, {8088, 8, &rule103}, {8096, 8, &rule95}, {8104, 8, &rule103}, {8112, 2, &rule95}, {8114, 1, &rule14}, {8115, 1, &rule104}, {8116, 1, &rule14}, {8118, 2, &rule14}, {8120, 2, &rule96}, {8122, 2, &rule105}, {8124, 1, &rule106}, {8125, 1, &rule10}, {8126, 1, &rule107}, {8127, 3, &rule10}, {8130, 1, &rule14}, {8131, 1, &rule104}, {8132, 1, &rule14}, {8134, 2, &rule14}, {8136, 4, &rule108}, {8140, 1, &rule106}, {8141, 3, &rule10}, {8144, 2, &rule95}, {8146, 2, &rule14}, {8150, 2, &rule14}, {8152, 2, &rule96}, {8154, 2, &rule109}, {8157, 3, &rule10}, {8160, 2, &rule95}, {8162, 3, &rule14}, {8165, 1, &rule84}, {8166, 2, &rule14}, {8168, 2, &rule96}, {8170, 2, &rule110}, {8172, 1, &rule87}, {8173, 3, &rule10}, {8178, 1, &rule14}, {8179, 1, &rule104}, {8180, 1, &rule14}, {8182, 2, &rule14}, {8184, 2, &rule111}, {8186, 2, &rule112}, {8188, 1, &rule106}, {8189, 2, &rule10}, {8192, 12, &rule1}, {8204, 4, &rule16}, {8208, 6, &rule7}, {8214, 2, &rule2}, {8216, 1, &rule15}, {8217, 1, &rule19}, {8218, 1, &rule4}, {8219, 2, &rule15}, {8221, 1, &rule19}, {8222, 1, &rule4}, {8223, 1, &rule15}, {8224, 8, &rule2}, {8232, 1, &rule113}, {8233, 1, &rule114}, {8234, 5, &rule16}, {8239, 1, &rule1}, {8240, 9, &rule2}, {8249, 1, &rule15}, {8250, 1, &rule19}, {8251, 4, &rule2}, {8255, 2, &rule11}, {8257, 3, &rule2}, {8260, 1, &rule6}, {8261, 1, &rule4}, {8262, 1, &rule5}, {8263, 11, &rule2}, {8274, 1, &rule6}, {8275, 1, &rule2}, {8276, 1, &rule11}, {8279, 1, &rule2}, {8287, 1, &rule1}, {8288, 4, &rule16}, {8298, 6, &rule16}, {8304, 1, &rule17}, {8305, 1, &rule14}, {8308, 6, &rule17}, {8314, 3, &rule6}, {8317, 1, &rule4}, {8318, 1, &rule5}, {8319, 1, &rule14}, {8320, 10, &rule17}, {8330, 3, &rule6}, {8333, 1, &rule4}, {8334, 1, &rule5}, {8352, 18, &rule3}, {8400, 13, &rule66}, {8413, 4, &rule89}, {8417, 1, &rule66}, {8418, 3, &rule89}, {8421, 6, &rule66}, {8448, 2, &rule13}, {8450, 1, &rule79}, {8451, 4, &rule13}, {8455, 1, &rule79}, {8456, 2, &rule13}, {8458, 1, &rule14}, {8459, 3, &rule79}, {8462, 2, &rule14}, {8464, 3, &rule79}, {8467, 1, &rule14}, {8468, 1, &rule13}, {8469, 1, &rule79}, {8470, 3, &rule13}, {8473, 5, &rule79}, {8478, 6, &rule13}, {8484, 1, &rule79}, {8485, 1, &rule13}, {8486, 1, &rule115}, {8487, 1, &rule13}, {8488, 1, &rule79}, {8489, 1, &rule13}, {8490, 1, &rule116}, {8491, 1, &rule117}, {8492, 2, &rule79}, {8494, 1, &rule13}, {8495, 1, &rule14}, {8496, 2, &rule79}, {8498, 1, &rule13}, {8499, 1, &rule79}, {8500, 1, &rule14}, {8501, 4, &rule43}, {8505, 1, &rule14}, {8506, 2, &rule13}, {8509, 1, &rule14}, {8510, 2, &rule79}, {8512, 5, &rule6}, {8517, 1, &rule79}, {8518, 4, &rule14}, {8522, 1, &rule13}, {8523, 1, &rule6}, {8531, 13, &rule17}, {8544, 16, &rule118}, {8560, 16, &rule119}, {8576, 4, &rule93}, {8592, 5, &rule6}, {8597, 5, &rule13}, {8602, 2, &rule6}, {8604, 4, &rule13}, {8608, 1, &rule6}, {8609, 2, &rule13}, {8611, 1, &rule6}, {8612, 2, &rule13}, {8614, 1, &rule6}, {8615, 7, &rule13}, {8622, 1, &rule6}, {8623, 31, &rule13}, {8654, 2, &rule6}, {8656, 2, &rule13}, {8658, 1, &rule6}, {8659, 1, &rule13}, {8660, 1, &rule6}, {8661, 31, &rule13}, {8692, 268, &rule6}, {8960, 8, &rule13}, {8968, 4, &rule6}, {8972, 20, &rule13}, {8992, 2, &rule6}, {8994, 7, &rule13}, {9001, 1, &rule4}, {9002, 1, &rule5}, {9003, 81, &rule13}, {9084, 1, &rule6}, {9085, 30, &rule13}, {9115, 25, &rule6}, {9140, 1, &rule4}, {9141, 1, &rule5}, {9142, 1, &rule2}, {9143, 26, &rule13}, {9216, 39, &rule13}, {9280, 11, &rule13}, {9312, 60, &rule17}, {9372, 26, &rule13}, {9398, 26, &rule120}, {9424, 26, &rule121}, {9450, 22, &rule17}, {9472, 183, &rule13}, {9655, 1, &rule6}, {9656, 9, &rule13}, {9665, 1, &rule6}, {9666, 54, &rule13}, {9720, 8, &rule6}, {9728, 24, &rule13}, {9753, 86, &rule13}, {9839, 1, &rule6}, {9840, 14, &rule13}, {9856, 18, &rule13}, {9888, 2, &rule13}, {9985, 4, &rule13}, {9990, 4, &rule13}, {9996, 28, &rule13}, {10025, 35, &rule13}, {10061, 1, &rule13}, {10063, 4, &rule13}, {10070, 1, &rule13}, {10072, 7, &rule13}, {10081, 7, &rule13}, {10088, 1, &rule4}, {10089, 1, &rule5}, {10090, 1, &rule4}, {10091, 1, &rule5}, {10092, 1, &rule4}, {10093, 1, &rule5}, {10094, 1, &rule4}, {10095, 1, &rule5}, {10096, 1, &rule4}, {10097, 1, &rule5}, {10098, 1, &rule4}, {10099, 1, &rule5}, {10100, 1, &rule4}, {10101, 1, &rule5}, {10102, 30, &rule17}, {10132, 1, &rule13}, {10136, 24, &rule13}, {10161, 14, &rule13}, {10192, 22, &rule6}, {10214, 1, &rule4}, {10215, 1, &rule5}, {10216, 1, &rule4}, {10217, 1, &rule5}, {10218, 1, &rule4}, {10219, 1, &rule5}, {10224, 16, &rule6}, {10240, 256, &rule13}, {10496, 131, &rule6}, {10627, 1, &rule4}, {10628, 1, &rule5}, {10629, 1, &rule4}, {10630, 1, &rule5}, {10631, 1, &rule4}, {10632, 1, &rule5}, {10633, 1, &rule4}, {10634, 1, &rule5}, {10635, 1, &rule4}, {10636, 1, &rule5}, {10637, 1, &rule4}, {10638, 1, &rule5}, {10639, 1, &rule4}, {10640, 1, &rule5}, {10641, 1, &rule4}, {10642, 1, &rule5}, {10643, 1, &rule4}, {10644, 1, &rule5}, {10645, 1, &rule4}, {10646, 1, &rule5}, {10647, 1, &rule4}, {10648, 1, &rule5}, {10649, 63, &rule6}, {10712, 1, &rule4}, {10713, 1, &rule5}, {10714, 1, &rule4}, {10715, 1, &rule5}, {10716, 32, &rule6}, {10748, 1, &rule4}, {10749, 1, &rule5}, {10750, 258, &rule6}, {11008, 14, &rule13}, {11904, 26, &rule13}, {11931, 89, &rule13}, {12032, 214, &rule13}, {12272, 12, &rule13}, {12288, 1, &rule1}, {12289, 3, &rule2}, {12292, 1, &rule13}, {12293, 1, &rule65}, {12294, 1, &rule43}, {12295, 1, &rule93}, {12296, 1, &rule4}, {12297, 1, &rule5}, {12298, 1, &rule4}, {12299, 1, &rule5}, {12300, 1, &rule4}, {12301, 1, &rule5}, {12302, 1, &rule4}, {12303, 1, &rule5}, {12304, 1, &rule4}, {12305, 1, &rule5}, {12306, 2, &rule13}, {12308, 1, &rule4}, {12309, 1, &rule5}, {12310, 1, &rule4}, {12311, 1, &rule5}, {12312, 1, &rule4}, {12313, 1, &rule5}, {12314, 1, &rule4}, {12315, 1, &rule5}, {12316, 1, &rule7}, {12317, 1, &rule4}, {12318, 2, &rule5}, {12320, 1, &rule13}, {12321, 9, &rule93}, {12330, 6, &rule66}, {12336, 1, &rule7}, {12337, 5, &rule65}, {12342, 2, &rule13}, {12344, 3, &rule93}, {12347, 1, &rule65}, {12348, 1, &rule43}, {12349, 1, &rule2}, {12350, 2, &rule13}, {12353, 86, &rule43}, {12441, 2, &rule66}, {12443, 2, &rule10}, {12445, 2, &rule65}, {12447, 1, &rule43}, {12448, 1, &rule7}, {12449, 90, &rule43}, {12539, 1, &rule11}, {12540, 3, &rule65}, {12543, 1, &rule43}, {12549, 40, &rule43}, {12593, 94, &rule43}, {12688, 2, &rule13}, {12690, 4, &rule17}, {12694, 10, &rule13}, {12704, 24, &rule43}, {12784, 16, &rule43}, {12800, 31, &rule13}, {12832, 10, &rule17}, {12842, 26, &rule13}, {12880, 1, &rule13}, {12881, 15, &rule17}, {12896, 30, &rule13}, {12927, 1, &rule13}, {12928, 10, &rule17}, {12938, 39, &rule13}, {12977, 15, &rule17}, {12992, 63, &rule13}, {13056, 256, &rule13}, {13312, 6582, &rule43}, {19904, 64, &rule13}, {19968, 20902, &rule43}, {40960, 1165, &rule43}, {42128, 55, &rule13}, {44032, 11172, &rule43}, {55296, 896, &rule122}, {56192, 128, &rule122}, {56320, 1024, &rule122}, {57344, 6400, &rule123}, {63744, 302, &rule43}, {64048, 59, &rule43}, {64256, 7, &rule14}, {64275, 5, &rule14}, {64285, 1, &rule43}, {64286, 1, &rule66}, {64287, 10, &rule43}, {64297, 1, &rule6}, {64298, 13, &rule43}, {64312, 5, &rule43}, {64318, 1, &rule43}, {64320, 2, &rule43}, {64323, 2, &rule43}, {64326, 108, &rule43}, {64467, 363, &rule43}, {64830, 1, &rule4}, {64831, 1, &rule5}, {64848, 64, &rule43}, {64914, 54, &rule43}, {65008, 12, &rule43}, {65020, 1, &rule3}, {65021, 1, &rule13}, {65024, 16, &rule66}, {65056, 4, &rule66}, {65072, 1, &rule2}, {65073, 2, &rule7}, {65075, 2, &rule11}, {65077, 1, &rule4}, {65078, 1, &rule5}, {65079, 1, &rule4}, {65080, 1, &rule5}, {65081, 1, &rule4}, {65082, 1, &rule5}, {65083, 1, &rule4}, {65084, 1, &rule5}, {65085, 1, &rule4}, {65086, 1, &rule5}, {65087, 1, &rule4}, {65088, 1, &rule5}, {65089, 1, &rule4}, {65090, 1, &rule5}, {65091, 1, &rule4}, {65092, 1, &rule5}, {65093, 2, &rule2}, {65095, 1, &rule4}, {65096, 1, &rule5}, {65097, 4, &rule2}, {65101, 3, &rule11}, {65104, 3, &rule2}, {65108, 4, &rule2}, {65112, 1, &rule7}, {65113, 1, &rule4}, {65114, 1, &rule5}, {65115, 1, &rule4}, {65116, 1, &rule5}, {65117, 1, &rule4}, {65118, 1, &rule5}, {65119, 3, &rule2}, {65122, 1, &rule6}, {65123, 1, &rule7}, {65124, 3, &rule6}, {65128, 1, &rule2}, {65129, 1, &rule3}, {65130, 2, &rule2}, {65136, 5, &rule43}, {65142, 135, &rule43}, {65279, 1, &rule16}, {65281, 3, &rule2}, {65284, 1, &rule3}, {65285, 3, &rule2}, {65288, 1, &rule4}, {65289, 1, &rule5}, {65290, 1, &rule2}, {65291, 1, &rule6}, {65292, 1, &rule2}, {65293, 1, &rule7}, {65294, 2, &rule2}, {65296, 10, &rule8}, {65306, 2, &rule2}, {65308, 3, &rule6}, {65311, 2, &rule2}, {65313, 26, &rule9}, {65339, 1, &rule4}, {65340, 1, &rule2}, {65341, 1, &rule5}, {65342, 1, &rule10}, {65343, 1, &rule11}, {65344, 1, &rule10}, {65345, 26, &rule12}, {65371, 1, &rule4}, {65372, 1, &rule6}, {65373, 1, &rule5}, {65374, 1, &rule6}, {65375, 1, &rule4}, {65376, 1, &rule5}, {65377, 1, &rule2}, {65378, 1, &rule4}, {65379, 1, &rule5}, {65380, 1, &rule2}, {65381, 1, &rule11}, {65382, 10, &rule43}, {65392, 1, &rule65}, {65393, 45, &rule43}, {65438, 2, &rule65}, {65440, 31, &rule43}, {65474, 6, &rule43}, {65482, 6, &rule43}, {65490, 6, &rule43}, {65498, 3, &rule43}, {65504, 2, &rule3}, {65506, 1, &rule6}, {65507, 1, &rule10}, {65508, 1, &rule13}, {65509, 2, &rule3}, {65512, 1, &rule13}, {65513, 4, &rule6}, {65517, 2, &rule13}, {65529, 3, &rule16}, {65532, 2, &rule13}, {65536, 12, &rule43}, {65549, 26, &rule43}, {65576, 19, &rule43}, {65596, 2, &rule43}, {65599, 15, &rule43}, {65616, 14, &rule43}, {65664, 123, &rule43}, {65792, 2, &rule2}, {65794, 1, &rule13}, {65799, 45, &rule17}, {65847, 9, &rule13}, {66304, 31, &rule43}, {66336, 4, &rule17}, {66352, 26, &rule43}, {66378, 1, &rule93}, {66432, 30, &rule43}, {66463, 1, &rule2}, {66560, 40, &rule124}, {66600, 40, &rule125}, {66640, 78, &rule43}, {66720, 10, &rule8}, {67584, 6, &rule43}, {67592, 1, &rule43}, {67594, 44, &rule43}, {67639, 2, &rule43}, {67644, 1, &rule43}, {67647, 1, &rule43}, {118784, 246, &rule13}, {119040, 39, &rule13}, {119082, 59, &rule13}, {119141, 2, &rule92}, {119143, 3, &rule66}, {119146, 3, &rule13}, {119149, 6, &rule92}, {119155, 8, &rule16}, {119163, 8, &rule66}, {119171, 2, &rule13}, {119173, 7, &rule66}, {119180, 30, &rule13}, {119210, 4, &rule66}, {119214, 48, &rule13}, {119552, 87, &rule13}, {119808, 26, &rule79}, {119834, 26, &rule14}, {119860, 26, &rule79}, {119886, 7, &rule14}, {119894, 18, &rule14}, {119912, 26, &rule79}, {119938, 26, &rule14}, {119964, 1, &rule79}, {119966, 2, &rule79}, {119970, 1, &rule79}, {119973, 2, &rule79}, {119977, 4, &rule79}, {119982, 8, &rule79}, {119990, 4, &rule14}, {119995, 1, &rule14}, {119997, 7, &rule14}, {120005, 11, &rule14}, {120016, 26, &rule79}, {120042, 26, &rule14}, {120068, 2, &rule79}, {120071, 4, &rule79}, {120077, 8, &rule79}, {120086, 7, &rule79}, {120094, 26, &rule14}, {120120, 2, &rule79}, {120123, 4, &rule79}, {120128, 5, &rule79}, {120134, 1, &rule79}, {120138, 7, &rule79}, {120146, 26, &rule14}, {120172, 26, &rule79}, {120198, 26, &rule14}, {120224, 26, &rule79}, {120250, 26, &rule14}, {120276, 26, &rule79}, {120302, 26, &rule14}, {120328, 26, &rule79}, {120354, 26, &rule14}, {120380, 26, &rule79}, {120406, 26, &rule14}, {120432, 26, &rule79}, {120458, 26, &rule14}, {120488, 25, &rule79}, {120513, 1, &rule6}, {120514, 25, &rule14}, {120539, 1, &rule6}, {120540, 6, &rule14}, {120546, 25, &rule79}, {120571, 1, &rule6}, {120572, 25, &rule14}, {120597, 1, &rule6}, {120598, 6, &rule14}, {120604, 25, &rule79}, {120629, 1, &rule6}, {120630, 25, &rule14}, {120655, 1, &rule6}, {120656, 6, &rule14}, {120662, 25, &rule79}, {120687, 1, &rule6}, {120688, 25, &rule14}, {120713, 1, &rule6}, {120714, 6, &rule14}, {120720, 25, &rule79}, {120745, 1, &rule6}, {120746, 25, &rule14}, {120771, 1, &rule6}, {120772, 6, &rule14}, {120782, 50, &rule8}, {131072, 42711, &rule43}, {194560, 542, &rule43}, {917505, 1, &rule16}, {917536, 96, &rule16}, {917760, 240, &rule66}, {983040, 65534, &rule123}, {1048576, 65534, &rule123} }; static const struct _charblock_ convchars[]={ {65, 26, &rule9}, {97, 26, &rule12}, {181, 1, &rule18}, {192, 23, &rule9}, {216, 7, &rule9}, {224, 23, &rule12}, {248, 7, &rule12}, {255, 1, &rule20}, {256, 1, &rule21}, {257, 1, &rule22}, {258, 1, &rule21}, {259, 1, &rule22}, {260, 1, &rule21}, {261, 1, &rule22}, {262, 1, &rule21}, {263, 1, &rule22}, {264, 1, &rule21}, {265, 1, &rule22}, {266, 1, &rule21}, {267, 1, &rule22}, {268, 1, &rule21}, {269, 1, &rule22}, {270, 1, &rule21}, {271, 1, &rule22}, {272, 1, &rule21}, {273, 1, &rule22}, {274, 1, &rule21}, {275, 1, &rule22}, {276, 1, &rule21}, {277, 1, &rule22}, {278, 1, &rule21}, {279, 1, &rule22}, {280, 1, &rule21}, {281, 1, &rule22}, {282, 1, &rule21}, {283, 1, &rule22}, {284, 1, &rule21}, {285, 1, &rule22}, {286, 1, &rule21}, {287, 1, &rule22}, {288, 1, &rule21}, {289, 1, &rule22}, {290, 1, &rule21}, {291, 1, &rule22}, {292, 1, &rule21}, {293, 1, &rule22}, {294, 1, &rule21}, {295, 1, &rule22}, {296, 1, &rule21}, {297, 1, &rule22}, {298, 1, &rule21}, {299, 1, &rule22}, {300, 1, &rule21}, {301, 1, &rule22}, {302, 1, &rule21}, {303, 1, &rule22}, {304, 1, &rule23}, {305, 1, &rule24}, {306, 1, &rule21}, {307, 1, &rule22}, {308, 1, &rule21}, {309, 1, &rule22}, {310, 1, &rule21}, {311, 1, &rule22}, {313, 1, &rule21}, {314, 1, &rule22}, {315, 1, &rule21}, {316, 1, &rule22}, {317, 1, &rule21}, {318, 1, &rule22}, {319, 1, &rule21}, {320, 1, &rule22}, {321, 1, &rule21}, {322, 1, &rule22}, {323, 1, &rule21}, {324, 1, &rule22}, {325, 1, &rule21}, {326, 1, &rule22}, {327, 1, &rule21}, {328, 1, &rule22}, {330, 1, &rule21}, {331, 1, &rule22}, {332, 1, &rule21}, {333, 1, &rule22}, {334, 1, &rule21}, {335, 1, &rule22}, {336, 1, &rule21}, {337, 1, &rule22}, {338, 1, &rule21}, {339, 1, &rule22}, {340, 1, &rule21}, {341, 1, &rule22}, {342, 1, &rule21}, {343, 1, &rule22}, {344, 1, &rule21}, {345, 1, &rule22}, {346, 1, &rule21}, {347, 1, &rule22}, {348, 1, &rule21}, {349, 1, &rule22}, {350, 1, &rule21}, {351, 1, &rule22}, {352, 1, &rule21}, {353, 1, &rule22}, {354, 1, &rule21}, {355, 1, &rule22}, {356, 1, &rule21}, {357, 1, &rule22}, {358, 1, &rule21}, {359, 1, &rule22}, {360, 1, &rule21}, {361, 1, &rule22}, {362, 1, &rule21}, {363, 1, &rule22}, {364, 1, &rule21}, {365, 1, &rule22}, {366, 1, &rule21}, {367, 1, &rule22}, {368, 1, &rule21}, {369, 1, &rule22}, {370, 1, &rule21}, {371, 1, &rule22}, {372, 1, &rule21}, {373, 1, &rule22}, {374, 1, &rule21}, {375, 1, &rule22}, {376, 1, &rule25}, {377, 1, &rule21}, {378, 1, &rule22}, {379, 1, &rule21}, {380, 1, &rule22}, {381, 1, &rule21}, {382, 1, &rule22}, {383, 1, &rule26}, {385, 1, &rule27}, {386, 1, &rule21}, {387, 1, &rule22}, {388, 1, &rule21}, {389, 1, &rule22}, {390, 1, &rule28}, {391, 1, &rule21}, {392, 1, &rule22}, {393, 2, &rule29}, {395, 1, &rule21}, {396, 1, &rule22}, {398, 1, &rule30}, {399, 1, &rule31}, {400, 1, &rule32}, {401, 1, &rule21}, {402, 1, &rule22}, {403, 1, &rule29}, {404, 1, &rule33}, {405, 1, &rule34}, {406, 1, &rule35}, {407, 1, &rule36}, {408, 1, &rule21}, {409, 1, &rule22}, {412, 1, &rule35}, {413, 1, &rule37}, {414, 1, &rule38}, {415, 1, &rule39}, {416, 1, &rule21}, {417, 1, &rule22}, {418, 1, &rule21}, {419, 1, &rule22}, {420, 1, &rule21}, {421, 1, &rule22}, {422, 1, &rule40}, {423, 1, &rule21}, {424, 1, &rule22}, {425, 1, &rule40}, {428, 1, &rule21}, {429, 1, &rule22}, {430, 1, &rule40}, {431, 1, &rule21}, {432, 1, &rule22}, {433, 2, &rule41}, {435, 1, &rule21}, {436, 1, &rule22}, {437, 1, &rule21}, {438, 1, &rule22}, {439, 1, &rule42}, {440, 1, &rule21}, {441, 1, &rule22}, {444, 1, &rule21}, {445, 1, &rule22}, {447, 1, &rule44}, {452, 1, &rule45}, {453, 1, &rule46}, {454, 1, &rule47}, {455, 1, &rule45}, {456, 1, &rule46}, {457, 1, &rule47}, {458, 1, &rule45}, {459, 1, &rule46}, {460, 1, &rule47}, {461, 1, &rule21}, {462, 1, &rule22}, {463, 1, &rule21}, {464, 1, &rule22}, {465, 1, &rule21}, {466, 1, &rule22}, {467, 1, &rule21}, {468, 1, &rule22}, {469, 1, &rule21}, {470, 1, &rule22}, {471, 1, &rule21}, {472, 1, &rule22}, {473, 1, &rule21}, {474, 1, &rule22}, {475, 1, &rule21}, {476, 1, &rule22}, {477, 1, &rule48}, {478, 1, &rule21}, {479, 1, &rule22}, {480, 1, &rule21}, {481, 1, &rule22}, {482, 1, &rule21}, {483, 1, &rule22}, {484, 1, &rule21}, {485, 1, &rule22}, {486, 1, &rule21}, {487, 1, &rule22}, {488, 1, &rule21}, {489, 1, &rule22}, {490, 1, &rule21}, {491, 1, &rule22}, {492, 1, &rule21}, {493, 1, &rule22}, {494, 1, &rule21}, {495, 1, &rule22}, {497, 1, &rule45}, {498, 1, &rule46}, {499, 1, &rule47}, {500, 1, &rule21}, {501, 1, &rule22}, {502, 1, &rule49}, {503, 1, &rule50}, {504, 1, &rule21}, {505, 1, &rule22}, {506, 1, &rule21}, {507, 1, &rule22}, {508, 1, &rule21}, {509, 1, &rule22}, {510, 1, &rule21}, {511, 1, &rule22}, {512, 1, &rule21}, {513, 1, &rule22}, {514, 1, &rule21}, {515, 1, &rule22}, {516, 1, &rule21}, {517, 1, &rule22}, {518, 1, &rule21}, {519, 1, &rule22}, {520, 1, &rule21}, {521, 1, &rule22}, {522, 1, &rule21}, {523, 1, &rule22}, {524, 1, &rule21}, {525, 1, &rule22}, {526, 1, &rule21}, {527, 1, &rule22}, {528, 1, &rule21}, {529, 1, &rule22}, {530, 1, &rule21}, {531, 1, &rule22}, {532, 1, &rule21}, {533, 1, &rule22}, {534, 1, &rule21}, {535, 1, &rule22}, {536, 1, &rule21}, {537, 1, &rule22}, {538, 1, &rule21}, {539, 1, &rule22}, {540, 1, &rule21}, {541, 1, &rule22}, {542, 1, &rule21}, {543, 1, &rule22}, {544, 1, &rule51}, {546, 1, &rule21}, {547, 1, &rule22}, {548, 1, &rule21}, {549, 1, &rule22}, {550, 1, &rule21}, {551, 1, &rule22}, {552, 1, &rule21}, {553, 1, &rule22}, {554, 1, &rule21}, {555, 1, &rule22}, {556, 1, &rule21}, {557, 1, &rule22}, {558, 1, &rule21}, {559, 1, &rule22}, {560, 1, &rule21}, {561, 1, &rule22}, {562, 1, &rule21}, {563, 1, &rule22}, {595, 1, &rule52}, {596, 1, &rule53}, {598, 2, &rule54}, {601, 1, &rule55}, {603, 1, &rule56}, {608, 1, &rule54}, {611, 1, &rule57}, {616, 1, &rule58}, {617, 1, &rule59}, {623, 1, &rule59}, {626, 1, &rule60}, {629, 1, &rule61}, {640, 1, &rule62}, {643, 1, &rule62}, {648, 1, &rule62}, {650, 2, &rule63}, {658, 1, &rule64}, {837, 1, &rule67}, {902, 1, &rule68}, {904, 3, &rule69}, {908, 1, &rule70}, {910, 2, &rule71}, {913, 17, &rule9}, {931, 9, &rule9}, {940, 1, &rule72}, {941, 3, &rule73}, {945, 17, &rule12}, {962, 1, &rule74}, {963, 9, &rule12}, {972, 1, &rule75}, {973, 2, &rule76}, {976, 1, &rule77}, {977, 1, &rule78}, {981, 1, &rule80}, {982, 1, &rule81}, {984, 1, &rule21}, {985, 1, &rule22}, {986, 1, &rule21}, {987, 1, &rule22}, {988, 1, &rule21}, {989, 1, &rule22}, {990, 1, &rule21}, {991, 1, &rule22}, {992, 1, &rule21}, {993, 1, &rule22}, {994, 1, &rule21}, {995, 1, &rule22}, {996, 1, &rule21}, {997, 1, &rule22}, {998, 1, &rule21}, {999, 1, &rule22}, {1000, 1, &rule21}, {1001, 1, &rule22}, {1002, 1, &rule21}, {1003, 1, &rule22}, {1004, 1, &rule21}, {1005, 1, &rule22}, {1006, 1, &rule21}, {1007, 1, &rule22}, {1008, 1, &rule82}, {1009, 1, &rule83}, {1010, 1, &rule84}, {1012, 1, &rule85}, {1013, 1, &rule86}, {1015, 1, &rule21}, {1016, 1, &rule22}, {1017, 1, &rule87}, {1018, 1, &rule21}, {1019, 1, &rule22}, {1024, 16, &rule88}, {1040, 32, &rule9}, {1072, 32, &rule12}, {1104, 16, &rule83}, {1120, 1, &rule21}, {1121, 1, &rule22}, {1122, 1, &rule21}, {1123, 1, &rule22}, {1124, 1, &rule21}, {1125, 1, &rule22}, {1126, 1, &rule21}, {1127, 1, &rule22}, {1128, 1, &rule21}, {1129, 1, &rule22}, {1130, 1, &rule21}, {1131, 1, &rule22}, {1132, 1, &rule21}, {1133, 1, &rule22}, {1134, 1, &rule21}, {1135, 1, &rule22}, {1136, 1, &rule21}, {1137, 1, &rule22}, {1138, 1, &rule21}, {1139, 1, &rule22}, {1140, 1, &rule21}, {1141, 1, &rule22}, {1142, 1, &rule21}, {1143, 1, &rule22}, {1144, 1, &rule21}, {1145, 1, &rule22}, {1146, 1, &rule21}, {1147, 1, &rule22}, {1148, 1, &rule21}, {1149, 1, &rule22}, {1150, 1, &rule21}, {1151, 1, &rule22}, {1152, 1, &rule21}, {1153, 1, &rule22}, {1162, 1, &rule21}, {1163, 1, &rule22}, {1164, 1, &rule21}, {1165, 1, &rule22}, {1166, 1, &rule21}, {1167, 1, &rule22}, {1168, 1, &rule21}, {1169, 1, &rule22}, {1170, 1, &rule21}, {1171, 1, &rule22}, {1172, 1, &rule21}, {1173, 1, &rule22}, {1174, 1, &rule21}, {1175, 1, &rule22}, {1176, 1, &rule21}, {1177, 1, &rule22}, {1178, 1, &rule21}, {1179, 1, &rule22}, {1180, 1, &rule21}, {1181, 1, &rule22}, {1182, 1, &rule21}, {1183, 1, &rule22}, {1184, 1, &rule21}, {1185, 1, &rule22}, {1186, 1, &rule21}, {1187, 1, &rule22}, {1188, 1, &rule21}, {1189, 1, &rule22}, {1190, 1, &rule21}, {1191, 1, &rule22}, {1192, 1, &rule21}, {1193, 1, &rule22}, {1194, 1, &rule21}, {1195, 1, &rule22}, {1196, 1, &rule21}, {1197, 1, &rule22}, {1198, 1, &rule21}, {1199, 1, &rule22}, {1200, 1, &rule21}, {1201, 1, &rule22}, {1202, 1, &rule21}, {1203, 1, &rule22}, {1204, 1, &rule21}, {1205, 1, &rule22}, {1206, 1, &rule21}, {1207, 1, &rule22}, {1208, 1, &rule21}, {1209, 1, &rule22}, {1210, 1, &rule21}, {1211, 1, &rule22}, {1212, 1, &rule21}, {1213, 1, &rule22}, {1214, 1, &rule21}, {1215, 1, &rule22}, {1217, 1, &rule21}, {1218, 1, &rule22}, {1219, 1, &rule21}, {1220, 1, &rule22}, {1221, 1, &rule21}, {1222, 1, &rule22}, {1223, 1, &rule21}, {1224, 1, &rule22}, {1225, 1, &rule21}, {1226, 1, &rule22}, {1227, 1, &rule21}, {1228, 1, &rule22}, {1229, 1, &rule21}, {1230, 1, &rule22}, {1232, 1, &rule21}, {1233, 1, &rule22}, {1234, 1, &rule21}, {1235, 1, &rule22}, {1236, 1, &rule21}, {1237, 1, &rule22}, {1238, 1, &rule21}, {1239, 1, &rule22}, {1240, 1, &rule21}, {1241, 1, &rule22}, {1242, 1, &rule21}, {1243, 1, &rule22}, {1244, 1, &rule21}, {1245, 1, &rule22}, {1246, 1, &rule21}, {1247, 1, &rule22}, {1248, 1, &rule21}, {1249, 1, &rule22}, {1250, 1, &rule21}, {1251, 1, &rule22}, {1252, 1, &rule21}, {1253, 1, &rule22}, {1254, 1, &rule21}, {1255, 1, &rule22}, {1256, 1, &rule21}, {1257, 1, &rule22}, {1258, 1, &rule21}, {1259, 1, &rule22}, {1260, 1, &rule21}, {1261, 1, &rule22}, {1262, 1, &rule21}, {1263, 1, &rule22}, {1264, 1, &rule21}, {1265, 1, &rule22}, {1266, 1, &rule21}, {1267, 1, &rule22}, {1268, 1, &rule21}, {1269, 1, &rule22}, {1272, 1, &rule21}, {1273, 1, &rule22}, {1280, 1, &rule21}, {1281, 1, &rule22}, {1282, 1, &rule21}, {1283, 1, &rule22}, {1284, 1, &rule21}, {1285, 1, &rule22}, {1286, 1, &rule21}, {1287, 1, &rule22}, {1288, 1, &rule21}, {1289, 1, &rule22}, {1290, 1, &rule21}, {1291, 1, &rule22}, {1292, 1, &rule21}, {1293, 1, &rule22}, {1294, 1, &rule21}, {1295, 1, &rule22}, {1329, 38, &rule90}, {1377, 38, &rule91}, {7680, 1, &rule21}, {7681, 1, &rule22}, {7682, 1, &rule21}, {7683, 1, &rule22}, {7684, 1, &rule21}, {7685, 1, &rule22}, {7686, 1, &rule21}, {7687, 1, &rule22}, {7688, 1, &rule21}, {7689, 1, &rule22}, {7690, 1, &rule21}, {7691, 1, &rule22}, {7692, 1, &rule21}, {7693, 1, &rule22}, {7694, 1, &rule21}, {7695, 1, &rule22}, {7696, 1, &rule21}, {7697, 1, &rule22}, {7698, 1, &rule21}, {7699, 1, &rule22}, {7700, 1, &rule21}, {7701, 1, &rule22}, {7702, 1, &rule21}, {7703, 1, &rule22}, {7704, 1, &rule21}, {7705, 1, &rule22}, {7706, 1, &rule21}, {7707, 1, &rule22}, {7708, 1, &rule21}, {7709, 1, &rule22}, {7710, 1, &rule21}, {7711, 1, &rule22}, {7712, 1, &rule21}, {7713, 1, &rule22}, {7714, 1, &rule21}, {7715, 1, &rule22}, {7716, 1, &rule21}, {7717, 1, &rule22}, {7718, 1, &rule21}, {7719, 1, &rule22}, {7720, 1, &rule21}, {7721, 1, &rule22}, {7722, 1, &rule21}, {7723, 1, &rule22}, {7724, 1, &rule21}, {7725, 1, &rule22}, {7726, 1, &rule21}, {7727, 1, &rule22}, {7728, 1, &rule21}, {7729, 1, &rule22}, {7730, 1, &rule21}, {7731, 1, &rule22}, {7732, 1, &rule21}, {7733, 1, &rule22}, {7734, 1, &rule21}, {7735, 1, &rule22}, {7736, 1, &rule21}, {7737, 1, &rule22}, {7738, 1, &rule21}, {7739, 1, &rule22}, {7740, 1, &rule21}, {7741, 1, &rule22}, {7742, 1, &rule21}, {7743, 1, &rule22}, {7744, 1, &rule21}, {7745, 1, &rule22}, {7746, 1, &rule21}, {7747, 1, &rule22}, {7748, 1, &rule21}, {7749, 1, &rule22}, {7750, 1, &rule21}, {7751, 1, &rule22}, {7752, 1, &rule21}, {7753, 1, &rule22}, {7754, 1, &rule21}, {7755, 1, &rule22}, {7756, 1, &rule21}, {7757, 1, &rule22}, {7758, 1, &rule21}, {7759, 1, &rule22}, {7760, 1, &rule21}, {7761, 1, &rule22}, {7762, 1, &rule21}, {7763, 1, &rule22}, {7764, 1, &rule21}, {7765, 1, &rule22}, {7766, 1, &rule21}, {7767, 1, &rule22}, {7768, 1, &rule21}, {7769, 1, &rule22}, {7770, 1, &rule21}, {7771, 1, &rule22}, {7772, 1, &rule21}, {7773, 1, &rule22}, {7774, 1, &rule21}, {7775, 1, &rule22}, {7776, 1, &rule21}, {7777, 1, &rule22}, {7778, 1, &rule21}, {7779, 1, &rule22}, {7780, 1, &rule21}, {7781, 1, &rule22}, {7782, 1, &rule21}, {7783, 1, &rule22}, {7784, 1, &rule21}, {7785, 1, &rule22}, {7786, 1, &rule21}, {7787, 1, &rule22}, {7788, 1, &rule21}, {7789, 1, &rule22}, {7790, 1, &rule21}, {7791, 1, &rule22}, {7792, 1, &rule21}, {7793, 1, &rule22}, {7794, 1, &rule21}, {7795, 1, &rule22}, {7796, 1, &rule21}, {7797, 1, &rule22}, {7798, 1, &rule21}, {7799, 1, &rule22}, {7800, 1, &rule21}, {7801, 1, &rule22}, {7802, 1, &rule21}, {7803, 1, &rule22}, {7804, 1, &rule21}, {7805, 1, &rule22}, {7806, 1, &rule21}, {7807, 1, &rule22}, {7808, 1, &rule21}, {7809, 1, &rule22}, {7810, 1, &rule21}, {7811, 1, &rule22}, {7812, 1, &rule21}, {7813, 1, &rule22}, {7814, 1, &rule21}, {7815, 1, &rule22}, {7816, 1, &rule21}, {7817, 1, &rule22}, {7818, 1, &rule21}, {7819, 1, &rule22}, {7820, 1, &rule21}, {7821, 1, &rule22}, {7822, 1, &rule21}, {7823, 1, &rule22}, {7824, 1, &rule21}, {7825, 1, &rule22}, {7826, 1, &rule21}, {7827, 1, &rule22}, {7828, 1, &rule21}, {7829, 1, &rule22}, {7835, 1, &rule94}, {7840, 1, &rule21}, {7841, 1, &rule22}, {7842, 1, &rule21}, {7843, 1, &rule22}, {7844, 1, &rule21}, {7845, 1, &rule22}, {7846, 1, &rule21}, {7847, 1, &rule22}, {7848, 1, &rule21}, {7849, 1, &rule22}, {7850, 1, &rule21}, {7851, 1, &rule22}, {7852, 1, &rule21}, {7853, 1, &rule22}, {7854, 1, &rule21}, {7855, 1, &rule22}, {7856, 1, &rule21}, {7857, 1, &rule22}, {7858, 1, &rule21}, {7859, 1, &rule22}, {7860, 1, &rule21}, {7861, 1, &rule22}, {7862, 1, &rule21}, {7863, 1, &rule22}, {7864, 1, &rule21}, {7865, 1, &rule22}, {7866, 1, &rule21}, {7867, 1, &rule22}, {7868, 1, &rule21}, {7869, 1, &rule22}, {7870, 1, &rule21}, {7871, 1, &rule22}, {7872, 1, &rule21}, {7873, 1, &rule22}, {7874, 1, &rule21}, {7875, 1, &rule22}, {7876, 1, &rule21}, {7877, 1, &rule22}, {7878, 1, &rule21}, {7879, 1, &rule22}, {7880, 1, &rule21}, {7881, 1, &rule22}, {7882, 1, &rule21}, {7883, 1, &rule22}, {7884, 1, &rule21}, {7885, 1, &rule22}, {7886, 1, &rule21}, {7887, 1, &rule22}, {7888, 1, &rule21}, {7889, 1, &rule22}, {7890, 1, &rule21}, {7891, 1, &rule22}, {7892, 1, &rule21}, {7893, 1, &rule22}, {7894, 1, &rule21}, {7895, 1, &rule22}, {7896, 1, &rule21}, {7897, 1, &rule22}, {7898, 1, &rule21}, {7899, 1, &rule22}, {7900, 1, &rule21}, {7901, 1, &rule22}, {7902, 1, &rule21}, {7903, 1, &rule22}, {7904, 1, &rule21}, {7905, 1, &rule22}, {7906, 1, &rule21}, {7907, 1, &rule22}, {7908, 1, &rule21}, {7909, 1, &rule22}, {7910, 1, &rule21}, {7911, 1, &rule22}, {7912, 1, &rule21}, {7913, 1, &rule22}, {7914, 1, &rule21}, {7915, 1, &rule22}, {7916, 1, &rule21}, {7917, 1, &rule22}, {7918, 1, &rule21}, {7919, 1, &rule22}, {7920, 1, &rule21}, {7921, 1, &rule22}, {7922, 1, &rule21}, {7923, 1, &rule22}, {7924, 1, &rule21}, {7925, 1, &rule22}, {7926, 1, &rule21}, {7927, 1, &rule22}, {7928, 1, &rule21}, {7929, 1, &rule22}, {7936, 8, &rule95}, {7944, 8, &rule96}, {7952, 6, &rule95}, {7960, 6, &rule96}, {7968, 8, &rule95}, {7976, 8, &rule96}, {7984, 8, &rule95}, {7992, 8, &rule96}, {8000, 6, &rule95}, {8008, 6, &rule96}, {8017, 1, &rule95}, {8019, 1, &rule95}, {8021, 1, &rule95}, {8023, 1, &rule95}, {8025, 1, &rule96}, {8027, 1, &rule96}, {8029, 1, &rule96}, {8031, 1, &rule96}, {8032, 8, &rule95}, {8040, 8, &rule96}, {8048, 2, &rule97}, {8050, 4, &rule98}, {8054, 2, &rule99}, {8056, 2, &rule100}, {8058, 2, &rule101}, {8060, 2, &rule102}, {8064, 8, &rule95}, {8072, 8, &rule103}, {8080, 8, &rule95}, {8088, 8, &rule103}, {8096, 8, &rule95}, {8104, 8, &rule103}, {8112, 2, &rule95}, {8115, 1, &rule104}, {8120, 2, &rule96}, {8122, 2, &rule105}, {8124, 1, &rule106}, {8126, 1, &rule107}, {8131, 1, &rule104}, {8136, 4, &rule108}, {8140, 1, &rule106}, {8144, 2, &rule95}, {8152, 2, &rule96}, {8154, 2, &rule109}, {8160, 2, &rule95}, {8165, 1, &rule84}, {8168, 2, &rule96}, {8170, 2, &rule110}, {8172, 1, &rule87}, {8179, 1, &rule104}, {8184, 2, &rule111}, {8186, 2, &rule112}, {8188, 1, &rule106}, {8486, 1, &rule115}, {8490, 1, &rule116}, {8491, 1, &rule117}, {8544, 16, &rule118}, {8560, 16, &rule119}, {9398, 26, &rule120}, {9424, 26, &rule121}, {65313, 26, &rule9}, {65345, 26, &rule12}, {66560, 40, &rule124}, {66600, 40, &rule125} }; static const struct _charblock_ spacechars[]={ {32, 1, &rule1}, {160, 1, &rule1}, {5760, 1, &rule1}, {6158, 1, &rule1}, {8192, 12, &rule1}, {8239, 1, &rule1}, {8287, 1, &rule1}, {12288, 1, &rule1} }; /* Obtain the reference to character rule by doing binary search over the specified array of blocks. To make checkattr shorter, the address of nullrule is returned if the search fails: this rule defines no category and no conversion distances. The compare function returns 0 when key->start is within the block. Otherwise result of comparison of key->start and start of the current block is returned as usual. */ static const struct _convrule_ nullrule={0,NUMCAT_CN,0,0,0,0}; static int blkcmp(const void *vk,const void *vb) { const struct _charblock_ *key,*cur; key=vk; cur=vb; if((key->start>=cur->start)&&(key->start<(cur->start+cur->length))) { return 0; } if(key->start>cur->start) return 1; return -1; } static const struct _convrule_ *getrule( const struct _charblock_ *blocks, int numblocks, int unichar) { struct _charblock_ key={unichar,1,(void *)0}; struct _charblock_ *cb=bsearch(&key,blocks,numblocks,sizeof(key),blkcmp); if(cb==(void *)0) return &nullrule; return cb->rule; } /* Check whether a character (internal code) has certain attributes. Attributes (category flags) may be ORed. The function ANDs character category flags and the mask and returns the result. If the character belongs to one of the categories requested, the result will be nonzero. */ inline static int checkattr(int c,unsigned int catmask) { return (catmask & (getrule(allchars,(c<256)?NUM_LAT1BLOCKS:NUM_BLOCKS,c)->category)); } inline static int checkattr_s(int c,unsigned int catmask) { return (catmask & (getrule(spacechars,NUM_SPACEBLOCKS,c)->category)); } /* Define predicate functions for some combinations of categories. */ #define unipred(p,m) \ int p(int c) \ { \ return checkattr(c,m); \ } #define unipred_s(p,m) \ int p(int c) \ { \ return checkattr_s(c,m); \ } /* Make these rules as close to Hugs as possible. */ unipred(u_iswcntrl,GENCAT_CC) unipred(u_iswprint, \ (GENCAT_MC | GENCAT_NO | GENCAT_SK | GENCAT_ME | GENCAT_ND | \ GENCAT_PO | GENCAT_LT | GENCAT_PC | GENCAT_SM | GENCAT_ZS | \ GENCAT_LU | GENCAT_PD | GENCAT_SO | GENCAT_PE | GENCAT_PF | \ GENCAT_PS | GENCAT_SC | GENCAT_LL | GENCAT_LM | GENCAT_PI | \ GENCAT_NL | GENCAT_MN | GENCAT_LO)) unipred_s(u_iswspace,GENCAT_ZS) unipred(u_iswupper,(GENCAT_LU|GENCAT_LT)) unipred(u_iswlower,GENCAT_LL) unipred(u_iswalpha,(GENCAT_LL|GENCAT_LU|GENCAT_LT|GENCAT_LM|GENCAT_LO)) unipred(u_iswalnum,(GENCAT_LT|GENCAT_LU|GENCAT_LL|GENCAT_LM|GENCAT_LO| GENCAT_MC|GENCAT_ME|GENCAT_MN| GENCAT_NO|GENCAT_ND|GENCAT_NL)) #define caseconv(p,to) \ int p(int c) \ { \ const struct _convrule_ *rule=getrule(convchars,NUM_CONVBLOCKS,c);\ if(rule==&nullrule) return c;\ return c+rule->to;\ } caseconv(u_towupper,updist) caseconv(u_towlower,lowdist) caseconv(u_towtitle,titledist) int u_gencat(int c) { return getrule(allchars,NUM_BLOCKS,c)->catnumber; } hugs98-plus-Sep2006/packages/base/cbits/PrelIOUtils.c0000644006511100651110000000021510504340221021063 0ustar rossross/* * (c) The University of Glasgow 2002 * * static versions of the inline functions in HsCore.h */ #define INLINE #include "HsBase.h" hugs98-plus-Sep2006/packages/base/cbits/inputReady.c0000644006511100651110000000411510504340225021043 0ustar rossross/* * (c) The GRASP/AQUA Project, Glasgow University, 1994-2002 * * hWaitForInput Runtime Support */ /* select and supporting types is not Posix */ /* #include "PosixSource.h" */ #include "HsBase.h" /* * inputReady(fd) checks to see whether input is available on the file * descriptor 'fd'. Input meaning 'can I safely read at least a * *character* from this file object without blocking?' */ int inputReady(int fd, int msecs, int isSock) { if #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) ( isSock ) { #else ( 1 ) { #endif int maxfd, ready; fd_set rfd; struct timeval tv; FD_ZERO(&rfd); FD_SET(fd, &rfd); /* select() will consider the descriptor set in the range of 0 to * (maxfd-1) */ maxfd = fd + 1; tv.tv_sec = msecs / 1000; tv.tv_usec = (msecs % 1000) * 1000; while ((ready = select(maxfd, &rfd, NULL, NULL, &tv)) < 0 ) { if (errno != EINTR ) { return -1; } } /* 1 => Input ready, 0 => not ready, -1 => error */ return (ready); } #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) else { DWORD rc; HANDLE hFile = (HANDLE)_get_osfhandle(fd); DWORD avail; // WaitForMultipleObjects() works for Console input, but it // doesn't work for pipes (it always returns WAIT_OBJECT_0 // even when no data is available). There doesn't seem to be // an easy way to distinguish the two kinds of HANDLE, so we // try to detect pipe input first, and if that fails we try // WaitForMultipleObjects(). // rc = PeekNamedPipe( hFile, NULL, 0, NULL, &avail, NULL ); if (rc != 0) { if (avail != 0) { return 1; } else { return 0; } } else { rc = GetLastError(); if (rc == ERROR_BROKEN_PIPE) { return 1; // this is probably what we want } if (rc != ERROR_INVALID_HANDLE) { return -1; } } rc = WaitForMultipleObjects( 1, &hFile, TRUE, /* wait all */ msecs); /*millisecs*/ /* 1 => Input ready, 0 => not ready, -1 => error */ switch (rc) { case WAIT_TIMEOUT: return 0; case WAIT_OBJECT_0: return 1; default: return -1; } } #endif } hugs98-plus-Sep2006/packages/base/cbits/dirUtils.c0000644006511100651110000001242510504340225020521 0ustar rossross/* * (c) The University of Glasgow 2002 * * Directory Runtime Support */ /* needed only for solaris2_HOST_OS */ #include "ghcconfig.h" // The following is required on Solaris to force the POSIX versions of // the various _r functions instead of the Solaris versions. #ifdef solaris2_HOST_OS #define _POSIX_PTHREAD_SEMANTICS #endif #include "HsBase.h" #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) #include static int toErrno(DWORD rc) { switch (rc) { case ERROR_FILE_NOT_FOUND: return ENOENT; case ERROR_PATH_NOT_FOUND: return ENOENT; case ERROR_TOO_MANY_OPEN_FILES: return EMFILE; case ERROR_ACCESS_DENIED: return EACCES; case ERROR_INVALID_HANDLE: return EBADF; /* kinda sorta */ case ERROR_NOT_ENOUGH_MEMORY: return ENOMEM; case ERROR_INVALID_ACCESS: return EINVAL; case ERROR_INVALID_DATA: return EINVAL; case ERROR_OUTOFMEMORY: return ENOMEM; case ERROR_SHARING_VIOLATION: return EACCES; case ERROR_LOCK_VIOLATION: return EACCES; case ERROR_ALREADY_EXISTS: return EEXIST; case ERROR_BUSY: return EBUSY; case ERROR_BROKEN_PIPE: return EPIPE; case ERROR_PIPE_CONNECTED: return EBUSY; case ERROR_PIPE_LISTENING: return EBUSY; case ERROR_NOT_CONNECTED: return EINVAL; case ERROR_NOT_OWNER: return EPERM; case ERROR_DIRECTORY: return ENOTDIR; case ERROR_FILE_INVALID: return EACCES; case ERROR_FILE_EXISTS: return EEXIST; default: return rc; } } #endif /* * read an entry from the directory stream; opt for the * re-entrant friendly way of doing this, if available. */ HsInt __hscore_readdir( HsAddr dirPtr, HsAddr pDirEnt ) { struct dirent **pDirE = (struct dirent**)pDirEnt; #if HAVE_READDIR_R struct dirent* p; int res; static unsigned int nm_max = (unsigned int)-1; if (pDirE == NULL) { return -1; } if (nm_max == (unsigned int)-1) { #ifdef NAME_MAX nm_max = NAME_MAX + 1; #else nm_max = pathconf(".", _PC_NAME_MAX); if (nm_max == -1) { nm_max = 255; } nm_max++; #endif } p = (struct dirent*)malloc(sizeof(struct dirent) + nm_max); if (p == NULL) return -1; res = readdir_r((DIR*)dirPtr, p, pDirE); if (res != 0) { *pDirE = NULL; free(p); } else if (*pDirE == NULL) { // end of stream free(p); } return res; #else if (pDirE == NULL) { return -1; } *pDirE = readdir((DIR*)dirPtr); if (*pDirE == NULL) { return -1; } else { return 0; } #endif } /* * Function: __hscore_renameFile() * * Provide Haskell98's semantics for renaming files and directories. * It mirrors that of POSIX.1's behaviour for rename() by overwriting * the target if it exists (the MS CRT implementation of rename() returns * an error * */ HsInt __hscore_renameFile( HsAddr src, HsAddr dest) { #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) static int forNT = -1; /* ToDo: propagate error codes back */ if (MoveFileA(src, dest)) { return 0; } else { ; } /* Failed...it could be because the target already existed. */ if ( !GetFileAttributes(dest) ) { /* No, it's not there - just fail. */ errno = toErrno(GetLastError()); return (-1); } if (forNT == -1) { OSVERSIONINFO ovi; ovi.dwOSVersionInfoSize = sizeof(ovi); if ( !GetVersionEx(&ovi) ) { errno = toErrno(GetLastError()); return (-1); } forNT = ((ovi.dwPlatformId & VER_PLATFORM_WIN32_NT) != 0); } if (forNT) { /* Easy, go for MoveFileEx() */ if ( MoveFileExA(src, dest, MOVEFILE_REPLACE_EXISTING) ) { return 0; } else { errno = toErrno(GetLastError()); return (-1); } } /* No MoveFileEx() for Win9x, try deleting the target. */ /* Similarly, if the MoveFile*() ops didn't work out under NT */ if (DeleteFileA(dest)) { if (MoveFileA(src,dest)) { return 0; } else { errno = toErrno(GetLastError()); return (-1); } } else { errno = toErrno(GetLastError()); return (-1); } #else return rename(src,dest); #endif } /* * Function: __hscore_getFolderPath() * * Late-bound version of SHGetFolderPath(), coping with OS versions * that have shell32's lacking that particular API. * */ #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) typedef HRESULT (*HSCORE_GETAPPFOLDERFUNTY)(HWND,int,HANDLE,DWORD,char*); int __hscore_getFolderPath(HWND hwndOwner, int nFolder, HANDLE hToken, DWORD dwFlags, char* pszPath) { static int loaded_dll = 0; static HMODULE hMod = (HMODULE)NULL; static HSCORE_GETAPPFOLDERFUNTY funcPtr = NULL; /* The DLLs to try loading entry point from */ char* dlls[] = { "shell32.dll", "shfolder.dll" }; if (loaded_dll < 0) { return (-1); } else if (loaded_dll == 0) { int i; for(i=0;i < sizeof(dlls); i++) { hMod = LoadLibrary(dlls[i]); if ( hMod != NULL && (funcPtr = (HSCORE_GETAPPFOLDERFUNTY)GetProcAddress(hMod, "SHGetFolderPathA")) ) { loaded_dll = 1; break; } } if (loaded_dll == 0) { loaded_dll = (-1); return (-1); } } /* OK, if we got this far the function has been bound */ return (int)funcPtr(hwndOwner,nFolder,hToken,dwFlags,pszPath); /* ToDo: unload the DLL on shutdown? */ } #endif hugs98-plus-Sep2006/packages/base/cbits/execvpe.c0000644006511100651110000001160410504340225020357 0ustar rossross/* ----------------------------------------------------------------------------- (c) The University of Glasgow 1995-2004 Our low-level exec() variant. -------------------------------------------------------------------------- */ #include "HsBase.h" #if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) /* to the end */ /* Evidently non-Posix. */ /* #include "PosixSource.h" */ #include #include #include #include #include /* * We want the search semantics of execvp, but we want to provide our * own environment, like execve. The following copyright applies to * this code, as it is a derivative of execvp: *- * Copyright (c) 1991 The Regents of the University of California. * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ int execvpe(char *name, char *const argv[], char **envp) { register int lp, ln; register char *p; int eacces=0, etxtbsy=0; char *bp, *cur, *path, *buf = 0; /* If it's an absolute or relative path name, it's easy. */ if (strchr(name, '/')) { bp = (char *) name; cur = path = buf = NULL; goto retry; } /* Get the path we're searching. */ if (!(path = getenv("PATH"))) { #ifdef HAVE_CONFSTR ln = confstr(_CS_PATH, NULL, 0); if ((cur = path = malloc(ln + 1)) != NULL) { path[0] = ':'; (void) confstr (_CS_PATH, path + 1, ln); } #else if ((cur = path = malloc(1 + 1)) != NULL) { path[0] = ':'; path[1] = '\0'; } #endif } else cur = path = strdup(path); if (path == NULL || (bp = buf = malloc(strlen(path)+strlen(name)+2)) == NULL) goto done; while (cur != NULL) { p = cur; if ((cur = strchr(cur, ':')) != NULL) *cur++ = '\0'; /* * It's a SHELL path -- double, leading and trailing colons mean the current * directory. */ if (!*p) { p = "."; lp = 1; } else lp = strlen(p); ln = strlen(name); memcpy(buf, p, lp); buf[lp] = '/'; memcpy(buf + lp + 1, name, ln); buf[lp + ln + 1] = '\0'; retry: (void) execve(bp, argv, envp); switch (errno) { case EACCES: eacces = 1; break; case ENOENT: break; case ENOEXEC: { register size_t cnt; register char **ap; for (cnt = 0, ap = (char **) argv; *ap; ++ap, ++cnt) ; if ((ap = malloc((cnt + 2) * sizeof(char *))) != NULL) { memcpy(ap + 2, argv + 1, cnt * sizeof(char *)); ap[0] = "sh"; ap[1] = bp; (void) execve("/bin/sh", ap, envp); free(ap); } goto done; } case ETXTBSY: if (etxtbsy < 3) (void) sleep(++etxtbsy); goto retry; default: goto done; } } if (eacces) errno = EACCES; else if (!errno) errno = ENOENT; done: if (path) free(path); if (buf) free(buf); return (-1); } /* Copied verbatim from ghc/lib/std/cbits/system.c. */ void pPrPr_disableITimers (void) { # ifdef HAVE_SETITIMER /* Reset the itimers in the child, so it doesn't get plagued * by SIGVTALRM interrupts. */ struct timeval tv_null = { 0, 0 }; struct itimerval itv; itv.it_interval = tv_null; itv.it_value = tv_null; setitimer(ITIMER_REAL, &itv, NULL); setitimer(ITIMER_VIRTUAL, &itv, NULL); setitimer(ITIMER_PROF, &itv, NULL); # endif } #endif hugs98-plus-Sep2006/packages/base/cbits/lockFile.c0000644006511100651110000000512710504340225020453 0ustar rossross/* * (c) The GRASP/AQUA Project, Glasgow University, 1994-2004 * * $Id: lockFile.c,v 1.5 2005/01/28 13:36:32 simonmar Exp $ * * stdin/stout/stderr Runtime Support */ #if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) #include "HsBase.h" #include "Rts.h" #include "RtsUtils.h" typedef struct { dev_t device; ino_t inode; int fd; } Lock; static Lock readLock[FD_SETSIZE]; static Lock writeLock[FD_SETSIZE]; static int readLocks = 0; static int writeLocks = 0; int lockFile(int fd, int for_writing, int exclusive) { struct stat sb; int i; if (fd > FD_SETSIZE) { barf("lockFile: fd out of range"); } while (fstat(fd, &sb) < 0) { if (errno != EINTR) return -1; } if (for_writing) { /* opening a file for writing, check to see whether we don't have any read locks on it already.. */ for (i = 0; i < readLocks; i++) { if (readLock[i].inode == sb.st_ino && readLock[i].device == sb.st_dev) return -1; } /* If we're determined that there is only a single writer to the file, check to see whether the file hasn't already been opened for writing.. */ if (exclusive) { for (i = 0; i < writeLocks; i++) { if (writeLock[i].inode == sb.st_ino && writeLock[i].device == sb.st_dev) { return -1; } } } /* OK, everything is cool lock-wise, record it and leave. */ i = writeLocks++; writeLock[i].device = sb.st_dev; writeLock[i].inode = sb.st_ino; writeLock[i].fd = fd; return 0; } else { /* For reading, it's simpler - just check to see that there's no-one writing to the underlying file. */ for (i = 0; i < writeLocks; i++) { if (writeLock[i].inode == sb.st_ino && writeLock[i].device == sb.st_dev) return -1; } /* Fit in new entry, reusing an existing table entry, if possible. */ for (i = 0; i < readLocks; i++) { if (readLock[i].inode == sb.st_ino && readLock[i].device == sb.st_dev) { return 0; } } i = readLocks++; readLock[i].device = sb.st_dev; readLock[i].inode = sb.st_ino; readLock[i].fd = fd; return 0; } } int unlockFile(int fd) { int i; for (i = 0; i < readLocks; i++) if (readLock[i].fd == fd) { while (++i < readLocks) readLock[i - 1] = readLock[i]; readLocks--; return 0; } for (i = 0; i < writeLocks; i++) if (writeLock[i].fd == fd) { while (++i < writeLocks) writeLock[i - 1] = writeLock[i]; writeLocks--; return 0; } /* Signal that we did not find an entry */ return 1; } #endif hugs98-plus-Sep2006/packages/base/cbits/longlong.c0000644006511100651110000001117310504340221020534 0ustar rossross/* ----------------------------------------------------------------------------- * $Id: longlong.c,v 1.4 2002/12/13 14:23:42 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * * Primitive operations over (64-bit) long longs * (only used on 32-bit platforms.) * * ---------------------------------------------------------------------------*/ /* Miscellaneous primitive operations on StgInt64 and StgWord64s. N.B. These are not primops! Instead of going the normal (boring) route of making the list of primitive operations even longer to cope with operations over 64-bit entities, we implement them instead 'out-of-line'. The primitive ops get their own routine (in C) that implements the operation, requiring the caller to _ccall_ out. This has performance implications of course, but we currently don't expect intensive use of either Int64 or Word64 types. The exceptions to the rule are primops that cast to and from 64-bit entities (these are defined in PrimOps.h) */ #include "Rts.h" #ifdef SUPPORT_LONG_LONGS /* Relational operators */ StgBool stg_gtWord64 (StgWord64 a, StgWord64 b) {return a > b;} StgBool stg_geWord64 (StgWord64 a, StgWord64 b) {return a >= b;} StgBool stg_eqWord64 (StgWord64 a, StgWord64 b) {return a == b;} StgBool stg_neWord64 (StgWord64 a, StgWord64 b) {return a != b;} StgBool stg_ltWord64 (StgWord64 a, StgWord64 b) {return a < b;} StgBool stg_leWord64 (StgWord64 a, StgWord64 b) {return a <= b;} StgBool stg_gtInt64 (StgInt64 a, StgInt64 b) {return a > b;} StgBool stg_geInt64 (StgInt64 a, StgInt64 b) {return a >= b;} StgBool stg_eqInt64 (StgInt64 a, StgInt64 b) {return a == b;} StgBool stg_neInt64 (StgInt64 a, StgInt64 b) {return a != b;} StgBool stg_ltInt64 (StgInt64 a, StgInt64 b) {return a < b;} StgBool stg_leInt64 (StgInt64 a, StgInt64 b) {return a <= b;} /* Arithmetic operators */ StgWord64 stg_remWord64 (StgWord64 a, StgWord64 b) {return a % b;} StgWord64 stg_quotWord64 (StgWord64 a, StgWord64 b) {return a / b;} StgInt64 stg_remInt64 (StgInt64 a, StgInt64 b) {return a % b;} StgInt64 stg_quotInt64 (StgInt64 a, StgInt64 b) {return a / b;} StgInt64 stg_negateInt64 (StgInt64 a) {return -a;} StgInt64 stg_plusInt64 (StgInt64 a, StgInt64 b) {return a + b;} StgInt64 stg_minusInt64 (StgInt64 a, StgInt64 b) {return a - b;} StgInt64 stg_timesInt64 (StgInt64 a, StgInt64 b) {return a * b;} /* Logical operators: */ StgWord64 stg_and64 (StgWord64 a, StgWord64 b) {return a & b;} StgWord64 stg_or64 (StgWord64 a, StgWord64 b) {return a | b;} StgWord64 stg_xor64 (StgWord64 a, StgWord64 b) {return a ^ b;} StgWord64 stg_not64 (StgWord64 a) {return ~a;} StgWord64 stg_uncheckedShiftL64 (StgWord64 a, StgInt b) {return a << b;} StgWord64 stg_uncheckedShiftRL64 (StgWord64 a, StgInt b) {return a >> b;} /* Right shifting of signed quantities is not portable in C, so the behaviour you'll get from using these primops depends on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98 */ StgInt64 stg_uncheckedIShiftL64 (StgInt64 a, StgInt b) {return a << b;} StgInt64 stg_uncheckedIShiftRA64 (StgInt64 a, StgInt b) {return a >> b;} StgInt64 stg_uncheckedIShiftRL64 (StgInt64 a, StgInt b) {return (StgInt64) ((StgWord64) a >> b);} /* Casting between longs and longer longs. (the primops that cast from long longs to Integers expressed as macros, since these may cause some heap allocation). */ StgInt64 stg_intToInt64 (StgInt i) {return (StgInt64) i;} StgInt stg_int64ToInt (StgInt64 i) {return (StgInt) i;} StgWord64 stg_int64ToWord64 (StgInt64 i) {return (StgWord64) i;} StgWord64 stg_wordToWord64 (StgWord w) {return (StgWord64) w;} StgWord stg_word64ToWord (StgWord64 w) {return (StgWord) w;} StgInt64 stg_word64ToInt64 (StgWord64 w) {return (StgInt64) w;} StgWord64 stg_integerToWord64 (I_ sa, StgByteArray /* Really: mp_limb_t* */ da) { mp_limb_t* d; I_ s; StgWord64 res; d = (mp_limb_t *)da; s = sa; switch (s) { case 0: res = 0; break; case 1: res = d[0]; break; case -1: res = -(StgWord64)d[0]; break; default: res = (StgWord64)d[0] + ((StgWord64)d[1] << (BITS_IN (mp_limb_t))); if (s < 0) res = -res; } return res; } StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da) { mp_limb_t* d; I_ s; StgInt64 res; d = (mp_limb_t *)da; s = (sa); switch (s) { case 0: res = 0; break; case 1: res = d[0]; break; case -1: res = -(StgInt64)d[0]; break; default: res = (StgInt64)d[0] + ((StgWord64)d[1] << (BITS_IN (mp_limb_t))); if (s < 0) res = -res; } return res; } #endif /* SUPPORT_LONG_LONGS */ hugs98-plus-Sep2006/packages/base/cbits/runProcess.c0000644006511100651110000003411710504340225021067 0ustar rossross/* ---------------------------------------------------------------------------- (c) The University of Glasgow 2004 Support for System.Process ------------------------------------------------------------------------- */ #include "HsBase.h" #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) #include #include #endif #ifdef HAVE_VFORK_H #include #endif #ifdef HAVE_VFORK #define fork vfork #endif #ifdef HAVE_SIGNAL_H #include #endif #if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) /* ---------------------------------------------------------------------------- UNIX versions ------------------------------------------------------------------------- */ ProcHandle runProcess (char *const args[], char *workingDirectory, char **environment, int fdStdInput, int fdStdOutput, int fdStdError, int set_inthandler, long inthandler, int set_quithandler, long quithandler) { int pid; struct sigaction dfl; switch(pid = fork()) { case -1: return -1; case 0: { pPrPr_disableITimers(); if (workingDirectory) { if (chdir (workingDirectory) < 0) { return -1; } } /* Set the SIGINT/SIGQUIT signal handlers in the child, if requested */ (void)sigemptyset(&dfl.sa_mask); dfl.sa_flags = 0; if (set_inthandler) { dfl.sa_handler = (void *)inthandler; (void)sigaction(SIGINT, &dfl, NULL); } if (set_quithandler) { dfl.sa_handler = (void *)quithandler; (void)sigaction(SIGQUIT, &dfl, NULL); } dup2 (fdStdInput, STDIN_FILENO); dup2 (fdStdOutput, STDOUT_FILENO); dup2 (fdStdError, STDERR_FILENO); if (environment) { execvpe(args[0], args, environment); } else { execvp(args[0], args); } } _exit(127); } return pid; } ProcHandle runInteractiveProcess (char *const args[], char *workingDirectory, char **environment, int *pfdStdInput, int *pfdStdOutput, int *pfdStdError) { int pid; int fdStdInput[2], fdStdOutput[2], fdStdError[2]; pipe(fdStdInput); pipe(fdStdOutput); pipe(fdStdError); switch(pid = fork()) { case -1: close(fdStdInput[0]); close(fdStdInput[1]); close(fdStdOutput[0]); close(fdStdOutput[1]); close(fdStdError[0]); close(fdStdError[1]); return -1; case 0: { pPrPr_disableITimers(); if (workingDirectory) { if (chdir (workingDirectory) < 0) { return -1; } } if (fdStdInput[0] != STDIN_FILENO) { dup2 (fdStdInput[0], STDIN_FILENO); close(fdStdInput[0]); } if (fdStdOutput[1] != STDOUT_FILENO) { dup2 (fdStdOutput[1], STDOUT_FILENO); close(fdStdOutput[1]); } if (fdStdError[1] != STDERR_FILENO) { dup2 (fdStdError[1], STDERR_FILENO); close(fdStdError[1]); } close(fdStdInput[1]); close(fdStdOutput[0]); close(fdStdError[0]); /* the child */ if (environment) { execvpe(args[0], args, environment); } else { execvp(args[0], args); } } _exit(127); default: close(fdStdInput[0]); close(fdStdOutput[1]); close(fdStdError[1]); *pfdStdInput = fdStdInput[1]; *pfdStdOutput = fdStdOutput[0]; *pfdStdError = fdStdError[0]; break; } return pid; } int terminateProcess (ProcHandle handle) { return (kill(handle, SIGTERM) == 0); } int getProcessExitCode (ProcHandle handle, int *pExitCode) { int wstat, res; *pExitCode = 0; if ((res = waitpid(handle, &wstat, WNOHANG)) > 0) { if (WIFEXITED(wstat)) { *pExitCode = WEXITSTATUS(wstat); return 1; } else if (WIFSIGNALED(wstat)) { errno = EINTR; return -1; } else { /* This should never happen */ } } if (res == 0) return 0; if (errno == ECHILD) { *pExitCode = 0; return 1; } return -1; } int waitForProcess (ProcHandle handle) { int wstat; while (waitpid(handle, &wstat, 0) < 0) { if (errno != EINTR) { return -1; } } if (WIFEXITED(wstat)) return WEXITSTATUS(wstat); else if (WIFSIGNALED(wstat)) { return wstat; } else { /* This should never happen */ } return -1; } #else /* ---------------------------------------------------------------------------- Win32 versions ------------------------------------------------------------------------- */ /* -------------------- WINDOWS VERSION --------------------- */ /* This is the error table that defines the mapping between OS error codes and errno values */ struct errentry { unsigned long oscode; /* OS return value */ int errnocode; /* System V error code */ }; static struct errentry errtable[] = { { ERROR_INVALID_FUNCTION, EINVAL }, /* 1 */ { ERROR_FILE_NOT_FOUND, ENOENT }, /* 2 */ { ERROR_PATH_NOT_FOUND, ENOENT }, /* 3 */ { ERROR_TOO_MANY_OPEN_FILES, EMFILE }, /* 4 */ { ERROR_ACCESS_DENIED, EACCES }, /* 5 */ { ERROR_INVALID_HANDLE, EBADF }, /* 6 */ { ERROR_ARENA_TRASHED, ENOMEM }, /* 7 */ { ERROR_NOT_ENOUGH_MEMORY, ENOMEM }, /* 8 */ { ERROR_INVALID_BLOCK, ENOMEM }, /* 9 */ { ERROR_BAD_ENVIRONMENT, E2BIG }, /* 10 */ { ERROR_BAD_FORMAT, ENOEXEC }, /* 11 */ { ERROR_INVALID_ACCESS, EINVAL }, /* 12 */ { ERROR_INVALID_DATA, EINVAL }, /* 13 */ { ERROR_INVALID_DRIVE, ENOENT }, /* 15 */ { ERROR_CURRENT_DIRECTORY, EACCES }, /* 16 */ { ERROR_NOT_SAME_DEVICE, EXDEV }, /* 17 */ { ERROR_NO_MORE_FILES, ENOENT }, /* 18 */ { ERROR_LOCK_VIOLATION, EACCES }, /* 33 */ { ERROR_BAD_NETPATH, ENOENT }, /* 53 */ { ERROR_NETWORK_ACCESS_DENIED, EACCES }, /* 65 */ { ERROR_BAD_NET_NAME, ENOENT }, /* 67 */ { ERROR_FILE_EXISTS, EEXIST }, /* 80 */ { ERROR_CANNOT_MAKE, EACCES }, /* 82 */ { ERROR_FAIL_I24, EACCES }, /* 83 */ { ERROR_INVALID_PARAMETER, EINVAL }, /* 87 */ { ERROR_NO_PROC_SLOTS, EAGAIN }, /* 89 */ { ERROR_DRIVE_LOCKED, EACCES }, /* 108 */ { ERROR_BROKEN_PIPE, EPIPE }, /* 109 */ { ERROR_DISK_FULL, ENOSPC }, /* 112 */ { ERROR_INVALID_TARGET_HANDLE, EBADF }, /* 114 */ { ERROR_INVALID_HANDLE, EINVAL }, /* 124 */ { ERROR_WAIT_NO_CHILDREN, ECHILD }, /* 128 */ { ERROR_CHILD_NOT_COMPLETE, ECHILD }, /* 129 */ { ERROR_DIRECT_ACCESS_HANDLE, EBADF }, /* 130 */ { ERROR_NEGATIVE_SEEK, EINVAL }, /* 131 */ { ERROR_SEEK_ON_DEVICE, EACCES }, /* 132 */ { ERROR_DIR_NOT_EMPTY, ENOTEMPTY }, /* 145 */ { ERROR_NOT_LOCKED, EACCES }, /* 158 */ { ERROR_BAD_PATHNAME, ENOENT }, /* 161 */ { ERROR_MAX_THRDS_REACHED, EAGAIN }, /* 164 */ { ERROR_LOCK_FAILED, EACCES }, /* 167 */ { ERROR_ALREADY_EXISTS, EEXIST }, /* 183 */ { ERROR_FILENAME_EXCED_RANGE, ENOENT }, /* 206 */ { ERROR_NESTING_NOT_ALLOWED, EAGAIN }, /* 215 */ { ERROR_NOT_ENOUGH_QUOTA, ENOMEM } /* 1816 */ }; /* size of the table */ #define ERRTABLESIZE (sizeof(errtable)/sizeof(errtable[0])) /* The following two constants must be the minimum and maximum values in the (contiguous) range of Exec Failure errors. */ #define MIN_EXEC_ERROR ERROR_INVALID_STARTING_CODESEG #define MAX_EXEC_ERROR ERROR_INFLOOP_IN_RELOC_CHAIN /* These are the low and high value in the range of errors that are access violations */ #define MIN_EACCES_RANGE ERROR_WRITE_PROTECT #define MAX_EACCES_RANGE ERROR_SHARING_BUFFER_EXCEEDED static void maperrno (void) { int i; DWORD dwErrorCode; dwErrorCode = GetLastError(); /* check the table for the OS error code */ for (i = 0; i < ERRTABLESIZE; ++i) { if (dwErrorCode == errtable[i].oscode) { errno = errtable[i].errnocode; return; } } /* The error code wasn't in the table. We check for a range of */ /* EACCES errors or exec failure errors (ENOEXEC). Otherwise */ /* EINVAL is returned. */ if (dwErrorCode >= MIN_EACCES_RANGE && dwErrorCode <= MAX_EACCES_RANGE) errno = EACCES; else if (dwErrorCode >= MIN_EXEC_ERROR && dwErrorCode <= MAX_EXEC_ERROR) errno = ENOEXEC; else errno = EINVAL; } /* * Function: mkAnonPipe * * Purpose: create an anonymous pipe with read and write ends being * optionally (non-)inheritable. */ static BOOL mkAnonPipe (HANDLE* pHandleIn, BOOL isInheritableIn, HANDLE* pHandleOut, BOOL isInheritableOut) { HANDLE hTemporaryIn = NULL; HANDLE hTemporaryOut = NULL; BOOL status; SECURITY_ATTRIBUTES sec_attrs; /* Create inheritable security attributes */ sec_attrs.nLength = sizeof(SECURITY_ATTRIBUTES); sec_attrs.lpSecurityDescriptor = NULL; sec_attrs.bInheritHandle = TRUE; /* Create the anon pipe with both ends inheritable */ if (!CreatePipe(&hTemporaryIn, &hTemporaryOut, &sec_attrs, 0)) { maperrno(); *pHandleIn = NULL; *pHandleOut = NULL; return FALSE; } if (isInheritableIn) *pHandleIn = hTemporaryIn; else { /* Make the read end non-inheritable */ status = DuplicateHandle(GetCurrentProcess(), hTemporaryIn, GetCurrentProcess(), pHandleIn, 0, FALSE, /* non-inheritable */ DUPLICATE_SAME_ACCESS); CloseHandle(hTemporaryIn); if (!status) { maperrno(); *pHandleIn = NULL; *pHandleOut = NULL; CloseHandle(hTemporaryOut); return FALSE; } } if (isInheritableOut) *pHandleOut = hTemporaryOut; else { /* Make the write end non-inheritable */ status = DuplicateHandle(GetCurrentProcess(), hTemporaryOut, GetCurrentProcess(), pHandleOut, 0, FALSE, /* non-inheritable */ DUPLICATE_SAME_ACCESS); CloseHandle(hTemporaryOut); if (!status) { maperrno(); *pHandleIn = NULL; *pHandleOut = NULL; CloseHandle(*pHandleIn); return FALSE; } } return TRUE; } ProcHandle runProcess (char *cmd, char *workingDirectory, void *environment, int fdStdInput, int fdStdOutput, int fdStdError) { STARTUPINFO sInfo; PROCESS_INFORMATION pInfo; DWORD flags; char buffer[256]; ZeroMemory(&sInfo, sizeof(sInfo)); sInfo.cb = sizeof(sInfo); sInfo.hStdInput = (HANDLE) _get_osfhandle(fdStdInput); sInfo.hStdOutput= (HANDLE) _get_osfhandle(fdStdOutput); sInfo.hStdError = (HANDLE) _get_osfhandle(fdStdError); if (sInfo.hStdInput == INVALID_HANDLE_VALUE) sInfo.hStdInput = NULL; if (sInfo.hStdOutput == INVALID_HANDLE_VALUE) sInfo.hStdOutput = NULL; if (sInfo.hStdError == INVALID_HANDLE_VALUE) sInfo.hStdError = NULL; if (sInfo.hStdInput || sInfo.hStdOutput || sInfo.hStdError) sInfo.dwFlags = STARTF_USESTDHANDLES; if (sInfo.hStdInput != GetStdHandle(STD_INPUT_HANDLE) && sInfo.hStdOutput != GetStdHandle(STD_OUTPUT_HANDLE) && sInfo.hStdError != GetStdHandle(STD_ERROR_HANDLE)) flags = CREATE_NO_WINDOW; // Run without console window only when both output and error are redirected else flags = 0; if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, flags, environment, workingDirectory, &sInfo, &pInfo)) { maperrno(); return -1; } CloseHandle(pInfo.hThread); return (ProcHandle)pInfo.hProcess; } ProcHandle runInteractiveProcess (char *cmd, char *workingDirectory, void *environment, int *pfdStdInput, int *pfdStdOutput, int *pfdStdError) { STARTUPINFO sInfo; PROCESS_INFORMATION pInfo; HANDLE hStdInputRead, hStdInputWrite; HANDLE hStdOutputRead, hStdOutputWrite; HANDLE hStdErrorRead, hStdErrorWrite; if (!mkAnonPipe(&hStdInputRead, TRUE, &hStdInputWrite, FALSE)) return -1; if (!mkAnonPipe(&hStdOutputRead, FALSE, &hStdOutputWrite, TRUE)) { CloseHandle(hStdInputRead); CloseHandle(hStdInputWrite); return -1; } if (!mkAnonPipe(&hStdErrorRead, FALSE, &hStdErrorWrite, TRUE)) { CloseHandle(hStdInputRead); CloseHandle(hStdInputWrite); CloseHandle(hStdOutputRead); CloseHandle(hStdOutputWrite); return -1; } ZeroMemory(&sInfo, sizeof(sInfo)); sInfo.cb = sizeof(sInfo); sInfo.dwFlags = STARTF_USESTDHANDLES; sInfo.hStdInput = hStdInputRead; sInfo.hStdOutput= hStdOutputWrite; sInfo.hStdError = hStdErrorWrite; if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, CREATE_NO_WINDOW, environment, workingDirectory, &sInfo, &pInfo)) { maperrno(); CloseHandle(hStdInputRead); CloseHandle(hStdInputWrite); CloseHandle(hStdOutputRead); CloseHandle(hStdOutputWrite); CloseHandle(hStdErrorRead); CloseHandle(hStdErrorWrite); return -1; } CloseHandle(pInfo.hThread); // Close the ends of the pipes that were inherited by the // child process. This is important, otherwise we won't see // EOF on these pipes when the child process exits. CloseHandle(hStdInputRead); CloseHandle(hStdOutputWrite); CloseHandle(hStdErrorWrite); *pfdStdInput = _open_osfhandle((intptr_t) hStdInputWrite, _O_WRONLY); *pfdStdOutput = _open_osfhandle((intptr_t) hStdOutputRead, _O_RDONLY); *pfdStdError = _open_osfhandle((intptr_t) hStdErrorRead, _O_RDONLY); return (int) pInfo.hProcess; } int terminateProcess (ProcHandle handle) { if (!TerminateProcess((HANDLE) handle, 1)) { maperrno(); return -1; } return 0; } int getProcessExitCode (ProcHandle handle, int *pExitCode) { *pExitCode = 0; if (WaitForSingleObject((HANDLE) handle, 1) == WAIT_OBJECT_0) { if (GetExitCodeProcess((HANDLE) handle, (DWORD *) pExitCode) == 0) { maperrno(); return -1; } return 1; } return 0; } int waitForProcess (ProcHandle handle) { DWORD retCode; if (WaitForSingleObject((HANDLE) handle, INFINITE) == WAIT_OBJECT_0) { if (GetExitCodeProcess((HANDLE) handle, &retCode) == 0) { maperrno(); return -1; } return retCode; } maperrno(); return -1; } #endif /* Win32 */ hugs98-plus-Sep2006/packages/base/cbits/selectUtils.c0000644006511100651110000000010310504340221021204 0ustar rossross #include "HsBase.h" void hsFD_ZERO(fd_set *fds) { FD_ZERO(fds); } hugs98-plus-Sep2006/packages/base/cbits/timeUtils.c0000644006511100651110000000046410504340225020701 0ustar rossross/* * (c) The University of Glasgow 2002 * * Time Runtime Support */ #include "HsBase.h" #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) /* to the end */ HsAddr __hscore_timezone( void ) { return (HsAddr)&_timezone; } HsAddr __hscore_tzname( void ) { return (HsAddr)_tzname; } #endif hugs98-plus-Sep2006/packages/base/cbits/ubconfc0000644006511100651110000001745110504340221020120 0ustar rossross#!/bin/sh # -------------------------------------------------------------------------- # This is the script to create the unicode chars property table # Written by Dimitry Golubovsky (dimitry@golubovsky.org) as part # of the Partial Unicode Support patch # # Adopted for use with GHC. # License: see libraries/base/LICENSE # # ------------------------------------------------------------------------- # The script reads the file from the standard input, # and outputs C code into the standard output. # The C code contains the chars property table, and basic functions # to access properties. # Output the file header echo "/*-------------------------------------------------------------------------" echo "This is an automatically generated file: do not edit" echo "Generated by `basename $0` at `date`" echo "-------------------------------------------------------------------------*/" echo echo "#include \"WCsubst.h\"" # Define structures cat <")!=0) { dumpblock() } else if (index(name,"Last>")!=0) { blockl+=(self-blockb) } else if((self==blockb+blockl)&&(rule==blockr)) blockl++ else { dumpblock() } } } END { dumpblock() for(c in cats) print "#define GENCAT_"c" "cats[c] print "#define MAX_UNI_CHAR " self print "#define NUM_BLOCKS " blockidx print "#define NUM_CONVBLOCKS " cblckidx print "#define NUM_SPACEBLOCKS " sblckidx print "#define NUM_LAT1BLOCKS " lat1idx print "#define NUM_RULES " rulidx for(r in rules) { printf "static const struct _convrule_ rule" rules[r] "={" r "};\n" } print "static const struct _charblock_ allchars[]={" for(i=0;istart is within the block. Otherwise result of comparison of key->start and start of the current block is returned as usual. */ static const struct _convrule_ nullrule={0,NUMCAT_CN,0,0,0,0}; int blkcmp(const void *vk,const void *vb) { const struct _charblock_ *key,*cur; key=vk; cur=vb; if((key->start>=cur->start)&&(key->start<(cur->start+cur->length))) { return 0; } if(key->start>cur->start) return 1; return -1; } static const struct _convrule_ *getrule( const struct _charblock_ *blocks, int numblocks, int unichar) { struct _charblock_ key={unichar,1,(void *)0}; struct _charblock_ *cb=bsearch(&key,blocks,numblocks,sizeof(key),blkcmp); if(cb==(void *)0) return &nullrule; return cb->rule; } /* Check whether a character (internal code) has certain attributes. Attributes (category flags) may be ORed. The function ANDs character category flags and the mask and returns the result. If the character belongs to one of the categories requested, the result will be nonzero. */ inline static int checkattr(int c,unsigned int catmask) { return (catmask & (getrule(allchars,(c<256)?NUM_LAT1BLOCKS:NUM_BLOCKS,c)->category)); } inline static int checkattr_s(int c,unsigned int catmask) { return (catmask & (getrule(spacechars,NUM_SPACEBLOCKS,c)->category)); } /* Define predicate functions for some combinations of categories. */ #define unipred(p,m) \\ int p(int c) \\ { \\ return checkattr(c,m); \\ } #define unipred_s(p,m) \\ int p(int c) \\ { \\ return checkattr_s(c,m); \\ } /* Make these rules as close to Hugs as possible. */ unipred(u_iswcntrl,GENCAT_CC) unipred(u_iswprint, \ (GENCAT_MC | GENCAT_NO | GENCAT_SK | GENCAT_ME | GENCAT_ND | \ GENCAT_PO | GENCAT_LT | GENCAT_PC | GENCAT_SM | GENCAT_ZS | \ GENCAT_LU | GENCAT_PD | GENCAT_SO | GENCAT_PE | GENCAT_PF | \ GENCAT_PS | GENCAT_SC | GENCAT_LL | GENCAT_LM | GENCAT_PI | \ GENCAT_NL | GENCAT_MN | GENCAT_LO)) unipred_s(u_iswspace,GENCAT_ZS) unipred(u_iswupper,(GENCAT_LU|GENCAT_LT)) unipred(u_iswlower,GENCAT_LL) unipred(u_iswalpha,(GENCAT_LL|GENCAT_LU|GENCAT_LT|GENCAT_LM|GENCAT_LO)) unipred(u_iswdigit,GENCAT_ND) unipred(u_iswalnum,(GENCAT_LT|GENCAT_LU|GENCAT_LL|GENCAT_LM|GENCAT_LO| GENCAT_MC|GENCAT_ME|GENCAT_MN| GENCAT_NO|GENCAT_ND|GENCAT_NL)) #define caseconv(p,to) \\ int p(int c) \\ { \\ const struct _convrule_ *rule=getrule(convchars,NUM_CONVBLOCKS,c);\\ if(rule==&nullrule) return c;\\ return c+rule->##to;\\ } caseconv(u_towupper,updist) caseconv(u_towlower,lowdist) caseconv(u_towtitle,titledist) int u_gencat(int c) { return getrule(allchars,NUM_BLOCKS,c)->catnumber; } EOF hugs98-plus-Sep2006/packages/base/cbits/fpstring.c0000644006511100651110000000545010504340226020557 0ustar rossross/* * Copyright (c) 2003 David Roundy * Copyright (c) 2005-6 Don Stewart * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the names of the authors or the names of any contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "fpstring.h" /* copy a string in reverse */ void fps_reverse(unsigned char *q, unsigned char *p, unsigned long n) { p += n-1; while (n-- != 0) *q++ = *p--; } /* duplicate a string, interspersing the character through the elements of the duplicated string */ void fps_intersperse(unsigned char *q, unsigned char *p, unsigned long n, unsigned char c) { while (n > 1) { *q++ = *p++; *q++ = c; n--; } if (n == 1) *q = *p; } /* find maximum char in a packed string */ unsigned char fps_maximum(unsigned char *p, unsigned long len) { unsigned char *q, c = *p; for (q = p; q < p + len; q++) if (*q > c) c = *q; return c; } /* find minimum char in a packed string */ unsigned char fps_minimum(unsigned char *p, unsigned long len) { unsigned char *q, c = *p; for (q = p; q < p + len; q++) if (*q < c) c = *q; return c; } /* count the number of occurences of a char in a string */ unsigned long fps_count(unsigned char *p, unsigned long len, unsigned char w) { unsigned long c; for (c = 0; len-- != 0; ++p) if (*p == w) ++c; return c; } hugs98-plus-Sep2006/packages/base/aclocal.m40000644006511100651110000001507010504340225017311 0ustar rossross# FP_DECL_ALTZONE # --------------- # Defines HAVE_DECL_ALTZONE to 1 if declared, 0 otherwise. # # Used by base package. AC_DEFUN([FP_DECL_ALTZONE], [AC_REQUIRE([AC_HEADER_TIME])dnl AC_CHECK_HEADERS([sys/time.h]) AC_CHECK_DECLS([altzone], [], [],[#if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif]) ])# FP_DECL_ALTZONE # FP_COMPUTE_INT(EXPRESSION, VARIABLE, INCLUDES, IF-FAILS) # -------------------------------------------------------- # Assign VARIABLE the value of the compile-time EXPRESSION using INCLUDES for # compilation. Execute IF-FAILS when unable to determine the value. Works for # cross-compilation, too. # # Implementation note: We are lazy and use an internal autoconf macro, but it # is supported in autoconf versions 2.50 up to the actual 2.57, so there is # little risk. AC_DEFUN([FP_COMPUTE_INT], [_AC_COMPUTE_INT([$1], [$2], [$3], [$4])[]dnl ])# FP_COMPUTE_INT # FP_CHECK_CONST(EXPRESSION, [INCLUDES = DEFAULT-INCLUDES], [VALUE-IF-FAIL = -1]) # ------------------------------------------------------------------------------- # Defines CONST_EXPRESSION to the value of the compile-time EXPRESSION, using # INCLUDES. If the value cannot be determined, use VALUE-IF-FAIL. AC_DEFUN([FP_CHECK_CONST], [AS_VAR_PUSHDEF([fp_Cache], [fp_cv_const_$1])[]dnl AC_CACHE_CHECK([value of $1], fp_Cache, [FP_COMPUTE_INT([$1], fp_check_const_result, [AC_INCLUDES_DEFAULT([$2])], [fp_check_const_result=m4_default([$3], ['-1'])]) AS_VAR_SET(fp_Cache, [$fp_check_const_result])])[]dnl AC_DEFINE_UNQUOTED(AS_TR_CPP([CONST_$1]), AS_VAR_GET(fp_Cache), [The value of $1.])[]dnl AS_VAR_POPDEF([fp_Cache])[]dnl ])# FP_CHECK_CONST # FP_CHECK_CONSTS_TEMPLATE(EXPRESSION...) # --------------------------------------- # autoheader helper for FP_CHECK_CONSTS m4_define([FP_CHECK_CONSTS_TEMPLATE], [AC_FOREACH([fp_Const], [$1], [AH_TEMPLATE(AS_TR_CPP(CONST_[]fp_Const), [The value of ]fp_Const[.])])[]dnl ])# FP_CHECK_CONSTS_TEMPLATE # FP_CHECK_CONSTS(EXPRESSION..., [INCLUDES = DEFAULT-INCLUDES], [VALUE-IF-FAIL = -1]) # ----------------------------------------------------------------------------------- # List version of FP_CHECK_CONST AC_DEFUN([FP_CHECK_CONSTS], [FP_CHECK_CONSTS_TEMPLATE([$1])dnl for fp_const_name in $1 do FP_CHECK_CONST([$fp_const_name], [$2], [$3]) done ])# FP_CHECK_CONSTS dnl ** Map an arithmetic C type to a Haskell type. dnl Based on autconf's AC_CHECK_SIZEOF. dnl FPTOOLS_CHECK_HTYPE(TYPE [, DEFAULT_VALUE, [, VALUE-FOR-CROSS-COMPILATION]) AC_DEFUN([FPTOOLS_CHECK_HTYPE], [changequote(<<, >>)dnl dnl The name to #define. define(<>, translit(htype_$1, [a-z *], [A-Z_P]))dnl dnl The cache variable name. define(<>, translit(fptools_cv_htype_$1, [ *], [_p]))dnl define(<>, translit(fptools_cv_htype_sup_$1, [ *], [_p]))dnl changequote([, ])dnl AC_MSG_CHECKING(Haskell type for $1) AC_CACHE_VAL(AC_CV_NAME, [AC_CV_NAME_supported=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" AC_RUN_IFELSE([AC_LANG_SOURCE([[#include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef $1 testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); }]])],[AC_CV_NAME=`cat conftestval`], [ifelse([$2], , [AC_CV_NAME=NotReallyAType; AC_CV_NAME_supported=no], [AC_CV_NAME=$2])], [ifelse([$3], , [AC_CV_NAME=NotReallyATypeCross; AC_CV_NAME_supported=no], [AC_CV_NAME=$3])]) CPPFLAGS="$fp_check_htype_save_cppflags"]) dnl if test "$AC_CV_NAME_supported" = yes; then AC_MSG_RESULT($AC_CV_NAME) AC_DEFINE_UNQUOTED(AC_TYPE_NAME, $AC_CV_NAME, [Define to Haskell type for $1]) else AC_MSG_RESULT([not supported]) fi undefine([AC_TYPE_NAME])dnl undefine([AC_CV_NAME])dnl undefine([AC_CV_NAME_supported])dnl ]) # FP_READDIR_EOF_ERRNO # -------------------- # Defines READDIR_ERRNO_EOF to what readdir() sets 'errno' to upon reaching end # of directory (not set => 0); not setting it is the correct thing to do, but # MinGW based versions have set it to ENOENT until recently (summer 2004). AC_DEFUN([FP_READDIR_EOF_ERRNO], [AC_CACHE_CHECK([what readdir sets errno to upon EOF], [fptools_cv_readdir_eof_errno], [AC_RUN_IFELSE([AC_LANG_SOURCE([[#include #include #include int main(argc, argv) int argc; char **argv; { FILE *f=fopen("conftestval", "w"); #if defined(__MINGW32__) int fd = mkdir("testdir"); #else int fd = mkdir("testdir", 0666); #endif DIR* dp; struct dirent* de; int err = 0; if (!f) return 1; if (fd == -1) { fprintf(stderr,"unable to create directory; quitting.\n"); return 1; } close(fd); dp = opendir("testdir"); if (!dp) { fprintf(stderr,"unable to browse directory; quitting.\n"); rmdir("testdir"); return 1; } /* the assumption here is that readdir() will only return NULL * due to reaching the end of the directory. */ while (de = readdir(dp)) { ; } err = errno; fprintf(f,"%d", err); fclose(f); closedir(dp); rmdir("testdir"); return 0; }]])], [fptools_cv_readdir_eof_errno=`cat conftestval`], [AC_MSG_WARN([failed to determine the errno value]) fptools_cv_readdir_eof_errno=0], [fptools_cv_readdir_eof_errno=0])]) AC_DEFINE_UNQUOTED([READDIR_ERRNO_EOF], [$fptools_cv_readdir_eof_errno], [readdir() sets errno to this upon EOF]) ])# FP_READDIR_EOF_ERRNO hugs98-plus-Sep2006/packages/base/base.cabal0000644006511100651110000000534610504340226017355 0ustar rossrossname: base version: 2.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org synopsis: Basic libraries description: This package contains the Prelude and its support libraries, and a large collection of useful libraries ranging from data structures to parsing combinators and debugging utilities. exposed-modules: Control.Applicative, Control.Arrow, Control.Concurrent, Control.Concurrent.Chan, Control.Concurrent.MVar, Control.Concurrent.QSem, Control.Concurrent.QSemN, Control.Concurrent.SampleVar, Control.Exception, Control.Monad, Control.Monad.Fix, Control.Monad.Instances, Control.Monad.ST, Control.Monad.ST.Lazy, Control.Monad.ST.Strict, Control.Parallel, -- Control.Parallel.Strategies, Data.Array, Data.Array.Base, Data.Array.Diff, Data.Array.IArray, Data.Array.IO, Data.Array.IO.Internals, Data.Array.MArray, Data.Array.ST, Data.Array.Storable, Data.Array.Unboxed, Data.Bits, Data.Bool, Data.ByteString, Data.ByteString.Char8, Data.ByteString.Lazy Data.ByteString.Lazy.Char8 Data.ByteString.Base Data.ByteString.Fusion Data.Char, Data.Complex, Data.Dynamic, Data.Either, Data.Eq, Data.Foldable, Data.Fixed, Data.FunctorM, -- Data.Generics, -- Data.Generics.Aliases, -- Data.Generics.Basics, -- Data.Generics.Instances, -- Data.Generics.Schemes, -- Data.Generics.Text, -- Data.Generics.Twins, Data.Graph, Data.HashTable, Data.IORef, Data.Int, Data.IntMap, Data.IntSet, Data.Ix, Data.List, Data.Maybe, Data.Map, Data.Monoid, Data.Ord, Data.PackedString, Data.Queue, Data.Ratio, Data.STRef, Data.STRef.Lazy, Data.STRef.Strict, Data.Sequence, Data.Set, Data.Tree, Data.Traversable, Data.Tuple, Data.Typeable, Data.Unique, Data.Version, Data.Word, Debug.Trace, Foreign, Foreign.C, Foreign.C.Error, Foreign.C.String, Foreign.C.Types, -- Foreign.Concurrent, Foreign.ForeignPtr, Foreign.Marshal, Foreign.Marshal.Alloc, Foreign.Marshal.Array, Foreign.Marshal.Error, Foreign.Marshal.Pool, Foreign.Marshal.Utils, Foreign.Ptr, Foreign.StablePtr, Foreign.Storable, Numeric, Prelude, System.Cmd, System.Console.GetOpt, System.CPUTime, System.Directory, System.Directory.Internals, System.Environment, System.Exit, System.IO, System.IO.Error, System.IO.Unsafe, System.Info, System.Locale, System.Mem, System.Mem.StableName, System.Mem.Weak, System.Posix.Internals, System.Posix.Signals, System.Posix.Types, -- System.Process, System.Process.Internals, System.Random, System.Time, Text.ParserCombinators.ReadP, Text.ParserCombinators.ReadPrec, Text.PrettyPrint, Text.PrettyPrint.HughesPJ, Text.Printf, Text.Read, Text.Read.Lex, Text.Show, Text.Show.Functions include-dirs: include, ../../ghc/includes includes: HsBase.h extensions: CPP hugs98-plus-Sep2006/packages/base/configure0000755006511100651110000131551710504340675017403 0ustar rossross#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.60a for Haskell base package 1.0. # # Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /usr/bin/posix$PATH_SEPARATOR/bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell autoconf@gnu.org about your system, echo including any error possibly output before this echo message } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='Haskell base package' PACKAGE_TARNAME='base' PACKAGE_VERSION='1.0' PACKAGE_STRING='Haskell base package 1.0' PACKAGE_BUGREPORT='libraries@haskell.org' ac_unique_file="include/HsBase.h" # Factoring default headers for most tests. ac_includes_default="\ #include #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_STAT_H # include #endif #ifdef STDC_HEADERS # include # include #else # ifdef HAVE_STDLIB_H # include # endif #endif #ifdef HAVE_STRING_H # if !defined STDC_HEADERS && defined HAVE_MEMORY_H # include # endif # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datarootdir datadir sysconfdir sharedstatedir localstatedir includedir oldincludedir docdir infodir htmldir dvidir pdfdir psdir libdir localedir mandir DEFS ECHO_C ECHO_N ECHO_T LIBS build_alias host_alias target_alias CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP GREP EGREP LIBOBJS LTLIBOBJS' ac_subst_files='' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS CPPFLAGS CPP' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` eval with_$ac_package=\$ac_optarg ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval with_$ac_package=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute directory names. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { echo "$as_me: error: Working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$0" || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # 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 Haskell base package 1.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/base] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of Haskell base package 1.0:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --disable-largefile omit support for large files Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF Haskell base package configure 1.0 generated by GNU Autoconf 2.60a Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by Haskell base package $as_me 1.0, which was generated by GNU Autoconf 2.60a. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then set x "$CONFIG_SITE" elif test "x$prefix" != xNONE; then set x "$prefix/share/config.site" "$prefix/etc/config.site" else set x "$ac_default_prefix/share/config.site" \ "$ac_default_prefix/etc/config.site" fi shift for ac_site_file do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Safety check: Ensure that we are in the correct source directory. ac_config_headers="$ac_config_headers include/HsBaseConfig.h" # do we have long longs? ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO: checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; } ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # # List of possible output files, starting from the most likely. # The algorithm is not robust to junk in `.', hence go to wildcards (a.*) # only as a last resort. b.out is created by i960 compilers. ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' # # The IRIX 6 linker writes into existing files which may not be # executable, retaining their permissions. Remove them first so a # subsequent execution test works. ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { (ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi { echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6; } if test -z "$ac_file"; then echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } { echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6; } { echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext { echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT { echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; } if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; } GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CFLAGS="" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_c89+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_c89=$ac_arg else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6; } ;; xno) { echo "$as_me:$LINENO: result: unsupported" >&5 echo "${ECHO_T}unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Extract the first word of "grep ggrep" to use in msg output if test -z "$GREP"; then set dummy grep ggrep; ac_prog_name=$2 if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_GREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_GREP" && $as_executable_p "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_GREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_GREP_found && break 3 done done done IFS=$as_save_IFS fi GREP="$ac_cv_path_GREP" if test -z "$GREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_GREP=$GREP fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 echo "${ECHO_T}$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" { echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6; } if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else # Extract the first word of "egrep" to use in msg output if test -z "$EGREP"; then set dummy egrep; ac_prog_name=$2 if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_EGREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_EGREP" && $as_executable_p "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_EGREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_found && break 3 done done done IFS=$as_save_IFS fi EGREP="$ac_cv_path_EGREP" if test -z "$EGREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_EGREP=$EGREP fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 echo "${ECHO_T}$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" { echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) return 2; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking for long long" >&5 echo $ECHO_N "checking for long long... $ECHO_C" >&6; } if test "${ac_cv_type_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef long long ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_long_long=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_long_long=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_long_long" >&5 echo "${ECHO_T}$ac_cv_type_long_long" >&6; } if test $ac_cv_type_long_long = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LONG_LONG 1 _ACEOF fi { echo "$as_me:$LINENO: checking for pid_t" >&5 echo $ECHO_N "checking for pid_t... $ECHO_C" >&6; } if test "${ac_cv_type_pid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef pid_t ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_pid_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_pid_t=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_pid_t" >&5 echo "${ECHO_T}$ac_cv_type_pid_t" >&6; } if test $ac_cv_type_pid_t = yes; then : else cat >>confdefs.h <<_ACEOF #define pid_t int _ACEOF fi for ac_header in vfork.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in fork vfork do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done if test "x$ac_cv_func_fork" = xyes; then { echo "$as_me:$LINENO: checking for working fork" >&5 echo $ECHO_N "checking for working fork... $ECHO_C" >&6; } if test "${ac_cv_func_fork_works+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then ac_cv_func_fork_works=cross else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { /* By Ruediger Kuhlmann. */ return fork () < 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_fork_works=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_fork_works=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi { echo "$as_me:$LINENO: result: $ac_cv_func_fork_works" >&5 echo "${ECHO_T}$ac_cv_func_fork_works" >&6; } else ac_cv_func_fork_works=$ac_cv_func_fork fi if test "x$ac_cv_func_fork_works" = xcross; then case $host in *-*-amigaos* | *-*-msdosdjgpp*) # Override, as these systems have only a dummy fork() stub ac_cv_func_fork_works=no ;; *) ac_cv_func_fork_works=yes ;; esac { echo "$as_me:$LINENO: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&5 echo "$as_me: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&2;} fi ac_cv_func_vfork_works=$ac_cv_func_vfork if test "x$ac_cv_func_vfork" = xyes; then { echo "$as_me:$LINENO: checking for working vfork" >&5 echo $ECHO_N "checking for working vfork... $ECHO_C" >&6; } if test "${ac_cv_func_vfork_works+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then ac_cv_func_vfork_works=cross else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Thanks to Paul Eggert for this test. */ $ac_includes_default #include #ifdef HAVE_VFORK_H # include #endif /* On some sparc systems, changes by the child to local and incoming argument registers are propagated back to the parent. The compiler is told about this with #include , but some compilers (e.g. gcc -O) don't grok . Test for this by using a static variable whose address is put into a register that is clobbered by the vfork. */ static void #ifdef __cplusplus sparc_address_test (int arg) # else sparc_address_test (arg) int arg; #endif { static pid_t child; if (!child) { child = vfork (); if (child < 0) { perror ("vfork"); _exit(2); } if (!child) { arg = getpid(); write(-1, "", 0); _exit (arg); } } } int main () { pid_t parent = getpid (); pid_t child; sparc_address_test (0); child = vfork (); if (child == 0) { /* Here is another test for sparc vfork register problems. This test uses lots of local variables, at least as many local variables as main has allocated so far including compiler temporaries. 4 locals are enough for gcc 1.40.3 on a Solaris 4.1.3 sparc, but we use 8 to be safe. A buggy compiler should reuse the register of parent for one of the local variables, since it will think that parent can't possibly be used any more in this routine. Assigning to the local variable will thus munge parent in the parent process. */ pid_t p = getpid(), p1 = getpid(), p2 = getpid(), p3 = getpid(), p4 = getpid(), p5 = getpid(), p6 = getpid(), p7 = getpid(); /* Convince the compiler that p..p7 are live; otherwise, it might use the same hardware register for all 8 local variables. */ if (p != p1 || p != p2 || p != p3 || p != p4 || p != p5 || p != p6 || p != p7) _exit(1); /* On some systems (e.g. IRIX 3.3), vfork doesn't separate parent from child file descriptors. If the child closes a descriptor before it execs or exits, this munges the parent's descriptor as well. Test for this by closing stdout in the child. */ _exit(close(fileno(stdout)) != 0); } else { int status; struct stat st; while (wait(&status) != child) ; return ( /* Was there some problem with vforking? */ child < 0 /* Did the child fail? (This shouldn't happen.) */ || status /* Did the vfork/compiler bug occur? */ || parent != getpid() /* Did the file descriptor bug occur? */ || fstat(fileno(stdout), &st) != 0 ); } } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_vfork_works=yes else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_func_vfork_works=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi { echo "$as_me:$LINENO: result: $ac_cv_func_vfork_works" >&5 echo "${ECHO_T}$ac_cv_func_vfork_works" >&6; } fi; if test "x$ac_cv_func_fork_works" = xcross; then ac_cv_func_vfork_works=$ac_cv_func_vfork { echo "$as_me:$LINENO: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&5 echo "$as_me: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&2;} fi if test "x$ac_cv_func_vfork_works" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_WORKING_VFORK 1 _ACEOF else cat >>confdefs.h <<\_ACEOF #define vfork fork _ACEOF fi if test "x$ac_cv_func_fork_works" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_WORKING_FORK 1 _ACEOF fi { echo "$as_me:$LINENO: checking for an ANSI C-conforming const" >&5 echo $ECHO_N "checking for an ANSI C-conforming const... $ECHO_C" >&6; } if test "${ac_cv_c_const+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { /* FIXME: Include the comments suggested by Paul. */ #ifndef __cplusplus /* Ultrix mips cc rejects this. */ typedef int charset[2]; const charset cs; /* SunOS 4.1.1 cc rejects this. */ char const *const *pcpcc; char **ppc; /* NEC SVR4.0.2 mips cc rejects this. */ struct point {int x, y;}; static struct point const zero = {0,0}; /* AIX XL C 1.02.0.0 rejects this. It does not let you subtract one const X* pointer from another in an arm of an if-expression whose if-part is not a constant expression */ const char *g = "string"; pcpcc = &g + (g ? g-g : 0); /* HPUX 7.0 cc rejects these. */ ++pcpcc; ppc = (char**) pcpcc; pcpcc = (char const *const *) ppc; { /* SCO 3.2v4 cc rejects this. */ char *t; char const *s = 0 ? (char *) 0 : (char const *) 0; *t++ = 0; if (s) return 0; } { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */ int x[] = {25, 17}; const int *foo = &x[0]; ++foo; } { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */ typedef const int *iptr; iptr p = 0; ++p; } { /* AIX XL C 1.02.0.0 rejects this saying "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ struct s { int j; const int *ap[3]; }; struct s *b; b->j = 5; } { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ const int foo = 10; if (!foo) return 0; } return !cs[0] && !zero.x; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_const=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_const=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_c_const" >&5 echo "${ECHO_T}$ac_cv_c_const" >&6; } if test $ac_cv_c_const = no; then cat >>confdefs.h <<\_ACEOF #define const _ACEOF fi { echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) return 2; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # check for specific header (.h) files that we are interested in for ac_header in ctype.h dirent.h errno.h fcntl.h limits.h signal.h sys/resource.h sys/select.h sys/syscall.h sys/time.h sys/timeb.h sys/timers.h sys/times.h sys/utsname.h sys/wait.h termios.h time.h utime.h windows.h winsock.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done # Enable large file support. Do this before testing the types ino_t, off_t, and # rlim_t, because it will affect the result of that test. # Check whether --enable-largefile was given. if test "${enable_largefile+set}" = set; then enableval=$enable_largefile; fi if test "$enable_largefile" != no; then { echo "$as_me:$LINENO: checking for special C compiler options needed for large files" >&5 echo $ECHO_N "checking for special C compiler options needed for large files... $ECHO_C" >&6; } if test "${ac_cv_sys_largefile_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_sys_largefile_CC=no if test "$GCC" != yes; then ac_save_CC=$CC while :; do # IRIX 6.2 and later do not support large files by default, # so use the C compiler's -n32 option if that helps. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include /* Check that off_t can represent 2**63 - 1 correctly. We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext CC="$CC -n32" rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sys_largefile_CC=' -n32'; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext break done CC=$ac_save_CC rm -f conftest.$ac_ext fi fi { echo "$as_me:$LINENO: result: $ac_cv_sys_largefile_CC" >&5 echo "${ECHO_T}$ac_cv_sys_largefile_CC" >&6; } if test "$ac_cv_sys_largefile_CC" != no; then CC=$CC$ac_cv_sys_largefile_CC fi { echo "$as_me:$LINENO: checking for _FILE_OFFSET_BITS value needed for large files" >&5 echo $ECHO_N "checking for _FILE_OFFSET_BITS value needed for large files... $ECHO_C" >&6; } if test "${ac_cv_sys_file_offset_bits+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else while :; do ac_cv_sys_file_offset_bits=no cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include /* Check that off_t can represent 2**63 - 1 correctly. We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _FILE_OFFSET_BITS 64 #include /* Check that off_t can represent 2**63 - 1 correctly. We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sys_file_offset_bits=64; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext break done fi { echo "$as_me:$LINENO: result: $ac_cv_sys_file_offset_bits" >&5 echo "${ECHO_T}$ac_cv_sys_file_offset_bits" >&6; } if test "$ac_cv_sys_file_offset_bits" != no; then cat >>confdefs.h <<_ACEOF #define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits _ACEOF fi rm -f conftest* { echo "$as_me:$LINENO: checking for _LARGE_FILES value needed for large files" >&5 echo $ECHO_N "checking for _LARGE_FILES value needed for large files... $ECHO_C" >&6; } if test "${ac_cv_sys_large_files+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else while :; do ac_cv_sys_large_files=no cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include /* Check that off_t can represent 2**63 - 1 correctly. We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _LARGE_FILES 1 #include /* Check that off_t can represent 2**63 - 1 correctly. We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sys_large_files=1; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext break done fi { echo "$as_me:$LINENO: result: $ac_cv_sys_large_files" >&5 echo "${ECHO_T}$ac_cv_sys_large_files" >&6; } if test "$ac_cv_sys_large_files" != no; then cat >>confdefs.h <<_ACEOF #define _LARGE_FILES $ac_cv_sys_large_files _ACEOF fi rm -f conftest* fi for ac_header in wctype.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF for ac_func in iswspace do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done fi done for ac_func in ftime gmtime_r localtime_r lstat readdir_r do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in getclock getrusage gettimeofday setitimer times do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in _chsize ftruncate do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6; } if test "${ac_cv_header_time+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include int main () { if ((struct tm *) 0) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_time=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_time=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 echo "${ECHO_T}$ac_cv_header_time" >&6; } if test $ac_cv_header_time = yes; then cat >>confdefs.h <<\_ACEOF #define TIME_WITH_SYS_TIME 1 _ACEOF fi { echo "$as_me:$LINENO: checking whether struct tm is in sys/time.h or time.h" >&5 echo $ECHO_N "checking whether struct tm is in sys/time.h or time.h... $ECHO_C" >&6; } if test "${ac_cv_struct_tm+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { struct tm *tp; tp->tm_sec; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_struct_tm=time.h else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_struct_tm=sys/time.h fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_struct_tm" >&5 echo "${ECHO_T}$ac_cv_struct_tm" >&6; } if test $ac_cv_struct_tm = sys/time.h; then cat >>confdefs.h <<\_ACEOF #define TM_IN_SYS_TIME 1 _ACEOF fi { echo "$as_me:$LINENO: checking for struct tm.tm_zone" >&5 echo $ECHO_N "checking for struct tm.tm_zone... $ECHO_C" >&6; } if test "${ac_cv_member_struct_tm_tm_zone+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include <$ac_cv_struct_tm> int main () { static struct tm ac_aggr; if (ac_aggr.tm_zone) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_tm_tm_zone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include <$ac_cv_struct_tm> int main () { static struct tm ac_aggr; if (sizeof ac_aggr.tm_zone) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_tm_tm_zone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_member_struct_tm_tm_zone=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_member_struct_tm_tm_zone" >&5 echo "${ECHO_T}$ac_cv_member_struct_tm_tm_zone" >&6; } if test $ac_cv_member_struct_tm_tm_zone = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_TM_TM_ZONE 1 _ACEOF fi if test "$ac_cv_member_struct_tm_tm_zone" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_TM_ZONE 1 _ACEOF else { echo "$as_me:$LINENO: checking whether tzname is declared" >&5 echo $ECHO_N "checking whether tzname is declared... $ECHO_C" >&6; } if test "${ac_cv_have_decl_tzname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { #ifndef tzname char *p = (char *) tzname; return !p; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_tzname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_tzname=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_have_decl_tzname" >&5 echo "${ECHO_T}$ac_cv_have_decl_tzname" >&6; } if test $ac_cv_have_decl_tzname = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_TZNAME 1 _ACEOF else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_TZNAME 0 _ACEOF fi { echo "$as_me:$LINENO: checking for tzname" >&5 echo $ECHO_N "checking for tzname... $ECHO_C" >&6; } if test "${ac_cv_var_tzname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #if !HAVE_DECL_TZNAME extern char *tzname[]; #endif int main () { return tzname[0][0]; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_var_tzname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_var_tzname=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_var_tzname" >&5 echo "${ECHO_T}$ac_cv_var_tzname" >&6; } if test $ac_cv_var_tzname = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_TZNAME 1 _ACEOF fi fi for ac_header in sys/time.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking whether altzone is declared" >&5 echo $ECHO_N "checking whether altzone is declared... $ECHO_C" >&6; } if test "${ac_cv_have_decl_altzone+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif int main () { #ifndef altzone char *p = (char *) altzone; return !p; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_altzone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_altzone=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_have_decl_altzone" >&5 echo "${ECHO_T}$ac_cv_have_decl_altzone" >&6; } if test $ac_cv_have_decl_altzone = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_ALTZONE 1 _ACEOF else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_ALTZONE 0 _ACEOF fi # map standard C types and ISO types to Haskell types { echo "$as_me:$LINENO: checking Haskell type for char" >&5 echo $ECHO_N "checking Haskell type for char... $ECHO_C" >&6; } if test "${fptools_cv_htype_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_char=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_char=NotReallyATypeCross; fptools_cv_htype_sup_char=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef char testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_char=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_char=NotReallyAType; fptools_cv_htype_sup_char=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_char" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_char" >&5 echo "${ECHO_T}$fptools_cv_htype_char" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_CHAR $fptools_cv_htype_char _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for signed char" >&5 echo $ECHO_N "checking Haskell type for signed char... $ECHO_C" >&6; } if test "${fptools_cv_htype_signed_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_signed_char=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_signed_char=NotReallyATypeCross; fptools_cv_htype_sup_signed_char=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef signed char testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_signed_char=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_signed_char=NotReallyAType; fptools_cv_htype_sup_signed_char=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_signed_char" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_signed_char" >&5 echo "${ECHO_T}$fptools_cv_htype_signed_char" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_SIGNED_CHAR $fptools_cv_htype_signed_char _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for unsigned char" >&5 echo $ECHO_N "checking Haskell type for unsigned char... $ECHO_C" >&6; } if test "${fptools_cv_htype_unsigned_char+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_unsigned_char=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_unsigned_char=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_char=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef unsigned char testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_unsigned_char=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_unsigned_char=NotReallyAType; fptools_cv_htype_sup_unsigned_char=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_unsigned_char" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_unsigned_char" >&5 echo "${ECHO_T}$fptools_cv_htype_unsigned_char" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_UNSIGNED_CHAR $fptools_cv_htype_unsigned_char _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for short" >&5 echo $ECHO_N "checking Haskell type for short... $ECHO_C" >&6; } if test "${fptools_cv_htype_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_short=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_short=NotReallyATypeCross; fptools_cv_htype_sup_short=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef short testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_short=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_short=NotReallyAType; fptools_cv_htype_sup_short=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_short" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_short" >&5 echo "${ECHO_T}$fptools_cv_htype_short" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_SHORT $fptools_cv_htype_short _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for unsigned short" >&5 echo $ECHO_N "checking Haskell type for unsigned short... $ECHO_C" >&6; } if test "${fptools_cv_htype_unsigned_short+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_unsigned_short=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_unsigned_short=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_short=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef unsigned short testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_unsigned_short=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_unsigned_short=NotReallyAType; fptools_cv_htype_sup_unsigned_short=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_unsigned_short" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_unsigned_short" >&5 echo "${ECHO_T}$fptools_cv_htype_unsigned_short" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_UNSIGNED_SHORT $fptools_cv_htype_unsigned_short _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for int" >&5 echo $ECHO_N "checking Haskell type for int... $ECHO_C" >&6; } if test "${fptools_cv_htype_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_int=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_int=NotReallyATypeCross; fptools_cv_htype_sup_int=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef int testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_int=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_int=NotReallyAType; fptools_cv_htype_sup_int=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_int" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_int" >&5 echo "${ECHO_T}$fptools_cv_htype_int" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_INT $fptools_cv_htype_int _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for unsigned int" >&5 echo $ECHO_N "checking Haskell type for unsigned int... $ECHO_C" >&6; } if test "${fptools_cv_htype_unsigned_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_unsigned_int=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_unsigned_int=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_int=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef unsigned int testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_unsigned_int=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_unsigned_int=NotReallyAType; fptools_cv_htype_sup_unsigned_int=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_unsigned_int" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_unsigned_int" >&5 echo "${ECHO_T}$fptools_cv_htype_unsigned_int" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_UNSIGNED_INT $fptools_cv_htype_unsigned_int _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for long" >&5 echo $ECHO_N "checking Haskell type for long... $ECHO_C" >&6; } if test "${fptools_cv_htype_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_long=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_long=NotReallyATypeCross; fptools_cv_htype_sup_long=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef long testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_long=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_long=NotReallyAType; fptools_cv_htype_sup_long=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_long" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_long" >&5 echo "${ECHO_T}$fptools_cv_htype_long" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_LONG $fptools_cv_htype_long _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for unsigned long" >&5 echo $ECHO_N "checking Haskell type for unsigned long... $ECHO_C" >&6; } if test "${fptools_cv_htype_unsigned_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_unsigned_long=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_unsigned_long=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_long=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef unsigned long testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_unsigned_long=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_unsigned_long=NotReallyAType; fptools_cv_htype_sup_unsigned_long=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_unsigned_long" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_unsigned_long" >&5 echo "${ECHO_T}$fptools_cv_htype_unsigned_long" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_UNSIGNED_LONG $fptools_cv_htype_unsigned_long _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi if test "$ac_cv_type_long_long" = yes; then { echo "$as_me:$LINENO: checking Haskell type for long long" >&5 echo $ECHO_N "checking Haskell type for long long... $ECHO_C" >&6; } if test "${fptools_cv_htype_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_long_long=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_long_long=NotReallyATypeCross; fptools_cv_htype_sup_long_long=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef long long testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_long_long=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_long_long=NotReallyAType; fptools_cv_htype_sup_long_long=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_long_long" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_long_long" >&5 echo "${ECHO_T}$fptools_cv_htype_long_long" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_LONG_LONG $fptools_cv_htype_long_long _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for unsigned long long" >&5 echo $ECHO_N "checking Haskell type for unsigned long long... $ECHO_C" >&6; } if test "${fptools_cv_htype_unsigned_long_long+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_unsigned_long_long=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_unsigned_long_long=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_long_long=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef unsigned long long testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_unsigned_long_long=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_unsigned_long_long=NotReallyAType; fptools_cv_htype_sup_unsigned_long_long=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_unsigned_long_long" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_unsigned_long_long" >&5 echo "${ECHO_T}$fptools_cv_htype_unsigned_long_long" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_UNSIGNED_LONG_LONG $fptools_cv_htype_unsigned_long_long _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi fi { echo "$as_me:$LINENO: checking Haskell type for float" >&5 echo $ECHO_N "checking Haskell type for float... $ECHO_C" >&6; } if test "${fptools_cv_htype_float+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_float=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_float=NotReallyATypeCross; fptools_cv_htype_sup_float=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef float testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_float=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_float=NotReallyAType; fptools_cv_htype_sup_float=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_float" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_float" >&5 echo "${ECHO_T}$fptools_cv_htype_float" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_FLOAT $fptools_cv_htype_float _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for double" >&5 echo $ECHO_N "checking Haskell type for double... $ECHO_C" >&6; } if test "${fptools_cv_htype_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_double=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_double=NotReallyATypeCross; fptools_cv_htype_sup_double=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef double testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_double=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_double=NotReallyAType; fptools_cv_htype_sup_double=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_double" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_double" >&5 echo "${ECHO_T}$fptools_cv_htype_double" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_DOUBLE $fptools_cv_htype_double _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for ptrdiff_t" >&5 echo $ECHO_N "checking Haskell type for ptrdiff_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_ptrdiff_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_ptrdiff_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_ptrdiff_t=NotReallyATypeCross; fptools_cv_htype_sup_ptrdiff_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef ptrdiff_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_ptrdiff_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_ptrdiff_t=NotReallyAType; fptools_cv_htype_sup_ptrdiff_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_ptrdiff_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_ptrdiff_t" >&5 echo "${ECHO_T}$fptools_cv_htype_ptrdiff_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_PTRDIFF_T $fptools_cv_htype_ptrdiff_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for size_t" >&5 echo $ECHO_N "checking Haskell type for size_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_size_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_size_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_size_t=NotReallyATypeCross; fptools_cv_htype_sup_size_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef size_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_size_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_size_t=NotReallyAType; fptools_cv_htype_sup_size_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_size_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_size_t" >&5 echo "${ECHO_T}$fptools_cv_htype_size_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_SIZE_T $fptools_cv_htype_size_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for wchar_t" >&5 echo $ECHO_N "checking Haskell type for wchar_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_wchar_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_wchar_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_wchar_t=NotReallyATypeCross; fptools_cv_htype_sup_wchar_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef wchar_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_wchar_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_wchar_t=NotReallyAType; fptools_cv_htype_sup_wchar_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_wchar_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_wchar_t" >&5 echo "${ECHO_T}$fptools_cv_htype_wchar_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_WCHAR_T $fptools_cv_htype_wchar_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi # Int32 is a HACK for non-ISO C compilers { echo "$as_me:$LINENO: checking Haskell type for sig_atomic_t" >&5 echo $ECHO_N "checking Haskell type for sig_atomic_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_sig_atomic_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_sig_atomic_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_sig_atomic_t=NotReallyATypeCross; fptools_cv_htype_sup_sig_atomic_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef sig_atomic_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_sig_atomic_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_sig_atomic_t=Int32 fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_sig_atomic_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_sig_atomic_t" >&5 echo "${ECHO_T}$fptools_cv_htype_sig_atomic_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_SIG_ATOMIC_T $fptools_cv_htype_sig_atomic_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for clock_t" >&5 echo $ECHO_N "checking Haskell type for clock_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_clock_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_clock_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_clock_t=NotReallyATypeCross; fptools_cv_htype_sup_clock_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef clock_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_clock_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_clock_t=NotReallyAType; fptools_cv_htype_sup_clock_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_clock_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_clock_t" >&5 echo "${ECHO_T}$fptools_cv_htype_clock_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_CLOCK_T $fptools_cv_htype_clock_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for time_t" >&5 echo $ECHO_N "checking Haskell type for time_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_time_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_time_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_time_t=NotReallyATypeCross; fptools_cv_htype_sup_time_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef time_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_time_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_time_t=NotReallyAType; fptools_cv_htype_sup_time_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_time_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_time_t" >&5 echo "${ECHO_T}$fptools_cv_htype_time_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_TIME_T $fptools_cv_htype_time_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for dev_t" >&5 echo $ECHO_N "checking Haskell type for dev_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_dev_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_dev_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_dev_t=NotReallyATypeCross; fptools_cv_htype_sup_dev_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef dev_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_dev_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_dev_t=Word32 fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_dev_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_dev_t" >&5 echo "${ECHO_T}$fptools_cv_htype_dev_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_DEV_T $fptools_cv_htype_dev_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for ino_t" >&5 echo $ECHO_N "checking Haskell type for ino_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_ino_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_ino_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_ino_t=NotReallyATypeCross; fptools_cv_htype_sup_ino_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef ino_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_ino_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_ino_t=NotReallyAType; fptools_cv_htype_sup_ino_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_ino_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_ino_t" >&5 echo "${ECHO_T}$fptools_cv_htype_ino_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_INO_T $fptools_cv_htype_ino_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for mode_t" >&5 echo $ECHO_N "checking Haskell type for mode_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_mode_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_mode_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_mode_t=NotReallyATypeCross; fptools_cv_htype_sup_mode_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef mode_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_mode_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_mode_t=NotReallyAType; fptools_cv_htype_sup_mode_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_mode_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_mode_t" >&5 echo "${ECHO_T}$fptools_cv_htype_mode_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_MODE_T $fptools_cv_htype_mode_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for off_t" >&5 echo $ECHO_N "checking Haskell type for off_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_off_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_off_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_off_t=NotReallyATypeCross; fptools_cv_htype_sup_off_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef off_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_off_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_off_t=NotReallyAType; fptools_cv_htype_sup_off_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_off_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_off_t" >&5 echo "${ECHO_T}$fptools_cv_htype_off_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_OFF_T $fptools_cv_htype_off_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for pid_t" >&5 echo $ECHO_N "checking Haskell type for pid_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_pid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_pid_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_pid_t=NotReallyATypeCross; fptools_cv_htype_sup_pid_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef pid_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_pid_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_pid_t=NotReallyAType; fptools_cv_htype_sup_pid_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_pid_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_pid_t" >&5 echo "${ECHO_T}$fptools_cv_htype_pid_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_PID_T $fptools_cv_htype_pid_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for gid_t" >&5 echo $ECHO_N "checking Haskell type for gid_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_gid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_gid_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_gid_t=NotReallyATypeCross; fptools_cv_htype_sup_gid_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef gid_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_gid_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_gid_t=NotReallyAType; fptools_cv_htype_sup_gid_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_gid_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_gid_t" >&5 echo "${ECHO_T}$fptools_cv_htype_gid_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_GID_T $fptools_cv_htype_gid_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for uid_t" >&5 echo $ECHO_N "checking Haskell type for uid_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_uid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_uid_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_uid_t=NotReallyATypeCross; fptools_cv_htype_sup_uid_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef uid_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_uid_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_uid_t=NotReallyAType; fptools_cv_htype_sup_uid_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_uid_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_uid_t" >&5 echo "${ECHO_T}$fptools_cv_htype_uid_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_UID_T $fptools_cv_htype_uid_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for cc_t" >&5 echo $ECHO_N "checking Haskell type for cc_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_cc_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_cc_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_cc_t=NotReallyATypeCross; fptools_cv_htype_sup_cc_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef cc_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_cc_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_cc_t=NotReallyAType; fptools_cv_htype_sup_cc_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_cc_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_cc_t" >&5 echo "${ECHO_T}$fptools_cv_htype_cc_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_CC_T $fptools_cv_htype_cc_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for speed_t" >&5 echo $ECHO_N "checking Haskell type for speed_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_speed_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_speed_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_speed_t=NotReallyATypeCross; fptools_cv_htype_sup_speed_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef speed_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_speed_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_speed_t=NotReallyAType; fptools_cv_htype_sup_speed_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_speed_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_speed_t" >&5 echo "${ECHO_T}$fptools_cv_htype_speed_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_SPEED_T $fptools_cv_htype_speed_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for tcflag_t" >&5 echo $ECHO_N "checking Haskell type for tcflag_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_tcflag_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_tcflag_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_tcflag_t=NotReallyATypeCross; fptools_cv_htype_sup_tcflag_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef tcflag_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_tcflag_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_tcflag_t=NotReallyAType; fptools_cv_htype_sup_tcflag_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_tcflag_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_tcflag_t" >&5 echo "${ECHO_T}$fptools_cv_htype_tcflag_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_TCFLAG_T $fptools_cv_htype_tcflag_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for nlink_t" >&5 echo $ECHO_N "checking Haskell type for nlink_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_nlink_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_nlink_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_nlink_t=NotReallyATypeCross; fptools_cv_htype_sup_nlink_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef nlink_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_nlink_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_nlink_t=NotReallyAType; fptools_cv_htype_sup_nlink_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_nlink_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_nlink_t" >&5 echo "${ECHO_T}$fptools_cv_htype_nlink_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_NLINK_T $fptools_cv_htype_nlink_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for ssize_t" >&5 echo $ECHO_N "checking Haskell type for ssize_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_ssize_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_ssize_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_ssize_t=NotReallyATypeCross; fptools_cv_htype_sup_ssize_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef ssize_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_ssize_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_ssize_t=NotReallyAType; fptools_cv_htype_sup_ssize_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_ssize_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_ssize_t" >&5 echo "${ECHO_T}$fptools_cv_htype_ssize_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_SSIZE_T $fptools_cv_htype_ssize_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for rlim_t" >&5 echo $ECHO_N "checking Haskell type for rlim_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_rlim_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_rlim_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_rlim_t=NotReallyATypeCross; fptools_cv_htype_sup_rlim_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef rlim_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_rlim_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_rlim_t=NotReallyAType; fptools_cv_htype_sup_rlim_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_rlim_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_rlim_t" >&5 echo "${ECHO_T}$fptools_cv_htype_rlim_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_RLIM_T $fptools_cv_htype_rlim_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for wint_t" >&5 echo $ECHO_N "checking Haskell type for wint_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_wint_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_wint_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_wint_t=NotReallyATypeCross; fptools_cv_htype_sup_wint_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef wint_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_wint_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_wint_t=NotReallyAType; fptools_cv_htype_sup_wint_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_wint_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_wint_t" >&5 echo "${ECHO_T}$fptools_cv_htype_wint_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_WINT_T $fptools_cv_htype_wint_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for intptr_t" >&5 echo $ECHO_N "checking Haskell type for intptr_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_intptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_intptr_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_intptr_t=NotReallyATypeCross; fptools_cv_htype_sup_intptr_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef intptr_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_intptr_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_intptr_t=NotReallyAType; fptools_cv_htype_sup_intptr_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_intptr_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_intptr_t" >&5 echo "${ECHO_T}$fptools_cv_htype_intptr_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_INTPTR_T $fptools_cv_htype_intptr_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for uintptr_t" >&5 echo $ECHO_N "checking Haskell type for uintptr_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_uintptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_uintptr_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_uintptr_t=NotReallyATypeCross; fptools_cv_htype_sup_uintptr_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef uintptr_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_uintptr_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_uintptr_t=NotReallyAType; fptools_cv_htype_sup_uintptr_t=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_uintptr_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_uintptr_t" >&5 echo "${ECHO_T}$fptools_cv_htype_uintptr_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_UINTPTR_T $fptools_cv_htype_uintptr_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi # Workaround for OSes that don't have intmax_t and uintmax_t, e.g. OpenBSD. if test "$ac_cv_type_long_long" = yes; then fptools_cv_default_htype_intmax=$fptools_cv_htype_long_long fptools_cv_default_htype_uintmax=$fptools_cv_htype_unsigned_long_long else fptools_cv_default_htype_intmax=$fptools_cv_htype_long fptools_cv_default_htype_uintmax=$fptools_cv_htype_unsigned_long fi { echo "$as_me:$LINENO: checking Haskell type for intmax_t" >&5 echo $ECHO_N "checking Haskell type for intmax_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_intmax_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_intmax_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_intmax_t=NotReallyATypeCross; fptools_cv_htype_sup_intmax_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef intmax_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_intmax_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_intmax_t=$fptools_cv_default_htype_intmax fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_intmax_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_intmax_t" >&5 echo "${ECHO_T}$fptools_cv_htype_intmax_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_INTMAX_T $fptools_cv_htype_intmax_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi { echo "$as_me:$LINENO: checking Haskell type for uintmax_t" >&5 echo $ECHO_N "checking Haskell type for uintmax_t... $ECHO_C" >&6; } if test "${fptools_cv_htype_uintmax_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else fptools_cv_htype_sup_uintmax_t=yes fp_check_htype_save_cppflags="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $X_CFLAGS" if test "$cross_compiling" = yes; then fptools_cv_htype_uintmax_t=NotReallyATypeCross; fptools_cv_htype_sup_uintmax_t=no else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_UNISTD_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_SIGNAL_H # include #endif #if HAVE_TIME_H # include #endif #if HAVE_TERMIOS_H # include #endif #if HAVE_STRING_H # include #endif #if HAVE_CTYPE_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if defined(HAVE_GL_GL_H) # include #elif defined(HAVE_OPENGL_GL_H) # include #endif #if defined(HAVE_AL_AL_H) # include #elif defined(HAVE_OPENAL_AL_H) # include #endif #if defined(HAVE_AL_ALC_H) # include #elif defined(HAVE_OPENAL_ALC_H) # include #endif #if HAVE_SYS_RESOURCE_H # include #endif typedef uintmax_t testing; main() { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word", sizeof(testing)*8); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" : (sizeof(testing) == sizeof(double)) ? "Double" : "Float"); } fclose(f); exit(0); } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_htype_uintmax_t=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fptools_cv_htype_uintmax_t=$fptools_cv_default_htype_uintmax fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi CPPFLAGS="$fp_check_htype_save_cppflags" fi if test "$fptools_cv_htype_sup_uintmax_t" = yes; then { echo "$as_me:$LINENO: result: $fptools_cv_htype_uintmax_t" >&5 echo "${ECHO_T}$fptools_cv_htype_uintmax_t" >&6; } cat >>confdefs.h <<_ACEOF #define HTYPE_UINTMAX_T $fptools_cv_htype_uintmax_t _ACEOF else { echo "$as_me:$LINENO: result: not supported" >&5 echo "${ECHO_T}not supported" >&6; } fi # test errno values for fp_const_name in E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EADV EAFNOSUPPORT EAGAIN EALREADY EBADF EBADMSG EBADRPC EBUSY ECHILD ECOMM ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDIRTY EDOM EDQUOT EEXIST EFAULT EFBIG EFTYPE EHOSTDOWN EHOSTUNREACH EIDRM EILSEQ EINPROGRESS EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE EMULTIHOP ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODATA ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG ENONET ENOPROTOOPT ENOSPC ENOSR ENOSTR ENOSYS ENOTBLK ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE EPROCLIM EPROCUNAVAIL EPROGMISMATCH EPROGUNAVAIL EPROTO EPROTONOSUPPORT EPROTOTYPE ERANGE EREMCHG EREMOTE EROFS ERPCMISMATCH ERREMOTE ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESRMNT ESTALE ETIME ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV ENOCIGAR do as_fp_Cache=`echo "fp_cv_const_$fp_const_name" | $as_tr_sh` { echo "$as_me:$LINENO: checking value of $fp_const_name" >&5 echo $ECHO_N "checking value of $fp_const_name... $ECHO_C" >&6; } if { as_var=$as_fp_Cache; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { static int test_array [1 - 2 * !(($fp_const_name) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { static int test_array [1 - 2 * !(($fp_const_name) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { static int test_array [1 - 2 * !(($fp_const_name) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { static int test_array [1 - 2 * !(($fp_const_name) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { static int test_array [1 - 2 * !(($fp_const_name) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_check_const_result=$ac_lo;; '') fp_check_const_result='-1' ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include static long int longval () { return $fp_const_name; } static unsigned long int ulongval () { return $fp_const_name; } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (($fp_const_name) < 0) { long int i = longval (); if (i != ($fp_const_name)) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ($fp_const_name)) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_check_const_result=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fp_check_const_result='-1' fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val eval "$as_fp_Cache=\$fp_check_const_result" fi ac_res=`eval echo '${'$as_fp_Cache'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } cat >>confdefs.h <<_ACEOF #define `echo "CONST_$fp_const_name" | $as_tr_cpp` `eval echo '${'$as_fp_Cache'}'` _ACEOF done for fp_const_name in SIGABRT SIGALRM SIGBUS SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGPOLL SIGPROF SIGSYS SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ SIG_BLOCK SIG_SETMASK SIG_UNBLOCK SIG_DFL SIG_IGN SIG_ERR do as_fp_Cache=`echo "fp_cv_const_$fp_const_name" | $as_tr_sh` { echo "$as_me:$LINENO: checking value of $fp_const_name" >&5 echo $ECHO_N "checking value of $fp_const_name... $ECHO_C" >&6; } if { as_var=$as_fp_Cache; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SIGNAL_H #include #endif int main () { static int test_array [1 - 2 * !(($fp_const_name) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SIGNAL_H #include #endif int main () { static int test_array [1 - 2 * !(($fp_const_name) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SIGNAL_H #include #endif int main () { static int test_array [1 - 2 * !(($fp_const_name) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SIGNAL_H #include #endif int main () { static int test_array [1 - 2 * !(($fp_const_name) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SIGNAL_H #include #endif int main () { static int test_array [1 - 2 * !(($fp_const_name) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_check_const_result=$ac_lo;; '') fp_check_const_result='-1' ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SIGNAL_H #include #endif static long int longval () { return $fp_const_name; } static unsigned long int ulongval () { return $fp_const_name; } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (($fp_const_name) < 0) { long int i = longval (); if (i != ($fp_const_name)) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ($fp_const_name)) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_check_const_result=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fp_check_const_result='-1' fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val eval "$as_fp_Cache=\$fp_check_const_result" fi ac_res=`eval echo '${'$as_fp_Cache'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } cat >>confdefs.h <<_ACEOF #define `echo "CONST_$fp_const_name" | $as_tr_cpp` `eval echo '${'$as_fp_Cache'}'` _ACEOF done { echo "$as_me:$LINENO: checking value of O_BINARY" >&5 echo $ECHO_N "checking value of O_BINARY... $ECHO_C" >&6; } if test "${fp_cv_const_O_BINARY+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { static int test_array [1 - 2 * !((O_BINARY) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { static int test_array [1 - 2 * !((O_BINARY) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { static int test_array [1 - 2 * !((O_BINARY) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { static int test_array [1 - 2 * !((O_BINARY) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { static int test_array [1 - 2 * !((O_BINARY) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) fp_check_const_result=$ac_lo;; '') fp_check_const_result=0 ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include static long int longval () { return O_BINARY; } static unsigned long int ulongval () { return O_BINARY; } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if ((O_BINARY) < 0) { long int i = longval (); if (i != (O_BINARY)) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != (O_BINARY)) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_check_const_result=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) fp_check_const_result=0 fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fp_cv_const_O_BINARY=$fp_check_const_result fi { echo "$as_me:$LINENO: result: $fp_cv_const_O_BINARY" >&5 echo "${ECHO_T}$fp_cv_const_O_BINARY" >&6; } cat >>confdefs.h <<_ACEOF #define CONST_O_BINARY $fp_cv_const_O_BINARY _ACEOF # Check for idiosyncracies in some mingw impls of directory handling. { echo "$as_me:$LINENO: checking what readdir sets errno to upon EOF" >&5 echo $ECHO_N "checking what readdir sets errno to upon EOF... $ECHO_C" >&6; } if test "${fptools_cv_readdir_eof_errno+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then fptools_cv_readdir_eof_errno=0 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include int main(argc, argv) int argc; char **argv; { FILE *f=fopen("conftestval", "w"); #if defined(__MINGW32__) int fd = mkdir("testdir"); #else int fd = mkdir("testdir", 0666); #endif DIR* dp; struct dirent* de; int err = 0; if (!f) return 1; if (fd == -1) { fprintf(stderr,"unable to create directory; quitting.\n"); return 1; } close(fd); dp = opendir("testdir"); if (!dp) { fprintf(stderr,"unable to browse directory; quitting.\n"); rmdir("testdir"); return 1; } /* the assumption here is that readdir() will only return NULL * due to reaching the end of the directory. */ while (de = readdir(dp)) { ; } err = errno; fprintf(f,"%d", err); fclose(f); closedir(dp); rmdir("testdir"); return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fptools_cv_readdir_eof_errno=`cat conftestval` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { echo "$as_me:$LINENO: WARNING: failed to determine the errno value" >&5 echo "$as_me: WARNING: failed to determine the errno value" >&2;} fptools_cv_readdir_eof_errno=0 fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi { echo "$as_me:$LINENO: result: $fptools_cv_readdir_eof_errno" >&5 echo "${ECHO_T}$fptools_cv_readdir_eof_errno" >&6; } cat >>confdefs.h <<_ACEOF #define READDIR_ERRNO_EOF $fptools_cv_readdir_eof_errno _ACEOF cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { echo "$as_me:$LINENO: updating cache $cache_file" >&5 echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by Haskell base package $as_me 1.0, which was generated by GNU Autoconf 2.60a. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for. config_headers="$ac_config_headers" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration headers: $config_headers Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ Haskell base package config.status 1.0 configured by $0, generated by GNU Autoconf 2.60a, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2006 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header { echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 CONFIG_SHELL=$SHELL export CONFIG_SHELL exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "include/HsBaseConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsBaseConfig.h" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } for ac_tag in :H $CONFIG_HEADERS do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 echo "$as_me: error: Invalid tag $ac_tag." >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac ac_file_inputs="$ac_file_inputs $ac_f" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input="Generated from "`IFS=: echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} fi case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin";; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :H) # # CONFIG_HEADER # _ACEOF # Transform confdefs.h into a sed script `conftest.defines', that # substitutes the proper values into config.h.in to produce config.h. rm -f conftest.defines conftest.tail # First, append a space to every undef/define line, to ease matching. echo 's/$/ /' >conftest.defines # Then, protect against being on the right side of a sed subst, or in # an unquoted here document, in config.status. If some macros were # called several times there might be several #defines for the same # symbol, which is useless. But do not sort them, since the last # AC_DEFINE must be honored. ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* # These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where # NAME is the cpp macro being defined, VALUE is the value it is being given. # PARAMS is the parameter list in the macro definition--in most cases, it's # just an empty string. ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' ac_dB='\\)[ (].*,\\1define\\2' ac_dC=' ' ac_dD=' ,' uniq confdefs.h | sed -n ' t rset :rset s/^[ ]*#[ ]*define[ ][ ]*// t ok d :ok s/[\\&,]/\\&/g s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p ' >>conftest.defines # Remove the space that was appended to ease matching. # Then replace #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. # (The regexp can be short, since the line contains either #define or #undef.) echo 's/ $// s,^[ #]*u.*,/* & */,' >>conftest.defines # Break up conftest.defines: ac_max_sed_lines=50 # First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" # Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" # Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" # et cetera. ac_in='$ac_file_inputs' ac_out='"$tmp/out1"' ac_nxt='"$tmp/out2"' while : do # Write a here document: cat >>$CONFIG_STATUS <<_ACEOF # First, check the format of the line: cat >"\$tmp/defines.sed" <<\\CEOF /^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def /^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def b :def _ACEOF sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail grep . conftest.tail >/dev/null || break rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines conftest.tail echo "ac_result=$ac_in" >>$CONFIG_STATUS cat >>$CONFIG_STATUS <<\_ACEOF if test x"$ac_file" != x-; then echo "/* $configure_input */" >"$tmp/config.h" cat "$ac_result" >>"$tmp/config.h" if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else rm -f $ac_file mv "$tmp/config.h" $ac_file fi else echo "/* $configure_input */" cat "$ac_result" fi rm -f "$tmp/out12" ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi hugs98-plus-Sep2006/packages/base/configure.ac0000644006511100651110000001103410504340226017734 0ustar rossrossAC_INIT([Haskell base package], [1.0], [libraries@haskell.org], [base]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([include/HsBase.h]) AC_CONFIG_HEADERS([include/HsBaseConfig.h]) # do we have long longs? AC_CHECK_TYPES([long long]) dnl ** Working vfork? AC_FUNC_FORK dnl ** determine whether or not const works AC_C_CONST dnl ** check for full ANSI header (.h) files AC_HEADER_STDC # check for specific header (.h) files that we are interested in AC_CHECK_HEADERS([ctype.h dirent.h errno.h fcntl.h limits.h signal.h sys/resource.h sys/select.h sys/syscall.h sys/time.h sys/timeb.h sys/timers.h sys/times.h sys/utsname.h sys/wait.h termios.h time.h utime.h windows.h winsock.h]) # Enable large file support. Do this before testing the types ino_t, off_t, and # rlim_t, because it will affect the result of that test. AC_SYS_LARGEFILE dnl ** check for wide-char classifications dnl FreeBSD has an emtpy wctype.h, so test one of the affected dnl functions if it's really there. AC_CHECK_HEADERS([wctype.h], [AC_CHECK_FUNCS(iswspace)]) AC_CHECK_FUNCS([ftime gmtime_r localtime_r lstat readdir_r]) AC_CHECK_FUNCS([getclock getrusage gettimeofday setitimer times]) AC_CHECK_FUNCS([_chsize ftruncate]) dnl ** check if it is safe to include both and AC_HEADER_TIME dnl ** how do we get a timezone name, and UTC offset ? AC_STRUCT_TIMEZONE dnl ** do we have altzone? FP_DECL_ALTZONE # map standard C types and ISO types to Haskell types FPTOOLS_CHECK_HTYPE(char) FPTOOLS_CHECK_HTYPE(signed char) FPTOOLS_CHECK_HTYPE(unsigned char) FPTOOLS_CHECK_HTYPE(short) FPTOOLS_CHECK_HTYPE(unsigned short) FPTOOLS_CHECK_HTYPE(int) FPTOOLS_CHECK_HTYPE(unsigned int) FPTOOLS_CHECK_HTYPE(long) FPTOOLS_CHECK_HTYPE(unsigned long) if test "$ac_cv_type_long_long" = yes; then FPTOOLS_CHECK_HTYPE(long long) FPTOOLS_CHECK_HTYPE(unsigned long long) fi FPTOOLS_CHECK_HTYPE(float) FPTOOLS_CHECK_HTYPE(double) FPTOOLS_CHECK_HTYPE(ptrdiff_t) FPTOOLS_CHECK_HTYPE(size_t) FPTOOLS_CHECK_HTYPE(wchar_t) # Int32 is a HACK for non-ISO C compilers FPTOOLS_CHECK_HTYPE(sig_atomic_t, Int32) FPTOOLS_CHECK_HTYPE(clock_t) FPTOOLS_CHECK_HTYPE(time_t) FPTOOLS_CHECK_HTYPE(dev_t, Word32) FPTOOLS_CHECK_HTYPE(ino_t) FPTOOLS_CHECK_HTYPE(mode_t) FPTOOLS_CHECK_HTYPE(off_t) FPTOOLS_CHECK_HTYPE(pid_t) FPTOOLS_CHECK_HTYPE(gid_t) FPTOOLS_CHECK_HTYPE(uid_t) FPTOOLS_CHECK_HTYPE(cc_t) FPTOOLS_CHECK_HTYPE(speed_t) FPTOOLS_CHECK_HTYPE(tcflag_t) FPTOOLS_CHECK_HTYPE(nlink_t) FPTOOLS_CHECK_HTYPE(ssize_t) FPTOOLS_CHECK_HTYPE(rlim_t) FPTOOLS_CHECK_HTYPE(wint_t) FPTOOLS_CHECK_HTYPE(intptr_t) FPTOOLS_CHECK_HTYPE(uintptr_t) # Workaround for OSes that don't have intmax_t and uintmax_t, e.g. OpenBSD. if test "$ac_cv_type_long_long" = yes; then fptools_cv_default_htype_intmax=$fptools_cv_htype_long_long fptools_cv_default_htype_uintmax=$fptools_cv_htype_unsigned_long_long else fptools_cv_default_htype_intmax=$fptools_cv_htype_long fptools_cv_default_htype_uintmax=$fptools_cv_htype_unsigned_long fi FPTOOLS_CHECK_HTYPE(intmax_t, $fptools_cv_default_htype_intmax) FPTOOLS_CHECK_HTYPE(uintmax_t, $fptools_cv_default_htype_uintmax) # test errno values FP_CHECK_CONSTS([E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EADV EAFNOSUPPORT EAGAIN EALREADY EBADF EBADMSG EBADRPC EBUSY ECHILD ECOMM ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDIRTY EDOM EDQUOT EEXIST EFAULT EFBIG EFTYPE EHOSTDOWN EHOSTUNREACH EIDRM EILSEQ EINPROGRESS EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE EMULTIHOP ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODATA ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG ENONET ENOPROTOOPT ENOSPC ENOSR ENOSTR ENOSYS ENOTBLK ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE EPROCLIM EPROCUNAVAIL EPROGMISMATCH EPROGUNAVAIL EPROTO EPROTONOSUPPORT EPROTOTYPE ERANGE EREMCHG EREMOTE EROFS ERPCMISMATCH ERREMOTE ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESRMNT ESTALE ETIME ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV ENOCIGAR], [#include #include ]) FP_CHECK_CONSTS([SIGABRT SIGALRM SIGBUS SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGPOLL SIGPROF SIGSYS SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ SIG_BLOCK SIG_SETMASK SIG_UNBLOCK SIG_DFL SIG_IGN SIG_ERR], [ #if HAVE_SIGNAL_H #include #endif]) dnl ** can we open files in binary mode? FP_CHECK_CONST([O_BINARY], [#include ], [0]) # Check for idiosyncracies in some mingw impls of directory handling. FP_READDIR_EOF_ERRNO AC_OUTPUT hugs98-plus-Sep2006/packages/base/include/0000755006511100651110000000000010504340675017102 5ustar rossrosshugs98-plus-Sep2006/packages/base/include/consUtils.h0000644006511100651110000000050510504340221021221 0ustar rossross/* * (c) The University of Glasgow, 2000-2002 * * Win32 Console API helpers. */ #ifndef __CONSUTILS_H__ #define __CONSUTILS_H__ extern int set_console_buffering__(int fd, int cooked); extern int set_console_echo__(int fd, int on); extern int get_console_echo__(int fd); extern int flush_input_console__ (int fd); #endif hugs98-plus-Sep2006/packages/base/include/CTypes.h0000644006511100651110000001552610504340221020456 0ustar rossross/* ----------------------------------------------------------------------------- * Dirty CPP hackery for CTypes/CTypesISO * * (c) The FFI task force, 2000 * -------------------------------------------------------------------------- */ #ifndef CTYPES__H #define CTYPES__H #include "Typeable.h" /* As long as there is no automatic derivation of classes for newtypes we resort to extremely dirty cpp-hackery. :-P Some care has to be taken when the macros below are modified, otherwise the layout rule will bite you. */ /* A hacked version for GHC follows the Haskell 98 version... */ #ifndef __GLASGOW_HASKELL__ #define ARITHMETIC_TYPE(T,C,S,B) \ newtype T = T B deriving (Eq, Ord) ; \ INSTANCE_NUM(T) ; \ INSTANCE_REAL(T) ; \ INSTANCE_READ(T,B) ; \ INSTANCE_SHOW(T,B) ; \ INSTANCE_ENUM(T) ; \ INSTANCE_STORABLE(T) ; \ INSTANCE_TYPEABLE0(T,C,S) ; #define INTEGRAL_TYPE(T,C,S,B) \ ARITHMETIC_TYPE(T,C,S,B) ; \ INSTANCE_BOUNDED(T) ; \ INSTANCE_INTEGRAL(T) ; \ INSTANCE_BITS(T) #define FLOATING_TYPE(T,C,S,B) \ ARITHMETIC_TYPE(T,C,S,B) ; \ INSTANCE_FRACTIONAL(T) ; \ INSTANCE_FLOATING(T) ; \ INSTANCE_REALFRAC(T) ; \ INSTANCE_REALFLOAT(T) #ifndef __GLASGOW_HASKELL__ #define fakeMap map #endif #define INSTANCE_READ(T,B) \ instance Read T where { \ readsPrec p s = fakeMap (\(x, t) -> (T x, t)) (readsPrec p s) } #define INSTANCE_SHOW(T,B) \ instance Show T where { \ showsPrec p (T x) = showsPrec p x } #define INSTANCE_NUM(T) \ instance Num T where { \ (T i) + (T j) = T (i + j) ; \ (T i) - (T j) = T (i - j) ; \ (T i) * (T j) = T (i * j) ; \ negate (T i) = T (negate i) ; \ abs (T i) = T (abs i) ; \ signum (T i) = T (signum i) ; \ fromInteger x = T (fromInteger x) } #define INSTANCE_BOUNDED(T) \ instance Bounded T where { \ minBound = T minBound ; \ maxBound = T maxBound } #define INSTANCE_ENUM(T) \ instance Enum T where { \ succ (T i) = T (succ i) ; \ pred (T i) = T (pred i) ; \ toEnum x = T (toEnum x) ; \ fromEnum (T i) = fromEnum i ; \ enumFrom (T i) = fakeMap T (enumFrom i) ; \ enumFromThen (T i) (T j) = fakeMap T (enumFromThen i j) ; \ enumFromTo (T i) (T j) = fakeMap T (enumFromTo i j) ; \ enumFromThenTo (T i) (T j) (T k) = fakeMap T (enumFromThenTo i j k) } #define INSTANCE_REAL(T) \ instance Real T where { \ toRational (T i) = toRational i } #define INSTANCE_INTEGRAL(T) \ instance Integral T where { \ (T i) `quot` (T j) = T (i `quot` j) ; \ (T i) `rem` (T j) = T (i `rem` j) ; \ (T i) `div` (T j) = T (i `div` j) ; \ (T i) `mod` (T j) = T (i `mod` j) ; \ (T i) `quotRem` (T j) = let (q,r) = i `quotRem` j in (T q, T r) ; \ (T i) `divMod` (T j) = let (d,m) = i `divMod` j in (T d, T m) ; \ toInteger (T i) = toInteger i } #define INSTANCE_BITS(T) \ instance Bits T where { \ (T x) .&. (T y) = T (x .&. y) ; \ (T x) .|. (T y) = T (x .|. y) ; \ (T x) `xor` (T y) = T (x `xor` y) ; \ complement (T x) = T (complement x) ; \ shift (T x) n = T (shift x n) ; \ rotate (T x) n = T (rotate x n) ; \ bit n = T (bit n) ; \ setBit (T x) n = T (setBit x n) ; \ clearBit (T x) n = T (clearBit x n) ; \ complementBit (T x) n = T (complementBit x n) ; \ testBit (T x) n = testBit x n ; \ bitSize (T x) = bitSize x ; \ isSigned (T x) = isSigned x } #define INSTANCE_FRACTIONAL(T) \ instance Fractional T where { \ (T x) / (T y) = T (x / y) ; \ recip (T x) = T (recip x) ; \ fromRational r = T (fromRational r) } #define INSTANCE_FLOATING(T) \ instance Floating T where { \ pi = pi ; \ exp (T x) = T (exp x) ; \ log (T x) = T (log x) ; \ sqrt (T x) = T (sqrt x) ; \ (T x) ** (T y) = T (x ** y) ; \ (T x) `logBase` (T y) = T (x `logBase` y) ; \ sin (T x) = T (sin x) ; \ cos (T x) = T (cos x) ; \ tan (T x) = T (tan x) ; \ asin (T x) = T (asin x) ; \ acos (T x) = T (acos x) ; \ atan (T x) = T (atan x) ; \ sinh (T x) = T (sinh x) ; \ cosh (T x) = T (cosh x) ; \ tanh (T x) = T (tanh x) ; \ asinh (T x) = T (asinh x) ; \ acosh (T x) = T (acosh x) ; \ atanh (T x) = T (atanh x) } #define INSTANCE_REALFRAC(T) \ instance RealFrac T where { \ properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \ truncate (T x) = truncate x ; \ round (T x) = round x ; \ ceiling (T x) = ceiling x ; \ floor (T x) = floor x } #define INSTANCE_REALFLOAT(T) \ instance RealFloat T where { \ floatRadix (T x) = floatRadix x ; \ floatDigits (T x) = floatDigits x ; \ floatRange (T x) = floatRange x ; \ decodeFloat (T x) = decodeFloat x ; \ encodeFloat m n = T (encodeFloat m n) ; \ exponent (T x) = exponent x ; \ significand (T x) = T (significand x) ; \ scaleFloat n (T x) = T (scaleFloat n x) ; \ isNaN (T x) = isNaN x ; \ isInfinite (T x) = isInfinite x ; \ isDenormalized (T x) = isDenormalized x ; \ isNegativeZero (T x) = isNegativeZero x ; \ isIEEE (T x) = isIEEE x ; \ (T x) `atan2` (T y) = T (x `atan2` y) } #define INSTANCE_STORABLE(T) \ instance Storable T where { \ sizeOf (T x) = sizeOf x ; \ alignment (T x) = alignment x ; \ peekElemOff a i = liftM T (peekElemOff (castPtr a) i) ; \ pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x } #else /* __GLASGOW_HASKELL__ */ /* GHC can derive any class for a newtype, so we make use of that * here... */ #define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real #define INTEGRAL_CLASSES Bounded,Integral,Bits #define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat #define ARITHMETIC_TYPE(T,C,S,B) \ newtype T = T B deriving (ARITHMETIC_CLASSES); \ INSTANCE_READ(T,B); \ INSTANCE_SHOW(T,B); \ INSTANCE_TYPEABLE0(T,C,S) ; #define INTEGRAL_TYPE(T,C,S,B) \ newtype T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \ INSTANCE_READ(T,B); \ INSTANCE_SHOW(T,B); \ INSTANCE_TYPEABLE0(T,C,S) ; #define FLOATING_TYPE(T,C,S,B) \ newtype T = T B deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES); \ INSTANCE_READ(T,B); \ INSTANCE_SHOW(T,B); \ INSTANCE_TYPEABLE0(T,C,S) ; #define INSTANCE_READ(T,B) \ instance Read T where { \ readsPrec = unsafeCoerce# (readsPrec :: Int -> ReadS B); \ readList = unsafeCoerce# (readList :: ReadS [B]); } #define INSTANCE_SHOW(T,B) \ instance Show T where { \ showsPrec = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \ show = unsafeCoerce# (show :: B -> String); \ showList = unsafeCoerce# (showList :: [B] -> ShowS); } #endif /* __GLASGOW_HASKELL__ */ #endif hugs98-plus-Sep2006/packages/base/include/HsBase.h0000644006511100651110000003706710504340225020424 0ustar rossross/* ----------------------------------------------------------------------------- * * (c) The University of Glasgow 2001-2004 * * Definitions for package `base' which are visible in Haskell land. * * ---------------------------------------------------------------------------*/ #ifndef __HSBASE_H__ #define __HSBASE_H__ #include "HsBaseConfig.h" /* ultra-evil... */ #undef PACKAGE_BUGREPORT #undef PACKAGE_NAME #undef PACKAGE_STRING #undef PACKAGE_TARNAME #undef PACKAGE_VERSION /* Needed to get the macro version of errno on some OSs (eg. Solaris). We must do this, because these libs are only compiled once, but must work in both single-threaded and multi-threaded programs. */ #define _REENTRANT 1 #include "HsFFI.h" #include #include #include #if HAVE_SYS_TYPES_H #include #endif #if HAVE_UNISTD_H #include #endif #if HAVE_SYS_STAT_H #include #endif #if HAVE_FCNTL_H # include #endif #if HAVE_TERMIOS_H #include #endif #if HAVE_SIGNAL_H #include /* Ultra-ugly: OpenBSD uses broken macros for sigemptyset and sigfillset (missing casts) */ #if __OpenBSD__ #undef sigemptyset #undef sigfillset #endif #endif #if HAVE_ERRNO_H #include #endif #if HAVE_STRING_H #include #endif #if HAVE_DIRENT_H #include #endif #if HAVE_UTIME_H #include #endif #if HAVE_SYS_UTSNAME_H #include #endif #if HAVE_GETTIMEOFDAY # if HAVE_SYS_TIME_H # include # endif #elif HAVE_GETCLOCK # if HAVE_SYS_TIMERS_H # define POSIX_4D9 1 # include # endif #endif #if HAVE_TIME_H #include #endif #if HAVE_SYS_TIMEB_H #include #endif #if HAVE_WINDOWS_H #include #endif #if HAVE_SYS_TIMES_H #include #endif #if HAVE_WINSOCK_H && defined(__MINGW32__) #include #endif #if HAVE_LIMITS_H #include #endif #if HAVE_WCTYPE_H #include #endif #if HAVE_INTTYPES_H # include #elif HAVE_STDINT_H # include #endif #if !defined(__MINGW32__) && !defined(irix_HOST_OS) # if HAVE_SYS_RESOURCE_H # include # endif #endif #if !HAVE_GETRUSAGE && HAVE_SYS_SYSCALL_H # include # if defined(SYS_GETRUSAGE) /* hpux_HOST_OS */ # define getrusage(a, b) syscall(SYS_GETRUSAGE, a, b) # define HAVE_GETRUSAGE 1 # endif #endif /* For System */ #if HAVE_SYS_WAIT_H #include #endif #if HAVE_VFORK_H #include #endif #include "lockFile.h" #include "dirUtils.h" #include "WCsubst.h" #include "runProcess.h" #if defined(__MINGW32__) #include #include #include "timeUtils.h" #include #include #endif #if HAVE_SYS_SELECT_H #include #endif /* in inputReady.c */ int inputReady(int fd, int msecs, int isSock); /* in Signals.c */ extern HsInt nocldstop; #if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) /* in execvpe.c */ extern int execvpe(char *name, char *const argv[], char **envp); extern void pPrPr_disableITimers (void); #endif /* ----------------------------------------------------------------------------- 64-bit operations, defined in longlong.c -------------------------------------------------------------------------- */ #ifdef SUPPORT_LONG_LONGS StgInt stg_gtWord64 (StgWord64, StgWord64); StgInt stg_geWord64 (StgWord64, StgWord64); StgInt stg_eqWord64 (StgWord64, StgWord64); StgInt stg_neWord64 (StgWord64, StgWord64); StgInt stg_ltWord64 (StgWord64, StgWord64); StgInt stg_leWord64 (StgWord64, StgWord64); StgInt stg_gtInt64 (StgInt64, StgInt64); StgInt stg_geInt64 (StgInt64, StgInt64); StgInt stg_eqInt64 (StgInt64, StgInt64); StgInt stg_neInt64 (StgInt64, StgInt64); StgInt stg_ltInt64 (StgInt64, StgInt64); StgInt stg_leInt64 (StgInt64, StgInt64); StgWord64 stg_remWord64 (StgWord64, StgWord64); StgWord64 stg_quotWord64 (StgWord64, StgWord64); StgInt64 stg_remInt64 (StgInt64, StgInt64); StgInt64 stg_quotInt64 (StgInt64, StgInt64); StgInt64 stg_negateInt64 (StgInt64); StgInt64 stg_plusInt64 (StgInt64, StgInt64); StgInt64 stg_minusInt64 (StgInt64, StgInt64); StgInt64 stg_timesInt64 (StgInt64, StgInt64); StgWord64 stg_and64 (StgWord64, StgWord64); StgWord64 stg_or64 (StgWord64, StgWord64); StgWord64 stg_xor64 (StgWord64, StgWord64); StgWord64 stg_not64 (StgWord64); StgWord64 stg_uncheckedShiftL64 (StgWord64, StgInt); StgWord64 stg_uncheckedShiftRL64 (StgWord64, StgInt); StgInt64 stg_uncheckedIShiftL64 (StgInt64, StgInt); StgInt64 stg_uncheckedIShiftRL64 (StgInt64, StgInt); StgInt64 stg_uncheckedIShiftRA64 (StgInt64, StgInt); StgInt64 stg_intToInt64 (StgInt); StgInt stg_int64ToInt (StgInt64); StgWord64 stg_int64ToWord64 (StgInt64); StgWord64 stg_wordToWord64 (StgWord); StgWord stg_word64ToWord (StgWord64); StgInt64 stg_word64ToInt64 (StgWord64); StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da); StgWord64 stg_integerToWord64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da); #endif /* SUPPORT_LONG_LONGS */ /* ----------------------------------------------------------------------------- INLINE functions. These functions are given as inlines here for when compiling via C, but we also generate static versions into the cbits library for when compiling to native code. -------------------------------------------------------------------------- */ #ifndef INLINE # if defined(_MSC_VER) # define INLINE extern __inline # elif defined(__GNUC__) # define INLINE extern inline # else # define INLINE inline # endif #endif INLINE int __hscore_get_errno(void) { return errno; } INLINE void __hscore_set_errno(int e) { errno = e; } #if !defined(_MSC_VER) INLINE int __hscore_s_isreg(m) { return S_ISREG(m); } INLINE int __hscore_s_isdir(m) { return S_ISDIR(m); } INLINE int __hscore_s_isfifo(m) { return S_ISFIFO(m); } INLINE int __hscore_s_isblk(m) { return S_ISBLK(m); } INLINE int __hscore_s_ischr(m) { return S_ISCHR(m); } #ifdef S_ISSOCK INLINE int __hscore_s_issock(m) { return S_ISSOCK(m); } #endif #endif #if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) INLINE int __hscore_sigemptyset( sigset_t *set ) { return sigemptyset(set); } INLINE int __hscore_sigfillset( sigset_t *set ) { return sigfillset(set); } INLINE int __hscore_sigaddset( sigset_t * set, int s ) { return sigaddset(set,s); } INLINE int __hscore_sigdelset( sigset_t * set, int s ) { return sigdelset(set,s); } INLINE int __hscore_sigismember( sigset_t * set, int s ) { return sigismember(set,s); } #endif INLINE void * __hscore_memcpy_dst_off( char *dst, int dst_off, char *src, size_t sz ) { return memcpy(dst+dst_off, src, sz); } INLINE void * __hscore_memcpy_src_off( char *dst, char *src, int src_off, size_t sz ) { return memcpy(dst, src+src_off, sz); } INLINE HsBool __hscore_supportsTextMode() { #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) return HS_BOOL_FALSE; #else return HS_BOOL_TRUE; #endif } INLINE HsInt __hscore_bufsiz() { return BUFSIZ; } INLINE HsInt __hscore_seek_cur() { return SEEK_CUR; } INLINE HsInt __hscore_o_binary() { #if defined(_MSC_VER) return O_BINARY; #else return CONST_O_BINARY; #endif } INLINE int __hscore_o_rdonly() { #ifdef O_RDONLY return O_RDONLY; #else return 0; #endif } INLINE int __hscore_o_wronly( void ) { #ifdef O_WRONLY return O_WRONLY; #else return 0; #endif } INLINE int __hscore_o_rdwr( void ) { #ifdef O_RDWR return O_RDWR; #else return 0; #endif } INLINE int __hscore_o_append( void ) { #ifdef O_APPEND return O_APPEND; #else return 0; #endif } INLINE int __hscore_o_creat( void ) { #ifdef O_CREAT return O_CREAT; #else return 0; #endif } INLINE int __hscore_o_excl( void ) { #ifdef O_EXCL return O_EXCL; #else return 0; #endif } INLINE int __hscore_o_trunc( void ) { #ifdef O_TRUNC return O_TRUNC; #else return 0; #endif } INLINE int __hscore_o_noctty( void ) { #ifdef O_NOCTTY return O_NOCTTY; #else return 0; #endif } INLINE int __hscore_o_nonblock( void ) { #ifdef O_NONBLOCK return O_NONBLOCK; #else return 0; #endif } INLINE HsInt __hscore_seek_set( void ) { return SEEK_SET; } INLINE HsInt __hscore_seek_end( void ) { return SEEK_END; } INLINE int __hscore_ftruncate( int fd, off_t where ) { #if defined(HAVE_FTRUNCATE) return ftruncate(fd,where); #elif defined(HAVE__CHSIZE) return _chsize(fd,where); #else #error at least ftruncate or _chsize functions are required to build #endif } INLINE HsInt __hscore_setmode( HsInt fd, HsBool toBin ) { #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) return setmode(fd,(toBin == HS_BOOL_TRUE) ? _O_BINARY : _O_TEXT); #else return 0; #endif } #if __GLASGOW_HASKELL__ INLINE HsInt __hscore_PrelHandle_write( HsInt fd, HsAddr ptr, HsInt off, int sz ) { return write(fd,(char *)ptr + off, sz); } INLINE HsInt __hscore_PrelHandle_read( HsInt fd, HsAddr ptr, HsInt off, int sz ) { return read(fd,(char *)ptr + off, sz); } #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) INLINE HsInt __hscore_PrelHandle_send( HsInt fd, HsAddr ptr, HsInt off, int sz ) { return send(fd,(char *)ptr + off, sz, 0); } INLINE HsInt __hscore_PrelHandle_recv( HsInt fd, HsAddr ptr, HsInt off, int sz ) { return recv(fd,(char *)ptr + off, sz, 0); } #endif #endif /* __GLASGOW_HASKELL__ */ INLINE HsInt __hscore_mkdir( HsAddr pathName, HsInt mode ) { #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) return mkdir(pathName); #else return mkdir(pathName,mode); #endif } INLINE HsInt __hscore_lstat( HsAddr fname, HsAddr st ) { #if HAVE_LSTAT return lstat((const char*)fname, (struct stat*)st); #else return stat((const char*)fname, (struct stat*)st); #endif } #ifdef PATH_MAX /* A size that will contain many path names, but not necessarily all * (PATH_MAX is not defined on systems with unlimited path length, * e.g. the Hurd). */ INLINE HsInt __hscore_long_path_size() { return PATH_MAX; } #else INLINE HsInt __hscore_long_path_size() { return 4096; } #endif #ifdef R_OK INLINE mode_t __hscore_R_OK() { return R_OK; } #endif #ifdef W_OK INLINE mode_t __hscore_W_OK() { return W_OK; } #endif #ifdef X_OK INLINE mode_t __hscore_X_OK() { return X_OK; } #endif #ifdef S_IRUSR INLINE mode_t __hscore_S_IRUSR() { return S_IRUSR; } #endif #ifdef S_IWUSR INLINE mode_t __hscore_S_IWUSR() { return S_IWUSR; } #endif #ifdef S_IXUSR INLINE mode_t __hscore_S_IXUSR() { return S_IXUSR; } #endif INLINE HsAddr __hscore_d_name( struct dirent* d ) { return (HsAddr)(d->d_name); } INLINE HsInt __hscore_end_of_dir( void ) { return READDIR_ERRNO_EOF; } INLINE void __hscore_free_dirent(HsAddr dEnt) { #if HAVE_READDIR_R free(dEnt); #endif } INLINE HsInt __hscore_sizeof_stat( void ) { return sizeof(struct stat); } INLINE time_t __hscore_st_mtime ( struct stat* st ) { return st->st_mtime; } INLINE off_t __hscore_st_size ( struct stat* st ) { return st->st_size; } #if !defined(_MSC_VER) INLINE mode_t __hscore_st_mode ( struct stat* st ) { return st->st_mode; } #endif #if HAVE_TERMIOS_H INLINE tcflag_t __hscore_lflag( struct termios* ts ) { return ts->c_lflag; } INLINE void __hscore_poke_lflag( struct termios* ts, tcflag_t t ) { ts->c_lflag = t; } INLINE unsigned char* __hscore_ptr_c_cc( struct termios* ts ) { return (unsigned char*) &ts->c_cc; } INLINE HsInt __hscore_sizeof_termios( void ) { #ifndef __MINGW32__ return sizeof(struct termios); #else return 0; #endif } #endif #if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) INLINE HsInt __hscore_sizeof_sigset_t( void ) { return sizeof(sigset_t); } #endif INLINE int __hscore_echo( void ) { #ifdef ECHO return ECHO; #else return 0; #endif } INLINE int __hscore_tcsanow( void ) { #ifdef TCSANOW return TCSANOW; #else return 0; #endif } INLINE int __hscore_icanon( void ) { #ifdef ICANON return ICANON; #else return 0; #endif } INLINE int __hscore_vmin( void ) { #ifdef VMIN return VMIN; #else return 0; #endif } INLINE int __hscore_vtime( void ) { #ifdef VTIME return VTIME; #else return 0; #endif } INLINE int __hscore_sigttou( void ) { #ifdef SIGTTOU return SIGTTOU; #else return 0; #endif } INLINE int __hscore_sig_block( void ) { #ifdef SIG_BLOCK return SIG_BLOCK; #else return 0; #endif } INLINE int __hscore_sig_setmask( void ) { #ifdef SIG_SETMASK return SIG_SETMASK; #else return 0; #endif } INLINE int __hscore_f_getfl( void ) { #ifdef F_GETFL return F_GETFL; #else return 0; #endif } INLINE int __hscore_f_setfl( void ) { #ifdef F_SETFL return F_SETFL; #else return 0; #endif } // defined in rts/RtsStartup.c. extern void* __hscore_get_saved_termios(int fd); extern void __hscore_set_saved_termios(int fd, void* ts); INLINE int __hscore_hs_fileno (FILE *f) { return fileno (f); } INLINE int __hscore_open(char *file, int how, mode_t mode) { #ifdef __MINGW32__ if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND)) return _sopen(file,how,_SH_DENYRW,mode); else return _sopen(file,how,_SH_DENYWR,mode); #else return open(file,how,mode); #endif } // These are wrapped because on some OSs (eg. Linux) they are // macros which redirect to the 64-bit-off_t versions when large file // support is enabled. // INLINE off_t __hscore_lseek(int fd, off_t off, int whence) { return (lseek(fd,off,whence)); } INLINE int __hscore_stat(char *file, struct stat *buf) { return (stat(file,buf)); } INLINE int __hscore_fstat(int fd, struct stat *buf) { return (fstat(fd,buf)); } // select-related stuff #if !defined(__MINGW32__) INLINE int hsFD_SETSIZE(void) { return FD_SETSIZE; } INLINE void hsFD_CLR(int fd, fd_set *fds) { FD_CLR(fd, fds); } INLINE int hsFD_ISSET(int fd, fd_set *fds) { return FD_ISSET(fd, fds); } INLINE void hsFD_SET(int fd, fd_set *fds) { FD_SET(fd, fds); } INLINE int sizeof_fd_set(void) { return sizeof(fd_set); } extern void hsFD_ZERO(fd_set *fds); #endif // gettimeofday()-related #if !defined(__MINGW32__) #define TICK_FREQ 50 INLINE HsInt sizeofTimeVal(void) { return sizeof(struct timeval); } INLINE HsInt getTicksOfDay(void) { struct timeval tv; gettimeofday(&tv, (struct timezone *) NULL); return (tv.tv_sec * TICK_FREQ + tv.tv_usec * TICK_FREQ / 1000000); } INLINE void setTimevalTicks(struct timeval *p, HsInt ticks) { p->tv_sec = ticks / TICK_FREQ; p->tv_usec = (ticks % TICK_FREQ) * (1000000 / TICK_FREQ); } #endif /* !defined(__MINGW32__) */ // Directory-related #if defined(__MINGW32__) /* Make sure we've got the reqd CSIDL_ constants in scope; * w32api header files are lagging a bit in defining the full set. */ #if !defined(CSIDL_APPDATA) #define CSIDL_APPDATA 0x001a #endif #if !defined(CSIDL_PERSONAL) #define CSIDL_PERSONAL 0x0005 #endif #if !defined(CSIDL_PROFILE) #define CSIDL_PROFILE 0x0028 #endif #if !defined(CSIDL_WINDOWS) #define CSIDL_WINDOWS 0x0024 #endif INLINE int __hscore_CSIDL_PROFILE() { return CSIDL_PROFILE; } INLINE int __hscore_CSIDL_APPDATA() { return CSIDL_APPDATA; } INLINE int __hscore_CSIDL_WINDOWS() { return CSIDL_WINDOWS; } INLINE int __hscore_CSIDL_PERSONAL() { return CSIDL_PERSONAL; } #endif #if defined(__MINGW32__) INLINE unsigned int __hscore_get_osver(void) { return _osver; } #endif /* ToDo: write a feature test that doesn't assume 'environ' to * be in scope at link-time. */ extern char** environ; INLINE char **__hscore_environ() { return environ; } /* lossless conversions between pointers and integral types */ INLINE void * __hscore_from_uintptr(uintptr_t n) { return (void *)n; } INLINE void * __hscore_from_intptr (intptr_t n) { return (void *)n; } INLINE uintptr_t __hscore_to_uintptr (void *p) { return (uintptr_t)p; } INLINE intptr_t __hscore_to_intptr (void *p) { return (intptr_t)p; } #endif /* __HSBASE_H__ */ hugs98-plus-Sep2006/packages/base/include/Makefile0000644006511100651110000000051310504340226020531 0ustar rossross# ----------------------------------------------------------------------------- # $Id: Makefile,v 1.6 2005/03/02 16:39:57 ross Exp $ TOP=../.. include $(TOP)/mk/boilerplate.mk H_FILES = $(wildcard *.h) includedir = $(libdir)/include INSTALL_INCLUDES = $(H_FILES) DIST_CLEAN_FILES += HsBaseConfig.h include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/base/include/Typeable.h0000644006511100651110000000432310504340221021005 0ustar rossross/* ---------------------------------------------------------------------------- * Macros to help make Typeable instances. * * INSTANCE_TYPEABLEn(tc,tcname,"tc") defines * * instance Typeable/n/ tc * instance Typeable a => Typeable/n-1/ (tc a) * instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b) * ... * instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an) * -------------------------------------------------------------------------- */ #ifndef TYPEABLE_H #define TYPEABLE_H #define INSTANCE_TYPEABLE0(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] } #ifdef __GLASGOW_HASKELL__ /* For GHC, the extra instances follow from general instance declarations * defined in Data.Typeable. */ #define INSTANCE_TYPEABLE1(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] } #define INSTANCE_TYPEABLE2(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] } #define INSTANCE_TYPEABLE3(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] } #else /* !__GLASGOW_HASKELL__ */ #define INSTANCE_TYPEABLE1(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \ instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault } #define INSTANCE_TYPEABLE2(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \ instance Typeable a => Typeable1 (tycon a) where { \ typeOf1 = typeOf1Default }; \ instance (Typeable a, Typeable b) => Typeable (tycon a b) where { \ typeOf = typeOfDefault } #define INSTANCE_TYPEABLE3(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }; \ instance Typeable a => Typeable2 (tycon a) where { \ typeOf2 = typeOf2Default }; \ instance (Typeable a, Typeable b) => Typeable1 (tycon a b) where { \ typeOf1 = typeOf1Default }; \ instance (Typeable a, Typeable b, Typeable c) => Typeable (tycon a b c) where { \ typeOf = typeOfDefault } #endif /* !__GLASGOW_HASKELL__ */ #endif hugs98-plus-Sep2006/packages/base/include/WCsubst.h0000644006511100651110000000055310504340221020633 0ustar rossross#ifndef WCSUBST_INCL #define WCSUBST_INCL #include int u_iswupper(int wc); int u_iswdigit(int wc); int u_iswalpha(int wc); int u_iswcntrl(int wc); int u_iswspace(int wc); int u_iswprint(int wc); int u_iswlower(int wc); int u_iswalnum(int wc); int u_towlower(int wc); int u_towupper(int wc); int u_towtitle(int wc); int u_gencat(int wc); #endif hugs98-plus-Sep2006/packages/base/include/dirUtils.h0000644006511100651110000000074210504340225021044 0ustar rossross/* * (c) The University of Glasgow 2002 * * Directory Runtime Support */ #ifndef __DIRUTILS_H__ #define __DIRUTILS_H__ extern HsInt __hscore_readdir(HsAddr dirPtr, HsAddr pDirEnt); extern HsInt __hscore_renameFile(HsAddr src, HsAddr dest); #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) extern int __hscore_getFolderPath(HWND hwndOwner, int nFolder, HANDLE hToken, DWORD dwFlags, char* pszPath); #endif #endif /* __DIRUTILS_H__ */ hugs98-plus-Sep2006/packages/base/include/lockFile.h0000644006511100651110000000043610504340225020775 0ustar rossross/* * (c) The University of Glasgow 2001 * * $Id: lockFile.h,v 1.3 2005/01/28 13:36:34 simonmar Exp $ * * lockFile header */ #if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) int lockFile(int fd, int for_writing, int exclusive); int unlockFile(int fd); #endif hugs98-plus-Sep2006/packages/base/include/runProcess.h0000644006511100651110000000277610504340225021421 0ustar rossross/* ---------------------------------------------------------------------------- (c) The University of Glasgow 2004 Interface for code in runProcess.c (providing support for System.Process) ------------------------------------------------------------------------- */ #if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) typedef pid_t ProcHandle; #else // Should really be intptr_t, but we don't have that type on the Haskell side typedef long ProcHandle; #endif #if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) extern ProcHandle runProcess( char *const args[], char *workingDirectory, char **environment, int fdStdInput, int fdStdOutput, int fdStdError, int set_inthandler, long inthandler, int set_quithandler, long quithandler); extern ProcHandle runInteractiveProcess( char *const args[], char *workingDirectory, char **environment, int *pfdStdInput, int *pfdStdOutput, int *pfdStdError); #else extern ProcHandle runProcess( char *cmd, char *workingDirectory, void *environment, int fdStdInput, int fdStdOutput, int fdStdError); extern ProcHandle runInteractiveProcess( char *cmd, char *workingDirectory, void *environment, int *pfdStdInput, int *pfdStdOutput, int *pfdStdError); #endif extern int terminateProcess( ProcHandle handle ); extern int getProcessExitCode( ProcHandle handle, int *pExitCode ); extern int waitForProcess( ProcHandle handle ); hugs98-plus-Sep2006/packages/base/include/timeUtils.h0000644006511100651110000000034610504340221021220 0ustar rossross/* * (c) The University of Glasgow 2002 * * Time Runtime Support */ #ifndef __TIMEUTILS_H__ #define __TIMEUTILS_H__ extern HsAddr __hscore_timezone( void ); extern HsAddr __hscore_tzname( void ); #endif /* __DIRUTILS_H__ */ hugs98-plus-Sep2006/packages/base/include/fpstring.h0000644006511100651110000000061010504340226021074 0ustar rossross void fps_reverse(unsigned char *dest, unsigned char *from, unsigned long len); void fps_intersperse(unsigned char *dest, unsigned char *from, unsigned long len, unsigned char c); unsigned char fps_maximum(unsigned char *p, unsigned long len); unsigned char fps_minimum(unsigned char *p, unsigned long len); unsigned long fps_count(unsigned char *p, unsigned long len, unsigned char w); hugs98-plus-Sep2006/packages/base/include/HsBaseConfig.h.in0000644006511100651110000003477710504340675022175 0ustar rossross/* include/HsBaseConfig.h.in. Generated from configure.ac by autoheader. */ /* The value of E2BIG. */ #undef CONST_E2BIG /* The value of EACCES. */ #undef CONST_EACCES /* The value of EADDRINUSE. */ #undef CONST_EADDRINUSE /* The value of EADDRNOTAVAIL. */ #undef CONST_EADDRNOTAVAIL /* The value of EADV. */ #undef CONST_EADV /* The value of EAFNOSUPPORT. */ #undef CONST_EAFNOSUPPORT /* The value of EAGAIN. */ #undef CONST_EAGAIN /* The value of EALREADY. */ #undef CONST_EALREADY /* The value of EBADF. */ #undef CONST_EBADF /* The value of EBADMSG. */ #undef CONST_EBADMSG /* The value of EBADRPC. */ #undef CONST_EBADRPC /* The value of EBUSY. */ #undef CONST_EBUSY /* The value of ECHILD. */ #undef CONST_ECHILD /* The value of ECOMM. */ #undef CONST_ECOMM /* The value of ECONNABORTED. */ #undef CONST_ECONNABORTED /* The value of ECONNREFUSED. */ #undef CONST_ECONNREFUSED /* The value of ECONNRESET. */ #undef CONST_ECONNRESET /* The value of EDEADLK. */ #undef CONST_EDEADLK /* The value of EDESTADDRREQ. */ #undef CONST_EDESTADDRREQ /* The value of EDIRTY. */ #undef CONST_EDIRTY /* The value of EDOM. */ #undef CONST_EDOM /* The value of EDQUOT. */ #undef CONST_EDQUOT /* The value of EEXIST. */ #undef CONST_EEXIST /* The value of EFAULT. */ #undef CONST_EFAULT /* The value of EFBIG. */ #undef CONST_EFBIG /* The value of EFTYPE. */ #undef CONST_EFTYPE /* The value of EHOSTDOWN. */ #undef CONST_EHOSTDOWN /* The value of EHOSTUNREACH. */ #undef CONST_EHOSTUNREACH /* The value of EIDRM. */ #undef CONST_EIDRM /* The value of EILSEQ. */ #undef CONST_EILSEQ /* The value of EINPROGRESS. */ #undef CONST_EINPROGRESS /* The value of EINTR. */ #undef CONST_EINTR /* The value of EINVAL. */ #undef CONST_EINVAL /* The value of EIO. */ #undef CONST_EIO /* The value of EISCONN. */ #undef CONST_EISCONN /* The value of EISDIR. */ #undef CONST_EISDIR /* The value of ELOOP. */ #undef CONST_ELOOP /* The value of EMFILE. */ #undef CONST_EMFILE /* The value of EMLINK. */ #undef CONST_EMLINK /* The value of EMSGSIZE. */ #undef CONST_EMSGSIZE /* The value of EMULTIHOP. */ #undef CONST_EMULTIHOP /* The value of ENAMETOOLONG. */ #undef CONST_ENAMETOOLONG /* The value of ENETDOWN. */ #undef CONST_ENETDOWN /* The value of ENETRESET. */ #undef CONST_ENETRESET /* The value of ENETUNREACH. */ #undef CONST_ENETUNREACH /* The value of ENFILE. */ #undef CONST_ENFILE /* The value of ENOBUFS. */ #undef CONST_ENOBUFS /* The value of ENOCIGAR. */ #undef CONST_ENOCIGAR /* The value of ENODATA. */ #undef CONST_ENODATA /* The value of ENODEV. */ #undef CONST_ENODEV /* The value of ENOENT. */ #undef CONST_ENOENT /* The value of ENOEXEC. */ #undef CONST_ENOEXEC /* The value of ENOLCK. */ #undef CONST_ENOLCK /* The value of ENOLINK. */ #undef CONST_ENOLINK /* The value of ENOMEM. */ #undef CONST_ENOMEM /* The value of ENOMSG. */ #undef CONST_ENOMSG /* The value of ENONET. */ #undef CONST_ENONET /* The value of ENOPROTOOPT. */ #undef CONST_ENOPROTOOPT /* The value of ENOSPC. */ #undef CONST_ENOSPC /* The value of ENOSR. */ #undef CONST_ENOSR /* The value of ENOSTR. */ #undef CONST_ENOSTR /* The value of ENOSYS. */ #undef CONST_ENOSYS /* The value of ENOTBLK. */ #undef CONST_ENOTBLK /* The value of ENOTCONN. */ #undef CONST_ENOTCONN /* The value of ENOTDIR. */ #undef CONST_ENOTDIR /* The value of ENOTEMPTY. */ #undef CONST_ENOTEMPTY /* The value of ENOTSOCK. */ #undef CONST_ENOTSOCK /* The value of ENOTTY. */ #undef CONST_ENOTTY /* The value of ENXIO. */ #undef CONST_ENXIO /* The value of EOPNOTSUPP. */ #undef CONST_EOPNOTSUPP /* The value of EPERM. */ #undef CONST_EPERM /* The value of EPFNOSUPPORT. */ #undef CONST_EPFNOSUPPORT /* The value of EPIPE. */ #undef CONST_EPIPE /* The value of EPROCLIM. */ #undef CONST_EPROCLIM /* The value of EPROCUNAVAIL. */ #undef CONST_EPROCUNAVAIL /* The value of EPROGMISMATCH. */ #undef CONST_EPROGMISMATCH /* The value of EPROGUNAVAIL. */ #undef CONST_EPROGUNAVAIL /* The value of EPROTO. */ #undef CONST_EPROTO /* The value of EPROTONOSUPPORT. */ #undef CONST_EPROTONOSUPPORT /* The value of EPROTOTYPE. */ #undef CONST_EPROTOTYPE /* The value of ERANGE. */ #undef CONST_ERANGE /* The value of EREMCHG. */ #undef CONST_EREMCHG /* The value of EREMOTE. */ #undef CONST_EREMOTE /* The value of EROFS. */ #undef CONST_EROFS /* The value of ERPCMISMATCH. */ #undef CONST_ERPCMISMATCH /* The value of ERREMOTE. */ #undef CONST_ERREMOTE /* The value of ESHUTDOWN. */ #undef CONST_ESHUTDOWN /* The value of ESOCKTNOSUPPORT. */ #undef CONST_ESOCKTNOSUPPORT /* The value of ESPIPE. */ #undef CONST_ESPIPE /* The value of ESRCH. */ #undef CONST_ESRCH /* The value of ESRMNT. */ #undef CONST_ESRMNT /* The value of ESTALE. */ #undef CONST_ESTALE /* The value of ETIME. */ #undef CONST_ETIME /* The value of ETIMEDOUT. */ #undef CONST_ETIMEDOUT /* The value of ETOOMANYREFS. */ #undef CONST_ETOOMANYREFS /* The value of ETXTBSY. */ #undef CONST_ETXTBSY /* The value of EUSERS. */ #undef CONST_EUSERS /* The value of EWOULDBLOCK. */ #undef CONST_EWOULDBLOCK /* The value of EXDEV. */ #undef CONST_EXDEV /* The value of O_BINARY. */ #undef CONST_O_BINARY /* The value of SIGABRT. */ #undef CONST_SIGABRT /* The value of SIGALRM. */ #undef CONST_SIGALRM /* The value of SIGBUS. */ #undef CONST_SIGBUS /* The value of SIGCHLD. */ #undef CONST_SIGCHLD /* The value of SIGCONT. */ #undef CONST_SIGCONT /* The value of SIGFPE. */ #undef CONST_SIGFPE /* The value of SIGHUP. */ #undef CONST_SIGHUP /* The value of SIGILL. */ #undef CONST_SIGILL /* The value of SIGINT. */ #undef CONST_SIGINT /* The value of SIGKILL. */ #undef CONST_SIGKILL /* The value of SIGPIPE. */ #undef CONST_SIGPIPE /* The value of SIGPOLL. */ #undef CONST_SIGPOLL /* The value of SIGPROF. */ #undef CONST_SIGPROF /* The value of SIGQUIT. */ #undef CONST_SIGQUIT /* The value of SIGSEGV. */ #undef CONST_SIGSEGV /* The value of SIGSTOP. */ #undef CONST_SIGSTOP /* The value of SIGSYS. */ #undef CONST_SIGSYS /* The value of SIGTERM. */ #undef CONST_SIGTERM /* The value of SIGTRAP. */ #undef CONST_SIGTRAP /* The value of SIGTSTP. */ #undef CONST_SIGTSTP /* The value of SIGTTIN. */ #undef CONST_SIGTTIN /* The value of SIGTTOU. */ #undef CONST_SIGTTOU /* The value of SIGURG. */ #undef CONST_SIGURG /* The value of SIGUSR1. */ #undef CONST_SIGUSR1 /* The value of SIGUSR2. */ #undef CONST_SIGUSR2 /* The value of SIGVTALRM. */ #undef CONST_SIGVTALRM /* The value of SIGXCPU. */ #undef CONST_SIGXCPU /* The value of SIGXFSZ. */ #undef CONST_SIGXFSZ /* The value of SIG_BLOCK. */ #undef CONST_SIG_BLOCK /* The value of SIG_DFL. */ #undef CONST_SIG_DFL /* The value of SIG_ERR. */ #undef CONST_SIG_ERR /* The value of SIG_IGN. */ #undef CONST_SIG_IGN /* The value of SIG_SETMASK. */ #undef CONST_SIG_SETMASK /* The value of SIG_UNBLOCK. */ #undef CONST_SIG_UNBLOCK /* Define to 1 if you have the header file. */ #undef HAVE_CTYPE_H /* Define to 1 if you have the declaration of `altzone', and to 0 if you don't. */ #undef HAVE_DECL_ALTZONE /* Define to 1 if you have the declaration of `tzname', and to 0 if you don't. */ #undef HAVE_DECL_TZNAME /* Define to 1 if you have the header file. */ #undef HAVE_DIRENT_H /* Define to 1 if you have the header file. */ #undef HAVE_ERRNO_H /* Define to 1 if you have the header file. */ #undef HAVE_FCNTL_H /* Define to 1 if you have the `fork' function. */ #undef HAVE_FORK /* Define to 1 if you have the `ftime' function. */ #undef HAVE_FTIME /* Define to 1 if you have the `ftruncate' function. */ #undef HAVE_FTRUNCATE /* Define to 1 if you have the `getclock' function. */ #undef HAVE_GETCLOCK /* Define to 1 if you have the `getrusage' function. */ #undef HAVE_GETRUSAGE /* Define to 1 if you have the `gettimeofday' function. */ #undef HAVE_GETTIMEOFDAY /* Define to 1 if you have the `gmtime_r' function. */ #undef HAVE_GMTIME_R /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if you have the `iswspace' function. */ #undef HAVE_ISWSPACE /* Define to 1 if you have the header file. */ #undef HAVE_LIMITS_H /* Define to 1 if you have the `localtime_r' function. */ #undef HAVE_LOCALTIME_R /* Define to 1 if the system has the type `long long'. */ #undef HAVE_LONG_LONG /* Define to 1 if you have the `lstat' function. */ #undef HAVE_LSTAT /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the `readdir_r' function. */ #undef HAVE_READDIR_R /* Define to 1 if you have the `setitimer' function. */ #undef HAVE_SETITIMER /* Define to 1 if you have the header file. */ #undef HAVE_SIGNAL_H /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if `tm_zone' is member of `struct tm'. */ #undef HAVE_STRUCT_TM_TM_ZONE /* Define to 1 if you have the header file. */ #undef HAVE_SYS_RESOURCE_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_SELECT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_SYSCALL_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIMEB_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIMERS_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIMES_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_UTSNAME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_WAIT_H /* Define to 1 if you have the header file. */ #undef HAVE_TERMIOS_H /* Define to 1 if you have the `times' function. */ #undef HAVE_TIMES /* Define to 1 if you have the header file. */ #undef HAVE_TIME_H /* Define to 1 if your `struct tm' has `tm_zone'. Deprecated, use `HAVE_STRUCT_TM_TM_ZONE' instead. */ #undef HAVE_TM_ZONE /* Define to 1 if you don't have `tm_zone' but do have the external array `tzname'. */ #undef HAVE_TZNAME /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to 1 if you have the header file. */ #undef HAVE_UTIME_H /* Define to 1 if you have the `vfork' function. */ #undef HAVE_VFORK /* Define to 1 if you have the header file. */ #undef HAVE_VFORK_H /* Define to 1 if you have the header file. */ #undef HAVE_WCTYPE_H /* Define to 1 if you have the header file. */ #undef HAVE_WINDOWS_H /* Define to 1 if you have the header file. */ #undef HAVE_WINSOCK_H /* Define to 1 if `fork' works. */ #undef HAVE_WORKING_FORK /* Define to 1 if `vfork' works. */ #undef HAVE_WORKING_VFORK /* Define to 1 if you have the `_chsize' function. */ #undef HAVE__CHSIZE /* Define to Haskell type for cc_t */ #undef HTYPE_CC_T /* Define to Haskell type for char */ #undef HTYPE_CHAR /* Define to Haskell type for clock_t */ #undef HTYPE_CLOCK_T /* Define to Haskell type for dev_t */ #undef HTYPE_DEV_T /* Define to Haskell type for double */ #undef HTYPE_DOUBLE /* Define to Haskell type for float */ #undef HTYPE_FLOAT /* Define to Haskell type for gid_t */ #undef HTYPE_GID_T /* Define to Haskell type for ino_t */ #undef HTYPE_INO_T /* Define to Haskell type for int */ #undef HTYPE_INT /* Define to Haskell type for intmax_t */ #undef HTYPE_INTMAX_T /* Define to Haskell type for intptr_t */ #undef HTYPE_INTPTR_T /* Define to Haskell type for long */ #undef HTYPE_LONG /* Define to Haskell type for long long */ #undef HTYPE_LONG_LONG /* Define to Haskell type for mode_t */ #undef HTYPE_MODE_T /* Define to Haskell type for nlink_t */ #undef HTYPE_NLINK_T /* Define to Haskell type for off_t */ #undef HTYPE_OFF_T /* Define to Haskell type for pid_t */ #undef HTYPE_PID_T /* Define to Haskell type for ptrdiff_t */ #undef HTYPE_PTRDIFF_T /* Define to Haskell type for rlim_t */ #undef HTYPE_RLIM_T /* Define to Haskell type for short */ #undef HTYPE_SHORT /* Define to Haskell type for signed char */ #undef HTYPE_SIGNED_CHAR /* Define to Haskell type for sig_atomic_t */ #undef HTYPE_SIG_ATOMIC_T /* Define to Haskell type for size_t */ #undef HTYPE_SIZE_T /* Define to Haskell type for speed_t */ #undef HTYPE_SPEED_T /* Define to Haskell type for ssize_t */ #undef HTYPE_SSIZE_T /* Define to Haskell type for tcflag_t */ #undef HTYPE_TCFLAG_T /* Define to Haskell type for time_t */ #undef HTYPE_TIME_T /* Define to Haskell type for uid_t */ #undef HTYPE_UID_T /* Define to Haskell type for uintmax_t */ #undef HTYPE_UINTMAX_T /* Define to Haskell type for uintptr_t */ #undef HTYPE_UINTPTR_T /* Define to Haskell type for unsigned char */ #undef HTYPE_UNSIGNED_CHAR /* Define to Haskell type for unsigned int */ #undef HTYPE_UNSIGNED_INT /* Define to Haskell type for unsigned long */ #undef HTYPE_UNSIGNED_LONG /* Define to Haskell type for unsigned long long */ #undef HTYPE_UNSIGNED_LONG_LONG /* Define to Haskell type for unsigned short */ #undef HTYPE_UNSIGNED_SHORT /* Define to Haskell type for wchar_t */ #undef HTYPE_WCHAR_T /* Define to Haskell type for wint_t */ #undef HTYPE_WINT_T /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* readdir() sets errno to this upon EOF */ #undef READDIR_ERRNO_EOF /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS /* Define to 1 if you can safely include both and . */ #undef TIME_WITH_SYS_TIME /* Define to 1 if your declares `struct tm'. */ #undef TM_IN_SYS_TIME /* Number of bits in a file offset, on hosts where this is settable. */ #undef _FILE_OFFSET_BITS /* Define for large files, on AIX-style hosts. */ #undef _LARGE_FILES /* Define to empty if `const' does not conform to ANSI C. */ #undef const /* Define to `int' if does not define. */ #undef pid_t /* Define as `fork' if `vfork' does not work. */ #undef vfork hugs98-plus-Sep2006/packages/base/package.conf.in0000644006511100651110000000651610504340226020326 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: Control.Applicative, Control.Arrow, Control.Concurrent, Control.Concurrent.Chan, Control.Concurrent.MVar, Control.Concurrent.QSem, Control.Concurrent.QSemN, Control.Concurrent.SampleVar, Control.Exception, Control.Monad, Control.Monad.Fix, Control.Monad.Instances, Control.Monad.ST, Control.Monad.ST.Lazy, Control.Monad.ST.Strict, Control.Parallel, Control.Parallel.Strategies, Data.Array, Data.Array.Base, Data.Array.Diff, Data.Array.IArray, Data.Array.IO, Data.Array.IO.Internals, Data.Array.MArray, Data.Array.ST, Data.Array.Storable, Data.Array.Unboxed, Data.Bits, Data.Bool, Data.ByteString, Data.ByteString.Char8, Data.ByteString.Lazy Data.ByteString.Lazy.Char8 Data.ByteString.Base Data.ByteString.Fusion Data.Char, Data.Complex, Data.Dynamic, Data.Either, Data.Eq, Data.Fixed, Data.Foldable, Data.FunctorM, Data.Generics, Data.Generics.Aliases, Data.Generics.Basics, Data.Generics.Instances, Data.Generics.Schemes, Data.Generics.Text, Data.Generics.Twins, Data.Graph, Data.HashTable, Data.IORef, Data.Int, Data.IntMap, Data.IntSet, Data.Ix, Data.List, Data.Maybe, Data.Map, Data.Monoid, Data.Ord, Data.PackedString, Data.Queue, Data.Ratio, Data.STRef, Data.STRef.Lazy, Data.STRef.Strict, Data.Sequence, Data.Set, Data.Traversable, Data.Tree, Data.Tuple, Data.Typeable, Data.Unique, Data.Version, Data.Word, Debug.Trace, Foreign, Foreign.C, Foreign.C.Error, Foreign.C.String, Foreign.C.Types, Foreign.Concurrent, Foreign.ForeignPtr, Foreign.Marshal, Foreign.Marshal.Alloc, Foreign.Marshal.Array, Foreign.Marshal.Error, Foreign.Marshal.Pool, Foreign.Marshal.Utils, Foreign.Ptr, Foreign.StablePtr, Foreign.Storable, GHC.ConsoleHandler, GHC.Dotnet, GHC.Dynamic, GHC.Exts, GHC.ForeignPtr, GHC.Handle, GHC.IO, GHC.Int, GHC.PArr, GHC.PrimopWrappers, GHC.Unicode, GHC.Word, Numeric, Prelude, System.Cmd, System.Console.GetOpt, System.CPUTime, System.Directory, System.Directory.Internals, System.Environment, System.Exit, System.IO, System.IO.Error, System.IO.Unsafe, System.Info, System.Locale, System.Mem, System.Mem.StableName, System.Mem.Weak, System.Posix.Internals, System.Posix.Signals, System.Posix.Types, System.Process, System.Process.Internals, System.Random, System.Time, Text.ParserCombinators.ReadP, Text.ParserCombinators.ReadPrec, Text.PrettyPrint, Text.PrettyPrint.HughesPJ, Text.Printf, Text.Read, Text.Read.Lex, Text.Show, Text.Show.Functions, GHC.Arr, GHC.Base, GHC.Conc, GHC.Enum, GHC.Err, GHC.Exception, GHC.Float, GHC.IOBase, GHC.List, GHC.Num, GHC.Pack, GHC.Prim, GHC.Ptr, GHC.Read, GHC.Real, GHC.ST, GHC.STRef, GHC.Show, GHC.Stable, GHC.Storable, GHC.TopHandler, GHC.Weak hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR #ifndef INSTALLING , LIB_DIR"/cbits" #endif hs-libraries: "HSbase" extra-libraries: "HSbase_cbits" #if defined(mingw32_HOST_OS) || defined(__MINGW32__) || defined(_MSC_VER) , "wsock32", "msvcrt", "kernel32", "user32", "shell32" #endif include-dirs: INCLUDE_DIR includes: HsBase.h depends: rts hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/base/prologue.txt0000644006511100651110000000026710504340221020044 0ustar rossrossThis package contains the @Prelude@ and its support libraries, and a large collection of useful libraries ranging from data structures to parsing combinators and debugging utilities. hugs98-plus-Sep2006/packages/haskell98/0000755006511100651110000000000010504340573016346 5ustar rossrosshugs98-plus-Sep2006/packages/haskell98/CForeign.hs0000644006511100651110000000007410504340231020366 0ustar rossrossmodule CForeign ( module Foreign.C ) where import Foreign.C hugs98-plus-Sep2006/packages/haskell98/Array.hs0000644006511100651110000000032010504340231017742 0ustar rossrossmodule Array ( module Ix, -- export all of Ix for convenience Array, array, listArray, (!), bounds, indices, elems, assocs, accumArray, (//), accum, ixmap ) where import Ix import Data.Array hugs98-plus-Sep2006/packages/haskell98/Bits.hs0000644006511100651110000000006710504340231017575 0ustar rossrossmodule Bits (module Data.Bits) where import Data.Bits hugs98-plus-Sep2006/packages/haskell98/CError.hs0000644006511100651110000000010410504340231020060 0ustar rossrossmodule CError (module Foreign.C.Error) where import Foreign.C.Error hugs98-plus-Sep2006/packages/haskell98/Directory.hs0000644006511100651110000000057710504340231020646 0ustar rossrossmodule Directory ( Permissions( Permissions, readable, writable, executable, searchable ), createDirectory, removeDirectory, removeFile, renameDirectory, renameFile, getDirectoryContents, getCurrentDirectory, setCurrentDirectory, doesFileExist, doesDirectoryExist, getPermissions, setPermissions, getModificationTime ) where import System.Directory hugs98-plus-Sep2006/packages/haskell98/CPUTime.hs0000644006511100651110000000012410504340231020134 0ustar rossrossmodule CPUTime ( getCPUTime, cpuTimePrecision ) where import System.CPUTime hugs98-plus-Sep2006/packages/haskell98/CString.hs0000644006511100651110000000010710504340231020240 0ustar rossrossmodule CString (module Foreign.C.String) where import Foreign.C.String hugs98-plus-Sep2006/packages/haskell98/CTypes.hs0000644006511100651110000000010410504340231020073 0ustar rossrossmodule CTypes (module Foreign.C.Types) where import Foreign.C.Types hugs98-plus-Sep2006/packages/haskell98/Char.hs0000644006511100651110000000051310504340231017545 0ustar rossrossmodule Char ( isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum, digitToInt, intToDigit, toUpper, toLower, ord, chr, readLitChar, showLitChar, lexLitChar, -- ...and what the Prelude exports Char, String ) where import Data.Char hugs98-plus-Sep2006/packages/haskell98/Complex.hs0000644006511100651110000000021610504340231020277 0ustar rossrossmodule Complex ( Complex((:+)), realPart, imagPart, conjugate, mkPolar, cis, polar, magnitude, phase ) where import Data.Complex hugs98-plus-Sep2006/packages/haskell98/MarshalAlloc.hs0000644006511100651110000000012610504340231021232 0ustar rossrossmodule MarshalAlloc (module Foreign.Marshal.Alloc) where import Foreign.Marshal.Alloc hugs98-plus-Sep2006/packages/haskell98/ForeignPtr.hs0000644006511100651110000000011610504340231020746 0ustar rossrossmodule ForeignPtr (module Foreign.ForeignPtr) where import Foreign.ForeignPtr hugs98-plus-Sep2006/packages/haskell98/IO.hs0000644006511100651110000000416210504340231017203 0ustar rossrossmodule IO ( Handle, HandlePosn, IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode), BufferMode(NoBuffering,LineBuffering,BlockBuffering), SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd), stdin, stdout, stderr, openFile, hClose, hFileSize, hIsEOF, isEOF, hSetBuffering, hGetBuffering, hFlush, hGetPosn, hSetPosn, hSeek, hWaitForInput, hReady, hGetChar, hGetLine, hLookAhead, hGetContents, hPutChar, hPutStr, hPutStrLn, hPrint, hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable, isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError, isFullError, isEOFError, isIllegalOperation, isPermissionError, isUserError, ioeGetErrorString, ioeGetHandle, ioeGetFileName, try, bracket, bracket_, -- ...and what the Prelude exports IO, FilePath, IOError, ioError, userError, catch, interact, putChar, putStr, putStrLn, print, getChar, getLine, getContents, readFile, writeFile, appendFile, readIO, readLn ) where import System.IO import System.IO.Error -- | The 'bracket' function captures a common allocate, compute, deallocate -- idiom in which the deallocation step must occur even in the case of an -- error during computation. This is similar to try-catch-finally in Java. -- -- This version handles only IO errors, as defined by Haskell 98. -- The version of @bracket@ in "Control.Exception" handles all exceptions, -- and should be used instead. bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket before after m = do x <- before rs <- try (m x) after x case rs of Right r -> return r Left e -> ioError e -- | A variant of 'bracket' where the middle computation doesn't want @x@. -- -- This version handles only IO errors, as defined by Haskell 98. -- The version of @bracket_@ in "Control.Exception" handles all exceptions, -- and should be used instead. bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c bracket_ before after m = do x <- before rs <- try m after x case rs of Right r -> return r Left e -> ioError e hugs98-plus-Sep2006/packages/haskell98/Int.hs0000644006511100651110000000006510504340231017424 0ustar rossrossmodule Int ( module Data.Int ) where import Data.Int hugs98-plus-Sep2006/packages/haskell98/Ix.hs0000644006511100651110000000011710504340231017250 0ustar rossrossmodule Ix ( Ix(range, index, inRange), rangeSize ) where import Data.Ix hugs98-plus-Sep2006/packages/haskell98/LICENSE0000644006511100651110000000254110504340231017344 0ustar rossrossCode derived from the document "Report on the Programming Language Haskell 98", is distributed under the following license: Copyright (c) 2002 Simon Peyton Jones The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Language. ----------------------------------------------------------------------------- Code derived from the document "The Haskell 98 Foreign Function Interface, An Addendum to the Haskell 98 Report" is distributed under the following license: Copyright (c) 2002 Manuel M. T. Chakravarty The authors intend this Report to belong to the entire Haskell community, and so we grant permission to copy and distribute it for any purpose, provided that it is reproduced in its entirety, including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Foreign Function Interface. hugs98-plus-Sep2006/packages/haskell98/List.hs0000644006511100651110000000215310504340231017605 0ustar rossrossmodule List ( elemIndex, elemIndices, find, findIndex, findIndices, nub, nubBy, delete, deleteBy, (\\), deleteFirstsBy, union, unionBy, intersect, intersectBy, intersperse, transpose, partition, group, groupBy, inits, tails, isPrefixOf, isSuffixOf, mapAccumL, mapAccumR, sort, sortBy, insert, insertBy, maximumBy, minimumBy, genericLength, genericTake, genericDrop, genericSplitAt, genericIndex, genericReplicate, zip4, zip5, zip6, zip7, zipWith4, zipWith5, zipWith6, zipWith7, unzip4, unzip5, unzip6, unzip7, unfoldr, -- ...and what the Prelude exports -- []((:), []), -- This is built-in syntax map, (++), concat, filter, head, last, tail, init, null, length, (!!), foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1, iterate, repeat, replicate, cycle, take, drop, splitAt, takeWhile, dropWhile, span, break, lines, words, unlines, unwords, reverse, and, or, any, all, elem, notElem, lookup, sum, product, maximum, minimum, concatMap, zip, zip3, zipWith, zipWith3, unzip, unzip3 ) where import Data.List hiding (foldl') hugs98-plus-Sep2006/packages/haskell98/Locale.hs0000644006511100651110000000040310504340231020065 0ustar rossrossmodule Locale ( TimeLocale(..), defaultTimeLocale ) where import System.Locale ( -- just the bits that are specified by Haskell 98 TimeLocale(TimeLocale,wDays,months,amPm,dateTimeFmt, dateFmt,timeFmt,time12Fmt), defaultTimeLocale ) hugs98-plus-Sep2006/packages/haskell98/Makefile0000644006511100651110000000054410504340231020000 0ustar rossross# ----------------------------------------------------------------------------- # $Id: Makefile,v 1.8 2004/11/26 16:22:11 simonmar Exp $ TOP=.. include $(TOP)/mk/boilerplate.mk ALL_DIRS = PACKAGE = haskell98 VERSION = 1.0 PACKAGE_DEPS = base SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/haskell98/MarshalArray.hs0000644006511100651110000000012610504340231021256 0ustar rossrossmodule MarshalArray (module Foreign.Marshal.Array) where import Foreign.Marshal.Array hugs98-plus-Sep2006/packages/haskell98/MarshalError.hs0000644006511100651110000000051310504340231021271 0ustar rossrossmodule MarshalError ( module Foreign.Marshal.Error, IOErrorType, mkIOError, alreadyExistsErrorType, doesNotExistErrorType, alreadyInUseErrorType, fullErrorType, eofErrorType, illegalOperationErrorType, permissionErrorType, userErrorType, annotateIOError ) where import System.IO.Error import Foreign.Marshal.Error hugs98-plus-Sep2006/packages/haskell98/MarshalUtils.hs0000644006511100651110000000012610504340231021300 0ustar rossrossmodule MarshalUtils (module Foreign.Marshal.Utils) where import Foreign.Marshal.Utils hugs98-plus-Sep2006/packages/haskell98/Maybe.hs0000644006511100651110000000033310504340231017725 0ustar rossrossmodule Maybe ( isJust, isNothing, fromJust, fromMaybe, listToMaybe, maybeToList, catMaybes, mapMaybe, -- ...and what the Prelude exports Maybe(Nothing, Just), maybe ) where import Data.Maybe hugs98-plus-Sep2006/packages/haskell98/Monad.hs0000644006511100651110000000055310504340231017732 0ustar rossrossmodule Monad ( MonadPlus(mzero, mplus), join, guard, when, unless, ap, msum, filterM, mapAndUnzipM, zipWithM, zipWithM_, foldM, liftM, liftM2, liftM3, liftM4, liftM5, -- ...and what the Prelude exports Monad((>>=), (>>), return, fail), Functor(fmap), mapM, mapM_, sequence, sequence_, (=<<), ) where import Control.Monad hugs98-plus-Sep2006/packages/haskell98/Ptr.hs0000644006511100651110000000007110504340231017434 0ustar rossrossmodule Ptr (module Foreign.Ptr) where import Foreign.Ptr hugs98-plus-Sep2006/packages/haskell98/Random.hs0000644006511100651110000000034410504340231020112 0ustar rossrossmodule Random ( RandomGen(next, split, genRange), StdGen, mkStdGen, Random( random, randomR, randoms, randomRs, randomIO, randomRIO ), getStdRandom, getStdGen, setStdGen, newStdGen ) where import System.Random hugs98-plus-Sep2006/packages/haskell98/Ratio.hs0000644006511100651110000000015510504340231017750 0ustar rossrossmodule Ratio ( Ratio, Rational, (%), numerator, denominator, approxRational ) where import Data.Ratio hugs98-plus-Sep2006/packages/haskell98/StablePtr.hs0000644006511100651110000000011310504340231020564 0ustar rossrossmodule StablePtr (module Foreign.StablePtr) where import Foreign.StablePtr hugs98-plus-Sep2006/packages/haskell98/Storable.hs0000644006511100651110000000011010504340231020434 0ustar rossrossmodule Storable (module Foreign.Storable) where import Foreign.Storable hugs98-plus-Sep2006/packages/haskell98/System.hs0000644006511100651110000000030110504340231020147 0ustar rossrossmodule System ( ExitCode(ExitSuccess,ExitFailure), getArgs, getProgName, getEnv, system, exitWith, exitFailure ) where import System.Exit import System.Environment import System.Cmd hugs98-plus-Sep2006/packages/haskell98/Time.hs0000644006511100651110000000113110504340231017563 0ustar rossrossmodule Time ( ClockTime, Month(January,February,March,April,May,June, July,August,September,October,November,December), Day(Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday), CalendarTime(CalendarTime, ctYear, ctMonth, ctDay, ctHour, ctMin, ctSec, ctPicosec, ctWDay, ctYDay, ctTZName, ctTZ, ctIsDST), TimeDiff(TimeDiff, tdYear, tdMonth, tdDay, tdHour, tdMin, tdSec, tdPicosec), getClockTime, addToClockTime, diffClockTimes, toCalendarTime, toUTCTime, toClockTime, calendarTimeToString, formatCalendarTime ) where import System.Time hugs98-plus-Sep2006/packages/haskell98/Word.hs0000644006511100651110000000007010504340231017601 0ustar rossrossmodule Word ( module Data.Word ) where import Data.Word hugs98-plus-Sep2006/packages/haskell98/haskell98.cabal0000644006511100651110000000156310504340231021132 0ustar rossrossname: haskell98 version: 1.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org synopsis: Compatibility with Haskell 98 description: This package provides compatibility with the modules of Haskell 98 and the FFI addendum, by means of wrappers around modules from the base package (which in many cases have additional features). However Prelude, Numeric and Foreign are provided directly by the base package. homepage: http://www.haskell.org/definition/ build-depends: base exposed-modules: -- Haskell 98 (Prelude and Numeric are in the base package) Array, CPUTime, Char, Complex, Directory, IO, Ix, List, Locale, Maybe, Monad, Random, Ratio, System, Time, -- FFI addendum (Foreign is in the base package) Bits, CError, CForeign, CString, CTypes, ForeignPtr, Int, MarshalAlloc, MarshalArray, MarshalError, MarshalUtils, Ptr, StablePtr, Storable, Word hugs98-plus-Sep2006/packages/haskell98/package.conf.in0000644006511100651110000000123610504340231021206 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: Array, Bits, CError, CForeign, CPUTime, CString, CTypes, Char, Complex, Directory, ForeignPtr, IO, Int, Ix, List, Locale, MarshalAlloc, MarshalArray, MarshalError, MarshalUtils, Maybe, Monad, Ptr, Random, Ratio, StablePtr, Storable, System, Time, Word hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HShaskell98" extra-libraries: include-dirs: includes: depends: base hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/haskell98/prologue.txt0000644006511100651110000000100510504340231020726 0ustar rossrossThis package provides compatibility with the modules of Haskell 98 and the FFI addendum, by means of wrappers around modules from the @base@ package (which in many cases have additional features). However @Prelude@, @Numeric@ and @Foreign@ are provided directly by the @base@ package. The modules of this package are documented in the /Revised Haskell 98 Report/, at , and the /Haskell 98 Foreign Function Interface/ addendum, at . hugs98-plus-Sep2006/packages/haskell-src/0000755006511100651110000000000010504340573016752 5ustar rossrosshugs98-plus-Sep2006/packages/haskell-src/Language/0000755006511100651110000000000010504340234020467 5ustar rossrosshugs98-plus-Sep2006/packages/haskell-src/Language/Haskell/0000755006511100651110000000000010504340576022063 5ustar rossrosshugs98-plus-Sep2006/packages/haskell-src/Language/Haskell/Parser.hs0000644006511100651110000065410310504340577023665 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Parser -- Copyright : (c) Simon Marlow, Sven Panne 1997-2000 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Haskell parser. -- ----------------------------------------------------------------------------- module Language.Haskell.Parser ( parseModule, parseModuleWithMode, ParseMode(..), defaultParseMode, ParseResult(..)) where import Language.Haskell.Syntax import Language.Haskell.ParseMonad import Language.Haskell.Lexer import Language.Haskell.ParseUtils -- parser produced by Happy Version 1.15 data HappyAbsSyn = HappyTerminal Token | HappyErrorToken Int | HappyAbsSyn4 (HsModule) | HappyAbsSyn5 (([HsImportDecl],[HsDecl])) | HappyAbsSyn7 (()) | HappyAbsSyn9 (Maybe [HsExportSpec]) | HappyAbsSyn10 ([HsExportSpec]) | HappyAbsSyn13 (HsExportSpec) | HappyAbsSyn14 ([HsImportDecl]) | HappyAbsSyn15 (HsImportDecl) | HappyAbsSyn16 (Bool) | HappyAbsSyn17 (Maybe Module) | HappyAbsSyn18 (Maybe (Bool, [HsImportSpec])) | HappyAbsSyn19 ((Bool, [HsImportSpec])) | HappyAbsSyn21 ([HsImportSpec]) | HappyAbsSyn22 (HsImportSpec) | HappyAbsSyn23 ([HsCName]) | HappyAbsSyn24 (HsCName) | HappyAbsSyn25 (HsDecl) | HappyAbsSyn26 (Int) | HappyAbsSyn27 (HsAssoc) | HappyAbsSyn28 ([HsOp]) | HappyAbsSyn29 ([HsDecl]) | HappyAbsSyn32 ([HsType]) | HappyAbsSyn38 ([HsName]) | HappyAbsSyn39 (HsType) | HappyAbsSyn42 (HsQName) | HappyAbsSyn43 (HsQualType) | HappyAbsSyn44 (HsContext) | HappyAbsSyn46 ((HsName, [HsName])) | HappyAbsSyn48 ([HsConDecl]) | HappyAbsSyn49 (HsConDecl) | HappyAbsSyn50 ((HsName, [HsBangType])) | HappyAbsSyn52 (HsBangType) | HappyAbsSyn54 ([([HsName],HsBangType)]) | HappyAbsSyn55 (([HsName],HsBangType)) | HappyAbsSyn57 ([HsQName]) | HappyAbsSyn65 (HsRhs) | HappyAbsSyn66 ([HsGuardedRhs]) | HappyAbsSyn67 (HsGuardedRhs) | HappyAbsSyn68 (HsExp) | HappyAbsSyn75 ([HsPat]) | HappyAbsSyn76 (HsPat) | HappyAbsSyn81 ([HsExp]) | HappyAbsSyn84 ([HsStmt]) | HappyAbsSyn85 (HsStmt) | HappyAbsSyn86 ([HsAlt]) | HappyAbsSyn89 (HsAlt) | HappyAbsSyn90 (HsGuardedAlts) | HappyAbsSyn91 ([HsGuardedAlt]) | HappyAbsSyn92 (HsGuardedAlt) | HappyAbsSyn96 ([HsFieldUpdate]) | HappyAbsSyn97 (HsFieldUpdate) | HappyAbsSyn99 (HsName) | HappyAbsSyn108 (HsOp) | HappyAbsSyn109 (HsQOp) | HappyAbsSyn123 (HsLiteral) | HappyAbsSyn124 (SrcLoc) | HappyAbsSyn127 (Module) type HappyReduction m = Int -> (Token) -> HappyState (Token) (HappyStk HappyAbsSyn -> m HappyAbsSyn) -> [HappyState (Token) (HappyStk HappyAbsSyn -> m HappyAbsSyn)] -> HappyStk HappyAbsSyn -> m HappyAbsSyn action_0, action_1, action_2, action_3, action_4, action_5, action_6, action_7, action_8, action_9, action_10, action_11, action_12, action_13, action_14, action_15, action_16, action_17, action_18, action_19, action_20, action_21, action_22, action_23, action_24, action_25, action_26, action_27, action_28, action_29, action_30, action_31, action_32, action_33, action_34, action_35, action_36, action_37, action_38, action_39, action_40, action_41, action_42, action_43, action_44, action_45, action_46, action_47, action_48, action_49, action_50, action_51, action_52, action_53, action_54, action_55, action_56, action_57, action_58, action_59, action_60, action_61, action_62, action_63, action_64, action_65, action_66, action_67, action_68, action_69, action_70, action_71, action_72, action_73, action_74, action_75, action_76, action_77, action_78, action_79, action_80, action_81, action_82, action_83, action_84, action_85, action_86, action_87, action_88, action_89, action_90, action_91, action_92, action_93, action_94, action_95, action_96, action_97, action_98, action_99, action_100, action_101, action_102, action_103, action_104, action_105, action_106, action_107, action_108, action_109, action_110, action_111, action_112, action_113, action_114, action_115, action_116, action_117, action_118, action_119, action_120, action_121, action_122, action_123, action_124, action_125, action_126, action_127, action_128, action_129, action_130, action_131, action_132, action_133, action_134, action_135, action_136, action_137, action_138, action_139, action_140, action_141, action_142, action_143, action_144, action_145, action_146, action_147, action_148, action_149, action_150, action_151, action_152, action_153, action_154, action_155, action_156, action_157, action_158, action_159, action_160, action_161, action_162, action_163, action_164, action_165, action_166, action_167, action_168, action_169, action_170, action_171, action_172, action_173, action_174, action_175, action_176, action_177, action_178, action_179, action_180, action_181, action_182, action_183, action_184, action_185, action_186, action_187, action_188, action_189, action_190, action_191, action_192, action_193, action_194, action_195, action_196, action_197, action_198, action_199, action_200, action_201, action_202, action_203, action_204, action_205, action_206, action_207, action_208, action_209, action_210, action_211, action_212, action_213, action_214, action_215, action_216, action_217, action_218, action_219, action_220, action_221, action_222, action_223, action_224, action_225, action_226, action_227, action_228, action_229, action_230, action_231, action_232, action_233, action_234, action_235, action_236, action_237, action_238, action_239, action_240, action_241, action_242, action_243, action_244, action_245, action_246, action_247, action_248, action_249, action_250, action_251, action_252, action_253, action_254, action_255, action_256, action_257, action_258, action_259, action_260, action_261, action_262, action_263, action_264, action_265, action_266, action_267, action_268, action_269, action_270, action_271, action_272, action_273, action_274, action_275, action_276, action_277, action_278, action_279, action_280, action_281, action_282, action_283, action_284, action_285, action_286, action_287, action_288, action_289, action_290, action_291, action_292, action_293, action_294, action_295, action_296, action_297, action_298, action_299, action_300, action_301, action_302, action_303, action_304, action_305, action_306, action_307, action_308, action_309, action_310, action_311, action_312, action_313, action_314, action_315, action_316, action_317, action_318, action_319, action_320, action_321, action_322, action_323, action_324, action_325, action_326, action_327, action_328, action_329, action_330, action_331, action_332, action_333, action_334, action_335, action_336, action_337, action_338, action_339, action_340, action_341, action_342, action_343, action_344, action_345, action_346, action_347, action_348, action_349, action_350, action_351, action_352, action_353, action_354, action_355, action_356, action_357, action_358, action_359, action_360, action_361, action_362, action_363, action_364, action_365, action_366, action_367, action_368, action_369, action_370, action_371, action_372, action_373, action_374, action_375, action_376, action_377, action_378, action_379, action_380, action_381, action_382, action_383, action_384, action_385, action_386, action_387, action_388, action_389, action_390, action_391, action_392, action_393, action_394, action_395, action_396, action_397, action_398, action_399, action_400, action_401, action_402, action_403, action_404, action_405, action_406, action_407, action_408, action_409, action_410, action_411, action_412, action_413, action_414, action_415, action_416, action_417, action_418, action_419, action_420, action_421, action_422, action_423, action_424, action_425, action_426, action_427, action_428, action_429, action_430, action_431, action_432, action_433, action_434, action_435, action_436, action_437, action_438, action_439, action_440, action_441, action_442, action_443, action_444, action_445, action_446, action_447, action_448, action_449, action_450, action_451, action_452, action_453, action_454, action_455, action_456, action_457, action_458, action_459, action_460, action_461, action_462, action_463, action_464, action_465, action_466, action_467, action_468, action_469, action_470, action_471, action_472, action_473, action_474, action_475, action_476, action_477, action_478, action_479, action_480, action_481, action_482, action_483, action_484, action_485, action_486, action_487, action_488, action_489, action_490, action_491, action_492 :: () => Int -> HappyReduction (P) happyReduce_1, happyReduce_2, happyReduce_3, happyReduce_4, happyReduce_5, happyReduce_6, happyReduce_7, happyReduce_8, happyReduce_9, happyReduce_10, happyReduce_11, happyReduce_12, happyReduce_13, happyReduce_14, happyReduce_15, happyReduce_16, happyReduce_17, happyReduce_18, happyReduce_19, happyReduce_20, happyReduce_21, happyReduce_22, happyReduce_23, happyReduce_24, happyReduce_25, happyReduce_26, happyReduce_27, happyReduce_28, happyReduce_29, happyReduce_30, happyReduce_31, happyReduce_32, happyReduce_33, happyReduce_34, happyReduce_35, happyReduce_36, happyReduce_37, happyReduce_38, happyReduce_39, happyReduce_40, happyReduce_41, happyReduce_42, happyReduce_43, happyReduce_44, happyReduce_45, happyReduce_46, happyReduce_47, happyReduce_48, happyReduce_49, happyReduce_50, happyReduce_51, happyReduce_52, happyReduce_53, happyReduce_54, happyReduce_55, happyReduce_56, happyReduce_57, happyReduce_58, happyReduce_59, happyReduce_60, happyReduce_61, happyReduce_62, happyReduce_63, happyReduce_64, happyReduce_65, happyReduce_66, happyReduce_67, happyReduce_68, happyReduce_69, happyReduce_70, happyReduce_71, happyReduce_72, happyReduce_73, happyReduce_74, happyReduce_75, happyReduce_76, happyReduce_77, happyReduce_78, happyReduce_79, happyReduce_80, happyReduce_81, happyReduce_82, happyReduce_83, happyReduce_84, happyReduce_85, happyReduce_86, happyReduce_87, happyReduce_88, happyReduce_89, happyReduce_90, happyReduce_91, happyReduce_92, happyReduce_93, happyReduce_94, happyReduce_95, happyReduce_96, happyReduce_97, happyReduce_98, happyReduce_99, happyReduce_100, happyReduce_101, happyReduce_102, happyReduce_103, happyReduce_104, happyReduce_105, happyReduce_106, happyReduce_107, happyReduce_108, happyReduce_109, happyReduce_110, happyReduce_111, happyReduce_112, happyReduce_113, happyReduce_114, happyReduce_115, happyReduce_116, happyReduce_117, happyReduce_118, happyReduce_119, happyReduce_120, happyReduce_121, happyReduce_122, happyReduce_123, happyReduce_124, happyReduce_125, happyReduce_126, happyReduce_127, happyReduce_128, happyReduce_129, happyReduce_130, happyReduce_131, happyReduce_132, happyReduce_133, happyReduce_134, happyReduce_135, happyReduce_136, happyReduce_137, happyReduce_138, happyReduce_139, happyReduce_140, happyReduce_141, happyReduce_142, happyReduce_143, happyReduce_144, happyReduce_145, happyReduce_146, happyReduce_147, happyReduce_148, happyReduce_149, happyReduce_150, happyReduce_151, happyReduce_152, happyReduce_153, happyReduce_154, happyReduce_155, happyReduce_156, happyReduce_157, happyReduce_158, happyReduce_159, happyReduce_160, happyReduce_161, happyReduce_162, happyReduce_163, happyReduce_164, happyReduce_165, happyReduce_166, happyReduce_167, happyReduce_168, happyReduce_169, happyReduce_170, happyReduce_171, happyReduce_172, happyReduce_173, happyReduce_174, happyReduce_175, happyReduce_176, happyReduce_177, happyReduce_178, happyReduce_179, happyReduce_180, happyReduce_181, happyReduce_182, happyReduce_183, happyReduce_184, happyReduce_185, happyReduce_186, happyReduce_187, happyReduce_188, happyReduce_189, happyReduce_190, happyReduce_191, happyReduce_192, happyReduce_193, happyReduce_194, happyReduce_195, happyReduce_196, happyReduce_197, happyReduce_198, happyReduce_199, happyReduce_200, happyReduce_201, happyReduce_202, happyReduce_203, happyReduce_204, happyReduce_205, happyReduce_206, happyReduce_207, happyReduce_208, happyReduce_209, happyReduce_210, happyReduce_211, happyReduce_212, happyReduce_213, happyReduce_214, happyReduce_215, happyReduce_216, happyReduce_217, happyReduce_218, happyReduce_219, happyReduce_220, happyReduce_221, happyReduce_222, happyReduce_223, happyReduce_224, happyReduce_225, happyReduce_226, happyReduce_227, happyReduce_228, happyReduce_229, happyReduce_230, happyReduce_231, happyReduce_232, happyReduce_233, happyReduce_234, happyReduce_235, happyReduce_236, happyReduce_237, happyReduce_238, happyReduce_239, happyReduce_240, happyReduce_241, happyReduce_242, happyReduce_243, happyReduce_244, happyReduce_245, happyReduce_246, happyReduce_247, happyReduce_248, happyReduce_249, happyReduce_250, happyReduce_251, happyReduce_252, happyReduce_253, happyReduce_254, happyReduce_255, happyReduce_256, happyReduce_257, happyReduce_258, happyReduce_259, happyReduce_260, happyReduce_261, happyReduce_262, happyReduce_263, happyReduce_264, happyReduce_265, happyReduce_266, happyReduce_267, happyReduce_268, happyReduce_269, happyReduce_270, happyReduce_271, happyReduce_272, happyReduce_273, happyReduce_274, happyReduce_275, happyReduce_276, happyReduce_277, happyReduce_278, happyReduce_279, happyReduce_280, happyReduce_281, happyReduce_282, happyReduce_283, happyReduce_284, happyReduce_285, happyReduce_286, happyReduce_287, happyReduce_288, happyReduce_289 :: () => HappyReduction (P) action_0 (4) = happyGoto action_3 action_0 (124) = happyGoto action_4 action_0 _ = happyReduce_279 action_1 (124) = happyGoto action_2 action_1 _ = happyFail action_2 (186) = happyShift action_8 action_2 _ = happyFail action_3 (193) = happyAccept action_3 _ = happyFail action_4 (148) = happyShift action_7 action_4 (186) = happyShift action_8 action_4 (5) = happyGoto action_5 action_4 (125) = happyGoto action_6 action_4 _ = happyReduce_280 action_5 _ = happyReduce_2 action_6 (6) = happyGoto action_15 action_6 (7) = happyGoto action_13 action_6 (8) = happyGoto action_14 action_6 _ = happyReduce_11 action_7 (6) = happyGoto action_12 action_7 (7) = happyGoto action_13 action_7 (8) = happyGoto action_14 action_7 _ = happyReduce_11 action_8 (135) = happyShift action_10 action_8 (136) = happyShift action_11 action_8 (127) = happyGoto action_9 action_8 _ = happyFail action_9 (145) = happyShift action_33 action_9 (9) = happyGoto action_31 action_9 (10) = happyGoto action_32 action_9 _ = happyReduce_13 action_10 _ = happyReduce_283 action_11 _ = happyReduce_284 action_12 (149) = happyShift action_30 action_12 _ = happyFail action_13 _ = happyReduce_10 action_14 (133) = happyReduce_279 action_14 (134) = happyReduce_279 action_14 (135) = happyReduce_279 action_14 (136) = happyReduce_279 action_14 (141) = happyReduce_279 action_14 (142) = happyReduce_279 action_14 (143) = happyReduce_279 action_14 (144) = happyReduce_279 action_14 (145) = happyReduce_279 action_14 (147) = happyShift action_29 action_14 (151) = happyReduce_279 action_14 (154) = happyReduce_279 action_14 (165) = happyReduce_279 action_14 (167) = happyReduce_279 action_14 (169) = happyReduce_279 action_14 (170) = happyReduce_279 action_14 (171) = happyReduce_279 action_14 (172) = happyReduce_279 action_14 (173) = happyReduce_279 action_14 (175) = happyReduce_279 action_14 (177) = happyReduce_279 action_14 (179) = happyReduce_279 action_14 (181) = happyReduce_279 action_14 (182) = happyReduce_279 action_14 (183) = happyReduce_279 action_14 (184) = happyReduce_279 action_14 (187) = happyReduce_279 action_14 (190) = happyReduce_279 action_14 (192) = happyReduce_279 action_14 (14) = happyGoto action_19 action_14 (15) = happyGoto action_20 action_14 (25) = happyGoto action_21 action_14 (29) = happyGoto action_22 action_14 (30) = happyGoto action_23 action_14 (31) = happyGoto action_24 action_14 (35) = happyGoto action_25 action_14 (37) = happyGoto action_26 action_14 (63) = happyGoto action_27 action_14 (124) = happyGoto action_28 action_14 _ = happyReduce_8 action_15 (1) = happyShift action_17 action_15 (150) = happyShift action_18 action_15 (126) = happyGoto action_16 action_15 _ = happyFail action_16 _ = happyReduce_4 action_17 _ = happyReduce_282 action_18 _ = happyReduce_281 action_19 (7) = happyGoto action_90 action_19 (8) = happyGoto action_91 action_19 _ = happyReduce_11 action_20 _ = happyReduce_27 action_21 _ = happyReduce_76 action_22 _ = happyReduce_6 action_23 (7) = happyGoto action_88 action_23 (8) = happyGoto action_89 action_23 _ = happyReduce_11 action_24 _ = happyReduce_60 action_25 _ = happyReduce_67 action_26 _ = happyReduce_75 action_27 _ = happyReduce_77 action_28 (133) = happyShift action_43 action_28 (134) = happyShift action_44 action_28 (135) = happyShift action_45 action_28 (136) = happyShift action_46 action_28 (141) = happyShift action_67 action_28 (142) = happyShift action_68 action_28 (143) = happyShift action_69 action_28 (144) = happyShift action_70 action_28 (145) = happyShift action_71 action_28 (151) = happyShift action_72 action_28 (154) = happyShift action_73 action_28 (165) = happyShift action_74 action_28 (167) = happyShift action_75 action_28 (169) = happyShift action_49 action_28 (170) = happyShift action_76 action_28 (171) = happyShift action_77 action_28 (172) = happyShift action_78 action_28 (173) = happyShift action_79 action_28 (175) = happyShift action_80 action_28 (177) = happyShift action_50 action_28 (179) = happyShift action_81 action_28 (181) = happyShift action_82 action_28 (182) = happyShift action_83 action_28 (183) = happyShift action_84 action_28 (184) = happyShift action_85 action_28 (187) = happyShift action_86 action_28 (190) = happyShift action_87 action_28 (192) = happyShift action_52 action_28 (27) = happyGoto action_54 action_28 (38) = happyGoto action_55 action_28 (71) = happyGoto action_56 action_28 (73) = happyGoto action_57 action_28 (74) = happyGoto action_58 action_28 (77) = happyGoto action_59 action_28 (78) = happyGoto action_60 action_28 (79) = happyGoto action_61 action_28 (98) = happyGoto action_62 action_28 (100) = happyGoto action_63 action_28 (102) = happyGoto action_64 action_28 (112) = happyGoto action_38 action_28 (113) = happyGoto action_39 action_28 (114) = happyGoto action_65 action_28 (115) = happyGoto action_41 action_28 (123) = happyGoto action_66 action_28 _ = happyFail action_29 _ = happyReduce_9 action_30 _ = happyReduce_3 action_31 (191) = happyShift action_53 action_31 _ = happyFail action_32 _ = happyReduce_12 action_33 (133) = happyShift action_43 action_33 (134) = happyShift action_44 action_33 (135) = happyShift action_45 action_33 (136) = happyShift action_46 action_33 (145) = happyShift action_47 action_33 (153) = happyShift action_48 action_33 (169) = happyShift action_49 action_33 (177) = happyShift action_50 action_33 (186) = happyShift action_51 action_33 (192) = happyShift action_52 action_33 (11) = happyGoto action_34 action_33 (12) = happyGoto action_35 action_33 (13) = happyGoto action_36 action_33 (100) = happyGoto action_37 action_33 (112) = happyGoto action_38 action_33 (113) = happyGoto action_39 action_33 (114) = happyGoto action_40 action_33 (115) = happyGoto action_41 action_33 (130) = happyGoto action_42 action_33 _ = happyReduce_17 action_34 (146) = happyShift action_186 action_34 _ = happyFail action_35 (153) = happyShift action_185 action_35 (11) = happyGoto action_184 action_35 _ = happyReduce_17 action_36 _ = happyReduce_19 action_37 _ = happyReduce_20 action_38 _ = happyReduce_229 action_39 _ = happyReduce_253 action_40 _ = happyReduce_287 action_41 _ = happyReduce_259 action_42 (145) = happyShift action_183 action_42 _ = happyReduce_21 action_43 _ = happyReduce_255 action_44 _ = happyReduce_254 action_45 _ = happyReduce_261 action_46 _ = happyReduce_260 action_47 (137) = happyShift action_172 action_47 (139) = happyShift action_151 action_47 (167) = happyShift action_175 action_47 (168) = happyShift action_176 action_47 (118) = happyGoto action_144 action_47 (120) = happyGoto action_146 action_47 (122) = happyGoto action_170 action_47 _ = happyFail action_48 _ = happyReduce_16 action_49 _ = happyReduce_256 action_50 _ = happyReduce_258 action_51 (135) = happyShift action_10 action_51 (136) = happyShift action_11 action_51 (127) = happyGoto action_182 action_51 _ = happyFail action_52 _ = happyReduce_257 action_53 (148) = happyShift action_7 action_53 (5) = happyGoto action_181 action_53 (125) = happyGoto action_6 action_53 _ = happyReduce_280 action_54 (141) = happyShift action_180 action_54 (26) = happyGoto action_179 action_54 _ = happyReduce_51 action_55 (153) = happyShift action_177 action_55 (158) = happyShift action_178 action_55 _ = happyFail action_56 (137) = happyShift action_172 action_56 (138) = happyShift action_150 action_56 (139) = happyShift action_151 action_56 (140) = happyShift action_152 action_56 (155) = happyShift action_173 action_56 (157) = happyShift action_156 action_56 (159) = happyShift action_174 action_56 (167) = happyShift action_175 action_56 (168) = happyShift action_176 action_56 (65) = happyGoto action_162 action_56 (66) = happyGoto action_163 action_56 (67) = happyGoto action_164 action_56 (104) = happyGoto action_165 action_56 (107) = happyGoto action_166 action_56 (109) = happyGoto action_167 action_56 (111) = happyGoto action_168 action_56 (116) = happyGoto action_142 action_56 (117) = happyGoto action_143 action_56 (118) = happyGoto action_169 action_56 (120) = happyGoto action_146 action_56 (122) = happyGoto action_170 action_56 (124) = happyGoto action_171 action_56 _ = happyReduce_279 action_57 _ = happyReduce_154 action_58 (133) = happyShift action_43 action_58 (134) = happyShift action_44 action_58 (135) = happyShift action_45 action_58 (136) = happyShift action_46 action_58 (141) = happyShift action_67 action_58 (142) = happyShift action_68 action_58 (143) = happyShift action_69 action_58 (144) = happyShift action_70 action_58 (145) = happyShift action_71 action_58 (151) = happyShift action_72 action_58 (154) = happyShift action_73 action_58 (165) = happyShift action_74 action_58 (169) = happyShift action_49 action_58 (177) = happyShift action_50 action_58 (192) = happyShift action_52 action_58 (77) = happyGoto action_161 action_58 (78) = happyGoto action_60 action_58 (79) = happyGoto action_61 action_58 (98) = happyGoto action_62 action_58 (100) = happyGoto action_124 action_58 (102) = happyGoto action_64 action_58 (112) = happyGoto action_38 action_58 (113) = happyGoto action_39 action_58 (114) = happyGoto action_65 action_58 (115) = happyGoto action_41 action_58 (123) = happyGoto action_66 action_58 _ = happyReduce_161 action_59 _ = happyReduce_163 action_60 (148) = happyShift action_160 action_60 _ = happyReduce_169 action_61 _ = happyReduce_172 action_62 _ = happyReduce_174 action_63 (153) = happyReduce_82 action_63 (158) = happyReduce_82 action_63 (164) = happyShift action_159 action_63 _ = happyReduce_173 action_64 _ = happyReduce_226 action_65 _ = happyReduce_233 action_66 _ = happyReduce_175 action_67 _ = happyReduce_275 action_68 _ = happyReduce_277 action_69 _ = happyReduce_276 action_70 _ = happyReduce_278 action_71 (133) = happyShift action_43 action_71 (134) = happyShift action_44 action_71 (135) = happyShift action_45 action_71 (136) = happyShift action_46 action_71 (137) = happyShift action_149 action_71 (138) = happyShift action_150 action_71 (139) = happyShift action_151 action_71 (140) = happyShift action_152 action_71 (141) = happyShift action_67 action_71 (142) = happyShift action_68 action_71 (143) = happyShift action_69 action_71 (144) = happyShift action_70 action_71 (145) = happyShift action_71 action_71 (146) = happyShift action_153 action_71 (151) = happyShift action_72 action_71 (153) = happyShift action_154 action_71 (154) = happyShift action_73 action_71 (155) = happyShift action_155 action_71 (157) = happyShift action_156 action_71 (160) = happyShift action_125 action_71 (165) = happyShift action_74 action_71 (167) = happyShift action_157 action_71 (168) = happyShift action_158 action_71 (169) = happyShift action_49 action_71 (170) = happyShift action_76 action_71 (175) = happyShift action_80 action_71 (177) = happyShift action_50 action_71 (178) = happyShift action_126 action_71 (185) = happyShift action_127 action_71 (192) = happyShift action_52 action_71 (68) = happyGoto action_134 action_71 (69) = happyGoto action_120 action_71 (70) = happyGoto action_121 action_71 (71) = happyGoto action_135 action_71 (72) = happyGoto action_123 action_71 (73) = happyGoto action_57 action_71 (74) = happyGoto action_58 action_71 (77) = happyGoto action_59 action_71 (78) = happyGoto action_60 action_71 (79) = happyGoto action_61 action_71 (80) = happyGoto action_136 action_71 (81) = happyGoto action_137 action_71 (98) = happyGoto action_62 action_71 (100) = happyGoto action_124 action_71 (102) = happyGoto action_64 action_71 (105) = happyGoto action_138 action_71 (107) = happyGoto action_139 action_71 (110) = happyGoto action_140 action_71 (111) = happyGoto action_141 action_71 (112) = happyGoto action_38 action_71 (113) = happyGoto action_39 action_71 (114) = happyGoto action_65 action_71 (115) = happyGoto action_41 action_71 (116) = happyGoto action_142 action_71 (117) = happyGoto action_143 action_71 (118) = happyGoto action_144 action_71 (119) = happyGoto action_145 action_71 (120) = happyGoto action_146 action_71 (121) = happyGoto action_147 action_71 (122) = happyGoto action_148 action_71 (123) = happyGoto action_66 action_71 _ = happyFail action_72 (133) = happyShift action_43 action_72 (134) = happyShift action_44 action_72 (135) = happyShift action_45 action_72 (136) = happyShift action_46 action_72 (141) = happyShift action_67 action_72 (142) = happyShift action_68 action_72 (143) = happyShift action_69 action_72 (144) = happyShift action_70 action_72 (145) = happyShift action_71 action_72 (151) = happyShift action_72 action_72 (152) = happyShift action_133 action_72 (154) = happyShift action_73 action_72 (160) = happyShift action_125 action_72 (165) = happyShift action_74 action_72 (167) = happyShift action_75 action_72 (169) = happyShift action_49 action_72 (170) = happyShift action_76 action_72 (175) = happyShift action_80 action_72 (177) = happyShift action_50 action_72 (178) = happyShift action_126 action_72 (185) = happyShift action_127 action_72 (192) = happyShift action_52 action_72 (68) = happyGoto action_130 action_72 (69) = happyGoto action_120 action_72 (70) = happyGoto action_121 action_72 (71) = happyGoto action_122 action_72 (72) = happyGoto action_123 action_72 (73) = happyGoto action_57 action_72 (74) = happyGoto action_58 action_72 (77) = happyGoto action_59 action_72 (78) = happyGoto action_60 action_72 (79) = happyGoto action_61 action_72 (82) = happyGoto action_131 action_72 (83) = happyGoto action_132 action_72 (98) = happyGoto action_62 action_72 (100) = happyGoto action_124 action_72 (102) = happyGoto action_64 action_72 (112) = happyGoto action_38 action_72 (113) = happyGoto action_39 action_72 (114) = happyGoto action_65 action_72 (115) = happyGoto action_41 action_72 (123) = happyGoto action_66 action_72 _ = happyFail action_73 _ = happyReduce_181 action_74 (133) = happyShift action_43 action_74 (134) = happyShift action_44 action_74 (135) = happyShift action_45 action_74 (136) = happyShift action_46 action_74 (141) = happyShift action_67 action_74 (142) = happyShift action_68 action_74 (143) = happyShift action_69 action_74 (144) = happyShift action_70 action_74 (145) = happyShift action_71 action_74 (151) = happyShift action_72 action_74 (154) = happyShift action_73 action_74 (165) = happyShift action_74 action_74 (169) = happyShift action_49 action_74 (177) = happyShift action_50 action_74 (192) = happyShift action_52 action_74 (77) = happyGoto action_129 action_74 (78) = happyGoto action_60 action_74 (79) = happyGoto action_61 action_74 (98) = happyGoto action_62 action_74 (100) = happyGoto action_124 action_74 (102) = happyGoto action_64 action_74 (112) = happyGoto action_38 action_74 (113) = happyGoto action_39 action_74 (114) = happyGoto action_65 action_74 (115) = happyGoto action_41 action_74 (123) = happyGoto action_66 action_74 _ = happyFail action_75 (133) = happyShift action_43 action_75 (134) = happyShift action_44 action_75 (135) = happyShift action_45 action_75 (136) = happyShift action_46 action_75 (141) = happyShift action_67 action_75 (142) = happyShift action_68 action_75 (143) = happyShift action_69 action_75 (144) = happyShift action_70 action_75 (145) = happyShift action_71 action_75 (151) = happyShift action_72 action_75 (154) = happyShift action_73 action_75 (165) = happyShift action_74 action_75 (169) = happyShift action_49 action_75 (177) = happyShift action_50 action_75 (192) = happyShift action_52 action_75 (74) = happyGoto action_128 action_75 (77) = happyGoto action_59 action_75 (78) = happyGoto action_60 action_75 (79) = happyGoto action_61 action_75 (98) = happyGoto action_62 action_75 (100) = happyGoto action_124 action_75 (102) = happyGoto action_64 action_75 (112) = happyGoto action_38 action_75 (113) = happyGoto action_39 action_75 (114) = happyGoto action_65 action_75 (115) = happyGoto action_41 action_75 (123) = happyGoto action_66 action_75 _ = happyFail action_76 (133) = happyShift action_43 action_76 (134) = happyShift action_44 action_76 (135) = happyShift action_45 action_76 (136) = happyShift action_46 action_76 (141) = happyShift action_67 action_76 (142) = happyShift action_68 action_76 (143) = happyShift action_69 action_76 (144) = happyShift action_70 action_76 (145) = happyShift action_71 action_76 (151) = happyShift action_72 action_76 (154) = happyShift action_73 action_76 (160) = happyShift action_125 action_76 (165) = happyShift action_74 action_76 (167) = happyShift action_75 action_76 (169) = happyShift action_49 action_76 (170) = happyShift action_76 action_76 (175) = happyShift action_80 action_76 (177) = happyShift action_50 action_76 (178) = happyShift action_126 action_76 (185) = happyShift action_127 action_76 (192) = happyShift action_52 action_76 (68) = happyGoto action_119 action_76 (69) = happyGoto action_120 action_76 (70) = happyGoto action_121 action_76 (71) = happyGoto action_122 action_76 (72) = happyGoto action_123 action_76 (73) = happyGoto action_57 action_76 (74) = happyGoto action_58 action_76 (77) = happyGoto action_59 action_76 (78) = happyGoto action_60 action_76 (79) = happyGoto action_61 action_76 (98) = happyGoto action_62 action_76 (100) = happyGoto action_124 action_76 (102) = happyGoto action_64 action_76 (112) = happyGoto action_38 action_76 (113) = happyGoto action_39 action_76 (114) = happyGoto action_65 action_76 (115) = happyGoto action_41 action_76 (123) = happyGoto action_66 action_76 _ = happyFail action_77 (133) = happyShift action_43 action_77 (135) = happyShift action_45 action_77 (136) = happyShift action_46 action_77 (145) = happyShift action_108 action_77 (151) = happyShift action_109 action_77 (169) = happyShift action_49 action_77 (177) = happyShift action_50 action_77 (192) = happyShift action_52 action_77 (39) = happyGoto action_99 action_77 (40) = happyGoto action_100 action_77 (41) = happyGoto action_101 action_77 (42) = happyGoto action_102 action_77 (43) = happyGoto action_118 action_77 (44) = happyGoto action_104 action_77 (113) = happyGoto action_105 action_77 (114) = happyGoto action_106 action_77 (115) = happyGoto action_41 action_77 (132) = happyGoto action_107 action_77 _ = happyFail action_78 (133) = happyShift action_43 action_78 (135) = happyShift action_45 action_78 (136) = happyShift action_46 action_78 (145) = happyShift action_108 action_78 (151) = happyShift action_109 action_78 (169) = happyShift action_49 action_78 (177) = happyShift action_50 action_78 (192) = happyShift action_52 action_78 (39) = happyGoto action_99 action_78 (40) = happyGoto action_100 action_78 (41) = happyGoto action_101 action_78 (42) = happyGoto action_102 action_78 (43) = happyGoto action_117 action_78 (44) = happyGoto action_104 action_78 (113) = happyGoto action_105 action_78 (114) = happyGoto action_106 action_78 (115) = happyGoto action_41 action_78 (132) = happyGoto action_107 action_78 _ = happyFail action_79 (145) = happyShift action_116 action_79 _ = happyFail action_80 (148) = happyShift action_115 action_80 (94) = happyGoto action_113 action_80 (125) = happyGoto action_114 action_80 _ = happyReduce_280 action_81 (192) = happyShift action_112 action_81 (16) = happyGoto action_111 action_81 _ = happyReduce_30 action_82 _ = happyReduce_53 action_83 _ = happyReduce_54 action_84 _ = happyReduce_55 action_85 (133) = happyShift action_43 action_85 (135) = happyShift action_45 action_85 (136) = happyShift action_46 action_85 (145) = happyShift action_108 action_85 (151) = happyShift action_109 action_85 (169) = happyShift action_49 action_85 (177) = happyShift action_50 action_85 (192) = happyShift action_52 action_85 (39) = happyGoto action_99 action_85 (40) = happyGoto action_100 action_85 (41) = happyGoto action_101 action_85 (42) = happyGoto action_102 action_85 (43) = happyGoto action_110 action_85 (44) = happyGoto action_104 action_85 (113) = happyGoto action_105 action_85 (114) = happyGoto action_106 action_85 (115) = happyGoto action_41 action_85 (132) = happyGoto action_107 action_85 _ = happyFail action_86 (133) = happyShift action_43 action_86 (135) = happyShift action_45 action_86 (136) = happyShift action_46 action_86 (145) = happyShift action_108 action_86 (151) = happyShift action_109 action_86 (169) = happyShift action_49 action_86 (177) = happyShift action_50 action_86 (192) = happyShift action_52 action_86 (39) = happyGoto action_99 action_86 (40) = happyGoto action_100 action_86 (41) = happyGoto action_101 action_86 (42) = happyGoto action_102 action_86 (43) = happyGoto action_103 action_86 (44) = happyGoto action_104 action_86 (113) = happyGoto action_105 action_86 (114) = happyGoto action_106 action_86 (115) = happyGoto action_41 action_86 (132) = happyGoto action_107 action_86 _ = happyFail action_87 (135) = happyShift action_45 action_87 (46) = happyGoto action_96 action_87 (115) = happyGoto action_97 action_87 (129) = happyGoto action_98 action_87 _ = happyFail action_88 (133) = happyReduce_279 action_88 (134) = happyReduce_279 action_88 (135) = happyReduce_279 action_88 (136) = happyReduce_279 action_88 (141) = happyReduce_279 action_88 (142) = happyReduce_279 action_88 (143) = happyReduce_279 action_88 (144) = happyReduce_279 action_88 (145) = happyReduce_279 action_88 (151) = happyReduce_279 action_88 (154) = happyReduce_279 action_88 (165) = happyReduce_279 action_88 (167) = happyReduce_279 action_88 (169) = happyReduce_279 action_88 (170) = happyReduce_279 action_88 (171) = happyReduce_279 action_88 (172) = happyReduce_279 action_88 (173) = happyReduce_279 action_88 (175) = happyReduce_279 action_88 (177) = happyReduce_279 action_88 (181) = happyReduce_279 action_88 (182) = happyReduce_279 action_88 (183) = happyReduce_279 action_88 (184) = happyReduce_279 action_88 (187) = happyReduce_279 action_88 (190) = happyReduce_279 action_88 (192) = happyReduce_279 action_88 (25) = happyGoto action_21 action_88 (31) = happyGoto action_94 action_88 (35) = happyGoto action_25 action_88 (37) = happyGoto action_26 action_88 (63) = happyGoto action_27 action_88 (124) = happyGoto action_95 action_88 _ = happyReduce_10 action_89 (147) = happyShift action_29 action_89 _ = happyReduce_58 action_90 (133) = happyReduce_279 action_90 (134) = happyReduce_279 action_90 (135) = happyReduce_279 action_90 (136) = happyReduce_279 action_90 (141) = happyReduce_279 action_90 (142) = happyReduce_279 action_90 (143) = happyReduce_279 action_90 (144) = happyReduce_279 action_90 (145) = happyReduce_279 action_90 (151) = happyReduce_279 action_90 (154) = happyReduce_279 action_90 (165) = happyReduce_279 action_90 (167) = happyReduce_279 action_90 (169) = happyReduce_279 action_90 (170) = happyReduce_279 action_90 (171) = happyReduce_279 action_90 (172) = happyReduce_279 action_90 (173) = happyReduce_279 action_90 (175) = happyReduce_279 action_90 (177) = happyReduce_279 action_90 (179) = happyReduce_279 action_90 (181) = happyReduce_279 action_90 (182) = happyReduce_279 action_90 (183) = happyReduce_279 action_90 (184) = happyReduce_279 action_90 (187) = happyReduce_279 action_90 (190) = happyReduce_279 action_90 (192) = happyReduce_279 action_90 (15) = happyGoto action_92 action_90 (25) = happyGoto action_21 action_90 (29) = happyGoto action_93 action_90 (30) = happyGoto action_23 action_90 (31) = happyGoto action_24 action_90 (35) = happyGoto action_25 action_90 (37) = happyGoto action_26 action_90 (63) = happyGoto action_27 action_90 (124) = happyGoto action_28 action_90 _ = happyReduce_10 action_91 (147) = happyShift action_29 action_91 _ = happyReduce_7 action_92 _ = happyReduce_26 action_93 _ = happyReduce_5 action_94 _ = happyReduce_59 action_95 (133) = happyShift action_43 action_95 (134) = happyShift action_44 action_95 (135) = happyShift action_45 action_95 (136) = happyShift action_46 action_95 (141) = happyShift action_67 action_95 (142) = happyShift action_68 action_95 (143) = happyShift action_69 action_95 (144) = happyShift action_70 action_95 (145) = happyShift action_71 action_95 (151) = happyShift action_72 action_95 (154) = happyShift action_73 action_95 (165) = happyShift action_74 action_95 (167) = happyShift action_75 action_95 (169) = happyShift action_49 action_95 (170) = happyShift action_76 action_95 (171) = happyShift action_77 action_95 (172) = happyShift action_78 action_95 (173) = happyShift action_79 action_95 (175) = happyShift action_80 action_95 (177) = happyShift action_50 action_95 (181) = happyShift action_82 action_95 (182) = happyShift action_83 action_95 (183) = happyShift action_84 action_95 (184) = happyShift action_85 action_95 (187) = happyShift action_86 action_95 (190) = happyShift action_87 action_95 (192) = happyShift action_52 action_95 (27) = happyGoto action_54 action_95 (38) = happyGoto action_55 action_95 (71) = happyGoto action_56 action_95 (73) = happyGoto action_57 action_95 (74) = happyGoto action_58 action_95 (77) = happyGoto action_59 action_95 (78) = happyGoto action_60 action_95 (79) = happyGoto action_61 action_95 (98) = happyGoto action_62 action_95 (100) = happyGoto action_63 action_95 (102) = happyGoto action_64 action_95 (112) = happyGoto action_38 action_95 (113) = happyGoto action_39 action_95 (114) = happyGoto action_65 action_95 (115) = happyGoto action_41 action_95 (123) = happyGoto action_66 action_95 _ = happyFail action_96 (159) = happyShift action_275 action_96 _ = happyFail action_97 _ = happyReduce_286 action_98 (47) = happyGoto action_274 action_98 _ = happyReduce_104 action_99 _ = happyReduce_98 action_100 (133) = happyShift action_43 action_100 (135) = happyShift action_45 action_100 (136) = happyShift action_46 action_100 (145) = happyShift action_108 action_100 (151) = happyShift action_109 action_100 (163) = happyShift action_273 action_100 (166) = happyReduce_99 action_100 (169) = happyShift action_49 action_100 (177) = happyShift action_50 action_100 (192) = happyShift action_52 action_100 (41) = happyGoto action_272 action_100 (42) = happyGoto action_102 action_100 (113) = happyGoto action_105 action_100 (114) = happyGoto action_106 action_100 (115) = happyGoto action_41 action_100 (132) = happyGoto action_107 action_100 _ = happyReduce_84 action_101 _ = happyReduce_86 action_102 _ = happyReduce_87 action_103 (159) = happyShift action_271 action_103 _ = happyFail action_104 (166) = happyShift action_270 action_104 _ = happyFail action_105 _ = happyReduce_289 action_106 _ = happyReduce_92 action_107 _ = happyReduce_88 action_108 (133) = happyShift action_43 action_108 (135) = happyShift action_45 action_108 (136) = happyShift action_46 action_108 (145) = happyShift action_108 action_108 (146) = happyShift action_268 action_108 (151) = happyShift action_109 action_108 (153) = happyShift action_154 action_108 (163) = happyShift action_269 action_108 (169) = happyShift action_49 action_108 (177) = happyShift action_50 action_108 (192) = happyShift action_52 action_108 (39) = happyGoto action_265 action_108 (40) = happyGoto action_251 action_108 (41) = happyGoto action_101 action_108 (42) = happyGoto action_102 action_108 (45) = happyGoto action_266 action_108 (80) = happyGoto action_267 action_108 (113) = happyGoto action_105 action_108 (114) = happyGoto action_106 action_108 (115) = happyGoto action_41 action_108 (132) = happyGoto action_107 action_108 _ = happyFail action_109 (133) = happyShift action_43 action_109 (135) = happyShift action_45 action_109 (136) = happyShift action_46 action_109 (145) = happyShift action_108 action_109 (151) = happyShift action_109 action_109 (152) = happyShift action_264 action_109 (169) = happyShift action_49 action_109 (177) = happyShift action_50 action_109 (192) = happyShift action_52 action_109 (39) = happyGoto action_263 action_109 (40) = happyGoto action_251 action_109 (41) = happyGoto action_101 action_109 (42) = happyGoto action_102 action_109 (113) = happyGoto action_105 action_109 (114) = happyGoto action_106 action_109 (115) = happyGoto action_41 action_109 (132) = happyGoto action_107 action_109 _ = happyFail action_110 (191) = happyShift action_262 action_110 (60) = happyGoto action_261 action_110 _ = happyReduce_134 action_111 (135) = happyShift action_10 action_111 (136) = happyShift action_11 action_111 (127) = happyGoto action_260 action_111 _ = happyFail action_112 _ = happyReduce_29 action_113 _ = happyReduce_160 action_114 (133) = happyShift action_43 action_114 (134) = happyShift action_44 action_114 (135) = happyShift action_45 action_114 (136) = happyShift action_46 action_114 (141) = happyShift action_67 action_114 (142) = happyShift action_68 action_114 (143) = happyShift action_69 action_114 (144) = happyShift action_70 action_114 (145) = happyShift action_71 action_114 (147) = happyShift action_257 action_114 (151) = happyShift action_72 action_114 (154) = happyShift action_73 action_114 (160) = happyShift action_125 action_114 (165) = happyShift action_74 action_114 (167) = happyShift action_75 action_114 (169) = happyShift action_49 action_114 (170) = happyShift action_76 action_114 (175) = happyShift action_80 action_114 (177) = happyShift action_50 action_114 (178) = happyShift action_126 action_114 (185) = happyShift action_258 action_114 (192) = happyShift action_52 action_114 (68) = happyGoto action_253 action_114 (69) = happyGoto action_120 action_114 (70) = happyGoto action_121 action_114 (71) = happyGoto action_254 action_114 (72) = happyGoto action_123 action_114 (73) = happyGoto action_57 action_114 (74) = happyGoto action_58 action_114 (77) = happyGoto action_59 action_114 (78) = happyGoto action_60 action_114 (79) = happyGoto action_61 action_114 (93) = happyGoto action_255 action_114 (95) = happyGoto action_259 action_114 (98) = happyGoto action_62 action_114 (100) = happyGoto action_124 action_114 (102) = happyGoto action_64 action_114 (112) = happyGoto action_38 action_114 (113) = happyGoto action_39 action_114 (114) = happyGoto action_65 action_114 (115) = happyGoto action_41 action_114 (123) = happyGoto action_66 action_114 _ = happyFail action_115 (133) = happyShift action_43 action_115 (134) = happyShift action_44 action_115 (135) = happyShift action_45 action_115 (136) = happyShift action_46 action_115 (141) = happyShift action_67 action_115 (142) = happyShift action_68 action_115 (143) = happyShift action_69 action_115 (144) = happyShift action_70 action_115 (145) = happyShift action_71 action_115 (147) = happyShift action_257 action_115 (151) = happyShift action_72 action_115 (154) = happyShift action_73 action_115 (160) = happyShift action_125 action_115 (165) = happyShift action_74 action_115 (167) = happyShift action_75 action_115 (169) = happyShift action_49 action_115 (170) = happyShift action_76 action_115 (175) = happyShift action_80 action_115 (177) = happyShift action_50 action_115 (178) = happyShift action_126 action_115 (185) = happyShift action_258 action_115 (192) = happyShift action_52 action_115 (68) = happyGoto action_253 action_115 (69) = happyGoto action_120 action_115 (70) = happyGoto action_121 action_115 (71) = happyGoto action_254 action_115 (72) = happyGoto action_123 action_115 (73) = happyGoto action_57 action_115 (74) = happyGoto action_58 action_115 (77) = happyGoto action_59 action_115 (78) = happyGoto action_60 action_115 (79) = happyGoto action_61 action_115 (93) = happyGoto action_255 action_115 (95) = happyGoto action_256 action_115 (98) = happyGoto action_62 action_115 (100) = happyGoto action_124 action_115 (102) = happyGoto action_64 action_115 (112) = happyGoto action_38 action_115 (113) = happyGoto action_39 action_115 (114) = happyGoto action_65 action_115 (115) = happyGoto action_41 action_115 (123) = happyGoto action_66 action_115 _ = happyFail action_116 (133) = happyShift action_43 action_116 (135) = happyShift action_45 action_116 (136) = happyShift action_46 action_116 (145) = happyShift action_108 action_116 (151) = happyShift action_109 action_116 (169) = happyShift action_49 action_116 (177) = happyShift action_50 action_116 (192) = happyShift action_52 action_116 (32) = happyGoto action_249 action_116 (39) = happyGoto action_250 action_116 (40) = happyGoto action_251 action_116 (41) = happyGoto action_101 action_116 (42) = happyGoto action_102 action_116 (45) = happyGoto action_252 action_116 (113) = happyGoto action_105 action_116 (114) = happyGoto action_106 action_116 (115) = happyGoto action_41 action_116 (132) = happyGoto action_107 action_116 _ = happyReduce_70 action_117 (159) = happyShift action_248 action_117 _ = happyFail action_118 (191) = happyShift action_247 action_118 (59) = happyGoto action_246 action_118 _ = happyReduce_131 action_119 (188) = happyShift action_245 action_119 _ = happyFail action_120 _ = happyReduce_148 action_121 _ = happyReduce_149 action_122 (137) = happyShift action_172 action_122 (138) = happyShift action_150 action_122 (139) = happyShift action_151 action_122 (140) = happyShift action_152 action_122 (155) = happyShift action_173 action_122 (157) = happyShift action_156 action_122 (158) = happyShift action_231 action_122 (167) = happyShift action_175 action_122 (168) = happyShift action_176 action_122 (104) = happyGoto action_165 action_122 (107) = happyGoto action_166 action_122 (109) = happyGoto action_244 action_122 (111) = happyGoto action_168 action_122 (116) = happyGoto action_142 action_122 (117) = happyGoto action_143 action_122 (118) = happyGoto action_169 action_122 (120) = happyGoto action_146 action_122 (122) = happyGoto action_170 action_122 _ = happyReduce_150 action_123 _ = happyReduce_152 action_124 (164) = happyShift action_159 action_124 _ = happyReduce_173 action_125 (124) = happyGoto action_243 action_125 _ = happyReduce_279 action_126 (133) = happyShift action_43 action_126 (134) = happyShift action_44 action_126 (135) = happyShift action_45 action_126 (136) = happyShift action_46 action_126 (141) = happyShift action_67 action_126 (142) = happyShift action_68 action_126 (143) = happyShift action_69 action_126 (144) = happyShift action_70 action_126 (145) = happyShift action_71 action_126 (151) = happyShift action_72 action_126 (154) = happyShift action_73 action_126 (160) = happyShift action_125 action_126 (165) = happyShift action_74 action_126 (167) = happyShift action_75 action_126 (169) = happyShift action_49 action_126 (170) = happyShift action_76 action_126 (175) = happyShift action_80 action_126 (177) = happyShift action_50 action_126 (178) = happyShift action_126 action_126 (185) = happyShift action_127 action_126 (192) = happyShift action_52 action_126 (68) = happyGoto action_242 action_126 (69) = happyGoto action_120 action_126 (70) = happyGoto action_121 action_126 (71) = happyGoto action_122 action_126 (72) = happyGoto action_123 action_126 (73) = happyGoto action_57 action_126 (74) = happyGoto action_58 action_126 (77) = happyGoto action_59 action_126 (78) = happyGoto action_60 action_126 (79) = happyGoto action_61 action_126 (98) = happyGoto action_62 action_126 (100) = happyGoto action_124 action_126 (102) = happyGoto action_64 action_126 (112) = happyGoto action_38 action_126 (113) = happyGoto action_39 action_126 (114) = happyGoto action_65 action_126 (115) = happyGoto action_41 action_126 (123) = happyGoto action_66 action_126 _ = happyFail action_127 (148) = happyShift action_241 action_127 (36) = happyGoto action_239 action_127 (125) = happyGoto action_240 action_127 _ = happyReduce_280 action_128 (133) = happyShift action_43 action_128 (134) = happyShift action_44 action_128 (135) = happyShift action_45 action_128 (136) = happyShift action_46 action_128 (141) = happyShift action_67 action_128 (142) = happyShift action_68 action_128 (143) = happyShift action_69 action_128 (144) = happyShift action_70 action_128 (145) = happyShift action_71 action_128 (151) = happyShift action_72 action_128 (154) = happyShift action_73 action_128 (165) = happyShift action_74 action_128 (169) = happyShift action_49 action_128 (177) = happyShift action_50 action_128 (192) = happyShift action_52 action_128 (77) = happyGoto action_161 action_128 (78) = happyGoto action_60 action_128 (79) = happyGoto action_61 action_128 (98) = happyGoto action_62 action_128 (100) = happyGoto action_124 action_128 (102) = happyGoto action_64 action_128 (112) = happyGoto action_38 action_128 (113) = happyGoto action_39 action_128 (114) = happyGoto action_65 action_128 (115) = happyGoto action_41 action_128 (123) = happyGoto action_66 action_128 _ = happyReduce_159 action_129 _ = happyReduce_168 action_130 (153) = happyShift action_236 action_130 (156) = happyShift action_237 action_130 (161) = happyShift action_238 action_130 _ = happyReduce_186 action_131 (152) = happyShift action_235 action_131 _ = happyFail action_132 (153) = happyShift action_234 action_132 _ = happyReduce_187 action_133 _ = happyReduce_224 action_134 (146) = happyShift action_232 action_134 (153) = happyShift action_233 action_134 _ = happyFail action_135 (137) = happyShift action_172 action_135 (138) = happyShift action_150 action_135 (139) = happyShift action_151 action_135 (140) = happyShift action_152 action_135 (155) = happyShift action_173 action_135 (157) = happyShift action_156 action_135 (158) = happyShift action_231 action_135 (167) = happyShift action_175 action_135 (168) = happyShift action_176 action_135 (104) = happyGoto action_165 action_135 (107) = happyGoto action_166 action_135 (109) = happyGoto action_230 action_135 (111) = happyGoto action_168 action_135 (116) = happyGoto action_142 action_135 (117) = happyGoto action_143 action_135 (118) = happyGoto action_169 action_135 (120) = happyGoto action_146 action_135 (122) = happyGoto action_170 action_135 _ = happyReduce_150 action_136 (146) = happyShift action_228 action_136 (153) = happyShift action_229 action_136 _ = happyFail action_137 (146) = happyShift action_226 action_137 (153) = happyShift action_227 action_137 _ = happyFail action_138 _ = happyReduce_249 action_139 _ = happyReduce_250 action_140 (133) = happyShift action_43 action_140 (134) = happyShift action_44 action_140 (135) = happyShift action_45 action_140 (136) = happyShift action_46 action_140 (141) = happyShift action_67 action_140 (142) = happyShift action_68 action_140 (143) = happyShift action_69 action_140 (144) = happyShift action_70 action_140 (145) = happyShift action_71 action_140 (151) = happyShift action_72 action_140 (154) = happyShift action_73 action_140 (160) = happyShift action_125 action_140 (165) = happyShift action_74 action_140 (167) = happyShift action_75 action_140 (169) = happyShift action_49 action_140 (170) = happyShift action_76 action_140 (175) = happyShift action_80 action_140 (177) = happyShift action_50 action_140 (178) = happyShift action_126 action_140 (185) = happyShift action_127 action_140 (192) = happyShift action_52 action_140 (69) = happyGoto action_224 action_140 (70) = happyGoto action_121 action_140 (71) = happyGoto action_225 action_140 (72) = happyGoto action_123 action_140 (73) = happyGoto action_57 action_140 (74) = happyGoto action_58 action_140 (77) = happyGoto action_59 action_140 (78) = happyGoto action_60 action_140 (79) = happyGoto action_61 action_140 (98) = happyGoto action_62 action_140 (100) = happyGoto action_124 action_140 (102) = happyGoto action_64 action_140 (112) = happyGoto action_38 action_140 (113) = happyGoto action_39 action_140 (114) = happyGoto action_65 action_140 (115) = happyGoto action_41 action_140 (123) = happyGoto action_66 action_140 _ = happyFail action_141 (146) = happyShift action_223 action_141 _ = happyReduce_243 action_142 _ = happyReduce_252 action_143 _ = happyReduce_262 action_144 (146) = happyShift action_222 action_144 _ = happyFail action_145 _ = happyReduce_239 action_146 _ = happyReduce_265 action_147 _ = happyReduce_267 action_148 (146) = happyReduce_266 action_148 _ = happyReduce_268 action_149 (146) = happyReduce_269 action_149 _ = happyReduce_272 action_150 _ = happyReduce_264 action_151 _ = happyReduce_274 action_152 _ = happyReduce_263 action_153 _ = happyReduce_223 action_154 _ = happyReduce_183 action_155 (133) = happyShift action_43 action_155 (134) = happyShift action_44 action_155 (135) = happyShift action_45 action_155 (136) = happyShift action_46 action_155 (169) = happyShift action_49 action_155 (177) = happyShift action_50 action_155 (192) = happyShift action_52 action_155 (112) = happyGoto action_221 action_155 (113) = happyGoto action_39 action_155 (114) = happyGoto action_210 action_155 (115) = happyGoto action_41 action_155 _ = happyFail action_156 _ = happyReduce_251 action_157 (133) = happyShift action_43 action_157 (134) = happyShift action_44 action_157 (135) = happyShift action_45 action_157 (136) = happyShift action_46 action_157 (141) = happyShift action_67 action_157 (142) = happyShift action_68 action_157 (143) = happyShift action_69 action_157 (144) = happyShift action_70 action_157 (145) = happyShift action_71 action_157 (151) = happyShift action_72 action_157 (154) = happyShift action_73 action_157 (165) = happyShift action_74 action_157 (169) = happyShift action_49 action_157 (177) = happyShift action_50 action_157 (192) = happyShift action_52 action_157 (74) = happyGoto action_128 action_157 (77) = happyGoto action_59 action_157 (78) = happyGoto action_60 action_157 (79) = happyGoto action_61 action_157 (98) = happyGoto action_62 action_157 (100) = happyGoto action_124 action_157 (102) = happyGoto action_64 action_157 (112) = happyGoto action_38 action_157 (113) = happyGoto action_39 action_157 (114) = happyGoto action_65 action_157 (115) = happyGoto action_41 action_157 (123) = happyGoto action_66 action_157 _ = happyReduce_270 action_158 (146) = happyReduce_271 action_158 _ = happyReduce_273 action_159 (133) = happyShift action_43 action_159 (134) = happyShift action_44 action_159 (135) = happyShift action_45 action_159 (136) = happyShift action_46 action_159 (141) = happyShift action_67 action_159 (142) = happyShift action_68 action_159 (143) = happyShift action_69 action_159 (144) = happyShift action_70 action_159 (145) = happyShift action_71 action_159 (151) = happyShift action_72 action_159 (154) = happyShift action_73 action_159 (165) = happyShift action_74 action_159 (169) = happyShift action_49 action_159 (177) = happyShift action_50 action_159 (192) = happyShift action_52 action_159 (77) = happyGoto action_220 action_159 (78) = happyGoto action_60 action_159 (79) = happyGoto action_61 action_159 (98) = happyGoto action_62 action_159 (100) = happyGoto action_124 action_159 (102) = happyGoto action_64 action_159 (112) = happyGoto action_38 action_159 (113) = happyGoto action_39 action_159 (114) = happyGoto action_65 action_159 (115) = happyGoto action_41 action_159 (123) = happyGoto action_66 action_159 _ = happyFail action_160 (133) = happyShift action_43 action_160 (134) = happyShift action_44 action_160 (145) = happyShift action_47 action_160 (149) = happyShift action_219 action_160 (169) = happyShift action_49 action_160 (177) = happyShift action_50 action_160 (192) = happyShift action_52 action_160 (96) = happyGoto action_216 action_160 (97) = happyGoto action_217 action_160 (100) = happyGoto action_218 action_160 (112) = happyGoto action_38 action_160 (113) = happyGoto action_39 action_160 _ = happyFail action_161 _ = happyReduce_162 action_162 (191) = happyShift action_215 action_162 (64) = happyGoto action_214 action_162 _ = happyReduce_141 action_163 (161) = happyReduce_279 action_163 (67) = happyGoto action_213 action_163 (124) = happyGoto action_171 action_163 _ = happyReduce_143 action_164 _ = happyReduce_145 action_165 _ = happyReduce_247 action_166 _ = happyReduce_248 action_167 (133) = happyShift action_43 action_167 (134) = happyShift action_44 action_167 (135) = happyShift action_45 action_167 (136) = happyShift action_46 action_167 (141) = happyShift action_67 action_167 (142) = happyShift action_68 action_167 (143) = happyShift action_69 action_167 (144) = happyShift action_70 action_167 (145) = happyShift action_71 action_167 (151) = happyShift action_72 action_167 (154) = happyShift action_73 action_167 (165) = happyShift action_74 action_167 (167) = happyShift action_75 action_167 (169) = happyShift action_49 action_167 (170) = happyShift action_76 action_167 (175) = happyShift action_80 action_167 (177) = happyShift action_50 action_167 (192) = happyShift action_52 action_167 (73) = happyGoto action_212 action_167 (74) = happyGoto action_58 action_167 (77) = happyGoto action_59 action_167 (78) = happyGoto action_60 action_167 (79) = happyGoto action_61 action_167 (98) = happyGoto action_62 action_167 (100) = happyGoto action_124 action_167 (102) = happyGoto action_64 action_167 (112) = happyGoto action_38 action_167 (113) = happyGoto action_39 action_167 (114) = happyGoto action_65 action_167 (115) = happyGoto action_41 action_167 (123) = happyGoto action_66 action_167 _ = happyFail action_168 _ = happyReduce_243 action_169 _ = happyReduce_237 action_170 _ = happyReduce_266 action_171 (161) = happyShift action_211 action_171 _ = happyFail action_172 _ = happyReduce_269 action_173 (133) = happyShift action_43 action_173 (134) = happyShift action_44 action_173 (135) = happyShift action_45 action_173 (136) = happyShift action_46 action_173 (169) = happyShift action_49 action_173 (177) = happyShift action_50 action_173 (192) = happyShift action_52 action_173 (112) = happyGoto action_209 action_173 (113) = happyGoto action_39 action_173 (114) = happyGoto action_210 action_173 (115) = happyGoto action_41 action_173 _ = happyFail action_174 (133) = happyShift action_43 action_174 (134) = happyShift action_44 action_174 (135) = happyShift action_45 action_174 (136) = happyShift action_46 action_174 (141) = happyShift action_67 action_174 (142) = happyShift action_68 action_174 (143) = happyShift action_69 action_174 (144) = happyShift action_70 action_174 (145) = happyShift action_71 action_174 (151) = happyShift action_72 action_174 (154) = happyShift action_73 action_174 (160) = happyShift action_125 action_174 (165) = happyShift action_74 action_174 (167) = happyShift action_75 action_174 (169) = happyShift action_49 action_174 (170) = happyShift action_76 action_174 (175) = happyShift action_80 action_174 (177) = happyShift action_50 action_174 (178) = happyShift action_126 action_174 (185) = happyShift action_127 action_174 (192) = happyShift action_52 action_174 (68) = happyGoto action_208 action_174 (69) = happyGoto action_120 action_174 (70) = happyGoto action_121 action_174 (71) = happyGoto action_122 action_174 (72) = happyGoto action_123 action_174 (73) = happyGoto action_57 action_174 (74) = happyGoto action_58 action_174 (77) = happyGoto action_59 action_174 (78) = happyGoto action_60 action_174 (79) = happyGoto action_61 action_174 (98) = happyGoto action_62 action_174 (100) = happyGoto action_124 action_174 (102) = happyGoto action_64 action_174 (112) = happyGoto action_38 action_174 (113) = happyGoto action_39 action_174 (114) = happyGoto action_65 action_174 (115) = happyGoto action_41 action_174 (123) = happyGoto action_66 action_174 _ = happyFail action_175 _ = happyReduce_270 action_176 _ = happyReduce_271 action_177 (133) = happyShift action_43 action_177 (145) = happyShift action_207 action_177 (169) = happyShift action_49 action_177 (177) = happyShift action_50 action_177 (192) = happyShift action_52 action_177 (99) = happyGoto action_206 action_177 (113) = happyGoto action_193 action_177 _ = happyFail action_178 (133) = happyShift action_43 action_178 (135) = happyShift action_45 action_178 (136) = happyShift action_46 action_178 (145) = happyShift action_108 action_178 (151) = happyShift action_109 action_178 (169) = happyShift action_49 action_178 (177) = happyShift action_50 action_178 (192) = happyShift action_52 action_178 (39) = happyGoto action_99 action_178 (40) = happyGoto action_100 action_178 (41) = happyGoto action_101 action_178 (42) = happyGoto action_102 action_178 (43) = happyGoto action_205 action_178 (44) = happyGoto action_104 action_178 (113) = happyGoto action_105 action_178 (114) = happyGoto action_106 action_178 (115) = happyGoto action_41 action_178 (132) = happyGoto action_107 action_178 _ = happyFail action_179 (137) = happyShift action_172 action_179 (138) = happyShift action_150 action_179 (155) = happyShift action_204 action_179 (167) = happyShift action_175 action_179 (168) = happyShift action_176 action_179 (28) = happyGoto action_198 action_179 (103) = happyGoto action_199 action_179 (106) = happyGoto action_200 action_179 (108) = happyGoto action_201 action_179 (117) = happyGoto action_202 action_179 (120) = happyGoto action_203 action_179 _ = happyFail action_180 _ = happyReduce_52 action_181 _ = happyReduce_1 action_182 _ = happyReduce_25 action_183 (133) = happyShift action_43 action_183 (135) = happyShift action_45 action_183 (145) = happyShift action_195 action_183 (146) = happyShift action_196 action_183 (156) = happyShift action_197 action_183 (169) = happyShift action_49 action_183 (177) = happyShift action_50 action_183 (192) = happyShift action_52 action_183 (23) = happyGoto action_189 action_183 (24) = happyGoto action_190 action_183 (99) = happyGoto action_191 action_183 (101) = happyGoto action_192 action_183 (113) = happyGoto action_193 action_183 (115) = happyGoto action_194 action_183 _ = happyFail action_184 (146) = happyShift action_188 action_184 _ = happyFail action_185 (133) = happyShift action_43 action_185 (134) = happyShift action_44 action_185 (135) = happyShift action_45 action_185 (136) = happyShift action_46 action_185 (145) = happyShift action_47 action_185 (169) = happyShift action_49 action_185 (177) = happyShift action_50 action_185 (186) = happyShift action_51 action_185 (192) = happyShift action_52 action_185 (13) = happyGoto action_187 action_185 (100) = happyGoto action_37 action_185 (112) = happyGoto action_38 action_185 (113) = happyGoto action_39 action_185 (114) = happyGoto action_40 action_185 (115) = happyGoto action_41 action_185 (130) = happyGoto action_42 action_185 _ = happyReduce_16 action_186 _ = happyReduce_15 action_187 _ = happyReduce_18 action_188 _ = happyReduce_14 action_189 (146) = happyShift action_342 action_189 (153) = happyShift action_343 action_189 _ = happyFail action_190 _ = happyReduce_47 action_191 _ = happyReduce_48 action_192 _ = happyReduce_49 action_193 _ = happyReduce_227 action_194 _ = happyReduce_231 action_195 (137) = happyShift action_172 action_195 (138) = happyShift action_150 action_195 (167) = happyShift action_175 action_195 (168) = happyShift action_176 action_195 (117) = happyGoto action_341 action_195 (120) = happyGoto action_336 action_195 _ = happyFail action_196 _ = happyReduce_23 action_197 (146) = happyShift action_340 action_197 _ = happyFail action_198 (153) = happyShift action_339 action_198 _ = happyReduce_50 action_199 _ = happyReduce_245 action_200 _ = happyReduce_246 action_201 _ = happyReduce_57 action_202 _ = happyReduce_241 action_203 _ = happyReduce_235 action_204 (133) = happyShift action_43 action_204 (135) = happyShift action_45 action_204 (169) = happyShift action_49 action_204 (177) = happyShift action_50 action_204 (192) = happyShift action_52 action_204 (113) = happyGoto action_337 action_204 (115) = happyGoto action_338 action_204 _ = happyFail action_205 _ = happyReduce_80 action_206 _ = happyReduce_81 action_207 (137) = happyShift action_172 action_207 (167) = happyShift action_175 action_207 (168) = happyShift action_176 action_207 (120) = happyGoto action_336 action_207 _ = happyFail action_208 _ = happyReduce_142 action_209 (155) = happyShift action_335 action_209 _ = happyFail action_210 (155) = happyShift action_334 action_210 _ = happyFail action_211 (133) = happyShift action_43 action_211 (134) = happyShift action_44 action_211 (135) = happyShift action_45 action_211 (136) = happyShift action_46 action_211 (141) = happyShift action_67 action_211 (142) = happyShift action_68 action_211 (143) = happyShift action_69 action_211 (144) = happyShift action_70 action_211 (145) = happyShift action_71 action_211 (151) = happyShift action_72 action_211 (154) = happyShift action_73 action_211 (160) = happyShift action_125 action_211 (165) = happyShift action_74 action_211 (167) = happyShift action_75 action_211 (169) = happyShift action_49 action_211 (170) = happyShift action_76 action_211 (175) = happyShift action_80 action_211 (177) = happyShift action_50 action_211 (178) = happyShift action_126 action_211 (185) = happyShift action_127 action_211 (192) = happyShift action_52 action_211 (69) = happyGoto action_333 action_211 (70) = happyGoto action_121 action_211 (71) = happyGoto action_225 action_211 (72) = happyGoto action_123 action_211 (73) = happyGoto action_57 action_211 (74) = happyGoto action_58 action_211 (77) = happyGoto action_59 action_211 (78) = happyGoto action_60 action_211 (79) = happyGoto action_61 action_211 (98) = happyGoto action_62 action_211 (100) = happyGoto action_124 action_211 (102) = happyGoto action_64 action_211 (112) = happyGoto action_38 action_211 (113) = happyGoto action_39 action_211 (114) = happyGoto action_65 action_211 (115) = happyGoto action_41 action_211 (123) = happyGoto action_66 action_211 _ = happyFail action_212 _ = happyReduce_153 action_213 _ = happyReduce_144 action_214 _ = happyReduce_139 action_215 (148) = happyShift action_241 action_215 (36) = happyGoto action_332 action_215 (125) = happyGoto action_240 action_215 _ = happyReduce_280 action_216 (149) = happyShift action_330 action_216 (153) = happyShift action_331 action_216 _ = happyFail action_217 _ = happyReduce_221 action_218 (159) = happyShift action_329 action_218 _ = happyFail action_219 _ = happyReduce_170 action_220 _ = happyReduce_167 action_221 (155) = happyShift action_328 action_221 _ = happyFail action_222 _ = happyReduce_230 action_223 _ = happyReduce_234 action_224 (146) = happyShift action_327 action_224 _ = happyFail action_225 (137) = happyShift action_172 action_225 (138) = happyShift action_150 action_225 (139) = happyShift action_151 action_225 (140) = happyShift action_152 action_225 (155) = happyShift action_173 action_225 (157) = happyShift action_156 action_225 (167) = happyShift action_175 action_225 (168) = happyShift action_176 action_225 (104) = happyGoto action_165 action_225 (107) = happyGoto action_166 action_225 (109) = happyGoto action_244 action_225 (111) = happyGoto action_168 action_225 (116) = happyGoto action_142 action_225 (117) = happyGoto action_143 action_225 (118) = happyGoto action_169 action_225 (120) = happyGoto action_146 action_225 (122) = happyGoto action_170 action_225 _ = happyReduce_150 action_226 _ = happyReduce_177 action_227 (133) = happyShift action_43 action_227 (134) = happyShift action_44 action_227 (135) = happyShift action_45 action_227 (136) = happyShift action_46 action_227 (141) = happyShift action_67 action_227 (142) = happyShift action_68 action_227 (143) = happyShift action_69 action_227 (144) = happyShift action_70 action_227 (145) = happyShift action_71 action_227 (151) = happyShift action_72 action_227 (154) = happyShift action_73 action_227 (160) = happyShift action_125 action_227 (165) = happyShift action_74 action_227 (167) = happyShift action_75 action_227 (169) = happyShift action_49 action_227 (170) = happyShift action_76 action_227 (175) = happyShift action_80 action_227 (177) = happyShift action_50 action_227 (178) = happyShift action_126 action_227 (185) = happyShift action_127 action_227 (192) = happyShift action_52 action_227 (68) = happyGoto action_326 action_227 (69) = happyGoto action_120 action_227 (70) = happyGoto action_121 action_227 (71) = happyGoto action_122 action_227 (72) = happyGoto action_123 action_227 (73) = happyGoto action_57 action_227 (74) = happyGoto action_58 action_227 (77) = happyGoto action_59 action_227 (78) = happyGoto action_60 action_227 (79) = happyGoto action_61 action_227 (98) = happyGoto action_62 action_227 (100) = happyGoto action_124 action_227 (102) = happyGoto action_64 action_227 (112) = happyGoto action_38 action_227 (113) = happyGoto action_39 action_227 (114) = happyGoto action_65 action_227 (115) = happyGoto action_41 action_227 (123) = happyGoto action_66 action_227 _ = happyFail action_228 _ = happyReduce_225 action_229 _ = happyReduce_182 action_230 (133) = happyShift action_43 action_230 (134) = happyShift action_44 action_230 (135) = happyShift action_45 action_230 (136) = happyShift action_46 action_230 (141) = happyShift action_67 action_230 (142) = happyShift action_68 action_230 (143) = happyShift action_69 action_230 (144) = happyShift action_70 action_230 (145) = happyShift action_71 action_230 (146) = happyShift action_325 action_230 (151) = happyShift action_72 action_230 (154) = happyShift action_73 action_230 (160) = happyShift action_125 action_230 (165) = happyShift action_74 action_230 (167) = happyShift action_75 action_230 (169) = happyShift action_49 action_230 (170) = happyShift action_76 action_230 (175) = happyShift action_80 action_230 (177) = happyShift action_50 action_230 (178) = happyShift action_126 action_230 (185) = happyShift action_127 action_230 (192) = happyShift action_52 action_230 (72) = happyGoto action_306 action_230 (73) = happyGoto action_212 action_230 (74) = happyGoto action_58 action_230 (77) = happyGoto action_59 action_230 (78) = happyGoto action_60 action_230 (79) = happyGoto action_61 action_230 (98) = happyGoto action_62 action_230 (100) = happyGoto action_124 action_230 (102) = happyGoto action_64 action_230 (112) = happyGoto action_38 action_230 (113) = happyGoto action_39 action_230 (114) = happyGoto action_65 action_230 (115) = happyGoto action_41 action_230 (123) = happyGoto action_66 action_230 _ = happyFail action_231 (124) = happyGoto action_324 action_231 _ = happyReduce_279 action_232 _ = happyReduce_176 action_233 (133) = happyShift action_43 action_233 (134) = happyShift action_44 action_233 (135) = happyShift action_45 action_233 (136) = happyShift action_46 action_233 (141) = happyShift action_67 action_233 (142) = happyShift action_68 action_233 (143) = happyShift action_69 action_233 (144) = happyShift action_70 action_233 (145) = happyShift action_71 action_233 (151) = happyShift action_72 action_233 (154) = happyShift action_73 action_233 (160) = happyShift action_125 action_233 (165) = happyShift action_74 action_233 (167) = happyShift action_75 action_233 (169) = happyShift action_49 action_233 (170) = happyShift action_76 action_233 (175) = happyShift action_80 action_233 (177) = happyShift action_50 action_233 (178) = happyShift action_126 action_233 (185) = happyShift action_127 action_233 (192) = happyShift action_52 action_233 (68) = happyGoto action_323 action_233 (69) = happyGoto action_120 action_233 (70) = happyGoto action_121 action_233 (71) = happyGoto action_122 action_233 (72) = happyGoto action_123 action_233 (73) = happyGoto action_57 action_233 (74) = happyGoto action_58 action_233 (77) = happyGoto action_59 action_233 (78) = happyGoto action_60 action_233 (79) = happyGoto action_61 action_233 (98) = happyGoto action_62 action_233 (100) = happyGoto action_124 action_233 (102) = happyGoto action_64 action_233 (112) = happyGoto action_38 action_233 (113) = happyGoto action_39 action_233 (114) = happyGoto action_65 action_233 (115) = happyGoto action_41 action_233 (123) = happyGoto action_66 action_233 _ = happyFail action_234 (133) = happyShift action_43 action_234 (134) = happyShift action_44 action_234 (135) = happyShift action_45 action_234 (136) = happyShift action_46 action_234 (141) = happyShift action_67 action_234 (142) = happyShift action_68 action_234 (143) = happyShift action_69 action_234 (144) = happyShift action_70 action_234 (145) = happyShift action_71 action_234 (151) = happyShift action_72 action_234 (154) = happyShift action_73 action_234 (160) = happyShift action_125 action_234 (165) = happyShift action_74 action_234 (167) = happyShift action_75 action_234 (169) = happyShift action_49 action_234 (170) = happyShift action_76 action_234 (175) = happyShift action_80 action_234 (177) = happyShift action_50 action_234 (178) = happyShift action_126 action_234 (185) = happyShift action_127 action_234 (192) = happyShift action_52 action_234 (68) = happyGoto action_322 action_234 (69) = happyGoto action_120 action_234 (70) = happyGoto action_121 action_234 (71) = happyGoto action_122 action_234 (72) = happyGoto action_123 action_234 (73) = happyGoto action_57 action_234 (74) = happyGoto action_58 action_234 (77) = happyGoto action_59 action_234 (78) = happyGoto action_60 action_234 (79) = happyGoto action_61 action_234 (98) = happyGoto action_62 action_234 (100) = happyGoto action_124 action_234 (102) = happyGoto action_64 action_234 (112) = happyGoto action_38 action_234 (113) = happyGoto action_39 action_234 (114) = happyGoto action_65 action_234 (115) = happyGoto action_41 action_234 (123) = happyGoto action_66 action_234 _ = happyFail action_235 _ = happyReduce_178 action_236 (133) = happyShift action_43 action_236 (134) = happyShift action_44 action_236 (135) = happyShift action_45 action_236 (136) = happyShift action_46 action_236 (141) = happyShift action_67 action_236 (142) = happyShift action_68 action_236 (143) = happyShift action_69 action_236 (144) = happyShift action_70 action_236 (145) = happyShift action_71 action_236 (151) = happyShift action_72 action_236 (154) = happyShift action_73 action_236 (160) = happyShift action_125 action_236 (165) = happyShift action_74 action_236 (167) = happyShift action_75 action_236 (169) = happyShift action_49 action_236 (170) = happyShift action_76 action_236 (175) = happyShift action_80 action_236 (177) = happyShift action_50 action_236 (178) = happyShift action_126 action_236 (185) = happyShift action_127 action_236 (192) = happyShift action_52 action_236 (68) = happyGoto action_321 action_236 (69) = happyGoto action_120 action_236 (70) = happyGoto action_121 action_236 (71) = happyGoto action_122 action_236 (72) = happyGoto action_123 action_236 (73) = happyGoto action_57 action_236 (74) = happyGoto action_58 action_236 (77) = happyGoto action_59 action_236 (78) = happyGoto action_60 action_236 (79) = happyGoto action_61 action_236 (98) = happyGoto action_62 action_236 (100) = happyGoto action_124 action_236 (102) = happyGoto action_64 action_236 (112) = happyGoto action_38 action_236 (113) = happyGoto action_39 action_236 (114) = happyGoto action_65 action_236 (115) = happyGoto action_41 action_236 (123) = happyGoto action_66 action_236 _ = happyFail action_237 (133) = happyShift action_43 action_237 (134) = happyShift action_44 action_237 (135) = happyShift action_45 action_237 (136) = happyShift action_46 action_237 (141) = happyShift action_67 action_237 (142) = happyShift action_68 action_237 (143) = happyShift action_69 action_237 (144) = happyShift action_70 action_237 (145) = happyShift action_71 action_237 (151) = happyShift action_72 action_237 (154) = happyShift action_73 action_237 (160) = happyShift action_125 action_237 (165) = happyShift action_74 action_237 (167) = happyShift action_75 action_237 (169) = happyShift action_49 action_237 (170) = happyShift action_76 action_237 (175) = happyShift action_80 action_237 (177) = happyShift action_50 action_237 (178) = happyShift action_126 action_237 (185) = happyShift action_127 action_237 (192) = happyShift action_52 action_237 (68) = happyGoto action_320 action_237 (69) = happyGoto action_120 action_237 (70) = happyGoto action_121 action_237 (71) = happyGoto action_122 action_237 (72) = happyGoto action_123 action_237 (73) = happyGoto action_57 action_237 (74) = happyGoto action_58 action_237 (77) = happyGoto action_59 action_237 (78) = happyGoto action_60 action_237 (79) = happyGoto action_61 action_237 (98) = happyGoto action_62 action_237 (100) = happyGoto action_124 action_237 (102) = happyGoto action_64 action_237 (112) = happyGoto action_38 action_237 (113) = happyGoto action_39 action_237 (114) = happyGoto action_65 action_237 (115) = happyGoto action_41 action_237 (123) = happyGoto action_66 action_237 _ = happyReduce_188 action_238 (133) = happyShift action_43 action_238 (134) = happyShift action_44 action_238 (135) = happyShift action_45 action_238 (136) = happyShift action_46 action_238 (141) = happyShift action_67 action_238 (142) = happyShift action_68 action_238 (143) = happyShift action_69 action_238 (144) = happyShift action_70 action_238 (145) = happyShift action_71 action_238 (151) = happyShift action_72 action_238 (154) = happyShift action_73 action_238 (160) = happyShift action_125 action_238 (165) = happyShift action_74 action_238 (167) = happyShift action_75 action_238 (169) = happyShift action_49 action_238 (170) = happyShift action_76 action_238 (175) = happyShift action_80 action_238 (177) = happyShift action_50 action_238 (178) = happyShift action_126 action_238 (185) = happyShift action_319 action_238 (192) = happyShift action_52 action_238 (68) = happyGoto action_315 action_238 (69) = happyGoto action_120 action_238 (70) = happyGoto action_121 action_238 (71) = happyGoto action_254 action_238 (72) = happyGoto action_123 action_238 (73) = happyGoto action_57 action_238 (74) = happyGoto action_58 action_238 (77) = happyGoto action_59 action_238 (78) = happyGoto action_60 action_238 (79) = happyGoto action_61 action_238 (84) = happyGoto action_316 action_238 (85) = happyGoto action_317 action_238 (93) = happyGoto action_318 action_238 (98) = happyGoto action_62 action_238 (100) = happyGoto action_124 action_238 (102) = happyGoto action_64 action_238 (112) = happyGoto action_38 action_238 (113) = happyGoto action_39 action_238 (114) = happyGoto action_65 action_238 (115) = happyGoto action_41 action_238 (123) = happyGoto action_66 action_238 _ = happyFail action_239 (180) = happyShift action_314 action_239 _ = happyFail action_240 (7) = happyGoto action_13 action_240 (8) = happyGoto action_311 action_240 (33) = happyGoto action_313 action_240 _ = happyReduce_11 action_241 (7) = happyGoto action_13 action_241 (8) = happyGoto action_311 action_241 (33) = happyGoto action_312 action_241 _ = happyReduce_11 action_242 (189) = happyShift action_310 action_242 _ = happyFail action_243 (133) = happyShift action_43 action_243 (134) = happyShift action_44 action_243 (135) = happyShift action_45 action_243 (136) = happyShift action_46 action_243 (141) = happyShift action_67 action_243 (142) = happyShift action_68 action_243 (143) = happyShift action_69 action_243 (144) = happyShift action_70 action_243 (145) = happyShift action_71 action_243 (151) = happyShift action_72 action_243 (154) = happyShift action_73 action_243 (165) = happyShift action_74 action_243 (169) = happyShift action_49 action_243 (177) = happyShift action_50 action_243 (192) = happyShift action_52 action_243 (75) = happyGoto action_307 action_243 (76) = happyGoto action_308 action_243 (77) = happyGoto action_309 action_243 (78) = happyGoto action_60 action_243 (79) = happyGoto action_61 action_243 (98) = happyGoto action_62 action_243 (100) = happyGoto action_124 action_243 (102) = happyGoto action_64 action_243 (112) = happyGoto action_38 action_243 (113) = happyGoto action_39 action_243 (114) = happyGoto action_65 action_243 (115) = happyGoto action_41 action_243 (123) = happyGoto action_66 action_243 _ = happyFail action_244 (133) = happyShift action_43 action_244 (134) = happyShift action_44 action_244 (135) = happyShift action_45 action_244 (136) = happyShift action_46 action_244 (141) = happyShift action_67 action_244 (142) = happyShift action_68 action_244 (143) = happyShift action_69 action_244 (144) = happyShift action_70 action_244 (145) = happyShift action_71 action_244 (151) = happyShift action_72 action_244 (154) = happyShift action_73 action_244 (160) = happyShift action_125 action_244 (165) = happyShift action_74 action_244 (167) = happyShift action_75 action_244 (169) = happyShift action_49 action_244 (170) = happyShift action_76 action_244 (175) = happyShift action_80 action_244 (177) = happyShift action_50 action_244 (178) = happyShift action_126 action_244 (185) = happyShift action_127 action_244 (192) = happyShift action_52 action_244 (72) = happyGoto action_306 action_244 (73) = happyGoto action_212 action_244 (74) = happyGoto action_58 action_244 (77) = happyGoto action_59 action_244 (78) = happyGoto action_60 action_244 (79) = happyGoto action_61 action_244 (98) = happyGoto action_62 action_244 (100) = happyGoto action_124 action_244 (102) = happyGoto action_64 action_244 (112) = happyGoto action_38 action_244 (113) = happyGoto action_39 action_244 (114) = happyGoto action_65 action_244 (115) = happyGoto action_41 action_244 (123) = happyGoto action_66 action_244 _ = happyFail action_245 (148) = happyShift action_305 action_245 (86) = happyGoto action_303 action_245 (125) = happyGoto action_304 action_245 _ = happyReduce_280 action_246 _ = happyReduce_64 action_247 (148) = happyShift action_241 action_247 (36) = happyGoto action_302 action_247 (125) = happyGoto action_240 action_247 _ = happyReduce_280 action_248 (48) = happyGoto action_300 action_248 (49) = happyGoto action_301 action_248 (124) = happyGoto action_280 action_248 _ = happyReduce_279 action_249 (146) = happyShift action_299 action_249 _ = happyFail action_250 (153) = happyShift action_287 action_250 _ = happyReduce_69 action_251 (133) = happyShift action_43 action_251 (135) = happyShift action_45 action_251 (136) = happyShift action_46 action_251 (145) = happyShift action_108 action_251 (151) = happyShift action_109 action_251 (163) = happyShift action_273 action_251 (169) = happyShift action_49 action_251 (177) = happyShift action_50 action_251 (192) = happyShift action_52 action_251 (41) = happyGoto action_272 action_251 (42) = happyGoto action_102 action_251 (113) = happyGoto action_105 action_251 (114) = happyGoto action_106 action_251 (115) = happyGoto action_41 action_251 (132) = happyGoto action_107 action_251 _ = happyReduce_84 action_252 (153) = happyShift action_285 action_252 _ = happyReduce_68 action_253 (147) = happyShift action_298 action_253 _ = happyReduce_219 action_254 (137) = happyShift action_172 action_254 (138) = happyShift action_150 action_254 (139) = happyShift action_151 action_254 (140) = happyShift action_152 action_254 (155) = happyShift action_173 action_254 (157) = happyShift action_156 action_254 (158) = happyShift action_231 action_254 (162) = happyReduce_211 action_254 (167) = happyShift action_175 action_254 (168) = happyShift action_176 action_254 (104) = happyGoto action_165 action_254 (107) = happyGoto action_166 action_254 (109) = happyGoto action_244 action_254 (111) = happyGoto action_168 action_254 (116) = happyGoto action_142 action_254 (117) = happyGoto action_143 action_254 (118) = happyGoto action_169 action_254 (120) = happyGoto action_146 action_254 (122) = happyGoto action_170 action_254 _ = happyReduce_150 action_255 (124) = happyGoto action_297 action_255 _ = happyReduce_279 action_256 (149) = happyShift action_296 action_256 _ = happyFail action_257 (133) = happyShift action_43 action_257 (134) = happyShift action_44 action_257 (135) = happyShift action_45 action_257 (136) = happyShift action_46 action_257 (141) = happyShift action_67 action_257 (142) = happyShift action_68 action_257 (143) = happyShift action_69 action_257 (144) = happyShift action_70 action_257 (145) = happyShift action_71 action_257 (147) = happyShift action_257 action_257 (151) = happyShift action_72 action_257 (154) = happyShift action_73 action_257 (160) = happyShift action_125 action_257 (165) = happyShift action_74 action_257 (167) = happyShift action_75 action_257 (169) = happyShift action_49 action_257 (170) = happyShift action_76 action_257 (175) = happyShift action_80 action_257 (177) = happyShift action_50 action_257 (178) = happyShift action_126 action_257 (185) = happyShift action_258 action_257 (192) = happyShift action_52 action_257 (68) = happyGoto action_253 action_257 (69) = happyGoto action_120 action_257 (70) = happyGoto action_121 action_257 (71) = happyGoto action_254 action_257 (72) = happyGoto action_123 action_257 (73) = happyGoto action_57 action_257 (74) = happyGoto action_58 action_257 (77) = happyGoto action_59 action_257 (78) = happyGoto action_60 action_257 (79) = happyGoto action_61 action_257 (93) = happyGoto action_255 action_257 (95) = happyGoto action_295 action_257 (98) = happyGoto action_62 action_257 (100) = happyGoto action_124 action_257 (102) = happyGoto action_64 action_257 (112) = happyGoto action_38 action_257 (113) = happyGoto action_39 action_257 (114) = happyGoto action_65 action_257 (115) = happyGoto action_41 action_257 (123) = happyGoto action_66 action_257 _ = happyFail action_258 (148) = happyShift action_241 action_258 (36) = happyGoto action_294 action_258 (125) = happyGoto action_240 action_258 _ = happyReduce_280 action_259 (1) = happyShift action_17 action_259 (150) = happyShift action_18 action_259 (126) = happyGoto action_293 action_259 _ = happyFail action_260 (169) = happyShift action_292 action_260 (17) = happyGoto action_291 action_260 _ = happyReduce_32 action_261 _ = happyReduce_65 action_262 (148) = happyShift action_290 action_262 (125) = happyGoto action_289 action_262 _ = happyReduce_280 action_263 (152) = happyShift action_288 action_263 _ = happyFail action_264 _ = happyReduce_95 action_265 (146) = happyShift action_286 action_265 (153) = happyShift action_287 action_265 _ = happyFail action_266 (146) = happyShift action_284 action_266 (153) = happyShift action_285 action_266 _ = happyFail action_267 (146) = happyShift action_283 action_267 (153) = happyShift action_229 action_267 _ = happyFail action_268 _ = happyReduce_93 action_269 (146) = happyShift action_282 action_269 _ = happyFail action_270 (133) = happyShift action_43 action_270 (135) = happyShift action_45 action_270 (136) = happyShift action_46 action_270 (145) = happyShift action_108 action_270 (151) = happyShift action_109 action_270 (169) = happyShift action_49 action_270 (177) = happyShift action_50 action_270 (192) = happyShift action_52 action_270 (39) = happyGoto action_281 action_270 (40) = happyGoto action_251 action_270 (41) = happyGoto action_101 action_270 (42) = happyGoto action_102 action_270 (113) = happyGoto action_105 action_270 (114) = happyGoto action_106 action_270 (115) = happyGoto action_41 action_270 (132) = happyGoto action_107 action_270 _ = happyFail action_271 (49) = happyGoto action_279 action_271 (124) = happyGoto action_280 action_271 _ = happyReduce_279 action_272 _ = happyReduce_85 action_273 (133) = happyShift action_43 action_273 (135) = happyShift action_45 action_273 (136) = happyShift action_46 action_273 (145) = happyShift action_108 action_273 (151) = happyShift action_109 action_273 (169) = happyShift action_49 action_273 (177) = happyShift action_50 action_273 (192) = happyShift action_52 action_273 (39) = happyGoto action_278 action_273 (40) = happyGoto action_251 action_273 (41) = happyGoto action_101 action_273 (42) = happyGoto action_102 action_273 (113) = happyGoto action_105 action_273 (114) = happyGoto action_106 action_273 (115) = happyGoto action_41 action_273 (132) = happyGoto action_107 action_273 _ = happyFail action_274 (133) = happyShift action_43 action_274 (169) = happyShift action_49 action_274 (177) = happyShift action_50 action_274 (192) = happyShift action_52 action_274 (113) = happyGoto action_105 action_274 (132) = happyGoto action_277 action_274 _ = happyReduce_102 action_275 (133) = happyShift action_43 action_275 (135) = happyShift action_45 action_275 (136) = happyShift action_46 action_275 (145) = happyShift action_108 action_275 (151) = happyShift action_109 action_275 (169) = happyShift action_49 action_275 (177) = happyShift action_50 action_275 (192) = happyShift action_52 action_275 (39) = happyGoto action_276 action_275 (40) = happyGoto action_251 action_275 (41) = happyGoto action_101 action_275 (42) = happyGoto action_102 action_275 (113) = happyGoto action_105 action_275 (114) = happyGoto action_106 action_275 (115) = happyGoto action_41 action_275 (132) = happyGoto action_107 action_275 _ = happyFail action_276 _ = happyReduce_61 action_277 _ = happyReduce_103 action_278 _ = happyReduce_83 action_279 (174) = happyShift action_372 action_279 (57) = happyGoto action_394 action_279 _ = happyReduce_124 action_280 (133) = happyShift action_43 action_280 (135) = happyShift action_45 action_280 (136) = happyShift action_46 action_280 (145) = happyShift action_392 action_280 (151) = happyShift action_109 action_280 (168) = happyShift action_393 action_280 (169) = happyShift action_49 action_280 (177) = happyShift action_50 action_280 (192) = happyShift action_52 action_280 (40) = happyGoto action_386 action_280 (41) = happyGoto action_101 action_280 (42) = happyGoto action_102 action_280 (50) = happyGoto action_387 action_280 (51) = happyGoto action_388 action_280 (53) = happyGoto action_389 action_280 (101) = happyGoto action_390 action_280 (113) = happyGoto action_105 action_280 (114) = happyGoto action_106 action_280 (115) = happyGoto action_391 action_280 (132) = happyGoto action_107 action_280 _ = happyFail action_281 _ = happyReduce_97 action_282 _ = happyReduce_94 action_283 _ = happyReduce_96 action_284 _ = happyReduce_89 action_285 (133) = happyShift action_43 action_285 (135) = happyShift action_45 action_285 (136) = happyShift action_46 action_285 (145) = happyShift action_108 action_285 (151) = happyShift action_109 action_285 (169) = happyShift action_49 action_285 (177) = happyShift action_50 action_285 (192) = happyShift action_52 action_285 (39) = happyGoto action_385 action_285 (40) = happyGoto action_251 action_285 (41) = happyGoto action_101 action_285 (42) = happyGoto action_102 action_285 (113) = happyGoto action_105 action_285 (114) = happyGoto action_106 action_285 (115) = happyGoto action_41 action_285 (132) = happyGoto action_107 action_285 _ = happyFail action_286 _ = happyReduce_91 action_287 (133) = happyShift action_43 action_287 (135) = happyShift action_45 action_287 (136) = happyShift action_46 action_287 (145) = happyShift action_108 action_287 (151) = happyShift action_109 action_287 (169) = happyShift action_49 action_287 (177) = happyShift action_50 action_287 (192) = happyShift action_52 action_287 (39) = happyGoto action_384 action_287 (40) = happyGoto action_251 action_287 (41) = happyGoto action_101 action_287 (42) = happyGoto action_102 action_287 (113) = happyGoto action_105 action_287 (114) = happyGoto action_106 action_287 (115) = happyGoto action_41 action_287 (132) = happyGoto action_107 action_287 _ = happyFail action_288 _ = happyReduce_90 action_289 (7) = happyGoto action_13 action_289 (8) = happyGoto action_381 action_289 (61) = happyGoto action_383 action_289 _ = happyReduce_11 action_290 (7) = happyGoto action_13 action_290 (8) = happyGoto action_381 action_290 (61) = happyGoto action_382 action_290 _ = happyReduce_11 action_291 (145) = happyReduce_38 action_291 (177) = happyShift action_380 action_291 (18) = happyGoto action_377 action_291 (19) = happyGoto action_378 action_291 (20) = happyGoto action_379 action_291 _ = happyReduce_34 action_292 (135) = happyShift action_10 action_292 (136) = happyShift action_11 action_292 (127) = happyGoto action_376 action_292 _ = happyFail action_293 _ = happyReduce_213 action_294 (147) = happyShift action_375 action_294 (180) = happyShift action_314 action_294 _ = happyFail action_295 _ = happyReduce_217 action_296 _ = happyReduce_212 action_297 (162) = happyShift action_374 action_297 _ = happyFail action_298 (133) = happyShift action_43 action_298 (134) = happyShift action_44 action_298 (135) = happyShift action_45 action_298 (136) = happyShift action_46 action_298 (141) = happyShift action_67 action_298 (142) = happyShift action_68 action_298 (143) = happyShift action_69 action_298 (144) = happyShift action_70 action_298 (145) = happyShift action_71 action_298 (147) = happyShift action_257 action_298 (151) = happyShift action_72 action_298 (154) = happyShift action_73 action_298 (160) = happyShift action_125 action_298 (165) = happyShift action_74 action_298 (167) = happyShift action_75 action_298 (169) = happyShift action_49 action_298 (170) = happyShift action_76 action_298 (175) = happyShift action_80 action_298 (177) = happyShift action_50 action_298 (178) = happyShift action_126 action_298 (185) = happyShift action_258 action_298 (192) = happyShift action_52 action_298 (68) = happyGoto action_253 action_298 (69) = happyGoto action_120 action_298 (70) = happyGoto action_121 action_298 (71) = happyGoto action_254 action_298 (72) = happyGoto action_123 action_298 (73) = happyGoto action_57 action_298 (74) = happyGoto action_58 action_298 (77) = happyGoto action_59 action_298 (78) = happyGoto action_60 action_298 (79) = happyGoto action_61 action_298 (93) = happyGoto action_255 action_298 (95) = happyGoto action_373 action_298 (98) = happyGoto action_62 action_298 (100) = happyGoto action_124 action_298 (102) = happyGoto action_64 action_298 (112) = happyGoto action_38 action_298 (113) = happyGoto action_39 action_298 (114) = happyGoto action_65 action_298 (115) = happyGoto action_41 action_298 (123) = happyGoto action_66 action_298 _ = happyReduce_218 action_299 _ = happyReduce_66 action_300 (161) = happyShift action_371 action_300 (174) = happyShift action_372 action_300 (57) = happyGoto action_370 action_300 _ = happyReduce_124 action_301 _ = happyReduce_106 action_302 _ = happyReduce_130 action_303 _ = happyReduce_158 action_304 (7) = happyGoto action_13 action_304 (8) = happyGoto action_367 action_304 (87) = happyGoto action_369 action_304 _ = happyReduce_11 action_305 (7) = happyGoto action_13 action_305 (8) = happyGoto action_367 action_305 (87) = happyGoto action_368 action_305 _ = happyReduce_11 action_306 _ = happyReduce_151 action_307 (133) = happyShift action_43 action_307 (134) = happyShift action_44 action_307 (135) = happyShift action_45 action_307 (136) = happyShift action_46 action_307 (141) = happyShift action_67 action_307 (142) = happyShift action_68 action_307 (143) = happyShift action_69 action_307 (144) = happyShift action_70 action_307 (145) = happyShift action_71 action_307 (151) = happyShift action_72 action_307 (154) = happyShift action_73 action_307 (163) = happyShift action_366 action_307 (165) = happyShift action_74 action_307 (169) = happyShift action_49 action_307 (177) = happyShift action_50 action_307 (192) = happyShift action_52 action_307 (76) = happyGoto action_365 action_307 (77) = happyGoto action_309 action_307 (78) = happyGoto action_60 action_307 (79) = happyGoto action_61 action_307 (98) = happyGoto action_62 action_307 (100) = happyGoto action_124 action_307 (102) = happyGoto action_64 action_307 (112) = happyGoto action_38 action_307 (113) = happyGoto action_39 action_307 (114) = happyGoto action_65 action_307 (115) = happyGoto action_41 action_307 (123) = happyGoto action_66 action_307 _ = happyFail action_308 _ = happyReduce_165 action_309 _ = happyReduce_166 action_310 (133) = happyShift action_43 action_310 (134) = happyShift action_44 action_310 (135) = happyShift action_45 action_310 (136) = happyShift action_46 action_310 (141) = happyShift action_67 action_310 (142) = happyShift action_68 action_310 (143) = happyShift action_69 action_310 (144) = happyShift action_70 action_310 (145) = happyShift action_71 action_310 (151) = happyShift action_72 action_310 (154) = happyShift action_73 action_310 (160) = happyShift action_125 action_310 (165) = happyShift action_74 action_310 (167) = happyShift action_75 action_310 (169) = happyShift action_49 action_310 (170) = happyShift action_76 action_310 (175) = happyShift action_80 action_310 (177) = happyShift action_50 action_310 (178) = happyShift action_126 action_310 (185) = happyShift action_127 action_310 (192) = happyShift action_52 action_310 (68) = happyGoto action_364 action_310 (69) = happyGoto action_120 action_310 (70) = happyGoto action_121 action_310 (71) = happyGoto action_122 action_310 (72) = happyGoto action_123 action_310 (73) = happyGoto action_57 action_310 (74) = happyGoto action_58 action_310 (77) = happyGoto action_59 action_310 (78) = happyGoto action_60 action_310 (79) = happyGoto action_61 action_310 (98) = happyGoto action_62 action_310 (100) = happyGoto action_124 action_310 (102) = happyGoto action_64 action_310 (112) = happyGoto action_38 action_310 (113) = happyGoto action_39 action_310 (114) = happyGoto action_65 action_310 (115) = happyGoto action_41 action_310 (123) = happyGoto action_66 action_310 _ = happyFail action_311 (133) = happyReduce_279 action_311 (134) = happyReduce_279 action_311 (135) = happyReduce_279 action_311 (136) = happyReduce_279 action_311 (141) = happyReduce_279 action_311 (142) = happyReduce_279 action_311 (143) = happyReduce_279 action_311 (144) = happyReduce_279 action_311 (145) = happyReduce_279 action_311 (147) = happyShift action_29 action_311 (151) = happyReduce_279 action_311 (154) = happyReduce_279 action_311 (165) = happyReduce_279 action_311 (167) = happyReduce_279 action_311 (169) = happyReduce_279 action_311 (170) = happyReduce_279 action_311 (175) = happyReduce_279 action_311 (177) = happyReduce_279 action_311 (181) = happyReduce_279 action_311 (182) = happyReduce_279 action_311 (183) = happyReduce_279 action_311 (192) = happyReduce_279 action_311 (25) = happyGoto action_21 action_311 (34) = happyGoto action_361 action_311 (35) = happyGoto action_362 action_311 (37) = happyGoto action_26 action_311 (63) = happyGoto action_27 action_311 (124) = happyGoto action_363 action_311 _ = happyReduce_72 action_312 (149) = happyShift action_360 action_312 _ = happyFail action_313 (1) = happyShift action_17 action_313 (150) = happyShift action_18 action_313 (126) = happyGoto action_359 action_313 _ = happyFail action_314 (133) = happyShift action_43 action_314 (134) = happyShift action_44 action_314 (135) = happyShift action_45 action_314 (136) = happyShift action_46 action_314 (141) = happyShift action_67 action_314 (142) = happyShift action_68 action_314 (143) = happyShift action_69 action_314 (144) = happyShift action_70 action_314 (145) = happyShift action_71 action_314 (151) = happyShift action_72 action_314 (154) = happyShift action_73 action_314 (160) = happyShift action_125 action_314 (165) = happyShift action_74 action_314 (167) = happyShift action_75 action_314 (169) = happyShift action_49 action_314 (170) = happyShift action_76 action_314 (175) = happyShift action_80 action_314 (177) = happyShift action_50 action_314 (178) = happyShift action_126 action_314 (185) = happyShift action_127 action_314 (192) = happyShift action_52 action_314 (68) = happyGoto action_358 action_314 (69) = happyGoto action_120 action_314 (70) = happyGoto action_121 action_314 (71) = happyGoto action_122 action_314 (72) = happyGoto action_123 action_314 (73) = happyGoto action_57 action_314 (74) = happyGoto action_58 action_314 (77) = happyGoto action_59 action_314 (78) = happyGoto action_60 action_314 (79) = happyGoto action_61 action_314 (98) = happyGoto action_62 action_314 (100) = happyGoto action_124 action_314 (102) = happyGoto action_64 action_314 (112) = happyGoto action_38 action_314 (113) = happyGoto action_39 action_314 (114) = happyGoto action_65 action_314 (115) = happyGoto action_41 action_314 (123) = happyGoto action_66 action_314 _ = happyFail action_315 _ = happyReduce_198 action_316 (153) = happyShift action_357 action_316 _ = happyReduce_192 action_317 _ = happyReduce_196 action_318 (124) = happyGoto action_356 action_318 _ = happyReduce_279 action_319 (148) = happyShift action_241 action_319 (36) = happyGoto action_355 action_319 (125) = happyGoto action_240 action_319 _ = happyReduce_280 action_320 _ = happyReduce_190 action_321 (156) = happyShift action_354 action_321 _ = happyReduce_194 action_322 _ = happyReduce_193 action_323 _ = happyReduce_185 action_324 (133) = happyShift action_43 action_324 (135) = happyShift action_45 action_324 (136) = happyShift action_46 action_324 (145) = happyShift action_108 action_324 (151) = happyShift action_109 action_324 (169) = happyShift action_49 action_324 (177) = happyShift action_50 action_324 (192) = happyShift action_52 action_324 (39) = happyGoto action_99 action_324 (40) = happyGoto action_100 action_324 (41) = happyGoto action_101 action_324 (42) = happyGoto action_102 action_324 (43) = happyGoto action_353 action_324 (44) = happyGoto action_104 action_324 (113) = happyGoto action_105 action_324 (114) = happyGoto action_106 action_324 (115) = happyGoto action_41 action_324 (132) = happyGoto action_107 action_324 _ = happyFail action_325 _ = happyReduce_179 action_326 _ = happyReduce_184 action_327 _ = happyReduce_180 action_328 _ = happyReduce_240 action_329 (133) = happyShift action_43 action_329 (134) = happyShift action_44 action_329 (135) = happyShift action_45 action_329 (136) = happyShift action_46 action_329 (141) = happyShift action_67 action_329 (142) = happyShift action_68 action_329 (143) = happyShift action_69 action_329 (144) = happyShift action_70 action_329 (145) = happyShift action_71 action_329 (151) = happyShift action_72 action_329 (154) = happyShift action_73 action_329 (160) = happyShift action_125 action_329 (165) = happyShift action_74 action_329 (167) = happyShift action_75 action_329 (169) = happyShift action_49 action_329 (170) = happyShift action_76 action_329 (175) = happyShift action_80 action_329 (177) = happyShift action_50 action_329 (178) = happyShift action_126 action_329 (185) = happyShift action_127 action_329 (192) = happyShift action_52 action_329 (68) = happyGoto action_352 action_329 (69) = happyGoto action_120 action_329 (70) = happyGoto action_121 action_329 (71) = happyGoto action_122 action_329 (72) = happyGoto action_123 action_329 (73) = happyGoto action_57 action_329 (74) = happyGoto action_58 action_329 (77) = happyGoto action_59 action_329 (78) = happyGoto action_60 action_329 (79) = happyGoto action_61 action_329 (98) = happyGoto action_62 action_329 (100) = happyGoto action_124 action_329 (102) = happyGoto action_64 action_329 (112) = happyGoto action_38 action_329 (113) = happyGoto action_39 action_329 (114) = happyGoto action_65 action_329 (115) = happyGoto action_41 action_329 (123) = happyGoto action_66 action_329 _ = happyFail action_330 _ = happyReduce_171 action_331 (133) = happyShift action_43 action_331 (134) = happyShift action_44 action_331 (145) = happyShift action_47 action_331 (169) = happyShift action_49 action_331 (177) = happyShift action_50 action_331 (192) = happyShift action_52 action_331 (97) = happyGoto action_351 action_331 (100) = happyGoto action_218 action_331 (112) = happyGoto action_38 action_331 (113) = happyGoto action_39 action_331 _ = happyFail action_332 _ = happyReduce_140 action_333 (159) = happyShift action_350 action_333 _ = happyFail action_334 _ = happyReduce_244 action_335 _ = happyReduce_238 action_336 (146) = happyShift action_349 action_336 _ = happyFail action_337 (155) = happyShift action_348 action_337 _ = happyFail action_338 (155) = happyShift action_347 action_338 _ = happyFail action_339 (137) = happyShift action_172 action_339 (138) = happyShift action_150 action_339 (155) = happyShift action_204 action_339 (167) = happyShift action_175 action_339 (168) = happyShift action_176 action_339 (103) = happyGoto action_199 action_339 (106) = happyGoto action_200 action_339 (108) = happyGoto action_346 action_339 (117) = happyGoto action_202 action_339 (120) = happyGoto action_203 action_339 _ = happyFail action_340 _ = happyReduce_22 action_341 (146) = happyShift action_345 action_341 _ = happyFail action_342 _ = happyReduce_24 action_343 (133) = happyShift action_43 action_343 (135) = happyShift action_45 action_343 (145) = happyShift action_195 action_343 (169) = happyShift action_49 action_343 (177) = happyShift action_50 action_343 (192) = happyShift action_52 action_343 (24) = happyGoto action_344 action_343 (99) = happyGoto action_191 action_343 (101) = happyGoto action_192 action_343 (113) = happyGoto action_193 action_343 (115) = happyGoto action_194 action_343 _ = happyFail action_344 _ = happyReduce_46 action_345 _ = happyReduce_232 action_346 _ = happyReduce_56 action_347 _ = happyReduce_242 action_348 _ = happyReduce_236 action_349 _ = happyReduce_228 action_350 (133) = happyShift action_43 action_350 (134) = happyShift action_44 action_350 (135) = happyShift action_45 action_350 (136) = happyShift action_46 action_350 (141) = happyShift action_67 action_350 (142) = happyShift action_68 action_350 (143) = happyShift action_69 action_350 (144) = happyShift action_70 action_350 (145) = happyShift action_71 action_350 (151) = happyShift action_72 action_350 (154) = happyShift action_73 action_350 (160) = happyShift action_125 action_350 (165) = happyShift action_74 action_350 (167) = happyShift action_75 action_350 (169) = happyShift action_49 action_350 (170) = happyShift action_76 action_350 (175) = happyShift action_80 action_350 (177) = happyShift action_50 action_350 (178) = happyShift action_126 action_350 (185) = happyShift action_127 action_350 (192) = happyShift action_52 action_350 (68) = happyGoto action_427 action_350 (69) = happyGoto action_120 action_350 (70) = happyGoto action_121 action_350 (71) = happyGoto action_122 action_350 (72) = happyGoto action_123 action_350 (73) = happyGoto action_57 action_350 (74) = happyGoto action_58 action_350 (77) = happyGoto action_59 action_350 (78) = happyGoto action_60 action_350 (79) = happyGoto action_61 action_350 (98) = happyGoto action_62 action_350 (100) = happyGoto action_124 action_350 (102) = happyGoto action_64 action_350 (112) = happyGoto action_38 action_350 (113) = happyGoto action_39 action_350 (114) = happyGoto action_65 action_350 (115) = happyGoto action_41 action_350 (123) = happyGoto action_66 action_350 _ = happyFail action_351 _ = happyReduce_220 action_352 _ = happyReduce_222 action_353 _ = happyReduce_147 action_354 (133) = happyShift action_43 action_354 (134) = happyShift action_44 action_354 (135) = happyShift action_45 action_354 (136) = happyShift action_46 action_354 (141) = happyShift action_67 action_354 (142) = happyShift action_68 action_354 (143) = happyShift action_69 action_354 (144) = happyShift action_70 action_354 (145) = happyShift action_71 action_354 (151) = happyShift action_72 action_354 (154) = happyShift action_73 action_354 (160) = happyShift action_125 action_354 (165) = happyShift action_74 action_354 (167) = happyShift action_75 action_354 (169) = happyShift action_49 action_354 (170) = happyShift action_76 action_354 (175) = happyShift action_80 action_354 (177) = happyShift action_50 action_354 (178) = happyShift action_126 action_354 (185) = happyShift action_127 action_354 (192) = happyShift action_52 action_354 (68) = happyGoto action_426 action_354 (69) = happyGoto action_120 action_354 (70) = happyGoto action_121 action_354 (71) = happyGoto action_122 action_354 (72) = happyGoto action_123 action_354 (73) = happyGoto action_57 action_354 (74) = happyGoto action_58 action_354 (77) = happyGoto action_59 action_354 (78) = happyGoto action_60 action_354 (79) = happyGoto action_61 action_354 (98) = happyGoto action_62 action_354 (100) = happyGoto action_124 action_354 (102) = happyGoto action_64 action_354 (112) = happyGoto action_38 action_354 (113) = happyGoto action_39 action_354 (114) = happyGoto action_65 action_354 (115) = happyGoto action_41 action_354 (123) = happyGoto action_66 action_354 _ = happyReduce_189 action_355 (180) = happyShift action_314 action_355 _ = happyReduce_199 action_356 (162) = happyShift action_425 action_356 _ = happyFail action_357 (133) = happyShift action_43 action_357 (134) = happyShift action_44 action_357 (135) = happyShift action_45 action_357 (136) = happyShift action_46 action_357 (141) = happyShift action_67 action_357 (142) = happyShift action_68 action_357 (143) = happyShift action_69 action_357 (144) = happyShift action_70 action_357 (145) = happyShift action_71 action_357 (151) = happyShift action_72 action_357 (154) = happyShift action_73 action_357 (160) = happyShift action_125 action_357 (165) = happyShift action_74 action_357 (167) = happyShift action_75 action_357 (169) = happyShift action_49 action_357 (170) = happyShift action_76 action_357 (175) = happyShift action_80 action_357 (177) = happyShift action_50 action_357 (178) = happyShift action_126 action_357 (185) = happyShift action_319 action_357 (192) = happyShift action_52 action_357 (68) = happyGoto action_315 action_357 (69) = happyGoto action_120 action_357 (70) = happyGoto action_121 action_357 (71) = happyGoto action_254 action_357 (72) = happyGoto action_123 action_357 (73) = happyGoto action_57 action_357 (74) = happyGoto action_58 action_357 (77) = happyGoto action_59 action_357 (78) = happyGoto action_60 action_357 (79) = happyGoto action_61 action_357 (85) = happyGoto action_424 action_357 (93) = happyGoto action_318 action_357 (98) = happyGoto action_62 action_357 (100) = happyGoto action_124 action_357 (102) = happyGoto action_64 action_357 (112) = happyGoto action_38 action_357 (113) = happyGoto action_39 action_357 (114) = happyGoto action_65 action_357 (115) = happyGoto action_41 action_357 (123) = happyGoto action_66 action_357 _ = happyFail action_358 _ = happyReduce_156 action_359 _ = happyReduce_79 action_360 _ = happyReduce_78 action_361 (7) = happyGoto action_422 action_361 (8) = happyGoto action_423 action_361 _ = happyReduce_11 action_362 _ = happyReduce_74 action_363 (133) = happyShift action_43 action_363 (134) = happyShift action_44 action_363 (135) = happyShift action_45 action_363 (136) = happyShift action_46 action_363 (141) = happyShift action_67 action_363 (142) = happyShift action_68 action_363 (143) = happyShift action_69 action_363 (144) = happyShift action_70 action_363 (145) = happyShift action_71 action_363 (151) = happyShift action_72 action_363 (154) = happyShift action_73 action_363 (165) = happyShift action_74 action_363 (167) = happyShift action_75 action_363 (169) = happyShift action_49 action_363 (170) = happyShift action_76 action_363 (175) = happyShift action_80 action_363 (177) = happyShift action_50 action_363 (181) = happyShift action_82 action_363 (182) = happyShift action_83 action_363 (183) = happyShift action_84 action_363 (192) = happyShift action_52 action_363 (27) = happyGoto action_54 action_363 (38) = happyGoto action_55 action_363 (71) = happyGoto action_56 action_363 (73) = happyGoto action_57 action_363 (74) = happyGoto action_58 action_363 (77) = happyGoto action_59 action_363 (78) = happyGoto action_60 action_363 (79) = happyGoto action_61 action_363 (98) = happyGoto action_62 action_363 (100) = happyGoto action_63 action_363 (102) = happyGoto action_64 action_363 (112) = happyGoto action_38 action_363 (113) = happyGoto action_39 action_363 (114) = happyGoto action_65 action_363 (115) = happyGoto action_41 action_363 (123) = happyGoto action_66 action_363 _ = happyFail action_364 (176) = happyShift action_421 action_364 _ = happyFail action_365 _ = happyReduce_164 action_366 (133) = happyShift action_43 action_366 (134) = happyShift action_44 action_366 (135) = happyShift action_45 action_366 (136) = happyShift action_46 action_366 (141) = happyShift action_67 action_366 (142) = happyShift action_68 action_366 (143) = happyShift action_69 action_366 (144) = happyShift action_70 action_366 (145) = happyShift action_71 action_366 (151) = happyShift action_72 action_366 (154) = happyShift action_73 action_366 (160) = happyShift action_125 action_366 (165) = happyShift action_74 action_366 (167) = happyShift action_75 action_366 (169) = happyShift action_49 action_366 (170) = happyShift action_76 action_366 (175) = happyShift action_80 action_366 (177) = happyShift action_50 action_366 (178) = happyShift action_126 action_366 (185) = happyShift action_127 action_366 (192) = happyShift action_52 action_366 (68) = happyGoto action_420 action_366 (69) = happyGoto action_120 action_366 (70) = happyGoto action_121 action_366 (71) = happyGoto action_122 action_366 (72) = happyGoto action_123 action_366 (73) = happyGoto action_57 action_366 (74) = happyGoto action_58 action_366 (77) = happyGoto action_59 action_366 (78) = happyGoto action_60 action_366 (79) = happyGoto action_61 action_366 (98) = happyGoto action_62 action_366 (100) = happyGoto action_124 action_366 (102) = happyGoto action_64 action_366 (112) = happyGoto action_38 action_366 (113) = happyGoto action_39 action_366 (114) = happyGoto action_65 action_366 (115) = happyGoto action_41 action_366 (123) = happyGoto action_66 action_366 _ = happyFail action_367 (147) = happyShift action_29 action_367 (88) = happyGoto action_417 action_367 (89) = happyGoto action_418 action_367 (124) = happyGoto action_419 action_367 _ = happyReduce_279 action_368 (149) = happyShift action_416 action_368 _ = happyFail action_369 (1) = happyShift action_17 action_369 (150) = happyShift action_18 action_369 (126) = happyGoto action_415 action_369 _ = happyFail action_370 _ = happyReduce_62 action_371 (49) = happyGoto action_414 action_371 (124) = happyGoto action_280 action_371 _ = happyReduce_279 action_372 (135) = happyShift action_45 action_372 (136) = happyShift action_46 action_372 (145) = happyShift action_413 action_372 (114) = happyGoto action_411 action_372 (115) = happyGoto action_41 action_372 (131) = happyGoto action_412 action_372 _ = happyFail action_373 _ = happyReduce_216 action_374 (133) = happyShift action_43 action_374 (134) = happyShift action_44 action_374 (135) = happyShift action_45 action_374 (136) = happyShift action_46 action_374 (141) = happyShift action_67 action_374 (142) = happyShift action_68 action_374 (143) = happyShift action_69 action_374 (144) = happyShift action_70 action_374 (145) = happyShift action_71 action_374 (151) = happyShift action_72 action_374 (154) = happyShift action_73 action_374 (160) = happyShift action_125 action_374 (165) = happyShift action_74 action_374 (167) = happyShift action_75 action_374 (169) = happyShift action_49 action_374 (170) = happyShift action_76 action_374 (175) = happyShift action_80 action_374 (177) = happyShift action_50 action_374 (178) = happyShift action_126 action_374 (185) = happyShift action_127 action_374 (192) = happyShift action_52 action_374 (68) = happyGoto action_410 action_374 (69) = happyGoto action_120 action_374 (70) = happyGoto action_121 action_374 (71) = happyGoto action_122 action_374 (72) = happyGoto action_123 action_374 (73) = happyGoto action_57 action_374 (74) = happyGoto action_58 action_374 (77) = happyGoto action_59 action_374 (78) = happyGoto action_60 action_374 (79) = happyGoto action_61 action_374 (98) = happyGoto action_62 action_374 (100) = happyGoto action_124 action_374 (102) = happyGoto action_64 action_374 (112) = happyGoto action_38 action_374 (113) = happyGoto action_39 action_374 (114) = happyGoto action_65 action_374 (115) = happyGoto action_41 action_374 (123) = happyGoto action_66 action_374 _ = happyFail action_375 (133) = happyShift action_43 action_375 (134) = happyShift action_44 action_375 (135) = happyShift action_45 action_375 (136) = happyShift action_46 action_375 (141) = happyShift action_67 action_375 (142) = happyShift action_68 action_375 (143) = happyShift action_69 action_375 (144) = happyShift action_70 action_375 (145) = happyShift action_71 action_375 (147) = happyShift action_257 action_375 (151) = happyShift action_72 action_375 (154) = happyShift action_73 action_375 (160) = happyShift action_125 action_375 (165) = happyShift action_74 action_375 (167) = happyShift action_75 action_375 (169) = happyShift action_49 action_375 (170) = happyShift action_76 action_375 (175) = happyShift action_80 action_375 (177) = happyShift action_50 action_375 (178) = happyShift action_126 action_375 (185) = happyShift action_258 action_375 (192) = happyShift action_52 action_375 (68) = happyGoto action_253 action_375 (69) = happyGoto action_120 action_375 (70) = happyGoto action_121 action_375 (71) = happyGoto action_254 action_375 (72) = happyGoto action_123 action_375 (73) = happyGoto action_57 action_375 (74) = happyGoto action_58 action_375 (77) = happyGoto action_59 action_375 (78) = happyGoto action_60 action_375 (79) = happyGoto action_61 action_375 (93) = happyGoto action_255 action_375 (95) = happyGoto action_409 action_375 (98) = happyGoto action_62 action_375 (100) = happyGoto action_124 action_375 (102) = happyGoto action_64 action_375 (112) = happyGoto action_38 action_375 (113) = happyGoto action_39 action_375 (114) = happyGoto action_65 action_375 (115) = happyGoto action_41 action_375 (123) = happyGoto action_66 action_375 _ = happyFail action_376 _ = happyReduce_31 action_377 _ = happyReduce_28 action_378 _ = happyReduce_33 action_379 (145) = happyShift action_408 action_379 _ = happyFail action_380 _ = happyReduce_37 action_381 (133) = happyReduce_279 action_381 (134) = happyReduce_279 action_381 (135) = happyReduce_279 action_381 (136) = happyReduce_279 action_381 (141) = happyReduce_279 action_381 (142) = happyReduce_279 action_381 (143) = happyReduce_279 action_381 (144) = happyReduce_279 action_381 (145) = happyReduce_279 action_381 (147) = happyShift action_29 action_381 (151) = happyReduce_279 action_381 (154) = happyReduce_279 action_381 (165) = happyReduce_279 action_381 (167) = happyReduce_279 action_381 (169) = happyReduce_279 action_381 (170) = happyReduce_279 action_381 (175) = happyReduce_279 action_381 (177) = happyReduce_279 action_381 (192) = happyReduce_279 action_381 (62) = happyGoto action_405 action_381 (63) = happyGoto action_406 action_381 (124) = happyGoto action_407 action_381 _ = happyReduce_136 action_382 (149) = happyShift action_404 action_382 _ = happyFail action_383 (1) = happyShift action_17 action_383 (150) = happyShift action_18 action_383 (126) = happyGoto action_403 action_383 _ = happyFail action_384 _ = happyReduce_101 action_385 _ = happyReduce_100 action_386 (133) = happyShift action_43 action_386 (135) = happyShift action_45 action_386 (136) = happyShift action_46 action_386 (138) = happyReduce_117 action_386 (145) = happyShift action_108 action_386 (151) = happyShift action_109 action_386 (155) = happyReduce_117 action_386 (168) = happyShift action_402 action_386 (169) = happyShift action_49 action_386 (177) = happyShift action_50 action_386 (192) = happyShift action_52 action_386 (41) = happyGoto action_272 action_386 (42) = happyGoto action_102 action_386 (113) = happyGoto action_105 action_386 (114) = happyGoto action_106 action_386 (115) = happyGoto action_41 action_386 (132) = happyGoto action_107 action_386 _ = happyReduce_111 action_387 _ = happyReduce_107 action_388 (133) = happyShift action_43 action_388 (135) = happyShift action_45 action_388 (136) = happyShift action_46 action_388 (145) = happyShift action_108 action_388 (151) = happyShift action_109 action_388 (168) = happyShift action_401 action_388 (169) = happyShift action_49 action_388 (177) = happyShift action_50 action_388 (192) = happyShift action_52 action_388 (41) = happyGoto action_399 action_388 (42) = happyGoto action_102 action_388 (52) = happyGoto action_400 action_388 (113) = happyGoto action_105 action_388 (114) = happyGoto action_106 action_388 (115) = happyGoto action_41 action_388 (132) = happyGoto action_107 action_388 _ = happyReduce_112 action_389 (138) = happyShift action_150 action_389 (155) = happyShift action_398 action_389 (106) = happyGoto action_397 action_389 (117) = happyGoto action_202 action_389 _ = happyFail action_390 (148) = happyShift action_396 action_390 _ = happyFail action_391 (148) = happyReduce_231 action_391 _ = happyReduce_259 action_392 (133) = happyShift action_43 action_392 (135) = happyShift action_45 action_392 (136) = happyShift action_46 action_392 (138) = happyShift action_150 action_392 (145) = happyShift action_108 action_392 (146) = happyShift action_268 action_392 (151) = happyShift action_109 action_392 (153) = happyShift action_154 action_392 (163) = happyShift action_269 action_392 (169) = happyShift action_49 action_392 (177) = happyShift action_50 action_392 (192) = happyShift action_52 action_392 (39) = happyGoto action_265 action_392 (40) = happyGoto action_251 action_392 (41) = happyGoto action_101 action_392 (42) = happyGoto action_102 action_392 (45) = happyGoto action_266 action_392 (80) = happyGoto action_267 action_392 (113) = happyGoto action_105 action_392 (114) = happyGoto action_106 action_392 (115) = happyGoto action_41 action_392 (117) = happyGoto action_341 action_392 (132) = happyGoto action_107 action_392 _ = happyFail action_393 (133) = happyShift action_43 action_393 (135) = happyShift action_45 action_393 (136) = happyShift action_46 action_393 (145) = happyShift action_108 action_393 (151) = happyShift action_109 action_393 (169) = happyShift action_49 action_393 (177) = happyShift action_50 action_393 (192) = happyShift action_52 action_393 (41) = happyGoto action_395 action_393 (42) = happyGoto action_102 action_393 (113) = happyGoto action_105 action_393 (114) = happyGoto action_106 action_393 (115) = happyGoto action_41 action_393 (132) = happyGoto action_107 action_393 _ = happyFail action_394 _ = happyReduce_63 action_395 _ = happyReduce_118 action_396 (133) = happyShift action_43 action_396 (134) = happyShift action_44 action_396 (145) = happyShift action_47 action_396 (149) = happyShift action_455 action_396 (169) = happyShift action_49 action_396 (177) = happyShift action_50 action_396 (192) = happyShift action_52 action_396 (38) = happyGoto action_451 action_396 (54) = happyGoto action_452 action_396 (55) = happyGoto action_453 action_396 (100) = happyGoto action_454 action_396 (112) = happyGoto action_38 action_396 (113) = happyGoto action_39 action_396 _ = happyFail action_397 (133) = happyShift action_43 action_397 (135) = happyShift action_45 action_397 (136) = happyShift action_46 action_397 (145) = happyShift action_108 action_397 (151) = happyShift action_109 action_397 (168) = happyShift action_393 action_397 (169) = happyShift action_49 action_397 (177) = happyShift action_50 action_397 (192) = happyShift action_52 action_397 (40) = happyGoto action_449 action_397 (41) = happyGoto action_101 action_397 (42) = happyGoto action_102 action_397 (53) = happyGoto action_450 action_397 (113) = happyGoto action_105 action_397 (114) = happyGoto action_106 action_397 (115) = happyGoto action_41 action_397 (132) = happyGoto action_107 action_397 _ = happyFail action_398 (135) = happyShift action_45 action_398 (115) = happyGoto action_338 action_398 _ = happyFail action_399 _ = happyReduce_115 action_400 _ = happyReduce_114 action_401 (133) = happyShift action_43 action_401 (135) = happyShift action_45 action_401 (136) = happyShift action_46 action_401 (145) = happyShift action_108 action_401 (151) = happyShift action_109 action_401 (169) = happyShift action_49 action_401 (177) = happyShift action_50 action_401 (192) = happyShift action_52 action_401 (41) = happyGoto action_448 action_401 (42) = happyGoto action_102 action_401 (113) = happyGoto action_105 action_401 (114) = happyGoto action_106 action_401 (115) = happyGoto action_41 action_401 (132) = happyGoto action_107 action_401 _ = happyFail action_402 (133) = happyShift action_43 action_402 (135) = happyShift action_45 action_402 (136) = happyShift action_46 action_402 (145) = happyShift action_108 action_402 (151) = happyShift action_109 action_402 (169) = happyShift action_49 action_402 (177) = happyShift action_50 action_402 (192) = happyShift action_52 action_402 (41) = happyGoto action_447 action_402 (42) = happyGoto action_102 action_402 (113) = happyGoto action_105 action_402 (114) = happyGoto action_106 action_402 (115) = happyGoto action_41 action_402 (132) = happyGoto action_107 action_402 _ = happyFail action_403 _ = happyReduce_133 action_404 _ = happyReduce_132 action_405 (7) = happyGoto action_445 action_405 (8) = happyGoto action_446 action_405 _ = happyReduce_11 action_406 _ = happyReduce_138 action_407 (133) = happyShift action_43 action_407 (134) = happyShift action_44 action_407 (135) = happyShift action_45 action_407 (136) = happyShift action_46 action_407 (141) = happyShift action_67 action_407 (142) = happyShift action_68 action_407 (143) = happyShift action_69 action_407 (144) = happyShift action_70 action_407 (145) = happyShift action_71 action_407 (151) = happyShift action_72 action_407 (154) = happyShift action_73 action_407 (165) = happyShift action_74 action_407 (167) = happyShift action_75 action_407 (169) = happyShift action_49 action_407 (170) = happyShift action_76 action_407 (175) = happyShift action_80 action_407 (177) = happyShift action_50 action_407 (192) = happyShift action_52 action_407 (71) = happyGoto action_56 action_407 (73) = happyGoto action_57 action_407 (74) = happyGoto action_58 action_407 (77) = happyGoto action_59 action_407 (78) = happyGoto action_60 action_407 (79) = happyGoto action_61 action_407 (98) = happyGoto action_62 action_407 (100) = happyGoto action_124 action_407 (102) = happyGoto action_64 action_407 (112) = happyGoto action_38 action_407 (113) = happyGoto action_39 action_407 (114) = happyGoto action_65 action_407 (115) = happyGoto action_41 action_407 (123) = happyGoto action_66 action_407 _ = happyFail action_408 (133) = happyShift action_43 action_408 (135) = happyShift action_45 action_408 (145) = happyShift action_207 action_408 (153) = happyShift action_48 action_408 (169) = happyShift action_49 action_408 (177) = happyShift action_50 action_408 (192) = happyShift action_52 action_408 (11) = happyGoto action_439 action_408 (21) = happyGoto action_440 action_408 (22) = happyGoto action_441 action_408 (99) = happyGoto action_442 action_408 (113) = happyGoto action_193 action_408 (115) = happyGoto action_443 action_408 (128) = happyGoto action_444 action_408 _ = happyReduce_17 action_409 _ = happyReduce_214 action_410 (147) = happyShift action_438 action_410 _ = happyFail action_411 _ = happyReduce_288 action_412 _ = happyReduce_125 action_413 (135) = happyShift action_45 action_413 (136) = happyShift action_46 action_413 (146) = happyShift action_437 action_413 (58) = happyGoto action_435 action_413 (114) = happyGoto action_411 action_413 (115) = happyGoto action_41 action_413 (131) = happyGoto action_436 action_413 _ = happyFail action_414 _ = happyReduce_105 action_415 _ = happyReduce_201 action_416 _ = happyReduce_200 action_417 (7) = happyGoto action_433 action_417 (8) = happyGoto action_434 action_417 _ = happyReduce_11 action_418 _ = happyReduce_204 action_419 (133) = happyShift action_43 action_419 (134) = happyShift action_44 action_419 (135) = happyShift action_45 action_419 (136) = happyShift action_46 action_419 (141) = happyShift action_67 action_419 (142) = happyShift action_68 action_419 (143) = happyShift action_69 action_419 (144) = happyShift action_70 action_419 (145) = happyShift action_71 action_419 (151) = happyShift action_72 action_419 (154) = happyShift action_73 action_419 (165) = happyShift action_74 action_419 (167) = happyShift action_75 action_419 (169) = happyShift action_49 action_419 (170) = happyShift action_76 action_419 (175) = happyShift action_80 action_419 (177) = happyShift action_50 action_419 (192) = happyShift action_52 action_419 (71) = happyGoto action_431 action_419 (73) = happyGoto action_57 action_419 (74) = happyGoto action_58 action_419 (77) = happyGoto action_59 action_419 (78) = happyGoto action_60 action_419 (79) = happyGoto action_61 action_419 (93) = happyGoto action_432 action_419 (98) = happyGoto action_62 action_419 (100) = happyGoto action_124 action_419 (102) = happyGoto action_64 action_419 (112) = happyGoto action_38 action_419 (113) = happyGoto action_39 action_419 (114) = happyGoto action_65 action_419 (115) = happyGoto action_41 action_419 (123) = happyGoto action_66 action_419 _ = happyFail action_420 _ = happyReduce_155 action_421 (133) = happyShift action_43 action_421 (134) = happyShift action_44 action_421 (135) = happyShift action_45 action_421 (136) = happyShift action_46 action_421 (141) = happyShift action_67 action_421 (142) = happyShift action_68 action_421 (143) = happyShift action_69 action_421 (144) = happyShift action_70 action_421 (145) = happyShift action_71 action_421 (151) = happyShift action_72 action_421 (154) = happyShift action_73 action_421 (160) = happyShift action_125 action_421 (165) = happyShift action_74 action_421 (167) = happyShift action_75 action_421 (169) = happyShift action_49 action_421 (170) = happyShift action_76 action_421 (175) = happyShift action_80 action_421 (177) = happyShift action_50 action_421 (178) = happyShift action_126 action_421 (185) = happyShift action_127 action_421 (192) = happyShift action_52 action_421 (68) = happyGoto action_430 action_421 (69) = happyGoto action_120 action_421 (70) = happyGoto action_121 action_421 (71) = happyGoto action_122 action_421 (72) = happyGoto action_123 action_421 (73) = happyGoto action_57 action_421 (74) = happyGoto action_58 action_421 (77) = happyGoto action_59 action_421 (78) = happyGoto action_60 action_421 (79) = happyGoto action_61 action_421 (98) = happyGoto action_62 action_421 (100) = happyGoto action_124 action_421 (102) = happyGoto action_64 action_421 (112) = happyGoto action_38 action_421 (113) = happyGoto action_39 action_421 (114) = happyGoto action_65 action_421 (115) = happyGoto action_41 action_421 (123) = happyGoto action_66 action_421 _ = happyFail action_422 (133) = happyReduce_279 action_422 (134) = happyReduce_279 action_422 (135) = happyReduce_279 action_422 (136) = happyReduce_279 action_422 (141) = happyReduce_279 action_422 (142) = happyReduce_279 action_422 (143) = happyReduce_279 action_422 (144) = happyReduce_279 action_422 (145) = happyReduce_279 action_422 (151) = happyReduce_279 action_422 (154) = happyReduce_279 action_422 (165) = happyReduce_279 action_422 (167) = happyReduce_279 action_422 (169) = happyReduce_279 action_422 (170) = happyReduce_279 action_422 (175) = happyReduce_279 action_422 (177) = happyReduce_279 action_422 (181) = happyReduce_279 action_422 (182) = happyReduce_279 action_422 (183) = happyReduce_279 action_422 (192) = happyReduce_279 action_422 (25) = happyGoto action_21 action_422 (35) = happyGoto action_429 action_422 (37) = happyGoto action_26 action_422 (63) = happyGoto action_27 action_422 (124) = happyGoto action_363 action_422 _ = happyReduce_10 action_423 (147) = happyShift action_29 action_423 _ = happyReduce_71 action_424 _ = happyReduce_195 action_425 (133) = happyShift action_43 action_425 (134) = happyShift action_44 action_425 (135) = happyShift action_45 action_425 (136) = happyShift action_46 action_425 (141) = happyShift action_67 action_425 (142) = happyShift action_68 action_425 (143) = happyShift action_69 action_425 (144) = happyShift action_70 action_425 (145) = happyShift action_71 action_425 (151) = happyShift action_72 action_425 (154) = happyShift action_73 action_425 (160) = happyShift action_125 action_425 (165) = happyShift action_74 action_425 (167) = happyShift action_75 action_425 (169) = happyShift action_49 action_425 (170) = happyShift action_76 action_425 (175) = happyShift action_80 action_425 (177) = happyShift action_50 action_425 (178) = happyShift action_126 action_425 (185) = happyShift action_127 action_425 (192) = happyShift action_52 action_425 (68) = happyGoto action_428 action_425 (69) = happyGoto action_120 action_425 (70) = happyGoto action_121 action_425 (71) = happyGoto action_122 action_425 (72) = happyGoto action_123 action_425 (73) = happyGoto action_57 action_425 (74) = happyGoto action_58 action_425 (77) = happyGoto action_59 action_425 (78) = happyGoto action_60 action_425 (79) = happyGoto action_61 action_425 (98) = happyGoto action_62 action_425 (100) = happyGoto action_124 action_425 (102) = happyGoto action_64 action_425 (112) = happyGoto action_38 action_425 (113) = happyGoto action_39 action_425 (114) = happyGoto action_65 action_425 (115) = happyGoto action_41 action_425 (123) = happyGoto action_66 action_425 _ = happyFail action_426 _ = happyReduce_191 action_427 _ = happyReduce_146 action_428 _ = happyReduce_197 action_429 _ = happyReduce_73 action_430 _ = happyReduce_157 action_431 (137) = happyShift action_172 action_431 (138) = happyShift action_150 action_431 (139) = happyShift action_151 action_431 (140) = happyShift action_152 action_431 (155) = happyShift action_173 action_431 (157) = happyShift action_156 action_431 (167) = happyShift action_175 action_431 (168) = happyShift action_176 action_431 (104) = happyGoto action_165 action_431 (107) = happyGoto action_166 action_431 (109) = happyGoto action_167 action_431 (111) = happyGoto action_168 action_431 (116) = happyGoto action_142 action_431 (117) = happyGoto action_143 action_431 (118) = happyGoto action_169 action_431 (120) = happyGoto action_146 action_431 (122) = happyGoto action_170 action_431 _ = happyReduce_211 action_432 (163) = happyShift action_472 action_432 (90) = happyGoto action_468 action_432 (91) = happyGoto action_469 action_432 (92) = happyGoto action_470 action_432 (124) = happyGoto action_471 action_432 _ = happyReduce_279 action_433 (133) = happyReduce_279 action_433 (134) = happyReduce_279 action_433 (135) = happyReduce_279 action_433 (136) = happyReduce_279 action_433 (141) = happyReduce_279 action_433 (142) = happyReduce_279 action_433 (143) = happyReduce_279 action_433 (144) = happyReduce_279 action_433 (145) = happyReduce_279 action_433 (151) = happyReduce_279 action_433 (154) = happyReduce_279 action_433 (165) = happyReduce_279 action_433 (167) = happyReduce_279 action_433 (169) = happyReduce_279 action_433 (170) = happyReduce_279 action_433 (175) = happyReduce_279 action_433 (177) = happyReduce_279 action_433 (192) = happyReduce_279 action_433 (89) = happyGoto action_467 action_433 (124) = happyGoto action_419 action_433 _ = happyReduce_10 action_434 (147) = happyShift action_29 action_434 _ = happyReduce_202 action_435 (146) = happyShift action_465 action_435 (153) = happyShift action_466 action_435 _ = happyFail action_436 _ = happyReduce_129 action_437 _ = happyReduce_126 action_438 (133) = happyShift action_43 action_438 (134) = happyShift action_44 action_438 (135) = happyShift action_45 action_438 (136) = happyShift action_46 action_438 (141) = happyShift action_67 action_438 (142) = happyShift action_68 action_438 (143) = happyShift action_69 action_438 (144) = happyShift action_70 action_438 (145) = happyShift action_71 action_438 (147) = happyShift action_257 action_438 (151) = happyShift action_72 action_438 (154) = happyShift action_73 action_438 (160) = happyShift action_125 action_438 (165) = happyShift action_74 action_438 (167) = happyShift action_75 action_438 (169) = happyShift action_49 action_438 (170) = happyShift action_76 action_438 (175) = happyShift action_80 action_438 (177) = happyShift action_50 action_438 (178) = happyShift action_126 action_438 (185) = happyShift action_258 action_438 (192) = happyShift action_52 action_438 (68) = happyGoto action_253 action_438 (69) = happyGoto action_120 action_438 (70) = happyGoto action_121 action_438 (71) = happyGoto action_254 action_438 (72) = happyGoto action_123 action_438 (73) = happyGoto action_57 action_438 (74) = happyGoto action_58 action_438 (77) = happyGoto action_59 action_438 (78) = happyGoto action_60 action_438 (79) = happyGoto action_61 action_438 (93) = happyGoto action_255 action_438 (95) = happyGoto action_464 action_438 (98) = happyGoto action_62 action_438 (100) = happyGoto action_124 action_438 (102) = happyGoto action_64 action_438 (112) = happyGoto action_38 action_438 (113) = happyGoto action_39 action_438 (114) = happyGoto action_65 action_438 (115) = happyGoto action_41 action_438 (123) = happyGoto action_66 action_438 _ = happyFail action_439 (146) = happyShift action_463 action_439 _ = happyFail action_440 (153) = happyShift action_462 action_440 (11) = happyGoto action_461 action_440 _ = happyReduce_17 action_441 _ = happyReduce_40 action_442 _ = happyReduce_41 action_443 _ = happyReduce_285 action_444 (145) = happyShift action_460 action_444 _ = happyReduce_42 action_445 (133) = happyReduce_279 action_445 (134) = happyReduce_279 action_445 (135) = happyReduce_279 action_445 (136) = happyReduce_279 action_445 (141) = happyReduce_279 action_445 (142) = happyReduce_279 action_445 (143) = happyReduce_279 action_445 (144) = happyReduce_279 action_445 (145) = happyReduce_279 action_445 (151) = happyReduce_279 action_445 (154) = happyReduce_279 action_445 (165) = happyReduce_279 action_445 (167) = happyReduce_279 action_445 (169) = happyReduce_279 action_445 (170) = happyReduce_279 action_445 (175) = happyReduce_279 action_445 (177) = happyReduce_279 action_445 (192) = happyReduce_279 action_445 (63) = happyGoto action_459 action_445 (124) = happyGoto action_407 action_445 _ = happyReduce_10 action_446 (147) = happyShift action_29 action_446 _ = happyReduce_135 action_447 _ = happyReduce_113 action_448 _ = happyReduce_116 action_449 (133) = happyShift action_43 action_449 (135) = happyShift action_45 action_449 (136) = happyShift action_46 action_449 (145) = happyShift action_108 action_449 (151) = happyShift action_109 action_449 (169) = happyShift action_49 action_449 (177) = happyShift action_50 action_449 (192) = happyShift action_52 action_449 (41) = happyGoto action_272 action_449 (42) = happyGoto action_102 action_449 (113) = happyGoto action_105 action_449 (114) = happyGoto action_106 action_449 (115) = happyGoto action_41 action_449 (132) = happyGoto action_107 action_449 _ = happyReduce_117 action_450 _ = happyReduce_108 action_451 (153) = happyShift action_177 action_451 (158) = happyShift action_458 action_451 _ = happyFail action_452 (149) = happyShift action_456 action_452 (153) = happyShift action_457 action_452 _ = happyFail action_453 _ = happyReduce_120 action_454 _ = happyReduce_82 action_455 _ = happyReduce_109 action_456 _ = happyReduce_110 action_457 (133) = happyShift action_43 action_457 (134) = happyShift action_44 action_457 (145) = happyShift action_47 action_457 (169) = happyShift action_49 action_457 (177) = happyShift action_50 action_457 (192) = happyShift action_52 action_457 (38) = happyGoto action_451 action_457 (55) = happyGoto action_486 action_457 (100) = happyGoto action_454 action_457 (112) = happyGoto action_38 action_457 (113) = happyGoto action_39 action_457 _ = happyFail action_458 (133) = happyShift action_43 action_458 (135) = happyShift action_45 action_458 (136) = happyShift action_46 action_458 (145) = happyShift action_108 action_458 (151) = happyShift action_109 action_458 (168) = happyShift action_485 action_458 (169) = happyShift action_49 action_458 (177) = happyShift action_50 action_458 (192) = happyShift action_52 action_458 (39) = happyGoto action_483 action_458 (40) = happyGoto action_251 action_458 (41) = happyGoto action_101 action_458 (42) = happyGoto action_102 action_458 (56) = happyGoto action_484 action_458 (113) = happyGoto action_105 action_458 (114) = happyGoto action_106 action_458 (115) = happyGoto action_41 action_458 (132) = happyGoto action_107 action_458 _ = happyFail action_459 _ = happyReduce_137 action_460 (133) = happyShift action_43 action_460 (135) = happyShift action_45 action_460 (145) = happyShift action_195 action_460 (146) = happyShift action_481 action_460 (156) = happyShift action_482 action_460 (169) = happyShift action_49 action_460 (177) = happyShift action_50 action_460 (192) = happyShift action_52 action_460 (23) = happyGoto action_480 action_460 (24) = happyGoto action_190 action_460 (99) = happyGoto action_191 action_460 (101) = happyGoto action_192 action_460 (113) = happyGoto action_193 action_460 (115) = happyGoto action_194 action_460 _ = happyFail action_461 (146) = happyShift action_479 action_461 _ = happyFail action_462 (133) = happyShift action_43 action_462 (135) = happyShift action_45 action_462 (145) = happyShift action_207 action_462 (169) = happyShift action_49 action_462 (177) = happyShift action_50 action_462 (192) = happyShift action_52 action_462 (22) = happyGoto action_478 action_462 (99) = happyGoto action_442 action_462 (113) = happyGoto action_193 action_462 (115) = happyGoto action_443 action_462 (128) = happyGoto action_444 action_462 _ = happyReduce_16 action_463 _ = happyReduce_36 action_464 _ = happyReduce_215 action_465 _ = happyReduce_127 action_466 (135) = happyShift action_45 action_466 (136) = happyShift action_46 action_466 (114) = happyGoto action_411 action_466 (115) = happyGoto action_41 action_466 (131) = happyGoto action_477 action_466 _ = happyFail action_467 _ = happyReduce_203 action_468 (191) = happyShift action_215 action_468 (64) = happyGoto action_476 action_468 _ = happyReduce_141 action_469 (161) = happyReduce_279 action_469 (92) = happyGoto action_475 action_469 (124) = happyGoto action_471 action_469 _ = happyReduce_207 action_470 _ = happyReduce_209 action_471 (161) = happyShift action_474 action_471 _ = happyFail action_472 (133) = happyShift action_43 action_472 (134) = happyShift action_44 action_472 (135) = happyShift action_45 action_472 (136) = happyShift action_46 action_472 (141) = happyShift action_67 action_472 (142) = happyShift action_68 action_472 (143) = happyShift action_69 action_472 (144) = happyShift action_70 action_472 (145) = happyShift action_71 action_472 (151) = happyShift action_72 action_472 (154) = happyShift action_73 action_472 (160) = happyShift action_125 action_472 (165) = happyShift action_74 action_472 (167) = happyShift action_75 action_472 (169) = happyShift action_49 action_472 (170) = happyShift action_76 action_472 (175) = happyShift action_80 action_472 (177) = happyShift action_50 action_472 (178) = happyShift action_126 action_472 (185) = happyShift action_127 action_472 (192) = happyShift action_52 action_472 (68) = happyGoto action_473 action_472 (69) = happyGoto action_120 action_472 (70) = happyGoto action_121 action_472 (71) = happyGoto action_122 action_472 (72) = happyGoto action_123 action_472 (73) = happyGoto action_57 action_472 (74) = happyGoto action_58 action_472 (77) = happyGoto action_59 action_472 (78) = happyGoto action_60 action_472 (79) = happyGoto action_61 action_472 (98) = happyGoto action_62 action_472 (100) = happyGoto action_124 action_472 (102) = happyGoto action_64 action_472 (112) = happyGoto action_38 action_472 (113) = happyGoto action_39 action_472 (114) = happyGoto action_65 action_472 (115) = happyGoto action_41 action_472 (123) = happyGoto action_66 action_472 _ = happyFail action_473 _ = happyReduce_206 action_474 (133) = happyShift action_43 action_474 (134) = happyShift action_44 action_474 (135) = happyShift action_45 action_474 (136) = happyShift action_46 action_474 (141) = happyShift action_67 action_474 (142) = happyShift action_68 action_474 (143) = happyShift action_69 action_474 (144) = happyShift action_70 action_474 (145) = happyShift action_71 action_474 (151) = happyShift action_72 action_474 (154) = happyShift action_73 action_474 (160) = happyShift action_125 action_474 (165) = happyShift action_74 action_474 (167) = happyShift action_75 action_474 (169) = happyShift action_49 action_474 (170) = happyShift action_76 action_474 (175) = happyShift action_80 action_474 (177) = happyShift action_50 action_474 (178) = happyShift action_126 action_474 (185) = happyShift action_127 action_474 (192) = happyShift action_52 action_474 (69) = happyGoto action_490 action_474 (70) = happyGoto action_121 action_474 (71) = happyGoto action_225 action_474 (72) = happyGoto action_123 action_474 (73) = happyGoto action_57 action_474 (74) = happyGoto action_58 action_474 (77) = happyGoto action_59 action_474 (78) = happyGoto action_60 action_474 (79) = happyGoto action_61 action_474 (98) = happyGoto action_62 action_474 (100) = happyGoto action_124 action_474 (102) = happyGoto action_64 action_474 (112) = happyGoto action_38 action_474 (113) = happyGoto action_39 action_474 (114) = happyGoto action_65 action_474 (115) = happyGoto action_41 action_474 (123) = happyGoto action_66 action_474 _ = happyFail action_475 _ = happyReduce_208 action_476 _ = happyReduce_205 action_477 _ = happyReduce_128 action_478 _ = happyReduce_39 action_479 _ = happyReduce_35 action_480 (146) = happyShift action_489 action_480 (153) = happyShift action_343 action_480 _ = happyFail action_481 _ = happyReduce_44 action_482 (146) = happyShift action_488 action_482 _ = happyFail action_483 _ = happyReduce_122 action_484 _ = happyReduce_121 action_485 (133) = happyShift action_43 action_485 (135) = happyShift action_45 action_485 (136) = happyShift action_46 action_485 (145) = happyShift action_108 action_485 (151) = happyShift action_109 action_485 (169) = happyShift action_49 action_485 (177) = happyShift action_50 action_485 (192) = happyShift action_52 action_485 (41) = happyGoto action_487 action_485 (42) = happyGoto action_102 action_485 (113) = happyGoto action_105 action_485 (114) = happyGoto action_106 action_485 (115) = happyGoto action_41 action_485 (132) = happyGoto action_107 action_485 _ = happyFail action_486 _ = happyReduce_119 action_487 _ = happyReduce_123 action_488 _ = happyReduce_43 action_489 _ = happyReduce_45 action_490 (163) = happyShift action_491 action_490 _ = happyFail action_491 (133) = happyShift action_43 action_491 (134) = happyShift action_44 action_491 (135) = happyShift action_45 action_491 (136) = happyShift action_46 action_491 (141) = happyShift action_67 action_491 (142) = happyShift action_68 action_491 (143) = happyShift action_69 action_491 (144) = happyShift action_70 action_491 (145) = happyShift action_71 action_491 (151) = happyShift action_72 action_491 (154) = happyShift action_73 action_491 (160) = happyShift action_125 action_491 (165) = happyShift action_74 action_491 (167) = happyShift action_75 action_491 (169) = happyShift action_49 action_491 (170) = happyShift action_76 action_491 (175) = happyShift action_80 action_491 (177) = happyShift action_50 action_491 (178) = happyShift action_126 action_491 (185) = happyShift action_127 action_491 (192) = happyShift action_52 action_491 (68) = happyGoto action_492 action_491 (69) = happyGoto action_120 action_491 (70) = happyGoto action_121 action_491 (71) = happyGoto action_122 action_491 (72) = happyGoto action_123 action_491 (73) = happyGoto action_57 action_491 (74) = happyGoto action_58 action_491 (77) = happyGoto action_59 action_491 (78) = happyGoto action_60 action_491 (79) = happyGoto action_61 action_491 (98) = happyGoto action_62 action_491 (100) = happyGoto action_124 action_491 (102) = happyGoto action_64 action_491 (112) = happyGoto action_38 action_491 (113) = happyGoto action_39 action_491 (114) = happyGoto action_65 action_491 (115) = happyGoto action_41 action_491 (123) = happyGoto action_66 action_491 _ = happyFail action_492 _ = happyReduce_210 happyReduce_1 = happyReduce 6 4 happyReduction_1 happyReduction_1 ((HappyAbsSyn5 happy_var_6) `HappyStk` _ `HappyStk` (HappyAbsSyn9 happy_var_4) `HappyStk` (HappyAbsSyn127 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn4 (HsModule happy_var_1 happy_var_3 happy_var_4 (fst happy_var_6) (snd happy_var_6) ) `HappyStk` happyRest happyReduce_2 = happySpecReduce_2 4 happyReduction_2 happyReduction_2 (HappyAbsSyn5 happy_var_2) (HappyAbsSyn124 happy_var_1) = HappyAbsSyn4 (HsModule happy_var_1 main_mod (Just [HsEVar (UnQual main_name)]) (fst happy_var_2) (snd happy_var_2) ) happyReduction_2 _ _ = notHappyAtAll happyReduce_3 = happySpecReduce_3 5 happyReduction_3 happyReduction_3 _ (HappyAbsSyn5 happy_var_2) _ = HappyAbsSyn5 (happy_var_2 ) happyReduction_3 _ _ _ = notHappyAtAll happyReduce_4 = happySpecReduce_3 5 happyReduction_4 happyReduction_4 _ (HappyAbsSyn5 happy_var_2) _ = HappyAbsSyn5 (happy_var_2 ) happyReduction_4 _ _ _ = notHappyAtAll happyReduce_5 = happyReduce 4 6 happyReduction_5 happyReduction_5 ((HappyAbsSyn29 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn14 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn5 ((reverse happy_var_2, happy_var_4) ) `HappyStk` happyRest happyReduce_6 = happySpecReduce_2 6 happyReduction_6 happyReduction_6 (HappyAbsSyn29 happy_var_2) _ = HappyAbsSyn5 (([], happy_var_2) ) happyReduction_6 _ _ = notHappyAtAll happyReduce_7 = happySpecReduce_3 6 happyReduction_7 happyReduction_7 _ (HappyAbsSyn14 happy_var_2) _ = HappyAbsSyn5 ((reverse happy_var_2, []) ) happyReduction_7 _ _ _ = notHappyAtAll happyReduce_8 = happySpecReduce_1 6 happyReduction_8 happyReduction_8 _ = HappyAbsSyn5 (([], []) ) happyReduce_9 = happySpecReduce_2 7 happyReduction_9 happyReduction_9 _ _ = HappyAbsSyn7 (() ) happyReduce_10 = happySpecReduce_1 8 happyReduction_10 happyReduction_10 _ = HappyAbsSyn7 (() ) happyReduce_11 = happySpecReduce_0 8 happyReduction_11 happyReduction_11 = HappyAbsSyn7 (() ) happyReduce_12 = happySpecReduce_1 9 happyReduction_12 happyReduction_12 (HappyAbsSyn10 happy_var_1) = HappyAbsSyn9 (Just happy_var_1 ) happyReduction_12 _ = notHappyAtAll happyReduce_13 = happySpecReduce_0 9 happyReduction_13 happyReduction_13 = HappyAbsSyn9 (Nothing ) happyReduce_14 = happyReduce 4 10 happyReduction_14 happyReduction_14 (_ `HappyStk` _ `HappyStk` (HappyAbsSyn10 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn10 (reverse happy_var_2 ) `HappyStk` happyRest happyReduce_15 = happySpecReduce_3 10 happyReduction_15 happyReduction_15 _ _ _ = HappyAbsSyn10 ([] ) happyReduce_16 = happySpecReduce_1 11 happyReduction_16 happyReduction_16 _ = HappyAbsSyn7 (() ) happyReduce_17 = happySpecReduce_0 11 happyReduction_17 happyReduction_17 = HappyAbsSyn7 (() ) happyReduce_18 = happySpecReduce_3 12 happyReduction_18 happyReduction_18 (HappyAbsSyn13 happy_var_3) _ (HappyAbsSyn10 happy_var_1) = HappyAbsSyn10 (happy_var_3 : happy_var_1 ) happyReduction_18 _ _ _ = notHappyAtAll happyReduce_19 = happySpecReduce_1 12 happyReduction_19 happyReduction_19 (HappyAbsSyn13 happy_var_1) = HappyAbsSyn10 ([happy_var_1] ) happyReduction_19 _ = notHappyAtAll happyReduce_20 = happySpecReduce_1 13 happyReduction_20 happyReduction_20 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn13 (HsEVar happy_var_1 ) happyReduction_20 _ = notHappyAtAll happyReduce_21 = happySpecReduce_1 13 happyReduction_21 happyReduction_21 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn13 (HsEAbs happy_var_1 ) happyReduction_21 _ = notHappyAtAll happyReduce_22 = happyReduce 4 13 happyReduction_22 happyReduction_22 (_ `HappyStk` _ `HappyStk` _ `HappyStk` (HappyAbsSyn42 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn13 (HsEThingAll happy_var_1 ) `HappyStk` happyRest happyReduce_23 = happySpecReduce_3 13 happyReduction_23 happyReduction_23 _ _ (HappyAbsSyn42 happy_var_1) = HappyAbsSyn13 (HsEThingWith happy_var_1 [] ) happyReduction_23 _ _ _ = notHappyAtAll happyReduce_24 = happyReduce 4 13 happyReduction_24 happyReduction_24 (_ `HappyStk` (HappyAbsSyn23 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn42 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn13 (HsEThingWith happy_var_1 (reverse happy_var_3) ) `HappyStk` happyRest happyReduce_25 = happySpecReduce_2 13 happyReduction_25 happyReduction_25 (HappyAbsSyn127 happy_var_2) _ = HappyAbsSyn13 (HsEModuleContents happy_var_2 ) happyReduction_25 _ _ = notHappyAtAll happyReduce_26 = happySpecReduce_3 14 happyReduction_26 happyReduction_26 (HappyAbsSyn15 happy_var_3) _ (HappyAbsSyn14 happy_var_1) = HappyAbsSyn14 (happy_var_3 : happy_var_1 ) happyReduction_26 _ _ _ = notHappyAtAll happyReduce_27 = happySpecReduce_1 14 happyReduction_27 happyReduction_27 (HappyAbsSyn15 happy_var_1) = HappyAbsSyn14 ([happy_var_1] ) happyReduction_27 _ = notHappyAtAll happyReduce_28 = happyReduce 6 15 happyReduction_28 happyReduction_28 ((HappyAbsSyn18 happy_var_6) `HappyStk` (HappyAbsSyn17 happy_var_5) `HappyStk` (HappyAbsSyn127 happy_var_4) `HappyStk` (HappyAbsSyn16 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn15 (HsImportDecl happy_var_1 happy_var_4 happy_var_3 happy_var_5 happy_var_6 ) `HappyStk` happyRest happyReduce_29 = happySpecReduce_1 16 happyReduction_29 happyReduction_29 _ = HappyAbsSyn16 (True ) happyReduce_30 = happySpecReduce_0 16 happyReduction_30 happyReduction_30 = HappyAbsSyn16 (False ) happyReduce_31 = happySpecReduce_2 17 happyReduction_31 happyReduction_31 (HappyAbsSyn127 happy_var_2) _ = HappyAbsSyn17 (Just happy_var_2 ) happyReduction_31 _ _ = notHappyAtAll happyReduce_32 = happySpecReduce_0 17 happyReduction_32 happyReduction_32 = HappyAbsSyn17 (Nothing ) happyReduce_33 = happySpecReduce_1 18 happyReduction_33 happyReduction_33 (HappyAbsSyn19 happy_var_1) = HappyAbsSyn18 (Just happy_var_1 ) happyReduction_33 _ = notHappyAtAll happyReduce_34 = happySpecReduce_0 18 happyReduction_34 happyReduction_34 = HappyAbsSyn18 (Nothing ) happyReduce_35 = happyReduce 5 19 happyReduction_35 happyReduction_35 (_ `HappyStk` _ `HappyStk` (HappyAbsSyn21 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn16 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn19 ((happy_var_1, reverse happy_var_3) ) `HappyStk` happyRest happyReduce_36 = happyReduce 4 19 happyReduction_36 happyReduction_36 (_ `HappyStk` _ `HappyStk` _ `HappyStk` (HappyAbsSyn16 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn19 ((happy_var_1, []) ) `HappyStk` happyRest happyReduce_37 = happySpecReduce_1 20 happyReduction_37 happyReduction_37 _ = HappyAbsSyn16 (True ) happyReduce_38 = happySpecReduce_0 20 happyReduction_38 happyReduction_38 = HappyAbsSyn16 (False ) happyReduce_39 = happySpecReduce_3 21 happyReduction_39 happyReduction_39 (HappyAbsSyn22 happy_var_3) _ (HappyAbsSyn21 happy_var_1) = HappyAbsSyn21 (happy_var_3 : happy_var_1 ) happyReduction_39 _ _ _ = notHappyAtAll happyReduce_40 = happySpecReduce_1 21 happyReduction_40 happyReduction_40 (HappyAbsSyn22 happy_var_1) = HappyAbsSyn21 ([happy_var_1] ) happyReduction_40 _ = notHappyAtAll happyReduce_41 = happySpecReduce_1 22 happyReduction_41 happyReduction_41 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn22 (HsIVar happy_var_1 ) happyReduction_41 _ = notHappyAtAll happyReduce_42 = happySpecReduce_1 22 happyReduction_42 happyReduction_42 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn22 (HsIAbs happy_var_1 ) happyReduction_42 _ = notHappyAtAll happyReduce_43 = happyReduce 4 22 happyReduction_43 happyReduction_43 (_ `HappyStk` _ `HappyStk` _ `HappyStk` (HappyAbsSyn99 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn22 (HsIThingAll happy_var_1 ) `HappyStk` happyRest happyReduce_44 = happySpecReduce_3 22 happyReduction_44 happyReduction_44 _ _ (HappyAbsSyn99 happy_var_1) = HappyAbsSyn22 (HsIThingWith happy_var_1 [] ) happyReduction_44 _ _ _ = notHappyAtAll happyReduce_45 = happyReduce 4 22 happyReduction_45 happyReduction_45 (_ `HappyStk` (HappyAbsSyn23 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn99 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn22 (HsIThingWith happy_var_1 (reverse happy_var_3) ) `HappyStk` happyRest happyReduce_46 = happySpecReduce_3 23 happyReduction_46 happyReduction_46 (HappyAbsSyn24 happy_var_3) _ (HappyAbsSyn23 happy_var_1) = HappyAbsSyn23 (happy_var_3 : happy_var_1 ) happyReduction_46 _ _ _ = notHappyAtAll happyReduce_47 = happySpecReduce_1 23 happyReduction_47 happyReduction_47 (HappyAbsSyn24 happy_var_1) = HappyAbsSyn23 ([happy_var_1] ) happyReduction_47 _ = notHappyAtAll happyReduce_48 = happySpecReduce_1 24 happyReduction_48 happyReduction_48 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn24 (HsVarName happy_var_1 ) happyReduction_48 _ = notHappyAtAll happyReduce_49 = happySpecReduce_1 24 happyReduction_49 happyReduction_49 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn24 (HsConName happy_var_1 ) happyReduction_49 _ = notHappyAtAll happyReduce_50 = happyReduce 4 25 happyReduction_50 happyReduction_50 ((HappyAbsSyn28 happy_var_4) `HappyStk` (HappyAbsSyn26 happy_var_3) `HappyStk` (HappyAbsSyn27 happy_var_2) `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn25 (HsInfixDecl happy_var_1 happy_var_2 happy_var_3 (reverse happy_var_4) ) `HappyStk` happyRest happyReduce_51 = happySpecReduce_0 26 happyReduction_51 happyReduction_51 = HappyAbsSyn26 (9 ) happyReduce_52 = happyMonadReduce 1 26 happyReduction_52 happyReduction_52 ((HappyTerminal (IntTok happy_var_1)) `HappyStk` happyRest) = happyThen ( checkPrec happy_var_1 ) (\r -> happyReturn (HappyAbsSyn26 r)) happyReduce_53 = happySpecReduce_1 27 happyReduction_53 happyReduction_53 _ = HappyAbsSyn27 (HsAssocNone ) happyReduce_54 = happySpecReduce_1 27 happyReduction_54 happyReduction_54 _ = HappyAbsSyn27 (HsAssocLeft ) happyReduce_55 = happySpecReduce_1 27 happyReduction_55 happyReduction_55 _ = HappyAbsSyn27 (HsAssocRight ) happyReduce_56 = happySpecReduce_3 28 happyReduction_56 happyReduction_56 (HappyAbsSyn108 happy_var_3) _ (HappyAbsSyn28 happy_var_1) = HappyAbsSyn28 (happy_var_3 : happy_var_1 ) happyReduction_56 _ _ _ = notHappyAtAll happyReduce_57 = happySpecReduce_1 28 happyReduction_57 happyReduction_57 (HappyAbsSyn108 happy_var_1) = HappyAbsSyn28 ([happy_var_1] ) happyReduction_57 _ = notHappyAtAll happyReduce_58 = happyMonadReduce 2 29 happyReduction_58 happyReduction_58 (_ `HappyStk` (HappyAbsSyn29 happy_var_1) `HappyStk` happyRest) = happyThen ( checkRevDecls happy_var_1 ) (\r -> happyReturn (HappyAbsSyn29 r)) happyReduce_59 = happySpecReduce_3 30 happyReduction_59 happyReduction_59 (HappyAbsSyn25 happy_var_3) _ (HappyAbsSyn29 happy_var_1) = HappyAbsSyn29 (happy_var_3 : happy_var_1 ) happyReduction_59 _ _ _ = notHappyAtAll happyReduce_60 = happySpecReduce_1 30 happyReduction_60 happyReduction_60 (HappyAbsSyn25 happy_var_1) = HappyAbsSyn29 ([happy_var_1] ) happyReduction_60 _ = notHappyAtAll happyReduce_61 = happyReduce 5 31 happyReduction_61 happyReduction_61 ((HappyAbsSyn39 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn46 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn25 (HsTypeDecl happy_var_1 (fst happy_var_3) (snd happy_var_3) happy_var_5 ) `HappyStk` happyRest happyReduce_62 = happyMonadReduce 6 31 happyReduction_62 happyReduction_62 ((HappyAbsSyn57 happy_var_6) `HappyStk` (HappyAbsSyn48 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn43 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = happyThen ( do { (cs,c,t) <- checkDataHeader happy_var_3; return (HsDataDecl happy_var_1 cs c t (reverse happy_var_5) happy_var_6) } ) (\r -> happyReturn (HappyAbsSyn25 r)) happyReduce_63 = happyMonadReduce 6 31 happyReduction_63 happyReduction_63 ((HappyAbsSyn57 happy_var_6) `HappyStk` (HappyAbsSyn49 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn43 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = happyThen ( do { (cs,c,t) <- checkDataHeader happy_var_3; return (HsNewTypeDecl happy_var_1 cs c t happy_var_5 happy_var_6) } ) (\r -> happyReturn (HappyAbsSyn25 r)) happyReduce_64 = happyMonadReduce 4 31 happyReduction_64 happyReduction_64 ((HappyAbsSyn29 happy_var_4) `HappyStk` (HappyAbsSyn43 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = happyThen ( do { (cs,c,vs) <- checkClassHeader happy_var_3; return (HsClassDecl happy_var_1 cs c vs happy_var_4) } ) (\r -> happyReturn (HappyAbsSyn25 r)) happyReduce_65 = happyMonadReduce 4 31 happyReduction_65 happyReduction_65 ((HappyAbsSyn29 happy_var_4) `HappyStk` (HappyAbsSyn43 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = happyThen ( do { (cs,c,ts) <- checkInstHeader happy_var_3; return (HsInstDecl happy_var_1 cs c ts happy_var_4) } ) (\r -> happyReturn (HappyAbsSyn25 r)) happyReduce_66 = happyReduce 5 31 happyReduction_66 happyReduction_66 (_ `HappyStk` (HappyAbsSyn32 happy_var_4) `HappyStk` _ `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn25 (HsDefaultDecl happy_var_1 happy_var_4 ) `HappyStk` happyRest happyReduce_67 = happySpecReduce_1 31 happyReduction_67 happyReduction_67 (HappyAbsSyn25 happy_var_1) = HappyAbsSyn25 (happy_var_1 ) happyReduction_67 _ = notHappyAtAll happyReduce_68 = happySpecReduce_1 32 happyReduction_68 happyReduction_68 (HappyAbsSyn32 happy_var_1) = HappyAbsSyn32 (reverse happy_var_1 ) happyReduction_68 _ = notHappyAtAll happyReduce_69 = happySpecReduce_1 32 happyReduction_69 happyReduction_69 (HappyAbsSyn39 happy_var_1) = HappyAbsSyn32 ([happy_var_1] ) happyReduction_69 _ = notHappyAtAll happyReduce_70 = happySpecReduce_0 32 happyReduction_70 happyReduction_70 = HappyAbsSyn32 ([] ) happyReduce_71 = happyMonadReduce 3 33 happyReduction_71 happyReduction_71 (_ `HappyStk` (HappyAbsSyn29 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = happyThen ( checkRevDecls happy_var_2 ) (\r -> happyReturn (HappyAbsSyn29 r)) happyReduce_72 = happySpecReduce_1 33 happyReduction_72 happyReduction_72 _ = HappyAbsSyn29 ([] ) happyReduce_73 = happySpecReduce_3 34 happyReduction_73 happyReduction_73 (HappyAbsSyn25 happy_var_3) _ (HappyAbsSyn29 happy_var_1) = HappyAbsSyn29 (happy_var_3 : happy_var_1 ) happyReduction_73 _ _ _ = notHappyAtAll happyReduce_74 = happySpecReduce_1 34 happyReduction_74 happyReduction_74 (HappyAbsSyn25 happy_var_1) = HappyAbsSyn29 ([happy_var_1] ) happyReduction_74 _ = notHappyAtAll happyReduce_75 = happySpecReduce_1 35 happyReduction_75 happyReduction_75 (HappyAbsSyn25 happy_var_1) = HappyAbsSyn25 (happy_var_1 ) happyReduction_75 _ = notHappyAtAll happyReduce_76 = happySpecReduce_1 35 happyReduction_76 happyReduction_76 (HappyAbsSyn25 happy_var_1) = HappyAbsSyn25 (happy_var_1 ) happyReduction_76 _ = notHappyAtAll happyReduce_77 = happySpecReduce_1 35 happyReduction_77 happyReduction_77 (HappyAbsSyn25 happy_var_1) = HappyAbsSyn25 (happy_var_1 ) happyReduction_77 _ = notHappyAtAll happyReduce_78 = happySpecReduce_3 36 happyReduction_78 happyReduction_78 _ (HappyAbsSyn29 happy_var_2) _ = HappyAbsSyn29 (happy_var_2 ) happyReduction_78 _ _ _ = notHappyAtAll happyReduce_79 = happySpecReduce_3 36 happyReduction_79 happyReduction_79 _ (HappyAbsSyn29 happy_var_2) _ = HappyAbsSyn29 (happy_var_2 ) happyReduction_79 _ _ _ = notHappyAtAll happyReduce_80 = happyReduce 4 37 happyReduction_80 happyReduction_80 ((HappyAbsSyn43 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn38 happy_var_2) `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn25 (HsTypeSig happy_var_1 (reverse happy_var_2) happy_var_4 ) `HappyStk` happyRest happyReduce_81 = happySpecReduce_3 38 happyReduction_81 happyReduction_81 (HappyAbsSyn99 happy_var_3) _ (HappyAbsSyn38 happy_var_1) = HappyAbsSyn38 (happy_var_3 : happy_var_1 ) happyReduction_81 _ _ _ = notHappyAtAll happyReduce_82 = happyMonadReduce 1 38 happyReduction_82 happyReduction_82 ((HappyAbsSyn42 happy_var_1) `HappyStk` happyRest) = happyThen ( do { n <- checkUnQual happy_var_1; return [n] } ) (\r -> happyReturn (HappyAbsSyn38 r)) happyReduce_83 = happySpecReduce_3 39 happyReduction_83 happyReduction_83 (HappyAbsSyn39 happy_var_3) _ (HappyAbsSyn39 happy_var_1) = HappyAbsSyn39 (HsTyFun happy_var_1 happy_var_3 ) happyReduction_83 _ _ _ = notHappyAtAll happyReduce_84 = happySpecReduce_1 39 happyReduction_84 happyReduction_84 (HappyAbsSyn39 happy_var_1) = HappyAbsSyn39 (happy_var_1 ) happyReduction_84 _ = notHappyAtAll happyReduce_85 = happySpecReduce_2 40 happyReduction_85 happyReduction_85 (HappyAbsSyn39 happy_var_2) (HappyAbsSyn39 happy_var_1) = HappyAbsSyn39 (HsTyApp happy_var_1 happy_var_2 ) happyReduction_85 _ _ = notHappyAtAll happyReduce_86 = happySpecReduce_1 40 happyReduction_86 happyReduction_86 (HappyAbsSyn39 happy_var_1) = HappyAbsSyn39 (happy_var_1 ) happyReduction_86 _ = notHappyAtAll happyReduce_87 = happySpecReduce_1 41 happyReduction_87 happyReduction_87 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn39 (HsTyCon happy_var_1 ) happyReduction_87 _ = notHappyAtAll happyReduce_88 = happySpecReduce_1 41 happyReduction_88 happyReduction_88 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn39 (HsTyVar happy_var_1 ) happyReduction_88 _ = notHappyAtAll happyReduce_89 = happySpecReduce_3 41 happyReduction_89 happyReduction_89 _ (HappyAbsSyn32 happy_var_2) _ = HappyAbsSyn39 (HsTyTuple (reverse happy_var_2) ) happyReduction_89 _ _ _ = notHappyAtAll happyReduce_90 = happySpecReduce_3 41 happyReduction_90 happyReduction_90 _ (HappyAbsSyn39 happy_var_2) _ = HappyAbsSyn39 (HsTyApp list_tycon happy_var_2 ) happyReduction_90 _ _ _ = notHappyAtAll happyReduce_91 = happySpecReduce_3 41 happyReduction_91 happyReduction_91 _ (HappyAbsSyn39 happy_var_2) _ = HappyAbsSyn39 (happy_var_2 ) happyReduction_91 _ _ _ = notHappyAtAll happyReduce_92 = happySpecReduce_1 42 happyReduction_92 happyReduction_92 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_92 _ = notHappyAtAll happyReduce_93 = happySpecReduce_2 42 happyReduction_93 happyReduction_93 _ _ = HappyAbsSyn42 (unit_tycon_name ) happyReduce_94 = happySpecReduce_3 42 happyReduction_94 happyReduction_94 _ _ _ = HappyAbsSyn42 (fun_tycon_name ) happyReduce_95 = happySpecReduce_2 42 happyReduction_95 happyReduction_95 _ _ = HappyAbsSyn42 (list_tycon_name ) happyReduce_96 = happySpecReduce_3 42 happyReduction_96 happyReduction_96 _ (HappyAbsSyn26 happy_var_2) _ = HappyAbsSyn42 (tuple_tycon_name happy_var_2 ) happyReduction_96 _ _ _ = notHappyAtAll happyReduce_97 = happySpecReduce_3 43 happyReduction_97 happyReduction_97 (HappyAbsSyn39 happy_var_3) _ (HappyAbsSyn44 happy_var_1) = HappyAbsSyn43 (HsQualType happy_var_1 happy_var_3 ) happyReduction_97 _ _ _ = notHappyAtAll happyReduce_98 = happySpecReduce_1 43 happyReduction_98 happyReduction_98 (HappyAbsSyn39 happy_var_1) = HappyAbsSyn43 (HsQualType [] happy_var_1 ) happyReduction_98 _ = notHappyAtAll happyReduce_99 = happyMonadReduce 1 44 happyReduction_99 happyReduction_99 ((HappyAbsSyn39 happy_var_1) `HappyStk` happyRest) = happyThen ( checkContext happy_var_1 ) (\r -> happyReturn (HappyAbsSyn44 r)) happyReduce_100 = happySpecReduce_3 45 happyReduction_100 happyReduction_100 (HappyAbsSyn39 happy_var_3) _ (HappyAbsSyn32 happy_var_1) = HappyAbsSyn32 (happy_var_3 : happy_var_1 ) happyReduction_100 _ _ _ = notHappyAtAll happyReduce_101 = happySpecReduce_3 45 happyReduction_101 happyReduction_101 (HappyAbsSyn39 happy_var_3) _ (HappyAbsSyn39 happy_var_1) = HappyAbsSyn32 ([happy_var_3, happy_var_1] ) happyReduction_101 _ _ _ = notHappyAtAll happyReduce_102 = happySpecReduce_2 46 happyReduction_102 happyReduction_102 (HappyAbsSyn38 happy_var_2) (HappyAbsSyn99 happy_var_1) = HappyAbsSyn46 ((happy_var_1,reverse happy_var_2) ) happyReduction_102 _ _ = notHappyAtAll happyReduce_103 = happySpecReduce_2 47 happyReduction_103 happyReduction_103 (HappyAbsSyn99 happy_var_2) (HappyAbsSyn38 happy_var_1) = HappyAbsSyn38 (happy_var_2 : happy_var_1 ) happyReduction_103 _ _ = notHappyAtAll happyReduce_104 = happySpecReduce_0 47 happyReduction_104 happyReduction_104 = HappyAbsSyn38 ([] ) happyReduce_105 = happySpecReduce_3 48 happyReduction_105 happyReduction_105 (HappyAbsSyn49 happy_var_3) _ (HappyAbsSyn48 happy_var_1) = HappyAbsSyn48 (happy_var_3 : happy_var_1 ) happyReduction_105 _ _ _ = notHappyAtAll happyReduce_106 = happySpecReduce_1 48 happyReduction_106 happyReduction_106 (HappyAbsSyn49 happy_var_1) = HappyAbsSyn48 ([happy_var_1] ) happyReduction_106 _ = notHappyAtAll happyReduce_107 = happySpecReduce_2 49 happyReduction_107 happyReduction_107 (HappyAbsSyn50 happy_var_2) (HappyAbsSyn124 happy_var_1) = HappyAbsSyn49 (HsConDecl happy_var_1 (fst happy_var_2) (snd happy_var_2) ) happyReduction_107 _ _ = notHappyAtAll happyReduce_108 = happyReduce 4 49 happyReduction_108 happyReduction_108 ((HappyAbsSyn52 happy_var_4) `HappyStk` (HappyAbsSyn99 happy_var_3) `HappyStk` (HappyAbsSyn52 happy_var_2) `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn49 (HsConDecl happy_var_1 happy_var_3 [happy_var_2,happy_var_4] ) `HappyStk` happyRest happyReduce_109 = happyReduce 4 49 happyReduction_109 happyReduction_109 (_ `HappyStk` _ `HappyStk` (HappyAbsSyn99 happy_var_2) `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn49 (HsRecDecl happy_var_1 happy_var_2 [] ) `HappyStk` happyRest happyReduce_110 = happyReduce 5 49 happyReduction_110 happyReduction_110 (_ `HappyStk` (HappyAbsSyn54 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn99 happy_var_2) `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn49 (HsRecDecl happy_var_1 happy_var_2 (reverse happy_var_4) ) `HappyStk` happyRest happyReduce_111 = happyMonadReduce 1 50 happyReduction_111 happyReduction_111 ((HappyAbsSyn39 happy_var_1) `HappyStk` happyRest) = happyThen ( do { (c,ts) <- splitTyConApp happy_var_1; return (c,map HsUnBangedTy ts) } ) (\r -> happyReturn (HappyAbsSyn50 r)) happyReduce_112 = happySpecReduce_1 50 happyReduction_112 happyReduction_112 (HappyAbsSyn50 happy_var_1) = HappyAbsSyn50 (happy_var_1 ) happyReduction_112 _ = notHappyAtAll happyReduce_113 = happyMonadReduce 3 51 happyReduction_113 happyReduction_113 ((HappyAbsSyn39 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn39 happy_var_1) `HappyStk` happyRest) = happyThen ( do { (c,ts) <- splitTyConApp happy_var_1; return (c,map HsUnBangedTy ts++ [HsBangedTy happy_var_3]) } ) (\r -> happyReturn (HappyAbsSyn50 r)) happyReduce_114 = happySpecReduce_2 51 happyReduction_114 happyReduction_114 (HappyAbsSyn52 happy_var_2) (HappyAbsSyn50 happy_var_1) = HappyAbsSyn50 ((fst happy_var_1, snd happy_var_1 ++ [happy_var_2] ) ) happyReduction_114 _ _ = notHappyAtAll happyReduce_115 = happySpecReduce_1 52 happyReduction_115 happyReduction_115 (HappyAbsSyn39 happy_var_1) = HappyAbsSyn52 (HsUnBangedTy happy_var_1 ) happyReduction_115 _ = notHappyAtAll happyReduce_116 = happySpecReduce_2 52 happyReduction_116 happyReduction_116 (HappyAbsSyn39 happy_var_2) _ = HappyAbsSyn52 (HsBangedTy happy_var_2 ) happyReduction_116 _ _ = notHappyAtAll happyReduce_117 = happySpecReduce_1 53 happyReduction_117 happyReduction_117 (HappyAbsSyn39 happy_var_1) = HappyAbsSyn52 (HsUnBangedTy happy_var_1 ) happyReduction_117 _ = notHappyAtAll happyReduce_118 = happySpecReduce_2 53 happyReduction_118 happyReduction_118 (HappyAbsSyn39 happy_var_2) _ = HappyAbsSyn52 (HsBangedTy happy_var_2 ) happyReduction_118 _ _ = notHappyAtAll happyReduce_119 = happySpecReduce_3 54 happyReduction_119 happyReduction_119 (HappyAbsSyn55 happy_var_3) _ (HappyAbsSyn54 happy_var_1) = HappyAbsSyn54 (happy_var_3 : happy_var_1 ) happyReduction_119 _ _ _ = notHappyAtAll happyReduce_120 = happySpecReduce_1 54 happyReduction_120 happyReduction_120 (HappyAbsSyn55 happy_var_1) = HappyAbsSyn54 ([happy_var_1] ) happyReduction_120 _ = notHappyAtAll happyReduce_121 = happySpecReduce_3 55 happyReduction_121 happyReduction_121 (HappyAbsSyn52 happy_var_3) _ (HappyAbsSyn38 happy_var_1) = HappyAbsSyn55 ((reverse happy_var_1, happy_var_3) ) happyReduction_121 _ _ _ = notHappyAtAll happyReduce_122 = happySpecReduce_1 56 happyReduction_122 happyReduction_122 (HappyAbsSyn39 happy_var_1) = HappyAbsSyn52 (HsUnBangedTy happy_var_1 ) happyReduction_122 _ = notHappyAtAll happyReduce_123 = happySpecReduce_2 56 happyReduction_123 happyReduction_123 (HappyAbsSyn39 happy_var_2) _ = HappyAbsSyn52 (HsBangedTy happy_var_2 ) happyReduction_123 _ _ = notHappyAtAll happyReduce_124 = happySpecReduce_0 57 happyReduction_124 happyReduction_124 = HappyAbsSyn57 ([] ) happyReduce_125 = happySpecReduce_2 57 happyReduction_125 happyReduction_125 (HappyAbsSyn42 happy_var_2) _ = HappyAbsSyn57 ([happy_var_2] ) happyReduction_125 _ _ = notHappyAtAll happyReduce_126 = happySpecReduce_3 57 happyReduction_126 happyReduction_126 _ _ _ = HappyAbsSyn57 ([] ) happyReduce_127 = happyReduce 4 57 happyReduction_127 happyReduction_127 (_ `HappyStk` (HappyAbsSyn57 happy_var_3) `HappyStk` _ `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn57 (reverse happy_var_3 ) `HappyStk` happyRest happyReduce_128 = happySpecReduce_3 58 happyReduction_128 happyReduction_128 (HappyAbsSyn42 happy_var_3) _ (HappyAbsSyn57 happy_var_1) = HappyAbsSyn57 (happy_var_3 : happy_var_1 ) happyReduction_128 _ _ _ = notHappyAtAll happyReduce_129 = happySpecReduce_1 58 happyReduction_129 happyReduction_129 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn57 ([happy_var_1] ) happyReduction_129 _ = notHappyAtAll happyReduce_130 = happyMonadReduce 2 59 happyReduction_130 happyReduction_130 ((HappyAbsSyn29 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = happyThen ( checkClassBody happy_var_2 ) (\r -> happyReturn (HappyAbsSyn29 r)) happyReduce_131 = happySpecReduce_0 59 happyReduction_131 happyReduction_131 = HappyAbsSyn29 ([] ) happyReduce_132 = happyMonadReduce 4 60 happyReduction_132 happyReduction_132 (_ `HappyStk` (HappyAbsSyn29 happy_var_3) `HappyStk` _ `HappyStk` _ `HappyStk` happyRest) = happyThen ( checkClassBody happy_var_3 ) (\r -> happyReturn (HappyAbsSyn29 r)) happyReduce_133 = happyMonadReduce 4 60 happyReduction_133 happyReduction_133 (_ `HappyStk` (HappyAbsSyn29 happy_var_3) `HappyStk` _ `HappyStk` _ `HappyStk` happyRest) = happyThen ( checkClassBody happy_var_3 ) (\r -> happyReturn (HappyAbsSyn29 r)) happyReduce_134 = happySpecReduce_0 60 happyReduction_134 happyReduction_134 = HappyAbsSyn29 ([] ) happyReduce_135 = happyMonadReduce 3 61 happyReduction_135 happyReduction_135 (_ `HappyStk` (HappyAbsSyn29 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = happyThen ( checkRevDecls happy_var_2 ) (\r -> happyReturn (HappyAbsSyn29 r)) happyReduce_136 = happySpecReduce_1 61 happyReduction_136 happyReduction_136 _ = HappyAbsSyn29 ([] ) happyReduce_137 = happySpecReduce_3 62 happyReduction_137 happyReduction_137 (HappyAbsSyn25 happy_var_3) _ (HappyAbsSyn29 happy_var_1) = HappyAbsSyn29 (happy_var_3 : happy_var_1 ) happyReduction_137 _ _ _ = notHappyAtAll happyReduce_138 = happySpecReduce_1 62 happyReduction_138 happyReduction_138 (HappyAbsSyn25 happy_var_1) = HappyAbsSyn29 ([happy_var_1] ) happyReduction_138 _ = notHappyAtAll happyReduce_139 = happyMonadReduce 4 63 happyReduction_139 happyReduction_139 ((HappyAbsSyn29 happy_var_4) `HappyStk` (HappyAbsSyn65 happy_var_3) `HappyStk` (HappyAbsSyn68 happy_var_2) `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = happyThen ( checkValDef happy_var_1 happy_var_2 happy_var_3 happy_var_4 ) (\r -> happyReturn (HappyAbsSyn25 r)) happyReduce_140 = happySpecReduce_2 64 happyReduction_140 happyReduction_140 (HappyAbsSyn29 happy_var_2) _ = HappyAbsSyn29 (happy_var_2 ) happyReduction_140 _ _ = notHappyAtAll happyReduce_141 = happySpecReduce_0 64 happyReduction_141 happyReduction_141 = HappyAbsSyn29 ([] ) happyReduce_142 = happyMonadReduce 2 65 happyReduction_142 happyReduction_142 ((HappyAbsSyn68 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = happyThen ( do { e <- checkExpr happy_var_2; return (HsUnGuardedRhs e) } ) (\r -> happyReturn (HappyAbsSyn65 r)) happyReduce_143 = happySpecReduce_1 65 happyReduction_143 happyReduction_143 (HappyAbsSyn66 happy_var_1) = HappyAbsSyn65 (HsGuardedRhss (reverse happy_var_1) ) happyReduction_143 _ = notHappyAtAll happyReduce_144 = happySpecReduce_2 66 happyReduction_144 happyReduction_144 (HappyAbsSyn67 happy_var_2) (HappyAbsSyn66 happy_var_1) = HappyAbsSyn66 (happy_var_2 : happy_var_1 ) happyReduction_144 _ _ = notHappyAtAll happyReduce_145 = happySpecReduce_1 66 happyReduction_145 happyReduction_145 (HappyAbsSyn67 happy_var_1) = HappyAbsSyn66 ([happy_var_1] ) happyReduction_145 _ = notHappyAtAll happyReduce_146 = happyMonadReduce 5 67 happyReduction_146 happyReduction_146 ((HappyAbsSyn68 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = happyThen ( do { g <- checkExpr happy_var_3; e <- checkExpr happy_var_5; return (HsGuardedRhs happy_var_1 g e) } ) (\r -> happyReturn (HappyAbsSyn67 r)) happyReduce_147 = happyReduce 4 68 happyReduction_147 happyReduction_147 ((HappyAbsSyn43 happy_var_4) `HappyStk` (HappyAbsSyn124 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn68 (HsExpTypeSig happy_var_3 happy_var_1 happy_var_4 ) `HappyStk` happyRest happyReduce_148 = happySpecReduce_1 68 happyReduction_148 happyReduction_148 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_148 _ = notHappyAtAll happyReduce_149 = happySpecReduce_1 69 happyReduction_149 happyReduction_149 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_149 _ = notHappyAtAll happyReduce_150 = happySpecReduce_1 69 happyReduction_150 happyReduction_150 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_150 _ = notHappyAtAll happyReduce_151 = happySpecReduce_3 70 happyReduction_151 happyReduction_151 (HappyAbsSyn68 happy_var_3) (HappyAbsSyn109 happy_var_2) (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (HsInfixApp happy_var_1 happy_var_2 happy_var_3 ) happyReduction_151 _ _ _ = notHappyAtAll happyReduce_152 = happySpecReduce_1 70 happyReduction_152 happyReduction_152 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_152 _ = notHappyAtAll happyReduce_153 = happySpecReduce_3 71 happyReduction_153 happyReduction_153 (HappyAbsSyn68 happy_var_3) (HappyAbsSyn109 happy_var_2) (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (HsInfixApp happy_var_1 happy_var_2 happy_var_3 ) happyReduction_153 _ _ _ = notHappyAtAll happyReduce_154 = happySpecReduce_1 71 happyReduction_154 happyReduction_154 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_154 _ = notHappyAtAll happyReduce_155 = happyReduce 5 72 happyReduction_155 happyReduction_155 ((HappyAbsSyn68 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn75 happy_var_3) `HappyStk` (HappyAbsSyn124 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn68 (HsLambda happy_var_2 (reverse happy_var_3) happy_var_5 ) `HappyStk` happyRest happyReduce_156 = happyReduce 4 72 happyReduction_156 happyReduction_156 ((HappyAbsSyn68 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn29 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn68 (HsLet happy_var_2 happy_var_4 ) `HappyStk` happyRest happyReduce_157 = happyReduce 6 72 happyReduction_157 happyReduction_157 ((HappyAbsSyn68 happy_var_6) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn68 (HsIf happy_var_2 happy_var_4 happy_var_6 ) `HappyStk` happyRest happyReduce_158 = happyReduce 4 73 happyReduction_158 happyReduction_158 ((HappyAbsSyn86 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn68 (HsCase happy_var_2 happy_var_4 ) `HappyStk` happyRest happyReduce_159 = happySpecReduce_2 73 happyReduction_159 happyReduction_159 (HappyAbsSyn68 happy_var_2) _ = HappyAbsSyn68 (HsNegApp happy_var_2 ) happyReduction_159 _ _ = notHappyAtAll happyReduce_160 = happySpecReduce_2 73 happyReduction_160 happyReduction_160 (HappyAbsSyn84 happy_var_2) _ = HappyAbsSyn68 (HsDo happy_var_2 ) happyReduction_160 _ _ = notHappyAtAll happyReduce_161 = happySpecReduce_1 73 happyReduction_161 happyReduction_161 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_161 _ = notHappyAtAll happyReduce_162 = happySpecReduce_2 74 happyReduction_162 happyReduction_162 (HappyAbsSyn68 happy_var_2) (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (HsApp happy_var_1 happy_var_2 ) happyReduction_162 _ _ = notHappyAtAll happyReduce_163 = happySpecReduce_1 74 happyReduction_163 happyReduction_163 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_163 _ = notHappyAtAll happyReduce_164 = happySpecReduce_2 75 happyReduction_164 happyReduction_164 (HappyAbsSyn76 happy_var_2) (HappyAbsSyn75 happy_var_1) = HappyAbsSyn75 (happy_var_2 : happy_var_1 ) happyReduction_164 _ _ = notHappyAtAll happyReduce_165 = happySpecReduce_1 75 happyReduction_165 happyReduction_165 (HappyAbsSyn76 happy_var_1) = HappyAbsSyn75 ([happy_var_1] ) happyReduction_165 _ = notHappyAtAll happyReduce_166 = happyMonadReduce 1 76 happyReduction_166 happyReduction_166 ((HappyAbsSyn68 happy_var_1) `HappyStk` happyRest) = happyThen ( checkPattern happy_var_1 ) (\r -> happyReturn (HappyAbsSyn76 r)) happyReduce_167 = happyMonadReduce 3 77 happyReduction_167 happyReduction_167 ((HappyAbsSyn68 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn42 happy_var_1) `HappyStk` happyRest) = happyThen ( do { n <- checkUnQual happy_var_1; return (HsAsPat n happy_var_3) } ) (\r -> happyReturn (HappyAbsSyn68 r)) happyReduce_168 = happySpecReduce_2 77 happyReduction_168 happyReduction_168 (HappyAbsSyn68 happy_var_2) _ = HappyAbsSyn68 (HsIrrPat happy_var_2 ) happyReduction_168 _ _ = notHappyAtAll happyReduce_169 = happySpecReduce_1 77 happyReduction_169 happyReduction_169 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_169 _ = notHappyAtAll happyReduce_170 = happyMonadReduce 3 78 happyReduction_170 happyReduction_170 (_ `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_1) `HappyStk` happyRest) = happyThen ( mkRecConstrOrUpdate happy_var_1 [] ) (\r -> happyReturn (HappyAbsSyn68 r)) happyReduce_171 = happyMonadReduce 4 78 happyReduction_171 happyReduction_171 (_ `HappyStk` (HappyAbsSyn96 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_1) `HappyStk` happyRest) = happyThen ( mkRecConstrOrUpdate happy_var_1 (reverse happy_var_3) ) (\r -> happyReturn (HappyAbsSyn68 r)) happyReduce_172 = happySpecReduce_1 78 happyReduction_172 happyReduction_172 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_172 _ = notHappyAtAll happyReduce_173 = happySpecReduce_1 79 happyReduction_173 happyReduction_173 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn68 (HsVar happy_var_1 ) happyReduction_173 _ = notHappyAtAll happyReduce_174 = happySpecReduce_1 79 happyReduction_174 happyReduction_174 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (happy_var_1 ) happyReduction_174 _ = notHappyAtAll happyReduce_175 = happySpecReduce_1 79 happyReduction_175 happyReduction_175 (HappyAbsSyn123 happy_var_1) = HappyAbsSyn68 (HsLit happy_var_1 ) happyReduction_175 _ = notHappyAtAll happyReduce_176 = happySpecReduce_3 79 happyReduction_176 happyReduction_176 _ (HappyAbsSyn68 happy_var_2) _ = HappyAbsSyn68 (HsParen happy_var_2 ) happyReduction_176 _ _ _ = notHappyAtAll happyReduce_177 = happySpecReduce_3 79 happyReduction_177 happyReduction_177 _ (HappyAbsSyn81 happy_var_2) _ = HappyAbsSyn68 (HsTuple (reverse happy_var_2) ) happyReduction_177 _ _ _ = notHappyAtAll happyReduce_178 = happySpecReduce_3 79 happyReduction_178 happyReduction_178 _ (HappyAbsSyn68 happy_var_2) _ = HappyAbsSyn68 (happy_var_2 ) happyReduction_178 _ _ _ = notHappyAtAll happyReduce_179 = happyReduce 4 79 happyReduction_179 happyReduction_179 (_ `HappyStk` (HappyAbsSyn109 happy_var_3) `HappyStk` (HappyAbsSyn68 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn68 (HsLeftSection happy_var_2 happy_var_3 ) `HappyStk` happyRest happyReduce_180 = happyReduce 4 79 happyReduction_180 happyReduction_180 (_ `HappyStk` (HappyAbsSyn68 happy_var_3) `HappyStk` (HappyAbsSyn109 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn68 (HsRightSection happy_var_2 happy_var_3 ) `HappyStk` happyRest happyReduce_181 = happySpecReduce_1 79 happyReduction_181 happyReduction_181 _ = HappyAbsSyn68 (HsWildCard ) happyReduce_182 = happySpecReduce_2 80 happyReduction_182 happyReduction_182 _ (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 + 1 ) happyReduction_182 _ _ = notHappyAtAll happyReduce_183 = happySpecReduce_1 80 happyReduction_183 happyReduction_183 _ = HappyAbsSyn26 (1 ) happyReduce_184 = happySpecReduce_3 81 happyReduction_184 happyReduction_184 (HappyAbsSyn68 happy_var_3) _ (HappyAbsSyn81 happy_var_1) = HappyAbsSyn81 (happy_var_3 : happy_var_1 ) happyReduction_184 _ _ _ = notHappyAtAll happyReduce_185 = happySpecReduce_3 81 happyReduction_185 happyReduction_185 (HappyAbsSyn68 happy_var_3) _ (HappyAbsSyn68 happy_var_1) = HappyAbsSyn81 ([happy_var_3,happy_var_1] ) happyReduction_185 _ _ _ = notHappyAtAll happyReduce_186 = happySpecReduce_1 82 happyReduction_186 happyReduction_186 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (HsList [happy_var_1] ) happyReduction_186 _ = notHappyAtAll happyReduce_187 = happySpecReduce_1 82 happyReduction_187 happyReduction_187 (HappyAbsSyn81 happy_var_1) = HappyAbsSyn68 (HsList (reverse happy_var_1) ) happyReduction_187 _ = notHappyAtAll happyReduce_188 = happySpecReduce_2 82 happyReduction_188 happyReduction_188 _ (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (HsEnumFrom happy_var_1 ) happyReduction_188 _ _ = notHappyAtAll happyReduce_189 = happyReduce 4 82 happyReduction_189 happyReduction_189 (_ `HappyStk` (HappyAbsSyn68 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn68 (HsEnumFromThen happy_var_1 happy_var_3 ) `HappyStk` happyRest happyReduce_190 = happySpecReduce_3 82 happyReduction_190 happyReduction_190 (HappyAbsSyn68 happy_var_3) _ (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (HsEnumFromTo happy_var_1 happy_var_3 ) happyReduction_190 _ _ _ = notHappyAtAll happyReduce_191 = happyReduce 5 82 happyReduction_191 happyReduction_191 ((HappyAbsSyn68 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn68 (HsEnumFromThenTo happy_var_1 happy_var_3 happy_var_5 ) `HappyStk` happyRest happyReduce_192 = happySpecReduce_3 82 happyReduction_192 happyReduction_192 (HappyAbsSyn84 happy_var_3) _ (HappyAbsSyn68 happy_var_1) = HappyAbsSyn68 (HsListComp happy_var_1 (reverse happy_var_3) ) happyReduction_192 _ _ _ = notHappyAtAll happyReduce_193 = happySpecReduce_3 83 happyReduction_193 happyReduction_193 (HappyAbsSyn68 happy_var_3) _ (HappyAbsSyn81 happy_var_1) = HappyAbsSyn81 (happy_var_3 : happy_var_1 ) happyReduction_193 _ _ _ = notHappyAtAll happyReduce_194 = happySpecReduce_3 83 happyReduction_194 happyReduction_194 (HappyAbsSyn68 happy_var_3) _ (HappyAbsSyn68 happy_var_1) = HappyAbsSyn81 ([happy_var_3,happy_var_1] ) happyReduction_194 _ _ _ = notHappyAtAll happyReduce_195 = happySpecReduce_3 84 happyReduction_195 happyReduction_195 (HappyAbsSyn85 happy_var_3) _ (HappyAbsSyn84 happy_var_1) = HappyAbsSyn84 (happy_var_3 : happy_var_1 ) happyReduction_195 _ _ _ = notHappyAtAll happyReduce_196 = happySpecReduce_1 84 happyReduction_196 happyReduction_196 (HappyAbsSyn85 happy_var_1) = HappyAbsSyn84 ([happy_var_1] ) happyReduction_196 _ = notHappyAtAll happyReduce_197 = happyReduce 4 85 happyReduction_197 happyReduction_197 ((HappyAbsSyn68 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_2) `HappyStk` (HappyAbsSyn76 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn85 (HsGenerator happy_var_2 happy_var_1 happy_var_4 ) `HappyStk` happyRest happyReduce_198 = happySpecReduce_1 85 happyReduction_198 happyReduction_198 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn85 (HsQualifier happy_var_1 ) happyReduction_198 _ = notHappyAtAll happyReduce_199 = happySpecReduce_2 85 happyReduction_199 happyReduction_199 (HappyAbsSyn29 happy_var_2) _ = HappyAbsSyn85 (HsLetStmt happy_var_2 ) happyReduction_199 _ _ = notHappyAtAll happyReduce_200 = happySpecReduce_3 86 happyReduction_200 happyReduction_200 _ (HappyAbsSyn86 happy_var_2) _ = HappyAbsSyn86 (happy_var_2 ) happyReduction_200 _ _ _ = notHappyAtAll happyReduce_201 = happySpecReduce_3 86 happyReduction_201 happyReduction_201 _ (HappyAbsSyn86 happy_var_2) _ = HappyAbsSyn86 (happy_var_2 ) happyReduction_201 _ _ _ = notHappyAtAll happyReduce_202 = happySpecReduce_3 87 happyReduction_202 happyReduction_202 _ (HappyAbsSyn86 happy_var_2) _ = HappyAbsSyn86 (reverse happy_var_2 ) happyReduction_202 _ _ _ = notHappyAtAll happyReduce_203 = happySpecReduce_3 88 happyReduction_203 happyReduction_203 (HappyAbsSyn89 happy_var_3) _ (HappyAbsSyn86 happy_var_1) = HappyAbsSyn86 (happy_var_3 : happy_var_1 ) happyReduction_203 _ _ _ = notHappyAtAll happyReduce_204 = happySpecReduce_1 88 happyReduction_204 happyReduction_204 (HappyAbsSyn89 happy_var_1) = HappyAbsSyn86 ([happy_var_1] ) happyReduction_204 _ = notHappyAtAll happyReduce_205 = happyReduce 4 89 happyReduction_205 happyReduction_205 ((HappyAbsSyn29 happy_var_4) `HappyStk` (HappyAbsSyn90 happy_var_3) `HappyStk` (HappyAbsSyn76 happy_var_2) `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn89 (HsAlt happy_var_1 happy_var_2 happy_var_3 happy_var_4 ) `HappyStk` happyRest happyReduce_206 = happySpecReduce_2 90 happyReduction_206 happyReduction_206 (HappyAbsSyn68 happy_var_2) _ = HappyAbsSyn90 (HsUnGuardedAlt happy_var_2 ) happyReduction_206 _ _ = notHappyAtAll happyReduce_207 = happySpecReduce_1 90 happyReduction_207 happyReduction_207 (HappyAbsSyn91 happy_var_1) = HappyAbsSyn90 (HsGuardedAlts (reverse happy_var_1) ) happyReduction_207 _ = notHappyAtAll happyReduce_208 = happySpecReduce_2 91 happyReduction_208 happyReduction_208 (HappyAbsSyn92 happy_var_2) (HappyAbsSyn91 happy_var_1) = HappyAbsSyn91 (happy_var_2 : happy_var_1 ) happyReduction_208 _ _ = notHappyAtAll happyReduce_209 = happySpecReduce_1 91 happyReduction_209 happyReduction_209 (HappyAbsSyn92 happy_var_1) = HappyAbsSyn91 ([happy_var_1] ) happyReduction_209 _ = notHappyAtAll happyReduce_210 = happyReduce 5 92 happyReduction_210 happyReduction_210 ((HappyAbsSyn68 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn92 (HsGuardedAlt happy_var_1 happy_var_3 happy_var_5 ) `HappyStk` happyRest happyReduce_211 = happyMonadReduce 1 93 happyReduction_211 happyReduction_211 ((HappyAbsSyn68 happy_var_1) `HappyStk` happyRest) = happyThen ( checkPattern happy_var_1 ) (\r -> happyReturn (HappyAbsSyn76 r)) happyReduce_212 = happySpecReduce_3 94 happyReduction_212 happyReduction_212 _ (HappyAbsSyn84 happy_var_2) _ = HappyAbsSyn84 (happy_var_2 ) happyReduction_212 _ _ _ = notHappyAtAll happyReduce_213 = happySpecReduce_3 94 happyReduction_213 happyReduction_213 _ (HappyAbsSyn84 happy_var_2) _ = HappyAbsSyn84 (happy_var_2 ) happyReduction_213 _ _ _ = notHappyAtAll happyReduce_214 = happyReduce 4 95 happyReduction_214 happyReduction_214 ((HappyAbsSyn84 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn29 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn84 (HsLetStmt happy_var_2 : happy_var_4 ) `HappyStk` happyRest happyReduce_215 = happyReduce 6 95 happyReduction_215 happyReduction_215 ((HappyAbsSyn84 happy_var_6) `HappyStk` _ `HappyStk` (HappyAbsSyn68 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn124 happy_var_2) `HappyStk` (HappyAbsSyn76 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn84 (HsGenerator happy_var_2 happy_var_1 happy_var_4 : happy_var_6 ) `HappyStk` happyRest happyReduce_216 = happySpecReduce_3 95 happyReduction_216 happyReduction_216 (HappyAbsSyn84 happy_var_3) _ (HappyAbsSyn68 happy_var_1) = HappyAbsSyn84 (HsQualifier happy_var_1 : happy_var_3 ) happyReduction_216 _ _ _ = notHappyAtAll happyReduce_217 = happySpecReduce_2 95 happyReduction_217 happyReduction_217 (HappyAbsSyn84 happy_var_2) _ = HappyAbsSyn84 (happy_var_2 ) happyReduction_217 _ _ = notHappyAtAll happyReduce_218 = happySpecReduce_2 95 happyReduction_218 happyReduction_218 _ (HappyAbsSyn68 happy_var_1) = HappyAbsSyn84 ([HsQualifier happy_var_1] ) happyReduction_218 _ _ = notHappyAtAll happyReduce_219 = happySpecReduce_1 95 happyReduction_219 happyReduction_219 (HappyAbsSyn68 happy_var_1) = HappyAbsSyn84 ([HsQualifier happy_var_1] ) happyReduction_219 _ = notHappyAtAll happyReduce_220 = happySpecReduce_3 96 happyReduction_220 happyReduction_220 (HappyAbsSyn97 happy_var_3) _ (HappyAbsSyn96 happy_var_1) = HappyAbsSyn96 (happy_var_3 : happy_var_1 ) happyReduction_220 _ _ _ = notHappyAtAll happyReduce_221 = happySpecReduce_1 96 happyReduction_221 happyReduction_221 (HappyAbsSyn97 happy_var_1) = HappyAbsSyn96 ([happy_var_1] ) happyReduction_221 _ = notHappyAtAll happyReduce_222 = happySpecReduce_3 97 happyReduction_222 happyReduction_222 (HappyAbsSyn68 happy_var_3) _ (HappyAbsSyn42 happy_var_1) = HappyAbsSyn97 (HsFieldUpdate happy_var_1 happy_var_3 ) happyReduction_222 _ _ _ = notHappyAtAll happyReduce_223 = happySpecReduce_2 98 happyReduction_223 happyReduction_223 _ _ = HappyAbsSyn68 (unit_con ) happyReduce_224 = happySpecReduce_2 98 happyReduction_224 happyReduction_224 _ _ = HappyAbsSyn68 (HsList [] ) happyReduce_225 = happySpecReduce_3 98 happyReduction_225 happyReduction_225 _ (HappyAbsSyn26 happy_var_2) _ = HappyAbsSyn68 (tuple_con happy_var_2 ) happyReduction_225 _ _ _ = notHappyAtAll happyReduce_226 = happySpecReduce_1 98 happyReduction_226 happyReduction_226 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn68 (HsCon happy_var_1 ) happyReduction_226 _ = notHappyAtAll happyReduce_227 = happySpecReduce_1 99 happyReduction_227 happyReduction_227 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn99 (happy_var_1 ) happyReduction_227 _ = notHappyAtAll happyReduce_228 = happySpecReduce_3 99 happyReduction_228 happyReduction_228 _ (HappyAbsSyn99 happy_var_2) _ = HappyAbsSyn99 (happy_var_2 ) happyReduction_228 _ _ _ = notHappyAtAll happyReduce_229 = happySpecReduce_1 100 happyReduction_229 happyReduction_229 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_229 _ = notHappyAtAll happyReduce_230 = happySpecReduce_3 100 happyReduction_230 happyReduction_230 _ (HappyAbsSyn42 happy_var_2) _ = HappyAbsSyn42 (happy_var_2 ) happyReduction_230 _ _ _ = notHappyAtAll happyReduce_231 = happySpecReduce_1 101 happyReduction_231 happyReduction_231 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn99 (happy_var_1 ) happyReduction_231 _ = notHappyAtAll happyReduce_232 = happySpecReduce_3 101 happyReduction_232 happyReduction_232 _ (HappyAbsSyn99 happy_var_2) _ = HappyAbsSyn99 (happy_var_2 ) happyReduction_232 _ _ _ = notHappyAtAll happyReduce_233 = happySpecReduce_1 102 happyReduction_233 happyReduction_233 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_233 _ = notHappyAtAll happyReduce_234 = happySpecReduce_3 102 happyReduction_234 happyReduction_234 _ (HappyAbsSyn42 happy_var_2) _ = HappyAbsSyn42 (happy_var_2 ) happyReduction_234 _ _ _ = notHappyAtAll happyReduce_235 = happySpecReduce_1 103 happyReduction_235 happyReduction_235 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn99 (happy_var_1 ) happyReduction_235 _ = notHappyAtAll happyReduce_236 = happySpecReduce_3 103 happyReduction_236 happyReduction_236 _ (HappyAbsSyn99 happy_var_2) _ = HappyAbsSyn99 (happy_var_2 ) happyReduction_236 _ _ _ = notHappyAtAll happyReduce_237 = happySpecReduce_1 104 happyReduction_237 happyReduction_237 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_237 _ = notHappyAtAll happyReduce_238 = happySpecReduce_3 104 happyReduction_238 happyReduction_238 _ (HappyAbsSyn42 happy_var_2) _ = HappyAbsSyn42 (happy_var_2 ) happyReduction_238 _ _ _ = notHappyAtAll happyReduce_239 = happySpecReduce_1 105 happyReduction_239 happyReduction_239 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_239 _ = notHappyAtAll happyReduce_240 = happySpecReduce_3 105 happyReduction_240 happyReduction_240 _ (HappyAbsSyn42 happy_var_2) _ = HappyAbsSyn42 (happy_var_2 ) happyReduction_240 _ _ _ = notHappyAtAll happyReduce_241 = happySpecReduce_1 106 happyReduction_241 happyReduction_241 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn99 (happy_var_1 ) happyReduction_241 _ = notHappyAtAll happyReduce_242 = happySpecReduce_3 106 happyReduction_242 happyReduction_242 _ (HappyAbsSyn99 happy_var_2) _ = HappyAbsSyn99 (happy_var_2 ) happyReduction_242 _ _ _ = notHappyAtAll happyReduce_243 = happySpecReduce_1 107 happyReduction_243 happyReduction_243 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_243 _ = notHappyAtAll happyReduce_244 = happySpecReduce_3 107 happyReduction_244 happyReduction_244 _ (HappyAbsSyn42 happy_var_2) _ = HappyAbsSyn42 (happy_var_2 ) happyReduction_244 _ _ _ = notHappyAtAll happyReduce_245 = happySpecReduce_1 108 happyReduction_245 happyReduction_245 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn108 (HsVarOp happy_var_1 ) happyReduction_245 _ = notHappyAtAll happyReduce_246 = happySpecReduce_1 108 happyReduction_246 happyReduction_246 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn108 (HsConOp happy_var_1 ) happyReduction_246 _ = notHappyAtAll happyReduce_247 = happySpecReduce_1 109 happyReduction_247 happyReduction_247 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn109 (HsQVarOp happy_var_1 ) happyReduction_247 _ = notHappyAtAll happyReduce_248 = happySpecReduce_1 109 happyReduction_248 happyReduction_248 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn109 (HsQConOp happy_var_1 ) happyReduction_248 _ = notHappyAtAll happyReduce_249 = happySpecReduce_1 110 happyReduction_249 happyReduction_249 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn109 (HsQVarOp happy_var_1 ) happyReduction_249 _ = notHappyAtAll happyReduce_250 = happySpecReduce_1 110 happyReduction_250 happyReduction_250 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn109 (HsQConOp happy_var_1 ) happyReduction_250 _ = notHappyAtAll happyReduce_251 = happySpecReduce_1 111 happyReduction_251 happyReduction_251 _ = HappyAbsSyn42 (list_cons_name ) happyReduce_252 = happySpecReduce_1 111 happyReduction_252 happyReduction_252 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_252 _ = notHappyAtAll happyReduce_253 = happySpecReduce_1 112 happyReduction_253 happyReduction_253 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn42 (UnQual happy_var_1 ) happyReduction_253 _ = notHappyAtAll happyReduce_254 = happySpecReduce_1 112 happyReduction_254 happyReduction_254 (HappyTerminal (QVarId happy_var_1)) = HappyAbsSyn42 (Qual (Module (fst happy_var_1)) (HsIdent (snd happy_var_1)) ) happyReduction_254 _ = notHappyAtAll happyReduce_255 = happySpecReduce_1 113 happyReduction_255 happyReduction_255 (HappyTerminal (VarId happy_var_1)) = HappyAbsSyn99 (HsIdent happy_var_1 ) happyReduction_255 _ = notHappyAtAll happyReduce_256 = happySpecReduce_1 113 happyReduction_256 happyReduction_256 _ = HappyAbsSyn99 (as_name ) happyReduce_257 = happySpecReduce_1 113 happyReduction_257 happyReduction_257 _ = HappyAbsSyn99 (qualified_name ) happyReduce_258 = happySpecReduce_1 113 happyReduction_258 happyReduction_258 _ = HappyAbsSyn99 (hiding_name ) happyReduce_259 = happySpecReduce_1 114 happyReduction_259 happyReduction_259 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn42 (UnQual happy_var_1 ) happyReduction_259 _ = notHappyAtAll happyReduce_260 = happySpecReduce_1 114 happyReduction_260 happyReduction_260 (HappyTerminal (QConId happy_var_1)) = HappyAbsSyn42 (Qual (Module (fst happy_var_1)) (HsIdent (snd happy_var_1)) ) happyReduction_260 _ = notHappyAtAll happyReduce_261 = happySpecReduce_1 115 happyReduction_261 happyReduction_261 (HappyTerminal (ConId happy_var_1)) = HappyAbsSyn99 (HsIdent happy_var_1 ) happyReduction_261 _ = notHappyAtAll happyReduce_262 = happySpecReduce_1 116 happyReduction_262 happyReduction_262 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn42 (UnQual happy_var_1 ) happyReduction_262 _ = notHappyAtAll happyReduce_263 = happySpecReduce_1 116 happyReduction_263 happyReduction_263 (HappyTerminal (QConSym happy_var_1)) = HappyAbsSyn42 (Qual (Module (fst happy_var_1)) (HsSymbol (snd happy_var_1)) ) happyReduction_263 _ = notHappyAtAll happyReduce_264 = happySpecReduce_1 117 happyReduction_264 happyReduction_264 (HappyTerminal (ConSym happy_var_1)) = HappyAbsSyn99 (HsSymbol happy_var_1 ) happyReduction_264 _ = notHappyAtAll happyReduce_265 = happySpecReduce_1 118 happyReduction_265 happyReduction_265 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn42 (UnQual happy_var_1 ) happyReduction_265 _ = notHappyAtAll happyReduce_266 = happySpecReduce_1 118 happyReduction_266 happyReduction_266 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_266 _ = notHappyAtAll happyReduce_267 = happySpecReduce_1 119 happyReduction_267 happyReduction_267 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn42 (UnQual happy_var_1 ) happyReduction_267 _ = notHappyAtAll happyReduce_268 = happySpecReduce_1 119 happyReduction_268 happyReduction_268 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_268 _ = notHappyAtAll happyReduce_269 = happySpecReduce_1 120 happyReduction_269 happyReduction_269 (HappyTerminal (VarSym happy_var_1)) = HappyAbsSyn99 (HsSymbol happy_var_1 ) happyReduction_269 _ = notHappyAtAll happyReduce_270 = happySpecReduce_1 120 happyReduction_270 happyReduction_270 _ = HappyAbsSyn99 (minus_name ) happyReduce_271 = happySpecReduce_1 120 happyReduction_271 happyReduction_271 _ = HappyAbsSyn99 (pling_name ) happyReduce_272 = happySpecReduce_1 121 happyReduction_272 happyReduction_272 (HappyTerminal (VarSym happy_var_1)) = HappyAbsSyn99 (HsSymbol happy_var_1 ) happyReduction_272 _ = notHappyAtAll happyReduce_273 = happySpecReduce_1 121 happyReduction_273 happyReduction_273 _ = HappyAbsSyn99 (pling_name ) happyReduce_274 = happySpecReduce_1 122 happyReduction_274 happyReduction_274 (HappyTerminal (QVarSym happy_var_1)) = HappyAbsSyn42 (Qual (Module (fst happy_var_1)) (HsSymbol (snd happy_var_1)) ) happyReduction_274 _ = notHappyAtAll happyReduce_275 = happySpecReduce_1 123 happyReduction_275 happyReduction_275 (HappyTerminal (IntTok happy_var_1)) = HappyAbsSyn123 (HsInt happy_var_1 ) happyReduction_275 _ = notHappyAtAll happyReduce_276 = happySpecReduce_1 123 happyReduction_276 happyReduction_276 (HappyTerminal (Character happy_var_1)) = HappyAbsSyn123 (HsChar happy_var_1 ) happyReduction_276 _ = notHappyAtAll happyReduce_277 = happySpecReduce_1 123 happyReduction_277 happyReduction_277 (HappyTerminal (FloatTok happy_var_1)) = HappyAbsSyn123 (HsFrac happy_var_1 ) happyReduction_277 _ = notHappyAtAll happyReduce_278 = happySpecReduce_1 123 happyReduction_278 happyReduction_278 (HappyTerminal (StringTok happy_var_1)) = HappyAbsSyn123 (HsString happy_var_1 ) happyReduction_278 _ = notHappyAtAll happyReduce_279 = happyMonadReduce 0 124 happyReduction_279 happyReduction_279 (happyRest) = happyThen ( getSrcLoc ) (\r -> happyReturn (HappyAbsSyn124 r)) happyReduce_280 = happyMonadReduce 0 125 happyReduction_280 happyReduction_280 (happyRest) = happyThen ( pushCurrentContext ) (\r -> happyReturn (HappyAbsSyn7 r)) happyReduce_281 = happySpecReduce_1 126 happyReduction_281 happyReduction_281 _ = HappyAbsSyn7 (() ) happyReduce_282 = happyMonadReduce 1 126 happyReduction_282 happyReduction_282 (_ `HappyStk` happyRest) = happyThen ( popContext ) (\r -> happyReturn (HappyAbsSyn7 r)) happyReduce_283 = happySpecReduce_1 127 happyReduction_283 happyReduction_283 (HappyTerminal (ConId happy_var_1)) = HappyAbsSyn127 (Module happy_var_1 ) happyReduction_283 _ = notHappyAtAll happyReduce_284 = happySpecReduce_1 127 happyReduction_284 happyReduction_284 (HappyTerminal (QConId happy_var_1)) = HappyAbsSyn127 (Module (fst happy_var_1 ++ '.':snd happy_var_1) ) happyReduction_284 _ = notHappyAtAll happyReduce_285 = happySpecReduce_1 128 happyReduction_285 happyReduction_285 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn99 (happy_var_1 ) happyReduction_285 _ = notHappyAtAll happyReduce_286 = happySpecReduce_1 129 happyReduction_286 happyReduction_286 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn99 (happy_var_1 ) happyReduction_286 _ = notHappyAtAll happyReduce_287 = happySpecReduce_1 130 happyReduction_287 happyReduction_287 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_287 _ = notHappyAtAll happyReduce_288 = happySpecReduce_1 131 happyReduction_288 happyReduction_288 (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_1 ) happyReduction_288 _ = notHappyAtAll happyReduce_289 = happySpecReduce_1 132 happyReduction_289 happyReduction_289 (HappyAbsSyn99 happy_var_1) = HappyAbsSyn99 (happy_var_1 ) happyReduction_289 _ = notHappyAtAll happyNewToken action sts stk = lexer(\tk -> let cont i = action i i tk (HappyState action) sts stk in case tk of { EOF -> action 193 193 (error "reading EOF!") (HappyState action) sts stk; VarId happy_dollar_dollar -> cont 133; QVarId happy_dollar_dollar -> cont 134; ConId happy_dollar_dollar -> cont 135; QConId happy_dollar_dollar -> cont 136; VarSym happy_dollar_dollar -> cont 137; ConSym happy_dollar_dollar -> cont 138; QVarSym happy_dollar_dollar -> cont 139; QConSym happy_dollar_dollar -> cont 140; IntTok happy_dollar_dollar -> cont 141; FloatTok happy_dollar_dollar -> cont 142; Character happy_dollar_dollar -> cont 143; StringTok happy_dollar_dollar -> cont 144; LeftParen -> cont 145; RightParen -> cont 146; SemiColon -> cont 147; LeftCurly -> cont 148; RightCurly -> cont 149; VRightCurly -> cont 150; LeftSquare -> cont 151; RightSquare -> cont 152; Comma -> cont 153; Underscore -> cont 154; BackQuote -> cont 155; DotDot -> cont 156; Colon -> cont 157; DoubleColon -> cont 158; Equals -> cont 159; Backslash -> cont 160; Bar -> cont 161; LeftArrow -> cont 162; RightArrow -> cont 163; At -> cont 164; Tilde -> cont 165; DoubleArrow -> cont 166; Minus -> cont 167; Exclamation -> cont 168; KW_As -> cont 169; KW_Case -> cont 170; KW_Class -> cont 171; KW_Data -> cont 172; KW_Default -> cont 173; KW_Deriving -> cont 174; KW_Do -> cont 175; KW_Else -> cont 176; KW_Hiding -> cont 177; KW_If -> cont 178; KW_Import -> cont 179; KW_In -> cont 180; KW_Infix -> cont 181; KW_InfixL -> cont 182; KW_InfixR -> cont 183; KW_Instance -> cont 184; KW_Let -> cont 185; KW_Module -> cont 186; KW_NewType -> cont 187; KW_Of -> cont 188; KW_Then -> cont 189; KW_Type -> cont 190; KW_Where -> cont 191; KW_Qualified -> cont 192; _ -> happyError' }) happyError_ tk = happyError' happyThen :: () => P a -> (a -> P b) -> P b happyThen = (>>=) happyReturn :: () => a -> P a happyReturn = (return) happyThen1 = happyThen happyReturn1 :: () => a -> P a happyReturn1 = happyReturn happyError' :: () => P a happyError' = happyError parse = happySomeParser where happySomeParser = happyThen (happyParse action_0) (\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll }) happySeq = happyDontSeq happyError :: P a happyError = fail "Parse error" -- | Parse of a string, which should contain a complete Haskell 98 module. parseModule :: String -> ParseResult HsModule parseModule = runParser parse -- | Parse of a string, which should contain a complete Haskell 98 module. parseModuleWithMode :: ParseMode -> String -> ParseResult HsModule parseModuleWithMode mode = runParserWithMode mode parse {-# LINE 1 "GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp {-# LINE 16 "GenericTemplate.hs" #-} {-# LINE 28 "GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) ----------------------------------------------------------------------------- -- starting the parse happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll ----------------------------------------------------------------------------- -- Accepting the parse -- If the current token is (1), it means we've just accepted a partial -- parse (a %partial parser). We must ignore the saved token on the top of -- the stack in this case. happyAccept (1) tk st sts (_ `HappyStk` ans `HappyStk` _) = happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action {-# LINE 155 "GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- HappyState data type (not arrays) newtype HappyState b c = HappyState (Int -> -- token number Int -> -- token number (yes, again) b -> -- token semantic value HappyState b c -> -- current state [HappyState b c] -> -- state stack c) ----------------------------------------------------------------------------- -- Shifting a token happyShift new_state (1) tk st sts stk@(x `HappyStk` _) = let i = (case x of { HappyErrorToken (i) -> i }) in -- trace "shifting the error token" $ new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk) happyShift new_state i tk st sts stk = happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk) -- happyReduce is specialised for the common cases. happySpecReduce_0 i fn (1) tk st sts stk = happyFail (1) tk st sts stk happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk = action nt j tk st ((st):(sts)) (fn `HappyStk` stk) happySpecReduce_1 i fn (1) tk st sts stk = happyFail (1) tk st sts stk happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk') = let r = fn v1 in happySeq r (action nt j tk st sts (r `HappyStk` stk')) happySpecReduce_2 i fn (1) tk st sts stk = happyFail (1) tk st sts stk happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk') = let r = fn v1 v2 in happySeq r (action nt j tk st sts (r `HappyStk` stk')) happySpecReduce_3 i fn (1) tk st sts stk = happyFail (1) tk st sts stk happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') = let r = fn v1 v2 v3 in happySeq r (action nt j tk st sts (r `HappyStk` stk')) happyReduce k i fn (1) tk st sts stk = happyFail (1) tk st sts stk happyReduce k nt fn j tk st sts stk = case happyDrop (k - ((1) :: Int)) sts of sts1@(((st1@(HappyState (action))):(_))) -> let r = fn stk in -- it doesn't hurt to always seq here... happyDoSeq r (action nt j tk st1 sts1 r) happyMonadReduce k nt fn (1) tk st sts stk = happyFail (1) tk st sts stk happyMonadReduce k nt fn j tk st sts stk = happyThen1 (fn stk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk)) where sts1@(((st1@(HappyState (action))):(_))) = happyDrop k ((st):(sts)) drop_stk = happyDropStk k stk happyDrop (0) l = l happyDrop n ((_):(t)) = happyDrop (n - ((1) :: Int)) t happyDropStk (0) l = l happyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs ----------------------------------------------------------------------------- -- Moving to a new state after a reduction {-# LINE 239 "GenericTemplate.hs" #-} happyGoto action j tk st = action j j tk (HappyState action) ----------------------------------------------------------------------------- -- Error recovery ((1) is the error token) -- parse error if we are in recovery and we fail again happyFail (1) tk old_st _ stk = -- trace "failing" $ happyError_ tk {- We don't need state discarding for our restricted implementation of "error". In fact, it can cause some bogus parses, so I've disabled it for now --SDM -- discard a state happyFail (1) tk old_st (((HappyState (action))):(sts)) (saved_tok `HappyStk` _ `HappyStk` stk) = -- trace ("discarding state, depth " ++ show (length stk)) $ action (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk)) -} -- Enter error recovery: generate an error token, -- save the old token and carry on. happyFail i tk (HappyState (action)) sts stk = -- trace "entering error recovery" $ action (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk) -- Internal happy errors: notHappyAtAll = error "Internal Happy error\n" ----------------------------------------------------------------------------- -- Hack to get the typechecker to accept our action functions ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits -- happySeq = happyDoSeq -- otherwise it emits -- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b happyDontSeq a b = b ----------------------------------------------------------------------------- -- Don't inline any functions from the template. GHC has a nasty habit -- of deciding to inline happyGoto everywhere, which increases the size of -- the generated parser quite a bit. {-# LINE 303 "GenericTemplate.hs" #-} {-# NOINLINE happyShift #-} {-# NOINLINE happySpecReduce_0 #-} {-# NOINLINE happySpecReduce_1 #-} {-# NOINLINE happySpecReduce_2 #-} {-# NOINLINE happySpecReduce_3 #-} {-# NOINLINE happyReduce #-} {-# NOINLINE happyMonadReduce #-} {-# NOINLINE happyGoto #-} {-# NOINLINE happyFail #-} -- end of Happy Template. hugs98-plus-Sep2006/packages/haskell-src/Language/Haskell/Lexer.hs0000644006511100651110000003132510504340234023471 0ustar rossross-- #hide ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Lexer -- Copyright : (c) The GHC Team, 1997-2000 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Lexer for Haskell. -- ----------------------------------------------------------------------------- -- ToDo: Introduce different tokens for decimal, octal and hexadecimal (?) -- ToDo: FloatTok should have three parts (integer part, fraction, exponent) (?) -- ToDo: Use a lexical analyser generator (lx?) module Language.Haskell.Lexer (Token(..), lexer) where import Language.Haskell.ParseMonad import Data.Char (isAlpha, isLower, isUpper, toLower, isDigit, isHexDigit, isOctDigit, isSpace, ord, chr, digitToInt) import Data.Ratio data Token = VarId String | QVarId (String,String) | ConId String | QConId (String,String) | VarSym String | ConSym String | QVarSym (String,String) | QConSym (String,String) | IntTok Integer | FloatTok Rational | Character Char | StringTok String -- Symbols | LeftParen | RightParen | SemiColon | LeftCurly | RightCurly | VRightCurly -- a virtual close brace | LeftSquare | RightSquare | Comma | Underscore | BackQuote -- Reserved operators | DotDot | Colon | DoubleColon | Equals | Backslash | Bar | LeftArrow | RightArrow | At | Tilde | DoubleArrow | Minus | Exclamation -- Reserved Ids | KW_As | KW_Case | KW_Class | KW_Data | KW_Default | KW_Deriving | KW_Do | KW_Else | KW_Hiding | KW_If | KW_Import | KW_In | KW_Infix | KW_InfixL | KW_InfixR | KW_Instance | KW_Let | KW_Module | KW_NewType | KW_Of | KW_Then | KW_Type | KW_Where | KW_Qualified | EOF deriving (Eq,Show) reserved_ops :: [(String,Token)] reserved_ops = [ ( "..", DotDot ), ( ":", Colon ), ( "::", DoubleColon ), ( "=", Equals ), ( "\\", Backslash ), ( "|", Bar ), ( "<-", LeftArrow ), ( "->", RightArrow ), ( "@", At ), ( "~", Tilde ), ( "=>", DoubleArrow ) ] special_varops :: [(String,Token)] special_varops = [ ( "-", Minus ), --ToDo: shouldn't be here ( "!", Exclamation ) --ditto ] reserved_ids :: [(String,Token)] reserved_ids = [ ( "_", Underscore ), ( "case", KW_Case ), ( "class", KW_Class ), ( "data", KW_Data ), ( "default", KW_Default ), ( "deriving", KW_Deriving ), ( "do", KW_Do ), ( "else", KW_Else ), ( "if", KW_If ), ( "import", KW_Import ), ( "in", KW_In ), ( "infix", KW_Infix ), ( "infixl", KW_InfixL ), ( "infixr", KW_InfixR ), ( "instance", KW_Instance ), ( "let", KW_Let ), ( "module", KW_Module ), ( "newtype", KW_NewType ), ( "of", KW_Of ), ( "then", KW_Then ), ( "type", KW_Type ), ( "where", KW_Where ) ] special_varids :: [(String,Token)] special_varids = [ ( "as", KW_As ), ( "qualified", KW_Qualified ), ( "hiding", KW_Hiding ) ] isIdent, isSymbol :: Char -> Bool isIdent c = isAlpha c || isDigit c || c == '\'' || c == '_' isSymbol c = elem c ":!#$%&*+./<=>?@\\^|-~" matchChar :: Char -> String -> Lex a () matchChar c msg = do s <- getInput if null s || head s /= c then fail msg else discard 1 -- The top-level lexer. -- We need to know whether we are at the beginning of the line to decide -- whether to insert layout tokens. lexer :: (Token -> P a) -> P a lexer = runL $ do bol <- checkBOL bol <- lexWhiteSpace bol startToken if bol then lexBOL else lexToken lexWhiteSpace :: Bool -> Lex a Bool lexWhiteSpace bol = do s <- getInput case s of '{':'-':_ -> do discard 2 bol <- lexNestedComment bol lexWhiteSpace bol '-':'-':rest | all (== '-') (takeWhile isSymbol rest) -> do lexWhile (== '-') lexWhile (/= '\n') s' <- getInput case s' of [] -> fail "Unterminated end-of-line comment" _ -> do lexNewline lexWhiteSpace True '\n':_ -> do lexNewline lexWhiteSpace True '\t':_ -> do lexTab lexWhiteSpace bol c:_ | isSpace c -> do discard 1 lexWhiteSpace bol _ -> return bol lexNestedComment :: Bool -> Lex a Bool lexNestedComment bol = do s <- getInput case s of '-':'}':_ -> discard 2 >> return bol '{':'-':_ -> do discard 2 bol <- lexNestedComment bol -- rest of the subcomment lexNestedComment bol -- rest of this comment '\t':_ -> lexTab >> lexNestedComment bol '\n':_ -> lexNewline >> lexNestedComment True _:_ -> discard 1 >> lexNestedComment bol [] -> fail "Unterminated nested comment" -- When we are lexing the first token of a line, check whether we need to -- insert virtual semicolons or close braces due to layout. lexBOL :: Lex a Token lexBOL = do pos <- getOffside case pos of LT -> do -- trace "layout: inserting '}'\n" $ -- Set col to 0, indicating that we're still at the -- beginning of the line, in case we need a semi-colon too. -- Also pop the context here, so that we don't insert -- another close brace before the parser can pop it. setBOL popContextL "lexBOL" return VRightCurly EQ -> -- trace "layout: inserting ';'\n" $ return SemiColon GT -> lexToken lexToken :: Lex a Token lexToken = do s <- getInput case s of [] -> return EOF '0':c:d:_ | toLower c == 'o' && isOctDigit d -> do discard 2 n <- lexOctal return (IntTok n) | toLower c == 'x' && isHexDigit d -> do discard 2 n <- lexHexadecimal return (IntTok n) c:_ | isDigit c -> lexDecimalOrFloat | isUpper c -> lexConIdOrQual "" | isLower c || c == '_' -> do ident <- lexWhile isIdent return $ case lookup ident (reserved_ids ++ special_varids) of Just keyword -> keyword Nothing -> VarId ident | isSymbol c -> do sym <- lexWhile isSymbol return $ case lookup sym (reserved_ops ++ special_varops) of Just t -> t Nothing -> case c of ':' -> ConSym sym _ -> VarSym sym | otherwise -> do discard 1 case c of -- First the special symbols '(' -> return LeftParen ')' -> return RightParen ',' -> return Comma ';' -> return SemiColon '[' -> return LeftSquare ']' -> return RightSquare '`' -> return BackQuote '{' -> do pushContextL NoLayout return LeftCurly '}' -> do popContextL "lexToken" return RightCurly '\'' -> do c2 <- lexChar matchChar '\'' "Improperly terminated character constant" return (Character c2) '"' -> lexString _ -> fail ("Illegal character \'" ++ show c ++ "\'\n") lexDecimalOrFloat :: Lex a Token lexDecimalOrFloat = do ds <- lexWhile isDigit rest <- getInput case rest of ('.':d:_) | isDigit d -> do discard 1 frac <- lexWhile isDigit let num = parseInteger 10 (ds ++ frac) decimals = toInteger (length frac) exponent <- do rest2 <- getInput case rest2 of 'e':_ -> lexExponent 'E':_ -> lexExponent _ -> return 0 return (FloatTok ((num%1) * 10^^(exponent - decimals))) e:_ | toLower e == 'e' -> do exponent <- lexExponent return (FloatTok ((parseInteger 10 ds%1) * 10^^exponent)) _ -> return (IntTok (parseInteger 10 ds)) where lexExponent :: Lex a Integer lexExponent = do discard 1 -- 'e' or 'E' r <- getInput case r of '+':d:_ | isDigit d -> do discard 1 lexDecimal '-':d:_ | isDigit d -> do discard 1 n <- lexDecimal return (negate n) d:_ | isDigit d -> lexDecimal _ -> fail "Float with missing exponent" lexConIdOrQual :: String -> Lex a Token lexConIdOrQual qual = do con <- lexWhile isIdent let conid | null qual = ConId con | otherwise = QConId (qual,con) qual' | null qual = con | otherwise = qual ++ '.':con just_a_conid <- alternative (return conid) rest <- getInput case rest of '.':c:_ | isLower c || c == '_' -> do -- qualified varid? discard 1 ident <- lexWhile isIdent case lookup ident reserved_ids of -- cannot qualify a reserved word Just _ -> just_a_conid Nothing -> return (QVarId (qual', ident)) | isUpper c -> do -- qualified conid? discard 1 lexConIdOrQual qual' | isSymbol c -> do -- qualified symbol? discard 1 sym <- lexWhile isSymbol case lookup sym reserved_ops of -- cannot qualify a reserved operator Just _ -> just_a_conid Nothing -> return $ case c of ':' -> QConSym (qual', sym) _ -> QVarSym (qual', sym) _ -> return conid -- not a qualified thing lexChar :: Lex a Char lexChar = do r <- getInput case r of '\\':_ -> lexEscape c:_ -> discard 1 >> return c [] -> fail "Incomplete character constant" lexString :: Lex a Token lexString = loop "" where loop s = do r <- getInput case r of '\\':'&':_ -> do discard 2 loop s '\\':c:_ | isSpace c -> do discard 1 lexWhiteChars matchChar '\\' "Illegal character in string gap" loop s | otherwise -> do ce <- lexEscape loop (ce:s) '"':_ -> do discard 1 return (StringTok (reverse s)) c:_ -> do discard 1 loop (c:s) [] -> fail "Improperly terminated string" lexWhiteChars :: Lex a () lexWhiteChars = do s <- getInput case s of '\n':_ -> do lexNewline lexWhiteChars '\t':_ -> do lexTab lexWhiteChars c:_ | isSpace c -> do discard 1 lexWhiteChars _ -> return () lexEscape :: Lex a Char lexEscape = do discard 1 r <- getInput case r of -- Production charesc from section B.2 (Note: \& is handled by caller) 'a':_ -> discard 1 >> return '\a' 'b':_ -> discard 1 >> return '\b' 'f':_ -> discard 1 >> return '\f' 'n':_ -> discard 1 >> return '\n' 'r':_ -> discard 1 >> return '\r' 't':_ -> discard 1 >> return '\t' 'v':_ -> discard 1 >> return '\v' '\\':_ -> discard 1 >> return '\\' '"':_ -> discard 1 >> return '\"' '\'':_ -> discard 1 >> return '\'' -- Production ascii from section B.2 '^':c:_ -> discard 2 >> cntrl c 'N':'U':'L':_ -> discard 3 >> return '\NUL' 'S':'O':'H':_ -> discard 3 >> return '\SOH' 'S':'T':'X':_ -> discard 3 >> return '\STX' 'E':'T':'X':_ -> discard 3 >> return '\ETX' 'E':'O':'T':_ -> discard 3 >> return '\EOT' 'E':'N':'Q':_ -> discard 3 >> return '\ENQ' 'A':'C':'K':_ -> discard 3 >> return '\ACK' 'B':'E':'L':_ -> discard 3 >> return '\BEL' 'B':'S':_ -> discard 2 >> return '\BS' 'H':'T':_ -> discard 2 >> return '\HT' 'L':'F':_ -> discard 2 >> return '\LF' 'V':'T':_ -> discard 2 >> return '\VT' 'F':'F':_ -> discard 2 >> return '\FF' 'C':'R':_ -> discard 2 >> return '\CR' 'S':'O':_ -> discard 2 >> return '\SO' 'S':'I':_ -> discard 2 >> return '\SI' 'D':'L':'E':_ -> discard 3 >> return '\DLE' 'D':'C':'1':_ -> discard 3 >> return '\DC1' 'D':'C':'2':_ -> discard 3 >> return '\DC2' 'D':'C':'3':_ -> discard 3 >> return '\DC3' 'D':'C':'4':_ -> discard 3 >> return '\DC4' 'N':'A':'K':_ -> discard 3 >> return '\NAK' 'S':'Y':'N':_ -> discard 3 >> return '\SYN' 'E':'T':'B':_ -> discard 3 >> return '\ETB' 'C':'A':'N':_ -> discard 3 >> return '\CAN' 'E':'M':_ -> discard 2 >> return '\EM' 'S':'U':'B':_ -> discard 3 >> return '\SUB' 'E':'S':'C':_ -> discard 3 >> return '\ESC' 'F':'S':_ -> discard 2 >> return '\FS' 'G':'S':_ -> discard 2 >> return '\GS' 'R':'S':_ -> discard 2 >> return '\RS' 'U':'S':_ -> discard 2 >> return '\US' 'S':'P':_ -> discard 2 >> return '\SP' 'D':'E':'L':_ -> discard 3 >> return '\DEL' -- Escaped numbers 'o':c:_ | isOctDigit c -> do discard 1 n <- lexOctal checkChar n 'x':c:_ | isHexDigit c -> do discard 1 n <- lexHexadecimal checkChar n c:_ | isDigit c -> do n <- lexDecimal checkChar n _ -> fail "Illegal escape sequence" where checkChar n | n <= 0x01FFFF = return (chr (fromInteger n)) checkChar _ = fail "Character constant out of range" -- Production cntrl from section B.2 cntrl :: Char -> Lex a Char cntrl c | c >= '@' && c <= '_' = return (chr (ord c - ord '@')) cntrl _ = fail "Illegal control character" -- assumes at least one octal digit lexOctal :: Lex a Integer lexOctal = do ds <- lexWhile isOctDigit return (parseInteger 8 ds) -- assumes at least one hexadecimal digit lexHexadecimal :: Lex a Integer lexHexadecimal = do ds <- lexWhile isHexDigit return (parseInteger 16 ds) -- assumes at least one decimal digit lexDecimal :: Lex a Integer lexDecimal = do ds <- lexWhile isDigit return (parseInteger 10 ds) -- Stolen from Hugs's Prelude parseInteger :: Integer -> String -> Integer parseInteger radix ds = foldl1 (\n d -> n * radix + d) (map (toInteger . digitToInt) ds) hugs98-plus-Sep2006/packages/haskell-src/Language/Haskell/Parser.ly0000644006511100651110000005365110504340234023666 0ustar rossross> { > ----------------------------------------------------------------------------- > -- | > -- Module : Language.Haskell.Parser > -- Copyright : (c) Simon Marlow, Sven Panne 1997-2000 > -- License : BSD-style (see the file libraries/base/LICENSE) > -- > -- Maintainer : libraries@haskell.org > -- Stability : experimental > -- Portability : portable > -- > -- Haskell parser. > -- > ----------------------------------------------------------------------------- > > module Language.Haskell.Parser ( > parseModule, parseModuleWithMode, > ParseMode(..), defaultParseMode, ParseResult(..)) where > > import Language.Haskell.Syntax > import Language.Haskell.ParseMonad > import Language.Haskell.Lexer > import Language.Haskell.ParseUtils > } ToDo: Check exactly which names must be qualified with Prelude (commas and friends) ToDo: Inst (MPCs?) ToDo: Polish constr a bit ToDo: Ugly: exp0b is used for lhs, pat, exp0, ... ToDo: Differentiate between record updates and labeled construction. ----------------------------------------------------------------------------- Conflicts: 2 shift/reduce 2 for ambiguity in 'case x of y | let z = y in z :: Bool -> b' (don't know whether to reduce 'Bool' as a btype or shift the '->'. Similarly lambda and if. The default resolution in favour of the shift means that a guard can never end with a type signature. In mitigation: it's a rare case and no Haskell implementation allows these, because it would require unbounded lookahead.) There are 2 conflicts rather than one because contexts are parsed as btypes (cf ctype). ----------------------------------------------------------------------------- > %token > VARID { VarId $$ } > QVARID { QVarId $$ } > CONID { ConId $$ } > QCONID { QConId $$ } > VARSYM { VarSym $$ } > CONSYM { ConSym $$ } > QVARSYM { QVarSym $$ } > QCONSYM { QConSym $$ } > INT { IntTok $$ } > RATIONAL { FloatTok $$ } > CHAR { Character $$ } > STRING { StringTok $$ } Symbols > '(' { LeftParen } > ')' { RightParen } > ';' { SemiColon } > '{' { LeftCurly } > '}' { RightCurly } > vccurly { VRightCurly } -- a virtual close brace > '[' { LeftSquare } > ']' { RightSquare } > ',' { Comma } > '_' { Underscore } > '`' { BackQuote } Reserved operators > '..' { DotDot } > ':' { Colon } > '::' { DoubleColon } > '=' { Equals } > '\\' { Backslash } > '|' { Bar } > '<-' { LeftArrow } > '->' { RightArrow } > '@' { At } > '~' { Tilde } > '=>' { DoubleArrow } > '-' { Minus } > '!' { Exclamation } Reserved Ids > 'as' { KW_As } > 'case' { KW_Case } > 'class' { KW_Class } > 'data' { KW_Data } > 'default' { KW_Default } > 'deriving' { KW_Deriving } > 'do' { KW_Do } > 'else' { KW_Else } > 'hiding' { KW_Hiding } > 'if' { KW_If } > 'import' { KW_Import } > 'in' { KW_In } > 'infix' { KW_Infix } > 'infixl' { KW_InfixL } > 'infixr' { KW_InfixR } > 'instance' { KW_Instance } > 'let' { KW_Let } > 'module' { KW_Module } > 'newtype' { KW_NewType } > 'of' { KW_Of } > 'then' { KW_Then } > 'type' { KW_Type } > 'where' { KW_Where } > 'qualified' { KW_Qualified } > %monad { P } > %lexer { lexer } { EOF } > %name parse > %tokentype { Token } > %% ----------------------------------------------------------------------------- Module Header > module :: { HsModule } > : srcloc 'module' modid maybeexports 'where' body > { HsModule $1 $3 $4 (fst $6) (snd $6) } > | srcloc body > { HsModule $1 main_mod (Just [HsEVar (UnQual main_name)]) > (fst $2) (snd $2) } > body :: { ([HsImportDecl],[HsDecl]) } > : '{' bodyaux '}' { $2 } > | open bodyaux close { $2 } > bodyaux :: { ([HsImportDecl],[HsDecl]) } > : optsemis impdecls semis topdecls { (reverse $2, $4) } > | optsemis topdecls { ([], $2) } > | optsemis impdecls optsemis { (reverse $2, []) } > | optsemis { ([], []) } > semis :: { () } > : optsemis ';' { () } > optsemis :: { () } > : semis { () } > | {- empty -} { () } ----------------------------------------------------------------------------- The Export List > maybeexports :: { Maybe [HsExportSpec] } > : exports { Just $1 } > | {- empty -} { Nothing } > exports :: { [HsExportSpec] } > : '(' exportlist optcomma ')' { reverse $2 } > | '(' optcomma ')' { [] } > optcomma :: { () } > : ',' { () } > | {- empty -} { () } > exportlist :: { [HsExportSpec] } > : exportlist ',' export { $3 : $1 } > | export { [$1] } > export :: { HsExportSpec } > : qvar { HsEVar $1 } > | qtyconorcls { HsEAbs $1 } > | qtyconorcls '(' '..' ')' { HsEThingAll $1 } > | qtyconorcls '(' ')' { HsEThingWith $1 [] } > | qtyconorcls '(' cnames ')' { HsEThingWith $1 (reverse $3) } > | 'module' modid { HsEModuleContents $2 } ----------------------------------------------------------------------------- Import Declarations > impdecls :: { [HsImportDecl] } > : impdecls semis impdecl { $3 : $1 } > | impdecl { [$1] } > impdecl :: { HsImportDecl } > : srcloc 'import' optqualified modid maybeas maybeimpspec > { HsImportDecl $1 $4 $3 $5 $6 } > optqualified :: { Bool } > : 'qualified' { True } > | {- empty -} { False } > maybeas :: { Maybe Module } > : 'as' modid { Just $2 } > | {- empty -} { Nothing } > maybeimpspec :: { Maybe (Bool, [HsImportSpec]) } > : impspec { Just $1 } > | {- empty -} { Nothing } > impspec :: { (Bool, [HsImportSpec]) } > : opthiding '(' importlist optcomma ')' { ($1, reverse $3) } > | opthiding '(' optcomma ')' { ($1, []) } > opthiding :: { Bool } > : 'hiding' { True } > | {- empty -} { False } > importlist :: { [HsImportSpec] } > : importlist ',' importspec { $3 : $1 } > | importspec { [$1] } > importspec :: { HsImportSpec } > : var { HsIVar $1 } > | tyconorcls { HsIAbs $1 } > | tyconorcls '(' '..' ')' { HsIThingAll $1 } > | tyconorcls '(' ')' { HsIThingWith $1 [] } > | tyconorcls '(' cnames ')' { HsIThingWith $1 (reverse $3) } > cnames :: { [HsCName] } > : cnames ',' cname { $3 : $1 } > | cname { [$1] } > cname :: { HsCName } > : var { HsVarName $1 } > | con { HsConName $1 } ----------------------------------------------------------------------------- Fixity Declarations > fixdecl :: { HsDecl } > : srcloc infix prec ops { HsInfixDecl $1 $2 $3 (reverse $4) } > prec :: { Int } > : {- empty -} { 9 } > | INT {% checkPrec $1 } > infix :: { HsAssoc } > : 'infix' { HsAssocNone } > | 'infixl' { HsAssocLeft } > | 'infixr' { HsAssocRight } > ops :: { [HsOp] } > : ops ',' op { $3 : $1 } > | op { [$1] } ----------------------------------------------------------------------------- Top-Level Declarations Note: The report allows topdecls to be empty. This would result in another shift/reduce-conflict, so we don't handle this case here, but in bodyaux. > topdecls :: { [HsDecl] } > : topdecls1 optsemis {% checkRevDecls $1 } > topdecls1 :: { [HsDecl] } > : topdecls1 semis topdecl { $3 : $1 } > | topdecl { [$1] } > topdecl :: { HsDecl } > : srcloc 'type' simpletype '=' type > { HsTypeDecl $1 (fst $3) (snd $3) $5 } > | srcloc 'data' ctype '=' constrs deriving > {% do { (cs,c,t) <- checkDataHeader $3; > return (HsDataDecl $1 cs c t (reverse $5) $6) } } > | srcloc 'newtype' ctype '=' constr deriving > {% do { (cs,c,t) <- checkDataHeader $3; > return (HsNewTypeDecl $1 cs c t $5 $6) } } > | srcloc 'class' ctype optcbody > {% do { (cs,c,vs) <- checkClassHeader $3; > return (HsClassDecl $1 cs c vs $4) } } > | srcloc 'instance' ctype optvaldefs > {% do { (cs,c,ts) <- checkInstHeader $3; > return (HsInstDecl $1 cs c ts $4) } } > | srcloc 'default' '(' typelist ')' > { HsDefaultDecl $1 $4 } > | decl { $1 } > typelist :: { [HsType] } > : types { reverse $1 } > | type { [$1] } > | {- empty -} { [] } > decls :: { [HsDecl] } > : optsemis decls1 optsemis {% checkRevDecls $2 } > | optsemis { [] } > decls1 :: { [HsDecl] } > : decls1 semis decl { $3 : $1 } > | decl { [$1] } > decl :: { HsDecl } > : signdecl { $1 } > | fixdecl { $1 } > | valdef { $1 } > decllist :: { [HsDecl] } > : '{' decls '}' { $2 } > | open decls close { $2 } > signdecl :: { HsDecl } > : srcloc vars '::' ctype { HsTypeSig $1 (reverse $2) $4 } ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var instead of qvar, we get another shift/reduce-conflict. Consider the following programs: { (+) :: ... } only var { (+) x y = ... } could (incorrectly) be qvar We re-use expressions for patterns, so a qvar would be allowed in patterns instead of a var only (which would be correct). But deciding what the + is, would require more lookahead. So let's check for ourselves... > vars :: { [HsName] } > : vars ',' var { $3 : $1 } > | qvar {% do { n <- checkUnQual $1; > return [n] } } ----------------------------------------------------------------------------- Types > type :: { HsType } > : btype '->' type { HsTyFun $1 $3 } > | btype { $1 } > btype :: { HsType } > : btype atype { HsTyApp $1 $2 } > | atype { $1 } > atype :: { HsType } > : gtycon { HsTyCon $1 } > | tyvar { HsTyVar $1 } > | '(' types ')' { HsTyTuple (reverse $2) } > | '[' type ']' { HsTyApp list_tycon $2 } > | '(' type ')' { $2 } > gtycon :: { HsQName } > : qconid { $1 } > | '(' ')' { unit_tycon_name } > | '(' '->' ')' { fun_tycon_name } > | '[' ']' { list_tycon_name } > | '(' commas ')' { tuple_tycon_name $2 } (Slightly edited) Comment from GHC's hsparser.y: "context => type" vs "type" is a problem, because you can't distinguish between foo :: (Baz a, Baz a) bar :: (Baz a, Baz a) => [a] -> [a] -> [a] with one token of lookahead. The HACK is to parse the context as a btype (more specifically as a tuple type), then check that it has the right form C a, or (C1 a, C2 b, ... Cn z) and convert it into a context. Blaach! > ctype :: { HsQualType } > : context '=>' type { HsQualType $1 $3 } > | type { HsQualType [] $1 } > context :: { HsContext } > : btype {% checkContext $1 } > types :: { [HsType] } > : types ',' type { $3 : $1 } > | type ',' type { [$3, $1] } > simpletype :: { (HsName, [HsName]) } > : tycon tyvars { ($1,reverse $2) } > tyvars :: { [HsName] } > : tyvars tyvar { $2 : $1 } > | {- empty -} { [] } ----------------------------------------------------------------------------- Datatype declarations > constrs :: { [HsConDecl] } > : constrs '|' constr { $3 : $1 } > | constr { [$1] } > constr :: { HsConDecl } > : srcloc scontype { HsConDecl $1 (fst $2) (snd $2) } > | srcloc sbtype conop sbtype { HsConDecl $1 $3 [$2,$4] } > | srcloc con '{' '}' { HsRecDecl $1 $2 [] } > | srcloc con '{' fielddecls '}' { HsRecDecl $1 $2 (reverse $4) } > scontype :: { (HsName, [HsBangType]) } > : btype {% do { (c,ts) <- splitTyConApp $1; > return (c,map HsUnBangedTy ts) } } > | scontype1 { $1 } > scontype1 :: { (HsName, [HsBangType]) } > : btype '!' atype {% do { (c,ts) <- splitTyConApp $1; > return (c,map HsUnBangedTy ts++ > [HsBangedTy $3]) } } > | scontype1 satype { (fst $1, snd $1 ++ [$2] ) } > satype :: { HsBangType } > : atype { HsUnBangedTy $1 } > | '!' atype { HsBangedTy $2 } > sbtype :: { HsBangType } > : btype { HsUnBangedTy $1 } > | '!' atype { HsBangedTy $2 } > fielddecls :: { [([HsName],HsBangType)] } > : fielddecls ',' fielddecl { $3 : $1 } > | fielddecl { [$1] } > fielddecl :: { ([HsName],HsBangType) } > : vars '::' stype { (reverse $1, $3) } > stype :: { HsBangType } > : type { HsUnBangedTy $1 } > | '!' atype { HsBangedTy $2 } > deriving :: { [HsQName] } > : {- empty -} { [] } > | 'deriving' qtycls { [$2] } > | 'deriving' '(' ')' { [] } > | 'deriving' '(' dclasses ')' { reverse $3 } > dclasses :: { [HsQName] } > : dclasses ',' qtycls { $3 : $1 } > | qtycls { [$1] } ----------------------------------------------------------------------------- Class declarations > optcbody :: { [HsDecl] } > : 'where' decllist {% checkClassBody $2 } > | {- empty -} { [] } ----------------------------------------------------------------------------- Instance declarations > optvaldefs :: { [HsDecl] } > : 'where' '{' valdefs '}' {% checkClassBody $3 } > | 'where' open valdefs close {% checkClassBody $3 } > | {- empty -} { [] } > valdefs :: { [HsDecl] } > : optsemis valdefs1 optsemis {% checkRevDecls $2 } > | optsemis { [] } > valdefs1 :: { [HsDecl] } > : valdefs1 semis valdef { $3 : $1 } > | valdef { [$1] } ----------------------------------------------------------------------------- Value definitions > valdef :: { HsDecl } > : srcloc exp0b rhs optwhere {% checkValDef $1 $2 $3 $4 } > optwhere :: { [HsDecl] } > : 'where' decllist { $2 } > | {- empty -} { [] } > rhs :: { HsRhs } > : '=' exp {% do { e <- checkExpr $2; > return (HsUnGuardedRhs e) } } > | gdrhs { HsGuardedRhss (reverse $1) } > gdrhs :: { [HsGuardedRhs] } > : gdrhs gdrh { $2 : $1 } > | gdrh { [$1] } > gdrh :: { HsGuardedRhs } > : srcloc '|' exp0 '=' exp {% do { g <- checkExpr $3; > e <- checkExpr $5; > return (HsGuardedRhs $1 g e) } } ----------------------------------------------------------------------------- Expressions Note: The Report specifies a meta-rule for lambda, let and if expressions (the exp's that end with a subordinate exp): they extend as far to the right as possible. That means they cannot be followed by a type signature or infix application. To implement this without shift/reduce conflicts, we split exp10 into these expressions (exp10a) and the others (exp10b). That also means that only an exp0 ending in an exp10b (an exp0b) can followed by a type signature or infix application. So we duplicate the exp0 productions to distinguish these from the others (exp0a). > exp :: { HsExp } > : exp0b '::' srcloc ctype { HsExpTypeSig $3 $1 $4 } > | exp0 { $1 } > exp0 :: { HsExp } > : exp0a { $1 } > | exp0b { $1 } > exp0a :: { HsExp } > : exp0b qop exp10a { HsInfixApp $1 $2 $3 } > | exp10a { $1 } > exp0b :: { HsExp } > : exp0b qop exp10b { HsInfixApp $1 $2 $3 } > | exp10b { $1 } > exp10a :: { HsExp } > : '\\' srcloc apats '->' exp { HsLambda $2 (reverse $3) $5 } > | 'let' decllist 'in' exp { HsLet $2 $4 } > | 'if' exp 'then' exp 'else' exp { HsIf $2 $4 $6 } > exp10b :: { HsExp } > : 'case' exp 'of' altslist { HsCase $2 $4 } > | '-' fexp { HsNegApp $2 } > | 'do' stmtlist { HsDo $2 } > | fexp { $1 } > fexp :: { HsExp } > : fexp aexp { HsApp $1 $2 } > | aexp { $1 } > apats :: { [HsPat] } > : apats apat { $2 : $1 } > | apat { [$1] } > apat :: { HsPat } > : aexp {% checkPattern $1 } UGLY: Because patterns and expressions are mixed, aexp has to be split into two rules: One right-recursive and one left-recursive. Otherwise we get two reduce/reduce-errors (for as-patterns and irrefutable patters). Even though the variable in an as-pattern cannot be qualified, we use qvar here to avoid a shift/reduce conflict, and then check it ourselves (as for vars above). > aexp :: { HsExp } > : qvar '@' aexp {% do { n <- checkUnQual $1; > return (HsAsPat n $3) } } > | '~' aexp { HsIrrPat $2 } > | aexp1 { $1 } Note: The first two alternatives of aexp1 are not necessarily record updates: they could be labeled constructions. > aexp1 :: { HsExp } > : aexp1 '{' '}' {% mkRecConstrOrUpdate $1 [] } > | aexp1 '{' fbinds '}' {% mkRecConstrOrUpdate $1 (reverse $3) } > | aexp2 { $1 } According to the Report, the left section (e op) is legal iff (e op x) parses equivalently to ((e) op x). Thus e must be an exp0b. > aexp2 :: { HsExp } > : qvar { HsVar $1 } > | gcon { $1 } > | literal { HsLit $1 } > | '(' exp ')' { HsParen $2 } > | '(' texps ')' { HsTuple (reverse $2) } > | '[' list ']' { $2 } > | '(' exp0b qop ')' { HsLeftSection $2 $3 } > | '(' qopm exp0 ')' { HsRightSection $2 $3 } > | '_' { HsWildCard } > commas :: { Int } > : commas ',' { $1 + 1 } > | ',' { 1 } > texps :: { [HsExp] } > : texps ',' exp { $3 : $1 } > | exp ',' exp { [$3,$1] } ----------------------------------------------------------------------------- List expressions The rules below are little bit contorted to keep lexps left-recursive while avoiding another shift/reduce-conflict. > list :: { HsExp } > : exp { HsList [$1] } > | lexps { HsList (reverse $1) } > | exp '..' { HsEnumFrom $1 } > | exp ',' exp '..' { HsEnumFromThen $1 $3 } > | exp '..' exp { HsEnumFromTo $1 $3 } > | exp ',' exp '..' exp { HsEnumFromThenTo $1 $3 $5 } > | exp '|' quals { HsListComp $1 (reverse $3) } > lexps :: { [HsExp] } > : lexps ',' exp { $3 : $1 } > | exp ',' exp { [$3,$1] } ----------------------------------------------------------------------------- List comprehensions > quals :: { [HsStmt] } > : quals ',' qual { $3 : $1 } > | qual { [$1] } > qual :: { HsStmt } > : pat srcloc '<-' exp { HsGenerator $2 $1 $4 } > | exp { HsQualifier $1 } > | 'let' decllist { HsLetStmt $2 } ----------------------------------------------------------------------------- Case alternatives > altslist :: { [HsAlt] } > : '{' alts '}' { $2 } > | open alts close { $2 } > alts :: { [HsAlt] } > : optsemis alts1 optsemis { reverse $2 } > alts1 :: { [HsAlt] } > : alts1 semis alt { $3 : $1 } > | alt { [$1] } > alt :: { HsAlt } > : srcloc pat ralt optwhere { HsAlt $1 $2 $3 $4 } > ralt :: { HsGuardedAlts } > : '->' exp { HsUnGuardedAlt $2 } > | gdpats { HsGuardedAlts (reverse $1) } > gdpats :: { [HsGuardedAlt] } > : gdpats gdpat { $2 : $1 } > | gdpat { [$1] } > gdpat :: { HsGuardedAlt } > : srcloc '|' exp0 '->' exp { HsGuardedAlt $1 $3 $5 } > pat :: { HsPat } > : exp0b {% checkPattern $1 } ----------------------------------------------------------------------------- Statement sequences As per the Report, but with stmt expanded to simplify building the list without introducing conflicts. This also ensures that the last stmt is an expression. > stmtlist :: { [HsStmt] } > : '{' stmts '}' { $2 } > | open stmts close { $2 } > stmts :: { [HsStmt] } > : 'let' decllist ';' stmts { HsLetStmt $2 : $4 } > | pat srcloc '<-' exp ';' stmts { HsGenerator $2 $1 $4 : $6 } > | exp ';' stmts { HsQualifier $1 : $3 } > | ';' stmts { $2 } > | exp ';' { [HsQualifier $1] } > | exp { [HsQualifier $1] } ----------------------------------------------------------------------------- Record Field Update/Construction > fbinds :: { [HsFieldUpdate] } > : fbinds ',' fbind { $3 : $1 } > | fbind { [$1] } > fbind :: { HsFieldUpdate } > : qvar '=' exp { HsFieldUpdate $1 $3 } ----------------------------------------------------------------------------- Variables, Constructors and Operators. > gcon :: { HsExp } > : '(' ')' { unit_con } > | '[' ']' { HsList [] } > | '(' commas ')' { tuple_con $2 } > | qcon { HsCon $1 } > var :: { HsName } > : varid { $1 } > | '(' varsym ')' { $2 } > qvar :: { HsQName } > : qvarid { $1 } > | '(' qvarsym ')' { $2 } > con :: { HsName } > : conid { $1 } > | '(' consym ')' { $2 } > qcon :: { HsQName } > : qconid { $1 } > | '(' gconsym ')' { $2 } > varop :: { HsName } > : varsym { $1 } > | '`' varid '`' { $2 } > qvarop :: { HsQName } > : qvarsym { $1 } > | '`' qvarid '`' { $2 } > qvaropm :: { HsQName } > : qvarsymm { $1 } > | '`' qvarid '`' { $2 } > conop :: { HsName } > : consym { $1 } > | '`' conid '`' { $2 } > qconop :: { HsQName } > : gconsym { $1 } > | '`' qconid '`' { $2 } > op :: { HsOp } > : varop { HsVarOp $1 } > | conop { HsConOp $1 } > qop :: { HsQOp } > : qvarop { HsQVarOp $1 } > | qconop { HsQConOp $1 } > qopm :: { HsQOp } > : qvaropm { HsQVarOp $1 } > | qconop { HsQConOp $1 } > gconsym :: { HsQName } > : ':' { list_cons_name } > | qconsym { $1 } ----------------------------------------------------------------------------- Identifiers and Symbols > qvarid :: { HsQName } > : varid { UnQual $1 } > | QVARID { Qual (Module (fst $1)) (HsIdent (snd $1)) } > varid :: { HsName } > : VARID { HsIdent $1 } > | 'as' { as_name } > | 'qualified' { qualified_name } > | 'hiding' { hiding_name } > qconid :: { HsQName } > : conid { UnQual $1 } > | QCONID { Qual (Module (fst $1)) (HsIdent (snd $1)) } > conid :: { HsName } > : CONID { HsIdent $1 } > qconsym :: { HsQName } > : consym { UnQual $1 } > | QCONSYM { Qual (Module (fst $1)) (HsSymbol (snd $1)) } > consym :: { HsName } > : CONSYM { HsSymbol $1 } > qvarsym :: { HsQName } > : varsym { UnQual $1 } > | qvarsym1 { $1 } > qvarsymm :: { HsQName } > : varsymm { UnQual $1 } > | qvarsym1 { $1 } > varsym :: { HsName } > : VARSYM { HsSymbol $1 } > | '-' { minus_name } > | '!' { pling_name } > varsymm :: { HsName } -- varsym not including '-' > : VARSYM { HsSymbol $1 } > | '!' { pling_name } > qvarsym1 :: { HsQName } > : QVARSYM { Qual (Module (fst $1)) (HsSymbol (snd $1)) } > literal :: { HsLiteral } > : INT { HsInt $1 } > | CHAR { HsChar $1 } > | RATIONAL { HsFrac $1 } > | STRING { HsString $1 } > srcloc :: { SrcLoc } : {% getSrcLoc } ----------------------------------------------------------------------------- Layout > open :: { () } : {% pushCurrentContext } > close :: { () } > : vccurly { () } -- context popped in lexer. > | error {% popContext } ----------------------------------------------------------------------------- Miscellaneous (mostly renamings) > modid :: { Module } > : CONID { Module $1 } > | QCONID { Module (fst $1 ++ '.':snd $1) } > tyconorcls :: { HsName } > : conid { $1 } > tycon :: { HsName } > : conid { $1 } > qtyconorcls :: { HsQName } > : qconid { $1 } > qtycls :: { HsQName } > : qconid { $1 } > tyvar :: { HsName } > : varid { $1 } ----------------------------------------------------------------------------- > { > happyError :: P a > happyError = fail "Parse error" > -- | Parse of a string, which should contain a complete Haskell 98 module. > parseModule :: String -> ParseResult HsModule > parseModule = runParser parse > -- | Parse of a string, which should contain a complete Haskell 98 module. > parseModuleWithMode :: ParseMode -> String -> ParseResult HsModule > parseModuleWithMode mode = runParserWithMode mode parse > } hugs98-plus-Sep2006/packages/haskell-src/Language/Haskell/ParseMonad.hs0000644006511100651110000001625610504340234024451 0ustar rossross-- #hide ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.ParseMonad -- Copyright : (c) The GHC Team, 1997-2000 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Monads for the Haskell parser and lexer. -- ----------------------------------------------------------------------------- module Language.Haskell.ParseMonad( -- * Parsing P, ParseResult(..), atSrcLoc, LexContext(..), ParseMode(..), defaultParseMode, runParserWithMode, runParser, getSrcLoc, pushCurrentContext, popContext, -- * Lexing Lex(runL), getInput, discard, lexNewline, lexTab, lexWhile, alternative, checkBOL, setBOL, startToken, getOffside, pushContextL, popContextL ) where import Language.Haskell.Syntax(SrcLoc(..)) -- | The result of a parse. data ParseResult a = ParseOk a -- ^ The parse succeeded, yielding a value. | ParseFailed SrcLoc String -- ^ The parse failed at the specified -- source location, with an error message. deriving Show -- internal version data ParseStatus a = Ok ParseState a | Failed SrcLoc String deriving Show data LexContext = NoLayout | Layout Int deriving (Eq,Ord,Show) type ParseState = [LexContext] indentOfParseState :: ParseState -> Int indentOfParseState (Layout n:_) = n indentOfParseState _ = 0 -- | Static parameters governing a parse. -- More to come later, e.g. literate mode, language extensions. data ParseMode = ParseMode { -- | original name of the file being parsed parseFilename :: String } -- | Default parameters for a parse, -- currently just a marker for an unknown filename. defaultParseMode :: ParseMode defaultParseMode = ParseMode { parseFilename = "" } -- | Monad for parsing newtype P a = P { runP :: String -- input string -> Int -- current column -> Int -- current line -> SrcLoc -- location of last token read -> ParseState -- layout info. -> ParseMode -- parse parameters -> ParseStatus a } runParserWithMode :: ParseMode -> P a -> String -> ParseResult a runParserWithMode mode (P m) s = case m s 0 1 start [] mode of Ok _ a -> ParseOk a Failed loc msg -> ParseFailed loc msg where start = SrcLoc { srcFilename = parseFilename mode, srcLine = 1, srcColumn = 1 } runParser :: P a -> String -> ParseResult a runParser = runParserWithMode defaultParseMode instance Monad P where return a = P $ \_i _x _y _l s _m -> Ok s a P m >>= k = P $ \i x y l s mode -> case m i x y l s mode of Failed loc msg -> Failed loc msg Ok s' a -> runP (k a) i x y l s' mode fail s = P $ \_r _col _line loc _stk _m -> Failed loc s atSrcLoc :: P a -> SrcLoc -> P a P m `atSrcLoc` loc = P $ \i x y _l -> m i x y loc getSrcLoc :: P SrcLoc getSrcLoc = P $ \_i _x _y l s _m -> Ok s l -- Enter a new layout context. If we are already in a layout context, -- ensure that the new indent is greater than the indent of that context. -- (So if the source loc is not to the right of the current indent, an -- empty list {} will be inserted.) pushCurrentContext :: P () pushCurrentContext = do loc <- getSrcLoc indent <- currentIndent pushContext (Layout (max (indent+1) (srcColumn loc))) currentIndent :: P Int currentIndent = P $ \_r _x _y loc stk _mode -> Ok stk (indentOfParseState stk) pushContext :: LexContext -> P () pushContext ctxt = --trace ("pushing lexical scope: " ++ show ctxt ++"\n") $ P $ \_i _x _y _l s _m -> Ok (ctxt:s) () popContext :: P () popContext = P $ \_i _x _y _l stk _m -> case stk of (_:s) -> --trace ("popping lexical scope, context now "++show s ++ "\n") $ Ok s () [] -> error "Internal error: empty context in popContext" -- Monad for lexical analysis: -- a continuation-passing version of the parsing monad newtype Lex r a = Lex { runL :: (a -> P r) -> P r } instance Monad (Lex r) where return a = Lex $ \k -> k a Lex v >>= f = Lex $ \k -> v (\a -> runL (f a) k) Lex v >> Lex w = Lex $ \k -> v (\_ -> w k) fail s = Lex $ \_ -> fail s -- Operations on this monad getInput :: Lex r String getInput = Lex $ \cont -> P $ \r -> runP (cont r) r -- | Discard some input characters (these must not include tabs or newlines). discard :: Int -> Lex r () discard n = Lex $ \cont -> P $ \r x -> runP (cont ()) (drop n r) (x+n) -- | Discard the next character, which must be a newline. lexNewline :: Lex a () lexNewline = Lex $ \cont -> P $ \(_:r) _x y -> runP (cont ()) r 1 (y+1) -- | Discard the next character, which must be a tab. lexTab :: Lex a () lexTab = Lex $ \cont -> P $ \(_:r) x -> runP (cont ()) r (nextTab x) nextTab :: Int -> Int nextTab x = x + (tAB_LENGTH - (x-1) `mod` tAB_LENGTH) tAB_LENGTH :: Int tAB_LENGTH = 8 -- Consume and return the largest string of characters satisfying p lexWhile :: (Char -> Bool) -> Lex a String lexWhile p = Lex $ \cont -> P $ \r x -> let (cs,rest) = span p r in runP (cont cs) rest (x + length cs) -- An alternative scan, to which we can return if subsequent scanning -- is unsuccessful. alternative :: Lex a v -> Lex a (Lex a v) alternative (Lex v) = Lex $ \cont -> P $ \r x y -> runP (cont (Lex $ \cont' -> P $ \_r _x _y -> runP (v cont') r x y)) r x y -- The source location is the coordinates of the previous token, -- or, while scanning a token, the start of the current token. -- col is the current column in the source file. -- We also need to remember between scanning tokens whether we are -- somewhere at the beginning of the line before the first token. -- This could be done with an extra Bool argument to the P monad, -- but as a hack we use a col value of 0 to indicate this situation. -- Setting col to 0 is used in two places: just after emitting a virtual -- close brace due to layout, so that next time through we check whether -- we also need to emit a semi-colon, and at the beginning of the file, -- by runParser, to kick off the lexer. -- Thus when col is zero, the true column can be taken from the loc. checkBOL :: Lex a Bool checkBOL = Lex $ \cont -> P $ \r x y loc -> if x == 0 then runP (cont True) r (srcColumn loc) y loc else runP (cont False) r x y loc setBOL :: Lex a () setBOL = Lex $ \cont -> P $ \r _ -> runP (cont ()) r 0 -- Set the loc to the current position startToken :: Lex a () startToken = Lex $ \cont -> P $ \s x y _ stk mode -> let loc = SrcLoc { srcFilename = parseFilename mode, srcLine = y, srcColumn = x } in runP (cont ()) s x y loc stk mode -- Current status with respect to the offside (layout) rule: -- LT: we are to the left of the current indent (if any) -- EQ: we are at the current indent (if any) -- GT: we are to the right of the current indent, or not subject to layout getOffside :: Lex a Ordering getOffside = Lex $ \cont -> P $ \r x y loc stk -> runP (cont (compare x (indentOfParseState stk))) r x y loc stk pushContextL :: LexContext -> Lex a () pushContextL ctxt = Lex $ \cont -> P $ \r x y loc stk -> runP (cont ()) r x y loc (ctxt:stk) popContextL :: String -> Lex a () popContextL fn = Lex $ \cont -> P $ \r x y loc stk -> case stk of (_:ctxt) -> runP (cont ()) r x y loc ctxt [] -> error ("Internal error: empty context in " ++ fn) hugs98-plus-Sep2006/packages/haskell-src/Language/Haskell/ParseUtils.hs0000644006511100651110000002477710504340234024522 0ustar rossross-- #hide ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.ParseUtils -- Copyright : (c) The GHC Team, 1997-2000 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Utilities for the Haskell parser. -- ----------------------------------------------------------------------------- module Language.Haskell.ParseUtils ( splitTyConApp -- HsType -> P (HsName,[HsType]) , mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp , checkPrec -- Integer -> P Int , checkContext -- HsType -> P HsContext , checkAssertion -- HsType -> P HsAsst , checkDataHeader -- HsQualType -> P (HsContext,HsName,[HsName]) , checkClassHeader -- HsQualType -> P (HsContext,HsName,[HsName]) , checkInstHeader -- HsQualType -> P (HsContext,HsQName,[HsType]) , checkPattern -- HsExp -> P HsPat , checkExpr -- HsExp -> P HsExp , checkValDef -- SrcLoc -> HsExp -> HsRhs -> [HsDecl] -> P HsDecl , checkClassBody -- [HsDecl] -> P [HsDecl] , checkUnQual -- HsQName -> P HsName , checkRevDecls -- [HsDecl] -> P [HsDecl] ) where import Language.Haskell.Syntax import Language.Haskell.ParseMonad import Language.Haskell.Pretty splitTyConApp :: HsType -> P (HsName,[HsType]) splitTyConApp t0 = split t0 [] where split :: HsType -> [HsType] -> P (HsName,[HsType]) split (HsTyApp t u) ts = split t (u:ts) split (HsTyCon (UnQual t)) ts = return (t,ts) split _ _ = fail "Illegal data/newtype declaration" ----------------------------------------------------------------------------- -- Various Syntactic Checks checkContext :: HsType -> P HsContext checkContext (HsTyTuple ts) = mapM checkAssertion ts checkContext t = do c <- checkAssertion t return [c] -- Changed for multi-parameter type classes checkAssertion :: HsType -> P HsAsst checkAssertion = checkAssertion' [] where checkAssertion' ts (HsTyCon c) = return (c,ts) checkAssertion' ts (HsTyApp a t) = checkAssertion' (t:ts) a checkAssertion' _ _ = fail "Illegal class assertion" checkDataHeader :: HsQualType -> P (HsContext,HsName,[HsName]) checkDataHeader (HsQualType cs t) = do (c,ts) <- checkSimple "data/newtype" t [] return (cs,c,ts) checkClassHeader :: HsQualType -> P (HsContext,HsName,[HsName]) checkClassHeader (HsQualType cs t) = do (c,ts) <- checkSimple "class" t [] return (cs,c,ts) checkSimple :: String -> HsType -> [HsName] -> P ((HsName,[HsName])) checkSimple kw (HsTyApp l (HsTyVar a)) xs = checkSimple kw l (a:xs) checkSimple _kw (HsTyCon (UnQual t)) xs = return (t,xs) checkSimple kw _ _ = fail ("Illegal " ++ kw ++ " declaration") checkInstHeader :: HsQualType -> P (HsContext,HsQName,[HsType]) checkInstHeader (HsQualType cs t) = do (c,ts) <- checkInsts t [] return (cs,c,ts) checkInsts :: HsType -> [HsType] -> P ((HsQName,[HsType])) checkInsts (HsTyApp l t) ts = checkInsts l (t:ts) checkInsts (HsTyCon c) ts = return (c,ts) checkInsts _ _ = fail "Illegal instance declaration" ----------------------------------------------------------------------------- -- Checking Patterns. -- We parse patterns as expressions and check for valid patterns below, -- converting the expression into a pattern at the same time. checkPattern :: HsExp -> P HsPat checkPattern e = checkPat e [] checkPat :: HsExp -> [HsPat] -> P HsPat checkPat (HsCon c) args = return (HsPApp c args) checkPat (HsApp f x) args = do x <- checkPat x [] checkPat f (x:args) checkPat e [] = case e of HsVar (UnQual x) -> return (HsPVar x) HsLit l -> return (HsPLit l) HsInfixApp l op r -> do l <- checkPat l [] r <- checkPat r [] case op of HsQConOp c -> return (HsPInfixApp l c r) _ -> patFail HsTuple es -> do ps <- mapM (\e -> checkPat e []) es return (HsPTuple ps) HsList es -> do ps <- mapM (\e -> checkPat e []) es return (HsPList ps) HsParen e -> do p <- checkPat e [] return (HsPParen p) HsAsPat n e -> do p <- checkPat e [] return (HsPAsPat n p) HsWildCard -> return HsPWildCard HsIrrPat e -> do p <- checkPat e [] return (HsPIrrPat p) HsRecConstr c fs -> do fs <- mapM checkPatField fs return (HsPRec c fs) HsNegApp (HsLit l) -> return (HsPNeg (HsPLit l)) _ -> patFail checkPat _ _ = patFail checkPatField :: HsFieldUpdate -> P HsPatField checkPatField (HsFieldUpdate n e) = do p <- checkPat e [] return (HsPFieldPat n p) patFail :: P a patFail = fail "Parse error in pattern" ----------------------------------------------------------------------------- -- Check Expression Syntax checkExpr :: HsExp -> P HsExp checkExpr e = case e of HsVar _ -> return e HsCon _ -> return e HsLit _ -> return e HsInfixApp e1 op e2 -> check2Exprs e1 e2 (flip HsInfixApp op) HsApp e1 e2 -> check2Exprs e1 e2 HsApp HsNegApp e -> check1Expr e HsNegApp HsLambda loc ps e -> check1Expr e (HsLambda loc ps) HsLet bs e -> check1Expr e (HsLet bs) HsIf e1 e2 e3 -> check3Exprs e1 e2 e3 HsIf HsCase e alts -> do alts <- mapM checkAlt alts e <- checkExpr e return (HsCase e alts) HsDo stmts -> do stmts <- mapM checkStmt stmts return (HsDo stmts) HsTuple es -> checkManyExprs es HsTuple HsList es -> checkManyExprs es HsList HsParen e -> check1Expr e HsParen HsLeftSection e op -> check1Expr e (flip HsLeftSection op) HsRightSection op e -> check1Expr e (HsRightSection op) HsRecConstr c fields -> do fields <- mapM checkField fields return (HsRecConstr c fields) HsRecUpdate e fields -> do fields <- mapM checkField fields e <- checkExpr e return (HsRecUpdate e fields) HsEnumFrom e -> check1Expr e HsEnumFrom HsEnumFromTo e1 e2 -> check2Exprs e1 e2 HsEnumFromTo HsEnumFromThen e1 e2 -> check2Exprs e1 e2 HsEnumFromThen HsEnumFromThenTo e1 e2 e3 -> check3Exprs e1 e2 e3 HsEnumFromThenTo HsListComp e stmts -> do stmts <- mapM checkStmt stmts e <- checkExpr e return (HsListComp e stmts) HsExpTypeSig loc e ty -> do e <- checkExpr e return (HsExpTypeSig loc e ty) _ -> fail "Parse error in expression" -- type signature for polymorphic recursion!! check1Expr :: HsExp -> (HsExp -> a) -> P a check1Expr e1 f = do e1 <- checkExpr e1 return (f e1) check2Exprs :: HsExp -> HsExp -> (HsExp -> HsExp -> a) -> P a check2Exprs e1 e2 f = do e1 <- checkExpr e1 e2 <- checkExpr e2 return (f e1 e2) check3Exprs :: HsExp -> HsExp -> HsExp -> (HsExp -> HsExp -> HsExp -> a) -> P a check3Exprs e1 e2 e3 f = do e1 <- checkExpr e1 e2 <- checkExpr e2 e3 <- checkExpr e3 return (f e1 e2 e3) checkManyExprs :: [HsExp] -> ([HsExp] -> a) -> P a checkManyExprs es f = do es <- mapM checkExpr es return (f es) checkAlt :: HsAlt -> P HsAlt checkAlt (HsAlt loc p galts bs) = do galts <- checkGAlts galts return (HsAlt loc p galts bs) checkGAlts :: HsGuardedAlts -> P HsGuardedAlts checkGAlts (HsUnGuardedAlt e) = check1Expr e HsUnGuardedAlt checkGAlts (HsGuardedAlts galts) = do galts <- mapM checkGAlt galts return (HsGuardedAlts galts) checkGAlt :: HsGuardedAlt -> P HsGuardedAlt checkGAlt (HsGuardedAlt loc e1 e2) = check2Exprs e1 e2 (HsGuardedAlt loc) checkStmt :: HsStmt -> P HsStmt checkStmt (HsGenerator loc p e) = check1Expr e (HsGenerator loc p) checkStmt (HsQualifier e) = check1Expr e HsQualifier checkStmt s@(HsLetStmt _) = return s checkField :: HsFieldUpdate -> P HsFieldUpdate checkField (HsFieldUpdate n e) = check1Expr e (HsFieldUpdate n) ----------------------------------------------------------------------------- -- Check Equation Syntax checkValDef :: SrcLoc -> HsExp -> HsRhs -> [HsDecl] -> P HsDecl checkValDef srcloc lhs rhs whereBinds = case isFunLhs lhs [] of Just (f,es) -> do ps <- mapM checkPattern es return (HsFunBind [HsMatch srcloc f ps rhs whereBinds]) Nothing -> do lhs <- checkPattern lhs return (HsPatBind srcloc lhs rhs whereBinds) -- A variable binding is parsed as an HsPatBind. isFunLhs :: HsExp -> [HsExp] -> Maybe (HsName, [HsExp]) isFunLhs (HsInfixApp l (HsQVarOp (UnQual op)) r) es = Just (op, l:r:es) isFunLhs (HsApp (HsVar (UnQual f)) e) es = Just (f, e:es) isFunLhs (HsApp (HsParen f) e) es = isFunLhs f (e:es) isFunLhs (HsApp f e) es = isFunLhs f (e:es) isFunLhs _ _ = Nothing ----------------------------------------------------------------------------- -- In a class or instance body, a pattern binding must be of a variable. checkClassBody :: [HsDecl] -> P [HsDecl] checkClassBody decls = do mapM_ checkMethodDef decls return decls checkMethodDef :: HsDecl -> P () checkMethodDef (HsPatBind _ (HsPVar _) _ _) = return () checkMethodDef (HsPatBind loc _ _ _) = fail "illegal method definition" `atSrcLoc` loc checkMethodDef _ = return () ----------------------------------------------------------------------------- -- Check that an identifier or symbol is unqualified. -- For occasions when doing this in the grammar would cause conflicts. checkUnQual :: HsQName -> P HsName checkUnQual (Qual _ _) = fail "Illegal qualified name" checkUnQual (UnQual n) = return n checkUnQual (Special _) = fail "Illegal special name" ----------------------------------------------------------------------------- -- Miscellaneous utilities checkPrec :: Integer -> P Int checkPrec i | 0 <= i && i <= 9 = return (fromInteger i) checkPrec i | otherwise = fail ("Illegal precedence " ++ show i) mkRecConstrOrUpdate :: HsExp -> [HsFieldUpdate] -> P HsExp mkRecConstrOrUpdate (HsCon c) fs = return (HsRecConstr c fs) mkRecConstrOrUpdate e fs@(_:_) = return (HsRecUpdate e fs) mkRecConstrOrUpdate _ _ = fail "Empty record update" ----------------------------------------------------------------------------- -- Reverse a list of declarations, merging adjacent HsFunBinds of the -- same name and checking that their arities match. checkRevDecls :: [HsDecl] -> P [HsDecl] checkRevDecls = mergeFunBinds [] where mergeFunBinds revDs [] = return revDs mergeFunBinds revDs (HsFunBind ms1@(HsMatch _ name ps _ _:_):ds1) = mergeMatches ms1 ds1 where arity = length ps mergeMatches ms' (HsFunBind ms@(HsMatch loc name' ps' _ _:_):ds) | name' == name = if length ps' /= arity then fail ("arity mismatch for '" ++ prettyPrint name ++ "'") `atSrcLoc` loc else mergeMatches (ms++ms') ds mergeMatches ms' ds = mergeFunBinds (HsFunBind ms':revDs) ds mergeFunBinds revDs (d:ds) = mergeFunBinds (d:revDs) ds hugs98-plus-Sep2006/packages/haskell-src/Language/Haskell/Pretty.hs0000644006511100651110000005674610504340234023717 0ustar rossross{-# OPTIONS_GHC -w #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Pretty -- Copyright : (c) The GHC Team, Noel Winstanley 1997-2000 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Pretty printer for Haskell. -- ----------------------------------------------------------------------------- module Language.Haskell.Pretty ( -- * Pretty printing Pretty, prettyPrintStyleMode, prettyPrintWithMode, prettyPrint, -- * Pretty-printing styles (from "Text.PrettyPrint.HughesPJ") P.Style(..), P.style, P.Mode(..), -- * Haskell formatting modes PPHsMode(..), Indent, PPLayout(..), defaultMode) where import Language.Haskell.Syntax import qualified Text.PrettyPrint as P infixl 5 $$$ ----------------------------------------------------------------------------- -- | Varieties of layout we can use. data PPLayout = PPOffsideRule -- ^ classical layout | PPSemiColon -- ^ classical layout made explicit | PPInLine -- ^ inline decls, with newlines between them | PPNoLayout -- ^ everything on a single line deriving Eq type Indent = Int -- | Pretty-printing parameters. -- -- /Note:/ the 'onsideIndent' must be positive and less than all other indents. data PPHsMode = PPHsMode { -- | indentation of a class or instance classIndent :: Indent, -- | indentation of a @do@-expression doIndent :: Indent, -- | indentation of the body of a -- @case@ expression caseIndent :: Indent, -- | indentation of the declarations in a -- @let@ expression letIndent :: Indent, -- | indentation of the declarations in a -- @where@ clause whereIndent :: Indent, -- | indentation added for continuation -- lines that would otherwise be offside onsideIndent :: Indent, -- | blank lines between statements? spacing :: Bool, -- | Pretty-printing style to use layout :: PPLayout, -- | add GHC-style @LINE@ pragmas to output? linePragmas :: Bool, -- | not implemented yet comments :: Bool } -- | The default mode: pretty-print using the offside rule and sensible -- defaults. defaultMode :: PPHsMode defaultMode = PPHsMode{ classIndent = 8, doIndent = 3, caseIndent = 4, letIndent = 4, whereIndent = 6, onsideIndent = 2, spacing = True, layout = PPOffsideRule, linePragmas = False, comments = True } -- | Pretty printing monad newtype DocM s a = DocM (s -> a) instance Functor (DocM s) where fmap f xs = do x <- xs; return (f x) instance Monad (DocM s) where (>>=) = thenDocM (>>) = then_DocM return = retDocM {-# INLINE thenDocM #-} {-# INLINE then_DocM #-} {-# INLINE retDocM #-} {-# INLINE unDocM #-} {-# INLINE getPPEnv #-} thenDocM :: DocM s a -> (a -> DocM s b) -> DocM s b thenDocM m k = DocM $ (\s -> case unDocM m $ s of a -> unDocM (k a) $ s) then_DocM :: DocM s a -> DocM s b -> DocM s b then_DocM m k = DocM $ (\s -> case unDocM m $ s of _ -> unDocM k $ s) retDocM :: a -> DocM s a retDocM a = DocM (\_s -> a) unDocM :: DocM s a -> (s -> a) unDocM (DocM f) = f -- all this extra stuff, just for this one function. getPPEnv :: DocM s s getPPEnv = DocM id -- So that pp code still looks the same -- this means we lose some generality though -- | The document type produced by these pretty printers uses a 'PPHsMode' -- environment. type Doc = DocM PPHsMode P.Doc -- | Things that can be pretty-printed, including all the syntactic objects -- in "Language.Haskell.Syntax". class Pretty a where -- | Pretty-print something in isolation. pretty :: a -> Doc -- | Pretty-print something in a precedence context. prettyPrec :: Int -> a -> Doc pretty = prettyPrec 0 prettyPrec _ = pretty -- The pretty printing combinators empty :: Doc empty = return P.empty nest :: Int -> Doc -> Doc nest i m = m >>= return . P.nest i -- Literals text, ptext :: String -> Doc text = return . P.text ptext = return . P.text char :: Char -> Doc char = return . P.char int :: Int -> Doc int = return . P.int integer :: Integer -> Doc integer = return . P.integer float :: Float -> Doc float = return . P.float double :: Double -> Doc double = return . P.double rational :: Rational -> Doc rational = return . P.rational -- Simple Combining Forms parens, brackets, braces,quotes,doubleQuotes :: Doc -> Doc parens d = d >>= return . P.parens brackets d = d >>= return . P.brackets braces d = d >>= return . P.braces quotes d = d >>= return . P.quotes doubleQuotes d = d >>= return . P.doubleQuotes parensIf :: Bool -> Doc -> Doc parensIf True = parens parensIf False = id -- Constants semi,comma,colon,space,equals :: Doc semi = return P.semi comma = return P.comma colon = return P.colon space = return P.space equals = return P.equals lparen,rparen,lbrack,rbrack,lbrace,rbrace :: Doc lparen = return P.lparen rparen = return P.rparen lbrack = return P.lbrack rbrack = return P.rbrack lbrace = return P.lbrace rbrace = return P.rbrace -- Combinators (<>),(<+>),($$),($+$) :: Doc -> Doc -> Doc aM <> bM = do{a<-aM;b<-bM;return (a P.<> b)} aM <+> bM = do{a<-aM;b<-bM;return (a P.<+> b)} aM $$ bM = do{a<-aM;b<-bM;return (a P.$$ b)} aM $+$ bM = do{a<-aM;b<-bM;return (a P.$+$ b)} hcat,hsep,vcat,sep,cat,fsep,fcat :: [Doc] -> Doc hcat dl = sequence dl >>= return . P.hcat hsep dl = sequence dl >>= return . P.hsep vcat dl = sequence dl >>= return . P.vcat sep dl = sequence dl >>= return . P.sep cat dl = sequence dl >>= return . P.cat fsep dl = sequence dl >>= return . P.fsep fcat dl = sequence dl >>= return . P.fcat -- Some More hang :: Doc -> Int -> Doc -> Doc hang dM i rM = do{d<-dM;r<-rM;return $ P.hang d i r} -- Yuk, had to cut-n-paste this one from Pretty.hs punctuate :: Doc -> [Doc] -> [Doc] punctuate _ [] = [] punctuate p (d1:ds) = go d1 ds where go d [] = [d] go d (e:es) = (d <> p) : go e es -- | render the document with a given style and mode. renderStyleMode :: P.Style -> PPHsMode -> Doc -> String renderStyleMode ppStyle ppMode d = P.renderStyle ppStyle . unDocM d $ ppMode -- | render the document with a given mode. renderWithMode :: PPHsMode -> Doc -> String renderWithMode = renderStyleMode P.style -- | render the document with 'defaultMode'. render :: Doc -> String render = renderWithMode defaultMode -- | pretty-print with a given style and mode. prettyPrintStyleMode :: Pretty a => P.Style -> PPHsMode -> a -> String prettyPrintStyleMode ppStyle ppMode = renderStyleMode ppStyle ppMode . pretty -- | pretty-print with the default style and a given mode. prettyPrintWithMode :: Pretty a => PPHsMode -> a -> String prettyPrintWithMode = prettyPrintStyleMode P.style -- | pretty-print with the default style and 'defaultMode'. prettyPrint :: Pretty a => a -> String prettyPrint = prettyPrintWithMode defaultMode fullRenderWithMode :: PPHsMode -> P.Mode -> Int -> Float -> (P.TextDetails -> a -> a) -> a -> Doc -> a fullRenderWithMode ppMode m i f fn e mD = P.fullRender m i f fn e $ (unDocM mD) ppMode fullRender :: P.Mode -> Int -> Float -> (P.TextDetails -> a -> a) -> a -> Doc -> a fullRender = fullRenderWithMode defaultMode ------------------------- Pretty-Print a Module -------------------- instance Pretty HsModule where pretty (HsModule pos m mbExports imp decls) = markLine pos $ topLevel (ppHsModuleHeader m mbExports) (map pretty imp ++ map pretty decls) -------------------------- Module Header ------------------------------ ppHsModuleHeader :: Module -> Maybe [HsExportSpec] -> Doc ppHsModuleHeader m mbExportList = mySep [ text "module", pretty m, maybePP (parenList . map pretty) mbExportList, text "where"] instance Pretty Module where pretty (Module modName) = text modName instance Pretty HsExportSpec where pretty (HsEVar name) = pretty name pretty (HsEAbs name) = pretty name pretty (HsEThingAll name) = pretty name <> text "(..)" pretty (HsEThingWith name nameList) = pretty name <> (parenList . map pretty $ nameList) pretty (HsEModuleContents m) = text "module" <+> pretty m instance Pretty HsImportDecl where pretty (HsImportDecl pos m qual mbName mbSpecs) = markLine pos $ mySep [text "import", if qual then text "qualified" else empty, pretty m, maybePP (\m' -> text "as" <+> pretty m') mbName, maybePP exports mbSpecs] where exports (b,specList) = if b then text "hiding" <+> specs else specs where specs = parenList . map pretty $ specList instance Pretty HsImportSpec where pretty (HsIVar name) = pretty name pretty (HsIAbs name) = pretty name pretty (HsIThingAll name) = pretty name <> text "(..)" pretty (HsIThingWith name nameList) = pretty name <> (parenList . map pretty $ nameList) ------------------------- Declarations ------------------------------ instance Pretty HsDecl where pretty (HsTypeDecl loc name nameList htype) = blankline $ markLine loc $ mySep ( [text "type", pretty name] ++ map pretty nameList ++ [equals, pretty htype]) pretty (HsDataDecl loc context name nameList constrList derives) = blankline $ markLine loc $ mySep ( [text "data", ppHsContext context, pretty name] ++ map pretty nameList) <+> (myVcat (zipWith (<+>) (equals : repeat (char '|')) (map pretty constrList)) $$$ ppHsDeriving derives) pretty (HsNewTypeDecl pos context name nameList constr derives) = blankline $ markLine pos $ mySep ( [text "newtype", ppHsContext context, pretty name] ++ map pretty nameList) <+> equals <+> (pretty constr $$$ ppHsDeriving derives) --m{spacing=False} -- special case for empty class declaration pretty (HsClassDecl pos context name nameList []) = blankline $ markLine pos $ mySep ( [text "class", ppHsContext context, pretty name] ++ map pretty nameList) pretty (HsClassDecl pos context name nameList declList) = blankline $ markLine pos $ mySep ( [text "class", ppHsContext context, pretty name] ++ map pretty nameList ++ [text "where"]) $$$ ppBody classIndent (map pretty declList) -- m{spacing=False} -- special case for empty instance declaration pretty (HsInstDecl pos context name args []) = blankline $ markLine pos $ mySep ( [text "instance", ppHsContext context, pretty name] ++ map ppHsAType args) pretty (HsInstDecl pos context name args declList) = blankline $ markLine pos $ mySep ( [text "instance", ppHsContext context, pretty name] ++ map ppHsAType args ++ [text "where"]) $$$ ppBody classIndent (map pretty declList) pretty (HsDefaultDecl pos htypes) = blankline $ markLine pos $ text "default" <+> parenList (map pretty htypes) pretty (HsTypeSig pos nameList qualType) = blankline $ markLine pos $ mySep ((punctuate comma . map pretty $ nameList) ++ [text "::", pretty qualType]) pretty (HsFunBind matches) = foldr ($$$) empty (map pretty matches) pretty (HsPatBind pos pat rhs whereDecls) = markLine pos $ myFsep [pretty pat, pretty rhs] $$$ ppWhere whereDecls pretty (HsInfixDecl pos assoc prec opList) = blankline $ markLine pos $ mySep ([pretty assoc, int prec] ++ (punctuate comma . map pretty $ opList)) instance Pretty HsAssoc where pretty HsAssocNone = text "infix" pretty HsAssocLeft = text "infixl" pretty HsAssocRight = text "infixr" instance Pretty HsMatch where pretty (HsMatch pos f ps rhs whereDecls) = markLine pos $ myFsep (lhs ++ [pretty rhs]) $$$ ppWhere whereDecls where lhs = case ps of l:r:ps' | isSymbolName f -> let hd = [pretty l, ppHsName f, pretty r] in if null ps' then hd else parens (myFsep hd) : map (prettyPrec 2) ps' _ -> pretty f : map (prettyPrec 2) ps ppWhere :: [HsDecl] -> Doc ppWhere [] = empty ppWhere l = nest 2 (text "where" $$$ ppBody whereIndent (map pretty l)) ------------------------- Data & Newtype Bodies ------------------------- instance Pretty HsConDecl where pretty (HsRecDecl _pos name fieldList) = pretty name <> (braceList . map ppField $ fieldList) pretty (HsConDecl _pos name@(HsSymbol _) [l, r]) = myFsep [prettyPrec prec_btype l, ppHsName name, prettyPrec prec_btype r] pretty (HsConDecl _pos name typeList) = mySep $ ppHsName name : map (prettyPrec prec_atype) typeList ppField :: ([HsName],HsBangType) -> Doc ppField (names, ty) = myFsepSimple $ (punctuate comma . map pretty $ names) ++ [text "::", pretty ty] instance Pretty HsBangType where prettyPrec _ (HsBangedTy ty) = char '!' <> ppHsAType ty prettyPrec p (HsUnBangedTy ty) = prettyPrec p ty ppHsDeriving :: [HsQName] -> Doc ppHsDeriving [] = empty ppHsDeriving [d] = text "deriving" <+> ppHsQName d ppHsDeriving ds = text "deriving" <+> parenList (map ppHsQName ds) ------------------------- Types ------------------------- instance Pretty HsQualType where pretty (HsQualType context htype) = myFsep [ppHsContext context, pretty htype] ppHsBType :: HsType -> Doc ppHsBType = prettyPrec prec_btype ppHsAType :: HsType -> Doc ppHsAType = prettyPrec prec_atype -- precedences for types prec_btype, prec_atype :: Int prec_btype = 1 -- left argument of ->, -- or either argument of an infix data constructor prec_atype = 2 -- argument of type or data constructor, or of a class instance Pretty HsType where prettyPrec p (HsTyFun a b) = parensIf (p > 0) $ myFsep [ppHsBType a, text "->", pretty b] prettyPrec _ (HsTyTuple l) = parenList . map pretty $ l prettyPrec p (HsTyApp a b) | a == list_tycon = brackets $ pretty b -- special case | otherwise = parensIf (p > prec_btype) $ myFsep [pretty a, ppHsAType b] prettyPrec _ (HsTyVar name) = pretty name prettyPrec _ (HsTyCon name) = pretty name ------------------------- Expressions ------------------------- instance Pretty HsRhs where pretty (HsUnGuardedRhs e) = equals <+> pretty e pretty (HsGuardedRhss guardList) = myVcat . map pretty $ guardList instance Pretty HsGuardedRhs where pretty (HsGuardedRhs _pos guard body) = myFsep [char '|', pretty guard, equals, pretty body] instance Pretty HsLiteral where pretty (HsInt i) = integer i pretty (HsChar c) = text (show c) pretty (HsString s) = text (show s) pretty (HsFrac r) = double (fromRational r) -- GHC unboxed literals: pretty (HsCharPrim c) = text (show c) <> char '#' pretty (HsStringPrim s) = text (show s) <> char '#' pretty (HsIntPrim i) = integer i <> char '#' pretty (HsFloatPrim r) = float (fromRational r) <> char '#' pretty (HsDoublePrim r) = double (fromRational r) <> text "##" instance Pretty HsExp where pretty (HsLit l) = pretty l -- lambda stuff pretty (HsInfixApp a op b) = myFsep [pretty a, pretty op, pretty b] pretty (HsNegApp e) = myFsep [char '-', pretty e] pretty (HsApp a b) = myFsep [pretty a, pretty b] pretty (HsLambda _loc expList body) = myFsep $ char '\\' : map pretty expList ++ [text "->", pretty body] -- keywords pretty (HsLet expList letBody) = myFsep [text "let" <+> ppBody letIndent (map pretty expList), text "in", pretty letBody] pretty (HsIf cond thenexp elsexp) = myFsep [text "if", pretty cond, text "then", pretty thenexp, text "else", pretty elsexp] pretty (HsCase cond altList) = myFsep [text "case", pretty cond, text "of"] $$$ ppBody caseIndent (map pretty altList) pretty (HsDo stmtList) = text "do" $$$ ppBody doIndent (map pretty stmtList) -- Constructors & Vars pretty (HsVar name) = pretty name pretty (HsCon name) = pretty name pretty (HsTuple expList) = parenList . map pretty $ expList -- weird stuff pretty (HsParen e) = parens . pretty $ e pretty (HsLeftSection e op) = parens (pretty e <+> pretty op) pretty (HsRightSection op e) = parens (pretty op <+> pretty e) pretty (HsRecConstr c fieldList) = pretty c <> (braceList . map pretty $ fieldList) pretty (HsRecUpdate e fieldList) = pretty e <> (braceList . map pretty $ fieldList) -- patterns -- special case that would otherwise be buggy pretty (HsAsPat name (HsIrrPat e)) = myFsep [pretty name <> char '@', char '~' <> pretty e] pretty (HsAsPat name e) = hcat [pretty name, char '@', pretty e] pretty HsWildCard = char '_' pretty (HsIrrPat e) = char '~' <> pretty e -- Lists pretty (HsList list) = bracketList . punctuate comma . map pretty $ list pretty (HsEnumFrom e) = bracketList [pretty e, text ".."] pretty (HsEnumFromTo from to) = bracketList [pretty from, text "..", pretty to] pretty (HsEnumFromThen from thenE) = bracketList [pretty from <> comma, pretty thenE, text ".."] pretty (HsEnumFromThenTo from thenE to) = bracketList [pretty from <> comma, pretty thenE, text "..", pretty to] pretty (HsListComp e stmtList) = bracketList ([pretty e, char '|'] ++ (punctuate comma . map pretty $ stmtList)) pretty (HsExpTypeSig _pos e ty) = myFsep [pretty e, text "::", pretty ty] ------------------------- Patterns ----------------------------- instance Pretty HsPat where prettyPrec _ (HsPVar name) = pretty name prettyPrec _ (HsPLit lit) = pretty lit prettyPrec _ (HsPNeg p) = myFsep [char '-', pretty p] prettyPrec p (HsPInfixApp a op b) = parensIf (p > 0) $ myFsep [pretty a, pretty (HsQConOp op), pretty b] prettyPrec p (HsPApp n ps) = parensIf (p > 1) $ myFsep (pretty n : map pretty ps) prettyPrec _ (HsPTuple ps) = parenList . map pretty $ ps prettyPrec _ (HsPList ps) = bracketList . punctuate comma . map pretty $ ps prettyPrec _ (HsPParen p) = parens . pretty $ p prettyPrec _ (HsPRec c fields) = pretty c <> (braceList . map pretty $ fields) -- special case that would otherwise be buggy prettyPrec _ (HsPAsPat name (HsPIrrPat pat)) = myFsep [pretty name <> char '@', char '~' <> pretty pat] prettyPrec _ (HsPAsPat name pat) = hcat [pretty name, char '@', pretty pat] prettyPrec _ HsPWildCard = char '_' prettyPrec _ (HsPIrrPat pat) = char '~' <> pretty pat instance Pretty HsPatField where pretty (HsPFieldPat name pat) = myFsep [pretty name, equals, pretty pat] ------------------------- Case bodies ------------------------- instance Pretty HsAlt where pretty (HsAlt _pos e gAlts decls) = pretty e <+> pretty gAlts $$$ ppWhere decls instance Pretty HsGuardedAlts where pretty (HsUnGuardedAlt e) = text "->" <+> pretty e pretty (HsGuardedAlts altList) = myVcat . map pretty $ altList instance Pretty HsGuardedAlt where pretty (HsGuardedAlt _pos e body) = myFsep [char '|', pretty e, text "->", pretty body] ------------------------- Statements in monads & list comprehensions ----- instance Pretty HsStmt where pretty (HsGenerator _loc e from) = pretty e <+> text "<-" <+> pretty from pretty (HsQualifier e) = pretty e pretty (HsLetStmt declList) = text "let" $$$ ppBody letIndent (map pretty declList) ------------------------- Record updates instance Pretty HsFieldUpdate where pretty (HsFieldUpdate name e) = myFsep [pretty name, equals, pretty e] ------------------------- Names ------------------------- instance Pretty HsQOp where pretty (HsQVarOp n) = ppHsQNameInfix n pretty (HsQConOp n) = ppHsQNameInfix n ppHsQNameInfix :: HsQName -> Doc ppHsQNameInfix name | isSymbolName (getName name) = ppHsQName name | otherwise = char '`' <> ppHsQName name <> char '`' instance Pretty HsQName where pretty name = parensIf (isSymbolName (getName name)) (ppHsQName name) ppHsQName :: HsQName -> Doc ppHsQName (UnQual name) = ppHsName name ppHsQName (Qual m name) = pretty m <> char '.' <> ppHsName name ppHsQName (Special sym) = text (specialName sym) instance Pretty HsOp where pretty (HsVarOp n) = ppHsNameInfix n pretty (HsConOp n) = ppHsNameInfix n ppHsNameInfix :: HsName -> Doc ppHsNameInfix name | isSymbolName name = ppHsName name | otherwise = char '`' <> ppHsName name <> char '`' instance Pretty HsName where pretty name = parensIf (isSymbolName name) (ppHsName name) ppHsName :: HsName -> Doc ppHsName (HsIdent s) = text s ppHsName (HsSymbol s) = text s instance Pretty HsCName where pretty (HsVarName n) = pretty n pretty (HsConName n) = pretty n isSymbolName :: HsName -> Bool isSymbolName (HsSymbol _) = True isSymbolName _ = False getName :: HsQName -> HsName getName (UnQual s) = s getName (Qual _ s) = s getName (Special HsCons) = HsSymbol ":" getName (Special HsFunCon) = HsSymbol "->" getName (Special s) = HsIdent (specialName s) specialName :: HsSpecialCon -> String specialName HsUnitCon = "()" specialName HsListCon = "[]" specialName HsFunCon = "->" specialName (HsTupleCon n) = "(" ++ replicate (n-1) ',' ++ ")" specialName HsCons = ":" ppHsContext :: HsContext -> Doc ppHsContext [] = empty ppHsContext context = mySep [parenList (map ppHsAsst context), text "=>"] -- hacked for multi-parameter type classes ppHsAsst :: HsAsst -> Doc ppHsAsst (a,ts) = myFsep (ppHsQName a : map ppHsAType ts) ------------------------- pp utils ------------------------- maybePP :: (a -> Doc) -> Maybe a -> Doc maybePP _ Nothing = empty maybePP pp (Just a) = pp a parenList :: [Doc] -> Doc parenList = parens . myFsepSimple . punctuate comma braceList :: [Doc] -> Doc braceList = braces . myFsepSimple . punctuate comma bracketList :: [Doc] -> Doc bracketList = brackets . myFsepSimple -- Wrap in braces and semicolons, with an extra space at the start in -- case the first doc begins with "-", which would be scanned as {- flatBlock :: [Doc] -> Doc flatBlock = braces . (space <>) . hsep . punctuate semi -- Same, but put each thing on a separate line prettyBlock :: [Doc] -> Doc prettyBlock = braces . (space <>) . vcat . punctuate semi -- Monadic PP Combinators -- these examine the env blankline :: Doc -> Doc blankline dl = do{e<-getPPEnv;if spacing e && layout e /= PPNoLayout then space $$ dl else dl} topLevel :: Doc -> [Doc] -> Doc topLevel header dl = do e <- fmap layout getPPEnv case e of PPOffsideRule -> header $$ vcat dl PPSemiColon -> header $$ prettyBlock dl PPInLine -> header $$ prettyBlock dl PPNoLayout -> header <+> flatBlock dl ppBody :: (PPHsMode -> Int) -> [Doc] -> Doc ppBody f dl = do e <- fmap layout getPPEnv case e of PPOffsideRule -> indent PPSemiColon -> indentExplicit _ -> flatBlock dl where indent = do{i <-fmap f getPPEnv;nest i . vcat $ dl} indentExplicit = do {i <- fmap f getPPEnv; nest i . prettyBlock $ dl} ($$$) :: Doc -> Doc -> Doc a $$$ b = layoutChoice (a $$) (a <+>) b mySep :: [Doc] -> Doc mySep = layoutChoice mySep' hsep where -- ensure paragraph fills with indentation. mySep' [x] = x mySep' (x:xs) = x <+> fsep xs mySep' [] = error "Internal error: mySep" myVcat :: [Doc] -> Doc myVcat = layoutChoice vcat hsep myFsepSimple :: [Doc] -> Doc myFsepSimple = layoutChoice fsep hsep -- same, except that continuation lines are indented, -- which is necessary to avoid triggering the offside rule. myFsep :: [Doc] -> Doc myFsep = layoutChoice fsep' hsep where fsep' [] = empty fsep' (d:ds) = do e <- getPPEnv let n = onsideIndent e nest n (fsep (nest (-n) d:ds)) layoutChoice :: (a -> Doc) -> (a -> Doc) -> a -> Doc layoutChoice a b dl = do e <- getPPEnv if layout e == PPOffsideRule || layout e == PPSemiColon then a dl else b dl -- Prefix something with a LINE pragma, if requested. -- GHC's LINE pragma actually sets the current line number to n-1, so -- that the following line is line n. But if there's no newline before -- the line we're talking about, we need to compensate by adding 1. markLine :: SrcLoc -> Doc -> Doc markLine loc doc = do e <- getPPEnv let y = srcLine loc let line l = text ("{-# LINE " ++ show l ++ " \"" ++ srcFilename loc ++ "\" #-}") if linePragmas e then layoutChoice (line y $$) (line (y+1) <+>) doc else doc hugs98-plus-Sep2006/packages/haskell-src/Language/Haskell/Syntax.hs0000644006511100651110000004053210504340234023700 0ustar rossross{-# OPTIONS_GHC -fglasgow-exts -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Syntax -- Copyright : (c) The GHC Team, 1997-2000 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- A suite of datatypes describing the abstract syntax of Haskell 98 -- plus a few extensions: -- -- * multi-parameter type classes -- -- * parameters of type class assertions are unrestricted -- -- This module has been changed so that show is a real show. -- For GHC, we also derive Typeable and Data for all types. ----------------------------------------------------------------------------- module Language.Haskell.Syntax ( -- * Modules HsModule(..), HsExportSpec(..), HsImportDecl(..), HsImportSpec(..), HsAssoc(..), -- * Declarations HsDecl(..), HsConDecl(..), HsBangType(..), HsMatch(..), HsRhs(..), HsGuardedRhs(..), -- * Class Assertions and Contexts HsQualType(..), HsContext, HsAsst, -- * Types HsType(..), -- * Expressions HsExp(..), HsStmt(..), HsFieldUpdate(..), HsAlt(..), HsGuardedAlts(..), HsGuardedAlt(..), -- * Patterns HsPat(..), HsPatField(..), -- * Literals HsLiteral(..), -- * Variables, Constructors and Operators Module(..), HsQName(..), HsName(..), HsQOp(..), HsOp(..), HsSpecialCon(..), HsCName(..), -- * Builtin names -- ** Modules prelude_mod, main_mod, -- ** Main function of a program main_name, -- ** Constructors unit_con_name, tuple_con_name, list_cons_name, unit_con, tuple_con, -- ** Special identifiers as_name, qualified_name, hiding_name, minus_name, pling_name, -- ** Type constructors unit_tycon_name, fun_tycon_name, list_tycon_name, tuple_tycon_name, unit_tycon, fun_tycon, list_tycon, tuple_tycon, -- * Source coordinates SrcLoc(..), ) where #ifdef __GLASGOW_HASKELL__ import Data.Generics.Basics import Data.Generics.Instances #endif -- | A position in the source. data SrcLoc = SrcLoc { srcFilename :: String, srcLine :: Int, srcColumn :: Int } #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | The name of a Haskell module. newtype Module = Module String #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Constructors with special syntax. -- These names are never qualified, and always refer to builtin type or -- data constructors. data HsSpecialCon = HsUnitCon -- ^ unit type and data constructor @()@ | HsListCon -- ^ list type constructor @[]@ | HsFunCon -- ^ function type constructor @->@ | HsTupleCon Int -- ^ /n/-ary tuple type and data -- constructors @(,)@ etc | HsCons -- ^ list data constructor @(:)@ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | This type is used to represent qualified variables, and also -- qualified constructors. data HsQName = Qual Module HsName -- ^ name qualified with a module name | UnQual HsName -- ^ unqualified name | Special HsSpecialCon -- ^ built-in constructor with special syntax #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | This type is used to represent variables, and also constructors. data HsName = HsIdent String -- ^ /varid/ or /conid/ | HsSymbol String -- ^ /varsym/ or /consym/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Possibly qualified infix operators (/qop/), appearing in expressions. data HsQOp = HsQVarOp HsQName -- ^ variable operator (/qvarop/) | HsQConOp HsQName -- ^ constructor operator (/qconop/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | Operators, appearing in @infix@ declarations. data HsOp = HsVarOp HsName -- ^ variable operator (/varop/) | HsConOp HsName -- ^ constructor operator (/conop/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A name (/cname/) of a component of a class or data type in an @import@ -- or export specification. data HsCName = HsVarName HsName -- ^ name of a method or field | HsConName HsName -- ^ name of a data constructor #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else deriving (Eq,Ord,Show) #endif -- | A Haskell source module. data HsModule = HsModule SrcLoc Module (Maybe [HsExportSpec]) [HsImportDecl] [HsDecl] #ifdef __GLASGOW_HASKELL__ deriving (Show,Typeable,Data) #else deriving (Show) #endif -- | Export specification. data HsExportSpec = HsEVar HsQName -- ^ variable | HsEAbs HsQName -- ^ @T@: -- a class or datatype exported abstractly, -- or a type synonym. | HsEThingAll HsQName -- ^ @T(..)@: -- a class exported with all of its methods, or -- a datatype exported with all of its constructors. | HsEThingWith HsQName [HsCName] -- ^ @T(C_1,...,C_n)@: -- a class exported with some of its methods, or -- a datatype exported with some of its constructors. | HsEModuleContents Module -- ^ @module M@: -- re-export a module. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | Import declaration. data HsImportDecl = HsImportDecl { importLoc :: SrcLoc -- ^ position of the @import@ keyword. , importModule :: Module -- ^ name of the module imported. , importQualified :: Bool -- ^ imported @qualified@? , importAs :: Maybe Module -- ^ optional alias name in an -- @as@ clause. , importSpecs :: Maybe (Bool,[HsImportSpec]) -- ^ optional list of import specifications. -- The 'Bool' is 'True' if the names are excluded -- by @hiding@. } #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | Import specification. data HsImportSpec = HsIVar HsName -- ^ variable | HsIAbs HsName -- ^ @T@: -- the name of a class, datatype or type synonym. | HsIThingAll HsName -- ^ @T(..)@: -- a class imported with all of its methods, or -- a datatype imported with all of its constructors. | HsIThingWith HsName [HsCName] -- ^ @T(C_1,...,C_n)@: -- a class imported with some of its methods, or -- a datatype imported with some of its constructors. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | Associativity of an operator. data HsAssoc = HsAssocNone -- ^ non-associative operator (declared with @infix@) | HsAssocLeft -- ^ left-associative operator (declared with @infixl@). | HsAssocRight -- ^ right-associative operator (declared with @infixr@) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif data HsDecl = HsTypeDecl SrcLoc HsName [HsName] HsType | HsDataDecl SrcLoc HsContext HsName [HsName] [HsConDecl] [HsQName] | HsInfixDecl SrcLoc HsAssoc Int [HsOp] | HsNewTypeDecl SrcLoc HsContext HsName [HsName] HsConDecl [HsQName] | HsClassDecl SrcLoc HsContext HsName [HsName] [HsDecl] | HsInstDecl SrcLoc HsContext HsQName [HsType] [HsDecl] | HsDefaultDecl SrcLoc [HsType] | HsTypeSig SrcLoc [HsName] HsQualType | HsFunBind [HsMatch] | HsPatBind SrcLoc HsPat HsRhs {-where-} [HsDecl] #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | Clauses of a function binding. data HsMatch = HsMatch SrcLoc HsName [HsPat] HsRhs {-where-} [HsDecl] #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | Declaration of a data constructor. data HsConDecl = HsConDecl SrcLoc HsName [HsBangType] -- ^ ordinary data constructor | HsRecDecl SrcLoc HsName [([HsName],HsBangType)] -- ^ record constructor #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | The type of a constructor argument or field, optionally including -- a strictness annotation. data HsBangType = HsBangedTy HsType -- ^ strict component, marked with \"@!@\" | HsUnBangedTy HsType -- ^ non-strict component #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | The right hand side of a function or pattern binding. data HsRhs = HsUnGuardedRhs HsExp -- ^ unguarded right hand side (/exp/) | HsGuardedRhss [HsGuardedRhs] -- ^ guarded right hand side (/gdrhs/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | A guarded right hand side @|@ /exp/ @=@ /exp/. -- The first expression will be Boolean-valued. data HsGuardedRhs = HsGuardedRhs SrcLoc HsExp HsExp #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | A type qualified with a context. -- An unqualified type has an empty context. data HsQualType = HsQualType HsContext HsType #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | Haskell types and type constructors. data HsType = HsTyFun HsType HsType -- ^ function type | HsTyTuple [HsType] -- ^ tuple type | HsTyApp HsType HsType -- ^ application of a type constructor | HsTyVar HsName -- ^ type variable | HsTyCon HsQName -- ^ named type or type constructor #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif type HsContext = [HsAsst] -- | Class assertions. -- In Haskell 98, the argument would be a /tyvar/, but this definition -- allows multiple parameters, and allows them to be /type/s. type HsAsst = (HsQName,[HsType]) -- | /literal/. -- Values of this type hold the abstract value of the literal, not the -- precise string representation used. For example, @10@, @0o12@ and @0xa@ -- have the same representation. data HsLiteral = HsChar Char -- ^ character literal | HsString String -- ^ string literal | HsInt Integer -- ^ integer literal | HsFrac Rational -- ^ floating point literal | HsCharPrim Char -- ^ GHC unboxed character literal | HsStringPrim String -- ^ GHC unboxed string literal | HsIntPrim Integer -- ^ GHC unboxed integer literal | HsFloatPrim Rational -- ^ GHC unboxed float literal | HsDoublePrim Rational -- ^ GHC unboxed double literal #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | Haskell expressions. -- -- /Notes:/ -- -- * Because it is difficult for parsers to distinguish patterns from -- expressions, they typically parse them in the same way and then check -- that they have the appropriate form. Hence the expression type -- includes some forms that are found only in patterns. After these -- checks, these constructors should not be used. -- -- * The parser does not take precedence and associativity into account, -- so it will leave 'HsInfixApp's associated to the left. -- -- * The 'Language.Haskell.Pretty.Pretty' instance for 'HsExp' does not -- add parentheses in printing. data HsExp = HsVar HsQName -- ^ variable | HsCon HsQName -- ^ data constructor | HsLit HsLiteral -- ^ literal constant | HsInfixApp HsExp HsQOp HsExp -- ^ infix application | HsApp HsExp HsExp -- ^ ordinary application | HsNegApp HsExp -- ^ negation expression @-@ /exp/ | HsLambda SrcLoc [HsPat] HsExp -- ^ lambda expression | HsLet [HsDecl] HsExp -- ^ local declarations with @let@ | HsIf HsExp HsExp HsExp -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/ | HsCase HsExp [HsAlt] -- ^ @case@ /exp/ @of@ /alts/ | HsDo [HsStmt] -- ^ @do@-expression: -- the last statement in the list -- should be an expression. | HsTuple [HsExp] -- ^ tuple expression | HsList [HsExp] -- ^ list expression | HsParen HsExp -- ^ parenthesized expression | HsLeftSection HsExp HsQOp -- ^ left section @(@/exp/ /qop/@)@ | HsRightSection HsQOp HsExp -- ^ right section @(@/qop/ /exp/@)@ | HsRecConstr HsQName [HsFieldUpdate] -- ^ record construction expression | HsRecUpdate HsExp [HsFieldUpdate] -- ^ record update expression | HsEnumFrom HsExp -- ^ unbounded arithmetic sequence, -- incrementing by 1 | HsEnumFromTo HsExp HsExp -- ^ bounded arithmetic sequence, -- incrementing by 1 | HsEnumFromThen HsExp HsExp -- ^ unbounded arithmetic sequence, -- with first two elements given | HsEnumFromThenTo HsExp HsExp HsExp -- ^ bounded arithmetic sequence, -- with first two elements given | HsListComp HsExp [HsStmt] -- ^ list comprehension | HsExpTypeSig SrcLoc HsExp HsQualType -- ^ expression type signature | HsAsPat HsName HsExp -- ^ patterns only | HsWildCard -- ^ patterns only | HsIrrPat HsExp -- ^ patterns only #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | A pattern, to be matched against a value. data HsPat = HsPVar HsName -- ^ variable | HsPLit HsLiteral -- ^ literal constant | HsPNeg HsPat -- ^ negated pattern | HsPInfixApp HsPat HsQName HsPat -- ^ pattern with infix data constructor | HsPApp HsQName [HsPat] -- ^ data constructor and argument -- patterns | HsPTuple [HsPat] -- ^ tuple pattern | HsPList [HsPat] -- ^ list pattern | HsPParen HsPat -- ^ parenthesized pattern | HsPRec HsQName [HsPatField] -- ^ labelled pattern | HsPAsPat HsName HsPat -- ^ @\@@-pattern | HsPWildCard -- ^ wildcard pattern (@_@) | HsPIrrPat HsPat -- ^ irrefutable pattern (@~@) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | An /fpat/ in a labeled record pattern. data HsPatField = HsPFieldPat HsQName HsPat #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | This type represents both /stmt/ in a @do@-expression, -- and /qual/ in a list comprehension. data HsStmt = HsGenerator SrcLoc HsPat HsExp -- ^ a generator /pat/ @<-@ /exp/ | HsQualifier HsExp -- ^ an /exp/ by itself: in a @do@-expression, -- an action whose result is discarded; -- in a list comprehension, a guard expression | HsLetStmt [HsDecl] -- ^ local bindings #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | An /fbind/ in a labeled record construction or update expression. data HsFieldUpdate = HsFieldUpdate HsQName HsExp #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | An /alt/ in a @case@ expression. data HsAlt = HsAlt SrcLoc HsPat HsGuardedAlts [HsDecl] #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif data HsGuardedAlts = HsUnGuardedAlt HsExp -- ^ @->@ /exp/ | HsGuardedAlts [HsGuardedAlt] -- ^ /gdpat/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif -- | A guarded alternative @|@ /exp/ @->@ /exp/. -- The first expression will be Boolean-valued. data HsGuardedAlt = HsGuardedAlt SrcLoc HsExp HsExp #ifdef __GLASGOW_HASKELL__ deriving (Eq,Show,Typeable,Data) #else deriving (Eq,Show) #endif ----------------------------------------------------------------------------- -- Builtin names. prelude_mod, main_mod :: Module prelude_mod = Module "Prelude" main_mod = Module "Main" main_name :: HsName main_name = HsIdent "main" unit_con_name :: HsQName unit_con_name = Special HsUnitCon tuple_con_name :: Int -> HsQName tuple_con_name i = Special (HsTupleCon (i+1)) list_cons_name :: HsQName list_cons_name = Special HsCons unit_con :: HsExp unit_con = HsCon unit_con_name tuple_con :: Int -> HsExp tuple_con i = HsCon (tuple_con_name i) as_name, qualified_name, hiding_name, minus_name, pling_name :: HsName as_name = HsIdent "as" qualified_name = HsIdent "qualified" hiding_name = HsIdent "hiding" minus_name = HsSymbol "-" pling_name = HsSymbol "!" unit_tycon_name, fun_tycon_name, list_tycon_name :: HsQName unit_tycon_name = unit_con_name fun_tycon_name = Special HsFunCon list_tycon_name = Special HsListCon tuple_tycon_name :: Int -> HsQName tuple_tycon_name i = tuple_con_name i unit_tycon, fun_tycon, list_tycon :: HsType unit_tycon = HsTyCon unit_tycon_name fun_tycon = HsTyCon fun_tycon_name list_tycon = HsTyCon list_tycon_name tuple_tycon :: Int -> HsType tuple_tycon i = HsTyCon (tuple_tycon_name i) hugs98-plus-Sep2006/packages/haskell-src/LICENSE0000644006511100651110000000311310504340234017747 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/haskell-src/Makefile.inc0000644006511100651110000000022310504340234021151 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/haskell-src/Makefile0000644006511100651110000000116110504340234020403 0ustar rossross# ----------------------------------------------------------------------------- TOP=.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- ifeq "$(IncludeExampleDirsInBuild)" "YES" SUBDIRS += examples endif ALL_DIRS = Language/Haskell PACKAGE = haskell-src VERSION = 1.0 PACKAGE_DEPS = base Language/Haskell/Parser_HC_OPTS += -Onot -fno-warn-incomplete-patterns SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/haskell-src/examples/0000755006511100651110000000000010504340234020562 5ustar rossrosshugs98-plus-Sep2006/packages/haskell-src/examples/hsparser.hs0000644006511100651110000000763410504340234022757 0ustar rossross-- A simple test program for the Haskell parser, -- originally written by Sven Panne. module Main (main, mainArgs, testLexer) where import Data.List import Language.Haskell.Lexer (lexer, Token(EOF)) import Language.Haskell.ParseMonad (runParserWithMode) import Language.Haskell.Parser import Language.Haskell.Syntax import Language.Haskell.Pretty import System.Environment import System.Console.GetOpt data Flag = LexOnlyLength -- print number of tokens only | LexOnlyRev -- print tokens in reverse order | LexOnly -- print tokens | ParseLength -- print number of declarations only | ParseInternal -- print abstract syntax in internal format | ParsePretty PPLayout -- pretty print in this style | Help -- give short usage info title :: String title = "A simple test program for the haskell-src package" usage :: String usage = "usage: hsparser [option] [filename]\n" options :: [OptDescr Flag] options = [ Option ['n'] ["numtokens"] (NoArg LexOnlyLength) "print number of tokens only", Option ['r'] ["revtokens"] (NoArg LexOnlyRev) "print tokens in reverse order", Option ['t'] ["tokens"] (NoArg LexOnly) "print tokens", Option ['d'] ["numdecls"] (NoArg ParseLength) "print number of declarations only", Option ['a'] ["abstract"] (NoArg ParseInternal) "print abstract syntax in internal format", Option ['p'] ["pretty"] (OptArg pStyle "STYLE") "pretty print in STYLE[(o)ffside|(s)emicolon|(i)nline|(n)one](default = offside)", Option ['h','?'] ["help"] (NoArg Help) "display this help and exit"] pStyle :: Maybe String -> Flag pStyle Nothing = ParsePretty PPOffsideRule pStyle (Just s) = ParsePretty $ case s of "o" -> PPOffsideRule "offside" -> PPOffsideRule "s" -> PPSemiColon "semicolon" -> PPSemiColon "i" -> PPInLine "inline" -> PPInLine "n" -> PPNoLayout "none" -> PPNoLayout _ -> PPOffsideRule main :: IO () main = do args <- getArgs mainArgs args mainArgs :: [String] -> IO () mainArgs cmdline = case getOpt Permute options cmdline of (flags, args, []) -> do inp <- case args of [] -> getContents [f] -> readFile f _ -> error usage let parse_mode = case args of [] -> defaultParseMode [f] -> defaultParseMode {parseFilename = f} putStrLn (handleFlag (getFlag flags) parse_mode inp) (_, _, errors) -> error (concat errors ++ usageInfo usage options) getFlag :: [Flag] -> Flag getFlag [] = ParsePretty PPOffsideRule getFlag [f] = f getFlag _ = error usage handleFlag :: Flag -> ParseMode -> String -> String handleFlag LexOnlyLength parse_mode = show . length . testLexerRev parse_mode handleFlag LexOnlyRev parse_mode = concat . intersperse "\n" . map show . testLexerRev parse_mode handleFlag LexOnly parse_mode = concat . intersperse "\n" . map show . testLexer parse_mode handleFlag ParseLength parse_mode = show . modLength . testParser parse_mode where modLength (HsModule _ _ _ imp d) = length imp + length d handleFlag ParseInternal parse_mode = show . testParser parse_mode handleFlag (ParsePretty l) parse_mode = prettyPrintStyleMode style{lineLength=80} defaultMode{layout=l} . testParser parse_mode handleFlag Help _parse_mode = const $ usageInfo (title ++ "\n" ++ usage) options testLexerRev :: ParseMode -> String -> [Token] testLexerRev parse_mode = getResult . runParserWithMode parse_mode (loop []) where loop toks = lexer $ \t -> case t of EOF -> return toks _ -> loop (t:toks) testLexer :: ParseMode -> String -> [Token] testLexer parse_mode = reverse . testLexerRev parse_mode testParser :: ParseMode -> String -> HsModule testParser parse_mode = getResult . parseModuleWithMode parse_mode getResult :: ParseResult a -> a getResult (ParseOk a) = a getResult (ParseFailed loc err) = error (srcFilename loc ++ ":" ++ show (srcLine loc) ++ ":" ++ show (srcColumn loc) ++ ": " ++ err) hugs98-plus-Sep2006/packages/haskell-src/examples/Makefile0000644006511100651110000000073710504340234022231 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- ifeq "$(way)" "" HS_PROG = hsparser$(exeext) endif HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -package haskell-src # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/haskell-src/Makefile.nhc980000644006511100651110000000114710504340234021337 0ustar rossrossTHISPKG = haskell-src SEARCH = EXTRA_H_FLAGS = -K6M # NOTE: 200M is ridiculous, but otherwise there is a segfault with CFG=p # for Language/Haskell/Parser.hs. More investigation is needed here... EXTRA_HBC_FLAGS = -H220M -A4M SRCS = \ Language/Haskell/Lexer.hs Language/Haskell/ParseMonad.hs \ Language/Haskell/ParseUtils.hs Language/Haskell/Parser.hs \ Language/Haskell/Pretty.hs Language/Haskell/Syntax.hs # Here are the main rules. include ../Makefile.common # some extra rules Language/Haskell/Parser.hs: Language/Haskell/Parser.ly happy $< # Here are any extra dependencies. # C-files dependencies. hugs98-plus-Sep2006/packages/haskell-src/haskell-src.cabal0000644006511100651110000000124310504340234022140 0ustar rossrossname: haskell-src version: 1.0 license: BSD3 license-file: LICENSE author: Simon Marlow, Sven Panne and Noel Winstanley maintainer: libraries@haskell.org category: Language synopsis: Manipulating Haskell source code description: Facilities for manipulating Haskell source code: an abstract syntax, lexer, parser and pretty-printer. exposed-modules: Language.Haskell.Lexer, Language.Haskell.Parser, Language.Haskell.ParseMonad, Language.Haskell.Pretty, Language.Haskell.Syntax other-modules: Language.Haskell.ParseUtils build-depends: base, haskell98 -- The dependency on Haskell 98 is only because -- Happy generates a parser that imports Array extensions: CPP hugs98-plus-Sep2006/packages/haskell-src/package.conf.in0000644006511100651110000000123110504340234021610 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: Language.Haskell.Lexer, Language.Haskell.Parser, Language.Haskell.ParseMonad, Language.Haskell.ParseUtils, Language.Haskell.Pretty, Language.Haskell.Syntax hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HShaskell-src" extra-libraries: include-dirs: includes: depends: base, haskell98 /* The dependency on Haskell 98 is only because Happy generates a parser that imports Array */ hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/haskell-src/prologue.txt0000644006511100651110000000014710504340234021343 0ustar rossrossFacilities for manipulating Haskell source code: an abstract syntax, lexer, parser and pretty-printer. hugs98-plus-Sep2006/packages/mtl/0000755006511100651110000000000010504340573015336 5ustar rossrosshugs98-plus-Sep2006/packages/mtl/Control/0000755006511100651110000000000010504340237016753 5ustar rossrosshugs98-plus-Sep2006/packages/mtl/Control/Monad/0000755006511100651110000000000010504340237020011 5ustar rossrosshugs98-plus-Sep2006/packages/mtl/Control/Monad/Identity.hs0000644006511100651110000000320510504340237022136 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Identity -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- The Identity monad. -- -- Inspired by the paper -- /Functional Programming with Overloading and -- Higher-Order Polymorphism/, -- Mark P Jones () -- Advanced School of Functional Programming, 1995. -- ----------------------------------------------------------------------------- module Control.Monad.Identity ( Identity(..), module Control.Monad, module Control.Monad.Fix, ) where import Prelude import Control.Monad import Control.Monad.Fix -- --------------------------------------------------------------------------- -- Identity wrapper -- -- Abstraction for wrapping up a object. -- If you have an monadic function, say: -- -- example :: Int -> IdentityMonad Int -- example x = return (x*x) -- -- you can "run" it, using -- -- Main> runIdentity (example 42) -- 1764 :: Int newtype Identity a = Identity { runIdentity :: a } -- --------------------------------------------------------------------------- -- Identity instances for Functor and Monad instance Functor Identity where fmap f m = Identity (f (runIdentity m)) instance Monad Identity where return a = Identity a m >>= k = k (runIdentity m) instance MonadFix Identity where mfix f = Identity (fix (runIdentity . f)) hugs98-plus-Sep2006/packages/mtl/Control/Monad/Cont.hs0000644006511100651110000000711710504340237021256 0ustar rossross{-# OPTIONS -fallow-undecidable-instances #-} -- Search for -fallow-undecidable-instances to see why this is needed ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Cont -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (multi-parameter type classes) -- -- Continuation monads. -- ----------------------------------------------------------------------------- module Control.Monad.Cont ( MonadCont(..), Cont(..), mapCont, withCont, ContT(..), mapContT, withContT, module Control.Monad, module Control.Monad.Trans, ) where import Prelude import Control.Monad import Control.Monad.Trans import Control.Monad.Reader import Control.Monad.Writer import Control.Monad.State import Control.Monad.RWS class (Monad m) => MonadCont m where callCC :: ((a -> m b) -> m a) -> m a -- --------------------------------------------------------------------------- -- Our parameterizable continuation monad newtype Cont r a = Cont { runCont :: (a -> r) -> r } instance Functor (Cont r) where fmap f m = Cont $ \c -> runCont m (c . f) instance Monad (Cont r) where return a = Cont ($ a) m >>= k = Cont $ \c -> runCont m $ \a -> runCont (k a) c instance MonadCont (Cont r) where callCC f = Cont $ \c -> runCont (f (\a -> Cont $ \_ -> c a)) c mapCont :: (r -> r) -> Cont r a -> Cont r a mapCont f m = Cont $ f . runCont m withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b withCont f m = Cont $ runCont m . f -- --------------------------------------------------------------------------- -- Our parameterizable continuation monad, with an inner monad newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r } instance (Monad m) => Functor (ContT r m) where fmap f m = ContT $ \c -> runContT m (c . f) instance (Monad m) => Monad (ContT r m) where return a = ContT ($ a) m >>= k = ContT $ \c -> runContT m (\a -> runContT (k a) c) instance (Monad m) => MonadCont (ContT r m) where callCC f = ContT $ \c -> runContT (f (\a -> ContT $ \_ -> c a)) c instance MonadTrans (ContT r) where lift m = ContT (m >>=) instance (MonadIO m) => MonadIO (ContT r m) where liftIO = lift . liftIO -- Needs -fallow-undecidable-instances instance (MonadReader r' m) => MonadReader r' (ContT r m) where ask = lift ask local f m = ContT $ \c -> do r <- ask local f (runContT m (local (const r) . c)) -- Needs -fallow-undecidable-instances instance (MonadState s m) => MonadState s (ContT r m) where get = lift get put = lift . put -- ----------------------------------------------------------------------------- -- MonadCont instances for other monad transformers instance (MonadCont m) => MonadCont (ReaderT r m) where callCC f = ReaderT $ \r -> callCC $ \c -> runReaderT (f (\a -> ReaderT $ \_ -> c a)) r instance (MonadCont m) => MonadCont (StateT s m) where callCC f = StateT $ \s -> callCC $ \c -> runStateT (f (\a -> StateT $ \s' -> c (a, s'))) s instance (Monoid w, MonadCont m) => MonadCont (WriterT w m) where callCC f = WriterT $ callCC $ \c -> runWriterT (f (\a -> WriterT $ c (a, mempty))) instance (Monoid w, MonadCont m) => MonadCont (RWST r w s m) where callCC f = RWST $ \r s -> callCC $ \c -> runRWST (f (\a -> RWST $ \_ s' -> c (a, s', mempty))) r s mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a mapContT f m = ContT $ f . runContT m withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b withContT f m = ContT $ runContT m . f hugs98-plus-Sep2006/packages/mtl/Control/Monad/Error.hs0000644006511100651110000001433010504340237021437 0ustar rossross{-# OPTIONS -fallow-undecidable-instances #-} -- Needed for the same reasons as in Reader, State etc ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Error -- Copyright : (c) Michael Weber , 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (multi-parameter type classes) -- -- The Error monad. -- -- Rendered by Michael Weber , -- inspired by the Haskell Monad Template Library from -- Andy Gill () -- ----------------------------------------------------------------------------- module Control.Monad.Error ( Error(..), MonadError(..), ErrorT(..), mapErrorT, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, ) where import Prelude import Control.Monad import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Reader import Control.Monad.Writer import Control.Monad.State import Control.Monad.RWS import Control.Monad.Cont import Control.Monad.Instances () import System.IO -- --------------------------------------------------------------------------- -- class MonadError -- -- throws an exception inside the monad and thus interrupts -- normal execution order, until an error handler is reached} -- -- catches an exception inside the monad (that was previously -- thrown by throwError class Error a where noMsg :: a strMsg :: String -> a noMsg = strMsg "" strMsg _ = noMsg instance Error [Char] where noMsg = "" strMsg = id instance Error IOError where strMsg = userError class (Monad m) => MonadError e m | m -> e where throwError :: e -> m a catchError :: m a -> (e -> m a) -> m a instance MonadPlus IO where mzero = ioError (userError "mzero") m `mplus` n = m `catch` \_ -> n instance MonadError IOError IO where throwError = ioError catchError = catch -- --------------------------------------------------------------------------- -- Our parameterizable error monad instance (Error e) => Monad (Either e) where return = Right Left l >>= _ = Left l Right r >>= k = k r fail msg = Left (strMsg msg) instance (Error e) => MonadPlus (Either e) where mzero = Left noMsg Left _ `mplus` n = n m `mplus` _ = m instance (Error e) => MonadFix (Either e) where mfix f = let a = f $ case a of Right r -> r _ -> error "empty mfix argument" in a instance (Error e) => MonadError e (Either e) where throwError = Left Left l `catchError` h = h l Right r `catchError` _ = Right r -- --------------------------------------------------------------------------- -- Our parameterizable error monad, with an inner monad newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) } -- The ErrorT Monad structure is parameterized over two things: -- * e - The error type. -- * m - The inner monad. -- Here are some examples of use: -- -- type ErrorWithIO e a = ErrorT e IO a -- ==> ErrorT (IO (Either e a)) -- -- type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a -- ==> ErrorT (StateT s IO (Either e a)) -- ==> ErrorT (StateT (s -> IO (Either e a,s))) -- instance (Monad m) => Functor (ErrorT e m) where fmap f m = ErrorT $ do a <- runErrorT m case a of Left l -> return (Left l) Right r -> return (Right (f r)) instance (Monad m, Error e) => Monad (ErrorT e m) where return a = ErrorT $ return (Right a) m >>= k = ErrorT $ do a <- runErrorT m case a of Left l -> return (Left l) Right r -> runErrorT (k r) fail msg = ErrorT $ return (Left (strMsg msg)) instance (Monad m, Error e) => MonadPlus (ErrorT e m) where mzero = ErrorT $ return (Left noMsg) m `mplus` n = ErrorT $ do a <- runErrorT m case a of Left _ -> runErrorT n Right r -> return (Right r) instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where mfix f = ErrorT $ mfix $ \a -> runErrorT $ f $ case a of Right r -> r _ -> error "empty mfix argument" instance (Monad m, Error e) => MonadError e (ErrorT e m) where throwError l = ErrorT $ return (Left l) m `catchError` h = ErrorT $ do a <- runErrorT m case a of Left l -> runErrorT (h l) Right r -> return (Right r) instance (Error e) => MonadTrans (ErrorT e) where lift m = ErrorT $ do a <- m return (Right a) instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where liftIO = lift . liftIO instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where ask = lift ask local f m = ErrorT $ local f (runErrorT m) instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where tell = lift . tell listen m = ErrorT $ do (a, w) <- listen (runErrorT m) return $ case a of Left l -> Left l Right r -> Right (r, w) pass m = ErrorT $ pass $ do a <- runErrorT m return $ case a of Left l -> (Left l, id) Right (r, f) -> (Right r, f) instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where get = lift get put = lift . put instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where callCC f = ErrorT $ callCC $ \c -> runErrorT (f (\a -> ErrorT $ c (Right a))) mapErrorT :: (m (Either e a) -> n (Either e' b)) -> ErrorT e m a -> ErrorT e' n b mapErrorT f m = ErrorT $ f (runErrorT m) -- --------------------------------------------------------------------------- -- MonadError instances for other monad transformers instance (MonadError e m) => MonadError e (ReaderT r m) where throwError = lift . throwError m `catchError` h = ReaderT $ \r -> runReaderT m r `catchError` \e -> runReaderT (h e) r instance (Monoid w, MonadError e m) => MonadError e (WriterT w m) where throwError = lift . throwError m `catchError` h = WriterT $ runWriterT m `catchError` \e -> runWriterT (h e) instance (MonadError e m) => MonadError e (StateT s m) where throwError = lift . throwError m `catchError` h = StateT $ \s -> runStateT m s `catchError` \e -> runStateT (h e) s instance (Monoid w, MonadError e m) => MonadError e (RWST r w s m) where throwError = lift . throwError m `catchError` h = RWST $ \r s -> runRWST m r s `catchError` \e -> runRWST (h e) r s hugs98-plus-Sep2006/packages/mtl/Control/Monad/List.hs0000644006511100651110000000443110504340237021262 0ustar rossross{-# OPTIONS -fallow-undecidable-instances #-} -- Needed for the same reasons as in Reader, State etc ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.List -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (multi-parameter type classes) -- -- The List monad. -- ----------------------------------------------------------------------------- module Control.Monad.List ( ListT(..), mapListT, module Control.Monad, module Control.Monad.Trans, ) where import Prelude import Control.Monad import Control.Monad.Trans import Control.Monad.Reader import Control.Monad.State import Control.Monad.Cont import Control.Monad.Error -- --------------------------------------------------------------------------- -- Our parameterizable list monad, with an inner monad newtype ListT m a = ListT { runListT :: m [a] } instance (Monad m) => Functor (ListT m) where fmap f m = ListT $ do a <- runListT m return (map f a) instance (Monad m) => Monad (ListT m) where return a = ListT $ return [a] m >>= k = ListT $ do a <- runListT m b <- mapM (runListT . k) a return (concat b) fail _ = ListT $ return [] instance (Monad m) => MonadPlus (ListT m) where mzero = ListT $ return [] m `mplus` n = ListT $ do a <- runListT m b <- runListT n return (a ++ b) instance MonadTrans ListT where lift m = ListT $ do a <- m return [a] instance (MonadIO m) => MonadIO (ListT m) where liftIO = lift . liftIO instance (MonadReader s m) => MonadReader s (ListT m) where ask = lift ask local f m = ListT $ local f (runListT m) instance (MonadState s m) => MonadState s (ListT m) where get = lift get put = lift . put instance (MonadCont m) => MonadCont (ListT m) where callCC f = ListT $ callCC $ \c -> runListT (f (\a -> ListT $ c [a])) instance (MonadError e m) => MonadError e (ListT m) where throwError = lift . throwError m `catchError` h = ListT $ runListT m `catchError` \e -> runListT (h e) mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b mapListT f m = ListT $ f (runListT m) hugs98-plus-Sep2006/packages/mtl/Control/Monad/RWS.hs0000644006511100651110000001131010504340237021014 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Monad.RWS -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (multi-param classes, functional dependencies) -- -- Declaration of the MonadRWS class. -- -- Inspired by the paper -- /Functional Programming with Overloading and -- Higher-Order Polymorphism/, -- Mark P Jones () -- Advanced School of Functional Programming, 1995. ----------------------------------------------------------------------------- module Control.Monad.RWS ( RWS(..), evalRWS, execRWS, mapRWS, withRWS, RWST(..), evalRWST, execRWST, mapRWST, withRWST, module Control.Monad.Reader, module Control.Monad.Writer, module Control.Monad.State, ) where import Prelude import Control.Monad import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Reader import Control.Monad.Writer import Control.Monad.State import Data.Monoid newtype RWS r w s a = RWS { runRWS :: r -> s -> (a, s, w) } instance Functor (RWS r w s) where fmap f m = RWS $ \r s -> let (a, s', w) = runRWS m r s in (f a, s', w) instance (Monoid w) => Monad (RWS r w s) where return a = RWS $ \_ s -> (a, s, mempty) m >>= k = RWS $ \r s -> let (a, s', w) = runRWS m r s (b, s'', w') = runRWS (k a) r s' in (b, s'', w `mappend` w') instance (Monoid w) => MonadFix (RWS r w s) where mfix f = RWS $ \r s -> let (a, s', w) = runRWS (f a) r s in (a, s', w) instance (Monoid w) => MonadReader r (RWS r w s) where ask = RWS $ \r s -> (r, s, mempty) local f m = RWS $ \r s -> runRWS m (f r) s instance (Monoid w) => MonadWriter w (RWS r w s) where tell w = RWS $ \_ s -> ((), s, w) listen m = RWS $ \r s -> let (a, s', w) = runRWS m r s in ((a, w), s', w) pass m = RWS $ \r s -> let ((a, f), s', w) = runRWS m r s in (a, s', f w) instance (Monoid w) => MonadState s (RWS r w s) where get = RWS $ \_ s -> (s, s, mempty) put s = RWS $ \_ _ -> ((), s, mempty) evalRWS :: RWS r w s a -> r -> s -> (a, w) evalRWS m r s = let (a, _, w) = runRWS m r s in (a, w) execRWS :: RWS r w s a -> r -> s -> (s, w) execRWS m r s = let (_, s', w) = runRWS m r s in (s', w) mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b mapRWS f m = RWS $ \r s -> f (runRWS m r s) withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a withRWS f m = RWS $ \r s -> uncurry (runRWS m) (f r s) newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) } instance (Monad m) => Functor (RWST r w s m) where fmap f m = RWST $ \r s -> do (a, s', w) <- runRWST m r s return (f a, s', w) instance (Monoid w, Monad m) => Monad (RWST r w s m) where return a = RWST $ \_ s -> return (a, s, mempty) m >>= k = RWST $ \r s -> do (a, s', w) <- runRWST m r s (b, s'',w') <- runRWST (k a) r s' return (b, s'', w `mappend` w') fail msg = RWST $ \_ _ -> fail msg instance (Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) where mzero = RWST $ \_ _ -> mzero m `mplus` n = RWST $ \r s -> runRWST m r s `mplus` runRWST n r s instance (Monoid w, MonadFix m) => MonadFix (RWST r w s m) where mfix f = RWST $ \r s -> mfix $ \ ~(a, _, _) -> runRWST (f a) r s instance (Monoid w, Monad m) => MonadReader r (RWST r w s m) where ask = RWST $ \r s -> return (r, s, mempty) local f m = RWST $ \r s -> runRWST m (f r) s instance (Monoid w, Monad m) => MonadWriter w (RWST r w s m) where tell w = RWST $ \_ s -> return ((),s,w) listen m = RWST $ \r s -> do (a, s', w) <- runRWST m r s return ((a, w), s', w) pass m = RWST $ \r s -> do ((a, f), s', w) <- runRWST m r s return (a, s', f w) instance (Monoid w, Monad m) => MonadState s (RWST r w s m) where get = RWST $ \_ s -> return (s, s, mempty) put s = RWST $ \_ _ -> return ((), s, mempty) instance (Monoid w) => MonadTrans (RWST r w s) where lift m = RWST $ \_ s -> do a <- m return (a, s, mempty) instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where liftIO = lift . liftIO evalRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (a, w) evalRWST m r s = do (a, _, w) <- runRWST m r s return (a, w) execRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (s, w) execRWST m r s = do (_, s', w) <- runRWST m r s return (s', w) mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b mapRWST f m = RWST $ \r s -> f (runRWST m r s) withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a withRWST f m = RWST $ \r s -> uncurry (runRWST m) (f r s) hugs98-plus-Sep2006/packages/mtl/Control/Monad/Reader.hs0000644006511100651110000000741310504340237021554 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Reader -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (multi-param classes, functional dependencies) -- -- Declaration of the Monoid class,and instances for list and functions -- -- Inspired by the paper -- /Functional Programming with Overloading and -- Higher-Order Polymorphism/, -- Mark P Jones () -- Advanced School of Functional Programming, 1995. ----------------------------------------------------------------------------- module Control.Monad.Reader ( MonadReader(..), asks, Reader(..), mapReader, withReader, ReaderT(..), mapReaderT, withReaderT, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, ) where import Prelude import Control.Monad import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Instances () -- ---------------------------------------------------------------------------- -- class MonadReader -- asks for the internal (non-mutable) state. class (Monad m) => MonadReader r m | m -> r where ask :: m r local :: (r -> r) -> m a -> m a -- This allows you to provide a projection function. asks :: (MonadReader r m) => (r -> a) -> m a asks f = do r <- ask return (f r) -- ---------------------------------------------------------------------------- -- The partially applied function type is a simple reader monad instance MonadReader r ((->) r) where ask = id local f m = m . f -- --------------------------------------------------------------------------- -- Our parameterizable reader monad newtype Reader r a = Reader { runReader :: r -> a } instance Functor (Reader r) where fmap f m = Reader $ \r -> f (runReader m r) instance Monad (Reader r) where return a = Reader $ \_ -> a m >>= k = Reader $ \r -> runReader (k (runReader m r)) r instance MonadFix (Reader r) where mfix f = Reader $ \r -> let a = runReader (f a) r in a instance MonadReader r (Reader r) where ask = Reader id local f m = Reader $ runReader m . f mapReader :: (a -> b) -> Reader r a -> Reader r b mapReader f m = Reader $ f . runReader m -- This is a more general version of local. withReader :: (r' -> r) -> Reader r a -> Reader r' a withReader f m = Reader $ runReader m . f -- --------------------------------------------------------------------------- -- Our parameterizable reader monad, with an inner monad newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a } instance (Monad m) => Functor (ReaderT r m) where fmap f m = ReaderT $ \r -> do a <- runReaderT m r return (f a) instance (Monad m) => Monad (ReaderT r m) where return a = ReaderT $ \_ -> return a m >>= k = ReaderT $ \r -> do a <- runReaderT m r runReaderT (k a) r fail msg = ReaderT $ \_ -> fail msg instance (MonadPlus m) => MonadPlus (ReaderT r m) where mzero = ReaderT $ \_ -> mzero m `mplus` n = ReaderT $ \r -> runReaderT m r `mplus` runReaderT n r instance (MonadFix m) => MonadFix (ReaderT r m) where mfix f = ReaderT $ \r -> mfix $ \a -> runReaderT (f a) r instance (Monad m) => MonadReader r (ReaderT r m) where ask = ReaderT return local f m = ReaderT $ \r -> runReaderT m (f r) instance MonadTrans (ReaderT r) where lift m = ReaderT $ \_ -> m instance (MonadIO m) => MonadIO (ReaderT r m) where liftIO = lift . liftIO mapReaderT :: (m a -> n b) -> ReaderT w m a -> ReaderT w n b mapReaderT f m = ReaderT $ f . runReaderT m withReaderT :: (r' -> r) -> ReaderT r m a -> ReaderT r' m a withReaderT f m = ReaderT $ runReaderT m . f hugs98-plus-Sep2006/packages/mtl/Control/Monad/State.hs0000644006511100651110000002441510504340237021433 0ustar rossross{-# OPTIONS -fallow-undecidable-instances #-} -- Search for -fallow-undecidable-instances to see why this is needed ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.State -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (multi-param classes, functional dependencies) -- -- State monads. -- -- This module is inspired by the paper -- /Functional Programming with Overloading and -- Higher-Order Polymorphism/, -- Mark P Jones () -- Advanced School of Functional Programming, 1995. -- -- See below for examples. ----------------------------------------------------------------------------- module Control.Monad.State ( -- * MonadState class MonadState(..), modify, gets, -- * The State Monad State(..), evalState, execState, mapState, withState, -- * The StateT Monad StateT(..), evalStateT, execStateT, mapStateT, withStateT, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, -- * Examples -- $examples ) where import Prelude import Control.Monad import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Reader import Control.Monad.Writer -- --------------------------------------------------------------------------- -- | /get/ returns the state from the internals of the monad. -- -- /put/ replaces the state inside the monad. class (Monad m) => MonadState s m | m -> s where get :: m s put :: s -> m () -- | Monadic state transformer. -- -- Maps an old state to a new state inside a state monad. -- The old state is thrown away. -- -- > Main> :t modify ((+1) :: Int -> Int) -- > modify (...) :: (MonadState Int a) => a () -- -- This says that @modify (+1)@ acts over any -- Monad that is a member of the @MonadState@ class, -- with an @Int@ state. modify :: (MonadState s m) => (s -> s) -> m () modify f = do s <- get put (f s) -- | Gets specific component of the state, using a projection function -- supplied. gets :: (MonadState s m) => (s -> a) -> m a gets f = do s <- get return (f s) -- --------------------------------------------------------------------------- -- | A parameterizable state monad where /s/ is the type of the state -- to carry and /a/ is the type of the /return value/. newtype State s a = State { runState :: s -> (a, s) } -- The State Monad structure is parameterized over just the state. instance Functor (State s) where fmap f m = State $ \s -> let (a, s') = runState m s in (f a, s') instance Monad (State s) where return a = State $ \s -> (a, s) m >>= k = State $ \s -> let (a, s') = runState m s in runState (k a) s' instance MonadFix (State s) where mfix f = State $ \s -> let (a, s') = runState (f a) s in (a, s') instance MonadState s (State s) where get = State $ \s -> (s, s) put s = State $ \_ -> ((), s) -- |Evaluate this state monad with the given initial state,throwing -- away the final state. Very much like @fst@ composed with -- @runstate@. evalState :: State s a -- ^The state to evaluate -> s -- ^An initial value -> a -- ^The return value of the state application evalState m s = fst (runState m s) -- |Execute this state and return the new state, throwing away the -- return value. Very much like @snd@ composed with -- @runstate@. execState :: State s a -- ^The state to evaluate -> s -- ^An initial value -> s -- ^The new state execState m s = snd (runState m s) -- |Map a stateful computation from one (return value, state) pair to -- another. For instance, to convert numberTree from a function that -- returns a tree to a function that returns the sum of the numbered -- tree (see the Examples section for numberTree and sumTree) you may -- write: -- -- > sumNumberedTree :: (Eq a) => Tree a -> State (Table a) Int -- > sumNumberedTree = mapState (\ (t, tab) -> (sumTree t, tab)) . numberTree mapState :: ((a, s) -> (b, s)) -> State s a -> State s b mapState f m = State $ f . runState m -- |Apply this function to this state and return the resulting state. withState :: (s -> s) -> State s a -> State s a withState f m = State $ runState m . f -- --------------------------------------------------------------------------- -- | A parameterizable state monad for encapsulating an inner -- monad. -- -- The StateT Monad structure is parameterized over two things: -- -- * s - The state. -- -- * m - The inner monad. -- -- Here are some examples of use: -- -- (Parser from ParseLib with Hugs) -- -- > type Parser a = StateT String [] a -- > ==> StateT (String -> [(a,String)]) -- -- For example, item can be written as: -- -- > item = do (x:xs) <- get -- > put xs -- > return x -- > -- > type BoringState s a = StateT s Indentity a -- > ==> StateT (s -> Identity (a,s)) -- > -- > type StateWithIO s a = StateT s IO a -- > ==> StateT (s -> IO (a,s)) -- > -- > type StateWithErr s a = StateT s Maybe a -- > ==> StateT (s -> Maybe (a,s)) newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } instance (Monad m) => Functor (StateT s m) where fmap f m = StateT $ \s -> do (x, s') <- runStateT m s return (f x, s') instance (Monad m) => Monad (StateT s m) where return a = StateT $ \s -> return (a, s) m >>= k = StateT $ \s -> do (a, s') <- runStateT m s runStateT (k a) s' fail str = StateT $ \_ -> fail str instance (MonadPlus m) => MonadPlus (StateT s m) where mzero = StateT $ \_ -> mzero m `mplus` n = StateT $ \s -> runStateT m s `mplus` runStateT n s instance (MonadFix m) => MonadFix (StateT s m) where mfix f = StateT $ \s -> mfix $ \ ~(a, _) -> runStateT (f a) s instance (Monad m) => MonadState s (StateT s m) where get = StateT $ \s -> return (s, s) put s = StateT $ \_ -> return ((), s) instance MonadTrans (StateT s) where lift m = StateT $ \s -> do a <- m return (a, s) instance (MonadIO m) => MonadIO (StateT s m) where liftIO = lift . liftIO -- Needs -fallow-undecidable-instances instance (MonadReader r m) => MonadReader r (StateT s m) where ask = lift ask local f m = StateT $ \s -> local f (runStateT m s) -- Needs -fallow-undecidable-instances instance (MonadWriter w m) => MonadWriter w (StateT s m) where tell = lift . tell listen m = StateT $ \s -> do ((a, s'), w) <- listen (runStateT m s) return ((a, w), s') pass m = StateT $ \s -> pass $ do ((a, f), s') <- runStateT m s return ((a, s'), f) -- |Similar to 'evalState' evalStateT :: (Monad m) => StateT s m a -> s -> m a evalStateT m s = do (a, _) <- runStateT m s return a -- |Similar to 'execState' execStateT :: (Monad m) => StateT s m a -> s -> m s execStateT m s = do (_, s') <- runStateT m s return s' -- |Similar to 'mapState' mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b mapStateT f m = StateT $ f . runStateT m -- |Similar to 'withState' withStateT :: (s -> s) -> StateT s m a -> StateT s m a withStateT f m = StateT $ runStateT m . f -- --------------------------------------------------------------------------- -- MonadState instances for other monad transformers -- Needs -fallow-undecidable-instances instance (MonadState s m) => MonadState s (ReaderT r m) where get = lift get put = lift . put -- Needs -fallow-undecidable-instances instance (Monoid w, MonadState s m) => MonadState s (WriterT w m) where get = lift get put = lift . put -- --------------------------------------------------------------------------- -- $examples -- A function to increment a counter. Taken from the paper -- /Generalising Monads to Arrows/, John -- Hughes (), November 1998: -- -- > tick :: State Int Int -- > tick = do n <- get -- > put (n+1) -- > return n -- -- Add one to the given number using the state monad: -- -- > plusOne :: Int -> Int -- > plusOne n = execState tick n -- -- A contrived addition example. Works only with positive numbers: -- -- > plus :: Int -> Int -> Int -- > plus n x = execState (sequence $ replicate n tick) x -- -- An example from /The Craft of Functional Programming/, Simon -- Thompson (), -- Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a -- tree of integers in which the original elements are replaced by -- natural numbers, starting from 0. The same element has to be -- replaced by the same number at every occurrence, and when we meet -- an as-yet-unvisited element we have to find a \'new\' number to match -- it with:\" -- -- > data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq) -- > type Table a = [a] -- -- > numberTree :: Eq a => Tree a -> State (Table a) (Tree Int) -- > numberTree Nil = return Nil -- > numberTree (Node x t1 t2) -- > = do num <- numberNode x -- > nt1 <- numberTree t1 -- > nt2 <- numberTree t2 -- > return (Node num nt1 nt2) -- > where -- > numberNode :: Eq a => a -> State (Table a) Int -- > numberNode x -- > = do table <- get -- > (newTable, newPos) <- return (nNode x table) -- > put newTable -- > return newPos -- > nNode:: (Eq a) => a -> Table a -> (Table a, Int) -- > nNode x table -- > = case (findIndexInList (== x) table) of -- > Nothing -> (table ++ [x], length table) -- > Just i -> (table, i) -- > findIndexInList :: (a -> Bool) -> [a] -> Maybe Int -- > findIndexInList = findIndexInListHelp 0 -- > findIndexInListHelp _ _ [] = Nothing -- > findIndexInListHelp count f (h:t) -- > = if (f h) -- > then Just count -- > else findIndexInListHelp (count+1) f t -- -- numTree applies numberTree with an initial state: -- -- > numTree :: (Eq a) => Tree a -> Tree Int -- > numTree t = evalState (numberTree t) [] -- -- > testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil -- > numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil -- -- sumTree is a little helper function that does not use the State monad: -- -- > sumTree :: (Num a) => Tree a -> a -- > sumTree Nil = 0 -- > sumTree (Node e t1 t2) = e + (sumTree t1) + (sumTree t2) hugs98-plus-Sep2006/packages/mtl/Control/Monad/Trans.hs0000644006511100651110000000232210504340237021433 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- The MonadTrans class. -- -- Inspired by the paper -- /Functional Programming with Overloading and -- Higher-Order Polymorphism/, -- Mark P Jones () -- Advanced School of Functional Programming, 1995. ----------------------------------------------------------------------------- module Control.Monad.Trans ( MonadTrans(..), MonadIO(..), ) where import Prelude import System.IO -- --------------------------------------------------------------------------- -- MonadTrans class -- -- Monad to facilitate stackable Monads. -- Provides a way of digging into an outer -- monad, giving access to (lifting) the inner monad. class MonadTrans t where lift :: Monad m => m a -> t m a class (Monad m) => MonadIO m where liftIO :: IO a -> m a instance MonadIO IO where liftIO = id hugs98-plus-Sep2006/packages/mtl/Control/Monad/Writer.hs0000644006511100651110000001214110504340237021620 0ustar rossross{-# OPTIONS -fallow-undecidable-instances #-} -- Search for -fallow-undecidable-instances to see why this is needed ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Writer -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (multi-param classes, functional dependencies) -- -- The MonadWriter class. -- -- Inspired by the paper -- /Functional Programming with Overloading and -- Higher-Order Polymorphism/, -- Mark P Jones () -- Advanced School of Functional Programming, 1995. ----------------------------------------------------------------------------- module Control.Monad.Writer ( MonadWriter(..), listens, censor, Writer(..), execWriter, mapWriter, WriterT(..), execWriterT, mapWriterT, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, module Data.Monoid, ) where import Prelude import Control.Monad import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Reader import Data.Monoid -- --------------------------------------------------------------------------- -- MonadWriter class -- -- tell is like tell on the MUD's it shouts to monad -- what you want to be heard. The monad carries this 'packet' -- upwards, merging it if needed (hence the Monoid requirement)} -- -- listen listens to a monad acting, and returns what the monad "said". -- -- pass lets you provide a writer transformer which changes internals of -- the written object. class (Monoid w, Monad m) => MonadWriter w m | m -> w where tell :: w -> m () listen :: m a -> m (a, w) pass :: m (a, w -> w) -> m a listens :: (MonadWriter w m) => (w -> b) -> m a -> m (a, b) listens f m = do (a, w) <- listen m return (a, f w) censor :: (MonadWriter w m) => (w -> w) -> m a -> m a censor f m = pass $ do a <- m return (a, f) -- --------------------------------------------------------------------------- -- Our parameterizable writer monad newtype Writer w a = Writer { runWriter :: (a, w) } instance Functor (Writer w) where fmap f m = Writer $ let (a, w) = runWriter m in (f a, w) instance (Monoid w) => Monad (Writer w) where return a = Writer (a, mempty) m >>= k = Writer $ let (a, w) = runWriter m (b, w') = runWriter (k a) in (b, w `mappend` w') instance (Monoid w) => MonadFix (Writer w) where mfix m = Writer $ let (a, w) = runWriter (m a) in (a, w) instance (Monoid w) => MonadWriter w (Writer w) where tell w = Writer ((), w) listen m = Writer $ let (a, w) = runWriter m in ((a, w), w) pass m = Writer $ let ((a, f), w) = runWriter m in (a, f w) execWriter :: Writer w a -> w execWriter m = snd (runWriter m) mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b mapWriter f m = Writer $ f (runWriter m) -- --------------------------------------------------------------------------- -- Our parameterizable writer monad, with an inner monad newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } instance (Monad m) => Functor (WriterT w m) where fmap f m = WriterT $ do (a, w) <- runWriterT m return (f a, w) instance (Monoid w, Monad m) => Monad (WriterT w m) where return a = WriterT $ return (a, mempty) m >>= k = WriterT $ do (a, w) <- runWriterT m (b, w') <- runWriterT (k a) return (b, w `mappend` w') fail msg = WriterT $ fail msg instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where mzero = WriterT mzero m `mplus` n = WriterT $ runWriterT m `mplus` runWriterT n instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a) instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where tell w = WriterT $ return ((), w) listen m = WriterT $ do (a, w) <- runWriterT m return ((a, w), w) pass m = WriterT $ do ((a, f), w) <- runWriterT m return (a, f w) instance (Monoid w) => MonadTrans (WriterT w) where lift m = WriterT $ do a <- m return (a, mempty) instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where liftIO = lift . liftIO -- This instance needs -fallow-undecidable-instances, because -- it does not satisfy the coverage condition instance (Monoid w, MonadReader r m) => MonadReader r (WriterT w m) where ask = lift ask local f m = WriterT $ local f (runWriterT m) execWriterT :: Monad m => WriterT w m a -> m w execWriterT m = do (_, w) <- runWriterT m return w mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b mapWriterT f m = WriterT $ f (runWriterT m) -- --------------------------------------------------------------------------- -- MonadWriter instances for other monad transformers -- This instance needs -fallow-undecidable-instances, because -- it does not satisfy the coverage condition instance (MonadWriter w m) => MonadWriter w (ReaderT r m) where tell = lift . tell listen m = ReaderT $ \w -> listen (runReaderT m w) pass m = ReaderT $ \w -> pass (runReaderT m w) hugs98-plus-Sep2006/packages/mtl/Makefile.inc0000644006511100651110000000022310504340237017540 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/mtl/LICENSE0000644006511100651110000000311310504340237016336 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/mtl/Makefile0000644006511100651110000000041410504340237016772 0ustar rossrossTOP=.. include $(TOP)/mk/boilerplate.mk SUBDIRS = ALL_DIRS = \ Control/Monad PACKAGE = mtl VERSION = 1.0 PACKAGE_DEPS = base SRC_HC_OPTS += -fglasgow-exts SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/mtl/package.conf.in0000644006511100651110000000110410504340237020176 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: Control.Monad.Error, Control.Monad.Cont, Control.Monad.Identity, Control.Monad.List, Control.Monad.RWS, Control.Monad.Reader, Control.Monad.State, Control.Monad.Trans, Control.Monad.Writer hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSmtl" extra-libraries: include-dirs: includes: depends: base hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/mtl/Makefile.nhc980000644006511100651110000000024310504340237017722 0ustar rossrossTHISPKG = mtl SEARCH = SRCS = \ Control/Monad/Identity.hs \ Control/Monad/Trans.hs # Here are the main rules. include ../Makefile.common # (no dependencies) hugs98-plus-Sep2006/packages/mtl/mtl.cabal0000644006511100651110000000127410504340237017117 0ustar rossrossname: mtl version: 1.0 license: BSD3 license-file: LICENSE author: Andy Gill maintainer: libraries@haskell.org category: Control synopsis: Monad transformer library description: A monad transformer library, inspired by the paper "Functional Programming with Overloading and Higher-Order Polymorphism", by Mark P Jones (), Advanced School of Functional Programming, 1995. exposed-modules: Control.Monad.Error, Control.Monad.Cont, Control.Monad.Identity, Control.Monad.List, Control.Monad.RWS, Control.Monad.Reader, Control.Monad.State, Control.Monad.Trans, Control.Monad.Writer build-depends: base extensions: MultiParamTypeClasses, FunctionalDependencies hugs98-plus-Sep2006/packages/mtl/prologue.txt0000644006511100651110000000033410504340237017730 0ustar rossrossA monad transformer library, inspired by the paper /Functional Programming with Overloading and Higher-Order Polymorphism/, Mark P Jones () Advanced School of Functional Programming, 1995. hugs98-plus-Sep2006/packages/network/0000755006511100651110000000000010504340734016232 5ustar rossrosshugs98-plus-Sep2006/packages/network/Network/0000755006511100651110000000000010504340250017654 5ustar rossrosshugs98-plus-Sep2006/packages/network/Network/BSD.hsc0000644006511100651110000005043410504340250020771 0ustar rossross{-# OPTIONS -fglasgow-exts -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Network.BSD -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/network/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable -- -- The "Network.BSD" module defines Haskell bindings to network -- programming functionality provided by BSD Unix derivatives. -- ----------------------------------------------------------------------------- #include "HsNet.h" -- NOTE: ##, we want this interpreted when compiling the .hs, not by hsc2hs. ##include "Typeable.h" module Network.BSD ( -- * Host names HostName, getHostName, -- :: IO HostName HostEntry(..), getHostByName, -- :: HostName -> IO HostEntry getHostByAddr, -- :: HostAddress -> Family -> IO HostEntry hostAddress, -- :: HostEntry -> HostAddress #if defined(HAVE_GETHOSTENT) && !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) getHostEntries, -- :: Bool -> IO [HostEntry] -- ** Low level functionality setHostEntry, -- :: Bool -> IO () getHostEntry, -- :: IO HostEntry endHostEntry, -- :: IO () #endif -- * Service names ServiceEntry(..), ServiceName, getServiceByName, -- :: ServiceName -> ProtocolName -> IO ServiceEntry getServiceByPort, -- :: PortNumber -> ProtocolName -> IO ServiceEntry getServicePortNumber, -- :: ServiceName -> IO PortNumber #if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) getServiceEntries, -- :: Bool -> IO [ServiceEntry] -- ** Low level functionality getServiceEntry, -- :: IO ServiceEntry setServiceEntry, -- :: Bool -> IO () endServiceEntry, -- :: IO () #endif -- * Protocol names ProtocolName, ProtocolNumber, ProtocolEntry(..), getProtocolByName, -- :: ProtocolName -> IO ProtocolEntry getProtocolByNumber, -- :: ProtocolNumber -> IO ProtcolEntry getProtocolNumber, -- :: ProtocolName -> ProtocolNumber defaultProtocol, -- :: ProtocolNumber #if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) getProtocolEntries, -- :: Bool -> IO [ProtocolEntry] -- ** Low level functionality setProtocolEntry, -- :: Bool -> IO () getProtocolEntry, -- :: IO ProtocolEntry endProtocolEntry, -- :: IO () #endif -- * Port numbers PortNumber, -- * Network names NetworkName, NetworkAddr, NetworkEntry(..) #if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) , getNetworkByName -- :: NetworkName -> IO NetworkEntry , getNetworkByAddr -- :: NetworkAddr -> Family -> IO NetworkEntry , getNetworkEntries -- :: Bool -> IO [NetworkEntry] -- ** Low level functionality , setNetworkEntry -- :: Bool -> IO () , getNetworkEntry -- :: IO NetworkEntry , endNetworkEntry -- :: IO () #endif ) where #ifdef __HUGS__ import Hugs.Prelude ( IOException(..), IOErrorType(..) ) #endif import Network.Socket import Control.Concurrent ( MVar, newMVar, withMVar ) import Foreign.C.Error ( throwErrnoIfMinus1, throwErrnoIfMinus1_ ) import Foreign.C.String ( CString, peekCString, peekCStringLen, withCString ) import Foreign.C.Types ( CInt, CULong, CChar, CSize, CShort ) import Foreign.Ptr ( Ptr, nullPtr ) import Foreign.Storable ( Storable(..) ) import Foreign.Marshal.Array ( allocaArray0, peekArray0 ) import Foreign.Marshal.Utils ( with, fromBool ) import Data.Typeable import System.IO.Unsafe ( unsafePerformIO ) #ifdef __GLASGOW_HASKELL__ import GHC.IOBase #endif import Control.Monad ( liftM ) -- --------------------------------------------------------------------------- -- Basic Types type HostName = String type ProtocolName = String type ServiceName = String -- --------------------------------------------------------------------------- -- Service Database Access -- Calling getServiceByName for a given service and protocol returns -- the systems service entry. This should be used to find the port -- numbers for standard protocols such as SMTP and FTP. The remaining -- three functions should be used for browsing the service database -- sequentially. -- Calling setServiceEntry with True indicates that the service -- database should be left open between calls to getServiceEntry. To -- close the database a call to endServiceEntry is required. This -- database file is usually stored in the file /etc/services. data ServiceEntry = ServiceEntry { serviceName :: ServiceName, -- Official Name serviceAliases :: [ServiceName], -- aliases servicePort :: PortNumber, -- Port Number ( network byte order ) serviceProtocol :: ProtocolName -- Protocol } deriving (Show) INSTANCE_TYPEABLE0(ServiceEntry,serviceEntryTc,"ServiceEntry") instance Storable ServiceEntry where sizeOf _ = #const sizeof(struct servent) alignment _ = alignment (undefined :: CInt) -- ??? peek p = do s_name <- (#peek struct servent, s_name) p >>= peekCString s_aliases <- (#peek struct servent, s_aliases) p >>= peekArray0 nullPtr >>= mapM peekCString s_port <- (#peek struct servent, s_port) p s_proto <- (#peek struct servent, s_proto) p >>= peekCString return (ServiceEntry { serviceName = s_name, serviceAliases = s_aliases, #if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS) servicePort = PortNum (fromIntegral (s_port :: CShort)), #else -- s_port is already in network byte order, but it -- might be the wrong size. servicePort = PortNum (fromIntegral (s_port :: CInt)), #endif serviceProtocol = s_proto }) poke p = error "Storable.poke(BSD.ServiceEntry) not implemented" -- | Get service by name. getServiceByName :: ServiceName -- Service Name -> ProtocolName -- Protocol Name -> IO ServiceEntry -- Service Entry getServiceByName name proto = withLock $ do withCString name $ \ cstr_name -> do withCString proto $ \ cstr_proto -> do throwNoSuchThingIfNull "getServiceByName" "no such service entry" $ (trySysCall (c_getservbyname cstr_name cstr_proto)) >>= peek foreign import ccall unsafe "getservbyname" c_getservbyname :: CString -> CString -> IO (Ptr ServiceEntry) -- | Get the service given a 'PortNumber' and 'ProtocolName'. getServiceByPort :: PortNumber -> ProtocolName -> IO ServiceEntry getServiceByPort (PortNum port) proto = withLock $ do withCString proto $ \ cstr_proto -> do throwNoSuchThingIfNull "getServiceByPort" "no such service entry" $ (trySysCall (c_getservbyport (fromIntegral port) cstr_proto)) >>= peek foreign import ccall unsafe "getservbyport" c_getservbyport :: CInt -> CString -> IO (Ptr ServiceEntry) -- | Get the 'PortNumber' corresponding to the 'ServiceName'. getServicePortNumber :: ServiceName -> IO PortNumber getServicePortNumber name = do (ServiceEntry _ _ port _) <- getServiceByName name "tcp" return port #if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) getServiceEntry :: IO ServiceEntry getServiceEntry = withLock $ do throwNoSuchThingIfNull "getServiceEntry" "no such service entry" $ trySysCall c_getservent >>= peek foreign import ccall unsafe "getservent" c_getservent :: IO (Ptr ServiceEntry) setServiceEntry :: Bool -> IO () setServiceEntry flg = withLock $ trySysCall $ c_setservent (fromBool flg) foreign import ccall unsafe "setservent" c_setservent :: CInt -> IO () endServiceEntry :: IO () endServiceEntry = withLock $ trySysCall $ c_endservent foreign import ccall unsafe "endservent" c_endservent :: IO () getServiceEntries :: Bool -> IO [ServiceEntry] getServiceEntries stayOpen = do setServiceEntry stayOpen getEntries (getServiceEntry) (endServiceEntry) #endif -- --------------------------------------------------------------------------- -- Protocol Entries -- The following relate directly to the corresponding UNIX C -- calls for returning the protocol entries. The protocol entry is -- represented by the Haskell type ProtocolEntry. -- As for setServiceEntry above, calling setProtocolEntry. -- determines whether or not the protocol database file, usually -- @/etc/protocols@, is to be kept open between calls of -- getProtocolEntry. Similarly, data ProtocolEntry = ProtocolEntry { protoName :: ProtocolName, -- Official Name protoAliases :: [ProtocolName], -- aliases protoNumber :: ProtocolNumber -- Protocol Number } deriving (Read, Show) INSTANCE_TYPEABLE0(ProtocolEntry,protocolEntryTc,"ProtocolEntry") instance Storable ProtocolEntry where sizeOf _ = #const sizeof(struct protoent) alignment _ = alignment (undefined :: CInt) -- ??? peek p = do p_name <- (#peek struct protoent, p_name) p >>= peekCString p_aliases <- (#peek struct protoent, p_aliases) p >>= peekArray0 nullPtr >>= mapM peekCString #if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS) -- With WinSock, the protocol number is only a short; -- hoist it in as such, but represent it on the Haskell side -- as a CInt. p_proto_short <- (#peek struct protoent, p_proto) p let p_proto = fromIntegral (p_proto_short :: CShort) #else p_proto <- (#peek struct protoent, p_proto) p #endif return (ProtocolEntry { protoName = p_name, protoAliases = p_aliases, protoNumber = p_proto }) poke p = error "Storable.poke(BSD.ProtocolEntry) not implemented" getProtocolByName :: ProtocolName -> IO ProtocolEntry getProtocolByName name = withLock $ do withCString name $ \ name_cstr -> do throwNoSuchThingIfNull "getProtocolByName" ("no such protocol name: " ++ name) $ (trySysCall.c_getprotobyname) name_cstr >>= peek foreign import ccall unsafe "getprotobyname" c_getprotobyname :: CString -> IO (Ptr ProtocolEntry) getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry getProtocolByNumber num = withLock $ do throwNoSuchThingIfNull "getProtocolByNumber" ("no such protocol number: " ++ show num) $ (trySysCall.c_getprotobynumber) (fromIntegral num) >>= peek foreign import ccall unsafe "getprotobynumber" c_getprotobynumber :: CInt -> IO (Ptr ProtocolEntry) getProtocolNumber :: ProtocolName -> IO ProtocolNumber getProtocolNumber proto = do (ProtocolEntry _ _ num) <- getProtocolByName proto return num -- | This is the default protocol for the given service. defaultProtocol :: ProtocolNumber defaultProtocol = 0 #if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB getProtocolEntry = withLock $ do ent <- throwNoSuchThingIfNull "getProtocolEntry" "no such protocol entry" $ trySysCall c_getprotoent peek ent foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry) setProtocolEntry :: Bool -> IO () -- Keep DB Open ? setProtocolEntry flg = withLock $ trySysCall $ c_setprotoent (fromBool flg) foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO () endProtocolEntry :: IO () endProtocolEntry = withLock $ trySysCall $ c_endprotoent foreign import ccall unsafe "endprotoent" c_endprotoent :: IO () getProtocolEntries :: Bool -> IO [ProtocolEntry] getProtocolEntries stayOpen = withLock $ do setProtocolEntry stayOpen getEntries (getProtocolEntry) (endProtocolEntry) #endif -- --------------------------------------------------------------------------- -- Host lookups data HostEntry = HostEntry { hostName :: HostName, -- Official Name hostAliases :: [HostName], -- aliases hostFamily :: Family, -- Host Type (currently AF_INET) hostAddresses :: [HostAddress] -- Set of Network Addresses (in network byte order) } deriving (Read, Show) INSTANCE_TYPEABLE0(HostEntry,hostEntryTc,"hostEntry") instance Storable HostEntry where sizeOf _ = #const sizeof(struct hostent) alignment _ = alignment (undefined :: CInt) -- ??? peek p = do h_name <- (#peek struct hostent, h_name) p >>= peekCString h_aliases <- (#peek struct hostent, h_aliases) p >>= peekArray0 nullPtr >>= mapM peekCString h_addrtype <- (#peek struct hostent, h_addrtype) p -- h_length <- (#peek struct hostent, h_length) p h_addr_list <- (#peek struct hostent, h_addr_list) p >>= peekArray0 nullPtr >>= mapM peek return (HostEntry { hostName = h_name, hostAliases = h_aliases, hostFamily = unpackFamily h_addrtype, hostAddresses = h_addr_list }) poke p = error "Storable.poke(BSD.ServiceEntry) not implemented" -- convenience function: hostAddress :: HostEntry -> HostAddress hostAddress (HostEntry nm _ _ ls) = case ls of [] -> error ("BSD.hostAddress: empty network address list for " ++ nm) (x:_) -> x -- getHostByName must use the same lock as the *hostent functions -- may cause problems if called concurrently. -- | Resolve a 'HostName' to IPv4 address. getHostByName :: HostName -> IO HostEntry getHostByName name = withLock $ do withCString name $ \ name_cstr -> do ent <- throwNoSuchThingIfNull "getHostByName" "no such host entry" $ trySysCall $ c_gethostbyname name_cstr peek ent foreign import ccall safe "gethostbyname" c_gethostbyname :: CString -> IO (Ptr HostEntry) -- The locking of gethostbyaddr is similar to gethostbyname. -- | Get a 'HostEntry' corresponding to the given address and family. -- Note that only IPv4 is currently supported. getHostByAddr :: Family -> HostAddress -> IO HostEntry getHostByAddr family addr = do with addr $ \ ptr_addr -> withLock $ do throwNoSuchThingIfNull "getHostByAddr" "no such host entry" $ trySysCall $ c_gethostbyaddr ptr_addr (fromIntegral (sizeOf addr)) (packFamily family) >>= peek foreign import ccall safe "gethostbyaddr" c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry) #if defined(HAVE_GETHOSTENT) && !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) getHostEntry :: IO HostEntry getHostEntry = withLock $ do throwNoSuchThingIfNull "getHostEntry" "unable to retrieve host entry" $ trySysCall $ c_gethostent >>= peek foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry) setHostEntry :: Bool -> IO () setHostEntry flg = withLock $ trySysCall $ c_sethostent (fromBool flg) foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO () endHostEntry :: IO () endHostEntry = withLock $ c_endhostent foreign import ccall unsafe "endhostent" c_endhostent :: IO () getHostEntries :: Bool -> IO [HostEntry] getHostEntries stayOpen = do setHostEntry stayOpen getEntries (getHostEntry) (endHostEntry) #endif -- --------------------------------------------------------------------------- -- Accessing network information -- Same set of access functions as for accessing host,protocol and -- service system info, this time for the types of networks supported. -- network addresses are represented in host byte order. type NetworkAddr = CULong type NetworkName = String data NetworkEntry = NetworkEntry { networkName :: NetworkName, -- official name networkAliases :: [NetworkName], -- aliases networkFamily :: Family, -- type networkAddress :: NetworkAddr } deriving (Read, Show) INSTANCE_TYPEABLE0(NetworkEntry,networkEntryTc,"NetworkEntry") instance Storable NetworkEntry where sizeOf _ = #const sizeof(struct hostent) alignment _ = alignment (undefined :: CInt) -- ??? peek p = do n_name <- (#peek struct netent, n_name) p >>= peekCString n_aliases <- (#peek struct netent, n_aliases) p >>= peekArray0 nullPtr >>= mapM peekCString n_addrtype <- (#peek struct netent, n_addrtype) p n_net <- (#peek struct netent, n_net) p return (NetworkEntry { networkName = n_name, networkAliases = n_aliases, networkFamily = unpackFamily (fromIntegral (n_addrtype :: CInt)), networkAddress = n_net }) poke p = error "Storable.poke(BSD.NetEntry) not implemented" #if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) getNetworkByName :: NetworkName -> IO NetworkEntry getNetworkByName name = withLock $ do withCString name $ \ name_cstr -> do throwNoSuchThingIfNull "getNetworkByName" "no such network entry" $ trySysCall $ c_getnetbyname name_cstr >>= peek foreign import ccall unsafe "getnetbyname" c_getnetbyname :: CString -> IO (Ptr NetworkEntry) getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry getNetworkByAddr addr family = withLock $ do throwNoSuchThingIfNull "getNetworkByAddr" "no such network entry" $ trySysCall $ c_getnetbyaddr addr (packFamily family) >>= peek foreign import ccall unsafe "getnetbyaddr" c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry) getNetworkEntry :: IO NetworkEntry getNetworkEntry = withLock $ do throwNoSuchThingIfNull "getNetworkEntry" "no more network entries" $ trySysCall $ c_getnetent >>= peek foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry) -- | Open the network name database. The parameter specifies -- whether a connection is maintained open between various -- networkEntry calls setNetworkEntry :: Bool -> IO () setNetworkEntry flg = withLock $ trySysCall $ c_setnetent (fromBool flg) foreign import ccall unsafe "setnetent" c_setnetent :: CInt -> IO () -- | Close the connection to the network name database. endNetworkEntry :: IO () endNetworkEntry = withLock $ trySysCall $ c_endnetent foreign import ccall unsafe "endnetent" c_endnetent :: IO () -- | Get the list of network entries. getNetworkEntries :: Bool -> IO [NetworkEntry] getNetworkEntries stayOpen = do setNetworkEntry stayOpen getEntries (getNetworkEntry) (endNetworkEntry) #endif -- Mutex for name service lockdown {-# NOINLINE lock #-} lock :: MVar () lock = unsafePerformIO $ newMVar () withLock :: IO a -> IO a withLock act = withMVar lock (\_ -> act) -- --------------------------------------------------------------------------- -- Miscellaneous Functions -- | Calling getHostName returns the standard host name for the current -- processor, as set at boot time. getHostName :: IO HostName getHostName = do let size = 256 allocaArray0 size $ \ cstr -> do throwSocketErrorIfMinus1_ "getHostName" $ c_gethostname cstr (fromIntegral size) peekCString cstr foreign import ccall unsafe "gethostname" c_gethostname :: CString -> CSize -> IO CInt -- Helper function used by the exported functions that provides a -- Haskellised view of the enumerator functions: getEntries :: IO a -- read -> IO () -- at end -> IO [a] getEntries getOne atEnd = loop where loop = do vv <- catch (liftM Just getOne) ((const.return) Nothing) case vv of Nothing -> return [] Just v -> loop >>= \ vs -> atEnd >> return (v:vs) -- --------------------------------------------------------------------------- -- Winsock only: -- The BSD API networking calls made locally return NULL upon failure. -- That failure may very well be due to WinSock not being initialised, -- so if NULL is seen try init'ing and repeat the call. #if !defined(mingw32_HOST_OS) && !defined(_WIN32) trySysCall act = act #else trySysCall act = do ptr <- act if (ptr == nullPtr) then withSocketsDo act else return ptr #endif throwNoSuchThingIfNull :: String -> String -> IO (Ptr a) -> IO (Ptr a) throwNoSuchThingIfNull loc desc act = do ptr <- act if (ptr == nullPtr) then ioError (IOError Nothing NoSuchThing loc desc Nothing) else return ptr hugs98-plus-Sep2006/packages/network/Network/Socket.hsc0000644006511100651110000016247610504340250021623 0ustar rossross{-# OPTIONS -fglasgow-exts -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Network.Socket -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/network/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- The "Network.Socket" module is for when you want full control over -- sockets. Essentially the entire C socket API is exposed through -- this module; in general the operations follow the behaviour of the C -- functions of the same name (consult your favourite Unix networking book). -- -- A higher level interface to networking operations is provided -- through the module "Network". -- ----------------------------------------------------------------------------- #include "HsNet.h" -- NOTE: ##, we want this interpreted when compiling the .hs, not by hsc2hs. ##include "Typeable.h" #if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS) #define WITH_WINSOCK 1 #endif #if !defined(mingw32_HOST_OS) && !defined(_WIN32) #define DOMAIN_SOCKET_SUPPORT 1 #endif #if !defined(CALLCONV) #ifdef WITH_WINSOCK #define CALLCONV stdcall #else #define CALLCONV ccall #endif #endif -- In order to process this file, you need to have CALLCONV defined. module Network.Socket ( -- * Types Socket(..), -- instance Eq, Show Family(..), SocketType(..), SockAddr(..), SocketStatus(..), HostAddress, ShutdownCmd(..), ProtocolNumber, PortNumber(..), -- PortNumber is used non-abstractly in Network.BSD. ToDo: remove -- this use and make the type abstract. -- * Socket Operations socket, -- :: Family -> SocketType -> ProtocolNumber -> IO Socket #if defined(DOMAIN_SOCKET_SUPPORT) socketPair, -- :: Family -> SocketType -> ProtocolNumber -> IO (Socket, Socket) #endif connect, -- :: Socket -> SockAddr -> IO () bindSocket, -- :: Socket -> SockAddr -> IO () listen, -- :: Socket -> Int -> IO () accept, -- :: Socket -> IO (Socket, SockAddr) getPeerName, -- :: Socket -> IO SockAddr getSocketName, -- :: Socket -> IO SockAddr #ifdef SO_PEERCRED -- get the credentials of our domain socket peer. getPeerCred, -- :: Socket -> IO (CUInt{-pid-}, CUInt{-uid-}, CUInt{-gid-}) #endif socketPort, -- :: Socket -> IO PortNumber socketToHandle, -- :: Socket -> IOMode -> IO Handle sendTo, -- :: Socket -> String -> SockAddr -> IO Int sendBufTo, -- :: Socket -> Ptr a -> Int -> SockAddr -> IO Int recvFrom, -- :: Socket -> Int -> IO (String, Int, SockAddr) recvBufFrom, -- :: Socket -> Ptr a -> Int -> IO (Int, SockAddr) send, -- :: Socket -> String -> IO Int recv, -- :: Socket -> Int -> IO String recvLen, -- :: Socket -> Int -> IO (String, Int) inet_addr, -- :: String -> IO HostAddress inet_ntoa, -- :: HostAddress -> IO String shutdown, -- :: Socket -> ShutdownCmd -> IO () sClose, -- :: Socket -> IO () -- ** Predicates on sockets sIsConnected, -- :: Socket -> IO Bool sIsBound, -- :: Socket -> IO Bool sIsListening, -- :: Socket -> IO Bool sIsReadable, -- :: Socket -> IO Bool sIsWritable, -- :: Socket -> IO Bool -- * Socket options SocketOption(..), getSocketOption, -- :: Socket -> SocketOption -> IO Int setSocketOption, -- :: Socket -> SocketOption -> Int -> IO () -- * File descriptor transmission #ifdef DOMAIN_SOCKET_SUPPORT sendFd, -- :: Socket -> CInt -> IO () recvFd, -- :: Socket -> IO CInt -- Note: these two will disappear shortly sendAncillary, -- :: Socket -> Int -> Int -> Int -> Ptr a -> Int -> IO () recvAncillary, -- :: Socket -> Int -> Int -> IO (Int,Int,Int,Ptr a) #endif -- * Special Constants aNY_PORT, -- :: PortNumber iNADDR_ANY, -- :: HostAddress sOMAXCONN, -- :: Int sOL_SOCKET, -- :: Int #ifdef SCM_RIGHTS sCM_RIGHTS, -- :: Int #endif maxListenQueue, -- :: Int -- * Initialisation withSocketsDo, -- :: IO a -> IO a -- * Very low level operations -- in case you ever want to get at the underlying file descriptor.. fdSocket, -- :: Socket -> CInt mkSocket, -- :: CInt -> Family -- -> SocketType -- -> ProtocolNumber -- -> SocketStatus -- -> IO Socket -- * Internal -- | The following are exported ONLY for use in the BSD module and -- should not be used anywhere else. packFamily, unpackFamily, packSocketType, throwSocketErrorIfMinus1_ ) where #ifdef __HUGS__ import Hugs.Prelude ( IOException(..), IOErrorType(..) ) import Hugs.IO ( openFd ) {-# CFILES cbits/HsNet.c #-} # if HAVE_STRUCT_MSGHDR_MSG_CONTROL || HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS {-# CFILES cbits/ancilData.c #-} # endif # if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) {-# CFILES cbits/initWinSock.c cbits/winSockErr.c #-} # endif #endif import Data.Word ( Word8, Word16, Word32 ) import Foreign.Ptr ( Ptr, castPtr, plusPtr ) import Foreign.Storable ( Storable(..) ) import Foreign.C.Error import Foreign.C.String ( withCString, peekCString, peekCStringLen, castCharToCChar ) import Foreign.C.Types ( CInt, CUInt, CChar, CSize ) import Foreign.Marshal.Alloc ( alloca, allocaBytes ) import Foreign.Marshal.Array ( peekArray, pokeArray0 ) import Foreign.Marshal.Utils ( with ) import System.IO import Control.Monad ( liftM, when ) import Data.Ratio ( (%) ) import qualified Control.Exception import Control.Concurrent.MVar import Data.Typeable #ifdef __GLASGOW_HASKELL__ import GHC.Conc (threadWaitRead, threadWaitWrite) # if defined(mingw32_HOST_OS) import GHC.Conc ( asyncDoProc ) import Foreign( FunPtr ) # endif import GHC.Handle import GHC.IOBase import qualified System.Posix.Internals #else import System.IO.Unsafe (unsafePerformIO) #endif ----------------------------------------------------------------------------- -- Socket types -- There are a few possible ways to do this. The first is convert the -- structs used in the C library into an equivalent Haskell type. An -- other possible implementation is to keep all the internals in the C -- code and use an Int## and a status flag. The second method is used -- here since a lot of the C structures are not required to be -- manipulated. -- Originally the status was non-mutable so we had to return a new -- socket each time we changed the status. This version now uses -- mutable variables to avoid the need to do this. The result is a -- cleaner interface and better security since the application -- programmer now can't circumvent the status information to perform -- invalid operations on sockets. data SocketStatus -- Returned Status Function called = NotConnected -- socket | Bound -- bindSocket | Listening -- listen | Connected -- connect/accept | ConvertedToHandle -- is now a Handle, don't touch deriving (Eq, Show) INSTANCE_TYPEABLE0(SocketStatus,socketStatusTc,"SocketStatus") data Socket = MkSocket CInt -- File Descriptor Family SocketType ProtocolNumber -- Protocol Number (MVar SocketStatus) -- Status Flag INSTANCE_TYPEABLE0(Socket,socketTc,"Socket") mkSocket :: CInt -> Family -> SocketType -> ProtocolNumber -> SocketStatus -> IO Socket mkSocket fd fam sType pNum stat = do mStat <- newMVar stat return (MkSocket fd fam sType pNum mStat) instance Eq Socket where (MkSocket _ _ _ _ m1) == (MkSocket _ _ _ _ m2) = m1 == m2 instance Show Socket where showsPrec n (MkSocket fd _ _ _ _) = showString "" fdSocket :: Socket -> CInt fdSocket (MkSocket fd _ _ _ _) = fd type ProtocolNumber = CInt -- NOTE: HostAddresses are represented in network byte order. -- Functions that expect the address in machine byte order -- will have to perform the necessary translation. type HostAddress = Word32 ---------------------------------------------------------------------------- -- Port Numbers -- -- newtyped to prevent accidental use of sane-looking -- port numbers that haven't actually been converted to -- network-byte-order first. -- newtype PortNumber = PortNum Word16 deriving ( Eq, Ord ) INSTANCE_TYPEABLE0(PortNumber,portNumberTc,"PortNumber") instance Show PortNumber where showsPrec p pn = showsPrec p (portNumberToInt pn) intToPortNumber :: Int -> PortNumber intToPortNumber v = PortNum (htons (fromIntegral v)) portNumberToInt :: PortNumber -> Int portNumberToInt (PortNum po) = fromIntegral (ntohs po) foreign import CALLCONV unsafe "ntohs" ntohs :: Word16 -> Word16 foreign import CALLCONV unsafe "htons" htons :: Word16 -> Word16 --foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32 foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32 instance Enum PortNumber where toEnum = intToPortNumber fromEnum = portNumberToInt instance Num PortNumber where fromInteger i = intToPortNumber (fromInteger i) -- for completeness. (+) x y = intToPortNumber (portNumberToInt x + portNumberToInt y) (-) x y = intToPortNumber (portNumberToInt x - portNumberToInt y) negate x = intToPortNumber (-portNumberToInt x) (*) x y = intToPortNumber (portNumberToInt x * portNumberToInt y) abs n = intToPortNumber (abs (portNumberToInt n)) signum n = intToPortNumber (signum (portNumberToInt n)) instance Real PortNumber where toRational x = toInteger x % 1 instance Integral PortNumber where quotRem a b = let (c,d) = quotRem (portNumberToInt a) (portNumberToInt b) in (intToPortNumber c, intToPortNumber d) toInteger a = toInteger (portNumberToInt a) instance Storable PortNumber where sizeOf _ = sizeOf (undefined :: Word16) alignment _ = alignment (undefined :: Word16) poke p (PortNum po) = poke (castPtr p) po peek p = PortNum `liftM` peek (castPtr p) ----------------------------------------------------------------------------- -- SockAddr -- The scheme used for addressing sockets is somewhat quirky. The -- calls in the BSD socket API that need to know the socket address -- all operate in terms of struct sockaddr, a `virtual' type of -- socket address. -- The Internet family of sockets are addressed as struct sockaddr_in, -- so when calling functions that operate on struct sockaddr, we have -- to type cast the Internet socket address into a struct sockaddr. -- Instances of the structure for different families might *not* be -- the same size. Same casting is required of other families of -- sockets such as Xerox NS. Similarly for Unix domain sockets. -- To represent these socket addresses in Haskell-land, we do what BSD -- didn't do, and use a union/algebraic type for the different -- families. Currently only Unix domain sockets and the Internet family -- are supported. data SockAddr -- C Names = SockAddrInet PortNumber -- sin_port (network byte order) HostAddress -- sin_addr (ditto) #if defined(DOMAIN_SOCKET_SUPPORT) | SockAddrUnix String -- sun_path #endif deriving (Eq) INSTANCE_TYPEABLE0(SockAddr,sockAddrTc,"SockAddr") #if defined(WITH_WINSOCK) || defined(cygwin32_HOST_OS) type CSaFamily = (#type unsigned short) #elif defined(darwin_HOST_OS) type CSaFamily = (#type u_char) #else type CSaFamily = (#type sa_family_t) #endif instance Show SockAddr where #if defined(DOMAIN_SOCKET_SUPPORT) showsPrec _ (SockAddrUnix str) = showString str #endif showsPrec _ (SockAddrInet port ha) = showString (unsafePerformIO (inet_ntoa ha)) . showString ":" . shows port -- we can't write an instance of Storable for SockAddr, because the Storable -- class can't easily handle alternatives. Also note that on Darwin, the -- sockaddr structure must be zeroed before use. #if defined(DOMAIN_SOCKET_SUPPORT) pokeSockAddr p (SockAddrUnix path) = do #if defined(darwin_TARGET_OS) zeroMemory p (#const sizeof(struct sockaddr_un)) #endif (#poke struct sockaddr_un, sun_family) p ((#const AF_UNIX) :: CSaFamily) let pathC = map castCharToCChar path pokeArray0 0 ((#ptr struct sockaddr_un, sun_path) p) pathC #endif pokeSockAddr p (SockAddrInet (PortNum port) addr) = do #if defined(darwin_TARGET_OS) zeroMemory p (#const sizeof(struct sockaddr_in)) #endif (#poke struct sockaddr_in, sin_family) p ((#const AF_INET) :: CSaFamily) (#poke struct sockaddr_in, sin_port) p port (#poke struct sockaddr_in, sin_addr) p addr peekSockAddr p = do family <- (#peek struct sockaddr, sa_family) p case family :: CSaFamily of #if defined(DOMAIN_SOCKET_SUPPORT) (#const AF_UNIX) -> do str <- peekCString ((#ptr struct sockaddr_un, sun_path) p) return (SockAddrUnix str) #endif (#const AF_INET) -> do addr <- (#peek struct sockaddr_in, sin_addr) p port <- (#peek struct sockaddr_in, sin_port) p return (SockAddrInet (PortNum port) addr) -- helper function used to zero a structure zeroMemory :: Ptr a -> CSize -> IO () zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes) foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO () -- size of struct sockaddr by family #if defined(DOMAIN_SOCKET_SUPPORT) sizeOfSockAddr_Family AF_UNIX = #const sizeof(struct sockaddr_un) #endif sizeOfSockAddr_Family AF_INET = #const sizeof(struct sockaddr_in) -- size of struct sockaddr by SockAddr #if defined(DOMAIN_SOCKET_SUPPORT) sizeOfSockAddr (SockAddrUnix _) = #const sizeof(struct sockaddr_un) #endif sizeOfSockAddr (SockAddrInet _ _) = #const sizeof(struct sockaddr_in) withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a withSockAddr addr f = do let sz = sizeOfSockAddr addr allocaBytes sz $ \p -> pokeSockAddr p addr >> f (castPtr p) sz withNewSockAddr :: Family -> (Ptr SockAddr -> Int -> IO a) -> IO a withNewSockAddr family f = do let sz = sizeOfSockAddr_Family family allocaBytes sz $ \ptr -> f ptr sz ----------------------------------------------------------------------------- -- Connection Functions -- In the following connection and binding primitives. The names of -- the equivalent C functions have been preserved where possible. It -- should be noted that some of these names used in the C library, -- \tr{bind} in particular, have a different meaning to many Haskell -- programmers and have thus been renamed by appending the prefix -- Socket. -- Create an unconnected socket of the given family, type and -- protocol. The most common invocation of $socket$ is the following: -- ... -- my_socket <- socket AF_INET Stream 6 -- ... socket :: Family -- Family Name (usually AF_INET) -> SocketType -- Socket Type (usually Stream) -> ProtocolNumber -- Protocol Number (getProtocolByName to find value) -> IO Socket -- Unconnected Socket socket family stype protocol = do fd <- throwSocketErrorIfMinus1Retry "socket" $ c_socket (packFamily family) (packSocketType stype) protocol #if !defined(__HUGS__) System.Posix.Internals.setNonBlockingFD fd #endif socket_status <- newMVar NotConnected return (MkSocket fd family stype protocol socket_status) -- Create an unnamed pair of connected sockets, given family, type and -- protocol. Differs from a normal pipe in being a bi-directional channel -- of communication. #if defined(DOMAIN_SOCKET_SUPPORT) socketPair :: Family -- Family Name (usually AF_INET) -> SocketType -- Socket Type (usually Stream) -> ProtocolNumber -- Protocol Number -> IO (Socket, Socket) -- unnamed and connected. socketPair family stype protocol = do allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do rc <- throwSocketErrorIfMinus1Retry "socketpair" $ c_socketpair (packFamily family) (packSocketType stype) protocol fdArr [fd1,fd2] <- peekArray 2 fdArr s1 <- mkSocket fd1 s2 <- mkSocket fd2 return (s1,s2) where mkSocket fd = do #if !defined(__HUGS__) System.Posix.Internals.setNonBlockingFD fd #endif stat <- newMVar Connected return (MkSocket fd family stype protocol stat) foreign import ccall unsafe "socketpair" c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt #endif ----------------------------------------------------------------------------- -- Binding a socket -- -- Given a port number this {\em binds} the socket to that port. This -- means that the programmer is only interested in data being sent to -- that port number. The $Family$ passed to $bindSocket$ must -- be the same as that passed to $socket$. If the special port -- number $aNY\_PORT$ is passed then the system assigns the next -- available use port. -- -- Port numbers for standard unix services can be found by calling -- $getServiceEntry$. These are traditionally port numbers below -- 1000; although there are afew, namely NFS and IRC, which used higher -- numbered ports. -- -- The port number allocated to a socket bound by using $aNY\_PORT$ can be -- found by calling $port$ bindSocket :: Socket -- Unconnected Socket -> SockAddr -- Address to Bind to -> IO () bindSocket (MkSocket s _family _stype _protocol socketStatus) addr = do modifyMVar_ socketStatus $ \ status -> do if status /= NotConnected then ioError (userError ("bindSocket: can't peform bind on socket in status " ++ show status)) else do withSockAddr addr $ \p_addr sz -> do status <- throwSocketErrorIfMinus1Retry "bind" $ c_bind s p_addr (fromIntegral sz) return Bound ----------------------------------------------------------------------------- -- Connecting a socket -- -- Make a connection to an already opened socket on a given machine -- and port. assumes that we have already called createSocket, -- otherwise it will fail. -- -- This is the dual to $bindSocket$. The {\em server} process will -- usually bind to a port number, the {\em client} will then connect -- to the same port number. Port numbers of user applications are -- normally agreed in advance, otherwise we must rely on some meta -- protocol for telling the other side what port number we have been -- allocated. connect :: Socket -- Unconnected Socket -> SockAddr -- Socket address stuff -> IO () connect sock@(MkSocket s _family _stype _protocol socketStatus) addr = do modifyMVar_ socketStatus $ \currentStatus -> do if currentStatus /= NotConnected then ioError (userError ("connect: can't peform connect on socket in status " ++ show currentStatus)) else do withSockAddr addr $ \p_addr sz -> do let connectLoop = do r <- c_connect s p_addr (fromIntegral sz) if r == -1 then do #if !(defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS)) err <- getErrno case () of _ | err == eINTR -> connectLoop _ | err == eINPROGRESS -> connectBlocked -- _ | err == eAGAIN -> connectBlocked otherwise -> throwErrno "connect" #else rc <- c_getLastError case rc of 10093 -> do -- WSANOTINITIALISED withSocketsDo (return ()) r <- c_connect s p_addr (fromIntegral sz) if r == -1 then (c_getLastError >>= throwSocketError "connect") else return r _ -> throwSocketError "connect" rc #endif else return r connectBlocked = do #if !defined(__HUGS__) threadWaitWrite (fromIntegral s) #endif err <- getSocketOption sock SoError if (err == 0) then return 0 else do ioError (errnoToIOError "connect" (Errno (fromIntegral err)) Nothing Nothing) connectLoop return Connected ----------------------------------------------------------------------------- -- Listen -- -- The programmer must call $listen$ to tell the system software that -- they are now interested in receiving data on this port. This must -- be called on the bound socket before any calls to read or write -- data are made. -- The programmer also gives a number which indicates the length of -- the incoming queue of unread messages for this socket. On most -- systems the maximum queue length is around 5. To remove a message -- from the queue for processing a call to $accept$ should be made. listen :: Socket -- Connected & Bound Socket -> Int -- Queue Length -> IO () listen (MkSocket s _family _stype _protocol socketStatus) backlog = do modifyMVar_ socketStatus $ \ status -> do if status /= Bound then ioError (userError ("listen: can't peform listen on socket in status " ++ show status)) else do throwSocketErrorIfMinus1Retry "listen" (c_listen s (fromIntegral backlog)) return Listening ----------------------------------------------------------------------------- -- Accept -- -- A call to `accept' only returns when data is available on the given -- socket, unless the socket has been set to non-blocking. It will -- return a new socket which should be used to read the incoming data and -- should then be closed. Using the socket returned by `accept' allows -- incoming requests to be queued on the original socket. accept :: Socket -- Queue Socket -> IO (Socket, -- Readable Socket SockAddr) -- Peer details accept sock@(MkSocket s family stype protocol status) = do currentStatus <- readMVar status okay <- sIsAcceptable sock if not okay then ioError (userError ("accept: can't perform accept on socket (" ++ (show (family,stype,protocol)) ++") in status " ++ show currentStatus)) else do let sz = sizeOfSockAddr_Family family allocaBytes sz $ \ sockaddr -> do #if defined(mingw32_HOST_OS) && defined(__GLASGOW_HASKELL__) new_sock <- if threaded then with (fromIntegral sz) $ \ ptr_len -> throwErrnoIfMinus1Retry "Network.Socket.accept" $ c_accept_safe s sockaddr ptr_len else do paramData <- c_newAcceptParams s (fromIntegral sz) sockaddr rc <- asyncDoProc c_acceptDoProc paramData new_sock <- c_acceptNewSock paramData c_free paramData when (rc /= 0) (ioError (errnoToIOError "Network.Socket.accept" (Errno (fromIntegral rc)) Nothing Nothing)) return new_sock #else with (fromIntegral sz) $ \ ptr_len -> do new_sock <- # if !defined(__HUGS__) throwErrnoIfMinus1Retry_repeatOnBlock "accept" (threadWaitRead (fromIntegral s)) # endif (c_accept s sockaddr ptr_len) # if !defined(__HUGS__) System.Posix.Internals.setNonBlockingFD new_sock # endif #endif addr <- peekSockAddr sockaddr new_status <- newMVar Connected return ((MkSocket new_sock family stype protocol new_status), addr) #if defined(mingw32_HOST_OS) && !defined(__HUGS__) foreign import ccall unsafe "HsNet.h acceptNewSock" c_acceptNewSock :: Ptr () -> IO CInt foreign import ccall unsafe "HsNet.h newAcceptParams" c_newAcceptParams :: CInt -> CInt -> Ptr a -> IO (Ptr ()) foreign import ccall unsafe "HsNet.h &acceptDoProc" c_acceptDoProc :: FunPtr (Ptr () -> IO Int) foreign import ccall unsafe "free" c_free:: Ptr a -> IO () #endif ----------------------------------------------------------------------------- -- sendTo & recvFrom sendTo :: Socket -- (possibly) bound/connected Socket -> String -- Data to send -> SockAddr -> IO Int -- Number of Bytes sent sendTo sock xs addr = do withCString xs $ \str -> do sendBufTo sock str (length xs) addr sendBufTo :: Socket -- (possibly) bound/connected Socket -> Ptr a -> Int -- Data to send -> SockAddr -> IO Int -- Number of Bytes sent sendBufTo (MkSocket s _family _stype _protocol status) ptr nbytes addr = do withSockAddr addr $ \p_addr sz -> do liftM fromIntegral $ #if !defined(__HUGS__) throwErrnoIfMinus1Retry_repeatOnBlock "sendTo" (threadWaitWrite (fromIntegral s)) $ #endif c_sendto s ptr (fromIntegral $ nbytes) 0{-flags-} p_addr (fromIntegral sz) recvFrom :: Socket -> Int -> IO (String, Int, SockAddr) recvFrom sock nbytes = allocaBytes nbytes $ \ptr -> do (len, sockaddr) <- recvBufFrom sock ptr nbytes str <- peekCStringLen (ptr, len) return (str, len, sockaddr) recvBufFrom :: Socket -> Ptr a -> Int -> IO (Int, SockAddr) recvBufFrom sock@(MkSocket s _family _stype _protocol status) ptr nbytes | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvFrom") | otherwise = withNewSockAddr AF_INET $ \ptr_addr sz -> do alloca $ \ptr_len -> do poke ptr_len (fromIntegral sz) len <- #if !defined(__HUGS__) throwErrnoIfMinus1Retry_repeatOnBlock "recvFrom" (threadWaitRead (fromIntegral s)) $ #endif c_recvfrom s ptr (fromIntegral nbytes) 0{-flags-} ptr_addr ptr_len let len' = fromIntegral len if len' == 0 then ioError (mkEOFError "Network.Socket.recvFrom") else do flg <- sIsConnected sock -- For at least one implementation (WinSock 2), recvfrom() ignores -- filling in the sockaddr for connected TCP sockets. Cope with -- this by using getPeerName instead. sockaddr <- if flg then getPeerName sock else peekSockAddr ptr_addr return (len', sockaddr) ----------------------------------------------------------------------------- -- send & recv send :: Socket -- Bound/Connected Socket -> String -- Data to send -> IO Int -- Number of Bytes sent send (MkSocket s _family _stype _protocol status) xs = do let len = length xs withCString xs $ \str -> do liftM fromIntegral $ #if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) writeRawBufferPtr "Network.Socket.send" (fromIntegral s) True str 0 (fromIntegral len) #else # if !defined(__HUGS__) throwErrnoIfMinus1Retry_repeatOnBlock "send" (threadWaitWrite (fromIntegral s)) $ # endif c_send s str (fromIntegral len) 0{-flags-} #endif recv :: Socket -> Int -> IO String recv sock l = recvLen sock l >>= \ (s,_) -> return s recvLen :: Socket -> Int -> IO (String, Int) recvLen sock@(MkSocket s _family _stype _protocol status) nbytes | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recv") | otherwise = do allocaBytes nbytes $ \ptr -> do len <- #if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) readRawBufferPtr "Network.Socket.recvLen" (fromIntegral s) True ptr 0 (fromIntegral nbytes) #else # if !defined(__HUGS__) throwErrnoIfMinus1Retry_repeatOnBlock "recv" (threadWaitRead (fromIntegral s)) $ # endif c_recv s ptr (fromIntegral nbytes) 0{-flags-} #endif let len' = fromIntegral len if len' == 0 then ioError (mkEOFError "Network.Socket.recv") else do s <- peekCStringLen (ptr,len') return (s, len') -- --------------------------------------------------------------------------- -- socketPort -- -- The port number the given socket is currently connected to can be -- determined by calling $port$, is generally only useful when bind -- was given $aNY\_PORT$. socketPort :: Socket -- Connected & Bound Socket -> IO PortNumber -- Port Number of Socket socketPort sock@(MkSocket _ AF_INET _ _ _) = do (SockAddrInet port _) <- getSocketName sock return port socketPort (MkSocket _ family _ _ _) = ioError (userError ("socketPort: not supported for Family " ++ show family)) -- --------------------------------------------------------------------------- -- getPeerName -- Calling $getPeerName$ returns the address details of the machine, -- other than the local one, which is connected to the socket. This is -- used in programs such as FTP to determine where to send the -- returning data. The corresponding call to get the details of the -- local machine is $getSocketName$. getPeerName :: Socket -> IO SockAddr getPeerName (MkSocket s family _ _ _) = do withNewSockAddr family $ \ptr sz -> do with (fromIntegral sz) $ \int_star -> do throwSocketErrorIfMinus1Retry "getPeerName" $ c_getpeername s ptr int_star sz <- peek int_star peekSockAddr ptr getSocketName :: Socket -> IO SockAddr getSocketName (MkSocket s family _ _ _) = do withNewSockAddr family $ \ptr sz -> do with (fromIntegral sz) $ \int_star -> do throwSocketErrorIfMinus1Retry "getSocketName" $ c_getsockname s ptr int_star peekSockAddr ptr ----------------------------------------------------------------------------- -- Socket Properties data SocketOption = DummySocketOption__ #ifdef SO_DEBUG | Debug {- SO_DEBUG -} #endif #ifdef SO_REUSEADDR | ReuseAddr {- SO_REUSEADDR -} #endif #ifdef SO_TYPE | Type {- SO_TYPE -} #endif #ifdef SO_ERROR | SoError {- SO_ERROR -} #endif #ifdef SO_DONTROUTE | DontRoute {- SO_DONTROUTE -} #endif #ifdef SO_BROADCAST | Broadcast {- SO_BROADCAST -} #endif #ifdef SO_SNDBUF | SendBuffer {- SO_SNDBUF -} #endif #ifdef SO_RCVBUF | RecvBuffer {- SO_RCVBUF -} #endif #ifdef SO_KEEPALIVE | KeepAlive {- SO_KEEPALIVE -} #endif #ifdef SO_OOBINLINE | OOBInline {- SO_OOBINLINE -} #endif #ifdef IP_TTL | TimeToLive {- IP_TTL -} #endif #ifdef TCP_MAXSEG | MaxSegment {- TCP_MAXSEG -} #endif #ifdef TCP_NODELAY | NoDelay {- TCP_NODELAY -} #endif #ifdef SO_LINGER | Linger {- SO_LINGER -} #endif #ifdef SO_REUSEPORT | ReusePort {- SO_REUSEPORT -} #endif #ifdef SO_RCVLOWAT | RecvLowWater {- SO_RCVLOWAT -} #endif #ifdef SO_SNDLOWAT | SendLowWater {- SO_SNDLOWAT -} #endif #ifdef SO_RCVTIMEO | RecvTimeOut {- SO_RCVTIMEO -} #endif #ifdef SO_SNDTIMEO | SendTimeOut {- SO_SNDTIMEO -} #endif #ifdef SO_USELOOPBACK | UseLoopBack {- SO_USELOOPBACK -} #endif INSTANCE_TYPEABLE0(SocketOption,socketOptionTc,"SocketOption") socketOptLevel :: SocketOption -> CInt socketOptLevel so = case so of #ifdef IP_TTL TimeToLive -> #const IPPROTO_IP #endif #ifdef TCP_MAXSEG MaxSegment -> #const IPPROTO_TCP #endif #ifdef TCP_NODELAY NoDelay -> #const IPPROTO_TCP #endif _ -> #const SOL_SOCKET packSocketOption :: SocketOption -> CInt packSocketOption so = case so of #ifdef SO_DEBUG Debug -> #const SO_DEBUG #endif #ifdef SO_REUSEADDR ReuseAddr -> #const SO_REUSEADDR #endif #ifdef SO_TYPE Type -> #const SO_TYPE #endif #ifdef SO_ERROR SoError -> #const SO_ERROR #endif #ifdef SO_DONTROUTE DontRoute -> #const SO_DONTROUTE #endif #ifdef SO_BROADCAST Broadcast -> #const SO_BROADCAST #endif #ifdef SO_SNDBUF SendBuffer -> #const SO_SNDBUF #endif #ifdef SO_RCVBUF RecvBuffer -> #const SO_RCVBUF #endif #ifdef SO_KEEPALIVE KeepAlive -> #const SO_KEEPALIVE #endif #ifdef SO_OOBINLINE OOBInline -> #const SO_OOBINLINE #endif #ifdef IP_TTL TimeToLive -> #const IP_TTL #endif #ifdef TCP_MAXSEG MaxSegment -> #const TCP_MAXSEG #endif #ifdef TCP_NODELAY NoDelay -> #const TCP_NODELAY #endif #ifdef SO_LINGER Linger -> #const SO_LINGER #endif #ifdef SO_REUSEPORT ReusePort -> #const SO_REUSEPORT #endif #ifdef SO_RCVLOWAT RecvLowWater -> #const SO_RCVLOWAT #endif #ifdef SO_SNDLOWAT SendLowWater -> #const SO_SNDLOWAT #endif #ifdef SO_RCVTIMEO RecvTimeOut -> #const SO_RCVTIMEO #endif #ifdef SO_SNDTIMEO SendTimeOut -> #const SO_SNDTIMEO #endif #ifdef SO_USELOOPBACK UseLoopBack -> #const SO_USELOOPBACK #endif setSocketOption :: Socket -> SocketOption -- Option Name -> Int -- Option Value -> IO () setSocketOption (MkSocket s _ _ _ _) so v = do with (fromIntegral v) $ \ptr_v -> do throwErrnoIfMinus1_ "setSocketOption" $ c_setsockopt s (socketOptLevel so) (packSocketOption so) ptr_v (fromIntegral (sizeOf v)) return () getSocketOption :: Socket -> SocketOption -- Option Name -> IO Int -- Option Value getSocketOption (MkSocket s _ _ _ _) so = do alloca $ \ptr_v -> with (fromIntegral (sizeOf (undefined :: CInt))) $ \ptr_sz -> do throwErrnoIfMinus1 "getSocketOption" $ c_getsockopt s (socketOptLevel so) (packSocketOption so) ptr_v ptr_sz fromIntegral `liftM` peek ptr_v #ifdef SO_PEERCRED -- | Returns the processID, userID and groupID of the socket's peer. -- -- Only available on platforms that support SO_PEERCRED on domain sockets. getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt) getPeerCred sock = do let fd = fdSocket sock let sz = (fromIntegral (#const sizeof(struct ucred))) with sz $ \ ptr_cr -> alloca $ \ ptr_sz -> do poke ptr_sz sz throwErrnoIfMinus1 "getPeerCred" $ c_getsockopt fd (#const SOL_SOCKET) (#const SO_PEERCRED) ptr_cr ptr_sz pid <- (#peek struct ucred, pid) ptr_cr uid <- (#peek struct ucred, uid) ptr_cr gid <- (#peek struct ucred, gid) ptr_cr return (pid, uid, gid) #endif #if defined(DOMAIN_SOCKET_SUPPORT) -- sending/receiving ancillary socket data; low-level mechanism -- for transmitting file descriptors, mainly. sendFd :: Socket -> CInt -> IO () sendFd sock outfd = do let fd = fdSocket sock #if !defined(__HUGS__) throwErrnoIfMinus1Retry_repeatOnBlock "sendFd" (threadWaitWrite (fromIntegral fd)) $ c_sendFd fd outfd #else c_sendFd fd outfd #endif -- Note: If Winsock supported FD-passing, thi would have been -- incorrect (since socket FDs need to be closed via closesocket().) c_close outfd return () recvFd :: Socket -> IO CInt recvFd sock = do let fd = fdSocket sock theFd <- #if !defined(__HUGS__) throwErrnoIfMinus1Retry_repeatOnBlock "recvFd" (threadWaitRead (fromIntegral fd)) $ #endif c_recvFd fd return theFd sendAncillary :: Socket -> Int -> Int -> Int -> Ptr a -> Int -> IO () sendAncillary sock level ty flags datum len = do let fd = fdSocket sock _ <- #if !defined(__HUGS__) throwErrnoIfMinus1Retry_repeatOnBlock "sendAncillary" (threadWaitWrite (fromIntegral fd)) $ #endif c_sendAncillary fd (fromIntegral level) (fromIntegral ty) (fromIntegral flags) datum (fromIntegral len) return () recvAncillary :: Socket -> Int -> Int -> IO (Int,Int,Ptr a,Int) recvAncillary sock flags len = do let fd = fdSocket sock alloca $ \ ptr_len -> alloca $ \ ptr_lev -> alloca $ \ ptr_ty -> alloca $ \ ptr_pData -> do poke ptr_len (fromIntegral len) _ <- #if !defined(__HUGS__) throwErrnoIfMinus1Retry_repeatOnBlock "recvAncillary" (threadWaitRead (fromIntegral fd)) $ #endif c_recvAncillary fd ptr_lev ptr_ty (fromIntegral flags) ptr_pData ptr_len len <- fromIntegral `liftM` peek ptr_len lev <- fromIntegral `liftM` peek ptr_lev ty <- fromIntegral `liftM` peek ptr_ty pD <- peek ptr_pData return (lev,ty,pD, len) foreign import ccall unsafe "sendAncillary" c_sendAncillary :: CInt -> CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt foreign import ccall unsafe "recvAncillary" c_recvAncillary :: CInt -> Ptr CInt -> Ptr CInt -> CInt -> Ptr (Ptr a) -> Ptr CInt -> IO CInt foreign import ccall unsafe "sendFd" c_sendFd :: CInt -> CInt -> IO CInt foreign import ccall unsafe "recvFd" c_recvFd :: CInt -> IO CInt #endif {- A calling sequence table for the main functions is shown in the table below. \begin{figure}[h] \begin{center} \begin{tabular}{|l|c|c|c|c|c|c|c|}d \hline {\bf A Call to} & socket & connect & bindSocket & listen & accept & read & write \\ \hline {\bf Precedes} & & & & & & & \\ \hline socket & & & & & & & \\ \hline connect & + & & & & & & \\ \hline bindSocket & + & & & & & & \\ \hline listen & & & + & & & & \\ \hline accept & & & & + & & & \\ \hline read & & + & & + & + & + & + \\ \hline write & & + & & + & + & + & + \\ \hline \end{tabular} \caption{Sequence Table for Major functions of Socket} \label{tab:api-seq} \end{center} \end{figure} -} -- --------------------------------------------------------------------------- -- OS Dependent Definitions unpackFamily :: CInt -> Family packFamily :: Family -> CInt packSocketType :: SocketType -> CInt -- | Address Families. -- -- This data type might have different constructors depending on what is -- supported by the operating system. data Family = AF_UNSPEC -- unspecified #ifdef AF_UNIX | AF_UNIX -- local to host (pipes, portals #endif #ifdef AF_INET | AF_INET -- internetwork: UDP, TCP, etc #endif #ifdef AF_INET6 | AF_INET6 -- Internet Protocol version 6 #endif #ifdef AF_IMPLINK | AF_IMPLINK -- arpanet imp addresses #endif #ifdef AF_PUP | AF_PUP -- pup protocols: e.g. BSP #endif #ifdef AF_CHAOS | AF_CHAOS -- mit CHAOS protocols #endif #ifdef AF_NS | AF_NS -- XEROX NS protocols #endif #ifdef AF_NBS | AF_NBS -- nbs protocols #endif #ifdef AF_ECMA | AF_ECMA -- european computer manufacturers #endif #ifdef AF_DATAKIT | AF_DATAKIT -- datakit protocols #endif #ifdef AF_CCITT | AF_CCITT -- CCITT protocols, X.25 etc #endif #ifdef AF_SNA | AF_SNA -- IBM SNA #endif #ifdef AF_DECnet | AF_DECnet -- DECnet #endif #ifdef AF_DLI | AF_DLI -- Direct data link interface #endif #ifdef AF_LAT | AF_LAT -- LAT #endif #ifdef AF_HYLINK | AF_HYLINK -- NSC Hyperchannel #endif #ifdef AF_APPLETALK | AF_APPLETALK -- Apple Talk #endif #ifdef AF_ROUTE | AF_ROUTE -- Internal Routing Protocol #endif #ifdef AF_NETBIOS | AF_NETBIOS -- NetBios-style addresses #endif #ifdef AF_NIT | AF_NIT -- Network Interface Tap #endif #ifdef AF_802 | AF_802 -- IEEE 802.2, also ISO 8802 #endif #ifdef AF_ISO | AF_ISO -- ISO protocols #endif #ifdef AF_OSI | AF_OSI -- umbrella of all families used by OSI #endif #ifdef AF_NETMAN | AF_NETMAN -- DNA Network Management #endif #ifdef AF_X25 | AF_X25 -- CCITT X.25 #endif #ifdef AF_AX25 | AF_AX25 #endif #ifdef AF_OSINET | AF_OSINET -- AFI #endif #ifdef AF_GOSSIP | AF_GOSSIP -- US Government OSI #endif #ifdef AF_IPX | AF_IPX -- Novell Internet Protocol #endif #ifdef Pseudo_AF_XTP | Pseudo_AF_XTP -- eXpress Transfer Protocol (no AF) #endif #ifdef AF_CTF | AF_CTF -- Common Trace Facility #endif #ifdef AF_WAN | AF_WAN -- Wide Area Network protocols #endif #ifdef AF_SDL | AF_SDL -- SGI Data Link for DLPI #endif #ifdef AF_NETWARE | AF_NETWARE #endif #ifdef AF_NDD | AF_NDD #endif #ifdef AF_INTF | AF_INTF -- Debugging use only #endif #ifdef AF_COIP | AF_COIP -- connection-oriented IP, aka ST II #endif #ifdef AF_CNT | AF_CNT -- Computer Network Technology #endif #ifdef Pseudo_AF_RTIP | Pseudo_AF_RTIP -- Help Identify RTIP packets #endif #ifdef Pseudo_AF_PIP | Pseudo_AF_PIP -- Help Identify PIP packets #endif #ifdef AF_SIP | AF_SIP -- Simple Internet Protocol #endif #ifdef AF_ISDN | AF_ISDN -- Integrated Services Digital Network #endif #ifdef Pseudo_AF_KEY | Pseudo_AF_KEY -- Internal key-management function #endif #ifdef AF_NATM | AF_NATM -- native ATM access #endif #ifdef AF_ARP | AF_ARP -- (rev.) addr. res. prot. (RFC 826) #endif #ifdef Pseudo_AF_HDRCMPLT | Pseudo_AF_HDRCMPLT -- Used by BPF to not rewrite hdrs in iface output #endif #ifdef AF_ENCAP | AF_ENCAP #endif #ifdef AF_LINK | AF_LINK -- Link layer interface #endif #ifdef AF_RAW | AF_RAW -- Link layer interface #endif #ifdef AF_RIF | AF_RIF -- raw interface #endif #ifdef AF_NETROM | AF_NETROM -- Amateur radio NetROM #endif #ifdef AF_BRIDGE | AF_BRIDGE -- multiprotocol bridge #endif #ifdef AF_ATMPVC | AF_ATMPVC -- ATM PVCs #endif #ifdef AF_ROSE | AF_ROSE -- Amateur Radio X.25 PLP #endif #ifdef AF_NETBEUI | AF_NETBEUI -- 802.2LLC #endif #ifdef AF_SECURITY | AF_SECURITY -- Security callback pseudo AF #endif #ifdef AF_PACKET | AF_PACKET -- Packet family #endif #ifdef AF_ASH | AF_ASH -- Ash #endif #ifdef AF_ECONET | AF_ECONET -- Acorn Econet #endif #ifdef AF_ATMSVC | AF_ATMSVC -- ATM SVCs #endif #ifdef AF_IRDA | AF_IRDA -- IRDA sockets #endif #ifdef AF_PPPOX | AF_PPPOX -- PPPoX sockets #endif #ifdef AF_WANPIPE | AF_WANPIPE -- Wanpipe API sockets #endif #ifdef AF_BLUETOOTH | AF_BLUETOOTH -- bluetooth sockets #endif deriving (Eq, Ord, Read, Show) ------ ------ packFamily f = case f of AF_UNSPEC -> #const AF_UNSPEC #ifdef AF_UNIX AF_UNIX -> #const AF_UNIX #endif #ifdef AF_INET AF_INET -> #const AF_INET #endif #ifdef AF_INET6 AF_INET6 -> #const AF_INET6 #endif #ifdef AF_IMPLINK AF_IMPLINK -> #const AF_IMPLINK #endif #ifdef AF_PUP AF_PUP -> #const AF_PUP #endif #ifdef AF_CHAOS AF_CHAOS -> #const AF_CHAOS #endif #ifdef AF_NS AF_NS -> #const AF_NS #endif #ifdef AF_NBS AF_NBS -> #const AF_NBS #endif #ifdef AF_ECMA AF_ECMA -> #const AF_ECMA #endif #ifdef AF_DATAKIT AF_DATAKIT -> #const AF_DATAKIT #endif #ifdef AF_CCITT AF_CCITT -> #const AF_CCITT #endif #ifdef AF_SNA AF_SNA -> #const AF_SNA #endif #ifdef AF_DECnet AF_DECnet -> #const AF_DECnet #endif #ifdef AF_DLI AF_DLI -> #const AF_DLI #endif #ifdef AF_LAT AF_LAT -> #const AF_LAT #endif #ifdef AF_HYLINK AF_HYLINK -> #const AF_HYLINK #endif #ifdef AF_APPLETALK AF_APPLETALK -> #const AF_APPLETALK #endif #ifdef AF_ROUTE AF_ROUTE -> #const AF_ROUTE #endif #ifdef AF_NETBIOS AF_NETBIOS -> #const AF_NETBIOS #endif #ifdef AF_NIT AF_NIT -> #const AF_NIT #endif #ifdef AF_802 AF_802 -> #const AF_802 #endif #ifdef AF_ISO AF_ISO -> #const AF_ISO #endif #ifdef AF_OSI AF_OSI -> #const AF_OSI #endif #ifdef AF_NETMAN AF_NETMAN -> #const AF_NETMAN #endif #ifdef AF_X25 AF_X25 -> #const AF_X25 #endif #ifdef AF_AX25 AF_AX25 -> #const AF_AX25 #endif #ifdef AF_OSINET AF_OSINET -> #const AF_OSINET #endif #ifdef AF_GOSSIP AF_GOSSIP -> #const AF_GOSSIP #endif #ifdef AF_IPX AF_IPX -> #const AF_IPX #endif #ifdef Pseudo_AF_XTP Pseudo_AF_XTP -> #const Pseudo_AF_XTP #endif #ifdef AF_CTF AF_CTF -> #const AF_CTF #endif #ifdef AF_WAN AF_WAN -> #const AF_WAN #endif #ifdef AF_SDL AF_SDL -> #const AF_SDL #endif #ifdef AF_NETWARE AF_NETWARE -> #const AF_NETWARE #endif #ifdef AF_NDD AF_NDD -> #const AF_NDD #endif #ifdef AF_INTF AF_INTF -> #const AF_INTF #endif #ifdef AF_COIP AF_COIP -> #const AF_COIP #endif #ifdef AF_CNT AF_CNT -> #const AF_CNT #endif #ifdef Pseudo_AF_RTIP Pseudo_AF_RTIP -> #const Pseudo_AF_RTIP #endif #ifdef Pseudo_AF_PIP Pseudo_AF_PIP -> #const Pseudo_AF_PIP #endif #ifdef AF_SIP AF_SIP -> #const AF_SIP #endif #ifdef AF_ISDN AF_ISDN -> #const AF_ISDN #endif #ifdef Pseudo_AF_KEY Pseudo_AF_KEY -> #const Pseudo_AF_KEY #endif #ifdef AF_NATM AF_NATM -> #const AF_NATM #endif #ifdef AF_ARP AF_ARP -> #const AF_ARP #endif #ifdef Pseudo_AF_HDRCMPLT Pseudo_AF_HDRCMPLT -> #const Pseudo_AF_HDRCMPLT #endif #ifdef AF_ENCAP AF_ENCAP -> #const AF_ENCAP #endif #ifdef AF_LINK AF_LINK -> #const AF_LINK #endif #ifdef AF_RAW AF_RAW -> #const AF_RAW #endif #ifdef AF_RIF AF_RIF -> #const AF_RIF #endif #ifdef AF_NETROM AF_NETROM -> #const AF_NETROM #endif #ifdef AF_BRIDGE AF_BRIDGE -> #const AF_BRIDGE #endif #ifdef AF_ATMPVC AF_ATMPVC -> #const AF_ATMPVC #endif #ifdef AF_ROSE AF_ROSE -> #const AF_ROSE #endif #ifdef AF_NETBEUI AF_NETBEUI -> #const AF_NETBEUI #endif #ifdef AF_SECURITY AF_SECURITY -> #const AF_SECURITY #endif #ifdef AF_PACKET AF_PACKET -> #const AF_PACKET #endif #ifdef AF_ASH AF_ASH -> #const AF_ASH #endif #ifdef AF_ECONET AF_ECONET -> #const AF_ECONET #endif #ifdef AF_ATMSVC AF_ATMSVC -> #const AF_ATMSVC #endif #ifdef AF_IRDA AF_IRDA -> #const AF_IRDA #endif #ifdef AF_PPPOX AF_PPPOX -> #const AF_PPPOX #endif #ifdef AF_WANPIPE AF_WANPIPE -> #const AF_WANPIPE #endif #ifdef AF_BLUETOOTH AF_BLUETOOTH -> #const AF_BLUETOOTH #endif --------- ---------- unpackFamily f = case f of (#const AF_UNSPEC) -> AF_UNSPEC #ifdef AF_UNIX (#const AF_UNIX) -> AF_UNIX #endif #ifdef AF_INET (#const AF_INET) -> AF_INET #endif #ifdef AF_INET6 (#const AF_INET6) -> AF_INET6 #endif #ifdef AF_IMPLINK (#const AF_IMPLINK) -> AF_IMPLINK #endif #ifdef AF_PUP (#const AF_PUP) -> AF_PUP #endif #ifdef AF_CHAOS (#const AF_CHAOS) -> AF_CHAOS #endif #ifdef AF_NS (#const AF_NS) -> AF_NS #endif #ifdef AF_NBS (#const AF_NBS) -> AF_NBS #endif #ifdef AF_ECMA (#const AF_ECMA) -> AF_ECMA #endif #ifdef AF_DATAKIT (#const AF_DATAKIT) -> AF_DATAKIT #endif #ifdef AF_CCITT (#const AF_CCITT) -> AF_CCITT #endif #ifdef AF_SNA (#const AF_SNA) -> AF_SNA #endif #ifdef AF_DECnet (#const AF_DECnet) -> AF_DECnet #endif #ifdef AF_DLI (#const AF_DLI) -> AF_DLI #endif #ifdef AF_LAT (#const AF_LAT) -> AF_LAT #endif #ifdef AF_HYLINK (#const AF_HYLINK) -> AF_HYLINK #endif #ifdef AF_APPLETALK (#const AF_APPLETALK) -> AF_APPLETALK #endif #ifdef AF_ROUTE (#const AF_ROUTE) -> AF_ROUTE #endif #ifdef AF_NETBIOS (#const AF_NETBIOS) -> AF_NETBIOS #endif #ifdef AF_NIT (#const AF_NIT) -> AF_NIT #endif #ifdef AF_802 (#const AF_802) -> AF_802 #endif #ifdef AF_ISO (#const AF_ISO) -> AF_ISO #endif #ifdef AF_OSI # if (!defined(AF_ISO)) || (defined(AF_ISO) && (AF_ISO != AF_OSI)) (#const AF_OSI) -> AF_OSI # endif #endif #ifdef AF_NETMAN (#const AF_NETMAN) -> AF_NETMAN #endif #ifdef AF_X25 (#const AF_X25) -> AF_X25 #endif #ifdef AF_AX25 (#const AF_AX25) -> AF_AX25 #endif #ifdef AF_OSINET (#const AF_OSINET) -> AF_OSINET #endif #ifdef AF_GOSSIP (#const AF_GOSSIP) -> AF_GOSSIP #endif #ifdef AF_IPX (#const AF_IPX) -> AF_IPX #endif #ifdef Pseudo_AF_XTP (#const Pseudo_AF_XTP) -> Pseudo_AF_XTP #endif #ifdef AF_CTF (#const AF_CTF) -> AF_CTF #endif #ifdef AF_WAN (#const AF_WAN) -> AF_WAN #endif #ifdef AF_SDL (#const AF_SDL) -> AF_SDL #endif #ifdef AF_NETWARE (#const AF_NETWARE) -> AF_NETWARE #endif #ifdef AF_NDD (#const AF_NDD) -> AF_NDD #endif #ifdef AF_INTF (#const AF_INTF) -> AF_INTF #endif #ifdef AF_COIP (#const AF_COIP) -> AF_COIP #endif #ifdef AF_CNT (#const AF_CNT) -> AF_CNT #endif #ifdef Pseudo_AF_RTIP (#const Pseudo_AF_RTIP) -> Pseudo_AF_RTIP #endif #ifdef Pseudo_AF_PIP (#const Pseudo_AF_PIP) -> Pseudo_AF_PIP #endif #ifdef AF_SIP (#const AF_SIP) -> AF_SIP #endif #ifdef AF_ISDN (#const AF_ISDN) -> AF_ISDN #endif #ifdef Pseudo_AF_KEY (#const Pseudo_AF_KEY) -> Pseudo_AF_KEY #endif #ifdef AF_NATM (#const AF_NATM) -> AF_NATM #endif #ifdef AF_ARP (#const AF_ARP) -> AF_ARP #endif #ifdef Pseudo_AF_HDRCMPLT (#const Pseudo_AF_HDRCMPLT) -> Pseudo_AF_HDRCMPLT #endif #ifdef AF_ENCAP (#const AF_ENCAP) -> AF_ENCAP #endif #ifdef AF_LINK (#const AF_LINK) -> AF_LINK #endif #ifdef AF_RAW (#const AF_RAW) -> AF_RAW #endif #ifdef AF_RIF (#const AF_RIF) -> AF_RIF #endif #ifdef AF_NETROM (#const AF_NETROM) -> AF_NETROM #endif #ifdef AF_BRIDGE (#const AF_BRIDGE) -> AF_BRIDGE #endif #ifdef AF_ATMPVC (#const AF_ATMPVC) -> AF_ATMPVC #endif #ifdef AF_ROSE (#const AF_ROSE) -> AF_ROSE #endif #ifdef AF_NETBEUI (#const AF_NETBEUI) -> AF_NETBEUI #endif #ifdef AF_SECURITY (#const AF_SECURITY) -> AF_SECURITY #endif #ifdef AF_PACKET (#const AF_PACKET) -> AF_PACKET #endif #ifdef AF_ASH (#const AF_ASH) -> AF_ASH #endif #ifdef AF_ECONET (#const AF_ECONET) -> AF_ECONET #endif #ifdef AF_ATMSVC (#const AF_ATMSVC) -> AF_ATMSVC #endif #ifdef AF_IRDA (#const AF_IRDA) -> AF_IRDA #endif #ifdef AF_PPPOX (#const AF_PPPOX) -> AF_PPPOX #endif #ifdef AF_WANPIPE (#const AF_WANPIPE) -> AF_WANPIPE #endif #ifdef AF_BLUETOOTH (#const AF_BLUETOOTH) -> AF_BLUETOOTH #endif -- Socket Types. -- | Socket Types. -- -- This data type might have different constructors depending on what is -- supported by the operating system. data SocketType = NoSocketType #ifdef SOCK_STREAM | Stream #endif #ifdef SOCK_DGRAM | Datagram #endif #ifdef SOCK_RAW | Raw #endif #ifdef SOCK_RDM | RDM #endif #ifdef SOCK_SEQPACKET | SeqPacket #endif deriving (Eq, Ord, Read, Show) INSTANCE_TYPEABLE0(SocketType,socketTypeTc,"SocketType") packSocketType stype = case stype of NoSocketType -> 0 #ifdef SOCK_STREAM Stream -> #const SOCK_STREAM #endif #ifdef SOCK_DGRAM Datagram -> #const SOCK_DGRAM #endif #ifdef SOCK_RAW Raw -> #const SOCK_RAW #endif #ifdef SOCK_RDM RDM -> #const SOCK_RDM #endif #ifdef SOCK_SEQPACKET SeqPacket -> #const SOCK_SEQPACKET #endif -- --------------------------------------------------------------------------- -- Utility Functions aNY_PORT :: PortNumber aNY_PORT = 0 iNADDR_ANY :: HostAddress iNADDR_ANY = htonl (#const INADDR_ANY) sOMAXCONN :: Int sOMAXCONN = #const SOMAXCONN sOL_SOCKET :: Int sOL_SOCKET = #const SOL_SOCKET #ifdef SCM_RIGHTS sCM_RIGHTS :: Int sCM_RIGHTS = #const SCM_RIGHTS #endif maxListenQueue :: Int maxListenQueue = sOMAXCONN -- ----------------------------------------------------------------------------- data ShutdownCmd = ShutdownReceive | ShutdownSend | ShutdownBoth INSTANCE_TYPEABLE0(ShutdownCmd,shutdownCmdTc,"ShutdownCmd") sdownCmdToInt :: ShutdownCmd -> CInt sdownCmdToInt ShutdownReceive = 0 sdownCmdToInt ShutdownSend = 1 sdownCmdToInt ShutdownBoth = 2 shutdown :: Socket -> ShutdownCmd -> IO () shutdown (MkSocket s _ _ _ _) stype = do throwSocketErrorIfMinus1Retry "shutdown" (c_shutdown s (sdownCmdToInt stype)) return () -- ----------------------------------------------------------------------------- -- | Closes a socket sClose :: Socket -> IO () sClose (MkSocket s _ _ _ socketStatus) = do withMVar socketStatus $ \ status -> if status == ConvertedToHandle then ioError (userError ("sClose: converted to a Handle, use hClose instead")) else c_close s; return () -- ----------------------------------------------------------------------------- sIsConnected :: Socket -> IO Bool sIsConnected (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Connected) -- ----------------------------------------------------------------------------- -- Socket Predicates sIsBound :: Socket -> IO Bool sIsBound (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Bound) sIsListening :: Socket -> IO Bool sIsListening (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening) sIsReadable :: Socket -> IO Bool sIsReadable (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening || value == Connected) sIsWritable :: Socket -> IO Bool sIsWritable = sIsReadable -- sort of. sIsAcceptable :: Socket -> IO Bool #if defined(DOMAIN_SOCKET_SUPPORT) sIsAcceptable (MkSocket _ AF_UNIX Stream _ status) = do value <- readMVar status return (value == Connected || value == Bound || value == Listening) sIsAcceptable (MkSocket _ AF_UNIX _ _ _) = return False #endif sIsAcceptable (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Connected || value == Listening) -- ----------------------------------------------------------------------------- -- Internet address manipulation routines: inet_addr :: String -> IO HostAddress inet_addr ipstr = do withCString ipstr $ \str -> do had <- c_inet_addr str if had == -1 then ioError (userError ("inet_addr: Malformed address: " ++ ipstr)) else return had -- network byte order inet_ntoa :: HostAddress -> IO String inet_ntoa haddr = do pstr <- c_inet_ntoa haddr peekCString pstr -- | turns a Socket into an 'Handle'. By default, the new handle is -- unbuffered. Use 'System.IO.hSetBuffering' to change the buffering. -- -- Note that since a 'Handle' is automatically closed by a finalizer -- when it is no longer referenced, you should avoid doing any more -- operations on the 'Socket' after calling 'socketToHandle'. To -- close the 'Socket' after 'socketToHandle', call 'System.IO.hClose' -- on the 'Handle'. #ifndef __PARALLEL_HASKELL__ socketToHandle :: Socket -> IOMode -> IO Handle socketToHandle s@(MkSocket fd _ _ _ socketStatus) mode = do modifyMVar socketStatus $ \ status -> if status == ConvertedToHandle then ioError (userError ("socketToHandle: already a Handle")) else do # ifdef __GLASGOW_HASKELL__ h <- openFd (fromIntegral fd) (Just System.Posix.Internals.Stream) True (show s) mode True{-bin-} # endif # ifdef __HUGS__ h <- openFd (fromIntegral fd) True{-is a socket-} mode True{-bin-} # endif return (ConvertedToHandle, h) #else socketToHandle (MkSocket s family stype protocol status) m = error "socketToHandle not implemented in a parallel setup" #endif mkInvalidRecvArgError :: String -> IOError mkInvalidRecvArgError loc = IOError Nothing #ifdef __GLASGOW_HASKELL__ InvalidArgument #else IllegalOperation #endif loc "non-positive length" Nothing mkEOFError :: String -> IOError mkEOFError loc = IOError Nothing EOF loc "end of file" Nothing -- --------------------------------------------------------------------------- -- WinSock support {-| On Windows operating systems, the networking subsystem has to be initialised using 'withSocketsDo' before any networking operations can be used. eg. > main = withSocketsDo $ do {...} Although this is only strictly necessary on Windows platforms, it is harmless on other platforms, so for portability it is good practice to use it all the time. -} withSocketsDo :: IO a -> IO a #if !defined(WITH_WINSOCK) withSocketsDo x = x #else withSocketsDo act = do x <- initWinSock if ( x /= 0 ) then ioError (userError "Failed to initialise WinSock") else do act `Control.Exception.finally` shutdownWinSock foreign import ccall unsafe "initWinSock" initWinSock :: IO Int foreign import ccall unsafe "shutdownWinSock" shutdownWinSock :: IO () #endif -- --------------------------------------------------------------------------- -- foreign imports from the C library foreign import ccall unsafe "my_inet_ntoa" c_inet_ntoa :: HostAddress -> IO (Ptr CChar) foreign import CALLCONV unsafe "inet_addr" c_inet_addr :: Ptr CChar -> IO HostAddress foreign import CALLCONV unsafe "shutdown" c_shutdown :: CInt -> CInt -> IO CInt #if !defined(WITH_WINSOCK) foreign import ccall unsafe "close" c_close :: CInt -> IO CInt #else foreign import stdcall unsafe "closesocket" c_close :: CInt -> IO CInt #endif foreign import CALLCONV unsafe "socket" c_socket :: CInt -> CInt -> CInt -> IO CInt foreign import CALLCONV unsafe "bind" c_bind :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt foreign import CALLCONV unsafe "connect" c_connect :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt foreign import CALLCONV unsafe "accept" c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt foreign import CALLCONV safe "accept" c_accept_safe :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt foreign import CALLCONV unsafe "listen" c_listen :: CInt -> CInt -> IO CInt #ifdef __GLASGOW_HASKELL__ foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool #endif foreign import CALLCONV unsafe "send" c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt foreign import CALLCONV unsafe "sendto" c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> CInt -> IO CInt foreign import CALLCONV unsafe "recv" c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt foreign import CALLCONV unsafe "recvfrom" c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt foreign import CALLCONV unsafe "getpeername" c_getpeername :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt foreign import CALLCONV unsafe "getsockname" c_getsockname :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt foreign import CALLCONV unsafe "getsockopt" c_getsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt foreign import CALLCONV unsafe "setsockopt" c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt ----------------------------------------------------------------------------- -- Support for thread-safe blocking operations in GHC. #if defined(__GLASGOW_HASKELL__) && !(defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS)) {-# SPECIALISE throwErrnoIfMinus1Retry_mayBlock :: String -> IO CInt -> IO CInt -> IO CInt #-} throwErrnoIfMinus1Retry_mayBlock :: Num a => String -> IO a -> IO a -> IO a throwErrnoIfMinus1Retry_mayBlock name on_block act = do res <- act if res == -1 then do err <- getErrno if err == eINTR then throwErrnoIfMinus1Retry_mayBlock name on_block act else if err == eWOULDBLOCK || err == eAGAIN then on_block else throwErrno name else return res throwErrnoIfMinus1Retry_repeatOnBlock :: Num a => String -> IO b -> IO a -> IO a throwErrnoIfMinus1Retry_repeatOnBlock name on_block act = do throwErrnoIfMinus1Retry_mayBlock name (on_block >> repeat) act where repeat = throwErrnoIfMinus1Retry_repeatOnBlock name on_block act throwSocketErrorIfMinus1Retry name act = throwErrnoIfMinus1Retry name act throwSocketErrorIfMinus1_ :: Num a => String -> IO a -> IO () throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_ #else throwErrnoIfMinus1Retry_mayBlock name _ act = throwSocketErrorIfMinus1Retry name act throwErrnoIfMinus1Retry_repeatOnBlock name _ act = throwSocketErrorIfMinus1Retry name act throwSocketErrorIfMinus1_ :: Num a => String -> IO a -> IO () throwSocketErrorIfMinus1_ name act = do throwSocketErrorIfMinus1Retry name act return () # if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS) throwSocketErrorIfMinus1Retry name act = do r <- act if (r == -1) then do rc <- c_getLastError case rc of 10093 -> do -- WSANOTINITIALISED withSocketsDo (return ()) r <- act if (r == -1) then (c_getLastError >>= throwSocketError name) else return r _ -> throwSocketError name rc else return r throwSocketError name rc = do pstr <- c_getWSError rc str <- peekCString pstr # if __GLASGOW_HASKELL__ ioError (IOError Nothing OtherError name str Nothing) # else ioError (userError (name ++ ": socket error - " ++ str)) # endif foreign import CALLCONV unsafe "WSAGetLastError" c_getLastError :: IO CInt foreign import ccall unsafe "getWSErrorDescr" c_getWSError :: CInt -> IO (Ptr CChar) # else throwSocketErrorIfMinus1Retry name act = throwErrnoIfMinus1Retry name act # endif #endif /* __GLASGOW_HASKELL */ hugs98-plus-Sep2006/packages/network/Network/URI.hs0000644006511100651110000012000510504340250020645 0ustar rossross{-# OPTIONS_GHC -fglasgow-exts -cpp #-} -------------------------------------------------------------------------------- -- | -- Module : Network.URI -- Copyright : (c) 2004, Graham Klyne -- License : BSD-style (see end of this file) -- -- Maintainer : Graham Klyne -- Stability : provisional -- Portability : portable -- -- This module defines functions for handling URIs. It presents substantially the -- same interface as the older GHC Network.URI module, but is implemented using -- Parsec rather than a Regex library that is not available with Hugs. The internal -- representation of URI has been changed so that URI strings are more -- completely preserved when round-tripping to a URI value and back. -- -- In addition, four methods are provided for parsing different -- kinds of URI string (as noted in RFC3986): -- 'parseURI', -- 'parseURIReference', -- 'parseRelativeReference' and -- 'parseAbsoluteURI'. -- -- Further, four methods are provided for classifying different -- kinds of URI string (as noted in RFC3986): -- 'isURI', -- 'isURIReference', -- 'isRelativeReference' and -- 'isAbsoluteURI'. -- -- The long-standing official reference for URI handling was RFC2396 [1], -- as updated by RFC 2732 [2], but this was replaced by a new specification, -- RFC3986 [3] in January 2005. This latter specification has been used -- as the primary reference for constructing the URI parser implemented -- here, and it is intended that there is a direct relationship between -- the syntax definition in that document and this parser implementation. -- -- RFC 1808 [4] contains a number of test cases for relative URI handling. -- Dan Connolly's Python module @uripath.py@ [5] also contains useful details -- and test cases. -- -- Some of the code has been copied from the previous GHC implementation, -- but the parser is replaced with one that performs more complete -- syntax checking of the URI itself, according to RFC3986 [3]. -- -- References -- -- (1) -- -- (2) -- -- (3) -- -- (4) -- -- (5) -- -------------------------------------------------------------------------------- module Network.URI ( -- * The URI type URI(..) , URIAuth(..) , nullURI -- * Parsing , parseURI -- :: String -> Maybe URI , parseURIReference -- :: String -> Maybe URI , parseRelativeReference -- :: String -> Maybe URI , parseAbsoluteURI -- :: String -> Maybe URI -- * Test for strings containing various kinds of URI , isURI , isURIReference , isRelativeReference , isAbsoluteURI , isIPv6address , isIPv4address -- * Relative URIs , relativeTo -- :: URI -> URI -> Maybe URI , nonStrictRelativeTo -- :: URI -> URI -> Maybe URI , relativeFrom -- :: URI -> URI -> URI -- * Operations on URI strings -- | Support for putting strings into URI-friendly -- escaped format and getting them back again. -- This can't be done transparently in all cases, because certain -- characters have different meanings in different kinds of URI. -- The URI spec [3], section 2.4, indicates that all URI components -- should be escaped before they are assembled as a URI: -- \"Once produced, a URI is always in its percent-encoded form\" , uriToString -- :: URI -> ShowS , isReserved, isUnreserved -- :: Char -> Bool , isAllowedInURI, isUnescapedInURI -- :: Char -> Bool , escapeURIChar -- :: (Char->Bool) -> Char -> String , escapeURIString -- :: (Char->Bool) -> String -> String , unEscapeString -- :: String -> String -- * URI Normalization functions , normalizeCase -- :: String -> String , normalizeEscape -- :: String -> String , normalizePathSegments -- :: String -> String -- * Deprecated functions , parseabsoluteURI -- :: String -> Maybe URI , escapeString -- :: String -> (Char->Bool) -> String , reserved, unreserved -- :: Char -> Bool , scheme, authority, path, query, fragment ) where import Text.ParserCombinators.Parsec ( GenParser(..), ParseError(..) , parse, (<|>), (), try , option, many, many1, count, notFollowedBy, lookAhead , char, satisfy, oneOf, string, letter, digit, hexDigit, eof , unexpected ) import Data.Char( ord, chr, isHexDigit, isSpace, toLower, toUpper, digitToInt ) import Debug.Trace( trace ) import Numeric( showIntAtBase ) import Data.Maybe( isJust ) import Control.Monad( MonadPlus(..) ) #ifdef __GLASGOW_HASKELL__ import Data.Typeable ( Typeable ) import Data.Generics ( Data ) #else import Data.Typeable ( Typeable(..), TyCon, mkTyCon, mkTyConApp ) #endif ------------------------------------------------------------ -- The URI datatype ------------------------------------------------------------ -- |Represents a general universal resource identifier using -- its component parts. -- -- For example, for the URI -- -- > foo://anonymous@www.haskell.org:42/ghc?query#frag -- -- the components are: -- data URI = URI { uriScheme :: String -- ^ @foo:@ , uriAuthority :: Maybe URIAuth -- ^ @\/\/anonymous\@www.haskell.org:42@ , uriPath :: String -- ^ @\/ghc@ , uriQuery :: String -- ^ @?query@ , uriFragment :: String -- ^ @#frag@ } deriving (Eq #ifdef __GLASGOW_HASKELL__ , Typeable, Data #endif ) #ifndef __GLASGOW_HASKELL__ uriTc :: TyCon uriTc = mkTyCon "URI" instance Typeable URI where typeOf _ = mkTyConApp uriTc [] #endif -- |Type for authority value within a URI data URIAuth = URIAuth { uriUserInfo :: String -- ^ @anonymous\@@ , uriRegName :: String -- ^ @www.haskell.org@ , uriPort :: String -- ^ @:42@ } deriving (Eq #ifdef __GLASGOW_HASKELL__ , Typeable, Data #endif ) #ifndef __GLASGOW_HASKELL__ uriAuthTc :: TyCon uriAuthTc = mkTyCon "URIAuth" instance Typeable URIAuth where typeOf _ = mkTyConApp uriAuthTc [] #endif -- |Blank URI nullURI :: URI nullURI = URI { uriScheme = "" , uriAuthority = Nothing , uriPath = "" , uriQuery = "" , uriFragment = "" } -- URI as instance of Show. Note that for security reasons, the default -- behaviour is to suppress any userinfo field (see RFC3986, section 7.5). -- This can be overridden by using uriToString directly with first -- argument @id@ (noting that this returns a ShowS value rather than a string). -- -- [[[Another design would be to embed the userinfo mapping function in -- the URIAuth value, with the default value suppressing userinfo formatting, -- but providing a function to return a new URI value with userinfo -- data exposed by show.]]] -- instance Show URI where showsPrec _ uri = uriToString defaultUserInfoMap uri defaultUserInfoMap :: String -> String defaultUserInfoMap uinf = user++newpass where (user,pass) = break (==':') uinf newpass = if null pass || (pass == "@") || (pass == ":@") then pass else ":...@" testDefaultUserInfoMap = [ defaultUserInfoMap "" == "" , defaultUserInfoMap "@" == "@" , defaultUserInfoMap "user@" == "user@" , defaultUserInfoMap "user:@" == "user:@" , defaultUserInfoMap "user:anonymous@" == "user:...@" , defaultUserInfoMap "user:pass@" == "user:...@" , defaultUserInfoMap "user:pass" == "user:...@" , defaultUserInfoMap "user:anonymous" == "user:...@" ] ------------------------------------------------------------ -- Parse a URI ------------------------------------------------------------ -- |Turn a string containing a URI into a 'URI'. -- Returns 'Nothing' if the string is not a valid URI; -- (an absolute URI with optional fragment identifier). -- -- NOTE: this is different from the previous network.URI, -- whose @parseURI@ function works like 'parseURIReference' -- in this module. -- parseURI :: String -> Maybe URI parseURI = parseURIAny uri -- |Parse a URI reference to a 'URI' value. -- Returns 'Nothing' if the string is not a valid URI reference. -- (an absolute or relative URI with optional fragment identifier). -- parseURIReference :: String -> Maybe URI parseURIReference = parseURIAny uriReference -- |Parse a relative URI to a 'URI' value. -- Returns 'Nothing' if the string is not a valid relative URI. -- (a relative URI with optional fragment identifier). -- parseRelativeReference :: String -> Maybe URI parseRelativeReference = parseURIAny relativeRef -- |Parse an absolute URI to a 'URI' value. -- Returns 'Nothing' if the string is not a valid absolute URI. -- (an absolute URI without a fragment identifier). -- parseAbsoluteURI :: String -> Maybe URI parseAbsoluteURI = parseURIAny absoluteURI -- |Test if string contains a valid URI -- (an absolute URI with optional fragment identifier). -- isURI :: String -> Bool isURI = isValidParse uri -- |Test if string contains a valid URI reference -- (an absolute or relative URI with optional fragment identifier). -- isURIReference :: String -> Bool isURIReference = isValidParse uriReference -- |Test if string contains a valid relative URI -- (a relative URI with optional fragment identifier). -- isRelativeReference :: String -> Bool isRelativeReference = isValidParse relativeRef -- |Test if string contains a valid absolute URI -- (an absolute URI without a fragment identifier). -- isAbsoluteURI :: String -> Bool isAbsoluteURI = isValidParse absoluteURI -- |Test if string contains a valid IPv6 address -- isIPv6address :: String -> Bool isIPv6address = isValidParse ipv6address -- |Test if string contains a valid IPv4 address -- isIPv4address :: String -> Bool isIPv4address = isValidParse ipv4address -- |Test function: parse and reconstruct a URI reference -- testURIReference :: String -> String testURIReference uristr = show (parseAll uriReference "" uristr) -- Helper function for turning a string into a URI -- parseURIAny :: URIParser URI -> String -> Maybe URI parseURIAny parser uristr = case parseAll parser "" uristr of Left _ -> Nothing Right u -> Just u -- Helper function to test a string match to a parser -- isValidParse :: URIParser a -> String -> Bool isValidParse parser uristr = case parseAll parser "" uristr of -- Left e -> error (show e) Left _ -> False Right u -> True parseAll :: URIParser a -> String -> String -> Either ParseError a parseAll parser filename uristr = parse newparser filename uristr where newparser = do { res <- parser ; eof ; return res } ------------------------------------------------------------ -- URI parser body based on Parsec elements and combinators ------------------------------------------------------------ -- Parser parser type. -- Currently type URIParser a = GenParser Char () a -- RFC3986, section 2.1 -- -- Parse and return a 'pct-encoded' sequence -- escaped :: URIParser String escaped = do { char '%' ; h1 <- hexDigitChar ; h2 <- hexDigitChar ; return $ ['%',h1,h2] } -- RFC3986, section 2.2 -- -- |Returns 'True' if the character is a \"reserved\" character in a -- URI. To include a literal instance of one of these characters in a -- component of a URI, it must be escaped. -- isReserved :: Char -> Bool isReserved c = isGenDelims c || isSubDelims c isGenDelims c = c `elem` ":/?#[]@" isSubDelims c = c `elem` "!$&'()*+,;=" genDelims :: URIParser String genDelims = do { c <- satisfy isGenDelims ; return [c] } subDelims :: URIParser String subDelims = do { c <- satisfy isSubDelims ; return [c] } -- RFC3986, section 2.3 -- -- |Returns 'True' if the character is an \"unreserved\" character in -- a URI. These characters do not need to be escaped in a URI. The -- only characters allowed in a URI are either \"reserved\", -- \"unreserved\", or an escape sequence (@%@ followed by two hex digits). -- isUnreserved :: Char -> Bool isUnreserved c = isAlphaNumChar c || (c `elem` "-_.~") unreservedChar :: URIParser String unreservedChar = do { c <- satisfy isUnreserved ; return [c] } -- RFC3986, section 3 -- -- URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ] -- -- hier-part = "//" authority path-abempty -- / path-abs -- / path-rootless -- / path-empty uri :: URIParser URI uri = do { us <- try uscheme -- ; ua <- option Nothing ( do { try (string "//") ; uauthority } ) -- ; up <- upath ; (ua,up) <- hierPart ; uq <- option "" ( do { char '?' ; uquery } ) ; uf <- option "" ( do { char '#' ; ufragment } ) ; return $ URI { uriScheme = us , uriAuthority = ua , uriPath = up , uriQuery = uq , uriFragment = uf } } hierPart :: URIParser ((Maybe URIAuth),String) hierPart = do { try (string "//") ; ua <- uauthority ; up <- pathAbEmpty ; return (ua,up) } <|> do { up <- pathAbs ; return (Nothing,up) } <|> do { up <- pathRootLess ; return (Nothing,up) } <|> do { return (Nothing,"") } -- RFC3986, section 3.1 uscheme :: URIParser String uscheme = do { s <- oneThenMany alphaChar (satisfy isSchemeChar) ; char ':' ; return $ s++":" } -- RFC3986, section 3.2 uauthority :: URIParser (Maybe URIAuth) uauthority = do { uu <- option "" (try userinfo) ; uh <- host ; up <- option "" port ; return $ Just $ URIAuth { uriUserInfo = uu , uriRegName = uh , uriPort = up } } -- RFC3986, section 3.2.1 userinfo :: URIParser String userinfo = do { uu <- many (uchar ";:&=+$,") ; char '@' ; return (concat uu ++"@") } -- RFC3986, section 3.2.2 host :: URIParser String host = ipLiteral <|> try ipv4address <|> regName ipLiteral :: URIParser String ipLiteral = do { char '[' ; ua <- ( ipv6address <|> ipvFuture ) ; char ']' ; return $ "[" ++ ua ++ "]" } "IP address literal" ipvFuture :: URIParser String ipvFuture = do { char 'v' ; h <- hexDigitChar ; char '.' ; a <- many1 (satisfy isIpvFutureChar) ; return $ 'c':h:'.':a } isIpvFutureChar c = isUnreserved c || isSubDelims c || (c==';') ipv6address :: URIParser String ipv6address = try ( do { a2 <- count 6 h4c ; a3 <- ls32 ; return $ concat a2 ++ a3 } ) <|> try ( do { string "::" ; a2 <- count 5 h4c ; a3 <- ls32 ; return $ "::" ++ concat a2 ++ a3 } ) <|> try ( do { a1 <- opt_n_h4c_h4 0 ; string "::" ; a2 <- count 4 h4c ; a3 <- ls32 ; return $ a1 ++ "::" ++ concat a2 ++ a3 } ) <|> try ( do { a1 <- opt_n_h4c_h4 1 ; string "::" ; a2 <- count 3 h4c ; a3 <- ls32 ; return $ a1 ++ "::" ++ concat a2 ++ a3 } ) <|> try ( do { a1 <- opt_n_h4c_h4 2 ; string "::" ; a2 <- count 2 h4c ; a3 <- ls32 ; return $ a1 ++ "::" ++ concat a2 ++ a3 } ) <|> try ( do { a1 <- opt_n_h4c_h4 3 ; string "::" ; a2 <- h4c ; a3 <- ls32 ; return $ a1 ++ "::" ++ a2 ++ a3 } ) <|> try ( do { a1 <- opt_n_h4c_h4 4 ; string "::" ; a3 <- ls32 ; return $ a1 ++ "::" ++ a3 } ) <|> try ( do { a1 <- opt_n_h4c_h4 5 ; string "::" ; a3 <- h4 ; return $ a1 ++ "::" ++ a3 } ) <|> try ( do { a1 <- opt_n_h4c_h4 6 ; string "::" ; return $ a1 ++ "::" } ) "IPv6 address" opt_n_h4c_h4 :: Int -> URIParser String opt_n_h4c_h4 n = option "" $ do { a1 <- countMinMax 0 n h4c ; a2 <- h4 ; return $ concat a1 ++ a2 } ls32 :: URIParser String ls32 = try ( do { a1 <- h4c ; a2 <- h4 ; return (a1++a2) } ) <|> ipv4address h4c :: URIParser String h4c = try $ do { a1 <- h4 ; char ':' ; notFollowedBy (char ':') ; return $ a1 ++ ":" } h4 :: URIParser String h4 = countMinMax 1 4 hexDigitChar ipv4address :: URIParser String ipv4address = do { a1 <- decOctet ; char '.' ; a2 <- decOctet ; char '.' ; a3 <- decOctet ; char '.' ; a4 <- decOctet ; return $ a1++"."++a2++"."++a3++"."++a4 } decOctet :: URIParser String decOctet = do { a1 <- countMinMax 1 3 digitChar ; if read a1 > 255 then fail "Decimal octet value too large" else return a1 } regName :: URIParser String regName = do { ss <- countMinMax 0 255 ( unreservedChar <|> escaped <|> subDelims ) ; return $ concat ss } "Registered name" -- RFC3986, section 3.2.3 port :: URIParser String port = do { char ':' ; p <- many digitChar ; return (':':p) } -- -- RFC3986, section 3.3 -- -- path = path-abempty ; begins with "/" or is empty -- / path-abs ; begins with "/" but not "//" -- / path-noscheme ; begins with a non-colon segment -- / path-rootless ; begins with a segment -- / path-empty ; zero characters -- -- path-abempty = *( "/" segment ) -- path-abs = "/" [ segment-nz *( "/" segment ) ] -- path-noscheme = segment-nzc *( "/" segment ) -- path-rootless = segment-nz *( "/" segment ) -- path-empty = 0 -- -- segment = *pchar -- segment-nz = 1*pchar -- segment-nzc = 1*( unreserved / pct-encoded / sub-delims / "@" ) -- -- pchar = unreserved / pct-encoded / sub-delims / ":" / "@" {- upath :: URIParser String upath = pathAbEmpty <|> pathAbs <|> pathNoScheme <|> pathRootLess <|> pathEmpty -} pathAbEmpty :: URIParser String pathAbEmpty = do { ss <- many slashSegment ; return $ concat ss } pathAbs :: URIParser String pathAbs = do { char '/' ; ss <- option "" pathRootLess ; return $ '/':ss } pathNoScheme :: URIParser String pathNoScheme = do { s1 <- segmentNzc ; ss <- many slashSegment ; return $ concat (s1:ss) } pathRootLess :: URIParser String pathRootLess = do { s1 <- segmentNz ; ss <- many slashSegment ; return $ concat (s1:ss) } slashSegment :: URIParser String slashSegment = do { char '/' ; s <- segment ; return ('/':s) } segment :: URIParser String segment = do { ps <- many pchar ; return $ concat ps } segmentNz :: URIParser String segmentNz = do { ps <- many1 pchar ; return $ concat ps } segmentNzc :: URIParser String segmentNzc = do { ps <- many1 (uchar "@") ; return $ concat ps } pchar :: URIParser String pchar = uchar ":@" -- helper function for pchar and friends uchar :: String -> URIParser String uchar extras = unreservedChar <|> escaped <|> subDelims <|> do { c <- oneOf extras ; return [c] } -- RFC3986, section 3.4 uquery :: URIParser String uquery = do { ss <- many $ uchar (":@"++"/?") ; return $ '?':concat ss } -- RFC3986, section 3.5 ufragment :: URIParser String ufragment = do { ss <- many $ uchar (":@"++"/?") ; return $ '#':concat ss } -- Reference, Relative and Absolute URI forms -- -- RFC3986, section 4.1 uriReference :: URIParser URI uriReference = uri <|> relativeRef -- RFC3986, section 4.2 -- -- relative-URI = relative-part [ "?" query ] [ "#" fragment ] -- -- relative-part = "//" authority path-abempty -- / path-abs -- / path-noscheme -- / path-empty relativeRef :: URIParser URI relativeRef = do { notMatching uscheme -- ; ua <- option Nothing ( do { try (string "//") ; uauthority } ) -- ; up <- upath ; (ua,up) <- relativePart ; uq <- option "" ( do { char '?' ; uquery } ) ; uf <- option "" ( do { char '#' ; ufragment } ) ; return $ URI { uriScheme = "" , uriAuthority = ua , uriPath = up , uriQuery = uq , uriFragment = uf } } relativePart :: URIParser ((Maybe URIAuth),String) relativePart = do { try (string "//") ; ua <- uauthority ; up <- pathAbEmpty ; return (ua,up) } <|> do { up <- pathAbs ; return (Nothing,up) } <|> do { up <- pathNoScheme ; return (Nothing,up) } <|> do { return (Nothing,"") } -- RFC3986, section 4.3 absoluteURI :: URIParser URI absoluteURI = do { us <- uscheme -- ; ua <- option Nothing ( do { try (string "//") ; uauthority } ) -- ; up <- upath ; (ua,up) <- hierPart ; uq <- option "" ( do { char '?' ; uquery } ) ; return $ URI { uriScheme = us , uriAuthority = ua , uriPath = up , uriQuery = uq , uriFragment = "" } } -- Imports from RFC 2234 -- NOTE: can't use isAlphaNum etc. because these deal with ISO 8859 -- (and possibly Unicode!) chars. -- [[[Above was a comment originally in GHC Network/URI.hs: -- when IRIs are introduced then most codepoints above 128(?) should -- be treated as unreserved, and higher codepoints for letters should -- certainly be allowed. -- ]]] isAlphaChar c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') isDigitChar c = (c >= '0' && c <= '9') isAlphaNumChar c = isAlphaChar c || isDigitChar c isHexDigitChar c = isHexDigit c isSchemeChar c = (isAlphaNumChar c) || (c `elem` "+-.") alphaChar :: URIParser Char alphaChar = satisfy isAlphaChar -- or: Parsec.letter ? digitChar :: URIParser Char digitChar = satisfy isDigitChar -- or: Parsec.digit ? alphaNumChar :: URIParser Char alphaNumChar = satisfy isAlphaNumChar hexDigitChar :: URIParser Char hexDigitChar = satisfy isHexDigitChar -- or: Parsec.hexDigit ? -- Additional parser combinators for common patterns oneThenMany :: GenParser t s a -> GenParser t s a -> GenParser t s [a] oneThenMany p1 pr = do { a1 <- p1 ; ar <- many pr ; return (a1:ar) } countMinMax :: Int -> Int -> GenParser t s a -> GenParser t s [a] countMinMax m n p | m > 0 = do { a1 <- p ; ar <- countMinMax (m-1) (n-1) p ; return (a1:ar) } countMinMax _ n _ | n <= 0 = return [] countMinMax _ n p = option [] $ do { a1 <- p ; ar <- countMinMax 0 (n-1) p ; return (a1:ar) } notMatching :: Show a => GenParser tok st a -> GenParser tok st () notMatching p = do { a <- try p ; unexpected (show a) } <|> return () ------------------------------------------------------------ -- Reconstruct a URI string ------------------------------------------------------------ -- -- |Turn a 'URI' into a string. -- -- Uses a supplied function to map the userinfo part of the URI. -- -- The Show instance for URI uses a mapping that hides any password -- that may be present in the URI. Use this function with argument @id@ -- to preserve the password in the formatted output. -- uriToString :: (String->String) -> URI -> ShowS uriToString userinfomap URI { uriScheme=scheme , uriAuthority=authority , uriPath=path , uriQuery=query , uriFragment=fragment } = (scheme++) . (uriAuthToString userinfomap authority) . (path++) . (query++) . (fragment++) uriAuthToString :: (String->String) -> (Maybe URIAuth) -> ShowS uriAuthToString _ Nothing = id -- shows "" uriAuthToString userinfomap (Just URIAuth { uriUserInfo = uinfo , uriRegName = regname , uriPort = port } ) = ("//"++) . (if null uinfo then id else ((userinfomap uinfo)++)) . (regname++) . (port++) ------------------------------------------------------------ -- Character classes ------------------------------------------------------------ -- | Returns 'True' if the character is allowed in a URI. -- isAllowedInURI :: Char -> Bool isAllowedInURI c = isReserved c || isUnreserved c || c == '%' -- escape char -- | Returns 'True' if the character is allowed unescaped in a URI. -- isUnescapedInURI :: Char -> Bool isUnescapedInURI c = isReserved c || isUnreserved c ------------------------------------------------------------ -- Escape sequence handling ------------------------------------------------------------ -- |Escape character if supplied predicate is not satisfied, -- otherwise return character as singleton string. -- escapeURIChar :: (Char->Bool) -> Char -> String escapeURIChar p c | p c = [c] | otherwise = '%' : myShowHex (ord c) "" where myShowHex :: Int -> ShowS myShowHex n r = case showIntAtBase 16 (toChrHex) n r of [] -> "00" [c] -> ['0',c] cs -> cs toChrHex d | d < 10 = chr (ord '0' + fromIntegral d) | otherwise = chr (ord 'A' + fromIntegral (d - 10)) -- |Can be used to make a string valid for use in a URI. -- escapeURIString :: (Char->Bool) -- ^ a predicate which returns 'False' -- if the character should be escaped -> String -- ^ the string to process -> String -- ^ the resulting URI string escapeURIString p s = concatMap (escapeURIChar p) s -- |Turns all instances of escaped characters in the string back -- into literal characters. -- unEscapeString :: String -> String unEscapeString [] = "" unEscapeString ('%':x1:x2:s) | isHexDigit x1 && isHexDigit x2 = chr (digitToInt x1 * 16 + digitToInt x2) : unEscapeString s unEscapeString (c:s) = c : unEscapeString s ------------------------------------------------------------ -- Resolving a relative URI relative to a base URI ------------------------------------------------------------ -- |Returns a new 'URI' which represents the value of the -- first 'URI' interpreted as relative to the second 'URI'. -- For example: -- -- > "foo" `relativeTo` "http://bar.org/" = "http://bar.org/foo" -- > "http:foo" `nonStrictRelativeTo` "http://bar.org/" = "http://bar.org/foo" -- -- Algorithm from RFC3986 [3], section 5.2.2 -- nonStrictRelativeTo :: URI -> URI -> Maybe URI nonStrictRelativeTo ref base = relativeTo ref' base where ref' = if uriScheme ref == uriScheme base then ref { uriScheme="" } else ref isDefined :: ( MonadPlus m, Eq (m a) ) => m a -> Bool isDefined a = a /= mzero -- |Compute an absolute 'URI' for a supplied URI -- relative to a given base. relativeTo :: URI -> URI -> Maybe URI relativeTo ref base | isDefined ( uriScheme ref ) = just_segments ref | isDefined ( uriAuthority ref ) = just_segments ref { uriScheme = uriScheme base } | isDefined ( uriPath ref ) = if (head (uriPath ref) == '/') then just_segments ref { uriScheme = uriScheme base , uriAuthority = uriAuthority base } else just_segments ref { uriScheme = uriScheme base , uriAuthority = uriAuthority base , uriPath = mergePaths base ref } | isDefined ( uriQuery ref ) = just_segments ref { uriScheme = uriScheme base , uriAuthority = uriAuthority base , uriPath = uriPath base } | otherwise = just_segments ref { uriScheme = uriScheme base , uriAuthority = uriAuthority base , uriPath = uriPath base , uriQuery = uriQuery base } where just_segments u = Just $ u { uriPath = removeDotSegments (uriPath u) } mergePaths b r | isDefined (uriAuthority b) && null pb = '/':pr | otherwise = dropLast pb ++ pr where pb = uriPath b pr = uriPath r dropLast = fst . splitLast -- reverse . dropWhile (/='/') . reverse -- Remove dot segments, but protect leading '/' character removeDotSegments :: String -> String removeDotSegments ('/':ps) = '/':elimDots ps [] removeDotSegments ps = elimDots ps [] -- Second arg accumulates segments processed so far in reverse order elimDots :: String -> [String] -> String -- elimDots ps rs | traceVal "\nps " ps $ traceVal "rs " rs $ False = error "" elimDots [] [] = "" elimDots [] rs = concat (reverse rs) elimDots ( '.':'/':ps) rs = elimDots ps rs elimDots ( '.':[] ) rs = elimDots [] rs elimDots ( '.':'.':'/':ps) rs = elimDots ps (dropHead rs) elimDots ( '.':'.':[] ) rs = elimDots [] (dropHead rs) elimDots ps rs = elimDots ps1 (r:rs) where (r,ps1) = nextSegment ps -- Return tail of non-null list, otherwise return null list dropHead :: [a] -> [a] dropHead [] = [] dropHead (r:rs) = rs -- Returns the next segment and the rest of the path from a path string. -- Each segment ends with the next '/' or the end of string. -- nextSegment :: String -> (String,String) nextSegment ps = case break (=='/') ps of (r,'/':ps1) -> (r++"/",ps1) (r,_) -> (r,[]) -- Split last (name) segment from path, returning (path,name) splitLast :: String -> (String,String) splitLast path = (reverse revpath,reverse revname) where (revname,revpath) = break (=='/') $ reverse path ------------------------------------------------------------ -- Finding a URI relative to a base URI ------------------------------------------------------------ -- |Returns a new 'URI' which represents the relative location of -- the first 'URI' with respect to the second 'URI'. Thus, the -- values supplied are expected to be absolute URIs, and the result -- returned may be a relative URI. -- -- Example: -- -- > "http://example.com/Root/sub1/name2#frag" -- > `relativeFrom` "http://example.com/Root/sub2/name2#frag" -- > == "../sub2/name2#frag" -- -- There is no single correct implementation of this function, -- but any acceptable implementation must satisfy the following: -- -- > (uabs `relativeFrom` ubase) `relativeTo` ubase == uabs -- -- For any valid absolute URI. -- (cf. -- ) -- relativeFrom :: URI -> URI -> URI relativeFrom uabs base | diff uriScheme uabs base = uabs | diff uriAuthority uabs base = uabs { uriScheme = "" } | diff uriPath uabs base = uabs { uriScheme = "" , uriAuthority = Nothing , uriPath = relPathFrom (removeBodyDotSegments $ uriPath uabs) (removeBodyDotSegments $ uriPath base) } | diff uriQuery uabs base = uabs { uriScheme = "" , uriAuthority = Nothing , uriPath = "" } | otherwise = uabs -- Always carry fragment from uabs { uriScheme = "" , uriAuthority = Nothing , uriPath = "" , uriQuery = "" } where diff sel u1 u2 = sel u1 /= sel u2 -- Remove dot segments except the final segment removeBodyDotSegments p = removeDotSegments p1 ++ p2 where (p1,p2) = splitLast p relPathFrom :: String -> String -> String relPathFrom [] base = "/" relPathFrom pabs [] = pabs relPathFrom pabs base = -- Construct a relative path segments if sa1 == sb1 -- if the paths share a leading segment then if (sa1 == "/") -- other than a leading '/' then if (sa2 == sb2) then relPathFrom1 ra2 rb2 else pabs else relPathFrom1 ra1 rb1 else pabs where (sa1,ra1) = nextSegment pabs (sb1,rb1) = nextSegment base (sa2,ra2) = nextSegment ra1 (sb2,rb2) = nextSegment rb1 -- relPathFrom1 strips off trailing names from the supplied paths, -- and calls difPathFrom to find the relative path from base to -- target relPathFrom1 :: String -> String -> String relPathFrom1 pabs base = relName where (sa,na) = splitLast pabs (sb,nb) = splitLast base rp = relSegsFrom sa sb relName = if null rp then if (na == nb) then "" else if protect na then "./"++na else na else rp++na -- Precede name with some path if it is null or contains a ':' protect na = null na || ':' `elem` na -- relSegsFrom discards any common leading segments from both paths, -- then invokes difSegsFrom to calculate a relative path from the end -- of the base path to the end of the target path. -- The final name is handled separately, so this deals only with -- "directory" segtments. -- relSegsFrom :: String -> String -> String {- relSegsFrom sabs base | traceVal "\nrelSegsFrom\nsabs " sabs $ traceVal "base " base $ False = error "" -} relSegsFrom [] [] = "" -- paths are identical relSegsFrom sabs base = if sa1 == sb1 then relSegsFrom ra1 rb1 else difSegsFrom sabs base where (sa1,ra1) = nextSegment sabs (sb1,rb1) = nextSegment base -- difSegsFrom calculates a path difference from base to target, -- not including the final name at the end of the path -- (i.e. results always ends with '/') -- -- This function operates under the invariant that the supplied -- value of sabs is the desired path relative to the beginning of -- base. Thus, when base is empty, the desired path has been found. -- difSegsFrom :: String -> String -> String {- difSegsFrom sabs base | traceVal "\ndifSegsFrom\nsabs " sabs $ traceVal "base " base $ False = error "" -} difSegsFrom sabs "" = sabs difSegsFrom sabs base = difSegsFrom ("../"++sabs) (snd $ nextSegment base) ------------------------------------------------------------ -- Other normalization functions ------------------------------------------------------------ -- |Case normalization; cf. RFC3986 section 6.2.2.1 -- NOTE: authority case normalization is not performed -- normalizeCase :: String -> String normalizeCase uristr = ncScheme uristr where ncScheme (':':cs) = ':':ncEscape cs ncScheme (c:cs) | isSchemeChar c = toLower c:ncScheme cs ncScheme _ = ncEscape uristr -- no scheme present ncEscape ('%':h1:h2:cs) = '%':toUpper h1:toUpper h2:ncEscape cs ncEscape (c:cs) = c:ncEscape cs ncEscape [] = [] -- |Encoding normalization; cf. RFC3986 section 6.2.2.2 -- normalizeEscape :: String -> String normalizeEscape ('%':h1:h2:cs) | isHexDigit h1 && isHexDigit h2 && isUnreserved escval = escval:normalizeEscape cs where escval = chr (digitToInt h1*16+digitToInt h2) normalizeEscape (c:cs) = c:normalizeEscape cs normalizeEscape [] = [] -- |Path segment normalization; cf. RFC3986 section 6.2.2.4 -- normalizePathSegments :: String -> String normalizePathSegments uristr = normstr juri where juri = parseURI uristr normstr Nothing = uristr normstr (Just u) = show (normuri u) normuri u = u { uriPath = removeDotSegments (uriPath u) } ------------------------------------------------------------ -- Local trace helper functions ------------------------------------------------------------ traceShow :: Show a => String -> a -> a traceShow msg x = trace (msg ++ show x) x traceVal :: Show a => String -> a -> b -> b traceVal msg x y = trace (msg ++ show x) y ------------------------------------------------------------ -- Deprecated functions ------------------------------------------------------------ {-# DEPRECATED parseabsoluteURI "use parseAbsoluteURI" #-} parseabsoluteURI :: String -> Maybe URI parseabsoluteURI = parseAbsoluteURI {-# DEPRECATED escapeString "use escapeURIString, and note the flipped arguments" #-} escapeString :: String -> (Char->Bool) -> String escapeString = flip escapeURIString {-# DEPRECATED reserved "use isReserved" #-} reserved :: Char -> Bool reserved = isReserved {-# DEPRECATED unreserved "use isUnreserved" #-} unreserved :: Char -> Bool unreserved = isUnreserved -- Additional component access functions for backward compatibility {-# DEPRECATED scheme "use uriScheme" #-} scheme :: URI -> String scheme = orNull init . uriScheme {-# DEPRECATED authority "use uriAuthority, and note changed functionality" #-} authority :: URI -> String authority = dropss . ($"") . uriAuthToString id . uriAuthority where -- Old-style authority component does not include leading '//' dropss ('/':'/':s) = s dropss s = s {-# DEPRECATED path "use uriPath" #-} path :: URI -> String path = uriPath {-# DEPRECATED query "use uriQuery, and note changed functionality" #-} query :: URI -> String query = orNull tail . uriQuery {-# DEPRECATED fragment "use uriFragment, and note changed functionality" #-} fragment :: URI -> String fragment = orNull tail . uriFragment orNull :: ([a]->[a]) -> [a] -> [a] orNull _ [] = [] orNull f as = f as -------------------------------------------------------------------------------- -- -- Copyright (c) 2004, G. KLYNE. All rights reserved. -- Distributed as free software under the following license. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions -- are met: -- -- - Redistributions of source code must retain the above copyright notice, -- this list of conditions and the following disclaimer. -- -- - Redistributions in binary form must reproduce the above copyright -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. -- -- - Neither name of the copyright holders nor the names of its -- contributors may be used to endorse or promote products derived from -- this software without specific prior written permission. -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, -- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, -- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS -- OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR -- TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE -- USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- -------------------------------------------------------------------------------- hugs98-plus-Sep2006/packages/network/LICENSE0000644006511100651110000000311310504340250017226 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2002, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/network/Makefile0000644006511100651110000000173610504340250017672 0ustar rossross# ----------------------------------------------------------------------------- # $Id: Makefile,v 1.24 2005/07/21 12:54:33 simonmar Exp $ TOP=.. include $(TOP)/mk/boilerplate.mk SUBDIRS = include ALL_DIRS = Network PACKAGE = network VERSION = 2.0 PACKAGE_DEPS = base parsec html SRC_HC_OPTS += -Iinclude -\#include HsNet.h SRC_CC_OPTS += -Iinclude -I. -I$(GHC_INCLUDE_DIR) SRC_HSC2HS_OPTS += -Iinclude Network/Socket_HC_OPTS += -cpp EXTRA_SRCS += cbits/HsNet.c EXCLUDED_SRCS += Setup.hs # Only bother with cbits/initWinSock.c when it's really needed. ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" EXTRA_SRCS += cbits/initWinSock.c cbits/winSockErr.c cbits/asyncAccept.c Network/Socket_HC_OPTS += -DCALLCONV=stdcall else EXTRA_SRCS += cbits/ancilData.c Network/Socket_HC_OPTS += -DCALLCONV=ccall endif SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries (network package)" DIST_CLEAN_FILES += network.buildinfo config.cache config.status include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/network/cbits/0000755006511100651110000000000010504340250017327 5ustar rossrosshugs98-plus-Sep2006/packages/network/cbits/ancilData.c0000644006511100651110000001162610504340250021361 0ustar rossross/* * Copyright(c), 2002 The GHC Team. */ #ifdef aix_HOST_OS #define _LINUX_SOURCE_COMPAT // Required to get CMSG_SPACE/CMSG_LEN macros. See #265. // Alternative is to #define COMPAT_43 and use the // HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS code instead, but that means // fiddling with the configure script too. #endif #include "HsNet.h" #if HAVE_STRUCT_MSGHDR_MSG_CONTROL || HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS /* until end */ /* * Support for transmitting file descriptors. * * */ /* * sendmsg() and recvmsg() wrappers for transmitting * ancillary socket data. * * Doesn't provide the full generality of either, specifically: * * - no support for scattered read/writes. * - only possible to send one ancillary chunk of data at a time. * * * NOTE: recv/sendAncillary() is being phased out in preference * of the more specific send/recvFd(), as the latter is * really the only application of recv/sendAncillary() and * stand the chance of being supported on platforms that * don't have send/recvmsg() (but do have ioctl() support * for this kind of thing, for instance.) * */ int sendFd(int sock, int outfd) { struct msghdr msg = {0}; struct iovec iov[1]; char buf[2]; #if HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS msg.msg_accrights = (void*)&outfd; msg.msg_accrightslen = sizeof(int); #else struct cmsghdr *cmsg; char ancBuffer[CMSG_SPACE(sizeof(int))]; char* dPtr; msg.msg_control = ancBuffer; msg.msg_controllen = sizeof(ancBuffer); cmsg = CMSG_FIRSTHDR(&msg); cmsg->cmsg_level = SOL_SOCKET; cmsg->cmsg_type = SCM_RIGHTS; cmsg->cmsg_len = CMSG_LEN(sizeof(int)); dPtr = (char*)CMSG_DATA(cmsg); *(int*)dPtr = outfd; msg.msg_controllen = cmsg->cmsg_len; #endif buf[0] = 0; buf[1] = '\0'; iov[0].iov_base = buf; iov[0].iov_len = 2; msg.msg_iov = iov; msg.msg_iovlen = 1; return sendmsg(sock,&msg,0); } int sendAncillary(int sock, int level, int type, int flags, void* data, int len) { struct msghdr msg = {0}; struct iovec iov[1]; char buf[2]; #if HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS /* Contains the older BSD msghdr fields only, so no room for 'type' or 'level' data. */ msg.msg_accrights = data; msg.msg_accrightslen=len; #else struct cmsghdr *cmsg; char ancBuffer[CMSG_SPACE(len)]; char* dPtr; msg.msg_control = ancBuffer; msg.msg_controllen = sizeof(ancBuffer); cmsg = CMSG_FIRSTHDR(&msg); cmsg->cmsg_level = level; cmsg->cmsg_type = type; cmsg->cmsg_len = CMSG_LEN(len); dPtr = (char*)CMSG_DATA(cmsg); memcpy(dPtr, data, len); msg.msg_controllen = cmsg->cmsg_len; #endif buf[0] = 0; buf[1] = '\0'; iov[0].iov_base = buf; iov[0].iov_len = 2; msg.msg_iov = iov; msg.msg_iovlen = 1; return sendmsg(sock,&msg,flags); } int recvFd(int sock) { struct msghdr msg = {0}; char duffBuf[10]; int rc; int len = sizeof(int); struct iovec iov[1]; #if HAVE_STRUCT_MSGHDR_MSG_CONTROL struct cmsghdr *cmsg = NULL; struct cmsghdr *cptr; #else int* fdBuffer; #endif iov[0].iov_base = duffBuf; iov[0].iov_len = sizeof(duffBuf); msg.msg_iov = iov; msg.msg_iovlen = 1; #if HAVE_STRUCT_MSGHDR_MSG_CONTROL cmsg = (struct cmsghdr*)malloc(CMSG_SPACE(len)); if (cmsg==NULL) { return -1; } msg.msg_control = (void *)cmsg; msg.msg_controllen = CMSG_LEN(len); #else fdBuffer = (int*)malloc(len); if (fdBuffer) { msg.msg_accrights = (void *)fdBuffer; } else { return -1; } msg.msg_accrightslen = len; #endif if ((rc = recvmsg(sock,&msg,0)) < 0) { return rc; } #if HAVE_STRUCT_MSGHDR_MSG_CONTROL cptr = (struct cmsghdr*)CMSG_FIRSTHDR(&msg); return *(int*)CMSG_DATA(cptr); #else return *(int*)fdBuffer; #endif } int recvAncillary(int sock, int* pLevel, int* pType, int flags, void** pData, int* pLen) { struct msghdr msg = {0}; char duffBuf[10]; int rc; struct iovec iov[1]; #if HAVE_STRUCT_MSGHDR_MSG_CONTROL struct cmsghdr *cmsg = NULL; struct cmsghdr *cptr; #endif iov[0].iov_base = duffBuf; iov[0].iov_len = sizeof(duffBuf); msg.msg_iov = iov; msg.msg_iovlen = 1; #if HAVE_STRUCT_MSGHDR_MSG_CONTROL cmsg = (struct cmsghdr*)malloc(CMSG_SPACE(*pLen)); if (cmsg==NULL) { return -1; } msg.msg_control = (void *)cmsg; msg.msg_controllen = CMSG_LEN(*pLen); #else *pData = (void*)malloc(*pLen); if (*pData) { msg.msg_accrights = *pData; } else { return -1; } msg.msg_accrightslen = *pLen; #endif if ((rc = recvmsg(sock,&msg,flags)) < 0) { return rc; } #if HAVE_STRUCT_MSGHDR_MSG_CONTROL cptr = (struct cmsghdr*)CMSG_FIRSTHDR(&msg); *pLevel = cptr->cmsg_level; *pType = cptr->cmsg_type; /* The length of the data portion only */ *pLen = cptr->cmsg_len - sizeof(struct cmsghdr); *pData = CMSG_DATA(cptr); #else /* Sensible defaults, I hope.. */ *pLevel = 0; *pType = 0; #endif return rc; } #endif hugs98-plus-Sep2006/packages/network/cbits/HsNet.c0000644006511100651110000000044610504340250020520 0ustar rossross/* ----------------------------------------------------------------------------- * (c) The University of Glasgow 2002 * * static versions of the inline functions from HsNet.h * -------------------------------------------------------------------------- */ #define INLINE #include "HsNet.h" hugs98-plus-Sep2006/packages/network/cbits/asyncAccept.c0000644006511100651110000000261010504340250021727 0ustar rossross/* * (c) sof, 2003. */ #include "HsNet.h" #include "HsFFI.h" #if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) && !defined(__HUGS__) /* all the way to the end */ /* * To support non-blocking accept()s with WinSock, we use the asyncDoProc# * primop, which lets a Haskell thread call an external routine without * blocking the progress of other threads. * * As can readily be seen, this is a low-level mechanism. * */ typedef struct AcceptData { int fdSock; int newSock; void* sockAddr; int size; } AcceptData; /* * Fill in parameter block that's passed along when the RTS invokes the * accept()-calling proc below (acceptDoProc()) */ void* newAcceptParams(int sock, int sz, void* sockaddr) { AcceptData* data = (AcceptData*)malloc(sizeof(AcceptData)); if (!data) return NULL; data->fdSock = sock; data->newSock = 0; data->sockAddr = sockaddr; data->size = sz; return data; } /* Accessors for return code and accept()'s socket result. */ int acceptNewSock(void* d) { return (((AcceptData*)d)->newSock); } /* Routine invoked by an RTS worker thread */ int acceptDoProc(void* param) { SOCKET s; AcceptData* data = (AcceptData*)param; s = accept( data->fdSock, data->sockAddr, &data->size); data->newSock = s; if ( s == INVALID_SOCKET ) { return GetLastError(); } else { return 0; } } #endif hugs98-plus-Sep2006/packages/network/cbits/initWinSock.c0000644006511100651110000000221510504340250021734 0ustar rossross#include "HsNet.h" #include "HsFFI.h" #if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) static int winsock_inited = 0; static int winsock_uninited = 0; /* Initialising WinSock... */ int initWinSock () { WORD wVersionRequested; WSADATA wsaData; int err; #ifdef __HUGS__ int optval = SO_SYNCHRONOUS_NONALERT; #endif if (!winsock_inited) { wVersionRequested = MAKEWORD( 1, 1 ); err = WSAStartup ( wVersionRequested, &wsaData ); if ( err != 0 ) { return err; } if ( LOBYTE( wsaData.wVersion ) != 1 || HIBYTE( wsaData.wVersion ) != 1 ) { WSACleanup(); return (-1); } #ifdef __HUGS__ /* By default, socket() creates sockets in overlapped mode * (so that async I/O is possible). The CRT can only handle * non-overlapped sockets, so turn off overlap mode here. */ setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, &optval, sizeof(optval)); #endif winsock_inited = 1; } return 0; } static void shutdownHandler(void) { WSACleanup(); } void shutdownWinSock() { if (!winsock_uninited) { atexit(shutdownHandler); winsock_uninited = 1; } } #endif hugs98-plus-Sep2006/packages/network/cbits/winSockErr.c0000644006511100651110000001040110504340250021555 0ustar rossross#include "HsNet.h" #include "HsFFI.h" #if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) #include /* to the end */ const char* getWSErrorDescr(int err) { static char otherErrMsg[256]; switch (err) { case WSAEINTR: return "Interrupted function call (WSAEINTR)"; case WSAEBADF: return "bad socket descriptor (WSAEBADF)"; case WSAEACCES: return "Permission denied (WSAEACCESS)"; case WSAEFAULT: return "Bad address (WSAEFAULT)"; case WSAEINVAL: return "Invalid argument (WSAEINVAL)"; case WSAEMFILE: return "Too many open files (WSAEMFILE)"; case WSAEWOULDBLOCK: return "Resource temporarily unavailable (WSAEWOULDBLOCK)"; case WSAEINPROGRESS: return "Operation now in progress (WSAEINPROGRESS)"; case WSAEALREADY: return "Operation already in progress (WSAEALREADY)"; case WSAENOTSOCK: return "Socket operation on non-socket (WSAENOTSOCK)"; case WSAEDESTADDRREQ: return "Destination address required (WSAEDESTADDRREQ)"; case WSAEMSGSIZE: return "Message too long (WSAEMSGSIZE)"; case WSAEPROTOTYPE: return "Protocol wrong type for socket (WSAEPROTOTYPE)"; case WSAENOPROTOOPT: return "Bad protocol option (WSAENOPROTOOPT)"; case WSAEPROTONOSUPPORT: return "Protocol not supported (WSAEPROTONOSUPPORT)"; case WSAESOCKTNOSUPPORT: return "Socket type not supported (WSAESOCKTNOSUPPORT)"; case WSAEOPNOTSUPP: return "Operation not supported (WSAEOPNOTSUPP)"; case WSAEPFNOSUPPORT: return "Protocol family not supported (WSAEPFNOSUPPORT)"; case WSAEAFNOSUPPORT: return "Address family not supported by protocol family (WSAEAFNOSUPPORT)"; case WSAEADDRINUSE: return "Address already in use (WSAEADDRINUSE)"; case WSAEADDRNOTAVAIL: return "Cannot assign requested address (WSAEADDRNOTAVAIL)"; case WSAENETDOWN: return "Network is down (WSAENETDOWN)"; case WSAENETUNREACH: return "Network is unreachable (WSAENETUNREACH)"; case WSAENETRESET: return "Network dropped connection on reset (WSAENETRESET)"; case WSAECONNABORTED: return "Software caused connection abort (WSAECONNABORTED)"; case WSAECONNRESET: return "Connection reset by peer (WSAECONNRESET)"; case WSAENOBUFS: return "No buffer space available (WSAENOBUFS)"; case WSAEISCONN: return "Socket is already connected (WSAEISCONN)"; case WSAENOTCONN: return "Socket is not connected (WSAENOTCONN)"; case WSAESHUTDOWN: return "Cannot send after socket shutdown (WSAESHUTDOWN)"; case WSAETOOMANYREFS: return "Too many references (WSAETOOMANYREFS)"; case WSAETIMEDOUT: return "Connection timed out (WSAETIMEDOUT)"; case WSAECONNREFUSED: return "Connection refused (WSAECONNREFUSED)"; case WSAELOOP: return "Too many levels of symbolic links (WSAELOOP)"; case WSAENAMETOOLONG: return "Filename too long (WSAENAMETOOLONG)"; case WSAEHOSTDOWN: return "Host is down (WSAEHOSTDOWN)"; case WSAEHOSTUNREACH: return "Host is unreachable (WSAEHOSTUNREACH)"; case WSAENOTEMPTY: return "Resource not empty (WSAENOTEMPTY)"; case WSAEPROCLIM: return "Too many processes (WSAEPROCLIM)"; case WSAEUSERS: return "Too many users (WSAEUSERS)"; case WSAEDQUOT: return "Disk quota exceeded (WSAEDQUOT)"; case WSAESTALE: return "Stale NFS file handle (WSAESTALE)"; case WSAEREMOTE: return "Too many levels of remote in path (WSAEREMOTE)"; case WSAEDISCON: return "Graceful shutdown in progress (WSAEDISCON)"; case WSASYSNOTREADY: return "Network subsystem is unavailable (WSASYSNOTREADY)"; case WSAVERNOTSUPPORTED: return "Winsock.dll version out of range (WSAVERNOTSUPPORTED)"; case WSANOTINITIALISED: return "Successful WSAStartup not yet performed (WSANOTINITIALISED)"; #ifdef WSATYPE_NOT_FOUND case WSATYPE_NOT_FOUND: return "Class type not found (WSATYPE_NOT_FOUND)"; #endif case WSAHOST_NOT_FOUND: return "Host not found (WSAHOST_NOT_FOUND)"; case WSATRY_AGAIN: return "Nonauthoritative host not found (WSATRY_AGAIN)"; case WSANO_RECOVERY: return "This is a nonrecoverable error (WSANO_RECOVERY)"; case WSANO_DATA: return "Valid name, no data record of requested type (WSANO_DATA)"; default: sprintf(otherErrMsg, "Unknown WinSock error: %u", err); return otherErrMsg; } } #endif hugs98-plus-Sep2006/packages/network/Network.hs0000644006511100651110000002245510504340250020220 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Network -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/network/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- The "Network" interface is a \"higher-level\" interface to -- networking facilities, and it is recommended unless you need the -- lower-level interface in "Network.Socket". -- ----------------------------------------------------------------------------- module Network ( -- * Basic data types Socket, PortID(..), HostName, PortNumber, -- instance (Eq, Enum, Num, Real, Integral) -- * Initialisation withSocketsDo, -- :: IO a -> IO a -- * Server-side connections listenOn, -- :: PortID -> IO Socket accept, -- :: Socket -> IO (Handle, HostName, PortNumber) sClose, -- :: Socket -> IO () -- * Client-side connections connectTo, -- :: HostName -> PortID -> IO Handle -- * Simple sending and receiving {-$sendrecv-} sendTo, -- :: HostName -> PortID -> String -> IO () recvFrom, -- :: HostName -> PortID -> IO String -- * Miscellaneous socketPort, -- :: Socket -> IO PortID -- * Networking Issues -- ** Buffering {-$buffering-} -- ** Improving I\/O Performance over sockets {-$performance-} -- ** @SIGPIPE@ {-$sigpipe-} ) where import Network.BSD import Network.Socket hiding ( accept, socketPort, recvFrom, sendTo, PortNumber ) import qualified Network.Socket as Socket ( accept ) import System.IO import Prelude import Control.Exception as Exception -- --------------------------------------------------------------------------- -- High Level ``Setup'' functions -- If the @PortID@ specifies a unix family socket and the @Hostname@ -- differs from that returned by @getHostname@ then an error is -- raised. Alternatively an empty string may be given to @connectTo@ -- signalling that the current hostname applies. data PortID = Service String -- Service Name eg "ftp" | PortNumber PortNumber -- User defined Port Number #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) | UnixSocket String -- Unix family socket in file system #endif -- | Calling 'connectTo' creates a client side socket which is -- connected to the given host and port. The Protocol and socket type is -- derived from the given port identifier. If a port number is given -- then the result is always an internet family 'Stream' socket. connectTo :: HostName -- Hostname -> PortID -- Port Identifier -> IO Handle -- Connected Socket connectTo hostname (Service serv) = do proto <- getProtocolNumber "tcp" Exception.bracketOnError (socket AF_INET Stream proto) (sClose) -- only done if there's an error (\sock -> do port <- getServicePortNumber serv he <- getHostByName hostname connect sock (SockAddrInet port (hostAddress he)) socketToHandle sock ReadWriteMode ) connectTo hostname (PortNumber port) = do proto <- getProtocolNumber "tcp" Exception.bracketOnError (socket AF_INET Stream proto) (sClose) -- only done if there's an error (\sock -> do he <- getHostByName hostname connect sock (SockAddrInet port (hostAddress he)) socketToHandle sock ReadWriteMode ) #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) connectTo _ (UnixSocket path) = do Exception.bracketOnError (socket AF_UNIX Stream 0) (sClose) (\sock -> do connect sock (SockAddrUnix path) socketToHandle sock ReadWriteMode ) #endif -- | Creates the server side socket which has been bound to the -- specified port. -- -- NOTE: To avoid the \"Address already in use\" -- problems popped up several times on the GHC-Users mailing list we -- set the 'ReuseAddr' socket option on the listening socket. If you -- don't want this behaviour, please use the lower level -- 'Network.Socket.listen' instead. listenOn :: PortID -- ^ Port Identifier -> IO Socket -- ^ Connected Socket listenOn (Service serv) = do proto <- getProtocolNumber "tcp" Exception.bracketOnError (socket AF_INET Stream proto) (sClose) (\sock -> do port <- getServicePortNumber serv setSocketOption sock ReuseAddr 1 bindSocket sock (SockAddrInet port iNADDR_ANY) listen sock maxListenQueue return sock ) listenOn (PortNumber port) = do proto <- getProtocolNumber "tcp" Exception.bracketOnError (socket AF_INET Stream proto) (sClose) (\sock -> do setSocketOption sock ReuseAddr 1 bindSocket sock (SockAddrInet port iNADDR_ANY) listen sock maxListenQueue return sock ) #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) listenOn (UnixSocket path) = Exception.bracketOnError (socket AF_UNIX Stream 0) (sClose) (\sock -> do setSocketOption sock ReuseAddr 1 bindSocket sock (SockAddrUnix path) listen sock maxListenQueue return sock ) #endif -- ----------------------------------------------------------------------------- -- accept -- | Accept a connection on a socket created by 'listenOn'. Normal -- I\/O opertaions (see "System.IO") can be used on the 'Handle' -- returned to communicate with the client. -- Notice that although you can pass any Socket to Network.accept, only -- sockets of either AF_UNIX or AF_INET will work (this shouldn't be a problem, -- though). When using AF_UNIX, HostName will be set to the path of the socket -- and PortNumber to -1. -- accept :: Socket -- ^ Listening Socket -> IO (Handle, HostName, PortNumber) -- ^ Triple of: read\/write 'Handle' for -- communicating with the client, -- the 'HostName' of the peer socket, and -- the 'PortNumber' of the remote connection. accept sock@(MkSocket _ AF_INET _ _ _) = do ~(sock', (SockAddrInet port haddr)) <- Socket.accept sock peer <- Exception.catchJust ioErrors (do (HostEntry peer _ _ _) <- getHostByAddr AF_INET haddr return peer ) (\e -> inet_ntoa haddr) -- if getHostByName fails, we fall back to the IP address handle <- socketToHandle sock' ReadWriteMode return (handle, peer, port) #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) accept sock@(MkSocket _ AF_UNIX _ _ _) = do ~(sock', (SockAddrUnix path)) <- Socket.accept sock handle <- socketToHandle sock' ReadWriteMode return (handle, path, -1) #endif accept sock@(MkSocket _ family _ _ _) = error $ "Sorry, address family " ++ (show family) ++ " is not supported!" -- ----------------------------------------------------------------------------- -- sendTo/recvFrom {-$sendrecv Send and receive data from\/to the given host and port number. These should normally only be used where the socket will not be required for further calls. Also, note that due to the use of 'hGetContents' in 'recvFrom' the socket will remain open (i.e. not available) even if the function already returned. Their use is strongly discouraged except for small test-applications or invocations from the command line. -} sendTo :: HostName -- Hostname -> PortID -- Port Number -> String -- Message to send -> IO () sendTo h p msg = do s <- connectTo h p hPutStr s msg hClose s recvFrom :: HostName -- Hostname -> PortID -- Port Number -> IO String -- Received Data recvFrom host port = do ip <- getHostByName host let ipHs = hostAddresses ip s <- listenOn port let waiting = do ~(s', SockAddrInet _ haddr) <- Socket.accept s he <- getHostByAddr AF_INET haddr if not (any (`elem` ipHs) (hostAddresses he)) then do sClose s' waiting else do h <- socketToHandle s' ReadMode msg <- hGetContents h return msg message <- waiting return message -- --------------------------------------------------------------------------- -- Access function returning the port type/id of socket. -- | Returns the 'PortID' associated with a given socket. socketPort :: Socket -> IO PortID socketPort s = do sockaddr <- getSocketName s return (portID sockaddr) where portID sa = case sa of SockAddrInet port _ -> PortNumber port #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) SockAddrUnix path -> UnixSocket path #endif ----------------------------------------------------------------------------- -- Extra documentation {-$buffering The 'Handle' returned by 'connectTo' and 'accept' is block-buffered by default. For an interactive application you may want to set the buffering mode on the 'Handle' to 'LineBuffering' or 'NoBuffering', like so: > h <- connectTo host port > hSetBuffering h LineBuffering -} {-$performance For really fast I\/O, it might be worth looking at the 'hGetBuf' and 'hPutBuf' family of functions in "System.IO". -} {-$sigpipe On Unix, when writing to a socket and the reading end is closed by the remote client, the program is normally sent a @SIGPIPE@ signal by the operating system. The default behaviour when a @SIGPIPE@ is received is to terminate the program silently, which can be somewhat confusing if you haven't encountered this before. The solution is to specify that @SIGPIPE@ is to be ignored, using the POSIX library: > import Posix > main = do installHandler sigPIPE Ignore Nothing; ... -} hugs98-plus-Sep2006/packages/network/aclocal.m40000644006511100651110000000021610504340250020062 0ustar rossross# Empty file to avoid a dependency on automake: autoreconf calls aclocal to # generate a temporary aclocal.m4t when no aclocal.m4 is present. hugs98-plus-Sep2006/packages/network/include/0000755006511100651110000000000010504340702017650 5ustar rossrosshugs98-plus-Sep2006/packages/network/include/HsNet.h0000644006511100651110000000472210504340250021045 0ustar rossross/* ----------------------------------------------------------------------------- * * Definitions for package `net' which are visible in Haskell land. * * ---------------------------------------------------------------------------*/ #ifndef HSNET_H #define HSNET_H #include "HsNetworkConfig.h" /* ultra-evil... */ #undef PACKAGE_BUGREPORT #undef PACKAGE_NAME #undef PACKAGE_STRING #undef PACKAGE_TARNAME #undef PACKAGE_VERSION #ifndef INLINE # if defined(_MSC_VER) # define INLINE extern __inline # elif defined(__GNUC__) # define INLINE extern inline # else # define INLINE inline # endif #endif #if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) #include extern void shutdownWinSock(); extern int initWinSock (); extern const char* getWSErrorDescr(int err); # if !defined(__HUGS__) extern void* newAcceptParams(int sock, int sz, void* sockaddr); extern int acceptNewSock(void* d); extern int acceptDoProc(void* param); # endif #else #ifdef HAVE_LIMITS_H # include #endif #ifdef HAVE_STDLIB_H # include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_FCNTL_H # include #endif #ifdef HAVE_SYS_UIO_H # include #endif #ifdef HAVE_SYS_SOCKET_H # include #endif #ifdef HAVE_NETINET_TCP_H # include #endif #ifdef HAVE_NETINET_IN_H # include #endif #ifdef HAVE_SYS_UN_H # include #endif #ifdef HAVE_ARPA_INET_H # include #endif #ifdef HAVE_NETDB_H #include #endif #ifdef HAVE_BSD_SENDFILE #include #endif #ifdef HAVE_LINUX_SENDFILE #if !defined(__USE_FILE_OFFSET64) #include #endif #endif extern int sendFd(int sock, int outfd); extern int recvFd(int sock); /* The next two are scheduled for deletion */ extern int sendAncillary(int sock, int level, int type, int flags, void* data, int len); extern int recvAncillary(int sock, int* pLevel, int* pType, int flags, void** pData, int* pLen); #endif /* HAVE_WINSOCK_H && !__CYGWIN */ INLINE char * my_inet_ntoa( #if defined(HAVE_WINSOCK_H) u_long addr #elif defined(HAVE_IN_ADDR_T) in_addr_t addr #elif defined(HAVE_INTTYPES_H) u_int32_t addr #else unsigned long addr #endif ) { struct in_addr a; a.s_addr = addr; return inet_ntoa(a); } #endif hugs98-plus-Sep2006/packages/network/include/Makefile0000644006511100651110000000051610504340250021310 0ustar rossross# ----------------------------------------------------------------------------- # $Id: Makefile,v 1.3 2005/03/02 16:39:58 ross Exp $ TOP=../.. include $(TOP)/mk/boilerplate.mk H_FILES = $(wildcard *.h) includedir = $(libdir)/include INSTALL_INCLUDES = $(H_FILES) DIST_CLEAN_FILES += HsNetworkConfig.h include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/network/include/Typeable.h0000644006511100651110000000034410504340250021565 0ustar rossross/* Cut down from base/include/Typeable.h */ #ifndef TYPEABLE_H #define TYPEABLE_H #define INSTANCE_TYPEABLE0(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] } #endif hugs98-plus-Sep2006/packages/network/include/HsNetworkConfig.h.in0000644006511100651110000000553310504340702023506 0ustar rossross/* include/HsNetworkConfig.h.in. Generated from configure.ac by autoheader. */ /* Define to 1 if you have the header file. */ #undef HAVE_ARPA_INET_H /* Define to 1 if you have a BSDish sendfile(2) implementation. */ #undef HAVE_BSD_SENDFILE /* Define to 1 if you have the header file. */ #undef HAVE_FCNTL_H /* Define to 1 if you have the `gethostent' function. */ #undef HAVE_GETHOSTENT /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if in_addr_t is available. */ #undef HAVE_IN_ADDR_T /* Define to 1 if you have the header file. */ #undef HAVE_LIMITS_H /* Define to 1 if you have a Linux sendfile(2) implementation. */ #undef HAVE_LINUX_SENDFILE /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the header file. */ #undef HAVE_NETDB_H /* Define to 1 if you have the header file. */ #undef HAVE_NETINET_IN_H /* Define to 1 if you have the header file. */ #undef HAVE_NETINET_TCP_H /* Define to 1 if you have the `readlink' function. */ #undef HAVE_READLINK /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if `msg_accrights' is member of `struct msghdr'. */ #undef HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS /* Define to 1 if `msg_control' is member of `struct msghdr'. */ #undef HAVE_STRUCT_MSGHDR_MSG_CONTROL /* Define to 1 if you have the `symlink' function. */ #undef HAVE_SYMLINK /* Define to 1 if you have the header file. */ #undef HAVE_SYS_SOCKET_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_UIO_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_UN_H /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to 1 if you have the header file. */ #undef HAVE_WINSOCK_H /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS /* Define to empty if `const' does not conform to ANSI C. */ #undef const hugs98-plus-Sep2006/packages/network/configure.ac0000644006511100651110000000451410504340250020515 0ustar rossrossAC_INIT([Haskell network package], [1.0], [libraries@haskell.org], [network]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([include/HsNet.h]) AC_CONFIG_HEADERS([include/HsNetworkConfig.h]) AC_CANONICAL_HOST AC_C_CONST dnl ** check for specific header (.h) files that we are interested in AC_CHECK_HEADERS([fcntl.h limits.h stdlib.h sys/types.h unistd.h winsock.h]) AC_CHECK_HEADERS([arpa/inet.h netdb.h netinet/in.h netinet/tcp.h sys/socket.h sys/uio.h sys/un.h]) AC_CHECK_FUNCS([readlink symlink]) dnl ** check what fields struct msghdr contains AC_CHECK_MEMBERS([struct msghdr.msg_control, struct msghdr.msg_accrights], [], [], [#if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_SOCKET_H # include #endif #if HAVE_SYS_UIO_H # include #endif]) dnl -------------------------------------------------- dnl * test for in_addr_t dnl -------------------------------------------------- AC_MSG_CHECKING(for in_addr_t in netinet/in.h) AC_EGREP_HEADER(in_addr_t, netinet/in.h, [ AC_DEFINE([HAVE_IN_ADDR_T], [1], [Define to 1 if in_addr_t is available.]) AC_MSG_RESULT(yes) ], AC_MSG_RESULT(no)) dnl -------------------------------------------------- dnl * test for Linux sendfile(2) dnl -------------------------------------------------- AC_MSG_CHECKING(for sendfile in sys/sendfile.h) AC_EGREP_HEADER(sendfile, sys/sendfile.h, [ AC_DEFINE([HAVE_LINUX_SENDFILE], [1], [Define to 1 if you have a Linux sendfile(2) implementation.]) AC_MSG_RESULT(yes) ], AC_MSG_RESULT(no)) dnl -------------------------------------------------- dnl * test for BSD sendfile(2) dnl -------------------------------------------------- AC_MSG_CHECKING(for sendfile in sys/socket.h) AC_EGREP_HEADER(sendfile, sys/socket.h, [ AC_DEFINE([HAVE_BSD_SENDFILE], [1], [Define to 1 if you have a BSDish sendfile(2) implementation.]) AC_MSG_RESULT(yes) ], AC_MSG_RESULT(no)) AC_CHECK_FUNCS(gethostent) case "$host" in *-mingw32) EXTRA_SRCS="cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c" EXTRA_LIBS=wsock32 CALLCONV=stdcall ;; *-solaris2) EXTRA_SRCS="cbits/ancilData.c" EXTRA_LIBS="nsl, socket" CALLCONV=ccall ;; *) EXTRA_SRCS="cbits/ancilData.c" EXTRA_LIBS= CALLCONV=ccall ;; esac AC_SUBST([CALLCONV]) AC_SUBST([EXTRA_LIBS]) AC_SUBST([EXTRA_SRCS]) AC_CONFIG_FILES([network.buildinfo]) AC_OUTPUT hugs98-plus-Sep2006/packages/network/tests/0000755006511100651110000000000010504340250017365 5ustar rossrosshugs98-plus-Sep2006/packages/network/tests/URITest.hs0000644006511100651110000014150610504340250021227 0ustar rossross-------------------------------------------------------------------------------- -- $Id: URITest.hs,v 1.8 2005/07/19 22:01:27 gklyne Exp $ -- -- Copyright (c) 2004, G. KLYNE. All rights reserved. -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : URITest -- Copyright : (c) 2004, Graham Klyne -- License : BSD-style (see end of this file) -- -- Maintainer : Graham Klyne -- Stability : provisional -- Portability : H98 -- -- This Module contains test cases for module URI. -- -- Using GHC, I compile with this command line: -- ghc --make -fglasgow-exts -- -i..\;C:\Dev\Haskell\Lib\HUnit;C:\Dev\Haskell\Lib\Parsec -- -o URITest.exe URITest -main-is URITest.main -- The -i line may need changing for alternative installations. -- -------------------------------------------------------------------------------- module URITest where import Network.URI ( URI(..), URIAuth(..) , nullURI , parseURI, parseURIReference, parseRelativeReference, parseAbsoluteURI , parseabsoluteURI , isURI, isURIReference, isRelativeReference, isAbsoluteURI , isIPv6address, isIPv4address , relativeTo, nonStrictRelativeTo , relativeFrom , uriToString , isUnescapedInURI, escapeURIString, unEscapeString , normalizeCase, normalizeEscape, normalizePathSegments ) import HUnit import IO ( Handle, openFile, IOMode(WriteMode), hClose, hPutStr, hPutStrLn ) import Maybe ( fromJust ) -- Test supplied string for valid URI reference syntax -- isValidURIRef :: String -> Bool -- Test supplied string for valid absolute URI reference syntax -- isAbsoluteURIRef :: String -> Bool -- Test supplied string for valid absolute URI syntax -- isAbsoluteURI :: String -> Bool data URIType = AbsId -- URI form (absolute, no fragment) | AbsRf -- Absolute URI reference | RelRf -- Relative URI reference | InvRf -- Invalid URI reference isValidT :: URIType -> Bool isValidT InvRf = False isValidT _ = True isAbsRfT :: URIType -> Bool isAbsRfT AbsId = True isAbsRfT AbsRf = True isAbsRfT _ = False isRelRfT :: URIType -> Bool isRelRfT RelRf = True isRelRfT _ = False isAbsIdT :: URIType -> Bool isAbsIdT AbsId = True isAbsIdT _ = False testEq :: (Eq a, Show a) => String -> a -> a -> Test testEq lab a1 a2 = TestCase ( assertEqual lab a1 a2 ) testURIRef :: URIType -> String -> Test testURIRef t u = TestList [ testEq ("test_isURIReference:"++u) (isValidT t) (isURIReference u) , testEq ("test_isRelativeReference:"++u) (isRelRfT t) (isRelativeReference u) , testEq ("test_isAbsoluteURI:"++u) (isAbsIdT t) (isAbsoluteURI u) ] testURIRefComponents :: String -> (Maybe URI) -> String -> Test testURIRefComponents lab uv us = testEq ("testURIRefComponents:"++us) uv (parseURIReference us) testURIRef001 = testURIRef AbsRf "http://example.org/aaa/bbb#ccc" testURIRef002 = testURIRef AbsId "mailto:local@domain.org" testURIRef003 = testURIRef AbsRf "mailto:local@domain.org#frag" testURIRef004 = testURIRef AbsRf "HTTP://EXAMPLE.ORG/AAA/BBB#CCC" testURIRef005 = testURIRef RelRf "//example.org/aaa/bbb#ccc" testURIRef006 = testURIRef RelRf "/aaa/bbb#ccc" testURIRef007 = testURIRef RelRf "bbb#ccc" testURIRef008 = testURIRef RelRf "#ccc" testURIRef009 = testURIRef RelRf "#" testURIRef010 = testURIRef RelRf "/" -- escapes testURIRef011 = testURIRef AbsRf "http://example.org/aaa%2fbbb#ccc" testURIRef012 = testURIRef AbsRf "http://example.org/aaa%2Fbbb#ccc" testURIRef013 = testURIRef RelRf "%2F" testURIRef014 = testURIRef RelRf "aaa%2Fbbb" -- ports testURIRef015 = testURIRef AbsRf "http://example.org:80/aaa/bbb#ccc" testURIRef016 = testURIRef AbsRf "http://example.org:/aaa/bbb#ccc" testURIRef017 = testURIRef AbsRf "http://example.org./aaa/bbb#ccc" testURIRef018 = testURIRef AbsRf "http://example.123./aaa/bbb#ccc" -- bare authority testURIRef019 = testURIRef AbsId "http://example.org" -- IPv6 literals (from RFC2732): testURIRef021 = testURIRef AbsId "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html" testURIRef022 = testURIRef AbsId "http://[1080:0:0:0:8:800:200C:417A]/index.html" testURIRef023 = testURIRef AbsId "http://[3ffe:2a00:100:7031::1]" testURIRef024 = testURIRef AbsId "http://[1080::8:800:200C:417A]/foo" testURIRef025 = testURIRef AbsId "http://[::192.9.5.5]/ipng" testURIRef026 = testURIRef AbsId "http://[::FFFF:129.144.52.38]:80/index.html" testURIRef027 = testURIRef AbsId "http://[2010:836B:4179::836B:4179]" testURIRef028 = testURIRef RelRf "//[2010:836B:4179::836B:4179]" testURIRef029 = testURIRef InvRf "[2010:836B:4179::836B:4179]" -- RFC2396 test cases testURIRef031 = testURIRef RelRf "./aaa" testURIRef032 = testURIRef RelRf "../aaa" testURIRef033 = testURIRef AbsId "g:h" testURIRef034 = testURIRef RelRf "g" testURIRef035 = testURIRef RelRf "./g" testURIRef036 = testURIRef RelRf "g/" testURIRef037 = testURIRef RelRf "/g" testURIRef038 = testURIRef RelRf "//g" testURIRef039 = testURIRef RelRf "?y" testURIRef040 = testURIRef RelRf "g?y" testURIRef041 = testURIRef RelRf "#s" testURIRef042 = testURIRef RelRf "g#s" testURIRef043 = testURIRef RelRf "g?y#s" testURIRef044 = testURIRef RelRf ";x" testURIRef045 = testURIRef RelRf "g;x" testURIRef046 = testURIRef RelRf "g;x?y#s" testURIRef047 = testURIRef RelRf "." testURIRef048 = testURIRef RelRf "./" testURIRef049 = testURIRef RelRf ".." testURIRef050 = testURIRef RelRf "../" testURIRef051 = testURIRef RelRf "../g" testURIRef052 = testURIRef RelRf "../.." testURIRef053 = testURIRef RelRf "../../" testURIRef054 = testURIRef RelRf "../../g" testURIRef055 = testURIRef RelRf "../../../g" testURIRef056 = testURIRef RelRf "../../../../g" testURIRef057 = testURIRef RelRf "/./g" testURIRef058 = testURIRef RelRf "/../g" testURIRef059 = testURIRef RelRf "g." testURIRef060 = testURIRef RelRf ".g" testURIRef061 = testURIRef RelRf "g.." testURIRef062 = testURIRef RelRf "..g" testURIRef063 = testURIRef RelRf "./../g" testURIRef064 = testURIRef RelRf "./g/." testURIRef065 = testURIRef RelRf "g/./h" testURIRef066 = testURIRef RelRf "g/../h" testURIRef067 = testURIRef RelRf "g;x=1/./y" testURIRef068 = testURIRef RelRf "g;x=1/../y" testURIRef069 = testURIRef RelRf "g?y/./x" testURIRef070 = testURIRef RelRf "g?y/../x" testURIRef071 = testURIRef RelRf "g#s/./x" testURIRef072 = testURIRef RelRf "g#s/../x" testURIRef073 = testURIRef RelRf "" testURIRef074 = testURIRef RelRf "A'C" testURIRef075 = testURIRef RelRf "A$C" testURIRef076 = testURIRef RelRf "A@C" testURIRef077 = testURIRef RelRf "A,C" -- Invalid testURIRef080 = testURIRef InvRf "http://foo.org:80Path/More" testURIRef081 = testURIRef InvRf "::" testURIRef082 = testURIRef InvRf " " testURIRef083 = testURIRef InvRf "%" testURIRef084 = testURIRef InvRf "A%Z" testURIRef085 = testURIRef InvRf "%ZZ" testURIRef086 = testURIRef InvRf "%AZ" testURIRef087 = testURIRef InvRf "A C" -- testURIRef088 = -- (case removed) -- testURIRef089 = -- (case removed) testURIRef090 = testURIRef InvRf "A\"C" testURIRef091 = testURIRef InvRf "A`C" testURIRef092 = testURIRef InvRf "AC" testURIRef094 = testURIRef InvRf "A^C" testURIRef095 = testURIRef InvRf "A\\C" testURIRef096 = testURIRef InvRf "A{C" testURIRef097 = testURIRef InvRf "A|C" testURIRef098 = testURIRef InvRf "A}C" -- From RFC2396: -- rel_segment = 1*( unreserved | escaped | -- ";" | "@" | "&" | "=" | "+" | "$" | "," ) -- unreserved = alphanum | mark -- mark = "-" | "_" | "." | "!" | "~" | "*" | "'" | -- "(" | ")" -- Note RFC 2732 allows '[', ']' ONLY for reserved purpose of IPv6 literals, -- or does it? testURIRef101 = testURIRef InvRf "A[C" testURIRef102 = testURIRef InvRf "A]C" testURIRef103 = testURIRef InvRf "A[**]C" testURIRef104 = testURIRef InvRf "http://[xyz]/" testURIRef105 = testURIRef InvRf "http://]/" testURIRef106 = testURIRef InvRf "http://example.org/[2010:836B:4179::836B:4179]" testURIRef107 = testURIRef InvRf "http://example.org/abc#[2010:836B:4179::836B:4179]" testURIRef108 = testURIRef InvRf "http://example.org/xxx/[qwerty]#a[b]" -- Random other things that crop up testURIRef111 = testURIRef AbsRf "http://example/Andrȷ" testURIRef112 = testURIRef AbsId "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/" testURIRef113 = testURIRef AbsId "http://46229EFFE16A9BD60B9F1BE88B2DB047ADDED785/demo.mp3" testURIRef114 = testURIRef InvRf "http://example.org/xxx/qwerty#a#b" testURIRef115 = testURIRef InvRf "dcp.tcp.pft://192.168.0.1:1002:3002?fec=1&crc=0" testURIRef116 = testURIRef AbsId "dcp.tcp.pft://192.168.0.1:1002?fec=1&crc=0" testURIRef117 = testURIRef AbsId "foo://" testURIRefSuite = TestLabel "Test URIrefs" testURIRefList testURIRefList = TestList [ testURIRef001, testURIRef002, testURIRef003, testURIRef004, testURIRef005, testURIRef006, testURIRef007, testURIRef008, testURIRef009, testURIRef010, -- testURIRef011, testURIRef012, testURIRef013, testURIRef014, testURIRef015, testURIRef016, testURIRef017, testURIRef018, -- testURIRef019, -- testURIRef021, testURIRef022, testURIRef023, testURIRef024, testURIRef025, testURIRef026, testURIRef027, testURIRef028, testURIRef029, -- testURIRef031, testURIRef032, testURIRef033, testURIRef034, testURIRef035, testURIRef036, testURIRef037, testURIRef038, testURIRef039, testURIRef040, testURIRef041, testURIRef042, testURIRef043, testURIRef044, testURIRef045, testURIRef046, testURIRef047, testURIRef048, testURIRef049, testURIRef050, testURIRef051, testURIRef052, testURIRef053, testURIRef054, testURIRef055, testURIRef056, testURIRef057, testURIRef058, testURIRef059, testURIRef060, testURIRef061, testURIRef062, testURIRef063, testURIRef064, testURIRef065, testURIRef066, testURIRef067, testURIRef068, testURIRef069, testURIRef070, testURIRef071, testURIRef072, testURIRef073, testURIRef074, testURIRef075, testURIRef076, testURIRef077, -- testURIRef080, testURIRef081, testURIRef082, testURIRef083, testURIRef084, testURIRef085, testURIRef086, testURIRef087, -- testURIRef088, -- testURIRef089, testURIRef090, testURIRef091, testURIRef092, testURIRef093, testURIRef094, testURIRef095, testURIRef096, testURIRef097, testURIRef098, -- testURIRef099, -- testURIRef101, testURIRef102, testURIRef103, testURIRef104, testURIRef105, testURIRef106, testURIRef107, testURIRef108, -- testURIRef111, testURIRef112, testURIRef113, testURIRef114, testURIRef115, testURIRef116, testURIRef117 ] -- test decomposition of URI into components testComponent01 = testURIRefComponents "testComponent01" ( Just $ URI { uriScheme = "http:" , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") , uriPath = "/aaa/bbb" , uriQuery = "?qqq" , uriFragment = "#fff" } ) "http://user:pass@example.org:99/aaa/bbb?qqq#fff" testComponent02 = testURIRefComponents "testComponent02" ( const Nothing ( Just $ URI { uriScheme = "http:" , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") , uriPath = "aaa/bbb" , uriQuery = "" , uriFragment = "" } ) ) "http://user:pass@example.org:99aaa/bbb" testComponent03 = testURIRefComponents "testComponent03" ( Just $ URI { uriScheme = "http:" , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") , uriPath = "" , uriQuery = "?aaa/bbb" , uriFragment = "" } ) "http://user:pass@example.org:99?aaa/bbb" testComponent04 = testURIRefComponents "testComponent03" ( Just $ URI { uriScheme = "http:" , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") , uriPath = "" , uriQuery = "" , uriFragment = "#aaa/bbb" } ) "http://user:pass@example.org:99#aaa/bbb" -- These test cases contributed by Robert Buck (mathworks.com) testComponent11 = testURIRefComponents "testComponent03" ( Just $ URI { uriScheme = "about:" , uriAuthority = Nothing , uriPath = "" , uriQuery = "" , uriFragment = "" } ) "about:" testComponent12 = testURIRefComponents "testComponent03" ( Just $ URI { uriScheme = "file:" , uriAuthority = Just (URIAuth "" "windowsauth" "") , uriPath = "/d$" , uriQuery = "" , uriFragment = "" } ) "file://windowsauth/d$" testComponentSuite = TestLabel "Test URIrefs" $ TestList [ testComponent01 , testComponent02 , testComponent03 , testComponent04 , testComponent11 , testComponent12 ] -- Get reference relative to given base -- relativeRef :: String -> String -> String -- -- Get absolute URI given base and relative reference -- absoluteURI :: String -> String -> String -- -- Test cases taken from: http://www.w3.org/2000/10/swap/uripath.py -- (Thanks, Dan Connolly) -- -- NOTE: absoluteURI base (relativeRef base u) is always equivalent to u. -- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html testRelSplit :: String -> String -> String -> String -> Test testRelSplit label base uabs urel = testEq label urel (mkrel puabs pubas) where mkrel (Just u1) (Just u2) = show (u1 `relativeFrom` u2) mkrel Nothing _ = "Invalid URI: "++urel mkrel _ Nothing = "Invalid URI: "++uabs puabs = parseURIReference uabs pubas = parseURIReference base testRelJoin :: String -> String -> String -> String -> Test testRelJoin label base urel uabs = testEq label uabs (mkabs purel pubas) where mkabs (Just u1) (Just u2) = shabs (u1 `relativeTo` u2) mkabs Nothing _ = "Invalid URI: "++urel mkabs _ Nothing = "Invalid URI: "++uabs shabs (Just u) = show u shabs Nothing = "No result" purel = parseURIReference urel pubas = parseURIReference base testRelative :: String -> String -> String -> String -> Test testRelative label base uabs urel = TestList [ (testRelSplit (label++"(rel)") base uabs urel), (testRelJoin (label++"(abs)") base urel uabs) ] testRelative01 = testRelative "testRelative01" "foo:xyz" "bar:abc" "bar:abc" testRelative02 = testRelative "testRelative02" "http://example/x/y/z" "http://example/x/abc" "../abc" testRelative03 = testRelative "testRelative03" "http://example2/x/y/z" "http://example/x/abc" "//example/x/abc" -- "http://example2/x/y/z" "http://example/x/abc" "http://example/x/abc" testRelative04 = testRelative "testRelative04" "http://ex/x/y/z" "http://ex/x/r" "../r" testRelative05 = testRelative "testRelative05" "http://ex/x/y/z" "http://ex/r" "/r" -- "http://ex/x/y/z" "http://ex/r" "../../r" testRelative06 = testRelative "testRelative06" "http://ex/x/y/z" "http://ex/x/y/q/r" "q/r" testRelative07 = testRelative "testRelative07" "http://ex/x/y" "http://ex/x/q/r#s" "q/r#s" testRelative08 = testRelative "testRelative08" "http://ex/x/y" "http://ex/x/q/r#s/t" "q/r#s/t" testRelative09 = testRelative "testRelative09" "http://ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r" testRelative10 = testRelative "testRelative10" -- "http://ex/x/y" "http://ex/x/y" "y" "http://ex/x/y" "http://ex/x/y" "" testRelative11 = testRelative "testRelative11" -- "http://ex/x/y/" "http://ex/x/y/" "./" "http://ex/x/y/" "http://ex/x/y/" "" testRelative12 = testRelative "testRelative12" -- "http://ex/x/y/pdq" "http://ex/x/y/pdq" "pdq" "http://ex/x/y/pdq" "http://ex/x/y/pdq" "" testRelative13 = testRelative "testRelative13" "http://ex/x/y/" "http://ex/x/y/z/" "z/" testRelative14 = testRelative "testRelative14" -- "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "animal.rdf#Animal" "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "#Animal" testRelative15 = testRelative "testRelative15" "file:/e/x/y/z" "file:/e/x/abc" "../abc" testRelative16 = testRelative "testRelative16" "file:/example2/x/y/z" "file:/example/x/abc" "/example/x/abc" testRelative17 = testRelative "testRelative17" "file:/ex/x/y/z" "file:/ex/x/r" "../r" testRelative18 = testRelative "testRelative18" "file:/ex/x/y/z" "file:/r" "/r" testRelative19 = testRelative "testRelative19" "file:/ex/x/y" "file:/ex/x/q/r" "q/r" testRelative20 = testRelative "testRelative20" "file:/ex/x/y" "file:/ex/x/q/r#s" "q/r#s" testRelative21 = testRelative "testRelative21" "file:/ex/x/y" "file:/ex/x/q/r#" "q/r#" testRelative22 = testRelative "testRelative22" "file:/ex/x/y" "file:/ex/x/q/r#s/t" "q/r#s/t" testRelative23 = testRelative "testRelative23" "file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r" testRelative24 = testRelative "testRelative24" -- "file:/ex/x/y" "file:/ex/x/y" "y" "file:/ex/x/y" "file:/ex/x/y" "" testRelative25 = testRelative "testRelative25" -- "file:/ex/x/y/" "file:/ex/x/y/" "./" "file:/ex/x/y/" "file:/ex/x/y/" "" testRelative26 = testRelative "testRelative26" -- "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "pdq" "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "" testRelative27 = testRelative "testRelative27" "file:/ex/x/y/" "file:/ex/x/y/z/" "z/" testRelative28 = testRelative "testRelative28" "file:/devel/WWW/2000/10/swap/test/reluri-1.n3" "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1" -- "file:/devel/WWW/2000/10/swap/test/reluri-1.n3" -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1" testRelative29 = testRelative "testRelative29" "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3" "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1" -- "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3" -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1" testRelative30 = testRelative "testRelative30" "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort" testRelative31 = testRelative "testRelative31" "file:/some/dir/foo" "file:/some/dir/#" "./#" testRelative32 = testRelative "testRelative32" "http://ex/x/y" "http://ex/x/q:r" "./q:r" -- see RFC2396bis, section 5 ^^ testRelative33 = testRelative "testRelative33" "http://ex/x/y" "http://ex/x/p=q:r" "./p=q:r" -- "http://ex/x/y" "http://ex/x/p=q:r" "p=q:r" testRelative34 = testRelative "testRelative34" "http://ex/x/y?pp/qq" "http://ex/x/y?pp/rr" "?pp/rr" testRelative35 = testRelative "testRelative35" "http://ex/x/y?pp/qq" "http://ex/x/y/z" "y/z" testRelative36 = testRelative "testRelative36" "mailto:local" "mailto:local/qual@domain.org#frag" "local/qual@domain.org#frag" testRelative37 = testRelative "testRelative37" "mailto:local/qual1@domain1.org" "mailto:local/more/qual2@domain2.org#frag" "more/qual2@domain2.org#frag" testRelative38 = testRelative "testRelative38" "http://ex/x/z?q" "http://ex/x/y?q" "y?q" testRelative39 = testRelative "testRelative39" "http://ex?p" "http://ex/x/y?q" "/x/y?q" testRelative40 = testRelative "testRelative40" "foo:a/b" "foo:a/c/d" "c/d" testRelative41 = testRelative "testRelative41" "foo:a/b" "foo:/c/d" "/c/d" testRelative42 = testRelative "testRelative42" "foo:a/b?c#d" "foo:a/b?c" "" testRelative43 = testRelative "testRelative42" "foo:a" "foo:b/c" "b/c" testRelative44 = testRelative "testRelative44" "foo:/a/y/z" "foo:/a/b/c" "../b/c" testRelative45 = testRelJoin "testRelative45" "foo:a" "./b/c" "foo:b/c" testRelative46 = testRelJoin "testRelative46" "foo:a" "/./b/c" "foo:/b/c" testRelative47 = testRelJoin "testRelative47" "foo://a//b/c" "../../d" "foo://a/d" testRelative48 = testRelJoin "testRelative48" "foo:a" "." "foo:" testRelative49 = testRelJoin "testRelative49" "foo:a" ".." "foo:" -- add escape tests testRelative50 = testRelative "testRelative50" "http://example/x/y%2Fz" "http://example/x/abc" "abc" testRelative51 = testRelative "testRelative51" "http://example/a/x/y/z" "http://example/a/x%2Fabc" "../../x%2Fabc" testRelative52 = testRelative "testRelative52" "http://example/a/x/y%2Fz" "http://example/a/x%2Fabc" "../x%2Fabc" testRelative53 = testRelative "testRelative53" "http://example/x%2Fy/z" "http://example/x%2Fy/abc" "abc" testRelative54 = testRelative "testRelative54" "http://ex/x/y" "http://ex/x/q%3Ar" "q%3Ar" testRelative55 = testRelative "testRelative55" "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc" -- Apparently, TimBL prefers the following way to 41, 42 above -- cf. http://lists.w3.org/Archives/Public/uri/2003Feb/0028.html -- He also notes that there may be different relative fuctions -- that satisfy the basic equivalence axiom: -- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html testRelative56 = testRelative "testRelative56" "http://example/x/y/z" "http://example/x%2Fabc" "/x%2Fabc" testRelative57 = testRelative "testRelative57" "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc" -- Other oddball tests -- Check segment normalization code: testRelative60 = testRelJoin "testRelative60" "ftp://example/x/y" "http://example/a/b/../../c" "http://example/c" testRelative61 = testRelJoin "testRelative61" "ftp://example/x/y" "http://example/a/b/c/../../" "http://example/a/" testRelative62 = testRelJoin "testRelative62" "ftp://example/x/y" "http://example/a/b/c/./" "http://example/a/b/c/" testRelative63 = testRelJoin "testRelative63" "ftp://example/x/y" "http://example/a/b/c/.././" "http://example/a/b/" testRelative64 = testRelJoin "testRelative64" "ftp://example/x/y" "http://example/a/b/c/d/../../../../e" "http://example/e" testRelative65 = testRelJoin "testRelative65" "ftp://example/x/y" "http://example/a/b/c/d/../.././../../e" "http://example/e" -- Check handling of queries and fragments with non-relative paths testRelative70 = testRelative "testRelative70" "mailto:local1@domain1?query1" "mailto:local2@domain2" "local2@domain2" testRelative71 = testRelative "testRelative71" "mailto:local1@domain1" "mailto:local2@domain2?query2" "local2@domain2?query2" testRelative72 = testRelative "testRelative72" "mailto:local1@domain1?query1" "mailto:local2@domain2?query2" "local2@domain2?query2" testRelative73 = testRelative "testRelative73" "mailto:local@domain?query1" "mailto:local@domain?query2" "?query2" testRelative74 = testRelative "testRelative74" "mailto:?query1" "mailto:local@domain?query2" "local@domain?query2" testRelative75 = testRelative "testRelative75" "mailto:local@domain?query1" "mailto:local@domain?query2" "?query2" testRelative76 = testRelative "testRelative76" "foo:bar" "http://example/a/b?c/../d" "http://example/a/b?c/../d" testRelative77 = testRelative "testRelative77" "foo:bar" "http://example/a/b#c/../d" "http://example/a/b#c/../d" {- These (78-81) are some awkward test cases thrown up by a question on the URI list: http://lists.w3.org/Archives/Public/uri/2005Jul/0013 Mote that RFC 3986 discards path segents after the final '/' only when merging two paths - otherwise the final segment in the base URI is mnaintained. This leads to difficulty in constructinmg a reversible relativeTo/relativeFrom pair of functions. -} testRelative78 = testRelative "testRelative78" "http://www.example.com/data/limit/.." "http://www.example.com/data/limit/test.xml" "test.xml" testRelative79 = testRelative "testRelative79" "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort" testRelative80 = testRelative "testRelative80" "file:/some/dir/foo" "file:/some/dir/#" "./#" testRelative81 = testRelative "testRelative81" "file:/some/dir/.." "file:/some/dir/#blort" "./#blort" -- testRelative base abs rel -- testRelSplit base abs rel -- testRelJoin base rel abs testRelative91 = testRelSplit "testRelative91" "http://example.org/base/uri" "http:this" "this" testRelative92 = testRelJoin "testRelative92" "http://example.org/base/uri" "http:this" "http:this" testRelative93 = testRelJoin "testRelative93" "http:base" "http:this" "http:this" testRelative94 = testRelJoin "testRelative94" "f:/a" ".//g" "f://g" testRelative95 = testRelJoin "testRelative95" "f://example.org/base/a" "b/c//d/e" "f://example.org/base/b/c//d/e" testRelative96 = testRelJoin "testRelative96" "mid:m@example.ord/c@example.org" "m2@example.ord/c2@example.org" "mid:m@example.ord/m2@example.ord/c2@example.org" testRelative97 = testRelJoin "testRelative97" "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/" "mini1.xml" "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/mini1.xml" testRelative98 = testRelative "testRelative98" "foo:a/y/z" "foo:a/b/c" "../b/c" testRelative99 = testRelJoin "testRelative99" "f:/a/" "..//g" "f://g" testRelativeSuite = TestLabel "Test Relative URIs" testRelativeList testRelativeList = TestList [ testRelative01, testRelative02, testRelative03, testRelative04 , testRelative05, testRelative06, testRelative07, testRelative08 , testRelative09 , testRelative10, testRelative11, testRelative12, testRelative13 , testRelative14, testRelative15, testRelative16, testRelative17 , testRelative18, testRelative19 , testRelative20, testRelative21, testRelative22, testRelative23 , testRelative24, testRelative25, testRelative26, testRelative27 , testRelative28, testRelative29 , testRelative30, testRelative31, testRelative32, testRelative33 , testRelative34, testRelative35, testRelative36, testRelative37 , testRelative38, testRelative39 , testRelative40, testRelative41, testRelative42, testRelative43 , testRelative44, testRelative45, testRelative46, testRelative47 , testRelative48, testRelative49 -- , testRelative50, testRelative51, testRelative52, testRelative53 , testRelative54, testRelative55, testRelative56, testRelative57 -- , testRelative60, testRelative61, testRelative62, testRelative63 , testRelative64, testRelative65 -- , testRelative70, testRelative71, testRelative72, testRelative73 , testRelative74, testRelative75, testRelative76, testRelative77 -- Awkward cases: , testRelative78, testRelative79, testRelative80, testRelative81 -- -- , testRelative90 , testRelative91, testRelative92, testRelative93 , testRelative94, testRelative95, testRelative96 , testRelative97, testRelative98, testRelative99 ] -- RFC2396 relative-to-absolute URI tests rfcbase = "http://a/b/c/d;p?q" -- normal cases, RFC2396bis 5.4.1 testRFC01 = testRelJoin "testRFC01" rfcbase "g:h" "g:h" testRFC02 = testRelJoin "testRFC02" rfcbase "g" "http://a/b/c/g" testRFC03 = testRelJoin "testRFC03" rfcbase "./g" "http://a/b/c/g" testRFC04 = testRelJoin "testRFC04" rfcbase "g/" "http://a/b/c/g/" testRFC05 = testRelJoin "testRFC05" rfcbase "/g" "http://a/g" testRFC06 = testRelJoin "testRFC06" rfcbase "//g" "http://g" testRFC07 = testRelJoin "testRFC07" rfcbase "?y" "http://a/b/c/d;p?y" testRFC08 = testRelJoin "testRFC08" rfcbase "g?y" "http://a/b/c/g?y" testRFC09 = testRelJoin "testRFC09" rfcbase "?q#s" "http://a/b/c/d;p?q#s" testRFC23 = testRelJoin "testRFC10" rfcbase "#s" "http://a/b/c/d;p?q#s" testRFC10 = testRelJoin "testRFC11" rfcbase "g#s" "http://a/b/c/g#s" testRFC11 = testRelJoin "testRFC12" rfcbase "g?y#s" "http://a/b/c/g?y#s" testRFC12 = testRelJoin "testRFC13" rfcbase ";x" "http://a/b/c/;x" testRFC13 = testRelJoin "testRFC14" rfcbase "g;x" "http://a/b/c/g;x" testRFC14 = testRelJoin "testRFC15" rfcbase "g;x?y#s" "http://a/b/c/g;x?y#s" testRFC24 = testRelJoin "testRFC16" rfcbase "" "http://a/b/c/d;p?q" testRFC15 = testRelJoin "testRFC17" rfcbase "." "http://a/b/c/" testRFC16 = testRelJoin "testRFC18" rfcbase "./" "http://a/b/c/" testRFC17 = testRelJoin "testRFC19" rfcbase ".." "http://a/b/" testRFC18 = testRelJoin "testRFC20" rfcbase "../" "http://a/b/" testRFC19 = testRelJoin "testRFC21" rfcbase "../g" "http://a/b/g" testRFC20 = testRelJoin "testRFC22" rfcbase "../.." "http://a/" testRFC21 = testRelJoin "testRFC23" rfcbase "../../" "http://a/" testRFC22 = testRelJoin "testRFC24" rfcbase "../../g" "http://a/g" -- abnormal cases, RFC2396bis 5.4.2 testRFC31 = testRelJoin "testRFC31" rfcbase "?q" rfcbase testRFC32 = testRelJoin "testRFC32" rfcbase "../../../g" "http://a/g" testRFC33 = testRelJoin "testRFC33" rfcbase "../../../../g" "http://a/g" testRFC34 = testRelJoin "testRFC34" rfcbase "/./g" "http://a/g" testRFC35 = testRelJoin "testRFC35" rfcbase "/../g" "http://a/g" testRFC36 = testRelJoin "testRFC36" rfcbase "g." "http://a/b/c/g." testRFC37 = testRelJoin "testRFC37" rfcbase ".g" "http://a/b/c/.g" testRFC38 = testRelJoin "testRFC38" rfcbase "g.." "http://a/b/c/g.." testRFC39 = testRelJoin "testRFC39" rfcbase "..g" "http://a/b/c/..g" testRFC40 = testRelJoin "testRFC40" rfcbase "./../g" "http://a/b/g" testRFC41 = testRelJoin "testRFC41" rfcbase "./g/." "http://a/b/c/g/" testRFC42 = testRelJoin "testRFC42" rfcbase "g/./h" "http://a/b/c/g/h" testRFC43 = testRelJoin "testRFC43" rfcbase "g/../h" "http://a/b/c/h" testRFC44 = testRelJoin "testRFC44" rfcbase "g;x=1/./y" "http://a/b/c/g;x=1/y" testRFC45 = testRelJoin "testRFC45" rfcbase "g;x=1/../y" "http://a/b/c/y" testRFC46 = testRelJoin "testRFC46" rfcbase "g?y/./x" "http://a/b/c/g?y/./x" testRFC47 = testRelJoin "testRFC47" rfcbase "g?y/../x" "http://a/b/c/g?y/../x" testRFC48 = testRelJoin "testRFC48" rfcbase "g#s/./x" "http://a/b/c/g#s/./x" testRFC49 = testRelJoin "testRFC49" rfcbase "g#s/../x" "http://a/b/c/g#s/../x" testRFC50 = testRelJoin "testRFC50" rfcbase "http:x" "http:x" -- Null path tests -- See RFC2396bis, section 5.2, -- "If the base URI's path component is the empty string, then a single -- slash character is copied to the buffer" testRFC60 = testRelative "testRFC60" "http://ex" "http://ex/x/y?q" "/x/y?q" testRFC61 = testRelJoin "testRFC61" "http://ex" "x/y?q" "http://ex/x/y?q" testRFC62 = testRelative "testRFC62" "http://ex?p" "http://ex/x/y?q" "/x/y?q" testRFC63 = testRelJoin "testRFC63" "http://ex?p" "x/y?q" "http://ex/x/y?q" testRFC64 = testRelative "testRFC64" "http://ex#f" "http://ex/x/y?q" "/x/y?q" testRFC65 = testRelJoin "testRFC65" "http://ex#f" "x/y?q" "http://ex/x/y?q" testRFC66 = testRelative "testRFC66" "http://ex?p" "http://ex/x/y#g" "/x/y#g" testRFC67 = testRelJoin "testRFC67" "http://ex?p" "x/y#g" "http://ex/x/y#g" testRFC68 = testRelative "testRFC68" "http://ex" "http://ex/" "/" testRFC69 = testRelJoin "testRFC69" "http://ex" "./" "http://ex/" testRFC70 = testRelative "testRFC70" "http://ex" "http://ex/a/b" "/a/b" testRFC71 = testRelative "testRFC71" "http://ex/a/b" "http://ex" "./" testRFC2396Suite = TestLabel "Test RFC2396 examples" testRFC2396List testRFC2396List = TestList [ testRFC01, testRFC02, testRFC03, testRFC04, testRFC05, testRFC06, testRFC07, testRFC08, testRFC09, testRFC10, testRFC11, testRFC12, testRFC13, testRFC14, testRFC15, testRFC16, testRFC17, testRFC18, testRFC19, testRFC20, testRFC21, testRFC22, testRFC23, testRFC24, -- testRFC30, testRFC31, testRFC32, testRFC33, testRFC34, testRFC35, testRFC36, testRFC37, testRFC38, testRFC39, testRFC40, testRFC41, testRFC42, testRFC43, testRFC44, testRFC45, testRFC46, testRFC47, testRFC48, testRFC49, testRFC50, -- testRFC60, testRFC61, testRFC62, testRFC63, testRFC64, testRFC65, testRFC66, testRFC67, testRFC68, testRFC69, testRFC70 ] -- And some other oddballs: mailbase = "mailto:local/option@domain.org?notaquery#frag" testMail01 = testRelJoin "testMail01" mailbase "more@domain" "mailto:local/more@domain" testMail02 = testRelJoin "testMail02" mailbase "#newfrag" "mailto:local/option@domain.org?notaquery#newfrag" testMail03 = testRelJoin "testMail03" mailbase "l1/q1@domain" "mailto:local/l1/q1@domain" testMail11 = testRelJoin "testMail11" "mailto:local1@domain1?query1" "mailto:local2@domain2" "mailto:local2@domain2" testMail12 = testRelJoin "testMail12" "mailto:local1@domain1" "mailto:local2@domain2?query2" "mailto:local2@domain2?query2" testMail13 = testRelJoin "testMail13" "mailto:local1@domain1?query1" "mailto:local2@domain2?query2" "mailto:local2@domain2?query2" testMail14 = testRelJoin "testMail14" "mailto:local@domain?query1" "mailto:local@domain?query2" "mailto:local@domain?query2" testMail15 = testRelJoin "testMail15" "mailto:?query1" "mailto:local@domain?query2" "mailto:local@domain?query2" testMail16 = testRelJoin "testMail16" "mailto:local@domain?query1" "?query2" "mailto:local@domain?query2" testInfo17 = testRelJoin "testInfo17" "info:name/1234/../567" "name/9876/../543" "info:name/name/543" testInfo18 = testRelJoin "testInfo18" "info:/name/1234/../567" "name/9876/../543" "info:/name/name/543" testOddballSuite = TestLabel "Test oddball examples" testOddballList testOddballList = TestList [ testMail01, testMail02, testMail03 , testMail11, testMail12, testMail13, testMail14, testMail15, testMail16 , testInfo17 ] -- Normalization tests -- Case normalization; cf. RFC2396bis section 6.2.2.1 -- NOTE: authority case normalization is not performed testNormalize01 = testEq "testNormalize01" "http://EXAMPLE.com/Root/%2A?%2B#%2C" (normalizeCase "HTTP://EXAMPLE.com/Root/%2a?%2b#%2c") -- Encoding normalization; cf. RFC2396bis section 6.2.2.2 testNormalize11 = testEq "testNormalize11" "HTTP://EXAMPLE.com/Root/~Me/" (normalizeEscape "HTTP://EXAMPLE.com/Root/%7eMe/") testNormalize12 = testEq "testNormalize12" "foo:%40AZ%5b%60az%7b%2f09%3a-._~" (normalizeEscape "foo:%40%41%5a%5b%60%61%7a%7b%2f%30%39%3a%2d%2e%5f%7e") testNormalize13 = testEq "testNormalize13" "foo:%3a%2f%3f%23%5b%5d%40" (normalizeEscape "foo:%3a%2f%3f%23%5b%5d%40") -- Path segment normalization; cf. RFC2396bis section 6.2.2.4 testNormalize21 = testEq "testNormalize21" "http://example/c" (normalizePathSegments "http://example/a/b/../../c") testNormalize22 = testEq "testNormalize22" "http://example/a/" (normalizePathSegments "http://example/a/b/c/../../") testNormalize23 = testEq "testNormalize23" "http://example/a/b/c/" (normalizePathSegments "http://example/a/b/c/./") testNormalize24 = testEq "testNormalize24" "http://example/a/b/" (normalizePathSegments "http://example/a/b/c/.././") testNormalize25 = testEq "testNormalize25" "http://example/e" (normalizePathSegments "http://example/a/b/c/d/../../../../e") testNormalize26 = testEq "testNormalize26" "http://example/e" (normalizePathSegments "http://example/a/b/c/d/../.././../../e") testNormalize27 = testEq "testNormalize27" "http://example/e" (normalizePathSegments "http://example/a/b/../.././../../e") testNormalize28 = testEq "testNormalize28" "foo:e" (normalizePathSegments "foo:a/b/../.././../../e") testNormalizeSuite = TestList [ testNormalize01 , testNormalize11 , testNormalize12 , testNormalize13 , testNormalize21, testNormalize22, testNormalize23, testNormalize24 , testNormalize25, testNormalize26, testNormalize27, testNormalize28 ] -- URI formatting (show) tests ts02URI = URI { uriScheme = "http:" , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") , uriPath = "/aaa/bbb" , uriQuery = "?ccc" , uriFragment = "#ddd/eee" } ts04URI = URI { uriScheme = "http:" , uriAuthority = Just (URIAuth "user:anonymous@" "example.org" ":99") , uriPath = "/aaa/bbb" , uriQuery = "?ccc" , uriFragment = "#ddd/eee" } ts02str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee" ts03str = "http://user:pass@example.org:99/aaa/bbb?ccc#ddd/eee" ts04str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee" testShowURI01 = testEq "testShowURI01" "" (show nullURI) testShowURI02 = testEq "testShowURI02" ts02str (show ts02URI) testShowURI03 = testEq "testShowURI03" ts03str ((uriToString id ts02URI) "") testShowURI04 = testEq "testShowURI04" ts04str (show ts04URI) testShowURI = TestList [ testShowURI01 , testShowURI02 , testShowURI03 , testShowURI04 ] -- URI escaping tests te01str = "http://example.org/az/09-_/.~:/?#[]@!$&'()*+,;=" te02str = "http://example.org/a/c%/d /e" te02esc = "http://example.org/a%3C/b%3E/c%25/d%20/e" testEscapeURIString01 = testEq "testEscapeURIString01" te01str (escapeURIString isUnescapedInURI te01str) testEscapeURIString02 = testEq "testEscapeURIString02" te02esc (escapeURIString isUnescapedInURI te02str) testEscapeURIString03 = testEq "testEscapeURIString03" te01str (unEscapeString te01str) testEscapeURIString04 = testEq "testEscapeURIString04" te02str (unEscapeString te02esc) testEscapeURIString = TestList [ testEscapeURIString01 , testEscapeURIString02 , testEscapeURIString03 , testEscapeURIString04 ] -- URI string normalization tests tn01str = "eXAMPLE://a/b/%7bfoo%7d" tn01nrm = "example://a/b/%7Bfoo%7D" tn02str = "example://a/b/%63/" tn02nrm = "example://a/b/c/" tn03str = "example://a/./b/../b/c/foo" tn03nrm = "example://a/b/c/foo" tn04str = "eXAMPLE://a/b/%7bfoo%7d" -- From RFC2396bis, 6.2.2 tn04nrm = "example://a/b/%7Bfoo%7D" tn06str = "file:/x/..//y" tn06nrm = "file://y" tn07str = "file:x/..//y/" tn07nrm = "file:/y/" testNormalizeURIString01 = testEq "testNormalizeURIString01" tn01nrm (normalizeCase tn01str) testNormalizeURIString02 = testEq "testNormalizeURIString02" tn02nrm (normalizeEscape tn02str) testNormalizeURIString03 = testEq "testNormalizeURIString03" tn03nrm (normalizePathSegments tn03str) testNormalizeURIString04 = testEq "testNormalizeURIString04" tn04nrm ((normalizeCase . normalizeEscape . normalizePathSegments) tn04str) testNormalizeURIString05 = testEq "testNormalizeURIString05" tn04nrm ((normalizePathSegments . normalizeEscape . normalizeCase) tn04str) testNormalizeURIString06 = testEq "testNormalizeURIString06" tn06nrm (normalizePathSegments tn06str) testNormalizeURIString07 = testEq "testNormalizeURIString07" tn07nrm (normalizePathSegments tn07str) testNormalizeURIString = TestList [ testNormalizeURIString01 , testNormalizeURIString02 , testNormalizeURIString03 , testNormalizeURIString04 , testNormalizeURIString05 , testNormalizeURIString06 , testNormalizeURIString07 ] tnus67 = runTestTT $ TestList [ testNormalizeURIString06 , testNormalizeURIString07 ] -- Test strict vs non-strict relativeTo logic trbase = fromJust $ parseURIReference "http://bar.org/" testRelativeTo01 = testEq "testRelativeTo01" "http://bar.org/foo" (show . fromJust $ (fromJust $ parseURIReference "foo") `relativeTo` trbase) testRelativeTo02 = testEq "testRelativeTo02" "http:foo" (show . fromJust $ (fromJust $ parseURIReference "http:foo") `relativeTo` trbase) testRelativeTo03 = testEq "testRelativeTo03" "http://bar.org/foo" (show . fromJust $ (fromJust $ parseURIReference "http:foo") `nonStrictRelativeTo` trbase) testRelativeTo = TestList [ testRelativeTo01 , testRelativeTo02 , testRelativeTo03 ] -- Test alternative parsing functions testAltFn01 = testEq "testAltFn01" "Just http://a.b/c#f" (show . parseURI $ "http://a.b/c#f") testAltFn02 = testEq "testAltFn02" "Just http://a.b/c#f" (show . parseURIReference $ "http://a.b/c#f") testAltFn03 = testEq "testAltFn03" "Just c/d#f" (show . parseRelativeReference $ "c/d#f") testAltFn04 = testEq "testAltFn04" "Nothing" (show . parseRelativeReference $ "http://a.b/c#f") testAltFn05 = testEq "testAltFn05" "Just http://a.b/c" (show . parseAbsoluteURI $ "http://a.b/c") testAltFn06 = testEq "testAltFn06" "Nothing" (show . parseAbsoluteURI $ "http://a.b/c#f") testAltFn07 = testEq "testAltFn07" "Nothing" (show . parseAbsoluteURI $ "c/d") testAltFn08 = testEq "testAltFn08" "Just http://a.b/c" (show . parseabsoluteURI $ "http://a.b/c") testAltFn11 = testEq "testAltFn11" True (isURI "http://a.b/c#f") testAltFn12 = testEq "testAltFn12" True (isURIReference "http://a.b/c#f") testAltFn13 = testEq "testAltFn13" True (isRelativeReference "c/d#f") testAltFn14 = testEq "testAltFn14" False (isRelativeReference "http://a.b/c#f") testAltFn15 = testEq "testAltFn15" True (isAbsoluteURI "http://a.b/c") testAltFn16 = testEq "testAltFn16" False (isAbsoluteURI "http://a.b/c#f") testAltFn17 = testEq "testAltFn17" False (isAbsoluteURI "c/d") testAltFn = TestList [ testAltFn01 , testAltFn02 , testAltFn03 , testAltFn04 , testAltFn05 , testAltFn06 , testAltFn07 , testAltFn08 , testAltFn11 , testAltFn12 , testAltFn13 , testAltFn14 , testAltFn15 , testAltFn16 , testAltFn17 ] -- Full test suite allTests = TestList [ testURIRefSuite , testComponentSuite , testRelativeSuite , testRFC2396Suite , testOddballSuite , testNormalizeSuite , testShowURI , testEscapeURIString , testNormalizeURIString , testRelativeTo , testAltFn ] main = runTestTT allTests runTestFile t = do h <- openFile "a.tmp" WriteMode runTestText (putTextToHandle h False) t hClose h tf = runTestFile tt = runTestTT -- Miscellaneous values for hand-testing/debugging in Hugs: uref = testURIRefSuite tr01 = testRelative01 tr02 = testRelative02 tr03 = testRelative03 tr04 = testRelative04 rel = testRelativeSuite rfc = testRFC2396Suite oddb = testOddballSuite (Just bu02) = parseURIReference "http://example/x/y/z" (Just ou02) = parseURIReference "../abc" (Just ru02) = parseURIReference "http://example/x/abc" -- fileuri = testURIReference "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/" cu02 = ou02 `relativeTo` bu02 -------------------------------------------------------------------------------- -- -- Copyright (c) 2004, G. KLYNE. All rights reserved. -- Distributed as free software under the following license. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions -- are met: -- -- - Redistributions of source code must retain the above copyright notice, -- this list of conditions and the following disclaimer. -- -- - Redistributions in binary form must reproduce the above copyright -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. -- -- - Neither name of the copyright holders nor the names of its -- contributors may be used to endorse or promote products derived from -- this software without specific prior written permission. -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, -- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, -- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS -- OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR -- TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE -- USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- -------------------------------------------------------------------------------- -- $Source: /srv/cvs/cvs.haskell.org/fptools/libraries/network/tests/URITest.hs,v $ -- $Author: gklyne $ -- $Revision: 1.8 $ -- $Log: URITest.hs,v $ -- Revision 1.8 2005/07/19 22:01:27 gklyne -- Added some additional test cases raised by discussion on URI@w3.org mailing list about 2005-07-19. The test p[roposed by this discussion exposed a subtle bug in relativeFrom not being an exact inverse of relativeTo. -- -- Revision 1.7 2005/06/06 16:31:44 gklyne -- Added two new test cases. -- -- Revision 1.6 2005/05/31 17:18:36 gklyne -- Added some additional test cases triggered by URI-list discussions. -- -- Revision 1.5 2005/04/07 11:09:37 gklyne -- Added test cases for alternate parsing functions (including deprecated 'parseabsoluteURI') -- -- Revision 1.4 2005/04/05 12:47:32 gklyne -- Added test case. -- Changed module name, now requires GHC -main-is to compile. -- All tests run OK with GHC 6.4 on MS-Windows. -- -- Revision 1.3 2004/11/05 17:29:09 gklyne -- Changed password-obscuring logic to reflect late change in revised URI -- specification (password "anonymous" is no longer a special case). -- Updated URI test module to use function 'escapeURIString'. -- (Should unEscapeString be similarly updated?) -- -- Revision 1.2 2004/10/27 13:06:55 gklyne -- Updated URI module function names per: -- http://www.haskell.org//pipermail/cvs-libraries/2004-October/002916.html -- Added test cases to give better covereage of module functions. -- -- Revision 1.1 2004/10/14 16:11:30 gklyne -- Add URI unit test to cvs.haskell.org repository -- -- Revision 1.17 2004/10/14 11:51:09 graham -- Confirm that URITest runs with GHC. -- Fix up some comments and other minor details. -- -- Revision 1.16 2004/10/14 11:45:30 graham -- Use moduke name main for GHC 6.2 -- -- Revision 1.15 2004/08/11 11:07:39 graham -- Add new test case. -- -- Revision 1.14 2004/06/30 11:35:27 graham -- Update URI code to use hierarchical libraries for Parsec and Network. -- -- Revision 1.13 2004/06/22 16:19:16 graham -- New URI test case added. -- -- Revision 1.12 2004/04/21 15:13:29 graham -- Add test case -- -- Revision 1.11 2004/04/21 14:54:05 graham -- Fix up some tests -- -- Revision 1.10 2004/04/20 14:54:13 graham -- Fix up test cases related to port number in authority, -- and add some more URI decomposition tests. -- -- Revision 1.9 2004/04/07 15:06:17 graham -- Add extra test case -- Revise syntax in line with changes to RFC2396bis -- -- Revision 1.8 2004/03/17 14:34:58 graham -- Add Network.HTTP files to CVS -- -- Revision 1.7 2004/03/16 14:19:38 graham -- Change licence to BSD style; add nullURI definition; new test cases. -- -- Revision 1.6 2004/02/20 12:12:00 graham -- Add URI normalization functions -- -- Revision 1.5 2004/02/19 23:19:35 graham -- Network.URI module passes all test cases -- -- Revision 1.4 2004/02/17 20:06:02 graham -- Revised URI parser to reflect latest RFC2396bis (-04) -- -- Revision 1.3 2004/02/11 14:32:14 graham -- Added work-in-progress notes. -- -- Revision 1.2 2004/02/02 14:00:39 graham -- Fix optional host name in URI. Add test cases. -- -- Revision 1.1 2004/01/27 21:13:45 graham -- New URI module and test suite added, -- implementing the GHC Network.URI interface. -- hugs98-plus-Sep2006/packages/network/Setup.hs0000644006511100651110000000023210504340250017654 0ustar rossrossmodule Main (main) where import Distribution.Simple (defaultMainWithHooks, defaultUserHooks) main :: IO () main = defaultMainWithHooks defaultUserHooks hugs98-plus-Sep2006/packages/network/network.buildinfo.in0000644006511100651110000000017310504340250022217 0ustar rossrossghc-options: -DCALLCONV=@CALLCONV@ cc-options: -DCALLCONV=@CALLCONV@ c-sources: @EXTRA_SRCS@ extra-libraries: @EXTRA_LIBS@ hugs98-plus-Sep2006/packages/network/network.cabal0000644006511100651110000000134410504340250020702 0ustar rossrossname: network version: 2.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org synopsis: Networking-related facilities exposed-modules: Network Network.BSD Network.Socket Network.URI extra-source-files: config.guess config.sub install-sh configure.ac configure network.buildinfo.in include/HsNetworkConfig.h.in include/HsNet.h include/Typeable.h -- C sources only used on some systems cbits/ancilData.c cbits/asyncAccept.c cbits/initWinSock.c cbits/winSockErr.c extra-tmp-files: config.log config.status autom4te.cache network.buildinfo include/HsNetworkConfig.h build-depends: base, parsec extensions: CPP include-dirs: include install-includes: HsNet.h HsNetworkConfig.h c-sources: cbits/HsNet.c hugs98-plus-Sep2006/packages/network/package.conf.in0000644006511100651110000000120610504340250021071 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: Network.BSD, Network.Socket, Network.URI, Network hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSnetwork" #ifdef solaris2_HOST_OS extra-libraries: "nsl", "socket" #elif defined(_MSC_VER) || defined(__MINGW32__) extra-libraries: "wsock32" #else extra-libraries: #endif include-dirs: INCLUDE_DIR includes: "HsNet.h" depends: base, parsec, html hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/network/prologue.txt0000644006511100651110000000003710504340250020620 0ustar rossrossNetworking-related facilities. hugs98-plus-Sep2006/packages/network/config.guess0000644006511100651110000012605110504340250020545 0ustar rossross#! /bin/sh # Attempt to guess a canonical system name. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. timestamp='2006-02-23' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA # 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Originally written by Per Bothner . # Please send patches to . Submit a context # diff and a properly formatted ChangeLog entry. # # This script attempts to guess a canonical system name similar to # config.sub. If it succeeds, it prints the system name on stdout, and # exits with 0. Otherwise, it exits with 1. # # The plan is that this can be called by configure scripts if you # don't specify an explicit build system type. me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] Output the configuration name of the system \`$me' is run on. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to ." version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" >&2 exit 1 ;; * ) break ;; esac done if test $# != 0; then echo "$me: too many arguments$help" >&2 exit 1 fi trap 'exit 1' 1 2 15 # CC_FOR_BUILD -- compiler used by this script. Note that the use of a # compiler to aid in system detection is discouraged as it requires # temporary files to be created and, as you can see below, it is a # headache to deal with in a portable fashion. # Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still # use `HOST_CC' if defined, but it is deprecated. # Portable tmp directory creation inspired by the Autoconf team. set_cc_for_build=' trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; : ${TMPDIR=/tmp} ; { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; dummy=$tmp/dummy ; tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; case $CC_FOR_BUILD,$HOST_CC,$CC in ,,) echo "int x;" > $dummy.c ; for c in cc gcc c89 c99 ; do if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then CC_FOR_BUILD="$c"; break ; fi ; done ; if test x"$CC_FOR_BUILD" = x ; then CC_FOR_BUILD=no_compiler_found ; fi ;; ,,*) CC_FOR_BUILD=$CC ;; ,*,*) CC_FOR_BUILD=$HOST_CC ;; esac ; set_cc_for_build= ;' # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24) if (test -f /.attbin/uname) >/dev/null 2>&1 ; then PATH=$PATH:/.attbin ; export PATH fi UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown # Note: order is significant - the case branches are not exclusive. case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward # compatibility and a consistent mechanism for selecting the # object file format. # # Note: NetBSD doesn't particularly care about the vendor # portion of the name. We always set it to "unknown". sysctl="sysctl -n hw.machine_arch" UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ /usr/sbin/$sysctl 2>/dev/null || echo unknown)` case "${UNAME_MACHINE_ARCH}" in armeb) machine=armeb-unknown ;; arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched # to ELF recently, or will in the future. case "${UNAME_MACHINE_ARCH}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep __ELF__ >/dev/null then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? os=netbsd else os=netbsdelf fi ;; *) os=netbsd ;; esac # The OS release # Debian GNU/NetBSD machines have a different userland, and # thus, need a distinct triplet. However, they do not need # kernel version information, so it can be replaced with a # suitable tag, in the style of linux-gnu. case "${UNAME_VERSION}" in Debian*) release='-gnu' ;; *) release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` ;; esac # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: # contains redundant information, the shorter form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} exit ;; *:ekkoBSD:*:*) echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} exit ;; *:SolidBSD:*:*) echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} exit ;; macppc:MirBSD:*:*) echo powerppc-unknown-mirbsd${UNAME_RELEASE} exit ;; *:MirBSD:*:*) echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} exit ;; alpha:OSF1:*:*) case $UNAME_RELEASE in *4.0) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on # OSF/1 and Tru64 systems produced since 1995. I hope that # covers most systems running today. This code pipes the CPU # types through head -n 1, so we only detect the type of CPU 0. ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` case "$ALPHA_CPU_TYPE" in "EV4 (21064)") UNAME_MACHINE="alpha" ;; "EV4.5 (21064)") UNAME_MACHINE="alpha" ;; "LCA4 (21066/21068)") UNAME_MACHINE="alpha" ;; "EV5 (21164)") UNAME_MACHINE="alphaev5" ;; "EV5.6 (21164A)") UNAME_MACHINE="alphaev56" ;; "EV5.6 (21164PC)") UNAME_MACHINE="alphapca56" ;; "EV5.7 (21164PC)") UNAME_MACHINE="alphapca57" ;; "EV6 (21264)") UNAME_MACHINE="alphaev6" ;; "EV6.7 (21264A)") UNAME_MACHINE="alphaev67" ;; "EV6.8CB (21264C)") UNAME_MACHINE="alphaev68" ;; "EV6.8AL (21264B)") UNAME_MACHINE="alphaev68" ;; "EV6.8CX (21264D)") UNAME_MACHINE="alphaev68" ;; "EV6.9A (21264/EV69A)") UNAME_MACHINE="alphaev69" ;; "EV7 (21364)") UNAME_MACHINE="alphaev7" ;; "EV7.9 (21364A)") UNAME_MACHINE="alphaev79" ;; esac # A Pn.n version is a patched version. # A Vn.n version is a released version. # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` exit ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead # of the specific Alpha model? echo alpha-pc-interix exit ;; 21064:Windows_NT:50:3) echo alpha-dec-winnt3.5 exit ;; Amiga*:UNIX_System_V:4.0:*) echo m68k-unknown-sysv4 exit ;; *:[Aa]miga[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-amigaos exit ;; *:[Mm]orph[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-morphos exit ;; *:OS/390:*:*) echo i370-ibm-openedition exit ;; *:z/VM:*:*) echo s390-ibm-zvmoe exit ;; *:OS400:*:*) echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; arm:riscos:*:*|arm:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) echo hppa1.1-hitachi-hiuxmpp exit ;; Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. if test "`(/bin/universe) 2>/dev/null`" = att ; then echo pyramid-pyramid-sysv3 else echo pyramid-pyramid-bsd fi exit ;; NILE*:*:*:dcosx) echo pyramid-pyramid-svr4 exit ;; DRS?6000:unix:4.0:6*) echo sparc-icl-nx6 exit ;; DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; i86pc:SunOS:5.*:*) echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:*:*) case "`/usr/bin/arch -k`" in Series*|S4*) UNAME_RELEASE=`uname -v` ;; esac # Japanese Language versions have a version number like `4.1.3-JL'. echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` exit ;; sun3*:SunOS:*:*) echo m68k-sun-sunos${UNAME_RELEASE} exit ;; sun*:*:4.2BSD:*) UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 case "`/bin/arch`" in sun3) echo m68k-sun-sunos${UNAME_RELEASE} ;; sun4) echo sparc-sun-sunos${UNAME_RELEASE} ;; esac exit ;; aushp:SunOS:*:*) echo sparc-auspex-sunos${UNAME_RELEASE} exit ;; # The situation for MiNT is a little confusing. The machine name # can be virtually everything (everything which is not # "atarist" or "atariste" at least should have a processor # > m68000). The system name ranges from "MiNT" over "FreeMiNT" # to the lowercase version "mint" (or "freemint"). Finally # the system name "TOS" denotes a system which is actually not # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) echo m68k-milan-mint${UNAME_RELEASE} exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) echo m68k-hades-mint${UNAME_RELEASE} exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) echo m68k-unknown-mint${UNAME_RELEASE} exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; powerpc:machten:*:*) echo powerpc-apple-machten${UNAME_RELEASE} exit ;; RISC*:Mach:*:*) echo mips-dec-mach_bsd4.3 exit ;; RISC*:ULTRIX:*:*) echo mips-dec-ultrix${UNAME_RELEASE} exit ;; VAX*:ULTRIX*:*:*) echo vax-dec-ultrix${UNAME_RELEASE} exit ;; 2020:CLIX:*:* | 2430:CLIX:*:*) echo clipper-intergraph-clix${UNAME_RELEASE} exit ;; mips:*:*:UMIPS | mips:*:*:RISCos) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #ifdef __cplusplus #include /* for printf() prototype */ int main (int argc, char *argv[]) { #else int main (argc, argv) int argc; char *argv[]; { #endif #if defined (host_mips) && defined (MIPSEB) #if defined (SYSTYPE_SYSV) printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_SVR4) printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); #endif #endif exit (-1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && SYSTEM_NAME=`$dummy $dummyarg` && { echo "$SYSTEM_NAME"; exit; } echo mips-mips-riscos${UNAME_RELEASE} exit ;; Motorola:PowerMAX_OS:*:*) echo powerpc-motorola-powermax exit ;; Motorola:*:4.3:PL8-*) echo powerpc-harris-powermax exit ;; Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) echo powerpc-harris-powermax exit ;; Night_Hawk:Power_UNIX:*:*) echo powerpc-harris-powerunix exit ;; m88k:CX/UX:7*:*) echo m88k-harris-cxux7 exit ;; m88k:*:4*:R4*) echo m88k-motorola-sysv4 exit ;; m88k:*:3*:R3*) echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ [ ${TARGET_BINARY_INTERFACE}x = x ] then echo m88k-dg-dgux${UNAME_RELEASE} else echo m88k-dg-dguxbcs${UNAME_RELEASE} fi else echo i586-dg-dgux${UNAME_RELEASE} fi exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; M88*:*:R3*:*) # Delta 88k system running SVR3 echo m88k-motorola-sysv3 exit ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) echo m88k-tektronix-sysv3 exit ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) echo m68k-tektronix-bsd exit ;; *:IRIX*:*:*) echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` exit ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i*86:AIX:*:*) echo i386-ibm-aix exit ;; ia64:AIX:*:*) if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} exit ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include main() { if (!__power_pc()) exit(1); puts("powerpc-ibm-aix3.2.5"); exit(0); } EOF if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` then echo "$SYSTEM_NAME" else echo rs6000-ibm-aix3.2.5 fi elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then echo rs6000-ibm-aix3.2.4 else echo rs6000-ibm-aix3.2 fi exit ;; *:AIX:*:[45]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 else IBM_ARCH=powerpc fi if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${IBM_ARCH}-ibm-aix${IBM_REV} exit ;; *:AIX:*:*) echo rs6000-ibm-aix exit ;; ibmrt:4.4BSD:*|romp-ibm:BSD:*) echo romp-ibm-bsd4.4 exit ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to exit ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) echo rs6000-bull-bosx exit ;; DPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 exit ;; 9000/[34]??:4.3bsd:1.*:*) echo m68k-hp-bsd exit ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) echo m68k-hp-bsd4.4 exit ;; 9000/[34678]??:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` case "${UNAME_MACHINE}" in 9000/31? ) HP_ARCH=m68000 ;; 9000/[34]?? ) HP_ARCH=m68k ;; 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` case "${sc_cpu_version}" in 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 532) # CPU_PA_RISC2_0 case "${sc_kernel_bits}" in 32) HP_ARCH="hppa2.0n" ;; 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 esac ;; esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #define _HPUX_SOURCE #include #include int main () { #if defined(_SC_KERNEL_BITS) long bits = sysconf(_SC_KERNEL_BITS); #endif long cpu = sysconf (_SC_CPU_VERSION); switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0"); break; case CPU_PA_RISC1_1: puts ("hppa1.1"); break; case CPU_PA_RISC2_0: #if defined(_SC_KERNEL_BITS) switch (bits) { case 64: puts ("hppa2.0w"); break; case 32: puts ("hppa2.0n"); break; default: puts ("hppa2.0"); break; } break; #else /* !defined(_SC_KERNEL_BITS) */ puts ("hppa2.0"); break; #endif default: puts ("hppa1.0"); break; } exit (0); } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa fi ;; esac if [ ${HP_ARCH} = "hppa2.0w" ] then eval $set_cc_for_build # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler # generating 64-bit code. GNU and HP use different nomenclature: # # $ CC_FOR_BUILD=cc ./config.guess # => hppa2.0w-hp-hpux11.23 # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | grep __LP64__ >/dev/null then HP_ARCH="hppa2.0w" else HP_ARCH="hppa64" fi fi echo ${HP_ARCH}-hp-hpux${HPUX_REV} exit ;; ia64:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` echo ia64-hp-hpux${HPUX_REV} exit ;; 3050*:HI-UX:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include int main () { long cpu = sysconf (_SC_CPU_VERSION); /* The order matters, because CPU_IS_HP_MC68K erroneously returns true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct results, however. */ if (CPU_IS_PA_RISC (cpu)) { switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; default: puts ("hppa-hitachi-hiuxwe2"); break; } } else if (CPU_IS_HP_MC68K (cpu)) puts ("m68k-hitachi-hiuxwe2"); else puts ("unknown-hitachi-hiuxwe2"); exit (0); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } echo unknown-hitachi-hiuxwe2 exit ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) echo hppa1.1-hp-bsd exit ;; 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exit ;; *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) echo hppa1.0-hp-mpeix exit ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf exit ;; hp8??:OSF1:*:*) echo hppa1.0-hp-osf exit ;; i*86:OSF1:*:*) if [ -x /usr/sbin/sysversion ] ; then echo ${UNAME_MACHINE}-unknown-osf1mk else echo ${UNAME_MACHINE}-unknown-osf1 fi exit ;; parisc*:Lites*:*:*) echo hppa1.1-hp-lites exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*[A-Z]90:*:*:*) echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ -e 's/\.[^.]*$/.X/' exit ;; CRAY*TS:*:*:*) echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*T3E:*:*:*) echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*SV1:*:*:*) echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; *:UNICOS/mp:*:*) echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; 5000:UNIX_System_V:4.*:*) FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} exit ;; sparc*:BSD/OS:*:*) echo sparc-unknown-bsdi${UNAME_RELEASE} exit ;; *:BSD/OS:*:*) echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) case ${UNAME_MACHINE} in pc98) echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; i*:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; i*:MSYS_NT-*:*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; i*:windows32*:*) # uname -m includes "-pc" on this system. echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; x86:Interix*:[345]*) echo i586-pc-interix${UNAME_RELEASE} exit ;; EM64T:Interix*:[345]*) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we # UNAME_MACHINE based on the output of uname instead of i386? echo i586-pc-interix exit ;; i*:UWIN*:*) echo ${UNAME_MACHINE}-pc-uwin exit ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) echo x86_64-unknown-cygwin exit ;; p*:CYGWIN*:*) echo powerpcle-unknown-cygwin exit ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; *:GNU:*:*) # the GNU system echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` exit ;; *:GNU/*:*:*) # other systems with GNU libc and userland echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu exit ;; i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; arm*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) echo cris-axis-linux-gnu exit ;; crisv32:Linux:*:*) echo crisv32-axis-linux-gnu exit ;; frv:Linux:*:*) echo frv-unknown-linux-gnu exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; m32r*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; mips:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU #undef mips #undef mipsel #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) CPU=mipsel #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) CPU=mips #else CPU= #endif #endif EOF eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' /^CPU/{ s: ::g p }'`" test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU #undef mips64 #undef mips64el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) CPU=mips64el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) CPU=mips64 #else CPU= #endif #endif EOF eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' /^CPU/{ s: ::g p }'`" test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; or32:Linux:*:*) echo or32-unknown-linux-gnu exit ;; ppc:Linux:*:*) echo powerpc-unknown-linux-gnu exit ;; ppc64:Linux:*:*) echo powerpc64-unknown-linux-gnu exit ;; alpha:Linux:*:*) case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in EV5) UNAME_MACHINE=alphaev5 ;; EV56) UNAME_MACHINE=alphaev56 ;; PCA56) UNAME_MACHINE=alphapca56 ;; PCA57) UNAME_MACHINE=alphapca56 ;; EV6) UNAME_MACHINE=alphaev6 ;; EV67) UNAME_MACHINE=alphaev67 ;; EV68*) UNAME_MACHINE=alphaev68 ;; esac objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in PA7*) echo hppa1.1-unknown-linux-gnu ;; PA8*) echo hppa2.0-unknown-linux-gnu ;; *) echo hppa-unknown-linux-gnu ;; esac exit ;; parisc64:Linux:*:* | hppa64:Linux:*:*) echo hppa64-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) echo x86_64-unknown-linux-gnu exit ;; i*86:Linux:*:*) # The BFD linker knows what the default object file format is, so # first see if it will tell us. cd to the root directory to prevent # problems with other programs or directories called `ld' in the path. # Set LC_ALL=C to ensure ld outputs messages in English. ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ | sed -ne '/supported targets:/!d s/[ ][ ]*/ /g s/.*supported targets: *// s/ .*// p'` case "$ld_supported_targets" in elf32-i386) TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" ;; a.out-i386-linux) echo "${UNAME_MACHINE}-pc-linux-gnuaout" exit ;; coff-i386) echo "${UNAME_MACHINE}-pc-linux-gnucoff" exit ;; "") # Either a pre-BFD a.out linker (linux-gnuoldld) or # one that does not give us useful --help. echo "${UNAME_MACHINE}-pc-linux-gnuoldld" exit ;; esac # Determine whether the default compiler is a.out or elf eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include #ifdef __ELF__ # ifdef __GLIBC__ # if __GLIBC__ >= 2 LIBC=gnu # else LIBC=gnulibc1 # endif # else LIBC=gnulibc1 # endif #else #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__sun) LIBC=gnu #else LIBC=gnuaout #endif #endif #ifdef __dietlibc__ LIBC=dietlibc #endif EOF eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' /^LIBC/{ s: ::g p }'`" test x"${LIBC}" != x && { echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit } test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both # sysname and nodename. echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) # Unixware is an offshoot of SVR4, but it has its own version # number series starting with 2... # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) # If we were able to find `uname', then EMX Unix compatibility # is probably installed. echo ${UNAME_MACHINE}-pc-os2-emx exit ;; i*86:XTS-300:*:STOP) echo ${UNAME_MACHINE}-unknown-stop exit ;; i*86:atheos:*:*) echo ${UNAME_MACHINE}-unknown-atheos exit ;; i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) echo ${UNAME_MACHINE}-pc-msdosdjgpp exit ;; i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} else echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} fi exit ;; i*86:*:5:[678]*) # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; *Pent*|*Celeron) UNAME_MACHINE=i686 ;; esac echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} exit ;; i*86:*:3.2:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ && UNAME_MACHINE=i686 (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ && UNAME_MACHINE=i686 echo ${UNAME_MACHINE}-pc-sco$UNAME_REL else echo ${UNAME_MACHINE}-pc-sysv32 fi exit ;; pc:*:*:*) # Left here for compatibility: # uname -m prints for DJGPP always 'pc', but it prints nothing about # the processor, so we play safe by assuming i386. echo i386-pc-msdosdjgpp exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; paragon:*:*:*) echo i860-intel-osf1 exit ;; i860:*:4.*:*) # i860-SVR4 if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 fi exit ;; mini*:CTIX:SYS*5:*) # "miniframe" echo m68010-convergent-sysv exit ;; mc68k:UNIX:SYSTEM5:3.51m) echo m68k-convergent-sysv exit ;; M680?0:D-NIX:5.3:*) echo m68k-diab-dnix exit ;; M68*:*:R3V[5678]*:*) test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) OS_REL='' test -r /etc/.relid \ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; mc68030:UNIX_System_V:4.*:*) echo m68k-atari-sysv4 exit ;; TSUNAMI:LynxOS:2.*:*) echo sparc-unknown-lynxos${UNAME_RELEASE} exit ;; rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) echo mips-dde-sysv${UNAME_RELEASE} exit ;; RM*:ReliantUNIX-*:*:*) echo mips-sni-sysv4 exit ;; RM*:SINIX-*:*:*) echo mips-sni-sysv4 exit ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` echo ${UNAME_MACHINE}-sni-sysv4 else echo ns32k-sni-sysv fi exit ;; PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort # says echo i586-unisys-sysv4 exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes . # How about differentiating between stratus architectures? -djm echo hppa1.1-stratus-sysv4 exit ;; *:*:*:FTX*) # From seanf@swdc.stratus.com. echo i860-stratus-sysv4 exit ;; i*86:VOS:*:*) # From Paul.Green@stratus.com. echo ${UNAME_MACHINE}-stratus-vos exit ;; *:VOS:*:*) # From Paul.Green@stratus.com. echo hppa1.1-stratus-vos exit ;; mc68*:A/UX:*:*) echo m68k-apple-aux${UNAME_RELEASE} exit ;; news*:NEWS-OS:6*:*) echo mips-sony-newsos6 exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then echo mips-nec-sysv${UNAME_RELEASE} else echo mips-unknown-sysv${UNAME_RELEASE} fi exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. echo powerpc-apple-beos exit ;; BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; SX-5:SUPER-UX:*:*) echo sx5-nec-superux${UNAME_RELEASE} exit ;; SX-6:SUPER-UX:*:*) echo sx6-nec-superux${UNAME_RELEASE} exit ;; Power*:Rhapsody:*:*) echo powerpc-apple-rhapsody${UNAME_RELEASE} exit ;; *:Rhapsody:*:*) echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} exit ;; *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} exit ;; *:procnto*:*:* | *:QNX:[0123456789]*:*) UNAME_PROCESSOR=`uname -p` if test "$UNAME_PROCESSOR" = "x86"; then UNAME_PROCESSOR=i386 UNAME_MACHINE=pc fi echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} exit ;; *:QNX:*:4*) echo i386-pc-qnx exit ;; NSE-?:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) echo nsr-tandem-nsk${UNAME_RELEASE} exit ;; *:NonStop-UX:*:*) echo mips-compaq-nonstopux exit ;; BS2000:POSIX*:*:*) echo bs2000-siemens-sysv exit ;; DS/*:UNIX_System_V:*:*) echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} exit ;; *:Plan9:*:*) # "uname -m" is not consistent, so use $cputype instead. 386 # is converted to i386 for consistency with other x86 # operating systems. if test "$cputype" = "386"; then UNAME_MACHINE=i386 else UNAME_MACHINE="$cputype" fi echo ${UNAME_MACHINE}-unknown-plan9 exit ;; *:TOPS-10:*:*) echo pdp10-unknown-tops10 exit ;; *:TENEX:*:*) echo pdp10-unknown-tenex exit ;; KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) echo pdp10-dec-tops20 exit ;; XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) echo pdp10-xkl-tops20 exit ;; *:TOPS-20:*:*) echo pdp10-unknown-tops20 exit ;; *:ITS:*:*) echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; V*) echo vax-dec-vms ; exit ;; esac ;; *:XENIX:*:SysV) echo i386-pc-xenix exit ;; i*86:skyos:*:*) echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' exit ;; i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 eval $set_cc_for_build cat >$dummy.c < # include #endif main () { #if defined (sony) #if defined (MIPSEB) /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, I don't know.... */ printf ("mips-sony-bsd\n"); exit (0); #else #include printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 "4" #else "" #endif ); exit (0); #endif #endif #if defined (__arm) && defined (__acorn) && defined (__unix) printf ("arm-acorn-riscix\n"); exit (0); #endif #if defined (hp300) && !defined (hpux) printf ("m68k-hp-bsd\n"); exit (0); #endif #if defined (NeXT) #if !defined (__ARCHITECTURE__) #define __ARCHITECTURE__ "m68k" #endif int version; version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; if (version < 4) printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); else printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); exit (0); #endif #if defined (MULTIMAX) || defined (n16) #if defined (UMAXV) printf ("ns32k-encore-sysv\n"); exit (0); #else #if defined (CMU) printf ("ns32k-encore-mach\n"); exit (0); #else printf ("ns32k-encore-bsd\n"); exit (0); #endif #endif #endif #if defined (__386BSD__) printf ("i386-pc-bsd\n"); exit (0); #endif #if defined (sequent) #if defined (i386) printf ("i386-sequent-dynix\n"); exit (0); #endif #if defined (ns32000) printf ("ns32k-sequent-dynix\n"); exit (0); #endif #endif #if defined (_SEQUENT_) struct utsname un; uname(&un); if (strncmp(un.version, "V2", 2) == 0) { printf ("i386-sequent-ptx2\n"); exit (0); } if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ printf ("i386-sequent-ptx1\n"); exit (0); } printf ("i386-sequent-ptx\n"); exit (0); #endif #if defined (vax) # if !defined (ultrix) # include # if defined (BSD) # if BSD == 43 printf ("vax-dec-bsd4.3\n"); exit (0); # else # if BSD == 199006 printf ("vax-dec-bsd4.3reno\n"); exit (0); # else printf ("vax-dec-bsd\n"); exit (0); # endif # endif # else printf ("vax-dec-bsd\n"); exit (0); # endif # else printf ("vax-dec-ultrix\n"); exit (0); # endif #endif #if defined (alliant) && defined (i860) printf ("i860-alliant-bsd\n"); exit (0); #endif exit (1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } # Apollos put the system type in the environment. test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } # Convex versions that predate uname can use getsysinfo(1) if [ -x /usr/convex/getsysinfo ] then case `getsysinfo -f cpu_type` in c1*) echo c1-convex-bsd exit ;; c2*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; c34*) echo c34-convex-bsd exit ;; c38*) echo c38-convex-bsd exit ;; c4*) echo c4-convex-bsd exit ;; esac fi cat >&2 < in order to provide the needed information to handle your system. config.guess timestamp = $timestamp uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` /bin/uname -X = `(/bin/uname -X) 2>/dev/null` hostinfo = `(hostinfo) 2>/dev/null` /bin/universe = `(/bin/universe) 2>/dev/null` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` /bin/arch = `(/bin/arch) 2>/dev/null` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` UNAME_MACHINE = ${UNAME_MACHINE} UNAME_RELEASE = ${UNAME_RELEASE} UNAME_SYSTEM = ${UNAME_SYSTEM} UNAME_VERSION = ${UNAME_VERSION} EOF exit 1 # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: hugs98-plus-Sep2006/packages/network/config.sub0000644006511100651110000007713010504340250020213 0ustar rossross#! /bin/sh # Configuration validation subroutine script. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. timestamp='2006-02-23' # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software # can handle that machine. It does not imply ALL GNU software can. # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA # 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Please send patches to . Submit a context # diff and a properly formatted ChangeLog entry. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. # Each package is responsible for reporting which valid configurations # it does not support. The user should be able to distinguish # a failure to support a valid configuration from a meaningless # configuration. # The goal of this file is to map all the various variations of a given # machine specification into a single specification in the form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM # or in some cases, the newer four-part form: # CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM # It is wrong to echo any other type of specification. me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] CPU-MFR-OPSYS $0 [OPTION] ALIAS Canonicalize a configuration name. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to ." version="\ GNU config.sub ($timestamp) Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" exit 1 ;; *local*) # First pass through any local machine types. echo $1 exit ;; * ) break ;; esac done case $# in 0) echo "$me: missing argument$help" >&2 exit 1;; 1) ;; *) echo "$me: too many arguments$help" >&2 exit 1;; esac # Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] then os=`echo $1 | sed 's/.*-/-/'` else os=; fi ;; esac ### Let's recognize common machines as not being operating systems so ### that things like config.sub decstation-3100 work. We also ### recognize some manufacturers as not being operating systems, so we ### can provide default operating systems below. case $os in -sun*os*) # Prevent following clause from handling this invalid input. ;; -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ -apple | -axis | -knuth | -cray) os= basic_machine=$1 ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 ;; -scout) ;; -wrs) os=-vxworks basic_machine=$1 ;; -chorusos*) os=-chorusos basic_machine=$1 ;; -chorusrdb) os=-chorusrdb basic_machine=$1 ;; -hiux*) os=-hiuxwe2 ;; -sco6) os=-sco5v6 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco4) os=-sco3.2v4 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2.[4-9]*) os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2v[4-9]*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco5v6*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -udk*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -isc) os=-isc2.2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -clix*) basic_machine=clipper-intergraph ;; -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -lynx*) os=-lynxos ;; -ptx*) basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` ;; -windowsnt*) os=`echo $os | sed -e 's/windowsnt/winnt/'` ;; -psos*) os=-psos ;; -mint | -mint[0-9]*) basic_machine=m68k-atari os=-mint ;; esac # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ | m32r | m32rle | m68000 | m68k | m88k | maxq | mb | microblaze | mcore \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ | mips64vr | mips64vrel \ | mips64orion | mips64orionel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ | mipsisa64 | mipsisa64el \ | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ | mt \ | msp430 \ | nios | nios2 \ | ns16k | ns32k \ | or32 \ | pdp10 | pdp11 | pj | pjl \ | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ | pyramid \ | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b \ | strongarm \ | tahoe | thumb | tic4x | tic80 | tron \ | v850 | v850e \ | we32k \ | x86 | xscale | xscalee[bl] | xstormy16 | xtensa \ | z8k) basic_machine=$basic_machine-unknown ;; m32c) basic_machine=$basic_machine-unknown ;; m6811 | m68hc11 | m6812 | m68hc12) # Motorola 68HC11/12. basic_machine=$basic_machine-unknown os=-none ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; ms1) basic_machine=mt-unknown ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. i*86 | x86_64) basic_machine=$basic_machine-pc ;; # Object if more than one company name word. *-*-*) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* \ | bfin-* | bs2000-* \ | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ | m88110-* | m88k-* | maxq-* | mcore-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ | mips64vr-* | mips64vrel-* \ | mips64orion-* | mips64orionel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ | mipsisa64-* | mipsisa64el-* \ | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ | nios-* | nios2-* \ | none-* | np1-* | ns16k-* | ns32k-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ | pyramid-* \ | romp-* | rs6000-* \ | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc86x-* | sparclet-* \ | sparclite-* \ | sparcv8-* | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \ | tahoe-* | thumb-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ | tron-* \ | v850-* | v850e-* | vax-* \ | we32k-* \ | x86-* | x86_64-* | xps100-* | xscale-* | xscalee[bl]-* \ | xstormy16-* | xtensa-* \ | ymp-* \ | z8k-*) ;; m32c-*) ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. 386bsd) basic_machine=i386-unknown os=-bsd ;; 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) basic_machine=m68000-att ;; 3b*) basic_machine=we32k-att ;; a29khif) basic_machine=a29k-amd os=-udi ;; abacus) basic_machine=abacus-unknown ;; adobe68k) basic_machine=m68010-adobe os=-scout ;; alliant | fx80) basic_machine=fx80-alliant ;; altos | altos3068) basic_machine=m68k-altos ;; am29k) basic_machine=a29k-none os=-bsd ;; amd64) basic_machine=x86_64-pc ;; amd64-*) basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; amdahl) basic_machine=580-amdahl os=-sysv ;; amiga | amiga-*) basic_machine=m68k-unknown ;; amigaos | amigados) basic_machine=m68k-unknown os=-amigaos ;; amigaunix | amix) basic_machine=m68k-unknown os=-sysv4 ;; apollo68) basic_machine=m68k-apollo os=-sysv ;; apollo68bsd) basic_machine=m68k-apollo os=-bsd ;; aux) basic_machine=m68k-apple os=-aux ;; balance) basic_machine=ns32k-sequent os=-dynix ;; c90) basic_machine=c90-cray os=-unicos ;; convex-c1) basic_machine=c1-convex os=-bsd ;; convex-c2) basic_machine=c2-convex os=-bsd ;; convex-c32) basic_machine=c32-convex os=-bsd ;; convex-c34) basic_machine=c34-convex os=-bsd ;; convex-c38) basic_machine=c38-convex os=-bsd ;; cray | j90) basic_machine=j90-cray os=-unicos ;; craynv) basic_machine=craynv-cray os=-unicosmp ;; cr16c) basic_machine=cr16c-unknown os=-elf ;; crds | unos) basic_machine=m68k-crds ;; crisv32 | crisv32-* | etraxfs*) basic_machine=crisv32-axis ;; cris | cris-* | etrax*) basic_machine=cris-axis ;; crx) basic_machine=crx-unknown os=-elf ;; da30 | da30-*) basic_machine=m68k-da30 ;; decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) basic_machine=mips-dec ;; decsystem10* | dec10*) basic_machine=pdp10-dec os=-tops10 ;; decsystem20* | dec20*) basic_machine=pdp10-dec os=-tops20 ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) basic_machine=m68k-motorola ;; delta88) basic_machine=m88k-motorola os=-sysv3 ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx ;; dpx2* | dpx2*-bull) basic_machine=m68k-bull os=-sysv3 ;; ebmon29k) basic_machine=a29k-amd os=-ebmon ;; elxsi) basic_machine=elxsi-elxsi os=-bsd ;; encore | umax | mmax) basic_machine=ns32k-encore ;; es1800 | OSE68k | ose68k | ose | OSE) basic_machine=m68k-ericsson os=-ose ;; fx2800) basic_machine=i860-alliant ;; genix) basic_machine=ns32k-ns ;; gmicro) basic_machine=tron-gmicro os=-sysv ;; go32) basic_machine=i386-pc os=-go32 ;; h3050r* | hiux*) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; h8300hms) basic_machine=h8300-hitachi os=-hms ;; h8300xray) basic_machine=h8300-hitachi os=-xray ;; h8500hms) basic_machine=h8500-hitachi os=-hms ;; harris) basic_machine=m88k-harris os=-sysv3 ;; hp300-*) basic_machine=m68k-hp ;; hp300bsd) basic_machine=m68k-hp os=-bsd ;; hp300hpux) basic_machine=m68k-hp os=-hpux ;; hp3k9[0-9][0-9] | hp9[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k2[0-9][0-9] | hp9k31[0-9]) basic_machine=m68000-hp ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp ;; hp9k6[0-9][0-9] | hp6[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k7[0-79][0-9] | hp7[0-79][0-9]) basic_machine=hppa1.1-hp ;; hp9k78[0-9] | hp78[0-9]) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[0-9][13679] | hp8[0-9][13679]) basic_machine=hppa1.1-hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) basic_machine=hppa1.0-hp ;; hppa-next) os=-nextstep3 ;; hppaosf) basic_machine=hppa1.1-hp os=-osf ;; hppro) basic_machine=hppa1.1-hp os=-proelf ;; i370-ibm* | ibm*) basic_machine=i370-ibm ;; # I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 ;; i*86v4*) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv4 ;; i*86v) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv ;; i*86sol2) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-solaris2 ;; i386mach) basic_machine=i386-mach os=-mach ;; i386-vsta | vsta) basic_machine=i386-unknown os=-vsta ;; iris | iris4d) basic_machine=mips-sgi case $os in -irix*) ;; *) os=-irix4 ;; esac ;; isi68 | isi) basic_machine=m68k-isi os=-sysv ;; m88k-omron*) basic_machine=m88k-omron ;; magnum | m3230) basic_machine=mips-mips os=-sysv ;; merlin) basic_machine=ns32k-utek os=-sysv ;; mingw32) basic_machine=i386-pc os=-mingw32 ;; miniframe) basic_machine=m68000-convergent ;; *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) basic_machine=m68k-atari os=-mint ;; mips3*-*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` ;; mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; monitor) basic_machine=m68k-rom68k os=-coff ;; morphos) basic_machine=powerpc-unknown os=-morphos ;; msdos) basic_machine=i386-pc os=-msdos ;; ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; mvs) basic_machine=i370-ibm os=-mvs ;; ncr3000) basic_machine=i486-ncr os=-sysv4 ;; netbsd386) basic_machine=i386-unknown os=-netbsd ;; netwinder) basic_machine=armv4l-rebel os=-linux ;; news | news700 | news800 | news900) basic_machine=m68k-sony os=-newsos ;; news1000) basic_machine=m68030-sony os=-newsos ;; news-3600 | risc-news) basic_machine=mips-sony os=-newsos ;; necv70) basic_machine=v70-nec os=-sysv ;; next | m*-next ) basic_machine=m68k-next case $os in -nextstep* ) ;; -ns2*) os=-nextstep2 ;; *) os=-nextstep3 ;; esac ;; nh3000) basic_machine=m68k-harris os=-cxux ;; nh[45]000) basic_machine=m88k-harris os=-cxux ;; nindy960) basic_machine=i960-intel os=-nindy ;; mon960) basic_machine=i960-intel os=-mon960 ;; nonstopux) basic_machine=mips-compaq os=-nonstopux ;; np1) basic_machine=np1-gould ;; nsr-tandem) basic_machine=nsr-tandem ;; op50n-* | op60c-*) basic_machine=hppa1.1-oki os=-proelf ;; openrisc | openrisc-*) basic_machine=or32-unknown ;; os400) basic_machine=powerpc-ibm os=-os400 ;; OSE68000 | ose68000) basic_machine=m68000-ericsson os=-ose ;; os68k) basic_machine=m68k-none os=-os68k ;; pa-hitachi) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; paragon) basic_machine=i860-intel os=-osf ;; pbd) basic_machine=sparc-tti ;; pbb) basic_machine=m68k-tti ;; pc532 | pc532-*) basic_machine=ns32k-pc532 ;; pc98) basic_machine=i386-pc ;; pc98-*) basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; pentiumpro | p6 | 6x86 | athlon | athlon_*) basic_machine=i686-pc ;; pentiumii | pentium2 | pentiumiii | pentium3) basic_machine=i686-pc ;; pentium4) basic_machine=i786-pc ;; pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumpro-* | p6-* | 6x86-* | athlon-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentium4-*) basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pn) basic_machine=pn-gould ;; power) basic_machine=power-ibm ;; ppc) basic_machine=powerpc-unknown ;; ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown ;; ppcle-* | powerpclittle-*) basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64) basic_machine=powerpc64-unknown ;; ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64le | powerpc64little | ppc64-le | powerpc64-little) basic_machine=powerpc64le-unknown ;; ppc64le-* | powerpc64little-*) basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ps2) basic_machine=i386-ibm ;; pw32) basic_machine=i586-unknown os=-pw32 ;; rdos) basic_machine=i386-pc os=-rdos ;; rom68k) basic_machine=m68k-rom68k os=-coff ;; rm[46]00) basic_machine=mips-siemens ;; rtpc | rtpc-*) basic_machine=romp-ibm ;; s390 | s390-*) basic_machine=s390-ibm ;; s390x | s390x-*) basic_machine=s390x-ibm ;; sa29200) basic_machine=a29k-amd os=-udi ;; sb1) basic_machine=mipsisa64sb1-unknown ;; sb1el) basic_machine=mipsisa64sb1el-unknown ;; sei) basic_machine=mips-sei os=-seiux ;; sequent) basic_machine=i386-sequent ;; sh) basic_machine=sh-hitachi os=-hms ;; sh64) basic_machine=sh64-unknown ;; sparclite-wrs | simso-wrs) basic_machine=sparclite-wrs os=-vxworks ;; sps7) basic_machine=m68k-bull os=-sysv2 ;; spur) basic_machine=spur-unknown ;; st2000) basic_machine=m68k-tandem ;; stratus) basic_machine=i860-stratus os=-sysv4 ;; sun2) basic_machine=m68000-sun ;; sun2os3) basic_machine=m68000-sun os=-sunos3 ;; sun2os4) basic_machine=m68000-sun os=-sunos4 ;; sun3os3) basic_machine=m68k-sun os=-sunos3 ;; sun3os4) basic_machine=m68k-sun os=-sunos4 ;; sun4os3) basic_machine=sparc-sun os=-sunos3 ;; sun4os4) basic_machine=sparc-sun os=-sunos4 ;; sun4sol2) basic_machine=sparc-sun os=-solaris2 ;; sun3 | sun3-*) basic_machine=m68k-sun ;; sun4) basic_machine=sparc-sun ;; sun386 | sun386i | roadrunner) basic_machine=i386-sun ;; sv1) basic_machine=sv1-cray os=-unicos ;; symmetry) basic_machine=i386-sequent os=-dynix ;; t3e) basic_machine=alphaev5-cray os=-unicos ;; t90) basic_machine=t90-cray os=-unicos ;; tic54x | c54x*) basic_machine=tic54x-unknown os=-coff ;; tic55x | c55x*) basic_machine=tic55x-unknown os=-coff ;; tic6x | c6x*) basic_machine=tic6x-unknown os=-coff ;; tx39) basic_machine=mipstx39-unknown ;; tx39el) basic_machine=mipstx39el-unknown ;; toad1) basic_machine=pdp10-xkl os=-tops20 ;; tower | tower-32) basic_machine=m68k-ncr ;; tpf) basic_machine=s390x-ibm os=-tpf ;; udi29k) basic_machine=a29k-amd os=-udi ;; ultra3) basic_machine=a29k-nyu os=-sym1 ;; v810 | necv810) basic_machine=v810-nec os=-none ;; vaxv) basic_machine=vax-dec os=-sysv ;; vms) basic_machine=vax-dec os=-vms ;; vpp*|vx|vx-*) basic_machine=f301-fujitsu ;; vxworks960) basic_machine=i960-wrs os=-vxworks ;; vxworks68) basic_machine=m68k-wrs os=-vxworks ;; vxworks29k) basic_machine=a29k-wrs os=-vxworks ;; w65*) basic_machine=w65-wdc os=-none ;; w89k-*) basic_machine=hppa1.1-winbond os=-proelf ;; xbox) basic_machine=i686-pc os=-mingw32 ;; xps | xps100) basic_machine=xps100-honeywell ;; ymp) basic_machine=ymp-cray os=-unicos ;; z8k-*-coff) basic_machine=z8k-unknown os=-sim ;; none) basic_machine=none-none os=-none ;; # Here we handle the default manufacturer of certain CPU types. It is in # some cases the only manufacturer, in others, it is the most popular. w89k) basic_machine=hppa1.1-winbond ;; op50n) basic_machine=hppa1.1-oki ;; op60c) basic_machine=hppa1.1-oki ;; romp) basic_machine=romp-ibm ;; mmix) basic_machine=mmix-knuth ;; rs6000) basic_machine=rs6000-ibm ;; vax) basic_machine=vax-dec ;; pdp10) # there are many clones, so DEC is not a safe bet basic_machine=pdp10-unknown ;; pdp11) basic_machine=pdp11-dec ;; we32k) basic_machine=we32k-att ;; sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b) basic_machine=sparc-sun ;; cydra) basic_machine=cydra-cydrome ;; orion) basic_machine=orion-highlevel ;; orion105) basic_machine=clipper-highlevel ;; mac | mpw | mac-mpw) basic_machine=m68k-apple ;; pmac | pmac-mpw) basic_machine=powerpc-apple ;; *-unknown) # Make sure to match an already-canonicalized machine name. ;; *) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; esac # Here we canonicalize certain aliases for manufacturers. case $basic_machine in *-digital*) basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` ;; *-commodore*) basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` ;; *) ;; esac # Decode manufacturer-specific aliases for certain operating systems. if [ x"$os" != x"" ] then case $os in # First match some system type aliases # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; -solaris) os=-solaris2 ;; -svr4*) os=-sysv4 ;; -unixware*) os=-sysv4.2uw ;; -gnu/linux*) os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` ;; # First accept the basic system types. # The portable systems comes first. # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ | -aos* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ | -chorusos* | -chorusrdb* \ | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ | -skyos* | -haiku* | -rdos*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) case $basic_machine in x86-* | i*86-*) ;; *) os=-nto$os ;; esac ;; -nto-qnx*) ;; -nto*) os=`echo $os | sed -e 's|nto|nto-qnx|'` ;; -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) ;; -mac*) os=`echo $os | sed -e 's|mac|macos|'` ;; -linux-dietlibc) os=-linux-dietlibc ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; -sunos5*) os=`echo $os | sed -e 's|sunos5|solaris2|'` ;; -sunos6*) os=`echo $os | sed -e 's|sunos6|solaris3|'` ;; -opened*) os=-openedition ;; -os400*) os=-os400 ;; -wince*) os=-wince ;; -osfrose*) os=-osfrose ;; -osf*) os=-osf ;; -utek*) os=-bsd ;; -dynix*) os=-bsd ;; -acis*) os=-aos ;; -atheos*) os=-atheos ;; -syllable*) os=-syllable ;; -386bsd) os=-bsd ;; -ctix* | -uts*) os=-sysv ;; -nova*) os=-rtmk-nova ;; -ns2 ) os=-nextstep2 ;; -nsk*) os=-nsk ;; # Preserve the version number of sinix5. -sinix5.*) os=`echo $os | sed -e 's|sinix|sysv|'` ;; -sinix*) os=-sysv4 ;; -tpf*) os=-tpf ;; -triton*) os=-sysv3 ;; -oss*) os=-sysv3 ;; -svr4) os=-sysv4 ;; -svr3) os=-sysv3 ;; -sysvr4) os=-sysv4 ;; # This must come after -sysvr4. -sysv*) ;; -ose*) os=-ose ;; -es1800*) os=-ose ;; -xenix) os=-xenix ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) os=-mint ;; -aros*) os=-aros ;; -kaos*) os=-kaos ;; -zvmoe) os=-zvmoe ;; -none) ;; *) # Get rid of the `-' at the beginning of $os. os=`echo $os | sed 's/[^-]*-//'` echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 exit 1 ;; esac else # Here we handle the default operating systems that come with various machines. # The value should be what the vendor currently ships out the door with their # machine or put another way, the most popular os provided with the machine. # Note that if you're going to try to match "-MANUFACTURER" here (say, # "-sun"), then you have to tell the case statement up towards the top # that MANUFACTURER isn't an operating system. Otherwise, code above # will signal an error saying that MANUFACTURER isn't an operating # system, and we'll never get to this point. case $basic_machine in *-acorn) os=-riscix1.2 ;; arm*-rebel) os=-linux ;; arm*-semi) os=-aout ;; c4x-* | tic4x-*) os=-coff ;; # This must come before the *-dec entry. pdp10-*) os=-tops20 ;; pdp11-*) os=-none ;; *-dec | vax-*) os=-ultrix4.2 ;; m68*-apollo) os=-domain ;; i386-sun) os=-sunos4.0.2 ;; m68000-sun) os=-sunos3 # This also exists in the configure program, but was not the # default. # os=-sunos4 ;; m68*-cisco) os=-aout ;; mips*-cisco) os=-elf ;; mips*-*) os=-elf ;; or32-*) os=-coff ;; *-tti) # must be before sparc entry or we get the wrong os. os=-sysv3 ;; sparc-* | *-sun) os=-sunos4.1.1 ;; *-be) os=-beos ;; *-haiku) os=-haiku ;; *-ibm) os=-aix ;; *-knuth) os=-mmixware ;; *-wec) os=-proelf ;; *-winbond) os=-proelf ;; *-oki) os=-proelf ;; *-hp) os=-hpux ;; *-hitachi) os=-hiux ;; i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) os=-sysv ;; *-cbm) os=-amigaos ;; *-dg) os=-dgux ;; *-dolphin) os=-sysv3 ;; m68k-ccur) os=-rtu ;; m88k-omron*) os=-luna ;; *-next ) os=-nextstep ;; *-sequent) os=-ptx ;; *-crds) os=-unos ;; *-ns) os=-genix ;; i370-*) os=-mvs ;; *-next) os=-nextstep3 ;; *-gould) os=-sysv ;; *-highlevel) os=-bsd ;; *-encore) os=-bsd ;; *-sgi) os=-irix ;; *-siemens) os=-sysv4 ;; *-masscomp) os=-rtu ;; f30[01]-fujitsu | f700-fujitsu) os=-uxpv ;; *-rom68k) os=-coff ;; *-*bug) os=-coff ;; *-apple) os=-macos ;; *-atari*) os=-mint ;; *) os=-none ;; esac fi # Here we handle the case where we know the os, and the CPU type, but not the # manufacturer. We pick the logical manufacturer. vendor=unknown case $basic_machine in *-unknown) case $os in -riscix*) vendor=acorn ;; -sunos*) vendor=sun ;; -aix*) vendor=ibm ;; -beos*) vendor=be ;; -hpux*) vendor=hp ;; -mpeix*) vendor=hp ;; -hiux*) vendor=hitachi ;; -unos*) vendor=crds ;; -dgux*) vendor=dg ;; -luna*) vendor=omron ;; -genix*) vendor=ns ;; -mvs* | -opened*) vendor=ibm ;; -os400*) vendor=ibm ;; -ptx*) vendor=sequent ;; -tpf*) vendor=ibm ;; -vxsim* | -vxworks* | -windiss*) vendor=wrs ;; -aux*) vendor=apple ;; -hms*) vendor=hitachi ;; -mpw* | -macos*) vendor=apple ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) vendor=atari ;; -vos*) vendor=stratus ;; esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` ;; esac echo $basic_machine$os exit # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: hugs98-plus-Sep2006/packages/network/install-sh0000644006511100651110000002017410504340250020230 0ustar rossross#!/bin/sh # install - install a program, script, or datafile scriptversion=2003-09-24.23 # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the # following copyright and license. # # Copyright (C) 1994 X Consortium # # 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 # X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN # AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- # TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. # # Except as contained in this notice, the name of the X Consortium shall not # be used in advertising or otherwise to promote the sale, use or other deal- # ings in this Software without prior written authorization from the X Consor- # tium. # # # FSF changes to this file are in the public domain. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. It can only install one file at a time, a restriction # shared with many OS's install programs. # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" transformbasename= transform_arg= instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd= chgrpcmd= stripcmd= rmcmd="$rmprog -f" mvcmd="$mvprog" src= dst= dir_arg= usage="Usage: $0 [OPTION]... SRCFILE DSTFILE or: $0 -d DIR1 DIR2... In the first form, install SRCFILE to DSTFILE, removing SRCFILE by default. In the second, create the directory path DIR. Options: -b=TRANSFORMBASENAME -c copy source (using $cpprog) instead of moving (using $mvprog). -d create directories instead of installing files. -g GROUP $chgrp installed files to GROUP. -m MODE $chmod installed files to MODE. -o USER $chown installed files to USER. -s strip installed files (using $stripprog). -t=TRANSFORM --help display this help and exit. --version display version info and exit. Environment variables override the default commands: CHGRPPROG CHMODPROG CHOWNPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG " while test -n "$1"; do case $1 in -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; -c) instcmd=$cpprog shift continue;; -d) dir_arg=true shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; --help) echo "$usage"; exit 0;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -s) stripcmd=$stripprog shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; --version) echo "$0 $scriptversion"; exit 0;; *) if test -z "$src"; then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if test -z "$src"; then echo "$0: no input file specified." >&2 exit 1 fi # Protect names starting with `-'. case $src in -*) src=./$src ;; esac if test -n "$dir_arg"; then dst=$src src= if test -d "$dst"; then instcmd=: chmodcmd= else instcmd=$mkdirprog fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if test ! -f "$src" && test ! -d "$src"; then echo "$0: $src does not exist." >&2 exit 1 fi if test -z "$dst"; then echo "$0: no destination specified." >&2 exit 1 fi # Protect names starting with `-'. case $dst in -*) dst=./$dst ;; esac # If destination is a directory, append the input filename; won't work # if double slashes aren't ignored. if test -d "$dst"; then dst=$dst/`basename "$src"` fi fi # This sed command emulates the dirname command. dstdir=`echo "$dst" | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # Skip lots of stat calls in the usual case. if test ! -d "$dstdir"; then defaultIFS=' ' IFS="${IFS-$defaultIFS}" oIFS=$IFS # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo "$dstdir" | sed -e 's@/@%@g' -e 's@^%@/@'` IFS=$oIFS pathcomp= while test $# -ne 0 ; do pathcomp=$pathcomp$1 shift test -d "$pathcomp" || $mkdirprog "$pathcomp" pathcomp=$pathcomp/ done fi if test -n "$dir_arg"; then $doit $instcmd "$dst" \ && { test -z "$chowncmd" || $doit $chowncmd "$dst"; } \ && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } \ && { test -z "$stripcmd" || $doit $stripcmd "$dst"; } \ && { test -z "$chmodcmd" || $doit $chmodcmd "$dst"; } else # If we're going to rename the final executable, determine the name now. if test -z "$transformarg"; then dstfile=`basename "$dst"` else dstfile=`basename "$dst" $transformbasename \ | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename. test -z "$dstfile" && dstfile=`basename "$dst"` # Make a couple of temp file names in the proper directory. dsttmp=$dstdir/_inst.$$_ rmtmp=$dstdir/_rm.$$_ # Trap to clean up those temp files at exit. trap 'status=$?; rm -f "$dsttmp" "$rmtmp" && exit $status' 0 trap '(exit $?); exit' 1 2 13 15 # Move or copy the file name to the temp name $doit $instcmd "$src" "$dsttmp" && # and set any options; do chmod last to preserve setuid bits. # # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. # { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } \ && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } \ && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } \ && { test -z "$chmodcmd" || $doit $chmodcmd "$dsttmp"; } && # Now remove or move aside any old file at destination location. We # try this two ways since rm can't unlink itself on some systems and # the destination file might be busy for other reasons. In this case, # the final cleanup might fail but the new file should still install # successfully. { if test -f "$dstdir/$dstfile"; then $doit $rmcmd -f "$dstdir/$dstfile" 2>/dev/null \ || $doit $mvcmd -f "$dstdir/$dstfile" "$rmtmp" 2>/dev/null \ || { echo "$0: cannot unlink or rename $dstdir/$dstfile" >&2 (exit 1); exit } else : fi } && # Now rename the file to the real destination. $doit $mvcmd "$dsttmp" "$dstdir/$dstfile" fi && # The final little trick to "correctly" pass the exit status to the exit trap. { (exit 0); exit } # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-end: "$" # End: hugs98-plus-Sep2006/packages/network/configure0000755006511100651110000047154610504340701020154 0ustar rossross#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.60a for Haskell network package 1.0. # # Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /usr/bin/posix$PATH_SEPARATOR/bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell autoconf@gnu.org about your system, echo including any error possibly output before this echo message } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='Haskell network package' PACKAGE_TARNAME='network' PACKAGE_VERSION='1.0' PACKAGE_STRING='Haskell network package 1.0' PACKAGE_BUGREPORT='libraries@haskell.org' ac_unique_file="include/HsNet.h" # Factoring default headers for most tests. ac_includes_default="\ #include #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_STAT_H # include #endif #ifdef STDC_HEADERS # include # include #else # ifdef HAVE_STDLIB_H # include # endif #endif #ifdef HAVE_STRING_H # if !defined STDC_HEADERS && defined HAVE_MEMORY_H # include # endif # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datarootdir datadir sysconfdir sharedstatedir localstatedir includedir oldincludedir docdir infodir htmldir dvidir pdfdir psdir libdir localedir mandir DEFS ECHO_C ECHO_N ECHO_T LIBS build_alias host_alias target_alias build build_cpu build_vendor build_os host host_cpu host_vendor host_os CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP GREP EGREP CALLCONV EXTRA_LIBS EXTRA_SRCS LIBOBJS LTLIBOBJS' ac_subst_files='' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS CPPFLAGS CPP' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` eval with_$ac_package=\$ac_optarg ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval with_$ac_package=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute directory names. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { echo "$as_me: error: Working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$0" || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # 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 Haskell network package 1.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/network] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF System types: --build=BUILD configure for building on BUILD [guessed] --host=HOST cross-compile to build programs to run on HOST [BUILD] _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of Haskell network package 1.0:";; esac cat <<\_ACEOF Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF Haskell network package configure 1.0 generated by GNU Autoconf 2.60a Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by Haskell network package $as_me 1.0, which was generated by GNU Autoconf 2.60a. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then set x "$CONFIG_SITE" elif test "x$prefix" != xNONE; then set x "$prefix/share/config.site" "$prefix/etc/config.site" else set x "$ac_default_prefix/share/config.site" \ "$ac_default_prefix/etc/config.site" fi shift for ac_site_file do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Safety check: Ensure that we are in the correct source directory. ac_config_headers="$ac_config_headers include/HsNetworkConfig.h" ac_aux_dir= for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do if test -f "$ac_dir/install-sh"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install-sh -c" break elif test -f "$ac_dir/install.sh"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install.sh -c" break elif test -f "$ac_dir/shtool"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/shtool install -c" break fi done if test -z "$ac_aux_dir"; then { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" >&5 echo "$as_me: error: cannot find install-sh or install.sh in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" >&2;} { (exit 1); exit 1; }; } fi # These three variables are undocumented and unsupported, # and are intended to be withdrawn in a future Autoconf release. # They can cause serious problems if a builder's source tree is in a directory # whose full name contains unusual characters. ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. # Make sure we can run config.sub. $SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || { { echo "$as_me:$LINENO: error: cannot run $SHELL $ac_aux_dir/config.sub" >&5 echo "$as_me: error: cannot run $SHELL $ac_aux_dir/config.sub" >&2;} { (exit 1); exit 1; }; } { echo "$as_me:$LINENO: checking build system type" >&5 echo $ECHO_N "checking build system type... $ECHO_C" >&6; } if test "${ac_cv_build+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_build_alias=$build_alias test "x$ac_build_alias" = x && ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` test "x$ac_build_alias" = x && { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5 echo "$as_me: error: cannot guess build type; you must specify one" >&2;} { (exit 1); exit 1; }; } ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&5 echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&2;} { (exit 1); exit 1; }; } fi { echo "$as_me:$LINENO: result: $ac_cv_build" >&5 echo "${ECHO_T}$ac_cv_build" >&6; } case $ac_cv_build in *-*-*) ;; *) { { echo "$as_me:$LINENO: error: invalid value of canonical build" >&5 echo "$as_me: error: invalid value of canonical build" >&2;} { (exit 1); exit 1; }; };; esac build=$ac_cv_build ac_save_IFS=$IFS; IFS='-' set x $ac_cv_build shift build_cpu=$1 build_vendor=$2 shift; shift # Remember, the first character of IFS is used to create $*, # except with old shells: build_os=$* IFS=$ac_save_IFS case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac { echo "$as_me:$LINENO: checking host system type" >&5 echo $ECHO_N "checking host system type... $ECHO_C" >&6; } if test "${ac_cv_host+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "x$host_alias" = x; then ac_cv_host=$ac_cv_build else ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&5 echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&2;} { (exit 1); exit 1; }; } fi fi { echo "$as_me:$LINENO: result: $ac_cv_host" >&5 echo "${ECHO_T}$ac_cv_host" >&6; } case $ac_cv_host in *-*-*) ;; *) { { echo "$as_me:$LINENO: error: invalid value of canonical host" >&5 echo "$as_me: error: invalid value of canonical host" >&2;} { (exit 1); exit 1; }; };; esac host=$ac_cv_host ac_save_IFS=$IFS; IFS='-' set x $ac_cv_host shift host_cpu=$1 host_vendor=$2 shift; shift # Remember, the first character of IFS is used to create $*, # except with old shells: host_os=$* IFS=$ac_save_IFS case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO: checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; } ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # # List of possible output files, starting from the most likely. # The algorithm is not robust to junk in `.', hence go to wildcards (a.*) # only as a last resort. b.out is created by i960 compilers. ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' # # The IRIX 6 linker writes into existing files which may not be # executable, retaining their permissions. Remove them first so a # subsequent execution test works. ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { (ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi { echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6; } if test -z "$ac_file"; then echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } { echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6; } { echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext { echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT { echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; } if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; } GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CFLAGS="" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_c89+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_c89=$ac_arg else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6; } ;; xno) { echo "$as_me:$LINENO: result: unsupported" >&5 echo "${ECHO_T}unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for an ANSI C-conforming const" >&5 echo $ECHO_N "checking for an ANSI C-conforming const... $ECHO_C" >&6; } if test "${ac_cv_c_const+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { /* FIXME: Include the comments suggested by Paul. */ #ifndef __cplusplus /* Ultrix mips cc rejects this. */ typedef int charset[2]; const charset cs; /* SunOS 4.1.1 cc rejects this. */ char const *const *pcpcc; char **ppc; /* NEC SVR4.0.2 mips cc rejects this. */ struct point {int x, y;}; static struct point const zero = {0,0}; /* AIX XL C 1.02.0.0 rejects this. It does not let you subtract one const X* pointer from another in an arm of an if-expression whose if-part is not a constant expression */ const char *g = "string"; pcpcc = &g + (g ? g-g : 0); /* HPUX 7.0 cc rejects these. */ ++pcpcc; ppc = (char**) pcpcc; pcpcc = (char const *const *) ppc; { /* SCO 3.2v4 cc rejects this. */ char *t; char const *s = 0 ? (char *) 0 : (char const *) 0; *t++ = 0; if (s) return 0; } { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */ int x[] = {25, 17}; const int *foo = &x[0]; ++foo; } { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */ typedef const int *iptr; iptr p = 0; ++p; } { /* AIX XL C 1.02.0.0 rejects this saying "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ struct s { int j; const int *ap[3]; }; struct s *b; b->j = 5; } { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ const int foo = 10; if (!foo) return 0; } return !cs[0] && !zero.x; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_const=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_const=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_c_const" >&5 echo "${ECHO_T}$ac_cv_c_const" >&6; } if test $ac_cv_c_const = no; then cat >>confdefs.h <<\_ACEOF #define const _ACEOF fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Extract the first word of "grep ggrep" to use in msg output if test -z "$GREP"; then set dummy grep ggrep; ac_prog_name=$2 if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_GREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_GREP" && $as_executable_p "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_GREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_GREP_found && break 3 done done done IFS=$as_save_IFS fi GREP="$ac_cv_path_GREP" if test -z "$GREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_GREP=$GREP fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 echo "${ECHO_T}$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" { echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6; } if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else # Extract the first word of "egrep" to use in msg output if test -z "$EGREP"; then set dummy egrep; ac_prog_name=$2 if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_EGREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_EGREP" && $as_executable_p "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_EGREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_found && break 3 done done done IFS=$as_save_IFS fi EGREP="$ac_cv_path_EGREP" if test -z "$EGREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_EGREP=$EGREP fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 echo "${ECHO_T}$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" { echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) return 2; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in fcntl.h limits.h stdlib.h sys/types.h unistd.h winsock.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in arpa/inet.h netdb.h netinet/in.h netinet/tcp.h sys/socket.h sys/uio.h sys/un.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in readlink symlink do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking for struct msghdr.msg_control" >&5 echo $ECHO_N "checking for struct msghdr.msg_control... $ECHO_C" >&6; } if test "${ac_cv_member_struct_msghdr_msg_control+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_SOCKET_H # include #endif #if HAVE_SYS_UIO_H # include #endif int main () { static struct msghdr ac_aggr; if (ac_aggr.msg_control) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_msghdr_msg_control=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_SOCKET_H # include #endif #if HAVE_SYS_UIO_H # include #endif int main () { static struct msghdr ac_aggr; if (sizeof ac_aggr.msg_control) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_msghdr_msg_control=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_member_struct_msghdr_msg_control=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_member_struct_msghdr_msg_control" >&5 echo "${ECHO_T}$ac_cv_member_struct_msghdr_msg_control" >&6; } if test $ac_cv_member_struct_msghdr_msg_control = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_MSGHDR_MSG_CONTROL 1 _ACEOF fi { echo "$as_me:$LINENO: checking for struct msghdr.msg_accrights" >&5 echo $ECHO_N "checking for struct msghdr.msg_accrights... $ECHO_C" >&6; } if test "${ac_cv_member_struct_msghdr_msg_accrights+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_SOCKET_H # include #endif #if HAVE_SYS_UIO_H # include #endif int main () { static struct msghdr ac_aggr; if (ac_aggr.msg_accrights) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_msghdr_msg_accrights=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_SOCKET_H # include #endif #if HAVE_SYS_UIO_H # include #endif int main () { static struct msghdr ac_aggr; if (sizeof ac_aggr.msg_accrights) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_msghdr_msg_accrights=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_member_struct_msghdr_msg_accrights=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_member_struct_msghdr_msg_accrights" >&5 echo "${ECHO_T}$ac_cv_member_struct_msghdr_msg_accrights" >&6; } if test $ac_cv_member_struct_msghdr_msg_accrights = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS 1 _ACEOF fi { echo "$as_me:$LINENO: checking for in_addr_t in netinet/in.h" >&5 echo $ECHO_N "checking for in_addr_t in netinet/in.h... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "in_addr_t" >/dev/null 2>&1; then cat >>confdefs.h <<\_ACEOF #define HAVE_IN_ADDR_T 1 _ACEOF { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* { echo "$as_me:$LINENO: checking for sendfile in sys/sendfile.h" >&5 echo $ECHO_N "checking for sendfile in sys/sendfile.h... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "sendfile" >/dev/null 2>&1; then cat >>confdefs.h <<\_ACEOF #define HAVE_LINUX_SENDFILE 1 _ACEOF { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* { echo "$as_me:$LINENO: checking for sendfile in sys/socket.h" >&5 echo $ECHO_N "checking for sendfile in sys/socket.h... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "sendfile" >/dev/null 2>&1; then cat >>confdefs.h <<\_ACEOF #define HAVE_BSD_SENDFILE 1 _ACEOF { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* for ac_func in gethostent do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done case "$host" in *-mingw32) EXTRA_SRCS="cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c" EXTRA_LIBS=wsock32 CALLCONV=stdcall ;; *-solaris2) EXTRA_SRCS="cbits/ancilData.c" EXTRA_LIBS="nsl, socket" CALLCONV=ccall ;; *) EXTRA_SRCS="cbits/ancilData.c" EXTRA_LIBS= CALLCONV=ccall ;; esac ac_config_files="$ac_config_files network.buildinfo" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { echo "$as_me:$LINENO: updating cache $cache_file" >&5 echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by Haskell network package $as_me 1.0, which was generated by GNU Autoconf 2.60a. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for. config_files="$ac_config_files" config_headers="$ac_config_headers" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ Haskell network package config.status 1.0 configured by $0, generated by GNU Autoconf 2.60a, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2006 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header { echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 CONFIG_SHELL=$SHELL export CONFIG_SHELL exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "include/HsNetworkConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsNetworkConfig.h" ;; "network.buildinfo") CONFIG_FILES="$CONFIG_FILES network.buildinfo" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } # # Set up the sed scripts for CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "$CONFIG_FILES"; then _ACEOF ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF SHELL!$SHELL$ac_delim PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim PACKAGE_NAME!$PACKAGE_NAME$ac_delim PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim PACKAGE_STRING!$PACKAGE_STRING$ac_delim PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim exec_prefix!$exec_prefix$ac_delim prefix!$prefix$ac_delim program_transform_name!$program_transform_name$ac_delim bindir!$bindir$ac_delim sbindir!$sbindir$ac_delim libexecdir!$libexecdir$ac_delim datarootdir!$datarootdir$ac_delim datadir!$datadir$ac_delim sysconfdir!$sysconfdir$ac_delim sharedstatedir!$sharedstatedir$ac_delim localstatedir!$localstatedir$ac_delim includedir!$includedir$ac_delim oldincludedir!$oldincludedir$ac_delim docdir!$docdir$ac_delim infodir!$infodir$ac_delim htmldir!$htmldir$ac_delim dvidir!$dvidir$ac_delim pdfdir!$pdfdir$ac_delim psdir!$psdir$ac_delim libdir!$libdir$ac_delim localedir!$localedir$ac_delim mandir!$mandir$ac_delim DEFS!$DEFS$ac_delim ECHO_C!$ECHO_C$ac_delim ECHO_N!$ECHO_N$ac_delim ECHO_T!$ECHO_T$ac_delim LIBS!$LIBS$ac_delim build_alias!$build_alias$ac_delim host_alias!$host_alias$ac_delim target_alias!$target_alias$ac_delim build!$build$ac_delim build_cpu!$build_cpu$ac_delim build_vendor!$build_vendor$ac_delim build_os!$build_os$ac_delim host!$host$ac_delim host_cpu!$host_cpu$ac_delim host_vendor!$host_vendor$ac_delim host_os!$host_os$ac_delim CC!$CC$ac_delim CFLAGS!$CFLAGS$ac_delim LDFLAGS!$LDFLAGS$ac_delim CPPFLAGS!$CPPFLAGS$ac_delim ac_ct_CC!$ac_ct_CC$ac_delim EXEEXT!$EXEEXT$ac_delim OBJEXT!$OBJEXT$ac_delim CPP!$CPP$ac_delim GREP!$GREP$ac_delim EGREP!$EGREP$ac_delim CALLCONV!$CALLCONV$ac_delim EXTRA_LIBS!$EXTRA_LIBS$ac_delim EXTRA_SRCS!$EXTRA_SRCS$ac_delim LIBOBJS!$LIBOBJS$ac_delim LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 60; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` if test -n "$ac_eof"; then ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` ac_eof=`expr $ac_eof + 1` fi cat >>$CONFIG_STATUS <<_ACEOF cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof /@[a-zA-Z_][a-zA-Z_0-9]*@/!b end _ACEOF sed ' s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g s/^/s,@/; s/!/@,|#_!!_#|/ :n t n s/'"$ac_delim"'$/,g/; t s/$/\\/; p N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n ' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF :end s/|#_!!_#|//g CEOF$ac_eof _ACEOF # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/ s/:*\${srcdir}:*/:/ s/:*@srcdir@:*/:/ s/^\([^=]*=[ ]*\):*/\1/ s/:*$// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF fi # test -n "$CONFIG_FILES" for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 echo "$as_me: error: Invalid tag $ac_tag." >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac ac_file_inputs="$ac_file_inputs $ac_f" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input="Generated from "`IFS=: echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} fi case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin";; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= case `sed -n '/datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p ' $ac_file_inputs` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s&@configure_input@&$configure_input&;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out"; rm -f "$tmp/out";; *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; esac ;; :H) # # CONFIG_HEADER # _ACEOF # Transform confdefs.h into a sed script `conftest.defines', that # substitutes the proper values into config.h.in to produce config.h. rm -f conftest.defines conftest.tail # First, append a space to every undef/define line, to ease matching. echo 's/$/ /' >conftest.defines # Then, protect against being on the right side of a sed subst, or in # an unquoted here document, in config.status. If some macros were # called several times there might be several #defines for the same # symbol, which is useless. But do not sort them, since the last # AC_DEFINE must be honored. ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* # These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where # NAME is the cpp macro being defined, VALUE is the value it is being given. # PARAMS is the parameter list in the macro definition--in most cases, it's # just an empty string. ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' ac_dB='\\)[ (].*,\\1define\\2' ac_dC=' ' ac_dD=' ,' uniq confdefs.h | sed -n ' t rset :rset s/^[ ]*#[ ]*define[ ][ ]*// t ok d :ok s/[\\&,]/\\&/g s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p ' >>conftest.defines # Remove the space that was appended to ease matching. # Then replace #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. # (The regexp can be short, since the line contains either #define or #undef.) echo 's/ $// s,^[ #]*u.*,/* & */,' >>conftest.defines # Break up conftest.defines: ac_max_sed_lines=50 # First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" # Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" # Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" # et cetera. ac_in='$ac_file_inputs' ac_out='"$tmp/out1"' ac_nxt='"$tmp/out2"' while : do # Write a here document: cat >>$CONFIG_STATUS <<_ACEOF # First, check the format of the line: cat >"\$tmp/defines.sed" <<\\CEOF /^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def /^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def b :def _ACEOF sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail grep . conftest.tail >/dev/null || break rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines conftest.tail echo "ac_result=$ac_in" >>$CONFIG_STATUS cat >>$CONFIG_STATUS <<\_ACEOF if test x"$ac_file" != x-; then echo "/* $configure_input */" >"$tmp/config.h" cat "$ac_result" >>"$tmp/config.h" if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else rm -f $ac_file mv "$tmp/config.h" $ac_file fi else echo "/* $configure_input */" cat "$ac_result" fi rm -f "$tmp/out12" ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi hugs98-plus-Sep2006/packages/parsec/0000755006511100651110000000000010504340573016017 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/Makefile.inc0000644006511100651110000000022310504340255020221 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/parsec/LICENSE0000644006511100651110000000235710504340255017030 0ustar rossrossCopyright 1999-2000, Daan Leijen. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. This software is provided by the copyright holders "as is" and any express or implied warranties, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose are disclaimed. In no event shall the copyright holders be liable for any direct, indirect, incidental, special, exemplary, or consequential damages (including, but not limited to, procurement of substitute goods or services; loss of use, data, or profits; or business interruption) however caused and on any theory of liability, whether in contract, strict liability, or tort (including negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage. hugs98-plus-Sep2006/packages/parsec/Makefile0000644006511100651110000000114510504340255017455 0ustar rossross# ----------------------------------------------------------------------------- TOP=.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- ifeq "$(IncludeExampleDirsInBuild)" "YES" SUBDIRS += examples endif ALL_DIRS = \ Text/ParserCombinators \ Text/ParserCombinators/Parsec PACKAGE = parsec VERSION = 2.0 PACKAGE_DEPS = base SRC_HC_OPTS += -fglasgow-exts SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/parsec/Text/0000755006511100651110000000000010504340255016740 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/0000755006511100651110000000000010504340255022375 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/0000755006511100651110000000000010504340255023612 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/Language.hs0000644006511100651110000001111510504340255025670 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Language -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : non-portable (uses non-portable module Text.ParserCombinators.Parsec.Token) -- -- A helper module that defines some language definitions that can be used -- to instantiate a token parser (see "Text.ParserCombinators.Parsec.Token"). -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Language ( haskellDef, haskell , mondrianDef, mondrian , emptyDef , haskellStyle , javaStyle , LanguageDef (..) ) where import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Token ----------------------------------------------------------- -- Styles: haskellStyle, javaStyle ----------------------------------------------------------- haskellStyle :: LanguageDef st haskellStyle= emptyDef { commentStart = "{-" , commentEnd = "-}" , commentLine = "--" , nestedComments = True , identStart = letter , identLetter = alphaNum <|> oneOf "_'" , opStart = opLetter haskellStyle , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~" , reservedOpNames= [] , reservedNames = [] , caseSensitive = True } javaStyle :: LanguageDef st javaStyle = emptyDef { commentStart = "/*" , commentEnd = "*/" , commentLine = "//" , nestedComments = True , identStart = letter , identLetter = alphaNum <|> oneOf "_'" , reservedNames = [] , reservedOpNames= [] , caseSensitive = False } ----------------------------------------------------------- -- minimal language definition ----------------------------------------------------------- emptyDef :: LanguageDef st emptyDef = LanguageDef { commentStart = "" , commentEnd = "" , commentLine = "" , nestedComments = True , identStart = letter <|> char '_' , identLetter = alphaNum <|> oneOf "_'" , opStart = opLetter emptyDef , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~" , reservedOpNames= [] , reservedNames = [] , caseSensitive = True } ----------------------------------------------------------- -- Haskell ----------------------------------------------------------- haskell :: TokenParser st haskell = makeTokenParser haskellDef haskellDef :: LanguageDef st haskellDef = haskell98Def { identLetter = identLetter haskell98Def <|> char '#' , reservedNames = reservedNames haskell98Def ++ ["foreign","import","export","primitive" ,"_ccall_","_casm_" ,"forall" ] } haskell98Def :: LanguageDef st haskell98Def = haskellStyle { reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"] , reservedNames = ["let","in","case","of","if","then","else", "data","type", "class","default","deriving","do","import", "infix","infixl","infixr","instance","module", "newtype","where", "primitive" -- "as","qualified","hiding" ] } ----------------------------------------------------------- -- Mondrian ----------------------------------------------------------- mondrian :: TokenParser st mondrian = makeTokenParser mondrianDef mondrianDef :: LanguageDef st mondrianDef = javaStyle { reservedNames = [ "case", "class", "default", "extends" , "import", "in", "let", "new", "of", "package" ] , caseSensitive = True } hugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/Char.hs0000644006511100651110000000560210504340255025026 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Char -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : portable -- -- Commonly used character parsers. -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Char ( CharParser , spaces, space , newline, tab , upper, lower, alphaNum, letter , digit, hexDigit, octDigit , char, string , anyChar, oneOf, noneOf , satisfy ) where import Prelude import Data.Char import Text.ParserCombinators.Parsec.Pos( updatePosChar, updatePosString ) import Text.ParserCombinators.Parsec.Prim ----------------------------------------------------------- -- Type of character parsers ----------------------------------------------------------- type CharParser st a = GenParser Char st a ----------------------------------------------------------- -- Character parsers ----------------------------------------------------------- oneOf, noneOf :: [Char] -> CharParser st Char oneOf cs = satisfy (\c -> elem c cs) noneOf cs = satisfy (\c -> not (elem c cs)) spaces :: CharParser st () spaces = skipMany space "white space" space, newline, tab :: CharParser st Char space = satisfy (isSpace) "space" newline = char '\n' "new-line" tab = char '\t' "tab" upper, lower, alphaNum, letter, digit, hexDigit, octDigit :: CharParser st Char upper = satisfy (isUpper) "uppercase letter" lower = satisfy (isLower) "lowercase letter" alphaNum = satisfy (isAlphaNum) "letter or digit" letter = satisfy (isAlpha) "letter" digit = satisfy (isDigit) "digit" hexDigit = satisfy (isHexDigit) "hexadecimal digit" octDigit = satisfy (isOctDigit) "octal digit" char :: Char -> CharParser st Char char c = satisfy (==c) show [c] anyChar :: CharParser st Char anyChar = satisfy (const True) ----------------------------------------------------------- -- Primitive character parsers ----------------------------------------------------------- satisfy :: (Char -> Bool) -> CharParser st Char satisfy f = tokenPrim (\c -> show [c]) (\pos c cs -> updatePosChar pos c) (\c -> if f c then Just c else Nothing) string :: String -> CharParser st String string s = tokens show updatePosString s hugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/Error.hs0000644006511100651110000001412410504340255025241 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Error -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : portable -- -- Parse errors -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Error ( Message(SysUnExpect,UnExpect,Expect,Message) , messageString, messageCompare, messageEq , ParseError, errorPos, errorMessages, errorIsUnknown , showErrorMessages , newErrorMessage, newErrorUnknown , addErrorMessage, setErrorPos, setErrorMessage , mergeError ) where import Prelude import Data.List (nub,sortBy) import Text.ParserCombinators.Parsec.Pos ----------------------------------------------------------- -- Messages ----------------------------------------------------------- data Message = SysUnExpect !String --library generated unexpect | UnExpect !String --unexpected something | Expect !String --expecting something | Message !String --raw message messageToEnum msg = case msg of SysUnExpect _ -> 0 UnExpect _ -> 1 Expect _ -> 2 Message _ -> 3 messageCompare :: Message -> Message -> Ordering messageCompare msg1 msg2 = compare (messageToEnum msg1) (messageToEnum msg2) messageString :: Message -> String messageString msg = case msg of SysUnExpect s -> s UnExpect s -> s Expect s -> s Message s -> s messageEq :: Message -> Message -> Bool messageEq msg1 msg2 = (messageCompare msg1 msg2 == EQ) ----------------------------------------------------------- -- Parse Errors ----------------------------------------------------------- data ParseError = ParseError !SourcePos [Message] errorPos :: ParseError -> SourcePos errorPos (ParseError pos msgs) = pos errorMessages :: ParseError -> [Message] errorMessages (ParseError pos msgs) = sortBy messageCompare msgs errorIsUnknown :: ParseError -> Bool errorIsUnknown (ParseError pos msgs) = null msgs ----------------------------------------------------------- -- Create parse errors ----------------------------------------------------------- newErrorUnknown :: SourcePos -> ParseError newErrorUnknown pos = ParseError pos [] newErrorMessage :: Message -> SourcePos -> ParseError newErrorMessage msg pos = ParseError pos [msg] addErrorMessage :: Message -> ParseError -> ParseError addErrorMessage msg (ParseError pos msgs) = ParseError pos (msg:msgs) setErrorPos :: SourcePos -> ParseError -> ParseError setErrorPos pos (ParseError _ msgs) = ParseError pos msgs setErrorMessage :: Message -> ParseError -> ParseError setErrorMessage msg (ParseError pos msgs) = ParseError pos (msg:filter (not . messageEq msg) msgs) mergeError :: ParseError -> ParseError -> ParseError mergeError (ParseError pos msgs1) (ParseError _ msgs2) = ParseError pos (msgs1 ++ msgs2) ----------------------------------------------------------- -- Show Parse Errors ----------------------------------------------------------- instance Show ParseError where show err = show (errorPos err) ++ ":" ++ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages err) -- | Language independent show function showErrorMessages :: String -> String -> String -> String -> String -> [Message] -> String showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs | null msgs = msgUnknown | otherwise = concat $ map ("\n"++) $ clean $ [showSysUnExpect,showUnExpect,showExpect,showMessages] where (sysUnExpect,msgs1) = span (messageEq (SysUnExpect "")) msgs (unExpect,msgs2) = span (messageEq (UnExpect "")) msgs1 (expect,messages) = span (messageEq (Expect "")) msgs2 showExpect = showMany msgExpecting expect showUnExpect = showMany msgUnExpected unExpect showSysUnExpect | not (null unExpect) || null sysUnExpect = "" | null firstMsg = msgUnExpected ++ " " ++ msgEndOfInput | otherwise = msgUnExpected ++ " " ++ firstMsg where firstMsg = messageString (head sysUnExpect) showMessages = showMany "" messages --helpers showMany pre msgs = case (clean (map messageString msgs)) of [] -> "" ms | null pre -> commasOr ms | otherwise -> pre ++ " " ++ commasOr ms commasOr [] = "" commasOr [m] = m commasOr ms = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms commaSep = seperate ", " . clean semiSep = seperate "; " . clean seperate sep [] = "" seperate sep [m] = m seperate sep (m:ms) = m ++ sep ++ seperate sep ms clean = nub . filter (not.null) hugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/Combinator.hs0000644006511100651110000001273110504340255026247 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Combinator -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : portable -- -- Commonly used generic combinators -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Combinator ( choice , count , between , option, optional , skipMany1 , many1 , sepBy, sepBy1 , endBy, endBy1 , sepEndBy, sepEndBy1 , chainl, chainl1 , chainr, chainr1 , eof, notFollowedBy -- tricky combinators , manyTill, lookAhead, anyToken ) where import Control.Monad import Text.ParserCombinators.Parsec.Prim ---------------------------------------------------------------- -- ---------------------------------------------------------------- choice :: [GenParser tok st a] -> GenParser tok st a choice ps = foldr (<|>) mzero ps option :: a -> GenParser tok st a -> GenParser tok st a option x p = p <|> return x optional :: GenParser tok st a -> GenParser tok st () optional p = do{ p; return ()} <|> return () between :: GenParser tok st open -> GenParser tok st close -> GenParser tok st a -> GenParser tok st a between open close p = do{ open; x <- p; close; return x } skipMany1 :: GenParser tok st a -> GenParser tok st () skipMany1 p = do{ p; skipMany p } {- skipMany p = scan where scan = do{ p; scan } <|> return () -} many1 :: GenParser tok st a -> GenParser tok st [a] many1 p = do{ x <- p; xs <- many p; return (x:xs) } {- many p = scan id where scan f = do{ x <- p ; scan (\tail -> f (x:tail)) } <|> return (f []) -} sepBy1,sepBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a] sepBy p sep = sepBy1 p sep <|> return [] sepBy1 p sep = do{ x <- p ; xs <- many (sep >> p) ; return (x:xs) } sepEndBy1, sepEndBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a] sepEndBy1 p sep = do{ x <- p ; do{ sep ; xs <- sepEndBy p sep ; return (x:xs) } <|> return [x] } sepEndBy p sep = sepEndBy1 p sep <|> return [] endBy1,endBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a] endBy1 p sep = many1 (do{ x <- p; sep; return x }) endBy p sep = many (do{ x <- p; sep; return x }) count :: Int -> GenParser tok st a -> GenParser tok st [a] count n p | n <= 0 = return [] | otherwise = sequence (replicate n p) chainr,chainl :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> a -> GenParser tok st a chainr p op x = chainr1 p op <|> return x chainl p op x = chainl1 p op <|> return x chainr1,chainl1 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> GenParser tok st a chainl1 p op = do{ x <- p; rest x } where rest x = do{ f <- op ; y <- p ; rest (f x y) } <|> return x chainr1 p op = scan where scan = do{ x <- p; rest x } rest x = do{ f <- op ; y <- scan ; return (f x y) } <|> return x ----------------------------------------------------------- -- Tricky combinators ----------------------------------------------------------- anyToken :: Show tok => GenParser tok st tok anyToken = tokenPrim show (\pos tok toks -> pos) Just eof :: Show tok => GenParser tok st () eof = notFollowedBy anyToken "end of input" notFollowedBy :: Show tok => GenParser tok st tok -> GenParser tok st () notFollowedBy p = try (do{ c <- p; unexpected (show [c]) } <|> return () ) manyTill :: GenParser tok st a -> GenParser tok st end -> GenParser tok st [a] manyTill p end = scan where scan = do{ end; return [] } <|> do{ x <- p; xs <- scan; return (x:xs) } lookAhead :: GenParser tok st a -> GenParser tok st a lookAhead p = do{ state <- getParserState ; x <- p ; setParserState state ; return x } hugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/Expr.hs0000644006511100651110000001172210504340255025067 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Expr -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : portable -- -- A helper module to parse \"expressions\". -- Builds a parser given a table of operators and associativities. -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Expr ( Assoc(..), Operator(..), OperatorTable , buildExpressionParser ) where import Text.ParserCombinators.Parsec.Prim import Text.ParserCombinators.Parsec.Combinator ----------------------------------------------------------- -- Assoc and OperatorTable ----------------------------------------------------------- data Assoc = AssocNone | AssocLeft | AssocRight data Operator t st a = Infix (GenParser t st (a -> a -> a)) Assoc | Prefix (GenParser t st (a -> a)) | Postfix (GenParser t st (a -> a)) type OperatorTable t st a = [[Operator t st a]] ----------------------------------------------------------- -- Convert an OperatorTable and basic term parser into -- a full fledged expression parser ----------------------------------------------------------- buildExpressionParser :: OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a buildExpressionParser operators simpleExpr = foldl (makeParser) simpleExpr operators where makeParser term ops = let (rassoc,lassoc,nassoc ,prefix,postfix) = foldr splitOp ([],[],[],[],[]) ops rassocOp = choice rassoc lassocOp = choice lassoc nassocOp = choice nassoc prefixOp = choice prefix "" postfixOp = choice postfix "" ambigious assoc op= try $ do{ op; fail ("ambiguous use of a " ++ assoc ++ " associative operator") } ambigiousRight = ambigious "right" rassocOp ambigiousLeft = ambigious "left" lassocOp ambigiousNon = ambigious "non" nassocOp termP = do{ pre <- prefixP ; x <- term ; post <- postfixP ; return (post (pre x)) } postfixP = postfixOp <|> return id prefixP = prefixOp <|> return id rassocP x = do{ f <- rassocOp ; y <- do{ z <- termP; rassocP1 z } ; return (f x y) } <|> ambigiousLeft <|> ambigiousNon -- <|> return x rassocP1 x = rassocP x <|> return x lassocP x = do{ f <- lassocOp ; y <- termP ; lassocP1 (f x y) } <|> ambigiousRight <|> ambigiousNon -- <|> return x lassocP1 x = lassocP x <|> return x nassocP x = do{ f <- nassocOp ; y <- termP ; ambigiousRight <|> ambigiousLeft <|> ambigiousNon <|> return (f x y) } -- <|> return x in do{ x <- termP ; rassocP x <|> lassocP x <|> nassocP x <|> return x "operator" } splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix) = case assoc of AssocNone -> (rassoc,lassoc,op:nassoc,prefix,postfix) AssocLeft -> (rassoc,op:lassoc,nassoc,prefix,postfix) AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix) splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix) = (rassoc,lassoc,nassoc,op:prefix,postfix) splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix) = (rassoc,lassoc,nassoc,prefix,op:postfix) hugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/Perm.hs0000644006511100651110000000742610504340255025062 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Perm -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : non-portable (uses existentially quantified data constructors) -- -- This module implements permutation parsers. The algorithm used -- is fairly complex since we push the type system to its limits :-) -- The algorithm is described in: -- -- /Parsing Permutation Phrases,/ -- by Arthur Baars, Andres Loh and Doaitse Swierstra. -- Published as a functional pearl at the Haskell Workshop 2001. -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Perm ( PermParser -- abstract , permute , (<||>), (<$$>) , (<|?>), (<$?>) ) where import Text.ParserCombinators.Parsec {--------------------------------------------------------------- ---------------------------------------------------------------} infixl 1 <||>, <|?> infixl 2 <$$>, <$?> {--------------------------------------------------------------- test -- parse a permutation of * an optional string of 'a's * a required 'b' * an optional 'c' ---------------------------------------------------------------} test input = parse (do{ x <- ptest; eof; return x }) "" input ptest :: Parser (String,Char,Char) ptest = permute $ (,,) <$?> ("",many1 (char 'a')) <||> char 'b' <|?> ('_',char 'c') {--------------------------------------------------------------- Building a permutation parser ---------------------------------------------------------------} (<||>) :: PermParser tok st (a -> b) -> GenParser tok st a -> PermParser tok st b (<||>) perm p = add perm p (<$$>) :: (a -> b) -> GenParser tok st a -> PermParser tok st b (<$$>) f p = newperm f <||> p (<|?>) :: PermParser tok st (a -> b) -> (a, GenParser tok st a) -> PermParser tok st b (<|?>) perm (x,p) = addopt perm x p (<$?>) :: (a -> b) -> (a, GenParser tok st a) -> PermParser tok st b (<$?>) f (x,p) = newperm f <|?> (x,p) {--------------------------------------------------------------- The permutation tree ---------------------------------------------------------------} data PermParser tok st a = Perm (Maybe a) [Branch tok st a] data Branch tok st a = forall b. Branch (PermParser tok st (b -> a)) (GenParser tok st b) -- transform a permutation tree into a normal parser permute :: PermParser tok st a -> GenParser tok st a permute (Perm def xs) = choice (map branch xs ++ empty) where empty = case def of Nothing -> [] Just x -> [return x] branch (Branch perm p) = do{ x <- p ; f <- permute perm ; return (f x) } -- build permutation trees newperm :: (a -> b) -> PermParser tok st (a -> b) newperm f = Perm (Just f) [] add :: PermParser tok st (a -> b) -> GenParser tok st a -> PermParser tok st b add perm@(Perm mf fs) p = Perm Nothing (first:map insert fs) where first = Branch perm p insert (Branch perm' p') = Branch (add (mapPerms flip perm') p) p' addopt :: PermParser tok st (a -> b) -> a -> GenParser tok st a -> PermParser tok st b addopt perm@(Perm mf fs) x p = Perm (fmap ($ x) mf) (first:map insert fs) where first = Branch perm p insert (Branch perm' p') = Branch (addopt (mapPerms flip perm') x p) p' mapPerms :: (a -> b) -> PermParser tok st a -> PermParser tok st b mapPerms f (Perm x xs) = Perm (fmap f x) (map (mapBranch f) xs) where mapBranch f (Branch perm p) = Branch (mapPerms (f.) perm) p hugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/Pos.hs0000644006511100651110000000676610504340255024726 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Pos -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : portable -- -- Textual source positions. -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Pos ( SourceName, Line, Column , SourcePos , sourceLine, sourceColumn, sourceName , incSourceLine, incSourceColumn , setSourceLine, setSourceColumn, setSourceName , newPos, initialPos , updatePosChar, updatePosString ) where ----------------------------------------------------------- -- Source Positions, a file name, a line and a column. -- upper left is (1,1) ----------------------------------------------------------- type SourceName = String type Line = Int type Column = Int data SourcePos = SourcePos SourceName !Line !Column deriving (Eq,Ord) newPos :: SourceName -> Line -> Column -> SourcePos newPos sourceName line column = SourcePos sourceName line column initialPos :: SourceName -> SourcePos initialPos sourceName = newPos sourceName 1 1 sourceName :: SourcePos -> SourceName sourceName (SourcePos name line column) = name sourceLine :: SourcePos -> Line sourceLine (SourcePos name line column) = line sourceColumn :: SourcePos -> Column sourceColumn (SourcePos name line column) = column incSourceLine :: SourcePos -> Line -> SourcePos incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column incSourceColumn :: SourcePos -> Column -> SourcePos incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n) setSourceName :: SourcePos -> SourceName -> SourcePos setSourceName (SourcePos name line column) n = SourcePos n line column setSourceLine :: SourcePos -> Line -> SourcePos setSourceLine (SourcePos name line column) n = SourcePos name n column setSourceColumn :: SourcePos -> Column -> SourcePos setSourceColumn (SourcePos name line column) n = SourcePos name line n ----------------------------------------------------------- -- Update source positions on characters ----------------------------------------------------------- updatePosString :: SourcePos -> String -> SourcePos updatePosString pos string = forcePos (foldl updatePosChar pos string) updatePosChar :: SourcePos -> Char -> SourcePos updatePosChar pos@(SourcePos name line column) c = forcePos $ case c of '\n' -> SourcePos name (line+1) 1 '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8)) _ -> SourcePos name line (column + 1) forcePos :: SourcePos -> SourcePos forcePos pos@(SourcePos name line column) = seq line (seq column (pos)) ----------------------------------------------------------- -- Show positions ----------------------------------------------------------- instance Show SourcePos where show (SourcePos name line column) | null name = showLineColumn | otherwise = "\"" ++ name ++ "\" " ++ showLineColumn where showLineColumn = "(line " ++ show line ++ ", column " ++ show column ++ ")" hugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/Prim.hs0000644006511100651110000004226610504340255025067 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Prim -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : portable -- -- The primitive parser combinators. -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Prim ( -- operators: label a parser, alternative (), (<|>) -- basic types , Parser, GenParser , runParser, parse, parseFromFile, parseTest -- primitive parsers: -- instance Functor Parser : fmap -- instance Monad Parser : return, >>=, fail -- instance MonadPlus Parser : mzero (pzero), mplus (<|>) , token, tokens, tokenPrim, tokenPrimEx , try, label, labels, unexpected, pzero -- primitive because of space behaviour , many, skipMany -- user state manipulation , getState, setState, updateState -- state manipulation , getPosition, setPosition , getInput, setInput , State(..), getParserState, setParserState ) where import Prelude import Text.ParserCombinators.Parsec.Pos import Text.ParserCombinators.Parsec.Error import Control.Monad {-# INLINE parsecMap #-} {-# INLINE parsecReturn #-} {-# INLINE parsecBind #-} {-# INLINE parsecZero #-} {-# INLINE parsecPlus #-} {-# INLINE token #-} {-# INLINE tokenPrim #-} ----------------------------------------------------------- -- Operators: -- gives a name to a parser (which is used in error messages) -- <|> is the choice operator ----------------------------------------------------------- infix 0 infixr 1 <|> () :: GenParser tok st a -> String -> GenParser tok st a p msg = label p msg (<|>) :: GenParser tok st a -> GenParser tok st a -> GenParser tok st a p1 <|> p2 = mplus p1 p2 ----------------------------------------------------------- -- User state combinators ----------------------------------------------------------- getState :: GenParser tok st st getState = do{ state <- getParserState ; return (stateUser state) } setState :: st -> GenParser tok st () setState st = do{ updateParserState (\(State input pos _) -> State input pos st) ; return () } updateState :: (st -> st) -> GenParser tok st () updateState f = do{ updateParserState (\(State input pos user) -> State input pos (f user)) ; return () } ----------------------------------------------------------- -- Parser state combinators ----------------------------------------------------------- getPosition :: GenParser tok st SourcePos getPosition = do{ state <- getParserState; return (statePos state) } getInput :: GenParser tok st [tok] getInput = do{ state <- getParserState; return (stateInput state) } setPosition :: SourcePos -> GenParser tok st () setPosition pos = do{ updateParserState (\(State input _ user) -> State input pos user) ; return () } setInput :: [tok] -> GenParser tok st () setInput input = do{ updateParserState (\(State _ pos user) -> State input pos user) ; return () } getParserState :: GenParser tok st (State tok st) getParserState = updateParserState id setParserState :: State tok st -> GenParser tok st (State tok st) setParserState st = updateParserState (const st) ----------------------------------------------------------- -- Parser definition. -- GenParser tok st a: -- General parser for tokens of type "tok", -- a user state "st" and a result type "a" ----------------------------------------------------------- type Parser a = GenParser Char () a newtype GenParser tok st a = Parser (State tok st -> Consumed (Reply tok st a)) runP (Parser p) = p data Consumed a = Consumed a --input is consumed | Empty !a --no input is consumed data Reply tok st a = Ok !a !(State tok st) ParseError --parsing succeeded with "a" | Error ParseError --parsing failed data State tok st = State { stateInput :: [tok] , statePos :: !SourcePos , stateUser :: !st } ----------------------------------------------------------- -- run a parser ----------------------------------------------------------- parseFromFile :: Parser a -> SourceName -> IO (Either ParseError a) parseFromFile p fname = do{ input <- readFile fname ; return (parse p fname input) } parseTest :: Show a => GenParser tok () a -> [tok] -> IO () parseTest p input = case (runParser p () "" input) of Left err -> do{ putStr "parse error at " ; print err } Right x -> print x parse :: GenParser tok () a -> SourceName -> [tok] -> Either ParseError a parse p name input = runParser p () name input runParser :: GenParser tok st a -> st -> SourceName -> [tok] -> Either ParseError a runParser p st name input = case parserReply (runP p (State input (initialPos name) st)) of Ok x _ _ -> Right x Error err -> Left err parserReply result = case result of Consumed reply -> reply Empty reply -> reply ----------------------------------------------------------- -- Functor: fmap ----------------------------------------------------------- instance Functor (GenParser tok st) where fmap f p = parsecMap f p parsecMap :: (a -> b) -> GenParser tok st a -> GenParser tok st b parsecMap f (Parser p) = Parser (\state -> case (p state) of Consumed reply -> Consumed (mapReply reply) Empty reply -> Empty (mapReply reply) ) where mapReply reply = case reply of Ok x state err -> let fx = f x in seq fx (Ok fx state err) Error err -> Error err ----------------------------------------------------------- -- Monad: return, sequence (>>=) and fail ----------------------------------------------------------- instance Monad (GenParser tok st) where return x = parsecReturn x p >>= f = parsecBind p f fail msg = parsecFail msg parsecReturn :: a -> GenParser tok st a parsecReturn x = Parser (\state -> Empty (Ok x state (unknownError state))) parsecBind :: GenParser tok st a -> (a -> GenParser tok st b) -> GenParser tok st b parsecBind (Parser p) f = Parser (\state -> case (p state) of Consumed reply1 -> Consumed $ case (reply1) of Ok x state1 err1 -> case runP (f x) state1 of Empty reply2 -> mergeErrorReply err1 reply2 Consumed reply2 -> reply2 Error err1 -> Error err1 Empty reply1 -> case (reply1) of Ok x state1 err1 -> case runP (f x) state1 of Empty reply2 -> Empty (mergeErrorReply err1 reply2) other -> other Error err1 -> Empty (Error err1) ) mergeErrorReply err1 reply = case reply of Ok x state err2 -> Ok x state (mergeError err1 err2) Error err2 -> Error (mergeError err1 err2) parsecFail :: String -> GenParser tok st a parsecFail msg = Parser (\state -> Empty (Error (newErrorMessage (Message msg) (statePos state)))) ----------------------------------------------------------- -- MonadPlus: alternative (mplus) and mzero ----------------------------------------------------------- instance MonadPlus (GenParser tok st) where mzero = parsecZero mplus p1 p2 = parsecPlus p1 p2 pzero :: GenParser tok st a pzero = parsecZero parsecZero :: GenParser tok st a parsecZero = Parser (\state -> Empty (Error (unknownError state))) parsecPlus :: GenParser tok st a -> GenParser tok st a -> GenParser tok st a parsecPlus (Parser p1) (Parser p2) = Parser (\state -> case (p1 state) of Empty (Error err) -> case (p2 state) of Empty reply -> Empty (mergeErrorReply err reply) consumed -> consumed other -> other ) {- -- variant that favors a consumed reply over an empty one, even it is not the first alternative. empty@(Empty reply) -> case reply of Error err -> case (p2 state) of Empty reply -> Empty (mergeErrorReply err reply) consumed -> consumed ok -> case (p2 state) of Empty reply -> empty consumed -> consumed consumed -> consumed -} ----------------------------------------------------------- -- Primitive Parsers: -- try, token(Prim), label, unexpected and updateState ----------------------------------------------------------- try :: GenParser tok st a -> GenParser tok st a try (Parser p) = Parser (\state@(State input pos user) -> case (p state) of Consumed (Error err) -> Empty (Error (setErrorPos pos err)) Consumed ok -> Consumed ok -- was: Empty ok empty -> empty ) token :: (tok -> String) -> (tok -> SourcePos) -> (tok -> Maybe a) -> GenParser tok st a token show tokpos test = tokenPrim show nextpos test where nextpos _ _ (tok:toks) = tokpos tok nextpos _ tok [] = tokpos tok tokenPrim :: (tok -> String) -> (SourcePos -> tok -> [tok] -> SourcePos) -> (tok -> Maybe a) -> GenParser tok st a tokenPrim show nextpos test = tokenPrimEx show nextpos Nothing test -- | The most primitive token recogniser. The expression @tokenPrimEx show nextpos mbnextstate test@, -- recognises tokens when @test@ returns @Just x@ (and returns the value @x@). Tokens are shown in -- error messages using @show@. The position is calculated using @nextpos@, and finally, @mbnextstate@, -- can hold a function that updates the user state on every token recognised (nice to count tokens :-). -- The function is packed into a 'Maybe' type for performance reasons. tokenPrimEx :: (tok -> String) -> (SourcePos -> tok -> [tok] -> SourcePos) -> Maybe (SourcePos -> tok -> [tok] -> st -> st) -> (tok -> Maybe a) -> GenParser tok st a tokenPrimEx show nextpos mbNextState test = case mbNextState of Nothing -> Parser (\state@(State input pos user) -> case input of (c:cs) -> case test c of Just x -> let newpos = nextpos pos c cs newstate = State cs newpos user in seq newpos $ seq newstate $ Consumed (Ok x newstate (newErrorUnknown newpos)) Nothing -> Empty (sysUnExpectError (show c) pos) [] -> Empty (sysUnExpectError "" pos) ) Just nextState -> Parser (\state@(State input pos user) -> case input of (c:cs) -> case test c of Just x -> let newpos = nextpos pos c cs newuser = nextState pos c cs user newstate = State cs newpos newuser in seq newpos $ seq newstate $ Consumed (Ok x newstate (newErrorUnknown newpos)) Nothing -> Empty (sysUnExpectError (show c) pos) [] -> Empty (sysUnExpectError "" pos) ) label :: GenParser tok st a -> String -> GenParser tok st a label p msg = labels p [msg] labels :: GenParser tok st a -> [String] -> GenParser tok st a labels (Parser p) msgs = Parser (\state -> case (p state) of Empty reply -> Empty $ case (reply) of Error err -> Error (setExpectErrors err msgs) Ok x state1 err | errorIsUnknown err -> reply | otherwise -> Ok x state1 (setExpectErrors err msgs) other -> other ) updateParserState :: (State tok st -> State tok st) -> GenParser tok st (State tok st) updateParserState f = Parser (\state -> let newstate = f state in Empty (Ok state newstate (unknownError newstate))) unexpected :: String -> GenParser tok st a unexpected msg = Parser (\state -> Empty (Error (newErrorMessage (UnExpect msg) (statePos state)))) setExpectErrors err [] = setErrorMessage (Expect "") err setExpectErrors err [msg] = setErrorMessage (Expect msg) err setExpectErrors err (msg:msgs) = foldr (\msg err -> addErrorMessage (Expect msg) err) (setErrorMessage (Expect msg) err) msgs sysUnExpectError msg pos = Error (newErrorMessage (SysUnExpect msg) pos) unknownError state = newErrorUnknown (statePos state) ----------------------------------------------------------- -- Parsers unfolded for space: -- if many and skipMany are not defined as primitives, -- they will overflow the stack on large inputs ----------------------------------------------------------- many :: GenParser tok st a -> GenParser tok st [a] many p = do{ xs <- manyAccum (:) p ; return (reverse xs) } skipMany :: GenParser tok st a -> GenParser tok st () skipMany p = do{ manyAccum (\x xs -> []) p ; return () } manyAccum :: (a -> [a] -> [a]) -> GenParser tok st a -> GenParser tok st [a] manyAccum accum (Parser p) = Parser (\state -> let walk xs state r = case r of Empty (Error err) -> Ok xs state err Empty ok -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string." Consumed (Error err) -> Error err Consumed (Ok x state' err) -> let ys = accum x xs in seq ys (walk ys state' (p state')) in case (p state) of Empty reply -> case reply of Ok x state' err -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string." Error err -> Empty (Ok [] state err) consumed -> Consumed $ walk [] state consumed) ----------------------------------------------------------- -- Parsers unfolded for speed: -- tokens ----------------------------------------------------------- {- specification of @tokens@: tokens showss nextposs s = scan s where scan [] = return s scan (c:cs) = do{ token show nextpos c shows s; scan cs } show c = shows [c] nextpos pos c = nextposs pos [c] -} tokens :: Eq tok => ([tok] -> String) -> (SourcePos -> [tok] -> SourcePos) -> [tok] -> GenParser tok st [tok] tokens shows nextposs s = Parser (\state@(State input pos user) -> let ok cs = let newpos = nextposs pos s newstate = State cs newpos user in seq newpos $ seq newstate $ (Ok s newstate (newErrorUnknown newpos)) errEof = Error (setErrorMessage (Expect (shows s)) (newErrorMessage (SysUnExpect "") pos)) errExpect c = Error (setErrorMessage (Expect (shows s)) (newErrorMessage (SysUnExpect (shows [c])) pos)) walk [] cs = ok cs walk xs [] = errEof walk (x:xs) (c:cs)| x == c = walk xs cs | otherwise = errExpect c walk1 [] cs = Empty (ok cs) walk1 xs [] = Empty (errEof) walk1 (x:xs) (c:cs)| x == c = Consumed (walk xs cs) | otherwise = Empty (errExpect c) in walk1 s input) hugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec/Token.hs0000644006511100651110000004262710504340255025241 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Token -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : non-portable (uses existentially quantified data constructors) -- -- A helper module to parse lexical elements (tokens). -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.Token ( LanguageDef (..) , TokenParser (..) , makeTokenParser ) where import Data.Char (isAlpha,toLower,toUpper,isSpace,digitToInt) import Data.List (nub,sort) import Text.ParserCombinators.Parsec ----------------------------------------------------------- -- Language Definition ----------------------------------------------------------- data LanguageDef st = LanguageDef { commentStart :: String , commentEnd :: String , commentLine :: String , nestedComments :: Bool , identStart :: CharParser st Char , identLetter :: CharParser st Char , opStart :: CharParser st Char , opLetter :: CharParser st Char , reservedNames :: [String] , reservedOpNames:: [String] , caseSensitive :: Bool } ----------------------------------------------------------- -- A first class module: TokenParser ----------------------------------------------------------- data TokenParser st = TokenParser{ identifier :: CharParser st String , reserved :: String -> CharParser st () , operator :: CharParser st String , reservedOp :: String -> CharParser st () , charLiteral :: CharParser st Char , stringLiteral :: CharParser st String , natural :: CharParser st Integer , integer :: CharParser st Integer , float :: CharParser st Double , naturalOrFloat :: CharParser st (Either Integer Double) , decimal :: CharParser st Integer , hexadecimal :: CharParser st Integer , octal :: CharParser st Integer , symbol :: String -> CharParser st String , lexeme :: forall a. CharParser st a -> CharParser st a , whiteSpace :: CharParser st () , parens :: forall a. CharParser st a -> CharParser st a , braces :: forall a. CharParser st a -> CharParser st a , angles :: forall a. CharParser st a -> CharParser st a , brackets :: forall a. CharParser st a -> CharParser st a -- "squares" is deprecated , squares :: forall a. CharParser st a -> CharParser st a , semi :: CharParser st String , comma :: CharParser st String , colon :: CharParser st String , dot :: CharParser st String , semiSep :: forall a . CharParser st a -> CharParser st [a] , semiSep1 :: forall a . CharParser st a -> CharParser st [a] , commaSep :: forall a . CharParser st a -> CharParser st [a] , commaSep1 :: forall a . CharParser st a -> CharParser st [a] } ----------------------------------------------------------- -- Given a LanguageDef, create a token parser. ----------------------------------------------------------- makeTokenParser :: LanguageDef st -> TokenParser st makeTokenParser languageDef = TokenParser{ identifier = identifier , reserved = reserved , operator = operator , reservedOp = reservedOp , charLiteral = charLiteral , stringLiteral = stringLiteral , natural = natural , integer = integer , float = float , naturalOrFloat = naturalOrFloat , decimal = decimal , hexadecimal = hexadecimal , octal = octal , symbol = symbol , lexeme = lexeme , whiteSpace = whiteSpace , parens = parens , braces = braces , angles = angles , brackets = brackets , squares = brackets , semi = semi , comma = comma , colon = colon , dot = dot , semiSep = semiSep , semiSep1 = semiSep1 , commaSep = commaSep , commaSep1 = commaSep1 } where ----------------------------------------------------------- -- Bracketing ----------------------------------------------------------- parens p = between (symbol "(") (symbol ")") p braces p = between (symbol "{") (symbol "}") p angles p = between (symbol "<") (symbol ">") p brackets p = between (symbol "[") (symbol "]") p semi = symbol ";" comma = symbol "," dot = symbol "." colon = symbol ":" commaSep p = sepBy p comma semiSep p = sepBy p semi commaSep1 p = sepBy1 p comma semiSep1 p = sepBy1 p semi ----------------------------------------------------------- -- Chars & Strings ----------------------------------------------------------- -- charLiteral :: CharParser st Char charLiteral = lexeme (between (char '\'') (char '\'' "end of character") characterChar ) "character" characterChar = charLetter <|> charEscape "literal character" charEscape = do{ char '\\'; escapeCode } charLetter = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026')) -- stringLiteral :: CharParser st String stringLiteral = lexeme ( do{ str <- between (char '"') (char '"' "end of string") (many stringChar) ; return (foldr (maybe id (:)) "" str) } "literal string") -- stringChar :: CharParser st (Maybe Char) stringChar = do{ c <- stringLetter; return (Just c) } <|> stringEscape "string character" stringLetter = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026')) stringEscape = do{ char '\\' ; do{ escapeGap ; return Nothing } <|> do{ escapeEmpty; return Nothing } <|> do{ esc <- escapeCode; return (Just esc) } } escapeEmpty = char '&' escapeGap = do{ many1 space ; char '\\' "end of string gap" } -- escape codes escapeCode = charEsc <|> charNum <|> charAscii <|> charControl "escape code" -- charControl :: CharParser st Char charControl = do{ char '^' ; code <- upper ; return (toEnum (fromEnum code - fromEnum 'A')) } -- charNum :: CharParser st Char charNum = do{ code <- decimal <|> do{ char 'o'; number 8 octDigit } <|> do{ char 'x'; number 16 hexDigit } ; return (toEnum (fromInteger code)) } charEsc = choice (map parseEsc escMap) where parseEsc (c,code) = do{ char c; return code } charAscii = choice (map parseAscii asciiMap) where parseAscii (asc,code) = try (do{ string asc; return code }) -- escape code tables escMap = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'") asciiMap = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2) ascii2codes = ["BS","HT","LF","VT","FF","CR","SO","SI","EM", "FS","GS","RS","US","SP"] ascii3codes = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL", "DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB", "CAN","SUB","ESC","DEL"] ascii2 = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI', '\EM','\FS','\GS','\RS','\US','\SP'] ascii3 = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK', '\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK', '\SYN','\ETB','\CAN','\SUB','\ESC','\DEL'] ----------------------------------------------------------- -- Numbers ----------------------------------------------------------- -- naturalOrFloat :: CharParser st (Either Integer Double) naturalOrFloat = lexeme (natFloat) "number" float = lexeme floating "float" integer = lexeme int "integer" natural = lexeme nat "natural" -- floats floating = do{ n <- decimal ; fractExponent n } natFloat = do{ char '0' ; zeroNumFloat } <|> decimalFloat zeroNumFloat = do{ n <- hexadecimal <|> octal ; return (Left n) } <|> decimalFloat <|> fractFloat 0 <|> return (Left 0) decimalFloat = do{ n <- decimal ; option (Left n) (fractFloat n) } fractFloat n = do{ f <- fractExponent n ; return (Right f) } fractExponent n = do{ fract <- fraction ; expo <- option 1.0 exponent' ; return ((fromInteger n + fract)*expo) } <|> do{ expo <- exponent' ; return ((fromInteger n)*expo) } fraction = do{ char '.' ; digits <- many1 digit "fraction" ; return (foldr op 0.0 digits) } "fraction" where op d f = (f + fromIntegral (digitToInt d))/10.0 exponent' = do{ oneOf "eE" ; f <- sign ; e <- decimal "exponent" ; return (power (f e)) } "exponent" where power e | e < 0 = 1.0/power(-e) | otherwise = fromInteger (10^e) -- integers and naturals int = do{ f <- lexeme sign ; n <- nat ; return (f n) } -- sign :: CharParser st (Integer -> Integer) sign = (char '-' >> return negate) <|> (char '+' >> return id) <|> return id nat = zeroNumber <|> decimal zeroNumber = do{ char '0' ; hexadecimal <|> octal <|> decimal <|> return 0 } "" decimal = number 10 digit hexadecimal = do{ oneOf "xX"; number 16 hexDigit } octal = do{ oneOf "oO"; number 8 octDigit } -- number :: Integer -> CharParser st Char -> CharParser st Integer number base baseDigit = do{ digits <- many1 baseDigit ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits ; seq n (return n) } ----------------------------------------------------------- -- Operators & reserved ops ----------------------------------------------------------- reservedOp name = lexeme $ try $ do{ string name ; notFollowedBy (opLetter languageDef) ("end of " ++ show name) } operator = lexeme $ try $ do{ name <- oper ; if (isReservedOp name) then unexpected ("reserved operator " ++ show name) else return name } oper = do{ c <- (opStart languageDef) ; cs <- many (opLetter languageDef) ; return (c:cs) } "operator" isReservedOp name = isReserved (sort (reservedOpNames languageDef)) name ----------------------------------------------------------- -- Identifiers & Reserved words ----------------------------------------------------------- reserved name = lexeme $ try $ do{ caseString name ; notFollowedBy (identLetter languageDef) ("end of " ++ show name) } caseString name | caseSensitive languageDef = string name | otherwise = do{ walk name; return name } where walk [] = return () walk (c:cs) = do{ caseChar c msg; walk cs } caseChar c | isAlpha c = char (toLower c) <|> char (toUpper c) | otherwise = char c msg = show name identifier = lexeme $ try $ do{ name <- ident ; if (isReservedName name) then unexpected ("reserved word " ++ show name) else return name } ident = do{ c <- identStart languageDef ; cs <- many (identLetter languageDef) ; return (c:cs) } "identifier" isReservedName name = isReserved theReservedNames caseName where caseName | caseSensitive languageDef = name | otherwise = map toLower name isReserved names name = scan names where scan [] = False scan (r:rs) = case (compare r name) of LT -> scan rs EQ -> True GT -> False theReservedNames | caseSensitive languageDef = sortedNames | otherwise = map (map toLower) sortedNames where sortedNames = sort (reservedNames languageDef) ----------------------------------------------------------- -- White space & symbols ----------------------------------------------------------- symbol name = lexeme (string name) lexeme p = do{ x <- p; whiteSpace; return x } --whiteSpace whiteSpace | noLine && noMulti = skipMany (simpleSpace "") | noLine = skipMany (simpleSpace <|> multiLineComment "") | noMulti = skipMany (simpleSpace <|> oneLineComment "") | otherwise = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment "") where noLine = null (commentLine languageDef) noMulti = null (commentStart languageDef) simpleSpace = skipMany1 (satisfy isSpace) oneLineComment = do{ try (string (commentLine languageDef)) ; skipMany (satisfy (/= '\n')) ; return () } multiLineComment = do { try (string (commentStart languageDef)) ; inComment } inComment | nestedComments languageDef = inCommentMulti | otherwise = inCommentSingle inCommentMulti = do{ try (string (commentEnd languageDef)) ; return () } <|> do{ multiLineComment ; inCommentMulti } <|> do{ skipMany1 (noneOf startEnd) ; inCommentMulti } <|> do{ oneOf startEnd ; inCommentMulti } "end of comment" where startEnd = nub (commentEnd languageDef ++ commentStart languageDef) inCommentSingle = do{ try (string (commentEnd languageDef)); return () } <|> do{ skipMany1 (noneOf startEnd) ; inCommentSingle } <|> do{ oneOf startEnd ; inCommentSingle } "end of comment" where startEnd = nub (commentEnd languageDef ++ commentStart languageDef) hugs98-plus-Sep2006/packages/parsec/Text/ParserCombinators/Parsec.hs0000644006511100651110000000413210504340255024146 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : portable -- -- Parsec, the Fast Monadic Parser combinator library, see -- . -- -- Inspired by: -- -- * Graham Hutton and Erik Meijer: -- Monadic Parser Combinators. -- Technical report NOTTCS-TR-96-4. -- Department of Computer Science, University of Nottingham, 1996. -- -- -- * Andrew Partridge, David Wright: -- Predictive parser combinators need four values to report errors. -- Journal of Functional Programming 6(2): 355-364, 1996 -- -- This helper module exports elements from the basic libraries. -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec ( -- complete modules module Text.ParserCombinators.Parsec.Prim , module Text.ParserCombinators.Parsec.Combinator , module Text.ParserCombinators.Parsec.Char -- module Text.ParserCombinators.Parsec.Error , ParseError , errorPos -- module Text.ParserCombinators.Parsec.Pos , SourcePos , SourceName, Line, Column , sourceName, sourceLine, sourceColumn , incSourceLine, incSourceColumn , setSourceLine, setSourceColumn, setSourceName ) where import Text.ParserCombinators.Parsec.Pos -- textual positions import Text.ParserCombinators.Parsec.Error -- parse errors import Text.ParserCombinators.Parsec.Prim -- primitive combinators import Text.ParserCombinators.Parsec.Combinator -- derived combinators import Text.ParserCombinators.Parsec.Char -- character parsers hugs98-plus-Sep2006/packages/parsec/Makefile.nhc980000644006511100651110000000107010504340255020402 0ustar rossrossTHISPKG = parsec SEARCH = SRCS = \ Text/ParserCombinators/Parsec/Char.hs \ Text/ParserCombinators/Parsec/Combinator.hs \ Text/ParserCombinators/Parsec/Error.hs \ Text/ParserCombinators/Parsec/Expr.hs \ Text/ParserCombinators/Parsec/Perm.hs \ Text/ParserCombinators/Parsec/Pos.hs \ Text/ParserCombinators/Parsec/Prim.hs \ Text/ParserCombinators/Parsec.hs # Text/ParserCombinators/Parsec/Token.hs \ # Text/ParserCombinators/Parsec/Language.hs # Here are the main rules. include ../Makefile.common # Here are any extra dependencies. # C-files dependencies. hugs98-plus-Sep2006/packages/parsec/examples/0000755006511100651110000000000010504340255017632 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/examples/Henk/0000755006511100651110000000000010504340255020517 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/examples/Henk/HenkAS.hs0000644006511100651110000001072510504340255022171 0ustar rossross---------------------------------------------------------------- -- the Henk Abstract Syntax -- Copyright 2000, Jan-Willem Roorda and Daan Leijen ---------------------------------------------------------------- module HenkAS where import Text.PrettyPrint.HughesPJ ---------------------------------------------------------------- -- Abstract Syntax ---------------------------------------------------------------- data Program = Program [TypeDecl] [ValueDecl] data TypeDecl = Data Var [Var] data ValueDecl = Let Bind | LetRec [Bind] data Bind = Bind Var Expr data Expr = Var Var | Lit Lit | Box | Star | Unknown | App Expr Expr | Case Expr [Alt] [Expr] | In ValueDecl Expr | Pi Var Expr | Lam Var Expr data Alt = Alt Pat Expr data Pat = PatVar Var | PatLit Lit data Var = TVar Identifier Expr data Lit = LitInt Integer type Identifier = String anonymous = "_" isAnonymous s = (null s || (head s == head anonymous)) ---------------------------------------------------------------- -- pretty print abstract syntax ---------------------------------------------------------------- instance Show Program where showsPrec d program = shows (pprogram program) vsep ds = vcat (map ($$ text "") ds) -- program pprogram (Program tdecls vdecls) = vsep ((map ptdecl tdecls) ++ (map pvdecl vdecls)) ptdecl (Data v vs) = (text "data" <+> pbindvar v) $$ indent (text "=" <+> braced (map ptvar vs)) pvdecl vdecl = case vdecl of Let bind -> text "let" <+> pbind bind LetRec binds -> text "letrec" $$ indent (braced (map pbind binds)) pbind (Bind v e) = pbindvar v $$ indent (text "=" <+> pexpr e) -- expressions (are parenthesis correct ?) parensExpr e = case e of In _ _ -> parens (pexpr e) Pi _ _ -> parens (pexpr e) Lam _ _ -> parens (pexpr e) Case _ _ _ -> parens (pexpr e) App _ _ -> parens (pexpr e) Var (TVar i t) -> case t of Unknown -> pexpr e other -> parens (pexpr e) other -> pexpr e pexpr e = case e of Var v -> pboundvar v Lit l -> plit l Box -> text "[]" Star -> text "*" Unknown -> text "?" App e1 e2 -> pexpr e1 <+> parensExpr e2 Case e as ts-> sep $ [text "case" <+> parensExpr e <+> text "of" ,nest 3 (braced (map palt as)) ] ++ (if (null as) then [] else [text "at" ,nest 3 (braced (map pexpr ts)) ]) In v e -> sep[ pvdecl v, text "in" <+> pexpr e] Pi v e -> case v of TVar i t | isAnonymous i -> parensExpr t <+> text "->" <+> pexpr e TVar i Star -> sep[ text "\\/" <> text i <> text ".", pexpr e] other -> sep[ text "|~|" <> pbindvar v <> text ".", pexpr e] Lam v e -> case v of TVar i Star -> sep[ text "/\\" <> text i <> text ".", pexpr e] other -> sep[ text "\\" <> pbindvar v <> text ".", pexpr e] -- atomic stuff palt (Alt p e) = ppat p <+> text "=>" <+> pexpr e ppat p = case p of PatVar v -> pboundvar v PatLit l -> plit l pboundvar v@(TVar i e) = case e of Unknown -> text i other -> ptvar v pbindvar v@(TVar i e) = case e of Star -> text i other -> ptvar v ptvar (TVar i e) = text i <> colon <+> pexpr e plit l = case l of LitInt i -> integer i braced [] = empty braced ds = let prefix = map text $ ["{"] ++ repeat ";" in cat ((zipWith (<+>) prefix ds) ++ [text "}"]) indent = nest 4 hugs98-plus-Sep2006/packages/parsec/examples/Henk/Main.hs0000644006511100651110000000227610504340255021746 0ustar rossross---------------------------------------------------------------- -- Henk -- Copyright 2000, Jan-Willem Roorda ---------------------------------------------------------------- module Main where import Text.ParserCombinators.Parsec import HenkParser welcome = "__ __ ______ __ __ ____ __________________________________________\n"++ "|| || || || ||\\ || ||// Henk 2000: Based on Pure Type Systems \n"++ "||___|| ||_| ||\\\\ || ||\\\\ \n"++ "||---|| ||-|__ || \\\\|| WWW http://www.students.cs.uu.nl/~jwroorda\n"++ "|| || ||__|| Report bugs to: jwroorda@math.uu.nl \n"++ "|| || Version: Jan 2000 __________________________________________\n\n" test fname = do{ putStr welcome ; result <- parseFromFile program (root ++ fname ++ ".h") ; case result of Left err -> do{ putStr "parse error at: " ; print err } Right x -> print x } where root = "" main = test "test" hugs98-plus-Sep2006/packages/parsec/examples/Henk/HenkParser.hs0000644006511100651110000001555010504340255023123 0ustar rossross---------------------------------------------------------------- -- the Henk Parser -- Copyright 2000, Jan-Willem Roorda and Daan Leijen ---------------------------------------------------------------- module HenkParser where import Text.ParserCombinators.Parsec import qualified Text.ParserCombinators.Parsec.Token as P import Text.ParserCombinators.Parsec.Language import HenkAS ---------------------------------------------------------------- -- the Henk Parser -- -- anonymous variables are any identifiers starting with "_" -- -- unknown types (those that need to be inferred) can explicitly -- be given using "?" -- -- instead of grammar: "var : aexpr" as in the henk paper, -- we use "var : expr" instead. This means that variable -- sequences as in \, |~|, \/ and /\ expressions need to -- be comma seperated. Pattern variables are also comma -- seperated. The case arrow (->) now needs to be (=>) in -- order to distinguish the end of the pattern from function -- arrows. ---------------------------------------------------------------- program = do{ whiteSpace ; ts <- semiSep tdecl ; vs <- semiSep vdecl ; eof ; return $ Program ts vs } ---------------------------------------------------------------- -- Type declarations ---------------------------------------------------------------- tdecl = do{ reserved "data" ; t <- bindVar ; symbol "=" ; ts <- braces (semiSep1 tvar) ; return $ Data t ts } ---------------------------------------------------------------- -- Value declarations ---------------------------------------------------------------- vdecl :: Parser ValueDecl vdecl = do{ reserved "let" ; b <- bind ; return $ Let b } <|> do{ reserved "letrec" ; bs <- braces (semiSep1 bind) ; return $ LetRec bs } bind = do{ t <- tvar ; symbol "=" ; e <- expr ; return $ Bind t e } ---------------------------------------------------------------- -- Expressions ---------------------------------------------------------------- expr :: Parser Expr expr = choice [ letExpr , forallExpr -- forall before lambda! \/ vs. \ , lambdaExpr , piExpr , caseExpr , functionExpr , bigLamdaExpr ] "expression" letExpr = do{ vd <- vdecl ; reserved "in" ; e <- expr ; return (In vd e) } lambdaExpr = do{ symbol "\\" ; ts <- commaSep1 bindVar ; symbol "." ; e <- expr ; return $ (foldr Lam e ts) } piExpr = do{ symbol "|~|" ; ts <- commaSep1 bindVar ; symbol "." ; e <- expr ; return (foldr Pi e ts) } ---------------------------------------------------------------- -- Case expressions ---------------------------------------------------------------- caseExpr = do{ reserved "case" ; e <- expr ; reserved "of" ; as <- braces (semiSep1 alt) ; es <- option [] (do{ reserved "at" ; braces (semiSep expr) }) ; return (Case e as es) } alt = do{ pat <- pattern ; symbol "=>" ; e <- expr ; return (pat e) } pattern = do{ p <- atomPattern ; vs <- commaSep boundVar ; return (\e -> Alt p (foldr Lam e vs)) } atomPattern = do{ v <- boundVar ; return (PatVar v) } <|> do{ l <- literal ; return (PatLit l) } "pattern" ---------------------------------------------------------------- -- Syntactic sugar: ->, \/, /\ ---------------------------------------------------------------- functionExpr = chainr1 appExpr arrow where arrow = do{ symbol "->" ; return ((\x y -> Pi (TVar anonymous x) y)) } "" bigLamdaExpr = do{ symbol "/\\" ; ts <- commaSep1 bindVar ; symbol "." ; e <- expr ; return (foldr Lam e ts) } forallExpr = do{ try (symbol "\\/") -- use "try" to try "\" (lambda) too. ; ts <- commaSep1 bindVar ; symbol "." ; e <- expr ; return (foldr Pi e ts) } ---------------------------------------------------------------- -- Simple expressions ---------------------------------------------------------------- appExpr = do{ es <- many1 atomExpr ; return (foldl1 App es) } atomExpr = parens expr <|> do{ v <- boundVar; return (Var v) } <|> do{ l <- literal; return (Lit l)} <|> do{ symbol "*"; return Star } <|> do{ symbol "[]"; return Box } <|> do{ symbol "?"; return Unknown } "simple expression" ---------------------------------------------------------------- -- Variables & Literals ---------------------------------------------------------------- variable = identifier anonymousVar = lexeme $ do{ c <- char '_' ; cs <- many (identLetter henkDef) ; return (c:cs) } bindVar = do{ i <- variable <|> anonymousVar ; do{ e <- varType ; return (TVar i e) } <|> return (TVar i Star) } "variable" boundVar = do{ i <- variable ; do{ e <- varType ; return (TVar i e) } <|> return (TVar i Unknown) } "variable" tvar = do{ v <- variable ; t <- varType ; return (TVar v t) } "typed variable" varType = do{ symbol ":" ; expr } "variable type" literal = do{ i <- natural ; return (LitInt i) } "literal" ---------------------------------------------------------------- -- Tokens ---------------------------------------------------------------- henk = P.makeTokenParser henkDef lexeme = P.lexeme henk parens = P.parens henk braces = P.braces henk semiSep = P.semiSep henk semiSep1 = P.semiSep1 henk commaSep = P.commaSep henk commaSep1 = P.commaSep1 henk whiteSpace = P.whiteSpace henk symbol = P.symbol henk identifier = P.identifier henk reserved = P.reserved henk natural = P.natural henk henkDef = haskellStyle { identStart = letter , identLetter = alphaNum <|> oneOf "_'" , opStart = opLetter henkDef , opLetter = oneOf ":=\\->/|~.*[]" , reservedOpNames = ["::","=","\\","->","=>","/\\","\\/" ,"|~|",".",":","*","[]"] , reservedNames = [ "case", "data", "letrec", "type" , "import", "in", "let", "of", "at" ] } hugs98-plus-Sep2006/packages/parsec/examples/Henk/Makefile0000644006511100651110000000067110504340255022163 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- HS_PROG = Henk$(exeext) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -package parsec # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/parsec/examples/Henk/test.h0000644006511100651110000000200010504340255021637 0ustar rossross-- type declarations data List: * -> * = { Nil: \/a. List a ; Cons : \/a. a -> List a -> List a }; data Maybe : * -> * -> * = { Left: \/a,b. a -> Maybe a b ; Right: \/a,b. b -> Maybe a b } -- value declarations let id : \/a. a->a = /\a. \x:a. x; letrec { map: \/a,b. a -> b -> List a -> List b = /\a,b. \f: a->b,xs:List a. case (xs) of { Nil =>Nil ; Cons => \x:a, xx: List a. Cons (f x) (map a b f xx) } at {a:*} }; letrec { reverse: \/a. List a -> List a = /\a.\xs:List a. case xs of { Nil => Nil ; Cons x,xx => append (reverse xx) (Cons x Nil) } at {a:*} }; letrec { append: \/a. |~|_dummy:List a.|~|_:List a.List a = /\a.\xs:List a, ys:List a. case xs of { Nil => ys ; Cons x:a,xx: List a => Cons x (append xx ys) } at {a:*} } hugs98-plus-Sep2006/packages/parsec/examples/Mondrian/0000755006511100651110000000000010504340255021401 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/examples/Mondrian/MonParser.hs0000644006511100651110000002046710504340255023654 0ustar rossross----------------------------------------------------------- -- Daan Leijen (c) 1999-2000, daan@cs.uu.nl ----------------------------------------------------------- module MonParser ( parseMondrian , parseMondrianFromFile , prettyFile , ParseError ) where import Char import Monad import Mondrian import Utils (groupLambdas) -- Parsec import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Expr import qualified Text.ParserCombinators.Parsec.Token as P import Text.ParserCombinators.Parsec.Language (mondrianDef) --testing import qualified SimpleMondrianPrinter as Pretty ----------------------------------------------------------- -- ----------------------------------------------------------- parseMondrianFromFile :: String -> IO (Either ParseError CompilationUnit) parseMondrianFromFile fname = parseFromFile compilationUnit fname parseMondrian sourceName source = parse compilationUnit sourceName source -- testing prettyFile fname = do{ result <- parseMondrianFromFile fname ; case result of Left err -> putStr ("parse error at: " ++ show err) Right x -> print (Pretty.compilationUnit x) } ----------------------------------------------------------- -- GRAMMAR ELEMENTS ----------------------------------------------------------- compilationUnit :: Parser CompilationUnit compilationUnit = do{ whiteSpace ; reserved "package" ; name <- option [""] packageName ; decls <- option [] declarations ; eof ; return $ Package name decls } ----------------------------------------------------------- -- Declarations ----------------------------------------------------------- declarations = braces (semiSep1 declaration) declaration = importDeclaration <|> classDeclaration <|> variableSignatureDeclaration "declaration" variableSignatureDeclaration = do{ name <- variableName ; variableDeclaration name <|> signatureDeclaration name } variableDeclaration name = do{ symbol "=" ; expr <- expression ; return $ VarDecl name expr } "variable declaration" importDeclaration = do{ reserved "import" ; name <- packageName ; star <- option [] (do{ symbol "." ; symbol "*" ; return ["*"] }) ; return $ ImportDecl (name ++ star) } classDeclaration = do{ reserved "class" ; name <- className ; extends <- option [] (do{ reserved "extends" ; n <- className ; return [n] }) ; decls <- option [] declarations ; return $ ClassDecl name extends decls } signatureDeclaration name = do{ symbol "::" ; texpr <- typeExpression ; return $ SigDecl name texpr } "type declaration" ----------------------------------------------------------- -- Expressions ----------------------------------------------------------- expression :: Parser Expr expression = lambdaExpression <|> letExpression <|> newExpression <|> infixExpression "expression" lambdaExpression = do{ symbol "\\" ; name <- variableName ; symbol "->" ; expr <- expression ; return $ groupLambdas (Lambda [name] expr) } letExpression = do{ reserved "let" ; decls <- declarations ; reserved "in" ; expr <- expression ; return $ Let decls expr } newExpression = do{ reserved "new" ; name <- className ; decls <- option [] declarations ; return $ New name decls } ----------------------------------------------------------- -- Infix expression ----------------------------------------------------------- infixExpression = buildExpressionParser operators applyExpression operators = [ [ prefix "-", prefix "+" ] , [ op "^" AssocRight ] , [ op "*" AssocLeft, op "/" AssocLeft ] , [ op "+" AssocLeft, op "-" AssocLeft ] , [ op "==" AssocNone, op "/=" AssocNone, op "<" AssocNone , op "<=" AssocNone, op ">" AssocNone, op ">=" AssocNone ] , [ op "&&" AssocNone ] , [ op "||" AssocNone ] ] where op name assoc = Infix (do{ var <- try (symbol name) ; return (\x y -> App (App (Var [var]) x) y) }) assoc prefix name = Prefix (do{ var <- try (symbol name) ; return (\x -> App (Var [var,"unary"]) x) }) applyExpression = do{ exprs <- many1 simpleExpression ; return (foldl1 App exprs) } {- infixExpression = do{ (e,es) <- chain simpleExpression operator "infix expression" ; return $ if null es then e else (unChain (Chain e es)) } -} simpleExpression :: Parser Expr simpleExpression = literal <|> parens expression <|> caseExpression <|> variable "simple expression" ----------------------------------------------------------- -- Case expression ----------------------------------------------------------- caseExpression = do{ reserved "case" ; expr <- variable ; reserved "of" ; alts <- alternatives ; return $ Case expr alts } alternatives = braces (semiSep1 arm) arm = do{ pat <- pattern ; symbol "->" ; expr <- expression ; return (pat,expr) } pattern = do{ reserved "default" ; return Default } <|> do{ name <- patternName ; decls <- option [] declarations ; return $ Pattern name decls } "pattern" ----------------------------------------------------------- -- Type expression ----------------------------------------------------------- {- typeExpression = do{ (e,es) <- chain simpleType typeOperator "type expression" ; return $ if null es then e else Chain e es } "type expression" -} typeExpression :: Parser Expr typeExpression = do{ exprs <- sepBy1 simpleType (symbol "->") ; return (foldl1 (\x y -> App (App (Var ["->"]) x) y) exprs) } simpleType :: Parser Expr simpleType = parens typeExpression <|> variable "simple type" ----------------------------------------------------------- -- LEXICAL ELEMENTS ----------------------------------------------------------- ----------------------------------------------------------- -- Identifiers & Reserved words ----------------------------------------------------------- variable = do{ name <- variableName ; return $ Var name } patternName = qualifiedName "pattern variable" variableName = qualifiedName "identifier" className = qualifiedName "class name" packageName = qualifiedName "package name" qualifiedName = identifier `sepBy1` (symbol "." "") ----------------------------------------------------------- -- Literals ----------------------------------------------------------- literal = do{ v <- intLiteral <|> chrLiteral <|> strLiteral ; return $ Lit v } "literal" intLiteral = do{ n <- natural; return (IntLit n) } chrLiteral = do{ c <- charLiteral; return (CharLit c) } strLiteral = do{ s <- stringLiteral; return (StringLit s) } ----------------------------------------------------------- -- Tokens -- Use qualified import to have token parsers on toplevel ----------------------------------------------------------- mondrian = P.makeTokenParser mondrianDef parens = P.parens mondrian braces = P.braces mondrian semiSep1 = P.semiSep1 mondrian whiteSpace = P.whiteSpace mondrian symbol = P.symbol mondrian identifier = P.identifier mondrian reserved = P.reserved mondrian natural = P.natural mondrian charLiteral = P.charLiteral mondrian stringLiteral = P.stringLiteral mondrian hugs98-plus-Sep2006/packages/parsec/examples/Mondrian/Main.hs0000644006511100651110000000040610504340255022621 0ustar rossross----------------------------------------------------------- -- Daan Leijen (c) 1999-2000, daan@cs.uu.nl ----------------------------------------------------------- module Main where import MonParser (prettyFile) main :: IO () main = prettyFile "Prelude.m" hugs98-plus-Sep2006/packages/parsec/examples/Mondrian/Makefile0000644006511100651110000000067510504340255023051 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- HS_PROG = Mondrian$(exeext) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -package parsec # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/parsec/examples/Mondrian/Mondrian.hs0000644006511100651110000000125410504340255023506 0ustar rossross{- Abstract Syntax for Core Mondrian (c) 1999 Erik Meijer and Arjan van Yzendoorn -} module Mondrian where data CompilationUnit = Package Name [Decl] deriving Show data Decl = ClassDecl Name [Name] [Decl] | ImportDecl Name | VarDecl Name Expr | SigDecl Name Expr deriving Show data Expr = Lit Lit | Var Name | Case Expr [(Pattern, Expr)] | Let [Decl] Expr | Lambda [Name] Expr | App Expr Expr | New Name [Decl] | Chain Expr [(Name, Expr)] deriving Show data Pattern = Pattern Name [Decl] | Default deriving Show data Lit = IntLit Integer | CharLit Char | StringLit String deriving Show type Name = [String] hugs98-plus-Sep2006/packages/parsec/examples/Mondrian/Prelude.m0000644006511100651110000000162010504340255023156 0ustar rossrosspackage Prelude { import Foo ; class List extends Mondrian ; class Nil extends List ; class Cons extends List { head :: Mondrian ; tail :: List } ; map = \f -> \as -> case as of { Nil -> new Nil ; Cons{ a :: Mondrian; a = head; as :: List; as = tail } -> new Cons{ head = f a; tail = map f as } } ; class Boolean extends Mondrian ; class True extends Boolean ; class False extends Boolean ; cond = \b -> \t -> \e -> case b of { True -> t ; False -> e } ; fac = \n -> cond (n == 0) 1 (n * (fac (n - 1))) ; I :: a -> a ; I = \x -> x ; K :: a -> b -> a ; K = \x -> \y -> x ; S :: (a -> b -> c) -> (a -> b) -> (a -> c) ; S = \f -> \g -> \x -> f x (g x) ; Compose :: (b -> c) -> (a -> b) -> (a -> c) ; Compose = \f -> \g -> \x -> f (g x) ; Twice :: (a -> a) -> (a -> a) ; Twice = \f -> Compose f f ; main = Twice I 3 }hugs98-plus-Sep2006/packages/parsec/examples/Mondrian/Pretty.hs0000644006511100651110000000554610504340255023236 0ustar rossross{- Copyright(C) 1999 Erik Meijer -} module Pretty where {- Quick reference for the simple Pretty-print Combinators |---| |----| |-------| |koe| <|> |beer| = |koebeer| |---| |----| |-------| |---| |----| |--------| |koe| <+> |beer| = |koe beer| |---| |----| |--------| |---| |----| |----| |koe| <-> |beer| = |koe | |---| |----| |beer| |----| |---| |----| |-------| |koe| <|> nest 2 |beer| = |koebeer| |---| |----| |-------| |---| |----| |------| |koe| <-> nest 2 |beer| = |koe | |---| |----| | beer| |------| empty = -} {- Extremely simplified version of John Hughes' combinators, without (sep), but with (empty). TODO: use Okasaki-style catenable dequeues to represent Doc (c) Erik Meijer and Arjan van IJzendoorn October 199 -} infixl 7 <+> infixl 6 <|> infixr 5 <-> instance Show Doc where { showsPrec = showsPrecDoc } showsPrecDoc i = \d -> case d of { Empty -> id ; Doc ds -> layout ds } data Doc = Doc [(Int,ShowS)] | Empty layout :: [(Int,ShowS)] -> ShowS layout = \ds -> case ds of { [] -> showString "" ; [(n,s)] -> indent n.s ; (n,s):ds -> indent n.s.showString "\n".layout ds } width :: Doc -> Int width = \d -> case d of { Empty -> 0 ; Doc ds -> maximum [ i + length (s "") | (i,s) <- ds ] } text :: String -> Doc text = \s -> Doc [(0,showString s)] nest :: Int -> Doc -> Doc nest n = \d -> case d of { Empty -> Empty ; Doc ds -> Doc [ (i+n,d) | (i,d) <- ds ] } (<->) :: Doc -> Doc -> Doc Empty <-> Empty = Empty Empty <-> (Doc d2) = Doc d2 (Doc d1) <-> Empty = Doc d1 (Doc d1) <-> (Doc d2) = Doc (d1++d2) (<+>) :: Doc -> Doc -> Doc a <+> b = a <|> (text " ") <|> b (<|>) :: Doc -> Doc -> Doc Empty <|> Empty = Empty Empty <|> (Doc d2) = Doc d2 (Doc d1) <|> Empty = Doc d1 (Doc d1) <|> (Doc d2) = let { (d,(i,s)) = (init d1,last d1) ; ((j,t),e) = (head d2,tail d2) } in ( Doc d <-> Doc [(i,s.t)] <-> nest (i + length (s "") - j) (Doc e) ) -- Derived operations empty :: Doc empty = Empty {- horizontal s [a,b,c] = a <|> (s <|> b) <|> (s <|> c) -} horizontal :: Doc -> [Doc] -> Doc horizontal s = \ds -> case ds of { [] -> empty ; ds -> foldr1 (\d -> \ds -> d <|> s <|> ds) ds } {- vertical s [a,b,c] = a <-> (s <|> b) <-> (s <|> c) -} vertical :: [Doc] -> Doc vertical = \ds -> case ds of { [] -> empty ; d:ds -> d <-> vertical ds } block (o,s,c) = \ds -> case ds of { [] -> o<|>c ; [d] -> o<|>d<|>c ; d:ds -> (vertical ((o <|> d):[s <|> d | d <- ds ])) <-> c } -- Helper function indent :: Int -> ShowS indent = \n -> showString [ ' ' | i <- [1..n] ] hugs98-plus-Sep2006/packages/parsec/examples/Mondrian/Utils.hs0000644006511100651110000000272210504340255023040 0ustar rossross{- Copyright(C) 1999 Erik Meijer and Arjan van Yzendoorn Determines wether an express/declaration is "simple". The pretty-printing strategy is to print a "complex" expression on a new line. -} module Utils where import Mondrian isSimpleExpr :: Expr -> Bool isSimpleExpr = \e -> case e of { Lit l -> True ; Var n -> True ; Case e as -> and [ isSimpleArms as, isSimpleExpr e ] ; Let ds e -> and [ isSimpleDecls ds, isSimpleExpr e ] ; Lambda n e -> isSimpleExpr e ; New n ds -> all isSimpleDecl ds ; App f a -> and [ isSimpleExpr f, isSimpleExpr a] ; Chain e oes -> and [ isSimpleExpr e, all isSimpleExpr [ e | (o,e) <- oes ] ] } isSimpleArms = \as -> and [ length as == 1, all isSimpleExpr [ e | (p,e) <- as ], all isSimplePattern [ p | (p,e) <- as ] ] isSimplePattern = \ p-> case p of { Pattern n ds -> isSimpleDecls ds ; Default -> True } isSimpleDecls = \ds -> and [ all isSimpleDecl ds ] isSimpleDecl = \d -> case d of { ClassDecl n ns ds -> False ; ImportDecl n -> True ; VarDecl n e -> isSimpleExpr e ; SigDecl n e -> True } groupLambdas :: Expr -> Expr groupLambdas = \e -> case e of { Lambda ns (Lambda ms e) -> groupLambdas (Lambda (ns++ms) e) ; otherwise -> e } isTopLevel :: [Name] -> Name -> Bool isTopLevel = \topLevel -> \n -> n `elem` topLevel topLevel :: CompilationUnit -> [Name] topLevel = \p -> case p of { Package n ds -> [ n | VarDecl n e <- ds ] } hugs98-plus-Sep2006/packages/parsec/examples/Mondrian/test.m0000644006511100651110000000035710504340255022543 0ustar rossrosspackage Koe { Id =\x -> /* multi-line Comment_ */ x // the identity function ; K = \x -> \y_ -> x ;fac = \n -> case n of { n -> n ; n -> let { m = minus n 1 } in times n (fac m) } ; class Hi extends Mondrian { x = 2} } hugs98-plus-Sep2006/packages/parsec/examples/Mondrian/SimpleMondrianPrinter.hs0000644006511100651110000001131710504340255026225 0ustar rossross{- Copyright(C) 1999 Erik Meijer and Arjan van Yzendoorn -} module SimpleMondrianPrinter where import Mondrian import Pretty import Utils mondrianIndent :: Int mondrianIndent = 2 compilationUnit :: CompilationUnit -> Doc compilationUnit = \m -> case m of { Package n ds -> package m (name n) (decls ds) } package = \(Package n' ds') -> \n -> \ds -> case null ds' of { True -> text "package" <+> n <+> row ds ; False -> text "package" <+> n <-> nest (-mondrianIndent) (column ds) } decls = \ds -> [ decl d | d <- ds ] decl = \d -> case d of { ImportDecl ns -> importDecl d (name ns) ; ClassDecl n xs ds -> classDecl d (name n) (extends xs) (decls ds) ; SigDecl n t -> sigDecl (name n) (expr t) ; VarDecl v (Lambda ns e) -> varDecl d (name v) (lambdas ns) (expr e) ; VarDecl v e -> decl (VarDecl v (Lambda [] e)) } extends = \xs -> case xs of { [] -> empty ; [x] -> text "extends" <+> name x <+> empty ; xs -> text "multiple inheritance not supported" <+> row [name x | x <- xs] } classDecl = \(ClassDecl n' xs' ds') -> \n -> \xs -> \ds -> case ds' of { [] -> text "class" <+> n <+> xs ; otherwise -> text "class" <+> n <+> xs <-> column ds } sigDecl = \n -> \t -> n <+> text "::" <+> t importDecl = \d -> \n -> text "import" <+> n varDecl = \(VarDecl v' (Lambda ns' e')) -> \v -> \ns -> \e -> if isSimpleExpr e' then v <+> text "=" <+> ns <|> e else v <+> text "=" <+> ns <-> nest mondrianIndent e names = \ns -> horizontal (text " ") [ name n | n <- ns ] name = \ns -> horizontal (text ".") [text n | n <- ns] lambdas = \ns -> case ns of { [] -> empty ; [n] -> text "\\" <|> name n <+> text "->" <+> empty ; n:ns -> text "\\" <|> name n <+> text "->" <+> lambdas ns } expr = \e -> case e of { Lit l -> lit l ; Var n -> name n ; App f a -> application (expr f) (expr a) ; Lambda ns b -> lambdaExpr e (lambdas ns) (expr b) ; New n ds -> newExpr e (name n) (decls ds) ; Case e1 as -> caseExpr e (expr e1) (arms as) ; Let ds e1 -> letExpr e (decls ds) (expr e1) ; Chain e1 oes -> chain e1 oes } application = \f -> \a -> text "(" <|> f <+> a <|> text ")" newExpr = \(New n' ds') -> \n -> \ds -> case ds' of { [] -> text "new" <+> n ; otherwise -> if isSimpleDecls ds' then text "new" <+> n <+> row ds else text "new" <+> n <-> column ds } lambdaExpr = \(Lambda ns' e') -> \ns -> \e -> if isSimpleExpr e' then ns <|> e else ns <-> nest mondrianIndent e caseExpr :: Expr -> Doc -> [Doc] -> Doc caseExpr = \(Case e' as') -> \e -> \as -> case (isSimpleExpr e', isSimpleArms as') of { (True, True) -> text "case" <+> e <+> text "of" <+> row as ; (True, False)-> text "case" <+> e <+> text "of" <-> column as ; (False, True) -> text "case" <-> nest mondrianIndent e <-> text "of" <+> row as ; (False, False) -> text "case" <-> nest mondrianIndent e <-> text "of" <-> column as } letExpr = \(Let ds' e') -> \ds -> \e -> case (length ds' == 1 && isSimpleDecls ds', isSimpleExpr e') of { (True, True) -> text "let" <+> row ds <+> text "in" <+> e ; (True, False) -> text "let" <+> row ds <-> text "in" <-> nest mondrianIndent e ; (False, True) -> text "let" <-> column ds <-> text "in" <+> e ; (False, False) -> text "let" <-> column ds <-> text "in" <-> nest mondrianIndent e } arms = \as -> [ arm (p,e) (pattern p) (expr e) | (p,e) <- as ] arm = \(p',e') -> \p -> \e -> if isSimplePattern p' && isSimpleExpr e' then p <+> text "->" <+> e else p <+> text "->" <-> nest mondrianIndent e -- This is a dirty hack! chain = \e -> \oes -> case oes of { [] -> bracket e ; ([""],f):oes -> if (isSimpleExpr f) then (bracket e) <+> chain f oes else (bracket e) <-> nest 2 (chain f oes) ; (o,f):oes -> if (isSimpleExpr f) then (bracket e) <+> name o <+> chain f oes else (bracket e) <-> name o <+> chain f oes } pattern = \p -> case p of { Pattern n ds -> case ds of { [] -> name n ; otherwise -> name n <+> row (decls ds) } ; Default -> text "default" } lit = \l -> case l of { IntLit i -> text (show i) ; CharLit c -> text (show c) ; StringLit s -> text (show s) } bracket = \e -> case e of { Lit l -> expr e ; Var n -> expr e ; e -> par (expr e) } par = \e -> text "(" <|> e <|> text ")" column = \ds -> nest mondrianIndent (block (text "{ ", text ";" <+> empty, text "}") ds) row = \ds -> text "{" <|> horizontal (text ";" <+> empty) ds <|> text "}"hugs98-plus-Sep2006/packages/parsec/examples/Makefile0000644006511100651110000000060310504340255021271 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- ifeq "$(way)" "" SUBDIRS = Henk Mondrian UserGuide tiger while endif # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/parsec/examples/UserGuide/0000755006511100651110000000000010504340255021526 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/examples/UserGuide/Main.hs0000644006511100651110000001107210504340255022747 0ustar rossross----------------------------------------------------------- -- Daan Leijen (c) 2000, daan@cs.uu.nl ----------------------------------------------------------- module Main where import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Expr import Text.ParserCombinators.Parsec.Token import Text.ParserCombinators.Parsec.Language ----------------------------------------------------------- -- ----------------------------------------------------------- run :: Show a => Parser a -> String -> IO () run p input = case (parse p "" input) of Left err -> do{ putStr "parse error at " ; print err } Right x -> print x runLex :: Show a => Parser a -> String -> IO () runLex p = run (do{ whiteSpace lang ; x <- p ; eof ; return x } ) ----------------------------------------------------------- -- Sequence and choice ----------------------------------------------------------- simple :: Parser Char simple = letter openClose :: Parser Char openClose = do{ char '(' ; char ')' } matching:: Parser () matching= do{ char '(' ; matching ; char ')' ; matching } <|> return () -- Predictive parsing testOr = do{ char '('; char 'a'; char ')' } <|> do{ char '('; char 'b'; char ')' } testOr1 = do{ char '(' ; char 'a' <|> char 'b' ; char ')' } testOr2 = try (do{ char '('; char 'a'; char ')' }) <|> do{ char '('; char 'b'; char ')' } -- Semantics nesting :: Parser Int nesting = do{ char '(' ; n <- nesting ; char ')' ; m <- nesting ; return (max (n+1) m) } <|> return 0 word1 :: Parser String word1 = do{ c <- letter ; do{ cs <- word1 ; return (c:cs) } <|> return [c] } ----------------------------------------------------------- -- ----------------------------------------------------------- word :: Parser String word = many1 (letter "") "word" sentence :: Parser [String] sentence = do{ words <- sepBy1 word separator ; oneOf ".?!" "end of sentence" ; return words } separator :: Parser () separator = skipMany1 (space <|> char ',' "") ----------------------------------------------------------- -- Tokens ----------------------------------------------------------- lang = makeTokenParser (haskellStyle{ reservedNames = ["return","total"]}) ----------------------------------------------------------- -- ----------------------------------------------------------- expr = buildExpressionParser table factor "expression" table = [[op "*" (*) AssocLeft, op "/" div AssocLeft] ,[op "+" (+) AssocLeft, op "-" (-) AssocLeft] ] where op s f assoc = Infix (do{ symbol lang s; return f} "operator") assoc factor = parens lang expr <|> natural lang "simple expression" test1 = do{ n <- natural lang ; do{ symbol lang "+" ; m <- natural lang ; return (n+m) } <|> return n } ----------------------------------------------------------- -- ----------------------------------------------------------- {- receipt ::= product* total product ::= "return" price ";" | identifier price ";" total ::= price "total" price ::= natural "." digit digit -} receipt :: Parser Bool receipt = do{ ps <- many produkt ; p <- total ; return (sum ps == p) } produkt = do{ reserved lang "return" ; p <- price ; semi lang ; return (-p) } <|> do{ identifier lang ; p <- price ; semi lang ; return p } "product" total = do{ p <- price ; reserved lang "total" ; return p } price :: Parser Int price = lexeme lang ( do{ ds1 <- many1 digit ; char '.' ; ds2 <- count 2 digit ; return (convert 0 (ds1 ++ ds2)) }) "price" where convert n [] = n convert n (d:ds) = convert (10*n + digitToInt d) ds digitToInt :: Char -> Int digitToInt d = fromEnum d - fromEnum '0' main :: IO () main = putStrLn "I'm only a dummy..." hugs98-plus-Sep2006/packages/parsec/examples/UserGuide/Makefile0000644006511100651110000000067610504340255023177 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- HS_PROG = UserGuide$(exeext) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -package parsec # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/parsec/examples/tiger/0000755006511100651110000000000010504340255020744 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/examples/tiger/Main.hs0000644006511100651110000000050410504340255022163 0ustar rossross{--------------------------------------------------------------- Daan Leijen (c) 2001. daan@cs.uu.nl $Revision: 1.1 $ $Author: ross $ $Date: 2003/07/31 17:45:35 $ ---------------------------------------------------------------} module Main where import Tiger( prettyTigerFromFile ) main = prettyTigerFromFile "fac.tig" hugs98-plus-Sep2006/packages/parsec/examples/tiger/Makefile0000644006511100651110000000067210504340255022411 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- HS_PROG = tiger$(exeext) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -package parsec # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/parsec/examples/tiger/Tiger.hs0000644006511100651110000002540210504340255022355 0ustar rossross------------------------------------------------------------- -- Parser for Tiger from Appel's book on compilers. -- Semantic checks have been omitted for now. -- Scope rules and such are as a consequence not implemented. ------------------------------------------------------------- module Tiger( prettyTigerFromFile ) where import TigerAS import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Expr import qualified Text.ParserCombinators.Parsec.Token as P import Text.ParserCombinators.Parsec.Language( javaStyle ) prettyTigerFromFile fname = do{ input <- readFile fname ; putStr input ; case parse program fname input of Left err -> do{ putStr "parse error at " ; print err } Right x -> print x } {- main = do putStr "Parsec Tiger parser\n" putStr "Type filename (without suffix): " basename <- getLine tokens <- scanner False keywordstxt keywordsops specialchars opchars (basename ++ ".sl") Nothing let ((exprpp,proof), errors) = parse pRoot tokens putStr (if null errors then "" else "Errors:\n" ++ errors) putStr ("Result:\n" ++ (disp exprpp 140 "")) writeFile (basename ++ ".tex") (disp proof 500 "") putStr ("\nGenerated proof in file " ++ (basename ++ ".tex")) -} ----------------------------------------------------------- -- A program is simply an expression. ----------------------------------------------------------- program = do{ whiteSpace ; e <- expr ; return e } ---------------------------------------------------------------- -- Declarations for types, identifiers and functions ---------------------------------------------------------------- decs = many dec dec = tydec <|> vardec <|> fundec ---------------------------------------------------------------- -- Type declarations -- int and string are predefined, but not reserved. ---------------------------------------------------------------- tydec :: Parser Declaration tydec = do{ reserved "type" ; tid <- identifier ; symbol "=" ; t <- ty ; return (TypeDec tid t) } ty = do{ fields <- braces tyfields ; return (Record fields) } <|> do{ reserved "array" ; reserved "of" ; tid <- identifier ; return (Array tid) } <|> do{ id <- identifier ; return (Var id) } tyfields = commaSep field noType = "*" voidType = "void" field = do{ id <- identifier ; symbol ":" ; tid <- identifier ; return (TypedVar id tid) } ---------------------------------------------------------------- -- identifier declarations -- Lacks: 11, 12 ---------------------------------------------------------------- vardec = do{ reserved "var" ; id <- identifier ; t <- option noType (try (do{ symbol ":" ; identifier })) ; symbol ":=" ; e <- expr ; return (VarDec id t e) } ---------------------------------------------------------------- -- Function declarations ---------------------------------------------------------------- fundec = do{ reserved "function" ; name <- identifier ; parms <- parens tyfields ; rettype <- option voidType (do{ symbol ":" ; identifier }) ; symbol "=" ; body <- expr ; return (FunDec name parms rettype body) } ---------------------------------------------------------------- -- Lvalues -- This may not be what we want. I parse lvalues as -- a list of dot separated array indexings (where the indexing) -- may be absent. Possibly, we'd want the . and [] ---------------------------------------------------------------- -- This combinator does ab* in a leftassociative way. -- Applicable when you have a cfg rule with left recursion -- which you might rewrite into EBNF X -> YZ*. lfact :: Parser a -> Parser (a -> a) -> Parser a lfact p q = do{ a <- p ; fs <- many q ; return (foldl (\x f -> f x) a fs) } {- chainl op expr = lfact expr (do { o <- op ; e <- expr ; return (`o` e) }) -} lvalue = lfact variable (recordref <|> subscripted) recordref = do{ symbol "." ; id <- variable ; return (\x -> Dot x id) } subscripted = do{ indexexpr <- brackets expr ; return (\x -> Sub x indexexpr) } {- Alternatively (an lvalue is then a sequence of, possibly (mutli-)indexed, identifiers separated by dots) lvalue :: Parser Expr lvalue = do{ flds <- sepBy1 subscripted (symbol ".") ; return (if length flds < 2 then head flds else Dots flds) } subscripted :: Parser Expr subscripted = do{ id <- identifier ; indexes <- many (brackets expr) ; return (if null indexes then Ident id else Subscripted id indexes) } -} ---------------------------------------------------------------- -- All types of expression(s) ---------------------------------------------------------------- exprs = many expr expr :: Parser Expr expr = choice [ do{ reserved "break" ; return Break } , ifExpr , whileExpr , forExpr , letExpr , sequenceExpr , infixExpr -- , sequenceExpr -- I am not sure about this one. ] recordExpr :: Parser Expr recordExpr = do{ tid <- identifier ; symbol "{" ; fields <- commaSep1 fieldAssign ; symbol "}" ; return (RecordVal tid fields) } fieldAssign :: Parser AssignField fieldAssign = do{ id <- identifier ; symbol "=" ; e <- expr ; return (AssignField id e) } arrayExpr :: Parser Expr arrayExpr = do{ tid <- identifier ; size <- brackets expr ; reserved "of" ; initvalue <- expr ; return (ArrayVal tid size initvalue) } assignExpr :: Parser Expr assignExpr = do{ lv <- lvalue ; symbol ":=" ; e <- expr ; return (Assign lv e) } ifExpr :: Parser Expr ifExpr = do{ reserved "if" ; cond <- expr ; reserved "then" ; thenpart <- expr ; elsepart <- option Skip (do{ reserved "else"; expr}) ; return (If cond thenpart elsepart) } whileExpr :: Parser Expr whileExpr = do{ reserved "while" ; cond <- expr ; reserved "do" ; body <- expr ; return (While cond body) } forExpr :: Parser Expr forExpr = do{ reserved "for" ; id <- identifier ; symbol ":=" ; lowerbound <- expr ; reserved "to" ; upperbound <- expr ; reserved "do" ; body <- expr ; return (For id lowerbound upperbound body) } letExpr :: Parser Expr letExpr = do{ reserved "let" ; ds <- decs ; reserved "in" ; es <- semiSep expr ; reserved "end" ; return (Let ds es) } sequenceExpr :: Parser Expr sequenceExpr = do{ exps <- parens (semiSep1 expr) ; return (if length exps < 2 then head exps else Seq exps) } infixExpr :: Parser Expr infixExpr = buildExpressionParser operators simpleExpr operators = [ [ prefix "-"] , [ op "*" AssocLeft, op "/" AssocLeft ] , [ op "+" AssocLeft, op "-" AssocLeft ] , [ op "=" AssocNone, op "<>" AssocNone, op "<=" AssocNone , op "<" AssocNone, op ">=" AssocNone, op ">" AssocNone ] , [ op "&" AssocRight ] -- Right for shortcircuiting , [ op "|" AssocRight ] -- Right for shortcircuiting , [ op ":=" AssocRight ] ] where op name assoc = Infix (do{ reservedOp name ; return (\x y -> Op name x y) }) assoc prefix name = Prefix (do{ reservedOp name ; return (\x -> UnOp name x) }) simpleExpr = choice [ do{ reserved "nil" ; return Nil } , intLiteral , strLiteral , parens expr , try funCallExpr , try recordExpr , try arrayExpr , lvalue ] funCallExpr = do{ id <- identifier ; parms <- parens (commaSep expr) ; return (Apply id parms) } intLiteral = do{ i <- integer; return (IntLit i) } strLiteral = do{ s <- stringLiteral; return (StringLit s) } variable = do{ id <- identifier ; return (Ident id) } ----------------------------------------------------------- -- The lexer ----------------------------------------------------------- lexer = P.makeTokenParser tigerDef tigerDef = javaStyle { -- Kept the Java single line comments, but officially the language has no comments P.reservedNames = [ "array", "break", "do", "else", "end", "for", "function", "if", "in", "let", "nil", "of", "then", "to", "type", "var", "while" ] , P.reservedOpNames= [ "<", "<=", ">", ">=", ":=", "+", "&", "-", "/"] , P.opLetter = oneOf (concat (P.reservedOpNames tigerDef)) , P.caseSensitive = True } parens = P.parens lexer braces = P.braces lexer semiSep = P.semiSep lexer semiSep1 = P.semiSep1 lexer commaSep = P.commaSep lexer commaSep1 = P.commaSep1 lexer brackets = P.brackets lexer whiteSpace = P.whiteSpace lexer symbol = P.symbol lexer identifier = P.identifier lexer reserved = P.reserved lexer reservedOp = P.reservedOp lexer integer = P.integer lexer charLiteral = P.charLiteral lexer stringLiteral = P.stringLiteral lexer hugs98-plus-Sep2006/packages/parsec/examples/tiger/TigerAS.hs0000644006511100651110000000156510504340255022605 0ustar rossrossmodule TigerAS where type VarIdent = String type TypeIdent = String data Declaration = TypeDec TypeIdent Type | VarDec VarIdent TypeIdent Expr | FunDec VarIdent [TypedVar] TypeIdent Expr deriving (Eq, Show) data TypedVar = TypedVar VarIdent TypeIdent deriving (Eq, Show) data Type = Var TypeIdent | Array TypeIdent | Record [TypedVar] deriving (Eq, Show) data Expr = Sub Expr Expr | Dot Expr Expr | Apply VarIdent [Expr] | Ident TypeIdent | RecordVal TypeIdent [AssignField] | ArrayVal TypeIdent Expr Expr | IntLit Integer | StringLit String | While Expr Expr | For VarIdent Expr Expr Expr | If Expr Expr Expr | Let [Declaration] [Expr] | Assign Expr Expr | Op String Expr Expr | UnOp String Expr | Skip | Nil | Break | Seq [Expr] deriving (Show, Eq) data AssignField = AssignField VarIdent Expr deriving (Eq, Show) hugs98-plus-Sep2006/packages/parsec/examples/tiger/fac.tig0000644006511100651110000000014210504340255022177 0ustar rossrosslet function fact(n : int) : int = if n < 1 then 1 else (n * fact(n - 1)) in fact(10) end hugs98-plus-Sep2006/packages/parsec/examples/tiger/matrix.tig0000644006511100651110000000604310504340255022760 0ustar rossrosslet type vec = array of int type vector = {dim : int, d : vec} type mat = array of vector type matrix = {x : int, y : int, d : mat} function vectorCreate(n : int) : vector = vector{dim = n, d = vec[n] of 0} function vectorLiftedAdd(X : vector, Y : vector) : vector = let var tmp : vector := vectorCreate(X.dim) in for i := 0 to X.dim do tmp.d[i] := X.d[i] + Y.d[i]; tmp end function vectorLiftedMul(X : vector, Y : vector) : vector = let var tmp : vector := vectorCreate(X.dim) in for i := 0 to X.dim do tmp.d[i] := X.d[i] * Y.d[i]; tmp end function vectorInProduct(X : vector, Y : vector) : int = let var tmp : int := 0 in for i := 0 to X.dim do tmp := tmp + X.d[i] * Y.d[i]; tmp end function matrixCreate(n : int, m : int) : matrix = let var tmp := matrix{x = n, y = m, d = mat[n] of nil} in for i := 0 to n do tmp.d[i] := vectorCreate(m); tmp end function matrixRow(A : matrix, i : int) : vector = A.d[i] function matrixCol(A : matrix, j : int) : vector = let var tmp := vectorCreate(A.y) in for i := 0 to A.y do tmp.d[i] := A.d[i].d[j]; tmp end function matrixTranspose(A : matrix) : matrix = let var tmp := matrixCreate(A.y, A.x) in for i := 0 to A.x do for j := 0 to A.y do tmp.d[j].d[i] := A.d[i].d[j]; tmp end function matrixLiftedAdd(A : matrix, B : matrix) : matrix = let var tmp := matrixCreate(A.x, A.y) in if A.x <> B.x | A.y <> B.y then exit(1) else for i := 0 to A.x do for j := 0 to A.y do tmp.d[i].d[j] := A.d[i].d[j] + B.d[i].d[j]; tmp end function matrixLiftedMul(A : matrix, B : matrix) : matrix = let var tmp := matrixCreate(A.x, A.y) in if A.x <> B.x | A.y <> B.y then exit(1) else for i := 0 to A.x do for j := 0 to A.y do tmp.d[i].d[j] := A.d[i].d[j] * B.d[i].d[j]; tmp end function matrixMul(A : matrix, B : matrix) : matrix = let var tmp := matrixCreate(A.x, B.y) in if A.y <> B.x then exit(1) else for i := 0 to A.x do for j := 0 to B.y do tmp.d[i].d[j] := vectorInProduct(matrixRow(A,i), matrixCol(B,j)); tmp end function createDiagMat(X : vector) : matrix = let var tmp := matrixCreate(X.dim, X.dim) in for i := 0 to X.dim do tmp.d[i].d[i] := X.d[i]; tmp end /* matrixMul(A, B) where B is a diagonal matrix, which can be represented by a vector */ function matrixMulDiag(A : matrix, X : vector) : matrix = let var tmp := matrixCreate(A.x, A.y) in if A.y <> X.dim then exit(1) else for i := 0 to A.x do for j := 0 to A.y do tmp.d[i].d[j] := A.d[i].d[j] * X.d[j]; tmp end /* Challenge: matrixMul(A, createDiagMat(X)) == matrixMulDiag(A, X) i.e., derive the rhs from the lhs by specialization What are the laws involved? Challenge: matrixMul(A, create5shapeMatrix(a,b,c,d,e)) == efficient algorithm */ in /* matrixLiftedAdd(matrixCreate(8),matrixCreate(8)) */ matrixMul(A, createDiagMat(X)) endhugs98-plus-Sep2006/packages/parsec/examples/tiger/merge.tig0000644006511100651110000000253310504340255022553 0ustar rossrosslet type any = {any : int} var buffer := getchar() function readint(any: any) : int = let var i := 0 function isdigit(s : string) : int = ord(buffer)>=ord("0") & ord(buffer)<=ord("9") function skipto() = while buffer=" " | buffer="\n" do buffer := getchar() in skipto(); any.any := isdigit(buffer); while isdigit(buffer) do (i := i*10+ord(buffer)-ord("0"); buffer := getchar()); i end type list = {first: int, rest: list} function readlist() : list = let var any := any{any=0} var i := readint(any) in if any.any then list{first=i,rest=readlist()} else nil end function merge(a: list, b: list) : list = if a=nil then b else if b=nil then a else if a.first < b.first then list{first=a.first,rest=merge(a.rest,b)} else list{first=b.first,rest=merge(a,b.rest)} function printint(i: int) = let function f(i:int) = if i>0 then (f(i/10); print(chr(i-i/10*10+ord("0")))) in if i<0 then (print("-"); f(-i)) else if i>0 then f(i) else print("0") end function printlist(l: list) = if l=nil then print("\n") else (printint(l.first); print(" "); printlist(l.rest)) var list1 := readlist() var list2 := (buffer:=getchar(); readlist()) /* BODY OF MAIN PROGRAM */ in printlist(merge(list1,list2)) end hugs98-plus-Sep2006/packages/parsec/examples/tiger/queens.tig0000644006511100651110000000133210504340255022750 0ustar rossross/* A program to solve the 8-queens problem */ let var N := 8 type intArray = array of int var row := intArray [ N ] of 0 var col := intArray [ N ] of 0 var diag1 := intArray [N+N-1] of 0 var diag2 := intArray [N+N-1] of 0 function printboard() = (for i := 0 to N-1 do (for j := 0 to N-1 do print(if col[i]=j then " O" else " ."); print("\n")); print("\n")) function try(c:int) = ( if c=N then printboard() else for r := 0 to N-1 do if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 then (row[r]:=1; diag1[r+c]:=1; diag2[r+7-c]:=1; col[c]:=r; try(c+1); row[r]:=0; diag1[r+c]:=0; diag2[r+7-c]:=0) ) in try(0) end hugs98-plus-Sep2006/packages/parsec/examples/while/0000755006511100651110000000000010504340255020742 5ustar rossrosshugs98-plus-Sep2006/packages/parsec/examples/while/Main.hs0000644006511100651110000000050310504340255022160 0ustar rossross{--------------------------------------------------------------- Daan Leijen (c) 2001. daan@cs.uu.nl $Revision: 1.1 $ $Author: ross $ $Date: 2003/07/31 17:45:36 $ ---------------------------------------------------------------} module Main where import While( prettyWhileFromFile ) main = prettyWhileFromFile "fib.wh" hugs98-plus-Sep2006/packages/parsec/examples/while/Makefile0000644006511100651110000000067210504340255022407 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- HS_PROG = while$(exeext) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -package parsec # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/parsec/examples/while/While.hs0000644006511100651110000001351610504340255022354 0ustar rossross------------------------------------------------------------- -- Parser for WHILE from Nielson, Nielson and Hankin -- and various other sources. ------------------------------------------------------------- module While( prettyWhileFromFile ) where import WhileAS import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Expr import qualified Text.ParserCombinators.Parsec.Token as P import Text.ParserCombinators.Parsec.Language( javaStyle ) prettyWhileFromFile fname = do{ input <- readFile fname ; putStr input ; case parse program fname input of Left err -> do{ putStr "parse error at " ; print err } Right x -> print x } --renum :: Prog -> Prog --renum p = rn (1,p) --rn :: (Int, Stat) -> (Int, Stat) --rn (x,s) = case s of -- Assign vi ae _ -> (x+1,Assign vi ae x) -- Skip _ -> (x+1, Skip x) -- Seq [Stat] -> -- If be _ s1 s2 -> do{ (newx, newthen) <- rn (x+1,s1) -- ; (newerx, newelse) <- rn (newx,s2) -- ; return (newerx, If be x newthen newelse) -- } -- While be _ s -> do{ (newx, news) <- rn (x+1,s) -- ; return (newx, While be x+1 news) -- } ----------------------------------------------------------- -- A program is simply an expression. ----------------------------------------------------------- program = do{ stats <- semiSep1 stat ; return (if length stats < 2 then head stats else Seq stats) } stat :: Parser Stat stat = choice [ do { reserved "skip"; return (Skip 0) } , ifStat , whileStat , sequenceStat , try assignStat ] assignStat :: Parser Stat assignStat = do{ id <- identifier ; symbol ":=" ; s <- aritExpr ; return (Assign id s 0) } ifStat :: Parser Stat ifStat = do{ reserved "if" ; cond <- boolExpr ; reserved "then" ; thenpart <- stat ; reserved "else" ; elsepart <- stat ; return (If cond 0 thenpart elsepart) } whileStat :: Parser Stat whileStat = do{ reserved "while" ; cond <- boolExpr ; reserved "do" ; body <- stat ; return (While cond 0 body) } sequenceStat :: Parser Stat sequenceStat = do{ stats <- parens (semiSep1 stat) ; return (if length stats < 2 then head stats else Seq stats) } boolExpr:: Parser BExp boolExpr = buildExpressionParser boolOperators relExpr relExpr :: Parser BExp relExpr = do{ arg1 <- aritExpr ; op <- choice [string "=", try (string "<>"), try (string "<="), string "<", try (string ">="), string ">"] ; arg2 <- aritExpr ; return (RelOp op arg1 arg2) } aritExpr :: Parser AExp aritExpr = buildExpressionParser aritOperators simpleArit -- Everything mapping bools to bools boolOperators = [ [ prefix "not"] , [ opbb "and" AssocRight ] -- right for shortcircuit , [ opbb "or" AssocRight ] -- right for shortcircuit ] where opbb name assoc = Infix (do{ reservedOp name ; return (\x y -> BOp name x y) }) assoc prefix name = Prefix (do{ reservedOp name ; return (\x -> BUnOp name x) }) -- Everything mapping pairs of ints to ints aritOperators = [ [ op "*" AssocLeft, op "/" AssocLeft ] , [ op "+" AssocLeft, op "-" AssocLeft ] , [ op "&" AssocRight ] -- bitwise and delivering an int , [ op "|" AssocRight ] -- bitwise or delivering an int ] where op name assoc = Infix (do{ reservedOp name ; return (\x y -> AOp name x y) }) assoc simpleArit = choice [ intLiteral , parens aritExpr , variable ] simpleBool = choice [ boolLiteral , parens boolExpr ] boolLiteral = do{ reserved "false" ; return (BoolLit True) } <|> do{ reserved "true" ; return (BoolLit False) } intLiteral = do{ i <- integer; return (IntLit i) } variable = do{ id <- identifier ; return (Var id) } ----------------------------------------------------------- -- The lexer ----------------------------------------------------------- lexer = P.makeTokenParser whileDef whileDef = javaStyle { -- Kept the Java single line comments, but officially the language has no comments P.reservedNames = [ "true", "false", "do", "else", "not", "if", "then", "while", "skip" -- , "begin", "proc", "is", "end", "val", "res", "malloc" ] , P.reservedOpNames= [ "and", "or", "not", "<", "<=", ">", ">=", ":=", "+", "&", "-", "/"] , P.opLetter = oneOf (concat (P.reservedOpNames whileDef)) , P.caseSensitive = False } parens = P.parens lexer braces = P.braces lexer semiSep1 = P.semiSep1 lexer whiteSpace = P.whiteSpace lexer symbol = P.symbol lexer identifier = P.identifier lexer reserved = P.reserved lexer reservedOp = P.reservedOp lexer integer = P.integer lexer charLiteral = P.charLiteral lexer stringLiteral = P.stringLiteral lexer hugs98-plus-Sep2006/packages/parsec/examples/while/WhileAS.hs0000644006511100651110000000154710504340255022601 0ustar rossrossmodule WhileAS where type VarIdent = String type Label = Int -- type Selector = String type Prog = Stat -- type Prog = Prog [Dec] [Stat] -- Contains name, a list of input vars, output var, body respectively and of course -- the two labels ln and lx data Dec = Proc [VarIdent] VarIdent VarIdent Label Stat Label data AExp = Var VarIdent | IntLit Integer | AOp String AExp AExp -- | Var VarIdent (Maybe Selector) -- | Nil | Dummy deriving (Eq, Show) data BExp = BUnOp String BExp | BoolLit Bool | BOp String BExp BExp | RelOp String AExp AExp -- | POp VarIdent (Maybe Selector) deriving (Eq, Show) data Stat = Assign VarIdent AExp Label | Skip Label | Seq [Stat] | If BExp Label Stat Stat | While BExp Label Stat -- | Call VarIdent [AExp] VarIdent Label Label -- | Malloc VarIdent (Maybe Selector) Label deriving (Show, Eq) hugs98-plus-Sep2006/packages/parsec/examples/while/fac.wh0000644006511100651110000000006710504340255022036 0ustar rossrossy := x; z := 1; while y>1 do (z := z*y; y:=y-1); y:=0 hugs98-plus-Sep2006/packages/parsec/examples/while/fib.wh0000644006511100651110000000016710504340255022046 0ustar rossrossv := 1; u := 1; if n <= 2 then skip else while n > 2 do ( t := u; u := v; v := u + t ) hugs98-plus-Sep2006/packages/parsec/package.conf.in0000644006511100651110000000136010504340255020663 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: daan@cs.uu.nl exposed: True exposed-modules: Text.ParserCombinators.Parsec.Error, Text.ParserCombinators.Parsec.Char, Text.ParserCombinators.Parsec.Combinator, Text.ParserCombinators.Parsec.Expr, Text.ParserCombinators.Parsec.Language, Text.ParserCombinators.Parsec.Perm, Text.ParserCombinators.Parsec.Pos, Text.ParserCombinators.Parsec.Prim, Text.ParserCombinators.Parsec.Token, Text.ParserCombinators.Parsec hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSparsec" extra-libraries: include-dirs: includes: depends: base hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/parsec/parsec.cabal0000644006511100651110000000155510504340255020263 0ustar rossrossname: parsec version: 2.0 license: BSD3 license-file: LICENSE author: Daan Leijen maintainer: Daan Leijen homepage: http://www.cs.uu.nl/~daan/parsec.html category: Parsing synopsis: Monadic parser combinators description: Parsec is designed from scratch as an industrial-strength parser library. It is simple, safe, well documented (on the package homepage), has extensive libraries and good error messages, and is also fast. exposed-modules: Text.ParserCombinators.Parsec.Error, Text.ParserCombinators.Parsec.Char, Text.ParserCombinators.Parsec.Combinator, Text.ParserCombinators.Parsec.Expr, Text.ParserCombinators.Parsec.Language, Text.ParserCombinators.Parsec.Perm, Text.ParserCombinators.Parsec.Pos, Text.ParserCombinators.Parsec.Prim, Text.ParserCombinators.Parsec.Token, Text.ParserCombinators.Parsec build-depends: base hugs98-plus-Sep2006/packages/parsec/prologue.txt0000644006511100651110000000047310504340255020415 0ustar rossrossA monadic parser combinator library, written by Daan Leijen. Parsec is designed from scratch as an industrial-strength parser library. It is simple, safe, well documented, has extensive libraries and good error messages, and is also fast. More documentation can be found on: hugs98-plus-Sep2006/packages/QuickCheck/0000755006511100651110000000000010504340573016554 5ustar rossrosshugs98-plus-Sep2006/packages/QuickCheck/Debug/0000755006511100651110000000000010504340262017575 5ustar rossrosshugs98-plus-Sep2006/packages/QuickCheck/Debug/QuickCheck/0000755006511100651110000000000010504340262021607 5ustar rossrosshugs98-plus-Sep2006/packages/QuickCheck/Debug/QuickCheck/Batch.hs0000644006511100651110000000126210504340262023165 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Debug.QuickCheck.Batch -- Copyright : (c) Andy Gill 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : deprecated -- Portability : non-portable (uses Control.Exception, Control.Concurrent) -- -- This is a batch driver for running QuickCheck (GHC only). -- ----------------------------------------------------------------------------- module Debug.QuickCheck.Batch {-# DEPRECATED "Use module Test.QuickCheck.Batch instead" #-} ( module Test.QuickCheck.Batch ) where import Test.QuickCheck.Batch hugs98-plus-Sep2006/packages/QuickCheck/Debug/QuickCheck/Poly.hs0000644006511100651110000000107210504340262023066 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Debug.QuickCheck.Poly -- Copyright : (c) Andy Gill 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : deprecated -- Portability : portable -- ----------------------------------------------------------------------------- module Debug.QuickCheck.Poly {-# DEPRECATED "Use module Test.QuickCheck.Poly instead" #-} ( module Test.QuickCheck.Poly ) where import Test.QuickCheck.Poly hugs98-plus-Sep2006/packages/QuickCheck/Debug/QuickCheck/Utils.hs0000644006511100651110000000120710504340262023243 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Debug.QuickCheck.Utils -- Copyright : (c) Andy Gill 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : deprecated -- Portability : portable -- -- These are some general purpose utilities for use with QuickCheck. -- ----------------------------------------------------------------------------- module Debug.QuickCheck.Utils {-# DEPRECATED "Use module Test.QuickCheck.Utils instead" #-} ( module Test.QuickCheck.Utils ) where import Test.QuickCheck.Utils hugs98-plus-Sep2006/packages/QuickCheck/Debug/QuickCheck.hs0000644006511100651110000000113610504340262022144 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Debug.QuickCheck -- Copyright : (c) Koen Claessen, John Hughes 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : deprecated -- Portability : portable -- -- implementation moved to Test.QuickCheck ----------------------------------------------------------------------------- module Debug.QuickCheck {-# DEPRECATED "Use module Test.QuickCheck instead" #-} ( module Test.QuickCheck ) where import Test.QuickCheck hugs98-plus-Sep2006/packages/QuickCheck/Makefile.inc0000644006511100651110000000022310504340262020754 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/QuickCheck/LICENSE0000644006511100651110000000311310504340262017552 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/QuickCheck/Makefile0000644006511100651110000000042510504340262020210 0ustar rossrossTOP=.. include $(TOP)/mk/boilerplate.mk SUBDIRS = ALL_DIRS = \ Test Test/QuickCheck \ Debug Debug/QuickCheck PACKAGE = QuickCheck VERSION = 1.0 PACKAGE_DEPS = base SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/QuickCheck/QuickCheck.cabal0000644006511100651110000000175410504340262021554 0ustar rossrossname: QuickCheck version: 1.0 license: BSD3 license-file: LICENSE author: Koen Classen and John Hughes maintainer: libraries@haskell.org category: Testing homepage: http://www.math.chalmers.se/~rjmh/QuickCheck/ synopsis: Automatic testing of Haskell programs description: A library for testing Haskell programs automatically. The programmer provides a specification of the program, in the form of properties which functions should satisfy, and QuickCheck then tests that the properties hold in a large number of randomly generated cases. Specifications are expressed in Haskell, using combinators defined in the QuickCheck library. QuickCheck provides combinators to define properties, observe the distribution of test data, and define test data generators. exposed-modules: Debug.QuickCheck.Batch, Debug.QuickCheck.Poly, Debug.QuickCheck.Utils, Debug.QuickCheck, Test.QuickCheck.Batch, Test.QuickCheck.Poly, Test.QuickCheck.Utils, Test.QuickCheck build-depends: base extensions: CPP hugs98-plus-Sep2006/packages/QuickCheck/Makefile.nhc980000644006511100651110000000062110504340262021136 0ustar rossrossTHISPKG = QuickCheck SEARCH = -package base SRCS = \ Test/QuickCheck.hs \ Test/QuickCheck/Poly.hs Test/QuickCheck/Utils.hs \ Debug/QuickCheck.hs \ Debug/QuickCheck/Poly.hs Debug/QuickCheck/Utils.hs # Test/QuickCheck/Batch.hs \ # Debug/QuickCheck/Batch.hs \ # Here are the main rules. include ../Makefile.common # some extra rules # Here are any extra dependencies. # C-files dependencies. hugs98-plus-Sep2006/packages/QuickCheck/Test/0000755006511100651110000000000010504340262017466 5ustar rossrosshugs98-plus-Sep2006/packages/QuickCheck/Test/QuickCheck/0000755006511100651110000000000010504340262021500 5ustar rossrosshugs98-plus-Sep2006/packages/QuickCheck/Test/QuickCheck/Batch.hs0000644006511100651110000001722010504340262023057 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Test.QuickCheck.Batch -- Copyright : (c) Andy Gill 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Control.Exception, Control.Concurrent) -- -- A batch driver for running QuickCheck. -- -- /Note:/ in GHC only, it is possible to place a time limit on each test, -- to ensure that testing terminates. -- ----------------------------------------------------------------------------- {- - Here is the key for reading the output. - . = test successful - ? = every example passed, but quickcheck did not find enough good examples - * = test aborted for some reason (out-of-time, bottom, etc) - # = test failed outright - - We also provide the dangerous "isBottom". - - Here is is an example of use for sorting: - - testOptions :: TestOptions - testOptions = TestOptions - { no_of_tests = 100 -- number of tests to run - , length_of_tests = 1 -- 1 second max per check - -- where a check == n tests - , debug_tests = False -- True => debugging info - } - - prop_sort1 xs = sort xs == sortBy compare xs - where types = (xs :: [OrdALPHA]) - prop_sort2 xs = - (not (null xs)) ==> - (head (sort xs) == minimum xs) - where types = (xs :: [OrdALPHA]) - prop_sort3 xs = (not (null xs)) ==> - last (sort xs) == maximum xs - where types = (xs :: [OrdALPHA]) - prop_sort4 xs ys = - (not (null xs)) ==> - (not (null ys)) ==> - (head (sort (xs ++ ys)) == min (minimum xs) (minimum ys)) - where types = (xs :: [OrdALPHA], ys :: [OrdALPHA]) - prop_sort6 xs ys = - (not (null xs)) ==> - (not (null ys)) ==> - (last (sort (xs ++ ys)) == max (maximum xs) (maximum ys)) - where types = (xs :: [OrdALPHA], ys :: [OrdALPHA]) - prop_sort5 xs ys = - (not (null xs)) ==> - (not (null ys)) ==> - (head (sort (xs ++ ys)) == max (maximum xs) (maximum ys)) - where types = (xs :: [OrdALPHA], ys :: [OrdALPHA]) - - test_sort = runTests "sort" testOptions - [ run prop_sort1 - , run prop_sort2 - , run prop_sort3 - , run prop_sort4 - , run prop_sort5 - ] - - When run, this gives - Main> test_sort - sort : ..... - - You would tie together all the test_* functions - into one test_everything, on a per module basis. - -} module Test.QuickCheck.Batch ( run -- :: Testable a => a -> TestOptions -> IO TestResult , runTests -- :: String -> TestOptions -> -- [TestOptions -> IO TestResult] -> IO () , defOpt -- :: TestOptions , TestOptions (..) , TestResult (..) , isBottom -- :: a -> Bool , bottom -- :: a {- _|_ -} ) where import Prelude import System.Random #ifdef __GLASGOW_HASKELL__ import Control.Concurrent #endif import Control.Exception hiding (catch, evaluate) import qualified Control.Exception as Exception (catch, evaluate) import Test.QuickCheck import System.IO.Unsafe data TestOptions = TestOptions { no_of_tests :: Int, -- ^ number of tests to run. length_of_tests :: Int, -- ^ time limit for test, in seconds. -- If zero, no time limit. -- /Note:/ only GHC supports time limits. debug_tests :: Bool } defOpt :: TestOptions defOpt = TestOptions { no_of_tests = 100 , length_of_tests = 1 , debug_tests = False } data TestResult = TestOk String Int [[String]] | TestExausted String Int [[String]] | TestFailed [String] Int | TestAborted Exception tests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO TestResult tests config gen rnd0 ntest nfail stamps | ntest == configMaxTest config = return (TestOk "OK, passed" ntest stamps) | nfail == configMaxFail config = return (TestExausted "Arguments exhausted after" ntest stamps) | otherwise = do (if not (null txt) then putStr txt else return ()) case ok result of Nothing -> tests config gen rnd1 ntest (nfail+1) stamps Just True -> tests config gen rnd1 (ntest+1) nfail (stamp result:stamps) Just False -> do return (TestFailed (arguments result) ntest) where txt = configEvery config ntest (arguments result) result = generate (configSize config ntest) rnd2 gen (rnd1,rnd2) = split rnd0 batch n v = Config { configMaxTest = n , configMaxFail = n * 10 , configSize = (+ 3) . (`div` 2) , configEvery = \n args -> if v then show n ++ ":\n" ++ unlines args else "" } -- | Run the test. -- Here we use the same random number each time, -- so we get reproducable results! run :: Testable a => a -> TestOptions -> IO TestResult run a TestOptions { no_of_tests = n, length_of_tests = len, debug_tests = debug } = #ifdef __GLASGOW_HASKELL__ do me <- myThreadId ready <- newEmptyMVar r <- if len == 0 then try theTest else try (do -- This waits a bit, then raises an exception in its parent, -- saying, right, you've had long enough! watcher <- forkIO (Exception.catch (do threadDelay (len * 1000 * 1000) takeMVar ready throwTo me NonTermination return ()) (\ _ -> return ())) -- Tell the watcher we are starting... putMVar ready () -- This is cheating, because possibly some of the internal message -- inside "r" might be _|_, but anyway.... r <- theTest -- Now, we turn off the watcher. -- Ignored if the watcher is already dead, -- (unless some unlucky thread picks up the same name) killThread watcher return r) case r of Right r -> return r Left e -> return (TestAborted e) #else Exception.catch theTest $ \ e -> return (TestAborted e) #endif where theTest = tests (batch n debug) (evaluate a) (mkStdGen 0) 0 0 [] -- | Prints a one line summary of various tests with common theme runTests :: String -> TestOptions -> [TestOptions -> IO TestResult] -> IO () runTests name scale actions = do putStr (rjustify 25 name ++ " : ") f <- tr 1 actions [] 0 mapM fa f return () where rjustify n s = replicate (max 0 (n - length s)) ' ' ++ s tr n [] xs c = do putStr (rjustify (max 0 (35-n)) " (" ++ show c ++ ")\n") return xs tr n (action:actions) others c = do r <- action scale case r of (TestOk _ m _) -> do { putStr "." ; tr (n+1) actions others (c+m) } (TestExausted s m ss) -> do { putStr "?" ; tr (n+1) actions others (c+m) } (TestAborted e) -> do { putStr "*" ; tr (n+1) actions others c } (TestFailed f num) -> do { putStr "#" ; tr (n+1) actions ((f,n,num):others) (c+num) } fa :: ([String],Int,Int) -> IO () fa (f,n,no) = do putStr "\n" putStr (" ** test " ++ show (n :: Int) ++ " of " ++ name ++ " failed with the binding(s)\n") sequence_ [putStr (" ** " ++ v ++ "\n") | v <- f ] putStr "\n" bottom :: a bottom = error "_|_" -- | Look out behind you! These can be misused badly. -- However, in the context of a batch tester, can also be very useful. -- -- Examples of use of bottom and isBottom: -- -- > {- test for abort -} -- > prop_head2 = isBottom (head []) -- > {- test for strictness -} -- > prop_head3 = isBottom (head bottom) isBottom :: a -> Bool isBottom a = unsafePerformIO (do a' <- try (Exception.evaluate a) case a' of Left _ -> return True Right _ -> return False) hugs98-plus-Sep2006/packages/QuickCheck/Test/QuickCheck/Poly.hs0000644006511100651110000000440410504340262022761 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Test.QuickCheck.Poly -- Copyright : (c) Andy Gill 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- This is an attempt to emulate polymorphic types for the -- purposes of testing by using abstract monomorphic types. -- -- It is likely that future versions of QuickCheck will -- include some polymorphic emulation testing facility, -- but this module can be used for now. -- ----------------------------------------------------------------------------- module Test.QuickCheck.Poly ( ALPHA , BETA , GAMMA , OrdALPHA , OrdBETA , OrdGAMMA ) where import Prelude import Test.QuickCheck import Test.QuickCheck.Utils {- This is the basic pseudo-polymorphic object. - The idea is you can't cheat, and use the integer - directly, but need to use the abstraction. - - We use phantom types (ref: Domain Specific Embedded Compilers, - Daan Leijen & Erik Meijer, 2nd Conference of Domain Specific - Languages, Austin, TX, 1999) -} newtype Poly a = Poly Int instance Show (Poly a) where show (Poly a) = "_" ++ show a instance Arbitrary (Poly a) where arbitrary = sized $ \n -> (choose (1,n) >>= return . Poly) coarbitrary (Poly n) = variant (if n >= 0 then 2*n else 2*(-n) + 1) instance Eq a => Eq (Poly a) where (Poly a) == (Poly b) = a == b instance Ord a => Ord (Poly a) where (Poly a) `compare` (Poly b) = a `compare` b {- - These are what we export, our pseudo-polymorphic instances. -} type ALPHA = Poly ALPHA_ data ALPHA_ = ALPHA_ deriving (Eq) type BETA = Poly BETA_ data BETA_ = BETA_ deriving (Eq) type GAMMA = Poly GAMMA_ data GAMMA_ = GAMMA_ deriving (Eq) type OrdALPHA = Poly OrdALPHA_ data OrdALPHA_ = OrdALPHA_ deriving (Eq,Ord) type OrdBETA = Poly OrdBETA_ data OrdBETA_ = OrdBETA_ deriving (Eq,Ord) type OrdGAMMA = Poly OrdGAMMA_ data OrdGAMMA_ = OrdGAMMA_ deriving (Eq,Ord) {- - This is a condition on OrdALPHA, OrdBETA, etc, itself. - It states that all OrdALPHA objects obey total ordering. -} prop_OrdPOLY x y = isTotalOrder x y where types = (x :: OrdALPHA, y :: OrdALPHA) hugs98-plus-Sep2006/packages/QuickCheck/Test/QuickCheck/Utils.hs0000644006511100651110000000304310504340262023134 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Test.QuickCheck.Utils -- Copyright : (c) Andy Gill 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- These are some general purpose utilities for use with QuickCheck. -- ----------------------------------------------------------------------------- module Test.QuickCheck.Utils ( isAssociativeBy , isAssociative , isCommutableBy , isCommutable , isTotalOrder ) where import Prelude import Test.QuickCheck isAssociativeBy :: (Show a,Testable prop) => (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property isAssociativeBy (===) src (**) = forAll src $ \ a -> forAll src $ \ b -> forAll src $ \ c -> ((a ** b) ** c) === (a ** (b ** c)) isAssociative :: (Arbitrary a,Show a,Eq a) => (a -> a -> a) -> Property isAssociative = isAssociativeBy (==) arbitrary isCommutableBy :: (Show a,Testable prop) => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property isCommutableBy (===) src (**) = forAll src $ \ a -> forAll src $ \ b -> (a ** b) === (b ** a) isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property isCommutable = isCommutableBy (==) arbitrary isTotalOrder :: (Arbitrary a,Show a,Ord a) => a -> a -> Property isTotalOrder x y = classify (x > y) "less than" $ classify (x == y) "equals" $ classify (x < y) "greater than" $ x < y || x == y || x > y hugs98-plus-Sep2006/packages/QuickCheck/Test/QuickCheck.hs0000644006511100651110000002407410504340262022043 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Test.QuickCheck -- Copyright : (c) Koen Claessen, John Hughes 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- QuickCheck v.0.2 -- DRAFT implementation; last update 000104. -- Koen Claessen, John Hughes. -- This file represents work in progress, and might change at a later date. -- ----------------------------------------------------------------------------- module Test.QuickCheck -- testing functions ( quickCheck -- :: prop -> IO () , verboseCheck -- :: prop -> IO () , test -- :: prop -> IO () -- = quickCheck , Config(..) -- :: * , defaultConfig -- :: Config , check -- :: Config -> prop -> IO () -- property combinators , forAll -- :: Gen a -> (a -> prop) -> prop , (==>) -- :: Bool -> prop -> prop -- gathering test-case information , label -- :: String -> prop -> prop , collect -- :: Show a => a -> prop -> prop , classify -- :: Bool -> String -> prop -> prop , trivial -- :: Bool -> prop -> prop -- generator combinators , Gen -- :: * -> * ; Functor, Monad , elements -- :: [a] -> Gen a , two -- :: Gen a -> Gen (a,a) , three -- :: Gen a -> Gen (a,a,a) , four -- :: Gen a -> Gen (a,a,a,a) , sized -- :: (Int -> Gen a) -> Gen a , resize -- :: Int -> Gen a -> Gen a , choose -- :: Random a => (a, a) -> Gen a , oneof -- :: [Gen a] -> Gen a , frequency -- :: [(Int, Gen a)] -> Gen a , vector -- :: Arbitrary a => Int -> Gen [a] -- default generators , Arbitrary(..) -- :: class , rand -- :: Gen StdGen , promote -- :: (a -> Gen b) -> Gen (a -> b) , variant -- :: Int -> Gen a -> Gen a -- testable , Testable(..) -- :: class , Property -- :: * -- For writing your own driver , Result(..) -- :: data , generate -- :: Int -> StdGen -> Gen a -> a , evaluate -- :: Testable a => a -> Gen Result ) where import Prelude import System.Random import Data.List( group, sort, intersperse ) import Control.Monad( liftM2, liftM3, liftM4 ) infixr 0 ==> infix 1 `classify` -------------------------------------------------------------------- -- Generator newtype Gen a = Gen (Int -> StdGen -> a) sized :: (Int -> Gen a) -> Gen a sized fgen = Gen (\n r -> let Gen m = fgen n in m n r) resize :: Int -> Gen a -> Gen a resize n (Gen m) = Gen (\_ r -> m n r) rand :: Gen StdGen rand = Gen (\n r -> r) promote :: (a -> Gen b) -> Gen (a -> b) promote f = Gen (\n r -> \a -> let Gen m = f a in m n r) variant :: Int -> Gen a -> Gen a variant v (Gen m) = Gen (\n r -> m n (rands r !! (v+1))) where rands r0 = r1 : rands r2 where (r1, r2) = split r0 generate :: Int -> StdGen -> Gen a -> a generate n rnd (Gen m) = m size rnd' where (size, rnd') = randomR (0, n) rnd instance Functor Gen where fmap f m = m >>= return . f instance Monad Gen where return a = Gen (\n r -> a) Gen m >>= k = Gen (\n r0 -> let (r1,r2) = split r0 Gen m' = k (m n r1) in m' n r2) -- derived choose :: Random a => (a, a) -> Gen a choose bounds = (fst . randomR bounds) `fmap` rand elements :: [a] -> Gen a elements xs = (xs !!) `fmap` choose (0, length xs - 1) vector :: Arbitrary a => Int -> Gen [a] vector n = sequence [ arbitrary | i <- [1..n] ] oneof :: [Gen a] -> Gen a oneof gens = elements gens >>= id frequency :: [(Int, Gen a)] -> Gen a frequency xs = choose (1, tot) >>= (`pick` xs) where tot = sum (map fst xs) pick n ((k,x):xs) | n <= k = x | otherwise = pick (n-k) xs -- general monadic two :: Monad m => m a -> m (a, a) two m = liftM2 (,) m m three :: Monad m => m a -> m (a, a, a) three m = liftM3 (,,) m m m four :: Monad m => m a -> m (a, a, a, a) four m = liftM4 (,,,) m m m m -------------------------------------------------------------------- -- Arbitrary class Arbitrary a where arbitrary :: Gen a coarbitrary :: a -> Gen b -> Gen b instance Arbitrary () where arbitrary = return () coarbitrary _ = variant 0 instance Arbitrary Bool where arbitrary = elements [True, False] coarbitrary b = if b then variant 0 else variant 1 instance Arbitrary Int where arbitrary = sized $ \n -> choose (-n,n) coarbitrary n = variant (if n >= 0 then 2*n else 2*(-n) + 1) instance Arbitrary Integer where arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n) coarbitrary n = variant (fromInteger (if n >= 0 then 2*n else 2*(-n) + 1)) instance Arbitrary Float where arbitrary = liftM3 fraction arbitrary arbitrary arbitrary coarbitrary x = coarbitrary (decodeFloat x) instance Arbitrary Double where arbitrary = liftM3 fraction arbitrary arbitrary arbitrary coarbitrary x = coarbitrary (decodeFloat x) fraction a b c = fromInteger a + (fromInteger b / (abs (fromInteger c) + 1)) instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where arbitrary = liftM2 (,) arbitrary arbitrary coarbitrary (a, b) = coarbitrary a . coarbitrary b instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (a, b, c) where arbitrary = liftM3 (,,) arbitrary arbitrary arbitrary coarbitrary (a, b, c) = coarbitrary a . coarbitrary b . coarbitrary c instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (a, b, c, d) where arbitrary = liftM4 (,,,) arbitrary arbitrary arbitrary arbitrary coarbitrary (a, b, c, d) = coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d instance Arbitrary a => Arbitrary [a] where arbitrary = sized (\n -> choose (0,n) >>= vector) coarbitrary [] = variant 0 coarbitrary (a:as) = coarbitrary a . variant 1 . coarbitrary as instance (Arbitrary a, Arbitrary b) => Arbitrary (a -> b) where arbitrary = promote (`coarbitrary` arbitrary) coarbitrary f gen = arbitrary >>= ((`coarbitrary` gen) . f) -------------------------------------------------------------------- -- Testable data Result = Result { ok :: Maybe Bool, stamp :: [String], arguments :: [String] } nothing :: Result nothing = Result{ ok = Nothing, stamp = [], arguments = [] } newtype Property = Prop (Gen Result) result :: Result -> Property result res = Prop (return res) evaluate :: Testable a => a -> Gen Result evaluate a = gen where Prop gen = property a class Testable a where property :: a -> Property instance Testable () where property _ = result nothing instance Testable Bool where property b = result (nothing{ ok = Just b }) instance Testable Result where property res = result res instance Testable Property where property prop = prop instance (Arbitrary a, Show a, Testable b) => Testable (a -> b) where property f = forAll arbitrary f forAll :: (Show a, Testable b) => Gen a -> (a -> b) -> Property forAll gen body = Prop $ do a <- gen res <- evaluate (body a) return (argument a res) where argument a res = res{ arguments = show a : arguments res } (==>) :: Testable a => Bool -> a -> Property True ==> a = property a False ==> a = property () label :: Testable a => String -> a -> Property label s a = Prop (add `fmap` evaluate a) where add res = res{ stamp = s : stamp res } classify :: Testable a => Bool -> String -> a -> Property classify True name = label name classify False _ = property trivial :: Testable a => Bool -> a -> Property trivial = (`classify` "trivial") collect :: (Show a, Testable b) => a -> b -> Property collect v = label (show v) -------------------------------------------------------------------- -- Testing data Config = Config { configMaxTest :: Int , configMaxFail :: Int , configSize :: Int -> Int , configEvery :: Int -> [String] -> String } quick :: Config quick = Config { configMaxTest = 100 , configMaxFail = 1000 , configSize = (+ 3) . (`div` 2) , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ] } verbose :: Config verbose = quick { configEvery = \n args -> show n ++ ":\n" ++ unlines args } defaultConfig :: Config defaultConfig = quick test, quickCheck, verboseCheck :: Testable a => a -> IO () test = check quick quickCheck = check quick verboseCheck = check verbose check :: Testable a => Config -> a -> IO () check config a = do rnd <- newStdGen tests config (evaluate a) rnd 0 0 [] tests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO () tests config gen rnd0 ntest nfail stamps | ntest == configMaxTest config = do done "OK, passed" ntest stamps | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps | otherwise = do putStr (configEvery config ntest (arguments result)) case ok result of Nothing -> tests config gen rnd1 ntest (nfail+1) stamps Just True -> tests config gen rnd1 (ntest+1) nfail (stamp result:stamps) Just False -> putStr ( "Falsifiable, after " ++ show ntest ++ " tests:\n" ++ unlines (arguments result) ) where result = generate (configSize config ntest) rnd2 gen (rnd1,rnd2) = split rnd0 done :: String -> Int -> [[String]] -> IO () done mesg ntest stamps = do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table ) where table = display . map entry . reverse . sort . map pairLength . group . sort . filter (not . null) $ stamps display [] = ".\n" display [x] = " (" ++ x ++ ").\n" display xs = ".\n" ++ unlines (map (++ ".") xs) pairLength xss@(xs:_) = (length xss, xs) entry (n, xs) = percentage n ntest ++ " " ++ concat (intersperse ", " xs) percentage n m = show ((100 * n) `div` m) ++ "%" -------------------------------------------------------------------- -- the end. hugs98-plus-Sep2006/packages/QuickCheck/package.conf.in0000644006511100651110000000107210504340262021416 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: Debug.QuickCheck.Batch, Debug.QuickCheck.Poly, Debug.QuickCheck.Utils, Debug.QuickCheck, Test.QuickCheck.Batch, Test.QuickCheck.Poly, Test.QuickCheck.Utils, Test.QuickCheck hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSQuickCheck" extra-libraries: include-dirs: includes: depends: base hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/QuickCheck/prologue.txt0000644006511100651110000000107110504340262021143 0ustar rossrossA library for testing Haskell programs automatically. The programmer provides a specification of the program, in the form of properties which functions should satisfy, and QuickCheck then tests that the properties hold in a large number of randomly generated cases. Specifications are expressed in Haskell, using combinators defined in the QuickCheck library. QuickCheck provides combinators to define properties, observe the distribution of test data, and define test data generators. For more information, please see: . hugs98-plus-Sep2006/packages/unix/0000755006511100651110000000000010504340734015524 5ustar rossrosshugs98-plus-Sep2006/packages/unix/System/0000755006511100651110000000000010504340274017007 5ustar rossrosshugs98-plus-Sep2006/packages/unix/System/Posix/0000755006511100651110000000000010504340275020112 5ustar rossrosshugs98-plus-Sep2006/packages/unix/System/Posix/DynamicLinker/0000755006511100651110000000000010504340274022642 5ustar rossrosshugs98-plus-Sep2006/packages/unix/System/Posix/DynamicLinker/Module.hsc0000644006511100651110000000711310504340274024570 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.DynamicLinker.Module -- Copyright : (c) Volker Stolz 2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : vs@foldr.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- DLOpen support, old API -- Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs -- I left the API more or less the same, mostly the flags are different. -- ----------------------------------------------------------------------------- module System.Posix.DynamicLinker.Module ( -- Usage: -- ****** -- -- Let's assume you want to open a local shared library 'foo' (./libfoo.so) -- offering a function -- char * mogrify (char*,int) -- and invoke str = mogrify("test",1): -- -- type Fun = CString -> Int -> IO CString -- foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun -- -- withModule (Just ".") ("libfoo.so") [RTLD_NOW] $ \ mod -> do -- funptr <- moduleSymbol mod "mogrify" -- let fun = fun__ funptr -- withCString "test" $ \ str -> do -- strptr <- fun str 1 -- strstr <- peekCString strptr -- ... Module , moduleOpen -- :: String -> ModuleFlags -> IO Module , moduleSymbol -- :: Source -> String -> IO (FunPtr a) , moduleClose -- :: Module -> IO Bool , moduleError -- :: IO String , withModule -- :: Maybe String -- -> String -- -> [ModuleFlags ] -- -> (Module -> IO a) -- -> IO a , withModule_ -- :: Maybe String -- -> String -- -> [ModuleFlags] -- -> (Module -> IO a) -- -> IO () ) where #include "HsUnix.h" import System.Posix.DynamicLinker import Foreign.Ptr ( Ptr, nullPtr, FunPtr ) import Foreign.C.String ( withCString ) -- abstract handle for dynamically loaded module (EXPORTED) -- newtype Module = Module (Ptr ()) unModule :: Module -> (Ptr ()) unModule (Module adr) = adr -- Opens a module (EXPORTED) -- moduleOpen :: String -> [RTLDFlags] -> IO Module moduleOpen mod flags = do modPtr <- withCString mod $ \ modAddr -> c_dlopen modAddr (packRTLDFlags flags) if (modPtr == nullPtr) then moduleError >>= \ err -> ioError (userError ("dlopen: " ++ err)) else return $ Module modPtr -- Gets a symbol pointer from a module (EXPORTED) -- moduleSymbol :: Module -> String -> IO (FunPtr a) moduleSymbol mod sym = dlsym (DLHandle (unModule mod)) sym -- Closes a module (EXPORTED) -- moduleClose :: Module -> IO () moduleClose mod = dlclose (DLHandle (unModule mod)) -- Gets a string describing the last module error (EXPORTED) -- moduleError :: IO String moduleError = dlerror -- Convenience function, cares for module open- & closing -- additionally returns status of `moduleClose' (EXPORTED) -- withModule :: Maybe String -> String -> [RTLDFlags] -> (Module -> IO a) -> IO a withModule dir mod flags p = do let modPath = case dir of Nothing -> mod Just p -> p ++ if ((head (reverse p)) == '/') then mod else ('/':mod) mod <- moduleOpen modPath flags result <- p mod moduleClose mod return result withModule_ :: Maybe String -> String -> [RTLDFlags] -> (Module -> IO a) -> IO () withModule_ dir mod flags p = withModule dir mod flags p >>= \ _ -> return () hugs98-plus-Sep2006/packages/unix/System/Posix/DynamicLinker/Prim.hsc0000644006511100651110000000707010504340274024254 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.DynamicLinker.Prim -- Copyright : (c) Volker Stolz 2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : vs@foldr.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- DLOpen and friend -- Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs -- I left the API more or less the same, mostly the flags are different. -- ----------------------------------------------------------------------------- module System.Posix.DynamicLinker.Prim ( -- * low level API c_dlopen, c_dlsym, c_dlerror, c_dlclose, -- dlAddr, -- XXX NYI haveRtldNext, haveRtldLocal, packRTLDFlags, RTLDFlags(..), packDL, DL(..) ) where #include "HsUnix.h" import Data.Bits ( (.|.) ) import Foreign.Ptr ( Ptr, FunPtr, nullPtr ) import Foreign.C.Types ( CInt ) import Foreign.C.String ( CString ) -- RTLD_NEXT madness -- On some host (e.g. SuSe Linux 7.2) RTLD_NEXT is not visible -- without setting _GNU_SOURCE. Since we don't want to set this -- flag, here's a different solution: You can use the Haskell -- function 'haveRtldNext' to check wether the flag is available -- to you. Ideally, this will be optimized by the compiler so -- that it should be as efficient as an #ifdef. -- If you fail to test the flag and use it although it is -- undefined, 'packOneModuleFlag' will bomb. -- The same applies to RTLD_LOCAL which isn't available on -- cygwin. haveRtldNext :: Bool #ifdef HAVE_RTLDNEXT haveRtldNext = True foreign import ccall unsafe "__hsunix_rtldNext" rtldNext :: Ptr a #else /* HAVE_RTLDNEXT */ haveRtldNext = False #endif /* HAVE_RTLDNEXT */ #ifdef HAVE_RTLDDEFAULT foreign import ccall unsafe "__hsunix_rtldDefault" rtldDefault :: Ptr a #endif /* HAVE_RTLDDEFAULT */ haveRtldLocal :: Bool #ifdef HAVE_RTLDLOCAL haveRtldLocal = True #else /* HAVE_RTLDLOCAL */ haveRtldLocal = False #endif /* HAVE_RTLDLOCAL */ data RTLDFlags = RTLD_LAZY | RTLD_NOW | RTLD_GLOBAL | RTLD_LOCAL deriving (Show, Read) foreign import ccall unsafe "dlopen" c_dlopen :: CString -> CInt -> IO (Ptr ()) foreign import ccall unsafe "dlsym" c_dlsym :: Ptr () -> CString -> IO (FunPtr a) foreign import ccall unsafe "dlerror" c_dlerror :: IO CString foreign import ccall unsafe "dlclose" c_dlclose :: (Ptr ()) -> IO CInt packRTLDFlags :: [RTLDFlags] -> CInt packRTLDFlags flags = foldl (\ s f -> (packRTLDFlag f) .|. s) 0 flags packRTLDFlag :: RTLDFlags -> CInt packRTLDFlag RTLD_LAZY = #const RTLD_LAZY #ifdef HAVE_RTLDNOW packRTLDFlag RTLD_NOW = #const RTLD_NOW #else /* HAVE_RTLDNOW */ packRTLDFlag RTLD_NOW = error "RTLD_NOW not available" #endif /* HAVE_RTLDNOW */ #ifdef HAVE_RTLDGLOBAL packRTLDFlag RTLD_GLOBAL = #const RTLD_GLOBAL #else /* HAVE_RTLDGLOBAL */ packRTLDFlag RTLD_GLOBAL = error "RTLD_GLOBAL not available" #endif #ifdef HAVE_RTLDLOCAL packRTLDFlag RTLD_LOCAL = #const RTLD_LOCAL #else /* HAVE_RTLDLOCAL */ packRTLDFlag RTLD_LOCAL = error "RTLD_LOCAL not available" #endif /* HAVE_RTLDLOCAL */ -- |Flags for 'System.Posix.DynamicLinker.dlsym'. Notice that 'Next' -- might not be available on your particular platform! data DL = Null | Next | Default | DLHandle (Ptr ()) deriving (Show) packDL :: DL -> Ptr () packDL Null = nullPtr #ifdef HAVE_RTLDNEXT packDL Next = rtldNext #else packDL Next = error "RTLD_NEXT not available" #endif #ifdef HAVE_RTLDDEFAULT packDL Default = rtldDefault #else packDL Default = nullPtr #endif packDL (DLHandle h) = h hugs98-plus-Sep2006/packages/unix/System/Posix/Directory.hsc0000644006511100651110000001011210504340274022547 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Files -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX directory support -- ----------------------------------------------------------------------------- module System.Posix.Directory ( -- * Creating and removing directories createDirectory, removeDirectory, -- * Reading directories DirStream, openDirStream, readDirStream, rewindDirStream, closeDirStream, DirStreamOffset, tellDirStream, seekDirStream, -- * The working dirctory getWorkingDirectory, changeWorkingDirectory, changeWorkingDirectoryFd, ) where import System.Posix.Error import System.Posix.Types import System.Posix.Internals import System.Directory hiding (createDirectory) import Foreign import Foreign.C -- | @createDirectory dir mode@ calls @mkdir@ to -- create a new directory, @dir@, with permissions based on -- @mode@. createDirectory :: FilePath -> FileMode -> IO () createDirectory name mode = withCString name $ \s -> throwErrnoPathIfMinus1_ "createDirectory" name (c_mkdir s mode) foreign import ccall unsafe "mkdir" c_mkdir :: CString -> CMode -> IO CInt newtype DirStream = DirStream (Ptr CDir) -- | @openDirStream dir@ calls @opendir@ to obtain a -- directory stream for @dir@. openDirStream :: FilePath -> IO DirStream openDirStream name = withCString name $ \s -> do dirp <- throwErrnoPathIfNull "openDirStream" name $ c_opendir s return (DirStream dirp) -- | @readDirStream dp@ calls @readdir@ to obtain the -- next directory entry (@struct dirent@) for the open directory -- stream @dp@, and returns the @d_name@ member of that -- structure. readDirStream :: DirStream -> IO FilePath readDirStream (DirStream dirp) = alloca $ \ptr_dEnt -> loop ptr_dEnt where loop ptr_dEnt = do resetErrno r <- readdir dirp ptr_dEnt if (r == 0) then do dEnt <- peek ptr_dEnt if (dEnt == nullPtr) then return [] else do entry <- (d_name dEnt >>= peekCString) freeDirEnt dEnt return entry else do errno <- getErrno if (errno == eINTR) then loop ptr_dEnt else do let (Errno eo) = errno if (eo == end_of_dir) then return [] else throwErrno "readDirStream" -- | @rewindDirStream dp@ calls @rewinddir@ to reposition -- the directory stream @dp@ at the beginning of the directory. rewindDirStream :: DirStream -> IO () rewindDirStream (DirStream dirp) = c_rewinddir dirp -- | @closeDirStream dp@ calls @closedir@ to close -- the directory stream @dp@. closeDirStream :: DirStream -> IO () closeDirStream (DirStream dirp) = do throwErrnoIfMinus1_ "closeDirStream" (c_closedir dirp) newtype DirStreamOffset = DirStreamOffset CLong seekDirStream :: DirStream -> DirStreamOffset -> IO () seekDirStream (DirStream dirp) (DirStreamOffset off) = c_seekdir dirp off foreign import ccall unsafe "seekdir" c_seekdir :: Ptr CDir -> CLong -> IO () tellDirStream :: DirStream -> IO DirStreamOffset tellDirStream (DirStream dirp) = do off <- c_telldir dirp return (DirStreamOffset off) foreign import ccall unsafe "telldir" c_telldir :: Ptr CDir -> IO CLong {- Renamings of functionality provided via Directory interface, kept around for b.wards compatibility and for having more POSIXy names -} -- | @getWorkingDirectory@ calls @getcwd@ to obtain the name -- of the current working directory. getWorkingDirectory :: IO FilePath getWorkingDirectory = getCurrentDirectory -- | @changeWorkingDirectory dir@ calls @chdir@ to change -- the current working directory to @dir@. changeWorkingDirectory :: FilePath -> IO () changeWorkingDirectory name = setCurrentDirectory name changeWorkingDirectoryFd :: Fd -> IO () changeWorkingDirectoryFd (Fd fd) = throwErrnoIfMinus1_ "changeWorkingDirectoryFd" (c_fchdir fd) foreign import ccall unsafe "fchdir" c_fchdir :: CInt -> IO CInt hugs98-plus-Sep2006/packages/unix/System/Posix/Signals/0000755006511100651110000000000010504340274021511 5ustar rossrosshugs98-plus-Sep2006/packages/unix/System/Posix/Signals/Exts.hsc0000644006511100651110000000242210504340274023133 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Signals.Exts -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX, includes Linuxisms/BSDisms) -- -- non-POSIX signal support commonly available -- ----------------------------------------------------------------------------- #include "HsUnix.h" module System.Posix.Signals.Exts ( module System.Posix.Signals #ifdef SIGINFO , infoEvent, sigINFO #endif #ifdef SIGWINCH , windowChange, sigWINCH #endif ) where import Foreign.C ( CInt ) import System.Posix.Signals #ifdef __HUGS__ # ifdef SIGINFO sigINFO = (#const SIGINFO) :: CInt # endif # ifdef SIGWINCH sigWINCH = (#const SIGWINCH) :: CInt # endif #else /* !HUGS */ # ifdef SIGINFO foreign import ccall unsafe "__hsunix_SIGINFO" sigINFO :: CInt # endif # ifdef SIGWINCH foreign import ccall unsafe "__hsunix_SIGWINCH" sigWINCH :: CInt # endif #endif /* !HUGS */ #ifdef SIGINFO infoEvent :: Signal infoEvent = sigINFO #endif #ifdef SIGWINCH windowChange :: Signal windowChange = sigWINCH #endif hugs98-plus-Sep2006/packages/unix/System/Posix/DynamicLinker.hsc0000644006511100651110000000540010504340274023340 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Posix.DynamicLinker -- Copyright : (c) Volker Stolz 2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : vs@foldr.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- Dynamic linker support through dlopen() ----------------------------------------------------------------------------- module System.Posix.DynamicLinker ( module System.Posix.DynamicLinker.Prim, dlopen, dlsym, dlerror, dlclose, withDL, withDL_, undl, ) -- Usage: -- ****** -- -- Let's assume you want to open a local shared library \'foo\' (.\/libfoo.so) -- offering a function -- @char \* mogrify (char\*,int)@ -- and invoke @str = mogrify("test",1)@: -- -- -- type Fun = CString -> Int -> IO CString -- foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun -- -- withDL "libfoo.so" [RTLD_NOW] \$ \\ mod -> do -- funptr <- dlsym mod "mogrify" -- let fun = fun__ funptr -- withCString "test" \$ \\ str -> do -- strptr <- fun str 1 -- strstr <- peekCString strptr -- ... -- where #include "HsUnix.h" import System.Posix.DynamicLinker.Prim import Control.Exception ( bracket ) import Control.Monad ( liftM ) import Foreign.Ptr ( Ptr, nullPtr, FunPtr, nullFunPtr ) import Foreign.C.String ( withCString, peekCString ) dlopen :: String -> [RTLDFlags] -> IO DL dlopen path flags = do withCString path $ \ p -> do liftM DLHandle $ throwDLErrorIf "dlopen" (== nullPtr) $ c_dlopen p (packRTLDFlags flags) dlclose :: DL -> IO () dlclose (DLHandle h) = throwDLErrorIf_ "dlclose" (/= 0) $ c_dlclose h dlclose h = error $ "dlclose: invalid argument" ++ (show h) dlerror :: IO String dlerror = c_dlerror >>= peekCString -- |'dlsym' returns the address binding of the symbol described in @symbol@, -- as it occurs in the shared object identified by @source@. dlsym :: DL -> String -> IO (FunPtr a) dlsym source symbol = do withCString symbol $ \ s -> do throwDLErrorIf "dlsym" (== nullFunPtr) $ c_dlsym (packDL source) s withDL :: String -> [RTLDFlags] -> (DL -> IO a) -> IO a withDL mod flags f = bracket (dlopen mod flags) (dlclose) f withDL_ :: String -> [RTLDFlags] -> (DL -> IO a) -> IO () withDL_ mod flags f = withDL mod flags f >> return () -- |'undl' obtains the raw handle. You mustn't do something like -- @withDL mod flags $ liftM undl >>= \ p -> use p@ undl :: DL -> Ptr () undl = packDL throwDLErrorIf :: String -> (a -> Bool) -> IO a -> IO a throwDLErrorIf s p f = do r <- f if (p r) then dlerror >>= \ err -> ioError (userError ( s ++ ": " ++ err)) else return r throwDLErrorIf_ s p f = throwDLErrorIf s p f >> return () hugs98-plus-Sep2006/packages/unix/System/Posix/Env.hsc0000644006511100651110000000702010504340275021340 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Env -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX environment support -- ----------------------------------------------------------------------------- module System.Posix.Env ( getEnv , getEnvDefault , getEnvironmentPrim , getEnvironment , putEnv , setEnv , unsetEnv ) where #include "HsUnix.h" import Foreign.C.Error ( throwErrnoIfMinus1_ ) import Foreign.C.Types ( CInt ) import Foreign.C.String import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable import Control.Monad ( liftM ) import Data.Maybe ( fromMaybe ) -- |'getEnv' looks up a variable in the environment. getEnv :: String -> IO (Maybe String) getEnv name = do litstring <- withCString name c_getenv if litstring /= nullPtr then liftM Just $ peekCString litstring else return Nothing -- |'getEnvDefault' is a wrapper around 'getEnv' where the -- programmer can specify a fallback if the variable is not found -- in the environment. getEnvDefault :: String -> String -> IO String getEnvDefault name fallback = liftM (fromMaybe fallback) (getEnv name) foreign import ccall unsafe "getenv" c_getenv :: CString -> IO CString getEnvironmentPrim :: IO [String] getEnvironmentPrim = do c_environ <- peek c_environ_p arr <- peekArray0 nullPtr c_environ mapM peekCString arr foreign import ccall unsafe "&environ" c_environ_p :: Ptr (Ptr CString) -- |'getEnvironment' retrieves the entire environment as a -- list of @(key,value)@ pairs. getEnvironment :: IO [(String,String)] getEnvironment = do env <- getEnvironmentPrim return $ map (dropEq.(break ((==) '='))) env where dropEq (x,'=':ys) = (x,ys) dropEq (x,_) = error $ "getEnvironment: insane variable " ++ x -- |The 'unsetEnv' function deletes all instances of the variable name -- from the environment. unsetEnv :: String -> IO () #ifdef HAVE_UNSETENV unsetEnv name = withCString name c_unsetenv foreign import ccall unsafe "unsetenv" c_unsetenv :: CString -> IO () #else unsetEnv name = putEnv (name ++ "=") #endif -- |'putEnv' function takes an argument of the form @name=value@ -- and is equivalent to @setEnv(key,value,True{-overwrite-})@. putEnv :: String -> IO () putEnv keyvalue = withCString keyvalue $ \s -> throwErrnoIfMinus1_ "putenv" (c_putenv s) foreign import ccall unsafe "putenv" c_putenv :: CString -> IO CInt {- |The 'setEnv' function inserts or resets the environment variable name in the current environment list. If the variable @name@ does not exist in the list, it is inserted with the given value. If the variable does exist, the argument @overwrite@ is tested; if @overwrite@ is @False@, the variable is not reset, otherwise it is reset to the given value. -} setEnv :: String -> String -> Bool {-overwrite-} -> IO () #ifdef HAVE_SETENV setEnv key value ovrwrt = do withCString key $ \ keyP -> withCString value $ \ valueP -> throwErrnoIfMinus1_ "putenv" $ c_setenv keyP valueP (fromIntegral (fromEnum ovrwrt)) foreign import ccall unsafe "setenv" c_setenv :: CString -> CString -> CInt -> IO CInt #else setEnv key value True = putEnv (key++"="++value) setEnv key value False = do res <- getEnv key case res of Just _ -> return () Nothing -> putEnv (key++"="++value) #endif hugs98-plus-Sep2006/packages/unix/System/Posix/Error.hs0000644006511100651110000000306310504340274021540 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Posix.Error -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX error support -- ----------------------------------------------------------------------------- module System.Posix.Error ( throwErrnoPath, throwErrnoPathIf, throwErrnoPathIf_, throwErrnoPathIfNull, throwErrnoPathIfMinus1, throwErrnoPathIfMinus1_ ) where import Foreign.C.Error import Foreign.Ptr import Foreign.Marshal.Error ( void ) throwErrnoPath :: String -> FilePath -> IO a throwErrnoPath loc path = do errno <- getErrno ioError (errnoToIOError loc errno Nothing (Just path)) throwErrnoPathIf :: (a -> Bool) -> String -> FilePath -> IO a -> IO a throwErrnoPathIf pred loc path f = do res <- f if pred res then throwErrnoPath loc path else return res throwErrnoPathIf_ :: (a -> Bool) -> String -> FilePath -> IO a -> IO () throwErrnoPathIf_ pred loc path f = void $ throwErrnoPathIf pred loc path f throwErrnoPathIfNull :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a) throwErrnoPathIfNull = throwErrnoPathIf (== nullPtr) throwErrnoPathIfMinus1 :: Num a => String -> FilePath -> IO a -> IO a throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1) throwErrnoPathIfMinus1_ :: Num a => String -> FilePath -> IO a -> IO () throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1) hugs98-plus-Sep2006/packages/unix/System/Posix/Files.hsc0000644006511100651110000005560610504340275021667 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Files -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- Functions defined by the POSIX standards for manipulating and querying the -- file system. Names of underlying POSIX functions are indicated whenever -- possible. A more complete documentation of the POSIX functions together -- with a more detailed description of different error conditions are usually -- available in the system's manual pages or from -- (free registration required). -- -- When a function that calls an underlying POSIX function fails, the errno -- code is converted to an 'IOError' using 'Foreign.C.Error.errnoToIOError'. -- For a list of which errno codes may be generated, consult the POSIX -- documentation for the underlying function. -- ----------------------------------------------------------------------------- module System.Posix.Files ( -- * File modes -- FileMode exported by System.Posix.Types unionFileModes, intersectFileModes, nullFileMode, ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes, groupReadMode, groupWriteMode, groupExecuteMode, groupModes, otherReadMode, otherWriteMode, otherExecuteMode, otherModes, setUserIDMode, setGroupIDMode, stdFileMode, accessModes, -- ** Setting file modes setFileMode, setFdMode, setFileCreationMask, -- ** Checking file existence and permissions fileAccess, fileExist, -- * File status FileStatus, -- ** Obtaining file status getFileStatus, getFdStatus, getSymbolicLinkStatus, -- ** Querying file status deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup, specialDeviceID, fileSize, accessTime, modificationTime, statusChangeTime, isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile, isDirectory, isSymbolicLink, isSocket, -- * Creation createNamedPipe, createDevice, -- * Hard links createLink, removeLink, -- * Symbolic links createSymbolicLink, readSymbolicLink, -- * Renaming files rename, -- * Changing file ownership setOwnerAndGroup, setFdOwnerAndGroup, #if HAVE_LCHOWN setSymbolicLinkOwnerAndGroup, #endif -- * Changing file timestamps setFileTimes, touchFile, -- * Setting file sizes setFileSize, setFdSize, -- * Find system-specific limits for a file PathVar(..), getPathVar, getFdPathVar, ) where #include "HsUnix.h" import System.Posix.Error import System.Posix.Types import System.IO.Unsafe import Data.Bits import System.Posix.Internals import Foreign import Foreign.C -- ----------------------------------------------------------------------------- -- POSIX file modes -- The abstract type 'FileMode', constants and operators for -- manipulating the file modes defined by POSIX. -- | No permissions. nullFileMode :: FileMode nullFileMode = 0 -- | Owner has read permission. ownerReadMode :: FileMode ownerReadMode = (#const S_IRUSR) -- | Owner has write permission. ownerWriteMode :: FileMode ownerWriteMode = (#const S_IWUSR) -- | Owner has execute permission. ownerExecuteMode :: FileMode ownerExecuteMode = (#const S_IXUSR) -- | Group has read permission. groupReadMode :: FileMode groupReadMode = (#const S_IRGRP) -- | Group has write permission. groupWriteMode :: FileMode groupWriteMode = (#const S_IWGRP) -- | Group has execute permission. groupExecuteMode :: FileMode groupExecuteMode = (#const S_IXGRP) -- | Others have read permission. otherReadMode :: FileMode otherReadMode = (#const S_IROTH) -- | Others have write permission. otherWriteMode :: FileMode otherWriteMode = (#const S_IWOTH) -- | Others have execute permission. otherExecuteMode :: FileMode otherExecuteMode = (#const S_IXOTH) -- | Set user ID on execution. setUserIDMode :: FileMode setUserIDMode = (#const S_ISUID) -- | Set group ID on execution. setGroupIDMode :: FileMode setGroupIDMode = (#const S_ISGID) -- | Owner, group and others have read and write permission. stdFileMode :: FileMode stdFileMode = ownerReadMode .|. ownerWriteMode .|. groupReadMode .|. groupWriteMode .|. otherReadMode .|. otherWriteMode -- | Owner has read, write and execute permission. ownerModes :: FileMode ownerModes = (#const S_IRWXU) -- | Group has read, write and execute permission. groupModes :: FileMode groupModes = (#const S_IRWXG) -- | Others have read, write and execute permission. otherModes :: FileMode otherModes = (#const S_IRWXO) -- | Owner, group and others have read, write and execute permission. accessModes :: FileMode accessModes = ownerModes .|. groupModes .|. otherModes -- | Combines the two file modes into one that contains modes that appear in -- either. unionFileModes :: FileMode -> FileMode -> FileMode unionFileModes m1 m2 = m1 .|. m2 -- | Combines two file modes into one that only contains modes that appear in -- both. intersectFileModes :: FileMode -> FileMode -> FileMode intersectFileModes m1 m2 = m1 .&. m2 -- Not exported: fileTypeModes :: FileMode fileTypeModes = (#const S_IFMT) blockSpecialMode :: FileMode blockSpecialMode = (#const S_IFBLK) characterSpecialMode :: FileMode characterSpecialMode = (#const S_IFCHR) namedPipeMode :: FileMode namedPipeMode = (#const S_IFIFO) regularFileMode :: FileMode regularFileMode = (#const S_IFREG) directoryMode :: FileMode directoryMode = (#const S_IFDIR) symbolicLinkMode :: FileMode symbolicLinkMode = (#const S_IFLNK) socketMode :: FileMode socketMode = (#const S_IFSOCK) -- | @setFileMode path mode@ changes permission of the file given by @path@ -- to @mode@. This operation may fail with 'throwErrnoPathIfMinus1_' if @path@ -- doesn't exist or if the effective user ID of the current process is not that -- of the file's owner. -- -- Note: calls @chmod@. setFileMode :: FilePath -> FileMode -> IO () setFileMode name m = withCString name $ \s -> do throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m) -- | @setFdMode fd mode@ acts like 'setFileMode' but uses a file descriptor -- @fd@ instead of a 'FilePath'. -- -- Note: calls @fchmod@. setFdMode :: Fd -> FileMode -> IO () setFdMode fd m = throwErrnoIfMinus1_ "setFdMode" (c_fchmod fd m) foreign import ccall unsafe "fchmod" c_fchmod :: Fd -> CMode -> IO CInt -- | @setFileCreationMask mode@ sets the file mode creation mask to @mode@. -- Modes set by this operation are subtracted from files and directories upon -- creation. The previous file creation mask is returned. -- -- Note: calls @umask@. setFileCreationMask :: FileMode -> IO FileMode setFileCreationMask mask = c_umask mask -- ----------------------------------------------------------------------------- -- access() -- | @fileAccess name read write exec@ checks if the file (or other file system -- object) @name@ can be accessed for reading, writing and\/or executing. To -- check a permission set the corresponding argument to 'True'. -- -- Note: calls @access@. fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool fileAccess name read write exec = access name flags where flags = read_f .|. write_f .|. exec_f read_f = if read then (#const R_OK) else 0 write_f = if write then (#const W_OK) else 0 exec_f = if exec then (#const X_OK) else 0 -- | Checks for the existence of the file. -- -- Note: calls @access@. fileExist :: FilePath -> IO Bool fileExist name = withCString name $ \s -> do r <- c_access s (#const F_OK) if (r == 0) then return True else do err <- getErrno if (err == eNOENT) then return False else throwErrnoPath "fileExist" name access :: FilePath -> CMode -> IO Bool access name flags = withCString name $ \s -> do r <- c_access s flags if (r == 0) then return True else do err <- getErrno if (err == eACCES) then return False else throwErrnoPath "fileAccess" name -- ----------------------------------------------------------------------------- -- stat() support -- | POSIX defines operations to get information, such as owner, permissions, -- size and access times, about a file. This information is represented by the -- 'FileStatus' type. -- -- Note: see @chmod@. newtype FileStatus = FileStatus (ForeignPtr CStat) -- | ID of the device on which this file resides. deviceID :: FileStatus -> DeviceID -- | inode number fileID :: FileStatus -> FileID -- | File mode (such as permissions). fileMode :: FileStatus -> FileMode -- | Number of hard links to this file. linkCount :: FileStatus -> LinkCount -- | ID of owner. fileOwner :: FileStatus -> UserID -- | ID of group. fileGroup :: FileStatus -> GroupID -- | Describes the device that this file represents. specialDeviceID :: FileStatus -> DeviceID -- | Size of the file in bytes. If this file is a symbolic link the size is -- the length of the pathname it contains. fileSize :: FileStatus -> FileOffset -- | Time of last access. accessTime :: FileStatus -> EpochTime -- | Time of last modification. modificationTime :: FileStatus -> EpochTime -- | Time of last status change (i.e. owner, group, link count, mode, etc.). statusChangeTime :: FileStatus -> EpochTime deviceID (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_dev) fileID (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_ino) fileMode (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_mode) linkCount (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_nlink) fileOwner (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_uid) fileGroup (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_gid) specialDeviceID (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_rdev) fileSize (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_size) accessTime (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_atime) modificationTime (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_mtime) statusChangeTime (FileStatus stat) = unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_ctime) -- | Checks if this file is a block device. isBlockDevice :: FileStatus -> Bool -- | Checks if this file is a character device. isCharacterDevice :: FileStatus -> Bool -- | Checks if this file is a named pipe device. isNamedPipe :: FileStatus -> Bool -- | Checks if this file is a regular file device. isRegularFile :: FileStatus -> Bool -- | Checks if this file is a directory device. isDirectory :: FileStatus -> Bool -- | Checks if this file is a symbolic link device. isSymbolicLink :: FileStatus -> Bool -- | Checks if this file is a socket device. isSocket :: FileStatus -> Bool isBlockDevice stat = (fileMode stat `intersectFileModes` fileTypeModes) == blockSpecialMode isCharacterDevice stat = (fileMode stat `intersectFileModes` fileTypeModes) == characterSpecialMode isNamedPipe stat = (fileMode stat `intersectFileModes` fileTypeModes) == namedPipeMode isRegularFile stat = (fileMode stat `intersectFileModes` fileTypeModes) == regularFileMode isDirectory stat = (fileMode stat `intersectFileModes` fileTypeModes) == directoryMode isSymbolicLink stat = (fileMode stat `intersectFileModes` fileTypeModes) == symbolicLinkMode isSocket stat = (fileMode stat `intersectFileModes` fileTypeModes) == socketMode -- | @getFileStatus path@ calls gets the @FileStatus@ information (user ID, -- size, access times, etc.) for the file @path@. -- -- Note: calls @stat@. getFileStatus :: FilePath -> IO FileStatus getFileStatus path = do fp <- mallocForeignPtrBytes (#const sizeof(struct stat)) withForeignPtr fp $ \p -> withCString path $ \s -> throwErrnoPathIfMinus1_ "getFileStatus" path (c_stat s p) return (FileStatus fp) -- | @getFdStatus fd@ acts as 'getFileStatus' but uses a file descriptor @fd@. -- -- Note: calls @fstat@. getFdStatus :: Fd -> IO FileStatus getFdStatus (Fd fd) = do fp <- mallocForeignPtrBytes (#const sizeof(struct stat)) withForeignPtr fp $ \p -> throwErrnoIfMinus1_ "getFdStatus" (c_fstat fd p) return (FileStatus fp) -- | Acts as 'getFileStatus' except when the 'FilePath' refers to a symbolic -- link. In that case the @FileStatus@ information of the symbolic link itself -- is returned instead of that of the file it points to. -- -- Note: calls @lstat@. getSymbolicLinkStatus :: FilePath -> IO FileStatus getSymbolicLinkStatus path = do fp <- mallocForeignPtrBytes (#const sizeof(struct stat)) withForeignPtr fp $ \p -> withCString path $ \s -> throwErrnoPathIfMinus1_ "getSymbolicLinkStatus" path (c_lstat s p) return (FileStatus fp) foreign import ccall unsafe "lstat" c_lstat :: CString -> Ptr CStat -> IO CInt -- | @createNamedPipe fifo mode@ -- creates a new named pipe, @fifo@, with permissions based on -- @mode@. May fail with 'throwErrnoPathIfMinus1_' if a file named @name@ -- already exists or if the effective user ID of the current process doesn't -- have permission to create the pipe. -- -- Note: calls @mkfifo@. createNamedPipe :: FilePath -> FileMode -> IO () createNamedPipe name mode = do withCString name $ \s -> throwErrnoPathIfMinus1_ "createNamedPipe" name (c_mkfifo s mode) -- | @createDevice path mode dev@ creates either a regular or a special file -- depending on the value of @mode@ (and @dev@). May fail with -- 'throwErrnoPathIfMinus1_' if a file named @name@ already exists or if the -- effective user ID of the current process doesn't have permission to create -- the file. -- -- Note: calls @mknod@. createDevice :: FilePath -> FileMode -> DeviceID -> IO () createDevice path mode dev = withCString path $ \s -> throwErrnoPathIfMinus1_ "createDevice" path (c_mknod s mode dev) foreign import ccall unsafe "mknod" c_mknod :: CString -> CMode -> CDev -> IO CInt -- ----------------------------------------------------------------------------- -- Hard links -- | @createLink old new@ creates a new path, @new@, linked to an existing file, -- @old@. -- -- Note: calls @link@. createLink :: FilePath -> FilePath -> IO () createLink name1 name2 = withCString name1 $ \s1 -> withCString name2 $ \s2 -> throwErrnoPathIfMinus1_ "createLink" name1 (c_link s1 s2) -- | @removeLink path@ removes the link named @path@. -- -- Note: calls @unlink@. removeLink :: FilePath -> IO () removeLink name = withCString name $ \s -> throwErrnoPathIfMinus1_ "removeLink" name (c_unlink s) -- ----------------------------------------------------------------------------- -- Symbolic Links -- | @createSymbolicLink file1 file2@ creates a symbolic link named @file2@ -- which points to the file @file1@. -- -- Symbolic links are interpreted at run-time as if the contents of the link -- had been substituted into the path being followed to find a file or directory. -- -- Note: calls @symlink@. createSymbolicLink :: FilePath -> FilePath -> IO () createSymbolicLink file1 file2 = withCString file1 $ \s1 -> withCString file2 $ \s2 -> throwErrnoPathIfMinus1_ "createSymbolicLink" file1 (c_symlink s1 s2) foreign import ccall unsafe "symlink" c_symlink :: CString -> CString -> IO CInt -- ToDo: should really use SYMLINK_MAX, but not everyone supports it yet, -- and it seems that the intention is that SYMLINK_MAX is no larger than -- PATH_MAX. #if !defined(PATH_MAX) -- PATH_MAX is not defined on systems with unlimited path length. -- Ugly. Fix this. #define PATH_MAX 4096 #endif -- | Reads the @FilePath@ pointed to by the symbolic link and returns it. -- -- Note: calls @readlink@. readSymbolicLink :: FilePath -> IO FilePath readSymbolicLink file = allocaArray0 (#const PATH_MAX) $ \buf -> do withCString file $ \s -> do len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $ c_readlink s buf (#const PATH_MAX) peekCStringLen (buf,fromIntegral len) foreign import ccall unsafe "readlink" c_readlink :: CString -> CString -> CInt -> IO CInt -- ----------------------------------------------------------------------------- -- Renaming files -- | @rename old new@ renames a file or directory from @old@ to @new@. -- -- Note: calls @rename@. rename :: FilePath -> FilePath -> IO () rename name1 name2 = withCString name1 $ \s1 -> withCString name2 $ \s2 -> throwErrnoPathIfMinus1_ "rename" name1 (c_rename s1 s2) -- ----------------------------------------------------------------------------- -- chown() -- | @setOwnerAndGroup path uid gid@ changes the owner and group of @path@ to -- @uid@ and @gid@, respectively. -- -- If @uid@ or @gid@ is specified as -1, then that ID is not changed. -- -- Note: calls @chown@. setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () setOwnerAndGroup name uid gid = do withCString name $ \s -> throwErrnoPathIfMinus1_ "setOwnerAndGroup" name (c_chown s uid gid) foreign import ccall unsafe "chown" c_chown :: CString -> CUid -> CGid -> IO CInt -- | Acts as 'setOwnerAndGroup' but uses a file descriptor instead of a -- 'FilePath'. -- -- Note: calls @fchown@. setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO () setFdOwnerAndGroup (Fd fd) uid gid = throwErrnoIfMinus1_ "setFdOwnerAndGroup" (c_fchown fd uid gid) foreign import ccall unsafe "fchown" c_fchown :: CInt -> CUid -> CGid -> IO CInt #if HAVE_LCHOWN -- | Acts as 'setOwnerAndGroup' but does not follow symlinks (and thus -- changes permissions on the link itself). -- -- Note: calls @lchown@. setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () setSymbolicLinkOwnerAndGroup name uid gid = do withCString name $ \s -> throwErrnoPathIfMinus1_ "setSymbolicLinkOwnerAndGroup" name (c_lchown s uid gid) foreign import ccall unsafe "lchown" c_lchown :: CString -> CUid -> CGid -> IO CInt #endif -- ----------------------------------------------------------------------------- -- utime() -- | @setFileTimes path atime mtime@ sets the access and modification times -- associated with file @path@ to @atime@ and @mtime@, respectively. -- -- Note: calls @utime@. setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO () setFileTimes name atime mtime = do withCString name $ \s -> allocaBytes (#const sizeof(struct utimbuf)) $ \p -> do (#poke struct utimbuf, actime) p atime (#poke struct utimbuf, modtime) p mtime throwErrnoPathIfMinus1_ "setFileTimes" name (c_utime s p) -- | @touchFile path@ sets the access and modification times associated with -- file @path@ to the current time. -- -- Note: calls @utime@. touchFile :: FilePath -> IO () touchFile name = do withCString name $ \s -> throwErrnoPathIfMinus1_ "touchFile" name (c_utime s nullPtr) -- ----------------------------------------------------------------------------- -- Setting file sizes -- | Truncates the file down to the specified length. If the file was larger -- than the given length before this operation was performed the extra is lost. -- -- Note: calls @truncate@. setFileSize :: FilePath -> FileOffset -> IO () setFileSize file off = withCString file $ \s -> throwErrnoPathIfMinus1_ "setFileSize" file (c_truncate s off) foreign import ccall unsafe "truncate" c_truncate :: CString -> COff -> IO CInt -- | Acts as 'setFileSize' but uses a file descriptor instead of a 'FilePath'. -- -- Note: calls @ftruncate@. setFdSize :: Fd -> FileOffset -> IO () setFdSize (Fd fd) off = throwErrnoIfMinus1_ "setFdSize" (c_ftruncate fd off) -- ----------------------------------------------------------------------------- -- pathconf()/fpathconf() support data PathVar = FileSizeBits {- _PC_FILESIZEBITS -} | LinkLimit {- _PC_LINK_MAX -} | InputLineLimit {- _PC_MAX_CANON -} | InputQueueLimit {- _PC_MAX_INPUT -} | FileNameLimit {- _PC_NAME_MAX -} | PathNameLimit {- _PC_PATH_MAX -} | PipeBufferLimit {- _PC_PIPE_BUF -} -- These are described as optional in POSIX: {- _PC_ALLOC_SIZE_MIN -} {- _PC_REC_INCR_XFER_SIZE -} {- _PC_REC_MAX_XFER_SIZE -} {- _PC_REC_MIN_XFER_SIZE -} {- _PC_REC_XFER_ALIGN -} | SymbolicLinkLimit {- _PC_SYMLINK_MAX -} | SetOwnerAndGroupIsRestricted {- _PC_CHOWN_RESTRICTED -} | FileNamesAreNotTruncated {- _PC_NO_TRUNC -} | VDisableChar {- _PC_VDISABLE -} | AsyncIOAvailable {- _PC_ASYNC_IO -} | PrioIOAvailable {- _PC_PRIO_IO -} | SyncIOAvailable {- _PC_SYNC_IO -} pathVarConst :: PathVar -> CInt pathVarConst v = case v of LinkLimit -> (#const _PC_LINK_MAX) InputLineLimit -> (#const _PC_MAX_CANON) InputQueueLimit -> (#const _PC_MAX_INPUT) FileNameLimit -> (#const _PC_NAME_MAX) PathNameLimit -> (#const _PC_PATH_MAX) PipeBufferLimit -> (#const _PC_PIPE_BUF) SetOwnerAndGroupIsRestricted -> (#const _PC_CHOWN_RESTRICTED) FileNamesAreNotTruncated -> (#const _PC_NO_TRUNC) VDisableChar -> (#const _PC_VDISABLE) #ifdef _PC_SYNC_IO SyncIOAvailable -> (#const _PC_SYNC_IO) #else SyncIOAvailable -> error "_PC_SYNC_IO not available" #endif #ifdef _PC_ASYNC_IO AsyncIOAvailable -> (#const _PC_ASYNC_IO) #else AsyncIOAvailable -> error "_PC_ASYNC_IO not available" #endif #ifdef _PC_PRIO_IO PrioIOAvailable -> (#const _PC_PRIO_IO) #else PrioIOAvailable -> error "_PC_PRIO_IO not available" #endif #if _PC_FILESIZEBITS FileSizeBits -> (#const _PC_FILESIZEBITS) #else FileSizeBits -> error "_PC_FILESIZEBITS not available" #endif #if _PC_SYMLINK_MAX SymbolicLinkLimit -> (#const _PC_SYMLINK_MAX) #else SymbolicLinkLimit -> error "_PC_SYMLINK_MAX not available" #endif -- | @getPathVar var path@ obtains the dynamic value of the requested -- configurable file limit or option associated with file or directory @path@. -- For defined file limits, @getPathVar@ returns the associated -- value. For defined file options, the result of @getPathVar@ -- is undefined, but not failure. -- -- Note: calls @pathconf@. getPathVar :: FilePath -> PathVar -> IO Limit getPathVar name v = do withCString name $ \ nameP -> throwErrnoPathIfMinus1 "getPathVar" name $ c_pathconf nameP (pathVarConst v) foreign import ccall unsafe "pathconf" c_pathconf :: CString -> CInt -> IO CLong -- | @getFdPathVar var fd@ obtains the dynamic value of the requested -- configurable file limit or option associated with the file or directory -- attached to the open channel @fd@. For defined file limits, @getFdPathVar@ -- returns the associated value. For defined file options, the result of -- @getFdPathVar@ is undefined, but not failure. -- -- Note: calls @fpathconf@. getFdPathVar :: Fd -> PathVar -> IO Limit getFdPathVar fd v = throwErrnoIfMinus1 "getFdPathVar" $ c_fpathconf fd (pathVarConst v) foreign import ccall unsafe "fpathconf" c_fpathconf :: Fd -> CInt -> IO CLong hugs98-plus-Sep2006/packages/unix/System/Posix/IO.hsc0000644006511100651110000003001710504340274021120 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.IO -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX IO support. These types and functions correspond to the unix -- functions open(2), close(2), etc. For more portable functions -- which are more like fopen(3) and friends from stdio.h, see -- 'System.IO'. -- ----------------------------------------------------------------------------- module System.Posix.IO ( -- * Input \/ Output -- ** Standard file descriptors stdInput, stdOutput, stdError, -- ** Opening and closing files OpenMode(..), OpenFileFlags(..), defaultFileFlags, openFd, createFile, closeFd, -- ** Reading\/writing data -- |Programmers using the 'fdRead' and 'fdWrite' API should be aware that -- EAGAIN exceptions may occur for non-blocking IO! fdRead, fdWrite, -- ** Seeking fdSeek, -- ** File options FdOption(..), queryFdOption, setFdOption, -- ** Locking FileLock, LockRequest(..), getLock, setLock, waitToSetLock, -- ** Pipes createPipe, -- ** Duplicating file descriptors dup, dupTo, -- ** Converting file descriptors to\/from Handles handleToFd, fdToHandle, ) where import System.IO import System.IO.Error import System.Posix.Types import System.Posix.Error import System.Posix.Internals import Foreign import Foreign.C import Data.Bits #ifdef __GLASGOW_HASKELL__ import GHC.IOBase import GHC.Handle hiding (fdToHandle, openFd) import qualified GHC.Handle #endif #ifdef __HUGS__ import Hugs.Prelude (IOException(..), IOErrorType(..)) import qualified Hugs.IO (handleToFd, openFd) #endif #include "HsUnix.h" -- ----------------------------------------------------------------------------- -- Pipes -- |The 'createPipe' function creates a pair of connected file -- descriptors. The first component is the fd to read from, the second -- is the write end. Although pipes may be bidirectional, this -- behaviour is not portable and programmers should use two separate -- pipes for this purpose. May throw an exception if this is an -- invalid descriptor. createPipe :: IO (Fd, Fd) createPipe = allocaArray 2 $ \p_fd -> do throwErrnoIfMinus1_ "createPipe" (c_pipe p_fd) rfd <- peekElemOff p_fd 0 wfd <- peekElemOff p_fd 1 return (Fd rfd, Fd wfd) -- ----------------------------------------------------------------------------- -- Duplicating file descriptors -- | May throw an exception if this is an invalid descriptor. dup :: Fd -> IO Fd dup (Fd fd) = do r <- throwErrnoIfMinus1 "dup" (c_dup fd); return (Fd r) -- | May throw an exception if this is an invalid descriptor. dupTo :: Fd -> Fd -> IO Fd dupTo (Fd fd1) (Fd fd2) = do r <- throwErrnoIfMinus1 "dupTo" (c_dup2 fd1 fd2) return (Fd r) -- ----------------------------------------------------------------------------- -- Opening and closing files stdInput, stdOutput, stdError :: Fd stdInput = Fd (#const STDIN_FILENO) stdOutput = Fd (#const STDOUT_FILENO) stdError = Fd (#const STDERR_FILENO) data OpenMode = ReadOnly | WriteOnly | ReadWrite -- |Correspond to some of the int flags from C's fcntl.h. data OpenFileFlags = OpenFileFlags { append :: Bool, -- ^ O_APPEND exclusive :: Bool, -- ^ O_EXCL noctty :: Bool, -- ^ O_NOCTTY nonBlock :: Bool, -- ^ O_NONBLOCK trunc :: Bool -- ^ O_TRUNC } -- |Default values for the 'OpenFileFlags' type. False for each of -- append, exclusive, noctty, nonBlock, and trunc. defaultFileFlags :: OpenFileFlags defaultFileFlags = OpenFileFlags { append = False, exclusive = False, noctty = False, nonBlock = False, trunc = False } -- |Open and optionally create this file. See 'System.Posix.Files' -- for information on how to use the 'FileMode' type. openFd :: FilePath -> OpenMode -> Maybe FileMode -- ^Just x => creates the file with the given modes, Nothing => the file must exist. -> OpenFileFlags -> IO Fd openFd name how maybe_mode (OpenFileFlags append exclusive noctty nonBlock truncate) = do withCString name $ \s -> do fd <- throwErrnoPathIfMinus1 "openFd" name (c_open s all_flags mode_w) return (Fd fd) where all_flags = creat .|. flags .|. open_mode flags = (if append then (#const O_APPEND) else 0) .|. (if exclusive then (#const O_EXCL) else 0) .|. (if noctty then (#const O_NOCTTY) else 0) .|. (if nonBlock then (#const O_NONBLOCK) else 0) .|. (if truncate then (#const O_TRUNC) else 0) (creat, mode_w) = case maybe_mode of Nothing -> (0,0) Just x -> ((#const O_CREAT), x) open_mode = case how of ReadOnly -> (#const O_RDONLY) WriteOnly -> (#const O_WRONLY) ReadWrite -> (#const O_RDWR) -- |Create and open this file in WriteOnly mode. A special case of -- 'openFd'. See 'System.Posix.Files' for information on how to use -- the 'FileMode' type. createFile :: FilePath -> FileMode -> IO Fd createFile name mode = openFd name WriteOnly (Just mode) defaultFileFlags{ trunc=True } -- |Close this file descriptor. May throw an exception if this is an -- invalid descriptor. closeFd :: Fd -> IO () closeFd (Fd fd) = throwErrnoIfMinus1_ "closeFd" (c_close fd) -- ----------------------------------------------------------------------------- -- Converting file descriptors to/from Handles -- | Extracts the 'Fd' from a 'Handle'. This function has the side effect -- of closing the 'Handle' and flushing its write buffer, if necessary. handleToFd :: Handle -> IO Fd -- | Converts an 'Fd' into a 'Handle' that can be used with the -- standard Haskell IO library (see "System.IO"). -- -- GHC only: this function has the side effect of putting the 'Fd' -- into non-blocking mode (@O_NONBLOCK@) due to the way the standard -- IO library implements multithreaded I\/O. -- fdToHandle :: Fd -> IO Handle #ifdef __GLASGOW_HASKELL__ handleToFd h = withHandle "handleToFd" h $ \ h_ -> do -- converting a Handle into an Fd effectively means -- letting go of the Handle; it is put into a closed -- state as a result. let fd = haFD h_ flushWriteBufferOnly h_ unlockFile (fromIntegral fd) -- setting the Handle's fd to (-1) as well as its 'type' -- to closed, is enough to disable the finalizer that -- eventually is run on the Handle. return (h_{haFD= (-1),haType=ClosedHandle}, Fd (fromIntegral fd)) fdToHandle fd = GHC.Handle.fdToHandle (fromIntegral fd) #endif #ifdef __HUGS__ handleToFd h = do fd <- Hugs.IO.handleToFd h return (fromIntegral fd) fdToHandle fd = do mode <- fdGetMode (fromIntegral fd) Hugs.IO.openFd (fromIntegral fd) False mode True #endif -- ----------------------------------------------------------------------------- -- Fd options data FdOption = AppendOnWrite -- ^O_APPEND | CloseOnExec -- ^FD_CLOEXEC | NonBlockingRead -- ^O_NONBLOCK | SynchronousWrites -- ^O_SYNC fdOption2Int :: FdOption -> CInt fdOption2Int CloseOnExec = (#const FD_CLOEXEC) fdOption2Int AppendOnWrite = (#const O_APPEND) fdOption2Int NonBlockingRead = (#const O_NONBLOCK) fdOption2Int SynchronousWrites = (#const O_SYNC) -- | May throw an exception if this is an invalid descriptor. queryFdOption :: Fd -> FdOption -> IO Bool queryFdOption (Fd fd) opt = do r <- throwErrnoIfMinus1 "queryFdOption" (c_fcntl_read fd flag) return ((r .&. fdOption2Int opt) /= 0) where flag = case opt of CloseOnExec -> (#const F_GETFD) other -> (#const F_GETFL) -- | May throw an exception if this is an invalid descriptor. setFdOption :: Fd -> FdOption -> Bool -> IO () setFdOption (Fd fd) opt val = do r <- throwErrnoIfMinus1 "setFdOption" (c_fcntl_read fd getflag) let r' | val = r .|. opt_val | otherwise = r .&. (complement opt_val) throwErrnoIfMinus1_ "setFdOption" (c_fcntl_write fd setflag r') where (getflag,setflag)= case opt of CloseOnExec -> ((#const F_GETFD),(#const F_SETFD)) other -> ((#const F_GETFL),(#const F_SETFL)) opt_val = fdOption2Int opt -- ----------------------------------------------------------------------------- -- Seeking mode2Int :: SeekMode -> CInt mode2Int AbsoluteSeek = (#const SEEK_SET) mode2Int RelativeSeek = (#const SEEK_CUR) mode2Int SeekFromEnd = (#const SEEK_END) -- | May throw an exception if this is an invalid descriptor. fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset fdSeek (Fd fd) mode off = throwErrnoIfMinus1 "fdSeek" (c_lseek fd off (mode2Int mode)) -- ----------------------------------------------------------------------------- -- Locking data LockRequest = ReadLock | WriteLock | Unlock type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset) -- | May throw an exception if this is an invalid descriptor. getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock)) getLock (Fd fd) lock = allocaLock lock $ \p_flock -> do throwErrnoIfMinus1_ "getLock" (c_fcntl_lock fd (#const F_GETLK) p_flock) result <- bytes2ProcessIDAndLock p_flock return (maybeResult result) where maybeResult (_, (Unlock, _, _, _)) = Nothing maybeResult x = Just x allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a allocaLock (lockreq, mode, start, len) io = allocaBytes (#const sizeof(struct flock)) $ \p -> do (#poke struct flock, l_type) p (lockReq2Int lockreq :: CShort) (#poke struct flock, l_whence) p (fromIntegral (mode2Int mode) :: CShort) (#poke struct flock, l_start) p start (#poke struct flock, l_len) p len io p lockReq2Int :: LockRequest -> CShort lockReq2Int ReadLock = (#const F_RDLCK) lockReq2Int WriteLock = (#const F_WRLCK) lockReq2Int Unlock = (#const F_UNLCK) bytes2ProcessIDAndLock :: Ptr CFLock -> IO (ProcessID, FileLock) bytes2ProcessIDAndLock p = do req <- (#peek struct flock, l_type) p mode <- (#peek struct flock, l_whence) p start <- (#peek struct flock, l_start) p len <- (#peek struct flock, l_len) p pid <- (#peek struct flock, l_pid) p return (pid, (int2req req, int2mode mode, start, len)) where int2req :: CShort -> LockRequest int2req (#const F_RDLCK) = ReadLock int2req (#const F_WRLCK) = WriteLock int2req (#const F_UNLCK) = Unlock int2req _ = error $ "int2req: bad argument" int2mode :: CShort -> SeekMode int2mode (#const SEEK_SET) = AbsoluteSeek int2mode (#const SEEK_CUR) = RelativeSeek int2mode (#const SEEK_END) = SeekFromEnd int2mode _ = error $ "int2mode: bad argument" -- | May throw an exception if this is an invalid descriptor. setLock :: Fd -> FileLock -> IO () setLock (Fd fd) lock = do allocaLock lock $ \p_flock -> throwErrnoIfMinus1_ "setLock" (c_fcntl_lock fd (#const F_SETLK) p_flock) -- | May throw an exception if this is an invalid descriptor. waitToSetLock :: Fd -> FileLock -> IO () waitToSetLock (Fd fd) lock = do allocaLock lock $ \p_flock -> throwErrnoIfMinus1_ "waitToSetLock" (c_fcntl_lock fd (#const F_SETLKW) p_flock) -- ----------------------------------------------------------------------------- -- fd{Read,Write} -- | May throw an exception if this is an invalid descriptor. fdRead :: Fd -> ByteCount -- ^How many bytes to read -> IO (String, ByteCount) -- ^The bytes read, how many bytes were read. fdRead _fd 0 = return ("", 0) fdRead (Fd fd) nbytes = do allocaBytes (fromIntegral nbytes) $ \ bytes -> do rc <- throwErrnoIfMinus1Retry "fdRead" (c_read fd bytes nbytes) case fromIntegral rc of 0 -> ioError (IOError Nothing EOF "fdRead" "EOF" Nothing) n -> do s <- peekCStringLen (bytes, fromIntegral n) return (s, n) -- | May throw an exception if this is an invalid descriptor. fdWrite :: Fd -> String -> IO ByteCount fdWrite (Fd fd) str = withCStringLen str $ \ (strPtr,len) -> do rc <- throwErrnoIfMinus1Retry "fdWrite" (c_write fd strPtr (fromIntegral len)) return (fromIntegral rc) hugs98-plus-Sep2006/packages/unix/System/Posix/Process.hsc0000644006511100651110000003340010504340275022227 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Process -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX process support -- ----------------------------------------------------------------------------- module System.Posix.Process ( -- * Processes -- ** Forking and executing #ifdef __GLASGOW_HASKELL__ forkProcess, #endif executeFile, -- ** Exiting exitImmediately, -- ** Process environment getProcessID, getParentProcessID, getProcessGroupID, -- ** Process groups createProcessGroup, joinProcessGroup, setProcessGroupID, -- ** Sessions createSession, -- ** Process times ProcessTimes(..), getProcessTimes, -- ** Scheduling priority nice, getProcessPriority, getProcessGroupPriority, getUserPriority, setProcessPriority, setProcessGroupPriority, setUserPriority, -- ** Process status ProcessStatus(..), getProcessStatus, getAnyProcessStatus, getGroupProcessStatus, ) where #include "HsUnix.h" import Foreign.C.Error import Foreign.C.String ( CString, withCString ) import Foreign.C.Types ( CInt, CClock ) import Foreign.Marshal.Alloc ( alloca, allocaBytes ) import Foreign.Marshal.Array ( withArray0 ) import Foreign.Marshal.Utils ( withMany ) import Foreign.Ptr ( Ptr, nullPtr ) import Foreign.StablePtr ( StablePtr, newStablePtr, freeStablePtr ) import Foreign.Storable ( Storable(..) ) import System.IO import System.IO.Error import System.Exit import System.Posix.Error import System.Posix.Types import System.Posix.Signals import System.Process.Internals ( pPrPr_disableITimers, c_execvpe ) import Control.Monad #ifdef __GLASGOW_HASKELL__ import GHC.TopHandler ( runIO ) #endif #ifdef __HUGS__ {-# CFILES cbits/HsUnix.c #-} #endif -- ----------------------------------------------------------------------------- -- Process environment -- | 'getProcessID' calls @getpid@ to obtain the 'ProcessID' for -- the current process. getProcessID :: IO ProcessID getProcessID = c_getpid foreign import ccall unsafe "getpid" c_getpid :: IO CPid -- | 'getProcessID' calls @getppid@ to obtain the 'ProcessID' for -- the parent of the current process. getParentProcessID :: IO ProcessID getParentProcessID = c_getppid foreign import ccall unsafe "getppid" c_getppid :: IO CPid -- | 'getProcessGroupID' calls @getpgrp@ to obtain the -- 'ProcessGroupID' for the current process. getProcessGroupID :: IO ProcessGroupID getProcessGroupID = c_getpgrp foreign import ccall unsafe "getpgrp" c_getpgrp :: IO CPid -- | @'createProcessGroup' pid@ calls @setpgid@ to make -- process @pid@ a new process group leader. createProcessGroup :: ProcessID -> IO ProcessGroupID createProcessGroup pid = do throwErrnoIfMinus1_ "createProcessGroup" (c_setpgid pid 0) return pid -- | @'joinProcessGroup' pgid@ calls @setpgid@ to set the -- 'ProcessGroupID' of the current process to @pgid@. joinProcessGroup :: ProcessGroupID -> IO () joinProcessGroup pgid = throwErrnoIfMinus1_ "joinProcessGroup" (c_setpgid 0 pgid) -- | @'setProcessGroupID' pid pgid@ calls @setpgid@ to set the -- 'ProcessGroupID' for process @pid@ to @pgid@. setProcessGroupID :: ProcessID -> ProcessGroupID -> IO () setProcessGroupID pid pgid = throwErrnoIfMinus1_ "setProcessGroupID" (c_setpgid pid pgid) foreign import ccall unsafe "setpgid" c_setpgid :: CPid -> CPid -> IO CInt -- | 'createSession' calls @setsid@ to create a new session -- with the current process as session leader. createSession :: IO ProcessGroupID createSession = throwErrnoIfMinus1 "createSession" c_setsid foreign import ccall unsafe "setsid" c_setsid :: IO CPid -- ----------------------------------------------------------------------------- -- Process times -- All times in clock ticks (see getClockTick) data ProcessTimes = ProcessTimes { elapsedTime :: ClockTick , userTime :: ClockTick , systemTime :: ClockTick , childUserTime :: ClockTick , childSystemTime :: ClockTick } -- | 'getProcessTimes' calls @times@ to obtain time-accounting -- information for the current process and its children. getProcessTimes :: IO ProcessTimes getProcessTimes = do allocaBytes (#const sizeof(struct tms)) $ \p_tms -> do elapsed <- throwErrnoIfMinus1 "getProcessTimes" (c_times p_tms) ut <- (#peek struct tms, tms_utime) p_tms st <- (#peek struct tms, tms_stime) p_tms cut <- (#peek struct tms, tms_cutime) p_tms cst <- (#peek struct tms, tms_cstime) p_tms return (ProcessTimes{ elapsedTime = elapsed, userTime = ut, systemTime = st, childUserTime = cut, childSystemTime = cst }) type CTms = () foreign import ccall unsafe "times" c_times :: Ptr CTms -> IO CClock -- ----------------------------------------------------------------------------- -- Process scheduling priority nice :: Int -> IO () nice prio = do resetErrno res <- c_nice (fromIntegral prio) when (res == -1) $ do err <- getErrno when (err /= eOK) (throwErrno "nice") foreign import ccall unsafe "nice" c_nice :: CInt -> IO CInt getProcessPriority :: ProcessID -> IO Int getProcessGroupPriority :: ProcessGroupID -> IO Int getUserPriority :: UserID -> IO Int getProcessPriority pid = do r <- throwErrnoIfMinus1 "getProcessPriority" $ c_getpriority (#const PRIO_PROCESS) (fromIntegral pid) return (fromIntegral r) getProcessGroupPriority pid = do r <- throwErrnoIfMinus1 "getProcessPriority" $ c_getpriority (#const PRIO_PGRP) (fromIntegral pid) return (fromIntegral r) getUserPriority uid = do r <- throwErrnoIfMinus1 "getUserPriority" $ c_getpriority (#const PRIO_USER) (fromIntegral uid) return (fromIntegral r) foreign import ccall unsafe "getpriority" c_getpriority :: CInt -> CInt -> IO CInt setProcessPriority :: ProcessID -> Int -> IO () setProcessGroupPriority :: ProcessGroupID -> Int -> IO () setUserPriority :: UserID -> Int -> IO () setProcessPriority pid val = throwErrnoIfMinus1_ "setProcessPriority" $ c_setpriority (#const PRIO_PROCESS) (fromIntegral pid) (fromIntegral val) setProcessGroupPriority pid val = throwErrnoIfMinus1_ "setProcessPriority" $ c_setpriority (#const PRIO_PGRP) (fromIntegral pid) (fromIntegral val) setUserPriority uid val = throwErrnoIfMinus1_ "setUserPriority" $ c_setpriority (#const PRIO_USER) (fromIntegral uid) (fromIntegral val) foreign import ccall unsafe "setpriority" c_setpriority :: CInt -> CInt -> CInt -> IO CInt -- ----------------------------------------------------------------------------- -- Forking, execution #ifdef __GLASGOW_HASKELL__ {- | 'forkProcess' corresponds to the POSIX @fork@ system call. The 'IO' action passed as an argument is executed in the child process; no other threads will be copied to the child process. On success, 'forkProcess' returns the child's 'ProcessID' to the parent process; in case of an error, an exception is thrown. -} forkProcess :: IO () -> IO ProcessID forkProcess action = do stable <- newStablePtr (runIO action) pid <- throwErrnoIfMinus1 "forkProcess" (forkProcessPrim stable) freeStablePtr stable return $ fromIntegral pid foreign import ccall "forkProcess" forkProcessPrim :: StablePtr (IO ()) -> IO CPid #endif /* __GLASGOW_HASKELL__ */ -- | @'executeFile' cmd args env@ calls one of the -- @execv*@ family, depending on whether or not the current -- PATH is to be searched for the command, and whether or not an -- environment is provided to supersede the process's current -- environment. The basename (leading directory names suppressed) of -- the command is passed to @execv*@ as @arg[0]@; -- the argument list passed to 'executeFile' therefore -- begins with @arg[1]@. executeFile :: FilePath -- ^ Command -> Bool -- ^ Search PATH? -> [String] -- ^ Arguments -> Maybe [(String, String)] -- ^ Environment -> IO () executeFile path search args Nothing = do withCString path $ \s -> withMany withCString (path:args) $ \cstrs -> withArray0 nullPtr cstrs $ \arr -> do pPrPr_disableITimers if search then throwErrnoPathIfMinus1_ "executeFile" path (c_execvp s arr) else throwErrnoPathIfMinus1_ "executeFile" path (c_execv s arr) executeFile path search args (Just env) = do withCString path $ \s -> withMany withCString (path:args) $ \cstrs -> withArray0 nullPtr cstrs $ \arg_arr -> let env' = map (\ (name, val) -> name ++ ('=' : val)) env in withMany withCString env' $ \cenv -> withArray0 nullPtr cenv $ \env_arr -> do pPrPr_disableITimers if search then throwErrnoPathIfMinus1_ "executeFile" path (c_execvpe s arg_arr env_arr) else throwErrnoPathIfMinus1_ "executeFile" path (c_execve s arg_arr env_arr) foreign import ccall unsafe "execvp" c_execvp :: CString -> Ptr CString -> IO CInt foreign import ccall unsafe "execv" c_execv :: CString -> Ptr CString -> IO CInt foreign import ccall unsafe "execve" c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt -- ----------------------------------------------------------------------------- -- Waiting for process termination data ProcessStatus = Exited ExitCode | Terminated Signal | Stopped Signal deriving (Eq, Ord, Show) -- | @'getProcessStatus' blk stopped pid@ calls @waitpid@, returning -- @'Just' tc@, the 'ProcessStatus' for process @pid@ if it is -- available, 'Nothing' otherwise. If @blk@ is 'False', then -- @WNOHANG@ is set in the options for @waitpid@, otherwise not. -- If @stopped@ is 'True', then @WUNTRACED@ is set in the -- options for @waitpid@, otherwise not. getProcessStatus :: Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus) getProcessStatus block stopped pid = alloca $ \wstatp -> do pid <- throwErrnoIfMinus1Retry "getProcessStatus" (c_waitpid pid wstatp (waitOptions block stopped)) case pid of 0 -> return Nothing _ -> do ps <- decipherWaitStatus wstatp return (Just ps) -- safe, because this call might block foreign import ccall safe "waitpid" c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid -- | @'getGroupProcessStatus' blk stopped pgid@ calls @waitpid@, -- returning @'Just' (pid, tc)@, the 'ProcessID' and -- 'ProcessStatus' for any process in group @pgid@ if one is -- available, 'Nothing' otherwise. If @blk@ is 'False', then -- @WNOHANG@ is set in the options for @waitpid@, otherwise not. -- If @stopped@ is 'True', then @WUNTRACED@ is set in the -- options for @waitpid@, otherwise not. getGroupProcessStatus :: Bool -> Bool -> ProcessGroupID -> IO (Maybe (ProcessID, ProcessStatus)) getGroupProcessStatus block stopped pgid = alloca $ \wstatp -> do pid <- throwErrnoIfMinus1Retry "getGroupProcessStatus" (c_waitpid (-pgid) wstatp (waitOptions block stopped)) case pid of 0 -> return Nothing _ -> do ps <- decipherWaitStatus wstatp return (Just (pid, ps)) -- | @'getAnyProcessStatus' blk stopped@ calls @waitpid@, returning -- @'Just' (pid, tc)@, the 'ProcessID' and 'ProcessStatus' for any -- child process if one is available, 'Nothing' otherwise. If -- @blk@ is 'False', then @WNOHANG@ is set in the options for -- @waitpid@, otherwise not. If @stopped@ is 'True', then -- @WUNTRACED@ is set in the options for @waitpid@, otherwise not. getAnyProcessStatus :: Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus)) getAnyProcessStatus block stopped = getGroupProcessStatus block stopped 1 waitOptions :: Bool -> Bool -> CInt -- block stopped waitOptions False False = (#const WNOHANG) waitOptions False True = (#const (WNOHANG|WUNTRACED)) waitOptions True False = 0 waitOptions True True = (#const WUNTRACED) -- Turn a (ptr to a) wait status into a ProcessStatus decipherWaitStatus :: Ptr CInt -> IO ProcessStatus decipherWaitStatus wstatp = do wstat <- peek wstatp if c_WIFEXITED wstat /= 0 then do let exitstatus = c_WEXITSTATUS wstat if exitstatus == 0 then return (Exited ExitSuccess) else return (Exited (ExitFailure (fromIntegral exitstatus))) else do if c_WIFSIGNALED wstat /= 0 then do let termsig = c_WTERMSIG wstat return (Terminated (fromIntegral termsig)) else do if c_WIFSTOPPED wstat /= 0 then do let stopsig = c_WSTOPSIG wstat return (Stopped (fromIntegral stopsig)) else do ioError (mkIOError illegalOperationErrorType "waitStatus" Nothing Nothing) foreign import ccall unsafe "__hsunix_wifexited" c_WIFEXITED :: CInt -> CInt foreign import ccall unsafe "__hsunix_wexitstatus" c_WEXITSTATUS :: CInt -> CInt foreign import ccall unsafe "__hsunix_wifsignaled" c_WIFSIGNALED :: CInt -> CInt foreign import ccall unsafe "__hsunix_wtermsig" c_WTERMSIG :: CInt -> CInt foreign import ccall unsafe "__hsunix_wifstopped" c_WIFSTOPPED :: CInt -> CInt foreign import ccall unsafe "__hsunix_wstopsig" c_WSTOPSIG :: CInt -> CInt -- ----------------------------------------------------------------------------- -- Exiting -- | @'exitImmediately' status@ calls @_exit@ to terminate the process -- with the indicated exit @status@. -- The operation never returns. exitImmediately :: ExitCode -> IO () exitImmediately exitcode = c_exit (exitcode2Int exitcode) where exitcode2Int ExitSuccess = 0 exitcode2Int (ExitFailure n) = fromIntegral n foreign import ccall unsafe "exit" c_exit :: CInt -> IO () -- ----------------------------------------------------------------------------- hugs98-plus-Sep2006/packages/unix/System/Posix/Resource.hsc0000644006511100651110000001046010504340274022400 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Resource -- Copyright : (c) The University of Glasgow 2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX resource support -- ----------------------------------------------------------------------------- module System.Posix.Resource ( -- * Resource Limits ResourceLimit(..), ResourceLimits(..), Resource(..), getResourceLimit, setResourceLimit, ) where #include "HsUnix.h" import System.Posix.Types import Foreign import Foreign.C -- ----------------------------------------------------------------------------- -- Resource limits data Resource = ResourceCoreFileSize | ResourceCPUTime | ResourceDataSize | ResourceFileSize | ResourceOpenFiles | ResourceStackSize #ifdef RLIMIT_AS | ResourceTotalMemory #endif deriving Eq data ResourceLimits = ResourceLimits { softLimit, hardLimit :: ResourceLimit } deriving Eq data ResourceLimit = ResourceLimitInfinity | ResourceLimitUnknown | ResourceLimit Integer deriving Eq type RLimit = () foreign import ccall unsafe "getrlimit" c_getrlimit :: CInt -> Ptr RLimit -> IO CInt foreign import ccall unsafe "setrlimit" c_setrlimit :: CInt -> Ptr RLimit -> IO CInt getResourceLimit :: Resource -> IO ResourceLimits getResourceLimit res = do allocaBytes (#const sizeof(struct rlimit)) $ \p_rlimit -> do throwErrnoIfMinus1 "getResourceLimit" $ c_getrlimit (packResource res) p_rlimit soft <- (#peek struct rlimit, rlim_cur) p_rlimit hard <- (#peek struct rlimit, rlim_max) p_rlimit return (ResourceLimits { softLimit = unpackRLimit soft, hardLimit = unpackRLimit hard }) setResourceLimit :: Resource -> ResourceLimits -> IO () setResourceLimit res ResourceLimits{softLimit=soft,hardLimit=hard} = do allocaBytes (#const sizeof(struct rlimit)) $ \p_rlimit -> do (#poke struct rlimit, rlim_cur) p_rlimit (packRLimit soft True) (#poke struct rlimit, rlim_max) p_rlimit (packRLimit hard False) throwErrnoIfMinus1 "setResourceLimit" $ c_setrlimit (packResource res) p_rlimit return () packResource :: Resource -> CInt packResource ResourceCoreFileSize = (#const RLIMIT_CORE) packResource ResourceCPUTime = (#const RLIMIT_CPU) packResource ResourceDataSize = (#const RLIMIT_DATA) packResource ResourceFileSize = (#const RLIMIT_FSIZE) packResource ResourceOpenFiles = (#const RLIMIT_NOFILE) packResource ResourceStackSize = (#const RLIMIT_STACK) #ifdef RLIMIT_AS packResource ResourceTotalMemory = (#const RLIMIT_AS) #endif unpackRLimit :: CRLim -> ResourceLimit unpackRLimit (#const RLIM_INFINITY) = ResourceLimitInfinity #ifdef RLIM_SAVED_MAX unpackRLimit (#const RLIM_SAVED_MAX) = ResourceLimitUnknown unpackRLimit (#const RLIM_SAVED_CUR) = ResourceLimitUnknown #endif unpackRLimit other = ResourceLimit (fromIntegral other) packRLimit :: ResourceLimit -> Bool -> CRLim packRLimit ResourceLimitInfinity _ = (#const RLIM_INFINITY) #ifdef RLIM_SAVED_MAX packRLimit ResourceLimitUnknown True = (#const RLIM_SAVED_CUR) packRLimit ResourceLimitUnknown False = (#const RLIM_SAVED_MAX) #endif packRLimit (ResourceLimit other) _ = fromIntegral other -- ----------------------------------------------------------------------------- -- Test code {- import System.Posix import Control.Monad main = do zipWithM_ (\r n -> setResourceLimit r ResourceLimits{ hardLimit = ResourceLimit n, softLimit = ResourceLimit n }) allResources [1..] showAll mapM_ (\r -> setResourceLimit r ResourceLimits{ hardLimit = ResourceLimit 1, softLimit = ResourceLimitInfinity }) allResources -- should fail showAll = mapM_ (\r -> getResourceLimit r >>= (putStrLn . showRLims)) allResources allResources = [ResourceCoreFileSize, ResourceCPUTime, ResourceDataSize, ResourceFileSize, ResourceOpenFiles, ResourceStackSize #ifdef RLIMIT_AS , ResourceTotalMemory #endif ] showRLims ResourceLimits{hardLimit=h,softLimit=s} = "hard: " ++ showRLim h ++ ", soft: " ++ showRLim s showRLim ResourceLimitInfinity = "infinity" showRLim ResourceLimitUnknown = "unknown" showRLim (ResourceLimit other) = show other -} hugs98-plus-Sep2006/packages/unix/System/Posix/Terminal.hsc0000644006511100651110000006306010504340274022370 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Terminal -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX Terminal support -- ----------------------------------------------------------------------------- module System.Posix.Terminal ( -- * Terminal support -- ** Terminal attributes TerminalAttributes, getTerminalAttributes, TerminalState(..), setTerminalAttributes, TerminalMode(..), withoutMode, withMode, terminalMode, bitsPerByte, withBits, ControlCharacter(..), controlChar, withCC, withoutCC, inputTime, withTime, minInput, withMinInput, BaudRate(..), inputSpeed, withInputSpeed, outputSpeed, withOutputSpeed, -- ** Terminal operations sendBreak, drainOutput, QueueSelector(..), discardData, FlowAction(..), controlFlow, -- ** Process groups getTerminalProcessGroupID, setTerminalProcessGroupID, -- ** Testing a file descriptor queryTerminal, getTerminalName, getControllingTerminalName ) where #include "HsUnix.h" import Data.Bits import Data.Char import Foreign.C.Error ( throwErrnoIfMinus1, throwErrnoIfMinus1_, throwErrnoIfNull ) import Foreign.C.String ( CString, peekCString ) import Foreign.C.Types ( CInt ) import Foreign.ForeignPtr ( ForeignPtr, withForeignPtr, mallocForeignPtrBytes ) import Foreign.Marshal.Utils ( copyBytes ) import Foreign.Ptr ( Ptr, nullPtr, plusPtr ) import Foreign.Storable ( Storable(..) ) import System.IO.Unsafe ( unsafePerformIO ) import System.Posix.Types -- ----------------------------------------------------------------------------- -- Terminal attributes type CTermios = () newtype TerminalAttributes = TerminalAttributes (ForeignPtr CTermios) makeTerminalAttributes :: ForeignPtr CTermios -> TerminalAttributes makeTerminalAttributes = TerminalAttributes withTerminalAttributes :: TerminalAttributes -> (Ptr CTermios -> IO a) -> IO a withTerminalAttributes (TerminalAttributes termios) = withForeignPtr termios data TerminalMode -- input flags = InterruptOnBreak -- BRKINT | MapCRtoLF -- ICRNL | IgnoreBreak -- IGNBRK | IgnoreCR -- IGNCR | IgnoreParityErrors -- IGNPAR | MapLFtoCR -- INLCR | CheckParity -- INPCK | StripHighBit -- ISTRIP | StartStopInput -- IXOFF | StartStopOutput -- IXON | MarkParityErrors -- PARMRK -- output flags | ProcessOutput -- OPOST -- ToDo: ONLCR, OCRNL, ONOCR, ONLRET, OFILL, -- NLDLY(NL0,NL1), CRDLY(CR0,CR1,CR2,CR2) -- TABDLY(TAB0,TAB1,TAB2,TAB3) -- BSDLY(BS0,BS1), VTDLY(VT0,VT1), FFDLY(FF0,FF1) -- control flags | LocalMode -- CLOCAL | ReadEnable -- CREAD | TwoStopBits -- CSTOPB | HangupOnClose -- HUPCL | EnableParity -- PARENB | OddParity -- PARODD -- local modes | EnableEcho -- ECHO | EchoErase -- ECHOE | EchoKill -- ECHOK | EchoLF -- ECHONL | ProcessInput -- ICANON | ExtendedFunctions -- IEXTEN | KeyboardInterrupts -- ISIG | NoFlushOnInterrupt -- NOFLSH | BackgroundWriteInterrupt -- TOSTOP withoutMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes withoutMode termios InterruptOnBreak = clearInputFlag (#const BRKINT) termios withoutMode termios MapCRtoLF = clearInputFlag (#const ICRNL) termios withoutMode termios IgnoreBreak = clearInputFlag (#const IGNBRK) termios withoutMode termios IgnoreCR = clearInputFlag (#const IGNCR) termios withoutMode termios IgnoreParityErrors = clearInputFlag (#const IGNPAR) termios withoutMode termios MapLFtoCR = clearInputFlag (#const INLCR) termios withoutMode termios CheckParity = clearInputFlag (#const INPCK) termios withoutMode termios StripHighBit = clearInputFlag (#const ISTRIP) termios withoutMode termios StartStopInput = clearInputFlag (#const IXOFF) termios withoutMode termios StartStopOutput = clearInputFlag (#const IXON) termios withoutMode termios MarkParityErrors = clearInputFlag (#const PARMRK) termios withoutMode termios ProcessOutput = clearOutputFlag (#const OPOST) termios withoutMode termios LocalMode = clearControlFlag (#const CLOCAL) termios withoutMode termios ReadEnable = clearControlFlag (#const CREAD) termios withoutMode termios TwoStopBits = clearControlFlag (#const CSTOPB) termios withoutMode termios HangupOnClose = clearControlFlag (#const HUPCL) termios withoutMode termios EnableParity = clearControlFlag (#const PARENB) termios withoutMode termios OddParity = clearControlFlag (#const PARODD) termios withoutMode termios EnableEcho = clearLocalFlag (#const ECHO) termios withoutMode termios EchoErase = clearLocalFlag (#const ECHOE) termios withoutMode termios EchoKill = clearLocalFlag (#const ECHOK) termios withoutMode termios EchoLF = clearLocalFlag (#const ECHONL) termios withoutMode termios ProcessInput = clearLocalFlag (#const ICANON) termios withoutMode termios ExtendedFunctions = clearLocalFlag (#const IEXTEN) termios withoutMode termios KeyboardInterrupts = clearLocalFlag (#const ISIG) termios withoutMode termios NoFlushOnInterrupt = setLocalFlag (#const NOFLSH) termios withoutMode termios BackgroundWriteInterrupt = clearLocalFlag (#const TOSTOP) termios withMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes withMode termios InterruptOnBreak = setInputFlag (#const BRKINT) termios withMode termios MapCRtoLF = setInputFlag (#const ICRNL) termios withMode termios IgnoreBreak = setInputFlag (#const IGNBRK) termios withMode termios IgnoreCR = setInputFlag (#const IGNCR) termios withMode termios IgnoreParityErrors = setInputFlag (#const IGNPAR) termios withMode termios MapLFtoCR = setInputFlag (#const INLCR) termios withMode termios CheckParity = setInputFlag (#const INPCK) termios withMode termios StripHighBit = setInputFlag (#const ISTRIP) termios withMode termios StartStopInput = setInputFlag (#const IXOFF) termios withMode termios StartStopOutput = setInputFlag (#const IXON) termios withMode termios MarkParityErrors = setInputFlag (#const PARMRK) termios withMode termios ProcessOutput = setOutputFlag (#const OPOST) termios withMode termios LocalMode = setControlFlag (#const CLOCAL) termios withMode termios ReadEnable = setControlFlag (#const CREAD) termios withMode termios TwoStopBits = setControlFlag (#const CSTOPB) termios withMode termios HangupOnClose = setControlFlag (#const HUPCL) termios withMode termios EnableParity = setControlFlag (#const PARENB) termios withMode termios OddParity = setControlFlag (#const PARODD) termios withMode termios EnableEcho = setLocalFlag (#const ECHO) termios withMode termios EchoErase = setLocalFlag (#const ECHOE) termios withMode termios EchoKill = setLocalFlag (#const ECHOK) termios withMode termios EchoLF = setLocalFlag (#const ECHONL) termios withMode termios ProcessInput = setLocalFlag (#const ICANON) termios withMode termios ExtendedFunctions = setLocalFlag (#const IEXTEN) termios withMode termios KeyboardInterrupts = setLocalFlag (#const ISIG) termios withMode termios NoFlushOnInterrupt = clearLocalFlag (#const NOFLSH) termios withMode termios BackgroundWriteInterrupt = setLocalFlag (#const TOSTOP) termios terminalMode :: TerminalMode -> TerminalAttributes -> Bool terminalMode InterruptOnBreak = testInputFlag (#const BRKINT) terminalMode MapCRtoLF = testInputFlag (#const ICRNL) terminalMode IgnoreBreak = testInputFlag (#const IGNBRK) terminalMode IgnoreCR = testInputFlag (#const IGNCR) terminalMode IgnoreParityErrors = testInputFlag (#const IGNPAR) terminalMode MapLFtoCR = testInputFlag (#const INLCR) terminalMode CheckParity = testInputFlag (#const INPCK) terminalMode StripHighBit = testInputFlag (#const ISTRIP) terminalMode StartStopInput = testInputFlag (#const IXOFF) terminalMode StartStopOutput = testInputFlag (#const IXON) terminalMode MarkParityErrors = testInputFlag (#const PARMRK) terminalMode ProcessOutput = testOutputFlag (#const OPOST) terminalMode LocalMode = testControlFlag (#const CLOCAL) terminalMode ReadEnable = testControlFlag (#const CREAD) terminalMode TwoStopBits = testControlFlag (#const CSTOPB) terminalMode HangupOnClose = testControlFlag (#const HUPCL) terminalMode EnableParity = testControlFlag (#const PARENB) terminalMode OddParity = testControlFlag (#const PARODD) terminalMode EnableEcho = testLocalFlag (#const ECHO) terminalMode EchoErase = testLocalFlag (#const ECHOE) terminalMode EchoKill = testLocalFlag (#const ECHOK) terminalMode EchoLF = testLocalFlag (#const ECHONL) terminalMode ProcessInput = testLocalFlag (#const ICANON) terminalMode ExtendedFunctions = testLocalFlag (#const IEXTEN) terminalMode KeyboardInterrupts = testLocalFlag (#const ISIG) terminalMode NoFlushOnInterrupt = not . testLocalFlag (#const NOFLSH) terminalMode BackgroundWriteInterrupt = testLocalFlag (#const TOSTOP) bitsPerByte :: TerminalAttributes -> Int bitsPerByte termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do cflag <- (#peek struct termios, c_cflag) p return $! (word2Bits (cflag .&. (#const CSIZE))) where word2Bits :: CTcflag -> Int word2Bits x = if x == (#const CS5) then 5 else if x == (#const CS6) then 6 else if x == (#const CS7) then 7 else if x == (#const CS8) then 8 else 0 withBits :: TerminalAttributes -> Int -> TerminalAttributes withBits termios bits = unsafePerformIO $ do withNewTermios termios $ \p -> do cflag <- (#peek struct termios, c_cflag) p (#poke struct termios, c_cflag) p ((cflag .&. complement (#const CSIZE)) .|. mask bits) where mask :: Int -> CTcflag mask 5 = (#const CS5) mask 6 = (#const CS6) mask 7 = (#const CS7) mask 8 = (#const CS8) mask _ = error "withBits bit value out of range [5..8]" data ControlCharacter = EndOfFile -- VEOF | EndOfLine -- VEOL | Erase -- VERASE | Interrupt -- VINTR | Kill -- VKILL | Quit -- VQUIT | Start -- VSTART | Stop -- VSTOP | Suspend -- VSUSP controlChar :: TerminalAttributes -> ControlCharacter -> Maybe Char controlChar termios cc = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p val <- peekElemOff c_cc (cc2Word cc) if val == ((#const _POSIX_VDISABLE)::CCc) then return Nothing else return (Just (chr (fromEnum val))) withCC :: TerminalAttributes -> (ControlCharacter, Char) -> TerminalAttributes withCC termios (cc, c) = unsafePerformIO $ do withNewTermios termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p pokeElemOff c_cc (cc2Word cc) (fromIntegral (ord c) :: CCc) withoutCC :: TerminalAttributes -> ControlCharacter -> TerminalAttributes withoutCC termios cc = unsafePerformIO $ do withNewTermios termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p pokeElemOff c_cc (cc2Word cc) ((#const _POSIX_VDISABLE) :: CCc) inputTime :: TerminalAttributes -> Int inputTime termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do c <- peekElemOff ((#ptr struct termios, c_cc) p) (#const VTIME) return (fromEnum (c :: CCc)) withTime :: TerminalAttributes -> Int -> TerminalAttributes withTime termios time = unsafePerformIO $ do withNewTermios termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p pokeElemOff c_cc (#const VTIME) (fromIntegral time :: CCc) minInput :: TerminalAttributes -> Int minInput termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do c <- peekElemOff ((#ptr struct termios, c_cc) p) (#const VMIN) return (fromEnum (c :: CCc)) withMinInput :: TerminalAttributes -> Int -> TerminalAttributes withMinInput termios count = unsafePerformIO $ do withNewTermios termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p pokeElemOff c_cc (#const VMIN) (fromIntegral count :: CCc) data BaudRate = B0 | B50 | B75 | B110 | B134 | B150 | B200 | B300 | B600 | B1200 | B1800 | B2400 | B4800 | B9600 | B19200 | B38400 inputSpeed :: TerminalAttributes -> BaudRate inputSpeed termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do w <- c_cfgetispeed p return (word2Baud w) foreign import ccall unsafe "cfgetispeed" c_cfgetispeed :: Ptr CTermios -> IO CSpeed withInputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes withInputSpeed termios br = unsafePerformIO $ do withNewTermios termios $ \p -> c_cfsetispeed p (baud2Word br) foreign import ccall unsafe "cfsetispeed" c_cfsetispeed :: Ptr CTermios -> CSpeed -> IO CInt outputSpeed :: TerminalAttributes -> BaudRate outputSpeed termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do w <- c_cfgetospeed p return (word2Baud w) foreign import ccall unsafe "cfgetospeed" c_cfgetospeed :: Ptr CTermios -> IO CSpeed withOutputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes withOutputSpeed termios br = unsafePerformIO $ do withNewTermios termios $ \p -> c_cfsetospeed p (baud2Word br) foreign import ccall unsafe "cfsetospeed" c_cfsetospeed :: Ptr CTermios -> CSpeed -> IO CInt -- | @getTerminalAttributes fd@ calls @tcgetattr@ to obtain -- the @TerminalAttributes@ associated with @Fd@ @fd@. getTerminalAttributes :: Fd -> IO TerminalAttributes getTerminalAttributes fd = do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p -> throwErrnoIfMinus1_ "getTerminalAttributes" (c_tcgetattr fd p) return $ makeTerminalAttributes fp foreign import ccall unsafe "tcgetattr" c_tcgetattr :: Fd -> Ptr CTermios -> IO CInt data TerminalState = Immediately | WhenDrained | WhenFlushed -- | @setTerminalAttributes fd attr ts@ calls @tcsetattr@ to change -- the @TerminalAttributes@ associated with @Fd@ @fd@ to -- @attr@, when the terminal is in the state indicated by @ts@. setTerminalAttributes :: Fd -> TerminalAttributes -> TerminalState -> IO () setTerminalAttributes fd termios state = do withTerminalAttributes termios $ \p -> throwErrnoIfMinus1_ "setTerminalAttributes" (c_tcsetattr fd (state2Int state) p) where state2Int :: TerminalState -> CInt state2Int Immediately = (#const TCSANOW) state2Int WhenDrained = (#const TCSADRAIN) state2Int WhenFlushed = (#const TCSAFLUSH) foreign import ccall unsafe "tcsetattr" c_tcsetattr :: Fd -> CInt -> Ptr CTermios -> IO CInt -- | @sendBreak fd duration@ calls @tcsendbreak@ to transmit a -- continuous stream of zero-valued bits on @Fd@ @fd@ for the -- specified implementation-dependent @duration@. sendBreak :: Fd -> Int -> IO () sendBreak fd duration = throwErrnoIfMinus1_ "sendBreak" (c_tcsendbreak fd (fromIntegral duration)) foreign import ccall unsafe "tcsendbreak" c_tcsendbreak :: Fd -> CInt -> IO CInt -- | @drainOutput fd@ calls @tcdrain@ to block until all output -- written to @Fd@ @fd@ has been transmitted. drainOutput :: Fd -> IO () drainOutput fd = throwErrnoIfMinus1_ "drainOutput" (c_tcdrain fd) foreign import ccall unsafe "tcdrain" c_tcdrain :: Fd -> IO CInt data QueueSelector = InputQueue -- TCIFLUSH | OutputQueue -- TCOFLUSH | BothQueues -- TCIOFLUSH -- | @discardData fd queues@ calls @tcflush@ to discard -- pending input and\/or output for @Fd@ @fd@, -- as indicated by the @QueueSelector@ @queues@. discardData :: Fd -> QueueSelector -> IO () discardData fd queue = throwErrnoIfMinus1_ "discardData" (c_tcflush fd (queue2Int queue)) where queue2Int :: QueueSelector -> CInt queue2Int InputQueue = (#const TCIFLUSH) queue2Int OutputQueue = (#const TCOFLUSH) queue2Int BothQueues = (#const TCIOFLUSH) foreign import ccall unsafe "tcflush" c_tcflush :: Fd -> CInt -> IO CInt data FlowAction = SuspendOutput -- ^ TCOOFF | RestartOutput -- ^ TCOON | TransmitStop -- ^ TCIOFF | TransmitStart -- ^ TCION -- | @controlFlow fd action@ calls @tcflow@ to control the -- flow of data on @Fd@ @fd@, as indicated by -- @action@. controlFlow :: Fd -> FlowAction -> IO () controlFlow fd action = throwErrnoIfMinus1_ "controlFlow" (c_tcflow fd (action2Int action)) where action2Int :: FlowAction -> CInt action2Int SuspendOutput = (#const TCOOFF) action2Int RestartOutput = (#const TCOON) action2Int TransmitStop = (#const TCIOFF) action2Int TransmitStart = (#const TCION) foreign import ccall unsafe "tcflow" c_tcflow :: Fd -> CInt -> IO CInt -- | @getTerminalProcessGroupID fd@ calls @tcgetpgrp@ to -- obtain the @ProcessGroupID@ of the foreground process group -- associated with the terminal attached to @Fd@ @fd@. getTerminalProcessGroupID :: Fd -> IO ProcessGroupID getTerminalProcessGroupID fd = do throwErrnoIfMinus1 "getTerminalProcessGroupID" (c_tcgetpgrp fd) foreign import ccall unsafe "tcgetpgrp" c_tcgetpgrp :: Fd -> IO CPid -- | @setTerminalProcessGroupID fd pgid@ calls @tcsetpgrp@ to -- set the @ProcessGroupID@ of the foreground process group -- associated with the terminal attached to @Fd@ -- @fd@ to @pgid@. setTerminalProcessGroupID :: Fd -> ProcessGroupID -> IO () setTerminalProcessGroupID fd pgid = throwErrnoIfMinus1_ "setTerminalProcessGroupID" (c_tcsetpgrp fd pgid) foreign import ccall unsafe "tcsetpgrp" c_tcsetpgrp :: Fd -> CPid -> IO CInt -- ----------------------------------------------------------------------------- -- file descriptor queries -- | @queryTerminal fd@ calls @isatty@ to determine whether or -- not @Fd@ @fd@ is associated with a terminal. queryTerminal :: Fd -> IO Bool queryTerminal fd = do r <- c_isatty fd return (r == 1) -- ToDo: the spec says that it can set errno to EBADF if the result is zero foreign import ccall unsafe "isatty" c_isatty :: Fd -> IO CInt -- | @getTerminalName fd@ calls @ttyname@ to obtain a name associated -- with the terminal for @Fd@ @fd@. If @fd@ is associated -- with a terminal, @getTerminalName@ returns the name of the -- terminal. getTerminalName :: Fd -> IO FilePath getTerminalName fd = do s <- throwErrnoIfNull "getTerminalName" (c_ttyname fd) peekCString s foreign import ccall unsafe "ttyname" c_ttyname :: Fd -> IO CString -- | @getControllingTerminalName@ calls @ctermid@ to obtain -- a name associated with the controlling terminal for the process. If a -- controlling terminal exists, -- @getControllingTerminalName@ returns the name of the -- controlling terminal. getControllingTerminalName :: IO FilePath getControllingTerminalName = do s <- throwErrnoIfNull "getControllingTerminalName" (c_ctermid nullPtr) peekCString s foreign import ccall unsafe "ctermid" c_ctermid :: CString -> IO CString -- ----------------------------------------------------------------------------- -- Local utility functions -- Convert Haskell ControlCharacter to Int cc2Word :: ControlCharacter -> Int cc2Word EndOfFile = (#const VEOF) cc2Word EndOfLine = (#const VEOL) cc2Word Erase = (#const VERASE) cc2Word Interrupt = (#const VINTR) cc2Word Kill = (#const VKILL) cc2Word Quit = (#const VQUIT) cc2Word Suspend = (#const VSUSP) cc2Word Start = (#const VSTART) cc2Word Stop = (#const VSTOP) -- Convert Haskell BaudRate to unsigned integral type (Word) baud2Word :: BaudRate -> CSpeed baud2Word B0 = (#const B0) baud2Word B50 = (#const B50) baud2Word B75 = (#const B75) baud2Word B110 = (#const B110) baud2Word B134 = (#const B134) baud2Word B150 = (#const B150) baud2Word B200 = (#const B200) baud2Word B300 = (#const B300) baud2Word B600 = (#const B600) baud2Word B1200 = (#const B1200) baud2Word B1800 = (#const B1800) baud2Word B2400 = (#const B2400) baud2Word B4800 = (#const B4800) baud2Word B9600 = (#const B9600) baud2Word B19200 = (#const B19200) baud2Word B38400 = (#const B38400) -- And convert a word back to a baud rate -- We really need some cpp macros here. word2Baud :: CSpeed -> BaudRate word2Baud x = if x == (#const B0) then B0 else if x == (#const B50) then B50 else if x == (#const B75) then B75 else if x == (#const B110) then B110 else if x == (#const B134) then B134 else if x == (#const B150) then B150 else if x == (#const B200) then B200 else if x == (#const B300) then B300 else if x == (#const B600) then B600 else if x == (#const B1200) then B1200 else if x == (#const B1800) then B1800 else if x == (#const B2400) then B2400 else if x == (#const B4800) then B4800 else if x == (#const B9600) then B9600 else if x == (#const B19200) then B19200 else if x == (#const B38400) then B38400 else error "unknown baud rate" -- Clear termios i_flag clearInputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes clearInputFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) iflag <- (#peek struct termios, c_iflag) p2 (#poke struct termios, c_iflag) p1 (iflag .&. complement flag) return $ makeTerminalAttributes fp -- Set termios i_flag setInputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes setInputFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) iflag <- (#peek struct termios, c_iflag) p2 (#poke struct termios, c_iflag) p1 (iflag .|. flag) return $ makeTerminalAttributes fp -- Examine termios i_flag testInputFlag :: CTcflag -> TerminalAttributes -> Bool testInputFlag flag termios = unsafePerformIO $ withTerminalAttributes termios $ \p -> do iflag <- (#peek struct termios, c_iflag) p return $! ((iflag .&. flag) /= 0) -- Clear termios c_flag clearControlFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes clearControlFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) cflag <- (#peek struct termios, c_cflag) p2 (#poke struct termios, c_cflag) p1 (cflag .&. complement flag) return $ makeTerminalAttributes fp -- Set termios c_flag setControlFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes setControlFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) cflag <- (#peek struct termios, c_cflag) p2 (#poke struct termios, c_cflag) p1 (cflag .|. flag) return $ makeTerminalAttributes fp -- Examine termios c_flag testControlFlag :: CTcflag -> TerminalAttributes -> Bool testControlFlag flag termios = unsafePerformIO $ withTerminalAttributes termios $ \p -> do cflag <- (#peek struct termios, c_cflag) p return $! ((cflag .&. flag) /= 0) -- Clear termios l_flag clearLocalFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes clearLocalFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) lflag <- (#peek struct termios, c_lflag) p2 (#poke struct termios, c_lflag) p1 (lflag .&. complement flag) return $ makeTerminalAttributes fp -- Set termios l_flag setLocalFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes setLocalFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) lflag <- (#peek struct termios, c_lflag) p2 (#poke struct termios, c_lflag) p1 (lflag .|. flag) return $ makeTerminalAttributes fp -- Examine termios l_flag testLocalFlag :: CTcflag -> TerminalAttributes -> Bool testLocalFlag flag termios = unsafePerformIO $ withTerminalAttributes termios $ \p -> do lflag <- (#peek struct termios, c_lflag) p return $! ((lflag .&. flag) /= 0) -- Clear termios o_flag clearOutputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes clearOutputFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) oflag <- (#peek struct termios, c_oflag) p2 (#poke struct termios, c_oflag) p1 (oflag .&. complement flag) return $ makeTerminalAttributes fp -- Set termios o_flag setOutputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes setOutputFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) oflag <- (#peek struct termios, c_oflag) p2 (#poke struct termios, c_oflag) p1 (oflag .|. flag) return $ makeTerminalAttributes fp -- Examine termios o_flag testOutputFlag :: CTcflag -> TerminalAttributes -> Bool testOutputFlag flag termios = unsafePerformIO $ withTerminalAttributes termios $ \p -> do oflag <- (#peek struct termios, c_oflag) p return $! ((oflag .&. flag) /= 0) withNewTermios :: TerminalAttributes -> (Ptr CTermios -> IO a) -> IO TerminalAttributes withNewTermios termios action = do fp1 <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp1 $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) action p1 return $ makeTerminalAttributes fp1 hugs98-plus-Sep2006/packages/unix/System/Posix/Temp.hsc0000644006511100651110000000312010504340274021511 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Temp -- Copyright : (c) Volker Stolz -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : vs@foldr.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX environment support -- ----------------------------------------------------------------------------- module System.Posix.Temp ( mkstemp {- Not ported (yet?): tmpfile: can we handle FILE*? tmpnam: ISO C, should go in base? tempname: dito -} ) where #include "HsUnix.h" import System.IO import System.Posix.IO import System.Posix.Types import Foreign.C -- |'mkstemp' - make a unique filename and open it for -- reading\/writing (only safe on GHC & Hugs) mkstemp :: String -> IO (String, Handle) mkstemp template = do #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) withCString template $ \ ptr -> do fd <- throwErrnoIfMinus1 "mkstemp" (c_mkstemp ptr) name <- peekCString ptr h <- fdToHandle fd return (name, h) #else name <- mktemp template h <- openFile name ReadWriteMode return (name, h) -- |'mktemp' - make a unique file name -- This function should be considered deprecated mktemp :: String -> IO String mktemp template = do withCString template $ \ ptr -> do ptr <- throwErrnoIfNull "mktemp" (c_mktemp ptr) peekCString ptr foreign import ccall unsafe "mktemp" c_mktemp :: CString -> IO CString #endif foreign import ccall unsafe "mkstemp" c_mkstemp :: CString -> IO Fd hugs98-plus-Sep2006/packages/unix/System/Posix/Time.hsc0000644006511100651110000000207310504340274021510 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Time -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX Time support -- ----------------------------------------------------------------------------- module System.Posix.Time ( epochTime, -- ToDo: lots more from sys/time.h -- how much already supported by System.Time? ) where #include "HsUnix.h" import System.Posix.Types import Foreign import Foreign.C -- ----------------------------------------------------------------------------- -- epochTime -- | @epochTime@ calls @time@ to obtain the number of -- seconds that have elapsed since the epoch (Jan 01 00:00:00 GMT 1970). epochTime :: IO EpochTime epochTime = throwErrnoIfMinus1 "epochTime" (c_time nullPtr) foreign import ccall unsafe "time" c_time :: Ptr CTime -> IO CTime hugs98-plus-Sep2006/packages/unix/System/Posix/Unistd.hsc0000644006511100651110000001070610504340274022062 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Unistd -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX miscellaneous stuff, mostly from unistd.h -- ----------------------------------------------------------------------------- module System.Posix.Unistd ( -- * System environment SystemID(..), getSystemID, SysVar(..), getSysVar, -- * Sleeping sleep, usleep, {- ToDo from unistd.h: confstr, lots of sysconf variables -- use Network.BSD gethostid, gethostname -- should be in System.Posix.Files? pathconf, fpathconf, -- System.Posix.Signals ualarm, -- System.Posix.IO read, write, -- should be in System.Posix.User? getEffectiveUserName, -} ) where #include "HsUnix.h" import Foreign.C.Error import Foreign.C.String ( peekCString ) import Foreign.C.Types ( CInt, CUInt, CLong ) import Foreign.Marshal.Alloc ( allocaBytes ) import Foreign.Ptr ( Ptr, plusPtr ) import System.Posix.Types import System.Posix.Internals -- ----------------------------------------------------------------------------- -- System environment (uname()) data SystemID = SystemID { systemName :: String , nodeName :: String , release :: String , version :: String , machine :: String } getSystemID :: IO SystemID getSystemID = do allocaBytes (#const sizeof(struct utsname)) $ \p_sid -> do throwErrnoIfMinus1_ "getSystemID" (c_uname p_sid) sysN <- peekCString ((#ptr struct utsname, sysname) p_sid) node <- peekCString ((#ptr struct utsname, nodename) p_sid) rel <- peekCString ((#ptr struct utsname, release) p_sid) ver <- peekCString ((#ptr struct utsname, version) p_sid) mach <- peekCString ((#ptr struct utsname, machine) p_sid) return (SystemID { systemName = sysN, nodeName = node, release = rel, version = ver, machine = mach }) foreign import ccall unsafe "uname" c_uname :: Ptr CUtsname -> IO CInt -- ----------------------------------------------------------------------------- -- sleeping -- | Sleep for the specified duration (in seconds). Returns the time remaining -- (if the sleep was interrupted by a signal, for example). -- -- GHC Note: the comment for 'usleep' also applies here. -- sleep :: Int -> IO Int sleep 0 = return 0 sleep secs = do r <- c_sleep (fromIntegral secs); return (fromIntegral r) foreign import ccall safe "sleep" c_sleep :: CUInt -> IO CUInt -- | Sleep for the specified duration (in microseconds). -- -- GHC Note: 'Control.Concurrent.threadDelay' is a better choice. -- Without the @-threaded@ option, 'usleep' will block all other user -- threads. Even with the @-threaded@ option, 'usleep' requires a -- full OS thread to itself. 'Control.Concurrent.threadDelay' has -- neither of these shortcomings. -- usleep :: Int -> IO () usleep 0 = return () #ifdef USLEEP_RETURNS_VOID usleep usecs = c_usleep (fromIntegral usecs) #else usleep usecs = throwErrnoIfMinus1Retry_ "usleep" (c_usleep (fromIntegral usecs)) #endif #ifdef USLEEP_RETURNS_VOID foreign import ccall safe "usleep" c_usleep :: CUInt -> IO () #else foreign import ccall safe "usleep" c_usleep :: CUInt -> IO CInt #endif -- ----------------------------------------------------------------------------- -- System variables data SysVar = ArgumentLimit | ChildLimit | ClockTick | GroupLimit | OpenFileLimit | PosixVersion | HasSavedIDs | HasJobControl -- ToDo: lots more getSysVar :: SysVar -> IO Integer getSysVar v = case v of ArgumentLimit -> sysconf (#const _SC_ARG_MAX) ChildLimit -> sysconf (#const _SC_CHILD_MAX) ClockTick -> sysconf (#const _SC_CLK_TCK) GroupLimit -> sysconf (#const _SC_NGROUPS_MAX) OpenFileLimit -> sysconf (#const _SC_OPEN_MAX) PosixVersion -> sysconf (#const _SC_VERSION) HasSavedIDs -> sysconf (#const _SC_SAVED_IDS) HasJobControl -> sysconf (#const _SC_JOB_CONTROL) sysconf :: CInt -> IO Integer sysconf n = do r <- throwErrnoIfMinus1 "getSysVar" (c_sysconf n) return (fromIntegral r) foreign import ccall unsafe "sysconf" c_sysconf :: CInt -> IO CLong hugs98-plus-Sep2006/packages/unix/System/Posix/User.hsc0000644006511100651110000003215710504340275021537 0ustar rossross{-# OPTIONS -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.User -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX user\/group support -- ----------------------------------------------------------------------------- module System.Posix.User ( -- * User environment -- ** Querying the user environment getRealUserID, getRealGroupID, getEffectiveUserID, getEffectiveGroupID, getGroups, getLoginName, getEffectiveUserName, -- *** The group database GroupEntry(..), getGroupEntryForID, getGroupEntryForName, getAllGroupEntries, -- *** The user database UserEntry(..), getUserEntryForID, getUserEntryForName, getAllUserEntries, -- ** Modifying the user environment setUserID, setGroupID, ) where #include "HsUnix.h" import System.Posix.Types import Foreign import Foreign.C import System.Posix.Internals ( CGroup, CPasswd ) #if !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || defined(HAVE_GETPWENT) || defined(HAVE_GETGRENT) import Control.Concurrent.MVar ( newMVar, withMVar ) #endif -- ----------------------------------------------------------------------------- -- user environemnt -- | @getRealUserID@ calls @getuid@ to obtain the real @UserID@ -- associated with the current process. getRealUserID :: IO UserID getRealUserID = c_getuid foreign import ccall unsafe "getuid" c_getuid :: IO CUid -- | @getRealGroupID@ calls @getgid@ to obtain the real @GroupID@ -- associated with the current process. getRealGroupID :: IO GroupID getRealGroupID = c_getgid foreign import ccall unsafe "getgid" c_getgid :: IO CGid -- | @getEffectiveUserID@ calls @geteuid@ to obtain the effective -- @UserID@ associated with the current process. getEffectiveUserID :: IO UserID getEffectiveUserID = c_geteuid foreign import ccall unsafe "geteuid" c_geteuid :: IO CUid -- | @getEffectiveGroupID@ calls @getegid@ to obtain the effective -- @GroupID@ associated with the current process. getEffectiveGroupID :: IO GroupID getEffectiveGroupID = c_getegid foreign import ccall unsafe "getegid" c_getegid :: IO CGid -- | @getGroups@ calls @getgroups@ to obtain the list of -- supplementary @GroupID@s associated with the current process. getGroups :: IO [GroupID] getGroups = do ngroups <- c_getgroups 0 nullPtr allocaArray (fromIntegral ngroups) $ \arr -> do throwErrnoIfMinus1_ "getGroups" (c_getgroups ngroups arr) groups <- peekArray (fromIntegral ngroups) arr return groups foreign import ccall unsafe "getgroups" c_getgroups :: CInt -> Ptr CGid -> IO CInt -- | @getLoginName@ calls @getlogin@ to obtain the login name -- associated with the current process. getLoginName :: IO String getLoginName = do -- ToDo: use getlogin_r str <- throwErrnoIfNull "getLoginName" c_getlogin peekCString str foreign import ccall unsafe "getlogin" c_getlogin :: IO CString -- | @setUserID uid@ calls @setuid@ to set the real, effective, and -- saved set-user-id associated with the current process to @uid@. setUserID :: UserID -> IO () setUserID uid = throwErrnoIfMinus1_ "setUserID" (c_setuid uid) foreign import ccall unsafe "setuid" c_setuid :: CUid -> IO CInt -- | @setGroupID gid@ calls @setgid@ to set the real, effective, and -- saved set-group-id associated with the current process to @gid@. setGroupID :: GroupID -> IO () setGroupID gid = throwErrnoIfMinus1_ "setGroupID" (c_setgid gid) foreign import ccall unsafe "setgid" c_setgid :: CGid -> IO CInt -- ----------------------------------------------------------------------------- -- User names -- | @getEffectiveUserName@ gets the name -- associated with the effective @UserID@ of the process. getEffectiveUserName :: IO String getEffectiveUserName = do euid <- getEffectiveUserID pw <- getUserEntryForID euid return (userName pw) -- ----------------------------------------------------------------------------- -- The group database (grp.h) data GroupEntry = GroupEntry { groupName :: String, -- ^ The name of this group (gr_name) groupPassword :: String, -- ^ The password for this group (gr_passwd) groupID :: GroupID, -- ^ The unique numeric ID for this group (gr_gid) groupMembers :: [String] -- ^ A list of zero or more usernames that are members (gr_mem) } deriving (Show, Read, Eq) -- | @getGroupEntryForID gid@ calls @getgrgid@ to obtain -- the @GroupEntry@ information associated with @GroupID@ -- @gid@. getGroupEntryForID :: GroupID -> IO GroupEntry #ifdef HAVE_GETGRGID_R getGroupEntryForID gid = do allocaBytes (#const sizeof(struct group)) $ \pgr -> allocaBytes grBufSize $ \pbuf -> alloca $ \ ppgr -> do throwErrorIfNonZero_ "getGroupEntryForID" $ c_getgrgid_r gid pgr pbuf (fromIntegral grBufSize) ppgr throwErrnoIfNull "getGroupEntryForID" $ peekElemOff ppgr 0 unpackGroupEntry pgr foreign import ccall unsafe "getgrgid_r" c_getgrgid_r :: CGid -> Ptr CGroup -> CString -> CSize -> Ptr (Ptr CGroup) -> IO CInt #else getGroupEntryForID = error "System.Posix.User.getGroupEntryForID: not supported" #endif -- | @getGroupEntryForName name@ calls @getgrnam@ to obtain -- the @GroupEntry@ information associated with the group called -- @name@. getGroupEntryForName :: String -> IO GroupEntry #ifdef HAVE_GETGRNAM_R getGroupEntryForName name = do allocaBytes (#const sizeof(struct group)) $ \pgr -> allocaBytes grBufSize $ \pbuf -> alloca $ \ ppgr -> withCString name $ \ pstr -> do throwErrorIfNonZero_ "getGroupEntryForName" $ c_getgrnam_r pstr pgr pbuf (fromIntegral grBufSize) ppgr throwErrnoIfNull "getGroupEntryForName" $ peekElemOff ppgr 0 unpackGroupEntry pgr foreign import ccall unsafe "getgrnam_r" c_getgrnam_r :: CString -> Ptr CGroup -> CString -> CSize -> Ptr (Ptr CGroup) -> IO CInt #else getGroupEntryForName = error "System.Posix.User.getGroupEntryForName: not supported" #endif -- | @getAllGroupEntries@ returns all group entries on the system by -- repeatedly calling @getgrent@ getAllGroupEntries :: IO [GroupEntry] #ifdef HAVE_GETGRENT getAllGroupEntries = withMVar lock $ \_ -> worker [] where worker accum = do resetErrno ppw <- throwErrnoIfNullAndError "getAllGroupEntries" $ c_getgrent if ppw == nullPtr then return (reverse accum) else do thisentry <- unpackGroupEntry ppw worker (thisentry : accum) foreign import ccall unsafe "getgrent" c_getgrent :: IO (Ptr CGroup) #else getAllGroupEntries = error "System.Posix.User.getAllGroupEntries: not supported" #endif #if defined(HAVE_GETGRGID_R) || defined(HAVE_GETGRNAM_R) grBufSize :: Int #if defined(HAVE_SYSCONF) && defined(HAVE_SC_GETGR_R_SIZE_MAX) grBufSize = fromIntegral $ unsafePerformIO $ c_sysconf (#const _SC_GETGR_R_SIZE_MAX) #else grBufSize = 2048 -- just assume some value (1024 is too small on OpenBSD) #endif #endif unpackGroupEntry :: Ptr CGroup -> IO GroupEntry unpackGroupEntry ptr = do name <- (#peek struct group, gr_name) ptr >>= peekCString passwd <- (#peek struct group, gr_passwd) ptr >>= peekCString gid <- (#peek struct group, gr_gid) ptr mem <- (#peek struct group, gr_mem) ptr members <- peekArray0 nullPtr mem >>= mapM peekCString return (GroupEntry name passwd gid members) -- ----------------------------------------------------------------------------- -- The user database (pwd.h) data UserEntry = UserEntry { userName :: String, -- ^ Textual name of this user (pw_name) userPassword :: String, -- ^ Password -- may be empty or fake if shadow is in use (pw_passwd) userID :: UserID, -- ^ Numeric ID for this user (pw_uid) userGroupID :: GroupID, -- ^ Primary group ID (pw_gid) userGecos :: String, -- ^ Usually the real name for the user (pw_gecos) homeDirectory :: String, -- ^ Home directory (pw_dir) userShell :: String -- ^ Default shell (pw_shell) } deriving (Show, Read, Eq) -- -- getpwuid and getpwnam leave results in a static object. Subsequent -- calls modify the same object, which isn't threadsafe. We attempt to -- mitigate this issue, on platforms that don't provide the safe _r versions -- -- Also, getpwent/setpwent require a global lock since they maintain -- an internal file position pointer. #if !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || defined(HAVE_GETPWENT) || defined(HAVE_GETGRENT) lock = unsafePerformIO $ newMVar () {-# NOINLINE lock #-} #endif -- | @getUserEntryForID gid@ calls @getpwuid@ to obtain -- the @UserEntry@ information associated with @UserID@ -- @uid@. getUserEntryForID :: UserID -> IO UserEntry #ifdef HAVE_GETPWUID_R getUserEntryForID uid = do allocaBytes (#const sizeof(struct passwd)) $ \ppw -> allocaBytes pwBufSize $ \pbuf -> alloca $ \ pppw -> do throwErrorIfNonZero_ "getUserEntryForID" $ c_getpwuid_r uid ppw pbuf (fromIntegral pwBufSize) pppw throwErrnoIfNull "getUserEntryForID" $ peekElemOff pppw 0 unpackUserEntry ppw foreign import ccall unsafe "getpwuid_r" c_getpwuid_r :: CUid -> Ptr CPasswd -> CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt #elif HAVE_GETPWUID getUserEntryForID uid = do withMVar lock $ \_ -> do ppw <- throwErrnoIfNull "getUserEntryForID" $ c_getpwuid uid unpackUserEntry ppw foreign import ccall unsafe "getpwuid" c_getpwuid :: CUid -> IO (Ptr CPasswd) #else getUserEntryForID = error "System.Posix.User.getUserEntryForID: not supported" #endif -- | @getUserEntryForName name@ calls @getpwnam@ to obtain -- the @UserEntry@ information associated with the user login -- @name@. getUserEntryForName :: String -> IO UserEntry #if HAVE_GETPWNAM_R getUserEntryForName name = do allocaBytes (#const sizeof(struct passwd)) $ \ppw -> allocaBytes pwBufSize $ \pbuf -> alloca $ \ pppw -> withCString name $ \ pstr -> do throwErrorIfNonZero_ "getUserEntryForName" $ c_getpwnam_r pstr ppw pbuf (fromIntegral pwBufSize) pppw throwErrnoIfNull "getUserEntryForName" $ peekElemOff pppw 0 unpackUserEntry ppw foreign import ccall unsafe "getpwnam_r" c_getpwnam_r :: CString -> Ptr CPasswd -> CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt #elif HAVE_GETPWNAM getUserEntryForName name = do withCString name $ \ pstr -> do withMVar lock $ \_ -> do ppw <- throwErrnoIfNull "getUserEntryForName" $ c_getpwnam pstr unpackUserEntry ppw foreign import ccall unsafe "getpwnam" c_getpwnam :: CString -> IO (Ptr CPasswd) #else getUserEntryForName = error "System.Posix.User.getUserEntryForName: not supported" #endif -- | @getAllUserEntries@ returns all user entries on the system by -- repeatedly calling @getpwent@ getAllUserEntries :: IO [UserEntry] #ifdef HAVE_GETPWENT getAllUserEntries = withMVar lock $ \_ -> worker [] where worker accum = do resetErrno ppw <- throwErrnoIfNullAndError "getAllUserEntries" $ c_getpwent if ppw == nullPtr then return (reverse accum) else do thisentry <- unpackUserEntry ppw worker (thisentry : accum) foreign import ccall unsafe "getpwent" c_getpwent :: IO (Ptr CPasswd) #else getAllUserEntries = error "System.Posix.User.getAllUserEntries: not supported" #endif #if defined(HAVE_GETPWUID_R) || defined(HAVE_GETPWNAM_R) pwBufSize :: Int #if defined(HAVE_SYSCONF) && defined(HAVE_SC_GETPW_R_SIZE_MAX) pwBufSize = fromIntegral $ unsafePerformIO $ c_sysconf (#const _SC_GETPW_R_SIZE_MAX) #else pwBufSize = 1024 #endif #endif #ifdef HAVE_SYSCONF foreign import ccall unsafe "sysconf" c_sysconf :: CInt -> IO CLong #endif unpackUserEntry :: Ptr CPasswd -> IO UserEntry unpackUserEntry ptr = do name <- (#peek struct passwd, pw_name) ptr >>= peekCString passwd <- (#peek struct passwd, pw_passwd) ptr >>= peekCString uid <- (#peek struct passwd, pw_uid) ptr gid <- (#peek struct passwd, pw_gid) ptr gecos <- (#peek struct passwd, pw_gecos) ptr >>= peekCString dir <- (#peek struct passwd, pw_dir) ptr >>= peekCString shell <- (#peek struct passwd, pw_shell) ptr >>= peekCString return (UserEntry name passwd uid gid gecos dir shell) -- Used when calling re-entrant system calls that signal their 'errno' -- directly through the return value. throwErrorIfNonZero_ :: String -> IO CInt -> IO () throwErrorIfNonZero_ loc act = do rc <- act if (rc == 0) then return () else ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) -- Used when a function returns NULL to indicate either an error or -- EOF, depending on whether the global errno is nonzero. throwErrnoIfNullAndError :: String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfNullAndError loc act = do rc <- act errno <- getErrno if rc == nullPtr && errno /= eOK then throwErrno loc else return rc hugs98-plus-Sep2006/packages/unix/System/Posix.hs0000644006511100651110000000700610504340274020450 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Posix -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX support -- ----------------------------------------------------------------------------- module System.Posix ( module System.Posix.Types, module System.Posix.Signals, module System.Posix.Directory, module System.Posix.Files, module System.Posix.Unistd, module System.Posix.IO, module System.Posix.Env, module System.Posix.Process, module System.Posix.Temp, module System.Posix.Terminal, module System.Posix.Time, module System.Posix.User, module System.Posix.Resource ) where import System.Posix.Types import System.Posix.Signals import System.Posix.Directory import System.Posix.Files import System.Posix.Unistd import System.Posix.Process import System.Posix.IO import System.Posix.Env import System.Posix.Temp import System.Posix.Terminal import System.Posix.Time import System.Posix.User import System.Posix.Resource {- TODO Here we detail our support for the IEEE Std 1003.1-2001 standard. For each header file defined by the standard, we categorise its functionality as - "supported" Full equivalent functionality is provided by the specified Haskell module. - "unsupported" (functionality not provided by a Haskell module) The functionality is not currently provided. - "to be supported" Currently unsupported, but support is planned for the future. Exceptions are listed where appropriate. Interfaces supported -------------------- base package: regex.h Text.Regex.Posix signal.h System.Posix.Signals unix package: dirent.h System.Posix.Directory dlfcn.h System.Posix.DynamicLinker errno.h Foreign.C.Error fcntl.h System.Posix.IO sys/stat.h System.Posix.Files sys/times.h System.Posix.Process sys/types.h System.Posix.Types (with exceptions...) sys/utsname.h System.Posix.Unistd sys/wait.h System.Posix.Process termios.h System.Posix.Terminal (check exceptions) unistd.h System.Posix.* utime.h System.Posix.Files pwd.h System.Posix.User grp.h System.Posix.User stdlib.h: System.Posix.Env (getenv()/setenv()/unsetenv()) System.Posix.Temp (mkstemp()) sys/resource.h: System.Posix.Resource (get/setrlimit() only) network package: arpa/inet.h net/if.h netinet/in.h netinet/tcp.h sys/socket.h sys/un.h To be supported --------------- limits.h (pathconf()/fpathconf() already done) poll.h sys/resource.h (getrusage(): use instead of times() for getProcessTimes?) sys/select.h sys/statvfs.h (?) sys/time.h (but maybe not the itimer?) time.h (System.Posix.Time) stdio.h (popen only: System.Posix.IO) sys/mman.h Unsupported interfaces ---------------------- aio.h assert.h complex.h cpio.h ctype.h fenv.h float.h fmtmsg.h fnmatch.h ftw.h glob.h iconv.h inttypes.h iso646.h langinfo.h libgen.h locale.h (see System.Locale) math.h monetary.h mqueue.h ndbm.h netdb.h nl_types.h pthread.h sched.h search.h semaphore.h setjmp.h spawn.h stdarg.h stdbool.h stddef.h stdint.h stdio.h except: popen() stdlib.h except: exit(): System.Posix.Process free()/malloc(): Foreign.Marshal.Alloc getenv()/setenv(): ?? System.Environment rand() etc.: System.Random string.h strings.h stropts.h sys/ipc.h sys/msg.h sys/sem.h sys/shm.h sys/timeb.h sys/uio.h syslog.h tar.h tgmath.h trace.h ucontext.h ulimit.h utmpx.h wchar.h wctype.h wordexp.h -} hugs98-plus-Sep2006/packages/unix/LICENSE0000644006511100651110000000311310504340274016526 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/unix/Makefile0000644006511100651110000000101410504340275017160 0ustar rossrossTOP=.. include $(TOP)/mk/boilerplate.mk SUBDIRS = cbits include ALL_DIRS = System System/Posix System/Posix/DynamicLinker System/Posix/Signals PACKAGE = unix VERSION = 1.0 PACKAGE_DEPS = base SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" SRC_HSC2HS_OPTS += -Iinclude -I../../mk/ $(unix_SRC_HSC2HS_OPTS) SRC_HC_OPTS += -Iinclude $(unix_SRC_HSC2HS_OPTS) EXCLUDED_SRCS += Setup.hs DIST_CLEAN_FILES += unix.buildinfo config.cache config.status include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/unix/cbits/0000755006511100651110000000000010504340275016630 5ustar rossrosshugs98-plus-Sep2006/packages/unix/cbits/HsUnix.c0000644006511100651110000000070510504340274020213 0ustar rossross/* ----------------------------------------------------------------------------- * $Id: HsUnix.c,v 1.1 2002/09/12 16:38:22 simonmar Exp $ * * (c) The University of Glasgow 2002 * * Definitions for package `unix' which are visible in Haskell land. * * ---------------------------------------------------------------------------*/ // Out-of-line versions of all the inline functions from HsUnix.h #define INLINE /* nothing */ #include "HsUnix.h" hugs98-plus-Sep2006/packages/unix/cbits/Makefile0000644006511100651110000000035010504340275020266 0ustar rossrossTOP = ../.. include $(TOP)/mk/boilerplate.mk HC = $(GHC_INPLACE) SRC_CC_OPTS += -Wall SRC_CC_OPTS += -I$(GHC_INCLUDE_DIR) -I$(GHC_RTS_DIR) -I../include LIBRARY = libHSunix_cbits.a LIBOBJS = $(C_OBJS) include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/unix/aclocal.m40000644006511100651110000000021610504340274017362 0ustar rossross# Empty file to avoid a dependency on automake: autoreconf calls aclocal to # generate a temporary aclocal.m4t when no aclocal.m4 is present. hugs98-plus-Sep2006/packages/unix/include/0000755006511100651110000000000010504340713017144 5ustar rossrosshugs98-plus-Sep2006/packages/unix/include/HsUnix.h0000644006511100651110000000473310504340274020544 0ustar rossross/* ----------------------------------------------------------------------------- * * (c) The University of Glasgow 2002 * * Definitions for package `unix' which are visible in Haskell land. * * ---------------------------------------------------------------------------*/ #ifndef HSUNIX_H #define HSUNIX_H #include "HsUnixConfig.h" /* ultra-evil... */ #undef PACKAGE_BUGREPORT #undef PACKAGE_NAME #undef PACKAGE_STRING #undef PACKAGE_TARNAME #undef PACKAGE_VERSION #ifdef solaris2_HOST_OS #define _POSIX_PTHREAD_SEMANTICS #endif #include #include #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_SYS_TIMES_H #include #endif #ifdef HAVE_SYS_TIME_H #include #endif #ifdef HAVE_SYS_RESOURCE_H #include #endif #ifdef HAVE_SYS_WAIT_H #include #endif #ifdef HAVE_SYS_STAT_H #include #endif #ifdef HAVE_TIME_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_UTIME_H #include #endif #ifdef HAVE_FCNTL_H #include #endif #ifdef HAVE_LIMITS_H #include #endif #ifdef HAVE_TERMIOS_H #include #endif #ifdef HAVE_SYS_UTSNAME_H #include #endif #ifdef HAVE_PWD_H #include #endif #ifdef HAVE_GRP_H #include #endif #ifdef HAVE_DIRENT_H #include #endif #include #ifdef HAVE_SIGNAL_H #include #endif extern char **environ; #ifndef INLINE # if defined(__GNUC__) # define INLINE extern inline # else # define INLINE inline # endif #endif INLINE int __hsunix_wifexited (int stat) { return WIFEXITED(stat); } INLINE int __hsunix_wexitstatus (int stat) { return WEXITSTATUS(stat); } INLINE int __hsunix_wifsignaled (int stat) { return WIFSIGNALED(stat); } INLINE int __hsunix_wtermsig (int stat) { return WTERMSIG(stat); } INLINE int __hsunix_wifstopped (int stat) { return WIFSTOPPED(stat); } INLINE int __hsunix_wstopsig (int stat) { return WSTOPSIG(stat); } #ifdef HAVE_RTLDNEXT INLINE void *__hsunix_rtldNext (void) {return RTLD_NEXT;} #endif #ifdef HAVE_RTLDDEFAULT INLINE void *__hsunix_rtldDefault (void) {return RTLD_DEFAULT;} #endif /* O_SYNC doesn't exist on Mac OS X and (at least some versions of) FreeBSD, fall back to O_FSYNC, which should be the same */ #ifndef O_SYNC #define O_SYNC O_FSYNC #endif #ifdef SIGINFO INLINE int __hsunix_SIGINFO() { return SIGINFO; } #endif #ifdef SIGWINCH INLINE int __hsunix_SIGWINCH() { return SIGWINCH; } #endif #endif hugs98-plus-Sep2006/packages/unix/include/Makefile0000644006511100651110000000030510504340274020604 0ustar rossrossTOP=../.. include $(TOP)/mk/boilerplate.mk H_FILES = $(wildcard *.h) includedir = $(libdir)/include INSTALL_INCLUDES = $(H_FILES) DIST_CLEAN_FILES += HsUnixConfig.h include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/unix/include/HsUnixConfig.h.in0000644006511100651110000000776610504340713022306 0ustar rossross/* include/HsUnixConfig.h.in. Generated from configure.ac by autoheader. */ /* Define to 1 if you have the header file. */ #undef HAVE_DIRENT_H /* Define to 1 if you have the header file. */ #undef HAVE_FCNTL_H /* Define to 1 if you have the `getgrent' function. */ #undef HAVE_GETGRENT /* Define to 1 if you have the `getgrgid_r' function. */ #undef HAVE_GETGRGID_R /* Define to 1 if you have the `getgrnam_r' function. */ #undef HAVE_GETGRNAM_R /* Define to 1 if you have the `getpwent' function. */ #undef HAVE_GETPWENT /* Define to 1 if you have the `getpwnam' function. */ #undef HAVE_GETPWNAM /* Define to 1 if you have the `getpwnam_r' function. */ #undef HAVE_GETPWNAM_R /* Define to 1 if you have the `getpwuid' function. */ #undef HAVE_GETPWUID /* Define to 1 if you have the `getpwuid_r' function. */ #undef HAVE_GETPWUID_R /* Define to 1 if you have the header file. */ #undef HAVE_GRP_H /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if you have the `lchown' function. */ #undef HAVE_LCHOWN /* Define to 1 if you have the header file. */ #undef HAVE_LIMITS_H /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the header file. */ #undef HAVE_PWD_H /* Define to 1 if RTLD_DEFAULT is available. */ #undef HAVE_RTLDDEFAULT /* Define to 1 if RTLD_GLOBAL is available. */ #undef HAVE_RTLDGLOBAL /* Define to 1 if RTLD_LOCAL is available. */ #undef HAVE_RTLDLOCAL /* Define to 1 if we can see RTLD_NEXT in dlfcn.h. */ #undef HAVE_RTLDNEXT /* Define to 1 if we can see RTLD_NOW in dlfcn.h */ #undef HAVE_RTLDNOW /* Define to 1 if defines _SC_GETGR_R_SIZE_MAX. */ #undef HAVE_SC_GETGR_R_SIZE_MAX /* Define to 1 if defines _SC_GETPW_R_SIZE_MAX. */ #undef HAVE_SC_GETPW_R_SIZE_MAX /* Define to 1 if you have the `setenv' function. */ #undef HAVE_SETENV /* Define to 1 if you have the header file. */ #undef HAVE_SIGNAL_H /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the `sysconf' function. */ #undef HAVE_SYSCONF /* Define to 1 if you have the header file. */ #undef HAVE_SYS_RESOURCE_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIMES_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_UTSNAME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_WAIT_H /* Define to 1 if you have the header file. */ #undef HAVE_TERMIOS_H /* Define to 1 if you have the header file. */ #undef HAVE_TIME_H /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to 1 if you have the `unsetenv' function. */ #undef HAVE_UNSETENV /* Define to 1 if you have the header file. */ #undef HAVE_UTIME_H /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS /* Define if the system headers declare usleep to return void. */ #undef USLEEP_RETURNS_VOID /* Define to empty if `const' does not conform to ANSI C. */ #undef const hugs98-plus-Sep2006/packages/unix/configure.ac0000644006511100651110000000750010504340275020014 0ustar rossrossAC_INIT([Haskell unix package], [2.0], [libraries@haskell.org], [unix]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([include/HsUnix.h]) AC_CONFIG_HEADERS([include/HsUnixConfig.h]) # Is this a Unix system? AC_CHECK_HEADER([dlfcn.h], [BUILD_PACKAGE_BOOL=True], [BUILD_PACKAGE_BOOL=False]) AC_SUBST([BUILD_PACKAGE_BOOL]) AC_C_CONST AC_CHECK_HEADERS([dirent.h fcntl.h grp.h limits.h pwd.h signal.h string.h]) AC_CHECK_HEADERS([sys/resource.h sys/stat.h sys/times.h sys/time.h]) AC_CHECK_HEADERS([sys/utsname.h sys/wait.h]) AC_CHECK_HEADERS([termios.h time.h unistd.h utime.h]) AC_CHECK_FUNCS([getgrgid_r getgrnam_r getpwnam_r getpwuid_r getpwnam getpwuid]) AC_CHECK_FUNCS([getpwent getgrent]) AC_CHECK_FUNCS([lchown setenv sysconf unsetenv]) AC_MSG_CHECKING([for _SC_GETGR_R_SIZE_MAX]) AC_EGREP_CPP(we_have_that_sysconf_thing, [ #include #ifdef _SC_GETGR_R_SIZE_MAX we_have_that_sysconf_thing #endif ], [AC_MSG_RESULT([yes]) AC_DEFINE([HAVE_SC_GETGR_R_SIZE_MAX], [1], [Define to 1 if defines _SC_GETGR_R_SIZE_MAX.])], [AC_MSG_RESULT([no])]) AC_MSG_CHECKING([for _SC_GETPW_R_SIZE_MAX]) AC_EGREP_CPP(we_have_that_sysconf_thing, [ #include #ifdef _SC_GETPW_R_SIZE_MAX we_have_that_sysconf_thing #endif ], [AC_MSG_RESULT([yes]) AC_DEFINE([HAVE_SC_GETPW_R_SIZE_MAX], [1], [Define to 1 if defines _SC_GETPW_R_SIZE_MAX.])], [AC_MSG_RESULT([no])]) dnl ---------- usleep ---------- dnl --- stolen from guile configure --- dnl --- FIXME: /usr/include/unistd.h can't be right? ### On some systems usleep has no return value. If it does have one, ### we'd like to return it; otherwise, we'll fake it. AC_CACHE_CHECK([return type of usleep], cv_func_usleep_return_type, [AC_EGREP_HEADER(changequote(<, >)changequote([, ]), /usr/include/unistd.h, [cv_func_usleep_return_type=void], [cv_func_usleep_return_type=int])]) case "$cv_func_usleep_return_type" in "void" ) AC_DEFINE([USLEEP_RETURNS_VOID], [1], [Define if the system headers declare usleep to return void.]) ;; esac dnl ** sometimes RTLD_NEXT is hidden in #ifdefs we really don't wan to set AC_MSG_CHECKING(for RTLD_NEXT from dlfcn.h) AC_EGREP_CPP(yes, [ #include #ifdef RTLD_NEXT yes #endif ], [ AC_MSG_RESULT(yes) AC_DEFINE([HAVE_RTLDNEXT], [1], [Define to 1 if we can see RTLD_NEXT in dlfcn.h.]) ], [ AC_MSG_RESULT(no) ]) dnl ** RTLD_DEFAULT isn't available on cygwin AC_MSG_CHECKING(for RTLD_DEFAULT from dlfcn.h) AC_EGREP_CPP(yes, [ #include #ifdef RTLD_DEFAULT yes #endif ], [ AC_MSG_RESULT(yes) AC_DEFINE([HAVE_RTLDDEFAULT], [1], [Define to 1 if RTLD_DEFAULT is available.]) ], [ AC_MSG_RESULT(no) ]) dnl ** RTLD_LOCAL isn't available on cygwin or openbsd AC_MSG_CHECKING(for RTLD_LOCAL from dlfcn.h) AC_EGREP_CPP(yes, [ #include #ifdef RTLD_LOCAL yes #endif ], [ AC_MSG_RESULT(yes) AC_DEFINE([HAVE_RTLDLOCAL], [1], [Define to 1 if RTLD_LOCAL is available.]) ], [ AC_MSG_RESULT(no) ]) dnl ** RTLD_GLOBAL isn't available on openbsd AC_MSG_CHECKING(for RTLD_GLOBAL from dlfcn.h) AC_EGREP_CPP(yes, [ #include #ifdef RTLD_GLOBAL yes #endif ], [ AC_MSG_RESULT(yes) AC_DEFINE([HAVE_RTLDGLOBAL], [1], [Define to 1 if RTLD_GLOBAL is available.]) ], [ AC_MSG_RESULT(no) ]) dnl ** RTLD_NOW isn't available on openbsd AC_MSG_CHECKING(for RTLD_NOW from dlfcn.h) AC_EGREP_CPP(yes, [ #include #ifdef RTLD_NOW yes #endif ], [ AC_MSG_RESULT(yes) AC_DEFINE([HAVE_RTLDNOW], [1], [Define to 1 if we can see RTLD_NOW in dlfcn.h]) ], [ AC_MSG_RESULT(no) ]) # Avoid adding dl if absent or unneeded AC_CHECK_LIB(dl, dlopen, [EXTRA_LIBS=dl], [EXTRA_LIBS=]) AC_SUBST([EXTRA_LIBS]) AC_CONFIG_FILES([unix.buildinfo]) AC_OUTPUT hugs98-plus-Sep2006/packages/unix/package.conf.in0000644006511100651110000000176010504340274020376 0ustar rossross#include "ghcconfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: System.Posix, System.Posix.DynamicLinker.Module, System.Posix.DynamicLinker.Prim, System.Posix.Directory, System.Posix.DynamicLinker, System.Posix.Env, System.Posix.Error, System.Posix.Files, System.Posix.IO, System.Posix.Process, System.Posix.Resource, System.Posix.Temp, System.Posix.Terminal, System.Posix.Time, System.Posix.Unistd, System.Posix.User, System.Posix.Signals.Exts hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR #ifndef INSTALLING , LIB_DIR"/cbits" #endif hs-libraries: "HSunix" #if !(defined HAVE_FRAMEWORK_HASKELLSUPPORT) && defined(HAVE_LIBDL) extra-libraries: "HSunix_cbits", "dl" #else extra-libraries: "HSunix_cbits" #endif include-dirs: INCLUDE_DIR includes: HsUnix.h depends: base hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/unix/prologue.txt0000644006511100651110000000002410504340274020114 0ustar rossrossPOSIX functionality.hugs98-plus-Sep2006/packages/unix/unix.buildinfo.in0000644006511100651110000000007610504340274021013 0ustar rossrossbuildable: @BUILD_PACKAGE_BOOL@ extra-libraries: @EXTRA_LIBS@ hugs98-plus-Sep2006/packages/unix/unix.cabal0000644006511100651110000000221310504340275017471 0ustar rossrossname: unix version: 2.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org synopsis: POSIX functionality description: This package gives you access to the set of operating system services standardised by POSIX 1003.1b (or the IEEE Portable Operating System Interface for Computing Environments - IEEE Std. 1003.1). . The package is not supported under Windows (except under Cygwin). exposed-modules: System.Posix System.Posix.DynamicLinker.Module System.Posix.DynamicLinker.Prim System.Posix.Directory System.Posix.DynamicLinker System.Posix.Env System.Posix.Error System.Posix.Files System.Posix.IO System.Posix.Process System.Posix.Resource System.Posix.Temp System.Posix.Terminal System.Posix.Time System.Posix.Unistd System.Posix.User System.Posix.Signals.Exts extra-source-files: configure.ac configure unix.buildinfo.in include/HsUnixConfig.h.in include/HsUnix.h extra-tmp-files: config.log config.status autom4te.cache unix.buildinfo include/HsUnixConfig.h build-depends: base extensions: CPP include-dirs: include install-includes: HsUnix.h HsUnixConfig.h c-sources: cbits/HsUnix.c hugs98-plus-Sep2006/packages/unix/Setup.hs0000644006511100651110000000023210504340275017155 0ustar rossrossmodule Main (main) where import Distribution.Simple (defaultMainWithHooks, defaultUserHooks) main :: IO () main = defaultMainWithHooks defaultUserHooks hugs98-plus-Sep2006/packages/unix/configure0000755006511100651110000052445110504340712017442 0ustar rossross#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.60a for Haskell unix package 2.0. # # Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /usr/bin/posix$PATH_SEPARATOR/bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell autoconf@gnu.org about your system, echo including any error possibly output before this echo message } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='Haskell unix package' PACKAGE_TARNAME='unix' PACKAGE_VERSION='2.0' PACKAGE_STRING='Haskell unix package 2.0' PACKAGE_BUGREPORT='libraries@haskell.org' ac_unique_file="include/HsUnix.h" # Factoring default headers for most tests. ac_includes_default="\ #include #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_STAT_H # include #endif #ifdef STDC_HEADERS # include # include #else # ifdef HAVE_STDLIB_H # include # endif #endif #ifdef HAVE_STRING_H # if !defined STDC_HEADERS && defined HAVE_MEMORY_H # include # endif # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datarootdir datadir sysconfdir sharedstatedir localstatedir includedir oldincludedir docdir infodir htmldir dvidir pdfdir psdir libdir localedir mandir DEFS ECHO_C ECHO_N ECHO_T LIBS build_alias host_alias target_alias CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP GREP EGREP BUILD_PACKAGE_BOOL EXTRA_LIBS LIBOBJS LTLIBOBJS' ac_subst_files='' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS CPPFLAGS CPP' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` eval with_$ac_package=\$ac_optarg ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval with_$ac_package=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute directory names. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { echo "$as_me: error: Working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$0" || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # 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 Haskell unix package 2.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/unix] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of Haskell unix package 2.0:";; esac cat <<\_ACEOF Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF Haskell unix package configure 2.0 generated by GNU Autoconf 2.60a Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by Haskell unix package $as_me 2.0, which was generated by GNU Autoconf 2.60a. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then set x "$CONFIG_SITE" elif test "x$prefix" != xNONE; then set x "$prefix/share/config.site" "$prefix/etc/config.site" else set x "$ac_default_prefix/share/config.site" \ "$ac_default_prefix/etc/config.site" fi shift for ac_site_file do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Safety check: Ensure that we are in the correct source directory. ac_config_headers="$ac_config_headers include/HsUnixConfig.h" # Is this a Unix system? ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO: checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; } ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # # List of possible output files, starting from the most likely. # The algorithm is not robust to junk in `.', hence go to wildcards (a.*) # only as a last resort. b.out is created by i960 compilers. ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' # # The IRIX 6 linker writes into existing files which may not be # executable, retaining their permissions. Remove them first so a # subsequent execution test works. ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { (ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi { echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6; } if test -z "$ac_file"; then echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } { echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6; } { echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext { echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT { echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; } if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; } GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CFLAGS="" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_c89+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_c89=$ac_arg else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6; } ;; xno) { echo "$as_me:$LINENO: result: unsupported" >&5 echo "${ECHO_T}unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Extract the first word of "grep ggrep" to use in msg output if test -z "$GREP"; then set dummy grep ggrep; ac_prog_name=$2 if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_GREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_GREP" && $as_executable_p "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_GREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_GREP_found && break 3 done done done IFS=$as_save_IFS fi GREP="$ac_cv_path_GREP" if test -z "$GREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_GREP=$GREP fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 echo "${ECHO_T}$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" { echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6; } if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else # Extract the first word of "egrep" to use in msg output if test -z "$EGREP"; then set dummy egrep; ac_prog_name=$2 if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_EGREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_EGREP" && $as_executable_p "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_EGREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_found && break 3 done done done IFS=$as_save_IFS fi EGREP="$ac_cv_path_EGREP" if test -z "$EGREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_EGREP=$EGREP fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 echo "${ECHO_T}$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" { echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) return 2; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done if test "${ac_cv_header_dlfcn_h+set}" = set; then { echo "$as_me:$LINENO: checking for dlfcn.h" >&5 echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6; } if test "${ac_cv_header_dlfcn_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi { echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking dlfcn.h usability" >&5 echo $ECHO_N "checking dlfcn.h usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking dlfcn.h presence" >&5 echo $ECHO_N "checking dlfcn.h presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: dlfcn.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: dlfcn.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: dlfcn.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: dlfcn.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: dlfcn.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for dlfcn.h" >&5 echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6; } if test "${ac_cv_header_dlfcn_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_dlfcn_h=$ac_header_preproc fi { echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6; } fi if test $ac_cv_header_dlfcn_h = yes; then BUILD_PACKAGE_BOOL=True else BUILD_PACKAGE_BOOL=False fi { echo "$as_me:$LINENO: checking for an ANSI C-conforming const" >&5 echo $ECHO_N "checking for an ANSI C-conforming const... $ECHO_C" >&6; } if test "${ac_cv_c_const+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { /* FIXME: Include the comments suggested by Paul. */ #ifndef __cplusplus /* Ultrix mips cc rejects this. */ typedef int charset[2]; const charset cs; /* SunOS 4.1.1 cc rejects this. */ char const *const *pcpcc; char **ppc; /* NEC SVR4.0.2 mips cc rejects this. */ struct point {int x, y;}; static struct point const zero = {0,0}; /* AIX XL C 1.02.0.0 rejects this. It does not let you subtract one const X* pointer from another in an arm of an if-expression whose if-part is not a constant expression */ const char *g = "string"; pcpcc = &g + (g ? g-g : 0); /* HPUX 7.0 cc rejects these. */ ++pcpcc; ppc = (char**) pcpcc; pcpcc = (char const *const *) ppc; { /* SCO 3.2v4 cc rejects this. */ char *t; char const *s = 0 ? (char *) 0 : (char const *) 0; *t++ = 0; if (s) return 0; } { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */ int x[] = {25, 17}; const int *foo = &x[0]; ++foo; } { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */ typedef const int *iptr; iptr p = 0; ++p; } { /* AIX XL C 1.02.0.0 rejects this saying "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ struct s { int j; const int *ap[3]; }; struct s *b; b->j = 5; } { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ const int foo = 10; if (!foo) return 0; } return !cs[0] && !zero.x; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_const=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_const=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_c_const" >&5 echo "${ECHO_T}$ac_cv_c_const" >&6; } if test $ac_cv_c_const = no; then cat >>confdefs.h <<\_ACEOF #define const _ACEOF fi for ac_header in dirent.h fcntl.h grp.h limits.h pwd.h signal.h string.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in sys/resource.h sys/stat.h sys/times.h sys/time.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in sys/utsname.h sys/wait.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in termios.h time.h unistd.h utime.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in getgrgid_r getgrnam_r getpwnam_r getpwuid_r getpwnam getpwuid do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in getpwent getgrent do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in lchown setenv sysconf unsetenv do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking for _SC_GETGR_R_SIZE_MAX" >&5 echo $ECHO_N "checking for _SC_GETGR_R_SIZE_MAX... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #ifdef _SC_GETGR_R_SIZE_MAX we_have_that_sysconf_thing #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "we_have_that_sysconf_thing" >/dev/null 2>&1; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } cat >>confdefs.h <<\_ACEOF #define HAVE_SC_GETGR_R_SIZE_MAX 1 _ACEOF else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* { echo "$as_me:$LINENO: checking for _SC_GETPW_R_SIZE_MAX" >&5 echo $ECHO_N "checking for _SC_GETPW_R_SIZE_MAX... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #ifdef _SC_GETPW_R_SIZE_MAX we_have_that_sysconf_thing #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "we_have_that_sysconf_thing" >/dev/null 2>&1; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } cat >>confdefs.h <<\_ACEOF #define HAVE_SC_GETPW_R_SIZE_MAX 1 _ACEOF else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* ### On some systems usleep has no return value. If it does have one, ### we'd like to return it; otherwise, we'll fake it. { echo "$as_me:$LINENO: checking return type of usleep" >&5 echo $ECHO_N "checking return type of usleep... $ECHO_C" >&6; } if test "${cv_func_usleep_return_type+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "void[ ]+usleep" >/dev/null 2>&1; then cv_func_usleep_return_type=void else cv_func_usleep_return_type=int fi rm -f conftest* fi { echo "$as_me:$LINENO: result: $cv_func_usleep_return_type" >&5 echo "${ECHO_T}$cv_func_usleep_return_type" >&6; } case "$cv_func_usleep_return_type" in "void" ) cat >>confdefs.h <<\_ACEOF #define USLEEP_RETURNS_VOID 1 _ACEOF ;; esac { echo "$as_me:$LINENO: checking for RTLD_NEXT from dlfcn.h" >&5 echo $ECHO_N "checking for RTLD_NEXT from dlfcn.h... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #ifdef RTLD_NEXT yes #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "yes" >/dev/null 2>&1; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } cat >>confdefs.h <<\_ACEOF #define HAVE_RTLDNEXT 1 _ACEOF else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* { echo "$as_me:$LINENO: checking for RTLD_DEFAULT from dlfcn.h" >&5 echo $ECHO_N "checking for RTLD_DEFAULT from dlfcn.h... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #ifdef RTLD_DEFAULT yes #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "yes" >/dev/null 2>&1; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } cat >>confdefs.h <<\_ACEOF #define HAVE_RTLDDEFAULT 1 _ACEOF else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* { echo "$as_me:$LINENO: checking for RTLD_LOCAL from dlfcn.h" >&5 echo $ECHO_N "checking for RTLD_LOCAL from dlfcn.h... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #ifdef RTLD_LOCAL yes #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "yes" >/dev/null 2>&1; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } cat >>confdefs.h <<\_ACEOF #define HAVE_RTLDLOCAL 1 _ACEOF else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* { echo "$as_me:$LINENO: checking for RTLD_GLOBAL from dlfcn.h" >&5 echo $ECHO_N "checking for RTLD_GLOBAL from dlfcn.h... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #ifdef RTLD_GLOBAL yes #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "yes" >/dev/null 2>&1; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } cat >>confdefs.h <<\_ACEOF #define HAVE_RTLDGLOBAL 1 _ACEOF else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* { echo "$as_me:$LINENO: checking for RTLD_NOW from dlfcn.h" >&5 echo $ECHO_N "checking for RTLD_NOW from dlfcn.h... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #ifdef RTLD_NOW yes #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "yes" >/dev/null 2>&1; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } cat >>confdefs.h <<\_ACEOF #define HAVE_RTLDNOW 1 _ACEOF else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi rm -f conftest* # Avoid adding dl if absent or unneeded { echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5 echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6; } if test "${ac_cv_lib_dl_dlopen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char dlopen (); int main () { return dlopen (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dl_dlopen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dl_dlopen=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5 echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6; } if test $ac_cv_lib_dl_dlopen = yes; then EXTRA_LIBS=dl else EXTRA_LIBS= fi ac_config_files="$ac_config_files unix.buildinfo" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { echo "$as_me:$LINENO: updating cache $cache_file" >&5 echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by Haskell unix package $as_me 2.0, which was generated by GNU Autoconf 2.60a. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for. config_files="$ac_config_files" config_headers="$ac_config_headers" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ Haskell unix package config.status 2.0 configured by $0, generated by GNU Autoconf 2.60a, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2006 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header { echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 CONFIG_SHELL=$SHELL export CONFIG_SHELL exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "include/HsUnixConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsUnixConfig.h" ;; "unix.buildinfo") CONFIG_FILES="$CONFIG_FILES unix.buildinfo" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } # # Set up the sed scripts for CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "$CONFIG_FILES"; then _ACEOF ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF SHELL!$SHELL$ac_delim PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim PACKAGE_NAME!$PACKAGE_NAME$ac_delim PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim PACKAGE_STRING!$PACKAGE_STRING$ac_delim PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim exec_prefix!$exec_prefix$ac_delim prefix!$prefix$ac_delim program_transform_name!$program_transform_name$ac_delim bindir!$bindir$ac_delim sbindir!$sbindir$ac_delim libexecdir!$libexecdir$ac_delim datarootdir!$datarootdir$ac_delim datadir!$datadir$ac_delim sysconfdir!$sysconfdir$ac_delim sharedstatedir!$sharedstatedir$ac_delim localstatedir!$localstatedir$ac_delim includedir!$includedir$ac_delim oldincludedir!$oldincludedir$ac_delim docdir!$docdir$ac_delim infodir!$infodir$ac_delim htmldir!$htmldir$ac_delim dvidir!$dvidir$ac_delim pdfdir!$pdfdir$ac_delim psdir!$psdir$ac_delim libdir!$libdir$ac_delim localedir!$localedir$ac_delim mandir!$mandir$ac_delim DEFS!$DEFS$ac_delim ECHO_C!$ECHO_C$ac_delim ECHO_N!$ECHO_N$ac_delim ECHO_T!$ECHO_T$ac_delim LIBS!$LIBS$ac_delim build_alias!$build_alias$ac_delim host_alias!$host_alias$ac_delim target_alias!$target_alias$ac_delim CC!$CC$ac_delim CFLAGS!$CFLAGS$ac_delim LDFLAGS!$LDFLAGS$ac_delim CPPFLAGS!$CPPFLAGS$ac_delim ac_ct_CC!$ac_ct_CC$ac_delim EXEEXT!$EXEEXT$ac_delim OBJEXT!$OBJEXT$ac_delim CPP!$CPP$ac_delim GREP!$GREP$ac_delim EGREP!$EGREP$ac_delim BUILD_PACKAGE_BOOL!$BUILD_PACKAGE_BOOL$ac_delim EXTRA_LIBS!$EXTRA_LIBS$ac_delim LIBOBJS!$LIBOBJS$ac_delim LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 51; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` if test -n "$ac_eof"; then ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` ac_eof=`expr $ac_eof + 1` fi cat >>$CONFIG_STATUS <<_ACEOF cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof /@[a-zA-Z_][a-zA-Z_0-9]*@/!b end _ACEOF sed ' s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g s/^/s,@/; s/!/@,|#_!!_#|/ :n t n s/'"$ac_delim"'$/,g/; t s/$/\\/; p N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n ' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF :end s/|#_!!_#|//g CEOF$ac_eof _ACEOF # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/ s/:*\${srcdir}:*/:/ s/:*@srcdir@:*/:/ s/^\([^=]*=[ ]*\):*/\1/ s/:*$// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF fi # test -n "$CONFIG_FILES" for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 echo "$as_me: error: Invalid tag $ac_tag." >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac ac_file_inputs="$ac_file_inputs $ac_f" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input="Generated from "`IFS=: echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} fi case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin";; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= case `sed -n '/datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p ' $ac_file_inputs` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s&@configure_input@&$configure_input&;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out"; rm -f "$tmp/out";; *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; esac ;; :H) # # CONFIG_HEADER # _ACEOF # Transform confdefs.h into a sed script `conftest.defines', that # substitutes the proper values into config.h.in to produce config.h. rm -f conftest.defines conftest.tail # First, append a space to every undef/define line, to ease matching. echo 's/$/ /' >conftest.defines # Then, protect against being on the right side of a sed subst, or in # an unquoted here document, in config.status. If some macros were # called several times there might be several #defines for the same # symbol, which is useless. But do not sort them, since the last # AC_DEFINE must be honored. ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* # These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where # NAME is the cpp macro being defined, VALUE is the value it is being given. # PARAMS is the parameter list in the macro definition--in most cases, it's # just an empty string. ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' ac_dB='\\)[ (].*,\\1define\\2' ac_dC=' ' ac_dD=' ,' uniq confdefs.h | sed -n ' t rset :rset s/^[ ]*#[ ]*define[ ][ ]*// t ok d :ok s/[\\&,]/\\&/g s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p ' >>conftest.defines # Remove the space that was appended to ease matching. # Then replace #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. # (The regexp can be short, since the line contains either #define or #undef.) echo 's/ $// s,^[ #]*u.*,/* & */,' >>conftest.defines # Break up conftest.defines: ac_max_sed_lines=50 # First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" # Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" # Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" # et cetera. ac_in='$ac_file_inputs' ac_out='"$tmp/out1"' ac_nxt='"$tmp/out2"' while : do # Write a here document: cat >>$CONFIG_STATUS <<_ACEOF # First, check the format of the line: cat >"\$tmp/defines.sed" <<\\CEOF /^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def /^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def b :def _ACEOF sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail grep . conftest.tail >/dev/null || break rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines conftest.tail echo "ac_result=$ac_in" >>$CONFIG_STATUS cat >>$CONFIG_STATUS <<\_ACEOF if test x"$ac_file" != x-; then echo "/* $configure_input */" >"$tmp/config.h" cat "$ac_result" >>"$tmp/config.h" if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else rm -f $ac_file mv "$tmp/config.h" $ac_file fi else echo "/* $configure_input */" cat "$ac_result" fi rm -f "$tmp/out12" ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi hugs98-plus-Sep2006/packages/Cabal/0000755006511100651110000000000010504340573015544 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/DefaultSetup.lhs0000644006511100651110000000015410504340326020655 0ustar rossross#!/usr/bin/runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/Cabal.cabal0000644006511100651110000000402410504340326017526 0ustar rossrossName: Cabal Version: 1.1.5.9.2 Copyright: 2003-2006, Isaac Jones -- Util dependency removed. This may break ghc 6.2 builds :( Will -- have to figure something out for ghc 6.2 Build-Depends: base License: BSD3 License-File: LICENSE Author: Isaac Jones Maintainer: Isaac Jones Homepage: http://www.haskell.org/cabal/ Synopsis: A framework for packaging Haskell software Description: The Haskell Common Architecture for Building Applications and Libraries: a framework defining a common interface for authors to more easily build their Haskell applications in a portable way. . The Haskell Cabal is meant to be a part of a larger infrastructure for distributing, organizing, and cataloging Haskell libraries and tools. Category: Distribution Exposed-Modules: Distribution.Compat.ReadP, Distribution.Compiler, Distribution.Extension, Distribution.InstalledPackageInfo, Distribution.License, Distribution.Make, Distribution.Program, Distribution.Package, Distribution.PackageDescription, Distribution.ParseUtils, Distribution.PreProcess, Distribution.PreProcess.Unlit, Distribution.Setup, Distribution.Simple, Distribution.Simple.Build, Distribution.Simple.Configure, Distribution.Simple.GHC, Distribution.Simple.GHCPackageConfig, Distribution.Simple.Hugs, Distribution.Simple.Install, Distribution.Simple.JHC, Distribution.Simple.LocalBuildInfo, Distribution.Simple.NHC, Distribution.Simple.Register, Distribution.Simple.SrcDist, Distribution.Simple.Utils, Distribution.Version, Language.Haskell.Extension Other-Modules: Distribution.GetOpt, Distribution.Compat.Map, Distribution.Compat.Directory, Distribution.Compat.Exception, Distribution.Compat.FilePath, Distribution.Compat.RawSystem Extensions: CPP hugs98-plus-Sep2006/packages/Cabal/Distribution/0000755006511100651110000000000010504340326020217 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/Distribution/Compat/0000755006511100651110000000000010504340326021442 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/Distribution/Compat/Directory.hs0000644006511100651110000001044510504340326023746 0ustar rossross{-# OPTIONS_GHC -cpp #-} -- #hide module Distribution.Compat.Directory ( module System.Directory, #if __GLASGOW_HASKELL__ <= 602 findExecutable, copyFile, getHomeDirectory, createDirectoryIfMissing, removeDirectoryRecursive, #endif getDirectoryContentsWithoutSpecial ) where #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604 #if __GLASGOW_HASKELL__ < 603 #include "config.h" #else #include "ghcconfig.h" #endif #endif #if !__GLASGOW_HASKELL__ || __GLASGOW_HASKELL__ > 602 import System.Directory #else /* to end of file... */ import System.Environment ( getEnv ) import Distribution.Compat.FilePath import System.IO import Foreign import System.Directory import Distribution.Compat.Exception (bracket) import Control.Monad (when, unless) #if !(mingw32_HOST_OS || mingw32_TARGET_OS) import System.Posix (getFileStatus,setFileMode,fileMode,accessTime, setFileMode,modificationTime,setFileTimes) #endif findExecutable :: String -> IO (Maybe FilePath) findExecutable binary = do path <- getEnv "PATH" search (parseSearchPath path) where search :: [FilePath] -> IO (Maybe FilePath) search [] = return Nothing search (d:ds) = do let path = d `joinFileName` binary `joinFileExt` exeSuffix b <- doesFileExist path if b then return (Just path) else search ds exeSuffix :: String #if mingw32_HOST_OS || mingw32_TARGET_OS exeSuffix = "exe" #else exeSuffix = "" #endif copyPermissions :: FilePath -> FilePath -> IO () #if !(mingw32_HOST_OS || mingw32_TARGET_OS) copyPermissions src dest = do srcStatus <- getFileStatus src setFileMode dest (fileMode srcStatus) #else copyPermissions src dest = getPermissions src >>= setPermissions dest #endif copyFileTimes :: FilePath -> FilePath -> IO () #if !(mingw32_HOST_OS || mingw32_TARGET_OS) copyFileTimes src dest = do st <- getFileStatus src let atime = accessTime st mtime = modificationTime st setFileTimes dest atime mtime #else copyFileTimes src dest = return () #endif -- |Preserves permissions and, if possible, atime+mtime copyFile :: FilePath -> FilePath -> IO () copyFile src dest | dest == src = fail "copyFile: source and destination are the same file" #if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600)) | otherwise = do readFile src >>= writeFile dest try (copyPermissions src dest) return () #else | otherwise = bracket (openBinaryFile src ReadMode) hClose $ \hSrc -> bracket (openBinaryFile dest WriteMode) hClose $ \hDest -> do allocaBytes bufSize $ \buffer -> copyContents hSrc hDest buffer try (copyPermissions src dest) try (copyFileTimes src dest) return () where bufSize = 1024 copyContents hSrc hDest buffer = do count <- hGetBuf hSrc buffer bufSize when (count > 0) $ do hPutBuf hDest buffer count copyContents hSrc hDest buffer #endif getHomeDirectory :: IO FilePath getHomeDirectory = getEnv "HOME" createDirectoryIfMissing :: Bool -- ^ Create its parents too? -> FilePath -- ^ The path to the directory you want to make -> IO () createDirectoryIfMissing parents file = do b <- doesDirectoryExist file case (b,parents, file) of (_, _, "") -> return () (True, _, _) -> return () (_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file)) (_, False, _) -> createDirectory file removeDirectoryRecursive :: FilePath -> IO () removeDirectoryRecursive startLoc = do cont <- getDirectoryContentsWithoutSpecial startLoc mapM_ (rm . joinFileName startLoc) cont removeDirectory startLoc where rm :: FilePath -> IO () rm f = do temp <- try (removeFile f) case temp of Left e -> do isDir <- doesDirectoryExist f -- If f is not a directory, re-throw the error unless isDir $ ioError e removeDirectoryRecursive f Right _ -> return () #endif getDirectoryContentsWithoutSpecial :: FilePath -> IO [FilePath] getDirectoryContentsWithoutSpecial = fmap (filter (not . flip elem [".", ".."])) . getDirectoryContents hugs98-plus-Sep2006/packages/Cabal/Distribution/Compat/Exception.hs0000644006511100651110000000054010504340326023733 0ustar rossross{-# OPTIONS_GHC -cpp #-} -- #hide module Distribution.Compat.Exception (bracket,finally) where #ifdef __NHC__ import System.IO.Error (catch, ioError) import IO (bracket) #else import Control.Exception (bracket,finally) #endif #ifdef __NHC__ finally :: IO a -> IO b -> IO a finally thing after = bracket (return ()) (const after) (const thing) #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Compat/FilePath.hs0000644006511100651110000003716410504340326023505 0ustar rossross{-# OPTIONS_GHC -cpp #-} -- #hide module Distribution.Compat.FilePath ( -- * File path FilePath , splitFileName , splitFileExt , splitFilePath , baseName , dirName , joinFileName , joinFileExt , joinPaths , changeFileExt , isRootedPath , isAbsolutePath , dropAbsolutePrefix , breakFilePath , dropPrefix , pathParents , commonParent -- * Search path , parseSearchPath , mkSearchPath -- * Separators , isPathSeparator , pathSeparator , searchPathSeparator , platformPath -- * Filename extensions , exeExtension , objExtension , dllExtension ) where #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604 #if __GLASGOW_HASKELL__ < 603 #include "config.h" #else #include "ghcconfig.h" #endif #endif import Data.List(intersperse) -------------------------------------------------------------- -- * FilePath -------------------------------------------------------------- -- | Split the path into directory and file name -- -- Examples: -- -- \[Posix\] -- -- > splitFileName "/" == ("/", ".") -- > splitFileName "/foo/bar.ext" == ("/foo", "bar.ext") -- > splitFileName "bar.ext" == (".", "bar.ext") -- > splitFileName "/foo/." == ("/foo", ".") -- > splitFileName "/foo/.." == ("/foo", "..") -- -- \[Windows\] -- -- > splitFileName "\\" == ("\\", "") -- > splitFileName "c:\\foo\\bar.ext" == ("c:\\foo", "bar.ext") -- > splitFileName "bar.ext" == (".", "bar.ext") -- > splitFileName "c:\\foo\\." == ("c:\\foo", ".") -- > splitFileName "c:\\foo\\.." == ("c:\\foo", "..") -- -- The first case in the Windows examples returns an empty file name. -- This is a special case because the \"\\\\\" path doesn\'t refer to -- an object (file or directory) which resides within a directory. splitFileName :: FilePath -> (String, String) #if mingw32_HOST_OS || mingw32_TARGET_OS splitFileName p = (reverse (path2++drive), reverse fname) where (path,drive) = case p of (c:':':p) -> (reverse p,[':',c]) _ -> (reverse p,"") (fname,path1) = break isPathSeparator path path2 = case path1 of [] -> "." [_] -> path1 -- don't remove the trailing slash if -- there is only one character (c:path) | isPathSeparator c -> path _ -> path1 #else splitFileName p = (reverse path1, reverse fname1) where (fname,path) = break isPathSeparator (reverse p) path1 = case path of "" -> "." _ -> case dropWhile isPathSeparator path of "" -> [pathSeparator] p -> p fname1 = case fname of "" -> "." _ -> fname #endif -- | Split the path into file name and extension. If the file doesn\'t have extension, -- the function will return empty string. The extension doesn\'t include a leading period. -- -- Examples: -- -- > splitFileExt "foo.ext" == ("foo", "ext") -- > splitFileExt "foo" == ("foo", "") -- > splitFileExt "." == (".", "") -- > splitFileExt ".." == ("..", "") -- > splitFileExt "foo.bar."== ("foo.bar.", "") -- > splitFileExt "foo.tar.gz" == ("foo.tar","gz") splitFileExt :: FilePath -> (String, String) splitFileExt p = case break (== '.') fname of (suf@(_:_),_:pre) -> (reverse (pre++path), reverse suf) _ -> (p, []) where (fname,path) = break isPathSeparator (reverse p) -- | Split the path into directory, file name and extension. -- The function is an optimized version of the following equation: -- -- > splitFilePath path = (dir,name,ext) -- > where -- > (dir,basename) = splitFileName path -- > (name,ext) = splitFileExt basename splitFilePath :: FilePath -> (String, String, String) splitFilePath path = case break (== '.') (reverse basename) of (name_r, "") -> (dir, reverse name_r, "") (ext_r, _:name_r) -> (dir, reverse name_r, reverse ext_r) where (dir, basename) = splitFileName path baseName :: FilePath -> FilePath baseName = snd . splitFileName dirName :: FilePath -> FilePath dirName = fst . splitFileName -- | The 'joinFileName' function is the opposite of 'splitFileName'. -- It joins directory and file names to form a complete file path. -- -- The general rule is: -- -- > dir `joinFileName` basename == path -- > where -- > (dir,basename) = splitFileName path -- -- There might be an exceptions to the rule but in any case the -- reconstructed path will refer to the same object (file or directory). -- An example exception is that on Windows some slashes might be converted -- to backslashes. joinFileName :: String -> String -> FilePath joinFileName "" fname = fname joinFileName "." fname = fname joinFileName dir "" = dir joinFileName dir fname | isPathSeparator (last dir) = dir++fname | otherwise = dir++pathSeparator:fname -- | The 'joinFileExt' function is the opposite of 'splitFileExt'. -- It joins a file name and an extension to form a complete file path. -- -- The general rule is: -- -- > filename `joinFileExt` ext == path -- > where -- > (filename,ext) = splitFileExt path joinFileExt :: String -> String -> FilePath joinFileExt path "" = path joinFileExt path ext = path ++ '.':ext -- | Given a directory path \"dir\" and a file\/directory path \"rel\", -- returns a merged path \"full\" with the property that -- (cd dir; do_something_with rel) is equivalent to -- (do_something_with full). If the \"rel\" path is an absolute path -- then the returned path is equal to \"rel\" joinPaths :: FilePath -> FilePath -> FilePath joinPaths path1 path2 | isRootedPath path2 = path2 | otherwise = #if mingw32_HOST_OS || mingw32_TARGET_OS case path2 of d:':':path2' | take 2 path1 == [d,':'] -> path1 `joinFileName` path2' | otherwise -> path2 _ -> path1 `joinFileName` path2 #else path1 `joinFileName` path2 #endif -- | Changes the extension of a file path. changeFileExt :: FilePath -- ^ The path information to modify. -> String -- ^ The new extension (without a leading period). -- Specify an empty string to remove an existing -- extension from path. -> FilePath -- ^ A string containing the modified path information. changeFileExt path ext = joinFileExt name ext where (name,_) = splitFileExt path -- | On Unix and Macintosh the 'isRootedPath' function is a synonym to 'isAbsolutePath'. -- The difference is important only on Windows. The rooted path must start from the root -- directory but may not include the drive letter while the absolute path always includes -- the drive letter and the full file path. isRootedPath :: FilePath -> Bool isRootedPath (c:_) | isPathSeparator c = True #if mingw32_HOST_OS || mingw32_TARGET_OS isRootedPath (_:':':c:_) | isPathSeparator c = True -- path with drive letter #endif isRootedPath _ = False -- | Returns 'True' if this path\'s meaning is independent of any OS -- \"working directory\", or 'False' if it isn\'t. isAbsolutePath :: FilePath -> Bool #if mingw32_HOST_OS || mingw32_TARGET_OS isAbsolutePath (_:':':c:_) | isPathSeparator c = True #else isAbsolutePath (c:_) | isPathSeparator c = True #endif isAbsolutePath _ = False -- | If the function is applied to an absolute path then it returns a local path droping -- the absolute prefix in the path. Under Windows the prefix is \"\\\", \"c:\" or \"c:\\\". Under -- Unix the prefix is always \"\/\". dropAbsolutePrefix :: FilePath -> FilePath dropAbsolutePrefix (c:cs) | isPathSeparator c = cs #if mingw32_HOST_OS || mingw32_TARGET_OS dropAbsolutePrefix (_:':':c:cs) | isPathSeparator c = cs -- path with drive letter dropAbsolutePrefix (_:':':cs) = cs #endif dropAbsolutePrefix cs = cs -- | Split the path into a list of strings constituting the filepath -- -- > breakFilePath "/usr/bin/ls" == ["/","usr","bin","ls"] breakFilePath :: FilePath -> [String] breakFilePath = worker [] where worker ac path | less == path = less:ac | otherwise = worker (current:ac) less where (less,current) = splitFileName path -- | Drops a specified prefix from a filepath. -- -- > dropPrefix "." "Src/Test.hs" == "Src/Test.hs" -- > dropPrefix "Src" "Src/Test.hs" == "Test.hs" dropPrefix :: FilePath -> FilePath -> FilePath dropPrefix prefix path = worker (breakFilePath prefix) (breakFilePath path) where worker (x:xs) (y:ys) | x == y = worker xs ys worker _ ys = foldr1 joinPaths ys -- | Gets this path and all its parents. -- The function is useful in case if you want to create -- some file but you aren\'t sure whether all directories -- in the path exist or if you want to search upward for some file. -- -- Some examples: -- -- \[Posix\] -- -- > pathParents "/" == ["/"] -- > pathParents "/dir1" == ["/", "/dir1"] -- > pathParents "/dir1/dir2" == ["/", "/dir1", "/dir1/dir2"] -- > pathParents "dir1" == [".", "dir1"] -- > pathParents "dir1/dir2" == [".", "dir1", "dir1/dir2"] -- -- \[Windows\] -- -- > pathParents "c:" == ["c:."] -- > pathParents "c:\\" == ["c:\\"] -- > pathParents "c:\\dir1" == ["c:\\", "c:\\dir1"] -- > pathParents "c:\\dir1\\dir2" == ["c:\\", "c:\\dir1", "c:\\dir1\\dir2"] -- > pathParents "c:dir1" == ["c:.","c:dir1"] -- > pathParents "dir1\\dir2" == [".", "dir1", "dir1\\dir2"] -- -- Note that if the file is relative then the current directory (\".\") -- will be explicitly listed. pathParents :: FilePath -> [FilePath] pathParents p = root'' : map ((++) root') (dropEmptyPath $ inits path') where #if mingw32_HOST_OS || mingw32_TARGET_OS (root,path) = case break (== ':') p of (path, "") -> ("",path) (root,_:path) -> (root++":",path) #else (root,path) = ("",p) #endif (root',root'',path') = case path of (c:path) | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path) _ -> (root ,root++"." ,path) dropEmptyPath ("":paths) = paths dropEmptyPath paths = paths inits :: String -> [String] inits [] = [""] inits cs = case pre of "." -> inits suf ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf) _ -> "" : map (joinFileName pre) (inits suf) where (pre,suf) = case break isPathSeparator cs of (pre,"") -> (pre, "") (pre,_:suf) -> (pre,suf) -- | Given a list of file paths, returns the longest common parent. commonParent :: [FilePath] -> Maybe FilePath commonParent [] = Nothing commonParent paths@(p:ps) = case common Nothing "" p ps of #if mingw32_HOST_OS || mingw32_TARGET_OS Nothing | all (not . isAbsolutePath) paths -> let getDrive (d:':':_) ds | not (d `elem` ds) = d:ds getDrive _ ds = ds in case foldr getDrive [] paths of [] -> Just "." [d] -> Just [d,':'] _ -> Nothing #else Nothing | all (not . isAbsolutePath) paths -> Just "." #endif mb_path -> mb_path where common i acc [] ps = checkSep i acc ps common i acc (c:cs) ps | isPathSeparator c = removeSep i acc cs [] ps | otherwise = removeChar i acc c cs [] ps checkSep i acc [] = Just (reverse acc) checkSep i acc ([]:ps) = Just (reverse acc) checkSep i acc ((c1:p):ps) | isPathSeparator c1 = checkSep i acc ps checkSep i acc ps = i removeSep i acc cs pacc [] = common (Just (reverse (pathSeparator:acc))) (pathSeparator:acc) cs pacc removeSep i acc cs pacc ([] :ps) = Just (reverse acc) removeSep i acc cs pacc ((c1:p):ps) | isPathSeparator c1 = removeSep i acc cs (p:pacc) ps removeSep i acc cs pacc ps = i removeChar i acc c cs pacc [] = common i (c:acc) cs pacc removeChar i acc c cs pacc ([] :ps) = i removeChar i acc c cs pacc ((c1:p):ps) | c == c1 = removeChar i acc c cs (p:pacc) ps removeChar i acc c cs pacc ps = i -------------------------------------------------------------- -- * Search path -------------------------------------------------------------- -- | The function splits the given string to substrings -- using the 'searchPathSeparator'. parseSearchPath :: String -> [FilePath] parseSearchPath path = split path where split :: String -> [String] split s = case rest' of [] -> [chunk] _:rest -> chunk : split rest where chunk = case chunk' of #ifdef mingw32_HOST_OS ('\"':xs@(_:_)) | last xs == '\"' -> init xs #endif _ -> chunk' (chunk', rest') = break (==searchPathSeparator) s -- | The function concatenates the given paths to form a -- single string where the paths are separated with 'searchPathSeparator'. mkSearchPath :: [FilePath] -> String mkSearchPath paths = concat (intersperse [searchPathSeparator] paths) -------------------------------------------------------------- -- * Separators -------------------------------------------------------------- -- | Checks whether the character is a valid path separator for the host -- platform. The valid character is a 'pathSeparator' but since the Windows -- operating system also accepts a slash (\"\/\") since DOS 2, the function -- checks for it on this platform, too. isPathSeparator :: Char -> Bool isPathSeparator ch = #if mingw32_HOST_OS || mingw32_TARGET_OS ch == '/' || ch == '\\' #else ch == '/' #endif -- | Provides a platform-specific character used to separate directory levels in -- a path string that reflects a hierarchical file system organization. The -- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash -- (@\"\\\"@) on the Windows operating system. pathSeparator :: Char #if mingw32_HOST_OS || mingw32_TARGET_OS pathSeparator = '\\' #else pathSeparator = '/' #endif -- | A platform-specific character used to separate search path strings in -- environment variables. The separator is a colon (\":\") on Unix and Macintosh, -- and a semicolon (\";\") on the Windows operating system. searchPathSeparator :: Char #if mingw32_HOST_OS || mingw32_TARGET_OS searchPathSeparator = ';' #else searchPathSeparator = ':' #endif -- |Convert Unix-style path separators to the path separators for this platform. platformPath :: FilePath -> FilePath #if mingw32_HOST_OS || mingw32_TARGET_OS platformPath = map slash where slash '/' = '\\' slash c = c #else platformPath = id #endif -- ToDo: This should be determined via autoconf (AC_EXEEXT) -- | Extension for executable files -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2) exeExtension :: String #if mingw32_HOST_OS || mingw32_TARGET_OS exeExtension = "exe" #else exeExtension = "" #endif -- ToDo: This should be determined via autoconf (AC_OBJEXT) -- | Extension for object files. For GHC and NHC the extension is @\"o\"@. -- Hugs uses either @\"o\"@ or @\"obj\"@ depending on the used C compiler. objExtension :: String objExtension = "o" -- | Extension for dynamically linked (or shared) libraries -- (typically @\"so\"@ on Unix and @\"dll\"@ on Windows) dllExtension :: String #if mingw32_HOST_OS || mingw32_TARGET_OS dllExtension = "dll" #else dllExtension = "so" #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Compat/Map.hs0000644006511100651110000000271710504340326022522 0ustar rossross{-# OPTIONS_GHC -cpp #-} -- #hide module Distribution.Compat.Map ( Map, member, lookup, findWithDefault, empty, insert, insertWith, union, unionWith, unions, elems, keys, fromList, fromListWith, toAscList ) where import Prelude hiding ( lookup ) #if __GLASGOW_HASKELL__ >= 603 || !__GLASGOW_HASKELL__ import Data.Map #else import Data.FiniteMap type Map k a = FiniteMap k a instance Functor (FiniteMap k) where fmap f = mapFM (const f) member :: Ord k => k -> Map k a -> Bool member = elemFM lookup :: Ord k => k -> Map k a -> Maybe a lookup = flip lookupFM findWithDefault :: Ord k => a -> k -> Map k a -> a findWithDefault a k m = lookupWithDefaultFM m a k empty :: Map k a empty = emptyFM insert :: Ord k => k -> a -> Map k a -> Map k a insert k a m = addToFM m k a insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith c k a m = addToFM_C (flip c) m k a union :: Ord k => Map k a -> Map k a -> Map k a union = flip plusFM unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a unionWith c l r = plusFM_C (flip c) r l unions :: Ord k => [Map k a] -> Map k a unions = foldl (flip plusFM) emptyFM elems :: Map k a -> [a] elems = eltsFM keys :: Map k a -> [k] keys = keysFM fromList :: Ord k => [(k,a)] -> Map k a fromList = listToFM fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a fromListWith c = addListToFM_C (flip c) emptyFM toAscList :: Map k a -> [(k,a)] toAscList = fmToList #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Compat/RawSystem.hs0000644006511100651110000000102010504340326023725 0ustar rossross{-# OPTIONS_GHC -cpp #-} -- #hide module Distribution.Compat.RawSystem (rawSystem) where #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 602 import Data.List (intersperse) import System.Cmd (system) import System.Exit (ExitCode) #else import System.Cmd (rawSystem) #endif #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 602 rawSystem :: String -> [String] -> IO ExitCode rawSystem p args = system $ concat $ intersperse " " (p : map esc args) where esc arg = "'" ++ arg ++ "'" -- this is hideously broken, actually #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Compat/ReadP.hs0000644006511100651110000003620110504340326022773 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Compat.ReadP -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- This is a library of parser combinators, originally written by Koen Claessen. -- It parses all alternatives in parallel, so it never keeps hold of -- the beginning of the input string, a common source of space leaks with -- other parsers. The '(+++)' choice combinator is genuinely commutative; -- it makes no difference which branch is \"shorter\". -- -- See also Koen's paper /Parallel Parsing Processes/ -- (). -- -- This version of ReadP has been locally hacked to make it H98, by -- Martin Sjögren -- ----------------------------------------------------------------------------- module Distribution.Compat.ReadP ( -- * The 'ReadP' type ReadP, -- :: * -> *; instance Functor, Monad, MonadPlus -- * Primitive operations get, -- :: ReadP Char look, -- :: ReadP String (+++), -- :: ReadP a -> ReadP a -> ReadP a (<++), -- :: ReadP a -> ReadP a -> ReadP a gather, -- :: ReadP a -> ReadP (String, a) -- * Other operations pfail, -- :: ReadP a satisfy, -- :: (Char -> Bool) -> ReadP Char char, -- :: Char -> ReadP Char string, -- :: String -> ReadP String munch, -- :: (Char -> Bool) -> ReadP String munch1, -- :: (Char -> Bool) -> ReadP String skipSpaces, -- :: ReadP () choice, -- :: [ReadP a] -> ReadP a count, -- :: Int -> ReadP a -> ReadP [a] between, -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a option, -- :: a -> ReadP a -> ReadP a optional, -- :: ReadP a -> ReadP () many, -- :: ReadP a -> ReadP [a] many1, -- :: ReadP a -> ReadP [a] skipMany, -- :: ReadP a -> ReadP () skipMany1, -- :: ReadP a -> ReadP () sepBy, -- :: ReadP a -> ReadP sep -> ReadP [a] sepBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] endBy, -- :: ReadP a -> ReadP sep -> ReadP [a] endBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] chainr, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a chainl, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a chainl1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a chainr1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a manyTill, -- :: ReadP a -> ReadP end -> ReadP [a] -- * Running a parser ReadS, -- :: *; = String -> [(a,String)] readP_to_S, -- :: ReadP a -> ReadS a readS_to_P -- :: ReadS a -> ReadP a #if __GLASGOW_HASKELL__ < 603 && !__HUGS__ -- * Properties -- $properties #endif ) where #if __GLASGOW_HASKELL__ >= 603 || __HUGS__ import Text.ParserCombinators.ReadP hiding (ReadP) import qualified Text.ParserCombinators.ReadP as ReadP type ReadP r a = ReadP.ReadP a #else import Control.Monad( MonadPlus(..), liftM2 ) import Data.Char (isSpace) infixr 5 +++, <++ -- --------------------------------------------------------------------------- -- The P type -- is representation type -- should be kept abstract data P s a = Get (s -> P s a) | Look ([s] -> P s a) | Fail | Result a (P s a) | Final [(a,[s])] -- invariant: list is non-empty! -- Monad, MonadPlus instance Monad (P s) where return x = Result x Fail (Get f) >>= k = Get (\c -> f c >>= k) (Look f) >>= k = Look (\s -> f s >>= k) Fail >>= k = Fail (Result x p) >>= k = k x `mplus` (p >>= k) (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s] fail _ = Fail instance MonadPlus (P s) where mzero = Fail -- most common case: two gets are combined Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c) -- results are delivered as soon as possible Result x p `mplus` q = Result x (p `mplus` q) p `mplus` Result x q = Result x (p `mplus` q) -- fail disappears Fail `mplus` p = p p `mplus` Fail = p -- two finals are combined -- final + look becomes one look and one final (=optimization) -- final + sthg else becomes one look and one final Final r `mplus` Final t = Final (r ++ t) Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s)) Final r `mplus` p = Look (\s -> Final (r ++ run p s)) Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r)) p `mplus` Final r = Look (\s -> Final (run p s ++ r)) -- two looks are combined (=optimization) -- look + sthg else floats upwards Look f `mplus` Look g = Look (\s -> f s `mplus` g s) Look f `mplus` p = Look (\s -> f s `mplus` p) p `mplus` Look f = Look (\s -> p `mplus` f s) -- --------------------------------------------------------------------------- -- The ReadP type newtype Parser r s a = R ((a -> P s r) -> P s r) type ReadP r a = Parser r Char a -- Functor, Monad, MonadPlus instance Functor (Parser r s) where fmap h (R f) = R (\k -> f (k . h)) instance Monad (Parser r s) where return x = R (\k -> k x) fail _ = R (\_ -> Fail) R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k)) instance MonadPlus (Parser r s) where mzero = pfail mplus = (+++) -- --------------------------------------------------------------------------- -- Operations over P final :: [(a,[s])] -> P s a -- Maintains invariant for Final constructor final [] = Fail final r = Final r --run :: P s a -> ReadS a run (Get f) (c:s) = run (f c) s run (Look f) s = run (f s) s run (Result x p) s = (x,s) : run p s run (Final r) _ = r run _ _ = [] -- --------------------------------------------------------------------------- -- Operations over ReadP --get :: ReadP Char -- ^ Consumes and returns the next character. -- Fails if there is no input left. get = R Get --look :: ReadP String -- ^ Look-ahead: returns the part of the input that is left, without -- consuming it. look = R Look --pfail :: ReadP a -- ^ Always fails. pfail = R (\_ -> Fail) --(+++) :: ReadP r a -> ReadP r a -> ReadP r a -- ^ Symmetric choice. R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k) --(<++) :: ReadP a -> ReadP a -> ReadP a -- ^ Local, exclusive, left-biased choice: If left parser -- locally produces any result at all, then right parser is -- not used. R f <++ q = do s <- look probe (f return) s 0 where probe (Get f) (c:s) n = probe (f c) s (n+1) probe (Look f) s n = probe (f s) s n probe p@(Result _ _) _ n = discard n >> R (p >>=) probe (Final r) _ _ = R (Final r >>=) probe _ _ _ = q discard 0 = return () discard n = get >> discard (n-1) --gather :: ReadP a -> ReadP (String, a) -- ^ Transforms a parser into one that does the same, but -- in addition returns the exact characters read. -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument -- is built using any occurrences of readS_to_P. gather (R m) = R (\k -> gath id (m (\a -> return (\s -> k (s,a))))) where gath l (Get f) = Get (\c -> gath (l.(c:)) (f c)) gath l Fail = Fail gath l (Look f) = Look (\s -> gath l (f s)) gath l (Result k p) = k (l []) `mplus` gath l p gath l (Final r) = error "do not use readS_to_P in gather!" -- --------------------------------------------------------------------------- -- Derived operations --satisfy :: (Char -> Bool) -> ReadP Char -- ^ Consumes and returns the next character, if it satisfies the -- specified predicate. satisfy p = do c <- get; if p c then return c else pfail --char :: Char -> ReadP Char -- ^ Parses and returns the specified character. char c = satisfy (c ==) --string :: String -> ReadP String -- ^ Parses and returns the specified string. string this = do s <- look; scan this s where scan [] _ = do return this scan (x:xs) (y:ys) | x == y = do get; scan xs ys scan _ _ = do pfail --munch :: (Char -> Bool) -> ReadP String -- ^ Parses the first zero or more characters satisfying the predicate. munch p = do s <- look scan s where scan (c:cs) | p c = do get; s <- scan cs; return (c:s) scan _ = do return "" --munch1 :: (Char -> Bool) -> ReadP String -- ^ Parses the first one or more characters satisfying the predicate. munch1 p = do c <- get if p c then do s <- munch p; return (c:s) else pfail --choice :: [ReadP a] -> ReadP a -- ^ Combines all parsers in the specified list. choice [] = pfail choice [p] = p choice (p:ps) = p +++ choice ps --skipSpaces :: ReadP () -- ^ Skips all whitespace. skipSpaces = do s <- look skip s where skip (c:s) | isSpace c = do get; skip s skip _ = do return () --count :: Int -> ReadP a -> ReadP [a] -- ^ @ count n p @ parses @n@ occurrences of @p@ in sequence. A list of -- results is returned. count n p = sequence (replicate n p) --between :: ReadP open -> ReadP close -> ReadP a -> ReadP a -- ^ @ between open close p @ parses @open@, followed by @p@ and finally -- @close@. Only the value of @p@ is returned. between open close p = do open x <- p close return x --option :: a -> ReadP a -> ReadP a -- ^ @option x p@ will either parse @p@ or return @x@ without consuming -- any input. option x p = p +++ return x --optional :: ReadP a -> ReadP () -- ^ @optional p@ optionally parses @p@ and always returns @()@. optional p = (p >> return ()) +++ return () --many :: ReadP a -> ReadP [a] -- ^ Parses zero or more occurrences of the given parser. many p = return [] +++ many1 p --many1 :: ReadP a -> ReadP [a] -- ^ Parses one or more occurrences of the given parser. many1 p = liftM2 (:) p (many p) --skipMany :: ReadP a -> ReadP () -- ^ Like 'many', but discards the result. skipMany p = many p >> return () --skipMany1 :: ReadP a -> ReadP () -- ^ Like 'many1', but discards the result. skipMany1 p = p >> skipMany p --sepBy :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@. -- Returns a list of values returned by @p@. sepBy p sep = sepBy1 p sep +++ return [] --sepBy1 :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@. -- Returns a list of values returned by @p@. sepBy1 p sep = liftM2 (:) p (many (sep >> p)) --endBy :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended -- by @sep@. endBy p sep = many (do x <- p ; sep ; return x) --endBy1 :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended -- by @sep@. endBy1 p sep = many1 (do x <- p ; sep ; return x) --chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@. -- Returns a value produced by a /right/ associative application of all -- functions returned by @op@. If there are no occurrences of @p@, @x@ is -- returned. chainr p op x = chainr1 p op +++ return x --chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a -- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@. -- Returns a value produced by a /left/ associative application of all -- functions returned by @op@. If there are no occurrences of @p@, @x@ is -- returned. chainl p op x = chainl1 p op +++ return x --chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a -- ^ Like 'chainr', but parses one or more occurrences of @p@. chainr1 p op = scan where scan = p >>= rest rest x = do f <- op y <- scan return (f x y) +++ return x --chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a -- ^ Like 'chainl', but parses one or more occurrences of @p@. chainl1 p op = p >>= rest where rest x = do f <- op y <- p rest (f x y) +++ return x --manyTill :: ReadP a -> ReadP end -> ReadP [a] -- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@ -- succeeds. Returns a list of values returned by @p@. manyTill p end = scan where scan = (end >> return []) <++ (liftM2 (:) p scan) -- --------------------------------------------------------------------------- -- Converting between ReadP and Read --readP_to_S :: ReadP a -> ReadS a -- ^ Converts a parser into a Haskell ReadS-style function. -- This is the main way in which you can \"run\" a 'ReadP' parser: -- the expanded type is -- @ readP_to_S :: ReadP a -> String -> [(a,String)] @ readP_to_S (R f) = run (f return) --readS_to_P :: ReadS a -> ReadP a -- ^ Converts a Haskell ReadS-style function into a parser. -- Warning: This introduces local backtracking in the resulting -- parser, and therefore a possible inefficiency. readS_to_P r = R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s'])) -- --------------------------------------------------------------------------- -- QuickCheck properties that hold for the combinators {- $properties The following are QuickCheck specifications of what the combinators do. These can be seen as formal specifications of the behavior of the combinators. We use bags to give semantics to the combinators. > type Bag a = [a] Equality on bags does not care about the order of elements. > (=~) :: Ord a => Bag a -> Bag a -> Bool > xs =~ ys = sort xs == sort ys A special equality operator to avoid unresolved overloading when testing the properties. > (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool > (=~.) = (=~) Here follow the properties: > prop_Get_Nil = > readP_to_S get [] =~ [] > > prop_Get_Cons c s = > readP_to_S get (c:s) =~ [(c,s)] > > prop_Look s = > readP_to_S look s =~ [(s,s)] > > prop_Fail s = > readP_to_S pfail s =~. [] > > prop_Return x s = > readP_to_S (return x) s =~. [(x,s)] > > prop_Bind p k s = > readP_to_S (p >>= k) s =~. > [ ys'' > | (x,s') <- readP_to_S p s > , ys'' <- readP_to_S (k (x::Int)) s' > ] > > prop_Plus p q s = > readP_to_S (p +++ q) s =~. > (readP_to_S p s ++ readP_to_S q s) > > prop_LeftPlus p q s = > readP_to_S (p <++ q) s =~. > (readP_to_S p s +<+ readP_to_S q s) > where > [] +<+ ys = ys > xs +<+ _ = xs > > prop_Gather s = > forAll readPWithoutReadS $ \p -> > readP_to_S (gather p) s =~ > [ ((pre,x::Int),s') > | (x,s') <- readP_to_S p s > , let pre = take (length s - length s') s > ] > > prop_String_Yes this s = > readP_to_S (string this) (this ++ s) =~ > [(this,s)] > > prop_String_Maybe this s = > readP_to_S (string this) s =~ > [(this, drop (length this) s) | this `isPrefixOf` s] > > prop_Munch p s = > readP_to_S (munch p) s =~ > [(takeWhile p s, dropWhile p s)] > > prop_Munch1 p s = > readP_to_S (munch1 p) s =~ > [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)] > > prop_Choice ps s = > readP_to_S (choice ps) s =~. > readP_to_S (foldr (+++) pfail ps) s > > prop_ReadS r s = > readP_to_S (readS_to_P r) s =~. r s -} #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/PreProcess/0000755006511100651110000000000010504340326022304 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/Distribution/PreProcess/Unlit.hs0000644006511100651110000001006710504340326023737 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.PreProcess.Unlit -- Copyright : ... -- -- Maintainer : Malcolm Wallace -- Stability : Stable -- Portability : portable -- -- Remove the \"literal\" markups from a Haskell source file, including -- \"@>@\", \"@\\begin{code}@\", \"@\\end{code}@\", and \"@#@\" -- -- Part of the following code is from -- /Report on the Programming Language Haskell/, -- version 1.2, appendix C. module Distribution.PreProcess.Unlit(unlit,plain) where import Data.Char -- exports: unlit :: String -> String -> String unlit file lhs = (unlines . map unclassify . adjacent file (0::Int) Blank . classify 0) (tolines lhs) plain :: String -> String -> String -- no unliteration plain _ hs = hs ---- data Classified = Program String | Blank | Comment | Include Int String | Pre String classify :: Int -> [String] -> [Classified] classify _ [] = [] classify _ (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs where allProg [] = [] -- Should give an error message, but I have no -- good position information. allProg (('\\':x'):xs') | x' == "end{code}" = Blank : classify 0 xs' allProg (x':xs') = Program x':allProg xs' classify 0 (('>':x):xs) = let (sp,code) = span isSpace x in Program code : classify (length sp + 1) xs classify n (('>':x):xs) = Program (drop (n-1) x) : classify n xs classify _ (('#':x):xs) = (case words x of (line:file:_) | all isDigit line -> Include (read line) file _ -> Pre x ) : classify 0 xs classify _ (x:xs) | all isSpace x = Blank:classify 0 xs classify _ (_:xs) = Comment:classify 0 xs unclassify :: Classified -> String unclassify (Program s) = s unclassify (Pre s) = '#':s unclassify (Include i f) = '#':' ':show i ++ ' ':f unclassify Blank = "" unclassify Comment = "" adjacent :: String -> Int -> Classified -> [Classified] -> [Classified] adjacent file 0 _ (x :xs) = x: adjacent file 1 x xs -- force evaluation of line number adjacent file n (Program _) (Comment :_) = error (message file n "program" "comment") adjacent _ _ y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs adjacent file n y@(Program _) (x@(Pre _) :xs) = x: adjacent file (n+1) y xs adjacent file n Comment ((Program _) :_) = error (message file n "comment" "program") adjacent _ _ y@Comment (x@(Include i f):xs) = x: adjacent f i y xs adjacent file n y@Comment (x@(Pre _) :xs) = x: adjacent file (n+1) y xs adjacent _ _ y@Blank (x@(Include i f):xs) = x: adjacent f i y xs adjacent file n y@Blank (x@(Pre _) :xs) = x: adjacent file (n+1) y xs adjacent file n _ (x :xs) = x: adjacent file (n+1) x xs adjacent _ _ _ [] = [] message :: (Show a) => String -> a -> String -> String -> String message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" message [] n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" message file n p c = "In file " ++ file ++ " at line " ++show n++": "++p++ " line before "++c++" line.\n" -- Re-implementation of 'lines', for better efficiency (but decreased -- laziness). Also, importantly, accepts non-standard DOS and Mac line -- ending characters. tolines :: String -> [String] tolines s' = lines' s' id where lines' [] acc = [acc []] lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS lines' ('\n':s) acc = acc [] : lines' s id -- Unix lines' (c:s) acc = lines' s (acc . (c:)) {- -- A very naive version of unliteration.... module Unlit(unlit) where -- This version does not handle \begin{code} & \end{code}, and it is -- careless with indentation. unlit = map unlitline unlitline ('>' : s) = s unlitline _ = "" -} hugs98-plus-Sep2006/packages/Cabal/Distribution/Compiler.hs0000644006511100651110000002351510504340326022333 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Compiler -- Copyright : Isaac Jones 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Haskell implementations. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Compiler ( -- * Haskell implementations CompilerFlavor(..), Compiler(..), showCompilerId, compilerBinaryName, -- * Support for language extensions Opt, extensionsToFlags, extensionsToGHCFlag, extensionsToHugsFlag, extensionsToNHCFlag, extensionsToJHCFlag, #ifdef DEBUG hunitTests #endif ) where import Distribution.Version (Version(..), showVersion) import Language.Haskell.Extension (Extension(..)) import Data.List (nub) #ifdef DEBUG import HUnit (Test) #endif -- ------------------------------------------------------------ -- * Command Line Types and Exports -- ------------------------------------------------------------ data CompilerFlavor = GHC | NHC | Hugs | HBC | Helium | JHC | OtherCompiler String deriving (Show, Read, Eq) data Compiler = Compiler {compilerFlavor:: CompilerFlavor, compilerVersion :: Version, compilerPath :: FilePath, compilerPkgTool :: FilePath} deriving (Show, Read, Eq) showCompilerId :: Compiler -> String showCompilerId (Compiler f (Version [] _) _ _) = compilerBinaryName f showCompilerId (Compiler f v _ _) = compilerBinaryName f ++ '-': showVersion v compilerBinaryName :: CompilerFlavor -> String compilerBinaryName GHC = "ghc" compilerBinaryName NHC = "hmake" -- FIX: uses hmake for now compilerBinaryName Hugs = "ffihugs" compilerBinaryName JHC = "jhc" compilerBinaryName cmp = error $ "Unsupported compiler: " ++ (show cmp) -- ------------------------------------------------------------ -- * Extensions -- ------------------------------------------------------------ -- |For the given compiler, return the unsupported extensions, and the -- flags for the supported extensions. extensionsToFlags :: CompilerFlavor -> [ Extension ] -> ([Extension], [Opt]) extensionsToFlags GHC exts = extensionsToGHCFlag exts extensionsToFlags Hugs exts = extensionsToHugsFlag exts extensionsToFlags NHC exts = extensionsToNHCFlag exts extensionsToFlags JHC exts = extensionsToJHCFlag exts extensionsToFlags _ exts = (exts, []) -- |GHC: Return the unsupported extensions, and the flags for the supported extensions extensionsToGHCFlag :: [ Extension ] -> ([Extension], [Opt]) extensionsToGHCFlag l = splitEither $ nub $ map extensionToGHCFlag l where extensionToGHCFlag :: Extension -> Either Extension String extensionToGHCFlag OverlappingInstances = Right "-fallow-overlapping-instances" extensionToGHCFlag TypeSynonymInstances = Right "-fglasgow-exts" extensionToGHCFlag TemplateHaskell = Right "-fth" extensionToGHCFlag ForeignFunctionInterface = Right "-fffi" extensionToGHCFlag NoMonomorphismRestriction = Right "-fno-monomorphism-restriction" extensionToGHCFlag UndecidableInstances = Right "-fallow-undecidable-instances" extensionToGHCFlag IncoherentInstances = Right "-fallow-incoherent-instances" extensionToGHCFlag InlinePhase = Right "-finline-phase" extensionToGHCFlag ContextStack = Right "-fcontext-stack" extensionToGHCFlag Arrows = Right "-farrows" extensionToGHCFlag Generics = Right "-fgenerics" extensionToGHCFlag NoImplicitPrelude = Right "-fno-implicit-prelude" extensionToGHCFlag ImplicitParams = Right "-fimplicit-params" extensionToGHCFlag CPP = Right "-cpp" extensionToGHCFlag BangPatterns = Right "-fbang-patterns" extensionToGHCFlag RecursiveDo = Right "-fglasgow-exts" extensionToGHCFlag ParallelListComp = Right "-fglasgow-exts" extensionToGHCFlag MultiParamTypeClasses = Right "-fglasgow-exts" extensionToGHCFlag FunctionalDependencies = Right "-fglasgow-exts" extensionToGHCFlag Rank2Types = Right "-fglasgow-exts" extensionToGHCFlag RankNTypes = Right "-fglasgow-exts" extensionToGHCFlag PolymorphicComponents = Right "-fglasgow-exts" extensionToGHCFlag ExistentialQuantification = Right "-fglasgow-exts" extensionToGHCFlag ScopedTypeVariables = Right "-fglasgow-exts" extensionToGHCFlag FlexibleContexts = Right "-fglasgow-exts" extensionToGHCFlag FlexibleInstances = Right "-fglasgow-exts" extensionToGHCFlag EmptyDataDecls = Right "-fglasgow-exts" extensionToGHCFlag PatternGuards = Right "-fglasgow-exts" extensionToGHCFlag GeneralizedNewtypeDeriving = Right "-fglasgow-exts" extensionToGHCFlag e@ExtensibleRecords = Left e extensionToGHCFlag e@RestrictedTypeSynonyms = Left e extensionToGHCFlag e@HereDocuments = Left e extensionToGHCFlag e@NamedFieldPuns = Left e -- |NHC: Return the unsupported extensions, and the flags for the supported extensions extensionsToNHCFlag :: [ Extension ] -> ([Extension], [Opt]) extensionsToNHCFlag l = splitEither $ nub $ map extensionToNHCFlag l where -- NHC doesn't enforce the monomorphism restriction at all. extensionToNHCFlag NoMonomorphismRestriction = Right "" extensionToNHCFlag ForeignFunctionInterface = Right "" extensionToNHCFlag ExistentialQuantification = Right "" extensionToNHCFlag EmptyDataDecls = Right "" extensionToNHCFlag NamedFieldPuns = Right "-puns" extensionToNHCFlag CPP = Right "-cpp" extensionToNHCFlag e = Left e -- |JHC: Return the unsupported extensions, and the flags for the supported extensions extensionsToJHCFlag :: [ Extension ] -> ([Extension], [Opt]) extensionsToJHCFlag l = (es, filter (not . null) rs) where (es,rs) = splitEither $ nub $ map extensionToJHCFlag l extensionToJHCFlag TypeSynonymInstances = Right "" extensionToJHCFlag ForeignFunctionInterface = Right "" extensionToJHCFlag NoImplicitPrelude = Right "--noprelude" extensionToJHCFlag CPP = Right "-fcpp" extensionToJHCFlag e = Left e -- |Hugs: Return the unsupported extensions, and the flags for the supported extensions extensionsToHugsFlag :: [ Extension ] -> ([Extension], [Opt]) extensionsToHugsFlag l = splitEither $ nub $ map extensionToHugsFlag l where extensionToHugsFlag OverlappingInstances = Right "+o" extensionToHugsFlag IncoherentInstances = Right "+oO" extensionToHugsFlag HereDocuments = Right "+H" extensionToHugsFlag TypeSynonymInstances = Right "-98" extensionToHugsFlag RecursiveDo = Right "-98" extensionToHugsFlag ParallelListComp = Right "-98" extensionToHugsFlag MultiParamTypeClasses = Right "-98" extensionToHugsFlag FunctionalDependencies = Right "-98" extensionToHugsFlag Rank2Types = Right "-98" extensionToHugsFlag PolymorphicComponents = Right "-98" extensionToHugsFlag ExistentialQuantification = Right "-98" extensionToHugsFlag ScopedTypeVariables = Right "-98" extensionToHugsFlag ImplicitParams = Right "-98" extensionToHugsFlag ExtensibleRecords = Right "-98" extensionToHugsFlag RestrictedTypeSynonyms = Right "-98" extensionToHugsFlag FlexibleContexts = Right "-98" extensionToHugsFlag FlexibleInstances = Right "-98" extensionToHugsFlag ForeignFunctionInterface = Right "" extensionToHugsFlag EmptyDataDecls = Right "" extensionToHugsFlag CPP = Right "" extensionToHugsFlag e = Left e splitEither :: [Either a b] -> ([a], [b]) splitEither l = ([a | Left a <- l], [b | Right b <- l]) type Opt = String -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ #ifdef DEBUG hunitTests :: [Test] hunitTests = [] #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Extension.hs0000644006511100651110000000432410504340326022532 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.Extension -- Copyright : Isaac Jones 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Haskell language extensions {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Extension {-# DEPRECATED "Use modules Language.Haskell.Extension and Distribution.Compiler instead" #-} (Extension(..), Opt, extensionsToNHCFlag, extensionsToGHCFlag, extensionsToJHCFlag, extensionsToHugsFlag ) where import Distribution.Compiler (Opt, extensionsToNHCFlag, extensionsToGHCFlag, extensionsToJHCFlag, extensionsToHugsFlag) import Language.Haskell.Extension (Extension(..)) hugs98-plus-Sep2006/packages/Cabal/Distribution/GetOpt.hs0000644006511100651110000003213310504340326021757 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.GetOpt -- Copyright : (c) Sven Panne 2002-2005 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- This library provides facilities for parsing the command-line options -- in a standalone program. It is essentially a Haskell port of the GNU -- @getopt@ library. -- ----------------------------------------------------------------------------- {- Sven Panne Oct. 1996 (small changes Dec. 1997) Two rather obscure features are missing: The Bash 2.0 non-option hack (if you don't already know it, you probably don't want to hear about it...) and the recognition of long options with a single dash (e.g. '-help' is recognised as '--help', as long as there is no short option 'h'). Other differences between GNU's getopt and this implementation: * To enforce a coherent description of options and arguments, there are explanation fields in the option/argument descriptor. * Error messages are now more informative, but no longer POSIX compliant... :-( And a final Haskell advertisement: The GNU C implementation uses well over 1100 lines, we need only 195 here, including a 46 line example! :-) -} -- #hide module Distribution.GetOpt ( -- * GetOpt getOpt, getOpt', usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..), -- * Example -- $example ) where #if __GLASGOW_HASKELL__ >= 604 || !__GLASGOW_HASKELL__ import System.Console.GetOpt #else -- to end of file: import Data.List ( isPrefixOf ) -- |What to do with options following non-options data ArgOrder a = RequireOrder -- ^ no option processing after first non-option | Permute -- ^ freely intersperse options and non-options | ReturnInOrder (String -> a) -- ^ wrap non-options into options {-| Each 'OptDescr' describes a single option. The arguments to 'Option' are: * list of short option characters * list of long option strings (without \"--\") * argument descriptor * explanation of option for user -} data OptDescr a = -- description of a single options: Option [Char] -- list of short option characters [String] -- list of long option strings (without "--") (ArgDescr a) -- argument descriptor String -- explanation of option for user -- |Describes whether an option takes an argument or not, and if so -- how the argument is injected into a value of type @a@. data ArgDescr a = NoArg a -- ^ no argument expected | ReqArg (String -> a) String -- ^ option requires argument | OptArg (Maybe String -> a) String -- ^ optional argument data OptKind a -- kind of cmd line arg (internal use only): = Opt a -- an option | UnreqOpt String -- an un-recognized option | NonOpt String -- a non-option | EndOfOpts -- end-of-options marker (i.e. "--") | OptErr String -- something went wrong... -- | Return a string describing the usage of a command, derived from -- the header (first argument) and the options described by the -- second argument. usageInfo :: String -- header -> [OptDescr a] -- option descriptors -> String -- nicely formatted decription of options usageInfo header optDescr = unlines (header:table) where (ss,ls,ds) = (unzip3 . concatMap fmtOpt) optDescr table = zipWith3 paste (sameLen ss) (sameLen ls) ds paste x y z = " " ++ x ++ " " ++ y ++ " " ++ z sameLen xs = flushLeft ((maximum . map length) xs) xs flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ] fmtOpt :: OptDescr a -> [(String,String,String)] fmtOpt (Option sos los ad descr) = case lines descr of [] -> [(sosFmt,losFmt,"")] (d:ds) -> (sosFmt,losFmt,d) : [ ("","",d') | d' <- ds ] where sepBy _ [] = "" sepBy _ [x] = x sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs sosFmt = sepBy ',' (map (fmtShort ad) sos) losFmt = sepBy ',' (map (fmtLong ad) los) fmtShort :: ArgDescr a -> Char -> String fmtShort (NoArg _ ) so = "-" ++ [so] fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]" fmtLong :: ArgDescr a -> String -> String fmtLong (NoArg _ ) lo = "--" ++ lo fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]" {-| Process the command-line, and return the list of values that matched (and those that didn\'t). The arguments are: * The order requirements (see 'ArgOrder') * The option descriptions (see 'OptDescr') * The actual command line arguments (presumably got from 'System.Environment.getArgs'). 'getOpt' returns a triple consisting of the option arguments, a list of non-options, and a list of error messages. -} getOpt :: ArgOrder a -- non-option handling -> [OptDescr a] -- option descriptors -> [String] -- the command-line arguments -> ([a],[String],[String]) -- (options,non-options,error messages) getOpt ordering optDescr args = (os,xs,es ++ map errUnrec us) where (os,xs,us,es) = getOpt' ordering optDescr args {-| This is almost the same as 'getOpt', but returns a quadruple consisting of the option arguments, a list of non-options, a list of unrecognized options, and a list of error messages. -} getOpt' :: ArgOrder a -- non-option handling -> [OptDescr a] -- option descriptors -> [String] -- the command-line arguments -> ([a],[String], [String] ,[String]) -- (options,non-options,unrecognized,error messages) getOpt' _ _ [] = ([],[],[],[]) getOpt' ordering optDescr (arg:args) = procNextOpt opt ordering where procNextOpt (Opt o) _ = (o:os,xs,us,es) procNextOpt (UnreqOpt u) _ = (os,xs,u:us,es) procNextOpt (NonOpt x) RequireOrder = ([],x:rest,[],[]) procNextOpt (NonOpt x) Permute = (os,x:xs,us,es) procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,us,es) procNextOpt EndOfOpts RequireOrder = ([],rest,[],[]) procNextOpt EndOfOpts Permute = ([],rest,[],[]) procNextOpt EndOfOpts (ReturnInOrder f) = (map f rest,[],[],[]) procNextOpt (OptErr e) _ = (os,xs,us,e:es) (opt,rest) = getNext arg args optDescr (os,xs,us,es) = getOpt' ordering optDescr rest -- take a look at the next cmd line arg and decide what to do with it getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) getNext ('-':'-':[]) rest _ = (EndOfOpts,rest) getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr getNext ('-': x :xs) rest optDescr = shortOpt x xs rest optDescr getNext a rest _ = (NonOpt a,rest) -- handle long option longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) longOpt ls rs optDescr = long ads arg rs where (opt,arg) = break (=='=') ls getWith p = [ o | o@(Option _ xs _ _) <- optDescr, x <- xs, opt `p` x ] exact = getWith (==) options = if null exact then getWith isPrefixOf else exact ads = [ ad | Option _ _ ad _ <- options ] optStr = ("--"++opt) long (_:_:_) _ rest = (errAmbig options optStr,rest) long [NoArg a ] [] rest = (Opt a,rest) long [NoArg _ ] ('=':_) rest = (errNoArg optStr,rest) long [ReqArg _ d] [] [] = (errReq d optStr,[]) long [ReqArg f _] [] (r:rest) = (Opt (f r),rest) long [ReqArg f _] ('=':xs) rest = (Opt (f xs),rest) long [OptArg f _] [] rest = (Opt (f Nothing),rest) long [OptArg f _] ('=':xs) rest = (Opt (f (Just xs)),rest) long _ _ rest = (UnreqOpt ("--"++ls),rest) -- handle short option shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String]) shortOpt y ys rs optDescr = short ads ys rs where options = [ o | o@(Option ss _ _ _) <- optDescr, s <- ss, y == s ] ads = [ ad | Option _ _ ad _ <- options ] optStr = '-':[y] short (_:_:_) _ rest = (errAmbig options optStr,rest) short (NoArg a :_) [] rest = (Opt a,rest) short (NoArg a :_) xs rest = (Opt a,('-':xs):rest) short (ReqArg _ d:_) [] [] = (errReq d optStr,[]) short (ReqArg f _:_) [] (r:rest) = (Opt (f r),rest) short (ReqArg f _:_) xs rest = (Opt (f xs),rest) short (OptArg f _:_) [] rest = (Opt (f Nothing),rest) short (OptArg f _:_) xs rest = (Opt (f (Just xs)),rest) short [] [] rest = (UnreqOpt optStr,rest) short [] xs rest = (UnreqOpt optStr,('-':xs):rest) -- miscellaneous error formatting errAmbig :: [OptDescr a] -> String -> OptKind a errAmbig ods optStr = OptErr (usageInfo header ods) where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:" errReq :: String -> String -> OptKind a errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n") errUnrec :: String -> String errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n" errNoArg :: String -> OptKind a errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n") {- ----------------------------------------------------------------------------------------- -- and here a small and hopefully enlightening example: data Flag = Verbose | Version | Name String | Output String | Arg String deriving Show options :: [OptDescr Flag] options = [Option ['v'] ["verbose"] (NoArg Verbose) "verbosely list files", Option ['V','?'] ["version","release"] (NoArg Version) "show version info", Option ['o'] ["output"] (OptArg out "FILE") "use FILE for dump", Option ['n'] ["name"] (ReqArg Name "USER") "only dump USER's files"] out :: Maybe String -> Flag out Nothing = Output "stdout" out (Just o) = Output o test :: ArgOrder Flag -> [String] -> String test order cmdline = case getOpt order options cmdline of (o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n ++ "\n" (_,_,errs) -> concat errs ++ usageInfo header options where header = "Usage: foobar [OPTION...] files..." -- example runs: -- putStr (test RequireOrder ["foo","-v"]) -- ==> options=[] args=["foo", "-v"] -- putStr (test Permute ["foo","-v"]) -- ==> options=[Verbose] args=["foo"] -- putStr (test (ReturnInOrder Arg) ["foo","-v"]) -- ==> options=[Arg "foo", Verbose] args=[] -- putStr (test Permute ["foo","--","-v"]) -- ==> options=[] args=["foo", "-v"] -- putStr (test Permute ["-?o","--name","bar","--na=baz"]) -- ==> options=[Version, Output "stdout", Name "bar", Name "baz"] args=[] -- putStr (test Permute ["--ver","foo"]) -- ==> option `--ver' is ambiguous; could be one of: -- -v --verbose verbosely list files -- -V, -? --version, --release show version info -- Usage: foobar [OPTION...] files... -- -v --verbose verbosely list files -- -V, -? --version, --release show version info -- -o[FILE] --output[=FILE] use FILE for dump -- -n USER --name=USER only dump USER's files ----------------------------------------------------------------------------------------- -} #endif {- $example To hopefully illuminate the role of the different data structures, here\'s the command-line options for a (very simple) compiler: > module Opts where > > import Distribution.GetOpt > import Data.Maybe ( fromMaybe ) > > data Flag > = Verbose | Version > | Input String | Output String | LibDir String > deriving Show > > options :: [OptDescr Flag] > options = > [ Option ['v'] ["verbose"] (NoArg Verbose) "chatty output on stderr" > , Option ['V','?'] ["version"] (NoArg Version) "show version number" > , Option ['o'] ["output"] (OptArg outp "FILE") "output FILE" > , Option ['c'] [] (OptArg inp "FILE") "input FILE" > , Option ['L'] ["libdir"] (ReqArg LibDir "DIR") "library directory" > ] > > inp,outp :: Maybe String -> Flag > outp = Output . fromMaybe "stdout" > inp = Input . fromMaybe "stdin" > > compilerOpts :: [String] -> IO ([Flag], [String]) > compilerOpts argv = > case getOpt Permute options argv of > (o,n,[] ) -> return (o,n) > (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) > where header = "Usage: ic [OPTION...] files..." -} hugs98-plus-Sep2006/packages/Cabal/Distribution/License.hs0000644006511100651110000000640610504340326022143 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.License -- Copyright : Isaac Jones 2003-2005 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- The License datatype. For more information about these and other -- open-source licenses, you may visit . -- -- I am not a lawyer, but as a general guideline, most Haskell -- software seems to be released under a BSD3 license, which is very -- open and free. If you don't want to restrict the use of your -- software or its source code, use BSD3 or PublicDomain. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.License ( License(..) ) where -- |This datatype indicates the license under which your package is -- released. It is also wise to add your license to each source file. -- The 'AllRightsReserved' constructor is not actually a license, but -- states that you are not giving anyone else a license to use or -- distribute your work. The comments below are general guidelines. -- Please read the licenses themselves and consult a lawyer if you are -- unsure of your rights to release the software. data License = GPL -- ^GNU Public License. Source code must accompany alterations. | LGPL -- ^Lesser GPL, Less restrictive than GPL, useful for libraries. | BSD3 -- ^3-clause BSD license, newer, no advertising clause. Very free license. | BSD4 -- ^4-clause BSD license, older, with advertising clause. | PublicDomain -- ^Holder makes no claim to ownership, least restrictive license. | AllRightsReserved -- ^No rights are granted to others. Undistributable. Most restrictive. | {- ... | -} OtherLicense -- ^Some other license. deriving (Read, Show, Eq) hugs98-plus-Sep2006/packages/Cabal/Distribution/Make.hs0000644006511100651110000001706610504340326021442 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.Make -- Copyright : Martin Sjögren 2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Explanation: Uses the parsed command-line from Distribution.Setup -- in order to build haskell tools using a backend build system based -- on Make. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Make ( module Distribution.Package, License(..), Version(..), defaultMain, defaultMainNoRead ) where -- local import Distribution.Package --must not specify imports, since we're exporting moule. import Distribution.Program(defaultProgramConfiguration) import Distribution.PackageDescription import Distribution.Setup --(parseArgs, Action(..), optionHelpString) import Distribution.Simple.Utils (die, maybeExit, defaultPackageDesc) import Distribution.License (License(..)) import Distribution.Version (Version(..)) import System.Environment(getArgs) import Data.List ( intersperse ) import System.Cmd import System.Exit {- Basic assumptions ----------------- Obviously we assume that there is a configure script, and that after the ConfigCmd has been run, there is a Makefile. ConfigCmd: We assume the configure script accepts: --with-hc --with-hc-pkg --prefix --bindir --libdir --libexecdir --datadir BuildCmd: We assume the default Makefile target will build everything InstallCmd: We assume there is an install target Note that we assume that this does *not* register the package! CopyCmd: We assume there is a copy target, and a variable $(destdir) The 'copy' target should probably just invoke make install recursively, eg. copy : $(MAKE) install prefix=$(destdir)/$(prefix) \ bindir=$(destdir)/$(bindir) \ ... The reason we can't invoke make install directly here is that we don't know the value of $(prefix). SDistCmd: We assume there is an dist target RegisterCmd: We assume there is a register target and a variable $(user) UnregisterCmd: We assume there is an unregister target HaddockCmd: We assume there is a "docs" or "doc" target ProgramaticaCmd: We assume there is a "programatica" target -} exec :: String -> IO ExitCode exec cmd = (putStrLn $ "-=-= Cabal executing: " ++ cmd ++ "=-=-") >> system cmd defaultMain :: IO () defaultMain = defaultPackageDesc >>= readPackageDescription >>= defaultMainNoRead defaultMainNoRead :: PackageDescription -> IO () defaultMainNoRead pkg_descr = do args <- getArgs (action, args) <- parseGlobalArgs defaultProgramConfiguration args case action of ConfigCmd flags -> do (flags, _, args) <- parseConfigureArgs defaultProgramConfiguration flags args [] retVal <- exec $ unwords $ "./configure" : configureArgs flags ++ args if (retVal == ExitSuccess) then putStrLn "Configure Succeeded." else putStrLn "Configure failed." exitWith retVal CopyCmd copydest0 -> do ((CopyFlags copydest _), _, args) <- parseCopyArgs (CopyFlags copydest0 0) args [] no_extra_flags args let cmd = case copydest of NoCopyDest -> "install" CopyTo path -> "copy destdir=" ++ path CopyPrefix path -> "install prefix=" ++ path -- CopyPrefix is backwards compat, DEPRECATED maybeExit $ system $ ("make " ++ cmd) InstallCmd -> do ((InstallFlags _ _), _, args) <- parseInstallArgs emptyInstallFlags args [] no_extra_flags args maybeExit $ system $ "make install" retVal <- exec "make register" if (retVal == ExitSuccess) then putStrLn "Install Succeeded." else putStrLn "Install failed." exitWith retVal HaddockCmd -> do (_, _, args) <- parseHaddockArgs emptyHaddockFlags args [] no_extra_flags args retVal <- exec "make docs" case retVal of ExitSuccess -> do putStrLn "Haddock Succeeded" exitWith ExitSuccess _ -> do retVal' <- exec "make doc" case retVal' of ExitSuccess -> do putStrLn "Haddock Succeeded" exitWith ExitSuccess _ -> do putStrLn "Haddock Failed." exitWith retVal' BuildCmd -> basicCommand "Build" "make" (parseBuildArgs args []) CleanCmd -> basicCommand "Clean" "make clean" (parseCleanArgs args []) SDistCmd -> basicCommand "SDist" "make dist" (parseSDistArgs args []) RegisterCmd -> basicCommand "Register" "make register" (parseRegisterArgs emptyRegisterFlags args []) UnregisterCmd -> basicCommand "Unregister" "make unregister" (parseUnregisterArgs emptyRegisterFlags args []) ProgramaticaCmd -> basicCommand "Programatica" "make programatica" (parseProgramaticaArgs args []) HelpCmd -> exitWith ExitSuccess -- this is handled elsewhere -- |convinience function for repetitions above basicCommand :: String -- ^Command name -> String -- ^Command command -> (IO (b, [a], [String])) -- ^Command parser function -> IO () basicCommand commandName commandCommand commandParseFun = do (_, _, args) <- commandParseFun no_extra_flags args retVal <- exec commandCommand putStrLn $ commandName ++ if (retVal == ExitSuccess) then " Succeeded." else " Failed." exitWith retVal no_extra_flags :: [String] -> IO () no_extra_flags [] = return () no_extra_flags extra_flags = die $ "Unrecognised flags: " ++ concat (intersperse "," (extra_flags)) hugs98-plus-Sep2006/packages/Cabal/Distribution/InstalledPackageInfo.hs0000644006511100651110000002601210504340326024563 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.InstalledPackageInfo -- Copyright : (c) The University of Glasgow 2004 -- -- Maintainer : libraries@haskell.org -- Stability : alpha -- Portability : portable -- -- This is the information about an /installed/ package that -- is communicated to the @hc-pkg@ program in order to register -- a package. @ghc-pkg@ now consumes this package format (as of verison -- 6.4). This is specific to GHC at the moment. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the University nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} -- This module is meant to be local-only to Distribution... module Distribution.InstalledPackageInfo ( InstalledPackageInfo(..), ParseResult(..), emptyInstalledPackageInfo, parseInstalledPackageInfo, showInstalledPackageInfo, showInstalledPackageInfoField, ) where import Distribution.ParseUtils ( StanzaField(..), singleStanza, ParseResult(..), LineNo, simpleField, listField, parseLicenseQ, parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ, showFilePath, showToken, parseReadS, parseOptVersion, parseQuoted, showFreeText) import Distribution.License ( License(..) ) import Distribution.Compiler ( Opt ) import Distribution.Package ( PackageIdentifier(..), showPackageId, parsePackageId ) import Distribution.Version ( Version(..), showVersion ) import Distribution.Compat.ReadP as ReadP import Control.Monad ( foldM ) import Text.PrettyPrint -- ----------------------------------------------------------------------------- -- The InstalledPackageInfo type data InstalledPackageInfo = InstalledPackageInfo { -- these parts are exactly the same as PackageDescription package :: PackageIdentifier, license :: License, copyright :: String, maintainer :: String, author :: String, stability :: String, homepage :: String, pkgUrl :: String, description :: String, category :: String, -- these parts are required by an installed package only: exposed :: Bool, exposedModules :: [String], hiddenModules :: [String], importDirs :: [FilePath], -- contain sources in case of Hugs libraryDirs :: [FilePath], hsLibraries :: [String], extraLibraries :: [String], extraGHCiLibraries:: [String], -- overrides extraLibraries for GHCi includeDirs :: [FilePath], includes :: [String], depends :: [PackageIdentifier], hugsOptions :: [Opt], ccOptions :: [Opt], ldOptions :: [Opt], frameworkDirs :: [FilePath], frameworks :: [String], haddockInterfaces :: [FilePath], haddockHTMLs :: [FilePath] } deriving (Read, Show) emptyInstalledPackageInfo :: InstalledPackageInfo emptyInstalledPackageInfo = InstalledPackageInfo { package = PackageIdentifier "" noVersion, license = AllRightsReserved, copyright = "", maintainer = "", author = "", stability = "", homepage = "", pkgUrl = "", description = "", category = "", exposed = False, exposedModules = [], hiddenModules = [], importDirs = [], libraryDirs = [], hsLibraries = [], extraLibraries = [], extraGHCiLibraries= [], includeDirs = [], includes = [], depends = [], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = [], haddockHTMLs = [] } noVersion :: Version noVersion = Version{ versionBranch=[], versionTags=[] } -- ----------------------------------------------------------------------------- -- Parsing parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo parseInstalledPackageInfo inp = do stLines <- singleStanza inp -- not interested in stanzas, so just allow blank lines in -- the package info. foldM (parseBasicStanza fields) emptyInstalledPackageInfo stLines parseBasicStanza :: [StanzaField a] -> a -> (LineNo, String, String) -> ParseResult a parseBasicStanza ((StanzaField name _ set):fields) pkg (lineNo, f, val) | name == f = set lineNo val pkg | otherwise = parseBasicStanza fields pkg (lineNo, f, val) parseBasicStanza [] pkg (_, _, _) = return pkg -- ----------------------------------------------------------------------------- -- Pretty-printing showInstalledPackageInfo :: InstalledPackageInfo -> String showInstalledPackageInfo pkg = render (ppFields fields) where ppFields [] = empty ppFields ((StanzaField name get' _):flds) = pprField name (get' pkg) $$ ppFields flds showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) showInstalledPackageInfoField field = case [ (f,get') | (StanzaField f get' _) <- fields, f == field ] of [] -> Nothing ((f,get'):_) -> Just (render . pprField f . get') pprField name field = text name <> colon <+> field -- ----------------------------------------------------------------------------- -- Description of the fields, for parsing/printing fields :: [StanzaField InstalledPackageInfo] fields = basicStanzaFields ++ installedStanzaFields basicStanzaFields :: [StanzaField InstalledPackageInfo] basicStanzaFields = [ simpleField "name" text parsePackageNameQ (pkgName . package) (\name pkg -> pkg{package=(package pkg){pkgName=name}}) , simpleField "version" (text . showVersion) parseOptVersion (pkgVersion . package) (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}}) , simpleField "license" (text . show) parseLicenseQ license (\l pkg -> pkg{license=l}) , simpleField "copyright" showFreeText (munch (const True)) copyright (\val pkg -> pkg{copyright=val}) , simpleField "maintainer" showFreeText (munch (const True)) maintainer (\val pkg -> pkg{maintainer=val}) , simpleField "stability" showFreeText (munch (const True)) stability (\val pkg -> pkg{stability=val}) , simpleField "homepage" showFreeText (munch (const True)) homepage (\val pkg -> pkg{homepage=val}) , simpleField "package-url" showFreeText (munch (const True)) pkgUrl (\val pkg -> pkg{pkgUrl=val}) , simpleField "description" showFreeText (munch (const True)) description (\val pkg -> pkg{description=val}) , simpleField "category" showFreeText (munch (const True)) category (\val pkg -> pkg{category=val}) , simpleField "author" showFreeText (munch (const True)) author (\val pkg -> pkg{author=val}) ] installedStanzaFields :: [StanzaField InstalledPackageInfo] installedStanzaFields = [ simpleField "exposed" (text.show) parseReadS exposed (\val pkg -> pkg{exposed=val}) , listField "exposed-modules" text parseModuleNameQ exposedModules (\xs pkg -> pkg{exposedModules=xs}) , listField "hidden-modules" text parseModuleNameQ hiddenModules (\xs pkg -> pkg{hiddenModules=xs}) , listField "import-dirs" showFilePath parseFilePathQ importDirs (\xs pkg -> pkg{importDirs=xs}) , listField "library-dirs" showFilePath parseFilePathQ libraryDirs (\xs pkg -> pkg{libraryDirs=xs}) , listField "hs-libraries" showFilePath parseTokenQ hsLibraries (\xs pkg -> pkg{hsLibraries=xs}) , listField "extra-libraries" showToken parseTokenQ extraLibraries (\xs pkg -> pkg{extraLibraries=xs}) , listField "extra-ghci-libraries" showToken parseTokenQ extraGHCiLibraries (\xs pkg -> pkg{extraGHCiLibraries=xs}) , listField "include-dirs" showFilePath parseFilePathQ includeDirs (\xs pkg -> pkg{includeDirs=xs}) , listField "includes" showFilePath parseFilePathQ includes (\xs pkg -> pkg{includes=xs}) , listField "depends" (text.showPackageId) parsePackageId' depends (\xs pkg -> pkg{depends=xs}) , listField "hugs-options" showToken parseTokenQ hugsOptions (\path pkg -> pkg{hugsOptions=path}) , listField "cc-options" showToken parseTokenQ ccOptions (\path pkg -> pkg{ccOptions=path}) , listField "ld-options" showToken parseTokenQ ldOptions (\path pkg -> pkg{ldOptions=path}) , listField "framework-dirs" showFilePath parseFilePathQ frameworkDirs (\xs pkg -> pkg{frameworkDirs=xs}) , listField "frameworks" showToken parseTokenQ frameworks (\xs pkg -> pkg{frameworks=xs}) , listField "haddock-interfaces" showFilePath parseFilePathQ haddockInterfaces (\xs pkg -> pkg{haddockInterfaces=xs}) , listField "haddock-html" showFilePath parseFilePathQ haddockHTMLs (\xs pkg -> pkg{haddockHTMLs=xs}) ] parsePackageId' = parseQuoted parsePackageId <++ parsePackageId hugs98-plus-Sep2006/packages/Cabal/Distribution/Package.hs0000644006511100651110000000566310504340326022120 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.Package -- Copyright : Isaac Jones 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Packages. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Package ( PackageIdentifier(..), showPackageId, parsePackageId, parsePackageName, ) where import Distribution.Version import Distribution.Compat.ReadP as ReadP import Data.Char ( isDigit, isAlphaNum ) import Data.List ( intersperse ) data PackageIdentifier = PackageIdentifier { pkgName :: String, pkgVersion :: Version } deriving (Read, Show, Eq, Ord) showPackageId :: PackageIdentifier -> String showPackageId (PackageIdentifier n (Version [] _)) = n -- if no version, don't show version. showPackageId pkgid = pkgName pkgid ++ '-': showVersion (pkgVersion pkgid) parsePackageName :: ReadP r String parsePackageName = do ns <- sepBy1 component (char '-') return (concat (intersperse "-" ns)) where component = do cs <- munch1 isAlphaNum if all isDigit cs then pfail else return cs -- each component must contain an alphabetic character, to avoid -- ambiguity in identifiers like foo-1 (the 1 is the version number). parsePackageId :: ReadP r PackageIdentifier parsePackageId = do n <- parsePackageName v <- (ReadP.char '-' >> parseVersion) <++ return (Version [] []) return PackageIdentifier{pkgName=n,pkgVersion=v} hugs98-plus-Sep2006/packages/Cabal/Distribution/ParseUtils.hs0000644006511100651110000002750610504340326022660 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.ParseUtils -- Copyright : (c) The University of Glasgow 2004 -- -- Maintainer : libraries@haskell.org -- Stability : alpha -- Portability : portable -- -- Utilities for parsing PackageDescription and InstalledPackageInfo. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the University nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} -- This module is meant to be local-only to Distribution... -- #hide module Distribution.ParseUtils ( LineNo, PError(..), PWarning, locatedErrorMsg, showError, syntaxError, warning, runP, ParseResult(..), StanzaField(..), splitStanzas, Stanza, singleStanza, parseFilePathQ, parseTokenQ, parseModuleNameQ, parseDependency, parseOptVersion, parsePackageNameQ, parseVersionRangeQ, parseTestedWithQ, parseLicenseQ, parseExtensionQ, parseCommaList, parseOptCommaList, showFilePath, showToken, showTestedWith, showDependency, showFreeText, simpleField, listField, commaListField, optsField, parseReadS, parseQuoted, ) where import Text.PrettyPrint.HughesPJ import Distribution.Compiler (CompilerFlavor) import Distribution.License import Distribution.Version import Distribution.Package ( parsePackageName ) import Distribution.Compat.ReadP as ReadP hiding (get) import Distribution.Compat.FilePath (platformPath) import Control.Monad (liftM) import Data.Char import Language.Haskell.Extension (Extension) -- ----------------------------------------------------------------------------- type LineNo = Int data PError = AmbigousParse String LineNo | NoParse String LineNo | FromString String (Maybe LineNo) deriving Show type PWarning = String data ParseResult a = ParseFailed PError | ParseOk [PWarning] a deriving Show instance Monad ParseResult where return x = ParseOk [] x ParseFailed err >>= _ = ParseFailed err ParseOk ws x >>= f = case f x of ParseFailed err -> ParseFailed err ParseOk ws' x' -> ParseOk (ws'++ws) x' fail s = ParseFailed (FromString s Nothing) runP :: LineNo -> String -> ReadP a a -> String -> ParseResult a runP lineNo field p s = case [ x | (x,"") <- results ] of [a] -> ParseOk [] a [] -> case [ x | (x,ys) <- results, all isSpace ys ] of [a] -> ParseOk [] a [] -> ParseFailed (NoParse field lineNo) _ -> ParseFailed (AmbigousParse field lineNo) _ -> ParseFailed (AmbigousParse field lineNo) where results = readP_to_S p s -- TODO: deprecated showError :: PError -> String showError e = case locatedErrorMsg e of (Just n, s) -> "Line "++show n++": " ++ s (Nothing, s) -> s locatedErrorMsg :: PError -> (Maybe LineNo, String) locatedErrorMsg (AmbigousParse f n) = (Just n, "Ambigous parse in field '"++f++"'") locatedErrorMsg (NoParse f n) = (Just n, "Parse of field '"++f++"' failed: ") locatedErrorMsg (FromString s n) = (n, s) syntaxError :: LineNo -> String -> ParseResult a syntaxError n s = ParseFailed $ FromString s (Just n) warning :: String -> ParseResult () warning s = ParseOk [s] () data StanzaField a = StanzaField { fieldName :: String , fieldGet :: a -> Doc , fieldSet :: LineNo -> String -> a -> ParseResult a } simpleField :: String -> (a -> Doc) -> (ReadP a a) -> (b -> a) -> (a -> b -> b) -> StanzaField b simpleField name showF readF get set = StanzaField name (\st -> showF (get st)) (\lineNo val st -> do x <- runP lineNo name readF val return (set x st)) commaListField :: String -> (a -> Doc) -> (ReadP [a] a) -> (b -> [a]) -> ([a] -> b -> b) -> StanzaField b commaListField name showF readF get set = StanzaField name (\st -> fsep (punctuate comma (map showF (get st)))) (\lineNo val st -> do xs <- runP lineNo name (parseCommaList readF) val return (set xs st)) listField :: String -> (a -> Doc) -> (ReadP [a] a) -> (b -> [a]) -> ([a] -> b -> b) -> StanzaField b listField name showF readF get set = StanzaField name (\st -> fsep (map showF (get st))) (\lineNo val st -> do xs <- runP lineNo name (parseOptCommaList readF) val return (set xs st)) optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> StanzaField b optsField name flavor get set = StanzaField name (\st -> case lookup flavor (get st) of Just args -> hsep (map text args) Nothing -> empty) (\_ val st -> let old_val = get st old_args = case lookup flavor old_val of Just args -> args Nothing -> [] val' = filter (\(f,_) -> f/=flavor) old_val in return (set ((flavor,words val++old_args) : val') st)) type Stanza = [(LineNo,String,String)] -- |Split a string into blank line-separated stanzas of -- "Field: value" groups splitStanzas :: String -> ParseResult [Stanza] splitStanzas = mapM mkStanza . map merge . groupStanzas . filter validLine . zip [1..] . lines where validLine (_,s) = case dropWhile isSpace s of '-':'-':_ -> False -- Comment _ -> True groupStanzas :: [(Int,String)] -> [[(Int,String)]] groupStanzas [] = [] groupStanzas xs = let (ys,zs) = break allSpaces xs in ys : groupStanzas (dropWhile allSpaces zs) allSpaces :: (a, String) -> Bool allSpaces (_,xs) = all isSpace xs -- |Split a file into "Field: value" groups, but blank lines have no -- significance, unlike 'splitStanzas'. A field value may span over blank -- lines. singleStanza :: String -> ParseResult Stanza singleStanza = mkStanza . merge . filter validLine . zip [1..] . lines where validLine (_,s) = case dropWhile isSpace s of '-':'-':_ -> False -- Comment [] -> False -- blank line _ -> True merge :: [(a, [Char])] -> [(a, [Char])] merge ((n,x):(_,c:s):ys) | c == ' ' || c == '\t' = case dropWhile isSpace s of ('.':s') -> merge ((n,x++"\n"++s'):ys) s' -> merge ((n,x++"\n"++s'):ys) merge ((n,x):ys) = (n,x) : merge ys merge [] = [] mkStanza :: [(Int,String)] -> ParseResult Stanza mkStanza [] = return [] mkStanza ((n,xs):ys) = case break (==':') xs of (fld', ':':val) -> do let fld'' = map toLower fld' fld <- case () of _ | fld'' == "hs-source-dir" -> do warning "The field \"hs-source-dir\" is deprecated, please use hs-source-dirs." return "hs-source-dirs" | fld'' == "other-files" -> do warning "The field \"other-files\" is deprecated, please use extra-source-files." return "extra-source-files" | otherwise -> return fld'' ss <- mkStanza ys checkDuplField fld ss return ((n, fld, dropWhile isSpace val):ss) (_, _) -> syntaxError n "Invalid syntax (no colon after field name)" where checkDuplField _ [] = return () checkDuplField fld ((n',fld',_):xs') | fld' == fld = syntaxError (max n n') $ "The field "++fld++" was already defined on line " ++ show (min n n') | otherwise = checkDuplField fld xs' -- |parse a module name parseModuleNameQ :: ReadP r String parseModuleNameQ = parseQuoted modu <++ modu where modu = do c <- satisfy isUpper cs <- munch (\x -> isAlphaNum x || x `elem` "_'.") return (c:cs) parseFilePathQ :: ReadP r FilePath parseFilePathQ = liftM platformPath parseTokenQ parseReadS :: Read a => ReadP r a parseReadS = readS_to_P reads parseDependency :: ReadP r Dependency parseDependency = do name <- parsePackageNameQ skipSpaces ver <- parseVersionRangeQ <++ return AnyVersion skipSpaces return $ Dependency name ver parsePackageNameQ :: ReadP r String parsePackageNameQ = parseQuoted parsePackageName <++ parsePackageName parseVersionRangeQ :: ReadP r VersionRange parseVersionRangeQ = parseQuoted parseVersionRange <++ parseVersionRange parseOptVersion :: ReadP r Version parseOptVersion = parseQuoted ver <++ ver where ver = parseVersion <++ return noVersion noVersion = Version{ versionBranch=[], versionTags=[] } parseTestedWithQ :: ReadP r (CompilerFlavor,VersionRange) parseTestedWithQ = parseQuoted tw <++ tw where tw = do compiler <- parseReadS skipSpaces version <- parseVersionRange <++ return AnyVersion skipSpaces return (compiler,version) parseLicenseQ :: ReadP r License parseLicenseQ = parseQuoted parseReadS <++ parseReadS -- urgh, we can't define optQuotes :: ReadP r a -> ReadP r a -- because the "compat" version of ReadP isn't quite powerful enough. In -- particular, the type of <++ is ReadP r r -> ReadP r a -> ReadP r a -- Hence the trick above to make 'lic' polymorphic. parseExtensionQ :: ReadP r Extension parseExtensionQ = parseQuoted parseReadS <++ parseReadS parseTokenQ :: ReadP r String parseTokenQ = parseReadS <++ munch1 (\x -> not (isSpace x) && x /= ',') parseCommaList :: ReadP r a -- ^The parser for the stuff between commas -> ReadP r [a] parseCommaList p = sepBy p separator where separator = skipSpaces >> ReadP.char ',' >> skipSpaces parseOptCommaList :: ReadP r a -- ^The parser for the stuff between commas -> ReadP r [a] parseOptCommaList p = sepBy p separator where separator = skipSpaces >> optional (ReadP.char ',') >> skipSpaces parseQuoted :: ReadP r a -> ReadP r a parseQuoted p = between (ReadP.char '"') (ReadP.char '"') p -- -------------------------------------------- -- ** Pretty printing showFilePath :: FilePath -> Doc showFilePath = showToken showToken :: String -> Doc showToken str | not (any dodgy str) && not (null str) = text str | otherwise = text (show str) where dodgy c = isSpace c || c == ',' showTestedWith :: (CompilerFlavor,VersionRange) -> Doc showTestedWith (compiler,version) = text (show compiler ++ " " ++ showVersionRange version) showDependency :: Dependency -> Doc showDependency (Dependency name ver) = text name <+> text (showVersionRange ver) -- | Pretty-print free-format text, ensuring that it is vertically aligned, -- and with blank lines replaced by dots for correct re-parsing. showFreeText :: String -> Doc showFreeText s = vcat [text (if null l then "." else l) | l <- lines s] hugs98-plus-Sep2006/packages/Cabal/Distribution/PackageDescription.hs0000644006511100651110000011727710504340326024331 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.PackageDescription -- Copyright : Isaac Jones 2003-2005 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Package description and parsing. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.PackageDescription ( -- * Package descriptions PackageDescription(..), emptyPackageDescription, readPackageDescription, parseDescription, StanzaField(..), LineNo, basicStanzaFields, writePackageDescription, showPackageDescription, sanityCheckPackage, errorOut, setupMessage, Library(..), withLib, hasLibs, libModules, Executable(..), withExe, exeModules, -- * Build information BuildInfo(..), emptyBuildInfo, -- ** Supplementary build information HookedBuildInfo, emptyHookedBuildInfo, readHookedBuildInfo, parseHookedBuildInfo, writeHookedBuildInfo, showHookedBuildInfo, updatePackageDescription, -- * Utilities ParseResult(..), PError, PWarning, showError, hcOptions, autogenModuleName, haddockName, #ifdef DEBUG hunitTests, test #endif ) where import Control.Monad(liftM, foldM, when) import Data.Char import Data.Maybe(fromMaybe, isNothing, catMaybes) import Data.List (nub,lookup) import Text.PrettyPrint.HughesPJ import System.Directory(doesFileExist) import System.Environment(getProgName) import System.IO(hPutStrLn, stderr) import System.Exit import Distribution.ParseUtils import Distribution.Package(PackageIdentifier(..),showPackageId, parsePackageName) import Distribution.Version(Version(..), VersionRange(..), withinRange, showVersion, parseVersion, showVersionRange, parseVersionRange) import Distribution.License(License(..)) import Distribution.Version(Dependency(..)) import Distribution.Compiler(CompilerFlavor(..)) import Distribution.Simple.Utils(currentDir, die, dieWithLocation, warn) import Language.Haskell.Extension(Extension(..)) import Distribution.Compat.ReadP as ReadP hiding (get) import Distribution.Compat.FilePath(joinFileExt) #ifdef DEBUG import HUnit (Test(..), assertBool, Assertion, runTestTT, Counts, assertEqual) import Distribution.ParseUtils (runP) #endif -- |Fix. Figure out a way to get this from .cabal file cabalVersion :: Version cabalVersion = Version [1,1,4] [] -- | This data type is the internal representation of the file @pkg.cabal@. -- It contains two kinds of information about the package: information -- which is needed for all packages, such as the package name and version, and -- information which is needed for the simple build system only, such as -- the compiler options and library name. -- data PackageDescription = PackageDescription { -- the following are required by all packages: package :: PackageIdentifier, license :: License, licenseFile :: FilePath, copyright :: String, maintainer :: String, author :: String, stability :: String, testedWith :: [(CompilerFlavor,VersionRange)], homepage :: String, pkgUrl :: String, synopsis :: String, -- ^A one-line summary of this package description :: String, -- ^A more verbose description of this package category :: String, buildDepends :: [Dependency], descCabalVersion :: VersionRange, -- ^If this package depends on a specific version of Cabal, give that here. -- components library :: Maybe Library, executables :: [Executable], dataFiles :: [FilePath], extraSrcFiles :: [FilePath], extraTmpFiles :: [FilePath] } deriving (Show, Read, Eq) data Library = Library { exposedModules :: [String], libBuildInfo :: BuildInfo } deriving (Show, Eq, Read) emptyLibrary :: Library emptyLibrary = Library [] emptyBuildInfo emptyPackageDescription :: PackageDescription emptyPackageDescription = PackageDescription {package = PackageIdentifier "" (Version [] []), license = AllRightsReserved, licenseFile = "", descCabalVersion = AnyVersion, copyright = "", maintainer = "", author = "", stability = "", testedWith = [], buildDepends = [], homepage = "", pkgUrl = "", synopsis = "", description = "", category = "", library = Nothing, executables = [], dataFiles = [], extraSrcFiles = [], extraTmpFiles = [] } -- |Get all the module names from the libraries in this package libModules :: PackageDescription -> [String] libModules PackageDescription{library=lib} = maybe [] exposedModules lib ++ maybe [] (otherModules . libBuildInfo) lib -- |Get all the module names from the exes in this package exeModules :: PackageDescription -> [String] exeModules PackageDescription{executables=execs} = concatMap (otherModules . buildInfo) execs -- |does this package have any libraries? hasLibs :: PackageDescription -> Bool hasLibs p = maybe False (buildable . libBuildInfo) (library p) -- |'Maybe' version of 'hasLibs' maybeHasLibs :: PackageDescription -> Maybe Library maybeHasLibs p = library p >>= (\lib -> toMaybe (buildable (libBuildInfo lib)) lib) -- Consider refactoring into executable and library versions. data BuildInfo = BuildInfo { buildable :: Bool, -- ^ component is buildable here ccOptions :: [String], -- ^ options for C compiler ldOptions :: [String], -- ^ options for linker frameworks :: [String], -- ^support frameworks for Mac OS X cSources :: [FilePath], hsSourceDirs :: [FilePath], -- ^ where to look for the haskell module hierarchy otherModules :: [String], -- ^ non-exposed or non-main modules extensions :: [Extension], extraLibs :: [String], -- ^ what libraries to link with when compiling a program that uses your package extraLibDirs :: [String], includeDirs :: [FilePath], -- ^directories to find .h files includes :: [FilePath], -- ^ The .h files to be found in includeDirs installIncludes :: [FilePath], -- ^ .h files to install with the package options :: [(CompilerFlavor,[String])], ghcProfOptions :: [String] } deriving (Show,Read,Eq) emptyBuildInfo :: BuildInfo emptyBuildInfo = BuildInfo { buildable = True, ccOptions = [], ldOptions = [], frameworks = [], cSources = [], hsSourceDirs = [currentDir], otherModules = [], extensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [] } data Executable = Executable { exeName :: String, modulePath :: FilePath, buildInfo :: BuildInfo } deriving (Show, Read, Eq) emptyExecutable :: Executable emptyExecutable = Executable { exeName = "", modulePath = "", buildInfo = emptyBuildInfo } -- | Perform the action on each buildable 'Executable' in the package -- description. withExe :: PackageDescription -> (Executable -> IO a) -> IO () withExe pkg_descr f = sequence_ [f exe | exe <- executables pkg_descr, buildable (buildInfo exe)] type HookedBuildInfo = (Maybe BuildInfo, [(String, BuildInfo)]) emptyHookedBuildInfo :: HookedBuildInfo emptyHookedBuildInfo = (Nothing, []) -- ------------------------------------------------------------ -- * Utils -- ------------------------------------------------------------ -- |If the package description has a library section, call the given -- function with the library build info as argument. withLib :: PackageDescription -> a -> (Library -> IO a) -> IO a withLib pkg_descr a f = maybe (return a) f (maybeHasLibs pkg_descr) setupMessage :: String -> PackageDescription -> IO () setupMessage msg pkg_descr = putStrLn (msg ++ ' ':showPackageId (package pkg_descr) ++ "...") -- |Update the given package description with the output from the -- pre-hooks. updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription updatePackageDescription (mb_lib_bi, exe_bi) p = p{ executables = updateExecutables exe_bi (executables p) , library = updateLibrary mb_lib_bi (library p) } where updateLibrary :: Maybe BuildInfo -> Maybe Library -> Maybe Library updateLibrary (Just bi) (Just lib) = Just (lib{libBuildInfo = unionBuildInfo bi (libBuildInfo lib)}) updateLibrary Nothing mb_lib = mb_lib --the lib only exists in the buildinfo file. FIX: Is this --wrong? If there aren't any exposedModules, then the library --won't build anyway. add to sanity checker? updateLibrary (Just bi) Nothing = Just emptyLibrary{libBuildInfo=bi} updateExecutables :: [(String, BuildInfo)] -- ^[(exeName, new buildinfo)] -> [Executable] -- ^list of executables to update -> [Executable] -- ^list with exeNames updated updateExecutables exe_bi' executables' = foldr updateExecutable executables' exe_bi' updateExecutable :: (String, BuildInfo) -- ^(exeName, new buildinfo) -> [Executable] -- ^list of executables to update -> [Executable] -- ^libst with exeName updated updateExecutable _ [] = [] updateExecutable exe_bi'@(name,bi) (exe:exes) | exeName exe == name = exe{buildInfo = unionBuildInfo bi (buildInfo exe)} : exes | otherwise = exe : updateExecutable exe_bi' exes unionBuildInfo :: BuildInfo -> BuildInfo -> BuildInfo unionBuildInfo b1 b2 = b1{buildable = buildable b1 && buildable b2, ccOptions = combine ccOptions, ldOptions = combine ldOptions, frameworks = combine frameworks, cSources = combine cSources, hsSourceDirs = combine hsSourceDirs, otherModules = combine otherModules, extensions = combine extensions, extraLibs = combine extraLibs, extraLibDirs = combine extraLibDirs, includeDirs = combine includeDirs, includes = combine includes, installIncludes = combine installIncludes, options = combine options } where combine :: (Eq a) => (BuildInfo -> [a]) -> [a] combine f = nub $ f b1 ++ f b2 -- |Select options for a particular Haskell compiler. hcOptions :: CompilerFlavor -> [(CompilerFlavor, [String])] -> [String] hcOptions hc hc_opts = [opt | (hc',opts) <- hc_opts, hc' == hc, opt <- opts] -- |The name of the auto-generated module associated with a package autogenModuleName :: PackageDescription -> String autogenModuleName pkg_descr = "Paths_" ++ map fixchar (pkgName (package pkg_descr)) where fixchar '-' = '_' fixchar c = c haddockName :: PackageDescription -> FilePath haddockName pkg_descr = joinFileExt (pkgName (package pkg_descr)) "haddock" -- ------------------------------------------------------------ -- * Parsing & Pretty printing -- ------------------------------------------------------------ -- the strings for the required fields are necessary here, and so we -- don't repeat ourselves, I name them: reqNameName = "name" reqNameVersion = "version" reqNameCopyright = "copyright" reqNameMaintainer = "maintainer" reqNameSynopsis = "synopsis" basicStanzaFields :: [StanzaField PackageDescription] basicStanzaFields = [ simpleField reqNameName text parsePackageName (pkgName . package) (\name pkg -> pkg{package=(package pkg){pkgName=name}}) , simpleField reqNameVersion (text . showVersion) parseVersion (pkgVersion . package) (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}}) , simpleField "cabal-version" (text . showVersionRange) parseVersionRange descCabalVersion (\v pkg -> pkg{descCabalVersion=v}) , simpleField "license" (text . show) parseLicenseQ license (\l pkg -> pkg{license=l}) , simpleField "license-file" showFilePath parseFilePathQ licenseFile (\l pkg -> pkg{licenseFile=l}) , simpleField reqNameCopyright showFreeText (munch (const True)) copyright (\val pkg -> pkg{copyright=val}) , simpleField reqNameMaintainer showFreeText (munch (const True)) maintainer (\val pkg -> pkg{maintainer=val}) , commaListField "build-depends" showDependency parseDependency buildDepends (\xs pkg -> pkg{buildDepends=xs}) , simpleField "stability" showFreeText (munch (const True)) stability (\val pkg -> pkg{stability=val}) , simpleField "homepage" showFreeText (munch (const True)) homepage (\val pkg -> pkg{homepage=val}) , simpleField "package-url" showFreeText (munch (const True)) pkgUrl (\val pkg -> pkg{pkgUrl=val}) , simpleField reqNameSynopsis showFreeText (munch (const True)) synopsis (\val pkg -> pkg{synopsis=val}) , simpleField "description" showFreeText (munch (const True)) description (\val pkg -> pkg{description=val}) , simpleField "category" showFreeText (munch (const True)) category (\val pkg -> pkg{category=val}) , simpleField "author" showFreeText (munch (const True)) author (\val pkg -> pkg{author=val}) , listField "tested-with" showTestedWith parseTestedWithQ testedWith (\val pkg -> pkg{testedWith=val}) , listField "data-files" showFilePath parseFilePathQ dataFiles (\val pkg -> pkg{dataFiles=val}) , listField "extra-source-files" showFilePath parseFilePathQ extraSrcFiles (\val pkg -> pkg{extraSrcFiles=val}) , listField "extra-tmp-files" showFilePath parseFilePathQ extraTmpFiles (\val pkg -> pkg{extraTmpFiles=val}) ] executableStanzaFields :: [StanzaField Executable] executableStanzaFields = [ simpleField "executable" showFreeText (munch (const True)) exeName (\xs exe -> exe{exeName=xs}) , simpleField "main-is" showFilePath parseFilePathQ modulePath (\xs exe -> exe{modulePath=xs}) ] binfoFields :: [StanzaField BuildInfo] binfoFields = [ simpleField "buildable" (text . show) parseReadS buildable (\val binfo -> binfo{buildable=val}) , listField "cc-options" showToken parseTokenQ ccOptions (\val binfo -> binfo{ccOptions=val}) , listField "ld-options" showToken parseTokenQ ldOptions (\val binfo -> binfo{ldOptions=val}) , listField "frameworks" showToken parseTokenQ frameworks (\val binfo -> binfo{frameworks=val}) , listField "c-sources" showFilePath parseFilePathQ cSources (\paths binfo -> binfo{cSources=paths}) , listField "extensions" (text . show) parseExtensionQ extensions (\exts binfo -> binfo{extensions=exts}) , listField "extra-libraries" showToken parseTokenQ extraLibs (\xs binfo -> binfo{extraLibs=xs}) , listField "extra-lib-dirs" showFilePath parseFilePathQ extraLibDirs (\xs binfo -> binfo{extraLibDirs=xs}) , listField "includes" showFilePath parseFilePathQ includes (\paths binfo -> binfo{includes=paths}) , listField "install-includes" showFilePath parseFilePathQ includes (\paths binfo -> binfo{installIncludes=paths}) , listField "include-dirs" showFilePath parseFilePathQ includeDirs (\paths binfo -> binfo{includeDirs=paths}) , listField "hs-source-dirs" showFilePath parseFilePathQ hsSourceDirs (\paths binfo -> binfo{hsSourceDirs=paths}) , listField "other-modules" text parseModuleNameQ otherModules (\val binfo -> binfo{otherModules=val}) , listField "ghc-prof-options" text parseTokenQ ghcProfOptions (\val binfo -> binfo{ghcProfOptions=val}) , optsField "ghc-options" GHC options (\path binfo -> binfo{options=path}) , optsField "hugs-options" Hugs options (\path binfo -> binfo{options=path}) , optsField "nhc-options" NHC options (\path binfo -> binfo{options=path}) , optsField "jhc-options" JHC options (\path binfo -> binfo{options=path}) ] -- -------------------------------------------- -- ** Parsing -- | Given a parser and a filename, return the parse of the file, -- after checking if the file exists. readAndParseFile :: (String -> ParseResult a) -> FilePath -> IO a readAndParseFile parser fpath = do exists <- doesFileExist fpath when (not exists) (die $ "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue.") str <- readFile fpath case parser str of ParseFailed e -> do let (lineNo, message) = locatedErrorMsg e dieWithLocation fpath lineNo message ParseOk ws x -> do mapM_ warn ws return x -- |Parse the given package file. readPackageDescription :: FilePath -> IO PackageDescription readPackageDescription = readAndParseFile parseDescription readHookedBuildInfo :: FilePath -> IO HookedBuildInfo readHookedBuildInfo = readAndParseFile parseHookedBuildInfo parseDescription :: String -> ParseResult PackageDescription parseDescription inp = do (st:sts) <- splitStanzas inp pkg <- foldM (parseBasicStanza basicStanzaFields) emptyPackageDescription st exes <- mapM parseExecutableStanza sts return pkg{executables=exes} where -- The basic stanza, with library building info parseBasicStanza ((StanzaField name _ set):fields) pkg (lineNo, f, val) | name == f = set lineNo val pkg | otherwise = parseBasicStanza fields pkg (lineNo, f, val) {- , listField "exposed-modules" text parseModuleNameQ (\p -> maybe [] exposedModules (library p)) (\xs pkg -> let lib = fromMaybe emptyLibrary (library pkg) in pkg{library = Just lib{exposedModules=xs}}) -} parseBasicStanza [] pkg (lineNo, f, val) | "exposed-modules" == f = do mods <- runP lineNo f (parseOptCommaList parseModuleNameQ) val return pkg{library=Just lib{exposedModules=mods}} | otherwise = do bi <- parseBInfoField binfoFields (libBuildInfo lib) (lineNo, f, val) return pkg{library=Just lib{libBuildInfo=bi}} where lib = fromMaybe emptyLibrary (library pkg) parseExecutableStanza st@((lineNo, "executable",eName):_) = case lookupField "main-is" st of Just (_,_) -> foldM (parseExecutableField executableStanzaFields) emptyExecutable st Nothing -> syntaxError lineNo $ "No 'Main-Is' field found for " ++ eName ++ " stanza" parseExecutableStanza ((lineNo, f,_):_) = syntaxError lineNo $ "'Executable' stanza starting with field '" ++ f ++ "'" parseExecutableStanza _ = error "This shouldn't happen!" parseExecutableField ((StanzaField name _ set):fields) exe (lineNo, f, val) | name == f = set lineNo val exe | otherwise = parseExecutableField fields exe (lineNo, f, val) parseExecutableField [] exe (lineNo, f, val) = do binfo <- parseBInfoField binfoFields (buildInfo exe) (lineNo, f, val) return exe{buildInfo=binfo} -- ... lookupField :: String -> Stanza -> Maybe (LineNo,String) lookupField x sts = lookup x (map (\(n,f,v) -> (f,(n,v))) sts) parseHookedBuildInfo :: String -> ParseResult HookedBuildInfo parseHookedBuildInfo inp = do stanzas@(mLibStr:exes) <- splitStanzas inp mLib <- parseLib mLibStr biExes <- mapM parseExe (maybe stanzas (const exes) mLib) return (mLib, biExes) where parseLib :: Stanza -> ParseResult (Maybe BuildInfo) parseLib (bi@((_, inFieldName, _):_)) | map toLower inFieldName /= "executable" = liftM Just (parseBI bi) parseLib _ = return Nothing parseExe :: Stanza -> ParseResult (String, BuildInfo) parseExe ((lineNo, inFieldName, mName):bi) | map toLower inFieldName == "executable" = do bis <- parseBI bi return (mName, bis) | otherwise = syntaxError lineNo "expecting 'executable' at top of stanza" parseExe [] = syntaxError 0 "error in parsing buildinfo file. Expected executable stanza" parseBI :: Stanza -> ParseResult BuildInfo parseBI st = foldM (parseBInfoField binfoFields) emptyBuildInfo st parseBInfoField :: [StanzaField a] -> a -> (LineNo, String, String) -> ParseResult a parseBInfoField ((StanzaField name _ set):fields) binfo (lineNo, f, val) | name == f = set lineNo val binfo | otherwise = parseBInfoField fields binfo (lineNo, f, val) -- ignore "x-" extension fields without a warning parseBInfoField [] binfo (lineNo, 'x':'-':f, _) = return binfo parseBInfoField [] binfo (lineNo, f, _) = do warning $ "Unknown field '" ++ f ++ "'" return binfo -- -------------------------------------------- -- ** Pretty printing writePackageDescription :: FilePath -> PackageDescription -> IO () writePackageDescription fpath pkg = writeFile fpath (showPackageDescription pkg) showPackageDescription :: PackageDescription -> String showPackageDescription pkg = render $ ppFields pkg basicStanzaFields $$ (case library pkg of Nothing -> empty Just lib -> text "exposed-modules" <> colon <+> fsep (punctuate comma (map text (exposedModules lib))) $$ ppFields (libBuildInfo lib) binfoFields) $$ vcat (map ppExecutable (executables pkg)) where ppExecutable exe = space $$ ppFields exe executableStanzaFields $$ ppFields (buildInfo exe) binfoFields ppFields _ [] = empty ppFields pkg' ((StanzaField name get _):flds) = ppField name (get pkg') $$ ppFields pkg' flds ppField name field = text name <> colon <+> field writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO () writeHookedBuildInfo fpath pbi = writeFile fpath (showHookedBuildInfo pbi) showHookedBuildInfo :: HookedBuildInfo -> String showHookedBuildInfo (mb_lib_bi, ex_bi) = render $ (case mb_lib_bi of Nothing -> empty Just bi -> ppFields bi binfoFields) $$ vcat (map ppExeBuildInfo ex_bi) where ppExeBuildInfo (name, bi) = space $$ text "executable:" <+> text name $$ ppFields bi binfoFields ppFields _ [] = empty ppFields bi ((StanzaField name get _):flds) = ppField name (get bi) $$ ppFields bi flds -- ------------------------------------------------------------ -- * Sanity Checking -- ------------------------------------------------------------ -- |Sanity check this description file. -- FIX: add a sanity check for missing haskell files? That's why its -- in the IO monad. sanityCheckPackage :: PackageDescription -> IO ([String] -- Warnings ,[String])-- Errors sanityCheckPackage pkg_descr = let libSane = sanityCheckLib (library pkg_descr) nothingToDo = checkSanity (null (executables pkg_descr) && isNothing (library pkg_descr)) "No executables and no library found. Nothing to do." noModules = checkSanity (hasMods pkg_descr) "No exposed modules or executables in this package." allRights = checkSanity (license pkg_descr == AllRightsReserved) "Package is copyright All Rights Reserved" noLicenseFile = checkSanity (null $ licenseFile pkg_descr) "No license-file field." goodCabal = let v = (descCabalVersion pkg_descr) in checkSanity (not $ cabalVersion `withinRange` v) ("This package requires Cabal verion: " ++ (showVersionRange v) ++ ".") in return $ (catMaybes [nothingToDo, noModules, allRights, noLicenseFile] ,catMaybes $ libSane:goodCabal:(checkMissingFields pkg_descr)) -- |Output warnings and errors. Exit if any errors. errorOut :: [String] -- ^Warnings -> [String] -- ^errors -> IO () errorOut warnings errors = do mapM warn warnings when (not (null errors)) $ do pname <- getProgName mapM (hPutStrLn stderr . ((pname ++ ": Error: ") ++)) errors exitWith (ExitFailure 1) toMaybe :: Bool -> a -> Maybe a toMaybe b x = if b then Just x else Nothing checkMissingFields :: PackageDescription -> [Maybe String] checkMissingFields pkg_descr = [missingField (pkgName . package) reqNameName ,missingField (versionBranch .pkgVersion .package) reqNameVersion ] where missingField :: (PackageDescription -> [a]) -- Field accessor -> String -- Name of field -> Maybe String -- error message missingField f n = toMaybe (null (f pkg_descr)) ("Missing field: " ++ n) sanityCheckLib :: Maybe Library -> Maybe String sanityCheckLib ml = ml >>= (\l -> toMaybe (null $ exposedModules l) ("Non-empty library, but empty exposed modules list. " ++ "Cabal may not build this library correctly")) checkSanity :: Bool -> String -> Maybe String checkSanity = toMaybe hasMods :: PackageDescription -> Bool hasMods pkg_descr = null (executables pkg_descr) && maybe True (null . exposedModules) (library pkg_descr) -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ #ifdef DEBUG testPkgDesc :: String testPkgDesc = unlines [ "-- Required", "Name: Cabal", "Version: 0.1.1.1.1-rain", "License: LGPL", "License-File: foo", "Copyright: Free Text String", "Cabal-version: >1.1.1", "-- Optional - may be in source?", "Author: Happy Haskell Hacker", "Homepage: http://www.haskell.org/foo", "Package-url: http://www.haskell.org/foo", "Synopsis: a nice package!", "Description: a really nice package!", "Category: tools", "buildable: True", "CC-OPTIONS: -g -o", "LD-OPTIONS: -BStatic -dn", "Frameworks: foo", "Tested-with: GHC", "Stability: Free Text String", "Build-Depends: haskell-src, HUnit>=1.0.0-rain", "Other-Modules: Distribution.Package, Distribution.Version,", " Distribution.Simple.GHCPackageConfig", "Other-files: file1, file2", "Extra-Tmp-Files: file1, file2", "C-Sources: not/even/rain.c, such/small/hands", "HS-Source-Dirs: src, src2", "Exposed-Modules: Distribution.Void, Foo.Bar", "Extensions: OverlappingInstances, TypeSynonymInstances", "Extra-Libraries: libfoo, bar, bang", "Extra-Lib-Dirs: \"/usr/local/libs\"", "Include-Dirs: your/slightest, look/will", "Includes: /easily/unclose, /me, \"funky, path\\\\name\"", "Install-Includes: /easily/unclose, /me, \"funky, path\\\\name\"", "GHC-Options: -fTH -fglasgow-exts", "Hugs-Options: +TH", "Nhc-Options: ", "Jhc-Options: ", "", "-- Next is an executable", "Executable: somescript", "Main-is: SomeFile.hs", "Other-Modules: Foo1, Util, Main", "HS-Source-Dir: scripts", "Extensions: OverlappingInstances", "GHC-Options: ", "Hugs-Options: ", "Nhc-Options: ", "Jhc-Options: " ] testPkgDescAnswer :: PackageDescription testPkgDescAnswer = PackageDescription {package = PackageIdentifier {pkgName = "Cabal", pkgVersion = Version {versionBranch = [0,1,1,1,1], versionTags = ["rain"]}}, license = LGPL, licenseFile = "foo", copyright = "Free Text String", author = "Happy Haskell Hacker", homepage = "http://www.haskell.org/foo", pkgUrl = "http://www.haskell.org/foo", synopsis = "a nice package!", description = "a really nice package!", category = "tools", descCabalVersion=LaterVersion (Version [1,1,1] []), buildDepends = [Dependency "haskell-src" AnyVersion, Dependency "HUnit" (UnionVersionRanges (ThisVersion (Version [1,0,0] ["rain"])) (LaterVersion (Version [1,0,0] ["rain"])))], testedWith=[(GHC, AnyVersion)], maintainer = "", stability = "Free Text String", extraTmpFiles=["file1", "file2"], extraSrcFiles=["file1", "file2"], dataFiles=[], library = Just $ Library { exposedModules = ["Distribution.Void", "Foo.Bar"], libBuildInfo=BuildInfo { buildable = True, ccOptions = ["-g", "-o"], ldOptions = ["-BStatic", "-dn"], frameworks = ["foo"], cSources = ["not/even/rain.c", "such/small/hands"], hsSourceDirs = ["src", "src2"], otherModules = ["Distribution.Package", "Distribution.Version", "Distribution.Simple.GHCPackageConfig"], extensions = [OverlappingInstances, TypeSynonymInstances], extraLibs = ["libfoo", "bar", "bang"], extraLibDirs = ["/usr/local/libs"], includeDirs = ["your/slightest", "look/will"], includes = ["/easily/unclose", "/me", "funky, path\\name"], installIncludes = ["/easily/unclose", "/me", "funky, path\\name"], -- Note reversed order: ghcProfOptions = [], options = [(JHC,[]),(NHC, []), (Hugs,["+TH"]), (GHC,["-fTH","-fglasgow-exts"])]} }, executables = [Executable "somescript" "SomeFile.hs" ( emptyBuildInfo{ otherModules=["Foo1","Util","Main"], hsSourceDirs = ["scripts"], extensions = [OverlappingInstances], options = [(JHC,[]),(NHC,[]),(Hugs,[]),(GHC,[])] })] } hunitTests :: [Test] hunitTests = [ TestLabel "license parsers" $ TestCase $ sequence_ [assertParseOk ("license " ++ show lVal) lVal (runP 1 "license" parseLicenseQ (show lVal)) | lVal <- [GPL,LGPL,BSD3,BSD4]], TestLabel "Required fields" $ TestCase $ do assertParseOk "some fields" emptyPackageDescription{package=(PackageIdentifier "foo" (Version [0,0] ["asdf"]))} (parseDescription "Name: foo\nVersion: 0.0-asdf") assertParseOk "more fields foo" emptyPackageDescription{package=(PackageIdentifier "foo" (Version [0,0]["asdf"])), license=GPL} (parseDescription "Name: foo\nVersion:0.0-asdf\nLicense: GPL") assertParseOk "required fields for foo" emptyPackageDescription{package=(PackageIdentifier "foo" (Version [0,0]["asdf"])), license=GPL, copyright="2004 isaac jones"} (parseDescription "Name: foo\nVersion:0.0-asdf\nCopyright: 2004 isaac jones\nLicense: GPL"), TestCase $ assertParseOk "no library" Nothing (library `liftM` parseDescription "Name: foo\nVersion: 1\nLicense: GPL\nMaintainer: someone\n\nExecutable: script\nMain-is: SomeFile.hs\n"), TestLabel "Package description" $ TestCase $ assertParseOk "entire package description" testPkgDescAnswer (parseDescription testPkgDesc), TestLabel "Package description pretty" $ TestCase $ case parseDescription testPkgDesc of ParseFailed _ -> assertBool "can't parse description" False ParseOk _ d -> case parseDescription $ showPackageDescription d of ParseFailed _ -> assertBool "can't parse description after pretty print!" False ParseOk _ d' -> assertBool ("parse . show . parse not identity." ++" Incorrect fields:" ++ (show $ comparePackageDescriptions d d')) (d == d'), TestLabel "Sanity checker" $ TestCase $ do (warns, ers) <- sanityCheckPackage emptyPackageDescription assertEqual "Wrong number of errors" 2 (length ers) assertEqual "Wrong number of warnings" 4 (length warns) ] -- |Compare two package descriptions and see which fields aren't the same. comparePackageDescriptions :: PackageDescription -> PackageDescription -> [String] -- ^Errors comparePackageDescriptions p1 p2 = catMaybes $ myCmp package "package" : myCmp license "license": myCmp licenseFile "licenseFile": myCmp copyright "copyright": myCmp maintainer "maintainer": myCmp author "author": myCmp stability "stability": myCmp testedWith "testedWith": myCmp homepage "homepage": myCmp pkgUrl "pkgUrl": myCmp synopsis "synopsis": myCmp description "description": myCmp category "category": myCmp buildDepends "buildDepends": myCmp library "library": myCmp executables "executables": myCmp descCabalVersion "cabal-version":[] where myCmp :: (Eq a, Show a) => (PackageDescription -> a) -> String -- Error message -> Maybe String -- myCmp f er = let e1 = f p1 e2 = f p2 in toMaybe (e1 /= e2) (er ++ " Expected: " ++ show e1 ++ " Got: " ++ show e2) -- |Assert that the 2nd value parses correctly and matches the first value assertParseOk :: (Eq val) => String -> val -> ParseResult val -> Assertion assertParseOk mes expected actual = assertBool mes (case actual of ParseOk _ v -> v == expected _ -> False) test :: IO Counts test = runTestTT (TestList hunitTests) #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/0000755006511100651110000000000010504340326021450 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/Configure.hs0000644006511100651110000004477010504340326023741 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Configure -- Copyright : Isaac Jones 2003-2005 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Explanation: Perform the \"@.\/setup configure@\" action. -- Outputs the @.setup-config@ file. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.Configure (writePersistBuildConfig, getPersistBuildConfig, maybeGetPersistBuildConfig, configure, localBuildInfoFile, findProgram, getInstalledPackages, configDependency, configCompiler, configCompilerAux, #ifdef DEBUG hunitTests #endif ) where #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604 #if __GLASGOW_HASKELL__ < 603 #include "config.h" #else #include "ghcconfig.h" #endif #endif import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Register (removeInstalledConfig) import Distribution.Setup(ConfigFlags(..), CopyDest(..)) import Distribution.Compiler(CompilerFlavor(..), Compiler(..), compilerBinaryName, extensionsToFlags) import Distribution.Package (PackageIdentifier(..), showPackageId, parsePackageId) import Distribution.PackageDescription( PackageDescription(..), Library(..), BuildInfo(..), Executable(..), setupMessage ) import Distribution.Simple.Utils (die, warn, withTempFile,maybeExit) import Distribution.Version (Version(..), Dependency(..), VersionRange(ThisVersion), parseVersion, showVersion, withinRange, showVersionRange) import Data.List (intersperse, nub, maximumBy, isPrefixOf) import Data.Char (isSpace) import Data.Maybe(fromMaybe) import System.Directory import Distribution.Compat.FilePath (splitFileName, joinFileName, joinFileExt, exeExtension) import Distribution.Program(Program(..), ProgramLocation(..), lookupPrograms, updateProgram) import System.Cmd ( system ) import System.Exit ( ExitCode(..) ) import Control.Monad ( when, unless ) import Distribution.Compat.ReadP import Distribution.Compat.Directory (findExecutable) import Data.Char (isDigit) import Prelude hiding (catch) #ifdef mingw32_HOST_OS import Distribution.PackageDescription (hasLibs) #endif #ifdef DEBUG import HUnit #endif tryGetPersistBuildConfig :: IO (Either String LocalBuildInfo) tryGetPersistBuildConfig = do e <- doesFileExist localBuildInfoFile let dieMsg = "error reading " ++ localBuildInfoFile ++ "; run \"setup configure\" command?\n" if (not e) then return $ Left dieMsg else do str <- readFile localBuildInfoFile case reads str of [(bi,_)] -> return $ Right bi _ -> return $ Left dieMsg getPersistBuildConfig :: IO LocalBuildInfo getPersistBuildConfig = do lbi <- tryGetPersistBuildConfig either die return lbi maybeGetPersistBuildConfig :: IO (Maybe LocalBuildInfo) maybeGetPersistBuildConfig = do lbi <- tryGetPersistBuildConfig return $ either (const Nothing) Just lbi writePersistBuildConfig :: LocalBuildInfo -> IO () writePersistBuildConfig lbi = do writeFile localBuildInfoFile (show lbi) localBuildInfoFile :: FilePath localBuildInfoFile = "./.setup-config" -- ----------------------------------------------------------------------------- -- * Configuration -- ----------------------------------------------------------------------------- configure :: PackageDescription -> ConfigFlags -> IO LocalBuildInfo configure pkg_descr cfg = do setupMessage "Configuring" pkg_descr removeInstalledConfig let lib = library pkg_descr -- detect compiler comp@(Compiler f' ver p' pkg) <- configCompilerAux cfg -- installation directories defPrefix <- default_prefix defDataDir <- default_datadir pkg_descr let pref = fromMaybe defPrefix (configPrefix cfg) my_bindir = fromMaybe default_bindir (configBinDir cfg) my_libdir = fromMaybe (default_libdir comp) (configLibDir cfg) my_libsubdir = fromMaybe (default_libsubdir comp) (configLibSubDir cfg) my_libexecdir = fromMaybe default_libexecdir (configLibExecDir cfg) my_datadir = fromMaybe defDataDir (configDataDir cfg) my_datasubdir = fromMaybe default_datasubdir (configDataSubDir cfg) -- check extensions let extlist = nub $ maybe [] (extensions . libBuildInfo) lib ++ concat [ extensions exeBi | Executable _ _ exeBi <- executables pkg_descr ] let exts = fst $ extensionsToFlags f' extlist unless (null exts) $ warn $ -- Just warn, FIXME: Should this be an error? show f' ++ " does not support the following extensions:\n " ++ concat (intersperse ", " (map show exts)) foundPrograms <- lookupPrograms (configPrograms cfg) happy <- findProgram "happy" (configHappy cfg) alex <- findProgram "alex" (configAlex cfg) hsc2hs <- findProgram "hsc2hs" (configHsc2hs cfg) c2hs <- findProgram "c2hs" (configC2hs cfg) cpphs <- findProgram "cpphs" (configCpphs cfg) greencard <- findProgram "greencard" (configGreencard cfg) let newConfig = foldr (\(_, p) c -> updateProgram p c) (configPrograms cfg) foundPrograms -- FIXME: currently only GHC has hc-pkg dep_pkgs <- case f' of GHC | ver >= Version [6,3] [] -> do ipkgs <- getInstalledPackagesAux comp cfg mapM (configDependency ipkgs) (buildDepends pkg_descr) JHC -> do ipkgs <- getInstalledPackagesJHC comp cfg mapM (configDependency ipkgs) (buildDepends pkg_descr) _ -> do return $ map setDepByVersion (buildDepends pkg_descr) split_objs <- if not (configSplitObjs cfg) then return False else case f' of GHC | ver >= Version [6,5] [] -> return True _ -> do warn ("this compiler does not support " ++ "--enable-split-objs; ignoring") return False let lbi = LocalBuildInfo{prefix=pref, compiler=comp, buildDir="dist" `joinFileName` "build", bindir=my_bindir, libdir=my_libdir, libsubdir=my_libsubdir, libexecdir=my_libexecdir, datadir=my_datadir, datasubdir=my_datasubdir, packageDeps=dep_pkgs, withPrograms=newConfig, withHappy=happy, withAlex=alex, withHsc2hs=hsc2hs, withC2hs=c2hs, withCpphs=cpphs, withGreencard=greencard, withVanillaLib=configVanillaLib cfg, withProfLib=configProfLib cfg, withProfExe=configProfExe cfg, withGHCiLib=configGHCiLib cfg, splitObjs=split_objs, userConf=configUser cfg } -- FIXME: maybe this should only be printed when verbose? message $ "Using install prefix: " ++ pref messageDir pkg_descr lbi "Binaries" mkBinDir mkBinDirRel messageDir pkg_descr lbi "Libraries" mkLibDir mkLibDirRel messageDir pkg_descr lbi "Private binaries" mkLibexecDir mkLibexecDirRel messageDir pkg_descr lbi "Data files" mkDataDir mkDataDirRel message $ "Using compiler: " ++ p' message $ "Compiler flavor: " ++ (show f') message $ "Compiler version: " ++ showVersion ver message $ "Using package tool: " ++ pkg mapM (\(s,p) -> reportProgram' s p) foundPrograms reportProgram "happy" happy reportProgram "alex" alex reportProgram "hsc2hs" hsc2hs reportProgram "c2hs" c2hs reportProgram "cpphs" cpphs reportProgram "greencard" greencard return lbi messageDir :: PackageDescription -> LocalBuildInfo -> String -> (PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath) -> (PackageDescription -> LocalBuildInfo -> CopyDest -> Maybe FilePath) -> IO () messageDir pkg_descr lbi name mkDir mkDirRel = message (name ++ " installed in: " ++ mkDir pkg_descr lbi NoCopyDest ++ rel_note) where #if mingw32_HOST_OS rel_note | not (hasLibs pkg_descr) && mkDirRel pkg_descr lbi NoCopyDest == Nothing = " (fixed location)" | otherwise = "" #else rel_note = "" #endif -- |Converts build dependencies to a versioned dependency. only sets -- version information for exact versioned dependencies. setDepByVersion :: Dependency -> PackageIdentifier -- if they specify the exact version, use that: setDepByVersion (Dependency s (ThisVersion v)) = PackageIdentifier s v -- otherwise, just set it to empty setDepByVersion (Dependency s _) = PackageIdentifier s (Version [] []) -- |Return the explicit path if given, otherwise look for the program -- name in the path. findProgram :: String -- ^ program name -> Maybe FilePath -- ^ optional explicit path -> IO (Maybe FilePath) findProgram name Nothing = findExecutable name findProgram _ p = return p reportProgram :: String -> Maybe FilePath -> IO () reportProgram name Nothing = message ("No " ++ name ++ " found") reportProgram name (Just p) = message ("Using " ++ name ++ ": " ++ p) reportProgram' :: String -> Maybe Program -> IO () reportProgram' _ (Just Program{ programName=name , programLocation=EmptyLocation}) = message ("No " ++ name ++ " found") reportProgram' _ (Just Program{ programName=name , programLocation=FoundOnSystem p}) = message ("Using " ++ name ++ " found on system at: " ++ p) reportProgram' _ (Just Program{ programName=name , programLocation=UserSpecified p}) = message ("Using " ++ name ++ " given by user at: " ++ p) reportProgram' name Nothing = message ("No " ++ name ++ " found") -- | Test for a package dependency and record the version we have installed. configDependency :: [PackageIdentifier] -> Dependency -> IO PackageIdentifier configDependency ps (Dependency pkgname vrange) = do let ok p = pkgName p == pkgname && pkgVersion p `withinRange` vrange -- case filter ok ps of [] -> die ("cannot satisfy dependency " ++ pkgname ++ showVersionRange vrange) qs -> let pkg = maximumBy versions qs versions a b = pkgVersion a `compare` pkgVersion b in do message ("Dependency " ++ pkgname ++ showVersionRange vrange ++ ": using " ++ showPackageId pkg) return pkg getInstalledPackagesJHC :: Compiler -> ConfigFlags -> IO [PackageIdentifier] getInstalledPackagesJHC comp cfg = do let verbose = configVerbose cfg when (verbose > 0) $ message "Reading installed packages..." let cmd_line = "\"" ++ compilerPkgTool comp ++ "\" --list-libraries" str <- systemCaptureStdout verbose cmd_line case pCheck (readP_to_S (many (skipSpaces >> parsePackageId)) str) of [ps] -> return ps _ -> die "cannot parse package list" getInstalledPackagesAux :: Compiler -> ConfigFlags -> IO [PackageIdentifier] getInstalledPackagesAux comp cfg = getInstalledPackages comp (configUser cfg) (configVerbose cfg) getInstalledPackages :: Compiler -> Bool -> Int -> IO [PackageIdentifier] getInstalledPackages comp user verbose = do when (verbose > 0) $ message "Reading installed packages..." let user_flag = if user then "--user" else "--global" cmd_line = "\"" ++ compilerPkgTool comp ++ "\" " ++ user_flag ++ " list" str <- systemCaptureStdout verbose cmd_line let keep_line s = ':' `notElem` s && not ("Creating" `isPrefixOf` s) str1 = unlines (filter keep_line (lines str)) str2 = filter (`notElem` ",()") str1 -- case pCheck (readP_to_S (many (skipSpaces >> parsePackageId)) str2) of [ps] -> return ps _ -> die "cannot parse package list" systemCaptureStdout :: Int -> String -> IO String systemCaptureStdout verbose cmd = do withTempFile "." "" $ \tmp -> do let cmd_line = cmd ++ " >" ++ tmp when (verbose > 0) $ putStrLn cmd_line res <- system cmd_line case res of ExitFailure _ -> die ("executing external program failed: "++cmd_line) ExitSuccess -> do str <- readFile tmp let ev [] = ' '; ev xs = last xs ev str `seq` return str -- ----------------------------------------------------------------------------- -- Determining the compiler details configCompilerAux :: ConfigFlags -> IO Compiler configCompilerAux cfg = configCompiler (configHcFlavor cfg) (configHcPath cfg) (configHcPkg cfg) (configVerbose cfg) configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath -> Int -> IO Compiler configCompiler hcFlavor hcPath hcPkg verbose = do let flavor = case hcFlavor of Just f -> f Nothing -> error "Unknown compiler" comp <- case hcPath of Just path -> return path Nothing -> findCompiler verbose flavor ver <- configCompilerVersion flavor comp verbose pkgtool <- case hcPkg of Just path -> return path Nothing -> guessPkgToolFromHCPath verbose flavor comp return (Compiler{compilerFlavor=flavor, compilerVersion=ver, compilerPath=comp, compilerPkgTool=pkgtool}) findCompiler :: Int -> CompilerFlavor -> IO FilePath findCompiler verbose flavor = do let prog = compilerBinaryName flavor when (verbose > 0) $ message $ "searching for " ++ prog ++ " in path." res <- findExecutable prog case res of Nothing -> die ("Cannot find compiler for " ++ prog) Just path -> do when (verbose > 0) $ message ("found " ++ prog ++ " at "++ path) return path -- ToDo: check that compiler works? compilerPkgToolName :: CompilerFlavor -> String compilerPkgToolName GHC = "ghc-pkg" compilerPkgToolName NHC = "hmake" -- FIX: nhc98-pkg Does not yet exist compilerPkgToolName Hugs = "hugs" compilerPkgToolName JHC = "jhc" compilerPkgToolName cmp = error $ "Unsupported compiler: " ++ (show cmp) configCompilerVersion :: CompilerFlavor -> FilePath -> Int -> IO Version configCompilerVersion GHC compilerP verbose = do str <- systemGetStdout verbose ("\"" ++ compilerP ++ "\" --version") case pCheck (readP_to_S parseVersion (dropWhile (not.isDigit) str)) of [v] -> return v _ -> die ("cannot determine version of " ++ compilerP ++ ":\n "++ str) configCompilerVersion JHC compilerP verbose = do str <- systemGetStdout verbose ("\"" ++ compilerP ++ "\" --version") case words str of (_:ver:_) -> case pCheck $ readP_to_S parseVersion ver of [v] -> return v _ -> fail ("parsing version: "++ver++" failed.") _ -> fail ("reading version string: "++show str++" failed.") configCompilerVersion _ _ _ = return Version{ versionBranch=[],versionTags=[] } systemGetStdout :: Int -> String -> IO String systemGetStdout verbose cmd = do withTempFile "." "" $ \tmp -> do let cmd_line = cmd ++ " >" ++ tmp when (verbose > 0) $ putStrLn cmd_line maybeExit $ system cmd_line str <- readFile tmp let eval [] = ' '; eval xs = last xs eval str `seq` return str pCheck :: [(a, [Char])] -> [a] pCheck rs = [ r | (r,s) <- rs, all isSpace s ] guessPkgToolFromHCPath :: Int -> CompilerFlavor -> FilePath -> IO FilePath guessPkgToolFromHCPath verbose flavor path = do let pkgToolName = compilerPkgToolName flavor (dir,_) = splitFileName path pkgtool = dir `joinFileName` pkgToolName `joinFileExt` exeExtension when (verbose > 0) $ message $ "looking for package tool: " ++ pkgToolName ++ " near compiler in " ++ path exists <- doesFileExist pkgtool when (not exists) $ die ("Cannot find package tool: " ++ pkgtool) when (verbose > 0) $ message $ "found package tool in " ++ pkgtool return pkgtool message :: String -> IO () message s = putStrLn $ "configure: " ++ s -- ----------------------------------------------------------------------------- -- Tests #ifdef DEBUG hunitTests :: [Test] hunitTests = [] {- Too specific: packageID = PackageIdentifier "Foo" (Version [1] []) = [TestCase $ do let simonMarGHCLoc = "/usr/bin/ghc" simonMarGHC <- configure emptyPackageDescription {package=packageID} (Just GHC, Just simonMarGHCLoc, Nothing, Nothing) assertEqual "finding ghc, etc on simonMar's machine failed" (LocalBuildInfo "/usr" (Compiler GHC (Version [6,2,2] []) simonMarGHCLoc (simonMarGHCLoc ++ "-pkg")) [] []) simonMarGHC ] -} #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/Build.hs0000644006511100651110000002414510504340326023051 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Build -- Copyright : Isaac Jones 2003-2005 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- {- Copyright (c) 2003-2005, Isaac Jones All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.Build ( build #ifdef DEBUG ,hunitTests #endif ) where import Distribution.Compiler ( Compiler(..), CompilerFlavor(..) ) import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..), setupMessage, Executable(..), Library(..), autogenModuleName ) import Distribution.Package ( PackageIdentifier(..), showPackageId ) import Distribution.Setup (CopyDest(..), BuildFlags(..) ) import Distribution.PreProcess ( preprocessSources, PPSuffixHandler ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), mkBinDir, mkBinDirRel, mkLibDir, mkLibDirRel, mkDataDir,mkDataDirRel, mkLibexecDir, mkLibexecDirRel ) import Distribution.Simple.Configure ( localBuildInfoFile ) import Distribution.Simple.Utils( die ) import Distribution.Compat.Directory ( createDirectoryIfMissing ) import Distribution.Compat.FilePath ( joinFileName, pathSeparator ) import Data.Maybe ( maybeToList, fromJust ) import Control.Monad ( unless ) import System.Directory ( getModificationTime, doesFileExist) import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.JHC as JHC -- import qualified Distribution.Simple.NHC as NHC import qualified Distribution.Simple.Hugs as Hugs #ifdef mingw32_HOST_OS import Distribution.PackageDescription (hasLibs) #endif #ifdef DEBUG import HUnit (Test) #endif -- ----------------------------------------------------------------------------- -- Build the library build :: PackageDescription -> LocalBuildInfo -> BuildFlags -> [ PPSuffixHandler ] -> IO () build pkg_descr lbi (BuildFlags verbose) suffixes = do -- check that there's something to build let buildInfos = map libBuildInfo (maybeToList (library pkg_descr)) ++ map buildInfo (executables pkg_descr) unless (any buildable buildInfos) $ do let name = showPackageId (package pkg_descr) die ("Package " ++ name ++ " can't be built on this system.") createDirectoryIfMissing True (buildDir lbi) -- construct and write the Paths_.hs file createDirectoryIfMissing True (autogenModulesDir lbi) buildPathsModule pkg_descr lbi preprocessSources pkg_descr lbi verbose suffixes setupMessage "Building" pkg_descr case compilerFlavor (compiler lbi) of GHC -> GHC.build pkg_descr lbi verbose JHC -> JHC.build pkg_descr lbi verbose Hugs -> Hugs.build pkg_descr lbi verbose _ -> die ("Building is not supported with this compiler.") -- ------------------------------------------------------------ -- * Building Paths_.hs -- ------------------------------------------------------------ -- The directory in which we put auto-generated modules autogenModulesDir :: LocalBuildInfo -> String autogenModulesDir lbi = buildDir lbi `joinFileName` "autogen" buildPathsModule :: PackageDescription -> LocalBuildInfo -> IO () buildPathsModule pkg_descr lbi = let pragmas | absolute = "" | otherwise = "{-# OPTIONS_GHC -fffi #-}\n"++ "{-# LANGUAGE ForeignFunctionInterface #-}\n" foreign_imports | absolute = "" | otherwise = "import Foreign\n"++ "import Foreign.C\n"++ "import Data.Maybe\n" header = pragmas++ "module " ++ paths_modulename ++ " (\n"++ "\tversion,\n"++ "\tgetBinDir, getLibDir, getDataDir, getLibexecDir,\n"++ "\tgetDataFileName\n"++ "\t) where\n"++ "\n"++ foreign_imports++ "import Data.Version"++ "\n"++ "\nversion = " ++ show (pkgVersion (package pkg_descr))++ "\n" body | absolute = "\nbindir = " ++ show flat_bindir ++ "\nlibdir = " ++ show flat_libdir ++ "\ndatadir = " ++ show flat_datadir ++ "\nlibexecdir = " ++ show flat_libexecdir ++ "\n"++ "\ngetBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath\n"++ "getBinDir = return bindir\n"++ "getLibDir = return libdir\n"++ "getDataDir = return datadir\n"++ "getLibexecDir = return libexecdir\n" ++ "\n"++ "getDataFileName :: FilePath -> IO FilePath\n"++ "getDataFileName name = return (datadir ++ "++path_sep++" ++ name)\n" | otherwise = "\nprefix = " ++ show (prefix lbi) ++ "\nbindirrel = " ++ show (fromJust flat_bindirrel) ++ "\n"++ "\ngetBinDir :: IO FilePath\n"++ "getBinDir = getPrefixDirRel bindirrel\n\n"++ "getLibDir :: IO FilePath\n"++ "getLibDir = "++mkGetDir flat_libdir flat_libdirrel++"\n\n"++ "getDataDir :: IO FilePath\n"++ "getDataDir = "++mkGetDir flat_datadir flat_datadirrel++"\n\n"++ "getLibexecDir :: IO FilePath\n"++ "getLibexecDir = "++mkGetDir flat_libexecdir flat_libexecdirrel++"\n\n"++ "getDataFileName :: FilePath -> IO FilePath\n"++ "getDataFileName name = do\n"++ " dir <- getDataDir\n"++ " return (dir `joinFileName` name)\n"++ "\n"++ get_prefix_stuff in do btime <- getModificationTime localBuildInfoFile exists <- doesFileExist paths_filepath ptime <- if exists then getModificationTime paths_filepath else return btime if btime >= ptime then writeFile paths_filepath (header++body) else return () where flat_bindir = mkBinDir pkg_descr lbi NoCopyDest flat_bindirrel = mkBinDirRel pkg_descr lbi NoCopyDest flat_libdir = mkLibDir pkg_descr lbi NoCopyDest flat_libdirrel = mkLibDirRel pkg_descr lbi NoCopyDest flat_datadir = mkDataDir pkg_descr lbi NoCopyDest flat_datadirrel = mkDataDirRel pkg_descr lbi NoCopyDest flat_libexecdir = mkLibexecDir pkg_descr lbi NoCopyDest flat_libexecdirrel = mkLibexecDirRel pkg_descr lbi NoCopyDest mkGetDir dir (Just dirrel) = "getPrefixDirRel " ++ show dirrel mkGetDir dir Nothing = "return " ++ show dir #if mingw32_HOST_OS absolute = hasLibs pkg_descr || flat_bindirrel == Nothing #else absolute = True #endif paths_modulename = autogenModuleName pkg_descr paths_filename = paths_modulename ++ ".hs" paths_filepath = autogenModulesDir lbi `joinFileName` paths_filename path_sep = show [pathSeparator] get_prefix_stuff :: String get_prefix_stuff = "getPrefixDirRel :: FilePath -> IO FilePath\n"++ "getPrefixDirRel dirRel = do \n"++ " let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.\n"++ " buf <- mallocArray len\n"++ " ret <- getModuleFileName nullPtr buf len\n"++ " if ret == 0 \n"++ " then do free buf;\n"++ " return (prefix `joinFileName` dirRel)\n"++ " else do exePath <- peekCString buf\n"++ " free buf\n"++ " let (bindir,_) = splitFileName exePath\n"++ " return (prefixFromBinDir bindir bindirrel `joinFileName` dirRel)\n"++ " where\n"++ " prefixFromBinDir bindir path\n"++ " | path' == \".\" = bindir'\n"++ " | otherwise = prefixFromBinDir bindir' path'\n"++ " where\n"++ " (bindir',_) = splitFileName bindir\n"++ " (path', _) = splitFileName path\n"++ "\n"++ "foreign import stdcall unsafe \"windows.h GetModuleFileNameA\"\n"++ " getModuleFileName :: Ptr () -> CString -> Int -> IO Int32\n"++ "\n"++ "joinFileName :: String -> String -> FilePath\n"++ "joinFileName \"\" fname = fname\n"++ "joinFileName \".\" fname = fname\n"++ "joinFileName dir \"\" = dir\n"++ "joinFileName dir fname\n"++ " | isPathSeparator (last dir) = dir++fname\n"++ " | otherwise = dir++pathSeparator:fname\n"++ "\n"++ "splitFileName p = (reverse (path2++drive), reverse fname)\n"++ " where\n"++ " (path,drive) = case p of\n"++ " (c:':':p) -> (reverse p,[':',c])\n"++ " _ -> (reverse p,\"\")\n"++ " (fname,path1) = break isPathSeparator path\n"++ " path2 = case path1 of\n"++ " [] -> \".\"\n"++ " [_] -> path1 -- don't remove the trailing slash if \n"++ " -- there is only one character\n"++ " (c:path) | isPathSeparator c -> path\n"++ " _ -> path1\n"++ "\n"++ "pathSeparator :: Char\n"++ "pathSeparator = '\\\\'\n"++ "\n"++ "isPathSeparator :: Char -> Bool\n"++ "isPathSeparator ch =\n"++ " ch == '/' || ch == '\\\\'\n" -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ #ifdef DEBUG hunitTests :: [Test] hunitTests = [] #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/Hugs.hs0000644006511100651110000003530410504340326022717 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Hugs -- Copyright : Isaac Jones 2003-2006 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- {- Copyright (c) 2003-2005, Isaac Jones All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.Hugs ( build, install, hugsPackageDir ) where import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..), withLib, Executable(..), withExe, Library(..), libModules, hcOptions, autogenModuleName ) import Distribution.Compiler ( Compiler(..), CompilerFlavor(..) ) import Distribution.Package ( PackageIdentifier(..) ) import Distribution.Setup ( CopyDest(..) ) import Distribution.PreProcess ( ppCpp ) import Distribution.PreProcess.Unlit ( unlit ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), mkLibDir, autogenModulesDir ) import Distribution.Simple.Utils( rawSystemExit, die, dirOf, dotToSep, moduleToFilePath, smartCopySources, findFile ) import Language.Haskell.Extension ( Extension(..) ) import Distribution.Compat.Directory ( copyFile,createDirectoryIfMissing, removeDirectoryRecursive ) import Distribution.Compat.FilePath ( joinFileName, splitFileExt, joinFileExt, dllExtension, searchPathSeparator, platformPath ) import Data.Char ( isSpace ) import Data.Maybe ( mapMaybe ) import Control.Monad ( unless, when, filterM ) #ifndef __NHC__ import Control.Exception ( try ) #else import IO ( try ) #endif import Data.List ( nub, sort, isSuffixOf ) import System.Directory ( Permissions(..), getPermissions, setPermissions ) -- ----------------------------------------------------------------------------- -- |Building a package for Hugs. build :: PackageDescription -> LocalBuildInfo -> Int -> IO () build pkg_descr lbi verbose = do let pref = buildDir lbi withLib pkg_descr () $ \ l -> do copyFile (autogenModulesDir lbi `joinFileName` paths_modulename) (pref `joinFileName` paths_modulename) compileBuildInfo pref [] (libModules pkg_descr) (libBuildInfo l) withExe pkg_descr $ compileExecutable (pref `joinFileName` "programs") where paths_modulename = autogenModuleName pkg_descr ++ ".hs" compileExecutable :: FilePath -> Executable -> IO () compileExecutable destDir (exe@Executable {modulePath=mainPath, buildInfo=bi}) = do let exeMods = otherModules bi srcMainFile <- findFile (hsSourceDirs bi) mainPath let exeDir = destDir `joinFileName` exeName exe let destMainFile = exeDir `joinFileName` hugsMainFilename exe copyModule (CPP `elem` extensions bi) bi srcMainFile destMainFile let destPathsFile = exeDir `joinFileName` paths_modulename copyFile (autogenModulesDir lbi `joinFileName` paths_modulename) destPathsFile compileBuildInfo exeDir (maybe [] (hsSourceDirs . libBuildInfo) (library pkg_descr)) exeMods bi compileFiles bi exeDir [destMainFile, destPathsFile] compileBuildInfo :: FilePath -> [FilePath] -- ^library source dirs, if building exes -> [String] -- ^Modules -> BuildInfo -> IO () compileBuildInfo destDir mLibSrcDirs mods bi = do -- Pass 1: copy or cpp files from src directory to build directory let useCpp = CPP `elem` extensions bi let srcDirs = nub $ hsSourceDirs bi ++ mLibSrcDirs when (verbose > 3) (putStrLn $ "Source directories: " ++ show srcDirs) flip mapM_ mods $ \ m -> do fs <- moduleToFilePath srcDirs m suffixes if null fs then die ("can't find source for module " ++ m) else do let srcFile = head fs let (_, ext) = splitFileExt srcFile copyModule useCpp bi srcFile (destDir `joinFileName` dotToSep m `joinFileExt` ext) -- Pass 2: compile foreign stubs in build directory stubsFileLists <- sequence [moduleToFilePath [destDir] modu suffixes | modu <- mods] compileFiles bi destDir (concat stubsFileLists) suffixes = ["hs", "lhs"] -- Copy or cpp a file from the source directory to the build directory. copyModule :: Bool -> BuildInfo -> FilePath -> FilePath -> IO () copyModule cppAll bi srcFile destFile = do createDirectoryIfMissing True (dirOf destFile) (exts, opts, _) <- getOptionsFromSource srcFile let ghcOpts = hcOptions GHC opts if cppAll || CPP `elem` exts || "-cpp" `elem` ghcOpts then do ppCpp bi lbi srcFile destFile verbose return () else copyFile srcFile destFile compileFiles :: BuildInfo -> FilePath -> [FilePath] -> IO () compileFiles bi modDir fileList = do ffiFileList <- filterM testFFI fileList unless (null ffiFileList) $ do when (verbose > 2) (putStrLn "Compiling FFI stubs") mapM_ (compileFFI bi modDir) ffiFileList -- Only compile FFI stubs for a file if it contains some FFI stuff testFFI :: FilePath -> IO Bool testFFI file = do inp <- readHaskellFile file return ("foreign" `elem` symbols (stripComments False inp)) compileFFI :: BuildInfo -> FilePath -> FilePath -> IO () compileFFI bi modDir file = do (_, opts, file_incs) <- getOptionsFromSource file let ghcOpts = hcOptions GHC opts let pkg_incs = ["\"" ++ inc ++ "\"" | inc <- includes bi ++ installIncludes bi] let incs = nub (sort (file_incs ++ includeOpts ghcOpts ++ pkg_incs)) let pathFlag = "-P" ++ modDir ++ [searchPathSeparator] let hugsArgs = "-98" : pathFlag : map ("-i" ++) incs cfiles <- getCFiles file let cArgs = ["-I" ++ dir | dir <- includeDirs bi] ++ ccOptions bi ++ cfiles ++ ["-L" ++ dir | dir <- extraLibDirs bi] ++ ldOptions bi ++ ["-l" ++ lib | lib <- extraLibs bi] ++ concat [["-framework", f] | f <- frameworks bi] rawSystemExit verbose ffihugs (hugsArgs ++ file : cArgs) ffihugs = compilerPath (compiler lbi) includeOpts :: [String] -> [String] includeOpts [] = [] includeOpts ("-#include" : arg : opts) = arg : includeOpts opts includeOpts (_ : opts) = includeOpts opts -- get C file names from CFILES pragmas throughout the source file getCFiles :: FilePath -> IO [String] getCFiles file = do inp <- readHaskellFile file return [platformPath cfile | "{-#" : "CFILES" : rest <- map words $ lines $ stripComments True inp, last rest == "#-}", cfile <- init rest] -- List of terminal symbols in a source file. symbols :: String -> [String] symbols cs = case lex cs of (sym, cs'):_ | not (null sym) -> sym : symbols cs' _ -> [] -- Get the non-literate source of a Haskell module. readHaskellFile :: FilePath -> IO String readHaskellFile file = do text <- readFile file return $ if ".lhs" `isSuffixOf` file then unlit file text else text -- ------------------------------------------------------------ -- * options in source files -- ------------------------------------------------------------ -- |Read the initial part of a source file, before any Haskell code, -- and return the contents of any LANGUAGE, OPTIONS and INCLUDE pragmas. getOptionsFromSource :: FilePath -> IO ([Extension], -- LANGUAGE pragma, if any [(CompilerFlavor,[String])], -- OPTIONS_FOO pragmas [String] -- INCLUDE pragmas ) getOptionsFromSource file = do text <- readFile file return $ foldr appendOptions ([],[],[]) $ map getOptions $ takeWhileJust $ map getPragma $ filter textLine $ map (dropWhile isSpace) $ lines $ stripComments True $ if ".lhs" `isSuffixOf` file then unlit file text else text where textLine [] = False textLine ('#':_) = False textLine _ = True getPragma :: String -> Maybe [String] getPragma line = case words line of ("{-#" : rest) | last rest == "#-}" -> Just (init rest) _ -> Nothing getOptions ("OPTIONS":opts) = ([], [(GHC, opts)], []) getOptions ("OPTIONS_GHC":opts) = ([], [(GHC, opts)], []) getOptions ("OPTIONS_NHC98":opts) = ([], [(NHC, opts)], []) getOptions ("OPTIONS_HUGS":opts) = ([], [(Hugs, opts)], []) getOptions ("LANGUAGE":ws) = (mapMaybe readExtension ws, [], []) where readExtension :: String -> Maybe Extension readExtension w = case reads w of [(ext, "")] -> Just ext [(ext, ",")] -> Just ext _ -> Nothing getOptions ("INCLUDE":ws) = ([], [], ws) getOptions _ = ([], [], []) appendOptions (exts, opts, incs) (exts', opts', incs') = (exts++exts', opts++opts', incs++incs') -- takeWhileJust f = map fromJust . takeWhile isJust takeWhileJust :: [Maybe a] -> [a] takeWhileJust (Just x:xs) = x : takeWhileJust xs takeWhileJust _ = [] -- |Strip comments from Haskell source. stripComments :: Bool -- ^ preserve pragmas? -> String -- ^ input source text -> String stripComments keepPragmas = stripCommentsLevel 0 where stripCommentsLevel :: Int -> String -> String stripCommentsLevel 0 ('"':cs) = '"':copyString cs stripCommentsLevel 0 ('-':'-':cs) = -- FIX: symbols like --> stripCommentsLevel 0 (dropWhile (/= '\n') cs) stripCommentsLevel 0 ('{':'-':'#':cs) | keepPragmas = '{' : '-' : '#' : copyPragma cs stripCommentsLevel n ('{':'-':cs) = stripCommentsLevel (n+1) cs stripCommentsLevel 0 (c:cs) = c : stripCommentsLevel 0 cs stripCommentsLevel n ('-':'}':cs) = stripCommentsLevel (n-1) cs stripCommentsLevel n (c:cs) = stripCommentsLevel n cs stripCommentsLevel _ [] = [] copyString ('\\':c:cs) = '\\' : c : copyString cs copyString ('"':cs) = '"' : stripCommentsLevel 0 cs copyString (c:cs) = c : copyString cs copyString [] = [] copyPragma ('#':'-':'}':cs) = '#' : '-' : '}' : stripCommentsLevel 0 cs copyPragma (c:cs) = c : copyPragma cs copyPragma [] = [] -- ----------------------------------------------------------------------------- -- Install for Hugs -- For install, copy-prefix = prefix, but for copy they're different. -- The library goes in /lib/hugs/packages/ -- (i.e. /lib/hugs/packages/ on the target system). -- Each executable goes in /lib/hugs/programs/ -- (i.e. /lib/hugs/programs/ on the target system) -- with a script /bin/ pointing at -- /lib/hugs/programs/ install :: Int -- ^verbose -> FilePath -- ^Library install location -> FilePath -- ^Program install location -> FilePath -- ^Executable install location -> FilePath -- ^Program location on target system -> FilePath -- ^Build location -> PackageDescription -> IO () install verbose libDir installProgDir binDir targetProgDir buildPref pkg_descr = do withLib pkg_descr () $ \ libInfo -> do try $ removeDirectoryRecursive libDir smartCopySources verbose [buildPref] libDir (libModules pkg_descr) hugsInstallSuffixes True False let buildProgDir = buildPref `joinFileName` "programs" when (any (buildable . buildInfo) (executables pkg_descr)) $ createDirectoryIfMissing True binDir withExe pkg_descr $ \ exe -> do let buildDir = buildProgDir `joinFileName` exeName exe let installDir = installProgDir `joinFileName` exeName exe let targetDir = targetProgDir `joinFileName` exeName exe try $ removeDirectoryRecursive installDir smartCopySources verbose [buildDir] installDir ("Main" : autogenModuleName pkg_descr : otherModules (buildInfo exe)) hugsInstallSuffixes True False let targetName = "\"" ++ (targetDir `joinFileName` hugsMainFilename exe) ++ "\"" -- FIX (HUGS): use extensions, and options from file too? -- see http://hackage.haskell.org/trac/hackage/ticket/43 let hugsOptions = hcOptions Hugs (options (buildInfo exe)) #if mingw32_HOST_OS || mingw32_TARGET_OS let exeFile = binDir `joinFileName` exeName exe `joinFileExt` "bat" let script = unlines [ "@echo off", unwords ("runhugs" : hugsOptions ++ [targetName, "%*"])] #else let exeFile = binDir `joinFileName` exeName exe let script = unlines [ "#! /bin/sh", unwords ("runhugs" : hugsOptions ++ [targetName, "\"$@\""])] #endif writeFile exeFile script perms <- getPermissions exeFile setPermissions exeFile perms { executable = True, readable = True } hugsInstallSuffixes :: [String] hugsInstallSuffixes = ["hs", "lhs", dllExtension] -- |Hugs library directory for a package hugsPackageDir :: PackageDescription -> LocalBuildInfo -> FilePath hugsPackageDir pkg_descr lbi = mkLibDir pkg_descr lbi NoCopyDest `joinFileName` "packages" `joinFileName` pkgName (package pkg_descr) -- |Filename used by Hugs for the main module of an executable. -- This is a simple filename, so that Hugs will look for any auxiliary -- modules it uses relative to the directory it's in. hugsMainFilename :: Executable -> FilePath hugsMainFilename exe = "Main" `joinFileExt` ext where (_, ext) = splitFileExt (modulePath exe) hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/GHC.hs0000644006511100651110000004535210504340326022416 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.GHC -- Copyright : Isaac Jones 2003-2006 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- {- Copyright (c) 2003-2005, Isaac Jones All rights reserved. Redistribution and use in source and binary forms, with or without modiication, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.GHC ( build, installLib, installExe ) where import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..), withLib, setupMessage, Executable(..), withExe, Library(..), libModules, hcOptions ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), autogenModulesDir, mkLibDir, mkIncludeDir ) import Distribution.Simple.Utils( rawSystemExit, rawSystemPath, rawSystemVerbose, maybeExit, xargs, die, dirOf, moduleToFilePath, smartCopySources, findFile, copyFileVerbose, mkLibName, mkProfLibName, dotToSep ) import Distribution.Package ( PackageIdentifier(..), showPackageId ) import Distribution.Program ( rawSystemProgram, ranlibProgram, Program(..), ProgramConfiguration(..), ProgramLocation(..), lookupProgram, arProgram ) import Distribution.Compiler ( Compiler(..), CompilerFlavor(..), extensionsToGHCFlag ) import Distribution.Version ( Version(..) ) import Distribution.Compat.FilePath ( joinFileName, exeExtension, joinFileExt, splitFilePath, objExtension, joinPaths, isAbsolutePath, splitFileExt ) import Distribution.Compat.Directory ( createDirectoryIfMissing ) import qualified Distribution.Simple.GHCPackageConfig as GHC ( localPackageConfig, canReadLocalPackageConfig ) import Language.Haskell.Extension (Extension(..)) import Control.Monad ( unless, when ) import Data.List ( isSuffixOf, nub ) import System.Directory ( removeFile, renameFile, getDirectoryContents, doesFileExist ) import System.Exit (ExitCode(..)) #ifdef mingw32_HOST_OS import Distribution.Compat.FilePath ( splitFileName ) #endif #ifndef __NHC__ import Control.Exception (try) #else import IO (try) #endif -- ----------------------------------------------------------------------------- -- Building -- |Building for GHC. If .ghc-packages exists and is readable, add -- it to the command-line. build :: PackageDescription -> LocalBuildInfo -> Int -> IO () build pkg_descr lbi verbose = do let pref = buildDir lbi let ghcPath = compilerPath (compiler lbi) ifVanillaLib forceVanilla = when (forceVanilla || withVanillaLib lbi) ifProfLib = when (withProfLib lbi) ifGHCiLib = when (withGHCiLib lbi) -- GHC versions prior to 6.4 didn't have the user package database, -- so we fake it. TODO: This can go away in due course. pkg_conf <- if versionBranch (compilerVersion (compiler lbi)) >= [6,4] then return [] else do pkgConf <- GHC.localPackageConfig pkgConfReadable <- GHC.canReadLocalPackageConfig if pkgConfReadable then return ["-package-conf", pkgConf] else return [] -- Build lib withLib pkg_descr () $ \lib -> do when (verbose > 3) (putStrLn "Building library...") let libBi = libBuildInfo lib libTargetDir = pref forceVanillaLib = TemplateHaskell `elem` extensions libBi -- TH always needs vanilla libs, even when building for profiling createDirectoryIfMissing True libTargetDir -- put hi-boot files into place for mutually recurive modules smartCopySources verbose (hsSourceDirs libBi) libTargetDir (libModules pkg_descr) ["hi-boot"] False False let ghcArgs = pkg_conf ++ ["-package-name", showPackageId (package pkg_descr) ] ++ (if splitObjs lbi then ["-split-objs"] else []) ++ constructGHCCmdLine lbi libBi libTargetDir verbose ++ (libModules pkg_descr) ghcArgsProf = ghcArgs ++ ["-prof", "-hisuf", "p_hi", "-osuf", "p_o" ] ++ ghcProfOptions libBi unless (null (libModules pkg_descr)) $ do ifVanillaLib forceVanillaLib (rawSystemExit verbose ghcPath ghcArgs) ifProfLib (rawSystemExit verbose ghcPath ghcArgsProf) -- build any C sources unless (null (cSources libBi)) $ do when (verbose > 3) (putStrLn "Building C Sources...") -- FIX: similar 'versionBranch' logic duplicated below. refactor for code sharing sequence_ [do let ghc_vers = compilerVersion (compiler lbi) odir | versionBranch ghc_vers >= [6,4,1] = pref | otherwise = pref `joinFileName` dirOf c -- ghc 6.4.1 fixed a bug in -odir handling -- for C compilations. createDirectoryIfMissing True odir let cArgs = ["-I" ++ dir | dir <- includeDirs libBi] ++ ["-optc" ++ opt | opt <- ccOptions libBi] ++ ["-odir", odir, "-hidir", pref, "-c"] ++ (if verbose > 4 then ["-v"] else []) rawSystemExit verbose ghcPath (cArgs ++ [c]) | c <- cSources libBi] -- link: when (verbose > 3) (putStrLn "cabal-linking...") let cObjs = [ path `joinFileName` file `joinFileExt` objExtension | (path, file, _) <- (map splitFilePath (cSources libBi)) ] libName = mkLibName pref (showPackageId (package pkg_descr)) profLibName = mkProfLibName pref (showPackageId (package pkg_descr)) ghciLibName = mkGHCiLibName pref (showPackageId (package pkg_descr)) stubObjs <- sequence [moduleToFilePath [libTargetDir] (x ++"_stub") [objExtension] | x <- libModules pkg_descr ] >>= return . concat stubProfObjs <- sequence [moduleToFilePath [libTargetDir] (x ++"_stub") ["p_" ++ objExtension] | x <- libModules pkg_descr ] >>= return . concat hObjs <- getHaskellObjects pkg_descr libBi lbi pref objExtension hProfObjs <- if (withProfLib lbi) then getHaskellObjects pkg_descr libBi lbi pref ("p_" ++ objExtension) else return [] unless (null hObjs && null cObjs && null stubObjs) $ do try (removeFile libName) -- first remove library if it exists try (removeFile profLibName) -- first remove library if it exists try (removeFile ghciLibName) -- first remove library if it exists let arArgs = ["q"++ (if verbose > 4 then "v" else "")] ++ [libName] arObjArgs = hObjs ++ map (pref `joinFileName`) cObjs ++ stubObjs arProfArgs = ["q"++ (if verbose > 4 then "v" else "")] ++ [profLibName] arProfObjArgs = hProfObjs ++ map (pref `joinFileName`) cObjs ++ stubProfObjs ldArgs = ["-r"] ++ ["-x"] -- FIXME: only some systems's ld support the "-x" flag ++ ["-o", ghciLibName `joinFileExt` "tmp"] ldObjArgs = hObjs ++ map (pref `joinFileName`) cObjs ++ stubObjs #if defined(mingw32_TARGET_OS) || defined(mingw32_HOST_OS) (compilerDir, _) = splitFileName $ compilerPath (compiler lbi) (baseDir, _) = splitFileName compilerDir ld = baseDir `joinFileName` "gcc-lib\\ld.exe" rawSystemLd = rawSystemVerbose maxCommandLineSize = 30 * 1024 #else ld = "ld" rawSystemLd = rawSystemPath --TODO: discover this at configure time on unix maxCommandLineSize = 30 * 1024 #endif runLd ld args = do exists <- doesFileExist ghciLibName status <- rawSystemLd verbose ld (args ++ if exists then [ghciLibName] else []) when (status == ExitSuccess) (renameFile (ghciLibName `joinFileExt` "tmp") ghciLibName) return status ifVanillaLib False $ maybeExit $ xargs maxCommandLineSize (rawSystemPath verbose) "ar" arArgs arObjArgs ifProfLib $ maybeExit $ xargs maxCommandLineSize (rawSystemPath verbose) "ar" arProfArgs arProfObjArgs ifGHCiLib $ maybeExit $ xargs maxCommandLineSize runLd ld ldArgs ldObjArgs -- build any executables withExe pkg_descr $ \ (Executable exeName' modPath exeBi) -> do when (verbose > 3) (putStrLn $ "Building executable: " ++ exeName' ++ "...") -- exeNameReal, the name that GHC really uses (with .exe on Windows) let exeNameReal = exeName' `joinFileExt` (if null $ snd $ splitFileExt exeName' then exeExtension else "") let targetDir = pref `joinFileName` exeName' let exeDir = joinPaths targetDir (exeName' ++ "-tmp") createDirectoryIfMissing True targetDir createDirectoryIfMissing True exeDir -- put hi-boot files into place for mutually recursive modules -- FIX: what about exeName.hi-boot? smartCopySources verbose (hsSourceDirs exeBi) exeDir (otherModules exeBi) ["hi-boot"] False False -- build executables unless (null (cSources exeBi)) $ do when (verbose > 3) (putStrLn "Building C Sources.") sequence_ [do let cSrcODir |versionBranch (compilerVersion (compiler lbi)) >= [6,4,1] = exeDir | otherwise = exeDir `joinFileName` (dirOf c) createDirectoryIfMissing True cSrcODir let cArgs = ["-I" ++ dir | dir <- includeDirs exeBi] ++ ["-optc" ++ opt | opt <- ccOptions exeBi] ++ ["-odir", cSrcODir, "-hidir", pref, "-c"] ++ (if verbose > 4 then ["-v"] else []) rawSystemExit verbose ghcPath (cArgs ++ [c]) | c <- cSources exeBi] srcMainFile <- findFile (hsSourceDirs exeBi) modPath let cObjs = [ path `joinFileName` file `joinFileExt` objExtension | (path, file, _) <- (map splitFilePath (cSources exeBi)) ] let binArgs linkExe profExe = pkg_conf ++ ["-I"++pref] ++ (if linkExe then ["-o", targetDir `joinFileName` exeNameReal] else ["-c"]) ++ constructGHCCmdLine lbi exeBi exeDir verbose ++ [exeDir `joinFileName` x | x <- cObjs] ++ [srcMainFile] ++ ldOptions exeBi ++ ["-l"++lib | lib <- extraLibs exeBi] ++ ["-L"++libDir | libDir <- extraLibDirs exeBi] ++ if profExe then "-prof":ghcProfOptions exeBi else [] -- For building exe's for profiling that use TH we actually -- have to build twice, once without profiling and the again -- with profiling. This is because the code that TH needs to -- run at compile time needs to be the vanilla ABI so it can -- be loaded up and run by the compiler. when (withProfExe lbi && TemplateHaskell `elem` extensions exeBi) (rawSystemExit verbose ghcPath (binArgs False False)) rawSystemExit verbose ghcPath (binArgs True (withProfExe lbi)) -- when using -split-objs, we need to search for object files in the -- Module_split directory for each module. getHaskellObjects :: PackageDescription -> BuildInfo -> LocalBuildInfo -> FilePath -> String -> IO [FilePath] getHaskellObjects pkg_descr libBi lbi pref obj_ext | splitObjs lbi = do let dirs = [ pref `joinFileName` (dotToSep x ++ "_split") | x <- libModules pkg_descr ] objss <- mapM getDirectoryContents dirs let objs = [ dir `joinFileName` obj | (objs,dir) <- zip objss dirs, obj <- objs, obj_ext `isSuffixOf` obj ] return objs | otherwise = return [ pref `joinFileName` (dotToSep x) `joinFileExt` obj_ext | x <- libModules pkg_descr ] constructGHCCmdLine :: LocalBuildInfo -> BuildInfo -> FilePath -> Int -- verbosity level -> [String] constructGHCCmdLine lbi bi odir verbose = ["--make"] ++ (if verbose > 4 then ["-v"] else []) -- Unsupported extensions have already been checked by configure ++ (if compilerVersion (compiler lbi) > Version [6,4] [] then ["-hide-all-packages"] else []) ++ ["-i"] ++ ["-i" ++ autogenModulesDir lbi] ++ ["-i" ++ l | l <- nub (hsSourceDirs bi)] ++ ["-I" ++ dir | dir <- includeDirs bi] ++ ["-optc" ++ opt | opt <- ccOptions bi] ++ [ "-#include \"" ++ inc ++ "\"" | inc <- includes bi ++ installIncludes bi ] ++ [ "-odir", odir, "-hidir", odir ] ++ (concat [ ["-package", showPackageId pkg] | pkg <- packageDeps lbi ]) ++ hcOptions GHC (options bi) ++ snd (extensionsToGHCFlag (extensions bi)) mkGHCiLibName :: FilePath -- ^file Prefix -> String -- ^library name. -> String mkGHCiLibName pref lib = pref `joinFileName` ("HS" ++ lib ++ ".o") -- ----------------------------------------------------------------------------- -- Installing -- |Install executables for GHC. installExe :: Int -- ^verbose -> FilePath -- ^install location -> FilePath -- ^Build location -> PackageDescription -> IO () installExe verbose pref buildPref pkg_descr = do createDirectoryIfMissing True pref withExe pkg_descr $ \ (Executable e _ b) -> do let exeName = e `joinFileExt` exeExtension copyFileVerbose verbose (buildPref `joinFileName` e `joinFileName` exeName) (pref `joinFileName` exeName) -- |Install for ghc, .hi, .a and, if --with-ghci given, .o installLib :: Int -- ^verbose -> ProgramConfiguration -> Bool -- ^has vanilla library -> Bool -- ^has profiling library -> Bool -- ^has GHCi libs -> FilePath -- ^install location -> FilePath -- ^Build location -> PackageDescription -> IO () installLib verbose programConf hasVanilla hasProf hasGHCi pref buildPref pd@PackageDescription{library=Just l, package=p} = do ifVanilla $ smartCopySources verbose [buildPref] pref (libModules pd) ["hi"] True False ifProf $ smartCopySources verbose [buildPref] pref (libModules pd) ["p_hi"] True False let libTargetLoc = mkLibName pref (showPackageId p) profLibTargetLoc = mkProfLibName pref (showPackageId p) libGHCiTargetLoc = mkGHCiLibName pref (showPackageId p) ifVanilla $ copyFileVerbose verbose (mkLibName buildPref (showPackageId p)) libTargetLoc ifProf $ copyFileVerbose verbose (mkProfLibName buildPref (showPackageId p)) profLibTargetLoc ifGHCi $ copyFileVerbose verbose (mkGHCiLibName buildPref (showPackageId p)) libGHCiTargetLoc installIncludeFiles verbose pd pref -- use ranlib or ar -s to build an index. this is necessary -- on some systems like MacOS X. If we can't find those, -- don't worry too much about it. let progName = programName $ ranlibProgram mProg <- lookupProgram progName programConf case foundProg mProg of Just rl -> do ifVanilla $ rawSystemProgram verbose rl [libTargetLoc] ifProf $ rawSystemProgram verbose rl [profLibTargetLoc] Nothing -> do let progName = programName $ arProgram mProg <- lookupProgram progName programConf case mProg of Just ar -> do ifVanilla $ rawSystemProgram verbose ar ["-s", libTargetLoc] ifProf $ rawSystemProgram verbose ar ["-s", profLibTargetLoc] Nothing -> setupMessage "Warning: Unable to generate index for library (missing ranlib and ar)" pd return () where ifVanilla action = when hasVanilla (action >> return ()) ifProf action = when hasProf (action >> return ()) ifGHCi action = when hasGHCi (action >> return ()) installLib _ _ _ _ _ _ _ PackageDescription{library=Nothing} = die $ "Internal Error. installLibGHC called with no library." -- | Install the files listed in install-includes installIncludeFiles :: Int -> PackageDescription -> FilePath -> IO () installIncludeFiles verbose pkg_descr@PackageDescription{library=Just l} libdir = do createDirectoryIfMissing True incdir incs <- mapM (findInc relincdirs) (installIncludes lbi) sequence_ [ copyFileVerbose verbose path (incdir `joinFileName` f) | (f,path) <- incs ] where relincdirs = filter (not.isAbsolutePath) (includeDirs lbi) lbi = libBuildInfo l incdir = mkIncludeDir libdir findInc [] f = die ("can't find include file " ++ f) findInc (d:ds) f = do let path = (d `joinFileName` f) b <- doesFileExist path if b then return (f,path) else findInc ds f -- Also checks whether the program was actually found. foundProg :: Maybe Program -> Maybe Program foundProg Nothing = Nothing foundProg (Just Program{programLocation=EmptyLocation}) = Nothing foundProg x = x hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/Utils.hs0000644006511100651110000004635710504340326023123 0ustar rossross{-# OPTIONS_GHC -cpp -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Utils -- Copyright : Isaac Jones, Simon Marlow 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Explanation: Misc. Utilities, especially file-related utilities. -- Stuff used by multiple modules that doesn't fit elsewhere. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.Utils ( die, dieWithLocation, warn, rawSystemPath, rawSystemVerbose, rawSystemExit, maybeExit, xargs, matchesDescFile, rawSystemPathExit, smartCopySources, copyFileVerbose, copyDirectoryRecursiveVerbose, moduleToFilePath, mkLibName, mkProfLibName, currentDir, dirOf, dotToSep, withTempFile, findFile, defaultPackageDesc, findPackageDesc, defaultHookedPackageDesc, findHookedPackageDesc, distPref, haddockPref, srcPref, #ifdef DEBUG hunitTests #endif ) where #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604 #if __GLASGOW_HASKELL__ < 603 #include "config.h" #else #include "ghcconfig.h" #endif #endif import Distribution.Compat.RawSystem (rawSystem) import Distribution.Compat.Exception (finally) import Control.Monad(when, filterM, unless) import Data.List (nub, unfoldr) import System.Environment (getProgName) import System.IO (hPutStrLn, stderr, hFlush, stdout) import System.IO.Error import System.Exit #if (__GLASGOW_HASKELL__ || __HUGS__) && !(mingw32_HOST_OS || mingw32_TARGET_OS) import System.Posix.Internals (c_getpid) #endif import Distribution.Compat.FilePath (splitFileName, splitFileExt, joinFileName, joinFileExt, joinPaths, pathSeparator,splitFilePath) import System.Directory (getDirectoryContents, getCurrentDirectory , doesDirectoryExist, doesFileExist, removeFile, getPermissions , Permissions(executable)) import Distribution.Compat.Directory (copyFile, findExecutable, createDirectoryIfMissing, getDirectoryContentsWithoutSpecial) #ifdef DEBUG import HUnit ((~:), (~=?), Test(..), assertEqual) #endif -- ------------------------------------------------------------------------------- Utils for setup dieWithLocation :: FilePath -> (Maybe Int) -> String -> IO a dieWithLocation fname Nothing msg = die (fname ++ ": " ++ msg) dieWithLocation fname (Just n) msg = die (fname ++ ":" ++ show n ++ ": " ++ msg) die :: String -> IO a die msg = do hFlush stdout pname <- getProgName hPutStrLn stderr (pname ++ ": " ++ msg) exitWith (ExitFailure 1) warn :: String -> IO () warn msg = do hFlush stdout pname <- getProgName hPutStrLn stderr (pname ++ ": Warning: " ++ msg) -- ----------------------------------------------------------------------------- -- rawSystem variants rawSystemPath :: Int -> String -> [String] -> IO ExitCode rawSystemPath verbose prog args = do r <- findExecutable prog case r of Nothing -> die ("Cannot find: " ++ prog) Just path -> rawSystemVerbose verbose path args rawSystemVerbose :: Int -> FilePath -> [String] -> IO ExitCode rawSystemVerbose verbose prog args = do when (verbose > 0) $ putStrLn (prog ++ concatMap (' ':) args) e <- doesFileExist prog if e then do perms <- getPermissions prog if (executable perms) then rawSystem prog args else die ("Error: file is not executable: " ++ show prog) else die ("Error: file does not exist: " ++ show prog) maybeExit :: IO ExitCode -> IO () maybeExit cmd = do res <- cmd if res /= ExitSuccess then exitWith res else return () -- Exit with the same exitcode if the subcommand fails rawSystemExit :: Int -> FilePath -> [String] -> IO () rawSystemExit verbose path args = do when (verbose > 0) $ putStrLn (path ++ concatMap (' ':) args) maybeExit $ rawSystem path args -- Exit with the same exitcode if the subcommand fails rawSystemPathExit :: Int -> String -> [String] -> IO () rawSystemPathExit verbose prog args = do maybeExit $ rawSystemPath verbose prog args -- | Like the unix xargs program. Useful for when we've got very long command -- lines that might overflow an OS limit on command line length and so you -- need to invoke a command multiple times to get all the args in. -- -- Use it with either of the rawSystem variants above. For example: -- -- > xargs (32*1024) (rawSystemPath verbose) prog fixedArgs bigArgs -- xargs :: Int -> (FilePath -> [String] -> IO ExitCode) -> FilePath -> [String] -> [String] -> IO ExitCode xargs maxSize rawSystem prog fixedArgs bigArgs = let fixedArgSize = sum (map length fixedArgs) + length fixedArgs chunkSize = maxSize - fixedArgSize loop [] = return ExitSuccess loop (args:remainingArgs) = do status <- rawSystem prog (fixedArgs ++ args) case status of ExitSuccess -> loop remainingArgs _ -> return status in loop (chunks chunkSize bigArgs) where chunks len = unfoldr $ \s -> if null s then Nothing else Just (chunk [] len s) chunk acc len [] = (reverse acc,[]) chunk acc len (s:ss) | len' < len = chunk (s:acc) (len-len'-1) ss | otherwise = (reverse acc, s:ss) where len' = length s -- ------------------------------------------------------------ -- * File Utilities -- ------------------------------------------------------------ -- |Get the file path for this particular module. In the IO monad -- because it looks for the actual file. Might eventually interface -- with preprocessor libraries in order to correctly locate more -- filenames. -- Returns empty list if no such files exist. moduleToFilePath :: [FilePath] -- ^search locations -> String -- ^Module Name -> [String] -- ^possible suffixes -> IO [FilePath] moduleToFilePath pref s possibleSuffixes = filterM doesFileExist $ concatMap (searchModuleToPossiblePaths s possibleSuffixes) pref where searchModuleToPossiblePaths :: String -> [String] -> FilePath -> [FilePath] searchModuleToPossiblePaths s' suffs searchP = moduleToPossiblePaths searchP s' suffs -- |Like 'moduleToFilePath', but return the location and the rest of -- the path as separate results. moduleToFilePath2 :: [FilePath] -- ^search locations -> String -- ^Module Name -> [String] -- ^possible suffixes -> IO [(FilePath, FilePath)] -- ^locations and relative names moduleToFilePath2 locs mname possibleSuffixes = filterM exists $ [(loc, fname `joinFileExt` ext) | loc <- locs, ext <- possibleSuffixes] where fname = dotToSep mname exists (loc, relname) = doesFileExist (loc `joinFileName` relname) -- |Get the possible file paths based on this module name. moduleToPossiblePaths :: FilePath -- ^search prefix -> String -- ^module name -> [String] -- ^possible suffixes -> [FilePath] moduleToPossiblePaths searchPref s possibleSuffixes = let fname = searchPref `joinFileName` (dotToSep s) in [fname `joinFileExt` ext | ext <- possibleSuffixes] findFile :: [FilePath] -- ^search locations -> FilePath -- ^File Name -> IO FilePath findFile prefPathsIn locPath = do let prefPaths = nub prefPathsIn -- ignore dups paths <- filterM doesFileExist [prefPath `joinFileName` locPath | prefPath <- prefPaths] case nub paths of -- also ignore dups, though above nub should fix this. [path] -> return path [] -> die (locPath ++ " doesn't exist") paths -> die (locPath ++ " is found in multiple places:" ++ unlines (map ((++) " ") paths)) dotToSep :: String -> String dotToSep = map dts where dts '.' = pathSeparator dts c = c -- |Copy the source files into the right directory. Looks in the -- build prefix for files that look like the input modules, based on -- the input search suffixes. It copies the files into the target -- directory. smartCopySources :: Int -- ^verbose -> [FilePath] -- ^build prefix (location of objects) -> FilePath -- ^Target directory -> [String] -- ^Modules -> [String] -- ^search suffixes -> Bool -- ^Exit if no such modules -> Bool -- ^Preserve directory structure -> IO () smartCopySources verbose srcDirs targetDir sources searchSuffixes exitIfNone preserveDirs = do createDirectoryIfMissing True targetDir allLocations <- mapM moduleToFPErr sources let copies = [(srcDir `joinFileName` name, if preserveDirs then targetDir `joinFileName` srcDir `joinFileName` name else targetDir `joinFileName` name) | (srcDir, name) <- concat allLocations] -- Create parent directories for everything: mapM_ (createDirectoryIfMissing True) $ nub $ [fst (splitFileName targetFile) | (_, targetFile) <- copies] -- Put sources into place: sequence_ [copyFileVerbose verbose srcFile destFile | (srcFile, destFile) <- copies] where moduleToFPErr m = do p <- moduleToFilePath2 srcDirs m searchSuffixes when (null p && exitIfNone) (die ("Error: Could not find module: " ++ m ++ " with any suffix: " ++ (show searchSuffixes))) return p copyFileVerbose :: Int -> FilePath -> FilePath -> IO () copyFileVerbose verbose src dest = do when (verbose > 0) $ putStrLn ("copy " ++ src ++ " to " ++ dest) copyFile src dest -- adaptation of removeDirectoryRecursive copyDirectoryRecursiveVerbose :: Int -> FilePath -> FilePath -> IO () copyDirectoryRecursiveVerbose verbose srcDir destDir = do when (verbose > 0) $ putStrLn ("copy directory '" ++ srcDir ++ "' to '" ++ destDir ++ "'.") let aux src dest = let cp :: FilePath -> IO () cp f = let srcFile = joinPaths src f destFile = joinPaths dest f in do success <- try (copyFileVerbose verbose srcFile destFile) case success of Left e -> do isDir <- doesDirectoryExist srcFile -- If f is not a directory, re-throw the error unless isDir $ ioError e aux srcFile destFile Right _ -> return () in do createDirectoryIfMissing False dest getDirectoryContentsWithoutSpecial src >>= mapM_ cp in aux srcDir destDir -- | The path name that represents the current directory. -- In Unix, it's @\".\"@, but this is system-specific. -- (E.g. AmigaOS uses the empty string @\"\"@ for the current directory.) currentDir :: FilePath currentDir = "." dirOf :: FilePath -> FilePath dirOf f = (\ (x, _, _) -> x) $ (splitFilePath f) mkLibName :: FilePath -- ^file Prefix -> String -- ^library name. -> String mkLibName pref lib = pref `joinFileName` ("libHS" ++ lib ++ ".a") mkProfLibName :: FilePath -- ^file Prefix -> String -- ^library name. -> String mkProfLibName pref lib = mkLibName pref (lib++"_p") -- ------------------------------------------------------------ -- * Some Paths -- ------------------------------------------------------------ distPref :: FilePath distPref = "dist" srcPref :: FilePath srcPref = distPref `joinFileName` "src" haddockPref :: FilePath haddockPref = foldl1 joinPaths [distPref, "doc", "html"] -- ------------------------------------------------------------ -- * temporary file names -- ------------------------------------------------------------ -- use a temporary filename that doesn't already exist. -- NB. *not* secure (we don't atomically lock the tmp file we get) withTempFile :: FilePath -> String -> (FilePath -> IO a) -> IO a withTempFile tmp_dir extn action = do x <- getProcessID findTempName x where findTempName x = do let filename = ("tmp" ++ show x) `joinFileExt` extn path = tmp_dir `joinFileName` filename b <- doesFileExist path if b then findTempName (x+1) else action path `finally` try (removeFile path) #if mingw32_HOST_OS || mingw32_TARGET_OS foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows #elif __GLASGOW_HASKELL__ || __HUGS__ getProcessID :: IO Int getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral #else -- error ToDo: getProcessID foreign import ccall unsafe "getpid" getProcessID :: IO Int #endif -- ------------------------------------------------------------ -- * Finding the description file -- ------------------------------------------------------------ oldDescFile :: String oldDescFile = "Setup.description" cabalExt :: String cabalExt = "cabal" buildInfoExt :: String buildInfoExt = "buildinfo" matchesDescFile :: FilePath -> Bool matchesDescFile p = (snd $ splitFileExt p) == cabalExt || p == oldDescFile noDesc :: IO a noDesc = die $ "No description file found, please create a cabal-formatted description file with the name ." ++ cabalExt multiDesc :: [String] -> IO a multiDesc l = die $ "Multiple description files found. Please use only one of : " ++ show (filter (/= oldDescFile) l) -- |A list of possibly correct description files. Should be pre-filtered. descriptionCheck :: [FilePath] -> IO FilePath descriptionCheck [] = noDesc descriptionCheck [x] | x == oldDescFile = do warn $ "The filename \"Setup.description\" is deprecated, please move to ." ++ cabalExt return x | matchesDescFile x = return x | otherwise = noDesc descriptionCheck [x,y] | x == oldDescFile = do warn $ "The filename \"Setup.description\" is deprecated. Please move out of the way. Using \"" ++ y ++ "\"" return y | y == oldDescFile = do warn $ "The filename \"Setup.description\" is deprecated. Please move out of the way. Using \"" ++ x ++ "\"" return x | otherwise = multiDesc [x,y] descriptionCheck l = multiDesc l -- |Package description file (/pkgname/@.cabal@) defaultPackageDesc :: IO FilePath defaultPackageDesc = getCurrentDirectory >>= findPackageDesc -- |Find a package description file in the given directory. Looks for -- @.cabal@ files. findPackageDesc :: FilePath -- ^Where to look -> IO FilePath -- .cabal findPackageDesc p = do ls <- getDirectoryContents p let descs = filter matchesDescFile ls descriptionCheck descs -- |Optional auxiliary package information file (/pkgname/@.buildinfo@) defaultHookedPackageDesc :: IO (Maybe FilePath) defaultHookedPackageDesc = getCurrentDirectory >>= findHookedPackageDesc -- |Find auxiliary package information in the given directory. -- Looks for @.buildinfo@ files. findHookedPackageDesc :: FilePath -- ^Directory to search -> IO (Maybe FilePath) -- ^/dir/@\/@/pkgname/@.buildinfo@, if present findHookedPackageDesc dir = do ns <- getDirectoryContents dir case [dir `joinFileName` n | n <- ns, snd (splitFileExt n) == buildInfoExt] of [] -> return Nothing [f] -> return (Just f) _ -> die ("Multiple files with extension " ++ buildInfoExt) -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ #ifdef DEBUG hunitTests :: [Test] hunitTests = let suffixes = ["hs", "lhs"] in [TestCase $ #if mingw32_HOST_OS || mingw32_TARGET_OS do mp1 <- moduleToFilePath [""] "Distribution.Simple.Build" suffixes --exists mp2 <- moduleToFilePath [""] "Foo.Bar" suffixes -- doesn't exist assertEqual "existing not found failed" ["Distribution\\Simple\\Build.hs"] mp1 assertEqual "not existing not nothing failed" [] mp2, "moduleToPossiblePaths 1" ~: "failed" ~: ["Foo\\Bar\\Bang.hs","Foo\\Bar\\Bang.lhs"] ~=? (moduleToPossiblePaths "" "Foo.Bar.Bang" suffixes), "moduleToPossiblePaths2 " ~: "failed" ~: (moduleToPossiblePaths "" "Foo" suffixes) ~=? ["Foo.hs", "Foo.lhs"], TestCase (do files <- filesWithExtensions "." "cabal" assertEqual "filesWithExtensions" "Cabal.cabal" (head files)) #else do mp1 <- moduleToFilePath [""] "Distribution.Simple.Build" suffixes --exists mp2 <- moduleToFilePath [""] "Foo.Bar" suffixes -- doesn't exist assertEqual "existing not found failed" ["Distribution/Simple/Build.hs"] mp1 assertEqual "not existing not nothing failed" [] mp2, "moduleToPossiblePaths 1" ~: "failed" ~: ["Foo/Bar/Bang.hs","Foo/Bar/Bang.lhs"] ~=? (moduleToPossiblePaths "" "Foo.Bar.Bang" suffixes), "moduleToPossiblePaths2 " ~: "failed" ~: (moduleToPossiblePaths "" "Foo" suffixes) ~=? ["Foo.hs", "Foo.lhs"], TestCase (do files <- filesWithExtensions "." "cabal" assertEqual "filesWithExtensions" "Cabal.cabal" (head files)) #endif ] -- |Might want to make this more generic some day, with regexps -- or something. filesWithExtensions :: FilePath -- ^Directory to look in -> String -- ^The extension -> IO [FilePath] {- ^The file names (not full path) of all the files with this extension in this directory. -} filesWithExtensions dir extension = do allFiles <- getDirectoryContents dir return $ filter hasExt allFiles where hasExt f = snd (splitFileExt f) == extension #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/JHC.hs0000644006511100651110000001231210504340326022407 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.JHC -- Copyright : Isaac Jones 2003-2006 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- {- Copyright (c) 2003-2005, Isaac Jones All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.JHC ( build, installLib, installExe ) where import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..), withLib, Executable(..), withExe, Library(..), libModules, hcOptions ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), autogenModulesDir ) import Distribution.Compiler ( Compiler(..), CompilerFlavor(..), extensionsToJHCFlag ) import Distribution.Package ( showPackageId ) import Distribution.Simple.Utils( rawSystemExit, copyFileVerbose ) import Distribution.Compat.FilePath ( joinFileName, exeExtension ) import Distribution.Compat.Directory ( createDirectoryIfMissing ) import Control.Monad ( when ) import Data.List ( nub, intersperse ) -- ----------------------------------------------------------------------------- -- Building -- | Building a package for JHC. -- Currently C source files are not supported. build :: PackageDescription -> LocalBuildInfo -> Int -> IO () build pkg_descr lbi verbose = do let jhcPath = compilerPath (compiler lbi) withLib pkg_descr () $ \lib -> do when (verbose > 3) (putStrLn "Building library...") let libBi = libBuildInfo lib let args = constructJHCCmdLine lbi libBi (buildDir lbi) verbose rawSystemExit verbose jhcPath (["-c"] ++ args ++ libModules pkg_descr) let pkgid = showPackageId (package pkg_descr) pfile = buildDir lbi `joinFileName` "jhc-pkg.conf" hlfile= buildDir lbi `joinFileName` (pkgid ++ ".hl") writeFile pfile $ jhcPkgConf pkg_descr rawSystemExit verbose jhcPath ["--build-hl="++pfile, "-o", hlfile] withExe pkg_descr $ \exe -> do when (verbose > 3) (putStrLn ("Building executable "++exeName exe)) let exeBi = buildInfo exe let out = buildDir lbi `joinFileName` exeName exe let args = constructJHCCmdLine lbi exeBi (buildDir lbi) verbose rawSystemExit verbose jhcPath (["-o",out] ++ args ++ [modulePath exe]) constructJHCCmdLine :: LocalBuildInfo -> BuildInfo -> FilePath -> Int -> [String] constructJHCCmdLine lbi bi odir verbose = (if verbose > 4 then ["-v"] else []) ++ snd (extensionsToJHCFlag (extensions bi)) ++ hcOptions JHC (options bi) ++ ["--noauto","-i-"] ++ ["-i", autogenModulesDir lbi] ++ concat [["-i", l] | l <- nub (hsSourceDirs bi)] ++ ["-optc" ++ opt | opt <- ccOptions bi] ++ (concat [ ["-p", showPackageId pkg] | pkg <- packageDeps lbi ]) jhcPkgConf :: PackageDescription -> String jhcPkgConf pd = let sline name sel = name ++ ": "++sel pd Just lib = library pd comma f l = concat $ intersperse "," $ map f l in unlines [sline "name" (showPackageId . package) ,"exposed-modules: " ++ (comma id (exposedModules lib)) ,"hidden-modules: " ++ (comma id (otherModules $ libBuildInfo lib)) ] installLib :: Int -> FilePath -> FilePath -> PackageDescription -> Library -> IO () installLib verb dest build pkg_descr _ = do let p = showPackageId (package pkg_descr)++".hl" createDirectoryIfMissing True dest copyFileVerbose verb (joinFileName build p) (joinFileName dest p) installExe :: Int -> FilePath -> FilePath -> PackageDescription -> Executable -> IO () installExe verb dest build pkg_descr exe = do let out = exeName exe `joinFileName` exeExtension createDirectoryIfMissing True dest copyFileVerbose verb (joinFileName build out) (joinFileName dest out) hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/GHCPackageConfig.hs0000644006511100651110000001351610504340326025015 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.GHCPackageConfig -- Copyright : (c) The University of Glasgow 2004 -- -- Maintainer : libraries@haskell.org -- Stability : alpha -- Portability : portable -- -- Explanation: Performs registration for GHC. Specific to -- ghc-pkg. Creates a GHC package config file. module Distribution.Simple.GHCPackageConfig ( GHCPackageConfig(..), mkGHCPackageConfig, defaultGHCPackageConfig, showGHCPackageConfig, localPackageConfig, maybeCreateLocalPackageConfig, canWriteLocalPackageConfig, canReadLocalPackageConfig ) where import Distribution.PackageDescription (PackageDescription(..), BuildInfo(..), Library(..)) import Distribution.Package (PackageIdentifier(..), showPackageId) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),mkLibDir) import Distribution.Setup (CopyDest(..)) #ifndef __NHC__ import Control.Exception (try) #else import IO (try) #endif import Control.Monad(unless) import Text.PrettyPrint.HughesPJ import System.Directory (doesFileExist, getPermissions, Permissions (..)) import Distribution.Compat.FilePath (joinFileName) import Distribution.Compat.Directory (getHomeDirectory) -- |Where ghc keeps the --user files. -- |return the file, whether it exists, and whether it's readable localPackageConfig :: IO FilePath localPackageConfig = do u <- getHomeDirectory return $ (u `joinFileName` ".ghc-packages") -- |If the package file doesn't exist, we should try to create it. If -- it already exists, do nothing and return true. This does not take -- into account whether it is readable or writeable. maybeCreateLocalPackageConfig :: IO Bool -- ^success? maybeCreateLocalPackageConfig = do f <- localPackageConfig exists <- doesFileExist f unless exists $ (try (writeFile f "[]\n") >> return ()) doesFileExist f -- |Helper function for canReadPackageConfig and canWritePackageConfig checkPermission :: (Permissions -> Bool) -> IO Bool checkPermission perm = do f <- localPackageConfig exists <- doesFileExist f if exists then getPermissions f >>= (return . perm) else return False -- |Check for read permission on the localPackageConfig canReadLocalPackageConfig :: IO Bool canReadLocalPackageConfig = checkPermission readable -- |Check for write permission on the localPackageConfig canWriteLocalPackageConfig :: IO Bool canWriteLocalPackageConfig = checkPermission writable -- ----------------------------------------------------------------------------- -- GHC 6.2 PackageConfig type -- Until GHC supports the InstalledPackageInfo type above, we use its -- existing PackagConfig type. mkGHCPackageConfig :: PackageDescription -> LocalBuildInfo -> GHCPackageConfig mkGHCPackageConfig pkg_descr lbi = defaultGHCPackageConfig { name = pkg_name, auto = True, import_dirs = [mkLibDir pkg_descr lbi NoCopyDest], library_dirs = (mkLibDir pkg_descr lbi NoCopyDest: maybe [] (extraLibDirs . libBuildInfo) (library pkg_descr)), hs_libraries = ["HS"++(showPackageId (package pkg_descr))], extra_libraries = maybe [] (extraLibs . libBuildInfo) (library pkg_descr), include_dirs = maybe [] (includeDirs . libBuildInfo) (library pkg_descr), c_includes = maybe [] (includes . libBuildInfo) (library pkg_descr), package_deps = map pkgName (packageDeps lbi) } where pkg_name = pkgName (package pkg_descr) data GHCPackageConfig = GHCPackage { name :: String, auto :: Bool, import_dirs :: [String], source_dirs :: [String], library_dirs :: [String], hs_libraries :: [String], extra_libraries :: [String], include_dirs :: [String], c_includes :: [String], package_deps :: [String], extra_ghc_opts :: [String], extra_cc_opts :: [String], extra_ld_opts :: [String], framework_dirs :: [String], -- ignored everywhere but on Darwin/MacOS X extra_frameworks:: [String] -- ignored everywhere but on Darwin/MacOS X } defaultGHCPackageConfig :: GHCPackageConfig defaultGHCPackageConfig = GHCPackage { name = error "defaultPackage", auto = False, import_dirs = [], source_dirs = [], library_dirs = [], hs_libraries = [], extra_libraries = [], include_dirs = [], c_includes = [], package_deps = [], extra_ghc_opts = [], extra_cc_opts = [], extra_ld_opts = [], framework_dirs = [], extra_frameworks= [] } -- --------------------------------------------------------------------------- -- Pretty printing package info showGHCPackageConfig :: GHCPackageConfig -> String showGHCPackageConfig pkg = render $ text "Package" $$ nest 3 (braces ( sep (punctuate comma [ text "name = " <> text (show (name pkg)), text "auto = " <> text (show (auto pkg)), dumpField "import_dirs" (import_dirs pkg), dumpField "source_dirs" (source_dirs pkg), dumpField "library_dirs" (library_dirs pkg), dumpField "hs_libraries" (hs_libraries pkg), dumpField "extra_libraries" (extra_libraries pkg), dumpField "include_dirs" (include_dirs pkg), dumpField "c_includes" (c_includes pkg), dumpField "package_deps" (package_deps pkg), dumpField "extra_ghc_opts" (extra_ghc_opts pkg), dumpField "extra_cc_opts" (extra_cc_opts pkg), dumpField "extra_ld_opts" (extra_ld_opts pkg), dumpField "framework_dirs" (framework_dirs pkg), dumpField "extra_frameworks"(extra_frameworks pkg) ]))) dumpField :: String -> [String] -> Doc dumpField name' val = hang (text name' <+> equals) 2 (dumpFieldContents val) dumpFieldContents :: [String] -> Doc dumpFieldContents val = brackets (sep (punctuate comma (map (text . show) val))) hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/Install.hs0000644006511100651110000001253510504340326023420 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Install -- Copyright : Isaac Jones 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Explanation: Perform the \"@.\/setup install@\" action. Move files into -- place based on the prefix argument. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.Install ( install, #ifdef DEBUG hunitTests #endif ) where #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604 #if __GLASGOW_HASKELL__ < 603 #include "config.h" #else #include "ghcconfig.h" #endif #endif import Distribution.PackageDescription ( PackageDescription(..), setupMessage, hasLibs, withLib, withExe ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), mkLibDir, mkBinDir, mkDataDir, mkProgDir, mkHaddockDir) import Distribution.Simple.Utils(copyFileVerbose, die, haddockPref, copyDirectoryRecursiveVerbose) import Distribution.Compiler (CompilerFlavor(..), Compiler(..)) import Distribution.Setup (CopyFlags(..), CopyDest(..)) import Distribution.Compat.Directory(createDirectoryIfMissing) import Distribution.Compat.FilePath(splitFileName,joinFileName) import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.JHC as JHC -- import qualified Distribution.Simple.NHC as NHC import qualified Distribution.Simple.Hugs as Hugs import Control.Monad(when) import Distribution.Compat.Directory(createDirectoryIfMissing, doesDirectoryExist) import Distribution.Compat.FilePath(splitFileName,joinFileName) #ifdef DEBUG import HUnit (Test) #endif -- |FIX: nhc isn't implemented yet. install :: PackageDescription -> LocalBuildInfo -> CopyFlags -> IO () install pkg_descr lbi (CopyFlags copydest verbose) = do let dataFilesExist = not (null (dataFiles pkg_descr)) docExists <- doesDirectoryExist haddockPref when (verbose >= 4) (putStrLn ("directory " ++ haddockPref ++ " does exist: " ++ show docExists)) when (dataFilesExist || docExists) $ do let dataPref = mkDataDir pkg_descr lbi copydest createDirectoryIfMissing True dataPref flip mapM_ (dataFiles pkg_descr) $ \ file -> do let (dir, _) = splitFileName file createDirectoryIfMissing True (dataPref `joinFileName` dir) copyFileVerbose verbose file (dataPref `joinFileName` file) when docExists $ do let targetDir = mkHaddockDir pkg_descr lbi copydest createDirectoryIfMissing True targetDir copyDirectoryRecursiveVerbose verbose haddockPref targetDir -- setPermissionsRecursive [Read] targetDir let buildPref = buildDir lbi let libPref = mkLibDir pkg_descr lbi copydest let binPref = mkBinDir pkg_descr lbi copydest setupMessage ("Installing: " ++ libPref ++ " & " ++ binPref) pkg_descr case compilerFlavor (compiler lbi) of GHC -> do when (hasLibs pkg_descr) (GHC.installLib verbose (withPrograms lbi) (withVanillaLib lbi) (withProfLib lbi) (withGHCiLib lbi) libPref buildPref pkg_descr) GHC.installExe verbose binPref buildPref pkg_descr JHC -> do withLib pkg_descr () $ JHC.installLib verbose libPref buildPref pkg_descr withExe pkg_descr $ JHC.installExe verbose binPref buildPref pkg_descr Hugs -> do let progPref = mkProgDir pkg_descr lbi copydest let targetProgPref = mkProgDir pkg_descr lbi NoCopyDest Hugs.install verbose libPref progPref binPref targetProgPref buildPref pkg_descr _ -> die ("only installing with GHC, JHC or Hugs is implemented") return () -- register step should be performed by caller. -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ #ifdef DEBUG hunitTests :: [Test] hunitTests = [] #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/NHC.hs0000644006511100651110000000536510504340326022425 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.NHC -- Copyright : Isaac Jones 2003-2006 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- {- Copyright (c) 2003-2005, Isaac Jones All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.NHC ( build{-, install -} ) where import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..), Library(..), libModules, hcOptions) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) ) import Distribution.Simple.Utils( rawSystemExit ) import Distribution.Compiler ( Compiler(..), CompilerFlavor(..), extensionsToNHCFlag ) -- |FIX: For now, the target must contain a main module. Not used -- ATM. Re-add later. build :: PackageDescription -> LocalBuildInfo -> Int -> IO () build pkg_descr lbi verbose = do -- Unsupported extensions have already been checked by configure let flags = snd $ extensionsToNHCFlag (maybe [] (extensions . libBuildInfo) (library pkg_descr)) rawSystemExit verbose (compilerPath (compiler lbi)) (["-nhc98"] ++ flags ++ maybe [] (hcOptions NHC . options . libBuildInfo) (library pkg_descr) ++ (libModules pkg_descr)) hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/LocalBuildInfo.hs0000644006511100651110000002702210504340326024635 0ustar rossross{-# OPTIONS_GHC -cpp -fffi #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.LocalBuildInfo -- Copyright : Isaac Jones 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Definition of the LocalBuildInfo data type. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), default_prefix, default_bindir, default_libdir, default_libsubdir, default_libexecdir, default_datadir, default_datasubdir, mkLibDir, mkLibDirRel, mkBinDir, mkBinDirRel, mkLibexecDir, mkLibexecDirRel, mkDataDir, mkDataDirRel, mkHaddockDir, mkProgDir, absolutePath, prefixRelPath, substDir, distPref, srcPref, autogenModulesDir, mkIncludeDir ) where import Distribution.Program (ProgramConfiguration) import Distribution.PackageDescription (PackageDescription(..)) import Distribution.Package (PackageIdentifier(..), showPackageId) import Distribution.Compiler (Compiler(..), CompilerFlavor(..), showCompilerId) import Distribution.Setup (CopyDest(..)) import Distribution.Compat.FilePath #if mingw32_HOST_OS || mingw32_TARGET_OS import Data.Maybe (fromMaybe) import Distribution.PackageDescription (hasLibs) import Foreign import Foreign.C #endif -- |Data cached after configuration step. data LocalBuildInfo = LocalBuildInfo { prefix :: FilePath, -- ^ The installation directory (eg. @/usr/local@, or -- @C:/Program Files/foo-1.2@ on Windows. bindir :: FilePath, -- ^ The bin directory libdir :: FilePath, -- ^ The lib directory libsubdir :: FilePath, -- ^ Subdirectory of libdir into which libraries are installed libexecdir :: FilePath, -- ^ The lib directory datadir :: FilePath, -- ^ The data directory datasubdir :: FilePath, -- ^ Subdirectory of datadir into which data files are installed compiler :: Compiler, -- ^ The compiler we're building with buildDir :: FilePath, -- ^ Where to put the result of building. packageDeps :: [PackageIdentifier], -- ^ Which packages we depend on, /exactly/. -- The 'Distribution.PackageDescription.PackageDescription' -- specifies a set of build dependencies -- that must be satisfied in terms of version ranges. This -- field fixes those dependencies to the specific versions -- available on this machine for this compiler. withPrograms :: ProgramConfiguration, -- location and args for all programs userConf :: Bool, -- ^Was this package configured with --user? withHappy :: Maybe FilePath, -- ^Might be the location of the Happy executable. withAlex :: Maybe FilePath, -- ^Might be the location of the Alex executable. withHsc2hs :: Maybe FilePath, -- ^Might be the location of the Hsc2hs executable. withC2hs :: Maybe FilePath, -- ^Might be the location of the C2hs executable. withCpphs :: Maybe FilePath, -- ^Might be the location of the Cpphs executable. withGreencard :: Maybe FilePath, -- ^Might be the location of the GreenCard executable. withVanillaLib:: Bool, -- ^Whether to build normal libs. withProfLib :: Bool, -- ^Whether to build profiling versions of libs. withProfExe :: Bool, -- ^Whether to build executables for profiling. withGHCiLib :: Bool, -- ^Whether to build libs suitable for use with GHCi. splitObjs :: Bool -- ^Use -split-objs with GHC, if available } deriving (Read, Show) -- ------------------------------------------------------------ -- * Some Paths -- ------------------------------------------------------------ distPref :: FilePath distPref = "dist" srcPref :: FilePath srcPref = distPref `joinFileName` "src" -- |The directory in which we put auto-generated modules autogenModulesDir :: LocalBuildInfo -> String autogenModulesDir lbi = buildDir lbi `joinFileName` "autogen" -- |The place where install-includes are installed, relative to libdir mkIncludeDir :: FilePath -> FilePath mkIncludeDir = (`joinFileName` "include") -- ----------------------------------------------------------------------------- -- Default directories {- The defaults are as follows: Windows: prefix = C:\Program Files bindir = $prefix\$pkgid libdir = $prefix\Haskell libsubdir = $pkgid\$compiler datadir = $prefix (for an executable) = $prefix\Common Files (for a library) datasubdir = $pkgid libexecdir = $prefix\$pkgid Unix: prefix = /usr/local bindir = $prefix/bin libdir = $prefix/lib/$pkgid/$compiler libsubdir = $pkgid/$compiler datadir = $prefix/share/$pkgid datasubdir = $pkgid libexecdir = $prefix/libexec -} default_prefix :: IO String #if mingw32_HOST_OS || mingw32_TARGET_OS # if __HUGS__ default_prefix = return "C:\\Program Files" # else default_prefix = getProgramFilesDir # endif #else default_prefix = return "/usr/local" #endif #if mingw32_HOST_OS || mingw32_TARGET_OS getProgramFilesDir = do m <- shGetFolderPath csidl_PROGRAM_FILES return (fromMaybe "C:\\Program Files" m) getCommonFilesDir = do m <- shGetFolderPath csidl_PROGRAM_FILES_COMMON case m of Nothing -> getProgramFilesDir Just s -> return s shGetFolderPath id = allocaBytes long_path_size $ \pPath -> do r <- c_SHGetFolderPath nullPtr id nullPtr 0 pPath if (r /= 0) then return Nothing else do s <- peekCString pPath; return (Just s) where long_path_size = 1024 csidl_PROGRAM_FILES = 0x0026 :: CInt csidl_PROGRAM_FILES_COMMON = 0x002b :: CInt foreign import stdcall unsafe "shlobj.h SHGetFolderPathA" c_SHGetFolderPath :: Ptr () -> CInt -> Ptr () -> CInt -> CString -> IO CInt #endif default_bindir :: FilePath default_bindir = "$prefix" `joinFileName` #if mingw32_HOST_OS || mingw32_TARGET_OS "Haskell" `joinFileName` "bin" #else "bin" #endif default_libdir :: Compiler -> FilePath default_libdir hc = "$prefix" `joinFileName` #if mingw32_HOST_OS || mingw32_TARGET_OS "Haskell" #else "lib" #endif default_libsubdir :: Compiler -> FilePath default_libsubdir hc = case compilerFlavor hc of Hugs -> "hugs" `joinFileName` "packages" `joinFileName` "$pkg" JHC -> "$compiler" _ -> "$pkgid" `joinFileName` "$compiler" default_libexecdir :: FilePath default_libexecdir = "$prefix" `joinFileName` #if mingw32_HOST_OS || mingw32_TARGET_OS "$pkgid" #else "libexec" #endif default_datadir :: PackageDescription -> IO FilePath default_datadir pkg_descr #if mingw32_HOST_OS || mingw32_TARGET_OS | hasLibs pkg_descr = getCommonFilesDir | otherwise = return ("$prefix" `joinFileName` "Haskell") #else = return ("$prefix" `joinFileName` "share") #endif default_datasubdir :: FilePath default_datasubdir = "$pkgid" mkBinDir :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath mkBinDir pkg_descr lbi copydest = absolutePath pkg_descr lbi copydest (bindir lbi) mkBinDirRel :: PackageDescription -> LocalBuildInfo -> CopyDest -> Maybe FilePath mkBinDirRel pkg_descr lbi copydest = prefixRelPath pkg_descr lbi copydest (bindir lbi) mkLibDir :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath mkLibDir pkg_descr lbi copydest = absolutePath pkg_descr lbi copydest (libdir lbi `joinFileName` libsubdir lbi) mkLibDirRel :: PackageDescription -> LocalBuildInfo -> CopyDest -> Maybe FilePath mkLibDirRel pkg_descr lbi copydest = prefixRelPath pkg_descr lbi copydest (libdir lbi `joinFileName` libsubdir lbi) mkLibexecDir :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath mkLibexecDir pkg_descr lbi copydest = absolutePath pkg_descr lbi copydest (libexecdir lbi) mkLibexecDirRel :: PackageDescription -> LocalBuildInfo -> CopyDest -> Maybe FilePath mkLibexecDirRel pkg_descr lbi copydest = prefixRelPath pkg_descr lbi copydest (libexecdir lbi) mkDataDir :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath mkDataDir pkg_descr lbi copydest = absolutePath pkg_descr lbi copydest (datadir lbi `joinFileName` datasubdir lbi) mkDataDirRel :: PackageDescription -> LocalBuildInfo -> CopyDest -> Maybe FilePath mkDataDirRel pkg_descr lbi copydest = prefixRelPath pkg_descr lbi copydest (datadir lbi `joinFileName` datasubdir lbi) mkHaddockDir :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath mkHaddockDir pkg_descr lbi copydest = foldl1 joinPaths [mkDataDir pkg_descr lbi copydest, "doc", "html"] -- | Directory for program modules (Hugs only). mkProgDir :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath mkProgDir pkg_descr lbi copydest = absolutePath pkg_descr lbi copydest (libdir lbi) `joinFileName` "hugs" `joinFileName` "programs" prefixRelPath :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath -> Maybe FilePath prefixRelPath pkg_descr lbi0 copydest ('$':'p':'r':'e':'f':'i':'x':s) = Just $ case s of (c:s) | isPathSeparator c -> substDir pkg_descr lbi s s -> substDir pkg_descr lbi s where lbi = case copydest of CopyPrefix d -> lbi0{prefix=d} _otherwise -> lbi0 prefixRelPath pkg_descr lbi copydest s = Nothing absolutePath :: PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath -> FilePath absolutePath pkg_descr lbi copydest s = case copydest of NoCopyDest -> substDir pkg_descr lbi s CopyPrefix d -> substDir pkg_descr lbi{prefix=d} s CopyTo p -> p `joinFileName` (dropAbsolutePrefix (substDir pkg_descr lbi s)) substDir :: PackageDescription -> LocalBuildInfo -> String -> String substDir pkg_descr lbi s = loop s where loop "" = "" loop ('$':'p':'r':'e':'f':'i':'x':s) = prefix lbi ++ loop s loop ('$':'c':'o':'m':'p':'i':'l':'e':'r':s) = showCompilerId (compiler lbi) ++ loop s loop ('$':'p':'k':'g':'i':'d':s) = showPackageId (package pkg_descr) ++ loop s loop ('$':'p':'k':'g':s) = pkgName (package pkg_descr) ++ loop s loop ('$':'v':'e':'r':'s':'i':'o':'n':s) = show (pkgVersion (package pkg_descr)) ++ loop s loop ('$':'$':s) = '$' : loop s loop (c:s) = c : loop s hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/Register.hs0000644006511100651110000003374610504340326023605 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Register -- Copyright : Isaac Jones 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Explanation: Perform the \"@.\/setup register@\" action. -- Uses a drop-file for HC-PKG. See also "Distribution.InstalledPackageInfo". {- Copyright (c) 2003-2004, Isaac Jones All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.Register ( register, unregister, writeInstalledConfig, removeInstalledConfig, installedPkgConfigFile, regScriptLocation, unregScriptLocation, #ifdef DEBUG hunitTests #endif ) where #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604 #if __GLASGOW_HASKELL__ < 603 #include "config.h" #else #include "ghcconfig.h" #endif #endif import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), mkLibDir, mkHaddockDir, mkIncludeDir) import Distribution.Compiler (CompilerFlavor(..), Compiler(..)) import Distribution.Setup (RegisterFlags(..), CopyDest(..), userOverride) import Distribution.PackageDescription (setupMessage, PackageDescription(..), BuildInfo(..), Library(..), haddockName) import Distribution.Package (PackageIdentifier(..), showPackageId) import Distribution.Version (Version(..)) import Distribution.InstalledPackageInfo (InstalledPackageInfo, showInstalledPackageInfo, emptyInstalledPackageInfo) import qualified Distribution.InstalledPackageInfo as IPI import Distribution.Simple.Utils (rawSystemExit, copyFileVerbose, die) import Distribution.Simple.Hugs (hugsPackageDir) import Distribution.Simple.GHCPackageConfig (mkGHCPackageConfig, showGHCPackageConfig) import qualified Distribution.Simple.GHCPackageConfig as GHC (localPackageConfig, canWriteLocalPackageConfig, maybeCreateLocalPackageConfig) import Distribution.Compat.Directory (createDirectoryIfMissing,removeDirectoryRecursive, setPermissions, getPermissions, Permissions(executable) ) import Distribution.Compat.FilePath (joinFileName, joinPaths, splitFileName, isAbsolutePath) import System.Directory(doesFileExist, removeFile, getCurrentDirectory) import System.IO.Error (try) import Control.Monad (when, unless) import Data.Maybe (isNothing, fromJust) import Data.List (partition) #ifdef DEBUG import HUnit (Test) #endif regScriptLocation :: FilePath #if mingw32_HOST_OS || mingw32_TARGET_OS regScriptLocation = "register.bat" #else regScriptLocation = "register.sh" #endif unregScriptLocation :: FilePath #if mingw32_HOST_OS || mingw32_TARGET_OS unregScriptLocation = "unregister.bat" #else unregScriptLocation = "unregister.sh" #endif -- ----------------------------------------------------------------------------- -- Registration register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO () register pkg_descr lbi regFlags | isNothing (library pkg_descr) = do setupMessage "No package to register" pkg_descr return () | otherwise = do let ghc_63_plus = compilerVersion (compiler lbi) >= Version [6,3] [] genScript = regGenScript regFlags verbose = regVerbose regFlags user = regUser regFlags `userOverride` userConf lbi inplace = regInPlace regFlags setupMessage (if genScript then ("Writing registration script: " ++ regScriptLocation) else "Registering") pkg_descr case compilerFlavor (compiler lbi) of GHC -> do config_flags <- if user then if ghc_63_plus then return ["--user"] else do GHC.maybeCreateLocalPackageConfig localConf <- GHC.localPackageConfig pkgConfWriteable <- GHC.canWriteLocalPackageConfig when (not pkgConfWriteable && not genScript) $ userPkgConfErr localConf return ["--config-file=" ++ localConf] else return [] let instConf = if inplace then inplacePkgConfigFile else installedPkgConfigFile instConfExists <- doesFileExist instConf when (not instConfExists && not genScript) $ do when (verbose > 0) $ putStrLn ("create " ++ instConf) writeInstalledConfig pkg_descr lbi inplace let register_flags | ghc_63_plus = "update": #if !(mingw32_HOST_OS || mingw32_TARGET_OS) if genScript then [] else #endif [instConf] | otherwise = "--update-package": #if !(mingw32_HOST_OS || mingw32_TARGET_OS) if genScript then [] else #endif ["--input-file="++instConf] let allFlags = register_flags ++ config_flags ++ if ghc_63_plus && genScript then ["-"] else [] let pkgTool = case regWithHcPkg regFlags of Just f -> f Nothing -> compilerPkgTool (compiler lbi) if genScript then do cfg <- showInstalledConfig pkg_descr lbi inplace rawSystemPipe regScriptLocation verbose cfg pkgTool allFlags else rawSystemExit verbose pkgTool allFlags Hugs -> do when inplace $ die "--inplace is not supported with Hugs" createDirectoryIfMissing True (hugsPackageDir pkg_descr lbi) copyFileVerbose verbose installedPkgConfigFile (hugsPackageDir pkg_descr lbi `joinFileName` "package.conf") JHC -> when (verbose > 0) $ putStrLn "registering for JHC (nothing to do)" _ -> die ("only registering with GHC is implemented") userPkgConfErr :: String -> IO a userPkgConfErr local_conf = die ("--user flag passed, but cannot write to local package config: " ++ local_conf ) -- ----------------------------------------------------------------------------- -- The installed package config -- |Register doesn't drop the register info file, it must be done in a -- separate step. writeInstalledConfig :: PackageDescription -> LocalBuildInfo -> Bool -> IO () writeInstalledConfig pkg_descr lbi inplace = do pkg_config <- showInstalledConfig pkg_descr lbi inplace writeFile (if inplace then inplacePkgConfigFile else installedPkgConfigFile) (pkg_config ++ "\n") -- |Create a string suitable for writing out to the package config file showInstalledConfig :: PackageDescription -> LocalBuildInfo -> Bool -> IO String showInstalledConfig pkg_descr lbi inplace | (case compilerFlavor hc of GHC -> True; _ -> False) && compilerVersion hc < Version [6,3] [] = if inplace then error "--inplace not supported for GHC < 6.3" else return (showGHCPackageConfig (mkGHCPackageConfig pkg_descr lbi)) | otherwise = do cfg <- mkInstalledPackageInfo pkg_descr lbi inplace return (showInstalledPackageInfo cfg) where hc = compiler lbi removeInstalledConfig :: IO () removeInstalledConfig = do try (removeFile installedPkgConfigFile) >> return () try (removeFile inplacePkgConfigFile) >> return () installedPkgConfigFile :: String installedPkgConfigFile = ".installed-pkg-config" inplacePkgConfigFile :: String inplacePkgConfigFile = ".inplace-pkg-config" -- ----------------------------------------------------------------------------- -- Making the InstalledPackageInfo mkInstalledPackageInfo :: PackageDescription -> LocalBuildInfo -> Bool -> IO InstalledPackageInfo mkInstalledPackageInfo pkg_descr lbi inplace = do pwd <- getCurrentDirectory let lib = fromJust (library pkg_descr) -- checked for Nothing earlier bi = libBuildInfo lib build_dir = pwd `joinFileName` buildDir lbi libdir = mkLibDir pkg_descr lbi NoCopyDest incdir = mkIncludeDir libdir (absinc,relinc) = partition isAbsolutePath (includeDirs bi) haddockDir = mkHaddockDir pkg_descr lbi NoCopyDest haddockFile = joinPaths haddockDir (haddockName pkg_descr) in return emptyInstalledPackageInfo{ IPI.package = package pkg_descr, IPI.license = license pkg_descr, IPI.copyright = copyright pkg_descr, IPI.maintainer = maintainer pkg_descr, IPI.author = author pkg_descr, IPI.stability = stability pkg_descr, IPI.homepage = homepage pkg_descr, IPI.pkgUrl = pkgUrl pkg_descr, IPI.description = description pkg_descr, IPI.category = category pkg_descr, IPI.exposed = True, IPI.exposedModules = exposedModules lib, IPI.hiddenModules = otherModules bi, IPI.importDirs = [if inplace then build_dir else libdir], IPI.libraryDirs = (if inplace then build_dir else libdir) : extraLibDirs bi, IPI.hsLibraries = ["HS" ++ showPackageId (package pkg_descr)], IPI.extraLibraries = extraLibs bi, IPI.includeDirs = absinc ++ if inplace then map (pwd `joinFileName`) relinc else [incdir], IPI.includes = includes bi ++ map (snd.splitFileName) (installIncludes bi), IPI.depends = packageDeps lbi, IPI.hugsOptions = concat [opts | (Hugs,opts) <- options bi], IPI.ccOptions = ccOptions bi, IPI.ldOptions = ldOptions bi, IPI.frameworkDirs = [], IPI.frameworks = frameworks bi, IPI.haddockInterfaces = [haddockFile], IPI.haddockHTMLs = [haddockDir] } -- ----------------------------------------------------------------------------- -- Unregistration unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO () unregister pkg_descr lbi regFlags = do setupMessage "Unregistering" pkg_descr let ghc_63_plus = compilerVersion (compiler lbi) >= Version [6,3] [] genScript = regGenScript regFlags verbose = regVerbose regFlags user = regUser regFlags `userOverride` userConf lbi case compilerFlavor (compiler lbi) of GHC -> do config_flags <- if user then if ghc_63_plus then return ["--user"] else do instConfExists <- doesFileExist installedPkgConfigFile localConf <- GHC.localPackageConfig unless instConfExists (userPkgConfErr localConf) return ["--config-file=" ++ localConf] else return [] let removeCmd = if ghc_63_plus then ["unregister",showPackageId (package pkg_descr)] else ["--remove-package="++(pkgName $ package pkg_descr)] let pkgTool = case regWithHcPkg regFlags of Just f -> f Nothing -> compilerPkgTool (compiler lbi) rawSystemEmit unregScriptLocation genScript verbose pkgTool (removeCmd++config_flags) Hugs -> do try $ removeDirectoryRecursive (hugsPackageDir pkg_descr lbi) return () _ -> die ("only unregistering with GHC and Hugs is implemented") -- |Like rawSystemExit, but optionally emits to a script instead of -- exiting. FIX: chmod +x? rawSystemEmit :: FilePath -- ^Script name -> Bool -- ^if true, emit, if false, run -> Int -- ^Verbosity -> FilePath -- ^Program to run -> [String] -- ^Args -> IO () rawSystemEmit _ False verbosity path args = rawSystemExit verbosity path args rawSystemEmit scriptName True verbosity path args = do #if mingw32_HOST_OS || mingw32_TARGET_OS writeFile scriptName ("@" ++ path ++ concatMap (' ':) args) #else writeFile scriptName ("#!/bin/sh\n\n" ++ (path ++ concatMap (' ':) args) ++ "\n") p <- getPermissions scriptName setPermissions scriptName p{executable=True} #endif -- |Like rawSystemEmit, except it has string for pipeFrom. FIX: chmod +x rawSystemPipe :: FilePath -- ^Script location -> Int -- ^Verbosity -> String -- ^where to pipe from -> FilePath -- ^Program to run -> [String] -- ^Args -> IO () rawSystemPipe scriptName verbose pipeFrom path args = do #if mingw32_HOST_OS || mingw32_TARGET_OS writeFile scriptName ("@" ++ path ++ concatMap (' ':) args) #else writeFile scriptName ("#!/bin/sh\n\n" ++ "echo '" ++ pipeFrom ++ "' | " ++ (path ++ concatMap (' ':) args) ++ "\n") p <- getPermissions scriptName setPermissions scriptName p{executable=True} #endif -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ #ifdef DEBUG hunitTests :: [Test] hunitTests = [] #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple/SrcDist.hs0000644006511100651110000001742010504340326023363 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.SrcDist -- Copyright : Simon Marlow 2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- {- Copyright (c) 2003-2004, Simon Marlow All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} -- NOTE: FIX: we don't have a great way of testing this module, since -- we can't easily look inside a tarball once its created. module Distribution.Simple.SrcDist ( sdist #ifdef DEBUG ,hunitTests #endif ) where import Distribution.PackageDescription (PackageDescription(..), BuildInfo(..), Executable(..), Library(..), setupMessage, libModules) import Distribution.Package (showPackageId, PackageIdentifier(pkgVersion)) import Distribution.Version (Version(versionBranch)) import Distribution.Simple.Utils (smartCopySources, die, findPackageDesc, findFile, copyFileVerbose) import Distribution.Setup (SDistFlags(..)) import Distribution.PreProcess (PPSuffixHandler, ppSuffixes, removePreprocessed) import Control.Monad(when) import Data.Char (isSpace, toLower) import Data.List (isPrefixOf) import System.Cmd (system) import System.Time (getClockTime, toCalendarTime, CalendarTime(..)) import Distribution.Compat.Directory (doesFileExist, doesDirectoryExist, getCurrentDirectory, createDirectoryIfMissing, removeDirectoryRecursive) import Distribution.Compat.FilePath (joinFileName, splitFileName) #ifdef DEBUG import HUnit (Test) #endif -- |Create a source distribution. FIX: Calls tar directly (won't work -- on windows). sdist :: PackageDescription -> SDistFlags -- verbose & snapshot -> FilePath -- ^build prefix (temp dir) -> FilePath -- ^TargetPrefix -> [PPSuffixHandler] -- ^ extra preprocessors (includes suffixes) -> IO () sdist pkg_descr_orig (SDistFlags snapshot verbose) tmpDir targetPref pps = do time <- getClockTime ct <- toCalendarTime time let date = ctYear ct*10000 + (fromEnum (ctMonth ct) + 1)*100 + ctDay ct let pkg_descr | snapshot = updatePackage (updatePkgVersion (updateVersionBranch (++ [date]))) pkg_descr_orig | otherwise = pkg_descr_orig setupMessage "Building source dist for" pkg_descr ex <- doesDirectoryExist tmpDir when ex (die $ "Source distribution already in place. please move: " ++ tmpDir) let targetDir = tmpDir `joinFileName` (nameVersion pkg_descr) createDirectoryIfMissing True targetDir -- maybe move the library files into place maybe (return ()) (\l -> prepareDir verbose targetDir pps (libModules pkg_descr) (libBuildInfo l)) (library pkg_descr) -- move the executables into place flip mapM_ (executables pkg_descr) $ \ (Executable _ mainPath exeBi) -> do prepareDir verbose targetDir pps [] exeBi srcMainFile <- findFile (hsSourceDirs exeBi) mainPath copyFileTo verbose targetDir srcMainFile flip mapM_ (dataFiles pkg_descr) $ \ file -> do let (dir, _) = splitFileName file createDirectoryIfMissing True (targetDir `joinFileName` dir) copyFileVerbose verbose file (targetDir `joinFileName` file) when (not (null (licenseFile pkg_descr))) $ copyFileTo verbose targetDir (licenseFile pkg_descr) flip mapM_ (extraSrcFiles pkg_descr) $ \ fpath -> do copyFileTo verbose targetDir fpath -- setup isn't listed in the description file. hsExists <- doesFileExist "Setup.hs" lhsExists <- doesFileExist "Setup.lhs" if hsExists then copyFileTo verbose targetDir "Setup.hs" else if lhsExists then copyFileTo verbose targetDir "Setup.lhs" else writeFile (targetDir `joinFileName` "Setup.hs") $ unlines [ "import Distribution.Simple", "main = defaultMainWithHooks defaultUserHooks"] -- the description file itself descFile <- getCurrentDirectory >>= findPackageDesc let targetDescFile = targetDir `joinFileName` descFile -- We could just writePackageDescription targetDescFile pkg_descr, -- but that would lose comments and formatting. if snapshot then do contents <- readFile descFile writeFile targetDescFile $ unlines $ map (appendVersion date) $ lines $ contents else copyFileVerbose verbose descFile targetDescFile let tarBallFilePath = targetPref `joinFileName` tarBallName pkg_descr system $ "(cd " ++ tmpDir ++ ";tar cf - " ++ (nameVersion pkg_descr) ++ ") | gzip -9 >" ++ tarBallFilePath removeDirectoryRecursive tmpDir putStrLn $ "Source tarball created: " ++ tarBallFilePath where updatePackage f pd = pd { package = f (package pd) } updatePkgVersion f pkg = pkg { pkgVersion = f (pkgVersion pkg) } updateVersionBranch f v = v { versionBranch = f (versionBranch v) } appendVersion :: Int -> String -> String appendVersion n line | "version:" `isPrefixOf` map toLower line = trimTrailingSpace line ++ "." ++ show n | otherwise = line trimTrailingSpace :: String -> String trimTrailingSpace = reverse . dropWhile isSpace . reverse -- |Move the sources into place based on buildInfo prepareDir :: Int -- ^verbose -> FilePath -- ^TargetPrefix -> [PPSuffixHandler] -- ^ extra preprocessors (includes suffixes) -> [String] -- ^Exposed modules -> BuildInfo -> IO () prepareDir verbose inPref pps mods BuildInfo{hsSourceDirs=srcDirs, otherModules=mods', cSources=cfiles} = do let suff = ppSuffixes pps ++ ["hs", "lhs"] smartCopySources verbose srcDirs inPref (mods++mods') suff True True removePreprocessed (map (joinFileName inPref) srcDirs) mods suff mapM_ (copyFileTo verbose inPref) cfiles copyFileTo :: Int -> FilePath -> FilePath -> IO () copyFileTo verbose dir file = do let targetFile = dir `joinFileName` file createDirectoryIfMissing True (fst (splitFileName targetFile)) copyFileVerbose verbose file targetFile ------------------------------------------------------------ -- |The file name of the tarball tarBallName :: PackageDescription -> FilePath tarBallName p = (nameVersion p) ++ ".tar.gz" nameVersion :: PackageDescription -> String nameVersion = showPackageId . package -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ #ifdef DEBUG hunitTests :: [Test] hunitTests = [] #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/PreProcess.hs0000644006511100651110000003127410504340326022647 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.PreProcess -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- {- Copyright (c) 2003-2005, Isaac Jones, Malcolm Wallace All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.PreProcess (preprocessSources, knownSuffixHandlers, ppSuffixes, PPSuffixHandler, PreProcessor, removePreprocessed, removePreprocessedPackage, ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs, ppHappy, ppAlex, ppUnlit ) where import Distribution.PreProcess.Unlit(unlit) import Distribution.PackageDescription (setupMessage, PackageDescription(..), BuildInfo(..), Executable(..), withExe, Library(..), withLib, libModules) import Distribution.Compiler (CompilerFlavor(..), Compiler(..)) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..)) import Distribution.Simple.Utils (rawSystemVerbose, moduleToFilePath, die, dieWithLocation) import Distribution.Version (Version(..)) import Control.Monad (unless) import Data.Maybe (fromMaybe) import Data.List (nub) import System.Exit (ExitCode(..)) import System.Directory (removeFile, getModificationTime) import System.Info (os, arch) import Distribution.Compat.FilePath (splitFileExt, joinFileName, joinFileExt) -- |The interface to a preprocessor, which may be implemented using an -- external program, but need not be. The arguments are the name of -- the input file, the name of the output file and a verbosity level. -- Here is a simple example that merely prepends a comment to the given -- source file: -- -- > ppTestHandler :: PreProcessor -- > ppTestHandler inFile outFile verbose -- > = do when (verbose > 0) $ -- > putStrLn (inFile++" has been preprocessed to "++outFile) -- > stuff <- readFile inFile -- > writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff) -- > return ExitSuccess -- type PreProcessor = FilePath -- Location of the source file in need of preprocessing -> FilePath -- Output filename -> Int -- verbose -> IO ExitCode -- |A preprocessor for turning non-Haskell files with the given extension -- into plain Haskell source files. type PPSuffixHandler = (String, BuildInfo -> LocalBuildInfo -> PreProcessor) -- |Apply preprocessors to the sources from 'hsSourceDirs', to obtain -- a Haskell source file for each module. preprocessSources :: PackageDescription -> LocalBuildInfo -> Int -- ^ verbose -> [PPSuffixHandler] -- ^ preprocessors to try -> IO () preprocessSources pkg_descr lbi verbose handlers = do withLib pkg_descr () $ \ lib -> do setupMessage "Preprocessing library" pkg_descr let bi = libBuildInfo lib let biHandlers = localHandlers bi sequence_ [do retVal <- preprocessModule (hsSourceDirs bi) modu verbose builtinSuffixes biHandlers unless (retVal == ExitSuccess) (die $ "got error code while preprocessing: " ++ modu) | modu <- libModules pkg_descr] unless (null (executables pkg_descr)) $ setupMessage "Preprocessing executables for" pkg_descr withExe pkg_descr $ \ theExe -> do let bi = buildInfo theExe let biHandlers = localHandlers bi sequence_ [do retVal <- preprocessModule (nub $ (hsSourceDirs bi) ++(maybe [] (hsSourceDirs . libBuildInfo) (library pkg_descr))) modu verbose builtinSuffixes biHandlers unless (retVal == ExitSuccess) (die $ "got error code while preprocessing: " ++ modu) | modu <- otherModules bi] where hc = compilerFlavor (compiler lbi) builtinSuffixes | hc == NHC = ["hs", "lhs", "gc"] | otherwise = ["hs", "lhs"] localHandlers bi = [(ext, h bi lbi) | (ext, h) <- handlers] -- |Find the first extension of the file that exists, and preprocess it -- if required. preprocessModule :: [FilePath] -- ^source directories -> String -- ^module name -> Int -- ^verbose -> [String] -- ^builtin suffixes -> [(String, PreProcessor)] -- ^possible preprocessors -> IO ExitCode preprocessModule searchLoc modu verbose builtinSuffixes handlers = do bsrcFiles <- moduleToFilePath searchLoc modu builtinSuffixes psrcFiles <- moduleToFilePath searchLoc modu (map fst handlers) case psrcFiles of [] -> case bsrcFiles of [] -> die ("can't find source for " ++ modu ++ " in " ++ show searchLoc) _ -> return ExitSuccess (psrcFile:_) -> do let (srcStem, ext) = splitFileExt psrcFile pp = fromMaybe (error "Internal error in preProcess module: Just expected") (lookup ext handlers) recomp <- case bsrcFiles of [] -> return True (bsrcFile:_) -> do btime <- getModificationTime bsrcFile ptime <- getModificationTime psrcFile return (btime < ptime) if recomp then pp psrcFile (srcStem `joinFileExt` "hs") verbose else return ExitSuccess removePreprocessedPackage :: PackageDescription -> FilePath -- ^root of source tree (where to look for hsSources) -> [String] -- ^suffixes -> IO () removePreprocessedPackage pkg_descr r suff = do withLib pkg_descr () (\lib -> do let bi = libBuildInfo lib removePreprocessed (map (joinFileName r) (hsSourceDirs bi)) (libModules pkg_descr) suff) withExe pkg_descr (\theExe -> do let bi = buildInfo theExe removePreprocessed (map (joinFileName r) (hsSourceDirs bi)) (otherModules bi) suff) -- |Remove the preprocessed .hs files. (do we need to get some .lhs files too?) removePreprocessed :: [FilePath] -- ^search Location -> [String] -- ^Modules -> [String] -- ^suffixes -> IO () removePreprocessed searchLocs mods suffixesIn = mapM_ removePreprocessedModule mods where removePreprocessedModule m = do -- collect related files fs <- moduleToFilePath searchLocs m otherSuffixes -- does M.hs also exist? hs <- moduleToFilePath searchLocs m ["hs"] unless (null fs) (mapM_ removeFile hs) otherSuffixes = filter (/= "hs") suffixesIn -- ------------------------------------------------------------ -- * known preprocessors -- ------------------------------------------------------------ ppGreenCard :: BuildInfo -> LocalBuildInfo -> PreProcessor ppGreenCard = ppGreenCard' [] ppGreenCard' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor ppGreenCard' inputArgs bi lbi = maybe (ppNone "greencard") pp (withGreencard lbi) where pp greencard inFile outFile verbose = rawSystemVerbose verbose greencard (["-tffi", "-o" ++ outFile, inFile] ++ inputArgs) -- This one is useful for preprocessors that can't handle literate source. -- We also need a way to chain preprocessors. ppUnlit :: PreProcessor ppUnlit inFile outFile verbose = do contents <- readFile inFile writeFile outFile (unlit inFile contents) return ExitSuccess ppCpp :: BuildInfo -> LocalBuildInfo -> PreProcessor ppCpp = ppCpp' [] ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor ppCpp' inputArgs bi lbi = case withCpphs lbi of Just path -> use_cpphs path Nothing | compilerFlavor hc == GHC -> use_ghc _otherwise -> ppNone "cpphs (or GHC)" where hc = compiler lbi use_cpphs cpphs inFile outFile verbose = rawSystemVerbose verbose cpphs cpphsArgs where cpphsArgs = ("-O"++outFile) : inFile : "--noline" : "--strip" : extraArgs extraArgs = sysDefines ++ cppOptions bi lbi ++ inputArgs sysDefines = ["-D" ++ os ++ "_" ++ loc ++ "_OS" | loc <- locations] ++ ["-D" ++ arch ++ "_" ++ loc ++ "_ARCH" | loc <- locations] locations = ["BUILD", "HOST"] use_ghc inFile outFile verbose = rawSystemVerbose verbose (compilerPath hc) (["-E", "-cpp", "-optP-P", "-o", outFile, inFile] ++ extraArgs) ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor ppHsc2hs bi lbi = maybe (ppNone "hsc2hs") pp (withHsc2hs lbi) where pp n = standardPP n (hcDefines (compiler lbi) ++ ["-I" ++ dir | dir <- includeDirs bi] ++ [opt | opt@('-':c:_) <- ccOptions bi, c == 'D' || c == 'I'] ++ ["--cflag=" ++ opt | opt@('-':'U':_) <- ccOptions bi] ++ ["--lflag=-L" ++ dir | dir <- extraLibDirs bi] ++ ["--lflag=-l" ++ lib | lib <- extraLibs bi]) ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor ppC2hs bi lbi = maybe (ppNone "c2hs") pp (withC2hs lbi) where pp n = standardPP n (concat [["-C", opt] | opt <- cppOptions bi lbi]) cppOptions :: BuildInfo -> LocalBuildInfo -> [String] cppOptions bi lbi = hcDefines (compiler lbi) ++ ["-I" ++ dir | dir <- includeDirs bi] ++ [opt | opt@('-':c:_) <- ccOptions bi, c `elem` "DIU"] hcDefines :: Compiler -> [String] hcDefines Compiler { compilerFlavor=GHC, compilerVersion=version } = ["-D__GLASGOW_HASKELL__=" ++ versionInt version] hcDefines Compiler { compilerFlavor=JHC, compilerVersion=version } = ["-D__JHC__=" ++ versionInt version] hcDefines Compiler { compilerFlavor=NHC, compilerVersion=version } = ["-D__NHC__=" ++ versionInt version] hcDefines Compiler { compilerFlavor=Hugs } = ["-D__HUGS__"] hcDefines _ = [] versionInt :: Version -> String versionInt (Version { versionBranch = [] }) = "1" versionInt (Version { versionBranch = [n] }) = show n versionInt (Version { versionBranch = n1:n2:_ }) = show n1 ++ take 2 ('0' : show n2) ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessor ppHappy _ lbi = maybe (ppNone "happy") pp (withHappy lbi) where pp n = standardPP n (hcFlags hc) hc = compilerFlavor (compiler lbi) hcFlags GHC = ["-agc"] hcFlags _ = [] ppAlex :: BuildInfo -> LocalBuildInfo -> PreProcessor ppAlex _ lbi = maybe (ppNone "alex") pp (withAlex lbi) where pp n = standardPP n (hcFlags hc) hc = compilerFlavor (compiler lbi) hcFlags GHC = ["-g"] hcFlags _ = [] standardPP :: String -> [String] -> PreProcessor standardPP eName args inFile outFile verbose = rawSystemVerbose verbose eName (args ++ ["-o", outFile, inFile]) ppNone :: String -> PreProcessor ppNone name inFile _ _ = dieWithLocation inFile Nothing $ "no " ++ name ++ " preprocessor available" -- |Convenience function; get the suffixes of these preprocessors. ppSuffixes :: [ PPSuffixHandler ] -> [String] ppSuffixes = map fst -- |Standard preprocessors: GreenCard, c2hs, hsc2hs, happy, alex and cpphs. knownSuffixHandlers :: [ PPSuffixHandler ] knownSuffixHandlers = [ ("gc", ppGreenCard) , ("chs", ppC2hs) , ("hsc", ppHsc2hs) , ("x", ppAlex) , ("y", ppHappy) , ("ly", ppHappy) , ("cpphs", ppCpp) ] hugs98-plus-Sep2006/packages/Cabal/Distribution/Program.hs0000644006511100651110000002535310504340326022172 0ustar rossrossmodule Distribution.Program( Program(..) , ProgramLocation(..) , ProgramConfiguration(..) , withProgramFlag , programOptsFlag , programOptsField , defaultProgramConfiguration , updateProgram , userSpecifyPath , userSpecifyArgs , lookupProgram , lookupPrograms , rawSystemProgram , rawSystemProgramConf , simpleProgram -- Programs , ghcProgram , ghcPkgProgram , nhcProgram , jhcProgram , hugsProgram , ranlibProgram , arProgram , alexProgram , hsc2hsProgram , c2hsProgram , cpphsProgram , haddockProgram , greencardProgram , ldProgram , cppProgram , pfesetupProgram ) where import qualified Distribution.Compat.Map as Map import Control.Monad(when) import Data.Maybe(catMaybes) import System.Exit (ExitCode) import Distribution.Compat.Directory(findExecutable) import Distribution.Simple.Utils (die, rawSystemVerbose, maybeExit) -- |Represents a program which cabal may call. data Program = Program { -- |The simple name of the program, eg ghc programName :: String -- |The name of this program's binary, eg ghc-6.4 ,programBinName :: String -- |Default command-line args for this program ,programArgs :: [String] -- |Location of the program. eg. \/usr\/bin\/ghc-6.4 ,programLocation :: ProgramLocation } deriving (Read, Show) -- |Similar to Maybe, but tells us whether it's specifed by user or -- not. This includes not just the path, but the program as well. data ProgramLocation = EmptyLocation | UserSpecified FilePath | FoundOnSystem FilePath deriving (Read, Show) data ProgramConfiguration = ProgramConfiguration (Map.Map String Program) -- Read & Show instances are based on listToFM instance Show ProgramConfiguration where show (ProgramConfiguration s) = show $ Map.toAscList s instance Read ProgramConfiguration where readsPrec p s = [(ProgramConfiguration $ Map.fromList $ s', r) | (s', r) <- readsPrec p s ] -- |The default list of programs and their arguments. These programs -- are typically used internally to Cabal. defaultProgramConfiguration :: ProgramConfiguration defaultProgramConfiguration = progListToFM [ haddockProgram , pfesetupProgram , ranlibProgram , simpleProgram "runghc" , simpleProgram "runhugs" , arProgram] -- haddock is currently the only one that really works. {- [ ghcProgram , ghcPkgProgram , nhcProgram , hugsProgram , alexProgram , hsc2hsProgram , c2hsProgram , cpphsProgram , haddockProgram , greencardProgram , ldProgram , cppProgram , pfesetupProgram , ranlib, ar ]-} -- |The flag for giving a path to this program. eg --with-alex=\/usr\/bin\/alex withProgramFlag :: Program -> String withProgramFlag Program{programName=n} = "with-" ++ n -- |The flag for giving args for this program. -- eg --haddock-options=-s http:\/\/foo programOptsFlag :: Program -> String programOptsFlag Program{programName=n} = n ++ "-options" -- |The foo.cabal field for giving args for this program. -- eg haddock-options: -s http:\/\/foo programOptsField :: Program -> String programOptsField = programOptsFlag -- ------------------------------------------------------------ -- * cabal programs -- ------------------------------------------------------------ ghcProgram :: Program ghcProgram = simpleProgram "ghc" ghcPkgProgram :: Program ghcPkgProgram = simpleProgram "ghc-pkg" nhcProgram :: Program nhcProgram = simpleProgram "nhc" jhcProgram :: Program jhcProgram = simpleProgram "jhc" hugsProgram :: Program hugsProgram = simpleProgram "hugs" alexProgram :: Program alexProgram = simpleProgram "alex" ranlibProgram :: Program ranlibProgram = simpleProgram "ranlib" arProgram :: Program arProgram = simpleProgram "ar" hsc2hsProgram :: Program hsc2hsProgram = simpleProgram "hsc2hs" c2hsProgram :: Program c2hsProgram = simpleProgram "c2hs" cpphsProgram :: Program cpphsProgram = simpleProgram "cpphs" haddockProgram :: Program haddockProgram = simpleProgram "haddock" greencardProgram :: Program greencardProgram = simpleProgram "greencard" ldProgram :: Program ldProgram = simpleProgram "ld" cppProgram :: Program cppProgram = simpleProgram "cpp" pfesetupProgram :: Program pfesetupProgram = simpleProgram "pfesetup" -- ------------------------------------------------------------ -- * helpers -- ------------------------------------------------------------ -- |Looks up a program in the given configuration. If there's no -- location information in the configuration, then we use IO to look -- on the system in PATH for the program. If the program is not in -- the configuration at all, we return Nothing. FIX: should we build -- a simpleProgram in that case? Do we want a way to specify NOT to -- find it on the system (populate programLocation). lookupProgram :: String -- simple name of program -> ProgramConfiguration -> IO (Maybe Program) -- the full program lookupProgram name conf = case lookupProgram' name conf of Nothing -> return Nothing Just p@Program{ programLocation= configLoc , programBinName = binName} -> do newLoc <- case configLoc of EmptyLocation -> do maybeLoc <- findExecutable binName return $ maybe EmptyLocation FoundOnSystem maybeLoc a -> return a return $ Just p{programLocation=newLoc} lookupPrograms :: ProgramConfiguration -> IO [(String, Maybe Program)] lookupPrograms conf@(ProgramConfiguration fm) = do let l = Map.elems fm mapM (\p -> do fp <- lookupProgram (programName p) conf return (programName p, fp) ) l -- |User-specify this path. Basically override any path information -- for this program in the configuration. If it's not a known -- program, add it. userSpecifyPath :: String -- ^Program name -> FilePath -- ^user-specified path to filename -> ProgramConfiguration -> ProgramConfiguration userSpecifyPath name path conf'@(ProgramConfiguration conf) = case Map.lookup name conf of Just p -> updateProgram (Just p{programLocation=UserSpecified path}) conf' Nothing -> updateProgram (Just $ Program name name [] (UserSpecified path)) conf' -- |User-specify the arguments for this program. Basically override -- any args information for this program in the configuration. If it's -- not a known program, add it. userSpecifyArgs :: String -- ^Program name -> String -- ^user-specified args -> ProgramConfiguration -> ProgramConfiguration userSpecifyArgs name args conf'@(ProgramConfiguration conf) = case Map.lookup name conf of Just p -> updateProgram (Just p{programArgs=(words args)}) conf' Nothing -> updateProgram (Just $ Program name name (words args) EmptyLocation) conf' -- |Update this program's entry in the configuration. No changes if -- you pass in Nothing. updateProgram :: Maybe Program -> ProgramConfiguration -> ProgramConfiguration updateProgram (Just p@Program{programName=n}) (ProgramConfiguration conf) = ProgramConfiguration $ Map.insert n p conf updateProgram Nothing conf = conf -- |Runs the given program. rawSystemProgram :: Int -- ^Verbosity -> Program -- ^The program to run -> [String] -- ^Any /extra/ arguments to add -> IO () rawSystemProgram verbose (Program { programLocation=(UserSpecified p) , programArgs=args }) extraArgs = maybeExit $ rawSystemVerbose verbose p (extraArgs ++ args) rawSystemProgram verbose (Program { programLocation=(FoundOnSystem p) , programArgs=args }) extraArgs = maybeExit $ rawSystemVerbose verbose p (args ++ extraArgs) rawSystemProgram _ (Program { programLocation=EmptyLocation , programName=n}) _ = die ("Error: Could not find location for program: " ++ n) rawSystemProgramConf :: Int -- ^verbosity -> String -- ^The name of the program to run -> ProgramConfiguration -- ^look up the program here -> [String] -- ^Any /extra/ arguments to add -> IO () rawSystemProgramConf verbose progName programConf extraArgs = do prog <- do mProg <- lookupProgram progName programConf case mProg of Nothing -> (die (progName ++ " command not found")) Just h -> return h rawSystemProgram verbose prog extraArgs -- ------------------------------------------------------------ -- * Internal helpers -- ------------------------------------------------------------ -- Export? lookupProgram' :: String -> ProgramConfiguration -> Maybe Program lookupProgram' s (ProgramConfiguration conf) = Map.lookup s conf progListToFM :: [Program] -> ProgramConfiguration progListToFM progs = foldl (\ (ProgramConfiguration conf') p@(Program {programName=n}) -> ProgramConfiguration (Map.insert n p conf')) (ProgramConfiguration Map.empty) progs simpleProgram :: String -> Program simpleProgram s = Program s s [] EmptyLocation hugs98-plus-Sep2006/packages/Cabal/Distribution/Setup.hs0000644006511100651110000010614010504340326021655 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Setup -- Copyright : Isaac Jones 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Explanation: Data types and parser for the standard command-line -- setup. Will also return commands it doesn't know about. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Setup (--parseArgs, module Distribution.Compiler, Action(..), ConfigFlags(..), emptyConfigFlags, configureArgs, CopyFlags(..), CopyDest(..), InstallFlags(..), emptyInstallFlags, HaddockFlags(..), emptyHaddockFlags, BuildFlags(..), CleanFlags(..), PFEFlags(..), RegisterFlags(..), emptyRegisterFlags, SDistFlags(..), MaybeUserFlag(..), userOverride, --optionHelpString, #ifdef DEBUG hunitTests, #endif parseGlobalArgs, defaultCompilerFlavor, parseConfigureArgs, parseBuildArgs, parseCleanArgs, parseHaddockArgs, parseProgramaticaArgs, parseTestArgs, parseInstallArgs, parseSDistArgs, parseRegisterArgs, parseUnregisterArgs, parseCopyArgs, reqPathArg, reqDirArg ) where -- Misc: #ifdef DEBUG import HUnit (Test(..)) #endif import Distribution.Compiler (CompilerFlavor(..), Compiler(..)) import Distribution.Simple.Utils (die) import Distribution.Program(ProgramConfiguration(..), userSpecifyPath, userSpecifyArgs) import Data.List(find) import Distribution.Compat.Map (keys) import Distribution.GetOpt import Distribution.Compat.FilePath (platformPath) import System.Exit import System.Environment -- type CommandLineOpts = (Action, -- [String]) -- The un-parsed remainder data Action = ConfigCmd ConfigFlags -- config | BuildCmd -- build | CleanCmd -- clean | CopyCmd CopyDest -- copy (--destdir flag) | HaddockCmd -- haddock | ProgramaticaCmd -- pfesetup | InstallCmd -- install (install-prefix) | SDistCmd -- sdist | TestCmd -- test | RegisterCmd -- register | UnregisterCmd -- unregister | HelpCmd -- help -- | NoCmd -- error case, help case. -- | TestCmd 1.0? -- | BDist -- 1.0 -- | CleanCmd -- clean -- | NoCmd -- error case? -- ------------------------------------------------------------ -- * Flag-related types -- ------------------------------------------------------------ -- | Flags to @configure@ command data ConfigFlags = ConfigFlags { configPrograms :: ProgramConfiguration, -- ^All programs that cabal may run configHcFlavor :: Maybe CompilerFlavor, configHcPath :: Maybe FilePath, -- ^given compiler location configHcPkg :: Maybe FilePath, -- ^given hc-pkg location configHappy :: Maybe FilePath, -- ^Happy path configAlex :: Maybe FilePath, -- ^Alex path configHsc2hs :: Maybe FilePath, -- ^Hsc2hs path configC2hs :: Maybe FilePath, -- ^C2hs path configCpphs :: Maybe FilePath, -- ^Cpphs path configGreencard:: Maybe FilePath, -- ^GreenCard path configVanillaLib :: Bool, -- ^Enable vanilla library configProfLib :: Bool, -- ^Enable profiling in the library configProfExe :: Bool, -- ^Enable profiling in the executables. configPrefix :: Maybe FilePath, -- ^installation prefix configBinDir :: Maybe FilePath, -- ^installation dir for binaries, configLibDir :: Maybe FilePath, -- ^installation dir for object code libraries, configLibSubDir :: Maybe FilePath, -- ^subdirectory of libdir in which libs are installed configLibExecDir :: Maybe FilePath, -- ^installation dir for program executables, configDataDir :: Maybe FilePath, -- ^installation dir for read-only arch-independent data, configDataSubDir :: Maybe FilePath, -- ^subdirectory of datadir in which data files are installed configVerbose :: Int, -- ^verbosity level configUser :: Bool, -- ^--user flag? configGHCiLib :: Bool, -- ^Enable compiling library for GHCi configSplitObjs :: Bool -- ^Enable -split-objs with GHC } emptyConfigFlags :: ProgramConfiguration -> ConfigFlags emptyConfigFlags progConf = ConfigFlags { configPrograms = progConf, configHcFlavor = defaultCompilerFlavor, configHcPath = Nothing, configHcPkg = Nothing, -- configHaddock = EmptyLocation, configHappy = Nothing, configAlex = Nothing, configHsc2hs = Nothing, configC2hs = Nothing, configVanillaLib = True, configProfLib = False, configProfExe = False, configCpphs = Nothing, configGreencard= Nothing, configPrefix = Nothing, configBinDir = Nothing, configLibDir = Nothing, configLibSubDir = Nothing, configLibExecDir = Nothing, configDataDir = Nothing, configDataSubDir = Nothing, configVerbose = 0, configUser = False, configGHCiLib = True, configSplitObjs = False -- takes longer, so turn off by default } -- | Flags to @copy@: (destdir, copy-prefix (backwards compat), verbose) data CopyFlags = CopyFlags {copyDest :: CopyDest ,copyVerbose :: Int} data CopyDest = NoCopyDest | CopyTo FilePath | CopyPrefix FilePath -- DEPRECATED deriving (Eq, Show) data MaybeUserFlag = MaybeUserNone -- ^no --user OR --global flag. | MaybeUserUser -- ^--user flag | MaybeUserGlobal -- ^--global flag -- |A 'MaybeUserFlag' overrides the default --user setting userOverride :: MaybeUserFlag -> Bool -> Bool MaybeUserUser `userOverride` _ = True MaybeUserGlobal `userOverride` _ = False _ `userOverride` r = r -- | Flags to @install@: (user package, verbose) data InstallFlags = InstallFlags {installUserFlags::MaybeUserFlag ,installVerbose :: Int} emptyInstallFlags :: InstallFlags emptyInstallFlags = InstallFlags{ installUserFlags=MaybeUserNone, installVerbose=0 } -- | Flags to @sdist@: (snapshot, verbose) data SDistFlags = SDistFlags {sDistSnapshot::Bool ,sDistVerbose:: Int} -- | Flags to @register@ and @unregister@: (user package, gen-script, -- in-place, verbose) data RegisterFlags = RegisterFlags {regUser::MaybeUserFlag ,regGenScript::Bool ,regInPlace::Bool ,regWithHcPkg::Maybe FilePath ,regVerbose::Int} emptyRegisterFlags :: RegisterFlags emptyRegisterFlags = RegisterFlags { regUser=MaybeUserNone, regGenScript=False, regInPlace=False, regWithHcPkg=Nothing, regVerbose=0 } data HaddockFlags = HaddockFlags {haddockHoogle :: Bool ,haddockVerbose :: Int} emptyHaddockFlags :: HaddockFlags emptyHaddockFlags = HaddockFlags {haddockHoogle = False, haddockVerbose = 0} -- Following only have verbose flags, but for consistency and -- extensibility we make them into a type. data BuildFlags = BuildFlags {buildVerbose :: Int} data CleanFlags = CleanFlags {cleanVerbose :: Int} data PFEFlags = PFEFlags {pfeVerbose :: Int} -- |Most of these flags are for Configure, but InstPrefix is for Copy. data Flag a = GhcFlag | NhcFlag | HugsFlag | JhcFlag | WithCompiler FilePath | WithHcPkg FilePath | WithHappy FilePath | WithAlex FilePath | WithHsc2hs FilePath | WithC2hs FilePath | WithCpphs FilePath | WithGreencard FilePath | WithVanillaLib | WithoutVanillaLib | WithProfLib | WithoutProfLib | WithProfExe | WithoutProfExe | WithGHCiLib | WithoutGHCiLib | WithSplitObjs | WithoutSplitObjs | Prefix FilePath | BinDir FilePath | LibDir FilePath | LibSubDir FilePath | LibExecDir FilePath | DataDir FilePath | DataSubDir FilePath | ProgramArgs String String -- program name, arguments | WithProgram String FilePath -- program name, location -- For install, register, and unregister: | UserFlag | GlobalFlag -- for register & unregister | GenScriptFlag | InPlaceFlag -- For copy: | InstPrefix FilePath | DestDir FilePath -- For sdist: | Snapshot -- For haddock: | HaddockHoogle -- For everyone: | HelpFlag | Verbose Int -- | Version? | Lift a deriving (Show, Eq) -- ------------------------------------------------------------ -- * Mostly parsing functions -- ------------------------------------------------------------ defaultCompilerFlavor :: Maybe CompilerFlavor defaultCompilerFlavor = #if defined(__GLASGOW_HASKELL__) Just GHC #elif defined(__NHC__) Just NHC #elif defined(__JHC__) Just JHC #elif defined(__HUGS__) Just Hugs #else Nothing #endif -- | Arguments to pass to a @configure@ script, e.g. generated by -- @autoconf@. configureArgs :: ConfigFlags -> [String] configureArgs flags = hc_flag ++ optFlag "with-hc-pkg" configHcPkg ++ optFlag "prefix" configPrefix ++ optFlag "bindir" configBinDir ++ optFlag "libdir" configLibDir ++ optFlag "libexecdir" configLibExecDir ++ optFlag "datadir" configDataDir where hc_flag = case (configHcFlavor flags, configHcPath flags) of (_, Just hc_path) -> ["--with-hc=" ++ hc_path] (Just hc, Nothing) -> ["--with-hc=" ++ showHC hc] (Nothing,Nothing) -> [] optFlag name config_field = case config_field flags of Just p -> ["--" ++ name ++ "=" ++ p] Nothing -> [] showHC GHC = "ghc" showHC NHC = "nhc98" showHC JHC = "jhc" showHC Hugs = "hugs" showHC c = "unknown compiler: " ++ (show c) cmd_help :: OptDescr (Flag a) cmd_help = Option "h?" ["help"] (NoArg HelpFlag) "Show this help text" cmd_verbose :: OptDescr (Flag a) cmd_verbose = Option "v" ["verbose"] (OptArg verboseFlag "n") "Control verbosity (n is 0--5, normal verbosity level is 1, -v alone is equivalent to -v3)" where verboseFlag mb_s = Verbose (maybe 3 read mb_s) cmd_with_hc_pkg :: OptDescr (Flag a) cmd_with_hc_pkg = Option "" ["with-hc-pkg"] (reqPathArg WithHcPkg) "give the path to the package tool" -- Do we have any other interesting global flags? globalOptions :: [OptDescr (Flag a)] globalOptions = [ cmd_help ] liftCustomOpts :: [OptDescr a] -> [OptDescr (Flag a)] liftCustomOpts flags = [ Option shopt lopt (f adesc) help | Option shopt lopt adesc help <- flags ] where f (NoArg x) = NoArg (Lift x) f (ReqArg g s) = ReqArg (Lift . g) s f (OptArg g s) = OptArg (Lift . g) s data Cmd a = Cmd { cmdName :: String, cmdHelp :: String, -- Short description cmdDescription :: String, -- Long description cmdOptions :: [OptDescr (Flag a)], cmdAction :: Action } commandList :: ProgramConfiguration -> [Cmd a] commandList progConf = [(configureCmd progConf), buildCmd, cleanCmd, installCmd, copyCmd, sdistCmd, testCmd, haddockCmd, programaticaCmd, registerCmd, unregisterCmd] lookupCommand :: String -> [Cmd a] -> Maybe (Cmd a) lookupCommand name = find ((==name) . cmdName) printGlobalHelp :: ProgramConfiguration -> IO () printGlobalHelp progConf = do pname <- getProgName let syntax_line = "Usage: " ++ pname ++ " [GLOBAL FLAGS]\n or: " ++ pname ++ " COMMAND [FLAGS]\n\nGlobal flags:" putStrLn (usageInfo syntax_line globalOptions) putStrLn "Commands:" let maxlen = maximum [ length (cmdName cmd) | cmd <- (commandList progConf) ] sequence_ [ do putStr " " putStr (align maxlen (cmdName cmd)) putStr " " putStrLn (cmdHelp cmd) | cmd <- (commandList progConf) ] putStrLn $ "\nFor more information about a command, try '" ++ pname ++ " COMMAND --help'." where align n str = str ++ replicate (n - length str) ' ' printCmdHelp :: Cmd a -> [OptDescr a] -> IO () printCmdHelp cmd opts = do pname <- getProgName let syntax_line = "Usage: " ++ pname ++ " " ++ cmdName cmd ++ " [FLAGS]\n\nFlags for " ++ cmdName cmd ++ ":" putStrLn (usageInfo syntax_line (cmdOptions cmd ++ liftCustomOpts opts)) putStr (cmdDescription cmd) getCmdOpt :: Cmd a -> [OptDescr a] -> [String] -> ([Flag a], [String], [String]) getCmdOpt cmd opts s = let (a,_,c,d) = getOpt' Permute (cmdOptions cmd ++ liftCustomOpts opts) s in (a,c,d) -- We don't want to use elem, because that imposes Eq a hasHelpFlag :: [Flag a] -> Bool hasHelpFlag flags = not . null $ [ () | HelpFlag <- flags ] parseGlobalArgs :: ProgramConfiguration -> [String] -> IO (Action,[String]) parseGlobalArgs progConf args = case getOpt' RequireOrder globalOptions args of (flags, _, _, []) | hasHelpFlag flags -> do (printGlobalHelp progConf) exitWith ExitSuccess (_, cname:cargs, extra_args, []) -> do case lookupCommand cname (commandList progConf) of Just cmd -> return (cmdAction cmd, extra_args ++ cargs) Nothing -> die $ "Unrecognised command: " ++ cname ++ " (try --help)" (_, [], _, []) -> die $ "No command given (try --help)" (_, _, _, errs) -> putErrors errs configureCmd :: ProgramConfiguration -> Cmd a configureCmd progConf = Cmd { cmdName = "configure", cmdHelp = "Prepare to build the package.", cmdDescription = "", -- This can be a multi-line description cmdOptions = [cmd_help, cmd_verbose, Option "g" ["ghc"] (NoArg GhcFlag) "compile with GHC", Option "n" ["nhc"] (NoArg NhcFlag) "compile with NHC", Option "" ["jhc"] (NoArg JhcFlag) "compile with JHC", Option "" ["hugs"] (NoArg HugsFlag) "compile with hugs", Option "w" ["with-compiler"] (reqPathArg WithCompiler) "give the path to a particular compiler", cmd_with_hc_pkg, Option "" ["prefix"] (reqDirArg Prefix) "bake this prefix in preparation of installation", Option "" ["bindir"] (reqDirArg BinDir) "installation directory for executables", Option "" ["libdir"] (reqDirArg LibDir) "installation directory for libraries", Option "" ["libsubdir"] (reqDirArg LibSubDir) "subdirectory of libdir in which libs are installed", Option "" ["libexecdir"] (reqDirArg LibExecDir) "installation directory for program executables", Option "" ["datadir"] (reqDirArg DataDir) "installation directory for read-only data", Option "" ["datasubdir"] (reqDirArg DataSubDir) "subdirectory of datadir in which data files are installed", Option "" ["with-happy"] (reqPathArg WithHappy) "give the path to happy", Option "" ["with-alex"] (reqPathArg WithAlex) "give the path to alex", Option "" ["with-hsc2hs"] (reqPathArg WithHsc2hs) "give the path to hsc2hs", Option "" ["with-c2hs"] (reqPathArg WithC2hs) "give the path to c2hs", Option "" ["with-cpphs"] (reqPathArg WithCpphs) "give the path to cpphs", Option "" ["with-greencard"] (reqPathArg WithGreencard) "give the path to greencard", Option "" ["enable-library-vanilla"] (NoArg WithVanillaLib) "Enable vanilla libraries", Option "" ["disable-library-vanilla"] (NoArg WithoutVanillaLib) "Disable vanilla libraries", Option "p" ["enable-library-profiling"] (NoArg WithProfLib) "Enable library profiling", Option "" ["disable-library-profiling"] (NoArg WithoutProfLib) "Disable library profiling", Option "" ["enable-executable-profiling"] (NoArg WithProfExe) "Enable executable profiling", Option "" ["disable-executable-profiling"] (NoArg WithoutProfExe) "Disable executable profiling", Option "" ["enable-library-for-ghci"] (NoArg WithGHCiLib) "compile library for use with GHCi", Option "" ["disable-library-for-ghci"] (NoArg WithoutGHCiLib) "do not compile libraries for GHCi", Option "" ["enable-split-objs"] (NoArg WithSplitObjs) "split library into smaller objects to reduce binary sizes (GHC 6.6+)", Option "" ["disable-split-objs"] (NoArg WithoutSplitObjs) "split library into smaller objects to reduce binary sizes (GHC 6.6+)", Option "" ["user"] (NoArg UserFlag) "allow dependencies to be satisfied from the user package database. also implies install --user", Option "" ["global"] (NoArg GlobalFlag) "(default) dependencies must be satisfied from the global package database" ] {- FIX: Instead of using ++ here, we might add extra arguments. That way, we can condense the help out put to something like --with-{haddock,happy,alex,etc} FIX: shouldn't use default. Look in hooks?. -} ++ (withProgramOptions progConf) ++ (programArgsOptions progConf), cmdAction = ConfigCmd (emptyConfigFlags progConf) } programArgsOptions :: ProgramConfiguration -> [OptDescr (Flag a)] programArgsOptions (ProgramConfiguration conf) = map f (keys conf) where f name = Option "" [name ++ "-args"] (reqPathArg (ProgramArgs name)) ("give the args to " ++ name) withProgramOptions :: ProgramConfiguration -> [OptDescr (Flag a)] withProgramOptions (ProgramConfiguration conf) = map f (keys conf) where f name = Option "" ["with-" ++ name] (reqPathArg (WithProgram name)) ("give the path to " ++ name) reqPathArg :: (FilePath -> a) -> ArgDescr a reqPathArg constr = ReqArg (constr . platformPath) "PATH" reqDirArg :: (FilePath -> a) -> ArgDescr a reqDirArg constr = ReqArg (constr . platformPath) "DIR" parseConfigureArgs :: ProgramConfiguration -> ConfigFlags -> [String] -> [OptDescr a] -> IO (ConfigFlags, [a], [String]) parseConfigureArgs progConf = parseArgs (configureCmd progConf) updateCfg where updateCfg t GhcFlag = t { configHcFlavor = Just GHC } updateCfg t NhcFlag = t { configHcFlavor = Just NHC } updateCfg t JhcFlag = t { configHcFlavor = Just JHC } updateCfg t HugsFlag = t { configHcFlavor = Just Hugs } updateCfg t (WithCompiler path) = t { configHcPath = Just path } updateCfg t (WithHcPkg path) = t { configHcPkg = Just path } updateCfg t (WithHappy path) = t { configHappy = Just path } updateCfg t (WithAlex path) = t { configAlex = Just path } updateCfg t (WithHsc2hs path) = t { configHsc2hs = Just path } updateCfg t (WithC2hs path) = t { configC2hs = Just path } updateCfg t (WithCpphs path) = t { configCpphs = Just path } updateCfg t (WithGreencard path) = t { configGreencard= Just path } updateCfg t (ProgramArgs name args) = t { configPrograms = (userSpecifyArgs name args (configPrograms t))} updateCfg t (WithProgram name path) = t { configPrograms = (userSpecifyPath name path (configPrograms t))} updateCfg t WithVanillaLib = t { configVanillaLib = True } updateCfg t WithoutVanillaLib = t { configVanillaLib = False, configGHCiLib = False } updateCfg t WithProfLib = t { configProfLib = True } updateCfg t WithoutProfLib = t { configProfLib = False } updateCfg t WithProfExe = t { configProfExe = True } updateCfg t WithoutProfExe = t { configProfExe = False } updateCfg t WithGHCiLib = t { configGHCiLib = True } updateCfg t WithoutGHCiLib = t { configGHCiLib = False } updateCfg t (Prefix path) = t { configPrefix = Just path } updateCfg t (BinDir path) = t { configBinDir = Just path } updateCfg t (LibDir path) = t { configLibDir = Just path } updateCfg t (LibSubDir path) = t { configLibSubDir= Just path } updateCfg t (LibExecDir path) = t { configLibExecDir = Just path } updateCfg t (DataDir path) = t { configDataDir = Just path } updateCfg t (DataSubDir path) = t { configDataSubDir = Just path } updateCfg t (Verbose n) = t { configVerbose = n } updateCfg t UserFlag = t { configUser = True } updateCfg t GlobalFlag = t { configUser = False } updateCfg t WithSplitObjs = t { configSplitObjs = True } updateCfg t WithoutSplitObjs = t { configSplitObjs = False } updateCfg t (Lift _) = t updateCfg t _ = error $ "Unexpected flag!" buildCmd :: Cmd a buildCmd = Cmd { cmdName = "build", cmdHelp = "Make this package ready for installation.", cmdDescription = "", -- This can be a multi-line description cmdOptions = [cmd_help, cmd_verbose], cmdAction = BuildCmd } parseBuildArgs :: [String] -> [OptDescr a] -> IO (BuildFlags, [a], [String]) parseBuildArgs = parseNoArgs buildCmd BuildFlags haddockCmd :: Cmd a haddockCmd = Cmd { cmdName = "haddock", cmdHelp = "Generate Haddock HTML code from Exposed-Modules.", cmdDescription = "Requires cpphs and haddock.", cmdOptions = [cmd_help, cmd_verbose, Option "" ["hoogle"] (NoArg HaddockHoogle) "Generate a hoogle database"], cmdAction = HaddockCmd } parseHaddockArgs :: HaddockFlags -> [String] -> [OptDescr a] -> IO (HaddockFlags, [a], [String]) parseHaddockArgs = parseArgs haddockCmd updateCfg where updateCfg (HaddockFlags hoogle verbose) fl = case fl of HaddockHoogle -> HaddockFlags True verbose Verbose n -> HaddockFlags hoogle n _ -> error "Unexpected flag!" programaticaCmd :: Cmd a programaticaCmd = Cmd { cmdName = "pfe", cmdHelp = "Generate Programatica Project.", cmdDescription = "", cmdOptions = [cmd_help, cmd_verbose], cmdAction = ProgramaticaCmd } parseProgramaticaArgs :: [String] -> [OptDescr a] -> IO (PFEFlags, [a], [String]) parseProgramaticaArgs = parseNoArgs programaticaCmd PFEFlags cleanCmd :: Cmd a cleanCmd = Cmd { cmdName = "clean", cmdHelp = "Clean up after a build.", cmdDescription = "Removes .hi, .o, preprocessed sources, etc.\n", -- Multi-line! cmdOptions = [cmd_help, cmd_verbose], cmdAction = CleanCmd } parseCleanArgs :: [String] -> [OptDescr a] -> IO (CleanFlags, [a], [String]) parseCleanArgs = parseNoArgs cleanCmd CleanFlags installCmd :: Cmd a installCmd = Cmd { cmdName = "install", cmdHelp = "Copy the files into the install locations. Run register.", cmdDescription = "Unlike the copy command, install calls the register command.\nIf you want to install into a location that is not what was\nspecified in the configure step, use the copy command.\n", cmdOptions = [cmd_help, cmd_verbose, Option "" ["install-prefix"] (reqDirArg InstPrefix) "[DEPRECATED, use copy]", Option "" ["user"] (NoArg UserFlag) "upon registration, register this package in the user's local package database", Option "" ["global"] (NoArg GlobalFlag) "(default; override with configure) upon registration, register this package in the system-wide package database" ], cmdAction = InstallCmd } copyCmd :: Cmd a copyCmd = Cmd { cmdName = "copy", cmdHelp = "Copy the files into the install locations.", cmdDescription = "Does not call register, and allows a prefix at install time\nWithout the --destdir flag, configure determines location.\n", cmdOptions = [cmd_help, cmd_verbose, Option "" ["destdir"] (reqDirArg DestDir) "directory to copy files to, prepended to installation directories", Option "" ["copy-prefix"] (reqDirArg InstPrefix) "[DEPRECATED, directory to copy files to instead of prefix]" ], cmdAction = CopyCmd NoCopyDest } parseCopyArgs :: CopyFlags -> [String] -> [OptDescr a] -> IO (CopyFlags, [a], [String]) parseCopyArgs = parseArgs copyCmd updateCfg where updateCfg (CopyFlags copydest verbose) fl = case fl of InstPrefix path -> (CopyFlags (CopyPrefix path) verbose) DestDir path -> (CopyFlags (CopyTo path) verbose) Verbose n -> (CopyFlags copydest n) _ -> error $ "Unexpected flag!" parseInstallArgs :: InstallFlags -> [String] -> [OptDescr a] -> IO (InstallFlags, [a], [String]) parseInstallArgs = parseArgs installCmd updateCfg where updateCfg (InstallFlags uFlag verbose) fl = case fl of InstPrefix _ -> error "--install-prefix is obsolete. Use copy command instead." UserFlag -> (InstallFlags MaybeUserUser verbose) GlobalFlag -> (InstallFlags MaybeUserGlobal verbose) Verbose n -> (InstallFlags uFlag n) _ -> error $ "Unexpected flag!" sdistCmd :: Cmd a sdistCmd = Cmd { cmdName = "sdist", cmdHelp = "Generate a source distribution file (.tar.gz or .zip).", cmdDescription = "", -- This can be a multi-line description cmdOptions = [cmd_help,cmd_verbose, Option "" ["snapshot"] (NoArg Snapshot) "Produce a snapshot source distribution" ], cmdAction = SDistCmd } parseSDistArgs :: [String] -> [OptDescr a] -> IO (SDistFlags, [a], [String]) parseSDistArgs = parseArgs sdistCmd updateCfg (SDistFlags False 0) where updateCfg (SDistFlags snapshot verbose) fl = case fl of Snapshot -> (SDistFlags True verbose) Verbose n -> (SDistFlags snapshot n) _ -> error $ "Unexpected flag!" testCmd :: Cmd a testCmd = Cmd { cmdName = "test", cmdHelp = "Run the test suite, if any (configure with UserHooks).", cmdDescription = "", -- This can be a multi-line description cmdOptions = [cmd_help,cmd_verbose], cmdAction = TestCmd } parseTestArgs :: [String] -> [OptDescr a] -> IO (Int, [a], [String]) parseTestArgs = parseNoArgs testCmd id registerCmd :: Cmd a registerCmd = Cmd { cmdName = "register", cmdHelp = "Register this package with the compiler.", cmdDescription = "", -- This can be a multi-line description cmdOptions = [cmd_help, cmd_verbose, Option "" ["user"] (NoArg UserFlag) "upon registration, register this package in the user's local package database", Option "" ["global"] (NoArg GlobalFlag) "(default) upon registration, register this package in the system-wide package database", Option "" ["inplace"] (NoArg InPlaceFlag) "register the package in the build location, so it can be used without being installed", Option "" ["gen-script"] (NoArg GenScriptFlag) "Instead of performing the register command, generate a script to register later", cmd_with_hc_pkg ], cmdAction = RegisterCmd } parseRegisterArgs :: RegisterFlags -> [String] -> [OptDescr a] -> IO (RegisterFlags, [a], [String]) parseRegisterArgs = parseArgs registerCmd updateCfg where updateCfg reg fl = case fl of UserFlag -> reg { regUser=MaybeUserUser } GlobalFlag -> reg { regUser=MaybeUserGlobal } Verbose n -> reg { regVerbose=n } GenScriptFlag -> reg { regGenScript=True } InPlaceFlag -> reg { regInPlace=True } WithHcPkg f -> reg { regWithHcPkg=Just f } _ -> error $ "Unexpected flag!" unregisterCmd :: Cmd a unregisterCmd = Cmd { cmdName = "unregister", cmdHelp = "Unregister this package with the compiler.", cmdDescription = "", -- This can be a multi-line description cmdOptions = [cmd_help, cmd_verbose, Option "" ["user"] (NoArg UserFlag) "unregister this package in the user's local package database", Option "" ["global"] (NoArg GlobalFlag) "(default) unregister this package in the system-wide package database", Option "" ["gen-script"] (NoArg GenScriptFlag) "Instead of performing the unregister command, generate a script to unregister later" ], cmdAction = UnregisterCmd } parseUnregisterArgs :: RegisterFlags -> [String] -> [OptDescr a] -> IO (RegisterFlags, [a], [String]) parseUnregisterArgs = parseRegisterArgs -- |Helper function for commands with no arguments except for verbose -- and help. parseNoArgs :: (Cmd a) -> (Int -> b) -- Constructor to make this type. -> [String] -> [OptDescr a]-> IO (b, [a], [String]) parseNoArgs cmd c = parseArgs cmd updateCfg (c 0) where updateCfg _ (Verbose n) = c n updateCfg _ _ = error "Unexpected flag!" -- |Helper function for commands with more options. parseArgs :: Cmd a -> (cfg -> Flag a -> cfg) -> cfg -> [String] -> [OptDescr a] -> IO (cfg, [a], [String]) parseArgs cmd updateCfg cfg args customOpts = case getCmdOpt cmd customOpts args of (flags, _, []) | hasHelpFlag flags -> do printCmdHelp cmd customOpts exitWith ExitSuccess (flags, args', []) -> let flags' = filter (not.isLift) flags in return (foldl updateCfg cfg flags', unliftFlags flags, args') (_, _, errs) -> putErrors errs where isLift (Lift _) = True isLift _ = False unliftFlags :: [Flag a] -> [a] unliftFlags flags = [ fl | Lift fl <- flags ] putErrors :: [String] -> IO a putErrors errs = die $ "Errors:" ++ concat ['\n':err | err <- errs] #ifdef DEBUG hunitTests :: [Test] hunitTests = [] -- The test cases kinda have to be rewritten from the ground up... :/ --hunitTests = -- let m = [("ghc", GHC), ("nhc", NHC), ("hugs", Hugs)] -- (flags, commands', unkFlags, ers) -- = getOpt Permute options ["configure", "foobar", "--prefix=/foo", "--ghc", "--nhc", "--hugs", "--with-compiler=/comp", "--unknown1", "--unknown2", "--install-prefix=/foo", "--user", "--global"] -- in [TestLabel "very basic option parsing" $ TestList [ -- "getOpt flags" ~: "failed" ~: -- [Prefix "/foo", GhcFlag, NhcFlag, HugsFlag, -- WithCompiler "/comp", InstPrefix "/foo", UserFlag, GlobalFlag] -- ~=? flags, -- "getOpt commands" ~: "failed" ~: ["configure", "foobar"] ~=? commands', -- "getOpt unknown opts" ~: "failed" ~: -- ["--unknown1", "--unknown2"] ~=? unkFlags, -- "getOpt errors" ~: "failed" ~: [] ~=? ers], -- -- TestLabel "test location of various compilers" $ TestList -- ["configure parsing for prefix and compiler flag" ~: "failed" ~: -- (Right (ConfigCmd (Just comp, Nothing, Just "/usr/local"), [])) -- ~=? (parseArgs ["--prefix=/usr/local", "--"++name, "configure"]) -- | (name, comp) <- m], -- -- TestLabel "find the package tool" $ TestList -- ["configure parsing for prefix comp flag, withcompiler" ~: "failed" ~: -- (Right (ConfigCmd (Just comp, Just "/foo/comp", Just "/usr/local"), [])) -- ~=? (parseArgs ["--prefix=/usr/local", "--"++name, -- "--with-compiler=/foo/comp", "configure"]) -- | (name, comp) <- m], -- -- TestLabel "simpler commands" $ TestList -- [flag ~: "failed" ~: (Right (flagCmd, [])) ~=? (parseArgs [flag]) -- | (flag, flagCmd) <- [("build", BuildCmd), -- ("install", InstallCmd Nothing False), -- ("sdist", SDistCmd), -- ("register", RegisterCmd False)] -- ] -- ] #endif {- Testing ideas: * IO to look for hugs and hugs-pkg (which hugs, etc) * quickCheck to test permutations of arguments * what other options can we over-ride with a command-line flag? -} hugs98-plus-Sep2006/packages/Cabal/Distribution/Simple.hs0000644006511100651110000007423210504340326022014 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple -- Copyright : Isaac Jones 2003-2005 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Explanation: Simple build system; basically the interface for -- Distribution.Simple.\* modules. When given the parsed command-line -- args and package information, is able to perform basic commands -- like configure, build, install, register, etc. -- -- This module isn't called \"Simple\" because it's simple. Far from -- it. It's called \"Simple\" because it does complicated things to -- simple software. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple ( module Distribution.Package, module Distribution.Version, module Distribution.License, module Distribution.Compiler, module Language.Haskell.Extension, -- * Simple interface defaultMain, defaultMainNoRead, defaultMainArgs, -- * Customization UserHooks(..), Args, defaultMainWithHooks, defaultUserHooks, emptyUserHooks, defaultHookedPackageDesc #ifdef DEBUG ,simpleHunitTests #endif ) where -- local import Distribution.Compiler import Distribution.Package --must not specify imports, since we're exporting moule. import Distribution.PackageDescription import Distribution.Program(lookupProgram, Program(..), ProgramConfiguration(..), haddockProgram, rawSystemProgram, defaultProgramConfiguration, pfesetupProgram, updateProgram, rawSystemProgramConf) import Distribution.PreProcess (knownSuffixHandlers, ppSuffixes, ppCpp', ppUnlit, removePreprocessedPackage, preprocessSources, PPSuffixHandler) import Distribution.Setup import Distribution.Simple.Build ( build ) import Distribution.Simple.SrcDist ( sdist ) import Distribution.Simple.Register ( register, unregister, writeInstalledConfig, installedPkgConfigFile, regScriptLocation, unregScriptLocation ) import Distribution.Simple.Configure(getPersistBuildConfig, maybeGetPersistBuildConfig, findProgram, configure, writePersistBuildConfig, localBuildInfoFile) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..)) import Distribution.Simple.Install(install) import Distribution.Simple.Utils (die, currentDir, rawSystemVerbose, defaultPackageDesc, defaultHookedPackageDesc, moduleToFilePath, findFile, distPref, srcPref, haddockPref) #if mingw32_HOST_OS || mingw32_TARGET_OS import Distribution.Simple.Utils (rawSystemPath) #endif import Language.Haskell.Extension -- Base import System.Environment(getArgs) import System.Exit(ExitCode(..), exitWith) import System.Directory(removeFile, doesFileExist, doesDirectoryExist) import Distribution.License import Control.Monad(when, unless) import Data.List ( intersperse, unionBy ) import Data.Maybe ( isJust, fromJust ) import System.IO.Error (try) import Distribution.GetOpt import Distribution.Compat.Directory(createDirectoryIfMissing,removeDirectoryRecursive, copyFile) import Distribution.Compat.FilePath(joinFileName, joinPaths, joinFileExt, splitFileName, splitFileExt, changeFileExt) #ifdef DEBUG import HUnit (Test) import Distribution.Version hiding (hunitTests) #else import Distribution.Version #endif type Args = [String] -- | WARNING: The hooks interface is under rather constant flux as we -- try to understand users needs. Setup files that depend on this -- interface may break in future releases. Hooks allow authors to add -- specific functionality before and after a command is run, and also -- to specify additional preprocessors. data UserHooks = UserHooks { runTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ExitCode, -- ^Used for @.\/setup test@ readDesc :: IO (Maybe PackageDescription), -- ^Read the description file hookedPreProcessors :: [ PPSuffixHandler ], -- ^Custom preprocessors in addition to and overriding 'knownSuffixHandlers'. hookedPrograms :: [Program], -- ^These programs are detected at configure time. Arguments for them are added to the configure command. -- |Hook to run before configure command preConf :: Args -> ConfigFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during configure. confHook :: PackageDescription -> ConfigFlags -> IO LocalBuildInfo, -- |Hook to run after configure command postConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode, -- |Hook to run before build command. Second arg indicates verbosity level. preBuild :: Args -> BuildFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during build. buildHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> BuildFlags -> IO (), -- |Hook to run after build command. Second arg indicates verbosity level. postBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode, -- |Hook to run before clean command. Second arg indicates verbosity level. preClean :: Args -> CleanFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during clean. cleanHook :: PackageDescription -> Maybe LocalBuildInfo -> Maybe UserHooks -> CleanFlags -> IO (), -- |Hook to run after clean command. Second arg indicates verbosity level. postClean :: Args -> CleanFlags -> PackageDescription -> Maybe LocalBuildInfo -> IO ExitCode, -- |Hook to run before copy command preCopy :: Args -> CopyFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during copy. copyHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> CopyFlags -> IO (), -- |Hook to run after copy command postCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode, -- |Hook to run before install command preInst :: Args -> InstallFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during install. instHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> InstallFlags -> IO (), -- |Hook to run after install command. postInst should be run -- on the target, not on the build machine. postInst :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode, -- |Hook to run before sdist command. Second arg indicates verbosity level. preSDist :: Args -> SDistFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during sdist. sDistHook :: PackageDescription -> Maybe LocalBuildInfo -> Maybe UserHooks -> SDistFlags -> IO (), -- |Hook to run after sdist command. Second arg indicates verbosity level. postSDist :: Args -> SDistFlags -> PackageDescription -> Maybe LocalBuildInfo -> IO ExitCode, -- |Hook to run before register command preReg :: Args -> RegisterFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during pfe. regHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> RegisterFlags -> IO (), -- |Hook to run after register command postReg :: Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode, -- |Hook to run before unregister command preUnreg :: Args -> RegisterFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during pfe. unregHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> RegisterFlags -> IO (), -- |Hook to run after unregister command postUnreg :: Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode, -- |Hook to run before haddock command. Second arg indicates verbosity level. preHaddock :: Args -> HaddockFlags -> IO HookedBuildInfo, -- |Hook to run after haddock command. Second arg indicates verbosity level. -- |Over-ride this hook to get different behavior during haddock. haddockHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> HaddockFlags -> IO (), postHaddock :: Args -> HaddockFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode, -- |Hook to run before pfe command. Second arg indicates verbosity level. prePFE :: Args -> PFEFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during pfe. pfeHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> PFEFlags -> IO (), -- |Hook to run after pfe command. Second arg indicates verbosity level. postPFE :: Args -> PFEFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode } -- |A simple implementation of @main@ for a Cabal setup script. -- It reads the package description file using IO, and performs the -- action specified on the command line. defaultMain :: IO () defaultMain = getArgs >>=defaultMainArgs defaultMainArgs :: [String] -> IO () defaultMainArgs args = do (action, args) <- parseGlobalArgs (allPrograms Nothing) args pkg_descr_file <- defaultPackageDesc pkg_descr <- readPackageDescription pkg_descr_file defaultMainWorker pkg_descr action args Nothing return () -- | A customizable version of 'defaultMain'. defaultMainWithHooks :: UserHooks -> IO () defaultMainWithHooks hooks = do args <- getArgs (action, args) <- parseGlobalArgs (allPrograms (Just hooks)) args maybeDesc <- readDesc hooks pkg_descr <- maybe (defaultPackageDesc >>= readPackageDescription) return maybeDesc defaultMainWorker pkg_descr action args (Just hooks) return () -- |Like 'defaultMain', but accepts the package description as input -- rather than using IO to read it. defaultMainNoRead :: PackageDescription -> IO () defaultMainNoRead pkg_descr = do args <- getArgs (action, args) <- parseGlobalArgs (allPrograms Nothing) args defaultMainWorker pkg_descr action args Nothing return () -- |Combine the programs in the given hooks with the programs built -- into cabal. allPrograms :: Maybe UserHooks -> ProgramConfiguration -- combine defaults w/ user programs allPrograms Nothing = defaultProgramConfiguration allPrograms (Just h) = foldl (\pConf p -> updateProgram (Just p) pConf) defaultProgramConfiguration (hookedPrograms h) -- |Combine the preprocessors in the given hooks with the -- preprocessors built into cabal. allSuffixHandlers :: Maybe UserHooks -> [PPSuffixHandler] allSuffixHandlers hooks = maybe knownSuffixHandlers (\h -> overridesPP (hookedPreProcessors h) knownSuffixHandlers) hooks where overridesPP :: [PPSuffixHandler] -> [PPSuffixHandler] -> [PPSuffixHandler] overridesPP = unionBy (\x y -> fst x == fst y) -- |Helper function for /defaultMain/ and /defaultMainNoRead/ defaultMainWorker :: PackageDescription -> Action -> [String] -- ^args1 -> Maybe UserHooks -> IO ExitCode defaultMainWorker pkg_descr_in action args hooks = do case action of ConfigCmd flags -> do (flags, optFns, args) <- parseConfigureArgs (allPrograms hooks) flags args [buildDirOpt] pkg_descr <- hookOrInArgs preConf args flags (warns, ers) <- sanityCheckPackage pkg_descr errorOut warns ers let c = maybe (confHook defaultUserHooks) confHook hooks localbuildinfo <- c pkg_descr flags writePersistBuildConfig (foldr id localbuildinfo optFns) postHook postConf args flags pkg_descr localbuildinfo BuildCmd -> do (flags, _, args) <- parseBuildArgs args [] pkg_descr <- hookOrInArgs preBuild args flags localbuildinfo <- getPersistBuildConfig cmdHook buildHook pkg_descr localbuildinfo flags postHook postBuild args flags pkg_descr localbuildinfo HaddockCmd -> do (verbose, _, args) <- parseHaddockArgs emptyHaddockFlags args [] pkg_descr <- hookOrInArgs preHaddock args verbose localbuildinfo <- getPersistBuildConfig cmdHook haddockHook pkg_descr localbuildinfo verbose postHook postHaddock args verbose pkg_descr localbuildinfo ProgramaticaCmd -> do (verbose, _, args) <- parseProgramaticaArgs args [] pkg_descr <- hookOrInArgs prePFE args verbose localbuildinfo <- getPersistBuildConfig cmdHook pfeHook pkg_descr localbuildinfo verbose postHook postPFE args verbose pkg_descr localbuildinfo CleanCmd -> do (verbose,_, args) <- parseCleanArgs args [] pkg_descr <- hookOrInArgs preClean args verbose maybeLocalbuildinfo <- maybeGetPersistBuildConfig cmdHook cleanHook pkg_descr maybeLocalbuildinfo verbose postHook postClean args verbose pkg_descr maybeLocalbuildinfo CopyCmd mprefix -> do (flags, _, args) <- parseCopyArgs (CopyFlags mprefix 0) args [] pkg_descr <- hookOrInArgs preCopy args flags localbuildinfo <- getPersistBuildConfig cmdHook copyHook pkg_descr localbuildinfo flags postHook postCopy args flags pkg_descr localbuildinfo InstallCmd -> do (flags, _, args) <- parseInstallArgs emptyInstallFlags args [] pkg_descr <- hookOrInArgs preInst args flags localbuildinfo <- getPersistBuildConfig cmdHook instHook pkg_descr localbuildinfo flags postHook postInst args flags pkg_descr localbuildinfo SDistCmd -> do (flags,_, args) <- parseSDistArgs args [] pkg_descr <- hookOrInArgs preSDist args flags maybeLocalbuildinfo <- maybeGetPersistBuildConfig cmdHook sDistHook pkg_descr maybeLocalbuildinfo flags postHook postSDist args flags pkg_descr maybeLocalbuildinfo TestCmd -> do (verbose,_, args) <- parseTestArgs args [] case hooks of Nothing -> return ExitSuccess Just h -> do localbuildinfo <- getPersistBuildConfig out <- (runTests h) args False pkg_descr_in localbuildinfo when (isFailure out) (exitWith out) return out RegisterCmd -> do (flags, _, args) <- parseRegisterArgs emptyRegisterFlags args [] pkg_descr <- hookOrInArgs preReg args flags localbuildinfo <- getPersistBuildConfig cmdHook regHook pkg_descr localbuildinfo flags postHook postReg args flags pkg_descr localbuildinfo UnregisterCmd -> do (flags,_, args) <- parseUnregisterArgs emptyRegisterFlags args [] pkg_descr <- hookOrInArgs preUnreg args flags localbuildinfo <- getPersistBuildConfig cmdHook unregHook pkg_descr localbuildinfo flags postHook postUnreg args flags pkg_descr localbuildinfo HelpCmd -> return ExitSuccess -- this is handled elsewhere where hookOrInArgs :: (UserHooks -> ([String] -> b -> IO HookedBuildInfo)) -> [String] -> b -> IO PackageDescription hookOrInArgs f a i = case hooks of Nothing -> no_extra_flags a >> return pkg_descr_in Just h -> do pbi <- f h a i return (updatePackageDescription pbi pkg_descr_in) cmdHook f desc lbi = (maybe (f defaultUserHooks) f hooks) desc lbi hooks postHook f args flags pkg_descr localbuildinfo = case hooks of Nothing -> return ExitSuccess Just h -> f h args flags pkg_descr localbuildinfo isFailure :: ExitCode -> Bool isFailure (ExitFailure _) = True isFailure _ = False -- (filter (\x -> notElem x overriders) overridden) ++ overriders getModulePaths :: BuildInfo -> [String] -> IO [FilePath] getModulePaths bi = fmap concat . mapM (flip (moduleToFilePath (hsSourceDirs bi)) ["hs", "lhs"]) haddock :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> HaddockFlags -> IO () haddock pkg_descr lbi hooks (HaddockFlags hoogle verbose) = do let pps = allSuffixHandlers hooks confHaddock <- do let programConf = withPrograms lbi let haddockName = programName haddockProgram mHaddock <- lookupProgram haddockName programConf maybe (die "haddock command not found") return mHaddock let tmpDir = joinPaths (buildDir lbi) "tmp" createDirectoryIfMissing True tmpDir createDirectoryIfMissing True haddockPref preprocessSources pkg_descr lbi verbose pps setupMessage "Running Haddock for" pkg_descr let replaceLitExts = map (joinFileName tmpDir . flip changeFileExt "hs") let mockAll bi = mapM_ (mockPP ["-D__HADDOCK__"] pkg_descr bi lbi tmpDir verbose) let showPkg = showPackageId (package pkg_descr) let showDepPkgs = map showPackageId (packageDeps lbi) let outputFlag = if hoogle then "--hoogle" else "--html" withLib pkg_descr () $ \lib -> do let bi = libBuildInfo lib inFiles <- getModulePaths bi (exposedModules lib ++ otherModules bi) mockAll bi inFiles let prologName = showPkg ++ "-haddock-prolog.txt" writeFile prologName (description pkg_descr ++ "\n") let outFiles = replaceLitExts inFiles let haddockFile = joinFileName haddockPref (haddockName pkg_descr) -- FIX: replace w/ rawSystemProgramConf? rawSystemProgram verbose confHaddock ([outputFlag, "--odir=" ++ haddockPref, "--title=" ++ showPkg ++ ": " ++ synopsis pkg_descr, "--package=" ++ showPkg, "--dump-interface=" ++ haddockFile, "--prologue=" ++ prologName] ++ map ("--use-package=" ++) showDepPkgs ++ programArgs confHaddock ++ (if verbose > 4 then ["--verbose"] else []) ++ outFiles ++ map ("--hide=" ++) (otherModules bi) ) removeFile prologName withExe pkg_descr $ \exe -> do let bi = buildInfo exe exeTargetDir = haddockPref `joinFileName` exeName exe createDirectoryIfMissing True exeTargetDir inFiles' <- getModulePaths bi (otherModules bi) srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) let inFiles = srcMainPath : inFiles' mockAll bi inFiles let outFiles = replaceLitExts inFiles rawSystemProgram verbose confHaddock ([outputFlag, "--odir=" ++ exeTargetDir, "--title=" ++ exeName exe] ++ map ("--use-package=" ++) (showPkg:showDepPkgs) ++ programArgs confHaddock ++ (if verbose > 4 then ["--verbose"] else []) ++ outFiles ) removeDirectoryRecursive tmpDir where mockPP inputArgs pkg_descr bi lbi pref verbose file = do let (filePref, fileName) = splitFileName file let targetDir = joinPaths pref filePref let targetFile = joinFileName targetDir fileName let (targetFileNoext, targetFileExt) = splitFileExt targetFile createDirectoryIfMissing True targetDir if (needsCpp pkg_descr) then ppCpp' inputArgs bi lbi file targetFile verbose else copyFile file targetFile >> return ExitSuccess when (targetFileExt == "lhs") $ do ppUnlit targetFile (joinFileExt targetFileNoext "hs") verbose return () needsCpp :: PackageDescription -> Bool needsCpp p = hasLibs p && any (== CPP) (extensions $ libBuildInfo $ fromJust $ library p) pfe :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> PFEFlags -> IO () pfe pkg_descr _lbi hooks (PFEFlags verbose) = do let pps = allSuffixHandlers hooks unless (hasLibs pkg_descr) $ die "no libraries found in this project" withLib pkg_descr () $ \lib -> do lbi <- getPersistBuildConfig let bi = libBuildInfo lib let mods = exposedModules lib ++ otherModules (libBuildInfo lib) preprocessSources pkg_descr lbi verbose pps inFiles <- getModulePaths bi mods rawSystemProgramConf verbose (programName pfesetupProgram) (withPrograms lbi) ("noplogic":"cpp": (if verbose > 4 then ["-v"] else []) ++ inFiles) return () clean :: PackageDescription -> Maybe LocalBuildInfo -> Maybe UserHooks -> CleanFlags -> IO () clean pkg_descr maybeLbi hooks (CleanFlags verbose) = do let pps = allSuffixHandlers hooks putStrLn "cleaning..." try $ removeDirectoryRecursive (joinPaths distPref "doc") try $ removeFile installedPkgConfigFile try $ removeFile localBuildInfoFile try $ removeFile regScriptLocation try $ removeFile unregScriptLocation removePreprocessedPackage pkg_descr currentDir (ppSuffixes pps) mapM_ removeFileOrDirectory (extraTmpFiles pkg_descr) when (isJust maybeLbi) $ do let lbi = fromJust maybeLbi try $ removeDirectoryRecursive (buildDir lbi) case compilerFlavor (compiler lbi) of GHC -> cleanGHCExtras lbi JHC -> cleanJHCExtras lbi _ -> return () where cleanGHCExtras lbi = do -- remove source stubs for library withLib pkg_descr () $ \ Library{libBuildInfo=bi} -> removeGHCModuleStubs bi (libModules pkg_descr) -- remove source stubs for executables withExe pkg_descr $ \ Executable{modulePath=exeSrcName ,buildInfo=bi} -> do removeGHCModuleStubs bi (exeModules pkg_descr) let (startN, _) = splitFileExt exeSrcName try $ removeFile (startN ++ "_stub.h") try $ removeFile (startN ++ "_stub.c") removeGHCModuleStubs :: BuildInfo -> [String] -> IO () removeGHCModuleStubs (BuildInfo{hsSourceDirs=dirs}) mods = do s <- mapM (\x -> moduleToFilePath dirs (x ++"_stub") ["h", "c"]) mods mapM_ removeFile (concat s) -- JHC FIXME remove exe-sources cleanJHCExtras lbi = do try $ removeFile (buildDir lbi `joinFileName` "jhc-pkg.conf") removePreprocessedPackage pkg_descr currentDir ["ho"] removeFileOrDirectory :: FilePath -> IO () removeFileOrDirectory fname = do isDir <- doesDirectoryExist fname isFile <- doesFileExist fname if isDir then removeDirectoryRecursive fname else if isFile then removeFile fname else return () no_extra_flags :: [String] -> IO () no_extra_flags [] = return () no_extra_flags extra_flags = die ("Unrecognised flags: " ++ concat (intersperse "," extra_flags)) buildDirOpt :: OptDescr (LocalBuildInfo -> LocalBuildInfo) buildDirOpt = Option "b" ["scratchdir"] (reqDirArg setBuildDir) "directory to receive the built package [dist/build]" where setBuildDir dir lbi = lbi { buildDir = dir } -- |Empty 'UserHooks' which do nothing. emptyUserHooks :: UserHooks emptyUserHooks = UserHooks { runTests = res, readDesc = return Nothing, hookedPreProcessors = [], hookedPrograms = [], preConf = rn, confHook = (\_ _ -> return (error "No local build info generated during configure. Over-ride empty configure hook.")), postConf = res, preBuild = rn, buildHook = ru, postBuild = res, preClean = rn, cleanHook = ru, postClean = res, preCopy = rn, copyHook = ru, postCopy = res, preInst = rn, instHook = ru, postInst = res, preSDist = rn, sDistHook = ru, postSDist = res, preReg = rn, regHook = ru, postReg = res, preUnreg = rn, unregHook = ru, postUnreg = res, prePFE = rn, pfeHook = ru, postPFE = res, preHaddock = rn, haddockHook = ru, postHaddock = res } where rn _ _ = return emptyHookedBuildInfo res _ _ _ _ = return ExitSuccess ru _ _ _ _ = return () -- |Basic default 'UserHooks': -- -- * on non-Windows systems, 'postConf' runs @.\/configure@, if present. -- -- * the pre-hooks 'preBuild', 'preClean', 'preCopy', 'preInst', -- 'preReg' and 'preUnreg' read additional build information from -- /package/@.buildinfo@, if present. -- -- Thus @configure@ can use local system information to generate -- /package/@.buildinfo@ and possibly other files. -- FIXME: do something sensible for windows, or do nothing in postConf. defaultUserHooks :: UserHooks defaultUserHooks = emptyUserHooks { postConf = defaultPostConf, confHook = configure, preBuild = readHook buildVerbose, buildHook = defaultBuildHook, preClean = readHook cleanVerbose, preCopy = readHook copyVerbose, copyHook = \desc lbi _ f -> install desc lbi f, -- has correct 'copy' behavior with params preInst = readHook installVerbose, instHook = defaultInstallHook, sDistHook = \p _ h f -> sdist p f srcPref distPref (allSuffixHandlers h), pfeHook = pfe, cleanHook = clean, haddockHook = haddock, preReg = readHook regVerbose, regHook = defaultRegHook, unregHook = \p l _ f -> unregister p l f, preUnreg = readHook regVerbose } where defaultPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode defaultPostConf args flags pkg_descr lbi = do let verbose = configVerbose flags args' = configureArgs flags ++ args confExists <- doesFileExist "configure" if confExists then #if mingw32_HOST_OS || mingw32_TARGET_OS -- FIXME: hack for script files under MinGW -- This assumes sh (check for #! line?) rawSystemPath verbose "sh" ("configure" : args') #else -- FIXME: should we really be discarding the exit code? rawSystemVerbose verbose "./configure" args' #endif else do no_extra_flags args return ExitSuccess readHook :: (a -> Int) -> Args -> a -> IO HookedBuildInfo readHook verbose a flags = do no_extra_flags a maybe_infoFile <- defaultHookedPackageDesc case maybe_infoFile of Nothing -> return emptyHookedBuildInfo Just infoFile -> do when (verbose flags > 0) $ putStrLn $ "Reading parameters from " ++ infoFile readHookedBuildInfo infoFile defaultInstallHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks ->InstallFlags -> IO () defaultInstallHook pkg_descr localbuildinfo _ (InstallFlags uInstFlag verbose) = do install pkg_descr localbuildinfo (CopyFlags NoCopyDest verbose) when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo emptyRegisterFlags{ regUser=uInstFlag, regVerbose=verbose } defaultBuildHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> BuildFlags -> IO () defaultBuildHook pkg_descr localbuildinfo hooks flags = do build pkg_descr localbuildinfo flags (allSuffixHandlers hooks) when (hasLibs pkg_descr) $ writeInstalledConfig pkg_descr localbuildinfo False defaultRegHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> RegisterFlags -> IO () defaultRegHook pkg_descr localbuildinfo _ flags = if hasLibs pkg_descr then register pkg_descr localbuildinfo flags else die "Package contains no library to register" -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ #ifdef DEBUG simpleHunitTests :: [Test] simpleHunitTests = [] #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/Version.hs0000644006511100651110000003154610504340326022211 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Version -- Copyright : Isaac Jones, Simon Marlow 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Versions for packages, based on the 'Version' datatype. {- Copyright (c) 2003-2004, Isaac Jones All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Version ( -- * Package versions Version(..), showVersion, parseVersion, -- * Version ranges VersionRange(..), orLaterVersion, orEarlierVersion, betweenVersionsInclusive, withinRange, showVersionRange, parseVersionRange, -- * Dependencies Dependency(..), #ifdef DEBUG hunitTests #endif ) where #if __HUGS__ || __GLASGOW_HASKELL__ >= 603 import Data.Version ( Version(..), showVersion, parseVersion ) #endif import Control.Monad ( liftM ) import Distribution.Compat.ReadP #ifdef DEBUG import HUnit #endif -- ----------------------------------------------------------------------------- -- The Version type #if ( __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 603 ) || __NHC__ -- Code copied from Data.Version in GHC 6.3+ : -- These #ifdefs are necessary because this code might be compiled as -- part of ghc/lib/compat, and hence might be compiled by an older version -- of GHC. In which case, we might need to pick up ReadP from -- Distribution.Compat.ReadP, because the version in -- Text.ParserCombinators.ReadP doesn't have all the combinators we need. #if __GLASGOW_HASKELL__ <= 602 || __NHC__ import Distribution.Compat.ReadP #else import Text.ParserCombinators.ReadP #endif #if __GLASGOW_HASKELL__ < 602 import Data.Dynamic ( Typeable(..), TyCon, mkTyCon, mkAppTy ) #else import Data.Typeable ( Typeable ) #endif import Data.List ( intersperse, sort ) import Data.Char ( isDigit, isAlphaNum ) {- | A 'Version' represents the version of a software entity. An instance of 'Eq' is provided, which implements exact equality modulo reordering of the tags in the 'versionTags' field. An instance of 'Ord' is also provided, which gives lexicographic ordering on the 'versionBranch' fields (i.e. 2.1 > 2.0, 1.2.3 > 1.2.2, etc.). This is expected to be sufficient for many uses, but note that you may need to use a more specific ordering for your versioning scheme. For example, some versioning schemes may include pre-releases which have tags @"pre1"@, @"pre2"@, and so on, and these would need to be taken into account when determining ordering. In some cases, date ordering may be more appropriate, so the application would have to look for @date@ tags in the 'versionTags' field and compare those. The bottom line is, don't always assume that 'compare' and other 'Ord' operations are the right thing for every 'Version'. Similarly, concrete representations of versions may differ. One possible concrete representation is provided (see 'showVersion' and 'parseVersion'), but depending on the application a different concrete representation may be more appropriate. -} data Version = Version { versionBranch :: [Int], -- ^ The numeric branch for this version. This reflects the -- fact that most software versions are tree-structured; there -- is a main trunk which is tagged with versions at various -- points (1,2,3...), and the first branch off the trunk after -- version 3 is 3.1, the second branch off the trunk after -- version 3 is 3.2, and so on. The tree can be branched -- arbitrarily, just by adding more digits. -- -- We represent the branch as a list of 'Int', so -- version 3.2.1 becomes [3,2,1]. Lexicographic ordering -- (i.e. the default instance of 'Ord' for @[Int]@) gives -- the natural ordering of branches. versionTags :: [String] -- really a bag -- ^ A version can be tagged with an arbitrary list of strings. -- The interpretation of the list of tags is entirely dependent -- on the entity that this version applies to. } deriving (Read,Show #if __GLASGOW_HASKELL__ >= 602 ,Typeable #endif ) #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 602 versionTc :: TyCon versionTc = mkTyCon "Version" instance Typeable Version where typeOf _ = mkAppTy versionTc [] #endif instance Eq Version where v1 == v2 = versionBranch v1 == versionBranch v2 && sort (versionTags v1) == sort (versionTags v2) -- tags may be in any order instance Ord Version where v1 `compare` v2 = versionBranch v1 `compare` versionBranch v2 -- ----------------------------------------------------------------------------- -- A concrete representation of 'Version' -- | Provides one possible concrete representation for 'Version'. For -- a version with 'versionBranch' @= [1,2,3]@ and 'versionTags' -- @= ["tag1","tag2"]@, the output will be @1.2.3-tag1-tag2@. -- showVersion :: Version -> String showVersion (Version branch tags) = concat (intersperse "." (map show branch)) ++ concatMap ('-':) tags -- | A parser for versions in the format produced by 'showVersion'. -- #if __GLASGOW_HASKELL__ <= 602 parseVersion :: ReadP r Version #else parseVersion :: ReadP Version #endif parseVersion = do branch <- sepBy1 (liftM read $ munch1 isDigit) (char '.') tags <- many (char '-' >> munch1 isAlphaNum) return Version{versionBranch=branch, versionTags=tags} #endif -- ----------------------------------------------------------------------------- -- Version ranges -- Todo: maybe move this to Distribution.Package.Version? -- (package-specific versioning scheme). data VersionRange = AnyVersion | ThisVersion Version -- = version | LaterVersion Version -- > version (NB. not >=) | EarlierVersion Version -- < version -- ToDo: are these too general? | UnionVersionRanges VersionRange VersionRange | IntersectVersionRanges VersionRange VersionRange deriving (Show,Read,Eq) orLaterVersion :: Version -> VersionRange orLaterVersion v = UnionVersionRanges (ThisVersion v) (LaterVersion v) orEarlierVersion :: Version -> VersionRange orEarlierVersion v = UnionVersionRanges (ThisVersion v) (EarlierVersion v) betweenVersionsInclusive :: Version -> Version -> VersionRange betweenVersionsInclusive v1 v2 = IntersectVersionRanges (orLaterVersion v1) (orEarlierVersion v2) laterVersion :: Version -> Version -> Bool v1 `laterVersion` v2 = versionBranch v1 > versionBranch v2 earlierVersion :: Version -> Version -> Bool v1 `earlierVersion` v2 = versionBranch v1 < versionBranch v2 -- |Does this version fall within the given range? withinRange :: Version -> VersionRange -> Bool withinRange _ AnyVersion = True withinRange v1 (ThisVersion v2) = v1 == v2 withinRange v1 (LaterVersion v2) = v1 `laterVersion` v2 withinRange v1 (EarlierVersion v2) = v1 `earlierVersion` v2 withinRange v1 (UnionVersionRanges v2 v3) = v1 `withinRange` v2 || v1 `withinRange` v3 withinRange v1 (IntersectVersionRanges v2 v3) = v1 `withinRange` v2 && v1 `withinRange` v3 showVersionRange :: VersionRange -> String showVersionRange AnyVersion = "-any" showVersionRange (ThisVersion v) = '=' : '=' : showVersion v showVersionRange (LaterVersion v) = '>' : showVersion v showVersionRange (EarlierVersion v) = '<' : showVersion v showVersionRange (UnionVersionRanges (ThisVersion v1) (LaterVersion v2)) | v1 == v2 = '>' : '=' : showVersion v1 showVersionRange (UnionVersionRanges (LaterVersion v2) (ThisVersion v1)) | v1 == v2 = '>' : '=' : showVersion v1 showVersionRange (UnionVersionRanges (ThisVersion v1) (EarlierVersion v2)) | v1 == v2 = '<' : '=' : showVersion v1 showVersionRange (UnionVersionRanges (EarlierVersion v2) (ThisVersion v1)) | v1 == v2 = '<' : '=' : showVersion v1 showVersionRange (UnionVersionRanges r1 r2) = showVersionRange r1 ++ "||" ++ showVersionRange r2 showVersionRange (IntersectVersionRanges r1 r2) = showVersionRange r1 ++ "&&" ++ showVersionRange r2 -- ------------------------------------------------------------ -- * Package dependencies -- ------------------------------------------------------------ data Dependency = Dependency String VersionRange deriving (Read, Show, Eq) -- ------------------------------------------------------------ -- * Parsing -- ------------------------------------------------------------ -- ----------------------------------------------------------- parseVersionRange :: ReadP r VersionRange parseVersionRange = do f1 <- factor skipSpaces (do string "||" skipSpaces f2 <- factor return (UnionVersionRanges f1 f2) +++ do string "&&" skipSpaces f2 <- factor return (IntersectVersionRanges f1 f2) +++ return f1) where factor = choice ((string "-any" >> return AnyVersion) : map parseRangeOp rangeOps) parseRangeOp (s,f) = string s >> skipSpaces >> liftM f parseVersion rangeOps = [ ("<", EarlierVersion), ("<=", orEarlierVersion), (">", LaterVersion), (">=", orLaterVersion), ("==", ThisVersion) ] #ifdef DEBUG -- ------------------------------------------------------------ -- * Testing -- ------------------------------------------------------------ -- |Simple version parser wrapper doVersionParse :: String -> Either String Version doVersionParse input = case results of [y] -> Right y [] -> Left "No parse" _ -> Left "Ambigous parse" where results = [ x | (x,"") <- readP_to_S parseVersion input ] branch1 :: [Int] branch1 = [1] branch2 :: [Int] branch2 = [1,2] branch3 :: [Int] branch3 = [1,2,3] release1 :: Version release1 = Version{versionBranch=branch1, versionTags=[]} release2 :: Version release2 = Version{versionBranch=branch2, versionTags=[]} release3 :: Version release3 = Version{versionBranch=branch3, versionTags=[]} hunitTests :: [Test] hunitTests = [ "released version 1" ~: "failed" ~: (Right $ release1) ~=? doVersionParse "1", "released version 3" ~: "failed" ~: (Right $ release3) ~=? doVersionParse "1.2.3", "range comparison LaterVersion 1" ~: "failed" ~: True ~=? release3 `withinRange` (LaterVersion release2), "range comparison LaterVersion 2" ~: "failed" ~: False ~=? release2 `withinRange` (LaterVersion release3), "range comparison EarlierVersion 1" ~: "failed" ~: True ~=? release3 `withinRange` (LaterVersion release2), "range comparison EarlierVersion 2" ~: "failed" ~: False ~=? release2 `withinRange` (LaterVersion release3), "range comparison orLaterVersion 1" ~: "failed" ~: True ~=? release3 `withinRange` (orLaterVersion release3), "range comparison orLaterVersion 2" ~: "failed" ~: True ~=? release3 `withinRange` (orLaterVersion release2), "range comparison orLaterVersion 3" ~: "failed" ~: False ~=? release2 `withinRange` (orLaterVersion release3), "range comparison orEarlierVersion 1" ~: "failed" ~: True ~=? release2 `withinRange` (orEarlierVersion release2), "range comparison orEarlierVersion 2" ~: "failed" ~: True ~=? release2 `withinRange` (orEarlierVersion release3), "range comparison orEarlierVersion 3" ~: "failed" ~: False ~=? release3 `withinRange` (orEarlierVersion release2) ] #endif hugs98-plus-Sep2006/packages/Cabal/Distribution/attic0000644006511100651110000000414210504340326021247 0ustar rossross rawSystemEmit :: FilePath -- ^Script name -> Bool -- ^if true, emit, if false, run -> Int -- ^Verbosity -> FilePath -- ^Program to run -> [String] -- ^Args -> IO () rawSystemEmit _ False verbosity path args = rawSystemExit verbosity path args rawSystemEmit scriptName True verbosity path args = writeFile scriptName ("#!/bin/sh\n\n" ++ (path ++ concatMap (' ':) args) ++ "\n") >> putStrLn (path ++ concatMap (' ':) args) -- build the executables sequence_ [rawSystemExit (compilerPath (compiler lbi)) ["--make", modName, "-o" ++ exeName] | (exeName, modName, _) <- executables pkg_descr] TestLabel "Config" $ TestList [ "config prefix ghc given package tool" ~: "failed" ~: basicGhcConfig ~=? (parseArgs ["--prefix=/lib", "--ghc", "--with-compiler=/bin/ghc", "--with-pkg=/bin/ghc-pkg", "configure"]), "find package tool" ~: "failed" ~: basicGhcConfig ~=? (parseArgs ["--prefix=/lib", "--ghc", "--with-compiler=/bin/ghc", "configure"]), "locate compiler and package tool" ~: "failed" ~: realGhcConfig ~=? (parseArgs ["configure", "--ghc"]), "should we default to the current compiler?" ~: "failed" ~: realGhcConfig ~=? (parseArgs ["configure"])], let basicGhcConfig = (ConfigCmd [Prefix "/lib", GhcFlag, (LocalBuildInfo "/lib" (Compiler GHC "/bin/ghc" "/bin/ghc-pkg")), []) let realGhcConfig = (ConfigCmd (LocalBuildInfo "" (Compiler Hugs "" "")), []) hugs98-plus-Sep2006/packages/Cabal/Language/0000755006511100651110000000000010504340326017263 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/Language/Haskell/0000755006511100651110000000000010504340326020646 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/Language/Haskell/Extension.hs0000644006511100651110000000575210504340326023167 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Extension -- Copyright : Isaac Jones 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : portable -- -- Haskell language extensions {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Language.Haskell.Extension ( Extension(..), ) where -- ------------------------------------------------------------ -- * Extension -- ------------------------------------------------------------ -- NB: if you add a constructor to 'Extension', be sure also to -- add it to Distribution.Compiler.extensionsTo_X_Flag -- (where X is each compiler) -- |This represents language extensions beyond Haskell 98 that are -- supported by some implementations, usually in some special mode. data Extension = OverlappingInstances | UndecidableInstances | IncoherentInstances | RecursiveDo | ParallelListComp | MultiParamTypeClasses | NoMonomorphismRestriction | FunctionalDependencies | Rank2Types | RankNTypes | PolymorphicComponents | ExistentialQuantification | ScopedTypeVariables | ImplicitParams | FlexibleContexts | FlexibleInstances | EmptyDataDecls | CPP | BangPatterns | TypeSynonymInstances | TemplateHaskell | ForeignFunctionInterface | InlinePhase | ContextStack | Arrows | Generics | NoImplicitPrelude | NamedFieldPuns | PatternGuards | GeneralizedNewtypeDeriving | ExtensibleRecords | RestrictedTypeSynonyms | HereDocuments deriving (Show, Read, Eq) hugs98-plus-Sep2006/packages/Cabal/LICENSE0000644006511100651110000000276010504340326016552 0ustar rossrossCopyright Isaac Jones 2003-2005. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/Cabal/Makefile.inc0000644006511100651110000000022310504340326017745 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/Cabal/Makefile0000644006511100651110000001414410504340326017204 0ustar rossrossTOP=.. ifeq "$(findstring boilerplate.mk, $(wildcard $(TOP)/mk/*))" "" # ---------------------------------------------------------------------------- # Standalone Makefile: CABALVERSION=1.1.5.9.2 KIND=rc #KIND=latest GHCFLAGS= --make -fno-warn-unused-matches -cpp # later: -Wall PREF=/usr/local USER_FLAG = GHCPKGFLAGS = HC=ghc HC_PKG=ghc-pkg # Comment out this line if your system doesn't have System.Posix. ISPOSIX=-DHAVE_UNIX_PACKAGE ifdef user USER_FLAG = --user GHCPKGFLAGS = -f ~/.ghc-packages GHCFLAGS += -package-conf ~/.ghc-packages endif # the cabal tarball... CABALBALL=cabal-$(CABALVERSION).tar.gz all: moduleTest # build the library itself setup:: mkdir -p dist/tmp $(HC) $(GHCFLAGS) -i. -odir dist/tmp -hidir dist/tmp Setup.lhs -o setup Setup-nhc: hmake -nhc98 -package base -prelude Setup config: setup ./setup configure --ghc --prefix=$(PREF) build: build-stamp build-stamp: config ./setup build # cd cabal-install && mkdir -p dist/tmp && $(HC) $(GHCFLAGS) -i.. -odir dist/tmp -hidir dist/tmp Setup.lhs -o setup && ./setup configure --ghc --prefix=$(PREF) && ./setup build # cd cabal-setup && mkdir -p dist/tmp && $(HC) $(GHCFLAGS) -i.. -odir dist/tmp -hidir dist/tmp Setup.hs -o setup && ./setup configure --ghc --prefix=$(PREF) && ./setup build install: build-stamp ./setup install $(USER_FLAG) # cd cabal-install && ./setup install # cd cabal-setup && ./setup install hugsbootstrap: rm -rf dist/tmp dist/hugs mkdir -p dist/tmp mkdir dist/hugs cp -r Distribution dist/tmp hugs-package dist/tmp dist/hugs cp Setup.lhs Cabal.cabal dist/hugs hugsinstall: hugsbootstrap cd dist/hugs && ./Setup.lhs configure --hugs cd dist/hugs && ./Setup.lhs build cd dist/hugs && ./Setup.lhs install haddock: setup ./setup configure ./setup haddock clean-doc: cd doc && $(MAKE) clean doc: haddock docbook2html doc/Cabal.xml --output doc/users-guide clean: clean-cabal clean-hunit clean-test clean-doc clean-cabal: -rm -f Distribution/*.o Distribution/*.hi -rm -f Distribution/Simple/*.o Distribution/Simple/*.hi -rm -f Compat/*.o Compat/*.hi -rm -f darcs* out.build *~ semantic.cache* x*.html -rm -f library-infrastructure--darcs.tar.gz -rm -rf setup *.o *.hi moduleTest dist installed-pkg-config -rm -f build-stamp -rm -rf dist/hugs clean-hunit: -rm -f hunit-stamp hunitInstall-stamp cd tests/HUnit-1.0 && $(MAKE) clean clean-test: cd tests/A && $(MAKE) clean cd tests/wash2hs && $(MAKE) clean remove: remove-cabal remove-hunit remove-cabal: -$(HC_PKG) $(GHCPKGFLAGS) -r Cabal -rm -rf $(PREF)/lib/Cabal-0.1 remove-hunit: -$(HC_PKG) $(GHCPKGFLAGS) -r HUnit -rm -rf $(PREF)/lib/HUnit-1.0 # dependencies (included): hunit: hunit-stamp hunit-stamp: cd tests/HUnit-1.0 && $(MAKE) && ./setup configure --prefix=$(PREF) && ./setup build touch $@ hunitInstall: hunitInstall-stamp hunitInstall-stamp: hunit-stamp cd tests/HUnit-1.0 && ./setup install $(USER_FLAG) touch $@ # testing... moduleTest: mkdir -p dist/debug $(HC) $(GHCFLAGS) $(ISPOSIX) -DDEBUG -odir dist/debug -hidir dist/debug -idist/debug/:src:tests/HUnit-1.0/src tests/ModuleTest.hs -o moduleTest tests: moduleTest clean cd tests/A && $(MAKE) clean cd tests/HUnit-1.0 && $(MAKE) clean cd tests/A && $(MAKE) cd tests/HUnit-1.0 && $(MAKE) check: rm -f moduleTest $(MAKE) moduleTest ./moduleTest # distribution... pushall: darcs push ijones@darcs.haskell.org:/home/darcs/cabal darcs push ijones@darcs.haskell.org:/home/darcs/packages/Cabal pullall: darcs pull ijones@darcs.haskell.org:/home/darcs/cabal darcs pull ijones@darcs.haskell.org:/home/darcs/packages/Cabal pushdist: pushall dist scp $(TMPDISTLOC)/cabal.tar.gz ijones@www.haskell.org:~/cabal/cabal-code.tgz # PUSH ELSEWHERE: scp changelog ijones@www.haskell.org:~/cabal/release/changelog # PUSH ELSEWHERE: scp releaseNotes ijones@www.haskell.org:~/cabal/release/notes # rm -f /tmp/cabal-code.tgz deb: dist cd $(TMPDISTLOC) && ln -s $(CABALBALL) haskell-cabal_$(CABALVERSION).orig.tar.gz cd $(TMPDISTLOC) && tar -zxvf $(CABALBALL) mv $(TMPDISTLOC)/cabal $(TMPDISTLOC)/haskell-cabal-$(CABALVERSION) cd $(TMPDISTLOC)/haskell-cabal-$(CABALVERSION) && debuild $(CABALBALL): darcs record rm -rf /tmp/cabal* /tmp/Cabal* rm -rf $(TMPDISTLOC) darcs dist --dist-name=cabal-$(CABALVERSION) TMPDISTLOC=/tmp/cabaldist # after this command, there will be cabal.tar.gz in $(TMPDISTLOC), # which will have built docs, haddock, and source code. dist: haddock $(CABALBALL) rm -rf $(TMPDISTLOC) mkdir $(TMPDISTLOC) mv $(CABALBALL) $(TMPDISTLOC) cd $(TMPDISTLOC) && tar -zxvf $(CABALBALL) #mkdir $(TMPDISTLOC)/cabal/doc $(MAKE) doc cp -r dist/doc/html $(TMPDISTLOC)/cabal-$(CABALVERSION)/doc/API cp -r doc/users-guide $(TMPDISTLOC)/cabal-$(CABALVERSION)/doc/users-guide cd ~/prgs/build/haskell-report/packages && docbook2html -o /tmp/pkg-spec-html pkg-spec.sgml && docbook2pdf pkg-spec.sgml -o /tmp cp -r /tmp/pkg-spec{-html,.pdf} $(TMPDISTLOC)/cabal-$(CABALVERSION)/doc cd $(TMPDISTLOC) && rm -f $(CABALBALL) && tar -zcvf $(CABALBALL) cabal-$(CABALVERSION) @echo "Cabal tarball built: $(TMPDISTLOC)/$(CABALBALL)" release: dist mkdir $(TMPDISTLOC)/release cp $(TMPDISTLOC)/cabal-$(CABALVERSION)/releaseNotes $(TMPDISTLOC)/release cp $(TMPDISTLOC)/cabal-$(CABALVERSION)/changelog $(TMPDISTLOC)/release cp -r $(TMPDISTLOC)/cabal-$(CABALVERSION)/doc $(TMPDISTLOC)/release cp $(TMPDISTLOC)/cabal-$(CABALVERSION).tar.gz $(TMPDISTLOC)/release/cabal-$(CABALVERSION).tar.gz scp -r $(TMPDISTLOC)/release www.haskell.org:/home/haskell/cabal/release/cabal-$(CABALVERSION) ssh www.haskell.org 'cd /home/haskell/cabal/release && rm -f $(KIND) && ln -s cabal-$(CABALVERSION) $(KIND)' else # boilerplate.mk exists # ---------------------------------------------------------------------------- # GHC build tree Makefile: include $(TOP)/mk/boilerplate.mk SUBDIRS = doc #cabal-setup ALL_DIRS = \ Distribution \ Distribution/Simple \ Distribution/PreProcess \ Distribution/Compat \ Language/Haskell EXCLUDED_SRCS = DefaultSetup.lhs PACKAGE = Cabal VERSION = 1.1.4 PACKAGE_DEPS = base SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries (Cabal package)" SRC_HC_OPTS += -cpp include $(TOP)/mk/target.mk endif hugs98-plus-Sep2006/packages/Cabal/Network/0000755006511100651110000000000010504340326017171 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/Network/Hackage/0000755006511100651110000000000010504340326020514 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/0000755006511100651110000000000010504340326023045 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/BuildDep.hs0000644006511100651110000000244310504340326025074 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.BuildDep -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- High level interface to a specialized instance of package installation. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.BuildDep where import Network.Hackage.CabalInstall.Dependency (getPackages, getBuildDeps, resolveDependenciesAux) import Network.Hackage.CabalInstall.Install (installPkg) import Network.Hackage.CabalInstall.Types (ConfigFlags (..), UnresolvedDependency) import Distribution.Simple.Configure (getInstalledPackages) {-| This function behaves exactly like 'Network.Hackage.CabalInstall.Install.install' except that it only builds the dependencies for packages. -} buildDep :: ConfigFlags -> [String] -> [UnresolvedDependency] -> IO () buildDep cfg globalArgs deps = do ipkgs <- getInstalledPackages (configCompiler cfg) (configUser cfg) (configVerbose cfg) apkgs <- fmap getPackages (fmap (getBuildDeps ipkgs) (resolveDependenciesAux cfg ipkgs deps)) mapM_ (installPkg cfg globalArgs) apkgs hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Clean.hs0000644006511100651110000000145410504340326024427 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Clean -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Clean ( clean ) where import Network.Hackage.CabalInstall.Types (ConfigFlags) import Network.Hackage.CabalInstall.Fetch (packagesDirectory) import System.Directory (removeDirectoryRecursive) -- | 'clean' removes all downloaded packages from the {config-dir}\/packages\/ directory. clean :: ConfigFlags -> IO () clean cfg = removeDirectoryRecursive (packagesDirectory cfg) hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Config.hs0000644006511100651110000000576010504340326024616 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Config -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- Utilities for handling saved state such as known packages, known servers and downloaded packages. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Config ( packagesDirectoryName , getKnownServers , getKnownPackages , writeKnownPackages , selectValidConfigDir ) where import Control.Monad.Error (mplus, filterM) -- Using Control.Monad.Error to get the Error instance for IO. import System.Directory (Permissions (..), getPermissions) import Distribution.Package (PackageIdentifier) import Distribution.Version (Dependency) import Distribution.Compat.FilePath (joinFileName) import Network.Hackage.CabalInstall.Types (ConfigFlags (..), PkgInfo (..)) pkgListFile :: FilePath pkgListFile = "pkg.list" servListFile :: FilePath servListFile = "serv.list" -- |Name of the packages directory. packagesDirectoryName :: FilePath packagesDirectoryName = "packages" pkgList :: ConfigFlags -> FilePath pkgList cfg = configConfPath cfg `joinFileName` pkgListFile servList :: ConfigFlags -> FilePath servList cfg = configConfPath cfg `joinFileName` servListFile -- |Read the list of known packages from the pkg.list file. getKnownPackages :: ConfigFlags -> IO [PkgInfo] getKnownPackages cfg = fmap read (readFile (pkgList cfg)) `mplus` return [] -- |Write the list of known packages to the pkg.list file. writeKnownPackages :: ConfigFlags -> [PkgInfo] -> IO () writeKnownPackages cfg pkgs = writeFile (pkgList cfg) (show pkgs) getKnownServers :: ConfigFlags -> IO [String] getKnownServers cfg = fmap read (readFile (servList cfg)) `mplus` return [] -- |Confirms validity of a config directory by checking the permissions for the package-list file, -- server-list file and downloaded packages directory. isValidConfigDir :: FilePath -> IO Bool isValidConfigDir path = do checks <- sequence [ checkFiles readable [ path , path `joinFileName` servListFile ]] return (and checks) -- |Picks the first valid config directory or throws an exception if none were found. selectValidConfigDir :: [FilePath] -> IO FilePath selectValidConfigDir paths = do valids <- filterM isValidConfigDir paths case valids of [] -> error "No valid config dir found!" (x:_) -> return x checkFiles :: (Permissions -> Bool) -> [FilePath] -> IO Bool checkFiles check = worker True where worker r [] = return r worker r (x:xs) = do permissions <- getPermissions x if check permissions then worker r xs else return False `mplus` worker False xs hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Configure.hs0000644006511100651110000001455310504340326025332 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Configure -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- Functions used to generate ConfigFlags. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Configure ( defaultOutputGen , mkConfigFlags ) where import Control.Monad (guard, mplus, when) import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen (..) , TempFlags (..), ResolvedPackage (..)) import Network.Hackage.CabalInstall.Config (getKnownServers, selectValidConfigDir) import qualified Distribution.Simple.Configure as Configure (findProgram, configCompiler) import Distribution.ParseUtils (showDependency) import Distribution.Package (showPackageId) import Distribution.Compat.FilePath (joinFileName) import Text.Printf (printf) import System.IO (openFile, IOMode (..)) import System.Directory (getHomeDirectory, getAppUserDataDirectory) import Data.Maybe (fromMaybe) {-| Structure with default responses to various events. -} defaultOutputGen :: Int -> IO OutputGen defaultOutputGen verbose = do (outch,errch) <- do guard (verbose <= 1) nullOut <- openFile "/dev/null" AppendMode nullErr <- openFile "/dev/null" AppendMode return (Just nullOut, Just nullErr) `mplus` return (Nothing,Nothing) return OutputGen { prepareInstall = \_pkgs -> return () , pkgIsPresent = printf "'%s' is present.\n" . showPackageId , downloadingPkg = printf "Downloading '%s'\n" . showPackageId , executingCmd = \cmd args -> when (verbose > 0) $ printf "Executing: '%s %s'\n" cmd (unwords args) , cmdFailed = \cmd args errno -> error (printf "Command failed: '%s %s'. Errno: %d\n" cmd (unwords args) errno) , buildingPkg = printf "Building '%s'\n" . showPackageId , stepConfigPkg = const (printf " Configuring...\n") , stepBuildPkg = const (printf " Building...\n") , stepInstallPkg = const (printf " Installing...\n") , stepFinishedPkg= const (printf " Done.\n") , noSetupScript = const (error "Couldn't find a setup script in the tarball.") , noCabalFile = const (error "Couldn't find a .cabal file in the tarball") , gettingPkgList = \serv -> when (verbose > 0) (printf "Downloading package list from server '%s'\n" serv) , showPackageInfo = showPkgInfo , showOtherPackageInfo = showOtherPkg , cmdStdout = outch , cmdStderr = errch } where showOtherPkg mbPkg dep = do printf " Package: '%s'\n" (show $ showDependency dep) case mbPkg of Nothing -> printf " Not available!\n\n" Just pkg -> do printf " Using: %s\n" (showPackageId pkg) printf " Installed: Yes\n\n" showPkgInfo mbPath installed ops dep (pkg,location,deps) = do printf " Package: '%s'\n" (show $ showDependency dep) printf " Using: %s\n" (showPackageId pkg) printf " Installed: %s\n" (if installed then "Yes" else "No") printf " Depends: %s\n" (showDeps deps) printf " Options: %s\n" (unwords ops) printf " Location: %s\n" location printf " Local: %s\n\n" (fromMaybe "*Not downloaded" mbPath) showDeps = show . map showDep showDep dep = show (showDependency (fulfilling dep)) findProgramOrDie :: String -> Maybe FilePath -> IO FilePath findProgramOrDie name p = fmap (fromMaybe (error $ printf "No %s found." name)) (Configure.findProgram name p) -- |Compute the default prefix when doing a local install ('~/usr' on Linux). localPrefix :: IO FilePath localPrefix = do home <- getHomeDirectory return (home `joinFileName` "usr") -- |Compute the local config directory ('~/.cabal-install' on Linux). localConfigDir :: IO FilePath localConfigDir = getAppUserDataDirectory "cabal-install" {-| Give concrete answers to questions like: * where to find \'runhaskell\'. * where to find \'tar\'. * which compiler to use. * which config-directory to use. -} mkConfigFlags :: TempFlags -> IO ConfigFlags mkConfigFlags cfg = do runHc <- findProgramOrDie "runhaskell" (tempRunHc cfg) tarProg <- findProgramOrDie "tar" (tempTarPath cfg) comp <- Configure.configCompiler (tempHcFlavor cfg) (tempHcPath cfg) (tempHcPkg cfg) (tempVerbose cfg) localConfig <- localConfigDir prefix <- if tempUserIns cfg || tempUser cfg then fmap Just (maybe localPrefix return (tempPrefix cfg)) else return Nothing confPath <- selectValidConfigDir ( maybe id (:) (tempConfPath cfg) ["/etc/cabal-install" ,localConfig] ) when (tempVerbose cfg > 0) $ printf "Using config dir: %s\n" confPath outputGen <- defaultOutputGen (tempVerbose cfg) let config = ConfigFlags { configCompiler = comp , configConfPath = confPath , configPrefix = prefix , configServers = [] , configTarPath = tarProg , configRunHc = runHc , configOutputGen = outputGen , configVerbose = tempVerbose cfg -- , configUpgradeDeps = tempUpgradeDeps cfg , configUser = tempUser cfg , configUserIns = tempUserIns cfg || tempUser cfg } knownServers <- getKnownServers config return (config{ configServers = knownServers ++ tempServers cfg}) hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Dependency.hs0000644006511100651110000002234610504340326025466 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Dependency -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- Various kinds of dependency resolution and utilities. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Dependency ( -- * Dependency resolution resolveDependencies , resolveDependenciesAux -- * Utilities , getPackages -- :: [ResolvedPackage] -> [(PackageIdentifier,[String],String)] , getBuildDeps -- :: [PackageIdentifier] -> [ResolvedPackage] -> [ResolvedPackage] , filterFetchables -- :: [ResolvedPackage] -> [(PackageIdentifier,String)] , fulfillDependency -- :: Dependency -> PackageIdentifier -> Bool ) where import Distribution.Version (Dependency(..), withinRange) import Distribution.Package (PackageIdentifier(..)) import Distribution.ParseUtils (showDependency) import Network.Hackage.Interface import Data.List (nub, maximumBy) import Data.Maybe (mapMaybe) import Control.Monad (guard) import Network.Hackage.CabalInstall.Config (getKnownPackages) import Network.Hackage.CabalInstall.Types ( ResolvedPackage(..), UnresolvedDependency(..) , ConfigFlags (..), PkgInfo (..)) import Text.Printf (printf) -- |Flattens a list of dependencies, filtering out installed packages. -- Packages dependencies are placed before the packages and duplicate entries -- are removed. flattenDepList :: [PackageIdentifier] -- ^List of installed packages. -> [ResolvedPackage] -- ^List of resolved packages. -> [ResolvedPackage] flattenDepList ps deps = nub $ worker deps where isBeingInstalled dep = not . null $ flip mapMaybe deps $ \rpkg -> do (pkg,_,_) <- resolvedData rpkg guard (fulfillDependency dep pkg) worker [] = [] worker (pkgInfo:xs) = case getLatestPkg ps (fulfilling pkgInfo) of Just _pkg -> worker xs Nothing -> case resolvedData pkgInfo of Just (_pkg,_location,subDeps) -> worker (filter (not.isBeingInstalled.fulfilling) subDeps) ++ pkgInfo:worker xs Nothing -> pkgInfo:worker xs -- |Flattens a dependency list while only keeping the dependencies of the packages. -- This is used for installing all the dependencies of a package but not the package itself. getBuildDeps :: [PackageIdentifier] -> [ResolvedPackage] -> [ResolvedPackage] getBuildDeps ps deps = nub $ concatMap worker deps where worker pkgInfo = case getLatestPkg ps (fulfilling pkgInfo) of Just _pkg -> [] Nothing -> case resolvedData pkgInfo of Just (_pkg,_location,subDeps) -> flattenDepList ps subDeps Nothing -> [] {- getReverseDeps :: [PackageIdentifier] -- All installed packages. -> [(PackageIdentifier,[Dependency],String)] -- Known packages. -> [(PackageIdentifier,[Dependency],String)] -- Resolved and installed packages. -> [(PackageIdentifier,[String],String)] -- Packages to be installed. -> [(PackageIdentifier,[String],String)] getReverseDeps ps knownPkgs ipkgs toBeInstalled = nub $ concatMap resolve $ filter depends ipkgs where depends (_pkg,deps,_location) = or (map (\dep -> or (map (\(p,_,_) -> fulfillDependency dep p) toBeInstalled)) deps) resolve (pkg,deps,location) = let resolveDep dep = case find (\(p,_,_) -> fulfillDependency dep p) knownPkgs of Just (pkg,_,location) -> Just (pkg,[],location) Nothing | pkg `elem` ps -> Nothing | otherwise -> error "Urk!" in mapMaybe resolveDep deps ++ [(pkg,[],location)] -- |Find the dependencies and location for installed packages. -- Packages not located on a Hackage server will be filtered out. filterInstalledPkgs :: [PackageIdentifier] -> [(PackageIdentifier,[Dependency],String)] -> [(PackageIdentifier,[Dependency],String)] filterInstalledPkgs ipkgs knownPkgs = filter worker knownPkgs where worker (pkg,_deps,_location) = pkg `elem` ipkgs -} depToUnresolvedDep :: Dependency -> UnresolvedDependency depToUnresolvedDep dep = UnresolvedDependency { dependency = dep , depOptions = [] } resolvedDepToResolvedPkg :: (Dependency,Maybe ResolvedDependency) -> ResolvedPackage resolvedDepToResolvedPkg (dep,rDep) = ResolvedPackage { fulfilling = dep , resolvedData = rData , pkgOptions = [] } where rData = do ResolvedDependency pkg location subDeps <- rDep return ( pkg , location , map resolvedDepToResolvedPkg subDeps ) -- |Locates a @PackageIdentifier@ which satisfies a given @Dependency@. -- Fails with "cannot satisfy dependency: %s." where %s == the given dependency. getLatestPkg :: (Monad m) => [PackageIdentifier] -> Dependency -> m PackageIdentifier getLatestPkg ps dep = case filter (fulfillDependency dep) ps of [] -> fail $ printf "cannot satisfy dependency: %s." (show (showDependency dep)) qs -> let pkg = maximumBy versions qs versions a b = pkgVersion a `compare` pkgVersion b in return pkg -- |Evaluates to @True@ if the given @Dependency@ is satisfied by the given @PackageIdentifer@. fulfillDependency :: Dependency -> PackageIdentifier -> Bool fulfillDependency (Dependency depName vrange) pkg = pkgName pkg == depName && pkgVersion pkg `withinRange` vrange getDependency :: [PkgInfo] -> UnresolvedDependency -> ResolvedPackage getDependency ps (UnresolvedDependency { dependency=dep@(Dependency pkgname vrange) , depOptions=opts}) = case filter ok ps of [] -> ResolvedPackage { fulfilling = dep , resolvedData = Nothing , pkgOptions = opts } qs -> let PkgInfo { infoId = pkg, infoDeps = deps, infoURL = location } = maximumBy versions qs versions a b = pkgVersion (infoId a) `compare` pkgVersion (infoId b) in ResolvedPackage { fulfilling = dep , resolvedData = Just ( pkg , location , (map (getDependency ps) (map depToUnresolvedDep deps))) , pkgOptions = opts } where ok PkgInfo{ infoId = p } = pkgName p == pkgname && pkgVersion p `withinRange` vrange -- |Get the PackageIdentifier, build options and location from a list of resolved packages. -- Throws an exception if a package couldn't be resolved. getPackages :: [ResolvedPackage] -> [(PackageIdentifier,[String],String)] getPackages = map worker where worker dep = case resolvedData dep of Nothing -> error $ printf "Couldn't satisfy dependency: '%s'." (show $ showDependency (fulfilling dep)) Just (pkg,location,_) -> (pkg,pkgOptions dep,location) -- |List all packages which can be fetched. filterFetchables :: [ResolvedPackage] -> [(PackageIdentifier,String)] filterFetchables = mapMaybe worker where worker dep = do (pkg,location,_) <- resolvedData dep return (pkg,location) -- |Resolve some dependencies from the known packages while filtering out installed packages. -- The result hasn't been modified to put the dependencies in front of the packages. resolveDependenciesAux :: ConfigFlags -> [PackageIdentifier] -- ^Installed packages. -> [UnresolvedDependency] -- ^Dependencies in need of resolution. -> IO [ResolvedPackage] resolveDependenciesAux cfg ps deps = do knownPkgs <- getKnownPackages cfg let resolved = map (resolve knownPkgs) (filter isNotInstalled deps) return resolved where isNotInstalled pkgDep = not (or (map (fulfillDependency (dependency pkgDep)) ps)) resolve pkgs dep = let rDep = getDependency pkgs dep in case resolvedData rDep of Nothing -> resolvedDepToResolvedPkg (dependency dep,Nothing) _ -> rDep -- |Resolve some dependencies from the known packages while filtering out installed packages. -- The result has been modified to put the dependencies in front of the packages. resolveDependencies :: ConfigFlags -> [PackageIdentifier] -- ^Installed packages. -> [UnresolvedDependency] -- ^Dependencies in need of resolution. -> IO [ResolvedPackage] resolveDependencies cfg ps deps = fmap (flattenDepList ps) (resolveDependenciesAux cfg ps deps) hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Fetch.hs0000644006511100651110000001177510504340326024445 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Fetch -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Fetch ( -- * Commands fetch , -- * Utilities fetchPackage , packageFile , packagesDirectory , isFetched , readURI ) where import Network.URI (URI,parseURI,uriScheme,uriPath) import Network.HTTP (ConnError(..), Request (..), simpleHTTP , Response(..), RequestMethod (..)) import Control.Monad (filterM) import Text.Printf (printf) import System.Directory (doesFileExist, createDirectoryIfMissing) import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen (..), UnresolvedDependency (..)) import Network.Hackage.CabalInstall.Config (packagesDirectoryName) import Network.Hackage.CabalInstall.Dependency (filterFetchables, resolveDependencies) import Distribution.Package (PackageIdentifier, showPackageId) import Distribution.Compat.FilePath (joinFileName) import System.Directory (copyFile) import Text.ParserCombinators.ReadP (readP_to_S) import Distribution.ParseUtils (parseDependency) readURI :: URI -> IO String readURI uri | uriScheme uri == "file:" = (readFile $ uriPath uri) | otherwise = do eitherResult <- simpleHTTP (Request uri GET [] "") case eitherResult of Left err -> fail $ printf "Failed to download '%s': %s" (show uri) (show err) Right rsp | rspCode rsp == (2,0,0) -> return (rspBody rsp) | otherwise -> fail $ "Failed to download '" ++ show uri ++ "': Invalid HTTP code: " ++ show (rspCode rsp) downloadURI :: FilePath -- ^ Where to put it -> URI -- ^ What to download -> IO (Maybe ConnError) downloadURI path uri | uriScheme uri == "file:" = do copyFile (uriPath uri) path return Nothing | otherwise = do eitherResult <- simpleHTTP request case eitherResult of Left err -> return (Just err) Right rsp | rspCode rsp == (2,0,0) -> writeFile path (rspBody rsp) >> return Nothing | otherwise -> return (Just (ErrorMisc ("Invalid HTTP code: " ++ show (rspCode rsp)))) where request = Request uri GET [] "" downloadFile :: FilePath -> String -> IO (Maybe ConnError) downloadFile path url = case parseURI url of Just parsed -> downloadURI path parsed Nothing -> return (Just (ErrorMisc ("Failed to parse url: " ++ show url))) -- Downloads a package to [config-dir/packages/package-id] and returns the path to the package. downloadPackage :: ConfigFlags -> PackageIdentifier -> String -> IO String downloadPackage cfg pkg url = do mbError <- downloadFile path url case mbError of Just err -> fail $ printf "Failed to download '%s': %s" (showPackageId pkg) (show err) Nothing -> return path where path = configConfPath cfg `joinFileName` packagesDirectoryName `joinFileName` showPackageId pkg -- |Full path to the packages directory. packagesDirectory :: ConfigFlags -> FilePath packagesDirectory cfg = configConfPath cfg `joinFileName` packagesDirectoryName -- |Generate the full path to a given @PackageIdentifer@. packageFile :: ConfigFlags -> PackageIdentifier -> FilePath packageFile cfg pkg = packagesDirectory cfg `joinFileName` (showPackageId pkg) -- |Returns @True@ if the package has already been fetched. isFetched :: ConfigFlags -> PackageIdentifier -> IO Bool isFetched cfg pkg = doesFileExist (packageFile cfg pkg) -- |Fetch a package if we don't have it already. fetchPackage :: ConfigFlags -> PackageIdentifier -> String -> IO String fetchPackage cfg pkg location = do createDirectoryIfMissing True (packagesDirectory cfg) fetched <- isFetched cfg pkg if fetched then return (packageFile cfg pkg) else downloadPackage cfg pkg location -- |Fetch a list of packages and their dependencies. fetch :: ConfigFlags -> [String] -> IO () fetch cfg pkgs = do apkgs <- fmap filterFetchables (resolveDependencies cfg [] (map parseDep pkgs)) mapM_ (\(pkg,location) -> do downloadingPkg output pkg fetchPackage cfg pkg location ) =<< filterM isNotFetched apkgs where parseDep dep = case readP_to_S parseDependency dep of [] -> error ("Failed to parse package dependency: " ++ show dep) x -> UnresolvedDependency { dependency = (fst (last x)) , depOptions = [] } isNotFetched (pkg,_location) = do fetched <- isFetched cfg pkg pkgIsPresent output pkg return (not fetched) output = configOutputGen cfg hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Info.hs0000644006511100651110000000445410504340326024303 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Info -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- High level interface to a dry-run package installation. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Info where import Network.Hackage.CabalInstall.Dependency (resolveDependencies, fulfillDependency) import Network.Hackage.CabalInstall.Fetch (isFetched, packageFile) import Network.Hackage.CabalInstall.Types (ConfigFlags(..), ResolvedPackage(..) ,UnresolvedDependency(..), OutputGen(..)) import Distribution.Package (PackageIdentifier) import Distribution.Simple.Configure (getInstalledPackages) import Data.Maybe (listToMaybe) info :: ConfigFlags -> [String] -> [UnresolvedDependency] -> IO () info cfg globalArgs deps = do ipkgs <- getInstalledPackages (configCompiler cfg) (configUser cfg) (configVerbose cfg) apkgs <- resolveDependencies cfg [] deps mapM_ (infoPkg cfg ipkgs globalArgs) apkgs {-| 'infoPkg' displays various information about a package. This information can be used to figure out what packages will be installed, from where they'll be downloaded and what options will be parsed to them. -} infoPkg :: ConfigFlags -> [PackageIdentifier] -> [String] -> ResolvedPackage -> IO () infoPkg cfg ipkgs _ (ResolvedPackage { fulfilling = dep , resolvedData = Nothing }) = showOtherPackageInfo output installedPkg dep where installedPkg = listToMaybe (filter (fulfillDependency dep) ipkgs) output = configOutputGen cfg infoPkg cfg ipkgs globalArgs (ResolvedPackage { fulfilling = dep , pkgOptions = ops , resolvedData = (Just (pkg,location,deps)) }) = do fetched <- isFetched cfg pkg let pkgFile = if fetched then Just (packageFile cfg pkg) else Nothing showPackageInfo output pkgFile isInstalled (globalArgs ++ ops) dep (pkg,location,deps) where output = configOutputGen cfg isInstalled = pkg `elem` ipkgs hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Install.hs0000644006511100651110000001536010504340326025014 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Install -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- High level interface to package installation. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Install ( install -- :: ConfigFlags -> [UnresolvedDependency] -> IO () , installPkg -- :: ConfigFlags -> (PackageIdentifier,[String],String) -> IO () ) where import Control.Exception (bracket_) import Network.Hackage.CabalInstall.Dependency (getPackages, resolveDependencies) import Network.Hackage.CabalInstall.Fetch (isFetched, packageFile, fetchPackage) import Network.Hackage.CabalInstall.Types (ConfigFlags(..), UnresolvedDependency(..) ,OutputGen(..)) import Network.Hackage.CabalInstall.TarUtils import Distribution.Simple.Configure (getInstalledPackages) import Distribution.Package (showPackageId, PackageIdentifier) import Distribution.Compat.FilePath (joinFileName, splitFileName) import Text.Printf (printf) import System.Directory (getTemporaryDirectory, createDirectoryIfMissing ,removeDirectoryRecursive, copyFile) import System.Process (runProcess, waitForProcess, terminateProcess) import System.Exit (ExitCode(..)) import System.Posix.Signals -- |Installs the packages needed to satisfy a list of dependencies. install :: ConfigFlags -> [String] -> [UnresolvedDependency] -> IO () install cfg globalArgs deps = do ipkgs <- getInstalledPackages (configCompiler cfg) (configUser cfg) (configVerbose cfg) apkgs <- fmap getPackages (resolveDependencies cfg ipkgs deps) mapM_ (installPkg cfg globalArgs) apkgs -- Fetch a package and output nice messages. downloadPkg :: ConfigFlags -> PackageIdentifier -> String -> IO FilePath downloadPkg cfg pkg location = do fetched <- isFetched cfg pkg if fetched then do pkgIsPresent (configOutputGen cfg) pkg return (packageFile cfg pkg) else do downloadingPkg (configOutputGen cfg) pkg fetchPackage cfg pkg location whenFlag :: Bool -> String -> [String] -> [String] whenFlag True = (:) whenFlag False = flip const -- Attach the correct prefix flag to configure commands, -- correct --user flag to install commands and no options to other commands. mkPkgOps :: ConfigFlags -> String -> [String] -> [String] mkPkgOps cfg "configure" ops = let ops' = whenFlag (configUser cfg) "--user" ops in maybe id (\p -> (:) ("--prefix="++p)) (configPrefix cfg) ops' mkPkgOps cfg "install" _ops | configUserIns cfg = return "--user" mkPkgOps _cfg _ _ops = [] {-| Download, build and install a given package with some given flags. The process is divided up in a few steps: * The package is downloaded to {config-dir}\/packages\/{pkg-id} (if not already there). * The fetched tarball is then moved to a temporary directory (\/tmp on linux) and unpacked. * The lowest directory with a .cabal file is located and searched for a \'Setup.lhs\' or \'Setup.hs\' file. * \'runhaskell [Setup script] configure\' is called with the user specified options, \'--user\' if the 'configUser' flag is @True@ and \'--prefix=[PREFIX]\' if 'configPrefix' is not @Nothing@. * \'runhaskell [Setup script] build\' is called with no options. * \'runhaskell [Setup script] install\' is called with the \'--user\' flag if 'configUserIns' is @True@. * The installation finishes by deleting the unpacked tarball. -} installPkg :: ConfigFlags -> [String] -- ^Options which will be parse to every package. -> (PackageIdentifier,[String],String) -- ^(Package, list of configure options, package location) -> IO () installPkg cfg globalArgs (pkg,ops,location) = do pkgPath <- downloadPkg cfg pkg location tmp <- getTemporaryDirectory let tmpDirPath = tmp `joinFileName` printf "TMP%sTMP" (showPackageId pkg) tmpPkgPath = tmpDirPath `joinFileName` printf "TAR%s.tgz" (showPackageId pkg) setup setupScript cmd = let (path,script) = splitFileName setupScript cmdOps = mkPkgOps cfg cmd (globalArgs++ops) in do executingCmd output runHc (script:cmd:cmdOps) h <- runProcess runHc (script:cmd:cmdOps) (Just (tmpDirPath `joinFileName` path)) Nothing Nothing (cmdStdout output) (cmdStderr output) oldHandler <- installHandler keyboardSignal (Catch (terminateProcess h)) Nothing e <- waitForProcess h installHandler keyboardSignal oldHandler Nothing case e of ExitFailure err -> cmdFailed output cmd (script:cmd:cmdOps) err _ -> return () bracket_ (createDirectoryIfMissing True tmpDirPath) (removeDirectoryRecursive tmpDirPath) (do copyFile pkgPath tmpPkgPath extractTarFile tarProg tmpPkgPath installUnpackedPkg cfg pkg tmpPkgPath setup return ()) where runHc = configRunHc cfg tarProg = configTarPath cfg output = configOutputGen cfg installUnpackedPkg :: ConfigFlags -> PackageIdentifier -> FilePath -> (String -> String -> IO ()) -> IO () installUnpackedPkg cfg pkgId tarFile setup = do tarFiles <- tarballGetFiles tarProg tarFile let cabalFile = locateFileExt tarFiles "cabal" case cabalFile of Just f -> let (path,_) = splitFileName f mbScript = locateFile tarFiles path ["Setup.lhs", "Setup.hs"] in case mbScript of Just script -> do buildingPkg output pkgId stepConfigPkg output pkgId setup script "configure" stepBuildPkg output pkgId setup script "build" stepInstallPkg output pkgId setup script "install" stepFinishedPkg output pkgId return () Nothing -> noSetupScript output pkgId Nothing -> noCabalFile output pkgId where output = configOutputGen cfg tarProg = configTarPath cfg hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/List.hs0000644006511100651110000000320210504340326024311 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Install -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- High level interface to package installation. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.List ( list -- :: ConfigFlags -> [UnresolvedDependency] -> IO () ) where import Text.Regex import Data.Maybe (catMaybes, isJust) import Data.List (find, nub) import Distribution.Package import Distribution.PackageDescription import Network.Hackage.CabalInstall.Config (getKnownPackages) import Network.Hackage.CabalInstall.Types (PkgInfo(..), ConfigFlags(..), UnresolvedDependency(..) ,OutputGen(..)) -- |Show information about packages list :: ConfigFlags -> [String] -> IO () list cfg pats = do pkgs <- getKnownPackages cfg mapM_ doList $ if null pats then pkgs else nub (concatMap (findInPkgs pkgs) pats) where findInPkgs :: [PkgInfo] -> String -> [PkgInfo] findInPkgs pkgs pat = let rx = mkRegexWithOpts pat False False in filter (isJust . matchRegex rx . showInfo) pkgs showInfo :: PkgInfo -> String showInfo pkg = showPackageId (infoId pkg) ++ "\n" ++ infoSynopsis pkg doList :: PkgInfo -> IO () doList info = do putStr . (if null syn then id else padTo 25) . showPackageId . infoId $ info putStrLn syn where syn = infoSynopsis info padTo n s = s ++ (replicate (n - length s) ' ') hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Main.hs0000644006511100651110000000326410504340326024272 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Main -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- Entry point to the default cabal-install front-end. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Main where import System.Environment (getArgs) import Network.Hackage.CabalInstall.Types (Action (..)) import Network.Hackage.CabalInstall.Setup (parseGlobalArgs, parseInstallArgs) import Network.Hackage.CabalInstall.Configure (mkConfigFlags) import Network.Hackage.CabalInstall.List (list) import Network.Hackage.CabalInstall.Install (install) import Network.Hackage.CabalInstall.Info (info) import Network.Hackage.CabalInstall.Update (update) import Network.Hackage.CabalInstall.Fetch (fetch) import Network.Hackage.CabalInstall.Clean (clean) import Network.Hackage.CabalInstall.BuildDep (buildDep) main :: IO () main = do args <- getArgs (action, flags, args) <- parseGlobalArgs args config <- mkConfigFlags flags let runCmd f = do (globalArgs, pkgs) <- parseInstallArgs args f config globalArgs pkgs case action of InstallCmd -> runCmd install BuildDepCmd -> runCmd buildDep InfoCmd -> runCmd info ListCmd -> list config args UpdateCmd -> update config CleanCmd -> clean config FetchCmd -> fetch config args _ -> putStrLn "Unhandled command." hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Setup.hs0000644006511100651110000002116710504340326024510 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Setup -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Setup ( emptyTempFlags , parseInstallArgs , parseGlobalArgs ) where import Text.ParserCombinators.ReadP (readP_to_S) import Distribution.ParseUtils (parseDependency) import Distribution.Setup (defaultCompilerFlavor, CompilerFlavor(..)) import Data.List (find) import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..), usageInfo, getOpt') import System.Exit (exitWith, ExitCode (..)) import System.Environment (getProgName) import Network.Hackage.CabalInstall.Types (TempFlags (..), Flag (..), Action (..) , UnresolvedDependency (..)) emptyTempFlags :: TempFlags emptyTempFlags = TempFlags { tempHcFlavor = defaultCompilerFlavor, -- Nothing, tempHcPath = Nothing, tempConfPath = Nothing, tempHcPkg = Nothing, tempPrefix = Nothing, tempServers = [], tempRunHc = Nothing, tempTarPath = Nothing, tempVerbose = 3, -- tempUpgradeDeps = False, tempUser = False, tempUserIns = False } cmd_verbose :: OptDescr Flag cmd_verbose = Option "v" ["verbose"] (OptArg verboseFlag "n") "Control verbosity (n is 0--5, normal verbosity level is 1, -v alone is equivalent to -v3)" where verboseFlag mb_s = Verbose (maybe 3 read mb_s) globalOptions :: [OptDescr Flag] globalOptions = [ Option "h?" ["help"] (NoArg HelpFlag) "Show this help text" , cmd_verbose , Option "g" ["ghc"] (NoArg GhcFlag) "compile with GHC" , Option "n" ["nhc"] (NoArg NhcFlag) "compile with NHC" , Option "" ["hugs"] (NoArg HugsFlag) "compile with hugs" , Option "s" ["with-server"] (ReqArg WithServer "URL") "give the URL to a Hackage server" , Option "c" ["config-path"] (ReqArg WithConfPath "PATH") "give the path to the config dir. Default is /etc/cabal-install" , Option "" ["tar-path"] (ReqArg WithTarPath "PATH") "give the path to tar" , Option "w" ["with-compiler"] (ReqArg WithCompiler "PATH") "give the path to a particular compiler" , Option "" ["with-hc-pkg"] (ReqArg WithHcPkg "PATH") "give the path to the package tool" -- , Option "" ["upgrade-deps"] (NoArg UpgradeDeps) -- "Upgrade all dependencies which depend on the newly installed packages" , Option "" ["user-install"] (NoArg UserInstallFlag) "upon registration, register this package in the user's local package database" , Option "" ["global-install"] (NoArg GlobalInstallFlag) "upon registration, register this package in the system-wide package database" , Option "" ["user-deps"] (NoArg UserFlag) "allow dependencies to be satisfied from the user package database" , Option "" ["global-deps"] (NoArg GlobalFlag) "(default) dependencies must be satisfied from the global package database" ] data Cmd = Cmd { cmdName :: String, cmdHelp :: String, -- Short description cmdDescription :: String, -- Long description cmdOptions :: [OptDescr Flag ], cmdAction :: Action } commandList :: [Cmd] commandList = [fetchCmd, installCmd, buildDepCmd, updateCmd, cleanCmd, listCmd, infoCmd] lookupCommand :: String -> [Cmd] -> Maybe Cmd lookupCommand name = find ((==name) . cmdName) printGlobalHelp :: IO () printGlobalHelp = do pname <- getProgName let syntax_line = concat [ "Usage: ", pname , " [GLOBAL FLAGS]\n or: ", pname , " COMMAND [FLAGS]\n\nGlobal flags:"] putStrLn (usageInfo syntax_line globalOptions) putStrLn "Commands:" let maxlen = maximum [ length (cmdName cmd) | cmd <- commandList ] sequence_ [ do putStr " " putStr (align maxlen (cmdName cmd)) putStr " " putStrLn (cmdHelp cmd) | cmd <- commandList ] where align n str = str ++ replicate (n - length str) ' ' printCmdHelp :: Cmd -> IO () printCmdHelp cmd = do pname <- getProgName let syntax_line = "Usage: " ++ pname ++ " " ++ cmdName cmd ++ " [FLAGS]\n\nFlags for " ++ cmdName cmd ++ ":" putStrLn (usageInfo syntax_line (cmdOptions cmd)) putStr (cmdDescription cmd) -- We don't want to use elem, because that imposes Eq a hasHelpFlag :: [Flag] -> Bool hasHelpFlag flags = not . null $ [ () | HelpFlag <- flags ] parseGlobalArgs :: [String] -> IO (Action,TempFlags,[String]) parseGlobalArgs args = case getOpt' RequireOrder globalOptions args of (flags, _, _, []) | hasHelpFlag flags -> do printGlobalHelp exitWith ExitSuccess (flags, cname:cargs, _, []) -> do case lookupCommand cname commandList of Just cmd -> return (cmdAction cmd,mkTempFlags flags emptyTempFlags, cargs) Nothing -> do putStrLn $ "Unrecognised command: " ++ cname ++ " (try --help)" exitWith (ExitFailure 1) (_, [], _, []) -> do putStrLn $ "No command given (try --help)" exitWith (ExitFailure 1) (_, _, _, errs) -> do putStrLn "Errors:" mapM_ putStrLn errs exitWith (ExitFailure 1) mkTempFlags :: [Flag] -> TempFlags -> TempFlags mkTempFlags = updateCfg where updateCfg (fl:flags) t = updateCfg flags $ case fl of GhcFlag -> t { tempHcFlavor = Just GHC } NhcFlag -> t { tempHcFlavor = Just NHC } HugsFlag -> t { tempHcFlavor = Just Hugs } WithCompiler path -> t { tempHcPath = Just path } WithConfPath path -> t { tempConfPath = Just path } WithHcPkg path -> t { tempHcPkg = Just path } WithServer url -> t { tempServers = url:tempServers t } Verbose n -> t { tempVerbose = n } -- UpgradeDeps -> t { tempUpgradeDeps = True } UserFlag -> t { tempUser = True } GlobalFlag -> t { tempUser = False } UserInstallFlag -> t { tempUserIns = True } GlobalInstallFlag -> t { tempUserIns = False } _ -> error $ "Unexpected flag!" updateCfg [] t = t mkCmd :: String -> String -> String -> Action -> Cmd mkCmd name help desc action = Cmd { cmdName = name , cmdHelp = help , cmdDescription = desc , cmdOptions = [] , cmdAction = action } fetchCmd :: Cmd fetchCmd = mkCmd "fetch" "Downloads packages for later installation or study." "" FetchCmd installCmd :: Cmd installCmd = mkCmd "install" "Installs a list of packages." "" InstallCmd listCmd :: Cmd listCmd = mkCmd "list" "List available packages on the server." "" ListCmd buildDepCmd :: Cmd buildDepCmd = mkCmd "build-dep" "Installs the dependencies for a list of packages." "" BuildDepCmd updateCmd :: Cmd updateCmd = mkCmd "update" "Updates list of known packages" "" UpdateCmd cleanCmd :: Cmd cleanCmd = mkCmd "clean" "Removes downloaded files" "" CleanCmd infoCmd :: Cmd infoCmd = mkCmd "info" "Emit some info" "Emits information about dependency resolution" InfoCmd parseInstallArgs :: [String] -> IO ([String],[UnresolvedDependency]) parseInstallArgs [] = do printCmdHelp installCmd exitWith ExitSuccess parseInstallArgs args = return (globalArgs,parsePkgArgs pkgs) where (globalArgs,pkgs) = break (not.(==)'-'.head) args parseDep dep = case readP_to_S parseDependency dep of [] -> error ("Failed to parse package dependency: " ++ show dep) x -> fst (last x) parsePkgArgs [] = [] parsePkgArgs (x:xs) = let (args,rest) = break (not.(==) '-'.head) xs in (UnresolvedDependency { dependency = parseDep x , depOptions = args } ):parsePkgArgs rest hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/TarUtils.hs0000644006511100651110000000652310504340326025156 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.TarUtils -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- Utility functions for manipulating tar archives. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.TarUtils ( tarballGetFiles , locateFile , locateFileExt , extractTarFile ) where import Distribution.Compat.FilePath (splitFileName, splitFileExt, breakFilePath) import System.IO (hClose, hGetContents) import System.Process (runInteractiveProcess, runProcess, waitForProcess) import System.Exit (ExitCode(..)) import Text.Printf (printf) import Data.List (find, sortBy) import Data.Maybe (listToMaybe) -- |List the files in a gzipped tar archive. Throwing an exception on failure. tarballGetFiles :: FilePath -- ^Path to the 'tar' binary. -> FilePath -- ^Path to the .tgz archive. -> IO [FilePath] tarballGetFiles tarProg tarFile = do (inch,out,_,handle) <- runInteractiveProcess tarProg args Nothing Nothing hClose inch files <- hGetContents out length files `seq` hClose out eCode <- waitForProcess handle case eCode of ExitFailure err -> error $ printf "Failed to get filelist from '%s': %s." tarFile (show err) _ -> return (lines files) where args = ["--list" ,"--gunzip" ,"--file" ,tarFile] {-| Find a file in a given directory. @ locateFile [\"somedir\/jalla.txt\"] \"somedir\" [\"jalla.txt\"] => Just \"somedir\/jalla.txt\" locateFile [\"somepkg\/pkg.cabal\", \"somepkg\/Setup.hs\"] \"somepkg\" [\"Setup.lhs\", \"Setup.hs\"] => Just \"somedir\/Setup.hs\" @ -} locateFile :: [FilePath] -- ^File list. -> FilePath -- ^Base directory. -> [FilePath] -- ^List of filenames to locate. -> Maybe FilePath locateFile files dir names = find findFile files where findFile file = let (root,name) = splitFileName file in root == dir && name `elem` names {-| Locate all files with a given extension and return the shortest result. @ locateFileExt [\"somedir\/test.cabal\"] \"cabal\" => Just \"somedir\/test.cabal\" @ -} locateFileExt :: [FilePath] -> String -> Maybe FilePath locateFileExt files fileExt = let okExts = filter (\f -> let (_,ext) = splitFileExt f in ext == fileExt) files in (listToMaybe (sortBy sortFn okExts)) where comparing f a b = f a `compare` f b sortFn = comparing (length.breakFilePath) -- |Extract a given archive in the directory where it's placed. extractTarFile :: FilePath -- ^Path to the 'tar' binary. -> FilePath -- ^Path to the .tgz archive. -> IO () extractTarFile tarProg tarFile = do tarHandle <- runProcess tarProg args (Just dir) Nothing Nothing Nothing Nothing eCode <- waitForProcess tarHandle case eCode of ExitFailure err -> error $ printf "Failed to extract tar file '%s': %s." tarFile (show err) _ -> return () where args = ["-xzf",tarFile] (dir,_) = splitFileName tarFile hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Types.hs0000644006511100651110000001067510504340326024516 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Types -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- All data types for the entire cabal-install system gathered here to avoid some .hs-boot files. ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Types where import Distribution.Setup (CompilerFlavor(..),Compiler) import Distribution.Package (PackageIdentifier) import Distribution.Version (Dependency) import System.IO (Handle) data PkgInfo = PkgInfo { infoId :: PackageIdentifier , infoDeps :: [Dependency] , infoSynopsis :: String , infoURL :: String } deriving (Show, Read, Eq) data Action = FetchCmd | InstallCmd | BuildDepCmd | CleanCmd | UpdateCmd | InfoCmd | HelpCmd | ListCmd data TempFlags = TempFlags { tempHcFlavor :: Maybe CompilerFlavor, tempHcPath :: Maybe FilePath, -- ^given compiler location tempConfPath :: Maybe FilePath, tempHcPkg :: Maybe FilePath, -- ^given hc-pkg location tempPrefix :: Maybe FilePath, tempServers :: [String], -- ^Available Hackage servers. tempTarPath :: Maybe FilePath, tempRunHc :: Maybe FilePath, tempVerbose :: Int, -- ^verbosity level -- tempUpgradeDeps :: Bool, tempUser :: Bool, -- ^--user flag tempUserIns :: Bool -- ^--user-install flag } data ConfigFlags = ConfigFlags { configCompiler :: Compiler, configConfPath :: FilePath, configPrefix :: Maybe FilePath, configServers :: [String], -- ^Available Hackage servers. configTarPath :: FilePath, configRunHc :: FilePath, configOutputGen :: OutputGen, configVerbose :: Int, -- configUpgradeDeps :: Bool, configUser :: Bool, -- ^--user flag configUserIns :: Bool -- ^--user-install flag } data Flag = GhcFlag | NhcFlag | HugsFlag | WithCompiler FilePath | WithHcPkg FilePath | WithConfPath FilePath | WithTarPath FilePath | WithServer String | UserFlag | GlobalFlag | UserInstallFlag | GlobalInstallFlag -- | UpgradeDeps | HelpFlag | Verbose Int data OutputGen = OutputGen { prepareInstall :: [(PackageIdentifier,[String],String)] -> IO () , pkgIsPresent :: PackageIdentifier -> IO () , downloadingPkg :: PackageIdentifier -> IO () , executingCmd :: String -> [String] -> IO () , cmdFailed :: String -> [String] -> Int -> IO () -- cmd, flags and errno. , buildingPkg :: PackageIdentifier -> IO () -- Package is fetched and unpacked. Starting installation. , stepConfigPkg :: PackageIdentifier -> IO () , stepBuildPkg :: PackageIdentifier -> IO () , stepInstallPkg :: PackageIdentifier -> IO () , stepFinishedPkg:: PackageIdentifier -> IO () , noSetupScript :: PackageIdentifier -> IO () , noCabalFile :: PackageIdentifier -> IO () , gettingPkgList :: String -> IO () -- Server. , showPackageInfo :: Maybe FilePath -- pkg file if fetched. -> Bool -- is installed -> [String] -- Options -> Dependency -- Which dependency is this package supposed to fill -> (PackageIdentifier,String,[ResolvedPackage]) -> IO () , showOtherPackageInfo :: Maybe PackageIdentifier -- package if installed. -> Dependency -> IO () -- Show package which isn't available from any server. , cmdStdout :: Maybe Handle , cmdStderr :: Maybe Handle } data ResolvedPackage = ResolvedPackage { fulfilling :: Dependency , resolvedData :: Maybe ( PackageIdentifier -- pkg id , String -- pkg location , [ResolvedPackage] -- pkg dependencies ) , pkgOptions :: [String] } deriving Eq data UnresolvedDependency = UnresolvedDependency { dependency :: Dependency , depOptions :: [String] } hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/CabalInstall/Update.hs0000644006511100651110000000201210504340326024616 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Network.Hackage.CabalInstall.Update -- Copyright : (c) David Himmelstrup 2005 -- License : BSD-like -- -- Maintainer : lemmih@gmail.com -- Stability : provisional -- Portability : portable -- -- ----------------------------------------------------------------------------- module Network.Hackage.CabalInstall.Update ( update ) where import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen(..)) import Network.Hackage.CabalInstall.Config (writeKnownPackages) import Network.Hackage.Client (listPackages) -- | 'update' downloads the package list from all known servers update :: ConfigFlags -> IO () update cfg = do pkgs <- flip concatMapM servers $ \serv -> do gettingPkgList (configOutputGen cfg) serv listPackages serv writeKnownPackages cfg pkgs where servers = configServers cfg concatMapM f = fmap concat . mapM f hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/Interface.hs0000644006511100651110000000700110504340326022746 0ustar rossrossmodule Network.Hackage.Interface where import Distribution.Package(PackageIdentifier(..)) import Distribution.Version(Version(..), showVersion, VersionRange, Dependency(..), withinRange) import Network.XmlRpc.Server(ServerResult, fun, handleCall, methods) import Network.XmlRpc.Internals(XmlRpcType(..), Type(TStruct, TArray, TString), MethodCall, getField, Value(..)) import Control.Monad.State(Functor(..), MonadIO(..), mapM, gets, evalStateT) import Data.List import Data.Maybe -- Resolved dependency, pkg location and resolved dependencies of the dependency. data ResolvedDependency = ResolvedDependency PackageIdentifier String [(Dependency,Maybe ResolvedDependency)] deriving (Eq,Show) instance XmlRpcType PackageIdentifier where toValue p = toValue [("pkgName",toValue (pkgName p)), ("pkgVersion", toValue (pkgVersion p))] fromValue v = do t <- fromValue v name <- getField "pkgName" t version <- getField "pkgVersion" t return (PackageIdentifier name version) getType _ = TStruct instance XmlRpcType Version where toValue p = toValue [("branch",toValue (versionBranch p)), ("tags", toValue (versionTags p))] fromValue v = do t <- fromValue v branch <- getField "branch" t tags <- getField "tags" t return (Version branch tags) getType _ = TStruct instance XmlRpcType Dependency where toValue (Dependency name range) = toValue [("name",toValue name), ("range", toValue range)] fromValue v = do t <- fromValue v name <- getField "name" t range <- getField "range" t return (Dependency name range) getType _ = TStruct instance XmlRpcType ResolvedDependency where toValue (ResolvedDependency pkg location deps) = toValue [("pkg",toValue pkg), ("deps", toValue deps), ("location", toValue location)] fromValue v = do t <- fromValue v pkg <- getField "pkg" t deps <- getField "deps" t location <- getField "location" t return (ResolvedDependency pkg location deps) getType _ = TStruct instance (XmlRpcType a, XmlRpcType b) => XmlRpcType (a,b) where toValue (a,b) = toValue [("fst",toValue a), ("snd", toValue b)] fromValue v = do t <- fromValue v a <- getField "fst" t b <- getField "snd" t return (a,b) getType _ = TStruct instance (XmlRpcType a, XmlRpcType b, XmlRpcType c) => XmlRpcType (a,b,c) where toValue (a,b,c) = toValue [("fst", toValue a), ("snd", toValue b), ("trd", toValue c)] fromValue v = do t <- fromValue v a <- getField "fst" t b <- getField "snd" t c <- getField "trd" t return (a,b,c) getType _ = TStruct instance XmlRpcType VersionRange where toValue versionRange = toValue (show versionRange) fromValue v = do t <- fromValue v return (read t) getType _ = TString instance (XmlRpcType a) => XmlRpcType (Maybe a) where toValue Nothing = toValue ([]::[Value]) toValue (Just a) = toValue [toValue a] fromValue v = do t <- fromValue v case t of [x] -> fmap Just (fromValue x) _ -> return Nothing getType _ = TArray hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/Client.hs0000644006511100651110000000515710504340326022276 0ustar rossrossmodule Network.Hackage.Client where import Network.URI (URI,parseURI,uriScheme,uriPath) import Distribution.Package import Distribution.PackageDescription import Distribution.Version import Data.Version import Data.Maybe import Text.ParserCombinators.ReadP import Distribution.ParseUtils import Network.Hackage.CabalInstall.Types import Network.Hackage.CabalInstall.Fetch (readURI) type PathName = String -- Resolved dependency, pkg location and resolved dependencies of the dependency. data ResolvedDependency = ResolvedDependency PackageIdentifier String [(Dependency,Maybe ResolvedDependency)] deriving (Eq,Show) data Pkg = Pkg String [String] String deriving (Show, Read) getPkgDescription :: String -> PackageIdentifier -> IO (Maybe String) getPkgDescription url pkgId = do fmap Just ( getFrom url (pathOf pkgId "cabal") ) getPkgDescriptions :: String -> [PackageIdentifier] -> IO [Maybe String] getPkgDescriptions url pkgIds = mapM (getPkgDescription url) pkgIds getDependencies :: String -> [Dependency] -> IO [(Dependency, Maybe ResolvedDependency)] getDependencies _ _ = fail "getDependencies unimplemented" -- remote url "getDependencies" listPackages :: String -> IO [PkgInfo] listPackages url = do x <- getFrom url "00-latest.txt" -- remote url "listPackages" pkgs <- readIO x return $ map parsePkg pkgs where parsePkg :: Pkg -> PkgInfo parsePkg (Pkg ident deps pkgSynopsis) = PkgInfo { infoId = pkgId , infoDeps = pkgDeps , infoSynopsis = pkgSynopsis , infoURL = pkgURL } where pkgId = parseWith parsePackageId ident pkgDeps = map (parseWith parseDependency) deps pkgURL = url ++ "/" ++ pathOf pkgId "tar.gz" pathOf :: PackageIdentifier -> String -> PathName pathOf pkgId ext = concat [pkgName pkgId, "/", showPackageId pkgId, ".", ext] parseWith :: Show a => ReadP a -> String -> a parseWith f s = case reverse (readP_to_S f s) of ((x, _):_) -> x _ -> error s -- XXX - check for existence? getPkgLocation :: String -> PackageIdentifier -> IO (Maybe String) getPkgLocation url pkgId = return . Just $ url ++ "/" ++ pathOf pkgId "tar.gz" getServerVersion :: String -> IO Version getServerVersion url = fail "getServerVersion not implemented" -- remote url "getServerVersion" getFrom :: String -> String -> IO String getFrom base path = case parseURI uri of Just parsed -> readURI parsed Nothing -> fail $ "Failed to parse url: " ++ show uri where uri = base ++ "/" ++ path {- isCompatible :: String -> IO Bool isCompatible = fmap ((==) clientVersion) . getServerVersion -} hugs98-plus-Sep2006/packages/Cabal/Network/Hackage/Version.hs0000644006511100651110000000017010504340326022473 0ustar rossrossmodule Network.Hackage.Version where import Data.Version clientVersion :: Version clientVersion = Version [0,1,0] [] hugs98-plus-Sep2006/packages/Cabal/Makefile.nhc980000644006511100651110000000216310504340326020132 0ustar rossross# Hey Emacs, this is a -*- makefile -*- ! THISPKG = Cabal SEARCH = -package base EXTRA_H_FLAGS = -K4M EXTRA_HBC_FLAGS = -H80M -A4M SRCS = \ Distribution/Extension.hs \ Distribution/GetOpt.hs \ Distribution/InstalledPackageInfo.hs \ Distribution/License.hs \ Distribution/Make.hs \ Distribution/Package.hs \ Distribution/PackageDescription.hs \ Distribution/ParseUtils.hs \ Distribution/PreProcess.hs \ Distribution/Setup.hs \ Distribution/Simple.hs \ Distribution/Version.hs \ \ Distribution/Compat/Directory.hs \ Distribution/Compat/Exception.hs \ Distribution/Compat/FilePath.hs \ Distribution/Compat/RawSystem.hs \ Distribution/Compat/ReadP.hs \ \ Distribution/PreProcess/Unlit.hs \ \ Distribution/Simple/Build.hs \ Distribution/Simple/Configure.hs \ Distribution/Simple/GHCPackageConfig.hs \ Distribution/Simple/Install.hs \ Distribution/Simple/LocalBuildInfo.hs \ Distribution/Simple/Register.hs \ Distribution/Simple/SrcDist.hs \ Distribution/Simple/Utils.hs \ # Here are the main rules. include ../Makefile.common # Here are any extra dependencies. # C-files dependencies. hugs98-plus-Sep2006/packages/Cabal/debian/0000755006511100651110000000000010504340326016762 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/debian/README.Debian0000644006511100651110000000022510504340326021022 0ustar rossrosshaskell-cabal for Debian ------------------------ This is just a test package. -- Isaac Jones , Wed Jul 28 23:39:48 2004 hugs98-plus-Sep2006/packages/Cabal/debian/changelog0000644006511100651110000000654310504340326020644 0ustar rossrosshaskell-cabal (1.1.3) unstable; urgency=low * Release candidate for 1.2. * WARNING: Interfaces not documented in the user's guide may change in future releases. * Move building of GHCi .o libs to the build phase rather than register phase. (from Duncan Coutts) * Use .tar.gz for source package extension * Uses GHC instead of cpphs if the latter is not available * Added experimental "command hooks" which completely override the default behavior of a command. * Some bugfixes -- Isaac Jones Sat, 22 Oct 2005 11:38:59 -0700 haskell-cabal (1.1.1) unstable; urgency=low * Release candidate for 1.2. * WARNING: Interfaces not documented in the user's guide may change in future releases. * Handles recursive modules for GHC 6.2 and GHC 6.4. * Added "setup test" command (Used with UserHook) * implemented handling of _stub.{c,h,o} files * Added support for profiling * Changed install prefix of libraries (pref/pkgname-version to prefix/pkgname-version/compname-version) * Added pattern guards as a language extension * Moved some functionality to Language.Haskell.Extension * Register / unregister .bat files for windows * Exposed more of the API * Added support for the hide-all-packages flag in GHC > 6.4 * Several bug fixes -- Isaac Jones Sun, 17 Jul 2005 22:16:42 -0700 haskell-cabal (0.5-1) unstable; urgency=low * new upstream version. see upstream changelog for more info. * some interface changes, see upstream changelog -- Isaac Jones Sat, 19 Feb 2005 12:41:18 -0800 haskell-cabal (0.4-1) unstable; urgency=low * new upstream version. see upstream changelog for more info. * some interface changes, see upstream changelog. * bumped standards-version. -- Isaac Jones Sat, 15 Jan 2005 12:55:49 -0800 haskell-cabal (0.2-3) unstable; urgency=low * added depends on posix (Closes: #280244). -- Isaac Jones Mon, 8 Nov 2004 07:01:53 -0800 haskell-cabal (0.2-2) unstable; urgency=low * Removed spurious depends on ghc5. Should close 279988. I'll close that by hand once I'm sure. -- Isaac Jones Sun, 7 Nov 2004 14:21:38 -0800 haskell-cabal (0.2-1) unstable; urgency=low * New upstream release * Includes cleanup of treatment of the local packages file ~/.ghc-packages. Doesn't touch this file unless it's necessary. (Closes: #278667 Closes: #279556). * Some work on preprocessors. -- Isaac Jones Tue, 2 Nov 2004 20:06:22 -0800 haskell-cabal (0.1-4) unstable; urgency=low * Added basic infrastructure for multiple targets, though have not yet enabled it because it doesn't yet work upstream. -- John Goerzen Tue, 5 Oct 2004 19:45:27 -0500 haskell-cabal (0.1-3) unstable; urgency=low * Fixed old postinst, postrm scripts to do the right thing in more cases. -- John Goerzen Tue, 5 Oct 2004 16:25:29 -0500 haskell-cabal (0.1-2) unstable; urgency=low * Install binary under /usr/lib/haskell-libraries/ghc6 in keeping with new Haskell policy. -- John Goerzen Tue, 5 Oct 2004 15:56:03 -0500 haskell-cabal (0.1-1) unstable; urgency=low * Initial release. Closes: #275069. -- John Goerzen Tue, 05 Oct 2004 13:36:08 -0500 hugs98-plus-Sep2006/packages/Cabal/debian/compat0000644006511100651110000000000210504340326020160 0ustar rossross4 hugs98-plus-Sep2006/packages/Cabal/debian/control0000644006511100651110000000127310504340326020370 0ustar rossrossSource: haskell-cabal Priority: optional Maintainer: Isaac Jones Build-Depends: debhelper (>= 4.0.0), ghc6 (>= 6.2.2), ghc6 (6.4) Standards-Version: 3.6.1 Suggests: haddock, cpphs Package: libghc6-cabal-dev Section: devel Architecture: any Depends: ghc6 (>= 6.2.2), ghc6 (<< 6.2.3) Description: Haskell Common Architecture for Building Applications and Libraries The Haskell Cabal is a system for building and installing Haskell programs and libraries. It is aware of multiple different compilers and can handle them without trouble. . This package will provide the infrastructure necessary to build Cabalized packages on Debian machines, or to Debianize those packages. hugs98-plus-Sep2006/packages/Cabal/debian/copyright0000644006511100651110000000335310504340326020721 0ustar rossrossThis package was debianized by Isaac Jones on Wed, 28 Jul 2004 22:29:38 -0400. John Goerzen updated it for sid in October 5, 2004. It was downloaded from http://www.haskell.org/cabal/code.html Upstream Authors: Bjorn Bringert, Isaac Jones, Simon Marlow, Martin Sjögren Copyright: Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/Cabal/debian/dirs0000644006511100651110000000005010504340326017641 0ustar rossrossusr/bin usr/share/doc/libghc6-cabal-dev hugs98-plus-Sep2006/packages/Cabal/debian/docs0000644006511100651110000000002410504340326017631 0ustar rossrossREADME releaseNotes hugs98-plus-Sep2006/packages/Cabal/debian/haskell-cabal-dev.files0000644006511100651110000000011710504340326023244 0ustar rossrossusr/include/* usr/lib/lib*.a usr/lib/lib*.so usr/lib/pkgconfig/* /usr/lib/*.la hugs98-plus-Sep2006/packages/Cabal/debian/haskell-cabal-dev.dirs0000644006511100651110000000002410504340326023100 0ustar rossrossusr/lib usr/include hugs98-plus-Sep2006/packages/Cabal/debian/libghc6-cabal-dev.prerm0000644006511100651110000000216610504340326023170 0ustar rossross#! /bin/sh # prerm script for missingh # # see: dh_installdeb(1) set -e # summary of how this script can be called: # * `remove' # * `upgrade' # * `failed-upgrade' # * `remove' `in-favour' # * `deconfigure' `in-favour' # `removing' # # for details, see http://www.debian.org/doc/debian-policy/ or # the debian-policy package case "$1" in remove|upgrade|deconfigure) chmod +x /usr/share/doc/libghc6-cabal-dev/unregister.sh /usr/share/doc/libghc6-cabal-dev/unregister.sh rm -f /usr/lib/haskell-packages/ghc6/lib/Cabal-0.6/HSCabal*.o # install-info --quiet --remove /usr/info/missingh.info.gz ;; failed-upgrade) ;; *) echo "prerm called with unknown argument \`$1'" >&2 exit 1 ;; esac # dh_installdeb will replace this with shell code automatically # generated by other debhelper scripts. #DEBHELPER# exit 0 hugs98-plus-Sep2006/packages/Cabal/debian/haskell-cabal1.dirs0000644006511100651110000000001010504340326022400 0ustar rossrossusr/lib hugs98-plus-Sep2006/packages/Cabal/debian/haskell-cabal1.files0000644006511100651110000000002210504340326022544 0ustar rossrossusr/lib/lib*.so.* hugs98-plus-Sep2006/packages/Cabal/debian/rules0000644006511100651110000000564610504340326020052 0ustar rossross#!/usr/bin/make -f # -*- makefile -*- # Sample debian/rules that uses debhelper. # GNU copyright 1997 to 1999 by Joey Hess. # Uncomment this to turn on verbose mode. #export DH_VERBOSE=1 GHCVERSION=6.2.2 GHCPATH=/usr/lib/ghc-$(GHCVERSION)/bin PATH:=$(GHCPATH):$(PATH) export PATH CFLAGS = -Wall -g LIBPATH=/usr/lib/haskell-packages/$(1) PACKAGE=lib$(1)-cabal-dev FLAVORS=ghc6 define build_flavor echo BUILDING FOR $(1) -./setup clean rm -f .*config* ./setup configure --prefix=$(LIBPATH) --with-compiler=/usr/bin/$(1) ./setup build mkdir -p $(CURDIR)/debian/$(PACKAGE)/usr/share/doc/$(PACKAGE) cp -r $(CURDIR)/doc/API $(CURDIR)/debian/$(PACKAGE)/usr/share/doc/$(PACKAGE) cp -r $(CURDIR)/doc/users-guide $(CURDIR)/debian/$(PACKAGE)/usr/share/doc/$(PACKAGE) ./setup copy --copy-prefix=$(CURDIR)/debian/$(PACKAGE)$(LIBPATH) #generate the register and unregister scripts ./setup register --gen-script ./setup unregister --gen-script # install them for later cp register.sh $(CURDIR)/debian/$(PACKAGE)/usr/share/doc/$(PACKAGE)/register.sh cp unregister.sh $(CURDIR)/debian/$(PACKAGE)/usr/share/doc/$(PACKAGE)/unregister.sh endef ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS))) CFLAGS += -O0 else CFLAGS += -O2 endif ifeq (,$(findstring nostrip,$(DEB_BUILD_OPTIONS))) INSTALL_PROGRAM += -s endif # shared library versions, option 1 version=2.0.5 major=2 # option 2, assuming the library is created as src/.libs/libfoo.so.2.0.5 or so #version=`ls src/.libs/lib*.so.* | \ # awk '{if (match($$0,/[0-9]+\.[0-9]+\.[0-9]+$$/)) print substr($$0,RSTART)}'` #major=`ls src/.libs/lib*.so.* | \ # awk '{if (match($$0,/\.so\.[0-9]+$$/)) print substr($$0,RSTART+4)}'` configure: configure-stamp configure-stamp: dh_testdir # Add here commands to configure the package. make setup touch configure-stamp build: build-stamp build-stamp: configure-stamp dh_testdir # Add here commands to compile the package. touch build-stamp clean: dh_testdir dh_testroot rm -f build-stamp configure-stamp # Add here commands to clean up after the build process. -$(MAKE) clean rm -f .*config* dh_clean install: build dh_testdir dh_testroot dh_clean -k dh_installdirs $(foreach tgt,$(FLAVORS),$(call build_flavor,$(tgt))) # Build architecture-independent files here. binary-indep: build install # We have nothing to do by default. # Build architecture-dependent files here. binary-arch: build install dh_testdir dh_testroot dh_installchangelogs -a dh_installdocs -a dh_installexamples -a # dh_install # dh_installmenu # dh_installdebconf # dh_installlogrotate # dh_installemacsen # dh_installpam # dh_installmime # dh_installinit # dh_installcron # dh_installinfo dh_installman -a dh_link -a dh_strip -a dh_compress -a dh_fixperms -a # dh_perl # dh_python # dh_makeshlibs dh_installdeb -a dh_shlibdeps -a dh_gencontrol -a dh_md5sums -a dh_builddeb -a binary: binary-indep binary-arch .PHONY: build clean binary-indep binary-arch binary install configure hugs98-plus-Sep2006/packages/Cabal/debian/libghc6-cabal-dev.postinst0000644006511100651110000000202110504340326023714 0ustar rossross#! /bin/sh # postinst script for missingh # # see: dh_installdeb(1) set -e # summary of how this script can be called: # * `configure' # * `abort-upgrade' # * `abort-remove' `in-favour' # # * `abort-deconfigure' `in-favour' # `removing' # # for details, see http://www.debian.org/doc/debian-policy/ or # the debian-policy package # case "$1" in configure) chmod +x /usr/share/doc/libghc6-cabal-dev/register.sh /usr/share/doc/libghc6-cabal-dev/register.sh ;; abort-upgrade|abort-remove|abort-deconfigure) ;; *) echo "postinst called with unknown argument \`$1'" >&2 exit 1 ;; esac # dh_installdeb will replace this with shell code automatically # generated by other debhelper scripts. #DEBHELPER# exit 0 hugs98-plus-Sep2006/packages/Cabal/README0000644006511100651110000000661010504340326016423 0ustar rossrossCabal home page: http://www.haskell.org/cabal WARNING If you already have Cabal installed, including GHC 6.4 users, read "Working with older versions of Cabal" for information first! If you do this out of order, stuff might get screwy. If stuff gets screwy, post to libraries@haskell.org for help. -= Quirky things about the build system =- * If you don't already have Cabal installed: "make install" as root, then try "ghci -package Cabal" to test it. If you get an error about multiple versions of Cabal, read the section below "Working with older versions of Cabal" You were supposed to read this first. * The cabal should build just like any other Cabal-ized package. If you're using windows or have another means of building cabal packages, you might want to ignore the GNUmakefile altogether. * GNUmakefile is the one you're probably interested in. If you see Makefile, it is probably from the fptools build tree, and it won't work on its own. * The GNUmakefile wraps the standard Cabal setup script; the GNUmakefile is a convinience for bootstrapping the system. "sudo make install" should handle HUnit, generate the setup script, configure, build, install, and register it in a standard location. * HUnit is included both as a test case for Cabal, and because Cabal uses HUnit for testing. Don't panic. -= Working with older versions of Cabal =- * Installing as root / Administrator (GHC's global package file) This is the recommended method of installing Cabal. If you have an older version of Cabal installed, you probably just want to remove it: $ ghc-pkg unregister Cabal If you don't want to remove it, and want both the old and new versions installed, that's fine... In order to use the new one after installation you may have to specify which version you want when you run ghci. For instance: $ ghci -package Cabal ... ghc-6.4: Error; multiple packages match Cabal: Cabal-1.0, Cabal-1.1.3 $ ghci -package Cabal-1.1.3 ... (OK) * Installing as a user (no root or administer access) If you have cabal installed already, you can this command to remove it: $ ghc-pkg unregister Cabal --user If: 1) Cabal is installed in the global package file (use ghc-pkg -l to see) 2) You don't have root access 3) You need to install a newer version of Cabal in your user directory, then this formula may help to hide the global version: $ ghc-pkg describe Cabal-1.0 | ghc-pkg --user register - $ ghc-pkg --user hide Cabal-1.0 -= Your Help =- Portability is one of the most important things about this project. We don't expect the early releases to work on every system, but it should work on YOUR system! If it doesn't please help us figure out why, and write a patch and test case to fix the problem, if you can! The codebase is a very manageable size. -= Code =- You can get the code from the web page; the version control system we use is very open and welcoming to new developers. -= Debian Templates =- Build a Debian source tree with: dh_make -d -t /full/path/to/debiantemplates After, you just need to edit the copyright, description, and dependencies... -= Credits (in alphabetical order) =- Cabal Coders: - Krasimir Angelov - Bjorn Bringert - Isaac Jones - David Himmelstrup (Lemmih) - Simon Marlow - Ross Patterson - Martin Sjögren - Malcolm Wallace (via hmake) Cabal spec: - Isaac Jones - Simon Marlow - Ross Patterson - Simon Peyton Jones - Malcolm Wallace hugs98-plus-Sep2006/packages/Cabal/TODO0000644006511100651110000000770010504340326016234 0ustar rossrossOLD TODOS: * Parsing ** Allow quoting in the options fields, to allow things like -f"something with spaces" * Doc ** do comments have to start in the first column? ** clarify relationship between other-modules and modules, etc. ** add preprocessor explanation (see bottom of this TODO). ** Fix example for angela, expose Data.Set, etc, not A, B, etc.b ** add information about executable stanzas ** elimintate need for cpphs in haddock makefile rule. ** add info about deb packages to web page at least check out the manpage for dh_haskell, section "How to package a haskell library" * Misc ** HC-PKG (see "Depends on HC-PKG" below) ** add more layered tools to appendix? ** make reference to "layered tools" appendix where approprote ** integrate hscpp, use it for preprocessing step. ** SDist for windows machines, or machines without tar. ** add sanity checking command? * testing ** find a real test case that uses preprocessors ** add a make target or command for tests we know will fail? ** setup test suite to run on --push? ** redirect non-hunit outputs to a file? ** test / port code for Hugs ** error cases for parsing command-line args ** reading & writing configuration-dropping ** use-cases based on SimonPJ's doc ** discovering the location of the given flavor of compiler and pkg tool ------------------------------------------------------------ -= Future Releases =- * Depends on HC-PKG ** configure: check for presence of build dependencies * NHC Support ** look carefully at "rawSystem" and error handing stuff for nhc. ** add install target for nhc ** add information for compiling w/ nhc ** nhc-pkg (see old package manager code) ** register * Misc ** Reorganize compiler dependent code into Distribution.Compiler.* ** API Versioning? Libtool-style or just a major number? ** sanity checking tool for configuration; are all the .hs files included, etc. ** create a (native?) zlib library? ** sign flag? ** for fields like allModules, allow user to specify "Foo.Bar.*" or something to indicate all haskell modules under that? ** Get function from hmake that creates a directory based on arch. ** ./Setup test - this may be something that's easy to break off and give to someone else. - give to John Goerzen? ** writePersistBuildConfig robustify + diagnostics ** elaborate command-line help text ** configure should check for 'ar' args + properties (see fptools/aclocal.m4) ** most commands should accept a -v flag to show command lines? ** configure should check version of compiler ** hat support ** per-system source database ** rebuild for new compiler ** helium ** hbc ------------------------------------------------------------ * Orthogonal (layered?) tools ** visual studio support ** hackage ** downloadable public database of packages (wget filename;tar xf filename;cd filename;./setup install) NOTE: such an interface might be implemented w/ xml-rpc, which is there for Haskell now, though in general we'll probabliy want to be careful here about dependencies. ** debian package building (boilerplate) tool. Other debian support w/ rebuild-all-packages? ------------------------------------------------------------ [1] Foo.y is a happy grammer which, when processed, will produce Foo.hs. The description file should include the module Foo. ./setup sdist (source distribution): Include Foo.y, not Foo.hs. Maybe we could add a flag to include Foo.hs as well. This makes sense for some preprocessors and not for others, but I'm wary of including too much preprocessor-specific behavior. ./setup clean: Removes Foo.hs if Foo.y exists. ./setup build: Preprocesses Foo.y to Create Foo.hs before any compilation. The issue with cpp is that we can't go by extensions as we do with the rest of the preprocessors... There is a function in HMake which tests to see if a file needs to be cpp'd, so we can employ that. I think we'll probably have to just treat cpp a little differently from the others, unfortunitely, and I haven't gotten around to it. hugs98-plus-Sep2006/packages/Cabal/cabal-install/0000755006511100651110000000000010504340326020246 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/cabal-install/cabal-install.cabal0000644006511100651110000000140210504340326023735 0ustar rossrossName: cabal-install Version: 0.3.0 License: BSD4 License-File: ../LICENSE Author: Lemmih data-files: etc-cabal-install/serv.list Maintainer: Lemmih Copyright: 2005 Lemmih Stability: Experimental Category: Distribution Build-depends: base, mtl, network Synopsis: Automatic installer for Cabal packages. Description: apt-get like tool. Executable: cabal-install Main-is: CabalInstall.hs Extensions: CPP, OverlappingInstances, TypeSynonymInstances, TemplateHaskell GHC-options: -i.. -i../dependencies/hackage-client-0.1.0 -i../dependencies/XmlRpc-2005.5.5 -i../dependencies/Crypto-2.0.0 -i../dependencies/GnuPG-0.1.1 -i../dependencies/HaXml-1.2/src -i../dependencies/HTTP-2005.5.5 -i../dependencies/NewBinary-0.1 hugs98-plus-Sep2006/packages/Cabal/cabal-install/CabalInstall.hs0000644006511100651110000000017610504340326023137 0ustar rossrossmodule Main where import qualified Network.Hackage.CabalInstall.Main as CabalInstall main :: IO () main = CabalInstall.main hugs98-plus-Sep2006/packages/Cabal/cabal-install/INSTALL0000644006511100651110000000013010504340326021271 0ustar rossrossAfter building and installing with cabal, copy etc-cabal-install to /etc/cabal-install. hugs98-plus-Sep2006/packages/Cabal/cabal-install/README0000644006511100651110000000305510504340326021131 0ustar rossross CabalInstall, what happens under the hood. FetchCmd: cabal-install stores packages in [config-dir]/packages/ by their package id. This can lead to clashes if there's two identical (same name, same version) packages from two servers with different functionality. CleanCmd: Removes all fetched packages. UpdateCmd: Queries all known servers for their packages and stores it in [cfg-dir]/pkg.list. InstallCmd: Installed packages are determined, and dependencies of the to-be-installed packages are resolved and fetched. The fetched tarballs are moved to a temporary directory (usually /tmp) and extracted. Then cabal-install finds any files with a ".cabal" extension and picks the shortest (eg. "myPkg/pkg.cabal" will be chosen over "myPkg/subdir/somefile.cabal"). Cabal-get looks for "Setup.lhs" and "Setup.hs" (in that order) in the directory where the .cabal file was found. Runhaskell is then called with user specified arguments. The user can only pass arguments to the 'configure' phase of the installation. '--user' is only passed to 'runhaskell install' when the '--user' flag is given to cabal-install. InfoCmd: To be written. Files used by cabal-install: [cfg-dir]/serv.list list of servers in the format of :: [String] [cfg-dir]/pkg.list list of packages available from the servers. Format: [(ServerURL,[(PackageIdentifier,[Dependency])])] where ServerURL = String [cfg-dir]/packages/ directory containing all fetched packages. hugs98-plus-Sep2006/packages/Cabal/cabal-install/Setup.lhs0000644006511100651110000000016110504340326022054 0ustar rossross#!/usr/local/bin/runghc > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/cabal-install/etc-cabal-install/0000755006511100651110000000000010504340326023525 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/cabal-install/etc-cabal-install/serv.list0000644006511100651110000000010310504340326025373 0ustar rossross["http://hackage.haskell.org/ModHackage/Hackage.hs?action=xmlrpc"] hugs98-plus-Sep2006/packages/Cabal/cabal-setup/0000755006511100651110000000000010504340326017740 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/cabal-setup/CabalSetup.hs0000644006511100651110000000767210504340326022333 0ustar rossross{-# OPTIONS_GHC -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : CabalSetup -- Copyright : (c) The University of Glasgow 2006 -- -- Maintainer : http://hackage.haskell.org/trac/hackage -- Stability : alpha -- Portability : portable -- -- The user interface to building and installing Cabal packages. module Main (main) where import Distribution.Simple import Distribution.Simple.Utils import Distribution.Simple.Configure ( configCompiler, getInstalledPackages, configDependency ) import Distribution.Setup ( reqPathArg ) import Distribution.PackageDescription ( readPackageDescription, PackageDescription(..) ) import System.Console.GetOpt import System.Environment import Control.Monad ( when ) import System.Directory ( doesFileExist ) main = do args <- getArgs -- read the .cabal file -- - attempt to find the version of Cabal required -- if there's a Setup script, -- - if we find GHC, -- - build it with the right version of Cabal -- - invoke it with args -- - if we find runhaskell (TODO) -- - use runhaskell to invoke it -- otherwise, -- - behave like a boilerplate Setup.hs -- -- Later: -- - add support for multiple packages, by figuring out -- dependencies here and building/installing the sub packages -- in the right order. pkg_descr_file <- defaultPackageDesc pkg_descr <- readPackageDescription pkg_descr_file let (flag_fn, non_opts, unrec_opts, errs) = getOpt' Permute opts args when (not (null errs)) $ die (unlines errs) let flags = foldr (.) id flag_fn defaultFlags comp <- configCompiler (Just GHC) (withCompiler flags) (withHcPkg flags) 0 cabal_flag <- configCabalFlag flags (descCabalVersion pkg_descr) comp let trySetupScript f on_fail = do b <- doesFileExist f if not b then on_fail else do rawSystemExit (verbose flags) (compilerPath comp) (cabal_flag ++ ["--make", f, "-o", "setup", "-v"++show (verbose flags)]) rawSystemExit (verbose flags) ('.':pathSeparator:"setup") args trySetupScript "Setup.hs" $ do trySetupScript "Setup.lhs" $ do trySetupScript ".Setup.hs" $ do -- Setup.hs doesn't exist, we need to behave like defaultMain if descCabalVersion pkg_descr == AnyVersion then defaultMain -- doesn't matter which version we use, so no need to compile -- a special Setup.hs. else do writeFile ".Setup.hs" "import Distribution.Simple; main=defaultMain" trySetupScript ".Setup.hs" $ error "panic! shouldn't happen" data Flags = Flags { withCompiler :: Maybe FilePath, withHcPkg :: Maybe FilePath, verbose :: Int } defaultFlags = Flags { withCompiler = Nothing, withHcPkg = Nothing, verbose = 0 } setWithCompiler f flags = flags{ withCompiler=f } setWithHcPkg f flags = flags{ withHcPkg=f } setVerbose v flags = flags{ verbose=v } opts :: [OptDescr (Flags -> Flags)] opts = [ Option "w" ["with-compiler"] (reqPathArg (setWithCompiler.Just)) "give the path to a particular compiler", Option "" ["with-hc-pkg"] (reqPathArg (setWithHcPkg.Just)) "give the path to the package tool", Option "v" ["verbose"] (OptArg (setVerbose . maybe 3 read) "n") "Control verbosity (n is 0--5, normal verbosity level is 1, -v alone is equivalent to -v3)" ] noSetupScript = error "noSetupScript" configCabalFlag :: Flags -> VersionRange -> Compiler -> IO [String] configCabalFlag flags AnyVersion _ = return [] configCabalFlag flags range comp = do ipkgs <- getInstalledPackages comp True (verbose flags) -- user packages are *allowed* here, no portability problem cabal_pkgid <- configDependency ipkgs (Dependency "Cabal" range) return ["-package", showPackageId cabal_pkgid] pathSeparator :: Char #if mingw32_HOST_OS || mingw32_TARGET_OS pathSeparator = '\\' #else pathSeparator = '/' #endif hugs98-plus-Sep2006/packages/Cabal/cabal-setup/Makefile0000644006511100651110000000064210504340326021402 0ustar rossrossTOP=../.. ifneq "$(findstring boilerplate.mk, $(wildcard $(TOP)/mk/*))" "" # ---------------------------------------------------------------------------- # GHC build tree Makefile: include $(TOP)/mk/boilerplate.mk HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) HS_PROG = cabal-setup EXCLUDED_SRCS = Setup.hs SRC_HC_OPTS += -package Cabal INSTALL_PROGS += $(HS_PROG) include $(TOP)/mk/target.mk endif hugs98-plus-Sep2006/packages/Cabal/cabal-setup/Setup.hs0000644006511100651110000000005510504340326021374 0ustar rossrossimport Distribution.Simple; main=defaultMain hugs98-plus-Sep2006/packages/Cabal/cabal-setup/cabal-setup.cabal0000644006511100651110000000107310504340326023125 0ustar rossrossName: cabal-setup Version: 1.1.4 Copyright: 2005, Simon Marlow Build-depends: Cabal >= 1.1.4, base License: BSD3 License-File: ../LICENSE Author: Simon Marlow Maintainer: http://hackage.haskell.org/trac/hackage/ Homepage: http://www.haskell.org/cabal/ Category: Distribution Synopsis: The user interface for building and installing Cabal packages Description: cabal-setup is the user interface to Cabal. It provides the basic commands for configuring, building, and installing Cabal packages. Executable: cabal-setup Main-is: CabalSetup.hs hugs98-plus-Sep2006/packages/Cabal/dependencies/0000755006511100651110000000000010504340326020166 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/changelog0000644006511100651110000001057610504340326017423 0ustar rossross-*-change-log-*- 1.1.3 Isaac Jones Sept 2005 * WARNING: Interfaces not documented in the user's guide may change in future releases. * Move building of GHCi .o libs to the build phase rather than register phase. (from Duncan Coutts) * Use .tar.gz for source package extension * Uses GHC instead of cpphs if the latter is not available * Added experimental "command hooks" which completely override the default behavior of a command. * Some bugfixes 1.1.1 Isaac Jones July 2005 * WARNING: Interfaces not documented in the user's guide may change in future releases. * Handles recursive modules for GHC 6.2 and GHC 6.4. * Added "setup test" command (Used with UserHook) * implemented handling of _stub.{c,h,o} files * Added support for profiling * Changed install prefix of libraries (pref/pkgname-version to prefix/pkgname-version/compname-version) * Added pattern guards as a language extension * Moved some functionality to Language.Haskell.Extension * Register / unregister .bat files for windows * Exposed more of the API * Added support for the hide-all-packages flag in GHC > 6.4 * Several bug fixes 1.0 Isaac Jones March 11 2005 * Released with GHC 6.4, Hugs March 2005, and nhc98 1.18 * Some sanity checking 0.5 Isaac Jones Wed Feb 19 2005 * WARNING: this is a pre-release and the interfaces are still likely to change until we reach a 1.0 release. * Hooks interfaces changed * Added preprocessors to user hooks * No more executable-modules or hidden-modules. Use "other-modules" instead. * Certain fields moved into BuildInfo, much refactoring * extra-libs -> extra-libraries * Added --gen-script to configure and unconfigure. * modules-ghc (etc) now ghc-modules (etc) * added new fields including "synopsis" * Lots of bug fixes * spaces can sometimes be used instead of commas * A user manual has appeared (Thanks, ross!) * for ghc 6.4, configures versionsed depends properly * more features to ./setup haddock 0.4 Isaac Jones Sun Jan 16 2005 * Much thanks to all the awesome fptools hackers who have been working hard to build the Haskell Cabal! * Interface Changes: ** WARNING: this is a pre-release and the interfaces are still likely to change until we reach a 1.0 release. ** Instead of Package.description, you should name your description files .cabal. In particular, we suggest that you name it .cabal, but this is not enforced (yet). Multiple .cabal files in the same directory is an error, at least for now. ** ./setup install --install-prefix is gone. Use ./setup copy --copy-prefix instead. ** The "Modules" field is gone. Use "hidden-modules", "exposed-modules", and "executable-modules". ** Build-depends is now a package-only field, and can't go into executable stanzas. Build-depends is a package-to-package relationship. ** Some new fields. Use the Source. * New Features ** Cabal is now included as a package in the CVS version of fptools. That means it'll be released as "-package Cabal" in future versions of the compilers, and if you are a bleeding-edge user, you can grab it from the CVS repository with the compilers. ** Hugs compatibility and NHC98 compatibility should both be improved. ** Hooks Interface / Autoconf compatibility: Most of the hooks interface is hidden for now, because it's not finalized. I have exposed only "defaultMainWithHooks" and "defaultUserHooks". This allows you to use a ./configure script to preprocess "foo.buildinfo", which gets merged with "foo.cabal". In future releases, we'll expose UserHooks, but we're definitely going to change the interface to those. The interface to the two functions I've exposed should stay the same, though. ** ./setup haddock is a baby feature which pre-processes the source code with hscpp and runs haddock on it. This is brand new and hardly tested, so you get to knock it around and see what you think. ** Some commands now actually implement verbosity. ** The preprocessors have been tested a bit more, and seem to work OK. Please give feedback if you use these. 0.3 Isaac Jones Sun Jan 16 2005 * Unstable snapshot release * From now on, stable releases are even. 0.2 Isaac Jones * Adds more HUGS support and preprocessor support. hugs98-plus-Sep2006/packages/Cabal/copyright0000644006511100651110000000321010504340326017467 0ustar rossrossCopyright (c) 2003-2005, Isaac Jones, Simon Marlow, Martin Sjögren, Bjorn Bringert, Krasimir Angelov, Malcolm Wallace, Ross Patterson All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/Cabal/debianTemplate/0000755006511100651110000000000010504340326020456 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/debianTemplate/changelog0000644006511100651110000000014710504340326022332 0ustar rossross#PACKAGE# (#VERSION#-1) unstable; urgency=low * Initial Release. -- #USERNAME# <#EMAIL#> #DATE# hugs98-plus-Sep2006/packages/Cabal/debianTemplate/compat0000644006511100651110000000000110504340326021653 0ustar rossross4hugs98-plus-Sep2006/packages/Cabal/debianTemplate/control0000644006511100651110000000126010504340326022060 0ustar rossrossSource: #PACKAGE# Priority: optional Maintainer: #USERNAME# <#EMAIL#> Build-Depends: debhelper (>= 4.0.0) Standards-Version: #POLICY# Package: libghc6-#PACKAGE#-dev Section: devel Architecture: any #Depends: #PACKAGE# (= ${Source-Version}) Description: # Package: libnhc98-#PACKAGE#-dev # Section: devel # Architecture: any # Description: # # # Package: libhugs-#PACKAGE#-dev # Section: devel # Architecture: any # Description: # hugs98-plus-Sep2006/packages/Cabal/debianTemplate/libghc6-package-dev.postinst0000644006511100651110000000016510504340326025750 0ustar rossross#!/bin/sh -e ghc-pkg -g --add-package \ < /usr/share/doc/libghc6-#PACKAGE#-dev/installed-pkg-config #DEBHELPER# hugs98-plus-Sep2006/packages/Cabal/debianTemplate/libghc6-package-dev.docs0000644006511100651110000000002510504340326025010 0ustar rossrossinstalled-pkg-config hugs98-plus-Sep2006/packages/Cabal/debianTemplate/rules0000644006511100651110000000432110504340326021533 0ustar rossross#!/usr/bin/make -f # -*- makefile -*- # Sample debian/rules that uses debhelper. # GNU copyright 1997 to 1999 by Joey Hess. # Uncomment this to turn on verbose mode. #export DH_VERBOSE=1 #DPKG_ARCH# CFLAGS = -Wall -g CABAL_GHC_BIN=libghc6-#PACKAGE#-dev ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS))) CFLAGS += -O0 else CFLAGS += -O2 endif ifeq (,$(findstring nostrip,$(DEB_BUILD_OPTIONS))) INSTALL_PROGRAM += -s endif # shared library versions, option 1 version=2.0.5 major=2 # option 2, assuming the library is created as src/.libs/libfoo.so.2.0.5 or so #version=`ls src/.libs/lib*.so.* | \ # awk '{if (match($$0,/[0-9]+\.[0-9]+\.[0-9]+$$/)) print substr($$0,RSTART)}'` #major=`ls src/.libs/lib*.so.* | \ # awk '{if (match($$0,/\.so\.[0-9]+$$/)) print substr($$0,RSTART+4)}'` #CONFIGURE# setup: Setup.lhs ghc -package Cabal Setup.lhs -o setup build: build-stamp build-stamp: #CONFIGURE_STAMP# #CONFIG_STATUS# setup dh_testdir # Add here any extra commands to compile the package. ./setup configure --ghc --prefix=/usr ./setup build touch build-stamp clean: setup dh_testdir dh_testroot rm -f build-stamp #CONFIGURE_STAMP# # Add here any extra commands to clean up after the build process. ./setup clean dh_clean #PRESERVE# install: build setup dh_testdir dh_testroot dh_clean -k #PRESERVE# dh_installdirs # Add here commands to install the package into debian/tmp ./setup install --install-prefix=$(CURDIR)/debian/$(CABAL_GHC_BIN)/usr cp .installed-pkg-config installed-pkg-config # Build architecture-independent files here. binary-indep: build install # We have nothing to do by default. # Build architecture-dependent files here. binary-arch: build install dh_testdir dh_testroot dh_installchangelogs #CHANGELOGS# dh_installdocs dh_installexamples # dh_install # dh_installmenu # dh_installdebconf # dh_installlogrotate # dh_installemacsen # dh_installpam # dh_installmime # dh_installinit # dh_installcron # dh_installinfo dh_installman dh_link dh_strip dh_compress dh_fixperms # dh_perl # dh_python # dh_makeshlibs dh_installdeb # dh_shlibdeps dh_gencontrol dh_md5sums dh_builddeb binary: binary-indep binary-arch .PHONY: build clean binary-indep binary-arch binary install #PHONY_CONFIGURE# hugs98-plus-Sep2006/packages/Cabal/debianTemplate/libghc6-package-dev.prerm0000644006511100651110000000020310504340326025203 0ustar rossross#!/bin/sh -e ghc-pkg -r #PACKAGE# # ditch that ghci library: rm /usr/lib/#PACKAGE#-#VERSION#/HS#PACKAGE#-#VERSION#.o #DEBHELPER# hugs98-plus-Sep2006/packages/Cabal/doc/0000755006511100651110000000000010504340326016305 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/doc/Cabal.xml0000644006511100651110000021735410504340326020045 0ustar rossross Distribution.Simple'> Distribution.Make'> License'> Extension'> alex'> autoconf'> c2hs'> cpphs'> greencard'> haddock'> happy'> ]>

Common Architecture for Building Applications and Libraries User's Guide The Cabal aims to simplify the distribution of Haskell software. It does this by specifying a number of interfaces between package authors, builders and users, as well as providing a library implementing these interfaces. Packages A package is the unit of distribution for the Cabal. Its purpose, when installed, is to make available either or both of: A library, exposing a number of Haskell modules. A library may also contain hidden modules, which are used internally but not available to clients. Hugs doesn't support module hiding. One or more Haskell programs. However having both a library and executables in a package does not work very well; if the executables depend on the library, they must explicitly list all the modules they directly or indirectly import from that library. Internally, the package may consist of much more than a bunch of Haskell modules: it may also have C source code and header files, source code meant for preprocessing, documentation, test cases, auxiliary tools etc. A package is identified by a globally-unique package name, which consists of one or more alphanumeric words separated by hyphens. To avoid ambiguity, each of these words should contain at least one letter. Chaos will result if two distinct packages with the same name are installed on the same system, but there is not yet a mechanism for allocating these names. A particular version of the package is distinguished by a version number, consisting of a sequence of one or more integers separated by dots. These can be combined to form a single text string called the package ID, using a hyphen to separate the name from the version, e.g. HUnit-1.1. Packages are not part of the Haskell language; they simply populate the hierarchical space of module names. It is still the case that all the modules of a program must have distinct module names, regardless of the package they come from, and whether they are exposed or hidden. This also means that although some implementations (i.e. GHC) may allow several versions of a package to be installed at the same time, a program cannot use two packages, P and Q that depend on different versions of the same underlying package R. Creating a package Suppose you have a directory hierarchy containing the source files that make up your package. You will need to add two more files to the root directory of the package: package.cabal a text file containing a package description (for details of the syntax of this file, see ), and Setup.hs or Setup.lhs a single-module Haskell program to perform various setup tasks (with the interface described in ). This module should import only modules that will be present in all Haskell implementations, including modules of the Cabal library. In most cases it will be trivial, calling on the Cabal library to do most of the work. Once you have these, you can create a source bundle of this directory for distribution. Building of the package is discussed in . A package containing a simple library The HUnit package contains a file HUnit.cabal containing: Name: HUnit Version: 1.1 License: BSD3 Author: Dean Herington Homepage: http://hunit.sourceforge.net/ Category: Testing Build-Depends: base Synopsis: Unit testing framework for Haskell Exposed-modules: Test.HUnit, Test.HUnit.Base, Test.HUnit.Lang, Test.HUnit.Terminal, Test.HUnit.Text Extensions: CPP and the following Setup.hs: import Distribution.Simple main = defaultMain A package containing executable programs Name: TestPackage Version: 0.0 License: BSD3 Author: Angela Author Synopsis: Small package with two programs Build-Depends: HUnit Executable: program1 Main-Is: Main.hs Hs-Source-Dirs: prog1 Executable: program2 Main-Is: Main.hs Hs-Source-Dirs: prog2 Other-Modules: Utils with Setup.hs the same as above. A package containing a library and executable programs Name: TestPackage Version: 0.0 License: BSD3 Author: Angela Author Synopsis: Package with library and two programs Build-Depends: HUnit Exposed-Modules: A, B, C Executable: program1 Main-Is: Main.hs Hs-Source-Dirs: prog1 Other-Modules: A, B Executable: program2 Main-Is: Main.hs Hs-Source-Dirs: prog2 Other-Modules: A, C, Utils with Setup.hs the same as above. Note that any library modules required (directly or indirectly) by an executable must be listed again. The trivial setup script used in these examples uses the simple build infrastructure provided by the Cabal library (see &Simple;). The simplicity lies in its interface rather that its implementation. It automatically handles preprocessing with standard preprocessors, and builds packages for all the Haskell implementations (except nhc98, for now). The simple build infrastructure can also handle packages where building is governed by system-dependent parameters, if you specify a little more (see ). A few packages require more elaborate solutions (see ). Package descriptions The package description file should have a name ending in .cabal. There must be exactly one such file in the directory. The first part of the name is immaterial, but it is conventional to use the package name. In the package description file, lines beginning with -- are treated as comments and ignored. This file should contain one or more stanzas separated by blank lines: The first stanza describes the package as a whole (see ), as well as an optional library (see ) and relevant build information (see ). Each subsequent stanza (if any) describes an executable program (see ) and relevant build information (see ). Each stanza consists of a number of field/value pairs, with a syntax like mail message headers. case is not significant in field names to continue a field value, indent the next line to get a blank line in a field value, use an indented . The syntax of the value depends on the field. Field types include: token filename directory Either a sequence of one or more non-space non-comma characters, or a quoted string in Haskell 98 lexical syntax. Unless otherwise stated, relative filenames and directories are interpreted from the package root directory. freeform URL address An arbitrary, uninterpreted string. identifier A letter followed by zero or more alphanumerics or underscores. Modules and preprocessors Haskell module names listed in the exposed-modules and other-modules fields may correspond to Haskell source files, i.e. with names ending in .hs or .lhs, or to inputs for various Haskell preprocessors. The simple build infrastructure understands the extensions .gc (&Greencard;), .chs (&C2hs;), .hsc (hsc2hs), .y and .ly (&Happy;), .x (&Alex;) and .cpphs (&Cpphs;). When building, Cabal will automatically run the appropriate preprocessor and compile the Haskell module it produces. Some fields take lists of values, which are optionally separated by commas, except for the build-depends field, where the commas are mandatory. Some fields are marked as required. All others are optional, and unless otherwise specified have empty default values. Package properties These fields may occur in the first stanza, and describe the package as a whole: name: package-name (required) The unique name of the package (see ), without the version number. version: numbers (required) The package version number, usually consisting of a sequence of natural numbers separated by dots. cabal-version: >, <=, etc. & numbers The version of Cabal required for this package. Use only if this package requires a particular version of Cabal, since unfortunately early versions of Cabal do not recognize this field. List the field early in your .cabal file so that it will appear as a syntax error before any others. license: identifier (default: AllRightsReserved) The type of license under which this package is distributed. License names are the constants of the &License; type. license-file: filename The name of a file containing the precise license for this package. copyright: freeform The content of a copyright notice, typically the name of the holder of the copyright on the package and the year(s) from which copyright is claimed. author: freeform The original author of the package. maintainer: address The current maintainer or maintainers of the package. This is an e-mail address to which users should send bug reports, feature requests and patches. stability: freeform The stability level of the package, e.g. alpha, experimental, provisional, stable. homepage: URL The package homepage. package-url: URL The location of a source bundle for the package. The distribution should be a Cabal package. synopsis: freeform A very short description of the package, for use in a table of packages. This is your headline, so keep it short (one line) but as informative as possible. Save space by not including the package name or saying it's written in Haskell. description: freeform Description of the package. This may be several paragraphs, and should be aimed at a Haskell programmer who has never heard of your package before. For library packages, this field is used as prologue text by setup haddock (see ), and thus may contain the same markup as &Haddock; documentation comments. category: freeform A classification category for future use by the package catalogue Hackage. These categories have not yet been specified, but the upper levels of the module hierarchy make a good start. tested-with: compiler list A list of compilers and versions against which the package has been tested (or at least built). build-depends: package list A list of packages, possibly annotated with versions, needed to build this one, e.g. foo > 1.2, bar. If no version constraint is specified, any version is assumed to be acceptable. data-files: filename list A list of files to be installed for run-time use by the package. This is useful for packages that use a large amount of static data, such as tables of values or code templates. For details on how to find these files at run-time, see . extra-source-files: filename list A list of additional files to be included in source distributions built with setup sdist (see ). extra-tmp-files: filename list A list of additional files or directories to be removed by setup clean (see ). These would typically be additional files created by additional hooks, such as the scheme described in . Library If the package contains a library, the first stanza should also contain the following field: exposed-modules: identifier list (required if this package contains a library) A list of modules added by this package. The first stanza may also contain build information fields (see ) relating to the library. Executables Subsequent stanzas (if present) describe executable programs contained in the package, using the following fields, as well as build information fields (see ). executable: freeform (required) The name of the executable program. main-is: filename (required) The name of the source file containing the Main module, relative to one of the directories listed in hs-source-dirs. These stanzas may also contain build information fields (see ) relating to the executable. Build information The following fields may be optionally present in any stanza, and give information for the building of the corresponding library or executable. See also for a way to supply system-dependent values for these fields. buildable: Boolean (default: True) Is the component buildable? Like some of the other fields below, this field is more useful with the slightly more elaborate form of the simple build infrastructure described in . other-modules: identifier list A list of modules used by the component but not exposed to users. For a library component, these would be hidden modules of the library. For an executable, these would be auxiliary modules to be linked with the file named in the main-is field. hs-source-dirs: directory list (default: .) Root directories for the module hierarchy. For backwards compatibility, the old variant hs-source-dir is also recognized. extensions: identifier list A list of Haskell extensions used by every module. Extension names are the constructors of the &Extension; type. These determine corresponding compiler options. In particular, CPP specifies that Haskell source files are to be preprocessed with a C preprocessor. Extensions used only by one module may be specified by placing a LANGUAGE pragma in the source file affected, e.g.: {-# LANGUAGE CPP, MultiParamTypeClasses #-} GHC versions prior to 6.6 do not support the LANGUAGE pragma. ghc-options: token list Additional options for GHC. You can often achieve the same effect using the extensions field, which is preferred. Options required only by one module may be specified by placing an OPTIONS_GHC pragma in the source file affected. ghc-prof-options: token list Additional options for GHC when the package is built with profiling enabled. hugs-options: token list Additional options for Hugs. You can often achieve the same effect using the extensions field, which is preferred. Options required only by one module may be specified by placing an OPTIONS_HUGS pragma in the source file affected. nhc-options: token list Additional options for nhc98. You can often achieve the same effect using the extensions field, which is preferred. Options required only by one module may be specified by placing an OPTIONS_NHC pragma in the source file affected. includes: filename list A list of header files already installed on the system (i.e. not part of this package) to be included in any compilations via C. These files typically contain function prototypes for foreign imports used by the package. install-includes: filename list A list of header files from this package to be included in any compilations via C. These header files will be installed into $(libdir)/includes when the package is installed. Files listed in install-includes: should be found in one of the directories listed in include-dirs. install-includes is typically used to name header files that contain prototypes for foreign imports used in Haskell code in this package, for which the C implementations are also provided with the package. include-dirs: directory list A list of directories to search for header files, when preprocessing with c2hs, hsc2hs, ffihugs, cpphs, or the C preprocessor, and also when compiling via C. c-sources: filename list A list of C source files to be compiled and linked with the Haskell files. If you use this field, you should also name the C files in CFILES pragmas in the Haskell source files that use them, e.g.: {-# CFILES dir/file1.c dir/file2.c #-} These are ignored by the compilers, but needed by Hugs. extra-libraries: token list A list of extra libraries to link with. extra-lib-dirs: directory list A list of directories to search for libraries. cc-options: token list Command-line arguments to be passed to the C compiler. Since the arguments are compiler-dependent, this field is more useful with the setup described in . ld-options: token list Command-line arguments to be passed to the linker. Since the arguments are compiler-dependent, this field is more useful with the setup described in . frameworks: token list On Darwin/MacOS X, a list of frameworks to link to. See Apple's developer documentation for more details on frameworks. This entry is ignored on all other platforms. Accessing data files from package code The placement on the target system of files listed in the data-files field varies between systems, and in some cases one can even move packages around after installation (see ). To enable packages to find these files in a portable way, Cabal generates a module called Paths_pkgname (with any hyphens in pkgname replaced by underscores) during building, so that it may be imported by modules of the package. This module defines a function getDataFileName :: FilePath -> IO FilePath If the argument is a filename listed in the data-files field, the result is the name of the corresponding file on the system on which the program is running. System-dependent parameters For some packages, especially those interfacing with C libraries, implementation details and the build procedure depend on the build environment. The simple build infrastructure can handle many such situations using a slightly longer Setup.hs: import Distribution.Simple main = defaultMainWithHooks defaultUserHooks This program differs from defaultMain in two ways: If the package root directory contains a file called configure, the configure step will run that. This configure program may be a script produced by the &Autoconf; system, or may be hand-written. This program typically discovers information about the system and records it for later steps, e.g. by generating system-dependent header files for inclusion in C source files and preprocessed Haskell source files. (Clearly this won't work for Windows without MSYS or Cygwin: other ideas are needed.) If the package root directory contains a file called package.buildinfo after the configuration step, subsequent steps will read it to obtain additional settings for build information fields (see ), to be merged with the ones given in the .cabal file. In particular, this file may be generated by the configure script mentioned above, allowing these settings to vary depending on the build environment. The build information file should have the following structure: buildinfo executable: name buildinfo executable: name buildinfo ... where each buildinfo consists of settings of fields listed in . The first one (if present) relates to the library, while each of the others relate to the named executable. (The names must match the package description, but you don't have to have entries for all of them.) Neither of these files is required. If they are absent, this setup script is equivalent to defaultMain. Using autoconf (This example is for people familiar with the &Autoconf; tools.) In the X11 package, the file configure.ac contains: AC_INIT([Haskell X11 package], [1.1], [libraries@haskell.org], [X11]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([X11.cabal]) # Header file to place defines in AC_CONFIG_HEADERS([include/HsX11Config.h]) # Check for X11 include paths and libraries AC_PATH_XTRA AC_TRY_CPP([#include <X11/Xlib.h>],,[no_x=yes]) # Build the package if we found X11 stuff if test "$no_x" = yes then BUILD_PACKAGE_BOOL=False else BUILD_PACKAGE_BOOL=True fi AC_SUBST([BUILD_PACKAGE_BOOL]) AC_CONFIG_FILES([X11.buildinfo]) AC_OUTPUT Then the setup script will run the configure script, which checks for the presence of the X11 libraries and substitutes for variables in the file X11.buildinfo.in: buildable: @BUILD_PACKAGE_BOOL@ cc-options: @X_CFLAGS@ ld-options: @X_LIBS@ This generates a file X11.buildinfo supplying the parameters needed by later stages: buildable: True cc-options: -I/usr/X11R6/include ld-options: -L/usr/X11R6/lib The configure script also generates a header file include/HsX11Config.h containing C preprocessor defines recording the results of various tests. This file may be included by C source files and preprocessed Haskell source files in the package. Packages using these features will also need to list additional files such as configure, templates for .buildinfo files, files named only in .buildinfo files, header files and so on in the extra-source-files field, to ensure that they are included in source distributions. They should also list files and directories generated by configure in the extra-tmp-files field to ensure that they are removed by setup clean. More complex packages For packages that don't fit the simple schemes described above, you have a few options: You can customize the simple build infrastructure using hooks. These allow you to perform additional actions before and after each command is run, and also to specify additional preprocessors. See UserHooks in &Simple; for the details, but note that this interface is experimental, and likely to change in future releases. You could delegate all the work to make, though this is unlikely to be very portable. Cabal supports this with a trivial setup library &Make;, which simply parses the command line arguments and invokes make. Here Setup.hs looks like import Distribution.Make main = defaultMain The root directory of the package should contain a configure script, and, after that has run, a Makefile with a default target that builds the package, plus targets install, register, unregister, clean, dist and docs. Some options to commands are passed through as follows: The , , , , , and options to the configure command are passed on to the configure script. the --destdir option to the copy command becomes a setting of a destdir variable on the invocation of make copy. The supplied Makefile should provide a copy target, which will probably look like this: copy : $(MAKE) install prefix=$(destdir)/$(prefix) \ bindir=$(destdir)/$(bindir) \ libdir=$(destdir)/$(libdir) \ datadir=$(destdir)/$(datadir) \ libexecdir=$(destdir)/$(libexecdir) You can write your own setup script conforming to the interface of , possibly using the Cabal library for part of the work. One option is to copy the source of Distribution.Simple, and alter it for your needs. Good luck. Building and installing a package After you've unpacked a Cabal package, you can build it by moving into the root directory of the package and using the Setup.hs or Setup.lhs script there: runhaskell Setup.hs command option where runhaskell might be runhugs, runghc or runnhc. The command argument selects a particular step in the build/install process. You can also get a summary of the command syntax with runhaskell Setup.hs Building and installing a system package runhaskell Setup.hs configure --ghc runhaskell Setup.hs build runhaskell Setup.hs install The first line readies the system to build the tool using GHC; for example, it checks that GHC exists on the system. The second line performs the actual building, while the last both copies the build results to some permanent place and registers the package with GHC. Building and installing a user package runhaskell Setup.hs configure --ghc --user --prefix=$HOME runhaskell Setup.hs build runhaskell Setup.hs install The package may use packages from the user's package database as well as the global one (), is installed under the user's home directory (), and is registered in the user's package database (). Creating a binary package When creating binary packages (e.g. for RedHat or Debian) one needs to create a tarball that can be sent to another system for unpacking in the root directory: runhaskell Setup.hs configure --ghc --prefix=/usr runhaskell Setup.hs build runhaskell Setup.hs copy --destdir=/tmp/mypkg (cd /tmp/mypkg; tar cf - .) | gzip -9 >mypkg.tar.gz If the package contains a library, you need two additional steps: runhaskell Setup.hs register --gen-script runhaskell Setup.hs unregister --gen-script This creates shell scripts register.sh and unregister.sh, which must also be sent to the target system. After unpacking there, the package must be registered by running the register.sh script. The unregister.sh script would be used in the uninstall procedure of the package. Similar steps may be used for creating binary packages for Windows. The following options are understood by all commands: , or List the available options for the command. =n or n Set the verbosity level (0-5). The normal level is 1; a missing n defaults to 3. The various commands and the additional options they support are described below. In the simple build infrastructure, any other options will be reported as errors, except in the case of the configure command. setup configure Prepare to build the package. Typically, this step checks that the target platform is capable of building the package, and discovers platform-specific features that are needed during the build. The user may also adjust the behaviour of later stages using the options listed in the following subsections. In the simple build infrastructure, the values supplied via these options are recorded in a private file read by later stages. If a user-supplied configure script is run (see or ), it is passed the , , , , , and options, plus any unrecognized options. Programs used for building The following options govern the programs used to process the source files of a package: or or Specify which Haskell implementation to use to build the package. At most one of these flags may be given. If none is given, the implementation under which the setup script was compiled or interpreted is used. =path or path Specify the path to a particular compiler. If given, this must match the implementation selected above. The default is to search for the usual name of the selected implementation. =path Specify the path to the package tool, e.g. ghc-pkg. =path Specify the path to &Haddock;. =path Specify the path to &Happy;. =path Specify the path to &Alex;. =path Specify the path to hsc2hs. =path Specify the path to &C2hs;. =path Specify the path to &Greencard;. =path Specify the path to &Cpphs;. Installation paths The following options govern the location of installed files from a package: =dir The root of the installation, for example /usr/local on a Unix system, or C:\Program Files on a Windows system. The other installation paths are usually subdirectories of prefix, but they don't have to be. =dir Executables that the user might invoke are installed here. =dir Object-code libraries are installed here. =dir A subdirectory of libdir in which libraries are actually installed. For example, in the simple build system on Unix, the default libdir is /usr/local/lib, and libsubdir contains the package identifier and compiler, e.g. mypkg-0.2/ghc-6.4, so libraries would be installed in /usr/local/lib/mypkg-0.2/ghc-6.4. Not all build systems make use of libsubdir, in particular the &Make; system does not. =dir Architecture-independent data files are installed here. =dir A subdirectory of datadir in which data files are actually installed. This option is similar to --libsubdir in that not all build systems make use of it. =dir Executables that are not expected to be invoked directly by the user are installed here. Paths in the simple build system For the simple build system, the following defaults apply: Option Windows Default Unix Default --prefix C:\Program Files /usr/local --bindir $prefix\Haskell\bin $prefix/bin --libdir $prefix\Haskell $prefix/lib --libsubdir (Hugs) hugs\packages\$pkg hugs/packages/$pkg --libsubdir (others) $pkgid\$compiler $pkgid/$compiler --datadir (executable) $prefix\Haskell $prefix/share --datadir (library) C:\Program Files\Common Files $prefix/share --datasubdir $pkgid $pkgid --libexecdir $prefix\$pkgid $prefix/libexec The following strings are substituted into directory names: $prefix The value of prefix $pkgid The full package identifier, e.g. pkg-0.1 $compiler The compiler and version, e.g. ghc-6.4.1 $pkg The name of the package only $version The version of the package Prefix-independence On Windows (and perhaps other OSs), it is possible to query the pathname of the running binary. This means that we can construct an installable executable package that is independent of its absolute install location. The executable can find its auxiliary files by finding its own path and knowing the location of the other files relative to bindir. Prefix-independence is particularly useful: it means the user can choose the install location (i.e. the value of prefix) at install-time, rather than having to bake the path into the binary when it is built. In order to achieve this, we require that for an executable on Windows, all of bindir, libdir, datadir and libexecdir begin with $prefix. If this is not the case then the compiled executable will have baked in all absolute paths. The application need do nothing special to achieve prefix-independence. If it finds any files using getDataFileName and the other functions provided for the purpose (see ), the files will be accessed relative to the location of the current executable. A library cannot (currently) be prefix-independent, because it will be linked into an executable whose filesystem location bears no relation to the library package. Miscellaneous options Allow dependencies to be satisfied by the user package database, in addition to the global database. This also implies a default of for any subsequent install command, as packages registered in the global database should not depend on packages registered in a user's database. (default) Dependencies must be satisfied by the global package database. or Request that an additional version of the library with profiling features enabled be built and installed (only for implementations that support profiling). (default) Do not generate an additional profiling version of the library. Any executables generated should have profiling enabled (only for implementations that support profiling). For this to work, all libraries used by these executables must also have been built with profiling support. (default) Do not enable profiling in generated executables. In the simple build infrastructure, an additional option is recognized: =dir or dir Specify the directory into which the package will be built (default: dist/build). setup build Perform any preprocessing or compilation needed to make this package ready for installation. setup haddock Build the interface documentation for a library using &Haddock;. This command takes the following option: Generate a file dist/doc/html/pkgid.txt, which can be converted by Hoogle into a database for searching. This is equivalent to running &Haddock; with the flag. setup install Copy the files into the install locations and (for library packages) register the package with the compiler, i.e. make the modules it contains available to programs. The install locations are determined by options to setup configure (see ). This command takes the following options: Register this package in the system-wide database. (This is the default, unless the option was supplied to the configure command.) Register this package in the user's local package database. (This is the default if the option was supplied to the configure command.) setup copy Copy the files without registering them. This command is mainly of use to those creating binary packages. This command takes the following option: =path Specify the directory under which to place installed files. If this is not given, then the root directory is assumed. setup register Register this package with the compiler, i.e. make the modules it contains available to programs. This only makes sense for library packages. Note that the install command incorporates this action. The main use of this separate command is in the post-installation step for a binary package. This command takes the following options: Register this package in the system-wide database. (This is the default.) Register this package in the user's local package database. Instead of registering the package, generate a script containing commands to perform the registration. On Unix, this file is called register.sh, on Windows, register.bat. This script might be included in a binary bundle, to be run after the bundle is unpacked on the target system. Registers the package for use directly from the build tree, without needing to install it. This can be useful for testing: there's no need to install the package after modifying it, just recompile and test. However, there are some caveats. It only works with GHC (currently). It only works if your package doesn't depend on having any supplemental files installed - plain Haskell libraries should be fine. =path Specify the path to the package tool, e.g. ghc-pkg. This overrides the hc-pkg tool discovered during configure. setup unregister Deregister this package with the compiler. This command takes the following options: Deregister this package in the system-wide database. (This is the default.) Deregister this package in the user's local package database. Instead of deregistering the package, generate a script containing commands to perform the deregistration. On Unix, this file is called unregister.sh, on Windows, unregister.bat. This script might be included in a binary bundle, to be run on the target system. setup clean Remove any local files created during the configure, build, haddock, register or unregister steps, and also any files and directories listed in the extra-tmp-files field. setup test Run the test suite specified by the runTests field of Distribution.Simple.UserHooks. See &Simple; for information about creating hooks and using defaultMainWithHooks. setup sdist Create a system- and compiler-independent source distribution in a file package-version.tar.gz in the dist subdirectory, for distribution to package builders. When unpacked, the commands listed in this section will be available. The files placed in this distribution are the package description file, the setup script, the sources of the modules named in the package description file, and files named in the license-file, main-is, c-sources, data-files and extra-source-files fields. This command takes the following option: Append today's date (in YYYYMMDD form) to the version number for the generated source package. The original package is unaffected. Known bugs and deficiencies All these should be fixed in future versions: The scheme described in will not work on Windows without MSYS or Cygwin. Cabal has some limitations both running under Hugs and building packages for it: Cabal requires the latest release (Mar 2005). It doesn't work with Windows. There is no hugs-pkg tool. Though the library runs under Nhc98, it cannot build packages for Nhc98. Please report any other flaws to libraries@haskell.org.
hugs98-plus-Sep2006/packages/Cabal/doc/Makefile0000644006511100651110000000103410504340326017743 0ustar rossrossTOP = ../.. ifeq "$(findstring boilerplate.mk, $(wildcard $(TOP)/mk/*))" "" # ---------------------------------------------------------------------------- # Standalone Makefile: all: Cabal.xml docbook2pdf Cabal.xml clean: rm -fr *~ API users-guide Cabal.pdf Cabal.dvi semantic.cache else # boilerplate.mk exists # ---------------------------------------------------------------------------- # GHC build tree Makefile: include $(TOP)/mk/boilerplate.mk XML_DOC = Cabal INSTALL_XML_DOC = $(XML_DOC) include $(TOP)/mk/target.mk endif hugs98-plus-Sep2006/packages/Cabal/examples/0000755006511100651110000000000010504340573017362 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/examples/Makefile0000644006511100651110000000117610504340326021023 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../.. include $(TOP)/mk/boilerplate.mk # # Disable 'make boot' # NO_BOOT_TARGET=YES WAYS= # ----------------------------------------------------------------------------- EXAMPLES := $(wildcard *.hs) BINS := $(EXAMPLES:.hs=$(exeext)) CLEAN_FILES += $(BINS) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -package Cabal all:: $(BINS) $(BINS): %$(exeext): %.hs $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $< # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/Cabal/examples/hapax.hs0000644006511100651110000000031010504340326021005 0ustar rossross-- Simple general-purpose Cabal setup script module Main (main) where import Distribution.Simple (defaultMainWithHooks, defaultUserHooks) main :: IO () main = defaultMainWithHooks defaultUserHooks hugs98-plus-Sep2006/packages/Cabal/examples/DefaultSetup.lhs0000644006511100651110000000015410504340326022473 0ustar rossross#!/usr/bin/runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/tests/0000755006511100651110000000000010504340326016702 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/A/0000755006511100651110000000000010504340326017062 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/A/B/0000755006511100651110000000000010504340326017243 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/A/B/MainB.hs0000644006511100651110000000005410504340326020564 0ustar rossrossmodule Main where import A main = print a hugs98-plus-Sep2006/packages/Cabal/tests/A/B/A.lhs0000644006511100651110000000006510504340326020134 0ustar rossross> module B.A where > a = 42 :: Int > main = print a hugs98-plus-Sep2006/packages/Cabal/tests/A/A.cabal0000644006511100651110000000077510504340326020237 0ustar rossrossName: test cabal-version: > 1.1 Version: 1.0 copyright: filler for test suite maintainer: Isaac Jones synopsis: this package is really awesome. Build-Depends: base Other-Modules: B.A Exposed-Modules: A C-Sources: hello.c, c_src/hello.c Extensions: ForeignFunctionInterface x-darcs-repo: http://darcs.haskell.org/tmp unknown-field: Filler. Executable: testA Other-Modules: A Main-is: MainA.hs C-Sources: c_src/hello.c Extensions: OverlappingInstances Executable: testB Other-Modules: B.A Main-is: B/MainB.hs hugs98-plus-Sep2006/packages/Cabal/tests/A/A.hs0000644006511100651110000000005610504340326017577 0ustar rossrossmodule A where a = 42 :: Int main2 = print a hugs98-plus-Sep2006/packages/Cabal/tests/A/c_src/0000755006511100651110000000000010504340326020153 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/A/c_src/hello.c0000644006511100651110000000002710504340326021421 0ustar rossrossint foo () {return 9;} hugs98-plus-Sep2006/packages/Cabal/tests/A/MainA.hs0000644006511100651110000000005410504340326020402 0ustar rossrossmodule Main where import A main = print a hugs98-plus-Sep2006/packages/Cabal/tests/A/Makefile0000644006511100651110000000002410504340326020516 0ustar rossrossinclude ../Tests.mk hugs98-plus-Sep2006/packages/Cabal/tests/A/Setup.lhs0000644006511100651110000000016310504340326020672 0ustar rossross#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/tests/A/hello.c0000644006511100651110000000003010504340326020322 0ustar rossrossint main () {return 9;} hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/0000755006511100651110000000000010504340326017451 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HSQL/NSIS/0000755006511100651110000000000010504340326020225 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HSQL/NSIS/hsql_installer.nsi0000644006511100651110000001461610504340326023774 0ustar rossross; Script generated by the HM NIS Edit Script Wizard. ; HM NIS Edit Wizard helper defines !define PRODUCT_NAME "HSQL" !define PRODUCT_VERSION "1.4" !define PRODUCT_PUBLISHER "Krasimir Angelov" !define PRODUCT_WEB_SITE "http://htoolkit.sourceforge.net" !define PRODUCT_UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PRODUCT_NAME}" !define PRODUCT_UNINST_ROOT_KEY "HKLM" !define REQUIRED_GHC_VERSION "6.2.1" ; Path to the HSQL build directory: !define HSQL_PATH ".." ; MUI 1.67 compatible ------ !include "MUI.nsh" ; MUI Settings !define MUI_ABORTWARNING !define MUI_ICON "${NSISDIR}\Contrib\Graphics\Icons\modern-install.ico" !define MUI_UNICON "${NSISDIR}\Contrib\Graphics\Icons\modern-uninstall.ico" ; Welcome page !insertmacro MUI_PAGE_WELCOME ; License page !insertmacro MUI_PAGE_LICENSE "${HSQL_PATH}\LICENSE" ; Settings !insertmacro MUI_PAGE_COMPONENTS ; Directory page !insertmacro MUI_PAGE_DIRECTORY ;Startmenu Var STARTMENU_FOLDER !insertmacro MUI_PAGE_STARTMENU PRODUCT_NAME $STARTMENU_FOLDER ; Instfiles page !insertmacro MUI_PAGE_INSTFILES ; Finish page !insertmacro MUI_PAGE_FINISH ; Uninstaller pages !insertmacro MUI_UNPAGE_INSTFILES ; Language files !insertmacro MUI_LANGUAGE "English" ; MUI end ------ !include "StrFunc.nsh" ${StrRep} Var GHCDIR Var DOCS Name "${PRODUCT_NAME} ${PRODUCT_VERSION}" OutFile "${PRODUCT_NAME}-${PRODUCT_VERSION}.exe" InstallDir "c:\HToolkit\HSQL" ShowInstDetails show ShowUnInstDetails show Section "HSQL for GHC-${REQUIRED_GHC_VERSION}" SEC01 ReadRegStr $GHCDIR HKLM "SOFTWARE\Haskell\GHC\ghc-${REQUIRED_GHC_VERSION}" "InstallDir" StrCmp $GHCDIR "" GetDir Ok IfErrors +1 Ok GetDir: MessageBox MB_ICONEXCLAMATION "Couldn't find GHC" StrCpy $GHCDIR $R9 StrCmp $GHCDIR "" Cancel Ok Cancel: Abort "Couldn't find GHC" Ok: SetOverwrite ifnewer SetOutPath "$INSTDIR\GHC" File /r "${HSQL_PATH}\hsql.pkg.in" File /r "${HSQL_PATH}\build\libHSsql.a" File /r "${HSQL_PATH}\mingw32lib\liblibmysql.a" File /r "${HSQL_PATH}\mingw32lib\liblibpq.a" File /r "${HSQL_PATH}\mingw32lib\libsqlite.a" SetOutPath "$INSTDIR\GHC\imports" File /r "${HSQL_PATH}\build\*.hi" ; Fix the hsql.pkg-file Call fixPkg StrCpy $R0 "$GHCDIR\bin\ghc-pkg -u -g -i $\"$INSTDIR\GHC\hsql.pkg$\"" ExecWait $R0 SectionEnd Section "HSQL for Hugs" SEC02 SetOutPath "$INSTDIR\Hugs\libraries" File /r "${HSQL_PATH}\build\*.hs" File /r "${HSQL_PATH}\build\*.dll" SectionEnd Section "Documentation" SEC03 StrCpy $DOCS "yes" SetOverwrite ifnewer SetOutPath "$INSTDIR\doc" File /r "${HSQL_PATH}\doc\*.html" File /r "${HSQL_PATH}\doc\*.gif" File /r "${HSQL_PATH}\doc\*.css" SectionEnd Section "Examples" SEC04 SetOverwrite ifnewer SetOutPath "$INSTDIR\examples" File /r "${HSQL_PATH}\examples\*.hs" SectionEnd Section -DLL SetOverwrite ifnewer SetOutPath "$SYSDIR" File /r "${HSQL_PATH}\mingw32lib\*.dll" SectionEnd Section -AdditionalIcons WriteIniStr "$INSTDIR\${PRODUCT_NAME}.url" "InternetShortcut" "URL" "${PRODUCT_WEB_SITE}" CreateDirectory "$SMPROGRAMS\$STARTMENU_FOLDER" StrCmp $DOCS "yes" +1 +2 CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\Documentation.lnk" "$INSTDIR\doc\index.html" CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\Website.lnk" "$INSTDIR\${PRODUCT_NAME}.url" CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\Uninstall.lnk" "$INSTDIR\uninst.exe" SectionEnd Section -Post WriteUninstaller "$INSTDIR\uninst.exe" WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "DisplayName" "$(^Name)" WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "UninstallString" "$INSTDIR\uninst.exe" WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "DisplayVersion" "${PRODUCT_VERSION}" WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "URLInfoAbout" "${PRODUCT_WEB_SITE}" WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "Publisher" "${PRODUCT_PUBLISHER}" WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "StartMenu" "$STARTMENU_FOLDER" SectionEnd ; Component descriptions !insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN !insertmacro MUI_DESCRIPTION_TEXT ${SEC01} $(DESC_Section1) !insertmacro MUI_DESCRIPTION_TEXT ${SEC02} $(DESC_Section2) !insertmacro MUI_DESCRIPTION_TEXT ${SEC03} $(DESC_Section3) !insertmacro MUI_DESCRIPTION_TEXT ${SEC04} $(DESC_Section4) !insertmacro MUI_FUNCTION_DESCRIPTION_END LangString DESC_Section1 ${LANG_ENGLISH} "Install HSQL for GHC" LangString DESC_Section2 ${LANG_ENGLISH} "Install HSQL for Hugs" LangString DESC_Section3 ${LANG_ENGLISH} "Install HSQL with documentation" LangString DESC_Section4 ${LANG_ENGLISH} "Install HSQL examples" Function fixPkg ; Fix the hsql.pkg file to the right paths ; in order to be able to add the hsql package to ghc. clearErrors FileOpen $0 "$INSTDIR\GHC\hsql.pkg.in" "r" GetTempFileName $R0 FileOpen $1 $R0 "w" loop: FileRead $0 $2 IfErrors done ${StrRep} $R1 $2 "@GHC_DIR@" "$INSTDIR/GHC" ${StrRep} $R1 $R1 "@LIB_DIRS@" "$\"$INSTDIR/GHC$\"" ${StrRep} $R1 $R1 "@DEP_LIBS@" "$\"sqlite$\", $\"libpq$\", $\"odbc32$\", $\"libmysql$\"" ${StrRep} $R1 $R1 "\" "/" FileWrite $1 $R1 Goto loop done: FileClose $0 FileClose $1 CopyFiles /SILENT $R0 "$INSTDIR\GHC\hsql.pkg" Delete $R0 FunctionEnd Function un.onUninstSuccess HideWindow MessageBox MB_ICONINFORMATION|MB_OK "$(^Name) was successfully removed from your computer." FunctionEnd Function un.onInit MessageBox MB_ICONQUESTION|MB_YESNO|MB_DEFBUTTON2 "Are you sure you want to completely remove $(^Name) and all of its components?" IDYES +2 Abort FunctionEnd Section Uninstall ; Remove HSQL from statmenu ReadRegStr $STARTMENU_FOLDER ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "StartMenu" ifErrors +2 +1 RMDir /r "$SMPROGRAMS\$STARTMENU_FOLDER" RMDir /r "$INSTDIR" ; Remove hsql package from ghc ReadRegStr $GHCDIR HKLM "SOFTWARE\Haskell\GHC\ghc-${REQUIRED_GHC_VERSION}" "InstallDir" ifErrors +1 +3 MessageBox MB_ICONEXCLAMATION "Unable to remove hsql lib files from the ghc folder" goto end StrCpy $R0 "$\"$GHCDIR\bin\ghc-pkg$\" -r hsql" ExecWait $R0 end: DeleteRegKey ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" SetAutoClose true SectionEnd hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/HSQL.cabal0000644006511100651110000000043710504340326021210 0ustar rossrossname: hsql license: BSD3 version: 1.4 copyright: filler for test suite maintainer: filler for test suite synopsis: interface to databases description: a simple library, which provides an interface to multiple databases. MySQL, PostgreSQL, ODBC and SQLite (new) are currently supported. hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/LICENSE0000644006511100651110000000300710504340326020456 0ustar rossrossCopyright (c) 2003, Krasimir Angelov All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the HToolkit nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/Makefile0000644006511100651110000001062010504340326021110 0ustar rossrossinclude config.mk COMPILERS = ifneq "$(GHC)" "" COMPILERS += ghc endif # ifneq "$(HUGS)" "" # COMPILERS += hugs # endif #-------------------------------------------------------------------------- # DIRECTORIES #-------------------------------------------------------------------------- # library and doc output BUILDDIR = build DOCDIR = doc HOUTDIR = $(BUILDDIR)/Database HSQLLib = $(BUILDDIR)/libHSsql.a # source dirs VPATH = src #-------------------------------------------------------------------------- # SOURCES #-------------------------------------------------------------------------- HSC_SRC += HSQL.hsc ifeq "$(WithODBC)" "YES" HSC_SRC += HSQL/ODBC.hsc endif ifeq "$(WithPostgreSQL)" "YES" HSC_SRC += HSQL/PostgreSQL.hsc endif ifeq "$(WithMySQL)" "YES" HSC_SRC += HSQL/MySQL.hsc endif ifeq "$(WithSQLite)" "YES" HSC_SRC += HSQL/SQLite.hsc endif SO_SRC = $(patsubst %.hsc,$(HOUTDIR)/%.$(SO_EXT),$(HSC_SRC)) HS_SRC = $(HOUTDIR)/HSQL/Types.hs $(patsubst %.hsc,$(HOUTDIR)/%.hs,$(HSC_SRC)) HI_SRC = $(patsubst %.hs,%.hi,$(HS_SRC)) OBJS = $(patsubst %.hs,%.o, $(HS_SRC)) HS_DEPS = $(patsubst %.hs,%.d, $(HS_SRC)) ifeq "$(WithODBC)" "YES" ifeq "$(WIN32)" "YES" HsODBC_o = $(HOUTDIR)/HSQL/HsODBC.o endif endif #-------------------------------------------------------------------------- # FLAGS #-------------------------------------------------------------------------- FFIHUGS_FLAGS = $(patsubst %, +L"%", $(CPPFLAGS)) ifeq "$(WIN32)" "YES" ODBC_FFIHUGS_FLAGS = +L"$(HsODBC_o)" FFIHUGS_FLAGS += $(patsubst %, +L"%", $(patsubst -l%, %.lib, $(LDFLAGS))) else FFIHUGS_FLAGS += $(patsubst %, +L"%", $(LDFLAGS)) endif ifeq "$(HADDOCK)" "" HADDOCK = echo else HS_PPS = $(addsuffix .raw-hs, $(basename $(HS_SRC))) endif #-------------------------------------------------------------------------- # RULES #-------------------------------------------------------------------------- .SUFFIXES: .hs .hi .o .c # should be: # # $(HSC2HS) $< -o $@ $(CPPFLAGS) # # but there is a bug in hsc2hs from GHC 6.2 for Windows $(HOUTDIR)/%.hs: %.hsc $(HSC2HS) $< $(CPPFLAGS) mv $(patsubst %.hsc, %.hs, $<) $@ %.o : %.hs mkdir -p $(basename $<)_split rm -f $(basename $<)_split/* $(GHC) $< -O -c -i$(BUILDDIR) -fglasgow-exts -split-objs $(CPPFLAGS) -package-name hsql $(LD) -r -o $@ $(basename $<)_split/*.o @# create dependency file @$(GHC) $< -M -i$(BUILDDIR) -optdep-f -optdep$(*F).d $(CPPFLAGS) @sed -e 's|$(subst .hs,,$<)\.o|$*\.o|' $(*F).d > $*.d @rm $(*F).d .o.hi: @: %.$(SO_EXT): %.hs $(FFIHUGS) -98 +G -P$(BUILDDIR): $(FFIHUGS_FLAGS) $($(*F)_FFIHUGS_FLAGS) $< %.raw-hs : %.hs $(GHC) -Iincludes $(CPPFLAGS) -D__HADDOCK__ -E -cpp $< -o $<.tmp && sed -e 's/^#.*//' <$<.tmp >$@ all: $(patsubst %, all-%, $(COMPILERS)) all-ghc: $(HSQLLib) all-hugs: $(SO_SRC) $(HSQLLib): $(OBJS) $(HsODBC_o) rm -f $(HSQLLib) for i in $(patsubst %.o,%_split, $(OBJS)); do \ $(AR) -q $(HSQLLib) $$i/*.o; \ done $(AR) -q $(HSQLLib) $(HsODBC_o) genclean: distclean rm -rf configure autom4te.cache distclean: clean rm -f $(HSQLLib) rm -f config.status config.log config.mk hsql.pkg clean: rm -f $(OBJS) rm -f $(HI_SRC) rm -f $(SO_SRC) rm -f $(HS_SRC) rm -f $(patsubst %.hs,%.c,$(HS_SRC)) rm -f $(HS_PPS) rm -f $(HS_DEPS) rm -rf $(patsubst %.o,%_split, $(OBJS)) rm -f $(HSQLLib) docs : $(HS_PPS) mkdir -p $(DOCDIR) $(HADDOCK) -h -o $(DOCDIR) $(HS_PPS) install: $(patsubst %, install-%, $(COMPILERS)) install-ghc: $(HSQLLib) $(HI_SRC) docs $(INSTALL) -d $(GHC_DIR) $(INSTALL) $(HSQLLib) $(GHC_DIR)/libHSsql.a for i in $(patsubst $(BUILDDIR)/%,%,$(HI_SRC)); do \ $(INSTALL) -d $(GHC_DIR)/imports/`dirname $$i`; \ $(INSTALL) -c $(BUILDDIR)/$$i $(GHC_DIR)/imports/`dirname $$i`; \ done rm -f $(GHC_DIR)/HSsql.o $(GHC_PKG) --config-file=tmpConfig -u -g -i hsql.pkg if test -f $(DOCDIR)/index.html; then \ $(INSTALL) -d $(DOC_DIR); \ $(INSTALL) -c $(DOCDIR)/* $(DOC_DIR); \ fi install-hugs: $(HS_SRC) $(SO_SRC) $(INSTALL) -d $(HUGS_DIR)/libraries/Database for i in $(patsubst $(BUILDDIR)/%,%,$(HS_SRC) $(SO_SRC)); do \ $(INSTALL) -d $(HUGS_DIR)/libraries/`dirname $$i`; \ $(INSTALL) -c $(BUILDDIR)/$$i $(HUGS_DIR)/libraries/`dirname $$i`; \ done setup: Setup.lhs ghc -cpp --make -i../.. Setup.lhs -o setup 2>out.build -include $(HS_DEPS) $(HOUTDIR)/HSQL/ODBC.hs : HSQL/HsODBC.h $(HOUTDIR)/HSQL/Types.hs : HSQL/Types.hs cp $< $@ $(HOUTDIR)/HSQL/HsODBC.o : HSQL/HsODBC.c HSQL/HsODBC.h $(CC) $< -o $@ -O -c $(CPPFLAGS) hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/RPM/0000755006511100651110000000000010504340326020107 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HSQL/RPM/HSQL.spec0000644006511100651110000000314610504340326021536 0ustar rossrossSummary: Haskell database interaction library Name: HSQL Version: 1.4 Release: 1 Copyright: BSD vendor: HToolkit Team packager: Conny Andersson Group: Development/Libraries Source: HSQL.tar.gz Requires: ghc >= 6.2.1 Requires: hugs98 = Nov2003 Requires: sqlite >= 2.8.12 Requires: postgresql-libs >= 7.4.1 Requires: unixODBC >= 2.2.5 Requires: MySQL-shared >= 4.1.1 %description HSQL allows haskell programmers to interact with databases using MySQL, PostgreSQL, ODBC and SQLite. %prep %setup -n HSQL %post ghc-pkg -u --auto-ghci-libs <<- \EOF Package {name = "hsql", auto=True, import_dirs = ["/usr/lib/ghc-6.2/imports"], source_dirs = [], library_dirs = ["/usr/lib/ghc-6.2","/usr/lib","/usr/lib/mysql"], hs_libraries = ["HSsql"], extra_libraries = ["sqlite","pq","odbc","mysqlclient","z","crypt","nsl","m","c","nss_files","nss_dns","resolv","c","nss_files","nss_dns","resolv","sqlite"], include_dirs = [], c_includes = [], package_deps = ["base"], extra_ghc_opts = [], extra_cc_opts = [], extra_ld_opts = [], framework_dirs = [], extra_frameworks = [] } EOF %postun ghc-pkg -r hsql %build ./configure --enable-mysql --enable-postgres --enable-odbc --enable-sqlite make make docs %install make install %files %defattr (-,root,root) #GHC /usr/lib/ghc-6.2/libHSsql.a /usr/lib/ghc-6.2/imports/Database/HSQL /usr/lib/ghc-6.2/imports/Database/HSQL.hi #Hugs /usr/lib/hugs/libraries/Database/HSQL /usr/lib/hugs/libraries/Database/HSQL.hs /usr/lib/hugs/libraries/Database/HSQL.so #GHC-Docs /usr/lib/ghc-6.2/doc/html/libraries/hsql hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/config.guess0000644006511100651110000007634610504340326022006 0ustar rossross#! /bin/sh # Attempt to guess a canonical system name. # Copyright (C) 1992, 93, 94, 95, 96, 97, 1998 Free Software Foundation, Inc. # # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Written by Per Bothner . # The master version of this file is at the FSF in /home/gd/gnu/lib. # # This script attempts to guess a canonical system name similar to # config.sub. If it succeeds, it prints the system name on stdout, and # exits with 0. Otherwise, it exits with 1. # # The plan is that this can be called by configure scripts if you # don't specify an explicit system type (host/target name). # # Only a few systems have been added to this list; please add others # (but try to keep the structure clean). # # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 8/24/94.) if (test -f /.attbin/uname) >/dev/null 2>&1 ; then PATH=$PATH:/.attbin ; export PATH fi UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown trap 'rm -f dummy.c dummy.o dummy; exit 1' 1 2 15 # Note: order is significant - the case branches are not exclusive. case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in alpha:OSF1:*:*) if test $UNAME_RELEASE = "V4.0"; then UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` fi # A Vn.n version is a released version. # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. cat <dummy.s .globl main .ent main main: .frame \$30,0,\$26,0 .prologue 0 .long 0x47e03d80 # implver $0 lda \$2,259 .long 0x47e20c21 # amask $2,$1 srl \$1,8,\$2 sll \$2,2,\$2 sll \$0,3,\$0 addl \$1,\$0,\$0 addl \$2,\$0,\$0 ret \$31,(\$26),1 .end main EOF ${CC-cc} dummy.s -o dummy 2>/dev/null if test "$?" = 0 ; then ./dummy case "$?" in 7) UNAME_MACHINE="alpha" ;; 15) UNAME_MACHINE="alphaev5" ;; 14) UNAME_MACHINE="alphaev56" ;; 10) UNAME_MACHINE="alphapca56" ;; 16) UNAME_MACHINE="alphaev6" ;; esac fi rm -f dummy.s dummy echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr [[A-Z]] [[a-z]]` exit 0 ;; 21064:Windows_NT:50:3) echo alpha-dec-winnt3.5 exit 0 ;; Amiga*:UNIX_System_V:4.0:*) echo m68k-cbm-sysv4 exit 0;; amiga:NetBSD:*:*) echo m68k-cbm-netbsd${UNAME_RELEASE} exit 0 ;; amiga:OpenBSD:*:*) echo m68k-unknown-openbsd${UNAME_RELEASE} exit 0 ;; *:[Aa]miga[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-amigaos exit 0 ;; arc64:OpenBSD:*:*) echo mips64el-unknown-openbsd${UNAME_RELEASE} exit 0 ;; arc:OpenBSD:*:*) echo mipsel-unknown-openbsd${UNAME_RELEASE} exit 0 ;; hkmips:OpenBSD:*:*) echo mips-unknown-openbsd${UNAME_RELEASE} exit 0 ;; pmax:OpenBSD:*:*) echo mipsel-unknown-openbsd${UNAME_RELEASE} exit 0 ;; sgi:OpenBSD:*:*) echo mips-unknown-openbsd${UNAME_RELEASE} exit 0 ;; wgrisc:OpenBSD:*:*) echo mipsel-unknown-openbsd${UNAME_RELEASE} exit 0 ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit 0;; arm32:NetBSD:*:*) echo arm-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` exit 0 ;; SR2?01:HI-UX/MPP:*:*) echo hppa1.1-hitachi-hiuxmpp exit 0;; Pyramid*:OSx*:*:*|MIS*:OSx*:*:*|MIS*:SMP_DC-OSx*:*:*) # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. if test "`(/bin/universe) 2>/dev/null`" = att ; then echo pyramid-pyramid-sysv3 else echo pyramid-pyramid-bsd fi exit 0 ;; NILE:*:*:dcosx) echo pyramid-pyramid-svr4 exit 0 ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; i86pc:SunOS:5.*:*) echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; sun4*:SunOS:*:*) case "`/usr/bin/arch -k`" in Series*|S4*) UNAME_RELEASE=`uname -v` ;; esac # Japanese Language versions have a version number like `4.1.3-JL'. echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` exit 0 ;; sun3*:SunOS:*:*) echo m68k-sun-sunos${UNAME_RELEASE} exit 0 ;; sun*:*:4.2BSD:*) UNAME_RELEASE=`(head -1 /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 case "`/bin/arch`" in sun3) echo m68k-sun-sunos${UNAME_RELEASE} ;; sun4) echo sparc-sun-sunos${UNAME_RELEASE} ;; esac exit 0 ;; aushp:SunOS:*:*) echo sparc-auspex-sunos${UNAME_RELEASE} exit 0 ;; atari*:NetBSD:*:*) echo m68k-atari-netbsd${UNAME_RELEASE} exit 0 ;; atari*:OpenBSD:*:*) echo m68k-unknown-openbsd${UNAME_RELEASE} exit 0 ;; sun3*:NetBSD:*:*) echo m68k-sun-netbsd${UNAME_RELEASE} exit 0 ;; sun3*:OpenBSD:*:*) echo m68k-unknown-openbsd${UNAME_RELEASE} exit 0 ;; mac68k:NetBSD:*:*) echo m68k-apple-netbsd${UNAME_RELEASE} exit 0 ;; mac68k:OpenBSD:*:*) echo m68k-unknown-openbsd${UNAME_RELEASE} exit 0 ;; mvme68k:OpenBSD:*:*) echo m68k-unknown-openbsd${UNAME_RELEASE} exit 0 ;; mvme88k:OpenBSD:*:*) echo m88k-unknown-openbsd${UNAME_RELEASE} exit 0 ;; powerpc:machten:*:*) echo powerpc-apple-machten${UNAME_RELEASE} exit 0 ;; Power*:Darwin:*:*) echo powerpc-apple-macosx${UNAME_RELEASE} exit 0 ;; macppc:NetBSD:*:*) echo powerpc-apple-netbsd${UNAME_RELEASE} exit 0 ;; RISC*:Mach:*:*) echo mips-dec-mach_bsd4.3 exit 0 ;; RISC*:ULTRIX:*:*) echo mips-dec-ultrix${UNAME_RELEASE} exit 0 ;; VAX*:ULTRIX*:*:*) echo vax-dec-ultrix${UNAME_RELEASE} exit 0 ;; 2020:CLIX:*:*) echo clipper-intergraph-clix${UNAME_RELEASE} exit 0 ;; mips:*:*:UMIPS | mips:*:*:RISCos) sed 's/^ //' << EOF >dummy.c int main (argc, argv) int argc; char **argv; { #if defined (host_mips) && defined (MIPSEB) #if defined (SYSTYPE_SYSV) printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_SVR4) printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); #endif #endif exit (-1); } EOF ${CC-cc} dummy.c -o dummy \ && ./dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ && rm dummy.c dummy && exit 0 rm -f dummy.c dummy echo mips-mips-riscos${UNAME_RELEASE} exit 0 ;; Night_Hawk:Power_UNIX:*:*) echo powerpc-harris-powerunix exit 0 ;; m88k:CX/UX:7*:*) echo m88k-harris-cxux7 exit 0 ;; m88k:*:4*:R4*) echo m88k-motorola-sysv4 exit 0 ;; m88k:*:3*:R3*) echo m88k-motorola-sysv3 exit 0 ;; AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88110 ] ; then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \ -o ${TARGET_BINARY_INTERFACE}x = x ] ; then echo m88k-dg-dgux${UNAME_RELEASE} else echo m88k-dg-dguxbcs${UNAME_RELEASE} fi else echo i586-dg-dgux${UNAME_RELEASE} fi exit 0 ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit 0 ;; M88*:*:R3*:*) # Delta 88k system running SVR3 echo m88k-motorola-sysv3 exit 0 ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) echo m88k-tektronix-sysv3 exit 0 ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) echo m68k-tektronix-bsd exit 0 ;; *:IRIX*:*:*) echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` exit 0 ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i?86:AIX:*:*) echo i386-ibm-aix exit 0 ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then sed 's/^ //' << EOF >dummy.c #include main() { if (!__power_pc()) exit(1); puts("powerpc-ibm-aix3.2.5"); exit(0); } EOF ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 rm -f dummy.c dummy echo rs6000-ibm-aix3.2.5 elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then echo rs6000-ibm-aix3.2.4 else echo rs6000-ibm-aix3.2 fi exit 0 ;; *:AIX:*:4) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | head -1 | awk '{ print $1 }'` if /usr/sbin/lsattr -EHl ${IBM_CPU_ID} | grep POWER >/dev/null 2>&1; then IBM_ARCH=rs6000 else IBM_ARCH=powerpc fi if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=4.${UNAME_RELEASE} fi echo ${IBM_ARCH}-ibm-aix${IBM_REV} exit 0 ;; *:AIX:*:*) echo rs6000-ibm-aix exit 0 ;; ibmrt:4.4BSD:*|romp-ibm:BSD:*) echo romp-ibm-bsd4.4 exit 0 ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to exit 0 ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) echo rs6000-bull-bosx exit 0 ;; DPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 exit 0 ;; 9000/[34]??:4.3bsd:1.*:*) echo m68k-hp-bsd exit 0 ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) echo m68k-hp-bsd4.4 exit 0 ;; 9000/[34678]??:HP-UX:*:*) case "${UNAME_MACHINE}" in 9000/31? ) HP_ARCH=m68000 ;; 9000/[34]?? ) HP_ARCH=m68k ;; 9000/6?? | 9000/7?? | 9000/80[24] | 9000/8?[13679] | 9000/892 ) sed 's/^ //' << EOF >dummy.c #include #include int main () { #if defined(_SC_KERNEL_BITS) long bits = sysconf(_SC_KERNEL_BITS); #endif long cpu = sysconf (_SC_CPU_VERSION); switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0"); break; case CPU_PA_RISC1_1: puts ("hppa1.1"); break; case CPU_PA_RISC2_0: #if defined(_SC_KERNEL_BITS) switch (bits) { case 64: puts ("hppa2.0w"); break; case 32: puts ("hppa2.0n"); break; default: puts ("hppa2.0"); break; } break; #else /* !defined(_SC_KERNEL_BITS) */ puts ("hppa2.0"); break; #endif default: puts ("hppa1.0"); break; } exit (0); } EOF (${CC-cc} dummy.c -o dummy 2>/dev/null ) && HP_ARCH=`./dummy` rm -f dummy.c dummy esac HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` echo ${HP_ARCH}-hp-hpux${HPUX_REV} exit 0 ;; 3050*:HI-UX:*:*) sed 's/^ //' << EOF >dummy.c #include int main () { long cpu = sysconf (_SC_CPU_VERSION); /* The order matters, because CPU_IS_HP_MC68K erroneously returns true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct results, however. */ if (CPU_IS_PA_RISC (cpu)) { switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; default: puts ("hppa-hitachi-hiuxwe2"); break; } } else if (CPU_IS_HP_MC68K (cpu)) puts ("m68k-hitachi-hiuxwe2"); else puts ("unknown-hitachi-hiuxwe2"); exit (0); } EOF ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 rm -f dummy.c dummy echo unknown-hitachi-hiuxwe2 exit 0 ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) echo hppa1.1-hp-bsd exit 0 ;; 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exit 0 ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf exit 0 ;; hp8??:OSF1:*:*) echo hppa1.0-hp-osf exit 0 ;; i?86:OSF1:*:*) if [ -x /usr/sbin/sysversion ] ; then echo ${UNAME_MACHINE}-unknown-osf1mk else echo ${UNAME_MACHINE}-unknown-osf1 fi exit 0 ;; parisc*:Lites*:*:*) echo hppa1.1-hp-lites exit 0 ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd exit 0 ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit 0 ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd exit 0 ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd exit 0 ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd exit 0 ;; CRAY*X-MP:*:*:*) echo xmp-cray-unicos exit 0 ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} exit 0 ;; CRAY*[A-Z]90:*:*:*) echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ exit 0 ;; CRAY*TS:*:*:*) echo t90-cray-unicos${UNAME_RELEASE} exit 0 ;; CRAY-2:*:*:*) echo cray2-cray-unicos exit 0 ;; F300:UNIX_System_V:*:*) FUJITSU_SYS=`uname -p | tr [A-Z] [a-z] | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` echo "f300-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit 0 ;; F301:UNIX_System_V:*:*) echo f301-fujitsu-uxpv`echo $UNAME_RELEASE | sed 's/ .*//'` exit 0 ;; hp3[0-9][05]:NetBSD:*:*) echo m68k-hp-netbsd${UNAME_RELEASE} exit 0 ;; hp300:OpenBSD:*:*) echo m68k-unknown-openbsd${UNAME_RELEASE} exit 0 ;; sparc*:BSD/OS:*:*) echo sparc-unknown-bsdi${UNAME_RELEASE} exit 0 ;; i?86:BSD/386:*:* | *:BSD/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} exit 0 ;; *:FreeBSD:*:*) echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit 0 ;; *:NetBSD:*:*) echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` exit 0 ;; *:OpenBSD:*:*) echo ${UNAME_MACHINE}-unknown-openbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` exit 0 ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit 0 ;; i*:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit 0 ;; p*:CYGWIN*:*) echo powerpcle-unknown-cygwin exit 0 ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; *:GNU:*:*) echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` exit 0 ;; *:Linux:*:*) # uname on the ARM produces all sorts of strangeness, and we need to # filter it out. case "$UNAME_MACHINE" in arm* | sa110*) UNAME_MACHINE="arm" ;; esac # The BFD linker knows what the default object file format is, so # first see if it will tell us. ld_help_string=`ld --help 2>&1` ld_supported_emulations=`echo $ld_help_string \ | sed -ne '/supported emulations:/!d s/[ ][ ]*/ /g s/.*supported emulations: *// s/ .*// p'` case "$ld_supported_emulations" in i?86linux) echo "${UNAME_MACHINE}-pc-linux-gnuaout" ; exit 0 ;; i?86coff) echo "${UNAME_MACHINE}-pc-linux-gnucoff" ; exit 0 ;; sparclinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; armlinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; m68klinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; elf32ppc) echo "powerpc-unknown-linux-gnu" ; exit 0 ;; esac if test "${UNAME_MACHINE}" = "alpha" ; then sed 's/^ //' <dummy.s .globl main .ent main main: .frame \$30,0,\$26,0 .prologue 0 .long 0x47e03d80 # implver $0 lda \$2,259 .long 0x47e20c21 # amask $2,$1 srl \$1,8,\$2 sll \$2,2,\$2 sll \$0,3,\$0 addl \$1,\$0,\$0 addl \$2,\$0,\$0 ret \$31,(\$26),1 .end main EOF LIBC="" ${CC-cc} dummy.s -o dummy 2>/dev/null if test "$?" = 0 ; then ./dummy case "$?" in 7) UNAME_MACHINE="alpha" ;; 15) UNAME_MACHINE="alphaev5" ;; 14) UNAME_MACHINE="alphaev56" ;; 10) UNAME_MACHINE="alphapca56" ;; 16) UNAME_MACHINE="alphaev6" ;; esac objdump --private-headers dummy | \ grep ld.so.1 > /dev/null if test "$?" = 0 ; then LIBC="libc1" fi fi rm -f dummy.s dummy echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} ; exit 0 elif test "${UNAME_MACHINE}" = "mips" ; then cat >dummy.c </dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0 rm -f dummy.c dummy else # Either a pre-BFD a.out linker (linux-gnuoldld) # or one that does not give us useful --help. # GCC wants to distinguish between linux-gnuoldld and linux-gnuaout. # If ld does not provide *any* "supported emulations:" # that means it is gnuoldld. echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations:" test $? != 0 && echo "${UNAME_MACHINE}-pc-linux-gnuoldld" && exit 0 case "${UNAME_MACHINE}" in i?86) VENDOR=pc; ;; *) VENDOR=unknown; ;; esac # Determine whether the default compiler is a.out or elf cat >dummy.c < main(argc, argv) int argc; char *argv[]; { #ifdef __ELF__ # ifdef __GLIBC__ # if __GLIBC__ >= 2 printf ("%s-${VENDOR}-linux-gnu\n", argv[1]); # else printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]); # endif # else printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]); # endif #else printf ("%s-${VENDOR}-linux-gnuaout\n", argv[1]); #endif return 0; } EOF ${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0 rm -f dummy.c dummy fi ;; # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions # are messed up and put the nodename in both sysname and nodename. i?86:DYNIX/ptx:4*:*) echo i386-sequent-sysv4 exit 0 ;; i?86:UNIX_SV:4.2MP:2.*) # Unixware is an offshoot of SVR4, but it has its own version # number series starting with 2... # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit 0 ;; i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*) if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE} else echo ${UNAME_MACHINE}-pc-sysv${UNAME_RELEASE} fi exit 0 ;; i?86:*:3.2:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')` (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486 (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 echo ${UNAME_MACHINE}-pc-sco$UNAME_REL else echo ${UNAME_MACHINE}-pc-sysv32 fi exit 0 ;; i?86:UnixWare:*:*) if /bin/uname -X 2>/dev/null >/dev/null ; then (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 fi echo ${UNAME_MACHINE}-unixware-${UNAME_RELEASE}-${UNAME_VERSION} exit 0 ;; pc:*:*:*) # uname -m prints for DJGPP always 'pc', but it prints nothing about # the processor, so we play safe by assuming i386. echo i386-pc-msdosdjgpp exit 0 ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit 0 ;; paragon:*:*:*) echo i860-intel-osf1 exit 0 ;; i860:*:4.*:*) # i860-SVR4 if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 fi exit 0 ;; mini*:CTIX:SYS*5:*) # "miniframe" echo m68010-convergent-sysv exit 0 ;; M68*:*:R3V[567]*:*) test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 4850:*:4.0:3.0) OS_REL='' test -r /etc/.relid \ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && echo i486-ncr-sysv4.3${OS_REL} && exit 0 /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && echo i486-ncr-sysv4 && exit 0 ;; m68*:LynxOS:2.*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit 0 ;; mc68030:UNIX_System_V:4.*:*) echo m68k-atari-sysv4 exit 0 ;; i?86:LynxOS:2.*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit 0 ;; TSUNAMI:LynxOS:2.*:*) echo sparc-unknown-lynxos${UNAME_RELEASE} exit 0 ;; rs6000:LynxOS:2.*:* | PowerPC:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit 0 ;; SM[BE]S:UNIX_SV:*:*) echo mips-dde-sysv${UNAME_RELEASE} exit 0 ;; RM*:SINIX-*:*:*) echo mips-sni-sysv4 exit 0 ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` echo ${UNAME_MACHINE}-sni-sysv4 else echo ns32k-sni-sysv fi exit 0 ;; PENTIUM:CPunix:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort # says echo i586-unisys-sysv4 exit 0 ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes . # How about differentiating between stratus architectures? -djm echo hppa1.1-stratus-sysv4 exit 0 ;; *:*:*:FTX*) # From seanf@swdc.stratus.com. echo i860-stratus-sysv4 exit 0 ;; mc68*:A/UX:*:*) echo m68k-apple-aux${UNAME_RELEASE} exit 0 ;; news*:NEWS-OS:*:6*) echo mips-sony-newsos6 exit 0 ;; R3000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R4000:UNIX_SV:*:*) if [ -d /usr/nec ]; then echo mips-nec-sysv${UNAME_RELEASE} else echo mips-unknown-sysv${UNAME_RELEASE} fi exit 0 ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit 0 ;; BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. echo powerpc-apple-beos exit 0 ;; BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit 0 ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 cat >dummy.c < # include #endif main () { #if defined (sony) #if defined (MIPSEB) /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, I don't know.... */ printf ("mips-sony-bsd\n"); exit (0); #else #include printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 "4" #else "" #endif ); exit (0); #endif #endif #if defined (__arm) && defined (__acorn) && defined (__unix) printf ("arm-acorn-riscix"); exit (0); #endif #if defined (hp300) && !defined (hpux) printf ("m68k-hp-bsd\n"); exit (0); #endif #if defined (NeXT) #if !defined (__ARCHITECTURE__) #define __ARCHITECTURE__ "m68k" #endif int version; version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); exit (0); #endif #if defined (MULTIMAX) || defined (n16) #if defined (UMAXV) printf ("ns32k-encore-sysv\n"); exit (0); #else #if defined (CMU) printf ("ns32k-encore-mach\n"); exit (0); #else printf ("ns32k-encore-bsd\n"); exit (0); #endif #endif #endif #if defined (__386BSD__) printf ("i386-pc-bsd\n"); exit (0); #endif #if defined (sequent) #if defined (i386) printf ("i386-sequent-dynix\n"); exit (0); #endif #if defined (ns32000) printf ("ns32k-sequent-dynix\n"); exit (0); #endif #endif #if defined (_SEQUENT_) struct utsname un; uname(&un); if (strncmp(un.version, "V2", 2) == 0) { printf ("i386-sequent-ptx2\n"); exit (0); } if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ printf ("i386-sequent-ptx1\n"); exit (0); } printf ("i386-sequent-ptx\n"); exit (0); #endif #if defined (vax) #if !defined (ultrix) printf ("vax-dec-bsd\n"); exit (0); #else printf ("vax-dec-ultrix\n"); exit (0); #endif #endif #if defined (alliant) && defined (i860) printf ("i860-alliant-bsd\n"); exit (0); #endif exit (1); } EOF ${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy && rm dummy.c dummy && exit 0 rm -f dummy.c dummy # Apollos put the system type in the environment. test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; } # Convex versions that predate uname can use getsysinfo(1) if [ -x /usr/convex/getsysinfo ] then case `getsysinfo -f cpu_type` in c1*) echo c1-convex-bsd exit 0 ;; c2*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit 0 ;; c34*) echo c34-convex-bsd exit 0 ;; c38*) echo c38-convex-bsd exit 0 ;; c4*) echo c4-convex-bsd exit 0 ;; esac fi #echo '(Unable to guess system type)' 1>&2 exit 1 hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/Setup.lhs0000644006511100651110000000015210504340326021257 0ustar rossross#!/usr/bin/runhugs > module Main where > import Distribution.Make > main :: IO () > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/config.mk.in0000644006511100651110000000061310504340326021654 0ustar rossrossWithODBC=@WithODBC@ WithPostgreSQL=@WithPostgreSQL@ WithMySQL=@WithMySQL@ WithSQLite=@WithSQLite@ SO_EXT = @SO_EXT@ WIN32=@WIN32@ AR = @AR@ LD = @LD@ INSTALL = @INSTALL@ CPPFLAGS = @CPPFLAGS@ LDFLAGS = @LDFLAGS@ HSC2HS = @HSC2HS@ HADDOCK = @HADDOCK@ DOC_DIR = @DOC_DIR@ GHC = @GHC@ GHC_DIR = @GHC_DIR@ GHC_PKG = @GHC_PKG@ HUGS = @HUGS@ HUGS_DIR = @HUGS_DIR@ FFIHUGS = @FFIHUGS@ hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/config.mk0000644006511100651110000000063310504340326021251 0ustar rossrossWithODBC=NO WithPostgreSQL=NO WithMySQL=NO WithSQLite=NO SO_EXT = so WIN32=NO AR = /usr/bin/ar LD = /usr/bin/ld INSTALL = /usr/bin/install -c CPPFLAGS = LDFLAGS = HSC2HS = /usr/bin/hsc2hs HADDOCK = /usr/bin/haddock DOC_DIR = /tmp/doc/HSQL GHC = /usr/bin/ghc GHC_DIR = /tmp/lib/HSQL/GHC GHC_PKG = /usr/bin/ghc-pkg HUGS = /usr/bin/hugs HUGS_DIR = /tmp/lib/HSQL/Hugs FFIHUGS = /usr/bin/ffihugs hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/configure.ac0000644006511100651110000002326210504340326021744 0ustar rossrossAC_INIT([HSQL],[1.0],[htoolkit-users@lists.sourceforge.net],[hsql]) AC_CONFIG_FILES([config.mk:config.mk.in hsql.pkg:hsql.pkg.in]) AC_CANONICAL_SYSTEM dnl *********************************************** dnl Enable/Disable ODBC binding dnl *********************************************** AC_ARG_ENABLE(odbc, [ --enable-odbc Build an ODBC binding for Haskell. ], [WithODBC=YES], [WithODBC=NO] ) AC_SUBST(WithODBC) dnl *********************************************** dnl Enable/Disable PostgreSQL binding dnl *********************************************** AC_ARG_ENABLE(postgres, [ --enable-postgres Build a PostgreSQL binding for Haskell. ], [WithPostgreSQL=YES], [WithPostgreSQL=NO] ) AC_SUBST(WithPostgreSQL) dnl *********************************************** dnl Enable/Disable MySQL binding dnl *********************************************** AC_ARG_ENABLE(mysql, [ --enable-mysql Build a MySQL binding for Haskell. ], [WithMySQL=YES], [WithMySQL=NO] ) AC_SUBST(WithMySQL) dnl *********************************************** dnl Enable/Disable SQLite binding dnl *********************************************** AC_ARG_ENABLE(sqlite, [ --enable-sqlite Build a SQLite binding for Haskell. ], [WithSQLite=YES], [WithSQLite=NO] ) AC_SUBST(WithSQLite) dnl *********************************************** dnl GHC dnl *********************************************** AC_ARG_WITH(ghc, [ --with-ghc= Use a different command instead of 'ghc' for the Haskell compiler. ], [GHC="$withval"], [AC_PATH_PROG(GHC,ghc)] ) if test "$GHC" = "" || test ! -f $GHC; then AC_MSG_RESULT([The build for GHC will be skiped.]) GHC="" fi if test "x$prefix" != xNONE; then GHC_DIR="$prefix/lib/HSQL/GHC" else GHC_DIR="$ac_default_prefix/lib/HSQL/Hugs" fi AC_SUBST(GHC) AC_SUBST(GHC_DIR) dnl *********************************************** dnl hsc2hs dnl *********************************************** AC_ARG_WITH(hsc2hs, [ --with-hsc2hs= Use a different command instead of 'hsc2hs' ], [HSC2HS="$withval"], [AC_PATH_PROG(HSC2HS,hsc2hs)] ) if test "$HSC2HS" = "" || test ! -f $HSC2HS; then AC_MSG_ERROR([HSC2HS is required to build the package]) fi AC_SUBST(HSC2HS) dnl *********************************************** dnl ghc-pkg dnl *********************************************** AC_ARG_WITH(ghc-pkg, [ --with-ghc-pkg= Use a different command instead of 'ghc-pkg' ], [GHC_PKG="$withval"], [AC_PATH_PROG(GHC_PKG,ghc-pkg)] ) if test "$GHC_PKG" = "" || test ! -f $GHC_PKG; then AC_MSG_ERROR([ghc-pkg is required to build the package]) fi AC_SUBST(GHC_PKG) dnl *********************************************** dnl HUGS dnl *********************************************** AC_ARG_WITH(hugs, [ --with-hugs= Use a different command instead of 'hugs' for the Hugs interpreter. ], [HUGS="$withval"], [AC_PATH_PROG(HUGS,hugs)] ) if test "$HUGS" = "" || test ! -f $HUGS; then AC_MSG_RESULT([The build for HUGS will be skiped.]) HUGS="" fi if test "x$prefix" != xNONE; then HUGS_DIR="$prefix/lib/HSQL/Hugs" else HUGS_DIR="$ac_default_prefix/lib/HSQL/Hugs" fi case $ac_cv_target_alias in i[[3456]]86-*-cygwin*|i[[3456]]86-*-mingw32*) SO_EXT=dll;; *) SO_EXT=so;; esac AC_SUBST(HUGS) AC_SUBST(HUGS_DIR) AC_SUBST(SO_EXT) dnl *********************************************** dnl FFIHUGS dnl *********************************************** AC_ARG_WITH(ffihugs, [ --with-ffihugs= Use a different command instead of 'ffihugs' for the Hugs FFI compiler. ], [FFIHUGS="$withval"], [AC_PATH_PROG(FFIHUGS,ffihugs)] ) if test "$HUGS" != ""; then if test "$FFIHUGS" = "" || test ! -f $FFIHUGS; then AC_MSG_ERROR([ffihugs is required to build the Hugs libraries]) fi fi AC_SUBST(FFIHUGS) dnl *********************************************** dnl HADDOCK dnl *********************************************** AC_ARG_WITH(haddock, [ --with-haddock= Use a different command instead of 'haddock' for the documentation builder. ], [HADDOCK="$withval"], [AC_PATH_PROG(HADDOCK,haddock)] ) if test "$HADDOCK" = "" || test ! -f $HADDOCK; then AC_MSG_RESULT([HADDOCK is required to build the documentations]) fi if test "x$prefix" != xNONE; then DOC_DIR="$prefix/doc/HSQL" else DOC_DIR="$ac_default_prefix/doc/HSQL" fi AC_SUBST(HADDOCK) AC_SUBST(DOC_DIR) dnl *********************************************** dnl other progs dnl *********************************************** AC_PROG_CC AC_PROG_CPP AC_PROG_INSTALL AC_PATH_PROG(AR,ar) AC_SUBST(AR) AC_PATH_PROG(LD,ld) AC_SUBST(LD) case $ac_cv_target_alias in i[[3456]]86-*-cygwin*|i[[3456]]86-*-mingw32*) AC_CHECK_HEADER(windows.h) CFLAGS="$CFLAGS -mno-cygwin" CPPFLAGS="$CPPFLAGS -D_WIN32_" ac_includes_default="$ac_includes_default #include " WIN32=YES ;; *) WIN32=NO ;; esac AC_SUBST(WIN32) dnl *********************************************** dnl check for headers and libraries for ODBC dnl *********************************************** if test $WithODBC = YES; then AC_CHECK_HEADER(sqlext.h,,AC_MSG_ERROR([sqlext.h and libodbc required to build ODBC building.])) case $WIN32 in YES) AC_COMPILE_IFELSE( [ #include #include int main() { SQLAllocEnv (NULL); return 0; } ], [LIBS="${LIBS} -lodbc32"], AC_MSG_ERROR([sqlext.h and libodbc required to build ODBC building.])) ;; NO) AC_CHECK_LIB(odbc,SQLAllocEnv,,AC_MSG_ERROR([sqlext.h and libodbc required to build ODBC building.])) ;; esac CPPFLAGS="$CPPFLAGS -Isrc/HSQL" fi dnl *********************************************** dnl check for headers and libraries for PostgreSQL dnl *********************************************** if test $WithPostgreSQL = YES; then if test $WIN32 = NO; then AC_PATH_PROG(PG_CONFIG, pg_config) if test "$PG_CONFIG" = "" || test ! -f $PG_CONFIG; then AC_MSG_ERROR([pg_config is required to build PostgreSQL binding]) fi incdir=`$PG_CONFIG --includedir` incdir_server=`$PG_CONFIG --includedir-server` case $ac_cv_target_alias in i[[3456]]86-*-cygwin*|i[[3456]]86-*-mingw32*) LDFLAGS="$LDFLAGS -L$(cygpath -m `$PG_CONFIG --libdir`)" incdir=$(cygpath -m $incdir) CPPFLAGS="$CPPFLAGS -I$(cygpath -m /usr/include) -I$incdir -I$incdir_server" ;; *) LDFLAGS="$LDFLAGS -L`$PG_CONFIG --libdir`" CPPFLAGS="$CPPFLAGS -I$incdir -I$incdir_server" ;; esac else CPPFLAGS="$CPPFLAGS -D_MSC_VER" fi AC_CHECK_HEADER(libpq-fe.h,,AC_MSG_ERROR([libpq-fe.h header not found])) AC_CHECK_HEADER(postgres.h,,AC_MSG_ERROR([postgres.h header not found])) case $WIN32 in YES) AC_CHECK_LIB(libpq,PQsetdbLogin,,AC_MSG_ERROR([liblibpq.a library not found]));; NO) AC_CHECK_LIB(pq, PQsetdbLogin,,AC_MSG_ERROR([libpq.a library not found]));; esac fi dnl *********************************************** dnl check for headers and libraries for MySQL dnl *********************************************** if test $WithMySQL = YES; then if test $WIN32 = NO; then AC_PATH_PROG(MYSQL_CONFIG, mysql_config) if test "$MYSQL_CONFIG" = "" || test ! -f $MYSQL_CONFIG; then AC_MSG_ERROR([mysql_config is required to build MySQL binding]) fi LDFLAGS="$LDFLAGS `$MYSQL_CONFIG --libs`" for mysql_opt in `$MYSQL_CONFIG --cflags` do case $mysql_opt in -I*) CPPFLAGS="$CPPFLAGS ${mysql_opt}";; esac done fi AC_CHECK_HEADER(mysql.h,, AC_MSG_ERROR([mysql.h header not found])) case $WIN32 in YES) AC_COMPILE_IFELSE( [ #include #include int main () { mysql_init (NULL); return 0; } ], [LIBS="${LIBS} -llibmysql"], AC_MSG_ERROR([liblibmysql.a library not found])) ;; NO) AC_CHECK_LIB(mysqlclient,mysql_init,,AC_MSG_ERROR([libmysql.a library not found])) ;; esac fi dnl *********************************************** dnl check for headers and libraries for SQLite dnl *********************************************** if test $WithSQLite = YES; then AC_CHECK_HEADER(sqlite.h,, AC_MSG_ERROR([sqlite.h header not found])) AC_CHECK_LIB(sqlite,sqlite_open,,AC_MSG_ERROR([sqlite.h and libsqlite required to build SQLite building.])) LDFLAGS="$LDFLAGS -lsqlite" fi dnl *********************************************** dnl subst dnl *********************************************** LDFLAGS="${LIBS} ${LDFLAGS}" LIB_DIRS='"'${GHC_DIR}'"' for lib_opt in ${LDFLAGS} do case $lib_opt in -l*) if test x$DEP_LIBS = x; then DEP_LIBS='"'`echo ${lib_opt} | sed s,-l,,`'"' else DEP_LIBS=$DEP_LIBS,'"'`echo ${lib_opt} | sed s,-l,,`'"' fi;; -L*) LIB_DIRS=$LIB_DIRS,'"'`echo ${lib_opt} | sed s,-L,, | sed s,"'",, | sed s,"'",,`'"' esac done AC_SUBST(CPPFLAGS) AC_SUBST(LDFLAGS) AC_SUBST(DEP_LIBS) AC_SUBST(LIB_DIRS) dnl *********************************************** dnl Create directories and output files dnl *********************************************** AC_OUTPUT echo "creating output directories:" echo " - build/Database/HSQL" mkdir -p build/Database/HSQL echo echo "Backends" echo "--------" echo echo "MySQL: $WithMySQL" echo "PostgreSQL: $WithPostgreSQL" echo "SQLite: $WithSQLite" echo "ODBC: $WithODBC" echo hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/config.sub0000644006511100651110000007335310504340326021444 0ustar rossross#! /bin/sh #--------------------------------------------------------------------- # Modified and adapted for the Lazy Virtual Machine by Daan Leijen. # + added better "windows" support #--------------------------------------------------------------------- # $Id: config.sub,v 1.1 2003/09/05 11:37:55 kr_angelov Exp $ # Configuration validation subroutine script, version 1.1. # Copyright (C) 1991, 92-97, 1998 Free Software Foundation, Inc. # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software # can handle that machine. It does not imply ALL GNU software can. # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. # Each package is responsible for reporting which valid configurations # it does not support. The user should be able to distinguish # a failure to support a valid configuration from a meaningless # configuration. # The goal of this file is to map all the various variations of a given # machine specification into a single specification in the form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM # or in some cases, the newer four-part form: # CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM # It is wrong to echo any other type of specification. if [ x$1 = x ] then echo Configuration name missing. 1>&2 echo "Usage: $0 CPU-MFR-OPSYS" 1>&2 echo "or $0 ALIAS" 1>&2 echo where ALIAS is a recognized configuration type. 1>&2 exit 1 fi # First pass through any local machine types. case $1 in *local*) echo $1 exit 0 ;; *) ;; esac # Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in linux-gnu*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] then os=`echo $1 | sed 's/.*-/-/'` else os=; fi ;; esac ### Let's recognize common machines as not being operating systems so ### that things like config.sub decstation-3100 work. We also ### recognize some manufacturers as not being operating systems, so we ### can provide default operating systems below. case $os in -sun*os*) # Prevent following clause from handling this invalid input. ;; -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ -apple) os= basic_machine=$1 ;; -hiux*) os=-hiuxwe2 ;; -sco5) os=sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco4) os=-sco3.2v4 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2.[4-9]*) os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2v[4-9]*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -isc) os=-isc2.2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -clix*) basic_machine=clipper-intergraph ;; -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -lynx*) os=-lynxos ;; -ptx*) basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` ;; -windowsnt*) os=`echo $os | sed -e 's/windowsnt/winnt/'` ;; -psos*) os=-psos ;; esac # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. tahoe | i860 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \ | arme[lb] | pyramid | mn10200 | mn10300 | tron | a29k \ | 580 | i960 | h8300 | hppa | hppa1.0 | hppa1.1 | hppa2.0 \ | alpha | alphaev5 | alphaev56 | we32k | ns16k | clipper \ | i370 | sh | powerpc | powerpcle | 1750a | dsp16xx | pdp11 \ | mips64 | mipsel | mips64el | mips64orion | mips64orionel \ | mipstx39 | mipstx39el \ | sparc | sparclet | sparclite | sparc64 | v850) basic_machine=$basic_machine-unknown ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. i[34567]86) basic_machine=$basic_machine-pc ;; # Object if more than one company name word. *-*-*) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; # Recognize the basic CPU types with company name. vax-* | tahoe-* | i[34567]86-* | i860-* | m32r-* | m68k-* | m68000-* \ | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \ | power-* | none-* | 580-* | cray2-* | h8300-* | i960-* \ | xmp-* | ymp-* | hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* \ | alpha-* | alphaev5-* | alphaev56-* | we32k-* | cydra-* \ | ns16k-* | pn-* | np1-* | xps100-* | clipper-* | orion-* \ | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \ | sparc64-* | mips64-* | mipsel-* \ | mips64el-* | mips64orion-* | mips64orionel-* \ | mipstx39-* | mipstx39el-* \ | f301-*) ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) basic_machine=m68000-att ;; 3b*) basic_machine=we32k-att ;; alliant | fx80) basic_machine=fx80-alliant ;; altos | altos3068) basic_machine=m68k-altos ;; am29k) basic_machine=a29k-none os=-bsd ;; amdahl) basic_machine=580-amdahl os=-sysv ;; amiga | amiga-*) basic_machine=m68k-cbm ;; amigaos | amigados) basic_machine=m68k-cbm os=-amigaos ;; amigaunix | amix) basic_machine=m68k-cbm os=-sysv4 ;; apollo68) basic_machine=m68k-apollo os=-sysv ;; aux) basic_machine=m68k-apple os=-aux ;; balance) basic_machine=ns32k-sequent os=-dynix ;; convex-c1) basic_machine=c1-convex os=-bsd ;; convex-c2) basic_machine=c2-convex os=-bsd ;; convex-c32) basic_machine=c32-convex os=-bsd ;; convex-c34) basic_machine=c34-convex os=-bsd ;; convex-c38) basic_machine=c38-convex os=-bsd ;; cray | ymp) basic_machine=ymp-cray os=-unicos ;; cray2) basic_machine=cray2-cray os=-unicos ;; [ctj]90-cray) basic_machine=c90-cray os=-unicos ;; crds | unos) basic_machine=m68k-crds ;; da30 | da30-*) basic_machine=m68k-da30 ;; decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) basic_machine=mips-dec ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) basic_machine=m68k-motorola ;; delta88) basic_machine=m88k-motorola os=-sysv3 ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx ;; dpx2* | dpx2*-bull) basic_machine=m68k-bull os=-sysv3 ;; ebmon29k) basic_machine=a29k-amd os=-ebmon ;; elxsi) basic_machine=elxsi-elxsi os=-bsd ;; encore | umax | mmax) basic_machine=ns32k-encore ;; fx2800) basic_machine=i860-alliant ;; genix) basic_machine=ns32k-ns ;; gmicro) basic_machine=tron-gmicro os=-sysv ;; h3050r* | hiux*) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; h8300hms) basic_machine=h8300-hitachi os=-hms ;; harris) basic_machine=m88k-harris os=-sysv3 ;; hp300-*) basic_machine=m68k-hp ;; hp300bsd) basic_machine=m68k-hp os=-bsd ;; hp300hpux) basic_machine=m68k-hp os=-hpux ;; hp9k2[0-9][0-9] | hp9k31[0-9]) basic_machine=m68000-hp ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp ;; hp9k7[0-9][0-9] | hp7[0-9][0-9] | hp9k8[0-9]7 | hp8[0-9]7) basic_machine=hppa1.1-hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) basic_machine=hppa1.0-hp ;; hppa-next) os=-nextstep3 ;; i370-ibm* | ibm*) basic_machine=i370-ibm os=-mvs ;; # I'm not sure what "Sysv32" means. Should this be sysv3.2? i[34567]86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 ;; i[34567]86v4*) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv4 ;; i[34567]86v) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv ;; i[34567]86sol2) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-solaris2 ;; iris | iris4d) basic_machine=mips-sgi case $os in -irix*) ;; *) os=-irix4 ;; esac ;; isi68 | isi) basic_machine=m68k-isi os=-sysv ;; m88k-omron*) basic_machine=m88k-omron ;; magnum | m3230) basic_machine=mips-mips os=-sysv ;; merlin) basic_machine=ns32k-utek os=-sysv ;; miniframe) basic_machine=m68000-convergent ;; mipsel*-linux*) basic_machine=mipsel-unknown os=-linux-gnu ;; mips*-linux*) basic_machine=mips-unknown os=-linux-gnu ;; mips3*-*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` ;; mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; ncr3000) basic_machine=i486-ncr os=-sysv4 ;; news | news700 | news800 | news900) basic_machine=m68k-sony os=-newsos ;; news1000) basic_machine=m68030-sony os=-newsos ;; news-3600 | risc-news) basic_machine=mips-sony os=-newsos ;; next | m*-next ) basic_machine=m68k-next case $os in -nextstep* ) ;; -ns2*) os=-nextstep2 ;; *) os=-nextstep3 ;; esac ;; nh3000) basic_machine=m68k-harris os=-cxux ;; nh[45]000) basic_machine=m88k-harris os=-cxux ;; nindy960) basic_machine=i960-intel os=-nindy ;; np1) basic_machine=np1-gould ;; pa-hitachi) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; paragon) basic_machine=i860-intel os=-osf ;; pbd) basic_machine=sparc-tti ;; pbb) basic_machine=m68k-tti ;; pc532 | pc532-*) basic_machine=ns32k-pc532 ;; pentium | p5 | k5 | nexen) basic_machine=i586-pc ;; pentiumpro | p6 | k6 | 6x86) basic_machine=i686-pc ;; pentiumii | pentium2) basic_machine=i786-pc ;; pentium-* | p5-* | k5-* | nexen-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumpro-* | p6-* | k6-* | 6x86-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumii-* | pentium2-*) basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pn) basic_machine=pn-gould ;; power) basic_machine=rs6000-ibm ;; ppc) basic_machine=powerpc-unknown ;; ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown ;; ppcle-* | powerpclittle-*) basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ps2) basic_machine=i386-ibm ;; rm[46]00) basic_machine=mips-siemens ;; rtpc | rtpc-*) basic_machine=romp-ibm ;; sequent) basic_machine=i386-sequent ;; sh) basic_machine=sh-hitachi os=-hms ;; sps7) basic_machine=m68k-bull os=-sysv2 ;; spur) basic_machine=spur-unknown ;; sun2) basic_machine=m68000-sun ;; sun2os3) basic_machine=m68000-sun os=-sunos3 ;; sun2os4) basic_machine=m68000-sun os=-sunos4 ;; sun3os3) basic_machine=m68k-sun os=-sunos3 ;; sun3os4) basic_machine=m68k-sun os=-sunos4 ;; sun4os3) basic_machine=sparc-sun os=-sunos3 ;; sun4os4) basic_machine=sparc-sun os=-sunos4 ;; sun4sol2) basic_machine=sparc-sun os=-solaris2 ;; sun3 | sun3-*) basic_machine=m68k-sun ;; sun4) basic_machine=sparc-sun ;; sun386 | sun386i | roadrunner) basic_machine=i386-sun ;; symmetry) basic_machine=i386-sequent os=-dynix ;; tx39) basic_machine=mipstx39-unknown ;; tx39el) basic_machine=mipstx39el-unknown ;; tower | tower-32) basic_machine=m68k-ncr ;; udi29k) basic_machine=a29k-amd os=-udi ;; ultra3) basic_machine=a29k-nyu os=-sym1 ;; vaxv) basic_machine=vax-dec os=-sysv ;; vms) basic_machine=vax-dec os=-vms ;; vpp*|vx|vx-*) basic_machine=f301-fujitsu ;; vxworks960) basic_machine=i960-wrs os=-vxworks ;; vxworks68) basic_machine=m68k-wrs os=-vxworks ;; vxworks29k) basic_machine=a29k-wrs os=-vxworks ;; xmp) basic_machine=xmp-cray os=-unicos ;; xps | xps100) basic_machine=xps100-honeywell ;; none) basic_machine=none-none os=-none ;; # Here we handle the default manufacturer of certain CPU types. It is in # some cases the only manufacturer, in others, it is the most popular. mips) if [ x$os = x-linux-gnu ]; then basic_machine=mips-unknown else basic_machine=mips-mips fi ;; romp) basic_machine=romp-ibm ;; rs6000) basic_machine=rs6000-ibm ;; vax) basic_machine=vax-dec ;; pdp11) basic_machine=pdp11-dec ;; we32k) basic_machine=we32k-att ;; sparc) basic_machine=sparc-sun ;; cydra) basic_machine=cydra-cydrome ;; orion) basic_machine=orion-highlevel ;; orion105) basic_machine=clipper-highlevel ;; *) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; esac # Here we canonicalize certain aliases for manufacturers. case $basic_machine in *-digital*) basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` ;; *-commodore*) basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` ;; *) ;; esac # Decode manufacturer-specific aliases for certain operating systems. if [ x"$os" != x"" ] then case $os in # First match some system type aliases # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; -solaris) os=-solaris2 ;; -svr4*) os=-sysv4 ;; -unixware*) os=-sysv4.2uw ;; -gnu/linux*) os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` ;; # First accept the basic system types. # The portable systems comes first. # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ | -aos* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -windows*) # LVM: added windows # Remember, each alternative MUST END IN *, to match a version number. ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; -sunos5*) os=`echo $os | sed -e 's|sunos5|solaris2|'` ;; -sunos6*) os=`echo $os | sed -e 's|sunos6|solaris3|'` ;; -osfrose*) os=-osfrose ;; -osf*) os=-osf ;; -utek*) os=-bsd ;; -dynix*) os=-bsd ;; -acis*) os=-aos ;; -ctix* | -uts*) os=-sysv ;; -ns2 ) os=-nextstep2 ;; # Preserve the version number of sinix5. -sinix5.*) os=`echo $os | sed -e 's|sinix|sysv|'` ;; -sinix*) os=-sysv4 ;; -triton*) os=-sysv3 ;; -oss*) os=-sysv3 ;; -svr4) os=-sysv4 ;; -svr3) os=-sysv3 ;; -sysvr4) os=-sysv4 ;; # This must come after -sysvr4. -sysv*) ;; -xenix) os=-xenix ;; -macosx*) os=-macosx ;; -none) ;; *) # Get rid of the `-' at the beginning of $os. os=`echo $os | sed 's/[^-]*-//'` echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 exit 1 ;; esac else # Here we handle the default operating systems that come with various machines. # The value should be what the vendor currently ships out the door with their # machine or put another way, the most popular os provided with the machine. # Note that if you're going to try to match "-MANUFACTURER" here (say, # "-sun"), then you have to tell the case statement up towards the top # that MANUFACTURER isn't an operating system. Otherwise, code above # will signal an error saying that MANUFACTURER isn't an operating # system, and we'll never get to this point. case $basic_machine in *-acorn) os=-riscix1.2 ;; arm*-semi) os=-aout ;; pdp11-*) os=-none ;; *-dec | vax-*) os=-ultrix4.2 ;; m68*-apollo) os=-domain ;; i386-sun) os=-sunos4.0.2 ;; m68000-sun) os=-sunos3 # This also exists in the configure program, but was not the # default. # os=-sunos4 ;; *-tti) # must be before sparc entry or we get the wrong os. os=-sysv3 ;; sparc-* | *-sun) os=-sunos4.1.1 ;; *-be) os=-beos ;; *-ibm) os=-aix ;; *-hp) os=-hpux ;; *-hitachi) os=-hiux ;; i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) os=-sysv ;; *-cbm) os=-amigaos ;; *-dg) os=-dgux ;; *-dolphin) os=-sysv3 ;; m68k-ccur) os=-rtu ;; m88k-omron*) os=-luna ;; *-next ) os=-nextstep ;; *-sequent) os=-ptx ;; *-crds) os=-unos ;; *-ns) os=-genix ;; i370-*) os=-mvs ;; *-next) os=-nextstep3 ;; *-gould) os=-sysv ;; *-highlevel) os=-bsd ;; *-encore) os=-bsd ;; *-sgi) os=-irix ;; *-siemens) os=-sysv4 ;; *-masscomp) os=-rtu ;; f301-fujitsu) os=-uxpv ;; *) os=-none ;; esac fi # Here we handle the case where we know the os, and the CPU type, but not the # manufacturer. We pick the logical manufacturer. vendor=unknown case $basic_machine in *-unknown) case $os in -riscix*) vendor=acorn ;; -sunos*) vendor=sun ;; -aix*) vendor=ibm ;; -hpux*) vendor=hp ;; -hiux*) vendor=hitachi ;; -unos*) vendor=crds ;; -dgux*) vendor=dg ;; -luna*) vendor=omron ;; -genix*) vendor=ns ;; -mvs*) vendor=ibm ;; -ptx*) vendor=sequent ;; -vxsim* | -vxworks*) vendor=wrs ;; -aux*) vendor=apple ;; esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` ;; esac echo $basic_machine$os hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/configure0000644006511100651110000050465010504340326021367 0ustar rossross#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.57 for HSQL 1.0. # # Report bugs to . # # Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002 # Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi # Support unset when possible. if (FOO=FOO; unset FOO) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -n "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="sed y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" # Sed expression to map a string onto a valid variable name. as_tr_sh="sed y%*+%pp%;s%[^_$as_cr_alnum]%_%g" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local ac_config_libobj_dir=. cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='HSQL' PACKAGE_TARNAME='hsql' PACKAGE_VERSION='1.0' PACKAGE_STRING='HSQL 1.0' PACKAGE_BUGREPORT='htoolkit-users@lists.sourceforge.net' # Factoring default headers for most tests. ac_includes_default="\ #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if STDC_HEADERS # include # include #else # if HAVE_STDLIB_H # include # endif #endif #if HAVE_STRING_H # if !STDC_HEADERS && HAVE_MEMORY_H # include # endif # include #endif #if HAVE_STRINGS_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os WithODBC WithPostgreSQL WithMySQL WithSQLite GHC GHC_DIR HSC2HS GHC_PKG HUGS HUGS_DIR SO_EXT FFIHUGS HADDOCK DOC_DIR CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA AR LD EGREP WIN32 PG_CONFIG MYSQL_CONFIG DEP_LIBS LIB_DIRS LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias ac_env_CC_set=${CC+set} ac_env_CC_value=$CC ac_cv_env_CC_set=${CC+set} ac_cv_env_CC_value=$CC ac_env_CFLAGS_set=${CFLAGS+set} ac_env_CFLAGS_value=$CFLAGS ac_cv_env_CFLAGS_set=${CFLAGS+set} ac_cv_env_CFLAGS_value=$CFLAGS ac_env_LDFLAGS_set=${LDFLAGS+set} ac_env_LDFLAGS_value=$LDFLAGS ac_cv_env_LDFLAGS_set=${LDFLAGS+set} ac_cv_env_LDFLAGS_value=$LDFLAGS ac_env_CPPFLAGS_set=${CPPFLAGS+set} ac_env_CPPFLAGS_value=$CPPFLAGS ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} ac_cv_env_CPPFLAGS_value=$CPPFLAGS ac_env_CPP_set=${CPP+set} ac_env_CPP_value=$CPP ac_cv_env_CPP_set=${CPP+set} ac_cv_env_CPP_value=$CPP # # Report the --help message. # 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 HSQL 1.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF System types: --build=BUILD configure for building on BUILD [guessed] --host=HOST cross-compile to build programs to run on HOST [BUILD] --target=TARGET configure for building compilers for TARGET [HOST] _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of HSQL 1.0:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-odbc Build an ODBC binding for Haskell. --enable-postgres Build a PostgreSQL binding for Haskell. --enable-mysql Build a MySQL binding for Haskell. --enable-sqlite Build a SQLite binding for Haskell. Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-ghc= Use a different command instead of 'ghc' for the Haskell compiler. --with-hsc2hs= Use a different command instead of 'hsc2hs' --with-ghc-pkg= Use a different command instead of 'ghc-pkg' --with-hugs= Use a different command instead of 'hugs' for the Hugs interpreter. --with-ffihugs= Use a different command instead of 'ffihugs' for the Hugs FFI compiler. --with-haddock= Use a different command instead of 'haddock' for the documentation builder. Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d $ac_dir || continue ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Don't blindly perform a `cd "$ac_dir"/$ac_foo && pwd` since $ac_foo can be # absolute. ac_abs_builddir=`cd "$ac_dir" && cd $ac_builddir && pwd` ac_abs_top_builddir=`cd "$ac_dir" && cd ${ac_top_builddir}. && pwd` ac_abs_srcdir=`cd "$ac_dir" && cd $ac_srcdir && pwd` ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd` cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then echo $SHELL $ac_srcdir/configure.gnu --help=recursive elif test -f $ac_srcdir/configure; then echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || test -f $ac_srcdir/configure.in; then echo $ac_configure --help else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF HSQL configure 1.0 generated by GNU Autoconf 2.57 Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit 0 fi exec 5>config.log 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 HSQL $as_me 1.0, which was generated by GNU Autoconf 2.57. Invocation command line was $ $0 $@ _ACEOF { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. ac_sep=" " ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Be sure not to use single quotes in there, as some shells, # such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------- ## ## Output files. ## ## ------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core core.* *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_config_files="$ac_config_files config.mk:config.mk.in hsql.pkg:hsql.pkg.in" ac_aux_dir= for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do if test -f $ac_dir/install-sh; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install-sh -c" break elif test -f $ac_dir/install.sh; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install.sh -c" break elif test -f $ac_dir/shtool; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/shtool install -c" break fi done if test -z "$ac_aux_dir"; then { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5 echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;} { (exit 1); exit 1; }; } fi ac_config_guess="$SHELL $ac_aux_dir/config.guess" ac_config_sub="$SHELL $ac_aux_dir/config.sub" ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure. # Make sure we can run config.sub. $ac_config_sub sun4 >/dev/null 2>&1 || { { echo "$as_me:$LINENO: error: cannot run $ac_config_sub" >&5 echo "$as_me: error: cannot run $ac_config_sub" >&2;} { (exit 1); exit 1; }; } echo "$as_me:$LINENO: checking build system type" >&5 echo $ECHO_N "checking build system type... $ECHO_C" >&6 if test "${ac_cv_build+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_build_alias=$build_alias test -z "$ac_cv_build_alias" && ac_cv_build_alias=`$ac_config_guess` test -z "$ac_cv_build_alias" && { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5 echo "$as_me: error: cannot guess build type; you must specify one" >&2;} { (exit 1); exit 1; }; } ac_cv_build=`$ac_config_sub $ac_cv_build_alias` || { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_build_alias failed" >&5 echo "$as_me: error: $ac_config_sub $ac_cv_build_alias failed" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: result: $ac_cv_build" >&5 echo "${ECHO_T}$ac_cv_build" >&6 build=$ac_cv_build build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` echo "$as_me:$LINENO: checking host system type" >&5 echo $ECHO_N "checking host system type... $ECHO_C" >&6 if test "${ac_cv_host+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_host_alias=$host_alias test -z "$ac_cv_host_alias" && ac_cv_host_alias=$ac_cv_build_alias ac_cv_host=`$ac_config_sub $ac_cv_host_alias` || { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_host_alias failed" >&5 echo "$as_me: error: $ac_config_sub $ac_cv_host_alias failed" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: result: $ac_cv_host" >&5 echo "${ECHO_T}$ac_cv_host" >&6 host=$ac_cv_host host_cpu=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` host_vendor=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` host_os=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` echo "$as_me:$LINENO: checking target system type" >&5 echo $ECHO_N "checking target system type... $ECHO_C" >&6 if test "${ac_cv_target+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_target_alias=$target_alias test "x$ac_cv_target_alias" = "x" && ac_cv_target_alias=$ac_cv_host_alias ac_cv_target=`$ac_config_sub $ac_cv_target_alias` || { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_target_alias failed" >&5 echo "$as_me: error: $ac_config_sub $ac_cv_target_alias failed" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: result: $ac_cv_target" >&5 echo "${ECHO_T}$ac_cv_target" >&6 target=$ac_cv_target target_cpu=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` target_vendor=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` target_os=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` # The aliases save the names the user supplied, while $host etc. # will get canonicalized. test -n "$target_alias" && test "$program_prefix$program_suffix$program_transform_name" = \ NONENONEs,x,x, && program_prefix=${target_alias}- # Check whether --enable-odbc or --disable-odbc was given. if test "${enable_odbc+set}" = set; then enableval="$enable_odbc" WithODBC=YES else WithODBC=NO fi; # Check whether --enable-postgres or --disable-postgres was given. if test "${enable_postgres+set}" = set; then enableval="$enable_postgres" WithPostgreSQL=YES else WithPostgreSQL=NO fi; # Check whether --enable-mysql or --disable-mysql was given. if test "${enable_mysql+set}" = set; then enableval="$enable_mysql" WithMySQL=YES else WithMySQL=NO fi; # Check whether --enable-sqlite or --disable-sqlite was given. if test "${enable_sqlite+set}" = set; then enableval="$enable_sqlite" WithSQLite=YES else WithSQLite=NO fi; # Check whether --with-ghc or --without-ghc was given. if test "${with_ghc+set}" = set; then withval="$with_ghc" GHC="$withval" else # Extract the first word of "ghc", so it can be a program name with args. set dummy ghc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_GHC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $GHC in [\\/]* | ?:[\\/]*) ac_cv_path_GHC="$GHC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_GHC="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi GHC=$ac_cv_path_GHC if test -n "$GHC"; then echo "$as_me:$LINENO: result: $GHC" >&5 echo "${ECHO_T}$GHC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi; if test "$GHC" = "" || test ! -f $GHC; then echo "$as_me:$LINENO: result: The build for GHC will be skiped." >&5 echo "${ECHO_T}The build for GHC will be skiped." >&6 GHC="" fi if test "x$prefix" != xNONE; then GHC_DIR="$prefix/lib/HSQL/GHC" else GHC_DIR="$ac_default_prefix/lib/HSQL/Hugs" fi # Check whether --with-hsc2hs or --without-hsc2hs was given. if test "${with_hsc2hs+set}" = set; then withval="$with_hsc2hs" HSC2HS="$withval" else # Extract the first word of "hsc2hs", so it can be a program name with args. set dummy hsc2hs; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_HSC2HS+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $HSC2HS in [\\/]* | ?:[\\/]*) ac_cv_path_HSC2HS="$HSC2HS" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_HSC2HS="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi HSC2HS=$ac_cv_path_HSC2HS if test -n "$HSC2HS"; then echo "$as_me:$LINENO: result: $HSC2HS" >&5 echo "${ECHO_T}$HSC2HS" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi; if test "$HSC2HS" = "" || test ! -f $HSC2HS; then { { echo "$as_me:$LINENO: error: HSC2HS is required to build the package" >&5 echo "$as_me: error: HSC2HS is required to build the package" >&2;} { (exit 1); exit 1; }; } fi # Check whether --with-ghc-pkg or --without-ghc-pkg was given. if test "${with_ghc_pkg+set}" = set; then withval="$with_ghc_pkg" GHC_PKG="$withval" else # Extract the first word of "ghc-pkg", so it can be a program name with args. set dummy ghc-pkg; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_GHC_PKG+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $GHC_PKG in [\\/]* | ?:[\\/]*) ac_cv_path_GHC_PKG="$GHC_PKG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_GHC_PKG="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi GHC_PKG=$ac_cv_path_GHC_PKG if test -n "$GHC_PKG"; then echo "$as_me:$LINENO: result: $GHC_PKG" >&5 echo "${ECHO_T}$GHC_PKG" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi; if test "$GHC_PKG" = "" || test ! -f $GHC_PKG; then { { echo "$as_me:$LINENO: error: ghc-pkg is required to build the package" >&5 echo "$as_me: error: ghc-pkg is required to build the package" >&2;} { (exit 1); exit 1; }; } fi # Check whether --with-hugs or --without-hugs was given. if test "${with_hugs+set}" = set; then withval="$with_hugs" HUGS="$withval" else # Extract the first word of "hugs", so it can be a program name with args. set dummy hugs; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_HUGS+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $HUGS in [\\/]* | ?:[\\/]*) ac_cv_path_HUGS="$HUGS" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_HUGS="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi HUGS=$ac_cv_path_HUGS if test -n "$HUGS"; then echo "$as_me:$LINENO: result: $HUGS" >&5 echo "${ECHO_T}$HUGS" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi; if test "$HUGS" = "" || test ! -f $HUGS; then echo "$as_me:$LINENO: result: The build for HUGS will be skiped." >&5 echo "${ECHO_T}The build for HUGS will be skiped." >&6 HUGS="" fi if test "x$prefix" != xNONE; then HUGS_DIR="$prefix/lib/HSQL/Hugs" else HUGS_DIR="$ac_default_prefix/lib/HSQL/Hugs" fi case $ac_cv_target_alias in i[3456]86-*-cygwin*|i[3456]86-*-mingw32*) SO_EXT=dll;; *) SO_EXT=so;; esac # Check whether --with-ffihugs or --without-ffihugs was given. if test "${with_ffihugs+set}" = set; then withval="$with_ffihugs" FFIHUGS="$withval" else # Extract the first word of "ffihugs", so it can be a program name with args. set dummy ffihugs; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_FFIHUGS+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $FFIHUGS in [\\/]* | ?:[\\/]*) ac_cv_path_FFIHUGS="$FFIHUGS" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_FFIHUGS="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi FFIHUGS=$ac_cv_path_FFIHUGS if test -n "$FFIHUGS"; then echo "$as_me:$LINENO: result: $FFIHUGS" >&5 echo "${ECHO_T}$FFIHUGS" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi; if test "$HUGS" != ""; then if test "$FFIHUGS" = "" || test ! -f $FFIHUGS; then { { echo "$as_me:$LINENO: error: ffihugs is required to build the Hugs libraries" >&5 echo "$as_me: error: ffihugs is required to build the Hugs libraries" >&2;} { (exit 1); exit 1; }; } fi fi # Check whether --with-haddock or --without-haddock was given. if test "${with_haddock+set}" = set; then withval="$with_haddock" HADDOCK="$withval" else # Extract the first word of "haddock", so it can be a program name with args. set dummy haddock; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_HADDOCK+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $HADDOCK in [\\/]* | ?:[\\/]*) ac_cv_path_HADDOCK="$HADDOCK" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_HADDOCK="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi HADDOCK=$ac_cv_path_HADDOCK if test -n "$HADDOCK"; then echo "$as_me:$LINENO: result: $HADDOCK" >&5 echo "${ECHO_T}$HADDOCK" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi; if test "$HADDOCK" = "" || test ! -f $HADDOCK; then echo "$as_me:$LINENO: result: HADDOCK is required to build the documentations" >&5 echo "${ECHO_T}HADDOCK is required to build the documentations" >&6 fi if test "x$prefix" != xNONE; then DOC_DIR="$prefix/doc/HSQL" else DOC_DIR="$ac_default_prefix/doc/HSQL" fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_CC" && break done CC=$ac_ct_CC fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ "checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. echo "$as_me:$LINENO: checking for C compiler default output" >&5 echo $ECHO_N "checking for C compiler default output... $ECHO_C" >&6 ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 (eval $ac_link_default) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Find the output, starting from the most likely. This scheme is # not robust to junk in `.', hence go to wildcards (a.*) only as a last # resort. # Be careful to initialize this variable, since it used to be cached. # Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. ac_cv_exeext= # b.out is created by i960 compilers. for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; conftest.$ac_ext ) # This is the source file. ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` # FIXME: I believe we export ac_cv_exeext for Libtool, # but it would be cool to find out if it's true. Does anybody # maintain Libtool? --akim. export ac_cv_exeext break;; * ) break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6 # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6 echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` export ac_cv_exeext break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6 rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS CFLAGS="-g" echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_cc_g=no fi rm -f conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 if test "${ac_cv_prog_cc_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_stdc=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF # Don't try gcc -ansi; that turns off useful extensions and # breaks some systems' header files. # AIX -qlanglvl=ansi # Ultrix and OSF/1 -std1 # HP-UX 10.20 and later -Ae # HP-UX older versions -Aa -D_HPUX_SOURCE # SVR4 -Xc -D__EXTENSIONS__ for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_stdc=$ac_arg break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.$ac_objext done rm -f conftest.$ac_ext conftest.$ac_objext CC=$ac_save_CC fi case "x$ac_cv_prog_cc_stdc" in x|xno) echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6 ;; *) echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 CC="$CC $ac_cv_prog_cc_stdc" ;; esac # Some people use a C++ compiler to compile C. Since we use `exit', # in C++ we need to declare it. In case someone uses the same compiler # for both compiling C and C++ we need to have the C++ compiler decide # the declaration of exit, since it's the most demanding environment. cat >conftest.$ac_ext <<_ACEOF #ifndef __cplusplus choke me #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then for ac_declaration in \ ''\ '#include ' \ 'extern "C" void std::exit (int) throw (); using std::exit;' \ 'extern "C" void std::exit (int); using std::exit;' \ 'extern "C" void exit (int) throw ();' \ 'extern "C" void exit (int);' \ 'void exit (int);' do cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 continue fi rm -f conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.$ac_objext conftest.$ac_ext done rm -f conftest* if test -n "$ac_declaration"; then echo '#ifdef __cplusplus' >>confdefs.h echo $ac_declaration >>confdefs.h echo '#endif' >>confdefs.h fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6 ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Find a good install program. We prefer a C program (faster), # so one script is as good as another. But avoid the broken or # incompatible versions: # SysV /etc/install, /usr/sbin/install # SunOS /usr/etc/install # IRIX /sbin/install # AIX /bin/install # AmigaOS /C/install, which installs bootblocks on floppy discs # AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag # AFS /usr/afsws/bin/install, which mishandles nonexistent args # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6 if test -z "$INSTALL"; then if test "${ac_cv_path_install+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. # Account for people who put trailing slashes in PATH elements. case $as_dir/ in ./ | .// | /cC/* | \ /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ /usr/ucb/* ) ;; *) # OSF1 and SCO ODT 3.0 have their own names for install. # Don't use installbsd from OSF since it installs stuff as root # by default. for ac_prog in ginstall scoinst install; do for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then if test $ac_prog = install && grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # AIX install. It has an incompatible calling convention. : elif test $ac_prog = install && grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # program-specific install script used by HP pwplus--don't use. : else ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" break 3 fi fi done done ;; esac done fi if test "${ac_cv_path_install+set}" = set; then INSTALL=$ac_cv_path_install else # As a last resort, use the slow shell script. We don't cache a # path for INSTALL within a source directory, because that will # break other packages using the cache if that directory is # removed, or if the path is relative. INSTALL=$ac_install_sh fi fi echo "$as_me:$LINENO: result: $INSTALL" >&5 echo "${ECHO_T}$INSTALL" >&6 # Use test -z because SunOS4 sh mishandles braces in ${var-val}. # It thinks the first close brace ends the variable substitution. test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $AR in [\\/]* | ?:[\\/]*) ac_cv_path_AR="$AR" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_AR="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi AR=$ac_cv_path_AR if test -n "$AR"; then echo "$as_me:$LINENO: result: $AR" >&5 echo "${ECHO_T}$AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi # Extract the first word of "ld", so it can be a program name with args. set dummy ld; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_LD+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $LD in [\\/]* | ?:[\\/]*) ac_cv_path_LD="$LD" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_LD="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi LD=$ac_cv_path_LD if test -n "$LD"; then echo "$as_me:$LINENO: result: $LD" >&5 echo "${ECHO_T}$LD" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi case $ac_cv_target_alias in i[3456]86-*-cygwin*|i[3456]86-*-mingw32*) echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6 if test "${ac_cv_prog_egrep+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | (grep -E '(a|b)') >/dev/null 2>&1 then ac_cv_prog_egrep='grep -E' else ac_cv_prog_egrep='egrep' fi fi echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 echo "${ECHO_T}$ac_cv_prog_egrep" >&6 EGREP=$ac_cv_prog_egrep echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core core.* *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6 if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done if test "${ac_cv_header_windows_h+set}" = set; then echo "$as_me:$LINENO: checking for windows.h" >&5 echo $ECHO_N "checking for windows.h... $ECHO_C" >&6 if test "${ac_cv_header_windows_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_windows_h" >&5 echo "${ECHO_T}$ac_cv_header_windows_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking windows.h usability" >&5 echo $ECHO_N "checking windows.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking windows.h presence" >&5 echo $ECHO_N "checking windows.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc in yes:no ) { echo "$as_me:$LINENO: WARNING: windows.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: windows.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: windows.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: windows.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; no:yes ) { echo "$as_me:$LINENO: WARNING: windows.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: windows.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: windows.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: windows.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: windows.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: windows.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for windows.h" >&5 echo $ECHO_N "checking for windows.h... $ECHO_C" >&6 if test "${ac_cv_header_windows_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_windows_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_windows_h" >&5 echo "${ECHO_T}$ac_cv_header_windows_h" >&6 fi CFLAGS="$CFLAGS -mno-cygwin" CPPFLAGS="$CPPFLAGS -D_WIN32_" ac_includes_default="$ac_includes_default #include " WIN32=YES ;; *) WIN32=NO ;; esac if test $WithODBC = YES; then if test "${ac_cv_header_sqlext_h+set}" = set; then echo "$as_me:$LINENO: checking for sqlext.h" >&5 echo $ECHO_N "checking for sqlext.h... $ECHO_C" >&6 if test "${ac_cv_header_sqlext_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_sqlext_h" >&5 echo "${ECHO_T}$ac_cv_header_sqlext_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking sqlext.h usability" >&5 echo $ECHO_N "checking sqlext.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking sqlext.h presence" >&5 echo $ECHO_N "checking sqlext.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc in yes:no ) { echo "$as_me:$LINENO: WARNING: sqlext.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: sqlext.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: sqlext.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sqlext.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; no:yes ) { echo "$as_me:$LINENO: WARNING: sqlext.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: sqlext.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: sqlext.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: sqlext.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: sqlext.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sqlext.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for sqlext.h" >&5 echo $ECHO_N "checking for sqlext.h... $ECHO_C" >&6 if test "${ac_cv_header_sqlext_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_sqlext_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_sqlext_h" >&5 echo "${ECHO_T}$ac_cv_header_sqlext_h" >&6 fi if test $ac_cv_header_sqlext_h = yes; then : else { { echo "$as_me:$LINENO: error: sqlext.h and libodbc required to build ODBC building." >&5 echo "$as_me: error: sqlext.h and libodbc required to build ODBC building." >&2;} { (exit 1); exit 1; }; } fi case $WIN32 in YES) cat >conftest.$ac_ext <<_ACEOF #include #include int main() { SQLAllocEnv (NULL); return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then LIBS="${LIBS} -lodbc32" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: sqlext.h and libodbc required to build ODBC building." >&5 echo "$as_me: error: sqlext.h and libodbc required to build ODBC building." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_objext conftest.$ac_ext ;; NO) echo "$as_me:$LINENO: checking for SQLAllocEnv in -lodbc" >&5 echo $ECHO_N "checking for SQLAllocEnv in -lodbc... $ECHO_C" >&6 if test "${ac_cv_lib_odbc_SQLAllocEnv+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lodbc $LIBS" cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char SQLAllocEnv (); int main () { SQLAllocEnv (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_odbc_SQLAllocEnv=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_odbc_SQLAllocEnv=no fi rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_odbc_SQLAllocEnv" >&5 echo "${ECHO_T}$ac_cv_lib_odbc_SQLAllocEnv" >&6 if test $ac_cv_lib_odbc_SQLAllocEnv = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBODBC 1 _ACEOF LIBS="-lodbc $LIBS" else { { echo "$as_me:$LINENO: error: sqlext.h and libodbc required to build ODBC building." >&5 echo "$as_me: error: sqlext.h and libodbc required to build ODBC building." >&2;} { (exit 1); exit 1; }; } fi ;; esac CPPFLAGS="$CPPFLAGS -Isrc/HSQL" fi if test $WithPostgreSQL = YES; then if test $WIN32 = NO; then # Extract the first word of "pg_config", so it can be a program name with args. set dummy pg_config; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_PG_CONFIG+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $PG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PG_CONFIG="$PG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PG_CONFIG="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi PG_CONFIG=$ac_cv_path_PG_CONFIG if test -n "$PG_CONFIG"; then echo "$as_me:$LINENO: result: $PG_CONFIG" >&5 echo "${ECHO_T}$PG_CONFIG" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi if test "$PG_CONFIG" = "" || test ! -f $PG_CONFIG; then { { echo "$as_me:$LINENO: error: pg_config is required to build PostgreSQL binding" >&5 echo "$as_me: error: pg_config is required to build PostgreSQL binding" >&2;} { (exit 1); exit 1; }; } fi incdir=`$PG_CONFIG --includedir` incdir_server=`$PG_CONFIG --includedir-server` case $ac_cv_target_alias in i[3456]86-*-cygwin*|i[3456]86-*-mingw32*) LDFLAGS="$LDFLAGS -L$(cygpath -m `$PG_CONFIG --libdir`)" incdir=$(cygpath -m $incdir) CPPFLAGS="$CPPFLAGS -I$(cygpath -m /usr/include) -I$incdir -I$incdir_server" ;; *) LDFLAGS="$LDFLAGS -L`$PG_CONFIG --libdir`" CPPFLAGS="$CPPFLAGS -I$incdir -I$incdir_server" ;; esac else CPPFLAGS="$CPPFLAGS -D_MSC_VER" fi if test "${ac_cv_header_libpq_fe_h+set}" = set; then echo "$as_me:$LINENO: checking for libpq-fe.h" >&5 echo $ECHO_N "checking for libpq-fe.h... $ECHO_C" >&6 if test "${ac_cv_header_libpq_fe_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_libpq_fe_h" >&5 echo "${ECHO_T}$ac_cv_header_libpq_fe_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking libpq-fe.h usability" >&5 echo $ECHO_N "checking libpq-fe.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking libpq-fe.h presence" >&5 echo $ECHO_N "checking libpq-fe.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc in yes:no ) { echo "$as_me:$LINENO: WARNING: libpq-fe.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: libpq-fe.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: libpq-fe.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: libpq-fe.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; no:yes ) { echo "$as_me:$LINENO: WARNING: libpq-fe.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: libpq-fe.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: libpq-fe.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: libpq-fe.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: libpq-fe.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: libpq-fe.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for libpq-fe.h" >&5 echo $ECHO_N "checking for libpq-fe.h... $ECHO_C" >&6 if test "${ac_cv_header_libpq_fe_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_libpq_fe_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_libpq_fe_h" >&5 echo "${ECHO_T}$ac_cv_header_libpq_fe_h" >&6 fi if test $ac_cv_header_libpq_fe_h = yes; then : else { { echo "$as_me:$LINENO: error: libpq-fe.h header not found" >&5 echo "$as_me: error: libpq-fe.h header not found" >&2;} { (exit 1); exit 1; }; } fi if test "${ac_cv_header_postgres_h+set}" = set; then echo "$as_me:$LINENO: checking for postgres.h" >&5 echo $ECHO_N "checking for postgres.h... $ECHO_C" >&6 if test "${ac_cv_header_postgres_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_postgres_h" >&5 echo "${ECHO_T}$ac_cv_header_postgres_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking postgres.h usability" >&5 echo $ECHO_N "checking postgres.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking postgres.h presence" >&5 echo $ECHO_N "checking postgres.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc in yes:no ) { echo "$as_me:$LINENO: WARNING: postgres.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: postgres.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: postgres.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: postgres.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; no:yes ) { echo "$as_me:$LINENO: WARNING: postgres.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: postgres.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: postgres.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: postgres.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: postgres.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: postgres.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for postgres.h" >&5 echo $ECHO_N "checking for postgres.h... $ECHO_C" >&6 if test "${ac_cv_header_postgres_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_postgres_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_postgres_h" >&5 echo "${ECHO_T}$ac_cv_header_postgres_h" >&6 fi if test $ac_cv_header_postgres_h = yes; then : else { { echo "$as_me:$LINENO: error: postgres.h header not found" >&5 echo "$as_me: error: postgres.h header not found" >&2;} { (exit 1); exit 1; }; } fi case $WIN32 in YES) echo "$as_me:$LINENO: checking for PQsetdbLogin in -llibpq" >&5 echo $ECHO_N "checking for PQsetdbLogin in -llibpq... $ECHO_C" >&6 if test "${ac_cv_lib_libpq_PQsetdbLogin+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-llibpq $LIBS" cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char PQsetdbLogin (); int main () { PQsetdbLogin (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_libpq_PQsetdbLogin=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_libpq_PQsetdbLogin=no fi rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_libpq_PQsetdbLogin" >&5 echo "${ECHO_T}$ac_cv_lib_libpq_PQsetdbLogin" >&6 if test $ac_cv_lib_libpq_PQsetdbLogin = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBLIBPQ 1 _ACEOF LIBS="-llibpq $LIBS" else { { echo "$as_me:$LINENO: error: liblibpq.a library not found" >&5 echo "$as_me: error: liblibpq.a library not found" >&2;} { (exit 1); exit 1; }; } fi ;; NO) echo "$as_me:$LINENO: checking for PQsetdbLogin in -lpq" >&5 echo $ECHO_N "checking for PQsetdbLogin in -lpq... $ECHO_C" >&6 if test "${ac_cv_lib_pq_PQsetdbLogin+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpq $LIBS" cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char PQsetdbLogin (); int main () { PQsetdbLogin (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pq_PQsetdbLogin=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pq_PQsetdbLogin=no fi rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pq_PQsetdbLogin" >&5 echo "${ECHO_T}$ac_cv_lib_pq_PQsetdbLogin" >&6 if test $ac_cv_lib_pq_PQsetdbLogin = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBPQ 1 _ACEOF LIBS="-lpq $LIBS" else { { echo "$as_me:$LINENO: error: libpq.a library not found" >&5 echo "$as_me: error: libpq.a library not found" >&2;} { (exit 1); exit 1; }; } fi ;; esac fi if test $WithMySQL = YES; then if test $WIN32 = NO; then # Extract the first word of "mysql_config", so it can be a program name with args. set dummy mysql_config; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_MYSQL_CONFIG+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $MYSQL_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_MYSQL_CONFIG="$MYSQL_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_MYSQL_CONFIG="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi MYSQL_CONFIG=$ac_cv_path_MYSQL_CONFIG if test -n "$MYSQL_CONFIG"; then echo "$as_me:$LINENO: result: $MYSQL_CONFIG" >&5 echo "${ECHO_T}$MYSQL_CONFIG" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi if test "$MYSQL_CONFIG" = "" || test ! -f $MYSQL_CONFIG; then { { echo "$as_me:$LINENO: error: mysql_config is required to build MySQL binding" >&5 echo "$as_me: error: mysql_config is required to build MySQL binding" >&2;} { (exit 1); exit 1; }; } fi LDFLAGS="$LDFLAGS `$MYSQL_CONFIG --libs`" for mysql_opt in `$MYSQL_CONFIG --cflags` do case $mysql_opt in -I*) CPPFLAGS="$CPPFLAGS ${mysql_opt}";; esac done fi if test "${ac_cv_header_mysql_h+set}" = set; then echo "$as_me:$LINENO: checking for mysql.h" >&5 echo $ECHO_N "checking for mysql.h... $ECHO_C" >&6 if test "${ac_cv_header_mysql_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_mysql_h" >&5 echo "${ECHO_T}$ac_cv_header_mysql_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking mysql.h usability" >&5 echo $ECHO_N "checking mysql.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking mysql.h presence" >&5 echo $ECHO_N "checking mysql.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc in yes:no ) { echo "$as_me:$LINENO: WARNING: mysql.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: mysql.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: mysql.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: mysql.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; no:yes ) { echo "$as_me:$LINENO: WARNING: mysql.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: mysql.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: mysql.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: mysql.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: mysql.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: mysql.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for mysql.h" >&5 echo $ECHO_N "checking for mysql.h... $ECHO_C" >&6 if test "${ac_cv_header_mysql_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_mysql_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_mysql_h" >&5 echo "${ECHO_T}$ac_cv_header_mysql_h" >&6 fi if test $ac_cv_header_mysql_h = yes; then : else { { echo "$as_me:$LINENO: error: mysql.h header not found" >&5 echo "$as_me: error: mysql.h header not found" >&2;} { (exit 1); exit 1; }; } fi case $WIN32 in YES) cat >conftest.$ac_ext <<_ACEOF #include #include int main () { mysql_init (NULL); return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then LIBS="${LIBS} -llibmysql" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: liblibmysql.a library not found" >&5 echo "$as_me: error: liblibmysql.a library not found" >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_objext conftest.$ac_ext ;; NO) echo "$as_me:$LINENO: checking for mysql_init in -lmysqlclient" >&5 echo $ECHO_N "checking for mysql_init in -lmysqlclient... $ECHO_C" >&6 if test "${ac_cv_lib_mysqlclient_mysql_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lmysqlclient $LIBS" cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char mysql_init (); int main () { mysql_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_mysqlclient_mysql_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_mysqlclient_mysql_init=no fi rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_mysqlclient_mysql_init" >&5 echo "${ECHO_T}$ac_cv_lib_mysqlclient_mysql_init" >&6 if test $ac_cv_lib_mysqlclient_mysql_init = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBMYSQLCLIENT 1 _ACEOF LIBS="-lmysqlclient $LIBS" else { { echo "$as_me:$LINENO: error: libmysql.a library not found" >&5 echo "$as_me: error: libmysql.a library not found" >&2;} { (exit 1); exit 1; }; } fi ;; esac fi if test $WithSQLite = YES; then if test "${ac_cv_header_sqlite_h+set}" = set; then echo "$as_me:$LINENO: checking for sqlite.h" >&5 echo $ECHO_N "checking for sqlite.h... $ECHO_C" >&6 if test "${ac_cv_header_sqlite_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_sqlite_h" >&5 echo "${ECHO_T}$ac_cv_header_sqlite_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking sqlite.h usability" >&5 echo $ECHO_N "checking sqlite.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking sqlite.h presence" >&5 echo $ECHO_N "checking sqlite.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc in yes:no ) { echo "$as_me:$LINENO: WARNING: sqlite.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: sqlite.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: sqlite.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sqlite.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; no:yes ) { echo "$as_me:$LINENO: WARNING: sqlite.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: sqlite.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: sqlite.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: sqlite.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: sqlite.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sqlite.h: proceeding with the preprocessor's result" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to bug-autoconf@gnu.org. ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for sqlite.h" >&5 echo $ECHO_N "checking for sqlite.h... $ECHO_C" >&6 if test "${ac_cv_header_sqlite_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_sqlite_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_sqlite_h" >&5 echo "${ECHO_T}$ac_cv_header_sqlite_h" >&6 fi if test $ac_cv_header_sqlite_h = yes; then : else { { echo "$as_me:$LINENO: error: sqlite.h header not found" >&5 echo "$as_me: error: sqlite.h header not found" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: checking for sqlite_open in -lsqlite" >&5 echo $ECHO_N "checking for sqlite_open in -lsqlite... $ECHO_C" >&6 if test "${ac_cv_lib_sqlite_sqlite_open+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsqlite $LIBS" cat >conftest.$ac_ext <<_ACEOF #line $LINENO "configure" /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char sqlite_open (); int main () { sqlite_open (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_sqlite_sqlite_open=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_sqlite_sqlite_open=no fi rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_sqlite_sqlite_open" >&5 echo "${ECHO_T}$ac_cv_lib_sqlite_sqlite_open" >&6 if test $ac_cv_lib_sqlite_sqlite_open = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBSQLITE 1 _ACEOF LIBS="-lsqlite $LIBS" else { { echo "$as_me:$LINENO: error: sqlite.h and libsqlite required to build SQLite building." >&5 echo "$as_me: error: sqlite.h and libsqlite required to build SQLite building." >&2;} { (exit 1); exit 1; }; } fi LDFLAGS="$LDFLAGS -lsqlite" fi LDFLAGS="${LIBS} ${LDFLAGS}" LIB_DIRS='"'${GHC_DIR}'"' for lib_opt in ${LDFLAGS} do case $lib_opt in -l*) if test x$DEP_LIBS = x; then DEP_LIBS='"'`echo ${lib_opt} | sed s,-l,,`'"' else DEP_LIBS=$DEP_LIBS,'"'`echo ${lib_opt} | sed s,-l,,`'"' fi;; -L*) LIB_DIRS=$LIB_DIRS,'"'`echo ${lib_opt} | sed s,-L,, | sed s,"'",, | sed s,"'",,`'"' esac done cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. cat >confdef2opt.sed <<\_ACEOF t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote d : quote s,[ `~#$^&*(){}\\|;'"<>?],\\&,g s,\[,\\&,g s,\],\\&,g s,\$,$$,g p _ACEOF # We use echo to avoid assuming a particular line-breaking character. # The extra dot is to prevent the shell from consuming trailing # line-breaks from the sub-command output. A line-break within # single-quotes doesn't work because, if this script is created in a # platform that uses two characters for line-breaks (e.g., DOS), tr # would break. ac_LF_and_DOT=`echo; echo .` DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` rm -f confdef2opt.sed ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_i=`echo "$ac_i" | sed 's/\$U\././;s/\.o$//;s/\.obj$//'` # 2. Add them. ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi # Support unset when possible. if (FOO=FOO; unset FOO) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -n "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="sed y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" # Sed expression to map a string onto a valid variable name. as_tr_sh="sed y%*+%pp%;s%[^_$as_cr_alnum]%_%g" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH exec 6>&1 # Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. Logging --version etc. is OK. exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX } >&5 cat >&5 <<_CSEOF This file was extended by HSQL $as_me 1.0, which was generated by GNU Autoconf 2.57. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ _CSEOF echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 echo >&5 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ HSQL config.status 1.0 configured by $0, generated by GNU Autoconf 2.57, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir INSTALL="$INSTALL" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; *) # This is not an option, so the user has probably given explicit # arguments. ac_option=$1 ac_need_defaults=false;; esac case $ac_option in # Handling of the options. _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:$LINENO: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "config.mk" ) CONFIG_FILES="$CONFIG_FILES config.mk:config.mk.in" ;; "hsql.pkg" ) CONFIG_FILES="$CONFIG_FILES hsql.pkg:hsql.pkg.in" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./confstat$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "\$CONFIG_FILES"; then # Protect against being on the right side of a sed subst in config.status. sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@DEFS@,$DEFS,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@LIBS@,$LIBS,;t t s,@build@,$build,;t t s,@build_cpu@,$build_cpu,;t t s,@build_vendor@,$build_vendor,;t t s,@build_os@,$build_os,;t t s,@host@,$host,;t t s,@host_cpu@,$host_cpu,;t t s,@host_vendor@,$host_vendor,;t t s,@host_os@,$host_os,;t t s,@target@,$target,;t t s,@target_cpu@,$target_cpu,;t t s,@target_vendor@,$target_vendor,;t t s,@target_os@,$target_os,;t t s,@WithODBC@,$WithODBC,;t t s,@WithPostgreSQL@,$WithPostgreSQL,;t t s,@WithMySQL@,$WithMySQL,;t t s,@WithSQLite@,$WithSQLite,;t t s,@GHC@,$GHC,;t t s,@GHC_DIR@,$GHC_DIR,;t t s,@HSC2HS@,$HSC2HS,;t t s,@GHC_PKG@,$GHC_PKG,;t t s,@HUGS@,$HUGS,;t t s,@HUGS_DIR@,$HUGS_DIR,;t t s,@SO_EXT@,$SO_EXT,;t t s,@FFIHUGS@,$FFIHUGS,;t t s,@HADDOCK@,$HADDOCK,;t t s,@DOC_DIR@,$DOC_DIR,;t t s,@CC@,$CC,;t t s,@CFLAGS@,$CFLAGS,;t t s,@LDFLAGS@,$LDFLAGS,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@ac_ct_CC@,$ac_ct_CC,;t t s,@EXEEXT@,$EXEEXT,;t t s,@OBJEXT@,$OBJEXT,;t t s,@CPP@,$CPP,;t t s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t s,@INSTALL_DATA@,$INSTALL_DATA,;t t s,@AR@,$AR,;t t s,@LD@,$LD,;t t s,@EGREP@,$EGREP,;t t s,@WIN32@,$WIN32,;t t s,@PG_CONFIG@,$PG_CONFIG,;t t s,@MYSQL_CONFIG@,$MYSQL_CONFIG,;t t s,@DEP_LIBS@,$DEP_LIBS,;t t s,@LIB_DIRS@,$LIB_DIRS,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Don't blindly perform a `cd "$ac_dir"/$ac_foo && pwd` since $ac_foo can be # absolute. ac_abs_builddir=`cd "$ac_dir" && cd $ac_builddir && pwd` ac_abs_top_builddir=`cd "$ac_dir" && cd ${ac_top_builddir}. && pwd` ac_abs_srcdir=`cd "$ac_dir" && cd $ac_srcdir && pwd` ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd` case $INSTALL in [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; *) ac_INSTALL=$ac_top_builddir$INSTALL ;; esac if test x"$ac_file" != x-; then { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then configure_input= else configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo $f;; *) # Relative if test -f "$f"; then # Build tree echo $f elif test -f "$srcdir/$f"; then # Source tree echo $srcdir/$f else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@abs_srcdir@,$ac_abs_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t s,@builddir@,$ac_builddir,;t t s,@abs_builddir@,$ac_abs_builddir,;t t s,@top_builddir@,$ac_top_builddir,;t t s,@abs_top_builddir@,$ac_abs_top_builddir,;t t s,@INSTALL@,$ac_INSTALL,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi echo "creating output directories:" echo " - build/Database/HSQL" mkdir -p build/Database/HSQL echo echo "Backends" echo "--------" echo echo "MySQL: $WithMySQL" echo "PostgreSQL: $WithPostgreSQL" echo "SQLite: $WithSQLite" echo "ODBC: $WithODBC" echo hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/0000755006511100651110000000000010504340326020216 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/Database.HSQL.MySQL.html0000644006511100651110000001022210504340326024317 0ustar rossross Database.HSQL.MySQL
ContentsIndex
Database.HSQL.MySQL
Portability portable
Stability provisional
Maintainer ka2_mail@yahoo.com
Description
The module provides interface to MySQL database
Synopsis
connect :: String -> String -> String -> String -> IO Connection
module Database.HSQL
Documentation
connect
:: StringServer name
-> StringDatabase name
-> StringUser identifier
-> StringAuthentication string (password)
-> IO Connection
Makes a new connection to the database server.
module Database.HSQL
Produced by Haddock version 0.6
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/Database.HSQL.ODBC.html0000644006511100651110000001272510504340326024073 0ustar rossross Database.HSQL.ODBC
ContentsIndex
Database.HSQL.ODBC
Portability portable
Stability provisional
Maintainer ka2_mail@yahoo.com
Description
The module provides interface to ODBC
Synopsis
connect :: String -> String -> String -> IO Connection
driverConnect :: String -> IO Connection
module Database.HSQL
Documentation
connect
:: StringData source name
-> StringUser identifier
-> StringAuthentication string (password)
-> IO Connectionthe returned value represents the new connection
Makes a new connection to the ODBC data source
driverConnect
:: StringConnection string
-> IO Connectionthe returned value represents the new connection
driverConnect is an alternative to connect. It supports data sources that require more connection information than the three arguments in connect and data sources that are not defined in the system information.
module Database.HSQL
Produced by Haddock version 0.6
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/Database.HSQL.SQLite.html0000644006511100651110000000546610504340326024531 0ustar rossross Database.HSQL.SQLite
ContentsIndex
Database.HSQL.SQLite
Portability portable
Stability provisional
Maintainer ka2_mail@yahoo.com
Description
The module provides interface to SQLite
Synopsis
connect :: FilePath -> IOMode -> IO Connection
module Database.HSQL
Produced by Haddock version 0.6
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/Database.HSQL.PostgreSQL.html0000644006511100651110000001024110504340326025356 0ustar rossross Database.HSQL.PostgreSQL
ContentsIndex
Database.HSQL.PostgreSQL
Portability portable
Stability provisional
Maintainer ka2_mail@yahoo.com
Description
The module provides interface to PostgreSQL database
Synopsis
connect :: String -> String -> String -> String -> IO Connection
module Database.HSQL
Documentation
connect
:: StringServer name
-> StringDatabase name
-> StringUser identifier
-> StringAuthentication string (password)
-> IO Connection
Makes a new connection to the database server.
module Database.HSQL
Produced by Haddock version 0.6
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/Database.HSQL.html0000644006511100651110000020134410504340326023362 0ustar rossross Database.HSQL
ContentsIndex
Database.HSQL
Portability portable
Stability provisional
Maintainer ka2_mail@yahoo.com
Contents
Connect/Disconnect
Command Execution Functions
Retrieving Statement values and types
Transactions
SQL Exceptions handling
Utilities
Metadata
Extra types
Description
The module provides an abstract database interface
Synopsis
data Connection
disconnect :: Connection -> IO ()
execute :: Connection -> String -> IO ()
data Statement
query :: Connection -> String -> IO Statement
closeStatement :: Statement -> IO ()
fetch :: Statement -> IO Bool
type FieldDef = (String, SqlType, Bool)
data SqlType
= SqlChar Int
| SqlVarChar Int
| SqlLongVarChar Int
| SqlText
| SqlWChar Int
| SqlWVarChar Int
| SqlWLongVarChar Int
| SqlDecimal Int Int
| SqlNumeric Int Int
| SqlSmallInt
| SqlMedInt
| SqlInteger
| SqlReal
| SqlFloat
| SqlDouble
| SqlBit
| SqlTinyInt
| SqlBigInt
| SqlBinary Int
| SqlVarBinary Int
| SqlLongVarBinary Int
| SqlDate
| SqlTime
| SqlTimeTZ
| SqlAbsTime
| SqlRelTime
| SqlTimeInterval
| SqlAbsTimeInterval
| SqlTimeStamp
| SqlDateTime
| SqlDateTimeTZ
| SqlYear
| SqlSET
| SqlENUM
| SqlBLOB
| SqlMoney
| SqlINetAddr
| SqlCIDRAddr
| SqlMacAddr
| SqlPoint
| SqlLSeg
| SqlPath
| SqlBox
| SqlPolygon
| SqlLine
| SqlCircle
| SqlUnknown Int
class SqlBind a
toSqlValue :: SqlBind a => a -> String
getFieldValueMB :: SqlBind a => Statement -> String -> IO (Maybe a)
getFieldValue :: SqlBind a => Statement -> String -> IO a
getFieldValue' :: SqlBind a => Statement -> String -> a -> IO a
getFieldValueType :: Statement -> String -> (SqlType, Bool)
getFieldsTypes :: Statement -> [(String, SqlType, Bool)]
inTransaction :: Connection -> (Connection -> IO a) -> IO a
data SqlError
= SqlError {
seState :: String
seNativeError :: Int
seErrorMsg :: String
}
| SqlNoData
| SqlInvalidHandle
| SqlStillExecuting
| SqlNeedData
| SqlBadTypeCast {
seFieldName :: String
seFieldType :: SqlType
}
| SqlFetchNull {
seFieldName :: String
}
| SqlUnknownField {
seFieldName :: String
}
| SqlUnsupportedOperation
| SqlClosedHandle
catchSql :: IO a -> (SqlError -> IO a) -> IO a
handleSql :: (SqlError -> IO a) -> IO a -> IO a
sqlExceptions :: Exception -> Maybe SqlError
forEachRow :: (Statement -> s -> IO s) -> Statement -> s -> IO s
forEachRow' :: (Statement -> IO ()) -> Statement -> IO ()
collectRows :: (Statement -> IO a) -> Statement -> IO [a]
tables :: Connection -> IO [String]
describe :: Connection -> String -> IO [FieldDef]
data Point = Point Double Double
data Line = Line Point Point
data Path
= OpenPath [Point]
| ClosedPath [Point]
data Box = Box Double Double Double Double
data Circle = Circle Point Double
data Polygon = Polygon [Point]
Connect/Disconnect
data Connection
A Connection type represents a connection to a database, through which you can operate on the it. In order to create the connection you need to use the connect function from the module for your prefered backend.
disconnect :: Connection -> IO ()
Closes the connection. Performing disconnect on a connection that has already been closed has no effect. All other operations on a closed connection will fail.
Command Execution Functions
Once a connection to a database has been successfully established, the functions described here are used to perform SQL queries and commands.
execute
:: Connectionthe database connection
-> Stringthe text of SQL command
-> IO ()
Submits a command to the database.
data Statement
The Statement type represents a result from the execution of given SQL query.
query
:: Connectionthe database connection
-> Stringthe text of SQL query
-> IO Statementthe associated statement. Must be closed with the closeStatement function
Executes a query and returns a result set
closeStatement :: Statement -> IO ()
closeStatement stops processing associated with a specific statement, closes any open cursors associated with the statement, discards pending results, and frees all resources associated with the statement. Performing closeStatement on a statement that has already been closed has no effect. All other operations on a closed statement will fail.
fetch :: Statement -> IO Bool
fetch fetches the next rowset of data from the result set. The values from columns can be retrieved with getFieldValue function.
Retrieving Statement values and types
type FieldDef = (String, SqlType, Bool)
data SqlType
Constructors
SqlChar Int
SqlVarChar Int
SqlLongVarChar Int
SqlText
SqlWChar Int
SqlWVarChar Int
SqlWLongVarChar Int
SqlDecimal Int Int
SqlNumeric Int Int
SqlSmallInt
SqlMedInt
SqlInteger
SqlReal
SqlFloat
SqlDouble
SqlBit
SqlTinyInt
SqlBigInt
SqlBinary Int
SqlVarBinary Int
SqlLongVarBinary Int
SqlDate
SqlTime
SqlTimeTZ
SqlAbsTime
SqlRelTime
SqlTimeInterval
SqlAbsTimeInterval
SqlTimeStamp
SqlDateTime
SqlDateTimeTZ
SqlYear
SqlSET
SqlENUM
SqlBLOB
SqlMoney
SqlINetAddr
SqlCIDRAddr
SqlMacAddr
SqlPoint
SqlLSeg
SqlPath
SqlBox
SqlPolygon
SqlLine
SqlCircle
SqlUnknown IntHSQL returns SqlUnknown tp for all columns for which it cannot determine the right type. The tp here is the internal type code returned from the backend library
Instances
Eq SqlType
Show SqlType
class SqlBind a
Instances
SqlBind Int
SqlBind Int64
SqlBind Integer
SqlBind String
SqlBind Bool
SqlBind Double
SqlBind ClockTime
SqlBind Point
SqlBind Line
SqlBind Path
SqlBind Box
SqlBind Polygon
SqlBind Circle
SqlBind INetAddr
SqlBind MacAddr
toSqlValue :: SqlBind a => a -> String
getFieldValueMB
:: SqlBind a
=> Statement
-> StringField name
-> IO (Maybe a)Field value or Nothing
Retrieves the value of field with the specified name. The returned value is Nothing if the field value is null.
getFieldValue
:: SqlBind a
=> Statement
-> StringField name
-> IO aField value
Retrieves the value of field with the specified name. If the field value is null then the function will throw SqlFetchNull exception.
getFieldValue'
:: SqlBind a
=> Statement
-> StringField name
-> aDefault field value
-> IO aField value
Retrieves the value of field with the specified name. If the field value is null then the function will return the default value.
getFieldValueType :: Statement -> String -> (SqlType, Bool)
Returns the type and the nullable flag for field with specified name
getFieldsTypes :: Statement -> [(String, SqlType, Bool)]
Returns the list of fields with their types and nullable flags
Transactions
inTransaction
:: Connection
-> (Connection -> IO a)an action
-> IO athe returned value is the result returned from action
The inTransaction function executes the specified action in transaction mode. If the action completes successfully then the transaction will be commited. If the action completes with an exception then the transaction will be rolled back and the exception will be throw again.
SQL Exceptions handling
data SqlError
Constructors
SqlError
seState :: String
seNativeError :: Int
seErrorMsg :: String
SqlNoData
SqlInvalidHandle
SqlStillExecuting
SqlNeedData
SqlBadTypeCast
seFieldName :: String
seFieldType :: SqlType
SqlFetchNull
seFieldName :: String
SqlUnknownField
seFieldName :: String
SqlUnsupportedOperation
SqlClosedHandle
Instances
Typeable SqlError
Show SqlError
catchSql :: IO a -> (SqlError -> IO a) -> IO a
handleSql :: (SqlError -> IO a) -> IO a -> IO a
sqlExceptions :: Exception -> Maybe SqlError
Utilities
forEachRow
:: (Statement -> s -> IO s)an action
-> Statementthe statement
-> sinitial state
-> IO sfinal state
The forEachRow function iterates through the result set in Statement and executes the given action for each row in the set. The function closes the Statement after the last row processing or if the given action raises an exception.
forEachRow' :: (Statement -> IO ()) -> Statement -> IO ()
The forEachRow' function is analogous to forEachRow but doesn't provide state. The function closes the Statement after the last row processing or if the given action raises an exception.
collectRows :: (Statement -> IO a) -> Statement -> IO [a]
The collectRows function iterates through the result set in Statement and executes the given action for each row in the set. The values returned from action are collected and returned as list. The function closes the Statement after the last row processing or if the given action raises an exception.
Metadata
tables
:: ConnectionDatabase connection
-> IO [String]The names of all tables in the database.
List all tables in the database.
describe
:: ConnectionDatabase connection
-> StringName of a database table
-> IO [FieldDef]The list of fields in the table
List all columns in a table along with their types and nullable flags
Extra types
data Point
Constructors
Point Double Double
Instances
SqlBind Point
Eq Point
Show Point
data Line
Constructors
Line Point Point
Instances
SqlBind Line
Eq Line
Show Line
data Path
Constructors
OpenPath [Point]
ClosedPath [Point]
Instances
SqlBind Path
Eq Path
Show Path
data Box
Constructors
Box Double Double Double Double
Instances
SqlBind Box
Eq Box
Show Box
data Circle
Constructors
Circle Point Double
Instances
SqlBind Circle
Eq Circle
Show Circle
data Polygon
Constructors
Polygon [Point]
Instances
SqlBind Polygon
Eq Polygon
Show Polygon
Produced by Haddock version 0.6
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-B.html0000644006511100651110000000377210504340326023146 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (B)
Box
1 (Type/Class)Database.HSQL
2 (Data Constructor)Database.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-C.html0000644006511100651110000000571110504340326023142 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (C)
Circle
1 (Type/Class)Database.HSQL
2 (Data Constructor)Database.HSQL
ClosedPathDatabase.HSQL
ConnectionDatabase.HSQL
catchSqlDatabase.HSQL
closeStatementDatabase.HSQL
collectRowsDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-D.html0000644006511100651110000000364210504340326023144 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (D)
describeDatabase.HSQL
disconnectDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-E.html0000644006511100651110000000334010504340326023140 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (E)
executeDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-F.html0000644006511100651110000000443210504340326023144 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (F)
FieldDefDatabase.HSQL
fetchDatabase.HSQL
forEachRowDatabase.HSQL
forEachRow'Database.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-G.html0000644006511100651110000000502410504340326023143 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (G)
getFieldValueDatabase.HSQL
getFieldValue'Database.HSQL
getFieldValueMBDatabase.HSQL
getFieldValueTypeDatabase.HSQL
getFieldsTypesDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-H.html0000644006511100651110000000334410504340326023147 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (H)
handleSqlDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-I.html0000644006511100651110000000335410504340326023151 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (I)
inTransactionDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-L.html0000644006511100651110000000377510504340326023163 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (L)
Line
1 (Type/Class)Database.HSQL
2 (Data Constructor)Database.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-O.html0000644006511100651110000000334210504340326023154 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (O)
OpenPathDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-P.html0000644006511100651110000000522410504340326023156 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (P)
PathDatabase.HSQL
Point
1 (Type/Class)Database.HSQL
2 (Data Constructor)Database.HSQL
Polygon
1 (Type/Class)Database.HSQL
2 (Data Constructor)Database.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-Q.html0000644006511100651110000000333410504340326023157 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (Q)
queryDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-S.html0000644006511100651110000003436310504340326023167 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (S)
SqlAbsTimeDatabase.HSQL
SqlAbsTimeIntervalDatabase.HSQL
SqlBLOBDatabase.HSQL
SqlBadTypeCastDatabase.HSQL
SqlBigIntDatabase.HSQL
SqlBinaryDatabase.HSQL
SqlBindDatabase.HSQL
SqlBitDatabase.HSQL
SqlBoxDatabase.HSQL
SqlCIDRAddrDatabase.HSQL
SqlCharDatabase.HSQL
SqlCircleDatabase.HSQL
SqlClosedHandleDatabase.HSQL
SqlDateDatabase.HSQL
SqlDateTimeDatabase.HSQL
SqlDateTimeTZDatabase.HSQL
SqlDecimalDatabase.HSQL
SqlDoubleDatabase.HSQL
SqlENUMDatabase.HSQL
SqlError
1 (Type/Class)Database.HSQL
2 (Data Constructor)Database.HSQL
SqlFetchNullDatabase.HSQL
SqlFloatDatabase.HSQL
SqlINetAddrDatabase.HSQL
SqlIntegerDatabase.HSQL
SqlInvalidHandleDatabase.HSQL
SqlLSegDatabase.HSQL
SqlLineDatabase.HSQL
SqlLongVarBinaryDatabase.HSQL
SqlLongVarCharDatabase.HSQL
SqlMacAddrDatabase.HSQL
SqlMedIntDatabase.HSQL
SqlMoneyDatabase.HSQL
SqlNeedDataDatabase.HSQL
SqlNoDataDatabase.HSQL
SqlNumericDatabase.HSQL
SqlPathDatabase.HSQL
SqlPointDatabase.HSQL
SqlPolygonDatabase.HSQL
SqlRealDatabase.HSQL
SqlRelTimeDatabase.HSQL
SqlSETDatabase.HSQL
SqlSmallIntDatabase.HSQL
SqlStillExecutingDatabase.HSQL
SqlTextDatabase.HSQL
SqlTimeDatabase.HSQL
SqlTimeIntervalDatabase.HSQL
SqlTimeStampDatabase.HSQL
SqlTimeTZDatabase.HSQL
SqlTinyIntDatabase.HSQL
SqlTypeDatabase.HSQL
SqlUnknownDatabase.HSQL
SqlUnknownFieldDatabase.HSQL
SqlUnsupportedOperationDatabase.HSQL
SqlVarBinaryDatabase.HSQL
SqlVarCharDatabase.HSQL
SqlWCharDatabase.HSQL
SqlWLongVarCharDatabase.HSQL
SqlWVarCharDatabase.HSQL
SqlYearDatabase.HSQL
StatementDatabase.HSQL
seErrorMsgDatabase.HSQL
seFieldNameDatabase.HSQL
seFieldTypeDatabase.HSQL
seNativeErrorDatabase.HSQL
seStateDatabase.HSQL
sqlExceptionsDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index-T.html0000644006511100651110000000363610504340326023167 0ustar rossross (Index)
ContentsIndex
BCFLOPS
Index (T)
tablesDatabase.HSQL
toSqlValueDatabase.HSQL
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/doc-index.html0000644006511100651110000000270310504340326022760 0ustar rossross (Index)
ContentsIndex
Index
BCFLOPS
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/haddock.css0000644006511100651110000000566310504340326022337 0ustar rossross/* -------- Global things --------- */ BODY { background-color: #ffffff; color: #000000; font-family: sans-serif; } A:link { color: #0000e0; text-decoration: none } A:visited { color: #0000a0; text-decoration: none } A:hover { background-color: #e0e0ff; text-decoration: none } TABLE.vanilla { width: 100%; border-width: 0px; /* I can't seem to specify cellspacing or cellpadding properly using CSS... */ } /* font is a little too small in MSIE */ TT { font-size: 100%; } PRE { font-size: 100%; } LI P { margin: 0pt } TD { border-width: 0px; } TABLE.narrow { border-width: 0px; } TD.s8 { height: 8px; } TD.s15 { height: 15px; } SPAN.keyword { text-decoration: underline; } /* --------- Documentation elements ---------- */ TD.children { padding-left: 25px; } TD.synopsis { padding: 2px; background-color: #f0f0f0; font-family: monospace } TD.decl { padding: 2px; background-color: #f0f0f0; font-family: monospace; white-space: nowrap; vertical-align: top; } TD.recfield { padding-left: 20px } TD.doc { padding-top: 2px; padding-left: 10px; } TD.ndoc { padding: 2px; } TD.rdoc { padding: 2px; padding-left: 10px; width: 100%; } TD.body { padding-left: 10px } TD.pkg { width: 100%; padding-left: 10px } TD.indexentry { vertical-align: top; padding-right: 10px } TD.indexannot { vertical-align: top; padding-left: 20px; white-space: nowrap } TD.indexlinks { width: 100% } /* ------- Section Headings ------- */ TD.section1 { padding-top: 15px; font-weight: bold; font-size: 150% } TD.section2 { padding-top: 10px; font-weight: bold; font-size: 130% } TD.section3 { padding-top: 5px; font-weight: bold; font-size: 110% } TD.section4 { font-weight: bold; font-size: 100% } /* -------------- The title bar at the top of the page */ TD.infohead { color: #ffffff; font-weight: bold; padding-right: 10px; text-align: left; } TD.infoval { color: #ffffff; padding-right: 10px; text-align: left; } TD.topbar { background-color: #000099; padding: 5px; } TD.title { color: #ffffff; padding-left: 10px; width: 100% } TD.topbut { padding-left: 5px; padding-right: 5px; border-left-width: 1px; border-left-color: #ffffff; border-left-style: solid; white-space: nowrap; } TD.topbut A:link { color: #ffffff } TD.topbut A:visited { color: #ffff00 } TD.topbut A:hover { background-color: #6060ff; } TD.topbut:hover { background-color: #6060ff } TD.modulebar { background-color: #0077dd; padding: 5px; border-top-width: 1px; border-top-color: #ffffff; border-top-style: solid; } /* --------- The page footer --------- */ TD.botbar { background-color: #000099; color: #ffffff; padding: 5px } TD.botbar A:link { color: #ffffff; text-decoration: underline } TD.botbar A:visited { color: #ffff00 } TD.botbar A:hover { background-color: #6060ff } hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/haskell_icon.gif0000644006511100651110000000161710504340326023345 0ustar rossrossGIF87a÷€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿ!ù,lx@° A‚>8°°!Ç>$@À¡C Ðxp!Ɔ„4xãCKdhpäJ“ R<¨2¦Ì™U²¼)’äÇ8Gê,ˆ³§Èš,‹Š¤8téA¦8@µªUªQFÝÊu«À€;hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/doc/index.html0000644006511100651110000000264310504340326022220 0ustar rossross
ContentsIndex
Modules
Database
Database.HSQL
Produced by Haddock version 0.6
hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/examples/0000755006511100651110000000000010504340326021267 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HSQL/examples/Main.hs0000644006511100651110000000157110504340326022513 0ustar rossrossmodule Main where import Control.Exception import Database.HSQL.ODBC import Queries -- Change the following definitions to connect to -- another data source datasource = "HSQL_Example" user_id = "" password = "" main = handleSql print $ do bracket (connect datasource user_id password) disconnect $ \c -> inTransaction c $ \c -> do createTables c insertRecords c retrieveRecords c rs <- retrieveRecords c putStrLn " Records inserted in table Test are: " putStrLn "*************************************" mapM print rs putStrLn "*************************************" putStrLn "" putStrLn " The tables in your database are: " putStrLn "*************************************" mi <- getMetaInfo c mapM print mi putStrLn "*************************************" putStrLn "" dropTables c hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/examples/Queries.hs0000644006511100651110000000200210504340326023232 0ustar rossrossmodule Queries where import Database.HSQL createTables :: Connection -> IO () createTables c = do execute c "create table Test(id integer not null, name varchar(255) not null)" dropTables :: Connection -> IO () dropTables c = do execute c "drop table Test" insertRecords :: Connection -> IO () insertRecords c = do execute c "insert into Test(id,name) values (1,'Test1')" execute c "insert into Test(id,name) values (2,'Test2')" execute c "insert into Test(id,name) values (3,'Test3')" execute c "insert into Test(id,name) values (4,'Test4')" retrieveRecords :: Connection -> IO [(Int,String)] retrieveRecords c = do query c "select id, name from Test" >>= collectRows getRow where getRow :: Statement -> IO (Int,String) getRow stmt = do id <- getFieldValue stmt "id" name <- getFieldValue stmt "name" return (id,name) getMetaInfo :: Connection -> IO [(String,[FieldDef])] getMetaInfo c = do ts <- tables c mapM (\t -> describe c t >>= \cs -> return (t,cs)) ts hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/mingw32lib/0000755006511100651110000000000010504340326021426 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HSQL/mingw32lib/libmysql.def0000644006511100651110000000365010504340326023746 0ustar rossrossLIBRARY LIBMYSQL.DLL EXPORTS _dig_vec bmove_upp delete_dynamic init_dynamic_array insert_dynamic int2str is_prefix list_add list_delete max_allowed_packet my_casecmp my_end my_init my_malloc my_memdup my_no_flags_free my_realloc my_strdup my_thread_end my_thread_init myodbc_remove_escape@8 mysql_affected_rows@4 mysql_change_user@16 mysql_character_set_name@4 mysql_close@4 mysql_connect@16 mysql_create_db@8 mysql_data_seek@12 mysql_debug@4 mysql_drop_db@8 mysql_dump_debug_info@4 mysql_eof@4 mysql_errno@4 mysql_error@4 mysql_escape_string@12 mysql_fetch_field@4 mysql_fetch_field_direct@8 mysql_fetch_fields@4 mysql_fetch_lengths@4 mysql_fetch_row@4 mysql_field_count@4 mysql_field_seek@8 mysql_field_tell@4 mysql_free_result@4 mysql_get_client_info@0 mysql_get_host_info@4 mysql_get_proto_info@4 mysql_get_server_info@4 mysql_info@4 mysql_init@4 mysql_insert_id@4 mysql_kill@8 mysql_list_dbs@8 mysql_list_fields@12 mysql_list_processes@4 mysql_list_tables@8 mysql_num_fields@4 mysql_num_rows@4 mysql_odbc_escape_string@28 mysql_options@12 mysql_ping@4 mysql_query@8 mysql_read_query_result@4 mysql_real_connect@32 mysql_real_escape_string@16 mysql_real_query@12 mysql_refresh@8 mysql_row_seek@8 mysql_row_tell@4 mysql_select_db@8 mysql_send_query@12 mysql_shutdown@4 mysql_stat@4 mysql_store_result@4 mysql_thread_id@4 mysql_thread_safe@0 mysql_use_result@4 net_buffer_length set_dynamic strcend strdup_root strfill strinstr strmake strmov strxmov mysql_ssl_cipher@4 mysql_ssl_clear@4 mysql_ssl_set@20 hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/mingw32lib/Makefile0000644006511100651110000000057610504340326023076 0ustar rossrossall: liblibmysql.a liblibpq.a libsqlite.a liblibmysql.a: libmysql.def dlltool --input-def libmysql.def --dllname libmysql.dll --output-lib liblibmysql.a -k liblibpq.a: libpqdll.def dlltool --input-def libpqdll.def --dllname libpq.dll --output-lib liblibpq.a -k libsqlite.a: sqlite.def dlltool --input-def sqlite.def --dllname sqlite.dll --output-lib libsqlite.a -k hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/mingw32lib/libpqdll.def0000644006511100651110000000724710504340326023723 0ustar rossross; DEF file for MS VC++ LIBRARY LIBPQ DESCRIPTION "PostgreSQL Client Library" EXPORTS PQconnectdb @ 1 PQsetdbLogin @ 2 PQconndefaults @ 3 PQfinish @ 4 PQreset @ 5 PQrequestCancel @ 6 PQdb @ 7 PQuser @ 8 PQpass @ 9 PQhost @ 10 PQport @ 11 PQtty @ 12 PQoptions @ 13 PQstatus @ 14 PQerrorMessage @ 15 PQsocket @ 16 PQbackendPID @ 17 PQtrace @ 18 PQuntrace @ 19 PQsetNoticeProcessor @ 20 PQexec @ 21 PQnotifies @ 22 PQsendQuery @ 23 PQgetResult @ 24 PQisBusy @ 25 PQconsumeInput @ 26 PQgetline @ 27 PQputline @ 28 PQgetlineAsync @ 29 PQputnbytes @ 30 PQendcopy @ 31 PQfn @ 32 PQresultStatus @ 33 PQntuples @ 34 PQnfields @ 35 PQbinaryTuples @ 36 PQfname @ 37 PQfnumber @ 38 PQftype @ 39 PQfsize @ 40 PQfmod @ 41 PQcmdStatus @ 42 PQoidStatus @ 43 PQcmdTuples @ 44 PQgetvalue @ 45 PQgetlength @ 46 PQgetisnull @ 47 PQclear @ 48 PQmakeEmptyPGresult @ 49 PQprint @ 50 PQdisplayTuples @ 51 PQprintTuples @ 52 lo_open @ 53 lo_close @ 54 lo_read @ 55 lo_write @ 56 lo_lseek @ 57 lo_creat @ 58 lo_tell @ 59 lo_unlink @ 60 lo_import @ 61 lo_export @ 62 pgresStatus @ 63 PQmblen @ 64 PQresultErrorMessage @ 65 PQresStatus @ 66 termPQExpBuffer @ 67 appendPQExpBufferChar @ 68 initPQExpBuffer @ 69 resetPQExpBuffer @ 70 PQoidValue @ 71 PQclientEncoding @ 72 PQenv2encoding @ 73 appendBinaryPQExpBuffer @ 74 appendPQExpBufferStr @ 75 destroyPQExpBuffer @ 76 createPQExpBuffer @ 77 PQconninfoFree @ 78 PQconnectPoll @ 79 PQconnectStart @ 80 PQflush @ 81 PQisnonblocking @ 82 PQresetPoll @ 83 PQresetStart @ 84 PQsetClientEncoding @ 85 PQsetnonblocking @ 86 PQfreeNotify @ 87 PQescapeString @ 88 PQescapeBytea @ 89 printfPQExpBuffer @ 90 appendPQExpBuffer @ 91 pg_encoding_to_char @ 92 pg_utf_mblen @ 93 PQunescapeBytea @ 94 PQfreemem @ 95 PQtransactionStatus @ 96 PQparameterStatus @ 97 PQprotocolVersion @ 98 PQsetErrorVerbosity @ 99 PQsetNoticeReceiver @ 100 PQexecParams @ 101 PQsendQueryParams @ 102 PQputCopyData @ 103 PQputCopyEnd @ 104 PQgetCopyData @ 105 PQresultErrorField @ 106 PQftable @ 107 PQftablecol @ 108 PQfformat @ 109 PQexecPrepared @ 110 PQsendQueryPrepared @ 111 hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/mingw32lib/sqlite.def0000644006511100651110000000133110504340326023405 0ustar rossrossEXPORTS sqlite_open sqlite_close sqlite_exec sqlite_last_insert_rowid sqlite_error_string sqlite_interrupt sqlite_complete sqlite_busy_handler sqlite_busy_timeout sqlite_get_table sqlite_free_table sqlite_mprintf sqlite_vmprintf sqlite_exec_printf sqlite_exec_vprintf sqlite_get_table_printf sqlite_get_table_vprintf sqlite_freemem sqlite_libversion sqlite_libencoding sqlite_changes sqlite_create_function sqlite_create_aggregate sqlite_function_type sqlite_user_data sqlite_aggregate_context sqlite_aggregate_count sqlite_set_result_string sqlite_set_result_int sqlite_set_result_double sqlite_set_result_error sqliteMalloc sqliteFree sqliteRealloc sqlite_set_authorizer sqlite_trace sqlite_compile sqlite_step sqlite_finalize hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/hsql.pkg.in0000644006511100651110000000066510504340326021537 0ustar rossrossPackage {name = "hsql", auto=True, import_dirs = ["@GHC_DIR@/imports"], source_dirs = [], library_dirs = [@LIB_DIRS@], hs_libraries = ["HSsql"], extra_libraries = [@DEP_LIBS@], include_dirs = [], c_includes = [], package_deps = ["base"], extra_ghc_opts = [], extra_cc_opts = [], extra_ld_opts = [], framework_dirs = [], extra_frameworks = [] }hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/install-sh0000644006511100651110000001124310504340326021453 0ustar rossross#!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. # # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" tranformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" dir_arg="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -d) dir_arg=true shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; *) if [ x"$src" = x ] then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 else true fi if [ x"$dir_arg" != x ]; then dst=$src src="" if [ -d $dst ]; then instcmd=: else instcmd=mkdir fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if [ -f $src -o -d $src ] then true else echo "install: $src does not exist" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 else true fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` else true fi fi ## this sed command emulates the dirname command dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # this part is taken from Noah Friedman's mkinstalldirs script # Skip lots of stat calls in the usual case. if [ ! -d "$dstdir" ]; then defaultIFS=' ' IFS="${IFS-${defaultIFS}}" oIFS="${IFS}" # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` IFS="${oIFS}" pathcomp='' while [ $# -ne 0 ] ; do pathcomp="${pathcomp}${1}" shift if [ ! -d "${pathcomp}" ] ; then $mkdirprog "${pathcomp}" else true fi pathcomp="${pathcomp}/" done fi if [ x"$dir_arg" != x ] then $doit $instcmd $dst && if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi else # If we're going to rename the final executable, determine the name now. if [ x"$transformarg" = x ] then dstfile=`basename $dst` else dstfile=`basename $dst $transformbasename | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename if [ x"$dstfile" = x ] then dstfile=`basename $dst` else true fi # Make a temp file name in the proper directory. dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp && trap "rm -f ${dsttmp}" 0 && # and set any options; do chmod last to preserve setuid bits # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && # Now rename the file to the real destination. $doit $rmcmd -f $dstdir/$dstfile && $doit $mvcmd $dsttmp $dstdir/$dstfile fi && exit 0 hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/0000755006511100651110000000000010504340326020240 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL/0000755006511100651110000000000010504340326021007 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL/HsMySQL.h0000644006511100651110000000015610504340326022422 0ustar rossross#ifndef HsMySQL #define HsMySQL #if defined(_WIN32_) #include #endif #include #endif hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL/HsODBC.c0000644006511100651110000000051310504340326022154 0ustar rossross#include "HsODBC.h" #if defined(_WIN32_) // Under Windows SQLFreeEnv function has stdcall calling convention // while in Haskell functions represented with FunPtr must be always // with ccall convention. For that reason we need to redirect calling // to this function. void my_sqlFreeEnv(HENV hEnv) { SQLFreeEnv(hEnv); } #endif hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL/HsODBC.h0000644006511100651110000000072710504340326022170 0ustar rossross#ifndef HsODBC #define HsODBC #if defined(_WIN32_) #include #endif #include #include #define FIELD_NAME_LENGTH 255 typedef struct { HSTMT hSTMT; SQLUSMALLINT fieldsCount; SQLCHAR fieldName[FIELD_NAME_LENGTH]; SQLSMALLINT NameLength; SQLSMALLINT DataType; SQLULEN ColumnSize; SQLSMALLINT DecimalDigits; SQLSMALLINT Nullable; } FIELD; #if defined(_WIN32_) void my_sqlFreeEnv(HENV hEnv); #endif #endif hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL/MySQL.hsc0000644006511100651110000002150610504340326022457 0ustar rossross----------------------------------------------------------------------------------------- {-| Module : Database.HSQL.MySQL Copyright : (c) Krasimir Angelov 2003 License : BSD-style Maintainer : ka2_mail@yahoo.com Stability : provisional Portability : portable The module provides interface to MySQL database -} ----------------------------------------------------------------------------------------- #include module Database.HSQL.MySQL(connect, module Database.HSQL) where import Database.HSQL import Database.HSQL.Types import Data.Dynamic import Data.Bits import Data.Char import Foreign import Foreign.C import Control.Monad(when,unless) import Control.Exception (throwDyn, finally) import Control.Concurrent.MVar import System.Time import System.IO.Unsafe import Text.ParserCombinators.ReadP import Text.Read #include type MYSQL = Ptr () type MYSQL_RES = Ptr () type MYSQL_FIELD = Ptr () type MYSQL_ROW = Ptr CString type MYSQL_LENGTHS = Ptr CULong #if defined(_WIN32_) #let CALLCONV = "stdcall" #else #let CALLCONV = "ccall" #endif foreign import #{CALLCONV} "HsMySQL.h mysql_init" mysql_init :: MYSQL -> IO MYSQL foreign import #{CALLCONV} "HsMySQL.h mysql_real_connect" mysql_real_connect :: MYSQL -> CString -> CString -> CString -> CString -> Int -> CString -> Int -> IO MYSQL foreign import #{CALLCONV} "HsMySQL.h mysql_close" mysql_close :: MYSQL -> IO () foreign import #{CALLCONV} "HsMySQL.h mysql_errno" mysql_errno :: MYSQL -> IO Int foreign import #{CALLCONV} "HsMySQL.h mysql_error" mysql_error :: MYSQL -> IO CString foreign import #{CALLCONV} "HsMySQL.h mysql_query" mysql_query :: MYSQL -> CString -> IO Int foreign import #{CALLCONV} "HsMySQL.h mysql_use_result" mysql_use_result :: MYSQL -> IO MYSQL_RES foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_field" mysql_fetch_field :: MYSQL_RES -> IO MYSQL_FIELD foreign import #{CALLCONV} "HsMySQL.h mysql_free_result" mysql_free_result :: MYSQL_RES -> IO () foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_row" mysql_fetch_row :: MYSQL_RES -> IO MYSQL_ROW foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_lengths" mysql_fetch_lengths :: MYSQL_RES -> IO MYSQL_LENGTHS foreign import #{CALLCONV} "HsMySQL.h mysql_list_tables" mysql_list_tables :: MYSQL -> CString -> IO MYSQL_RES foreign import #{CALLCONV} "HsMySQL.h mysql_list_fields" mysql_list_fields :: MYSQL -> CString -> CString -> IO MYSQL_RES ----------------------------------------------------------------------------------------- -- routines for handling exceptions ----------------------------------------------------------------------------------------- handleSqlError :: MYSQL -> IO a handleSqlError pMYSQL = do errno <- mysql_errno pMYSQL errMsg <- mysql_error pMYSQL >>= peekCString throwDyn (SqlError "" errno errMsg) ----------------------------------------------------------------------------------------- -- Connect/Disconnect ----------------------------------------------------------------------------------------- -- | Makes a new connection to the database server. connect :: String -- ^ Server name -> String -- ^ Database name -> String -- ^ User identifier -> String -- ^ Authentication string (password) -> IO Connection connect server database user authentication = do pMYSQL <- mysql_init nullPtr pServer <- newCString server pDatabase <- newCString database pUser <- newCString user pAuthentication <- newCString authentication res <- mysql_real_connect pMYSQL pServer pUser pAuthentication pDatabase 0 nullPtr 0 free pServer free pDatabase free pUser free pAuthentication when (res == nullPtr) (handleSqlError pMYSQL) refFalse <- newMVar False let connection = Connection { connDisconnect = mysql_close pMYSQL , connExecute = execute pMYSQL , connQuery = query connection pMYSQL , connTables = tables connection pMYSQL , connDescribe = describe connection pMYSQL , connBeginTransaction = execute pMYSQL "begin" , connCommitTransaction = execute pMYSQL "commit" , connRollbackTransaction = execute pMYSQL "rollback" , connClosed = refFalse } return connection where execute :: MYSQL -> String -> IO () execute pMYSQL query = do res <- withCString query (mysql_query pMYSQL) when (res /= 0) (handleSqlError pMYSQL) withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement withStatement conn pMYSQL pRes = do currRow <- newMVar (nullPtr, nullPtr) refFalse <- newMVar False if (pRes == nullPtr) then do errno <- mysql_errno pMYSQL when (errno /= 0) (handleSqlError pMYSQL) return (Statement { stmtConn = conn , stmtClose = return () , stmtFetch = fetch pRes currRow , stmtGetCol = getColValue currRow , stmtFields = [] , stmtClosed = refFalse }) else do fieldDefs <- getFieldDefs pRes return (Statement { stmtConn = conn , stmtClose = mysql_free_result pRes , stmtFetch = fetch pRes currRow , stmtGetCol = getColValue currRow , stmtFields = fieldDefs , stmtClosed = refFalse }) where getFieldDefs pRes = do pField <- mysql_fetch_field pRes if pField == nullPtr then return [] else do name <- (#peek MYSQL_FIELD, name) pField >>= peekCString (dataType :: Int) <- (#peek MYSQL_FIELD, type) pField (columnSize :: Int) <- (#peek MYSQL_FIELD, length) pField (flags :: Int) <- (#peek MYSQL_FIELD, flags) pField (decimalDigits :: Int) <- (#peek MYSQL_FIELD, decimals) pField let sqlType = mkSqlType dataType columnSize decimalDigits defs <- getFieldDefs pRes return ((name,sqlType,(flags .&. (#const NOT_NULL_FLAG)) == 0):defs) mkSqlType :: Int -> Int -> Int -> SqlType mkSqlType (#const FIELD_TYPE_STRING) size _ = SqlChar size mkSqlType (#const FIELD_TYPE_VAR_STRING) size _ = SqlVarChar size mkSqlType (#const FIELD_TYPE_DECIMAL) size prec = SqlNumeric size prec mkSqlType (#const FIELD_TYPE_SHORT) _ _ = SqlSmallInt mkSqlType (#const FIELD_TYPE_INT24) _ _ = SqlMedInt mkSqlType (#const FIELD_TYPE_LONG) _ _ = SqlInteger mkSqlType (#const FIELD_TYPE_FLOAT) _ _ = SqlReal mkSqlType (#const FIELD_TYPE_DOUBLE) _ _ = SqlDouble mkSqlType (#const FIELD_TYPE_TINY) _ _ = SqlTinyInt mkSqlType (#const FIELD_TYPE_LONGLONG) _ _ = SqlBigInt mkSqlType (#const FIELD_TYPE_DATE) _ _ = SqlDate mkSqlType (#const FIELD_TYPE_TIME) _ _ = SqlTime mkSqlType (#const FIELD_TYPE_TIMESTAMP) _ _ = SqlTimeStamp mkSqlType (#const FIELD_TYPE_DATETIME) _ _ = SqlDateTime mkSqlType (#const FIELD_TYPE_YEAR) _ _ = SqlYear mkSqlType (#const FIELD_TYPE_BLOB) _ _ = SqlBLOB mkSqlType (#const FIELD_TYPE_SET) _ _ = SqlSET mkSqlType (#const FIELD_TYPE_ENUM) _ _ = SqlENUM mkSqlType tp _ _ = SqlUnknown tp query :: Connection -> MYSQL -> String -> IO Statement query conn pMYSQL query = do res <- withCString query (mysql_query pMYSQL) when (res /= 0) (handleSqlError pMYSQL) pRes <- mysql_use_result pMYSQL withStatement conn pMYSQL pRes fetch :: MYSQL_RES -> MVar (MYSQL_ROW, MYSQL_LENGTHS) -> IO Bool fetch pRes currRow | pRes == nullPtr = return False | otherwise = modifyMVar currRow $ \(pRow, pLengths) -> do pRow <- mysql_fetch_row pRes pLengths <- mysql_fetch_lengths pRes return ((pRow, pLengths), pRow /= nullPtr) getColValue :: MVar (MYSQL_ROW, MYSQL_LENGTHS) -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a) getColValue currRow colNumber (name,sqlType,nullable) f = do (row, lengths) <- readMVar currRow pValue <- peekElemOff row colNumber len <- fmap fromIntegral (peekElemOff lengths colNumber) if pValue == nullPtr then return Nothing else do mv <- f sqlType pValue len case mv of Just v -> return (Just v) Nothing -> throwDyn (SqlBadTypeCast name sqlType) tables :: Connection -> MYSQL -> IO [String] tables conn pMYSQL = do pRes <- mysql_list_tables pMYSQL nullPtr stmt <- withStatement conn pMYSQL pRes -- SQLTables returns: -- Column name # Type -- Tables_in_xx 0 VARCHAR collectRows (\stmt -> do mb_v <- stmtGetCol stmt 0 ("Tables", SqlVarChar 0, False) fromNonNullSqlCStringLen return (case mb_v of { Nothing -> ""; Just a -> a })) stmt describe :: Connection -> MYSQL -> String -> IO [FieldDef] describe conn pMYSQL table = do pRes <- withCString table (\table -> mysql_list_fields pMYSQL table nullPtr) stmt <- withStatement conn pMYSQL pRes return (getFieldsTypes stmt) hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL/ODBC.hsc0000644006511100651110000004253610504340326022227 0ustar rossross----------------------------------------------------------------------------------------- {-| Module : Database.HSQL.ODBC Copyright : (c) Krasimir Angelov 2003 License : BSD-style Maintainer : ka2_mail@yahoo.com Stability : provisional Portability : portable The module provides interface to ODBC -} ----------------------------------------------------------------------------------------- module Database.HSQL.ODBC(connect, driverConnect, module Database.HSQL) where import Database.HSQL import Database.HSQL.Types import Data.Word(Word32, Word16) import Data.Int(Int32, Int16) import Data.Maybe import Foreign import Foreign.C import Control.Monad(unless) import Control.Exception(throwDyn) import Control.Concurrent.MVar import System.IO.Unsafe import System.Time #include #include type SQLHANDLE = Ptr () type HENV = SQLHANDLE type HDBC = SQLHANDLE type HSTMT = SQLHANDLE type HENVRef = ForeignPtr () type SQLSMALLINT = #type SQLSMALLINT type SQLUSMALLINT = #type SQLUSMALLINT type SQLINTEGER = #type SQLINTEGER type SQLUINTEGER = #type SQLUINTEGER type SQLRETURN = SQLSMALLINT type SQLLEN = SQLINTEGER type SQLULEN = SQLINTEGER #if defined(_WIN32_) #let CALLCONV = "stdcall" #else #let CALLCONV = "ccall" #endif foreign import #{CALLCONV} "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN #if defined(_WIN32_) foreign import ccall "HsODBC.h &my_sqlFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ()) #else foreign import ccall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ()) #endif foreign import #{CALLCONV} "HsODBC.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLDriverConnect" sqlDriverConnect :: HDBC -> Ptr () -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> SQLUSMALLINT -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLTables" sqlTables :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN foreign import #{CALLCONV} "HsODBC.h SQLColumns" sqlColumns :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN ----------------------------------------------------------------------------------------- -- routines for handling exceptions ----------------------------------------------------------------------------------------- sqlSuccess :: SQLRETURN -> Bool sqlSuccess res = (res == (#const SQL_SUCCESS)) || (res == (#const SQL_SUCCESS_WITH_INFO)) || (res == (#const SQL_NO_DATA)) handleSqlResult :: SQLSMALLINT -> SQLHANDLE -> SQLRETURN -> IO () handleSqlResult handleType handle res | sqlSuccess res = return () | res == (#const SQL_INVALID_HANDLE) = throwDyn SqlInvalidHandle | res == (#const SQL_STILL_EXECUTING) = throwDyn SqlStillExecuting | res == (#const SQL_NEED_DATA) = throwDyn SqlNeedData | res == (#const SQL_ERROR) = allocaBytes 256 $ \pState -> alloca $ \pNative -> allocaBytes 256 $ \pMsg -> alloca $ \pTextLen -> do res <- sqlGetDiagRec handleType handle 1 pState pNative pMsg 256 pTextLen e <- if res == (#const SQL_NO_DATA) then return SqlNoData else do state <- peekCString pState native <- peek pNative msg <- peekCString pMsg return (SqlError {seState=state, seNativeError=fromIntegral native, seErrorMsg=msg}) throwDyn e | otherwise = error (show res) ----------------------------------------------------------------------------------------- -- keeper of HENV ----------------------------------------------------------------------------------------- {-# NOINLINE myEnvironment #-} myEnvironment :: HENVRef myEnvironment = unsafePerformIO $ alloca $ \ (phEnv :: Ptr HENV) -> do res <- sqlAllocEnv phEnv hEnv <- peek phEnv handleSqlResult 0 nullPtr res newForeignPtr sqlFreeEnv_p hEnv ----------------------------------------------------------------------------------------- -- Connect/Disconnect ----------------------------------------------------------------------------------------- -- | Makes a new connection to the ODBC data source connect :: String -- ^ Data source name -> String -- ^ User identifier -> String -- ^ Authentication string (password) -> IO Connection -- ^ the returned value represents the new connection connect server user authentication = connectHelper $ \hDBC -> withCString server $ \pServer -> withCString user $ \pUser -> withCString authentication $ \pAuthentication -> sqlConnect hDBC pServer (#const SQL_NTS) pUser (#const SQL_NTS) pAuthentication (#const SQL_NTS) -- | 'driverConnect' is an alternative to 'connect'. It supports data sources that -- require more connection information than the three arguments in 'connect' -- and data sources that are not defined in the system information. driverConnect :: String -- ^ Connection string -> IO Connection -- ^ the returned value represents the new connection driverConnect connString = connectHelper $ \hDBC -> withCString connString $ \pConnString -> allocaBytes 1024 $ \pOutConnString -> alloca $ \pLen -> sqlDriverConnect hDBC nullPtr pConnString (#const SQL_NTS) pOutConnString 1024 pLen (#const SQL_DRIVER_NOPROMPT) connectHelper :: (HDBC -> IO SQLRETURN) -> IO Connection connectHelper connectFunction = withForeignPtr myEnvironment $ \hEnv -> do hDBC <- alloca $ \ (phDBC :: Ptr HDBC) -> do res <- sqlAllocConnect hEnv phDBC handleSqlResult (#const SQL_HANDLE_ENV) hEnv res peek phDBC res <- connectFunction hDBC handleSqlResult (#const SQL_HANDLE_DBC) hDBC res refFalse <- newMVar False let connection = (Connection { connDisconnect = disconnect hDBC , connExecute = execute hDBC , connQuery = query connection hDBC , connTables = tables connection hDBC , connDescribe = describe connection hDBC , connBeginTransaction = beginTransaction myEnvironment hDBC , connCommitTransaction = commitTransaction myEnvironment hDBC , connRollbackTransaction = rollbackTransaction myEnvironment hDBC , connClosed = refFalse }) return connection where disconnect :: HDBC -> IO () disconnect hDBC = do sqlDisconnect hDBC >>= handleSqlResult (#const SQL_HANDLE_DBC) hDBC sqlFreeConnect hDBC >>= handleSqlResult (#const SQL_HANDLE_DBC) hDBC execute :: HDBC -> String -> IO () execute hDBC query = allocaBytes (#const sizeof(HSTMT)) $ \pStmt -> do res <- sqlAllocStmt hDBC pStmt handleSqlResult (#const SQL_HANDLE_DBC) hDBC res hSTMT <- peek pStmt withCStringLen query $ \(pQuery,len) -> do res <- sqlExecDirect hSTMT pQuery len handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res res <- sqlFreeStmt hSTMT (#const SQL_DROP) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res stmtBufferSize = 256 withStatement :: Connection -> HDBC -> (HSTMT -> IO SQLRETURN) -> IO Statement withStatement connection hDBC f = allocaBytes (#const sizeof(FIELD)) $ \pFIELD -> do res <- sqlAllocStmt hDBC ((#ptr FIELD, hSTMT) pFIELD) handleSqlResult (#const SQL_HANDLE_DBC) hDBC res hSTMT <- (#peek FIELD, hSTMT) pFIELD let handleResult res = handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res f hSTMT >>= handleResult sqlNumResultCols hSTMT ((#ptr FIELD, fieldsCount) pFIELD) >>= handleResult count <- (#peek FIELD, fieldsCount) pFIELD fields <- getFieldDefs hSTMT pFIELD 1 count buffer <- mallocBytes (fromIntegral stmtBufferSize) refFalse <- newMVar False let statement = Statement { stmtConn = connection , stmtClose = closeStatement hSTMT buffer , stmtFetch = fetch hSTMT , stmtGetCol = getColValue hSTMT buffer , stmtFields = fields , stmtClosed = refFalse } return statement where getFieldDefs :: HSTMT -> Ptr a -> SQLUSMALLINT -> SQLUSMALLINT -> IO [FieldDef] getFieldDefs hSTMT pFIELD n count | n > count = return [] | otherwise = do res <- sqlDescribeCol hSTMT n ((#ptr FIELD, fieldName) pFIELD) (#const FIELD_NAME_LENGTH) ((#ptr FIELD, NameLength) pFIELD) ((#ptr FIELD, DataType) pFIELD) ((#ptr FIELD, ColumnSize) pFIELD) ((#ptr FIELD, DecimalDigits) pFIELD) ((#ptr FIELD, Nullable) pFIELD) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res name <- peekCString ((#ptr FIELD, fieldName) pFIELD) dataType <- (#peek FIELD, DataType) pFIELD columnSize <- (#peek FIELD, ColumnSize) pFIELD decimalDigits <- (#peek FIELD, DecimalDigits) pFIELD (nullable :: SQLSMALLINT) <- (#peek FIELD, Nullable) pFIELD let sqlType = mkSqlType dataType columnSize decimalDigits fields <- getFieldDefs hSTMT pFIELD (n+1) count return ((name,sqlType,toBool nullable):fields) mkSqlType :: SQLSMALLINT -> SQLULEN -> SQLSMALLINT -> SqlType mkSqlType (#const SQL_CHAR) size _ = SqlChar (fromIntegral size) mkSqlType (#const SQL_VARCHAR) size _ = SqlVarChar (fromIntegral size) mkSqlType (#const SQL_LONGVARCHAR) size _ = SqlLongVarChar (fromIntegral size) mkSqlType (#const SQL_DECIMAL) size prec = SqlDecimal (fromIntegral size) (fromIntegral prec) mkSqlType (#const SQL_NUMERIC) size prec = SqlNumeric (fromIntegral size) (fromIntegral prec) mkSqlType (#const SQL_SMALLINT) _ _ = SqlSmallInt mkSqlType (#const SQL_INTEGER) _ _ = SqlInteger mkSqlType (#const SQL_REAL) _ _ = SqlReal -- From: http://msdn.microsoft.com/library/en-us/odbc/htm/odappdpr_2.asp -- "Depending on the implementation, the precision of SQL_FLOAT can be either 24 or 53: -- if it is 24, the SQL_FLOAT data type is the same as SQL_REAL; -- if it is 53, the SQL_FLOAT data type is the same as SQL_DOUBLE." mkSqlType (#const SQL_FLOAT) _ _ = SqlFloat mkSqlType (#const SQL_DOUBLE) _ _ = SqlDouble mkSqlType (#const SQL_BIT) _ _ = SqlBit mkSqlType (#const SQL_TINYINT) _ _ = SqlTinyInt mkSqlType (#const SQL_BIGINT) _ _ = SqlBigInt mkSqlType (#const SQL_BINARY) size _ = SqlBinary (fromIntegral size) mkSqlType (#const SQL_VARBINARY) size _ = SqlVarBinary (fromIntegral size) mkSqlType (#const SQL_LONGVARBINARY)size _ = SqlLongVarBinary (fromIntegral size) mkSqlType (#const SQL_DATE) _ _ = SqlDate mkSqlType (#const SQL_TIME) _ _ = SqlTime mkSqlType (#const SQL_TIMESTAMP) _ _ = SqlDateTime mkSqlType (#const SQL_WCHAR) size _ = SqlWChar (fromIntegral size) mkSqlType (#const SQL_WVARCHAR) size _ = SqlWVarChar (fromIntegral size) mkSqlType (#const SQL_WLONGVARCHAR) size _ = SqlWLongVarChar (fromIntegral size) mkSqlType tp _ _ = SqlUnknown (fromIntegral tp) query :: Connection -> HDBC -> String -> IO Statement query connection hDBC q = withStatement connection hDBC doQuery where doQuery hSTMT = withCStringLen q (uncurry (sqlExecDirect hSTMT)) beginTransaction myEnvironment hDBC = do sqlSetConnectOption hDBC (#const SQL_AUTOCOMMIT) (#const SQL_AUTOCOMMIT_OFF) return () commitTransaction myEnvironment hDBC = withForeignPtr myEnvironment $ \hEnv -> do sqlTransact hEnv hDBC (#const SQL_COMMIT) sqlSetConnectOption hDBC (#const SQL_AUTOCOMMIT) (#const SQL_AUTOCOMMIT_ON) return () rollbackTransaction myEnvironment hDBC = withForeignPtr myEnvironment $ \hEnv -> do sqlTransact hEnv hDBC (#const SQL_ROLLBACK) sqlSetConnectOption hDBC (#const SQL_AUTOCOMMIT) (#const SQL_AUTOCOMMIT_ON) return () tables :: Connection -> HDBC -> IO [String] tables connection hDBC = do stmt <- withStatement connection hDBC sqlTables' -- SQLTables returns (column names may vary): -- Column name # Type -- TABLE_NAME 3 VARCHAR collectRows (\s -> getFieldValue s 3 ("TABLE_NAME", SqlVarChar 0, False) "") stmt where sqlTables' hSTMT = sqlTables hSTMT nullPtr 0 nullPtr 0 nullPtr 0 nullPtr 0 describe :: Connection -> HDBC -> String -> IO [FieldDef] describe connection hDBC table = do stmt <- withStatement connection hDBC (sqlColumns' table) collectRows getColumnInfo stmt where sqlColumns' table hSTMT = withCStringLen table (\(pTable,len) -> sqlColumns hSTMT nullPtr 0 nullPtr 0 pTable (fromIntegral len) nullPtr 0) -- SQLColumns returns (column names may vary): -- Column name # Type -- COLUMN_NAME 4 Varchar not NULL -- DATA_TYPE 5 Smallint not NULL -- COLUMN_SIZE 7 Integer -- DECIMAL_DIGITS 9 Smallint -- NULLABLE 11 Smallint not NULL getColumnInfo stmt = do column_name <- getFieldValue stmt 4 ("COLUMN_NAME", SqlVarChar 0, False) "" (data_type::Int) <- getFieldValue stmt 5 ("DATA_TYPE", SqlSmallInt, False) 0 (column_size::Int) <- getFieldValue stmt 7 ("COLUMN_SIZE", SqlInteger, True) 0 (decimal_digits::Int) <- getFieldValue stmt 9 ("DECIMAL_DIGITS", SqlSmallInt, True) 0 (nullable::Int) <- getFieldValue stmt 11 ("NULLABLE", SqlSmallInt, False) 0 let sqlType = mkSqlType (fromIntegral data_type) (fromIntegral column_size) (fromIntegral decimal_digits) return (column_name, sqlType, toBool nullable) getFieldValue stmt colNumber fieldDef v = do mb_v <- stmtGetCol stmt (colNumber-1) fieldDef fromNonNullSqlCStringLen return (case mb_v of { Nothing -> v; Just a -> a }) fetch :: HSTMT -> IO Bool fetch hSTMT = do res <- sqlFetch hSTMT handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res return (res /= (#const SQL_NO_DATA)) getColValue :: HSTMT -> CString -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a) getColValue hSTMT buffer colNumber (name,sqlType,nullable) f = do (res,len_or_ind) <- getData buffer (fromIntegral stmtBufferSize) if len_or_ind == (#const SQL_NULL_DATA) then return Nothing else do mb_value <- (if res == (#const SQL_SUCCESS_WITH_INFO) then getLongData len_or_ind else f sqlType buffer (fromIntegral len_or_ind)) case mb_value of Just value -> return (Just value) Nothing -> throwDyn (SqlBadTypeCast name sqlType) where getData :: CString -> SQLINTEGER -> IO (SQLRETURN, SQLINTEGER) getData buffer size = alloca $ \lenP -> do res <- sqlGetData hSTMT (fromIntegral colNumber+1) (#const SQL_C_CHAR) (castPtr buffer) size lenP handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res len_or_ind <- peek lenP return (res, len_or_ind) -- gets called only when there is more data than would -- fit in the normal buffer. This call to -- SQLGetData() will fetch the rest of the data. -- We create a new buffer big enough to hold the -- old and the new data, copy the old data into -- it and put the new data in buffer after the old. getLongData len = allocaBytes (fromIntegral newBufSize) $ \newBuf -> do copyBytes newBuf buffer stmtBufferSize -- The last byte of the old data with always be null, -- so it is overwritten with the first byte of the new data. let newDataStart = newBuf `plusPtr` (stmtBufferSize - 1) newDataLen = newBufSize - (fromIntegral stmtBufferSize - 1) (res,_) <- getData newDataStart newDataLen f sqlType newBuf (fromIntegral newBufSize-1) where newBufSize = len+1 -- to allow for terminating null character closeStatement :: HSTMT -> CString -> IO () closeStatement hSTMT buffer = do free buffer sqlFreeStmt hSTMT (#const SQL_DROP) >>= handleSqlResult (#const SQL_HANDLE_STMT) hSTMT hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL/SQLite.hsc0000644006511100651110000001277110504340326022657 0ustar rossross----------------------------------------------------------------------------------------- {-| Module : Database.HSQL.SQLite Copyright : (c) Krasimir Angelov 2003 License : BSD-style Maintainer : ka2_mail@yahoo.com Stability : provisional Portability : portable The module provides interface to SQLite -} ----------------------------------------------------------------------------------------- module Database.HSQL.SQLite(connect, module Database.HSQL) where import Database.HSQL import Database.HSQL.Types import Foreign import Foreign.C import System.IO import Control.Monad(when) import Control.Exception(throwDyn) import Control.Concurrent.MVar #include #include type SQLite = Ptr () foreign import ccall sqlite_open :: CString -> Int -> Ptr CString -> IO SQLite foreign import ccall sqlite_close :: SQLite -> IO () foreign import ccall sqlite_exec :: SQLite -> CString -> FunPtr () -> Ptr () -> Ptr CString -> IO Int foreign import ccall sqlite_get_table :: SQLite -> CString -> Ptr (Ptr CString) -> Ptr Int -> Ptr Int -> Ptr CString -> IO Int foreign import ccall sqlite_free_table :: Ptr CString -> IO () foreign import ccall sqlite_freemem :: CString -> IO () foreign import ccall "strlen" strlen :: CString -> IO Int ----------------------------------------------------------------------------------------- -- routines for handling exceptions ----------------------------------------------------------------------------------------- handleSqlResult :: Int -> Ptr CString -> IO () handleSqlResult res ppMsg | res == (#const SQLITE_OK) = return () | otherwise = do pMsg <- peek ppMsg msg <- peekCString pMsg sqlite_freemem pMsg throwDyn (SqlError "E" res msg) ----------------------------------------------------------------------------------------- -- Connect ----------------------------------------------------------------------------------------- connect :: FilePath -> IOMode -> IO Connection connect fpath mode = alloca $ \ppMsg -> withCString fpath $ \pFPath -> do sqlite <- sqlite_open pFPath 0 ppMsg when (sqlite == nullPtr) $ do pMsg <- peek ppMsg msg <- peekCString pMsg free pMsg throwDyn (SqlError { seState = "C" , seNativeError = 0 , seErrorMsg = msg }) refFalse <- newMVar False let connection = Connection { connDisconnect = sqlite_close sqlite , connClosed = refFalse , connExecute = execute sqlite , connQuery = query connection sqlite , connTables = tables connection sqlite , connDescribe = describe connection sqlite , connBeginTransaction = execute sqlite "BEGIN TRANSACTION" , connCommitTransaction = execute sqlite "COMMIT TRANSACTION" , connRollbackTransaction = execute sqlite "ROLLBACK TRANSACTION" } return connection where oflags1 = case mode of ReadMode -> (#const O_RDONLY) WriteMode -> (#const O_WRONLY) ReadWriteMode -> (#const O_RDWR) AppendMode -> (#const O_APPEND) execute :: SQLite -> String -> IO () execute sqlite query = withCString query $ \pQuery -> do alloca $ \ppMsg -> do res <- sqlite_exec sqlite pQuery nullFunPtr nullPtr ppMsg handleSqlResult res ppMsg query :: Connection -> SQLite -> String -> IO Statement query connection sqlite query = do withCString query $ \pQuery -> do alloca $ \ppResult -> do alloca $ \pnRow -> do alloca $ \pnColumn -> do alloca $ \ppMsg -> do res <- sqlite_get_table sqlite pQuery ppResult pnRow pnColumn ppMsg handleSqlResult res ppMsg pResult <- peek ppResult rows <- peek pnRow columns <- peek pnColumn defs <- getFieldDefs pResult 0 columns refFalse <- newMVar False refIndex <- newMVar 0 return (Statement { stmtConn = connection , stmtClose = sqlite_free_table pResult , stmtFetch = fetch refIndex rows , stmtGetCol = getColValue pResult refIndex columns rows , stmtFields = defs , stmtClosed = refFalse }) where getFieldDefs :: Ptr CString -> Int -> Int -> IO [FieldDef] getFieldDefs pResult index count | index >= count = return [] | otherwise = do name <- peekElemOff pResult index >>= peekCString defs <- getFieldDefs pResult (index+1) count return ((name,SqlText,True):defs) tables :: Connection -> SQLite -> IO [String] tables connection sqlite = do stmt <- query connection sqlite "select tbl_name from sqlite_master" collectRows (\stmt -> getFieldValue stmt "tbl_name") stmt describe :: Connection -> SQLite -> String -> IO [FieldDef] describe connection sqlite table = do stmt <- query connection sqlite ("pragma table_info("++table++")") collectRows getRow stmt where getRow stmt = do name <- getFieldValue stmt "name" notnull <- getFieldValue stmt "notnull" return (name, SqlText, notnull=="0") fetch tupleIndex countTuples = modifyMVar tupleIndex (\index -> return (index+1,index < countTuples)) getColValue pResult refIndex columns rows colNumber (name,sqlType,nullable) f = do index <- readMVar refIndex when (index > rows) (throwDyn SqlNoData) pStr <- peekElemOff pResult (columns*index+colNumber) if pStr == nullPtr then return Nothing else do strLen <- strlen pStr mb_value <- f sqlType pStr strLen case mb_value of Just v -> return (Just v) Nothing -> throwDyn (SqlBadTypeCast name sqlType) hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL/PostgreSQL.hsc0000644006511100651110000002355310504340326023521 0ustar rossross----------------------------------------------------------------------------------------- {-| Module : Database.HSQL.PostgreSQL Copyright : (c) Krasimir Angelov 2003 License : BSD-style Maintainer : ka2_mail@yahoo.com Stability : provisional Portability : portable The module provides interface to PostgreSQL database -} ----------------------------------------------------------------------------------------- module Database.HSQL.PostgreSQL(connect, module Database.HSQL) where import Database.HSQL import Database.HSQL.Types import Data.Dynamic import Data.Char import Foreign import Foreign.C import Control.Exception (throwDyn, catchDyn, dynExceptions, Exception(..)) import Control.Monad(when,unless,mplus) import Control.Concurrent.MVar import System.Time import System.IO.Unsafe import Text.ParserCombinators.ReadP import Text.Read import Numeric # include #include #include #include type PGconn = Ptr () type PGresult = Ptr () type ConnStatusType = #type ConnStatusType type ExecStatusType = #type ExecStatusType type Oid = #type Oid foreign import ccall "libpq-fe.h PQsetdbLogin" pqSetdbLogin :: CString -> CString -> CString -> CString -> CString -> CString -> CString -> IO PGconn foreign import ccall "libpq-fe.h PQstatus" pqStatus :: PGconn -> IO ConnStatusType foreign import ccall "libpq-fe.h PQerrorMessage" pqErrorMessage :: PGconn -> IO CString foreign import ccall "libpq-fe.h PQfinish" pqFinish :: PGconn -> IO () foreign import ccall "libpq-fe.h PQexec" pqExec :: PGconn -> CString -> IO PGresult foreign import ccall "libpq-fe.h PQresultStatus" pqResultStatus :: PGresult -> IO ExecStatusType foreign import ccall "libpq-fe.h PQresStatus" pqResStatus :: ExecStatusType -> IO CString foreign import ccall "libpq-fe.h PQresultErrorMessage" pqResultErrorMessage :: PGresult -> IO CString foreign import ccall "libpq-fe.h PQnfields" pgNFields :: PGresult -> IO Int foreign import ccall "libpq-fe.h PQntuples" pqNTuples :: PGresult -> IO Int foreign import ccall "libpq-fe.h PQfname" pgFName :: PGresult -> Int -> IO CString foreign import ccall "libpq-fe.h PQftype" pqFType :: PGresult -> Int -> IO Oid foreign import ccall "libpq-fe.h PQfmod" pqFMod :: PGresult -> Int -> IO Int foreign import ccall "libpq-fe.h PQfnumber" pqFNumber :: PGresult -> CString -> IO Int foreign import ccall "libpq-fe.h PQgetvalue" pqGetvalue :: PGresult -> Int -> Int -> IO CString foreign import ccall "libpq-fe.h PQgetisnull" pqGetisnull :: PGresult -> Int -> Int -> IO Int foreign import ccall "strlen" strlen :: CString -> IO Int ----------------------------------------------------------------------------------------- -- Connect/Disconnect ----------------------------------------------------------------------------------------- -- | Makes a new connection to the database server. connect :: String -- ^ Server name -> String -- ^ Database name -> String -- ^ User identifier -> String -- ^ Authentication string (password) -> IO Connection connect server database user authentication = do pServer <- newCString server pDatabase <- newCString database pUser <- newCString user pAuthentication <- newCString authentication pConn <- pqSetdbLogin pServer nullPtr nullPtr nullPtr pDatabase pUser pAuthentication free pServer free pUser free pAuthentication status <- pqStatus pConn unless (status == (#const CONNECTION_OK)) (do errMsg <- pqErrorMessage pConn >>= peekCString pqFinish pConn throwDyn (SqlError {seState="C", seNativeError=fromIntegral status, seErrorMsg=errMsg})) refFalse <- newMVar False let connection = Connection { connDisconnect = pqFinish pConn , connExecute = execute pConn , connQuery = query connection pConn , connTables = tables connection pConn , connDescribe = describe connection pConn , connBeginTransaction = execute pConn "begin" , connCommitTransaction = execute pConn "commit" , connRollbackTransaction = execute pConn "rollback" , connClosed = refFalse } return connection where execute :: PGconn -> String -> IO () execute pConn sqlExpr = do pRes <- withCString sqlExpr (pqExec pConn) when (pRes==nullPtr) (do errMsg <- pqErrorMessage pConn >>= peekCString throwDyn (SqlError {seState="E", seNativeError=(#const PGRES_FATAL_ERROR), seErrorMsg=errMsg})) status <- pqResultStatus pRes unless (status == (#const PGRES_COMMAND_OK) || status == (#const PGRES_TUPLES_OK)) (do errMsg <- pqResultErrorMessage pRes >>= peekCString throwDyn (SqlError {seState="E", seNativeError=fromIntegral status, seErrorMsg=errMsg})) return () query :: Connection -> PGconn -> String -> IO Statement query conn pConn query = do pRes <- withCString query (pqExec pConn) when (pRes==nullPtr) (do errMsg <- pqErrorMessage pConn >>= peekCString throwDyn (SqlError {seState="E", seNativeError=(#const PGRES_FATAL_ERROR), seErrorMsg=errMsg})) status <- pqResultStatus pRes unless (status == (#const PGRES_COMMAND_OK) || status == (#const PGRES_TUPLES_OK)) (do errMsg <- pqResultErrorMessage pRes >>= peekCString throwDyn (SqlError {seState="E", seNativeError=fromIntegral status, seErrorMsg=errMsg})) defs <- if status == (#const PGRES_TUPLES_OK) then pgNFields pRes >>= getFieldDefs pRes 0 else return [] countTuples <- pqNTuples pRes; tupleIndex <- newMVar (-1) refFalse <- newMVar False return (Statement { stmtConn = conn , stmtClose = return () , stmtFetch = fetch tupleIndex countTuples , stmtGetCol = getColValue pRes tupleIndex countTuples , stmtFields = defs , stmtClosed = refFalse }) where getFieldDefs pRes i n | i >= n = return [] | otherwise = do name <- pgFName pRes i >>= peekCString dataType <- pqFType pRes i modifier <- pqFMod pRes i defs <- getFieldDefs pRes (i+1) n return ((name,mkSqlType dataType modifier,True):defs) mkSqlType :: Oid -> Int -> SqlType mkSqlType (#const BPCHAROID) size = SqlChar (size-4) mkSqlType (#const VARCHAROID) size = SqlVarChar (size-4) mkSqlType (#const NAMEOID) size = SqlVarChar 31 mkSqlType (#const TEXTOID) size = SqlText mkSqlType (#const NUMERICOID) size = SqlNumeric ((size-4) `div` 0x10000) ((size-4) `mod` 0x10000) mkSqlType (#const INT2OID) size = SqlSmallInt mkSqlType (#const INT4OID) size = SqlInteger mkSqlType (#const FLOAT4OID) size = SqlReal mkSqlType (#const FLOAT8OID) size = SqlDouble mkSqlType (#const BOOLOID) size = SqlBit mkSqlType (#const BITOID) size = SqlBinary size mkSqlType (#const VARBITOID) size = SqlVarBinary size mkSqlType (#const BYTEAOID) size = SqlTinyInt mkSqlType (#const INT8OID) size = SqlBigInt mkSqlType (#const DATEOID) size = SqlDate mkSqlType (#const TIMEOID) size = SqlTime mkSqlType (#const TIMETZOID) size = SqlTimeTZ mkSqlType (#const ABSTIMEOID) size = SqlAbsTime mkSqlType (#const RELTIMEOID) size = SqlRelTime mkSqlType (#const INTERVALOID) size = SqlTimeInterval mkSqlType (#const TINTERVALOID) size = SqlAbsTimeInterval mkSqlType (#const TIMESTAMPOID) size = SqlDateTime mkSqlType (#const TIMESTAMPTZOID) size = SqlDateTimeTZ mkSqlType (#const CASHOID) size = SqlMoney mkSqlType (#const INETOID) size = SqlINetAddr mkSqlType (#const 829) size = SqlMacAddr -- hack mkSqlType (#const CIDROID) size = SqlCIDRAddr mkSqlType (#const POINTOID) size = SqlPoint mkSqlType (#const LSEGOID) size = SqlLSeg mkSqlType (#const PATHOID) size = SqlPath mkSqlType (#const BOXOID) size = SqlBox mkSqlType (#const POLYGONOID) size = SqlPolygon mkSqlType (#const LINEOID) size = SqlLine mkSqlType (#const CIRCLEOID) size = SqlCircle mkSqlType tp size = SqlUnknown (fromIntegral tp) getFieldValue stmt colNumber fieldDef v = do mb_v <- stmtGetCol stmt colNumber fieldDef fromNonNullSqlCStringLen return (case mb_v of { Nothing -> v; Just a -> a }) tables :: Connection -> PGconn -> IO [String] tables connection pConn = do stmt <- query connection pConn "select relname from pg_class where relkind='r' and relname !~ '^pg_'" collectRows (\s -> getFieldValue s 0 ("relname", SqlVarChar 0, False) "") stmt describe :: Connection -> PGconn -> String -> IO [FieldDef] describe connection pConn table = do stmt <- query connection pConn ("select attname, atttypid, atttypmod, attnotnull " ++ "from pg_attribute as cols join pg_class as ts on cols.attrelid=ts.oid " ++ "where cols.attnum > 0 and ts.relname='"++table++"'") collectRows getColumnInfo stmt where getColumnInfo stmt = do column_name <- getFieldValue stmt 0 ("attname", SqlVarChar 0, False) "" (data_type::Int) <- getFieldValue stmt 1 ("atttypid", SqlInteger, False) 0 (type_mod::Int) <- getFieldValue stmt 2 ("atttypmod", SqlInteger, False) 0 (notnull::Bool) <- getFieldValue stmt 3 ("attnotnull", SqlBit, False) False let sqlType = mkSqlType (fromIntegral data_type) (fromIntegral type_mod) return (column_name, sqlType, not notnull) fetch :: MVar Int -> Int -> IO Bool fetch tupleIndex countTuples = modifyMVar tupleIndex (\index -> return (index+1,index < countTuples-1)) getColValue :: PGresult -> MVar Int -> Int -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a) getColValue pRes tupleIndex countTuples colNumber (name,sqlType,nullable) f = do index <- readMVar tupleIndex when (index >= countTuples) (throwDyn SqlNoData) isnull <- pqGetisnull pRes index colNumber if isnull == 1 then return Nothing else do pStr <- pqGetvalue pRes index colNumber strLen <- strlen pStr mb_value <- f sqlType pStr strLen case mb_value of Just v -> return (Just v) Nothing -> throwDyn (SqlBadTypeCast name sqlType) hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL/Types.hs0000644006511100651110000001372610504340326022460 0ustar rossross-- #hide module Database.HSQL.Types where import Control.Concurrent.MVar import Data.Dynamic import Foreign.C type FieldDef = (String, SqlType, Bool) data SqlType = SqlChar Int -- ODBC, MySQL, PostgreSQL | SqlVarChar Int -- ODBC, MySQL, PostgreSQL | SqlLongVarChar Int -- ODBC | SqlText -- , , PostgreSQL | SqlWChar Int -- ODBC | SqlWVarChar Int -- ODBC | SqlWLongVarChar Int -- ODBC | SqlDecimal Int Int -- ODBC | SqlNumeric Int Int -- ODBC, MySQL, PostgreSQL | SqlSmallInt -- ODBC, MySQL, PostgreSQL | SqlMedInt -- , MySQL | SqlInteger -- ODBC, MySQL, PostgreSQL | SqlReal -- ODBC, MySQL, PostgreSQL | SqlFloat -- ODBC | SqlDouble -- ODBC, MySQL, PostgreSQL | SqlBit -- ODBC, , PostgreSQL | SqlTinyInt -- ODBC, MySQL, PostgreSQL | SqlBigInt -- ODBC, MySQL, PostgreSQL | SqlBinary Int -- ODBC, , PostgreSQL | SqlVarBinary Int -- ODBC, , PostgreSQL | SqlLongVarBinary Int -- ODBC | SqlDate -- ODBC, MySQL, PostgreSQL | SqlTime -- ODBC, MySQL, PostgreSQL | SqlTimeTZ -- , , PostgreSQL | SqlAbsTime -- , , PostgreSQL | SqlRelTime -- , , PostgreSQL | SqlTimeInterval -- , , PostgreSQL | SqlAbsTimeInterval -- , , PostgreSQL | SqlTimeStamp -- ODBC, MySQL | SqlDateTime -- , MySQL | SqlDateTimeTZ -- , MySQL, PostgreSQL | SqlYear -- , MySQL | SqlSET -- , MySQL | SqlENUM -- , MySQL | SqlBLOB -- , MySQL | SqlMoney -- , , PostgreSQL | SqlINetAddr -- , , PostgreSQL | SqlCIDRAddr -- , , PostgreSQL | SqlMacAddr -- , , PostgreSQL | SqlPoint -- , , PostgreSQL | SqlLSeg -- , , PostgreSQL | SqlPath -- , , PostgreSQL | SqlBox -- , , PostgreSQL | SqlPolygon -- , , PostgreSQL | SqlLine -- , , PostgreSQL | SqlCircle -- , , PostgreSQL | SqlUnknown Int -- ^ HSQL returns @SqlUnknown tp@ for all -- columns for which it cannot determine -- the right type. The @tp@ here is the -- internal type code returned from the -- backend library deriving (Eq, Show) data SqlError = SqlError { seState :: String , seNativeError :: Int , seErrorMsg :: String } | SqlNoData | SqlInvalidHandle | SqlStillExecuting | SqlNeedData | SqlBadTypeCast { seFieldName :: String , seFieldType :: SqlType } | SqlFetchNull { seFieldName :: String } | SqlUnknownField { seFieldName :: String } | SqlUnsupportedOperation | SqlClosedHandle sqlErrorTc :: TyCon sqlErrorTc = mkTyCon "Database.HSQL.SqlError" instance Typeable SqlError where typeOf _ = mkAppTy sqlErrorTc [] instance Show SqlError where showsPrec _ (SqlError{seErrorMsg=msg}) = showString msg showsPrec _ SqlNoData = showString "No data" showsPrec _ SqlInvalidHandle = showString "Invalid handle" showsPrec _ SqlStillExecuting = showString "Stlll executing" showsPrec _ SqlNeedData = showString "Need data" showsPrec _ (SqlBadTypeCast name tp) = showString ("The type of " ++ name ++ " field can't be converted to " ++ show tp ++ " type") showsPrec _ (SqlFetchNull name) = showString ("The value of " ++ name ++ " field is null") showsPrec _ (SqlUnknownField name) = showString ("Unknown field name: " ++ name) showsPrec _ SqlUnsupportedOperation = showString "Unsupported operation" showsPrec _ SqlClosedHandle = showString "The referenced handle is already closed" -- | A 'Connection' type represents a connection to a database, through which you can operate on the it. -- In order to create the connection you need to use the @connect@ function from the module for -- your prefered backend. data Connection = Connection { connDisconnect :: IO () , connExecute :: String -> IO () , connQuery :: String -> IO Statement , connTables :: IO [String] , connDescribe :: String -> IO [FieldDef] , connBeginTransaction :: IO () , connCommitTransaction :: IO () , connRollbackTransaction :: IO () , connClosed :: MVar Bool } -- | The 'Statement' type represents a result from the execution of given SQL query. data Statement = Statement { stmtConn :: Connection , stmtClose :: IO () , stmtFetch :: IO Bool , stmtGetCol :: forall a . Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a) , stmtFields :: [FieldDef] , stmtClosed :: MVar Bool } class SqlBind a where -- This allows for faster conversion for eq. integral numeric types, etc. -- Default version uses fromSqlValue. fromNonNullSqlCStringLen :: SqlType -> CString -> Int -> IO (Maybe a) fromNonNullSqlCStringLen sqlType cstr cstrLen = do str <- peekCStringLen (cstr, cstrLen) return (fromSqlValue sqlType str) fromSqlValue :: SqlType -> String -> Maybe a toSqlValue :: a -> String hugs98-plus-Sep2006/packages/Cabal/tests/HSQL/src/HSQL.hsc0000644006511100651110000005134510504340326021516 0ustar rossross----------------------------------------------------------------------------------------- {-| Module : Database.HSQL.ODBC Copyright : (c) Krasimir Angelov 2003 License : BSD-style Maintainer : ka2_mail@yahoo.com Stability : provisional Portability : portable The module provides an abstract database interface -} ----------------------------------------------------------------------------------------- module Database.HSQL ( -- * Connect\/Disconnect Connection , disconnect -- :: Connection -> IO () -- * Command Execution Functions -- | Once a connection to a database has been successfully established, -- the functions described here are used to perform SQL queries and commands. , execute -- :: Connection -> String -> IO () , Statement , query -- :: Connection -> String -> IO Statement , closeStatement -- :: Statement -> IO () , fetch -- :: Statement -> IO Bool -- * Retrieving Statement values and types , FieldDef, SqlType(..), SqlBind, toSqlValue , getFieldValueMB -- :: SqlBind a => Statement -> String -> IO (Maybe a) , getFieldValue -- :: SqlBind a => Statement -> String -> IO a , getFieldValue' -- :: SqlBind a => Statement -> String -> a -> IO a , getFieldValueType -- :: Statement -> String -> (SqlType, Bool) , getFieldsTypes -- :: Statement -> [(String, SqlType, Bool)] -- * Transactions , inTransaction -- :: Connection -> (Connection -> IO a) -> IO a -- * SQL Exceptions handling , SqlError(..) , catchSql -- :: IO a -> (SqlError -> IO a) -> IO a , handleSql -- :: (SqlError -> IO a) -> IO a -> IO a , sqlExceptions -- :: Exception -> Maybe SqlError -- * Utilities , forEachRow -- :: (Statement -> s -> IO s) -- ^ an action , forEachRow' -- :: (Statement -> IO ()) -> Statement -> IO () , collectRows -- :: (Statement -> IO a) -> Statement -> IO [a] -- * Metadata , tables -- :: Connection -> IO [String] , describe -- :: Connection -> String -> IO [FieldDef] -- * Extra types , Point(..), Line(..), Path(..), Box(..), Circle(..), Polygon(..) ) where import Prelude hiding (catch) import Foreign import Foreign.C import Data.Int import Data.Char import Data.Dynamic import System.Time import System.IO.Unsafe(unsafePerformIO) import Control.Monad(when,unless,mplus) import Control.Exception (throwDyn, catchDyn, dynExceptions, Exception(..), finally, catch, throwIO) import Control.Concurrent.MVar import Text.ParserCombinators.ReadP import Text.Read import Text.Read.Lex import Numeric import Database.HSQL.Types #include ----------------------------------------------------------------------------------------- -- routines for exception handling ----------------------------------------------------------------------------------------- catchSql :: IO a -> (SqlError -> IO a) -> IO a catchSql = catchDyn handleSql :: (SqlError -> IO a) -> IO a -> IO a handleSql h f = catchDyn f h sqlExceptions :: Exception -> Maybe SqlError sqlExceptions e = dynExceptions e >>= fromDynamic checkHandle :: MVar Bool -> IO a -> IO a checkHandle ref action = withMVar ref (\closed -> when closed (throwDyn SqlClosedHandle) >> action) closeHandle :: MVar Bool -> IO () -> IO () closeHandle ref action = modifyMVar_ ref (\closed -> unless closed action >> return True) ----------------------------------------------------------------------------------------- -- Operations on the connection ----------------------------------------------------------------------------------------- -- | Closes the connection. Performing 'disconnect' on a connection that has already been -- closed has no effect. All other operations on a closed connection will fail. disconnect :: Connection -> IO () disconnect conn = closeHandle (connClosed conn) (connDisconnect conn) -- | Submits a command to the database. execute :: Connection -- ^ the database connection -> String -- ^ the text of SQL command -> IO () execute conn query = checkHandle (connClosed conn) (connExecute conn query) -- | Executes a query and returns a result set query :: Connection -- ^ the database connection -> String -- ^ the text of SQL query -> IO Statement -- ^ the associated statement. Must be closed with -- the 'closeStatement' function query conn query = checkHandle (connClosed conn) (connQuery conn query) -- | List all tables in the database. tables :: Connection -- ^ Database connection -> IO [String] -- ^ The names of all tables in the database. tables conn = checkHandle (connClosed conn) (connTables conn) -- | List all columns in a table along with their types and @nullable@ flags describe :: Connection -- ^ Database connection -> String -- ^ Name of a database table -> IO [FieldDef] -- ^ The list of fields in the table describe conn table = checkHandle (connClosed conn) (connDescribe conn table) ----------------------------------------------------------------------------------------- -- transactions ----------------------------------------------------------------------------------------- -- | The 'inTransaction' function executes the specified action in transaction mode. -- If the action completes successfully then the transaction will be commited. -- If the action completes with an exception then the transaction will be rolled back -- and the exception will be throw again. inTransaction :: Connection -> (Connection -> IO a) -- ^ an action -> IO a -- ^ the returned value is the result returned from action inTransaction conn action = do checkHandle (connClosed conn) (connBeginTransaction conn) r <- catch (action conn) (\err -> do checkHandle (connClosed conn) (connRollbackTransaction conn) throwIO err) checkHandle (connClosed conn) (connCommitTransaction conn) return r ----------------------------------------------------------------------------------------- -- Operations on the statements ----------------------------------------------------------------------------------------- -- | 'fetch' fetches the next rowset of data from the result set. -- The values from columns can be retrieved with 'getFieldValue' function. fetch :: Statement -> IO Bool fetch stmt = checkHandle (stmtClosed stmt) (stmtFetch stmt) -- | 'closeStatement' stops processing associated with a specific statement, closes any open cursors -- associated with the statement, discards pending results, and frees all resources associated with -- the statement. Performing 'closeStatement' on a statement that has already been -- closed has no effect. All other operations on a closed statement will fail. closeStatement :: Statement -> IO () closeStatement stmt = closeHandle (stmtClosed stmt) (stmtClose stmt) -- | Returns the type and the @nullable@ flag for field with specified name getFieldValueType :: Statement -> String -> (SqlType, Bool) getFieldValueType stmt name = (sqlType, nullable) where (sqlType,nullable,colNumber) = findFieldInfo name (stmtFields stmt) 0 -- | Returns the list of fields with their types and @nullable@ flags getFieldsTypes :: Statement -> [(String, SqlType, Bool)] getFieldsTypes stmt = stmtFields stmt findFieldInfo :: String -> [FieldDef] -> Int -> (SqlType,Bool,Int) findFieldInfo name [] colNumber = throwDyn (SqlUnknownField name) findFieldInfo name (fieldDef@(name',sqlType,nullable):fields) colNumber | name == name' = (sqlType,nullable,colNumber) | otherwise = findFieldInfo name fields $! (colNumber+1) ----------------------------------------------------------------------------------------- -- binding ----------------------------------------------------------------------------------------- foreign import ccall "stdlib.h atoi" c_atoi :: CString -> IO Int #ifdef WIN32 foreign import ccall "stdlib.h _atoi64" c_atoi64 :: CString -> IO Int64 #else foreign import ccall "stdlib.h strtoll" c_strtoll :: CString -> Ptr CString -> Int -> IO Int64 #endif instance SqlBind Int where fromNonNullSqlCStringLen sqlType cstr cstrLen = do if sqlType==SqlInteger || sqlType==SqlMedInt || sqlType==SqlTinyInt || sqlType==SqlSmallInt || sqlType==SqlBigInt then do val <- c_atoi cstr return (Just val) else return Nothing fromSqlValue SqlInteger s = Just (read s) fromSqlValue SqlMedInt s = Just (read s) fromSqlValue SqlTinyInt s = Just (read s) fromSqlValue SqlSmallInt s = Just (read s) fromSqlValue SqlBigInt s = Just (read s) fromSqlValue _ _ = Nothing toSqlValue s = show s instance SqlBind Int64 where fromNonNullSqlCStringLen sqlType cstr cstrLen = do if sqlType==SqlInteger || sqlType==SqlMedInt || sqlType==SqlTinyInt || sqlType==SqlSmallInt || sqlType==SqlBigInt then do #ifdef WIN32 val <- c_atoi64 cstr #else val <- c_strtoll cstr nullPtr 10 #endif return (Just val) else return Nothing fromSqlValue SqlInteger s = Just (read s) fromSqlValue SqlMedInt s = Just (read s) fromSqlValue SqlTinyInt s = Just (read s) fromSqlValue SqlSmallInt s = Just (read s) fromSqlValue SqlBigInt s = Just (read s) fromSqlValue _ s = Nothing toSqlValue val = show val instance SqlBind Integer where fromSqlValue SqlInteger s = Just (read s) fromSqlValue SqlMedInt s = Just (read s) fromSqlValue SqlTinyInt s = Just (read s) fromSqlValue SqlSmallInt s = Just (read s) fromSqlValue SqlBigInt s = Just (read s) fromSqlValue _ _ = Nothing toSqlValue s = show s instance SqlBind String where fromSqlValue _ = Just toSqlValue s = '\'' : foldr mapChar "'" s where mapChar '\\' s = '\\':'\\':s mapChar '\'' s = '\\':'\'':s mapChar '\n' s = '\\':'n' :s mapChar '\r' s = '\\':'r' :s mapChar '\t' s = '\\':'t' :s mapChar '\NUL' s = '\\':'0' :s mapChar c s = c :s instance SqlBind Bool where fromSqlValue SqlBit s = Just (s == "t") fromSqlValue _ _ = Nothing toSqlValue True = "'t'" toSqlValue False = "'f'" instance SqlBind Double where fromSqlValue (SqlDecimal _ _) s = Just (read s) fromSqlValue (SqlNumeric _ _) s = Just (read s) fromSqlValue SqlDouble s = Just (read s) fromSqlValue SqlReal s = Just (read s) fromSqlValue SqlFloat s = Just (read s) fromSqlValue _ _ = Nothing toSqlValue d = show d mkClockTime :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> ClockTime mkClockTime year mon mday hour min sec tz = unsafePerformIO $ do allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do (#poke struct tm,tm_sec ) p_tm (fromIntegral sec :: CInt) (#poke struct tm,tm_min ) p_tm (fromIntegral min :: CInt) (#poke struct tm,tm_hour ) p_tm (fromIntegral hour :: CInt) (#poke struct tm,tm_mday ) p_tm (fromIntegral mday :: CInt) (#poke struct tm,tm_mon ) p_tm (fromIntegral (mon-1) :: CInt) (#poke struct tm,tm_year ) p_tm (fromIntegral (year-1900) :: CInt) (#poke struct tm,tm_isdst) p_tm (-1 :: CInt) t <- mktime p_tm return (TOD (fromIntegral t + fromIntegral (tz-currTZ)) 0) foreign import ccall unsafe mktime :: Ptr () -> IO CTime {-# NOINLINE currTZ #-} currTZ :: Int currTZ = ctTZ (unsafePerformIO (getClockTime >>= toCalendarTime)) -- Hack parseTZ :: ReadP Int parseTZ = (char '+' >> readDecP) `mplus` (char '-' >> fmap negate readDecP) f_read :: ReadP a -> String -> Maybe a f_read f s = case readP_to_S f s of {[(x,_)] -> Just x} instance SqlBind ClockTime where fromSqlValue SqlTimeTZ s = f_read getTimeTZ s where getTimeTZ :: ReadP ClockTime getTimeTZ = do hour <- readDecP char ':' minutes <- readDecP char ':' seconds <- readDecP (char '.' >> readDecP) `mplus` (return 0) tz <- parseTZ return (mkClockTime 1970 1 1 hour minutes seconds (tz*3600)) fromSqlValue SqlTime s = f_read getTime s where getTime :: ReadP ClockTime getTime = do hour <- readDecP char ':' minutes <- readDecP char ':' seconds <- readDecP return (mkClockTime 1970 1 1 hour minutes seconds currTZ) fromSqlValue SqlDate s = f_read getDate s where getDate :: ReadP ClockTime getDate = do year <- readDecP char '-' month <- readDecP char '-' day <- readDecP return (mkClockTime year month day 0 0 0 currTZ) fromSqlValue SqlDateTimeTZ s = f_read getDateTimeTZ s where getDateTimeTZ :: ReadP ClockTime getDateTimeTZ = do year <- readDecP char '-' month <- readDecP char '-' day <- readDecP skipSpaces hour <- readDecP char ':' minutes <- readDecP char ':' seconds <- readDecP char '.' >> readDecP -- ) `mplus` (return 0) tz <- parseTZ return (mkClockTime year month day hour minutes seconds (tz*3600)) fromSqlValue SqlDateTime s = f_read getDateTime s where getDateTime :: ReadP ClockTime getDateTime = do year <- readDecP char '-' month <- readDecP char '-' day <- readDecP skipSpaces hour <- readDecP char ':' minutes <- readDecP char ':' seconds <- readDecP return (mkClockTime year month day hour minutes seconds currTZ) fromSqlValue SqlTimeStamp s = let [year,month,day,hour,minutes,seconds] = parts [4,2,2,2,2,2] s parts [] xs = [] parts (ix:ixs) xs = part ix 0 xs where part 0 n xs = n : parts ixs xs part k n (x:xs) = part (k-1) (n*10 + (ord x - ord '0')) xs in Just (mkClockTime year month day hour minutes seconds currTZ) fromSqlValue _ _ = Nothing toSqlValue ct = '\'' : (shows (ctYear t) . score . shows (ctMonth t) . score . shows (ctDay t) . space . shows (ctHour t) . colon . shows (ctMin t) . colon . shows (ctSec t)) "'" where t = toUTCTime ct score = showChar '-' space = showChar ' ' colon = showChar ':' data Point = Point Double Double deriving (Eq, Show) data Line = Line Point Point deriving (Eq, Show) data Path = OpenPath [Point] | ClosedPath [Point] deriving (Eq, Show) data Box = Box Double Double Double Double deriving (Eq, Show) data Circle = Circle Point Double deriving (Eq, Show) data Polygon = Polygon [Point] deriving (Eq, Show) instance SqlBind Point where fromSqlValue SqlPoint s = case read s of (x,y) -> Just (Point x y) fromSqlValue _ _ = Nothing toSqlValue (Point x y) = '\'' : shows (x,y) "'" instance SqlBind Line where fromSqlValue SqlLSeg s = case read s of [(x1,y1),(x2,y2)] -> Just (Line (Point x1 y1) (Point x2 y2)) fromSqlValue _ _ = Nothing toSqlValue (Line (Point x1 y1) (Point x2 y2)) = '\'' : shows [(x1,y1),(x2,y2)] "'" instance SqlBind Path where fromSqlValue SqlPath ('(':s) = case read ("["++init s++"]") of -- closed path ps -> Just (ClosedPath (map (\(x,y) -> Point x y) ps)) fromSqlValue SqlPath s = case read s of -- closed path -- open path ps -> Just (OpenPath (map (\(x,y) -> Point x y) ps)) fromSqlValue SqlLSeg s = case read s of [(x1,y1),(x2,y2)] -> Just (OpenPath [(Point x1 y1), (Point x2 y2)]) fromSqlValue SqlPoint s = case read s of (x,y) -> Just (ClosedPath [Point x y]) fromSqlValue _ _ = Nothing toSqlValue (OpenPath ps) = '\'' : shows ps "'" toSqlValue (ClosedPath ps) = "'(" ++ init (tail (show ps)) ++ "')" instance SqlBind Box where fromSqlValue SqlBox s = case read ("("++s++")") of ((x1,y1),(x2,y2)) -> Just (Box x1 y1 x2 y2) fromSqlValue _ _ = Nothing toSqlValue (Box x1 y1 x2 y2) = '\'' : shows ((x1,y1),(x2,y2)) "'" instance SqlBind Polygon where fromSqlValue SqlPolygon s = case read ("["++init (tail s)++"]") of ps -> Just (Polygon (map (\(x,y) -> Point x y) ps)) fromSqlValue _ _ = Nothing toSqlValue (Polygon ps) = "'(" ++ init (tail (show ps)) ++ "')" instance SqlBind Circle where fromSqlValue SqlCircle s = case read ("("++init (tail s)++")") of ((x,y),r) -> Just (Circle (Point x y) r) fromSqlValue _ _ = Nothing toSqlValue (Circle (Point x y) r) = "'<" ++ show (x,y) ++ "," ++ show r ++ "'>" data INetAddr = INetAddr Int Int Int Int Int deriving (Eq,Show) instance SqlBind INetAddr where fromSqlValue t s | t == SqlINetAddr || t == SqlCIDRAddr = case readNum s of (x1,s) -> case readNum s of (x2,s) -> case readNum s of (x3,s) -> case readNum s of (x4,s) -> case readNum s of (mask,_) -> Just (INetAddr x1 x2 x3 x4 mask) | otherwise = Nothing where readNum s = case readDec s of [(x,'.':s)] -> (x,s) [(x,'/':s)] -> (x,s) [(x,"")] -> (x,"") _ -> (0,"") toSqlValue (INetAddr x1 x2 x3 x4 mask) = '\'' : (shows x1 . dot . shows x2. dot . shows x3 . dot . shows x4 . slash . shows mask) "'" where dot = showChar '.' slash = showChar '/' data MacAddr = MacAddr Int Int Int Int Int Int deriving (Eq,Show) instance SqlBind MacAddr where fromSqlValue SqlMacAddr s = case readHex s of [(x1,':':s)] -> case readHex s of [(x2,':':s)] -> case readHex s of [(x3,':':s)] -> case readHex s of [(x4,':':s)] -> case readHex s of [(x5,':':s)] -> case readHex s of [(x6,_)] -> Just (MacAddr x1 x2 x3 x4 x5 x6) fromSqlValue _ _ = Nothing toSqlValue (MacAddr x1 x2 x3 x4 x5 x6) = '\'' : (showHex x1 . colon . showHex x2 . colon . showHex x3 . colon . showHex x4 . colon . showHex x5 . colon . showHex x6) "'" where colon = showChar ':' showHex = showIntAtBase 16 intToDigit -- | Retrieves the value of field with the specified name. -- The returned value is Nothing if the field value is @null@. getFieldValueMB :: SqlBind a => Statement -> String -- ^ Field name -> IO (Maybe a) -- ^ Field value or Nothing getFieldValueMB stmt name = checkHandle (stmtClosed stmt) $ stmtGetCol stmt colNumber (name,sqlType,nullable) fromNonNullSqlCStringLen where (sqlType,nullable,colNumber) = findFieldInfo name (stmtFields stmt) 0 -- | Retrieves the value of field with the specified name. -- If the field value is @null@ then the function will throw 'SqlFetchNull' exception. getFieldValue :: SqlBind a => Statement -> String -- ^ Field name -> IO a -- ^ Field value getFieldValue stmt name = do mb_v <- getFieldValueMB stmt name case mb_v of Nothing -> throwDyn (SqlFetchNull name) Just a -> return a -- | Retrieves the value of field with the specified name. -- If the field value is @null@ then the function will return the default value. getFieldValue' :: SqlBind a => Statement -> String -- ^ Field name -> a -- ^ Default field value -> IO a -- ^ Field value getFieldValue' stmt name def = do mb_v <- getFieldValueMB stmt name return (case mb_v of { Nothing -> def; Just a -> a }) ----------------------------------------------------------------------------------------- -- helpers ----------------------------------------------------------------------------------------- -- | The 'forEachRow' function iterates through the result set in 'Statement' and -- executes the given action for each row in the set. The function closes the 'Statement' -- after the last row processing or if the given action raises an exception. forEachRow :: (Statement -> s -> IO s) -- ^ an action -> Statement -- ^ the statement -> s -- ^ initial state -> IO s -- ^ final state forEachRow f stmt s = loop s `finally` closeStatement stmt where loop s = do success <- fetch stmt if success then f stmt s >>= loop else return s -- | The 'forEachRow\'' function is analogous to 'forEachRow' but doesn't provide state. -- The function closes the 'Statement' after the last row processing or if the given -- action raises an exception. forEachRow' :: (Statement -> IO ()) -> Statement -> IO () forEachRow' f stmt = loop `finally` closeStatement stmt where loop = do success <- fetch stmt when success (f stmt >> loop) -- | The 'collectRows' function iterates through the result set in 'Statement' and -- executes the given action for each row in the set. The values returned from action -- are collected and returned as list. The function closes the 'Statement' after the -- last row processing or if the given action raises an exception. collectRows :: (Statement -> IO a) -> Statement -> IO [a] collectRows f stmt = loop `finally` closeStatement stmt where loop = do success <- fetch stmt if success then do x <- f stmt xs <- loop return (x:xs) else return [] hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/0000755006511100651110000000000010504340326020225 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/HUnit.cabal0000644006511100651110000000047110504340326022242 0ustar rossrossName: HUnitTest Version: 1.0 copyright: filler for test suite maintainer: filler for test suite synopsis: filler for test suite License: AllRightsReserved Build-Depends: haskell-src, haskell98, base Other-Modules: HUnitText, HUnitLang, HUnitTestBase, Terminal, HUnitBase Exposed-Modules: HUnit HS-Source-Dir: src hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/Guide.html0000644006511100651110000006575510504340326022172 0ustar rossross HUnit 1.0 User's Guide

HUnit 1.0 User's Guide

HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java.  This guide describes how to use HUnit, assuming you are familiar with Haskell, though not necessarily with JUnit.  You can obtain HUnit, including this guide, at http://hunit.sourceforge.net.

Introduction

A test-centered methodology for software development is most effective when tests are easy to create, change, and execute.  The JUnit tool pioneered support for test-first development in Java.  HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely functional programming language.  (To learn more about Haskell, see http://www.haskell.org.)

With HUnit, as with JUnit, you can easily create tests, name them, group them into suites, and execute them, with the framework checking the results automatically.  Test specification in HUnit is even more concise and flexible than in JUnit, thanks to the nature of the Haskell language.  HUnit currently includes only a text-based test controller, but the framework is designed for easy extension.  (Would anyone care to write a graphical test controller for HUnit?)

The next section helps you get started using HUnit in simple ways.  Subsequent sections give details on writing tests and running tests.  The document concludes with a section describing HUnit's constituent files and a section giving references to further information.

Getting Started

In the Haskell module where your tests will reside, import module HUnit: 
    import HUnit
Define test cases as appropriate: 
    test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3))
    test2 = TestCase (do (x,y) <- partA 3
                         assertEqual "for the first result of partA," 5 x
                         b <- partB y
                         assertBool ("(partB " ++ show y ++ ") failed") b)
Name the test cases and group them together: 
    tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]
Run the tests as a group.  At a Haskell interpreter prompt, apply the function runTestTT to the collected tests.  (The "TT" suggests text orientation with output to the terminal.) 
    > runTestTT tests
    Cases: 2  Tried: 2  Errors: 0  Failures: 0
    >
If the tests are proving their worth, you might see: 
    > runTestTT tests
    ### Failure in: 0:test1
    for (foo 3),
    expected: (1,2)
     but got: (1,3)
    Cases: 2  Tried: 2  Errors: 0  Failures: 1
    >
Isn't that easy?

You can specify tests even more succinctly using operators and overloaded functions that HUnit provides: 

    tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3),
                   "test2" ~: do (x, y) <- partA 3
                                 assertEqual "for the first result of partA," 5 x
                                 partB y @? "(partB " ++ show y ++ ") failed" ]
Assuming the same test failures as before, you would see: 
    > runTestTT tests
    ### Failure in: 0:test1:(foo 3)
    expected: (1,2)
     but got: (1,3)
    Cases: 2  Tried: 2  Errors: 0  Failures: 1
    >

Writing Tests

Tests are specified compositionally.  Assertions are combined to make a test case, and test cases are combined into tests.  HUnit also provides advanced features for more convenient test specification.

Assertions

The basic building block of a test is an assertion. 
    type Assertion = IO ()
An assertion is an IO computation that always produces a void result.  Why is an assertion an IO computation? So that programs with real-world side effects can be tested.  How does an assertion assert anything if it produces no useful result? The answer is that an assertion can signal failure by calling assertFailure. 
    assertFailure :: String -> Assertion
    assertFailure msg = ioError (userError ("HUnit:" ++ msg))
(assertFailure msg) raises an exception.  The string argument identifies the failure.  The failure message is prefixed by "HUnit:" to mark it as an HUnit assertion failure message.  The HUnit test framework interprets such an exception as indicating failure of the test whose execution raised the exception.  (Note: The details concerning the implementation of assertFailure are subject to change and should not be relied upon.)

assertFailure can be used directly, but it is much more common to use it indirectly through other assertion functions that conditionally assert failure. 

    assertBool :: String -> Bool -> Assertion
    assertBool msg b = unless b (assertFailure msg)

    assertString :: String -> Assertion
    assertString s = unless (null s) (assertFailure s)

    assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion
    assertEqual preface expected actual =
      unless (actual == expected) (assertFailure msg)
     where msg = (if null preface then "" else preface ++ "\n") ++
                 "expected: " ++ show expected ++ "\n but got: " ++ show actual
With assertBool you give the assertion condition and failure message separately.  With assertString the two are combined.  With assertEqual you provide a "preface", an expected value, and an actual value; the failure message shows the two unequal values and is prefixed by the preface.  Additional ways to create assertions are described later under Advanced Features.

Since assertions are IO computations, they may be combined--along with other IO computations--using (>>=), (>>), and the do notation.  As long as its result is of type (IO ()), such a combination constitutes a single, collective assertion, incorporating any number of constituent assertions.  The important features of such a collective assertion are that it fails if any of its constituent assertions is executed and fails, and that the first constituent assertion to fail terminates execution of the collective assertion.  Such behavior is essential to specifying a test case.

Test Case

A test case is the unit of test execution.  That is, distinct test cases are executed independently.  The failure of one is independent of the failure of any other.

A test case consists of a single, possibly collective, assertion.  The possibly multiple constituent assertions in a test case's collective assertion are not independent.  Their interdependence may be crucial to specifying correct operation for a test.  A test case may involve a series of steps, each concluding in an assertion, where each step must succeed in order for the test case to continue.  As another example, a test may require some "set up" to be performed that must be undone ("torn down" in JUnit parlance) once the test is complete.  In this case, you could use Haskell's IO.bracket function to achieve the desired effect.

You can make a test case from an assertion by applying the TestCase constructor.  For example, (TestCase (return ())) is a test case that never fails, and (TestCase (assertEqual "for x," 3 x)) is a test case that checks that the value of x is 3.  Additional ways to create test cases are described later under Advanced Features.

Tests

As soon as you have more than one test, you'll want to name them to tell them apart.  As soon as you have more than several tests, you'll want to group them to process them more easily.  So, naming and grouping are the two keys to managing collections of tests.

In tune with the "composite" design pattern [1], a test is defined as a package of test cases.  Concretely, a test is either a single test case, a group of tests, or either of the first two identified by a label. 

    data Test = TestCase Assertion
              | TestList [Test]
              | TestLabel String Test
There are three important features of this definition to note:
  • A TestList consists of a list of tests rather than a list of test cases.  This means that the structure of a Test is actually a tree.  Using a hierarchy helps organize tests just as it helps organize files in a file system.
  • A TestLabel is attached to a test rather than to a test case.  This means that all nodes in the test tree, not just test case (leaf) nodes, can be labeled.  Hierarchical naming helps organize tests just as it helps organize files in a file system.
  • A TestLabel is separate from both TestCase and TestList.  This means that labeling is optional everywhere in the tree.  Why is this a good thing? Because of the hierarchical structure of a test, each constituent test case is uniquely identified by its path in the tree, ignoring all labels.  Sometimes a test case's path (or perhaps its subpath below a certain node) is a perfectly adequate "name" for the test case (perhaps relative to a certain node).  In this case, creating a label for the test case is both unnecessary and inconvenient.

The number of test cases that a test comprises can be computed with testCaseCount. 

    testCaseCount :: Test -> Int

As mentioned above, a test is identified by its path in the test hierarchy. 

    data Node  = ListItem Int | Label String
      deriving (Eq, Show, Read)

    type Path = [Node]    -- Node order is from test case to root.
Each occurrence of TestList gives rise to a ListItem and each occurrence of TestLabel gives rise to a Label.  The ListItems by themselves ensure uniqueness among test case paths, while the Labels allow you to add mnemonic names for individual test cases and collections of them.

Note that the order of nodes in a path is reversed from what you might expect: The first node in the list is the one deepest in the tree.  This order is a concession to efficiency: It allows common path prefixes to be shared.

The paths of the test cases that a test comprises can be computed with testCasePaths.  The paths are listed in the order in which the corresponding test cases would be executed. 

    testCasePaths :: Test -> [Path]

The three variants of Test can be constructed simply by applying TestCase, TestList, and TestLabel to appropriate arguments.  Additional ways to create tests are described later under Advanced Features.

The design of the type Test provides great conciseness, flexibility, and convenience in specifying tests.  Moreover, the nature of Haskell significantly augments these qualities:

  • Combining assertions and other code to construct test cases is easy with the IO monad.
  • Using overloaded functions and special operators (see below), specification of assertions and tests is extremely compact.
  • Structuring a test tree by value, rather than by name as in JUnit, provides for more convenient, flexible, and robust test suite specification.  In particular, a test suite can more easily be computed "on the fly" than in other test frameworks.
  • Haskell's powerful abstraction facilities provide unmatched support for test refactoring.

Advanced Features

HUnit provides additional features for specifying assertions and tests more conveniently and concisely.  These facilities make use of Haskell type classes.

The following operators can be used to construct assertions. 

    infix 1 @?, @=?, @?=

    (@?) :: (AssertionPredicable t) => t -> String -> Assertion
    pred @? msg = assertionPredicate pred >>= assertBool msg

    (@=?) :: (Eq a, Show a) => a -> a -> Assertion
    expected @=? actual = assertEqual "" expected actual

    (@?=) :: (Eq a, Show a) => a -> a -> Assertion
    actual @?= expected = assertEqual "" expected actual
You provide a boolean condition and failure message separately to (@?), as for assertBool, but in a different order.  The (@=?) and (@?=) operators provide shorthands for assertEqual when no preface is required.  They differ only in the order in which the expected and actual values are provided.  (The actual value--the uncertain one--goes on the "?" side of the operator.)

The (@?) operator's first argument is something from which an assertion predicate can be made, that is, its type must be AssertionPredicable. 

    type AssertionPredicate = IO Bool

    class AssertionPredicable t
     where assertionPredicate :: t -> AssertionPredicate

    instance AssertionPredicable Bool
     where assertionPredicate = return

    instance (AssertionPredicable t) => AssertionPredicable (IO t)
     where assertionPredicate = (>>= assertionPredicate)
The overloaded assert function in the Assertable type class constructs an assertion. 
    class Assertable t
     where assert :: t -> Assertion

    instance Assertable ()
     where assert = return

    instance Assertable Bool
     where assert = assertBool ""

    instance (ListAssertable t) => Assertable [t]
     where assert = listAssert

    instance (Assertable t) => Assertable (IO t)
     where assert = (>>= assert)
The ListAssertable class allows assert to be applied to [Char] (that is, String). 
    class ListAssertable t
     where listAssert :: [t] -> Assertion

    instance ListAssertable Char
     where listAssert = assertString
With the above declarations, (assert ()), (assert True), and (assert "") (as well as IO forms of these values, such as (return ())) are all assertions that never fail, while (assert False) and (assert "some failure message") (and their IO forms) are assertions that always fail.  You may define additional instances for the type classes Assertable, ListAssertable, and AssertionPredicable if that should be useful in your application.

The overloaded test function in the Testable type class constructs a test. 

    class Testable t
     where test :: t -> Test

    instance Testable Test
     where test = id

    instance (Assertable t) => Testable (IO t)
     where test = TestCase . assert

    instance (Testable t) => Testable [t]
     where test = TestList . map test
The test function makes a test from either an Assertion (using TestCase), a list of Testable items (using TestList), or a Test (making no change).

The following operators can be used to construct tests. 

    infix  1 ~?, ~=?, ~?=
    infixr 0 ~:

    (~?) :: (AssertionPredicable t) => t -> String -> Test
    pred ~? msg = TestCase (pred @? msg)

    (~=?) :: (Eq a, Show a) => a -> a -> Test
    expected ~=? actual = TestCase (expected @=? actual)

    (~?=) :: (Eq a, Show a) => a -> a -> Test
    actual ~?= expected = TestCase (actual @?= expected)

    (~:) :: (Testable t) => String -> t -> Test
    label ~: t = TestLabel label (test t)
(~?), (~=?), and (~?=) each make an assertion, as for (@?), (@=?), and (@?=), respectively, and then a test case from that assertion.  (~:) attaches a label to something that is Testable.  You may define additional instances for the type class Testable should that be useful.

Running Tests

HUnit is structured to support multiple test controllers.  The first subsection below describes the test execution characteristics common to all test controllers.  The second subsection describes the text-based controller that is included with HUnit.

Test Execution

All test controllers share a common test execution model.  They differ only in how the results of test execution are shown.

The execution of a test (a value of type Test) involves the serial execution (in the IO monad) of its constituent test cases.  The test cases are executed in a depth-first, left-to-right order.  During test execution, four counts of test cases are maintained: 

    data Counts = Counts { cases, tried, errors, failures :: Int }
      deriving (Eq, Show, Read)
  • cases is the number of test cases included in the test.  This number is a static property of a test and remains unchanged during test execution.
  • tried is the number of test cases that have been executed so far during the test execution.
  • errors is the number of test cases whose execution ended with an unexpected exception being raised.  Errors indicate problems with test cases, as opposed to the code under test.
  • failures is the number of test cases whose execution asserted failure.  Failures indicate problems with the code under test.
Why is there no count for test case successes? The technical reason is that the counts are maintained such that the number of test case successes is always equal to (tried - (errors + failures)).  The psychosocial reason is that, with test-centered development and the expectation that test failures will be few and short-lived, attention should be focused on the failures rather than the successes.

As test execution proceeds, three kinds of reporting event are communicated to the test controller.  (What the controller does in response to the reporting events depends on the controller.)

  • start -- Just prior to initiation of a test case, the path of the test case and the current counts (excluding the current test case) are reported.
  • error -- When a test case terminates with an error, the error message is reported, along with the test case path and current counts (including the current test case).
  • failure -- When a test case terminates with a failure, the failure message is reported, along with the test case path and current counts (including the current test case).
Typically, a test controller shows error and failure reports immediately but uses the start report merely to update an indication of overall test execution progress.

Text-Based Controller

A text-based test controller is included with HUnit. 
    runTestText :: PutText st -> Test -> IO (Counts, st)
runTestText is generalized on a reporting scheme given as its first argument.  During execution of the test given as its second argument, the controller creates a string for each reporting event and processes it according to the reporting scheme.  When test execution is complete, the controller returns the final counts along with the final state for the reporting scheme.

The strings for the three kinds of reporting event are as follows.

  • A start report is the result of the function showCounts applied to the counts current immediately prior to initiation of the test case being started.
  • An error report is of the form "Error in:   path\nmessage", where path is the path of the test case in error, as shown by showPath, and message is a message describing the error.  If the path is empty, the report has the form "Error:\nmessage".
  • A failure report is of the form "Failure in: path\nmessage", where path is the path of the test case in error, as shown by showPath, and message is the failure message.  If the path is empty, the report has the form "Failure:\nmessage".

The function showCounts shows a set of counts. 

    showCounts :: Counts -> String
The form of its result is "Cases: cases  Tried: tried  Errors: errors  Failures: failures" where cases, tried, errors, and failures are the count values.

The function showPath shows a test case path. 

    showPath :: Path -> String
The nodes in the path are reversed (so that the path reads from the root down to the test case), and the representations for the nodes are joined by ':' separators.  The representation for (ListItem n) is (show n).  The representation for (Label label) is normally label.  However, if label contains a colon or if (show label) is different from label surrounded by quotation marks--that is, if any ambiguity could exist--then (Label label) is represented as (show label).

HUnit includes two reporting schemes for the text-based test controller.  You may define others if you wish. 

    putTextToHandle :: Handle -> Bool -> PutText Int
putTextToHandle writes error and failure reports, plus a report of the final counts, to the given handle.  Each of these reports is terminated by a newline.  In addition, if the given flag is True, it writes start reports to the handle as well.  A start report, however, is not terminated by a newline.  Before the next report is written, the start report is "erased" with an appropriate sequence of carriage return and space characters.  Such overwriting realizes its intended effect on terminal devices. 
    putTextToShowS :: PutText ShowS
putTextToShowS ignores start reports and simply accumulates error and failure reports, terminating them with newlines.  The accumulated reports are returned (as the second element of the pair returned by runTestText) as a ShowS function (that is, one with type (String -> String)) whose first argument is a string to be appended to the accumulated report lines.

HUnit provides a shorthand for the most common use of the text-based test controller. 

    runTestTT :: Test -> IO Counts
runTestTT invokes runTestText, specifying (putTextToHandle stderr True) for the reporting scheme, and returns the final counts from the test execution.

Constituent Files

HUnit 1.0 consists of the following files.
Guide.html
This document.
Example.hs
Haskell module that includes the examples given in the Getting Started section.  Run this program to make sure you understand how to use HUnit.
HUnit.lhs
Haskell module that you import to use HUnit.
HUnitBase.lhs
Haskell module that defines HUnit's basic facilities.
HUnitLang.lhs
Haskell module that defines how assertion failure is signaled and caught.  By default, it is a copy of HUnitLang98.lhs.  Replace it by a copy of HUnitLangExc.lhs for more robust exception behavior.
HUnitLang98.lhs
Haskell module that defines generic assertion failure handling.  It is compliant to Haskell 98 but catches only IO errors.
HUnitLangExc.lhs
Haskell module that defines more robust assertion failure handling.  It catches more (though unfortunately not all) kinds of exceptions.  However, it works only with Hugs (Dec. 2001 or later) and GHC (5.00 and later).
HUnitTest98.lhs
Haskell module that tests HUnit, assuming the generic assertion failure handling of HUnitLang98.lhs.
HUnitTestBase.lhs
Haskell module that defines testing support and basic (Haskell 98 compliant) tests of HUnit (using HUnit, of course!).  Contains more extensive and advanced examples of testing with HUnit.
HUnitTestExc.lhs
Haskell module that tests HUnit, assuming the extended assertion failure handling of HUnitLangExc.lhs.
HUnitText.lhs
Haskell module that defines HUnit's text-based test controller.
License
The license for use of HUnit.
Terminal.lhs
Haskell module that assists in checking the output of HUnit tests performed by the text-based test controller.
TerminalTest.lhs
Haskell module that tests Terminal.lhs (using HUnit, of course!).

References

[1] Gamma, E., et al. Design Patterns: Elements of Reusable Object-Oriented Software, Addison-Wesley, Reading, MA, 1995.
The classic book describing design patterns in an object-oriented context.
http://www.junit.org
Web page for JUnit, the tool after which HUnit is modeled.
http://junit.sourceforge.net/doc/testinfected/testing.htm
A good introduction to test-first development and the use of JUnit.
http://junit.sourceforge.net/doc/cookstour/cookstour.htm
A description of the internal structure of JUnit.  Makes for an interesting comparison between JUnit and HUnit.

The HUnit software and this guide were written by Dean Herington (heringto@cs.unc.edu).

HUnit development is supported by SourceForge.net Logo

[$Revision: 1.1 $ $Date: 2002/02/21 19:09:27 $] hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/0000755006511100651110000000000010504340326021014 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/Terminal.lhs0000644006511100651110000000233610504340326023303 0ustar rossross> module Terminal > ( > terminalAppearance > ) > where > import Char (isPrint) Simplifies the input string by interpreting '\r' and '\b' characters specially so that the result string has the same final (or "terminal", pun intended) appearance as would the input string when written to a terminal that overwrites character positions following carriage returns and backspaces. The helper function `ta` takes an accumlating `ShowS`-style function that holds "committed" lines of text, a (reversed) list of characters on the current line *before* the cursor, a (normal) list of characters on the current line *after* the cursor, and the remaining input. > terminalAppearance :: String -> String > terminalAppearance str = ta id "" "" str > where > ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs > ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs > ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs > ta f "" as ('\b':cs) = error "'\\b' at beginning of line" > ta f bs as (c:cs) | not (isPrint c) = error "invalid nonprinting character" > | null as = ta f (c:bs) "" cs > | otherwise = ta f (c:bs) (tail as) cs > ta f bs as "" = f (reverse bs ++ as) hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/Example.hs0000644006511100651110000000170210504340326022743 0ustar rossross-- Example.hs -- Examples from HUnit user's guide -- $Id: Example.hs,v 1.2 2002/02/19 17:05:21 heringto Exp $ module Main where import HUnit foo :: Int -> (Int, Int) foo x = (1, x) partA :: Int -> IO (Int, Int) partA v = return (v+2, v+3) partB :: Int -> IO Bool partB v = return (v > 5) test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3)) test2 = TestCase (do (x,y) <- partA 3 assertEqual "for the first result of partA," 5 x b <- partB y assertBool ("(partB " ++ show y ++ ") failed") b) tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2] tests' = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3), "test2" ~: do (x, y) <- partA 3 assertEqual "for the first result of partA," 5 x partB y @? "(partB " ++ show y ++ ") failed" ] main = do runTestTT tests runTestTT tests' hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/HUnit.lhs0000644006511100651110000000032510504340326022553 0ustar rossrossHUnit.lhs -- interface module for HUnit $Id: HUnit.lhs,v 1.3 2002/02/09 04:25:12 heringto Exp $ > module HUnit > ( > module HUnitBase, > module HUnitText > ) > where > import HUnitBase > import HUnitText hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/HUnitLang98.lhs0000644006511100651110000000364010504340326023541 0ustar rossrossHUnitLang98.lhs -- HUnit language support, generic Haskell 98 variant Note: The Haskell system you use needs to find this file when looking for module `HUnitLang`. $Id: HUnitLang98.lhs,v 1.2 2002/02/14 19:27:56 heringto Exp $ > module HUnitLang > ( > Assertion, > assertFailure, > performTestCase > ) > where When adapting this module for other Haskell language systems, change the imports and the implementations but not the interfaces. Imports ------- > import List (isPrefixOf) > import IO (ioeGetErrorString, try) Interfaces ---------- An assertion is an `IO` computation with trivial result. > type Assertion = IO () `assertFailure` signals an assertion failure with a given message. > assertFailure :: String -> Assertion `performTestCase` performs a single test case. The meaning of the result is as follows: Nothing test case success Just (True, msg) test case failure with the given message Just (False, msg) test case error with the given message > performTestCase :: Assertion -> IO (Maybe (Bool, String)) Implementations --------------- > hunitPrefix = "HUnit:" > hugsPrefix = "IO Error: User error\nReason: " > nhc98Prefix = "I/O error (user-defined), call to function `userError':\n " > -- GHC prepends no prefix to the user-supplied string. > assertFailure msg = ioError (userError (hunitPrefix ++ msg)) > performTestCase action = do r <- try action > case r of Right () -> return Nothing > Left e -> return (Just (decode e)) > where > decode e = let s0 = ioeGetErrorString e > (_, s1) = dropPrefix hugsPrefix s0 > (_, s2) = dropPrefix nhc98Prefix s1 > in dropPrefix hunitPrefix s2 > dropPrefix pref str = if pref `isPrefixOf` str > then (True, drop (length pref) str) > else (False, str) hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/HUnitBase.lhs0000644006511100651110000001504010504340326023346 0ustar rossrossHUnitBase.lhs -- basic definitions $Id: HUnitBase.lhs,v 1.12 2002/02/14 19:31:57 heringto Exp $ > module HUnitBase > ( > {- from HUnitLang: -} Assertion, assertFailure, > assertString, assertBool, assertEqual, > Assertable(..), ListAssertable(..), > AssertionPredicate, AssertionPredicable(..), > (@?), (@=?), (@?=), > Test(..), Node(..), Path, > testCaseCount, > Testable(..), > (~?), (~=?), (~?=), (~:), > Counts(..), State(..), > ReportStart, ReportProblem, > testCasePaths, > performTest > ) > where > import Monad (unless, foldM) Assertion Definition ==================== > import HUnitLang Conditional Assertion Functions ------------------------------- > assertBool :: String -> Bool -> Assertion > assertBool msg b = unless b (assertFailure msg) > assertString :: String -> Assertion > assertString s = unless (null s) (assertFailure s) > assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion > assertEqual preface expected actual = > unless (actual == expected) (assertFailure msg) > where msg = (if null preface then "" else preface ++ "\n") ++ > "expected: " ++ show expected ++ "\n but got: " ++ show actual Overloaded `assert` Function ---------------------------- > class Assertable t > where assert :: t -> Assertion > instance Assertable () > where assert = return > instance Assertable Bool > where assert = assertBool "" > instance (ListAssertable t) => Assertable [t] > where assert = listAssert > instance (Assertable t) => Assertable (IO t) > where assert = (>>= assert) We define the assertability of `[Char]` (that is, `String`) and leave other types of list to possible user extension. > class ListAssertable t > where listAssert :: [t] -> Assertion > instance ListAssertable Char > where listAssert = assertString Overloaded `assertionPredicate` Function ---------------------------------------- > type AssertionPredicate = IO Bool > class AssertionPredicable t > where assertionPredicate :: t -> AssertionPredicate > instance AssertionPredicable Bool > where assertionPredicate = return > instance (AssertionPredicable t) => AssertionPredicable (IO t) > where assertionPredicate = (>>= assertionPredicate) Assertion Construction Operators -------------------------------- > infix 1 @?, @=?, @?= > (@?) :: (AssertionPredicable t) => t -> String -> Assertion > pred @? msg = assertionPredicate pred >>= assertBool msg > (@=?) :: (Eq a, Show a) => a -> a -> Assertion > expected @=? actual = assertEqual "" expected actual > (@?=) :: (Eq a, Show a) => a -> a -> Assertion > actual @?= expected = assertEqual "" expected actual Test Definition =============== > data Test = TestCase Assertion > | TestList [Test] > | TestLabel String Test > instance Show Test where > showsPrec p (TestCase _) = showString "TestCase _" > showsPrec p (TestList ts) = showString "TestList " . showList ts > showsPrec p (TestLabel l t) = showString "TestLabel " . showString l > . showChar ' ' . showsPrec p t > testCaseCount :: Test -> Int > testCaseCount (TestCase _) = 1 > testCaseCount (TestList ts) = sum (map testCaseCount ts) > testCaseCount (TestLabel _ t) = testCaseCount t > data Node = ListItem Int | Label String > deriving (Eq, Show, Read) > type Path = [Node] -- Node order is from test case to root. > testCasePaths :: Test -> [Path] > testCasePaths t = tcp t [] > where tcp (TestCase _) p = [p] > tcp (TestList ts) p = > concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ] > tcp (TestLabel l t) p = tcp t (Label l : p) Overloaded `test` Function -------------------------- > class Testable t > where test :: t -> Test > instance Testable Test > where test = id > instance (Assertable t) => Testable (IO t) > where test = TestCase . assert > instance (Testable t) => Testable [t] > where test = TestList . map test Test Construction Operators --------------------------- > infix 1 ~?, ~=?, ~?= > infixr 0 ~: > (~?) :: (AssertionPredicable t) => t -> String -> Test > pred ~? msg = TestCase (pred @? msg) > (~=?) :: (Eq a, Show a) => a -> a -> Test > expected ~=? actual = TestCase (expected @=? actual) > (~?=) :: (Eq a, Show a) => a -> a -> Test > actual ~?= expected = TestCase (actual @?= expected) > (~:) :: (Testable t) => String -> t -> Test > label ~: t = TestLabel label (test t) Test Execution ============== > data Counts = Counts { cases, tried, errors, failures :: Int } > deriving (Eq, Show, Read) > data State = State { path :: Path, counts :: Counts } > deriving (Eq, Show, Read) > type ReportStart us = State -> us -> IO us > type ReportProblem us = String -> State -> us -> IO us Note that the counts in a start report do not include the test case being started, whereas the counts in a problem report do include the test case just finished. The principle is that the counts are sampled only between test case executions. As a result, the number of test case successes always equals the difference of test cases tried and the sum of test case errors and failures. > performTest :: ReportStart us -> ReportProblem us -> ReportProblem us > -> us -> Test -> IO (Counts, us) > performTest reportStart reportError reportFailure us t = do > (ss', us') <- pt initState us t > unless (null (path ss')) $ error "performTest: Final path is nonnull" > return (counts ss', us') > where > initState = State{ path = [], counts = initCounts } > initCounts = Counts{ cases = testCaseCount t, tried = 0, > errors = 0, failures = 0} > pt ss us (TestCase a) = do > us' <- reportStart ss us > r <- performTestCase a > case r of Nothing -> do return (ss', us') > Just (True, m) -> do usF <- reportFailure m ssF us' > return (ssF, usF) > Just (False, m) -> do usE <- reportError m ssE us' > return (ssE, usE) > where c@Counts{ tried = t } = counts ss > ss' = ss{ counts = c{ tried = t + 1 } } > ssF = ss{ counts = c{ tried = t + 1, failures = failures c + 1 } } > ssE = ss{ counts = c{ tried = t + 1, errors = errors c + 1 } } > pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..]) > where f (ss, us) (t, n) = withNode (ListItem n) ss us t > pt ss us (TestLabel label t) = withNode (Label label) ss us t > withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t > return (ss2{ path = path0 }, us1) > where path0 = path ss0 > ss1 = ss0{ path = node : path0 } hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/HUnitLang.lhs0000644006511100651110000000364010504340326023360 0ustar rossrossHUnitLang98.lhs -- HUnit language support, generic Haskell 98 variant Note: The Haskell system you use needs to find this file when looking for module `HUnitLang`. $Id: HUnitLang98.lhs,v 1.2 2002/02/14 19:27:56 heringto Exp $ > module HUnitLang > ( > Assertion, > assertFailure, > performTestCase > ) > where When adapting this module for other Haskell language systems, change the imports and the implementations but not the interfaces. Imports ------- > import List (isPrefixOf) > import IO (ioeGetErrorString, try) Interfaces ---------- An assertion is an `IO` computation with trivial result. > type Assertion = IO () `assertFailure` signals an assertion failure with a given message. > assertFailure :: String -> Assertion `performTestCase` performs a single test case. The meaning of the result is as follows: Nothing test case success Just (True, msg) test case failure with the given message Just (False, msg) test case error with the given message > performTestCase :: Assertion -> IO (Maybe (Bool, String)) Implementations --------------- > hunitPrefix = "HUnit:" > hugsPrefix = "IO Error: User error\nReason: " > nhc98Prefix = "I/O error (user-defined), call to function `userError':\n " > -- GHC prepends no prefix to the user-supplied string. > assertFailure msg = ioError (userError (hunitPrefix ++ msg)) > performTestCase action = do r <- try action > case r of Right () -> return Nothing > Left e -> return (Just (decode e)) > where > decode e = let s0 = ioeGetErrorString e > (_, s1) = dropPrefix hugsPrefix s0 > (_, s2) = dropPrefix nhc98Prefix s1 > in dropPrefix hunitPrefix s2 > dropPrefix pref str = if pref `isPrefixOf` str > then (True, drop (length pref) str) > else (False, str) hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/HUnitLangExc.lhs0000644006511100651110000000342410504340326024020 0ustar rossrossHUnitLangExc.lhs -- HUnit language support, using `Exception` type Note: The Haskell system you use needs to find this file when looking for module `HUnitLang`. $Id: HUnitLangExc.lhs,v 1.1 2002/02/14 14:54:34 heringto Exp $ > module HUnitLang > ( > Assertion, > assertFailure, > performTestCase > ) > where When adapting this module for other Haskell language systems, change the imports and the implementations but not the interfaces. Imports ------- > import List (isPrefixOf) > import qualified Exception (try) Interfaces ---------- An assertion is an `IO` computation with trivial result. > type Assertion = IO () `assertFailure` signals an assertion failure with a given message. > assertFailure :: String -> Assertion `performTestCase` performs a single test case. The meaning of the result is as follows: Nothing test case success Just (True, msg) test case failure with the given message Just (False, msg) test case error with the given message > performTestCase :: Assertion -> IO (Maybe (Bool, String)) Implementations --------------- > hunitPrefix = "HUnit:" > hugsPrefix = "IO Error: User error\nReason: " > -- GHC prepends no prefix to the user-supplied string. > assertFailure msg = ioError (userError (hunitPrefix ++ msg)) > performTestCase action = do r <- Exception.try action > case r of Right () -> return Nothing > Left e -> return (Just (decode e)) > where > decode e = let s0 = show e > (_, s1) = dropPrefix hugsPrefix s0 > in dropPrefix hunitPrefix s1 > dropPrefix pref str = if pref `isPrefixOf` str > then (True, drop (length pref) str) > else (False, str) hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/HUnitTest98.lhs0000644006511100651110000000036210504340326023575 0ustar rossrossHUnitTest98.lhs -- test for HUnit, using Haskell language system "98" $Id: HUnitTest98.lhs,v 1.1 2002/02/19 17:12:14 heringto Exp $ > module Main (main) where > import HUnit > import HUnitTestBase > main = runTestTT (test [baseTests]) hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/HUnitTestBase.lhs0000644006511100651110000003051010504340326024205 0ustar rossrossHUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant) $Id: HUnitTestBase.lhs,v 1.4 2002/02/14 19:34:54 heringto Exp $ > module HUnitTestBase where > import HUnit > import Terminal (terminalAppearance) > import IO (IOMode(..), openFile, hClose) > data Report = Start State > | Error String State > | UnspecifiedError State > | Failure String State > deriving (Show, Read) > instance Eq Report where > Start s1 == Start s2 = s1 == s2 > Error m1 s1 == Error m2 s2 = m1 == m2 && s1 == s2 > Error m1 s1 == UnspecifiedError s2 = s1 == s2 > UnspecifiedError s1 == Error m2 s2 = s1 == s2 > UnspecifiedError s1 == UnspecifiedError s2 = s1 == s2 > Failure m1 s1 == Failure m2 s2 = m1 == m2 && s1 == s2 > _ == _ = False > expectReports :: [Report] -> Counts -> Test -> Test > expectReports reports counts test = TestCase $ do > (counts', reports') <- performTest (\ ss us -> return (Start ss : us)) > (\m ss us -> return (Error m ss : us)) > (\m ss us -> return (Failure m ss : us)) > [] test > assertEqual "for the reports from a test," reports (reverse reports') > assertEqual "for the counts from a test," counts counts' > simpleStart = Start (State [] (Counts 1 0 0 0)) > expectSuccess :: Test -> Test > expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0) > expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test > expectProblem kind err msg = > expectReports [simpleStart, kind msg (State [] counts)] counts > where counts = Counts 1 1 err (1-err) > expectError, expectFailure :: String -> Test -> Test > expectError = expectProblem Error 1 > expectFailure = expectProblem Failure 0 > expectUnspecifiedError :: Test -> Test > expectUnspecifiedError = expectProblem (\ msg st -> UnspecifiedError st) 1 undefined > data Expect = Succ | Err String | UErr | Fail String > expect :: Expect -> Test -> Test > expect Succ test = expectSuccess test > expect (Err m) test = expectError m test > expect UErr test = expectUnspecifiedError test > expect (Fail m) test = expectFailure m test > baseTests = test [ assertTests, > testCaseCountTests, > testCasePathsTests, > reportTests, > textTests, > showPathTests, > showCountsTests, > assertableTests, > predicableTests, > compareTests, > extendedTestTests ] > ok = test (assert ()) > bad m = test (assertFailure m) > assertTests = test [ > "null" ~: expectSuccess ok, > "userError" ~: > expectError "error" (TestCase (ioError (userError "error"))), > "IO error (file missing)" ~: > expectUnspecifiedError > (test (do openFile "3g9djs" ReadMode; return ())), "error" ~: expectError "error" (TestCase (error "error")), "tail []" ~: expectUnspecifiedError (TestCase (tail [] `seq` return ())), -- GHC doesn't currently catch arithmetic exceptions. "div by 0" ~: expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), > "assertFailure" ~: > let msg = "simple assertFailure" > in expectFailure msg (test (assertFailure msg)), > "assertString null" ~: expectSuccess (TestCase (assertString "")), > "assertString nonnull" ~: > let msg = "assertString nonnull" > in expectFailure msg (TestCase (assertString msg)), > let exp v non = > show v ++ " with " ++ non ++ "null message" ~: > expect (if v then Succ else Fail non) $ test $ assertBool non v > in "assertBool" ~: [ exp v non | v <- [True, False], non <- ["non", ""] ], > let msg = "assertBool True" > in msg ~: expectSuccess (test (assertBool msg True)), > let msg = "assertBool False" > in msg ~: expectFailure msg (test (assertBool msg False)), > "assertEqual equal" ~: > expectSuccess (test (assertEqual "" 3 3)), > "assertEqual unequal no msg" ~: > expectFailure "expected: 3\n but got: 4" > (test (assertEqual "" 3 4)), > "assertEqual unequal with msg" ~: > expectFailure "for x,\nexpected: 3\n but got: 4" > (test (assertEqual "for x," 3 4)) > ] > emptyTest0 = TestList [] > emptyTest1 = TestLabel "empty" emptyTest0 > emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ] > emptyTests = [emptyTest0, emptyTest1, emptyTest2] > testCountEmpty test = TestCase (assertEqual "" 0 (testCaseCount test)) > suite0 = (0, ok) > suite1 = (1, TestList []) > suite2 = (2, TestLabel "3" ok) > suite3 = (3, suite) > suite = > TestLabel "0" > (TestList [ TestLabel "1" (bad "1"), > TestLabel "2" (TestList [ TestLabel "2.1" ok, > ok, > TestLabel "2.3" (bad "2") ]), > TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))), > TestList [ TestList [ TestLabel "6" (bad "4") ] ] ]) > suiteCount = (6 :: Int) > suitePaths = [ > [Label "0", ListItem 0, Label "1"], > [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"], > [Label "0", ListItem 1, Label "2", ListItem 1], > [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"], > [Label "0", ListItem 2, Label "3", Label "4", Label "5"], > [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]] > suiteReports = [ Start (State (p 0) (Counts 6 0 0 0)), > Failure "1" (State (p 0) (Counts 6 1 0 1)), > Start (State (p 1) (Counts 6 1 0 1)), > Start (State (p 2) (Counts 6 2 0 1)), > Start (State (p 3) (Counts 6 3 0 1)), > Failure "2" (State (p 3) (Counts 6 4 0 2)), > Start (State (p 4) (Counts 6 4 0 2)), > Failure "3" (State (p 4) (Counts 6 5 0 3)), > Start (State (p 5) (Counts 6 5 0 3)), > Failure "4" (State (p 5) (Counts 6 6 0 4))] > where p n = reverse (suitePaths !! n) > suiteCounts = Counts 6 6 0 4 > suiteOutput = "### Failure in: 0:0:1\n\ > \1\n\ > \### Failure in: 0:1:2:2:2.3\n\ > \2\n\ > \### Failure in: 0:2:3:4:5\n\ > \3\n\ > \### Failure in: 0:3:0:0:6\n\ > \4\n\ > \Cases: 6 Tried: 6 Errors: 0 Failures: 4\n" > suites = [suite0, suite1, suite2, suite3] > testCount (num, test) count = > "testCaseCount suite" ++ show num ~: > TestCase $ assertEqual "for test count," count (testCaseCount test) > testCaseCountTests = TestList [ > "testCaseCount empty" ~: test (map testCountEmpty emptyTests), > testCount suite0 1, > testCount suite1 0, > testCount suite2 1, > testCount suite3 suiteCount > ] > testPaths (num, test) paths = > "testCasePaths suite" ++ show num ~: > TestCase $ assertEqual "for test paths," > (map reverse paths) (testCasePaths test) > testPathsEmpty test = TestCase $ assertEqual "" [] (testCasePaths test) > testCasePathsTests = TestList [ > "testCasePaths empty" ~: test (map testPathsEmpty emptyTests), > testPaths suite0 [[]], > testPaths suite1 [], > testPaths suite2 [[Label "3"]], > testPaths suite3 suitePaths > ] > reportTests = "reports" ~: expectReports suiteReports suiteCounts suite > expectText counts text test = TestCase $ do > (counts', text') <- runTestText putTextToShowS test > assertEqual "for the final counts," counts counts' > assertEqual "for the failure text output," text (text' "") > textTests = test [ > "lone error" ~: > expectText (Counts 1 1 1 0) > "### Error:\nxyz\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" > (test (do ioError (userError "xyz"); return ())), > "lone failure" ~: > expectText (Counts 1 1 0 1) > "### Failure:\nxyz\nCases: 1 Tried: 1 Errors: 0 Failures: 1\n" > (test (assert "xyz")), > "putTextToShowS" ~: > expectText suiteCounts suiteOutput suite, > "putTextToHandle (file)" ~: > let filename = "HUnitTest.tmp" > trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines > in map test > [ "show progress = " ++ show flag ~: do > handle <- openFile filename WriteMode > (counts, _) <- runTestText (putTextToHandle handle flag) suite > hClose handle > assertEqual "for the final counts," suiteCounts counts > text <- readFile filename > let text' = if flag then trim (terminalAppearance text) else text > assertEqual "for the failure text output," suiteOutput text' > | flag <- [False, True] ] > ] > showPathTests = "showPath" ~: [ > "empty" ~: showPath [] ~?= "", > ":" ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"", > "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"", > "misc" ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?= > "foo:3:2:b" > ] > showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?= > "Cases: 4 Tried: 3 Errors: 2 Failures: 1" > lift :: a -> IO a > lift a = return a > assertableTests = > let assertables x = [ > ( "", assert x , test (lift x)) , > ( "IO ", assert (lift x) , test (lift (lift x))) , > ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))] > assertabled l e x = > test [ test [ "assert" ~: pre ++ l ~: expect e $ test $ a, > "test" ~: pre ++ "IO " ++ l ~: expect e $ t ] > | (pre, a, t) <- assertables x ] > in "assertable" ~: [ > assertabled "()" Succ (), > assertabled "True" Succ True, > assertabled "False" (Fail "") False, > assertabled "\"\"" Succ "", > assertabled "\"x\"" (Fail "x") "x" > ] > predicableTests = > let predicables x m = [ > ( "", assertionPredicate x , x @? m, x ~? m ), > ( "IO ", assertionPredicate (l x) , l x @? m, l x ~? m ), > ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )] > l x = lift x > predicabled l e m x = > test [ test [ "pred" ~: pre ++ l ~: m ~: expect e $ test $ tst p, > "(@?)" ~: pre ++ l ~: m ~: expect e $ test $ a, > "(~?)" ~: pre ++ l ~: m ~: expect e $ t ] > | (pre, p, a, t) <- predicables x m ] > where tst p = p >>= assertBool m > in "predicable" ~: [ > predicabled "True" Succ "error" True, > predicabled "False" (Fail "error") "error" False, > predicabled "True" Succ "" True, > predicabled "False" (Fail "" ) "" False > ] > compareTests = test [ > let succ = const Succ > compare f exp act = test [ "(@=?)" ~: expect e $ test (exp @=? act), > "(@?=)" ~: expect e $ test (act @?= exp), > "(~=?)" ~: expect e $ exp ~=? act, > "(~?=)" ~: expect e $ act ~?= exp ] > where e = f $ "expected: " ++ show exp ++ "\n but got: " ++ show act > in test [ > compare succ 1 1, > compare Fail 1 2, > compare succ (1,'b',3.0) (1,'b',3.0), > compare Fail (1,'b',3.0) (1,'b',3.1) > ] > ] > expectList1 :: Int -> Test -> Test > expectList1 c = > expectReports > [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ] > (Counts c c 0 0) > expectList2 :: [Int] -> Test -> Test > expectList2 cs test = > expectReports > [ Start (State [ListItem j, ListItem i] (Counts c n 0 0)) > | ((i,j),n) <- zip coords [0..] ] > (Counts c c 0 0) > test > where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ] > c = testCaseCount test > extendedTestTests = test [ > "test idempotent" ~: expect Succ $ test $ test $ test $ ok, > "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True], > "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]] > ] hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/HUnitTestExc.lhs0000644006511100651110000000175410504340326024062 0ustar rossrossHUnitTestExc.lhs -- test for HUnit, using Haskell language system "Exc" $Id: HUnitTestExc.lhs,v 1.1 2002/02/19 17:12:47 heringto Exp $ > module Main (main) where > import HUnit > import HUnitTestBase > import qualified Exception (assert) assertionMessage = "HUnitTestExc.lhs:13: Assertion failed\n" assertion = Exception.assert False (return ()) > main = runTestTT (test [baseTests, excTests]) > excTests = test [ -- Hugs and GHC don't currently catch arithmetic exceptions. "div by 0" ~: expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), -- GHC doesn't currently catch array-related exceptions. "array ref out of bounds" ~: expectUnspecifiedError (TestCase (... `seq` return ())), > "error" ~: > expectError "error" (TestCase (error "error")), > "tail []" ~: > expectUnspecifiedError (TestCase (tail [] `seq` return ())) -- Hugs doesn't provide `assert`. "assert" ~: expectError assertionMessage (TestCase assertion) > ] hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/HUnitText.lhs0000644006511100651110000001210110504340326023413 0ustar rossrossHUnitText.lhs -- text-based test controller $Id: HUnitText.lhs,v 1.9 2002/02/21 16:50:27 heringto Exp $ > module HUnitText > ( > PutText(..), > putTextToHandle, putTextToShowS, > runTestText, > showPath, showCounts, > runTestTT > ) > where > import HUnitBase > import Monad (when) > import IO (Handle, stderr, hPutStr, hPutStrLn) As the general text-based test controller (`runTestText`) executes a test, it reports each test case start, error, and failure by constructing a string and passing it to the function embodied in a `PutText`. A report string is known as a "line", although it includes no line terminator; the function in a `PutText` is responsible for terminating lines appropriately. Besides the line, the function receives a flag indicating the intended "persistence" of the line: `True` indicates that the line should be part of the final overall report; `False` indicates that the line merely indicates progress of the test execution. Each progress line shows the current values of the cumulative test execution counts; a final, persistent line shows the final count values. The `PutText` function is also passed, and returns, an arbitrary state value (called `st` here). The initial state value is given in the `PutText`; the final value is returned by `runTestText`. > data PutText st = PutText (String -> Bool -> st -> IO st) st Two reporting schemes are defined here. `putTextToHandle` writes report lines to a given handle. `putTextToShowS` accumulates persistent lines for return as a whole by `runTestText`. `putTextToHandle` writes persistent lines to the given handle, following each by a newline character. In addition, if the given flag is `True`, it writes progress lines to the handle as well. A progress line is written with no line termination, so that it can be overwritten by the next report line. As overwriting involves writing carriage return and blank characters, its proper effect is usually only obtained on terminal devices. > putTextToHandle :: Handle -> Bool -> PutText Int > putTextToHandle handle showProgress = PutText put initCnt > where > initCnt = if showProgress then 0 else -1 > put line pers (-1) = do when pers (hPutStrLn handle line); return (-1) > put line True cnt = do hPutStrLn handle (erase cnt ++ line); return 0 > put line False cnt = do hPutStr handle ('\r' : line); return (length line) > -- The "erasing" strategy with a single '\r' relies on the fact that the > -- lengths of successive summary lines are monotonically nondecreasing. > erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" `putTextToShowS` accumulates persistent lines (dropping progess lines) for return by `runTestText`. The accumulated lines are represented by a `ShowS` (`String -> String`) function whose first argument is the string to be appended to the accumulated report lines. > putTextToShowS :: PutText ShowS > putTextToShowS = PutText put id > where put line pers f = return (if pers then acc f line else f) > acc f line tail = f (line ++ '\n' : tail) `runTestText` executes a test, processing each report line according to the given reporting scheme. The reporting scheme's state is threaded through calls to the reporting scheme's function and finally returned, along with final count values. > runTestText :: PutText st -> Test -> IO (Counts, st) > runTestText (PutText put us) t = do > (counts, us') <- performTest reportStart reportError reportFailure us t > us'' <- put (showCounts counts) True us' > return (counts, us'') > where > reportStart ss us = put (showCounts (counts ss)) False us > reportError = reportProblem "Error:" "Error in: " > reportFailure = reportProblem "Failure:" "Failure in: " > reportProblem p0 p1 msg ss us = put line True us > where line = "### " ++ kind ++ path' ++ '\n' : msg > kind = if null path' then p0 else p1 > path' = showPath (path ss) `showCounts` converts test execution counts to a string. > showCounts :: Counts -> String > showCounts Counts{ cases = cases, tried = tried, > errors = errors, failures = failures } = > "Cases: " ++ show cases ++ " Tried: " ++ show tried ++ > " Errors: " ++ show errors ++ " Failures: " ++ show failures `showPath` converts a test case path to a string, separating adjacent elements by ':'. An element of the path is quoted (as with `show`) when there is potential ambiguity. > showPath :: Path -> String > showPath [] = "" > showPath nodes = foldl1 f (map showNode nodes) > where f b a = a ++ ":" ++ b > showNode (ListItem n) = show n > showNode (Label label) = safe label (show label) > safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s `runTestTT` provides the "standard" text-based test controller. Reporting is made to standard error, and progress reports are included. For possible programmatic use, the final counts are returned. The "TT" in the name suggests "Text-based reporting to the Terminal". > runTestTT :: Test -> IO Counts > runTestTT t = do (counts, 0) <- runTestText (putTextToHandle stderr True) t > return counts hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/src/TerminalTest.lhs0000644006511100651110000000114110504340326024134 0ustar rossrossTerminalTest.lhs > import Terminal > import HUnit > main = runTestTT tests > try lab inp exp = lab ~: terminalAppearance inp ~?= exp > tests = test [ > try "empty" "" "", > try "end in \\n" "abc\ndef\n" "abc\ndef\n", > try "not end in \\n" "abc\ndef" "abc\ndef", > try "return 1" "abc\ndefgh\rxyz" "abc\nxyzgh", > try "return 2" "\nabcdefgh\rijklm\rxy\n" "\nxyklmfgh\n", > try "return 3" "\r\rabc\r\rdef\r\r\r\nghi\r\r\n" "def\nghi\n", > try "back 1" "abc\bdef\b\bgh\b" "abdgh", > try "back 2" "abc\b\b\bdef\b\bxy\b\b\n" "dxy\n" > -- \b at beginning of line > -- nonprinting char > ] hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/HUnitTester.hs0000644006511100651110000000020510504340326022774 0ustar rossrossmodule Main where import HUnit main :: IO () main = do runTestTT $ TestCase $ assertBool "foo!" True putStrLn "Works :)" hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/License0000644006511100651110000000272410504340326021537 0ustar rossrossHUnit is Copyright (c) Dean Herington, 2002, all rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions, and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions, and the following disclaimer in the documentation and/or other materials provided with the distribution. - The names of the copyright holders may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/Makefile0000644006511100651110000000002410504340326021661 0ustar rossrossinclude ../Tests.mk hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/README0000644006511100651110000000076110504340326021111 0ustar rossrossHUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java. HUnit is free software; see its "License" file for details. HUnit is available at . HUnit 1.0 consists of a number of files. Besides Haskell source files (whose names end in ".hs" or ".lhs"), these files include: * README -- this file * Guide.html -- user's guide, in HTML format * License -- license for use of HUnit See the user's guide for more information. hugs98-plus-Sep2006/packages/Cabal/tests/HUnit-1.0/Setup.lhs0000644006511100651110000000015410504340326022035 0ustar rossross#!/usr/bin/runhugs > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/tests/buildInfo/0000755006511100651110000000000010504340326020615 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/buildInfo/src/0000755006511100651110000000000010504340326021404 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/buildInfo/src/exe1.hs0000644006511100651110000000006510504340326022603 0ustar rossrossmodule Main () where main :: IO () main = return () hugs98-plus-Sep2006/packages/Cabal/tests/buildInfo/src/exe2.hs0000644006511100651110000000006510504340326022604 0ustar rossrossmodule Main () where main :: IO () main = return () hugs98-plus-Sep2006/packages/Cabal/tests/buildInfo/Makefile0000644006511100651110000000002410504340326022251 0ustar rossrossinclude ../Tests.mk hugs98-plus-Sep2006/packages/Cabal/tests/buildInfo/Setup.lhs0000644006511100651110000000014410504340326022424 0ustar rossross#!/usr/bin/runhaskell > import Distribution.Simple > main = defaultMainWithHooks defaultUserHooks hugs98-plus-Sep2006/packages/Cabal/tests/buildInfo/buildinfo2.buildinfo0000644006511100651110000000010310504340326024541 0ustar rossrossExecutable: exe1 Buildable: True Executable: exe2 Buildable: True hugs98-plus-Sep2006/packages/Cabal/tests/buildInfo/buildinfo2.cabal0000644006511100651110000000055310504340326023641 0ustar rossrossName: buildinfo2 Version: 0.0 License: GPL License-file: COPYING Build-Depends: base Author: Evgeny Chukreev Copyright: Evgeny Chukreev (C) 2005 Maintainer: Evgeny Chukreev Synopsis: Buildinfo testcase Description: Buildinfo testcase Executable: exe1 Main-is: exe1.hs HS-source-dirs: src Executable: exe2 Main-is: exe2.hs HS-source-dirs: src hugs98-plus-Sep2006/packages/Cabal/tests/ModuleTest.hs0000644006511100651110000005601010504340326021325 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Distribution.ModuleTest -- Copyright : Isaac Jones 2003-2004 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : GHC -- -- Explanation: Test this module and sub modules. {- All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Isaac Jones nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Main where #ifdef DEBUG -- Import everything, since we want to test the compilation of them: import qualified Distribution.Version as D.V (hunitTests) -- import qualified Distribution.InstalledPackageInfo(hunitTests) import qualified Distribution.License as D.L import qualified Distribution.Compiler as D.C (hunitTests) import qualified Distribution.Make () import qualified Distribution.Package as D.P () import qualified Distribution.PackageDescription as D.PD (hunitTests) import qualified Distribution.Setup as D.Setup (hunitTests) import Distribution.Compiler (CompilerFlavor(..), Compiler(..)) import Distribution.Version (Version(..)) import qualified Distribution.Simple as D.S (simpleHunitTests) import qualified Distribution.Simple.Install as D.S.I (hunitTests) import qualified Distribution.Simple.Build as D.S.B (hunitTests) import qualified Distribution.Simple.SrcDist as D.S.S (hunitTests) import qualified Distribution.Simple.Utils as D.S.U (hunitTests) import Distribution.Compat.FilePath(joinFileName) import qualified Distribution.Simple.Configure as D.S.C (hunitTests, localBuildInfoFile) import qualified Distribution.Simple.Register as D.S.R (hunitTests, installedPkgConfigFile) import qualified Distribution.Simple.GHCPackageConfig as GHC (localPackageConfig, maybeCreateLocalPackageConfig) import Distribution.Simple.Configure (configCompiler) -- base import Data.List (intersperse) import Control.Monad(when, unless) import Directory(setCurrentDirectory, doesFileExist, doesDirectoryExist, getCurrentDirectory, getPermissions, Permissions(..)) import Distribution.Compat.Directory (removeDirectoryRecursive) import System.Cmd(system) import System.Exit(ExitCode(..)) import System.Environment (getArgs) import HUnit(runTestTT, Test(..), Counts(..), assertBool, assertEqual, Assertion, showCounts) -- ------------------------------------------------------------ -- * Helpers -- ------------------------------------------------------------ combineCounts :: Counts -> Counts -> Counts combineCounts (Counts a b c d) (Counts a' b' c' d') = Counts (a + a') (b + b') (c + c') (d + d') label :: String -> String label t = "-= " ++ t ++ " =-" runTestTT' :: Test -> IO Counts runTestTT' t@(TestList _) = runTestTT t runTestTT' (TestLabel l t) = putStrLn (label l) >> runTestTT t runTestTT' t = runTestTT t checkTargetDir :: FilePath -> [String] -- ^suffixes -> IO () checkTargetDir targetDir suffixes = do doesDirectoryExist targetDir >>= assertBool "target dir exists" let mods = ["A", "B/A"] allFilesE <- mapM anyExists [[(targetDir ++ t ++ y) | y <- suffixes] | t <- mods] sequence [assertBool ("target file missing: " ++ targetDir ++ f) e | (e, f) <- zip allFilesE mods] return () where anyExists :: [FilePath] -> IO Bool anyExists l = do l' <- mapM doesFileExist l return $ any (== True) l' -- |Run this command, and assert it returns a successful error code. assertCmd :: String -- ^Command -> String -- ^Comment -> Assertion assertCmd command comment = system command >>= assertEqual (command ++ ":" ++ comment) ExitSuccess -- |like assertCmd, but separates command and args assertCmd' :: String -- ^Command -> String -- ^args -> String -- ^Comment -> Assertion assertCmd' command args comment = system (command ++ " "++ args ++ ">>out.build") >>= assertEqual (command ++ ":" ++ comment) ExitSuccess -- |Run this command, and assert it returns an unsuccessful error code. assertCmdFail :: String -- ^Command -> String -- ^Comment -> Assertion assertCmdFail command comment = do code <- system command assertBool (command ++ ":" ++ comment) (code /= ExitSuccess) -- ------------------------------------------------------------ -- * Integration Tests -- ------------------------------------------------------------ tests :: FilePath -- ^Currdir -> CompilerFlavor -- ^build setup with compiler -> CompilerFlavor -- ^configure with which compiler -> Version -- ^version of the compiler to use -> [Test] tests currDir comp compConf compVersion = [ -- executableWithC TestLabel ("package exeWithC: " ++ compIdent) $ TestCase $ do let targetDir =",tmp" setCurrentDirectory $ (testdir `joinFileName` "exeWithC") testPrelude assertConfigure targetDir assertClean assertConfigure targetDir assertBuild assertCopy assertCmd ",tmp/bin/tt" "exeWithC failed" -- A ,TestLabel ("package A: " ++ compIdent) $ TestCase $ do let targetDir=",tmp" setCurrentDirectory $ (testdir `joinFileName` "A") testPrelude assertConfigure targetDir assertHaddock assertBuild when (comp == GHC) -- are these tests silly? (do doesDirectoryExist "dist/build" >>= assertBool "dist/build doesn't exist" doesFileExist "dist/build/testA/testA" >>= assertBool "build did not create the executable: testA" doesFileExist "dist/build/testB/testB" >>= assertBool "build did not create the executable: testB" doesFileExist "dist/build/testA/testA-tmp/c_src/hello.o" >>= assertBool "build did not build c source for testA" doesFileExist "dist/build/hello.o" >>= assertBool "build did not build c source for A library" ) assertCopy libForA targetDir doesFileExist ",tmp/bin/testA" >>= assertBool "testA not produced" doesFileExist ",tmp/bin/testB" >>= assertBool "testB not produced" assertCmd' compCmd "sdist" "setup sdist returned error code" doesFileExist "dist/test-1.0.tar.gz" >>= assertBool "sdist did not put the expected file in place" doesFileExist "dist/src" >>= assertEqual "dist/src exists" False assertCmd' compCmd "register --user" "pkg A, register failed" assertCmd' compCmd "unregister --user" "pkg A, unregister failed" -- tricky, script-based register registerAndExecute comp "pkg A: register with script failed" unregisterAndExecute comp "pkg A: unregister with script failed" -- non-trick non-script based register assertCmd' compCmd "register --user" "regular register returned error" assertCmd' compCmd "unregister --user" "regular unregister returned error" ,TestLabel ("package A copy-prefix: " ++ compIdent) $ TestCase $ -- (uses above config) do let targetDir = ",tmp2" assertCmd' compCmd ("copy --copy-prefix=" ++ targetDir) "copy --copy-prefix failed" doesFileExist ",tmp2/bin/testA" >>= assertBool "testA not produced" doesFileExist ",tmp2/bin/testB" >>= assertBool "testB not produced" libForA ",tmp2" ,TestLabel ("package A and install w/ no prefix: " ++ compIdent) $ TestCase $ do let targetDir = ",tmp/lib/test-1.0/ghc-6.4" -- FIX: Compiler-version removeDirectoryRecursive ",tmp" when (comp == GHC) -- FIX: hugs can't do --user yet (do system $ "ghc-pkg unregister --user test-1.0" assertCmd' compCmd "install --user" "install --user failed" libForA ",tmp" assertCmd' compCmd "unregister --user" "unregister failed") -- HUnit ,TestLabel ("testing the HUnit package" ++ compIdent) $ TestCase $ do setCurrentDirectory $ (testdir `joinFileName` "HUnit-1.0") GHC.maybeCreateLocalPackageConfig system "make clean" system "make" assertCmd' compCmd "configure" "configure failed" system "setup unregister --user" system $ "touch " ++ D.S.C.localBuildInfoFile system $ "touch " ++ D.S.R.installedPkgConfigFile doesFileExist D.S.C.localBuildInfoFile >>= assertBool ("touch " ++ D.S.C.localBuildInfoFile ++ " failed") -- Test clean: assertBuild doesDirectoryExist "dist/build" >>= assertBool "HUnit build did not create build directory" assertCmd' compCmd "clean" "hunit clean" doesDirectoryExist "dist/build" >>= assertEqual "HUnit clean did not get rid of build directory" False doesFileExist D.S.C.localBuildInfoFile >>= assertEqual ("clean " ++ D.S.C.localBuildInfoFile ++ " failed") False doesFileExist D.S.R.installedPkgConfigFile >>= assertEqual ("clean " ++ D.S.R.installedPkgConfigFile ++ " failed") False assertConfigure ",tmp" assertHaddock doesDirectoryExist "dist/doc" >>= assertEqual "create of dist/doc" True assertBuild when (comp == GHC) -- tests building w/ an installed -package (do pkgConf <- GHC.localPackageConfig assertCmd' compCmd "install --user" "hunit install" assertCmd ("ghc -package-conf " ++ pkgConf ++ " -package HUnitTest HUnitTester.hs -o ./hunitTest") "compile w/ hunit" assertCmd "./hunitTest" "hunit test" assertCmd' compCmd "unregister --user" "unregister failed") assertClean doesDirectoryExist "dist/doc" >>= assertEqual "clean dist/doc" False assertCmd "make clean" "make clean failed" -- twoMains ,TestLabel ("package twoMains: building " ++ compIdent) $ TestCase $ do setCurrentDirectory $ (testdir `joinFileName` "twoMains") testPrelude assertConfigure ",tmp" assertCmd' compCmd "haddock" "setup haddock returned error code." assertBuild assertCopy doesFileExist ",tmp/bin/testA" >>= assertBool "install did not create the executable: testA" doesFileExist ",tmp/bin/testB" >>= assertBool "install did not create the executable: testB" assertCmd "./,tmp/bin/testA isA" "A is not A" assertCmd "./,tmp/bin/testB isB" "B is not B" -- no register, since there's no library -- buildinfo ,TestLabel ("buildinfo with multiple executables " ++ compIdent) $ TestCase $ do setCurrentDirectory $ (testdir `joinFileName` "buildInfo") testPrelude assertConfigure ",tmp" assertCmd' compCmd "haddock" "setup haddock returned error code." assertBuild assertCopy doesFileExist ",tmp/bin/exe1" >>= assertBool "install did not create the executable: exe1" doesFileExist ",tmp/bin/exe2" >>= assertBool "install did not create the executable: exe2" -- no register, since there's no library -- mutually recursive modules ,TestLabel ("package recursive: building " ++ compIdent) $ TestCase $ when (comp == GHC) (do setCurrentDirectory $ (testdir `joinFileName` "recursive") testPrelude assertConfigure ",tmp" assertBuild assertCopy doesFileExist "dist/build/A.hi-boot" >>= assertBool "build did not move A.hi-boot file into place lib" doesFileExist (",tmp/lib/recursive-1.0/ghc-" ++ compVerStr ++ "/libHSrecursive-1.0.a") >>= assertBool "recursive build didn't create library" doesFileExist "dist/build/testExe/testExe-tmp/A.hi" >>= assertBool "build did not move A.hi-boot file into place exe" doesFileExist "dist/build/testExe/testExe" >>= assertBool "recursive build didn't create binary") -- linking in ffi stubs ,TestLabel ("package ffi: " ++ compIdent) $ TestCase $ do setCurrentDirectory (testdir `joinFileName` "ffi-package") testPrelude assertConfigure "/tmp" assertBuild -- install it so we can test building with it. assertCmd' compCmd "install --user" "ffi-package install" assertClean doesFileExist "src/TestFFI_stub.c" >>= assertEqual "FFI-generated stub not cleaned." False -- now build something that depends on it setCurrentDirectory (".." `joinFileName` "ffi-bin") testPrelude assertConfigure ",tmp" assertBuild assertCopy -- depOnLib ,TestLabel ("package depOnLib: (executable depending on its lib)"++ compIdent) $ TestCase $ do setCurrentDirectory $ (testdir `joinFileName` "depOnLib") testPrelude assertConfigure ",tmp" assertHaddock assertBuild assertCopy registerAndExecute comp "pkg depOnLib: register with script failed" unregisterAndExecute comp "pkg DepOnLib: unregister with script failed" when (comp == GHC) (do doesFileExist "dist/build/mainForA/mainForA" >>= assertBool "build did not create the executable: mainForA" doesFileExist ("dist/build/" `joinFileName` "libHStest-1.0.a") >>= assertBool "library doesn't exist" doesFileExist (",tmp/bin/mainForA") >>= assertBool "installed bin doesn't exist" doesFileExist (",tmp/lib/test-1.0/ghc-" ++ compVerStr ++ "/libHStest-1.0.a") >>= assertBool "installed lib doesn't exist") -- wash2hs ,TestLabel ("testing the wash2hs package" ++ compIdent) $ TestCase $ do setCurrentDirectory $ (testdir `joinFileName` "wash2hs") testPrelude assertCmdFail (compCmd ++ " configure --someUnknownFlag") "wash2hs configure with unknown flag" assertConfigure ",tmp" assertHaddock assertBuild assertCopy -- no library to register doesFileExist ",tmp/bin/wash2hs" >>= assertBool "wash2hs didn't put executable into place." perms <- getPermissions ",tmp/bin/wash2hs" assertBool "wash2hs isn't +x" (executable perms) assertClean -- no unregister, because it has no libs! -- withHooks ,TestLabel ("package withHooks: "++compIdent) $ TestCase $ do setCurrentDirectory $ (testdir `joinFileName` "withHooks") testPrelude assertCmd' compCmd ("configure --prefix=,tmp --woohoo " ++ compFlag) "configure returned error code" assertCmdFail (compCmd ++ " test --asdf") "test was supposed to fail" assertCmd' compCmd ("test --pass") "test should not have failed" assertHaddock assertBuild assertCmd' compCmd "copy --copy-prefix=,tmp" "copy w/ prefix" doesFileExist ",tmp/withHooks" >>= -- this file is added w/ the hook. assertBool "hooked copy, redirecting prefix didn't work." assertCmd' compCmd "register --user" "regular register returned error" assertCmd' compCmd "unregister --user" "regular unregister returned error" when (comp == GHC) -- FIX: come up with good test for Hugs (do doesFileExist "dist/build/C.o" >>= assertBool "C.testSuffix did not get compiled to C.o." doesFileExist "dist/build/D.o" >>= assertBool "D.gc did not get compiled to D.o this is an overriding test" doesFileExist (",tmp/lib/withHooks-1.0/ghc-" ++ compVerStr ++ "/" `joinFileName` "libHSwithHooks-1.0.a") >>= assertBool "library doesn't exist") doesFileExist ",tmp/bin/withHooks" >>= assertBool "copy did not create the executable: withHooks" assertClean doesFileExist "C.hs" >>= assertEqual "C.hs (a generated file) not cleaned." False -- HSQL {- ,TestLabel ("package HSQL (make-based): " ++ show compIdent) $ TestCase $ unless (compFlag == "--hugs") $ -- FIX: won't compile w/ hugs do setCurrentDirectory $ (testdir `joinFileName` "HSQL") system "make distclean" system "rm -rf /tmp/lib/HSQL" when (comp == GHC) (system "ghc -cpp --make -i../.. Setup.lhs -o setup 2>out.build" >> return()) assertConfigure "/tmp" doesFileExist "config.mk" >>= assertBool "config.mk not generated after configure" assertBuild assertCopy when (comp == GHC) -- FIX: do something for hugs (doesFileExist "/tmp/lib/HSQL/GHC/libHSsql.a" >>= assertBool "libHSsql.a doesn't exist. copy failed.")-} ] where testdir = currDir `joinFileName` "tests" compStr = show comp compVerStr = concat . intersperse "." . map show . versionBranch $ compVersion compCmd = command comp compFlag = case compConf of GHC -> "--ghc" Hugs -> "--hugs" compIdent = compStr ++ "/" ++ compFlag testPrelude = system "make clean >> out.build" >> system "make >> out.build" assertConfigure pref = assertCmd' compCmd ("configure --user --prefix=" ++ pref ++ " " ++ compFlag) "configure returned error code" assertBuild = assertCmd' compCmd "build" "build returned error code" assertCopy = assertCmd' compCmd "copy" "copy returned error code" assertClean = assertCmd' compCmd "clean" "clean returned error code" assertHaddock = assertCmd' compCmd "haddock" "setup haddock returned error code." command GHC = "./setup" command Hugs = "runhugs -98 Setup.lhs" libForA pref -- checks to see if the lib exists, for tests/A = let ghcTargetDir = pref ++ "/lib/test-1.0/ghc-" ++ compVerStr ++ "/" in case compConf of Hugs -> checkTargetDir (pref ++ "/lib/hugs/packages/test/") [".hs", ".lhs"] GHC -> do checkTargetDir ghcTargetDir [".hi"] doesFileExist (ghcTargetDir `joinFileName` "libHStest-1.0.a") >>= assertBool "library doesn't exist" dumpScriptFlag = "--gen-script" registerAndExecute comp comment = do assertCmd' compCmd ("register --user "++dumpScriptFlag) comment if comp == GHC then assertCmd' "./register.sh" "" "reg script failed" else do ex <- doesFileExist "register.sh" assertBool "hugs should not produce register.sh" (not ex) unregisterAndExecute comp comment = do assertCmd' compCmd ("unregister --user "++dumpScriptFlag) comment if comp == GHC then assertCmd' "./unregister.sh" "" "reg script failed" else do ex <- doesFileExist "unregister.sh" assertBool "hugs should not produce unregister.sh" (not ex) main :: IO () main = do putStrLn "compile successful" putStrLn "-= Setup Tests =-" setupCount <- runTestTT' $ TestList $ (TestLabel "Utils Tests" $ TestList D.S.U.hunitTests): (TestLabel "Setup Tests" $ TestList D.Setup.hunitTests): (TestLabel "config Tests" $ TestList D.S.C.hunitTests): (D.S.R.hunitTests ++ D.V.hunitTests ++ D.S.S.hunitTests ++ D.S.B.hunitTests ++ D.S.I.hunitTests ++ D.S.simpleHunitTests ++ D.PD.hunitTests ++ D.C.hunitTests) dir <- getCurrentDirectory -- count' <- runTestTT' $ TestList (tests dir Hugs GHC) args <- getArgs let testList :: CompilerFlavor -> Version -> [Test] testList compiler version | null args = tests dir compiler compiler version | otherwise = case reads (head args) of [(n,_)] -> [ tests dir compiler compiler version !! n ] _ -> error "usage: moduleTest [test_num]" compilers = [GHC] --, Hugs] globalTests <- flip mapM compilers $ \compilerFlavour -> do compiler <- configCompiler (Just compilerFlavour) Nothing Nothing 0 let version = compilerVersion compiler runTestTT' $ TestList (testList compilerFlavour version) putStrLn "-------------" putStrLn "Test Summary:" putStrLn $ showCounts $ foldl1 combineCounts (setupCount:globalTests) return () #endif -- Local Variables: -- compile-command: "ghc -i../:/usr/local/src/HUnit-1.0 -Wall --make ModuleTest.hs -o moduleTest" -- End: hugs98-plus-Sep2006/packages/Cabal/tests/Tests.mk0000644006511100651110000000077310504340326020344 0ustar rossross#HC=/tmp/ghc/bin/ghc HC=ghc setup: Setup.lhs $(HC) -cpp --make -i../.. Setup.lhs -o setup 2>out.build clean: rm -f setup a.out .setup-config register.sh unregister.sh out.build rm -rf ,tmp* dist find . -name "*.o" |xargs rm -f find . -name "*.hi" |xargs rm -f find . -name "*~" | xargs rm -f check: setup ./setup configure --user --prefix=/tmp/foo ./setup build ./setup install --install-prefix=/tmp/bar ls /tmp/bar* # install w/ register! ./setup install # ls /tmp/foo* ./setup sdist ls dist hugs98-plus-Sep2006/packages/Cabal/tests/depOnLib/0000755006511100651110000000000010504340326020376 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/depOnLib/libs/0000755006511100651110000000000010504340326021327 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/depOnLib/libs/A.hs0000644006511100651110000000004210504340326022037 0ustar rossrossmodule A where a :: Char a = 'a' hugs98-plus-Sep2006/packages/Cabal/tests/depOnLib/Makefile0000644006511100651110000000002410504340326022032 0ustar rossrossinclude ../Tests.mk hugs98-plus-Sep2006/packages/Cabal/tests/depOnLib/Setup.lhs0000644006511100651110000000015410504340326022206 0ustar rossross#!/usr/bin/runhugs > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/tests/depOnLib/mains/0000755006511100651110000000000010504340326021505 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/depOnLib/mains/Main.hs0000644006511100651110000000007310504340326022725 0ustar rossrossmodule Main where import A main = putStrLn "Hello, cabal."hugs98-plus-Sep2006/packages/Cabal/tests/depOnLib/test.cabal0000644006511100651110000000042010504340326022335 0ustar rossrossName: test Version: 1.0 hs-source-dir: libs copyright: filler for test suite maintainer: filler for test suite synopsis: filler for test suite build-depends: base exposed-modules: A Executable: mainForA Other-Modules: Main, A hs-source-dirs: mains, libs Main-is: Main.hs hugs98-plus-Sep2006/packages/Cabal/tests/exeWithC/0000755006511100651110000000000010504340326020422 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/exeWithC/Makefile0000644006511100651110000000002410504340326022056 0ustar rossrossinclude ../Tests.mk hugs98-plus-Sep2006/packages/Cabal/tests/exeWithC/Setup.lhs0000644006511100651110000000011410504340326022226 0ustar rossross> import Distribution.Simple > main = defaultMainWithHooks defaultUserHooks hugs98-plus-Sep2006/packages/Cabal/tests/exeWithC/a.c0000644006511100651110000000003710504340326021006 0ustar rossrossint foo(int v) { return 2*v; } hugs98-plus-Sep2006/packages/Cabal/tests/exeWithC/test.hs0000644006511100651110000000013510504340326021734 0ustar rossross{-# CFILES a.c #-} foreign import ccall unsafe "foo" foo :: Int -> Int main = print $ foo 6 hugs98-plus-Sep2006/packages/Cabal/tests/exeWithC/tt.cabal0000644006511100651110000000054210504340326022036 0ustar rossrossName: tt Version: 0.0 Copyright: Einar Karttunen Maintainer: Isaac Jones Synopsis: Provided as a test. License: BSD3 Author: This Test Case Contributed by: Einar Karttunen Thanks! Build-Depends: base Executable: tt Main-Is: test.hs C-Sources: a.c Extensions: ForeignFunctionInterface hugs98-plus-Sep2006/packages/Cabal/tests/ffi-bin/0000755006511100651110000000000010504340326020214 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/ffi-bin/Main.hs0000644006511100651110000000011110504340326021425 0ustar rossrossmodule Main where import TestFFI main :: IO () main = putStrLn "test" hugs98-plus-Sep2006/packages/Cabal/tests/ffi-bin/Makefile0000644006511100651110000000002410504340326021650 0ustar rossrossinclude ../Tests.mk hugs98-plus-Sep2006/packages/Cabal/tests/ffi-bin/Setup.lhs0000644006511100651110000000011610504340326022022 0ustar rossross#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/tests/ffi-bin/main.cabal0000644006511100651110000000017110504340326022123 0ustar rossrossName: test-bin Build-Depends: base, testffi Version: 0.0 Executable: test Main-Is: Main.hs hugs98-plus-Sep2006/packages/Cabal/tests/ffi-package/0000755006511100651110000000000010504340326021037 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/ffi-package/src/0000755006511100651110000000000010504340326021626 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/ffi-package/src/TestFFI.hs0000644006511100651110000000020710504340326023425 0ustar rossrossmodule TestFFI where import Foreign type Action = IO () foreign import ccall "wrapper" mkAction :: Action -> IO (FunPtr Action) hugs98-plus-Sep2006/packages/Cabal/tests/ffi-package/Makefile0000644006511100651110000000002410504340326022473 0ustar rossrossinclude ../Tests.mk hugs98-plus-Sep2006/packages/Cabal/tests/ffi-package/Setup.lhs0000644006511100651110000000011310504340326022642 0ustar rossross#! /usr/bin/env runhugs > import Distribution.Simple > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/tests/ffi-package/TestFFIExe.hs0000644006511100651110000000024410504340326023301 0ustar rossrossmodule Main where import Foreign type Action = IO () foreign import ccall "wrapper" mkAction :: Action -> IO (FunPtr Action) main :: IO () main = return () hugs98-plus-Sep2006/packages/Cabal/tests/ffi-package/testffi.cabal0000644006511100651110000000036010504340326023466 0ustar rossrossName: testffi Version: 0.0 Build-Depends: base hs-source-dir: src Exposed-modules: TestFFI Extensions: ForeignFunctionInterface executable: foo main-is: TestFFIExe.hs Extensions: ForeignFunctionInterface hugs98-plus-Sep2006/packages/Cabal/tests/recursive/0000755006511100651110000000000010504340326020711 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/recursive/A.hi-boot0000644006511100651110000000005610504340326022355 0ustar rossrossmodule A where newtype TA = MkTA GHC.Base.Int hugs98-plus-Sep2006/packages/Cabal/tests/recursive/A.hs0000644006511100651110000000014110504340326021421 0ustar rossrossmodule A where import B( TB(..) ) newtype TA = MkTA Int f :: TB -> TA f (MkTB x) = MkTA x hugs98-plus-Sep2006/packages/Cabal/tests/recursive/A.hs-boot0000644006511100651110000000004510504340326022365 0ustar rossrossmodule A where newtype TA = MkTA Int hugs98-plus-Sep2006/packages/Cabal/tests/recursive/B.hs0000644006511100651110000000015610504340326021430 0ustar rossrossmodule B where import {-# SOURCE #-} A( TA(..) ) data TB = MkTB !Int g :: TA -> TB g (MkTA x) = MkTB x hugs98-plus-Sep2006/packages/Cabal/tests/recursive/C.hs0000644006511100651110000000021510504340326021425 0ustar rossrossmodule Main where import B import A -- FIX: GHC doesn't seem to figure out this dependency?! main :: IO () main = let f = g in putStrLn "C" hugs98-plus-Sep2006/packages/Cabal/tests/recursive/Makefile0000644006511100651110000000002410504340326022345 0ustar rossrossinclude ../Tests.mk hugs98-plus-Sep2006/packages/Cabal/tests/recursive/Setup.lhs0000644006511100651110000000016310504340326022521 0ustar rossross#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/tests/recursive/recursive.cabal0000644006511100651110000000034110504340326023702 0ustar rossrossname: recursive build-depends: base version: 1.0 copyright: filler for test suite maintainer: Isaac Jones synopsis: this package is really awesome. Exposed-Modules: A, B Executable: testExe Main-is: C.hs other-modules: A, B hugs98-plus-Sep2006/packages/Cabal/tests/twoMains/0000755006511100651110000000000010504340326020503 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/twoMains/MainA.hs0000644006511100651110000000027310504340326022026 0ustar rossrossmodule Main where import System import Control.Monad(when) main = do print 'a' args <- getArgs let isB = head args when (isB /= "isA") (error "A is not A!") hugs98-plus-Sep2006/packages/Cabal/tests/twoMains/MainB.hs0000644006511100651110000000027410504340326022030 0ustar rossrossmodule Main where import System import Control.Monad (when) main = do print 'b' args <- getArgs let isB = head args when (isB /= "isB") (error "B is not B!") hugs98-plus-Sep2006/packages/Cabal/tests/twoMains/Makefile0000644006511100651110000000002410504340326022137 0ustar rossrossinclude ../Tests.mk hugs98-plus-Sep2006/packages/Cabal/tests/twoMains/Setup.lhs0000644006511100651110000000015410504340326022313 0ustar rossross#!/usr/bin/runhugs > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hugs98-plus-Sep2006/packages/Cabal/tests/twoMains/test.cabal0000644006511100651110000000041610504340326022447 0ustar rossrossName: test Version: 1.0 copyright: filler for test suite maintainer: filler for test suite build-depends: base, haskell98 synopsis: filler for test suite Executable: testA Other-Modules: MainA Main-is: MainA.hs Executable: testB Other-Modules: MainB Main-is: MainB.hs hugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/0000755006511100651110000000000010504340326020261 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/hs/0000755006511100651110000000000010504340326020673 5ustar rossrosshugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/hs/WASHGenerator.hs0000644006511100651110000000313310504340326023640 0ustar rossrossmodule WASHGenerator (preprocess, preprocessPIPE) where { import List; import IO; import WASHData ; import Parsec hiding (try) ; import qualified WASHParser ; import qualified WASHExpression ; import qualified WASHClean ; import WASHFlags ; -- import Trace; preprocess :: FLAGS -> String -> String -> String -> IO (); preprocess flags srcName dstName globalDefs = bracket (openFile srcName ReadMode) (\ srcHandle -> hClose srcHandle) (\ srcHandle -> bracket (openFile dstName WriteMode) (\ dstHandle -> hClose dstHandle) (\ dstHandle -> preprocessPIPE flags srcName srcHandle dstHandle globalDefs)); preprocessPIPE :: FLAGS -> String -> Handle -> Handle -> String -> IO (); preprocessPIPE flags srcName srcHandle dstHandle globalDefs = do { input <- hGetContents srcHandle; let { parsing = parse WASHParser.washfile srcName input }; case parsing of { Left error -> ioError $ userError $ show error; Right washfile -> hPutStrLn dstHandle (postprocess $ file flags globalDefs washfile ""); }; }; file :: FLAGS -> String -> [CodeFrag] -> ShowS ; file flags globalDefs fcode = WASHExpression.code flags (WASHClean.cleanCodeFragList fcode) . showString globalDefs . showString "\n" ; imports :: [String] -> String ; imports is = concat $ map (\m -> "import " ++ m ++ ";\n") is ; postprocess :: String -> String ; postprocess = unlines . postprocess' . lines ; postprocess' :: [String] -> [String] ; postprocess' [] = [] ; postprocess' xs'@(x:xs) = if "import" `isPrefixOf` x then "import qualified CGI" : xs' else x : postprocess' xs ; } hugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/hs/WASHClean.hs0000644006511100651110000000363610504340326022744 0ustar rossrossmodule WASHClean where import Char import WASHData data CM a = CM ([String] -> a) instance Monad CM where -- Reader monad return x = CM (const x) m >>= f = CM (\strs -> case m of CM mfun -> case f (mfun strs) of CM ffun -> ffun strs) class Clean n where clean :: n -> CM n cleanCodeFragList :: [CodeFrag] -> [CodeFrag] cleanCodeFragList = map g where g (EFrag el) = EFrag (cleanElement el) g (CFrag cs) = CFrag (cleanContentList cs) g cf = cf cleanElement :: Element -> Element cleanElement e@Element{elemName = en, elemContent = ec} = if en == "pre" then e else let ec' = cleanContentList ec in e{elemContent = ec'} cleanContentList :: [Content] -> [Content] cleanContentList = remove . map g . combine where g c = case c of CElement{celem = el} -> CElement{celem = cleanElement el} CText{ctext = et} -> CText{ctext = et { textString = cleanText (textString et) }} CCode{ccode = ec} -> CCode{ccode = cleanCodeFragList ec} _ -> c combine (CText {ctext = t1} : CText {ctext = t2} : rest ) = combine (CText {ctext = Text {textString = textString t1++ textString t2, textMode = textMode t1}} : rest) combine (x : xs) = x : combine xs combine [] = [] remove (CText{ctext = tt} : rest) | textString tt == " " = remove rest -- remove (CText{ctext = tt} : rest@(CElement{} : _)) = CText{ctext = dropRight tt} : remove rest -- remove (e@CElement{} : (CText{ctext = tt} : rest)) = e : remove (CText{ctext = dropLeft tt} : rest) remove (x : rest) = x : remove rest remove [] = [] cleanText "" = "" cleanText xs@[x] | isSpace x = " " | otherwise = xs cleanText (x : ys@(y : _)) | isSpace x = if isSpace y then cleanText ys else ' ' : cleanText ys | otherwise = x : cleanText ys dropRight tt = tt { textString = reverse (dropWhile isSpace (reverse (textString tt))) } dropLeft tt = tt { textString = dropWhile isSpace (textString tt) } hugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/hs/WASHData.hs0000644006511100651110000000250710504340326022567 0ustar rossrossmodule WASHData -- derived from HSPData ( File (..) , Mode (..) , Element (..) , Text (..) , Content (..) , CodeFrag (..) , Attribute (..) , AttrValue (..) ) where { -- Data type. data File = File { fcode :: [CodeFrag], topElem :: Element } deriving Show; data Mode = V | S | F deriving (Eq,Show); data Element = Element { elemMode :: Mode , elemName :: String , elemAttrs :: [Attribute] , elemContent :: [Content] , elemEmptyTag :: Bool } deriving Show; data Text = Text { textMode :: Mode , textString :: String } deriving Show; data Content = CElement { celem :: Element } | CText { ctext :: Text } | CReference { creference :: Text } | CPI { cpi :: String } | CComment { ccomment :: String } | CCode { ccode :: [CodeFrag] } deriving Show; data CodeFrag = HFrag String | EFrag Element | HSFrag String | CFrag [Content] | AFrag [Attribute] | VFrag String deriving Show; data Attribute = Attribute { attrMode :: Mode , attrName :: String , attrValue :: AttrValue } | AttrPattern { attrPattern :: String } deriving Show; data AttrValue = AText String | ACode String deriving Show; data Reference = Reference String deriving Show; } hugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/hs/WASHFlags.hs0000644006511100651110000000015610504340326022750 0ustar rossrossmodule WASHFlags where -- flags0 = FLAGS { generateBT = False } data FLAGS = FLAGS { generateBT :: Bool } hugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/hs/WASHExpression.hs0000644006511100651110000000740410504340326024056 0ustar rossrossmodule WASHExpression where import Monad import WASHFlags import qualified WASHUtil import WASHData import WASHOut code :: FLAGS -> [CodeFrag] -> ShowS code flags [] = id code flags (x:xs) = code' flags x . code flags xs code' :: FLAGS -> CodeFrag -> ShowS code' flags (HFrag h) = showString h code' flags (EFrag e) = runOut $ element flags e code' flags (CFrag cnts) = showChar '(' . runOut (contents flags [] cnts) . showChar ')' code' flags (AFrag attrs) = showChar '(' . WASHUtil.itemList (attribute flags) "CGI.empty" " >> " attrs . showChar ')' code' flags (VFrag var) = id code' flags _ = error "Unknown type: code" outMode :: Mode -> Out () outMode = outShowS . showMode showMode :: Mode -> ShowS showMode V = id showMode S = showString "_T" showMode F = showString "_S" element :: FLAGS -> Element -> Out [String] element flags (Element mode nm ats cnt et) = do outChar '(' outString "CGI." outString nm when (generateBT flags) $ outMode mode outChar '(' outShowS $ attributes flags ats rvs <- contents flags [] cnt outString "))" return rvs outRVS :: [String] -> Out () outRVS [] = outString "()" outRVS (x:xs) = do outChar '(' outString x mapM_ g xs outChar ')' where g x = do { outChar ','; outString x; } outRVSpat :: [String] -> Out () outRVSpat [] = outString "(_)" outRVSpat xs = outRVS xs contents :: FLAGS -> [String] -> [Content] -> Out [String] contents flags inRVS cts = case cts of [] -> do outString "return" outRVS inRVS return inRVS ct:cts -> do rvs <- content flags ct case rvs of [] -> case (cts, inRVS) of ([],[]) -> return [] _ -> do outString " >> " contents flags inRVS cts _ -> case (cts, inRVS) of ([],[]) -> return rvs _ -> do outString " >>= \\ " outRVSpat rvs outString " -> " contents flags (rvs ++ inRVS) cts content :: FLAGS -> Content -> Out [String] content flags (CElement elem) = element flags elem content flags (CText txt) = do text flags txt return [] content flags (CCode (VFrag var:c)) = do outShowS $ (showChar '(' . code flags c . showChar ')') return [var] content flags (CCode c) = do outShowS $ (showChar '(' . code flags c . showChar ')') return [] content flags (CComment cc) = do outShowS $ (showString "return (const () " . shows cc . showChar ')') return [] content flags (CReference txt) = do text flags txt return [] content flags c = error $ "Unknown type: content -- " ++ (show c) text :: FLAGS -> Text -> Out [String] text flags txt = do outString "CGI.rawtext" when (generateBT flags) $ outMode (textMode txt) outChar ' ' outs (textString txt) return [] attributes :: FLAGS -> [Attribute] -> ShowS attributes flags atts = f atts where f [] = id f (att:atts) = attribute flags att . showString " >> " . f atts attribute :: FLAGS -> Attribute -> ShowS attribute flags (Attribute m n v) = showString "(CGI.attr" . (if generateBT flags then (attrvalueBT m v) else id) . showChar ' ' . shows n . showString " " . attrvalue v . showString ")" attribute flags (AttrPattern pat) = showString "( " . showString pat . showString " )" attribute flags a = error $ "Unknown type: attribute -- " ++ (show a) attrvalue :: AttrValue -> ShowS attrvalue (AText t) = shows t attrvalue (ACode c) = showString "( " . showString c . showString " )" attrvalue a = error $ "Unknown type: attrvalue -- " ++ (show a) attrvalueBT :: Mode -> AttrValue -> ShowS attrvalueBT V _ = id attrvalueBT m (AText _) = showMode m . showChar 'S' attrvalueBT m (ACode _) = showMode m . showChar 'D' attrvalueBT m a = error $ "Unknown type: attrvalueBT -- " ++ (show a) hugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/hs/WASHMain.hs0000644006511100651110000000210310504340326022572 0ustar rossrossmodule Main where -- ghc --make WASHMain -package text -o WASHMain import IO import List import System import WASHGenerator import WASHFlags main = do args <- getArgs runPreprocessor flags0 args runPreprocessor flags [washfile] = if ".wash" `isSuffixOf` washfile then preprocess flags washfile (take (length washfile - 5) washfile ++ ".hs") "" else preprocess flags (washfile ++ ".wash") (washfile ++ ".hs") "" runPreprocessor flags [washfile, hsfile] = preprocess flags (washfile) (hsfile) "" runPreprocessor flags [originalFile, washfile, hsfile] = preprocess flags (washfile) (hsfile) "" runPreprocessor flags [] = preprocessPIPE flags "" stdin stdout "" runPreprocessor flags args = do progName <- getProgName hPutStrLn stderr ("Usage: " ++ progName ++ " washfile [hsfile]") hPutStrLn stderr (" or: " ++ progName ++ " originalFile infile outfile") hPutStrLn stderr (" or: " ++ progName) hPutStrLn stderr (" to run as pipe processor") hPutStrLn stderr ("Actual arguments: " ++ show args) hugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/hs/WASHOut.hs0000644006511100651110000000101010504340326022451 0ustar rossrossmodule WASHOut where -- output monad data Out a = Out a ShowS instance Monad Out where return a = Out a id m >>= f = case m of Out x shw1 -> case f x of Out y shw2 -> Out y (shw1 . shw2) runOut :: Out a -> ShowS runOut (Out a shw) = shw wrapper = (Out () .) outString :: String -> Out () outString = wrapper showString outChar :: Char -> Out () outChar = wrapper showChar outs :: Show a => a -> Out () outs = wrapper shows outShowS :: ShowS -> Out () outShowS = Out () hugs98-plus-Sep2006/packages/Cabal/tests/wash2hs/hs/WASHParser.hs0000644006511100651110000002617510504340326023161 0ustar rossrossmodule WASHParser ( xmlfile, washfile ) where { import Char ; import Parsec hiding (letter) ; import WASHData; import WASHUtil; notImplemented = char '\xff' >> return undefined "something that isn't implemented yet"; f <$> p = do { x <- p; return $ f x; }; testParser p s = case parse (do { x <- p; eof; return x; }) "bla" s of { Left x -> print x; Right y -> print y; }; washfile :: Parser [CodeFrag] ; washfile = do code <- hBody eof return $ code ; setMode :: Bool -> Mode ; setMode toplevel = if toplevel then S else F ; -- The numbers given for each parser identify the section and -- grammar production within the XML 1.0 definition (W3C -- REC-xml-19980210). -- 2.1 / 1 xmlfile :: Parser File; xmlfile = do { prolog; code <- option [] (do { hs <- haskell; s0; return hs }); elem <- element True; many misc; eof; return $ File { fcode = code, topElem = elem }; }; -- 2.2 / 2 char' = (char '\t' <|> char '\n' <|> char '\r' <|> satisfy (>= ' ')) "character"; -- 2.3 / 3 s = (try $ many1 (char ' ' <|> char '\t' <|> char '\r' <|> char '\n')) "whitespace"; s0 = option "" s; {- s0 = (try $ many (char ' ' <|> char '\t' <|> char '\r' <|> char '\n')) "optional whitespace"; -} -- 2.3 / 4 nameChar = letter <|> digit <|> char '.' <|> char '-' <|> char '_' <|> char ':' <|> combiningChar <|> extender; -- 2.3 / 5 name :: Parser String; name = do { c <- letter <|> char '_' <|> char ':'; cs <- many nameChar; return $ c:cs; } "name"; -- 2.3 / 6 names :: Parser [String]; names = sepBy1 name s; -- 2.3 / 7 nmtoken :: Parser String; nmtoken = many1 nameChar "nmtoken"; -- 2.3 / 8 nmtokens :: Parser [String]; nmtokens = sepBy1 name s; -- 2.3 / 10 attValue :: Parser AttrValue; attValue = (((AText . concat) <$> ( between (char '\"') (char '\"') (many (p '\"')) <|> between (char '\'') (char '\'') (many (p '\'')) )) <|> ACode <$> haskellAttr) "attvalue" where { p end = (\x -> [x]) <$> satisfy (f end) <|> reference; f end = \c -> c /= '<' && c /= '&' && c /= end; }; -- 2.3 / 11 systemLiteral = do{ char '\''; sl <- many (satisfy (\c -> c /= '\'')); char '\''; return sl; } <|> do{ char '\"'; sl <- many (satisfy (\c -> c /= '\"')); char '\"'; return sl; }; -- 2.3 / 12 pubidLiteral = do { char '\''; sl <- many (pubidChar False); char '\''; return sl; } <|> do{ char '\"'; sl <- many (pubidChar True); char '\"'; return sl; }; -- 2.3 / 13 pubidChar w = satisfy (\c -> c >= 'A' && c <= 'Z' || c >= 'a' && c <= 'z' || c >= '0' && c <= '9' || c `elem` " \n\r-()+,./:=?;!*#@$_%" || w && c == '\''); -- 2.4 / 14 charData :: Bool -> Parser Text; charData toplevel = do { s <- many1 charData'; return $ Text (setMode toplevel) $ concat s; } "#PCDATA"; charData' :: Parser String; charData' = do { c <- satisfy f; return [c]; } <|> do { string "]]"; c <- satisfy (\c -> f c && c /= '>'); return $ ']':']':[c]; } where { f c = c /= '<' && c /= '&' && c /= ']'; }; -- 2.5 / 15 comment :: Parser String; comment = do { try $ string "b e3 = mkGraph (genUNodes 2) [(1,2,"a"),(1,2,"b"),(1,2,"a")] -- three edges (two labels) a-->b loop = ([],1,'a',[((),1)]) & empty -- loop on single node ab = ([((),1)],2,'b',[((),1)]) & a -- cycle of two nodes: a<-->b abb = mkGraph (zip [1..2] "ab") (labUEdges [(2,2)]) -- a and loop on b cyc3 = buildGr -- cycle of three nodes [([("ca",3)],1,'a',[("ab",2)]), ([],2,'b',[("bc",3)]), ([],3,'c',[])] dag3 = mkGraph (zip [1..3] "abc") (labUEdges [(1,3)]) dag4 = mkGraph (genLNodes 1 4) (labUEdges [(1,2),(1,4),(2,3),(2,4),(4,3)]) d1 = mkGraph (genLNodes 1 2) [(1,2,1)] d3 = mkGraph (genLNodes 1 3) [(1,2,1),(1,3,4),(2,3,2)] g3 = ([("left",2),("up",3)],1,'a',[("right",2)]) & ( ([],2,'b',[("down",3)]) & ( ([],3,'c',[]) & empty )) g3b = ([("down",2)], 3,'c',[("up",1)]) & ( ([("right",1)],2,'b',[("left",1)]) & ( ([],1,'a',[]) & empty )) a',b',c',e',loop',ab',abb',dag3' :: IO (SGr Char ()) e3' :: IO (SGr () String) dag4' :: IO (SGr Int ()) d1',d3' :: IO (SGr Int Int) a' = mkGraphM [(1,'a')] noEdges -- just a node b' = mkGraphM (zip [1..2] "ab") noEdges -- just two nodes c' = mkGraphM (zip [1..3] "abc") noEdges -- just three nodes e' = mkGraphM (zip [1..2] "ab") [(1,2,())] -- just one edge a-->b e3' = mkGraphM (genUNodes 2) [(1,2,"a"),(1,2,"b"),(1,2,"a")] -- three edges (two labels) a-->b loop' = mkGraphM [(1,'a')] [(1,1,())] -- loop on single node ab' = mkGraphM (zip [1..2] "ab") [(1,2,()),(2,1,())] -- cycle of two nodes: a<-->b abb' = mkGraphM (zip [1..2] "ab") (labUEdges [(2,2)]) -- a and loop on b dag3' = mkGraphM (zip [1..3] "abc") (labUEdges [(1,3)]) dag4' = mkGraphM (genLNodes 1 4) (labUEdges [(1,2),(1,4),(2,3),(2,4),(4,3)]) d1' = mkGraphM (genLNodes 1 2) [(1,2,1)] d3' = mkGraphM (genLNodes 1 3) [(1,2,1),(1,3,4),(2,3,2)] ucycle :: Graph gr => Int -> gr () () ucycle n = mkUGraph vs (map (\v->(v,v `mod` n+1)) vs) where vs = [1..n] star :: Graph gr => Int -> gr () () star n = mkUGraph [1..n] (map (\v->(1,v)) [2..n]) ucycleM :: GraphM m gr => Int -> m (gr () ()) ucycleM n = mkUGraphM vs (map (\v->(v,v `mod` n+1)) vs) where vs = [1..n] starM :: GraphM m gr => Int -> m (gr () ()) starM n = mkUGraphM [1..n] (map (\v->(1,v)) [2..n]) clr479,clr489 :: Gr Char () clr486 :: Gr String () clr508,clr528 :: Gr Char Int clr595,gr1 :: Gr Int Int kin248 :: Gr Int () vor :: Gr String Int clr479 = mkGraph (genLNodes 'u' 6) (labUEdges [(1,2),(1,4),(2,5),(3,5),(3,6),(4,2),(5,4),(6,6)]) clr486 = mkGraph (zip [1..9] ["shorts","socks","watch","pants","shoes", "shirt","belt","tie","jacket"]) (labUEdges [(1,4),(1,5),(2,5),(4,5),(4,7),(6,7),(6,8),(7,9),(8,9)]) clr489 = mkGraph (genLNodes 'a' 8) (labUEdges [(1,2),(2,3),(2,5),(2,6),(3,4),(3,7),(4,3),(4,8), (5,1),(5,6),(6,7),(7,6),(7,8),(8,8)]) clr508 = mkGraph (genLNodes 'a' 9) [(1,2,4),(1,8,8),(2,3,8),(2,8,11),(3,4,7),(3,6,4),(3,9,2), (4,5,9),(4,6,14),(5,6,10),(6,7,2),(7,8,1),(7,9,6),(8,9,7)] clr528 = mkGraph [(1,'s'),(2,'u'),(3,'v'),(4,'x'),(5,'y')] [(1,2,10),(1,4,5),(2,3,1),(2,4,2),(3,5,4), (4,2,3),(4,3,9),(4,5,2),(5,1,7),(5,3,6)] clr595 = mkGraph (zip [1..6] [1..6]) [(1,2,16),(1,3,13),(2,3,10),(2,4,12),(3,2,4), (3,5,14),(4,3,9),(4,6,20),(5,4,7),(5,6,4)] gr1 = mkGraph (zip [1..10] [1..10]) [(1,2,12),(1,3,1),(1,4,2),(2,3,1),(2,5,7),(2,6,5),(3,6,1), (3,7,7),(4,3,3),(4,6,2),(4,7,5),(5,3,2),(5,6,3),(5,8,3), (6,7,2),(6,8,3),(6,9,1),(7,9,9),(8,9,1),(8,10,4),(9,10,11)] kin248 = mkGraph (genLNodes 1 10) (labUEdges [(1,2),(1,4),(1,7),(2,4),(2,5),(3,4),(3,10), (4,5),(4,8),(5,2),(5,3),(6,7),(7,6),(7,8), (8,10),(9,9),(9,10),(10,8),(10,9)]) -- this is the inverse graph shown on the bottom of the page vor = mkGraph (zip [1..8] ["A","B","C","H1","H2","D","E","F"]) [(1,4,3),(2,3,3),(2,4,3),(4,2,4),(4,6,2), (5,2,5),(5,3,6),(5,7,5),(5,8,6), (6,5,3),(6,7,2),(7,8,3),(8,7,3)] clr479',clr489' :: IO (SGr Char ()) clr486' :: IO (SGr String ()) clr508',clr528' :: IO (SGr Char Int) kin248' :: IO (SGr Int ()) vor' :: IO (SGr String Int) clr479' = mkGraphM (genLNodes 'u' 6) (labUEdges [(1,2),(1,4),(2,5),(3,5),(3,6),(4,2),(5,4),(6,6)]) clr486' = mkGraphM (zip [1..9] ["shorts","socks","watch","pants","shoes", "shirt","belt","tie","jacket"]) (labUEdges [(1,4),(1,5),(2,5),(4,5),(4,7),(6,7),(6,8),(7,9),(8,9)]) clr489' = mkGraphM (genLNodes 'a' 8) (labUEdges [(1,2),(2,3),(2,5),(2,6),(3,4),(3,7),(4,3),(4,8), (5,1),(5,6),(6,7),(7,6),(7,8),(8,8)]) clr508' = mkGraphM (genLNodes 'a' 9) [(1,2,4),(1,8,8),(2,3,8),(2,8,11),(3,4,7),(3,6,4),(3,9,2), (4,5,9),(4,6,14),(5,6,10),(6,7,2),(7,8,1),(7,9,6),(8,9,7)] clr528' = mkGraphM [(1,'s'),(2,'u'),(3,'v'),(4,'x'),(5,'y')] [(1,2,10),(1,4,5),(2,3,1),(2,4,2),(3,5,4), (4,2,3),(4,3,9),(4,5,2),(5,1,7),(5,3,6)] kin248' = mkGraphM (genLNodes 1 10) (labUEdges [(1,2),(1,4),(1,7),(2,4),(2,5),(3,4),(3,10), (4,5),(4,8),(5,2),(5,3),(6,7),(7,6),(7,8), (8,10),(9,9),(9,10),(10,8),(10,9)]) -- this is the inverse graph shown on the bottom of the page vor' = mkGraphM (zip [1..8] ["A","B","C","H1","H2","D","E","F"]) [(1,4,3),(2,3,3),(2,4,3),(4,2,4),(4,6,2), (5,2,5),(5,3,6),(5,7,5),(5,8,6), (6,5,3),(6,7,2),(7,8,3),(8,7,3)] hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Graph.hs0000644006511100651110000003727310504340406022562 0ustar rossross-- (c) 1999-2005 by Martin Erwig [see file COPYRIGHT] -- | Static and Dynamic Inductive Graphs module Data.Graph.Inductive.Graph ( -- * General Type Defintions -- ** Node and Edge Types Node,LNode,UNode, Edge,LEdge,UEdge, -- ** Types Supporting Inductive Graph View Adj,Context,MContext,Decomp,GDecomp,UDecomp, Path,LPath(..),UPath, -- * Graph Type Classes -- | We define two graph classes: -- -- Graph: static, decomposable graphs. -- Static means that a graph itself cannot be changed -- -- DynGraph: dynamic, extensible graphs. -- Dynamic graphs inherit all operations from static graphs -- but also offer operations to extend and change graphs. -- -- Each class contains in addition to its essential operations those -- derived operations that might be overwritten by a more efficient -- implementation in an instance definition. -- -- Note that labNodes is essentially needed because the default definition -- for matchAny is based on it: we need some node from the graph to define -- matchAny in terms of match. Alternatively, we could have made matchAny -- essential and have labNodes defined in terms of ufold and matchAny. -- However, in general, labNodes seems to be (at least) as easy to define -- as matchAny. We have chosen labNodes instead of the function nodes since -- nodes can be easily derived from labNodes, but not vice versa. Graph(..), DynGraph(..), -- * Operations -- ** Graph Folds and Maps ufold,gmap,nmap,emap, -- ** Graph Projection nodes,edges,newNodes,gelem, -- ** Graph Construction and Destruction insNode,insEdge,delNode,delEdge,delLEdge, insNodes,insEdges,delNodes,delEdges, buildGr,mkUGraph, -- ** Graph Inspection context,lab,neighbors, suc,pre,lsuc,lpre, out,inn,outdeg,indeg,deg, equal, -- ** Context Inspection node',lab',labNode',neighbors', suc',pre',lpre',lsuc', out',inn',outdeg',indeg',deg', ) where import Data.List (sortBy) {- Signatures: -- basic operations empty :: Graph gr => gr a b isEmpty :: Graph gr => gr a b -> Bool match :: Graph gr => Node -> gr a b -> Decomp gr a b mkGraph :: Graph gr => [LNode a] -> [LEdge b] -> gr a b (&) :: DynGraph gr => Context a b -> gr a b -> gr a b -- graph folds and maps ufold :: Graph gr => ((Context a b) -> c -> c) -> c -> gr a b -> c gmap :: Graph gr => (Context a b -> Context c d) -> gr a b -> gr c d nmap :: Graph gr => (a -> c) -> gr a b -> gr c b emap :: Graph gr => (b -> c) -> gr a b -> gr a c -- graph projection matchAny :: Graph gr => gr a b -> GDecomp g a b nodes :: Graph gr => gr a b -> [Node] edges :: Graph gr => gr a b -> [Edge] labNodes :: Graph gr => gr a b -> [LNode a] labEdges :: Graph gr => gr a b -> [LEdge b] newNodes :: Graph gr => Int -> gr a b -> [Node] noNodes :: Graph gr => gr a b -> Int nodeRange :: Graph gr => gr a b -> (Node,Node) gelem :: Graph gr => Node -> gr a b -> Bool -- graph construction & destruction insNode :: DynGraph gr => LNode a -> gr a b -> gr a b insEdge :: DynGraph gr => LEdge b -> gr a b -> gr a b delNode :: Graph gr => Node -> gr a b -> gr a b delEdge :: DynGraph gr => Edge -> gr a b -> gr a b delLEdge :: (DynGraph gr, Eq b) => LEdge b -> gr a b -> gr a b insNodes :: DynGraph gr => [LNode a] -> gr a b -> gr a b insEdges :: DynGraph gr => [LEdge b] -> gr a b -> gr a b delNodes :: Graph gr => [Node] -> gr a b -> gr a b delEdges :: DynGraph gr => [Edge] -> gr a b -> gr a b buildGr :: DynGraph gr => [Context a b] -> gr a b mkUGraph :: DynGraph gr => [Node] -> [Edge] -> gr () () -- graph inspection context :: Graph gr => gr a b -> Node -> Context a b lab :: Graph gr => gr a b -> Node -> Maybe a neighbors :: Graph gr => gr a b -> Node -> [Node] suc :: Graph gr => gr a b -> Node -> [Node] pre :: Graph gr => gr a b -> Node -> [Node] lsuc :: Graph gr => gr a b -> Node -> [(Node,b)] lpre :: Graph gr => gr a b -> Node -> [(Node,b)] out :: Graph gr => gr a b -> Node -> [LEdge b] inn :: Graph gr => gr a b -> Node -> [LEdge b] outdeg :: Graph gr => gr a b -> Node -> Int indeg :: Graph gr => gr a b -> Node -> Int deg :: Graph gr => gr a b -> Node -> Int -- context inspection node' :: Context a b -> Node lab' :: Context a b -> a labNode' :: Context a b -> LNode a neighbors' :: Context a b -> [Node] suc' :: Context a b -> [Node] pre' :: Context a b -> [Node] lpre' :: Context a b -> [(Node,b)] lsuc' :: Context a b -> [(Node,b)] out' :: Context a b -> [LEdge b] inn' :: Context a b -> [LEdge b] outdeg' :: Context a b -> Int indeg' :: Context a b -> Int deg' :: Context a b -> Int -} -- | Unlabeled node type Node = Int -- | Labeled node type LNode a = (Node,a) -- | Quasi-unlabeled node type UNode = LNode () -- | Unlabeled edge type Edge = (Node,Node) -- | Labeled edge type LEdge b = (Node,Node,b) -- | Quasi-unlabeled edge type UEdge = LEdge () -- | Unlabeled path type Path = [Node] -- | Labeled path newtype LPath a = LP [LNode a] instance Show a => Show (LPath a) where show (LP xs) = show xs -- | Quasi-unlabeled path type UPath = [UNode] -- | Labeled links to or from a 'Node'. type Adj b = [(b,Node)] -- | Links to the 'Node', the 'Node' itself, a label, links from the 'Node'. type Context a b = (Adj b,Node,a,Adj b) -- Context a b "=" Context' a b "+" Node type MContext a b = Maybe (Context a b) -- | 'Graph' decomposition - the context removed from a 'Graph', and the rest -- of the 'Graph'. type Decomp g a b = (MContext a b,g a b) -- | The same as 'Decomp', only more sure of itself. type GDecomp g a b = (Context a b,g a b) -- | Unlabeled context. type UContext = ([Node],Node,[Node]) -- | Unlabeled decomposition. type UDecomp g = (Maybe UContext,g) -- | Minimum implementation: 'empty', 'isEmpty', 'match', 'mkGraph', 'labNodes' class Graph gr where -- essential operations -- | An empty 'Graph'. empty :: gr a b -- | True if the given 'Graph' is empty. isEmpty :: gr a b -> Bool -- | Decompose a 'Graph' into the 'MContext' found for the given node and the -- remaining 'Graph'. match :: Node -> gr a b -> Decomp gr a b -- | Create a 'Graph' from the list of 'LNode's and 'LEdge's. mkGraph :: [LNode a] -> [LEdge b] -> gr a b -- | A list of all 'LNode's in the 'Graph'. labNodes :: gr a b -> [LNode a] -- derived operations -- | Decompose a graph into the 'Context' for an arbitrarily-chosen 'Node' -- and the remaining 'Graph'. matchAny :: gr a b -> GDecomp gr a b -- | The number of 'Node's in a 'Graph'. noNodes :: gr a b -> Int -- | The minimum and maximum 'Node' in a 'Graph'. nodeRange :: gr a b -> (Node,Node) -- | A list of all 'LEdge's in the 'Graph'. labEdges :: gr a b -> [LEdge b] -- default implementation of derived operations matchAny g = case labNodes g of [] -> error "Match Exception, Empty Graph" (v,_):_ -> (c,g') where (Just c,g') = match v g noNodes = length . labNodes nodeRange g = (minimum vs,maximum vs) where vs = map fst (labNodes g) labEdges = ufold (\(_,v,_,s)->((map (\(l,w)->(v,w,l)) s)++)) [] class Graph gr => DynGraph gr where -- | Merge the 'Context' into the 'DynGraph'. (&) :: Context a b -> gr a b -> gr a b -- | Fold a function over the graph. ufold :: Graph gr => ((Context a b) -> c -> c) -> c -> gr a b -> c ufold f u g | isEmpty g = u | otherwise = f c (ufold f u g') where (c,g') = matchAny g -- | Map a function over the graph. gmap :: DynGraph gr => (Context a b -> Context c d) -> gr a b -> gr c d gmap f = ufold (\c->(f c&)) empty -- | Map a function over the 'Node' labels in a graph. nmap :: DynGraph gr => (a -> c) -> gr a b -> gr c b nmap f = gmap (\(p,v,l,s)->(p,v,f l,s)) -- | Map a function over the 'Edge' labels in a graph. emap :: DynGraph gr => (b -> c) -> gr a b -> gr a c emap f = gmap (\(p,v,l,s)->(map1 f p,v,l,map1 f s)) where map1 g = map (\(l,v)->(g l,v)) -- | List all 'Node's in the 'Graph'. nodes :: Graph gr => gr a b -> [Node] nodes = map fst . labNodes -- | List all 'Edge's in the 'Graph'. edges :: Graph gr => gr a b -> [Edge] edges = map (\(v,w,_)->(v,w)) . labEdges -- | List N available 'Node's, i.e. 'Node's that are not used in the 'Graph'. newNodes :: Graph gr => Int -> gr a b -> [Node] newNodes i g = [n+1..n+i] where (_,n) = nodeRange g -- | 'True' if the 'Node' is present in the 'Graph'. gelem :: Graph gr => Node -> gr a b -> Bool gelem v g = case match v g of {(Just _,_) -> True; _ -> False} -- | Insert a 'LNode' into the 'Graph'. insNode :: DynGraph gr => LNode a -> gr a b -> gr a b insNode (v,l) = (([],v,l,[])&) -- | Insert a 'LEdge' into the 'Graph'. insEdge :: DynGraph gr => LEdge b -> gr a b -> gr a b insEdge (v,w,l) g = (pr,v,la,(l,w):su) & g' where (Just (pr,_,la,su),g') = match v g -- | Remove a 'Node' from the 'Graph'. delNode :: Graph gr => Node -> gr a b -> gr a b delNode v = delNodes [v] -- | Remove an 'Edge' from the 'Graph'. delEdge :: DynGraph gr => Edge -> gr a b -> gr a b delEdge (v,w) g = case match v g of (Nothing,_) -> g (Just (p,v',l,s),g') -> (p,v',l,filter ((/=w).snd) s) & g' -- | Remove an 'LEdge' from the 'Graph'. delLEdge :: (DynGraph gr, Eq b) => LEdge b -> gr a b -> gr a b delLEdge (v,w,b) g = case match v g of (Nothing,_) -> g (Just (p,v',l,s),g') -> (p,v',l,filter (\(x,n) -> x /= b || n /= w) s) & g' -- | Insert multiple 'LNode's into the 'Graph'. insNodes :: DynGraph gr => [LNode a] -> gr a b -> gr a b insNodes vs g = foldr insNode g vs -- | Insert multiple 'LEdge's into the 'Graph'. insEdges :: DynGraph gr => [LEdge b] -> gr a b -> gr a b insEdges es g = foldr insEdge g es -- | Remove multiple 'Node's from the 'Graph'. delNodes :: Graph gr => [Node] -> gr a b -> gr a b delNodes [] g = g delNodes (v:vs) g = delNodes vs (snd (match v g)) -- | Remove multiple 'Edge's from the 'Graph'. delEdges :: DynGraph gr => [Edge] -> gr a b -> gr a b delEdges es g = foldr delEdge g es -- | Build a 'Graph' from a list of 'Context's. buildGr :: DynGraph gr => [Context a b] -> gr a b buildGr = foldr (&) empty -- mkGraph :: DynGraph gr => [LNode a] -> [LEdge b] -> gr a b -- mkGraph vs es = (insEdges es . insNodes vs) empty -- | Build a quasi-unlabeled 'Graph'. mkUGraph :: Graph gr => [Node] -> [Edge] -> gr () () mkUGraph vs es = mkGraph (labUNodes vs) (labUEdges es) labUEdges = map (\(v,w)->(v,w,())) labUNodes = map (\v->(v,())) -- | Find the context for the given 'Node'. Causes an error if the 'Node' is -- not present in the 'Graph'. context :: Graph gr => gr a b -> Node -> Context a b context g v = case match v g of (Nothing,_) -> error ("Match Exception, Node: "++show v) (Just c,_) -> c -- | Find the label for a 'Node'. lab :: Graph gr => gr a b -> Node -> Maybe a lab g v = fst (match v g) >>= return.lab' -- | Find the neighbors for a 'Node'. neighbors :: Graph gr => gr a b -> Node -> [Node] neighbors = (\(p,_,_,s) -> map snd (p++s)) .: context -- | Find all 'Node's that have a link from the given 'Node'. suc :: Graph gr => gr a b -> Node -> [Node] suc = map snd .: context4 -- | Find all 'Node's that link to to the given 'Node'. pre :: Graph gr => gr a b -> Node -> [Node] pre = map snd .: context1 -- | Find all 'Node's that are linked from the given 'Node' and the label of -- each link. lsuc :: Graph gr => gr a b -> Node -> [(Node,b)] lsuc = map flip2 .: context4 -- | Find all 'Node's that link to the given 'Node' and the label of each link. lpre :: Graph gr => gr a b -> Node -> [(Node,b)] lpre = map flip2 .: context1 -- | Find all outward-bound 'LEdge's for the given 'Node'. out :: Graph gr => gr a b -> Node -> [LEdge b] out g v = map (\(l,w)->(v,w,l)) (context4 g v) -- | Find all inward-bound 'LEdge's for the given 'Node'. inn :: Graph gr => gr a b -> Node -> [LEdge b] inn g v = map (\(l,w)->(w,v,l)) (context1 g v) -- | The outward-bound degree of the 'Node'. outdeg :: Graph gr => gr a b -> Node -> Int outdeg = length .: context4 -- | The inward-bound degree of the 'Node'. indeg :: Graph gr => gr a b -> Node -> Int indeg = length .: context1 -- | The degree of the 'Node'. deg :: Graph gr => gr a b -> Node -> Int deg = (\(p,_,_,s) -> length p+length s) .: context -- | The 'Node' in a 'Context'. node' :: Context a b -> Node node' (_,v,_,_) = v -- | The label in a 'Context'. lab' :: Context a b -> a lab' (_,_,l,_) = l -- | The 'LNode' from a 'Context'. labNode' :: Context a b -> LNode a labNode' (_,v,l,_) = (v,l) -- | All 'Node's linked to or from in a 'Context'. neighbors' :: Context a b -> [Node] neighbors' (p,_,_,s) = map snd p++map snd s -- | All 'Node's linked to in a 'Context'. suc' :: Context a b -> [Node] suc' (_,_,_,s) = map snd s -- | All 'Node's linked from in a 'Context'. pre' :: Context a b -> [Node] pre' (p,_,_,_) = map snd p -- | All 'Node's linked from in a 'Context', and the label of the links. lpre' :: Context a b -> [(Node,b)] lpre' (p,_,_,_) = map flip2 p -- | All 'Node's linked from in a 'Context', and the label of the links. lsuc' :: Context a b -> [(Node,b)] lsuc' (_,_,_,s) = map flip2 s -- | All outward-directed 'LEdge's in a 'Context'. out' :: Context a b -> [LEdge b] out' (_,v,_,s) = map (\(l,w)->(v,w,l)) s -- | All inward-directed 'LEdge's in a 'Context'. inn' :: Context a b -> [LEdge b] inn' (p,v,_,_) = map (\(l,w)->(w,v,l)) p -- | The outward degree of a 'Context'. outdeg' :: Context a b -> Int outdeg' (_,_,_,s) = length s -- | The inward degree of a 'Context'. indeg' :: Context a b -> Int indeg' (p,_,_,_) = length p -- | The degree of a 'Context'. deg' :: Context a b -> Int deg' (p,_,_,s) = length p+length s -- graph equality -- nodeComp :: Eq b => LNode b -> LNode b -> Ordering nodeComp n@(v,_) n'@(w,_) | n == n' = EQ | v gr a b -> [LNode a] slabNodes = sortBy nodeComp . labNodes edgeComp :: Eq b => LEdge b -> LEdge b -> Ordering edgeComp e@(v,w,_) e'@(x,y,_) | e == e' = EQ | v gr a b -> [LEdge b] slabEdges = sortBy edgeComp . labEdges -- instance (Eq a,Eq b,Graph gr) => Eq (gr a b) where -- g == g' = slabNodes g == slabNodes g' && slabEdges g == slabEdges g' equal :: (Eq a,Eq b,Graph gr) => gr a b -> gr a b -> Bool equal g g' = slabNodes g == slabNodes g' && slabEdges g == slabEdges g' ---------------------------------------------------------------------- -- UTILITIES ---------------------------------------------------------------------- -- auxiliary functions used in the implementation of the -- derived class members -- (.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d) -- f .: g = \x y->f (g x y) -- f .: g = (f .) . g -- (.:) f = ((f .) .) -- (.:) = (.) (.) (.) (.:) = (.) . (.) fst4 (x,_,_,_) = x {- not used snd4 (_,x,_,_) = x thd4 (_,_,x,_) = x -} fth4 (_,_,_,x) = x {- not used fst3 (x,_,_) = x snd3 (_,x,_) = x thd3 (_,_,x) = x -} flip2 (x,y) = (y,x) -- projecting on context elements -- -- context1 g v = fst4 (contextP g v) context1 :: Graph gr => gr a b -> Node -> Adj b {- not used context2 :: Graph gr => gr a b -> Node -> Node context3 :: Graph gr => gr a b -> Node -> a -} context4 :: Graph gr => gr a b -> Node -> Adj b context1 = fst4 .: context {- not used context2 = snd4 .: context context3 = thd4 .: context -} context4 = fth4 .: context hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Internal/0000755006511100651110000000000010504340406022725 5ustar rossrosshugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Internal/FiniteMap.hs0000644006511100651110000001650310504340406025142 0ustar rossross-- | Simple Finite Maps. -- This implementation provides several useful methods that Data.FiniteMap -- does not. module Data.Graph.Inductive.Internal.FiniteMap( -- * Type FiniteMap(..), -- * Operations emptyFM,addToFM,delFromFM, updFM, accumFM, splitFM, isEmptyFM,sizeFM,lookupFM,elemFM, rangeFM, minFM,maxFM,predFM,succFM, splitMinFM, fmToList ) where import Data.Maybe (isJust) data Ord a => FiniteMap a b = Empty | Node Int (FiniteMap a b) (a,b) (FiniteMap a b) deriving (Eq) ---------------------------------------------------------------------- -- UTILITIES ---------------------------------------------------------------------- -- pretty printing -- showsMap :: (Show a,Show b,Ord a) => FiniteMap a b -> ShowS showsMap Empty = id showsMap (Node _ l (i,x) r) = showsMap l . (' ':) . shows i . ("->"++) . shows x . showsMap r instance (Show a,Show b,Ord a) => Show (FiniteMap a b) where showsPrec _ m = showsMap m -- other -- splitMax :: Ord a => FiniteMap a b -> (FiniteMap a b,(a,b)) splitMax (Node _ l x Empty) = (l,x) splitMax (Node _ l x r) = (avlBalance l x m,y) where (m,y) = splitMax r splitMax Empty = error "splitMax on empty FiniteMap" merge :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b merge l Empty = l merge Empty r = r merge l r = avlBalance l' x r where (l',x) = splitMax l ---------------------------------------------------------------------- -- MAIN FUNCTIONS ---------------------------------------------------------------------- emptyFM :: Ord a => FiniteMap a b emptyFM = Empty addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b addToFM Empty i x = node Empty (i,x) Empty addToFM (Node h l (j,y) r) i x | ij = avlBalance l (j,y) (addToFM r i x) | otherwise = Node h l (j,x) r -- | applies function to stored entry updFM :: Ord a => FiniteMap a b -> a -> (b -> b) -> FiniteMap a b updFM Empty _ _ = Empty updFM (Node h l (j,x) r) i f | ij = let r' = updFM r i f in r' `seq` Node h l (j,x) r' | otherwise = Node h l (j,f x) r -- | defines or aggregates entries accumFM :: Ord a => FiniteMap a b -> a -> (b -> b -> b) -> b -> FiniteMap a b accumFM Empty i _ x = node Empty (i,x) Empty accumFM (Node h l (j,y) r) i f x | ij = avlBalance l (j,y) (accumFM r i f x) | otherwise = Node h l (j,f x y) r delFromFM :: Ord a => FiniteMap a b -> a -> FiniteMap a b delFromFM Empty _ = Empty delFromFM (Node _ l (j,x) r) i | ij = avlBalance l (j,x) (delFromFM r i) | otherwise = merge l r isEmptyFM :: FiniteMap a b -> Bool isEmptyFM Empty = True isEmptyFM _ = False sizeFM :: Ord a => FiniteMap a b -> Int sizeFM Empty = 0 sizeFM (Node _ l _ r) = sizeFM l + 1 + sizeFM r lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b lookupFM Empty _ = Nothing lookupFM (Node _ l (j,x) r) i | ij = lookupFM r i | otherwise = Just x -- | applies lookup to an interval rangeFM :: Ord a => FiniteMap a b -> a -> a -> [b] rangeFM m i j = rangeFMa m i j [] -- rangeFMa Empty _ _ a = a rangeFMa (Node _ l (k,x) r) i j a | kj = rangeFMa l i j a | otherwise = rangeFMa l i j (x:rangeFMa r i j a) minFM :: Ord a => FiniteMap a b -> Maybe (a,b) minFM Empty = Nothing minFM (Node _ Empty x _) = Just x minFM (Node _ l _ _) = minFM l maxFM :: Ord a => FiniteMap a b -> Maybe (a,b) maxFM Empty = Nothing maxFM (Node _ _ x Empty) = Just x maxFM (Node _ _ _ r) = maxFM r predFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b) predFM m i = predFM' m i Nothing -- predFM' Empty _ p = p predFM' (Node _ l (j,x) r) i p | ij = predFM' r i (Just (j,x)) | isJust ml = ml | otherwise = p where ml = maxFM l succFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b) succFM m i = succFM' m i Nothing -- succFM' Empty _ p = p succFM' (Node _ l (j,x) r) i p | ij = succFM' r i p | isJust mr = mr | otherwise = p where mr = minFM r elemFM :: Ord a => FiniteMap a b -> a -> Bool elemFM m i = case lookupFM m i of {Nothing -> False; _ -> True} -- | combines delFrom and lookup splitFM :: Ord a => FiniteMap a b -> a -> Maybe (FiniteMap a b,(a,b)) splitFM Empty _ = Nothing splitFM (Node _ l (j,x) r) i = if i Just (avlBalance l' (j,x) r,y) Nothing -> Nothing else if i>j then case splitFM r i of Just (r',y) -> Just (avlBalance l (j,x) r',y) Nothing -> Nothing else {- i==j -} Just (merge l r,(j,x)) -- | combines splitFM and minFM splitMinFM :: Ord a => FiniteMap a b -> Maybe (FiniteMap a b,(a,b)) splitMinFM Empty = Nothing splitMinFM (Node _ Empty x r) = Just (r,x) splitMinFM (Node _ l x r) = Just (avlBalance l' x r,y) where Just (l',y) = splitMinFM l fmToList :: Ord a => FiniteMap a b -> [(a,b)] fmToList m = scan m [] where scan Empty xs = xs scan (Node _ l x r) xs = scan l (x:(scan r xs)) ---------------------------------------------------------------------- -- AVL tree helper functions ---------------------------------------------------------------------- height :: Ord a => FiniteMap a b -> Int height Empty = 0 height (Node h _ _ _) = h node :: Ord a => FiniteMap a b -> (a,b) -> FiniteMap a b -> FiniteMap a b node l val r = Node h l val r where h=1+(height l `max` height r) avlBalance :: Ord a => FiniteMap a b -> (a,b) -> FiniteMap a b -> FiniteMap a b avlBalance l (i,x) r | (hr + 1 < hl) && (bias l < 0) = rotr (node (rotl l) (i,x) r) | (hr + 1 < hl) = rotr (node l (i,x) r) | (hl + 1 < hr) && (0 < bias r) = rotl (node l (i,x) (rotr r)) | (hl + 1 < hr) = rotl (node l (i,x) r) | otherwise = node l (i,x) r where hl=height l; hr=height r bias :: Ord a => FiniteMap a b -> Int bias (Node _ l _ r) = height l - height r bias Empty = 0 rotr :: Ord a => FiniteMap a b -> FiniteMap a b rotr Empty = Empty rotr (Node _ (Node _ l1 v1 r1) v2 r2) = node l1 v1 (node r1 v2 r2) rotr (Node _ Empty _ _) = error "rotr on invalid FiniteMap" rotl :: Ord a => FiniteMap a b -> FiniteMap a b rotl Empty = Empty rotl (Node _ l1 v1 (Node _ l2 v2 r2)) = node (node l1 v1 l2) v2 r2 rotl (Node _ _ _ Empty) = error "rotl on invalid FiniteMap" hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Internal/Heap.hs0000644006511100651110000000476110504340406024146 0ustar rossross-- | Pairing heap implementation of dictionary module Data.Graph.Inductive.Internal.Heap( -- * Type Heap(..), -- * Operations empty,unit,insert,merge,mergeAll, isEmpty,findMin,deleteMin,splitMin, build, toList, heapsort ) where data Ord a => Heap a b = Empty | Node a b [Heap a b] deriving Eq showsHeap :: (Show a,Ord a,Show b) => Heap a b -> ShowS showsHeap Empty = id showsHeap (Node key val []) = shows key . (": "++) . shows val showsHeap (Node key val hs) = shows key . (": "++) . shows val . (' ':) . shows hs instance (Show a,Ord a,Show b) => Show (Heap a b) where showsPrec _ d = showsHeap d ---------------------------------------------------------------------- -- MAIN FUNCTIONS ---------------------------------------------------------------------- empty :: Ord a => Heap a b empty = Empty unit :: Ord a => a -> b -> Heap a b unit key val = Node key val [] insert :: Ord a => (a, b) -> Heap a b -> Heap a b insert (key, val) h = merge (unit key val) h merge :: Ord a => Heap a b -> Heap a b -> Heap a b merge h Empty = h merge Empty h = h merge h@(Node key1 val1 hs) h'@(Node key2 val2 hs') | key1 [Heap a b] -> Heap a b mergeAll [] = Empty mergeAll [h] = h mergeAll (h:h':hs) = merge (merge h h') (mergeAll hs) isEmpty :: Ord a => Heap a b -> Bool isEmpty Empty = True isEmpty _ = False findMin :: Ord a => Heap a b -> (a, b) findMin Empty = error "Heap.findMin: empty heap" findMin (Node key val _) = (key, val) deleteMin :: Ord a => Heap a b -> Heap a b deleteMin Empty = Empty deleteMin (Node _ _ hs) = mergeAll hs splitMin :: Ord a => Heap a b -> (a,b,Heap a b) splitMin Empty = error "Heap.splitMin: empty heap" splitMin (Node key val hs) = (key,val,mergeAll hs) ---------------------------------------------------------------------- -- APPLICATION FUNCTIONS, EXAMPLES ---------------------------------------------------------------------- build :: Ord a => [(a,b)] -> Heap a b build = foldr insert Empty toList :: Ord a => Heap a b -> [(a,b)] toList Empty = [] toList h = x:toList r where (x,r) = (findMin h,deleteMin h) heapsort :: Ord a => [a] -> [a] heapsort = (map fst) . toList . build . map (\x->(x,x)) {- l :: (Num a) => [a] l = [6,9,2,13,6,8,14,9,10,7,5] l' = reverse l h1 = build $ map (\x->(x,x)) l h1' = build $ map (\x->(x,x)) l' s1 = heapsort l s1' = heapsort l' -} hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Internal/Queue.hs0000644006511100651110000000130410504340406024343 0ustar rossrossmodule Data.Graph.Inductive.Internal.Queue( -- * Type Queue(..), -- * Operations mkQueue, queuePut, queuePutList, queueGet, queueEmpty ) where data Queue a = MkQueue [a] [a] mkQueue :: Queue a mkQueue = MkQueue [] [] queuePut :: a -> Queue a -> Queue a queuePut item (MkQueue ins outs) = MkQueue (item:ins) outs queuePutList :: [a] -> Queue a -> Queue a queuePutList [] q = q queuePutList (x:xs) q = queuePutList xs (queuePut x q) queueGet :: Queue a -> (a, Queue a) queueGet (MkQueue ins (item:rest)) = (item, MkQueue ins rest) queueGet (MkQueue ins []) = queueGet (MkQueue [] (reverse ins)) queueEmpty :: Queue a -> Bool queueEmpty (MkQueue ins outs) = (null ins) && (null outs) hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Internal/RootPath.hs0000644006511100651110000000271710504340406025030 0ustar rossross-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT] -- | Inward directed trees as lists of paths. module Data.Graph.Inductive.Internal.RootPath ( -- * Types RTree,LRTree, -- * Operations getPath,getLPath, getDistance, getLPathNodes ) where import Data.Graph.Inductive.Graph instance Eq a => Eq (LPath a) where (LP []) == (LP []) = True (LP ((_,x):_)) == (LP ((_,y):_)) = x==y (LP _) == (LP _) = False instance Ord a => Ord (LPath a) where compare (LP []) (LP []) = EQ compare (LP ((_,x):_)) (LP ((_,y):_)) = compare x y compare _ _ = error "LPath: cannot compare to empty paths" type LRTree a = [LPath a] type RTree = [Path] first :: ([a] -> Bool) -> [[a]] -> [a] first p xss = case filter p xss of [] -> [] x:_ -> x -- | Find the first path in a tree that starts with the given node findP :: Node -> LRTree a -> [LNode a] findP _ [] = [] findP v ((LP []):ps) = findP v ps findP v ((LP (p@((w,_):_))):ps) | v==w = p | otherwise = findP v ps getPath :: Node -> RTree -> Path getPath v = reverse . first (\(w:_)->w==v) getLPath :: Node -> LRTree a -> LPath a getLPath v = LP . reverse . findP v getDistance :: Node -> LRTree a -> a getDistance v = snd . head . findP v getLPathNodes :: Node -> LRTree a -> Path getLPathNodes v = (\(LP p)->map fst p) . getLPath v hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Internal/Thread.hs0000644006511100651110000001073010504340406024471 0ustar rossross-- (c) 1999 by Martin Erwig -- | Threading Combinators. module Data.Graph.Inductive.Internal.Thread( -- * Types Split, SplitM, Thread, Collect, -- * Operations threadList', threadList, threadMaybe', threadMaybe, splitPar, splitParM ) where -- import Graph -- import GraphData -- import qualified Diet as D -- import ADT ---------------------------------------------------------------------- -- CLASSES AND TYPES ---------------------------------------------------------------------- {- class Thread t a b where split :: a -> t -> (b,t) instance Thread (Graph a b) Node (MContext a b) where split = match instance D.Discrete a => Thread (D.Diet a) a a where split x s = (x,D.delete x s) -} {- Make clear different notions: "thread" = data structure + split operation ... = threadable data structure ... = split operation -} ---------------------------------------------------------------------- -- THREAD COMBINATORS ---------------------------------------------------------------------- -- (A) split along a list of indexes and thread data structure -- -- there are different ways to consume the returned elements: {- -- (1) simple collect in a list -- foldT1' ys [] d = ys foldT1' ys (x:xs) d = foldT1' (y:ys) xs d' where (y,d') = split x d foldT1 xs d = foldT1' [] xs d -- (2) combine by a function -- foldT2' f ys [] d = ys foldT2' f ys (x:xs) d = foldT2' f (f y ys) xs d' where (y,d') = split x d foldT2 f u xs d = foldT2' f u xs d -} -- Mnemonics: -- -- t : thread type -- i : index type -- r : result type -- c : collection type -- type Split t i r = i -> t -> (r,t) type Thread t i r = (t,Split t i r) type Collect r c = (r -> c -> c,c) -- (3) abstract from split -- threadList' :: (Collect r c) -> (Split t i r) -> [i] -> t -> (c,t) threadList' (_,c) _ [] t = (c,t) threadList' (f,c) split (i:is) t = threadList' (f,f r c) split is t' where (r,t') = split i t {- Note: threadList' works top-down (or, from left), whereas dfs,gfold,... have been defined bottom-up (or from right). ==> therefore, we define a correpsonding operator for folding bottom-up/from right. -} threadList :: (Collect r c) -> (Split t i r) -> [i] -> t -> (c,t) threadList (_,c) _ [] t = (c,t) threadList (f,c) split (i:is) t = (f r c',t'') where (r,t') = split i t (c',t'') = threadList (f,c) split is t' -- (B) thread "maybes", ie, apply f to Just-values and continue -- threading with "continuation" c, and ignore Nothing-values, ie, -- stop threading and return current data structure. -- -- threadMaybe' :: (r -> b) -> (Split t i r) -> (e -> f -> (Maybe i,t)) -- -> e -> f -> (Maybe b,t) type SplitM t i r = Split t i (Maybe r) threadMaybe' :: (r->a)->Split t i r->Split t j (Maybe i)->Split t j (Maybe a) threadMaybe' f cont split j t = case mi of Just i -> (Just (f r),t'') where (r,t'') = cont i t' Nothing -> (Nothing,t') where (mi,t') = split j t -- extension: grant f access also to y, the result of split. -- -- threadMaybe :: (a -> b -> c) -> (a -> d -> (b,d)) -> (e -> f -> (Maybe a,d)) -- -> e -> f -> (Maybe c,d) -- threadMaybe :: (i->r->a)->Split t i r->Split t j (Maybe i)->Split t j (Maybe a) threadMaybe :: (i -> r -> a) -> Split t i r -> SplitM t j i -> SplitM t j a threadMaybe f cont split j t = case mi of Just i -> (Just (f i r),t'') where (r,t'') = cont i t' Nothing -> (Nothing,t') where (mi,t') = split j t -- (C) compose splits in parallel (is a kind of generalized zip) -- -- splitPar :: (a -> b -> (c,d)) -> (e -> f -> (g,h)) -- -> (a,e) -> (b,f) -> ((c,g),(d,h)) splitPar :: Split t i r -> Split u j s -> Split (t,u) (i,j) (r,s) splitPar split split' (i,j) (t,u) = ((r,s),(t',u')) where (r,t') = split i t (s,u') = split' j u splitParM :: SplitM t i r -> Split u j s -> SplitM (t,u) (i,j) (r,s) splitParM splitm split (i,j) (t,u) = case mr of Just r -> (Just (r,s),(t',u')) Nothing -> (Nothing,(t',u)) -- ignore 2nd split where (mr,t') = splitm i t (s,u') = split j u -- (D) merge a thread with/into a computation -- {- Example: assign consecutive numbers to the nodes of a tree Input: type d, thread (t,split), fold operation on d -} hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Monad/0000755006511100651110000000000010504340406022207 5ustar rossrosshugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Monad/IOArray.hs0000644006511100651110000000750710504340406024062 0ustar rossross-- (c) 2002 by Martin Erwig [see file COPYRIGHT] -- | Static IOArray-based Graphs module Data.Graph.Inductive.Monad.IOArray( -- * Graph Representation SGr(..), GraphRep, Context', USGr, defaultGraphSize, emptyN, -- * Utilities removeDel, ) where import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Monad import Control.Monad import Data.Array import Data.Array.IO import System.IO.Unsafe import Data.Maybe ---------------------------------------------------------------------- -- GRAPH REPRESENTATION ---------------------------------------------------------------------- data SGr a b = SGr (GraphRep a b) type GraphRep a b = (Int,Array Node (Context' a b),IOArray Node Bool) type Context' a b = Maybe (Adj b,a,Adj b) type USGr = SGr () () ---------------------------------------------------------------------- -- CLASS INSTANCES ---------------------------------------------------------------------- -- Show -- showGraph :: (Show a,Show b) => GraphRep a b -> String showGraph (_,a,m) = concatMap showAdj (indices a) where showAdj v | unsafePerformIO (readArray m v) = "" | otherwise = case a!v of Nothing -> "" Just (_,l,s) -> '\n':show v++":"++show l++"->"++show s' where s' = unsafePerformIO (removeDel m s) instance (Show a,Show b) => Show (SGr a b) where show (SGr g) = showGraph g instance (Show a,Show b) => Show (IO (SGr a b)) where show g = unsafePerformIO (do {(SGr g') <- g; return (showGraph g')}) {- run :: Show (IO a) => IO a -> IO () run x = seq x (print x) -} -- GraphM -- instance GraphM IO SGr where emptyM = emptyN defaultGraphSize isEmptyM g = do {SGr (n,_,_) <- g; return (n==0)} matchM v g = do g'@(SGr (n,a,m)) <- g case a!v of Nothing -> return (Nothing,g') Just (pr,l,su) -> do b <- readArray m v if b then return (Nothing,g') else do s <- removeDel m su p' <- removeDel m pr let p = filter ((/=v).snd) p' writeArray m v True return (Just (p,v,l,s),SGr (n-1,a,m)) mkGraphM vs es = do m <- newArray (1,n) False return (SGr (n,pr,m)) where nod = array bnds (map (\(v,l)->(v,Just ([],l,[]))) vs) su = accum addSuc nod (map (\(v,w,l)->(v,(l,w))) es) pr = accum addPre su (map (\(v,w,l)->(w,(l,v))) es) bnds = (minimum vs',maximum vs') vs' = map fst vs n = length vs addSuc (Just (p,l',s)) (l,w) = Just (p,l',(l,w):s) addSuc Nothing _ = error "mkGraphM (SGr): addSuc Nothing" addPre (Just (p,l',s)) (l,w) = Just ((l,w):p,l',s) addPre Nothing _ = error "mkGraphM (SGr): addPre Nothing" labNodesM g = do (SGr (_,a,m)) <- g let getLNode vs (_,Nothing) = return vs getLNode vs (v,Just (_,l,_)) = do b <- readArray m v return (if b then vs else (v,l):vs) foldM getLNode [] (assocs a) defaultGraphSize :: Int defaultGraphSize = 100 emptyN :: Int -> IO (SGr a b) emptyN n = do m <- newArray (1,n) False return (SGr (0,array (1,n) [(i,Nothing) | i <- [1..n]],m)) ---------------------------------------------------------------------- -- UTILITIES ---------------------------------------------------------------------- -- | filter list (of successors\/predecessors) through a boolean ST array -- representing deleted marks removeDel :: IOArray Node Bool -> Adj b -> IO (Adj b) removeDel m = filterM (\(_,v)->do {b<-readArray m v;return (not b)}) hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/0000755006511100651110000000000010504340406022256 5ustar rossrosshugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/ArtPoint.hs0000644006511100651110000001377410504340406024366 0ustar rossrossmodule Data.Graph.Inductive.Query.ArtPoint( ap ) where import Data.Graph.Inductive.Graph ------------------------------------------------------------------------------ -- Tree for storing the DFS numbers and back edges for each node in the graph. -- Each node in this tree is of the form (v,n,b) where v is the vertex number, -- n is its DFS number and b is the list of nodes (and their DFS numbers) that -- lead to back back edges for that vertex v. ------------------------------------------------------------------------------ data DFSTree a = B (a,a,[(a,a)]) [DFSTree a] deriving (Eq) ------------------------------------------------------------------------------ -- Tree for storing the DFS and low numbers for each node in the graph. -- Each node in this tree is of the form (v,n,l) where v is the vertex number, -- n is its DFS number and l is its low number. ------------------------------------------------------------------------------ data LOWTree a = Brc (a,a,a) [LOWTree a] deriving (Eq) ------------------------------------------------------------------------------ -- Finds the back edges for a given node. ------------------------------------------------------------------------------ getBackEdges :: Node -> [[(Node,Int)]] -> [(Node,Int)] getBackEdges _ [] = [] getBackEdges v ls = map head (filter (elem (v,0)) (tail ls)) ------------------------------------------------------------------------------ -- Builds a DFS tree for a given graph. Each element (v,n,b) in the tree -- contains: the node number v, the DFS number n, and a list of backedges b. ------------------------------------------------------------------------------ dfsTree :: Graph gr => Int -> Node -> [Node] -> [[(Node,Int)]] -> gr a b -> ([DFSTree Int],gr a b,Int) dfsTree n _ [] _ g = ([],g,n) dfsTree n _ _ _ g | isEmpty g = ([],g,n) dfsTree n u (v:vs) ls g = case match v g of (Nothing, g1) -> dfsTree n u vs ls g1 (Just c , g1) -> (B (v,n+1,bck) ts:ts', g3, k) where bck = getBackEdges v ls (ts, g2,m) = dfsTree (n+1) v sc ls' g1 (ts',g3,k) = dfsTree m v vs ls g2 ls' = ((v,n+1):sc'):ls sc' = map (\x->(x,0)) sc sc = suc' c ------------------------------------------------------------------------------ -- Finds the minimum between a dfs number and a list of back edges' dfs -- numbers. ------------------------------------------------------------------------------ minbckEdge :: Int -> [(Node,Int)] -> Int minbckEdge n [] = n minbckEdge n bs = min n (minimum (map snd bs)) ------------------------------------------------------------------------------ -- Returns the low number for a node in a subtree. ------------------------------------------------------------------------------ getLow :: LOWTree Int -> Int getLow (Brc (_,_,l) _) = l ------------------------------------------------------------------------------ -- Builds a low tree from a DFS tree. Each element (v,n,low) in the tree -- contains: the node number v, the DFS number n, and the low number low. ------------------------------------------------------------------------------ lowTree :: DFSTree Int -> LOWTree Int lowTree (B (v,n,[] ) [] ) = Brc (v,n,n) [] lowTree (B (v,n,bcks) [] ) = Brc (v,n,minbckEdge n bcks) [] lowTree (B (v,n,bcks) trs) = Brc (v,n,lowv) ts where lowv = min (minbckEdge n bcks) lowChild lowChild = minimum (map getLow ts) ts = map lowTree trs ------------------------------------------------------------------------------ -- Builds a low tree for a given graph. Each element (v,n,low) in the tree -- contains: the node number v, the DFS number n, and the low number low. ------------------------------------------------------------------------------ getLowTree :: Graph gr => gr a b -> Node -> LOWTree Int getLowTree g v = lowTree (head dfsf) where (dfsf, _, _) = dfsTree 0 0 [v] [] g ------------------------------------------------------------------------------ -- Tests if a node in a subtree is an articulation point. An non-root node v -- is an articulation point iff there exists at least one child w of v such -- that lowNumber(w) >= dfsNumber(v). The root node is an articulation point -- iff it has two or more children. ------------------------------------------------------------------------------ isap :: LOWTree Int -> Bool isap (Brc (_,_,_) []) = False isap (Brc (_,1,_) ts) = length ts > 1 isap (Brc (_,n,_) ts) = length ch >= 1 where ch = filter ( >=n) (map getLow ts) ------------------------------------------------------------------------------ -- Finds the articulation points by traversing the low tree. ------------------------------------------------------------------------------ arp :: LOWTree Int -> [Node] arp (Brc (v,1,_) ts) | length ts > 1 = v:concatMap arp ts | otherwise = concatMap arp ts arp (Brc (v,n,l) ts) | isap (Brc (v,n,l) ts) = v:concatMap arp ts | otherwise = concatMap arp ts ------------------------------------------------------------------------------ -- Finds the articulation points of a graph starting at a given node. ------------------------------------------------------------------------------ artpoints :: Graph gr => gr a b -> Node -> [Node] artpoints g v = arp (getLowTree g v) {-| Finds the articulation points for a connected undirected graph, by using the low numbers criteria: a) The root node is an articulation point iff it has two or more children. b) An non-root node v is an articulation point iff there exists at least one child w of v such that lowNumber(w) >= dfsNumber(v). -} ap :: Graph gr => gr a b -> [Node] ap g = artpoints g v where ((_,v,_,_),_) = matchAny g hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/BCC.hs0000644006511100651110000000512110504340406023200 0ustar rossrossmodule Data.Graph.Inductive.Query.BCC( bcc ) where import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Query.DFS import Data.Graph.Inductive.Query.ArtPoint ------------------------------------------------------------------------------ -- Given a graph g, this function computes the subgraphs which are -- g's connected components. ------------------------------------------------------------------------------ gComponents :: DynGraph gr => gr a b -> [gr a b] gComponents g = map (\(x,y)-> mkGraph x y) (zip ln le) where ln = map (\x->[(u,l)|(u,l)<-vs,elem u x]) cc le = map (\x->[(u,v,l)|(u,v,l)<-es,elem u x]) cc (vs,es,cc) = (labNodes g,labEdges g,components g) embedContexts :: DynGraph gr => Context a b -> [gr a b] -> [gr a b] embedContexts (_,v,l,s) gs = map (\(x,y)-> x & y) (zip lc gs) where lc = map (\e->(e,v,l,e)) lc' lc'= map (\g->[ e | e <- s, gelem (snd e) g]) gs ------------------------------------------------------------------------------ -- Given a node v and a list of graphs, this functions returns the graph which -- v belongs to. ------------------------------------------------------------------------------ findGraph :: DynGraph gr => Node -> [gr a b] -> Decomp gr a b findGraph _ [] = error "findGraph: empty graph list" findGraph v (g:gs) = case match v g of (Nothing, _) -> findGraph v gs (Just c, g') -> (Just c, g') ------------------------------------------------------------------------------ -- Given a graph g and its articulation points, this function disconnects g -- for each articulation point and returns the connected components of the -- resulting disconnected graph. ------------------------------------------------------------------------------ splitGraphs :: DynGraph gr => [gr a b] -> [Node] -> [gr a b] splitGraphs gs [] = gs splitGraphs [] _ = error "splitGraphs: empty graph list" splitGraphs (g:gs) (v:vs) = splitGraphs (gs''++gs) vs where gs'' = embedContexts c gs' gs' = gComponents g' (Just c,g') = findGraph v (g:gs) {-| Finds the bi-connected components of an undirected connected graph. It first finds the articulation points of the graph. Then it disconnects the graph on each articulation point and computes the connected components. -} bcc :: DynGraph gr => gr a b -> [gr a b] bcc g = splitGraphs [g] (ap g) hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/BFS.hs0000644006511100651110000000772510504340406023237 0ustar rossross-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT] -- | Breadth-First Search Algorithms module Data.Graph.Inductive.Query.BFS( -- * BFS Node List bfs,bfsn,bfsWith,bfsnWith, -- * Node List With Depth Info level,leveln, -- * BFS Edges bfe,bfen, -- * BFS Tree bft,lbft, -- * Shortest Path (Number of Edges) esp,lesp ) where import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Internal.Queue import Data.Graph.Inductive.Internal.RootPath -- bfs (node list ordered by distance) -- bfsnInternal :: Graph gr => (Context a b -> c) -> Queue Node -> gr a b -> [c] bfsnInternal f q g | queueEmpty q || isEmpty g = [] | otherwise = case match v g of (Just c, g') -> f c:bfsnInternal f (queuePutList (suc' c) q') g' (Nothing, g') -> bfsnInternal f q' g' where (v,q') = queueGet q bfsnWith :: Graph gr => (Context a b -> c) -> [Node] -> gr a b -> [c] bfsnWith f vs = bfsnInternal f (queuePutList vs mkQueue) bfsn :: Graph gr => [Node] -> gr a b -> [Node] bfsn = bfsnWith node' bfsWith :: Graph gr => (Context a b -> c) -> Node -> gr a b -> [c] bfsWith f v = bfsnInternal f (queuePut v mkQueue) bfs :: Graph gr => Node -> gr a b -> [Node] bfs = bfsWith node' -- level (extension of bfs giving the depth of each node) -- level :: Graph gr => Node -> gr a b -> [(Node,Int)] level v = leveln [(v,0)] suci c i = zip (suc' c) (repeat i) leveln :: Graph gr => [(Node,Int)] -> gr a b -> [(Node,Int)] leveln [] _ = [] leveln _ g | isEmpty g = [] leveln ((v,j):vs) g = case match v g of (Just c,g') -> (v,j):leveln (vs++suci c (j+1)) g' (Nothing,g') -> leveln vs g' -- bfe (breadth first edges) -- remembers predecessor information -- bfenInternal :: Graph gr => Queue Edge -> gr a b -> [Edge] bfenInternal q g | queueEmpty q || isEmpty g = [] | otherwise = case match v g of (Just c, g') -> (u,v):bfenInternal (queuePutList (outU c) q') g' (Nothing, g') -> bfenInternal q' g' where ((u,v),q') = queueGet q bfen :: Graph gr => [Edge] -> gr a b -> [Edge] bfen vs g = bfenInternal (queuePutList vs mkQueue) g bfe :: Graph gr => Node -> gr a b -> [Edge] bfe v = bfen [(v,v)] outU c = map (\(v,w,_)->(v,w)) (out' c) -- bft (breadth first search tree) -- here: with inward directed trees -- -- bft :: Node -> gr a b -> IT.InTree Node -- bft v g = IT.build $ map swap $ bfe v g -- where swap (x,y) = (y,x) -- -- sp (shortest path wrt to number of edges) -- -- sp :: Node -> Node -> gr a b -> [Node] -- sp s t g = reverse $ IT.rootPath (bft s g) t -- faster shortest paths -- here: with root path trees -- bft :: Graph gr => Node -> gr a b -> RTree bft v = bf (queuePut [v] mkQueue) bf :: Graph gr => Queue Path -> gr a b -> RTree bf q g | queueEmpty q || isEmpty g = [] | otherwise = case match v g of (Just c, g') -> p:bf (queuePutList (map (:p) (suc' c)) q') g' (Nothing, g') -> bf q' g' where (p@(v:_),q') = queueGet q esp :: Graph gr => Node -> Node -> gr a b -> Path esp s t = getPath t . bft s -- lesp is a version of esp that returns labeled paths -- Note that the label of the first node in a returned path is meaningless; -- all other nodes are paired with the label of their incoming edge. -- lbft :: Graph gr => Node -> gr a b -> LRTree b lbft v g = case (out g v) of [] -> [LP []] (v',_,l):_ -> lbf (queuePut (LP [(v',l)]) mkQueue) g lbf :: Graph gr => Queue (LPath b) -> gr a b -> LRTree b lbf q g | queueEmpty q || isEmpty g = [] | otherwise = case match v g of (Just c, g') -> LP p:lbf (queuePutList (map (\v' -> LP (v':p)) (lsuc' c)) q') g' (Nothing, g') -> lbf q' g' where ((LP (p@((v,_):_))),q') = queueGet q lesp :: Graph gr => Node -> Node -> gr a b -> LPath b lesp s t = getLPath t . lbft s hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/DFS.hs0000644006511100651110000001376110504340406023236 0ustar rossross-- (c) 2000 - 2005 by Martin Erwig [see file COPYRIGHT] -- | Depth-First Search module Data.Graph.Inductive.Query.DFS( CFun, dfs,dfs',dff,dff', dfsWith, dfsWith',dffWith,dffWith', -- * Undirected DFS udfs,udfs',udff,udff', -- * Reverse DFS rdff,rdff',rdfs,rdfs', -- * Applications of DFS\/DFF topsort,topsort',scc,reachable, -- * Applications of UDFS\/UDFF components,noComponents,isConnected ) where import Data.Tree import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Basic ---------------------------------------------------------------------- -- DFS AND FRIENDS ---------------------------------------------------------------------- {- Classification of all 32 dfs functions: dfs-function ::= [direction]"df"structure["With"]["'"] direction --> "x" | "u" | "r" structure --> "s" | "f" | structure direction | "s" "f" ------------------------ + optional With + optional ' "x" | xdfs xdff " " | dfs dff "u" | udfs udff "r" | rdfs rdff ------------------------ Direction Parameter ------------------- x : parameterized by a function that specifies which nodes to be visited next " ": the "normal case: just follow successors u : undirected, ie, follow predecesors and successors r : reverse, ie, follow predecesors Structure Parameter ------------------- s : result is a list of (a) objects computed from visited contexts ("With"-version) (b) nodes (normal version) f : result is a tree/forest of (a) objects computed from visited contexts ("With"-version) (b) nodes (normal version) Optional Suffixes ----------------- With : objects to be put into list/tree are given by a function on contexts, default for non-"With" versions: nodes ' : parameter node list is given implicitly by the nodes of the graph to be traversed, default for non-"'" versions: nodes must be provided explicitly Defined are only the following 18 most important function versions: xdfsWith dfsWith,dfsWith',dfs,dfs' udfs,udfs' rdfs,rdfs' xdffWith dffWith,dffWith',dff,dff' udff,udff' rdff,rdff' Others can be added quite easily if needed. -} -- fixNodes fixes the nodes of the graph as a parameter -- fixNodes :: Graph gr => ([Node] -> gr a b -> c) -> gr a b -> c fixNodes f g = f (nodes g) g -- generalized depth-first search -- (could also be simply defined as applying preorderF to the -- result of xdffWith) -- type CFun a b c = Context a b -> c xdfsWith :: Graph gr => CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c] xdfsWith _ _ [] _ = [] xdfsWith _ _ _ g | isEmpty g = [] xdfsWith d f (v:vs) g = case match v g of (Just c,g') -> f c:xdfsWith d f (d c++vs) g' (Nothing,g') -> xdfsWith d f vs g' -- dfs -- dfsWith :: Graph gr => CFun a b c -> [Node] -> gr a b -> [c] dfsWith = xdfsWith suc' dfsWith' :: Graph gr => CFun a b c -> gr a b -> [c] dfsWith' f = fixNodes (dfsWith f) dfs :: Graph gr => [Node] -> gr a b -> [Node] dfs = dfsWith node' dfs' :: Graph gr => gr a b -> [Node] dfs' = dfsWith' node' -- undirected dfs, ie, ignore edge directions -- udfs :: Graph gr => [Node] -> gr a b -> [Node] udfs = xdfsWith neighbors' node' udfs' :: Graph gr => gr a b -> [Node] udfs' = fixNodes udfs -- reverse dfs, ie, follow predecessors -- rdfs :: Graph gr => [Node] -> gr a b -> [Node] rdfs = xdfsWith pre' node' rdfs' :: Graph gr => gr a b -> [Node] rdfs' = fixNodes rdfs -- generalized depth-first forest -- xdfWith :: Graph gr => CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> ([Tree c],gr a b) xdfWith _ _ [] g = ([],g) xdfWith _ _ _ g | isEmpty g = ([],g) xdfWith d f (v:vs) g = case match v g of (Nothing,g1) -> xdfWith d f vs g1 (Just c,g1) -> (Node (f c) ts:ts',g3) where (ts,g2) = xdfWith d f (d c) g1 (ts',g3) = xdfWith d f vs g2 xdffWith :: Graph gr => CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c] xdffWith d f vs g = fst (xdfWith d f vs g) -- dff -- dffWith :: Graph gr => CFun a b c -> [Node] -> gr a b -> [Tree c] dffWith = xdffWith suc' dffWith' :: Graph gr => CFun a b c -> gr a b -> [Tree c] dffWith' f = fixNodes (dffWith f) dff :: Graph gr => [Node] -> gr a b -> [Tree Node] dff = dffWith node' dff' :: Graph gr => gr a b -> [Tree Node] dff' = dffWith' node' -- undirected dff -- udff :: Graph gr => [Node] -> gr a b -> [Tree Node] udff = xdffWith neighbors' node' udff' :: Graph gr => gr a b -> [Tree Node] udff' = fixNodes udff -- reverse dff, ie, following predecessors -- rdff :: Graph gr => [Node] -> gr a b -> [Tree Node] rdff = xdffWith pre' node' rdff' :: Graph gr => gr a b -> [Tree Node] rdff' = fixNodes rdff ---------------------------------------------------------------------- -- ALGORITHMS BASED ON DFS ---------------------------------------------------------------------- components :: Graph gr => gr a b -> [[Node]] components = (map preorder) . udff' noComponents :: Graph gr => gr a b -> Int noComponents = length . components isConnected :: Graph gr => gr a b -> Bool isConnected = (==1) . noComponents postflatten :: Tree a -> [a] postflatten (Node v ts) = postflattenF ts ++ [v] postflattenF :: [Tree a] -> [a] postflattenF = concatMap postflatten topsort :: Graph gr => gr a b -> [Node] topsort = reverse . postflattenF . dff' topsort' :: Graph gr => gr a b -> [a] topsort' = reverse . postorderF . (dffWith' lab') scc :: Graph gr => gr a b -> [[Node]] scc g = map preorder (rdff (topsort g) g) -- optimized, using rdff -- sccOrig g = map preorder (dff (topsort g) (grev g)) -- original by Sharir reachable :: Graph gr => Node -> gr a b -> [Node] reachable v g = preorderF (dff [v] g) hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/Dominators.hs0000644006511100651110000000220010504340406024723 0ustar rossrossmodule Data.Graph.Inductive.Query.Dominators( dom ) where import Data.List import Data.Graph.Inductive.Graph type DomSets = [(Node,[Node],[Node])] intersection :: [[Node]] -> [Node] intersection cs = foldr intersect (head cs) cs getdomv :: [Node] -> DomSets -> [[Node]] getdomv vs ds = [z|(w,_,z)<-ds,v<-vs,v==w] builddoms :: DomSets -> [Node] -> DomSets builddoms ds [] = ds builddoms ds (v:vs) = builddoms ((fs++[(n,p,sort(n:idv))])++(tail rs)) vs where idv = intersection (getdomv p ds) (n,p,_) = head rs (fs,rs) = span (\(x,_,_)->x/=v) ds domr :: DomSets -> [Node] -> DomSets domr ds vs|xs == ds = ds |otherwise = builddoms xs vs where xs = (builddoms ds vs) {-| Finds the dominators relationship for a given graph and an initial node. For each node v, it returns the list of dominators of v. -} dom :: Graph gr => gr a b -> Node -> [(Node,[Node])] dom g u = map (\(x,_,z)->(x,z)) (domr ld n') where ld = (u,[],[u]):map (\v->(v,pre g v,n)) (n') n' = n\\[u] n = nodes g hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/GVD.hs0000644006511100651110000000307410504340406023236 0ustar rossross-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT] -- | Graph Voronoi Diagram module Data.Graph.Inductive.Query.GVD ( Voronoi, gvdIn,gvdOut, voronoiSet,nearestNode,nearestDist,nearestPath, -- vd,nn,ns, -- vdO,nnO,nsO ) where import Data.Maybe (listToMaybe) import Data.List (nub) import qualified Data.Graph.Inductive.Internal.Heap as H import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Query.SP (dijkstra) import Data.Graph.Inductive.Internal.RootPath import Data.Graph.Inductive.Basic type Voronoi a = LRTree a gvdIn :: (DynGraph gr, Real b) => [Node] -> gr a b -> Voronoi b gvdIn vs g = gvdOut vs (grev g) gvdOut :: (Graph gr, Real b) => [Node] -> gr a b -> Voronoi b gvdOut vs = dijkstra (H.build (zip (repeat 0) (map (\v->LP [(v,0)]) vs))) voronoiSet :: Real b => Node -> Voronoi b -> [Node] voronoiSet v = nub . concat . filter (\p->last p==v) . map (\(LP p)->map fst p) maybePath :: Real b => Node -> Voronoi b -> Maybe (LPath b) maybePath v = listToMaybe . filter (\(LP ((w,_):_))->w==v) nearestNode :: Real b => Node -> Voronoi b -> Maybe Node nearestNode v = fmap (\(LP ((w,_):_))->w) . maybePath v nearestDist :: Real b => Node -> Voronoi b -> Maybe b nearestDist v = fmap (\(LP ((_,l):_))->l) . maybePath v nearestPath :: Real b => Node -> Voronoi b -> Maybe Path nearestPath v = fmap (\(LP p)->map fst p) . maybePath v -- vd = gvdIn [4,5] vor -- vdO = gvdOut [4,5] vor -- nn = map (flip nearestNode vd) [1..8] -- nnO = map (flip nearestNode vdO) [1..8] -- ns = map (flip voronoiSet vd) [1..8] -- nsO = map (flip voronoiSet vdO) [1..8] hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/Indep.hs0000644006511100651110000000123310504340406023650 0ustar rossross-- (c) 2000 - 2002 by Martin Erwig [see file COPYRIGHT] -- | Maximum Independent Node Sets module Data.Graph.Inductive.Query.Indep ( indep ) where import Data.Graph.Inductive.Graph first :: (a -> Bool) -> [a] -> a first p = head . filter p indep :: DynGraph gr => gr a b -> [Node] indep g | isEmpty g = [] indep g = if length i1>length i2 then i1 else i2 where vs = nodes g m = maximum (map (deg g) vs) v = first (\v'->deg g v'==m) vs (Just c,g') = match v g i1 = indep g' i2 = v:indep (delNodes (neighbors' c) g') hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/MST.hs0000644006511100651110000000245410504340406023262 0ustar rossross-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT] -- | Minimum-Spanning-Tree Algorithms module Data.Graph.Inductive.Query.MST ( msTreeAt,msTree, -- * Path in MST msPath ) where import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Internal.RootPath import qualified Data.Graph.Inductive.Internal.Heap as H newEdges :: Ord b => LPath b -> Context a b -> [H.Heap b (LPath b)] newEdges (LP p) (_,_,_,s) = map (\(l,v)->H.unit l (LP ((v,l):p))) s prim :: (Graph gr,Real b) => H.Heap b (LPath b) -> gr a b -> LRTree b prim h g | H.isEmpty h || isEmpty g = [] prim h g = case match v g of (Just c,g') -> p:prim (H.mergeAll (h':newEdges p c)) g' (Nothing,g') -> prim h' g' where (_,p@(LP ((v,_):_)),h') = H.splitMin h msTreeAt :: (Graph gr,Real b) => Node -> gr a b -> LRTree b msTreeAt v g = prim (H.unit 0 (LP [(v,0)])) g msTree :: (Graph gr,Real b) => gr a b -> LRTree b msTree g = msTreeAt v g where ((_,v,_,_),_) = matchAny g msPath :: Real b => LRTree b -> Node -> Node -> Path msPath t a b = joinPaths (getLPathNodes a t) (getLPathNodes b t) joinPaths :: Path -> Path -> Path joinPaths p q = joinAt (head p) p q joinAt :: Node -> Path -> Path -> Path joinAt _ (v:vs) (w:ws) | v==w = joinAt v vs ws joinAt x p q = reverse p++(x:q) hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/MaxFlow.hs0000644006511100651110000001354010504340406024172 0ustar rossross-- | Maximum Flow algorithm -- We are given a flow network G=(V,E) with source s and sink t where each -- edge (u,v) in E has a nonnegative capacity c(u,v)>=0, and we wish to -- find a flow of maximum value from s to t. -- -- A flow in G=(V,E) is a real-valued function f:VxV->R that satisfies: -- -- @ -- For all u,v in V, f(u,v)\<=c(u,v) -- For all u,v in V, f(u,v)=-f(v,u) -- For all u in V-{s,t}, Sum{f(u,v):v in V } = 0 -- @ -- -- The value of a flow f is defined as |f|=Sum {f(s,v)|v in V}, i.e., -- the total net flow out of the source. -- -- In this module we implement the Edmonds-Karp algorithm, which is the -- Ford-Fulkerson method but using the shortest path from s to t as the -- augmenting path along which the flow is incremented. module Data.Graph.Inductive.Query.MaxFlow( getRevEdges, augmentGraph, updAdjList, updateFlow, mfmg, mf, maxFlowgraph, maxFlow ) where import Data.List import Data.Graph.Inductive.Basic import Data.Graph.Inductive.Graph --import Data.Graph.Inductive.Tree import Data.Graph.Inductive.Query.BFS -- | -- @ -- i 0 -- For each edge a--->b this function returns edge b--->a . -- i -- Edges a\<--->b are ignored -- j -- @ getRevEdges :: (Num b,Ord b) => [(Node,Node)] -> [(Node,Node,b)] getRevEdges [] = [] getRevEdges ((u,v):es) | notElem (v,u) es = (v,u,0):getRevEdges es | otherwise = getRevEdges (delete (v,u) es) -- | -- @ -- i 0 -- For each edge a--->b insert into graph the edge a\<---b . Then change the -- i (i,0,i) -- label of every edge from a---->b to a------->b -- @ -- -- where label (x,y,z)=(Max Capacity, Current flow, Residual capacity) augmentGraph :: (DynGraph gr,Num b,Ord b) => gr a b -> gr a (b,b,b) augmentGraph g = emap (\i->(i,0,i)) (insEdges (getRevEdges (edges g)) g) -- | Given a successor or predecessor list for node u and given node v, find -- the label corresponding to edge (u,v) and update the flow and residual -- capacity of that edge's label. Then return the updated list. updAdjList::(Num b,Ord b) => [((b,b,b),Node)]->Node->b->Bool->[((b,b,b),Node)] updAdjList s v cf fwd | fwd == True = ((x,y+cf,z-cf),w):rs | otherwise = ((x,y-cf,z+cf),w):rs where ((x,y,z),w) = head (filter (\(_,w')->v==w') s) rs = filter (\(_,w')->v/=w') s -- | Update flow and residual capacity along augmenting path from s to t in -- graph G. For a path [u,v,w,...] find the node u in G and its successor and -- predecessor list, then update the corresponding edges (u,v) and (v,u) on -- those lists by using the minimum residual capacity of the path. updateFlow :: (DynGraph gr,Num b,Ord b) => Path -> b -> gr a (b,b,b) -> gr a (b,b,b) updateFlow [] _ g = g updateFlow [_] _ g = g updateFlow (u:v:vs) cf g = case match u g of (Nothing,g') -> g' (Just (p,u',l,s),g') -> (p',u',l,s') & g2 where g2 = updateFlow (v:vs) cf g' s' = updAdjList s v cf True p' = updAdjList p v cf False -- | Compute the flow from s to t on a graph whose edges are labeled with -- (x,y,z)=(max capacity,current flow,residual capacity) and all edges -- are of the form a\<---->b. First compute the residual graph, that is, -- delete those edges whose residual capacity is zero. Then compute the -- shortest augmenting path from s to t, and finally update the flow and -- residual capacity along that path by using the minimum capacity of -- that path. Repeat this process until no shortest path from s to t exist. mfmg :: (DynGraph gr,Num b,Ord b) => gr a (b,b,b) -> Node -> Node -> gr a (b,b,b) mfmg g s t | augPath == [] = g | otherwise = mfmg (updateFlow augPath minC g) s t where minC = minimum (map ((\(_,_,z)->z).snd)(tail augLPath)) augPath = map fst augLPath LP augLPath = lesp s t gf gf = elfilter (\(_,_,z)->z/=0) g -- | Compute the flow from s to t on a graph whose edges are labeled with -- x, which is the max capacity and where not all edges need to be of the -- form a\<---->b. Return the flow as a grap whose edges are labeled with -- (x,y,z)=(max capacity,current flow,residual capacity) and all edges -- are of the form a\<---->b mf :: (DynGraph gr,Num b,Ord b) => gr a b -> Node -> Node -> gr a (b,b,b) mf g s t = mfmg (augmentGraph g) s t -- | Compute the maximum flow from s to t on a graph whose edges are labeled -- with x, which is the max capacity and where not all edges need to be of -- the form a\<---->b. Return the flow as a grap whose edges are labeled with -- (y,x) = (current flow, max capacity). maxFlowgraph :: (DynGraph gr,Num b,Ord b) => gr a b -> Node -> Node -> gr a (b,b) maxFlowgraph g s t = emap (\(u,v,_)->(v,u)) g2 where g2 = elfilter (\(x,_,_)->x/=0) g1 g1 = mf g s t -- | Compute the value of a maximumflow maxFlow :: (DynGraph gr,Num b,Ord b) => gr a b -> Node -> Node -> b maxFlow g s t = foldr (+) 0 (map (\(_,_,(x,_))->x)(out (maxFlowgraph g s t) s)) ------------------------------------------------------------------------------ -- Some test cases: clr595 is from the CLR textbook, page 595. The value of -- the maximum flow for s=1 and t=6 (23) coincides with the example but the -- flow itself is slightly different since the textbook does not compute the -- shortest augmenting path from s to t, but just any path. However remember -- that for a given flow graph the maximum flow is not unique. -- (gr595 is defined in GraphData.hs) ------------------------------------------------------------------------------ hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/MaxFlow2.hs0000644006511100651110000002271310504340406024256 0ustar rossross-- | Alternative Maximum Flow module Data.Graph.Inductive.Query.MaxFlow2( Network, ekSimple, ekFused, ekList, ) where -- ekSimple, ekFused, ekList) where import Data.List import Data.Maybe import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Tree import Data.Graph.Inductive.Internal.FiniteMap import Data.Graph.Inductive.Internal.Queue import Data.Graph.Inductive.Query.BFS (bft) ------------------------------------------------------------------------------ -- Data types -- Network data type type Network = Gr () (Double, Double) -- Data type for direction in which an edge is traversed data Direction = Forward | Backward deriving (Eq, Show) -- Data type for edge with direction of traversal type DirEdge b = (Node, Node, b, Direction) type DirPath=[(Node, Direction)] type DirRTree=[DirPath] pathFromDirPath = map (\(n,_)->n) ------------------------------------------------------------------------------ -- Example networks -- Example number 1 -- This network has a maximum flow of 2000 {- exampleNetwork1 :: Network exampleNetwork1=mkGraph [ (1,()), (2,()), (3,()), (4,()) ] [ (1,2,(1000,0)), (1,3,(1000,0)), (2,3,(1,0)), (2,4,(1000,0)), (3,4,(1000,0)) ] -- Example number 2 -- Taken from "Introduction to Algorithms" (Cormen, Leiserson, Rivest) -- This network has a maximum flow of 23 exampleNetwork2 :: Network -- Names of nodes in "Introduction to Algorithms": -- 1: s -- 2: v1 -- 3: v2 -- 4: v3 -- 5: v4 -- 6: t exampleNetwork2=mkGraph [ (1,()), (2,()), (3,()), (4,()), (5,()), (6,()) ] [ (1, 2, (16, 0)), (1, 3, (13, 0)), (2, 3, (10, 0)), (3, 2, (4, 0)), (2, 4, (12, 0)), (3, 5, (14, 0)), (4, 3, (9, 0)), (5, 4, (7, 0)), (4, 6, (20, 0)), (5, 6, (4, 0)) ] -} ------------------------------------------------------------------------------ -- Implementation of Edmonds-Karp algorithm -- EXTRACT fglEdmondsFused.txt -- Compute an augmenting path augPathFused :: Network -> Node -> Node -> Maybe DirPath augPathFused g s t = listToMaybe $ map reverse $ filter (\((u,_):_) -> u==t) tree where tree = bftForEK s g -- Breadth First Search wrapper function bftForEK :: Node -> Network -> DirRTree bftForEK v = bfForEK (queuePut [(v,Forward)] mkQueue) -- Breadth First Search, tailored for Edmonds & Karp bfForEK :: Queue DirPath -> Network -> DirRTree bfForEK q g | queueEmpty q || isEmpty g = [] | otherwise = case match v g of (Nothing, g') -> bfForEK q1 g' (Just (preAdj, _, _, sucAdj), g') -> p:bfForEK q2 g' where -- Insert successor nodes (with path to root) into queue q2 = queuePutList suc1 $ queuePutList suc2 q1 -- Traverse edges in reverse if flow positive suc1 = [ (preNode, Backward):p | ((_, f), preNode) <- preAdj, f>0] -- Traverse edges forwards if flow less than capacity suc2 = [ (sucNode,Forward):p | ((c, f), sucNode) <- sucAdj, c>f] where (p@((v,_):_), q1)=queueGet q -- Extract augmenting path from network; return path as a sequence of -- edges with direction of traversal, and new network with augmenting -- path removed. extractPathFused :: Network -> DirPath -> ([DirEdge (Double,Double)], Network) extractPathFused g [] = ([], g) extractPathFused g [(_,_)] = ([], g) extractPathFused g ((u,_):rest@((v,Forward):_)) = ((u, v, l, Forward):tailedges, newerg) where (tailedges, newerg) = extractPathFused newg rest Just (l, newg) = extractEdge g u v (\(c,f)->(c>f)) extractPathFused g ((u,_):rest@((v,Backward):_)) = ((v, u, l, Backward):tailedges, newerg) where (tailedges, newerg) = extractPathFused newg rest Just (l, newg) = extractEdge g v u (\(_,f)->(f>0)) -- ekFusedStep :: EKStepFunc ekFusedStep g s t = case maybePath of Just _ -> Just ((insEdges (integrateDelta es delta) newg), delta) Nothing -> Nothing where maybePath = augPathFused g s t (es, newg) = extractPathFused g (fromJust maybePath) delta = minimum $ getPathDeltas es ekFused :: Network -> Node -> Node -> (Network, Double) ekFused = ekWith ekFusedStep -- ENDEXTRACT ----------------------------------------------------------------------------- -- Alternative implementation: Use an explicit residual graph -- EXTRACT fglEdmondsSimple.txt residualGraph :: Network -> Gr () Double residualGraph g = mkGraph (labNodes g) ([(u, v, c-f) | (u, v, (c,f)) <- labEdges g, c>f ] ++ [(v, u, f) | (u,v,(_,f)) <- labEdges g, f>0]) augPath :: Network -> Node -> Node -> Maybe Path augPath g s t = listToMaybe $ map reverse $ filter (\(u:_) -> u==t) tree where tree = bft s (residualGraph g) -- Extract augmenting path from network; return path as a sequence of -- edges with direction of traversal, and new network with augmenting -- path removed. extractPath :: Network -> Path -> ([DirEdge (Double,Double)], Network) extractPath g [] = ([], g) extractPath g [_] = ([], g) extractPath g (u:v:ws) = case fwdExtract of Just (l, newg) -> ((u, v, l, Forward):tailedges, newerg) where (tailedges, newerg) = extractPath newg (v:ws) Nothing -> case revExtract of Just (l, newg) -> ((v, u, l, Backward):tailedges, newerg) where (tailedges, newerg) = extractPath newg (v:ws) Nothing -> error "extractPath: revExtract == Nothing" where fwdExtract = extractEdge g u v (\(c,f)->(c>f)) revExtract = extractEdge g v u (\(_,f)->(f>0)) -- Extract an edge from the graph that satisfies a given predicate -- Return the label on the edge and the graph without the edge extractEdge :: Gr a b -> Node -> Node -> (b->Bool) -> Maybe (b, Gr a b) extractEdge g u v p = case adj of Just (el, _) -> Just (el, (p', node, l, rest) & newg) Nothing -> Nothing where (Just (p', node, l, s), newg) = match u g (adj, rest)=extractAdj s (\(l', dest) -> (dest==v) && (p l')) -- Extract an item from an adjacency list that satisfies a given -- predicate. Return the item and the rest of the adjacency list extractAdj :: Adj b -> ((b,Node)->Bool) -> (Maybe (b,Node), Adj b) extractAdj [] _ = (Nothing, []) extractAdj (adj:adjs) p | p adj = (Just adj, adjs) | otherwise = (theone, adj:rest) where (theone, rest)=extractAdj adjs p getPathDeltas :: [DirEdge (Double,Double)] -> [Double] getPathDeltas [] = [] getPathDeltas (e:es) = case e of (_, _, (c,f), Forward) -> (c-f) : (getPathDeltas es) (_, _, (_,f), Backward) -> f : (getPathDeltas es) integrateDelta :: [DirEdge (Double,Double)] -> Double -> [LEdge (Double, Double)] integrateDelta [] _ = [] integrateDelta (e:es) delta = case e of (u, v, (c, f), Forward) -> (u, v, (c, f+delta)) : (integrateDelta es delta) (u, v, (c, f), Backward) -> (u, v, (c, f-delta)) : (integrateDelta es delta) type EKStepFunc = Network -> Node -> Node -> Maybe (Network, Double) ekSimpleStep :: EKStepFunc ekSimpleStep g s t = case maybePath of Just _ -> Just ((insEdges (integrateDelta es delta) newg), delta) Nothing -> Nothing where maybePath = augPath g s t (es, newg) = extractPath g (fromJust maybePath) delta = minimum $ getPathDeltas es ekWith :: EKStepFunc -> Network -> Node -> Node -> (Network, Double) ekWith stepfunc g s t = case stepfunc g s t of Just (newg, delta) -> (finalg, capacity+delta) where (finalg, capacity) = (ekWith stepfunc newg s t) Nothing -> (g, 0) ekSimple :: Network -> Node -> Node -> (Network, Double) ekSimple = ekWith ekSimpleStep -- ENDEXTRACT ----------------------------------------------------------------------------- -- Alternative implementation: Process list of edges to extract path instead -- of operating on graph structure -- EXTRACT fglEdmondsList.txt setFromList :: Ord a => [a] -> FiniteMap a () setFromList [] = emptyFM setFromList (x:xs) = addToFM (setFromList xs) x () setContains :: Ord a => FiniteMap a () -> a -> Bool setContains m i = case (lookupFM m i) of Nothing -> False Just () -> True extractPathList :: [LEdge (Double, Double)] -> FiniteMap (Node,Node) () -> ([DirEdge (Double, Double)], [LEdge (Double, Double)]) extractPathList [] _ = ([], []) extractPathList (edge@(u,v,l@(c,f)):es) set | (c>f) && (setContains set (u,v)) = let (pathrest, notrest)=extractPathList es (delFromFM set (u,v)) in ((u,v,l,Forward):pathrest, notrest) | (f>0) && (setContains set (v,u)) = let (pathrest, notrest)=extractPathList es (delFromFM set (u,v)) in ((u,v,l,Backward):pathrest, notrest) | otherwise = let (pathrest, notrest)=extractPathList es set in (pathrest, edge:notrest) ekStepList :: EKStepFunc ekStepList g s t = case maybePath of Just _ -> Just (mkGraph (labNodes g) newEdges, delta) Nothing -> Nothing where newEdges = (integrateDelta es delta) ++ otheredges maybePath = augPathFused g s t (es, otheredges) = extractPathList (labEdges g) (setFromList (zip justPath (tail justPath))) delta = minimum $ getPathDeltas es justPath = pathFromDirPath (fromJust maybePath) ekList :: Network -> Node -> Node -> (Network, Double) ekList = ekWith ekStepList -- ENDEXTRACT hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/Monad.hs0000644006511100651110000001743610504340406023663 0ustar rossross-- (c) 2002 by Martin Erwig [see file COPYRIGHT] -- | Monadic Graph Algorithms module Data.Graph.Inductive.Query.Monad( -- * Additional Graph Utilities mapFst, mapSnd, (><), orP, -- * Graph Transformer Monad GT(..), apply, apply', applyWith, applyWith', runGT, condMGT', recMGT', condMGT, recMGT, -- * Graph Computations Based on Graph Monads -- ** Monadic Graph Accessing Functions getNode, getContext, getNodes', getNodes, sucGT, sucM, -- ** Derived Graph Recursion Operators graphRec, graphRec', graphUFold, -- * Examples: Graph Algorithms as Instances of Recursion Operators -- ** Instances of graphRec graphNodesM0, graphNodesM, graphNodes, graphFilterM, graphFilter, -- * Example: Monadic DFS Algorithm(s) dfsGT, dfsM, dfsM', dffM, graphDff, graphDff', ) where -- Why all this? -- -- graph monad ensures single-threaded access -- ==> we can safely use imperative updates in the graph implementation -- import Data.Tree --import Control.Monad (liftM) import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Monad -- some additional (graph) utilities -- mapFst :: (a -> b) -> (a, c) -> (b, c) mapFst f (x,y) = (f x,y) mapSnd :: (a -> b) -> (c, a) -> (c, b) mapSnd f (x,y) = (x,f y) infixr 8 >< (><) :: (a -> b) -> (c -> d) -> (a, c) -> (b, d) (f >< g) (x,y) = (f x,g y) orP :: (a -> Bool) -> (b -> Bool) -> (a,b) -> Bool orP p q (x,y) = p x || q y ---------------------------------------------------------------------- -- "wrapped" state transformer monad == -- monadic graph transformer monad ---------------------------------------------------------------------- data GT m g a = MGT (m g -> m (a,g)) apply :: GT m g a -> m g -> m (a,g) apply (MGT f) mg = f mg apply' :: Monad m => GT m g a -> g -> m (a,g) apply' gt = apply gt . return applyWith :: Monad m => (a -> b) -> GT m g a -> m g -> m (b,g) applyWith h (MGT f) gm = do {(x,g) <- f gm; return (h x,g)} applyWith' :: Monad m => (a -> b) -> GT m g a -> g -> m (b,g) applyWith' h gt = applyWith h gt . return runGT :: Monad m => GT m g a -> m g -> m a runGT gt mg = do {(x,_) <- apply gt mg; return x} instance Monad m => Monad (GT m g) where return x = MGT (\mg->do {g<-mg; return (x,g)}) f >>= h = MGT (\mg->do {(x,g)<-apply f mg; apply' (h x) g}) condMGT' :: Monad m => (s -> Bool) -> GT m s a -> GT m s a -> GT m s a condMGT' p f g = MGT (\mg->do {h<-mg; if p h then apply f mg else apply g mg}) recMGT' :: Monad m => (s -> Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b recMGT' p mg f u = condMGT' p (return u) (do {x<-mg;y<-recMGT' p mg f u;return (f x y)}) condMGT :: Monad m => (m s -> m Bool) -> GT m s a -> GT m s a -> GT m s a condMGT p f g = MGT (\mg->do {b<-p mg; if b then apply f mg else apply g mg}) recMGT :: Monad m => (m s -> m Bool) -> GT m s a -> (a -> b -> b) -> b -> GT m s b recMGT p mg f u = condMGT p (return u) (do {x<-mg;y<-recMGT p mg f u;return (f x y)}) ---------------------------------------------------------------------- -- graph computations based on state monads/graph monads ---------------------------------------------------------------------- -- some monadic graph accessing functions -- getNode :: GraphM m gr => GT m (gr a b) Node getNode = MGT (\mg->do {((_,v,_,_),g) <- matchAnyM mg; return (v,g)}) getContext :: GraphM m gr => GT m (gr a b) (Context a b) getContext = MGT matchAnyM -- some functions defined by using the do-notation explicitly -- Note: most of these can be expressed as an instance of graphRec -- getNodes' :: (Graph gr,GraphM m gr) => GT m (gr a b) [Node] getNodes' = condMGT' isEmpty (return []) (do v <- getNode vs <- getNodes return (v:vs)) getNodes :: GraphM m gr => GT m (gr a b) [Node] getNodes = condMGT isEmptyM (return []) (do v <- getNode vs <- getNodes return (v:vs)) sucGT :: GraphM m gr => Node -> GT m (gr a b) (Maybe [Node]) sucGT v = MGT (\mg->do (c,g) <- matchM v mg case c of Just (_,_,_,s) -> return (Just (map snd s),g) Nothing -> return (Nothing,g) ) sucM :: GraphM m gr => Node -> m (gr a b) -> m (Maybe [Node]) sucM v = runGT (sucGT v) ---------------------------------------------------------------------- -- some derived graph recursion operators ---------------------------------------------------------------------- -- -- graphRec :: GraphMonad a b c -> (c -> d -> d) -> d -> GraphMonad a b d -- graphRec f g u = cond isEmpty (return u) -- (do x <- f -- y <- graphRec f g u -- return (g x y)) -- | encapsulates a simple recursion schema on graphs graphRec :: GraphM m gr => GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d graphRec = recMGT isEmptyM graphRec' :: (Graph gr,GraphM m gr) => GT m (gr a b) c -> (c -> d -> d) -> d -> GT m (gr a b) d graphRec' = recMGT' isEmpty graphUFold :: GraphM m gr => (Context a b -> c -> c) -> c -> GT m (gr a b) c graphUFold = graphRec getContext ---------------------------------------------------------------------- -- Examples: graph algorithms as instances of recursion operators ---------------------------------------------------------------------- -- instances of graphRec -- graphNodesM0 :: GraphM m gr => GT m (gr a b) [Node] graphNodesM0 = graphRec getNode (:) [] graphNodesM :: GraphM m gr => GT m (gr a b) [Node] graphNodesM = graphUFold (\(_,v,_,_)->(v:)) [] graphNodes :: GraphM m gr => m (gr a b) -> m [Node] graphNodes = runGT graphNodesM graphFilterM :: GraphM m gr => (Context a b -> Bool) -> GT m (gr a b) [Context a b] graphFilterM p = graphUFold (\c cs->if p c then c:cs else cs) [] graphFilter :: GraphM m gr => (Context a b -> Bool) -> m (gr a b) -> m [Context a b] graphFilter p = runGT (graphFilterM p) ---------------------------------------------------------------------- -- Example: monadic dfs algorithm(s) ---------------------------------------------------------------------- -- | Monadic graph algorithms are defined in two steps: -- -- (1) define the (possibly parameterized) graph transformer (e.g., dfsGT) -- (2) run the graph transformer (applied to arguments) (e.g., dfsM) -- dfsGT :: GraphM m gr => [Node] -> GT m (gr a b) [Node] dfsGT [] = return [] dfsGT (v:vs) = MGT (\mg-> do (mc,g') <- matchM v mg case mc of Just (_,_,_,s) -> applyWith' (v:) (dfsGT (map snd s++vs)) g' Nothing -> apply' (dfsGT vs) g' ) -- | depth-first search yielding number of nodes dfsM :: GraphM m gr => [Node] -> m (gr a b) -> m [Node] dfsM vs = runGT (dfsGT vs) dfsM' :: GraphM m gr => m (gr a b) -> m [Node] dfsM' mg = do {vs <- nodesM mg; runGT (dfsGT vs) mg} -- | depth-first search yielding dfs forest dffM :: GraphM m gr => [Node] -> GT m (gr a b) [Tree Node] dffM vs = MGT (\mg-> do g<-mg b<-isEmptyM mg if b||null vs then return ([],g) else let (v:vs') = vs in do (mc,g1) <- matchM v mg case mc of Nothing -> apply (dffM vs') (return g1) Just c -> do (ts, g2) <- apply (dffM (suc' c)) (return g1) (ts',g3) <- apply (dffM vs') (return g2) return (Node (node' c) ts:ts',g3) ) graphDff :: GraphM m gr => [Node] -> m (gr a b) -> m [Tree Node] graphDff vs = runGT (dffM vs) graphDff' :: GraphM m gr => m (gr a b) -> m [Tree Node] graphDff' mg = do {vs <- nodesM mg; runGT (dffM vs) mg} hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/SP.hs0000644006511100651110000000213210504340406023132 0ustar rossross-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT] module Data.Graph.Inductive.Query.SP( spTree,spLength,sp, dijkstra ) where import qualified Data.Graph.Inductive.Internal.Heap as H import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Internal.RootPath expand :: Real b => b -> LPath b -> Context a b -> [H.Heap b (LPath b)] expand d (LP p) (_,_,_,s) = map (\(l,v)->H.unit (l+d) (LP ((v,l+d):p))) s -- | Implementation of Dijkstra's shortest path algorithm dijkstra :: (Graph gr, Real b) => H.Heap b (LPath b) -> gr a b -> LRTree b dijkstra h g | H.isEmpty h || isEmpty g = [] dijkstra h g = case match v g of (Just c,g') -> p:dijkstra (H.mergeAll (h':expand d p c)) g' (Nothing,g') -> dijkstra h' g' where (_,p@(LP ((v,d):_)),h') = H.splitMin h spTree :: (Graph gr, Real b) => Node -> gr a b -> LRTree b spTree v = dijkstra (H.unit 0 (LP [(v,0)])) spLength :: (Graph gr, Real b) => Node -> Node -> gr a b -> b spLength s t = getDistance t . spTree s sp :: (Graph gr, Real b) => Node -> Node -> gr a b -> Path sp s t = getLPathNodes t . spTree s hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query/TransClos.hs0000644006511100651110000000124310504340406024522 0ustar rossrossmodule Data.Graph.Inductive.Query.TransClos( trc ) where import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Query.DFS (reachable) getNewEdges :: DynGraph gr => [LNode a] -> gr a b -> [LEdge ()] getNewEdges vs g = concatMap (\(u,_)->r u g) vs where r = \u g' -> map (\v->(u,v,())) (reachable u g') {-| Finds the transitive closure of a directed graph. Given a graph G=(V,E), its transitive closure is the graph: G* = (V,E*) where E*={(i,j): i,j in V and there is a path from i to j in G} -} trc :: DynGraph gr => gr a b -> gr a () trc g = insEdges (getNewEdges ln g) (insNodes ln empty) where ln = labNodes g hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Monad.hs0000644006511100651110000001504010504340406022543 0ustar rossross-- (c) 2002 by Martin Erwig [see file COPYRIGHT] -- | Monadic Graphs module Data.Graph.Inductive.Monad( -- * Classes GraphM(..), -- * Operations -- ** Graph Folds and Maps ufoldM, -- ** Graph Projection nodesM,edgesM,newNodesM, -- ** Graph Construction and Destruction delNodeM,delNodesM, mkUGraphM, -- ** Graph Inspection contextM,labM ) where import Data.Graph.Inductive.Graph ---------------------------------------------------------------------- -- MONADIC GRAPH CLASS ---------------------------------------------------------------------- -- -- Currently, we define just one monadic graph class: -- -- GraphM: static, decomposable graphs -- static means that a graph itself cannot be changed -- -- Later we might also define DynGraphM for dynamic, extensible graphs -- -- Monadic Graph -- class Monad m => GraphM m gr where -- essential operations emptyM :: m (gr a b) isEmptyM :: m (gr a b) -> m Bool matchM :: Node -> m (gr a b) -> m (Decomp gr a b) mkGraphM :: [LNode a] -> [LEdge b] -> m (gr a b) labNodesM :: m (gr a b) -> m [LNode a] -- derived operations matchAnyM :: m (gr a b) -> m (GDecomp gr a b) noNodesM :: m (gr a b) -> m Int nodeRangeM :: m (gr a b) -> m (Node,Node) labEdgesM :: m (gr a b) -> m [LEdge b] -- default implementation of derived operations matchAnyM g = do vs <- labNodesM g case vs of [] -> error "Match Exception, Empty Graph" (v,_):_ -> do (Just c,g') <- matchM v g return (c,g') noNodesM = labNodesM >>. length nodeRangeM g = do vs <- labNodesM g let vs' = map fst vs return (minimum vs',maximum vs') labEdgesM = ufoldM (\(p,v,_,s)->(((map (i v) p)++(map (o v) s))++)) [] where o v = \(l,w)->(v,w,l) i v = \(l,w)->(w,v,l) -- composing a monadic function with a non-monadic one -- (>>.) :: Monad m => (m a -> m b) -> (b -> c) -> (m a -> m c) f >>. g = (>>= return . g) . f ---------------------------------------------------------------------- -- DERIVED GRAPH OPERATIONS ---------------------------------------------------------------------- -- graph folds and maps -- -- | graph fold ufoldM :: GraphM m gr => ((Context a b) -> c -> c) -> c -> m (gr a b) -> m c ufoldM f u g = do b <- isEmptyM g if b then return u else do (c,g') <- matchAnyM g x <- ufoldM f u (return g') return (f c x) -- (additional) graph projection -- [noNodes, nodeRange, labNodes, labEdges are defined in class Graph] -- nodesM :: GraphM m gr => m (gr a b) -> m [Node] nodesM = labNodesM >>. map fst edgesM :: GraphM m gr => m (gr a b) -> m [Edge] edgesM = labEdgesM >>. map (\(v,w,_)->(v,w)) newNodesM :: GraphM m gr => Int -> m (gr a b) -> m [Node] newNodesM i g = do (_,n) <- nodeRangeM g return [n+1..n+i] -- graph construction & destruction -- delNodeM :: GraphM m gr => Node -> m (gr a b) -> m (gr a b) delNodeM v = delNodesM [v] delNodesM :: GraphM m gr => [Node] -> m (gr a b) -> m (gr a b) delNodesM [] g = g delNodesM (v:vs) g = do (_,g') <- matchM v g delNodesM vs (return g') mkUGraphM :: GraphM m gr => [Node] -> [Edge] -> m (gr () ()) mkUGraphM vs es = mkGraphM (labUNodes vs) (labUEdges es) labUEdges = map (\(v,w)->(v,w,())) labUNodes = map (\v->(v,())) -- graph inspection (for a particular node) -- onMatch :: GraphM m gr => (Context a b -> c) -> c -> m (gr a b) -> Node -> m c onMatch f u g v = do (x,_) <- matchM v g return (case x of {Nothing -> u; Just c -> f c}) contextM :: GraphM m gr => m (gr a b) -> Node -> m (Context a b) contextM g v = onMatch id (error ("Match Exception, Node: "++show v)) g v labM :: GraphM m gr => m (gr a b) -> Node -> m (Maybe a) labM = onMatch (Just . lab') Nothing {- neighbors :: GraphM m gr => m (gr a b) -> Node -> [Node] neighbors = (\(p,_,_,s) -> map snd (p++s)) .: context suc :: GraphM m gr => m (gr a b) -> Node -> [Node] suc = map snd .: context4 pre :: GraphM m gr => m (gr a b) -> Node -> [Node] pre = map snd .: context1 lsuc :: GraphM m gr => m (gr a b) -> Node -> [(Node,b)] lsuc = map flip2 .: context4 lpre :: GraphM m gr => m (gr a b) -> Node -> [(Node,b)] lpre = map flip2 .: context1 out :: GraphM m gr => m (gr a b) -> Node -> [LEdge b] out g v = map (\(l,w)->(v,w,l)) (context4 g v) inn :: GraphM m gr => m (gr a b) -> Node -> [LEdge b] inn g v = map (\(l,w)->(w,v,l)) (context1 g v) outdeg :: GraphM m gr => m (gr a b) -> Node -> Int outdeg = length .: context4 indeg :: GraphM m gr => m (gr a b) -> Node -> Int indeg = length .: context1 deg :: GraphM m gr => m (gr a b) -> Node -> Int deg = (\(p,_,_,s) -> length p+length s) .: context -- -- -- context inspection -- -- -- node' :: Context a b -> Node -- node' (_,v,_,_) = v -- -- lab' :: Context a b -> a -- lab' (_,_,l,_) = l -- -- labNode' :: Context a b -> LNode a -- labNode' (_,v,l,_) = (v,l) -- -- neighbors' :: Context a b -> [Node] -- neighbors' (p,_,_,s) = map snd p++map snd s -- -- suc' :: Context a b -> [Node] -- suc' (_,_,_,s) = map snd s -- -- pre' :: Context a b -> [Node] -- pre' (p,_,_,_) = map snd p -- -- lpre' :: Context a b -> [(Node,b)] -- lpre' (p,_,_,_) = map flip2 p -- -- lsuc' :: Context a b -> [(Node,b)] -- lsuc' (_,_,_,s) = map flip2 s -- -- out' :: Context a b -> [LEdge b] -- out' (_,v,_,s) = map (\(l,w)->(v,w,l)) s -- -- inn' :: Context a b -> [LEdge b] -- inn' (p,v,_,_) = map (\(l,w)->(w,v,l)) p -- -- outdeg' :: Context a b -> Int -- outdeg' (_,_,_,s) = length s -- -- indeg' :: Context a b -> Int -- indeg' (p,_,_,_) = length p -- -- deg' :: Context a b -> Int -- deg' (p,_,_,s) = length p+length s -- graph equality -- nodeComp :: Eq b => LNode b -> LNode b -> Ordering nodeComp n@(v,a) n'@(w,b) | n == n' = EQ | v m (gr a b) -> [LNode a] slabNodes = sortBy nodeComp . labNodes edgeComp :: Eq b => LEdge b -> LEdge b -> Ordering edgeComp e@(v,w,a) e'@(x,y,b) | e == e' = EQ | v m (gr a b) -> [LEdge b] slabEdges = sortBy edgeComp . labEdges instance (Eq a,Eq b,Graph gr) => Eq (m (gr a b)) where g == g' = slabNodes g == slabNodes g' && slabEdges g == slabEdges g' -} hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/NodeMap.hs0000644006511100651110000002001210504340406023023 0ustar rossross-- | Utility methods to automatically generate and keep track of a mapping -- between node labels and 'Node's. module Data.Graph.Inductive.NodeMap( -- * Functional Construction NodeMap, -- ** Map Construction new, fromGraph, mkNode, mkNode_, mkNodes, mkNodes_, mkEdge, mkEdges, -- ** Graph Construction -- | These functions mirror the construction and destruction functions in -- 'Data.Graph.Inductive.Graph', but use the given 'NodeMap' to look up -- the appropriate 'Node's. Note that the 'insMapNode' family of functions -- will create new nodes as needed, but the other functions will not. insMapNode, insMapNode_, insMapEdge, delMapNode, delMapEdge, insMapNodes, insMapNodes_, insMapEdges, delMapNodes, delMapEdges, mkMapGraph, -- * Monadic Construction NodeMapM, -- | The following mirror the functional construction functions, but handle passing -- 'NodeMap's and 'Graph's behind the scenes. -- ** Map Construction run, run_, mkNodeM, mkNodesM, mkEdgeM, mkEdgesM, -- ** Graph Construction insMapNodeM, insMapEdgeM, delMapNodeM, delMapEdgeM, insMapNodesM, insMapEdgesM, delMapNodesM, delMapEdgesM ) where import Prelude hiding (map) import qualified Prelude as P (map) import Control.Monad.State import Data.Graph.Inductive.Graph --import Data.Graph.Inductive.Tree import Data.Graph.Inductive.Internal.FiniteMap data (Ord a) => NodeMap a = NodeMap { map :: FiniteMap a Node, key :: Int } deriving Show -- | Create a new, empty mapping. new :: (Ord a) => NodeMap a new = NodeMap { map = emptyFM, key = 0 } -- LNode = (Node, a) -- | Generate a mapping containing the nodes in the given graph. fromGraph :: (Ord a, Graph g) => g a b -> NodeMap a fromGraph g = let ns = labNodes g aux (n, a) (m', k') = (addToFM m' a n, max n k') (m, k) = foldr aux (emptyFM, 0) ns in NodeMap { map = m, key = k+1 } -- | Generate a labelled node from the given label. Will return the same node -- for the same label. mkNode :: (Ord a) => NodeMap a -> a -> (LNode a, NodeMap a) mkNode m@(NodeMap mp k) a = case lookupFM mp a of Just i -> ((i, a), m) Nothing -> let m' = NodeMap { map = addToFM mp a k, key = k+1 } in ((k, a), m') -- | Generate a labelled node and throw away the modified 'NodeMap'. mkNode_ :: (Ord a) => NodeMap a -> a -> LNode a mkNode_ m a = fst $ mkNode m a -- | Generate a 'LEdge' from the node labels. mkEdge :: (Ord a) => NodeMap a -> (a, a, b) -> Maybe (LEdge b) mkEdge (NodeMap m _) (a1, a2, b) = do n1 <- lookupFM m a1 n2 <- lookupFM m a2 return (n1, n2, b) -- | Generates a list of 'LEdge's. mkEdges :: (Ord a) => NodeMap a -> [(a, a, b)] -> Maybe [LEdge b] mkEdges m es = mapM (mkEdge m) es -- | Construct a list of nodes. mkNodes :: (Ord a) => NodeMap a -> [a] -> ([LNode a], NodeMap a) mkNodes = map' mkNode map' :: (a -> b -> (c, a)) -> a -> [b] -> ([c], a) map' _ a [] = ([], a) map' f a (b:bs) = let (c, a') = f a b (cs, a'') = map' f a' bs in (c:cs, a'') -- | Construct a list of nodes and throw away the modified 'NodeMap'. mkNodes_ :: (Ord a) => NodeMap a -> [a] -> [LNode a] mkNodes_ m as = fst $ mkNodes m as insMapNode :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> (g a b, NodeMap a, LNode a) insMapNode m a g = let (n, m') = mkNode m a in (insNode n g, m', n) insMapNode_ :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> g a b insMapNode_ m a g = let (g', _, _) = insMapNode m a g in g' insMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a, b) -> g a b -> g a b insMapEdge m e g = let (Just e') = mkEdge m e in insEdge e' g delMapNode :: (Ord a, DynGraph g) => NodeMap a -> a -> g a b -> g a b delMapNode m a g = let (n, _) = mkNode_ m a in delNode n g delMapEdge :: (Ord a, DynGraph g) => NodeMap a -> (a, a) -> g a b -> g a b delMapEdge m (n1, n2) g = let Just (n1', n2', _) = mkEdge m (n1, n2, ()) in delEdge (n1', n2') g insMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> (g a b, NodeMap a, [LNode a]) insMapNodes m as g = let (ns, m') = mkNodes m as in (insNodes ns g, m', ns) insMapNodes_ :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> g a b insMapNodes_ m as g = let (g', _, _) = insMapNodes m as g in g' insMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a, b)] -> g a b -> g a b insMapEdges m es g = let Just es' = mkEdges m es in insEdges es' g delMapNodes :: (Ord a, DynGraph g) => NodeMap a -> [a] -> g a b -> g a b delMapNodes m as g = let ns = P.map fst $ mkNodes_ m as in delNodes ns g delMapEdges :: (Ord a, DynGraph g) => NodeMap a -> [(a, a)] -> g a b -> g a b delMapEdges m ns g = let Just ns' = mkEdges m $ P.map (\(a, b) -> (a, b, ())) ns ns'' = P.map (\(a, b, _) -> (a, b)) ns' in delEdges ns'' g mkMapGraph :: (Ord a, DynGraph g) => [a] -> [(a, a, b)] -> (g a b, NodeMap a) mkMapGraph ns es = let (ns', m') = mkNodes new ns Just es' = mkEdges m' es in (mkGraph ns' es', m') -- | Graph construction monad; handles passing both the 'NodeMap' and the -- 'Graph'. type NodeMapM a b g r = State (NodeMap a, g a b) r -- | Run a construction; return the value of the computation, the modified -- 'NodeMap', and the modified 'Graph'. run :: (DynGraph g, Ord a) => g a b -> NodeMapM a b g r -> (r, (NodeMap a, g a b)) run g m = runState m (fromGraph g, g) -- | Run a construction and only return the 'Graph'. run_ :: (DynGraph g, Ord a) => g a b -> NodeMapM a b g r -> g a b run_ g m = snd . snd $ run g m {- not used liftN1 :: (Ord a, DynGraph g) => (NodeMap a -> (c, NodeMap a)) -> NodeMapM a b g c liftN1 f = do (m, g) <- get let (r, m') = f m put (m', g) return r liftN1' :: (Ord a, DynGraph g) => (NodeMap a -> c) -> NodeMapM a b g c liftN1' f = do (m, g) <- get return $ f m -} liftN2 :: (Ord a, DynGraph g) => (NodeMap a -> c -> (d, NodeMap a)) -> c -> NodeMapM a b g d liftN2 f c = do (m, g) <- get let (r, m') = f m c put (m', g) return r liftN2' :: (Ord a, DynGraph g) => (NodeMap a -> c -> d) -> c -> NodeMapM a b g d liftN2' f c = do (m, _) <- get return $ f m c {- not used liftN3 :: (Ord a, DynGraph g) => (NodeMap a -> c -> d -> (e, NodeMap a)) -> c -> d -> NodeMapM a b g e liftN3 f c d = do (m, g) <- get let (r, m') = f m c d put (m', g) return r liftN3' :: (Ord a, DynGraph g) => (NodeMap a -> c -> d -> e) -> c -> d -> NodeMapM a b g e liftN3' f c d = do (m, g) <- get return $ f m c d -} liftM1 :: (Ord a, DynGraph g) => (NodeMap a -> c -> g a b -> g a b) -> c -> NodeMapM a b g () liftM1 f c = do (m, g) <- get let g' = f m c g put (m, g') liftM1' :: (Ord a, DynGraph g) => (NodeMap a -> c -> g a b -> (g a b, NodeMap a, d)) -> c -> NodeMapM a b g d liftM1' f c = do (m, g) <- get let (g', m', r) = f m c g put (m', g') return r -- | Monadic node construction. mkNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g (LNode a) mkNodeM = liftN2 mkNode mkNodesM :: (Ord a, DynGraph g) => [a] -> NodeMapM a b g [LNode a] mkNodesM = liftN2 mkNodes mkEdgeM :: (Ord a, DynGraph g) => (a, a, b) -> NodeMapM a b g (Maybe (LEdge b)) mkEdgeM = liftN2' mkEdge mkEdgesM :: (Ord a, DynGraph g) => [(a, a, b)] -> NodeMapM a b g (Maybe [LEdge b]) mkEdgesM = liftN2' mkEdges insMapNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g (LNode a) insMapNodeM = liftM1' insMapNode insMapEdgeM :: (Ord a, DynGraph g) => (a, a, b) -> NodeMapM a b g () insMapEdgeM = liftM1 insMapEdge delMapNodeM :: (Ord a, DynGraph g) => a -> NodeMapM a b g () delMapNodeM = liftM1 delMapNode delMapEdgeM :: (Ord a, DynGraph g) => (a, a) -> NodeMapM a b g () delMapEdgeM = liftM1 delMapEdge insMapNodesM :: (Ord a, DynGraph g) => [a] -> NodeMapM a b g [LNode a] insMapNodesM = liftM1' insMapNodes insMapEdgesM :: (Ord a, DynGraph g) => [(a, a, b)] -> NodeMapM a b g () insMapEdgesM = liftM1 insMapEdges delMapNodesM :: (Ord a, DynGraph g) => [a] -> NodeMapM a b g () delMapNodesM = liftM1 delMapNodes delMapEdgesM :: (Ord a, DynGraph g) => [(a, a)] -> NodeMapM a b g () delMapEdgesM = liftM1 delMapEdges hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Query.hs0000644006511100651110000000220510504340406022611 0ustar rossrossmodule Data.Graph.Inductive.Query( module Data.Graph.Inductive.Query.DFS, module Data.Graph.Inductive.Query.BFS, module Data.Graph.Inductive.Query.SP, module Data.Graph.Inductive.Query.GVD, module Data.Graph.Inductive.Query.MST, module Data.Graph.Inductive.Query.Indep, module Data.Graph.Inductive.Query.MaxFlow, module Data.Graph.Inductive.Query.MaxFlow2, module Data.Graph.Inductive.Query.ArtPoint, module Data.Graph.Inductive.Query.BCC, module Data.Graph.Inductive.Query.Dominators, module Data.Graph.Inductive.Query.TransClos, module Data.Graph.Inductive.Query.Monad, ) where import Data.Graph.Inductive.Query.DFS import Data.Graph.Inductive.Query.BFS import Data.Graph.Inductive.Query.SP import Data.Graph.Inductive.Query.GVD import Data.Graph.Inductive.Query.MST import Data.Graph.Inductive.Query.Indep import Data.Graph.Inductive.Query.MaxFlow import Data.Graph.Inductive.Query.MaxFlow2 import Data.Graph.Inductive.Query.ArtPoint import Data.Graph.Inductive.Query.BCC import Data.Graph.Inductive.Query.Dominators import Data.Graph.Inductive.Query.TransClos import Data.Graph.Inductive.Query.Monad hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive/Tree.hs0000644006511100651110000000606610504340406022414 0ustar rossross-- (c) 1999 - 2002 by Martin Erwig [see file COPYRIGHT] -- | Tree-based implementation of 'Graph' and 'DynGraph' module Data.Graph.Inductive.Tree (Gr,UGr) where import Data.List (foldl') import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Internal.FiniteMap import Data.Maybe (fromJust) ---------------------------------------------------------------------- -- GRAPH REPRESENTATION ---------------------------------------------------------------------- data Gr a b = Gr (GraphRep a b) type GraphRep a b = FiniteMap Node (Context' a b) type Context' a b = (Adj b,a,Adj b) type UGr = Gr () () ---------------------------------------------------------------------- -- CLASS INSTANCES ---------------------------------------------------------------------- -- Show -- showsGraph :: (Show a,Show b) => GraphRep a b -> ShowS showsGraph Empty = id showsGraph (Node _ l (v,(_,l',s)) r) = showsGraph l . ('\n':) . shows v . (':':) . shows l' . ("->"++) . shows s . showsGraph r instance (Show a,Show b) => Show (Gr a b) where showsPrec _ (Gr g) = showsGraph g -- Graph -- instance Graph Gr where empty = Gr emptyFM isEmpty (Gr g) = case g of {Empty -> True; _ -> False} match = matchGr mkGraph vs es = (insEdges' . insNodes vs) empty where insEdges' g = foldl' (flip insEdge) g es labNodes (Gr g) = map (\(v,(_,l,_))->(v,l)) (fmToList g) -- more efficient versions of derived class members -- matchAny (Gr Empty) = error "Match Exception, Empty Graph" matchAny g@(Gr (Node _ _ (v,_) _)) = (c,g') where (Just c,g') = matchGr v g noNodes (Gr g) = sizeFM g nodeRange (Gr Empty) = (0,0) nodeRange (Gr g) = (ix (minFM g),ix (maxFM g)) where ix = fst.fromJust labEdges (Gr g) = concatMap (\(v,(_,_,s))->map (\(l,w)->(v,w,l)) s) (fmToList g) matchGr v (Gr g) = case splitFM g v of Nothing -> (Nothing,Gr g) Just (g',(_,(p,l,s))) -> (Just (p',v,l,s),Gr g2) where s' = filter ((/=v).snd) s p' = filter ((/=v).snd) p g1 = updAdj g' s' (clearPred v) g2 = updAdj g1 p' (clearSucc v) -- DynGraph -- instance DynGraph Gr where (p,v,l,s) & (Gr g) | elemFM g v = error ("Node Exception, Node: "++show v) | otherwise = Gr g3 where g1 = addToFM g v (p,l,s) g2 = updAdj g1 p (addSucc v) g3 = updAdj g2 s (addPred v) ---------------------------------------------------------------------- -- UTILITIES ---------------------------------------------------------------------- addSucc v l (p,l',s) = (p,l',(l,v):s) addPred v l (p,l',s) = ((l,v):p,l',s) clearSucc v _ (p,l,s) = (p,l,filter ((/=v).snd) s) clearPred v _ (p,l,s) = (filter ((/=v).snd) p,l,s) updAdj :: GraphRep a b -> Adj b -> (b -> Context' a b -> Context' a b) -> GraphRep a b updAdj g [] _ = g updAdj g ((l,v):vs) f | elemFM g v = updAdj (updFM g v (f l)) vs f | otherwise = error ("Edge Exception, Node: "++show v) hugs98-plus-Sep2006/packages/fgl/Data/Graph/Inductive.hs0000644006511100651110000000204410504340406021505 0ustar rossross------------------------------------------------------------------------------ -- -- Inductive.hs -- Functional Graph Library -- -- (c) 1999-2006 by Martin Erwig [see file COPYRIGHT] -- ------------------------------------------------------------------------------ module Data.Graph.Inductive( module Data.Graph.Inductive.Graph, module Data.Graph.Inductive.Tree, module Data.Graph.Inductive.Basic, module Data.Graph.Inductive.Monad, module Data.Graph.Inductive.Monad.IOArray, module Data.Graph.Inductive.Query, module Data.Graph.Inductive.Graphviz, module Data.Graph.Inductive.NodeMap, -- * Version Information version ) where import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Tree import Data.Graph.Inductive.Basic import Data.Graph.Inductive.Monad import Data.Graph.Inductive.Monad.IOArray import Data.Graph.Inductive.Query import Data.Graph.Inductive.Graphviz import Data.Graph.Inductive.NodeMap -- | Version info version :: IO () version = putStrLn "\nFGL - Functional Graph Library, June 2006" hugs98-plus-Sep2006/packages/fgl/doc/0000755006511100651110000000000010504340406016052 5ustar rossrosshugs98-plus-Sep2006/packages/fgl/doc/CHANGES0000644006511100651110000000460710504340406017054 0ustar rossrossCHANGES (FGL/HASKELL, Version: June 2006) -------------------------------------------- June 2006 --------- * fixed a bug in findP (thanks to lnagy@fit.edu) * added function delLEdge in Graph.hs (thanks to Jose Labra) * changed implementation of updFM and mkGraph (thanks to Don Stewart) February 2005 ------------- * fixed an import error in Basic.hs * removed Eq instance of gr because it caused overlapping instance problems. Instead the function equal defined in Graph.hs can be used * added some more functions to the export list of DFS.hs * changed the definition of LPath into a newtype to avoid overlapping instances with lists * fixed the Makefile (for GHC and GHCi) January 2004 ------------ * bug fix for nearestNode (src/Data/Graph/Inductive/Query/GVD.hs) Update contributed by Aetion Technologies LLC (www.aetion.com) * Refactor into hierarchical namespace * Build changes: - build a standard haskell library (libHSfgl.a, HSfgl.o) - install as ghc package (fgl), uses Auto so no -package is needed * Automatic Node generation for labels: Data.Graph.Inductive.NodeMap * Graphviz output: Data.Graph.Inductive.Graphviz September 2002 -------------- * Introduction of graph classes * Monadic graphs and graph computation monad * Graph implementation based on balanced (AVL) trees * Fast graph implementation based on IO arrays * New algorithms: - Maximum flow - Articulation points - biconnected components - dominators - transitive closure * minor changes in utility functions - changed signatures (swapped order of arguments) of functions context and lab to be consistent with other graph functions - changed function first in RootPath: not existing path is now reported as an empty list and will not produce an error - esp version that returns a list of labeled edges (to find minimum label in maxflow algorithm) - BFS uses amortized O(1) queue - Heap stores key and value separately - ... March 2001 ---------- * Changes to User Guide * a couple of new functions * some internal changes April 2000 ---------- * User Guide * Systematic structure for all depth-first search functions * Graph Voronoi diagram * Several small changes and additions in utility functions February 2000 ------------- * Representation for inward-directed trees * Breadth-first search * Dijkstra's algorithm * Minimum-spanning-tree algorithm August 1999 ----------- * First Haskell version hugs98-plus-Sep2006/packages/fgl/doc/README0000644006511100651110000001131710504340406016735 0ustar rossross------------------------------------------------------------------------------ FGL - Functional Graph Library, Version: January 2004 ------------------------------------------------------------------------------ CONTENTS A. CONTENTS B. TESTING C. CREDITS D. CONTACT ------------------------------------------------------------------------------ A. CONTENTS In addition to the files doc/README, doc/COPYRIGHT, doc/CHANGES, Makefile, package.conf.in, and prologue.txt this distribution consists of the following 28 Haskell files. (A) These files define inductive graphs and basic operations: Data/Graph/Inductive.hs - Main module Data/Graph/Inductive/Graph.hs - Static and dynamic graph classes, derived types & operations Data/Graph/Inductive/Tree.hs - Dynamic graph implementation Data/Graph/Inductive/Basic.hs - Basic graph operations (gmap, grev, ...) Data/Graph/Inductive/NodeMap.hs - Automatic generation of Nodes from labels. Data/Graph/Inductive/Graphviz.hs - Graphviz output. Data/Graph/Inductive/Monad/Monad.hs - Monadic (static) graph class based on balanced search trees Data/Graph/Inductive/Monad/IOArray.hs - Static graph implementation based on IO Arrays (B) Example graphs: Data/Graph/Inductive/Example.hs - Example graphs (C) Implementation of graph algorithms: Data/Graph/Inductive/Query.hs - Main query module Data/Graph/Inductive/Query/DFS.hs - Depth-first search and derived operations (topsort, scc, ...) Data/Graph/Inductive/Query/BFS.hs - Breadth-first search and "edge" shortest paths Data/Graph/Inductive/Query/SP.hs - Shortest paths (Dijkstra's algorithm) Data/Graph/Inductive/Query/GVD.hs - Graph voronoi diagram Data/Graph/Inductive/Query/MST.hs - Minimum spanning tree (Prim's algorithm) Data/Graph/Inductive/Query/Indep.hs - Independent node sets Data/Graph/Inductive/Query/MaxFlow.hs - Edmonds/Karp maximum flow algorithm Data/Graph/Inductive/Query/MaxFlow2.hs - Alternative implementations of the Edmonds/Karp algorithm Data/Graph/Inductive/Query/ArtPoint.hs - Articulation points Data/Graph/Inductive/Query/BCC.hs - Biconnected components Data/Graph/Inductive/Query/Dominators.hs - Dominators Data/Graph/Inductive/Query/TransClos.hs - Transitive closure Data/Graph/Inductive/Query/Monad.hs - Graph transformer monad and monadic graph algorithms (D) Some auxiliary modules: Data/Graph/Inductive/Inductive/RootPath.hs - Inward-directed trees Data/Graph/Inductive/Inductive/Heap.hs - Pairing heaps Data/Graph/Inductive/Inductive/Queue.hs - Amortized O(1) queue implementation Data/Graph/Inductive/Inductive/FiniteMap.hs - Binary-search-tree implementation of maps Data/Graph/Inductive/Inductive/Thread.hs - Auxiliary module used in Graph (subject to future change) ------------------------------------------------------------------------------ B. TESTING B.1 GHC 1. Run the test program: "ghci test/test.hs" B.2 Hugs 1. Start Hugs: "hugs -98 +o" 2. Load the FGL: ":l Data.Graph.Inductive.Example" 3. Play with it, e.g., enter: "sp 1 3 clr528" ------------------------------------------------------------------------------ C. CREDITS I am grateful to many people who have helped me with bug reports, questions, comments, and implementations to improve the FGL. In particular, I would like to thank Martin Boehme, Luis Zeron, and Hal Daume for their contributions. Moreover, I would like to thank Abe Egnor and Isaac Jones at Aetion Technologies who refactored the modules into the new hierarchical name space and who have added two modules (see also the file CHANGES). ------------------------------------------------------------------------------ D. BUG REPORTS, QUESTIONS, SUGGESTIONS, ... Please email comments, bug reports, etc. to erwig@cs.orst.edu hugs98-plus-Sep2006/packages/fgl/LICENSE0000644006511100651110000000272410504340406016317 0ustar rossrossCopyright (c) 1999-2004, Martin Erwig All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/fgl/Makefile0000644006511100651110000000125210504340406016745 0ustar rossross# ----------------------------------------------------------------------------- TOP=.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- ALL_DIRS = \ Data/Graph \ Data/Graph/Inductive \ Data/Graph/Inductive/Internal \ Data/Graph/Inductive/Monad \ Data/Graph/Inductive/Query PACKAGE = fgl VERSION = 5.2 PACKAGE_DEPS = base mtl SRC_HC_OPTS += -Wall -fno-warn-missing-signatures -fglasgow-exts -fallow-overlapping-instances SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/fgl/prologue.txt0000644006511100651110000000005210504340406017677 0ustar rossrossMartin Erwig\'s Functional Graph Library. hugs98-plus-Sep2006/packages/fgl/fgl.cabal0000644006511100651110000000237110504340406017044 0ustar rossrossname: fgl version: 5.3 license: BSD3 license-file: LICENSE maintainer: Martin Erwig homepage: http://web.engr.oregonstate.edu/~erwig/fgl/haskell category: Data Structures synopsis: Martin Erwig's Functional Graph Library exposed-modules: Data.Graph.Inductive.Internal.FiniteMap, Data.Graph.Inductive.Internal.Heap, Data.Graph.Inductive.Internal.Queue, Data.Graph.Inductive.Internal.RootPath, Data.Graph.Inductive.Internal.Thread, Data.Graph.Inductive.Basic, Data.Graph.Inductive.Example, Data.Graph.Inductive.Graph, Data.Graph.Inductive.Graphviz, Data.Graph.Inductive.Monad, Data.Graph.Inductive.NodeMap, Data.Graph.Inductive.Query, Data.Graph.Inductive.Tree, Data.Graph.Inductive.Monad.IOArray, Data.Graph.Inductive.Query.ArtPoint, Data.Graph.Inductive.Query.BCC, Data.Graph.Inductive.Query.BFS, Data.Graph.Inductive.Query.DFS, Data.Graph.Inductive.Query.Dominators, Data.Graph.Inductive.Query.GVD, Data.Graph.Inductive.Query.Indep, Data.Graph.Inductive.Query.MST, Data.Graph.Inductive.Query.MaxFlow, Data.Graph.Inductive.Query.MaxFlow2, Data.Graph.Inductive.Query.Monad, Data.Graph.Inductive.Query.SP, Data.Graph.Inductive.Query.TransClos, Data.Graph.Inductive build-depends: base, mtl extensions: MultiParamTypeClasses, OverlappingInstances hugs98-plus-Sep2006/packages/fgl/test/0000755006511100651110000000000010504340406016264 5ustar rossrosshugs98-plus-Sep2006/packages/fgl/test/test.hs0000644006511100651110000000113510504340406017577 0ustar rossrossmodule Main where import Data.Graph.Inductive import Data.Graph.Inductive.Example main :: IO () main = return () m486 :: NodeMap String m486 = fromGraph clr486 t1 :: Gr String () t1 = insMapEdge m486 ("shirt", "watch", ()) clr486 t2 :: Gr String () t2 = insMapEdge m486 ("watch", "pants", ()) t1 t3 :: Gr Char String t3 = run_ empty $ do insMapNodeM 'a' insMapNodeM 'b' insMapNodeM 'c' insMapEdgesM [('a', 'b', "right"), ('b', 'a', "left"), ('b', 'c', "down"), ('c', 'a', "up")] t4 :: Gr String () t4 = run_ clr486 $ insMapEdgeM ("shirt", "watch", ()) hugs98-plus-Sep2006/packages/fgl/package.conf.in0000644006511100651110000000246310504340406020161 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: Martin Erwig exposed: True exposed-modules: Data.Graph.Inductive.Internal.FiniteMap, Data.Graph.Inductive.Internal.Heap, Data.Graph.Inductive.Internal.Queue, Data.Graph.Inductive.Internal.RootPath, Data.Graph.Inductive.Internal.Thread, Data.Graph.Inductive.Basic, Data.Graph.Inductive.Example, Data.Graph.Inductive.Graph, Data.Graph.Inductive.Graphviz, Data.Graph.Inductive.Monad, Data.Graph.Inductive.NodeMap, Data.Graph.Inductive.Query, Data.Graph.Inductive.Tree, Data.Graph.Inductive.Monad.IOArray, Data.Graph.Inductive.Query.ArtPoint, Data.Graph.Inductive.Query.BCC, Data.Graph.Inductive.Query.BFS, Data.Graph.Inductive.Query.DFS, Data.Graph.Inductive.Query.Dominators, Data.Graph.Inductive.Query.GVD, Data.Graph.Inductive.Query.Indep, Data.Graph.Inductive.Query.MST, Data.Graph.Inductive.Query.MaxFlow, Data.Graph.Inductive.Query.MaxFlow2, Data.Graph.Inductive.Query.Monad, Data.Graph.Inductive.Query.SP, Data.Graph.Inductive.Query.TransClos, Data.Graph.Inductive hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSfgl" extra-libraries: include-dirs: includes: depends: base, mtl hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/X11/0000755006511100651110000000000010504340734015112 5ustar rossrosshugs98-plus-Sep2006/packages/X11/Graphics/0000755006511100651110000000000010504340414016645 5ustar rossrosshugs98-plus-Sep2006/packages/X11/Graphics/X11/0000755006511100651110000000000010504340414017216 5ustar rossrosshugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/0000755006511100651110000000000010504340414020114 5ustar rossrosshugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Atom.hsc0000644006511100651110000001206610504340414021520 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Atom -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of type declarations for interfacing with X11 Atoms. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Atom( internAtom, pRIMARY, sECONDARY, aRC, aTOM, bITMAP, cARDINAL, cOLORMAP, cURSOR, cUT_BUFFER0, cUT_BUFFER1, cUT_BUFFER2, cUT_BUFFER3, cUT_BUFFER4, cUT_BUFFER5, cUT_BUFFER6, cUT_BUFFER7, dRAWABLE, fONT, iNTEGER, pIXMAP, pOINT, rECTANGLE, rESOURCE_MANAGER, rGB_COLOR_MAP, rGB_BEST_MAP, rGB_BLUE_MAP, rGB_DEFAULT_MAP, rGB_GRAY_MAP, rGB_GREEN_MAP, rGB_RED_MAP, sTRING, vISUALID, wINDOW, wM_COMMAND, wM_HINTS, wM_CLIENT_MACHINE, wM_ICON_NAME, wM_ICON_SIZE, wM_NAME, wM_NORMAL_HINTS, wM_SIZE_HINTS, wM_ZOOM_HINTS, mIN_SPACE, nORM_SPACE, mAX_SPACE, eND_SPACE, sUPERSCRIPT_X, sUPERSCRIPT_Y, sUBSCRIPT_X, sUBSCRIPT_Y, uNDERLINE_POSITION, uNDERLINE_THICKNESS, sTRIKEOUT_ASCENT, sTRIKEOUT_DESCENT, iTALIC_ANGLE, x_HEIGHT, qUAD_WIDTH, wEIGHT, pOINT_SIZE, rESOLUTION, cOPYRIGHT, nOTICE, fONT_NAME, fAMILY_NAME, fULL_NAME, cAP_HEIGHT, wM_CLASS, wM_TRANSIENT_FOR, lAST_PREDEFINED, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types import Foreign.C.String #include "HsXlib.h" ---------------------------------------------------------------- -- Atoms ---------------------------------------------------------------- -- AC, 1/9/2000: Added definition for XInternAtom -- | interface to the X11 library function @XInternAtom()@. internAtom :: Display -> String -> Bool -> IO Atom internAtom display atom_name only_if_exists = withCString atom_name $ \ c_atom_name -> xInternAtom display c_atom_name only_if_exists foreign import ccall unsafe "XInternAtom" xInternAtom :: Display -> CString -> Bool -> IO Atom -- XInternAtoms omitted -- XGetAtomName omitted -- XGetAtomNames omitted -- XConvertSelection omitted -- XListProperties omitted -- XChangeProperty omitted -- XDeleteProperty omitted #{enum Atom, , pRIMARY = XA_PRIMARY , sECONDARY = XA_SECONDARY , aRC = XA_ARC , aTOM = XA_ATOM , bITMAP = XA_BITMAP , cARDINAL = XA_CARDINAL , cOLORMAP = XA_COLORMAP , cURSOR = XA_CURSOR , cUT_BUFFER0 = XA_CUT_BUFFER0 , cUT_BUFFER1 = XA_CUT_BUFFER1 , cUT_BUFFER2 = XA_CUT_BUFFER2 , cUT_BUFFER3 = XA_CUT_BUFFER3 , cUT_BUFFER4 = XA_CUT_BUFFER4 , cUT_BUFFER5 = XA_CUT_BUFFER5 , cUT_BUFFER6 = XA_CUT_BUFFER6 , cUT_BUFFER7 = XA_CUT_BUFFER7 , dRAWABLE = XA_DRAWABLE , fONT = XA_FONT , iNTEGER = XA_INTEGER , pIXMAP = XA_PIXMAP , pOINT = XA_POINT , rECTANGLE = XA_RECTANGLE , rESOURCE_MANAGER = XA_RESOURCE_MANAGER , rGB_COLOR_MAP = XA_RGB_COLOR_MAP , rGB_BEST_MAP = XA_RGB_BEST_MAP , rGB_BLUE_MAP = XA_RGB_BLUE_MAP , rGB_DEFAULT_MAP = XA_RGB_DEFAULT_MAP , rGB_GRAY_MAP = XA_RGB_GRAY_MAP , rGB_GREEN_MAP = XA_RGB_GREEN_MAP , rGB_RED_MAP = XA_RGB_RED_MAP , sTRING = XA_STRING , vISUALID = XA_VISUALID , wINDOW = XA_WINDOW , wM_COMMAND = XA_WM_COMMAND , wM_HINTS = XA_WM_HINTS , wM_CLIENT_MACHINE = XA_WM_CLIENT_MACHINE , wM_ICON_NAME = XA_WM_ICON_NAME , wM_ICON_SIZE = XA_WM_ICON_SIZE , wM_NAME = XA_WM_NAME , wM_NORMAL_HINTS = XA_WM_NORMAL_HINTS , wM_SIZE_HINTS = XA_WM_SIZE_HINTS , wM_ZOOM_HINTS = XA_WM_ZOOM_HINTS , mIN_SPACE = XA_MIN_SPACE , nORM_SPACE = XA_NORM_SPACE , mAX_SPACE = XA_MAX_SPACE , eND_SPACE = XA_END_SPACE , sUPERSCRIPT_X = XA_SUPERSCRIPT_X , sUPERSCRIPT_Y = XA_SUPERSCRIPT_Y , sUBSCRIPT_X = XA_SUBSCRIPT_X , sUBSCRIPT_Y = XA_SUBSCRIPT_Y , uNDERLINE_POSITION = XA_UNDERLINE_POSITION , uNDERLINE_THICKNESS = XA_UNDERLINE_THICKNESS , sTRIKEOUT_ASCENT = XA_STRIKEOUT_ASCENT , sTRIKEOUT_DESCENT = XA_STRIKEOUT_DESCENT , iTALIC_ANGLE = XA_ITALIC_ANGLE , x_HEIGHT = XA_X_HEIGHT , qUAD_WIDTH = XA_QUAD_WIDTH , wEIGHT = XA_WEIGHT , pOINT_SIZE = XA_POINT_SIZE , rESOLUTION = XA_RESOLUTION , cOPYRIGHT = XA_COPYRIGHT , nOTICE = XA_NOTICE , fONT_NAME = XA_FONT_NAME , fAMILY_NAME = XA_FAMILY_NAME , fULL_NAME = XA_FULL_NAME , cAP_HEIGHT = XA_CAP_HEIGHT , wM_CLASS = XA_WM_CLASS , wM_TRANSIENT_FOR = XA_WM_TRANSIENT_FOR , lAST_PREDEFINED = XA_LAST_PREDEFINED } ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Color.hs0000644006511100651110000001451110504340414021530 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Color -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib Colors. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Color( lookupColor, allocNamedColor, allocColor, parseColor, freeColors, storeColor, queryColor, queryColors, installColormap, uninstallColormap, copyColormapAndFree, createColormap, freeColormap, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types import Foreign import Foreign.C ---------------------------------------------------------------- -- Color and Colormaps ---------------------------------------------------------------- -- | interface to the X11 library function @XLookupColor()@. lookupColor :: Display -> Colormap -> String -> IO (Color, Color) lookupColor display colormap color_name = withCString color_name $ \c_color_name -> alloca $ \ exact_def_return -> alloca $ \ screen_def_return -> do throwIfZero "lookupColor" $ xLookupColor display colormap c_color_name exact_def_return screen_def_return exact_def <- peek exact_def_return screen_def <- peek screen_def_return return (exact_def, screen_def) foreign import ccall unsafe "HsXlib.h XLookupColor" xLookupColor :: Display -> Colormap -> CString -> Ptr Color -> Ptr Color -> IO Status -- | interface to the X11 library function @XAllocNamedColor()@. allocNamedColor :: Display -> Colormap -> String -> IO (Color, Color) allocNamedColor display colormap color_name = withCString color_name $ \c_color_name -> alloca $ \ exact_def_return -> alloca $ \ screen_def_return -> do throwIfZero "allocNamedColor" $ xAllocNamedColor display colormap c_color_name exact_def_return screen_def_return exact_def <- peek exact_def_return screen_def <- peek screen_def_return return (exact_def, screen_def) foreign import ccall unsafe "HsXlib.h XAllocNamedColor" xAllocNamedColor :: Display -> Colormap -> CString -> Ptr Color -> Ptr Color -> IO Status -- | interface to the X11 library function @XAllocColor()@. allocColor :: Display -> Colormap -> Color -> IO Color allocColor display colormap color = with color $ \ color_ptr -> do throwIfZero "allocColor" $ xAllocColor display colormap color_ptr peek color_ptr foreign import ccall unsafe "HsXlib.h XAllocColor" xAllocColor :: Display -> Colormap -> Ptr Color -> IO Status -- | interface to the X11 library function @XParseColor()@. parseColor :: Display -> Colormap -> String -> IO Color parseColor display colormap color_spec = withCString color_spec $ \ spec -> alloca $ \ exact_def_return -> do throwIfZero "parseColor" $ xParseColor display colormap spec exact_def_return peek exact_def_return foreign import ccall unsafe "HsXlib.h XParseColor" xParseColor :: Display -> Colormap -> CString -> Ptr Color -> IO Status -- ToDo: Can't express relationship between arg4 and res1 properly (or arg5, res2) -- %errfun Zero XAllocColorCells :: Display -> Colormap -> Bool -> Int -> Int -> IO (ListPixel, ListPixel) using err = XAllocColorCells(arg1,arg2,arg3,arg4_size,res1,arg5_size,res2) -- ToDo: Can't express relationship between arg4 and res1 properly -- %errfun Zero XAllocColorPlanes :: Display -> Colormap -> Bool -> Int -> Int -> Int -> Int IO (ListPixel, Pixel, Pixel, Pixel) using err = XAllocColorPlanes(...) -- | interface to the X11 library function @XFreeColors()@. freeColors :: Display -> Colormap -> [Pixel] -> Pixel -> IO () freeColors display colormap pixels planes = withArray pixels $ \ pixel_array -> xFreeColors display colormap pixel_array (length pixels) planes foreign import ccall unsafe "HsXlib.h XFreeColors" xFreeColors :: Display -> Colormap -> Ptr Pixel -> Int -> Pixel -> IO () -- | interface to the X11 library function @XStoreColor()@. storeColor :: Display -> Colormap -> Color -> IO () storeColor display colormap color = with color $ \ color_ptr -> xStoreColor display colormap color_ptr foreign import ccall unsafe "HsXlib.h XStoreColor" xStoreColor :: Display -> Colormap -> Ptr Color -> IO () -- %fun XStoreColors :: Display -> Colormap -> ListColor -> IO () -- %code XStoreColors(arg1,arg2,arg3,arg3_size) -- %fun XStoreNamedColor :: Display -> Colormap -> String -> Pixel -> PrimaryMask -> IO () -- | interface to the X11 library function @XQueryColor()@. queryColor :: Display -> Colormap -> Color -> IO Color queryColor display colormap color = with color $ \ color_ptr -> do xQueryColor display colormap color_ptr peek color_ptr foreign import ccall unsafe "HsXlib.h XQueryColor" xQueryColor :: Display -> Colormap -> Ptr Color -> IO () -- | interface to the X11 library function @XQueryColors()@. queryColors :: Display -> Colormap -> [Color] -> IO [Color] queryColors display colormap colors = withArrayLen colors $ \ ncolors color_array -> do xQueryColors display colormap color_array ncolors peekArray ncolors color_array foreign import ccall unsafe "HsXlib.h XQueryColors" xQueryColors :: Display -> Colormap -> Ptr Color -> Int -> IO () -- | interface to the X11 library function @XInstallColormap()@. foreign import ccall unsafe "HsXlib.h XInstallColormap" installColormap :: Display -> Colormap -> IO () -- | interface to the X11 library function @XUninstallColormap()@. foreign import ccall unsafe "HsXlib.h XUninstallColormap" uninstallColormap :: Display -> Colormap -> IO () -- | interface to the X11 library function @XCopyColormapAndFree()@. foreign import ccall unsafe "HsXlib.h XCopyColormapAndFree" copyColormapAndFree :: Display -> Colormap -> IO Colormap -- | interface to the X11 library function @XCreateColormap()@. foreign import ccall unsafe "HsXlib.h XCreateColormap" createColormap :: Display -> Window -> Visual -> ColormapAlloc -> IO Colormap -- | interface to the X11 library function @XFreeColormap()@. foreign import ccall unsafe "HsXlib.h XFreeColormap" freeColormap :: Display -> Colormap -> IO () ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Context.hs0000644006511100651110000002004410504340414022074 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Context -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib Graphics -- Contexts. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Context( setArcMode, setBackground, setForeground, setFunction, setGraphicsExposures, setClipMask, setClipOrigin, setDashes, setFillRule, setFillStyle, setFont, setLineAttributes, setPlaneMask, setState, setStipple, setSubwindowMode, setTSOrigin, setTile, createGC, gContextFromGC, freeGC, flushGC, copyGC, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types import Foreign import Foreign.C ---------------------------------------------------------------- -- Graphics contexts ---------------------------------------------------------------- -- Convenience functions -- | interface to the X11 library function @XSetArcMode()@. foreign import ccall unsafe "HsXlib.h XSetArcMode" setArcMode :: Display -> GC -> ArcMode -> IO () -- | interface to the X11 library function @XSetBackground()@. foreign import ccall unsafe "HsXlib.h XSetBackground" setBackground :: Display -> GC -> Pixel -> IO () -- | interface to the X11 library function @XSetForeground()@. foreign import ccall unsafe "HsXlib.h XSetForeground" setForeground :: Display -> GC -> Pixel -> IO () -- | interface to the X11 library function @XSetFunction()@. foreign import ccall unsafe "HsXlib.h XSetFunction" setFunction :: Display -> GC -> GXFunction -> IO () -- | interface to the X11 library function @XSetGraphicsExposures()@. foreign import ccall unsafe "HsXlib.h XSetGraphicsExposures" setGraphicsExposures :: Display -> GC -> Bool -> IO () -- | interface to the X11 library function @XSetClipMask()@. foreign import ccall unsafe "HsXlib.h XSetClipMask" setClipMask :: Display -> GC -> Pixmap -> IO () -- | interface to the X11 library function @XSetClipOrigin()@. foreign import ccall unsafe "HsXlib.h XSetClipOrigin" setClipOrigin :: Display -> GC -> Position -> Position -> IO () -- XSetClipRectangles omitted because it's not clear when it's safe to delete the -- array of rectangles -- | interface to the X11 library function @XSetDashes()@. setDashes :: Display -> GC -> Int -> String -> Int -> IO () setDashes display gc dash_offset dashes n = withCString dashes $ \ dash_list -> xSetDashes display gc dash_offset dash_list n foreign import ccall unsafe "HsXlib.h XSetDashes" xSetDashes :: Display -> GC -> Int -> CString -> Int -> IO () -- | interface to the X11 library function @XSetFillRule()@. foreign import ccall unsafe "HsXlib.h XSetFillRule" setFillRule :: Display -> GC -> FillRule -> IO () -- | interface to the X11 library function @XSetFillStyle()@. foreign import ccall unsafe "HsXlib.h XSetFillStyle" setFillStyle :: Display -> GC -> FillStyle -> IO () -- | interface to the X11 library function @XSetFont()@. foreign import ccall unsafe "HsXlib.h XSetFont" setFont :: Display -> GC -> Font -> IO () -- | interface to the X11 library function @XSetLineAttributes()@. foreign import ccall unsafe "HsXlib.h XSetLineAttributes" setLineAttributes :: Display -> GC -> Int -> LineStyle -> CapStyle -> JoinStyle -> IO () -- | interface to the X11 library function @XSetPlaneMask()@. foreign import ccall unsafe "HsXlib.h XSetPlaneMask" setPlaneMask :: Display -> GC -> Pixel -> IO () -- | interface to the X11 library function @XSetState()@. foreign import ccall unsafe "HsXlib.h XSetState" setState :: Display -> GC -> Pixel -> Pixel -> GXFunction -> Pixel -> IO () -- | interface to the X11 library function @XSetStipple()@. foreign import ccall unsafe "HsXlib.h XSetStipple" setStipple :: Display -> GC -> Pixmap -> IO () -- | interface to the X11 library function @XSetSubwindowMode()@. foreign import ccall unsafe "HsXlib.h XSetSubwindowMode" setSubwindowMode :: Display -> GC -> SubWindowMode -> IO () -- | interface to the X11 library function @XSetTSOrigin()@. foreign import ccall unsafe "HsXlib.h XSetTSOrigin" setTSOrigin :: Display -> GC -> Position -> Position -> IO () -- | interface to the X11 library function @XSetTile()@. foreign import ccall unsafe "HsXlib.h XSetTile" setTile :: Display -> GC -> Pixmap -> IO () -- ToDo: create a real interface to this -- | partial interface to the X11 library function @XCreateGC()@. createGC :: Display -> Drawable -> IO GC createGC display d = xCreateGC display d 0 nullPtr foreign import ccall unsafe "HsXlib.h XCreateGC" xCreateGC :: Display -> Drawable -> ValueMask -> Ptr GCValues -> IO GC type ValueMask = Word32 -- OLD: -- %synonym : GCValueSet : Ptr -- in rtsDummy -- -- {% -- typedef unsigned long GCMask; /* cf XtGCMask */ -- typedef struct _gcvalues { -- GCMask mask; -- XGCValues values; -- }* GCValueSet; -- %} -- -- IMPURE GCValueSet emptyGCValueSet() -- RESULT: (RETVAL = (GCValueSet) malloc(sizeof(struct _gcvalues))) ? RETVAL->mask = 0, RETVAL : RETVAL; -- POST: RETVAL != NULL -- -- IMPURE void setGCForeground(colour, set) -- IN Pixel colour -- IN GCValueSet set -- RESULT: set->mask |= GCForeground; set->values.foreground = colour -- -- IMPURE void setGCBackground(colour, set) -- IN Pixel colour -- IN GCValueSet set -- RESULT: set->mask |= GCBackground; set->values.background = colour -- -- IMPURE void freeGCValueSet(set) -- IN GCValueSet set -- RESULT: free(set) -- -- IMPURE GC XCreateGC(display, d, set->mask, &(set->values)) -- NAME: xCreateGC -- IN Display* display -- IN Drawable d -- IN GCValueSet set -- -- IMPURE void XChangeGC(display, gc, set->mask, &(set->values)) -- NAME: xChangeGC -- IN Display* display -- IN GC gc -- IN GCValueSet set -- -- STARTH -- -- Code that packages GCValueSets up in a clean monoidic way. -- -- data GCSetter = GCSetter (GCValueSet -> IO ()) -- should be newtype -- -- createGC :: Display -> Drawable -> GCSetter -> IO GC -- createGC display d (GCSetter setter) = -- emptyGCValueSet >>= \ set -> -- setter set >> -- xCreateGC display d set >>= \ gc -> -- freeGCValueSet set >> -- return gc -- -- changeGC :: Display -> Drawable -> GC -> GCSetter -> IO () -- changeGC display d gc (GCSetter setter) = -- emptyGCValueSet >>= \ set -> -- setter set >> -- xChangeGC display d set >>= \ gc -> -- freeGCValueSet set -- -- instance Monoid GCSetter where -- (GCSetter m) >>> (GCSetter k) -- = GCSetter (\ settings -> m settings >> k settings) -- unit = GCSetter (\ _ -> return ()) -- -- set_Background :: Pixel -> GCSetter -- set_Background c = GCSetter (setGCBackground c) -- -- set_Foreground :: Pixel -> GCSetter -- set_Foreground c = GCSetter (setGCForeground c) -- ENDH -- | interface to the X11 library function @XGContextFromGC()@. foreign import ccall unsafe "HsXlib.h XGContextFromGC" gContextFromGC :: GC -> GContext -- | interface to the X11 library function @XFreeGC()@. foreign import ccall unsafe "HsXlib.h XFreeGC" freeGC :: Display -> GC -> IO () -- | interface to the X11 library function @XFlushGC()@. foreign import ccall unsafe "HsXlib.h XFlushGC" flushGC :: Display -> GC -> IO () -- | interface to the X11 library function @XCopyGC()@. foreign import ccall unsafe "HsXlib.h XCopyGC" copyGC :: Display -> GC -> Mask -> GC -> IO () ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Display.hs0000644006511100651110000002101210504340414022051 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Display -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib Displays. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Display( allPlanes_aux, blackPixel, whitePixel, connectionNumber, defaultColormap, defaultGC, defaultDepth, defaultScreen, defaultScreenOfDisplay, displayHeight, displayHeightMM, displayWidth, displayWidthMM, maxRequestSize, displayMotionBufferSize, resourceManagerString, screenResourceString, displayString, imageByteOrder, protocolRevision, protocolVersion, serverVendor, screenCount, defaultVisual, displayCells, displayPlanes, screenOfDisplay, defaultRootWindow, rootWindow, qLength, noOp, openDisplay, closeDisplay, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types import Foreign import Foreign.C ---------------------------------------------------------------- -- Display ---------------------------------------------------------------- -- | interface to the X11 library function @XAllPlanes()@. foreign import ccall unsafe "HsXlib.h XAllPlanes" allPlanes_aux :: Pixel -- | interface to the X11 library function @XBlackPixel()@. foreign import ccall unsafe "HsXlib.h XBlackPixel" blackPixel :: Display -> ScreenNumber -> Pixel -- | interface to the X11 library function @XWhitePixel()@. foreign import ccall unsafe "HsXlib.h XWhitePixel" whitePixel :: Display -> ScreenNumber -> Pixel -- This may vary from one execution to another but I believe it -- is constant during any given execution and so it can be made PURE -- without breaking referential transparency. -- -- Note: underneath the opaque name, it turns out that this -- is the file descriptor. You need to know this if you want to -- use select. -- | interface to the X11 library function @XConnectionNumber()@. foreign import ccall unsafe "HsXlib.h XConnectionNumber" connectionNumber :: Display -> Int -- | interface to the X11 library function @XDefaultColormap()@. foreign import ccall unsafe "HsXlib.h XDefaultColormap" defaultColormap :: Display -> ScreenNumber -> Colormap -- XListDepths :: Display -> ScreenNumber -> ListInt using res1 = XListDepths(arg1,arg2,&res1_size) -- | interface to the X11 library function @XDefaultGC()@. foreign import ccall unsafe "HsXlib.h XDefaultGC" defaultGC :: Display -> ScreenNumber -> GC -- | interface to the X11 library function @XDefaultDepth()@. foreign import ccall unsafe "HsXlib.h XDefaultDepth" defaultDepth :: Display -> ScreenNumber -> Int -- | interface to the X11 library function @XDefaultScreen()@. foreign import ccall unsafe "HsXlib.h XDefaultScreen" defaultScreen :: Display -> ScreenNumber -- | interface to the X11 library function @XDefaultScreenOfDisplay()@. foreign import ccall unsafe "HsXlib.h XDefaultScreenOfDisplay" defaultScreenOfDisplay :: Display -> Screen -- | interface to the X11 library function @XDisplayHeight()@. foreign import ccall unsafe "HsXlib.h XDisplayHeight" displayHeight :: Display -> ScreenNumber -> Int -- | interface to the X11 library function @XDisplayHeightMM()@. foreign import ccall unsafe "HsXlib.h XDisplayHeightMM" displayHeightMM :: Display -> ScreenNumber -> Int -- | interface to the X11 library function @XDisplayWidth()@. foreign import ccall unsafe "HsXlib.h XDisplayWidth" displayWidth :: Display -> ScreenNumber -> Int -- | interface to the X11 library function @XDisplayWidthMM()@. foreign import ccall unsafe "HsXlib.h XDisplayWidthMM" displayWidthMM :: Display -> ScreenNumber -> Int -- | interface to the X11 library function @XMaxRequestSize()@. foreign import ccall unsafe "HsXlib.h XMaxRequestSize" maxRequestSize :: Display -> Int -- | interface to the X11 library function @XDisplayMotionBufferSize()@. foreign import ccall unsafe "HsXlib.h XDisplayMotionBufferSize" displayMotionBufferSize :: Display -> Int --Disnae exist in X11R5 XExtendedMaxRequestSize :: Display -> Int -- | interface to the X11 library function @XResourceManagerString()@. resourceManagerString :: Display -> String resourceManagerString display = xlibCString (xResourceManagerString display) foreign import ccall unsafe "HsXlib.h XResourceManagerString" xResourceManagerString :: Display -> IO CString -- | interface to the X11 library function @XScreenResourceString()@. screenResourceString :: Screen -> String screenResourceString screen = xlibCString (xScreenResourceString screen) foreign import ccall unsafe "HsXlib.h XScreenResourceString" xScreenResourceString :: Screen -> IO CString -- | interface to the X11 library function @XDisplayString()@. displayString :: Display -> String displayString display = xlibCString (xDisplayString display) foreign import ccall unsafe "HsXlib.h XDisplayString" xDisplayString :: Display -> IO CString -- | interface to the X11 library function @XImageByteOrder()@. foreign import ccall unsafe "HsXlib.h XImageByteOrder" imageByteOrder :: Display -> Int -- | interface to the X11 library function @XProtocolRevision()@. foreign import ccall unsafe "HsXlib.h XProtocolRevision" protocolRevision :: Display -> Int -- | interface to the X11 library function @XProtocolVersion()@. foreign import ccall unsafe "HsXlib.h XProtocolVersion" protocolVersion :: Display -> Int -- | interface to the X11 library function @XServerVendor()@. serverVendor :: Display -> String serverVendor display = xlibCString (xServerVendor display) foreign import ccall unsafe "HsXlib.h XServerVendor" xServerVendor :: Display -> IO CString --Disnae exist: XServerRelease :: Display -> Int -- | interface to the X11 library function @XScreenCount()@. foreign import ccall unsafe "HsXlib.h XScreenCount" screenCount :: Display -> Int -- | interface to the X11 library function @XDefaultVisual()@. foreign import ccall unsafe "HsXlib.h XDefaultVisual" defaultVisual :: Display -> ScreenNumber -> Visual -- | interface to the X11 library function @XDisplayCells()@. foreign import ccall unsafe "HsXlib.h XDisplayCells" displayCells :: Display -> ScreenNumber -> Int -- | interface to the X11 library function @XDisplayPlanes()@. foreign import ccall unsafe "HsXlib.h XDisplayPlanes" displayPlanes :: Display -> ScreenNumber -> Int -- | interface to the X11 library function @XScreenOfDisplay()@. foreign import ccall unsafe "HsXlib.h XScreenOfDisplay" screenOfDisplay :: Display -> ScreenNumber -> Screen -- | interface to the X11 library function @XDefaultRootWindow()@. foreign import ccall unsafe "HsXlib.h XDefaultRootWindow" defaultRootWindow :: Display -> Window -- The following are believed to be order dependent -- | interface to the X11 library function @XRootWindow()@. foreign import ccall unsafe "HsXlib.h XRootWindow" rootWindow :: Display -> ScreenNumber -> IO Window -- | interface to the X11 library function @XQLength()@. foreign import ccall unsafe "HsXlib.h XQLength" qLength :: Display -> IO Int -- | interface to the X11 library function @XNoOp()@. foreign import ccall unsafe "HsXlib.h XNoOp" noOp :: Display -> IO () -- | interface to the X11 library function @XOpenDisplay()@. openDisplay :: String -> IO Display openDisplay name = withCString name $ \ c_name -> do display <- throwIfNull "openDisplay" (xOpenDisplay c_name) return (Display display) foreign import ccall unsafe "HsXlib.h XOpenDisplay" xOpenDisplay :: CString -> IO (Ptr Display) -- | interface to the X11 library function @XCloseDisplay()@. foreign import ccall unsafe "HsXlib.h XCloseDisplay" closeDisplay :: Display -> IO () -- | convert a CString owned by Xlib to a Haskell String xlibCString :: IO CString -> String xlibCString act = unsafePerformIO $ do cs <- act peekCString cs ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Event.hsc0000644006511100651110000004141510504340414021701 0ustar rossross{-# OPTIONS_GHC -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Event -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib Events. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Event( QueuedMode, queuedAlready, queuedAfterFlush, queuedAfterReading, XEvent, XEventPtr, allocaXEvent, get_EventType, get_Window, XKeyEvent, XKeyEventPtr, asKeyEvent, XButtonEvent, get_KeyEvent, get_ButtonEvent, get_MotionEvent, XMotionEvent, XExposeEvent, get_ExposeEvent, XMappingEvent, XConfigureEvent, get_ConfigureEvent, waitForEvent, gettimeofday_in_milliseconds, -- gettimeofday_in_milliseconds_internal, flush, sync, pending, eventsQueued, nextEvent, allowEvents, selectInput, sendEvent, windowEvent, checkWindowEvent, maskEvent, checkMaskEvent, checkTypedEvent, checkTypedWindowEvent, putBackEvent, peekEvent, refreshKeyboardMapping, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types import Graphics.X11.Xlib.Display( connectionNumber ) import Foreign #if __GLASGOW_HASKELL__ import Data.Generics #endif #include "HsXlib.h" {-# CFILES cbits/fdset.c #-} ---------------------------------------------------------------- -- Events ---------------------------------------------------------------- type QueuedMode = Int #{enum QueuedMode, , queuedAlready = QueuedAlready , queuedAfterFlush = QueuedAfterFlush , queuedAfterReading = QueuedAfterReading } -- Because of the way the corresponding C types are defined, -- These "structs" are somewhat unusual - they omit fields which can -- be found in more general structs. -- For example, XAnyEvent omits type since it is in XEvent. -- Therefore, to get the complete contents of an event one typically -- writes: -- do -- ty <- get_XEvent e -- (serial,send_event,display,window) <- get_XAnyEvent -- window' <- get_XDestroyWindowEvent newtype XEvent = XEvent XEventPtr #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif type XEventPtr = Ptr XEvent allocaXEvent :: (XEventPtr -> IO a) -> IO a allocaXEvent = allocaBytes #{size XEvent} get_EventType :: XEventPtr -> IO EventType get_EventType = #{peek XEvent,type} get_Window :: XEventPtr -> IO Window get_Window = #{peek XAnyEvent,window} -- %struct : XAnyEvent : XAnyEvent arg1 -- Int32 : serial # # of last request processed by server -- Bool : send_event # true if this came from a SendEvent request -- Display : display # Display the event was read from -- Window : window # window on which event was requested in event mask type XKeyEvent = ( Window -- root window that the event occured on , Window -- child window , Time -- milliseconds , Int -- pointer x, y coordinates in event window , Int -- , Int -- coordinates relative to root , Int -- , Modifier -- key or button mask , KeyCode -- detail , Bool -- same screen flag ) peekXKeyEvent :: Ptr XKeyEvent -> IO XKeyEvent peekXKeyEvent p = do root <- #{peek XKeyEvent,root} p subwindow <- #{peek XKeyEvent,subwindow} p time <- #{peek XKeyEvent,time} p x <- #{peek XKeyEvent,x} p y <- #{peek XKeyEvent,y} p x_root <- #{peek XKeyEvent,x_root} p y_root <- #{peek XKeyEvent,y_root} p state <- #{peek XKeyEvent,state} p keycode <- #{peek XKeyEvent,keycode} p same_screen <- #{peek XKeyEvent,same_screen} p return (root, subwindow, time, x, y, x_root, y_root, state, keycode, same_screen) get_KeyEvent :: XEventPtr -> IO XKeyEvent get_KeyEvent p = peekXKeyEvent (castPtr p) type XKeyEventPtr = Ptr XKeyEvent asKeyEvent :: XEventPtr -> XKeyEventPtr asKeyEvent = castPtr type XButtonEvent = ( Window -- root window that the event occured on , Window -- child window , Time -- milliseconds , Int -- pointer x, y coordinates in event window , Int , Int -- coordinates relative to root , Int , Modifier -- key or button mask , Button -- detail , Bool -- same screen flag ) peekXButtonEvent :: Ptr XButtonEvent -> IO XButtonEvent peekXButtonEvent p = do root <- #{peek XButtonEvent,root} p subwindow <- #{peek XButtonEvent,subwindow} p time <- #{peek XButtonEvent,time} p x <- #{peek XButtonEvent,x} p y <- #{peek XButtonEvent,y} p x_root <- #{peek XButtonEvent,x_root} p y_root <- #{peek XButtonEvent,y_root} p state <- #{peek XButtonEvent,state} p button <- #{peek XButtonEvent,button} p same_screen <- #{peek XButtonEvent,same_screen} p return (root, subwindow, time, x, y, x_root, y_root, state, button, same_screen) get_ButtonEvent :: XEventPtr -> IO XButtonEvent get_ButtonEvent p = peekXButtonEvent (castPtr p) type XMotionEvent = ( Window -- root window that the event occured on , Window -- child window , Time -- milliseconds , Int -- pointer x, y coordinates in event window , Int , Int -- coordinates relative to root , Int , Modifier -- key or button mask , NotifyMode -- detail , Bool -- same screen flag ) peekXMotionEvent :: Ptr XMotionEvent -> IO XMotionEvent peekXMotionEvent p = do root <- #{peek XMotionEvent,root} p subwindow <- #{peek XMotionEvent,subwindow} p time <- #{peek XMotionEvent,time} p x <- #{peek XMotionEvent,x} p y <- #{peek XMotionEvent,y} p x_root <- #{peek XMotionEvent,x_root} p y_root <- #{peek XMotionEvent,y_root} p state <- #{peek XMotionEvent,state} p is_hint <- #{peek XMotionEvent,is_hint} p same_screen <- #{peek XMotionEvent,same_screen} p return (root, subwindow, time, x, y, x_root, y_root, state, is_hint, same_screen) get_MotionEvent :: XEventPtr -> IO XMotionEvent get_MotionEvent p = peekXMotionEvent (castPtr p) -- %struct : XCrossingEvent : XCrossingEvent arg1 -- Window : root # root window that the event occured on -- Window : subwindow # child window -- Time : time # milliseconds -- Int : x # pointer x, y coordinates in event window -- Int : y -- Int : x_root # coordinates relative to root -- Int : y_root -- NotifyMode : mode -- NotifyDetail : detail -- Bool : same_screen # same screen flag -- Bool : focus # boolean focus -- Modifier : state # key or button mask -- -- %struct : XFocusChangeEvent : XFocusChangeEvent arg1 -- NotifyMode : mode -- NotifyDetail : detail -- -- -- omitted: should be translated into bitmaps -- -- PURE void getKeymapEvent(event) -- -- IN XEvent* event -- -- OUT Window window = ((XKeymapEvent*)event)->window -- -- OUT array[32] Char key_vector = ((XKeymapEvent*)event)->key_vector -- -- RESULT: type XExposeEvent = ( Position -- x , Position -- y , Dimension -- width , Dimension -- height , Int -- count ) peekXExposeEvent :: Ptr XExposeEvent -> IO XExposeEvent peekXExposeEvent p = do x <- #{peek XExposeEvent,x} p y <- #{peek XExposeEvent,y} p width <- #{peek XExposeEvent,width} p height <- #{peek XExposeEvent,height} p count <- #{peek XExposeEvent,count} p return (x, y, width, height, count) get_ExposeEvent :: XEventPtr -> IO XExposeEvent get_ExposeEvent p = peekXExposeEvent (castPtr p) -- %struct : XGraphicsExposeEvent : XGraphicsExposeEvent arg1 -- Position : x -- Position : y -- Dimension : width . -- Dimension : height -- Int : count -- Int : major_code -- Int : minor_code -- -- %struct : XCirculateEvent : XCirculateEvent arg1 -- Window : window -- Place : place -- -- %struct : XConfigureEvent : XConfigureEvent arg1 -- Window : window -- Position : x -- Position : y -- Dimension : width -- Dimension : height -- Dimension : border_width -- Window : above -- Bool : override_redirect -- -- %struct : XCreateWindowEvent : XCreateWindowEvent arg1 -- Window : window -- Position : x -- Position : y -- Dimension : width -- Dimension : height -- Dimension : border_width -- Bool : override_redirect -- -- %struct : XDestroyWindowEvent : XDestroyWindowEvent arg1 -- Window : window -- -- %struct : XGravityEvent : XGravityEvent arg1 -- Window : window -- Position : x -- Position : y -- -- %struct : XMapEvent : XMapEvent arg1 -- Bool : override_redirect type XMappingEvent = ( MappingRequest -- request , KeyCode -- first_keycode , Int -- count ) withXMappingEvent :: XMappingEvent -> (Ptr XMappingEvent -> IO a) -> IO a withXMappingEvent event_map f = allocaBytes #{size XMappingEvent} $ \ event_map_ptr -> do pokeXMappingEvent event_map_ptr event_map f event_map_ptr pokeXMappingEvent :: Ptr XMappingEvent -> XMappingEvent -> IO () pokeXMappingEvent p (request, first_keycode, count) = do #{poke XMappingEvent,request} p request #{poke XMappingEvent,first_keycode} p first_keycode #{poke XMappingEvent,count} p count type XConfigureEvent = ( Position , Position , Dimension , Dimension ) peekXConfigureEvent :: Ptr XConfigureEvent -> IO XConfigureEvent peekXConfigureEvent p = do x <- #{peek XConfigureEvent,x} p y <- #{peek XConfigureEvent,y} p width <- #{peek XConfigureEvent,width} p height <- #{peek XConfigureEvent,height} p return (x, y, width, height) get_ConfigureEvent :: XEventPtr -> IO XConfigureEvent get_ConfigureEvent p = peekXConfigureEvent (castPtr p) -- %struct : XResizeRequestEvent : XResizeRequestEvent arg1 -- Dimension : width -- Dimension : height -- -- %struct : XReparentEvent : XReparentEvent arg1 -- Window : window -- Window : parent -- Position : x -- Position : y -- Bool : override_redirect -- -- %struct : XUnmapEvent : XUnmapEvent arg1 -- Window : window -- Bool : from_configure -- -- %struct : XVisibilityEvent : XVisibilityEvent arg1 -- Visibility : state -- -- %struct : XCirculateRequestEvent : XCirculateRequestEvent arg1 -- Place : place -- -- -- omitted because valuemask looks tricky -- -- %struct : XConfigureRequestEvent : XConfigureRequestEvent arg1 -- -- Window : window -- -- Position : x -- -- Position : y -- -- Dimension : width -- -- Dimension : height -- -- Dimension : border_width -- -- Window : above -- -- StackingMethod : detail -- -- ??? : valuemask -- -- %struct : XMapRequestEvent : XMapRequestEvent arg1 -- Window : window -- -- %struct : XColormapEvent : XColormapEvent arg1 -- Colormap : colormap -- Bool : new -- ColormapNotification : state -- -- -- getClientMessageEvent omitted -- -- getPropertyEvent omitted -- -- getSelectionClearEvent omitted -- -- getSelectionRequestEvent omitted -- -- getSelectionEvent omitted -- functions -- The following is useful if you want to do a read with timeout. -- | Reads an event with a timeout (in microseconds). -- Returns True if timeout occurs. waitForEvent :: Display -> Word32 -> IO Bool waitForEvent display usecs = with (TimeVal (usecs `div` 1000000) (usecs `mod` 1000000)) $ \ tv_ptr -> allocaBytes #{size fd_set} $ \ readfds -> allocaBytes #{size fd_set} $ \ nofds -> do let fd = connectionNumber display fdZero readfds fdZero nofds fdSet fd readfds n <- select (fd+1) readfds nofds nofds tv_ptr return (n == 0) newtype FdSet = FdSet (Ptr FdSet) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif foreign import ccall unsafe "HsXlib.h" fdZero :: Ptr FdSet -> IO () foreign import ccall unsafe "HsXlib.h" fdSet :: Int -> Ptr FdSet -> IO () foreign import ccall unsafe "HsXlib.h" select :: Int -> Ptr FdSet -> Ptr FdSet -> Ptr FdSet -> Ptr TimeVal -> IO Int -- | This function is somewhat compatible with Win32's @TimeGetTime()@ gettimeofday_in_milliseconds :: IO Integer gettimeofday_in_milliseconds = alloca $ \ tv_ptr -> do rc <- gettimeofday tv_ptr nullPtr TimeVal sec usec <- peek tv_ptr return (toInteger sec * 1000 + toInteger usec `div` 1000) data TimeVal = TimeVal Word32 Word32 instance Storable TimeVal where alignment _ = #{size int} sizeOf _ = #{size struct timeval} peek p = do sec <- #{peek struct timeval,tv_sec} p usec <- #{peek struct timeval,tv_usec} p return (TimeVal sec usec) poke p (TimeVal sec usec) = do #{poke struct timeval,tv_sec} p sec #{poke struct timeval,tv_usec} p usec newtype TimeZone = TimeZone (Ptr TimeZone) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif foreign import ccall unsafe "HsXlib.h" gettimeofday :: Ptr TimeVal -> Ptr TimeZone -> IO () -- | interface to the X11 library function @XFlush()@. foreign import ccall unsafe "HsXlib.h XFlush" flush :: Display -> IO () -- | interface to the X11 library function @XSync()@. foreign import ccall unsafe "HsXlib.h XSync" sync :: Display -> Bool -> IO () -- | interface to the X11 library function @XPending()@. foreign import ccall unsafe "HsXlib.h XPending" pending :: Display -> IO Int -- | interface to the X11 library function @XEventsQueued()@. foreign import ccall unsafe "HsXlib.h XEventsQueued" eventsQueued :: Display -> QueuedMode -> IO Int -- | interface to the X11 library function @XNextEvent()@. foreign import ccall unsafe "HsXlib.h XNextEvent" nextEvent :: Display -> XEventPtr -> IO () -- | interface to the X11 library function @XAllowEvents()@. foreign import ccall unsafe "HsXlib.h XAllowEvents" allowEvents :: Display -> AllowEvents -> Time -> IO () -- ToDo: XFree(res1) after constructing result -- %fun XGetMotionEvents :: Display -> Window -> Time -> Time -> IO ListXTimeCoord -- %code res1 = XGetMotionEvents(arg1,arg2,arg3,arg4,&res1_size) -- | interface to the X11 library function @XSelectInput()@. foreign import ccall unsafe "HsXlib.h XSelectInput" selectInput :: Display -> Window -> EventMask -> IO () -- | interface to the X11 library function @XSendEvent()@. sendEvent :: Display -> Window -> Bool -> EventMask -> XEventPtr -> IO () sendEvent display w propagate event_mask event_send = throwIfZero "sendEvent" $ xSendEvent display w propagate event_mask event_send foreign import ccall unsafe "HsXlib.h XSendEvent" xSendEvent :: Display -> Window -> Bool -> EventMask -> XEventPtr -> IO Status -- | interface to the X11 library function @XWindowEvent()@. foreign import ccall unsafe "HsXlib.h XWindowEvent" windowEvent :: Display -> Window -> EventMask -> XEventPtr -> IO () -- | interface to the X11 library function @XCheckWindowEvent()@. foreign import ccall unsafe "HsXlib.h XCheckWindowEvent" checkWindowEvent :: Display -> Window -> EventMask -> XEventPtr -> IO Bool -- | interface to the X11 library function @XMaskEvent()@. foreign import ccall unsafe "HsXlib.h XMaskEvent" maskEvent :: Display -> EventMask -> XEventPtr -> IO () -- | interface to the X11 library function @XCheckMaskEvent()@. foreign import ccall unsafe "HsXlib.h XCheckMaskEvent" checkMaskEvent :: Display -> EventMask -> XEventPtr -> IO Bool -- | interface to the X11 library function @XCheckTypedEvent()@. foreign import ccall unsafe "HsXlib.h XCheckTypedEvent" checkTypedEvent :: Display -> EventType -> XEventPtr -> IO Bool -- | interface to the X11 library function @XCheckTypedWindowEvent()@. foreign import ccall unsafe "HsXlib.h XCheckTypedWindowEvent" checkTypedWindowEvent :: Display -> Window -> EventType -> XEventPtr -> IO Bool -- | interface to the X11 library function @XPutBackEvent()@. foreign import ccall unsafe "HsXlib.h XPutBackEvent" putBackEvent :: Display -> XEventPtr -> IO () -- | interface to the X11 library function @XPeekEvent()@. foreign import ccall unsafe "HsXlib.h XPeekEvent" peekEvent :: Display -> XEventPtr -> IO () -- XFilterEvent omitted (can't find documentation) -- XIfEvent omitted (can't pass predicates (yet)) -- XCheckIfEvent omitted (can't pass predicates (yet)) -- XPeekIfEvent omitted (can't pass predicates (yet)) -- | interface to the X11 library function @XRefreshKeyboardMapping()@. refreshKeyboardMapping :: XMappingEvent -> IO () refreshKeyboardMapping event_map = withXMappingEvent event_map $ \ event_map_ptr -> xRefreshKeyboardMapping event_map_ptr foreign import ccall unsafe "HsXlib.h XRefreshKeyboardMapping" xRefreshKeyboardMapping :: Ptr XMappingEvent -> IO () -- XSynchronize omitted (returns C function) -- XSetAfterFunction omitted (can't pass functions (yet)) ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Font.hsc0000644006511100651110000001764210504340414021533 0ustar rossross{-# OPTIONS_GHC -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Font -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib Fonts. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Font( Glyph, queryFont, fontFromGC, loadQueryFont, freeFont, FontStruct, fontFromFontStruct, ascentFromFontStruct, descentFromFontStruct, CharStruct, textExtents, textWidth, ) where #include "HsXlib.h" import Graphics.X11.Types import Graphics.X11.Xlib.Types import Foreign import Foreign.C #if __GLASGOW_HASKELL__ import Data.Generics #endif ---------------------------------------------------------------- -- Fonts ---------------------------------------------------------------- -- A glyph (or Char2b) is a 16 bit character identification. -- The top 8 bits are zero in many fonts. type Glyph = Word16 -- | pointer to an X11 @XFontStruct@ structure newtype FontStruct = FontStruct (Ptr FontStruct) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif -- Disnae exist: %fun LoadFont :: Display -> String -> IO Font -- Disnae exist: %fun UnloadFont :: Display -> Font -> IO () -- Argument can be a Font or a GContext. -- But, if it's a GContext, the fontStruct will use the GContext as the -- FontID - which will cause most things to break so it's probably -- safer using XGetGCValues to get a genuine font ID -- | interface to the X11 library function @XQueryFont()@. foreign import ccall unsafe "HsXlib.h XQueryFont" queryFont :: Display -> Font -> IO FontStruct -- Note that this _WILL NOT WORK_ unless you have explicitly set the font. -- I'm slowly but surely coming to the conclusion that Xlib is a pile of -- steaming shit. -- | interface to the X11 library function @XGetGCValues()@. fontFromGC :: Display -> GC -> IO Font fontFromGC display gc = allocaBytes #{size XGCValues} $ \ values -> do throwIfZero "fontFromGC" $ xGetGCValues display gc #{const GCFont} values #{peek XGCValues,font} values foreign import ccall unsafe "HsXlib.h XGetGCValues" xGetGCValues :: Display -> GC -> ValueMask -> Ptr GCValues -> IO Int type ValueMask = #{type unsigned long} -- | interface to the X11 library function @XLoadQueryFont()@. loadQueryFont :: Display -> String -> IO FontStruct loadQueryFont display name = withCString name $ \ c_name -> do fs <- throwIfNull "loadQueryFont" $ xLoadQueryFont display c_name return (FontStruct fs) foreign import ccall unsafe "HsXlib.h XLoadQueryFont" xLoadQueryFont :: Display -> CString -> IO (Ptr FontStruct) -- | interface to the X11 library function @XFreeFont()@. foreign import ccall unsafe "HsXlib.h XFreeFont" freeFont :: Display -> FontStruct -> IO () -- %fun XSetFontPath :: Display -> ListString -> IO () using XSetFontPath(arg1,arg2,arg2_size) fontFromFontStruct :: FontStruct -> Font fontFromFontStruct (FontStruct fs) = unsafePerformIO $ #{peek XFontStruct,fid} fs ascentFromFontStruct :: FontStruct -> Int32 ascentFromFontStruct (FontStruct fs) = unsafePerformIO $ #{peek XFontStruct,ascent} fs descentFromFontStruct :: FontStruct -> Int32 descentFromFontStruct (FontStruct fs) = unsafePerformIO $ #{peek XFontStruct,descent} fs -- %prim XGetFontPath :: Display -> IO ListString --Int r_size; --String* r = XGetFontPath(arg1,&r_size); -- %update(r); --XFreeFontPath(r); --return; -- %prim XListFonts :: Display -> String -> Int -> IO ListString --Int r_size; --String *r = XListFonts(arg1,arg2,arg3,&r_size); -- %update(r); --XFreeFontNames(r); --return; -- XListFontsWithInfo omitted (no support for FontStruct yet) -- XQueryTextExtents omitted (no support for CharStruct yet) -- XQueryTextExtents16 omitted (no support for CharStruct yet) -- We marshall this across right away because it's usually one-off info type CharStruct = ( Int -- lbearing (origin to left edge of raster) , Int -- rbearing (origin to right edge of raster) , Int -- width (advance to next char's origin) , Int -- ascent (baseline to top edge of raster) , Int -- descent (baseline to bottom edge of raster) -- attributes omitted ) peekCharStruct :: Ptr CharStruct -> IO CharStruct peekCharStruct p = do lbearing <- #{peek XCharStruct,lbearing} p rbearing <- #{peek XCharStruct,rbearing} p width <- #{peek XCharStruct,width} p ascent <- #{peek XCharStruct,ascent} p descent <- #{peek XCharStruct,descent} p return (fromIntegral (lbearing::CShort), fromIntegral (rbearing::CShort), fromIntegral (width::CShort), fromIntegral (ascent::CShort), fromIntegral (descent::CShort)) -- No need to put this in the IO monad - this info is essentially constant -- | interface to the X11 library function @XTextExtents()@. textExtents :: FontStruct -> String -> (FontDirection, Int32, Int32, CharStruct) textExtents font_struct string = unsafePerformIO $ withCStringLen string $ \ (c_string, nchars) -> alloca $ \ direction_return -> alloca $ \ font_ascent_return -> alloca $ \ font_descent_return -> allocaBytes #{size XCharStruct} $ \ overall_return -> do xTextExtents font_struct c_string nchars direction_return font_ascent_return font_descent_return overall_return direction <- peek direction_return ascent <- peek font_ascent_return descent <- peek font_descent_return cs <- peekCharStruct overall_return return (direction, ascent, descent, cs) foreign import ccall unsafe "HsXlib.h XTextExtents" xTextExtents :: FontStruct -> CString -> Int -> Ptr FontDirection -> Ptr Int32 -> Ptr Int32 -> Ptr CharStruct -> IO Int -- No need to put ths in the IO monad - this info is essentially constant -- | interface to the X11 library function @XTextWidth()@. textWidth :: FontStruct -> String -> Int32 textWidth font_struct string = unsafePerformIO $ withCStringLen string $ \ (c_string, len) -> xTextWidth font_struct c_string len foreign import ccall unsafe "HsXlib.h XTextWidth" xTextWidth :: FontStruct -> CString -> Int -> IO Int32 -- XTextExtents16 omitted -- XTextWidth16 omitted -- XGetFontProperty omitted -- XFreeFontInfo omitted -- XFreeFontNames omitted -- XCreateFontSet omitted (no documentation available) -- XFreeFontSet omitted (no documentation available) -- XFontsOfFontSet omitted (no documentation available) -- XBaseFontNameListOfFontSet omitted (no documentation available) -- XLocaleOfFontSet omitted (no documentation available) -- XExtentsOfFontSet omitted (no documentation available) -- XContextDependentDrawing omitted -- XDirectionalDependentDrawing omitted -- XContextualDrawing omitted -- XmbTextEscapement omitted -- XwcTextEscapement omitted -- XmbTextExtents omitted -- XwcTextExtents omitted -- XmbTextPerCharExtents omitted -- XwcTextPerCharExtents omitted -- XmbDrawText omitted -- XwcDrawText omitted -- XmbDrawString omitted -- XwcDrawString omitted -- XmbDrawImageString omitted -- XwcDrawImageString omitted -- XOpenIM omitted -- XCloseIM omitted -- XGetIMValues omitted -- XSetIMValues omitted -- DisplayOfIM omitted -- XLocaleOfIM omitted -- XCreateIC omitted -- XDestroyIC omitted -- XSetICFocus omitted -- XUnsetICFocus omitted -- XwcResetIC omitted -- XmbResetIC omitted -- XSetICValues omitted -- XGetICValues omitted -- XIMOfIC omitted -- XRegisterIMInstantiateCallback omitted -- XUnregisterIMInstantiateCallback omitted -- XInternalConnectionNumbers omitted -- XProcessInternalConnection omitted -- XAddConnectionWatch omitted -- XRemoveConnectionWatch omitted -- XmbLookupString omitted -- XwcLookupString omitted ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Misc.hsc0000644006511100651110000013150210504340414021510 0ustar rossross{-# OPTIONS_GHC -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Misc -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Misc( rmInitialize, autoRepeatOff, autoRepeatOn, bell, setCloseDownMode, lastKnownRequestProcessed, getInputFocus, setInputFocus, grabButton, ungrabButton, grabPointer, ungrabPointer, grabKey, ungrabKey, grabKeyboard, ungrabKeyboard, grabServer, ungrabServer, queryBestTile, queryBestStipple, queryBestCursor, queryBestSize, queryPointer, -- * Error reporting displayName, setDefaultErrorHandler, -- * Geometry geometry, getGeometry, -- * Locale supportsLocale, setLocaleModifiers, -- * Screen saver AllowExposuresMode, dontAllowExposures, allowExposures, defaultExposures, PreferBlankingMode, dontPreferBlanking, preferBlanking, defaultBlanking, ScreenSaverMode, screenSaverActive, screenSaverReset, getScreenSaver, setScreenSaver, activateScreenSaver, resetScreenSaver, forceScreenSaver, -- * Pointer getPointerControl, warpPointer, -- * Pixmaps createPixmap, freePixmap, bitmapBitOrder, bitmapUnit, bitmapPad, -- * Keycodes displayKeycodes, lookupKeysym, keycodeToKeysym, keysymToKeycode, keysymToString, stringToKeysym, noSymbol, lookupString, -- * Icons getIconName, setIconName, -- * Cursors defineCursor, undefineCursor, createPixmapCursor, createGlyphCursor, createFontCursor, freeCursor, recolorCursor, -- * Window manager stuff setWMProtocols, -- * Set window attributes allocaSetWindowAttributes, set_background_pixmap, set_background_pixel, set_border_pixmap, set_border_pixel, set_bit_gravity, set_win_gravity, set_backing_store, set_backing_planes, set_backing_pixel, set_save_under, set_event_mask, set_do_not_propagate_mask, set_override_redirect, set_colormap, set_cursor, -- * Drawing drawPoint, drawPoints, drawLine, drawLines, drawSegments, drawRectangle, drawRectangles, drawArc, drawArcs, fillRectangle, fillRectangles, fillPolygon, fillArc, fillArcs, copyArea, copyPlane, drawString, drawImageString, -- * Cut and paste buffers storeBuffer, storeBytes, fetchBuffer, fetchBytes, rotateBuffers, -- * Window properties setTextProperty, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Event import Graphics.X11.Xlib.Font import Foreign import Foreign.C #if __GLASGOW_HASKELL__ import Data.Generics #endif #include "HsXlib.h" -- I'm not sure why I added this since I don't have any of the related -- functions. -- | interface to the X11 library function @XrmInitialize()@. foreign import ccall unsafe "HsXlib.h XrmInitialize" rmInitialize :: IO () -- %fun XGetDefault :: Display -> String -> String -> IO () -- | interface to the X11 library function @XAutoRepeatOff()@. foreign import ccall unsafe "HsXlib.h XAutoRepeatOff" autoRepeatOff :: Display -> IO () -- | interface to the X11 library function @XAutoRepeatOn()@. foreign import ccall unsafe "HsXlib.h XAutoRepeatOn" autoRepeatOn :: Display -> IO () -- | interface to the X11 library function @XBell()@. foreign import ccall unsafe "HsXlib.h XBell" bell :: Display -> Int -> IO () -- | interface to the X11 library function @XSetCloseDownMode()@. foreign import ccall unsafe "HsXlib.h XSetCloseDownMode" setCloseDownMode :: Display -> CloseDownMode -> IO () -- | interface to the X11 library function @XLastKnownRequestProcessed()@. foreign import ccall unsafe "HsXlib.h XLastKnownRequestProcessed" lastKnownRequestProcessed :: Display -> IO Int -- | interface to the X11 library function @XGetInputFocus()@. getInputFocus :: Display -> IO (Window, FocusMode) getInputFocus display = alloca $ \ focus_return -> alloca $ \ revert_to_return -> do xGetInputFocus display focus_return revert_to_return focus <- peek focus_return revert_to <- peek revert_to_return return (focus, revert_to) foreign import ccall unsafe "HsXlib.h XGetInputFocus" xGetInputFocus :: Display -> Ptr Window -> Ptr FocusMode -> IO () -- | interface to the X11 library function @XSetInputFocus()@. foreign import ccall unsafe "HsXlib.h XSetInputFocus" setInputFocus :: Display -> Window -> FocusMode -> Time -> IO () -- XAllocID omitted -- XKillClient omitted -- XFetchName omitted -- XGetKeyboardControl omitted -- XChangeKeyboardControl omitted -- XChangeKeyboardMapping omitted -- XChangePointerControl omitted -- | interface to the X11 library function @XGrabButton()@. foreign import ccall unsafe "HsXlib.h XGrabButton" grabButton :: Display -> Button -> ButtonMask -> Window -> Bool -> EventMask -> GrabMode -> GrabMode -> Window -> Cursor -> IO () -- | interface to the X11 library function @XUngrabButton()@. foreign import ccall unsafe "HsXlib.h XUngrabButton" ungrabButton :: Display -> Button -> ButtonMask -> Window -> IO () -- | interface to the X11 library function @XGrabPointer()@. foreign import ccall unsafe "HsXlib.h XGrabPointer" grabPointer :: Display -> Window -> Bool -> EventMask -> GrabMode -> GrabMode -> Window -> Cursor -> Time -> IO GrabStatus -- | interface to the X11 library function @XUngrabPointer()@. foreign import ccall unsafe "HsXlib.h XUngrabPointer" ungrabPointer :: Display -> Time -> IO () -- | interface to the X11 library function @XGrabKey()@. foreign import ccall unsafe "HsXlib.h XGrabKey" grabKey :: Display -> KeyCode -> ButtonMask -> Window -> Bool -> GrabMode -> GrabMode -> IO () -- | interface to the X11 library function @XUngrabKey()@. foreign import ccall unsafe "HsXlib.h XUngrabKey" ungrabKey :: Display -> KeyCode -> ButtonMask -> Window -> IO () -- | interface to the X11 library function @XGrabKeyboard()@. foreign import ccall unsafe "HsXlib.h XGrabKeyboard" grabKeyboard :: Display -> Window -> Bool -> GrabMode -> GrabMode -> Time -> IO GrabStatus -- | interface to the X11 library function @XUngrabKeyboard()@. foreign import ccall unsafe "HsXlib.h XUngrabKeyboard" ungrabKeyboard :: Display -> Time -> IO () -- | interface to the X11 library function @XGrabServer()@. foreign import ccall unsafe "HsXlib.h XGrabServer" grabServer :: Display -> IO () -- | interface to the X11 library function @XUngrabServer()@. foreign import ccall unsafe "HsXlib.h XUngrabServer" ungrabServer :: Display -> IO () -- XChangeActivePointerGrab omitted -- | interface to the X11 library function @XFree()@. foreign import ccall unsafe "HsXlib.h XFree" xFree :: Ptr a -> IO () -- XFreeStringList omitted -- | interface to the X11 library function @XQueryBestTile()@. queryBestTile :: Display -> Drawable -> Dimension -> Dimension -> IO (Dimension, Dimension) queryBestTile display which_screen width height = outParameters2 (throwIfZero "queryBestTile") $ xQueryBestTile display which_screen width height foreign import ccall unsafe "HsXlib.h XQueryBestTile" xQueryBestTile :: Display -> Drawable -> Dimension -> Dimension -> Ptr Dimension -> Ptr Dimension -> IO Status -- | interface to the X11 library function @XQueryBestStipple()@. queryBestStipple :: Display -> Drawable -> Dimension -> Dimension -> IO (Dimension, Dimension) queryBestStipple display which_screen width height = outParameters2 (throwIfZero "queryBestStipple") $ xQueryBestStipple display which_screen width height foreign import ccall unsafe "HsXlib.h XQueryBestStipple" xQueryBestStipple :: Display -> Drawable -> Dimension -> Dimension -> Ptr Dimension -> Ptr Dimension -> IO Status -- | interface to the X11 library function @XQueryBestCursor()@. queryBestCursor :: Display -> Drawable -> Dimension -> Dimension -> IO (Dimension, Dimension) queryBestCursor display d width height = outParameters2 (throwIfZero "queryBestCursor") $ xQueryBestCursor display d width height foreign import ccall unsafe "HsXlib.h XQueryBestCursor" xQueryBestCursor :: Display -> Drawable -> Dimension -> Dimension -> Ptr Dimension -> Ptr Dimension -> IO Status -- | interface to the X11 library function @XQueryBestSize()@. queryBestSize :: Display -> QueryBestSizeClass -> Drawable -> Dimension -> Dimension -> IO (Dimension, Dimension) queryBestSize display shape_class which_screen width height = outParameters2 (throwIfZero "queryBestSize") $ xQueryBestSize display shape_class which_screen width height foreign import ccall unsafe "HsXlib.h XQueryBestSize" xQueryBestSize :: Display -> QueryBestSizeClass -> Drawable -> Dimension -> Dimension -> Ptr Dimension -> Ptr Dimension -> IO Status -- Note: Returns false if pointer not in window w (and win_x = win_y = 0) -- ToDo: more effective use of Maybes? -- | interface to the X11 library function @XQueryPointer()@. queryPointer :: Display -> Window -> IO (Bool, Window, Window, Int, Int, Int, Int, Modifier) queryPointer display w = alloca $ \ root_return -> alloca $ \ child_return -> alloca $ \ root_x_return -> alloca $ \ root_y_return -> alloca $ \ win_x_return -> alloca $ \ win_y_return -> alloca $ \ mask_return -> do rel <- xQueryPointer display w root_return child_return root_x_return root_y_return win_x_return win_y_return mask_return root <- peek root_return child <- peek child_return root_x <- peek root_x_return root_y <- peek root_y_return win_x <- peek win_x_return win_y <- peek win_y_return mask <- peek mask_return return (rel, root, child, root_x, root_y, win_x, win_y, mask) foreign import ccall unsafe "HsXlib.h XQueryPointer" xQueryPointer :: Display -> Window -> Ptr Window -> Ptr Window -> Ptr Int -> Ptr Int -> Ptr Int -> Ptr Int -> Ptr Modifier -> IO Bool -- XSetSelectionOwner omitted -- XOpenOM omitted -- XCloseOM omitted -- XSetOMValues omitted -- XGetOMValues omitted -- DisplayOfOM omitted -- XLocaleOfOM omitted -- XCreateOC omitted -- XDestroyOC omitted -- XOMOfOC omitted -- XSetOCValues omitted -- XGetOCValues omitted -- XVaCreateNestedList omitted ---------------------------------------------------------------- -- Error reporting ---------------------------------------------------------------- -- | interface to the X11 library function @XDisplayName()@. displayName :: String -> String displayName str = unsafePerformIO $ withCString str $ \ c_str -> do c_name <- xDisplayName c_str peekCString c_name foreign import ccall unsafe "HsXlib.h XDisplayName" xDisplayName :: CString -> IO CString -- type ErrorHandler = Display -> ErrorEvent -> IO Int -- %dis errorHandler x = (stable x) -- -- type IOErrorHandler = Display -> IO Int -- %dis ioErrorHandler x = (stable x) -- Sadly, this code doesn't work because hugs->runIO creates a fresh -- stack of exception handlers so the exception gets thrown to the -- wrong place. -- -- %C -- % static HugsStablePtr ioErrorHandlerPtr; -- % -- % int genericIOErrorHandler(Display *d) -- % { -- % if (ioErrorHandlerPtr >= 0) { -- % hugs->putStablePtr(ioErrorHandlerPtr); -- % hugs->putAddr(d); -- % if (hugs->runIO(1)) { /* exitWith value returned */ -- % return hugs->getInt(); -- % } else { -- % return hugs->getWord(); -- % } -- % } -- % return 1; -- % } -- Here's what we might do instead. The two error handlers set flags -- when they fire and every single call to X contains the line: -- -- %fail { errorFlags != 0 } { XError(errorFlags) } -- -- This really sucks. -- Oh, and it won't even work with IOErrors since they terminate -- the process if the handler returns. I don't know what the hell they -- think they're doing taking it upon themselves to terminate MY -- process when THEIR library has a problem but I don't think anyone -- ever accused X of being well-designed. -- -- % static int genericIOErrorHandler(Display *d) -- % { -- % if (ioErrorHandlerPtr >= 0) { -- % hugs->putStablePtr(ioErrorHandlerPtr); -- % hugs->putAddr(d); -- % if (hugs->runIO(1)) { /* exitWith value returned */ -- % return hugs->getInt(); -- % } else { -- % return hugs->getWord(); -- % } -- % } -- % return 1; -- % } -- HN 2001-02-06 -- Moved to auxiliaries.c to make it easier to use the inlining option. -- -- Sigh, for now we just use an error handler that prints an error -- -- message on the screen -- %C -- % static int defaultErrorHandler(Display *d, XErrorEvent *ev) -- % { -- % char buffer[1000]; -- % XGetErrorText(d,ev->error_code,buffer,1000); -- % printf("Error: %s\n", buffer); -- % return 0; -- % } {-# CFILES cbits/auxiliaries.c #-} newtype XErrorEvent = XErrorEvent (Ptr XErrorEvent) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif type ErrorHandler = FunPtr (Display -> Ptr XErrorEvent -> IO Int) foreign import ccall unsafe "HsXlib.h &defaultErrorHandler" defaultErrorHandler :: FunPtr (Display -> Ptr XErrorEvent -> IO Int) -- | The Xlib library reports most errors by invoking a user-provided -- error handler. This function installs an error handler that prints a -- textual representation of the error. setDefaultErrorHandler :: IO () setDefaultErrorHandler = do xSetErrorHandler defaultErrorHandler return () -- %fun XSetIOErrorHandler :: IOErrorHandler -> IO IOErrorHandler foreign import ccall unsafe "HsXlib.h XSetErrorHandler" xSetErrorHandler :: ErrorHandler -> IO ErrorHandler -- XGetErrorDatabaseText omitted -- XGetErrorText omitted ---------------------------------------------------------------- -- -- Buffers -- ---------------------------------------------------------------- -- -- -- OLD: Would arrays be more appropriate? -- -- -- -- IMPURE void XStoreBytes(display, bytes, nbytes) -- -- IN Display* display -- -- VAR Int nbytes -- -- IN list[nbytes] Byte bytes -- -- -- -- IMPURE list[nbytes] Byte XFetchBytes(display, &nbytes) -- -- IN Display* display -- -- VAR Int nbytes -- -- -- -- IMPURE void XStoreBuffer(display, bytes, nbytes, buffer) -- -- IN Display* display -- -- VAR Int nbytes -- -- IN list[nbytes] Byte bytes -- -- IN Buffer buffer -- -- -- -- IMPURE list[nbytes] Byte XFetchBuffer(display, &nbytes, buffer) -- -- IN Display* display -- -- VAR Int nbytes -- -- IN Buffer buffer -- -- -- -- IMPURE void XRotateBuffers(display, rotate) -- -- IN Display* display -- -- VAR Int rotate ---------------------------------------------------------------- -- Extensions ---------------------------------------------------------------- -- ToDo: Use XFreeExtensionList -- %fun XListExtensions :: Display -> IO ListString using res1 = XListExtensions(arg1,&res1_size) -- %errfun False XQueryExtension :: Display -> String -> IO (Int,Int,Int) using res4 = XQueryExtension(arg1,arg2,&res1,&res2,&res3)->(res1,res2,res3) -- %fun XInitExtensions :: Display -> String -> IO XExtCodes -- %fun XAddExtensions :: Display -> IO XExtCodes -- XAddToExtensionList omitted -- XFindOnExtensionList omitted -- XEHeadOfExtensionList omitted ---------------------------------------------------------------- -- Hosts ---------------------------------------------------------------- -- ToDo: operations to construct and destruct an XHostAddress -- %fun XAddHost :: Display -> XHostAddress -> IO () -- %fun XRemoveHost :: Display -> XHostAddress -> IO () -- -- %fun XAddHosts :: Display -> ListXHostAddress -> IO () using XAddHosts(arg1,arg2,arg2_size) -- %fun XRemoveHosts :: Display -> ListXHostAddress -> IO () using XRemoveHosts(arg1,arg2,arg2_size) -- -- -- Uses %prim to let us call XFree -- %prim XListHosts :: Display -> IO (ListXHostAddress, Bool) -- Bool state; -- Int r_size; -- XHostAddress* r = XListHosts(arg1,&r_size,&state); -- %update(r,state); -- XFree(r); -- return; -- %fun XEnableAccessControl :: Display -> IO () -- %fun XDisableAccessControl :: Display -> IO () -- %fun XSetAccessControl :: Display -> Access -> IO () ---------------------------------------------------------------- -- Geometry ---------------------------------------------------------------- -- | interface to the X11 library function @XGeometry()@. geometry :: Display -> Int -> String -> String -> Dimension -> Dimension -> Dimension -> Int -> Int -> IO (Int, Position, Position, Dimension, Dimension) geometry display screen position default_position bwidth fwidth fheight xadder yadder = withCString position $ \ c_position -> withCString default_position $ \ c_default_position -> alloca $ \ x_return -> alloca $ \ y_return -> alloca $ \ width_return -> alloca $ \ height_return -> do res <- xGeometry display screen c_position c_default_position bwidth fwidth fheight xadder yadder x_return y_return width_return height_return x <- peek x_return y <- peek y_return width <- peek width_return height <- peek height_return return (res, x, y, width, height) foreign import ccall unsafe "HsXlib.h XGeometry" xGeometry :: Display -> Int -> CString -> CString -> Dimension -> Dimension -> Dimension -> Int -> Int -> Ptr Position -> Ptr Position -> Ptr Dimension -> Ptr Dimension -> IO Int -- | interface to the X11 library function @XGetGeometry()@. getGeometry :: Display -> Drawable -> IO (Window, Position, Position, Dimension, Dimension, Dimension, Int) getGeometry display d = outParameters7 (throwIfZero "getGeometry") $ xGetGeometry display d foreign import ccall unsafe "HsXlib.h XGetGeometry" xGetGeometry :: Display -> Drawable -> Ptr Window -> Ptr Position -> Ptr Position -> Ptr Dimension -> Ptr Dimension -> Ptr Dimension -> Ptr Int -> IO Status -- XParseGeometry omitted (returned bitset too weird) ---------------------------------------------------------------- -- Locale ---------------------------------------------------------------- -- | interface to the X11 library function @XSupportsLocale()@. foreign import ccall unsafe "HsXlib.h XSupportsLocale" supportsLocale :: IO Bool -- | interface to the X11 library function @XSetLocaleModifiers()@. setLocaleModifiers :: String -> IO String setLocaleModifiers mods = withCString mods $ \ modifier_list -> do c_str <- xSetLocaleModifiers modifier_list peekCString c_str foreign import ccall unsafe "HsXlib.h XSetLocaleModifiers" xSetLocaleModifiers :: CString -> IO CString ---------------------------------------------------------------- -- Screen Saver ---------------------------------------------------------------- type AllowExposuresMode = Int #{enum AllowExposuresMode, , dontAllowExposures = DontAllowExposures , allowExposures = AllowExposures , defaultExposures = DefaultExposures } type PreferBlankingMode = Int #{enum PreferBlankingMode, , dontPreferBlanking = DontPreferBlanking , preferBlanking = PreferBlanking , defaultBlanking = DefaultBlanking } type ScreenSaverMode = Int #{enum ScreenSaverMode, , screenSaverActive = ScreenSaverActive , screenSaverReset = ScreenSaverReset } getScreenSaver :: Display -> IO (Int, Int, PreferBlankingMode, AllowExposuresMode) getScreenSaver display = outParameters4 id (xGetScreenSaver display) foreign import ccall unsafe "HsXlib.h XGetScreenSaver" xGetScreenSaver :: Display -> Ptr Int -> Ptr Int -> Ptr PreferBlankingMode -> Ptr AllowExposuresMode -> IO () -- | interface to the X11 library function @XSetScreenSaver()@. foreign import ccall unsafe "HsXlib.h XSetScreenSaver" setScreenSaver :: Display -> Int -> Int -> PreferBlankingMode -> AllowExposuresMode -> IO () -- | interface to the X11 library function @XActivateScreenSaver()@. foreign import ccall unsafe "HsXlib.h XActivateScreenSaver" activateScreenSaver :: Display -> IO () -- | interface to the X11 library function @XResetScreenSaver()@. foreign import ccall unsafe "HsXlib.h XResetScreenSaver" resetScreenSaver :: Display -> IO () -- | interface to the X11 library function @XForceScreenSaver()@. foreign import ccall unsafe "HsXlib.h XForceScreenSaver" forceScreenSaver :: Display -> ScreenSaverMode -> IO () ---------------------------------------------------------------- -- Pointer ---------------------------------------------------------------- -- | interface to the X11 library function @XGetPointerControl()@. getPointerControl :: Display -> IO (Int, Int, Int) getPointerControl display = outParameters3 id (xGetPointerControl display) foreign import ccall unsafe "HsXlib.h XGetPointerControl" xGetPointerControl :: Display -> Ptr Int -> Ptr Int -> Ptr Int -> IO () -- | interface to the X11 library function @XWarpPointer()@. foreign import ccall unsafe "HsXlib.h XWarpPointer" warpPointer :: Display -> Window -> Window -> Position -> Position -> Dimension -> Dimension -> Position -> Position -> IO () -- XGetPointerMapping omitted -- XSetPointerMapping omitted ---------------------------------------------------------------- -- Visuals ---------------------------------------------------------------- -- XVisualIDFromVisual omitted ---------------------------------------------------------------- -- Threads ---------------------------------------------------------------- -- XInitThreads omitted (leary of thread stuff) -- XLockDisplay omitted (leary of thread stuff) -- XUnlockDisplay omitted (leary of thread stuff) ---------------------------------------------------------------- -- Pixmaps ---------------------------------------------------------------- -- | interface to the X11 library function @XCreatePixmap()@. foreign import ccall unsafe "HsXlib.h XCreatePixmap" createPixmap :: Display -> Drawable -> Dimension -> Dimension -> Int -> IO Pixmap -- | interface to the X11 library function @XFreePixmap()@. foreign import ccall unsafe "HsXlib.h XFreePixmap" freePixmap :: Display -> Pixmap -> IO () -- XCreatePixmapFromBitmapData omitted (type looks strange) -- %fun XListPixmapFormatValues = res1 = XListPixmapFormatValues(display, &res1_size) :: Display -> ListXPixmapFormatValues ---------------------------------------------------------------- -- Bitmaps ---------------------------------------------------------------- -- ToDo: do these need to be available to the programmer? -- Maybe I could just wire them into all other operations? -- | interface to the X11 library function @XBitmapBitOrder()@. foreign import ccall unsafe "HsXlib.h XBitmapBitOrder" bitmapBitOrder :: Display -> ByteOrder -- | interface to the X11 library function @XBitmapUnit()@. foreign import ccall unsafe "HsXlib.h XBitmapUnit" bitmapUnit :: Display -> Int -- | interface to the X11 library function @XBitmapPad()@. foreign import ccall unsafe "HsXlib.h XBitmapPad" bitmapPad :: Display -> Int -- ToDo: make sure that initialisation works correctly for x/y_hot -- omitted -- IMPURE void XWriteBitmapFile(display, filename, bitmap, width, height, x_hot, y_hot) RAISES Either -- RETURNTYPE BitmapFileStatus -- GLOBAL ERROR BitmapFileStatus RETVAL -- IN Display* display -- IN String filename -- IN Pixmap bitmap -- IN Dimension width -- IN Dimension height -- IN Maybe Int x_hot = -1 -- IN Maybe Int y_hot = -1 -- POST: RETVAL == BitmapSuccess -- omitted -- IMPURE void XReadBitmapFile(display, d, filename, bitmap, width, height, x_hot, y_hot) RAISES Either -- RETURNTYPE BitmapFileStatus -- GLOBAL ERROR BitmapFileStatus RETVAL -- IN Display* display -- IN Drawable d -- IN String filename -- OUT Pixmap bitmap -- OUT Dimension width -- OUT Dimension height -- OUT Int x_hot RAISES Maybe IF x_hot == -1 -- OUT Int y_hot RAISES Maybe IF x_hot == -1 -- POST: RETVAL == BitmapSuccess -- XCreateBitmapFromData omitted (awkward looking type) -- XReadBitmapFileData omitted (awkward looking type) ---------------------------------------------------------------- -- Keycodes ---------------------------------------------------------------- -- | interface to the X11 library function @XDisplayKeycodes()@. displayKeycodes :: Display -> (Int,Int) displayKeycodes display = unsafePerformIO $ outParameters2 id $ xDisplayKeycodes display foreign import ccall unsafe "HsXlib.h XDisplayKeycodes" xDisplayKeycodes :: Display -> Ptr Int -> Ptr Int -> IO () -- | interface to the X11 library function @XLookupKeysym()@. foreign import ccall unsafe "HsXlib.h XLookupKeysym" lookupKeysym :: XKeyEventPtr -> Int -> IO KeySym -- | interface to the X11 library function @XKeycodeToKeysym()@. foreign import ccall unsafe "HsXlib.h XKeycodeToKeysym" keycodeToKeysym :: Display -> KeyCode -> Int -> IO KeySym -- | interface to the X11 library function @XKeysymToKeycode()@. foreign import ccall unsafe "HsXlib.h XKeysymToKeycode" keysymToKeycode :: Display -> KeySym -> IO KeyCode -- | interface to the X11 library function @XKeysymToString()@. keysymToString :: KeySym -> String keysymToString keysym = unsafePerformIO $ do c_str <- xKeysymToString keysym peekCString c_str foreign import ccall unsafe "HsXlib.h XKeysymToString" xKeysymToString :: KeySym -> IO CString -- | interface to the X11 library function @XStringToKeysym()@. stringToKeysym :: String -> KeySym stringToKeysym str = unsafePerformIO $ withCString str $ \ c_str -> xStringToKeysym c_str foreign import ccall unsafe "HsXlib.h XStringToKeysym" xStringToKeysym :: CString -> IO KeySym noSymbol :: KeySym noSymbol = #{const NoSymbol} newtype XComposeStatus = XComposeStatus (Ptr XComposeStatus) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif -- XLookupString cannot handle compose, it seems. -- | interface to the X11 library function @XLookupString()@. lookupString :: XKeyEventPtr -> IO (Maybe KeySym, String) lookupString event_ptr = allocaBytes 100 $ \ buf -> alloca $ \ keysym_return -> do n <- xLookupString event_ptr buf 100 keysym_return nullPtr str <- peekCStringLen (buf, n) keysym <- peek keysym_return return (if keysym == noSymbol then Nothing else Just keysym, str) foreign import ccall unsafe "HsXlib.h XLookupString" xLookupString :: XKeyEventPtr -> CString -> Int -> Ptr KeySym -> Ptr XComposeStatus -> IO Int -- XQueryKeymap omitted -- XRebindKeysym omitted -- XDeleteModifiermapEntry omitted -- XInsertModifiermapEntry omitted -- XNewModifiermap omitted -- XFreeModifiermap omitted -- XSetModifierMapping omitted -- XGetModifierMapping omitted -- XGetKeyboardMapping omitted ---------------------------------------------------------------- -- Image ---------------------------------------------------------------- -- XCreateImage omitted -- XInitImage omitted -- XGetImage omitted -- XPutImage omitted -- XGetSubImage omitted ---------------------------------------------------------------- -- Icons ---------------------------------------------------------------- -- | interface to the X11 library function @XGetIconName()@. getIconName :: Display -> Window -> IO String getIconName display w = alloca $ \ icon_name_return -> do throwIfZero "getIconName" $ xGetIconName display w icon_name_return c_icon_name <- peek icon_name_return peekCString c_icon_name foreign import ccall unsafe "HsXlib.h XGetIconName" xGetIconName :: Display -> Window -> Ptr CString -> IO Status -- | interface to the X11 library function @XSetIconName()@. setIconName :: Display -> Window -> String -> IO () setIconName display w icon_name = withCString icon_name $ \ c_icon_name -> xSetIconName display w c_icon_name foreign import ccall unsafe "HsXlib.h XSetIconName" xSetIconName :: Display -> Window -> CString -> IO () ---------------------------------------------------------------- -- Cursors ---------------------------------------------------------------- -- | interface to the X11 library function @XDefineCursor()@. foreign import ccall unsafe "HsXlib.h XDefineCursor" defineCursor :: Display -> Window -> Cursor -> IO () -- | interface to the X11 library function @XUndefineCursor()@. foreign import ccall unsafe "HsXlib.h XUndefineCursor" undefineCursor :: Display -> Window -> IO () -- | interface to the X11 library function @XCreatePixmapCursor()@. createPixmapCursor :: Display -> Pixmap -> Pixmap -> Color -> Color -> Dimension -> Dimension -> IO Cursor createPixmapCursor display source mask fg_color bg_color x y = with fg_color $ \ fg_color_ptr -> with bg_color $ \ bg_color_ptr -> xCreatePixmapCursor display source mask fg_color_ptr bg_color_ptr x y foreign import ccall unsafe "HsXlib.h XCreatePixmapCursor" xCreatePixmapCursor :: Display -> Pixmap -> Pixmap -> Ptr Color -> Ptr Color -> Dimension -> Dimension -> IO Cursor -- | interface to the X11 library function @XCreateGlyphCursor()@. createGlyphCursor :: Display -> Font -> Font -> Glyph -> Glyph -> Color -> Color -> IO Cursor createGlyphCursor display source_font mask_font source_char mask_char fg_color bg_color = with fg_color $ \ fg_color_ptr -> with bg_color $ \ bg_color_ptr -> xCreateGlyphCursor display source_font mask_font source_char mask_char fg_color_ptr bg_color_ptr foreign import ccall unsafe "HsXlib.h XCreateGlyphCursor" xCreateGlyphCursor :: Display -> Font -> Font -> Glyph -> Glyph -> Ptr Color -> Ptr Color -> IO Cursor -- | interface to the X11 library function @XCreateFontCursor()@. foreign import ccall unsafe "HsXlib.h XCreateFontCursor" createFontCursor :: Display -> Glyph -> IO Cursor -- | interface to the X11 library function @XFreeCursor()@. foreign import ccall unsafe "HsXlib.h XFreeCursor" freeCursor :: Display -> Font -> IO () -- | interface to the X11 library function @XRecolorCursor()@. recolorCursor :: Display -> Cursor -> Color -> Color -> IO () recolorCursor display cursor fg_color bg_color = with fg_color $ \ fg_color_ptr -> with bg_color $ \ bg_color_ptr -> xRecolorCursor display cursor fg_color_ptr bg_color_ptr foreign import ccall unsafe "HsXlib.h XRecolorCursor" xRecolorCursor :: Display -> Cursor -> Ptr Color -> Ptr Color -> IO () ---------------------------------------------------------------- -- Window Manager stuff ---------------------------------------------------------------- -- XConfigureWMWindow omitted (can't find documentation) -- XReconfigureWMWindow omitted (can't find documentation) -- XWMGeometry omitted (can't find documentation) -- XGetWMColormapWindows omitted (can't find documentation) -- XSetWMColormapWindows omitted (can't find documentation) -- XGetWMProtocols omitted -- AC, 1/9/2000: Added definition for XSetWMProtocols -- | interface to the X11 library function @XSetWMProtocols()@. setWMProtocols :: Display -> Window -> [Atom] -> IO () setWMProtocols display w protocols = withArray protocols $ \ protocol_array -> xSetWMProtocols display w protocol_array (length protocols) foreign import ccall unsafe "HsXlib.h XSetWMProtocols" xSetWMProtocols :: Display -> Window -> Ptr Atom -> Int -> IO () ---------------------------------------------------------------- -- Set Window Attributes ---------------------------------------------------------------- -- ToDo: generate this kind of stuff automatically. allocaSetWindowAttributes :: (Ptr SetWindowAttributes -> IO a) -> IO a allocaSetWindowAttributes = allocaBytes #{size XSetWindowAttributes} ---------------- Access to individual fields ---------------- set_background_pixmap :: Ptr SetWindowAttributes -> Pixmap -> IO () set_background_pixmap = #{poke XSetWindowAttributes,background_pixmap} set_background_pixel :: Ptr SetWindowAttributes -> Pixel -> IO () set_background_pixel = #{poke XSetWindowAttributes,background_pixel} set_border_pixmap :: Ptr SetWindowAttributes -> Pixmap -> IO () set_border_pixmap = #{poke XSetWindowAttributes,border_pixmap} set_border_pixel :: Ptr SetWindowAttributes -> Pixel -> IO () set_border_pixel = #{poke XSetWindowAttributes,border_pixel} set_bit_gravity :: Ptr SetWindowAttributes -> BitGravity -> IO () set_bit_gravity = #{poke XSetWindowAttributes,bit_gravity} set_win_gravity :: Ptr SetWindowAttributes -> WindowGravity -> IO () set_win_gravity = #{poke XSetWindowAttributes,win_gravity} set_backing_store :: Ptr SetWindowAttributes -> BackingStore -> IO () set_backing_store = #{poke XSetWindowAttributes,backing_store} set_backing_planes :: Ptr SetWindowAttributes -> Pixel -> IO () set_backing_planes = #{poke XSetWindowAttributes,backing_planes} set_backing_pixel :: Ptr SetWindowAttributes -> Pixel -> IO () set_backing_pixel = #{poke XSetWindowAttributes,backing_pixel} set_save_under :: Ptr SetWindowAttributes -> Bool -> IO () set_save_under = #{poke XSetWindowAttributes,save_under} set_event_mask :: Ptr SetWindowAttributes -> EventMask -> IO () set_event_mask = #{poke XSetWindowAttributes,event_mask} set_do_not_propagate_mask :: Ptr SetWindowAttributes -> EventMask -> IO () set_do_not_propagate_mask = #{poke XSetWindowAttributes,do_not_propagate_mask} set_override_redirect :: Ptr SetWindowAttributes -> Bool -> IO () set_override_redirect = #{poke XSetWindowAttributes,override_redirect} set_colormap :: Ptr SetWindowAttributes -> Colormap -> IO () set_colormap = #{poke XSetWindowAttributes,colormap} set_cursor :: Ptr SetWindowAttributes -> Cursor -> IO () set_cursor = #{poke XSetWindowAttributes,cursor} ---------------------------------------------------------------- -- Drawing ---------------------------------------------------------------- -- | interface to the X11 library function @XDrawPoint()@. foreign import ccall unsafe "HsXlib.h XDrawPoint" drawPoint :: Display -> Drawable -> GC -> Position -> Position -> IO () -- | interface to the X11 library function @XDrawPoints()@. drawPoints :: Display -> Drawable -> GC -> [Point] -> CoordinateMode -> IO () drawPoints display d gc points mode = withArrayLen points $ \ npoints point_array -> xDrawPoints display d gc point_array npoints mode foreign import ccall unsafe "HsXlib.h XDrawPoints" xDrawPoints :: Display -> Drawable -> GC -> Ptr Point -> Int -> CoordinateMode -> IO () -- | interface to the X11 library function @XDrawLine()@. foreign import ccall unsafe "HsXlib.h XDrawLine" drawLine :: Display -> Drawable -> GC -> Position -> Position -> Position -> Position -> IO () -- | interface to the X11 library function @XDrawLines()@. drawLines :: Display -> Drawable -> GC -> [Point] -> CoordinateMode -> IO () drawLines display d gc points mode = withArrayLen points $ \ npoints point_array -> xDrawLines display d gc point_array npoints mode foreign import ccall unsafe "HsXlib.h XDrawLines" xDrawLines :: Display -> Drawable -> GC -> Ptr Point -> Int -> CoordinateMode -> IO () -- | interface to the X11 library function @XDrawSegments()@. drawSegments :: Display -> Drawable -> GC -> [Segment] -> IO () drawSegments display d gc segments = withArrayLen segments $ \ nsegments segment_array -> xDrawSegments display d gc segment_array nsegments foreign import ccall unsafe "HsXlib.h XDrawSegments" xDrawSegments :: Display -> Drawable -> GC -> Ptr Segment -> Int -> IO () -- | interface to the X11 library function @XDrawRectangle()@. foreign import ccall unsafe "HsXlib.h XDrawRectangle" drawRectangle :: Display -> Drawable -> GC -> Position -> Position -> Dimension -> Dimension -> IO () -- | interface to the X11 library function @XDrawRectangles()@. drawRectangles :: Display -> Drawable -> GC -> [Rectangle] -> IO () drawRectangles display d gc rectangles = withArrayLen rectangles $ \ nrectangles rectangle_array -> xDrawRectangles display d gc rectangle_array nrectangles foreign import ccall unsafe "HsXlib.h XDrawRectangles" xDrawRectangles :: Display -> Drawable -> GC -> Ptr Rectangle -> Int -> IO () -- | interface to the X11 library function @XDrawArc()@. foreign import ccall unsafe "HsXlib.h XDrawArc" drawArc :: Display -> Drawable -> GC -> Position -> Position -> Dimension -> Dimension -> Angle -> Angle -> IO () -- | interface to the X11 library function @XDrawArcs()@. drawArcs :: Display -> Drawable -> GC -> [Arc] -> IO () drawArcs display d gc arcs = withArrayLen arcs $ \ narcs arc_array -> xDrawArcs display d gc arc_array narcs foreign import ccall unsafe "HsXlib.h XDrawArcs" xDrawArcs :: Display -> Drawable -> GC -> Ptr Arc -> Int -> IO () -- | interface to the X11 library function @XFillRectangle()@. foreign import ccall unsafe "HsXlib.h XFillRectangle" fillRectangle :: Display -> Drawable -> GC -> Position -> Position -> Dimension -> Dimension -> IO () -- | interface to the X11 library function @XFillRectangles()@. fillRectangles :: Display -> Drawable -> GC -> [Rectangle] -> IO () fillRectangles display d gc rectangles = withArrayLen rectangles $ \ nrectangles rectangle_array -> xFillRectangles display d gc rectangle_array nrectangles foreign import ccall unsafe "HsXlib.h XFillRectangles" xFillRectangles :: Display -> Drawable -> GC -> Ptr Rectangle -> Int -> IO () -- | interface to the X11 library function @XFillPolygon()@. fillPolygon :: Display -> Drawable -> GC -> [Point] -> PolygonShape -> CoordinateMode -> IO () fillPolygon display d gc points shape mode = withArrayLen points $ \ npoints point_array -> xFillPolygon display d gc point_array npoints shape mode foreign import ccall unsafe "HsXlib.h XFillPolygon" xFillPolygon :: Display -> Drawable -> GC -> Ptr Point -> Int -> PolygonShape -> CoordinateMode -> IO () -- | interface to the X11 library function @XFillArc()@. foreign import ccall unsafe "HsXlib.h XFillArc" fillArc :: Display -> Drawable -> GC -> Position -> Position -> Dimension -> Dimension -> Angle -> Angle -> IO () -- | interface to the X11 library function @XFillArcs()@. fillArcs :: Display -> Drawable -> GC -> [Arc] -> IO () fillArcs display d gc arcs = withArrayLen arcs $ \ narcs arc_array -> xFillArcs display d gc arc_array narcs foreign import ccall unsafe "HsXlib.h XFillArcs" xFillArcs :: Display -> Drawable -> GC -> Ptr Arc -> Int -> IO () -- | interface to the X11 library function @XCopyArea()@. foreign import ccall unsafe "HsXlib.h XCopyArea" copyArea :: Display -> Drawable -> Drawable -> GC -> Position -> Position -> Dimension -> Dimension -> Position -> Position -> IO () -- | interface to the X11 library function @XCopyPlane()@. foreign import ccall unsafe "HsXlib.h XCopyPlane" copyPlane :: Display -> Drawable -> Drawable -> GC -> Position -> Position -> Dimension -> Dimension -> Position -> Position -> Pixel -> IO () -- draw characters over existing background -- | interface to the X11 library function @XDrawString()@. drawString :: Display -> Drawable -> GC -> Position -> Position -> String -> IO () drawString display d gc x y str = withCStringLen str $ \ (c_str, len) -> xDrawString display d gc x y c_str len foreign import ccall unsafe "HsXlib.h XDrawString" xDrawString :: Display -> Drawable -> GC -> Position -> Position -> CString -> Int -> IO () -- draw characters over a blank rectangle of current background colour -- | interface to the X11 library function @XDrawImageString()@. drawImageString :: Display -> Drawable -> GC -> Position -> Position -> String -> IO () drawImageString display d gc x y str = withCStringLen str $ \ (c_str, len) -> xDrawImageString display d gc x y c_str len foreign import ccall unsafe "HsXlib.h XDrawImageString" xDrawImageString :: Display -> Drawable -> GC -> Position -> Position -> CString -> Int -> IO () -- XDrawString16 omitted (16bit chars not supported) -- XDrawImageString16 omitted (16bit chars not supported) -- XDrawText omitted (XTextItem not supported) -- XDrawText16 omitted (XTextItem not supported) ---------------------------------------------------------------- -- Cut and paste buffers ---------------------------------------------------------------- -- | interface to the X11 library function @XStoreBuffer()@. storeBuffer :: Display -> String -> Int -> IO () storeBuffer display bytes buffer = withCStringLen bytes $ \ (c_bytes, nbytes) -> throwIfZero "storeBuffer" $ xStoreBuffer display c_bytes nbytes buffer foreign import ccall unsafe "HsXlib.h XStoreBuffer" xStoreBuffer :: Display -> CString -> Int -> Int -> IO Status -- | interface to the X11 library function @XStoreBytes()@. storeBytes :: Display -> String -> IO () storeBytes display bytes = withCStringLen bytes $ \ (c_bytes, nbytes) -> throwIfZero "storeBytes" $ xStoreBytes display c_bytes nbytes foreign import ccall unsafe "HsXlib.h XStoreBytes" xStoreBytes :: Display -> CString -> Int -> IO Status -- | interface to the X11 library function @XFetchBuffer()@. fetchBuffer :: Display -> Int -> IO String fetchBuffer display buffer = alloca $ \ nbytes_return -> do c_bytes <- throwIfNull "fetchBuffer" $ xFetchBuffer display nbytes_return buffer nbytes <- peek nbytes_return bytes <- peekCStringLen (c_bytes, nbytes) xFree c_bytes return bytes foreign import ccall unsafe "HsXlib.h XFetchBuffer" xFetchBuffer :: Display -> Ptr Int -> Int -> IO CString -- | interface to the X11 library function @XFetchBytes()@. fetchBytes :: Display -> IO String fetchBytes display = alloca $ \ nbytes_return -> do c_bytes <- throwIfNull "fetchBytes" $ xFetchBytes display nbytes_return nbytes <- peek nbytes_return bytes <- peekCStringLen (c_bytes, nbytes) xFree c_bytes return bytes foreign import ccall unsafe "HsXlib.h XFetchBytes" xFetchBytes :: Display -> Ptr Int -> IO CString -- | interface to the X11 library function @XRotateBuffers()@. rotateBuffers :: Display -> Int -> IO () rotateBuffers display rotate = throwIfZero "rotateBuffers" $ xRotateBuffers display rotate foreign import ccall unsafe "HsXlib.h XRotateBuffers" xRotateBuffers :: Display -> Int -> IO Status ---------------------------------------------------------------- -- Window properties ---------------------------------------------------------------- newtype XTextProperty = XTextProperty (Ptr XTextProperty) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif -- | interface to the X11 library function @XSetTextProperty()@. setTextProperty :: Display -> Window -> String -> Atom -> IO () setTextProperty display w value property = withCStringLen value $ \ (c_value, value_len) -> allocaBytes #{size XTextProperty} $ \ text_prop -> do #{poke XTextProperty,value} text_prop c_value #{poke XTextProperty,encoding} text_prop sTRING #{poke XTextProperty,format} text_prop (8::Int) #{poke XTextProperty,nitems} text_prop (fromIntegral value_len::Word32) xSetTextProperty display w text_prop property foreign import ccall unsafe "HsXlib.h XSetTextProperty" xSetTextProperty :: Display -> Window -> Ptr XTextProperty -> Atom -> IO () -- %fun XSetStandardProperties :: Display -> Window -> String -> String -> Pixmap -> [String] -> XSizeHints -> IO () -- %code Status err = XSetStandardProperties(arg1,arg2,arg3,arg4,arg5,arg6,arg6_size,&arg7) -- %fail { Success != err }{ BadStatus(err,XSetStandardProperties) } ---------------------------------------------------------------- -- Canned handling of output parameters ---------------------------------------------------------------- outParameters2 :: (Storable a, Storable b) => (IO r -> IO ()) -> (Ptr a -> Ptr b -> IO r) -> IO (a,b) outParameters2 check fn = alloca $ \ a_return -> alloca $ \ b_return -> do check (fn a_return b_return) a <- peek a_return b <- peek b_return return (a,b) outParameters3 :: (Storable a, Storable b, Storable c) => (IO r -> IO ()) -> (Ptr a -> Ptr b -> Ptr c -> IO r) -> IO (a,b,c) outParameters3 check fn = alloca $ \ a_return -> alloca $ \ b_return -> alloca $ \ c_return -> do check (fn a_return b_return c_return) a <- peek a_return b <- peek b_return c <- peek c_return return (a,b,c) outParameters4 :: (Storable a, Storable b, Storable c, Storable d) => (IO r -> IO ()) -> (Ptr a -> Ptr b -> Ptr c -> Ptr d -> IO r) -> IO (a,b,c,d) outParameters4 check fn = alloca $ \ a_return -> alloca $ \ b_return -> alloca $ \ c_return -> alloca $ \ d_return -> do check (fn a_return b_return c_return d_return) a <- peek a_return b <- peek b_return c <- peek c_return d <- peek d_return return (a,b,c,d) outParameters7 :: (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f, Storable g) => (IO r -> IO ()) -> (Ptr a -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> Ptr f -> Ptr g -> IO r) -> IO (a,b,c,d,e,f,g) outParameters7 check fn = alloca $ \ a_return -> alloca $ \ b_return -> alloca $ \ c_return -> alloca $ \ d_return -> alloca $ \ e_return -> alloca $ \ f_return -> alloca $ \ g_return -> do check (fn a_return b_return c_return d_return e_return f_return g_return) a <- peek a_return b <- peek b_return c <- peek c_return d <- peek d_return e <- peek e_return f <- peek f_return g <- peek g_return return (a,b,c,d,e,f,g) ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Region.hs0000644006511100651110000002142610504340414021700 0ustar rossross{-# OPTIONS_GHC -cpp -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Region -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib Regions. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Region( Region, RectInRegionResult, rectangleOut, rectangleIn, rectanglePart, createRegion, polygonRegion, intersectRegion, subtractRegion, unionRectWithRegion, unionRegion, xorRegion, emptyRegion, equalRegion, pointInRegion, rectInRegion, clipBox, offsetRegion, shrinkRegion, setRegion, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Marshal.Utils #if __GLASGOW_HASKELL__ import Data.Generics #endif ---------------------------------------------------------------- -- Regions ---------------------------------------------------------------- newtype Region = Region (ForeignPtr Region) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif withRegion :: Region -> (Ptr Region -> IO a) -> IO a withRegion (Region r) = withForeignPtr r type RectInRegionResult = Int -- Return values from XRectInRegion() rectangleOut, rectangleIn, rectanglePart :: RectInRegionResult rectangleOut = 0 rectangleIn = 1 rectanglePart = 2 ---------------------------------------------------------------- -- Creating regions ---------------------------------------------------------------- -- regions deallocation is handled by the GC (ForeignPtr magic) -- so we don't provide XDestroyRegion explicitly -- no idea what the int is for -- %fun XDestroyRegion :: Region -> IO Int foreign import ccall unsafe "HsXlib.h &XDestroyRegion" xDestroyRegionPtr :: FunPtr (Ptr Region -> IO ()) makeRegion :: Ptr Region -> IO Region makeRegion rp = do r <- newForeignPtr xDestroyRegionPtr rp return (Region r) -- an empty region -- (often used as "out argument" to binary operators which return regions) -- | interface to the X11 library function @XCreateRegion()@. createRegion :: IO Region createRegion = do rp <- xCreateRegion makeRegion rp foreign import ccall unsafe "HsXlib.h XCreateRegion" xCreateRegion :: IO (Ptr Region) -- | interface to the X11 library function @XPolygonRegion()@. polygonRegion :: [Point] -> FillRule -> IO Region polygonRegion points fill_rule = withArrayLen points $ \ n point_arr -> do rp <- xPolygonRegion point_arr n fill_rule makeRegion rp foreign import ccall unsafe "HsXlib.h XPolygonRegion" xPolygonRegion :: Ptr Point -> Int -> FillRule -> IO (Ptr Region) ---------------------------------------------------------------- -- Combining Regions -- -- The usual shoddy state of Xlib documentation fails to mention -- what the Int is for. -- -- All operations overwrite the region in their third argument -- which is usually a freshly created region. ---------------------------------------------------------------- -- | interface to the X11 library function @XIntersectRegion()@. intersectRegion :: Region -> Region -> Region -> IO Int intersectRegion src1 src2 dest = withRegion src1 $ \ src1_ptr -> withRegion src2 $ \ src2_ptr -> withRegion dest $ \ dest_ptr -> xIntersectRegion src1_ptr src2_ptr dest_ptr foreign import ccall unsafe "HsXlib.h XIntersectRegion" xIntersectRegion :: Ptr Region -> Ptr Region -> Ptr Region -> IO Int -- | interface to the X11 library function @XSubtractRegion()@. subtractRegion :: Region -> Region -> Region -> IO Int subtractRegion src1 src2 dest = withRegion src1 $ \ src1_ptr -> withRegion src2 $ \ src2_ptr -> withRegion dest $ \ dest_ptr -> xSubtractRegion src1_ptr src2_ptr dest_ptr foreign import ccall unsafe "HsXlib.h XSubtractRegion" xSubtractRegion :: Ptr Region -> Ptr Region -> Ptr Region -> IO Int -- | interface to the X11 library function @XUnionRectWithRegion()@. unionRectWithRegion :: Rectangle -> Region -> Region -> IO Int unionRectWithRegion rect src dest = with rect $ \ rect_ptr -> withRegion src $ \ src_ptr -> withRegion dest $ \ dest_ptr -> xUnionRectWithRegion rect_ptr src_ptr dest_ptr foreign import ccall unsafe "HsXlib.h XUnionRectWithRegion" xUnionRectWithRegion :: Ptr Rectangle -> Ptr Region -> Ptr Region -> IO Int -- | interface to the X11 library function @XUnionRegion()@. unionRegion :: Region -> Region -> Region -> IO Int unionRegion src1 src2 dest = withRegion src1 $ \ src1_ptr -> withRegion src2 $ \ src2_ptr -> withRegion dest $ \ dest_ptr -> xUnionRegion src1_ptr src2_ptr dest_ptr foreign import ccall unsafe "HsXlib.h XUnionRegion" xUnionRegion :: Ptr Region -> Ptr Region -> Ptr Region -> IO Int -- | interface to the X11 library function @XXorRegion()@. xorRegion :: Region -> Region -> Region -> IO Int xorRegion src1 src2 dest = withRegion src1 $ \ src1_ptr -> withRegion src2 $ \ src2_ptr -> withRegion dest $ \ dest_ptr -> xXorRegion src1_ptr src2_ptr dest_ptr foreign import ccall unsafe "HsXlib.h XXorRegion" xXorRegion :: Ptr Region -> Ptr Region -> Ptr Region -> IO Int ---------------------------------------------------------------- -- Examining regions (tests, bounding boxes, etc) ---------------------------------------------------------------- -- | interface to the X11 library function @XEmptyRegion()@. emptyRegion :: Region -> IO Bool emptyRegion r = withRegion r xEmptyRegion foreign import ccall unsafe "HsXlib.h XEmptyRegion" xEmptyRegion :: Ptr Region -> IO Bool -- | interface to the X11 library function @XEqualRegion()@. equalRegion :: Region -> Region -> IO Bool equalRegion r1 r2 = withRegion r1 $ \ rp1 -> withRegion r2 $ \ rp2 -> xEqualRegion rp1 rp2 foreign import ccall unsafe "HsXlib.h XEqualRegion" xEqualRegion :: Ptr Region -> Ptr Region -> IO Bool -- | interface to the X11 library function @XPointInRegion()@. pointInRegion :: Region -> Point -> IO Bool pointInRegion r (Point x y) = withRegion r $ \ rp -> xPointInRegion rp x y foreign import ccall unsafe "HsXlib.h XPointInRegion" xPointInRegion :: Ptr Region -> Position -> Position -> IO Bool -- | interface to the X11 library function @XRectInRegion()@. rectInRegion :: Region -> Rectangle -> IO RectInRegionResult rectInRegion r (Rectangle x y w h) = withRegion r $ \ rp -> xRectInRegion rp x y w h foreign import ccall unsafe "HsXlib.h XRectInRegion" xRectInRegion :: Ptr Region -> Position -> Position -> Dimension -> Dimension -> IO RectInRegionResult -- I have no idea what the int is for -- | interface to the X11 library function @XClipBox()@. clipBox :: Region -> IO (Rectangle,Int) clipBox r = withRegion r $ \ rp -> alloca $ \ rect_ptr -> do res <- xClipBox rp rect_ptr rect <- peek rect_ptr return (rect, res) foreign import ccall unsafe "HsXlib.h XClipBox" xClipBox :: Ptr Region -> Ptr Rectangle -> IO Int ---------------------------------------------------------------- -- Modifying regions -- (If you use any of these, you can't make regions look like -- first class data structures.) ---------------------------------------------------------------- -- translate region -- | interface to the X11 library function @XOffsetRegion()@. offsetRegion :: Region -> Point -> IO Int offsetRegion r (Point x y) = withRegion r $ \ rp -> xOffsetRegion rp x y foreign import ccall unsafe "HsXlib.h XOffsetRegion" xOffsetRegion :: Ptr Region -> Position -> Position -> IO Int -- increase size of region by +ve or -ve number of pixels -- while preserving the centre of the region (ie half the pixels -- come off the left, and half off the right) -- | interface to the X11 library function @XShrinkRegion()@. shrinkRegion :: Region -> Point -> IO Int shrinkRegion r (Point x y) = withRegion r $ \ rp -> xShrinkRegion rp x y foreign import ccall unsafe "HsXlib.h XShrinkRegion" xShrinkRegion :: Ptr Region -> Position -> Position -> IO Int ---------------------------------------------------------------- -- Graphics Context ---------------------------------------------------------------- -- set clip mask of GC -- | interface to the X11 library function @XSetRegion()@. setRegion :: Display -> GC -> Region -> IO Int setRegion disp gc r = withRegion r $ \ rp -> xSetRegion disp gc rp foreign import ccall unsafe "HsXlib.h XSetRegion" xSetRegion :: Display -> GC -> Ptr Region -> IO Int ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Screen.hs0000644006511100651110000001147410504340414021676 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Screen -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib Screens. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Screen( blackPixelOfScreen, whitePixelOfScreen, cellsOfScreen, defaultColormapOfScreen, defaultDepthOfScreen, defaultGCOfScreen, defaultVisualOfScreen, doesBackingStore, doesSaveUnders, displayOfScreen, eventMaskOfScreen, minCmapsOfScreen, maxCmapsOfScreen, rootWindowOfScreen, widthOfScreen, widthMMOfScreen, heightOfScreen, heightMMOfScreen, planesOfScreen, screenNumberOfScreen, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types ---------------------------------------------------------------- -- Screen ---------------------------------------------------------------- -- Many flags assumed to be PURE. -- | interface to the X11 library function @XBlackPixelOfScreen()@. foreign import ccall unsafe "HsXlib.h XBlackPixelOfScreen" blackPixelOfScreen :: Screen -> Pixel -- | interface to the X11 library function @XWhitePixelOfScreen()@. foreign import ccall unsafe "HsXlib.h XWhitePixelOfScreen" whitePixelOfScreen :: Screen -> Pixel -- | interface to the X11 library function @XCellsOfScreen()@. foreign import ccall unsafe "HsXlib.h XCellsOfScreen" cellsOfScreen :: Screen -> Int -- | interface to the X11 library function @XDefaultColormapOfScreen()@. foreign import ccall unsafe "HsXlib.h XDefaultColormapOfScreen" defaultColormapOfScreen :: Screen -> Colormap -- | interface to the X11 library function @XDefaultDepthOfScreen()@. foreign import ccall unsafe "HsXlib.h XDefaultDepthOfScreen" defaultDepthOfScreen :: Screen -> Int -- | interface to the X11 library function @XDefaultGCOfScreen()@. foreign import ccall unsafe "HsXlib.h XDefaultGCOfScreen" defaultGCOfScreen :: Screen -> GC -- | interface to the X11 library function @XDefaultVisualOfScreen()@. foreign import ccall unsafe "HsXlib.h XDefaultVisualOfScreen" defaultVisualOfScreen :: Screen -> Visual -- | interface to the X11 library function @XDoesBackingStore()@. foreign import ccall unsafe "HsXlib.h XDoesBackingStore" doesBackingStore :: Screen -> Bool -- | interface to the X11 library function @XDoesSaveUnders()@. foreign import ccall unsafe "HsXlib.h XDoesSaveUnders" doesSaveUnders :: Screen -> Bool -- | interface to the X11 library function @XDisplayOfScreen()@. foreign import ccall unsafe "HsXlib.h XDisplayOfScreen" displayOfScreen :: Screen -> Display -- | interface to the X11 library function @XEventMaskOfScreen()@. -- Event mask at connection setup time - not current event mask! foreign import ccall unsafe "HsXlib.h XEventMaskOfScreen" eventMaskOfScreen :: Screen -> EventMask -- | interface to the X11 library function @XMinCmapsOfScreen()@. foreign import ccall unsafe "HsXlib.h XMinCmapsOfScreen" minCmapsOfScreen :: Screen -> Int -- | interface to the X11 library function @XMaxCmapsOfScreen()@. foreign import ccall unsafe "HsXlib.h XMaxCmapsOfScreen" maxCmapsOfScreen :: Screen -> Int -- | interface to the X11 library function @XRootWindowOfScreen()@. foreign import ccall unsafe "HsXlib.h XRootWindowOfScreen" rootWindowOfScreen :: Screen -> Window -- | interface to the X11 library function @XWidthOfScreen()@. foreign import ccall unsafe "HsXlib.h XWidthOfScreen" widthOfScreen :: Screen -> Dimension -- | interface to the X11 library function @XWidthMMOfScreen()@. foreign import ccall unsafe "HsXlib.h XWidthMMOfScreen" widthMMOfScreen :: Screen -> Dimension -- | interface to the X11 library function @XHeightOfScreen()@. foreign import ccall unsafe "HsXlib.h XHeightOfScreen" heightOfScreen :: Screen -> Dimension -- | interface to the X11 library function @XHeightMMOfScreen()@. foreign import ccall unsafe "HsXlib.h XHeightMMOfScreen" heightMMOfScreen :: Screen -> Dimension -- | interface to the X11 library function @XPlanesOfScreen()@. foreign import ccall unsafe "HsXlib.h XPlanesOfScreen" planesOfScreen :: Screen -> Int -- | interface to the X11 library function @XScreenNumberOfScreen()@. foreign import ccall unsafe "HsXlib.h XScreenNumberOfScreen" screenNumberOfScreen :: Screen -> ScreenNumber ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Types.hsc0000644006511100651110000002071210504340414021721 0ustar rossross{-# OPTIONS_GHC -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Types -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of type declarations for interfacing with Xlib. -- ----------------------------------------------------------------------------- -- #hide module Graphics.X11.Xlib.Types( Display(..), Screen, Visual, GC, GCValues, SetWindowAttributes, Point(..), Rectangle(..), Arc(..), Segment(..), Color(..), Pixel, Position, Dimension, Angle, ScreenNumber, Buffer ) where import Control.Monad( zipWithM_ ) import Data.Int import Data.Word import Foreign.C.Types import Foreign.Marshal.Alloc( allocaBytes ) import Foreign.Ptr import Foreign.Storable( Storable(..) ) #if __GLASGOW_HASKELL__ import Data.Generics #endif #include "HsXlib.h" ---------------------------------------------------------------- -- Types ---------------------------------------------------------------- -- | pointer to an X11 @Display@ structure newtype Display = Display (Ptr Display) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif -- | pointer to an X11 @Screen@ structure newtype Screen = Screen (Ptr Screen) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif -- | pointer to an X11 @Visual@ structure newtype Visual = Visual (Ptr Visual) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif -- | pointer to an X11 @GC@ structure newtype GC = GC (Ptr GC) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif -- | pointer to an X11 @XGCValues@ structure newtype GCValues = GCValues (Ptr GCValues) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif -- | pointer to an X11 @XSetWindowAttributes@ structure newtype SetWindowAttributes = SetWindowAttributes (Ptr SetWindowAttributes) #if __GLASGOW_HASKELL__ deriving (Eq, Ord, Show, Typeable, Data) #else deriving (Eq, Ord, Show) #endif type Pixel = #{type unsigned long} type Position = #{type int} type Dimension = #{type unsigned int} type Angle = Int type ScreenNumber = Word32 type Buffer = Int ---------------------------------------------------------------- -- Short forms used in structs ---------------------------------------------------------------- type ShortPosition = CShort type ShortDimension = CUShort type ShortAngle = CShort peekPositionField :: Ptr a -> Int -> IO Position peekPositionField ptr off = do v <- peekByteOff ptr off return (fromIntegral (v::ShortPosition)) peekDimensionField :: Ptr a -> Int -> IO Dimension peekDimensionField ptr off = do v <- peekByteOff ptr off return (fromIntegral (v::ShortDimension)) peekAngleField :: Ptr a -> Int -> IO Angle peekAngleField ptr off = do v <- peekByteOff ptr off return (fromIntegral (v::ShortAngle)) pokePositionField :: Ptr a -> Int -> Position -> IO () pokePositionField ptr off v = pokeByteOff ptr off (fromIntegral v::ShortPosition) pokeDimensionField :: Ptr a -> Int -> Dimension -> IO () pokeDimensionField ptr off v = pokeByteOff ptr off (fromIntegral v::ShortDimension) pokeAngleField :: Ptr a -> Int -> Angle -> IO () pokeAngleField ptr off v = pokeByteOff ptr off (fromIntegral v::ShortAngle) ---------------------------------------------------------------- -- Point ---------------------------------------------------------------- -- | counterpart of an X11 @XPoint@ structure data Point = Point { pt_x :: Position, pt_y :: Position } #if __GLASGOW_HASKELL__ deriving (Eq, Show, Typeable, Data) #else deriving (Eq, Show) #endif instance Storable Point where sizeOf _ = #{size XPoint} alignment _ = alignment (undefined::CInt) peek p = do x <- peekPositionField p #{offset XPoint,x} y <- peekPositionField p #{offset XPoint,y} return (Point x y) poke p (Point x y) = do pokePositionField p #{offset XPoint,x} x pokePositionField p #{offset XPoint,y} y ---------------------------------------------------------------- -- Rectangle ---------------------------------------------------------------- -- | counterpart of an X11 @XRectangle@ structure data Rectangle = Rectangle { rect_x :: Position, rect_y :: Position, rect_width :: Dimension, rect_height :: Dimension } #if __GLASGOW_HASKELL__ deriving (Eq, Show, Typeable, Data) #else deriving (Eq, Show) #endif instance Storable Rectangle where sizeOf _ = #{size XRectangle} alignment _ = alignment (undefined::CInt) peek p = do x <- peekPositionField p #{offset XRectangle,x} y <- peekPositionField p #{offset XRectangle,y} width <- peekDimensionField p #{offset XRectangle,width} height <- peekDimensionField p #{offset XRectangle,height} return (Rectangle x y width height) poke p (Rectangle x y width height) = do pokePositionField p #{offset XRectangle,x} x pokePositionField p #{offset XRectangle,y} y pokeDimensionField p #{offset XRectangle,width} width pokeDimensionField p #{offset XRectangle,height} height ---------------------------------------------------------------- -- Arc ---------------------------------------------------------------- -- | counterpart of an X11 @XArc@ structure data Arc = Arc { arc_x :: Position, arc_y :: Position, arc_width :: Dimension, arc_height :: Dimension, arc_angle1 :: Angle, arc_angle2 :: Angle } #if __GLASGOW_HASKELL__ deriving (Eq, Show, Typeable, Data) #else deriving (Eq, Show) #endif instance Storable Arc where sizeOf _ = #{size XArc} alignment _ = alignment (undefined::CInt) peek p = do x <- peekPositionField p #{offset XArc,x} y <- peekPositionField p #{offset XArc,y} width <- peekDimensionField p #{offset XArc,width} height <- peekDimensionField p #{offset XArc,height} angle1 <- peekAngleField p #{offset XArc,angle1} angle2 <- peekAngleField p #{offset XArc,angle2} return (Arc x y width height angle1 angle2) poke p (Arc x y width height angle1 angle2) = do pokePositionField p #{offset XArc,x} x pokePositionField p #{offset XArc,y} y pokeDimensionField p #{offset XArc,width} width pokeDimensionField p #{offset XArc,height} height pokeAngleField p #{offset XArc,angle1} angle1 pokeAngleField p #{offset XArc,angle2} angle2 ---------------------------------------------------------------- -- Segment ---------------------------------------------------------------- -- | counterpart of an X11 @XSegment@ structure data Segment = Segment { seg_x1 :: Position, seg_y1 :: Position, seg_x2 :: Position, seg_y2 :: Position } #if __GLASGOW_HASKELL__ deriving (Eq, Show, Typeable, Data) #else deriving (Eq, Show) #endif instance Storable Segment where sizeOf _ = #{size XSegment} alignment _ = alignment (undefined::CInt) peek p = do x1 <- peekPositionField p #{offset XSegment,x1} y1 <- peekPositionField p #{offset XSegment,y1} x2 <- peekPositionField p #{offset XSegment,x2} y2 <- peekPositionField p #{offset XSegment,y2} return (Segment x1 y1 x2 y2) poke p (Segment x1 y1 x2 y2) = do pokePositionField p #{offset XSegment,x1} x1 pokePositionField p #{offset XSegment,y1} y1 pokePositionField p #{offset XSegment,x2} x2 pokePositionField p #{offset XSegment,y2} y2 ---------------------------------------------------------------- -- Color ---------------------------------------------------------------- -- | counterpart of an X11 @XColor@ structure data Color = Color { color_pixel :: Pixel, color_red :: Word16, color_green :: Word16, color_blue :: Word16, color_flags :: Word8 } #if __GLASGOW_HASKELL__ deriving (Eq, Show, Typeable, Data) #else deriving (Eq, Show) #endif instance Storable Color where sizeOf _ = #{size XColor} alignment _ = alignment (undefined::CInt) peek p = do pixel <- #{peek XColor,pixel} p red <- #{peek XColor,red} p green <- #{peek XColor,green} p blue <- #{peek XColor,blue} p flags <- #{peek XColor,flags} p return (Color pixel red green blue flags) poke p (Color pixel red green blue flags) = do #{poke XColor,pixel} p pixel #{poke XColor,red} p red #{poke XColor,green} p green #{poke XColor,blue} p blue #{poke XColor,flags} p flags ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib/Window.hs0000644006511100651110000002640310504340414021724 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib.Window -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib Windows. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib.Window( storeName, createSimpleWindow, createWindow, translateCoordinates, moveResizeWindow, resizeWindow, moveWindow, reparentWindow, mapSubwindows, unmapSubwindows, mapWindow, lowerWindow, raiseWindow, circulateSubwindowsDown, circulateSubwindowsUp, circulateSubwindows, iconifyWindow, withdrawWindow, destroyWindow, destroySubwindows, setWindowBorder, setWindowBorderPixmap, setWindowBorderWidth, setWindowBackground, setWindowBackgroundPixmap, setWindowColormap, addToSaveSet, removeFromSaveSet, changeSaveSet, clearWindow, clearArea, restackWindows, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types import Foreign import Foreign.C ---------------------------------------------------------------- -- Windows ---------------------------------------------------------------- -- | interface to the X11 library function @XStoreName()@. storeName :: Display -> Window -> String -> IO () storeName display window name = withCString name $ \ c_name -> xStoreName display window c_name foreign import ccall unsafe "HsXlib.h XStoreName" xStoreName :: Display -> Window -> CString -> IO () -- | interface to the X11 library function @XCreateSimpleWindow()@. foreign import ccall unsafe "HsXlib.h XCreateSimpleWindow" createSimpleWindow :: Display -> Window -> Position -> Position -> Dimension -> Dimension -> Int -> Pixel -> Pixel -> IO Window -- | interface to the X11 library function @XCreateWindow()@. foreign import ccall unsafe "HsXlib.h XCreateWindow" createWindow :: Display -> Window -> Position -> Position -> Dimension -> Dimension -> Int -> Int -> WindowClass -> Visual -> AttributeMask -> Ptr SetWindowAttributes -> IO Window ---------------------------------------------------------------- --ToDo: find an effective way to use Maybes -- | interface to the X11 library function @XTranslateCoordinates()@. translateCoordinates :: Display -> Window -> Window -> Position -> Position -> IO (Bool,Position,Position,Window) translateCoordinates display src_w dest_w src_x src_y = alloca $ \ dest_x_return -> alloca $ \ dest_y_return -> alloca $ \ child_return -> do res <- xTranslateCoordinates display src_w dest_w src_x src_y dest_x_return dest_y_return child_return dest_x <- peek dest_x_return dest_y <- peek dest_y_return child <- peek child_return return (res, dest_x, dest_y, child) foreign import ccall unsafe "HsXlib.h XTranslateCoordinates" xTranslateCoordinates :: Display -> Window -> Window -> Position -> Position -> Ptr Position -> Ptr Position -> Ptr Window -> IO Bool -- | interface to the X11 library function @XMoveResizeWindow()@. foreign import ccall unsafe "HsXlib.h XMoveResizeWindow" moveResizeWindow :: Display -> Window -> Position -> Position -> Dimension -> Dimension -> IO () -- | interface to the X11 library function @XResizeWindow()@. foreign import ccall unsafe "HsXlib.h XResizeWindow" resizeWindow :: Display -> Window -> Dimension -> Dimension -> IO () -- | interface to the X11 library function @XMoveWindow()@. foreign import ccall unsafe "HsXlib.h XMoveWindow" moveWindow :: Display -> Window -> Position -> Position -> IO () -- | interface to the X11 library function @XReparentWindow()@. foreign import ccall unsafe "HsXlib.h XReparentWindow" reparentWindow :: Display -> Window -> Window -> Position -> Position -> IO () -- | interface to the X11 library function @XMapSubwindows()@. foreign import ccall unsafe "HsXlib.h XMapSubwindows" mapSubwindows :: Display -> Window -> IO () -- | interface to the X11 library function @XUnmapSubwindows()@. foreign import ccall unsafe "HsXlib.h XUnmapSubwindows" unmapSubwindows :: Display -> Window -> IO () -- | interface to the X11 library function @XMapWindow()@. foreign import ccall unsafe "HsXlib.h XMapWindow" mapWindow :: Display -> Window -> IO () -- Disnae exist: %fun XUnmapWindows :: Display -> Window -> IO () -- Disnae exist: %fun XMapRaisedWindow :: Display -> Window -> IO () -- | interface to the X11 library function @XLowerWindow()@. foreign import ccall unsafe "HsXlib.h XLowerWindow" lowerWindow :: Display -> Window -> IO () -- | interface to the X11 library function @XRaiseWindow()@. foreign import ccall unsafe "HsXlib.h XRaiseWindow" raiseWindow :: Display -> Window -> IO () -- | interface to the X11 library function @XCirculateSubwindowsDown()@. foreign import ccall unsafe "HsXlib.h XCirculateSubwindowsDown" circulateSubwindowsDown :: Display -> Window -> IO () -- | interface to the X11 library function @XCirculateSubwindowsUp()@. foreign import ccall unsafe "HsXlib.h XCirculateSubwindowsUp" circulateSubwindowsUp :: Display -> Window -> IO () -- | interface to the X11 library function @XCirculateSubwindows()@. foreign import ccall unsafe "HsXlib.h XCirculateSubwindows" circulateSubwindows :: Display -> Window -> CirculationDirection -> IO () -- | interface to the X11 library function @XIconifyWindow()@. iconifyWindow :: Display -> Window -> ScreenNumber -> IO () iconifyWindow display window screenno = throwIfZero "iconifyWindow" (xIconifyWindow display window screenno) foreign import ccall unsafe "HsXlib.h XIconifyWindow" xIconifyWindow :: Display -> Window -> ScreenNumber -> IO Status -- | interface to the X11 library function @XWithdrawWindow()@. withdrawWindow :: Display -> Window -> ScreenNumber -> IO () withdrawWindow display window screenno = throwIfZero "withdrawWindow" (xWithdrawWindow display window screenno) foreign import ccall unsafe "HsXlib.h XWithdrawWindow" xWithdrawWindow :: Display -> Window -> ScreenNumber -> IO Status -- | interface to the X11 library function @XDestroyWindow()@. foreign import ccall unsafe "HsXlib.h XDestroyWindow" destroyWindow :: Display -> Window -> IO () -- | interface to the X11 library function @XDestroySubwindows()@. foreign import ccall unsafe "HsXlib.h XDestroySubwindows" destroySubwindows :: Display -> Window -> IO () -- | interface to the X11 library function @XSetWindowBorder()@. foreign import ccall unsafe "HsXlib.h XSetWindowBorder" setWindowBorder :: Display -> Window -> Pixel -> IO () -- | interface to the X11 library function @XSetWindowBorderPixmap()@. foreign import ccall unsafe "HsXlib.h XSetWindowBorderPixmap" setWindowBorderPixmap :: Display -> Window -> Pixmap -> IO () -- | interface to the X11 library function @XSetWindowBorderWidth()@. foreign import ccall unsafe "HsXlib.h XSetWindowBorderWidth" setWindowBorderWidth :: Display -> Window -> Dimension -> IO () -- | interface to the X11 library function @XSetWindowBackground()@. foreign import ccall unsafe "HsXlib.h XSetWindowBackground" setWindowBackground :: Display -> Window -> Pixel -> IO () -- | interface to the X11 library function @XSetWindowBackgroundPixmap()@. foreign import ccall unsafe "HsXlib.h XSetWindowBackgroundPixmap" setWindowBackgroundPixmap :: Display -> Window -> Pixmap -> IO () -- | interface to the X11 library function @XSetWindowColormap()@. foreign import ccall unsafe "HsXlib.h XSetWindowColormap" setWindowColormap :: Display -> Window -> Colormap -> IO () -- | interface to the X11 library function @XAddToSaveSet()@. foreign import ccall unsafe "HsXlib.h XAddToSaveSet" addToSaveSet :: Display -> Window -> IO () -- | interface to the X11 library function @XRemoveFromSaveSet()@. foreign import ccall unsafe "HsXlib.h XRemoveFromSaveSet" removeFromSaveSet :: Display -> Window -> IO () -- | interface to the X11 library function @XChangeSaveSet()@. foreign import ccall unsafe "HsXlib.h XChangeSaveSet" changeSaveSet :: Display -> Window -> ChangeSaveSetMode -> IO () -- | interface to the X11 library function @XClearWindow()@. foreign import ccall unsafe "HsXlib.h XClearWindow" clearWindow :: Display -> Window -> IO () -- | interface to the X11 library function @XClearArea()@. foreign import ccall unsafe "HsXlib.h XClearArea" clearArea :: Display -> Window -> Position -> Position -> Dimension -> Dimension -> Bool -> IO () -- This is almost good enough - but doesn't call XFree -- -- %errfun BadStatus XQueryTree :: Display -> Window -> IO (Window, Window, ListWindow) using err = XQueryTree(arg1,arg2,&res1,&res2,&res3,&res3_size) -- %prim XQueryTree :: Display -> Window -> IO (Window, Window, ListWindow) -- Window root_w, parent; -- Int children_size; -- Window *children; -- Status r = XQueryTree(arg1,arg2,&root_w, &parent, &children, &children_size); -- if (Success != r) { %failWith(BadStatus,r); } -- %update(root_w,parent,children); -- XFree(children); -- return; -- | interface to the X11 library function @XRestackWindows()@. restackWindows :: Display -> [Window] -> IO () restackWindows display windows = withArray windows $ \ window_array -> xRestackWindows display window_array (length windows) foreign import ccall unsafe "HsXlib.h XRestackWindows" xRestackWindows :: Display -> Ptr Window -> Int -> IO () -- ToDo: I want to be able to write this -- -- %fun XListInstalledColormaps :: Display -> Window -> IO ListColormap using res1 = XListInstalledColormaps(arg1,arg2,&res1_size) -- -- But I have to write this instead - need to add a notion of cleanup code! -- %prim XListInstalledColormaps :: Display -> Window -> IO ListColormap -- Int r_size; -- Colormap* r = XListInstalledColormaps(arg1,arg2,&r_size); -- %update(r); -- XFree(r); -- return; -- -- -- Again, this is almost good enough -- -- %errfun BadStatus XGetCommand :: Display -> Window -> IO ListString using err = XGetCommand(arg1,arg2,&res1,&res1_size) -- -- but not quite -- -- %prim XGetCommand :: Display -> Window -> IO ListString -- --Int argv_size; -- --String *argv; -- --Status r = XGetCommand(arg1,arg2,&argv,&argv_size); -- --if (Success != r) { %failWith(BadStatus, r); } -- -- %update(argv); -- --XFreeStringList(argv); -- --return; -- -- -- %fun XSetCommand :: Display -> Window -> ListString -> IO () using XSetCommand(arg1,arg2,arg3,res3_size) -- -- %errfun BadStatus XGetTransientForHint :: Display -> Window -> IO Window using err = XGetTransientForHint(arg1,arg2,&res1) -- -- %fun XSetTransientForHint :: Display -> Window -> Window -> IO () -- -- -- XRotateWindowProperties omitted -- -- XGetWindowProperty omitted -- -- -- XGetWindowAttributes omitted -- -- XChangeWindowAttributes omitted ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11/Types.hsc0000644006511100651110000007647710504340414021046 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Types -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of type declarations for interfacing with X11. -- ----------------------------------------------------------------------------- module Graphics.X11.Types ( XID, Mask, Atom, VisualID, Time, Window, Drawable, Font, Pixmap, Cursor, Colormap, GContext, KeyCode, -- * Enumeration types -- | These types were introduced to make function types clearer. -- Note that the types are synonyms for 'Int', so no extra -- typesafety was obtained. -- ** Key symbols KeySym, xK_VoidSymbol, xK_BackSpace, xK_Tab, xK_Linefeed, xK_Clear, xK_Return, xK_Pause, xK_Scroll_Lock, xK_Sys_Req, xK_Escape, xK_Delete, xK_Multi_key, xK_Home, xK_Left, xK_Up, xK_Right, xK_Down, xK_Prior, xK_Page_Up, xK_Next, xK_Page_Down, xK_End, xK_Begin, xK_Select, xK_Print, xK_Execute, xK_Insert, xK_Undo, xK_Redo, xK_Menu, xK_Find, xK_Cancel, xK_Help, xK_Break, xK_Mode_switch, xK_script_switch, xK_Num_Lock, xK_KP_Space, xK_KP_Tab, xK_KP_Enter, xK_KP_F1, xK_KP_F2, xK_KP_F3, xK_KP_F4, xK_KP_Home, xK_KP_Left, xK_KP_Up, xK_KP_Right, xK_KP_Down, xK_KP_Prior, xK_KP_Page_Up, xK_KP_Next, xK_KP_Page_Down, xK_KP_End, xK_KP_Begin, xK_KP_Insert, xK_KP_Delete, xK_KP_Equal, xK_KP_Multiply, xK_KP_Add, xK_KP_Separator, xK_KP_Subtract, xK_KP_Decimal, xK_KP_Divide, xK_KP_0, xK_KP_1, xK_KP_2, xK_KP_3, xK_KP_4, xK_KP_5, xK_KP_6, xK_KP_7, xK_KP_8, xK_KP_9, xK_F1, xK_F2, xK_F3, xK_F4, xK_F5, xK_F6, xK_F7, xK_F8, xK_F9, xK_F10, xK_F11, xK_L1, xK_F12, xK_L2, xK_F13, xK_L3, xK_F14, xK_L4, xK_F15, xK_L5, xK_F16, xK_L6, xK_F17, xK_L7, xK_F18, xK_L8, xK_F19, xK_L9, xK_F20, xK_L10, xK_F21, xK_R1, xK_F22, xK_R2, xK_F23, xK_R3, xK_F24, xK_R4, xK_F25, xK_R5, xK_F26, xK_R6, xK_F27, xK_R7, xK_F28, xK_R8, xK_F29, xK_R9, xK_F30, xK_R10, xK_F31, xK_R11, xK_F32, xK_R12, xK_F33, xK_R13, xK_F34, xK_R14, xK_F35, xK_R15, xK_Shift_L, xK_Shift_R, xK_Control_L, xK_Control_R, xK_Caps_Lock, xK_Shift_Lock, xK_Meta_L, xK_Meta_R, xK_Alt_L, xK_Alt_R, xK_Super_L, xK_Super_R, xK_Hyper_L, xK_Hyper_R, xK_space, xK_exclam, xK_quotedbl, xK_numbersign, xK_dollar, xK_percent, xK_ampersand, xK_apostrophe, xK_quoteright, xK_parenleft, xK_parenright, xK_asterisk, xK_plus, xK_comma, xK_minus, xK_period, xK_slash, xK_0, xK_1, xK_2, xK_3, xK_4, xK_5, xK_6, xK_7, xK_8, xK_9, xK_colon, xK_semicolon, xK_less, xK_equal, xK_greater, xK_question, xK_at, xK_A, xK_B, xK_C, xK_D, xK_E, xK_F, xK_G, xK_H, xK_I, xK_J, xK_K, xK_L, xK_M, xK_N, xK_O, xK_P, xK_Q, xK_R, xK_S, xK_T, xK_U, xK_V, xK_W, xK_X, xK_Y, xK_Z, xK_bracketleft, xK_backslash, xK_bracketright, xK_asciicircum, xK_underscore, xK_grave, xK_quoteleft, xK_a, xK_b, xK_c, xK_d, xK_e, xK_f, xK_g, xK_h, xK_i, xK_j, xK_k, xK_l, xK_m, xK_n, xK_o, xK_p, xK_q, xK_r, xK_s, xK_t, xK_u, xK_v, xK_w, xK_x, xK_y, xK_z, xK_braceleft, xK_bar, xK_braceright, xK_asciitilde, xK_nobreakspace, xK_exclamdown, xK_cent, xK_sterling, xK_currency, xK_yen, xK_brokenbar, xK_section, xK_diaeresis, xK_copyright, xK_ordfeminine, xK_guillemotleft, xK_notsign, xK_hyphen, xK_registered, xK_macron, xK_degree, xK_plusminus, xK_twosuperior, xK_threesuperior, xK_acute, xK_mu, xK_paragraph, xK_periodcentered, xK_cedilla, xK_onesuperior, xK_masculine, xK_guillemotright, xK_onequarter, xK_onehalf, xK_threequarters, xK_questiondown, xK_Agrave, xK_Aacute, xK_Acircumflex, xK_Atilde, xK_Adiaeresis, xK_Aring, xK_AE, xK_Ccedilla, xK_Egrave, xK_Eacute, xK_Ecircumflex, xK_Ediaeresis, xK_Igrave, xK_Iacute, xK_Icircumflex, xK_Idiaeresis, xK_ETH, xK_Eth, xK_Ntilde, xK_Ograve, xK_Oacute, xK_Ocircumflex, xK_Otilde, xK_Odiaeresis, xK_multiply, xK_Ooblique, xK_Ugrave, xK_Uacute, xK_Ucircumflex, xK_Udiaeresis, xK_Yacute, xK_THORN, xK_Thorn, xK_ssharp, xK_agrave, xK_aacute, xK_acircumflex, xK_atilde, xK_adiaeresis, xK_aring, xK_ae, xK_ccedilla, xK_egrave, xK_eacute, xK_ecircumflex, xK_ediaeresis, xK_igrave, xK_iacute, xK_icircumflex, xK_idiaeresis, xK_eth, xK_ntilde, xK_ograve, xK_oacute, xK_ocircumflex, xK_otilde, xK_odiaeresis, xK_division, xK_oslash, xK_ugrave, xK_uacute, xK_ucircumflex, xK_udiaeresis, xK_yacute, xK_thorn, xK_ydiaeresis, -- ** Event masks EventMask, noEventMask, keyPressMask, keyReleaseMask, buttonPressMask, buttonReleaseMask, enterWindowMask, leaveWindowMask, pointerMotionMask, pointerMotionHintMask, button1MotionMask, button2MotionMask, button3MotionMask, button4MotionMask, button5MotionMask, buttonMotionMask, keymapStateMask, exposureMask, visibilityChangeMask, structureNotifyMask, resizeRedirectMask, substructureNotifyMask, substructureRedirectMask, focusChangeMask, propertyChangeMask, colormapChangeMask, ownerGrabButtonMask, -- ** Event types EventType, keyPress, keyRelease, buttonPress, buttonRelease, motionNotify, enterNotify, leaveNotify, focusIn, focusOut, keymapNotify, expose, graphicsExpose, noExpose, visibilityNotify, createNotify, destroyNotify, unmapNotify, mapNotify, mapRequest, reparentNotify, configureNotify, configureRequest, gravityNotify, resizeRequest, circulateNotify, circulateRequest, propertyNotify, selectionClear, selectionRequest, selectionNotify, colormapNotify, clientMessage, mappingNotify, lASTEvent, -- ** Modifiers Modifier, shiftMapIndex, lockMapIndex, controlMapIndex, mod1MapIndex, mod2MapIndex, mod3MapIndex, mod4MapIndex, mod5MapIndex, anyModifier, -- ** Key masks KeyMask, shiftMask, lockMask, controlMask, mod1Mask, mod2Mask, mod3Mask, mod4Mask, mod5Mask, -- ** Button masks ButtonMask, button1Mask, button2Mask, button3Mask, button4Mask, button5Mask, -- ** Buttons Button, button1, button2, button3, button4, button5, -- ** Notify modes NotifyMode, notifyNormal, notifyGrab, notifyUngrab, notifyWhileGrabbed, notifyHint, -- ** Notify details NotifyDetail, notifyAncestor, notifyVirtual, notifyInferior, notifyNonlinear, notifyNonlinearVirtual, notifyPointer, notifyPointerRoot, notifyDetailNone, -- ** Visibility Visibility, visibilityUnobscured, visibilityPartiallyObscured, visibilityFullyObscured, -- ** Place of window Place, placeOnTop, placeOnBottom, -- ** Protocols Protocol, familyInternet, familyDECnet, familyChaos, -- ** Property notification PropertyNotification, propertyNewValue, propertyDelete, -- ** Colormap notification ColormapNotification, colormapUninstalled, colormapInstalled, -- ** Grab modes GrabMode, grabModeSync, grabModeAsync, -- ** Grab status GrabStatus, grabSuccess, alreadyGrabbed, grabInvalidTime, grabNotViewable, grabFrozen, -- ** Allow events AllowEvents, asyncPointer, syncPointer, replayPointer, asyncKeyboard, syncKeyboard, replayKeyboard, asyncBoth, syncBoth, -- ** Focus modes FocusMode, revertToNone, revertToPointerRoot, revertToParent, -- ** Error codes ErrorCode, success, badRequest, badValue, badWindow, badPixmap, badAtom, badCursor, badFont, badMatch, badDrawable, badAccess, badAlloc, badColor, badGC, badIDChoice, badName, badLength, badImplementation, firstExtensionError, lastExtensionError, -- ** Return status Status, throwIfZero, -- ** WindowClass WindowClass, copyFromParent, inputOutput, inputOnly, -- ** Attribute masks AttributeMask, cWBackPixmap, cWBackPixel, cWBorderPixmap, cWBorderPixel, cWBitGravity, cWWinGravity, cWBackingStore, cWBackingPlanes, cWBackingPixel, cWOverrideRedirect, cWSaveUnder, cWEventMask, cWDontPropagate, cWColormap, cWCursor, -- ** Close down modes CloseDownMode, destroyAll, retainPermanent, retainTemporary, -- ** QueryBestSize classes QueryBestSizeClass, cursorShape, tileShape, stippleShape, -- ** Graphics functions GXFunction, gXclear, gXand, gXandReverse, gXcopy, gXandInverted, gXnoop, gXxor, gXor, gXnor, gXequiv, gXinvert, gXorReverse, gXcopyInverted, gXorInverted, gXnand, gXset, -- ** Line styles LineStyle, lineSolid, lineOnOffDash, lineDoubleDash, -- ** Cap styles CapStyle, capNotLast, capButt, capRound, capProjecting, -- ** Join styles JoinStyle, joinMiter, joinRound, joinBevel, -- ** Fill styles FillStyle, fillSolid, fillTiled, fillStippled, fillOpaqueStippled, -- ** Fill rules FillRule, evenOddRule, windingRule, -- ** Subwindow modes SubWindowMode, clipByChildren, includeInferiors, -- ** Coordinate modes CoordinateMode, coordModeOrigin, coordModePrevious, -- ** Polygon shapes PolygonShape, complex, nonconvex, convex, -- ** Arc modes ArcMode, arcChord, arcPieSlice, -- ** GC masks GCMask, gCFunction, gCPlaneMask, gCForeground, gCBackground, gCLineWidth, gCLineStyle, gCCapStyle, gCJoinStyle, gCFillStyle, gCFillRule, gCTile, gCStipple, gCTileStipXOrigin, gCTileStipYOrigin, gCFont, gCSubwindowMode, gCGraphicsExposures, gCClipXOrigin, gCClipYOrigin, gCClipMask, gCDashOffset, gCDashList, gCArcMode, gCLastBit, -- ** Circulation direction CirculationDirection, raiseLowest, lowerHighest, -- ** Byte order ByteOrder, lSBFirst, mSBFirst, -- ** ColormapAlloc ColormapAlloc, allocNone, allocAll, -- ** Mapping requests MappingRequest, mappingModifier, mappingKeyboard, mappingPointer, -- ** ChangeSaveSetMode ChangeSaveSetMode, setModeInsert, setModeDelete, -- ** Bit gravity BitGravity, forgetGravity, northWestGravity, northGravity, northEastGravity, westGravity, centerGravity, eastGravity, southWestGravity, southGravity, southEastGravity, staticGravity, -- ** Window gravity WindowGravity, unmapGravity, -- ** Backing store BackingStore, notUseful, whenMapped, always, doRed, doGreen, doBlue, -- ** Font direction FontDirection, fontLeftToRight, fontRightToLeft, ) where import Data.Int import Data.Word import Foreign.Marshal.Error #include "HsXlib.h" -- ToDo: use newtype type XID = #{type XID} type Mask = #{type Mask} type Atom = #{type Atom} type VisualID = #{type VisualID} type Time = #{type Time} -- end platform dependency type Window = XID type Drawable = XID type Font = XID type Pixmap = XID type Cursor = XID type Colormap = XID type GContext = XID type KeyCode = Char type KeySym = XID #{enum KeySym, , xK_VoidSymbol = XK_VoidSymbol } -- TTY Functions, cleverly chosen to map to ascii, for convenience of -- programming, but could have been arbitrary (at the cost of lookup -- tables in client code. #{enum KeySym, , xK_BackSpace = XK_BackSpace , xK_Tab = XK_Tab , xK_Linefeed = XK_Linefeed , xK_Clear = XK_Clear , xK_Return = XK_Return , xK_Pause = XK_Pause , xK_Scroll_Lock = XK_Scroll_Lock , xK_Sys_Req = XK_Sys_Req , xK_Escape = XK_Escape , xK_Delete = XK_Delete } -- International & multi-key character composition #{enum KeySym, , xK_Multi_key = XK_Multi_key } -- xK_Codeinput = XK_Codeinput -- Not defined for SunOS. -- xK_SingleCandidate = XK_SingleCandidate -- Not defined for SunOS. -- xK_MultipleCandidate = XK_MultipleCandidate -- Not defined for SunOS. -- xK_PreviousCandidate = XK_PreviousCandidate -- Not defined for SunOS. -- Cursor control & motion #{enum KeySym, , xK_Home = XK_Home , xK_Left = XK_Left , xK_Up = XK_Up , xK_Right = XK_Right , xK_Down = XK_Down , xK_Prior = XK_Prior , xK_Page_Up = XK_Page_Up , xK_Next = XK_Next , xK_Page_Down = XK_Page_Down , xK_End = XK_End , xK_Begin = XK_Begin , xK_Select = XK_Select , xK_Print = XK_Print , xK_Execute = XK_Execute , xK_Insert = XK_Insert , xK_Undo = XK_Undo , xK_Redo = XK_Redo , xK_Menu = XK_Menu , xK_Find = XK_Find , xK_Cancel = XK_Cancel , xK_Help = XK_Help , xK_Break = XK_Break , xK_Mode_switch = XK_Mode_switch , xK_script_switch = XK_script_switch , xK_Num_Lock = XK_Num_Lock } -- Keypad Functions, keypad numbers cleverly chosen to map to ascii #{enum KeySym, , xK_KP_Space = XK_KP_Space , xK_KP_Tab = XK_KP_Tab , xK_KP_Enter = XK_KP_Enter , xK_KP_F1 = XK_KP_F1 , xK_KP_F2 = XK_KP_F2 , xK_KP_F3 = XK_KP_F3 , xK_KP_F4 = XK_KP_F4 , xK_KP_Home = XK_KP_Home , xK_KP_Left = XK_KP_Left , xK_KP_Up = XK_KP_Up , xK_KP_Right = XK_KP_Right , xK_KP_Down = XK_KP_Down , xK_KP_Prior = XK_KP_Prior , xK_KP_Page_Up = XK_KP_Page_Up , xK_KP_Next = XK_KP_Next , xK_KP_Page_Down = XK_KP_Page_Down , xK_KP_End = XK_KP_End , xK_KP_Begin = XK_KP_Begin , xK_KP_Insert = XK_KP_Insert , xK_KP_Delete = XK_KP_Delete , xK_KP_Equal = XK_KP_Equal , xK_KP_Multiply = XK_KP_Multiply , xK_KP_Add = XK_KP_Add , xK_KP_Separator = XK_KP_Separator , xK_KP_Subtract = XK_KP_Subtract , xK_KP_Decimal = XK_KP_Decimal , xK_KP_Divide = XK_KP_Divide , xK_KP_0 = XK_KP_0 , xK_KP_1 = XK_KP_1 , xK_KP_2 = XK_KP_2 , xK_KP_3 = XK_KP_3 , xK_KP_4 = XK_KP_4 , xK_KP_5 = XK_KP_5 , xK_KP_6 = XK_KP_6 , xK_KP_7 = XK_KP_7 , xK_KP_8 = XK_KP_8 , xK_KP_9 = XK_KP_9 , xK_F1 = XK_F1 , xK_F2 = XK_F2 , xK_F3 = XK_F3 , xK_F4 = XK_F4 , xK_F5 = XK_F5 , xK_F6 = XK_F6 , xK_F7 = XK_F7 , xK_F8 = XK_F8 , xK_F9 = XK_F9 , xK_F10 = XK_F10 , xK_F11 = XK_F11 , xK_L1 = XK_L1 , xK_F12 = XK_F12 , xK_L2 = XK_L2 , xK_F13 = XK_F13 , xK_L3 = XK_L3 , xK_F14 = XK_F14 , xK_L4 = XK_L4 , xK_F15 = XK_F15 , xK_L5 = XK_L5 , xK_F16 = XK_F16 , xK_L6 = XK_L6 , xK_F17 = XK_F17 , xK_L7 = XK_L7 , xK_F18 = XK_F18 , xK_L8 = XK_L8 , xK_F19 = XK_F19 , xK_L9 = XK_L9 , xK_F20 = XK_F20 , xK_L10 = XK_L10 , xK_F21 = XK_F21 , xK_R1 = XK_R1 , xK_F22 = XK_F22 , xK_R2 = XK_R2 , xK_F23 = XK_F23 , xK_R3 = XK_R3 , xK_F24 = XK_F24 , xK_R4 = XK_R4 , xK_F25 = XK_F25 , xK_R5 = XK_R5 , xK_F26 = XK_F26 , xK_R6 = XK_R6 , xK_F27 = XK_F27 , xK_R7 = XK_R7 , xK_F28 = XK_F28 , xK_R8 = XK_R8 , xK_F29 = XK_F29 , xK_R9 = XK_R9 , xK_F30 = XK_F30 , xK_R10 = XK_R10 , xK_F31 = XK_F31 , xK_R11 = XK_R11 , xK_F32 = XK_F32 , xK_R12 = XK_R12 , xK_F33 = XK_F33 , xK_R13 = XK_R13 , xK_F34 = XK_F34 , xK_R14 = XK_R14 , xK_F35 = XK_F35 , xK_R15 = XK_R15 } #{enum KeySym, , xK_Shift_L = XK_Shift_L , xK_Shift_R = XK_Shift_R , xK_Control_L = XK_Control_L , xK_Control_R = XK_Control_R , xK_Caps_Lock = XK_Caps_Lock , xK_Shift_Lock = XK_Shift_Lock , xK_Meta_L = XK_Meta_L , xK_Meta_R = XK_Meta_R , xK_Alt_L = XK_Alt_L , xK_Alt_R = XK_Alt_R , xK_Super_L = XK_Super_L , xK_Super_R = XK_Super_R , xK_Hyper_L = XK_Hyper_L , xK_Hyper_R = XK_Hyper_R } #{enum KeySym, , xK_space = XK_space , xK_exclam = XK_exclam , xK_quotedbl = XK_quotedbl , xK_numbersign = XK_numbersign , xK_dollar = XK_dollar , xK_percent = XK_percent , xK_ampersand = XK_ampersand , xK_apostrophe = XK_apostrophe , xK_quoteright = XK_quoteright , xK_parenleft = XK_parenleft , xK_parenright = XK_parenright , xK_asterisk = XK_asterisk , xK_plus = XK_plus , xK_comma = XK_comma , xK_minus = XK_minus , xK_period = XK_period , xK_slash = XK_slash , xK_0 = XK_0 , xK_1 = XK_1 , xK_2 = XK_2 , xK_3 = XK_3 , xK_4 = XK_4 , xK_5 = XK_5 , xK_6 = XK_6 , xK_7 = XK_7 , xK_8 = XK_8 , xK_9 = XK_9 , xK_colon = XK_colon , xK_semicolon = XK_semicolon , xK_less = XK_less , xK_equal = XK_equal , xK_greater = XK_greater , xK_question = XK_question , xK_at = XK_at , xK_A = XK_A , xK_B = XK_B , xK_C = XK_C , xK_D = XK_D , xK_E = XK_E , xK_F = XK_F , xK_G = XK_G , xK_H = XK_H , xK_I = XK_I , xK_J = XK_J , xK_K = XK_K , xK_L = XK_L , xK_M = XK_M , xK_N = XK_N , xK_O = XK_O , xK_P = XK_P , xK_Q = XK_Q , xK_R = XK_R , xK_S = XK_S , xK_T = XK_T , xK_U = XK_U , xK_V = XK_V , xK_W = XK_W , xK_X = XK_X , xK_Y = XK_Y , xK_Z = XK_Z , xK_bracketleft = XK_bracketleft , xK_backslash = XK_backslash , xK_bracketright = XK_bracketright , xK_asciicircum = XK_asciicircum , xK_underscore = XK_underscore , xK_grave = XK_grave , xK_quoteleft = XK_quoteleft , xK_a = XK_a , xK_b = XK_b , xK_c = XK_c , xK_d = XK_d , xK_e = XK_e , xK_f = XK_f , xK_g = XK_g , xK_h = XK_h , xK_i = XK_i , xK_j = XK_j , xK_k = XK_k , xK_l = XK_l , xK_m = XK_m , xK_n = XK_n , xK_o = XK_o , xK_p = XK_p , xK_q = XK_q , xK_r = XK_r , xK_s = XK_s , xK_t = XK_t , xK_u = XK_u , xK_v = XK_v , xK_w = XK_w , xK_x = XK_x , xK_y = XK_y , xK_z = XK_z , xK_braceleft = XK_braceleft , xK_bar = XK_bar , xK_braceright = XK_braceright , xK_asciitilde = XK_asciitilde } #{enum KeySym, , xK_nobreakspace = XK_nobreakspace , xK_exclamdown = XK_exclamdown , xK_cent = XK_cent , xK_sterling = XK_sterling , xK_currency = XK_currency , xK_yen = XK_yen , xK_brokenbar = XK_brokenbar , xK_section = XK_section , xK_diaeresis = XK_diaeresis , xK_copyright = XK_copyright , xK_ordfeminine = XK_ordfeminine , xK_guillemotleft = XK_guillemotleft , xK_notsign = XK_notsign , xK_hyphen = XK_hyphen , xK_registered = XK_registered , xK_macron = XK_macron , xK_degree = XK_degree , xK_plusminus = XK_plusminus , xK_twosuperior = XK_twosuperior , xK_threesuperior = XK_threesuperior , xK_acute = XK_acute , xK_mu = XK_mu , xK_paragraph = XK_paragraph , xK_periodcentered = XK_periodcentered , xK_cedilla = XK_cedilla , xK_onesuperior = XK_onesuperior , xK_masculine = XK_masculine , xK_guillemotright = XK_guillemotright , xK_onequarter = XK_onequarter , xK_onehalf = XK_onehalf , xK_threequarters = XK_threequarters , xK_questiondown = XK_questiondown , xK_Agrave = XK_Agrave , xK_Aacute = XK_Aacute , xK_Acircumflex = XK_Acircumflex , xK_Atilde = XK_Atilde , xK_Adiaeresis = XK_Adiaeresis , xK_Aring = XK_Aring , xK_AE = XK_AE , xK_Ccedilla = XK_Ccedilla , xK_Egrave = XK_Egrave , xK_Eacute = XK_Eacute , xK_Ecircumflex = XK_Ecircumflex , xK_Ediaeresis = XK_Ediaeresis , xK_Igrave = XK_Igrave , xK_Iacute = XK_Iacute , xK_Icircumflex = XK_Icircumflex , xK_Idiaeresis = XK_Idiaeresis , xK_ETH = XK_ETH , xK_Eth = XK_Eth , xK_Ntilde = XK_Ntilde , xK_Ograve = XK_Ograve , xK_Oacute = XK_Oacute , xK_Ocircumflex = XK_Ocircumflex , xK_Otilde = XK_Otilde , xK_Odiaeresis = XK_Odiaeresis , xK_multiply = XK_multiply , xK_Ooblique = XK_Ooblique , xK_Ugrave = XK_Ugrave , xK_Uacute = XK_Uacute , xK_Ucircumflex = XK_Ucircumflex , xK_Udiaeresis = XK_Udiaeresis , xK_Yacute = XK_Yacute , xK_THORN = XK_THORN , xK_Thorn = XK_Thorn , xK_ssharp = XK_ssharp , xK_agrave = XK_agrave , xK_aacute = XK_aacute , xK_acircumflex = XK_acircumflex , xK_atilde = XK_atilde , xK_adiaeresis = XK_adiaeresis , xK_aring = XK_aring , xK_ae = XK_ae , xK_ccedilla = XK_ccedilla , xK_egrave = XK_egrave , xK_eacute = XK_eacute , xK_ecircumflex = XK_ecircumflex , xK_ediaeresis = XK_ediaeresis , xK_igrave = XK_igrave , xK_iacute = XK_iacute , xK_icircumflex = XK_icircumflex , xK_idiaeresis = XK_idiaeresis , xK_eth = XK_eth , xK_ntilde = XK_ntilde , xK_ograve = XK_ograve , xK_oacute = XK_oacute , xK_ocircumflex = XK_ocircumflex , xK_otilde = XK_otilde , xK_odiaeresis = XK_odiaeresis , xK_division = XK_division , xK_oslash = XK_oslash , xK_ugrave = XK_ugrave , xK_uacute = XK_uacute , xK_ucircumflex = XK_ucircumflex , xK_udiaeresis = XK_udiaeresis , xK_yacute = XK_yacute , xK_thorn = XK_thorn , xK_ydiaeresis = XK_ydiaeresis } type EventMask = Mask #{enum EventMask, , noEventMask = NoEventMask , keyPressMask = KeyPressMask , keyReleaseMask = KeyReleaseMask , buttonPressMask = ButtonPressMask , buttonReleaseMask = ButtonReleaseMask , enterWindowMask = EnterWindowMask , leaveWindowMask = LeaveWindowMask , pointerMotionMask = PointerMotionMask , pointerMotionHintMask = PointerMotionHintMask , button1MotionMask = Button1MotionMask , button2MotionMask = Button2MotionMask , button3MotionMask = Button3MotionMask , button4MotionMask = Button4MotionMask , button5MotionMask = Button5MotionMask , buttonMotionMask = ButtonMotionMask , keymapStateMask = KeymapStateMask , exposureMask = ExposureMask , visibilityChangeMask = VisibilityChangeMask , structureNotifyMask = StructureNotifyMask , resizeRedirectMask = ResizeRedirectMask , substructureNotifyMask = SubstructureNotifyMask , substructureRedirectMask = SubstructureRedirectMask , focusChangeMask = FocusChangeMask , propertyChangeMask = PropertyChangeMask , colormapChangeMask = ColormapChangeMask , ownerGrabButtonMask = OwnerGrabButtonMask } type EventType = Word32 #{enum EventType, , keyPress = KeyPress , keyRelease = KeyRelease , buttonPress = ButtonPress , buttonRelease = ButtonRelease , motionNotify = MotionNotify , enterNotify = EnterNotify , leaveNotify = LeaveNotify , focusIn = FocusIn , focusOut = FocusOut , keymapNotify = KeymapNotify , expose = Expose , graphicsExpose = GraphicsExpose , noExpose = NoExpose , visibilityNotify = VisibilityNotify , createNotify = CreateNotify , destroyNotify = DestroyNotify , unmapNotify = UnmapNotify , mapNotify = MapNotify , mapRequest = MapRequest , reparentNotify = ReparentNotify , configureNotify = ConfigureNotify , configureRequest = ConfigureRequest , gravityNotify = GravityNotify , resizeRequest = ResizeRequest , circulateNotify = CirculateNotify , circulateRequest = CirculateRequest , propertyNotify = PropertyNotify , selectionClear = SelectionClear , selectionRequest = SelectionRequest , selectionNotify = SelectionNotify , colormapNotify = ColormapNotify , clientMessage = ClientMessage , mappingNotify = MappingNotify , lASTEvent = LASTEvent } type Modifier = Mask #{enum Modifier, , shiftMapIndex = ShiftMapIndex , lockMapIndex = LockMapIndex , controlMapIndex = ControlMapIndex , mod1MapIndex = Mod1MapIndex , mod2MapIndex = Mod2MapIndex , mod3MapIndex = Mod3MapIndex , mod4MapIndex = Mod4MapIndex , mod5MapIndex = Mod5MapIndex , anyModifier = AnyModifier } type KeyMask = Modifier #{enum KeyMask, , shiftMask = ShiftMask , lockMask = LockMask , controlMask = ControlMask , mod1Mask = Mod1Mask , mod2Mask = Mod2Mask , mod3Mask = Mod3Mask , mod4Mask = Mod4Mask , mod5Mask = Mod5Mask } type ButtonMask = Modifier #{enum ButtonMask, , button1Mask = Button1Mask , button2Mask = Button2Mask , button3Mask = Button3Mask , button4Mask = Button4Mask , button5Mask = Button5Mask } type Button = Word32 #{enum Button, , button1 = Button1 , button2 = Button2 , button3 = Button3 , button4 = Button4 , button5 = Button5 } type NotifyMode = Int -- NotifyNormal and NotifyHint are used as detail in XMotionEvents #{enum NotifyMode, , notifyNormal = NotifyNormal , notifyGrab = NotifyGrab , notifyUngrab = NotifyUngrab , notifyWhileGrabbed = NotifyWhileGrabbed , notifyHint = NotifyHint } type NotifyDetail = Int #{enum NotifyDetail, , notifyAncestor = NotifyAncestor , notifyVirtual = NotifyVirtual , notifyInferior = NotifyInferior , notifyNonlinear = NotifyNonlinear , notifyNonlinearVirtual = NotifyNonlinearVirtual , notifyPointer = NotifyPointer , notifyPointerRoot = NotifyPointerRoot , notifyDetailNone = NotifyDetailNone } type Visibility = Int #{enum Visibility, , visibilityUnobscured = VisibilityUnobscured , visibilityPartiallyObscured = VisibilityPartiallyObscured , visibilityFullyObscured = VisibilityFullyObscured } -- | Place of window relative to siblings -- (used in Circulation requests or events) type Place = Int #{enum Place, , placeOnTop = PlaceOnTop , placeOnBottom = PlaceOnBottom } type Protocol = Int #{enum Protocol, , familyInternet = FamilyInternet , familyDECnet = FamilyDECnet , familyChaos = FamilyChaos } type PropertyNotification = Int #{enum PropertyNotification, , propertyNewValue = PropertyNewValue , propertyDelete = PropertyDelete } type ColormapNotification = Int #{enum ColormapNotification, , colormapUninstalled = ColormapUninstalled , colormapInstalled = ColormapInstalled } -- Grab{Pointer,Button,Keyboard,Key} Modes type GrabMode = Int #{enum GrabMode, , grabModeSync = GrabModeSync , grabModeAsync = GrabModeAsync } -- Grab{Pointer,Keyboard} reply status type GrabStatus = Int #{enum GrabStatus, , grabSuccess = GrabSuccess , alreadyGrabbed = AlreadyGrabbed , grabInvalidTime = GrabInvalidTime , grabNotViewable = GrabNotViewable , grabFrozen = GrabFrozen } -- AllowEvents modes type AllowEvents = Int #{enum AllowEvents, , asyncPointer = AsyncPointer , syncPointer = SyncPointer , replayPointer = ReplayPointer , asyncKeyboard = AsyncKeyboard , syncKeyboard = SyncKeyboard , replayKeyboard = ReplayKeyboard , asyncBoth = AsyncBoth , syncBoth = SyncBoth } -- {Set,Get}InputFocus Modes type FocusMode = Int #{enum FocusMode, , revertToNone = RevertToNone , revertToPointerRoot = RevertToPointerRoot , revertToParent = RevertToParent } -- Error codes type ErrorCode = Int #{enum ErrorCode, , success = Success , badRequest = BadRequest , badValue = BadValue , badWindow = BadWindow , badPixmap = BadPixmap , badAtom = BadAtom , badCursor = BadCursor , badFont = BadFont , badMatch = BadMatch , badDrawable = BadDrawable , badAccess = BadAccess , badAlloc = BadAlloc , badColor = BadColor , badGC = BadGC , badIDChoice = BadIDChoice , badName = BadName , badLength = BadLength , badImplementation = BadImplementation , firstExtensionError = FirstExtensionError , lastExtensionError = LastExtensionError } type Status = Int -- |Xlib functions with return values of type @Status@ return zero on -- failure and nonzero on success. throwIfZero :: String -> IO Status -> IO () throwIfZero fn_name = throwIf_ (== 0) (const ("Error in function " ++ fn_name)) type WindowClass = Int #{enum WindowClass, , copyFromParent = CopyFromParent , inputOutput = InputOutput , inputOnly = InputOnly } -- Window attributes mask type AttributeMask = Mask #{enum AttributeMask, , cWBackPixmap = CWBackPixmap , cWBackPixel = CWBackPixel , cWBorderPixmap = CWBorderPixmap , cWBorderPixel = CWBorderPixel , cWBitGravity = CWBitGravity , cWWinGravity = CWWinGravity , cWBackingStore = CWBackingStore , cWBackingPlanes = CWBackingPlanes , cWBackingPixel = CWBackingPixel , cWOverrideRedirect = CWOverrideRedirect , cWSaveUnder = CWSaveUnder , cWEventMask = CWEventMask , cWDontPropagate = CWDontPropagate , cWColormap = CWColormap , cWCursor = CWCursor } -- Used in ChangeCloseDownMode type CloseDownMode = Int #{enum CloseDownMode, , destroyAll = DestroyAll , retainPermanent = RetainPermanent , retainTemporary = RetainTemporary } ---------------------------------------------------------------- -- CURSOR STUFF ---------------------------------------------------------------- type QueryBestSizeClass = Int #{enum QueryBestSizeClass, , cursorShape = CursorShape , tileShape = TileShape , stippleShape = StippleShape } ---------------------------------------------------------------- -- GRAPHICS DEFINITIONS ---------------------------------------------------------------- -- graphics functions, as in GC.alu type GXFunction = Int #{enum GXFunction, , gXclear = GXclear , gXand = GXand , gXandReverse = GXandReverse , gXcopy = GXcopy , gXandInverted = GXandInverted , gXnoop = GXnoop , gXxor = GXxor , gXor = GXor , gXnor = GXnor , gXequiv = GXequiv , gXinvert = GXinvert , gXorReverse = GXorReverse , gXcopyInverted = GXcopyInverted , gXorInverted = GXorInverted , gXnand = GXnand , gXset = GXset } type LineStyle = Int #{enum LineStyle, , lineSolid = LineSolid , lineOnOffDash = LineOnOffDash , lineDoubleDash = LineDoubleDash } type CapStyle = Int #{enum CapStyle, , capNotLast = CapNotLast , capButt = CapButt , capRound = CapRound , capProjecting = CapProjecting } type JoinStyle = Int #{enum JoinStyle, , joinMiter = JoinMiter , joinRound = JoinRound , joinBevel = JoinBevel } type FillStyle = Int #{enum FillStyle, , fillSolid = FillSolid , fillTiled = FillTiled , fillStippled = FillStippled , fillOpaqueStippled = FillOpaqueStippled } type FillRule = Int #{enum FillRule, , evenOddRule = EvenOddRule , windingRule = WindingRule } type SubWindowMode = Int #{enum SubWindowMode, , clipByChildren = ClipByChildren , includeInferiors = IncludeInferiors } -- -- SetClipRectangles ordering -- type Ordering = Int -- {enum Ordering, -- , unsorted = Unsorted -- , ySorted = YSorted -- , yXSorted = YXSorted -- , yXBanded = YXBanded -- } -- CoordinateMode for drawing routines type CoordinateMode = Int #{enum CoordinateMode, , coordModeOrigin = CoordModeOrigin , coordModePrevious = CoordModePrevious } type PolygonShape = Int #{enum PolygonShape, , complex = Complex , nonconvex = Nonconvex , convex = Convex } -- Arc modes for PolyFillArc type ArcMode = Int #{enum ArcMode, , arcChord = ArcChord , arcPieSlice = ArcPieSlice } -- GC components: masks used in CreateGC, CopyGC, ChangeGC, OR'ed into -- GC.stateChanges type GCMask = Int #{enum GCMask, , gCFunction = GCFunction , gCPlaneMask = GCPlaneMask , gCForeground = GCForeground , gCBackground = GCBackground , gCLineWidth = GCLineWidth , gCLineStyle = GCLineStyle , gCCapStyle = GCCapStyle , gCJoinStyle = GCJoinStyle , gCFillStyle = GCFillStyle , gCFillRule = GCFillRule , gCTile = GCTile , gCStipple = GCStipple , gCTileStipXOrigin = GCTileStipXOrigin , gCTileStipYOrigin = GCTileStipYOrigin , gCFont = GCFont , gCSubwindowMode = GCSubwindowMode , gCGraphicsExposures = GCGraphicsExposures , gCClipXOrigin = GCClipXOrigin , gCClipYOrigin = GCClipYOrigin , gCClipMask = GCClipMask , gCDashOffset = GCDashOffset , gCDashList = GCDashList , gCArcMode = GCArcMode , gCLastBit = GCLastBit } type CirculationDirection = Int #{enum CirculationDirection, , raiseLowest = RaiseLowest , lowerHighest = LowerHighest } -- used in imageByteOrder and bitmapBitOrder type ByteOrder = Int #{enum ByteOrder, , lSBFirst = LSBFirst , mSBFirst = MSBFirst } type ColormapAlloc = Int #{enum ColormapAlloc, , allocNone = AllocNone , allocAll = AllocAll } type MappingRequest = Int #{enum MappingRequest, , mappingModifier = MappingModifier , mappingKeyboard = MappingKeyboard , mappingPointer = MappingPointer } type ChangeSaveSetMode = Int #{enum ChangeSaveSetMode, , setModeInsert = SetModeInsert , setModeDelete = SetModeDelete } type BitGravity = Int #{enum BitGravity, , forgetGravity = ForgetGravity , northWestGravity = NorthWestGravity , northGravity = NorthGravity , northEastGravity = NorthEastGravity , westGravity = WestGravity , centerGravity = CenterGravity , eastGravity = EastGravity , southWestGravity = SouthWestGravity , southGravity = SouthGravity , southEastGravity = SouthEastGravity , staticGravity = StaticGravity } -- All the BitGravity's plus ... type WindowGravity = Int #{enum WindowGravity, , unmapGravity = UnmapGravity } -- Used in CreateWindow for backing-store hint type BackingStore = Int #{enum BackingStore, , notUseful = NotUseful , whenMapped = WhenMapped , always = Always } #{enum Word8, , doRed = DoRed , doGreen = DoGreen , doBlue = DoBlue } type FontDirection = Int #{enum FontDirection, , fontLeftToRight = FontLeftToRight , fontRightToLeft = FontRightToLeft } hugs98-plus-Sep2006/packages/X11/Graphics/X11/Xlib.hs0000644006511100651110000000645610504340414020463 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.X11.Xlib -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Xlib. -- -- The library aims to provide a direct translation of the X -- binding into Haskell so the most important documentation you -- should read is /The Xlib Programming Manual/, available online at -- . Let me say that again because -- it is very important. Get hold of this documentation and read it: -- it tells you almost everything you need to know to use this library. -- ----------------------------------------------------------------------------- module Graphics.X11.Xlib ( -- * Conventions -- $conventions -- * Types module Graphics.X11.Types, -- module Graphics.X11.Xlib.Types, Display, Screen, Visual, GC, SetWindowAttributes, Point(..), Rectangle(..), Arc(..), Segment(..), Color(..), Pixel, Position, Dimension, Angle, ScreenNumber, Buffer, -- * X11 library functions module Graphics.X11.Xlib.Event, module Graphics.X11.Xlib.Display, module Graphics.X11.Xlib.Screen, module Graphics.X11.Xlib.Window, module Graphics.X11.Xlib.Context, module Graphics.X11.Xlib.Color, module Graphics.X11.Xlib.Font, module Graphics.X11.Xlib.Atom, module Graphics.X11.Xlib.Region, module Graphics.X11.Xlib.Misc, ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types import Graphics.X11.Xlib.Event import Graphics.X11.Xlib.Display import Graphics.X11.Xlib.Screen import Graphics.X11.Xlib.Window import Graphics.X11.Xlib.Context import Graphics.X11.Xlib.Color import Graphics.X11.Xlib.Font import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Region import Graphics.X11.Xlib.Misc {- $conventions In translating the library, we had to change names to conform with Haskell's lexical syntax: function names and names of constants must start with a lowercase letter; type names must start with an uppercase letter. The case of the remaining letters is unchanged. In addition, we chose to take advantage of Haskell's module system to allow us to drop common prefixes (@X@, @XA_@, etc.) attached to X11 identifiers. We named enumeration types so that function types would be easier to understand. For example, we added 'Status', 'WindowClass', etc. Note that the types are synonyms for 'Int' so no extra typesafety was obtained. We consistently raise exceptions when a function returns an error code. In practice, this only affects the following functions because most Xlib functions do not return error codes: 'allocColor', 'allocNamedColor', 'fetchBuffer', 'fetchBytes', 'fontFromGC', 'getGeometry', 'getIconName', 'iconifyWindow', 'loadQueryFont', 'lookupColor', 'openDisplay', 'parseColor', 'queryBestCursor', 'queryBestSize', 'queryBestStipple', 'queryBestTile', 'rotateBuffers', 'selectInput', 'storeBuffer', 'storeBytes', 'withdrawWindow'. -} ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Graphics/X11.hs0000644006511100651110000000136510504340414017557 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.X11 -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A Haskell binding for the X11 libraries. -- ----------------------------------------------------------------------------- module Graphics.X11 ( module Graphics.X11.Types , module Graphics.X11.Xlib ) where import Graphics.X11.Types import Graphics.X11.Xlib ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/X11/Makefile.inc0000644006511100651110000000022410504340414017313 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/X11/INSTALL0000644006511100651110000000032610504340414016137 0ustar rossross# install ghc >= 6.0 # install greencard >= 3.00 # install X11 tar zxvf HSX11-1.00.tar.gz cd HSX11-1.00 cd fptools ./configure --with-greencard make cd .. make boot make all make install # may require su root hugs98-plus-Sep2006/packages/X11/LICENSE0000644006511100651110000000253510504340414016117 0ustar rossrossThe HSX11 Library is Copyright (c) Alastair Reid, 1997-2003, All rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/X11/Makefile0000644006511100651110000000177610504340414016560 0ustar rossross# ----------------------------------------------------------------------------- TOP = .. include $(TOP)/mk/boilerplate.mk -include config.mk ifneq "$(findstring clean, $(MAKECMDGOALS))" "" # if we're cleaning, then config.mk might have been cleaned already X11_BUILD_PACKAGE=yes PACKAGE=X11 endif # ----------------------------------------------------------------------------- ifeq "$(X11_BUILD_PACKAGE)" "yes" SUBDIRS = cbits doc include ALL_DIRS = \ Graphics/X11 \ Graphics/X11/Xlib PACKAGE_DEPS = base SRC_CC_OPTS += -Iinclude $(X_CFLAGS) SRC_HC_OPTS += -cpp -fffi SRC_HC_OPTS += -Iinclude $(X_CFLAGS) SRC_HSC2HS_OPTS += -Iinclude $(X_CFLAGS) PACKAGE_CPP_OPTS += -DMAINTAINER=$(MAINTAINER) SRC_HADDOCK_OPTS += -t "X11 Libraries ($(PACKAGE) package)" endif EXCLUDED_SRCS += Setup.hs # ----------------------------------------------------------------------------- DIST_CLEAN_FILES += X11.buildinfo config.cache config.status config.mk extraclean:: $(RM) -rf autom4te.cache include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/X11/X11.buildinfo.in0000644006511100651110000000025410504340414017761 0ustar rossross-- @configure_input@ -- System-dependent values used by Distribution.Simple.defaultUserHooks -- buildable: @BUILD_PACKAGE_BOOL@ cc-options: @X_CFLAGS@ ld-options: @X_LIBS@ hugs98-plus-Sep2006/packages/X11/Makefile.nhc980000644006511100651110000000122110504340414017471 0ustar rossrossTHISPKG = X11 SEARCH = -I/usr/X11/include -Iinclude EXTRA_H_FLAGS = -package base SRCS = \ Graphics/X11.hs \ Graphics/X11/Types.hsc \ Graphics/X11/Xlib.hs \ Graphics/X11/Xlib/Atom.hsc \ Graphics/X11/Xlib/Color.hs \ Graphics/X11/Xlib/Context.hs \ Graphics/X11/Xlib/Display.hs \ Graphics/X11/Xlib/Event.hsc \ Graphics/X11/Xlib/Font.hsc \ Graphics/X11/Xlib/Misc.hsc \ Graphics/X11/Xlib/Region.hs \ Graphics/X11/Xlib/Screen.hs \ Graphics/X11/Xlib/Types.hsc \ Graphics/X11/Xlib/Window.hs \ fdset.c \ auxiliaries.c # Here are the main rules. include ../Makefile.common # some extra rules # Here are the dependencies. # C-files dependencies. hugs98-plus-Sep2006/packages/X11/README0000644006511100651110000000223210504340414015764 0ustar rossross HSX11 1.00 A Haskell binding for X11 In preparation for a major release of HSX11, we are making an alpha release for folk to play with. We welcome bug reports, comments on how the system is packaged, the web page, examples, comments from those who build binary and source packages, etc. and especially welcome comments accompanied by patches or cvs commit messages. We are pleased to announce a new release of the Haskell binding for X11 which provides a binding to most of Xlib. The library is distributed as open source. The library can be downloaded from: http://www.reid-consulting-uk.ltd.uk/projects/HSX11.html You will need GreenCard 3.00, GHC 6.0 and, of course, X11 to build the library. Installation instructions are in HSX11-1.0/INSTALL. Bug reports should be sent to X11@reid-consulting-uk.ltd.uk Enjoy! -- Alastair Reid http://www.reid-consulting-uk.ltd.uk ps This release is based on the GHC team's fptools infrastructure which is evolving in the direction of supporting packages like this one. We welcome comments on this infrastructure and, especially, offers to help make it better. hugs98-plus-Sep2006/packages/X11/cbits/0000755006511100651110000000000010504340414016211 5ustar rossrosshugs98-plus-Sep2006/packages/X11/cbits/Makefile0000644006511100651110000000105110504340414017646 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../.. include $(TOP)/mk/boilerplate.mk -include ../config.mk # HACK PACKAGE= # ----------------------------------------------------------------------------- SRC_CC_OPTS += -Wall -I../include $(X_CFLAGS) LIBRARY = libHSX11_cbits.a LIBOBJS = $(C_OBJS) # ----------------------------------------------------------------------------- # Per-module flags # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/X11/cbits/fdset.c0000644006511100651110000000016510504340414017464 0ustar rossross#include "HsXlib.h" void fdZero(fd_set *set) { FD_ZERO(set); } void fdSet(int fd, fd_set *set) { FD_SET(fd, set); } hugs98-plus-Sep2006/packages/X11/cbits/auxiliaries.c0000644006511100651110000000035710504340414020701 0ustar rossross#include #include #include int defaultErrorHandler(Display *d, XErrorEvent *ev) { char buffer[1000]; XGetErrorText(d,ev->error_code,buffer,1000); printf("Error: %s\n", buffer); return 0; } hugs98-plus-Sep2006/packages/X11/X11.cabal0000644006511100651110000000227610504340414016451 0ustar rossrossname: X11 version: 1.2 license: BSD3 license-file: LICENSE copyright: Alastair Reid, 1999-2003 maintainer: category: Graphics synopsis: A binding to the X11 graphics library description: A Haskell binding to the X11 graphics library. . The binding is a direct translation of the C binding; for documentation of these calls, refer to "The Xlib Programming Manual", available online at . extra-source-files: configure.ac configure config.mk.in X11.buildinfo.in include/HsX11Config.h.in include/HsXlib.h extra-tmp-files: config.log config.status autom4te.cache config.mk X11.buildinfo include/HsX11Config.h exposed-modules: Graphics.X11, Graphics.X11.Types, Graphics.X11.Xlib, Graphics.X11.Xlib.Atom, Graphics.X11.Xlib.Color, Graphics.X11.Xlib.Context, Graphics.X11.Xlib.Display, Graphics.X11.Xlib.Event, Graphics.X11.Xlib.Font, Graphics.X11.Xlib.Misc, Graphics.X11.Xlib.Region, Graphics.X11.Xlib.Screen, Graphics.X11.Xlib.Types, Graphics.X11.Xlib.Window c-sources: cbits/fdset.c, cbits/auxiliaries.c extensions: ForeignFunctionInterface, CPP extra-libraries: "X11" include-dirs: include install-includes: HsXlib.h build-depends: base hugs98-plus-Sep2006/packages/X11/aclocal.m40000644006511100651110000000057510504340414016754 0ustar rossross# Empty file to avoid a dependency on automake: autoreconf calls aclocal to # generate a temporary aclocal.m4t when no aclocal.m4 is present. # FP_ARG_X11 # ------------- AC_DEFUN([FP_ARG_X11], [AC_ARG_ENABLE([x11], [AC_HELP_STRING([--enable-x11], [build a Haskell binding for X11. (default=autodetect)])], [enable_x11=$enableval], [enable_x11=yes]) ])# FP_ARG_X11 hugs98-plus-Sep2006/packages/X11/distrib/0000755006511100651110000000000010504340414016545 5ustar rossrosshugs98-plus-Sep2006/packages/X11/distrib/MakingDistributions.txt0000644006511100651110000000034510504340414023301 0ustar rossrosscd /tmp cvs -d:ext:reid@cvs.haskell.org:/home/cvs/root checkout HSX11 (cd HSX11/fptools; autoconf) mv HSX11 HSX11-1.00 tar zcf HSX11-1.00.tar.gz HSX11-1.00 scp HSX11-1.00.tar.gz reid@haskell.org:/home/haskell/packages/downloads hugs98-plus-Sep2006/packages/X11/config.mk.in0000644006511100651110000000037110504340414017311 0ustar rossrossX11_BUILD_PACKAGE=@X11_BUILD_PACKAGE@ ifneq "$(X11_BUILD_PACKAGE)" "no" X_CFLAGS=@X_CFLAGS@ X_PRE_LIBS=@X_PRE_LIBS@ X_LIBS=@X_LIBS@ X_EXTRA_LIBS=@X_EXTRA_LIBS@ PACKAGE=@PACKAGE_TARNAME@ VERSION=@PACKAGE_VERSION@ MAINTAINER=@PACKAGE_BUGREPORT@ endif hugs98-plus-Sep2006/packages/X11/configure.ac0000644006511100651110000000273010504340414017375 0ustar rossrossAC_INIT([Haskell X11 package], [1.1], [libraries@haskell.org], [X11]) FP_ARG_X11 if test "$enable_x11" = no; then X11_BUILD_PACKAGE=no BUILD_PACKAGE_BOOL=False else # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([include/HsXlib.h]) AC_CONFIG_HEADERS([include/HsX11Config.h]) # Check for X11 include paths and libraries AC_PATH_XTRA # AC_PATH_XTRA doesn't actually check that the C compiler can # really include the X headers, so double-check here. In particular, # this will catch the case of using a mingw32 gcc on a Cygwin system: # Cygwin has the X headers & libs installed, but the mingw32 gcc can't # use them, and we want to disable the package in this case. CPPFLAGS="$CPPFLAGS $X_CFLAGS" AC_TRY_CPP([#include ],,[no_x=yes]) # Build the package if we found X11 stuff if test "$no_x" = yes; then X11_BUILD_PACKAGE=no BUILD_PACKAGE_BOOL=False else X11_BUILD_PACKAGE=yes BUILD_PACKAGE_BOOL=True fi fi AC_SUBST([X11_BUILD_PACKAGE]) AC_SUBST([BUILD_PACKAGE_BOOL]) # Define CPP variables used in package.conf.in if test "$X11_BUILD_PACKAGE" = yes; then AC_DEFINE_UNQUOTED(X_CFLAGS, [`echo '' $X_CFLAGS | sed -e 's/-[[^ ]]*/,"&"/g' -e 's/^ *,//'`], [C flags for X11, as a list of string literals.]) AC_DEFINE_UNQUOTED(X_LIBS, [`echo '' $X_LIBS | sed -e 's/-[[^ ]]*/,"&"/g' -e 's/^ *,//'`], [Library flags for X11, as a list of string literals.]) fi AC_CONFIG_FILES([config.mk X11.buildinfo]) AC_OUTPUT hugs98-plus-Sep2006/packages/X11/doc/0000755006511100651110000000000010504340414015652 5ustar rossrosshugs98-plus-Sep2006/packages/X11/doc/HSX11.xml0000644006511100651110000002607610504340414017213 0ustar rossross 2003-05-22 HSX11 Guide Alastair Reid

alastair@reid-consulting-uk.ltd.uk
1999-2003 Alastair Reid This document describes HSX11, the Haskell binding to X11, version 1.00. Introduction HSX11 is a Haskell binding to the popular X11 library. The library aims to provide a direct translation of the X binding into Haskell so the most important pieces of documentation you should read are the X11 documents which can be obtained from the XFree86 website. Let me say that again because it is very important. Get hold of this documentation and read it: it tells you almost everything you need to know to use this library. Changes from X11 documentation In making a Haskell binding to a C library, there are certain necessary and/or desirable changes in the interface. These can be divided into systematic changes which are applied uniformly throughout the library and ad-hoc changes which are applied to particular parts of the interface. Systematic Changes Naming Conventions In translating the library, we had to change names to conform with Haskell's lexical syntax: function names and names of constants must start with a lowercase letter; type names must start with an uppercase letter. In addition, we chose to take advantage of Haskell's module system to allow us to drop common prefixes (X, XA_, etc.) attached to X11 identifiers. For example, we translate some C functions, constants and types as follows: C Name Haskell Name XWindowEvent windowEvent XCheckWindowEvent checkWindowEvent QueuedAlready queuedAlready XA_WM_ICON_NAME wM_ICON_NAME XA_WM_ICON_SIZE wM_ICON_SIZE Types We translate type names as follows... C Type Haskell Type Haskell Expansion Display* Display Screen* Screen Visual* Visual XFontStruct* FontStruct XPoint Point (Position,Position) XSegment Segment (Position,Position,Position,Position) XRectangle Rectangle (Position,Position,Dimension,Dimension) XArc Arc (Position,Position,Dimension,Dimension,Int,Int) XColor Color (Pixel,Word16, Word16, Word16, Word8) We systematically use a type of the form ListFoo as a synonym for [Foo] and MbFoo as a synonym for Maybe Foo. This is an unfortunate side-effect of the tool we used to generate the bindings. We named enumeration types so that function types would be easier to understand. For example, we added ... Note that the types are synonyms for Int so no extra typesafety was obtained. Exception Handling We consistently raise exceptions when a function returns an error code. In practice, this only affects the following functions because most Xlib functions do not return error codes. allocColor allocNamedColor fetchBuffer fetchBytes fontFromGC getGeometry getIconName iconifyWindow loadQueryFont lookupColor openDisplay parseColor queryBestCursor queryBestSize queryBestStipple queryBestTile rotateBuffers selectInput storeBuffer storeBytes withdrawWindow The Xlib library reports most errors by invoking a user-provided error handler. The function setDefaultErrorHandler :: IO () installs this error handler. int defaultErrorHandler(Display *d, XErrorEvent *ev) { char buffer[1000]; XGetErrorText(d,ev->error_code,buffer,1000); printf("Error: %s\n", buffer); return 0; } As an example of how these rules are applied in generating a function type, the C function with type: XDrawPoints(Display *display, Drawable d, GC gc, XPoint *points, int npoints, int mode) is given the Haskell type: drawPoints :: Display -> Drawable -> GC -> [Point] -> CoordinateMode -> IO () Ad hoc Changes Finally, we chose to make some changes in the interface to better conform with idiomatic Haskell style or to allow a typesafe interface. waitForEvent The function waitForEvent :: Display -> Word32 -> IO Bool reads an event with a timeout (in microseconds). It is sometimes useful in conjunction with this function: gettimeofday_in_milliseconds :: IO Integer WindowAttribute operations We provide the following operations on WindowsAttributes: set_background_pixmap :: XSetWindowAttributesPtr -> Pixmap -> IO () set_background_pixel :: XSetWindowAttributesPtr -> Pixel -> IO () set_border_pixmap :: XSetWindowAttributesPtr -> Pixmap -> IO () set_border_pixel :: XSetWindowAttributesPtr -> Pixel -> IO () set_bit_gravity :: XSetWindowAttributesPtr -> BitGravity -> IO () set_win_gravity :: XSetWindowAttributesPtr -> WindowGravity -> IO () set_backing_store :: XSetWindowAttributesPtr -> BackingStore -> IO () set_backing_planes :: XSetWindowAttributesPtr -> Pixel -> IO () set_backing_pixel :: XSetWindowAttributesPtr -> Pixel -> IO () set_save_under :: XSetWindowAttributesPtr -> Bool -> IO () set_event_mask :: XSetWindowAttributesPtr -> EventMask -> IO () set_do_not_propagate_mask :: XSetWindowAttributesPtr -> EventMask -> IO () set_override_redirect :: XSetWindowAttributesPtr -> Bool -> IO () set_colormap :: XSetWindowAttributesPtr -> Colormap -> IO () set_cursor :: XSetWindowAttributesPtr -> Cursor -> IO () hugs98-plus-Sep2006/packages/X11/doc/Makefile0000644006511100651110000000013310504340414017307 0ustar rossrossTOP = ../.. include $(TOP)/mk/boilerplate.mk XML_DOC = HSX11 include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/X11/include/0000755006511100651110000000000010504340665016540 5ustar rossrosshugs98-plus-Sep2006/packages/X11/include/HsXlib.h0000644006511100651110000000162210504340414020073 0ustar rossross/* ----------------------------------------------------------------------------- * $Id: HsXlib.h,v 1.3 2004/02/16 18:01:29 ross Exp $ * * Definitions for package `X11' which are visible in Haskell land. * * ---------------------------------------------------------------------------*/ #ifndef HSXLIB_H #define HSXLIB_H #include #include #include #include #include #include #define XK_MISCELLANY #define XK_LATIN1 #include /* This error handler is used from FFI code. * It generates a slightly better error message than the one * that comes with Xlib. */ extern int defaultErrorHandler(Display *, XErrorEvent *); /* Used in waitForEvent */ #include #include #include #include extern void fdZero(fd_set *set); extern void fdSet(int fd, fd_set *set); #endif hugs98-plus-Sep2006/packages/X11/include/Makefile0000644006511100651110000000042710504340414020173 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../.. include $(TOP)/mk/boilerplate.mk H_FILES = $(wildcard *.h) includedir = $(libdir)/include INSTALL_INCLUDES = $(H_FILES) DIST_CLEAN_FILES += HsX11Config.h include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/X11/include/HsX11Config.h.in0000644006511100651110000000132510504340665021311 0ustar rossross/* include/HsX11Config.h.in. Generated from configure.ac by autoheader. */ /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* C flags for X11, as a list of string literals. */ #undef X_CFLAGS /* Define to 1 if the X Window System is missing or not being used. */ #undef X_DISPLAY_MISSING /* Library flags for X11, as a list of string literals. */ #undef X_LIBS hugs98-plus-Sep2006/packages/X11/mk/0000755006511100651110000000000010504340414015514 5ustar rossrosshugs98-plus-Sep2006/packages/X11/mk/boilerplate.mk0000644006511100651110000000233510504340414020352 0ustar rossross# Begin by slurping in the boilerplate from one level up. # Remember, TOP is the top level of the innermost level # (FPTOOLS_TOP is the fptools top) # We need to set TOP to be the TOP that the next level up expects! # The TOP variable is reset after the inclusion of the fptools # boilerplate, so we stash TOP away first: LIBRARY_TOP := $(TOP) TOP:=$(TOP)/fptools HIERARCHICAL_LIB = YES # Some of the libraries rely on GreenCard. When you compile the GreenCard # generated code, you have to use -I/usr/lib/ghc-/include so that # the C compiler can find HsFFI.h. The easy way of doing this is to use ghc # as your C compiler. UseGhcForCc = YES # NOT YET: Haddock needs to understand about .raw-hs files # # Set our source links to point to the CVS repository on the web. # SRC_HADDOCK_OPTS += -s http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/libaries/$(PACKAGE) # Pull in the fptools boilerplate include $(TOP)/mk/boilerplate.mk # Reset TOP TOP:=$(LIBRARY_TOP) # ----------------------------------------------------------------- # Everything after this point # augments or overrides previously set variables. -include $(TOP)/mk/paths.mk -include $(TOP)/mk/opts.mk -include $(TOP)/mk/suffix.mk -include $(TOP)/mk/version.mk hugs98-plus-Sep2006/packages/X11/mk/target.mk0000644006511100651110000000010410504340414017326 0ustar rossrossTOP:=$(TOP)/fptools include $(TOP)/mk/target.mk TOP:=$(LIBRARY_TOP) hugs98-plus-Sep2006/packages/X11/mk/version.mk0000644006511100651110000000240310504340414017531 0ustar rossross# # Project-specific version information. # # Note: # this config file is intended to centralise all # project version information. To bump up the version # info on your package, edit this file and recompile # all the dependents. This file lives in the source tree. # # Project settings: # # ProjectVersion is treated as a *string* # ProjectVersionInt is treated as an *integer* (for cpp defines) # Versioning scheme: A.B.C # A: major version, decimal, any number of digits # B: minor version, decimal, any number of digits # C: patchlevel, one digit, omitted if zero. # # ProjectVersionInt does *not* contain the patchlevel (rationale: this # figure is used for conditional compilations, and library interfaces # etc. are not supposed to change between patchlevels). # # The ProjectVersionInt is included in interface files, and GHC # checks that it's reading interface generated by the same ProjectVersion # as itself. It does this even though interface file syntax may not # change between versions. Rationale: calling conventions or other # random .o-file stuff might change even if the .hi syntax doesn't ProjectName = X11 Haskell library ProjectNameShort = HSX11 ProjectVersion = 1.0 ProjectVersionInt = 100 ProjectPatchLevel = 0 hugs98-plus-Sep2006/packages/X11/package.conf.in0000644006511100651110000000144310504340414017756 0ustar rossross#include "HsX11Config.h" name: PACKAGE version: VERSION license: BSD3 maintainer: MAINTAINER exposed: True exposed-modules: Graphics.X11.Xlib.Atom, Graphics.X11.Xlib.Color, Graphics.X11.Xlib.Context, Graphics.X11.Xlib.Display, Graphics.X11.Xlib.Event, Graphics.X11.Xlib.Font, Graphics.X11.Xlib.Misc, Graphics.X11.Xlib.Region, Graphics.X11.Xlib.Screen, Graphics.X11.Xlib.Types, Graphics.X11.Xlib.Window, Graphics.X11.Types, Graphics.X11.Xlib, Graphics.X11 hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSX11" extra-libraries: "HSX11_cbits", "X11" include-dirs: INCLUDE_DIR includes: "HsXlib.h" depends: base hugs-options: cc-options: X_CFLAGS ld-options: X_LIBS framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/X11/prologue.txt0000644006511100651110000000033110504340414017477 0ustar rossrossA Haskell binding to the X11 library. The binding is a direct translation of C binding; for documentation of these calls, refer to /The Xlib Programming Manual/, available online at . hugs98-plus-Sep2006/packages/X11/Setup.hs0000644006511100651110000000023210504340414016536 0ustar rossrossmodule Main (main) where import Distribution.Simple (defaultMainWithHooks, defaultUserHooks) main :: IO () main = defaultMainWithHooks defaultUserHooks hugs98-plus-Sep2006/packages/X11/configure0000755006511100651110000047240610504340665017041 0ustar rossross#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.60a for Haskell X11 package 1.1. # # Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /usr/bin/posix$PATH_SEPARATOR/bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell autoconf@gnu.org about your system, echo including any error possibly output before this echo message } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='Haskell X11 package' PACKAGE_TARNAME='X11' PACKAGE_VERSION='1.1' PACKAGE_STRING='Haskell X11 package 1.1' PACKAGE_BUGREPORT='libraries@haskell.org' ac_unique_file="include/HsXlib.h" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datarootdir datadir sysconfdir sharedstatedir localstatedir includedir oldincludedir docdir infodir htmldir dvidir pdfdir psdir libdir localedir mandir DEFS ECHO_C ECHO_N ECHO_T LIBS build_alias host_alias target_alias XMKMF CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP X_CFLAGS X_PRE_LIBS X_LIBS X_EXTRA_LIBS X11_BUILD_PACKAGE BUILD_PACKAGE_BOOL LIBOBJS LTLIBOBJS' ac_subst_files='' ac_precious_vars='build_alias host_alias target_alias XMKMF CC CFLAGS LDFLAGS CPPFLAGS CPP' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` eval with_$ac_package=\$ac_optarg ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval with_$ac_package=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute directory names. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { echo "$as_me: error: Working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$0" || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # 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 Haskell X11 package 1.1 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/X11] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF X features: --x-includes=DIR X include files are in DIR --x-libraries=DIR X library files are in DIR _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of Haskell X11 package 1.1:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-x11 build a Haskell binding for X11. (default=autodetect) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-x use the X Window System Some influential environment variables: XMKMF Path to xmkmf, Makefile generator for X Window System CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF Haskell X11 package configure 1.1 generated by GNU Autoconf 2.60a Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by Haskell X11 package $as_me 1.1, which was generated by GNU Autoconf 2.60a. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then set x "$CONFIG_SITE" elif test "x$prefix" != xNONE; then set x "$prefix/share/config.site" "$prefix/etc/config.site" else set x "$ac_default_prefix/share/config.site" \ "$ac_default_prefix/etc/config.site" fi shift for ac_site_file do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Check whether --enable-x11 was given. if test "${enable_x11+set}" = set; then enableval=$enable_x11; enable_x11=$enableval else enable_x11=yes fi if test "$enable_x11" = no; then X11_BUILD_PACKAGE=no BUILD_PACKAGE_BOOL=False else # Safety check: Ensure that we are in the correct source directory. ac_config_headers="$ac_config_headers include/HsX11Config.h" # Check for X11 include paths and libraries ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO: checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; } ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # # List of possible output files, starting from the most likely. # The algorithm is not robust to junk in `.', hence go to wildcards (a.*) # only as a last resort. b.out is created by i960 compilers. ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' # # The IRIX 6 linker writes into existing files which may not be # executable, retaining their permissions. Remove them first so a # subsequent execution test works. ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { (ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi { echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6; } if test -z "$ac_file"; then echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } { echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6; } { echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext { echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT { echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; } if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; } GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CFLAGS="" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_c89+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_c89=$ac_arg else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6; } ;; xno) { echo "$as_me:$LINENO: result: unsupported" >&5 echo "${ECHO_T}unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for X" >&5 echo $ECHO_N "checking for X... $ECHO_C" >&6; } # Check whether --with-x was given. if test "${with_x+set}" = set; then withval=$with_x; fi # $have_x is `yes', `no', `disabled', or empty when we do not yet know. if test "x$with_x" = xno; then # The user explicitly disabled X. have_x=disabled else case $x_includes,$x_libraries in #( *\'*) { { echo "$as_me:$LINENO: error: Cannot use X directory names containing '" >&5 echo "$as_me: error: Cannot use X directory names containing '" >&2;} { (exit 1); exit 1; }; };; #( *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # One or both of the vars are not set, and there is no cached value. ac_x_includes=no ac_x_libraries=no rm -f -r conftest.dir if mkdir conftest.dir; then cd conftest.dir cat >Imakefile <<'_ACEOF' incroot: @echo incroot='${INCROOT}' usrlibdir: @echo usrlibdir='${USRLIBDIR}' libdir: @echo libdir='${LIBDIR}' _ACEOF if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then # GNU make sometimes prints "make[1]: Entering...", which would confuse us. for ac_var in incroot usrlibdir libdir; do eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" done # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. for ac_extension in a so sl; do if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" && test -f "$ac_im_libdir/libX11.$ac_extension"; then ac_im_usrlibdir=$ac_im_libdir; break fi done # Screen out bogus values from the imake configuration. They are # bogus both because they are the default anyway, and because # using them would break gcc on systems where it needs fixed includes. case $ac_im_incroot in /usr/include) ac_x_includes= ;; *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;; esac case $ac_im_usrlibdir in /usr/lib | /lib) ;; *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;; esac fi cd .. rm -f -r conftest.dir fi # Standard set of common directories for X headers. # Check X11 before X11Rn because it is often a symlink to the current release. ac_x_header_dirs=' /usr/X11/include /usr/X11R6/include /usr/X11R5/include /usr/X11R4/include /usr/include/X11 /usr/include/X11R6 /usr/include/X11R5 /usr/include/X11R4 /usr/local/X11/include /usr/local/X11R6/include /usr/local/X11R5/include /usr/local/X11R4/include /usr/local/include/X11 /usr/local/include/X11R6 /usr/local/include/X11R5 /usr/local/include/X11R4 /usr/X386/include /usr/x386/include /usr/XFree86/include/X11 /usr/include /usr/local/include /usr/unsupported/include /usr/athena/include /usr/local/x11r5/include /usr/lpp/Xamples/include /usr/openwin/include /usr/openwin/share/include' if test "$ac_x_includes" = no; then # Guess where to find include files, by looking for Xlib.h. # First, try using that file with no special directory specified. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # We can compile using X headers with no special include directory. ac_x_includes= else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 for ac_dir in $ac_x_header_dirs; do if test -r "$ac_dir/X11/Xlib.h"; then ac_x_includes=$ac_dir break fi done fi rm -f conftest.err conftest.$ac_ext fi # $ac_x_includes = no if test "$ac_x_libraries" = no; then # Check for the libraries. # See if we find them without any special options. # Don't add to $LIBS permanently. ac_save_LIBS=$LIBS LIBS="-lX11 $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { XrmInitialize () ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then LIBS=$ac_save_LIBS # We can link X programs with no special library path. ac_x_libraries= else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 LIBS=$ac_save_LIBS for ac_dir in `echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` do # Don't even attempt the hair of trying to link an X program! for ac_extension in a so sl; do if test -r "$ac_dir/libX11.$ac_extension"; then ac_x_libraries=$ac_dir break 2 fi done done fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi # $ac_x_libraries = no case $ac_x_includes,$ac_x_libraries in #( no,* | *,no | *\'*) # Didn't find X, or a directory has "'" in its name. ac_cv_have_x="have_x=no";; #( *) # Record where we found X for the cache. ac_cv_have_x="have_x=yes\ ac_x_includes='$ac_x_includes'\ ac_x_libraries='$ac_x_libraries'" esac fi ;; #( *) have_x=yes;; esac eval "$ac_cv_have_x" fi # $with_x != no if test "$have_x" != yes; then { echo "$as_me:$LINENO: result: $have_x" >&5 echo "${ECHO_T}$have_x" >&6; } no_x=yes else # If each of the values was on the command line, it overrides each guess. test "x$x_includes" = xNONE && x_includes=$ac_x_includes test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries # Update the cache value to reflect the command line values. ac_cv_have_x="have_x=yes\ ac_x_includes='$x_includes'\ ac_x_libraries='$x_libraries'" { echo "$as_me:$LINENO: result: libraries $x_libraries, headers $x_includes" >&5 echo "${ECHO_T}libraries $x_libraries, headers $x_includes" >&6; } fi if test "$no_x" = yes; then # Not all programs may use this symbol, but it does not hurt to define it. cat >>confdefs.h <<\_ACEOF #define X_DISPLAY_MISSING 1 _ACEOF X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS= else if test -n "$x_includes"; then X_CFLAGS="$X_CFLAGS -I$x_includes" fi # It would also be nice to do this for all -L options, not just this one. if test -n "$x_libraries"; then X_LIBS="$X_LIBS -L$x_libraries" # For Solaris; some versions of Sun CC require a space after -R and # others require no space. Words are not sufficient . . . . { echo "$as_me:$LINENO: checking whether -R must be followed by a space" >&5 echo $ECHO_N "checking whether -R must be followed by a space... $ECHO_C" >&6; } ac_xsave_LIBS=$LIBS; LIBS="$LIBS -R$x_libraries" ac_xsave_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } X_LIBS="$X_LIBS -R$x_libraries" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 LIBS="$ac_xsave_LIBS -R $x_libraries" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } X_LIBS="$X_LIBS -R $x_libraries" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { echo "$as_me:$LINENO: result: neither works" >&5 echo "${ECHO_T}neither works" >&6; } fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext ac_c_werror_flag=$ac_xsave_c_werror_flag LIBS=$ac_xsave_LIBS fi # Check for system-dependent libraries X programs must link with. # Do this before checking for the system-independent R6 libraries # (-lICE), since we may need -lsocket or whatever for X linking. if test "$ISC" = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet" else # Martyn Johnson says this is needed for Ultrix, if the X # libraries were built with DECnet support. And Karl Berry says # the Alpha needs dnet_stub (dnet does not exist). ac_xsave_LIBS="$LIBS"; LIBS="$LIBS $X_LIBS -lX11" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char XOpenDisplay (); int main () { return XOpenDisplay (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { echo "$as_me:$LINENO: checking for dnet_ntoa in -ldnet" >&5 echo $ECHO_N "checking for dnet_ntoa in -ldnet... $ECHO_C" >&6; } if test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldnet $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char dnet_ntoa (); int main () { return dnet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dnet_dnet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dnet_dnet_ntoa=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_dnet_dnet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_dnet_dnet_ntoa" >&6; } if test $ac_cv_lib_dnet_dnet_ntoa = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet" fi if test $ac_cv_lib_dnet_dnet_ntoa = no; then { echo "$as_me:$LINENO: checking for dnet_ntoa in -ldnet_stub" >&5 echo $ECHO_N "checking for dnet_ntoa in -ldnet_stub... $ECHO_C" >&6; } if test "${ac_cv_lib_dnet_stub_dnet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldnet_stub $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char dnet_ntoa (); int main () { return dnet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dnet_stub_dnet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dnet_stub_dnet_ntoa=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_dnet_stub_dnet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_dnet_stub_dnet_ntoa" >&6; } if test $ac_cv_lib_dnet_stub_dnet_ntoa = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub" fi fi fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS="$ac_xsave_LIBS" # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT, # to get the SysV transport functions. # Chad R. Larson says the Pyramis MIS-ES running DC/OSx (SVR4) # needs -lnsl. # The nsl library prevents programs from opening the X display # on Irix 5.2, according to T.E. Dickey. # The functions gethostbyname, getservbyname, and inet_addr are # in -lbsd on LynxOS 3.0.1/i386, according to Lars Hecking. { echo "$as_me:$LINENO: checking for gethostbyname" >&5 echo $ECHO_N "checking for gethostbyname... $ECHO_C" >&6; } if test "${ac_cv_func_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gethostbyname to an innocuous variant, in case declares gethostbyname. For example, HP-UX 11i declares gettimeofday. */ #define gethostbyname innocuous_gethostbyname /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gethostbyname /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char gethostbyname (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_gethostbyname || defined __stub___gethostbyname choke me #endif int main () { return gethostbyname (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gethostbyname=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_func_gethostbyname" >&6; } if test $ac_cv_func_gethostbyname = no; then { echo "$as_me:$LINENO: checking for gethostbyname in -lnsl" >&5 echo $ECHO_N "checking for gethostbyname in -lnsl... $ECHO_C" >&6; } if test "${ac_cv_lib_nsl_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnsl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char gethostbyname (); int main () { return gethostbyname (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_nsl_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_nsl_gethostbyname=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_nsl_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_lib_nsl_gethostbyname" >&6; } if test $ac_cv_lib_nsl_gethostbyname = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl" fi if test $ac_cv_lib_nsl_gethostbyname = no; then { echo "$as_me:$LINENO: checking for gethostbyname in -lbsd" >&5 echo $ECHO_N "checking for gethostbyname in -lbsd... $ECHO_C" >&6; } if test "${ac_cv_lib_bsd_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lbsd $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char gethostbyname (); int main () { return gethostbyname (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_bsd_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_bsd_gethostbyname=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_bsd_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_lib_bsd_gethostbyname" >&6; } if test $ac_cv_lib_bsd_gethostbyname = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lbsd" fi fi fi # lieder@skyler.mavd.honeywell.com says without -lsocket, # socket/setsockopt and other routines are undefined under SCO ODT # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary # on later versions), says Simon Leinen: it contains gethostby* # variants that don't use the name server (or something). -lsocket # must be given before -lnsl if both are needed. We assume that # if connect needs -lnsl, so does gethostbyname. { echo "$as_me:$LINENO: checking for connect" >&5 echo $ECHO_N "checking for connect... $ECHO_C" >&6; } if test "${ac_cv_func_connect+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define connect to an innocuous variant, in case declares connect. For example, HP-UX 11i declares gettimeofday. */ #define connect innocuous_connect /* System header to define __stub macros and hopefully few prototypes, which can conflict with char connect (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef connect /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char connect (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_connect || defined __stub___connect choke me #endif int main () { return connect (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_connect=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_connect=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_func_connect" >&5 echo "${ECHO_T}$ac_cv_func_connect" >&6; } if test $ac_cv_func_connect = no; then { echo "$as_me:$LINENO: checking for connect in -lsocket" >&5 echo $ECHO_N "checking for connect in -lsocket... $ECHO_C" >&6; } if test "${ac_cv_lib_socket_connect+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $X_EXTRA_LIBS $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char connect (); int main () { return connect (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_socket_connect=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_socket_connect=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_socket_connect" >&5 echo "${ECHO_T}$ac_cv_lib_socket_connect" >&6; } if test $ac_cv_lib_socket_connect = yes; then X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS" fi fi # Guillermo Gomez says -lposix is necessary on A/UX. { echo "$as_me:$LINENO: checking for remove" >&5 echo $ECHO_N "checking for remove... $ECHO_C" >&6; } if test "${ac_cv_func_remove+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define remove to an innocuous variant, in case declares remove. For example, HP-UX 11i declares gettimeofday. */ #define remove innocuous_remove /* System header to define __stub macros and hopefully few prototypes, which can conflict with char remove (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef remove /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char remove (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_remove || defined __stub___remove choke me #endif int main () { return remove (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_remove=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_remove=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_func_remove" >&5 echo "${ECHO_T}$ac_cv_func_remove" >&6; } if test $ac_cv_func_remove = no; then { echo "$as_me:$LINENO: checking for remove in -lposix" >&5 echo $ECHO_N "checking for remove in -lposix... $ECHO_C" >&6; } if test "${ac_cv_lib_posix_remove+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lposix $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char remove (); int main () { return remove (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_posix_remove=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_posix_remove=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_posix_remove" >&5 echo "${ECHO_T}$ac_cv_lib_posix_remove" >&6; } if test $ac_cv_lib_posix_remove = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix" fi fi # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. { echo "$as_me:$LINENO: checking for shmat" >&5 echo $ECHO_N "checking for shmat... $ECHO_C" >&6; } if test "${ac_cv_func_shmat+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define shmat to an innocuous variant, in case declares shmat. For example, HP-UX 11i declares gettimeofday. */ #define shmat innocuous_shmat /* System header to define __stub macros and hopefully few prototypes, which can conflict with char shmat (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef shmat /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char shmat (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_shmat || defined __stub___shmat choke me #endif int main () { return shmat (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_shmat=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_shmat=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_func_shmat" >&5 echo "${ECHO_T}$ac_cv_func_shmat" >&6; } if test $ac_cv_func_shmat = no; then { echo "$as_me:$LINENO: checking for shmat in -lipc" >&5 echo $ECHO_N "checking for shmat in -lipc... $ECHO_C" >&6; } if test "${ac_cv_lib_ipc_shmat+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lipc $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char shmat (); int main () { return shmat (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_ipc_shmat=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_ipc_shmat=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_ipc_shmat" >&5 echo "${ECHO_T}$ac_cv_lib_ipc_shmat" >&6; } if test $ac_cv_lib_ipc_shmat = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc" fi fi fi # Check for libraries that X11R6 Xt/Xaw programs need. ac_save_LDFLAGS=$LDFLAGS test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries" # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to # check for ICE first), but we must link in the order -lSM -lICE or # we get undefined symbols. So assume we have SM if we have ICE. # These have to be linked with before -lX11, unlike the other # libraries we check for below, so use a different variable. # John Interrante, Karl Berry { echo "$as_me:$LINENO: checking for IceConnectionNumber in -lICE" >&5 echo $ECHO_N "checking for IceConnectionNumber in -lICE... $ECHO_C" >&6; } if test "${ac_cv_lib_ICE_IceConnectionNumber+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lICE $X_EXTRA_LIBS $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char IceConnectionNumber (); int main () { return IceConnectionNumber (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_ICE_IceConnectionNumber=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_ICE_IceConnectionNumber=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_ICE_IceConnectionNumber" >&5 echo "${ECHO_T}$ac_cv_lib_ICE_IceConnectionNumber" >&6; } if test $ac_cv_lib_ICE_IceConnectionNumber = yes; then X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE" fi LDFLAGS=$ac_save_LDFLAGS fi # AC_PATH_XTRA doesn't actually check that the C compiler can # really include the X headers, so double-check here. In particular, # this will catch the case of using a mingw32 gcc on a Cygwin system: # Cygwin has the X headers & libs installed, but the mingw32 gcc can't # use them, and we want to disable the package in this case. CPPFLAGS="$CPPFLAGS $X_CFLAGS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 no_x=yes fi rm -f conftest.err conftest.$ac_ext # Build the package if we found X11 stuff if test "$no_x" = yes; then X11_BUILD_PACKAGE=no BUILD_PACKAGE_BOOL=False else X11_BUILD_PACKAGE=yes BUILD_PACKAGE_BOOL=True fi fi # Define CPP variables used in package.conf.in if test "$X11_BUILD_PACKAGE" = yes; then cat >>confdefs.h <<_ACEOF #define X_CFLAGS `echo '' $X_CFLAGS | sed -e 's/-[^ ]*/,"&"/g' -e 's/^ *,//'` _ACEOF cat >>confdefs.h <<_ACEOF #define X_LIBS `echo '' $X_LIBS | sed -e 's/-[^ ]*/,"&"/g' -e 's/^ *,//'` _ACEOF fi ac_config_files="$ac_config_files config.mk X11.buildinfo" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { echo "$as_me:$LINENO: updating cache $cache_file" >&5 echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by Haskell X11 package $as_me 1.1, which was generated by GNU Autoconf 2.60a. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for. config_files="$ac_config_files" config_headers="$ac_config_headers" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ Haskell X11 package config.status 1.1 configured by $0, generated by GNU Autoconf 2.60a, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2006 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header { echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 CONFIG_SHELL=$SHELL export CONFIG_SHELL exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "include/HsX11Config.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsX11Config.h" ;; "config.mk") CONFIG_FILES="$CONFIG_FILES config.mk" ;; "X11.buildinfo") CONFIG_FILES="$CONFIG_FILES X11.buildinfo" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } # # Set up the sed scripts for CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "$CONFIG_FILES"; then _ACEOF ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF SHELL!$SHELL$ac_delim PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim PACKAGE_NAME!$PACKAGE_NAME$ac_delim PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim PACKAGE_STRING!$PACKAGE_STRING$ac_delim PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim exec_prefix!$exec_prefix$ac_delim prefix!$prefix$ac_delim program_transform_name!$program_transform_name$ac_delim bindir!$bindir$ac_delim sbindir!$sbindir$ac_delim libexecdir!$libexecdir$ac_delim datarootdir!$datarootdir$ac_delim datadir!$datadir$ac_delim sysconfdir!$sysconfdir$ac_delim sharedstatedir!$sharedstatedir$ac_delim localstatedir!$localstatedir$ac_delim includedir!$includedir$ac_delim oldincludedir!$oldincludedir$ac_delim docdir!$docdir$ac_delim infodir!$infodir$ac_delim htmldir!$htmldir$ac_delim dvidir!$dvidir$ac_delim pdfdir!$pdfdir$ac_delim psdir!$psdir$ac_delim libdir!$libdir$ac_delim localedir!$localedir$ac_delim mandir!$mandir$ac_delim DEFS!$DEFS$ac_delim ECHO_C!$ECHO_C$ac_delim ECHO_N!$ECHO_N$ac_delim ECHO_T!$ECHO_T$ac_delim LIBS!$LIBS$ac_delim build_alias!$build_alias$ac_delim host_alias!$host_alias$ac_delim target_alias!$target_alias$ac_delim XMKMF!$XMKMF$ac_delim CC!$CC$ac_delim CFLAGS!$CFLAGS$ac_delim LDFLAGS!$LDFLAGS$ac_delim CPPFLAGS!$CPPFLAGS$ac_delim ac_ct_CC!$ac_ct_CC$ac_delim EXEEXT!$EXEEXT$ac_delim OBJEXT!$OBJEXT$ac_delim CPP!$CPP$ac_delim X_CFLAGS!$X_CFLAGS$ac_delim X_PRE_LIBS!$X_PRE_LIBS$ac_delim X_LIBS!$X_LIBS$ac_delim X_EXTRA_LIBS!$X_EXTRA_LIBS$ac_delim X11_BUILD_PACKAGE!$X11_BUILD_PACKAGE$ac_delim BUILD_PACKAGE_BOOL!$BUILD_PACKAGE_BOOL$ac_delim LIBOBJS!$LIBOBJS$ac_delim LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 54; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` if test -n "$ac_eof"; then ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` ac_eof=`expr $ac_eof + 1` fi cat >>$CONFIG_STATUS <<_ACEOF cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof /@[a-zA-Z_][a-zA-Z_0-9]*@/!b end _ACEOF sed ' s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g s/^/s,@/; s/!/@,|#_!!_#|/ :n t n s/'"$ac_delim"'$/,g/; t s/$/\\/; p N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n ' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF :end s/|#_!!_#|//g CEOF$ac_eof _ACEOF # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/ s/:*\${srcdir}:*/:/ s/:*@srcdir@:*/:/ s/^\([^=]*=[ ]*\):*/\1/ s/:*$// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF fi # test -n "$CONFIG_FILES" for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 echo "$as_me: error: Invalid tag $ac_tag." >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac ac_file_inputs="$ac_file_inputs $ac_f" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input="Generated from "`IFS=: echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} fi case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin";; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= case `sed -n '/datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p ' $ac_file_inputs` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s&@configure_input@&$configure_input&;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out"; rm -f "$tmp/out";; *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; esac ;; :H) # # CONFIG_HEADER # _ACEOF # Transform confdefs.h into a sed script `conftest.defines', that # substitutes the proper values into config.h.in to produce config.h. rm -f conftest.defines conftest.tail # First, append a space to every undef/define line, to ease matching. echo 's/$/ /' >conftest.defines # Then, protect against being on the right side of a sed subst, or in # an unquoted here document, in config.status. If some macros were # called several times there might be several #defines for the same # symbol, which is useless. But do not sort them, since the last # AC_DEFINE must be honored. ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* # These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where # NAME is the cpp macro being defined, VALUE is the value it is being given. # PARAMS is the parameter list in the macro definition--in most cases, it's # just an empty string. ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' ac_dB='\\)[ (].*,\\1define\\2' ac_dC=' ' ac_dD=' ,' uniq confdefs.h | sed -n ' t rset :rset s/^[ ]*#[ ]*define[ ][ ]*// t ok d :ok s/[\\&,]/\\&/g s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p ' >>conftest.defines # Remove the space that was appended to ease matching. # Then replace #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. # (The regexp can be short, since the line contains either #define or #undef.) echo 's/ $// s,^[ #]*u.*,/* & */,' >>conftest.defines # Break up conftest.defines: ac_max_sed_lines=50 # First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" # Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" # Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" # et cetera. ac_in='$ac_file_inputs' ac_out='"$tmp/out1"' ac_nxt='"$tmp/out2"' while : do # Write a here document: cat >>$CONFIG_STATUS <<_ACEOF # First, check the format of the line: cat >"\$tmp/defines.sed" <<\\CEOF /^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def /^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def b :def _ACEOF sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail grep . conftest.tail >/dev/null || break rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines conftest.tail echo "ac_result=$ac_in" >>$CONFIG_STATUS cat >>$CONFIG_STATUS <<\_ACEOF if test x"$ac_file" != x-; then echo "/* $configure_input */" >"$tmp/config.h" cat "$ac_result" >>"$tmp/config.h" if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else rm -f $ac_file mv "$tmp/config.h" $ac_file fi else echo "/* $configure_input */" cat "$ac_result" fi rm -f "$tmp/out12" ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi hugs98-plus-Sep2006/packages/HGL/0000755006511100651110000000000010504340734015153 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/Graphics/0000755006511100651110000000000010504340421016704 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/Graphics/HGL/0000755006511100651110000000000010504340421017316 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Draw/0000755006511100651110000000000010504340421020213 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Draw/Brush.hs0000644006511100651110000000557710504340421021650 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Draw.Brush -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Brushes, used for filling shapes. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" module Graphics.HGL.Draw.Brush ( Brush , createBrush , deleteBrush , selectBrush -- :: Brush -> Draw Brush , mkBrush -- , blackBrush, whiteBrush ) where import Graphics.HGL.Draw.Text (RGB(..)) import Graphics.HGL.Draw.Monad (Draw) import Graphics.HGL.Internals.Draw (mkDraw) #if !X_DISPLAY_MISSING import Graphics.HGL.X11.Types import qualified Graphics.X11.Xlib as X import Control.Concurrent (takeMVar, putMVar) #else import Graphics.HGL.Draw.Monad (ioToDraw, bracket) import qualified Graphics.Win32 as Win32 #endif ---------------------------------------------------------------- -- The interface ---------------------------------------------------------------- #if X_DISPLAY_MISSING newtype Brush = MkBrush Win32.HBRUSH #endif -- | Create a 'Brush'. createBrush :: RGB -> IO Brush -- | Destroy a 'Brush' created with 'createBrush'. deleteBrush :: Brush -> IO () -- | Set the 'Brush' for subsequent drawing, returning the previous setting. selectBrush :: Brush -> Draw Brush -- | Create a 'Brush' locally to a drawing. mkBrush :: RGB -> (Brush -> Draw a) -> Draw a ---------------------------------------------------------------- -- The implementation ---------------------------------------------------------------- #if !X_DISPLAY_MISSING createBrush col = return (Brush col) deleteBrush _ = return () -- ToDo: how do I set background colour for brush and pen? selectBrush b@(Brush x) = mkDraw $ \ dc -> do bs <- takeMVar (ref_bits dc) putMVar (ref_bits dc) bs{brush=b} p <- lookupColor (disp dc) x X.setForeground (disp dc) (brushGC dc) p return (brush bs) mkBrush c g = g (Brush c) #else /* X_DISPLAY_MISSING */ createBrush (RGB r g b) = do b <- Win32.createSolidBrush (Win32.rgb r g b) return (MkBrush b) deleteBrush (MkBrush b) = Win32.deleteBrush b selectBrush (MkBrush b) = mkDraw $ \hdc -> do b' <- Win32.selectBrush hdc b return (MkBrush b') mkBrush color = bracket (ioToDraw $ createBrush color) (ioToDraw . deleteBrush) ---------------------------------------------------------------- -- -- -- special cases - these should _never_ be deleted -- blackBrush :: IO Brush -- whiteBrush :: IO Brush -- -- blackBrush = Win32.getStockBrush Win32.bLACK_BRUSH >>= return . MkBrush -- whiteBrush = Win32.getStockBrush Win32.wHITE_BRUSH >>= return . MkBrush -- ---------------------------------------------------------------- #endif /* X_DISPLAY_MISSING */ hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Draw/Font.hs0000644006511100651110000001216310504340421021460 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Draw.Font -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Text fonts. -- -- Portability notes: -- -- * X11 does not directly support font rotation so 'createFont' and -- 'mkFont' always ignore the rotation angle argument in the X11 -- implementation of this library. -- -- * Many of the font families typically available on Win32 are not -- available on X11 (and /vice-versa/). In our experience, the font -- families /courier/, /helvetica/ and /times/ are somewhat portable. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" module Graphics.HGL.Draw.Font ( Font , createFont , deleteFont , selectFont -- :: Font -> Draw Font , mkFont ) where #if !X_DISPLAY_MISSING import qualified Graphics.HGL.Internals.Utilities as Utils import Graphics.HGL.X11.Types (Font(Font), DC(..), DC_Bits(..)) import Graphics.HGL.X11.Display (getDisplay) import qualified Graphics.X11.Xlib as X import Control.Concurrent.MVar (takeMVar, putMVar) #else import Graphics.HGL.Win32.Types import qualified Graphics.Win32 as Win32 #endif import Graphics.HGL.Units (Size, Angle) import Graphics.HGL.Draw.Monad (Draw, bracket, ioToDraw) import Graphics.HGL.Internals.Draw (mkDraw) ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- #if X_DISPLAY_MISSING newtype Font = MkFont Win32.HFONT #endif -- | Create a font. -- The rotation angle is ignored if the font is not a \"TrueType\" font -- (e.g., a @System@ font on Win32). createFont :: Size -- ^ size of character glyphs in pixels -> Angle -- ^ rotation angle -> Bool -- ^ bold font? -> Bool -- ^ italic font? -> String -- ^ font family -> IO Font -- | Delete a font created with 'createFont'. deleteFont :: Font -> IO () -- | Set the font for subsequent text, and return the previous font. selectFont :: Font -> Draw Font -- | Generate a font for use in a drawing, and delete it afterwards. -- The rotation angle is ignored if the font is not a \"TrueType\" font -- (e.g., a @System@ font on Win32). mkFont :: Size -- ^ size of character glyphs in pixels -> Angle -- ^ rotation angle -> Bool -- ^ bold font? -> Bool -- ^ italic font? -> String -- ^ font family -> (Font -> Draw a) -> Draw a ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- mkFont size angle bold italic family = bracket (ioToDraw $ createFont size angle bold italic family) (ioToDraw . deleteFont) #if !X_DISPLAY_MISSING createFont (width, height) escapement bold italic family = do display <- getDisplay -- print fontName r <- Utils.safeTry (X.loadQueryFont display fontName) case r of Left e -> ioError (userError $ "Unable to load font " ++ fontName) Right f -> return (Font f) where fontName = concatMap ('-':) fontParts fontParts = [ foundry , family , weight , slant , sWdth , adstyl , pxlsz , ptSz , resx , resy , spc , avgWidth , registry , encoding ] foundry = "*" -- eg "adobe" -- family = "*" -- eg "courier" weight = if bold then "bold" else "medium" slant = if italic then "i" else "r" sWdth = "normal" adstyl = "*" pxlsz = show height ptSz = "*" resx = "75" resy = "75" spc = "*" avgWidth = show (width*10) -- not sure what unit they use registry = "*" encoding = "*" deleteFont (Font f) = do display <- getDisplay X.freeFont display f selectFont f@(Font x) = mkDraw $ \ dc -> do bs <- takeMVar (ref_bits dc) putMVar (ref_bits dc) bs{font=f} X.setFont (disp dc) (textGC dc) (X.fontFromFontStruct x) return (font bs) #else /* X_DISPLAY_MISSING */ createFont (width, height) escapement bold italic family = Win32.createFont (fromDimension height) (fromDimension width) (round (escapement * 1800/pi)) 0 -- orientation weight italic False False -- italic, underline, strikeout Win32.aNSI_CHARSET Win32.oUT_DEFAULT_PRECIS Win32.cLIP_DEFAULT_PRECIS Win32.dEFAULT_QUALITY Win32.dEFAULT_PITCH family >>= return . MkFont where weight | bold = Win32.fW_BOLD | otherwise = Win32.fW_NORMAL deleteFont (MkFont f) = Win32.deleteFont f selectFont (MkFont f) = mkDraw (\hdc -> do f' <- Win32.selectFont hdc f return (MkFont f')) #endif /* X_DISPLAY_MISSING */ ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Draw/Monad.hs0000644006511100651110000000142110504340421021603 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Draw.Monad -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- The 'Draw' monad, with graphical objects as a special case. -- ----------------------------------------------------------------------------- module Graphics.HGL.Draw.Monad ( Graphic -- = Draw () , Draw , ioToDraw -- :: IO a -> Draw a , bracket -- :: Draw a -> (a -> Draw b) -> (a -> Draw c) -> Draw c , bracket_ -- :: Draw a -> (a -> Draw b) -> Draw c -> Draw c ) where import Graphics.HGL.Internals.Draw hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Draw/Pen.hs0000644006511100651110000000727010504340421021277 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Draw.Pen -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Pens, used for drawing lines. -- -- Portability notes: -- -- * On Win32, the pen is also used to draw a line round all the filled -- shapes --- so the pen color also affects how polygons, ellipses -- and regions are drawn. -- -- * On Win32, the 'Style' is ignored (i.e. treated as 'Solid') for pens -- of width greater than 1. This problem does not apply to X11. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" module Graphics.HGL.Draw.Pen ( Pen , Style(Solid, Dash, Dot, DashDot, DashDotDot, Null, InsideFrame) , createPen -- :: Style -> Int -> RGB -> IO Pen , deletePen , selectPen -- :: Pen -> Draw Pen , mkPen -- :: Style -> Int -> RGB -> (Pen -> Draw a) -> Draw a ) where import Graphics.HGL.Draw.Text (RGB) import Graphics.HGL.Draw.Monad (Draw, ioToDraw) import Graphics.HGL.Internals.Types (Style(..)) import Graphics.HGL.Internals.Draw (mkDraw) #if !X_DISPLAY_MISSING import Graphics.HGL.X11.Types import Graphics.HGL.X11.Display import qualified Graphics.X11.Xlib as X import Control.Concurrent (takeMVar, putMVar) #else import Graphics.HGL.Win32.Types import qualified Graphics.Win32 as Win32 import Graphics.HGL.Draw.Monad (bracket) #endif ---------------------------------------------------------------- #if X_DISPLAY_MISSING newtype Pen = Pen Win32.HPEN #endif -- | Create a 'Pen'. createPen :: Style -> Int -> RGB -> IO Pen -- | Destroy a 'Pen' created with 'createPen'. deletePen :: Pen -> IO () -- | Set the 'Pen' for subsequent drawing, returning the previous setting. selectPen :: Pen -> Draw Pen -- | Create a 'Pen' locally to a drawing. mkPen :: Style -> Int -> RGB -> (Pen -> Draw a) -> Draw a ---------------------------------------------------------------- #if !X_DISPLAY_MISSING ---------------------------------------------------------------- -- Pens -- -- Used to draw lines and boundaries of filled shapes ---------------------------------------------------------------- createPen style width col = do display <- getDisplay pixel <- lookupColor display col return (Pen style width pixel) deletePen _ = return () -- ToDo: how do I set background colour for brush and pen? selectPen p@(Pen _ lwidth c) = mkDraw $ \ dc -> do bs <- takeMVar (ref_bits dc) putMVar (ref_bits dc) bs{pen=p} X.setForeground (disp dc) (paintGC dc) c X.setLineAttributes (disp dc) (paintGC dc) lwidth X.lineSolid X.capButt X.joinMiter return (pen bs) mkPen style width color g = do p <- ioToDraw $ createPen style width color g p #else /* X_DISPLAY_MISSING */ style :: Style -> Win32.PenStyle style Solid = Win32.pS_SOLID style Dash = Win32.pS_DASH style Dot = Win32.pS_DOT style DashDot = Win32.pS_DASHDOT style DashDotDot = Win32.pS_DASHDOTDOT style Null = Win32.pS_NULL style InsideFrame = Win32.pS_INSIDEFRAME createPen sty width c = Win32.createPen (style sty) (fromIntegral width) (fromRGB c) >>= return . Pen deletePen (Pen pen) = Win32.deletePen pen selectPen (Pen p) = mkDraw (\hdc -> do p' <- Win32.selectPen hdc p return (Pen p')) mkPen sty width c = bracket (ioToDraw $ createPen sty width c) (ioToDraw . deletePen) #endif /* X_DISPLAY_MISSING */ ---------------------------------------------------------------- -- The end ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Draw/Picture.hs0000644006511100651110000001474210504340421022172 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Draw.Picture -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Drawing various shapes. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" module Graphics.HGL.Draw.Picture ( arc, ellipse, shearEllipse , line, polyline, polygon , polyBezier -- becomes error message and polyline in X11 ) where #if !X_DISPLAY_MISSING import Graphics.HGL.X11.Types import qualified Graphics.X11.Xlib as X import System.IO.Unsafe(unsafePerformIO) import System.IO(stderr, hPutStrLn) #else import Graphics.HGL.Win32.Types import qualified Graphics.Win32 as Win32 #endif import Graphics.HGL.Draw.Monad(Graphic) import Graphics.HGL.Internals.Draw(mkDraw) import Graphics.HGL.Units ---------------------------------------------------------------- -- The Interface (SOE, p50) ---------------------------------------------------------------- -- | A filled arc from an ellipse. arc :: Point -- ^ a corner of the rectangle bounding the ellipse. -> Point -- ^ the opposite corner of the rectangle bounding the ellipse. -> Angle -- ^ the start angle of the arc, measured counter-clockwise -- from the horizontal. -> Angle -- ^ the extent of the arc, measured counter-clockwise from -- the start angle. -> Graphic -- ^ a filled shape -- | A filled ellipse that fits inside a rectangle defined by two -- 'Point's on the window. ellipse :: Point -- ^ a corner of the rectangle bounding the ellipse. -> Point -- ^ the opposite corner of the rectangle bounding the ellipse. -> Graphic -- ^ a filled shape -- | A filled sheared ellipse that fits inside a parallelogram defined -- by three 'Point's on the window. This function is implemented using -- polygons on both Win32 and X11. shearEllipse :: Point -- ^ a corner of the bounding parallelogram. -> Point -- ^ another corner of the parallelogram, adjacent to the first. -> Point -- ^ another corner of the parallelogram, adjacent to the first -- and thus opposite to the second. -> Graphic -- ^ a filled shape -- | A filled polygon defined by a list of 'Point's. polygon :: [Point] -> Graphic -- filled -- | A line between two 'Point's. line :: Point -> Point -> Graphic -- unfilled -- | A series of lines through a list of 'Point's. polyline :: [Point] -> Graphic -- unfilled -- | A series of (unfilled) Bezier curves defined by a list of 3/n/+1 -- control 'Point's. This function is not supported on X11 (it yields -- an error message and a 'polyline'). polyBezier :: [Point] -> Graphic -- unfilled ---------------------------------------------------------------- -- The Implementation ---------------------------------------------------------------- #if !X_DISPLAY_MISSING arc (x0,y0) (x1,y1) s e = mkDraw (\ dc -> X.fillArc (disp dc) (drawable dc) (paintGC dc) x' y' w' h' s' e') where (x,w) = minAndDelta x0 x1 (y,h) = minAndDelta y0 y1 x' = fromIntegral x y' = fromIntegral y w' = fromIntegral w h' = fromIntegral h s' = round (s * 64) e' = round (e * 64) ellipse (x0,y0) (x1,y1) = mkDraw (\ dc -> X.fillArc (disp dc) (drawable dc) (brushGC dc) x' y' w' h' 0 threeSixty) where (x,w) = minAndDelta x0 x1 (y,h) = minAndDelta y0 y1 x' = fromIntegral x y' = fromIntegral y w' = fromIntegral w h' = fromIntegral h -- X measures angles in 64ths of a degree threeSixty :: Int threeSixty = 360*64 shearEllipse p0 p1 p2 = mkDraw (\ dc -> X.fillPolygon (disp dc) (drawable dc) (brushGC dc) pts X.convex X.coordModeOrigin) where X.Point x0 y0 = fromPoint p0 X.Point x1 y1 = fromPoint p1 X.Point x2 y2 = fromPoint p2 x = avg x1 x2 -- centre of parallelogram y = avg y1 y2 dx1 = fromIntegral ((x1 - x0) `div` 2) -- distance to corners from centre dy1 = fromIntegral ((y1 - y0) `div` 2) dx2 = fromIntegral ((x2 - x0) `div` 2) dy2 = fromIntegral ((y2 - y0) `div` 2) pts = [ X.Point (x + round(c*dx1 + s*dx2)) (y + round(c*dy1 + s*dy2)) | (c,s) <- cos'n'sins ] cos'n'sins :: [(Double,Double)] cos'n'sins = [ (cos a, sin a) | a <- angles ] angles :: [Angle] angles = take 40 [0, pi/20 .. ] line p0 p1 = mkDraw (\ dc -> X.drawLine (disp dc) (drawable dc) (paintGC dc) x0 y0 x1 y1) where X.Point x0 y0 = fromPoint p0 X.Point x1 y1 = fromPoint p1 polyline pts = mkDraw (\ dc -> X.drawLines (disp dc) (drawable dc) (paintGC dc) (map fromPoint pts) X.coordModeOrigin) polygon pts = mkDraw (\ dc -> X.fillPolygon (disp dc) (drawable dc) (brushGC dc) (map fromPoint pts) X.complex X.coordModeOrigin) polyBezier = unsafePerformIO $ do hPutStrLn stderr "warning: polyBezier is unavailable in X11 -- using polyline instead" return polyline ---------------------------------------------------------------- -- Utilities ---------------------------------------------------------------- -- delta is always +ve minAndDelta :: Int -> Int -> (Int,Int) minAndDelta a b | a <= b = (a, b-a) | otherwise = (b, a-b) -- avg :: Int32 -> Int32 -> Int32 avg :: Integral a => a -> a -> a avg a b = (a + b) `div` 2 #else /* X_DISPLAY_MISSING */ arc p0 p1 start end = mkDraw (\ hdc -> Win32.arc hdc x0 y0 x1 y1 xs ys xe ye) where (x0,y0) = fromPoint p0 (x1,y1) = fromPoint p1 x = (x0 + x1) `div` 2 y = (y0 + y1) `div` 2 start' = 2 * pi * start / 360 end' = 2 * pi * end / 360 xs = x + round (100 * cos start') ys = y + round (100 * sin start') xe = x + round (100 * cos end') ye = y + round (100 * sin end') ellipse p0 p1 = mkDraw (\ hdc -> Win32.ellipse hdc x0 y0 x1 y1) where (x0,y0) = fromPoint p0 (x1,y1) = fromPoint p1 shearEllipse p0 p1 p2 = mkDraw (\ hdc -> Win32.transformedEllipse hdc (fromPoint p0) (fromPoint p1) (fromPoint p2)) line p0 p1 = mkDraw (\ hdc -> Win32.moveToEx hdc x0 y0 >> Win32.lineTo hdc x1 y1) where (x0,y0) = fromPoint p0 (x1,y1) = fromPoint p1 polyline pts = mkDraw (\ hdc -> Win32.polyline hdc (map fromPoint pts)) polygon pts = mkDraw (\ hdc -> Win32.polygon hdc (map fromPoint pts)) polyBezier pts = mkDraw (\ hdc -> Win32.polyBezier hdc (map fromPoint pts)) #endif /* X_DISPLAY_MISSING */ ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Draw/Region.hs0000644006511100651110000001411310504340421021772 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Draw.Region -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- An efficient representation of sets of pixels. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" module Graphics.HGL.Draw.Region ( Region #if !X_DISPLAY_MISSING , emptyRegion -- :: Region #endif , rectangleRegion -- :: Point -> Point -> Region , ellipseRegion -- :: Point -> Point -> Region , polygonRegion -- :: [Point] -> Region , intersectRegion -- :: Region -> Region -> Region , unionRegion -- :: Region -> Region -> Region , subtractRegion -- :: Region -> Region -> Region , xorRegion -- :: Region -> Region -> Region , regionToGraphic -- :: Region -> Graphic ) where import Graphics.HGL.Units (Point, Angle) import Graphics.HGL.Draw.Monad (Graphic) import Graphics.HGL.Internals.Draw (mkDraw) #if !X_DISPLAY_MISSING import Graphics.HGL.X11.Types (DC(..), fromPoint) import qualified Graphics.X11.Xlib as X #else import Graphics.HGL.Win32.Types import qualified Graphics.Win32 as Win32 #endif import System.IO.Unsafe( unsafePerformIO ) ---------------------------------------------------------------- -- The Interface (SOE, p136) -- -- Note that Win32 does not include emptyRegion (SOE, p140). -- The obvious Win32 implementation (an empty rectangle) could create problems -- when you calculate the bounding box -- (This could be fixed by implementing Empty Regions explicitly in Haskell -- at the (small) cost of an extra test on every region operation.) ---------------------------------------------------------------- #if !X_DISPLAY_MISSING newtype Region = MkRegion X.Region #else newtype Region = MkRegion Win32.HRGN #endif #if !X_DISPLAY_MISSING -- | An empty region. This is not supported on Win32. -- It is possible to use an empty rectangle region instead. emptyRegion :: Region #endif -- | A rectangular region, with the given points as opposite corners. rectangleRegion :: Point -> Point -> Region -- | An elliptical region that fits in the rectangle with the given points -- as opposite corners. ellipseRegion :: Point -> Point -> Region -- | A polygonal region defined by a list of 'Point's. polygonRegion :: [Point] -> Region -- | The intersection of two regions. intersectRegion :: Region -> Region -> Region -- | The union of two regions. unionRegion :: Region -> Region -> Region -- | The part of the first region that is not also in the second. subtractRegion :: Region -> Region -> Region -- | The symmetric difference of two regions. xorRegion :: Region -> Region -> Region -- | Fill a 'Region' using the current 'Graphics.HGL.Draw.Brush'. regionToGraphic :: Region -> Graphic ---------------------------------------------------------------- -- The Implementation ---------------------------------------------------------------- #if !X_DISPLAY_MISSING emptyXRegion = unsafePerformIO X.createRegion emptyRegion = MkRegion emptyXRegion rectangleRegion (x0,y0) (x1,y1) = polygonRegion [(x0,y0),(x0,y1),(x1,y1),(x1,y0)] ellipseRegion p0 p1 = MkRegion $ unsafePerformIO $ do X.polygonRegion pts X.evenOddRule where X.Point x0 y0 = fromPoint p0 X.Point x1 y1 = fromPoint p1 rx = (x1 - x0) `div` 2 ry = (y1 - y0) `div` 2 cx = x0 + rx cy = y0 + ry rx' = fromIntegral rx ry' = fromIntegral ry pts = [ X.Point (cx + round (rx' * c)) (cy + round (ry' * s)) | (c,s) <- cos'n'sins ] cos'n'sins :: [(Double,Double)] cos'n'sins = [ (cos a, sin a) | a <- angles ] angles :: [Angle] angles = take 40 [0, pi/20 .. ] polygonRegion pts = MkRegion $ unsafePerformIO $ do X.polygonRegion (map fromPoint pts) X.evenOddRule intersectRegion = combine X.intersectRegion unionRegion = combine X.unionRegion subtractRegion = combine X.subtractRegion xorRegion = combine X.xorRegion type XRegionOp = X.Region -> X.Region -> X.Region -> IO Int combine :: XRegionOp -> Region -> Region -> Region combine op (MkRegion r1) (MkRegion r2) = unsafePerformIO $ do r <- X.createRegion op r1 r2 r return (MkRegion r) regionToGraphic (MkRegion r) = mkDraw $ \ dc -> do X.setRegion (disp dc) (brushGC dc) r X.fillRectangle (disp dc) (drawable dc) (brushGC dc) 0 0 (-1) (-1) -- entire window (in 2s complement!) X.setRegion (disp dc) (brushGC dc) emptyXRegion return () #else /* X_DISPLAY_MISSING */ rectangleRegion pt0 pt1 = unsafePerformIO $ do r <- Win32.createRectRgn x0 y0 x1 y1 return (MkRegion r) where (x0,y0) = fromPoint pt0 (x1,y1) = fromPoint pt1 -- Sigh! createEllipticRgn raises an exception if either dimension -- of the ellipse is empty. We hack around this by using rectangleRegion -- in the problematic case (since createRectRgn behaves sensibly). ellipseRegion pt0 pt1 | x0 /= x1 && y0 /= y1 = unsafePerformIO $ do r <- Win32.createEllipticRgn x0 y0 x1 y1 return (MkRegion r) | otherwise = rectangleRegion pt0 pt1 where (x0,y0) = fromPoint pt0 (x1,y1) = fromPoint pt1 polygonRegion pts = unsafePerformIO $ do r <- Win32.createPolygonRgn (map fromPoint pts) Win32.wINDING return (MkRegion r) -- combine :: Win32.ClippingMode -> Region -> Region -> Region -> IO () -- combine mode (MkRegion r1) (MkRegion r2) (MkRegion result) = do -- Win32.combineRgn result r1 r2 mode -- return () combine :: Win32.ClippingMode -> Region -> Region -> Region combine mode (MkRegion r1) (MkRegion r2) = unsafePerformIO $ do r <- Win32.createRectRgn 0 0 0 0 Win32.combineRgn r r1 r2 mode return (MkRegion r) regionToGraphic (MkRegion r) = mkDraw (\hdc -> Win32.paintRgn hdc r) intersectRegion = combine Win32.rGN_AND unionRegion = combine Win32.rGN_OR xorRegion = combine Win32.rGN_XOR subtractRegion = combine Win32.rGN_DIFF #endif /* X_DISPLAY_MISSING */ ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Draw/Text.hs0000644006511100651110000001631310504340421021477 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Draw.Text -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Drawing text. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" module Graphics.HGL.Draw.Text ( -- * Drawing text text -- ToDo: add textInfo to Win32 #if !X_DISPLAY_MISSING , textInfo #endif -- * Color , RGB(RGB) , setTextColor -- :: RGB -> Draw RGB , setBkColor -- :: RGB -> Draw RGB , BkMode(Opaque, Transparent) , setBkMode -- :: BkMode -> Draw BkMode -- * Alignment , Alignment -- = (HAlign, VAlign) , HAlign(Left', Center, Right') , VAlign(Top, Baseline, Bottom) , setTextAlignment -- :: Alignment -> Draw Alignment ) where #if !X_DISPLAY_MISSING import qualified Graphics.X11.Xlib as X import Graphics.HGL.X11.Types import Control.Concurrent.MVar (readMVar, takeMVar, putMVar) #else import qualified Graphics.Win32 as Win32 import Graphics.HGL.Win32.Types import Data.Bits #endif import Graphics.HGL.Units (Point, Size) import Graphics.HGL.Draw.Monad (Graphic, Draw) import Graphics.HGL.Internals.Draw (mkDraw) import Graphics.HGL.Internals.Types (RGB(..), BkMode(..), Alignment, HAlign(..), VAlign(..)) ---------------------------------------------------------------- -- The Interface (SOE, p50) ---------------------------------------------------------------- -- | Render a 'String' positioned relative to the specified 'Point'. text :: Point -> String -> Graphic -- filled #if !X_DISPLAY_MISSING -- | @'textInfo' s@ returns: -- -- (1) The offset at which the string would be drawn according to the -- current text alignment (e.g., @('Center', 'Baseline')@ will result -- in an offset of (-width\/2,0)) -- -- (2) The size at which the text would be drawn using the current font. -- textInfo :: String -> Draw (Point,Size) #endif -- | Set the foreground color for drawing text, returning the previous value. setTextColor :: RGB -> Draw RGB -- | Set the background color for drawing text, returning the previous value. -- The background color is ignored when the mode is 'Transparent'. setBkColor :: RGB -> Draw RGB -- | Set the background mode for drawing text, returning the previous value. setBkMode :: BkMode -> Draw BkMode -- | Set the alignment for drawing text, returning the previous value. setTextAlignment :: Alignment -> Draw Alignment ---------------------------------------------------------------- -- The Implementation ---------------------------------------------------------------- #if !X_DISPLAY_MISSING text p s = mkDraw (\ dc -> do bs <- readMVar (ref_bits dc) let Font f = font bs (halign, valign) = textAlignment bs width = X.textWidth f s ascent = X.ascentFromFontStruct f descent = X.descentFromFontStruct f x' = case halign of Left' -> x Center -> x - width `div` 2 Right' -> x - width + 1 y' = case valign of Top -> y + ascent Baseline -> y Bottom -> y - descent + 1 draw (bkMode bs) (disp dc) (drawable dc) (textGC dc) x' y' s ) where X.Point x y = fromPoint p -- Win32's DeviceContext has a BkMode in it. In X, we call two different -- routines depending on what mode we want. draw Transparent = X.drawString draw Opaque = X.drawImageString textInfo s = mkDraw $ \ dc -> do bs <- readMVar (ref_bits dc) let Font f = font bs (halign, valign) = textAlignment bs width = X.textWidth f s ascent = X.ascentFromFontStruct f descent = X.descentFromFontStruct f x1 = case halign of Left' -> 0 Center -> - width `div` 2 Right' -> - width + 1 y1 = case valign of Top -> ascent Baseline -> 0 Bottom -> - descent + 1 x2 = x1 + width y2 = y1 + ascent + descent (x1',x2') = (min x1 x2, max x1 x2) (y1',y2') = (min y1 y2, max y1 y2) return (toPoint (X.Point x1 y1), toSize (fromIntegral (x2'-x1'), fromIntegral (y2'-y1'))) setTextColor x = mkDraw $ \ dc -> do bs <- takeMVar (ref_bits dc) putMVar (ref_bits dc) bs{textColor=x} p <- lookupColor (disp dc) x X.setForeground (disp dc) (textGC dc) p return (textColor bs) setBkColor x = mkDraw $ \ dc -> do bs <- takeMVar (ref_bits dc) putMVar (ref_bits dc) bs{bkColor=x} p <- lookupColor (disp dc) x X.setBackground (disp dc) (textGC dc) p return (bkColor bs) setBkMode x = mkDraw $ \ dc -> do bs <- takeMVar (ref_bits dc) putMVar (ref_bits dc) bs{bkMode=x} return (bkMode bs) setTextAlignment x = mkDraw $ \ dc -> do bs <- takeMVar (ref_bits dc) putMVar (ref_bits dc) bs{textAlignment=x} return (textAlignment bs) #else /* X_DISPLAY_MISSING */ type TextAlignment = Win32.TextAlignment fromAlignment :: Alignment -> TextAlignment fromAlignment (ha,va) = hAlign ha .|. vAlign va hAlign :: HAlign -> TextAlignment hAlign Left' = Win32.tA_LEFT hAlign Center = Win32.tA_CENTER hAlign Right' = Win32.tA_RIGHT vAlign :: VAlign -> TextAlignment vAlign Top = Win32.tA_TOP vAlign Baseline = Win32.tA_BASELINE vAlign Bottom = Win32.tA_BOTTOM toAlignment :: TextAlignment -> Alignment toAlignment x = (toHAlign (x .&. hmask), toVAlign (x .&. vmask)) toHAlign x | x == Win32.tA_LEFT = Left' | x == Win32.tA_CENTER = Center | x == Win32.tA_RIGHT = Right' | otherwise = Center -- safe(?) default toVAlign x | x == Win32.tA_TOP = Top | x == Win32.tA_BASELINE = Baseline | x == Win32.tA_BOTTOM = Bottom | otherwise = Baseline -- safe(?) default -- Win32 doesn't seem to provide the masks I need - these ought to work. hmask = Win32.tA_LEFT .|. Win32.tA_CENTER .|. Win32.tA_RIGHT vmask = Win32.tA_TOP .|. Win32.tA_BASELINE .|. Win32.tA_BOTTOM fromBkMode :: BkMode -> Win32.BackgroundMode fromBkMode Opaque = Win32.oPAQUE fromBkMode Transparent = Win32.tRANSPARENT toBkMode :: Win32.BackgroundMode -> BkMode toBkMode x | x == Win32.oPAQUE = Opaque | x == Win32.tRANSPARENT = Transparent -- ToDo: add an update mode for these constants -- (not required at the moment since we always specify exactly where -- the text is to go) -- tA_NOUPDATECP :: TextAlignment -- tA_UPDATECP :: TextAlignment text (x,y) s = mkDraw $ \ hdc -> Win32.textOut hdc (fromDimension x) (fromDimension y) s setTextColor c = mkDraw (\hdc -> do c' <- Win32.setTextColor hdc (fromRGB c) return (toRGB c')) setBkColor c = mkDraw (\hdc -> do c' <- Win32.setBkColor hdc (fromRGB c) return (toRGB c')) setBkMode m = mkDraw (\hdc -> do m' <- Win32.setBkMode hdc (fromBkMode m) return (toBkMode m')) setTextAlignment new_alignment = mkDraw (\hdc -> do old <- Win32.setTextAlign hdc (fromAlignment new_alignment) return (toAlignment old) ) #endif /* X_DISPLAY_MISSING */ ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Core.hs0000644006511100651110000000143210504340421020542 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Core -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Core functions of a simple graphics library. -- ----------------------------------------------------------------------------- module Graphics.HGL.Core ( module Graphics.HGL.Units , module Graphics.HGL.Run , module Graphics.HGL.Window , module Graphics.HGL.Draw , module Graphics.HGL.Key ) where import Graphics.HGL.Units import Graphics.HGL.Run import Graphics.HGL.Window import Graphics.HGL.Draw import Graphics.HGL.Key hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Internals/0000755006511100651110000000000010504340421021255 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Internals/Utilities.hs0000644006511100651110000000253210504340421023566 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Internals.Utilities -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (requires concurrency) -- -- A simple graphics library. -- ----------------------------------------------------------------------------- -- #hide module Graphics.HGL.Internals.Utilities( bracket, bracket_, safeTry, E.Exception, modMVar, modMVar_ ) where import qualified Control.Exception as E (bracket, try, Exception) import Control.Concurrent( MVar, takeMVar, putMVar ) bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket = E.bracket -- Not exactly the same type as GHC's bracket_ bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c bracket_ left right m = bracket left right (const m) safeTry :: IO a -> IO (Either E.Exception a) safeTry = E.try ---------------------------------------------------------------- -- Utilities ---------------------------------------------------------------- modMVar :: MVar a -> (a -> a) -> IO a modMVar mv f = do x <- takeMVar mv putMVar mv (f x) return x modMVar_ :: MVar a -> (a -> a) -> IO () modMVar_ mv f = do x <- takeMVar mv putMVar mv (f x) hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Internals/Draw.hs0000644006511100651110000000570410504340421022514 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Internals.Draw -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (requires concurrency) -- -- Drawing in a simple graphics library. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" -- #hide module Graphics.HGL.Internals.Draw ( Graphic -- = Draw () , Draw , ioToDraw -- :: IO a -> Draw a , bracket -- :: Draw a -> (a -> Draw b) -> (a -> Draw c) -> Draw c , bracket_ -- :: Draw a -> (a -> Draw b) -> Draw c -> Draw c , unDraw -- :: Draw a -> (DC -> IO a) , mkDraw -- :: (DC -> IO a) -> Draw a ) where #if !X_DISPLAY_MISSING import Graphics.HGL.X11.Types(DC) #else import Graphics.HGL.Win32.Types(DC) #endif import qualified Graphics.HGL.Internals.Utilities as Utils (bracket, bracket_) import Control.Monad (liftM) ---------------------------------------------------------------- -- Graphics ---------------------------------------------------------------- -- | An abstract representation of an image. type Graphic = Draw () -- | Monad for sequential construction of images. newtype Draw a = MkDraw (DC -> IO a) unDraw :: Draw a -> (DC -> IO a) unDraw (MkDraw m) = m -- | Embed an 'IO' action in a drawing action. ioToDraw :: IO a -> Draw a ioToDraw m = MkDraw (\ _ -> m) mkDraw :: (DC -> IO a) -> Draw a mkDraw = MkDraw -- a standard reader monad instance Monad Draw where return a = MkDraw (\ hdc -> return a) m >>= k = MkDraw (\ hdc -> do { a <- unDraw m hdc; unDraw (k a) hdc }) m >> k = MkDraw (\ dc -> do { unDraw m dc; unDraw k dc }) instance Functor Draw where fmap = liftM -- | Wrap a drawing action in initialization and finalization actions. bracket :: Draw a -- ^ a pre-operation, whose value is passed to the -- other two components. -> (a -> Draw b) -- ^ a post-operation, to be performed on exit from -- the bracket, whether normal or by an exception. -> (a -> Draw c) -- ^ the drawing action inside the bracket. -> Draw c bracket left right m = MkDraw (\ hdc -> Utils.bracket (unDraw left hdc) (\ a -> unDraw (right a) hdc) (\ a -> unDraw (m a) hdc)) -- | A variant of 'bracket' in which the inner drawing action does not -- use the result of the pre-operation. bracket_ :: Draw a -- ^ a pre-operation, whose value is passed to the -- other two components. -> (a -> Draw b) -- ^ a post-operation, to be performed on exit from -- the bracket, whether normal or by an exception. -> Draw c -- ^ the drawing action inside the bracket. -> Draw c bracket_ left right m = MkDraw (\ hdc -> Utils.bracket_ (unDraw left hdc) (\ a -> unDraw (right a) hdc) (unDraw m hdc)) ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Internals/Event.hs0000644006511100651110000000626210504340421022700 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Internals.Event -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (requires concurrency) -- -- Events in a simple graphics library. -- ----------------------------------------------------------------------------- -- #hide module Graphics.HGL.Internals.Event ( Event(..) -- , Event(Char,Key,Button,MouseMove,Resize,Closed) -- deriving(Show) -- , char -- :: Event -> Char -- , keysym -- :: Event -> Key -- , isDown -- :: Event -> Bool -- , pt -- :: Event -> Point -- , isLeft -- :: Event -> Bool ) where import Graphics.HGL.Key (Key) import Graphics.HGL.Internals.Types (Point) -- We probably need a lot more info about the event -- but this will do for now. ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- -- Note: The Char event is for delivering properly translated characters -- after a key*press*. At least under X, a single key press might yield -- 0, 1 or more characters after translation (see X[mb]LookupString). -- The Key event is intended for reporting key up/down events of -- *abstract* keys, i.e. KeySyms rather than KeyCodes in X terms. -- To make it possible to report such events for arrow keys, function -- keys and the like, the Char field needs to be replaced by a field of -- a type somewhat isomorphic to KeySym, but valid under Windows too. -- | A user interface event. -- -- Notes: -- -- * Programmers should assume that the 'Event' datatype will be -- extended in the not-too-distant future and that individual events -- may change slightly. As a minimum, you should add a \"match anything\" -- alternative to any function which pattern matches against 'Event's. -- -- * X11 systems typically have three button mice. Button 1 is used as the -- left button, button 3 as the right button and button 2 (the middle -- button) is ignored. data Event = Char { char :: Char -- ^ the character represented by a key combination } -- ^ a properly translated character, sent after -- a key press. | Key { keysym :: Key -- ^ representation of the keyboard keys pressed , isDown :: Bool -- ^ if 'True', the key was pressed; -- otherwise it was released } -- ^ occurs when a key was pressed or released. | Button { pt :: Point -- ^ the position of the mouse cursor , isLeft :: Bool -- ^ if 'True', it was the left button , isDown :: Bool -- ^ if 'True', the button was pressed; -- otherwise it was released } -- ^ occurs when a mouse button is pressed or released. | MouseMove { pt :: Point -- ^ the position of the mouse cursor after the movement } -- ^ occurs when the mouse is moved inside the window. | Resize -- ^ occurs when the window is resized. | Closed -- ^ occurs when the window is closed. deriving Show ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Internals/Events.hs0000644006511100651110000000446110504340421023062 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Internals.Events -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (requires concurrency) -- -- A simple graphics library. -- ----------------------------------------------------------------------------- -- #hide module Graphics.HGL.Internals.Events( Events, newEvents, getEvent, sendEvent, isNoEvent, getTick, sendTick ) where import Graphics.HGL.Internals.Event import Graphics.HGL.Internals.Flag import Control.Concurrent.Chan(Chan, newChan, readChan, writeChan, isEmptyChan) ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- -- Events are more or less just a channel (~list) of events -- -- The only subtlety is that ticks are not part of the channel: -- they're a separate "flag" so that ticks don't accumulate in the -- queue (if you process them too fast) and so that ticks can -- "overtake" other events. -- (Win32 timers do the same thing. I was rather surprised to find -- myself reimplementing this in Haskell (even in the Win32 version -- of the Graphics library). Exposure events in X11 behave in a -- similar way except that they do not overtake other events.) data Events = Events { events :: Chan Event , tick :: Flag () } newEvents :: IO Events getEvent :: Events -> IO Event isNoEvent :: Events -> IO Bool sendEvent :: Events -> Event -> IO () sendTick :: Events -> IO () getTick :: Events -> IO () ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- newEvents = do events <- newChan tick <- newFlag return (Events { events=events, tick=tick }) getEvent evs = readChan (events evs) isNoEvent evs = isEmptyChan (events evs) sendEvent evs = writeChan (events evs) sendTick evs = setFlag (tick evs) () getTick evs = resetFlag (tick evs) ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Internals/Flag.hs0000644006511100651110000000332010504340421022460 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Internals.Flag -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (requires concurrency) -- -- A simple graphics library. -- ----------------------------------------------------------------------------- -- #hide module Graphics.HGL.Internals.Flag ( Flag, newFlag, setFlag, resetFlag ) where import Control.Concurrent.MVar ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar ) ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- -- We maintain a list of blocked processes. -- Blocked processes are "stored" in MVars; the outer MVar -- is used to implement a critical section. newtype Flag a = Flag (MVar [MVar a]) newFlag :: IO (Flag a) -- sets the flag, never blocks, never fails setFlag :: Flag a -> a -> IO () -- block until the flag is set (and reset it) resetFlag :: Flag a -> IO a ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- newFlag = do queue <- newMVar [] return (Flag queue) setFlag (Flag queue) a = do ps <- takeMVar queue mapM_ (\ p -> putMVar p a) ps putMVar queue [] resetFlag (Flag queue) = do ps <- takeMVar queue p <- newEmptyMVar putMVar queue (p:ps) takeMVar p -- block ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Internals/Types.hs0000644006511100651110000000645010504340421022722 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Internals.Types -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : portable -- -- Basic types for a simple graphics library. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" -- #hide module Graphics.HGL.Internals.Types where #if !X_DISPLAY_MISSING import qualified Graphics.X11.Xlib as X #else import Graphics.Win32.Misc(timeGetTime) import Control.Monad( liftM ) #endif import Data.Ix(Ix) import Data.Word(Word8) ---------------------------------------------------------------- -- Units ---------------------------------------------------------------- -- | A distance on the screen, measured in pixels. type Dimension = Int -- | A position within a window, measured in pixels to the right and down -- from the top left corner. type Point = (Int,Int) -- | A (width, height) pair, both measured in pixels. type Size = (Int,Int) -- | An angle in degrees (0 to 360). type Angle = Double -- | Time, measured in milliseconds. type Time = Integer -- | Time in milliseconds since some arbitrary epoch. getTime :: IO Integer #if !X_DISPLAY_MISSING getTime = X.gettimeofday_in_milliseconds #else getTime = liftM toInteger timeGetTime #endif --------------------------------------------------------------- -- Drawing ---------------------------------------------------------------- -- | A color, comprising red, green and blue components. data RGB = RGB Word8 Word8 Word8 -- | The style of line drawn by a pen. data Style = Solid | Dash -- "-------" | Dot -- "......." | DashDot -- "_._._._" | DashDotDot -- "_.._.._" | Null | InsideFrame -- | Background mode for drawing text. data BkMode = Opaque -- ^ Draw text on a bounding rectangle filled with the -- current background color. | Transparent -- ^ Draw text without a background rectangle. -- | How strings drawn with 'Graphics.HGL.Draw.Text.text' are positioned -- relative to the specified reference point. type Alignment = (HAlign, VAlign) -- | Horizontal alignment of text. -- Names have a tick to distinguish them from "Prelude" names. data HAlign = Left' -- ^ align the left edge of the text with the reference point | Center -- ^ center the text with the reference point | Right' -- ^ align the right edge of the text with the reference point deriving (Enum, Eq, Ord, Ix, Show) -- | Vertical alignment of text. data VAlign = Top -- ^ align the top edge of the text with the reference point | Baseline -- ^ align the baseline of the text with the reference point | Bottom -- ^ align the bottom edge of the text with the reference point deriving (Enum, Eq, Ord, Ix, Show) --------------------------------------------------------------- -- Windows ---------------------------------------------------------------- -- | Title of a window. type Title = String -- | How to draw in a window. data RedrawMode = DoubleBuffered -- ^ use a /double buffer/ to reduce flicker. -- You should probably use this for animations. | Unbuffered -- ^ draw directly to the window. -- This runs slightly faster but is more prone -- to flicker. hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Draw.hs0000644006511100651110000000270610504340421020554 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Draw -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Drawing in a simple graphics library. -- ----------------------------------------------------------------------------- module Graphics.HGL.Draw ( -- * Graphics -- | The type 'Graphic', which represents an abstract drawing, -- is actually a special case of a 'Draw' monad. module Graphics.HGL.Draw.Monad -- * Graphical objects -- | These are ways of constructing values of type 'Graphic'. , module Graphics.HGL.Draw.Picture , module Graphics.HGL.Draw.Text , module Graphics.HGL.Draw.Region -- * Graphical attributes -- | These are used to alter the above drawings. -- Brushes are used for filling shapes, pens for drawing lines. , module Graphics.HGL.Draw.Brush , module Graphics.HGL.Draw.Pen , module Graphics.HGL.Draw.Font ) where import Graphics.HGL.Draw.Monad import Graphics.HGL.Draw.Picture import Graphics.HGL.Draw.Text import Graphics.HGL.Draw.Region import Graphics.HGL.Draw.Brush import Graphics.HGL.Draw.Pen import Graphics.HGL.Draw.Font ---------------------------------------------------------------- -- The end ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Units.hs0000644006511100651110000000107510504340421020757 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Units -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Types for units in a simple graphics library. -- ----------------------------------------------------------------------------- module Graphics.HGL.Units ( Point , Size , Angle , Time ) where import Graphics.HGL.Internals.Types hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Key.hs0000644006511100651110000002054610504340421020411 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Key -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Abstract representation of keys. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" module Graphics.HGL.Key ( Key -- Abstract! , keyToChar -- :: Key -> Char , isCharKey -- :: Key -> Bool , isBackSpaceKey -- :: Key -> Bool , isTabKey -- :: Key -> Bool -- , isLineFeedKey -- :: Key -> Bool , isClearKey -- :: Key -> Bool , isReturnKey -- :: Key -> Bool , isEscapeKey -- :: Key -> Bool , isDeleteKey -- :: Key -> Bool -- , isMultiKeyKey -- :: Key -> Bool , isHomeKey -- :: Key -> Bool , isLeftKey -- :: Key -> Bool , isUpKey -- :: Key -> Bool , isRightKey -- :: Key -> Bool , isDownKey -- :: Key -> Bool , isPriorKey -- :: Key -> Bool , isPageUpKey -- :: Key -> Bool , isNextKey -- :: Key -> Bool , isPageDownKey -- :: Key -> Bool , isEndKey -- :: Key -> Bool -- , isBeginKey -- :: Key -> Bool , isShiftLKey -- :: Key -> Bool , isShiftRKey -- :: Key -> Bool , isControlLKey -- :: Key -> Bool , isControlRKey -- :: Key -> Bool -- , isCapsLockKey -- :: Key -> Bool -- , isShiftLockKey -- :: Key -> Bool -- , isMetaLKey -- :: Key -> Bool -- , isMetaRKey -- :: Key -> Bool -- , isAltLKey -- :: Key -> Bool -- , isAltRKey -- :: Key -> Bool ) where import Data.Maybe (isJust) #if !X_DISPLAY_MISSING import Graphics.HGL.X11.Types(Key(MkKey)) import Graphics.X11.Xlib #else import Graphics.HGL.Win32.Types(Key(MkKey)) import Graphics.Win32 #endif ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- -- | Converts a character key to a character. keyToChar :: Key -> Char isCharKey :: Key -> Bool -- Is it a "real" character? isBackSpaceKey :: Key -> Bool isTabKey :: Key -> Bool --isLineFeedKey :: Key -> Bool isClearKey :: Key -> Bool isReturnKey :: Key -> Bool isEscapeKey :: Key -> Bool isDeleteKey :: Key -> Bool --isMultiKeyKey :: Key -> Bool -- Multi-key character compose. isHomeKey :: Key -> Bool -- Cursor home. isLeftKey :: Key -> Bool -- Cursor left, left arrow. isUpKey :: Key -> Bool -- Cursor up, up arrow. isRightKey :: Key -> Bool -- Cursor right, right arrow. isDownKey :: Key -> Bool -- Cursor down, down arrow. isPriorKey :: Key -> Bool -- Prior, previous page. Same as page up. isPageUpKey :: Key -> Bool -- Page up, previous page. Same as prior. isNextKey :: Key -> Bool -- Next, next page. Same as page down. isPageDownKey :: Key -> Bool -- Page down, next page. Same as next. isEndKey :: Key -> Bool -- End of line. --isBeginKey :: Key -> Bool -- Beginning of line. isShiftLKey :: Key -> Bool -- Left shift. isShiftRKey :: Key -> Bool -- Right shift. isControlLKey :: Key -> Bool -- Left control. isControlRKey :: Key -> Bool -- Right control. --isCapsLockKey :: Key -> Bool -- Caps lock. --isShiftLockKey :: Key -> Bool -- Shift lock. --isMetaLKey :: Key -> Bool -- Left meta. --isMetaRKey :: Key -> Bool -- Right meta. --isAltLKey :: Key -> Bool -- Left alt. --isAltRKey :: Key -> Bool -- Right alt. ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- keyToChar (MkKey ks) = case (keySymToChar ks) of Just c -> c Nothing -> error "keyToChar: Not a character key!" isCharKey (MkKey ks) = isJust (keySymToChar ks) #if !X_DISPLAY_MISSING -- Converts an X KeySym representing an ISO 8859-1 (Latin 1) character or one -- of a few control characters to a Char. -- Note! It is assumed that the KeySym encoding for Latin 1 characters agrees -- with the Haskell character encoding! keySymToChar :: KeySym -> Maybe Char keySymToChar ks | xK_space <= ks && ks <= xK_ydiaeresis = Just (toEnum (fromIntegral ks)) | ks == xK_BackSpace = Just '\BS' | ks == xK_Tab = Just '\HT' | ks == xK_Linefeed = Just '\LF' | ks == xK_Clear = Just '\FF' | ks == xK_Return = Just '\CR' | ks == xK_Escape = Just '\ESC' | ks == xK_Delete = Just '\DEL' | otherwise = Nothing isBackSpaceKey (MkKey ks) = ks == xK_BackSpace isTabKey (MkKey ks) = ks == xK_Tab --isLineFeedKey (MkKey ks) = ks == xK_Linefeed isClearKey (MkKey ks) = ks == xK_Clear isReturnKey (MkKey ks) = ks == xK_Return isEscapeKey (MkKey ks) = ks == xK_Escape isDeleteKey (MkKey ks) = ks == xK_Delete --isMultiKeyKey (MkKey ks) = ks == xK_Multi_key isHomeKey (MkKey ks) = ks == xK_Home isLeftKey (MkKey ks) = ks == xK_Left isUpKey (MkKey ks) = ks == xK_Up isRightKey (MkKey ks) = ks == xK_Right isDownKey (MkKey ks) = ks == xK_Down isPriorKey (MkKey ks) = ks == xK_Prior isPageUpKey (MkKey ks) = ks == xK_Page_Up isNextKey (MkKey ks) = ks == xK_Next isPageDownKey (MkKey ks) = ks == xK_Page_Down isEndKey (MkKey ks) = ks == xK_End --isBeginKey (MkKey ks) = ks == xK_Begin isShiftLKey (MkKey ks) = ks == xK_Shift_L isShiftRKey (MkKey ks) = ks == xK_Shift_R isControlLKey (MkKey ks) = ks == xK_Control_L isControlRKey (MkKey ks) = ks == xK_Control_R --isCapsLockKey (MkKey ks) = ks == xK_Caps_Lock --isShiftLockKey (MkKey ks) = ks == xK_Shift_Lock --isMetaLKey (MkKey ks) = ks == xK_Meta_L --isMetaRKey (MkKey ks) = ks == xK_Meta_R --isAltLKey (MkKey ks) = ks == xK_Alt_L --isAltRKey (MkKey ks) = ks == xK_Alt_R #else /* X_DISPLAY_MISSING */ -- Converts a VKey representing an ISO 8859-1 (Latin 1) character or one -- of a few control characters to a Char. -- Note! It is assumed that the VKey encoding for Latin 1 characters agrees -- with the Haskell character encoding! keySymToChar :: VKey -> Maybe Char keySymToChar ks | space <= ks && ks <= ydiaresis = Just (toEnum (fromIntegral ks)) | ks == vK_BACK = Just '\BS' | ks == vK_TAB = Just '\HT' -- | ks == vK_LINEFEED = Just '\LF' | ks == vK_CLEAR = Just '\FF' | ks == vK_RETURN = Just '\CR' | ks == vK_ESCAPE = Just '\ESC' | ks == vK_DELETE = Just '\DEL' | otherwise = Nothing where space, ydiaresis :: VKey space = fromIntegral (fromEnum ' ') ydiaresis = fromIntegral 255 -- is this right? isBackSpaceKey (MkKey ks) = ks == vK_BACK isTabKey (MkKey ks) = ks == vK_TAB --isLineFeedKey (MkKey ks) = ks == vK_LINEFEED isClearKey (MkKey ks) = ks == vK_CLEAR isReturnKey (MkKey ks) = ks == vK_RETURN isEscapeKey (MkKey ks) = ks == vK_ESCAPE isDeleteKey (MkKey ks) = ks == vK_DELETE --isMultiKeyKey (MkKey ks) = ks == vK_MULTI_KEY isHomeKey (MkKey ks) = ks == vK_HOME isLeftKey (MkKey ks) = ks == vK_LEFT isUpKey (MkKey ks) = ks == vK_UP isRightKey (MkKey ks) = ks == vK_RIGHT isDownKey (MkKey ks) = ks == vK_DOWN isPriorKey (MkKey ks) = ks == vK_PRIOR isPageUpKey (MkKey ks) = ks == vK_PRIOR -- same as isPriorKey isNextKey (MkKey ks) = ks == vK_NEXT isPageDownKey (MkKey ks) = ks == vK_NEXT -- same as isNextKey isEndKey (MkKey ks) = ks == vK_END --isBeginKey (MkKey ks) = ks == vK_Begin isShiftLKey (MkKey ks) = ks == vK_SHIFT -- can't distinguish left and right isShiftRKey (MkKey ks) = ks == vK_SHIFT isControlLKey (MkKey ks) = ks == vK_CONTROL -- ambidextrous isControlRKey (MkKey ks) = ks == vK_CONTROL --isCapsLockKey (MkKey ks) = ks == vK_Caps_Lock --isShiftLockKey (MkKey ks) = ks == vK_Shift_Lock --isMetaLKey (MkKey ks) = ks == vK_Meta_L --isMetaRKey (MkKey ks) = ks == vK_Meta_R --isAltLKey (MkKey ks) = ks == vK_Alt_L --isAltRKey (MkKey ks) = ks == vK_Alt_R #endif /* X_DISPLAY_MISSING */ ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Run.hs0000644006511100651110000000414010504340421020415 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Run -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Running graphical actions. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" module Graphics.HGL.Run ( runGraphics -- :: IO () -> IO () ) where #if !X_DISPLAY_MISSING import Graphics.HGL.X11.Display (getDisplayName) import Graphics.HGL.X11.Window (runGraphicsEx) #else import Graphics.HGL.Win32.WND (handleEvents, beginGraphics, endGraphics) import Graphics.HGL.Internals.Utilities (safeTry) import Control.Concurrent (forkIO, yield) import Data.IORef( newIORef, readIORef, writeIORef ) import System.IO.Error (try) #endif ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- -- | Initialize the system to do graphics, run an action while collecting -- user interface events and forwarding them to the action, and then clean -- up everything else at the end. -- The other functions of the library may only be used inside 'runGraphics'. runGraphics :: IO () -> IO () -- SOE, p48 ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- #if !X_DISPLAY_MISSING runGraphics m = do disp <- getDisplayName runGraphicsEx disp m #else /* X_DISPLAY_MISSING */ -- We took a lot of effort to make sure that we always close the -- windows - even if "m" fails. -- -- Note though that we use "try" instead of "safeTry" on the call to -- "m" because it is quite normal for "m" to block (and safeTry treats -- blocking as failure). runGraphics m = do beginGraphics quit <- newIORef False safeTry $ do forkIO (try m >> writeIORef quit True) yield handleEvents (readIORef quit) endGraphics #endif /* X_DISPLAY_MISSING */ hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Win32/0000755006511100651110000000000010504340421020220 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Win32/Bitmap.hs0000644006511100651110000001316710504340421022000 0ustar rossross-- #hide module Graphics.HGL.Win32.Bitmap ( Bitmap , load, read, delete , draw, drawStretched, drawSheared , getBitmapSize , createBitmapFile ) where import Graphics.HGL.Units (Point) import Graphics.HGL.Internals.Draw (Draw, mkDraw) import Graphics.HGL.Win32.Draw import Graphics.HGL.Win32.Types import qualified Graphics.HGL.Internals.Utilities as Utils import qualified Graphics.Win32 as Win32 import qualified System.Win32 as Win32 import Foreign ---------------------------------------------------------------- -- The interface ---------------------------------------------------------------- load :: String -> IO (Bitmap, (Int, Int)) delete :: Bitmap -> IO () getBitmapSize :: Bitmap -> IO (Int, Int) -- Bitmaps can be drawn in three ways: -- a) with no transformation at a point -- b) stretched to fit a rectangle -- c) rotated and sheared to fit a parallelogram -- -- Sadly, the latter isn't supported in Win'95 draw :: Point -> Bitmap -> Draw () drawStretched :: Point -> Point -> Bitmap -> Draw () drawSheared :: Point -> Point -> Point -> Bitmap -> Draw () ---------------------------------------------------------------- -- The implementation ---------------------------------------------------------------- delete (MkBitmap bitmap) = Win32.deleteBitmap bitmap load fileName = do --putStrLn ("<>") bmp <- readBitmap fileName sz <- getBitmapSize bmp return (bmp, sz) getBitmapSize (MkBitmap bmp) = do (ty, w, h, wBytes, planes, bitsPixel, bits) <- Win32.getBitmapInfo bmp return (fromIntegral w, fromIntegral h) draw pt bmp = mkDraw (\ hdc -> withCompatibleDC hdc $ \ memdc -> withBitmap memdc bmp $ do (width,height) <- getBitmapSize bmp Win32.bitBlt hdc x y (fromIntegral width) (fromIntegral height) memdc 0 0 Win32.sRCCOPY) where (x,y) = fromPoint pt drawStretched p0 p1 bmp = mkDraw (\hdc -> withCompatibleDC hdc $ \ memdc -> withBitmap memdc bmp $ do (width,height) <- getBitmapSize bmp Win32.stretchBlt hdc x0 y1 (x1-x0) (y0-y1) memdc 0 0 (fromIntegral width) (fromIntegral height) Win32.sRCCOPY) where (x0,y0) = fromPoint p0 (x1,y1) = fromPoint p1 drawSheared p0 p1 p2 bmp = mkDraw (\hdc -> withCompatibleDC hdc $ \ memdc -> withBitmap memdc bmp $ do (width,height) <- getBitmapSize bmp Win32.plgBlt hdc (fromPoint p0) (fromPoint p1) (fromPoint p2) memdc 0 0 (fromIntegral width) (fromIntegral height) Nothing 0 0) ---------------------------------------------------------------- -- Reading bitmaps from files ---------------------------------------------------------------- -- ToDo: the "bits" read are never freed but I think we can free them -- as soon as we call createDIBitmap. -- Summary of the Win32 documentation on BMP files: -- -- A bitmap file consists of: -- -- +-------------------+ -- | BITMAPFILEHEADER | -- +-------------------+ -- | BITMAPINFOHEADER | -- +-------------------+ -- | Rgbquad array | -- +-------------------+ -- | Color-index array | -- +-------------------+ -- -- The file header tells you the size of the file and the offset of the -- bitmap data from the header start. -- -- The info header specifies the width and height, the colour format, -- compression mode, number of bytes of data, resolution and the number -- of colours. -- -- The RGBQUAD array is a palette. -- -- The Color-index array is the actual bitmap. readBitmap fileName = Utils.bracket (Win32.createFile fileName Win32.gENERIC_READ Win32.fILE_SHARE_READ Nothing Win32.oPEN_EXISTING Win32.fILE_ATTRIBUTE_NORMAL Nothing) Win32.closeHandle $ \ file -> do (offset, size) <- readFileHeader file (infoHeader,bmi,bits) <- readBits file offset size hdc <- Win32.getDC Nothing -- hdc for the screen bmp <- Win32.createDIBitmap hdc infoHeader Win32.cBM_INIT bits bmi Win32.dIB_RGB_COLORS return (MkBitmap bmp) readFileHeader :: Win32.HANDLE -> IO (Word32, Word32) readFileHeader file = -- read the file header allocaBytes (fromIntegral Win32.sizeofLPBITMAPFILEHEADER) $ \ fileHeader -> do read <- Win32.win32_ReadFile file fileHeader Win32.sizeofLPBITMAPFILEHEADER Nothing assert (read == Win32.sizeofLPBITMAPFILEHEADER) "Bitmap file lacks header" -- check the tag and get the size (tag, size, r1, r2, offset) <- Win32.getBITMAPFILEHEADER fileHeader assert (tag == fromIntegral (fromEnum 'B' + 256 * fromEnum 'M')) "Bitmap file lacks tag" assert (r1 == 0 && r2 == 0) "Bitmap header contains non-zero reserved words" return ( offset - Win32.sizeofLPBITMAPFILEHEADER , size - Win32.sizeofLPBITMAPFILEHEADER ) -- read the bits out of the rest of the file -- assumes that you've just read the file header readBits :: Win32.HANDLE -> Word32 -> Word32 -> IO (Win32.LPBITMAPINFOHEADER, Win32.LPBITMAPINFO, Win32.LPVOID) readBits file offset size = do header <- mallocBytes (fromIntegral size) read <- Win32.win32_ReadFile file header size Nothing assert (read == size) "Bitmap file ended unexpectedly" return ( castPtr header , header , castPtr header `plusPtr` fromIntegral offset ) -- In the development system, this might print the error message -- if the assertion fails. assert :: Bool -> String -> IO () assert _ _ = return () {- assert True _ = return () assert False why = do putStrLn "Assertion failed:" putStrLn why return () -} ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Win32/Draw.hs0000644006511100651110000001257310504340421021461 0ustar rossross-- #hide module Graphics.HGL.Win32.Draw ( DrawFun, drawGraphic, drawBufferedGraphic, drawBufferedGraphicBC , saveGraphic , withBitmap , setDefaults , createCompatibleBitmap, withCompatibleBitmap, withCompatibleDC, withDC , createBitmapFile ) where import Graphics.HGL.Units import Graphics.HGL.Internals.Draw import Graphics.HGL.Win32.Types import qualified Graphics.HGL.Internals.Utilities as Utils import qualified Graphics.Win32 as Win32 import Data.Int type DrawFun = Win32.HWND -> Win32.HDC -> IO () drawGraphic :: Draw () -> DrawFun drawBufferedGraphic :: Draw () -> DrawFun drawBufferedGraphicBC :: Win32.COLORREF -> Draw () -> DrawFun saveGraphic :: String -> Point -> Draw () -> IO () createBitmapFile :: Win32.HDC -> String -> Bitmap -> IO () createCompatibleDC :: Win32.HDC -> IO Win32.HDC deleteDC :: Win32.HDC -> IO () createCompatibleBitmap :: Win32.HDC -> Int32 -> Int32 -> IO Bitmap withCompatibleDC :: Win32.HDC -> (Win32.HDC -> IO a) -> IO a withBitmap :: Win32.HDC -> Bitmap -> IO a -> IO a withDC :: Maybe Win32.HWND -> (Win32.HDC -> IO a) -> IO a withCompatibleBitmap :: Win32.HDC -> Int32 -> Int32 -> (Bitmap -> IO a) -> IO a ---------------------------------------------------------------- drawGraphic p = \ hwnd hdc -> do (w,h) <- windowSize hwnd Win32.bitBlt hdc 0 0 w h hdc 0 0 backgroundColor setDefaults hdc unDraw p hdc drawBufferedGraphic = drawBufferedGraphicBC backgroundColor drawBufferedGraphicBC bgColor p = \ hwnd hdc -> do (w,h) <- windowSize hwnd withBuffer (Just hwnd) w h bgColor $ \ buffer _ -> do setDefaults buffer unDraw p buffer Win32.bitBlt hdc 0 0 w h buffer 0 0 Win32.sRCCOPY saveGraphic fileName size p = withBuffer Nothing w h backgroundColor $ \ buffer bmp -> do setDefaults buffer unDraw p buffer createBitmapFile buffer fileName bmp where (w,h) = fromPoint size backgroundColor = Win32.bLACKNESS setDefaults :: Win32.HDC -> IO () setDefaults hdc = do setDefaultPen hdc setDefaultBrush hdc setDefaultText hdc return () setDefaultPen :: Win32.HDC -> IO () setDefaultPen = \ hdc -> do whitePen <- Win32.getStockPen Win32.wHITE_PEN Win32.selectPen hdc whitePen return () setDefaultBrush :: Win32.HDC -> IO () setDefaultBrush = \ hdc -> do whiteBrush <- Win32.getStockBrush Win32.wHITE_BRUSH Win32.selectBrush hdc whiteBrush return () setDefaultText :: Win32.HDC -> IO () setDefaultText = \ hdc -> do Win32.setTextColor hdc white -- We omit this because it should be redundant (since mode is transparent) -- And because it causes some examples to crash. -- Maybe you're not allowed to set a color if the mode is transparent? -- Win32.setBkColor hdc black Win32.setBkMode hdc Win32.tRANSPARENT return () white :: Win32.COLORREF white = Win32.rgb 255 255 255 black :: Win32.COLORREF black = Win32.rgb 0 0 0 ---------------------------------------------------------------- -- Note that we create a bitmap which is compatible with the hdc -- onto which we are going to zap the Graphic. It might seem that -- it would be enough for it to be compatible with the buffer - -- but, sadly, this isn't the case. The problem is that the buffer -- is initially 0 pixels wide, 0 pixels high and 1 bit deep -- (ie it looks monochrome); it only becomes n-bits deep when you -- select in a bitmap which is n-bits deep. -- -- If it wasn't for that, we'd have swapped these two lines: -- -- withCompatibleBitmap w h $ \ bitmap -> -- withCompatibleDC $ \ hdc -> -- withBuffer :: Maybe Win32.HWND -> Int32 -> Int32 -> Win32.COLORREF -> (Win32.HDC -> Bitmap -> IO a) -> IO a withBuffer mbhwnd w h bgColor p = withDC mbhwnd $ \ hdc -> withCompatibleBitmap hdc w h $ \ bitmap -> withCompatibleDC hdc $ \ buffer -> withBitmap buffer bitmap $ do Win32.bitBlt buffer 0 0 w h buffer 0 0 bgColor p buffer bitmap ---------------------------------------------------------------- -- Get the width and height of a window's client area, in pixels. windowSize :: Win32.HWND -> IO (Win32.LONG,Win32.LONG) windowSize hwnd = Win32.getClientRect hwnd >>= \ (l',t',r',b') -> return (r' - l', b' - t') -- Note that this DC is only "1 bit" in size - you have to call -- "createCompatibleBitmap" before it is big enough to hold the bitmap -- you want. createCompatibleDC hdc = Win32.createCompatibleDC (Just hdc) deleteDC = Win32.deleteDC createCompatibleBitmap hdc w h = do bmp <- Win32.createCompatibleBitmap hdc w h return (MkBitmap bmp) withBitmap hdc bmp = Utils.bracket_ (selectBitmap hdc bmp) (selectBitmap hdc) withDC mhwnd = Utils.bracket (Win32.getDC mhwnd) (Win32.releaseDC mhwnd) -- Note that this DC is only "1 bit" in size - you have to call -- "createCompatibleBitmap" before it is big enough to hold the bitmap -- you want. withCompatibleDC hdc = Utils.bracket (createCompatibleDC hdc) deleteDC withCompatibleBitmap hdc w h = Utils.bracket (createCompatibleBitmap hdc w h) deleteBitmap deleteBitmap (MkBitmap bmp) = Win32.deleteBitmap bmp selectBitmap hdc (MkBitmap bmp) = do bmp' <- Win32.selectBitmap hdc bmp return (MkBitmap bmp) createBitmapFile hdc fileName (MkBitmap bmp) = Win32.createBMPFile fileName bmp hdc ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Win32/Types.hs0000644006511100651110000000355110504340421021664 0ustar rossross-- #hide module Graphics.HGL.Win32.Types ( toDimension, fromDimension , toPoint, fromPoint , toRGB, fromRGB , Bitmap(..) , DC , Key(MkKey) ) where import qualified Graphics.Win32 as Win32 import Graphics.HGL.Internals.Types -- Hugs does not allow operators to have different fixities in -- different modules (this is a known deviation from Standard Haskell). -- In consequence, we don't declare any fixities in any non-standard -- library because it would prevent the programmer from using the same -- operator name at a different fixity. -- -- infixr 9 `over` ---------------------------------------------------------------- -- Units ---------------------------------------------------------------- -- These functions are used when implementing Graphic values toPoint :: Win32.POINT -> Point fromPoint :: Point -> Win32.POINT toDimension :: Win32.INT -> Dimension fromDimension :: Dimension -> Win32.INT toPoint (x,y) = (toDimension x, toDimension y) fromPoint (x,y) = (fromDimension x, fromDimension y) toDimension = fromIntegral fromDimension = fromIntegral --------------------------------------------------------------- -- Colors ---------------------------------------------------------------- fromRGB :: RGB -> Win32.COLORREF fromRGB (RGB r g b) = Win32.rgb r g b toRGB :: Win32.COLORREF -> RGB toRGB c = RGB (Win32.getRValue c) (Win32.getGValue c) (Win32.getBValue c) ---------------------------------------------------------------- -- Bitmaps ---------------------------------------------------------------- newtype Bitmap = MkBitmap Win32.HBITMAP ---------------------------------------------------------------- -- Drawing Context ---------------------------------------------------------------- type DC = Win32.HDC newtype Key = MkKey Win32.VKey deriving Show ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Win32/WND.hs0000644006511100651110000002405310504340421021210 0ustar rossross-- #hide module Graphics.HGL.Win32.WND ( WND, mkWND, openWND, closeWND, redrawWND , handleEvents, closeAllHWNDs , beginGraphics, endGraphics , wndRect , getHWND , drawWND ) where import Graphics.HGL.Units (Point) import Graphics.HGL.Internals.Event( Event(..) ) import Graphics.HGL.Internals.Draw (Draw, unDraw) import Graphics.HGL.Internals.Events( Events, sendEvent, sendTick ) import Graphics.HGL.Internals.Utilities(safeTry, Exception) import Graphics.HGL.Win32.Draw( DrawFun, setDefaults, withDC ) import Graphics.HGL.Win32.Types( Key(MkKey), toPoint ) import Control.Concurrent( yield ) import Control.Monad(liftM2,when) import Data.Bits import Data.IORef import Data.Maybe(isJust) import System.IO.Unsafe(unsafePerformIO) import Graphics.Win32 import System.Win32 (getModuleHandle) ---------------------------------------------------------------- -- Once a window has been closed, we want to detect any further -- operations on the window - so all access is via a mutable Maybe ---------------------------------------------------------------- newtype WND = MkWND (IORef (Maybe HWND)) closeWND :: WND -> IO () closeWND wnd@(MkWND hwndref) = do mb_hwnd <- readIORef hwndref writeIORef hwndref Nothing -- mark it as closed case mb_hwnd of Just hwnd -> do removeHWND hwnd -- added by Ulf Norell yield -- added by Ulf destroyWindow hwnd Nothing -> return () getHWND :: WND -> IO HWND getHWND (MkWND hwndref) = do mb_hwnd <- readIORef hwndref case mb_hwnd of Just hwnd -> return hwnd Nothing -> ioError (userError "Attempted to act on closed window") redrawWND :: WND -> IO () redrawWND wnd = do hwnd <- getHWND wnd invalidateRect (Just hwnd) Nothing False drawWND :: WND -> Draw () -> IO () drawWND wnd p = do hwnd <- getHWND wnd withDC (Just hwnd) (\ hdc -> setDefaults hdc >> unDraw p hdc) wndRect :: WND -> IO (Point, Point) wndRect wnd = do hwnd <- getHWND wnd (l,t,r,b) <- getClientRect hwnd return (toPoint (l,t), toPoint (r,b)) mkWND :: HWND -> IO WND mkWND hwnd = fmap MkWND (newIORef (Just hwnd)) openWND :: String -> Maybe POINT -> Maybe POINT -> Events -- where to send the events -> DrawFun -- how to redraw the picture -> Maybe MilliSeconds -- time between timer ticks -> IO WND openWND name pos size events draw tickRate = do checkInitialised clAss <- newClass hwnd <- createWND name wndProc pos size wS_OVERLAPPEDWINDOW Nothing show hwnd False updateWindow hwnd maybe (return ()) (\ rate -> setWinTimer hwnd 1 rate >> return ()) tickRate fmap MkWND (newIORef (Just hwnd)) where wndProc hwnd msg wParam lParam = do -- print msg rs <- safeTry $ do r <- windowProc (sendEvent events) draw (\ wParam -> sendTick events) hwnd msg wParam lParam r `seq` return r -- force it inside the try! case rs of Right a -> return a Left e -> uncaughtError e >> return 0 -- Let's hope this works ok show hwnd iconified = if iconified then do showWindow hwnd sW_SHOWNORMAL -- open "iconified" return () else do showWindow hwnd sW_RESTORE -- open "restored" (ie normal size) bringWindowToTop hwnd -- Note that this code uses a single (static) MSG throughout the whole -- system - let's hope this isn't a problem handleEvents :: IO Bool -> IO () handleEvents userQuit = do -- first wait for a window to be created or for the user prog to quit -- this avoids the race condition that we might quit (for lack of -- any windows) before the user's thread has even had a chance to run. safeTry $ while (fmap not (liftM2 (||) userQuit (fmap not noMoreWindows))) yield -- Ulf uses this instead of handleEvent -- then wait for all windows to be shut down or user to quit safeTry $ while (fmap not (liftM2 (||) userQuit systemQuit)) handleEvent return () where while p s = do { c <- p; if c then s >> while p s else return () } handleEvent :: IO () handleEvent = do yield -- always yield before any blocking operation nowin <- noMoreWindows when (not nowin) $ allocaMessage $ \ lpmsg -> do getMessage lpmsg Nothing translateMessage lpmsg dispatchMessage lpmsg return () ---------------------------------------------------------------- -- The grotty details - opening WNDs, creating classes, etc ---------------------------------------------------------------- className = mkClassName "Graphics.HGL.Win32.WND" newClass :: IO ATOM newClass = do icon <- loadIcon Nothing iDI_APPLICATION cursor <- loadCursor Nothing iDC_ARROW whiteBrush <- getStockBrush wHITE_BRUSH mainInstance <- getModuleHandle Nothing atom <- registerClass ( (cS_HREDRAW .|. cS_VREDRAW), -- redraw if window size Changes mainInstance, (Just icon), (Just cursor), (Just whiteBrush), Nothing, className) --return atom return (maybe undefined id atom) createWND :: String -> WindowClosure -> Maybe POINT -> Maybe POINT -> WindowStyle -> Maybe HMENU -> IO HWND createWND name wndProc posn size style menu = do mainInstance <- getModuleHandle Nothing mbSize <- calcSize size hwnd <- createWindowEx 0 -- Win32.wS_EX_TOPMOST className name style (fmap (fromIntegral.fst) posn) -- x (fmap (fromIntegral.snd) posn) -- y (fmap (fromIntegral.fst) mbSize) -- w (fmap (fromIntegral.snd) mbSize) -- h Nothing -- parent menu mainInstance wndProc addHWND hwnd return hwnd where calcSize :: Maybe POINT -> IO (Maybe POINT) calcSize = maybe (return Nothing) (\ (width, height) -> do (l,t,r,b) <- adjustWindowRect (0,0,width,height) style (isJust menu) return $ Just (r-l, b-t)) windowProc :: (Event -> IO ()) -> -- Event Handler DrawFun -> -- Picture redraw (WPARAM -> IO ()) -> -- tick (HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT) windowProc send redraw tick hwnd msg wParam lParam | msg == wM_PAINT = paint | msg == wM_MOUSEMOVE = mouseMove lParam | msg == wM_LBUTTONDOWN || msg == wM_LBUTTONDBLCLK = button lParam True True | msg == wM_LBUTTONUP = button lParam True False | msg == wM_RBUTTONDOWN || msg == wM_RBUTTONDBLCLK = button lParam False True | msg == wM_RBUTTONUP = button lParam False False | msg == wM_KEYDOWN = key wParam True | msg == wM_KEYUP = key wParam False | msg == wM_CHAR = char wParam | msg == wM_TIMER = timer wParam | msg == wM_SIZE = resize {- | msg == wM_MOUSEACTIVATE = do hwnd' <- setFocus hwnd if hwnd `eqHWND` hwnd' then return mA_NOACTIVATE -- already had input focus else return mA_ACTIVATEANDEAT -} | msg == wM_DESTROY = destroy | otherwise = defWindowProc (Just hwnd) msg wParam lParam where paint :: IO LRESULT paint = paintWith hwnd (\hdc lpps -> do redraw hwnd hdc return 0 ) button :: LPARAM -> Bool -> Bool -> IO LRESULT button lParam isLeft isDown = do let (y,x) = lParam `divMod` 65536 send (Button {pt = toPoint (x,y), isLeft=isLeft, isDown=isDown}) return 0 key :: WPARAM -> Bool -> IO LRESULT key wParam isDown = do send (Key { keysym = MkKey wParam, isDown = isDown }) -- by returning 1 we let it get translated into a char too return 1 char :: WPARAM -> IO LRESULT char wParam = do send (Char { char = toEnum (fromIntegral wParam) }) return 0 mouseMove :: LPARAM -> IO LRESULT mouseMove lParam = do let (y,x) = lParam `divMod` 65536 send (MouseMove { pt = toPoint (x,y) }) return 0 timer :: WPARAM -> IO LRESULT timer wParam = do tick wParam return 0 resize :: IO LRESULT resize = do -- don't send new size, it may be out of date by the time we -- get round to reading the event send Resize return 0 destroy :: IO LRESULT destroy = do removeHWND hwnd send Closed return 0 paintWith :: HWND -> (HDC -> LPPAINTSTRUCT -> IO a) -> IO a paintWith hwnd p = allocaPAINTSTRUCT $ \ lpps -> do hdc <- beginPaint hwnd lpps a <- p hdc lpps endPaint hwnd lpps return a ---------------------------------------------------------------- -- The open window list ---------------------------------------------------------------- -- It's very important that we close any windows - even if the -- Haskell application fails to do so (or aborts for some reason). -- Therefore we keep a list of open windows and close them all at the -- end. -- persistent list of open windows windows :: IORef [HWND] windows = unsafePerformIO (newIORef []) initialised :: IORef Bool initialised = unsafePerformIO (newIORef False) noMoreWindows :: IO Bool noMoreWindows = fmap null (readIORef windows) -- It's also important that we abort cleanly if an uncaught IOError -- occurs - this flag keeps track of such things hadUncaughtError :: IORef Bool hadUncaughtError = unsafePerformIO (newIORef False) -- We call this if an uncaught error has occured uncaughtError :: Exception -> IO () uncaughtError e = do putStr "Uncaught Error: " print e writeIORef hadUncaughtError True systemQuit :: IO Bool systemQuit = liftM2 (||) (readIORef hadUncaughtError) noMoreWindows beginGraphics :: IO () beginGraphics = do closeAllHWNDs -- just in case any are already open! writeIORef initialised True checkInitialised :: IO () checkInitialised = do init <- readIORef initialised if init then return () else ioError (userError msg) where msg = "Graphics library uninitialised: perhaps you forgot to use runGraphics?" endGraphics :: IO () endGraphics = do closeAllHWNDs writeIORef initialised False closeAllHWNDs :: IO () closeAllHWNDs = do hwnds <- readIORef windows mapM_ destroyWindow hwnds writeIORef windows [] writeIORef hadUncaughtError False -- clear the system addHWND :: HWND -> IO () addHWND hwnd = do hwnds <- readIORef windows writeIORef windows (hwnd:hwnds) -- remove a HWND from windows list removeHWND :: HWND -> IO () removeHWND hwnd = do hwnds <- readIORef windows writeIORef windows (filter (/= hwnd) hwnds) hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Utils.hs0000644006511100651110000002307110504340421020755 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Utils -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Utility functions for a simple graphics library. -- ----------------------------------------------------------------------------- module Graphics.HGL.Utils ( -- * Windows openWindow -- :: Title -> Size -> IO Window , clearWindow -- :: Window -> IO () , drawInWindow -- :: Window -> Graphic -> IO () , withWindow -- :: Title -> Size -> (Window -> IO a) -> IO a , withWindow_ -- :: Title -> Size -> (Window -> IO a) -> IO () , runWindow -- :: Title -> Size -> (Window -> IO a) -> IO () , getWindowSize -- :: Window -> IO Size -- * Specific events -- ** Mouse events , getLBP -- :: Window -> IO Point , getRBP -- :: Window -> IO Point , getButton -- :: Window -> Bool -> Bool -> IO Point -- ** Keyboard events , getKey -- :: Window -> IO Key , getKeyEx -- :: Window -> Bool -> IO Key , wGetChar -- :: Window -> IO Char -- * Graphics -- ** Combining Graphics , emptyGraphic -- :: Graphic , overGraphic -- :: Graphic -> Graphic -> Graphic , overGraphics -- :: [Graphic] -> Graphic -- ** Graphic modifiers , withFont -- :: Font -> Graphic -> Graphic , withTextColor -- :: RGB -> Graphic -> Graphic , withTextAlignment -- :: Alignment -> Graphic -> Graphic , withBkColor -- :: RGB -> Graphic -> Graphic , withBkMode -- :: BkMode -> Graphic -> Graphic , withPen -- :: Pen -> Graphic -> Graphic , withBrush -- :: Brush -> Graphic -> Graphic , withRGB -- :: RGB -> Graphic -> Graphic -- * Named colors , Color(..) , colorList -- :: [(Color, RGB)] , colorTable -- :: Array Color RGB , withColor -- :: Color -> Graphic -> Graphic -- * Concurrency , par -- :: IO a -> IO b -> IO (a, b) , par_ -- :: IO a -> IO b -> IO () , parMany -- :: [IO ()] -> IO () ) where import Graphics.HGL.Core import Control.Concurrent ( newEmptyMVar, takeMVar, putMVar , forkIO ) import qualified Control.Exception as E import Data.Ix(Ix) import Data.Array(Array,array,(!)) ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- -- | Create a window with the given title and size. openWindow :: Title -> Size -> IO Window -- | Erase all drawing in the window. -- (That is, set the 'Graphic' held by the window to 'emptyGraphic'.) clearWindow :: Window -> IO () -- | Draw the given graphic on the window, on top of anything that is -- already there. -- (That is, combine the given 'Graphic' and the one held by the window -- using 'overGraphic', store the result in the window, and display it.) drawInWindow :: Window -> Graphic -> IO () -- | Run an action inside a new window, ensuring that the window is destroyed -- on exit. withWindow :: Title -> Size -> (Window -> IO a) -> IO a -- | A variant of 'withWindow' that ignores the result of the action. withWindow_ :: Title -> Size -> (Window -> IO a) -> IO () -- | A combination of 'runGraphics' and 'withWindow_'. runWindow :: Title -> Size -> (Window -> IO a) -> IO () -- | The current size of the window. getWindowSize :: Window -> IO Size -- | Wait for a press of the left mouse button, -- and return the position of the mouse cursor. getLBP :: Window -> IO Point -- | Wait for a press of the right mouse button, -- and return the position of the mouse cursor. getRBP :: Window -> IO Point -- | Wait for a mouse button to be pressed or released, -- and return the position of the mouse cursor. getButton :: Window -> Bool -- ^ if 'True', wait for the left button -> Bool -- ^ if 'True', wait for a press; -- otherwise wait for a release. -> IO Point -- | Wait until a key is pressed and released. getKey :: Window -> IO Key -- | Wait until a key is pressed (if the second argument is 'True') -- or released (otherwise). getKeyEx :: Window -> Bool -> IO Key -- | Wait for a translated character (from a key press). -- Use in preference to 'getKey' if the aim is to read text. wGetChar :: Window -> IO Char -- | An empty drawing. emptyGraphic :: Graphic -- | A composite drawing made by overlaying the first argument on the second. overGraphic :: Graphic -> Graphic -> Graphic -- | Overlay a list of drawings. overGraphics :: [Graphic] -> Graphic -- | Set the default font for a drawing. withFont :: Font -> Graphic -> Graphic -- | Set the default color for drawing text. withTextColor :: RGB -> Graphic -> Graphic -- | Set the default alignment of text in a drawing. withTextAlignment :: Alignment -> Graphic -> Graphic -- | Set the default background color for drawing text with background -- mode 'Opaque'. The background color is ignored when the mode is -- 'Transparent'. withBkColor :: RGB -> Graphic -> Graphic -- | Set the default background mode for drawing text. withBkMode :: BkMode -> Graphic -> Graphic -- | Set the default pen for drawing lines. withPen :: Pen -> Graphic -> Graphic -- | Set the default brush for filling shapes. withBrush :: Brush -> Graphic -> Graphic -- | A convenience function that sets the brush, -- pen and text colors to the same value. withRGB :: RGB -> Graphic -> Graphic -- | Named colors. data Color = Black | Blue | Green | Cyan | Red | Magenta | Yellow | White deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read) -- | A mapping of 'Color' names to 'RGB' triples. colorList :: [(Color, RGB)] -- | A mapping of 'Color' names to 'RGB' triples. colorTable :: Array Color RGB -- | Set the default drawing color for a 'Graphic'. withColor :: Color -> Graphic -> Graphic -- | Run two 'IO' actions in parallel and terminate when both actions terminate. par :: IO a -> IO b -> IO (a,b) -- | Run two 'IO' actions in parallel and terminate when both actions terminate, -- discarding the results of the actions. par_ :: IO a -> IO b -> IO () -- | Run several 'IO' actions in parallel and terminate when all actions -- terminate, discarding the results of the actions. parMany :: [IO ()] -> IO () ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- -- Window operations openWindow name size = openWindowEx name Nothing size Unbuffered Nothing clearWindow w = setGraphic w emptyGraphic getWindowSize w = do (pt,sz) <- getWindowRect w return sz drawInWindow w p = do modGraphic w (p `overGraphic`) directDraw w p withWindow name size = E.bracket (openWindow name size) closeWindow withWindow_ name size f = withWindow name size f >> return () runWindow name size f = runGraphics (withWindow_ name size f) -- Event operations -- wait for left/right mouse button up (SOE p148) getLBP w = getButton w True True getRBP w = getButton w False True -- Wait for a key to go down then a (possibly different) key to go up getKey w = do { getKeyEx w True; getKeyEx w False } -- wait for key to go down/up getKeyEx w down = loop where loop = do e <- getWindowEvent w case e of Key { keysym = k, isDown = isDown } | isDown == down -> return k _ -> loop getButton w left down = loop where loop = do e <- getWindowEvent w case e of Button {pt=pt,isLeft=isLeft,isDown=isDown} | isLeft == left && isDown == down -> return pt _ -> loop wGetChar w = loop where loop = do e <- getWindowEvent w case e of Char {char = c} -> return c _ -> loop -- Graphic --elsewhere: type Graphic = Draw () emptyGraphic = return () g1 `overGraphic` g2 = g2 >> g1 overGraphics = foldr overGraphic emptyGraphic -- Graphic modifiers withFont x = bracket_ (selectFont x) selectFont withTextAlignment x = bracket_ (setTextAlignment x) setTextAlignment withTextColor x = bracket_ (setTextColor x) setTextColor withBkColor x = bracket_ (setBkColor x) setBkColor withBkMode x = bracket_ (setBkMode x) setBkMode withPen x = bracket_ (selectPen x) selectPen withBrush x = bracket_ (selectBrush x) selectBrush withRGB c p = mkBrush c $ \ brush -> withBrush brush $ mkPen Solid 2 c $ \ pen -> withPen pen $ withTextColor c $ p colorList = [ (Black , RGB 0 0 0) , (Blue , RGB 0 0 255) , (Green , RGB 0 255 0) , (Cyan , RGB 0 255 255) , (Red , RGB 255 0 0) , (Magenta , RGB 255 0 255) , (Yellow , RGB 255 255 0) , (White , RGB 255 255 255) ] colorTable = array (minBound, maxBound) colorList withColor c g = withRGB (colorTable ! c) g -- Concurrency primitives par m1 m2 = do v1 <- newEmptyMVar v2 <- newEmptyMVar forkIO (m1 >>= putMVar v1) forkIO (m2 >>= putMVar v2) a <- takeMVar v1 b <- takeMVar v2 return (a,b) par_ m1 m2 = do v1 <- newEmptyMVar v2 <- newEmptyMVar forkIO (m1 >> putMVar v1 ()) forkIO (m2 >> putMVar v2 ()) takeMVar v1 takeMVar v2 return () parMany ms = foldr par_ (return ()) ms ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/X11/0000755006511100651110000000000010504340421017667 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/Graphics/HGL/X11/Timer.hs0000644006511100651110000000701710504340421021310 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.X11.Timer -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (requires concurrency) -- -- A simple graphics library. -- ----------------------------------------------------------------------------- -- #hide module Graphics.HGL.X11.Timer ( Timer, new, stop , Timers, newTimers, clearTimers, nextTick, fireTimers ) where import Control.Concurrent ( MVar, newMVar, takeMVar, putMVar, readMVar ) import Graphics.HGL.Internals.Utilities( modMVar_ ) import Graphics.HGL.Internals.Types ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- data Timer = Timer { period :: Time -- how often does it fire , action :: IO () -- what to do when it does , tag :: MVar () -- something that supports an equality test } -- A standard timer implementation using a list of (delta-time,timer) pairs. type Timers = MVar [(Time, Timer)] newTimers :: IO Timers clearTimers :: Timers -> IO () nextTick :: Timers -> IO (Maybe Time) fireTimers :: Timers -> Time -> IO () new :: Timers -> Time -> IO () -> IO Timer stop :: Timers -> Timer -> IO () ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- newTimers = do newMVar [] -- This will only work if the mvar is non-empty. -- Fortunately, all operations on timers do atomic updates (modMVar) -- so this should be true. clearTimers ts = do modMVar_ ts (const []) fireTimers timers t = do xs <- takeMVar timers let (ts,xs') = firedTimers t xs xs'' = foldr insert xs' ts putMVar timers xs'' mapM_ action ts where insert :: Timer -> [(Time,Timer)] -> [(Time,Timer)] insert timer = insertTimer (period timer) timer nextTick timers = do ts <- readMVar timers case ts of ((t,_):_) -> return (Just t) _ -> return Nothing new timers t a = do tag <- newMVar () let timer = Timer{period=t, action=a, tag=tag} modMVar_ timers (insertTimer t timer) return timer stop timers timer = do modMVar_ timers (deleteTimer timer) instance Eq Timer where t1 == t2 = tag t1 == tag t2 insertTimer :: Time -> Timer -> [(Time,Timer)] -> [(Time,Timer)] insertTimer t timer [] = [(t,timer)] insertTimer t timer (x@(t',timer'):xs) | t <= t' = (t,timer) : (t'-t, timer') : xs | otherwise = x : insertTimer (t-t') timer xs deleteTimer :: Timer -> [(Time,Timer)] -> [(Time,Timer)] deleteTimer timer [] = [] deleteTimer timer (x@(t',timer'):xs) | timer == timer' = case xs of [] -> [] (t'', timer''):xs' -> (t'+t'', timer''):xs' | otherwise = x : deleteTimer timer xs -- we could try to avoid timer drift by returning how "late" we are -- in firing the timer -- Maybe a better approach is to make use of the real-time clock provided -- by the OS and stay in sync with that? firedTimers :: Time -> [(Time,Timer)] -> ([Timer],[(Time,Timer)]) firedTimers t [] = ([],[]) firedTimers t ((t',timer):xs) | t < t' = ([], (t'-t,timer):xs) | otherwise = let (timers, xs') = firedTimers (t-t') xs in (timer : timers, xs') ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/X11/DC.hs0000644006511100651110000000357510504340421020523 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.X11.DC -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (requires concurrency) -- -- A simple graphics library. -- ----------------------------------------------------------------------------- -- #hide module Graphics.HGL.X11.DC ( drawUnbuffered, drawBuffered, erase ) where import Graphics.HGL.X11.Types import qualified Graphics.X11.Xlib as X import Data.IORef( IORef, readIORef, writeIORef ) import Control.Concurrent( readMVar ) import Graphics.HGL.Internals.Draw ---------------------------------------------------------------- -- Draw ---------------------------------------------------------------- drawUnbuffered :: DC -> Draw () -> IO () drawUnbuffered dc p = do unDraw erase dc unDraw p dc drawBuffered :: DC -> Draw () -> X.GC -> Int -> IORef (Maybe X.Pixmap) -> IO () drawBuffered dc p gc depth ref_mbuffer = do (_,(width,height)) <- readMVar (ref_rect dc) -- Note: The buffer is deallocated whenever the window size changes! mbuffer <- readIORef ref_mbuffer buffer <- case mbuffer of Nothing -> X.createPixmap (disp dc) (drawable dc) width height depth Just buffer -> return buffer X.fillRectangle (disp dc) buffer gc 0 0 width height unDraw p dc{drawable=buffer} X.copyArea (disp dc) buffer (drawable dc) (paintGC dc) 0 0 width height 0 0 writeIORef ref_mbuffer (Just buffer) erase :: Draw () erase = mkDraw (\ dc -> X.clearWindow (disp dc) (drawable dc)) ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/X11/Display.hs0000644006511100651110000000271310504340421021633 0ustar rossross-- #hide module Graphics.HGL.X11.Display ( getDisplayName , openDisplay , closeDisplay , getDisplay ) where import Graphics.HGL.Internals.Utilities (modMVar) import qualified Graphics.X11.Xlib as X import Control.Concurrent.MVar (MVar, newMVar, readMVar, takeMVar, putMVar) import Control.Monad (when) import Data.Maybe (isJust) import System.Environment (getEnv) import System.IO.Error (try) import System.IO.Unsafe (unsafePerformIO) getDisplayName :: IO String getDisplayName = do disp <- try (getEnv "DISPLAY") return (either (const ":0.0") id disp) displayRef :: MVar (Maybe X.Display) displayRef = unsafePerformIO (newMVar Nothing) openDisplay :: String -> IO () -> IO X.Display openDisplay host cleanup = do mb_display <- readMVar displayRef when (isJust mb_display) cleanup openDisplay' where openDisplay' = do display <- X.openDisplay host `catch` \ err -> ioError (userError ("Unable to open X display " ++ host)) modMVar displayRef (const $ Just display) return display closeDisplay :: IO () closeDisplay = do mb_display <- takeMVar displayRef case mb_display of Nothing -> do putMVar displayRef Nothing Just display -> do X.closeDisplay display putMVar displayRef Nothing getDisplay :: IO X.Display getDisplay = do mb_display <- readMVar displayRef case mb_display of Nothing -> ioError $ userError "Display not opened yet" Just display -> return display hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/X11/Types.hs0000644006511100651110000000550210504340421021331 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.X11.Types -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (requires concurrency) -- -- Basic types for a simple graphics library. -- ----------------------------------------------------------------------------- -- #hide module Graphics.HGL.X11.Types ( DC(..) , DC_Bits(..) , Font(Font), Brush(Brush), Pen(Pen), defaultPen , Key(MkKey) , fromPoint, toPoint , fromSize, toSize , lookupColor ) where import Graphics.HGL.Internals.Types import qualified Graphics.X11.Xlib as X import Control.Concurrent.MVar (MVar) import Data.Bits import Data.Word (Word8) ---------------------------------------------------------------- -- Units ---------------------------------------------------------------- fromPoint :: Point -> X.Point toPoint :: X.Point -> Point fromSize :: Size -> (X.Dimension, X.Dimension) toSize :: (X.Dimension, X.Dimension) -> Size fromPoint (x,y) = X.Point (fromIntegral x) (fromIntegral y) toPoint (X.Point x y) = (fromIntegral x, fromIntegral y) fromSize (x,y) = (fromIntegral x, fromIntegral y) toSize (x,y) = (fromIntegral x, fromIntegral y) ---------------------------------------------------------------- -- Device Context (simulates Win32 Device Contexts) ---------------------------------------------------------------- data DC = MkDC { disp :: X.Display , drawable :: X.Drawable , textGC :: X.GC , paintGC :: X.GC , brushGC :: X.GC , ref_rect :: MVar (X.Point,(X.Dimension, X.Dimension)) , ref_bits :: MVar DC_Bits } data DC_Bits = DC_Bits { textColor :: RGB , bkColor :: RGB , bkMode :: BkMode , textAlignment :: Alignment , brush :: Brush , pen :: Pen , font :: Font } newtype Key = MkKey X.KeySym deriving Show newtype Font = Font X.FontStruct newtype Brush = Brush RGB data Pen = Pen Style Int X.Pixel defaultPen :: X.Pixel -> Pen defaultPen col = Pen Solid 0 col lookupColor :: X.Display -> RGB -> IO X.Pixel lookupColor display col = (do (X.Color p _ _ _ _) <- X.allocColor display color_map (X.Color 0 r g b xcolor_flags) return p) `catch` \ err -> print err >> return 0 -- ioError (userError ("Error: " ++ show err -- ++ "\nUnable to allocate colo[u]r " ++ show (r,g,b) -- ++ " - I'll bet you're running Netscape.")) where screen = X.defaultScreenOfDisplay display color_map = X.defaultColormapOfScreen screen RGB r' g' b' = col (r,g,b) = ((fromIntegral r') * 256, (fromIntegral g') * 256, (fromIntegral b')*256) xcolor_flags :: Word8 xcolor_flags = X.doRed .|. X.doGreen .|. X.doBlue hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/X11/Window.hs0000644006511100651110000005334210504340421021501 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.X11.Window -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (requires concurrency) -- -- A simple graphics library. -- ----------------------------------------------------------------------------- -- #hide module Graphics.HGL.X11.Window ( runGraphicsEx -- :: String -> IO () -> IO () , Window(events, graphic) , openWindowEx -- :: Title -> Maybe Point -> Size -> -- RedrawMode -> Maybe Time -> IO Window , closeWindow -- :: Window -> IO () , getWindowRect -- :: Window -> IO (Point,Point) , redrawWindow -- :: Window -> IO () , directDraw -- :: Window -> Graphic -> IO () , sendTicks, findWindow, showEvent ) where import Graphics.HGL.Internals.Types import Graphics.HGL.Internals.Draw (Graphic, Draw, unDraw) import Graphics.HGL.Internals.Event import qualified Graphics.HGL.Internals.Utilities as Utils import qualified Graphics.HGL.Internals.Events as E import Graphics.HGL.X11.Types import Graphics.HGL.X11.Display import Graphics.HGL.X11.DC import qualified Graphics.HGL.X11.Timer as T import qualified Graphics.X11.Xlib as X import Control.Concurrent (forkIO, yield) import Control.Concurrent.MVar (MVar, newMVar, takeMVar, putMVar, readMVar) import Control.Exception (finally) import Control.Monad (when) import Data.Bits import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (isJust, fromJust, fromMaybe) import System.IO.Unsafe (unsafePerformIO) ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- data Window = MkWindow { wnd :: X.Window -- the real window , ref_dc :: MVar (Maybe DC) -- "device context" , exposed :: IORef Bool -- have we had an expose event yet? , events :: E.Events -- the event stream , graphic :: MVar Graphic -- the current graphic , redraw :: RedrawStuff , timer :: Maybe T.Timer } openWindowEx :: Title -> Maybe Point -> Size -> RedrawMode -> Maybe Time -> IO Window closeWindow :: Window -> IO () getWindowRect :: Window -> IO (Point,Point) redrawWindow :: Window -> IO () directDraw :: Window -> Graphic -> IO () ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- ---------------------------------------------------------------- -- Windows ---------------------------------------------------------------- closeWindow' :: Bool -> Window -> IO () closeWindow' destroyXWindow w = do mb_dc <- takeMVar (ref_dc w) case mb_dc of Just dc -> do putMVar (ref_dc w) Nothing -- mark it for dead X.freeGC (disp dc) (textGC dc) X.freeGC (disp dc) (paintGC dc) X.freeGC (disp dc) (brushGC dc) case (redraw w) of UnbufferedStuff -> return () BufferedStuff gc _ ref_mbuffer -> do X.freeGC (disp dc) gc removeBuffer dc ref_mbuffer when destroyXWindow $ do X.destroyWindow (disp dc) (drawable dc) -- ths dc had better hold a window! minor_eloop (disp dc) Nothing -> do putMVar (ref_dc w) Nothing removeBuffer :: DC -> IORef (Maybe X.Pixmap) -> IO () removeBuffer dc ref_mbuffer = do mbuffer <- readIORef ref_mbuffer case mbuffer of Nothing -> return () Just buffer -> X.freePixmap (disp dc) buffer writeIORef ref_mbuffer Nothing removeDeadWindows :: IO () removeDeadWindows = do ws <- takeMVar wnds ws' <- remove ws [] putMVar wnds ws' where remove [] r = return r remove (w:ws) r = do mb_dc <- readMVar (ref_dc w) if (isJust mb_dc) then remove ws (w:r) else remove ws r closeAllWindows :: IO () closeAllWindows = do ws <- readMVar wnds mapM_ (closeWindow' True) ws removeDeadWindows -- bring out your dead sendTicks :: IO () sendTicks = do ws <- readMVar wnds sequence_ [ E.sendTick (events w) | w <- ws ] -- persistent list of open windows wnds :: MVar [Window] wnds = unsafePerformIO (newMVar []) -- persistent list of timers timers :: T.Timers timers = unsafePerformIO T.newTimers runGraphicsEx :: String -> IO () -> IO () runGraphicsEx host m = do X.setDefaultErrorHandler display <- openDisplay host closeAllWindows T.clearTimers timers -- color_map <- X.getStandardColormap display root X.a_RGB_BEST_MAP -- HN 2001-01-30 -- There is a race condition here since the event loop terminates if it -- encounters an empty window list (in the global, imperative, variable -- wnds). Thus, if m has not yet opened a window (assuming it will!) -- when the event_loop is entered, it will exit immediately. -- Solution: wait until either the window list is non-empty, or until -- m exits (in case it does not open a window for some reason). mDone <- newIORef False forkIO (catchErrors m `finally` writeIORef mDone True) let loop = do yield ws <- readMVar wnds d <- readIORef mDone if not (null ws) then main_eloop display else if not d then loop else return () catchErrors loop -- X.sync display True closeAllWindows -- X.sync display True -- A final yield to make sure there's no threads thinking of -- accessing the display yield closeDisplay catchErrors :: IO () -> IO () catchErrors m = do r <- Utils.safeTry m case r of Left e -> do -- putStr "Uncaught Error: " print e Right _ -> return () return () ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- openWindowEx name pos size redrawMode tickRate = do display <- getDisplay let corner@(X.Point x y) = fromPoint (fromMaybe (0,0) pos) (w,h) = fromSize size let screen = X.defaultScreenOfDisplay display fg_color = X.whitePixelOfScreen screen bg_color = X.blackPixelOfScreen screen depth = X.defaultDepthOfScreen screen root = X.rootWindowOfScreen screen visual = X.defaultVisualOfScreen screen -- ToDo: resurrect the old code for constructing attribute sets window <- X.allocaSetWindowAttributes $ \ attributes -> do X.set_background_pixel attributes bg_color let event_mask = ( X.buttonPressMask .|. X.buttonReleaseMask .|. X.keyPressMask .|. X.keyReleaseMask .|. X.pointerMotionMask .|. X.exposureMask .|. X.structureNotifyMask ) X.set_event_mask attributes event_mask -- We use backing store to reduce the number of expose events due to -- raising/lowering windows. X.set_backing_store attributes X.whenMapped -- We use bit-gravity to avoid generating exposure events when a window is -- made smaller (they can't be avoided when the window is enlarged). -- The choice of NW is somewhat arbitrary but hopefully works often -- enough to be worth it. X.set_bit_gravity attributes X.northWestGravity let attrmask = X.cWBackPixel .|. X.cWEventMask .|. X.cWBackingStore .|. X.cWBitGravity X.createWindow display root x y -- x, y w h -- width, height 1 -- border_width depth -- use CopyFromParent?? X.inputOutput visual -- use CopyFromParent?? attrmask attributes -- AC, 1/9/2000: Tell the window manager that we want to use the -- DELETE_WINDOW protocol delWinAtom <- X.internAtom display "WM_DELETE_WINDOW" False X.setWMProtocols display window [delWinAtom] X.setTextProperty display window name X.wM_ICON_NAME X.setTextProperty display window name X.wM_NAME X.mapWindow display window X.raiseWindow display window text_gc <- X.createGC display window X.setBackground display text_gc bg_color X.setForeground display text_gc fg_color pen_gc <- X.createGC display window X.setBackground display pen_gc bg_color X.setForeground display pen_gc fg_color brush_gc <- X.createGC display window X.setBackground display brush_gc bg_color X.setForeground display brush_gc fg_color redraw <- case redrawMode of Unbuffered -> return UnbufferedStuff DoubleBuffered -> do gc <- X.createGC display window X.setForeground display gc bg_color -- gc for clearing the screen ref_mbuffer <- newIORef Nothing return (BufferedStuff gc depth ref_mbuffer) win <- newWindow display window fg_color text_gc pen_gc brush_gc (corner,(w,h)) redraw tickRate -- It might be some time till we get back to the event loop -- so we try to process as many events as possible now. -- This is a bit of a hack and partly aimed at avoiding the bug that -- directDraw might try to draw something before the first expose event -- is processed. -- To make the hack even more effective, we wait a short time (allegedly -- 1uS) and synchronise before looking for the event. -- -- NB: -- This whole thing is based on the implicit notion that the server thread -- is "lower priority" than the user threads. That is, the server thread -- will only run when no user threads are runnable. -- -- Or, more concretely, only the server thread calls yield so it's safe -- to call the minor_eloop (which doesn't yield or block) but not the -- major_eloop because, amongst other things, it may yield or block. X.waitForEvent display 1 X.sync display False minor_eloop display return win closeWindow w = do closeWindow' True w removeDeadWindows -- bring out your dead getWindowRect w = do mb_dc <- readMVar (ref_dc w) case mb_dc of Just dc -> do (pt,sz) <- readMVar (ref_rect dc) return (toPoint pt, toSize sz) Nothing -> return ((0,0),(0,0)) -- ToDo? -- main_eloop :: X.Display -> IO () -- main_eloop d = -- X.allocaXEvent $ \ xevent -> do -- let loop = do -- -- X.sync d False -- wild attempt to fix the broken X connection problem -- count <- X.pending d -- if (count > 0) then do -- -- X.sync d False -- wild attempt to fix the broken X connection problem -- X.nextEvent d xevent -- window <- X.get_Window xevent -- wnd <- findWindow window -- etype <- X.get_EventType xevent -- -- print (window,etype) -- dispatchEvent wnd etype xevent -- ws <- readMVar wnds -- unless (null ws) loop -- else -- loop -- loop -- This is the main event loop in the program main_eloop :: X.Display -> IO () main_eloop d = X.allocaXEvent $ \ xevent -> do let handleEvent = do count <- X.pending d next <- T.nextTick timers if (count > 0 || not (isJust next)) then do -- Event in queue or no tick pending. X.nextEvent d xevent window <- X.get_Window xevent etype <- X.get_EventType xevent -- showEvent etype withWindow window $ \ wnd -> do dispatchEvent d wnd etype xevent else do -- No event and tick pending. let delay = fromJust next t0 <- getTime timedOut <- X.waitForEvent d (fromIntegral (delay * 1000)) t1 <- getTime T.fireTimers timers (t1 - t0) let loop = do -- We yield at this point because we're (potentially) -- about to block so we should give other threads a chance -- to run. yield ws <- readMVar wnds if (null ws) then return () else do handleEvent loop loop -- This event loop is the same as above except that it is -- non-blocking: it only handles those events that have already arrived. -- And this is important because it means we don't have to yield which -- means it can safely be called by user code (see comment in openWindowEx). minor_eloop :: X.Display -> IO () minor_eloop d = X.allocaXEvent $ \ xevent -> do let handleEvent = do X.nextEvent d xevent window <- X.get_Window xevent etype <- X.get_EventType xevent -- print etype withWindow window $ \ wnd -> do dispatchEvent d wnd etype xevent return () loop = do ws <- readMVar wnds if null ws then return () else do -- Note: _do not_ call pending if null ws count <- X.pending d if count == 0 then return () else do handleEvent loop loop -- The DC is wrapped inside (MVar (Maybe ...)) so that we can mark -- windows as being dead the moment they die and so that we don't -- try to keep writing to them afterwards. -- The events remain valid after the window dies. -- It might be wiser to clear all events(???) and start returning -- Closed whenever events are read - or (more GC friendly?), when -- first read occurs but block thereafter? data RedrawStuff = UnbufferedStuff | BufferedStuff X.GC -- GC with foreground = background_color Int -- depth (IORef (Maybe X.Pixmap)) -- The buffer, allocated on demand -- drawBuffered. drawOnDC :: DC -> Draw () -> RedrawStuff -> IO () drawOnDC dc p redraw = case redraw of UnbufferedStuff -> drawUnbuffered dc p BufferedStuff gc depth ref_mbuffer -> drawBuffered dc p gc depth ref_mbuffer newWindow :: X.Display -> X.Window -> X.Pixel -> X.GC -> X.GC -> X.GC -> (X.Point,(X.Dimension,X.Dimension)) -> RedrawStuff -> Maybe Time -> IO Window newWindow display window fg_color tgc pgc bgc rect redraw tickRate = do es <- E.newEvents pic <- newMVar (return ()) -- failed attempts to find the default font -- f' <- X.fontFromGC display tgc -- f <- X.queryFont display f' -- Since we can't ask the server what default font it chooses to bless -- us with, we have to set an explicit font. f <- X.loadQueryFont display "9x15" -- a random choice X.setFont display tgc (X.fontFromFontStruct f) bits <- newMVar DC_Bits { textColor = RGB 255 255 255 , bkColor = RGB 0 0 0 , bkMode = Transparent , textAlignment = (Left',Top) , brush = Brush (RGB 255 255 255) , pen = defaultPen fg_color , font = Font f } ref_rect <- newMVar rect dc <- newMVar (Just MkDC{disp=display,drawable=window,textGC=tgc,paintGC=pgc,brushGC=bgc,ref_rect=ref_rect,ref_bits=bits}) timer <- case tickRate of Just t -> T.new timers t (E.sendTick es) >>= return.Just Nothing -> return Nothing ref_exposed <- newIORef False let wnd = MkWindow{wnd=window,ref_dc=dc,exposed=ref_exposed,events=es,graphic=pic,redraw=redraw,timer=timer} Utils.modMVar wnds (wnd:) return wnd redrawWindow w = do canDraw <- readIORef (exposed w) when canDraw $ do mb_dc <- readMVar (ref_dc w) case mb_dc of Just dc -> do p <- readMVar (graphic w) drawOnDC dc p (redraw w) Nothing -> return () directDraw w p = do mb_dc <- readMVar (ref_dc w) canDraw <- readIORef (exposed w) when canDraw $ do case mb_dc of Just dc -> unDraw p dc Nothing -> return () findWindow :: X.Window -> IO Window findWindow xw = do ws <- readMVar wnds return (head [ w | w <- ws, xw == wnd w ]) -- ToDo: don't use head withWindow :: X.Window -> (Window -> IO ()) -> IO () withWindow xw k = do ws <- readMVar wnds case [ w | w <- ws, xw == wnd w ] of (w:_) -> k w _ -> return () send :: Window -> Event -> IO () send w e = E.sendEvent (events w) e dispatchEvent :: X.Display -> Window -> X.EventType -> X.XEventPtr -> IO () dispatchEvent display w etype xevent | etype == X.graphicsExpose || etype == X.expose = paint | etype == X.motionNotify = mouseMove | etype == X.buttonPress = button True | etype == X.buttonRelease = button False | etype == X.keyPress = key True | etype == X.keyRelease = key False | etype == X.configureNotify = reconfig | etype == X.destroyNotify = destroy -- AC, 1/9/2000: treat a ClientMesage as a destroy event -- TODO: really need to examine the event in more detail, -- and ensure that xevent.xclient.message_type==ATOM_WM_PROTOCOLS && -- xevent.xclient.data.l[0]==ATOM_WM_DELETE_WINDOW -- where ATOM_XXX is obtained from XInternAtom(dpy,"XXX",False) | etype == X.clientMessage = destroy -- ToDo: consider printing a warning message | otherwise = return () where -- Redrawing is awkward because the request comes as a number of -- separate events. We need to do one of the following (we currently -- do a combination of (1) and (3)): -- 1) Do a single redraw of the entire window but first delete all other -- expose events for this window from the queue. -- 2) Use all expose events for this window to build a Region object -- and use that to optimise redraws. -- 3) When double-buffering, use the buffer and information about -- whether it is up to date to serve redraws from the buffer. -- When single-buffering, use the server's backing store to reduce -- the number of expose events. (Combine with bit-gravity info to -- handle resize requests.) paint :: IO () paint = do let stompOnExposeEvents = do -- X.get_ExposeEvent xevent >>= print gotOne <- X.checkTypedWindowEvent display (wnd w) X.expose xevent when gotOne stompOnExposeEvents writeIORef (exposed w) True -- now safe to draw directly stompOnExposeEvents p <- readMVar (graphic w) mb_dc <- readMVar (ref_dc w) case mb_dc of Just dc -> drawOnDC dc p (redraw w) Nothing -> return () button :: Bool -> IO () button isDown = do (_,_,_,x,y,_,_,_,b,_) <- X.get_ButtonEvent xevent let isLeft = b == 1 -- assume that button 1 = left button send w Button{pt = (x,y), isLeft=isLeft, isDown=isDown} -- An X KeySym is *not* a character; not even a Unicode character! And -- since characters in Hugs only are 8-bit, we get a runtime error -- below. There is an underlying assumption that key events only -- involve characters. But of course there are function keys, arrow -- keys, etc. too. While this will be a problem if one wants to get at -- e.g. arrow keys (e.g. for some drawing application) or at -- dead/multi-keys for doing proper input, we'll ignore them -- completely for now. Furthermore, one really needs to call -- XlookupString (not XkeysymToString!) to do the processing! We'll -- ignore that too, and do a static mapping of just a few keysyms. key :: Bool -> IO () key isDown = do -- Should really use XmbLookupString here to make compose work. -- It's OK to call X.lookupString both on key up and down events. -- Not true for X.mbLookupString. In that case, use e.g. X.lookup -- on key up events. (mks, s) <- X.lookupString (X.asKeyEvent xevent) case mks of Just ks -> send w (Key {keysym = MkKey ks, isDown = isDown}) Nothing -> return () if isDown then (mapM_ (\c -> send w (Char {char = c})) s) else return () mouseMove ::IO () mouseMove = do (_,_,_,x,y,_,_,_,_,_) <- X.get_MotionEvent xevent send w MouseMove{ pt = (x,y) } reconfig :: IO () reconfig = do (x,y,width,height) <- X.get_ConfigureEvent xevent mb_dc <- readMVar (ref_dc w) case mb_dc of Just dc -> do Utils.modMVar (ref_rect dc) (const ((X.Point x y),(width,height))) case (redraw w) of UnbufferedStuff -> return () BufferedStuff _ _ ref_mbuffer -> removeBuffer dc ref_mbuffer Nothing -> return () -- don't send new size, it may be out of date by the time we -- get round to reading the event send w Resize destroy :: IO () destroy = do -- putStrLn "Window Destroyed" -- todo closeWindow' True w removeDeadWindows -- bring out your dead send w Closed ---------------------------------------------------------------- -- Utilities ---------------------------------------------------------------- -- Only for debugging showEvent :: X.EventType -> IO () showEvent etype | etype == X.keyPress = putStrLn "keyPress" | etype == X.keyRelease = putStrLn "keyRelease" | etype == X.buttonPress = putStrLn "buttonPress" | etype == X.buttonRelease = putStrLn "buttonRelease" | etype == X.motionNotify = putStrLn "motionNotify" | etype == X.enterNotify = putStrLn "enterNotify" | etype == X.leaveNotify = putStrLn "leaveNotify" | etype == X.focusIn = putStrLn "focusIn" | etype == X.focusOut = putStrLn "focusOut" | etype == X.keymapNotify = putStrLn "keymapNotify" | etype == X.expose = putStrLn "expose" | etype == X.graphicsExpose = putStrLn "graphicsExpose" | etype == X.noExpose = putStrLn "noExpose" | etype == X.visibilityNotify = putStrLn "visibilityNotify" | etype == X.createNotify = putStrLn "createNotify" | etype == X.destroyNotify = putStrLn "destroyNotify" | etype == X.unmapNotify = putStrLn "unmapNotify" | etype == X.mapNotify = putStrLn "mapNotify" | etype == X.mapRequest = putStrLn "mapRequest" | etype == X.reparentNotify = putStrLn "reparentNotify" | etype == X.configureNotify = putStrLn "configureNotify" | etype == X.configureRequest = putStrLn "configureRequest" | etype == X.gravityNotify = putStrLn "gravityNotify" | etype == X.resizeRequest = putStrLn "resizeRequest" | etype == X.circulateNotify = putStrLn "circulateNotify" | etype == X.circulateRequest = putStrLn "circulateRequest" | etype == X.propertyNotify = putStrLn "propertyNotify" | etype == X.selectionClear = putStrLn "selectionClear" | etype == X.selectionRequest = putStrLn "selectionRequest" | etype == X.selectionNotify = putStrLn "selectionNotify" | etype == X.colormapNotify = putStrLn "colormapNotify" | etype == X.clientMessage = putStrLn "clientMessage" | etype == X.mappingNotify = putStrLn "mappingNotify" | etype == X.lASTEvent = putStrLn "lASTEvent" | otherwise = putStrLn ("Unknown X event type: " ++ show etype) ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL/Window.hs0000644006511100651110000001355010504340421021125 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL.Window -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- Windows in a simple graphics library. -- ----------------------------------------------------------------------------- #include "HsHGLConfig.h" module Graphics.HGL.Window ( -- * Windows Window , Title -- = String , RedrawMode(Unbuffered, DoubleBuffered) , openWindowEx -- :: Title -> Maybe Point -> Maybe Size -> -- RedrawMode -> Maybe Time -> IO Window , getWindowRect -- :: Window -> IO (Point,Point) , closeWindow -- :: Window -> IO () -- * Drawing in a window , setGraphic -- :: Window -> Graphic -> IO () , getGraphic -- :: Window -> IO Graphic , modGraphic -- :: Window -> (Graphic -> Graphic) -> IO () , directDraw -- :: Window -> Graphic -> IO () -- not in X11: , redrawWindow -- :: Window -> IO () -- * Events in a window , Event(..) -- , Event(Char,Key,Button,MouseMove,Resize,Closed) -- deriving(Show) -- , char -- :: Event -> Char -- , keysym -- :: Event -> Key -- , isDown -- :: Event -> Bool -- , pt -- :: Event -> Point -- , isLeft -- :: Event -> Bool , getWindowEvent -- :: Window -> IO Event , maybeGetWindowEvent -- :: Window -> IO (Maybe Event) -- * Timer ticks -- | Timers that tick at regular intervals are set up by 'openWindowEx'. , getWindowTick -- :: Window -> IO () , getTime -- :: IO Time ) where #ifdef __HADDOCK__ import Graphics.HGL.Key #endif import Graphics.HGL.Units import Graphics.HGL.Draw( Graphic ) import Graphics.HGL.Internals.Event( Event(..) ) import Graphics.HGL.Internals.Types( Title, RedrawMode(..), getTime ) import qualified Graphics.HGL.Internals.Events as E import Graphics.HGL.Internals.Utilities( modMVar, modMVar_ ) #if !X_DISPLAY_MISSING import Graphics.HGL.X11.Window (Window(..)) import qualified Graphics.HGL.X11.Window as X (openWindowEx, closeWindow, redrawWindow, directDraw, getWindowRect ) #else import Graphics.HGL.Win32.WND (WND, openWND, getHWND, closeWND, wndRect, redrawWND, drawWND) import Graphics.HGL.Win32.Types import Graphics.HGL.Win32.Draw( drawGraphic, drawBufferedGraphic ) import Graphics.HGL.Draw (Draw) -- import Graphics.HGL.Internals.Types import qualified Graphics.Win32 as Win32 #endif import Control.Concurrent.MVar ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- -- | Wait for the next event on the given window. getWindowEvent :: Window -> IO Event -- | Check for a pending event on the given window. maybeGetWindowEvent :: Window -> IO (Maybe Event) -- | Wait for the next tick event from the timer on the given window. getWindowTick :: Window -> IO () -- | Get the current drawing in a window. getGraphic :: Window -> IO Graphic -- | Set the current drawing in a window. setGraphic :: Window -> Graphic -> IO () -- | Update the drawing for a window. -- Note that this does not force a redraw. modGraphic :: Window -> (Graphic -> Graphic) -> IO () -- | General window creation. openWindowEx :: Title -- ^ title of the window -> Maybe Point -- ^ the optional initial position of a window -> Size -- ^ initial size of the window -> RedrawMode -- ^ how to display a graphic on the window -> Maybe Time -- ^ the time between ticks (in milliseconds) of an -- optional timer associated with the window -> IO Window -- | Close the window. closeWindow :: Window -> IO () redrawWindow :: Window -> IO () directDraw :: Window -> Graphic -> IO () -- | The position of the top left corner of the window on the screen, -- and the size of the window. getWindowRect :: Window -> IO (Point, Size) ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- getWindowEvent w = E.getEvent (events w) maybeGetWindowEvent w = do noEvent <- E.isNoEvent (events w) if noEvent then return Nothing else do ev <- getWindowEvent w return (Just ev) getWindowTick w = E.getTick (events w) getGraphic w = readMVar (graphic w) setGraphic w p = do modMVar (graphic w) (const p) redrawWindow w modGraphic w = modMVar_ (graphic w) #if !X_DISPLAY_MISSING openWindowEx = X.openWindowEx closeWindow = X.closeWindow getWindowRect = X.getWindowRect redrawWindow = X.redrawWindow directDraw = X.directDraw #else /* X_DISPLAY_MISSING */ data Window = MkWindow { events :: E.Events, -- the event stream graphic :: MVar (Draw ()), -- the current graphic wnd :: WND -- the real window } openWindowEx name pos size redrawMode tickRate = do graphic <- newMVar (return ()) events <- E.newEvents let draw = \ hwnd hdc -> do p <- readMVar graphic repaint p hwnd hdc wnd <- openWND name (fmap fromPoint pos) (Just $ fromPoint size) events draw (fmap fromInteger tickRate) mkWindow wnd events graphic where repaint = case redrawMode of Unbuffered -> drawGraphic DoubleBuffered -> drawBufferedGraphic mkWindow :: WND -> E.Events -> MVar (Draw ()) -> IO Window mkWindow wnd events graphic = do return (MkWindow { wnd=wnd, events=events, graphic=graphic }) closeWindow w = closeWND (wnd w) getWindowRect w = wndRect (wnd w) redrawWindow w = redrawWND (wnd w) directDraw w p = drawWND (wnd w) p -- in case you need low level access windowHWND :: Window -> IO Win32.HWND windowHWND w = getHWND (wnd w) #endif /* X_DISPLAY_MISSING */ ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/Graphics/HGL.hs0000644006511100651110000000574210504340421017662 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.HGL -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires concurrency) -- -- A simple graphics library. -- ----------------------------------------------------------------------------- module Graphics.HGL ( -- $intro module Graphics.HGL.Units , module Graphics.HGL.Run , module Graphics.HGL.Window , module Graphics.HGL.Draw , module Graphics.HGL.Key , module Graphics.HGL.Utils -- $utils ) where import Graphics.HGL.Units import Graphics.HGL.Run import Graphics.HGL.Window import Graphics.HGL.Draw import Graphics.HGL.Key import Graphics.HGL.Utils {- $intro The Haskell Graphics Library is designed to give the programmer access to most interesting parts of the Win32 Graphics Device Interface and X11 library without exposing the programmer to the pain and anguish usually associated with using these interfaces. To give you a taste of what the library looks like, here is the obligatory \"Hello World\" program: > module Main where > > import Graphics.HGL > > main :: IO () > main = runGraphics $ > withWindow_ "Hello World Window" (300, 200) $ \ w -> do > drawInWindow w $ text (100, 100) "Hello World" > drawInWindow w $ ellipse (100, 80) (200, 180) > getKey w Here's what each function does: * 'runGraphics' (defined in "Graphics.HGL.Run") runs a graphical action in an appropriate environment. All the other functions of the library should be used inside 'runGraphics'. * 'withWindow_' runs an action using a new 'Window', specifying the window title and size (300 pixels wide and 200 high). The window is closed when the action finishes. * 'drawInWindow' draws a 'Graphic' (an abstract representation of a picture) on a 'Window'. * 'text' creates a 'Graphic' consisting of a string at the specified position. * 'ellipse' creates a 'Graphic' consisting of an ellipse fitting inside a rectangle defined by the two points. These and other functions for defining, combining and modifying pictures are in "Graphics.HGL.Draw". * 'getKey' waits for the user to press (and release) a key. (This is necessary here to prevent the window from closing before you have a chance to read what's on the screen.) The library is broken up into several pieces. -} {- $utils The module "Graphics.HGL.Utils" defines a number of convenience functions in terms of more primitive functions defined by other modules. For example, * 'withWindow_' is defined using 'openWindowEx' and 'closeWindow' (from "Graphics.HGL.Window"). * 'getKey' is defined using 'getWindowEvent', which waits for a range of user interface events. * Instead of drawing several 'Graphic' objects sequentially as in the above example, you can combine them into a single 'Graphic' object using 'overGraphic'. -} hugs98-plus-Sep2006/packages/HGL/Graphics/SOE.hs0000644006511100651110000002022710504340421017671 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.SOE -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : non-portable (requires concurrency) -- -- The graphics library used in /The Haskell School of Expression/, -- by Paul Hudak, cf . -- -- /Notes:/ -- -- * This module is called @SOEGraphics@ in the book. It is a cut -- down version of "Graphics.HGL", with the interface frozen to match -- the book. -- -- * In chapters 13, 17 and 19 of the book, there are imports of modules -- @Win32Misc@ and @Word@. These should be omitted, as 'timeGetTime' -- and 'word32ToInt' are provided by this module. ----------------------------------------------------------------------------- module Graphics.SOE ( -- * Getting started runGraphics -- p41 -- * Windows , Title -- p40 , Size , Window , openWindow , getWindowSize -- not in SOE, but Resize is , clearWindow -- used on p127 , drawInWindow -- p41 , drawInWindowNow -- backward compatibility (p281) , setGraphic -- p168 , closeWindow -- p41 -- ** General windows , openWindowEx -- p168 , RedrawMode -- SOE has (Graphic -> DrawFun) , drawGraphic -- p168 , drawBufferedGraphic -- * Drawing , Graphic -- p41 , emptyGraphic -- p171 , overGraphic , overGraphics -- not in SOE, but an obvious extension -- ** Color , Color(..) -- p43 , withColor -- ** Drawing text , text -- p41 -- ** Drawing shapes , Point , ellipse -- p43 , shearEllipse , line , polygon , polyline , polyBezier -- warning: becomes error message and polyline in X11 , Angle -- not in SOE , arc -- not in SOE, but handy for pie charts -- ** Regions , Region -- p117 , createRectangle , createEllipse , createPolygon , andRegion , orRegion , xorRegion , diffRegion , drawRegion -- * User interaction -- ** Keyboard events , getKey -- p41 -- ** Mouse events , getLBP -- used on p127 , getRBP -- not in SOE, but obvious -- ** General events , Event(..) -- p214 , maybeGetWindowEvent -- p248 , getWindowEvent -- not in SOE, but obvious -- * Time -- Timers that tick at regular intervals are set up by 'openWindowEx'. , Word32 -- p168 , getWindowTick , timeGetTime -- from Win32 , word32ToInt -- obsolete function from Data.Word ) where import Graphics.HGL hiding (getKey, getKeyEx, openWindowEx, Event(..), getWindowEvent, maybeGetWindowEvent) import qualified Graphics.HGL as HGL import Control.Monad(liftM) import Data.Word(Word32) ---------------------------------------------------------------- -- Interface ---------------------------------------------------------------- -- | A rectangular region, with the given points as opposite corners. createRectangle :: Point -> Point -> Region -- | A polygonal region defined by a list of 'Point's. createPolygon :: [Point] -> Region -- | An elliptical region that fits in the rectangle with the given points -- as opposite corners. createEllipse :: Point -> Point -> Region -- | The union of two regions. orRegion :: Region -> Region -> Region -- | The intersection of two regions. andRegion :: Region -> Region -> Region -- | The part of the first region that is not also in the second. diffRegion :: Region -> Region -> Region -- | Draw a 'Region' in the current color. drawRegion :: Region -> Graphic -- | Another name for 'drawInWindow', retained for backwards compatibility. drawInWindowNow :: Window -> Graphic -> IO () ---------------------------------------------------------------- -- Implementation ---------------------------------------------------------------- -- | an extended version of 'openWindow'. openWindowEx :: Title -- ^ the title of the window -> Maybe Point -- ^ the initial position of the window -> Maybe Size -- ^ the initial size of the window -> RedrawMode -- ^ how to display a graphic on the window -> Maybe Word32 -- ^ optionally attach a timer to the window, -- with the specified time (in milliseconds) -- between ticks. -> IO Window openWindowEx a b (Just c) d e = HGL.openWindowEx a b c d (fmap fromIntegral e) openWindowEx a b Nothing d e = HGL.openWindowEx a b (300,300) d (fmap fromIntegral e) createRectangle = rectangleRegion createEllipse = ellipseRegion createPolygon = polygonRegion orRegion = unionRegion andRegion = intersectRegion diffRegion = subtractRegion drawRegion = regionToGraphic -- backwards compatibility: -- | Draw directly to the window -- (slightly faster than 'drawBufferedGraphic', but more prone to flicker). drawGraphic :: RedrawMode drawGraphic = Unbuffered -- | Use a /double buffer/ to reduce flicker and thus improve the look -- of animations. drawBufferedGraphic :: RedrawMode drawBufferedGraphic = DoubleBuffered -- should have a different way to specify background color -- drawBufferedGraphicBC :: RGB -> RedrawMode drawInWindowNow = drawInWindow -- | The current time of day (in milliseconds). timeGetTime :: IO Word32 timeGetTime = liftM integerToWord32 getTime integerToWord32 :: Integer -> Word32 #ifdef __GLASGOW_HASKELL__ integerToWord32 = fromInteger -- conversion to Word32 doesn't overflow #else integerToWord32 n = fromInteger (n `mod` (toInteger (maxBound::Word32) + 1)) #endif -- | An obsolete special case of 'fromIntegral'. word32ToInt :: Word32 -> Int word32ToInt = fromIntegral ---------------------------------------------------------------- -- Event, getKey, and maybeGetWindowEvent compatibility ---------------------------------------------------------------- {- The SOE sources are set in stone, so this module provides the interface SOE expects, even if the Graphics library moves on (cf. Event.Key). -} -- Deprecated SOE compatibility. -- | Wait until a key is pressed and released, -- and return the corresponding character. getKey :: Window -> IO Char getKey w = do { getKeyEx w True; getKeyEx w False } -- | Wait until a key is pressed (if the second argument is 'True') -- or released (otherwise), and return the corresponding character. -- (not in SOE) getKeyEx :: Window -> Bool -> IO Char getKeyEx w down = loop where loop = do e <- HGL.getWindowEvent w case e of HGL.Key { HGL.keysym = k, HGL.isDown = isDown } | isDown == down && isCharKey k -> return (keyToChar k) _ -> loop -- | Wait for the next event in the window. getWindowEvent :: Window -> IO Event getWindowEvent w = liftM toSOEEvent (HGL.getWindowEvent w) -- | Return a pending eventin the window, if any. maybeGetWindowEvent :: Window -> IO (Maybe Event) maybeGetWindowEvent w = liftM (fmap toSOEEvent) (HGL.maybeGetWindowEvent w) -- tiresome, but necessary. toSOEEvent :: HGL.Event -> Event toSOEEvent (HGL.Char x) = Key x True toSOEEvent (HGL.Key k isDown) = Key (keyToChar k) isDown toSOEEvent (HGL.Button pt left down) = Button pt left down toSOEEvent (HGL.MouseMove p) = MouseMove p toSOEEvent (HGL.Resize) = Resize toSOEEvent (HGL.Closed) = Closed -- | User interface events data Event = Key { char :: Char -- ^ character corresponding to the key , isDown :: Bool -- ^ if 'True', the key was pressed; -- otherwise it was released } -- ^ occurs when a key was pressed or released. | Button { pt :: Point -- ^ the position of the mouse cursor , isLeft :: Bool -- ^ if 'True', it was the left button , isDown :: Bool -- ^ if 'True', the button was pressed; -- otherwise it was released } -- ^ occurs when a mouse button is pressed or released. | MouseMove { pt :: Point -- ^ the position of the mouse cursor } -- ^ occurs when the mouse is moved inside the window. | Resize -- ^ occurs when the window is resized. -- The new window size can be discovered using -- 'getWindowSize'. | Closed -- ^ occurs when the window is closed. deriving Show ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/distrib/0000755006511100651110000000000010504340421016604 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/distrib/MakingDistributions.txt0000644006511100651110000000050610504340421023337 0ustar rossrosscd /tmp cvs -d:ext:reid@cvs.haskell.org:/home/cvs/root checkout HSHGL (cd HSHGL/fptools; autoconf) mv HSHGL HSHGL-3.00 tar zcf HSHGL-3.00.tar.gz HSHGL-3.00 mkdir /tmp/graphics (cd /tmp/graphics; runhugs /tmp/HSHGL-3.00/distrib/Webpage.hs) cp HSHGL-3.00.tar.gz /tmp/graphics scp -r /tmp/graphics reid@haskell.org:/home/haskell hugs98-plus-Sep2006/packages/HGL/distrib/Webpage.hs0000644006511100651110000003577210504340421020530 0ustar rossrossmodule Main(main) where import Text.Html libversion = "3.00" main = makePages beige :: String beige = "#FFF4E1" -- colors used in the Hugs home pages orange = "#ffaa88" bluish = "#eeeeff" greenish = "#638494" comma, period :: Html comma = stringToHtml ", " period = stringToHtml ". " openSource = anchor ! [href "http://www.opensource.org/"] << "open source" hugs = anchor ! [href "http://haskell.org/hugs/"] << "Hugs" ghc = anchor ! [href "http://haskell.org/ghc/"] << "GHC" soe = anchor ! [href "http://haskell.org/soe/"] << "School of Expression" libs = anchor ! [href "http://haskell.org/ghc/docs/latest/set/book-hslibs.html"] << "Hugs-GHC Haskell libraries" -- ffi = anchor ! [href "http://www.dcs.gla.ac.uk/fp/software/hdirect/ffi-a4.ps.gz"] -- << "Foreign Function Interface" ffi = "Foreign Function Interface" alastair = anchor ! [href "http://www.reid-consulting-uk.ltd.uk/alastair/"] << "Alastair Reid" henrik = anchor ! [href "http://cs-www.cs.yale.edu/homes/nilsson/"] << "Henrik Nilsson" antony = anchor ! [href "http://www.apocalypse.org/pub/u/antony/"] << "Antony Courtney" ulf = "Ulf Norell" url_htmllib = "http://www.cse.ogi.edu/~andy/html/intro.htm" -- This makes pages look (a little) like the Hugs home pages frameIt :: (HTML a) => String -> a -> Html frameIt nm theBody = header << thetitle << ("HGL: " ++ nm) +++ body ! [bgcolor white] << ( hdr +++ hr +++ hlinks pages +++ hr +++ theBody +++ hr +++ hlinks pages +++ hr +++ table![width "100%"] << ( (td![align "left"] << font![size "1"] << ("Copyright " +++ copyright +++ " 1999-2003 " +++ alastair)) `beside` (td![align "right"] << anchor ! [href url_htmllib] << font![size "1", color "008888"] << "Rendered using Haskell HTML Combinators" ) ) ) section :: String -> Html section nm = table ! [border 0, cellpadding 0, cellspacing 0, width "100%"] << td ! [bgcolor orange] << bold << font ! [size "5"] << nm hdr = table ! [cellpadding 0, cellspacing 0, border 0, bgcolor bluish] << (td ! [align "left", width "0%"] << (table ! [cellpadding 5, cellspacing 0, border 0, bgcolor greenish] << (td << bold << font![size "15", color white, face "Helvetica"] << "HGL"))) `beside` (td ! [align "left", width "100%"] << (table ! [cellpadding 5, cellspacing 0, border 0, bgcolor bluish] << (td << bold << font![size "15", face "Helvetica", color greenish] << "Graphics Library"))) vlinks :: [(String,URL)] -> HtmlTable vlinks xs = aboves $ map vlink $ xs where vlink (label,url) = (td ! [width "0", noshade] << anchor ! [href url] << label) hlinks :: [(String,URL)] -> Html hlinks xs = center $ brackets $ punctuate " | " $ map hlink xs where hlink (label,url) = anchor ! [href url] << font ! [size "1"] << label punctuate :: (HTML a) => a -> [Html] -> Html punctuate p [] = noHtml punctuate p [x] = x punctuate p (x:xs) = x +++ p +++ punctuate p xs brackets :: (HTML a) => a -> Html brackets xs = "[" +++ xs +++ "]" signature = hlinks [ ("Alastair Reid", "http://www.reid-consulting-uk.ltd.uk/alastair/") , ("Reid Consulting (UK) Limited", "http://www.reid-consulting-uk.ltd.uk/") ] adr_signature = address $ concatHtml [ anchor ! [href "http://www.reid-consulting-uk.ltd.uk/alastair/"] << "Alastair Reid" , comma , stringToHtml "alastair@reid-consulting-uk.ltd.uk" , comma , anchor ! [href "http://www.reid-consulting-uk.ltd.uk/"] << "Reid Consulting (UK) Limited" , period ] makePages = do writeFile url_homepage (renderHtml $ frameIt "Home" home) writeFile url_download (renderHtml $ frameIt "Downloading" download) writeFile url_faq (renderHtml $ frameIt "FAQ" faq) writeFile url_bugs (renderHtml $ frameIt "Known Bugs" bugs) writeFile url_bugreports (renderHtml $ frameIt "Reporting Bugs" bugreports) writeFile url_docs (renderHtml $ frameIt "Documentation" docs) url_homepage = "index.html" url_download = "downloading.html" url_faq = "faq.html" url_bugs = "bugs.html" url_bugreports = "bug-reports.html" url_docs = "documentation.html" pages = [ ("Home Page", url_homepage) , ("Downloading", url_download) , ("Frequently Asked Questions", url_faq) , ("Known Bugs", url_bugs) , ("Reporting Bugs", url_bugreports) -- , ("Documentation", url_docs) ] home :: Html home = center << font![size "+1"] << ( font![color red] << "New! " +++ "Updated for use with hierarchical libraries and GHC." ) +++ p << ("The HGL gives the programmer access to the most interesting parts of the Win32 and X11 library without exposing the programmer to the pain and anguish usually associated with using these interfaces. The library is distributed as " +++ openSource +++ " and is suitable for use in teaching and in applications.") +++ p << "The library currently supports:" +++ unordList [ "Filled and unfilled 2-dimensional objects (text, lines, polygons, ellipses)." , "Bitmaps (Win32 version only, for now)." , "Control over text alignment, fonts, color." , "Simple input events (keyboard, mouse, window resize) to support reactivity." , "Timers and double-buffering to support simple animation." , "Use of concurrency to avoid the usual inversion of the code associated with event-loop programming." , "Multiple windows may be handled at one time." ] +++ p << "To keep the library simple and portable, the library makes no attempt to support:" +++ unordList [ "User interface widgets (menus, toolbars, dialog boxes, etc.)" , "Palette manipulation and other advanced features." , "Many kinds of input event." ] +++ p << "Enjoy!" download = section "Downloading and Installing the X11 version" +++ p << ( toHtml "The X11 version is available via HTML as " -- +++ anchor ! [ href $ "downloads/HSHGL-" ++ libversion ++ ".bin.linux.tar.gz" ] -- << "a Linux binary" -- +++ ", " -- +++ anchor ! [ href $ "downloads/HSHGL-" ++ libversion ++ ".bin.freebsd.tar.gz" ] -- << "a FreeBSD binary" -- +++ " and as " +++ anchor ! [ href $ "downloads/HSHGL-" ++ libversion ++ ".tar.gz" ] << "source code" +++ "." -- +++ " Follow the X11 section of the " -- +++ anchor ! [ href $ "downloads/Install.txt" ] -- << "installation instructions" -- +++ "." +++ " It has been successfully used with both Linux and FreeBSD." ) +++ p << ( "To build it from source, you will need " +++ anchor ! [ href $ "http://haskell.org/greencard/" ] << "GreenCard 3.01" +++ " and " +++ anchor ! [ href $ "http://haskell.org/ghc/" ] << "GHC 6.x" +++ " as well." ) +++ section "Downloading and Installing the Win32 version" +++ p << ( "The latest release doesn't yet work with Win32. In the meantime, you can use the " +++ anchor ! [ href $ "http://cvs.haskell.org/Hugs/downloads/SOE.msi" ] << "previous version (2.0.5)" +++ "." +++ "To use it, simply download and run the installer." ) +++ section "Release History" +++ defList [ ("6/6/2003: version 3.00" , toHtml $ unordList [ "Alpha release in preparation for a new major release." , "Added support for GHC 6.0 and hierarchical libraries." , "Doesn't currently work with Hugs or Win32 (both coming soon)." ] ) , ("14/12/2002: version 2.0.5" , toHtml $ unordList [ "Updated to work with December 2002 release of Hugs" ] ) , ("4/9/2001: version 2.0.4" , toHtml $ unordList [ "Builds under Hugs (September 2001 release onwards) and GHC 5.0" , "Added support for key presses both as ASCII characters and as raw key presses. The latter is added through a new abstract type 'Key' and operations on it." , "Dropped the 'Maybe' from the 3rd argument of openWindowEx since X11 doesn't let you omit the size of a window when you create it." , "Minor fixes in documentation." ] ) , ("25/6/2000: version 2.0.3" , toHtml $ unordList [ "Removed need for Hugs sourcecode when installing X11 version." , "Changed default X11 colors to match default Win32 colors (white on a black background)." , "Updated Win32 version to work with up-to-date Win32 library." , "Added code from Paul Hudak's School of Expression to demos/SOE." ] ) , ("9/4/2000: version 2.0.2" , toHtml( p << "Tweaked export list of SOEGraphics (removed Time and regionToGraphic, added getWindowTick) and fixed type signature of getKey in documentation" ) ) , ("20/1/2000: version 2.0.1" , toHtml (p << "Initial Win32 release.") ) , ("16/1/2000: version 2.0.0" , toHtml (p << "Initial X11 release.") ) ] faq = defList [ ( "Who wrote the Graphics library?" , toHtml alastair +++ " with bugfixes from: " +++ antony +++ " and GHC porting by " +++ henrik +++ "." ) , ( "What License does the Graphics library use?" , toHtml ( "We use " -- +++ anchor ! [ href $ "downloads/License.txt" ] -- << +++ "the same BSD-style license as Hugs and GHC" +++ ". " +++ "[If you haven't seen this kind of license before, you might want to consult the " +++ openSource +++ " site for a less lawyerly explanation.]" ) ) , ( "What differences are there between versions?" , toHtml $ defList [ ("Version 1.0" , unordList [ "Win32 only." , "Provides the declarative Graphic datatype but does not expose the imperative Draw monad on which it is based." , "Overloads names like create and destroy using module qualifiers to disambiguate." ] ) , ("Version 1.1" , unordList [ "Win32 only." , "Exposes Draw monad." , "Quite different from the interface required by Paul Hudak's book `The Haskell School of Expression - Learning Functional Programming through Multimedia' but includes the SOEGraphics module to bridge the gap." , "Terrible Documentation (didn't reflect any of the changes)." ] ) , ("Version 2.0" , unordList [ "Supports X11 and Win32." , "Exposes Draw monad." , "Does not overload names." , "Interface is very close to that required by `The Haskell School of Expression'. Includes the SOEGraphics module to bridge the remaining gap." , "Better documentation." ] ) , ("Version 3.0" , unordList [ "Supports X11 (Win32 coming back soon)." , "Uses Hierarchical module namespace." ] ) ] ) , ( "What compilers does it work with?" , toHtml ( "Hugs releases after November 2002 and GHC 6.0." +++ "It requires concurrency and either the X11 or the Win32 packages." ) ) , ( "Do I need Hugs source code to install the library?" , toHtml ( "No." ) ) ] bugs = p << ( "Bugs are categorized according to whether they affect the X11, Win32 or both platforms or whether they are portability `bugs'. " +++ "If a bug does not appear on this list, please " +++ (anchor ! [href url_bugs] << "report it") +++ "." ) +++ section "Bugs in the X11 version" +++ unordList [ p << "Line styles are not yet implemented." ] +++ section "Bugs in the Win32 version" +++ p << "No known bugs." -- +++ unordList -- [ p << "Bug1" -- , p << "Bug2" -- ] +++ section "Bugs in both versions" +++ p << "No known bugs." -- +++ unordList -- [ p << "Bug1" -- , p << "Bug2" -- ] +++ section "Portability Issues" +++ p << "The following functions are provided in X11 but not Win32." +++ unordList [ p << "runGraphicsEx :: String -> IO () -> IO () allows the programmer to specify the display on which windows are drawn." ] +++ p << "Programmers should also watch for the following:" +++ unordList [ toHtml $ p << "Win32 and X11 differ in their treatment of line styles and widths. X11 guarantees that the style applies to any line width, Win32 only applies line styles to 0-width lines." , toHtml $ p << "Font names are usually not portable between Win32 and X11. Indeed, they may even vary between different Win32 or X11 machines." ] bugreports = p << ( "Please check that the bug is not on the " +++ (anchor ! [href url_bugs] << "list of known bugs") +++ "." ) +++ p << ( "If it is not on the list, please send a bug report to " +++ bold (toHtml "alastair at reid-consulting-uk.ltd.uk") +++ ". Bug reports should include enough information to reproduce the bug. This typically includes:" ) +++ unordList [ p << "What machine are you using? (uname -a, gcc -v)" , p << "What version of Hugs are you using? (banner printed when Hugs starts)" , p << "What version of the library are you using? (name of tarfile you installed)" , p << "What X server are you using (and what can it do)? (xdpyinfo)" , p << "What fonts does your X server provide? (xlsfonts)" , p << ("What are you doing? (a " +++ bold (toHtml "short") +++ " program demonstrating the problem)") , p << "What is happening and why is this wrong?" ] +++ p << "Some of this information can be omitted but the faster I can reproduce the problem, the faster it will get fixed." docs = p << ( toHtml "Documentation is available in " +++ anchor ! [ href $ "downloads/graphics-" ++ libversion ++ ".dvi" ] << "dvi" +++ ", " +++ anchor ! [ href $ "downloads/graphics-" ++ libversion ++ ".ps" ] << "postscript" +++ " and " +++ anchor ! [ href $ "downloads/graphics-" ++ libversion ++ ".ps.gz" ] << "compressed postscript" +++ " formats. " +++ "These files are included in the docs subdirectory of the distribution." ) -- Release directory: -- - *.html -- - downloads/License.txt -- - downloads/graphics-$libversion.*.tar.gz -- - downloads/graphics-$libversion.{dvi,ps.gz} -- - downloads/graphics-current.* (symlinks to latest version) -- -- Tarfile format: -- - graphics-$libversion -- - /License.txt -- - /Install.txt -- - /Readme.txt (copied from Homepage, add URLs) -- - /docs/graphics-$libversion.{dvi,ps.gz} -- - /lib/x11/* -- - /lib/win32/* -- - /demos/* -- - /test/* hugs98-plus-Sep2006/packages/HGL/distrib/mkdistrib0000644006511100651110000001250710504340421020524 0ustar rossross#! /bin/sh # Typical usage: # mkdir /tmp/graphics # ./mkdistrib `pwd`/.. /tmp/graphics # # check it looks ok # rm -rf /tmp/graphics SRCDIR=$1 XLIBSRCDIR=$1/../xlib DSTDIR=$2 VERSION="2.0.4" TMP=/tmp GDIR=graphics-$VERSION TMPROOT=$TMP/$GDIR TMPDOCS=$TMPROOT/doc TMPDEMO=$TMPROOT/demos TMPSOE=$TMPROOT/demos/SOE TMPSOEBITS=$TMPROOT/demos/SOE/book TMPLIB=$TMPROOT/lib TMPXLIB=$TMPLIB/x11 TMPWINLIB=$TMPLIB/win32 TMPTEST=$TMPROOT/test if (test "!" -d "$SRCDIR") then echo "Bogus srcdir $SRCDIR"; exit 1; fi if (test "!" -d "$XLIBSRCDIR") then echo "Bogus xlib srcdir $XLIBSRCDIR"; exit 1; fi if (test "!" -d "$DSTDIR") then echo "Bogus dstdir $DSTDIR"; exit 1; fi # No longer needed: we include StdDIS in the CVS tree (bad, bad, bad!) # if (test "!" -r "$HOME/local/greencard-2.0/lib/hugs/StdDIS.gc") then # echo "Can't find StdDIS in $HOME/local/greencard-2.0/lib/hugs/StdDIS.gc"; # exit 1; # fi if (test "!" -r "$HOME/Win32.zip") then echo "Can't find $HOME/Win32.zip"; exit 1; fi echo "Building release in $DSTDIR from $SRCDIR" ################################################################ # Building the distribution source tree ################################################################ echo "Building distribution source tree in $TMPROOT" rm -rf $TMPROOT mkdir $TMPROOT mkdir $TMPLIB mkdir $TMPXLIB mkdir $TMPXLIB/cbits mkdir $TMPWINLIB mkdir $TMPTEST mkdir $TMPDEMO mkdir $TMPSOE mkdir $TMPSOEBITS mkdir $TMPDOCS echo "Populating distribution source tree" sed $SRCDIR/License > $TMPROOT/License -e "s/@VERSION@/$VERSION/g" sed $SRCDIR/Readme > $TMPROOT/Readme -e "s/@VERSION@/$VERSION/g" sed $SRCDIR/Install > $TMPROOT/Install -e "s/@VERSION@/$VERSION/g" echo $VERSION > $TMPROOT/Version echo > $TMPROOT/Version-$VERSION cp $SRCDIR/doc/*.tex $TMPDOCS cp $SRCDIR/doc/*.bib $TMPDOCS make -fMakefile.hugs -C $XLIBSRCDIR rerun_GC=yes Xlib_StdDIS.c X.c Xlib.c cp $XLIBSRCDIR/Makefile.hugs $TMPXLIB/Makefile cp $XLIBSRCDIR/*.hs $TMPXLIB cp $XLIBSRCDIR/*.c $TMPXLIB cp $XLIBSRCDIR/*.gc $TMPXLIB cp $XLIBSRCDIR/cbits/*.c $TMPXLIB/cbits cp $XLIBSRCDIR/cbits/*.h $TMPXLIB/cbits cp $SRCDIR/lib/x11/*.hs $TMPXLIB cp $SRCDIR/lib/win32/*.hs $TMPWINLIB cp $SRCDIR/tests/Tests.hs $TMPTEST cp $SRCDIR/tests/GTest.hs $TMPTEST cp $SRCDIR/demos/*.hs $TMPDEMO cp $SRCDIR/demos/SOE/README $TMPSOE cp $SRCDIR/demos/SOE/*.lhs $TMPSOE cp $SRCDIR/demos/SOE/book/*.lhs $TMPSOEBITS (cd $SRCDIR/doc; latex Graphics > /dev/null; bibtex Graphics; latex Graphics > /dev/null; latex Graphics > /dev/null) cp $SRCDIR/doc/Graphics.dvi $TMPDOCS ################################################################ # Building the web pages and download directory ################################################################ echo "Building web pages" (cd $DSTDIR; runhugs $SRCDIR/distrib/Webpage.hs) echo "Building fresh download directory" rm -rf $DSTDIR/downloads mkdir $DSTDIR/downloads cp $TMPROOT/License $DSTDIR/downloads/License.txt cp $TMPROOT/Readme $DSTDIR/downloads/Readme.txt cp $TMPROOT/Install $DSTDIR/downloads/Install.txt cp $TMPROOT/Version $DSTDIR/downloads/Version.txt cp $TMPROOT/Version-$VERSION $DSTDIR/downloads/Version-$VERSION.txt cp $TMPDOCS/Graphics.dvi $DSTDIR/downloads/graphics-$VERSION.dvi dvips $DSTDIR/downloads/graphics-$VERSION.dvi -o $DSTDIR/downloads/graphics-$VERSION.ps gzip -c $DSTDIR/downloads/graphics-$VERSION.ps >> $DSTDIR/downloads/graphics-$VERSION.ps.gz echo "Building tar file" (cd $TMP; tar zcf $DSTDIR/downloads/graphics-$VERSION.src.tar.gz $GDIR) echo "Building zip file" (cd $TMP; zip -rq9 $DSTDIR/downloads/graphics-$VERSION.src.zip $GDIR) cp $HOME/Win32.zip $DSTDIR/downloads # tar zcvf $DSTDIR/downloads/graphics-$VERSION.bin.linux.tar.gz ?? # tar zcvf $DSTDIR/downloads/graphics-$VERSION.bin.freebsd.tar.gz ?? (cd $DSTDIR/downloads; ln -s graphics-$VERSION.src.tar.gz graphics-current.src.tar.gz) (cd $DSTDIR/downloads; ln -s graphics-$VERSION.src.zip graphics-current.src.zip) # haskell.org doesn't let you see directory contents so we build # an index for you cat > $DSTDIR/downloads/index.html <Contents of this directory

Install.txt

License.txt

Readme.txt

Version-$VERSION.txt

Version.txt

Win32.zip

graphics-$VERSION.dvi

graphics-$VERSION.ps

graphics-$VERSION.ps.gz

graphics-$VERSION.src.tar.gz

graphics-$VERSION.src.zip

graphics-current.src.tar.gz

graphics-current.src.zip EOF echo "Contents of $TMPROOT" ls -sRF --color $TMPROOT echo "Contents of $DSTDIR" ls -sRF --color $DSTDIR exit 0 ################################################################ # End ################################################################ hugs98-plus-Sep2006/packages/HGL/doc/0000755006511100651110000000000010504340421015711 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/doc/oldappendix.tex0000644006511100651110000001570310504340421020750 0ustar rossross\modName{HGL.Graphics.Core} % accurate 16/1/2000 \begin{verbatim} > type Title = String > type Point = (Int,Int) > type Size = (Int,Int) > type Angle = Double > type Time = Word32 -- milliseconds > data RGB = RGB Word8 Word8 Word8 > data BkMode = Opaque | Transparent > > type Alignment = (HAlign, VAlign) > -- names have a tick to distinguish them from Prelude names (blech!) > data HAlign = Left' | Center | Right' > deriving (Enum, Eq, Ord, Ix, Show) > data VAlign = Top | Baseline | Bottom > deriving (Enum, Eq, Ord, Ix, Show) > > data Style > = Solid > | Dash -- "-------" > | Dot -- "......." > | DashDot -- "_._._._" > | DashDotDot -- "_.._.._" > | Null > | InsideFrame > > runGraphics :: IO () -> IO () > getTime :: IO Time > > data Window > openWindowEx :: Title -> Maybe Point -> Size -> > RedrawMode -> Maybe T.Time -> IO Window > > closeWindow :: Window -> IO () > getWindowRect :: Window -> IO (Point,Point) > getWindowEvent :: Window -> IO Event > getWindowTick :: Window -> IO () > maybeGetWindowEvent :: Window -> IO (Maybe Event) > > type Graphic = Draw () > setGraphic :: Window -> Graphic -> IO () > getGraphic :: Window -> IO Graphic > modGraphic :: Window -> (Graphic -> Graphic) -> IO () > directDraw :: Window -> Graphic -> IO () > > selectFont :: Font -> Draw Font > setTextColor :: RGB -> Draw RGB > setTextAlignment :: Alignment -> Draw Alignment > setBkColor :: RGB -> Draw RGB > setBkMode :: BkMode -> Draw BkMode > selectPen :: Pen -> Draw Pen > selectBrush :: Brush -> Draw Brush > > bracket :: Draw a -> (a -> Draw b) -> (a -> Draw c) -> Draw c > bracket_ :: Draw a -> (a -> Draw b) -> Draw c -> Draw c > > data Font > createFont :: Point -> Angle -> Bool -> Bool -> String -> IO Font > deleteFont :: Font -> IO () > > data Brush > mkBrush :: RGB -> (Brush -> Draw a) -> Draw a > > data Pen > mkPen :: Style -> Int -> RGB -> (Pen -> Draw a) -> Draw a > createPen :: Style -> Int -> RGB -> IO Pen > > arc :: Point -> Point -> Angle -> Angle -> Graphic -- unfilled > line :: Point -> Point -> Graphic -- unfilled > polyline :: [Point] -> Graphic -- unfilled > ellipse :: Point -> Point -> Graphic -- filled > shearEllipse :: Point -> Point -> Point -> Graphic -- filled > polygon :: [Point] -> Graphic -- filled > text :: Point -> String -> Graphic -- filled > > data Region > emptyRegion :: Region > rectangleRegion :: Point -> Point -> Region > ellipseRegion :: Point -> Point -> Region > polygonRegion :: [Point] -> Region > intersectRegion :: Region -> Region -> Region > unionRegion :: Region -> Region -> Region > subtractRegion :: Region -> Region -> Region > xorRegion :: Region -> Region -> Region > regionToGraphic :: Region -> Graphic > > data Event > = Key { char :: Char, isDown :: Bool } > | Button { pt :: Point, isLeft, isDown :: Bool } > | MouseMove { pt :: Point } > | Resize > | Closed > deriving Show \end{verbatim} \modName{HGL.Graphics.Utils} % accurate 16/1/2000 Note that this document repeats the definitions of all the functions defined in \module{HGL.Graphics.Utils}. \begin{verbatim} > -- Reexports HGL.Graphics.Core > > openWindow :: Title -> Size -> IO Window > clearWindow :: Window -> IO () > drawInWindow :: Window -> Graphic -> IO () > > getWindowSize :: Window -> IO Size > getLBP :: Window -> IO Point > getRBP :: Window -> IO Point > getButton :: Window -> Bool -> Bool -> IO Point > getKey :: Window -> IO Char > getKeyEx :: Window -> Bool -> IO Char > > emptyGraphic :: Graphic > overGraphic :: Graphic -> Graphic -> Graphic > overGraphics :: [Graphic] -> Graphic > > withFont :: Font -> Graphic -> Graphic > withTextColor :: RGB -> Graphic -> Graphic > withTextAlignment :: Alignment -> Graphic -> Graphic > withBkColor :: RGB -> Graphic -> Graphic > withBkMode :: BkMode -> Graphic -> Graphic > withPen :: Pen -> Graphic -> Graphic > withBrush :: Brush -> Graphic -> Graphic > withRGB :: RGB -> Graphic -> Graphic > > data Color > = Black > | Blue > | Green > | Cyan > | Red > | Magenta > | Yellow > | White > deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read) > > colorList :: [(Color, RGB)] > colorTable :: Array Color RGB > withColor :: Color -> Graphic -> Graphic > > par :: IO a -> IO b -> IO (a,b) > par_ :: IO a -> IO b -> IO () > parMany :: [IO ()] -> IO () \end{verbatim} \subsection{Portability notes} \begin{itemize} \item \NotInX{\fun{polyBezier}} \item \fun{shearEllipse} is implemented by polygons on both Win32 and X11. \item X11 does not directly support font rotation so \fun{mkFont} always ignores the rotation angle argument in the X11 implementation of this library. \item Many of the font families typically available on Win32 are not available on X11 (and {\it vice-versa\/}). In our experience, the font families ``courier,'' ``helvetica'' and ``times'' are somewhat portable. \item On Win32, the pen is also used to draw a line round all the filled shapes --- so the pen color also affects how polygons, ellipses and regions are drawn. \item One of the Win32 ``gotchas'' is that the choice of \type{Style} only applies if the width is 1 or less. With greater widths, the pen style will always be \fun{Solid} no matter what you try to select. This problem does not apply to X11. \item The Bitmap functions are not currently provided in the X11 implementation of this library. \item \fun{shearBitmap} is supported on Win'NT but not Win'95. \item \NotInWin{\fun{emptyRegion}} It is possible to use an empty rectangle region instead \item \fun{ellipseRegion} is implemented using polygons in the X11 implementation of the library. \item Programmers should assume that the \type{Event} datatype will be extended in the not-too-distant future and that individual events may change slightly. As a minimum, you should add a ``match anything'' alternative to any function which pattern matches against \type{Event}s. \item X11 systems typically have three button mice. Button 1 is used as the left button, button 3 as the right button and button 2 (the middle button) is ignored. \end{itemize} hugs98-plus-Sep2006/packages/HGL/doc/Graphics.tex0000644006511100651110000013745210504340421020207 0ustar rossross%** The Hugs Graphics Library %** %**

The Hugs Graphics Library (Version 2.0)

%**
%**Alastair Reid
%**Reid Consulting (UK) Limited
%**alastair@reid-consulting-ltd.ltd.uk
%**
 %*ignore %\documentstyle[11pt]{article} \documentstyle{article} % copied from the Haskore tutorial \textheight=8.5in \textwidth=6.5in \topmargin=-.3in \oddsidemargin=0in \evensidemargin=0in \parskip=6pt plus2pt minus2pt \topsep=0pt % how much extra space (on top of parskip) is added round list/verbatim % and some of my own personal preferences \parindent=0in \newcommand{\var}[1]{{\tt #1\/}} % variables \newcommand{\fun}[1]{{\tt #1\/}} % functions \newcommand{\expr}[1]{{\tt #1\/}} % expressions \newcommand{\type}[1]{{\tt #1\/}} % types \newcommand{\module}[1]{{\tt #1\/}} % modules %\newcommand{\modName}[1]{\item[module #1]:} \newcommand{\modName}[1]{\subsection{Module {#1}}} \newcommand{\tva}{$\alpha$} % type variables \newcommand{\tvb}{$\beta $} \newcommand{\tvc}{$\gamma$} \newcommand{\arrow}{$\enspace\to\enspace$} % type constructors \newcommand{\Hugs}{{\sffamily Hugs\/}} \newcommand{\GHC}{{\sffamily GHC\/}} \newcommand{\Haskell}{{\sffamily Haskell\/}} \newcommand{\Library}{{\sffamily Hugs Graphics Library\/}} \newenvironment{aside} {\noindent \begingroup \small {\bf Aside} \list{} {\topsep 0pt \advance\leftmargin -1.5em \sl }% \item\relax% } { \endlist {\bf End aside.} \endgroup } \newenvironment{note} {\noindent \begingroup \small {\bf Note} \list{} {\topsep 0pt \advance\leftmargin -1.5em \sl }% \item\relax% } { \endlist {\bf End note.} \endgroup } \newcommand{\Portability}[1]{\par{{\bf Portability Note:} \sl #1}\par} \newenvironment{portability}{% % \medbreak \noindent \begingroup \small {\bf Portability Note: } \nobreak \sl \begin{itemize} \itemsep0pt }{% \end{itemize} \nobreak {\bf End Portability Note.} \endgroup % \medbreak } \def\NotInX#1{{#1} is not provided in the X11 implementation of this library.} \def\NotInWin#1{{#1} is not provided in the Win32 implementation of this library.} % These are used for reminders, communication between authors, etc. % There should be no calls to these guys in the final document. \newcommand{\HeyPaul}[1]{\par{{\bf Hey Paul:} \sl #1}\par} \newcommand{\ToDo}[1]{\par{{\bf ToDo:} \sl #1}\par} \newenvironment{outline}{% % \medbreak \noindent {\bf Outline: } \begingroup \nobreak \sl }{% \endgroup \nobreak {\bf End outline.} % \medbreak } % Here's how you create figures % % \begin{figure*} % \centerline{ % Foo % } % \caption{...} % \label{...} % \end{figure*} \begin{document} \title{% The Hugs Graphics Library\\ (Version 2.0)% } \author{Alastair Reid\\ Reid Consulting (UK) Limited\\ {\tt alastair@reid-consulting-ltd.ltd.uk}\\ {\tt http://www.reid-consulting-uk.ltd.uk/alastair/}} %\date{26 November, 1999} \maketitle %*endignore \section{Introduction}\label{introduction} The \Library{} is designed to give the programmer access to most interesting parts of the Win32 Graphics Device Interface and X11 library without exposing the programmer to the pain and anguish usually associated with using these interfaces. To give you a taste of what the library looks like, here is the obligatory ``Hello World'' program: \begin{verbatim} > module Hello where > > import GraphicsUtils > > helloWorld :: IO () > helloWorld = runGraphics (do > w <- openWindow "Hello World Window" (300, 300) > drawInWindow w (text (100, 100) "Hello") > drawInWindow w (text (100, 200) "World") > getKey w > closeWindow w > ) \end{verbatim} Here's what each function does: \begin{itemize} \item \expr{runGraphics :: IO () -> IO ()} get \Hugs{} ready to do graphics, runs an action (here, the action is a sequence of 5 subactions) and cleans everything up at the end.% % \footnote{% The description of \fun{runGraphics} is rather vague because of our promise to protect you from the full horror of Win32/X11 programming. If you really want to know, we highly recommend Charles Petzold's book ``Programming Windows''~\cite{petzold} which does an excellent job with a difficult subject or Adrian Nye's ``Xlib Programming Manual''~\cite{Xlib} which is almost adequate.% } % \item \expr{openWindow :: Title -> Point -> IO Window} opens a window specifying the window title ``Hello World Window'' and the size of the window (300 pixels $\times$ 300 pixels). \item \expr{drawInWindow :: Window -> Graphic -> IO ()} draws a \type{Graphic} on a \type{Window}. \item \expr{text :: Point -> String -> Graphic} creates a \type{Graphic} consisting of a \type{String} at a given screen location. \item \expr{getKey :: Window -> IO Char} waits for the user to press (and release) a key. This is necessary to prevent the window from closing before you have a chance to read what's on the screen. \item \expr{closeWindow :: Window -> IO ()} closes the window. \end{itemize} The rest of this document is organized as follows: %\begin{itemize} %\item Section~\ref{graphics} describes the \type{Graphic} type (a declarative way of drawing pictures); %\item Section~\ref{windows} describes \type{Window}s; %\item Section~\ref{events} describes \type{Event}s; %\item Section~\ref{concurrency} describes the Concurrent Haskell primitives which you need to create complex interfaces; and %\item Section~\ref{Draw} describes the \type{Draw} monad (a more imperative side to the \type{Graphic} type). %\end{itemize} % \begin{note} % This document is just a draft --- it contains British spelling (which % conflicts horribly with the US spelling used within the library); it % is incomplete; and it probably contains the occasional error as well. % \end{note} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Graphics}\label{graphics} In section~\ref{introduction}, we used these two functions to draw to a window \begin{verbatim} > drawInWindow :: Window -> Graphic -> IO () > text :: Point -> String -> Graphic \end{verbatim} This section describes other ways of creating graphics that can be drawn to the screen. \subsection{Atomic Graphics}\label{primitives} Here's a list of the atomic operations \begin{verbatim} > emptyGraphic :: Graphic > ellipse :: Point -> Point -> Graphic > shearEllipse :: Point -> Point -> Point -> Graphic > arc :: Point -> Point -> Angle -> Angle -> Graphic > line :: Point -> Point -> Graphic > polyline :: [Point] -> Graphic > polygon :: [Point] -> Graphic > polyBezier :: [Point] -> Graphic > text :: Point -> String -> Graphic \end{verbatim} \fun{emptyGraphic} is a blank \type{Graphic}. \fun{ellipse} is a filled ellipse which fits inside a rectangle defined by two \type{Point}s on the window. \fun{shearEllipse} is a filled ellipse inside a parallelogram defined by three \type{Point}s on the window. \fun{arc} is an unfilled elliptical arc which fits inside a rectangle defined by two \type{Point}s on the window. The angles specify the start and end points of the arc --- the arc consists of all points from the start angle counter-clockwise to the end angle. Angles are in degrees $[0..360]$ rather than radians $[0..2\pi]$. \fun{line} is a line between two \type{Point}s. \fun{polyline} is a series of lines through a list of \type{Point}s. \fun{polyBezier} is a series of (unfilled) bezier curves defined by a list of $3n+1$ control \type{Point}s. \fun{polygon} is a filled polygon defined by a list of \type{Point}s. \fun{text} is a rendered \type{String}. \begin{portability} %\begin{itemize} \item \NotInX{\fun{polyBezier}} \item \fun{shearEllipse} is implemented by polygons on both Win32 and X11. %\end{itemize} \end{portability} \subsection{Graphic Modifiers}\label{modifiers} One of the most useful properties of \type{Graphic}s is that they can be modified in various ways. Here is a selection of the modifiers available \begin{verbatim} > withFont :: Font -> Graphic -> Graphic > withTextColor :: RGB -> Graphic -> Graphic > withTextAlignment :: Alignment -> Graphic -> Graphic > withBkColor :: RGB -> Graphic -> Graphic > withBkMode :: BkMode -> Graphic -> Graphic > withPen :: Pen -> Graphic -> Graphic > withBrush :: Brush -> Graphic -> Graphic > withRGB :: RGB -> Graphic -> Graphic \end{verbatim} The effect of these ``modifiers'' is to modify the way in which a graphic will be drawn. For example, if \var{courier :: Font} is a 10 point Courier font, then drawing \expr{withFont courier (text (100,100) "Hello")} will draw the string \expr{"Hello"} on the window using the 10 point Courier font. Modifiers are cumulative: a series of modifiers can be applied to a single graphic. For example, the graphic \begin{verbatim} > withFont courier ( > withTextColor red ( > withTextAlignment (Center, Top) ( > text (100,100) "Hello World" > ) > ) > ) \end{verbatim} will be % \begin{itemize} \itemsep0pt \item horizontally aligned so that the centre of the text is at \expr{(100, 100)}; \item vertically aligned so that the top of the text is at \expr{(100, 100)}; \item colored red \item displayed in 10 point Courier font \end{itemize} Modifiers nest in the obvious way --- so % \begin{verbatim} > withTextColor red ( > withTextColor green ( > text (100,100) "What Color Am I?" > ) > ) \end{verbatim} % will produce green text, as expected. \begin{aside} As you write more and more complex graphics, you'll quickly realize that it's very tedious to insert all those parentheses and to keep everything indented in a way that reveals its structure. Fortunately, the Haskell Prelude provides a right associative application operator % \begin{verbatim} > ($) :: (a -> b) -> a -> b \end{verbatim} % which eliminates the need for almost all parentheses when defining \type{Graphic}s. Using the \fun{(\$)} operator, the above example can be rewritten like this % \begin{verbatim} > withTextColor red $ > withTextColor green $ > text (100,100) "What Color Am I?" \end{verbatim} % \end{aside} \subsection{Combining Graphics}\label{combining} The other useful property of \type{Graphic}s is that they can be combined using the \fun{overGraphic} combinator \begin{verbatim} > overGraphic :: Graphic -> Graphic -> Graphic \end{verbatim} For example, drawing this graphic produces a red triangle ``on top of'' (or ``in front of'') a blue square % \begin{verbatim} > overGraphic > (withBrush red $ polygon [(200,200),(400,200),(300,400)]) > (withBrush blue $ polygon [(100,100),(500,100),(500,500),(100,500)]) \end{verbatim} Notice that modifiers respect the structure of a graphic --- modifiers applied to one part of a graphic have no effect on other parts of the graphic. For example the above graphic could be rewritten like this. % \begin{verbatim} > withBrush blue $ > overGraphic > (withBrush red $ polygon [(200,200),(400,200),(300,400)]) > (polygon [(100,100),(500,100),(500,500),(100,500)]) \end{verbatim} The \fun{overGraphics} function is useful if you want to draw a list of graphics. It's type and definition are \begin{verbatim} > overGraphics :: [Graphic] -> Graphic > overGraphics = foldr overGraphic emptyGraphic \end{verbatim} Notice that graphics at the head of the list are drawn ``in front of'' graphics at the tail of the list. \subsection{Attribute Generators}\label{generators} The graphic modifiers listed at the start of Section~\ref{modifiers} use attributes with types like \type{Font}, \type{RGB} and \type{Brush}, but so far we have no way of generating any of these attributes. Some of these types are {\em concrete\/} (you can create them using normal data constructors) and some are {\em abstract\/} (you can only create them with special ``attribute generators''). Here's the definitions of the concrete types. \begin{verbatim} > type Angle = Double > type Dimension = Int > type Point = (Dimension,Dimension) > data RGB = RGB Int Int Int > > -- Text alignments > type Alignment = (HAlign, VAlign) > -- names have a tick to distinguish them from Prelude names (blech!) > data HAlign = Left' | Center | Right' > data VAlign = Top | Baseline | Bottom > > -- Text background modes > data BkMode = Opaque | Transparent \end{verbatim} The attributes \type{Font}, \type{Brush} and \type{Pen} are {\em abstract,\/} and are a little more complex because we want to delete the font, brush, or pen once we've finished using it. This gives the attribute generators a similar flavour to the modifiers seen in section~\ref{modifiers} --- these functions are applied to an argument of type \type{\tva \arrow Graphic} and return a \type{Graphic}. % \begin{verbatim} > mkFont :: Point -> Angle -> Bool -> Bool -> String -> > (Font -> Graphic) -> Graphic > mkBrush :: RGB -> (Brush -> Graphic) -> Graphic > mkPen :: Style -> Int -> RGB -> (Pen -> Graphic) -> Graphic \end{verbatim} For example, the following program uses a $50 \times 50$ pixel, non-bold, italic, courier font to draw red text on a green background at an angle of 45 degrees across the screen. \begin{verbatim} > fontDemo = runGraphics $ do > w <- openWindow "Font Demo Window" (100,100) > drawInWindow w $ > withTextColor (RGB 255 0 0) $ > mkFont (50,100) (pi/4) False True "courier" $ \ font -> > withFont font $ > withBkColor (RGB 0 255 0) $ > withBkMode Opaque $ > text (50,50) "Font Demo" > getKey w > closeWindow w \end{verbatim} A default font is substituted if the requested font does not exist. The rotation angle is ignored if the font is not a ``TrueType'' font (e.g., for {\tt System} font on Win32). \begin{portability} %\begin{itemize} \item X11 does not directly support font rotation so \fun{mkFont} always ignores the rotation angle argument in the X11 implementation of this library. \item Many of the font families typically available on Win32 are not available on X11 (and {\it vice-versa\/}). In our experience, the font families ``courier,'' ``helvetica'' and ``times'' are somewhat portable. %\ToDo{Check this} %\end{itemize} \end{portability} \subsection{Brushes, Pens and Text Colors} If you were counting, you'll have noticed that there are five separate ways of specifying colors \begin{verbatim} > mkBrush :: RGB -> (Brush -> Graphic) -> Graphic > mkPen :: Style -> Int -> RGB -> (Pen -> Graphic) -> Graphic > withTextColor :: RGB -> Graphic -> Graphic > withBkColor :: RGB -> Graphic -> Graphic > withRGB :: RGB -> Graphic -> Graphic \end{verbatim} What do these different modifiers and attributes control? \begin{description} \item[Brushes] are used when filling shapes --- so the brush color is used when drawing polygons, ellipses and regions. \item[Pens] are used when drawing lines --- so the pen color is used when drawing arcs, lines, polylines and polyBeziers. Pens also have a ``style'' and a ``width''. The \type{Style} argument is used to select solid lines or various styles of dotted and dashed lines. \begin{verbatim} > data Style > = Solid > | Dash -- "-------" > | Dot -- "......." > | DashDot -- "_._._._" > | DashDotDot -- "_.._.._" > | Null > | InsideFrame \end{verbatim} \item[TextColor] is used as the foreground color when drawing text. \item[BkColor] is used as the background color when drawing text with background mode \fun{Opaque}. The background color is ignored when the mode is \fun{Transparent}. % \ToDo{Should I expand the name \type{BkColor} to \type{BackgroundColor}?} \end{description} Finally, \fun{withRGB} is a convenience function which sets the brush, pen and text colors to the same value. Here is its definition \begin{verbatim} > withRGB :: RGB -> Graphic -> Graphic > withRGB c g = > mkBrush c $ \ brush -> > withBrush brush $ > mkPen Solid 2 c $ \ pen -> > withPen pen $ > withTextColor c $ > g \end{verbatim} \begin{portability} %\begin{itemize} \item On Win32, the pen is also used to draw a line round all the filled shapes --- so the pen color also affects how polygons, ellipses and regions are drawn. \item One of the Win32 ``gotchas'' is that the choice of \type{Style} only applies if the width is 1 or less. With greater widths, the pen style will always be \fun{Solid} no matter what you try to select. This problem does not apply to X11. %\end{itemize} \end{portability} \subsection{Named Colors} Working with RGB triples is a pain in the neck so the \module{HGL.Graphics.Utils} module provides these built in colors as convenient ``abbreviations.'' \begin{verbatim} > data Color > = Black > | Blue > | Green > | Cyan > | Red > | Magenta > | Yellow > | White > deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read) \end{verbatim} This type is useful because it may be used to index an array of RGB triples. \begin{verbatim} > colorTable :: Array Color RGB \end{verbatim} For example, we provide this function which looks up a color in the \var{colorTable} and uses that color for the brush, pen and text color. \begin{verbatim} > withColor :: Color -> Graphic -> Graphic \end{verbatim} It's worth pointing out that there's nothing ``magical'' about the \type{Color} type or our choice of colors. If you don't like our choice of colors, our names, or the way we mapped them onto RGB triples, you can write your own! To get you started, here's our implementation of \fun{withColor} and \var{colorTable}. \begin{verbatim} > withColor c = withRGB (colorTable ! c) > > colorTable = array (minBound, maxBound) colorList > > colorList :: [(Color, RGB)] > colorList = > [ (Black , RGB 0 0 0) > , (Blue , RGB 0 0 255) > , (Green , RGB 0 255 0) > , (Cyan , RGB 0 255 255) > , (Red , RGB 255 0 0) > , (Magenta , RGB 255 0 255) > , (Yellow , RGB 255 255 0) > , (White , RGB 255 255 255) > ] \end{verbatim} \subsection{Bitmaps} \type{Bitmap}s can be displayed in three ways: \begin{enumerate} \item with no transformation at a point \item stretched to fit a rectangle \item rotated and sheared to fit a parallelogram \end{enumerate} Rectangles are specified by a pair of points: the top-left, and bottom-right corners of the rectangle. \begin{verbatim} > bitmap :: Point -> Bitmap -> Graphic > stretchBitmap :: Point -> Point -> Bitmap -> Graphic > shearBitmap :: Point -> Point -> Point -> Bitmap -> Graphic \end{verbatim} \type{Bitmap}s are read in from files and disposed of using \begin{verbatim} > readBitmap :: String -> IO Bitmap > deleteBitmap :: Bitmap -> IO () \end{verbatim} (but be sure that the current \type{Graphic} on a \type{Window} doesn't contain a reference to a \type{Bitmap} before you delete the \type{Bitmap}!) This operation gets the size of a bitmap. \begin{verbatim} > getBitmapSize :: Bitmap -> IO (Int, Int) \end{verbatim} % \ToDo{% % Describe the other bitmap operations % --- clean them up a bit first though!% % } \begin{portability} %\begin{itemize} \item The Bitmap functions are not currently provided in the X11 implementation of this library. \item \fun{shearBitmap} is supported on Win'NT but not Win'95. %\end{itemize} \end{portability} \subsection{Regions} \type{Region}s can be viewed as an efficient representation of sets of pixels. They are created from rectangles, ellipses, polygons and combined using set operations (intersection, union, difference and xor (symmetric difference)). These are the operations available: \begin{verbatim} > emptyRegion :: Region > rectangleRegion :: Point -> Point -> Region > ellipseRegion :: Point -> Point -> Region > polygonRegion :: [Point] -> Region > > intersectRegion :: Region -> Region -> Region > unionRegion :: Region -> Region -> Region > subtractRegion :: Region -> Region -> Region > xorRegion :: Region -> Region -> Region > > regionToGraphic :: Region -> Graphic \end{verbatim} \fun{withBrush} affects the color of \fun{regionToGraphic}. \begin{portability} %\begin{itemize} \item \NotInWin{\fun{emptyRegion}} It is possible to use an empty rectangle region instead \item \fun{ellipseRegion} is implemented using polygons in the X11 implementation of the library. %\end{itemize} \end{portability} \subsection{The \type{Graphic} Algebra} The Graphic modifiers satisfy a large number of useful identities. For example, \begin{itemize} \item The triple $\langle \type{Graphic}, \fun{overGraphic}, \fun{emptyGraphic} \rangle$ forms a ``monoid.'' If this wasn't true, we wouldn't find the \fun{overGraphics} function very useful. \item Modifiers and generators all distribute over \fun{overGraphic}. That is, \begin{verbatim} > mkFoo (p1 `overGraphic` p2) > = (mkFoo p1) `overGraphic` (mkFoo p2) > withFoo foo (p1 `overGraphic` p2) > = (withFoo foo p1) `overGraphic` (withFoo foo p2) \end{verbatim} (These laws are especially useful when trying to make programs more efficient --- see section~\ref{efficiency}.) \item ``Independent'' modifiers commute with each other. For example, \begin{verbatim} > withTextColor c (withTextAlignment a p) > = withTextAlignment a (withTextColor c p) \end{verbatim} \item Generators commute with modifiers. For example, \begin{verbatim} > mkBrush c (\ b -> withBrush b' p) = withBrush b' mkBrush c (\ b -> p) \end{verbatim} if \var{b} and \var{b'} are distinct. \item Generators commute with other generators. For example \begin{verbatim} > mkBrush c (\ b -> mkBrush c' (\ b' -> p)) > = mkBrush c' (\ b' -> mkBrush c (\ b -> p)) \end{verbatim} if \var{b} and \var{b'} are distinct. \item ``Irrelevant'' modifiers and generators can be added or removed at will. For example, the text color has no effect on line drawing \begin{verbatim} > withTextColor c (line p0 p1) = line p0 p1 \end{verbatim} and there's no need to create a brush if you don't use it \begin{verbatim} > mkBrush c (\ b -> p) = p, if b does not occur in p \end{verbatim} This last law can also be stated in the form \begin{verbatim} > mkBrush c (\ b -> atomic) = atomic \end{verbatim} for any atomic operation. \end{itemize} % \ToDo{% % Add tables describing which modifiers are relevant and which % ones are independent. Or just list all the identities.% % } The practical upshot of all this is that there are many ways to rearrange a graphic so that it will be drawn more (or less) efficiently. We explore this topic in the next section. \subsection{Efficiency Considerations}\label{efficiency} The other sections provide a very simple set of functions for creating graphics --- but at the cost of ignoring efficiency. For example, this innocent looking graphic \begin{verbatim} > overGraphics > [ withColor Red $ ellipse (000,000) (100,100) > , withColor Red $ ellipse (100,100) (200,200) > , withColor Red $ ellipse (200,200) (300,300) > ] \end{verbatim} will take longer to draw than this equivalent graphic \begin{verbatim} > mkBrush (colorTable ! Red) $ \ redBrush -> > overGraphics > [ withBrush redBrush $ ellipse (000,000) (100,100) > , withBrush redBrush $ ellipse (100,100) (200,200) > , withBrush redBrush $ ellipse (200,200) (300,300) > ] \end{verbatim} Briefly, the problems are that \fun{withColor} sets the color of the brush, the pen and the text but ellipses only use the brush color; and we're calling \fun{withColor} $3$ times more than we have to. This wouldn't matter if brush creation was cheap and easy. However, most typical workstations can only display at most $256$ or $65536$ different colors on the screen at once but allow you to specify any one of $16777216$ different colors when selecting a drawing color --- finding a close match to the requested color can be as expensive as drawing the primitive object itself. % \ToDo{% % Time both graphics --- check that my estimate is about right.% % } This doesn't matter much for a graphic of this size --- but if you're drawing several thousand graphic elements onto the screen as part of an animation, it can make the difference between a quite respectable frame rate of 20--30 frames per second and an absolutely unusable frame rate of 2--3 frames per second. % \begin{aside} % % The (lazy) functional programming community has a bad habit of % ignoring these kinds of considerations; with the result that C % programmers have acquired the notion that functional programs will % {\em necessarily\/} run {\em several orders of magnitude\/} more % slowly than equivalent C programs. On the basis of this notion, % they {\em quite rightly\/} regard functional languages as toys which % have no relevance to Real Programming. % % We'd like to dispel that belief and so, in designing the graphics % library, we have made a serious attempt to expose enough of the % underlying machinery that we can tackle this sort of efficiency % consideration. % % That said, it's worth emphasising that \Hugs{} is an interpreter which % makes it run 10--100 times more slowly than compiled implementations % of \Haskell{} such as \GHC{}. If you really are wanting to animate % thousands of objects, you probably shouldn't be relying on \Hugs{}. % % \end{aside} \subsubsection{Eliminate calls to \fun{withRGB} and \fun{withColor}} At the risk of pointing out the obvious, the first step in optimizing a program in this way is to expand all uses of the \fun{withRGB} and \fun{withColor} functions and eliminating unnecessary calls to \fun{mkBrush}, \fun{mkPen} and \fun{withTextColor}. Applying this optimization to the above \type{Graphic}, we obtain this (which should run about 3 times faster). \begin{verbatim} > overGraphics > [ mkBrush red $ \ redBrush -> withBrush redBrush $ ellipse (00,00) (10,10) > , mkBrush red $ \ redBrush -> withBrush redBrush $ ellipse (10,10) (20,20) > , mkBrush red $ \ redBrush -> withBrush redBrush $ ellipse (20,20) (30,30) > ] \end{verbatim} \subsubsection{Lifting generators to the top of \type{Graphics}} Another important optimization is to avoid creating many identical brushes, pens or fonts when one will do. We do this by ``lifting'' brush creation out to the top of a graphic. For example, this graphic \begin{verbatim} > overGraphics > [ mkBrush red $ \ redBrush -> withBrush redBrush $ ellipse (00,00) (10,10) > , mkBrush red $ \ redBrush -> withBrush redBrush $ ellipse (10,10) (20,20) > , mkBrush red $ \ redBrush -> withBrush redBrush $ ellipse (20,20) (30,30) > ] \end{verbatim} creates three red brushes. It would be more efficient to rewrite it like this \begin{verbatim} > mkBrush red $ \ redBrush -> > overGraphics > [ withBrush redBrush $ ellipse (00,00) (10,10) > , withBrush redBrush $ ellipse (10,10) (20,20) > , withBrush redBrush $ ellipse (20,20) (30,30) > ] \end{verbatim} If your program uses a lot of brushes, it may be more convenient to store the brushes in a ``palette'' (i.e., an array of brushes) \begin{verbatim} > mkBrush red $ \ redBrush -> > mkBrush blue $ \ blueBrush -> > let palette = array (minBound, maxBound) > [(Red, redBrush), (Blue, blueBrush)] > in > overGraphics > [ withBrush (palette ! Red) $ ellipse (00,00) (10,10) > , withBrush (palette ! Blue) $ ellipse (10,10) (20,20) > , withBrush (palette ! Red) $ ellipse (20,20) (30,30) > ] \end{verbatim} % \ToDo{% % Write the obvious function with type % \type{[RGB] -> ([Brush] -> Graphic) -> Graphic} % (and similarily, for Pens, Fonts, etc).% % } \subsubsection{Lifting generators out of graphics} % \ToDo{Update this section} Even this program has room for improvement: every time the graphic is redrawn (e.g., whenever the window is resized), it will create fresh brushes with which to draw the graphic. The graphics library provides a way round this --- but it's more difficult and fraught with danger. \begin{outline} This section will talk about using explicit creation and deletion functions to create brushes, fonts, etc. The situation isn't very happy at the moment because it's easy to forget to deallocate brushes before you quit or to deallocate them before you change the graphic. % \ToDo{Maybe things will be better by the time we do an official release...} \end{outline} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Windows}\label{windows} In section~\ref{introduction} we saw the function \fun{drawInWindow} for drawing a \type{Graphic} on a \type{Window}. It turns out that \fun{drawInWindow} is not a primitive function but, rather, it is defined using these two primitive functions which read the current \type{Graphic} and set a new \type{Graphic}. \begin{verbatim} > getGraphic :: Window -> IO Graphic > setGraphic :: Window -> Graphic -> IO () \end{verbatim} Here's how these functions are used to define the function \fun{drawInWindow} (which we used in section~\ref{introduction}) and another useful function \fun{clearWindow}. \begin{verbatim} > drawInWindow :: Window -> Graphic -> IO () > drawInWindow w p = do > oldGraphic <- getGraphic w > setGraphic w (p `over` oldGraphic) > > clearWindow :: Window -> IO () > clearWindow w = setGraphic w emptyGraphic \end{verbatim} % \ToDo{This is no longer true. I think I want to make the ability to draw % the delta explicit.} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Events}\label{events} The graphics library supports several different input devices (the mouse, the keyboard, etc) each of which can generate several different kinds of event (mouse movement, mouse button clicks, key presses, key releases, window resizing, etc.) \subsection{Keyboard events} In section~\ref{introduction} we saw the function \fun{getKey} being used to wait until a key was pressed and released. The function \fun{getKey} is defined in terms of a more general function \fun{getKeyEx} \begin{verbatim} > getKeyEx :: Window -> Bool -> IO Char \end{verbatim} which can be used to wait until a key is pressed (\expr{getKeyEx w True}) or until it is released (\expr{getKeyEx w False}). The definition of \fun{getKey} using this function is trivial: \begin{verbatim} > getKey :: Window -> IO Char > getKey w = do{ getKeyEx w True; getKeyEx w False } \end{verbatim} \subsection{Mouse events} As well as waiting for keyboard events, we can wait for mouse button events. We provide three functions for getting these events. \fun{getLBP} and \fun{getRBP} are used to wait for left and right button presses. Both functions are defined using \fun{getButton} which can be used to wait for either the left button or the right button being either pressed or released. \begin{verbatim} > getLBP :: Window -> IO Point > getRBP :: Window -> IO Point > getButton :: Window -> Bool -> Bool -> IO Point > > getLBP w = getButton w True True > getRBP w = getButton w False True \end{verbatim} \subsection{General events} The functions \fun{getKeyEx} and \fun{getButton} described in the previous sections are not primitive functions. Rather they are defined using the primitive function \fun{getWindowEvent} \begin{verbatim} > getWindowEvent :: Window -> IO Event \end{verbatim} which waits for the next ``event'' on a given \type{Window}. \type{Event}s are defined by the following data type. \begin{verbatim} > data Event > = Key { char :: Char, isDown :: Bool } > | Button { pt :: Point, isLeft, isDown :: Bool } > | MouseMove { pt :: Point } > | Resize > | Closed > deriving Show \end{verbatim} These events are: \begin{itemize} \item \expr{Key\{char, isDown\}} occurs when a key is pressed (\expr{isDown==True}) or released (\expr{isDown==False}). \expr{char} is the ``keycode'' for the corresponding key. This keycode can be a letter, a number or some other value corresponding to the shift key, control key, etc. % \ToDo{% % Say more about what the keycode is --- in the meantime, users will % just have to try a few experiments to find out which code each key % produces.% % } \item \expr{Button\{pt, isLeft, isDown\}} occurs when a mouse button is pressed (\expr{isDown==True}) or released (\expr{isDown==False}). \expr{pt} is the mouse position when the button was pressed and \expr{isLeft} indicates whether it was the left or the right button. \item \expr{MouseMove\{pt\}} occurs when the mouse is moved inside the window. \expr{pt} is the position of the mouse after the movement. \item \expr{Resize} occurs when the window is resized. The new window size can be discovered using these functions. \begin{verbatim} > getWindowRect :: Window -> IO (Point, Size) > getWindowSize :: Window -> IO Size > getWindowSize w = do > (pt,sz) <- getWindowRect w > return sz \end{verbatim} \item \expr{Resize} occurs when the window is closed. \end{itemize} \begin{portability} %\begin{itemize} \item Programmers should assume that the \type{Event} datatype will be extended in the not-too-distant future and that individual events may change slightly. As a minimum, you should add a ``match anything'' alternative to any function which pattern matches against \type{Event}s. \item X11 systems typically have three button mice. Button 1 is used as the left button, button 3 as the right button and button 2 (the middle button) is ignored. %\end{itemize} \end{portability} As examples of how \fun{getWindowEvent} might be used in a program, here are the definitions of \fun{getKeyEx} and \fun{getButton}. \begin{verbatim} > getKeyEx :: Window -> Bool -> IO Char > getKeyEx w down = loop > where > loop = do > e <- getWindowEvent w > case e of > Key{ char = c, isDown } > | isDown == down > -> return c > _ -> loop \end{verbatim} \begin{verbatim} > getButton :: Window -> Bool -> Bool -> IO Point > getButton w left down = loop > where > loop = do > e <- getWindowEvent w > case e of > Button{pt,isLeft,isDown} > | isLeft == left && isDown == down > -> return pt > _ -> loop \end{verbatim} \subsection{Using Timers} % \ToDo{% % Timers are not very well integrated with the rest of the library at % the moment. We plan to improve this situation in future versions.% % } If you want to use a timer, you have to open the window using \fun{openWindowEx} instead of \fun{openWindow} \begin{verbatim} > openWindowEx :: Title -> Maybe Point -> Size -> > RedrawMode -> Maybe Time -> IO Window > > data RedrawMode > = Unbuffered > | DoubleBuffered \end{verbatim} This {\em extended\/} version of \fun{openWindow} takes extra parameters which specify \begin{itemize} \item the initial position of a window; \item how to display a graphic on a window; and \item the time between ticks (in milliseconds). \end{itemize} The function \fun{openWindow} is defined using \fun{openWindowEx} \begin{verbatim} > openWindow name size = openWindowEx name Nothing size Unbuffered Nothing \end{verbatim} The drawing mode can be either \fun{DoubleBuffered} which uses a ``double buffer'' to reduce flicker or \fun{Unbuffered} which draws directly to the window and runs slightly faster but is more prone to flicker. You should probably use \fun{DoubleBuffered} for animations. The timer generates ``tick events'' at regular intervals. The function \fun{getWindowTick} waits for the next ``tick event'' to occur. \begin{verbatim} > getWindowTick :: Window -> IO () \end{verbatim} \begin{aside} With normal events, like button presses, we store every event that happens until you remove that event from the queue. If we did this with tick events, and your program takes a little too long to draw each frame of an animation, the event queue could become so swamped with ``ticks'' that you'd never respond to user input. To avoid this problem, we only insert a tick into the queue if there's no tick there already. \end{aside} Here's a simple example of how to use timers. Note the use of \fun{setGraphic} instead of \fun{drawInWindow}. \begin{verbatim} > timerDemo = do > w <- openWindowEx > "Timer demo" -- title > (Just (500,500)) -- initial position of window > (100,100) -- initial size of window > DoubleBuffered -- drawing mode - see above > (Just 50) -- tick rate > let > loop x = do > setGraphic w $ text (0,50) $ show x > getWindowTick w -- wait for next tick on window > loop (x+1) > loop 0 \end{verbatim} % \ToDo{There is currently no way to specify a background color.} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Concurrent Haskell}\label{concurrency} If you want to use multiple windows or each window contains a number of essentially independent components, it is convenient to use separate threads for handling each window. \Hugs{} provides a simple mechanism for doing that. The simplest concurrency primitives are \fun{par} and \fun{par\_} \begin{verbatim} > par :: IO a -> IO b -> IO (a,b) > par_ :: IO a -> IO b -> IO () \end{verbatim} (These are both exported from the \module{HGL.Graphics.Utils} module.) These run two \type{IO} actions in parallel and terminate when both actions terminate. The function \fun{par\_} discards the results of the actions. \begin{aside} The underscore in the name \fun{par\_} is derived from the use of the underscore in the definition of \fun{par\_}. \begin{verbatim} > par_ p q = (p `par` q) >>= \ _ -> return () \end{verbatim} This naming convention is also used in the Haskell Prelude and standard libraries (\fun{mapM\_}, \fun{zipWithM\_}, etc.). \end{aside} The function \fun{parMany} generalizes \fun{par\_} to lists. \begin{verbatim} > parMany :: [ IO () ] -> IO () > parMany = foldr par_ (return ()) \end{verbatim} Of course, you'll quickly realise that there's not much point in being able to create concurrent threads if threads can't communicate with each other. \Hugs{} provides an implementation of the ``Concurrent Haskell'' primitives described in the Concurrent Haskell paper~\cite{concurrentHaskell:popl96} to which we refer the enthusiastic reader. % \begin{aside} % Programmers should be aware that there is one significant difference % between \Hugs{}' implementation of concurrency and \GHC{}'s. % % \begin{description} % \item[GHC] % uses preemptive multitasking. % % Context switches can occur at any time (except if you call a C % function (like "getchar") which blocks the entire process while % waiting for input. % % \item[Hugs] % uses cooperative multitasking. % % Context switches only occur when you use one of the primitives % defined in this module. This means that programs such as: % % \begin{verbatim} % > main = forkIO (write 'a') >> write 'b' % > where % > write c = putChar c >> write c % \end{verbatim} % % will print either "aaaaaaaaaaaaaa..." or "bbbbbbbbbbbb..." % instead of some random interleaving of 'a's and 'b's. % % \end{description} % % Cooperative multitasking is sufficient for writing coroutines and simple % graphical user interfaces. % \end{aside} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{The \type{Draw} monad}\label{Draw} The \type{Graphic} type, operations and combinators provide a flexible, efficient and convenient way of drawing images on a window and encapsulate good programming practice by cleaning up any changes they must make to the state of the window. In some applications though, it is appropriate to use a lower-level, more error-prone interface for drawing images. For example, when building a library on top of the Graphics library, one might want to build on a slightly more efficient, less secure interface. Or, when teaching courses on computer graphics, it would not be possible to demonstrate low-level aspects of graphics using an interface which hides those aspects. This section describes the \type{Draw} monad (an imperative graphics interface) and describes how this is used to implement the \type{Graphic} type (a declarative graphics interface). This section can be ignored by most readers. \subsection{The \type{Draw} monad and the \type{Graphic} type}\label{Draw monad} The \type{Graphic} type lets you describe what an image should look like; the \type{Draw} monad lets you describe how to build an image. These views intersect for atomic graphics. For example, the function to draw a line can serve both as a description and as the implementation. This is exploited in the graphics library by defining \type{Graphic} as an instance of the \type{Draw} monad. Thus, all \type{Graphic} types and operations listed in section~\ref{graphics} can also be used with the \type{Draw} monad. \begin{verbatim} > data Draw a = ... > instance Functor Draw where ... > instance Monad Draw where ... > > type Graphic = Draw () \end{verbatim} The \fun{emptyGraphic} and \fun{overGraphic} functions are implemented using this monad. Their definitions should not be surprising. \begin{verbatim} > emptyGraphic = return () > g1 `overGraphic` g2 = g2 >> g1 \end{verbatim} \subsection{\type{Draw} modifiers and generators}\label{Draw modifiers} The difference between the \type{Draw} monad and the \type{Graphic} type is that the \type{Graphic} modifiers and combinators respect the structure of the graphic (see section~\ref{combining}). For example, the \fun{withBrush} modifier only affects the color of the \type{Graphic} it is applied to, it does not affect the color of the \type{Graphic} it is embedded in. In contrast, the \type{Draw} monad provides operations which change the effect of subsequent drawing operations. The following operations correspond to the graphics modifiers described in section~\ref{modifiers}. \begin{verbatim} > selectFont :: Font -> Draw Font > setTextColor :: RGB -> Draw RGB > setTextAlignment :: Alignment -> Draw Alignment > setBkColor :: RGB -> Draw RGB > setBkMode :: BkMode -> Draw BkMode > selectPen :: Pen -> Draw Pen > selectBrush :: Brush -> Draw Brush \end{verbatim} These operations all have a type of the form \type{\tva \arrow Draw \tva}. The value returned is the old value of the attribute being changed and can be used to restore the attribute to its previous value. For example, the \fun{withFont} modifier could be implemented like this: \begin{verbatim} > withFont new g = do > old <- selectFont new > g > selectFont old > return () \end{verbatim} \begin{aside} This pattern of use is very common in imperative programs so the Haskell \module{IO} library provides two combinators which encapsulate this behavior. The \fun{bracket} function takes three operations as arguments: a pre-operation \var{left}, a post-operation \var{right} and an operation \var{middle} and performs them in the order \var{left}; \var{middle}; \var{right}. The arguments are provided in the order \var{left}, \var{right}, \var{middle} because the \var{left} and \var{right} operations are often ``inverses'' of each other such as \var{openFile} and \var{closeFile}. The \fun{bracket\_} function is similar and is used when the \var{middle} operation does not require the result of the \var{left} operation. \begin{verbatim} > bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c > bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c > > bracket left right middle = do > a <- left > c <- middle a > right a > return c > > bracket_ left right middle = bracket left right (const middle) \end{verbatim} \end{aside} % \ToDo{Should these functions be qualified?} The graphics library provides similar combinators for the \fun{Draw} monad: \begin{verbatim} > bracket :: Draw a -> (a -> Draw b) -> (a -> Draw c) -> Draw c > bracket_ :: Draw a -> (a -> Draw b) -> Draw c -> Draw c \end{verbatim} \begin{aside} In fact, the \fun{bracket} and \fun{bracket\_} functions do slightly more than the above description suggests. Those provided in the \module{IO} library use Haskell's error-catching facilities to ensure that the \var{right} operation is performed even if the \var{middle} operation raises an \type{IOError} whilst those in the Graphics library use Hugs' exception-handling facilities to ensure that the \var{right} operation is performed even if the \var{middle} operation raises an exception. \end{aside} Using these combinators, it is trivial to implement the modifiers described in section~\ref{modifiers}. \begin{verbatim} > withFont x = bracket_ (selectFont x) selectFont > withTextColor x = bracket_ (setTextColor x) setTextColor > withTextAlignment x = bracket_ (setTextAlignment x) setTextAlignment > withBkColor x = bracket_ (setBkColor x) setBkColor > withBkMode x = bracket_ (setBkMode x) setBkMode > withPen x = bracket_ (selectPen x) selectPen > withBrush x = bracket_ (selectBrush x) selectBrush \end{verbatim} % \ToDo{Can we expose the mkFoo functions in the same way? Not at the moment!} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \bibliographystyle{abbrv} \bibliography{graphics} \addcontentsline{toc}{chapter}{References} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \appendix %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Quick Reference} The exported (stable) interface of the library consists of all symbols exported from \module{HGL.Graphics.Core} and \module{HGL.Graphics.Utils}. \module{HGL.Graphics} reexports all symbols exported by these modules and it is expected that most users will only import \module{HGL.Graphics}; the \module{HGL.Graphics.Core} interface is aimed solely at those wishing to use the graphics library as a base on which to build their own library or who find the \module{HGL.Graphics.Utils} interface inappropriate for their needs. % \begin{description} \iffalse % Use this command to generate the documentation: % ./gendoc GraphicsColor.hs GraphicsEvent.hs GraphicsFont.hs GraphicsPicture.hs GraphicsRegion.hs GraphicsUtils.hs > appendix.tex % \include{appendix} \else \include{oldappendix} \fi % \end{description} %*ignore \end{document} %*endignore % Local Variables: % indent-tabs-mode: nil % End: hugs98-plus-Sep2006/packages/HGL/doc/appendix.tex0000644006511100651110000000413310504340421020244 0ustar rossross\modName{GraphicsColor} \begin{verbatim} > data Color > = Black > | Blue > | Green > | Cyan > | Red > | Magenta > | Yellow > | White > deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read) > colorList :: [(Color, RGB)] > colorTable :: Array Color RGB > withColor :: Color -> Graphic -> Graphic -- SOE, p51 \end{verbatim} \modName{GraphicsEvent} \begin{verbatim} > data Event > = Key { char :: Char, isDown :: Bool } > | Button { pt :: Point, isLeft, isDown :: Bool } > | MouseMove { pt :: Point } > | Resize > | Closed > deriving Show \end{verbatim} \modName{GraphicsFont} \begin{verbatim} > createFont :: Point -> Angle -> Bool -> Bool -> String -> IO Font > deleteFont :: Font -> IO () \end{verbatim} \modName{GraphicsUtils} \begin{verbatim} > openWindow :: Title -> Size -> IO Window > clearWindow :: Window -> IO () > drawInWindow :: Window -> Graphic -> IO () > getWindowSize :: Window -> IO Size > getLBP :: Window -> IO Point > getRBP :: Window -> IO Point > getButton :: Window -> Bool -> Bool -> IO Point > getKey :: Window -> IO Char > getKeyEx :: Window -> Bool -> IO Char > withFont :: Font -> Graphic -> Graphic > withTextColor :: RGB -> Graphic -> Graphic > withTextAlignment :: Alignment -> Graphic -> Graphic > withBkColor :: RGB -> Graphic -> Graphic > withBkMode :: BkMode -> Graphic -> Graphic > withPen :: Pen -> Graphic -> Graphic > withRGB :: RGB -> Graphic -> Graphic > withBrush :: Brush -> Graphic -> Graphic > mkBrush :: RGB -> (Brush -> Graphic) -> Graphic > mkPen :: Style -> Int -> RGB -> (Pen -> Graphic) -> Graphic > emptyGraphic :: Graphic > overGraphic :: Graphic -> Graphic -> Graphic > overGraphics :: [Graphic] -> Graphic > par :: IO a -> IO b -> IO (a,b) > par_ :: IO a -> IO b -> IO () > parMany :: [IO ()] -> IO () \end{verbatim} hugs98-plus-Sep2006/packages/HGL/doc/graphics.bib0000644006511100651110000000223410504340421020170 0ustar rossross@inproceedings{concurrentHaskell:popl96, author = "Simon {Peyton Jones} and Andrew Gordon and Sigbj\orn Finne", title = "Concurrent {H}askell", pages = "295--308", publisher = "ACM press", year = "1996", month = "January", address = "St. Petersburg Beach, FL", booktitle = "Conference record of {POPL '96}: 23rd {ACM SIGPLAN-SIGACT} {S}ymposium on {P}rinciples of {P}rogramming {L}anguages", } % booktitle = "{P}rinciples of {P}rogramming {L}anguages", @Book{petzold, author = "Charles Petzold", title = "Programming Windows", publisher = "Microsoft Press", year = "1999", OPTvolume = "", OPTseries = "Microsoft Programming Series", OPTedition = "Fifth edition", note = "ISBN 1-57321-995-X (hardback)", OPTsupersedes = "", } @Book{Xlib, author = "Adrian Nye", title = "Xlib Programming Manual", publisher = "O'Reilly and Associates, Inc.", year = "1988", OPTvolume = "1", OPTseries = "X Window System Series", note = "ISBN 0-937175-26-9", OPTsupersedes = "", } hugs98-plus-Sep2006/packages/HGL/HGL.buildinfo.in0000644006511100651110000000023710504340421020062 0ustar rossross-- @configure_input@ -- System-dependent values used by Distribution.Simple.defaultUserHooks -- buildable: @BUILD_PACKAGE_BOOL@ other-modules: @EXTRA_MODULES@ hugs98-plus-Sep2006/packages/HGL/HGL.cabal0000644006511100651110000000327010504340421016544 0ustar rossrossname: HGL version: 3.1 license: BSD3 license-file: LICENSE author: Alastair Reid maintainer: category: Graphics build-depends: base, X11 synopsis: A simple graphics library based on X11 or Win32 description: A simple graphics library, designed to give the programmer access to most interesting parts of the Win32 Graphics Device Interface and X11 library without exposing the programmer to the pain and anguish usually associated with using these interfaces. . The library also includes a module Graphics.SOE providing the interface used in "The Haskell School of Expression", by Paul Hudak, cf . extra-source-files: configure.ac configure config.mk.in HGL.buildinfo.in include/HsHGLConfig.h.in Graphics/HGL/Win32/Bitmap.hs Graphics/HGL/Win32/Draw.hs Graphics/HGL/Win32/Types.hs Graphics/HGL/Win32/WND.hs Graphics/HGL/X11/Display.hs Graphics/HGL/X11/DC.hs Graphics/HGL/X11/Timer.hs Graphics/HGL/X11/Types.hs Graphics/HGL/X11/Window.hs extra-tmp-files: config.log config.status autom4te.cache config.mk HGL.buildinfo include/HsHGLConfig.h exposed-modules: Graphics.HGL.Core, Graphics.HGL.Draw, Graphics.HGL.Units, Graphics.HGL.Key, Graphics.HGL.Run, Graphics.HGL.Draw.Brush, Graphics.HGL.Draw.Font, Graphics.HGL.Draw.Monad, Graphics.HGL.Draw.Pen, Graphics.HGL.Draw.Picture, Graphics.HGL.Draw.Region, Graphics.HGL.Draw.Text, Graphics.HGL.Utils, Graphics.HGL.Window, Graphics.HGL, Graphics.SOE other-modules: Graphics.HGL.Internals.Event, Graphics.HGL.Internals.Events, Graphics.HGL.Internals.Draw, Graphics.HGL.Internals.Types, Graphics.HGL.Internals.Flag, Graphics.HGL.Internals.Utilities extensions: CPP include-dirs: include hugs98-plus-Sep2006/packages/HGL/INSTALL0000644006511100651110000000032310504340421016173 0ustar rossross# install ghc >= 6.0 # install HSX11 >= 1.00 tar zxvf HSHGL-3.00.tar.gz cd HSHGL-3.00 cd fptools ./configure --with-greencard make cd .. make boot make all make install # may require su root make -Cexamples hugs98-plus-Sep2006/packages/HGL/LICENSE0000644006511100651110000000255010504340421016153 0ustar rossrossThe Haskell Graphics Library is Copyright (c) Alastair Reid, 1996-2003, All rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/HGL/Makefile0000644006511100651110000000335010504340421016605 0ustar rossross# ----------------------------------------------------------------------------- TOP = .. include $(TOP)/mk/boilerplate.mk -include config.mk ifneq "$(findstring clean, $(MAKECMDGOALS))" "" # if we're cleaning, then config.mk might have been cleaned already HGL_BUILD_PACKAGE=yes PACKAGE=HGL endif # ----------------------------------------------------------------------------- ifeq "$(HGL_BUILD_PACKAGE)" "yes" # We do not make examples a subdir because then we can't avoid building it # SUBDIRS = examples SUBDIRS = ALL_DIRS = \ Graphics \ Graphics/HGL \ Graphics/HGL/Draw \ Graphics/HGL/Internals ifneq "$(PLATFORM)" "" ALL_DIRS += Graphics/HGL/$(PLATFORM) endif PACKAGE_DEPS = base $(PLATFORM) SRC_HC_OPTS += -cpp -Iinclude PACKAGE_CPP_OPTS += -DMAINTAINER=$(MAINTAINER) SRC_HADDOCK_OPTS += -t "Graphics Libraries ($(PACKAGE) package)" # ----------------------------------------------------------------------------- HGL/Graphics/HGL/Draw/Brush.$(way_)o \ HGL/Graphics/HGL/Draw/Font.$(way_)o \ HGL/Graphics/HGL/Draw/Pen.$(way_)o \ HGL/Graphics/HGL/Draw/Picture.$(way_)o \ HGL/Graphics/HGL/Draw/Region.$(way_)o \ HGL/Graphics/HGL/Draw/Text.$(way_)o \ HGL/Graphics/HGL/Internals/Draw.$(way_)o \ HGL/Graphics/HGL/Internals/Types.$(way_)o \ HGL/Graphics/HGL/Key.$(way_)o \ HGL/Graphics/HGL/Run.$(way_)o \ HGL/Graphics/HGL/Window.$(way_)o \ : include/HsHGLConfig.h endif EXCLUDED_SRCS += Setup.hs # ----------------------------------------------------------------------------- DIST_CLEAN_FILES += include/HsHGLConfig.h HGL.buildinfo config.cache config.status DIST_CLEAN_FILES += config.mk extraclean:: $(RM) -rf autom4te.cache # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/HGL/README0000644006511100651110000000361110504340421016025 0ustar rossross HSHGL 3.00 A Portable Graphics Library In preparation for a major release of HSHGL, we are making an alpha release for folk to play with. This release only works with X11 and GHC (it almost certainly still runs on Hugs too but we haven't tested recently). We welcome bug reports, comments on how the system is packaged, the web page, examples, comments from those who build binary and source packages, etc. and especially welcome comments accompanied by patches or cvs commit messages. We are pleased to announce a new release of the HGL: a portable graphics library. The HGL gives the programmer access to the most interesting and portable parts of the Win32 and X11 library. The library is distributed as open source and is suitable for use in teaching and applications. This version supports: Filled and unfilled 2-dimensional objects (text, lines, polygons, ellipses). Bitmaps (Win32 version only, for now). Control over text alignment, fonts, color. Simple input events (keyboard, mouse, window resize) to support reactivity. Timers and double-buffering to support simple animation. Use of concurrency to avoid the usual inversion of the code associated with event-loop programming. Multiple windows may be handled at one time. To keep the library simple and portable, the library makes no attempt to support: User interface widgets (menus, toolbars, dialog boxes, etc.) Palette manipulation and other advanced features. Many kinds of input event. This release is only for X11 and GHC. We hope to have a Win32 release soon. The library can be downloaded from: http://www.haskell.org/graphics/. You will need GHC 6.0 and HSX11 1.00 to build the library. Installation instructions are in HGL-3.00/INSTALL. Bug reports should be sent to alastair at reid-consulting-uk.ltd.uk Enjoy! -- Alastair Reid http://www.reid-consulting-uk.ltd.uk/ hugs98-plus-Sep2006/packages/HGL/aclocal.m40000644006511100651110000000054710504340421017012 0ustar rossross# Empty file to avoid a dependency on automake: autoreconf calls aclocal to # generate a temporary aclocal.m4t when no aclocal.m4 is present. # FP_ARG_HGL # ------------- AC_DEFUN([FP_ARG_HGL], [AC_ARG_ENABLE([hgl], [AC_HELP_STRING([--enable-hgl], [build HGL. (default=autodetect)])], [enable_hgl=$enableval], [enable_hgl=yes]) ])# FP_ARG_HGL hugs98-plus-Sep2006/packages/HGL/config.mk.in0000644006511100651110000000026510504340421017352 0ustar rossrossHGL_BUILD_PACKAGE=@HGL_BUILD_PACKAGE@ ifneq "$(HGL_BUILD_PACKAGE)" "no" PLATFORM=@PLATFORM@ PACKAGE=@PACKAGE_TARNAME@ VERSION=@PACKAGE_VERSION@ MAINTAINER=@PACKAGE_BUGREPORT@ endif hugs98-plus-Sep2006/packages/HGL/configure.ac0000644006511100651110000000344710504340421017442 0ustar rossrossAC_INIT([Haskell Graphics Library], [3.1], [libraries@haskell.org], [HGL]) FP_ARG_HGL if test "$enable_hgl" = no; then HGL_BUILD_PACKAGE=no else # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([Graphics/HGL.hs]) AC_CONFIG_HEADERS([include/HsHGLConfig.h]) # Check for X11 include paths and libraries AC_PATH_XTRA # AC_PATH_XTRA doesn't actually check that the C compiler can # really include the X headers, so double-check here. In particular, # this will catch the case of using a mingw32 gcc on a Cygwin system: # Cygwin has the X headers & libs installed, but the mingw32 gcc can't # use them, and we want to disable the package in this case. CPPFLAGS="$CPPFLAGS $X_CFLAGS" AC_TRY_CPP([#include ],,[no_x=yes]) # Build the package if we found X11 stuff if test "$no_x" = yes; then # or we're on Windows AC_CHECK_HEADER([windows.h], [HGL_BUILD_PACKAGE=yes PLATFORM=Win32 AC_DEFINE(X_DISPLAY_MISSING)], [HGL_BUILD_PACKAGE=no]) else HGL_BUILD_PACKAGE=yes PLATFORM=X11 fi fi AC_SUBST([HGL_BUILD_PACKAGE]) AC_SUBST([PLATFORM]) case "$PLATFORM" in Win32) EXTRA_MODULES='Graphics.HGL.Win32.Bitmap, Graphics.HGL.Win32.Draw, Graphics.HGL.Win32.Types, Graphics.HGL.Win32.WND' ;; X11) EXTRA_MODULES='Graphics.HGL.X11.Display, Graphics.HGL.X11.DC, Graphics.HGL.X11.Timer, Graphics.HGL.X11.Types, Graphics.HGL.X11.Window' ;; *) EXTRA_MODULES= ;; esac AC_SUBST([EXTRA_MODULES]) # Define CPP variables used in package.conf.in if test "$HGL_BUILD_PACKAGE" = yes; then AC_DEFINE_UNQUOTED([PLATFORM], [$PLATFORM], [Package providing the underlying graphics library.]) fi if test "$HGL_BUILD_PACKAGE" = yes; then BUILD_PACKAGE_BOOL=True else BUILD_PACKAGE_BOOL=False fi AC_SUBST([BUILD_PACKAGE_BOOL]) AC_CONFIG_FILES([config.mk HGL.buildinfo]) AC_OUTPUT hugs98-plus-Sep2006/packages/HGL/examples/0000755006511100651110000000000010504340421016762 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/examples/GTest.hs0000644006511100651110000003643310504340421020355 0ustar rossrossmodule Main where import Graphics.HGL import Data.Array import Control.Monad( when ) import Data.IORef ---------------------------------------------------------------- -- withColor :: Color -> Graphic -> Graphic -- withColor c = withRGB (colorTable ! c) ---------------------------------------------------------------- -- abbreviation for runGraphics - almost all tests that you run -- will be of the form "rg w" for some small positive n rg = runGraphics main = runGraphics $ parMany [w1,w2,w3,w4,w5,{-w6 p1,-}w7,w8,w9,w10,w13] w0 = do w <- openWindow "My First Graphics Program" (400,400) wGetChar w closeWindow w w1 = do w <- openWindow "My First Graphics Program" (400,400) drawInWindow w $ text (150,200) "Hello Graphics Window 1" getLBP w drawInWindow w $ text (150,250) "Hit a key" wGetChar w clearWindow w drawInWindow w $ text (150,200) "Thank you" drawInWindow w $ text (150,250) "Hit another key" wGetChar w closeWindow w w2 = do w <- openWindow "My Second Graphics Program" (400,400) drawInWindow w $ text (150,200) "Hello Graphics Window 2" getRBP w drawInWindow w $ text (150,250) "Hit a key" wGetChar w clearWindow w drawInWindow w $ text (150,200) "Thank you" drawInWindow w $ text (150,250) "Hit another key" wGetChar w closeWindow w ---------------------------------------------------------------- -- Region demo ---------------------------------------------------------------- -- first create some regions r1,r2,r3,r4 :: MyRegion r1 = unions [ Shape (Rect (000,000) (300,100)) , Shape (Ellipse (100,000) (200,500)) ] r2 = Shape (Rect (050,050) (250,150)) r3 = r1 `Intersect` r2 r4 = pentangle 0 pentangle :: Angle -> MyRegion pentangle phi = Shape (poly phi (4*pi/5) 5) triangle :: Angle -> MyRegion triangle phi = Shape (poly phi (2*pi/3) 3) -- draw a regular polygon with "n" sides "angle" apart poly :: Angle -> Angle -> Int -> Shape poly init delta n = Polygon vertices where thetas = take n [init, init+delta ..] vertices = [ (round x, round y) | theta <- thetas , let x = 200*(1+cos theta) , let y = 200*(1+sin theta) ] ---------------------------------------------------------------- w3 = do w <- openWindow "Regions demo" (300,500) mapM_ (\ r -> do setGraphic w (drawRegion r) getLBP w) [r1,r2,r3,r4] clearWindow w drawInWindow w $ text (150,250) "Hit a key" wGetChar w closeWindow w w4 = do wa <- openWindow "Multiwindow demo 1" (300,500) wb <- openWindow "Multiwindow demo 2" (300,500) drawInWindow wa $ text (100,100) "Hello World 1" drawInWindow wb $ text (100,100) "Hello World 2" ka <- wGetChar wa drawInWindow wb $ text (100,200) ("Got key " ++ [ka]) kb <- wGetChar wb drawInWindow wa $ text (100,200) ("Got key " ++ [kb]) closeWindow wa closeWindow wb ---------------------------------------------------------------- -- Picture demo ---------------------------------------------------------------- type Pic color = [(color, MyRegion)] p1 = [ (Red,r3), (Green, r2), (Blue, r1)] w5 = do w <- openWindow "Picture demo" (300,500) setGraphic w (drawPic p1) getLBP w clearWindow w drawInWindow w $ text (150,250) "Hit a key" wGetChar w closeWindow w drawPic :: Pic Color -> Graphic drawPic p = overGraphics [ withColor c $ drawRegion r | (c,r) <- p ] ---------------------------------------------------------------- -- Faster picture drawing ---------------------------------------------------------------- -- This version is more efficient because it allocates colors just once. -- -- The cost of this performance gain is that we have to expose the -- allocation and deallocation of brushes to the programmer, which -- makes it possible for them to deallocate too early, to deallocate -- too late (eg never), or to deallocate too often. -- -- Notice that you must not deallocate brushes (and fonts, etc) -- until _after_ you clear the screen - otherwise the redraw routine -- might be called and you'll have a dangling reference to the brush. -- w6 p = do -- w <- openWindow "Faster Picture Demo" (300,500) -- -- -- get the "palette" -- let colors = nub [ c | (c,r) <- p ] -- brushes <- mapM (\c -> mkBrush (colorTable ! c)) colors -- let palette = array (minBound,maxBound) (zip colors brushes) -- let pic = [ (palette!c, r) | (c,r) <- p ] -- -- setGraphic w (drawPic2 pic) -- getLBP w -- -- clearWindow w -- -- drawInWindow w $ text (150,250) "Hit a key" -- wGetChar w -- closeWindow w drawPic2 :: Pic Brush -> Graphic drawPic2 p = overGraphics [ withBrush b (drawRegion r) | (b,r) <- p ] ---------------------------------------------------------------- -- Animation (sort of) -- -- Simple animations made of lists of pictures ---------------------------------------------------------------- type Frame = Pic Color type Anim = [Frame] a1 :: Anim a1 = [ [(Red, pentangle phi) ,(Green, triangle (-phi)) ] | phi <- [0, pi/20 .. 2*pi] ] -- draw an animation (using user-input to step through animation) -- Note that this doesn't terminate until the window is closed -- which has to be done using your window manager. w7 = do w <- openWindow "Animation demo" (400,400) mapM_ (drawFrame w) a1 where -- draw a frame and wait for left button press drawFrame :: Window -> Frame -> IO () drawFrame w p = do setGraphic w (drawPic p) getLBP w return () ---------------------------------------------------------------- -- Timer demo ---------------------------------------------------------------- -- draw an animation (using timer to step through animation) w8 = do w <- openWindowEx "Timer demo" Nothing (400,400) DoubleBuffered (Just 50) mapM_ (drawFrame w) (cycle a1) where -- draw a frame and wait for a tick drawFrame :: Window -> Frame -> IO () drawFrame w p = do setGraphic w (drawPic p) getWindowTick w ---------------------------------------------------------------- -- Text demo ---------------------------------------------------------------- -- half-inch wide, red text on a transparent background at a 45 degree angle -- quarter-inch wide, red text on a green background at a -45 degree angle w9 = do w <- openWindow "Font demo" (500,500) font1 <- createFont (50,50) (pi/4) False False "helvetica" font2 <- createFont (25,50) (-pi/4) True True "times" drawInWindow w $ withTextColor (RGB 255 0 0) $ withFont font1 $ withBkMode Transparent $ text (050,450) "Font Test 1" drawInWindow w $ withTextColor (RGB 0 0 255) $ withFont font2 $ withBkMode Opaque $ withBkColor (RGB 0 255 0) $ text (050,050) "Font Test 2" getLBP w deleteFont font1 deleteFont font2 closeWindow w ---------------------------------------------------------------- -- Error catching demo ---------------------------------------------------------------- -- This program demonstrates that the system doesn't get left in -- an inconsistent state even if your program hits an error. w10 = do w <- openWindow "Error recovery demo" (300,300) drawInWindow w $ text (10,150) "Click me to test error recovery" getLBP w drawInWindow w $ error "foo1" --error "foo2" getLBP w clearWindow w drawInWindow w $ text (10,150) "Shouldn't have made it this far" getLBP w closeWindow w ---------------------------------------------------------------- -- Bitmap demo ---------------------------------------------------------------- {- w11 = do w <- openWindow "Bitmap demo" (300,500) setGraphic w $ text (150,200) "Test" `overGraphic` drawPic p1 Draw.saveGraphic "bitmaps/Foo.bmp" (300,500) $ text (150,200) "Test" `overGraphic` drawPic p1 getLBP w closeWindow w w11b = do (bmp,_) <- Bitmap.load "bitmaps/Foo.bmp" w <- openWindow "Bitmap demo" (300,500) setGraphic w $ Bitmap.draw (50,50) bmp wGetChar w closeWindow w w11c = do (bmp,_) <- Bitmap.load "bitmaps/Foo.bmp" w <- openWindow "Bitmap demo" (300,500) setGraphic w $ Bitmap.drawStretched (0,400) (400,0) bmp wGetChar w closeWindow w w12 = do w <- openWindow "Bitmap demo" (400,400) mapM_ (drawFrame w) (zip [100..] a1) where -- draw a frame and wait for left button press drawFrame :: Window -> (Int,Frame) -> IO () drawFrame w (i,p) = do setGraphic w $ drawPic p Draw.saveGraphic name (400,400) $ drawPic p getLBP w return () where name = "bitmaps/" ++ "Foo" ++ show i ++ ".bmp" -} w13 = do w <- openWindow "My First Incremental Graphics Program" (400,400) -- start with 2 elements in the list so that polyline doesn't crash pointRef <- newIORef [(0,0),(400,400)] let -- discrete lines between left clicks, right click to move on loop1 = do e <- getWindowEvent w case e of Button{pt=pt,isDown=isDown,isLeft=isLeft} | not isLeft -> return () | isDown -> addPoint pt >> loop1 Closed -> return () _ -> loop1 -- continuous lines as long as mouse is held down loop2 down = do e <- getWindowEvent w case e of Button{isDown=isDown}-> loop2 isDown MouseMove{pt=pt} -> do when down (addPoint pt) loop2 down Closed -> return () _ -> loop2 down -- code to do a total redraw drawPoints = do pts <- ioToDraw $ readIORef pointRef withColor Red $ polyline pts -- code to draw the bit that changed and record the change addPoint pt = do pts <- readIORef pointRef writeIORef pointRef (pt:pts) directDraw w $ withColor Red $ line pt (head pts) --uncomment the next line to see how bad a total redraw would be -- redrawWindow w setGraphic w drawPoints loop1 loop2 True closeWindow w ---------------------------------------------------------------- -- Examples of straight pictures (not regions) ---------------------------------------------------------------- shapeToGraphic :: Shape -> Graphic shapeToGraphic shape = case shape of Rect (x1,y1) (x2,y2) -> polygon [(x1,y1),(x2,y1),(x2,y2),(x1,y2)] Ellipse p1 p2 -> ellipse p1 p2 Polygon pts -> polygon pts s1 = Rect (100,100) (200,300) s2 = Ellipse (150,150) (300,200) s3 = poly 0 (4*pi/5) 5 w14 = do w <- openWindow "Pure Picture Demo" (400,400) drawInWindow w $ withColor Red $ shapeToGraphic s1 drawInWindow w $ withColor Blue $ shapeToGraphic s2 drawInWindow w $ withColor Yellow $ shapeToGraphic s3 suspend w suspend = loop where loop w = getWindowEvent w >> loop w pic1 = withColor Red $ ellipse (150,150) (300,200) pic2 = withColor Blue $ polyline [(100,50),(200,50),(200,250),(100,250),(100,50)] testGraphics = runGraphics $ do w <- openWindow "Some Graphics Figures" (300,300) drawInWindow w pic1 drawInWindow w pic2 suspend w ---------------------------------------------------------------- -- Examples from the documentation ---------------------------------------------------------------- demos :: IO () demos = runGraphics $ parMany [ helloWorld , eg cp -- , fontDemo , lineDemo 0 , lineDemo 1 , lineDemo 20 , keyTest , timerDemo , ellipseTest ] helloWorld :: IO () helloWorld = do w <- openWindow "Hello World Window" (300, 300) drawInWindow w $ text (100, 100) "Hello" drawInWindow w $ text (100, 200) "World" wGetChar w closeWindow w cp :: Graphic cp = mkBrush (colorTable!Red) $ \ red -> mkBrush (colorTable!Blue) $ \ blue -> overGraphic (withBrush red $ polygon [(200,200),(400,200),(300,400)]) (withBrush blue $ polygon [(100,100),(500,100),(500,500),(100,500)]) eg :: Graphic -> IO () eg p = do w <- openWindow "Hello World Window" (600,600) drawInWindow w p wGetChar w closeWindow w -- fontDemo :: IO () -- fontDemo = do -- w <- openWindow "Font Demo Window" (500,500) -- drawInWindow w $ -- withTextColor (RGB 255 0 0) $ -- mkFont (50,100) (pi/4) False True "Arial" $ \ font -> -- withFont font $ -- withBkColor (RGB 0 255 0) $ -- withBkMode Opaque $ -- text (050,450) "Font Demo" -- wGetChar w -- closeWindow w -- Note that "width" must be 1 or less for the penstyle to matter lineDemo :: Int -> IO () lineDemo width = do w <- openWindow ("Line Demo Window " ++ show width) (500,500) drawInWindow w $ let color = colorTable ! Red in mkPen Solid width color $ \ pen1 -> mkPen Dash width color $ \ pen2 -> mkPen Dot width color $ \ pen3 -> mkPen DashDotDot width color $ \ pen4 -> overGraphics [ withPen pen1 $ line (100,100) (400,100) , withPen pen2 $ line (100,200) (400,200) , withPen pen3 $ line (100,300) (400,300) , withPen pen4 $ line (100,400) (400,400) ] wGetChar w closeWindow w -- Just what keys can we see? keyTest :: IO () keyTest= do w <- openWindow "Keypress Demo Window" (500,500) c <- wGetChar w print (fromEnum c) closeWindow w -- Tick counter timerDemo = do w <- openWindowEx "Timer demo" -- title (Just (500,500)) -- initial position of window (100,100) -- initial size of window drawFun -- draw function - see below (Just 50) -- tick rate let loop x = do setGraphic w $ text (0,50) $ show x getWindowTick w -- wait for next tick on window loop (x+1) loop 0 where -- The possible choices of "drawFun" are -- -- o drawBufferedGraphic - use a double buffer to reduce animation flicker -- o drawGraphic - draw directly to screen (for speed) useDoubleBuffering = True drawFun = if useDoubleBuffering then DoubleBuffered else Unbuffered ellipseTest :: IO () ellipseTest = do w <- openWindow "Ellipse Test" (300, 300) drawInWindow w $ ellipse (0,0) (200, 100) wGetChar w closeWindow w ---------------------------------------------------------------- -- Region code - prototype of the code in SOE ---------------------------------------------------------------- {- module Region( MyRegion(Empty, Union, Intersect, Shape), unions, Shape(Rect, Ellipse, Polygon), drawRegion ) where import GraphicsRegion -} data MyRegion = Empty | Union MyRegion MyRegion | Intersect MyRegion MyRegion | Shape Shape unions :: [MyRegion] -> MyRegion unions = foldr Union Empty --intersects :: [MyRegion] -> MyRegion --intersects = foldr Intersect Full drawRegion :: MyRegion -> Graphic drawRegion r = regionToGraphic (regionToRGN r) regionToRGN :: MyRegion -> Region regionToRGN Empty = rectangleRegion (0,0) (0,0) regionToRGN (Shape s) = shapeToRGN s regionToRGN (r1 `Union` r2) = unionRegion (regionToRGN r1) (regionToRGN r2) regionToRGN (r1 `Intersect` r2) = intersectRegion (regionToRGN r1) (regionToRGN r2) data Shape = Rect Point Point | Ellipse Point Point | Polygon [Point] shapeToRGN :: Shape -> Region shapeToRGN (Rect p1 p2) = rectangleRegion p1 p2 shapeToRGN (Ellipse p1 p2) = ellipseRegion p1 p2 shapeToRGN (Polygon ps) = polygonRegion ps ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/examples/Makefile0000644006511100651110000000126110504340421020422 0ustar rossross# ----------------------------------------------------------------------------- # $Id: Makefile,v 1.6 2004/05/05 11:39:13 ross Exp $ TOP = ../.. include $(TOP)/mk/boilerplate.mk # # Disable 'make boot' # NO_BOOT_TARGET=YES WAYS= # ----------------------------------------------------------------------------- EXAMPLES := $(wildcard *.hs) BINS := $(EXAMPLES:.hs=$(exeext)) CLEAN_FILES += $(BINS) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -package HGL all:: $(BINS) $(BINS): %$(exeext): %.hs $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $< # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/HGL/examples/HelloWorld.hs0000644006511100651110000000036710504340421021377 0ustar rossrossmodule Main(main) where import Graphics.HGL main :: IO () main = runGraphics $ do w <- openWindow "Hello World Window" (300, 300) drawInWindow w (text (100, 100) "Hello") drawInWindow w (text (100, 200) "World") getKey w closeWindow w hugs98-plus-Sep2006/packages/HGL/examples/README0000644006511100651110000000367710504340421017657 0ustar rossrossSome tests for the Haskell Graphics Library. HelloWorld: displays 2 strings, exits on a key press&release. Tests: four tests: "Test" prompts for keypress keypresses step through outlines: white square, white diamond + red triangle, white diamond, white pentagon, empty then exits "Animation" prompts for keypress keypresses step through white outline polygons, up to 20 sides then exits "Font demo" "Font Test1" in square Courier, red, rotated (Win32 only) "Font Test2" in Lucida italic, blue on green, rotated (Win32 only) exits on left mouse button press "Font demo 2" displays 9 texts with different alignments relative to points exits on a left mouse button press GTest: a bunch of tests: "My First Graphics Program": displays text waits for a left mouse button press prompts for 2 keypresses and then exits "My Second Graphics Program" displays text waits for a right mouse button press prompts for 2 keypresses and then exits "Regions demo" draws 4 monochrome pictures, stepped with left mouse button presses prompts for a keypress and then exits "Multiwindow demo 1"+"Multiwindow demo 2" displays text in each window prompts for a keypress in each window and then exits "Picture demo" draws picture in red, green and blue on black background waits for a left mouse button press prompts for a keypress and then exits "Animation demo" rotating red&green picture, stepped with left mouse button presses freezes after 21 steps "Timer demo" the same animation as above, but on a timer "Font demo" "Font Test1" in square Helvetica, red, rotated (Win32 only) "Font Test2" in Times italic, blue on green, rotated (Win32 only) exits on left mouse button press "Error recovery demo" left mouse button press does error "foo1" "My First Incremental Graphics Program" starts with a red diagonal line mouse button clicks add red lines to the picture you can also draw by dragging hugs98-plus-Sep2006/packages/HGL/examples/Tests.hs0000644006511100651110000001263310504340421020425 0ustar rossrossmodule Main( main ) where import Graphics.HGL import Control.Exception( try ) ---------------------------------------------------------------- -- Main ---------------------------------------------------------------- main :: IO () main = rgs [ w1, w2 polys, w9, w10 ] ---------------------------------------------------------------- -- Other Examples ---------------------------------------------------------------- w1 = do w <- openWindow "Test" (400,400) setGraphic w (text (100,100) "Press a key") getKey w red <- createPen Solid 4 (RGB 255 0 0) green <- createPen Solid 4 (RGB 0 255 0) blue <- createPen Solid 4 (RGB 0 0 255) setGraphic w $ p1 getKey w setGraphic w $ (withPen red $ regular 3 (200,200) 100) `overGraphic` regular 4 (200,200) 100 getKey w setGraphic w $ regular 4 (200,200) 100 getKey w setGraphic w $ regular 5 (200,200) 100 getKey w setGraphic w emptyGraphic getKey w closeWindow w return () w2 ps = do w <- openWindow "Animation" (400,400) setGraphic w (withTextColor (RGB 255 0 0) $ text (100,100) "Press a key") getKey w sequence_ [ setGraphic w p >> getKey w | p <- ps ] closeWindow w polys = [ regular i (200,200) 100 | i <- [3..20] ] p1 = overGraphics [ line (100,100) (200,100) , line (200,100) (200,200) , line (200,200) (100,200) , line (100,200) (100,100) ] p2 = polyline [ (100,100) , (200,100) , (200,200) , (100,200) , (100,100) ] regular :: Int -> Point -> Double -> Graphic regular n = poly 0.0 (2*pi / fromIntegral n) n -- draw a regular polygon with "n" sides "angle" apart poly :: Angle -> Angle -> Int -> Point -> Double -> Graphic poly init delta n (x,y) radius = polyline vertices where thetas = take (n+1) [init, init+delta ..] vertices = [ (x + round dx, y + round dy) | theta <- thetas , let dx = radius * cos theta , let dy = radius * sin theta ] rg = runGraphics rgs = rg . parMany -- overMany :: [Graphic] -> Graphic -- overMany = foldr overGraphic emptyGraphic w9 = do font1 <- createFont (50,50) (pi/4) False False "courier" font2 <- createFont (25,50) (-pi/4) True True "lucida" w <- openWindow "Font demo" (500,500) drawInWindow w $ withTextColor (RGB 255 0 0) $ withFont font1 $ withBkMode Transparent $ text (050,450) "Font Test 1" drawInWindow w $ withTextColor (RGB 0 0 255) $ withFont font2 $ withBkMode Opaque $ withBkColor (RGB 0 255 0) $ text (050,050) "Font Test 2" getLBP w deleteFont font1 deleteFont font2 closeWindow w w10 = do font1 <- createFont (10,20) 0 False False "helvetica" w <- openWindow "Font demo 2" (600,600) drawInWindow w $ withFont font1 $ overGraphics $ [ test h v | h <- [ Left' .. Right' ] , v <- [ Top .. Bottom ] ] getLBP w deleteFont font1 closeWindow w where (x,y) = (300, 300) r = 4 test h v = withTextAlignment (h,v) $ text (x', y') (show (h,v)) `overGraphic` ellipse (x'-r, y'-r) (x'+r, y'+r) where dx = 250 * (fromEnum h - 1) dy = 250 * (fromEnum v - 1) x' = x + dx y' = y + dy w11a = w11 True w11b = w11 False w11 safe = do fonts' <- getFonts safe fonts w <- openWindow "Font demo" (600,600) drawInWindow w $ overGraphics $ map (\(f,y) -> withFont f $ text (50,y) "Font Test") $ zip fonts' [0,50..] getLBP w closeWindow w mapM_ deleteFont fonts' where fonts = [ "courier" , "helvetica" , "times" , "lucida" , "new century schoolbook" , "symbol" , "utopia" , "charter" , "gothic" , "terminal" -- , "song" , "clean" , "fixed" ] getFonts :: Bool -> [String] -> IO [Font] getFonts safe fonts -- When used in safe mode, we protect against the distinct possibility -- that your machine doesn't have all the fonts you want. | safe = do fonts' <- mapM (try . createFont (50,50) 0 False False) fonts return [ f | Right f <- fonts' ] -- When used in unsafe mode, you get whatever error message the underlying -- system feels like giving you. | otherwise = do mapM (createFont (50,50) 0 False False) fonts ellipseTest :: IO () ellipseTest = do w <- openWindow "Ellipse Test" (300, 500) drawInWindow w $ ellipse (0,0) (200, 100) drawInWindow w $ shearEllipse (200, 100) (0,100) (200,200) let (x0,y0) = (100, 300) r = 50 drawInWindow w $ overGraphics $ [ shearEllipse (x0,y0) (x0 + round (r*cos a), y0 + round (r*sin a)) (x0 + round (r*cos a'), y0 + round (r*sin a')) | a <- take 5 [ 0, 2*pi/5 .. ] , let a' = a + pi/4 ] drawInWindow w $ overGraphics $ [ parallelogram (x0,y0) (x0 + round (r*cos a), y0 + round (r*sin a)) (x0 + round (r*cos a'), y0 + round (r*sin a')) | a <- take 5 [ 0, 2*pi/5 .. ] , let a' = a + pi/4 ] getKey w closeWindow w parallelogram (x0,y0) (x1,y1) (x2,y2) = polyline pts where pts = [ (x0,y0), (x1,y1), (x1+x2-x0,y1+y2-y0), (x2,y2), (x0,y0) ] ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/HGL/include/0000755006511100651110000000000010504340646016600 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/include/HsHGLConfig.h.in0000644006511100651110000000267310504340646021421 0ustar rossross/* include/HsHGLConfig.h.in. Generated from configure.ac by autoheader. */ /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Package providing the underlying graphics library. */ #undef PLATFORM /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS /* Define to 1 if the X Window System is missing or not being used. */ #undef X_DISPLAY_MISSING hugs98-plus-Sep2006/packages/HGL/mk/0000755006511100651110000000000010504340421015553 5ustar rossrosshugs98-plus-Sep2006/packages/HGL/mk/boilerplate.mk0000644006511100651110000000233310504340421020407 0ustar rossross# Begin by slurping in the boilerplate from one level up. # Remember, TOP is the top level of the innermost level # (FPTOOLS_TOP is the fptools top) # We need to set TOP to be the TOP that the next level up expects! # The TOP variable is reset after the inclusion of the fptools # boilerplate, so we stash TOP away first: LIBRARY_TOP := $(TOP) TOP:=$(TOP)/../.. HIERARCHICAL_LIB = YES # Some of the libraries rely on GreenCard. When you compile the GreenCard # generated code, you have to use -I/usr/lib/ghc-/include so that # the C compiler can find HsFFI.h. The easy way of doing this is to use ghc # as your C compiler. UseGhcForCc = YES # NOT YET: Haddock needs to understand about .raw-hs files # # Set our source links to point to the CVS repository on the web. # SRC_HADDOCK_OPTS += -s http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/libaries/$(PACKAGE) # Pull in the fptools boilerplate include $(TOP)/mk/boilerplate.mk # Reset TOP TOP:=$(LIBRARY_TOP) # ----------------------------------------------------------------- # Everything after this point # augments or overrides previously set variables. -include $(TOP)/mk/paths.mk -include $(TOP)/mk/opts.mk -include $(TOP)/mk/suffix.mk -include $(TOP)/mk/version.mk hugs98-plus-Sep2006/packages/HGL/mk/target.mk0000644006511100651110000000010210504340421017363 0ustar rossrossTOP:=$(TOP)/../.. include $(TOP)/mk/target.mk TOP:=$(LIBRARY_TOP) hugs98-plus-Sep2006/packages/HGL/mk/version.mk0000644006511100651110000000240410504340421017571 0ustar rossross# # Project-specific version information. # # Note: # this config file is intended to centralise all # project version information. To bump up the version # info on your package, edit this file and recompile # all the dependents. This file lives in the source tree. # # Project settings: # # ProjectVersion is treated as a *string* # ProjectVersionInt is treated as an *integer* (for cpp defines) # Versioning scheme: A.B.C # A: major version, decimal, any number of digits # B: minor version, decimal, any number of digits # C: patchlevel, one digit, omitted if zero. # # ProjectVersionInt does *not* contain the patchlevel (rationale: this # figure is used for conditional compilations, and library interfaces # etc. are not supposed to change between patchlevels). # # The ProjectVersionInt is included in interface files, and GHC # checks that it's reading interface generated by the same ProjectVersion # as itself. It does this even though interface file syntax may not # change between versions. Rationale: calling conventions or other # random .o-file stuff might change even if the .hi syntax doesn't ProjectName = HGL graphics library ProjectNameShort = HSHGL ProjectVersion = 3.0 ProjectVersionInt = 300 ProjectPatchLevel = 0 hugs98-plus-Sep2006/packages/HGL/package.conf.in0000644006511100651110000000227510504340421020021 0ustar rossross#include "HsHGLConfig.h" name: PACKAGE version: VERSION license: BSD3 maintainer: MAINTAINER exposed: True exposed-modules: Graphics.HGL.Core, Graphics.HGL.Draw, Graphics.HGL.Units, Graphics.HGL.Key, Graphics.HGL.Run, Graphics.HGL.Draw.Brush, Graphics.HGL.Draw.Font, Graphics.HGL.Draw.Monad, Graphics.HGL.Draw.Pen, Graphics.HGL.Draw.Picture, Graphics.HGL.Draw.Region, Graphics.HGL.Draw.Text, Graphics.HGL.Utils, Graphics.HGL.Window, Graphics.HGL, Graphics.SOE hidden-modules: Graphics.HGL.Internals.Event, Graphics.HGL.Internals.Events, Graphics.HGL.Internals.Draw, Graphics.HGL.Internals.Types, Graphics.HGL.Internals.Flag, Graphics.HGL.Internals.Utilities, #if X_DISPLAY_MISSING Graphics.HGL.Win32.Bitmap, Graphics.HGL.Win32.Draw, Graphics.HGL.Win32.Types, Graphics.HGL.Win32.WND #else Graphics.HGL.X11.Display, Graphics.HGL.X11.DC, Graphics.HGL.X11.Timer, Graphics.HGL.X11.Types, Graphics.HGL.X11.Window #endif import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSHGL" extra-libraries: include-dirs: includes: depends: base, PLATFORM hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/HGL/prologue.txt0000644006511100651110000000073010504340421017541 0ustar rossrossA simple graphics library, designed to give the programmer access to most interesting parts of the Win32 Graphics Device Interface and X11 library without exposing the programmer to the pain and anguish usually associated with using these interfaces. /Note:/ the Win32 part is not currently operational. The library also includes a module "Graphics.SOE" providing the interface used in /The Haskell School of Expression/, by Paul Hudak, cf . hugs98-plus-Sep2006/packages/HGL/Setup.hs0000644006511100651110000000023210504340421016575 0ustar rossrossmodule Main (main) where import Distribution.Simple (defaultMainWithHooks, defaultUserHooks) main :: IO () main = defaultMainWithHooks defaultUserHooks hugs98-plus-Sep2006/packages/HGL/configure0000755006511100651110000053626410504340645017103 0ustar rossross#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.60a for Haskell Graphics Library 3.1. # # Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /usr/bin/posix$PATH_SEPARATOR/bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell autoconf@gnu.org about your system, echo including any error possibly output before this echo message } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='Haskell Graphics Library' PACKAGE_TARNAME='HGL' PACKAGE_VERSION='3.1' PACKAGE_STRING='Haskell Graphics Library 3.1' PACKAGE_BUGREPORT='libraries@haskell.org' ac_unique_file="Graphics/HGL.hs" # Factoring default headers for most tests. ac_includes_default="\ #include #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_STAT_H # include #endif #ifdef STDC_HEADERS # include # include #else # ifdef HAVE_STDLIB_H # include # endif #endif #ifdef HAVE_STRING_H # if !defined STDC_HEADERS && defined HAVE_MEMORY_H # include # endif # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datarootdir datadir sysconfdir sharedstatedir localstatedir includedir oldincludedir docdir infodir htmldir dvidir pdfdir psdir libdir localedir mandir DEFS ECHO_C ECHO_N ECHO_T LIBS build_alias host_alias target_alias XMKMF CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP X_CFLAGS X_PRE_LIBS X_LIBS X_EXTRA_LIBS GREP EGREP HGL_BUILD_PACKAGE PLATFORM EXTRA_MODULES BUILD_PACKAGE_BOOL LIBOBJS LTLIBOBJS' ac_subst_files='' ac_precious_vars='build_alias host_alias target_alias XMKMF CC CFLAGS LDFLAGS CPPFLAGS CPP' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` eval with_$ac_package=\$ac_optarg ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval with_$ac_package=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute directory names. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { echo "$as_me: error: Working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$0" || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # 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 Haskell Graphics Library 3.1 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/HGL] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF X features: --x-includes=DIR X include files are in DIR --x-libraries=DIR X library files are in DIR _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of Haskell Graphics Library 3.1:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-hgl build HGL. (default=autodetect) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-x use the X Window System Some influential environment variables: XMKMF Path to xmkmf, Makefile generator for X Window System CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF Haskell Graphics Library configure 3.1 generated by GNU Autoconf 2.60a Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by Haskell Graphics Library $as_me 3.1, which was generated by GNU Autoconf 2.60a. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then set x "$CONFIG_SITE" elif test "x$prefix" != xNONE; then set x "$prefix/share/config.site" "$prefix/etc/config.site" else set x "$ac_default_prefix/share/config.site" \ "$ac_default_prefix/etc/config.site" fi shift for ac_site_file do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Check whether --enable-hgl was given. if test "${enable_hgl+set}" = set; then enableval=$enable_hgl; enable_hgl=$enableval else enable_hgl=yes fi if test "$enable_hgl" = no; then HGL_BUILD_PACKAGE=no else # Safety check: Ensure that we are in the correct source directory. ac_config_headers="$ac_config_headers include/HsHGLConfig.h" # Check for X11 include paths and libraries ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO: checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; } ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # # List of possible output files, starting from the most likely. # The algorithm is not robust to junk in `.', hence go to wildcards (a.*) # only as a last resort. b.out is created by i960 compilers. ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' # # The IRIX 6 linker writes into existing files which may not be # executable, retaining their permissions. Remove them first so a # subsequent execution test works. ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { (ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi { echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6; } if test -z "$ac_file"; then echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } { echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6; } { echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext { echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT { echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; } if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; } GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CFLAGS="" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_c89+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_c89=$ac_arg else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6; } ;; xno) { echo "$as_me:$LINENO: result: unsupported" >&5 echo "${ECHO_T}unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for X" >&5 echo $ECHO_N "checking for X... $ECHO_C" >&6; } # Check whether --with-x was given. if test "${with_x+set}" = set; then withval=$with_x; fi # $have_x is `yes', `no', `disabled', or empty when we do not yet know. if test "x$with_x" = xno; then # The user explicitly disabled X. have_x=disabled else case $x_includes,$x_libraries in #( *\'*) { { echo "$as_me:$LINENO: error: Cannot use X directory names containing '" >&5 echo "$as_me: error: Cannot use X directory names containing '" >&2;} { (exit 1); exit 1; }; };; #( *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # One or both of the vars are not set, and there is no cached value. ac_x_includes=no ac_x_libraries=no rm -f -r conftest.dir if mkdir conftest.dir; then cd conftest.dir cat >Imakefile <<'_ACEOF' incroot: @echo incroot='${INCROOT}' usrlibdir: @echo usrlibdir='${USRLIBDIR}' libdir: @echo libdir='${LIBDIR}' _ACEOF if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then # GNU make sometimes prints "make[1]: Entering...", which would confuse us. for ac_var in incroot usrlibdir libdir; do eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" done # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. for ac_extension in a so sl; do if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" && test -f "$ac_im_libdir/libX11.$ac_extension"; then ac_im_usrlibdir=$ac_im_libdir; break fi done # Screen out bogus values from the imake configuration. They are # bogus both because they are the default anyway, and because # using them would break gcc on systems where it needs fixed includes. case $ac_im_incroot in /usr/include) ac_x_includes= ;; *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;; esac case $ac_im_usrlibdir in /usr/lib | /lib) ;; *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;; esac fi cd .. rm -f -r conftest.dir fi # Standard set of common directories for X headers. # Check X11 before X11Rn because it is often a symlink to the current release. ac_x_header_dirs=' /usr/X11/include /usr/X11R6/include /usr/X11R5/include /usr/X11R4/include /usr/include/X11 /usr/include/X11R6 /usr/include/X11R5 /usr/include/X11R4 /usr/local/X11/include /usr/local/X11R6/include /usr/local/X11R5/include /usr/local/X11R4/include /usr/local/include/X11 /usr/local/include/X11R6 /usr/local/include/X11R5 /usr/local/include/X11R4 /usr/X386/include /usr/x386/include /usr/XFree86/include/X11 /usr/include /usr/local/include /usr/unsupported/include /usr/athena/include /usr/local/x11r5/include /usr/lpp/Xamples/include /usr/openwin/include /usr/openwin/share/include' if test "$ac_x_includes" = no; then # Guess where to find include files, by looking for Xlib.h. # First, try using that file with no special directory specified. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # We can compile using X headers with no special include directory. ac_x_includes= else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 for ac_dir in $ac_x_header_dirs; do if test -r "$ac_dir/X11/Xlib.h"; then ac_x_includes=$ac_dir break fi done fi rm -f conftest.err conftest.$ac_ext fi # $ac_x_includes = no if test "$ac_x_libraries" = no; then # Check for the libraries. # See if we find them without any special options. # Don't add to $LIBS permanently. ac_save_LIBS=$LIBS LIBS="-lX11 $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { XrmInitialize () ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then LIBS=$ac_save_LIBS # We can link X programs with no special library path. ac_x_libraries= else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 LIBS=$ac_save_LIBS for ac_dir in `echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` do # Don't even attempt the hair of trying to link an X program! for ac_extension in a so sl; do if test -r "$ac_dir/libX11.$ac_extension"; then ac_x_libraries=$ac_dir break 2 fi done done fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi # $ac_x_libraries = no case $ac_x_includes,$ac_x_libraries in #( no,* | *,no | *\'*) # Didn't find X, or a directory has "'" in its name. ac_cv_have_x="have_x=no";; #( *) # Record where we found X for the cache. ac_cv_have_x="have_x=yes\ ac_x_includes='$ac_x_includes'\ ac_x_libraries='$ac_x_libraries'" esac fi ;; #( *) have_x=yes;; esac eval "$ac_cv_have_x" fi # $with_x != no if test "$have_x" != yes; then { echo "$as_me:$LINENO: result: $have_x" >&5 echo "${ECHO_T}$have_x" >&6; } no_x=yes else # If each of the values was on the command line, it overrides each guess. test "x$x_includes" = xNONE && x_includes=$ac_x_includes test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries # Update the cache value to reflect the command line values. ac_cv_have_x="have_x=yes\ ac_x_includes='$x_includes'\ ac_x_libraries='$x_libraries'" { echo "$as_me:$LINENO: result: libraries $x_libraries, headers $x_includes" >&5 echo "${ECHO_T}libraries $x_libraries, headers $x_includes" >&6; } fi if test "$no_x" = yes; then # Not all programs may use this symbol, but it does not hurt to define it. cat >>confdefs.h <<\_ACEOF #define X_DISPLAY_MISSING 1 _ACEOF X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS= else if test -n "$x_includes"; then X_CFLAGS="$X_CFLAGS -I$x_includes" fi # It would also be nice to do this for all -L options, not just this one. if test -n "$x_libraries"; then X_LIBS="$X_LIBS -L$x_libraries" # For Solaris; some versions of Sun CC require a space after -R and # others require no space. Words are not sufficient . . . . { echo "$as_me:$LINENO: checking whether -R must be followed by a space" >&5 echo $ECHO_N "checking whether -R must be followed by a space... $ECHO_C" >&6; } ac_xsave_LIBS=$LIBS; LIBS="$LIBS -R$x_libraries" ac_xsave_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } X_LIBS="$X_LIBS -R$x_libraries" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 LIBS="$ac_xsave_LIBS -R $x_libraries" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } X_LIBS="$X_LIBS -R $x_libraries" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { echo "$as_me:$LINENO: result: neither works" >&5 echo "${ECHO_T}neither works" >&6; } fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext ac_c_werror_flag=$ac_xsave_c_werror_flag LIBS=$ac_xsave_LIBS fi # Check for system-dependent libraries X programs must link with. # Do this before checking for the system-independent R6 libraries # (-lICE), since we may need -lsocket or whatever for X linking. if test "$ISC" = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet" else # Martyn Johnson says this is needed for Ultrix, if the X # libraries were built with DECnet support. And Karl Berry says # the Alpha needs dnet_stub (dnet does not exist). ac_xsave_LIBS="$LIBS"; LIBS="$LIBS $X_LIBS -lX11" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char XOpenDisplay (); int main () { return XOpenDisplay (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { echo "$as_me:$LINENO: checking for dnet_ntoa in -ldnet" >&5 echo $ECHO_N "checking for dnet_ntoa in -ldnet... $ECHO_C" >&6; } if test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldnet $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char dnet_ntoa (); int main () { return dnet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dnet_dnet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dnet_dnet_ntoa=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_dnet_dnet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_dnet_dnet_ntoa" >&6; } if test $ac_cv_lib_dnet_dnet_ntoa = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet" fi if test $ac_cv_lib_dnet_dnet_ntoa = no; then { echo "$as_me:$LINENO: checking for dnet_ntoa in -ldnet_stub" >&5 echo $ECHO_N "checking for dnet_ntoa in -ldnet_stub... $ECHO_C" >&6; } if test "${ac_cv_lib_dnet_stub_dnet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldnet_stub $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char dnet_ntoa (); int main () { return dnet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dnet_stub_dnet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dnet_stub_dnet_ntoa=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_dnet_stub_dnet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_dnet_stub_dnet_ntoa" >&6; } if test $ac_cv_lib_dnet_stub_dnet_ntoa = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub" fi fi fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS="$ac_xsave_LIBS" # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT, # to get the SysV transport functions. # Chad R. Larson says the Pyramis MIS-ES running DC/OSx (SVR4) # needs -lnsl. # The nsl library prevents programs from opening the X display # on Irix 5.2, according to T.E. Dickey. # The functions gethostbyname, getservbyname, and inet_addr are # in -lbsd on LynxOS 3.0.1/i386, according to Lars Hecking. { echo "$as_me:$LINENO: checking for gethostbyname" >&5 echo $ECHO_N "checking for gethostbyname... $ECHO_C" >&6; } if test "${ac_cv_func_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define gethostbyname to an innocuous variant, in case declares gethostbyname. For example, HP-UX 11i declares gettimeofday. */ #define gethostbyname innocuous_gethostbyname /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef gethostbyname /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char gethostbyname (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_gethostbyname || defined __stub___gethostbyname choke me #endif int main () { return gethostbyname (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_gethostbyname=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_func_gethostbyname" >&6; } if test $ac_cv_func_gethostbyname = no; then { echo "$as_me:$LINENO: checking for gethostbyname in -lnsl" >&5 echo $ECHO_N "checking for gethostbyname in -lnsl... $ECHO_C" >&6; } if test "${ac_cv_lib_nsl_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnsl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char gethostbyname (); int main () { return gethostbyname (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_nsl_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_nsl_gethostbyname=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_nsl_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_lib_nsl_gethostbyname" >&6; } if test $ac_cv_lib_nsl_gethostbyname = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl" fi if test $ac_cv_lib_nsl_gethostbyname = no; then { echo "$as_me:$LINENO: checking for gethostbyname in -lbsd" >&5 echo $ECHO_N "checking for gethostbyname in -lbsd... $ECHO_C" >&6; } if test "${ac_cv_lib_bsd_gethostbyname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lbsd $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char gethostbyname (); int main () { return gethostbyname (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_bsd_gethostbyname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_bsd_gethostbyname=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_bsd_gethostbyname" >&5 echo "${ECHO_T}$ac_cv_lib_bsd_gethostbyname" >&6; } if test $ac_cv_lib_bsd_gethostbyname = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lbsd" fi fi fi # lieder@skyler.mavd.honeywell.com says without -lsocket, # socket/setsockopt and other routines are undefined under SCO ODT # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary # on later versions), says Simon Leinen: it contains gethostby* # variants that don't use the name server (or something). -lsocket # must be given before -lnsl if both are needed. We assume that # if connect needs -lnsl, so does gethostbyname. { echo "$as_me:$LINENO: checking for connect" >&5 echo $ECHO_N "checking for connect... $ECHO_C" >&6; } if test "${ac_cv_func_connect+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define connect to an innocuous variant, in case declares connect. For example, HP-UX 11i declares gettimeofday. */ #define connect innocuous_connect /* System header to define __stub macros and hopefully few prototypes, which can conflict with char connect (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef connect /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char connect (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_connect || defined __stub___connect choke me #endif int main () { return connect (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_connect=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_connect=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_func_connect" >&5 echo "${ECHO_T}$ac_cv_func_connect" >&6; } if test $ac_cv_func_connect = no; then { echo "$as_me:$LINENO: checking for connect in -lsocket" >&5 echo $ECHO_N "checking for connect in -lsocket... $ECHO_C" >&6; } if test "${ac_cv_lib_socket_connect+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $X_EXTRA_LIBS $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char connect (); int main () { return connect (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_socket_connect=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_socket_connect=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_socket_connect" >&5 echo "${ECHO_T}$ac_cv_lib_socket_connect" >&6; } if test $ac_cv_lib_socket_connect = yes; then X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS" fi fi # Guillermo Gomez says -lposix is necessary on A/UX. { echo "$as_me:$LINENO: checking for remove" >&5 echo $ECHO_N "checking for remove... $ECHO_C" >&6; } if test "${ac_cv_func_remove+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define remove to an innocuous variant, in case declares remove. For example, HP-UX 11i declares gettimeofday. */ #define remove innocuous_remove /* System header to define __stub macros and hopefully few prototypes, which can conflict with char remove (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef remove /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char remove (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_remove || defined __stub___remove choke me #endif int main () { return remove (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_remove=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_remove=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_func_remove" >&5 echo "${ECHO_T}$ac_cv_func_remove" >&6; } if test $ac_cv_func_remove = no; then { echo "$as_me:$LINENO: checking for remove in -lposix" >&5 echo $ECHO_N "checking for remove in -lposix... $ECHO_C" >&6; } if test "${ac_cv_lib_posix_remove+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lposix $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char remove (); int main () { return remove (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_posix_remove=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_posix_remove=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_posix_remove" >&5 echo "${ECHO_T}$ac_cv_lib_posix_remove" >&6; } if test $ac_cv_lib_posix_remove = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix" fi fi # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. { echo "$as_me:$LINENO: checking for shmat" >&5 echo $ECHO_N "checking for shmat... $ECHO_C" >&6; } if test "${ac_cv_func_shmat+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define shmat to an innocuous variant, in case declares shmat. For example, HP-UX 11i declares gettimeofday. */ #define shmat innocuous_shmat /* System header to define __stub macros and hopefully few prototypes, which can conflict with char shmat (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef shmat /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char shmat (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_shmat || defined __stub___shmat choke me #endif int main () { return shmat (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_shmat=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_shmat=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_func_shmat" >&5 echo "${ECHO_T}$ac_cv_func_shmat" >&6; } if test $ac_cv_func_shmat = no; then { echo "$as_me:$LINENO: checking for shmat in -lipc" >&5 echo $ECHO_N "checking for shmat in -lipc... $ECHO_C" >&6; } if test "${ac_cv_lib_ipc_shmat+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lipc $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char shmat (); int main () { return shmat (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_ipc_shmat=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_ipc_shmat=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_ipc_shmat" >&5 echo "${ECHO_T}$ac_cv_lib_ipc_shmat" >&6; } if test $ac_cv_lib_ipc_shmat = yes; then X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc" fi fi fi # Check for libraries that X11R6 Xt/Xaw programs need. ac_save_LDFLAGS=$LDFLAGS test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries" # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to # check for ICE first), but we must link in the order -lSM -lICE or # we get undefined symbols. So assume we have SM if we have ICE. # These have to be linked with before -lX11, unlike the other # libraries we check for below, so use a different variable. # John Interrante, Karl Berry { echo "$as_me:$LINENO: checking for IceConnectionNumber in -lICE" >&5 echo $ECHO_N "checking for IceConnectionNumber in -lICE... $ECHO_C" >&6; } if test "${ac_cv_lib_ICE_IceConnectionNumber+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lICE $X_EXTRA_LIBS $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char IceConnectionNumber (); int main () { return IceConnectionNumber (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_ICE_IceConnectionNumber=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_ICE_IceConnectionNumber=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_ICE_IceConnectionNumber" >&5 echo "${ECHO_T}$ac_cv_lib_ICE_IceConnectionNumber" >&6; } if test $ac_cv_lib_ICE_IceConnectionNumber = yes; then X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE" fi LDFLAGS=$ac_save_LDFLAGS fi # AC_PATH_XTRA doesn't actually check that the C compiler can # really include the X headers, so double-check here. In particular, # this will catch the case of using a mingw32 gcc on a Cygwin system: # Cygwin has the X headers & libs installed, but the mingw32 gcc can't # use them, and we want to disable the package in this case. CPPFLAGS="$CPPFLAGS $X_CFLAGS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 no_x=yes fi rm -f conftest.err conftest.$ac_ext # Build the package if we found X11 stuff if test "$no_x" = yes; then # or we're on Windows { echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Extract the first word of "grep ggrep" to use in msg output if test -z "$GREP"; then set dummy grep ggrep; ac_prog_name=$2 if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_GREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_GREP" && $as_executable_p "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_GREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_GREP_found && break 3 done done done IFS=$as_save_IFS fi GREP="$ac_cv_path_GREP" if test -z "$GREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_GREP=$GREP fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 echo "${ECHO_T}$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" { echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6; } if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else # Extract the first word of "egrep" to use in msg output if test -z "$EGREP"; then set dummy egrep; ac_prog_name=$2 if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_EGREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_EGREP" && $as_executable_p "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_EGREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_found && break 3 done done done IFS=$as_save_IFS fi EGREP="$ac_cv_path_EGREP" if test -z "$EGREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_EGREP=$EGREP fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 echo "${ECHO_T}$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" { echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) return 2; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done if test "${ac_cv_header_windows_h+set}" = set; then { echo "$as_me:$LINENO: checking for windows.h" >&5 echo $ECHO_N "checking for windows.h... $ECHO_C" >&6; } if test "${ac_cv_header_windows_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi { echo "$as_me:$LINENO: result: $ac_cv_header_windows_h" >&5 echo "${ECHO_T}$ac_cv_header_windows_h" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking windows.h usability" >&5 echo $ECHO_N "checking windows.h usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking windows.h presence" >&5 echo $ECHO_N "checking windows.h presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: windows.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: windows.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: windows.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: windows.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: windows.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: windows.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: windows.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: windows.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: windows.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: windows.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: windows.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: windows.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: windows.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: windows.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: windows.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: windows.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to libraries@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for windows.h" >&5 echo $ECHO_N "checking for windows.h... $ECHO_C" >&6; } if test "${ac_cv_header_windows_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_windows_h=$ac_header_preproc fi { echo "$as_me:$LINENO: result: $ac_cv_header_windows_h" >&5 echo "${ECHO_T}$ac_cv_header_windows_h" >&6; } fi if test $ac_cv_header_windows_h = yes; then HGL_BUILD_PACKAGE=yes PLATFORM=Win32 cat >>confdefs.h <<\_ACEOF #define X_DISPLAY_MISSING 1 _ACEOF else HGL_BUILD_PACKAGE=no fi else HGL_BUILD_PACKAGE=yes PLATFORM=X11 fi fi case "$PLATFORM" in Win32) EXTRA_MODULES='Graphics.HGL.Win32.Bitmap, Graphics.HGL.Win32.Draw, Graphics.HGL.Win32.Types, Graphics.HGL.Win32.WND' ;; X11) EXTRA_MODULES='Graphics.HGL.X11.Display, Graphics.HGL.X11.DC, Graphics.HGL.X11.Timer, Graphics.HGL.X11.Types, Graphics.HGL.X11.Window' ;; *) EXTRA_MODULES= ;; esac # Define CPP variables used in package.conf.in if test "$HGL_BUILD_PACKAGE" = yes; then cat >>confdefs.h <<_ACEOF #define PLATFORM $PLATFORM _ACEOF fi if test "$HGL_BUILD_PACKAGE" = yes; then BUILD_PACKAGE_BOOL=True else BUILD_PACKAGE_BOOL=False fi ac_config_files="$ac_config_files config.mk HGL.buildinfo" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { echo "$as_me:$LINENO: updating cache $cache_file" >&5 echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by Haskell Graphics Library $as_me 3.1, which was generated by GNU Autoconf 2.60a. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for. config_files="$ac_config_files" config_headers="$ac_config_headers" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ Haskell Graphics Library config.status 3.1 configured by $0, generated by GNU Autoconf 2.60a, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2006 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header { echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 CONFIG_SHELL=$SHELL export CONFIG_SHELL exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "include/HsHGLConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsHGLConfig.h" ;; "config.mk") CONFIG_FILES="$CONFIG_FILES config.mk" ;; "HGL.buildinfo") CONFIG_FILES="$CONFIG_FILES HGL.buildinfo" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } # # Set up the sed scripts for CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "$CONFIG_FILES"; then _ACEOF ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF SHELL!$SHELL$ac_delim PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim PACKAGE_NAME!$PACKAGE_NAME$ac_delim PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim PACKAGE_STRING!$PACKAGE_STRING$ac_delim PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim exec_prefix!$exec_prefix$ac_delim prefix!$prefix$ac_delim program_transform_name!$program_transform_name$ac_delim bindir!$bindir$ac_delim sbindir!$sbindir$ac_delim libexecdir!$libexecdir$ac_delim datarootdir!$datarootdir$ac_delim datadir!$datadir$ac_delim sysconfdir!$sysconfdir$ac_delim sharedstatedir!$sharedstatedir$ac_delim localstatedir!$localstatedir$ac_delim includedir!$includedir$ac_delim oldincludedir!$oldincludedir$ac_delim docdir!$docdir$ac_delim infodir!$infodir$ac_delim htmldir!$htmldir$ac_delim dvidir!$dvidir$ac_delim pdfdir!$pdfdir$ac_delim psdir!$psdir$ac_delim libdir!$libdir$ac_delim localedir!$localedir$ac_delim mandir!$mandir$ac_delim DEFS!$DEFS$ac_delim ECHO_C!$ECHO_C$ac_delim ECHO_N!$ECHO_N$ac_delim ECHO_T!$ECHO_T$ac_delim LIBS!$LIBS$ac_delim build_alias!$build_alias$ac_delim host_alias!$host_alias$ac_delim target_alias!$target_alias$ac_delim XMKMF!$XMKMF$ac_delim CC!$CC$ac_delim CFLAGS!$CFLAGS$ac_delim LDFLAGS!$LDFLAGS$ac_delim CPPFLAGS!$CPPFLAGS$ac_delim ac_ct_CC!$ac_ct_CC$ac_delim EXEEXT!$EXEEXT$ac_delim OBJEXT!$OBJEXT$ac_delim CPP!$CPP$ac_delim X_CFLAGS!$X_CFLAGS$ac_delim X_PRE_LIBS!$X_PRE_LIBS$ac_delim X_LIBS!$X_LIBS$ac_delim X_EXTRA_LIBS!$X_EXTRA_LIBS$ac_delim GREP!$GREP$ac_delim EGREP!$EGREP$ac_delim HGL_BUILD_PACKAGE!$HGL_BUILD_PACKAGE$ac_delim PLATFORM!$PLATFORM$ac_delim EXTRA_MODULES!$EXTRA_MODULES$ac_delim BUILD_PACKAGE_BOOL!$BUILD_PACKAGE_BOOL$ac_delim LIBOBJS!$LIBOBJS$ac_delim LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 58; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` if test -n "$ac_eof"; then ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` ac_eof=`expr $ac_eof + 1` fi cat >>$CONFIG_STATUS <<_ACEOF cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof /@[a-zA-Z_][a-zA-Z_0-9]*@/!b end _ACEOF sed ' s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g s/^/s,@/; s/!/@,|#_!!_#|/ :n t n s/'"$ac_delim"'$/,g/; t s/$/\\/; p N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n ' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF :end s/|#_!!_#|//g CEOF$ac_eof _ACEOF # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/ s/:*\${srcdir}:*/:/ s/:*@srcdir@:*/:/ s/^\([^=]*=[ ]*\):*/\1/ s/:*$// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF fi # test -n "$CONFIG_FILES" for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 echo "$as_me: error: Invalid tag $ac_tag." >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac ac_file_inputs="$ac_file_inputs $ac_f" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input="Generated from "`IFS=: echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} fi case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin";; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= case `sed -n '/datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p ' $ac_file_inputs` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s&@configure_input@&$configure_input&;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out"; rm -f "$tmp/out";; *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; esac ;; :H) # # CONFIG_HEADER # _ACEOF # Transform confdefs.h into a sed script `conftest.defines', that # substitutes the proper values into config.h.in to produce config.h. rm -f conftest.defines conftest.tail # First, append a space to every undef/define line, to ease matching. echo 's/$/ /' >conftest.defines # Then, protect against being on the right side of a sed subst, or in # an unquoted here document, in config.status. If some macros were # called several times there might be several #defines for the same # symbol, which is useless. But do not sort them, since the last # AC_DEFINE must be honored. ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* # These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where # NAME is the cpp macro being defined, VALUE is the value it is being given. # PARAMS is the parameter list in the macro definition--in most cases, it's # just an empty string. ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' ac_dB='\\)[ (].*,\\1define\\2' ac_dC=' ' ac_dD=' ,' uniq confdefs.h | sed -n ' t rset :rset s/^[ ]*#[ ]*define[ ][ ]*// t ok d :ok s/[\\&,]/\\&/g s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p ' >>conftest.defines # Remove the space that was appended to ease matching. # Then replace #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. # (The regexp can be short, since the line contains either #define or #undef.) echo 's/ $// s,^[ #]*u.*,/* & */,' >>conftest.defines # Break up conftest.defines: ac_max_sed_lines=50 # First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" # Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" # Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" # et cetera. ac_in='$ac_file_inputs' ac_out='"$tmp/out1"' ac_nxt='"$tmp/out2"' while : do # Write a here document: cat >>$CONFIG_STATUS <<_ACEOF # First, check the format of the line: cat >"\$tmp/defines.sed" <<\\CEOF /^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def /^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def b :def _ACEOF sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail grep . conftest.tail >/dev/null || break rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines conftest.tail echo "ac_result=$ac_in" >>$CONFIG_STATUS cat >>$CONFIG_STATUS <<\_ACEOF if test x"$ac_file" != x-; then echo "/* $configure_input */" >"$tmp/config.h" cat "$ac_result" >>"$tmp/config.h" if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else rm -f $ac_file mv "$tmp/config.h" $ac_file fi else echo "/* $configure_input */" cat "$ac_result" fi rm -f "$tmp/out12" ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi hugs98-plus-Sep2006/packages/HaXml/0000755006511100651110000000000010504340573015553 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/HaXml.cabal0000644006511100651110000000440310504340466017552 0ustar rossrossname: HaXml version: 1.17 ghc-options: -DVERSION="1.17" cc-options: -DVERSION="1.17" license: LGPL license-file: COPYRIGHT author: Malcolm Wallace homepage: http://www.cs.york.ac.uk/fp/HaXml/ category: Text synopsis: Utilities for manipulating XML documents description: Haskell utilities for parsing, filtering, transforming and generating XML documents. exposed-modules: Text.ParserCombinators.HuttonMeijer, Text.ParserCombinators.HuttonMeijerWallace, Text.ParserCombinators.Poly, Text.ParserCombinators.PolyState, Text.ParserCombinators.PolyLazy, Text.ParserCombinators.PolyStateLazy, Text.ParserCombinators.TextParser, Text.XML.HaXml, Text.XML.HaXml.Combinators, Text.XML.HaXml.DtdToHaskell.Convert, Text.XML.HaXml.DtdToHaskell.Instance, Text.XML.HaXml.DtdToHaskell.TypeDef, Text.XML.HaXml.Escape, Text.XML.HaXml.Html.Generate, Text.XML.HaXml.Html.Parse, Text.XML.HaXml.Html.ParseLazy, Text.XML.HaXml.Html.Pretty, Text.XML.HaXml.Lex, Text.XML.HaXml.OneOfN, Text.XML.HaXml.Parse, Text.XML.HaXml.ParseLazy, Text.XML.HaXml.Posn, Text.XML.HaXml.Pretty, Text.XML.HaXml.SAX, Text.XML.HaXml.ShowXmlLazy, Text.XML.HaXml.Types, Text.XML.HaXml.TypeMapping, Text.XML.HaXml.Validate, Text.XML.HaXml.Verbatim, Text.XML.HaXml.Wrappers, Text.XML.HaXml.XmlContent, Text.XML.HaXml.Xtract.Combinators, Text.XML.HaXml.Xtract.Lex, Text.XML.HaXml.Xtract.Parse hs-source-dir: src build-depends: base, haskell98 extensions: CPP Executable: Canonicalise GHC-Options: -Wall -O2 Extensions: CPP Hs-Source-Dirs: src/tools, src Main-Is: Canonicalise.hs Executable: CanonicaliseLazy GHC-Options: -Wall -O2 Extensions: CPP Hs-Source-Dirs: src/tools, src Main-Is: CanonicaliseLazy.hs Executable: Xtract GHC-Options: -Wall -O2 Extensions: CPP Hs-Source-Dirs: src/tools, src Main-Is: Xtract.hs Executable: XtractLazy GHC-Options: -Wall -O2 Extensions: CPP Hs-Source-Dirs: src/tools, src Main-Is: XtractLazy.hs Executable: Validate GHC-Options: -Wall -O2 Extensions: CPP Hs-Source-Dirs: src/tools, src Main-Is: Validate.hs Executable: MkOneOf GHC-Options: -Wall -O2 Extensions: CPP Hs-Source-Dirs: src/tools, src Main-Is: MkOneOf.hs Executable: DtdToHaskell GHC-Options: -Wall -O2 Extensions: CPP Hs-Source-Dirs: src/tools, src Main-Is: DtdToHaskell.hs hugs98-plus-Sep2006/packages/HaXml/Build.bat0000644006511100651110000001015210504340466017302 0ustar rossrossREM -- Build HaXml package using GHC REM REM Usage: (case-sensitive) REM Build compile and install the HaXml library GHC package REM Build Remove remove the HaXml GHC library package REM Build Tools compile the tools shipped with HaXml rem -- Change the following variables (upto and including SRC) rem -- to suit the local system environment -- rem GHC version set GHCVER=6.4.2 rem GHC installation directory: set GHCDIR=C:\DEV\ghc\ghc-%GHCVER% rem Programs needed to build HaXml: rem rem NOTE: install MinGW linked from rem for a copy of 'ar.exe' rem set GHC=C:\DEV\ghc\ghc-%GHCVER%\bin\ghc.exe set GHCPKG=C:\DEV\ghc\ghc-%GHCVER%\bin\ghc-pkg.exe set AR=C:\DEV\MinGW\bin\ar.exe set LD=C:\DEV\ghc\ghc-%GHCVER%\gcc-lib\ld.exe rem Source directory for HaXml: set SRC=C:\DEV\Haskell\lib\HaXml-1.17\src rem Two very long lines (500-600 chars) follow here. rem They should not need changing. set SRCS=Text/XML/HaXml.hs Text/XML/HaXml/Combinators.hs Text/XML/HaXml/Posn.hs Text/XML/HaXml/Lex.hs Text/XML/HaXml/Parse.hs Text/XML/HaXml/Pretty.hs Text/XML/HaXml/Types.hs Text/XML/HaXml/Validate.hs Text/XML/HaXml/Wrappers.hs Text/XML/HaXml/OneOfN.hs Text/XML/HaXml/XmlContent.hs Text/XML/HaXml/TypeMapping.hs Text/XML/HaXml/Verbatim.hs Text/XML/HaXml/Escape.hs Text/XML/HaXml/SAX.hs Text/XML/HaXml/Html/Generate.hs Text/XML/HaXml/Html/Parse.hs Text/XML/HaXml/Html/Pretty.hs Text/XML/HaXml/Xtract/Combinators.hs Text/XML/HaXml/Xtract/Lex.hs Text/XML/HaXml/Xtract/Parse.hs Text/ParserCombinators/Poly.hs Text/ParserCombinators/PolyState.hs Text/ParserCombinators/TextParser.hs Text/ParserCombinators/PolyLazy.hs Text/ParserCombinators/PolyStateLazy.hs Text/XML/HaXml/ParseLazy.hs Text/XML/HaXml/Html/ParseLazy.hs set OBJS=Text/XML/HaXml.o Text/XML/HaXml/Combinators.o Text/XML/HaXml/Posn.o Text/XML/HaXml/Lex.o Text/XML/HaXml/Parse.o Text/XML/HaXml/Pretty.o Text/XML/HaXml/Types.o Text/XML/HaXml/Validate.o Text/XML/HaXml/Wrappers.o Text/XML/HaXml/OneOfN.o Text/XML/HaXml/XmlContent.o Text/XML/HaXml/TypeMapping.o Text/XML/HaXml/Verbatim.o Text/XML/HaXml/Escape.o Text/XML/HaXml/SAX.o Text/XML/HaXml/Html/Generate.o Text/XML/HaXml/Html/Parse.o Text/XML/HaXml/Html/Pretty.o Text/XML/HaXml/Xtract/Combinators.o Text/XML/HaXml/Xtract/Lex.o Text/XML/HaXml/Xtract/Parse.o Text/ParserCombinators/Poly.o Text/ParserCombinators/PolyState.o Text/ParserCombinators/TextParser.o Text/ParserCombinators/PolyLazy.o Text/ParserCombinators/PolyStateLazy.o Text/XML/HaXml/ParseLazy.o Text/XML/HaXml/Html/ParseLazy.o rem -- Get on with the real work -- if "%1"=="Remove" goto Remove if "%1"=="Tools" goto Tools rem -- Compile sources and create library archive if "%GHCVER%"=="6.4" COPY HaXml.cabal %SRC%\pkg.conf cd %SRC% %GHC% --make -cpp -i. -package-name HaXml %SRCS% %AR% r libHSHaXml.a %OBJS% rem -- Create library file for GHCi %LD% -r --whole-archive -o HSHaXml.o libHSHaXml.a rem -- Install the library archive(s) where GHC can find them COPY libHSHaXml.a %GHCDIR% COPY HSHaXml.o %GHCDIR% rem -- Install the interface files where GHC can find them rem /L - list only, /Y - overrite without confirmation rem /S - copy subdirectories, /T - create directories only rem /F - display full filenames while copying XCOPY /S /F *.hi %GHCDIR%\imports rem -- Finally, register the package with GHC if "%GHCVER%"=="6.2.2" %GHCPKG% --add-package -i pkg.conf if "%GHCVER%"=="6.4.2" ECHO import-dirs: %GHCDIR%\imports >>pkg.conf if "%GHCVER%"=="6.4.2" ECHO library-dirs: %GHCDIR% >>pkg.conf if "%GHCVER%"=="6.4.2" ECHO depends: base, haskell98 >>pkg.conf if "%GHCVER%"=="6.4.2" ECHO hs-libraries: HSHaXml >>pkg.conf if "%GHCVER%"=="6.4.2" %GHCPKG% register pkg.conf goto Exit rem -- Remove GHC package for HaXml -- :Remove %GHCPKG% --remove-package HaXml goto Exit rem -- Build tools that come with HaXml -- :Tools cd %SRC%\tools for %%F in (Canonicalise DtdToHaskell MkOneOf Validate Xtract CanonicaliseLazy XtractLazy) DO %GHC% --make -cpp -i.. %%F -o %%F.exe cd .. goto Exit rem -- All done -- :Exit hugs98-plus-Sep2006/packages/HaXml/COPYRIGHT0000644006511100651110000000273110504340466017052 0ustar rossrossThe HaXml library and tools were written by and are copyright to (c) copyright 1998-2006 Malcolm Wallace and Colin Runciman The library incorporates the module Text.ParserCombinators.HuttonMeijerWallace (c) copyright 1996 Graham Hutton and Erik Meijer with modifications (c) copyright 1998-2000 Malcolm Wallace The HaXml library is licensed under the terms of the GNU Lesser General Public Licence (LGPL), which can be found in the file called LICENCE-LGPL, with the following special exception: ---- As a relaxation of clause 6 of the LGPL, the copyright holders of this library give permission to use, copy, link, modify, and distribute, binary-only object-code versions of an executable linked with the original unmodified Library, without requiring the supply of any mechanism to modify or replace the Library and relink (clauses 6a, 6b, 6c, 6d, 6e), provided that all the other terms of clause 6 are complied with. ---- The HaXml tools Xtract, Validate, DtdToHaskell, and MkOneOf, are licensed under the terms of the GNU General Public Licence (GPL), which can be found in the file called LICENCE-GPL. This library and toolset is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Licences for more details. If these licensing terms are not acceptable to you, please contact me for negotiation. :-) Malcolm.Wallace@cs.york.ac.uk hugs98-plus-Sep2006/packages/HaXml/bugs/0000755006511100651110000000000010504340456016513 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/bugs/Baars.hs0000644006511100651110000000402010504340456020073 0ustar rossrossmodule Main where import Text.XML.HaXml.Xml2Haskell import Text.XML.HaXml.OneOfN import Text.XML.HaXml.Wrappers (fix2Args) main = do (infile,outfile) <- fix2Args putStrLn ("reading "++infile) value <- readXml infile putStrLn (let (Descriptions xs) = value in if xs == xs then "ok" else "failed") print value {-Type decls-} newtype Descriptions = Descriptions (Maybe Descriptions_) deriving (Eq,Show) data Descriptions_ = Descriptions_ Item Description deriving (Eq,Show) newtype Item = Item String deriving (Eq,Show) newtype Description = Description String deriving (Eq,Show) {-Instance decls-} instance XmlContent Descriptions where fromElem (c0@(CElem (Elem "descriptions" [] _)):rest) = (\(a,ca)-> (Just (Descriptions a), rest)) (fromElem [c0]) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Descriptions a) = [CElem (Elem "descriptions" [] (maybe [] toElem a))] instance XmlContent Descriptions_ where fromElem (CElem (Elem "descriptions" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (Just (Descriptions_ a b), rest)) (definite fromElem "" "descriptions" ca)) (definite fromElem "" "descriptions" c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Descriptions_ a b) = [CElem (Elem "descriptions" [] (toElem a ++ toElem b))] instance XmlContent Item where fromElem (CElem (Elem "item" [] c0):rest) = (\(a,ca)-> (Just (Item a), rest)) (definite fromText "text" "item" c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Item a) = [CElem (Elem "item" [] (toText a))] instance XmlContent Description where fromElem (CElem (Elem "description" [] c0):rest) = (\(a,ca)-> (Just (Description a), rest)) (definite fromText "text" "description" c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Description a) = [CElem (Elem "description" [] (toText a))] {-Done-} hugs98-plus-Sep2006/packages/HaXml/bugs/AB.hs0000644006511100651110000000007710504340456017335 0ustar rossrossdata AB = A | AB | ABCD | ABC {-! derive : Haskell2Xml !-} hugs98-plus-Sep2006/packages/HaXml/bugs/Geisler2003.dtd0000644006511100651110000000010110504340456021077 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/AuxType.dtd0000644006511100651110000000052110504340456020605 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/bugs/Complex.dtd0000644006511100651110000000037410504340456020623 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/DTD_gdxl.hs0000644006511100651110000010346110504340456020505 0ustar rossrossmodule DTD_Gdxl where import Xml2Haskell {- patches -} instance (Show a, Show b) => Show (OneOf2 a b) where showsPrec i (OneOfTwo a) = showString "OneOfTwo" . showsPrec i a showsPrec i (TwoOfTwo b) = showString "TwoOfTwo" . showsPrec i b instance (Eq a, Eq b) => Eq (OneOf2 a b) where (==) (OneOfTwo a) (OneOfTwo b) = a == b (==) (TwoOfTwo a) (TwoOfTwo b) = a == b (==) _ _ = False {-Type decls-} data Gdxl = Gdxl Gdxl_Attrs [Sequencematch] [Graphdelta] (Maybe Xlinkdelta) deriving (Eq,Show) data Gdxl_Attrs = Gdxl_Attrs { gdxlSourcedoc :: (Maybe String) , gdxlTargetdoc :: (Maybe String) } deriving (Eq,Show) data Typedelta = Typedelta (Maybe Xlinkdelta) (Maybe Hrefdelta) deriving (Eq,Show) data Xlinkdelta = Xlinkdelta { xlinkdeltaOldxlink :: String , xlinkdeltaNewxlink :: String } deriving (Eq,Show) data Hrefdelta = Hrefdelta { hrefdeltaHrefmode :: Hrefdelta_Hrefmode , hrefdeltaNewlink :: String , hrefdeltaOldlink :: String } deriving (Eq,Show) data Hrefdelta_Hrefmode = Hrefdelta_Hrefmode_Absolute | Hrefdelta_Hrefmode_Local | Hrefdelta_Hrefmode_Relative deriving (Eq,Show) data Sequencematch = Sequencematch { sequencematchLength :: (Defaultable String) , sequencematchOldstart :: String , sequencematchNewstart :: String } deriving (Eq,Show) data Graphdelta = Graphdelta (Maybe Typedelta) Attributedelta [Nodedelta] [Edgedelta] [Reldelta] (Maybe Iddelta) (Maybe Roledelta) (OneOf2 Booldelta Skip) (Maybe Booldelta) (Maybe Edgemodedelta) deriving (Eq,Show) data Iddelta = Iddelta { iddeltaOldid :: String , iddeltaNewid :: String } deriving (Eq,Show) data Roledelta = Roledelta { roledeltaOldrole :: String , roledeltaNewrole :: String } deriving (Eq,Show) data Booldelta = Booldelta { booldeltaOldbool :: Booldelta_Oldbool , booldeltaNewbool :: Booldelta_Newbool } deriving (Eq,Show) data Booldelta_Oldbool = Booldelta_Oldbool_True | Booldelta_Oldbool_False deriving (Eq,Show) data Booldelta_Newbool = Booldelta_Newbool_True | Booldelta_Newbool_False deriving (Eq,Show) data Skip = Skip deriving (Eq,Show) data Edgemodedelta = Edgemodedelta { edgemodedeltaOldem :: Edgemodedelta_Oldem , edgemodedeltaNewem :: Edgemodedelta_Newem } deriving (Eq,Show) data Edgemodedelta_Oldem = Edgemodedelta_Oldem_Directed | Edgemodedelta_Oldem_Undirected | Edgemodedelta_Oldem_Defaultdirected | Edgemodedelta_Oldem_Defaultundirected deriving (Eq,Show) data Edgemodedelta_Newem = Edgemodedelta_Newem_Directed | Edgemodedelta_Newem_Undirected | Edgemodedelta_Newem_Defaultdirected | Edgemodedelta_Newem_Defaultundirected deriving (Eq,Show) data Nodedelta = Nodedelta (Maybe Typedelta) Attributedelta [Sequencematch] [Graphdelta] (Maybe Iddelta) deriving (Eq,Show) data Edgedelta = Edgedelta (Maybe Typedelta) Attributedelta [Sequencematch] [Graphdelta] (Maybe Iddelta) (OneOf2 Iddelta Skip) (Maybe Iddelta) (OneOf2 Orderingdelta Skip) (Maybe Orderingdelta) (Maybe Booldelta) deriving (Eq,Show) data Orderingdelta = Orderingdelta { orderingdeltaOldorder :: String , orderingdeltaNeworder :: String } deriving (Eq,Show) data Reldelta = Reldelta (Maybe Typedelta) Attributedelta [Sequencematch] (OneOf2 [Graphdelta] Skip) [Sequencematch] [Relenddelta] (Maybe Iddelta) (Maybe Booldelta) deriving (Eq,Show) data Relenddelta = Relenddelta Attributedelta (Maybe Iddelta) (Maybe Roledelta) (Maybe Directiondelta) (OneOf2 Orderingdelta Skip) (Maybe Orderingdelta) deriving (Eq,Show) data Directiondelta = Directiondelta { directiondeltaOlddirection :: (Maybe Directiondelta_Olddirection) , directiondeltaNewdirection :: (Maybe Directiondelta_Newdirection) } deriving (Eq,Show) data Directiondelta_Olddirection = Directiondelta_Olddirection_In | Directiondelta_Olddirection_Out | Directiondelta_Olddirection_None deriving (Eq,Show) data Directiondelta_Newdirection = Directiondelta_Newdirection_In | Directiondelta_Newdirection_Out | Directiondelta_Newdirection_None deriving (Eq,Show) newtype Attributedelta = Attributedelta [Attributedelta_] deriving (Eq,Show) data Attributedelta_ = Attributedelta_Reduce Reduce | Attributedelta_Change Change | Attributedelta_Extend Extend deriving (Eq,Show) data Reduce = Reduce Reduce_Attrs [Attrdelta] deriving (Eq,Show) data Reduce_Attrs = Reduce_Attrs { reduceNewname :: (Maybe String) } deriving (Eq,Show) data Extend = Extend Extend_Attrs [Attrdelta] deriving (Eq,Show) data Extend_Attrs = Extend_Attrs { extendOldname :: (Maybe String) } deriving (Eq,Show) data Attrdelta = Attrdelta Attrdelta_Attrs (Maybe Typedelta) (Maybe Attributedelta) (Maybe Iddelta) (Maybe Kinddelta) (Maybe Valuedelta) deriving (Eq,Show) data Attrdelta_Attrs = Attrdelta_Attrs { attrdeltaName :: String } deriving (Eq,Show) data Change = Change (Maybe Namedelta) (Maybe Typedelta) (Maybe Attributedelta) (Maybe Iddelta) (Maybe Kinddelta) (Maybe Valuedelta) deriving (Eq,Show) data Kinddelta = Kinddelta { kinddeltaOldkind :: (Maybe String) , kinddeltaNewkind :: (Maybe String) } deriving (Eq,Show) data Valuedelta = ValuedeltaNewvalue Newvalue | ValuedeltaLocdelta Locdelta | ValuedeltaBooldelta Booldelta | ValuedeltaIntdelta Intdelta | ValuedeltaFloatdelta Floatdelta | ValuedeltaStringdelta Stringdelta | ValuedeltaAltdelta Altdelta | ValuedeltaGraphdelta Graphdelta deriving (Eq,Show) data Newvalue = Newvalue Value Value deriving (Eq,Show) data Value = ValueLocdelta Locdelta | ValueBooldelta Booldelta | ValueIntdelta Intdelta | ValueFloatdelta Floatdelta | ValueStringdelta Stringdelta | ValueAltdelta Altdelta | ValueGraphdelta Graphdelta deriving (Eq,Show) data Locdelta = Locdelta (Maybe Typedelta) (Maybe Hrefdelta) deriving (Eq,Show) data Intdelta = Intdelta { intdeltaOldint :: String , intdeltaNewint :: String } deriving (Eq,Show) data Floatdelta = Floatdelta { floatdeltaOldfloat :: String , floatdeltaNewfloat :: String } deriving (Eq,Show) data Stringdelta = Stringdelta { stringdeltaOldstring :: String , stringdeltaNewstring :: String } deriving (Eq,Show) data Namedelta = Namedelta { namedeltaOldname :: String , namedeltaNewname :: String } deriving (Eq,Show) data Altdelta = Altdelta (Maybe Altchange) [Sequencematch] [(OneOf2 Valuedelta Accumdelta)] deriving (Eq,Show) data Altchange = Altchange { altchangeOldalt :: String , altchangeNewalt :: String } deriving (Eq,Show) data Accumdelta = Accumdelta Accumdelta_Attrs [Sequencematch] [Valuedelta] deriving (Eq,Show) data Accumdelta_Attrs = Accumdelta_Attrs { accumdeltaAccumkind :: (Defaultable Accumdelta_Accumkind) } deriving (Eq,Show) data Accumdelta_Accumkind = Accumdelta_Accumkind_Unch | Accumdelta_Accumkind_Seq2set | Accumdelta_Accumkind_Seq2bag | Accumdelta_Accumkind_Set2seq | Accumdelta_Accumkind_Set2bag | Accumdelta_Accumkind_Bag2seq | Accumdelta_Accumkind_Bag2set deriving (Eq,Show) {-Instance decls-} instance XmlContent Gdxl where fromElem (CElem (Elem "gdxl" as c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (Just (Gdxl (fromAttrs as) a b c), rest)) (fromElem cb)) (many fromElem ca)) (many fromElem c0) fromElem rest = (Nothing, rest) toElem (Gdxl as a b c) = [CElem (Elem "gdxl" (toAttrs as) (concatMap toElem a ++ concatMap toElem b ++ maybe [] toElem c))] instance XmlAttributes Gdxl_Attrs where fromAttrs as = Gdxl_Attrs { gdxlSourcedoc = possibleA fromAttrToStr "sourcedoc" as , gdxlTargetdoc = possibleA fromAttrToStr "targetdoc" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "sourcedoc" (gdxlSourcedoc v) , maybeToAttr toAttrFrStr "targetdoc" (gdxlTargetdoc v) ] instance XmlContent Typedelta where fromElem (CElem (Elem "typedelta" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (Just (Typedelta a b), rest)) (fromElem ca)) (fromElem c0) fromElem rest = (Nothing, rest) toElem (Typedelta a b) = [CElem (Elem "typedelta" [] (maybe [] toElem a ++ maybe [] toElem b))] instance XmlContent Xlinkdelta where fromElem (CElem (Elem "xlinkdelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "xlinkdelta" (toAttrs as) [])] instance XmlAttributes Xlinkdelta where fromAttrs as = Xlinkdelta { xlinkdeltaOldxlink = definiteA fromAttrToStr "xlinkdelta" "oldxlink" as , xlinkdeltaNewxlink = definiteA fromAttrToStr "xlinkdelta" "newxlink" as } toAttrs v = catMaybes [ toAttrFrStr "oldxlink" (xlinkdeltaOldxlink v) , toAttrFrStr "newxlink" (xlinkdeltaNewxlink v) ] instance XmlContent Hrefdelta where fromElem (CElem (Elem "hrefdelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "hrefdelta" (toAttrs as) [])] instance XmlAttributes Hrefdelta where fromAttrs as = Hrefdelta { hrefdeltaHrefmode = definiteA fromAttrToTyp "hrefdelta" "hrefmode" as , hrefdeltaNewlink = definiteA fromAttrToStr "hrefdelta" "newlink" as , hrefdeltaOldlink = definiteA fromAttrToStr "hrefdelta" "oldlink" as } toAttrs v = catMaybes [ toAttrFrTyp "hrefmode" (hrefdeltaHrefmode v) , toAttrFrStr "newlink" (hrefdeltaNewlink v) , toAttrFrStr "oldlink" (hrefdeltaOldlink v) ] instance XmlAttrType Hrefdelta_Hrefmode where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "absolute" = Just Hrefdelta_Hrefmode_Absolute translate "local" = Just Hrefdelta_Hrefmode_Local translate "relative" = Just Hrefdelta_Hrefmode_Relative translate _ = Nothing toAttrFrTyp n Hrefdelta_Hrefmode_Absolute = Just (n, str2attr "absolute") toAttrFrTyp n Hrefdelta_Hrefmode_Local = Just (n, str2attr "local") toAttrFrTyp n Hrefdelta_Hrefmode_Relative = Just (n, str2attr "relative") instance XmlContent Sequencematch where fromElem (CElem (Elem "sequencematch" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "sequencematch" (toAttrs as) [])] instance XmlAttributes Sequencematch where fromAttrs as = Sequencematch { sequencematchLength = defaultA fromAttrToStr "1" "length" as , sequencematchOldstart = definiteA fromAttrToStr "sequencematch" "oldstart" as , sequencematchNewstart = definiteA fromAttrToStr "sequencematch" "newstart" as } toAttrs v = catMaybes [ defaultToAttr toAttrFrStr "length" (sequencematchLength v) , toAttrFrStr "oldstart" (sequencematchOldstart v) , toAttrFrStr "newstart" (sequencematchNewstart v) ] instance XmlContent Graphdelta where fromElem (CElem (Elem "graphdelta" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (\(d,cd)-> (\(e,ce)-> (\(f,cf)-> (\(g,cg)-> (\(h,ch)-> (\(i,ci)-> (\(j,cj)-> (Just (Graphdelta a b c d e f g h i j), rest)) (fromElem ci)) (fromElem ch)) (fromElem cg)) (fromElem cf)) (fromElem ce)) (many fromElem cd)) (many fromElem cc)) (many fromElem cb)) (definite fromElem "" "graphdelta" ca)) (fromElem c0) fromElem rest = (Nothing, rest) toElem (Graphdelta a b c d e f g h i j) = [CElem (Elem "graphdelta" [] (maybe [] toElem a ++ toElem b ++ concatMap toElem c ++ concatMap toElem d ++ concatMap toElem e ++ maybe [] toElem f ++ maybe [] toElem g ++ toElem h ++ maybe [] toElem i ++ maybe [] toElem j))] instance XmlContent Iddelta where fromElem (CElem (Elem "iddelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "iddelta" (toAttrs as) [])] instance XmlAttributes Iddelta where fromAttrs as = Iddelta { iddeltaOldid = definiteA fromAttrToStr "iddelta" "oldid" as , iddeltaNewid = definiteA fromAttrToStr "iddelta" "newid" as } toAttrs v = catMaybes [ toAttrFrStr "oldid" (iddeltaOldid v) , toAttrFrStr "newid" (iddeltaNewid v) ] instance XmlContent Roledelta where fromElem (CElem (Elem "roledelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "roledelta" (toAttrs as) [])] instance XmlAttributes Roledelta where fromAttrs as = Roledelta { roledeltaOldrole = definiteA fromAttrToStr "roledelta" "oldrole" as , roledeltaNewrole = definiteA fromAttrToStr "roledelta" "newrole" as } toAttrs v = catMaybes [ toAttrFrStr "oldrole" (roledeltaOldrole v) , toAttrFrStr "newrole" (roledeltaNewrole v) ] instance XmlContent Booldelta where fromElem (CElem (Elem "booldelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "booldelta" (toAttrs as) [])] instance XmlAttributes Booldelta where fromAttrs as = Booldelta { booldeltaOldbool = definiteA fromAttrToTyp "booldelta" "oldbool" as , booldeltaNewbool = definiteA fromAttrToTyp "booldelta" "newbool" as } toAttrs v = catMaybes [ toAttrFrTyp "oldbool" (booldeltaOldbool v) , toAttrFrTyp "newbool" (booldeltaNewbool v) ] instance XmlAttrType Booldelta_Oldbool where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "true" = Just Booldelta_Oldbool_True translate "false" = Just Booldelta_Oldbool_False translate _ = Nothing toAttrFrTyp n Booldelta_Oldbool_True = Just (n, str2attr "true") toAttrFrTyp n Booldelta_Oldbool_False = Just (n, str2attr "false") instance XmlAttrType Booldelta_Newbool where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "true" = Just Booldelta_Newbool_True translate "false" = Just Booldelta_Newbool_False translate _ = Nothing toAttrFrTyp n Booldelta_Newbool_True = Just (n, str2attr "true") toAttrFrTyp n Booldelta_Newbool_False = Just (n, str2attr "false") instance XmlContent Skip where fromElem (CElem (Elem "skip" [] []):rest) = (Just Skip, rest) fromElem rest = (Nothing, rest) toElem Skip = [CElem (Elem "skip" [] [])] instance XmlContent Edgemodedelta where fromElem (CElem (Elem "edgemodedelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "edgemodedelta" (toAttrs as) [])] instance XmlAttributes Edgemodedelta where fromAttrs as = Edgemodedelta { edgemodedeltaOldem = definiteA fromAttrToTyp "edgemodedelta" "oldem" as , edgemodedeltaNewem = definiteA fromAttrToTyp "edgemodedelta" "newem" as } toAttrs v = catMaybes [ toAttrFrTyp "oldem" (edgemodedeltaOldem v) , toAttrFrTyp "newem" (edgemodedeltaNewem v) ] instance XmlAttrType Edgemodedelta_Oldem where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "directed" = Just Edgemodedelta_Oldem_Directed translate "undirected" = Just Edgemodedelta_Oldem_Undirected translate "defaultdirected" = Just Edgemodedelta_Oldem_Defaultdirected translate "defaultundirected" = Just Edgemodedelta_Oldem_Defaultundirected translate _ = Nothing toAttrFrTyp n Edgemodedelta_Oldem_Directed = Just (n, str2attr "directed") toAttrFrTyp n Edgemodedelta_Oldem_Undirected = Just (n, str2attr "undirected") toAttrFrTyp n Edgemodedelta_Oldem_Defaultdirected = Just (n, str2attr "defaultdirected") toAttrFrTyp n Edgemodedelta_Oldem_Defaultundirected = Just (n, str2attr "defaultundirected") instance XmlAttrType Edgemodedelta_Newem where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "directed" = Just Edgemodedelta_Newem_Directed translate "undirected" = Just Edgemodedelta_Newem_Undirected translate "defaultdirected" = Just Edgemodedelta_Newem_Defaultdirected translate "defaultundirected" = Just Edgemodedelta_Newem_Defaultundirected translate _ = Nothing toAttrFrTyp n Edgemodedelta_Newem_Directed = Just (n, str2attr "directed") toAttrFrTyp n Edgemodedelta_Newem_Undirected = Just (n, str2attr "undirected") toAttrFrTyp n Edgemodedelta_Newem_Defaultdirected = Just (n, str2attr "defaultdirected") toAttrFrTyp n Edgemodedelta_Newem_Defaultundirected = Just (n, str2attr "defaultundirected") instance XmlContent Nodedelta where fromElem (CElem (Elem "nodedelta" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (\(d,cd)-> (\(e,ce)-> (Just (Nodedelta a b c d e), rest)) (fromElem cd)) (many fromElem cc)) (many fromElem cb)) (definite fromElem "" "nodedelta" ca)) (fromElem c0) fromElem rest = (Nothing, rest) toElem (Nodedelta a b c d e) = [CElem (Elem "nodedelta" [] (maybe [] toElem a ++ toElem b ++ concatMap toElem c ++ concatMap toElem d ++ maybe [] toElem e))] instance XmlContent Edgedelta where fromElem (CElem (Elem "edgedelta" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (\(d,cd)-> (\(e,ce)-> (\(f,cf)-> (\(g,cg)-> (\(h,ch)-> (\(i,ci)-> (\(j,cj)-> (Just (Edgedelta a b c d e f g h i j), rest)) (fromElem ci)) (fromElem ch)) (fromElem cg)) (fromElem cf)) (fromElem ce)) (fromElem cd)) (many fromElem cc)) (many fromElem cb)) (definite fromElem "" "edgedelta" ca)) (fromElem c0) fromElem rest = (Nothing, rest) toElem (Edgedelta a b c d e f g h i j) = [CElem (Elem "edgedelta" [] (maybe [] toElem a ++ toElem b ++ concatMap toElem c ++ concatMap toElem d ++ maybe [] toElem e ++ toElem f ++ maybe [] toElem g ++ toElem h ++ maybe [] toElem i ++ maybe [] toElem j))] instance XmlContent Orderingdelta where fromElem (CElem (Elem "orderingdelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "orderingdelta" (toAttrs as) [])] instance XmlAttributes Orderingdelta where fromAttrs as = Orderingdelta { orderingdeltaOldorder = definiteA fromAttrToStr "orderingdelta" "oldorder" as , orderingdeltaNeworder = definiteA fromAttrToStr "orderingdelta" "neworder" as } toAttrs v = catMaybes [ toAttrFrStr "oldorder" (orderingdeltaOldorder v) , toAttrFrStr "neworder" (orderingdeltaNeworder v) ] instance XmlContent Reldelta where fromElem (CElem (Elem "reldelta" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (\(d,cd)-> (\(e,ce)-> (\(f,cf)-> (\(g,cg)-> (\(h,ch)-> (Just (Reldelta a b c d e f g h), rest)) (fromElem cg)) (fromElem cf)) (many fromElem ce)) (many fromElem cd)) (fromElem cc)) (many fromElem cb)) (definite fromElem "" "reldelta" ca)) (fromElem c0) fromElem rest = (Nothing, rest) toElem (Reldelta a b c d e f g h) = [CElem (Elem "reldelta" [] (maybe [] toElem a ++ toElem b ++ concatMap toElem c ++ toElem d ++ concatMap toElem e ++ concatMap toElem f ++ maybe [] toElem g ++ maybe [] toElem h))] instance XmlContent Relenddelta where fromElem (CElem (Elem "relenddelta" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (\(d,cd)-> (\(e,ce)-> (\(f,cf)-> (Just (Relenddelta a b c d e f), rest)) (fromElem ce)) (fromElem cd)) (fromElem cc)) (fromElem cb)) (fromElem ca)) (definite fromElem "" "relenddelta" c0) fromElem rest = (Nothing, rest) toElem (Relenddelta a b c d e f) = [CElem (Elem "relenddelta" [] (toElem a ++ maybe [] toElem b ++ maybe [] toElem c ++ maybe [] toElem d ++ toElem e ++ maybe [] toElem f))] instance XmlContent Directiondelta where fromElem (CElem (Elem "directiondelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "directiondelta" (toAttrs as) [])] instance XmlAttributes Directiondelta where fromAttrs as = Directiondelta { directiondeltaOlddirection = possibleA fromAttrToTyp "olddirection" as , directiondeltaNewdirection = possibleA fromAttrToTyp "newdirection" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrTyp "olddirection" (directiondeltaOlddirection v) , maybeToAttr toAttrFrTyp "newdirection" (directiondeltaNewdirection v) ] instance XmlAttrType Directiondelta_Olddirection where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "in" = Just Directiondelta_Olddirection_In translate "out" = Just Directiondelta_Olddirection_Out translate "none" = Just Directiondelta_Olddirection_None translate _ = Nothing toAttrFrTyp n Directiondelta_Olddirection_In = Just (n, str2attr "in") toAttrFrTyp n Directiondelta_Olddirection_Out = Just (n, str2attr "out") toAttrFrTyp n Directiondelta_Olddirection_None = Just (n, str2attr "none") instance XmlAttrType Directiondelta_Newdirection where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "in" = Just Directiondelta_Newdirection_In translate "out" = Just Directiondelta_Newdirection_Out translate "none" = Just Directiondelta_Newdirection_None translate _ = Nothing toAttrFrTyp n Directiondelta_Newdirection_In = Just (n, str2attr "in") toAttrFrTyp n Directiondelta_Newdirection_Out = Just (n, str2attr "out") toAttrFrTyp n Directiondelta_Newdirection_None = Just (n, str2attr "none") instance XmlContent Attributedelta where fromElem (CElem (Elem "attributedelta" [] c0):rest) = (\(a,ca)-> (Just (Attributedelta a), rest)) (many fromElem c0) fromElem rest = (Nothing, rest) toElem (Attributedelta a) = [CElem (Elem "attributedelta" [] (concatMap toElem a))] instance XmlContent Attributedelta_ where fromElem c0 = case (fromElem c0) of (Just a,rest) -> (Just (Attributedelta_Reduce a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,rest) -> (Just (Attributedelta_Change a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,rest) -> (Just (Attributedelta_Extend a), rest) (Nothing,_) -> (Nothing, c0) fromElem rest = (Nothing, rest) toElem (Attributedelta_Reduce a) = toElem a toElem (Attributedelta_Change a) = toElem a toElem (Attributedelta_Extend a) = toElem a instance XmlContent Reduce where fromElem (CElem (Elem "reduce" as c0):rest) = (\(a,ca)-> (Just (Reduce (fromAttrs as) a), rest)) (many fromElem c0) fromElem rest = (Nothing, rest) toElem (Reduce as a) = [CElem (Elem "reduce" (toAttrs as) (concatMap toElem a))] instance XmlAttributes Reduce_Attrs where fromAttrs as = Reduce_Attrs { reduceNewname = possibleA fromAttrToStr "newname" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "newname" (reduceNewname v) ] instance XmlContent Extend where fromElem (CElem (Elem "extend" as c0):rest) = (\(a,ca)-> (Just (Extend (fromAttrs as) a), rest)) (many fromElem c0) fromElem rest = (Nothing, rest) toElem (Extend as a) = [CElem (Elem "extend" (toAttrs as) (concatMap toElem a))] instance XmlAttributes Extend_Attrs where fromAttrs as = Extend_Attrs { extendOldname = possibleA fromAttrToStr "oldname" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "oldname" (extendOldname v) ] instance XmlContent Attrdelta where fromElem (CElem (Elem "attrdelta" as c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (\(d,cd)-> (\(e,ce)-> (Just (Attrdelta (fromAttrs as) a b c d e), rest)) (fromElem cd)) (fromElem cc)) (fromElem cb)) (fromElem ca)) (fromElem c0) fromElem rest = (Nothing, rest) toElem (Attrdelta as a b c d e) = [CElem (Elem "attrdelta" (toAttrs as) (maybe [] toElem a ++ maybe [] toElem b ++ maybe [] toElem c ++ maybe [] toElem d ++ maybe [] toElem e))] instance XmlAttributes Attrdelta_Attrs where fromAttrs as = Attrdelta_Attrs { attrdeltaName = definiteA fromAttrToStr "attrdelta" "name" as } toAttrs v = catMaybes [ toAttrFrStr "name" (attrdeltaName v) ] instance XmlContent Change where fromElem (CElem (Elem "change" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (\(d,cd)-> (\(e,ce)-> (\(f,cf)-> (Just (Change a b c d e f), rest)) (fromElem ce)) (fromElem cd)) (fromElem cc)) (fromElem cb)) (fromElem ca)) (fromElem c0) fromElem rest = (Nothing, rest) toElem (Change a b c d e f) = [CElem (Elem "change" [] (maybe [] toElem a ++ maybe [] toElem b ++ maybe [] toElem c ++ maybe [] toElem d ++ maybe [] toElem e ++ maybe [] toElem f))] instance XmlContent Kinddelta where fromElem (CElem (Elem "kinddelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "kinddelta" (toAttrs as) [])] instance XmlAttributes Kinddelta where fromAttrs as = Kinddelta { kinddeltaOldkind = possibleA fromAttrToStr "oldkind" as , kinddeltaNewkind = possibleA fromAttrToStr "newkind" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "oldkind" (kinddeltaOldkind v) , maybeToAttr toAttrFrStr "newkind" (kinddeltaNewkind v) ] instance XmlContent Valuedelta where fromElem (CElem (Elem "valuedelta" [] c0):rest) = case (fromElem c0) of (Just a,_) -> (Just (ValuedeltaNewvalue a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValuedeltaLocdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValuedeltaBooldelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValuedeltaIntdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValuedeltaFloatdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValuedeltaStringdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValuedeltaAltdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValuedeltaGraphdelta a), rest) (Nothing,_) -> (Nothing, c0) fromElem rest = (Nothing, rest) toElem (ValuedeltaNewvalue a) = [CElem (Elem "valuedelta" [] (toElem a) )] toElem (ValuedeltaLocdelta a) = [CElem (Elem "valuedelta" [] (toElem a) )] toElem (ValuedeltaBooldelta a) = [CElem (Elem "valuedelta" [] (toElem a) )] toElem (ValuedeltaIntdelta a) = [CElem (Elem "valuedelta" [] (toElem a) )] toElem (ValuedeltaFloatdelta a) = [CElem (Elem "valuedelta" [] (toElem a) )] toElem (ValuedeltaStringdelta a) = [CElem (Elem "valuedelta" [] (toElem a) )] toElem (ValuedeltaAltdelta a) = [CElem (Elem "valuedelta" [] (toElem a) )] toElem (ValuedeltaGraphdelta a) = [CElem (Elem "valuedelta" [] (toElem a) )] instance XmlContent Newvalue where fromElem (CElem (Elem "newvalue" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (Just (Newvalue a b), rest)) (definite fromElem "" "newvalue" ca)) (definite fromElem "" "newvalue" c0) fromElem rest = (Nothing, rest) toElem (Newvalue a b) = [CElem (Elem "newvalue" [] (toElem a ++ toElem b))] instance XmlContent Value where fromElem (CElem (Elem "value" [] c0):rest) = case (fromElem c0) of (Just a,_) -> (Just (ValueLocdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValueBooldelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValueIntdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValueFloatdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValueStringdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValueAltdelta a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,_) -> (Just (ValueGraphdelta a), rest) (Nothing,_) -> (Nothing, c0) fromElem rest = (Nothing, rest) toElem (ValueLocdelta a) = [CElem (Elem "value" [] (toElem a) )] toElem (ValueBooldelta a) = [CElem (Elem "value" [] (toElem a) )] toElem (ValueIntdelta a) = [CElem (Elem "value" [] (toElem a) )] toElem (ValueFloatdelta a) = [CElem (Elem "value" [] (toElem a) )] toElem (ValueStringdelta a) = [CElem (Elem "value" [] (toElem a) )] toElem (ValueAltdelta a) = [CElem (Elem "value" [] (toElem a) )] toElem (ValueGraphdelta a) = [CElem (Elem "value" [] (toElem a) )] instance XmlContent Locdelta where fromElem (CElem (Elem "locdelta" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (Just (Locdelta a b), rest)) (fromElem ca)) (fromElem c0) fromElem rest = (Nothing, rest) toElem (Locdelta a b) = [CElem (Elem "locdelta" [] (maybe [] toElem a ++ maybe [] toElem b))] instance XmlContent Intdelta where fromElem (CElem (Elem "intdelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "intdelta" (toAttrs as) [])] instance XmlAttributes Intdelta where fromAttrs as = Intdelta { intdeltaOldint = definiteA fromAttrToStr "intdelta" "oldint" as , intdeltaNewint = definiteA fromAttrToStr "intdelta" "newint" as } toAttrs v = catMaybes [ toAttrFrStr "oldint" (intdeltaOldint v) , toAttrFrStr "newint" (intdeltaNewint v) ] instance XmlContent Floatdelta where fromElem (CElem (Elem "floatdelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "floatdelta" (toAttrs as) [])] instance XmlAttributes Floatdelta where fromAttrs as = Floatdelta { floatdeltaOldfloat = definiteA fromAttrToStr "floatdelta" "oldfloat" as , floatdeltaNewfloat = definiteA fromAttrToStr "floatdelta" "newfloat" as } toAttrs v = catMaybes [ toAttrFrStr "oldfloat" (floatdeltaOldfloat v) , toAttrFrStr "newfloat" (floatdeltaNewfloat v) ] instance XmlContent Stringdelta where fromElem (CElem (Elem "stringdelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "stringdelta" (toAttrs as) [])] instance XmlAttributes Stringdelta where fromAttrs as = Stringdelta { stringdeltaOldstring = definiteA fromAttrToStr "stringdelta" "oldstring" as , stringdeltaNewstring = definiteA fromAttrToStr "stringdelta" "newstring" as } toAttrs v = catMaybes [ toAttrFrStr "oldstring" (stringdeltaOldstring v) , toAttrFrStr "newstring" (stringdeltaNewstring v) ] instance XmlContent Namedelta where fromElem (CElem (Elem "namedelta" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "namedelta" (toAttrs as) [])] instance XmlAttributes Namedelta where fromAttrs as = Namedelta { namedeltaOldname = definiteA fromAttrToStr "namedelta" "oldname" as , namedeltaNewname = definiteA fromAttrToStr "namedelta" "newname" as } toAttrs v = catMaybes [ toAttrFrStr "oldname" (namedeltaOldname v) , toAttrFrStr "newname" (namedeltaNewname v) ] instance XmlContent Altdelta where fromElem (CElem (Elem "altdelta" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (Just (Altdelta a b c), rest)) (many fromElem cb)) (many fromElem ca)) (fromElem c0) fromElem rest = (Nothing, rest) toElem (Altdelta a b c) = [CElem (Elem "altdelta" [] (maybe [] toElem a ++ concatMap toElem b ++ concatMap toElem c))] instance XmlContent Altchange where fromElem (CElem (Elem "altchange" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "altchange" (toAttrs as) [])] instance XmlAttributes Altchange where fromAttrs as = Altchange { altchangeOldalt = definiteA fromAttrToStr "altchange" "oldalt" as , altchangeNewalt = definiteA fromAttrToStr "altchange" "newalt" as } toAttrs v = catMaybes [ toAttrFrStr "oldalt" (altchangeOldalt v) , toAttrFrStr "newalt" (altchangeNewalt v) ] instance XmlContent Accumdelta where fromElem (CElem (Elem "accumdelta" as c0):rest) = (\(a,ca)-> (\(b,cb)-> (Just (Accumdelta (fromAttrs as) a b), rest)) (many fromElem ca)) (many fromElem c0) fromElem rest = (Nothing, rest) toElem (Accumdelta as a b) = [CElem (Elem "accumdelta" (toAttrs as) (concatMap toElem a ++ concatMap toElem b))] instance XmlAttributes Accumdelta_Attrs where fromAttrs as = Accumdelta_Attrs { accumdeltaAccumkind = defaultA fromAttrToTyp Accumdelta_Accumkind_Unch "accumkind" as } toAttrs v = catMaybes [ defaultToAttr toAttrFrTyp "accumkind" (accumdeltaAccumkind v) ] instance XmlAttrType Accumdelta_Accumkind where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "unch" = Just Accumdelta_Accumkind_Unch translate "seq2set" = Just Accumdelta_Accumkind_Seq2set translate "seq2bag" = Just Accumdelta_Accumkind_Seq2bag translate "set2seq" = Just Accumdelta_Accumkind_Set2seq translate "set2bag" = Just Accumdelta_Accumkind_Set2bag translate "bag2seq" = Just Accumdelta_Accumkind_Bag2seq translate "bag2set" = Just Accumdelta_Accumkind_Bag2set translate _ = Nothing toAttrFrTyp n Accumdelta_Accumkind_Unch = Just (n, str2attr "unch") toAttrFrTyp n Accumdelta_Accumkind_Seq2set = Just (n, str2attr "seq2set") toAttrFrTyp n Accumdelta_Accumkind_Seq2bag = Just (n, str2attr "seq2bag") toAttrFrTyp n Accumdelta_Accumkind_Set2seq = Just (n, str2attr "set2seq") toAttrFrTyp n Accumdelta_Accumkind_Set2bag = Just (n, str2attr "set2bag") toAttrFrTyp n Accumdelta_Accumkind_Bag2seq = Just (n, str2attr "bag2seq") toAttrFrTyp n Accumdelta_Accumkind_Bag2set = Just (n, str2attr "bag2set") {-Done-} hugs98-plus-Sep2006/packages/HaXml/bugs/DTD_norback.hs0000644006511100651110000000231110504340456021156 0ustar rossrossmodule DTD_norback where import Xml2Haskell {-Type decls-} newtype Test = Test [Test_] deriving (Eq,Show) data Test_ = Test_One One | Test_Two Two deriving (Eq,Show) data One = One deriving (Eq,Show) data Two = Two deriving (Eq,Show) {-Instance decls-} instance XmlContent Test where fromElem (CElem (Elem "test" [] c0):rest) = (\(a,ca)-> (Just (Test a), rest)) (many fromElem c0) fromElem rest = (Nothing, rest) toElem (Test a) = [CElem (Elem "test" [] (concatMap toElem a))] instance XmlContent Test_ where fromElem c0 = case (fromElem c0) of (Just a,rest) -> (Just (Test_One a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,rest) -> (Just (Test_Two a), rest) (Nothing,_) -> (Nothing, c0) fromElem rest = (Nothing, rest) toElem (Test_One a) = toElem a toElem (Test_Two a) = toElem a instance XmlContent One where fromElem (CElem (Elem "one" [] []):rest) = (Just One, rest) fromElem rest = (Nothing, rest) toElem One = [CElem (Elem "one" [] [])] instance XmlContent Two where fromElem (CElem (Elem "two" [] []):rest) = (Just Two, rest) fromElem rest = (Nothing, rest) toElem Two = [CElem (Elem "two" [] [])] {-Done-} hugs98-plus-Sep2006/packages/HaXml/bugs/DTypes.hs0000644006511100651110000000126210504340456020260 0ustar rossrossmodule DTypes where import Haskell2Xml hiding (Name) -- data types for a simple test program data Person = Person Name Email [Rating] Version {-! derive :Haskell2Xml !-} newtype Name = Name String {-! derive :Haskell2Xml !-} newtype Email = Email String {-! derive :Haskell2Xml !-} newtype Version = Version Int {-! derive :Haskell2Xml !-} data Rating = Rating SubjectID Interest Skill {-! derive :Haskell2Xml !-} newtype SubjectID = SubjectID Int {-! derive :Haskell2Xml !-} newtype Interest = Interest Score {-! derive :Haskell2Xml !-} newtype Skill = Skill Score {-! derive :Haskell2Xml !-} data Score = ScoreNone | ScoreLow | ScoreMedium | ScoreHigh {-! derive :Haskell2Xml !-} hugs98-plus-Sep2006/packages/HaXml/bugs/Geisler.dtd0000644006511100651110000000010210504340456020573 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/bugs/Geisler.xml0000644006511100651110000000023610504340456020630 0ustar rossross First Bar Second Bar & some entity reference Third Bar after the comment hugs98-plus-Sep2006/packages/HaXml/bugs/helsen-patch.txt0000644006511100651110000000160210504340456021626 0ustar rossross285,288c285,298 < -- complete the parse straightaway. < ( do (tok TokAnyClose +++ tok TokEndClose) < trace (e++"[+]") (return ()) < return ([], Elem e avs [])) --- > -- complete the parse straightaway. > (( do tok TokEndClose > trace (e++"[+]") (return ()) > return ([], Elem e avs [])) +++ > ( do tok TokAnyClose > trace (e++"[+") (return ()) > n <- bracket (tok TokEndOpen) name (tok TokAnyClose) > trace "]" (return ()) > if e == (map toUpper n :: Name) > then return ([], Elem e avs []) > else return (error "no nesting in empty tag")) +++ > do tok TokAnyClose > trace (e++"[+]") (return ()) > return ([], Elem e avs [])) hugs98-plus-Sep2006/packages/HaXml/bugs/GeislerTest.hs0000644006511100651110000000035410504340456021303 0ustar rossrossmodule Main where import Xml2Haskell import Geisler -- generated with DtdToHaskell from Geisler.dtd readFoo :: IO Foo readFoo = readXml "-" writeFoo :: Foo -> IO () writeFoo = writeXml "-" main = do foo <- readFoo writeFoo foo hugs98-plus-Sep2006/packages/HaXml/bugs/GxlDtd.hs0000644006511100651110000000001310504340456020227 0ustar rossrossmodule DTD_hugs98-plus-Sep2006/packages/HaXml/bugs/baars-bug.xml0000644006511100651110000000236210504340456021103 0ustar rossross ]> cowanimal farmerhuman hugs98-plus-Sep2006/packages/HaXml/bugs/XMLSchemaCustomized.dtd0000644006511100651110000004451410504340456023050 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/XMLSchemaCustomized.xml0000644006511100651110000004456110504340456023077 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/bugs/date.xml0000644006511100651110000000005110504340456020146 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/dominic.dtd0000644006511100651110000000032210504340456020627 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/bugs/either.hs0000644006511100651110000000010310504340456020321 0ustar rossrossdata Either a b = Left a | Right b {-! derive: Haskell2Xml !-} hugs98-plus-Sep2006/packages/HaXml/bugs/erik.dtd0000644006511100651110000000032410504340456020141 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/bugs/erik.hs0000644006511100651110000000420710504340456020004 0ustar rossrossmodule DTD_erik where import Xml2Haskell {-Type decls-} data Kenmerk = Kenmerk Kenmerk_Attrs [Kenmerk_] deriving (Eq,Show) data Kenmerk_Attrs = Kenmerk_Attrs { kenmerkKmc :: String , kenmerkGewicht :: (Defaultable String) } deriving (Eq,Show) data Kenmerk_ = Kenmerk_Str String | Kenmerk_Begin Begin | Kenmerk_Eind Eind deriving (Eq,Show) newtype Begin = Begin [String] deriving (Eq,Show) newtype Eind = Eind String deriving (Eq,Show) {-Instance decls-} instance XmlContent Kenmerk where fromElem (CElem (Elem "kenmerk" as c0):rest) = (\(a,ca)-> (Just (Kenmerk (fromAttrs as) a), rest)) (many fromElem c0) fromElem rest = (Nothing, rest) toElem (Kenmerk as a) = [CElem (Elem "kenmerk" (toAttrs as) (concatMap toElem a))] instance XmlAttributes Kenmerk_Attrs where fromAttrs as = Kenmerk_Attrs { kenmerkKmc = definiteA fromAttrToStr "kenmerk" "kmc" as , kenmerkGewicht = defaultA fromAttrToStr "1" "gewicht" as } toAttrs v = catMaybes [ toAttrFrStr "kmc" (kenmerkKmc v) , defaultToAttr toAttrFrStr "gewicht" (kenmerkGewicht v) ] instance XmlContent Kenmerk_ where fromElem c0 = case (fromText c0) of (Just a,rest) -> (Just (Kenmerk_Str a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,rest) -> (Just (Kenmerk_Begin a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,rest) -> (Just (Kenmerk_Eind a), rest) (Nothing,_) -> (Nothing, c0) toElem (Kenmerk_Str a) = [CElem (Elem "kenmerk" [] (toText a) )] toElem (Kenmerk_Begin a) = [CElem (Elem "kenmerk" [] (toElem a) )] toElem (Kenmerk_Eind a) = [CElem (Elem "kenmerk" [] (toElem a) )] instance XmlContent Begin where fromElem (CElem (Elem "begin" [] c0):rest) = (\(a,ca)-> (Just (Begin a), rest)) (many fromText c0) fromElem rest = (Nothing, rest) toElem (Begin a) = [CElem (Elem "begin" [] (concatMap toText a))] instance XmlContent Eind where fromElem (CElem (Elem "eind" [] c0):rest) = (\(a,ca)-> (Just (Eind a), rest)) (definite fromText "text" "eind" c0) fromElem rest = (Nothing, rest) toElem (Eind a) = [CElem (Elem "eind" [] (toText a))] {-Done-} hugs98-plus-Sep2006/packages/HaXml/bugs/file.xml0000644006511100651110000000015310504340456020153 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/gdxl.dtd0000644006511100651110000001037310504340456020152 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/genes.xml0000644006511100651110000000171110504340456020336 0ustar rossross one one mips orf two two mips orf three three mips orf one one ypd orf two two ypd orf four four ypd orf hugs98-plus-Sep2006/packages/HaXml/bugs/gxl-1.0.dtd0000644006511100651110000001001010504340456020266 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/panitz/0000755006511100651110000000000010504340456020020 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/bugs/panitz/XmlChar.lhs0000644006511100651110000002705610504340456022100 0ustar rossross
This module provides some tests on unicode characters. The productions are taken from the XQuery working draft od december 2001. These functions can as well be used for a XML lexer. module XmlChar where > import Char ]]> isNmstart c = c==' ' || isLetter c ]]> isNmchar c > = isDigit c || c=='.' || c=='-' || c=='_' || isLetter c || isCombiningChar c || isExtender c ]]> isLetter c = isBaseChar c || isIdeographic c ]]> isBaseChar c > = 0x0041<=n && (n<=0x005A > || 0x0061<=n && (n<=0x007A > || 0x00C0<=n && (n<=0x00D6 > || 0x00D8<=n && (n<=0x00F6 > || 0x00F8<=n && (n<=0x00FF > || 0x0100<=n && (n<=0x0131 > || 0x0134<=n && (n<=0x013E > || 0x0141<=n && (n<=0x0148 > || 0x014A<=n && (n<=0x017E > || 0x0180<=n && (n<=0x01C3 > || 0x01CD<=n && (n<=0x01F0 > || 0x01F4<=n && (n<=0x01F5 > || 0x01FA<=n && (n<=0x0217 > || 0x0250<=n && (n<=0x02A8 > || 0x02BB<=n && (n<=0x02C1 > || 0x0386==n > || 0x0388<=n && (n<=0x038A > || 0x038C==n > || 0x038E<=n && (n<=0x03A1 > || 0x03A3<=n && (n<=0x03CE > || 0x03D0<=n && (n<=0x03D6 > || 0x03DA==n > || 0x03DC==n > || 0x03DE==n > || 0x03E0==n > || 0x03E2<=n && (n<=0x03F3 > || 0x0401<=n && (n<=0x040C > || 0x040E<=n && (n<=0x044F > || 0x0451<=n && (n<=0x045C > || 0x045E<=n && (n<=0x0481 > || 0x0490<=n && (n<=0x04C4 > || 0x04C7<=n && (n<=0x04C8 > || 0x04CB<=n && (n<=0x04CC > || 0x04D0<=n && (n<=0x04EB > || 0x04EE<=n && (n<=0x04F5 > || 0x04F8<=n && (n<=0x04F9 > || 0x0531<=n && (n<=0x0556 > || 0x0559==n > || 0x0561<=n && (n<=0x0586 > || 0x05D0<=n && (n<=0x05EA > || 0x05F0<=n && (n<=0x05F2 > || 0x0621<=n && (n<=0x063A > || 0x0641<=n && (n<=0x064A > || 0x0671<=n && (n<=0x06B7 > || 0x06BA<=n && (n<=0x06BE > || 0x06C0<=n && (n<=0x06CE > || 0x06D0<=n && (n<=0x06D3 > || 0x06D5==n > || 0x06E5<=n && (n<=0x06E6 > || 0x0905<=n && (n<=0x0939 > || 0x093D==n > || 0x0958<=n && (n<=0x0961 > || 0x0985<=n && (n<=0x098C > || 0x098F<=n && (n<=0x0990 > || 0x0993<=n && (n<=0x09A8 > || 0x09AA<=n && (n<=0x09B0 > || 0x09B2==n > || 0x09B6<=n && (n<=0x09B9 > || 0x09DC<=n && (n<=0x09DD > || 0x09DF<=n && (n<=0x09E1 > || 0x09F0<=n && (n<=0x09F1 > || 0x0A05<=n && (n<=0x0A0A > || 0x0A0F<=n && (n<=0x0A10 > || 0x0A13<=n && (n<=0x0A28 > || 0x0A2A<=n && (n<=0x0A30 > || 0x0A32<=n && (n<=0x0A33 > || 0x0A35<=n && (n<=0x0A36 > || 0x0A38<=n && (n<=0x0A39 > || 0x0A59<=n && (n<=0x0A5C > || 0x0A5E==n > || 0x0A72<=n && (n<=0x0A74 > || 0x0A85<=n && (n<=0x0A8B > || 0x0A8D==n > || 0x0A8F<=n && (n<=0x0A91 > || 0x0A93<=n && (n<=0x0AA8 > || 0x0AAA<=n && (n<=0x0AB0 > || 0x0AB2<=n && (n<=0x0AB3 > || 0x0AB5<=n && (n<=0x0AB9 > || 0x0ABD==n > || 0x0AE0==n > || 0x0B05<=n && (n<=0x0B0C > || 0x0B0F<=n && (n<=0x0B10 > || 0x0B13<=n && (n<=0x0B28 > || 0x0B2A<=n && (n<=0x0B30 > || 0x0B32<=n && (n<=0x0B33 > || 0x0B36<=n && (n<=0x0B39 > || 0x0B3D==n > || 0x0B5C<=n && (n<=0x0B5D > || 0x0B5F<=n && (n<=0x0B61 > || 0x0B85<=n && (n<=0x0B8A > || 0x0B8E<=n && (n<=0x0B90 > || 0x0B92<=n && (n<=0x0B95 > || 0x0B99<=n && (n<=0x0B9A > || 0x0B9C==n > || 0x0B9E<=n && (n<=0x0B9F > || 0x0BA3<=n && (n<=0x0BA4 > || 0x0BA8<=n && (n<=0x0BAA > || 0x0BAE<=n && (n<=0x0BB5 > || 0x0BB7<=n && (n<=0x0BB9 > || 0x0C05<=n && (n<=0x0C0C > || 0x0C0E<=n && (n<=0x0C10 > || 0x0C12<=n && (n<=0x0C28 > || 0x0C2A<=n && (n<=0x0C33 > || 0x0C35<=n && (n<=0x0C39 > || 0x0C60<=n && (n<=0x0C61 > || 0x0C85<=n && (n<=0x0C8C > || 0x0C8E<=n && (n<=0x0C90 > || 0x0C92<=n && (n<=0x0CA8 > || 0x0CAA<=n && (n<=0x0CB3 > || 0x0CB5<=n && (n<=0x0CB9 > || 0x0CDE==n > || 0x0CE0<=n && (n<=0x0CE1 > || 0x0D05<=n && (n<=0x0D0C > || 0x0D0E<=n && (n<=0x0D10 > || 0x0D12<=n && (n<=0x0D28 > || 0x0D2A<=n && (n<=0x0D39 > || 0x0D60<=n && (n<=0x0D61 > || 0x0E01<=n && (n<=0x0E2E > || 0x0E30==n > || 0x0E32<=n && (n<=0x0E33 > || 0x0E40<=n && (n<=0x0E45 > || 0x0E81<=n && (n<=0x0E82 > || 0x0E84==n > || 0x0E87<=n && (n<=0x0E88 > || 0x0E8A==n > || 0x0E8D==n > || 0x0E94<=n && (n<=0x0E97 > || 0x0E99<=n && (n<=0x0E9F > || 0x0EA1<=n && (n<=0x0EA3 > || 0x0EA5==n > || 0x0EA7==n > || 0x0EAA<=n && (n<=0x0EAB > || 0x0EAD<=n && (n<=0x0EAE > || 0x0EB0==n > || 0x0EB2<=n && (n<=0x0EB3 > || 0x0EBD==n > || 0x0EC0<=n && (n<=0x0EC4 > || 0x0F40<=n && (n<=0x0F47 > || 0x0F49<=n && (n<=0x0F69 > || 0x10A0<=n && (n<=0x10C5 > || 0x10D0<=n && (n<=0x10F6 > || 0x1100==n > || 0x1102<=n && (n<=0x1103 > || 0x1105<=n && (n<=0x1107 > || 0x1109==n > || 0x110B<=n && (n<=0x110C > || 0x110E<=n && (n<=0x1112 > || 0x113C==n > || 0x113E==n > || 0x1140==n > || 0x114C==n > || 0x114E==n > || 0x1150==n > || 0x1154<=n && (n<=0x1155 > || 0x1159==n > || 0x115F<=n && (n<=0x1161 > || 0x1163==n > || 0x1165==n > || 0x1167==n > || 0x1169==n > || 0x116D<=n && (n<=0x116E > || 0x1172<=n && (n<=0x1173 > || 0x1175==n > || 0x119E==n > || 0x11A8==n > || 0x11AB==n > || 0x11AE<=n && (n<=0x11AF > || 0x11B7<=n && (n<=0x11B8 > || 0x11BA==n > || 0x11BC<=n && (n<=0x11C2 > || 0x11EB==n > || 0x11F0==n > || 0x11F9==n > || 0x1E00<=n && (n<=0x1E9B > || 0x1EA0<=n && (n<=0x1EF9 > || 0x1F00<=n && (n<=0x1F15 > || 0x1F18<=n && (n<=0x1F1D > || 0x1F20<=n && (n<=0x1F45 > || 0x1F48<=n && (n<=0x1F4D > || 0x1F50<=n && (n<=0x1F57 > || 0x1F59==n > || 0x1F5B==n > || 0x1F5D==n > || 0x1F5F<=n && (n<=0x1F7D > || 0x1F80<=n && (n<=0x1FB4 > || 0x1FB6<=n && (n<=0x1FBC > || 0x1FBE==n > || 0x1FC2<=n && (n<=0x1FC4 > || 0x1FC6<=n && (n<=0x1FCC > || 0x1FD0<=n && (n<=0x1FD3 > || 0x1FD6<=n && (n<=0x1FDB > || 0x1FE0<=n && (n<=0x1FEC > || 0x1FF2<=n && (n<=0x1FF4 > || 0x1FF6<=n && (n<=0x1FFC > || 0x2126==n > || 0x212A<=n && (n<=0x212B > || 0x212E==n > || 0x2180<=n && (n<=0x2182 > || 0x3041<=n && (n<=0x3094 > || 0x30A1<=n && (n<=0x30FA > || 0x3105<=n && (n<=0x312C > || 0xAC00<=n && n<=0xD7A3))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) > where > n = ord c ]]> isIdeographic c > = > 0x4E00<=n && (n<=0x9FA5 > || 0x3007==n > || 0x3021<=n && n<=0x3029) > where > n = ord c ]]> isCombiningChar c > = 0x0300<=n && (n<=0x0345 > || 0x0360<=n && (n<=0x0361 > || 0x0483<=n && (n<=0x0486 > || 0x0591<=n && (n<=0x05A1 > || 0x05A3<=n && (n<=0x05B9 > || 0x05BB<=n && (n<=0x05BD > || 0x05BF==n > || 0x05C1<=n && (n<=0x05C2 > || 0x05C4==n > || 0x064B<=n && (n<=0x0652 > || 0x0670==n > || 0x06D6<=n && (n<=0x06DC > || 0x06DD<=n && (n<=0x06DF > || 0x06E0<=n && (n<=0x06E > || 0x06E7<=n && (n<=0x06E8 > || 0x06EA<=n && (n<=0x06ED > || 0x0901<=n && (n<=0x0903 > || 0x093C==n > || 0x093E<=n && (n<=0x094C > || 0x094D==n > || 0x0951<=n && (n<=0x0954 > || 0x0962<=n && (n<=0x0963 > || 0x0981<=n && (n<=0x0983 > || 0x09BC==n > || 0x09BE==n > || 0x09BF==n > || 0x09C0<=n && (n<=0x09C4 > || 0x09C7<=n && (n<=0x09C8 > || 0x09CB<=n && (n<=0x09CD > || 0x09D7==n > || 0x09E2<=n && (n<=0x09E3 > || 0x0A02==n > || 0x0A3C==n > || 0x0A3E==n > || 0x0A3F==n > || 0x0A40<=n && (n<=0x0A42 > || 0x0A47<=n && (n<=0x0A48 > || 0x0A4B<=n && (n<=0x0A4D > || 0x0A70<=n && (n<=0x0A71 > || 0x0A81<=n && (n<=0x0A83 > || 0x0ABC==n > || 0x0ABE<=n && (n<=0x0AC5 > || 0x0AC7<=n && (n<=0x0AC9 > || 0x0ACB<=n && (n<=0x0ACD > || 0x0B01<=n && (n<=0x0B03 > || 0x0B3C==n > || 0x0B3E<=n && (n<=0x0B43 > || 0x0B47<=n && (n<=0x0B48 > || 0x0B4B<=n && (n<=0x0B4D > || 0x0B56<=n && (n<=0x0B57 > || 0x0B82<=n && (n<=0x0B83 > || 0x0BBE<=n && (n<=0x0BC2 > || 0x0BC6<=n && (n<=0x0BC8 > || 0x0BCA<=n && (n<=0x0BCD > || 0x0BD7==n > || 0x0C01<=n && (n<=0x0C03 > || 0x0C3E<=n && (n<=0x0C44 > || 0x0C46<=n && (n<=0x0C48 > || 0x0C4A<=n && (n<=0x0C4D > || 0x0C55<=n && (n<=0x0C56 > || 0x0C82<=n && (n<=0x0C83 > || 0x0CBE<=n && (n<=0x0CC4 > || 0x0CC6<=n && (n<=0x0CC8 > || 0x0CCA<=n && (n<=0x0CCD > || 0x0CD5<=n && (n<=0x0CD6 > || 0x0D02<=n && (n<=0x0D03 > || 0x0D3E<=n && (n<=0x0D43 > || 0x0D46<=n && (n<=0x0D48 > || 0x0D4A<=n && (n<=0x0D4D > || 0x0D57==n > || 0x0E31==n > || 0x0E34<=n && (n<=0x0E3A > || 0x0E47<=n && (n<=0x0E4E > || 0x0EB1==n > || 0x0EB4<=n && (n<=0x0EB9 > || 0x0EBB<=n && (n<=0x0EBC > || 0x0EC8<=n && (n<=0x0ECD > || 0x0F18<=n && (n<=0x0F19 > || 0x0F35==n > || 0x0F37==n > || 0x0F39==n > || 0x0F3E==n > || 0x0F3F==n > || 0x0F71<=n && (n<=0x0F84 > || 0x0F86<=n && (n<=0x0F8B > || 0x0F90<=n && (n<=0x0F95 > || 0x0F97==n > || 0x0F99<=n && (n<=0x0FAD > || 0x0FB1<=n && (n<=0x0FB7 > || 0x0FB9==n > || 0x20D0<=n && (n<=0x20DC > || 0x20E1==n > || 0x302A<=n && (n<=0x302F > || 0x3099==n > || 0x309A==n)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) > where > n = ord c ]]> isTDigit c > = 0x0030<=n && (n<=0x0039 > || 0x0660<=n && (n<=0x0669 > || 0x06F0<=n && (n<=0x06F9 > || 0x0966<=n && (n<=0x096F > || 0x09E6<=n && (n<=0x09EF > || 0x0A66<=n && (n<=0x0A6F > || 0x0AE6<=n && (n<=0x0AEF > || 0x0B66<=n && (n<=0x0B6F > || 0x0BE7<=n && (n<=0x0BEF > || 0x0C66<=n && (n<=0x0C6F > || 0x0CE6<=n && (n<=0x0CEF > || 0x0D66<=n && (n<=0x0D6F > || 0x0E50<=n && (n<=0x0E59 > || 0x0ED0<=n && (n<=0x0ED9 > || 0x0F20<=n && n<=0x0F29)))))))))))))) > where > n = ord c ]]> isExtender c > = > 0x00B7==n > || 0x02D0==n > || 0x02D1==n > || 0x0387==n > || 0x0640==n > || 0x0E46==n > || 0x0EC6==n > || 0x3005==n > || 0x3031<=n && (n<=0x3035 > || 0x309D<=n && (n<=0x309E > || 0x30FC<=n && (n<=0x30FE))) > where > n = ord c ]]>
hugs98-plus-Sep2006/packages/HaXml/bugs/panitz/XmlLex.hs0000644006511100651110000003060310504340456021567 0ustar rossrossmodule XmlLex ( xmlLex -- :: String -> String -> [Token] , xmlReLex -- :: Posn -> String -> [Token] , posInNewCxt -- :: String -> Posn , Posn(..) , TokenT(..) , Token , Special(..) , Section(..) ) where -- This is a hand-written lexer for tokenising the text of an XML -- document so that it is ready for parsing. It attaches position -- information in (line,column) format to every token. The main -- entry point is xmlLex. A secondary entry point, xmlReLex, is -- provided for when the parser needs to stuff a string back onto -- the front of the text and re-tokenise it (typically when expanding -- macros). -- -- As one would expect, the lexer is essentially a small finite -- state machine. import Prelude import Char import XmlChar data Where = InTag | NotInTag deriving (Eq) type Token = (Posn, TokenT) data Posn = Pn String Int Int (Maybe Posn) -- filename, line, column, incl.point deriving (Eq) instance Show Posn where showsPrec p (Pn f l c i) = showString f . showString " at line " . shows l . showString " col " . shows c . ( case i of Nothing -> id Just p -> showString "\n used by " . shows p ) data TokenT = TokCommentOpen -- | TokPIOpen -- | TokSectionOpen -- | TokSection Section -- CDATA INCLUDE IGNORE etc | TokSpecialOpen -- | TokAnyOpen -- < | TokAnyClose -- > | TokSqOpen -- [ | TokSqClose -- ] | TokEqual -- = | TokQuery -- ? | TokStar -- * | TokPlus -- + | TokAmp -- & | TokSemi -- ; | TokHash -- # | TokBraOpen -- ( | TokBraClose -- ) | TokPipe -- | | TokPercent -- % | TokComma -- , | TokQuote -- '' or "" | TokName String -- begins with letter | TokFreeText String -- any character data | TokNull -- fake token deriving (Eq) data Special = DOCTYPEx | ELEMENTx | ATTLISTx | ENTITYx | NOTATIONx deriving (Eq,Show) data Section = CDATAx | INCLUDEx | IGNOREx deriving (Eq,Show) instance Show TokenT where showsPrec p TokCommentOpen = showString "" showsPrec p TokPIOpen = showString "" showsPrec p TokSectionOpen = showString "" showsPrec p (TokSection s) = showsPrec p s showsPrec p TokSpecialOpen = showString "" showsPrec p TokAnyOpen = showString "<" showsPrec p TokAnyClose = showString ">" showsPrec p TokSqOpen = showString "[" showsPrec p TokSqClose = showString "]" showsPrec p TokEqual = showString "=" showsPrec p TokQuery = showString "?" showsPrec p TokStar = showString "*" showsPrec p TokPlus = showString "+" showsPrec p TokAmp = showString "&" showsPrec p TokSemi = showString ";" showsPrec p TokHash = showString "#" showsPrec p TokBraOpen = showString "(" showsPrec p TokBraClose = showString ")" showsPrec p TokPipe = showString "|" showsPrec p TokPercent = showString "%" showsPrec p TokComma = showString "," showsPrec p TokQuote = showString "' or \"" showsPrec p (TokName s) = showString s showsPrec p (TokFreeText s) = showString s showsPrec p TokNull = showString "(null)" --trim, revtrim :: String -> String --trim = f . f where f = reverse . dropWhile isSpace --revtrim = f.reverse.f where f = dropWhile isSpace revtrim = reverse . dropWhile (=='\n') emit :: TokenT -> Posn -> Token emit tok p = forcep p `seq` (p,tok) forcep (Pn f n m i) = m `seq` n lexerror :: String -> Posn -> a lexerror s p = error ("Lexical error in "++show p++": "++s++"\n") addcol :: Int -> Posn -> Posn addcol n (Pn f r c i) = Pn f r (c+n) i newline, tab :: Posn -> Posn newline (Pn f r c i) = Pn f (r+1) 1 i tab (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i white :: Char -> Posn -> Posn white ' ' = addcol 1 white '\n' = newline white '\r' = id white '\t' = tab white '\xa0' = addcol 1 skip :: Int -> Posn -> String -> (Posn->String->[Token]) -> [Token] skip n p s k = k (addcol n p) (drop n s) blank :: ([Where]->Posn->String->[Token]) -> [Where]-> Posn-> String-> [Token] blank k (InTag:_) p [] = lexerror "unexpected EOF in tag" p blank k _ p [] = [] blank k w p (' ': s) = blank k w (addcol 1 p) s blank k w p ('\t':s) = blank k w (tab p) s blank k w p ('\n':s) = blank k w (newline p) s blank k w p ('\r':s) = blank k w p s blank k w p ('\xa0': s) = blank k w (addcol 1 p) s blank k w p s = k w p s prefixes :: String -> String -> Bool [] `prefixes` ys = True (x:xs) `prefixes` (y:ys) = x==y && xs `prefixes` ys (x:xs) `prefixes` [] = False --error "unexpected EOF in prefix" accumulateUntil (c:cs) tok acc pos p [] k = lexerror ("unexpected EOF while looking for "++c:cs++" after "++show pos) p accumulateUntil (c:cs) tok acc pos p (s:ss) k | c==s && cs `prefixes` ss = emit (TokFreeText (reverse acc)) pos: emit tok p: skip (length cs) p ss k | isSpace s = accumulateUntil (c:cs) tok (s:acc) pos (white s p) ss k | otherwise = accumulateUntil (c:cs) tok (s:acc) pos (addcol 1 p) ss k ---- posInNewCxt :: String -> Maybe Posn -> Posn posInNewCxt name pos = Pn name 1 1 pos xmlLex :: String -> String -> [Token] xmlLex filename = xmlAny [] (posInNewCxt ("file "++filename) Nothing) xmlReLex :: Posn -> String -> [Token] xmlReLex p s | "INCLUDE" `prefixes` s = emit (TokSection INCLUDEx) p: k 7 | "IGNORE" `prefixes` s = emit (TokSection IGNOREx) p: k 6 | otherwise = blank xmlAny [] p s where k n = skip n p s (blank xmlAny []) --xmltop :: Posn -> String -> [Token] --xmltop p [] = [] --xmltop p s -- | " or " p -- where next n k = skip n p s k xmlPI w p s = xmlName p s (blank xmlPIEnd w) xmlPIEnd w p s = accumulateUntil "?>" TokPIClose "" p p s (blank xmlAny (tail w)) xmlComment w p s = accumulateUntil "-->" TokCommentClose "" p p s (blank xmlAny w) -- Note: the order of the clauses in xmlAny is very important. -- Some matches must precede the NotInTag test, the rest must follow it. xmlAny :: [Where] -> Posn -> String -> [Token] xmlAny (InTag:_) p [] = lexerror "unexpected EOF inside tag" p xmlAny _ p [] = [] xmlAny w p s@('<':ss) | "?" `prefixes` ss = emit TokPIOpen p: skip 2 p s (xmlPI (InTag:w)) | "!--" `prefixes` ss = emit TokCommentOpen p: skip 4 p s (xmlComment w) | "![" `prefixes` ss = emit TokSectionOpen p: skip 3 p s (xmlSection w) | "!" `prefixes` ss = emit TokSpecialOpen p: skip 2 p s (xmlSpecial (InTag:w)) | "/" `prefixes` ss = emit TokEndOpen p: skip 2 p s (xmlTag (InTag:tail w)) | otherwise = emit TokAnyOpen p: skip 1 p s (xmlTag (InTag:NotInTag:w)) xmlAny (_:_:w) p s@('/':ss) | ">" `prefixes` ss = emit TokEndClose p: skip 2 p s (xmlAny w) xmlAny w p ('&':ss) = emit TokAmp p: accumulateUntil ";" TokSemi "" p (addcol 1 p) ss (xmlAny w) xmlAny w@(NotInTag:_) p s = xmlContent "" w p p s xmlAny w p ('>':ss) = emit TokAnyClose p: xmlAny (tail w) (addcol 1 p) ss xmlAny w p ('[':ss) = emit TokSqOpen p: blank xmlAny (InTag:w) (addcol 1 p) ss xmlAny w p (']':ss) | "]>" `prefixes` ss = emit TokSectionClose p: skip 3 p (']':ss) (xmlAny (tail w)) | otherwise = emit TokSqClose p: blank xmlAny (tail w) (addcol 1 p) ss xmlAny w p ('(':ss) = emit TokBraOpen p: blank xmlAny (InTag:w) (addcol 1 p) ss xmlAny w p (')':ss) = emit TokBraClose p: blank xmlAny (tail w) (addcol 1 p) ss xmlAny w p ('=':ss) = emit TokEqual p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('*':ss) = emit TokStar p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('+':ss) = emit TokPlus p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('?':ss) = emit TokQuery p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('|':ss) = emit TokPipe p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('%':ss) = emit TokPercent p: blank xmlAny w (addcol 1 p) ss xmlAny w p (';':ss) = emit TokSemi p: blank xmlAny w (addcol 1 p) ss xmlAny w p (',':ss) = emit TokComma p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('#':ss) = emit TokHash p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('"':ss) = emit TokQuote p: accumulateUntil "\"" TokQuote "" p (addcol 1 p) ss (xmlAny w) xmlAny w p ('\'':ss) = emit TokQuote p: accumulateUntil "'" TokQuote "" p (addcol 1 p) ss (xmlAny w) xmlAny w p s | isSpace (head s) = blank xmlAny w p s | isNmstart (head s) = xmlName p s (blank xmlAny w) | otherwise = lexerror "unrecognised token" p xmlTag w p s = xmlName p s (blank xmlAny w) xmlSection = blank xmlSection0 where xmlSection0 w p s | "CDATA[" `prefixes` s = emit (TokSection CDATAx) p: accum w p s 6 | "INCLUDE" `prefixes` s = emit (TokSection INCLUDEx) p: k w p s 7 | "IGNORE" `prefixes` s = emit (TokSection IGNOREx) p: k w p s 6 | "%" `prefixes` s = emit TokPercent p: k w p s 1 | otherwise = lexerror ("expected CDATA, IGNORE, or INCLUDE") p accum w p s n = let p0 = addcol n p in accumulateUntil "]]>" TokSectionClose "" p0 p0 (drop n s) (blank xmlAny w) k w p s n = skip n p s (xmlAny w) xmlSpecial w p s | "DOCTYPE" `prefixes` s = emit (TokSpecial DOCTYPEx) p: k 7 | "ELEMENT" `prefixes` s = emit (TokSpecial ELEMENTx) p: k 7 | "ATTLIST" `prefixes` s = emit (TokSpecial ATTLISTx) p: k 7 | "ENTITY" `prefixes` s = emit (TokSpecial ENTITYx) p: k 6 | otherwise = lexerror "expected DOCTYPE, ELEMENT, ENTITY, or ATTLIST" p where k n = skip n p s (blank xmlAny w) xmlName p (s:ss) k | isNmstart s = gatherName (s:[]) p (addcol 1 p) ss k -- | isAlphaNum s || s==':' || s=='_' = gatherName (s:[]) p (addcol 1 p) ss k | otherwise = lexerror ((show$ord s) ++" expected name") p where gatherName acc pos p [] k = emit (TokName (reverse acc)) pos: k p [] -- lexerror ("unexpected EOF in name at "++show pos) p gatherName acc pos p (s:ss) k -- | isAlphaNum s || s `elem` ".-_:" | isNmchar s|| s `elem` ".-_:" = gatherName (s:acc) pos (addcol 1 p) ss k | otherwise = emit (TokName (reverse acc)) pos: k p (s:ss) xmlContent acc w pos p [] = if all isSpace acc then [] else lexerror "unexpected EOF between tags" p xmlContent acc w pos p (s:ss) | elem s "<&" = if all isSpace acc then xmlAny w p (s:ss) else emit (TokFreeText (revtrim acc)) pos: xmlAny w p (s:ss) | isSpace s = xmlContent (s:acc) w pos (white s p) ss | otherwise = xmlContent (s:acc) w pos (addcol 1 p) ss --ident :: (String->TokenT) -> -- Posn -> String -> [String] -> -- (Posn->String->[String]->[Token]) -> [Token] --ident tok p s ss k = -- let (name,s0) = span (\c-> isAlphaNum c || c `elem` "`-_#.'/\\") s -- in emit (tok name) p: skip (length name) p s ss k hugs98-plus-Sep2006/packages/HaXml/bugs/sven.dtd0000644006511100651110000000035110504340456020162 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/bugs/gxl-1.0.dtd-working0000644006511100651110000000761210504340456021762 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/log.dtd0000644006511100651110000016450210504340456020001 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/malc.dtd0000644006511100651110000000054010504340456020123 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/bugs/malc.hs0000644006511100651110000000672710504340456017777 0ustar rossrossmodule DTD where import Xml2Haskell {-Type decls-} newtype Persons = Persons [Person] deriving (Eq,Show) data Person = Person_Male_FathersName Person_Attrs Male (Maybe FathersName) | Person_Female_MothersName Person_Attrs Female (Maybe MothersName) deriving (Eq,Show) data Person_Attrs = Person_Attrs { personId :: Id } deriving (Eq,Show) newtype FathersName = FathersName String deriving (Eq,Show) newtype MothersName = MothersName String deriving (Eq,Show) data Male = Male { maleSrc :: (Maybe String) , maleAlt :: Alt } deriving (Eq,Show) data Alt = A | B deriving (Eq,Show) data Female = Female deriving (Eq,Show) {-Instance decls-} instance XmlContent Persons where fromElem (CElem (Elem "persons" [] c0):rest) = (\(a,ca)-> (Just (Persons a), rest)) (many fromElem c0) fromElem rest = (Nothing, rest) toElem (Persons a) = [CElem (Elem "persons" [] (concatMap toElem a))] instance XmlContent Person where fromElem (CElem (Elem "Person" as c0):rest) = case (\(a,ca)-> (\(b,cb)-> (a,b,cb)) (fromElem ca)) (fromElem c0) of (Nothing,Nothing,_) -> case (\(a,ca)-> (\(b,cb)-> (a,b,cb)) (fromElem ca)) (fromElem c0) of (Nothing,Nothing,_) -> (Nothing, c0) (Just a,b,[]) -> (Just (Person_Female_MothersName (fromAttrs as) a b), rest) (Just a,b,[]) -> (Just (Person_Male_FathersName (fromAttrs as) a b), rest) toElem (Person_Male_FathersName as a b) = [CElem (Elem "Person" (toAttrs as) (toElem a ++ maybe [] toElem b) )] toElem (Person_Female_MothersName as a b) = [CElem (Elem "Person" (toAttrs as) (toElem a ++ maybe [] toElem b) )] instance XmlAttributes Person_Attrs where fromAttrs as = Person_Attrs { personId = definiteA fromAttrToTyp "Person" "id" as } toAttrs v = catMaybes [ toAttrFrTyp "id" (personId v) ] instance XmlContent FathersName where fromElem (CElem (Elem "FathersName" [] c0):rest) = (\(a,ca)-> (Just (FathersName a), rest)) (definite fromText "text" "FathersName" c0) fromElem rest = (Nothing, rest) toElem (FathersName a) = [CElem (Elem "FathersName" [] (toText a))] instance XmlContent MothersName where fromElem (CElem (Elem "MothersName" [] c0):rest) = (\(a,ca)-> (Just (MothersName a), rest)) (definite fromText "text" "MothersName" c0) fromElem rest = (Nothing, rest) toElem (MothersName a) = [CElem (Elem "MothersName" [] (toText a))] instance XmlContent Male where fromElem (CElem (Elem "Male" as []):rest) = (Just (fromAttrs as), rest) fromElem rest = (Nothing, rest) toElem v = [CElem (Elem "Male" (toAttrs v) [])] instance XmlAttributes Male where fromAttrs as = Male { maleSrc = possibleA fromAttrToStr "src" as , maleAlt = definiteA fromAttrToTyp "Male" "alt" as } toAttrs v = catMaybes [ maybeA toAttrFrStr "src" (maleSrc v) , toAttrFrTyp "alt" (maleAlt v) ] instance XmlAttrType Alt where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "A" = Just A translate "B" = Just B translate _ = Nothing toAttrFrTyp n A = Just (n, str2attr "A") toAttrFrTyp n B = Just (n, str2attr "B") instance XmlContent Female where fromElem (CElem (Elem "Female" [] []):rest) = (Just Female, rest) fromElem rest = (Nothing, rest) toElem Female = [CElem (Elem "Female" [] [])] {-Done-} hugs98-plus-Sep2006/packages/HaXml/bugs/norback.dtd0000644006511100651110000000014210504340456020624 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/bugs/norback.xml0000644006511100651110000000004610504340456020654 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/norbacktest.hs0000644006511100651110000000015310504340456021365 0ustar rossrossimport Xml2Haskell import DTD_norback main = do d <- readXml "norback.xml" writeXml "-" (d::Test) hugs98-plus-Sep2006/packages/HaXml/bugs/xhtml-symbol.ent0000644006511100651110000003345710504340456021676 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/patch-norback0000644006511100651110000000234610504340456021157 0ustar rossross--- ../HaXml-1.02/tools/DtdToTypeDefPP.hs Wed May 30 14:21:31 2001 +++ tools/DtdToTypeDefPP.hs Fri Jul 13 15:22:52 2001 @@ -298,7 +298,8 @@ mkFrAux aux frattr cs $$ text "fromElem rest = (Nothing, rest)" $$ - vcat (map (mkToMult n topat toattr) cs) + if aux then vcat (map (mkToAux mixattrs) cs) + else vcat (map (mkToMult n topat toattr) cs) ) $$ mkInstanceAttrs Extended n fs @@ -491,13 +492,13 @@ (Defined m) -> text "Just" <+> v in parens (hcat (intersperse comma (zipWith sp sts vs++[rest]))) ---mkToAux :: Bool -> (Name,[StructType]) -> Doc ---mkToAux mixattrs (n,sts) = --- let vs = nameSupply sts --- attrs = if mixattrs then text "as" else empty --- in --- text "toElem" <+> parens (mkCpat n attrs vs) <+> text "=" <+> --- mkToElem sts vs +mkToAux :: Bool -> (Name,[StructType]) -> Doc +mkToAux mixattrs (n,sts) = + let vs = nameSupply sts + attrs = if mixattrs then text "as" else empty + in + text "toElem" <+> parens (mkCpat n attrs vs) <+> text "=" <+> + mkToElem sts vs mkToMult :: Name -> Doc -> Doc -> (Name,[StructType]) -> Doc mkToMult tag attrpat attrexp (n,sts) = hugs98-plus-Sep2006/packages/HaXml/bugs/scheffczyk.dtd0000644006511100651110000000003610504340456021346 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/svg.dtd0000644006511100651110000015273010504340456020017 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/xhtml-lat1.ent0000644006511100651110000002701510504340456021223 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/xhtml-special.ent0000644006511100651110000001006010504340456021772 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/bugs/xhtml1-transitional.dtd0000644006511100651110000007676510504340456023157 0ustar rossross %HTMLlat1; %HTMLsymbol; %HTMLspecial; hugs98-plus-Sep2006/packages/HaXml/docs/0000755006511100651110000000000010504340466016504 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/docs/Combinators.html0000644006511100651110000000170610504340456021655 0ustar rossross HaXml: Haskell and XML

Combinators

Text.XML.HaXml.Combinators is a combinator library for generating, editing, and transforming XML documents in a generic setting.

Text.XML.HaXml.Html.Generate is a small library of functions specifically for generating HTML from XML.

Text.XML.HaXml.Wrappers contains the wrapper processXmlWith, in which input files are parsed as HTML if the filename ends in .html or .htm - otherwise they are parsed as XML.

Usage: import Text.XML.HaXml.Combinators

Limitations
Note that the combinator library defines the functions elm and txt rather than the expected (elem and text), to avoid a nasty name clash with a Prelude function.

hugs98-plus-Sep2006/packages/HaXml/docs/Haskell2Xml.html0000644006511100651110000000576110504340456021530 0ustar rossross HaXml: Haskell and XML

Haskell2Xml

Text.XML.HaXml.Haskell2Xml is a library for translating Haskell data from any program into a valid XML document (and back again), by generating a DTD and the appropriate functions to write and write the XML format. In principle, it gives an alternative to the standard Read and Show classes, and allows you to use other standard XML-processing tools on your Haskell datafiles.

Usage. It works rather like the existing Read and Show classes: you must create an instance of the Haskell2Xml class for every datatype you wish to use for I/O. However, because this class is not a standard one, no Haskell compilers support the deriving clause for it yet. Fear not! There is a pre-processor tool called DrIFT which derives class instances automatically. We have extended DrIFT's ruleset to include the Haskell2Xml class. The only remaining thing is to ensure that you import the Text.XML.HaXml.Haskell2Xml module everywhere you use it.

(Please note that DrIFT is sometimes a bit fragile when parsing Haskell sources - it occasionally fails to recognise the derive command. We have found a workaround: isolate just the data type declarations that are of interest, and run DrIFT on them separately.) The syntax required is like this example: 

  data MyType a = A a | B String deriving (Eq, Show)
      {-! derive : Haskell2Xml !-}	-- this line is for DrIFT

To read and write Haskell data values as XML files, you have a choice of function pairs: toXML/fromXML convert between typed Haskell values and the generic internal XML representation; showXml/readXml convert to/from Strings; fWriteXml/fReadXml convert to/from named files; hPutXml/hGetXml convert to/from file Handles. 

    toXml     :: Haskell2Xml a => a        -> Document
    fromXml   :: Haskell2Xml a => Document -> a

    readXml   :: Haskell2Xml a => String   -> Maybe a
    showXml   :: Haskell2Xml a => a        -> String

    fReadXml  :: Haskell2Xml a => FilePath -> IO a
    fWriteXml :: Haskell2Xml a => FilePath -> a -> IO ()

    hGetXml   :: Haskell2Xml a => Handle   -> IO a
    hPutXml   :: Haskell2Xml a => Handle   -> a -> IO ()

(These signatures are extremely similar to those in Xml2Haskell - the only difference is the class context, indicating how the types have been derived.)

Do not forget to resolve the overloading in one of the usual ways (e.g. by implicit context at point of use, by explicit type signatures on values, use value as an argument to a function with an explicit signature, use `asTypeOf`, etc.)

hugs98-plus-Sep2006/packages/HaXml/docs/Xml2Haskell.html0000644006511100651110000000777310504340456021535 0ustar rossross HaXml: Haskell and XML

DtdToHaskell tool

DtdToHaskell is a tool (and Text.XML.HaXml.Xml2Haskell provides the class framework) for translating any valid XML DTD into equivalent Haskell types. This allows you to generate, edit, and transform documents as normal typed values in programs, and to read and write them as human-readable XML documents.

Usage: DtdToHaskell [dtdfile [outfile]]
(Missing file arguments or dashes (-) indicate stdin or stdout respectively.)

The program reads and parses a DTD from dtdfile (which may be either just a DTD, or a full XML document containing an internal DTD). It generates into outfile a Haskell module containing a collection of type definitions plus some class instance declarations for I/O.

In order to use the resulting module, you need to import it, and also to import Text.XML.HaXml.Xml2Haskell. To read and write XML files as values of the declared types, use some of the following convenience functions: 

    readXml   :: XmlContent a => String -> Maybe a
    showXml   :: XmlContent a => a -> String

    hGetXml   :: XmlContent a => Handle -> IO a
    hPutXml   :: XmlContent a => Handle -> a -> IO ()

    fReadXml  :: XmlContent a => FilePath -> IO a
    fWriteXml :: XmlContent a => FilePath -> a -> IO ()
not forgetting to resolve the overloading in one of the usual ways (e.g. by implicit context at point of use, by explicit type signatures on values, use value as an argument to a function with an explicit signature, use `asTypeOf`, etc.) (Also, note the similarity between these signatures and those provided by the Haskell2Xml library.)

You will need to study the automatically-generated type declarations to write your own transformation scripts - most things are pretty obvious parallels to the DTD structure.

Limitations
The generated Haskell contains references to types like OneOf3 where there is a choice between n (in this case 3) different tags. Currently, the module Text.XML.HaXml.OneOfN defines these types up to n=20. If your DTD requires larger choices, then use the tool MkOneOf to generate the extra size or range of sizes you need.

We mangle tag names and attribute names to ensure that they have the correct lexical form in Haskell, but this means that (for instance) we can't distinguish Myname and myname, which are different names in XML but translate to overlapping types in Haskell (and hence probably won't compile).

Attribute names translate into named fields: but because Haskell doesn't allow different types to have the same named field, this means your XML document which uses the same name for similar attributes on different tags would crash and burn. We have fixed this by incorporating the tagname into the named field in addition to the attribute name, e.g. tagAttr instead of just attr. Uglier, but more portable.

XML namespaces. Currently, we just mangle the namespace identifier into any tag name which uses it. Probably the right way to do it is to regard the namespace as a separate imported module, and hence translate the namespace prefix into a module qualifier. Does this sound about right? (It isn't implemented yet.)

External subset. Since HaXml release 1.00, we support the XML DTD external subset. This means we can read and parse a whole bunch of files as part of the same DTD, and we respect INCLUDE and IGNORE conditional sections.

There are some fringe parts of the DTD we are not entirely sure about - Tokenised Types and Notation Types. In particular, there is no validity checking of these external references. If you find a problem, mail us: Malcolm.Wallace@cs.york.ac.uk

hugs98-plus-Sep2006/packages/HaXml/docs/Xtract.html0000644006511100651110000003037010504340456020641 0ustar rossross Xtract: a query language for XML documents

Xtract: a query language for XML documents

Malcolm Wallace, Colin Runciman
University of York
December 1998,
updated June, August 1999, February 2000

Introduction

Xtract is a query language based originally on XQL, which was a W3C proposal that eventually mutated into XPath and XQuery. The syntax of Xtract is very similar to XPath, although not completely conformant.

The idea of Xtract is that it can be used as a kind of XML-grep at the command-line, but it could also be used within a scripting language (such as the Haskell XML combinator library) as a shorthand for a complicated selection filter.

All queries return a sequence of XML document fragments (either whole tagged elements or text contained inside an element): for our purposes, we also treat attribute values as document fragments.

This document describes the expression language for queries.

Queries

Just as in XPath, a query looks rather like a Unix file path, where the ``directories'' are tags of parent nodes, and the / separator indicates a parent/child relationship. Hence, 

    matches/match/player
selects the player elements inside match elements inside a matches element. The star * can be used as a wildcard meaning any tagged element, thus: 
    matches/*/player
means the player elements inside any element within a matches element. The star can also be used as a suffix or prefix to match a range of tags: [ Note that this is not a full regular expression language: we just provide for the common cases of wildcards. ] 
    html/h*
means all the headings ( <H1> to <H6> ) within an HTML document (and HR too!). A double slash indicates a recursive search for an element tag, so 
    matches//player
means all player elements found at any depth within a matches element. The plain text enclosed within a tagged element is expressed with a dash symbol: 
    matches/location/-
means the plain text of the location, without any surrounding <location> tags. Likewise, 
    *//-
simply means to flatten the text of the document at all levels, removing all tagged element structure. The union of two queries is expressed with the + operator and parentheses if required: 
    matches/match/(player + spectators)
gives both the players and spectators at a match. Finally, 
    matches//player/@goals
returns the value of the attribute `goals' on the selected player elements, if the attribute appears.

Predicates

There is a notion of a predicate on an element. The square bracket notation is used: 
    matches/match[player]
means all match elements which contain at least one player element. It is the match elements that are returned, not the players they contain. One can also ask for the presence of a particular attribute: 
    *//player[@goals]
means those players (found anywhere within the tree) who scored any goals. You can compare attribute values using any of the operators = , != , < , <= , > , >= all of which use lexicographical ordering. In this example: 
    */match[player/@surname!=referee/@surname]
we only want those matches in which the referee does not have the same surname as any of the players. A comparison may be either against another attribute value, or against a literal string; however a literal string may only appear to the right of the operator symbol. For instance, 
    */match[player/@name='colin']
asks for only those matches in which the player named ``colin'' participated. If lexicographical comparison is inappropriate, numeric comparisons are also possible: these comparison operators are surrounded by dots: .=. , .!=. , .<. , .<=. , .>. , .>=. Again, either two attribute values are compared, or one attribute value is compared with a literal integer. For instance 
    */match[@ourgoals .>. @theirgoals]
asks for the matches we won, while 
    */match[@ourgoals .<=. 3]
asks for the matches in which we scored three or fewer goals. (Note that the literal integer is not surrounded by quote marks.)

In addition to comparing attribute values, you can also compare the textual content of elements. For instance, 

    */match[player/- = 'Colin']
asks for the matches in which ``Colin'' participated, where the name is recorded between the player tags, rather than as an attribute. All the same conditions and operations apply as for attribute value comparisons. Note however that you can only compare texts, not whole structures.

Combining predicates

Predicates can be combined using the common Boolean operations & | and ~ , with parentheses for disambiguation if they are required: 
	        
	    */match/[@ourgoals .=. @theirgoals | (player/@name='colin' 
	    & ~(@opposition='city'))]
means the matches which either ended in a draw, or in which ``colin'' played but the opposition was not ``city''.

Positional selection

The final feature of Xtract is that the square bracket notation is overloaded to allow the selection of elements by position: 
    */match[3]
means the fourth match in the sequence (numbering starts at zero). You can have a series of indexes, separated by commas, and ranges are indicated with a dash. The dollar symbol means the last in the sequence. For example: 
    */match[0,2-$,1]
reorders the matches to place the second one last.

Complex queries

The full expression language is highly recursive, permitting you to build arbitrarily complex queries. For instance: 
    */match[player/@name='colin'][5-$]/referee[@age.>=.34]
means: from the sixth onwards, of those matches in which ``colin'' was a player, select those referees who are older than 34.

Grammar

We give a full grammar for Xtract.

textquery = query elements
| -plain text
query = string tagged element
| string* prefix of tag
| *string suffix of tag
| *any element
| ( textquery ) grouping
| query/textquery direct descendant
| query//textquery deep descendant
| query/@string value of attribute
| query + textquery union
| query[predicate] predicates
| query[positions] indexing
qa = textquery has tagged element
| attributehas attribute
predicate = qa has tagged element or attribute
| qa op qa lexical comparison of attribute values or element texts
| qa op 'string' lexical comparison of attribute value or element text
| qa op "string" lexical comparison of attribute value or element text
| qa nop qa numeric comparison of attribute values or element texts
| qa nop integer numeric comparison of attribute value or element text
| ( predicate ) grouping
| predicate & predicate logical and
| predicate | predicate logical or
| ~ predicate logical not
attribute = @string attribute of this element
| query/@string attribute of descendant
positions = position { , positions} comma-separated sequence
| position - position range
position = integer positions start at zero
| $last element
op = = lexical equality
| !=lexical inequality
| <lexically less than
| <= lexically less than or equal
| > lexically greater than
| >= lexically greater than or equal
nop = .=. numeric equality
| .!=.numeric inequality
| .<.numeric less than
| .<=. numeric less than or equal
| .>. numeric greater than
| .>=. numeric greater than or equal
hugs98-plus-Sep2006/packages/HaXml/docs/brubeck.gif0000644006511100651110000002273010504340456020613 0ustar rossrossGIF87aˆÛôÿÿÿÀÀÀsss€€€€ÿÿ€ÿÿÿ€€€€²²²Bš§º §7<_g/~ˆîáááeeeiµµ,ˆÛþ  Ždižhª®lë¾p,Ïtmßx®ïm À pH,ȤrÉl:ŸÐ¨tJ­Z¯Ølrà¾à°xL.›Ïè´zÍn»ßð¸|N¯Ûïø3÷—ïûÿ€‚ƒ„…†v{^‡‹ŒŽŒM“_•‰a›b››‘¡¢£¤¥y-\¨,\–© ˜]š@³@°bA–@¡CwDjºkÂcBGsƦ«+ª"ÑÒÒ"­Í*Ö™¶µ`¸ÅŠ×£¼¼vççhêÁãaéî„æ^ôñmðËŽØ)ÏÓÿÕ`5‹F‚ m²lèFà[¸\ŠØ½[„¯Î8‰eì­#£#äÖtÓqäÈ|tþö¡èçÃDKkØ <k›7p´¾8̨ëâ<`×ðÕ#FÔ^É]äzFÄï§Ð¢>—}µ¢¹©À”Îãèk=0ÄÀV]ª å©W«Z–x)p-µùÌ ðmaCp±"uj)éק^‘Bxª_Ãb…]Ýxë× ì"ÿ•*´ñcG-¼÷òI³qTž`y‚­+·%âÆÛYw^Ž'÷5œù)c3î”Ù~Lµ3át»ç‹°Õ‹…?§<”7gÀ!AŸeE Z逧GL#¡ºÓëÖ¯Óλëqâ\ó^Œ¹*áäe%Gî¾ú®gjGì‹~ùxÄÒý‚–u.awMA-ÍþÔÝ\7Ý›`À]Û„?%ÇÙ{Æ%¡x·1ƲÅsÜúvXúi6ßö)à0ÚWuþ\GSv3ùcZ,rÝ@"@Ix‰í\‘MùyÁ…åáp"ú p%EÅb‘½7dꉓ$•\z¹eE/Zãv3¦õÏ[0½ò…M ÎšÑ pˆGeþábž|R4 uÙeSSBq9'v‚gŸ¿ÜÆè£ 餔RJI¥˜N*P¦™Ú# *Ú¤É Eꩆ€ªêªÿ|Áj«<î‰ê¬´Öjë‰L ë®¼öêë¯À+ì°Äkì±È&«ì²Ì6ëì³ÐF+í´ÂþæJíµØf«í¶Üvëí·à>Kµ ”kî¹è¦«îºì¶ëî»ðÆ+ï¼ôÖkï½øæ«ï¾üöëoºŒÛ…®ÿlðÁ'¬ð 7ì0¾“ûðÄWlñÅglqÄO ñÇ ‡,òÈ$+Ìñ—¬òÊ,·ìòÅ'òË4×lóÍ8«óÌ9÷ìóÏ@S¼³ÇAmôÑH×;tÒL7íôÑK» *Ñð»&ºUWMuõj]î4ÿÓïÕòzm5׃ݮÖf/,ö×hÛÛ6ÃQ¯÷¹sË}7Ö{ç-õÝ~ìuàó¾·Ýÿ~/Û‡ãÝ8ÃŒŸ-´À(¸¹Y£­6½sg¾õÖþŠ«9ã‘nzáoŽ:æšKÃzéYƒ.;Ü£»nºêeεç ïÞzí¯?þ7ëŸ{¾¹ÚÈÛž¹á÷ÖÍ®ÙÆ·Þuß¾û·Þ×ó®½ôœ7^úêÙK<ìâ—/6ùÓ;.;úµ[ÿ}îÄ/ŸüíÜ·¼ðî:¿îùîs:ØÀ;ø¢w½âY/}½£ßôægÀð1OêSžíf‡½øÕ¯|ás ¾˜·¼òN} œà•F9™Yîyº3 îàÕ¶†n_s ˆÀ 0^Ä  ㆾÞ0ŽÃ #xAnïul áx8ö¥ð…ëÒŸèžøÃ$zð€PL×ü:×?+±{4þb!xÄòMˆS$âÅAÚÕ€$ßÖØÂ,ꬄ<ÛÛ?"bqwIü"ÁÈFBÒ°Œ:táYAÒ…‘… IÇ"bx<¡ÕÄîmq‘hÜä¡ç?½Å®“ÿ¡*¿Ç@GÞÏ‚v<#«¸½®…¯$åSD.æKŠO ¦0E9ÌÂé ˜ÅLf0c9Lf¢ ™ÊŒfÒœù4jž šÒ̦6·I/lró›à §7ÃIÎr&sœæL§:‘†Îuºó8k'<çIO•É³žøÌ'Ɔ°~úóŸ ¨@JЂô M¨BÊІ:ô¡¨D'JÑŠ4WͨþF7ÊÑŽzô£ ©H%š}šô¤*+)JWÊRŒ©´¥0Í'·ÚõÒvË\áRNsªIvñôW;ýi¸‚ -›j‹4í¼¾…Ôr µXMeO£ê®§î*ªVe*QŸeTƒ,©?XjOÿõU§Ž5ce•êY½JÕ®n «kZZóh0ºî+­êª©OãzW¸’l®|õ^ÝZ1À:Í° ÓÕ°ØÆ2ö±Ž,d';Xtéu]v¬_G†Xºµu¯0Û,Ó:‹0Åà8mjQ«ÚÖ²öµ«]meÏuYue¶_¤Yn6[Ûa»5Zpÿ¥Ø(à`,Åw¹È tþ“Û\æ.¶·åªmºfF66®³€ eâÌÞY’õ³˜µ\wµ(Þ9–«¼ùòåäv*Ë~é*¹È=@˜«\Ô&7Œ}®qSÛÜ» Ð.º¸k^ïÞ‘¾˜³ØÝàG~!ø\ –#{“HáÅ5±½š…ð÷¥+ºHw±Ò0.–ÛÜÀÓ@ns›‹`cX½ ¾_^ÑQ-€Œ¡ÌC Gø½¢} òÖ·Ëk¢×·&Ý›lC'™zT¦a™ïùÖ}õƒ¬k$+š…Dô“· 늹‡Œ[¦K™ì ï¸Ñ|&¤)½ib³øÓ+BšãL( À§ã|j´bòïd;Òæ:†ï4Ÿ‹<ä<+šÚ—Þ¡×]ë_íÐLŒã²GYífÓÏuö[¢“ïoâ¯Ìå&5ª êOŸºâÆö¨Ïî8B’“¾î÷­ëýgxÚÈ|r‡?nÉ…wütì¾4#C®V Wºà¿yƒøh†C[¬ãÆöB þS—ã£Nº¹‡`:WÇ Ÿ9­k^r]{ïä$Ï:ÍíÜl' œé7V7%ÙÁ­C]Ž’ö¥×-­óž‹œŒp$Ü}ËM÷ Í¤–8®ñsüÕÁS¸ü<Ž¶k±×X·u¼•=íƒÑñ.<ái7å.Û쯞åáÈIòuQÊÁ‹|s9æ§+]â?€ÀÝi‘t¤Ÿ:ï~gºE|°áîSÏ&;í'f{‘Ų÷ÈžW™5ÔG`õ ùt¸û^ô¿?=÷»ÿðCüòù¾}dïƒ×ô­yß4àõßOý¨ƒ q¤“úû{_:XÑ-yàâ^úïw¼n»°écì–ù‹¿{í¥+þº«ºè©—EW |WtèÎGXµ§·}òW}¼ç€rEür_Xt €?¨jè}ð¸w ({NÇ€lheÔ×~ÖGu£å‚úÒß'€è÷ €Ç|׃{·'¸~bR;5R •„#5 „Å„P(RRQFuq%Ø z;ØÐ @€ß÷}B¸€>R85…µ†J8lèOn‡HèTeT>؃;( zG2F€=ȇZø}hSˆèN6Ø €Ð¯" H†‡˜ˆ–XNºò…€bàö‰’X•x‰¤ÈMÅþµB œŠ£XŠ®M%Š²ØŠ¯X‹Â‹²‰´h‹¼È4¸˜‹¬²‹½8ŒEó‹À¨*ÂHŒÊØ3ÆxŒt’ŒË5ÓŒÎøÐ(ØÈ2ÔXÒpÙø#³ÜÞŽæ¨1ô×<(èjçØŽÚø[Ý´ŽìçŽôH2ºÂQFXú2Oˆì2{ûOYH“+™Á„G Ù£…‘EÃY‘>SBt˜‘¹‘Ù‘ù‘‰ð‘"9’$Y’&y’3!©{Ù’"£++é’2é20Ù)™U8™“:¹“<Ù“?’>”B9”DY”AI3™”ƒ”JÙ”ÔþN• óRZP•Vy•X™•Z¹•\Ù•^æB•_9–dY–fy–h™–d–N§–nù–p—r9—XÉ–ìH—x™—z¹—|i–v9}˜‚9˜„Y˜Eð—æb˜Š¹˜ŒÙ˜e‰˜å☒9™”Y™O™ `™š¹™œ)™˜Ù™ š¢™—Ÿ9š¦yš¨ù•¥™š¬Ùš®I«ùš²9›´9±Y›¸™›¨y›ºÙ›¾©™¼ù›Â9œŠœÄyœÈ©—Æ™œÌÙœj¹œÎÒÙ•Ð9ÖyYPعÜy™ÙÕ–Ýžâ Ú9žæ9žåyžCÀ*‡²•ÿ ž{™žðy C" ôÙžXiþŸôyfó —ò9Ÿ†¢Ÿ8! UI øÉüÙŸVùŸð Ñ j•Jºª WÉ  J Ó°Ÿ” ŸÚ¡z¡ú *¢k‚¡úw©¢J¢z¢ö£õ™ ºŸ8z 7ê¢W ¡ý¢ ¢*¤5ÊŸ;J¤9z <š, ˜Kš@ê Eš£ ²ž$J¥C¤Wú¤°Ù¤‰É¥G¥%:¥ø¹£cZHª£[ ¦`饑ɦh £ZJ¦i¦:§Ij¦pê>  r*¥XJ¦vj¤xª¦º§|ꦙ‰¨B ¦š§Y§€:¦ï‰£‡Ê¨IЧçI'ú¡2j¢4ª§‡þ²¥Ÿz¦˜JžŠzªªêššºª®j˜­úª²˜±:«¶Jš©z«ºJ™µº«¾úœ¹ú«ÂZ˜½:¬Æê•Åz¬Êš•Éº¬ÎªÍú¬ÒZÑ:­ÖŠªMע׺­k¬Üú­\Y­à:®¶é­äz®Lš­NŠ®ìÚ£æÚ®ðŠ­b¯ôêêú¥õš¯K ©"jªúª¬­Ú¯·ð¯Î°!Š ëªË¡z© ¦;ªÚ¨¡Z±”ê°Ë«£%zŸI:'÷© Ÿ‹¢j¨ZŸ#K²ïêRú¡'[±Uº²,{¯o*g6£1[¨»¦4»Û©;;©Vê³?kAë¡Cë¯þ«¤G«±-; #ê Ûžt*¤O+žüz¥*°Júž•šµÝ)®b{«d[¶³z¶hûªj»¶«Ú¶n{ªp·Œ:·t»§v{·lš·zË¥|Û·Kú·€ë¢‚;¸Z¸†ÛŸˆ›¸5;¯Œ;­‹û¸æ¹’«µQ[¹ÃJ¹˜ µ6»¨›»¬}š¢Qà©û¢ Û¯¢«´û•{• Z Fê•­[´^[µ‹É¯«‹³ë)µš»T ²ÀÛ´]9»®+¼Y@¼j ÆÛ¨Ž‰»;±‹ÊۻϋÏ›³Õ+¡z–*{Ó›ŸÚ¦žy¹Jð»]‹§Yª¼"+±j£»k½ ë¾S˼¯›þ»VªKºç²Dë»X¿ñ{¨¥¼7ª¥›¾5²Áë´Ëk¢œÀ„¹µ Ú´Ý[Á|Áð+¼œÁ\¤Cº½ï½< LÂÖkÂÝ{½ŒÂË[½,̼ºÂ,Ã'ÜÂlÁÓ‹¼oé¼0 Á¶ËÂ0ªÂ ÃB|À \º%LÃ]{Ä\ÃN\ÁüÁO¬ÄFÃ|§=LÃTºÂ—ú½>œÂ‚ÉÃE¼ÀRLÂò;ÅhJÄØ{ÃvÂZ ¼òûÂ&l»h,Ç6 ¿LÇk<Ç/LÇlŒÇ'l´¸Ú¹Ð›ÄuLÅ~lÅp¬Æ^ Á¤ÚÀˆœÇBlLJœÅ•<Çï{ÉnÜÇ”|Æ5þüÁAÁä+½\K´Hš¦Q<£‚:ªsÚ¾k*¦õ˳dܱ2 Ç9 ³Gê© zËì«¿S»Ë»§««Êù«Ëµ\Àû ³W¬Ã;<ÊnÉÌ°;ÐŒ·Îœ–Ó,¡×ìšÙ¼·Õ̽Ûü¹¢©¹àŒ´Ý<Î [Î’ÚÄÐûͺ˕ìü‚LÄH ¾müËaÛœ±ú½VðÎð šÄÛÅ֜Ɵ,ù|¼Ù[¼™Ì—ÐüÏ™Œ±ü\ÅÒ+ÏÌ´ ,Šܳº<ÏLÆ·l̦ ʤ;Ì!ýµ¿;Ä ¶>¼ÈlË/KÒª;Äù Óçë°­Ñ4*› »Ço¬Æ;ÝÉ-ìÓšlÉ}¬Á@¼Ò’ Èþ•,ÔWÉ=ÉLͪèlÈ€|Ô<ÈA|ÉkÌÈ@Ò.¼ÄÔ[l¿N]Õ“Ǫ«ÈT-ÏP¼¾0ÍšbìÂVÝÔhlÈ’lÑc ÔzŒÁ,ÐH ÆʬÔd½Ós=ÃIÍ׃=Ì´ùÖŸìÅÍÅÆ»ÕtýÔ˜Ô` Öf ÉN ×…íØ1üÔÍÙÊìÈPMÈ£[Ê Ê´Ò®ÀUÛ¾ŒÜ˶\ºÝиL¤6Šº¡ ÅVzЬÛ)½ÚªüÛ¸<¿÷{²›š‹ûЄ©Ü{ÉÜó‰¸Î-˜Ñ—Ó}žâŒšÕ=—¢ªª×mÎÎÙÝÞ=ÑQMÏZ9»]ÙŠÙ]–ñœÚ윺õÜþ°i Þo)ÂpºÐb=ºù}ÄÔ{–ôÝÎÞëÆUàÉÉ›—ÍßïýÕü]¾ó=Þó Ìû; :[¿1ÀëÀ¤úº¢ ÒîÁ[Û-©\Ë"}̱ʹ®Ç>ÛÅìÕ]]̉LË°íÒˆ½ÒÔéàzÚJ Ù™]ÙG½Õ”Ø›Íã)¬ÛC¾Ô™-Ùz}Ðx-´1MÙF¼ÞG ÁY½ÖE¾ãeLÔí㑬Î&›ä„=Â@ ØE~Þ9Žµ"ŽÇc®ÚDÞÑ[¦,ýæ=Žå~-åSŽã6ŽÖ Èc-Ö?îÙ„Ýçš=Ù»מÇwjß`½½=ÔíÔú¬ÖaÞÓôëßxžåbnÄ]þ®éW¾×`.Ç*k¾‡Ý×  ØÌÇgÎé.ê²Mæ?í¿j^ãZNêOêªþ˜x^¦ú;Ó÷{ÌSJÌL¨$NË:«æ,Ü'þá+~ܨÌ‘êÈmܲ¿^Ü<â^ëÀ<ÓuŠá¼þäí]•gkçÄéO;îˆjîGK¶Û¡íž±ÿÞÄïò.œŠm˜áß¼Mʵ‹³4-ìû\ÈL[§ûn¿©{ÊU¬í´šë“™à ¥û­ßr]ðý\Ú×ë×~ ¥:ÝÃ\=ë OÚrIîwì² °_ñâ[òúߌýÇ6NÊU½èX|òsºý»ë6 Ì+²8ØîÚþÃßÎáþL\Ò#¾ÑjÚ³ŒîËíÝè#íƒnæ2ε2¿ä0_è–ÎËåPnÔD®ä*ý絞ð1*ÃFäw=òNè¬Î¿˜Íõu®îdŸöþyéê_ÝÒuÜÄ(ìå|¿ê#÷?çVMÕ îʨmøÂûéVŸÕ¦kÒvïç|®Ò1ù]¯Ùc¼Ù1/çˆþø¯îù{ÎÅ3Ÿ÷¨ïøšÎä ¾ñ4ï—•÷`ÿÚ}ö”mëþöV/é‹Œû.Úïè%ú†öFOé–ÄãAÿò¸òðÌJË7oÊήÚ×ìÓϳ ëpî¯é뻂ªí7mô:ÿÊ…JþªâÏþÊOïâN‹ºôûí ¬õ Ÿ¸r¸÷o¸ùÏ£ôÞ® ˆYš'šª+Ûº/Ë*SÔÌÜû?0(‹Æ#2© în¹Ý2*R«Ö+6;kâtµâÈÎŽM’3ZP÷ÒèØÙ—ÖÒëv%÷ùu? ›`IáË!LÜZâã#äJžŸ &K£ÜLagËaèZ¤éiÖ$TfëXY¦ˆŸ¬ , í­&íÈk+gIœZðh#¨¡°0ãÜðàbé 2£2)ªõ5êžØmw¦7 æ78ymyøyúʨa;ô Ùœ» üûü±Yà=4v¿¶.«~à §Ë[ _ãd‰+ÃPþÁ0â¢å³÷Ž°ŒûŒmd–¨ØÆ"GÂÐV‰ÛÂZèÆ%l™r…Ä+gÊü¥^=Šú,òé³¢;‹ÕHýg²Är._Æti°Í…è&:/g'ŸAq: DïfТbIe‹—Cª gE”™Ö•+©lgy¥·Lš²xÏšQköfÑß½ÇÃGu,âHeÃœq˜1äÈcK6Cœ›Ìš7sîìù3hÍ•GÛ¡<éÔª#›^íú5l£õœŒmû6îÒ³)åîíû÷’ÖÀ‡/ÎB¸ñäÊ#_îüùëæЧS‡,½:öì"¯kïî]ñîßÇ“‡Ä½<úôxÂoSïþýzþNxïoÈùûú÷—ÈÏÿ}þ8`zx`da t9ø̓B8¡„Rx¡…N†jø¡‡!‚8¢ˆ%’x¢‰)¢¸b‡W0¨œ‚þc/Z&#ŽÅÙh9ÞÖ#~ìÕ†ÒR±iIB@±/¬Øâ#q;ªÐBJ(I]/ô”ý\ |µGä†JÔ`‘› qД]â&%šlÄ„tªôžINÁ¦‘t¦USMhõ¥›Fêœ ±£U.ŠPTUÈ™TšL9ZèjpÞù ¥‘Búé Rði©\£RŠ©‡öèR 5Jj« ªĤ°*륨’¦©£¯þúzëJRåŠ$K¤r© —¶êjŬ2°Š“g©ª ›F$Ñ“Vb‹§¨% K“G.»«é5;nQç–T.­èºË¯3¾k›º/°:/¾d±[^½ù^Óo ñú;ð5|° ·ï™,:¬"Ä rø0Å[\1ÆkœqÆ.2<žÂ;2 ÷@²È)oa²w(«¬æ÷Vš‚ËXD+ÄÍ,dKóc½l„ÁžìΗéÙ•‡a;oÍ&È\æ­e*™4&ÝæÌ K}°ÁYÖ™ó.ÞþÛëÑK‹Ûªƒaç‚ì´Z ]§¸1ݼmÓ°ÕM‚ÌŠ6elº€þ*ôZewJŽ×—þ½·§þ 8¨ÂfJ°Ê}mÔDCTPÛ7:%¹åkGŽÞÝ”Ì'‘zÇ*øÔ7Ò¤hå¸*{ÐD|þý¨æŠ³L¦–®šé¥ä›ç‚zï´3:‡€';{\Pƒ^ų½ø<è\™û“óïŸ{;w/_߉:¸b‡‹VöÒþNpи…žêù 3»Ñ?'œ¾»åÿè>c¡?M?þñ>æwðçOlä÷¿2}<à°ð¬1c)šX#èÀ J°‚¼àÛ¤ ÀØøg¢Âý<(Âu…‰6æáôÖWBú …z´ú Š¶&ân ȺáÚPˆ7^âhk™•×®=¹*rÉ‘ýx¨µbõþë\J –2ˆs˜Ž‰BÌ_¼’w¶ðuKPvòœ[’ç3ª®Oi“^cââ<µåðyk ír”Ä’îdžÓ]Jfr¸Ý!/:œOÇ·Aªxfô#•Ã*Ñ2Û£#¿Å9%áqxt»!§9¾\aÒobCÐ÷7$;Æ‘J¾«ä9lÑÇ)Îi§ƒ£ÛöV»·Q Yt$ñ6ôHudy0lS–|õK²å.’Êê•}(GŠˆÐ‚%³Ç¤.Æ.˜ÖÌá%ØÆ-lò .Õãf“®‡Ã³‰Œ‰¤#ÿú†È%ìŠ ¥˜Fé˜;°Ž^îÔa6È,sB}ì’›G¢¦O_È8±bÍ®PñS_‡ªL)*(v£å,Åø¯¦³‡O,¦&ÈÃ%Ωƒ=)aO IH«±Ûûę̈6Ø—ž‚W=“%æyÊÍÞU‹³t’YwÙÑòòzþ… -.3ÙºÀr”iûjµKc©’¶¯³ª s+Då:·•a5-hµª9ÇfWGtÕ)U•²J¿U7¼xœê >Iܲñ6³Ö;V¥ªˆWàž÷¶§8.MC¥§cÍåˆFýkùß9±V’†'6Áç§è)¶!öžó6YÚo…»Éii~ ŒÞeöp² è£U˜.±}ÊÁ0Îpº§Qr$ø(‰GˆâÔhؤ/1(¡Z¸Å"Í”:µæŽ}k`ñÅé-»xÎŒI2õ>¶mÙZkOù*á":Åk¾òŽÇ†Ò™ÂX=ŸýívÁ\⥑g•o\Ó\æ w9›¦+»›¹Ã-Âqþó1t,H<‡UuÃìê‡)ZC~¹p½»-¯lùI!£6¾‘Õër’|CZ·Xko¤ýS\ ÒÙµ°}½åfvÙ\Ò-.uÝ ÈN÷¹” ½¬šCíIWfÉAM+|U­kö¸ŒÈl²ì8éáQ3´Ôb\5ÿÔ`µ/ÁAÆÜ¢íldGkÑ‘n3ŒüåÄŒ±5¶Íf.ó‹Å&ævÌ°-kpãÖ’©qDoüí7v§hìñz·×ßf[{»Iã´³ü&uó LÖ.¯›^›†÷›žs• ‹åâÂLƒ_'IOVûŠ{á¾+žc}a:#v̹8qÞ\éoú°|­þ–b%ÌØý*X®Ÿ1ά@µÃîs7ÅŒhÒ2vŒ·öw-UëéÞ¸;A”þ²œg®ëWYêT„µ¬F¬Z…Ó“ç•=·—5>áÙNýTf†,9‰éêOGÞ!%u¹=»5¥åÓfï5ÚÓNmA†yw:gj·MJA«A^¶<'ãmë´ÿ§ýÌ-PœÜäq;IÁ yšÝZ{åá~ùŸµø¾^G.™=À¦Có åüà‘{ƒõÈ`³÷Á TÛ|œïý× ¯Ë«Oîà ­Š¯Þp)“ó|fÓ:VøñWçz¾ù^Ê]?¨ßûìܨ՚ù,bcÒÝuæ5þ[þöbÇK+'¹Þ§Â_åm5íœìä÷:á'>òù~mršdìi^ØqýVÙÑÝï9Zz_Óc5˜fý¡Üp¨÷ý÷¤ƒÜü–ƒV#- lm0q×ÍŸQàÞ]ßC_ìà“åVª­Nš™©PžðI¨%“µh—•ùÔ¨H߆Õ‡­YMË5E¦MõU ¸D\,]Žá-ß“DŸ°ˆœÌ±M£™  !  á±Úá±Ñ[=Øä8˜^EÞ÷° ý zäé ŠŸ°^ýLšPà>‚ªÀUº…¡ÏÑOña¦Ê¼¥ÂÊK‚hXîÉïˆá!®þŒ ‚žê“èß%^ fb nb»-¢ohA à ‚b(Vbv">™¢%¢âËàab°¢¹bêÁ¢ûÈ"bÐ" Ù¢Çá"ýèâöãø^Ͻ"1r(ö/Ž/ŽY2¦Œ0ŠE3ŠÐ3F£Œ-#6þÜéµPG}ãG…#8Ž£8–#9Þ¡6n#ù¤£:úË4¶ã¼#<ˆ<ÎãÔ£=î>æã}ì#?;þã²ø£@ºAd$BÊA.$y4¤C~DFdwL$Ef‡E^dud¤FNGv$’)$HÆ£HŽ$=–¤IÞ#J¦¤>®$Kö£K¾$@ª¢L¾ËGÖäÉÑ$NŽËMþî$ÓŤO¢GOåm %QƆQet¥Rz‡IìTF¥TN%UV¥U^%Vf¥Vn%Wv¥W~%X†¥XŽ%Y–¥Yž¥UŠZ®%[¶¥[¾%\Æ¥\Î%]Š¥ZÖ%^æ¥^î%_ö¥_òå|L &a¦a&b&¦b.&c6¦c>&dF¦dN&eV¦e^&ff¦fn&g*f`Nh†¦hŽ&i–¦iž&j¦¦j®&k¶¦k¾&lƦlÎ&mÖ¦mÞ&næ¦iRÀ]þ¥oþ&p§p§[òf<'r&§r.'sö¥qÒè&i6'uV§uV§t†fU>'%Dgv‚&\§xŽ'yúåþw†'Ur'T‚¦´§{¾§{|}|fyšegî'ö§þ§eZ%h¢%~¦§Z²g}&¨‚ʧ{„ €}¶gæçX(†f¨†n(fN€€z(€ˆŽ(‰ŽhVV¨Tªç°çƒB¨‹¾(0¨„>h@€à€ ¨…‚å`V©)‘©‘)’&©’.)“6©“>)”F)’hUR)X¥@`%B¥ŠÖ{"@‚®…„Êg}@ŠÀŠÀŽ¢g†åJ©œÎ)Ö©Þ)ž&)•R¥•|¾§ˆnéUvé|©w¶g‹™2è‹êh¸þ(ê›neœæ©¥^*¦fª¦6éžN¥•†èŸfi– ªUJ**{æ¤êh{ʧ,8¨£Bj›N*œRÀ¦Þ*®æª®Ji§J姊* ¶§–r©›¦èN¢®jƒ2(-Ô¨ˆišÎ*­~e¥îªµ^+¶Þj¯F寀Ÿ ë„ë kT¢*²ªê£²i«–À{>*šº«¢F*¹N«VVk¶Þ+¾æ+”nëz‚è•~ëˆ ë¨ëvk|ÊB»’ÀŸ>* @(š*½n'|'ÅV¬Å^,Æ‚(Ÿúë·†j ¬gª†êº@¨N…ÎkÄjƶ¬Ë¾,Ìšæ‡Ö@‰ÖìÇŽkÁ‚Š¬`öçÊö¬Ïö(xîgÎBçÎòìÏ-ÒRgÑvæÐvgÒ>-ÔFm^ªÔV­Õ^-W.¦ ×v­×~-؆­ØŽ-Ù–­Ùž-Ú¦­Ú®-Û¶­Û¾-ÜÆ­ÜÎ-ÝÖ­ÙNÞæ­Þî-ßö­ßþ-à®à.á®á.â&®â..ãâm;hugs98-plus-Sep2006/packages/HaXml/docs/changelog.html0000644006511100651110000003161610504340466021330 0ustar rossross HaXml change log

HaXml change log

Changes in 1.17

  • New: lazier pretty-printer
    • Text.XML.HaXml.ShowXmlLazy
  • Works with ghc-6.6 (changed uses of Data.FiniteMap to Data.Map).
  • A bunch of minor bugfixes.

Changes in 1.16

  • New: lazier parsers
    • Text.XML.HaXml.ParseLazy
    • Text.XML.HaXml.Html.ParseLazy
    • Text.ParserCombinators.PolyLazy
    • Text.ParserCombinators.PolyStateLazy
  • New: lazier tools
    • CanonicaliseLazy
    • XtractLazy
  • New: API call "xmlParseWith"
  • Bugfix: to permit percent character in attribute values.
  • Bugfix: to parse unquoted attribute values starting '+' or '#' in HTML.
  • Bugfix: to keep the original DTD in output of 'processXmlWith'.
  • Bugfixes: to configuration/build systems.
  • Bugfix: DtdToHaskell nows avoids generating types whose names clash with existing (Prelude,HaXml) types

Changes in 1.15

  • New: DrIFT and DtdToHaskell have now both been fully updated to produce instances of XmlContent.
  • New: the parser combinator library Poly has been split into two variations, Poly and PolyState. They have almost the same API, only the latter includes a running state where the former does not.
  • The TextParser library (a replacement for the Haskell'98 Read class) has also been improved with more new combinators. Really, these parser combinator experiments do not belong in HaXml, and will eventually be split out into a separate package.

Changes in 1.14

  • New: Completely replace the Xml2Haskell and Haskell2Xml modules. They are now combined into a single class called XmlContent. This makes the secondary parsing of generic XML trees to typed values more robust, with better error messages, etc. DrIFT and DtdToHaskell are being updated to both produce instances of XmlContent, depending on whether you start from Haskell or from the DTD. (not yet complete)
  • New: a SAX-like stream parser for XML events.
  • Improve the content handling that corresponds to an ANY contentspec. (Now represented as an existential type.)
  • Bugfix: accept attribute values containing the % character, without starting a PERef.
  • Bugfix: for expanding PERefs correctly in entity values.
  • The DTD for SVG (Scalable Vector Graphics) now goes through DtdToHaskell successfully.

Changes for 1.13.1

  • Bugfix: to permit percent character in attribute values.
  • Bugfix: to parse unquoted attribute values starting '+' or '#' in HTML.
  • Bugfix: to keep the original DTD in output of 'processXmlWith'.

Changes for 1.13

  • Bugfixes to the document validator: no more infinite loops.
  • Bugfixes to lexing mixed text and references between quote chars.
  • Support for building with Cabal, and for ghc-6.4's new package format.

Changes for 1.12

  • The licence has changed. Previously covered by the Artistic Licence, we have now converted to the LGPL for all the library code, and GPL for the standalone tools.
  • Now includes a minimal Build.bat script for Windows, so you can avoid any need for Cygwin utilities and get by with just GHC and Mingw.
  • Fix a bug in DtdToHaskell, whereby an auxiliary datatype introduced by the translation into Haskell could (in certain circumstances) cause an extra layer of element tag nesting on the output (via the 'toElem' method).
  • Fixed the parsing of entity/character references in the error-correcting HTML parser.
  • Changes in the signatures of Xml2Haskell (made in version 1.09) have now been mirrored in the converse library, Haskell2Xml. Thus, there are new functions readXml and showXml converting to/from Strings, hGetXml and hPutXml use file Handles, and the old functions using filenames are renamed to fReadXml and fWriteXml.

Changes for 1.11

  • Fix a tiny but embarrassing bug in the previous fix for complex DTDs being translated by DtdToHaskell. It broke on a very simple DTD like
        <!ELEMENT A (B|C)>
    which became sequence
        data A = A B C
    instead of choice
        data A = AB B | AC C

Changes for 1.10

  • All being well, HaXml now works again for Hugs (versions ≥ September 2003). The library sources are installed using hugs-package, and the tools are installed as scripts for runhugs.
  • Fixed the internal (and external) representations of XML character references.
  • New combinators to `escape' and `unescape' reserved XML characters in text and attribute values has been contributed by George Russell. (e.g. to convert "<" into "&lt;".)
  • Bugfixes to DtdToHaskell: A DTD content specification of the form
        <!ELEMENT A (B*,(C|(D?,E*)))>
    was incorrectly translated to the Haskell
        data A = A [B] (OneOf3 C (Maybe D) [E])
    but the new (correct) translation is
        data A = A [B] (OneOf2 C (Maybe D,[E]))

Changes for 1.09

  • ghc-6.0 (and newer) are supported.
  • hmake is no longer required to build HaXml, provided you have ghc --make.
  • A new combinator path has been added to Text.XML.HaXml.Combinators, allowing queries to be expressed in the style of XPath.
  • Some of the signatures in Text.XML.HaXml.Xml2Haskell have changed, in particular, there are new functions readXml and showXml that convert to/from Strings, hGetXml and hPutXml that use file Handles, and the old functions that use filenames are renamed to fReadXml and fWriteXml.
  • DtdToHaskell previously generated incorrect code for reading an XML element given the following DTD fragment: 
    <!ELEMENT foo (a,b)+ >
  • The parser had a fault when reading conditional sections nested inside an IGNORE section in a DTD.
  • In Text.XML.HaXml.Html.Generate, all functions now generate HTML tags in lower-case rather than upper-case, to conform to the XHTML standard.
  • DtdToHaskell now accepts NOTATION types for attributes. They are treated just like enumeration types.
  • If you give an output filename as a command-line argument to DtdToHaskell, it now uses the filename as the basis for the generated module name.
  • Fixed a configuration bug on the Cygwin platform with ghc-5.04.x.
  • make install now places the executables (DtdToHaskell, Xtract, Validate, MkOneOf, Canonicalise) into the directory specified by ./configure --prefix=...

Changes for 1.08a

  • There were some simple import naming problems in some of the demonstration files in the examples/ directory.
  • Embarrassingly, the string value of Text.XML.HaXml.version, previously "1.07", is only now updated to "1.08".

Changes for 1.08

  • A new and highly useful function, Text.XML.HaXml.Validate.partialValidate, does validation except for checking whether the root element type matches that of the DTD's root element. This is just what you need in order to validate any partial document or sub-document.
  • The function Text.XML.HaXml.Html.Generate.htmlprint had a little bug which caused it to loop infinitely if some text was longer than 60 characters without a space.
  • The Xtract parser and combinators are now included in the HaXml library package, rather than existing solely for the Xtract command-line tool.
  • Dependencies in ghc-5.04.x are fixed. You can now build HaXml for a specific compiler version, using e.g. configure --buildwith=ghc-5.0x.x.

Changes for 1.07b

  • The code generated by DtdToHaskell had a minor cut-and-paste error.

Changes for 1.07a

  • The file `script/echo.c' was missing from the distribution. This only affected the configuration step on systems where `echo -n' is not recognised (e.g. Solaris).

Changes for 1.07

  • The hierarchical namespace Text.Xml was incorrect. It should be Text.XML
  • The ghc package now also works in GHCi (but only for ghci-5.02.3 and later).
  • If you have both ghc and nhc98 compilers available, the package is built for both. However, now the configure --buildwith= option is available to choose to build for only one of them.

Changes for 1.06

  • HaXml now uses the new hierarchical namespace for modules, specifically under the tree Text.Xml.HaXml.
  • The HaXml libraries now install as a separate `package' in both ghc and nhc98. Use -package HaXml to access them.
  • The library APIs are now documented using Haddock.
  • Due to popular request, we have added a new validator for checking generic document content against a DTD. This is available both as a library function, and as a command-line tool.
  • DrIFT is now distributed separately by John Meacham, with much better configuration and build support. You still only need it if you want to derive the Haskell2Xml class.
  • Bugfix: the lexer and parser now accept NOTATION declarations in the DTD.
  • Bugfix: a PublicId in a NOTATION decl is now correctly recognised by the keyword PUBLIC, not PUBLICID.
  • Bugfix: the HTML parser now correctly accepts stand-alone tags like IMG.
  • Bugfix: instances of XmlContent now accept an empty string where #PCDATA is expected. Likewise, comments, processing instructions, and character/entity references are now permitted to be scattered thoughout some #PCDATA text.
  • Bugfix: the OneOfN types used in code generated by DtdToHaskell are now supplied by default up to size 20, and a utility for automatically generating larger sizes is included.

I didn't keep detailed changelogs for versions before 1.06, but here are the highlights.

Changes for 1.05

  • In DtdToHaskell, fix some more bugs with empty PE References at the end of an element content specification.

Changes for 1.04

  • In DtdToHaskell, fix a bug whereby an empty PE Reference at the end of an element content specification caused a parse error - the DTD is now accepted.

Changes for 1.03

  • In DtdToHaskell, added tagname prefixes to the attribute names of enumeration types, to disambiguate when attributes of the same name have different value-sets within different tags.
  • DtdToHaskell also now accepts Tokenized and Notation types, mapping them to Strings.
  • Added an instance of Xml2Haskell for the Maybe type.

Changes for 1.02

  • Added instances of Haskell2Xml for Float and Double.
  • Fixed a fault in DtdToHaskell's treatment of default attribute values.
  • Dtd parser now accepts (#PCDATA)* as a valid element content specification.

Changes for 1.01

  • Fixed DtdToHaskell's treatment of default values for attributes.

Changes for 1.00

  • Finally added support for the external subset of DTDs.

Changes for 0.9

  • Reworked the Haskell2Xml and Xml2Haskell modules.

Changes for 0.8b

  • Some minor bugfixes to DrIFT, ensuring H'98 compatibility.

Changes for 0.8a

  • No code changes - just some restructuring of the build tree.

Changes for 0.8

  • Bugfix: some PERefs didn't work.

Changes for 0.7

  • Fixed imports for GHC.

Changes for 0.6

  • Fixed preprocessor symbols to use the new standard __HASKELL98__.

Changes for 0.5

  • Added GE entity reference-handling to parser.
  • Tweaked the pretty-printer.
  • Ensured Haskell'98 compliance.

Changes for 0.4

  • Added separate HTML parser, some other bugfixes.

Changes for 0.3

  • Bugfix release.

Changes for 0.2

  • Added Haskell2Xml and Xml2Haskell.
  • Improved XML parser and printer.

Release 0.1

  • Initial release.
hugs98-plus-Sep2006/packages/HaXml/docs/icfp99.dvi0000644006511100651110000024727010504340456020326 0ustar rossross÷ƒ’À;è TeX output 1999.06.22:1358‹ÿÿÿÿ •ºâ ý? £ þŸŒ÷‘s=óX«Q ff cmr12ºHaskš›¼ell–³/and“XML:“Generic“Com˜binators“or“T˜ypdCe-Based“T‘þÓ4ranslation?ŽŸy”’VÜóKñ`y ó3 cmr10»Malcolm–¦fW‘ÿeallace“and“Colin“RuncimanŽŽŽŽŽŸï#’²²Univ•²!ersit“y–¦fof“Y‘ÿeork,“UKŽŽ ú þ"‘íºâót ‰: cmbx9ÄAbstractŽ©阑íºâóo´‹Ç cmr9¹W‘ÿ:«e–¾£presenš¾9t“t˜w˜o“complemen˜tary“approac˜hes“to“writing“XMLŽ¤ ‘íºâdo•AÇcumen¾9t-pro“cessing–Tapplications“in“a“functional“language.Ž¡‘û:âIn–Úthe“ rst“approac¾9h,‘»the“generic“tree“structure“of“XMLŽ¡‘íºâdoAÇcumen¾9ts–ô«is“used“as“the“basis“for“the“design“of“a“libraryŽ¡‘íºâof–ÔMcom¾9binators“for“generic“proAÇcessing:‘ûíselection,‘áOgeneration,Ž¡‘íºâand–Ttransformation“of“XML“trees.Ž¡‘û:âThe–wsecond“approacš¾9h“is“to“use“a“t˜ypAÇe-translation“frame-Ž¡‘íºâwš¾9ork–,†for“treating“XML‘,KdoAÇcumen˜t“t˜ypAÇe“de nitions“(DTDs)“asŽ¡‘íºâdeclarations–ãžof“algebraic“data“t¾9ypAÇes,‘íand“a“deriv‘ÿ|ration“of“theŽ¡‘íºâcorrespšAÇonding–+jfunctions“for“reading“and“writing“do˜cumen¾9tsŽ¡‘íºâas–Ttš¾9ypAÇed“v‘ÿ|ralues“in“Hask˜ell.ŽŸü‘íºâÄ1Ž‘ý´oIn´CtroK¼ductionŽ¦‘íºâ1.1Ž‘üñDoK¼cumen´Ct–ŒÊmarkup“languagesŽŸÏþ‘íºâ¹XML‘¢(Extensible–žMarkup“Language)“[1Ž‘Ÿþ]“is“a“recen¾9t“sim-Ž¡‘íºâpli cation–û•of“the“older“SGML‘û(Standardised“GeneralisedŽ¡‘íºâMarkup–­3Language)“standard“that“is“widely“used“in“the“pub-Ž¡‘íºâlishing–„äindustry‘ÿ:«.‘kIt“is“a“markup“language,‘àÇmeaning“thatŽ¡‘íºâit–cadds“structural“information“around“the“text“of“a“doAÇcu-Ž¡‘íºâmenš¾9t.‘O:It–{—is“extensible,‘•(meaning“that“the“v˜oAÇcabulary“of“theŽ¡‘íºâmarkup–§is“not“ xed“{“eacš¾9h“doAÇcumen˜t“can“con˜tain“or“refer-Ž¡‘íºâence–žùa“meta-došAÇcumen¾9t,‘¶¥called“a“DTD‘žÛ(Do˜cumenš¾9t“T˜ypAÇe“Def-Ž¡‘íºâinition),‘0¸whic¾9h–+=describAÇes“the“particular“markup“capabilitiesŽ¡‘íºâused.Ž¡‘û:âThe–…Ause“of“XML‘…$is“not“ho•¾9w“ev“er–…Arestricted“to“the“tradi-Ž¡‘íºâtional–Ðidea“of“a“došAÇcumen•¾9t.‘ÉDMan“y–Ðorganisations“are“prop˜osingŽ¡‘íºâto–3¾use“XML‘3„as“an“in•¾9terc“hange–3¾format“for“pure“data“proAÇducedŽ¡‘íºâbš¾9y–©¢applications“lik˜e“graph-plotters,–εspreadsheets,“and‘©¢rela-Ž¡‘íºâtional‘Tdatabases.Ž¡‘û:âHTML‘éŽ(HypAÇer-T‘ÿ:«ext–êIMarkup“Language)“is“one“w¾9ell-Ž¡‘íºâknoš¾9wn–¹ƒexample“of“an“instance“of“SGML‘¹{“ev˜ery“HTMLŽ¡‘íºâdošAÇcumen¾9t–is“an“SGML‘ûdo˜cumen¾9t“conforming“to“a“particu-Ž¡‘íºâlar–oDTD.“Where“XML‘mimpro•¾9v“es›oo“v“er˜SGML‘mis˜in˜remo“vingŽ¡‘íºâshorthand–Pforms“that“require“an“application“to“ha•¾9v“e‘Pkno“wl-Ž¡‘íºâedge–ûHof“a“doAÇcumen¾9t's“DTD.“F‘ÿ:«or“instance,‘4Äin“HTML‘û someŽ¡‘íºâmarkup–T(sucš¾9h“as“a“n˜um˜bAÇered“list)“requires“an“end“mark˜er;Ž¡‘íºâother–à forms“(sucš¾9h“as“paragraphs)“ha˜v˜e“implicit“end“mark˜ersŽ¡‘íºâundersto•AÇo“d–’–when“the“next“similar“form“starts;‘¾+and“y¾9et“otherŽ¡‘íºâmarkup–(sucš¾9h“as“in-line“images)“is“self-con˜tained“and“needsŽ‘íºâŸÀ‰ff_ÿ Ÿ™šŸ÷@ó|{Ycmr8¼T‘ÿJªo–mÂappš¹,‘ÎsandŽ¡’õºâend–…tags“ƹ,‘[Ñwhere“Ætag“¹is“an“arbitrary“name.‘,ThereŽ¡’õºâis–ì×spAÇecial“synš¾9tax“for“an“empt˜y“elemen˜t:‘ËuÆ“¹is“exactlyŽ¡’õºâequiv‘ÿ|ralenš¾9t–×_to“ƹ.‘ÉThe“start“and“end“tags“for“eac˜hŽ¡’õºâelemen•¾9t›«Écon“tain˜a˜tag˜name,‘Àæwhic“h˜iden“ti es˜seman“tic˜infor-Ž¡’õºâmation–‰abAÇout“the“structure,‘Gindicating“ho¾9w“the“enclosed“con-Ž¡’õºâtenš¾9t–Köshould“bAÇe“in˜terpreted.‘ÀUThe“start“tag“ma˜y“also“con˜tainŽ¡’õºâattributes,›‰Éwhic¾9h–fåare“simple“name/v‘ÿ|ralue“bindings,˜pro¾9vidingŽ¡’õºâfurther–Þinformation“abAÇout“the“elemenš¾9t.‘¶Figure“1“sho˜ws“anŽ¡’õºâexample–2XML“došAÇcumen¾9t,‘Ÿillustrating“all“these“comp˜onen¾9ts.Ž¦’õºâÄ1.3Ž’ üñRepresenš´Cting–ŒÊXML“in“Hask˜ellŽŸÏþ’õºâ¹This–papšAÇer“is“ab˜out“pro˜cessing“XML‘Óusing“the“functionalŽ¡’õºâlanguage–ýKHaskš¾9ell.Ÿü-=ó¹Aa¨cmr6½1ŽŽ‘ þû¹MoAÇdern“functional“languages“are“w˜ell-Ž¡’õºâequippšAÇed–}½to“deal“with“tree-structured“data,‘—Øso“one“exp˜ectsŽ¡’õºâthe–‘Òlanguage“to“bšAÇe“a“go˜o˜d“ t“for“the“application.‘‘êEv¾9enŽ¡’õºâso,‘Ò4a–¬nkš¾9ey“issue“is“just“ho˜w“to“represen˜t“doAÇcumen˜ts,‘Ò4and“inŽ¡’õºâparticular–GIhoš¾9w“to“reconcile“the“DTD‘Fúdatat˜ypAÇe“de nitionsŽ¡’õºâincluded–WKin“XML‘WdoAÇcumenš¾9ts“with“the“data“t˜ypšAÇes“that“can“b˜eŽ¡’õºâde ned– ïin“Haskš¾9ell.‘ÊùW‘ÿ:«e“ha˜v˜e“in˜v˜estigated“t˜w˜o“complemen˜taryŽ¡’õºâapproac¾9hes:ŽŸ33’øé"(1)ŽŽŽ’ ºäDe ne–‚an“inš¾9ternal“data“structure“that“represen˜ts“con-Ž¡’ ºätenš¾9ts–©Žof“Åany“¹XML‘©sdo•AÇcumen˜t,‘¿indep“enden˜t–©Žof“all“DTDs.ŽŸ34’øé"(2)ŽŽŽ’ ºäGiv¾9en–\vthe“DTD›\dfor“some“XML˜doAÇcumenš¾9ts“of“in˜terest,Ž¡’ ºäsystematically–#ÏÅderive“¹de nitions“for“inš¾9ternal“Hask˜ellŽ’õºâŸ@‰ff_ÿ Ÿ× ‘ r}Ÿüûró†›Zcmr5°1ŽŽŽ‘YóÙ“ Rcmr7±The–8pXML‘8Mtoš7olkit“from“this“pap˜er“is“aÈãv‘Çailable“on“the“WWW‘8MatŽŸóßCÊscmtt8Éhttp://www.cs.york.ac.uk/fp/HaXml/ŽŽŽŽŽŽŽŒ‹* •ºâ ý? £Ÿéff ý£™š‘íºâ„ffðŽŸ33‘íºâÆŽ¤ ‘íºâŽ¡‘íºâŽ¡‘÷.Time‘¹–OutŽ¡‘÷.Dave–¹–Brubeck“QuartetŽ¡‘÷.Ž¡‘¡:Ž¡‘÷.Ž¡¡‘÷.Ž¡‘÷.Ž¡‘÷.Ž¡‘÷.Ž¡¡‘÷.Ž¡‘¡:Ž¡‘¡:Ž¡‘¡:Ž¡‘¡:Ž¡‘÷.Ž¡¡‘÷.Ž¡‘¡:Ž¡‘¡:Ž¡‘¡:Ž¡‘¡:Ž¡‘¡:Ž¡‘¡:Ž¡‘¡:Ž¡‘÷.Ž¡¡‘÷.Ž¡‘¡:Possibly–¹–the“DBQ's“most“famous“album,Ž¡‘¡:this‘¹–containsŽ¡‘¡:Take“Five,Ž¡‘¡:the–¹–most“famous“jazz“track“of“that“period.Ž¡‘¡:These–¹–experiments“in“different“timeŽ¡‘¡:signatures–¹–are“what“Dave“Brubeck“is“mostŽ¡‘¡:remembered–¹–for.‘ s,Recorded“Jun-Aug“1959Ž¡‘¡:in–¹–NYC.‘ s,See“also“the“sequel,Ž¡‘ fŽ¡‘‡’Time–¹–Further“Out.Ž¡‘÷.Ž¡‘íºâŽŸ33‘…†¹Figure–T1:‘pAn“example“XML“doAÇcumen¾9t.ŽŽ¡‘íºâ„ffðŽŽŽŽ ý€’ ºädata–m@tš¾9ypAÇes“to“represen˜t“them.‘$4These“de nitions“areŽ¤ ’ ºäclosely–Tbased“on“the“spAÇeci c“DTD.ŽŸ33’:âAdv‘ÿ|ran¾9tages–ùof“(1)“include“Ågenericity“¹and“Åfunction-levelŽ¡’õºâscripting¹.‘DÕGeneric–"Ëapplications“handle“a“wide“class“of“XMLŽ¡’õºâdošAÇcumen¾9ts,‘RÐnot–F„just“those“sharing“a“sp˜eci c“DTD.“One“ex-Ž¡’õºâample–RPof“a“completely“generic“application“is“searc¾9hing“doAÇc-Ž¡’õºâumenš¾9ts–u Ø|–¹–CText“StringŽ¦‘íºâ¹Because–?functional“languages“are“go•AÇo“d–?at“proAÇcessing“tree-Ž¡‘íºâstructured–“–data,‘ó&there“is“a“natural“ t“bAÇet•¾9w“een–“–the“XMLŽ¡‘íºâdoAÇcumenš¾9t–Ädomain“and“Hask˜ell“tree“datat˜ypAÇes.‘•In“simpli edŽ¡‘íºâform,‘™Ithe–~åmain“datatš¾9ypAÇes“whic˜h“mošAÇdel“an“XML‘~Êdo˜cumen¾9tŽ¡‘íºâare–7 ÆElement“¹and“ÆContent¹,‘€3whose“de nitions“are“m¾9utuallyŽ¡‘íºârecursivš¾9e,–Ttogether“forming“a“m˜ulti-branc˜h“tree“structure.ŽŸ—ü‘íºâÄThe–ŒÊ lter“t´CypK¼eŽ¦‘¡:Ætype–¹–CFilter“=“Content“->“[Content]Ž¦‘íºâ¹Our–)†basic“t¾9ypšAÇe“for“all“do˜cumen¾9t“pro˜cessing“functions“is“theŽ¡‘íºâÅc‡ontent‘áü lter¹,‘ÞOwhic•¾9h›¶tak“es˜a˜fragmen“t˜of˜the˜con“ten“t˜of˜anŽ¡‘íºâXML‘9—došAÇcumen¾9t–9 (whether“that“b˜e“some“text,‘B³or“a“completeŽ¡‘íºâtagged–p»elemenš¾9t),‘‘§and“returns“some“sequence“of“con˜ten˜t.‘å’TheŽ¡‘íºâresult–³ylist“mighš¾9t“bAÇe“empt˜y‘ÿ:«,‘Ç it“migh˜t“con˜tain“a“single“item,‘Ç orŽ¡‘íºâit–Tcould“con¾9tain“a“large“collection“of“items.Ž¡‘û:âSome–¨ lters“are“used“to“select“parts“of“the“input“doAÇcu-Ž¡‘íºâmen¾9t,‘\xand–N=others“are“used“to“construct“parts“of“the“outputŽ¡‘íºâdoAÇcumenš¾9t.‘ÆTThey–all“share“the“same“basic“t˜yp•AÇe,‘F«b“ecause‘whenŽ¡‘íºâbuilding–±ïa“new“doAÇcumenš¾9t,‘Ùthe“in˜ten˜tion“is“to“re-use“or“ex-Ž¡‘íºâtract–Éšinformation“from“parts“of“the“old“doAÇcumen¾9t.‘9AWhereŽ¡‘íºâthe–óƒresult“of“a“ lter“is“either“empt¾9y“or“a“singleton,‘úFthe“ lterŽ¡‘íºâcan– sometimes“bAÇe“though¾9t“of“as“a“Åpr•‡e“dic“ate¹,‘Odeciding‘ whetherŽ¡‘íºâor–Tnot“to“k¾9eep“its“input.ŽŸ—ü‘íºâÄProgram‘ŒÊwrappK¼erŽ¦‘¡:ÆprocessXMLwith–¹–::“CFilter“->“IO“()Ž¦‘íºâ¹W‘ÿ:«e–!¤assume“a“top-levš¾9el“wrappAÇer“function,‘$·whic˜h“getsŽ¡‘íºâcommand-line–'argumenš¾9ts,‘¿Úparses“an“XML‘e le“in˜to“theŽ¡‘íºâÆContent–Ÿ¹t¾9ypAÇe,›ë±applies“a“ lter,˜and“prett•¾9y-prin“ts–Ÿthe“out-Ž¡‘íºâput–Ò·doAÇcumenš¾9t.‘T™The“giv˜en“ lter“is“applied“to“the“top-lev˜elŽ¡‘íºâenclosing–Telemenš¾9t“of“the“doAÇcumen˜t.ŽŸ—ü‘íºâÄBasic‘C lters‘ ?ü¹A‘Ãcomplete–álist“of“prede ned“ lters“is“sho¾9wnŽ¡‘íºâin–ÝÀFigure“2.‘u³The“simplest“pAÇossible“ lters:‘­HÆnone“¹takš¾9es“an˜yŽ¡‘íºâcon•¾9ten“t–:†and“returns“nothing;‘ÍÆkeep“¹takš¾9es“an˜y“con˜ten˜t“andŽ¡‘íºâreturns–Ì(just“that“item.‘ Algebraically‘ÿ:«,‘ÚËthese“are“the“zero“andŽ¡‘íºâunit‘T lters.ŽŸ33‘øæÈŽŽŽ‘ºäÅPr•‡e“dic“ate–&‰and“sele‡ction“ lters¹.‘ The–ê lter“Æelm“¹is“a“pred-Ž¡‘ºäicate,›‡returning–Cäjust“this“item“if“it“is“an“elemen¾9t,˜orŽ¡‘ºänothing›z otherwise.Ÿü-=½4ŽŽ‘ uC¹Con•¾9v“ersely‘ÿ:«,‘“<Ætxt˜¹returns˜this˜itemŽ¡‘ºäonly–׬if“is“plain“text,Ÿü-=½5ŽŽ‘¨¹and“nothing“otherwise.‘ãThe“ lterŽ¡‘ºäÆchildren–Ÿ¹returns“the“immediate“cš¾9hildren“of“an“elemen˜tŽ¡‘ºäif–Eit“has“anš¾9y‘ÿ:«,‘«Aor“nothing“if“this“con˜ten˜t-item“is“not“anŽ¡‘ºäelemen¾9t.‘ÖThe–û† lter“Ætag‘¹–t“¹returns“this“item“only“if“it“isŽ‘íºâŸ€‰ff_ÿ Ÿ× ‘ r}Ÿüûr°4ŽŽŽ‘Y±The––}shortened“name“Éelm“±wšÈãas“c˜hosen“to“a˜v˜oid“a“clash“with“theŽ¤Standard–±ÈPrelude“function“Éelem±.ŽŸ£Ù‘ r}Ÿüûr°5ŽŽŽ‘Y±F‘ÿZªor–î those“familiar“with“the“detail“of“XML,“en•Èãtit“y–î references“withinŽ¡the–±Èdo7cumenÈãt“are“treated“as“plain“text.ŽŽŽ þìÌÌ þ‰™š’õºâ„ffðŽŸ33’õºâÄPredicatesŽŽ¤ ’¡:Ænone,‘:$Åzer•‡o/failur“eŽŽ¡’¡:Ækeep,‘:$Åidentity/suc•‡c“essŽŽ¡’¡:Æelm,‘>Ý°Åtagge‡d‘NÝ°Åname‡d‘NÝ°Åelement–N“CFilterŽŽ¡’¡:attrval‘0°îÅelement–N“CFilterŽŽ¡¡’õºâÄSelectionŽŽ¡’¡:Æchildren‘+÷XÅchildr‡en–N“CFilterŽŽ¡¡’õºâÄConstructionŽŽ¡’¡:Æliteral,‘+÷XÅbuild–N“CFilterŽŽ¡’¡:mkElem‘5j„Åbuild‘N“[CFilter]“->“CFilterŽŽ¡’¡:mkElemAttrs‘Ê–Åbuild–N“[(String,CFilter)]ŽŽ¡’?°->–¹–[CFilter]“->“CFilterŽŽ¡’¡:replaceTag‘"„,År•‡eplac“e–N“CFilterŽŽ¡’¡:replaceAttrs‘År•‡eplac“e–N“CFilterŽŽ¡Ÿ33’.[¹Figure–T2:‘pBasic“con•¾9ten“t‘T lters.ŽŽ¡’õºâ„ffðŽŽŸšc’ ºäan–lÔelemen¾9t“whose“tag“name“is“the“string“Æt¹.‘"ïThe“ lterŽ¤ ’ ºäÆattr‘¹–a–³“¹returns“this“item“only“if“it“is“an“elemen¾9t“con-Ž¡’ ºätaining–KEthe“attribute“name“Æa¹.‘ÙThe“ lter“Æattrval‘¹–(a,v)Ž¡’ ºä¹returns–À2this“item“only“if“is“an“elemenš¾9t“con˜taining“theŽ¡’ ºäattribute–TÆa“¹with“the“v‘ÿ|ralue“Æv¹.ŽŸf’æÈŽŽŽ’ ºäÅConstruction‘†% lters¹.‘ÒøThe–R,function“Æliteral‘¹–s“¹mak¾9es“aŽ¡’ ºätext›ë&con•¾9ten“t˜con“taining˜just˜the˜string˜Æs¹.‘aThe˜functionŽ¡’ ºäÆmkElem–¹–t“fs–iå¹builds“a“con•¾9ten“t›iåelemen“t˜with˜the˜tag˜Æt¹;Ž¡’ ºäthe–eargumenš¾9t“Æfs“¹is“a“list“of“ lters,‘¹ eac˜h“of“whic˜h“isŽ¡’ ºäapplied–%×to“the“curren¾9t“item,‘i÷and“all“their“results“areŽ¡’ ºäcollected–û}to“bAÇecome“the“cš¾9hildren“of“the“new“elemen˜t.Ž¡’ ºäThe– žfunction“ÆmkElemAttrs–¹–t“avs“fs– ž¹is“just“lik¾9e“ÆmkElemŽ¡’ ºä¹except–q5that“its“extra“parameter“Æavs“¹is“a“list“of“attributeŽ¡’ ºäv‘ÿ|raluesŸü-=½6ŽŽ‘?û¹to–TbAÇe“attac¾9hed“to“the“tag.ŽŸ´/’:âA‘Kuseful–‹ lter“whicš¾9h“in˜v˜olv˜es“bAÇoth“selection“and“construc-Ž¡’õºâtion–|eis“ÆshowAttr‘¹–a¹,‘šûwhic¾9h“extracts“the“v‘ÿ|ralue“of“the“attributeŽ¡’õºâÆa–ÛY¹from“the“currenš¾9t“elemen˜t“and“returns“just“that“string“as“aŽ¡’õºâpiece–Tof“con•¾9ten“t.Ž¡’:âWhen–¦constructing“a“new“doAÇcumen¾9t“(e.g.“the“scriptŽ¡’õºâin–¡sFigure“4“whic¾9h“generates“HTML),“the“ÆmkElem“¹func-Ž¡’õºâtion–àìošAÇccurs“rep˜eatedly–ÿ:«.‘7W“e–àìde ne“and“use“a“small“libraryŽ’õºâŸ 2‰ff_ÿ Ÿ× ‘ r}Ÿüûr°6ŽŽŽ‘Y±Actually‘ÿZª,‘ø®a–ê€list“of“attribute/ lter“pairs.‘8cEacÈãh“ lter“is“applied“toŽ¤the–£FcurrenšÈãt“elemen˜t“and“the“resultan˜t“con˜ten˜t“is“ attened“to“a“stringŽ¡v‘Çalue–±ÈwhicÈãh“is“assigned“to“the“named“attribute.ŽŽŽŽŽŸ’çjã¹3ŽŽŒ‹4 •ºâ ý? £ ý€‘íºâ¹of–0Ôfunctions“sucš¾9h“as“Æhtable¹,–·´Æhrow¹,“and–0ÔÆhcol“¹whic˜h“areŽ¤ ‘íºâjust–*synon¾9yms“for“particular“applications“of“ÆmkElem“¹andŽ¡‘íºâÆmkElemAttrs–@(¹to“di erenš¾9t“tagnames,‘JÝreducing“v˜erbAÇosit˜y“andŽ¡‘íºâmaking–Tthe“syn¾9tax“rather“more“readable.Ž¡‘û:âAlso–߸for“con•¾9v“enience,‘êqw“e–߸de ne“the“new“opAÇerators“Æ?‘ ‘¹andŽ¡‘íºâÆ!‘îï¹as–ŒÒsynonš¾9yms“for“ÆshowAttr“¹and“Æliteral“¹respAÇectiv˜ely:‘Ø/theyŽ¡‘íºâare–sused“in“a“brac•¾9k“eted–spAÇost x“notation,Ÿü-=½7ŽŽ‘>z¹a“st¾9yle“some“pro-Ž¡‘íºâgrammers‘Tprefer.Ž©U‘íºâÄ2.2Ž‘üñCom´CbinatorsŽŸÏþ‘íºâ¹The–€±comš¾9binators“used“as“in˜termediate“coAÇde“in“compilers“canŽ¡‘íºârender–¹programs“`totally“un t“for“h¾9uman“consumption'“[11Ž‘ ?ü]!Ž¡‘íºâHo•¾9w“ev“er,‘¯Ethe–•Áidea“of“a“com¾9binator“library“for“a“spAÇeci c“classŽ¡‘íºâof–œÍapplications“is“to“ac•¾9hiev“e–œÍa“form“of“expression“that“is“nat-Ž¡‘íºâural–ûofor“the“problem.‘ÎA‘ûhcomš¾9binator“library“should“bAÇe“lik˜e“aŽ¡‘íºâlanguage–£Žextension“tailored“to“the“problem“domain“[4Ž‘Ÿþ].‘ÇInŽ¡‘íºâthis–Ø»sense,›äÚfunctional“languages“are“extensible,˜just“as“XMLŽ¡‘íºâitself–)5is“extensible.‘XThe“com¾9binators“are“higher-order“op-Ž¡‘íºâerators–{¼serving“as“`glue'[6Ž‘Ÿþ]“to“assemš¾9ble“functions“in˜to“moreŽ¡‘íºâpAÇo•¾9w“erful›“com“binations.‘ñ W‘ÿ:«e˜aim˜to˜k“eep˜the˜t“yp•AÇes˜of˜comp“o-Ž¡‘íºânenš¾9t–¥°functions“as“uniform“as“pAÇossible“so“that“an˜y“functionŽ¡‘íºâcan–Z3bšAÇe“comp˜osed“with“an¾9y“other.‘ë Within“the“lexical“limitsŽ¡‘íºâof–Þ*the“host“language,‘é2cš¾9hoice“of“notation“should“follo˜w“appli-Ž¡‘íºâcation›ßacon•¾9v“en“tions:‘°‰in˜Hask“ell˜w“e˜can,‘ãwhere˜appropriate,Ž¡‘íºâde ne–Tnew“in x“opšAÇerator“sym¾9b˜ols“for“com¾9binators.Ž¡‘û:âSo,›Ø÷ha¾9ving–~£de ned“some“basic“ lters“already‘ÿ:«,˜in“whatŽ¡‘íºâw•¾9a“ys–©?can“these“usefully“bAÇe“comš¾9bined“in˜to“more“in˜terestingŽ¡‘íºâand–Tcomplex“ lters?‘p(See“Figure“3.)Ž¡‘û:âThe–õmost“impAÇortanš¾9t“and“useful“ lter“com˜binator“is“Æ`o`¹.Ž¡‘íºâW‘ÿ:«e–ѱcall“this“opšAÇerator“Irish“comp˜osition,‘Éfor“reasons“whic¾9hŽ¡‘íºâshould–5fbAÇe“obš¾9vious.‘ÑËIt“plugs“t˜w˜o“ lters“together:‘¬ythe“left“ lterŽ¡‘íºâis–“f“:>“g–™ò¹is“a“functional“c¾9hoice“opAÇerator;Ž¡‘íºâif–»¬the“(predicate)“ lter“Æp“¹is“proAÇductiv¾9e,‘åBthen“the“ lter“Æf“¹isŽ¡‘íºâapplied,‘ìrotherwise–ÁlÆg“¹is“applied.‘ ¸F‘ÿ:«rom“this“is“deriv¾9ed“a“di-Ž¡‘íºârected–¾öcš¾9hoice“opAÇerator:‘o³Æf–¹–|>|“g–¾ö¹giv˜es“either“the“results“ofŽ¡‘íºâÆf¹,–Tor“those“of“Æg“¹only“if“Æf“¹is“unproAÇductiv¾9e.Ž¦‘íºâÄGeneralised–·³P´Cath“Selectors‘ ?ü¹Selection–÷Kof“subtrees“b¾9yŽ¡‘íºâÅp•‡ath‘•œp“atterns–y”¹is“familiar“to“users“of“the“Unix“ le-system,Ž¡‘íºâwhere–X suc¾9h“patterns“are“used“to“access“directory“structure,Ž¡‘íºâusing–z9a“Æ/“¹notation“to“indicate“the“`con¾9taining'“relation.‘è¼Sim-Ž¡‘íºâilar–¹patterns“are“used“in“XSL‘ÿ:«T,“an“XML‘¸–transformationŽ¡‘íºâlanguage–‰[3Ž‘Ÿþ].‘wÁIn“this“connection,‘æ wš¾9e“de ne“t˜w˜o“path“se-Ž¡‘íºâlection–,¥comš¾9binators“Æ/>“¹and“Æ“¹isŽ¡‘íºâan–ýŒ`in¾9terior'“selector,‘Nreturning“the“inner“structure;‘zÆ),‘1ë–Åinterior‘N|)‘1ë–Ådir•‡e“cte“d‘N“CFilter“->“CFilterŽŽ¡¡’ÿ.f–¹–`o`“g‘%Ì°=“concat“.“map“f“.“gŽŽ¡’ÿ.f–¹–|||“g‘%Ì°=“\c->“f“c“++“g“cŽŽ¡’ÿ.f–¹–`with`“g‘Ÿî=“filter“(not.null.g)“.“fŽŽ¡’ÿ.f–¹–`without`“g‘ s,=“filter“(null.g)“.“fŽŽ¡’ÿ.f–¹–/>“g‘*†F=“g“`o`“children“`o`“fŽŽ¡’ÿ.f–¹–|“g‘%Ì°=“f“?>“f“:>“gŽŽ¡¡’ÿ.cat‘;^ÂÅc•‡onc“atenate‘N“CFilterŽŽ¡¡’ÿ.cat–¹–fs‘æX=“\c->“concat.“map“(\f->f“c)“fsŽŽ¡¡’ÿ.et‘@XÅdisjoint‘NCFilter)“->“CFilter“->“CFilterŽŽ¡¡’ÿ.f–¹–`et`“g‘ s,=“(f“`oo`“tagged“elm)ŽŽ¡’7á|>|–¹–(g“`o`“txt)ŽŽ¡¡’ÿ.(?>)‘6¥,Åif-then-else‘N“ThenElse“CFilter“->“CFilterŽŽ¡¡’ÿ.data–¹–ThenElse“a“=“a“:>“aŽŽ¡’ÿ.p–¹–?>“f“:>“g“=“\c->“if“(not.null.p)“cŽŽ¡’Xô0then–¹–f“c“else“g“cŽŽ¡¡’ÿ.chip,‘1ë–Å\in-plac•‡e"›N“CFilterŽŽ¡¡’ÿ.deep–¹–f‘æX=“f“|>|“(deep“f“`o`“children)ŽŽ¡’ÿ.deepest–¹–f“=“(deepest“f“`o`“children)“|>|“fŽŽ¡’ÿ.multi–¹–f‘,Â=“f“|||“(multi“f“`o`“children)ŽŽ¡’ÿ.foldXml–¹–f“=“f“`o`“(chip“(foldXml“f))ŽŽ¡Ÿ33’Vû¹Figure–T3:‘pFilter“com¾9binators“and“their“de nitions.ŽŽ¡’õºâ„ffðŽŽŸ’õºâÄAn–bIediting“com´Cbinator‘ ?ü¹Aside–from“predicates,‘Eëselectors,Ž¤ ’õºâc•¾9hoice,‘¦$and›ŠWconstructiv“e˜ lters,‘¦$there˜is˜one˜v“ery˜useful˜com-Ž¡’õºâbinator–r«whicš¾9h“stands“in“its“o˜wn“category“{“an“editing“com˜bi-Ž¡’õºânator.‘ÛÆchip‘¹–f–”¹proAÇcesses“the“cš¾9hildren“of“an“elemen˜t“in-place:Ž¡’õºâthe–VK lter“Æf“¹is“applied“to“its“c¾9hildren;‘vÆthe“results“are“rebuiltŽ¡’õºâas–Tthe“new“cš¾9hildren“of“that“same“elemen˜t.ŽŸ—ü’õºâÄRecursion‘ ?ü¹It–Ôâis“often“useful“to“express“recursiv¾9e“transfor-Ž¡’õºâmations–Ôkon“XML‘Ô[doAÇcumenš¾9ts:‘ûütransformations“whic˜h“can“bAÇeŽ¡’õºâapplied–Tat“manš¾9y“di eren˜t“lev˜els“of“the“doAÇcumen˜t“tree.Ž¡’:âOne–8yfamily“of“suc¾9h“expressions“is“useful“primarily“in“se-ŽŽŽŽŽŸ’çjã4ŽŽŒ‹OÛ •ºâ ý? £ ý€‘íºâ¹lecting–‘«a“subtree“from“an“arbitrarily“deep“loAÇcation,‘¬althoughŽ¤ ‘íºâthey–¨can“of“course“bAÇe“used“for“editing“and“ ltering“as“w¾9ellŽ¡‘íºâas–selection.‘!The“recursivš¾9e“com˜binator“Ædeep‘¹–f“Åp‡otentialxälyŽ¡‘íºâ¹pushes–Uthe“action“of“ lter“Æf“¹deep“inside“the“doAÇcumen¾9t“sub-Ž¡‘íºâtree.‘NÆIt–& rst“tries“the“givš¾9en“ lter“on“the“curren˜t“item:‘=ÿifŽ¡‘íºâit–xýis“proAÇductiv¾9e“then“it“stops“here,‘‘èbut“if“no“results“are“re-Ž¡‘íºâturned,‘£then–Çit“mo•¾9v“es–Çto“the“c¾9hildren“and“tries“again“recur-Ž¡‘íºâsivš¾9ely‘ÿ:«.‘º¢When–Ÿeused“with“a“predicate,‘Áéthis“strategy“searc˜hesŽ¡‘íºâfor–Éìthe“topmost“matcš¾9hing“elemen˜ts“in“the“tree.‘:9There“areŽ¡‘íºâv‘ÿ|rariations:‘ÊUÆdeepest–lF¹searcš¾9hes“for“the“bAÇottommost“matc˜hingŽ¡‘íºâelemenš¾9ts;‘ ×Æmulti–ºV¹returns“all“matc˜hes,‘ã—ev˜en“those“whic˜h“areŽ¡‘íºâsub-trees–@ of“other“matc•¾9hes.‘œœHo“w“ev“er,›J¼as–@ already“noted,˜theŽ¡‘íºâaction–•øof“these“com¾9binators“is“not“restricted“to“predicates“orŽ¡‘íºâselectors.Ž¡‘û:âAnother›rÀpAÇo•¾9w“erful˜recursion˜com“binator˜is˜ÆfoldXml¹:‘×HtheŽ¡‘íºâexpression–^iÆfoldXml‘¹–f“¹applies“the“ lter“Æf“¹to“evš¾9ery“lev˜el“of“theŽ¡‘íºâtree,‘•æfrom–|/the“lea•¾9v“es›|/up“w“ards˜to˜the˜roAÇot˜(at˜least˜concep-Ž¡‘íºâtually–¿6{“of“course“lazy“ev‘ÿ|raluation“makš¾9es“this“more“ecien˜t).ŽŸ—ü‘íºâÄ2.3Ž‘üñExampleŽŸÏþ‘íºâ¹The–&use“of“these“ lters“and“com¾9binators“is“illustrated“in“anŽ¡‘íºâexample–Y1script“in“Figure“4.‘èThis“program“transforms“anŽ¡‘íºâÆ–|"¹elemenš¾9t“in˜to“an“HTML‘|doAÇcumen˜t“that“pro˜vides“aŽ¡‘íºâformatted–Ü=summary‘ÿ:«.‘q*The“HTML‘Ü output,‘ ÷rendered“b¾9y“theŽ¡‘íºâNetscapAÇe–#Qbroš¾9wser,‘fÐis“illustrated“in“Figure“5.‘FhSuc˜h“a“taskŽ¡‘íºâmigh¾9t–TbAÇe“fairly“common“in“e-commerce“applications.Ž¡‘û:âW‘ÿ:«e–m§noš¾9w“describAÇe“some“of“the“salien˜t“features“of“the“ex-Ž¡‘íºâample.Ž¤33‘¡:Æ(albumf–¹–`o`“deep“(tag“"album"))Ž¡‘íºâ¹The–Û¼script“ rst“searcš¾9hes“recursiv˜ely“for“the“topmost“ele-Ž¤ ‘íºâmen¾9t–ªåtagged“ƹ,‘ÐIbAÇefore“applying“the“ lter“Æalbumf“¹toŽ¡‘íºâit.‘yjTh•¾9us,‘<it›4Rw“orks˜equally˜w“ell˜with˜an“y˜XML‘4Jsource˜doAÇcu-Ž¡‘íºâmenš¾9t–ãÉthat“con˜tains“an“Æ“¹elemen˜t“an˜ywhere“within“it,Ž¡‘íºâand–ÍÂ(correctly)“prošAÇduces“no“output“for“do˜cumenš¾9ts“whic˜h“doŽ¡‘íºânot–Tcon¾9tain“album“data.Ž¡‘û:âThe–ã¼output“doAÇcumenš¾9t's“Æ“¹section“con˜tains“theŽ¡‘íºâartist–3 name“and“album“title“separated“b¾9y“a“colon.‘uœW‘ÿ:«e“noteŽ¡‘íºâthat–Tthe“expression,Ž©33‘¡:Ætxt–¹–`o`“children“`o`“tag“"artist"Ž¡‘‡’`o`–¹–children“`o`“tag“"album"Ž¦‘íºâ¹whicš¾9h–Rygrabs“the“textual“con˜ten˜t“of“the“Æ“¹elemen˜tŽ¡‘íºâwithin–…rthe“Æ“¹elemenš¾9t,‘¡yis“somewhat“un˜wieldy‘ÿ:«.‘lÊMore-Ž¡‘íºâo•¾9v“er–ô¾its“trailing“test“for“the“Æ“¹tag“is“redundan¾9t,‘ûBsinceŽ¡‘íºâthe–@Rcalling“ lter“has“already“pAÇerformed“that“matc¾9h.‘iTheŽ¡‘íºâexpression–Tcan“bAÇe“simpli ed“b¾9y“using“path“selectors“to:Ž¦‘¡:Ækeep–¹–/>“tag“"artist"“/>“txtŽ¦‘íºâ¹and–©this“st¾9yle“is“used“elsewhere“in“the“example.‘ín(The“al-Ž¡‘íºâgebraic–t×laš¾9ws“in“Section“2.5“guaran˜tee“that“this“rewriting“isŽ¡‘íºâsafe.)Ž¡‘û:âSucš¾9h–Ý™expressions“mak˜e“some“assumptions“abAÇout“theŽ¡‘íºâstructure–jof“the“data“within“the“Æ“¹elemen¾9t.‘ãZIn“this“in-Ž¡‘íºâstance,‘c}the–7assumption“is“that“an“Æ“¹elemen¾9t“is“an“im-Ž¡‘íºâmediate–Ücš¾9hild,‘çƒand“that“Åits“¹immediate“c˜hildren“include“text.Ž¡‘íºâIf–ñJsucš¾9h“assumptions“pro˜v˜e“incorrect“for“a“particular“doAÇcu-Ž¡‘íºâmenš¾9t,–Tthe“ lter“is“simply“unproAÇductiv˜e;“no“error“is“ agged.Ž¡‘û:âWith–·Xa“suitable“de nition,‘Ê$Æhbody–¹–=“mkElemAttr“"BODY"Ž¡‘íºâ¹the‘TexpressionŽ¦‘¡:Æhbody‘ s,[("bgcolor",("white"!))]‘,Â[...]ŽŽŽ ý€’õºâ¹can–©©bšAÇe“understo˜o˜d“to“set“the“bac¾9kground“colour“attribute“ofŽ¤ ’õºâthe–²:Æ“¹tag“to“the“literal“v‘ÿ|ralue“Æwhite¹.‘ó#Notice“ho¾9w“theŽ¡’õºâattribute–q2v‘ÿ|ralue“is“itself“describAÇed“b¾9y“a“ lter.‘åºIn“this“case,‘’theŽ¡’õºâ lter–Ÿis“not“v¾9ery“exciting,‘òbut“the“later“de nition“of“ÆmkLinkŽ¡’õºâ¹illustrates–+àthe“generation“of“an“HTML‘+Úreference“b¾9y“loAÇokingŽ¡’õºâup–lvthe“v‘ÿ|ralue“of“a“supplied“Ælink“¹attribute“(using“the“Æ?‘ä&¹ lter).Ž¡’:âWhen– `the“script“is“used“on“the“particular“doAÇcumen¾9tŽ¡’õºâfrom– Figure“1,‘\“the“output“is“a“re-ordering“of“the“in¾9ternalŽ¡’õºâcompAÇonen¾9ts–H¢of“the“input:‘ƒ in“the“Æ“¹part“of“the“out-Ž¡’õºâput,‘“¹section“is“selected“and“transformed“b¾9yŽ¡’õºâÆnotesf–ÕɹbšAÇefore“the“Æ“¹elemen¾9ts“are“pro˜cessed“b¾9yŽ¡’õºâthe–ëbÆsummaryf“¹ lter.‘uAlthough“in“the“absence“of“a“DTD‘ëWit“isŽ¡’õºâimpšAÇossible–-vto“b˜e“sure“of“an¾9y“input“ordering,‘3~the“script“hereŽ¡’õºâensures–Tthat“the“output“ordering“is“consisten¾9t.Ž¡’:âThe–qäde nition“of“the“Ænotesf“¹ lter“is“in¾9teresting“bAÇe-Ž¡’õºâcause–NÛit“makš¾9es“few˜er“assumptions“abAÇout“the“con˜ten˜t“of“aŽ¡’õºâÆ–G ¹structure,‘“{and“in“addition“it“preserv¾9es“the“inputŽ¡’õºâordering.‘„WThe–Lcš¾9hained“if-then-else“c˜hoice“within“the“recur-Ž¡’õºâsivš¾9e–íhÆfoldXml“¹com˜binator“causes“all“in˜ternal“structure“of“theŽ¡’õºâÆ–V‹¹elemenš¾9t“to“bAÇe“retained“except“for“the“replacemen˜tŽ¡’õºâof–{#ƹs“bš¾9y“emphasised“text,‘Ô–and“ƹs“b˜yŽ¡’õºâHTML‘Tlinks.Ž¡’:âOne–&of“the“most“striking“features“of“the“example“as“aŽ¡’õºâwhole–¢ is“hoš¾9w“selection“and“testing“of“old“con˜ten˜t“and“con-Ž¡’õºâstruction–öof“new“con•¾9ten“t–öare“uniform,‘£and“can“bAÇe“com¾9binedŽ¡’õºâalmost‘Tin•¾9terc“hangeably‘ÿ:«.Ž¡’:âW‘ÿ:«e–]ìwill“return“to“the“treatmenš¾9t“of“Æ“¹elemen˜tsŽ¡’õºâin–4)Section“2.4“after“inš¾9troAÇducing“some“extra“Ålab‡elxäling“¹com˜bi-Ž¡’õºânators.ŽŸ]ž’õºâÄ2.4Ž’ üñLabK¼ellingsŽŸÏþ’õºâ¹One–6kfeature“that“is“oAÇccasionally“useful“is“the“abilitš¾9y“to“attac˜hŽ¡’õºâlabAÇels–%]to“items“in“a“sequence,›)`for“instance,˜to“n•¾9um“bAÇer–%]a“listŽ¡’õºâof–¸1items,‘àéor“to“treat“the“ rst/last“item“of“a“list“di eren¾9tlyŽ¡’õºâfrom–Ý¥the“other“items.‘ àF‘ÿ:«or“this“purpAÇose,‘èÈthe“library“pro¾9videsŽ¡’õºâsp•AÇecial›ußlab“elling˜com•¾9binators.‘çIW‘ÿ:«e˜c“hoAÇose˜to˜in“troAÇduce˜a˜newŽ¡’õºât¾9ypAÇe:Ž¤ñ’ÿ.Ætype–¹–LabelFilter“a“=“Content“->“[“(a,Content)“]Ž¡’õºâ¹A‘hÆLabelFilter–h.¹is“likš¾9e“a“ÆCFilter“¹except“it“attac˜hes“a“labAÇelŽ¤ ’õºâto–Ìeacš¾9h“of“its“results.‘@xW‘ÿ:«e“migh˜t“ha˜v˜e“c˜hosen“to“fold“labAÇelŽ¡’õºâv‘ÿ|ralues–@tinside“the“ÆContent“¹t¾9ypAÇe,‘K“LabelFilter“IntŽ¡’ÿ.interspersed–¹–::“a“->“CFilter“->“aŽ¡’‘§8->–¹–LabelFilter“aŽ¡’ÿ.tagged‘!::–¹–CFilter“->“LabelFilter“StringŽ¡’ÿ.attributed‘,Â::–¹–CFilter“->Ž¡’T:šLabelFilter‘¹–[(String,String)]Ž¦’õºâ¹These–àºlabAÇelling“functions“lift“a“ÆCFilter“¹to“the“ÆLabelFilterŽ¡’õºâ¹tš¾9ypAÇe:‘ç¸Ænumbered‘¹–f–zø¹transforms“the“ordinary“ lter“Æf“¹in˜to“aŽ¡’õºânew–H± lter“that“attacš¾9hes“in˜tegers“(from“1“up˜w˜ards)“to“theŽ¡’õºâresults–^of“Æf¹;‘)Æinterspersed–¹–a“f“z–^¹attac¾9hes“the“labAÇel“Æa“¹toŽ¡’õºâall–©øof“the“results“of“Æf“¹except“the“last,‘Ï!whic¾9h“gets“the“labAÇelŽ¡’õºâÆz¹;‘‡AÆtagged‘¹–f–aH¹labAÇels“evš¾9ery“tagged“elemen˜t“with“its“tag“nameŽ¡’õºâ(and–Wnon-elemenš¾9ts“with“the“empt˜y“string);‘ø®Æattributed‘¹–fŽ¡’õºâ¹labAÇels–&¼evš¾9ery“tagged“elemen˜t“with“its“attribute/v‘ÿ|ralue“pairsŽ¡’õºâ(and–Tnon-elemenš¾9ts“with“the“empt˜y“list).ŽŸº ’ÿ.Æ`oo`–¹–::“(a->CFilter)“->“LabelFilter“a“->“CFilterŽŽŽŽŽŸ’çjã¹5ŽŽŒ‹l; •ºâ ý? £Ÿîff ý™™š‘íºâ„ffðŽŸ33‘íºâÆmodule–¹–Main“whereŽ¤ ‘íºâimport‘¹–XmlŽ¡‘íºâmain‘¹–=Ž¡‘÷.processXMLwith–¹–(albumf“`o`“deep“(tag“"album"))Ž¡‘íºâalbumf‘¹–=Ž¡‘÷.htmlŽ¡‘¡:[‘¹–hheadŽ¡‘ f[‘¹–htitleŽ¡‘‡’[–¹–txt“`o`“children“`o`“tag“"artist"Ž¡‘/á`o`–¹–children“`o`“tag“"album"Ž¡‘‡’,–¹–literal“":“"Ž¡‘‡’,–¹–keep“/>“tag“"title"“/>“txtŽ¡‘‡’]Ž¡‘ f]Ž¡‘¡:,–¹–hbody“[("bgcolor",("white"!))]Ž¡‘ f[‘¹–hcenterŽ¡‘ú¾[–¹–h1“[“keep“/>“tag“"title"“/>“txt“]“]Ž¡‘ f,–¹–h2“[“("Notes"!)“]Ž¡‘ f,–¹–hpara“[“notesf“`o`“(keep“/>“tag“"notes")“]Ž¡‘ f,‘¹–summaryfŽ¡‘ f]Ž¡‘¡:]Ž¡‘íºânotesf‘¹–=Ž¡‘÷.foldXml–¹–(txt›8³?>“keep˜:>Ž¡‘!´Ttag–¹–"trackref"“?>“replaceTag“"EM"“:>Ž¡‘!´Ttag–¹–"albumref"“?>“mkLink‘/?Ü:>Ž¡‘!´Tchildren)Ž¡‘íºâsummaryf‘¹–=Ž¡‘÷.htable‘¹–[("BORDER",("1"!))]Ž¡‘¡:[–¹–hrow“[“hcol“[“("Album“title"!)“]Ž¡‘!´T,–¹–hcol“[“keep“/>“tag“"title"“/>“txt“]Ž¡‘!´T]Ž¡‘¡:,–¹–hrow“[“hcol“[“("Artist"!)“]Ž¡‘!´T,–¹–hcol“[“keep“/>“tag“"artist"“/>“txt“]Ž¡‘!´T]Ž¡‘¡:,–¹–hrow“[“hcol“[“("Recording“date"!)“]Ž¡‘!´T,–¹–hcol“[“keep“/>Ž¡‘Zg\tag–¹–"recordingdate"“/>“txt“]Ž¡‘!´T]Ž¡‘¡:,–¹–hrow“[“hcola“[“("VALIGN",("top"!))“]Ž¡‘G[–¹–("Catalog“numbers"!)“]Ž¡‘!´T,‘¹–hcolŽ¡‘+'€[‘¹–hlistŽ¡‘4š¬[–¹–catno“`oo`Ž¡‘BÇnnumbered–¹–(deep“(tag“"catalogno"))Ž¡‘4š¬]Ž¡‘+'€]Ž¡‘!´T]Ž¡‘¡:]Ž¡‘íºâcatno–¹–n“=Ž¡‘÷.mkElem‘¹–"LI"Ž¡‘¡:[–¹–((show“n++".“")!),– s,("label"?),“("number"?)Ž¡‘¡:,–¹–("“("!),– s,("format"?),“(")"!)‘¹–]Ž¡‘íºâmkLink‘¹–=Ž¡‘÷.mkElemAttr–¹–"A"“[“("HREF",("link"?))“]Ž¡‘¡:[–¹–children“]ŽŸ33‘íºâ¹Figure–ÈÞ4:‘ö5An“example“do•AÇcumen¾9t-pro“cessing–ÈÞscript“using“theŽ¡‘íºâgeneric–T lter“com¾9binators.Ž¡‘íºâ„ffðŽŽŽŽ þÀ¨¥ŸØ’õºâï¹s“in“the“example“of“Figure“4:Ž¤33’ÿ.Æcatno–¹–`oo`“numbered“(deep“(tag“"catalogno"))Ž¡’õºâ¹First,‘·Öthe– vdesired“elemen¾9ts“are“extracted“from“their“topmostŽ¤ ’õºâpAÇositions–GÉin“the“tree,‘”fthen“they“are“givš¾9en“n˜umeric“labAÇels,Ž¡’õºâand–B nally“the“Æcatno“¹ lter“incorpšAÇorates“the“lab˜el“in¾9to“someŽ¡’õºâgenerated–Ýætext.‘v'Another“example“can“bAÇe“seen“in“the“de -Ž¡’õºânition–Qiof“the“Æ`et`“¹comš¾9binator“in“Figure“3.‘Я(Æ`et`“¹com˜binesŽ¡’õºâa–C² lter“Æf“¹on“elemen¾9ts“with“a“ lter“Æg“¹on“text.‘§‰Æf“¹pattern-Ž¡’õºâmatcš¾9hes–•against“tagnames“{“the“tagnames“are“extracted“b˜yŽ¡’õºâthe–TlabAÇelling“function“Ætagged¹.)Ž¡’:âF‘ÿ:«urthermore,‘K‡it– }is“pšAÇossible“to“com¾9bine“lab˜ellings.‘ìTheŽ¡’õºâÆ`x`–Óƒ¹comš¾9binator“glues“t˜w˜o“labAÇelling“functions“together,‘à­pair-Ž¡’õºâing–Tthe“labšAÇels“they“pro˜duce.ŽŸ33’ÿ.Æ`x`–¹–::“(CFilter->LabelFilter“a)Ž¡’)´T->–¹–(CFilter->LabelFilter“b)Ž¡’)´T->–¹–(CFilter->LabelFilter“(a,b))ŽŸ—ü’õºâÄ2.5Ž’ üñAlgebraic–ŒÊlaš´Cws“of“com˜binatorsŽŸÏþ’õºâ¹W‘ÿ:«e–õvbrie y“shoš¾9w“ho˜w“com˜binators“are“de ned“in“suc˜h“a“w˜a˜yŽ¡’õºâthat–{+v‘ÿ|rarious“algebraic“laš¾9ws“hold.‘MôThe“complete“set“of“la˜wsŽ¡’õºâis–Tgiv¾9en“in“Figure“6.Ž¡’:âGiving–3all“con•¾9ten“t–3 lters“the“same“t¾9ypAÇe“maximises“theŽ¡’õºâusefulness–äof“com¾9binators“for“plugging“together“functions“ofŽŽŽŽŽŸ’çjã6ŽŽŒ‹‹ë •ºâ ý? £Ÿøff ý…™š‘íºâ„ffðŽŸ33‘‡’ÄIrish‘ŒÊcompK¼ositionŽŽ¤ ‘íºâÆf–¹–`o`“(g“`o`“h)– s,=“(f–¹–`o`“g)“`o`“h‘µBÅasso‡ciativityŽŽ¡‘íºâÆnone–¹–`o`“f‘!=› s,f“`o`“none˜=˜none‘ÎêÅzer‡oŽŽ¡‘íºâÆkeep–¹–`o`“f‘!=› s,f“`o`“keep˜=˜f‘û¬ÅidentityŽŽ¡¡‘‡’ÄGuardsŽŽ¡‘íºâÆf–¹–`with`“keep– s,=“f‘fN¢ÅidentityŽŽ¡‘íºâÆf–¹–`with`“none– s,=“none–¹–`with`“f“=“none‘ ˆ€Åzer‡oŽŽ¡‘íºâÆ(f–¹–`with`“g)“`with`“g– s,=“f–¹–`with`“g‘û¬Åidemp•‡otenc“eŽŽ¡‘íºâÆ(f–¹–`with`“g)“`with`“hŽŽ¡‘&mê=‘ s,(f–¹–`with`“h)“`with`“g‘û¬Åpr‡omotionŽŽ¡‘íºâÆ(f–¹–`o`“g)“`with`“hŽŽ¡‘&mê=‘ s,(f–¹–`with`“h)“`o`“g‘$(nÅpr‡omotionŽŽ¡¡‘íºâÆf–¹–`without`“keep– s,=“none–¹–`without`“fŽŽ¡‘BÇn=‘ s,none‘IõÅzer‡oŽŽ¡‘íºâÆf–¹–`without`“none– s,=“keep‘IõÅidentityŽŽ¡‘íºâÆ(f–¹–`without`“g)“`without`“gŽŽ¡‘‡’=‘ s,f–¹–`without`“g‘N®´Åidemp•‡otenc“eŽŽ¡‘íºâÆ(f–¹–`without`“g)“`without`“hŽŽ¡‘‡’=‘ s,(f–¹–`without`“h)“`without`“g‘ ˆ€Åpr‡omotionŽŽ¡‘íºâÆ(f–¹–`o`“g)“`without`“hŽŽ¡‘‡’=‘ s,(f–¹–`without`“h)“`o`“g‘(âÅpr‡omotionŽŽ¡¡‘‡’ÄP´Cath‘ŒÊselectorsŽŽ¡‘íºâÆf–¹–/>“(g“/>“h)– s,=“(f–¹–/>“g)“/>“h‘-›šÅasso‡ciativityŽŽ¡‘íºâÆnone–¹–/>“f‘Y„=› s,f“/>“none˜=˜none‘û¬Åzer‡oŽŽ¡‘íºâÆkeep–¹–/>“f‘Y„=‘ s,f“`o`“childrenŽŽ¡‘íºâf–¹–/>“keep‘Y„=‘ s,children“`o`“fŽŽ¡‘íºâkeep–¹–/>“keep‘,Â=‘ s,childrenŽŽ¡‘íºânone–¹–“g– s,=“f–¹–/>“g‘N®´Åidemp•‡otenc“eŽŽ¡¡‘íºâÆ(f–¹–/>“g)““(g““h)‘Ÿî=‘ s,g“/>“(f“`o`“h)‘û¬Åpr‡omotionŽŽ¡‘íºâÆ(f–¹–/>“g)“`o`“h‘Ÿî=‘ s,(f“`o`“h)“/>“g‘û¬Åpr‡omotionŽŽ¡‘íºâÆ(f–¹–/>“g)“`with`“h– s,=“f–¹–/>“(g“`with`“h)‘ÎêÅpr‡omotionŽŽ¡‘íºâÆ(f–¹–|“g)“|>|“h– s,=“f–¹–|>|“(g“|>|“h)‘µBÅasso‡ciativityŽŽ¡‘íºâÆkeep–¹–|>|“f‘!=‘ s,keepŽŽ¡‘íºânone–¹–|>|“f‘!=› s,f“|>|“none˜=˜f‘û¬ÅidentityŽŽ¡‘íºâÆf‘æX|>|‘¹–f‘!=‘ s,f‘\ÛvÅidemp•‡otenc“eŽŽ¡¡‘‡’ÄRecursionŽŽ¡‘íºâÆdeep‘¹–keep‘Y„=‘ s,keep‘X!àÅsimpli c‡ationŽŽ¡‘íºâÆdeep‘¹–none‘Y„=‘ s,none‘X!àÅsimpli c‡ationŽŽ¡‘íºâÆdeep‘¹–children– s,=“children‘E;ˆÅsimpli c‡ationŽŽ¡‘íºâÆdeep–¹–(deep“f)– s,=“deep‘¹–f‘N®´Ådepth‘N|“txt“=“txt“|>|“elm“=“keep‘(âÅc‡ompletenessŽŽ¡‘íºâÆelm–¹–`o`“txt“=“txt“`o`“elm“=“none‘(âÅexcl.‘N“¹path“selector“is“assoAÇciativ¾9e“but“ƹ,“Æ|“¹view˜ed“b˜y“itself“ap-Ž¡’õºâpšAÇears–Á@to“b˜e“algebraically“sensible,‘ì:but“it“do˜es“not“seem“toŽ¡’õºâha•¾9v“e–xuseful“algebraic“propAÇerties“in“connection“with“otherŽ¡’õºâcomš¾9binators–;DbAÇecause“of“its“bias“to˜w˜ards“the“left“opAÇerand.Ž¡’õºâThe–É”simpler“result-appšAÇending“com¾9binator“Æ|||“¹could“b˜e“anŽ¡’õºâalternativš¾9e–´Üto“the“directed“c˜hoice“opAÇerator,‘È'and“w˜ould“prob-Ž¡’õºâably–)Ölead“to“more“la¾9ws,‘.öbut“it“has“less“`application“bite'.‘YõAŽ¡’õºâpAÇotenš¾9tially–µÌserious“problem“is“that“the“Æ|||¹-com˜bination“ofŽ¡’õºât•¾9w“o–Tselectors“is“not“necessarily“a“selector.Ž¡’:âThe–ºKrecursion“opAÇerator“Ædeep“¹has“some“minor“la¾9ws,‘ãˆoneŽ¡’õºâof–Éwhicš¾9h,‘bfthe“depth“la˜w,‘bfis“more“profound.‘;ÏW‘ÿ:«e“ha˜v˜e“notŽ¡’õºâyš¾9et–Öfully“in˜v˜estigated“the“propAÇerties“of“Ædeepest¹,–¼Æmulti¹,“andŽ¡’õºâÆfoldXml¹.ŽŸü’õºâÄ3Ž’´oT‘ÿÌranslation–ŒÊof“DTDs“to“T´CypK¼esŽŸ阒õºâ3.1Ž’ üñDTDsŽŸÏþ’õºâ¹So–µVfar“wš¾9e“ha˜v˜e“considered“do•AÇcumen˜t-pro“cessing–µVb˜y“genericŽ¡’õºâtree–´Xtransformations,‘Ǿwhere“markup“is“matc¾9hed“textually“atŽ¡’õºârunš¾9time,‘:^and–2õno“accoun˜t“is“tak˜en“of“an˜y“deepAÇer“meaning“ofŽ¡’õºâtags.Ž¡’:âHo•¾9w“ev“er,‘§¨when–ŒŽ¤ ‘íºâ Øcoverart,‘¹–(catalogno)+,Ž¡‘> Øpersonnel,–¹–tracks,“notes)“>Ž¡‘íºâŽ¡‘íºâŽ¡‘íºâŽ¡‘¡:Ž¡‘íºâŽ¡‘¡:Ž¡‘íºâŽ¡‘¡:Ž¡‘íºâŽ¡‘¡:Ž¡‘íºâŽ¡‘íºâŽ¡‘¡:Ž¡‘íºâŽ¡‘íºâŽ¡‘¡:Ž¡‘íºâŽ¡‘¡:Ž¡‘íºâŽ¡‘¡:Ž¡‘íºâŽ¡‘¡:Ž¡‘íºâ]>ŽŸ33‘*Ž¹Figure–T7:‘pAn“example“DTD.ŽŽ¡‘íºâ„ffðŽŽŸ‘û:âXML‘ §doAÇcumenš¾9t– ìv‘ÿ|ralidators“are“readily“a˜v‘ÿ|railable.‘?8Ho˜w-Ž¤ ‘íºâev•¾9er,‘D9w“e–¥go“further“and“de ne“the“idea“of“Åvalid‘,édo‡cumentŽ¡‘íºâpr•‡o“c“essing¹.‘¨ A‘Dv‘ÿ|ralid–DprošAÇcessing“script“is“one“whic¾9h“pro˜ducesŽ¡‘íºâa–!%v‘ÿ|ralid“doAÇcumenš¾9t“as“output,‘Qügiv˜en“a“v‘ÿ|ralid“doAÇcumen˜t“as“input.Ž¡‘íºâW‘ÿ:«e›Z7ac•¾9hiev“e˜this˜b“y˜demonstrating˜a˜corresp•AÇondence˜b“et•¾9w“eenŽ¡‘íºâthe–@DTD‘?öof“a“doAÇcumen¾9t“and“the“de nition“of“a“set“of“alge-Ž¡‘íºâbraic–¥¸tš¾9ypAÇes“in“Hask˜ell,‘ÉÐand“the“consequen˜t“correspAÇondenceŽ¡‘íºâbšAÇet•¾9w“een–áthe“do˜cumenš¾9t's“con˜ten˜t“and“a“structured“Hask˜ellŽ¡‘íºâv‘ÿ|ralue.‘F#Hence,‘Ñ^bš¾9y–xwriting“doAÇcumen˜t“proAÇcessing“scripts“toŽ¡‘íºâmanipulate–i—the“tš¾9ypAÇed“Hask˜ell“v›ÿ|ralue,‘¾§the“script“v˜alidationŽ¡‘íºâproblem–V”is“just“an“instance“of“normal“Haskš¾9ell“t˜ypAÇe“infer-Ž¡‘íºâence.Ÿü-=½9ŽŽŽŸ—ü‘íºâÄ3.2Ž‘üñDTD‘ŒÊtranslations.ŽŸÏþ‘íºâ¹An–†Ôexample“DTD‘†¯for“the“doAÇcumenš¾9t“sho˜wn“earlier“is“giv˜en“inŽ¡‘íºâFigure–¶ó7.‘üúThe“immediate“features“to“note“are:‘í?(1)“F‘ÿ:«or“ev¾9eryŽ‘íºâŸÀ‰ff_ÿ Ÿ× ‘ r}Ÿüûr°9ŽŽŽ‘Y±W–ÿZªell,‘\nearly!‘j†V“aliditšÈãy–F¬also“encompasses“some“other“minor“c˜hec˜ks,ŽŸfor–±Èinstance“that“IDREF“attributes“mÈãust“b7e“globally“unique.ŽŽŽ ÿZÌÌ þ™š’õºâ„ffðŽŸ33’õºâÆmodule–¹–AlbumDTD“whereŽ¤ ¡’õºâdata–¹–Album“=Ž¡’¡:Album–¹–Title“Artist“(Maybe“Recordingdate)Ž¡’$ú¾Coverart–¹–[Catalogno]“PersonnelŽ¡’$ú¾Tracks‘¹–NotesŽ¡’õºânewtype–¹–Title“=“Title“StringŽ¡’õºânewtype–¹–Artist“=“Artist“StringŽ¡’õºânewtype–¹–Recordingdate“=Ž¡’ATBRecordingdate‘¹–Recordingdate_AttrsŽ¡’õºâdata–¹–Recordingdate_Attrs“=“Recordingdate_Attrs“{Ž¡’¡:date–¹–::“Maybe“String,Ž¡’¡:place–¹–::“Maybe“String“}Ž¡’õºânewtype–¹–Coverart“=“Coverart“(String,“Maybe“Location)Ž¡’õºânewtype–¹–Location“=“Location“Location_AttrsŽ¡’õºâdata–¹–Location_Attrs“=“Location_Attrs“{Ž¡’¡:thumbnail–¹–::“Maybe“String,Ž¡’¡:fullsize‘ s,::–¹–Maybe“String“}Ž¡’õºânewtype–¹–Catalogno“=“Catalogno“Catalogno_AttrsŽ¡’õºâdata–¹–Catalogno_Attrs“=“Catalogno_Attrs“{Ž¡’¡:label–¹–::“String,Ž¡’¡:number–¹–::“String,Ž¡’¡:format–¹–::“Maybe“Format,Ž¡’¡:releasedate–¹–::“Maybe“String,Ž¡’¡:country–¹–::“Maybe“String“}Ž¡’õºâdata–¹–Format“=“CD“|“LP“|“MiniDiscŽ¡’õºânewtype–¹–Personnel“=“Personnel“[Player]Ž¡’õºânewtype–¹–Player“=“Player“Player_AttrsŽ¡’õºâdata–¹–Player_Attrs“=“Player_Attrs“{Ž¡’¡:name–¹–::“String,Ž¡’¡:instrument–¹–::“String“}Ž¡’õºânewtype–¹–Tracks“=“Tracks“[Track]Ž¡’õºânewtype–¹–Track“=“Track“Track_AttrsŽ¡’õºâdata–¹–Track_Attrs“=“Track_Attrs“{Ž¡’¡:title–¹–::“String,Ž¡’¡:credit–¹–::“Maybe“String,Ž¡’¡:timing–¹–::“Maybe“String“}Ž¡’õºânewtype–¹–Notes“=“Notes“(Maybe“String,“[Notes_])Ž¡’õºâdata–¹–Notes_“=Ž¡’¡:Notes_Str‘¹–StringŽ¡’ÿ.|–¹–Notes_Albumref“AlbumrefŽ¡’ÿ.|–¹–Notes_Trackref“TrackrefŽ¡’õºânewtype–¹–Albumref“=“Albumref“(String,String)Ž¡’õºânewtype–¹–Trackref“=“Trackref“(Maybe“String,String)ŽŸ33’øC]¹Figure–T8:‘pThe“example“DTD“translated“to“Haskš¾9ell“t˜ypAÇes.ŽŽ¡’õºâ„ffðŽŽŸ’õºâelemenš¾9t,‘KÆthere– °is“a“spAÇeci cation“of“allo˜w˜ed“inner“elemen˜tsŽ¤ ’õºâ(ÆELEMENT‘òŹdeclaration),‘*hand–òþpšAÇossibly“also“a“sp˜eci cation“ofŽ¡’õºâallo•¾9w“ed–vÚattribute“v‘ÿ|ralues“(ÆATTLIST‘vÁ¹declaration).‘A(2)“F‘ÿ:«or“in-Ž¡’õºâner›²ãcon•¾9ten“t,‘Æ”the˜grammar˜allo“ws˜sequence˜(commas),‘Æ”c“hoiceŽ¡’õºâ(v•¾9ertical› bar),‘Koptionalit“y˜(question˜mark),‘Kand˜repAÇetitionŽ¡’õºâ(star–‚ or“plus).‘b(3)“Where“the“inner“con•¾9ten“t–‚ declaration“al-Ž¡’õºâloš¾9ws–àæfree“text“(Æ#PCDATA¹),“c˜hoice“bAÇet˜w˜een“text“and“other“ele-Ž¡’õºâmenš¾9ts–Òis“pAÇermitted,‘Sbut“sequencing“of“those“elemen˜ts“is“notŽ¡’õºâpAÇermitted.‘íç(4)–‰ºIn“attribute“lists,‘¥¦some“v‘ÿ|ralues“are“mandatoryŽ¡’õºâ(Æ#REQUIRED¹)‘i]and–iµsome“are“optional“(Æ#IMPLIED¹);“attributeŽ¡’õºâv‘ÿ|ralues–#ƒcan“either“bAÇe“unconstrained“strings“(ÆCDATA¹)‘#Eor“a“mem-Ž¡’õºâbAÇer–Tof“some“pre-de ned“set“of“string“v‘ÿ|ralues.Ž¡’:âThere–v¨seem“to“bšAÇe“some“ob¾9vious“corresp˜ondences“b˜et•¾9w“eenŽ¡’õºâthis–/‹vš¾9ery“restricted“form“of“t˜ypAÇe“language“and“the“ric˜her“t˜ypAÇeŽŽŽŽŽŸ’çjã8ŽŽŒ‹ µÕ •ºâ ý? £ ý€‘íºâ¹language–9 of“Hask•¾9ell.‘‡ÕEac“h›9 elemen“t˜declaration˜is˜roughlyŽ¤ ‘íºâspšAÇeaking–­1a“new“datat¾9yp˜e“declaration.‘ùºSequence“is“lik¾9e“pro˜d-Ž¡‘íºâuct–å tš¾9ypAÇes“(i.e.“single-constructor“v‘ÿ|ralues).‘ XChoice“is“lik˜e“sumŽ¡‘íºâtš¾9ypAÇes–è=(i.e.“m˜ulti-constructor“v‘ÿ|ralues).‘•*Optionalit˜y“is“just“aŽ¡‘íºâÆMaybe›T¹t¾9yp•AÇe.‘pRep“etition˜is˜lists.Ž¡‘û:âAš¾9ttribute–Álists“also“ha˜v˜e“a“translation:‘-IbAÇecause“theyŽ¡‘íºâare–“sunordered“and“accessed“bš¾9y“name,‘²ûHask˜ell“named- eldsŽ¡‘íºâlošAÇok–åclik¾9e“a“go˜o˜d“represen•¾9tation.‘ŒOptionalit“y–åccan“again“b˜eŽ¡‘íºâexpressed–5Ras“ÆMaybe“¹t•¾9ypAÇes.‘|iA“ttribute–5Rv‘ÿ|ralues“that“are“con-Ž¡‘íºâstrained–°to“a“particular“v‘ÿ|ralue-set“can“bšAÇe“mo˜delled“b¾9y“de n-Ž¡‘íºâing–~a“new“enš¾9umeration“t˜ypšAÇe“encompassing“the“p˜ermittedŽ¡‘íºâstrings.Ž©—ü‘íºâÄ3.3Ž‘üñImplemen´CtationŽŸÏþ‘íºâ¹These–~1rules“are“formalised“in“the“appAÇendix“(Figure“9).‘WAnŽ¡‘íºâimplemen¾9tation–‰•of“these“rules“(with“some“additional“rules“toŽ¡‘íºâeliminate–ýredundancy)“translated“the“DTD‘ýin“Figure“7“in¾9toŽ¡‘íºâthe–THaskš¾9ell“t˜ypAÇe“declarations“sho˜wn“in“Figure“8.Ž¡‘û:âAlso–0needed,›kalong“with“the“t¾9ypAÇe“declarations,˜are“func-Ž¡‘íºâtions–‘dwhicš¾9h“read“and“write“v‘ÿ|ralues“of“these“t˜ypAÇes“to“and“fromŽ¡‘íºâactual–ÊSXML‘Ê@doAÇcumen¾9ts.‘pThese“are“generated“automaticallyŽ¡‘íºâfrom–JYthe“t¾9ypAÇe“declarations“alone.‘»Using“an“appropriate“setŽ¡‘íºâof–eïpre-de ned“tš¾9ypAÇe“classes,‘‰w˜e“deriv˜e“a“new“instance“for“eac˜hŽ¡‘íºâgenerated–Tt¾9ypšAÇe“using“a“to˜ol“lik¾9e“DrIFT“[16Ž‘ ?ü].Ž¦‘íºâÄ3.4Ž‘üñDiscussionŽŸÏþ‘íºâ¹Although–÷Cthis“t¾9ypšAÇe-based“translation“lo˜oks“straigh•¾9tforw“ard,Ž¡‘íºâit–Tturns“out“that“there“are“sevš¾9eral“tric˜ky“issues.Ž¡‘û:âFirst,‘´Ùthe–”òtš¾9ypAÇe“translation“ma˜y“only“use“datat˜ypAÇes“andŽ¡‘íºânewt•¾9ypšAÇes,‘¤nev“er‘Çt“yp˜e›Çsynon“yms.‘&ÊThis˜is˜a˜result˜of˜needingŽ¡‘íºâto–ewrite“v‘ÿ|ralues“out“as“XML‘&{“a“tš¾9ypAÇe“synon˜ym“in“Hask˜ellŽ¡‘íºâis–Tcindistinguishable“from“the“t¾9ypAÇe“it“abbreviates,‘¤&but“theŽ¡‘íºâgenerated–Ûétš¾9ypAÇes“m˜ust“bšAÇe“distinct“in“order“to“b˜e“able“toŽ¡‘íºâre-in¾9troAÇduce–â«enclosing“start“and“end“tags“with“the“correctŽ¡‘íºâmarkup.Ž¡‘û:âA‘´…separate–´®tš¾9ypAÇe“is“in˜troAÇduced“for“eac˜h“collection“of“at-Ž¡‘íºâtributes.‘ö&Hence,‘Úµan–³;elemenš¾9t“is“represen˜ted“b˜y“a“pairing“ofŽ¡‘íºâthe–òZattributes“and“the“con•¾9ten“t.‘ÇWhere–òZa“tagged“elemen¾9t“di-Ž¡‘íºârectly–Qmconš¾9tains“an“optional“t˜ypAÇe“or“a“sequence“of“t˜ypAÇes“whic˜hŽ¡‘íºâare–ɳthemselvš¾9es“sum-t˜ypAÇes,‘ØÔit“is“necessary“to“in˜terpAÇose“a“sep-Ž¡‘íºâarate–XHaskš¾9ell“t˜ypAÇe,‘aØe.g.“ÆNotes“¹con˜tains“a“Æ[Notes_]“¹whereŽ¡‘íºâthe–Tauxiliary“tš¾9ypAÇe“ÆNotes_“¹has“three“alternativ˜es.Ž¡‘û:âNaming–ÍÚis“a“big“issue.‘Case“matters“in“XML,“so“a“ÆŽ¡‘íºâ¹di ers–Åàfrom“a“Æ“¹and“attribute“Æattr“¹di ers“from“ÆAttr¹.Ž¡‘íºâIn–<"Haskš¾9ell“ho˜w˜ev˜er,‘EÖt˜ypAÇes“m˜ust“bšAÇegin“with“upp˜er-case,‘EÖandŽ¡‘íºâ eld-names–_Emš¾9ust“bAÇegin“with“lo˜w˜er-case.‘úBWhere“auxiliaryŽ¡‘íºâtš¾9ypAÇes–"Ïare“necessary‘ÿ:«,‘f-w˜e“ha˜v˜e“c˜hosen“to“appAÇend“an“under-Ž¡‘íºâscore–K\c¾9haracter“to“the“name.‘¾‰All“of“these“factors“impAÇoseŽ¡‘íºârestrictions–ñÿon“the“use“of“this“translation,‘ùdue“to“the“pAÇoten-Ž¡‘íºâtial–Tname“con icts.Ž¡‘û:âF‘ÿ:«urthermore,‘i½there–¿Cis“a“mismatcš¾9h“bAÇet˜w˜een“Hask˜ell'sŽ¡‘íºânamed–g~ elds“and“the“attribute“naming/scoping“rules“inŽ¡‘íºâXML.–0yIn“XML,“di erenš¾9t“elemen˜ts“ma˜y“ha˜v˜e“attributes“ofŽ¡‘íºâthe–”‡same“name“and“tš¾9ypAÇe,‘®Jwhereas“Hask˜ell's“named“ elds“areŽ¡‘íºârestricted–ú†to“use“within“a“single“tš¾9ypAÇe.‘ÌA‘úJsystem“of“t˜ypAÇedŽ¡‘íºâextensible–Trecords“[5Ž‘Ÿþ]“wš¾9ould“bAÇe“a“m˜uc˜h“bAÇetter“ t.Ž¡‘û:âDespite–Öthese“problems“in“expressing“DTDs“within“theŽ¡‘íºâHask•¾9ell›rÐt“ypAÇesystem,‘Ê/the˜latter˜is˜v“ery˜m“uc“h˜more˜pAÇo“w“er-Ž¡‘íºâful–ìthan“DTDs“{“for“instance,‘aÒDTDs“ha•¾9v“e–ìno“notion“ofŽ¡‘íºâpšAÇolymorphism.‘[LIndeed,‘Úthere–Ôóare“frequen¾9t“o˜ccasions“whenŽ¡‘íºâDTD‘alwriters–aÂresort“to“textual“macrosŸü-=½10ŽŽ‘ 7¹to“indicate“moreŽ‘íºâŸ€‰ff_ÿ Ÿ× ‘ ]Ÿüûr°10ŽŽŽ‘Y±That–±Èis,“parameter“en•Èãtit“y‘±Èreferences.ŽŽŽ ý€’õºâ¹detailed–µöstructuring“than“DTDs“pšAÇermit“(including“p˜olymor-Ž¤ ’õºâphism–Ãand“quali ed“t•¾9yping),‘Fzev“en–Ãthough“suc¾9h“implicit“struc-Ž¡’õºâturing–¤cannot“bšAÇe“v‘ÿ|ralidated“b¾9y“XML‘£ñto˜ols.‘ȶIt“is“signi can¾9tŽ¡’õºâto–±Çnote“the“XML‘±Ÿcomm•¾9unit“y's–±Çrecognition“of“these“limita-Ž¡’õºâtions–ú§of“DTDs“{“recen¾9t“propAÇosals“for“ÅschemasŸü-=½11ŽŽ‘ Ïõ¹address“theŽ¡’õºâquestion–Tof“ricš¾9her“t˜yping“in“a“more“disciplined“manner.Ž¡’:âOne–GÛarea“in“whicš¾9h“the“t˜ypAÇe“system“of“Hask˜ell“in“partic-Ž¡’õºâular–#(as“oppAÇosed“to“other“functional“languages)“is“exploitedŽ¡’õºâis–âÉtš¾9ypAÇe“classes.‘„ÏThis“systematic“o˜v˜erloading“mec˜hanism“isŽ¡’õºâvš¾9ery–Tuseful“for“coAÇdifying“the“I/O“con˜v˜ersions.ŽŸü’õºâÄ4Ž’´oPros–ŒÊand“cons“of“the“t•´Cw“o‘ŒÊsc“hemesŽŸ阒õºâ4.1Ž’ üñCom´CbinatorsŽŸÏþ’õºâ¹Compared–d;with“the“mainstream“solution“for“XML‘d'proAÇcess-Ž¡’õºâing,‘­_namely–[Änew“domain-spAÇeci c“languages“for“expressingŽ¡’õºâand–‹pscripting“transformations,‘§the“comš¾9binator“approac˜h“hasŽ¡’õºâsev•¾9eral‘Tadv‘ÿ|ran“tages:Ž©—ü’õºâÄEase–Ìkof“extension“and“v‘ÿh‰ariation‘ ?ü¹Scripting‘*ñlanguagesŽ¡’õºâsometimes–ÔÑlacš¾9k“useful“facilities,‘°or“pro˜vide“them“in“con˜v˜o-Ž¡’õºâluted›½¬w•¾9a“ys.–ÿ8Extending˜the˜language˜is˜dicult.“A‘½–com¾9bina-Ž¡’õºâtor‘<.library‘ÿ:«,›gho•¾9w“ev“er,˜can–<.bAÇe“enlarged“comparativš¾9ely“straigh˜t-Ž¡’õºâforw¾9ardly–^À{“the“de nitions“are“accessible,‘ƒEand“most“are“shortŽ¡’õºâand‘Tsimple.Ž¦’õºâÄComputational‘«pK¼o•´Cw“er‘ ?ü¹Scripting–ªdlanguages“tend“to“o erŽ¡’õºâeither–p¸a“vš¾9ery“limited“expression“language,‘‡’or“a“hoAÇok“in˜to“aŽ¡’õºâprogramming–ÌÞsystem“at“a“completely“di erenš¾9t“lev˜el“of“ab-Ž¡’õºâstraction.‘þBut–»Ùif“XML‘»®scripts“are“programs“in“a“languageŽ¡’õºâsucš¾9h–ñkas“Hask˜ell,‘ø™the“full“pAÇo˜w˜er“of“the“nativ˜e“language“is“im-Ž¡’õºâmediately‘Ta¾9v‘ÿ|railable.Ž¦’õºâÄAbstraction,‘ÀSgeneralit´Cy–5and“reuse‘ ?ü¹Almost–7Xan¾9y“patternŽ¡’õºâošAÇccurring–5—in“a“com¾9binator“program“can“b˜e“isolated“and“de-Ž¡’õºâ ned–Mcas“a“separate“re-usable“idea“[6Ž‘Ÿþ].‘ÙÊThis“also“applies“at“theŽ¡’õºâapplication–·úlev¾9el,‘ʦwhere“common“ideas“from“similar“applica-Ž¡’õºâtions–Eæmighš¾9t“easily“bAÇe“de ned“in“a“higher-lev˜el“library‘ÿ:«.‘®'ThisŽ¡’õºâform–VTof“re-use“makš¾9es“program“dev˜elopmen˜t“m˜uc˜h“quic˜k˜erŽ¡’õºâand–Tless“error-prone.Ž¦’õºâÄLa´Cws–úXfor“reasoning“abK¼out“scripts‘ ?ü¹The–t|seman¾9tics“of“aŽ¡’õºâscripting–•language“are“often“de ned“b¾9y“illustration.‘3So“itŽ¡’õºâis–}#hard“to“reason“with“con dence“abAÇout“the“meanings“ofŽ¡’õºâscripts.‘X½Is–~Ãó5ùž" cmmi9ÇA“¹just“a“st¾9ylistic“v‘ÿ|rariation“of“ÇB‘ñx¹or“are“there“in-Ž¡’õºâputs–for“whicš¾9h“the“t˜w˜o“could“giv˜e“di eren˜t“results?‘É^But“whenŽ¡’õºâthe–´fseman¾9tics“of“scripts“can“bAÇe“de ned“in“terms“of“the“equa-Ž¡’õºâtions–æfor“the“comš¾9binators,‘?‹propAÇerties“suc˜h“as“assoAÇciativit˜yŽ¡’õºâand–Tdistribution“can“often“bAÇe“demonstrated“simply‘ÿ:«.Ž¦’õºâÄImplemen´Ctation–|for“free‘ ?ü¹DoAÇes–(|a“scripting“language“ha•¾9v“eŽ¡’õºâan›6in•¾9teractiv“e˜in“terpreter?–~¦A›6compiler?“A˜t•¾9ypAÇe-c“hec“k“er?‘~¦AŽ¡’õºâpro ler?‘þAll–º6these“things“are“immediately“a¾9v‘ÿ|railable“to“XMLŽ¡’õºâscripts–Tdirectly“expressed“as“Hask¾9ell“programs.Ž’õºâŸ@‰ff_ÿ Ÿ× ‘ ]Ÿüûr°11ŽŽŽ‘YÉhttp://www.w3.org/TR/xmlschema-1–±È±for“structures,ŽŸand–±ÈÉhttp://www.w3.org/TR/xmlschema-2“±for“datatÈãyp7es.ŽŽŽŽŽŸ’çjã¹9ŽŽŒ‹ ÍC •ºâ ý? £ ý€‘íºâ¹Of–Tcourse,“there“are“disadv‘ÿ|ran¾9tages“toAÇo.Ž©é'‘íºâÄDistance–Þófrom“target“language‘ ?ü¹XSL‘ÿ:«T‘~1[3Ž‘Ÿþ]–~Whas“the“prop-Ž¤ ‘íºâert¾9y–ôthat“a“script“is“an“expression“in“the“target“language:Ž¡‘íºâit–ö¥uses“exactly“the“XML‘öksynš¾9tax“for“building“new“con˜ten˜t.Ž¡‘íºâComš¾9binator-based–iscripts“m˜ust“use“a“di eren˜t“syn˜tax“dueŽ¡‘íºâto–Fthe“underlying“language.‘:EThe“linguistic“gap“migh¾9t“causeŽ¡‘íºâconfusion–Tand“increase“learning“costs.Ž¦‘íºâÄLiving–——in“an“unfamiliar“w´Corld‘ ?ü¹Com¾9binator‘ýprogramsŽ¡‘íºâÅlo‡ok‘¯žlike–h·¹scripts“in“a“small“domain-spAÇeci c“language.‘âæW‘ÿ:«ritersŽ¡‘íºâma¾9y–bšAÇe“b˜eguiled“bš¾9y“this“apparen˜t“simplicit˜y‘ÿ:«,‘Emak˜e“a“small“er-Ž¡‘íºâror,‘ˆand–d¼drop“inš¾9to“an“unkno˜wn“corner“of“Hask˜ell.‘á“ErrorŽ‘ Omes-Ž¡‘íºâsages–Ž_maš¾9y“bAÇe“incomprehensible,‘¬¡or“w˜orse,‘¬¡the“script“migh˜tŽ¡‘íºâw¾9ork–Tbut“do“something“utterly“strange.Ž¦‘íºâÄ4.2Ž‘üñT´CypK¼e-based‘ŒÊtranslationŽŸÏþ‘íºâ¹Some–‰of“the“adv‘ÿ|ranš¾9tages“of“the“fully-t˜ypAÇed“represen˜tation“ofŽ¡‘íºâXML–TdoAÇcumenš¾9ts“ha˜v˜e“already“bAÇeen“men˜tioned.Ž¦‘íºâÄV‘ÿÌalidit´Cy‘ ?ü¹The–çabilit¾9y“for“the“system“to“spAÇot“errors“auto-Ž¡‘íºâmatically‘ÿ:«,›ÆÂnot–³just“in“the“data,˜but“in“the“program,˜and“alsoŽ¡‘íºâto›Tprev•¾9en“t˜the˜generation˜of˜incorrect˜doAÇcumen“t˜markup.Ž¦‘íºâÄDirect–9Iprogramming“st´Cyle‘ ?ü¹F‘ÿ:«unctional–gÙlanguages“en-Ž¡‘íºâcourage–œßthe“use“of“pattern-matc¾9hing“(binding“v›ÿ|ralues“to“v˜ari-Ž¡‘íºâables)–+Mon“the“left-hand-side“of“equations.‘^[Ho•¾9w“ev“er,‘pËusingŽ¡‘íºâhigher-order–vQcom¾9binators,‘Îdata“structures“tend“not“to“bAÇeŽ¡‘íºâmen¾9tioned–T•in“equations“at“all.‘Ú3The“DTD‘TCtranslation“ap-Ž¡‘íºâproacš¾9h– õis“m˜uc˜h“more“in“k˜eeping“with“the“pattern-bindingŽ¡‘íºâst•¾9yle,‘˜whic“h–©sometimes“leads“to“shorter“programs!‘âWhereasŽ¡‘íºâwith–çucomš¾9binators,‘ýit“is“sometimes“necessary“to“re-tra˜v˜erseŽ¡‘íºâthe–MGsame“selection“path“with“sligh¾9t“v‘ÿ|rariations,‘[Cthe“pattern-Ž¡‘íºâbinding–Tgiv¾9es“direct“access“for“free.ŽŸ9ó‘íºâDisadv‘ÿ|ran¾9tages‘Tare:Ž¦‘íºâÄHigh–ëstartup“cost‘ ?ü¹Before–èscripting“doAÇcumen¾9t“transfor-Ž¡‘íºâmations,›ä=it–ºÜis“necessary“to“acquire,˜c•¾9hec“k,˜and–ºÜproAÇcess“theŽ¡‘íºâDTD.–ÔAlthough“the“generation“of“Haskš¾9ell“t˜ypAÇes“is“auto-Ž¡‘íºâmated,‘Åhfew–nþpšAÇeople“are“familiar“enough“with“DTDs“to“b˜eŽ¡‘íºâable–ý to“start“using“them“immediately‘ÿ:«.‘ÓšThey“require“care-Ž¡‘íºâful– ?study“and“understanding“bšAÇefore“correct“scripts“can“b˜eŽ¡‘íºâwritten–Tand“the“initial“in•¾9v“estmen“t–Tof“e ort“pa¾9ys“o .Ž¦‘íºâÄIncomplete–ít´CypšK¼e“mo˜del‘ ?ü¹The–ŠŸgrammar“of“DTDs“is“smallŽ¡‘íºâand–RŸrestrictivš¾9e“compared“to“the“sophisticated“t˜ypAÇe“systemsŽ¡‘íºâaš¾9v‘ÿ|railable–˜±in“functional“languages.‘¦‡Better“means“of“t˜ypAÇe-Ž¡‘íºâspAÇeci cation–)in“XML‘(Öare“still“under“dev•¾9elopmen“t.‘WËIn‘)theŽ¡‘íºâmean¾9time,‘O there–Nis“little“scopšAÇe“for“using“the“full“p˜o•¾9w“er‘NofŽ¡‘íºâfeatures–Tlik¾9e“pAÇolymorphism.ŽŸá'‘íºâÄ5Ž‘ý´oRelated‘ŒÊW‘ÿÌorkŽŸ阑íºâXML‘­ ProK¼cessing‘ ?ü¹There–1`are“infan¾9t“proAÇcessing“languagesŽ¡‘íºâsurrounding–TXML.“Of“most“in¾9terest“here“are:ŽŸË;‘øæÈŽŽŽ‘ºä¹XSL›ÿ:«T‘ž[3Ž‘Ÿþ]–ž±(eXtensible“St¾9yle“Language“for“T˜ransforma-Ž¡‘ºätion)–ß„is“a“W3C-propAÇosed“declarativ¾9e“language“for“ex-Ž¡‘ºäpressing–a“limited“form“of“transformations“on“XML‘ÌdoAÇc-Ž¡‘ºäumen•¾9ts,‘Ñîoriginally›¬5in“tended˜for˜rendering˜to˜a˜la“y“out-Ž¡‘ºäbased–¾format,›AØe.g.‘í­HTML,“P¾9ostScript,˜etc.,˜but“no¾9wŽ¡‘ºäwidely–Tused“for“XMLÈ!¹XML“transformations.ŽŽŽ ý€’æÈŽŽŽ’ ºä¹DSSSL‘Žø[12Ž‘ ?ü]–Y(DoAÇcumenš¾9t“St˜yle“Seman˜tics“and“SpAÇeci -Ž¤ ’ ºäcation–NøLanguage)“is“a“mature“ISO‘N§standard“with“noŽ¡’ ºäcomplete–Û implemen¾9tations.‘m‘It“is“similar“in“essence“toŽ¡’ ºäXSL‘ÿ:«T,–—but“deals“with“full“SGML‘Âjinput,‘íèand“is“basedŽ¡’ ºäon‘TSc¾9heme.ŽŸ33’:âNot– manš¾9y“functional“language“researc˜hers“are“visibly“en-Ž¡’õºâgaged–1kin“XML-related“wš¾9ork,‘_but“t˜w˜o“other“toAÇolkits“for“XML-Ž¡’õºâproAÇcessing–aßare“Christian“Lindig's“XML‘aËparser“in“O'CamlŸü-=½12ŽŽŽ¡’õºâ¹and–]éAndreas“Neumann's“v‘ÿ|ralidating“XML‘]Öparser“in“SMLŸü-=½13ŽŽ‘ÕN¹.Ž¡’õºâT‘ÿ:«o–'our“knoš¾9wledge,‘+neither“of“these“pro˜vides“transformationŽ¡’õºâcapabilities–7åin“either“a“comš¾9binator“st˜yle“or“a“t˜ypAÇe-translationŽ¡’õºâstš¾9yle.‘ú¼Philip–°8W‘ÿ:«adler“has“written“a“short“formal“seman˜tics“ofŽ¡’õºâXSL–Tselection“patterns“[15Ž‘ ?ü].Ž©—ü’õºâÄApplication-based‘õµcom´Cbinators‘ ?ü¹P¾9arsing–-'is“the“mostŽ¡’õºâextensivš¾9ely–studied“application“for“com˜binator“libraries.Ž¡’õºâSince–Žõthe“original“treatmenš¾9t“b˜y“Burge“[2Ž‘Ÿþ],‘­]there“ha˜v˜e“bAÇeenŽ¡’õºâmanš¾9y–ÿv‘ÿ|rariations“on“the“theme.‘*rSwierstra“and“DupAÇonc˜heel'sŽ¡’õºâmetho•AÇd›¥incorp“orating˜on-the- y˜grammar˜analysis˜andŽ¡’õºâerror-correction–€Eis“a“notable“recen¾9t“example“[10Ž‘ ?ü].‘]BW‘ÿ:«e“hopAÇeŽ¡’õºâit–Ìma¾9y“bšAÇe“p˜ossible“to“incorp˜orate“DTD-analysis“in“our“com-Ž¡’õºâbinators–Tin“a“similar“st¾9yle.Ž¡’:âAlthough–manš¾9y“other“libraries“of“application“com˜bina-Ž¡’õºâtors›Pha•¾9v“e˜bAÇeen˜devised,‘wythe˜general˜design˜principles˜for˜suc“hŽ¡’õºâlibraries–£jare“scarcely“referred“to“in“the“literature.‘ƳHughes'Ž¡’õºâexpAÇosition–-#of“a“design“for“prett•¾9y-prin“ting›-#com“binators˜[7Ž‘Ÿþ]˜isŽ¡’õºâa–´vunique“resource“in“this“respAÇect,‘ÇÖand“wš¾9e“ha˜v˜e“y˜et“to“exploitŽ¡’õºâit‘Tfully‘ÿ:«.Ž¦’õºâÄT‘ÿÌree-pro•K¼cessing‘‚•op“erators‘ ?ü¹An–.earlier“v¾9ersion“of“this“pa-Ž¡’õºâpšAÇer–­prompted“more“than“one“p˜oinš¾9ter“to“the“w˜ork“of“EelcoŽ¡’õºâVisser–‘ðand“colleagues“[13Ž‘ ?ü].‘’CTheir“motiv‘ÿ|rating“application“isŽ¡’õºâspAÇeci cation–ü–extension“simpli es“v‘ÿ|rarious“tree-proAÇcessing“tasks,Ž¡‘íºâand–{éalso“hoš¾9w“it“can“bAÇe“translated“in˜to“standard“Hask˜ell.Ž¡‘íºâThis–óWwš¾9ork“could“pro˜vide“one“compAÇonen˜t“of“a“h˜ybrid“solu-Ž¡‘íºâtion,‘ïNwith–åÌDTD-spAÇeci c“represen¾9tation“Åand“¹generic“forms“ofŽ¡‘íºâtra•¾9v“ersal–Tand“matc¾9hing.Ž¡‘û:âVisser–ŽCet.“al.“[13Ž‘ ?ü]“also“discuss“sevš¾9eral“other“approac˜hes“toŽ¡‘íºâthe–Ttree“transformation“problem.ŽŸü‘íºâÄ6Ž‘ý´oConclusions–ŒÊand“F›ÿÌuture“W˜orkŽŸ阑íºâ¹In–9)our“expAÇerience,‘‚Haskš¾9ell“is“a“v˜ery“suitable“language“forŽ¡‘íºâXML‘:×proAÇcessing.‘ÞF‘ÿ:«or–;#generic“applications,‘„—a“small“set“ofŽ¡‘íºâcom¾9binators–Ô2designed“with“algebraic“propAÇerties“in“mind“canŽ¡‘íºâb•AÇe› Óp“o•¾9w“erful˜enough˜and˜ exible˜enough˜to˜describAÇe˜a˜fullŽ¡‘íºârange–:of“selection,–R³testing,“and–:construction“opAÇerations“inŽ¡‘íºâa–÷uniform“framew¾9ork.‘ ÁF‘ÿ:«or“applications“where“the“DTDŽ¡‘íºâis–éÙ xed,‘^ùa“tošAÇol“deriving“corresp˜onding“t¾9yp˜es“and“asso˜ci-Ž¡‘íºâated–»ƒI/O›»Xroutines“turns“XML˜proAÇcessing“inš¾9to“Hask˜ell“pro-Ž¡‘íºâgramming›¨6o•¾9v“er˜t“ypAÇed˜data˜structures,‘¾ and˜the˜Hask“ell˜t“ypAÇe-Ž¡‘íºâc•¾9hec“k“er–Tv‘ÿ|ralidates“scripts.Ž¡‘û:âHo•¾9w“ev“er,›¨)there–W™is“plen•¾9t“y–W™of“scopAÇe“for“further“w¾9ork,˜inŽ¡‘íºâsev¾9eral‘Tdirections:ŽŸ—ü‘íºâÄGeneralitš´Cy–y“of“com˜binators‘ ?ü¹Though–âýwš¾9e“ha˜v˜e“had“gen-Ž¡‘íºâeralitš¾9y–èas“a“design“aim“for“our“presen˜t“com˜binator“libraryŽ¡‘íºâthere–Tis“scopAÇe“for“generalising“it“further.ŽŸ33‘øæÈŽŽŽ‘ºäÅWider‘;\functionality.‘"¹Most›_con•¾9ten“t˜ lters˜in˜our˜cur-Ž¡‘ºären¾9t– [library“are“either“pure“selectors“(with“results“thatŽ¡‘ºäare–º”sequences“of“sub-trees“from“the“full“doAÇcumen¾9t“tree)Ž¡‘ºäor–Z1pure“constructors“(creating“doAÇcumenš¾9t“con˜ten˜t“fromŽ¡‘ºäv‘ÿ|ralues–$£of“other“t¾9ypšAÇes).‘J\The“design“could“usefully“b˜eŽ¡‘ºäextended–to“include“a“more“general“class“of“Ådeletion“¹op-Ž¡‘ºäerations–îªin“whic¾9h“sub-trees“can“bAÇe“thinned“and“prunedŽ¡‘ºäin–ðov‘ÿ|rarious“w•¾9a“ys.‘$More–ðogeneral“still“are“com¾9binators“forŽ¡‘ºäÅeš‡diting–,ôand“tr˜ansforming¹,‘DIwhere–±some“of“the“ideas“inŽ¡‘ºäVisser's–Tw¾9ork“could“usefully“bAÇe“transferred.Ž©34‘øæÈŽŽŽ‘ºäÅMultiple–±¿inputs“and“outputs.‘aN¹An–žin¾9teresting“extensionŽ¡‘ºäof–Ã,single-doAÇcumenš¾9t“scripting“is“the“handling“of“m˜ulti-Ž¡‘ºäple›< do•AÇcumen¾9ts.‘ÔPro“ducing˜more˜than˜one˜output˜do“c-Ž¡‘ºäumenš¾9t–«$is“no“great“problem.‘ù But“it“is“far“more“c˜halleng-Ž¡‘ºäing–ê¤to“design“appropriate“com¾9binators“for“dealing“withŽ¡‘ºäsev¾9eral‘Tinputs.Ž¦‘øæÈŽŽŽ‘ºäÅMor•‡e›ïgener“al˜typ“es.‘)b¹The–ÄOlabAÇelling“scš¾9heme“has“pro˜v˜edŽ¡‘ºäuseful–¤Òfor“some“applications,‘ȱbut“the“need“for“a“sepa-Ž¡‘ºärate–¡9ÆLabelFilter“¹t¾9ypšAÇe“is“a“blemish.‘õ¼W‘ÿ:«e“hop˜e“to“gener-Ž¡‘ºäalise–xôthe“ÆCFilter“¹t¾9ypšAÇe“to“incorp˜orate“ÆLabelFilter“¹asŽ¡‘ºäa–SspšAÇecial“case.‘ÖöBy“making“the“ÆCFilter“¹t¾9yp˜e“paramet-Ž¡‘ºäric–« it“mighš¾9t“ev˜en“bšAÇe“p˜ossible“to“incorp˜orate“the“t¾9yp˜e-Ž¡‘ºätranslation–Œof“DTDs“within“the“comš¾9binator“framew˜ork.ŽŸ—ü‘íºâÄEciency–Êof“com´Cbinators‘ ?ü¹The–(Ùcurrenš¾9t“com˜binator“li-Ž¡‘íºâbrary–‘|is“quite“usable,‘°†but“here“are“some“pAÇossible“routes“toŽ¡‘íºâgreater‘Teciency‘ÿ:«.ŽŸ33‘øæÈŽŽŽ‘ºäÅAÃŽlgebr‡aic‘ðùnormalisation–Æl¹So“far“wš¾9e“ha˜v˜e“merely“estab-Ž¡‘ºälished–ûuthat“la¾9ws“hold,‘týand“ošAÇccasionally“app˜ealed“toŽ¡‘ºäthem–H€when“writing“scripts.‘Ø)The“implemen¾9tation“simplyŽ¡‘ºäde nes–„êthe“comš¾9binators“b˜y“their“spAÇecifying“equations.ŽŽŽ ý€’ ºäInstead,‘¾#laš¾9ws–¨Wcould“bAÇe“exploited“at“the“implemen˜tationŽ¤ ’ ºälev•¾9el.‘ ÇF‘ÿ:«ollo“wing–àYHughes“[7Ž‘Ÿþ],‘êòwš¾9e“ha˜v˜e“in“mind“an“imple-Ž¡’ ºämenš¾9tation–Ï›that“automatically“reduces“all“com˜binationsŽ¡’ ºäto–…§a“Ånormal‘Ê6form¹,‘¢dthat“is“the“least“expAÇensivš¾9e“equiv‘ÿ|ralen˜tŽ¡’ ºäcomputationally‘ÿ:«.Ž©34’æÈŽŽŽ’ ºäÅSp•‡ac“e-ecient‘Qkformulation–/`¹Some“lazy“functional“pro-Ž¡’ ºägrams–Ï‹that“proAÇcess“trees“in“pre-order“left-to-righ¾9t“fash-Ž¡’ ºäion–†úcan“bAÇe“form¾9ulated“to“run“in“log(N)‘†›space.‘qcTheŽ¡’ ºäpart–8of“the“tree“that“is“held“in“memory“correspAÇonds“toŽ¡’ ºäa–[path“from“the“rošAÇot“to“some“no˜de“that“is“curren¾9tlyŽ¡’ ºäthe–µOfoAÇcus“of“computation:‘ìnto“the“left“are“`garbage'“sub-Ž¡’ ºätrees–áalready“proAÇcessed,‘što“the“righ¾9t“are“subtrees“notŽ¡’ ºäy•¾9et›){ev‘ÿ|raluated.‘XåHo“w“ev“er,‘.…our˜curren“t˜com“binators˜ha“v“eŽ¡’ ºänot–¸ebAÇeen“formš¾9ulated“to“guaran˜tee“this“sort“of“space“bAÇe-Ž¡’ ºäha•¾9viour,‘ev“en–Šin“fa•¾9v“ourable–Šcases.‘#This“problem“migh¾9tŽ¡’ ºäbAÇe–Ttacš¾9kled“b˜y“the“normalisation“approac˜h.Ž¦’æÈŽŽŽ’ ºäÅDTD-awar•‡e‘+‡c“ombinators–¹¹The“currenš¾9t“com˜binator“li-Ž¡’ ºäbrary–just“ignores“DTDs.‘ 0£Com¾9binators“that“main-Ž¡’ ºätain–RDTD‘Rinformation“migh¾9t,›aPfor“example,˜ac•¾9hiev“e‘RfarŽ¡’ ºämore–oDecienš¾9t“searc˜h“in“some“cases“b˜y“pruning“branc˜hesŽ¡’ ºäbšAÇound–}$to“fail.‘éµThey“could“also“b˜e“used“to“pro˜duce“ rst-Ž¡’ ºäclass–†ŸXML‘†{doAÇcumen¾9ts“as“the“results“of“queries,‘£*not“justŽ¡’ ºäraš¾9w–‚€extracts“of“unkno˜wn“t˜ypAÇe.‘cõAs“w˜e“ha˜v˜e“alreadyŽ¡’ ºänoted,‘~äDTDs–6”could“pšAÇerhaps“b˜e“attac¾9hed“as“lab˜els“inŽ¡’ ºäthe–Þsense“of“Èx¹2.4:‘5either“as“explicit“v‘ÿ|ralues“or“implicitlyŽ¡’ ºäin–Tt¾9ypAÇe“information.ŽŸ—ü’õºâÄRelations›rrbK¼et•´Cw“een˜DTDs‘ ?ü¹As– wš¾9e“ha˜v˜e“seen,‘Q&in“the“DTD-Ž¡’õºâdirected–Èapproacš¾9h“with“kno˜wn“ xed“DTDs“for“input“and“out-Ž¡’õºâput,‘: v‘ÿ|ralidation–ÿ€translates“to“static“t•¾9ypAÇe-c“hec“king;‘t—whereasŽ¡’õºâgeneric–×ôcom¾9binators“could“in“principle“acquire“and“computeŽ¡’õºâDTDs–ðûdynamically‘ÿ:«.‘¯eThese“represen¾9t“extremes“with“disad-Ž¡’õºâv‘ÿ|ranš¾9tages–±•of“in exibilit˜y“on“the“one“hand“and“some“insecu-Ž¡’õºâritš¾9y– jon“the“other.‘½²There“are“man˜y“other“w˜a˜ys“of“handlingŽ¡’õºârelations›TbAÇet•¾9w“een˜DTDs.‘pF‘ÿ:«or˜example:ŽŸ33’æÈŽŽŽ’ ºäÅPolymorphic–d and“higher-or‡der“scripts.‘ ë&¹The‘Z;genericŽ¡’ ºäapproac•¾9h›Ï w“ould˜gain˜securit“y˜if˜one˜could˜Åinfer˜¹aŽ¡’ ºäDTDÈ!¹DTD‘pšfunction.‘å•By–pÄanalogy“with“functional“pro-Ž¡’ ºägrams–\»it“is“then“natural“to“assign“scripts“pAÇolymorphicŽ¡’ ºäand–uýhigher-order“DTDs,‘•Ümaking“explicit“their“degree“ofŽ¡’ ºägenericit¾9y‘ÿ:«.Ž¦’æÈŽŽŽ’ ºäÅInclusion›““b•‡etwe“en˜DTDs.‘þϹThis–`Éhas“bAÇeen“implicitly“as-Ž¡’ ºäsumed–ªalready‘ÿ:«,‘¿èbut“has“practical“impAÇortance“in“its“o¾9wnŽ¡’ ºärigh•¾9t.‘UAs›}ŠstoAÇc“k˜DTDs˜are˜re ned,‘×—XML‘}-doAÇcumen“tsŽ¡’ ºäwill–®inhabit“a“hierarc•¾9h“y–®of“spAÇecialisation.‘ú Givš¾9en“sev˜eralŽ¡’ ºäsimilar–afDTDs,‘…cone“wš¾9ould“lik˜e“to“deriv˜e“a“DTD‘a8for“a“vir-Ž¡’ ºätual–?¬common“roAÇot“(inš¾9tersection)“or“common“descenden˜tŽ¡’ ºä(union).‘rØThis–2!gošAÇes“w¾9ell“b˜eyš¾9ond“the“abilities“of“curren˜tŽ¡’ ºätš¾9ypAÇe-inference–)µsystems,‘.Îbut“w˜ould“mak˜e“a“useful“addi-Ž¡’ ºätion–Tto“our“functional“tošAÇolkit“for“XML“pro˜cessing.ŽŸü’õºâÄAc•´Ckno“wledgemen“tsŽŸ阒õºâ¹Canon–ÖgResearcš¾9h“Cen˜tre“(EuropAÇe)“Ltd.‘_©suggested“this“lineŽ¡’õºâof–¦¹]˜]Ž’`®=Ž’r?Ænewtype–¹–Ëm“Æ=ŽŽ¡’„þ—Ëm–¹–Æ(Ëm‘‘$‰ffÕÂŽ›fæÆAttrs,“Ëm‘‘$‰ffÕÂŽ˜Æ)ŽŽ¡’r?newtype–¹–Ëm‘‘$‰ffÕÂŽ‘ |Æ=“ÈDAǹ[–þuV[Ëspec¹]“]‘¹–ËmŽŽ¡’Ÿ,a¹where‘TËm–¹–¹=“ÈM¹[–þuV[Æn¹]“]ŽŽ¡’û!IÈT‘Nî¹[‘þuV[ƹ]‘þuV]Ž’`®=Ž’r?Ædata–¹–Ëm‘‘$‰ffÕÂŽ‘fæÆAttrs“=ŽŽ¡’{‹kËm‘‘$‰ffÕÂŽ‘fæÆAttrs–¹–Èf“F‘对[–þuV[Åde‡clŸÿÿÌ0ŽŽ‘V¹]“]ŽŽ¡’¡XÆ,‘T¹.–Šª.“.ŽŽ¡’¡XÆ,ÈF‘对[–þuV[Åde‡clŸÌkŽŽ‘†¹]“]‘¹–ÈgŽŽ¡’Ÿ,a¹where‘TËm–¹–¹=“ÈM¹[–þuV[Æn¹]“]ŽŽ¡’r?ÈA¹[–þuV[Åde‡clŸÿÿÌ0ŽŽ‘V¹]“]ŽŽ¡’r?.–Šª.“.ŽŽ¡’r?ÈA¹[–þuV[Åde‡clŸÌkŽŽ‘†¹]“]ŽŽ¡¡’5ÍôÄRHS–ŒÊof“t´CypK¼e“declarationsŽŽ¡’û!IÈDAǹ[‘þuV[(ÇxŸÿÿ½0Ž–*§Ç;›ŠªxŸÿÿ½1Ž“Ç;˜:˜:˜:Ž‘ ßú;˜xŸó;Îcmmi6ÀkŽ‘—¹)]‘þuV]ÇmŽ’`®¹=Ž’r?ÈC‘f¹[–þuV[Çm‘TxŸÿÿ½0Ž‘Ê¥Ç:–Šª:“:Ž‘5IxŸÀkŽ‘—¹]“]ŽŽ¤ (’~ ¿ÈDAÇŸü-=óq¡% cmsy6Ã0Ž›óŽ¹[–þuV[ÇxŸÿÿ½0Ž‘*§¹]“]‘TÈDAÇŸü-=Ã0Ž˜¹[“[ÇxŸÿÿ½1Ž‘*§¹]“]‘ŸþÇ:–Šª:“:Ž‘ ¢ÈDAÇŸü-=Ã0Ž˜¹[“[ÇxŸÀkŽ‘—¹]“]ŽŽ¡’û!IÈDAǹ[›þuV[(ÇxŸÿÿ½0Ž–*§ÈjÇxŸÿÿ½1Ž“Èj–ŠªÇ:“:“:Ž‘ ßúÈjÇxŸÀkŽ‘—¹)]˜]ÇmŽ’`®¹=Ž’xBçÈC‘f¹[–þuV[Çm›TxŸÿÿ½0Ž‘*§¹]“]˜ÈDAÇŸü-=Ã0Ž‘óŽ¹[“[ÇxŸÿÿ½0Ž‘*§¹]“]ŽŽ¡’r?Æ|–TÈC‘f¹[›þuV[Çm“xŸÿÿ½1Ž‘*§¹]˜]“ÈDAÇŸü-=Ã0Ž‘óŽ¹[˜[ÇxŸÿÿ½1Ž‘*§¹]˜]ŽŽ© ’r?Æ|‘T¹.–Šª.“.ŽŽ¡’r?Æ|–TÈC‘f¹[›þuV[Çm“xŸÀkŽ‘—¹]˜]“ÈDAÇŸü-=Ã0Ž‘óŽ¹[˜[ÇxŸÀkŽ‘—¹]˜]ŽŽ¡’û!IÈDAǹ[–þuV[(Çx¹)?]“]ÇmŽ’`®¹=Ž’r?ÆMaybe‘TÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[Çx¹]“]ŽŽ¡’û!IÈDAǹ[–þuV[(Çx¹)+]“]ÇmŽ’`®¹=Ž’r?ÆList1‘TÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[Çx¹]“]ŽŽ¡’û!IÈDAǹ[–þuV[(Çx¹)ȹ]“]ÇmŽ’`®¹=Ž’r?Æ[›TÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[Çx¹]“]˜Æ]ŽŽ¦’û!IÈDAǹ[–þuV[Çx¹]“]ÇmŽ’`®¹=Ž’r?ÈC‘f¹[–þuV[Çm‘Tx¹]“]ŽŽ¦¦’< -ÄInner–ŒÊt´CypK¼e“expressionsŽŽ¡’û!IÈDAÇŸü-=Ã0Ž‘óŽ¹[‘þuV[(ÇxŸÿÿ½0Ž–*§Ç;›ŠªxŸÿÿ½1Ž“Ç;˜:˜:˜:Ž‘ ßú;˜xŸÀkŽ‘—¹)]‘þuV]Ž’`®=Ž’r?Æ(›TÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[ÇxŸÿÿ½0Ž‘*§¹]“]˜Æ,˜ÈDAÇŸü-=Ã0Ž‘óŽ¹[“[ÇxŸÿÿ½1Ž‘*§¹]“]ŽŽ¡’~ ¿Æ,‘TÇ:–Šª:“:Ž‘øÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[ÇxŸÀkŽ‘—¹]“]‘TÆ)ŽŽ¡’û!IÈDAÇŸü-=Ã0Ž‘óŽ¹[›þuV[(ÇxŸÿÿ½0Ž–*§ÈjÇxŸÿÿ½1Ž“Èj–ŠªÇ:“:“:Ž‘ ßúÈjÇxŸÀkŽ‘—¹)]˜]Ž’`®=Ž’r?Æ(OneOfŸÿÿÀnŽ‘ HßÈDAÇŸü-=Ã0Ž›óŽ¹[–þuV[ÇxŸÿÿ½0Ž‘*§¹]“]‘TÈDAÇŸü-=Ã0Ž˜¹[“[ÇxŸÿÿ½1Ž‘*§¹]“]ŽŽ¡’¢É-Ç:–Šª:“:Ž’²3ÑÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[ÇxŸÀkŽ‘—¹]“]‘TÆ)ŽŽ¡’û!IÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[(Çx¹)?]“]Ž’`®=Ž’r?Æ(Maybe›TÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[Çx¹]“]˜Æ)ŽŽ¡’û!IÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[(Çx¹)+]“]Ž’`®=Ž’r?Æ(List1›TÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[Çx¹]“]˜Æ)ŽŽ¡’û!IÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[(Çx¹)ȹ]“]Ž’`®=Ž’r?Æ[›TÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[Çx¹]“]˜Æ]ŽŽ¡’û!IÈDAÇŸü-=Ã0Ž‘óŽ¹[–þuV[Çx¹]“]Ž’`®=Ž’r?ÈC‘f¹[–þuV[Çx¹]“]ŽŽ¦¦’L†ÄName‘ŒÊmanglingŽŽ¦’û!IÈC‘f¹[–þuV[Çm‘TxŸÿÿ½0Ž‘?ûÇxŸÿÿ½1Ž‘Ê¥Ç:–Šª:“:Ž‘5IxŸÀkŽ‘—¹]“]Ž’`®=Ž’r?.–Šª.“.“Åunique–N Haskell and XML: Generic Combinators or Type-Based Translation?

Haskell and XML: Generic Combinators or Type-Based Translation?

Malcolm Wallace and Colin Runciman






Abstract: We present two complementary approaches to writing XML document-processing applications in a functional language.

In the first approach, the generic tree structure of XML documents is used as the basis for the design of a library of combinators for generic processing: selection, generation, and transformation of XML trees.

The second approach is to use a type-translation framework for treating XML document type definitions (DTDs) as declarations of algebraic data types, and a derivation of the corresponding functions for reading and writing documents as typed values in Haskell.

Published in the Proceedings of the International Conference on Functional Programming, Paris, Sept 1999. ACM Copyright.

1  Introduction

1.1  Document markup languages

XML (Extensible Markup Language) [1] is a recent simplification of the older SGML (Standardised Generalised Markup Language) standard that is widely used in the publishing industry. It is a markup language, meaning that it adds structural information around the text of a document. It is extensible, meaning that the vocabulary of the markup is not fixed -- each document can contain or reference a meta-document, called a DTD (Document Type Definition), which describes the particular markup capabilities used.

The use of XML is not however restricted to the traditional idea of a document. Many organisations are proposing to use XML as an interchange format for pure data produced by applications like graph-plotters, spreadsheets, and relational databases.

HTML (Hyper-Text Markup Language) is one well-known example of an instance of SGML -- every HTML document is an SGML document conforming to a particular DTD. Where XML improves over SGML is in removing shorthand forms that require an application to have knowledge of a document's DTD. For instance, in HTML some markup (such as a numbered list) requires an end marker; other forms (such as paragraphs) have implicit end markers understood when the next similar form starts; and yet other markup (such as in-line images) is self-contained and needs no end marker. An HTML application needs to be aware of the specific kind of markup in order to do the right thing.

1.2  XML document structure

XML is more regular. All markup has an explicit end marker without exception: every document is well-formed; its nesting structure is syntactically clear. One important consequence is that an XML application does not need to know the meaning or interpretation of all markup expressions -- parts of the document can be selected, re-arranged, transformed, by structure alone rather than by meaning.

An XML document is essentially a tree structure. There are two basic `types' of content in a document: tagged elements, and plain text. A tagged element consists of a start tag and an end tag, which may enclose any sequence of other content (elements or text fragments). Tagged elements can be nested to any depth, and the document is well-formed if it consists of a single top-level element containing other properly nested elements. Start tags have the syntax <tag>, and end tags </tag>, where tag is an arbitrary name. There is special syntax for an empty element: <tag/> is exactly equivalent to <tag></tag>. The start and end tags for each element contain a tag name, which identifies semantic information about the structure, indicating how the enclosed content should be interpreted. The start tag may also contain attributes, which are simple name/value bindings, providing further information about the element. Figure 1 shows an example XML document, illustrating all these components.

<?xml version='1.0'?>
<!DOCTYPE album SYSTEM "album.dtd">
<album>
  <title>Time Out</title>
  <artist>Dave Brubeck Quartet</artist>
  <coverart style='abstract'>
    <location thumbnail='pix/small/timeout.jpg'
              fullsize='pix/covers/timeout.jpg'/>
  </coverart>

  <catalogno label='Columbia' number='CL 1397'
             format='LP'/>
  <catalogno label='Columbia' number='CS 8192'
             format='LP'/>
  <catalogno label='Columbia' number='CPK 1181'
             format='LP' country='Korea'/>
  <catalogno label='Sony/CBS' number='Legacy CK 40585'
             format='CD'/>

  <personnel>
    <player name='Dave Brubeck' instrument='piano'/>
    <player name='Paul Desmond' instrument='alto sax'/>
    <player name='Eugene Wright' instrument='bass'/>
    <player name='Joe Morello' instrument='drums'/>
  </personnel>

  <tracks>
    <track title='Blue Rondo &agrave; la Turk'
           credit='Brubeck' timing='6m42s'/>
    <track title='Strange Meadow Lark'
           credit='Brubeck'  timing='7m20s' />
    <track title='Take Five'
           credit='Desmond'  timing='5m24s' />
    <track title='Three To Get Ready'
           credit='Brubeck'  timing='5m21s' />
    <track title="Kathy's Waltz"
           credit='Brubeck'  timing='4m48s' />
    <track title="Everybody's Jumpin'"
           credit='Brubeck'  timing='4m22s' />
    <track title='Pick Up Sticks'
           credit='Brubeck'  timing='4m16s' />
  </tracks>

  <notes author="unknown">
    Possibly the DBQ's most famous album,
    this contains
    <trackref link='#3'>Take Five</trackref>,
    the most famous jazz track of that period.
    These experiments in different time
    signatures are what Dave Brubeck is most
    remembered for.  Recorded Jun-Aug 1959
    in NYC.  See also the sequel,
      <albumref link='cbs-timefurthout'>
        Time Further Out</albumref>.
  </notes>
</album>
Figure 1: An example XML document.

1.3  Representing XML in Haskell

This paper is about processing XML using the functional language Haskell.1 Modern functional languages are well-equipped to deal with tree-structured data, so one expects the language to be a good fit for the application. Even so, a key issue is just how to represent documents, and in particular how to reconcile the DTD datatype definitions included in XML documents with the data types that can be defined in Haskell. We have investigated two complementary approaches:
  • (1) Define an internal data structure that represents contents of any XML document, independent of all DTDs.
  • (2) Given the DTD for some XML documents of interest, systematically derive definitions for internal Haskell data types to represent them. These definitions are closely based on the specific DTD.
Advantages of (1) include genericity and function-level scripting. Generic applications handle a wide class of XML documents, not just those sharing a specific DTD. One example of a completely generic application is searching documents to extract contents matching some pattern. Our Xtract2 is an interpreter for a regular XML query language.

The term `generic' also applies to applications that make some assumptions about a document's structure but need not know the full DTD,3 for example, a small script to add a ``total'' column to the end of every table (recognised by a particular markup tag) without altering any of the surrounding structure.

By function-level scripting we mean that the programmer does not have to be concerned with details of programming over data structures. All details of data structure manipulation can be hidden in a library of high-level combinators. In effect, combinatory expressions serve as an extensible domain-specific language.

Advantages of (2) include stronger typing and fuller control. A well-formed XML document is further said to be valid if it conforms to a stated DTD. By establishing a correspondence between DTDs and Haskell types, the concept of validity can be extended to include applications that process documents. Not only is there a static guarantee that applications cannot fail in respect of document structure if the input XML conforms to the stated DTD; any XML output produced via a DTD-derived type is guaranteed to be valid. With direct access to the DTD-specific data structure, the programmer has fuller control over how computation is done. They can use a full repertoire of programming techniques with the safeguard that type-checked Haskell will automatically produce XML that is valid in respect of a specified DTD.

Both approaches rely on a toolkit of more basic components for processing XML documents in Haskell: for instance, a parser and pretty-printer. These supporting components are implemented using existing combinator libraries [7, 8].

1.4  Sections following

§2 develops the approach using a generic representation and a combinator library, including an illustrative application. §3 develops the alternative based on translation between DTDs and Haskell data types. §4 discusses some pros and cons of the two approaches based on our experience implementing and using both. §5 discusses related work; §6 offers some conclusions and suggestions for further work.

2  Generic combinators

In this section, we begin with a generic representation for the contents of XML documents, excluding any DTD. We introduce content filters as a suitable basic type for functions processing this representation, and combinators for putting such filters together. A complete table of basic filters is given in Figure 2, and of combinators and their definitions in Figure 3. An example program is shown in Figure 4. One expected property of a fitting set of combinators is that they satisfy algebraic laws; a table of laws satisfied by our combinators is given in Figure 6.

2.1  Documents and transformations

Data modelling
    data Element = Elem Name [Attribute] [Content]
    data Content = CElem Element
                 | CText String
Because functional languages are good at processing tree-structured data, there is a natural fit between the XML document domain and Haskell tree datatypes. In simplified form, the main datatypes which model an XML document are Element and Content, whose definitions are mutually recursive, together forming a multi-branch tree structure.

The filter type
    type CFilter = Content -> [Content]
Our basic type for all document processing functions is the content filter, which takes a fragment of the content of an XML document (whether that be some text, or a complete tagged element), and returns some sequence of content. The result list might be empty, it might contain a single item, or it could contain a large collection of items.

Some filters are used to select parts of the input document, and others are used to construct parts of the output document. They all share the same basic type, because when building a new document, the intention is to re-use or extract information from parts of the old document. Where the result of a filter is either empty or a singleton, the filter can sometimes be thought of as a predicate, deciding whether or not to keep its input.

Program wrapper
    processXmlWith :: CFilter -> IO ()
We assume a top-level wrapper function, which gets command-line arguments, parses an XML file into the Content type, applies a filter, and pretty-prints the output document. The given filter is applied to the top-level enclosing element of the document.

Basic filters
A complete list of predefined filters is shown in Figure 2. The simplest possible filters: none takes any content and returns nothing; keep takes any content and returns just that item. Algebraically, these are the zero and unit filters.

Predicates
  none,   zero/failure
  keep,   identity/success
  elm,   tagged element?
  txt   plain text?
    :: CFilter
  tag,   named element?
  attr   element has attribute?
    :: String -> CFilter
  attrval   element has attribute/value?
    :: (String,String) -> CFilter
 
Selection
  children   children of element
    :: CFilter
  showAttr,   value of attribute
  (?)   synonym for showAttr
    :: String -> CFilter
 
Construction
  literal,   build plain text
  (!)   synonym for literal
    :: String -> CFilter
  mkElem   build element
    :: String -> [CFilter] -> CFilter
  mkElemAttrs   build element with attributes
    :: String -> [(String,CFilter)]
    -> [CFilter] -> CFilter
  replaceTag   replace element's tag
    :: String -> CFilter
  replaceAttrs   replace element's attributes
    :: [(String,CFilter)] -> CFilter

Figure 2: Basic content filters.
  • Predicate and selection filters. The filter elm is a predicate, returning just this item if it is an element, or nothing otherwise.4 Conversely, txt returns this item only if is plain text,5 and nothing otherwise. The filter children returns the immediate children of an element if it has any, or nothing if this content-item is not an element. The filter tag t returns this item only if it is an element whose tag name is the string t. The filter attr a returns this item only if it is an element containing the attribute name a. The filter attrval (a,v) returns this item only if is an element containing the attribute a with the value v.

  • Construction filters. The function literal s makes a text content containing just the string s. The function mkElem t fs builds a content element with the tag t; the argument fs is a list of filters, each of which is applied to the current item, and all their results are collected to become the children of the new element. The function mkElemAttrs t avs fs is just like mkElem except that its extra parameter avs is a list of attribute values6 to be attached to the tag.
A useful filter which involves both selection and construction is showAttr a, which extracts the value of the attribute a from the current element and returns just that string as a piece of content.

When constructing a new document (e.g. the script in Figure 4 which generates HTML), the mkElem function occurs repeatedly. We define and use a small library of functions such as htable, hrow, and hcol which are just synonyms for particular applications of mkElem and mkElemAttrs to different tagnames, reducing verbosity and making the syntax rather more readable.

Also for convenience, we define the new operators ? and ! as synonyms for showAttr and literal respectively: they are used in a bracketed postfix notation,7 a style some programmers prefer.

2.2  Combinators

The combinators used as intermediate code in compilers can render programs `totally unfit for human consumption' [11]! However, the idea of a combinator library for a specific class of applications is to achieve a form of expression that is natural for the problem. A combinator library should be like a language extension tailored to the problem domain [4]. In this sense, functional languages are extensible, just as XML itself is extensible. The combinators are higher-order operators serving as `glue'[6] to assemble functions into more powerful combinations. We aim to keep the types of component functions as uniform as possible so that any function can be composed with any other. Within the lexical limits of the host language, choice of notation should follow application conventions: in Haskell we can, where appropriate, define new infix operator symbols for combinators.

So, having defined some basic filters already, in what ways can these usefully be combined into more interesting and complex filters? (See Figure 3.)

  o,   Irish composition
  (|||),   append results
  with,   guard
  without,   negative guard
  (/>),   interior search
  (</),   exterior search
  (|>|)   directed choice
    :: CFilter -> CFilter -> CFilter
 
  f `o` g = concat . map f . g
  f ||| g = \c-> f c ++ g c
  f `with` g = filter (not.null.g) . f
  f `without` g = filter (null.g) . f
  f /> g = g `o` children `o` f
  f </ g = f `with` (g `o` children)
  f |>| g = f ?> f :> g
 
  cat   concatenate results
    :: [CFilter] -> CFilter
 
  cat fs = \c-> concat. map (\f->f c) fs
 
  et   disjoint union
    :: (String->CFilter) -> CFilter -> CFilter
 
  f `et` g = (f `oo` tagged elm)
  |>| (g `o` txt)
 
  (?>)   if-then-else choice
    :: CFilter -> ThenElse CFilter -> CFilter
 
  data ThenElse a = a :> a
  p ?> f :> g = \c-> if (not.null.p) c
  then f c else g c
 
  chip,   ``in-place'' application to children
  deep,   recursive search (topmost)
  deepest,   recursive search (deepest)
  multi,   recursive search (all)
  foldXml   recursive application
    :: CFilter -> CFilter
 
  deep f = f |>| (deep f `o` children)
  deepest f = (deepest f `o` children) |>| f
  multi f = f ||| (multi f `o` children)
  foldXml f = f `o` (chip (foldXml f))

Figure 3: Filter combinators and their definitions.
The most important and useful filter combinator is `o`. We call this operator Irish composition, for reasons which should be obvious. It plugs two filters together: the left filter is applied to the results of the right filter. So, for instance, the expression 
    text `o` children `o` tag "title"
means ``only the plain-text children of the current element, provided the current element has the title tag name''.

Some other combinators are as follows. f ||| g is an append operator: it joins the results of f and g sequentially. cat fs is the list generalisation of |||; it concatenates the results of each of the filters from the fs list. f `with` g acts as a guard on the results of f, pruning to include only those which are productive under g. The dual, f `without` g, excludes those results of f which are productive under g. The expression p ?> f :> g is a functional choice operator; if the (predicate) filter p is productive, then the filter f is applied, otherwise g is applied. From this is derived a directed choice operator: f |>| g gives either the results of f, or those of g only if f is unproductive.

Generalised Path Selectors
Selection of subtrees by path patterns is familiar to users of the Unix file-system, where such patterns are used to access directory structure, using a / notation to indicate the `containing' relation. Similar patterns are used in XSLT, an XML transformation language [3]. In this connection, we define two path selection combinators /> and </. Both combinators choose subtrees to return based on whether the results of the left filter contain the results of the right filter as children: /> is an `interior' selector, returning the inner structure; </ is an `exterior' selector, returning the outer structure.

An editing combinator
Aside from predicates, selectors, choice, and constructive filters, there is one very useful combinator which stands in its own category -- an editing combinator. chip f processes the children of an element in-place: the filter f is applied to its children; the results are rebuilt as the new children of that same element.

Recursion
It is often useful to express recursive transformations on XML documents: transformations which can be applied at many different levels of the document tree.

One family of such expressions is useful primarily in selecting a subtree from an arbitrarily deep location, although they can of course be used for editing and filtering as well as selection. The recursive combinator deep f potentially pushes the action of filter f deep inside the document sub-tree. It first tries the given filter on the current item: if it is productive then it stops here, but if no results are returned, then it moves to the children and tries again recursively. When used with a predicate, this strategy searches for the topmost matching elements in the tree. There are variations: deepest searches for the bottommost matching elements; multi returns all matches, even those which are sub-trees of other matches. However, as already noted, the action of these combinators is not restricted to predicates or selectors.

Another powerful recursion combinator is foldXml: the expression foldXml f applies the filter f to every level of the tree, from the leaves upwards to the root (at least conceptually -- of course lazy evaluation makes this more efficient).

2.3  Example

The use of these filters and combinators is illustrated in an example script in Figure 4. This program transforms an <album> element into an HTML document that provides a formatted summary. The HTML output, rendered by the Netscape browser, is illustrated in Figure 5. Such a task might be fairly common in e-commerce applications.

We now describe some of the salient features of the example.

    (albumf `o` deep (tag "album"))
The script first searches recursively for the topmost element tagged <album>, before applying the filter albumf to it. Thus, it works equally well with any XML source document that contains an <album> element anywhere within it, and (correctly) produces no output for documents which do not contain album data.

The output document's <HEAD> section contains the artist name and album title separated by a colon. We note that the expression, 
    txt `o` children `o` tag "artist"
        `o` children `o` tag "album"
which grabs the textual content of the <artist> element within the <album> element, is somewhat unwieldy. Moreover its trailing test for the <album> tag is redundant, since the calling filter has already performed that match. The expression can be simplified by using path selectors to: 
    keep /> tag "artist" /> txt
and this style is used elsewhere in the example. (The algebraic laws in Section 2.5 guarantee that this rewriting is safe.)

Such expressions make some assumptions about the structure of the data within the <album> element. In this instance, the assumption is that an <artist> element is an immediate child, and that its immediate children include text. If such assumptions prove incorrect for a particular document, the filter is simply unproductive; no error is flagged.

With a suitable definition, hbody = mkElemAttr "BODY" the expression 
    hbody  [("bgcolor",("white"!))]   [...]
can be understood to set the background colour attribute of the <BODY> tag to the literal value white. Notice how the attribute value is itself described by a filter. In this case, the filter is not very exciting, but the later definition of mkLink illustrates the generation of an HTML reference by looking up the value of a supplied link attribute (using the ? filter).

When the script is used on the particular document from Figure 1, the output is a re-ordering of the internal components of the input: in the <BODY> part of the output, the <notes> section is selected and transformed by notesf before the <catalogno> elements are processed by the summaryf filter. Although in the absence of a DTD it is impossible to be sure of any input ordering, the script here ensures that the output ordering is consistent.

The definition of the notesf filter is interesting because it makes fewer assumptions about the content of a <notes> structure, and in addition it preserves the input ordering. The chained if-then-else choice within the recursive foldXml combinator causes all internal structure of the <notes> element to be retained except for the replacement of <trackref>s by emphasised text, and <albumref>s by HTML links.

One of the most striking features of the example as a whole is how selection and testing of old content and construction of new content are uniform, and can be combined almost interchangeably.

We will return to the treatment of <catalogno> elements in Section 2.4 after introducing some extra labelling combinators.

module Main where
import Xml
main =
  processXmlWith (albumf `o` deep (tag "album"))
albumf =
  html
    [ hhead
      [ htitle
        [ txt `o` children `o` tag "artist"
              `o` children `o` tag "album"
        , literal ": "
        , keep /> tag "title" /> txt
        ]
      ]
    , hbody [("bgcolor",("white"!))]
      [ hcenter
          [ h1 [ keep /> tag "title" /> txt ] ]
      , h2 [ ("Notes"!) ]
      , hpara [ notesf `o` (keep /> tag "notes") ]
      , summaryf
      ]
    ]
notesf =
  foldXml (txt            ?> keep            :>
           tag "trackref" ?> replaceTag "EM" :>
           tag "albumref" ?> mkLink          :>
           children)
summaryf =
  htable [("BORDER",("1"!))]
    [ hrow [ hcol [ ("Album title"!) ]
           , hcol [ keep /> tag "title" /> txt ]
           ]
    , hrow [ hcol [ ("Artist"!) ]
           , hcol [ keep /> tag "artist" /> txt ]
           ]
    , hrow [ hcol [ ("Recording date"!) ]
           , hcol [ keep />
                       tag "recordingdate" /> txt ]
           ]
    , hrow [ hcola [ ("VALIGN",("top"!)) ]
                   [ ("Catalog numbers"!) ]
           , hcol
             [ hlist
               [ catno `oo`
                  numbered (deep (tag "catalogno"))
               ]
             ]
           ]
    ]
catno n =
  mkElem "LI"
    [ ((show n++". ")!),  ("label"?),  ("number"?)
    , (" ("!),  ("format"?),  (")"!) ]
mkLink =
  mkElemAttr "A" [ ("HREF",("link"?)) ]
    [ children ]
Figure 4: An example document-processing script using the generic filter combinators.
picture of browser

Figure 5: The HTML results of the example script, rendered by a browser.

2.4  Labellings

One feature that is occasionally useful is the ability to attach labels to items in a sequence, for instance, to number a list of items, or to treat the first/last item of a list differently from the other items. For this purpose, the library provides special labelling combinators. We choose to introduce a new type: 
  type LabelFilter a = Content -> [ (a,Content) ]
A LabelFilter is like a CFilter except it attaches a label to each of its results. We might have chosen to fold label values inside the Content type, to yield a uniform CFilter type, but keeping the labels separate allows them to be of completely polymorphic type: a label could even be another filter for example.

There are several common labelling functions: 
  numbered     :: CFilter -> LabelFilter Int
  interspersed :: a -> CFilter -> a
                                 -> LabelFilter a
  tagged       :: CFilter -> LabelFilter String
  attributed   :: CFilter ->
                    LabelFilter [(String,String)]
These labelling functions lift a CFilter to the LabelFilter type: numbered f transforms the ordinary filter f into a new filter that attaches integers (from 1 upwards) to the results of f; interspersed a f z attaches the label a to all of the results of f except the last, which gets the label z; tagged f labels every tagged element with its tag name (and non-elements with the empty string); attributed f labels every tagged element with its attribute/value pairs (and non-elements with the empty list).

  `oo` :: (a->CFilter) -> LabelFilter a -> CFilter
The combinator `oo` is a new form of composition which drops a LabelFilter back to the CFilter type by application of another filter that consumes the label.

The use of this form of labelling is illustrated by the treatment of <catalogno>s in the example of Figure 4: 
  catno `oo` numbered (deep (tag "catalogno"))
First, the desired elements are extracted from their topmost positions in the tree, then they are given numeric labels, and finally the catno filter incorporates the label into some generated text. Another example can be seen in the definition of the `et` combinator in Figure 3. (`et` combines a filter f on elements with a filter g on text. f pattern-matches against tagnames -- the tagnames are extracted by the labelling function tagged.)

Furthermore, it is possible to combine labellings. The `x` combinator glues two labelling functions together, pairing the labels they produce. 
  `x` :: (CFilter->LabelFilter a)
           -> (CFilter->LabelFilter b)
           -> (CFilter->LabelFilter (a,b))

2.5  Algebraic laws of combinators

We briefly show how combinators are defined in such a way that various algebraic laws hold. The complete set of laws is given in Figure 6.

  Irish composition
f `o` (g `o` h) = (f `o` g) `o` h   associativity
none `o` f = f `o` none = none   zero
keep `o` f = f `o` keep = f   identity
 
  Guards
f `with` keep = f   identity
f `with` none = none `with` f = none   zero
(f `with` g) `with` g = f `with` g   idempotence
(f `with` g) `with` h
= (f `with` h) `with` g   promotion
(f `o` g) `with` h
= (f `with` h) `o` g   promotion
 
f `without` keep = none `without` f
= none   zero
f `without` none = keep   identity
(f `without` g) `without` g
= f `without` g   idempotence
(f `without` g) `without` h
= (f `without` h) `without` g   promotion
(f `o` g) `without` h
= (f `without` h) `o` g   promotion
 
  Path selectors
f /> (g /> h) = (f /> g) /> h   associativity
none /> f = f /> none = none   zero
keep /> f = f `o` children    
f /> keep = children `o` f    
keep /> keep = children    
none </ f = f </ none = none   zero
f </ keep = f `with` children    
(f </ g) </ g = f </ g   idempotence
(f </ g) /> g = f /> g   idempotence
 
(f /> g) </ h = f /> (g </ h)   promotion
(f </ g) </ h = (f </ h) </ g   promotion
f `o` (g /> h) = g /> (f `o` h)   promotion
(f /> g) `o` h = (f `o` h) /> g   promotion
(f /> g) `with` h = f /> (g `with` h)   promotion
(f </ g) `with` h = (f `with` h) </ g   promotion
 
  Directed choice
(f |>| g) |>| h = f |>| (g |>| h)   associativity
keep |>| f = keep    
none |>| f = f |>| none = f   identity
f |>| f = f   idempotence
 
  Recursion
deep keep = keep   simplification
deep none = none   simplification
deep children = children   simplification
deep (deep f) = deep f   depth law
 
  Misc
elm |>| txt = txt |>| elm = keep   completeness
elm `o` txt = txt `o` elm = none   excl. middle
children `o` elm = children    
children `o` txt = none  

Figure 6: Algebraic laws of combinators.
Giving all content filters the same type maximises the usefulness of combinators for plugging together functions of this type. However, it is still helpful to identify subclasses of content filters that offer extra guarantees. Two examples of such classes are:
  1. A predicate p has the property that p c always gives as result either [c] or [].
  2. A selector s has the property that s c always gives as result a sequence of contents taken from c. Resulting items do not overlap, and the result sequence respects the order in which the contents were found in c.
So a predicate is a selector, but a selector is not necessarily a predicate.

The `o` form of filter composition could be defined using a Haskell list comprehension 
    (f `o` g) c = [c'' | c' <- g c, c'' <- f c']
However, we prefer the equivalent higher-order definition f `o` g = concat . map f . g because it is more convenient in algebraic calculation.8 Composition is associative, with none as zero, and keep as identity.

The `with` form of guarded composition is not associative, but we do have some laws, particularly idempotence. We also have a promotion law about combined uses of `with` and `o`. The dual operator, `without` has parallel laws.

The /> path selector is associative but </ is not, and there are some idempotence laws for both. Most important however, are the various promotion laws for changing the order of application of />, </, and with.

The directed choice operator |>| viewed by itself appears to be algebraically sensible, but it does not seem to have useful algebraic properties in connection with other combinators because of its bias towards the left operand. The simpler result-appending combinator ||| could be an alternative to the directed choice operator, and would probably lead to more laws, but it has less `application bite'. A potentially serious problem is that the |||-combination of two selectors is not necessarily a selector.

The recursion operator deep has some minor laws, one of which, the depth law, is more profound. We have not yet fully investigated the properties of deepest, multi, and foldXml.



3  Translation of DTDs to Types

3.1  DTDs

So far we have considered document-processing by generic tree transformations, where markup is matched textually at runtime, and no account is taken of any deeper meaning of tags.

However, when the DTD for a document is available, the meaning it defines for markup tags can be used to powerful effect. The most basic use is to confirm semantic validity: a stronger notion than mere syntactic well-formedness. A DTD defines a grammar for document content: it specifies a vocabulary of markup tags, and the allowed content and attributes for each tag. Document validation is therefore a straightforward check that the document's structure conforms to the vocabulary and grammar given in the DTD.

XML document validators are readily available. However, we go further and define the idea of valid document processing. A valid processing script is one which produces a valid document as output, given a valid document as input. We achieve this by demonstrating a correspondence between the DTD of a document and the definition of a set of algebraic types in Haskell, and the consequent correspondence between the document's content and a structured Haskell value. Hence, by writing document processing scripts to manipulate the typed Haskell value, the script validation problem is just an instance of normal Haskell type inference.9 

<?xml version='1.0'?>
<!DOCTYPE album SYSTEM "album.dtd" [
<!ELEMENT album (title, artist, recordingdate?,
                 coverart, (catalogno)+,
                 personnel, tracks, notes) >
<!ELEMENT title #PCDATA>
<!ELEMENT artist #PCDATA>
<!ELEMENT recordingdate EMPTY>
    <!ATTLIST recordingdate date CDATA #IMPLIED
                            place CDATA #IMPLIED>
<!ELEMENT coverart (location)? >
    <!ATTLIST coverart style CDATA #REQUIRED>
<!ELEMENT location EMPTY >
    <!ATTLIST location thumbnail CDATA #IMPLIED
                       fullsize CDATA #IMPLIED>
<!ELEMENT catalogno EMPTY >
    <!ATTLIST
          catalogno
              label CDATA #REQUIRED
              number CDATA #REQUIRED
              format (CD | LP | MiniDisc) #IMPLIED
              releasedate CDATA #IMPLIED
              country CDATA #IMPLIED>
<!ELEMENT personnel (player)+ >
<!ELEMENT player EMPTY >
    <!ATTLIST player name CDATA #REQUIRED
                      instrument CDATA #REQUIRED>
<!ELEMENT tracks (track)* >
<!ELEMENT track EMPTY>
    <!ATTLIST track title CDATA #REQUIRED
                    credit CDATA #IMPLIED
                    timing CDATA #IMPLIED>
<!ELEMENT notes (#PCDATA | albumref | trackref)* >
    <!ATTLIST notes author CDATA #IMPLIED>
<!ELEMENT albumref #PCDATA>
    <!ATTLIST albumref link CDATA #REQUIRED>
<!ELEMENT trackref #PCDATA>
    <!ATTLIST trackref link CDATA #IMPLIED>
]>
Figure 7: An example DTD. 
module AlbumDTD where

data Album = 
    Album Title Artist (Maybe Recordingdate)
          Coverart [Catalogno] Personnel
          Tracks Notes
newtype Title = Title String
newtype Artist = Artist String
newtype Recordingdate =
                Recordingdate Recordingdate_Attrs
data Recordingdate_Attrs = Recordingdate_Attrs {
    date :: Maybe String,
    place :: Maybe String }
newtype Coverart = Coverart (String, Maybe Location)
newtype Location = Location Location_Attrs
data Location_Attrs = Location_Attrs {
    thumbnail :: Maybe String,
    fullsize  :: Maybe String }
newtype Catalogno = Catalogno Catalogno_Attrs
data Catalogno_Attrs = Catalogno_Attrs {
    label :: String,
    number :: String,
    format :: Maybe Format,
    releasedate :: Maybe String,
    country :: Maybe String }
data Format = CD | LP | MiniDisc
newtype Personnel = Personnel [Player]
newtype Player = Player Player_Attrs
data Player_Attrs = Player_Attrs {
    name :: String,
    instrument :: String }
newtype Tracks = Tracks [Track]
newtype Track = Track Track_Attrs
data Track_Attrs = Track_Attrs {
    title :: String,
    credit :: Maybe String,
    timing :: Maybe String }
newtype Notes = Notes (Maybe String, [Notes_])
data Notes_ = 
    Notes_Str String
  | Notes_Albumref Albumref
  | Notes_Trackref Trackref
newtype Albumref = Albumref (String,String)
newtype Trackref = Trackref (Maybe String,String)
Figure 8: The example DTD translated to Haskell types.

3.2  DTD translations.

An example DTD for the document shown earlier is given in Figure 7. The immediate features to note are: (1) For every element, there is a specification of allowed inner elements (ELEMENT declaration), and possibly also a specification of allowed attribute values (ATTLIST declaration). (2) For inner content, the grammar allows sequence (commas), choice (vertical bar), optionality (question mark), and repetition (star or plus). (3) Where the inner content declaration allows free text (#PCDATA), choice between text and other elements is permitted, but sequencing of those elements is not permitted. (4) In attribute lists, some values are mandatory (#REQUIRED) and some are optional (#IMPLIED); attribute values can either be unconstrained strings (CDATA) or a member of some pre-defined set of string values.

There seem to be some obvious correspondences between this very restricted form of type language and the richer type language of Haskell. Each element declaration is roughly speaking a new datatype declaration. Sequence is like product types (i.e. single-constructor values). Choice is like sum types (i.e. multi-constructor values). Optionality is just a Maybe type. Repetition is lists.

Attribute lists also have a translation: because they are unordered and accessed by name, Haskell named-fields look like a good representation. Optionality can again be expressed as Maybe types. Attribute values that are constrained to a particular value-set can be modelled by defining a new enumeration type encompassing the permitted strings.

3.3  Implementation

These rules are formalised in the appendix (Figure 9). An implementation of these rules (with some additional rules to eliminate redundancy) translated the DTD in Figure 7 into the Haskell type declarations shown in Figure 8.

Also needed, along with the type declarations, are functions which read and write values of these types to and from actual XML documents. These are generated automatically from the type declarations alone. Using an appropriate set of pre-defined type classes, we derive a new instance for each generated type using a tool like DrIFT [16].

3.4  Discussion

Although this type-based translation looks straightforward, it turns out that there are several tricky issues.

First, the type translation may only use datatypes and newtypes, never type synonyms. This is a result of needing to write values out as XML -- a type synonym in Haskell is indistinguishable from the type it abbreviates, but the generated types must be distinct in order to be able to re-introduce enclosing start and end tags with the correct markup.

A separate type is introduced for each collection of attributes. Hence, an element is represented by a pairing of the attributes and the content. Where a tagged element directly contains an optional type or a sequence of types which are themselves sum-types, it is necessary to interpose a separate Haskell type, e.g. Notes contains a [Notes_] where the auxiliary type Notes_ has three alternatives.

Naming is a big issue. Case matters in XML, so a <tag> differs from a <TAG> and attribute attr differs from Attr. In Haskell however, types must begin with upper-case, and field-names must begin with lower-case. Where auxiliary types are necessary, we have chosen to append an underscore character to the name. All of these factors impose restrictions on the use of this translation, due to the potential name conflicts.

Furthermore, there is a mismatch between Haskell's named fields and the attribute naming/scoping rules in XML. In XML, different elements may have attributes of the same name and type, whereas Haskell's named fields are restricted to use within a single type. A system of typed extensible records [5] would be a much better fit.

Despite these problems in expressing DTDs within the Haskell typesystem, the latter is very much more powerful than DTDs -- for instance, DTDs have no notion of polymorphism. Indeed, there are frequent occasions when DTD writers resort to textual macros10 to indicate more detailed structuring than DTDs permit (including polymorphism and qualified typing), even though such implicit structuring cannot be validated by XML tools. It is significant to note the XML community's recognition of these limitations of DTDs -- recent proposals for schemas11 address the question of richer typing in a more disciplined manner.

One area in which the type system of Haskell in particular (as opposed to other functional languages) is exploited is type classes. This systematic overloading mechanism is very useful for codifying the I/O conversions.

4  Pros and cons of the two schemes

4.1  Combinators

Compared with the mainstream solution for XML processing, namely new domain-specific languages for expressing and scripting transformations, the combinator approach has several advantages:

Ease of extension and variation
Scripting languages sometimes lack useful facilities, or provide them in convoluted ways. Extending the language is difficult. A combinator library, however, can be enlarged comparatively straightforwardly -- the definitions are accessible, and most are short and simple.

Computational power
Scripting languages tend to offer either a very limited expression language, or a hook into a programming system at a completely different level of abstraction. But if XML scripts are programs in a language such as Haskell, the full power of the native language is immediately available.

Abstraction, generality and reuse
Almost any pattern occurring in a combinator program can be isolated and defined as a separate re-usable idea [6]. This also applies at the application level, where common ideas from similar applications might easily be defined in a higher-level library. This form of re-use makes program development much quicker and less error-prone.

Laws for reasoning about scripts
The semantics of a scripting language are often defined by illustration. So it is hard to reason with confidence about the meanings of scripts. Is A just a stylistic variation of B or are there inputs for which the two could give different results? But when the semantics of scripts can be defined in terms of the equations for the combinators, properties such as associativity and distribution can often be demonstrated simply.

Implementation for free
Does a scripting language have an interactive interpreter? A compiler? A type-checker? A profiler? All these things are immediately available to XML scripts directly expressed as Haskell programs.

Of course, there are disadvantages too.

Distance from target language
XSLT [3] has the property that a script is an expression in the target language: it uses exactly the XML syntax for building new content. Combinator-based scripts must use a different syntax due to the underlying language. The linguistic gap might cause confusion and increase learning costs.

Living in an unfamiliar world
Combinator programs look like scripts in a small domain-specific language. Writers may be beguiled by this apparent simplicity, make a small error, and drop into an unknown corner of Haskell. Error messages may be incomprehensible, or worse, the script might work but do something utterly strange.

4.2  Type-based translation

Some of the advantages of the fully-typed representation of XML documents have already been mentioned.

Validity
The ability for the system to spot errors automatically, not just in the data, but in the program, and also to prevent the generation of incorrect document markup.

Direct programming style
Functional languages encourage the use of pattern-matching (binding values to variables) on the left-hand-side of equations. However, using higher-order combinators, data structures tend not to be mentioned in equations at all. The DTD translation approach is much more in keeping with the pattern-binding style, which sometimes leads to shorter programs! Whereas with combinators, it is sometimes necessary to re-traverse the same selection path with slight variations, the pattern-binding gives direct access for free.


Disadvantages are:

High startup cost
Before scripting document transformations, it is necessary to acquire, check, and process the DTD. Although the generation of Haskell types is automated, few people are familiar enough with DTDs to be able to start using them immediately. They require careful study and understanding before correct scripts can be written and the initial investment of effort pays off.

Incomplete type model
The grammar of DTDs is small and restrictive compared to the sophisticated type systems available in functional languages. Better means of type-specification in XML are still under development. In the meantime, there is little scope for using the full power of features like polymorphism.

5  Related Work

XML Processing
There are infant processing languages surrounding XML. Of most interest here are:

  • XSLT [3] (eXtensible Style Language for Transformation) is a W3C-proposed declarative language for expressing a limited form of transformations on XML documents, originally intended for rendering to a layout-based format, e.g. HTML, PostScript, etc., but now widely used for XML->XML transformations.
  • DSSSL [12] (Document Style Semantics and Specification Language) is a mature ISO standard with no complete implementations. It is similar in essence to XSLT, but deals with full SGML input, and is based on Scheme.
Not many functional language researchers are visibly engaged in XML-related work, but two other toolkits for XML-processing are Christian Lindig's XML parser in O'Caml12 and Andreas Neumann's validating XML parser in SML13 . To our knowledge, neither of these provides transformation capabilities in either a combinator style or a type-translation style. Philip Wadler has written a short formal semantics of XSL selection patterns [15].

Application-based combinators
Parsing is the most extensively studied application for combinator libraries. Since the original treatment by Burge [2], there have been many variations on the theme. Swierstra and Duponcheel's method incorporating on-the-fly grammar analysis and error-correction is a notable recent example [10]. We hope it may be possible to incorporate DTD-analysis in our combinators in a similar style.

Although many other libraries of application combinators have been devised, the general design principles for such libraries are scarcely referred to in the literature. Hughes' exposition of a design for pretty-printing combinators [7] is a unique resource in this respect, and we have yet to exploit it fully.

Tree-processing operators
An earlier version of this paper prompted more than one pointer to the work of Eelco Visser and colleagues [13]. Their motivating application is specification of strategies for program optimisation, treated as rewriting over expression trees. The result of applying a strategy is either a single term or failure: non-determinism is achieved by backtracking but only the first success is computed, whereas we deal in `lists of successes' [14]. Their operators for combining strategies include composition, directed choice, and an explicit µ operator for recursion. They have several operators for specifying transformation of child subterms: some are not so relevant to XML where subtree position and arity are less often fixed than in program syntax; however, one of the most frequently applied operators is close to our foldXml. Most significantly, Visser et. al. achieve great expressive power by decomposing the match/re-build stages of rewriting, and introducing explicit environments by which these stages communicate. This makes it possible to deal with subtleties such as variable bindings in the program terms under transformation. Although the structure of XML is simpler than the structure of a programming language, our library could benefit from the addition of support for binding variables when matching subtrees.

Programming functions explicitly over the XML data-structure, without the abstraction of combinators, Haskell pattern matching provides bindings for subtrees. But only at a fixed (small) depth from the root, beneath an explicitly stated pattern of constructors. Mohnen [9] defines an extension of the pattern language for deep matching: variables in a pattern can be bound to subterms at arbitrary depth inside the original term. The result of the match includes a context function representing the original subject term with `holes' at the sites of matching; subterms for these holes are supplied by arguments to the function. So contexts are the complements of environments. Mohnen shows how his matching extension simplifies various tree-processing tasks, and also how it can be translated into standard Haskell. This work could provide one component of a hybrid solution, with DTD-specific representation and generic forms of traversal and matching.

Visser et. al. [13] also discuss several other approaches to the tree transformation problem.

6  Conclusions and Future Work

In our experience, Haskell is a very suitable language for XML processing. For generic applications, a small set of combinators designed with algebraic properties in mind can be powerful enough and flexible enough to describe a full range of selection, testing, and construction operations in a uniform framework. For applications where the DTD is fixed, a tool deriving corresponding types and associated I/O routines turns XML processing into Haskell programming over typed data structures, and the Haskell typechecker validates scripts.

However, there is plenty of scope for further work, in several directions:

Generality of combinators
Though we have had generality as a design aim for our present combinator library there is scope for generalising it further.

  • Wider functionality. Most content filters in our current library are either pure selectors (with results that are sequences of sub-trees from the full document tree) or pure constructors (creating document content from values of other types). The design could usefully be extended to include a more general class of deletion operations in which sub-trees can be thinned and pruned in various ways. More general still are combinators for editing and transforming, where some of the ideas in Visser's work could usefully be transferred.
  • Multiple inputs and outputs. An interesting extension of single-document scripting is the handling of multiple documents. Producing more than one output document is no great problem. But it is far more challenging to design appropriate combinators for dealing with several inputs.
  • More general types. The labelling scheme has proved useful for some applications, but the need for a separate LabelFilter type is a blemish. We hope to generalise the CFilter type to incorporate LabelFilter as a special case. By making the CFilter type parametric it might even be possible to incorporate the type-translation of DTDs within the combinator framework.
Efficiency of combinators
The current combinator library is quite usable, but here are some possible routes to greater efficiency.
  • Algebraic normalisation So far we have merely established that laws hold, and occasionally appealed to them when writing scripts. The implementation simply defines the combinators by their specifying equations. Instead, laws could be exploited at the implementation level. Following Hughes [7], we have in mind an implementation that automatically reduces all combinations to a normal form, that is the least expensive equivalent computationally.
  • Space-efficient formulation Some lazy functional programs that process trees in pre-order left-to-right fashion can be formulated to run in log(N) space. The part of the tree that is held in memory corresponds to a path from the root to some node that is currently the focus of computation: to the left are `garbage' subtrees already processed, to the right are subtrees not yet evaluated. However, our current combinators have not been formulated to guarantee this sort of space behaviour, even in favourable cases. This problem might be tackled by the normalisation approach.
  • DTD-aware combinators The current combinator library just ignores DTDs. Combinators that maintain DTD information might, for example, achieve far more efficient search in some cases by pruning branches bound to fail. They could also be used to produce first-class XML documents as the results of queries, not just raw extracts of unknown type. As we have already noted, DTDs could perhaps be attached as labels in the sense of §2.4: either as explicit values or implicitly in type information.
Relations between DTDs
As we have seen, in the DTD-directed approach with known fixed DTDs for input and output, validation translates to static type-checking; whereas generic combinators could in principle acquire and compute DTDs dynamically. These represent extremes with disadvantages of inflexibility on the one hand and some insecurity on the other. There are many other ways of handling relations between DTDs. For example:

  • Polymorphic and higher-order scripts. The generic approach would gain security if one could infer a DTD->DTD function. By analogy with functional programs it is then natural to assign scripts polymorphic and higher-order DTDs, making explicit their degree of genericity.

  • Inclusion between DTDs. This has been implicitly assumed already, but has practical importance in its own right. As stock DTDs are refined, XML documents will inhabit a hierarchy of specialisation. Given several similar DTDs, one would like to derive a DTD for a virtual common root (intersection) or common descendent (union). This goes well beyond the abilities of current type-inference systems, but would make a useful addition to our functional toolkit for XML processing.

Acknowledgements

Canon Research Centre (Europe) Ltd. suggested this line of work and funded it. Philip Wadler, Christian Lindig, and Joe English gave very helpful comments on an earlier draft of this paper and software. Several anonymous referees also gave useful advice.

References

[1]
Tim Bray, Jean Paoli, and C.M. Sperberg-Macqueen. Extensible Markup Language (XML) 1.0 (W3C Recommendation). http://www.w3.org/TR/REC-xml, WWW Consortium, February 1998.

[2]
W H Burge. Recursive Programming Techniques. Addison-Wesley, 1975.

[3]
James Clark (ed). XSL Transformations (Working Draft). http://www.w3.org/TR/WD-xslt, WWW Consortium, April 1999.

[4]
Jon Fairbairn. Making form follow function: An exercise in functional programming style. Software -- Practice and Experience, 17(6):379--386, June 1987.

[5]
Benedict R Gaster. Records, Variants, and Qualified Types. Dept of Computer Science, University of Nottingham, PhD Thesis, 1998.

[6]
John Hughes. Why functional programming matters. Computer Journal, 32(2), April 1989.

[7]
John Hughes. The design of a pretty-printing library. In 1st Intl. School on Advanced Functional Programming, pages 53--96. Springer LNCS Vol. 925, 1995.

[8]
Graham Hutton and Erik Meijer. Monadic parsing in Haskell. Journal of Functional Programming, 8(4), July 1998.

[9]
Markus Mohnen. Context patterns in Haskell. In Workshop on Implementation of Functional Languages, pages 41--57. Springer LNCS Vol 1268, September 1996.

[10]
Doaitse Swierstra and Luc Duponcheel. Deterministic error-correcting combinator parsers. In 2nd Intl. School on Advanced Functional Programming, pages 184--207. Springer LNCS Vol 1129, August 1996.

[11]
David A Turner. A new implementation technique for applicative languages. Software -- Practice and Experience, 9(1):31--50, January 1979.

[12]
Unknown. Document Style Semantics and Specification Language (DSSSL) (Final Draft). http://occam.sjf.novell.com/dsssl/dsssl96/, Novell Publications, 1996.

[13]
Eelco Visser, Zine el Abidine Benaissa, and Andrew Tolmach. Building program optimisers with rewrite strategies. In International Conference on Functional Programming, pages 13--26. ACM Press, September 1998.

[14]
Philip Wadler. How to replace failure by a list of successes. In Functional Programming Languages and Computer Architecture, pages 113--128. Springer LNCS Vol 201, September 1985.

[15]
Philip Wadler. A formal model of pattern matching in XSL. Technical Report http://www.cs.bell-labs.com/~wadler/xsl/, Bell Labs, January 1999.

[16]
Noel Winstanley. Reflections on instance derivation. In 1997 Glasgow Functional Programming Workshop. BCS Workshops in Computer Science, September 1997.

Appendix: DTD translation rules

Type declarations
T[[<ELEMENT n spec>]] = newtype m =
    m (m_Attrs, m_)
    newtype m_ = D[[spec]] m
    where m = M[[n]]
T[[<ATTLIST n
decl0 ... declk>]] = data m_Attrs =
    m_Attrs {F[[decl0]]
    , ...
    ,F[[ declk]] }
    where m = M[[n]]
    A[[decl0]]
    ...
    A[[ declk]]
 
RHS of type declarations
D[[ ( x0, x1, ..., xk ) ]] m = C[[ m x0 ... xk ]]
    D'[[ x0 ]] D'[[ x1 ]] ... D'[[ xk ]]
D[[ ( x0 | x1 | ... | xk ) ]] m = C[[ m x0 ]] D'[[ x0 ]]
    | C[[ m x1 ]] D'[[ x1 ]]
    | ...
    | C[[ m xk ]] D'[[ xk ]]
D[[ (x)? ]] m = Maybe D'[[ x ]]
D[[ (x)+ ]] m = List1 D'[[ x ]]
D[[ (x)* ]] m = [ D'[[ x ]] ]
D[[ x ]] m = C[[ m x ]]
 
Inner type expressions
D'[[ ( x0, x1, ..., xk ) ]] = ( D'[[ x0 ]] , D'[[ x1 ]]
    , ... D'[[ xk ]] )
D'[[ ( x0 | x1 | ... | xk ) ]] = (OneOfn D'[[ x0 ]] D'[[ x1 ]]
    ... D'[[ xk ]] )
D'[[ (x)? ]] = (Maybe D'[[ x ]] )
D'[[ (x)+ ]] = (List1 D'[[ x ]] )
D'[[ (x)* ]] = [ D'[[ x ]] ]
D'[[ x ]] = C[[ x ]]
 
Name mangling
C[[ m x0 x1 ... xk ]] = ... unique constructor name
    based on m
M[[ n ]] = ... ensure initial upper-case
M'[[ n ]] = ... ensure initial lower-case
 
Named fields
F[[ n CDATA #REQUIRED ]]
  = M'[[ n ]] :: String
F[[ n CDATA #IMPLIED ]]
  = M'[[ n ]] :: Maybe String
F[[ n (s0|s1|...|sk) #REQUIRED ]]
  = M'[[ n ]] :: M[[ n ]]
F[[ n (s0|s1|...|sk) #IMPLIED ]]
  = M'[[ n ]] :: Maybe M[[ n ]]
 
Constrained attributes
A[[ n CDATA ... ]] = 0
A[[ n (s0|s1|...|sk) ... ]]
  = data M[[ n ]] =
    M[[ s0 ]] | M[[ s1 ]]
    | ... | M[[ sk ]]

Figure 9: DTD translation rules.
1
The XML toolkit from this paper is available on the WWW at http://www.cs.york.ac.uk/fp/HaXml/
2
Xtract: a `grep'-like tool for XML documents. http://www.cs.york.ac.uk/fp/Xtract/
3
In light of the ``XML Namespaces'' recommendation, in effect a mechanism for permitting multiple DTDs, such facilities could be particularly useful. See http://www.w3.org/TR/REC-xml-names
4
The shortened name elm was chosen to avoid a clash with the Standard Prelude function elem.
5
For those familiar with the detail of XML, entity references within the document are treated as plain text.
6
Actually, a list of attribute/filter pairs. Each filter is applied to the current element and the resultant content is flattened to a string value which is assigned to the named attribute.
7
Actually a left-section of the infix operator. Because filters are higher-order, their use is eta-reduced and the rightmost argument disappears from view.
8
Irish composition is in fact just the flipped-argument version of the Kleisi composition operator in the list monad.
9
Well, nearly! Validity also encompasses some other minor checks, for instance that IDREF attributes must be globally unique.
10
That is, parameter entity references.
11
http://www.w3.org/TR/xmlschema-1 for structures, and http://www.w3.org/TR/xmlschema-2 for datatypes.
12
http://www.cs.tu-bs.de/softech/people/lindig/tony.html
13
http://www.informatik.uni-trier.de/ neumann/Fxp/
This document was translated from LATEX by HEVEA.
hugs98-plus-Sep2006/packages/HaXml/docs/icfp99.ps.gz0000644006511100651110000032060510504340456020577 0ustar rossross‹¤†o7icfp99.ps”9ýoÛ¸’¿ó¯àán}ÀKLJ¶%{EE:x›ë«{EÅâ Úrâ«cye;MžÎÿûÍ)ÊvºûÒZœ¡†äp¾8Cýô/¦Wóúku]õÓOYS•»ºy£çOËÍö›]ŽÒ…ÎêÍK³¼Øi;IÇ…çd¨?–óå¬\éü¥ÒÓz±û^6Ìði¹[Uoôr¶ØL&—0 ô}(ï«ím#ÿ³™W°ÆÕvV­çÐw]ï×óåúþº~~£ üMÆ:"ùM=Û?Vë݇rS5Óå?pž«!¼È×ó¬~ÄW[õÓÍç÷¦ˆ–ëùß–ëJø×µc%ð¡lÊÇjW50ç|³ü÷±1Õ3™T7ÕcýTÍ…vZï›Ì«?UwºÞï6{LgÆ—QôÆÆ£7RÝ/ךz6­voô®z¾Ü4µÀ˜›ål§£‘ÑsæÕB»Î¯8Fn[è<à‹Áuûu¹ž#ÑáV¦mõ<{8ܪÁ];Õ·‡k=øô±Ý5åz»*w’,·«­^”«m¥{Ú‚˜´µ:‰ôã~…]Ô•^Ž OIß dµYí·ÓÒP^ûèy¹nqÆö‹Ñ‘ÕöÐ^Xmj¹¨p1T•ùmV¯gåî°\à‚«m½Úï–õvú„=ŸºÖÕ½Þ‚áTŠ V)a ó^c£I m@sÁDê¡#:gŸ>"?m87O*£µÕå|Ž£Õ§_Ë]³|Ö³}Ó€0ÖÎ÷¿ÍTo÷_uùu«Í¥?«W»–^À‚µ¨›rµJd8ÛV2#êìnä°©ZÖß®ÙW¨^5xf¼/W‹ªš·Û]¹ÛoÉh]7ƒ ¢5¼›Õ›eµmÿÊ€¾ÃIŠ_ËÝK*º æ7X´¸¾þbDm€®×Aû>çv¶k˜/.vårÕ*$IÙfo5Àb¬E½Þ}zÙT:FjÄ~eÁ-Ö»æÙõ]ƒ?kXRߪ-¼]ßëÁ×”s§Ë¦)_ÀЗ0<óÀýr5ÏʦÅaUƒrÊ׳cƒ&oU…~±ß´ƒE]kç–9D2lO¸þª.ç°àÕmì Šk¾€mm w˜ùEY&»f¢m‹Æ„wBö`4hÃ(CÕ”·›zƒk’ÁT DÈŸçHfß—óÝC À¼Ü•HªVÕú~÷ GdZ÷•#|¨0䆔Z(‡G”Ïõ6e£TŸ!Ž1¶2àœ¡F!­’€~þ|ŽÚ±±|„ØîîÐF¬|‚×ðt+RðÇx‹þó,çl‚ÍwlÕ ™1~¿•ö?¸!@XM»-ŸÐ2-øøâ”dÌ–‡ëF‚kõLð´³AF™1ÙêF}z¯ 9(£EàZ䨽ªHÁ[Ò4mNHX¬œ=Tóêi9«:šn tìÎm/.­ŸP&§y.Iô¿µNèz>–pb7Õð EyÓf3ØÅkšø 9Úk' Çí¢Ó`_8øfªÉu`´DEÕ3ìtfi9:Æ*XÌ{c¨x`õ}«`iî¸ÁŽ¯õ¦Ýo«†#`uýM[×ß×­CqÆÁô½&…ßj>»Êî]­Ÿõ¹ˆNlZb!<9(V›°K!/—“ øÁß?ÚÁÇÏîx¡ð‚ç%ü0PUÀ1ð"ò׎y…/Bæ«€ùíCý}ƒúÃB}³ 6M8‘*Ùu(Ñ6Ãc âT³p<‘ìÁ€}è;…‘>%^Þ†-ࣺ§¨AŽÒ(ÄjD•Íž(àxSãQ’ÚËdÌSóYz§û½|"ßá¶6-n¡ýIÑt}SƒKŽ[=¿‚e_|j»swú3ZÊgÕbóñ³ÎJ9§ ûšïýþP5Egׄ±´Þ`Ü[®!|‚¬Þÿ|³ÜnVåË_ªßy u@óómu÷ _ÖÍææ4J’£ƒdUb1ppµí=ê§ä×ð ‹bÇlHó¦x4T¡ÀZPàÞ÷οg§ 'áiaÅ©á§>A’ÿ,3¯+0Nåš úGu6¯ÑKOàüΩ°YÁ¸–àÜT®iø$u}‹%ìû „•-ÏHgrµ‚ LÆ€'®¢$½w8IGú+dÊxã+tcwB¥~‡ÍÚ‹¡þõ pîö" ª½ˆZ`²KÐ=˜­ô,[!úßVÆ}kÕ¡ïm—U»Ñ°Îw„Ž^#1\#lþ½UœnZ §n”‘;eÂgXk®öüD|ðmTÉ‘RÃéT‚$mz £3WaPQIérRÉl7ÕlY®¨š9ª[¦\Ùã²ÄiøöÝ”GÞT‹r¿Ú'[=¶žìO[L"*Ojñqi¶3NÏžP®ïåœÿÛû.AXN«j­|ÝÓ*Iu”œÙÿ9¹ ³ø›tCÔ©È^aýD¦NDæ7vvåW–S^RúuIÛï1¨NujHc(GI¸hß__&ã¶ožC”#9D*ÅWU¾¦ÅàÅ]Ç/`ær2¦¬–ɶá,„¼kgÕ:ž]é¡7>¸ÅȼqÐká,¥“®w5G‡Ý™Û:µ§]äo¥ôðŒ¡4 ÞˆÜC  0ºÙ. /˜ö+ˆ[\ŸêOÕs±¼o‘ìߦÂ̧$g)ù|•Õü0ÿwlh{r5ᦆàBR´^Ä’ô9Dñà롽·òŽ'roz«Ð›1=;hKä<UnzªªQ"BGkðJŽW⪣ ¦Û¾(ñ+^L^QAÌ/LÉüî-ÎŽoQ2ÎZè ¬š#½`hÁÅìxìœ×œÙs‚tò¥Åz’ògŒ;A†léC)ê—Rcìýd*'âÀŸMzF.,G°œ¯¸¥õ\ S€#[ëÜcðŽ KÒá–R]åaîÄqÎ:¥ŒúÉçÇ|NBnÁ-Çœ!z¢iƒS̾±¼7VT+™$¤GN`Á=¤¡a1¹§CàM¯S}Q¡»Bæ ©&DL1Ãå­`º)AOrËSMT((Y9{”Œ²Å•Øê+¸^Ä‘ÄRñ‘éͦ"ÞéÐ.Ê*É©é 9’Š„˜íg0ˆÒRŒ"1 ê¬9Ñ-ÔŸtgy¤>05gI¬dÑ:ì Ãô¡©6Uy¢úyG„×áŽÊUÍ:´Cׇt¸"¸fÏv9NR~·¨<7HŽ•ë²•KÑUÛجm\ò‡µ,Ö-¸âÝQ¸Ã¾ÿ3¾ÅkŽj‡ÌJï€äÛí®©¿ã8^ñˆÎ3ËUK×<ýñëj…¹äøÀ3ÕAxËE‡`P7p¤Bû,-:¥¤èg/oÑÖ‘XÑH¶.CweÁÄ~½²™é`Êð#ÏI]ݯ㉥äm£Qœš œßte7–ßÏÝË¿(¾Ôƒ¢6†=_üblnL\ôI.¿Ì˜ÂýRúYx­ðãh,þ2þ%ið.€ÌÀk3Æ\™½JòɵÞSu£s`ã+x“µ–ø pLaz­9jqMߪãÃŒü¨æˆÚ¤ Öf±" N™ë1-VËÔÚ”Û„vc ^¨k‹Œ×G‘)Z¨iOЮMqáÂĦßFÌŠ fŠ€gËîí$&ÙUÙ·Ö$úæìÅÅm‘Å(¯Øf N3¶yfbl‹TẴ‘^{¤µs- Ç·Ê0v(- ZÚ1ÎË­M¹S²`Ê:Áe("\Ø$¹™Œ¢ñ[ UÛà íÁ¤ld†öEªAáÛŒþç†PEF–Ë3ïžl›%“Ç'OÞ_øTÜðJ'O1†Ü=-­³ûgLû6›H’‘l R?Y‡M¢(™\ÁX°~ÔIVŒ\L=xZ•w&>ÙˆOŸ4Yþ{ ‘zè('SÎÉs2ãÌ2WòD>A.dlb'…Òsœ¤ Õœ¤ü§h¶%” Ã`€MÆhŸöšíSçjPÌõ||,:åqË…øu$ÐæÜ]¥¤}´~Ä…†žûÍB-›Xbƒk“ü¨u®^v¯´ÉqÛ›,® ÈS‡Èm\Ðmˆ¶@-S2¹p™d<)¢äíd¢ÐØÅiÏ4yÒÑ“Zdž¤Èy×âò‡gêKTƳ‹Õ/âKrÖ¯ðgzü¥^â†ß*†ÿ¸ En@³Ä9ÅÔ¸ûe©Ø‰Â-é”-;¶× ’‰Ä‚á£Lr4¿„[Rd(_’Cž,î"/ÄsÆ„ˆ5 Š+Îœa.HdIbCJÒIâ8Õ)v!mb…äŠsç!…`ÆS¤áÂ=2B 1¤ya¦ƒàEBš@¢15¡N(àØÂÙ/Ë#:šUÂ.X¡)ˆ^£PIú2r„lÁ[D(#¶cU° 'Æ’(Ä9›"`LÅBÈ9™@ʃì;§ï€Ìˆm(u&è‚/b ñ x²i¶‘ƒ„†Rç~…ø:¾TÌ¡,bõý÷ ô²R([ìCñ9HÂqåÒ#Õ§‹ÆD£Ža¶q¨±î¤ñȧk ¸•¸–™N¯œúªSѾ0?ìöh»Ü­¦¯ëÈeÊIÔåuæHÔ&¬ÅT˜ä¤Òk n 5. $²ƒ¸;G Ñ>[Æ xÅDd2’$´Â[bY—u˜îÅžéœÊ:X²>ö£qpÌÑû ÜYE'~ãñpÞÙD“’30§Xy·†…ë3pÇ´‡SY^!eÖíÀf×6íÃŽé˜`~ÄF`•P®ËHQpy@±H)¿Eÿ·!ÕÞ&Rv¦'L+g.ÞëÇêÃñ«°é&ê¼­³Å8?³Uˆ˜Nìnµna]ÅQR\™(‰O⟧¶ç ôŠ{ÛI·dÇíh|bÞUöØú!ƒÖÅÓ…N8R‰Å`Æ@n±×1=-'Í|V"„éCf$›Äñc,§ EîKE)gy±”±ÜT2ÄVê¡× õP‘®ŽuÖS…pX¼"”ûðfÆ}œ‘…ÍØD!’ÚLlÆ .æ‘Ž bõOéø*v®õ#ŒÒá0¹¹ŽÁ€c¨Ú~ *—, ÄcàH“+•&vôv”» çžøKé‡q ¾Iyæð‹ôc·µ±0œ‰JE'´¯ ‘W´Ø{çK¡h¼L:½—=, ǘ ®~è½ìcÅ똽öN‡A ± jŒûXî\õ&Ù´ {XÜ‹“I÷°ŒC}‡Ú.žÙ4ÄPfBŒ"¹ê£ËBÌö±4ÄHEÑ‹kþ:(q•ŒáîW1Û¤ªº9=6>‹¥žk)A]Í–†˜Ø;¶{ظ‡å²5FýÅçÅ>/Ê|`àBçË9­$4ÆcðÌQ|õv<¢„߉£KÊ|Šßa…Û‚¢\ǧgY tÁ’"`ÓI$î5 gC݈ôÜø3XqóÙ0•a¤¿$9Ш kë>åÂúݧÝr®´w×I(6&òy¯+0²3=¥SõQÓ[¸ÙžJŽ1•õЋ_ÁÒn!Ùc,ZÔmœYôXðk{Ø‘Öœž 6RqåÝp9늞avv©BT˜Ç1Øx6þžo®ÃÌ7áÌ?u7²9&p†äx†Çpçt`¹ÚÆPIgz,kj¹h #pÞ3‹¥`rÔ1{ÁMD •£ }WŸàA5P¸ñ…GPtxÒáEî:í N³*ßTð2îw˜;æʠ㕲Õï°Y ‚˜Ê„$À1€v¼Ã#ö¸Ü¯%áf,]¿/lî˜-²%Î\ÐB ñ‹¢$¿2á» é '0šÎ`H ÎVŒ;Q\„x#AØÙ¥$ìíB`Óƒ%¬å{vp¦àëy]]×/òŠ>[¦vQ˜s<*ÖT¨%¯‘Žìk9#y½ð¥¾ŒOä.0ïàî¼·yÜœr?À!{¢+Ô–¢éý™ã8gº„KÊàÆÆò_¤rZY—J¿L½|MìOžîª‚ci _•.°ùèɬùÄ©ðY¾(+=iU!\³r8¿°\40³²¹8s7aþŽŠcç5(»2*â%†\í¥.^Pጄ9}¬àÁb’q€3ÉMJ·Â\œ”+V'•( ‘ó$¹Ó~Ÿ]|Ö§Þ¨¼ñOyÐPú(> ùd]\ÃZwâÐG )ûÐâ¸ØÃëÑœr²‚¡X!Hîš óöÚÕfñD6IW$m/7ãe8pD™zk#÷j¡#ü Á©ŠNö1Ý–ñ=Ì4†c´"WÈH#¨1W6J¢+,db QœatOg†|f­2#¨{r;y;¹* ÿeE–ж’4sUDŽ-Æï>¡$RGuÑþùBÎý$ôRž{­ì$I'©«úŒ¿ä¡à®ÅßlPâR¬ð’¥»pý'¯^ÕkÖgN ^½ÂÒçðÏ2hs‘«SB# ayÊM€‹Ãä÷rîô‡„õsänUòÇ /Š"€`æ(Ž 6¿J¢ë·ÉX‰’œ,x¸‹lÖÇœ^…äN^©êuôsGÛ‘WŸ+ñxâJ¢B¾g:¡{\„›3¿‚ã7^–sÒuŒÙ}à<Áù‚*@1zJNÜuÈ–å›vç/ÀÄ©àÖãøÖ$¾ÌK ,îã¹ÇÑÙqþøÿÙû×î:r#AýŽ_¡Ów[Ò]õ667r»mÍ"“‰ÏLÏø´=·{ÖxÖ:,‰’XE‰jR²]}î¿@¼Ìý"Õ~µY¥2Ï@ "ôñQt°KÔxò^º š1>y/-. ÛŽm‚‰ÃL¿d&iœ[LãÍ¢5P^Œ=¢bœd†eÔózÞÀø ñx^ñÒ§x K>¦UÝ›ëáO…I†’².Ðz¨Š¶™š ÌHR(lÛ)m Ùj̈Wâ?TwKll·à3Î(eó]§4²Zè>f¶ð¡ý°×=™"pG_ò•fU|”¬>eó¡È‡HIÑ¢~漡ÁJðè;32©'ÛÈ€h$ ÙdÛÌb£a¼‚¢‘‰ÅPh„ Dž­j^¹ ó@d÷$ÍHû£ÂÃH3;z êÇ…²ãÙ¡Þ®pÝŽšî —+æL Qt׎¤T1ŸL o¢¥S¶SÄxó2ž á|àœÝ$6-X0—û$6»EÛ„‘C[–𠎢’ÃåÌ4pçà.Œa¤ríyƒý愲3LnX•Š=.V›4*îwÆâ^DXù ` ;Dà$ó€;óå_Ȥ‹]Ok¯ÂûUuWÉü›ªõaµ”¬\rF–¯—.ΫÑÞ§›©vÛŒc¸CA5;+¤Ö«³4±,% Ë»žeîÄÊÇ–ù’@·3y2ðúiÄ©Âaˆy ÷³ž^æÇñ,çÎÒ-È*‘pŽ3!\¾ aMò±P@¨u#ž†É/ÚUóê™Ø"uðlž%VÉžÙG»Q!BfxzœW¨KŒáYVcÜIÜ`¥]Qå4hWìZ•<5¿Ì¤e\c3kÀÚ<Èßí(@)_ô•|ø‹ó}À õÊZ‹°*,âùù:¤ÚfÁ ¤ÑpªÃ×½?&•hî"¢' ™XæW# U²5!¯Zi¤.2 Â2b˜–B(Ç„eØ'*µÆs@Pè‚-¸õ báÊm.²lÙ¼}¢S _FÜ#…:QÈ-¯³س Miö˜J&Üû™&’Ie¿Iê`B'"k²ðCΈ3–‚¨`®É‚Tw(ĦË‹ó‚ /£Óù*¤ËÊÉ„Õ™O[Œ¾=×1‘ALeÅÈÚˆwºùΘþ\³æ„ YdÞgfª wYu£ç¡>#[)ù³ \ücKuó·2ô)i–âæIVC‹qž2Í2 ³ ÌS–ªÔçíT'«Å-ä=Ë)w9á.2ü>÷ )ö+—sî3ol±—ËŸ×Ñ-4dÞØyÿÏÚzTgÏÇh>Žn^ØBÌ»zŽGÇ $âñz jñÍúòeŒ®ÁôÑ»,úÞ³càú„¥xÞdVÑ&4èâ]©¯Ñ¦{aêâc}|Hmâо»&¦.>5›1®OeiÚxÚ½äÕ2Ï&˜›¸˜ðìˆ;´{Ñ„ÔÇ}ŸÚxà8×E}¸(O¹™Í)µqœìš çù(¿S%>´ñ$ñR£•gFž'zÞíÃx’Id—f´ñ)HÓ˜áäá•ePã¢ÂøÅHÜ*Å«Ø-»é¤Ë2ÔŽ[6i{ä/^Äó4¹‹³x)&½˜ûÀ¹ˆQ§5ë%¦‚ †Yo;2˜š¸g¹¼Ù(…zM Aµ‚Ñz ¬ã0VTGfi²M¢#{ÞR[QlR~ÈXÈï„œ¥>‹Få½ÛÿxÊ=”hçǃL‚‰QhA*;CȆ3–ÞëAÚ À÷`Gfffô¬¢l{Ùe^¥XæÛÅzµ}¹IDùC6H˳+oæ^ÔµÙ£ÌÊRÃÝáÑ“:á1A¬JYÄ:,ÃCÜd~x¬šMŽÖ#¨J© Òf%K•'ö&†x&"7 Y”àÃ¥ï‰M®.ÆpÚØØÇœ&7JƒÐŬa1æxb52þrŒdKªõ,Ç£*¢ŠL:F# Äò€©{3júƒ«”M–c¼ŒB| ix&ˆ'wKö ZZ$ç%‡ÂÓ¤éb/ôü!îd?—c0{´o‹ö&dB¯,ÍŒFþ–ý^‹&KŽHëÒœ[®3÷ñ¡‰#YÅ8j]F?gvÄCw=o|(Þ³~†Ì.¿ÐóÕ³x3$•Ì¶Œ€·C$qÛ-;*ܘŠîkÁ¡ ºC]|¨Z8UzTlyujØý:r? /ç¶DlM|4å¡ér#Ž¤¦³EÅfšÓµß˜fRsbá¶ËÄK/“WΤ)t ·9œQÓCbC•§&Mµâƒáµ lȈ¦ÆYj'ÐØ—5µEP…¤«Êjå’£vî¥a†Se JF£eŒeÕŒ“¦;SÅã‰æ¦/çÁ0×zßXq©©§›ÂBr—R³9…¸ÑåI“k“£ÅfI%ø7Iª5F“ºl%§‘•<Ù#S£šÂÀ52ˆW[wÉx9éˆ]}*näº&9ûæ,Ú›Õ.â]à&5;í…Y#}ï ’ÈÅç]šTbG˜k1_2Ÿe’¯£2¼”:µ©ð›yÔdÐ)yh^nOQâéÖ¶~ ŒGØd4/«83˜ÔŽTA*_ƒë’/F>$bSóà;êFsOSÍØ“þ–iþÎbÜþc}6¾L©Õ®xk3jÛªª.åá•×¬ãå±{Þ-+é‰8ÚÃʹ•É™¡l¥*Kùº84Â"8¶/ÿ'm%6©k»¡j~é…že9w]BìÆç踎}[ãSãæÔ3%œ×.8¸8&>o¡;­Kv·ÐíxáP g:!£MÝ¢ºHÃECP<_Ñ;`‡ztr×á)´hCƒ xoö«6Ýúk 0èX9×$fXy*Òi±Û/àDÉj Í4Y °­—4P‚’á7N»~Ñ5Ch ŒŽ,º2yOÅóÌi”f#jSKª8ýR#¶R æ@hÇ’§¥ß„G-F\ÈRÎ<„œIl‚@J볂YëÕÊœŒ}÷,nž…Õʽ~ós`[§<ûÃô"‚œ¥Ëm Ùœ_å7Ø‹ÐYõ"”Y±g†É*E­íV2*W¨))SÝìýc¾Z(Äø~rò‘;î+S-ôEV—éò¼ôŽCë%ƒM•Ï4„ü±ÁôÀßIQUL¨Ÿþû„ŒPÑ‹¢ AhøáÃÙª Ûùºb úo C.2ù Czœ=f8冒pÁ©æ9Y‘Éo _=nÛŒÃl4Ü:£¶×m.ïgɸ“C2>v>'ã#z/ ¹·–ÐéQ| ®¸Ù"®ÎÅÌæ/Cå凉hjm§4Nu8ðfñÊÖX*è2yXø—¥nöìb>¶Tâµ;¿¹ïí4á‘:ÐeŒXyò®øKÀé´ÙÍÂìoN2Â6mKÎ/϶jŠØûpƒá°ÓÏê8Hìâ)GÇp³:v@z¬!vã°ëÏ‹]ž/¢°@§5‰f|·g¹ 5 fic²úý¤EBö%ÎËL0›ê^œÝi²:‚CÙƇÌ;B2ºÞÕfÄÈ!dRWàTd}ÇÎß“3òG˜šü~‹jçFmò–FWë”ÏëR¶ÙJŸq_±kR7ÉØ'B¶ãŸÕ¼k›ëãÂÌaÎûÃ6ñ͇iVÒ±áBg³áCVã»Ñ¦‡ é³_ÖU\%B[êá-õ°çcsƒcBwü„M;Â2zb¸©»º€‘¬¬/ÓŠ°Œ§ÃdjžtŒÉûÛrŒ,Û´˜Û)#Ê rvfN^À‹Œmc¦…Ð-?H"ªÚ0aÿ ¸JX¥Ã,¢"l\–Õ±mXÉ f3ZÂÈ}˜:róˆòŦڣ3Ê­­og(k¨èÆRž"z¡™"iÔ!tüÀgrkšF²—žØ(ˆíHÞB­^¶1„1õàkÜÚ;Ì…au9"M³9×)1ˆBª)ט®ëÈ B 3yMÏp†c4!¦—Õs]VOè3à@ZónÏ~pØ !Ñ®Vâã‡ÈŒxª 6md/x#}Ùr2 '®àäÛ£2ÍbL¾âì?à ˜%bö·FòZ¬. ou ¼Õ¶nsh7-ŠšƒgM ùÂÚ€¸lï…`º·`ÍÅ”¢:økÎ*¹N†#CðËÜs62Lô+¡CjE®!Õ8àv fÐàió¨(E+­$ü´%ƒoybákSă¿_r2’"Ô} #—ç$–á¤dáðkƒÂ¦ ìûK¼Š‚rjBQcŠ/¤Ó„S®àÙ¦“ekBN=S¿g;˜ôpÔ††Sr{Y)óá,S,0`8DÇ#Ä’ tV­2Ò78‹tq2£ê™’%ž8VÈ€·4¬$Ÿ©PQv™ÿŽ:ªÎ++×; ­tô„¹q<Á£šdºÖJÊ.9sû­g鞘„{&ˆÍätmB"2dˆ†vݸ”ÁŽŒ™ßîÀ5ãÓÃÖ†»W‚(¯iGx§º¤€¥-úŸ ®¥¹;B2mˆäu2ò*žÕ¼ñ’#mìÏn´’ÑÜç`*œ…Íú&ÃB~N!¹±A{õDØ&3ØV•Ö‚Âáõð#qøv¹0 ôiëEâúA–±=²¤!ât"n4e Ý1cvL¸'£ªé ..\áÓÃd– pæE*ßñ»pR©ÿs¢ñù75sóØ_wêø‹-›_‡IaSxò‘´=²«Ñ0r^­°Ò:FjÉÃãÕo\rV±‹*ðĵzþÙfÄ‹4 nƒ„œ÷å]²žaDFg¾ìT›Lxΰ±S?Ð 'ôí·º]N !£5¨Ä¢Ö¨þ`Èéa ÛÁÓO~\=¼ÄËqvÚ;ÇÁG䓉ãa"hÚåÙv®á®2\SîÊl¨á[È~a9tö3ÌH˜æ˜Ùï*–L÷'6ˆC•Ñeà ±êtYbYXÜé˲ÀâN’XÒh÷œšÐõ Ç„K”ÉÙ…–m úÒ5iõñ¹bzui’ tœVûzB3ôì€Ôàð>¿Ÿ‡n׃ÝasZB§@LÎÐ.ò„…_DžŒ÷¸ ÉÀF‘c)ÐÇN,Ì +#zå¶P“0š[iFTÐ/øsA†K.ž¢fY÷ZZ±oZl®;ª? Ê7¨?žÑ±a›{ÈÅ)-aÀp .n£¢ÙŒ~ZˆÙÆy»*¶YØU\UX߃aì´díÐÎÇÑá Ye”dJçA8t°'}š-èB‰°Aþq:;¨§ùâ Ɔ¤6l2†ý½ÁZÕ†/Uè 5Åm^l/›ÐÜñ6¶!í¾Nè#y43 w]&¾å2ÚÓUØqĘ…‰õ‘b—Ûr½ÚQoiÁЉXǦÈ"c¢›ZYÊÒ4ú¡ik N"àá¼´m¢1S#RE 1½qÄ~ñ9L,½ X ©ý}ÈçÂèîYñÙ—ÉV;]´aäP:¬§»bÉÚ…}rˆ¬4yÍä7¯R9ÔƒmYÂdú3QÈôŸ²­žð¨]µK¹yv¶ªv)r--@êˆëh¼Ìè(ÙÃ&5mË èQ¤^h6·¶$®'+&Œ²ûã wèÅL“–Þs§–¼ r_&›QèóþI߆ì€hD Z «2±Ýù74’Q®9våÄ ç€÷´ZžìË5ñ Ãsä³pM¬žBøÞäö?>r_&Æ£Ý/’‚–Ø7/„V¡ŽW®ÍK÷K¬AëràÁ"iYNïd&±ÁËáC:róÄÓ‹!÷%jóGýcë—?¯þ ³˜'þ¯ÊÇýq˜ÿ¼þU·eø_ɨš¨€ÿÆ!Ä—1V³¾ìVÒèYc­ÿ£UJ¼¨ÿW6üß ´1ÿOðÿ‡»êÅMž²öõÿüÖ¡ÞÖ‘VZçjóê§\‹€ÿ6ð_uæ9¤úÉP¾¸6¥ºë5]ºaÿJK×… SÐÞ‚¢}KŠ|C¢^âúJ®idjÖ­‚ìTžCQòÎòããËùíÊ·Ï/ΔhÏÏ-Wôôü\[ÁÅüväÛæçŽéÈcêY3ÚÆ‹ty~˜Õ¼ÒÁÌ,ÁæìôàÁVŒwð¤ç9«;-ÚÀaÐs2»`¸ˆÕÙ&Ò4L»E¸R—ÉÂÌæÙá”Q¶p4 B€&ëw8GHÅYµ ,Õ00NB¼`#È <,zY†å~À‘ízI5òao²¬.Vç…Êlc@—,¡ñ‚¼wærIúdÝŽm7ÞRBVh8¹cžg-Åbs¥r°%:LÄËLl+f$—J{a<µˆP óǬühÍH½Wd5Â(°¸‰z7}Ó ¶˜âŠ£f4 »X›ó˜Ù4A® öLÅ[ØÉ”ç¾È¦¿R^†£AG:ÌBÍ"#VQ0jƒâ2íŒ0¼º¤õ#¾LgG½Ÿj‘pì\ûRS6º/“Mw¹æ!hÜ9ò/YÓ”Å_‚â”RBqÅ°s ´ZmÚ"m¢ÚâÌdªÖLNÚ%TÝ4à ©ñ0ìb‘ä™ GmŒfÑx8yO'U1jbǸîoš¨Ä.GÄ`·‘/(ÇÒH¿ ±X/C™ÅÜÒÃ',Ç|ÞK1·ð½Á,ÇøГ×[QýU×kñ1‡”œ̵±X¸Ë2ÓGE¢¤rž“-•+Éþo’Ì*i’KZ„I¡9 .Œ8úa˜öFVa¼ÎlÈþ üÉêÉUv –!Úˆh0x‘ßù@È=®†ÕˆÙÖh—<ßœ^µ°ýuó¤ý¿ÓrÉ™’ŽGk*MЦµ°§ÉÏìb£BÛ‚-ìv=8v*7ú.Ái¢+ÆÞð8GòÝ…ÃÏCÏ™¯êƒu–z<©…9¬°_`¡àÎ(`}'º¡·@ÇÓh@—x½²·76´öä2Ìƪé<6ÖÎ:N ýBaíb.Ôh™–›f¡c€TVìNM6=1 2ªw¬¦ ~B~$:èÀh»¾s¹:/ËßPoÇø¹ž@÷¾‰ÜÔªUmg  h@dlaÕ%^ä¡ÐÃn×…mŸí†Ý1/ýUgdÅ’%b²Ú:¢­™–?Ò¤ ælŒîÅ{C´ê¸:Ù+6†àÑ áAITÞ&‰-ÓˆèåLË6cic;*‚·ßxòºë3qY¤ÿ3ý¸¡¾ÖÍÛµ¸Q`v^¥qY £Jlâ:8«Õ~ÌëfËÑÎF°ˆá0lOìŠp[w~+û3lhmõdéè‘{ÆŠz‹Æ§çEˆýUN ãÃY•²Pˆúµ43Ôë'™7Ë®‚•¯èáæÚŽ¬yëÔx nî6{ÏÁ¸öŒ·ÝdÆtÃèq—¹’QëW‡ƒJubͺä¤[3¤°TC†Yºf‘FÐM&2µ²™_ûúÿDw\±÷€z$æ;6¸­²!›æÿ˱þ¿ÓÞwaÖÕd$'· /·+u=æÕ†[î8¨iÌñŽXä°.|å®÷»Â¨Gõ‰Éði² %ʈCX“‹Ð½¦¢õ?†—¨VÀ<=cOÀ€T¬ËPhâö¼6¹ž#âµ£?|%6:ß%<6¬±o äOÀqïˆÈÂme‹n/áìô¢ã'3öq yКŒˆâoô‘T‡ÃèG)d`Vx‹5N^ Y¯w=Þ—W/:=é/r˜P'Fô3ý›tÉ#• i%QÂAµ!(P?šÑ0 N„‰ \"‹=:ëÇrr ÝòƒŠ­0 2Xe×κ ©¤ 4©e5t"å †ù„ÐÙ„>#. Rˆ–ðT¨IUå™K{LOAÀ=Bxl¥'óðL.E<žM«®)êÚ8.@Ÿ$¤”ö×þíD³Z+FBàM¼xµâÈ’ó„p’î¥àE‘àzûO.öŒ¾a̯Ûõ¥’Ev¼sTF§þ¶A¦3,µï7h0I—Ò§‰huuÎS?ÂcÙ£sK9„‹ÄD‹Ä‘!œ»`—tBûpDq¶\’ϲöê-%œxÕïµtR)jWžö @{0À-œÐ#~ˆz÷Á‹Ÿ4¹û2‘^b•\† kü‘KÎrø8'8ÝŠ³qß©òÁµlcŸG»ÜšpغC/.dÄg3z7š8,„ePÂBË;ÿs ô.ègõXrÆè1®ýçú„SþœÓà˜ÉyÚ^e{YË/îø]ª¼›'™?˜}椧X›ÏÝ®§þ>1#¼ý8#:f< L¿@ˆÍDrŒcˆë!ž'¤I 3©qiýfÍzOZi¸šÿ°‘2JÄN¡ä8ŽhˆÔ ¤Ê¤#öù‚ÂÌ–ò»6¡»\ÂÂœK§ˆ²!áØ‘2øt'}ØÞ]’äÄ&ßɈp(·SD;ö¢›ˆp™2â`'ᘆ ”:“•BY7CxoÃbìB({¶bÓ;IÇE$!0Ê9€’* ð‡™›†š‡¥ûu»œòKJ¾l¼…3$wá¼rã5‚‘˜$ DЮ˯ƒ`€_±XA~†¤ATmì¾f"3Do¬Þ[K¿¨½E“A{;@2‚w3œ¿aMò+T›µéˆÇæ7Ì~£GÁþœù<îô……Oknµç7‚þ¢][ÑT´kòpz΄êÜèr¸ÂçLl¹*#‚‡j;A·¿¼Qx@¸,Õ£Ú+TxĶ¦K…A@ÅãÁ"µzBg–]œ¬áÞ¬ç^¹ ø›|{bàÕu$xS«½ˆá'o ^üLfBÔÌu2Ji[jJž¶'ª‡2°<àX¿@wïEö#†®ôàFC`ʉ4\Ä+ª¬‚E ‚l ‚¸#g þ¾ aÃe³uqB|';‰;1 ñ½×ýx c¡§ÄCõà=xÞs/äs'\àm3モ’Hì9¸¬ä‡gÁ?;À'„ÜY]sO'¨…¹„¿i€…(áÂ/ðÃé¿N#6;ÔªÚ2±X#ª] Eù2]n/ 1z¹`Û :‰îm‡Ù¿t¹Í¡_wÌKÎ(Ù ÜPæ‹mṑŸ Å&@N"b_ôüB¿ƒþ–N¼½ëDÝ?È6äH(›M>*ªM”€‡Èr­`ÞQwͲ:i2¿á¬ôuír¬·0¹‰ž€@—!i¡”8pÅ&uzL@'ƒ¬Í½>“¶Š°;C˹/œér΃½GjYdþ£Å¬|Çê8åuˆã·.ÈÀ/Ü¿ƈ]Táã ü+X'‹ƒ ƒì`ùpLgÂ_)sïoB×ÀUpqXïZ鉶MÑ)V`.rôl°Ñü:—.ðÚõ°Úá¯E"a‰ÁÇÖVy ‘ ^ ðf¢ÖÒ~ wú0ëtºþÙ_èÅ<Mhê3*àB›p½B-ÛN”å5í#’ànb”ì/¼å·`£˜¸Lb ö|¯kÎt#Ý˃Žäê¸:$ËðKs ¾Á/Ç~l˜Vë/vü~JøÔ®•wilgk¢Ù…®{C{=S`\ ÈmUht#ž°ûc™³ó¼×õŒI‚“ &6ê"€öÁo&4y•F4}Ùå]?_šœ]›þz–‹’ýÝ LFªÑlH•Ñ‰° 0A ‹y<*Tœ ìüB`«) z[{Xg4묧ét6Ôëÿ¸aë†eD*[Œašÿ¢öãЯ;æ¥úÛ ¿aÂSÈb…EµZqyµJ—çåS^… ²&³ oÿ­Wاe„ªÝÜœ€ éÖMŸ‘¼YÝxKyÕßæF9»ÌX•ƒÌ]g×íf97)“gÀ¨‹w€c+ÕþIo3®sÝÌ iäVYTÄzðÞÔÐ:ܘÅ_@V oûÚ@Z9œË¤ù!£Ù5ê1ã©4+"íˆþâ-m\>:¼J)ˆÇL.Í "pì žd €ÞÀã^€ß¸…_xu¿è ¯ DćßÙmà· Š›š…4òŠ`YêÂŒ6¢w⣳U¥‘ÉøKm жê|(ByÆ ÔEøƒ“æ%–ÀþÒ›¸–GÃT4ä¾®dY(ôŠÜ¹ÿEOˆ g°—q€´qÎËlE×Mi›â¤Wbü@6´lÀÉ"âíéq°¼SmeÁUåtV•~¡!4üŽ¥CúÝG›_à‘œ øÝ<@äÑ, NÒ™.¬0`þ¢‡ú ]†n`nÃI辜ÃD¬…÷ ô`c©‚ë߉óì%†Fzà_g#‹¿hþ^¤É2zF/)EÁ΀åo$N Mè~‘µM1àn‡:»·³U6pç¢_ØJÕ`í†KîÊ7ÀTLèUå@kÿƒŠ°z”]AL} %nqqû¥¹‘•ÛæƒõŠÀ8àÂa"rÙßDsH÷ð.CÍäG(WåI­Ò¶nhN;ùAš H­Ü4(,° ß75m‘·Ï†í³°J•I±÷ .ÿÕ{çÿ9 ú« ç×®r çÓ*¡‹´JÐV¤­CåžÃàä_Xš0#üu6²ÿe‚° ) P7YFòÉÅÛ4§†¤‘‚Ý È:gt —™B æºõêëú„dž”—t¨F\s° ÄÙNYŽnX|lWQ_¯¼[M5/iÔ‰˜xiÐSeÁBôbÌâ+9N¬HåÝD/û‰'@n”lF®Nµ|#·ºS$G´ÕfQx–Qo ì<Ë |Ä# )jü=0ˆ÷Ÿ‘·d*äFn<îùÕ;…(g{“ yû,ú­Èw!Pí:t\EVõõ°aÆ AóàIËÞB?MäNnA«C°UT"Þ.ñóä9d¢ÐdªOƒ"N0ë ÙÜ!£GuZ&ÚÜýc£qÞ †š=ñ°ªµ•â—9Áx¹Ôƒý%à̇ޤtÑZy{«­=b^±÷áÒù\{JvþÛ;Ýá—vÐÞ5VRl$6Ï#3ê«£t—s‘Zm]ÑE„ÏS¼ˆÐÛ¼m¢ïñé“äm+k‹žµ±9i•›»¥gí:¦Ÿ^áàK» ÐJ¸s°&ÛÓe ø¨é̤C×BoŸSo{fí¸LèúÂU0Ut©ô,dà&_ox¸`í0NI¼?„äKœñD¦ˆ«ÌÔ`æ«„0Ø{GjÆî"›’¨d®É®šîi«½ kqq¾áaæ„7©ö„îØw‡Ø>w²úo]#›ôÅÊ'˜°ƒ²šK—‹z¼~/Ö.¤84ÁÜçËdk±–qÖ)[œýØÈÚ™l¾~¡ÉÍT†b”¡à3ÑY/¹„ÞÆ b˜LØGO·n09ÂILƬŠýúzwOÓ½œ¦‡»‰i<Õ§ËÐ…üÜÉLå Û’ÔÞ…Ã^ãz\ð:1]›–B¹ZpbÑ‚=£&!絯@‡‘‘60ÅËMõíÉ”tG--ÒUAaâú+í'ˆÎŒÂo IVÂÄìgPšbqß)S„!fe¢@°gÛA€@(Xðv8Ñ’ˆßl+LPÚ˜„gÏ|<Ñ!²r¢…’¼ˆ­á>\†ÜþÇ3HüéÐ"ä†6‘^\­ÊÜ›h¤ùRcÒM,†ŽÔZ<(Ýþ‚HJ¸öbu™º³hT1ÛERµøÌZ6²ÇŽdž7—~é­³y‘` B‰FyvG‰ 6icRæ»Ò™€yïùZ=¾]™>"…‹Ï™É,‰½Y»„³ƒ•i´2aˆ§€ø ì^‘BµN1ë‡u©ç{f5‘—j_ wÆ!ç;4³å Œ§c±éíGbE8$"å˜Z¥T¹·…Öy¬qaXO@§½&´Ž &ã‰(Š‚`ÑD]Ê“× ¦t?'ƒÌUÓôÝ)¬:y”‚)#v/¢myù%àKÈ IdnµÙÉq,ë 0_·FÏ ^(C·ëÁîUÝÂäx]N:¥pÍËÊ+Àr7 ¿€¨©,6=áLË;…Ý‚f¤r‚oªÁÀà9«~,#•-géÜV±«Áñ²ÑÙYSh:j°ožÈüFrED¤k v~Ï+èˆ,Q­¤º°ÕúØaQŽ\œ°0=fVg$,² &̳¨ klù $-E€’3Õ(ãpˆOWAhRÄžA/Q9ïÆëÝJºí` ;ÎD¦ˆº‚Àso¯`!„ú”…“9Õ²#âŽÓ‘éž¿…óÔGg|¾ª÷=e@§Ê3ÜQ±ÿ8]löOªPöÒc©ËœwGĘŸZ–nçH½Á%R½±Öuƒ™½N;ZØyX8Ù›ä ìY“ìºtöN+™6ÉÞé¶éi&‚ðÎXp=w=pòÄä.ŸôÅör‹EΫÞÇós«ç<~w×üí?ÝOÇlÖM㚬|X¥Kp¹ì©×æí¥%öéÝ\¸»9 t˜çƒzK˜çŽ@½ŽÖqßÁyo<0Èb2rË™xøL9g¤·À4l—Þ«P\Ï’“œÖÔ)´-3“ˆúsdÝl'çï篖C·û…cH™þ-á5e œØ¸7”±eäj²RE”ú¨/P…ÔÏn‘hžX!Þ! ™°î‡œ‚̹0ƒ’±Pp Î!sŽœª ¦ÝPV½ˆ½mǨɨ&r'+”&—½[º•1?Sh¢£yÏò.KR¥L¡I âȘHãnèN›ùÉ Å£!7O\ú‘’µÂpf"³rg¸&ŠJ—!i@^¬um³#)žBmÐñ³‰Á@CS^S‡ lµ^‡Ž›:*:RÚº2Ä…m·s»áy?ÄÁ‹ìDêaežíEÍDÌÙ3ËJxÀg”%}:‡,w·òx˜mK¹²æñ!ÓeÙ0L©«)‡lL MCÔpÔöI´$IXí©aµ=oÍ·N!\«!XÀM{©Q¡ ™ni˜'¦=ž®Gº%·Ð.Ìv™ K[~¼¿^Ñ@Ü2z¨n°3N·NBš,ê/B8údÀ<ñZ„ZTí!·”¸?æ`©—Spµ¡ÓÈí\¹Ûí}èsÈMf|VqÏøî^wüøî^wüøî^wüøî^wüøî‡þ‘㺲¤ÈÒ÷`úNº`Vë[¾Ó•5ýÚB ‚@‘ TIA+å8¯ÌÏàE‹'——b4p~Ž BË}rǾˆµeLjëÚÐ@ŽAbUò!<Ž¤ªk¡¶­› Ò_Þ@°ìµ]¬ÝpªµãÚ<„` nÚyò|eSv¨t]úÑgëëÂ;â£~Ü)o![„ÜòãÓÜj™¨B÷þ´ã³üãÚñY­g$[ˆû,Ô®8`ËyJøWš™cîÌ0–¸0Gr³çyÆr‚lüÅwщ¥± QºçÐ dAÆ4ÐãöËäeËeÖƒíÎ n_8 Àœ ž!ÔMAóS—¦Ï>¡'GYo¡kÒ(Œ€\å™FnmÒ[½GÏ×¼§Q|ä‹Þ%™3"²S8&…&†X«Zh¹jI-Äký$ØÑ'6N¬äÑ“6)MRíÊÝp´yÆõ–6žŒ]Ó7Òu2&!æôš8à^pÂñ‰DÜFLÓgì©28ŒŽAMÔ¶ï äŽ}ñäNÿdr§² í»[Õ\/ºƒS3Û÷X¥ …òB›½¡ÎÎŽ/.Þ¨¬v§…P+3t­"ª´ëñÝz ÒÃ% q4Õ)U¡m¶9Ê>÷ÐP 0ƒ¶r¦ít·#C¹\—Ȧ"_êætýäö?>¢í4±t í¨4ãCïõ¬ mÔ‚Í# o D œþ1 _Œfgõô}9«{ù}ÐÀPRhÈ šæPP(/BŽmäÐ5Â.()4Ρ8âͺPAI((”Å$o'„NÓ'.Aä80£úi2C!§Æ ™V‹f|½ÏFÄÄIB¶pl©†Ö³déPVÞ„lê,$ágìC·ëÁ©á1#lÒ¸«©ÜŽû†.ÊÎë;•;›;¿à†Kâ„dÖ{?ß÷PHƒ¼PG£T$E£ó³ª²@;„ãrû¹à³l©D#ò ö ?oô™“@Þs6ދƸM| äNýD˜Y/µ"1½KÔ»ý3ΩÙ*bÑÑ3Ž†â/s¦¥É†n{$ kc=~Ì¡K8©´ü—q"ëŒz/ŽÝÔ†ÂáS¨fŠœCºÛ:u ö‚´áŸmÑý¦ òõ²©B7âám»ßʳÝ‚Ü,1h˜"§C7ûf›—Ã4ÊÇ ÿ$Ž¸Én,?rmbfˆ7ÀwB QâO)¢i MX ‰Jñ8©ÕY‘ZuׇʸpoÓ­u3Ë+öÖD3‡06Ž€¸# Óžó#…uXÐúÈRV¤ÌGzcb¬¥À˜ß, fòà›¤È<4û±Aç­f>“­+/{<_xíƒa#§3h¦Ý®›<ÓÈËû 9tö•a†œ%¼…# ï$È}™l¾´t-ø¶dŸ¢¼×ìƒàÜ!$3¥— Ät˜s; ¹¥ÄÇ@îËd³Ç¶ãTÈú MC*ýqQž]sÃ7Òò¦D–c„˜ö Íœ\ÖE4#É1":³·Ú¬JŠUF!ìgŸp×$Z‘Sxßý?Ð"\ Ü Ñ}?Ðê@òô r&‘‰ÃA(ML½rK‰ ñpª ¡ÐÛ=©Fö@n–¨÷³î‡ôNW±W”…£ŸùxÝAøžCïðX©á _FôåJ «uà¶H/$&¨]÷íãùÇ …¨{+ÇFiPE©¶4À4Jj/2˜g¦»Ž!á š„¼çÆn“m„ön6‹ó"Év¢\ Ù0• Qö{¨.£ãÈŒ¨¡«‚„ÇNøN&3:‡£ß:Ï}äNÿdrû‹4àÅ‹Ï"gÀë‹ó k䜇ٯgF¿ÿu»œúû×ÑŽtصá¬^y>O¶¡ZA3*r8váL ìœÑì‘×vå@:Éá‰9¹ãsØŸ“û­Ê˜ÑÊÉÒ*½¤ñlƒj (!Üs8þ×úÁ_EFi™ fNMÒÛμ‘÷»÷¨ï¡{ªTu Û3GÞÏqG Õ#™®#N€¢kÄQÏC÷/#/J<äÇîëSO^ /V¨[ß;ªL–#ß(Q±ÃAÆàâTppmðY1š…E,‡N†ø¬¹WM¦èR±‚¤Á)C·hÝ< égÙ±Tˆ.ÇDc•UYŽ[YÕÇOŠàÎÂÔËùPœ4žûsJý[kSÄ?6êРòEdbãaãÄñ3‘Ûšû­7 š„ÿ{ŠJV³Éj„#UR£IªáHŒ1íPR£¢ß;»m}ÛK¢ÿlLLt Ɇ$° ç¡ÊÙMjÿÄú‘[$?¨¾ßÐ~ÇmåN<)ì3jW“,#Gæ¸8È<›mÍï§{XäqY]!šS¿Ñbõ° ÇðTöÓ|1³à’ª3H¤Þí8W(éàgrGèi»C!þQÕU«Ø"ž:K¢È'B®Í†tH-Ԫϴ†Rÿ@ÊÁó¨2í’‘-}Ãû¢[¦¹““*¶#ü@ƒ'Dz ÜF/›7(­yÆ*6l3gBCqW@;5ìã„Ï ï ¬žGñ_qäý&Þ‹"+ h¤£¥Û0ó?#2JÂÞ*ø~ið=Èlp‚`D:e¯yÂAÈ´ø`>£±„kC×'hH(»ñ}ÈÏftZøÇȈ‰1ïQö!?/#PÝÂÏ?<Ì軆º)ª)¨!ɲ%;ÑrPm'’\þù Èv:Fa1vCn×c;¿5k1 åvA8G iTûBN“é1kOb"è… 3¥Û³®É²„fžH Æ!÷u™5`€ÂXÈaoçòEEv4RóêÿY^G2í²õ2Ö±m »ùâsg1ÆB¥üÉL×ÇŠSî*Âtñ":c¿ètô(s³ÿæIqhX€°»Yxm¹/“M&·s0¨rñ;Ê=‹¾×Ž¹Çñ÷¾w.p”[ ý‹Yѱ ’üSµ6týð‰uËŠY^5’ »—Ó…õtˆK#‘–å_âBû+<öþ¥ùÍo#µøÄ_÷ô,¾`FiŠœY~Ê|I$ Á ã01&"C2¬­-ˆÄÞ[™²%y=´cÀí| „sî%NhD“'ð*$:„h9tLñ“ ³2NéäOÂfe³“³|Ì;AÄöŠ‡4„—dÆw¨«“*©¶U„L %b=Fñ’5Fغ å{ÃDªùÏd·¨ILaµC&»6>5ükψ5nDìöhäŒO˜Ä—Ïz`ù·9“¹¼»m¬fÑÖÀs 4†>2'UYƒôMº ØƒÜ rá{ »]N…ÿ­3J°Ì€¯]£0EÚ¬½˜–ô„Jkü`µ]ù!-»§S}³X³‘ø‹•Y¬±Ö1M¼#`¢Ü•ƒà0›å¨k>OŒ/mX° Ä!NÄS yé‚"§s“x,±uH7Råxv}Ueaš&J*lz™ô¾Ñãòf SÄ"h°úß©NwkN‚#s‹Ð1ºQ·ÿq“TD!ÕœºÓT§Üx?Óœ’¥áÒ„¬'Y(ò¢ ›Y®½…ôÅ"P3{F̽ž’Û ¤]¡ò*®dNB*ßIúw’îž¼OªÂB7«ÃxåÚ¹=%›¥BÈÄNêåäÊj<`t×Pm|k >×Ê6Çžëp:äžò±çª bœY…iÍB…V›2ú“ÌýÌ^6‰ âÜŸÈ®UôVg™rfUcfÒ)óâ ½¹ªå95õ^ò/73ýÙÙN·ÿññÐ}­Z¥vsÈÙ붘ô(RQ¦–¬q…¤$ «‚ȱ+îQ¸ &L¢–òêœ0ódOl +ÝðëhTÈ ©kí4Ⱥû`Áyÿv%`ÿ¬ÚÓYH'`X€øRÄ‘t¥ª]å-mÏsÖÑ ?Iÿ©g ƒ=µÒk ×ìÑ1ÿqY…‰õʼhƒ`=‰ú®ýËlR:äq'4WE;›¸ä1Ó@bþ¸Ã-§Ñ.{ %rN9£€Y_[sž¿òCiúžµv *$¨ÑÝñræ\27Že…#_± µ.#›ßš8ì‚rre/4Ù³n>‹nÇ@jxIǯ¬bñhÞ댥/î1õ¯¾Øà–Ù´`ÅqšÐêºÃÃ^(ìvîì¹ïÐluÅ ¬ ²:Åê¬öÉå-qkSÆY™¢ð-®Ü,ØÇLzÌÉ餟'ãÒ¤Ï 3éù†Z_etÍŸC“Îo ‰ÿÝ43Èh+óû‚!8úΗ‹ðH/Ùàêµ?ËF 8h úäh Ã|QBåê¡‘[„àeEY5èf’¥ö]Ñ¢šúãv¬V†æƒw w‡Ø²‰¤ôXÃ>eêËÒ„é³å«´\ÿü”¸ÂÄR«ç%åp^ “W÷ý¿4Õë£-ÿª5à.ÍínM¶žžÝŒÿÉU¡êŠŸïq†žš3u!ÍÛ,˜64ý9hy¹oñ …ê'ìh鄨ǹÙ¡êœø?g#OùooFeeÜ”*x1eçõOêžÅ¿# Ó»npÿ4ó"3Šh&ˆÄì¨ Áo4/v—éý©ö 4¡»,0èž0¼¤!–´m_šKFaõ#]lü!÷H}Õuù2‚…/•BV3Óm‚‰Po©=Ç­ŠgÓ³ïòûg›ð,¬ÖÏ^¿!S¥ý¬ ‘t¯fÿƒÈ¤xí M$à& ÌäY|| ^½˜ÅEþvÀ.˜ˆ®‘§Ã.šˆ.§,òL;`a%d-tê”l¡e*fœ-<èòOZ^oÌ`²¤ÕÖPÍØõx<„á·ì½À°ÊÖâLC †™¸5)j…“…µÅxqNâ¯p&ÓVa¾Ñ™|¯05ÆØcìXˆa,ËG£ Ó+ÿò”¤0ñ‚ UÓüÓVó¯µÕ™:¬òúlX]¬W/ÃêÙ¥Î+d2„Dš†ª&U«E”^¸^°‹‚H c‘¥†GІР}Î$!nŠ(Tå¯.%àJ23“E6êÒ$éߎ‹‘,SŒIß|Ôæ)qžÂÂõwú~ÿ^Ÿ}ØÂɧʇEi iñûµ¶Xú„9øs­%ÃF?¦ p¿î/BÚ䋆—q++Ɔ…¥sD#—ÝsæÑv|Þ¾fŒ%z_YÀî3–\ã®ïwåÓççvÔgW¸«^å¹À·XÝ¡Ž wdÄ÷{õ5}HMãÅY†žQABΑ¿ $Œ_¬ÏÓÙE ™Ô.v/Ê»rÞQg7¯ô¸?äx|ë>»„ƒáÄp3 éÃ9Æ4MbÄp»QuG¸£bnWÁ‡òïósGNÍ]3E^sÍ{³™€`˜ _[±lb,;‰nº]„s7ÝLçC*ts]‰4°Ò~þ‹Òwþ,m·!\T­%›ï·W2.ÿ¥Y9>5­ãv$sx{Ù¸ª >,ĶyÁÇ¬Ñ Ü乜œŒ¼ÒTôô<%£?œ'ÀœQSѱ7Og#óTAͦ}7Äm…lM×Ûdk÷#ŸÍ„0²•¢pÄJ•Q”© "9M6-?uìŸ=Ël‚ Ù¡jÌËa8›.ÎÊ(n¢n‹¨ªÁ«lÙʊη¯Â¡µµq.sÔðþÙÀ“Âa\†ã`H´$KL <)Æe8:uôR‘NÏ'øexR8Xx´îĆeT  ð¤pÈzáïŽ`>ôDÄ<ôðäÅõ/¯Ä™pWàháAá䮥HF“>Ž–êŽl§§Iv6‚ð*½¸8‹Û—Y…HR`ÔÂ-;V$¡­#*Úï'žß@˜þ¡ACF/Ž¯Ç÷4ȹ*ó¦W‡úE˾3Eììl¢:1h'‡%§qSôƒ˜k¢ÊË}L§^ãîw6:øãb©‹Õ_×F‰5z÷u÷°ká¼½i9×Íš¨·±ÜÄ&[7ÄYññ˜Ìh§€¬yÔ\¸ á=‰s¡rí¼ð„¥Ê¯œå:vΒ˸Š)]¬c¡Þ '‡9Ì潜imcLüõH¶{0}Áǹ›…Q=Ó‰.5Qñ›aÛñÙÙ…k5ÎôÐÚŽ¶dá‚ÍŽ>®CS¦g1–`Ïé~ck ‡¶5挩u‘)J"¥o´‰É®wNmw,ÆÁ]µs¦ÅzÞšdý‘±…=C:"„~ZoSÌùhûØúÒ˜çØd%ã$ÂTÛµÑÉ!µ©‹%ÛB6(g£ˆõØBË–p“ãbŒybÓˆWi 7OZBé6Ö%ÆÒñäí[ì×ÒÉJ4‚ÿ>vªXÝ"m\ ‚¯;Gº 1g£L‰‘ZÙ˜oclQF#mã»eeú˜%Ë1±Õµ³_bc £°‘¨ëá5ut*ѱJ¨‹õ(=xÙñòt®ÊFíy¥ç±FÔ6›2YdiŽ©hDmZŠq ­jfG›Z(6æl{¤Áò·—ùjØ-×F—y1m“ü5,$8-1ú(Ãtô± ÁWâú H2ïÐe‘²W£‘x‘+»þ&v³ŽŠ—K³r9ÞBV½µ“mŸC´ˆ-ިɦ‰ìÑvM²Ë)ÁyœÒÐƜɶ1éîäû˜vw¹9ocÇóïnÎÀŸCaÍóil9ÒÙÇ#õdÛÞh"Aì}¬T»ÒÅxÔ¸d­dÏöA³½Ùð“w¡SÜH’bœŠîHØnù÷èeò[¾áßñïâ˜VO8[Hv‰šµ}ùÔFw¶÷,”— q ºEuó!ÅóBÝR]SA1QšÕõÄ º®†® [ê¸c OW¹Ý0½Lµª^/»Š-$Cmê6µd÷Öƒ1‰m ý]½Ðé‡|ƒ]Á…¸ÇUPúh¶‚­‹Ð"ðT¿ŽP!êH¯ÄŽÖqn H•t,]‰c„8:Ý%6Û.¬RIŽ}‚Âç)Üè‘ Ä€“’±ä”Ô¥L²%É+ݤ–*”Ô¢Ë"3í\Øe”’Pñ,Q3Ÿ åE3EpKͬìFfj­Ù¡ÒoÈAYk X½ö/»K–Y±/6ìŒÑ¨Vâõ1uP©1Ñ'#‰˜ÈG"¥Ä6&] ÛjÒw² ²Xdà¹{3låXš¬Y_´c;ºî¨ŸÁnã 6íµb¢æË<ÁFb$¬ƒ¦¼E#øáÉ öÙ߈Aê4"_ñì0rmxí€J}ÖË–a3< pT½ˆ‘¿°õ‹K«oØœ–29ý$µäÈp ¶œ‰e Ü’ü½ž–a¤¤ŽÕãƒe¸5…ò=LäÈŒÝ:H†è—iX~½¯<Oâ¼Sì•<ÀÅÔ®QЩzÓŽ)ƒC¼Ð0îɵQ1}Î#õ/ ÿ#µS)6Äh½Æ(i5€:PF‰6Fº l ÅœDé‘ÉÛ-^±C–c¸ *ÇHú·ˆ ‹¼²ÓèÐ<<•WžiW½o§Ñ±¼2jW÷ G¶ÐÍüȺ¦Þm¡ñVæ­Í¢÷q_lUxúu!Åõp¯Nø’kó­Ñ«° 7@Ç5[k{©±ÜÄ&«¨çÚ¨Æd¡0%…¯‰ažll$GÈ-AjÈĦѵQR™Xhc£™méѵQÍq/7±ÉÆÌ:[c®‰ÆawLK¨±© åf)O]ÌäYb©A(®],¢v±f õ1Îó `Üšxw±fÎÚ®¨[ƒgÉìß¾ª–qœœ#Ë$’’8eÀ)ÂIžÔRí$ÌקMÖÐÍ“$eèS ±Ž}J‹Ù¼g»œÌê™ ÎSFÙ >ò—Ûw¤D¼º`Ò7OJÖ€ƒ¬œL LՉϥqJu°Ð'¡+R3ÃIÁšg)†qN¨Í 6©™I5ej&Ìb Ø™›yI}JšÙUu óԯɼ*I(zÌSŒí rðcjR #c¦C¬ü´/‘G礸.É"ÒrŠà½oR\—Ô3Ä­%˜M1Ò2"ä,É{Co$a}†Óz}©šØ lh3WU®;\Œ³pa|Ziµs£´)uÀYbu¾!Ew¦(Çxì÷(ó4’•!ëŽ eïi;óŽ'jï«DÜ5 ¹!²p‚ñ±‹ks‹U[ç}ñ¾€”í¦aMhy?µË@»ea0Üîõµ¼Wn«¦¶JqìâƒÑAA}|Ë=*¡§ú´ñö¨»1ul´0^låû½©r¢¸,ý­®ž'2w+É&l4´wÍ0>ž“Æw‹¾ø=!yc—C¡M5¤"~¨96´ŽŠ8»Þa‘u\ûa—E<âI7Õ é¾.(œ‡ä6èZrK~é„ñä%:TÅcíQÔià‰¤q¼ð¼¡ÇMì8‘h§!‚Äo£š…u~rÞ Ƹ¢€Mff‰Q Š’8 / ®!ì»VSCО.É Õy¨ëH„+:bÕ´¦‹Â³•Ìê[ƒÇ»Ü±”òÒʯV…ÁM¡[<æÀB3ïI8Zd[™Šž†Yè›0öá$!íÐQ‚Z ²€ðöàBâ;k3Ú„89˜(!í›f §6ÄÁÁq&åmª%9:kÃ4µ!º å@âS“´O›È·7»&cd¼›Í§?kîHiÏË’7 ¤R£ç‰YS"5dïN+ÝòÝç…BMA-döçöOÕÓWYìG·‰ ·”¸£M{!wB›f„ÈVÕTÿ=•[!ÝÛ׋ äÔ±Z†‹0¬.‹Ó@²c#§H«5úë ¼5g'ú=!.ñûÂIA·ÈŽ #hBa [†6­z MdŠHôéŒ^™¶7Ñm’!÷ôãhÎ èŸb&ÿˆg>§ámó4¬&•ÂªP£F¥1'/ÓÆ0çiË4CîÑËt…Dæ,s_ÈÉÅÄÇòò ý@j@ãF˜«‡_t¹uÝœ&.Ó,·ãÊc·ð²¿¶Ê (0ëJÐÄý–ª>¤¨Õ ‚0:sÖ@T­ÈEƒjñ:„^ÓQ¼Î¼Îû,+R"&”Š_EØD–¥:ýë1'«ö=ñÏj ˜¹”ªy`?ÐùHÄß ]hPÊ¿€FpKrõÝ4r‡ó2M¿¶øô·d0«½\Nìo¥¤{D}#9¼š¤¾I‹ Ñùþü"Ô~ÚésÉðÎ.zÒŸn„³¤@ìQ}^éFØ^g"Yn"'¨qÐFmáïrîdb8c1£¹{TN÷¯gž&!ì]‰¦?ÙgîÑ&Šœ§R¦õjˆŠ#¬bbÕRæËlwvÓñÝål=¦»ÈÜÔ «ç€¾ 4}h^ÍÐ4ýKCÀð1Ä;‰Y#¬AºÄ’ôþI&ßòœfÂ)¤¸¾•À–¼•‡‰B`€mˆš‚È!ŒOɈ4 æ ‘a"uiKdå‰DâB ú#°zðxWŠ]©ÓØIýª*Á$íð?•\Ü¿—Ï]½‹£µ*´Õã¿Tÿ!ËpÄwQ ¢¯dêáˆN p°Ä‡¢÷x)²8…eC~r½_õd¹F´ ãe­Í5ìÒeÏÔ¤Òù˜û@‡±^Oâ“Æ'67#s\;xžlÜÃÂ0x»$7qõM ë³O2Á°5‹qä¢T”• ú! …|O©¬ç¬5bF•Å`-—â¶Å‰ãŽ8çd›Lò¶vÁ$G»h“ÕXq_›Lþ$?ؘ*ÅžŸ—F3Ò$~¥â‰CAA  G¬ÈãQî*¯ŠÞ,C>É`oNâ¼P*ÒÔ4ª5¯–ó‚!rf4Òa9A:=›î׎GŸx°4›Î–n^m°—W;u’TSºqg$21©h$"bb{æb9ÄÉà 0ä‘ý²&« Ù8:Ò¼”Ðea§9L„¶\‘Vû«ôŒÅÀ•Áæ©ÇK.¢é$‘…e=Þ,H‡ ³›â”IGnÄ‘íäN#w4<–b ‘kÂ<ÆANx,MñBÕ›BŒ¥9ƒ¦3§~©šÐ@Pô¬8I&.„mµG†ˆkf]¯l8 å"mçð¥­ñp1Í¡½Ò WUÈõ‰«³ÒÛYƼ ’KFÒY™<…'è2ij…ŽU;ĵƒ„}j˜d43µƒ„n^á¦NýPß¡«â£ªðÐ`ªWÿ‘H²‹ãíXÇE†×{½÷`™uä+ÝlX›yYFDvâHl¼V‚JË°ÔmȺ“VÕÆcpÃ'Ù‡‹e1qV%˜]È_Ód': üR+w2Ên©¹a”-øPD…;÷‚²Ž%yë’áÑ)DÉx7Ñù·¤¯>„hb”‹·½÷laH{ ÈTOÚDäÐã„À_§`éHÿÚg\Ô"_ëC;™xrbÀ¶ñ½ Ñöù ͯöR´¿Ê`ðà“:ŒÌ×Ìl$|\þnGmþü›í/ç¿œËB5kø ø+4¡3j2=†¡°: ç…~¹ÒcSØò5ø‡:‘$ß+€ÛzÒàò$ÐàØy'*KTUÒC¢N1c#Û”…«$-&]æ =ë!²îÌÒÓ‘Y^ŠêNTÄ &XhŠ²ý„°SPˆ·Óh' ìJ"rU1óFT’¨I6¢pCvµ¦)·u€—Àô $ôŒ¤±kFQ5’jLÈ;Æ‘útÄ­—}áŽÕ†w¬HÆñ,LëƯçÐi3i4N}H-÷´§ÿd6 Ô_Ôç“ /aÀØ·˜]Í…&E¸´DÐ;‰ô‡ÐQ¶³¢é°h: ´ÒsMïqÒxw0k¹¹3kí÷¨íMÓ»¦gç°£H4½m{Üöv ;Óý<I‡Bá‰Vm {Bà ¯ñbqÉŠ7”ÏÙ7\6꣑¦âŠ†*¢6PF²è‘Í °%KècIÆ53y†ß¨ o!j¤&#"$yA¼o‹hâƒ_dú”{xÓG4 Úí°¢Ôø.Jútæ''Ûó¡Px`ô=Úüaùç)˜í}(bUþ̦‰ð#h„&EfzÌÔñ>f&ÄL|5A6ML•þæAÃ< áebkChs³‘—6š¡± #1–‚®“«ñåÈ"l&²Ê«êAË™‚í?*T©Tü%ˆ·t8ÙŠ,èB°ò1­bÇßLd|CZ’LÚÊ!€]x)'2nàò™˜˜P;#—.Ä#&´yO8áI^ºþŠ/‚1‰!›!®äa@~?‚.²vîiQèÉŽ"G11O1!î¦GªZ­Š¼´Ý®«ÐäêåÍžÅzyóª^Þ̈ª>¤ð,r­Â%ðxúˆœ‡n×[0·á î×Z¿\¯ådÀü7¬üÚ¥¼õ ¯ºZ®5ìS׫µ0ùQ{Y·÷Ðè¸HDǧÿþ¹e„Úf0¦ÀßVc™…ZÑ•9jiÃ,_­Lš,¢ ¸;(‰¸ÇÁ›;lØ2¶º›¸[Ýj}æ!fHLˆÈ\#x 7^`3.ܤ‹Šrвèæ¤¿Ì ¥ã D9™ U:M&–ÍátBýxå -‹´ù<®.Ó%tþYb?â'Ò+@Ñc\x`ªÞÃÖf\`×>¢ˆña» G³…®0pŸjq½1E[x4ÊœeØ!C@ÅY8Š1$KðFíl¤ ƒz8È!ÑF›iæ[àUҿßÀÒ,L^põÁ Ǧ•õEN W’DZ°â M&ÉG¿*”î|Šgzs€½7T,AÏ2«˜YqÌuK²Iày¤&b›#» ^×f†eœŒÑ~ÍBd F‚a46ù»áe?e«•ÇÃGf´|ŠÜÖÔõ?lûBú( Úw²½SþÀö^:Øë(T\㜾Œ”§¼”XëÑ×?‘)Û³í®Î .ç—EPGû¼’摪äQoÌT‡¤Ì¾8Ç “©áÚ8 $PD( ‹§½x¸ E’@ÄòŒ·Ðà¬"(-d³TÈÔ‘§@î„OÄÂNÉ™!l«¡,8Óù¸š^&ÏË#Ø?Þpø×óÒ_@FÌöI'„µÃ Û—)bq×&b6ÍÌM‡·gOÕê)°#>fqvðãrÜõ ,DmvÅií»¸“„SCRÌñ>¶ëÈpns|ªÄ¶Aš qF‡c㎶ܼ¾ÐÇQýº'žªëöÄã„¿‹q¼È $yáPœ||·q[#³·LGØ4Ž>_ˆIö´Ññ"C@\×&Äs`>Çux™ ‘G¦ vÈzÁAÂfí,µ´*_o,x³+Élfä­—ÀÇÃÎæÚ–fkak×PÓ4coÞ°††5£¿½°;æ¥?«Œ¬mvÎö¾Cã„¥Gw>FÏŽçêDì#ðë;‚Ž÷H3™²¸H¡å”¸—Éx‘O&¤a$ýˆ Y:C>[90>aÍÁ‰Û“#ëÞ#Ž¾:™vò1eOý#ý$¡H‡cF ]”„i1LdŸˆx'Þ)"//ú^¯V=h–ÞM¡¦#Íõ0!—¶J/‡ºTY¿7-ìYA—6}±´$6ðFàÐÀØ Bl>À¦býO€Q›þ|¼óŽów© H$Z“Àdﾚ½¡-±÷gä ,’Ë›}cRSC'ŠŽì=o b!{C25J<ù&t÷°H6žaÓ9ßAÐaÜ i•›Ð=•»ÉX» ¨Œk˜ÁrÕçÇ™e*eDÙdåÓåvª»WtØ–û:%ÃýOr²5§$mz 'Ò‹í²ÈG‡nÿ ³ d‘s”¡$Û°ÁËÖb¢¦„å£eá¼Þ<¾B~¹Ý:ö.Ê”/ä9dב]ÛÿøxÈ->fkjh ¯ítÛ! ]fö‰Ø™¾t¶~líHPZ€òØBn)ñ1P³{¾TrfFkMUøeâÐ&ö²öyÆj<ó³ZÖè’ ß¸7I÷딿4%ek4ò¬1ìotÀŽ.ÌÌœRxì¤è‘?î@~ÝìQe›Uõ™Ë¬ÿß…ü¿TïtÊ÷ I{†öëÙa³øò¨_ºÈÈöS2zÊÇ»3"ójÜПÛCÁ|>… µ#2W%;ñçŒW£ýnoœí4øPèlBÿP,SÓÀ— áÚCÈÏžèÙ‹™úãpI¶¤™Cd˜—fÒ€p–T‘Jætá*?y°GØÒ{i$ƒIšÞ^L‹ù^©«øö·˜Á£\ c}T ”NÜéŸ,C<õiUÙô–m9 t9Q§§<䉶 dl÷œ­;¹Ó?Y†Ü£?F†qi xg ‚¸Ëºš”*“a>˜›¸ï¯ò÷õü-þcÿÜ1/-þ£- hÇ´š\mîº>¢úÏ=²:ÎÛ—3gŽÒŒà‡Ê¥Ñž6©ôá8 Õ^)ƒƒ£úp„)̆ÀõàRÞŽÄà‰æ4GÙPá…´Þü >kôñ1÷e²áC±OÎ&1ßÐ=D× ôë¦/þ‰Õ°¯Ê8:Æ@R0ªÃÅìÞ1dHNè?• ¹Ó?Y†žBÍ2äBîÉöž0‡"‘­nFä¨ÀX¾¢2íUó"Æ‹‡Pº'M„ ‰ 5t}ÂqaŸ±×é—WYfajò¼#TÊ8deÝlJ‚MY°i4ØDo&œ¡¥,ò„–cÄ‚ï„„pä–OB–©¿Tž9ÐÄuà žfŠŒl¸[í¥Ø$:É‚/wÉc°rǾØ@¢í‡7þBÊÂz¡]Í¡P²1T5[!Í•t_¿%ðydÒ˜zOZð‰¿î„Ø Mæß0ठãKBµˆªØ€)¿p»¦ä€pÜüþ¥(R'ÊúPä8G)á ²#ŒûhA¿4?0Èöw`V—Î xÇéË%y>K$t@h6ÈÇ %…ýúß0\HÝϽætwóiÒÛÿw¢ŽùuxTDZX« :VÒ[×…çlu^Ī!\sObi\ OT„=i qOùØB]ÑB¹&‘Ì &"¤fcªÙ;'Òl”>’¹ž©ûh7èÍ­-gEt™ËA+r—‚âÆ_¶I.T¨GQØuîÄס(„zh‚6Œ 1£Ÿ.‡dNÏ-@êy”]ºÖ?¡Ÿ ©šB껃꜆ªEUºF†XÌNƒx¶0^z¥Vzc/ëB‘Wg/Ã*<»|VíMïž «gaµ®ö¦ò¥nõ ÄÖÕÓð•öDF¥œå¤` ×hQE²'ã“{v5·´Íö0O€ÝS>^ÈH÷xÆð·F%~ìß!:]}‡8‡W9ž¥|±^]¾ Aìî ‚h_ÑÔ¹Ù¬+™þЕã "]ÒGŒó„9rG½˜­øÄÆWº=rOùØBîËdãmgï€ÈH¶gáMÎK[ „)| _7P2㉚æe6 Ä]&fÁƒ^t´„&§´Ð}‰î‘Ñ?MþGÿèÎnÐdŠŒ=´€%ÈÌò”Eš’D¦©S-‡ÞòÂçs˜Èž †Ñ]P*Ⱦ>Jª=튙êWFÔFë|tÜúÁ®¸ÛýO1{ã,9š úx:*îNý`WÜ=5ƒ¿žÉ|ÂÉ!„vr¸>kÂr<^âD[û~š–þ‹ø˜ýWsùÏ7n~)nÒùÅY8{«åªÐp³]§óoá2&ü­žH\¡…ÍÏòà>ÿEGëèÏñ8&zrŸ<^YjD¾àñ}ûNH¡P‹¸Ú@·ð”áí‰.×éêŽuÙS]µÐ…“]õJ¯XzÁÅ-±NH³RA7"U›L2ü&ó·õPš‰öû¦¾oOõÏøëšvüæáð¯;æ¥]¿¶07/¿¹ Ïü†©o&wÔà它6Q¿³Ê7E™Qñò¨Dó¤Â[Ÿ§íE SAû:Ý1µ3[ÎÎÊP§ÌkOmwËŸwÁ¡wG þQ¿óŒ ûrÝÃdüñëß]î-n·“ÆÉ;ó)¥É$µÃpŽ4œÂ‚½ì3{û÷˜˜;þÕý1÷e²ÁS±_ ›ÜîÆòCc™™Ç†÷˜º˜¾éÌ¡ƒ'ÕÍÿêþØ_Üð3ÞÆë ç‹8¾\óÒÛ®pnÏ¡å“V¸Ú4Xâ†Îø<µßõÖ¾°#ÛU8Ÿ_væüò™ú‡¥©Ãí.ÄÀØa’›r–úP,õá<·£€“ómlùvWüp½Oì>&_÷¨YÈ߬ø‘ùºGuÈBþî@ÅeŽ„ËõE%û« 9š¥5œ¨#C¥~ç”ÈÔ4Þ]åÝÖEÉ&!yå"çpy<’8:ÍC·ëÁ©á‰í®±kfm§°ï#î;íS6WáÎöâ%Ø^«R¾ëtyxÈX±.(Ãv“™‡žf/0”[ºv‡îРdžu±¯º¼ —o ö¬<ç2D|܆†.Øö0Æ°#Zq .E°¤ä‘nŸä^` iŸ(±‹L:=’@ŒÔ°:⥽] i ›ÐÓA Å•ÑûáGê‚¡í "EòÚ@!õ˜Ü'Õ’êÙb(#°{Q' ‘òGÖ¡¶G¾TÓóå»|Ñ.1T¾e·8,M —•9!b5~æE«DwÄdl ÕX  ‡¾xÌz&uFOµÑÆ1¤ƒ³píô]Úö|âA9¦!ÙÎœOå Sƒ¾v,Û’‘Gé–@0TÅQ!’ð’±£]‘.¾øšl¼‹…L^oSZ…õÁZ¸žð‰xÙ@ê.cÑfDtzÇ Bz.NoãÜ42B¡˜ÍA5&ÄÞ=DÎ=â5I I ‘!uò mXN¾ƒFú¡ µ¨gH~á*††fô7,B^>Ù¹ýwCAqŠs *´ 1¦éb…Á Îü^Ï„O@Ü@ïÏFÒæÉ€ï ÝQ/RÆdEîêj*nÂrMÔ®¾ÊôeÒÛŒá|M¢Iìf³Õ“qævyWHKŠËb‰kÎ$WóÙA\£Fϛy\Ô&¡ñä˜fͳÐݵ¡»–ãðm® ZVžˆ¶¯ðfÇ ò@û|  ¸ÎÕU¨]¬Ü|!§p’,÷Ønno¬ µ 96Ç—A’#UOVS‘¿AÈ b˜†_é0œ»CÌnõ*t–b0GÚ½ØÌ‘úˆút">s$æˆBÆ[—|ÜÍp²(Êd–Óôa‚ö=¥!]—L'O "':böÅ4)žÓ÷zC Ïò ›œë ×ú×åjôiù»¸#d1ª§\/Wõ\OØ9WÛÐÍðð‘¡c[´òí,ëÄ:"|‘&ŠØÃÊi2l‚Üö‚ ¬Yœ…Sf>ä‚hÅû7¸÷v‹™¼/fI¼ ™=ä ¾‰Jž¢ Á‰&Ô-÷*óZ{n‚Sd•±BïÕP¿ŠŽÍÖ…•í9Õ^ìèÄ 6w|Û#‡äÔ(cX¿‹'f úhÄ„O{wÄÿ‹%ŒýÆß¿…•OçÛ z¿ãscI¶~01í­@ÿUÊZÿ+”5TêHjëy>. )³#ú|¤žÚœ:[®ÐÓÿ¾dFQÅÃAŸ !Ýòrà€´ÞÁDÄ OVÐÚiÍÅ3×£ðKlP€{ØŽy˜èEïw‹Þ*'¶'­÷ÉÔ6¤×ìbˆ‰|Ó…Ãñ¡[zð˜?×´€%â^IÑ…©iy¸ˆgitëÕúå&²ÓEiöÁ˜œÅX»YÔÞi¿/–š©’š»ì»‡—ÙV`Ü ^ûÛD—c±©NK$òRF# ÷±IE2bÖR 8þAciG öV¤:MÌuÑÿݸ£¥‡b<‘)æl”ÔDÌ+‘,¹C>W%^=ÉCŽm(ëñ`ŒÄ}î,^Ò Æ“–F|\x¬éI·Ì1åio,Ƹ)ËÕY<¹9sêêO;M.BÆ?RÜx\¯¥,Ú`Ü bóFi²À“öAg»¼ãÁ1ðd sÓb-È…Ôh:r”îg«Ë‘»«ö‹ÓȤØè¥þã¦[°·5jªX] ÆV·‘ÑÙÈÉ°fšœØÔÎŽZ40RegðejqÇ2 «)Æ‚{«(º;D)YKIÿMZ„c–#NˆtÈfS=à`Hb} ×4t†w‚’÷N9Ý×ÀpyƒÑ 8Œ±“W ì^ôÜ»vǼô¨ŒZ§ó&ôp´M3ÞÄš>2ð lá8pɈªôd2ºX3w<1I˜¿Ö•vâJ–µ©5OªLm >0l,L)˜šŠè¼v1Çèƒ~+ß[¼÷*Æ s†™ºÑD»€ïK´ ²Žù“½Þ°¤ššX¶1ëį”`ltW̽Þs»æcî±ö1·ôðP3´ùsûû&ìéâØ †kdžÅeŠÙ!Í𷨑i‘ªÑˆîN‘±YÂ;¥½‹kÔšÇ ƒà)å×EÍD¢™¤aÜOdõžº1‘ƒðÆãÊØíz ã7-ÃÁÀiòfáç»àÑlÇuyɨ/yÓÁãaØã ýTØ:Ww6’ü2lØ’`àhÙ¸N„ñ"|™v¬ â9»­ÔÃ\BnX«ÁTC‘ÐÑfÕÕÀaì—a·ëÁÂñ˜÷Pé É8Xzf ³‘Ø~ÐeÔ¶£F'ÃÞfäŸ?.#{ˆ”¦£³‘^]æ­ØOVæ®~Fy‘™Ð† mÑ–ÕEE Û{–!õ Kꦔ—Ù6 ¹Z¤ìblFbc­nÓ0r‡bÞÄ”aœñ¹'gq°xÿƒ¢Ì61t‰á\ébì…³à–b=gmLL:B3ÄíðB æþƦY‚S¸óÝ \2Èƨˆêë1yîŸ\Ÿ ·Feňìn™&O´§7ìŠ9œ-TÓæªÈŽ‡=sý°¹/“r´OÌF´é-ÿµ;©ûµ¹ø d#fOï©Ó†¿Á·5]mcñŒ¸ÝsApûËùR_[þüñ¿©>ñÞöQHØ…ÕM]>Ñ–>T²Ò®wK¡;ô±á_TF|–›ÕlûÂÇ&Äôƒ† ‰ö™ê3¹S†¶|½šn@tåãYºt«URúNÏ—aË[õü—ÛõàTøßmFa8&þÑ<ˆþ48Ù%óÀh¿ƒc£ØW"’g_à2øo¼ÚËí_¦ î6OJTZ1n!nðv.dÇ m2Ã3„;âr±Ù8ãF•ô8¾p0N²~ôwMÙólŽ“Ò‡ý&7 ‹ñƒ!H`‹Ò@š÷Ä¡J›¥8mæAF}áP¼bª €ëºxšÔŽu)ÑQj¤ ;â=(펻.Ágð©´;Nj¼YÜ-¼€W`LG¡Xš%ž$1æWª†§KÐx¼,Si¼X­7HÃ!ç`^µ17HÔ{U\ã/Ñx¯÷=y#Bcf'ŸuÿcýãRŒ¯;d¬Å9ËQºÓ|1µsýHbQs%ɇcÄpr9†{ZÈyòÈÈÃ.Ûb‹y41pÌ;°ªH¢$nU£v%2Ã]Š•\1æˆOæaÉgw,å­‰EDW2–4QÌ5›˜ociWÌô0,ÄÄÅX¼­éJÝLEíc0}-Nѵfõb/ÞC·¬ü2nY³h›M­YMËñ9Ùw˜…²-lcIÚ;š|Z"¥ê²«ßÇŒÍ,tÎF“y8ÎbÜî0‹eYÆ#bîËdC)Ó¬âûšhcÚS»J»±õ.CÓí9ol>ò8‹óyߣFƒ6Î"•¾£&ˆ6ïQ›ásŒâò'è?WÏt;<£]ænÛc¥`»] n·Å†…óAØj½aá®FãbµwXr$ÖˆhJ0Nµ'òø4hQõ*óa7 ­ÆùfÍhÞËÊ[˜^扗>z–4!lºñ„c¾flb4Ó(ƒ.È'ÆÜ1¯î´nn^Õ¶É6XÆ— ž÷8guñ2½ØN úP dƒ‰×”á»XÛý{#ñÑØå‡ûbCsûîqÍFµÃGÔÙ ¬û#ŽLÈeù‰ƒ:ùJYN†x  ªñ %yÏ€!Ù¾VN®ŠŠX‰<’4]‡‹42!Ã]¸g ´ Ú”™sMòç’i;^2õƒg{Þ´ ‰žžš:È •e¬b·%ÑÌ^ù2ÚPÉúxàDÆ>¹aÏfê£AkYÐíBÏP0›Ù8”Cišr rƒ igËZM.l¢›‚AÖ´-ÅÜÕm(¶V¦Æ.LÌn–íŒÍ³>&ç‰÷ÇÐÈ>S·ú‚ýŠüì/b6Í-%rskQäf­®Ü DÊgÉ »‘›¢Ê™š4Ì¢ÑôHMƒÍž´Á£Æʤ²Øæ¢Q–.¥A‹¶ŒÞXs¢Õêôi ‘Xf§_$BËÔ¼Èiš€n(-™4Æoœ³}"ŠKÄ•zmßÈÁBš“Ä‘íDƒÃœ6ìM+"•ó$Zym_Ô`OîפLiŽ½Ñ@:b! önbBiN¯ÎÐÄ6íÑt´¤Ò.uÞ¹¥Ä ²¥Ù³4Ýæ¹c_$Q]Ã,&¸`£) %”H2}G> æMA½Ï®ÓâëãHÑAÑ@ƒBn)ñ1›%.ÔfšCXÿA ÑqK'n\HÂ{"ÙF»†|Ü • ‘.&r²NTÔiRMžœñaÆ)cñ‰}‹‰sTš²QA$¤ÒóÑ¡;îž 2Ð ¿dÕ¸˜†ÚÐ'D6k¨YÀ©fÁ)+Æ…Ë2¦2VNµ;©QÛ-%>r§âi˜0N®¬á¶ÇL¦Á•Þ0£‹¤ s2amb ¾%R#ÀIdBÊv,äNÿ¤-Ž«àlm´²}SRÓPnü@y]àžLu:é´4Ý…×wVu;ùRæ“jpe#áÈ#¯ bãjBs˜©Ó1ÏcB&07ð˜I‚¹†- <3ßP„98Ÿ0¤‘§ÝÕv:9:ôíÉñ/mËîšOØQbÉκȲAÖäY—ï™Î#Ù MIôŠM}Í ²øàÔNŒ’táÉ}±}ùŒä|+ÛP´a8Ç;¶BJÈ÷ÚŒž´îÞ kGrDÑt/†`JÿãQÓ od«ú©gãéÎPžž¯Ô!OŠ\/l0ûž2kzÄ·IÐóKΨ»xM¯À_6l¥XÙÓT¤k£4š?d‹2Qåø~$;}Ŧ ±(-&)ŽK‰\²¸/6D>I 2«Ã1«ÂjâdÞ¸“˜ÍÝ«“[J| ä÷±ž“!‚Txµ0±¬©ç:¶So°#­Рð‰?îËdCÌÚÉß‘) ºqÁ¬Õ)¨PY×Êb¦æÞÔüÃuQªIßý—&^'ðŸçhþ¹¥ÄÇü㌲õ‘sðt^’nð!«g¿Nöº÷OÆL–!ù5œÎ¿îøWÿtáEÝàÉ8-ð¢™ð$f”Sª 5 03 Vc½ŽÃº Rz$qú3–‰=rU» äÜO˜ŠaŽÃ(}ÍZmÔ! ä¹Þ^l)c¦×*-ĵ ÒY¶8¬z;†F>H—ÙUe´’|ÈZ0RÜÚÙKœ¼bDԦĔÙ{6 ë£Hã¿­ÖDœ¶@œ–hʧ!ÿ¦Í ´t|ÙÛ‹‡+¹ö O`’ÐS9°£ŒøZ]êâZ|Ý þÚ¢ªâÑ\Ò± $‘>>0¯¿§ÕÚÜ ûȸ{jÃ_Pôv{9u8êÝÓ;ãŽâXhãtî×A„°¸Ä Úfæ'1óãü ÜÏ>®Ẫìøù#°X ÜÏ2óƒ]ëX! ËŠˆÃž.p@Æ[¯@E:-Ú7ºççKû$µêLaäd‰™b“§@NÁ}å55ȶD'ˆJÚFÍKûËô!÷ë*¬¢CQ„p9²<êÅç-i Äì{ZÒ;¡MXai#ò>ˆ4»NÁ§AÎ$&-Ôaš×U´ÆTá·S5 Ñ­q¢o÷º†ãß#Å«9´ÄcÉ ÇËÐê,ú:Ç`Šñ™¿ˆYe㘎rT1S…9†p™e!Ê‚ŽIØvS -@ªjU’n)ñ1ÛU²ÕlÎõ™Ú(šX™…ÔðB„! Ù¤ž;ˆiçØ=Nó¼¹6ñðÀ¡Ò§Ë2æÀ·Eô¦_¯{#Ç6SãJ›§D;uNäilCRö·'A½½aÉ?-tO͠ψ-e²ºð¶a8/ N>÷t»³˜ßå‘È­ã BX!\g@òžˆùçpc¡ 'q 7P­Xa’‰|d–yÙÂFo¤™x±EN ¨ó@‡ìÏê:\çanB¬x†Rˆw¯"L./ÕæMDÅÄÁÐÔQdŸ²2ãžýfýµ·z+!®4$÷>¨¢yé„_wä«ñЯë’tö†~kç߀f`8põxݪÈvç—ØUÊå¼ï‡vÁ™ÄìøyœîiáÇ}™löp¡i/DÆÓ Ž»°.9™öxRcÊÈ*_ µ…U\É2–¥A]Ì éaOÔ*I¹‘g/A*_\!´èC¿ª¬g+m…&ÁôÉšaó1öa )ÇÙ×Eb!=Š ´@iÚð’&5rf~nÉXÙ¾‰‘ç?…0çÕº²áÛ ËÈÅ•,îT¹6êÅÝ€ô5vžô²ô/ÆFîmX@€}•7±‘` Ê~«>~`IÛð€„mt`¢gʹsz¦2Tƒê4ê5±±Ä&º±^½åMÌI´*|b¶ê¡‹épzÖðhÌ->„¾Uð¾b8Ž~¬#œ·YÄyö=5ƒ<úÏîE.­ù²0oN$LTGö·I[WøMƒÍôɤú¹9æšÃNÒ9Öâ’¡ˆ.¬€UóÜ|ÃIÛˆE¥Œqð,‹WÚ¨î‡4c#.ØKP!G¾v(L¸ãTENA…pIÕyBX‚ôæQ¨šS—jæÉ[«bK[`ÔÕͶˆÔ çˆåä2e‘wùܱ„6ƒ5îƒÒ l±â©Úž+´Y€¤ ¹?Æ«<Û³'vVTK~m¢üºœÂ¹ÁÆ]j’9_°¬!Y'ã®þ¤7ƒz$!¶+Oê&›ÍÎ7^ùkV‡t âã®{%;"x.)R¾|­DdÖƒ²K4z|ËÝ çÉ<)¢ pñ“‰Mã0ŒeÔuceè[Ëâ3¿üv]Õ nzö]þøìlý,¬VÏ^¿aÿFÚÏÂûš­_Ü«ýÆúÜ1§,ºS6B™dàŽÄhÙóëæI”Å(0Î#{žmvË"3$ôwv¦ªá)𿧌’ÎÃáxUoÞÍÑÅð2¬ø6´dpEpp«ĦÌ÷º2Æ‚ÛÁ襦Y-ÂXwDsBV—,¤(¸'PªHÃ0ià:….ïJÁˈš${vѦðÙ “â›7O:.¥Ç}7GûSRÚµzäïß2úSd„Sðñ¿Ž#ë3œÅëó—a]'qÆu.áúÄÿû/a&…·‹`g2 ÿh2ÔúÖ©ÊZ gMîâ2\¤óá"l_ºu-Ðt<þ7l|©Í6†Ëª3€ª»YÝ› Ô##Ö°pmT<š˜Ùk™Yxº¢J^ GzÏ·¡ëþeÔ]â=¹>!äÒù…_/×Ûgè0‰Hêoš'aàð\!ãÊæ‰ÀÓ&ˆ%ðJÕÌâšb  t¼Þë}%Rv3‡ ˜'ˆk‰£•Š¯ˆ¢o“É…¹f¾¸Ú.‹'ìT˜PA˜‚¼ƒžŒ2oþUƒü Ý4r ÈnâäËy­÷YE’@¼ ä扫X`@gnMÊŠI{"fÁGTÐOTñ„:Rß2å0ÊÐÂÛù$’ u6qƒ6œ_ònxõx’ø[÷ö2¹uç*›AWŇ¢„A“íx !ú‘ãóIЈvfâà6uöÀ[×ÙNÄÚsÁ^ ÈådëÔ–ÚÒl%õ\ÛxI*X~£éœ!â:ÒñL3gT Y*é%ƒÚ‰¨¸Dõ°T&ÓC–GaG‚²c0Á²Pl!,4qìÉ¿SpÅ)+ŸC½J˜š³0¦¸ŠB-ké¼13xÖ§úh÷°¹]ÌÌ©‹2Äð‰ zé//Iê|ѱca!ýI†?è H}Ûâˆ*îH~ÿà Ñ¢´GˆXNõÜ!âlp—²F MÆ}¼õÛ1;E¦¦vÆ•VµquЛ*Š[îâ®K0Œûã ²Ùi+0$[… /2¼Qãž•MhãpÒÍTAYC®÷Ÿþ,W0‹ÓñS©í†J<’E ²Ý´úîŠ3W<ÍãäÁ†ÿ¸Bm<È|a–‰êaâÎ&DyaÔ ™*%‰OÒcX.‘3›À]H“£*qu½È w}Âîxãºs\Çö‚y+ó1Ñ×Xš˜Y,‘©S,19fã¸+f–>‰«enîccnéáR‰‡jjF[ø Óþ(‰l/rÌ15ž²1E 稉%³ýX²¥1·ïáR6}\¼³Ñl+¾/¦YÌ-<„ß‹K1sÉM¬™r¡‰E‰Q™‡©g“†£b䃱Èè‰þ¼EðñXZFŠpžŒ“Aq…½…“ñ"g#“tì^8âÉF†qv6²N†dXXhkôOí·Î溧äxv{^¢¿ã`wê3;–+r]%Ë;w ŒcM ²KÁ»eQxxYQ’&„iIZ‰¦â²F9.œÙ11ïùžPÏãdÓ­Ìz—ÀúR«á˜Ç{HÒJN0*”6β#î½plÜ=*ÙçÔ8ºžà&È Ô}\ÛÇ£ö'´q×/Æu]Ÿ:4к6®JVêú¾Œˆ=¢ÖÄCx~(ö$ÛrU·Ù|<'YàŒ(¼ÃeÔ’óããv…CGNxlÜ=5ƒ?¿ñŸëŽÿ;è£?nNÁt·ôBœH8VinrÌaíñü|ø·Œl¸ÜéÎ~_àP­‚rµGs&N‹³EŸÿûÎ( ÇÀ&#«CÍþ ZX3Šæ…“³ÂÁÀ)kFQ1ËbÙ~xuI\íÙK—6dx©}ƒ÷·À»¦¿ö¦‰Svr³e Íu—;ÒÜÎõd@ÚîK ºÑ˜C—ؤyá§}i.«žsÔ—Ò¢`ÌRšÓD®›®’ƶ€ajÒ°ŠqÜ™Æ'±Ži°/.¥úYšë¡: ‘8棦¹¥Ä]i`é1,§9›XëHáÞ´RÅíÔ¥¹¥D:yp8oÛÙM¢¤a̦9Mä ™'žz:I—ÒÈrŒÒH Å3V˜¸&ÒpƪDD^4ÏÑéo⃗M]2ËÖ ‚4C£°}|¸ƒ©/ ^ˆ]Ù8å(qŸqÎj\‘8æ qÌAã^âN±m°/@Ž&9š8ähâ°6Ø„šƒ×læûasǾÊ38å‡1ÅU¡}!N¢ø•q)îö½`˜ñ˜.qf¹eB˜(‰$k„–ãQãÔ<÷£´ŽâÇ'S!­’ÚW c :±OS*6,Äå”èxTÈXUvæ¨JbCU3f­G%Öë)È°w0ña7Lj¼p´.FyÔ Q•Ì}´P%­V)6ž«d¦s¶VÉâb­Bßv¸ºÕòù$š& M{â†Sµqs±@kýy8›ò]Ÿà}{Åë<îÛ Qµ!xé^­ãËa#ü:›Ú.iÜŸêŽyY^ŸÏ`i*ª°,w¯jfšJ긜ʲw'†ÍD–°™¾¹™C²%/É<Ë©¤ç£Ð›Ö>)šÙ wB3çãÈáBª3ɨ»ãЛv¥Ã©NšÍ‡jZB!©^RÁb‰CÏ )ô(Ð1›`HÇrêDGr&3«!6’<êBJ“Z[N%(\Jµô&{;ék»² w§â\»$Œ¼lè’¤6Ô‰¥œÜÐ(¢Ù-eàØ1©b­ïrOÌl(-iÂÅT·÷e¹@¹#u ©Î‹SŽŽm¸/U|—ñžáÕ-«³ ¾*C4*ï«vfH¶ç 3~¢…D)$e.3@„5—¡,Ÿ€Z†ZKF"…yqÒ4QñËLj·Ò†Õ€7,¬.^nSõG£ÞUÌ4píœØ{ §%Øízp*ü%2JZ-M¡zX² ,[‚Ýd"OÊh¹¹Ý¬9ÔæY_Ø>ï5Õc(ö)ôºÍÁθ{ âU; ðñ†ú¨ì"3-¢G=ž=‘ÈŒNwbØË¢…ÄS|ê˜xB¶Þbði;ü¢¥!Ó bw’Ž}0&ZžìŒ'/þ'ø:B¡Â;œz­Gwÿzåäò<_‚ÝüÁáy¾»S?xjFµ£Ê—LWQF1gYÞÙÅÒÕåžÀt£R³WƒÝ“z”NÛ »c^:*£Ý|¹ âjRšÌÎY٠΂¿IW`å0š9Àfø¥Îð¸g†‡œ…¦@‰<&±#®;ç7ºTöçáuð $úüœM_³">ï‚öÏ9º4Ãã ²¶O¤8ǽùð,+téH Kâ(óÛ2‰Cí|ŸŠ|wíàY}Q£Lú"-m4¼ id•ÎFVºÄM9:tŒ]ˆ.»Â£3:½ìŒä]ኯ–£›­haöŽù³ê‘KL r•@Ê<.k¢õnJ8¶¡^L6E\ær¢š9Z(Cû„KöÞ[æ”™¦,«»Ì§êÑeH5ë£@ŒîfC,·Zºœ¹“ðUÞû$mýûYw>²KµzÏ" .ÏÒƒ|³².!cdB2ˆ _a¡&©ÏC&4u‡Xï­]ÿ½,Ïaßèhÿh«ì£3bm "‘,Q²$P0z]Np ±Î²™¸*ûé—á©…][žÿÙf„h–d!;¯F»6GºiW¨)öÿŠ;x£c2{Gü±‰Ú¯3%<é×== É×ÕùoXųҟë01©Ý®9zιc^ú7Îef†,ÃAf>)ªøI3åí9$ƒÀ¬h2 ,~amó¬;á¼ <X2­n v5Á²"5d„àö†< ¬NMÍ æõBÙǤ‚µgCƒ¬y(<‹°ë¬ÎqV¯òËàU»³<¿¼L/÷%&Ç_lFˆóß±3aJóU’†g­…¢dîÄ‹È’”4 ÇTö›Z9š-lüEŠ{1ê¯jþù«šÍœu±ã—ŽIé~Ýé½ú·Œv£Íþ_7OZÇ"Ëç~}ŽK‡Ð‘LÒŒZÌ(UØe┽u1„9†Qr~™kO…ÝS>þãet:£´ ®êÒfZŒÀ|«2ù!³¬+â‰G‰Š\_ã;,5è…*S$†Æ%¶0p¸dYy4Dd¹<ª×¨5ÔZ‹¾H•4“m³öƒ€ÌÆõá*‘C$¡¤Ç·ECŸ³jè!·fulÈcÇòË@˜Ý˜ö&‹°£ ¥o ™Ñ15ZjN^»HÐl•ÎâŠv=Ø–?5Û!,‚IɇáKÑÑ0hGÁ«‹z½±ã [/XD2 v$° ã¿íÁîçb$¹êÑ+.…Ž"øÝéfü6ZÕ¡;öÅGg”uyX C¦Ù¶~Âl±«ÕõˆˆÁKZ‰Ó!f›ÃD 7‡õRp@9Ç€âMÎZ#BBÂÞÌÆåY•:üÀMæ/ÄUŒsæÓa|*ŒÝGj5«çÒ¡X¼© .³Î£'4€|«–­¾Ì~ŸÃH&¸ã©§Å„gW˜v„¹ ÕÚD/jk†.P‡äá‰ö†qœ…n×â)VsÂUŽòº@3Ñô|• šNp‡w­Üˆ*{a§!{âÜ©ü‰3ZâúGèÙ€Ïñ$ô¼ˆ_RA``"~Ä 7ätú²ºöÌV Ry:˜©2ž«Dx¸º‘1òã<ÒÔ#K ¶È‚â„瘼9¼)êhàU&4ñ#ϱb—éˆM1â«œÃU¿ì&²eülq7ªžVí3Ì`´|5†Læ¬Î‰Æg29"‘t7rnvÇki !¹wÜÁ´1/I°Œ1mד:ž¹?j—š„²´^d±ÖÔ8ãÀXÑU ¬_­*2ÅMU[C 4B‚Ĥ—ã‹Æaë#\½5(‚$G¹,ª åBœÇY”Oj4¼ç]–ag|Tõ,V g¹ß§ fM¤.jˆ$â¬o8ü10¦ã…k†fVÜD5ÊÏ gVËöVëÌòÉ‚ï…~ó21B6£…ù|jf˜é$Ó£“‰Şúzw¿?ˆ}©š¶x2Æ#Ê£4ÍY‰;¢©r8ãQðl ÓõTO£°X3÷t ‹CëžNa±÷t ‹¹êqâGSXÌÕì_,QØV#ïN|À¤¶V-Ú¥³ {•¢ ÁÀ¶ƒ’ ¶™9Œ­¤–ÍêbÚ¥Õ\“PT±êY½x÷_ž­Îøâ]ð0 óuÛøo’ òÀÝøÏ1€7øŒú¯JÕ~²úá¨ÖU _é“ýEÓvغ°} ×%JK¼÷r?;¶‹fo˜ä½4Éù PòS·ñnüHQTîÉI^$f ÛiWiÒïH#Ýš'ÍÅ«È(M±@‘XìbAQÙÜ¿…1›¨)°‹ù)í¹6jpµ™‡cîøW÷ÇÜñ¯ò_êbØ&×Fá¯kܳ›—ûFc´ã6‹™ñvq´uƒÅ0ôÓ˜7&Þ…¨táh©ƒ·|ŽHòôŠï˜H¯ G«Æ…ø4[žeqyhÚ-;[1­W.]\äõêå&ÉÑ+ä>*p(n¨3w”^³›aÐøäÛ8¯GŽIêм ¼­OS×ÓGÄ¿ ®I’Lq!Ë\±±êŒçx ?Óòcdà5¶qC-pÐÌ~7»%¬[ÞBw zܺÌM<·ñ`x¤£UÑU=õ`0øc‹ãu["X–îblã5@Úiª®ÅøÔÅì§>«9º>ÁƵA§qWñÈ, „yoܨK9”{p “dⱋsŽ‚Ù¢‹u}‚´eìâýÔÉmܱ+O>fe{IþvÇ×õ®ªtyq¹N/ÓÍ~E2¤Ǧ¹–QÓSa6úÉH6Ó,Í-%š4½46ŒûÒ‚“:FñtŽLÓ3TtK‰’ÆUœ4-íHs}"×;Œ§¥ÕUD•ƒ¾¸”¶rû'YQ¦iŽêX×4}ñØ4¬ve'µ³mâÞ4Òû.ÍÍ¡ÞÓ©ik½aÅ6/.¥1ó°”æ¿\§?”FMý‹¥ÞG¥Å¼EfÃ-%Hc™¤Is ‰<5ö¤1I×4Ñ­wÀ„0kZÔ½’hÙØÔ¦¹¥DN[qª„ï,¾LÉxˆRáUŸ]ÊÊ1!¯_6>_Ž„SÔå¦÷ËO¿útËQ¿üÌãyGÜzáظëÚô æ¼IÒ´å>˜-Ùýšßðµ‹&¢áJšÅ‹â^ヵbæÙ·ƒ­€p%=/9CƒŽm•eiW Ú,ãÑ<¾ŸÍ¡o{_ŽŒ»]/”6¬»ø´3îÑ”®I˜š8*.”Ñ€¸‘I@KÅ®WFªR̘W6×›¿†gáq‰…3¶(¾tê‘ŠŠ›l‰r9AQ1—d”ìP˜è䮸;ô±q÷Ô þV£¿Ê)+ÍJ&uÓbÜI‚¸±ê C˜(®î8Î;kV­ªÒ*©Ún4åIŽœŸã¤%žÐ{ùƒ]R3ó{/ ÂoLßue—DÖ/–šPçH™ðéIuËÉš*»"B8˜ŒpmFîìiAbåcGûS¹»!#5ݲɩOÚÔi–êúdþ”SqÔ÷§&–úuÂ$ÉðÚp8uâu”ÖYz‰““?˜ä¥’/ó±uÛÚÔfÑl]'©°*92µc„%LJœ:ÚÔDvÅ]*VÒIr`™÷ö‡Ã©¼ŒF5z‰“eUÜZˆêH*¬ü’•«³;•ûÈÐCûv¥vr‹ÇŒ4Ù›¿©‚Ô65±e¢”¼ÊHݤ ªó🠅FOEÀ»|9$ãRÌ ©?”"¶ÆLšÄE+ùâ”ÐSʺáÃdùšú³i:´ R²­¥ZJÞgæOK fÇ[«˜Â):Ä©!Š¦´¬xä[²§Å…yŠÝïÉL¬«¼Ñ[M8§˜„fcÚ4—t5¦¸I¼5Ò”¡Iá­êfÛxjŠ÷;µ”6ÍR ,ËD´{_XÜplŠ;楿eô´Œæ£Ö) §¬C,ü²‡[v‘<˜W•|½@¿qô&“à‰ˆŠ£ ļ/ZíL‡ád”krrzÐÔ§ÀHÙ5•PÈÕuXíX‚š±HòR¬ÁrûsxñWôÜv6²ç½0ß2 ¡wá‹Œ[½µÖV{¨éÐÝrÊh&=Q§ L-aeÀK•VÛÕyº<V—ä É~Á†:Þ´¼ŒžÝO²Ì‚Çy“Œ&ê?'F‚¤=ˆCq]^òR©c w싇 ·\†Hø #/·aäID™Ã’çy¤Ý‰Ã-KLT«&ÀkÌœ¥Š„3|Xˆx2ôFå„‹t0iˆG:&Ä$.÷PèŽ}qHÛ™Óðô ¿PþŒ2 l:B}Än¨8\y”sÀC›¬Ø_Þ×_çÙL_ê­ãþv{!Øÿ2¢@¿ÎFžòûGÈH-çæ7¬qC:œ¿ þÌíòã¹^æ2œ”k:ö1ðŸqF¤´Ù ǬCY:¢ÕÔiDK ="â pÖZ¨g”ÃJaBdS«m®4P§&šLŠÒ£Kn*¬0J#…e‘ÃZd®)ø¤ŒÔtáI`eET,#x¸æÄ)ËÁŠ\‚Y‡¾×_bK`K>éÒ»¯.b.DiŠ¾:>q»Ÿì" ˿þ=gu„ûÎÊx~/ˆO ã(Í{}i¦¡`êªÅ)®!ö®ªà ™!,h†ú °Ó T½x@­8²©.oñFIB59#¦xA6‘ã»g«L/ÍS¿Eu°˜âŽyéoýñ2Š¬ÁÑ$Uþ€&êèâyÄ.©OY§ÕP$þ´gh.ŽÞæsÈ‚ÔÞ ³7ˆ Û #îNÈ$\HK‚aX¹Ô9<.Án׃SῆŒ .Øv6báÕ„c΢¬Jt"?‘ωšTÉ#yÛgí®ñ°R"FŽžö®jk¦ª^É«¶lPi^!^Ñ«#—}(âTû4È)¸¿ä¥Z+D]1hë D ‰‰®<Òœ¡5aRÝOÝ8»zÒø¬e/yª&túpѪ§ê8S@¯ÛànTc\pè9DEE•seÖõáÜóÃ#Ã?AFêælÑu¯ ¹L„é<¡?ÐwV¶j“ ([B/Í”5x„œfG:\½u$ ³ ½ G ' 3‡¢¸ÈŒGìúd7–Ø‹L›æ¿IÈ#¼­´èQ: Ρ7á`C—ÙY;k¨ˆüPØeJiŽØOñ©âéú²ê”]ÁÛ5±ç82l–,x4Ùï¹Ä ÃH]¡a´!áð/¯!œv†îÐ z '1ꇷyê4IOÆÆsF˜ q[„–„NgÌš”Y‡1!™5…½=ÅòÌÞEÏízp*ü—œQØ[+~«§yï7$Txb©Õ£9ñ3„.ÐÅ3Ïlb8Ëg…“Ø '¡Ô•ý"ìlÄ[7_lf6x0möÒ*ò±"ôSÚ ‡«½gõrÌã †õšmÁ4Â^FåA¶†Ò¦&ƒ)Ñ&c¤eáhŒ.Z˜¼,+F-lL/¬™”…õô·‰ô°*ä[Øš‰2ìúÜúÕ,š›è÷Œ¹ÂnqÌñc®Ãìl[æÇmþú1W˜Z¶<ÎP´ð]KcîehpÑñИ/ 3ïš0ÎË0;lØ1·Æþ±%B/YX nÝG =Ì.Xá7茶—`6fZ€ƒ ¶5¬ÌØ ©}æ`,ÂF­›º•pÞ7~%.â9¡sX…g—àZâþÙ*±k ä Hv6¡Ûõ€ÃÒ«©2á«ôr]¦}FŒ'_}òÏÙûèk½ŽûÛ½»pÌŸ©]S£µ«Wœm.V«ðòl@[ãèÙS9nCL+Ï5bX‰;‡WPØ„ï±éh÷MÌúûbÆ.+¦–ÂÂ9æZÝ8ŒŒæÁip²é¢Šø;àÆ ƒå2mÿ·úJl&½-Ê:µÐ÷ƒy?4´@_··¦æ_3·Í·~íè≠¥»ÜÍì£#n׃Sá/’Qý{Ú\û‹ÑMg[g+É ÑÑ°[xÐxpÉ]è•ÕùÙ:_’ðr/eáÔ{“B(iSHìÌíw®©‡R1·‡P§.¥¾íÚ¤ ÔHš¥§Q|›S›ÒeÄUÙ›ØÔÀ¦¸yÒxzŠ'_ümÒÁ”ŬûŒ«Ý¥Ä¥”Ã}4ïÚ¼25±ù6ª²nøƒ ´9C¤Ï8a””kM ‰ MÒÔf¤lÆ>„¬/õ}4G¿8ë‘EÌêñhaøí݇»R¢ºön‹ëR†ÙJ6Kq /Iqû츌†CM[J™õQšõQžuí,ea®ÍçQš¥ä~ø#O¥ÎLH-Í̾#¬Èd5Ä_÷$zN³×›³U¡óá,¾ÜlÔBT)q4'mø²VŽÚ Qª#ß Èà…Ì╈‡âO“俉˜ãÏÞ³=¥C¢ ¥Õm$ATd"Õª‘¹¨Û,³…·‹>Fß.žSÆ&ŵY£hÓžÆL¹A"L‰mJuõ×lÝ<¥;„R\˜%uò~!%ÎRÜ<©«µ¯bÑáwÄK}[½b‡þ¹yÒãRþ"2š÷ÈR¯õ)óΞ¿”æã8ë4þ4Úå”û õ8  }JßÚYJ=ŒÖÕ;ŒýÌŠc?ûª0Ò¹í\7ÉîÞ×ÑÏǬÞe"­¡QË!•´r ¼osú(j$eE-EYêÈÛöнÌ,w}À (¢¾ …³Ìf%ì:WE_1GQù£õp¶©’ÁÙ™Þä«ËÅF{A²Ua&È’¡¤.’†¹Äx¸Ã=g° S6mäžb™W䊓*3ÑÄòLÜýÔ¯·Ò›º€_òª¤%}`;;áël7O]~’Ö »µÊ>/Í3C<ÏÆ ꣔Õ%’ãÑé¨4S®iífjMë§8¥5„ L†;¶‰=U¡4(Íá¹îŽn="­©ÑœÆ.çå´’}üÇ6Íûâ¡´™â±º]/.õ—él–§&ÛÙ³ÄCiíУ«ï~5"·¹£5GÄYš3‰cÿb¿RìLK­ƒ {³Y›Ö¶e1Í-Ìp½òh––Ó”öï¥AM)‹D•5- =£’BM7 åôfI’h3#nËr&ºKâó$ô4¢Ây˜¯ 5ni5¯?Ý’dû¨-½ü­3-nãËŒW5-…]%aš[JÜ—æy¯œëC€zz´}*£dôbÒܱ/JsOùئ¹/QïI¤ýÍs_¢6­M|“J“ø˜´¿uöá´¿aöá´?eg·¡,¸ž»ôin׋ë˳Uº¸ gÙfÔ?‘efq·ÿÑÊŸ½ÉĶÝõ »§fð·ý­F_¼Fal_xL¼©úùz\ÜóA:"ÞÔ(w/d¿7lü«t/ôñÔÅs¸»¦ ±{!³Î~àÇDøFŽê©v"l6á¸xœ|®·/Ó†7±‚‡)§¥;z`żÀ¯¦y:´°HE8[¯uG\œ= îWúØ`vŠ,ñ/=ØŸÞÈ“Éhþ`zsÌh2š?@(Ø]¸a_ºÛÿUn&¿/ÝøÀ´mÚ›î|`§{Ó9#m›¹“å”t¡iÒ¶äíG§KFÒ¶©ýàØtÉȾt Ìmƒk™lFýƒCéÜ6ô c2êL§¶M³Œº’Î÷·Hw?À¶¥Ò¾twðl¹Ãßîmž¥›Œà´Í8ÿà¸t“Qmmµ—n2ªmc?ÁöƒãÒmF‰=_vìJ*N´5ŽHºl¶5ö¥³FM6K8#9"gP'4ér %ˆç· Ú~’_økFMãát·ûƒ³ í6E2Š¹ÿû!ö¡OJŠî4OÆŒ•U¢i2·=±ntGÚÐ¥MsK‰Ó|—VÍñ—“æ81Ï^ÌÆâ^ iýnèIÛ4çóÍ彋ãÒÜS>¶iîØ¥Íöz›¡;öÅCi7ÖþÖÙëì#ÒŽêìܪ³ê_ìE6×8­—ÌNOƒ­Ç³ÆKvör¨'Œyõàê`éûSÝ1/[ \ö´J\?gÚoTyö–G³/gô&ò%íÔ$÷ÜÜ&«2Ò¥Ù µ‡µv¼¤­ï-Ù|l-K5ZË}®FãoYô ©"\‘¨½0ì m²ô‘ðسj¤.•®yj¡Æ¾T¹2ÐcŒóTôñÚýÕjô•ÀjÌæ t•fû¨Tãr>Ñ|?«$µUÓI5f•˜íÓ›jÌSgæ‹RàBÝ–È€§1™Çèë,©óò‚I5UƒÓy5à’žy%†Þ ­*{cZê ”øûT8Í=¯x‘›þy;_ùOp3ëœy5X¼lSù¾W¡GTÜ€Ém|ܼMåýï¦3‚cnº)P…›ª§ÈlgÐ,èûHU[ CZµ2Û>¢ÔT#šT³z¨ºÕö‘eF{‹À®æ4–é#0Ô¤ŽËÎ …Ÿä3»HkɲÓkÖÙ<šNHu»^>‹EX›`k £…¾D]é rήÁµ¢F¯ìU&íïž°o/¡dH#ºÕÌlÌË ¼sm”/_i9®nQ¹¹}‹‘)”té»Ú÷òjBKuá šÎ%æX‡Æ×Ïìi"/¶ÓÛl°k]M¬”&–dl9&ì1Gç±|dÌ¡âCÊã†r Û!ƾêù¾-8L£˜Oõ‘2¡Ö=¤ Æâiö&½G𨦭ã&]\¬ãûSo»™ ;ânß óÅ¥k®OxlÜ=5ƒ§5jo¬f¼á8cÇRC­Q}YÎÃ×Þjé.ìd–•Eg§cCtFÓV1hîþìã–.øzìylfñ†¤`8Š¤S*˜åŒJñ›ÛWØQÒ õGvi’. ,±O¦'Ó}uíp¦ïL?Ú©Ç0Ü&}¬óŸ9ìw°RÜÀn׃Sá3J lkº£imûUÓ˜‘!kg{Yµ=2hÉÀr£ßh6FÝSÄ[”èë¬õG’lùx>‹[’Í¥;í„ÕX€±0ks„F©6V0çå¸;ô‚üõ²Vhã®+±¯ÁÑqwè…cãÿîj„ú!‰#A“x`QKpÿ'0ê^]EÆ(n5™X kÌ„F˜cÙf¤phâ­ì`*ÖÆ¥ìKqÅËq—º„Ãñvá4S­MxlÜ=5ƒƒ5:ÌÎè£Cw ÊÎQ3èÅh€ñùé„GöT›£"4Ù•w¢jm`î&ô†Ê +@ºXgñüiq”jT—ÿ4¶«¿¬8†LÆFY1x©ÿ¨¬HBÛ°Õ(Î*òê?È"·H”]]Õì$4Ü“ô~ΆÊ:Œ ìrÚµð0‡cíR 󟳑>e1w§³ Ë«w7\ýùòÙvIØD¹¨ ›¢ÍêgiõG5ÂÎðæðË®î¨Eü>³n‚ˆýê¯'²àõÕeYý/eõG…¢óäO‡.t}BÆnö-lðß\)þÈ¿#3âkXòÎÐqxv[BqJèûá_kFÁ¸& ê°aØžŠ<æU¨×·€VªÀó˜Û÷PþfG6m +éÚèãc‹ŠšÇÄÜñ¯î¹/“·w >&–s 4z(³UR£w–EÀ‡c³åÇÉÆÔÊ †ß,]fË×ÖÉÆ„¤AÌð̓õOW£ºeZcŠ-41c¢ +§rë)Û½ªZ³š¹ c ]Ip´1Y¦/–‡·ý`f]i5nR;×Fí!¼Ä)ÑÔ®Õ˜(ü¼É'5 ǶOVorå[XYwÎòÃÔÄr,úÈêVöÃŽÅá,VåNœøj#V˜Ã Œëþ-£/5‹+»œwsôá¼`lHV(dœè-ÃG‚‰Ødñ,Æ,àŽ *#g é¬Ô “îðAYÉãŒ83¸lÏNjÛÉöÝÒW•õ"Q‚- ?‡ÒÙ†ºæì,ÑÙ4ÝÐïDÌÓYiQãn׃cÒ¯5t»œšþ·Œþ–ÑŸiFÁzù$Rhë8ñ’;Kw»J?ã:qƒ÷¹Üð9HÖ˜Íä8æ qÜfWªW©[bŸLÕtÇ$ûvw)ó©ŽÇÁÆ s}û[+1Ütñ©‹œQ›°;¾?tǾø·Œþ‚2â ¸È6ØÐízІñ'–ÕsªªÌ§lô×­b jĵÉ"³…®gæ©©ŽÕ[”?œÈ—]qc½ù¾ÍîJ×í×±©t†•²1«ÛvmTûºkÛÁ˜u—íùÐScîËd3¨;h†6¿ éǾi{ªïbéþÉφ†·xè&öfPÛ—{ΦyŒ^ákà;¤hѯk)."ÞËCì/5£¶Äí©^ Vµ¾Õ¬1Ö´â0!œ.2l[#ñ êÚŠ¦5A9æ‹‘{ºHõ±ínˆÊÚÌòâ+•kâNEîÁÛ';ã½i ÅÝΙÖtñÞBPZ}jÜ=5­Ñ©ìh¢;ºOvt²ÖèÐ(¥=|‡.ŒNñ¤Ù®µ»l z$AD.Õ)÷3tŠ¥¡5­¡© ú+œ*¥>2+‰vòiñjÞÓãî©|é…Î $/ЧǩFq»¾H—²²#ÕTÀ\1íÝù8<+ëh4ce²ÉutÎÜèLPò %Â2dwi»Ï3', ªì‡šuv)ñ1{ÊÇr_&›‡¨—¬P–é@Wμè-A«T¸¾‚«In¹ÄÁÁº®lnd~%`HG„Eó ¿lµT—kRµgñ¥[¯Žaû¦‘9¿¸ª6¦ˆÎ¼©ÿƆ9K&tGÕ\ÆF»hâ73µB8[é#JäM‘…ËuÍ6­—ÑàƒY %ºeSH©ÇÝtɈÁÀ×lÖ{±žKD±ùIr£hæ[‹€ \¢"°îKgº—ï¯/OxfÍvýÙê Ù£‚4 *èÙº=;øb<rææ¡%(Ï¡°ÓGËîêLb^Ðør#äÈäÚDË"Ÿ¹Ó?Y†Ü—É V÷qZÈ-%>rû×ÎGwVy áµqšßoœZœ­Ë·t0úðÉÝ÷ǨCûd„é¶ÁWÁÕ›.¯?¼vÿçÿ9}xý«û»Û»·¾¸~{óá×ן>,‘|}õéóýõÏžýþñúáîö󧛻Ï ÿúãûÍõ?_Þ¼úôìûúAy÷WW¯ï}ó¯åíóµÃ\9Ÿ_]½-ÉáYpá™öýÝÇg! φ³gWÏòýóÿtõðã‹÷ϯoo_ÄôìûçW^¿¸yþÏÿð_öâÍóÿxýáúþæÕ‹·ÏÇ»÷/Þ»çßß|¸útwÿðâõó»û?<ÿMùô§/ž_sqõpýº¼ù›ß„RÌóû«·WµÒÿáE)ºⳟžåyþW·¯înß¿ˆ¡¼öO/¾j±··W¯®1©VáM)ñöæËëçÿøùë›÷W^„uÜz{öì§çÿãÃÍïj¥ïn>Õ¼x÷üîM©öÿÄÌîîü³úÿ¥ÔælåÂ*mj៟ÿðéþêÕ'HÖ*uWë±)\¿XÅ|¼¿~¸þðâÃóO¥&ŸJøûòïî…»yþêîýÇÛë÷øðêþ§ÒW?Þß]½* ï®J->Ý•nøýýͧ›oKÍJ_R%ÎB©Äó×w/úLY|S¾­ñ뇇úúMÍíöætÜCùúàêÅ;÷üM鈚zu[’o¯>¼ý\öÛ߬ý³p¶Ý–œù¡ÖöÝuùý­ëû‡OåMS»¯_¼uðüíó·4²ïžº¿®”^ùüªâ[¡/¹ÚÏÂfX¹¾Ú/âªôÓM­âgø« ×ܯŸõpS{âMA’·˜æž¿¾~¸yû¡¤–ìßÔ&=¿½ùþ¾v!“6uhËÃÕYɹôs)GðíòºqRñ7Ï›ŽûÙ‹X¿z¸¾½†Nús·¯0Ç`X¥”ŠbµéGK¾ïáRÓR8Ž×5tËõî6†Ò¿)ÍxWJxu÷š«ýZb¥¹oëÀ¿©½Q{½F˳29î]™Ÿt:”wÞÜ_½¿þÛ½*#Ujvÿã‹°-Õ¦~»/ "ŨS»v 5kÏ똾¾®£þá†Qç·Ï/sùðÛ86Ðü•ß¦Š‚ׯn¯î ÇVïqLnß^—´x}õéªvƒððuͧ6ÝAë^—aøÝ‹ÛçMßÕ¡ÆV…!”‚^ÝÝ—™T¿/V›òƒ ñà Gƒú¼´ó5¶§¾Îé°«Mí±«ÓÇÏ ¾~õ¹ý ³ð¦v4P·•º}K߮϶H‹¡võ/!g@¥×Ÿ¡bÔ€ LÖðm(¥\¶ý¾ÚºïŸ¿¿ºÿñóG3èôNHRê ÅZÆoŸOøtýááæûÛ:½þ¿,ýø_éÓ2Fïžÿ¯ðâ_žÿoÆ¥«òâýõ+*±àÝÍûo¨ Cô¥f…JÔáFJQúUúÿúùÝmœûõ,5(´àù¯?•Ž½º}3Õ!]¿º…(Vz[‰3×lU§vS·ÊfóUżRIW¨ÜÍëëÛŸ˜¼©þ–(ÌÇÏß3†oéJqïê¨ÆÚ{7^.$ç'¤ºß¾ØÀX|Â5¨JÅ1êãkéã¯_¬Wµï¯¯>@Võm¨ýP{¦¬ …(¿~]»‘ÉÍ›:Ùß,¾¿ûüáµTøÓõ>1ñ«½O¸GˆaS{ˆPàÛëè Â«-Vøíókã¯K\Å×X¿wD—ëHÉ÷êûÏ·•öÂÞÎœ¸ZWÄ“¦Cg|¸ûTJ¨ãý µÿO-OˆO­©k諲^¾+³W©›)3­bÔ›ë{nQ,xüÓóëeÝ…‡¿þtõM;뾆üno¯_SǪXef…Ãb£äèæùåõ.iVu\4ýöE!Îu™þý»lÁu]^Ýß|ÿÂUB#õñêþÓÍ«ÚO%I:äÕÕÇ«ïonK^4å\D® â Rìx–*•¯;V^¤Òä7JÝaŠ½N}÷üÝ.ï…J×Á¹Æn*xSø«kX%îhU­¹*nÔfS)­Èúõõ–óIdÓßb]þáªÆ~zSy[Ðä(ñMÅÉ:ËÊ4X,-­+Í+uyG­Á†À¢{UgÝ r}ÿª6å]™/õ%Ä÷ò ®(q}Úþ–ÐBõˆ ¸8¬êDýê•m˜‘›2…š–¾½¿úøî›·wŸJ‘eiøÁ=øXéøûëëO_-¿.]y{Å=¶ ^{ì5T£p ´Ìº¸ÝÖöŸ~Svælþ'D¦ûo~CÜY™¡ëÈpÓR©: ËtúPÛø{$ûTôÚWþïù`°? Y¾þÃUååxíºú¬’º2#Ü;G¢¡ÿOyðã§Ò*¨$æê‚ү̫ÁUø¡æz™ô«YEå; HÈøÛã‚hOä~½Z×ÉS'Áë:õ¾-µù§w×÷µÞÿ u»y_GòЖëJ‰$"‹@é–á&ï¯ßÂ\븪óçáÝÝ}!V@kµ˜Ú¿-ŸüËç›Z¤{”Åàó=﮸ԒB}ËmXû:¯_¤Œkd7ÞZ"K]òÕ’—oKwä2ä®Î±rä<0_ËÒþhüÃÝ{"œëõ6(á„øíó‡ÏHbÞÑL)ÅÖ’>s ¸u]±´¬MŸ ÝpCa†E⺣f ú÷TÖYªÓñ®…û«5²lÐaZ$LÎÒae8¯`º<’š~º®CWúñ¦ÎЮ "mëÍY’e*IŸjgÁœ-ŸþþÝõ!LêÌx[™„¤–µ:ÀÕ\zøû¯Ë¼.™×W±êؘ´öÚq?˜&Ü “uóá›"‹ÁèI¬p:ÀSB†ûÍ7ºÎ€ôáúº¬ÀŸa3¿~– °~ö»gXè6¥*~xNsûîÅ* Å©Ãru$ øîù¯îq+™´}À9ËI¤ïÕÈGãÝšúgþ¬Š/e݃•îÇ瀲 U‘ ¸àRJ©÷uB~]:ëW%Û«û›BÍÊ4ºþø©vcØn·ßRÎÈåyykü‡¯J™+弿yûéýÊW顈žøÁw4Ìot˜¿Eì>ÿ€r' u;½ÞQO\ ñ=qûW$•Öh–!Vã}ý ùÄòÒ7µp‡, ÷ëçÄ ËE¼¾#¦¨¬„ÔX“K·`£Š(‹Lna£¿]½êRÜn%Û•{kDKüvSgfaþéý,N÷×oëŠÏs{‹¯Èòÿî ÊÀrÑôyÛOêkôïo>½»û\¨r%(×xU†²ôìÏ U‡i<«|•c]~ÿü÷×·/>=¿ý¦N¬ë"f¼.¨]šð÷•þ~­ð ßP±,ÖÀ¡®K‘V¶†¦>ü„¦ _å¬*ýêöº6ú¬¶õ¿—¹+YÈCñ÷Ÿ®„±+ ñ5³üû—πد ªH°¯‘J“ÔØb´ðšùœ§HÃ…lã8ÁÔ*ý ììÛJß ³Q–üO,Ôâ"z{«¼Ú+WGè¾Jè•ø¡¬¢Pñ"…Ö•¾®sU²‡ÅÑm&à#ëéß‘|ýºÎÈûëo®îï+£Q°©gV¡Î9 ‚õ!Ìmäj®Í`êv[™…²¼]5„å®6ß-]GÍ.X‚Ì &W™¬¯¡og+ú$Š¥Á˜pƒƒ‹s¯h! ÿ ¬åXíK}Ñ°|©âé-¨Tª"îÿ6ùWHß2£¯µ€5ûÓ™ þŒ$¦«·¥Ó /ʶ.€eí¯‹*j|¼­„C ©Ôºöæ9v*åô®fc­ŒvYP^¼S^V¢K:v |\J… ,’Çò¤®ó" T‚‰ÃWäW·w0zÈH—.½¦9ðI-ËXÔõ¶ƒ€üÖÔùå#‘ß”›ýöEirí©ß CÒödp ¨Šen€9@œâUiƒÊW /ý:”ŸÞ} ¼çkYË—pêFøYÄéJ˜ÞÀzü‰ÊLÀ'HϳR‡:¿à00ºŸî>~s‹ï¶äÌ pªØõ®fuÃÌ\™Xßß|c!{WïË <«b›™Õº¦Rîl/ ÀRheYo¼ýõû”–ÿdú¡Î´uøgÔ¨ï^B~T›wUòxõ©t!ÐÙè·Ð§…ñDýc)ôÝ5´¶“[[ó©óëŽ ί·„I¸B?¡ö¨ °Ì*6³öµÕÜ Áºª*¹ÚQEÍd,r.6pÀ,?\¿Ç5 ˆ(ZeŠlú X&BªS¨Nº ³êEh"r÷¯aµ… Iç¼>Ðä]iê«Êâa1ÓÃWi\f>ß¾~©]²ªž n¹ûé¾7ˆ5LmªFôá®U¤`÷­W@¨?}º¿ùþó§ª ŠÑh\€öpCfíÅïX=Yy°ïo@!ZEçç$¾Ý€[T¸ÖRÀ›Ï÷0¯²Ú«wЇ:‘Uþ:˜ß¢œoÞÖe6Bªó;“¦6älÁŒ$aЙ£b¡×•A½½­*;™Xé¡èB‹Ý[Ø5/Dâ~cJgÌ(FdÿñZwW€Eòî{–d+ê©Î–²ØzR¨þæ]™=?¾µ¨»Qtr×í¦@éÚšïëçŸPŒØf6R°¶0YÇXÞ³jãÕ&Ö:œÏúcéÈUZU]ÆÖ#Wÿ ᣒ…¥-;ï»ö8˼ÿHl@EÐñ¼¾†<*çZ{¹°ßÈ$yM*ÔºÜUêÃ5P$W•ü׎[˜yµÑ°€™Â:¤’D™MoU¶DEã'!s¨T6\ä·/R¥Ms¤õ æàÃÝ×H:ëæôáO0LŸ+ j· éÌF‘ÃnÎì¹õè'ú$˜Æظ¸ªbQ_¢ôâÔe澺¹½ÕxÕ]âæ†Ù:qoº½,a sð¦œÏ¯K§ÃÎÌ óÕ=¯  × ó²UËöÎî À|} êgq°ûÖ0©°™ºt‹‰Ð¯²O ”´Qº…C%Ч›·WÄqr¶w‰EŸ¥Ê"5»˜?+6EZO°7õÛç¡HüëJG.©‚¸Ò(+Ö¿åV[‘‡v ì×i ôÛ­JA¥Ø!øĘVyâY‘¼®>”õšÅžۿ®Ý^Hé5ôð‡×‚@¨Æ¿­Uª»`ßRƒ¶€¥¿}¾‚•&üÇÆb˜{0rˆ$o@ÒýÒ›E¢H²ËNº t|] J‹Î<¬?©ÒlóÖÀ¼Ç½³‚”•mi1ï ijÛN5$ñã3´ÂAÇgÿß"è”Åî,õ,ÿP‰SUGžÁÄ–op}KϘ¾¢éöÇ*1»ÂåÞ½‡•8$¡ªoyÿåî§ÝÜ^á¾ÕnîüÓ?ýS}…ú³Umí³\˜¼OŸ>þì»ï~ÿûßûêáÛŸîîüöêÕ·ŸüîÍÇïþÓÕ?¿¿ý®´àúNíŠTåVÏØ%–¸¶E>MQVµu…úx‹hø»ºõ÷á_…oýWÿá%mŒÁòÏÿËÿ>þæþjiôûÏï«þõþú7Ó?”„¿ƒ”o_zýw/yï Î»ŸCzI*„mëtøù§›O·×/só¾ÿþùSa¾ ¥¾ãÎ`^ü¼Ÿ‡O//¯~W;åâþó÷ׯ~,=õ}.O®Ë'ôä{¶M…`ýüÕ]©<òjŸ~º½þÅWWd’ðÕËgÏ6°…õóÛ;ØëŽýç÷ß(ãð‹¯>Þüệ÷—JeÞ_—5ïÛ>¾ø—ço¿*ìÌð,Õ-ªj(p{ûpó¯×ø:”÷пÿÖi€½¦ŸÇ•ÂÖû5?/U(òÛu±(Hp]*0ÞÝ–ÊÜ\}Ufׇ]ß—´ŠZ!nS©ÅÙP¾†ÝdV~ñÕýìÊÈÖi¾¿./ a»‚|Ÿ…(sòëµ;¡º¿ú/µ¾aTß5¨QL¾@*?øtÿÓ/¾ú/w÷×WRÒ¨DlIŽ‹úõ݇Ÿ¾/~m‹ú¯×o¯^Uicü//^=/ëÉpFež„Ë/¥„*†Ÿ,cv÷áÃõmʼn0¬#$Þ^ýt V•üÅW€wïï¾¢í‹ûJŸ>ÕÁ¿úpWó=«š¢ªá ÞÒ÷¿ºú\™ŒËë‡÷w^÷ß_Ý'òpõȤÌt¿5µxC™LŸ«‘EyñŸª®ðSŸË÷Wüývõl^‰ÿ|WçÎ?”n¾½½û HŸ~ýºÔ7nLðïLçÔ>[Å5ÎØ2‰~|¨í]­A`Ä”J´êÌýÅW•÷.êKk+Ûôÿ®zùß]ÿ=0kuûòó}éÅÕ § ³uSª!=üCzªzø_mÞ¯WزªdðZÜ5÷ëO *¹ÿÃõÕë»ß—þë•Pˆp³†ºôqéýÊ?|õb]Ó°°tTÒ.é7W?ÖbrYT¨þ¬sœ»ŒðPwÏ9÷³÷«µÍ½ÊÙ«¥ÜßUÍջ翹+\ɼþ]XZô–Ud泃-)e(ËQYÑÃÓ•õwÿåêÓ»Ÿ¾ªëÏ?üû׿ÃBª8ûKX¿_MkŠà d¡+a*”î§ïï^×RnžÿçÏï?Þ|øŠÊ‰qqÔ›^[¿_­ÚrÖ+¿Ðk¿º)±wÏÿGU±ÿº0?–”ræüú}ؘR*úºÄšñ¼â~Lg0dîŠZ¹ôÏŸÞÝÝÿâï>øñÃÝï?ü]Eš8Ä:@¿º{¨Ö ?ÉöúåÅÿ=ýþò7Wïï>ƒpXׯë‡Ûz:d ¿V%à‡Òäµ÷:ãî¯ßÀÖð‡ñÕÿ+~õ±°©²å•—_ÃwÚ$’k,ö-ûîùWÿú¯ ëàœ½{ƒÖjÀ/—sW„ö’EØ$ÜÚ ™§<ªÄâ7Œ^ß¼Íس¨Ë÷YNÎêUû3°©d‘¬î¢AþÝ [ÉTÃòu¬F‚uÛôº’õÂVÿP)w‘‚¶ '¯‘1ùÏŸ?|sþ¹êÉÃöl[?^ƒÔì¿ýÏ‘>úu™PkP}Vƒ¨Aªóöëú|}È—Ô~G=üêû‡oj«@5PôÂ4„MÝ#=`WÞ<Ϥ7 Æ…3yù-28d”¾¤!>húŽ8¡|Ý£[£äMª`%ÙÚÕ=«µÓmôw‹:ñoi °îåʱîØ}³Ù>»BQÒ­ŒtÚýF,Íyÿí‹MBMzø®åߢ漲ßÀžª¨jÙêWß_¡…Òî)¶Ûcoqãý”©ç¯ÿEi©Êñ$0Øç@‘è K‡U@y϶‰7Ÿ~BÍ#èâêæëªîõú–Õ퀒¯îo>‚„´z?ŠÑ-T»1Àx[í:^/~Ê×|u[–X6«¬C€JUœ™%€ îú€^»õ¦Ñû«{ÜÞ¹¢}C§=C[òï`_꺌7©ÝÖ¾b6¾ØM¡”ù©öüg MÛm(P<\_݃Äi­ýX=2Ô `ìM7¬¹þZðvû°‡xõIò{ãPx{WD›j¥ò¡àì®}¦½³BËûçÿüé¾tÉrµZoÝYe'ª®gõb ÏCïît­Ø úÄ{4™Àþs¼‡ù‚IË´¥³ZíšmÎÎÈJéºæT7ìÿoê/`5€8¼ÁŽ»ÓÎ&‡6üÞ_¡iô]Š¶ :€UÏMÊj's…µfˆLsC g„ø·Ï¿ÿ,›…Ðyê®™@iÈ;‡¼¶T¤ò sªµW™­©òHµWc‰q2¨ÕB9›¨È×híü„¨LÞ™¾zMÅo=˜€¢òoûé®0äJ…Âð×ý9À «Ž6•A Ï'koÊT®j¢·Ð8’öþ ·C‚BÞY5ÓÞÝe1˜tðþr8Ë8ÒDúÀ;VP0vËÃgV‹ŸêüDPûnž}o÷W`­Îê,¾@k±gsJòƒ! ¯kgþžtAuãRÔMŽÞG2oíñUƒôkÚ3ª#Úó=uó5ιWe2A_¾«ncÆàV¶û>ªíøÇPç²1K‚aëUEe}?£=Øþæ|i—“ÌÖ¬jéýÕ‡Þ› k_—ÀÏde Ä+ÚÎEE绛ׯ¯?èþè[±@§š¿+ ì9Ú S+t)˜°j“^ ±~ù)B]‡âõ«O_ÃfÁûº9B¦ë°-d6Áëö=÷¬Zï‘ñè7l^±©ö=Ö×wï ÛõM»Z½éiIØ€™ËlÍzÍëÕj¾^=Ý»+2Ê}Yw>ýôÐÈñÊ…øfÀK¼‚—¹#0•˜Ã-îÀ»†½aØ¥ëv,oõw¼½É;uÆ_ÝA‚Õ!8QûÝÕí ªc(×æÝÐj@VXŽ(%`(Bß²éÜÅO°A_'?Ù#ãš–êÜý[`oÙn¶–Àº°:õúúie÷Ö(éÀ.Ý©á|»Òp¾38€ ‘]D\þ^‰óúªoÈ0€a·Æ±«ÚˆßÝ\©ýó7xúáÃsà)›S <µý$Ö5BBy´¿å×ÿ§JLÁœüõÍ}í–Òù¯`¨ß¿F"M˜ƒž”~ÝôÕdCýC¥ïÀ¶¯.ÔU§Ä¼Ôý]¥{†TëNÖî3üÐæÛë»×ÜŽ³ ñ3?á^Å+ mÕ\ç3÷¨­¿ÿtwÃçÞ5«Fe‡€ûpó/õ4âð$XsÐø…¦«7×µ»a³y!op?£þþH£åìD½)ÙÅR‘› ™e®U0iíAÚQ|(T¬qb ýÀcZûål=µèývÄì¸'åVH+*}{TVý»ÒкÓe5ãÛÊJ‚2þ Q«n£RKKºk2‚#kÜ®-h—›ZÜE&¬Ý=}»k£ ×OíÆŸáiˆšl6ßÈƼ‡Cl¹ûŠÍ›€aF²Yùg°o>ÞßàI0‹\?cQ÷ó?$[8¬š6*†uUn¶B»"à\o̦û~¦“v׸yÐÜÌš-ŒÁ áÞ³¸ZÕ)ú¿Ò‹yNödÃÿþ–‚ØB®q‹û××tÄ ºãÍÝí-L!³½¿êîñÛç@¹o…Ö¯É4çîヘµçÌx'ûª•­¬´ÌVÙb>7€ÍW4)íÁ:Ð_ó)¼Úª¯Ûq}Á©ˆÒŽlþónc³ìh³?€¾@šÑÐÞ6‹I2pÊ$¿jã§:Yóݲ°8[z©8ØQEè&š«5ë0ñŒFÁðí‹õÚ}o*¹&³Õ›‡WŸК7ýJÇ?˜Žtq€éó 7êÌ+Ýd½éæëjMØ»"{¾u¼S_ð ­ÖE·ö   Š}'ÃÆŸÞ}KÂ4æŒÉ4¦žÀ@ˆÎþ}Ýx”/6µ)À¾ÞóÆ·‡]!è„€g)cÏR#|øüömÝeFŽ%_f᮹ZðC«CÝ5ft{wΓöö·[”  ¸ðŽLÍédç ש$®vã[ ¸$‹ÔÑÞ7/pƒ•÷ÜW¤|3W%˜ÓB Z”ë?ðy㘛 ó­9K ­Áeñ¦9hX HtÈUªúJºº4Ô¹ñ€ÝÕ0aUt¼A‰õØ‚V×CSÔ®wæx%Ž‹fKØWxlT0ÚCŽºHí»±yCö …ø$²Ý—J>1R—6¡.Oo¯+Z|û"y” Ž:èˆê Ð(GÎM³YÜp[p¡|«;öŽ 2H=ùöùŠ+ÙÍZpÅþnî+Íiˆ¸·^ÊIzXvØ×ucvØW°ÃîÖ[´º£÷Uwô³ºV#ý¿­i׿úæöæG’ ßW)‰§ ¬«pœ÷=âØKmAKŠ$tÿNú?ƒì»µrîÌo@³òCÕ¬Àö¿Îpû¿L ù·lÅo¨Ö›ç¿ý-p¿îù»z_¸•«‚ŒyéµR§×‚ ÐÇ,â’î,€¸y…ká{äÖêQ¶÷d6ôî9’¸÷7ŸÈ”¯ŽÄçÛO7hW©60}f“¹7W¯øX_Žj¾×H€g+ØŽP]La„^¹Ê_Æò[ÄêªX¯Ö#]þ>~{wÿö»ßüãwÿ8ßüáýí7uóñ¡‘«àÎÊh"¹YuÆ ñYtñÙJ@q R')ó"iÏ˃³F+NŒ-3Šd…÷Eƒ»k:¢ H^U­@÷Ũ (8 ,¬3É/¤u%“-êé‡kPú,Ï€›f”¡EhxSYvXBëQć7h³.§Áoêöhµü{à<^=gB%гZný˜X[V¤¹7°è‘%.ŸM^£¼)³švq¨[nžo¨[âf Uä[:º}Ùñ¥Âô'ûù,ˆY—ȼG³½ÛÛÚegÏ6¸FÝ"Ã[3p•}ÿE©OÕN­s¥|þ¿ÎÙöó—:þ¯)øÿ.9%°¢§ãó”NyŒœ g]fѳláÿ%Ïñ7xŠëןîåhÞöŒ´¤ׯ®ª$Èeì ß,Ø[>0ÒéÍ"‹4 …4*>®IóÂؼ´¯Ù"¨îùÓaj'F‚3æŒí,ÕƒDsín¡r‹ +S¼Ï­±(-Ü÷¢y [–§°´•÷d[ñ5òHî¨ ›Ã '1Û½´hŽÐô5'—"C¤Ãuk¢âŽ` oþ¼®©Œd×¾®âÖïaßåÕÌø % ”Ÿ>ƒð‰MŠ›*âÊüùþ' I!¼¼âÒBÂsU0µý¦LáDaqØ+ R=3æv¶ÆÉõ8íëoU(©nãÌ…ÍvƒÓäÓOisÌ7ð*¡85öíóo^Öi"ƒ¼oDbì`ŽåÀ‚oÍ$…•Aë½þЬ›Ùø*ËsÍÔŽ„†íŠ¶x —3HZH£rmm·?á^Ê«-ô4«¢ic¡?wƒÔ˜=H ]ìÈ¥ùѲÒßÖó 0z7¬Køžz€v®êy”ÊnòÖ’2NäÎc ƒ4p&%4gRê9{²‹Œýùþƒˆ6oÍ‘Y'LSôh{óÑÂ(”B6µž˜­¨*œ…5;žˆx.%ÔëæS]ʇ“ú·¨dÄ3*ïê™–ë÷uDîhÙX­Îà8ݧ?[ð¶ÿ¼n­Ý¿½FÕ-ù€áÁªù‘+—ZxüEe2ßÑÌC7tÒ›U†Wª±54*;'n…¦ b›Ê'¨à$M_ jr«0 ³5#hGl "Õ$vZŽôì?¢Ê Vå¬Û¹×ªýÄ%k>Ó¾f„Ã¥å-ž)vTlt|ÿùæÄôÌô¢nþ~6+¿–²n‹ÜsÝésìoÈÃ=¨_Ø?Èv;xSמs`+Õ7Ô7ïÌô«nNfÚ©oËšZ­¤aÝÂ1A ІVæœØ8úZÀÇ÷nè4  rÝÄ»§·O?UÎÖDz:JØ4·©ÊÏ*ãÁŒ«²U)ÔÝç–%¿"jS‰ÕǺ©‡Lo^‡"ú±úîÁƒ"¯„z° —J îîuOuºü,¥?¡€‚Rß²_Ož±èð3Žôïïé ö}µZ­·Hö é­t·Ð4·«=óóŸý¬ž}¦Uà¦Òý7Ïùß+Kúü·/ˆw‹ÛUçfë ˜µº#MGú³i¦ÆùÕ×Èe ±†lÊøÀžFÀD° 0eæá©õ5Xªß¿5ò;l3‚ò¡*%?¼`oI±¥—lĞѽ®µQíŒâíú7 rñ¶×®×x’%9nÑ–é.þEÀª±Nþ\¿|<_…†½TaŸ :¿#¶ ê£d 'jÓÛäb„NÙU»D0s>ÌP?w=« û÷ˆJDj”À&ÐvÜÕs£¡•ÿa!¹áãk{B?¿!oEvr ”†ÔfÁ.~mL$®=:¼“é…ø rp½\wºì¦ëvª|Ãc[ .|õŒu-wòíÑȱÍg3L«G?A8ÃÝpÛà‰x£¹K—Žüšl¢z:ÙœUé×/¾)´ðpIçÀæ8Þ¹þ›SU/Uþ`þÛúxù€Sµïª²öš½!’Ýݼ®‹@@¸½z¨Ga}6¢ÐYÞ‘=Á!þÕý5ZƒÈúZíñ4œ7erB`S¿¶á Ûió‹oÎp¤B8´'£Þ›Û›+Ø hÎÄEѮ׃}´Ó¬l“³–ªªŸß½?[Á’¬ÜjA¢†Ê+<˜ÝfçË·¬äý&z/@•]æè2B×p¹nþ…2’)ád¨ C‘߇5½B9«Pù]5jøŒ°¾îªc‘Ø]=1]ZøÓwUÛy Ò(ØfÔìWÕYˆCRWX“¡éAþô𛸢:UBr¶YáV6µû¥­åÝ8Ôc TŸÂ¨d^ j»†ƒ(àpAŠ„’‡YÉgÕ‘V­m=ü¬ŸÐKøZÈéhªÇælëšzž XÆë¦VÏÒšÏWÿîê¶ÌÊ;XÊw¿«G«©¬aufÚ Þ°´¯1(ŒéµØ×Z,Xn‰ù5û¥!õhmbÜ$l9¦Ô¥3„`‡+5Õñ0Øï‚gLßÝý¾j ñ«ù8´tú|mr•ÆÒ‡`ä[óýíóÿPš$ˆððSÁÕŸÞã—¸å¹×iRF º(¬ý¦í£ãfJdû±®l(¯jç€kÍè¶Çû«Û¯µs@|DŒDä$ø!™©ÖêÿXýg»ªYƒ‰u)™…M­Eßÿú×õúÌõ•³ÃUm²Ò¾¼ÿeþ¿«?¨‰`>£e'–V´Ìóÿ{ÚÝÆq- ÃßëW ¾ë.ïit7F%qŽâ!ñyìÄ×ÒIÎ}L¯kh-ƒÁ’NrßßþÔžjè®@” ¹ŠK vïšöT{ªnÛ_e»œÏ¥©&@ÃH1ø³vªù£Ajîÿªõ“>üu;Š‘~lîŒvNg3üS Í\ç·PùTd i¬ˆÓð1±6‡ a™6¬Þ[¡±7=z+Òø¦¤?^$QÇôXY noàs”àŠt@½Ñ#ñ ¯Û¨tÐïûù  ¥¥œß@‡˜”Ü•®bž»jñ-—´j®OÙ úH=€ô­‚¼òOPdõ}éÖà(*©Ê¼¡…#uD´ãŽ˜âpAŒÎ‚‰ZðÚ#;¦”T­\õÅäøºêËŒô©MwR#ÅSצ\bç”a¬º‡I­YÝò¤©2Ú‹Qî圊ïX[‹ š<²èÑ“_4 þ: “I ¾èÎcæÌcÖæ[Õ¢6¤<@]Œ`wXjtó)»Ž%{P¹žøEæ–&ú¥¬×Kg"QR˜º=÷P´,f ™$F›9¼”žÙ ÂK7®išæÑïàÎ[”0uVš¾^!släZTx,€íi¬ãž ̨ß)³la¦¸+à¼%ÿ€@&·áØÑÒ™Vù»ã)‡\±Ç þoy‚òÿ°ŒE¯á™rh©¦›Ò ‘mÓhR0‹ŽÎf)‚3¡?3PohS£InË¿ê¹ìÖk)—”³™úV$Ã+ÌØÈè¥$É’É<-`1À®nrcrR3×a¦Wåft‚™Ñ°gI“\A„ù—Xù ÜÙpb/gI™WçuÚþêªð8Uѳ~ 2,bfk5#0'+ìLÕíC8ÔmRÞZ¾ uÏÃ.p{ú}Ìî° ¼‚Uäo\Îd»åð+cdgwF0±äПg KŽ¹ÃE©­«±Zü‚GŽKXaqSs}?:œ"é_Ø Euo5ºÀ ½±ºG$4G”_Gh*ÉN8§¦–yÆpgmܱ³—°ô¦ØÖ‘‘E8)nX{îu­L3e”˜«©/ º-òqN–¼Š;)¥" Úðwp2tz$V™ERE!AñjŽÀU3¿Ô{Ç‚2—¬ ×Á†R0…OÝ|ìœÂ"›äC`’˜¤©GvŽâe‰…Cˆ+Ž œ°HãT©TÓòÂÔ1ïÏ4Fn”YbÑd+ÛL™ˆh“ædb0ùpÚmkeÅ‹@ÒêJ_¡¡'5>’”ŽàÏÆâ*î’»ÊïÌ]"SÎ9É y®é´Õ¯¤>˜„&&'a‡ Š#€ú“Ëë Ô4„P„£ÄGÌAËöNîJwÝ…|½¥pß‚ë®MÌY7E‘gÁ§V, µ\_Ëd¹Jîè†ìàf1.1¨a#€²RP§ÑQFˆÒËÚq$:Ww2 ,ý«kN¡2LÜt П®W¯­ç–ˆ*Ãè¿Œ!L Ö™Òh-þl fÒxH“É ˜Ià”ôÊKSSåÜQÀ×M‚ * 2V®(ù`RPŒ¨ÍÈÍ0†ê nìd7&Æ@6Ïkª^N&ÔË$8c@¥†_q˜?%â:•õ¸gaËÁŽ&°„`€ÆÚŠ`®xFYÓt4[[ëjÁ¦$yp†ø¦’>A†Ã¨( •Ž? âã-JÖáòoÀ,†±˜ÈžKïqô™‰ÿPŽ&÷’´YI ‡ÍâíS²Úc[à¡,ÿHŽ#|» EUkFaÒH Rñ[¼€ ¦¹§}m@e”œý–VWŸp2F`èò²AÏìÍîbÎÙå} ‘œ8Lx¬”â±¾ð»Æ 5µÛrãúqŸš9×ÇؤZÇ®Œé “\Ê~ƒç¨XÐxÆjA…å×"…ªäÉ„G~ÆÌÐ"ánI!K_þ×Ý qIűŸÂ™9Á»8~Csàºô|O€¤JŠMNeÿR§µöRSªœ ®2Êâæ€,¬^KnaŸ†‹p4âÖEnÂñ‰n ÷I‡-“CwIŒÄŘPíz èzÅe"‰SêÔ4wsÉ)ïÏè,àOÌÞß3+W[œ&ËáR\ÆžkÐቈ³1› ë5& nWÆÅÀ¡hÙºÉâÇlÎ%:ì ŒC¤0!c”,7SN´ÜŒ£åÜ{;æâ4Bl´77Qýz­äæ‹)Bp'ì«—­žñÇ®/"®æ˜aš¯/¨Ü6°!Ù *^/ Ý(j´-H ײîÓ{@?µ¤–ìf“cO ׊oI P9)ß@…•i‘a6¯AõMK™!Ã)8§0˜õÔµHPª%¬@¸¸[Äë¯IQHf( ³ç$š¤2Ç@ì–âqÎÆ{dnâ®Ý`Å%öy¿©9ïðER6Ç_äæP #Ùؼe央(DË­ü<$½.ò7àMEŒ¿)ä¢d€%ôDÇÌæ+teÛËjfì²)¤6±åΘé*Tc2„äþ/ÁŠ!–Xࢠœ¾c¥Ù°óÚ8½ ˜×L‡z=¨Œ+çuBšÊíº@שâÞ°ä‚™è#q #$]¦®à„@·r‘Âj±›$18û9ôŠÊ]>_=¡¥˜SœuúKц" IC oj‡’Í0†ã™UJE/Ñg›Ë†#JE$ø”|èÆe†L7$•¨ÇJ¦œRÆ80 «,¤sHÃŒë“!ÿ˜Á…¥÷^¼8Ç`H]zìŽKñ`Ýwå~çÄ›àIµ$nɃÞñóêg1éÐh©ž¥=œ¤¸.l·@¯ª·¹ªùͺ@_¢!žBp¦|›ÐhCÌÆ(«‡a‰ŒÞX7S–yu»¾ÚmØ2øÍ–l·‹V‰vêU*oï%Òõ)½·cÇ"Ÿº‘ <ªi ²ã$Æ= X“Éeï;°½_²U[c.2…)—À—´FbëÚÒFŽì…š]}ö m´°73ëLšãd›5?Á RŸÈm_¤g­°¤i¸ºb4çѵr±¥èñŠ#žË?ÔžúeÃþ3…°q.ÉÝKUŽwSºg#'ý—*)Ãá¾ß§ vRŠ½¤B:¸”•, gÔøÒKÈ@;¥ýø׿þ¥Ÿšµ]lØÖ†GD![r·ƒß|ûCÁá¬/WÅrF <ÇM­R&`®-Na´è¾æh´P¼X*¶RÍ¿iÛ§„f´ÔŸÓgr)ÛˆIºïú†‰²A´ ˆ ÈÉÓŒ{‰ ¢ÖȲÄÆén(PžÜ‘&ÔÁu7üÕ1Ñ|74aÛe«Ûo¸+ÿ3ÈÏŸõ`ärªlØ¡bÈh©"’#ð¬I¹Ù3[=tjÆG5‹hyù4 é2»%ÝJlí—(¿>Z„ÁR6˜òÜÚý¤ä<Þ¡C³›UmÝh©ÙórN3%:åÒ.?K ÆaÍŒ±Ž.¥ÂR”•S’ Rl§ƒ?¥qΪãœñ8§Þ8%"03õ‚ƒ”wKþxø`‹ŸBø=äŽ*A72°¹Ú°¯XÚø-϶Ÿö8VG8.Xân%<oòchàVC)r_žÜ–Faô_šWi²¬6Éœû‰\G¡Kôü ,w+Ï<A‘ãùnÀhNÿ ØøæÕmÀ;ÚX×RÙËS®%ÕÊ®ÍÜç‡toÿúœÙ;Ý8Ó $ž–¸ reês(¢aê¡ B&Š»¤ £_ É€‚¡±¦†ì–å5¿t/)ƒÃº{ó#ÆâGhǦ˜àÀý>MÅFAt¸ 3˜¸®ñjÔ–$x9—”a ÆÿAýYÞ3Æ© šÓ1Ok4ë'¨r¸Þ÷àG~A5”ŸxW•‘Kk&ðVzS^ ýLÌXKcÎÕ5¨2S0ý¨ŒÒ¬Sy‡ÅÿŒè×hï ”ï*°±ö?£~®Äãö)^)¶à,yä6Ïå"O¹° oìBUÖL€C4•w­æ=ÿ–ûÇ:¢JKqË¥›li.tØ3'îYóÇŒÎý„ÎYßRÇ ªrˆõK>4L”g?kÙ$÷[Úâäñ5e‚.ÓRA… ÍÏ>/IÑß}& OÏXñÓs*F"¢F:Áy·–|ÄH:.Þ *€5Ðq¿$X¾,ãçö&±)“ÈGÇ;äÆ~Ή/ÉæUR5=µ” \Žvö”5\—´gÔÎU¤âz°–?ËÙ£X­Á:µaB}bæj©€+K ™7¸ý[Báß1mÉáŠxæû,UøXÊN:{&´8DµÍI"3%Ém¡lìã O±}Ž¬8-ب×ýbc°‡ÂG9Èt)†M‡ ³ï\’"I)vŠbñ`/…kvyb ®Åš¸àîS4e£ëÁz. &‘Ï|@s}КˆiŸZ{“ ì6¤srþÊ/Eþº.ø0ÑG$ >\4õ!£›q¿PÂüµ`©| ká[šxJ"ø´²>‡ÊÁ0¤ùb\4F"®â‹&H8IsLhkúO±»w!î´xr!º%DΠ~ßà¿i¯4vÃÀtôb±$L£ôý €ÁÇszÓ„+^iŒõÞ¥þoM4œÊXàŸßÔ,ŸÔµpç˜Jà2 ßMà&…6r8Q)µÑ d¢å6ÁN y8 åH!vÿ{âÕ¤±·  j5Â½Ñ M/±Œ AÀ˜EüÔœl\WWcÝ­>zƒþ¯ú·Ãg€¥Àëjˆ’ `Õódس¦2ü+c—ËÝbqI /ÁÁ`P&Á(¬î °lmÁ¹Š—ÄÁ|ö9M¥›Ù÷g|à œ€U`šmU¯åYBš¬‚ˆ…V«§u|@MžxJC¥;bykZ9•:8ÁÎ^dZòH ±r©‹G{Bð»0F›&Ddà€Þ®Ï + ¨áWWÓ‹ÏÑÕ®'‹ñ7ŠÀQeÎ| |DÐç[Ž›ÕÇ+ÝÄÀHå Uè.>7t- r¬¤x¹sPóˆØ—o ÿ]Œ¹¢-[á&9—ÆÝÀFuCEÁŽ¸ISoG·o¶¼™ ŽU¼Ò;ÄÝíË*¦p¬¸ÈV Ktí(b¨Y‰°õ‰jùÕ¿ÌB“ìö’Ú?³/‘?ç÷-JG$ñ€{Ý+SMÉæ.’MñÚ]ºËÍ¥Ê[¼‹Vö ×Qi?cË^1Ê®Ê-ËéóÞ5 Ü: ýêªX^HLå'\#JˆÇ$oQ—õ™q¾Ã3Ô F²vj˜)f£çâ­pøñ’›·«[—²}Y»×³à誑&UˆeX1É1@éÍ‚M$9ñòÝxÄ0!è \ ÃÈÒŒqeºZLþë*‘ö÷̺´”Ȳ,é%HhüA‚V÷œ„‚æ|ÊãO@3œ½~b战2³Ëº½C¢\7ÀªßóÊÑg…yÝã•s&¼)ó¬åmhAN’ |¦ " ea‚Uåa5²~Fõh=í°¦F \!Öâò˜>ÃM¯ZCkp¶p#u3ŽÔ•åìWOŽWÀIÜ+¸ ú˜ê$i Ñ»T|ªÛ¥<(p»uú){Ê7µ›œÆ â¦È;NV6$p˜}n‰£ºSÛj ’š;Qb r ®Æ‘;÷œÏ›¶ž1ûÜzŠqµ¾ÇþÖë ž•Ñ¯N|\š\ëÛ|¶Bßî?[|}bu¤Twãë—¤™Ë©·”Ìž­”Ó)mé†\ìÆ“&ÝXïåŽy™åO%ÀmÐç¨ÐÔ­9%æ»YÙ8d Š8Qçö[*å˜SMR>ΑqC,«Ä™õQÆ6\ŠSRá½á›K‰™÷þÍ|WêÒ8ö•ôЬ£Ï†áoØ"]}t‹@yoÙêÀ¶?à²nI–­{ÃûßmóÍÞ&HRý‚ßpo§øUJ•sЗîDÒ‘#͹¹¬›à9YV¹hâÌo¤üu9p¼©ù⟚U5èÎõ¯ÙMñ>¨ŠT é­¼mì?þeÙ›ÌÂÝ®‹›Ñº €q˜Ø.œòOÍN)òKŸ^UWŸÏª‘_håûÜsÇ6`m@ÿs¾:^®¥Á"ûž68Ë‘ZF .ÀQÊ-ÆDE€ù†_½ÍyË^ÿÍ–!.žÎ”iêó 58Áš\ŽÙ©ú¤?FöiXÉÅBA °ír•3‘ä¤RM™îɸ‚üø‚D«Ô°´‰ƒßî6P‘n8¦‚±õxL«fáÞ’†«W,‘׊ãkB—»wï®MU LlC걧1“L×5Ý~€>˜²9ôŽÙFÊQVhþý´ÕM(5×Æ‹¡KiHôC "‡y£`Cš˜sÍ?ò5•ãØaœ öråY©F'7ŒÛ XÇ'uJPoLù^sOÀó 2®Ð*h,™Qx îú…¹âll«&þ­ìÆñâLwdf㌉‘+ŸØ”],šÏÞ¢… ï}PX"“:/§wß$k-ÿR×qÉ•h ñoÒ^K]„5{¸Mðdý›4 a7Á>EQ2.é`n¦ÈÉ )Vü)~oW7Þè ;꣟ÓçoL$u)÷s‹åÎô­, ˜d\ÌSÉaÂfN´:Ò“ț3¹ºY–Ëf‚Rbs¼u]¨‡w¬«©u-Á™)”:66ÓM…1˜s˜ˆ  BwÙ©‚1KV;jÍM‘Ÿ¤®K£+‘Ï8i#o~¶ä+½1R ½T§²¦g§”¯Œš¹=šœŸ’OÃÌ/I°¢ƒãVKÅÝ̯‰*Ã"e>ÊÞTÏßGâZt´©‘}-'vŸ‹–õÚŠØÕ® ¢db"F–¤çÍÝ-Ï´žl$JšU¼ñ}µEë šô»ÃOÅç%²(C_"aQ’ýS¼Ã"k Xî¿ñþŽ´×Ç­]ÁÞÖåº7.¤þ”4ìfm Í(Tô+®ŽHc᪕½®’˱v°AöìUk Õ'e+®)UìÄͲK$¡\)©Íˆ|œJÀZ©!ÒÑRƒÊRÀeàp²:ŽS«#¹–ôĤFÉe’û^½[¶%°ˆï}€\„V áHš'@8ùÓ9P+±7!Â4_ipscŠ8³Ô”?áN¨”y ÀÇŒ Ä5GÀ &ª„ þ’o7cºTƒ¿^SÕ±)°jcu™MÍÆîeKõ‰ŸKYXR•4’Bh—GC‚3%Á0ÚLê#MGÅš‚v¡”ÏŠ‹ePÐj“®Ç¥‰%ÆŒê¤ØEÀ5¾™Î~°×ÒB3du²Œº S¦9_6uÓllÑ*ª“‚ˆt‰WÂí#d}ÆýŸ’‹‚Ìš|v¿’|â<ßr¼’Ks‹”¢¬L=‰4÷T3Ôi1ÞHB#;óEnô!Ä}S}–†-q/•ƒµ&jº’hÁÅ[ëeš•¸OxÎ,úë§3Ë’ç†[o8† «fph<Íæÿ(ª¶¤³YÃF³'ŒX(Õ^ QÈüÆBBÖk'9®.ªL Ô9˜çR~Ô5‰“@° s +º7d¼]¼E3Š½%ðf dÎÜä2íò±Ë­<ˆ•`¬>Ÿ±73p­;¾Ò¬&®ªÍa!]¬š"V®t¢™ÿù«g_òÄ7¦Pž»JŽÔÏÂr¼Æ–TvLñàü 3Šû*4@Hý£›§‰³LìÇ«:ÀÁëb«cs2é+MéºòÑÖ¤ÇxaÖÚ²GÒѸ?òTÖÁ‚:^@ºäñt%ªÉlв!®Í‘úv#º(ÈMer3óˆ¶øà¢$8®7›QÍV,u©²ôâ æ.Æwîà/¯‹|1á*:—” W«JM±>¢Šs»rÝ‚Ò ×£bAö-¨Â„±ª°YrÞ`(‰½ f4Ù-'#ÙJä¥h]]»5qñ#ª¸[¸G¬yIý$?/ß$ñÞöÅ—NuÊlˆˆãªn=uíY*f~X+öä. h˜Yõaõîol ν¢³n/䜕QlŸN19"&aŽ”ÂgÚ2I¹áÕã 0è×aU„O¥¬¬Pžf8æt>ZØ£ pv©Ö<6™I,+¹ŽBÿž^v[óà->F•[ç¯×bç3ÑzÑ᪠[ît0çX<ÆŸûö¹‘nÂÝÊ»€nj/ sªuº¯±Ö¶Õµ›ÍÎÖMäi ¡\Ò Dß,) YBÁ–&n“%’wÎI;PV*ÝœƒyÃ¥èyUÃÛPX¨Å²©ÓO¨.(e5Q2 ŸÅ¥H+_'ƒ·n¡£áj*lÍL\äœËqLÌ0Ó²é›)!œ˜Æf¥•ç_6ëhH$Ã8®{F—‹8¹„%Q ò{ §Ì©—óô¶R#Ý!¥U‚Ó~K"Rkuëõʤšbþ'¨%$Ý:î1!Ì-ë}óêÛbùŠoLêe|÷§9îlÌY›³Ê)ÅNÜ9%˜#'å:f-‰•ÌÉü»zeoB“¡>Ï#££ÝñüçŒô’Â@ÅAôø(×­¾rÅâÌa‹hQÀʬËS&?Uæ:-¹o³pr3KsClAxŸâÄpŒ„ÁðÛNÃ)Ë™<1.ÖQ%[› ›ãWŽþ”›ÌY¦ÐV(I)æʧÂÊ LàÑhŽ®”%ß;ç.L(+`B~mg¬ÁŠ¾ 2⡹Ã1cTÓýw|u2'Œ­¨z¨ÓÀÖ^Pº`”,…TZNƒ›šª£öè%jô©º£Åj¶\U¤œÇ±öë`+]fJ¦B$!6F²Í`JÐÄKÅ1AÅ'¬Õb{ƒ8í$¼~ùâK2=Û»Z†ú¬ð–ò˜LúÞK§àI ïBµPäˆ'uµ°j m‹ÁLŠý¥KTñÌ—/7|R7ªL”Fœµõ–ÞnuŠ›A½Ââs@F«æƒxÃæîʉBWJãËÝ’dgäËø(œ»u}¦9Y6©ŒAHa²=¡SÇH.w•?ƒ¬xäs¯¤Ò5têd"|7oZ['Çb‚™³Q–öã⹦¥¨7£‚j0x!:sö˜rÞ§ÊMÅûÀB {ñ@•cEójÙÔ‹«JWØ/Z3s¸÷Æ*ç.o×úkõª¤Öåî}¤K“›I)œ©ç½àgÆÚB·ºb†î:ãRÿÃËîáfvºÀĈdÇP|\Ÿ‹ r­P©W P«ïº¯¾t9KÒÃBØ(‰P¹‘±‘k…ûPɽ©Hë–oJ"˜ì_ò;Xa¥í±uK”Q,˜±Bçëùj×[  1jƒ-”33œ‘i„Q—*º—Ë‚ŒXýYšëYS{H0îãŽ/QF.ÃYÅOZTUî p®v";ä~ë´çÑ‚ i‚K|ÑÑ,×*è[(ŠŒöVº·±=$ëã¬Éº_.iÒWÖ(5ö^,ùÿ²Qâòó2—çVûtõ)¼¸‡;¨z3š²úïˆÊM¶;¾U‚Ê4Í ÂäB3¨< ŽZ òvÉJnL1¥V’yéÒÊŽ¹ÔM.=üùݨ#CíöY}\ÃjøŒN#Á,“êêŒ6˜˜¤×µÇ}nå€ÂýPx³®h̦ؓ¨k8Ô…sÑ0Ño³5*r  ˆÉédW¬áNRœ±dÎHÓ&ìÑ2ô1xÅ)RØß×!¹¦°Ïž“H+þŸ-FŒ…uìä†pSkZŠ™X0M§ƒÔhV(•9ŸÓ(ùš Ò¹ÈƱҫGßîÖœ/ÅfÊ)â`S?eû†˜1,¥*F° g—[å‹3Ýšdâ3¢@r7æ’8ãbg.‡N a¹©« µ¤¦ÀS‰ö“ºŸöxùÂDØ!÷*ŽWý͵£'ü1Ƶþ$·{v;T.ûçg.< /9–(7e-° ^ ý*[-' jëmX‰—µã^³ #˜Vz ^~æŒ rìû¿$%Ö)*¥·Þ¸Mfî]í3§D4Wiy D·k•Ñ=%N5TDÜàŠÜ½èàeù–:Mj:s#kR¸aæ® _wÚf6àÂxÅg²WxÛz~kO.s‡€çƦLb}%¦-ýàME,Ëq8£ÛKäš  D\Ç‹·7«õíܽAñ E#:¨›åš™gÄ!o¯“‰W—”.1±å9a³ˆ« ^J6Ø.çû£zO‰j›œ*ËáÕZâóšøÄæ\t$Ä0tÉç´ÜÝ\£C/ˆÚJ™a&ŸP¾€pŒb\3&fln¡`=`Œ†1ÁA^ 4C‚»d¡~®'«)Єb—ù‚¢~O§ ŽKȯ3G]=K<-g™BE'ÃPhäÌ)+5 bU¶ÓÉ2ã}Ûpá‹£sK«,Šé–9–ËŒÃßÐ;ÈLzÄi\Ì“ôj³‹è9œòE®³™•/­tk†‹L»-5çÛ —,¥ß!„ {u¬ŒUÓcU¬ę̂ÈÒ•ä†'@ã·€¦y y¨^$a™©“>7UǦTôô·\uá£Û ãè@½üoŠŽqGd¬V#ºA}!f§Rþ‘Â3ñšUÐüÇŽ¦ZŠ›aôv1 mPÅ6Ξ Ý+#½ÏA;©¯øß’›/—ÌìJ²¿ËÎl4ˆ’§K5ÙíIªN­`ÍàâÍ+r+ VnP”WºÖ^bÄ5ô®Z¿EƒàešÂÜ ¥ðuwØØQn-k’Â*ç*#w*³[“ VäÀÑ6&ã™P­™ÒLfîL¦v&SÔ“ÀEáê”|×Àš'«ŸI)ÐÌå}%‘%÷¨Ô®‰¢JÙBÈ¥’€ÝR`h¯ÑS½F× Mm.‡q&”Ìw³šìôA±á»ÆH¼vn¦ÂcLqs»Zƒ†§ZògáÉ㆞ÿ}ëBëО,J·/ÊÆL 4€Z`²e=Cï¢Ò<ßêt=ÔhA[šÏóѤ5è4ú) ~DŽÞ¤—6¨þ»ƒuG¨ãX-žXÕè¨Ûx<±ÐÓ°Y4OZ3c·Ö ßðÏI+¯Àß_ÑìɇõG¤– ¹çŽ_Jð"¸Ÿ`zIŠÚ\Þ™dxKÀ"³ÿLí7úÃëê¸<ã|‰¼¾“¨¤Ó£…Ô Ý?üý%y¸þCw|9o®G2Ñ©¤‹ºœZç)ÃÐ#ø Ø(`¨ÂÂzxåø^ç ,Á•¤©4žÀÒêÓ  ° 4m~‚}‚ G«7´<Á¸f6ÂPx“ .Ò`ÐÁ9©Ç¡ Ø£TÚîúIW87ð„5°J)¹Tû q=Ñ ‡ÛŒï£ '> ,Ñ>§wS«^ïïWß}¢¡ËÛiÒã·§ŒBΫb؇j%¶Ão…u’V(#C9fVI§¦¾(h¸²çñãýá˯~@ôH5ºúø‹—o# @ÅÏ# –øÄõóÏ0„bN!¸©°ù8´ÖÕ… wð‹ãTÑØA¢cÒ#Ãè'Þ¶´QßO¼Ñ(4Œ†èô7Œ‚n½GäÚ? Ïn‘Эö0ŽŒ®—ß?Žò1*9à›ŸŒˆÞ4H¦C!‹Òˆ©¯ÕÒ ð‚ k‡ÀôÙã3¸·ÁY)•‘GHîî'Õ}ÊÒ#üÛ³o¿ùÓ_pË·«[ÚôV0KƒÐ²##ù’ùÉdØ+ŠPÏ# žK÷äù6«¬O0Œ¼ÓÀcçhèh¦•õ“„ÙÍx´Eÿ)J½n·£²>Ú°é¤]ÉJûI Rex‚v:ì7„•î´;²m±?IÌA{HI«ä´Ä H üNŠFN)2ÛüäÛo>·³~—IáJA©T°ØýÛ¿}r vu=–ß@®wŸ×j"ú“?ÀGÇú Íè¼äD«ë]Ú¾6àâŠ`@I¬ŸPl$A˜ÃW-\n¤ãŸ¤@+™+Ìd½Ô^Bå\5Y|‚ðT6?ùó_}û6U肱Y¿M6q#Œ¤»¡œ2$‡ L3.DõŒ]ÄÖ®ê;×.г£Ìµ·së!§Ÿµ¥5¸„,óµVf_Y?¯lLíÍ9.M{ Àüûu>+–ZEÓx˜ÿ}±x5ˆõÿoAÖø÷ÝúM£«9¥þá­æ™Ã¤ñïë×Eãß7Zs¦÷´ÚôGóåŠ.ºÚ¸^ï®óñ«Ëüv£þgã?7ycõzÙ˜T–HÃÙ®£_VŤ1^-§ ýùFuñï ~霉À‹ÛÐûÜXM§º?-p/“>ݲ?måAï%ÝBÒo6¦ZÝ66ãÑRïf®Ú—mln¯w9L‡p~µ@:½þå ×ík²¼pÐo/ ‡¿Ab Ðp£Æj™7,t´Öç‹|Ý€õ™ô±K¤q³[4H9oLò©†ôÍV5³®]¿UðÜl9i˜­†þo]¼Q?"¤v£ÏÁÿ?©6(ae;-ô˜L—e5Ïßp·Z‹ý¿ª€þÔ¸}ʯ.‚û8ÀµáÛô„MXÁ½'pýŒI£ŸêKTÁ½7p‘4"¸..’F÷A; Pµœ ôùa/ûL•4mø²C¡ßívûØÁŸÃFp+¸étϹ°¹þúû~ ö™iáXâ´]Rr‡ˆŸz?=æ:D}¯uxË¡ÇŽU™ìCFwpíœí>k÷°±}P¤Qm'0q„d†]lÑk©¿‡‚ÛàðÒpÙÄI&[íO¾ß¥uʱ}„¤!Ÿ»?& K‡H£¼ä¼'_À‡m±¼s4ŽåLÖ2‰»Œ­úì™vŸi«Ãc» Њ4ü?ÖI !K$‡H£íHŽ0iX!í.=ü\±/»,s?WÒ—ö°ú§2 ÿ/þ–Û¿(÷áê¨ö§ü¤]ù±2û#õõ#ôʇ^@Y†øO—'^! lþt —O îĤ1ö¤Êq¤aÕª:Òp·ÜÝ%å£X+ª8S÷g÷á†ûXñ²h \ÇŽ§JwÎèÜžM²®kù®êcyúûÆjßõDäþe~4\>1¸““†¯VCö̱Ÿ4ª ®|j©ßÖ*¯픲ýY wdŸSU>ëSVÝ´ªóèŽÁÚðbTŸ©Å–Ä&®ö¿æ®ê£áò‰ÁÔŸ€8ª¤ÚpÃHýýpÿT->ÂU0 ¢ú©?’òh™4ãKhÔåŽÌèöO/ÿiÜÇBÕn'cú¢¹OË}"¡Ÿ³†»ûÔÿ™ i”ÁÕmr;ZúôÀá ~<áî”Ûþ±ùŸùŸ{2­ÊÌC+Ywˆ¨Ôqc{T\>1¸£Iããmè«ž4ˆªõç§ñ±»rûqÜÝ“|²ïÜ{󆋔xqüúH£,TÎkt¸é´Ÿ…¿|ô­{€þ¾ˆ}¦"5ö·Ó͸,çÏ{?ö‚«ÓfÎct¸Ú¦ ¯‹ÄG<#o#¸. ÎFžœêKTÁ½7p‘4"¸®úÕëú¤qžâKLÁ½/p½n$.‚ |EÒˆà"¸àW$.‚ ~EÒˆà"¸àW$.‚ ~EÒˆà"¸àW$.‚ ~EÒˆà"¸à×ñ¤Q¾¢Oî1Dˆû©Y] Î}° ô ëƒ'».÷ÚÞúŽ·œftÇ-ñ±_Ê_¥C“94õ÷F‡>)ÍøX@ÕOïMÇÍúNØr¢ÉÝû%:®t’ÑÕÒ8nMý½“F•ÅËÕù»Àìwÿ©#ÀÕ©ú¿:nB;uïɆW+4N%S‘?ÛÿïÔM–~> [êv7®~‰ÃcÜÿ¥üÞÃÈphÕ¼­_›»ÑÞÃI£¼'wÀ–òî¡P…I#¼cÞÞ_BÝi²‡G&ßUE‡_±-üÎH#R…>ö®ÛÅÐ×Òp'W¿Ÿ¥ÉÖ½þ˜¤Zð:­~ïŸõoߘÊ»‡Žq’ɇç*4±ý,%ÌVŽ®:Õú­ÿkI#4ªÃ_I£~ÕBÛT!ДŽû:Ôð÷ål Ïë^¤»ßCc*÷Ž¤qh|'”ÎèêpÓš¾º²ðû»' ·÷C_*Êw$ð”Žû:B˜ña@'" »ûÏ~?_Ò€ïwT¨BàÝ…y?¤q,qMá±–GXCw“dôuÖg ûÜíÝ€Õ ¾·…êF òG¡§îi¡ªÛ’#ªê*…¿‚ªã'WF¡³" Ÿk‰-î+.°êjç?\7&¿³{ø5„P8Ù2€êB ¸ÐÇþÔB€Ê›sÇɆV×p…j?J„¿öø5Ê}×­¡ÛmÅBB’ã¾¢7<‚ ÕaÒyŒîàîF‘4"¸º¯Œ4î*3"iDpu_iÜ0"iDp\ÍW$.‚ ~EÒˆà"¸àW$.‚ ~EÒˆà"¸àW$.‚ ~EÒˆà"¸àW•4à“‡©Ó€‰à"¸÷ Î!sbÁ½p†4ÎR°EpÜ{I#‚‹à‚à"iDp4¸“\=ݤqÒÛqîòD—íHÇqÐq[÷H“Ý×ÍùÝ{äŽöÎà‰4zÝ3 ĉÀÝ}ö-á•}G¤±EÏ4üÑžŒ4—ï.rà ŽÜ!»ôU;D;ˆ»€<Øu;V§rßðèêVV¾î¶zwœì¡=/ ¨<Ú“)T]$ é8’Æ&û°×4Ò~»ö|»û¿HÒq$Löa¯?"i¤=Môß]¿GÒŽ#i<`²{ý1I£Ÿu4it®AttWúŸ–Y‡~£¿x?õå™ÓFµFÆž¬>ÚH©×Qð (@ƒ¤ªÈq÷¯;ÆþÕ»C  ¼¢G* O¿~9‹4Ž/B^_¢¨ßC”gé!ôPub2Áÿ]Ò9iZ¾;’Æáj÷Þ ø|H£¾Ã_/iÔUÈ9î @µÛý®"t§$йùáÀçðï±H#T#¨¦_½Ôð÷Å~ÆuÁüÊÿóÙ‘¤áNÆÖsòK|•܃HÃïI#´¤uEšŽ »€ó?­.€:b_g5¤á>à«S]_Âs0å6YÕ¹›¿‘L€tà‰Ç! [å7žá1R£Œß\ìnDQþüHÒOfÿ§"hµ¯?OëVÔ#»«ý¯öƒ8´Vw *Õ‡†>kÀ–€8àkÐ&Êéõé/ãö ™_{Ö(‘†ÿ°}ìÐY#,”ÿ ôU U{HÃÎ;! wQB Uµ‡» [ùÍ;‚Û÷W&}UóßIjÜ4€ýÒè\[ɲô-ø L§ô|Þ럖4üŸB¸u'ÒØ/5 ¸ÐÊ¿×ýb©áÏëR£ºv{H#´À ýàê—Ã!zÕÕñ1àÞ¤QE%}ÃûÊÊQžDrÐú¯‰†| Nh¡:ŒM*ôHýFúx^ýÔØG0îÿ'W¨œ|¸Bå~v„ôÒ8®~9 i° ¬n´w’ûÖ—°\ÑÁ[HêU@$!„4ˆ€èû{;kÚÈ#¥Fùwù?ž5ŽW?º½¤! ­Õ‘*\Lu} ó•Q‘ú€Ðƒ6AHj<ÞY£:Š…Êþt •'5Ê/ÈÃ'‘vzuûU~G÷N,TUT #[y“îÎ]hâêˆPgaµÇ¯QULu}I”*øÙý…HU«öi¥Æq_Ñî~ý*¼áõ˜»o´5àŽ&_ŽBeOD½¾Ok{ ·ÏFÒŽ#i<`²åÊ¢ån£=!i ÚƒD‘4$B$+è@Î’#!i?ѱìõG /$*àc8ü­‘¾OÄb‰Hƒ>íõIjDÒˆ¤q’É>ìõG# ÂuDA²-T I ݯ•,5àSx¶;|8i[¼¾öÖº;È•’ŽÕé n™ÑܺӬÝþ‰…º9¿JOîhï ®ž4Ï•H‚î-Tš8 †è/AŸ‰Ü@â©|iœpïòÔ¤qpÞèö“ÆÉÖnÿÄqíNÎíÉHJ †qþÉq»sÝÎ)ZJˆžz¨Buׯó’âÜÇ N*-5Fí¼&ÛöÞF‡u” ‘4"¸Æ-¶J²5Hj ™h¡ú0‚ûXÁI¬¹7ÜÍËHûûIZ$îãGY~ÐÔa2ˆ¤ÁýzÀEÒˆà"¸àW$.‚ ~EÒˆà"¸àW$.‚ ~EÒˆà"¸àW$.‚ ~EÒˆà"¸à×{½Dà½Ì8‚‹àŽúŠ¤ÁEpÁ/ÿ€¸ààè"iDp48I#‚‹àÞ ¸H\gHãt)Óg>ã.‚;ü¥õ³H\WýŠ¤ÁEpÁ¯H\ürIã!e"ü¯ó+cÁEpwI#‚‹àª_yâ“Æ ¶.‚{÷àÀÅI#‚‹à*_UÒ€Oþ¥N&‚‹àÞ+8‡4Îuˆ\÷>ÀÅ@‘.‚ ‚‹¤ÁEpAp‘4"¸.®DÓ4u \÷¾ÀEÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H÷jíRSôŸüáD£³ðOîTíW.’ƽš « ®’NF. ‡=¯µûPÀEÒ¸W+#­’ODe0Ç­{â¼ÖîCIã^­–4NÓT•“Fýçµv ¸HjiØÃÿsù³òëU*¨! ÌÿÉ?û<Údeà"i<¨•H#tDá³ý»û¿…±‡4ê(mŸÊužkwîà"i<¨AwùIÞ‹¤qà"i<¨=˜4BzP$³IãAí$R£ 4’Æ€‹¤ñ ö(¤qÀBIãÝ€‹¤ñ ö˜¤Qç׈¤ñnÀEÒxP{i”?-®íÛ¥æ?·§IãÞÍEOU>Z‡.{2Êø]]ÝŸËàÜOi²¿Bp‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁöPÒ¨æõWŠlœ¦EpÜ»÷p©"Ž“‘ZÁ½[pï4îw Ź.`÷±‚;i¸5Äö ±®VÒ¡v® Á}¬àNAÕÂcfˆuɪWPø¯vs® Á}¬àNCå2zVp§% ù‡è~Pý©îª Ào纀ÜÇ îT¤ábÅ!GÕîæ\0‚ûXÁŽ4Êźï 5|±¤qwàNO‚Û÷ }Äq® Á}¬àNI>fß™4ößÈr® Á}¬àNK.fïµP…I&Z¨"¸ówšªò'fˆUÉÿÝÕÁ|}¬ÜÎu#¸\Œ¼à"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁÛÃH£Ý®¯uP;D·¾­9ÔÉ^på1„FUþ]êõnMI/''Í–•x¸Pe£€óÛ1àÚíÐÆG÷v&¤á—õ¼Óï²O.yªŽ¡üIµŽ:3¸S¬L¶¾ðÀ½Wäó·¦Bïyt¡v*Ò¨Ní¤á.ç¤Q^ûSõ uŠp„ÿëCÛIICï¬ ä¡Í€»ïëåO{íîÛN-5J|¹¬åøº˜\àW¨R.z—+_•öGzZ¹øšWH©êf¥Råzs‡A•ÿâC•{ •´s§W¯rñÚÙ‡¹üBy¤þ¨ULyu Ë[EoÒ¨Žî>íŒHÃÅ÷»ª~tüwnÿW‡sÿZ•ÿ„*¿Pq—±ªû¼XðÁàü {Rã˜%· %ôý(páÑø,ÈÛÙ2(OãØvF¤QýÍF×­ÿî3ŒÒ(³£:¼¶@«ctH#¼}õßË31જø.ßÝa¨‡š–Ú^\>wkHãÐøBØí㿳³§"Œƒ4èÇ*yì'ðiÔ¡¼òaR1£+¬úJéªâè$l¾¤P=œ[Ku“ßßÁÑB¨ª«…€{R#¤…Ý­}¤q÷í¬[ÊiÔ¡{™÷¸Ï–YYT¨Mþ¤Mˆ4Ì)’~)ïàÝۙƾCœrÿèŠ^9~•? o«4Gìú½¶V÷‰ýL~(þïîwÏB’°¢P¹=Ö²)ƒUõ€ª/‡ºñWR¹ëQý¹ºäþO~Žª\XG5BSW¶¿Ð†Üµ iìk÷â¾9ÁŒƒ¤qšvnàJ¤ñPp~û•€;#ÒØÏ*N4cÍŸ®¸òJž×è>pgC‡¤è¹.`÷±‚;Òˆà"¸óI#‚‹à‚íá¤á›'JÈc~êA1m'÷(F‚ðäK^—c^Ù×jF¶Y¹í$ñgG÷ÞÁBj„mÑwâ#‘Æ#¼Nîi„þ|"Ò8vDeGE$£[x¥Žâ]ü;G͸ÎÃtOpÇ· ¸ã0è¤qh½ê> i”?¤qd«:lè{À V~qŸ+ËÏàê*;³üO]ו_ ×÷kÕªü2ÒªSÑU3Ë#)*è£+áÐz…¦ï9$ýUMhŸÃÍ#C[Qþ|_û˜I£¼Rô½&ØÁÕ%ü¬qÁî{4Ôž§‚¼ÇŒã(påéí{Uþ¹ïUÖî¸õª›~e²wYÅrç÷ Ú×>fÒ°ßÝÿ÷D‘û¯V÷Íç7I£L–UðUd8‚4Ê#®“&8ºýýÛOü‘ÔutÒ L¶ú؉HÃ\žê¯™4êñ§E¾ïåýûr€4¤‹êË’.ØúQÊÿÊ14½úNÞÔ¸˜ò[Á­p;^^0¸c|Çà+òÖÑæ«Ì³ürˆ[Wøò!&¿o4÷ :Ä< \xâáWCï=i”{<i„§r<‰|œ¤QvETø±êãòWW,ûœ··úPh !õʾiR!PöÑðÔÂÏ8ÈZ ò.…0‰šr_9f½B`lÇÊýµüýT;¦Ÿ[±o絓4öµ;ù™î î¾í£u“Øæ°ùS€³íWî“Æ} ã0’Ư \Œ¡:²í'ê÷=ºjsÕ™ó݇.’FÁ[$.‚ ¶÷Fw=uì·”o²†œ÷©ÍŸ³=ó£’cŽ;ÎUíÂ}·æPzpÝ>i¼3pa×ĹŒîüÀI¸¾=únÍ÷Þ¦ÌH î¾Æ­“FØÃaÛcáòý-zApÇ´º.K"²ê>ºO7iTZÔ‚Õ Ë¾7÷¥ºgég'ܳêYòöÇæwbFWßSø3šå9¨ºIÔÅT~Wùýú“¨wVV½t .üJh}«ë/A%*¦,Aêþ?¯l¯aObhªLyφ4ªš¼§ÍWçš×1ß+ÕŠÂcØÿ¹'5î>*ð^pwËÁÑÝm¬Õ7T=2ÝuÜýÈó%J»RXlsÛ‘F™ºå4ìCáÍÞ÷l…4ÊËqoÒ*ÜûI£ÌÄ«kT߉W‹¼~ŠþX«8â _èw\ô¯¾ öJ sëÃýIí›f=…'}V¤þý$!rAÒ ö“Àá.ö£î{iL­Œ|vµ£ÛOaðÕ7*‘žåɸü÷ðÆÔœ5Ê×wzÒ¨{¹ üŒH#¼"©áÿy?ƒ(ƒ‚ï¡P…FîýΤQåpU`õ=’4Âc­¾Q‘¸U6³o¤{I#LßþçáÅ¿)5ªS mÍ‘ Û€|¯Ãåö÷7wþÕg\©ePîßì%ä«öTß{°ÛTÝ$«´o¢¼vU¬ð§R44yzÅ>f¿×MÛJ­_£¼ÈÕÉW7lZ-Ž,ˆ_}É}¦<*igDáv"§šm¸ªìx¸}-‚»O‹¤ñ¾ÀEÒ8spC,ÅO1@i纀Ò‚®¾Ep÷iŽ7<‚‹àÞ)¸H\l§ökØvöÑ£û^9 À·³Üë¬î•Ñr?wîþvttUÈÿ¼âòóG뿾ߢX;÷O÷igCõ툭{å¸]q7üžgºÏÕ1zïè\Ìu¯z:ä“#Á…͸~Ò¨ºEîÚ>&Ò8n Η4îmŽ{4Ò(3ݹ.e[Y˜4ìÿw$úÿR£úò]Û™FHVÒoÓruÿñ²¿Ë]4Ÿ§Ègµ±­öóúÑ”ŸœVo5¯Ó#Ê/º“·Ï«ðëû/ë~çlq'Mõ otåµ q‚ªôð‰Ä!ú‘„hͧ¶òÈê¶aªkgBõsÞy»ïµ²<·ß÷ĶÞå»ü_3ººI…ö¤Ý¶X¶g²áþ÷0ÒCëV~Þýïd}*òÿ곇4î²vv­üî¤xùác¦] î¾íT¤Qe©H£ÌQÊ¿¹Ì-He®¶¯«*ÿSá×ýI…ÿzʉ;©bEÌ¡™Ü4\õWîΤáÅïÜýü¤Q]Û‚¸lWÄ]òèBíÌHƒ~òWb/i¸/Ô‘†ÿÙžØÖc¤ \…_ß07—Ï¿þcö·f—O Êõšø Â Êz›%!>†?,–ÃoçŠ|ç îÃô†ƒ7ûŸ9×ýˆàÎÜÇJî¾SÛ“§ú:5¸G\»îÈö!’ÆÃcGÏw?"¸³÷!’FÁ½p‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶HÜÇΩIððv Ò"þ?U÷‡ûýS§æÔV<×Ñ÷Úåè¨i„ÛùòήçIÀ®Ep÷kHi§v*©Qm绀\wD‹RãtàN×"¸ûµ³–ŽÎW.e~×æƒU§ÃchfÛ^»¹Ø·Î["¸û¶SK ï8D¿œ§ƒ4,)Üg¤nåÅsÝÞ_¸3–.Û½7iøÏp$5B}×Üiöã!ã=_äû;­Ô¨! —¿ÚïþïD¹&.«,òÐÃ˳ñèÊ4íŽ04¶ò8=påWìÀï=ºÓµ_ ¸³•þÿ%©qÌ÷˜’Ô8•ŽV+5Žg€4¢íÝC[wŸvJ©á²ûÇ#S”õ¬•ûFX®Þqà¢Ô8A»§Ô¨{GÕ½|’Ñ=´Ep÷i§“eì~<©Q~á>í^R£ü¤ýK$³w–R£|! :"ü»`ì]õdÿQ¼ÎþúÐy{ Xî+<¶jÇŽ‘ <=ûóƒG÷ðÁݧEoøéÀ®Ep÷kg)5ªí|0‚‹àŽhQjœÜéZw¿¥FÁ=>¸(5Nît-‚»_;;©n绀\wD‹¤Á}<àÎNjˆ%ßÿ§êþp¿17<ŽîÀ?jgEáv¾¼Å€³ëyp§kÜýRÚ©€E UÁ[”§wºÁݯµÔØ«ó=k?ü¨©»5ûæžÄÀ«O(ú]GUmç‹Ëç îQsÃOÙOjÈïG nߡÁHà j¼ë¨ÊíØŠÓ´3–®­@…¨õP{¼ýð‡·æLöä¤q×Q…ž£ÏΗÏÜ#æ†Ó/~“ÇÊ¡é‡ÛãK ÷ç2Ï®ãá%©áO*Íú¹<UíÅé¿Z^a¿ã_Q½“³•þÿª¼ó>TÑr{R£~„uc®œ5BÈ~ø»o™’ƾï‡Vù|qùœÁ½ƒÜðê¦ÝG…y÷RÃçÊöÓÐóª l—q¹*Œ’Fy„Õ¿ü*IãC’᪜îp{—gS÷Ÿ,¿qÒ¨ëØ“ÇŒ*Üe¨‹óÅås÷rÃÏW¡ªòaù©îó*»gpÇꎾ0ªþdFW=ÝOeÀçŠ|'w–RÃÕ4Œú]þÈ%ëu‰ºöný2RúÙÿÜ»wÖ(O¹º6¡gªšf_Õ]çv¾¸|Îà¢7ütàN×<Â=!¸Ó´ów–R£ÚÎw?0p'h²g.JÓ;]‹àî×¢Ôˆà"¸Ç¥ÆéÀ®Ep÷kg'5Âí|0‚‹àŽh‘4"¸ÜÙI k¿wÿ©º?Üï_Ì £;ðÚY‘F¸/o1àìzžÜéZw¿†”v*`ÑBÁEpÁ¥ÆéÀ®Ep÷kg)5ª¡Hwâ¡XÜ ¸‡9‰½ÈÛ‡ú›O¥älo]ðÕ]G|¾¸|ÎàNy+»vç!îß츓†òýÑû'ÛZ=/.¸Ì2üÏiçŠ|'w–R£ºwïƒ4î‰-•Ó‡Üjî¾iŒ6îÂË{ïÉ>¼ýJÀ=ªÔŸ»|°¬"ø‘Üšõ±ØÇ1Õ òêÿÄK °þØì¸ÊŸûcvÀ•Gç«SîçÇ´sE¾“ƒ;[©Q:k¸éƒÿJè™ÐwUFŸúïUF[m©qÌ÷ºÉ«pß÷ìFU^øì¤~z{&ûðö+wj©a÷KùL<ôØ]°©–4 õÐIµVe }/€ËÅ“iÇ‘CU?r÷Žá¡‰š^`²§kç îl¥†û[—Ëß5ïÀæa¨w–uí€Ô“Œü-¾´½þŸë)j_;_\>gp‘nØ|Hº;i˜Ááaµ‘á1…X|˜áû†~ܘÝç”ý%,lî"3ÎùNî,¥†ÏyˆÕÝŸªm{ͲRÆÅéòÏ>ðP« _u‡ÙϽɖÇSžd`@?+\—v¾¸|Îà>oxEe9E{7Þðã¼£ÀÝ·ýjÀ¥Ô¨¶€4\$Ü 5‚ ÕCÛ»Š¡º›)é ¸ûµ_ ¸_›Ôˆà"¸÷îƒîHî]‚;;©n绀\wD‹¤Á}<àÎNj¸ž3ûOÕýá~ÿbnxÝÔΊ4Âí|y‹g×ó$àN×"¸û5¤´S‹ª.‚ ¶(5Nît-‚»_;[©aCà·C¼«'ìÝ‚»k+«‹¿Bþç{À…ªŸ®Û‰’U7Âr”ý솲•ßSþÊqouãªkçJi§Œ¼µ‹zÔOŒË÷÷©á£‡*ÿ©î•º¿AÇ·ÜI‘ºÄ`ÿw_,ÿÝý­³ãRÖÝWõã—.ï(òÐkǶwMi‡:ó™ªrÿT7–ò …ÿ¶gtÇ‘†ÿS[Âr+D¡§öƾÉ×·]jT×Cù¬Ê2}^cöŸ0BHX’«+øàÊ€Ê *¸|_©Ñöš·o5ê>«N•5 ýSô?Û×I # áö!ÒpÖnŸÔxÇ\ª<³"0«ä†û¿íÿ^~^Ýåeÿ{øƒðD¤Q?bµÿÏáïõyÖ(cvXfI£ÊÒŽo¿Z©Qݼ®žœ4ª]ûìõ¤Æ H£*,C”¡u»i쾿}ìR£Êºî%5|ü} ÔpAÈÏ'‘U>y”…ª¼B 5ÂMîOu¤|ΤqRph¡º;iÔ3³{H ù-ÔõãZ¨êI£:ºG j'É–¼*["jÿõÓ¯k¿Ô(‹cs /o}:RVÕû´ ½\þ~5$’“UÕ+%þ ù‹â.†S¨(<Åò eâðŸ+9"Ê# mÄ^Òh;­¼°áW÷µ_j”Û=†XÏ°¢7ü,À±>pÌCÇ·_ƒÔðÛ@ÜÛ¹“ÆIÁ•Ô ç«oQjܯäËw_Ó(5Ø"¸îÝ‚;3©ñnÁE©ñ‘‹RãÌÁÕk…Ö¨Sýüàè°…*dĪ‚ [®|à1òöÁí\gì€{¿Æ>¿@ÈHzúd‘·æÜ"…òhBÖàU6FÞÞi@ÕöÆý›Ë'kÀíCÿG% ÷'Ǥ&Ô §¤áƒ;¶×ÎÚ¥Æ=ZÛk\ù¡ý¿ ûWëA;iäm%•Éñ_:DØ'5Þ£Ë/J÷ îÒ8$ì'¡ï'Œ¼EpUwuXÁÚniø2ô½‘ÆIÁE©qv4ÂþäA¤Q¢v[ð¬Âäý~PjìE]‹Rãí¼Àí=kÔaF9뾟,òöàY£:ÞzÖþ¤qRpQjܳÀBõH¤ávBß÷Z¨ê^ýÍLÖÿóÙF”g Î(a¥ÜýÝ~n?9aäíÁ³FThòOÖW'ËE©q¨ëŒp‘p§kç .x° ?t|‹Rã-‚;pçN'¥ÆéÀ®/¸ƒ|ùîk¥Æ[Á½[pQjœÜéZw¿¥Æ™ƒ«šlÊ©Z;ýONyK?«²1i¿Q©l§*^qâTÍn®ýªnœ{'{ÿvV¤nç:cÜ{ökø«Œ.Ôçqãòÿ7“u1µjÌ­þ\v^Hã×ðâˆRãí¼À•Íþçyëa‹ÅÓ*&»8" ÷ó£Ií®×ÎÚ¥Æ=ZÛkœÿÈáOÊÚ*;'¼­HðHª?»‚Çý_U_Ú'5­s”lçîi„ÏuŸ„¾Ÿ0òÖ;kÔŸƒîuÖ¨' _¦¾3Ò8)¸(5îÑŽ¡£vø‰‘Föú”4 C„[wƸ³Ô¨•Û¢Ôx`;/p'9k<‚ÔØ{Öp?܇½¡³†ûÿù’ÆIÁE©qÏæsës¼­!*qœˆ4Âg‹(5üöÆ#«W³}Qã㱋ѧ®y[Yu! -üs…4|õÒ]]„½k÷ðvV¤nç:cÜC¤FÜéÚî˜<ôL”lÜ9‚;3Ò8)¸(5Nîtíwh ¯q”l\÷nÁE©q:p§kÜýZ”¸ÐšXÎÀù%k Â&§MÖv¢Ü_ÊÖ¨²Ýª:¢òç•Ìõ*ˆºi‡ÆyV¤n.?Š_CþX}¡þoÁÑÙ×|CmT°ûó Ö΂·vU¬öÊeOGÕRËVöO;Üù™‘ƯPj”ØHãR£üªÿ{ðÉIÃþTqHú–ñ¸:bÿó=¤áRÄogEáv^¸w_©Ñöšgÿ\¯P…~¯ åJ„Ãh?%z‘·þBŸ‡ÀúàÍÚ…{ “FX *¯J¨Ïò'᧢ÔxßàîI¾æcˆÿ]¹¿„9³¯Ðù¿Y`ÔÔþÞªß븴ê1ür™îªo–Î! 3ºS´(5îÑö’F¦á¾\~®B¾@©‚¨þT–Òp·û@ùsÛíÒ‰ÁxÿïUQ¥ªUû ª>¥ÆûWæÛªþOösÿ§¤á¾~U~ª#ûsùöÉ®*Øòß¼³F°heá1U?¯!CÓ®‚7àNÓ¢Ô¸gó±ÿãm²]þŽÈWeìÕWå÷ò_ý0# KŒ}Z& ûyÉBæîØüOìS,qëÄÝþi—Ÿv&{š¥Æ〠3üêAþ÷q\U_võ_0U—Ÿ©Ê?W "LÚ\y4á©×wèþ\s ?4íºqži„ۀˑp§j•k”Ú*¦eÿÿðŽ÷Ðv”»4ÜBë¬H#J³ v vgÒØœçKAp÷mQjœÜ)š£®¯zD(áàÖàŽÛ˜Òwf¤¥F÷‚‹RãtàN×"¸ûµ(5"¸îñÁE©q:p§kÜýZ”\÷øà¢Ô8¸Óµî~-J.‚{|pQjœÜéZw¿¥FÁ=>¸(5Nît-‚»_‹R#‚‹à\”§wºÁݯE©ÁEp.JÓ;]‹àî×¢Ôˆà"¸Ç¥ÆéÀ®Ep÷kg'5Âí|0‚‹àŽh‘4"¸ÜYI ©FQý§öýñîÿÔ)ÅÑ}¬£;#Ò¨oçË["¸îˆI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-’FÁ[$.‚ ¶H\l‘4"¸.Ø"iDp\°EÒˆà"¸`‹¤ÁEpÁI#‚‹à‚-L§øR§ÁEpï \$.‚ ‚‹¤ÁEpAp†4ò¤×=Í—: .‚{àÒ8Õ—:¨.‚{?à\Ò8_ÁÁEpï\$.‚ ~…Hã$‚ílgÁ}Œà¬PUA>iôºg¹€ÜÇ î¤Â×:Ò·ë¾ÚmpÚßüe?AKÁY.àÑà>"+ËÇ®Ž4î(a õ¤1¨ùòIc–­¾Æ†<"i|èÈwÎ຺!v^÷u:Ò”÷¿ôÒ Âr´8Úi óã¾Ô±Fp>x¤ú³FÍ|ÐÞ·Û¡OëH#[9!mìH úF›‰ƒž‰¤ñ!#ßyƒ;‚4ÚyàŸ’4¬ÜpIÃÊ ‘#m>Øß"i|ÈÈwÞàŽ’eâ€ß4ʇp‘Ói$ ùÎÜQ¤AÄàÆ㓆{§6ð¯¤~E…êÃG¾ów$i qI<i´Û.iaXûÉŠ#3"i|èÈwÞàî P‘]êq*‘ UuÊõrä˜hÏ$ iíß|¸‹4‚»Ë×ÒxÇðÃî>—|,}¤ñaa˯ ÜAÒŠ4ìÉù°I#‚ûÀÀÎ>À!Y&‡F$î]ƒ#œ}tÒ8£GpÜûI#‚‹àÒpÔœF?;Ý—:%°.‚{oà4i´OÚ"¸îc§6óÕëÛÑ,Wùr¢þçÿüj9ùr5ÞÝäË­jü»þls›‹Ñ¢‘ôz7ͯ‹Ùn·ÒvãºÙ}ÚÊRýÿ‹9ðçß}Ûš5×ùf·ØnZóæjÚšªæVÿ}ÖÌߌnnykÚÜŒ×ÅíöI«ÐO.'ù:Ÿè×;íFÚMÚ·ÍëÖ²ù¶õª9Ү׫ÖR5_oòõeë¶Á ;¿ñσ´×áp(ãÕ~ûºXŽ¶«uk¦¾^4^­~nÍ_¯šÅFc¤°Ì_럦«õþOqïݶÖÍզث¥þôõ¼kHs™J‡í¡Ùd½ºÝ´Ò¾îhÔš54ðoG×ùâëb±Í×­—ÐÇõ^{Õ7·+=A˜z£øÂ}h 3„þòÖ„§«v{»(Æ£ ^‹á0Uo›<=FýÀr¥ÁéY5¯ÚI¡Ít£­žÑxµÜè=Ûà'¹žÐbt ð—-•&Ý´‘µû]=\¨ÿn;sßÎõÂLi9æÔ•¼½(–3ý™þ{®šÅb±Ûl×£­Þ¯‚‡=ÁîpÄYÒè¶ë|´ÕØ£ÿ¼m¥]uÀZýn<ÚŽ«Ùrõ¹ÞJ½  ¦X¶r„15‚Ó-Ó¦ÍÎS˜C2ldY;i¼PÒrÕêÎáöΚËÝÍ5bÒ¼yÕœäù­~ñª¹éá«æ'¦çO®ZW-o§Óh+ÝÓz£Ñ1íhp0”‰°)X¾Èq2‹{Ö„ÊzÆ°‹Öå¦ð^±†Å\ÝÞ¬6[öõ&:˜µie€=zÖSžµ^¯üIë%ü¶¤å|ËýÌ›³â½Œúó™j‚ê^k´ÌÍþlžpG=¤œÑRSRWÃYŽ‹·ŒSe­€;T,Ç«5ŽvVhjº€íÇÍ\)oV7²Ý½a¦»œåËœP"Ë`ùôÒ\¶ºðã3F×L+»ñGK kDþYs“çKêaÊlb’Ãàˆ TÖï÷t'K¢Ê1!'>Xðs¾ý~Z•È~ ðæ‚@zí²ËV'eiâñ‹©&ï]=yšÙ  Ä>je=um—j oN‰“¬`¼‚„¯‹í\w:rÉ—}æ¼BËÓë@Ï,ëÒnG[ýüRf=ì¤z7£-² lêh6*–µ^Z/G@íyóŸfÃ̇sÂå é”Éç×i§À ümFJÙœî–c\kdZäL¿Äz tœ¤“´Î¿n]ô€¬a“oVkÄP{ì9-¡ý¦¸^äHȦd­K]oôª´•ˆd2dZÿùÍÏHš¡}ž-v9p`¨¯õ?ÄÑó’)Û®f9Œ÷‰þüvT¬™ÙvÒ~GÓ)=ï¯Ë†˜ø[½Ô·Z­›“Ý8¿l!?êtMÞ2Æl¨—ãéSd@Ìí/>w僖h°†~ª:Ý6ÐëÅçôVÍ `H×üN£Ódê¸w®š£'׆өN¿ß†µ¼m¦—ÝÖØÿ³Å,¿^43É€0#XÀ I„©¿Ì2l§Ä.ÿN;Ÿü^@±]`5Z•À(šüC^¥±’X(‘ùq³·Ù‘¼%‚Í”Õeµ°{Õü¥µÐPŠÕ9²™IáLc¾ZL4Ñw¥†¤h´E $ßêÇq®ò"B·ÝÜÖè;ñ˜/ò'æ'E³wI”ÐMºG›*~ÌÉ`54ÏEmÙ Á‰2± F IÍj¹&ø7ÅM±A±ªº©üäõt·Ð<Š™rÂÒ⢠Ì^ìf3ÒÌ |KMB@)Ÿ Ó¤Ñí zOÓx¾ºÕêß÷Z|Úè7úªßл¼ºm\ÀT/ôú'CÍñ;_´&¨ç>hŒ£¾Y›9!QI‡‚÷TÒa*žŠ´a}¥™âž7çKû°=¿Ç?ÀsŠžÓä­ÿ6çw´&–¦Ànš£Íf¥Q@k¥[½ôÛ·ÔUšv¨«åJ³§·©ÖغØö3%ú¡ÞñÙôø{½ø›Vs±—ÿÖ«¶Ðå‚Õ'þ T‹2pŽÏÚ ®W|èb¢µk¸^IMçŸv£õdCýu»=Ý@¼@ S ÌA·]‚‰ï÷ô0‚ï&Œ¢‘ÐX¢ú=èÈð§¤Ý­.†ê§)¿*ŸãŽåòk¡·™·vj6V2ó–CcŽ¯)f¬ÿÏiݹӪïpØ €vy#®ÌV˜‡ô;Z:„p‹“»Y¼m ûI¹oÜnèxfaPÇz•:{F ºÍÚíºn“4mW÷mµÛtê‘Šƒåæ™B¿ÖÕcI²vfDXh,­ u’ xÆýá{¦?ì]C a[Òé CÁ€fÎÊËG€ú¤ÛMí8ÝeÃÇ^êÇzÝLíC’¤—uïÖõœºî'%l©¼;·HFÃQ0ìv§vóí¤<”2Ò e1tŽÄŠ-T¬ô Òv—eü÷ :µ.š¨VRÇ(ˆG&Yæí÷gŸã9 ôýãÌåÆS‹ûø'\JøFŸÁCµ¼¸‘¦IO•˜1Ñì2ë/à–Û?ùèFìGÔCÚTŸËÌØWeà´ãy±˜¬sÞª4â¯Ã@@iÖ·/›ç‰;®ˆ5ÒË(#øÎŒzÆŸµJxŸ^évÛìbüî³Òb(3^ü/FãÐb¨´—ùV¿nçSYiù¼ñ©´Ÿ"^áŠàh·õó2—!¦Í´?ì—˜4“Ÿz¸€°÷ ‡tØË”ÛÁR÷¼×ãa0 QÞ¨UªÎÚ^ý$¸#åõä?8wW²¾#•%é°VW"²Ó’¡³©3CžD¬FW‚ë…[–&iýÚ±Zæ÷TƒsähØï^1š¥Ãîžž¬ü.c˜³K"ôi§zÝÚ¾2=ÒÚ’¾”ÛYU!vË›ì T¶¬K¦£Ûæ—Å:Ç6r[<Á¬Š1ãhÖKû%-â_ŸÿËúyN ü{8©’„Ïç8yó ¡¨ÚÃq³~’”™"½\ÒPñÏü êþ–)9ϳº¬®ýA±ö¸G£%Tôû‚ÊI·Ï¯ce¼¯5­BW Ø:íëÇ?äãÝzcö»“¤L˜3ã*'¥)ãan },à4=Œ,òtÒöP•€ád=&J\ù0ÕI‡iyd†ß„7±Ÿtõb]«½£ËúÝ2@¶rj¬A‘ÍL”þžàÊ:Éoµ>€gàÅè5ª .Ì”^ÕïŠÍ˜{éÉ *_ܸ±}³ÅCý4e\€‡ðSE‹œuX­#µàQÏ«¼/'(nXI8±œÖÜÀÎߌúô âò¦˜LZÛæ"—†¬:‡D7À3º…/›;8€ß‚•4’N·Ñm“þ±2Îàý½§hÍs,+) ¡gY™—NìàÒ ã^¢õvi\ô†jDFù—Ž}à’L;^±©+GëÄú ½‹­¦ÇNö›m6ÍçòÅít·óú L¬2GÓ·`~Øyk¼ÐÌDÌž¨èAŽ]ó…jžXó;fÍ•þ,ËÁÚ€VFúø:¢s=34¾ £Z,Ø̽f@v~1üäf8؈ž¶R}®Ri e‰ž=¸wžµ<ù™ë“‚ˆ%Ëö¢yÛÊagæ#±dkô¼]¯p ×[vµÓ„'êd¸«æhaLOkß RÏzZ¨¾“KoQ^WÀý8þ‰ Ò+ùà§Ö­ë)ÎF“˜³S;¶5€š<¬š8 ØŽÝiL˳˜Ò,æô´Ì¢¯ª³˜9³0“èv†î$FhûÇN³^4³yÉ1c¡ùtôŠLbSr{àPÇl&kÛŒOØM/=»Øæ7"“É Å¢†EH¼Ý>A×DÜ…sÚÌk ŸáŒ·<‹~b-Ù«õñ±@‹ñßÉò•&C&ÆíyÓÕN÷œ£×@¹3BL [ë9˜¯Á#y»Î5ÊÐŒˆGKGÇ,ði^ï¶à-áÐécðsmÐÜZæcÍGëbÁù!ðb8YUÒ–l¬hjo&ú릴SŽ?§d…Ó{9^íä3ãÔ1½Îš» nÒZ÷éÏ£ îµæ%3M‹b&SæíH|ó|‰Ò8M1I»íÚï^}¨ÇŸ~ª' beü)èŨjéßžÀcøGý¨!ðëOdM²aF,·Êÿ^Ò¯Z¢êÕ›²Sý‰ÿØh*^°!VãÖ¼˜ib½ \)d)h©Ò¶VI’NßXDDü÷dÖóS5fÍ›Ñ-ó’N,Câ ¸Ìã8XQ),`ÏÑ!^ÂDvô$]ô4‘¹àQ¢MâÖ´ý²9-ƻꚷ&¼LÚå«æ •¥é AÐ`_ø8À’Ç5(ŽÒ}ýL[âOhãÑ53Gwäf#x];W°GD¥¢hü÷©0ÄŸÐGÀ†ò¤ŸZç³"4fÛ`rNÒ¤È$ŸçÀCd\C@E ¢9u»Y±' SŠ”bš yO41f Á G à?¹f«Âz@`‚KÓøô{ ¬nGëm ¾ÖD:fÝt­ù¢éÜSÀNÀ„¡Æ-’ Ñ°Nçô”kÒ*PñI"ç>AÞÒ¬v[ÏE4»#o€^Ú±aŸU4^¿”ˆ¸)˜{!"!ëèè˜ìF `º$CFȬæY›Dræ0ÿÑb‘/8ü¡ÝÖÀKÄ›š&(šqS{Ä›àÔÆî̹Ëþxï ä]O0°K øŒ qUï1ðRthãRº iYß"7oïr ` µ«@—È ˆRoÞvΫòºèLAï­·#ŽXÀà‹¬ rz^ÕµÀ¼=çì­ö\Qvk§• 0-Ñ-Ã2Ž» †„#¢X ȧx}Q›xB{­W ·Zd'>ƒô+ò‹ÌU}ˆ$1‘9²Îœóª‡µ|èí—"ÇE¢”`•b«7èut++Ý.Ð8BiMÝþèô%¹3·ì 4áü¸^äO ÆÀ*‘B× «L‰ÐÄÜKõ2 u‡²ðˆF2‘ášsÖ™(MºË‘¯j¬e°úßžb¨ƒ~ ´]r®•ËÙ9N¦@M⺑s™ÑÝ8Æ‘œO·ð8Cïëé -²}LG?ˆ`½çB#ô¶œ£l`nпþEì—|nz)= P¢ƒf°4$—f´1"& >Ìëðá „P‡ÎæÈÈ®M°RÃO®õ¾¾Ô3MÈáÏ"/·Ìõ•»ÓÀj¬Ð–ëg篵Òøé%íí3Ìhw3F±+râR–(0uâ®k´º!¹WžL;—uC¹p¶‘A £mh ÀÆ iZk:q4ÄÐÜSè Еy’i0Ó:’ðJ8®­)cîž’3þLxñ”xœ^Êb‰1ÎZ¢#F2pÎÓS4ß'ìkžðù_Þ|Bl}ܤ‘à^¢ Q®(CféP͘V(t5[y Ÿo)@ щc[ÌF€BüÒb <ŽÀˆeÎúiág¸O7pð9n“Þš®“ÿºYxêzÖë±m.k @¿h]iÊÛþDè¢{Λ_¾øX ª_˜£¶‰B>]&3s€N—c!ô±7t:)GJÆÔ]1 Í+&›†Ì £+ñl}A1%€>Dç×|¶Ã°*°!PÀNÖ¥È:¡^˜ hM8ŸÍÜõ•Ë›ÑúÕîVPß„ñBðÑŽy¯¦Åq6è[nrÀ+&z«áÁ±æ.¬>39É!0§Ýk¢ä|+Æ'Ø\ýÞM>Z¢¬3$ÕIÛ¨2f¬A¨NŠî¯ªJ?†é,™Cá.  8V¹‹¨Ç¥D¿ÅE×ò¸XŒP¬¼´b¶“õ€ʨ€sÃnðI•‚Ïë7ÁqÂg´$õ±_³þ á ‡7ÉÈ× {(T¥¡fŽö‘1õY CDÁà@ p´Ñ»‹ét0ç;-0&<ÚmòÒJàQ0ü2Z°²"Â?å©u3ˆ één¶ëÕr†G ¥("šûÁ nrÒ—Þ"ÀÑaÂØœñ.™ò ˜ëô€»–åvz ðAØ•»bx`­G7zÉ`ä´~¥½Éýs÷S:êÅGk$ŸæÑä™KœQoHÑw3¤ 7ºMü-ó _'Ìa4‚SÈ0©,/ËÁ8–túèm·ëBK%=´YÑ<ò™0®ŽBöš_úsÀG:`â,/YÑE=uºZ ö Ðc8¢Ðaˆ¡ÕÇP€¡a…ÏÖ@©>¬HlI¸¿¬ŸÂòk0»ñ##egˆžFØÏ`*¨¬& õ©ÙCc'’'Qaôî›àën[´À¯@i¢'Ô…ÃÁ¨ñõK}Õd=TÝö¹cÁÁA•èj¦WìaªQQðr·‘Éæ.Õ-Hš\ŒÖ3³äS6¡è, ké&zËÒîÿYäŦ “”ÓíIZw‚dÜPš8—#-È( ³~)8jÐ(½Np”îÞFGÑG=X­¢ÿá–OhRþ…†ýûO“Ëö§øœCi€+ýî7_þõ‹ÿûû¯PI¾Þæòü?ñÕwúƒOð“ËÉvò‰ôVÕkã{_}ûÕw_ýå…óÞÀI§†#,Ä5C@þX04ãÓhšÿáI«›€aµƒJ®–~ð zM˜ôUëßð)­¸ÀoõÐAg^Xˆ)}¥ÉN“¼f2ùí;Ÿ‹OÆWA£Ñãúßñå³ÏxÚŒvŸ£Á–lt1þ×yPù“ÑÃþê»ï_üïÏ[ÝF)¿ûͳ/¾ýæù‹ò¼ApÀ¿°ýûÿøæ»ï¿ýæ«/[ÃN¿ÑGcÈíb„êoùø îÀeѸX‘þzÕúƒ~5lfÚAÍÝ6Û·m:ûá«ÿõŸßü`z¢‘ÁíM:Ð/á¼q黤 v§÷I`%»›ë¥–‹fbS;÷~7i$ ðAÛÿ gˆòcŸ·G(uÊ[l°¦<¨,ͼ¹§š’­í;ÙPÓNÁ ˆcu×^–£¥ð©nvˆ"ýƒáS=<‡’v„XýÅ—àH…uøö{6=~W,‹/‹Íã ÍJàë}<]®µþ>Òžð†{R¥G|NÜ-·ë·fçeœI†íN‰Z A!Öhœ{›¯5Í!ÎÐ2}UzŸÒBk<Ç5NÛývÃÇ/óDƒÃ Í°Ì:¯X³j Aˆ(_c¶Ùô¼‚‡išõÊt\€üxÕúÿá8¼&–FÉàqä<²¸(+ÏÏŽ¼§…nÚÁ`à1ØÊ·e‡‡TÚÅH^­Ñ’Þ›FÚë&¥½A¦†RHx"MN,V‹u-åÿêŒVÿ 3/h3úY§Dì ¬9Úmç+‹´II?ÄÑ¡»©å‰ºa»¼áöA¥%ÙòU=CÑoÊŒW¦áv£4ão÷z¥~œ'ËÝø“Ét.ýô¹V¨2ˆËèúîRP‚úOépùléy50Ò6ˆÛdî ñ·Æå›$Qó¿¾û–ü¬%Esâhbp@…fº)ˆ‹ÑæÓòù@+u©q¨^HHòQßÞ÷šÍ·3Ð¥¦”ðÀvp{„˜"Gdš+QÙI[Ðp·ÜÕY.Å–ÀßÀ¥BÇ@ö:>B39²n8GÆ‚³éD©ZajÙ†ÓÛ´vÅgCdá£V2p!WÎU9Øõ_*°Kßî¶`ú·ú!ëç{_C€~ñ’E~-¸6y¤d¹œ•Ñë=çSp®Wkd˜rFSSÐ"ý€«å„ͽx>cMn<û Ê<‚/N1|„UtjórÂ:èÌ÷ IY#·âÌKã…t…L¼5Ömž€`jO`Qí‘…,èäÄqÌ3ä4äVæúJ†\>#”œžlC™Ó2šã`§ãí〢´Á; 8®ýÆò„‚7h‹ôA}]l)u¨´œã¢¾bDeK)áD…­>å·àܲTd,Îð 3(9ß룓À¼t£©tQJ‹Ms“ð¼–Ò©B8"DÂ}]‚î°ð—eæ¦jÀáaš¯/x=”ïä J:ºÇ~JŽ¹¡ MIØ$u™’QŠÔbÊ!»Ôæ’¦ììæ˜4Üì9k ™9»®œuŸJÎO±ëE‘‹ÆÒ/â$^Ÿç€F˜5¿lö/é\‹~£ $7ZÎ’¿{šc6bÝé†~×À×®š ĪÁœ ¦‡Š¿2O}Ë!/ºc­¹ÈAòBŸ»`‰Âs¤^6 Lê2:Fjž"H'E[¼Þþ†L£¿’i±2é‹®€]ÑÇ@Š+SªjJ"-ÙTgîÑ[Ÿlèä‘âY–ú•Å‰ºPÍo¾ü᫯¤¬ù`Ús2a–XŒf‹Õ5ÚܦÍݲøÐÒ-YÞüS#‡þЩñf5Ù-81ãHwâ\dãc×- Nã902|D÷ù{rÅÓÉŽ>œ6_ 25o>£è›ßÞ^c”Çîùó̲”|_È)EŸ9¿eý' ç{£ºÂÓŠN|/Hœ6ÿ‚ú=ðŒ·Ì_oßÞÂJÐ@¦KE?ÏšÏõÚiÞ@ Bg=yÁŒx†±†üK!¯à*ЉÏvá͇¤§Õ@:Ùùœ•fÿžé}ä‘Ó!7>õJCF¯rèèwþ'mŽÒØárg¼ö2ó'Ù ÏáAOΞõdþ/{žÛ˜«h'íì,”ùµÐ;-½Ì\ÞüÖœPyÕùèg—]ž`xæ×Âü謕âó cb鉗¸üá+^•dìÓ•Ãi3ŸV–ˆâKèÜhN¨˜Âô”퉵kEçJg­Ì±“œ”óÁÜþìâ:y~åGp‚ªò±LQ£t°ÐƺÓR|Üä3ížÈK§S&Ÿg z‚&\4¿ÆO‹ø éž]âÄ<ïC¦3¦œ_g¡Õ×?ðZòIbÆ#‰åpÀVpDšVØü.5-ŽY&Âû`?˜7üO°?ñ»tö´{Heìä_ Å?¹[§P»uÞß çeóÑ?yùdŠÇ缺grþtNέ2/™Œ¬BH|’ÆοÍñ'uâiéá›ø3ÿï’!=íî¸.0ØØýä¥ :ÅD˜)6ù¤=÷qÏç`|²äóö,ô¨žÃÿGn¯§\| ±As¤ŸgVN™ž´(Â?þŸŸ$³™Oš¼ÅôG+5¤5‹Õ¾­² £áhO<³|ó#žðÉ ?ùBŽÂZ“7?³srànßÔBb9&¿ÊògúϦèö:U ° ̯¢Ä-P½BüÛÕPåÁSŽÎó¾~93J)úÀŽMX«¬Š„Qs3¼FN„'tfß²“’ ±ÌФÄ䆻LÙ#n8K.5¡O¼ª äñ £—Ôv0˜õ$/FkxP4q*`­ Ô!b3÷@h¹“»Ù`p9d©_0ãŪ90+ÛåFÝ%§œÃФ#Œ5殊&FBœ”×ÛÄï :þêóí,“^ÑäÀN'½lõ~Å2<ž|=¾ÞµË¦™Ëeë‚â´À»(ÔÝÞ„ ›…HÏ]“ØÓVÎwNàe㟠 ÛD1XdÍÑ5»%Ò"‰RÓh H§bùÅž—ó”øtr‘( S…#IIzhuáD6ò‘ò2ÃÏ[JãÒ›æBZF­ðº3'›R='¡kv¯v‡°fù€µÁˆ1ˆ½·û1ó7Ê&Á’z‹ŒÈeyç\R¶F6Té¦×‡µ3œ5A4ëÁäl¼1«îò `{¹_ ¢&€<ô*:…¦Œ©¦ßÃ< (“3ðˆ“á °™<ödÌwäàL(GÞ±[¾Ó¥©P))"v–ŠÕ•C¿-÷ÆÙ#f I ®šWKÚÆz·0‘Šãé=¤-qª•Ù0Ý7Êze‹ v÷Ì÷@‚(*ƒHÛ$mp~X—:‡$` O61 £É¤`:7#kz’!1ä 8ƒÁáÿ¥FÊÉNKòåø-Fi8zýœ' ¿_/MåûôÑR@7’NÂá÷ú¹:«øÔe¬þÆ=-UP‡Ð§7dÀ!ò )E£Å ·'¯L¥¼¾yBƒ-*qÄØt½i,c7 <‚ì¿›¡ÿ"wP|#ÎÞ åsy’Ý$)1Ž‹ zÆ_©—œ”Ór¬çÆZÖ7\;‹(ҖЛ‚ŸxQ#Oé#rcohð®¬Fiá_âúAÂ(Ĺþ'ex¡I•ã[ˆÁ]ÙÍ‚&Pq oùúÎÄí­ «ã ÈYwæO,È™˜â5ŠûÜ"ÃÔ·’òËõ7_¿Ðÿÿ˜ôZÿhþÄÎÆ´=íwØãRlÆ»MOÓ”³¥ž- ÿe6'IÌÕ0í(.®Gõé„"6¤qú}à™<1±gg…íneè Óg.¥;éP<—„ö“@²ŽFÒÃ^½ÅCóuË 4m Ékƒ…+Q% PYñüßPA5}àZb˜6ÅžúÚц ƒV±Óó©}à‰°äA–‰róv‰³·7ˆìhb(¸`*®ê¨5³‰äkÓD;ÌeRzXôtE2ŒhsæÓ&&I¡w¨ 2rØäÊI‹#ýÊ.δ‡dUlн3Ñ:‰Æ®ØÌ!6UfSØÓŸæœ2úF××ëü #$Jk€‡¹  ’“Emôåøë,Î"›!C£oYÆ(“ÓêçÑà oNHEš`‰ew?WÞ\Ž+ ØRÜñ¯œô}ˆs~I¬V²šðü1ÞJh jûtËè7ĸEˆÛä*†Ûäq¤b#‰8 …#µlŠé°6¼v¼Z,8‡“jF[‰Æh÷Ú€ì_ãPjöB#Òü:œ-NÉuu1$Ýë–"ÝoGðQ±6'mê](€|Ùúô¼c‘ò ¬Ç“‰‚^„½¢¢™sw\šA,—²ÊV@hâvÄÈ¡´'î KÍ¥5EÊAÆžS:ÒmLô‡pÙ,k‹ŽŒ‰€z&7›|ÁáxÖ¸ðè{JÌŠòð8µå­[ f9•ŒÝ¿G4Mˆ( )ð0W£/<M#¿œ]R2™}ç”Ïä- ý]L¿ú\¯!W(Çõ% œwoŠEAáâ;”NþeMQ¢ãvæ y)IJN0Ý.Doþe„F퉤@Æ×L8ò%Mò‹‘õ¬åjâ>4—ÂÃƆ5kŒ Ö8ò¹Ôˆ¡ ‰+!TRxÌ~F”ó»Ïþô9'ã">Z‹ žàWú³Ã ¾–I“áH'Ì,ÿfIÜÙÛ£jÞ#®¤rÔ á]œt6+–ÂC¦ÍéÄ닱^ÉÜáº0˜b·¬ *W‹•“J¼p†,›SóÄÚª¦>ô ÝeþžslÕ°|lÎÅ´e1 ­OÈ&!1^~æ7”‰²"݉´}PJѵƒúå‚ùC,$²¯0’‚2>±ïš¨G¬˜0o¶z<Ó žqÖçܨÿÏYf7BgtÜmwÁq"¶T÷(iÔ”&±ÎÇ ,;ਠª&»j’:’Œ:Ì”‘êŒÊ,ûÁ(1¥«{%âP¨e¬ŒåŸI­éôÅ0\â¦ØHFaŽò Z…ƒ‡ŸJᘬÝeoÛÍ}Î <Û½z€g5½~¦7â–,srœ*L=,©I“í?ßJ2"ůóÌZÔÌK‹S¾È¹ÒéôaMhÿ£¢¯¼¢Œå2Ĺ"ƆùöÞRLy¦vèhJHÝ.9~Éj „@JHSȬÑ>åõ­ekíxDÙ¼Ýls..áš¹&R((룕b˼d/¥h{Ø]ÐÅ[3›/j͵#á„6kbm|*”»%æÛéC-Ìæ—ùæÔ@Qr7œFÑ\Rîfb0ÁÝV’ÕÇsž­¬Ñ`]L‡Ù¡5Âá8ñ'œÂƒæÑ-—Ißà!‘¬«¹;ƒ)eQ¥„0  8nâ91‹çX½›òä¤vyü#Þ¼Pœj. ŒÞäT{½éÕ£€ƒÇ¨zŒz®´Ä¢7×ÊÆ„ɨ„Û5Œ2†'tîiM}±›&i—_jkAâV´’;GæÍèU¢l·‰ÑNÐ] &Œœƒó ,Ï£ 5ìÄjµÁÆØ5Žñ©£Äã¥t£%æ̓>=)Šd]˜²5áøTÈ™Z/I-d[.Z‚¥¤ŠÙ’=¡œi)µ6oÝ@¦ˆ¹^HKZ÷O!Í8ÃŒci_)ϾÒkÕÖÜzÑËŒÍFÊ\Ïiõ§H,’øL]§Õf´Ø°…aŠÕ”ÆZÅA:_/i¤c&‰–´ÝL¥bìM&À4xü’Z¬û7þL>”œ!Š6M¼‘ /ˆŽÍ¸ÐÛDµunFà­ä ðN ]òI$fD£«ÏCvfÄì$¾… ›b³#3­ø°Ð\6[plbòøê–ˆ‰#9öQ™zàhLÍSbð°®™êbUlåv2Më¿àÁÞ+\Î!Ítú >ó;rÌYÐoË”{ZˆlTó&çÂ@(èÞľÈ4-ì1ë;ˆ!iŒ§Übúãçlþø泿¶¤üºÍzô93œMBß«ÊÀøJª¸Pˆ³N0d¾W@c"Á$ª&m¨¼ÚìHzøÕ¢ùjí™’<#¼éXY³¥Aßàµ'`£7«ÅŽq&J¶DK-ü%%óÄÅPµBÍ÷ ¬Xß  _x! àe’)ÒŒ+>iØZ/0SõŒ¯æë*¹çŠçQº{‡,#á_pÜâ Û ³À¼$g‰9‚€¦^P3€õÞ d|â ml*û &41þKÑ?ØsZ³•ÓÞx·Øò[Ïèi»ö¦@æoq¤‹âzíœxÐß:ä‘_J4µ|©9ÉŒ Å öÊ颙•kõ”>‡‡*rR3–ù§9™¸9rM‰]Á)ûE€iòS¾g3]ƒ£Q°ÒE7Pô½)RQ%m³Ç¨mGÞ<ÃøªY«ßS%ÄÀE´ˆ* ™}@ÊI­C®D„þvCÀÉUÏÑL‚ WMÈ ©Y€c ÍŠŒè¨¾Å™½dÒÄ)|ƒ5–aL%Y°@#™Ø‚äZ Œeª^´½ c\ãš-Jó„ÝcvW‚~úG(˜…Nð)3Ÿ™IÜ5iC¹¬ÓLåÈGŒGõ…Œcþ©F‚–r…Q½¢DÙ]²Ž<3Kýš2QhIx#ñ>i/¡ ÌX è®V)ëË)¾õOŸ]›%xbœ1â­³Þ¶ÎáÕï?y¶@ôÄT.~1“+|¼Ê;¤UïÖsˆUW–ìä.ô‘Em•oH*´D`ETM$Â(ÅK šâ¤Á™µg®]v_ì6h4žJvÚì,A 1ÙèÛ S´ ñ+€¦þŸS§-Š‚c°~R‡Ô@JõŸä8(´EÍ€`‹ÅˆÅƒ½ïLeIÖ·ªL写‹†¡!PmP CÁ@SÜÏAyñ]’ôàéÂ|4ÃPZ ^‘)nôÝŒvCUN6${qg Ù ¯nmÒŸépÿؑÆ0˜ åà¡ÓÜͅ厴¶¿^놽dœTYgÈ%ü¿åâadDƒ9V\»ÄT‹›Ò숣™ËnœÚ!Æ¥9’øR¶SY©¨,ók‰Ë{5Ý¢å˽©Ç”ÿ’«àqôਠ•pð&õz]Ña7çPã‚mÈ4>¡;EO$›Ï™ .ÛÂ!ðý jž?{Ú¿Ùàä_çZ.¢5ƒ[HGß ICð –>¡c‘¨ S¾¥.oþ‘®èÃ(Zˆ-‡ æ~®Z¾´„ÙP®m‘QåÅbµÇ9×è2)X€®^Í÷&þö81Ò4ÆiÒÃv—ë\¼òw˜¹» ÃÌ«[S¥´àßH&[/S´‡l8jD[’M9›–x*D~]§Ü0þ)q}¯ðóVŠôk#3Ä0´£‘ФY& K´i¡àQR¤ØŠ“ªÛeµ±ó‘ UM)T´/¹ðÕolM=µ×!Ç(CsÈ0¿hĦtä9Êq‰ËgZÐßõ÷•Iíù],ðS¼™«ì¿pëÂ[ù¥%K…žf+é À"°ðçÍÊ¢En8±èÇ\ g²úÐU’‘X¹â=Gìb“`×KÅEãPÀÚ`%¬.<ó} ¢+˜´·äD@œ¸Öë; ®É°“`íýIU8¨_½ÝÞ>ýì³×¯__¾Î.WëÙg/~øìÍÍ‚N÷ îØ€`+_Ú|V¾Quúm9ÄhV0?/mØ+×)®(̪TfXŠ}L 1K Ã@øã_§²Ó»õ&g½Ç˜âÐíkO?ŠŽ?tZ×lP¢™’LnàŠÜx¨AKߺ8Úç2Ðÿõü[¢Š$ßÌÐ.;¯Ô•–˜Š>[;¡j¤02²F¬#×îŠÜÜØZµNÏc²jáSs%C̤´iþf„ˆ4õ¬HX§ –âMkÊìõzW,&dw¡û[K¾X¹rA½õâ¿1w˜£õ^Q-Çn‚Ï•©•CŸ ›ô»düBZ§ƒ/:oI8Ë„/‰ÈQ ã / á3Ý¢;„5Ðùvâãé¦ÌÊZNw\æhÄÕ©Ç 8Aë]ä£õR CR¼%JD é¨ÖjœÀLwËéèÝd-*U·Zk‘$¸â­ñ|£çS•`¾ÜÎ,XŠnQ¼Ê[¼ÍÕ,¯1‹mnFhª ["”»VèH'de#3v:ÀœPö¹ !U¢ È{¤—t›+Áèò‚²¤`mmcŒ§T™XÁ)Ù<«yÈ 3^ãÒb‚éJ`Âõ¢ƒ°³rsq¾Zšp·ñj½ÄÈ ÇpGÁÎtÖål+7ùæBQŽlü©X܈geb- Œ‡\Sím<1ÍNû¹ÉmÕGC®Í8Øå=÷_cD ÖeGÈœhlÇdð i—°IeH9Ü6;’Ìn+'2­Q˜š|ÄqÚÙPª&bâ„<‚–¬?­¹ÕLr*,yá0ä`À­ãxÓÿRrðµÊu6ìåU¦ôhæxÉü°† )³ßƇn!ãœ2ÌMÆyŸï’Å2}~]ÈRøŸuo *Àñ<€^½Ýv%ѧH¨‹Çiª=Ê… Ü tµì’:ô²GFäü„j6bœ÷8ü¯ÏFýWûÇžâM–C™Láµ)!# U €Lm¼²ýv7q/ÌiÁÍQžic&ú9H/ZLñ,+uÇ=§ ìušdTÍl·F„5 ™{®¡ô6ß²+>h 긦Çn/jzÕ2õ/¤š@G;yÆžw)Z¥~/æzi/ à§¸OA­æòxP ÜàAõ‹mÞsíת/[ 0èó'Žê#†«_5€s æAȰ⦋ÝTyn‡iŒK˜šAýœTN?;“­$ð'íô¨ Ø|s®zß²Î^%¾RÈsöÑ;&ñ©Ù)Ù|+k žH½z9uMî‹o${ ˆ°ˆÊÈ´ß8±[£É}€ƒ1‡±øõŸa¹‹-Ç)¯+QÂH³Î/àJã‚01‰-Gc£¨T0©PX8}*k±Yç.W7O*+eÔ+ÌbâeË›Îͤ²c¬\Åc†‡ QŸÚ˜ðû¥«†ŒU>¸ÀÓ€ ­†¢Yc w·¸pz‹„#þ‘Ê`bΈ=OŠïˆ_A‚iR4˜ßØï¯ÕG¥ÆÿØk 6rNKæNÇ}"î ŽUC#9Vœâbìz’v¸±]'ܬbDª‡åßY â7#Nö›bÊ>¾º]Hé ø1ŠY¾Ä0ÌœÅ%g]2„ÃqmÂXŽÑsæ$SrIL½£Êˆõ ª~K–ˆ(,Çz82öîK"oÞM°„Ö³ÉPá…cÈDªëqM‰²E$LkŒ4úú!žô÷T<är&)ÀI0Z”jIÛÒBz'^)ª±Ka·|×Í”Œõ‚΃ãé7Ksû³_ÉǦ¯¹óBÂul.­ë†F¦Fš"ÍeˆG4a p598Kÿcqý1²Ò7+ˆØbĤ“3ª k Õ&w\锎u˜P½{r/[}`q¤à4.€!ÍZ}Z&¯Ï~a(q zB9#Ù+CM2iV¬£Ñ0¦`ÉáH& '¡ˆâ|d‹N›3±’<²-•‹(.VùÉå 7P΋B•\SeãcRŒU6¥‹ø0f’ûÊq3\˜ªÇJn—TÜr2Âg\óµúÌñPK‰¥é`O¾÷ _‰’ó@Qsd{ât$9Ž~­¬¹rÔ.!…‘“›ÖwÂÜ1~mæ…)9ÌæÆеÔẓZ 9w¯×è 2<"âA}ŒH*Ù p?f`$¸jæÿe"¼¦Í碟M›ßŠ¡á%‹ÄYŒkøë` ‰æe)³Ióæß³/.Lø¥¨š¡'5UÜÔ ÍÆeM~x=oS?ÝÕwXÃÇígÄ€…‚T ;Í9oV[­‹™Ö¨l:/ïrbBÙÁš  ×­cd(R!*ÿþ¶ÅQw1 I¤—\ÏÃ~ º ¹ÿ~ˆH+p‰¯ÞQrPâSÛñ%È3Ê3 ƒ&Žšâ^k…®“êQ¤pR>p þ ÿ¥#QiM.¡ˆ‡~—¢JØñåóç?PIý1IÙ‚tU®†#‚(Äyó¹oœ&)üÜá+t 1©7¤ ba¶š¹]ëIWÿðÍó¿¢0‚ìôõD”FHˆGh %–aô(Û*Ùv¥’q¤“Iö¯Ô”­ã`Ϥ´¥íŠŠË cžsˆ@*Dd#OÒPžÿ « Z]埓2Å<­X >—(S#þú—ìú ;=†ÿÒ5MÃx´æh%“½¨º…»È—&áˆh6ša~—„ª_¬™Ñ‰Eá•s¥™õgÌLÁŽ{E7¡œ“Nà¤ñ™²PºCç‹ùD Z§¾uö)ì9%öh™¹É×Æañ×O¿Ý,´®©9s·Ë7_itäx!³!%âÙr‚Zý¬ù—|aXŸ‚væ‘3CkÜ~šÏ‰;½F¯#Á‹™–´I¢LìbècAŽ\¯ƒ»>jˆlZä“J¶% àPI˜÷Ì ÁŒ3&9b ËqŒG·dO(0f…¤þ´i ²1ßMíiz.i#^"ÿ…{ˆ£@Â4qWl‘û~®»½%É߉Ç&pO ž°ÉŠ,J‰1VcÆ ³­iÀMÅQ„m,ÍU8g BN4°c?&]8?±4I†¬Í=³h¶8uS/#°@ðB®^ˆ¾FÜÃÚl”߇F ”š4œ³H8ªHÂ\:À–Aù-ÈïÝP#hþ“˹ S•dt`üqŸ‘+X‚W+'–J€æwkŒqøQó\ÕüÉêH¥ FÄjÅÑU:r«@ÿ<1Lz¨“,°%Vƒ›ýüuZýzDÕR‰[}¹£:¤ÄSrˆE縬”t¸-†°è kë´úOj‘)èíB÷™õ]¨¥„Âhñvƒ×œš;’ê9ä磬¶^MÑËÕ–œ€P§†ðI›Ðddk΂*7g}’ûÃL‘b+¹;žÁCR— ÊåxïM’s¨/ÌdfDœÀ *%^¯Nwƒœ…œ±!–úèÚ¼f{˜C)ªP²³ÈYXŒkIé$M»‘ÓRlÇ}Ñ ü¬¿@Æ»[]ˆ¢c0¢ƒ‘‰éõ(n)HÂDýPÄV .;HJÜ[“n¯……é`pöZnW™ÚÛr(j îTÐ$P¯F¾ùTŠËµ‰rÝ˃9èaf;åP}$‚E¼€Á#oB}ºÄ?4åõg–Ä‹¤É€Îac®å‰õ6z«Ç  Kñ?Ì›J¥’Ê9Éhî/7_ Ä'|Ž¹•x¶~¢9_ñÝJ®‹;…ÚØÈ_ ä¥Ë„Ðaá\y±16™gK ,°Õa[5LÔ²ÉÛ‘ ­Â£9ž”¸ïî}ðdÖ›Ëe3«e.á\r Átd{ú÷U¾Êcs½2–¿›)³=£,ÑÑ ,³JïK’1y³y²Xk…ë÷~¡»³ñŒèRB!û¨R>LU¹ö> /˜Z›-…š7Åf$QcÈÁ%P:År¿ŠµÎ¥@òÜ €¤ö‚áj'ˆ4!'J³¦ò–ðtÄÓÀxfé[rh!ò4Îö™aȤzϘŽŠÅ«ö–,5ž@dÂM±4 ë‡X Ô+ÕÍaÌ"©®)^âèàš.U¶Â\s âÛ0 G³±Æሠ£ldm,(z»C›š%'jj.Ø…Ûh†?KAd~ Ø J‡¥70ˆÂáf¨W{äTê´à2œö‘SÜ’{ÃÌô"Ë4Ò¶¤ù"^€zÒâzbRˆý²3DN퀤«vÚ£¥{KñÅrnÎÂDww@K`öÉ¡rTŸ\BÆG‹K4™;ôÜ‚[ r,è*|I>¯åÑ+,:bðŸðÆŠ¿%vòÙ:¿Àè RG7äPxEWðùÄl«_Ç€nLýúÆ’‰Ô›Ä{Ö–¿x…Â*±npöt 3Õº0î¡B™`¨x4l®ݹ=hûñ¡Ã.\`cBA107ÞÌÉÇ” KbÐÅ"ß’R¶‘øP¾AôqÌœlÓ=ë¶ K㉠ړkùÈÈé7ÏR22Á’vRÜd äèaocñKDH†m¾ˆt&©o䱯pW*NRf¯ëÊÍX÷WˆÏ¹ ÄI $ߦºÄÀÄm‹sÕöÀ$ôƒš!EÄ ·¡s8gæJ‚ƒØã5uwCœ¯¿s\¾´‡Ñõ°O${SŽîýÞ™ :yÅÞ²a в ¡.\"˜À7+ÁÁð²†PB…/]棡C—à‡²Ò ­ã"“è–Øó±7Ï©g`˜[ôâœSåÌÃg!âH(´¹Â$:!ÉÕv°ü1OÅrЂ)crÉ(Õ2‚hB&o788'¤Ü•äΰ†°&O²@É´f²¦ÂäÌ|·š/s¾$áÇ!'{wR”ÚÖ˜½:,=¼¡ÛúLª×Ìé¬dwžÑ½–¹»¶O©{×R¾·ºvèÃW`?&—®¤Þ-ùÈ37²´…q÷`µ¿.¶L5²º&¹‹ÕÍšhð*`RЀô®Š>É—ÎÚÂ;&oÞäãÏD±¡Ú¼æº¿aj¯ûƒ˜ÍnÒIÅl¦³ÙMઠrÌæxs¹Ý]\o.'ùgÇãùg·èöül¦¾Ï¶«åÛËùöpy8TÝ4AóÎK°¸à4C;Ÿ»Y,™á½ºÔ|ûb«Ï”kè‚ –díûìë7·ŸiuX³(±™´Ë!›p홂ïíJÌæ ^dzZbWôê €(Ñ•{d2…½-x ÛÙÚ6_æx¿!êÞìÓåŠjz÷~ž¯ ¨â]£-_*ûÖÜŽë¢Ýo!ì[°#2È!E甩Ě/0z`™¨‘ؼ͵ŠPšL‘ˆd®|ûòs6nJ¼å|Þàt`ŒI'Û»‰´’ôák”Ñøš=K¾¨xs­8`T¬{éù62ÃÑ'`ÅÇÊˤ?¾G´t-û¶z6†*=¸êC®™ê±7s®áa`9œ©G¼s·’ê+Š#o¯pêÔªDõbbÀS“€ÌZQ>á”Т`-MX•‘¸òöz—KAÒ(‡(Q0G0¢Þ†”â/§ºèY˜òX.—Ïø:Ñ©qªR.°ä‚8§ånÕr |^VJ'¨ŠÎPÉY¾Åu¸)‰z·ÁŠªn14sg‹“Vê–?ä“„‡xlhö$SHáˆK ïd/o¼¼_¬€R¼$šôѯÉß»Cý‡ªR—<ÀI’0›g7ØAí™±QJ/"Õ¬zé p§œ­+±ÙdÙt\À-ŠJ现ÙCââ´>ãÂvMVzá…_e =Û5Ý™KP ÃÜ^kE4"Q— b(áÈ––ïÛ¯Á’‹¯ü<•“"«© × ¥YdHÏDLjì2(è„#af­äü [bM˜ ’Ôx]¸%FÐÇa§HÝÃ* ¯ñ7`¸l¾ÙòýÐÑØ*ìH.“µñKý„6K6Ž„™ö†Á‚X2ü³¿¢ò¶Óë’SÈÔŽ<2¤Û–¯ “Hè¼’û!‰ý>–Ã¥•IGuvcr0Âýœƒ´HÞ•`N²Œ„³öðjΖŸ9ƒg/%W„¡5Ç$a=Òa'|!9 hr¾0Ùj1G,™üÈ–M¨ŠkìeÆ™ª^ôÑG(4C:‰ðÀT(N0Cr&´2DÇò’SÑZˆè\v|™hdv˜K =Ïd2aJš £Mñž §9¥ôŒ(@ƒ­è£â¦%QÍt¼³r¤âs’09•K"Émtìô—nnòpY\cè%/祖ÚZãL»j,ËMó·Y/y±}«ùc›2Ј‚ø×äHd L>`Kqññn"i†’W@Ùœ<9É6¦×Û×óNCî®æ«rÉôkqP-<Ø&M~q)ï·1˜µ»¾À“šdýÌEáäø§Êm˜ð´>—!dtqát½[s9/s˜Â¡ArI86³r ×ÆØôjÙ°é¬+8)âÚ‰„ŠÈ° t$éab” ©·€F4âæÐÉÝ`¨îMĘŠêª1ÅÚ",¹ñQ½¤²$$ÕP±™ä`’5‡¬«—“µÑfØû+òã8uYìâƒÉ×Wçp#…TƸÃTl 6I©âukîk£T¶Å…:hÔR0Ò µ\'©¸%ú&ÚÓ™¥í.åä事 92 ¦û\Q‚?¡)ñ ¦ª+C{-ËÉ‘òµQÈÁ4Rty‘æö)GÏUtWUÝ7‰1B§Þ%ŸeRð™B‚ýÊ׃ۖ\¼KL«•št÷è†<=r%â@Ù,K’ÝpÈ0§vCψv¨©•—ÞYØ|8à_ô¤óX¡Â>®8EÅÂp‰Yû¹%|búÞµ]âp7٠ʽÌÍ Bkp`¬&cæK?#­QcM¦0JT©Û©™(ú“¹Wº VëyùrF½ô{t÷3\ˉîV&Äryè2â)æÎ`줅CŽ ¨eyÞÚKÜ|EÅn­qî½%B@ôGV›¡™ÆS/»©ÍmGY`‚¸ý\ÕVB¦0³gÃú K9 FÉ2æb.SqS#òWãk±‚ÑY ³TRsSZ*»k•¢ÝyÑü®zûºX`º_¬ß$³‚í+6sÞA¡: ìÀeAìë A¤‰…èi)0Õ ¯8á>_Vúä²­³ 8ha«^<˜V–ÒýÀãÂí¤Ò›x…ÃßúßÐ…D:swå¹çRš&ÒÁšp2yEÙ N.¤dI%šÂ3·cF®ÊQ’H檂0—΀Oª6Ú)S| t{uËêˬ¤ÍSxpO*I}…åxàx÷–Ò-ƒúØÐɔ٣.I4v¯¤_dÆ[ô]±¥Ì¦—Ì¡˜Pdé…”çkkÜ…S¨ÑçμέÈVèdî̇ƒ €z;x»[…záÚ <üaTú˜¨xÉW%Ðjç óý€èFX$¡U)´ ×ð¬) Dss(PƒÑ¸xÿ¸†3‡êÙ\:+Úpq 0Ð,&R2Ó7œ*†° ÷,SÉÖÑ¥´ž7†âvÈ1’ß8æMëª7§ñ±²s½RK`*Å,]7gÍÏ)Ÿª13f¸-ú¤g¬“5¦0Lcs›ßh­-éYsÁ"Z ãU1Æe[»²¹”H÷@5 Õº)¬–ˆ%¯CQÖ3Á7×ÃÍÒiÊ-œU†'(ÏŠÎW蜇ÎåX²”rO‰wÂ/±“ö5Be×YL*ctõ¿vò5ÎsŠÇ‹½žH/S+ñÁi<Ú°ëâüÌa(žDN{Ê Ù»E¦œàˆ¤ÆÛJ+ªÎsi#¼éýÂPÐ.ŒpÇüib2d×ÿû-®—àÇj]oJ9ÚiÇ’ˆ›îD±%”;ŒÊ9£pFùŠÛÕÅZx/”9ÛÌ8]| #Ê@ƒñ¸¤ Ée"˜÷¶ã›>4èÕìªùt mnGp1v?‘lxN÷¢BõB'憫¦ íŽ¦ÂÚÌ<_påðXä7+ÌüòÌœë‡ÀéNU6pqJ—2n)…i·\‘¹å’2ð1ÄD<é[f ~*3§YÑ?I¥DPÜp^¬‹|+6ÌðXvscÉϳÑúz4Ë?åƒSzìiçØgO9Ên¦Yƒ4ì‰LËî#Ç×±"&y‡è›ç°3ºþ‘Ïo#º?‰¼b¡ˆ:Œo®_¸YnŠ^­„.Ž…LLpaƒØ6Ûi%4{Ú2€«W‰÷ÐItÉ" ûe©g}ÎZƒT°jr¢) |nk¾B4š ÏØÞT!WÅçV)¡‰ÐM´æìGÁNþ­G\¬Ì…k²–T‹$ëWs-n(”ôõˆ”₼P7fq犵ˆÉ>b†*óuJ:a/"%‹kN0Ó#D´è²5À öþFZ‘;Ç •¼]*€WW¡kI.²Vv[qà‰±„qh.ÚXé8"‘'tV¡Ñö0Ï O-xÈ7<’çi’ZrAS.n¤¹âk‚çpŽBÓø$¾ꤟ@P%•˜²ÎWˆcÁG!U Ú‡Hªr]´kÖd1ÁfÎÔoí}S p“Õïcž™!(Ý`R©FvÍÉÑÃ#û?và;@×?ÐÏ”v6b€ymè‚yM¶@}†SïË«HáÖúîbòlã–¾/E¥ ¿¡y {LÁ ŒzóDYÏZüç£Ûsüm·ì¤1…äÜÆÑÏ8´m¯Þ@„¿b¦êxCF‹ô²ó”èT /b.‚!±œ¾h'u?˜s7€ôÔ[Ž®±‡%¼6KXÇÇÜ?T4¤X9.¹¢šõZSK‚Wu£_xb#…Ñô/=¢RDö_É70Ùô&+ÜÙSÞÆ5Ï ¦6!/-fÄ&nMv¬a¬”¬ñlìƬ®0Öó·âÁ ¯iõ#ñ=¥ÝjnFn,~Ãi¢È‘AP:ò”j$O¥°dí 8]”Œ“·Pîìj`xïÞ ºÊ-ÃÀÏ> d’Sê>-©¢ L²Hýt(6M›þÎqÅR¼P…½wµ´öXòÛÎÙÑ‚ëÏ7|±Ç;éd€®µ©Bùo$>Vdå–è ¹Üdz9þîT’eºQֆšgmðx\½KtʢϧÎ%ÄÎõÐOIµÍÚÝn@r}o²hÇxî­3%,À<‰ƒ5'«ajÅ×U‰l!KH‡sà•½M`ÚÄ«Ák©å YÃbjlk„]6¨I;ç»QFIJ8\nj$üŽbljÈØØ9kZý^ÍÞŠÑkæjå3G+ϲvGµ|@v9V&·s,/³„lTæ©|Á†=+’2?åÄ»¤ u7Ê–C‘_!vð Šk´ÊLœÈâÂ4'ùŒ.@†JŠ´ƒú/¿[#‰Ï2YsJþøÊ)~ãT–ík0DãašÐ n1 ].6œ~32R—ÂaÑ°¬fd=Œ0ØìàÒ Šd‰$5Œ°)û’ ÞbðܘŠÜ°©‹*¥qœ‚"RˆyÒÔû— z³>¤´Á¸A'+ygrc™WÖROñ ßC6©ÜöÇ=`0±GbóÑ5”²@+ Ö‚Ö¢Ò0Q“ŽË×¢%’•Ô?¬Ô–C»©³a§‹±m’ÌJAùS÷2{‘)ê0¥Ûû+uäáƒ`“_Šµ9©_÷`ª¼r Ÿ–mWöŠ¨ ù11™WÂêéqð׃3gi´k¬= àŽi­¹ÑÕè™)&jùŒË3Ã#3¢fYcÕh`Ÿp‘»I–äœGYæ¾P1sD2 ºQKJ4m$ÝÚ»ÆD †M±`[”ébNF].8 UbºKìÂæͶ$½¢poéº4ÕÁEû’úˆøè$˜E’BåVÃ/FpÊ¿lV°îæ zñøªùÕŽ#6ðbìo·¾9d³›i±‡TL Óàj‰ÕL8ØT3'——™îÐWÁS5¹¤ Î%eZ¶¹À3Î6…ª¸CbÿX …ÁWËQ8¦D[‡{ž/n±v;æi8Õ¿8 >&j²MåRõAŸoÂœØ,(1~)ˆhdé9‚´4¤Îç=bÁk¹ƒoõV| TðDÁ‘¢ªàLbî¢Õ/O –QñµÛIRd„«e|O*Œ ½Ê­'­ ("In˜UóÇä'²å¿(nØ´1ïG‹ûþ9n¦Ð®…d®Œ›_\~w©©ý9/ Ý›>»ø”7Íص|oà%-TÖž,Ðhkýë‚Á&›0[$ÖÈ|"¹lC´ ˆÐ¿ýcbÐœýd/$UïÖEѲ×õüá«/.ÞHòIJýýïײ¬"—`U(v7\FŠUžüz½É•ÉpÕªiúÓoý˜þDçâ¿S ?·8K÷n¼!±øÝMLÓù%ou;Xòúß Må3•äq||Ž…I÷ª.šÈžiƲY-/þŽÖñEÇø'2¼~—‡×CC ”íÀ-ý¼XíUó -€&¯šù– t.̸F…‹{/•ÇÀÀÌ+¡PMÓ0Ôa£ÖÀ/L7“»«¦Jëß¿¼x³Yleõ§¸ôH_ÀíÓC5À¹™(šÏôŠ^ò!ÏiHsêð’ÿÇŠ=¿¼S£b}­ÿ-¹rÓw|õû r˜è6Ó5”Û`Þû”Byž-E³ÏšFÕ6No\l¸Zo^1¹šØ%Ê­Wœ%ÏÊÐsÍÄl3nþS¿[>#ôKaÃ9ŠÌ:ÄC¾zs  (:ÿÂë5k&ý«fïªõ4ëÿ©UX¡ÿØ-t2ôi4Åc`Ç]^¡?j nRŒ·ÄnÐ`þ4Ò|Mex<ÜlDB`1_ëo¼ªkͱöIßDü/si¼óÉúÃøÃ~ZAÜ.ìÆ—ù-_$„.xºŽò›ÏÇ&ò?—ZéP”xºeà ª?YmqÙ:¼lËÙ|ÄtŠ'ù—ú!8ßiæÌfý™K¬I—¦gPg¾$G¾‹K*?øwÒ¹ðlåìvQJfáû‘£õúXòÆÑhéïñæåÍ,½j¦p¥ÓŒÑ:‡]Ê® °,1¤ÛÁ¡wIWà™(·Á1¸(x);%.«Ræò¤\çeì7Kñ`˜P„H†£Þ ¶]\êwžçXÈfŒ1ÔÏ&¿Œx¥ý×®Ââ±0%<Œ'­;b2ê-_ŸÑÍþ9ìAšÙsè }‹ßþå‹çú“¿‰_é’ØØ0í6èýn–&´D^¢?­GsH×Ã9»í+:`~µ.@9ÿ./^â‘™’ä–£ x#Ûhþ§ÊHÕC•&˜›ëÆf_‚’}œR^Z¥ú$ZðƒŒÜíàªÙŸjjÕç™!dpÃQÐÁÍ´CsòÜP‚F@±ðÆ+¡ö­VÊ”š\¥Äÿ '›vd³ÿ®ùöÂ0á×Kê o¤ÎY`– ×¾EÛןb ìlñ¤ÙIþÙí{[œÓÏìbëCä¶ø¹æ 9š(‰ ezmzR%´ß†r1?&íŸ(‹ñËÕHÚ¸l†-O!»ƒØôr… QøÒä3ßB\Ú(W–PT߀ž+. ia¼º ³ÐT÷üŠihêÐÐbáàôµb»x‰šæ.5MkðH1¹åüÄdÐùgÚîëI‡TFDÖzJk=uÖ‡šh©6€g»U¸vÖ7kãü˜€êhõ%9L&tÀzf5’Ýo.“‚ôðWª¹ð€ÃQמJ"Å_ëY T1Ñ5åª^ºz³,‹ùoÈ@E&+¾ä©ð°Ù)Fœ ͈Wrèƒ%Ø!Ø=º˜ZÏÿQó!ÒE%:Éþ™¢ „0™/¾CPŸêŸP “23Ô]h±ç Ìê~vxø =óÐZtl]á;œ1½g1Â"f\í¡57²ÖÙp6àPu2œž)žÀ…Vœµ«H ´Öl<R0YtHôÕ)¥[,–Í5ž`õÿÛÝÚ%湑7Zzþ3I!‰£8 ö¿ Fr§í@”טÀ k‚¹RÂò®¿Èìd¨–ÐA†8L)õŽÂKLQÖÔnG¨¾vúxï:æ~N½Ü5)\¡Ob3³g1a¤`Æ’éFR î÷méÈ;Þ\^kZ¾XŒ®7 þÿ¯G`ùú³7È HPäþˆ†Øóoõ›OˆÇ;|27G1¼‘§òcÒã%ú ZaDÕ§»kálÊúg 9ºJ8o³ùš¾ÀBìŽX®e…&ƒ.I¨o0 æ†Ð×èó§Åh3[½†%«WI›¦¸Q~ìQšdÑ5ª¤m»«üAÂðƒœ3{R)”‡@þ\#+µÍŸÉõàÅ›§T] æ ¾äû¨±t‚‘¶‚¾f¦¦&Æ6µ]ðõ’þë!«æzg`'~„Y.š¿ûêÛ¯¾ûê//H©Ôç×Æ×½©ñé®ÿœÖâ'~é§ÖxÕï©Ð„–ìÛ··9Æ/Âk7tIýïõ‘)Ãb9Ð7|ŒO_5üzÛÐò3­Mkž” Ä2ý?É›o4‰tÀèÉêëW@ é cÞÌ›¿¥ ê³^ÊbNPÕ{ø â‘`ô¿þƒýÐ •Gl|} DÓÃþè­•æH–=∠é/GÐ]Úk›' b)\_A×m”±i³ó6÷i¢xD ®s;Ø„t5ƒïKÖ Wê ãú w“¥PÔ+¤”y½†½½½{C¥{íÊòuÚí~uZˆ…½vRÂÂa r0°×Ê š·^TÍøAe0°ô`’É,gòχЅÅeÖOؘfBû™`cBÎ.:öµô{ʲ¾æ"¦Û1XÞvXo*ÍÛŽ“MTí¶§~'P•ÆíÄr>%‹æ¿bŽšBGo/‹ Dªl E€¼)XÌÕ «~¤‹ÆZšB꾘à˜ÛI/K”Û‰å¶F*ÉP*uõN™õj­›Þk¢˜¸Ìl¢=PÍ^uÛzDƒ4q&ÚsÞ MtØð:éeåvb‰e˜õÃÄB PÛºjý^á¹tÁérÌEó»ÑÛëÜsÖÕ˜?l[ÏúÓ[`Ì%åK ”´†Šç¯Zÿæ LvTi`ßêóoRX#A·“˜éíðÀ¸)LÕŒô”«v;s!ÈjžRçƒôõøi›ÒˆáëáAÇ5Ä鎱OðÌhÉwytP—õå@lTbIÅêžiÖíȵñGU‘] ÂÇäPÊw‡Á`Ó¤Ó;z_Ö Õ”ÛHÍíbžj!Œ½uú†±Ã-fòŠ§ZÀÊè cï$CïÁ™ËÒQÕÕBkˆú-\ObæýÄ‘ËÌ<×ÛÝÕƒL»ÊÛ^gj´½Õ©zN‡åNL«nîZø;ÿ„”tàI¢¼~ºpBÛÓO¢guA{b¹ÔORൢ¶w¬ï ÚJY6°¢&k¯££| ¢e½!ö–vI3bU©ë¼ÀÓí’â“0½×îûÈÓí÷|äá'œ.]½§—t}ä1@­ Ÿ*û`BÇ;÷ÁªV0gŒ§=­a¥=R]XGí9£s)Å{/\Dúë2ÿëTcŽ.a}._i§ÞèsS¦Ü5M¯¼¾Ôèâ°ºJ°¬«±Ø¾PÑá&J¯ƒ~¦{ÜÓÁÊ®œV§ì@¹èÕôê ËÇcQ ¹ó^¯§ûêµMç!¯…:‡ÊAiŸôDªA»í¼àÓAª~¿ç"•JûŽTüDð°Ã²€¥g·Û+í%KM»¤Ùú´]d­dAÇ3~3t>þZz¤CèZ¾ 3õåkëîÐY®zCWn4ôjÁ¡+èxÙ’;ô!]Œk‡ŽO¨½«–À] ÕÙ'w¾ˆ1Wû:,w³6¬„r§0ôE=^k"éuÝ…¯Ä¥‘tû 8(}ÿÐ¥t *DÓa¼8Œ0ís®~íi—TÖ4Õ#×GÞžåŒÝ¾yZG“•}X"ýÌF&Ø1 úVšì;ž"œ$f |ûÖûà"íèR¤z~Rò¤õ²¹„Ék¢ª1˜áz]ðÖbàdÈ /I‡(/läÉ}#O½^Áaa­Žå†}¸ör×YÞ„º¦àÛ¼óPÈv¢…Þ@úNAÂꃂƒ0áy¢²Sþ°ÐÌ}Ô°”;¬Åêµ3¦tÐoâ°cq c|ÐbÂêZÖ ˜ã„–´á_|ùìÅ3 áüðÕÿúÏo~øêK&zo£‡ZÂs,µÅøï4YjñŸñ¥VH–‰F¹ömÿ.u¹bÃÓ§˜ ß|¾] ðnwÿ7ß}ÿí7õÃï U†ï?¿SGþ{‡O=¦ÎL ¬:=j&õGýl€Ž!J:m[ÂÖJš…õÒ<J¯}è[Óªû`½!D„^»²f¹>–ÖHøü¬¹5V8ˆ*WYß|óÖ7†õºõ…èQuéÓšcõ<^sµ{ÊkžR|®¬¹²°¼5w”5wPo|’5Oé¤k×\CPþš[”n—\ŸxÉ•·äiè²äü`xñÔ”îõd;Ë«¯*«õÕõ‚¯Aÿþ¨XJ]»ÑVSÆ5ÖÀ@2ïô.kQ1×ùå%¥H•½§‚yPG,ë1*` ÷ ŽF„.x;"@d¿@r¡ï<ˆˆ4Ü“Ž ´°«®ƒBð§Ý ãåÐÐä•8˜zݺM ©xào„‰3ó®{wê#T.é·Íi×Á0}_ëúøB}`ÊÖßå o˜> ´+À`dªÃBmz!ÔÌýÛž.{¸Äl dƒúeèfüÞ@u¬cõu1ÛI¹¼!ñ#r-îk¹ ×ò¥Æ5*ßœ€]s¨kàžµ‘GP¼Y²^hYäk•/'j·É×CÜøLÿv1_­^5^-W¯—ÿ”_ÿo1Õ¯|õׯÕÿònó®ÙM hugs98-plus-Sep2006/packages/HaXml/docs/index.html0000644006511100651110000003325210504340466020506 0ustar rossross HaXml: Haskell and XML

HaXml

What is HaXml?
How do I use it?
Downloads
 Recent news
Contacts
Related Work

Warning! The development versions (1.14 upwards) significantly change the API of some modules! They may be incomplete, inconsistent, and liable to change before the next release! Do not expect code written against an earlier API to be compatible! DtdToHaskell has only recently been fixed to work with the 1.15 APIs! Warning!

What is HaXml?

HaXml is a collection of utilities for parsing, filtering, transforming, and generating XML documents using Haskell. Its basic facilities include:

  • a parser for XML,
  • a separate error-correcting parser for HTML,
  • a SAX-like stream parser for XML events,
  • an XML validator,
  • pretty-printers for XML and HTML.

For processing XML documents, the following components are also provided:

  • Combinators is a combinator library for generic XML document processing, including transformation, editing, and generation.
  • XmlContent is a replacement class for Haskell's Show/Read classes: it allows you to read and write ordinary Haskell data as XML documents (and vice versa). The DrIFT tool (available from http://repetae.net/~john/computer/haskell/DrIFT/) can automatically derive this class for you.
  • DtdToHaskell is a tool for translating any valid XML DTD into equivalent Haskell types, together with XmlContent instances.
  • Finally, Xtract is a grep-like tool for XML documents, loosely based on the XPath and XQL query languages. It can be used either from the command-line, or within your own code as part of the library.

How do I use it?

Detailed documentation of the HaXml APIs is generated automatically by Haddock directly from the source code. Documentation for the previous (stable) version, HaXml-1.13.1.

An introduction to HaXml for people who know more about XML than about Haskell can be found at IBM DeveloperWorks.

A paper describing and comparing the generic Combinators with the typed representation (DtdToHaskell/XmlContent) is available here: (12 pages of double-column A4)

Some additional info about using the various facilities is here:

Known problems:

  • To use -package HaXml interactively with GHCi, you need at least ghci-5.02.3.
  • The function toDTD generates Parameter Entity Declarations in the internal subset of the DTD, which don't conform to the strict well-formedness conditions of XML. We think the constraint in question is spurious, and any reasonable XML tool ought to deal adequately with full PEs. Nevertheless, many standard XML processors reject these auto-generated DTDs. The solution is easy - just write the DTD into a separate file!
  • DtdToHaskell generates the Haskell String type for DTD attributes that are of Tokenized or Notation Types in XML. This may not be entirely accurate.

Downloads

Development versions:
HaXml-1.17, release date 2006.09.11
By HTTP: .tar.gz, .zip.
By FTP: ftp://ftp.cs.york.ac.uk/pub/haskell/HaXml/

Ongoing development: The development version of HaXml is also available through
darcs get http://www.cs.york.ac.uk/fp/darcs/HaXml

Older versions:
Stable version: for 1.13.2 see http://haskell.org/HaXml/
By FTP: ftp://ftp.cs.york.ac.uk/pub/haskell/HaXml/
FreeBSD port: http://freshports.org/textproc/haxml/

Installation

To install HaXml, you must have a Haskell compiler: ghc-5.04 or later, and/or nhc98-1.16/hmake-3.06 or later, and/or Hugs98 (Sept 2003) or later. For more recent compilers, use the standard Cabal method of installation: 

    runhaskell Setup.hs configure [--prefix=...] [--buildwith=...]
    runhaskell Setup.hs build
    runhaskell Setup.hs install
For older compilers, use: 
    ./configure [--prefix=...] [--buildwith=...]
    make
    make install
to configure, build, and install HaXml as a package for your compiler(s). You need write permission on the library installation directories of your compiler(s). Afterwards, to gain access to the HaXml libraries, you only need to add the option -package HaXml to your compiler commandline (no option required for Hugs). Various stand-alone tools are also built - DtdToHaskell, Xtract, Validate, MkOneOf - and copied to the final installation location specified by the --prefix=... option to configure.

To build/install on a Windows system without the Cygwin shell and utilities, you can avoid the configure/make steps by simply using the minimal Build.bat script. Edit it first for the location of your compiler etc.

Recent news

Version 1.17 essentially just fixes compatibility with ghc-6.6. However, it also include a lazier pretty-printer to use in conjunction with the lazy parser, to save running out of memory on large datasets.

Version 1.16 adds laziness to the parser combinator libraries, such that they can start to return partial results before a whole entity has been parsed. Partial is also used in the sense that the returned value can contain bottom - an error which gets thrown as an exception when you try to explore the inner regions of the value. In terms of XML, it means you get an element back as soon as its start-tag has been consumed, but if there are parse errors later on, BOOM. However, if there are no errors, it does mean that your processing will be (a) faster and (b) less memory hungry. Another cool thing is that, even in the presence of errors, you still might get enough output to satisfy your processing task before the error is noticed.

Use Text.XML.HaXml.ParseLazy and Text.XML.HaXml.Html.ParseLazy to try it out. There are also lazy versions of the supplied demo programs: CanonicaliseLazy and XtractLazy.

Version 1.15 is essentially 1.14 with some bugfixes, and some new functionality, especially in the parser combinator libraries. DrIFT now supports deriving the XmlContent class, and DtdToHaskell now also derives the XmlContent class, in addition to determining a collection of Haskell datatypes equivalent to a given DTD.

Error messages from parsing are much improved in 1.15 - they should locate any error far more specifically and accurately. Let me know about examples which do not report correctly.

Prior to 1.14, there were two separate classes, Xml2Haskell and Haskell2Xml. They are now combined into the single class XmlContent. Make sure you get a recent version of DrIFT if you want to derive this class from Haskell datatypes - the included version of DtdToHaskell has not yet been updated for deriving the class the other way, from an XML DTD.

Version 1.14 also contains a new SAX-like stream parser.

A while back, Graham Klyne extended the 1.12 version of HaXml significantly, in particular to ensure that the parser passes a large XML acceptance test suite, and to deal more correctly with Unicode, namespaces, and parameter entity expansion. His modifications will eventually be merged back in to the main CVS tree, but in the meantime, you can get his version here: http://www.ninebynine.org/Software/HaskellUtils/

The previous stable version (1.13) had the following features and fixes:

  • Bugfixes to the document validator: no more infinite loops.
  • Bugfixes to lexing mixed text and references between quote chars.
  • Updated to work with ghc-6.4's new package mechanism.

Complete Changelog

Contacts

We are interested in hearing your feedback on these XML facilities - suggestions for improvements, comments, criticisms, bug reports. Please mail

Development of these XML libraries was originally funded by Canon Research Europe Ltd.. Subsequent maintenance and development has been partially supported by the EPSRC, and the University of York.

Licence: The library is Free and Open Source Software, i.e., the bits we wrote are copyright to us, but freely licensed for your use, modification, and re-distribution, provided you don't restrict anyone else's use of it. The HaXml library is distributed under the GNU Lesser General Public Licence (LGPL) - see file LICENCE-LGPL for more details. We allow one special exception to the LGPL - see COPYRIGHT. The HaXml tools are distributed under the GNU General Public Licence (GPL) - see LICENCE-GPL. (If you don't like any of these licensing conditions, please contact us to discuss your requirements.)

Related work

  • Joe English has written a more space-efficient parser for XML in Haskell, called hxml. What is more, it can be used as a simple drop-in replacement for the HaXml parser! Available here.
  • Uwe Schmidt designed another Haskell XML Toolbox based on the ideas of HaXml and hxml. It is well-maintained, and has recently been updated to use arrow-based combinators rather than filters as in HaXml.
  • To use HaXml and HXT together, Henning Thielemann has put together WraXML, a wrapper using an alternative tree data structure, together with conversions to/from HaXml and HXT.
  • Some comparisons between functional language approaches to processing XML can be found in Bijan Parsia's article on xml.com
  • Christian Lindig has written an XML parser in O'Caml: here.
  • Andreas Neumann of the University of Trier has written a validating XML parser in Standard ML: here.
  • Erik Meijer and Mark Shields have a design for a functional programming language that treats XML documents as basic data types: XMLambda.
  • Benjamin Pierce and Haruo Hosoya have a different but similar design in XDuce, which is also implemented.
  • Taking XDuce's approach further, is the very cool CDuce by Véronique Benzaken, Guiseppe Castagna, and Alain Frisch. The CDuce language does fully statically-typed transformation of XML documents, thus guaranteeing correctness, and what is more, it is also faster than the untyped XSLT!
  • The Xcerpt project uses HaXml to create another rule-based query and transformation language for XML, inspired by logic programming, and based on positional selection rather than navigational selection.
  • Ulf Wiger describes an Erlang toolkit for XML: XMerL
  • The Java world has adopted the ideas from DtdToHaskell into the Java Architecture for XML Binding (JAXB). JAXB translates an XML Schema Definition into a set of Java classes, and provides the runtime machinery (like XmlContent) for reading and writing objects of those classes to/from XML files.
  • There is a comprehensive reading list for XML and web programming in functional languages here.
hugs98-plus-Sep2006/packages/HaXml/LICENCE-GPL0000644006511100651110000004310410504340456017162 0ustar rossross GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. hugs98-plus-Sep2006/packages/HaXml/LICENCE-LGPL0000644006511100651110000006362610504340456017311 0ustar rossross GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! hugs98-plus-Sep2006/packages/HaXml/Makefile0000644006511100651110000001145010504340466017215 0ustar rossrossSOFTWARE = HaXml VERSION = 1.17 CPP = cpp -traditional #CPP = cpphs --text # useful e.g. on MacOS X DIRS = Text Text/XML Text/XML/HaXml Text/XML/HaXml/Html \ Text/XML/HaXml/Xtract Text/XML/HaXml/DtdToHaskell \ Text/ParserCombinators SRCS = \ src/Text/XML/HaXml.hs src/Text/XML/HaXml/Combinators.hs \ src/Text/XML/HaXml/Posn.hs src/Text/XML/HaXml/Lex.hs \ src/Text/XML/HaXml/Parse.hs src/Text/XML/HaXml/Pretty.hs \ src/Text/XML/HaXml/Types.hs src/Text/XML/HaXml/Validate.hs \ src/Text/XML/HaXml/Wrappers.hs \ src/Text/XML/HaXml/Verbatim.hs src/Text/XML/HaXml/Escape.hs \ src/Text/XML/HaXml/OneOfN.hs \ src/Text/XML/HaXml/ParseLazy.hs \ src/Text/XML/HaXml/TypeMapping.hs src/Text/XML/HaXml/XmlContent.hs \ src/Text/XML/HaXml/SAX.hs \ src/Text/XML/HaXml/ShowXmlLazy.hs \ src/Text/XML/HaXml/Html/Generate.hs src/Text/XML/HaXml/Html/Parse.hs \ src/Text/XML/HaXml/Html/Pretty.hs \ src/Text/XML/HaXml/Html/ParseLazy.hs \ src/Text/XML/HaXml/Xtract/Combinators.hs \ src/Text/XML/HaXml/Xtract/Lex.hs \ src/Text/XML/HaXml/Xtract/Parse.hs \ src/Text/XML/HaXml/DtdToHaskell/TypeDef.hs \ src/Text/XML/HaXml/DtdToHaskell/Convert.hs \ src/Text/XML/HaXml/DtdToHaskell/Instance.hs \ src/Text/ParserCombinators/HuttonMeijer.hs \ src/Text/ParserCombinators/HuttonMeijerWallace.hs \ src/Text/ParserCombinators/Poly.hs \ src/Text/ParserCombinators/PolyState.hs \ src/Text/ParserCombinators/PolyLazy.hs \ src/Text/ParserCombinators/PolyStateLazy.hs \ src/Text/ParserCombinators/TextParser.hs TOOLSRCS = \ src/tools/DtdToHaskell.hs src/tools/Xtract.hs src/tools/Validate.hs \ src/tools/Canonicalise.hs src/tools/MkOneOf.hs \ src/tools/CanonicaliseLazy.hs src/tools/XtractLazy.hs \ AUX = configure Makefile src/Makefile src/pkg.conf docs/* examples/* \ README LICENCE* COPYRIGHT script/echo.c rpm.spec Build.bat \ HaXml.cabal Setup.hs ALLFILES = $(SRCS) $(TOOLSRCS) $(AUX) # These files in CVS are NOT included in the src distribution. NOT = Makefile.inc Makefile.nhc98 src/Makefile.inc src/Makefile.nhc98 .PHONY: all libs tools haddock install register COMPILERS = $(shell cat obj/compilers) LIBS = $(patsubst %, libs-%, $(COMPILERS)) TOOLS = $(patsubst %, tools-%, $(COMPILERS)) INSTALL = $(patsubst %, install-%, $(COMPILERS)) FILESONLY = $(patsubst %, install-filesonly-%, $(COMPILERS)) all: $(LIBS) $(TOOLS) libs: $(LIBS) tools: $(TOOLS) install: $(INSTALL) install-filesonly: $(FILESONLY) libs-ghc: cd obj/ghc; $(MAKE) HC=$(shell cat obj/ghccmd) libs libs-nhc98: cd obj/nhc98; $(MAKE) HC=nhc98 libs libs-hugs: @echo "No building required for Hugs version of HaXml libs." tools-ghc: cd obj/ghc; $(MAKE) HC=$(shell cat obj/ghccmd) toolset tools-nhc98: cd obj/nhc98; $(MAKE) HC=nhc98 toolset tools-hugs: @echo "No building required for Hugs version of HaXml tools." install-ghc: cd obj/ghc; $(MAKE) HC=$(shell cat obj/ghccmd) install-ghc install-nhc98: cd obj/nhc98; $(MAKE) HC=nhc98 install-nhc98 install-hugs: hugs-package src cd obj/hugs; $(MAKE) install-tools-hugs install-filesonly-ghc: cd obj/ghc; $(MAKE) HC=$(shell cat obj/ghccmd) install-filesonly-ghc install-filesonly-nhc98: cd obj/nhc98; $(MAKE) HC=nhc98 install-filesonly-nhc98 install-filesonly-hugs: install-hugs haddock: mkdir -p docs/HaXml for dir in $(DIRS); \ do mkdir -p docs/HaXml/src/$$dir; \ done for file in $(SRCS); \ do $(CPP) -D__NHC__ $$file >$$file.uncpp; \ HsColour -anchorHTML $$file >docs/HaXml/`dirname $$file`/`basename $$file .hs`.html; \ done haddock --html --title=HaXml --odir=docs/HaXml --package=HaXml \ --source-module="src/%{MODULE/.//}.html" \ --source-entity="src/%{MODULE/.//}.html#%{NAME}" \ $(patsubst %, %.uncpp, $(SRCS)) rm -f $(patsubst %, %.uncpp, $(SRCS)) # packaging a distribution srcDist: $(ALLFILES) haddock rm -f $(SOFTWARE)-$(VERSION).tar $(SOFTWARE)-$(VERSION).tar.gz mkdir $(SOFTWARE)-$(VERSION) tar cf - $(ALLFILES) | ( cd $(SOFTWARE)-$(VERSION); tar xf - ) rm -rf $(SOFTWARE)-$(VERSION)/docs/CVS rm -rf $(SOFTWARE)-$(VERSION)/examples/CVS rm -rf $(SOFTWARE)-$(VERSION)/examples/SMIL/CVS rm -rf $(SOFTWARE)-$(VERSION)/examples/OpenOffice.org/CVS tar cf $(SOFTWARE)-$(VERSION).tar $(SOFTWARE)-$(VERSION) rm -rf $(SOFTWARE)-$(VERSION) gzip $(SOFTWARE)-$(VERSION).tar zipDist: $(ALLFILES) haddock rm -f $(SOFTWARE)-$(VERSION).zip mkdir $(SOFTWARE)-$(VERSION) tar cf - $(ALLFILES) | ( cd $(SOFTWARE)-$(VERSION); tar xf - ) -rm -rf $(SOFTWARE)-$(VERSION)/docs/CVS -rm -rf $(SOFTWARE)-$(VERSION)/examples/CVS -rm -rf $(SOFTWARE)-$(VERSION)/examples/SMIL/CVS -rm -rf $(SOFTWARE)-$(VERSION)/examples/OpenOffice.org/CVS zip -r $(SOFTWARE)-$(VERSION).zip $(SOFTWARE)-$(VERSION) rm -rf $(SOFTWARE)-$(VERSION) # clear up rubbish clean: rm -rf obj/ghc obj/nhc98 obj/hugs cd examples; rm -f *.hi *.o realclean: clean rm -f DtdToHaskell Xtract Validate Canonicalise MkOneOf rm -f XtractLazy CanonicaliseLazy hugs98-plus-Sep2006/packages/HaXml/Makefile.inc0000644006511100651110000000022310504340456017760 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/HaXml/Makefile.nhc980000644006511100651110000000027610504340456020150 0ustar rossrossall: cd src; $(MAKE) -f Makefile.nhc98 all cfiles: cd src; $(MAKE) -f Makefile.nhc98 cfiles fromC: cd src; $(MAKE) -f Makefile.nhc98 fromC clean: cd src; $(MAKE) -f Makefile.nhc98 clean hugs98-plus-Sep2006/packages/HaXml/README0000644006511100651110000000742610504340466016445 0ustar rossross HaXml - Haskell utilities for processing XML -------------------------------------------- Installation instructions: We currently support nhc98, ghc, and Hugs. The automatic configuration detects which compilers/interpreters you have, and prepares a build tree for each. Installation requires write-permission on the system directories of the compiler/interpreter - the libraries and interfaces can then be used as "-package HaXml" (for ghc/nhc98 - no extra options required for Hugs). The standalone tools are installed to a directory of your choice. ./configure make make install Options to configure are: --buildwith=... e.g. ghc-6.2, to build for a specific compiler --prefix=... e.g. /usr/local/bin, installation location for HaXml tools Complaints to: :-) Malcolm.Wallace@cs.york.ac.uk P.S. For those building on Windows /without/ Cygwin, you can avoid the need for configure/make steps by simply running the minimal build script in Build.bat You will need to edit it for the location of your compiler etc. ---- What this package contains: docs/ Some rudimentary HTML documentation about the libraries. docs/HaXml/ Haddock-generated API documentation. examples/ Some small examples of how the libraries/tools are used. src/Text/XML/HaXml/ Numerous support modules for processing XML. (The main APIs are as follows:) Types.hs Defines a (generic) representation for any XML document. Parse.hs Parses an XML document into the generic representation. ParseLazy.hs A more space-efficient parser. Pretty.hs Pretty-prints an XML document. Validate.hs Validates an XML document against a DTD. Combinators.hs Provides the combinators described in the ICFP'99 paper together with some other useful functions. SAX.hs A simple SAX-like stream-event-parser. Wrappers.hs Simple top-level wrappers for processing a single document using the combinators. XmlContent.hs A replacement class for Show/Read, to translate Haskell values to/from XML documents. Can be derived by DrIFT and/or DtdToHaskell. TypeMapping.hs Defines an explicit representation for Haskell types, allowing generation of a DTD from a Haskell value. OneOfN.hs Some support types (OneOf2 - OneOf20) for code generated by tools/DtdToHaskell. src/Text/XML/HaXml/Html Extra support modules for processing HTML. Parse.hs An error-correcting HTML parser, produces the generic XML representation. Pretty.hs An HTML-specific pretty-printer. Generate.hs Some useful combinators for generating HTML content. src/tools/ Standalone tools based on the library above. DtdToHaskell Translates an XML doc containing a DTD into a Haskell module containing data/newtype definitions. Xtract A structured 'grep' for XML docs, loosely based on the XPath and XQL query languages. Validate A simple validation tool for XML docs. Give it a DTD file and an XML file, and it reports all validation errors it can find. Canonicalise A 'cat' filter for XML docs, shows our "standard" parsing and pretty-printing behaviour. MkOneOf Generates a OneOfN type, given an N, together with its required instance of XmlContent. Sometimes types larger than OneOf20 are required in code generated by DtdToHaskell. src/Text/XML/HaXml/Xtract Internal APIs of the Xtract tool. Parse.hs Parse an XPath query to produce a filter. Combinators.hs Modified version of the standard combinators. src/Text/XML/HaXml/DtdToHaskell Internal APIs of the DtdToHaskell tool. TypeDef.hs A representation of the Haskell types corresponding to an XML DTD, and a pretty printer for them. Convert.hs Convert the standard DTD representation to the Haskell-like TypeDef representation. Instance.hs Generate appropriate XmlContent class instances for the TypeDefs. ---- hugs98-plus-Sep2006/packages/HaXml/Setup.hs0000644006511100651110000000005610504340456017210 0ustar rossrossimport Distribution.Simple main = defaultMain hugs98-plus-Sep2006/packages/HaXml/examples/0000755006511100651110000000000010504340466017372 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/0000755006511100651110000000000010504340456022174 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/Blocklist.dtd0000644006511100651110000000470010504340456024620 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/chart.mod0000644006511100651110000002372310504340456024005 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/datastyl.mod0000644006511100651110000002773710504340456024542 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/defs.mod0000644006511100651110000000667410504340456023633 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/drawing.mod0000644006511100651110000013315410504340456024337 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/dtypes.mod0000644006511100651110000001273010504340456024210 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/form.mod0000644006511100651110000003207610504340456023650 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/meta.mod0000644006511100651110000001042310504340456023623 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/nmspace.mod0000644006511100651110000000604510504340456024330 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/office.dtd0000644006511100651110000000565510504340456024137 0ustar rossross %dtypes-mod; %nmspace-mod; %defs-mod; %office-mod; %style-mod; %meta-mod; %script-mod; %drawing-mod; %text-mod; %table-mod; %chart-mod; %datastyl-mod; %form-mod; %settings-mod; hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/office.mod0000644006511100651110000002673110504340456024141 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/office2.dtd0000644006511100651110000054275410504340456024227 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/script.mod0000644006511100651110000000616310504340456024207 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/settings.mod0000644006511100651110000000601410504340456024536 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/style.mod0000644006511100651110000005655110504340456024051 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/table.mod0000644006511100651110000004771510504340456024002 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/OpenOffice.org/text.mod0000644006511100651110000014035310504340456023667 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/examples/AlbumDTD.hs0000644006511100651110000002441010504340466021323 0ustar rossrossmodule AlbumDTD where import Text.XML.HaXml.XmlContent import Text.XML.HaXml.OneOfN {-Type decls-} data Album = Album Title Artist (Maybe Recording) Coverart [Catalogno] Personnel [Track] Notes deriving (Eq,Show) newtype Title = Title String deriving (Eq,Show) newtype Artist = Artist String deriving (Eq,Show) data Recording = Recording { recordingDate :: (Maybe String) , recordingPlace :: (Maybe String) } deriving (Eq,Show) data Coverart = Coverart Coverart_Attrs (Maybe Location) deriving (Eq,Show) data Coverart_Attrs = Coverart_Attrs { coverartStyle :: String } deriving (Eq,Show) data Location = Location { locationThumbnail :: (Maybe String) , locationFullsize :: (Maybe String) } deriving (Eq,Show) data Catalogno = Catalogno { catalognoLabel :: String , catalognoNumber :: String , catalognoFormat :: (Maybe Catalogno_Format) , catalognoReleasedate :: (Maybe String) , catalognoCountry :: (Maybe String) } deriving (Eq,Show) data Catalogno_Format = Catalogno_Format_CD | Catalogno_Format_LP | Catalogno_Format_MiniDisc deriving (Eq,Show) newtype Personnel = Personnel [Player] deriving (Eq,Show) data Player = Player { playerName :: String , playerInstrument :: String } deriving (Eq,Show) data Track = Track { trackTitle :: String , trackCredit :: (Maybe String) , trackTiming :: (Maybe String) } deriving (Eq,Show) data Notes = Notes Notes_Attrs [Notes_] deriving (Eq,Show) data Notes_Attrs = Notes_Attrs { notesAuthor :: (Maybe String) } deriving (Eq,Show) data Notes_ = Notes_Str String | Notes_Albumref Albumref | Notes_Trackref Trackref deriving (Eq,Show) data Albumref = Albumref Albumref_Attrs String deriving (Eq,Show) data Albumref_Attrs = Albumref_Attrs { albumrefLink :: String } deriving (Eq,Show) data Trackref = Trackref Trackref_Attrs String deriving (Eq,Show) data Trackref_Attrs = Trackref_Attrs { trackrefLink :: (Maybe String) } deriving (Eq,Show) {-Instance decls-} instance XmlContent Album where fromElem (CElem (Elem "album" [] c0):rest) = (\(a,ca)-> (\(b,cb)-> (\(c,cc)-> (\(d,cd)-> (\(e,ce)-> (\(f,cf)-> (\(g,cg)-> (\(h,ch)-> (Just (Album a b c d e f g h), rest)) (definite fromElem "" "album" cg)) (many fromElem cf)) (definite fromElem "" "album" ce)) (many fromElem cd)) (definite fromElem "" "album" cc)) (fromElem cb)) (definite fromElem "" "album" ca)) (definite fromElem "" "album" c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Album a b c d e f g h) = [CElem (Elem "album" [] (toElem a ++ toElem b ++ maybe [] toElem c ++ toElem d ++ concatMap toElem e ++ toElem f ++ concatMap toElem g ++ toElem h))] instance XmlContent Title where fromElem (CElem (Elem "title" [] c0):rest) = (\(a,ca)-> (Just (Title a), rest)) (definite fromText "text" "title" c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Title a) = [CElem (Elem "title" [] (toText a))] instance XmlContent Artist where fromElem (CElem (Elem "artist" [] c0):rest) = (\(a,ca)-> (Just (Artist a), rest)) (definite fromText "text" "artist" c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Artist a) = [CElem (Elem "artist" [] (toText a))] instance XmlContent Recording where fromElem (CElem (Elem "recording" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "recording" (toAttrs as) [])] instance XmlAttributes Recording where fromAttrs as = Recording { recordingDate = possibleA fromAttrToStr "date" as , recordingPlace = possibleA fromAttrToStr "place" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "date" (recordingDate v) , maybeToAttr toAttrFrStr "place" (recordingPlace v) ] instance XmlContent Coverart where fromElem (CElem (Elem "coverart" as c0):rest) = (\(a,ca)-> (Just (Coverart (fromAttrs as) a), rest)) (fromElem c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Coverart as a) = [CElem (Elem "coverart" (toAttrs as) (maybe [] toElem a))] instance XmlAttributes Coverart_Attrs where fromAttrs as = Coverart_Attrs { coverartStyle = definiteA fromAttrToStr "coverart" "style" as } toAttrs v = catMaybes [ toAttrFrStr "style" (coverartStyle v) ] instance XmlContent Location where fromElem (CElem (Elem "location" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "location" (toAttrs as) [])] instance XmlAttributes Location where fromAttrs as = Location { locationThumbnail = possibleA fromAttrToStr "thumbnail" as , locationFullsize = possibleA fromAttrToStr "fullsize" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "thumbnail" (locationThumbnail v) , maybeToAttr toAttrFrStr "fullsize" (locationFullsize v) ] instance XmlContent Catalogno where fromElem (CElem (Elem "catalogno" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "catalogno" (toAttrs as) [])] instance XmlAttributes Catalogno where fromAttrs as = Catalogno { catalognoLabel = definiteA fromAttrToStr "catalogno" "label" as , catalognoNumber = definiteA fromAttrToStr "catalogno" "number" as , catalognoFormat = possibleA fromAttrToTyp "format" as , catalognoReleasedate = possibleA fromAttrToStr "releasedate" as , catalognoCountry = possibleA fromAttrToStr "country" as } toAttrs v = catMaybes [ toAttrFrStr "label" (catalognoLabel v) , toAttrFrStr "number" (catalognoNumber v) , maybeToAttr toAttrFrTyp "format" (catalognoFormat v) , maybeToAttr toAttrFrStr "releasedate" (catalognoReleasedate v) , maybeToAttr toAttrFrStr "country" (catalognoCountry v) ] instance XmlAttrType Catalogno_Format where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "CD" = Just Catalogno_Format_CD translate "LP" = Just Catalogno_Format_LP translate "MiniDisc" = Just Catalogno_Format_MiniDisc translate _ = Nothing toAttrFrTyp n Catalogno_Format_CD = Just (n, str2attr "CD") toAttrFrTyp n Catalogno_Format_LP = Just (n, str2attr "LP") toAttrFrTyp n Catalogno_Format_MiniDisc = Just (n, str2attr "MiniDisc") instance XmlContent Personnel where fromElem (CElem (Elem "personnel" [] c0):rest) = (\(a,ca)-> (Just (Personnel a), rest)) (many fromElem c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Personnel a) = [CElem (Elem "personnel" [] (concatMap toElem a))] instance XmlContent Player where fromElem (CElem (Elem "player" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "player" (toAttrs as) [])] instance XmlAttributes Player where fromAttrs as = Player { playerName = definiteA fromAttrToStr "player" "name" as , playerInstrument = definiteA fromAttrToStr "player" "instrument" as } toAttrs v = catMaybes [ toAttrFrStr "name" (playerName v) , toAttrFrStr "instrument" (playerInstrument v) ] instance XmlContent Track where fromElem (CElem (Elem "track" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "track" (toAttrs as) [])] instance XmlAttributes Track where fromAttrs as = Track { trackTitle = definiteA fromAttrToStr "track" "title" as , trackCredit = possibleA fromAttrToStr "credit" as , trackTiming = possibleA fromAttrToStr "timing" as } toAttrs v = catMaybes [ toAttrFrStr "title" (trackTitle v) , maybeToAttr toAttrFrStr "credit" (trackCredit v) , maybeToAttr toAttrFrStr "timing" (trackTiming v) ] instance XmlContent Notes where fromElem (CElem (Elem "notes" as c0):rest) = (\(a,ca)-> (Just (Notes (fromAttrs as) a), rest)) (many fromElem c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Notes as a) = [CElem (Elem "notes" (toAttrs as) (concatMap toElem a))] instance XmlAttributes Notes_Attrs where fromAttrs as = Notes_Attrs { notesAuthor = possibleA fromAttrToStr "author" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "author" (notesAuthor v) ] instance XmlContent Notes_ where fromElem c0 = case (fromText c0) of (Just a,rest) -> (Just (Notes_Str a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,rest) -> (Just (Notes_Albumref a), rest) (Nothing,_) -> case (fromElem c0) of (Just a,rest) -> (Just (Notes_Trackref a), rest) (Nothing,_) -> (Nothing, c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Notes_Str a) = toText a toElem (Notes_Albumref a) = toElem a toElem (Notes_Trackref a) = toElem a instance XmlContent Albumref where fromElem (CElem (Elem "albumref" as c0):rest) = (\(a,ca)-> (Just (Albumref (fromAttrs as) a), rest)) (definite fromText "text" "albumref" c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Albumref as a) = [CElem (Elem "albumref" (toAttrs as) (toText a))] instance XmlAttributes Albumref_Attrs where fromAttrs as = Albumref_Attrs { albumrefLink = definiteA fromAttrToStr "albumref" "link" as } toAttrs v = catMaybes [ toAttrFrStr "link" (albumrefLink v) ] instance XmlContent Trackref where fromElem (CElem (Elem "trackref" as c0):rest) = (\(a,ca)-> (Just (Trackref (fromAttrs as) a), rest)) (definite fromText "text" "trackref" c0) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem (Trackref as a) = [CElem (Elem "trackref" (toAttrs as) (toText a))] instance XmlAttributes Trackref_Attrs where fromAttrs as = Trackref_Attrs { trackrefLink = possibleA fromAttrToStr "link" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "link" (trackrefLink v) ] {-Done-} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/App.hs��������������������������������������������������0000644�0065111�0065111�00000001215�10504340466�020445� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module Main where import System (getArgs) import IO import Text.XML.HaXml.Wrappers (fix2Args) import Text.XML.HaXml.XmlContent (fReadXml, fWriteXml) import AlbumDTD main = fix2Args >>= \(infile,outfile)-> do putStrLn ("reading "++infile) value <- fReadXml infile putStrLn ("checking value's type and album title") putStrLn (let (Album title _ _ _ _ _ _ _) = value in if title==(Title "Time Out") then "ok" else "failed") putStrLn ("writing "++outfile) v <- (let (Album _ b c d e f g h) = value in return (Album (Title "unknown") b c d e f g h)) fWriteXml outfile v putStrLn ("Done.") �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/DTDpp.hs������������������������������������������������0000644�0065111�0065111�00000002024�10504340456�020676� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module Main where import System (getArgs) import IO import Maybe import List (isSuffixOf) import Text.XML.HaXml.Types (DocTypeDecl(..)) import Text.XML.HaXml.Parse (dtdParse) import Text.XML.HaXml.Pretty (markupdecl) import Text.XML.HaXml.Wrappers (fix2Args) import Text.PrettyPrint.HughesPJ (render,vcat) -- This is another trivial application that reads an XML DTD from -- a file (or stdin) and writes it back to another file (or stdout). -- It should deal with the external subset fully, collecting and -- in-lining all the individual files associated with the DTD. -- Note that PE references used in definitions are also expanded -- fully in the output. main = fix2Args >>= \(inf,outf)-> ( if inf=="-" then getContents else readFile inf ) >>= \content-> ( if outf=="-" then return stdout else openFile outf WriteMode ) >>= \o-> ( hPutStrLn o . render . vcat . map markupdecl . fromDTD . dtdParse inf) content fromDTD Nothing = error "no DTD found" fromDTD (Just (DTD _ _ ds)) = ds ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/DTypes.hs�����������������������������������������������0000644�0065111�0065111�00000012073�10504340466�021141� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{- Generated by DrIFT (Automatic class derivations for Haskell) -} {-# LINE 1 "DTypes.hs" #-} module DTypes where import Text.XML.HaXml.XmlContent hiding (Name) -- data types for a simple test program data Person = Person Name Email [Rating] Version {-! derive : XmlContent !-} newtype Name = Name String {-! derive : XmlContent !-} newtype Email = Email String {-! derive : XmlContent !-} newtype Version = Version Int {-! derive : XmlContent !-} data Rating = Rating SubjectID Interest Skill {-! derive : XmlContent !-} newtype SubjectID = SubjectID Int {-! derive : XmlContent !-} newtype Interest = Interest Score {-! derive : XmlContent !-} newtype Skill = Skill Score {-! derive : XmlContent !-} data Score = ScoreNone | ScoreLow | ScoreMedium | ScoreHigh {-! derive : XmlContent !-} {-* Generated by DrIFT : Look, but Don't Touch. *-} instance Haskell2XmlNew Person where toHType v = Defined "Person" [] [Constr "Person" [] [toHType aa,toHType ab,toHType ac,toHType ad]] where (Person aa ab ac ad) = v parseContents = do { e@(Elem t _ _) <- element ["Person"] ; case t of _ | "Person" `isPrefixOf` t -> interior e $ do { aa <- parseContents ; ab <- parseContents ; ac <- parseContents ; ad <- parseContents ; return (Person aa ab ac ad) } } toContents v@(Person aa ab ac ad) = [mkElemC (showConstr 0 (toHType v)) (concat [toContents aa, toContents ab,toContents ac,toContents ad])] instance Haskell2XmlNew Name where toHType v = Defined "Name" [] [Constr "Name" [] [toHType aa]] where (Name aa) = v parseContents = do { e@(Elem t _ _) <- element ["Name"] ; case t of _ | "Name" `isPrefixOf` t -> interior e $ fmap Name parseContents } toContents v@(Name aa) = [mkElemC (showConstr 0 (toHType v)) (toContents aa)] instance Haskell2XmlNew Email where toHType v = Defined "Email" [] [Constr "Email" [] [toHType aa]] where (Email aa) = v parseContents = do { e@(Elem t _ _) <- element ["Email"] ; case t of _ | "Email" `isPrefixOf` t -> interior e $ fmap Email parseContents } toContents v@(Email aa) = [mkElemC (showConstr 0 (toHType v)) (toContents aa)] instance Haskell2XmlNew Version where toHType v = Defined "Version" [] [Constr "Version" [] [toHType aa]] where (Version aa) = v parseContents = do { e@(Elem t _ _) <- element ["Version"] ; case t of _ | "Version" `isPrefixOf` t -> interior e $ fmap Version parseContents } toContents v@(Version aa) = [mkElemC (showConstr 0 (toHType v)) (toContents aa)] instance Haskell2XmlNew Rating where toHType v = Defined "Rating" [] [Constr "Rating" [] [toHType aa,toHType ab,toHType ac]] where (Rating aa ab ac) = v parseContents = do { e@(Elem t _ _) <- element ["Rating"] ; case t of _ | "Rating" `isPrefixOf` t -> interior e $ do { aa <- parseContents ; ab <- parseContents ; ac <- parseContents ; return (Rating aa ab ac) } } toContents v@(Rating aa ab ac) = [mkElemC (showConstr 0 (toHType v)) (concat [toContents aa, toContents ab,toContents ac])] instance Haskell2XmlNew SubjectID where toHType v = Defined "SubjectID" [] [Constr "SubjectID" [] [toHType aa]] where (SubjectID aa) = v parseContents = do { e@(Elem t _ _) <- element ["SubjectID"] ; case t of _ | "SubjectID" `isPrefixOf` t -> interior e $ fmap SubjectID parseContents } toContents v@(SubjectID aa) = [mkElemC (showConstr 0 (toHType v)) (toContents aa)] instance Haskell2XmlNew Interest where toHType v = Defined "Interest" [] [Constr "Interest" [] [toHType aa]] where (Interest aa) = v parseContents = do { e@(Elem t _ _) <- element ["Interest"] ; case t of _ | "Interest" `isPrefixOf` t -> interior e $ fmap Interest parseContents } toContents v@(Interest aa) = [mkElemC (showConstr 0 (toHType v)) (toContents aa)] instance Haskell2XmlNew Skill where toHType v = Defined "Skill" [] [Constr "Skill" [] [toHType aa]] where (Skill aa) = v parseContents = do { e@(Elem t _ _) <- element ["Skill"] ; case t of _ | "Skill" `isPrefixOf` t -> interior e $ fmap Skill parseContents } toContents v@(Skill aa) = [mkElemC (showConstr 0 (toHType v)) (toContents aa)] instance Haskell2XmlNew Score where toHType v = Defined "Score" [] [Constr "ScoreNone" [] [],Constr "ScoreLow" [] [], Constr "ScoreMedium" [] [],Constr "ScoreHigh" [] []] parseContents = do { e@(Elem t _ _) <- element ["ScoreNone","ScoreLow","ScoreMedium","ScoreHigh"] ; case t of _ | "ScoreNone" `isPrefixOf` t -> interior e $ return ScoreNone | "ScoreMedium" `isPrefixOf` t -> interior e $ return ScoreMedium | "ScoreLow" `isPrefixOf` t -> interior e $ return ScoreLow | "ScoreHigh" `isPrefixOf` t -> interior e $ return ScoreHigh } toContents v@ScoreNone = [mkElemC (showConstr 0 (toHType v)) []] toContents v@ScoreLow = [mkElemC (showConstr 1 (toHType v)) []] toContents v@ScoreMedium = [mkElemC (showConstr 2 (toHType v)) []] toContents v@ScoreHigh = [mkElemC (showConstr 3 (toHType v)) []] -- Imported from other files :- ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/DebugLex.hs���������������������������������������������0000644�0065111�0065111�00000000705�10504340456�021426� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module Main where import System (getArgs) import IO import Text.XML.HaXml.Lex (xmlLex) import Text.XML.HaXml.Wrappers (fix2Args) -- Debug the HaXml library by showing what the lexer generates. main = fix2Args >>= \(inf,outf)-> ( if inf=="-" then getContents else readFile inf ) >>= \content-> ( if outf=="-" then return stdout else openFile outf WriteMode ) >>= \o-> mapM_ ( hPutStrLn o . show ) (xmlLex inf content) �����������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/Example.hs����������������������������������������������0000644�0065111�0065111�00000000521�10504340466�021317� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module Main where import IO import Text.XML.HaXml.XmlContent (fWriteXml) import DTypes rjn = Person (Name "Rob Noble") (Email "rjn") [ Rating (SubjectID 1) (Interest ScoreNone) (Skill ScoreLow), Rating (SubjectID 2) (Interest ScoreMedium) (Skill ScoreHigh)] (Version 1) main :: IO () main = fWriteXml "subjdb.xml" rjn �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/���������������������������������������������������0000755�0065111�0065111�00000000000�10504340456�020135� 5����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL-control.mod�����������������������������������0000644�0065111�0065111�00000004544�10504340456�023067� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ================================================================= --> <!-- SMIL Content Control Module ==================================== --> <!-- file: SMIL-control.mod This is SMIL 2.0. Copyright 2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Author: Jacco van Ossenbruggen, Aaron Cohen Revision: $Id: SMIL-control.mod,v 1.1.1.1 2002/03/19 12:29:23 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Content Control//EN" SYSTEM "SMIL-control.mod" ================================================================= --> <!ENTITY % BasicContentControl.module "INCLUDE"> <![%BasicContentControl.module;[ <!ENTITY % switch.attrib ""> <!ENTITY % switch.content "EMPTY"> <!ENTITY % switch.qname "switch"> <!ELEMENT %switch.qname; %switch.content;> <!ATTLIST %switch.qname; %switch.attrib; %Core.attrib; %I18n.attrib; > ]]> <!-- ========================= CustomTest Elements ========================= --> <!ENTITY % CustomTestAttributes.module "IGNORE"> <![%CustomTestAttributes.module;[ <!ENTITY % customTest.attrib ""> <!ENTITY % customTest.qname "customTest"> <!ENTITY % customTest.content "EMPTY"> <!ELEMENT %customTest.qname; %customTest.content;> <!ATTLIST %customTest.qname; %customTest.attrib; defaultState (true|false) 'false' override (allowed|not-allowed) 'not-allowed' uid %URI; #IMPLIED %Core.attrib; %I18n.attrib; > <!ENTITY % customAttributes.attrib ""> <!ENTITY % customAttributes.qname "customAttributes"> <!ENTITY % customAttributes.content "EMPTY"> <!ELEMENT %customAttributes.qname; %customAttributes.content;> <!ATTLIST %customAttributes.qname; %customAttributes.attrib; %Core.attrib; %I18n.attrib; > ]]> <!-- end of CustomTestAttributes --> <!-- ========================= PrefetchControl Elements ==================== --> <!ENTITY % PrefetchControl.module "IGNORE"> <![%PrefetchControl.module;[ <!ENTITY % prefetch.attrib ""> <!ENTITY % prefetch.qname "prefetch"> <!ENTITY % prefetch.content "EMPTY"> <!ELEMENT %prefetch.qname; %prefetch.content;> <!ATTLIST %prefetch.qname; %prefetch.attrib; mediaSize CDATA #IMPLIED mediaTime CDATA #IMPLIED bandwidth CDATA #IMPLIED %Core.attrib; %I18n.attrib; > ]]> ������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/DTD_SMIL20.hs��������������������������������������0000644�0065111�0065111�00000416310�10504340456�022077� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module DTD_SMIL20 where import Text.XML.HaXml.Xml2Haskell import Text.XML.HaXml.OneOfN {-Type decls-} data Smil = Smil { smilId :: (Maybe String) , smilClass :: (Maybe String) , smilTitle :: (Maybe String) , smilXml'lang :: (Maybe String) , smilXmlns :: (Defaultable String) } deriving (Eq,Show) data Head = Head { headId :: (Maybe String) , headClass :: (Maybe String) , headTitle :: (Maybe String) , headXml'lang :: (Maybe String) } deriving (Eq,Show) data Body = Body { bodyId :: (Maybe String) , bodyClass :: (Maybe String) , bodyTitle :: (Maybe String) , bodyXml'lang :: (Maybe String) } deriving (Eq,Show) data Animate = Animate { animateId :: (Maybe String) , animateClass :: (Maybe String) , animateTitle :: (Maybe String) , animateXml'lang :: (Maybe String) , animateCustomTest :: (Maybe String) , animateSystemBitrate :: (Maybe String) , animateSystemCaptions :: (Maybe Animate_SystemCaptions) , animateSystemLanguage :: (Maybe String) , animateSystemOverdubOrSubtitle :: (Maybe Animate_SystemOverdubOrSubtitle) , animateSystemRequired :: (Maybe String) , animateSystemScreenSize :: (Maybe String) , animateSystemScreenDepth :: (Maybe String) , animateSystemAudioDesc :: (Maybe Animate_SystemAudioDesc) , animateSystemOperatingSystem :: (Maybe String) , animateSystemCPU :: (Maybe String) , animateSystemComponent :: (Maybe String) , animateSystem_bitrate :: (Maybe String) , animateSystem_captions :: (Maybe Animate_System_captions) , animateSystem_language :: (Maybe String) , animateSystem_overdub_or_caption :: (Maybe Animate_System_overdub_or_caption) , animateSystem_required :: (Maybe String) , animateSystem_screen_size :: (Maybe String) , animateSystem_screen_depth :: (Maybe String) , animateDur :: (Maybe String) , animateRepeatCount :: (Maybe String) , animateRepeatDur :: (Maybe String) , animateBegin :: (Maybe String) , animateEnd :: (Maybe String) , animateAttributeName :: String , animateAttributeType :: (Maybe String) , animateValues :: (Maybe String) , animateFrom :: (Maybe String) , animateTo :: (Maybe String) , animateBy :: (Maybe String) , animateCalcMode :: (Defaultable Animate_CalcMode) , animateAdditive :: (Defaultable Animate_Additive) , animateAccumulate :: (Defaultable Animate_Accumulate) } deriving (Eq,Show) data Animate_SystemCaptions = Animate_SystemCaptions_On | Animate_SystemCaptions_Off deriving (Eq,Show) data Animate_SystemOverdubOrSubtitle = Animate_SystemOverdubOrSubtitle_Overdub | Animate_SystemOverdubOrSubtitle_Subtitle deriving (Eq,Show) data Animate_SystemAudioDesc = Animate_SystemAudioDesc_On | Animate_SystemAudioDesc_Off deriving (Eq,Show) data Animate_System_captions = Animate_System_captions_On | Animate_System_captions_Off deriving (Eq,Show) data Animate_System_overdub_or_caption = Animate_System_overdub_or_caption_Overdub | Animate_System_overdub_or_caption_Caption deriving (Eq,Show) data Animate_CalcMode = Animate_CalcMode_Discrete | Animate_CalcMode_Linear | Animate_CalcMode_Paced deriving (Eq,Show) data Animate_Additive = Animate_Additive_Replace | Animate_Additive_Sum deriving (Eq,Show) data Animate_Accumulate = Animate_Accumulate_None | Animate_Accumulate_Sum deriving (Eq,Show) data Set = Set { setId :: (Maybe String) , setClass :: (Maybe String) , setTitle :: (Maybe String) , setXml'lang :: (Maybe String) , setCustomTest :: (Maybe String) , setSystemBitrate :: (Maybe String) , setSystemCaptions :: (Maybe Set_SystemCaptions) , setSystemLanguage :: (Maybe String) , setSystemOverdubOrSubtitle :: (Maybe Set_SystemOverdubOrSubtitle) , setSystemRequired :: (Maybe String) , setSystemScreenSize :: (Maybe String) , setSystemScreenDepth :: (Maybe String) , setSystemAudioDesc :: (Maybe Set_SystemAudioDesc) , setSystemOperatingSystem :: (Maybe String) , setSystemCPU :: (Maybe String) , setSystemComponent :: (Maybe String) , setSystem_bitrate :: (Maybe String) , setSystem_captions :: (Maybe Set_System_captions) , setSystem_language :: (Maybe String) , setSystem_overdub_or_caption :: (Maybe Set_System_overdub_or_caption) , setSystem_required :: (Maybe String) , setSystem_screen_size :: (Maybe String) , setSystem_screen_depth :: (Maybe String) , setDur :: (Maybe String) , setRepeatCount :: (Maybe String) , setRepeatDur :: (Maybe String) , setBegin :: (Maybe String) , setEnd :: (Maybe String) , setAttributeName :: String , setAttributeType :: (Maybe String) , setTo :: (Maybe String) } deriving (Eq,Show) data Set_SystemCaptions = Set_SystemCaptions_On | Set_SystemCaptions_Off deriving (Eq,Show) data Set_SystemOverdubOrSubtitle = Set_SystemOverdubOrSubtitle_Overdub | Set_SystemOverdubOrSubtitle_Subtitle deriving (Eq,Show) data Set_SystemAudioDesc = Set_SystemAudioDesc_On | Set_SystemAudioDesc_Off deriving (Eq,Show) data Set_System_captions = Set_System_captions_On | Set_System_captions_Off deriving (Eq,Show) data Set_System_overdub_or_caption = Set_System_overdub_or_caption_Overdub | Set_System_overdub_or_caption_Caption deriving (Eq,Show) data AnimateMotion = AnimateMotion { animateMotionId :: (Maybe String) , animateMotionClass :: (Maybe String) , animateMotionTitle :: (Maybe String) , animateMotionXml'lang :: (Maybe String) , animateMotionCustomTest :: (Maybe String) , animateMotionSystemBitrate :: (Maybe String) , animateMotionSystemCaptions :: (Maybe AnimateMotion_SystemCaptions) , animateMotionSystemLanguage :: (Maybe String) , animateMotionSystemOverdubOrSubtitle :: (Maybe AnimateMotion_SystemOverdubOrSubtitle) , animateMotionSystemRequired :: (Maybe String) , animateMotionSystemScreenSize :: (Maybe String) , animateMotionSystemScreenDepth :: (Maybe String) , animateMotionSystemAudioDesc :: (Maybe AnimateMotion_SystemAudioDesc) , animateMotionSystemOperatingSystem :: (Maybe String) , animateMotionSystemCPU :: (Maybe String) , animateMotionSystemComponent :: (Maybe String) , animateMotionSystem_bitrate :: (Maybe String) , animateMotionSystem_captions :: (Maybe AnimateMotion_System_captions) , animateMotionSystem_language :: (Maybe String) , animateMotionSystem_overdub_or_caption :: (Maybe AnimateMotion_System_overdub_or_caption) , animateMotionSystem_required :: (Maybe String) , animateMotionSystem_screen_size :: (Maybe String) , animateMotionSystem_screen_depth :: (Maybe String) , animateMotionDur :: (Maybe String) , animateMotionRepeatCount :: (Maybe String) , animateMotionRepeatDur :: (Maybe String) , animateMotionBegin :: (Maybe String) , animateMotionEnd :: (Maybe String) , animateMotionValues :: (Maybe String) , animateMotionFrom :: (Maybe String) , animateMotionTo :: (Maybe String) , animateMotionBy :: (Maybe String) , animateMotionCalcMode :: (Defaultable AnimateMotion_CalcMode) , animateMotionAdditive :: (Defaultable AnimateMotion_Additive) , animateMotionAccumulate :: (Defaultable AnimateMotion_Accumulate) , animateMotionOrigin :: (Defaultable AnimateMotion_Origin) } deriving (Eq,Show) data AnimateMotion_SystemCaptions = AnimateMotion_SystemCaptions_On | AnimateMotion_SystemCaptions_Off deriving (Eq,Show) data AnimateMotion_SystemOverdubOrSubtitle = AnimateMotion_SystemOverdubOrSubtitle_Overdub | AnimateMotion_SystemOverdubOrSubtitle_Subtitle deriving (Eq,Show) data AnimateMotion_SystemAudioDesc = AnimateMotion_SystemAudioDesc_On | AnimateMotion_SystemAudioDesc_Off deriving (Eq,Show) data AnimateMotion_System_captions = AnimateMotion_System_captions_On | AnimateMotion_System_captions_Off deriving (Eq,Show) data AnimateMotion_System_overdub_or_caption = AnimateMotion_System_overdub_or_caption_Overdub | AnimateMotion_System_overdub_or_caption_Caption deriving (Eq,Show) data AnimateMotion_CalcMode = AnimateMotion_CalcMode_Discrete | AnimateMotion_CalcMode_Linear | AnimateMotion_CalcMode_Paced deriving (Eq,Show) data AnimateMotion_Additive = AnimateMotion_Additive_Replace | AnimateMotion_Additive_Sum deriving (Eq,Show) data AnimateMotion_Accumulate = AnimateMotion_Accumulate_None | AnimateMotion_Accumulate_Sum deriving (Eq,Show) data AnimateMotion_Origin = AnimateMotion_Origin_Default deriving (Eq,Show) data AnimateColor = AnimateColor { animateColorId :: (Maybe String) , animateColorClass :: (Maybe String) , animateColorTitle :: (Maybe String) , animateColorXml'lang :: (Maybe String) , animateColorCustomTest :: (Maybe String) , animateColorSystemBitrate :: (Maybe String) , animateColorSystemCaptions :: (Maybe AnimateColor_SystemCaptions) , animateColorSystemLanguage :: (Maybe String) , animateColorSystemOverdubOrSubtitle :: (Maybe AnimateColor_SystemOverdubOrSubtitle) , animateColorSystemRequired :: (Maybe String) , animateColorSystemScreenSize :: (Maybe String) , animateColorSystemScreenDepth :: (Maybe String) , animateColorSystemAudioDesc :: (Maybe AnimateColor_SystemAudioDesc) , animateColorSystemOperatingSystem :: (Maybe String) , animateColorSystemCPU :: (Maybe String) , animateColorSystemComponent :: (Maybe String) , animateColorSystem_bitrate :: (Maybe String) , animateColorSystem_captions :: (Maybe AnimateColor_System_captions) , animateColorSystem_language :: (Maybe String) , animateColorSystem_overdub_or_caption :: (Maybe AnimateColor_System_overdub_or_caption) , animateColorSystem_required :: (Maybe String) , animateColorSystem_screen_size :: (Maybe String) , animateColorSystem_screen_depth :: (Maybe String) , animateColorDur :: (Maybe String) , animateColorRepeatCount :: (Maybe String) , animateColorRepeatDur :: (Maybe String) , animateColorBegin :: (Maybe String) , animateColorEnd :: (Maybe String) , animateColorAttributeName :: String , animateColorAttributeType :: (Maybe String) , animateColorValues :: (Maybe String) , animateColorFrom :: (Maybe String) , animateColorTo :: (Maybe String) , animateColorBy :: (Maybe String) , animateColorCalcMode :: (Defaultable AnimateColor_CalcMode) , animateColorAdditive :: (Defaultable AnimateColor_Additive) , animateColorAccumulate :: (Defaultable AnimateColor_Accumulate) } deriving (Eq,Show) data AnimateColor_SystemCaptions = AnimateColor_SystemCaptions_On | AnimateColor_SystemCaptions_Off deriving (Eq,Show) data AnimateColor_SystemOverdubOrSubtitle = AnimateColor_SystemOverdubOrSubtitle_Overdub | AnimateColor_SystemOverdubOrSubtitle_Subtitle deriving (Eq,Show) data AnimateColor_SystemAudioDesc = AnimateColor_SystemAudioDesc_On | AnimateColor_SystemAudioDesc_Off deriving (Eq,Show) data AnimateColor_System_captions = AnimateColor_System_captions_On | AnimateColor_System_captions_Off deriving (Eq,Show) data AnimateColor_System_overdub_or_caption = AnimateColor_System_overdub_or_caption_Overdub | AnimateColor_System_overdub_or_caption_Caption deriving (Eq,Show) data AnimateColor_CalcMode = AnimateColor_CalcMode_Discrete | AnimateColor_CalcMode_Linear | AnimateColor_CalcMode_Paced deriving (Eq,Show) data AnimateColor_Additive = AnimateColor_Additive_Replace | AnimateColor_Additive_Sum deriving (Eq,Show) data AnimateColor_Accumulate = AnimateColor_Accumulate_None | AnimateColor_Accumulate_Sum deriving (Eq,Show) data Switch = Switch { switchId :: (Maybe String) , switchClass :: (Maybe String) , switchTitle :: (Maybe String) , switchXml'lang :: (Maybe String) } deriving (Eq,Show) data Meta = Meta { metaContent :: (Maybe String) , metaName :: String } deriving (Eq,Show) data Metadata = Metadata { metadataId :: (Maybe String) , metadataClass :: (Maybe String) , metadataTitle :: (Maybe String) , metadataXml'lang :: (Maybe String) } deriving (Eq,Show) data Layout = Layout { layoutId :: (Maybe String) , layoutClass :: (Maybe String) , layoutTitle :: (Maybe String) , layoutXml'lang :: (Maybe String) , layoutType :: (Defaultable String) } deriving (Eq,Show) data Region = Region { regionId :: (Maybe String) , regionClass :: (Maybe String) , regionTitle :: (Maybe String) , regionXml'lang :: (Maybe String) , regionHeight :: (Defaultable String) , regionWidth :: (Defaultable String) , regionClose :: (Defaultable Region_Close) , regionOpen :: (Defaultable Region_Open) , regionBackgroundColor :: (Maybe String) , regionBackground_color :: (Maybe String) , regionBottom :: (Defaultable String) , regionLeft :: (Defaultable String) , regionRight :: (Defaultable String) , regionTop :: (Defaultable String) , regionZ_index :: (Maybe String) , regionShowBackground :: (Defaultable Region_ShowBackground) , regionFit :: (Defaultable Region_Fit) } deriving (Eq,Show) data Region_Close = Region_Close_Never | Region_Close_WhenNotActive deriving (Eq,Show) data Region_Open = Region_Open_Always | Region_Open_WhenActive deriving (Eq,Show) data Region_ShowBackground = Region_ShowBackground_Always | Region_ShowBackground_WhenActive deriving (Eq,Show) data Region_Fit = Region_Fit_Hidden | Region_Fit_Fill | Region_Fit_Meet | Region_Fit_Scroll | Region_Fit_Slice deriving (Eq,Show) data Root_layout = Root_layout { root_layoutId :: (Maybe String) , root_layoutClass :: (Maybe String) , root_layoutTitle :: (Maybe String) , root_layoutXml'lang :: (Maybe String) , root_layoutHeight :: (Defaultable String) , root_layoutWidth :: (Defaultable String) , root_layoutClose :: (Defaultable Root_layout_Close) , root_layoutOpen :: (Defaultable Root_layout_Open) , root_layoutBackgroundColor :: (Maybe String) , root_layoutBackground_color :: (Maybe String) } deriving (Eq,Show) data Root_layout_Close = Root_layout_Close_Never | Root_layout_Close_WhenNotActive deriving (Eq,Show) data Root_layout_Open = Root_layout_Open_Always | Root_layout_Open_WhenActive deriving (Eq,Show) data Ref = Ref { refId :: (Maybe String) , refClass :: (Maybe String) , refTitle :: (Maybe String) , refXml'lang :: (Maybe String) } deriving (Eq,Show) data Audio = Audio { audioId :: (Maybe String) , audioClass :: (Maybe String) , audioTitle :: (Maybe String) , audioXml'lang :: (Maybe String) } deriving (Eq,Show) data Img = Img { imgId :: (Maybe String) , imgClass :: (Maybe String) , imgTitle :: (Maybe String) , imgXml'lang :: (Maybe String) } deriving (Eq,Show) data Video = Video { videoId :: (Maybe String) , videoClass :: (Maybe String) , videoTitle :: (Maybe String) , videoXml'lang :: (Maybe String) } deriving (Eq,Show) data Text = Text { textId :: (Maybe String) , textClass :: (Maybe String) , textTitle :: (Maybe String) , textXml'lang :: (Maybe String) } deriving (Eq,Show) data Textstream = Textstream { textstreamId :: (Maybe String) , textstreamClass :: (Maybe String) , textstreamTitle :: (Maybe String) , textstreamXml'lang :: (Maybe String) } deriving (Eq,Show) data Animation = Animation { animationId :: (Maybe String) , animationClass :: (Maybe String) , animationTitle :: (Maybe String) , animationXml'lang :: (Maybe String) } deriving (Eq,Show) data Transition = Transition { transitionId :: (Maybe String) , transitionClass :: (Maybe String) , transitionTitle :: (Maybe String) , transitionXml'lang :: (Maybe String) , transitionType :: (Maybe Transition_Type) , transitionSubtype :: (Maybe Transition_Subtype) , transitionHorzRepeat :: (Defaultable String) , transitionVertRepeat :: (Defaultable String) , transitionBorderWidth :: (Defaultable String) , transitionBorderColor :: (Defaultable String) , transitionFadeColor :: (Defaultable String) , transitionCoordinated :: (Defaultable Transition_Coordinated) , transitionClibBoundary :: (Defaultable Transition_ClibBoundary) , transitionDur :: (Maybe String) , transitionStartProgress :: (Defaultable String) , transitionEndProgress :: (Defaultable String) , transitionDirection :: (Defaultable Transition_Direction) } deriving (Eq,Show) data Transition_Type = Transition_Type_BarWipe | Transition_Type_BoxWipe | Transition_Type_FourBoxWipe | Transition_Type_BarnDoorWipe | Transition_Type_DiagonalWipe | Transition_Type_BowTieWipe | Transition_Type_MiscDiagonalWipe | Transition_Type_VeeWipe | Transition_Type_BarnVeeWipe | Transition_Type_ZigZagWipe | Transition_Type_BarnZigZagWipe | Transition_Type_MiscShapeWipe | Transition_Type_TriangleWipe | Transition_Type_ArrowHeadWipe | Transition_Type_PentagonWipe | Transition_Type_HexagonWipe | Transition_Type_EllipseWipe | Transition_Type_EyeWipe | Transition_Type_RoundRectWipe | Transition_Type_StarWipe | Transition_Type_ClockWipe | Transition_Type_PinWheelWipe | Transition_Type_SingleSweepWipe | Transition_Type_FanWipe | Transition_Type_DoubleFanWipe | Transition_Type_DoubleSweepWipe | Transition_Type_SaloonDoorWipe | Transition_Type_WindshieldWipe | Transition_Type_SnakeWipe | Transition_Type_SpiralWipe | Transition_Type_ParallelSnakesWipe | Transition_Type_BoxSnakesWipe | Transition_Type_WaterfallWipe | Transition_Type_PushWipe | Transition_Type_SlideWipe | Transition_Type_Fade deriving (Eq,Show) data Transition_Subtype = Transition_Subtype_Bottom | Transition_Subtype_BottomCenter | Transition_Subtype_BottomLeft | Transition_Subtype_BottomLeftClockwise | Transition_Subtype_BottomLeftCounterClockwise | Transition_Subtype_BottomLeftDiagonal | Transition_Subtype_BottomRight | Transition_Subtype_BottomRightClockwise | Transition_Subtype_BottomRightCounterClockwise | Transition_Subtype_BottomRightDiagonal | Transition_Subtype_CenterRight | Transition_Subtype_CenterTop | Transition_Subtype_Circle | Transition_Subtype_ClockwiseBottom | Transition_Subtype_ClockwiseBottomRight | Transition_Subtype_ClockwiseLeft | Transition_Subtype_ClockwiseNine | Transition_Subtype_ClockwiseRight | Transition_Subtype_ClockwiseSix | Transition_Subtype_ClockwiseThree | Transition_Subtype_ClockwiseTop | Transition_Subtype_ClockwiseTopLeft | Transition_Subtype_ClockwiseTwelve | Transition_Subtype_CornersIn | Transition_Subtype_CornersOut | Transition_Subtype_CounterClockwiseBottomLeft | Transition_Subtype_CounterClockwiseTopRight | Transition_Subtype_Crossfade | Transition_Subtype_DiagonalBottomLeft | Transition_Subtype_DiagonalBottomLeftOpposite | Transition_Subtype_DiagonalTopLeft | Transition_Subtype_DiagonalTopLeftOpposite | Transition_Subtype_Diamond | Transition_Subtype_DoubleBarnDoor | Transition_Subtype_DoubleDiamond | Transition_Subtype_Down | Transition_Subtype_FadeFromColor | Transition_Subtype_FadeToColor | Transition_Subtype_FanInHorizontal | Transition_Subtype_FanInVertical | Transition_Subtype_FanOutHorizontal | Transition_Subtype_FanOutVertical | Transition_Subtype_FivePoint | Transition_Subtype_FourBlade | Transition_Subtype_FourBoxHorizontal | Transition_Subtype_FourBoxVertical | Transition_Subtype_FourPoint | Transition_Subtype_FromBottom | Transition_Subtype_FromLeft | Transition_Subtype_FromRight | Transition_Subtype_FromTop | Transition_Subtype_Heart | Transition_Subtype_Horizontal | Transition_Subtype_HorizontalLeft | Transition_Subtype_HorizontalLeftSame | Transition_Subtype_HorizontalRight | Transition_Subtype_HorizontalRightSame | Transition_Subtype_HorizontalTopLeftOpposite | Transition_Subtype_HorizontalTopRightOpposite | Transition_Subtype_Keyhole | Transition_Subtype_Left | Transition_Subtype_LeftCenter | Transition_Subtype_LeftToRight | Transition_Subtype_OppositeHorizontal | Transition_Subtype_OppositeVertical | Transition_Subtype_ParallelDiagonal | Transition_Subtype_ParallelDiagonalBottomLeft | Transition_Subtype_ParallelDiagonalTopLeft | Transition_Subtype_ParallelVertical | Transition_Subtype_Rectangle | Transition_Subtype_Right | Transition_Subtype_RightCenter | Transition_Subtype_SixPoint | Transition_Subtype_Top | Transition_Subtype_TopCenter | Transition_Subtype_TopLeft | Transition_Subtype_TopLeftClockwise | Transition_Subtype_TopLeftCounterClockwise | Transition_Subtype_TopLeftDiagonal | Transition_Subtype_TopLeftHorizontal | Transition_Subtype_TopLeftVertical | Transition_Subtype_TopRight | Transition_Subtype_TopRightClockwise | Transition_Subtype_TopRightCounterClockwise | Transition_Subtype_TopRightDiagonal | Transition_Subtype_TopToBottom | Transition_Subtype_TwoBladeHorizontal | Transition_Subtype_TwoBladeVertical | Transition_Subtype_TwoBoxBottom | Transition_Subtype_TwoBoxLeft | Transition_Subtype_TwoBoxRight | Transition_Subtype_TwoBoxTop | Transition_Subtype_Up | Transition_Subtype_Vertical | Transition_Subtype_VerticalBottomLeftOpposite | Transition_Subtype_VerticalBottomSame | Transition_Subtype_VerticalLeft | Transition_Subtype_VerticalRight | Transition_Subtype_VerticalTopLeftOpposite | Transition_Subtype_VerticalTopSame deriving (Eq,Show) data Transition_Coordinated = Transition_Coordinated_True | Transition_Coordinated_False deriving (Eq,Show) data Transition_ClibBoundary = Transition_ClibBoundary_Parent | Transition_ClibBoundary_Children deriving (Eq,Show) data Transition_Direction = Transition_Direction_Forward | Transition_Direction_Reverse deriving (Eq,Show) data TransitionFilter = TransitionFilter { transitionFilterId :: (Maybe String) , transitionFilterClass :: (Maybe String) , transitionFilterTitle :: (Maybe String) , transitionFilterXml'lang :: (Maybe String) , transitionFilterType :: (Maybe TransitionFilter_Type) , transitionFilterSubtype :: (Maybe TransitionFilter_Subtype) , transitionFilterHorzRepeat :: (Defaultable String) , transitionFilterVertRepeat :: (Defaultable String) , transitionFilterBorderWidth :: (Defaultable String) , transitionFilterBorderColor :: (Defaultable String) , transitionFilterFadeColor :: (Defaultable String) , transitionFilterCoordinated :: (Defaultable TransitionFilter_Coordinated) , transitionFilterClibBoundary :: (Defaultable TransitionFilter_ClibBoundary) , transitionFilterDur :: (Maybe String) , transitionFilterRepeatCount :: (Maybe String) , transitionFilterRepeatDur :: (Maybe String) , transitionFilterBegin :: (Maybe String) , transitionFilterEnd :: (Maybe String) , transitionFilterValues :: (Maybe String) , transitionFilterFrom :: (Maybe String) , transitionFilterTo :: (Maybe String) , transitionFilterBy :: (Maybe String) , transitionFilterCalcMode :: (Defaultable TransitionFilter_CalcMode) } deriving (Eq,Show) data TransitionFilter_Type = TransitionFilter_Type_BarWipe | TransitionFilter_Type_BoxWipe | TransitionFilter_Type_FourBoxWipe | TransitionFilter_Type_BarnDoorWipe | TransitionFilter_Type_DiagonalWipe | TransitionFilter_Type_BowTieWipe | TransitionFilter_Type_MiscDiagonalWipe | TransitionFilter_Type_VeeWipe | TransitionFilter_Type_BarnVeeWipe | TransitionFilter_Type_ZigZagWipe | TransitionFilter_Type_BarnZigZagWipe | TransitionFilter_Type_MiscShapeWipe | TransitionFilter_Type_TriangleWipe | TransitionFilter_Type_ArrowHeadWipe | TransitionFilter_Type_PentagonWipe | TransitionFilter_Type_HexagonWipe | TransitionFilter_Type_EllipseWipe | TransitionFilter_Type_EyeWipe | TransitionFilter_Type_RoundRectWipe | TransitionFilter_Type_StarWipe | TransitionFilter_Type_ClockWipe | TransitionFilter_Type_PinWheelWipe | TransitionFilter_Type_SingleSweepWipe | TransitionFilter_Type_FanWipe | TransitionFilter_Type_DoubleFanWipe | TransitionFilter_Type_DoubleSweepWipe | TransitionFilter_Type_SaloonDoorWipe | TransitionFilter_Type_WindshieldWipe | TransitionFilter_Type_SnakeWipe | TransitionFilter_Type_SpiralWipe | TransitionFilter_Type_ParallelSnakesWipe | TransitionFilter_Type_BoxSnakesWipe | TransitionFilter_Type_WaterfallWipe | TransitionFilter_Type_PushWipe | TransitionFilter_Type_SlideWipe | TransitionFilter_Type_Fade deriving (Eq,Show) data TransitionFilter_Subtype = TransitionFilter_Subtype_Bottom | TransitionFilter_Subtype_BottomCenter | TransitionFilter_Subtype_BottomLeft | TransitionFilter_Subtype_BottomLeftClockwise | TransitionFilter_Subtype_BottomLeftCounterClockwise | TransitionFilter_Subtype_BottomLeftDiagonal | TransitionFilter_Subtype_BottomRight | TransitionFilter_Subtype_BottomRightClockwise | TransitionFilter_Subtype_BottomRightCounterClockwise | TransitionFilter_Subtype_BottomRightDiagonal | TransitionFilter_Subtype_CenterRight | TransitionFilter_Subtype_CenterTop | TransitionFilter_Subtype_Circle | TransitionFilter_Subtype_ClockwiseBottom | TransitionFilter_Subtype_ClockwiseBottomRight | TransitionFilter_Subtype_ClockwiseLeft | TransitionFilter_Subtype_ClockwiseNine | TransitionFilter_Subtype_ClockwiseRight | TransitionFilter_Subtype_ClockwiseSix | TransitionFilter_Subtype_ClockwiseThree | TransitionFilter_Subtype_ClockwiseTop | TransitionFilter_Subtype_ClockwiseTopLeft | TransitionFilter_Subtype_ClockwiseTwelve | TransitionFilter_Subtype_CornersIn | TransitionFilter_Subtype_CornersOut | TransitionFilter_Subtype_CounterClockwiseBottomLeft | TransitionFilter_Subtype_CounterClockwiseTopRight | TransitionFilter_Subtype_Crossfade | TransitionFilter_Subtype_DiagonalBottomLeft | TransitionFilter_Subtype_DiagonalBottomLeftOpposite | TransitionFilter_Subtype_DiagonalTopLeft | TransitionFilter_Subtype_DiagonalTopLeftOpposite | TransitionFilter_Subtype_Diamond | TransitionFilter_Subtype_DoubleBarnDoor | TransitionFilter_Subtype_DoubleDiamond | TransitionFilter_Subtype_Down | TransitionFilter_Subtype_FadeFromColor | TransitionFilter_Subtype_FadeToColor | TransitionFilter_Subtype_FanInHorizontal | TransitionFilter_Subtype_FanInVertical | TransitionFilter_Subtype_FanOutHorizontal | TransitionFilter_Subtype_FanOutVertical | TransitionFilter_Subtype_FivePoint | TransitionFilter_Subtype_FourBlade | TransitionFilter_Subtype_FourBoxHorizontal | TransitionFilter_Subtype_FourBoxVertical | TransitionFilter_Subtype_FourPoint | TransitionFilter_Subtype_FromBottom | TransitionFilter_Subtype_FromLeft | TransitionFilter_Subtype_FromRight | TransitionFilter_Subtype_FromTop | TransitionFilter_Subtype_Heart | TransitionFilter_Subtype_Horizontal | TransitionFilter_Subtype_HorizontalLeft | TransitionFilter_Subtype_HorizontalLeftSame | TransitionFilter_Subtype_HorizontalRight | TransitionFilter_Subtype_HorizontalRightSame | TransitionFilter_Subtype_HorizontalTopLeftOpposite | TransitionFilter_Subtype_HorizontalTopRightOpposite | TransitionFilter_Subtype_Keyhole | TransitionFilter_Subtype_Left | TransitionFilter_Subtype_LeftCenter | TransitionFilter_Subtype_LeftToRight | TransitionFilter_Subtype_OppositeHorizontal | TransitionFilter_Subtype_OppositeVertical | TransitionFilter_Subtype_ParallelDiagonal | TransitionFilter_Subtype_ParallelDiagonalBottomLeft | TransitionFilter_Subtype_ParallelDiagonalTopLeft | TransitionFilter_Subtype_ParallelVertical | TransitionFilter_Subtype_Rectangle | TransitionFilter_Subtype_Right | TransitionFilter_Subtype_RightCenter | TransitionFilter_Subtype_SixPoint | TransitionFilter_Subtype_Top | TransitionFilter_Subtype_TopCenter | TransitionFilter_Subtype_TopLeft | TransitionFilter_Subtype_TopLeftClockwise | TransitionFilter_Subtype_TopLeftCounterClockwise | TransitionFilter_Subtype_TopLeftDiagonal | TransitionFilter_Subtype_TopLeftHorizontal | TransitionFilter_Subtype_TopLeftVertical | TransitionFilter_Subtype_TopRight | TransitionFilter_Subtype_TopRightClockwise | TransitionFilter_Subtype_TopRightCounterClockwise | TransitionFilter_Subtype_TopRightDiagonal | TransitionFilter_Subtype_TopToBottom | TransitionFilter_Subtype_TwoBladeHorizontal | TransitionFilter_Subtype_TwoBladeVertical | TransitionFilter_Subtype_TwoBoxBottom | TransitionFilter_Subtype_TwoBoxLeft | TransitionFilter_Subtype_TwoBoxRight | TransitionFilter_Subtype_TwoBoxTop | TransitionFilter_Subtype_Up | TransitionFilter_Subtype_Vertical | TransitionFilter_Subtype_VerticalBottomLeftOpposite | TransitionFilter_Subtype_VerticalBottomSame | TransitionFilter_Subtype_VerticalLeft | TransitionFilter_Subtype_VerticalRight | TransitionFilter_Subtype_VerticalTopLeftOpposite | TransitionFilter_Subtype_VerticalTopSame deriving (Eq,Show) data TransitionFilter_Coordinated = TransitionFilter_Coordinated_True | TransitionFilter_Coordinated_False deriving (Eq,Show) data TransitionFilter_ClibBoundary = TransitionFilter_ClibBoundary_Parent | TransitionFilter_ClibBoundary_Children deriving (Eq,Show) data TransitionFilter_CalcMode = TransitionFilter_CalcMode_Discrete | TransitionFilter_CalcMode_Linear | TransitionFilter_CalcMode_Paced deriving (Eq,Show) {-Instance decls-} instance XmlContent Smil where fromElem (CElem (Elem "smil" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "smil" (toAttrs as) [])] instance XmlAttributes Smil where fromAttrs as = Smil { smilId = possibleA fromAttrToStr "id" as , smilClass = possibleA fromAttrToStr "class" as , smilTitle = possibleA fromAttrToStr "title" as , smilXml'lang = possibleA fromAttrToStr "xml:lang" as , smilXmlns = defaultA fromAttrToStr "http://www.w3.org/TR/REC-smil/SMIL20" "xmlns" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (smilId v) , maybeToAttr toAttrFrStr "class" (smilClass v) , maybeToAttr toAttrFrStr "title" (smilTitle v) , maybeToAttr toAttrFrStr "xml:lang" (smilXml'lang v) , defaultToAttr toAttrFrStr "xmlns" (smilXmlns v) ] instance XmlContent Head where fromElem (CElem (Elem "head" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "head" (toAttrs as) [])] instance XmlAttributes Head where fromAttrs as = Head { headId = possibleA fromAttrToStr "id" as , headClass = possibleA fromAttrToStr "class" as , headTitle = possibleA fromAttrToStr "title" as , headXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (headId v) , maybeToAttr toAttrFrStr "class" (headClass v) , maybeToAttr toAttrFrStr "title" (headTitle v) , maybeToAttr toAttrFrStr "xml:lang" (headXml'lang v) ] instance XmlContent Body where fromElem (CElem (Elem "body" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "body" (toAttrs as) [])] instance XmlAttributes Body where fromAttrs as = Body { bodyId = possibleA fromAttrToStr "id" as , bodyClass = possibleA fromAttrToStr "class" as , bodyTitle = possibleA fromAttrToStr "title" as , bodyXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (bodyId v) , maybeToAttr toAttrFrStr "class" (bodyClass v) , maybeToAttr toAttrFrStr "title" (bodyTitle v) , maybeToAttr toAttrFrStr "xml:lang" (bodyXml'lang v) ] instance XmlContent Animate where fromElem (CElem (Elem "animate" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "animate" (toAttrs as) [])] instance XmlAttributes Animate where fromAttrs as = Animate { animateId = possibleA fromAttrToStr "id" as , animateClass = possibleA fromAttrToStr "class" as , animateTitle = possibleA fromAttrToStr "title" as , animateXml'lang = possibleA fromAttrToStr "xml:lang" as , animateCustomTest = possibleA fromAttrToStr "customTest" as , animateSystemBitrate = possibleA fromAttrToStr "systemBitrate" as , animateSystemCaptions = possibleA fromAttrToTyp "systemCaptions" as , animateSystemLanguage = possibleA fromAttrToStr "systemLanguage" as , animateSystemOverdubOrSubtitle = possibleA fromAttrToTyp "systemOverdubOrSubtitle" as , animateSystemRequired = possibleA fromAttrToStr "systemRequired" as , animateSystemScreenSize = possibleA fromAttrToStr "systemScreenSize" as , animateSystemScreenDepth = possibleA fromAttrToStr "systemScreenDepth" as , animateSystemAudioDesc = possibleA fromAttrToTyp "systemAudioDesc" as , animateSystemOperatingSystem = possibleA fromAttrToStr "systemOperatingSystem" as , animateSystemCPU = possibleA fromAttrToStr "systemCPU" as , animateSystemComponent = possibleA fromAttrToStr "systemComponent" as , animateSystem_bitrate = possibleA fromAttrToStr "system-bitrate" as , animateSystem_captions = possibleA fromAttrToTyp "system-captions" as , animateSystem_language = possibleA fromAttrToStr "system-language" as , animateSystem_overdub_or_caption = possibleA fromAttrToTyp "system-overdub-or-caption" as , animateSystem_required = possibleA fromAttrToStr "system-required" as , animateSystem_screen_size = possibleA fromAttrToStr "system-screen-size" as , animateSystem_screen_depth = possibleA fromAttrToStr "system-screen-depth" as , animateDur = possibleA fromAttrToStr "dur" as , animateRepeatCount = possibleA fromAttrToStr "repeatCount" as , animateRepeatDur = possibleA fromAttrToStr "repeatDur" as , animateBegin = possibleA fromAttrToStr "begin" as , animateEnd = possibleA fromAttrToStr "end" as , animateAttributeName = definiteA fromAttrToStr "animate" "attributeName" as , animateAttributeType = possibleA fromAttrToStr "attributeType" as , animateValues = possibleA fromAttrToStr "values" as , animateFrom = possibleA fromAttrToStr "from" as , animateTo = possibleA fromAttrToStr "to" as , animateBy = possibleA fromAttrToStr "by" as , animateCalcMode = defaultA fromAttrToTyp Animate_CalcMode_Linear "calcMode" as , animateAdditive = defaultA fromAttrToTyp Animate_Additive_Replace "additive" as , animateAccumulate = defaultA fromAttrToTyp Animate_Accumulate_None "accumulate" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (animateId v) , maybeToAttr toAttrFrStr "class" (animateClass v) , maybeToAttr toAttrFrStr "title" (animateTitle v) , maybeToAttr toAttrFrStr "xml:lang" (animateXml'lang v) , maybeToAttr toAttrFrStr "customTest" (animateCustomTest v) , maybeToAttr toAttrFrStr "systemBitrate" (animateSystemBitrate v) , maybeToAttr toAttrFrTyp "systemCaptions" (animateSystemCaptions v) , maybeToAttr toAttrFrStr "systemLanguage" (animateSystemLanguage v) , maybeToAttr toAttrFrTyp "systemOverdubOrSubtitle" (animateSystemOverdubOrSubtitle v) , maybeToAttr toAttrFrStr "systemRequired" (animateSystemRequired v) , maybeToAttr toAttrFrStr "systemScreenSize" (animateSystemScreenSize v) , maybeToAttr toAttrFrStr "systemScreenDepth" (animateSystemScreenDepth v) , maybeToAttr toAttrFrTyp "systemAudioDesc" (animateSystemAudioDesc v) , maybeToAttr toAttrFrStr "systemOperatingSystem" (animateSystemOperatingSystem v) , maybeToAttr toAttrFrStr "systemCPU" (animateSystemCPU v) , maybeToAttr toAttrFrStr "systemComponent" (animateSystemComponent v) , maybeToAttr toAttrFrStr "system-bitrate" (animateSystem_bitrate v) , maybeToAttr toAttrFrTyp "system-captions" (animateSystem_captions v) , maybeToAttr toAttrFrStr "system-language" (animateSystem_language v) , maybeToAttr toAttrFrTyp "system-overdub-or-caption" (animateSystem_overdub_or_caption v) , maybeToAttr toAttrFrStr "system-required" (animateSystem_required v) , maybeToAttr toAttrFrStr "system-screen-size" (animateSystem_screen_size v) , maybeToAttr toAttrFrStr "system-screen-depth" (animateSystem_screen_depth v) , maybeToAttr toAttrFrStr "dur" (animateDur v) , maybeToAttr toAttrFrStr "repeatCount" (animateRepeatCount v) , maybeToAttr toAttrFrStr "repeatDur" (animateRepeatDur v) , maybeToAttr toAttrFrStr "begin" (animateBegin v) , maybeToAttr toAttrFrStr "end" (animateEnd v) , toAttrFrStr "attributeName" (animateAttributeName v) , maybeToAttr toAttrFrStr "attributeType" (animateAttributeType v) , maybeToAttr toAttrFrStr "values" (animateValues v) , maybeToAttr toAttrFrStr "from" (animateFrom v) , maybeToAttr toAttrFrStr "to" (animateTo v) , maybeToAttr toAttrFrStr "by" (animateBy v) , defaultToAttr toAttrFrTyp "calcMode" (animateCalcMode v) , defaultToAttr toAttrFrTyp "additive" (animateAdditive v) , defaultToAttr toAttrFrTyp "accumulate" (animateAccumulate v) ] instance XmlAttrType Animate_SystemCaptions where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just Animate_SystemCaptions_On translate "off" = Just Animate_SystemCaptions_Off translate _ = Nothing toAttrFrTyp n Animate_SystemCaptions_On = Just (n, str2attr "on") toAttrFrTyp n Animate_SystemCaptions_Off = Just (n, str2attr "off") instance XmlAttrType Animate_SystemOverdubOrSubtitle where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "overdub" = Just Animate_SystemOverdubOrSubtitle_Overdub translate "subtitle" = Just Animate_SystemOverdubOrSubtitle_Subtitle translate _ = Nothing toAttrFrTyp n Animate_SystemOverdubOrSubtitle_Overdub = Just (n, str2attr "overdub") toAttrFrTyp n Animate_SystemOverdubOrSubtitle_Subtitle = Just (n, str2attr "subtitle") instance XmlAttrType Animate_SystemAudioDesc where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just Animate_SystemAudioDesc_On translate "off" = Just Animate_SystemAudioDesc_Off translate _ = Nothing toAttrFrTyp n Animate_SystemAudioDesc_On = Just (n, str2attr "on") toAttrFrTyp n Animate_SystemAudioDesc_Off = Just (n, str2attr "off") instance XmlAttrType Animate_System_captions where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just Animate_System_captions_On translate "off" = Just Animate_System_captions_Off translate _ = Nothing toAttrFrTyp n Animate_System_captions_On = Just (n, str2attr "on") toAttrFrTyp n Animate_System_captions_Off = Just (n, str2attr "off") instance XmlAttrType Animate_System_overdub_or_caption where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "overdub" = Just Animate_System_overdub_or_caption_Overdub translate "caption" = Just Animate_System_overdub_or_caption_Caption translate _ = Nothing toAttrFrTyp n Animate_System_overdub_or_caption_Overdub = Just (n, str2attr "overdub") toAttrFrTyp n Animate_System_overdub_or_caption_Caption = Just (n, str2attr "caption") instance XmlAttrType Animate_CalcMode where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "discrete" = Just Animate_CalcMode_Discrete translate "linear" = Just Animate_CalcMode_Linear translate "paced" = Just Animate_CalcMode_Paced translate _ = Nothing toAttrFrTyp n Animate_CalcMode_Discrete = Just (n, str2attr "discrete") toAttrFrTyp n Animate_CalcMode_Linear = Just (n, str2attr "linear") toAttrFrTyp n Animate_CalcMode_Paced = Just (n, str2attr "paced") instance XmlAttrType Animate_Additive where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "replace" = Just Animate_Additive_Replace translate "sum" = Just Animate_Additive_Sum translate _ = Nothing toAttrFrTyp n Animate_Additive_Replace = Just (n, str2attr "replace") toAttrFrTyp n Animate_Additive_Sum = Just (n, str2attr "sum") instance XmlAttrType Animate_Accumulate where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "none" = Just Animate_Accumulate_None translate "sum" = Just Animate_Accumulate_Sum translate _ = Nothing toAttrFrTyp n Animate_Accumulate_None = Just (n, str2attr "none") toAttrFrTyp n Animate_Accumulate_Sum = Just (n, str2attr "sum") instance XmlContent Set where fromElem (CElem (Elem "set" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "set" (toAttrs as) [])] instance XmlAttributes Set where fromAttrs as = Set { setId = possibleA fromAttrToStr "id" as , setClass = possibleA fromAttrToStr "class" as , setTitle = possibleA fromAttrToStr "title" as , setXml'lang = possibleA fromAttrToStr "xml:lang" as , setCustomTest = possibleA fromAttrToStr "customTest" as , setSystemBitrate = possibleA fromAttrToStr "systemBitrate" as , setSystemCaptions = possibleA fromAttrToTyp "systemCaptions" as , setSystemLanguage = possibleA fromAttrToStr "systemLanguage" as , setSystemOverdubOrSubtitle = possibleA fromAttrToTyp "systemOverdubOrSubtitle" as , setSystemRequired = possibleA fromAttrToStr "systemRequired" as , setSystemScreenSize = possibleA fromAttrToStr "systemScreenSize" as , setSystemScreenDepth = possibleA fromAttrToStr "systemScreenDepth" as , setSystemAudioDesc = possibleA fromAttrToTyp "systemAudioDesc" as , setSystemOperatingSystem = possibleA fromAttrToStr "systemOperatingSystem" as , setSystemCPU = possibleA fromAttrToStr "systemCPU" as , setSystemComponent = possibleA fromAttrToStr "systemComponent" as , setSystem_bitrate = possibleA fromAttrToStr "system-bitrate" as , setSystem_captions = possibleA fromAttrToTyp "system-captions" as , setSystem_language = possibleA fromAttrToStr "system-language" as , setSystem_overdub_or_caption = possibleA fromAttrToTyp "system-overdub-or-caption" as , setSystem_required = possibleA fromAttrToStr "system-required" as , setSystem_screen_size = possibleA fromAttrToStr "system-screen-size" as , setSystem_screen_depth = possibleA fromAttrToStr "system-screen-depth" as , setDur = possibleA fromAttrToStr "dur" as , setRepeatCount = possibleA fromAttrToStr "repeatCount" as , setRepeatDur = possibleA fromAttrToStr "repeatDur" as , setBegin = possibleA fromAttrToStr "begin" as , setEnd = possibleA fromAttrToStr "end" as , setAttributeName = definiteA fromAttrToStr "set" "attributeName" as , setAttributeType = possibleA fromAttrToStr "attributeType" as , setTo = possibleA fromAttrToStr "to" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (setId v) , maybeToAttr toAttrFrStr "class" (setClass v) , maybeToAttr toAttrFrStr "title" (setTitle v) , maybeToAttr toAttrFrStr "xml:lang" (setXml'lang v) , maybeToAttr toAttrFrStr "customTest" (setCustomTest v) , maybeToAttr toAttrFrStr "systemBitrate" (setSystemBitrate v) , maybeToAttr toAttrFrTyp "systemCaptions" (setSystemCaptions v) , maybeToAttr toAttrFrStr "systemLanguage" (setSystemLanguage v) , maybeToAttr toAttrFrTyp "systemOverdubOrSubtitle" (setSystemOverdubOrSubtitle v) , maybeToAttr toAttrFrStr "systemRequired" (setSystemRequired v) , maybeToAttr toAttrFrStr "systemScreenSize" (setSystemScreenSize v) , maybeToAttr toAttrFrStr "systemScreenDepth" (setSystemScreenDepth v) , maybeToAttr toAttrFrTyp "systemAudioDesc" (setSystemAudioDesc v) , maybeToAttr toAttrFrStr "systemOperatingSystem" (setSystemOperatingSystem v) , maybeToAttr toAttrFrStr "systemCPU" (setSystemCPU v) , maybeToAttr toAttrFrStr "systemComponent" (setSystemComponent v) , maybeToAttr toAttrFrStr "system-bitrate" (setSystem_bitrate v) , maybeToAttr toAttrFrTyp "system-captions" (setSystem_captions v) , maybeToAttr toAttrFrStr "system-language" (setSystem_language v) , maybeToAttr toAttrFrTyp "system-overdub-or-caption" (setSystem_overdub_or_caption v) , maybeToAttr toAttrFrStr "system-required" (setSystem_required v) , maybeToAttr toAttrFrStr "system-screen-size" (setSystem_screen_size v) , maybeToAttr toAttrFrStr "system-screen-depth" (setSystem_screen_depth v) , maybeToAttr toAttrFrStr "dur" (setDur v) , maybeToAttr toAttrFrStr "repeatCount" (setRepeatCount v) , maybeToAttr toAttrFrStr "repeatDur" (setRepeatDur v) , maybeToAttr toAttrFrStr "begin" (setBegin v) , maybeToAttr toAttrFrStr "end" (setEnd v) , toAttrFrStr "attributeName" (setAttributeName v) , maybeToAttr toAttrFrStr "attributeType" (setAttributeType v) , maybeToAttr toAttrFrStr "to" (setTo v) ] instance XmlAttrType Set_SystemCaptions where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just Set_SystemCaptions_On translate "off" = Just Set_SystemCaptions_Off translate _ = Nothing toAttrFrTyp n Set_SystemCaptions_On = Just (n, str2attr "on") toAttrFrTyp n Set_SystemCaptions_Off = Just (n, str2attr "off") instance XmlAttrType Set_SystemOverdubOrSubtitle where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "overdub" = Just Set_SystemOverdubOrSubtitle_Overdub translate "subtitle" = Just Set_SystemOverdubOrSubtitle_Subtitle translate _ = Nothing toAttrFrTyp n Set_SystemOverdubOrSubtitle_Overdub = Just (n, str2attr "overdub") toAttrFrTyp n Set_SystemOverdubOrSubtitle_Subtitle = Just (n, str2attr "subtitle") instance XmlAttrType Set_SystemAudioDesc where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just Set_SystemAudioDesc_On translate "off" = Just Set_SystemAudioDesc_Off translate _ = Nothing toAttrFrTyp n Set_SystemAudioDesc_On = Just (n, str2attr "on") toAttrFrTyp n Set_SystemAudioDesc_Off = Just (n, str2attr "off") instance XmlAttrType Set_System_captions where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just Set_System_captions_On translate "off" = Just Set_System_captions_Off translate _ = Nothing toAttrFrTyp n Set_System_captions_On = Just (n, str2attr "on") toAttrFrTyp n Set_System_captions_Off = Just (n, str2attr "off") instance XmlAttrType Set_System_overdub_or_caption where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "overdub" = Just Set_System_overdub_or_caption_Overdub translate "caption" = Just Set_System_overdub_or_caption_Caption translate _ = Nothing toAttrFrTyp n Set_System_overdub_or_caption_Overdub = Just (n, str2attr "overdub") toAttrFrTyp n Set_System_overdub_or_caption_Caption = Just (n, str2attr "caption") instance XmlContent AnimateMotion where fromElem (CElem (Elem "animateMotion" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "animateMotion" (toAttrs as) [])] instance XmlAttributes AnimateMotion where fromAttrs as = AnimateMotion { animateMotionId = possibleA fromAttrToStr "id" as , animateMotionClass = possibleA fromAttrToStr "class" as , animateMotionTitle = possibleA fromAttrToStr "title" as , animateMotionXml'lang = possibleA fromAttrToStr "xml:lang" as , animateMotionCustomTest = possibleA fromAttrToStr "customTest" as , animateMotionSystemBitrate = possibleA fromAttrToStr "systemBitrate" as , animateMotionSystemCaptions = possibleA fromAttrToTyp "systemCaptions" as , animateMotionSystemLanguage = possibleA fromAttrToStr "systemLanguage" as , animateMotionSystemOverdubOrSubtitle = possibleA fromAttrToTyp "systemOverdubOrSubtitle" as , animateMotionSystemRequired = possibleA fromAttrToStr "systemRequired" as , animateMotionSystemScreenSize = possibleA fromAttrToStr "systemScreenSize" as , animateMotionSystemScreenDepth = possibleA fromAttrToStr "systemScreenDepth" as , animateMotionSystemAudioDesc = possibleA fromAttrToTyp "systemAudioDesc" as , animateMotionSystemOperatingSystem = possibleA fromAttrToStr "systemOperatingSystem" as , animateMotionSystemCPU = possibleA fromAttrToStr "systemCPU" as , animateMotionSystemComponent = possibleA fromAttrToStr "systemComponent" as , animateMotionSystem_bitrate = possibleA fromAttrToStr "system-bitrate" as , animateMotionSystem_captions = possibleA fromAttrToTyp "system-captions" as , animateMotionSystem_language = possibleA fromAttrToStr "system-language" as , animateMotionSystem_overdub_or_caption = possibleA fromAttrToTyp "system-overdub-or-caption" as , animateMotionSystem_required = possibleA fromAttrToStr "system-required" as , animateMotionSystem_screen_size = possibleA fromAttrToStr "system-screen-size" as , animateMotionSystem_screen_depth = possibleA fromAttrToStr "system-screen-depth" as , animateMotionDur = possibleA fromAttrToStr "dur" as , animateMotionRepeatCount = possibleA fromAttrToStr "repeatCount" as , animateMotionRepeatDur = possibleA fromAttrToStr "repeatDur" as , animateMotionBegin = possibleA fromAttrToStr "begin" as , animateMotionEnd = possibleA fromAttrToStr "end" as , animateMotionValues = possibleA fromAttrToStr "values" as , animateMotionFrom = possibleA fromAttrToStr "from" as , animateMotionTo = possibleA fromAttrToStr "to" as , animateMotionBy = possibleA fromAttrToStr "by" as , animateMotionCalcMode = defaultA fromAttrToTyp AnimateMotion_CalcMode_Linear "calcMode" as , animateMotionAdditive = defaultA fromAttrToTyp AnimateMotion_Additive_Replace "additive" as , animateMotionAccumulate = defaultA fromAttrToTyp AnimateMotion_Accumulate_None "accumulate" as , animateMotionOrigin = defaultA fromAttrToTyp AnimateMotion_Origin_Default "origin" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (animateMotionId v) , maybeToAttr toAttrFrStr "class" (animateMotionClass v) , maybeToAttr toAttrFrStr "title" (animateMotionTitle v) , maybeToAttr toAttrFrStr "xml:lang" (animateMotionXml'lang v) , maybeToAttr toAttrFrStr "customTest" (animateMotionCustomTest v) , maybeToAttr toAttrFrStr "systemBitrate" (animateMotionSystemBitrate v) , maybeToAttr toAttrFrTyp "systemCaptions" (animateMotionSystemCaptions v) , maybeToAttr toAttrFrStr "systemLanguage" (animateMotionSystemLanguage v) , maybeToAttr toAttrFrTyp "systemOverdubOrSubtitle" (animateMotionSystemOverdubOrSubtitle v) , maybeToAttr toAttrFrStr "systemRequired" (animateMotionSystemRequired v) , maybeToAttr toAttrFrStr "systemScreenSize" (animateMotionSystemScreenSize v) , maybeToAttr toAttrFrStr "systemScreenDepth" (animateMotionSystemScreenDepth v) , maybeToAttr toAttrFrTyp "systemAudioDesc" (animateMotionSystemAudioDesc v) , maybeToAttr toAttrFrStr "systemOperatingSystem" (animateMotionSystemOperatingSystem v) , maybeToAttr toAttrFrStr "systemCPU" (animateMotionSystemCPU v) , maybeToAttr toAttrFrStr "systemComponent" (animateMotionSystemComponent v) , maybeToAttr toAttrFrStr "system-bitrate" (animateMotionSystem_bitrate v) , maybeToAttr toAttrFrTyp "system-captions" (animateMotionSystem_captions v) , maybeToAttr toAttrFrStr "system-language" (animateMotionSystem_language v) , maybeToAttr toAttrFrTyp "system-overdub-or-caption" (animateMotionSystem_overdub_or_caption v) , maybeToAttr toAttrFrStr "system-required" (animateMotionSystem_required v) , maybeToAttr toAttrFrStr "system-screen-size" (animateMotionSystem_screen_size v) , maybeToAttr toAttrFrStr "system-screen-depth" (animateMotionSystem_screen_depth v) , maybeToAttr toAttrFrStr "dur" (animateMotionDur v) , maybeToAttr toAttrFrStr "repeatCount" (animateMotionRepeatCount v) , maybeToAttr toAttrFrStr "repeatDur" (animateMotionRepeatDur v) , maybeToAttr toAttrFrStr "begin" (animateMotionBegin v) , maybeToAttr toAttrFrStr "end" (animateMotionEnd v) , maybeToAttr toAttrFrStr "values" (animateMotionValues v) , maybeToAttr toAttrFrStr "from" (animateMotionFrom v) , maybeToAttr toAttrFrStr "to" (animateMotionTo v) , maybeToAttr toAttrFrStr "by" (animateMotionBy v) , defaultToAttr toAttrFrTyp "calcMode" (animateMotionCalcMode v) , defaultToAttr toAttrFrTyp "additive" (animateMotionAdditive v) , defaultToAttr toAttrFrTyp "accumulate" (animateMotionAccumulate v) , defaultToAttr toAttrFrTyp "origin" (animateMotionOrigin v) ] instance XmlAttrType AnimateMotion_SystemCaptions where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just AnimateMotion_SystemCaptions_On translate "off" = Just AnimateMotion_SystemCaptions_Off translate _ = Nothing toAttrFrTyp n AnimateMotion_SystemCaptions_On = Just (n, str2attr "on") toAttrFrTyp n AnimateMotion_SystemCaptions_Off = Just (n, str2attr "off") instance XmlAttrType AnimateMotion_SystemOverdubOrSubtitle where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "overdub" = Just AnimateMotion_SystemOverdubOrSubtitle_Overdub translate "subtitle" = Just AnimateMotion_SystemOverdubOrSubtitle_Subtitle translate _ = Nothing toAttrFrTyp n AnimateMotion_SystemOverdubOrSubtitle_Overdub = Just (n, str2attr "overdub") toAttrFrTyp n AnimateMotion_SystemOverdubOrSubtitle_Subtitle = Just (n, str2attr "subtitle") instance XmlAttrType AnimateMotion_SystemAudioDesc where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just AnimateMotion_SystemAudioDesc_On translate "off" = Just AnimateMotion_SystemAudioDesc_Off translate _ = Nothing toAttrFrTyp n AnimateMotion_SystemAudioDesc_On = Just (n, str2attr "on") toAttrFrTyp n AnimateMotion_SystemAudioDesc_Off = Just (n, str2attr "off") instance XmlAttrType AnimateMotion_System_captions where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just AnimateMotion_System_captions_On translate "off" = Just AnimateMotion_System_captions_Off translate _ = Nothing toAttrFrTyp n AnimateMotion_System_captions_On = Just (n, str2attr "on") toAttrFrTyp n AnimateMotion_System_captions_Off = Just (n, str2attr "off") instance XmlAttrType AnimateMotion_System_overdub_or_caption where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "overdub" = Just AnimateMotion_System_overdub_or_caption_Overdub translate "caption" = Just AnimateMotion_System_overdub_or_caption_Caption translate _ = Nothing toAttrFrTyp n AnimateMotion_System_overdub_or_caption_Overdub = Just (n, str2attr "overdub") toAttrFrTyp n AnimateMotion_System_overdub_or_caption_Caption = Just (n, str2attr "caption") instance XmlAttrType AnimateMotion_CalcMode where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "discrete" = Just AnimateMotion_CalcMode_Discrete translate "linear" = Just AnimateMotion_CalcMode_Linear translate "paced" = Just AnimateMotion_CalcMode_Paced translate _ = Nothing toAttrFrTyp n AnimateMotion_CalcMode_Discrete = Just (n, str2attr "discrete") toAttrFrTyp n AnimateMotion_CalcMode_Linear = Just (n, str2attr "linear") toAttrFrTyp n AnimateMotion_CalcMode_Paced = Just (n, str2attr "paced") instance XmlAttrType AnimateMotion_Additive where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "replace" = Just AnimateMotion_Additive_Replace translate "sum" = Just AnimateMotion_Additive_Sum translate _ = Nothing toAttrFrTyp n AnimateMotion_Additive_Replace = Just (n, str2attr "replace") toAttrFrTyp n AnimateMotion_Additive_Sum = Just (n, str2attr "sum") instance XmlAttrType AnimateMotion_Accumulate where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "none" = Just AnimateMotion_Accumulate_None translate "sum" = Just AnimateMotion_Accumulate_Sum translate _ = Nothing toAttrFrTyp n AnimateMotion_Accumulate_None = Just (n, str2attr "none") toAttrFrTyp n AnimateMotion_Accumulate_Sum = Just (n, str2attr "sum") instance XmlAttrType AnimateMotion_Origin where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "default" = Just AnimateMotion_Origin_Default translate _ = Nothing toAttrFrTyp n AnimateMotion_Origin_Default = Just (n, str2attr "default") instance XmlContent AnimateColor where fromElem (CElem (Elem "animateColor" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "animateColor" (toAttrs as) [])] instance XmlAttributes AnimateColor where fromAttrs as = AnimateColor { animateColorId = possibleA fromAttrToStr "id" as , animateColorClass = possibleA fromAttrToStr "class" as , animateColorTitle = possibleA fromAttrToStr "title" as , animateColorXml'lang = possibleA fromAttrToStr "xml:lang" as , animateColorCustomTest = possibleA fromAttrToStr "customTest" as , animateColorSystemBitrate = possibleA fromAttrToStr "systemBitrate" as , animateColorSystemCaptions = possibleA fromAttrToTyp "systemCaptions" as , animateColorSystemLanguage = possibleA fromAttrToStr "systemLanguage" as , animateColorSystemOverdubOrSubtitle = possibleA fromAttrToTyp "systemOverdubOrSubtitle" as , animateColorSystemRequired = possibleA fromAttrToStr "systemRequired" as , animateColorSystemScreenSize = possibleA fromAttrToStr "systemScreenSize" as , animateColorSystemScreenDepth = possibleA fromAttrToStr "systemScreenDepth" as , animateColorSystemAudioDesc = possibleA fromAttrToTyp "systemAudioDesc" as , animateColorSystemOperatingSystem = possibleA fromAttrToStr "systemOperatingSystem" as , animateColorSystemCPU = possibleA fromAttrToStr "systemCPU" as , animateColorSystemComponent = possibleA fromAttrToStr "systemComponent" as , animateColorSystem_bitrate = possibleA fromAttrToStr "system-bitrate" as , animateColorSystem_captions = possibleA fromAttrToTyp "system-captions" as , animateColorSystem_language = possibleA fromAttrToStr "system-language" as , animateColorSystem_overdub_or_caption = possibleA fromAttrToTyp "system-overdub-or-caption" as , animateColorSystem_required = possibleA fromAttrToStr "system-required" as , animateColorSystem_screen_size = possibleA fromAttrToStr "system-screen-size" as , animateColorSystem_screen_depth = possibleA fromAttrToStr "system-screen-depth" as , animateColorDur = possibleA fromAttrToStr "dur" as , animateColorRepeatCount = possibleA fromAttrToStr "repeatCount" as , animateColorRepeatDur = possibleA fromAttrToStr "repeatDur" as , animateColorBegin = possibleA fromAttrToStr "begin" as , animateColorEnd = possibleA fromAttrToStr "end" as , animateColorAttributeName = definiteA fromAttrToStr "animateColor" "attributeName" as , animateColorAttributeType = possibleA fromAttrToStr "attributeType" as , animateColorValues = possibleA fromAttrToStr "values" as , animateColorFrom = possibleA fromAttrToStr "from" as , animateColorTo = possibleA fromAttrToStr "to" as , animateColorBy = possibleA fromAttrToStr "by" as , animateColorCalcMode = defaultA fromAttrToTyp AnimateColor_CalcMode_Linear "calcMode" as , animateColorAdditive = defaultA fromAttrToTyp AnimateColor_Additive_Replace "additive" as , animateColorAccumulate = defaultA fromAttrToTyp AnimateColor_Accumulate_None "accumulate" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (animateColorId v) , maybeToAttr toAttrFrStr "class" (animateColorClass v) , maybeToAttr toAttrFrStr "title" (animateColorTitle v) , maybeToAttr toAttrFrStr "xml:lang" (animateColorXml'lang v) , maybeToAttr toAttrFrStr "customTest" (animateColorCustomTest v) , maybeToAttr toAttrFrStr "systemBitrate" (animateColorSystemBitrate v) , maybeToAttr toAttrFrTyp "systemCaptions" (animateColorSystemCaptions v) , maybeToAttr toAttrFrStr "systemLanguage" (animateColorSystemLanguage v) , maybeToAttr toAttrFrTyp "systemOverdubOrSubtitle" (animateColorSystemOverdubOrSubtitle v) , maybeToAttr toAttrFrStr "systemRequired" (animateColorSystemRequired v) , maybeToAttr toAttrFrStr "systemScreenSize" (animateColorSystemScreenSize v) , maybeToAttr toAttrFrStr "systemScreenDepth" (animateColorSystemScreenDepth v) , maybeToAttr toAttrFrTyp "systemAudioDesc" (animateColorSystemAudioDesc v) , maybeToAttr toAttrFrStr "systemOperatingSystem" (animateColorSystemOperatingSystem v) , maybeToAttr toAttrFrStr "systemCPU" (animateColorSystemCPU v) , maybeToAttr toAttrFrStr "systemComponent" (animateColorSystemComponent v) , maybeToAttr toAttrFrStr "system-bitrate" (animateColorSystem_bitrate v) , maybeToAttr toAttrFrTyp "system-captions" (animateColorSystem_captions v) , maybeToAttr toAttrFrStr "system-language" (animateColorSystem_language v) , maybeToAttr toAttrFrTyp "system-overdub-or-caption" (animateColorSystem_overdub_or_caption v) , maybeToAttr toAttrFrStr "system-required" (animateColorSystem_required v) , maybeToAttr toAttrFrStr "system-screen-size" (animateColorSystem_screen_size v) , maybeToAttr toAttrFrStr "system-screen-depth" (animateColorSystem_screen_depth v) , maybeToAttr toAttrFrStr "dur" (animateColorDur v) , maybeToAttr toAttrFrStr "repeatCount" (animateColorRepeatCount v) , maybeToAttr toAttrFrStr "repeatDur" (animateColorRepeatDur v) , maybeToAttr toAttrFrStr "begin" (animateColorBegin v) , maybeToAttr toAttrFrStr "end" (animateColorEnd v) , toAttrFrStr "attributeName" (animateColorAttributeName v) , maybeToAttr toAttrFrStr "attributeType" (animateColorAttributeType v) , maybeToAttr toAttrFrStr "values" (animateColorValues v) , maybeToAttr toAttrFrStr "from" (animateColorFrom v) , maybeToAttr toAttrFrStr "to" (animateColorTo v) , maybeToAttr toAttrFrStr "by" (animateColorBy v) , defaultToAttr toAttrFrTyp "calcMode" (animateColorCalcMode v) , defaultToAttr toAttrFrTyp "additive" (animateColorAdditive v) , defaultToAttr toAttrFrTyp "accumulate" (animateColorAccumulate v) ] instance XmlAttrType AnimateColor_SystemCaptions where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just AnimateColor_SystemCaptions_On translate "off" = Just AnimateColor_SystemCaptions_Off translate _ = Nothing toAttrFrTyp n AnimateColor_SystemCaptions_On = Just (n, str2attr "on") toAttrFrTyp n AnimateColor_SystemCaptions_Off = Just (n, str2attr "off") instance XmlAttrType AnimateColor_SystemOverdubOrSubtitle where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "overdub" = Just AnimateColor_SystemOverdubOrSubtitle_Overdub translate "subtitle" = Just AnimateColor_SystemOverdubOrSubtitle_Subtitle translate _ = Nothing toAttrFrTyp n AnimateColor_SystemOverdubOrSubtitle_Overdub = Just (n, str2attr "overdub") toAttrFrTyp n AnimateColor_SystemOverdubOrSubtitle_Subtitle = Just (n, str2attr "subtitle") instance XmlAttrType AnimateColor_SystemAudioDesc where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just AnimateColor_SystemAudioDesc_On translate "off" = Just AnimateColor_SystemAudioDesc_Off translate _ = Nothing toAttrFrTyp n AnimateColor_SystemAudioDesc_On = Just (n, str2attr "on") toAttrFrTyp n AnimateColor_SystemAudioDesc_Off = Just (n, str2attr "off") instance XmlAttrType AnimateColor_System_captions where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "on" = Just AnimateColor_System_captions_On translate "off" = Just AnimateColor_System_captions_Off translate _ = Nothing toAttrFrTyp n AnimateColor_System_captions_On = Just (n, str2attr "on") toAttrFrTyp n AnimateColor_System_captions_Off = Just (n, str2attr "off") instance XmlAttrType AnimateColor_System_overdub_or_caption where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "overdub" = Just AnimateColor_System_overdub_or_caption_Overdub translate "caption" = Just AnimateColor_System_overdub_or_caption_Caption translate _ = Nothing toAttrFrTyp n AnimateColor_System_overdub_or_caption_Overdub = Just (n, str2attr "overdub") toAttrFrTyp n AnimateColor_System_overdub_or_caption_Caption = Just (n, str2attr "caption") instance XmlAttrType AnimateColor_CalcMode where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "discrete" = Just AnimateColor_CalcMode_Discrete translate "linear" = Just AnimateColor_CalcMode_Linear translate "paced" = Just AnimateColor_CalcMode_Paced translate _ = Nothing toAttrFrTyp n AnimateColor_CalcMode_Discrete = Just (n, str2attr "discrete") toAttrFrTyp n AnimateColor_CalcMode_Linear = Just (n, str2attr "linear") toAttrFrTyp n AnimateColor_CalcMode_Paced = Just (n, str2attr "paced") instance XmlAttrType AnimateColor_Additive where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "replace" = Just AnimateColor_Additive_Replace translate "sum" = Just AnimateColor_Additive_Sum translate _ = Nothing toAttrFrTyp n AnimateColor_Additive_Replace = Just (n, str2attr "replace") toAttrFrTyp n AnimateColor_Additive_Sum = Just (n, str2attr "sum") instance XmlAttrType AnimateColor_Accumulate where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "none" = Just AnimateColor_Accumulate_None translate "sum" = Just AnimateColor_Accumulate_Sum translate _ = Nothing toAttrFrTyp n AnimateColor_Accumulate_None = Just (n, str2attr "none") toAttrFrTyp n AnimateColor_Accumulate_Sum = Just (n, str2attr "sum") instance XmlContent Switch where fromElem (CElem (Elem "switch" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "switch" (toAttrs as) [])] instance XmlAttributes Switch where fromAttrs as = Switch { switchId = possibleA fromAttrToStr "id" as , switchClass = possibleA fromAttrToStr "class" as , switchTitle = possibleA fromAttrToStr "title" as , switchXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (switchId v) , maybeToAttr toAttrFrStr "class" (switchClass v) , maybeToAttr toAttrFrStr "title" (switchTitle v) , maybeToAttr toAttrFrStr "xml:lang" (switchXml'lang v) ] instance XmlContent Meta where fromElem (CElem (Elem "meta" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "meta" (toAttrs as) [])] instance XmlAttributes Meta where fromAttrs as = Meta { metaContent = possibleA fromAttrToStr "content" as , metaName = definiteA fromAttrToStr "meta" "name" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "content" (metaContent v) , toAttrFrStr "name" (metaName v) ] instance XmlContent Metadata where fromElem (CElem (Elem "metadata" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "metadata" (toAttrs as) [])] instance XmlAttributes Metadata where fromAttrs as = Metadata { metadataId = possibleA fromAttrToStr "id" as , metadataClass = possibleA fromAttrToStr "class" as , metadataTitle = possibleA fromAttrToStr "title" as , metadataXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (metadataId v) , maybeToAttr toAttrFrStr "class" (metadataClass v) , maybeToAttr toAttrFrStr "title" (metadataTitle v) , maybeToAttr toAttrFrStr "xml:lang" (metadataXml'lang v) ] instance XmlContent Layout where fromElem (CElem (Elem "layout" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "layout" (toAttrs as) [])] instance XmlAttributes Layout where fromAttrs as = Layout { layoutId = possibleA fromAttrToStr "id" as , layoutClass = possibleA fromAttrToStr "class" as , layoutTitle = possibleA fromAttrToStr "title" as , layoutXml'lang = possibleA fromAttrToStr "xml:lang" as , layoutType = defaultA fromAttrToStr "text/smil-basic-layout" "type" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (layoutId v) , maybeToAttr toAttrFrStr "class" (layoutClass v) , maybeToAttr toAttrFrStr "title" (layoutTitle v) , maybeToAttr toAttrFrStr "xml:lang" (layoutXml'lang v) , defaultToAttr toAttrFrStr "type" (layoutType v) ] instance XmlContent Region where fromElem (CElem (Elem "region" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "region" (toAttrs as) [])] instance XmlAttributes Region where fromAttrs as = Region { regionId = possibleA fromAttrToStr "id" as , regionClass = possibleA fromAttrToStr "class" as , regionTitle = possibleA fromAttrToStr "title" as , regionXml'lang = possibleA fromAttrToStr "xml:lang" as , regionHeight = defaultA fromAttrToStr "auto" "height" as , regionWidth = defaultA fromAttrToStr "auto" "width" as , regionClose = defaultA fromAttrToTyp Region_Close_Never "close" as , regionOpen = defaultA fromAttrToTyp Region_Open_Always "open" as , regionBackgroundColor = possibleA fromAttrToStr "backgroundColor" as , regionBackground_color = possibleA fromAttrToStr "background-color" as , regionBottom = defaultA fromAttrToStr "auto" "bottom" as , regionLeft = defaultA fromAttrToStr "auto" "left" as , regionRight = defaultA fromAttrToStr "auto" "right" as , regionTop = defaultA fromAttrToStr "auto" "top" as , regionZ_index = possibleA fromAttrToStr "z-index" as , regionShowBackground = defaultA fromAttrToTyp Region_ShowBackground_Always "showBackground" as , regionFit = defaultA fromAttrToTyp Region_Fit_Hidden "fit" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (regionId v) , maybeToAttr toAttrFrStr "class" (regionClass v) , maybeToAttr toAttrFrStr "title" (regionTitle v) , maybeToAttr toAttrFrStr "xml:lang" (regionXml'lang v) , defaultToAttr toAttrFrStr "height" (regionHeight v) , defaultToAttr toAttrFrStr "width" (regionWidth v) , defaultToAttr toAttrFrTyp "close" (regionClose v) , defaultToAttr toAttrFrTyp "open" (regionOpen v) , maybeToAttr toAttrFrStr "backgroundColor" (regionBackgroundColor v) , maybeToAttr toAttrFrStr "background-color" (regionBackground_color v) , defaultToAttr toAttrFrStr "bottom" (regionBottom v) , defaultToAttr toAttrFrStr "left" (regionLeft v) , defaultToAttr toAttrFrStr "right" (regionRight v) , defaultToAttr toAttrFrStr "top" (regionTop v) , maybeToAttr toAttrFrStr "z-index" (regionZ_index v) , defaultToAttr toAttrFrTyp "showBackground" (regionShowBackground v) , defaultToAttr toAttrFrTyp "fit" (regionFit v) ] instance XmlAttrType Region_Close where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "never" = Just Region_Close_Never translate "whenNotActive" = Just Region_Close_WhenNotActive translate _ = Nothing toAttrFrTyp n Region_Close_Never = Just (n, str2attr "never") toAttrFrTyp n Region_Close_WhenNotActive = Just (n, str2attr "whenNotActive") instance XmlAttrType Region_Open where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "always" = Just Region_Open_Always translate "whenActive" = Just Region_Open_WhenActive translate _ = Nothing toAttrFrTyp n Region_Open_Always = Just (n, str2attr "always") toAttrFrTyp n Region_Open_WhenActive = Just (n, str2attr "whenActive") instance XmlAttrType Region_ShowBackground where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "always" = Just Region_ShowBackground_Always translate "whenActive" = Just Region_ShowBackground_WhenActive translate _ = Nothing toAttrFrTyp n Region_ShowBackground_Always = Just (n, str2attr "always") toAttrFrTyp n Region_ShowBackground_WhenActive = Just (n, str2attr "whenActive") instance XmlAttrType Region_Fit where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "hidden" = Just Region_Fit_Hidden translate "fill" = Just Region_Fit_Fill translate "meet" = Just Region_Fit_Meet translate "scroll" = Just Region_Fit_Scroll translate "slice" = Just Region_Fit_Slice translate _ = Nothing toAttrFrTyp n Region_Fit_Hidden = Just (n, str2attr "hidden") toAttrFrTyp n Region_Fit_Fill = Just (n, str2attr "fill") toAttrFrTyp n Region_Fit_Meet = Just (n, str2attr "meet") toAttrFrTyp n Region_Fit_Scroll = Just (n, str2attr "scroll") toAttrFrTyp n Region_Fit_Slice = Just (n, str2attr "slice") instance XmlContent Root_layout where fromElem (CElem (Elem "root-layout" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "root-layout" (toAttrs as) [])] instance XmlAttributes Root_layout where fromAttrs as = Root_layout { root_layoutId = possibleA fromAttrToStr "id" as , root_layoutClass = possibleA fromAttrToStr "class" as , root_layoutTitle = possibleA fromAttrToStr "title" as , root_layoutXml'lang = possibleA fromAttrToStr "xml:lang" as , root_layoutHeight = defaultA fromAttrToStr "auto" "height" as , root_layoutWidth = defaultA fromAttrToStr "auto" "width" as , root_layoutClose = defaultA fromAttrToTyp Root_layout_Close_Never "close" as , root_layoutOpen = defaultA fromAttrToTyp Root_layout_Open_Always "open" as , root_layoutBackgroundColor = possibleA fromAttrToStr "backgroundColor" as , root_layoutBackground_color = possibleA fromAttrToStr "background-color" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (root_layoutId v) , maybeToAttr toAttrFrStr "class" (root_layoutClass v) , maybeToAttr toAttrFrStr "title" (root_layoutTitle v) , maybeToAttr toAttrFrStr "xml:lang" (root_layoutXml'lang v) , defaultToAttr toAttrFrStr "height" (root_layoutHeight v) , defaultToAttr toAttrFrStr "width" (root_layoutWidth v) , defaultToAttr toAttrFrTyp "close" (root_layoutClose v) , defaultToAttr toAttrFrTyp "open" (root_layoutOpen v) , maybeToAttr toAttrFrStr "backgroundColor" (root_layoutBackgroundColor v) , maybeToAttr toAttrFrStr "background-color" (root_layoutBackground_color v) ] instance XmlAttrType Root_layout_Close where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "never" = Just Root_layout_Close_Never translate "whenNotActive" = Just Root_layout_Close_WhenNotActive translate _ = Nothing toAttrFrTyp n Root_layout_Close_Never = Just (n, str2attr "never") toAttrFrTyp n Root_layout_Close_WhenNotActive = Just (n, str2attr "whenNotActive") instance XmlAttrType Root_layout_Open where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "always" = Just Root_layout_Open_Always translate "whenActive" = Just Root_layout_Open_WhenActive translate _ = Nothing toAttrFrTyp n Root_layout_Open_Always = Just (n, str2attr "always") toAttrFrTyp n Root_layout_Open_WhenActive = Just (n, str2attr "whenActive") instance XmlContent Ref where fromElem (CElem (Elem "ref" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "ref" (toAttrs as) [])] instance XmlAttributes Ref where fromAttrs as = Ref { refId = possibleA fromAttrToStr "id" as , refClass = possibleA fromAttrToStr "class" as , refTitle = possibleA fromAttrToStr "title" as , refXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (refId v) , maybeToAttr toAttrFrStr "class" (refClass v) , maybeToAttr toAttrFrStr "title" (refTitle v) , maybeToAttr toAttrFrStr "xml:lang" (refXml'lang v) ] instance XmlContent Audio where fromElem (CElem (Elem "audio" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "audio" (toAttrs as) [])] instance XmlAttributes Audio where fromAttrs as = Audio { audioId = possibleA fromAttrToStr "id" as , audioClass = possibleA fromAttrToStr "class" as , audioTitle = possibleA fromAttrToStr "title" as , audioXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (audioId v) , maybeToAttr toAttrFrStr "class" (audioClass v) , maybeToAttr toAttrFrStr "title" (audioTitle v) , maybeToAttr toAttrFrStr "xml:lang" (audioXml'lang v) ] instance XmlContent Img where fromElem (CElem (Elem "img" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "img" (toAttrs as) [])] instance XmlAttributes Img where fromAttrs as = Img { imgId = possibleA fromAttrToStr "id" as , imgClass = possibleA fromAttrToStr "class" as , imgTitle = possibleA fromAttrToStr "title" as , imgXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (imgId v) , maybeToAttr toAttrFrStr "class" (imgClass v) , maybeToAttr toAttrFrStr "title" (imgTitle v) , maybeToAttr toAttrFrStr "xml:lang" (imgXml'lang v) ] instance XmlContent Video where fromElem (CElem (Elem "video" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "video" (toAttrs as) [])] instance XmlAttributes Video where fromAttrs as = Video { videoId = possibleA fromAttrToStr "id" as , videoClass = possibleA fromAttrToStr "class" as , videoTitle = possibleA fromAttrToStr "title" as , videoXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (videoId v) , maybeToAttr toAttrFrStr "class" (videoClass v) , maybeToAttr toAttrFrStr "title" (videoTitle v) , maybeToAttr toAttrFrStr "xml:lang" (videoXml'lang v) ] instance XmlContent Text where fromElem (CElem (Elem "text" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "text" (toAttrs as) [])] instance XmlAttributes Text where fromAttrs as = Text { textId = possibleA fromAttrToStr "id" as , textClass = possibleA fromAttrToStr "class" as , textTitle = possibleA fromAttrToStr "title" as , textXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (textId v) , maybeToAttr toAttrFrStr "class" (textClass v) , maybeToAttr toAttrFrStr "title" (textTitle v) , maybeToAttr toAttrFrStr "xml:lang" (textXml'lang v) ] instance XmlContent Textstream where fromElem (CElem (Elem "textstream" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "textstream" (toAttrs as) [])] instance XmlAttributes Textstream where fromAttrs as = Textstream { textstreamId = possibleA fromAttrToStr "id" as , textstreamClass = possibleA fromAttrToStr "class" as , textstreamTitle = possibleA fromAttrToStr "title" as , textstreamXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (textstreamId v) , maybeToAttr toAttrFrStr "class" (textstreamClass v) , maybeToAttr toAttrFrStr "title" (textstreamTitle v) , maybeToAttr toAttrFrStr "xml:lang" (textstreamXml'lang v) ] instance XmlContent Animation where fromElem (CElem (Elem "animation" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "animation" (toAttrs as) [])] instance XmlAttributes Animation where fromAttrs as = Animation { animationId = possibleA fromAttrToStr "id" as , animationClass = possibleA fromAttrToStr "class" as , animationTitle = possibleA fromAttrToStr "title" as , animationXml'lang = possibleA fromAttrToStr "xml:lang" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (animationId v) , maybeToAttr toAttrFrStr "class" (animationClass v) , maybeToAttr toAttrFrStr "title" (animationTitle v) , maybeToAttr toAttrFrStr "xml:lang" (animationXml'lang v) ] instance XmlContent Transition where fromElem (CElem (Elem "transition" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "transition" (toAttrs as) [])] instance XmlAttributes Transition where fromAttrs as = Transition { transitionId = possibleA fromAttrToStr "id" as , transitionClass = possibleA fromAttrToStr "class" as , transitionTitle = possibleA fromAttrToStr "title" as , transitionXml'lang = possibleA fromAttrToStr "xml:lang" as , transitionType = possibleA fromAttrToTyp "type" as , transitionSubtype = possibleA fromAttrToTyp "subtype" as , transitionHorzRepeat = defaultA fromAttrToStr "0" "horzRepeat" as , transitionVertRepeat = defaultA fromAttrToStr "0" "vertRepeat" as , transitionBorderWidth = defaultA fromAttrToStr "0" "borderWidth" as , transitionBorderColor = defaultA fromAttrToStr "black" "borderColor" as , transitionFadeColor = defaultA fromAttrToStr "black" "fadeColor" as , transitionCoordinated = defaultA fromAttrToTyp Transition_Coordinated_False "coordinated" as , transitionClibBoundary = defaultA fromAttrToTyp Transition_ClibBoundary_Children "clibBoundary" as , transitionDur = possibleA fromAttrToStr "dur" as , transitionStartProgress = defaultA fromAttrToStr "0.0" "startProgress" as , transitionEndProgress = defaultA fromAttrToStr "1.0" "endProgress" as , transitionDirection = defaultA fromAttrToTyp Transition_Direction_Forward "direction" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (transitionId v) , maybeToAttr toAttrFrStr "class" (transitionClass v) , maybeToAttr toAttrFrStr "title" (transitionTitle v) , maybeToAttr toAttrFrStr "xml:lang" (transitionXml'lang v) , maybeToAttr toAttrFrTyp "type" (transitionType v) , maybeToAttr toAttrFrTyp "subtype" (transitionSubtype v) , defaultToAttr toAttrFrStr "horzRepeat" (transitionHorzRepeat v) , defaultToAttr toAttrFrStr "vertRepeat" (transitionVertRepeat v) , defaultToAttr toAttrFrStr "borderWidth" (transitionBorderWidth v) , defaultToAttr toAttrFrStr "borderColor" (transitionBorderColor v) , defaultToAttr toAttrFrStr "fadeColor" (transitionFadeColor v) , defaultToAttr toAttrFrTyp "coordinated" (transitionCoordinated v) , defaultToAttr toAttrFrTyp "clibBoundary" (transitionClibBoundary v) , maybeToAttr toAttrFrStr "dur" (transitionDur v) , defaultToAttr toAttrFrStr "startProgress" (transitionStartProgress v) , defaultToAttr toAttrFrStr "endProgress" (transitionEndProgress v) , defaultToAttr toAttrFrTyp "direction" (transitionDirection v) ] instance XmlAttrType Transition_Type where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "barWipe" = Just Transition_Type_BarWipe translate "boxWipe" = Just Transition_Type_BoxWipe translate "fourBoxWipe" = Just Transition_Type_FourBoxWipe translate "barnDoorWipe" = Just Transition_Type_BarnDoorWipe translate "diagonalWipe" = Just Transition_Type_DiagonalWipe translate "bowTieWipe" = Just Transition_Type_BowTieWipe translate "miscDiagonalWipe" = Just Transition_Type_MiscDiagonalWipe translate "veeWipe" = Just Transition_Type_VeeWipe translate "barnVeeWipe" = Just Transition_Type_BarnVeeWipe translate "zigZagWipe" = Just Transition_Type_ZigZagWipe translate "barnZigZagWipe" = Just Transition_Type_BarnZigZagWipe translate "miscShapeWipe" = Just Transition_Type_MiscShapeWipe translate "triangleWipe" = Just Transition_Type_TriangleWipe translate "arrowHeadWipe" = Just Transition_Type_ArrowHeadWipe translate "pentagonWipe" = Just Transition_Type_PentagonWipe translate "hexagonWipe" = Just Transition_Type_HexagonWipe translate "ellipseWipe" = Just Transition_Type_EllipseWipe translate "eyeWipe" = Just Transition_Type_EyeWipe translate "roundRectWipe" = Just Transition_Type_RoundRectWipe translate "starWipe" = Just Transition_Type_StarWipe translate "clockWipe" = Just Transition_Type_ClockWipe translate "pinWheelWipe" = Just Transition_Type_PinWheelWipe translate "singleSweepWipe" = Just Transition_Type_SingleSweepWipe translate "fanWipe" = Just Transition_Type_FanWipe translate "doubleFanWipe" = Just Transition_Type_DoubleFanWipe translate "doubleSweepWipe" = Just Transition_Type_DoubleSweepWipe translate "saloonDoorWipe" = Just Transition_Type_SaloonDoorWipe translate "windshieldWipe" = Just Transition_Type_WindshieldWipe translate "snakeWipe" = Just Transition_Type_SnakeWipe translate "spiralWipe" = Just Transition_Type_SpiralWipe translate "parallelSnakesWipe" = Just Transition_Type_ParallelSnakesWipe translate "boxSnakesWipe" = Just Transition_Type_BoxSnakesWipe translate "waterfallWipe" = Just Transition_Type_WaterfallWipe translate "pushWipe" = Just Transition_Type_PushWipe translate "slideWipe" = Just Transition_Type_SlideWipe translate "fade" = Just Transition_Type_Fade translate _ = Nothing toAttrFrTyp n Transition_Type_BarWipe = Just (n, str2attr "barWipe") toAttrFrTyp n Transition_Type_BoxWipe = Just (n, str2attr "boxWipe") toAttrFrTyp n Transition_Type_FourBoxWipe = Just (n, str2attr "fourBoxWipe") toAttrFrTyp n Transition_Type_BarnDoorWipe = Just (n, str2attr "barnDoorWipe") toAttrFrTyp n Transition_Type_DiagonalWipe = Just (n, str2attr "diagonalWipe") toAttrFrTyp n Transition_Type_BowTieWipe = Just (n, str2attr "bowTieWipe") toAttrFrTyp n Transition_Type_MiscDiagonalWipe = Just (n, str2attr "miscDiagonalWipe") toAttrFrTyp n Transition_Type_VeeWipe = Just (n, str2attr "veeWipe") toAttrFrTyp n Transition_Type_BarnVeeWipe = Just (n, str2attr "barnVeeWipe") toAttrFrTyp n Transition_Type_ZigZagWipe = Just (n, str2attr "zigZagWipe") toAttrFrTyp n Transition_Type_BarnZigZagWipe = Just (n, str2attr "barnZigZagWipe") toAttrFrTyp n Transition_Type_MiscShapeWipe = Just (n, str2attr "miscShapeWipe") toAttrFrTyp n Transition_Type_TriangleWipe = Just (n, str2attr "triangleWipe") toAttrFrTyp n Transition_Type_ArrowHeadWipe = Just (n, str2attr "arrowHeadWipe") toAttrFrTyp n Transition_Type_PentagonWipe = Just (n, str2attr "pentagonWipe") toAttrFrTyp n Transition_Type_HexagonWipe = Just (n, str2attr "hexagonWipe") toAttrFrTyp n Transition_Type_EllipseWipe = Just (n, str2attr "ellipseWipe") toAttrFrTyp n Transition_Type_EyeWipe = Just (n, str2attr "eyeWipe") toAttrFrTyp n Transition_Type_RoundRectWipe = Just (n, str2attr "roundRectWipe") toAttrFrTyp n Transition_Type_StarWipe = Just (n, str2attr "starWipe") toAttrFrTyp n Transition_Type_ClockWipe = Just (n, str2attr "clockWipe") toAttrFrTyp n Transition_Type_PinWheelWipe = Just (n, str2attr "pinWheelWipe") toAttrFrTyp n Transition_Type_SingleSweepWipe = Just (n, str2attr "singleSweepWipe") toAttrFrTyp n Transition_Type_FanWipe = Just (n, str2attr "fanWipe") toAttrFrTyp n Transition_Type_DoubleFanWipe = Just (n, str2attr "doubleFanWipe") toAttrFrTyp n Transition_Type_DoubleSweepWipe = Just (n, str2attr "doubleSweepWipe") toAttrFrTyp n Transition_Type_SaloonDoorWipe = Just (n, str2attr "saloonDoorWipe") toAttrFrTyp n Transition_Type_WindshieldWipe = Just (n, str2attr "windshieldWipe") toAttrFrTyp n Transition_Type_SnakeWipe = Just (n, str2attr "snakeWipe") toAttrFrTyp n Transition_Type_SpiralWipe = Just (n, str2attr "spiralWipe") toAttrFrTyp n Transition_Type_ParallelSnakesWipe = Just (n, str2attr "parallelSnakesWipe") toAttrFrTyp n Transition_Type_BoxSnakesWipe = Just (n, str2attr "boxSnakesWipe") toAttrFrTyp n Transition_Type_WaterfallWipe = Just (n, str2attr "waterfallWipe") toAttrFrTyp n Transition_Type_PushWipe = Just (n, str2attr "pushWipe") toAttrFrTyp n Transition_Type_SlideWipe = Just (n, str2attr "slideWipe") toAttrFrTyp n Transition_Type_Fade = Just (n, str2attr "fade") instance XmlAttrType Transition_Subtype where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "bottom" = Just Transition_Subtype_Bottom translate "bottomCenter" = Just Transition_Subtype_BottomCenter translate "bottomLeft" = Just Transition_Subtype_BottomLeft translate "bottomLeftClockwise" = Just Transition_Subtype_BottomLeftClockwise translate "bottomLeftCounterClockwise" = Just Transition_Subtype_BottomLeftCounterClockwise translate "bottomLeftDiagonal" = Just Transition_Subtype_BottomLeftDiagonal translate "bottomRight" = Just Transition_Subtype_BottomRight translate "bottomRightClockwise" = Just Transition_Subtype_BottomRightClockwise translate "bottomRightCounterClockwise" = Just Transition_Subtype_BottomRightCounterClockwise translate "bottomRightDiagonal" = Just Transition_Subtype_BottomRightDiagonal translate "centerRight" = Just Transition_Subtype_CenterRight translate "centerTop" = Just Transition_Subtype_CenterTop translate "circle" = Just Transition_Subtype_Circle translate "clockwiseBottom" = Just Transition_Subtype_ClockwiseBottom translate "clockwiseBottomRight" = Just Transition_Subtype_ClockwiseBottomRight translate "clockwiseLeft" = Just Transition_Subtype_ClockwiseLeft translate "clockwiseNine" = Just Transition_Subtype_ClockwiseNine translate "clockwiseRight" = Just Transition_Subtype_ClockwiseRight translate "clockwiseSix" = Just Transition_Subtype_ClockwiseSix translate "clockwiseThree" = Just Transition_Subtype_ClockwiseThree translate "clockwiseTop" = Just Transition_Subtype_ClockwiseTop translate "clockwiseTopLeft" = Just Transition_Subtype_ClockwiseTopLeft translate "clockwiseTwelve" = Just Transition_Subtype_ClockwiseTwelve translate "cornersIn" = Just Transition_Subtype_CornersIn translate "cornersOut" = Just Transition_Subtype_CornersOut translate "counterClockwiseBottomLeft" = Just Transition_Subtype_CounterClockwiseBottomLeft translate "counterClockwiseTopRight" = Just Transition_Subtype_CounterClockwiseTopRight translate "crossfade" = Just Transition_Subtype_Crossfade translate "diagonalBottomLeft" = Just Transition_Subtype_DiagonalBottomLeft translate "diagonalBottomLeftOpposite" = Just Transition_Subtype_DiagonalBottomLeftOpposite translate "diagonalTopLeft" = Just Transition_Subtype_DiagonalTopLeft translate "diagonalTopLeftOpposite" = Just Transition_Subtype_DiagonalTopLeftOpposite translate "diamond" = Just Transition_Subtype_Diamond translate "doubleBarnDoor" = Just Transition_Subtype_DoubleBarnDoor translate "doubleDiamond" = Just Transition_Subtype_DoubleDiamond translate "down" = Just Transition_Subtype_Down translate "fadeFromColor" = Just Transition_Subtype_FadeFromColor translate "fadeToColor" = Just Transition_Subtype_FadeToColor translate "fanInHorizontal" = Just Transition_Subtype_FanInHorizontal translate "fanInVertical" = Just Transition_Subtype_FanInVertical translate "fanOutHorizontal" = Just Transition_Subtype_FanOutHorizontal translate "fanOutVertical" = Just Transition_Subtype_FanOutVertical translate "fivePoint" = Just Transition_Subtype_FivePoint translate "fourBlade" = Just Transition_Subtype_FourBlade translate "fourBoxHorizontal" = Just Transition_Subtype_FourBoxHorizontal translate "fourBoxVertical" = Just Transition_Subtype_FourBoxVertical translate "fourPoint" = Just Transition_Subtype_FourPoint translate "fromBottom" = Just Transition_Subtype_FromBottom translate "fromLeft" = Just Transition_Subtype_FromLeft translate "fromRight" = Just Transition_Subtype_FromRight translate "fromTop" = Just Transition_Subtype_FromTop translate "heart" = Just Transition_Subtype_Heart translate "horizontal" = Just Transition_Subtype_Horizontal translate "horizontalLeft" = Just Transition_Subtype_HorizontalLeft translate "horizontalLeftSame" = Just Transition_Subtype_HorizontalLeftSame translate "horizontalRight" = Just Transition_Subtype_HorizontalRight translate "horizontalRightSame" = Just Transition_Subtype_HorizontalRightSame translate "horizontalTopLeftOpposite" = Just Transition_Subtype_HorizontalTopLeftOpposite translate "horizontalTopRightOpposite" = Just Transition_Subtype_HorizontalTopRightOpposite translate "keyhole" = Just Transition_Subtype_Keyhole translate "left" = Just Transition_Subtype_Left translate "leftCenter" = Just Transition_Subtype_LeftCenter translate "leftToRight" = Just Transition_Subtype_LeftToRight translate "oppositeHorizontal" = Just Transition_Subtype_OppositeHorizontal translate "oppositeVertical" = Just Transition_Subtype_OppositeVertical translate "parallelDiagonal" = Just Transition_Subtype_ParallelDiagonal translate "parallelDiagonalBottomLeft" = Just Transition_Subtype_ParallelDiagonalBottomLeft translate "parallelDiagonalTopLeft" = Just Transition_Subtype_ParallelDiagonalTopLeft translate "parallelVertical" = Just Transition_Subtype_ParallelVertical translate "rectangle" = Just Transition_Subtype_Rectangle translate "right" = Just Transition_Subtype_Right translate "rightCenter" = Just Transition_Subtype_RightCenter translate "sixPoint" = Just Transition_Subtype_SixPoint translate "top" = Just Transition_Subtype_Top translate "topCenter" = Just Transition_Subtype_TopCenter translate "topLeft" = Just Transition_Subtype_TopLeft translate "topLeftClockwise" = Just Transition_Subtype_TopLeftClockwise translate "topLeftCounterClockwise" = Just Transition_Subtype_TopLeftCounterClockwise translate "topLeftDiagonal" = Just Transition_Subtype_TopLeftDiagonal translate "topLeftHorizontal" = Just Transition_Subtype_TopLeftHorizontal translate "topLeftVertical" = Just Transition_Subtype_TopLeftVertical translate "topRight" = Just Transition_Subtype_TopRight translate "topRightClockwise" = Just Transition_Subtype_TopRightClockwise translate "topRightCounterClockwise" = Just Transition_Subtype_TopRightCounterClockwise translate "topRightDiagonal" = Just Transition_Subtype_TopRightDiagonal translate "topToBottom" = Just Transition_Subtype_TopToBottom translate "twoBladeHorizontal" = Just Transition_Subtype_TwoBladeHorizontal translate "twoBladeVertical" = Just Transition_Subtype_TwoBladeVertical translate "twoBoxBottom" = Just Transition_Subtype_TwoBoxBottom translate "twoBoxLeft" = Just Transition_Subtype_TwoBoxLeft translate "twoBoxRight" = Just Transition_Subtype_TwoBoxRight translate "twoBoxTop" = Just Transition_Subtype_TwoBoxTop translate "up" = Just Transition_Subtype_Up translate "vertical" = Just Transition_Subtype_Vertical translate "verticalBottomLeftOpposite" = Just Transition_Subtype_VerticalBottomLeftOpposite translate "verticalBottomSame" = Just Transition_Subtype_VerticalBottomSame translate "verticalLeft" = Just Transition_Subtype_VerticalLeft translate "verticalRight" = Just Transition_Subtype_VerticalRight translate "verticalTopLeftOpposite" = Just Transition_Subtype_VerticalTopLeftOpposite translate "verticalTopSame" = Just Transition_Subtype_VerticalTopSame translate _ = Nothing toAttrFrTyp n Transition_Subtype_Bottom = Just (n, str2attr "bottom") toAttrFrTyp n Transition_Subtype_BottomCenter = Just (n, str2attr "bottomCenter") toAttrFrTyp n Transition_Subtype_BottomLeft = Just (n, str2attr "bottomLeft") toAttrFrTyp n Transition_Subtype_BottomLeftClockwise = Just (n, str2attr "bottomLeftClockwise") toAttrFrTyp n Transition_Subtype_BottomLeftCounterClockwise = Just (n, str2attr "bottomLeftCounterClockwise") toAttrFrTyp n Transition_Subtype_BottomLeftDiagonal = Just (n, str2attr "bottomLeftDiagonal") toAttrFrTyp n Transition_Subtype_BottomRight = Just (n, str2attr "bottomRight") toAttrFrTyp n Transition_Subtype_BottomRightClockwise = Just (n, str2attr "bottomRightClockwise") toAttrFrTyp n Transition_Subtype_BottomRightCounterClockwise = Just (n, str2attr "bottomRightCounterClockwise") toAttrFrTyp n Transition_Subtype_BottomRightDiagonal = Just (n, str2attr "bottomRightDiagonal") toAttrFrTyp n Transition_Subtype_CenterRight = Just (n, str2attr "centerRight") toAttrFrTyp n Transition_Subtype_CenterTop = Just (n, str2attr "centerTop") toAttrFrTyp n Transition_Subtype_Circle = Just (n, str2attr "circle") toAttrFrTyp n Transition_Subtype_ClockwiseBottom = Just (n, str2attr "clockwiseBottom") toAttrFrTyp n Transition_Subtype_ClockwiseBottomRight = Just (n, str2attr "clockwiseBottomRight") toAttrFrTyp n Transition_Subtype_ClockwiseLeft = Just (n, str2attr "clockwiseLeft") toAttrFrTyp n Transition_Subtype_ClockwiseNine = Just (n, str2attr "clockwiseNine") toAttrFrTyp n Transition_Subtype_ClockwiseRight = Just (n, str2attr "clockwiseRight") toAttrFrTyp n Transition_Subtype_ClockwiseSix = Just (n, str2attr "clockwiseSix") toAttrFrTyp n Transition_Subtype_ClockwiseThree = Just (n, str2attr "clockwiseThree") toAttrFrTyp n Transition_Subtype_ClockwiseTop = Just (n, str2attr "clockwiseTop") toAttrFrTyp n Transition_Subtype_ClockwiseTopLeft = Just (n, str2attr "clockwiseTopLeft") toAttrFrTyp n Transition_Subtype_ClockwiseTwelve = Just (n, str2attr "clockwiseTwelve") toAttrFrTyp n Transition_Subtype_CornersIn = Just (n, str2attr "cornersIn") toAttrFrTyp n Transition_Subtype_CornersOut = Just (n, str2attr "cornersOut") toAttrFrTyp n Transition_Subtype_CounterClockwiseBottomLeft = Just (n, str2attr "counterClockwiseBottomLeft") toAttrFrTyp n Transition_Subtype_CounterClockwiseTopRight = Just (n, str2attr "counterClockwiseTopRight") toAttrFrTyp n Transition_Subtype_Crossfade = Just (n, str2attr "crossfade") toAttrFrTyp n Transition_Subtype_DiagonalBottomLeft = Just (n, str2attr "diagonalBottomLeft") toAttrFrTyp n Transition_Subtype_DiagonalBottomLeftOpposite = Just (n, str2attr "diagonalBottomLeftOpposite") toAttrFrTyp n Transition_Subtype_DiagonalTopLeft = Just (n, str2attr "diagonalTopLeft") toAttrFrTyp n Transition_Subtype_DiagonalTopLeftOpposite = Just (n, str2attr "diagonalTopLeftOpposite") toAttrFrTyp n Transition_Subtype_Diamond = Just (n, str2attr "diamond") toAttrFrTyp n Transition_Subtype_DoubleBarnDoor = Just (n, str2attr "doubleBarnDoor") toAttrFrTyp n Transition_Subtype_DoubleDiamond = Just (n, str2attr "doubleDiamond") toAttrFrTyp n Transition_Subtype_Down = Just (n, str2attr "down") toAttrFrTyp n Transition_Subtype_FadeFromColor = Just (n, str2attr "fadeFromColor") toAttrFrTyp n Transition_Subtype_FadeToColor = Just (n, str2attr "fadeToColor") toAttrFrTyp n Transition_Subtype_FanInHorizontal = Just (n, str2attr "fanInHorizontal") toAttrFrTyp n Transition_Subtype_FanInVertical = Just (n, str2attr "fanInVertical") toAttrFrTyp n Transition_Subtype_FanOutHorizontal = Just (n, str2attr "fanOutHorizontal") toAttrFrTyp n Transition_Subtype_FanOutVertical = Just (n, str2attr "fanOutVertical") toAttrFrTyp n Transition_Subtype_FivePoint = Just (n, str2attr "fivePoint") toAttrFrTyp n Transition_Subtype_FourBlade = Just (n, str2attr "fourBlade") toAttrFrTyp n Transition_Subtype_FourBoxHorizontal = Just (n, str2attr "fourBoxHorizontal") toAttrFrTyp n Transition_Subtype_FourBoxVertical = Just (n, str2attr "fourBoxVertical") toAttrFrTyp n Transition_Subtype_FourPoint = Just (n, str2attr "fourPoint") toAttrFrTyp n Transition_Subtype_FromBottom = Just (n, str2attr "fromBottom") toAttrFrTyp n Transition_Subtype_FromLeft = Just (n, str2attr "fromLeft") toAttrFrTyp n Transition_Subtype_FromRight = Just (n, str2attr "fromRight") toAttrFrTyp n Transition_Subtype_FromTop = Just (n, str2attr "fromTop") toAttrFrTyp n Transition_Subtype_Heart = Just (n, str2attr "heart") toAttrFrTyp n Transition_Subtype_Horizontal = Just (n, str2attr "horizontal") toAttrFrTyp n Transition_Subtype_HorizontalLeft = Just (n, str2attr "horizontalLeft") toAttrFrTyp n Transition_Subtype_HorizontalLeftSame = Just (n, str2attr "horizontalLeftSame") toAttrFrTyp n Transition_Subtype_HorizontalRight = Just (n, str2attr "horizontalRight") toAttrFrTyp n Transition_Subtype_HorizontalRightSame = Just (n, str2attr "horizontalRightSame") toAttrFrTyp n Transition_Subtype_HorizontalTopLeftOpposite = Just (n, str2attr "horizontalTopLeftOpposite") toAttrFrTyp n Transition_Subtype_HorizontalTopRightOpposite = Just (n, str2attr "horizontalTopRightOpposite") toAttrFrTyp n Transition_Subtype_Keyhole = Just (n, str2attr "keyhole") toAttrFrTyp n Transition_Subtype_Left = Just (n, str2attr "left") toAttrFrTyp n Transition_Subtype_LeftCenter = Just (n, str2attr "leftCenter") toAttrFrTyp n Transition_Subtype_LeftToRight = Just (n, str2attr "leftToRight") toAttrFrTyp n Transition_Subtype_OppositeHorizontal = Just (n, str2attr "oppositeHorizontal") toAttrFrTyp n Transition_Subtype_OppositeVertical = Just (n, str2attr "oppositeVertical") toAttrFrTyp n Transition_Subtype_ParallelDiagonal = Just (n, str2attr "parallelDiagonal") toAttrFrTyp n Transition_Subtype_ParallelDiagonalBottomLeft = Just (n, str2attr "parallelDiagonalBottomLeft") toAttrFrTyp n Transition_Subtype_ParallelDiagonalTopLeft = Just (n, str2attr "parallelDiagonalTopLeft") toAttrFrTyp n Transition_Subtype_ParallelVertical = Just (n, str2attr "parallelVertical") toAttrFrTyp n Transition_Subtype_Rectangle = Just (n, str2attr "rectangle") toAttrFrTyp n Transition_Subtype_Right = Just (n, str2attr "right") toAttrFrTyp n Transition_Subtype_RightCenter = Just (n, str2attr "rightCenter") toAttrFrTyp n Transition_Subtype_SixPoint = Just (n, str2attr "sixPoint") toAttrFrTyp n Transition_Subtype_Top = Just (n, str2attr "top") toAttrFrTyp n Transition_Subtype_TopCenter = Just (n, str2attr "topCenter") toAttrFrTyp n Transition_Subtype_TopLeft = Just (n, str2attr "topLeft") toAttrFrTyp n Transition_Subtype_TopLeftClockwise = Just (n, str2attr "topLeftClockwise") toAttrFrTyp n Transition_Subtype_TopLeftCounterClockwise = Just (n, str2attr "topLeftCounterClockwise") toAttrFrTyp n Transition_Subtype_TopLeftDiagonal = Just (n, str2attr "topLeftDiagonal") toAttrFrTyp n Transition_Subtype_TopLeftHorizontal = Just (n, str2attr "topLeftHorizontal") toAttrFrTyp n Transition_Subtype_TopLeftVertical = Just (n, str2attr "topLeftVertical") toAttrFrTyp n Transition_Subtype_TopRight = Just (n, str2attr "topRight") toAttrFrTyp n Transition_Subtype_TopRightClockwise = Just (n, str2attr "topRightClockwise") toAttrFrTyp n Transition_Subtype_TopRightCounterClockwise = Just (n, str2attr "topRightCounterClockwise") toAttrFrTyp n Transition_Subtype_TopRightDiagonal = Just (n, str2attr "topRightDiagonal") toAttrFrTyp n Transition_Subtype_TopToBottom = Just (n, str2attr "topToBottom") toAttrFrTyp n Transition_Subtype_TwoBladeHorizontal = Just (n, str2attr "twoBladeHorizontal") toAttrFrTyp n Transition_Subtype_TwoBladeVertical = Just (n, str2attr "twoBladeVertical") toAttrFrTyp n Transition_Subtype_TwoBoxBottom = Just (n, str2attr "twoBoxBottom") toAttrFrTyp n Transition_Subtype_TwoBoxLeft = Just (n, str2attr "twoBoxLeft") toAttrFrTyp n Transition_Subtype_TwoBoxRight = Just (n, str2attr "twoBoxRight") toAttrFrTyp n Transition_Subtype_TwoBoxTop = Just (n, str2attr "twoBoxTop") toAttrFrTyp n Transition_Subtype_Up = Just (n, str2attr "up") toAttrFrTyp n Transition_Subtype_Vertical = Just (n, str2attr "vertical") toAttrFrTyp n Transition_Subtype_VerticalBottomLeftOpposite = Just (n, str2attr "verticalBottomLeftOpposite") toAttrFrTyp n Transition_Subtype_VerticalBottomSame = Just (n, str2attr "verticalBottomSame") toAttrFrTyp n Transition_Subtype_VerticalLeft = Just (n, str2attr "verticalLeft") toAttrFrTyp n Transition_Subtype_VerticalRight = Just (n, str2attr "verticalRight") toAttrFrTyp n Transition_Subtype_VerticalTopLeftOpposite = Just (n, str2attr "verticalTopLeftOpposite") toAttrFrTyp n Transition_Subtype_VerticalTopSame = Just (n, str2attr "verticalTopSame") instance XmlAttrType Transition_Coordinated where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "true" = Just Transition_Coordinated_True translate "false" = Just Transition_Coordinated_False translate _ = Nothing toAttrFrTyp n Transition_Coordinated_True = Just (n, str2attr "true") toAttrFrTyp n Transition_Coordinated_False = Just (n, str2attr "false") instance XmlAttrType Transition_ClibBoundary where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "parent" = Just Transition_ClibBoundary_Parent translate "children" = Just Transition_ClibBoundary_Children translate _ = Nothing toAttrFrTyp n Transition_ClibBoundary_Parent = Just (n, str2attr "parent") toAttrFrTyp n Transition_ClibBoundary_Children = Just (n, str2attr "children") instance XmlAttrType Transition_Direction where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "forward" = Just Transition_Direction_Forward translate "reverse" = Just Transition_Direction_Reverse translate _ = Nothing toAttrFrTyp n Transition_Direction_Forward = Just (n, str2attr "forward") toAttrFrTyp n Transition_Direction_Reverse = Just (n, str2attr "reverse") instance XmlContent TransitionFilter where fromElem (CElem (Elem "transitionFilter" as []):rest) = (Just (fromAttrs as), rest) fromElem (CMisc _:rest) = fromElem rest fromElem rest = (Nothing, rest) toElem as = [CElem (Elem "transitionFilter" (toAttrs as) [])] instance XmlAttributes TransitionFilter where fromAttrs as = TransitionFilter { transitionFilterId = possibleA fromAttrToStr "id" as , transitionFilterClass = possibleA fromAttrToStr "class" as , transitionFilterTitle = possibleA fromAttrToStr "title" as , transitionFilterXml'lang = possibleA fromAttrToStr "xml:lang" as , transitionFilterType = possibleA fromAttrToTyp "type" as , transitionFilterSubtype = possibleA fromAttrToTyp "subtype" as , transitionFilterHorzRepeat = defaultA fromAttrToStr "0" "horzRepeat" as , transitionFilterVertRepeat = defaultA fromAttrToStr "0" "vertRepeat" as , transitionFilterBorderWidth = defaultA fromAttrToStr "0" "borderWidth" as , transitionFilterBorderColor = defaultA fromAttrToStr "black" "borderColor" as , transitionFilterFadeColor = defaultA fromAttrToStr "black" "fadeColor" as , transitionFilterCoordinated = defaultA fromAttrToTyp TransitionFilter_Coordinated_False "coordinated" as , transitionFilterClibBoundary = defaultA fromAttrToTyp TransitionFilter_ClibBoundary_Children "clibBoundary" as , transitionFilterDur = possibleA fromAttrToStr "dur" as , transitionFilterRepeatCount = possibleA fromAttrToStr "repeatCount" as , transitionFilterRepeatDur = possibleA fromAttrToStr "repeatDur" as , transitionFilterBegin = possibleA fromAttrToStr "begin" as , transitionFilterEnd = possibleA fromAttrToStr "end" as , transitionFilterValues = possibleA fromAttrToStr "values" as , transitionFilterFrom = possibleA fromAttrToStr "from" as , transitionFilterTo = possibleA fromAttrToStr "to" as , transitionFilterBy = possibleA fromAttrToStr "by" as , transitionFilterCalcMode = defaultA fromAttrToTyp TransitionFilter_CalcMode_Linear "calcMode" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (transitionFilterId v) , maybeToAttr toAttrFrStr "class" (transitionFilterClass v) , maybeToAttr toAttrFrStr "title" (transitionFilterTitle v) , maybeToAttr toAttrFrStr "xml:lang" (transitionFilterXml'lang v) , maybeToAttr toAttrFrTyp "type" (transitionFilterType v) , maybeToAttr toAttrFrTyp "subtype" (transitionFilterSubtype v) , defaultToAttr toAttrFrStr "horzRepeat" (transitionFilterHorzRepeat v) , defaultToAttr toAttrFrStr "vertRepeat" (transitionFilterVertRepeat v) , defaultToAttr toAttrFrStr "borderWidth" (transitionFilterBorderWidth v) , defaultToAttr toAttrFrStr "borderColor" (transitionFilterBorderColor v) , defaultToAttr toAttrFrStr "fadeColor" (transitionFilterFadeColor v) , defaultToAttr toAttrFrTyp "coordinated" (transitionFilterCoordinated v) , defaultToAttr toAttrFrTyp "clibBoundary" (transitionFilterClibBoundary v) , maybeToAttr toAttrFrStr "dur" (transitionFilterDur v) , maybeToAttr toAttrFrStr "repeatCount" (transitionFilterRepeatCount v) , maybeToAttr toAttrFrStr "repeatDur" (transitionFilterRepeatDur v) , maybeToAttr toAttrFrStr "begin" (transitionFilterBegin v) , maybeToAttr toAttrFrStr "end" (transitionFilterEnd v) , maybeToAttr toAttrFrStr "values" (transitionFilterValues v) , maybeToAttr toAttrFrStr "from" (transitionFilterFrom v) , maybeToAttr toAttrFrStr "to" (transitionFilterTo v) , maybeToAttr toAttrFrStr "by" (transitionFilterBy v) , defaultToAttr toAttrFrTyp "calcMode" (transitionFilterCalcMode v) ] instance XmlAttrType TransitionFilter_Type where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "barWipe" = Just TransitionFilter_Type_BarWipe translate "boxWipe" = Just TransitionFilter_Type_BoxWipe translate "fourBoxWipe" = Just TransitionFilter_Type_FourBoxWipe translate "barnDoorWipe" = Just TransitionFilter_Type_BarnDoorWipe translate "diagonalWipe" = Just TransitionFilter_Type_DiagonalWipe translate "bowTieWipe" = Just TransitionFilter_Type_BowTieWipe translate "miscDiagonalWipe" = Just TransitionFilter_Type_MiscDiagonalWipe translate "veeWipe" = Just TransitionFilter_Type_VeeWipe translate "barnVeeWipe" = Just TransitionFilter_Type_BarnVeeWipe translate "zigZagWipe" = Just TransitionFilter_Type_ZigZagWipe translate "barnZigZagWipe" = Just TransitionFilter_Type_BarnZigZagWipe translate "miscShapeWipe" = Just TransitionFilter_Type_MiscShapeWipe translate "triangleWipe" = Just TransitionFilter_Type_TriangleWipe translate "arrowHeadWipe" = Just TransitionFilter_Type_ArrowHeadWipe translate "pentagonWipe" = Just TransitionFilter_Type_PentagonWipe translate "hexagonWipe" = Just TransitionFilter_Type_HexagonWipe translate "ellipseWipe" = Just TransitionFilter_Type_EllipseWipe translate "eyeWipe" = Just TransitionFilter_Type_EyeWipe translate "roundRectWipe" = Just TransitionFilter_Type_RoundRectWipe translate "starWipe" = Just TransitionFilter_Type_StarWipe translate "clockWipe" = Just TransitionFilter_Type_ClockWipe translate "pinWheelWipe" = Just TransitionFilter_Type_PinWheelWipe translate "singleSweepWipe" = Just TransitionFilter_Type_SingleSweepWipe translate "fanWipe" = Just TransitionFilter_Type_FanWipe translate "doubleFanWipe" = Just TransitionFilter_Type_DoubleFanWipe translate "doubleSweepWipe" = Just TransitionFilter_Type_DoubleSweepWipe translate "saloonDoorWipe" = Just TransitionFilter_Type_SaloonDoorWipe translate "windshieldWipe" = Just TransitionFilter_Type_WindshieldWipe translate "snakeWipe" = Just TransitionFilter_Type_SnakeWipe translate "spiralWipe" = Just TransitionFilter_Type_SpiralWipe translate "parallelSnakesWipe" = Just TransitionFilter_Type_ParallelSnakesWipe translate "boxSnakesWipe" = Just TransitionFilter_Type_BoxSnakesWipe translate "waterfallWipe" = Just TransitionFilter_Type_WaterfallWipe translate "pushWipe" = Just TransitionFilter_Type_PushWipe translate "slideWipe" = Just TransitionFilter_Type_SlideWipe translate "fade" = Just TransitionFilter_Type_Fade translate _ = Nothing toAttrFrTyp n TransitionFilter_Type_BarWipe = Just (n, str2attr "barWipe") toAttrFrTyp n TransitionFilter_Type_BoxWipe = Just (n, str2attr "boxWipe") toAttrFrTyp n TransitionFilter_Type_FourBoxWipe = Just (n, str2attr "fourBoxWipe") toAttrFrTyp n TransitionFilter_Type_BarnDoorWipe = Just (n, str2attr "barnDoorWipe") toAttrFrTyp n TransitionFilter_Type_DiagonalWipe = Just (n, str2attr "diagonalWipe") toAttrFrTyp n TransitionFilter_Type_BowTieWipe = Just (n, str2attr "bowTieWipe") toAttrFrTyp n TransitionFilter_Type_MiscDiagonalWipe = Just (n, str2attr "miscDiagonalWipe") toAttrFrTyp n TransitionFilter_Type_VeeWipe = Just (n, str2attr "veeWipe") toAttrFrTyp n TransitionFilter_Type_BarnVeeWipe = Just (n, str2attr "barnVeeWipe") toAttrFrTyp n TransitionFilter_Type_ZigZagWipe = Just (n, str2attr "zigZagWipe") toAttrFrTyp n TransitionFilter_Type_BarnZigZagWipe = Just (n, str2attr "barnZigZagWipe") toAttrFrTyp n TransitionFilter_Type_MiscShapeWipe = Just (n, str2attr "miscShapeWipe") toAttrFrTyp n TransitionFilter_Type_TriangleWipe = Just (n, str2attr "triangleWipe") toAttrFrTyp n TransitionFilter_Type_ArrowHeadWipe = Just (n, str2attr "arrowHeadWipe") toAttrFrTyp n TransitionFilter_Type_PentagonWipe = Just (n, str2attr "pentagonWipe") toAttrFrTyp n TransitionFilter_Type_HexagonWipe = Just (n, str2attr "hexagonWipe") toAttrFrTyp n TransitionFilter_Type_EllipseWipe = Just (n, str2attr "ellipseWipe") toAttrFrTyp n TransitionFilter_Type_EyeWipe = Just (n, str2attr "eyeWipe") toAttrFrTyp n TransitionFilter_Type_RoundRectWipe = Just (n, str2attr "roundRectWipe") toAttrFrTyp n TransitionFilter_Type_StarWipe = Just (n, str2attr "starWipe") toAttrFrTyp n TransitionFilter_Type_ClockWipe = Just (n, str2attr "clockWipe") toAttrFrTyp n TransitionFilter_Type_PinWheelWipe = Just (n, str2attr "pinWheelWipe") toAttrFrTyp n TransitionFilter_Type_SingleSweepWipe = Just (n, str2attr "singleSweepWipe") toAttrFrTyp n TransitionFilter_Type_FanWipe = Just (n, str2attr "fanWipe") toAttrFrTyp n TransitionFilter_Type_DoubleFanWipe = Just (n, str2attr "doubleFanWipe") toAttrFrTyp n TransitionFilter_Type_DoubleSweepWipe = Just (n, str2attr "doubleSweepWipe") toAttrFrTyp n TransitionFilter_Type_SaloonDoorWipe = Just (n, str2attr "saloonDoorWipe") toAttrFrTyp n TransitionFilter_Type_WindshieldWipe = Just (n, str2attr "windshieldWipe") toAttrFrTyp n TransitionFilter_Type_SnakeWipe = Just (n, str2attr "snakeWipe") toAttrFrTyp n TransitionFilter_Type_SpiralWipe = Just (n, str2attr "spiralWipe") toAttrFrTyp n TransitionFilter_Type_ParallelSnakesWipe = Just (n, str2attr "parallelSnakesWipe") toAttrFrTyp n TransitionFilter_Type_BoxSnakesWipe = Just (n, str2attr "boxSnakesWipe") toAttrFrTyp n TransitionFilter_Type_WaterfallWipe = Just (n, str2attr "waterfallWipe") toAttrFrTyp n TransitionFilter_Type_PushWipe = Just (n, str2attr "pushWipe") toAttrFrTyp n TransitionFilter_Type_SlideWipe = Just (n, str2attr "slideWipe") toAttrFrTyp n TransitionFilter_Type_Fade = Just (n, str2attr "fade") instance XmlAttrType TransitionFilter_Subtype where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "bottom" = Just TransitionFilter_Subtype_Bottom translate "bottomCenter" = Just TransitionFilter_Subtype_BottomCenter translate "bottomLeft" = Just TransitionFilter_Subtype_BottomLeft translate "bottomLeftClockwise" = Just TransitionFilter_Subtype_BottomLeftClockwise translate "bottomLeftCounterClockwise" = Just TransitionFilter_Subtype_BottomLeftCounterClockwise translate "bottomLeftDiagonal" = Just TransitionFilter_Subtype_BottomLeftDiagonal translate "bottomRight" = Just TransitionFilter_Subtype_BottomRight translate "bottomRightClockwise" = Just TransitionFilter_Subtype_BottomRightClockwise translate "bottomRightCounterClockwise" = Just TransitionFilter_Subtype_BottomRightCounterClockwise translate "bottomRightDiagonal" = Just TransitionFilter_Subtype_BottomRightDiagonal translate "centerRight" = Just TransitionFilter_Subtype_CenterRight translate "centerTop" = Just TransitionFilter_Subtype_CenterTop translate "circle" = Just TransitionFilter_Subtype_Circle translate "clockwiseBottom" = Just TransitionFilter_Subtype_ClockwiseBottom translate "clockwiseBottomRight" = Just TransitionFilter_Subtype_ClockwiseBottomRight translate "clockwiseLeft" = Just TransitionFilter_Subtype_ClockwiseLeft translate "clockwiseNine" = Just TransitionFilter_Subtype_ClockwiseNine translate "clockwiseRight" = Just TransitionFilter_Subtype_ClockwiseRight translate "clockwiseSix" = Just TransitionFilter_Subtype_ClockwiseSix translate "clockwiseThree" = Just TransitionFilter_Subtype_ClockwiseThree translate "clockwiseTop" = Just TransitionFilter_Subtype_ClockwiseTop translate "clockwiseTopLeft" = Just TransitionFilter_Subtype_ClockwiseTopLeft translate "clockwiseTwelve" = Just TransitionFilter_Subtype_ClockwiseTwelve translate "cornersIn" = Just TransitionFilter_Subtype_CornersIn translate "cornersOut" = Just TransitionFilter_Subtype_CornersOut translate "counterClockwiseBottomLeft" = Just TransitionFilter_Subtype_CounterClockwiseBottomLeft translate "counterClockwiseTopRight" = Just TransitionFilter_Subtype_CounterClockwiseTopRight translate "crossfade" = Just TransitionFilter_Subtype_Crossfade translate "diagonalBottomLeft" = Just TransitionFilter_Subtype_DiagonalBottomLeft translate "diagonalBottomLeftOpposite" = Just TransitionFilter_Subtype_DiagonalBottomLeftOpposite translate "diagonalTopLeft" = Just TransitionFilter_Subtype_DiagonalTopLeft translate "diagonalTopLeftOpposite" = Just TransitionFilter_Subtype_DiagonalTopLeftOpposite translate "diamond" = Just TransitionFilter_Subtype_Diamond translate "doubleBarnDoor" = Just TransitionFilter_Subtype_DoubleBarnDoor translate "doubleDiamond" = Just TransitionFilter_Subtype_DoubleDiamond translate "down" = Just TransitionFilter_Subtype_Down translate "fadeFromColor" = Just TransitionFilter_Subtype_FadeFromColor translate "fadeToColor" = Just TransitionFilter_Subtype_FadeToColor translate "fanInHorizontal" = Just TransitionFilter_Subtype_FanInHorizontal translate "fanInVertical" = Just TransitionFilter_Subtype_FanInVertical translate "fanOutHorizontal" = Just TransitionFilter_Subtype_FanOutHorizontal translate "fanOutVertical" = Just TransitionFilter_Subtype_FanOutVertical translate "fivePoint" = Just TransitionFilter_Subtype_FivePoint translate "fourBlade" = Just TransitionFilter_Subtype_FourBlade translate "fourBoxHorizontal" = Just TransitionFilter_Subtype_FourBoxHorizontal translate "fourBoxVertical" = Just TransitionFilter_Subtype_FourBoxVertical translate "fourPoint" = Just TransitionFilter_Subtype_FourPoint translate "fromBottom" = Just TransitionFilter_Subtype_FromBottom translate "fromLeft" = Just TransitionFilter_Subtype_FromLeft translate "fromRight" = Just TransitionFilter_Subtype_FromRight translate "fromTop" = Just TransitionFilter_Subtype_FromTop translate "heart" = Just TransitionFilter_Subtype_Heart translate "horizontal" = Just TransitionFilter_Subtype_Horizontal translate "horizontalLeft" = Just TransitionFilter_Subtype_HorizontalLeft translate "horizontalLeftSame" = Just TransitionFilter_Subtype_HorizontalLeftSame translate "horizontalRight" = Just TransitionFilter_Subtype_HorizontalRight translate "horizontalRightSame" = Just TransitionFilter_Subtype_HorizontalRightSame translate "horizontalTopLeftOpposite" = Just TransitionFilter_Subtype_HorizontalTopLeftOpposite translate "horizontalTopRightOpposite" = Just TransitionFilter_Subtype_HorizontalTopRightOpposite translate "keyhole" = Just TransitionFilter_Subtype_Keyhole translate "left" = Just TransitionFilter_Subtype_Left translate "leftCenter" = Just TransitionFilter_Subtype_LeftCenter translate "leftToRight" = Just TransitionFilter_Subtype_LeftToRight translate "oppositeHorizontal" = Just TransitionFilter_Subtype_OppositeHorizontal translate "oppositeVertical" = Just TransitionFilter_Subtype_OppositeVertical translate "parallelDiagonal" = Just TransitionFilter_Subtype_ParallelDiagonal translate "parallelDiagonalBottomLeft" = Just TransitionFilter_Subtype_ParallelDiagonalBottomLeft translate "parallelDiagonalTopLeft" = Just TransitionFilter_Subtype_ParallelDiagonalTopLeft translate "parallelVertical" = Just TransitionFilter_Subtype_ParallelVertical translate "rectangle" = Just TransitionFilter_Subtype_Rectangle translate "right" = Just TransitionFilter_Subtype_Right translate "rightCenter" = Just TransitionFilter_Subtype_RightCenter translate "sixPoint" = Just TransitionFilter_Subtype_SixPoint translate "top" = Just TransitionFilter_Subtype_Top translate "topCenter" = Just TransitionFilter_Subtype_TopCenter translate "topLeft" = Just TransitionFilter_Subtype_TopLeft translate "topLeftClockwise" = Just TransitionFilter_Subtype_TopLeftClockwise translate "topLeftCounterClockwise" = Just TransitionFilter_Subtype_TopLeftCounterClockwise translate "topLeftDiagonal" = Just TransitionFilter_Subtype_TopLeftDiagonal translate "topLeftHorizontal" = Just TransitionFilter_Subtype_TopLeftHorizontal translate "topLeftVertical" = Just TransitionFilter_Subtype_TopLeftVertical translate "topRight" = Just TransitionFilter_Subtype_TopRight translate "topRightClockwise" = Just TransitionFilter_Subtype_TopRightClockwise translate "topRightCounterClockwise" = Just TransitionFilter_Subtype_TopRightCounterClockwise translate "topRightDiagonal" = Just TransitionFilter_Subtype_TopRightDiagonal translate "topToBottom" = Just TransitionFilter_Subtype_TopToBottom translate "twoBladeHorizontal" = Just TransitionFilter_Subtype_TwoBladeHorizontal translate "twoBladeVertical" = Just TransitionFilter_Subtype_TwoBladeVertical translate "twoBoxBottom" = Just TransitionFilter_Subtype_TwoBoxBottom translate "twoBoxLeft" = Just TransitionFilter_Subtype_TwoBoxLeft translate "twoBoxRight" = Just TransitionFilter_Subtype_TwoBoxRight translate "twoBoxTop" = Just TransitionFilter_Subtype_TwoBoxTop translate "up" = Just TransitionFilter_Subtype_Up translate "vertical" = Just TransitionFilter_Subtype_Vertical translate "verticalBottomLeftOpposite" = Just TransitionFilter_Subtype_VerticalBottomLeftOpposite translate "verticalBottomSame" = Just TransitionFilter_Subtype_VerticalBottomSame translate "verticalLeft" = Just TransitionFilter_Subtype_VerticalLeft translate "verticalRight" = Just TransitionFilter_Subtype_VerticalRight translate "verticalTopLeftOpposite" = Just TransitionFilter_Subtype_VerticalTopLeftOpposite translate "verticalTopSame" = Just TransitionFilter_Subtype_VerticalTopSame translate _ = Nothing toAttrFrTyp n TransitionFilter_Subtype_Bottom = Just (n, str2attr "bottom") toAttrFrTyp n TransitionFilter_Subtype_BottomCenter = Just (n, str2attr "bottomCenter") toAttrFrTyp n TransitionFilter_Subtype_BottomLeft = Just (n, str2attr "bottomLeft") toAttrFrTyp n TransitionFilter_Subtype_BottomLeftClockwise = Just (n, str2attr "bottomLeftClockwise") toAttrFrTyp n TransitionFilter_Subtype_BottomLeftCounterClockwise = Just (n, str2attr "bottomLeftCounterClockwise") toAttrFrTyp n TransitionFilter_Subtype_BottomLeftDiagonal = Just (n, str2attr "bottomLeftDiagonal") toAttrFrTyp n TransitionFilter_Subtype_BottomRight = Just (n, str2attr "bottomRight") toAttrFrTyp n TransitionFilter_Subtype_BottomRightClockwise = Just (n, str2attr "bottomRightClockwise") toAttrFrTyp n TransitionFilter_Subtype_BottomRightCounterClockwise = Just (n, str2attr "bottomRightCounterClockwise") toAttrFrTyp n TransitionFilter_Subtype_BottomRightDiagonal = Just (n, str2attr "bottomRightDiagonal") toAttrFrTyp n TransitionFilter_Subtype_CenterRight = Just (n, str2attr "centerRight") toAttrFrTyp n TransitionFilter_Subtype_CenterTop = Just (n, str2attr "centerTop") toAttrFrTyp n TransitionFilter_Subtype_Circle = Just (n, str2attr "circle") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseBottom = Just (n, str2attr "clockwiseBottom") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseBottomRight = Just (n, str2attr "clockwiseBottomRight") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseLeft = Just (n, str2attr "clockwiseLeft") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseNine = Just (n, str2attr "clockwiseNine") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseRight = Just (n, str2attr "clockwiseRight") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseSix = Just (n, str2attr "clockwiseSix") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseThree = Just (n, str2attr "clockwiseThree") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseTop = Just (n, str2attr "clockwiseTop") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseTopLeft = Just (n, str2attr "clockwiseTopLeft") toAttrFrTyp n TransitionFilter_Subtype_ClockwiseTwelve = Just (n, str2attr "clockwiseTwelve") toAttrFrTyp n TransitionFilter_Subtype_CornersIn = Just (n, str2attr "cornersIn") toAttrFrTyp n TransitionFilter_Subtype_CornersOut = Just (n, str2attr "cornersOut") toAttrFrTyp n TransitionFilter_Subtype_CounterClockwiseBottomLeft = Just (n, str2attr "counterClockwiseBottomLeft") toAttrFrTyp n TransitionFilter_Subtype_CounterClockwiseTopRight = Just (n, str2attr "counterClockwiseTopRight") toAttrFrTyp n TransitionFilter_Subtype_Crossfade = Just (n, str2attr "crossfade") toAttrFrTyp n TransitionFilter_Subtype_DiagonalBottomLeft = Just (n, str2attr "diagonalBottomLeft") toAttrFrTyp n TransitionFilter_Subtype_DiagonalBottomLeftOpposite = Just (n, str2attr "diagonalBottomLeftOpposite") toAttrFrTyp n TransitionFilter_Subtype_DiagonalTopLeft = Just (n, str2attr "diagonalTopLeft") toAttrFrTyp n TransitionFilter_Subtype_DiagonalTopLeftOpposite = Just (n, str2attr "diagonalTopLeftOpposite") toAttrFrTyp n TransitionFilter_Subtype_Diamond = Just (n, str2attr "diamond") toAttrFrTyp n TransitionFilter_Subtype_DoubleBarnDoor = Just (n, str2attr "doubleBarnDoor") toAttrFrTyp n TransitionFilter_Subtype_DoubleDiamond = Just (n, str2attr "doubleDiamond") toAttrFrTyp n TransitionFilter_Subtype_Down = Just (n, str2attr "down") toAttrFrTyp n TransitionFilter_Subtype_FadeFromColor = Just (n, str2attr "fadeFromColor") toAttrFrTyp n TransitionFilter_Subtype_FadeToColor = Just (n, str2attr "fadeToColor") toAttrFrTyp n TransitionFilter_Subtype_FanInHorizontal = Just (n, str2attr "fanInHorizontal") toAttrFrTyp n TransitionFilter_Subtype_FanInVertical = Just (n, str2attr "fanInVertical") toAttrFrTyp n TransitionFilter_Subtype_FanOutHorizontal = Just (n, str2attr "fanOutHorizontal") toAttrFrTyp n TransitionFilter_Subtype_FanOutVertical = Just (n, str2attr "fanOutVertical") toAttrFrTyp n TransitionFilter_Subtype_FivePoint = Just (n, str2attr "fivePoint") toAttrFrTyp n TransitionFilter_Subtype_FourBlade = Just (n, str2attr "fourBlade") toAttrFrTyp n TransitionFilter_Subtype_FourBoxHorizontal = Just (n, str2attr "fourBoxHorizontal") toAttrFrTyp n TransitionFilter_Subtype_FourBoxVertical = Just (n, str2attr "fourBoxVertical") toAttrFrTyp n TransitionFilter_Subtype_FourPoint = Just (n, str2attr "fourPoint") toAttrFrTyp n TransitionFilter_Subtype_FromBottom = Just (n, str2attr "fromBottom") toAttrFrTyp n TransitionFilter_Subtype_FromLeft = Just (n, str2attr "fromLeft") toAttrFrTyp n TransitionFilter_Subtype_FromRight = Just (n, str2attr "fromRight") toAttrFrTyp n TransitionFilter_Subtype_FromTop = Just (n, str2attr "fromTop") toAttrFrTyp n TransitionFilter_Subtype_Heart = Just (n, str2attr "heart") toAttrFrTyp n TransitionFilter_Subtype_Horizontal = Just (n, str2attr "horizontal") toAttrFrTyp n TransitionFilter_Subtype_HorizontalLeft = Just (n, str2attr "horizontalLeft") toAttrFrTyp n TransitionFilter_Subtype_HorizontalLeftSame = Just (n, str2attr "horizontalLeftSame") toAttrFrTyp n TransitionFilter_Subtype_HorizontalRight = Just (n, str2attr "horizontalRight") toAttrFrTyp n TransitionFilter_Subtype_HorizontalRightSame = Just (n, str2attr "horizontalRightSame") toAttrFrTyp n TransitionFilter_Subtype_HorizontalTopLeftOpposite = Just (n, str2attr "horizontalTopLeftOpposite") toAttrFrTyp n TransitionFilter_Subtype_HorizontalTopRightOpposite = Just (n, str2attr "horizontalTopRightOpposite") toAttrFrTyp n TransitionFilter_Subtype_Keyhole = Just (n, str2attr "keyhole") toAttrFrTyp n TransitionFilter_Subtype_Left = Just (n, str2attr "left") toAttrFrTyp n TransitionFilter_Subtype_LeftCenter = Just (n, str2attr "leftCenter") toAttrFrTyp n TransitionFilter_Subtype_LeftToRight = Just (n, str2attr "leftToRight") toAttrFrTyp n TransitionFilter_Subtype_OppositeHorizontal = Just (n, str2attr "oppositeHorizontal") toAttrFrTyp n TransitionFilter_Subtype_OppositeVertical = Just (n, str2attr "oppositeVertical") toAttrFrTyp n TransitionFilter_Subtype_ParallelDiagonal = Just (n, str2attr "parallelDiagonal") toAttrFrTyp n TransitionFilter_Subtype_ParallelDiagonalBottomLeft = Just (n, str2attr "parallelDiagonalBottomLeft") toAttrFrTyp n TransitionFilter_Subtype_ParallelDiagonalTopLeft = Just (n, str2attr "parallelDiagonalTopLeft") toAttrFrTyp n TransitionFilter_Subtype_ParallelVertical = Just (n, str2attr "parallelVertical") toAttrFrTyp n TransitionFilter_Subtype_Rectangle = Just (n, str2attr "rectangle") toAttrFrTyp n TransitionFilter_Subtype_Right = Just (n, str2attr "right") toAttrFrTyp n TransitionFilter_Subtype_RightCenter = Just (n, str2attr "rightCenter") toAttrFrTyp n TransitionFilter_Subtype_SixPoint = Just (n, str2attr "sixPoint") toAttrFrTyp n TransitionFilter_Subtype_Top = Just (n, str2attr "top") toAttrFrTyp n TransitionFilter_Subtype_TopCenter = Just (n, str2attr "topCenter") toAttrFrTyp n TransitionFilter_Subtype_TopLeft = Just (n, str2attr "topLeft") toAttrFrTyp n TransitionFilter_Subtype_TopLeftClockwise = Just (n, str2attr "topLeftClockwise") toAttrFrTyp n TransitionFilter_Subtype_TopLeftCounterClockwise = Just (n, str2attr "topLeftCounterClockwise") toAttrFrTyp n TransitionFilter_Subtype_TopLeftDiagonal = Just (n, str2attr "topLeftDiagonal") toAttrFrTyp n TransitionFilter_Subtype_TopLeftHorizontal = Just (n, str2attr "topLeftHorizontal") toAttrFrTyp n TransitionFilter_Subtype_TopLeftVertical = Just (n, str2attr "topLeftVertical") toAttrFrTyp n TransitionFilter_Subtype_TopRight = Just (n, str2attr "topRight") toAttrFrTyp n TransitionFilter_Subtype_TopRightClockwise = Just (n, str2attr "topRightClockwise") toAttrFrTyp n TransitionFilter_Subtype_TopRightCounterClockwise = Just (n, str2attr "topRightCounterClockwise") toAttrFrTyp n TransitionFilter_Subtype_TopRightDiagonal = Just (n, str2attr "topRightDiagonal") toAttrFrTyp n TransitionFilter_Subtype_TopToBottom = Just (n, str2attr "topToBottom") toAttrFrTyp n TransitionFilter_Subtype_TwoBladeHorizontal = Just (n, str2attr "twoBladeHorizontal") toAttrFrTyp n TransitionFilter_Subtype_TwoBladeVertical = Just (n, str2attr "twoBladeVertical") toAttrFrTyp n TransitionFilter_Subtype_TwoBoxBottom = Just (n, str2attr "twoBoxBottom") toAttrFrTyp n TransitionFilter_Subtype_TwoBoxLeft = Just (n, str2attr "twoBoxLeft") toAttrFrTyp n TransitionFilter_Subtype_TwoBoxRight = Just (n, str2attr "twoBoxRight") toAttrFrTyp n TransitionFilter_Subtype_TwoBoxTop = Just (n, str2attr "twoBoxTop") toAttrFrTyp n TransitionFilter_Subtype_Up = Just (n, str2attr "up") toAttrFrTyp n TransitionFilter_Subtype_Vertical = Just (n, str2attr "vertical") toAttrFrTyp n TransitionFilter_Subtype_VerticalBottomLeftOpposite = Just (n, str2attr "verticalBottomLeftOpposite") toAttrFrTyp n TransitionFilter_Subtype_VerticalBottomSame = Just (n, str2attr "verticalBottomSame") toAttrFrTyp n TransitionFilter_Subtype_VerticalLeft = Just (n, str2attr "verticalLeft") toAttrFrTyp n TransitionFilter_Subtype_VerticalRight = Just (n, str2attr "verticalRight") toAttrFrTyp n TransitionFilter_Subtype_VerticalTopLeftOpposite = Just (n, str2attr "verticalTopLeftOpposite") toAttrFrTyp n TransitionFilter_Subtype_VerticalTopSame = Just (n, str2attr "verticalTopSame") instance XmlAttrType TransitionFilter_Coordinated where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "true" = Just TransitionFilter_Coordinated_True translate "false" = Just TransitionFilter_Coordinated_False translate _ = Nothing toAttrFrTyp n TransitionFilter_Coordinated_True = Just (n, str2attr "true") toAttrFrTyp n TransitionFilter_Coordinated_False = Just (n, str2attr "false") instance XmlAttrType TransitionFilter_ClibBoundary where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "parent" = Just TransitionFilter_ClibBoundary_Parent translate "children" = Just TransitionFilter_ClibBoundary_Children translate _ = Nothing toAttrFrTyp n TransitionFilter_ClibBoundary_Parent = Just (n, str2attr "parent") toAttrFrTyp n TransitionFilter_ClibBoundary_Children = Just (n, str2attr "children") instance XmlAttrType TransitionFilter_CalcMode where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "discrete" = Just TransitionFilter_CalcMode_Discrete translate "linear" = Just TransitionFilter_CalcMode_Linear translate "paced" = Just TransitionFilter_CalcMode_Paced translate _ = Nothing toAttrFrTyp n TransitionFilter_CalcMode_Discrete = Just (n, str2attr "discrete") toAttrFrTyp n TransitionFilter_CalcMode_Linear = Just (n, str2attr "linear") toAttrFrTyp n TransitionFilter_CalcMode_Paced = Just (n, str2attr "paced") {-Done-} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL-anim.mod��������������������������������������0000644�0065111�0065111�00000013107�10504340456�022326� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ======================================================================= --> <!-- SMIL Animation Module ================================================ --> <!-- file: SMIL-anim.mod This is SMIL 2.0. Copyright 2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Author: Patrick Schmitz, Ken Day, Jacco van Ossenbruggen Revision: $Id: SMIL-anim.mod,v 1.1.1.1 2002/03/19 12:29:23 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Animation//EN" SYSTEM "SMIL-anim.mod" ======================================================================= --> <!-- ============================= Dependencies ============================ --> <!-- The integrating profile is expected to define the following entities, Unless the defaults provided are sufficient. --> <!-- SplineAnimation.module entity: Define as "INCLUDE" if the integrating profile includes the SMIL 2.0 SplineAnimation Module, "IGNORE" if not. The default is "IGNORE", i.e. by default SplineAnimation is not included in the integrating language profile. --> <!ENTITY % SplineAnimation.module "IGNORE"> <!-- Animation depends on SMIL Timing, importing the attributes listed in the AnimationTime.attrib entity. If the integrating profile does include the MinMaxTiming.module, its default value includes the attributes defined in BasicInlineTiming.attrib and inMaxTiming.attrib. Otherwise, it is defaulted to BasicInlineTiming.attrib, which is the minimum requirement. Note that the profile can override these defaults by redefining AnimationTime.attrib. The profile is also expected to define Fill.attrib. --> <!ENTITY % MinMaxTiming.module "IGNORE"> <![%MinMaxTiming.module;[ <!ENTITY % AnimationTime.attrib " %BasicInlineTiming.attrib; %MinMaxTiming.attrib; "> ]]> <!ENTITY % AnimationTime.attrib "%BasicInlineTiming.attrib;"> <!ENTITY % Fill.attrib ""> <!ENTITY % animTimingAttrs " %AnimationTime.attrib; %Fill.attrib; "> <!-- Language Designer chooses to integrate targetElement or xlink attributes. To integrate the targetElement attribute, define the entity animation-targetElement as "INCLUDE"; to integrate the XLink attributes, define animation-XLinkTarget as "INCLUDE". One or the other MUST be defined. It is strongly recommended that only one of the two be defined. --> <!ENTITY % animation-targetElement "IGNORE"> <![%animation-targetElement;[ <!ENTITY % animTargetElementAttr "targetElement IDREF #IMPLIED" > ]]> <!ENTITY % animTargetElementAttr ""> <!ENTITY % animation-XLinkTarget "IGNORE"> <![%animation-XLinkTarget;[ <!ENTITY % animTargetElementXLink " actuate (onRequest|onLoad) 'onLoad' href %URI; #IMPLIED show (new | embed | replace) #FIXED 'embed' type (simple | extended | locator | arc) #FIXED 'simple' "> ]]> <!ENTITY % animTargetElementXLink ""> <!-- ========================== Attribute Groups =========================== --> <!-- All animation elements include these attributes --> <!ENTITY % animAttrsCommon "%Core.attrib; %I18n.attrib; %System.attrib; %animTimingAttrs; %animTargetElementAttr; %animTargetElementXLink;" > <!-- All except animateMotion need an identified target attribute --> <!ENTITY % animAttrsNamedTarget "%animAttrsCommon; attributeName CDATA #REQUIRED attributeType CDATA #IMPLIED" > <!-- All except set support the full animation-function specification, additive and cumulative animation. SplineAnimation adds the attributes keyTimes, keySplines and path, and the calcMode value "spline", to those of BasicAnimation. --> <![%SplineAnimation.module;[ <!ENTITY % splineAnimCalcModeValues "| spline"> <!ENTITY % splineAnimValueAttrs "keyTimes CDATA #IMPLIED keySplines CDATA #IMPLIED" > <!ENTITY % splineAnimPathAttr "path CDATA #IMPLIED" > ]]> <!ENTITY % splineAnimCalcModeValues ""> <!ENTITY % splineAnimValueAttrs ""> <!ENTITY % splineAnimPathAttr ""> <!ENTITY % animValueAttrs " %BasicAnimation.attrib; calcMode (discrete|linear|paced %splineAnimCalcModeValues;) 'linear' %splineAnimValueAttrs; additive (replace | sum) 'replace' accumulate (none | sum) 'none'" > <!-- ========================== Animation Elements ========================= --> <!ENTITY % animate.attrib ""> <!ENTITY % animate.content "EMPTY"> <!ENTITY % animate.qname "animate"> <!ELEMENT %animate.qname; %animate.content;> <!ATTLIST %animate.qname; %animate.attrib; %animAttrsNamedTarget; %animValueAttrs; > <!ENTITY % set.attrib ""> <!ENTITY % set.content "EMPTY"> <!ENTITY % set.qname "set"> <!ELEMENT %set.qname; %set.content;> <!ATTLIST %set.qname; %set.attrib; %animAttrsNamedTarget; to CDATA #IMPLIED > <!ENTITY % animateMotion.attrib ""> <!ENTITY % animateMotion.content "EMPTY"> <!ENTITY % animateMotion.qname "animateMotion"> <!ELEMENT %animateMotion.qname; %animateMotion.content;> <!ATTLIST %animateMotion.qname; %animateMotion.attrib; %animAttrsCommon; %animValueAttrs; %splineAnimPathAttr; origin (default) "default" > <!ENTITY % animateColor.attrib ""> <!ENTITY % animateColor.content "EMPTY"> <!ENTITY % animateColor.qname "animateColor"> <!ELEMENT %animateColor.qname; %animateColor.content;> <!ATTLIST %animateColor.qname; %animateColor.attrib; %animAttrsNamedTarget; %animValueAttrs; > <!-- ========================== End Animation ============================= --> <!-- end of SMIL-anim.mod --> ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL-transition.mod��������������������������������0000644�0065111�0065111�00000007706�10504340456�023604� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ====================================================================== --> <!-- SMIL Transition Module ============================================== --> <!-- file: SMIL-transition.mod This is SMIL 2.0 Copyright 2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Revision: $Id: SMIL-transition.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Transition//EN" SYSTEM "SMIL-transition.mod" ====================================================================== --> <!ENTITY % transition-types "(barWipe|boxWipe|fourBoxWipe|barnDoorWipe| diagonalWipe|bowTieWipe|miscDiagonalWipe|veeWipe|barnVeeWipe|zigZagWipe| barnZigZagWipe|miscShapeWipe|triangleWipe|arrowHeadWipe|pentagonWipe| hexagonWipe|ellipseWipe|eyeWipe|roundRectWipe|starWipe|clockWipe| pinWheelWipe|singleSweepWipe|fanWipe|doubleFanWipe|doubleSweepWipe| saloonDoorWipe|windshieldWipe|snakeWipe|spiralWipe|parallelSnakesWipe| boxSnakesWipe|waterfallWipe|pushWipe|slideWipe|fade)" > <!ENTITY % transition-subtypes "(bottom |bottomCenter|bottomLeft|bottomLeftClockwise|bottomLeftCounterClockwise| bottomLeftDiagonal|bottomRight|bottomRightClockwise| bottomRightCounterClockwise|bottomRightDiagonal|centerRight|centerTop| circle|clockwiseBottom|clockwiseBottomRight|clockwiseLeft|clockwiseNine| clockwiseRight|clockwiseSix|clockwiseThree|clockwiseTop|clockwiseTopLeft| clockwiseTwelve|cornersIn|cornersOut|counterClockwiseBottomLeft| counterClockwiseTopRight|crossfade|diagonalBottomLeft| diagonalBottomLeftOpposite|diagonalTopLeft|diagonalTopLeftOpposite| diamond|doubleBarnDoor|doubleDiamond|down|fadeFromColor|fadeToColor| fanInHorizontal|fanInVertical|fanOutHorizontal|fanOutVertical|fivePoint| fourBlade|fourBoxHorizontal|fourBoxVertical|fourPoint|fromBottom|fromLeft| fromRight|fromTop|heart|horizontal|horizontalLeft|horizontalLeftSame| horizontalRight|horizontalRightSame|horizontalTopLeftOpposite| horizontalTopRightOpposite|keyhole|left|leftCenter|leftToRight| oppositeHorizontal|oppositeVertical|parallelDiagonal| parallelDiagonalBottomLeft|parallelDiagonalTopLeft| parallelVertical|rectangle|right|rightCenter|sixPoint|top|topCenter| topLeft|topLeftClockwise|topLeftCounterClockwise|topLeftDiagonal| topLeftHorizontal|topLeftVertical|topRight|topRightClockwise| topRightCounterClockwise|topRightDiagonal|topToBottom|twoBladeHorizontal| twoBladeVertical|twoBoxBottom|twoBoxLeft|twoBoxRight|twoBoxTop|up| vertical|verticalBottomLeftOpposite|verticalBottomSame|verticalLeft| verticalRight|verticalTopLeftOpposite|verticalTopSame)" > <!ENTITY % transition-attrs ' type %transition-types; #IMPLIED subtype %transition-subtypes; #IMPLIED horzRepeat CDATA "0" vertRepeat CDATA "0" borderWidth CDATA "0" borderColor CDATA "black" fadeColor CDATA "black" coordinated (true|false) "false" clibBoundary (parent|children) "children" '> <!ENTITY % transition.attrib ""> <!ENTITY % transition.content "EMPTY"> <!ENTITY % transition.qname "transition"> <!ELEMENT %transition.qname; %transition.content;> <!ATTLIST %transition.qname; %transition.attrib; %Core.attrib; %I18n.attrib; %transition-attrs; dur CDATA #IMPLIED startProgress CDATA "0.0" endProgress CDATA "1.0" direction (forward|reverse) "forward" > <!ENTITY % transitionFilter.attrib ""> <!ENTITY % transitionFilter.content "EMPTY"> <!ENTITY % transitionFilter.qname "transitionFilter"> <!ELEMENT %transitionFilter.qname; %transitionFilter.content;> <!ATTLIST %transitionFilter.qname; %transitionFilter.attrib; %Core.attrib; %I18n.attrib; %transition-attrs; %BasicInlineTiming.attrib; %BasicAnimation.attrib; calcMode (discrete|linear|paced) 'linear' > <!-- end of SMIL-transition.mod --> ����������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL-layout.mod������������������������������������0000644�0065111�0065111�00000011220�10504340456�022711� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ======================================================================= --> <!-- SMIL 2.0 Layout Modules =============================================== --> <!-- file: SMIL-layout.mod This is SMIL 2.0. Copyright 2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Authors: Jacco van Ossenbruggen, Aaron Cohen Revision: $Id: SMIL-layout.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Layout//EN" SYSTEM "SMIL-layout.mod" ==================================================================== --> <!-- ================== BasicLayout ======================================== --> <!-- ================== BasicLayout Profiling Entities ===================== --> <!ENTITY % layout.attrib ""> <!ENTITY % region.attrib ""> <!ENTITY % rootlayout.attrib ""> <!ENTITY % layout.content "EMPTY"> <!ENTITY % region.content "EMPTY"> <!ENTITY % rootlayout.content "EMPTY"> <!-- ================== BasicLayout Entities =============================== --> <!ENTITY % viewport-attrs " height CDATA 'auto' width CDATA 'auto' close (never|whenNotActive) 'never' open (always|whenActive) 'always' %BackgroundColor.attrib; %BackgroundColor-deprecated.attrib; "> <!ENTITY % region-attrs " bottom CDATA 'auto' left CDATA 'auto' right CDATA 'auto' top CDATA 'auto' z-index CDATA #IMPLIED showBackground (always|whenActive) 'always' %Fit.attrib; "> <!-- ================== BasicLayout Elements =============================== --> <!-- Layout contains the region and root-layout elements defined by smil-basic-layout or other elements defined an external layout mechanism. --> <!ENTITY % layout.qname "layout"> <!ELEMENT %layout.qname; %layout.content;> <!ATTLIST %layout.qname; %layout.attrib; %Core.attrib; %I18n.attrib; type CDATA 'text/smil-basic-layout' > <!-- ================== Region Element ======================================--> <!ENTITY % region.qname "region"> <!ELEMENT %region.qname; %region.content;> <!ATTLIST %region.qname; %region.attrib; %Core.attrib; %I18n.attrib; %viewport-attrs; %region-attrs; > <!-- ================== Root-layout Element =================================--> <!ENTITY % root-layout.qname "root-layout"> <!ELEMENT %root-layout.qname; %rootlayout.content; > <!ATTLIST %root-layout.qname; %rootlayout.attrib; %Core.attrib; %I18n.attrib; %viewport-attrs; > <!-- ================== AudioLayout ======================================== --> <!ENTITY % AudioLayout.module "IGNORE"> <![%AudioLayout.module;[ <!-- ================== AudioLayout Entities ============================= --> <!ENTITY % audio-attrs " soundLevel CDATA '100%' "> <!-- ================ AudioLayout Elements =============================== --> <!-- ================ Add soundLevel to region element =================== --> <!ATTLIST %region.qname; %audio-attrs;> ]]> <!-- end AudioLayout.module --> <!-- ================ MultiWindowLayout ==================================== --> <!ENTITY % MultiWindowLayout.module "IGNORE"> <![%MultiWindowLayout.module;[ <!-- ============== MultiWindowLayout Profiling Entities ================= --> <!ENTITY % viewport.attrib ""> <!ENTITY % viewport.content "EMPTY"> <!-- ============== MultiWindowLayout Elements =========================== --> <!--================= viewport element =================================== --> <!ENTITY % viewport.qname "viewport"> <!ELEMENT %viewport.qname; %viewport.content;> <!ATTLIST %viewport.qname; %viewport.attrib; %Core.attrib; %I18n.attrib; %viewport-attrs; > ]]> <!-- end MultiWindowLayout.module --> <!-- ====================== HierarchicalLayout ============================= --> <!ENTITY % HierarchicalLayout.module "IGNORE"> <![%HierarchicalLayout.module;[ <!-- ========== HierarchicalLayout Profiling Entities ==================== --> <!ENTITY % regPoint.attrib ""> <!ENTITY % regPoint.content "EMPTY"> <!-- ============ HierarchicalLayout Elements ============================ --> <!ENTITY % regPoint.qname "regPoint"> <!ELEMENT %regPoint.qname; %regPoint.content;> <!ATTLIST %regPoint.qname; %regPoint.attrib; %Core.attrib; %I18n.attrib; %Sub-region.attrib; %RegistrationPoint.attrib; > ]]> <!-- end HierarchicalLayout.module --> <!-- end of SMIL-layout.mod --> ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL-link.mod��������������������������������������0000644�0065111�0065111�00000007121�10504340456�022336� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ======================================================================= --> <!-- SMIL Linking Module ================================================== --> <!-- file: SMIL-link.mod This is SMIL 2.0. Copyright 2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Author: Jacco van Ossenbruggen, Lloyd Rutledge, Aaron Cohen Revision: $Id: SMIL-link.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Linking//EN" SYSTEM "SMIL-link.mod" ======================================================================= --> <!-- ======================== LinkingAttributes Entities =================== --> <!ENTITY % linking-attrs " sourceLevel CDATA '100%' destinationLevel CDATA '100%' sourcePlaystate (play|pause|stop) #IMPLIED destinationPlaystate (play|pause|stop) 'play' show (new|pause|replace) 'replace' accesskey CDATA #IMPLIED tabindex CDATA #IMPLIED target CDATA #IMPLIED external (true|false) 'false' actuate (onRequest|onLoad) 'onRequest' "> <!-- ========================= BasicLinking Elements ======================= --> <!ENTITY % BasicLinking.module "IGNORE"> <![%BasicLinking.module;[ <!-- ======================= BasicLinking Entities ======================= --> <!ENTITY % Shape "(rect|circle|poly|default)"> <!ENTITY % Coords "CDATA"> <!-- comma separated list of lengths --> <!ENTITY % a.attrib ""> <!ENTITY % a.content "EMPTY"> <!ENTITY % a.qname "a"> <!ELEMENT %a.qname; %a.content;> <!ATTLIST %a.qname; %a.attrib; %linking-attrs; href %URI; #IMPLIED %Core.attrib; %I18n.attrib; > <!ENTITY % area.attrib ""> <!ENTITY % area.content "EMPTY"> <!ENTITY % area.qname "area"> <!ELEMENT %area.qname; %area.content;> <!ATTLIST %area.qname; %area.attrib; %linking-attrs; shape %Shape; 'rect' coords %Coords; #IMPLIED href %URI; #IMPLIED nohref (nohref) #IMPLIED alt %Text; #IMPLIED %Core.attrib; %I18n.attrib; > <!ENTITY % anchor.attrib ""> <!ENTITY % anchor.content "EMPTY"> <!ENTITY % anchor.qname "anchor"> <!ELEMENT %anchor.qname; %anchor.content;> <!ATTLIST %anchor.qname; %area.attrib; %linking-attrs; shape %Shape; 'rect' coords %Coords; #IMPLIED href %URI; #IMPLIED nohref (nohref) #IMPLIED alt %Text; #IMPLIED %Core.attrib; %I18n.attrib; > ]]> <!-- end of BasicLinking --> <!-- ======================== ObjectLinking ================================ --> <!ENTITY % ObjectLinking.module "IGNORE"> <![%ObjectLinking.module;[ <!ENTITY % Fragment " fragment CDATA #IMPLIED "> <!-- ====================== ObjectLinking Elements ======================= --> <!-- add fragment attribute to area, and anchor elements --> <!ATTLIST %area.qname; %Fragment; > <!ATTLIST %anchor.qname; %Fragment; > ]]> <!-- ======================== End ObjectLinking ============================ --> <!-- end of SMIL-link.mod --> �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL-media.mod�������������������������������������0000644�0065111�0065111�00000012305�10504340456�022460� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ======================================================================= --> <!-- SMIL 2.0 Media Objects Modules ======================================== --> <!-- file: SMIL-media.mod This is SMIL 2.0. Copyright 2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Author: Rob Lanphier, Jacco van Ossenbruggen Revision: $Id: SMIL-media.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Media Objects//EN" SYSTEM "SMIL-media.mod" ======================================================================= --> <!-- ================== Profiling Entities ================================= --> <!ENTITY % BasicMedia.module "INCLUDE"> <![%BasicMedia.module;[ <!ENTITY % media-object.content "EMPTY"> <!ENTITY % media-object.attrib ""> <!-- ================ Media Objects Entities ============================= --> <!ENTITY % mo-attributes-BasicMedia " abstract CDATA #IMPLIED alt CDATA #IMPLIED author CDATA #IMPLIED copyright CDATA #IMPLIED longdesc CDATA #IMPLIED src CDATA #IMPLIED type CDATA #IMPLIED "> ]]> <!ENTITY % mo-attributes-BasicMedia ""> <!ENTITY % MediaClipping.module "IGNORE"> <![%MediaClipping.module;[ <!ENTITY % mo-attributes-MediaClipping " clipBegin CDATA #IMPLIED clipEnd CDATA #IMPLIED "> ]]> <!ENTITY % mo-attributes-MediaClipping ""> <!ENTITY % MediaClipping.deprecated.module "IGNORE"> <![%MediaClipping.module;[ <!ENTITY % mo-attributes-MediaClipping-deprecated " clip-begin CDATA #IMPLIED clip-end CDATA #IMPLIED "> ]]> <!ENTITY % mo-attributes-MediaClipping-deprecated ""> <!ENTITY % MediaParam.module "IGNORE"> <![%MediaParam.module;[ <!ENTITY % mo-attributes-MediaParam " erase (whenDone|never) 'whenDone' mediaRepeat (preserve|strip) 'preserve' "> ]]> <!ENTITY % mo-attributes-MediaParam ""> <!ENTITY % MediaAccessibility.module "IGNORE"> <![%MediaAccessibility.module;[ <!ENTITY % mo-attributes-MediaAccessibility " readIndex CDATA #IMPLIED "> ]]> <!ENTITY % mo-attributes-MediaAccessibility ""> <!ENTITY % mo-attributes " %Core.attrib; %I18n.attrib; %mo-attributes-BasicMedia; %mo-attributes-MediaParam; %mo-attributes-MediaAccessibility; %media-object.attrib; "> <!-- Most info is in the attributes, media objects are empty or have children defined at the language integration level: --> <!ENTITY % mo-content "%media-object.content;"> <!-- ================== Media Objects Elements ============================= --> <!-- BasicMedia --> <!ENTITY % ref.qname "ref"> <!ENTITY % audio.qname "audio"> <!ENTITY % img.qname "img"> <!ENTITY % video.qname "video"> <!ENTITY % text.qname "text"> <!ENTITY % textstream.qname "textstream"> <!ENTITY % animation.qname "animation"> <!ENTITY % ref.content "%mo-content;"> <!ENTITY % audio.content "%mo-content;"> <!ENTITY % img.content "%mo-content;"> <!ENTITY % video.content "%mo-content;"> <!ENTITY % text.content "%mo-content;"> <!ENTITY % textstream.content "%mo-content;"> <!ENTITY % animation.content "%mo-content;"> <!ELEMENT %ref.qname; %ref.content;> <!ELEMENT %audio.qname; %audio.content;> <!ELEMENT %img.qname; %img.content;> <!ELEMENT %video.qname; %video.content;> <!ELEMENT %text.qname; %text.content;> <!ELEMENT %textstream.qname; %textstream.content;> <!ELEMENT %animation.qname; %animation.content;> <!ATTLIST %img.qname; %mo-attributes; > <!ATTLIST %text.qname; %mo-attributes; > <!ATTLIST %ref.qname; %mo-attributes-MediaClipping; %mo-attributes-MediaClipping-deprecated; %mo-attributes; > <!ATTLIST %audio.qname; %mo-attributes-MediaClipping; %mo-attributes-MediaClipping-deprecated; %mo-attributes; > <!ATTLIST %video.qname; %mo-attributes-MediaClipping; %mo-attributes-MediaClipping-deprecated; %mo-attributes; > <!ATTLIST %textstream.qname; %mo-attributes-MediaClipping; %mo-attributes-MediaClipping-deprecated; %mo-attributes; > <!ATTLIST %animation.qname; %mo-attributes-MediaClipping; %mo-attributes-MediaClipping-deprecated; %mo-attributes; > <!-- MediaParam --> <![%MediaParam.module;[ <!ENTITY % param.qname "param"> <!ELEMENT %param.qname; EMPTY> <!ATTLIST %param.qname; %Core.attrib; %I18n.attrib; name CDATA #IMPLIED value CDATA #IMPLIED valuetype (data|ref|object) "data" type %ContentType; #IMPLIED > ]]> <!-- BrushMedia --> <!ENTITY % BrushMedia.module "IGNORE"> <![%BrushMedia.module;[ <!ENTITY % brush.attrib ""> <!ENTITY % brush.content "%mo-content;"> <!ENTITY % brush.qname "brush"> <!ELEMENT %brush.qname; %brush.content;> <!ATTLIST %brush.qname; %brush.attrib; %mo-attributes; color CDATA #IMPLIED > ]]> <!-- end of SMIL-media.mod --> ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL-struct.mod������������������������������������0000644�0065111�0065111�00000003130�10504340456�022721� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ====================================================================== --> <!-- SMIL Structure Module =============================================== --> <!-- file: SMIL-struct.mod This is SMIL 2.0. Copyright 2000 W3C (MIT, INRIA, Keio), All Rights Reserved. This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Document Structure//EN" SYSTEM "SMIL-struct.mod" Author: Warner ten Kate, Jacco van Ossenbruggen Revision: $Id: SMIL-struct.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ ===================================================================== --> <!-- ================== SMIL Document Root =============================== --> <!ENTITY % smil.attrib "" > <!ENTITY % smil.content "EMPTY" > <!ENTITY % smil.qname "smil" > <!ELEMENT %smil.qname; %smil.content;> <!ATTLIST %smil.qname; %smil.attrib; %Core.attrib; %I18n.attrib; xmlns %URI; #FIXED %SMIL.ns; > <!-- ================== The Document Head ================================ --> <!ENTITY % head.content "EMPTY" > <!ENTITY % head.attrib "" > <!ENTITY % head.qname "head" > <!ELEMENT %head.qname; %head.content;> <!ATTLIST %head.qname; %head.attrib; %Core.attrib; %I18n.attrib; > <!--=================== The Document Body - Timing Root ================== --> <!ENTITY % body.content "EMPTY" > <!ENTITY % body.attrib "" > <!ENTITY % body.qname "body" > <!ELEMENT %body.qname; %body.content;> <!ATTLIST %body.qname; %body.attrib; %Core.attrib; %I18n.attrib; > <!-- end of SMIL-struct.mod --> ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL-metainformation.mod���������������������������0000644�0065111�0065111�00000003022�10504340456�024571� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ================================================================ --> <!-- SMIL Metainformation Module =================================== --> <!-- file: SMIL-metainformation.mod This is SMIL 2.0. Copyright 2000 W3C (MIT, INRIA, Keio), All Rights Reserved. This module declares the meta and metadata elements types and its attributes, used to provide declarative document metainformation. Author: Thierry Michel, Jacco van Ossenbruggen Revision: $Id: SMIL-metainformation.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Document Metadata//EN" SYSTEM "SMIL-metainformation.mod" ================================================================ --> <!-- ================== Profiling Entities ========================== --> <!ENTITY % meta.content "EMPTY"> <!ENTITY % meta.attrib ""> <!ENTITY % meta.qname "meta"> <!ENTITY % metadata.content "EMPTY"> <!ENTITY % metadata.attrib ""> <!ENTITY % metadata.qname "metadata"> <!-- ================== meta element ================================ --> <!ELEMENT %meta.qname; %meta.content;> <!ATTLIST %meta.qname; %meta.attrib; content CDATA #IMPLIED name CDATA #REQUIRED > <!-- ================== metadata element ============================ --> <!ELEMENT %metadata.qname; %metadata.content;> <!ATTLIST %metadata.qname; %metadata.attrib; %Core.attrib; %I18n.attrib; > <!-- end of SMIL-metadata.mod --> ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL-timing.mod������������������������������������0000644�0065111�0065111�00000004534�10504340456�022675� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ================================================================= --> <!-- SMIL Timing and Synchronization Modules ========================= --> <!-- file: SMIL-timing.mod This is SMIL 2.0. Copyright 2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Author: Jacco van Ossenbruggen. Revision: $Id: SMIL-timing.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Timing//EN" SYSTEM "SMIL-timing.mod" ================================================================= --> <!-- ================== Timing Elements ============================== --> <!ENTITY % BasicTimeContainers.module "IGNORE"> <![%BasicTimeContainers.module;[ <!ENTITY % par.content "EMPTY"> <!ENTITY % seq.content "EMPTY"> <!ENTITY % par.attrib ""> <!ENTITY % seq.attrib ""> <!ENTITY % seq.qname "seq"> <!ENTITY % par.qname "par"> <!ENTITY % description.attrib " abstract CDATA #IMPLIED author CDATA #IMPLIED copyright CDATA #IMPLIED "> <!ELEMENT %seq.qname; %seq.content;> <!ATTLIST %seq.qname; %seq.attrib; %Core.attrib; %I18n.attrib; %description.attrib; > <!ELEMENT %par.qname; %par.content;> <!ATTLIST %par.qname; %par.attrib; %Core.attrib; %I18n.attrib; %description.attrib; > ]]> <!-- End of BasicTimeContainers.module --> <!ENTITY % ExclTimeContainers.module "IGNORE"> <![%ExclTimeContainers.module;[ <!ENTITY % excl.content "EMPTY"> <!ENTITY % priorityClass.content "EMPTY"> <!ENTITY % excl.attrib ""> <!ENTITY % priorityClass.attrib ""> <!ENTITY % excl.qname "excl"> <!ENTITY % priorityClass.qname "priorityClass"> <!ELEMENT %excl.qname; %excl.content;> <!ATTLIST %excl.qname; %excl.attrib; %Core.attrib; %I18n.attrib; %description.attrib; > <!ELEMENT %priorityClass.qname; %priorityClass.content;> <!ATTLIST %priorityClass.qname; %priorityClass.attrib; peers (stop|pause|defer|never) "stop" higher (stop|pause) "pause" lower (defer|never) "defer" pauseDisplay (disable|hide|show ) "show" %description.attrib; %Core.attrib; %I18n.attrib; > ]]> <!-- End of ExclTimeContainers.module --> <!-- end of SMIL-timing.mod --> ��������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/SMIL20.dtd�����������������������������������������0000644�0065111�0065111�00000007043�10504340456�021544� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ....................................................................... --> <!-- SMIL 2.0 DTD ......................................................... --> <!-- file: SMIL20.dtd --> <!-- SMIL 2.0 DTD This is SMIL 2.0. Copyright 1998-2000 World Wide Web Consortium (Massachusetts Institute of Technology, Institut National de Recherche en Informatique et en Automatique, Keio University). All Rights Reserved. Permission to use, copy, modify and distribute the SMIL 2.0 DTD and its accompanying documentation for any purpose and without fee is hereby granted in perpetuity, provided that the above copyright notice and this paragraph appear in all copies. The copyright holders make no representation about the suitability of the DTD for any purpose. It is provided "as is" without expressed or implied warranty. Author: Jacco van Ossenbruggen Revision: $Id: SMIL20.dtd,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ --> <!-- This is the driver file for the SMIL 2.0 DTD. Please use this formal public identifier to identify it: "-//W3C//DTD SMIL 2.0//EN" --> <!ENTITY % NS.prefixed "IGNORE" > <!ENTITY % SMIL.prefix "" > <!-- Define the Content Model --> <!ENTITY % smil-model.mod PUBLIC "-//W3C//ENTITIES SMIL 2.0 Document Model 1.0//EN" "smil-model-1.mod" > <!-- Modular Framework Module ................................... --> <!ENTITY % smil-framework.module "INCLUDE" > <![%smil-framework.module;[ <!ENTITY % smil-framework.mod PUBLIC "-//W3C//ENTITIES SMIL 2.0 Modular Framework 1.0//EN" "smil-framework-1.mod" > %smil-framework.mod;]]> <!-- The SMIL 2.0 Profile includes the following sections: C. The SMIL Animation Module D. The SMIL Content Control Module G. The SMIL Layout Module H. The SMIL Linking Module I. The SMIL Media Object Module J. The SMIL Metainformation Module K. The SMIL Structure Module L. The SMIL Timing and Synchronization Module M. Integrating SMIL Timing into other XML-Based Languages P. The SMIL Transition effects Module The SMIL Streaming Media Object Module is optional. --> <!ENTITY % streamingmedia.model "IGNORE"> <![%streamingmedia.model;[ <!ENTITY % streaming-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Streaming Media Objects//EN" "SMIL-streamingmedia.mod"> %streaming-mod; ]]> <!ENTITY % anim-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Animation//EN" "SMIL-anim.mod"> <!ENTITY % control-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Content Control//EN" "SMIL-control.mod"> <!ENTITY % layout-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Layout//EN" "SMIL-layout.mod"> <!ENTITY % link-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Linking//EN" "SMIL-link.mod"> <!ENTITY % media-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Media Objects//EN" "SMIL-media.mod"> <!ENTITY % meta-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Document Metainformation//EN" "SMIL-metainformation.mod"> <!ENTITY % struct-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Document Structure//EN" "SMIL-struct.mod"> <!ENTITY % timing-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Timing//EN" "SMIL-timing.mod"> <!ENTITY % transition-mod PUBLIC "-//W3C//ELEMENTS SMIL 2.0 Transition//EN" "SMIL-transition.mod"> %struct-mod; %anim-mod; %control-mod; %meta-mod; %layout-mod; %link-mod; %media-mod; %timing-mod; %transition-mod; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/smil-datatypes-1.mod�������������������������������0000644�0065111�0065111�00000002740�10504340456�023737� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ...................................................................... --> <!-- SMIL 2.0 Datatypes Module ........................................... --> <!-- file: smil-datatypes-1.mod This is SMIL 2.0. Copyright 1998-2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Revision: $Id: smil-datatypes-1.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ENTITIES SMIL 2.0 Datatypes 1.0//EN" SYSTEM "smil-datatypes-1.mod" ....................................................................... --> <!-- Datatypes defines containers for the following datatypes, many of these imported from other specifications and standards. --> <!ENTITY % Character "CDATA"> <!-- a single character from [ISO10646] --> <!ENTITY % ContentType "CDATA"> <!-- media type, as per [RFC2045] --> <!ENTITY % LanguageCode "NMTOKEN"> <!-- a language code, as per [RFC1766] --> <!ENTITY % LanguageCodes "CDATA"> <!-- comma-separated list of language codes, as per [RFC1766] --> <!ENTITY % Number "CDATA"> <!-- one or more digits --> <!ENTITY % Script "CDATA"> <!-- script expression --> <!ENTITY % Text "CDATA"> <!-- used for titles etc. --> <!ENTITY % TimeValue "CDATA"> <!-- a Number, possibly with its dimension, or a reserved word like 'indefinite' --> <!ENTITY % URI.datatype "CDATA" > <!ENTITY % URI "CDATA" > <!-- used for URI references --> ��������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/smil-attribs-1.mod���������������������������������0000644�0065111�0065111�00000015300�10504340456�023405� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ...................................................................... --> <!-- SMIL 2.0 Common Attributes Module ................................... --> <!-- file: smil-attribs-1.mod This is SMIL 2.0. Copyright 1998-2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Revision: $Id: smil-attribs-1.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ENTITIES SMIL 2.0 Common Attributes 1.0//EN" SYSTEM "smil-attribs-1.mod" ...................................................................... --> <!-- Common Attributes This module declares the common attributes for the SMIL DTD Modules. --> <!ENTITY % SMIL.pfx ""> <!ENTITY % Id.attrib "%SMIL.pfx;id ID #IMPLIED" > <!ENTITY % Class.attrib "%SMIL.pfx;class CDATA #IMPLIED" > <!ENTITY % Title.attrib "%SMIL.pfx;title %Text; #IMPLIED" > <!ENTITY % Core.extra.attrib "" > <!ENTITY % Core.attrib "%Id.attrib; %Class.attrib; %Title.attrib; %Core.extra.attrib;" > <!ENTITY % I18n.extra.attrib "" > <!ENTITY % I18n.attrib " xml:lang %LanguageCode; #IMPLIED %I18n.extra.attrib;" > <!-- ================== BasicLayout ======================================= --> <!ENTITY % Region.attrib " %SMIL.pfx;region CDATA #IMPLIED "> <!ENTITY % Fill.attrib " %SMIL.pfx;fill (remove|freeze|hold|transition) #IMPLIED "> <!-- ================== HierarchicalLayout ======================================= --> <!ENTITY % BackgroundColor.attrib " %SMIL.pfx;backgroundColor CDATA #IMPLIED "> <!ENTITY % BackgroundColor-deprecated.attrib " %SMIL.pfx;background-color CDATA #IMPLIED "> <!ENTITY % Sub-region.attrib " %SMIL.pfx;top CDATA 'auto' %SMIL.pfx;bottom CDATA 'auto' %SMIL.pfx;left CDATA 'auto' %SMIL.pfx;right CDATA 'auto' "> <!ENTITY % Fit.attrib " %SMIL.pfx;fit (hidden|fill|meet|scroll|slice) 'hidden' "> <!-- ================ Registration Point attribute for media elements ============ --> <!-- integrating language using HierarchicalLayout must include regPoint --> <!-- attribute on media elements for regPoint elements to be useful --> <!ENTITY % RegistrationPoint.attrib " %SMIL.pfx;regPoint CDATA #IMPLIED %SMIL.pfx;regAlign (topLeft|topMid|topRight|midLeft|center| midRight|bottomLeft|bottomMid|bottomRight) #IMPLIED "> <!--=================== Content Control =======================--> <!-- customTest Attribute --> <!ENTITY % CustomTest.attrib " %SMIL.pfx;customTest IDREF #IMPLIED "> <!-- ========================= SkipContentControl Module ========================= --> <!ENTITY % skipContent.attrib " %SMIL.pfx;skip-content (true|false) 'true' "> <!-- Switch Parameter Attributes --> <!ENTITY % System.attrib " %CustomTest.attrib; %SMIL.pfx;systemBitrate CDATA #IMPLIED %SMIL.pfx;systemCaptions (on|off) #IMPLIED %SMIL.pfx;systemLanguage CDATA #IMPLIED %SMIL.pfx;systemOverdubOrSubtitle (overdub|subtitle) #IMPLIED %SMIL.pfx;systemRequired NMTOKEN #IMPLIED %SMIL.pfx;systemScreenSize CDATA #IMPLIED %SMIL.pfx;systemScreenDepth CDATA #IMPLIED %SMIL.pfx;systemAudioDesc (on|off) #IMPLIED %SMIL.pfx;systemOperatingSystem NMTOKEN #IMPLIED %SMIL.pfx;systemCPU NMTOKEN #IMPLIED %SMIL.pfx;systemComponent CDATA #IMPLIED %SMIL.pfx;system-bitrate CDATA #IMPLIED %SMIL.pfx;system-captions (on|off) #IMPLIED %SMIL.pfx;system-language CDATA #IMPLIED %SMIL.pfx;system-overdub-or-caption (overdub|caption) #IMPLIED %SMIL.pfx;system-required NMTOKEN #IMPLIED %SMIL.pfx;system-screen-size CDATA #IMPLIED %SMIL.pfx;system-screen-depth CDATA #IMPLIED "> <!-- SMIL Animation Module ================================================ --> <!ENTITY % BasicAnimation.attrib " %SMIL.pfx;values CDATA #IMPLIED %SMIL.pfx;from CDATA #IMPLIED %SMIL.pfx;to CDATA #IMPLIED %SMIL.pfx;by CDATA #IMPLIED "> <!-- SMIL Timing Module =================================================== --> <!ENTITY % BasicInlineTiming.attrib " %SMIL.pfx;dur %TimeValue; #IMPLIED %SMIL.pfx;repeatCount %TimeValue; #IMPLIED %SMIL.pfx;repeatDur %TimeValue; #IMPLIED %SMIL.pfx;begin %TimeValue; #IMPLIED %SMIL.pfx;end %TimeValue; #IMPLIED "> <!ENTITY % MinMaxTiming.attrib " %SMIL.pfx;min %TimeValue; #IMPLIED %SMIL.pfx;max %TimeValue; #IMPLIED "> <!ENTITY % BasicInlineTiming-deprecated.attrib " %SMIL.pfx;repeat %TimeValue; #IMPLIED "> <!ENTITY % BasicTimeContainers.attrib " %SMIL.pfx;endsync (first|last|all|IDREF) 'last' %Fill.attrib; "> <!ENTITY % TimeContainerAttributes.attrib " %SMIL.pfx;timeAction CDATA #IMPLIED %SMIL.pfx;timeContainer CDATA #IMPLIED "> <!ENTITY % RestartTiming.attrib " %SMIL.pfx;restart (always|whenNotActive|never) 'always' "> <!ENTITY % RestartDefaultTiming.attrib " %SMIL.pfx;restartDefault (inherit|always|never|whenNotActive) 'always' "> <!ENTITY % SyncBehavior.attrib " %SMIL.pfx;syncBehavior (canSlip|locked|independent) #IMPLIED %SMIL.pfx;syncTolerence %TimeValue; #IMPLIED "> <!ENTITY % SyncBehaviorDefault.attrib " %SMIL.pfx;syncBehaviorDefault (canSlip|locked|independent) #IMPLIED %SMIL.pfx;syncToleranceDefault %TimeValue; #IMPLIED "> <!ENTITY % SyncMaster.attrib " %SMIL.pfx;syncMaster (true|false) 'false' "> <!-- ================== Time Manipulations ================================= --> <!ENTITY % TimeManipulations.attrib " %SMIL.pfx;accelerate %Number; '0' %SMIL.pfx;decelerate %Number; '0' %SMIL.pfx;autoReverse (true|false) 'false' %SMIL.pfx;speed %Number; '1.0' "> <!-- ================== Streaming Media ==================================== --> <!ENTITY % Streaming-media.attrib " %SMIL.pfx;port CDATA #IMPLIED %SMIL.pfx;rtpformat CDATA #IMPLIED %SMIL.pfx;transport CDATA #IMPLIED "> <!ENTITY % Streaming-timecontainer.attrib " %SMIL.pfx;control CDATA #IMPLIED "> <!-- ================== Transitions Media ================================== --> <!ENTITY % Transition.attrib " %SMIL.pfx;transIn IDREF #IMPLIED %SMIL.pfx;transOut IDREF #IMPLIED "> ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/smil-framework-1.mod�������������������������������0000644�0065111�0065111�00000004266�10504340456�023743� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ...................................................................... --> <!-- SMIL 2.0 Modular Framework Module ................................... --> <!-- file: smil-framework-1.mod This is SMIL 2.0. Copyright 1998-2000 W3C (MIT, INRIA, Keio), All Rights Reserved. This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ENTITIES SMIL 2.0 Modular Framework 1.0//EN" SYSTEM "smil-framework-1.mod" Revision: $Id: smil-framework-1.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ ....................................................................... --> <!-- Modular Framework This required module instantiates the modules needed to support the SMIL 2.0 modularization model, including: + datatypes + namespace-qualified names + common attributes + document model The Intrinsic Events module is ignored by default but occurs in this module because it must be instantiated prior to Attributes but after Datatypes. --> <!-- The (still to be determined) SMIL namespace: --> <!ENTITY % SMIL.ns "'http://www.w3.org/TR/REC-smil/SMIL20'"> <!ENTITY % smil-datatypes.module "INCLUDE" > <![%smil-datatypes.module;[ <!ENTITY % smil-datatypes.mod PUBLIC "-//W3C//ENTITIES SMIL 2.0 Datatypes 1.0//EN" "smil-datatypes-1.mod" > %smil-datatypes.mod;]]> <!ENTITY % smil-qname.module "INCLUDE" > <![%smil-qname.module;[ <!ENTITY % smil-qname.mod PUBLIC "-//W3C//ENTITIES SMIL 2.0 Qualified Names 1.0//EN" "smil-qname-1.mod" > %smil-qname.mod;]]> <!ENTITY % smil-events.module "IGNORE" > <![%smil-events.module;[ <!ENTITY % smil-events.mod PUBLIC "-//W3C//ENTITIES SMIL 2.0 Intrinsic Events 1.0//EN" "smil-events-1.mod" > %smil-events.mod;]]> <!ENTITY % smil-attribs.module "INCLUDE" > <![%smil-attribs.module;[ <!ENTITY % smil-attribs.mod PUBLIC "-//W3C//ENTITIES SMIL 2.0 Common Attributes 1.0//EN" "smil-attribs-1.mod" > %smil-attribs.mod;]]> <!ENTITY % smil-model.module "INCLUDE" > <![%smil-model.module;[ <!-- A content model MUST be defined by the driver file --> %smil-model.mod;]]> <!-- end of smil-framework-1.mod --> ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/smil-model-1.mod�����������������������������������0000644�0065111�0065111�00000021653�10504340456�023045� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- .................................................................... --> <!-- SMIL 2.0 Document Model Module ..................................... --> <!-- file: smil-model-1.mod This is SMIL 2.0. Copyright 1998-2000 W3C (MIT, INRIA, Keio), All Rights Reserved. This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ENTITIES SMIL 2.0 Document Model 1.0//EN" SYSTEM "smil-model-1.mod" Author: Warner ten Kate, Jacco van Ossenbruggen, Aaron Cohen Revision: $Id: smil-model-1.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ ....................................................................... --> <!-- This file defines the SMIL 2.0 Language Document Model. All attributes and content models are defined in the second half of this file. We first start with some utility definitions. These are mainly used to simplify the use of Modules in the second part of the file. --> <!-- ================== Util: Head ========================================= --> <!ENTITY % head-meta.content "metadata?,meta*"> <!ENTITY % head-layout.content "layout|switch"> <!ENTITY % head-control.content "customAttributes"> <!ENTITY % head-transition.content "transition+, meta*"> <!--=================== Util: Body - Content Control ======================= --> <!ENTITY % content-control "switch|prefetch"> <!--=================== Util: Body - Animation ========================= --> <!ENTITY % animation.elements "animate|set|animateMotion|animateColor"> <!--=================== Util: Body - Media ========================= --> <!ENTITY % media-object "audio|video|animation|text|img|textstream|ref|brush |%animation.elements;"> <!--=================== Util: Body - Timing ================================ --> <!ENTITY % BasicTimeContainers.class "par|seq"> <!ENTITY % ExclTimeContainers.class "excl"> <!ENTITY % timecontainer.class "%BasicTimeContainers.class;|%ExclTimeContainers.class;"> <!ENTITY % timecontainer.content "%timecontainer.class;|%media-object;|%content-control;|a"> <!ENTITY % smil-time.attrib " %BasicInlineTiming.attrib; %MinMaxTiming.attrib; %RestartTiming.attrib; %SyncBehavior.attrib; %SyncBehaviorDefault.attrib; %BasicInlineTiming-deprecated.attrib; %Fill.attrib; "> <!ENTITY % timecontainer.attrib " %BasicInlineTiming.attrib; %MinMaxTiming.attrib; %BasicTimeContainers.attrib; %RestartTiming.attrib; %SyncBehavior.attrib; %SyncBehaviorDefault.attrib; %BasicInlineTiming-deprecated.attrib; %System.attrib; "> <!-- ====================================================================== --> <!-- ====================================================================== --> <!-- ====================================================================== --> <!-- The actual content model and attribute definitions for each module sections follow below. --> <!-- ================== Content Control =================================== --> <!ENTITY % BasicContentControl.module "INCLUDE"> <!ENTITY % CustomTestAttributes.module "INCLUDE"> <!ENTITY % PrefetchControl.module "INCLUDE"> <!ENTITY % SkipContentControl.module "INCLUDE"> <!ENTITY % switch.content "(layout|%timecontainer.class;|%media-object;| %content-control;|a)*"> <!ENTITY % prefetch.content "%switch.content;"> <!ENTITY % customAttributes.content "(customTest)+"> <!ENTITY % switch.attrib "%System.attrib; %skipContent.attrib;"> <!ENTITY % prefetch.attrib "%timecontainer.attrib; %skipContent.attrib; "> <!ENTITY % customAttributes.attrib "%skipContent.attrib;"> <!ENTITY % customTest.attrib "%skipContent.attrib;"> <!-- ================== Animation ========================================= --> <!ENTITY % BasicAnimation.module "INCLUDE"> <!-- choose targetElement or XLink: --> <!ENTITY % animation-targetElement "INCLUDE"> <!ENTITY % animation-XLinkTarget "IGNORE"> <!ENTITY % animate.content "EMPTY"> <!ENTITY % animateColor.content "EMPTY"> <!ENTITY % animateMotion.content "EMPTY"> <!ENTITY % set.content "EMPTY"> <!ENTITY % animate.attrib "%skipContent.attrib;"> <!ENTITY % animateColor.attrib "%skipContent.attrib;"> <!ENTITY % animateMotion.attrib "%skipContent.attrib;"> <!ENTITY % set.attrib "%skipContent.attrib;"> <!-- ================== Layout ============================================ --> <!ENTITY % BasicLayout.module "INCLUDE"> <!ENTITY % AudioLayout.module "INCLUDE"> <!ENTITY % MultiWindowLayout.module "INCLUDE"> <!ENTITY % HierarchicalLayout.module "INCLUDE"> <!ENTITY % layout.content "(region|viewport|root-layout|regPoint)*"> <!ENTITY % region.content "(region)*"> <!ENTITY % rootlayout.content "(region)*"> <!ENTITY % viewport.content "(region)*"> <!ENTITY % regPoint.content "EMPTY"> <!ENTITY % rootlayout.attrib "%skipContent.attrib;"> <!ENTITY % viewport.attrib "%skipContent.attrib;"> <!ENTITY % region.attrib "%skipContent.attrib;"> <!ENTITY % regPoint.attrib "%skipContent.attrib;"> <!-- ================== Linking =========================================== --> <!ENTITY % LinkingAttributes.module "INCLUDE"> <!ENTITY % BasicLinking.module "INCLUDE"> <!ENTITY % ObjectLinking.module "INCLUDE"> <!ENTITY % a.content "(%timecontainer.class;|%media-object;| %content-control;)*"> <!ENTITY % area.content "EMPTY"> <!ENTITY % anchor.content "EMPTY"> <!ENTITY % a.attrib "%smil-time.attrib;"> <!ENTITY % area.attrib "%smil-time.attrib; %skipContent.attrib;"> <!ENTITY % anchor.attrib "%smil-time.attrib; %skipContent.attrib;"> <!-- ================== Media ============================================ --> <!ENTITY % BasicMedia.module "INCLUDE"> <!ENTITY % MediaClipping.module "INCLUDE"> <!ENTITY % MediaClipping.deperecated.module "INCLUDE"> <!ENTITY % MediaClipMarkers.module "INCLUDE"> <!ENTITY % MediaParam.module "INCLUDE"> <!ENTITY % BrushMedia.module "INCLUDE"> <!ENTITY % MediaAccessibility.module "INCLUDE"> <!ENTITY % media-object.content "(%animation.elements;|anchor|area |transitionFilter|param)*"> <!ENTITY % media-object.attrib " %smil-time.attrib; %System.attrib; %Region.attrib; %Transition.attrib; %BackgroundColor.attrib; %BackgroundColor-deprecated.attrib; %Sub-region.attrib; %RegistrationPoint.attrib; %Fit.attrib; "> <!ENTITY % brush.attrib "%skipContent.attrib;"> <!-- ================== Metadata ========================================== --> <!ENTITY % meta.content "EMPTY"> <!ENTITY % meta.attrib "%skipContent.attrib;"> <!ENTITY % metadata.content "EMPTY"> <!ENTITY % metadata.attrib "%skipContent.attrib;"> <!-- ================== Structure ========================================= --> <!ENTITY % Structure.module "INCLUDE"> <!ENTITY % smil.content "(head?,body?)"> <!ENTITY % head.content " ((%head-meta.content;)?, ((%head-layout.content;),meta*)?, (%head-transition.content;)?, ((%head-control.content;),meta*)?)"> <!ENTITY % body.content "(%timecontainer.class;|%media-object;| %content-control;|a)*"> <!ENTITY % body.attrib "%timecontainer.attrib; %Region.attrib;"> <!-- ================== Transitions ======================================= --> <!ENTITY % BasicTransitions.module "INCLUDE"> <!ENTITY % MultiElementTransitions.module "INCLUDE"> <!ENTITY % transition.content "(transitionFilter*)"> <!ENTITY % transition.attrib "%skipContent.attrib;"> <!ENTITY % transitionFilter.attrib "%skipContent.attrib;"> <!-- ================== Timing ============================================ --> <!ENTITY % BasicInlineTiming.module "INCLUDE"> <!ENTITY % SyncbaseTiming.module "INCLUDE"> <!ENTITY % EventTiming.module "INCLUDE"> <!ENTITY % WallclockTiming.module "INCLUDE"> <!ENTITY % MultiSyncArcTiming.module "INCLUDE"> <!ENTITY % MediaMarkerTiming.module "INCLUDE"> <!ENTITY % MinMaxTiming.module "INCLUDE"> <!ENTITY % BasicTimeContainers.module "INCLUDE"> <!ENTITY % ExclTimeContainers.module "INCLUDE"> <!ENTITY % PrevTiming.module "INCLUDE"> <!ENTITY % RestartTiming.module "INCLUDE"> <!ENTITY % SyncBehavior.module "INCLUDE"> <!ENTITY % SyncBehaviorDefault.module "INCLUDE"> <!ENTITY % RestartDefault.module "INCLUDE"> <!ENTITY % FillDefault.module "INCLUDE"> <!ENTITY % par.attrib "%timecontainer.attrib; %Region.attrib;"> <!ENTITY % seq.attrib "%timecontainer.attrib; %Region.attrib;"> <!ENTITY % excl.attrib "%timecontainer.attrib; %Region.attrib; %skipContent.attrib;"> <!ENTITY % par.content "(%timecontainer.content;)*"> <!ENTITY % seq.content "(%timecontainer.content;)*"> <!ENTITY % excl.content "((%timecontainer.content;)*|priorityClass+)"> <!ENTITY % priorityClass.attrib "%skipContent.attrib;"> <!ENTITY % priorityClass.content "((%timecontainer.content;)*|priorityClass+)"> �������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SMIL/smil-qname-1.mod�����������������������������������0000644�0065111�0065111�00000013620�10504340456�023041� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!-- ....................................................................... --> <!-- SMIL Qualified Names Module .......................................... --> <!-- file: smil-qname-1.mod This is SMIL. Copyright 1998-2000 W3C (MIT, INRIA, Keio), All Rights Reserved. Revision: $Id: smil-qname-1.mod,v 1.1.1.1 2002/03/19 12:29:24 malcolm Exp $ SMI This DTD module is identified by the PUBLIC and SYSTEM identifiers: PUBLIC "-//W3C//ENTITIES SMIL Qualified Names 1.0//EN" SYSTEM "smil-qname-1.mod" ....................................................................... --> <!-- SMIL Qualified Names This module is contained in two parts, labeled Section 'A' and 'B': Section A declares parameter entities to support namespace- qualified names, namespace declarations, and name prefixing for SMIL and extensions. Section B declares parameter entities used to provide namespace-qualified names for all SMIL element types: %animation.qname; the xmlns-qualified name for <animation> %video.qname; the xmlns-qualified name for <video> ... SMIL extensions would create a module similar to this one, using the '%smil-qname-extra.mod;' parameter entity to insert it within Section A. A template module suitable for this purpose ('template-qname-1.mod') is included in the XHTML distribution. --> <!-- Section A: SMIL XML Namespace Framework :::::::::::::::::::: --> <!-- 1. Declare the two parameter entities used to support XLink, first the parameter entity container for the URI used to identify the XLink namespace: --> <!ENTITY % XLINK.xmlns "http://www.w3.org/1999/xlink" > <!-- This contains the XLink namespace declaration attribute. --> <!ENTITY % XLINK.xmlns.attrib "xmlns:xlink %URI.datatype; #FIXED '%XLINK.xmlns;'" > <!-- 2. Declare parameter entities (eg., %SMIL.xmlns;) containing the namespace URI for the SMIL namespace, and any namespaces included by SMIL: --> <!ENTITY % SMIL.xmlns "http://www.w3.org/TR/REC-smil/SMIL20" > <!-- 3. Declare parameter entities (eg., %SMIL.prefix;) containing the default namespace prefix string(s) to use when prefixing is enabled. This may be overridden in the DTD driver or the internal subset of an document instance. NOTE: As specified in [XMLNAMES], the namespace prefix serves as a proxy for the URI reference, and is not in itself significant. --> <!ENTITY % SMIL.prefix "" > <!-- 4. Declare a %SMIL.prefixed; conditional section keyword, used to activate namespace prefixing. The default value should inherit '%NS.prefixed;' from the DTD driver, so that unless overridden, the default behaviour follows the overall DTD prefixing scheme. --> <!ENTITY % NS.prefixed "IGNORE" > <!ENTITY % SMIL.prefixed "%NS.prefixed;" > <!-- 5. Declare parameter entities (eg., %SMIL.pfx;) containing the colonized prefix(es) (eg., '%SMIL.prefix;:') used when prefixing is active, an empty string when it is not. --> <![%SMIL.prefixed;[ <!ENTITY % SMIL.pfx "%SMIL.prefix;:" > ]]> <!ENTITY % SMIL.pfx "" > <!-- declare qualified name extensions here --> <!ENTITY % smil-qname-extra.mod "" > %smil-qname-extra.mod; <!-- 6. The parameter entity %SMIL.xmlns.extra.attrib; may be redeclared to contain any non-SMIL namespace declaration attributes for namespaces embedded in SMIL. The default is an empty string. XLink should be included here if used in the DTD and not already included by a previously-declared %*.xmlns.extra.attrib;. --> <!ENTITY % SMIL.xmlns.extra.attrib "" > <!-- 7. The parameter entity %NS.prefixed.attrib; is defined to be the prefix for SMIL elements if any and whatever is in SMIL.xmlns.extra.attrib. --> <![%SMIL.prefixed;[ <!ENTITY % NS.prefixed.attrib "xmlns:%SMIL.prefix; %URI.datatype; #FIXED '%SMIL.xmlns;' %SMIL.xmlns.extra.attrib; " > ]]> <!ENTITY % NS.prefixed.attrib "%SMIL.xmlns.extra.attrib;" > <!-- Section B: SMIL Qualified Names ::::::::::::::::::::::::::::: --> <!-- This section declares parameter entities used to provide namespace-qualified names for all SMIL element types. --> <!ENTITY % animate.qname "%SMIL.pfx;animate" > <!ENTITY % set.qname "%SMIL.pfx;set" > <!ENTITY % animateMotion.qname "%SMIL.pfx;animateMotion" > <!ENTITY % animateColor.qname "%SMIL.pfx;animateColor" > <!ENTITY % switch.qname "%SMIL.pfx;switch" > <!ENTITY % customTest.qname "%SMIL.pfx;customTest" > <!ENTITY % customAttributes.qname "%SMIL.pfx;customAttributes" > <!ENTITY % prefetch.qname "%SMIL.pfx;prefetch" > <!ENTITY % layout.qname "%SMIL.pfx;layout" > <!ENTITY % region.qname "%SMIL.pfx;region" > <!ENTITY % root-layout.qname "%SMIL.pfx;root-layout" > <!ENTITY % viewport.qname "%SMIL.pfx;viewport" > <!ENTITY % regPoint.qname "%SMIL.pfx;regPoint" > <!ENTITY % a.qname "%SMIL.pfx;a" > <!ENTITY % area.qname "%SMIL.pfx;area" > <!ENTITY % anchor.qname "%SMIL.pfx;anchor" > <!ENTITY % ref.qname "%SMIL.pfx;ref" > <!ENTITY % audio.qname "%SMIL.pfx;audio" > <!ENTITY % img.qname "%SMIL.pfx;img" > <!ENTITY % video.qname "%SMIL.pfx;video" > <!ENTITY % text.qname "%SMIL.pfx;text" > <!ENTITY % textstream.qname "%SMIL.pfx;textstream" > <!ENTITY % animation.qname "%SMIL.pfx;animation" > <!ENTITY % param.qname "%SMIL.pfx;param" > <!ENTITY % brush.qname "%SMIL.pfx;brush" > <!ENTITY % meta.qname "%SMIL.pfx;meta" > <!ENTITY % metadata.qname "%SMIL.pfx;metadata" > <!ENTITY % rtpmap.qname "%SMIL.pfx;rtpmap" > <!ENTITY % smil.qname "%SMIL.pfx;smil" > <!ENTITY % head.qname "%SMIL.pfx;head" > <!ENTITY % body.qname "%SMIL.pfx;body" > <!ENTITY % seq.qname "%SMIL.pfx;seq" > <!ENTITY % par.qname "%SMIL.pfx;par" > <!ENTITY % excl.qname "%SMIL.pfx;excl" > <!ENTITY % transition.qname "%SMIL.pfx;transition" > <!ENTITY % transitionFilter.qname "%SMIL.pfx;transitionFilter" > <!-- end of smil-qname-1.mod --> ����������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/README��������������������������������������������������0000644�0065111�0065111�00000004757�10504340456�020266� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Please note: The example code in this directory may not always work with the current version of the the HaXml libraries. What little time I have for maintenance goes into the main HaXml facilites, not into testing these small demonstration exercises. Sorry. Parse/Pretty-Print example (Canonicalise.hs) -------------------------- To demonstrate parsing and pretty-printing, I wrote a simple in-out application: $ hmake Canonicalise -I../lib Test it on some XML documents: $ ./Canonicalise album.xml You will notice that it changes some parts of the document, for instance in $ ./Canonicalise subjdb.xml all parameter entities are replaced with their expansion. Xml2Haskell example (album.dtd, AlbumDTD.hs, album.xml) ------------------- In this example, I did the following: Convert the XML DTD for an album into a Haskell module: $ DtdToHaskell album.dtd AlbumDtd.hs Edit the generated file (just to change the module name to match!) $ vi AlbumDtd.hs Wrote the test application (App.hs) using AlbumDTD.hs, and compiled it: $ hmake App -I../lib Running the test displays some progress messages, and outputs the original document again, only with the album title changed. $ ./App album.xml new.xml And that's it. Haskell2Xml example (Types.hs, DTypes.hs, Example.hs, subjdb.xml) ------------------- The file Types.hs defines some data types for a mini-database. Derive the Haskell2Xml apparatus using DrIFT: $ DrIFT Types.hs >DTypes.hs The example program in Example.hs just writes some Haskell data to an XML file. $ hmake Example -I../lib $ ./Example $ less subjdb.xml I hope that's reasonably clear. Bigger DtdToHaskell example --------------------------- In directory SMIL, do $ DtdToHaskell SMIL20.dtd DTD_SMIL20.hs and have a look at the resulting Haskell file. This is a large multi-part DTD for the Synchronised Multimedia Integration Language, defined by the W3C. As of 2000-11-16, our XML parser has been extended to deal with the external subset as fully as possible. DTDpp ----- This little program is just a pretty-printer for an XML DTD - it inlines any included files and expands all PE references. Its main use is to check that the HaXml parser can read a complicated DTD without errors. DebugLex -------- Another little debugging program to help find errors in HaXml - this time in the lexer. It prints a stream of lexed tokens (and their source positions) to stdout, so you can examine whether some complicated piece of syntax has confused the lexer. �����������������hugs98-plus-Sep2006/packages/HaXml/examples/SimpleTest.hs�������������������������������������������0000644�0065111�0065111�00000002711�10504340466�022020� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module Main where import List (isPrefixOf) import Text.XML.HaXml.XmlContent import Text.XML.HaXml.Types import Text.PrettyPrint.HughesPJ (render) import Text.XML.HaXml.Pretty (document) -- Test stuff value1 :: ([(Bool,Int)],(String,Maybe Char)) value1 = ([(True,42),(False,0)],("Hello World",Just 'x')) data MyType a = ConsA Int a | ConsB String deriving Eq {-! derive : Haskell2Xml !-} instance Haskell2Xml a => Haskell2Xml (MyType a) where toHType v = Defined "MyType" [toHType a] [Constr "ConsA" [toHType a] [Prim "Int" "int", toHType a] ,Constr "ConsB" [] [String] ] where (ConsA _ a) = v toContents v@(ConsA n a) = [mkElemC (showConstr 0 (toHType v)) (concat [toContents n, toContents a])] toContents v@(ConsB s) = [mkElemC (showConstr 1 (toHType v)) (toContents s)] fromContents (CElem (Elem constr [] cs) : etc) | "ConsA-" `isPrefixOf` constr = (\(i,cs')-> (\(a,_) -> (ConsA i a,etc)) (fromContents cs')) (fromContents cs) | "ConsB" `isPrefixOf` constr = (\(s,_)-> (ConsB s, etc)) (fromContents cs) value2 :: (MyType [Int], MyType ()) value2 = (ConsA 2 [42,0], ConsB "hello world") --main = do (putStrLn . render . document . toXml) value2 main = putStrLn (if value2 == (fst . fromContents . toContents) value2 then "success" else "failure") �������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/SimpleTestD.hs������������������������������������������0000644�0065111�0065111�00000006766�10504340466�022142� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module Main where import IO import System (getArgs) --import List (isPrefixOf) import Text.XML.HaXml.XmlContent -- Test stuff data MyType a = ConsA Int a | ConsB String {-! derive : XmlContent !-} instance Eq a => Eq (MyType a) where (ConsA a b) == (ConsA c d) = a==c && b==d (ConsB e) == (ConsB f) = e `isPrefixOf` f || f `isPrefixOf` e _ == _ = False {- -- Hand-written example of preferred instance declaration. instance Haskell2Xml a => Haskell2Xml (MyType a) where toHType v = Defined "MyType" [toHType a] [Constr "ConsA" [toHType a] [Prim "Int" "int", toHType a] ,Constr "ConsB" [] [String] ] where (ConsA _ a) = v toContents v@(ConsA n a) = [mkElemC (showConstr 0 (toHType v)) (concat [toContents n, toContents a])] toContents v@(ConsB s) = [mkElemC (showConstr 1 (toHType v)) (toContents s)] fromContents (CElem (Elem constr [] cs) : etc) | "ConsA-" `isPrefixOf` constr = (\(i,cs')-> (\(a,_) -> (ConsA i a,etc)) (fromContents cs')) (fromContents cs) | "ConsB" `isPrefixOf` constr = (\(s,_)-> (ConsB s, etc)) (fromContents cs) -} value1 :: Maybe ([(Bool,Int)],(String,Maybe Char)) value1 = Just ([(True,42),(False,0)],("Hello World",Nothing)) value2 :: (MyType [Int], MyType ()) value2 = (ConsA 2 [42,0], ConsB "hello world") value3 :: MyType [Int] value3 = ConsA 2 [42,0] -- Main wrapper main = getArgs >>= \args-> if length args /= 3 then putStrLn "Usage: <app> [1|2|3] [-w|-r] <xmlfile>" else let (arg0:arg1:arg2:_) = args in ( case arg1 of "-w"-> return (stdout,WriteMode) "-r"-> return (stdin,ReadMode) _ -> fail ("Usage: <app> [-r|-w] <xmlfile>") ) >>= \(std,mode)-> ( if arg2=="-" then return std else openFile arg2 mode ) >>= \f-> ( case arg0 of "1" -> checkValue f mode value1 "2" -> checkValue f mode value2 "3" -> checkValue f mode value3 _ -> fail ("Usage: <app> [-r|-w] <xmlfile>") ) checkValue f mode value = case mode of WriteMode-> hPutXml f value ReadMode -> do ivalue <- hGetXml f putStrLn (if ivalue==value then "success" else "failure") -- WriteMode-> (hPutStrLn f . render . document . toXml) value1 -- ReadMode -> hGetContents f >>= \content -> -- let ivalue = (fromXml . xmlParse) content in -- (putStrLn . render . document . toXml) (ivalue `asTypeOf` value1) >> -- putStrLn (if ivalue == value1 then "success" else "failure") -- Machine generated stuff {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-} instance (Haskell2Xml a) => Haskell2Xml (MyType a) where toHType v = Defined "MyType" [a] [Constr "ConsA" [a] [toHType aa,toHType ab], Constr "ConsB" [] [toHType ac]] where (ConsA aa ab) = v (ConsB ac) = v (a) = toHType ab fromContents (CElem (Elem constr [] cs):etc) | "ConsA" `isPrefixOf` constr = (\(aa,cs00)-> (\(ab,_)-> (ConsA aa ab, etc)) (fromContents cs00)) (fromContents cs) | "ConsB" `isPrefixOf` constr = (\(ac,_)-> (ConsB ac, etc)) (fromContents cs) fromContents (CElem (Elem constr _ _):etc) = error ("expected ConsA or ConsB, got "++constr) toContents v@(ConsA aa ab) = [mkElemC (showConstr 0 (toHType v)) (concat [toContents aa, toContents ab])] toContents v@(ConsB ac) = [mkElemC (showConstr 1 (toHType v)) (toContents ac)] ����������hugs98-plus-Sep2006/packages/HaXml/examples/SimpleTestBool.hs���������������������������������������0000644�0065111�0065111�00000000563�10504340466�022637� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module Main where import List (isPrefixOf) import Text.XML.HaXml.XmlContent import Text.XML.HaXml.Types import Text.PrettyPrint.HughesPJ (render) import Text.XML.HaXml.Pretty (document) -- Test stuff --value1 :: ([(Bool,Int)],(String,Maybe Char)) value1 = True --main = do (putStrLn . render . document . toXml) value2 main = fWriteXml "/dev/tty" value1 ���������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/Types.hs������������������������������������������������0000644�0065111�0065111�00000001300�10504340466�021024� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������module DTypes where import Text.XML.HaXml.XmlContent hiding (Name) -- data types for a simple test program data Person = Person Name Email [Rating] Version {-! derive : XmlContent !-} newtype Name = Name String {-! derive : XmlContent !-} newtype Email = Email String {-! derive : XmlContent !-} newtype Version = Version Int {-! derive : XmlContent !-} data Rating = Rating SubjectID Interest Skill {-! derive : XmlContent !-} newtype SubjectID = SubjectID Int {-! derive : XmlContent !-} newtype Interest = Interest Score {-! derive : XmlContent !-} newtype Skill = Skill Score {-! derive : XmlContent !-} data Score = ScoreNone | ScoreLow | ScoreMedium | ScoreHigh {-! derive : XmlContent !-} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/album.dtd�����������������������������������������������0000644�0065111�0065111�00000002462�10504340456�021172� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!DOCTYPE album [ <!ELEMENT album (title, artist, recording?, coverart, catalogno*, personnel, track*, notes) > <!ELEMENT title (#PCDATA) > <!ELEMENT artist (#PCDATA) > <!ELEMENT recording EMPTY> <!ATTLIST recording date CDATA #IMPLIED place CDATA #IMPLIED> <!ELEMENT coverart (location)? > <!ATTLIST coverart style CDATA #REQUIRED> <!ELEMENT location EMPTY > <!ATTLIST location thumbnail CDATA #IMPLIED fullsize CDATA #IMPLIED> <!ELEMENT catalogno EMPTY > <!ATTLIST catalogno label CDATA #REQUIRED number CDATA #REQUIRED format (CD | LP | MiniDisc) #IMPLIED releasedate CDATA #IMPLIED country CDATA #IMPLIED> <!ELEMENT personnel (player)+ > <!ELEMENT player EMPTY > <!ATTLIST player name CDATA #REQUIRED instrument CDATA #REQUIRED> <!ELEMENT track EMPTY> <!ATTLIST track title CDATA #REQUIRED credit CDATA #IMPLIED timing CDATA #IMPLIED> <!ELEMENT notes (#PCDATA | albumref | trackref)* > <!ATTLIST notes author CDATA #IMPLIED> <!ELEMENT albumref (#PCDATA)> <!ATTLIST albumref link CDATA #REQUIRED> <!ELEMENT trackref (#PCDATA)> <!ATTLIST trackref link CDATA #IMPLIED> ]> ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������hugs98-plus-Sep2006/packages/HaXml/examples/album.xml�����������������������������������������������0000644�0065111�0065111�00000003315�10504340456�021215� 0����������������������������������������������������������������������������������������������������ustar �ross����������������������������ross�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<?xml version='1.0'?> <!DOCTYPE album SYSTEM "album.dtd"> <album ><title>Time OutDave Brubeck QuartetPossibly the DBQ's most famous album, this contains Take Five, the most famous jazz track of that period. These experiments in different time signatures are what Dave Brubeck is most remembered for. Recorded Jun-Aug 1959 in NYC. See also the sequel, Time Further Out. hugs98-plus-Sep2006/packages/HaXml/examples/subjdb.xml0000644006511100651110000000252210504340456021365 0ustar rossross ]> Rob Noblerjn hugs98-plus-Sep2006/packages/HaXml/script/0000755006511100651110000000000010504340456017057 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/script/echo.c0000644006511100651110000000063010504340456020140 0ustar rossross#include int main (int argc, char** argv) { int i=0; if (argc>1) { if (strcmp(argv[1],"-n")==0) { for (i=2; i 1.12-1 - Updated to HaXml 1.14 * Tue Mar 16 2004 Malcolm Wallace 1.12-1 - Updated to HaXml 1.12 - Licence has changed to GPL + LPGL * Mon Mar 15 2004 Bjorn Bringert 1.11-1 - Updated to HaXml 1.11 - Removed newline that broke postinstall script * Mon Dec 22 2003 Bjorn Bringert 1.09-5 - Updated to GHC 6.2 * Mon Dec 8 2003 Bjorn Bringert 1.09-4 - Updated to GHC 6.0.1 - Removed newline that broke install rule in spec * Tue Jun 10 2003 Jens Petersen - 1.09-3 - fix post script package location and preun script package name - no need to make the ghci object file * Tue Jun 10 2003 Jens Petersen - 1.09-2 - add doc files - include examples in lib package - add doc package * Tue Jun 10 2003 Jens Petersen - 1.09-1 - Initial packaging. hugs98-plus-Sep2006/packages/HaXml/src/0000755006511100651110000000000010504340466016343 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/src/Makefile.inc0000644006511100651110000000022310504340456020547 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/HaXml/src/Makefile0000644006511100651110000001031110504340466017777 0ustar rossrossSOFTWARE = HaXml VERSION = 1.17 LIBSRCS = \ Text/XML/HaXml.hs Text/XML/HaXml/Combinators.hs Text/XML/HaXml/Lex.hs \ Text/XML/HaXml/Posn.hs \ Text/XML/HaXml/Parse.hs Text/XML/HaXml/Pretty.hs \ Text/XML/HaXml/Types.hs Text/XML/HaXml/Validate.hs \ Text/XML/HaXml/Wrappers.hs \ Text/XML/HaXml/OneOfN.hs \ Text/XML/HaXml/ParseLazy.hs \ Text/XML/HaXml/TypeMapping.hs Text/XML/HaXml/XmlContent.hs \ Text/XML/HaXml/Verbatim.hs Text/XML/HaXml/Escape.hs \ Text/XML/HaXml/SAX.hs \ Text/XML/HaXml/ShowXmlLazy.hs \ Text/XML/HaXml/Html/Generate.hs Text/XML/HaXml/Html/Parse.hs \ Text/XML/HaXml/Html/Pretty.hs \ Text/XML/HaXml/Html/ParseLazy.hs \ Text/XML/HaXml/Xtract/Combinators.hs \ Text/XML/HaXml/Xtract/Lex.hs \ Text/XML/HaXml/Xtract/Parse.hs \ Text/ParserCombinators/HuttonMeijer.hs \ Text/ParserCombinators/HuttonMeijerWallace.hs \ Text/ParserCombinators/Poly.hs \ Text/ParserCombinators/PolyState.hs \ Text/ParserCombinators/PolyLazy.hs \ Text/ParserCombinators/PolyStateLazy.hs \ Text/ParserCombinators/TextParser.hs \ LIBOBJS = $(patsubst %.hs, %.o, $(LIBSRCS)) TOOLSRCS = \ Text/XML/HaXml/DtdToHaskell/TypeDef.hs \ Text/XML/HaXml/DtdToHaskell/Convert.hs \ Text/XML/HaXml/DtdToHaskell/Instance.hs \ tools/DtdToHaskell.hs tools/Xtract.hs tools/Validate.hs \ tools/Canonicalise.hs tools/MkOneOf.hs \ tools/CanonicaliseLazy.hs tools/XtractLazy.hs TOOLSET = \ ../../DtdToHaskell$(EXE) ../../Xtract$(EXE) ../../Validate$(EXE) \ ../../Canonicalise$(EXE) ../../MkOneOf$(EXE) \ ../../CanonicaliseLazy$(EXE) ../../XtractLazy$(EXE) EXE = $(shell cat ../exe) OUT = $(shell cat ../out) INSTALLDIR = $(shell cat ../prefix) WHOLEARCHIVE = $(shell cat ../ldopt) # The caller *must* set the HC variable. COMPILER := $(findstring ghc, $(HC)) ifeq "$(COMPILER)" "ghc" COMPILE = $(HC) --make -cpp -i. $(shell cat ghcpkgs) -package-name HaXml \ -DVERSION=$(VERSION) RENAME = mv $(OUT) endif COMPILER := $(findstring nhc98, $(HC)) ifeq "$(COMPILER)" "nhc98" COMPILE = hmake -hc=$(HC) -I. -K4M +CTS -H8M -CTS -package base \ -DVERSION=$(VERSION) RENAME = echo Built endif .PHONY: all libs toolset all: libs toolset libs: libHSHaXml.a toolset: $(TOOLSET) install-filesonly-ghc: libs $(INSTALLDIR) cp libHSHaXml.a `cat ghclibdir` -ranlib `cat ghclibdir`/libHSHaXml.a # ignore if fails on Linux -cp HSHaXml.o `cat ghclibdir` # file may not exist on MacOS X rm -rf `cat ghcincdir`/HaXml mkdir -p `cat ghcincdir`/HaXml cp interfaces.tar `cat ghcincdir`/HaXml cd `cat ghcincdir`/HaXml; tar xf interfaces.tar; rm interfaces.tar cp $(TOOLSET) $(INSTALLDIR) install-filesonly-nhc98: libs $(INSTALLDIR) cp libHSHaXml.a `cat nhc98libdir`/`harch` -ranlib `cat nhc98libdir`/`harch`/libHSHaXml.a rm -rf `cat nhc98incdir`/HaXml mkdir -p `cat nhc98incdir`/HaXml cp interfaces.tar `cat nhc98incdir`/packages/HaXml cd `cat nhc98incdir`/packages/HaXml; tar xf interfaces.tar; rm interfaces.tar cp $(TOOLSET) $(INSTALLDIR) install-ghc: install-filesonly-ghc HaXml.pkgconf `cat ghcpkgcmd` --remove-package=HaXml || true `cat ghcpkgcmd` --add-package >$@ echo "library-dirs: `cat ghclibdirraw`" >>$@ echo "depends: base, haskell98" >>$@ echo "hs-libraries: HS$(SOFTWARE)" >>$@ # packaged library libHSHaXml.a: $(LIBSRCS) $(COMPILE) $(LIBSRCS) ar r libHSHaXml.a $(LIBOBJS) -ld -r $(WHOLEARCHIVE) -o HSHaXml.o libHSHaXml.a # for GHCi only tar cf interfaces.tar `find Text -name *.hi -print` # standalone tools $(TOOLSET): $(LIBSRCS) $(TOOLSRCS) cd tools; $(COMPILE) -i.. $(patsubst ../../%${EXE}, %, $@) cd tools; $(RENAME) $(patsubst ../../%, %, $@) mv $(patsubst ../../%, tools/%, $@) ../.. toolset-hugs: for file in tools/*.hs ;\ do tool=`basename $$file .hs` ;\ echo '#!'`which runhugs` >$$tool ;\ cat $$file >>$$tool ;\ chmod +x $$tool ;\ done $(INSTALLDIR): if [ ! -d $(INSTALLDIR) ] ; then mkdir -p $(INSTALLDIR); fi hugs98-plus-Sep2006/packages/HaXml/src/Text/0000755006511100651110000000000010504340456017266 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/src/Text/ParserCombinators/0000755006511100651110000000000010504340466022724 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/src/Text/ParserCombinators/HuttonMeijer.hs0000644006511100651110000001674710504340456025713 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.HuttonMeijer -- Copyright : Graham Hutton (University of Nottingham), Erik Meijer (University of Utrecht) -- Licence : BSD -- -- Maintainer : Malcolm Wallace -- Stability : Stable -- Portability : All -- -- A LIBRARY OF MONADIC PARSER COMBINATORS -- -- 29th July 1996 -- -- Graham Hutton Erik Meijer -- University of Nottingham University of Utrecht -- -- This Haskell script defines a library of parser combinators, and is -- taken from sections 1-6 of our article "Monadic Parser Combinators". -- Some changes to the library have been made in the move from Gofer -- to Haskell: -- -- * Do notation is used in place of monad comprehension notation; -- -- * The parser datatype is defined using "newtype", to avoid the overhead -- of tagging and untagging parsers with the P constructor. ----------------------------------------------------------------------------- module Text.ParserCombinators.HuttonMeijer (Parser(..), item, first, papply, (+++), sat, {-tok,-} many, many1, sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper, letter, alphanum, string, ident, nat, int, spaces, comment, junk, skip, token, natural, integer, symbol, identifier) where import Char import Monad infixr 5 +++ type Token = Char --------------------------------------------------------- -- | The parser monad newtype Parser a = P ([Token] -> [(a,[Token])]) instance Functor Parser where -- map :: (a -> b) -> (Parser a -> Parser b) fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp]) instance Monad Parser where -- return :: a -> Parser a return v = P (\inp -> [(v,inp)]) -- >>= :: Parser a -> (a -> Parser b) -> Parser b (P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp]) -- fail :: String -> Parser a fail _ = P (\_ -> []) instance MonadPlus Parser where -- mzero :: Parser a mzero = P (\_ -> []) -- mplus :: Parser a -> Parser a -> Parser a (P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp)) -- ------------------------------------------------------------ -- * Other primitive parser combinators -- ------------------------------------------------------------ item :: Parser Token item = P (\inp -> case inp of [] -> [] (x:xs) -> [(x,xs)]) first :: Parser a -> Parser a first (P p) = P (\inp -> case p inp of [] -> [] (x:_) -> [x]) papply :: Parser a -> [Token] -> [(a,[Token])] papply (P p) inp = p inp -- ------------------------------------------------------------ -- * Derived combinators -- ------------------------------------------------------------ (+++) :: Parser a -> Parser a -> Parser a p +++ q = first (p `mplus` q) sat :: (Token -> Bool) -> Parser Token sat p = do {x <- item; if p x then return x else mzero} --tok :: Token -> Parser Token --tok t = do {x <- item; if t==snd x then return t else mzero} many :: Parser a -> Parser [a] many p = many1 p +++ return [] --many p = force (many1 p +++ return []) many1 :: Parser a -> Parser [a] many1 p = do {x <- p; xs <- many p; return (x:xs)} sepby :: Parser a -> Parser b -> Parser [a] p `sepby` sep = (p `sepby1` sep) +++ return [] sepby1 :: Parser a -> Parser b -> Parser [a] p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)} chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a chainl p op v = (p `chainl1` op) +++ return v chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a p `chainl1` op = do {x <- p; rest x} where rest x = do {f <- op; y <- p; rest (f x y)} +++ return x chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a chainr p op v = (p `chainr1` op) +++ return v chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a p `chainr1` op = do {x <- p; rest x} where rest x = do {f <- op; y <- p `chainr1` op; return (f x y)} +++ return x ops :: [(Parser a, b)] -> Parser b ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs] bracket :: Parser a -> Parser b -> Parser c -> Parser b bracket open p close = do {open; x <- p; close; return x} -- ------------------------------------------------------------ -- * Useful parsers -- ------------------------------------------------------------ char :: Char -> Parser Char char x = sat (\y -> x == y) digit :: Parser Char digit = sat isDigit lower :: Parser Char lower = sat isLower upper :: Parser Char upper = sat isUpper letter :: Parser Char letter = sat isAlpha alphanum :: Parser Char alphanum = sat isAlphaNum +++ char '_' string :: String -> Parser String string "" = return "" string (x:xs) = do {char x; string xs; return (x:xs)} ident :: Parser String ident = do {x <- lower; xs <- many alphanum; return (x:xs)} nat :: Parser Int nat = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op where m `op` n = 10*m + n int :: Parser Int int = do {char '-'; n <- nat; return (-n)} +++ nat -- ------------------------------------------------------------ -- * Lexical combinators -- ------------------------------------------------------------ spaces :: Parser () spaces = do {many1 (sat isSpace); return ()} comment :: Parser () --comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()} --comment = do -- _ <- string "--" -- _ <- many (sat (\x -> x /= '\n')) -- return () comment = do bracket (string "/*") (many item) (string "*/") return () junk :: Parser () junk = do {many (spaces +++ comment); return ()} skip :: Parser a -> Parser a skip p = do {junk; p} token :: Parser a -> Parser a token p = do {v <- p; junk; return v} -- ------------------------------------------------------------ -- * Token parsers -- ------------------------------------------------------------ natural :: Parser Int natural = token nat integer :: Parser Int integer = token int symbol :: String -> Parser String symbol xs = token (string xs) identifier :: [String] -> Parser String identifier ks = token (do {x <- ident; if not (elem x ks) then return x else return mzero}) ------------------------------------------------------------------------------ hugs98-plus-Sep2006/packages/HaXml/src/Text/ParserCombinators/Poly.hs0000644006511100651110000002360210504340456024205 0ustar rossrossmodule Text.ParserCombinators.Poly ( -- * A Parser datatype parameterised on arbitrary token type Parser(P) -- datatype, instance of: Functor, Monad , runParser -- :: Parser t a -> [t] -> (Either String a, [t]) , failBad -- :: String -> Parser t a , commit -- :: Parser t a -> Parser t a -- * Combinators -- ** primitives , next -- :: Parser t t , satisfy -- :: (t->Bool) -> Parser t t , apply -- :: Parser t (a->b) -> Parser t a -> Parser t b , discard -- :: Parser t a -> Parser t b -> Parser t a -- ** error-handling , adjustErr -- :: Parser t a -> (String->String) -> Parser t a , adjustErrBad-- :: Parser t a -> (String->String) -> Parser t a , indent -- :: Int -> String -> String -- ** choices , onFail -- :: Parser t a -> Parser t a -> Parser t a , oneOf -- :: Show t => [Parser t a] -> Parser t a , oneOf' -- :: [(String,Parser t a)] -> Parser t a , optional -- :: Parser t a -> Parser t (Maybe a) -- ** sequences , many -- :: Parser t a -> Parser t [a] , many1 -- :: Parser t a -> Parser t [a] , sepBy -- :: Parser t a -> Parser t sep -> Parser t [a] , sepBy1 -- :: Parser t a -> Parser t sep -> Parser t [a] , bracketSep -- :: Parser t bra -> Parser t sep -> Parser t ket -- -> Parser t a -> Parser t [a] , bracket -- :: Parser t bra -> Parser t ket -> Parser t a -- -> Parser t a , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a] -- ** re-parsing , reparse -- :: [t] -> Parser t () ) where -- | The @Parser@ datatype is a fairly generic parsing monad with error -- reporting. It can be used for arbitrary token types, not just -- String input. (If you require a running state, use module PolyState -- instead) newtype Parser t a = P ([t] -> (EitherE String a, [t])) -- A return type like Either, that distinguishes not only between -- right and wrong answers, but also had gradations of wrongness. type EitherE a b = Either (Bool,a) b -- | Apply a parser to an input token sequence. runParser :: Parser t a -> [t] -> (Either String a, [t]) runParser (P p) = (\ (e,ts)-> (case e of {Left (_,m)->Left m; Right m->Right m}, ts) ) . p instance Functor (Parser t) where fmap f (P p) = P (\ts-> case p ts of (Left msg, ts') -> (Left msg, ts') (Right x, ts') -> (Right (f x), ts')) instance Monad (Parser t) where return x = P (\ts-> (Right x, ts)) (P f) >>= g = P (\ts-> case f ts of (Left msg, ts') -> (Left msg, ts') (Right x, ts') -> let (P g') = g x in g' ts') fail e = P (\ts-> (Left (False,e), ts)) -- | When a simple fail is not strong enough, use failBad for emphasis. -- An emphasised (severe) error can propagate out through choice operators. failBad :: String -> Parser t a failBad msg = P (\ts-> (Left (True,msg), ts)) -- | Commit is a way of raising the severity of any errors found within -- its argument. Used in the middle of a parser definition, it means that -- any operations prior to commitment fail softly, but after commitment, -- they fail hard. commit :: Parser t a -> Parser t a commit (P p) = P (\ts-> case p ts of (Left (_,e), ts') -> (Left (True,e), ts') right -> right ) -- Combinators -- | One token next :: Parser t t next = P (\ts-> case ts of [] -> (Left (False,"Ran out of input (EOF)"), []) (t:ts') -> (Right t, ts') ) -- | One token satifying a predicate satisfy :: (t->Bool) -> Parser t t satisfy p = do{ x <- next ; if p x then return x else fail "Parse.satisfy: failed" } infixl 3 `apply` -- | Apply a parsed function to a parsed value apply :: Parser t (a->b) -> Parser t a -> Parser t b pf `apply` px = do { f <- pf; x <- px; return (f x) } infixl 3 `discard` -- | @x `discard` y@ parses both x and y, but discards the result of y discard :: Parser t a -> Parser t b -> Parser t a px `discard` py = do { x <- px; _ <- py; return x } -- | @p `adjustErr` f@ applies the transformation @f@ to any error message -- generated in @p@, having no effect if @p@ succeeds. adjustErr :: Parser t a -> (String->String) -> Parser t a (P p) `adjustErr` f = P (\ts-> case p ts of (Left (b,msg), ts') -> (Left (b,(f msg)), ts') right -> right ) -- | @adjustErrBad@ is just like @adjustErr@ except it also raises the -- severity of the error. adjustErrBad :: Parser t a -> (String->String) -> Parser t a p `adjustErrBad` f = commit (p `adjustErr` f) infixl 6 `onFail` -- not sure about precedence 6? -- | @p `onFail` q@ means parse p unless p fails in which case parse q instead. -- Can be chained together to give multiple attempts to parse something. -- (Note that q could itself be a failing parser, e.g. to change the error -- message from that defined in p to something different.) -- However, a *severe* failure in p cannot be ignored. onFail :: Parser t a -> Parser t a -> Parser t a (P p) `onFail` (P q) = P (\ts-> case p ts of r@(Left (True,_), _) -> r (Left _, _) -> q ts right -> right ) -- | Parse the first alternative in the list that succeeds. oneOf :: [Parser t a] -> Parser t a oneOf [] = do { n <- next ; fail ("failed to parse any of the possible choices") } --oneOf :: Show t => [Parser t a] -> Parser t a --oneOf [] = do { n <- next -- ; fail ("failed to parse any of the possible choices" -- ++"\n next token is "++show n) -- } oneOf (p:ps) = p `onFail` oneOf ps -- | Parse the first alternative that succeeds, but if none succeed, -- report only the severe errors, and if none of those, then report -- all the soft errors. oneOf' :: [(String, Parser t a)] -> Parser t a oneOf' = accum [] where accum errs [] = case filter isBad errs of [] -> fail ("failed to parse any of the possible choices:\n" ++indent 2 (concatMap showErr (reverse errs))) [(_,(_,e))] -> failBad e es -> failBad ("one of the following failures occurred:\n" ++indent 2 (concatMap showErr (reverse es))) accum errs ((e,P p):ps) = P (\ts-> case p ts of (Left err,_) -> let (P p) = accum ((e,err):errs) ps in p ts right -> right ) showErr (name,(_,err)) = name++":\n"++indent 2 err isBad (_,(b,_)) = b -- | Helper for formatting error messages: indents all lines by a fixed amount. indent :: Int -> String -> String indent n = unlines . map (replicate n ' ' ++) . lines -- | 'optional' indicates whether the parser succeeded through the Maybe type. optional :: Parser t a -> Parser t (Maybe a) optional p = fmap Just p `onFail` return Nothing -- | 'many p' parses a list of elements with individual parser p. -- Cannot fail, since an empty list is a valid return value. many :: Parser t a -> Parser t [a] many p = many1 p `onFail` return [] -- | Parse a non-empty list of items. many1 :: Parser t a -> Parser t [a] many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2) ; xs <- many p ; return (x:xs) } -- `adjustErr` ("When looking for a non-empty sequence:\n\t"++) -- | Parse a list of items separated by discarded junk. sepBy :: Parser t a -> Parser t sep -> Parser t [a] sepBy p sep = do sepBy1 p sep `onFail` return [] -- | Parse a non-empty list of items separated by discarded junk. sepBy1 :: Parser t a -> Parser t sep -> Parser t [a] sepBy1 p sep = do { x <- p ; xs <- many (do {sep; p}) ; return (x:xs) } `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++) -- | Parse a list of items, discarding the start, end, and separator -- items. bracketSep :: Parser t bra -> Parser t sep -> Parser t ket -> Parser t a -> Parser t [a] bracketSep open sep close p = do { open; close; return [] } `onFail` do { open `adjustErr` ("Missing opening bracket:\n\t"++) ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++) ; xs <- many (do {sep; p}) ; close `adjustErrBad` ("When looking for closing bracket:\n\t"++) ; return (x:xs) } -- | Parse a bracketed item, discarding the brackets. bracket :: Parser t bra -> Parser t ket -> Parser t a -> Parser t a bracket open close p = do do { open `adjustErr` ("Missing opening bracket:\n\t"++) ; x <- p ; close `adjustErrBad` ("Missing closing bracket:\n\t"++) ; return x } -- | 'manyFinally e t' parses a possibly-empty sequence of e's, -- terminated by a t. Any parse failures could be due either to -- a badly-formed terminator or a badly-formed element, so raise -- both possible errors. manyFinally :: Parser t a -> Parser t z -> Parser t [a] manyFinally p t = do { xs <- many p ; oneOf' [ ("sequence terminator", do { t; return () } ) , ("item in a sequence", do { p; return () } ) ] ; return xs } ------------------------------------------------------------------------ -- | Push some tokens back onto the front of the input stream and reparse. -- This is useful e.g. for recursively expanding macros. When the -- user-parser recognises a macro use, it can lookup the macro -- expansion from the parse state, lex it, and then stuff the -- lexed expansion back down into the parser. reparse :: [t] -> Parser t () reparse ts = P (\inp-> (Right (), ts++inp)) ------------------------------------------------------------------------ hugs98-plus-Sep2006/packages/HaXml/src/Text/ParserCombinators/HuttonMeijerWallace.hs0000644006511100651110000003050010504340456027163 0ustar rossross{----------------------------------------------------------------------------- A LIBRARY OF MONADIC PARSER COMBINATORS 29th July 1996 Graham Hutton Erik Meijer University of Nottingham University of Utrecht This Haskell 1.3 script defines a library of parser combinators, and is taken from sections 1-6 of our article "Monadic Parser Combinators". Some changes to the library have been made in the move from Gofer to Haskell: * Do notation is used in place of monad comprehension notation; * The parser datatype is defined using "newtype", to avoid the overhead of tagging and untagging parsers with the P constructor. ------------------------------------------------------------------------------ ** Extended to allow a symbol table/state to be threaded through the monad. ** Extended to allow a parameterised token type, rather than just strings. ** Extended to allow error-reporting. (Extensions: 1998-2000 Malcolm.Wallace@cs.york.ac.uk) (More extensions: 2004 gk-haskell@ninebynine.org) ------------------------------------------------------------------------------} -- | This library of monadic parser combinators is based on the ones -- defined by Graham Hutton and Erik Meijer. It has been extended by -- Malcolm Wallace to use an abstract token type (no longer just a -- string) as input, and to incorporate a State Transformer monad, useful -- for symbol tables, macros, and so on. Basic facilities for error -- reporting have also been added, and later extended by Graham Klyne -- to return the errors through an @Either@ type, rather than just -- calling @error@. module Text.ParserCombinators.HuttonMeijerWallace ( -- * The parser monad Parser(..) -- * Primitive parser combinators , item, eof, papply, papply' -- * Derived combinators , (+++), {-sat,-} tok, nottok, many, many1 , sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket , toEOF -- * Error handling , elserror -- * State handling , stupd, stquery, stget -- * Re-parsing , reparse ) where import Char import Monad infixr 5 +++ --- The parser monad --------------------------------------------------------- type ParseResult s t e a = Either e [(a,s,[Either e t])] newtype Parser s t e a = P ( s -> [Either e t] -> ParseResult s t e a ) -- ^ The parser type is parametrised on the types of the state @s@, -- the input tokens @t@, error-type @e@, and the result value @a@. -- The state and remaining input are threaded through the monad. instance Functor (Parser s t e) where -- fmap :: (a -> b) -> (Parser s t e a -> Parser s t e b) fmap f (P p) = P (\st inp -> case p st inp of Right res -> Right [(f v, s, out) | (v,s,out) <- res] Left err -> Left err ) instance Monad (Parser s t e) where -- return :: a -> Parser s t e a return v = P (\st inp -> Right [(v,st,inp)]) -- >>= :: Parser s t e a -> (a -> Parser s t e b) -> Parser s t e b (P p) >>= f = P (\st inp -> case p st inp of Right res -> foldr joinresults (Right []) [ papply' (f v) s out | (v,s,out) <- res ] Left err -> Left err ) -- fail :: String -> Parser s t e a fail err = P (\st inp -> Right []) -- I know it's counterintuitive, but we want no-parse, not an error. instance MonadPlus (Parser s t e) where -- mzero :: Parser s t e a mzero = P (\st inp -> Right []) -- mplus :: Parser s t e a -> Parser s t e a -> Parser s t e a (P p) `mplus` (P q) = P (\st inp -> joinresults (p st inp) (q st inp)) -- joinresults ensures that explicitly raised errors are dominant, -- provided no parse has yet been found. The commented out code is -- a slightly stricter specification of the real code. joinresults :: ParseResult s t e a -> ParseResult s t e a -> ParseResult s t e a {- joinresults (Left p) (Left q) = Left p joinresults (Left p) (Right _) = Left p joinresults (Right []) (Left q) = Left q joinresults (Right p) (Left q) = Right p joinresults (Right p) (Right q) = Right (p++q) -} joinresults (Left p) q = Left p joinresults (Right []) q = q joinresults (Right p) q = Right (p++ case q of Left _ -> [] Right r -> r) --- Primitive parser combinators --------------------------------------------- -- | Deliver the first remaining token. item :: Parser s t e t item = P (\st inp -> case inp of [] -> Right [] (Left e: _) -> Left e (Right x: xs) -> Right [(x,st,xs)] ) -- | Fail if end of input is not reached eof :: Show p => Parser s (p,t) String () eof = P (\st inp -> case inp of [] -> Right [((),st,[])] (Left e:_) -> Left e (Right (p,_):_) -> Left ("End of input expected at " ++show p++"\n but found text") ) {- -- | Ensure the value delivered by the parser is evaluated to WHNF. force :: Parser s t e a -> Parser s t e a force (P p) = P (\st inp -> let Right xs = p st inp h = head xs in h `seq` Right (h: tail xs) ) -- [[[GK]]] ^^^^^^ -- WHNF = Weak Head Normal Form, meaning that it has no top-level redex. -- In this case, I think that means that the first element of the list -- is fully evaluated. -- -- NOTE: the original form of this function fails if there is no parse -- result for p st inp (head xs fails if xs is null), so the modified -- form can assume a Right value only. -- -- Why is this needed? -- It's not exported, and the only use of this I see is commented out. --------------------------------------- -} -- | Deliver the first parse result only, eliminating any backtracking. first :: Parser s t e a -> Parser s t e a first (P p) = P (\st inp -> case p st inp of Right (x:xs) -> Right [x] otherwise -> otherwise ) -- | Apply the parser to some real input, given an initial state value. -- If the parser fails, raise 'error' to halt the program. -- (This is the original exported behaviour - to allow the caller to -- deal with the error differently, see @papply'@.) papply :: Parser s t String a -> s -> [Either String t] -> [(a,s,[Either String t])] papply (P p) st inp = either error id (p st inp) -- | Apply the parser to some real input, given an initial state value. -- If the parser fails, return a diagnostic message to the caller. papply' :: Parser s t e a -> s -> [Either e t] -> Either e [(a,s,[Either e t])] papply' (P p) st inp = p st inp --- Derived combinators ------------------------------------------------------ -- | A choice between parsers. Keep only the first success. (+++) :: Parser s t e a -> Parser s t e a -> Parser s t e a p +++ q = first (p `mplus` q) -- | Deliver the first token if it satisfies a predicate. sat :: (t -> Bool) -> Parser s (p,t) e t sat p = do {(_,x) <- item; if p x then return x else mzero} -- | Deliver the first token if it equals the argument. tok :: Eq t => t -> Parser s (p,t) e t tok t = do {(_,x) <- item; if x==t then return t else mzero} -- | Deliver the first token if it does not equal the argument. nottok :: Eq t => [t] -> Parser s (p,t) e t nottok ts = do {(_,x) <- item; if x `notElem` ts then return x else mzero} -- | Deliver zero or more values of @a@. many :: Parser s t e a -> Parser s t e [a] many p = many1 p +++ return [] --many p = force (many1 p +++ return []) -- | Deliver one or more values of @a@. many1 :: Parser s t e a -> Parser s t e [a] many1 p = do {x <- p; xs <- many p; return (x:xs)} -- | Deliver zero or more values of @a@ separated by @b@'s. sepby :: Parser s t e a -> Parser s t e b -> Parser s t e [a] p `sepby` sep = (p `sepby1` sep) +++ return [] -- | Deliver one or more values of @a@ separated by @b@'s. sepby1 :: Parser s t e a -> Parser s t e b -> Parser s t e [a] p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)} chainl :: Parser s t e a -> Parser s t e (a->a->a) -> a -> Parser s t e a chainl p op v = (p `chainl1` op) +++ return v chainl1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a p `chainl1` op = do {x <- p; rest x} where rest x = do {f <- op; y <- p; rest (f x y)} +++ return x chainr :: Parser s t e a -> Parser s t e (a->a->a) -> a -> Parser s t e a chainr p op v = (p `chainr1` op) +++ return v chainr1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a p `chainr1` op = do {x <- p; rest x} where rest x = do { f <- op ; y <- p `chainr1` op ; return (f x y) } +++ return x ops :: [(Parser s t e a, b)] -> Parser s t e b ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs] bracket :: (Show p,Show t) => Parser s (p,t) e a -> Parser s (p,t) e b -> Parser s (p,t) e c -> Parser s (p,t) e b bracket open p close = do { open ; x <- p ; close -- `elserror` "improperly matched construct"; ; return x } -- | Accept a complete parse of the input only, no partial parses. toEOF :: Show p => Parser s (p,t) String a -> Parser s (p,t) String a toEOF p = do { x <- p; eof; return x } --- Error handling ----------------------------------------------------------- -- | Return an error using the supplied diagnostic string, and a token type -- which includes position information. parseerror :: (Show p,Show t) => String -> Parser s (p,t) String a parseerror err = P (\st inp -> case inp of [] -> Left "Parse error: unexpected EOF\n" (Left e:_) -> Left ("Lexical error: "++e) (Right (p,t):_) -> Left ("Parse error: in "++show p++"\n " ++err++"\n "++"Found "++show t) ) -- | If the parser fails, generate an error message. elserror :: (Show p,Show t) => Parser s (p,t) String a -> String -> Parser s (p,t) String a p `elserror` s = p +++ parseerror s --- State handling ----------------------------------------------------------- -- | Update the internal state. stupd :: (s->s) -> Parser s t e () stupd f = P (\st inp-> {-let newst = f st in newst `seq`-} Right [((), f st, inp)]) -- | Query the internal state. stquery :: (s->a) -> Parser s t e a stquery f = P (\st inp-> Right [(f st, st, inp)]) -- | Deliver the entire internal state. stget :: Parser s t e s stget = P (\st inp-> Right [(st, st, inp)]) --- Push some tokens back onto the input stream and reparse ------------------ -- | This is useful for recursively expanding macros. When the -- user-parser recognises a macro use, it can lookup the macro -- expansion from the parse state, lex it, and then stuff the -- lexed expansion back down into the parser. reparse :: [Either e t] -> Parser s t e () reparse ts = P (\st inp-> Right [((), st, ts++inp)]) ------------------------------------------------------------------------------ hugs98-plus-Sep2006/packages/HaXml/src/Text/ParserCombinators/PolyState.hs0000644006511100651110000002474610504340456025220 0ustar rossrossmodule Text.ParserCombinators.PolyState ( -- * A Parser datatype parameterised on arbitrary token type and state type Parser(P) -- datatype, instance of: Functor, Monad , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t]) , failBad -- :: String -> Parser s t a , commit -- :: Parser s t a -> Parser s t a -- * Combinators -- ** primitives , next -- :: Parser s t t , satisfy -- :: (t->Bool) -> Parser s t t , apply -- :: Parser t (a->b) -> Parser s t a -> Parser s t b , discard -- :: Parser s t a -> Parser s t b -> Parser s t a -- ** error-handling , adjustErr -- :: Parser s t a -> (String->String) -> Parser s t a , adjustErrBad-- :: Parser s t a -> (String->String) -> Parser s t a , indent -- :: Int -> String -> String -- ** choices , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a , oneOf -- :: [Parser s t a] -> Parser s t a , oneOf' -- :: [(String, Parser s t a)] -> Parser s t a -- ** sequences , many -- :: Parser s t a -> Parser s t [a] , many1 -- :: Parser s t a -> Parser s t [a] , sepBy -- :: Parser s t a -> Parser s t sep -> Parser s t [a] , sepBy1 -- :: Parser s t a -> Parser s t sep -> Parser s t [a] , bracketSep -- :: Parser s t bra -> Parser s t sep -> Parser s t ket -- -> Parser s t a -> Parser s t [a] , bracket -- :: Parser s t bra -> Parser s t ket -> Parser s t a -- -> Parser s t a , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a] -- ** state-handling , stUpdate -- :: (s->s) -> Parser s t () , stQuery -- :: (s->a) -> Parser s t a , stGet -- :: Parser s t s -- ** re-parsing , reparse -- :: [t] -> Parser s t () ) where -- | The @Parser@ datatype is a fairly generic parsing monad with error -- reporting and a running state. It can be used for arbitrary token -- types, not just String input. newtype Parser s t a = P (s -> [t] -> (EitherE String a, s, [t])) -- | A return type like Either, that distinguishes not only between -- right and wrong answers, but also had gradations of wrongness. type EitherE a b = Either (Bool,a) b -- | Apply a parser to an initial state and input token sequence. runParser :: Parser s t a -> s -> [t] -> (Either String a, s, [t]) runParser (P p) s = (\ (e,s,ts)-> (case e of Left (_,m)->Left m; Right m->Right m ,s,ts)) . p s instance Functor (Parser s t) where fmap f (P p) = P (\s ts-> case p s ts of (Left msg, s', ts') -> (Left msg, s', ts') (Right x, s', ts') -> (Right (f x), s', ts')) instance Monad (Parser s t) where return x = P (\s ts-> (Right x, s, ts)) (P f) >>= g = P (\s ts-> case f s ts of (Left msg, s', ts') -> (Left msg, s', ts') (Right x, s', ts') -> let (P g') = g x in g' s' ts') fail msg = P (\s ts-> (Left (False,msg), s, ts)) -- | When a simple fail is not strong enough, use failBad for emphasis. -- An emphasised (severe) error can propagate out through choice operators. failBad :: String -> Parser s t a failBad msg = P (\s ts-> (Left (True,msg), s, ts)) -- | Commit is a way of raising the severity of any errors found within -- its argument. Used in the middle of a parser definition, it means that -- any operations prior to commitment fail softly, but after commitment, -- they fail hard. commit :: Parser s t a -> Parser s t a commit (P p) = P (\s ts-> case p s ts of (Left (_,e), s', ts') -> (Left (True,e), s', ts') right -> right ) -- Combinators -- | One token next :: Parser s t t next = P (\s ts-> case ts of [] -> (Left (False,"Ran out of input (EOF)"), s, []) (t:ts') -> (Right t, s, ts') ) -- | One token satifying a predicate satisfy :: (t->Bool) -> Parser s t t satisfy p = do{ x <- next ; if p x then return x else fail "Parse.satisfy: failed" } infixl 3 `apply` -- | Apply a parsed function to a parsed value apply :: Parser s t (a->b) -> Parser s t a -> Parser s t b pf `apply` px = do { f <- pf; x <- px; return (f x) } infixl 3 `discard` -- | @x `discard` y@ parses both x and y, but discards the result of y discard :: Parser s t a -> Parser s t b -> Parser s t a px `discard` py = do { x <- px; _ <- py; return x } -- | @p `adjustErr` f@ applies the transformation @f@ to any error message -- generated in @p@, having no effect if @p@ succeeds. adjustErr :: Parser s t a -> (String->String) -> Parser s t a (P p) `adjustErr` f = P (\s ts-> case p s ts of (Left (b,msg), s', ts') -> (Left (b,(f msg)), s, ts') right -> right ) -- | @adjustErrBad@ is just like @adjustErr@ except it also raises the -- severity of the error. adjustErrBad :: Parser s t a -> (String->String) -> Parser s t a -- p `adjustErrBad` f = commit (p `adjustErr` f) (P p) `adjustErrBad` f = P (\s ts-> case p s ts of (Left (_,msg), s', ts') -> (Left (True,(f msg)), s, ts') right -> right ) infixl 6 `onFail` -- not sure about precedence 6? -- | @p `onFail` q@ means parse p unless p fails in which case parse q instead. -- Can be chained together to give multiple attempts to parse something. -- (Note that q could itself be a failing parser, e.g. to change the error -- message from that defined in p to something different.) -- However, a severe failure in p cannot be ignored. onFail :: Parser s t a -> Parser s t a -> Parser s t a (P p) `onFail` (P q) = P (\s ts-> case p s ts of r@(Left (True,_), _, _) -> r (Left _, _, _) -> q s ts right -> right ) -- | Parse the first alternative in the list that succeeds. oneOf :: [Parser s t a] -> Parser s t a oneOf [] = fail ("Failed to parse any of the possible choices") oneOf (p:ps) = p `onFail` oneOf ps -- | Parse the first alternative that succeeds, but if none succeed, -- report only the severe errors, and if none of those, then report -- all the soft errors. oneOf' :: [(String, Parser s t a)] -> Parser s t a oneOf' = accum [] where accum errs [] = case filter isBad errs of [] -> fail ("failed to parse any of the possible choices:\n" ++indent 2 (concatMap showErr (reverse errs))) [(_,(_,e))] -> failBad e es -> failBad ("one of the following failures occurred:\n" ++indent 2 (concatMap showErr (reverse es))) accum errs ((e,P p):ps) = P (\u ts-> case p u ts of (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps in p u ts right -> right ) showErr (name,(_,err)) = name++":\n"++indent 2 err isBad (_,(b,_)) = b -- | Helper for formatting error messages: indents all lines by a fixed amount. indent :: Int -> String -> String indent n = unlines . map (replicate n ' ' ++) . lines -- | 'many p' parses a list of elements with individual parser p. -- Cannot fail, since an empty list is a valid return value. many :: Parser s t a -> Parser s t [a] many p = many1 p `onFail` return [] -- | Parse a non-empty list of items. many1 :: Parser s t a -> Parser s t [a] many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2) ; xs <- many p ; return (x:xs) } -- `adjustErr` ("When looking for a non-empty sequence:\n"++) -- | Parse a list of items separated by discarded junk. sepBy :: Parser s t a -> Parser s t sep -> Parser s t [a] sepBy p sep = do sepBy1 p sep `onFail` return [] -- | Parse a non-empty list of items separated by discarded junk. sepBy1 :: Parser s t a -> Parser s t sep -> Parser s t [a] sepBy1 p sep = do { x <- p ; xs <- many (do {sep; p}) ; return (x:xs) } `adjustErr` ("When looking for a non-empty sequence with separators:\n"++) -- | Parse a list of items, discarding the start, end, and separator -- items. bracketSep :: Parser s t bra -> Parser s t sep -> Parser s t ket -> Parser s t a -> Parser s t [a] bracketSep open sep close p = do { open; close; return [] } `onFail` do { open `adjustErr` ("Missing opening bracket:\n"++) ; x <- p `adjustErr` ("After first bracket in a group:\n"++) ; xs <- many (do {sep; p}) ; close `adjustErrBad` ("When looking for closing bracket:\n"++) ; return (x:xs) } -- | Parse a bracketed item, discarding the brackets. bracket :: Parser s t bra -> Parser s t ket -> Parser s t a -> Parser s t a bracket open close p = do do { open `adjustErr` ("Missing opening bracket:\n"++) ; x <- p ; close `adjustErrBad` ("Missing closing bracket:\n"++) ; return x } -- | 'manyFinally e t' parses a possibly-empty sequence of e's, -- terminated by a t. Any parse failures could be due either to -- a badly-formed terminator or a badly-formed element, so raise -- both possible errors. manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a] manyFinally p t = do { xs <- many p ; oneOf' [ ("sequence terminator", do { t; return () } ) , ("item in a sequence", do { p; return () } ) ] ; return xs } ------------------------------------------------------------------------ -- State handling -- | Update the internal state. stUpdate :: (s->s) -> Parser s t () stUpdate f = P (\s ts-> (Right (), f s, ts)) -- | Query the internal state. stQuery :: (s->a) -> Parser s t a stQuery f = P (\s ts-> (Right (f s), s, ts)) -- | Deliver the entire internal state. stGet :: Parser s t s stGet = P (\s ts-> (Right s, s, ts)) ------------------------------------------------------------------------ -- | Push some tokens back onto the front of the input stream and reparse. -- This is useful e.g. for recursively expanding macros. When the -- user-parser recognises a macro use, it can lookup the macro -- expansion from the parse state, lex it, and then stuff the -- lexed expansion back down into the parser. reparse :: [t] -> Parser s t () reparse ts = P (\s inp-> (Right (), s, ts++inp)) ------------------------------------------------------------------------ hugs98-plus-Sep2006/packages/HaXml/src/Text/ParserCombinators/TextParser.hs0000644006511100651110000001566110504340456025371 0ustar rossrossmodule Text.ParserCombinators.TextParser ( -- * The Parse class is a replacement for the Read class. It is a -- specialisation of the (poly) Parser monad for String input. TextParser -- synonym for Parser Char, i.e. string input, no state , Parse(..) -- instances: (), (a,b), (a,b,c), Maybe a, Either a, [a], -- Int, Integer, Float, Double, Char, Bool , parseByRead -- :: Read a => String -> TextParser a -- ** Combinators specific to string input, lexed haskell-style , word -- :: TextParser String , isWord -- :: String -> TextParser () , optionalParens -- :: TextParser a -> TextParser a , field -- :: Parse a => String -> TextParser a , constructors-- :: [(String,TextParser a)] -> TextParser a , enumeration -- :: Show a => String -> [a] -> TextParser a -- ** Re-export all the more general combinators too , module Text.ParserCombinators.Poly ) where import Char (isSpace) import List (intersperse) import Text.ParserCombinators.Poly ------------------------------------------------------------------------ -- | A synonym for Parser Char, i.e. string input (no state) type TextParser a = Parser Char a -- | The class @Parse@ is a replacement for @Read@, operating over String input. -- Essentially, it permits better error messages for why something failed to -- parse. It is rather important that @parse@ can read back exactly what -- is generated by the corresponding instance of @show@. class Parse a where parse :: TextParser a parseList :: TextParser [a] -- only to distinguish [] and "" parseList = do { isWord "[]"; return [] } `onFail` do { isWord "["; isWord "]"; return [] } `onFail` bracketSep (isWord "[") (isWord ",") (isWord "]") parse `adjustErr` ("Expected a list, but\n"++) -- | If there already exists a Read instance for a type, then we can make -- a Parser for it, but with only poor error-reporting. parseByRead :: Read a => String -> TextParser a parseByRead name = P (\s-> case reads s of [] -> (Left (False,"no parse, expected a "++name), s) [(a,s')] -> (Right a, s') _ -> (Left (False,"ambiguous parse, expected a "++name), s) ) -- | One lexical chunk (Haskell-style lexing). word :: TextParser String word = P (\s-> case lex s of [] -> (Left (False,"no input? (impossible)"), s) [("",s')] -> (Left (False,"no input?"), s') ((x,s'):_) -> (Right x, s') ) -- | Ensure that the next input word is a given string. (Note the input -- is lexed as haskell, so wordbreaks at spaces, symbols, etc.) isWord :: String -> TextParser String isWord w = do { w' <- word ; if w'==w then return w else fail ("expected "++w++" got "++w') } -- | Allow true string parens around an item. optionalParens :: TextParser a -> TextParser a optionalParens p = bracket (isWord "(") (isWord ")") p `onFail` p -- | Deal with named field syntax. field :: Parse a => String -> TextParser a field name = do { isWord name; commit $ do { isWord "="; parse } } -- | Parse one of a bunch of alternative constructors. constructors :: [(String,TextParser a)] -> TextParser a constructors cs = oneOf' (map cons cs) where cons (name,p) = ( name , do { isWord name ; p `adjustErrBad` (("got constructor, but within " ++name++",\n")++) } ) -- | Parse one of the given nullary constructors (an enumeration). enumeration :: (Show a) => String -> [a] -> TextParser a enumeration typ cs = oneOf (map (\c-> do { isWord (show c); return c }) cs) `adjustErr` (++("\n expected "++typ++" value ("++e++")")) where e = concat (intersperse ", " (map show (init cs))) ++ ", or " ++ show (last cs) ------------------------------------------------------------------------ -- Instances for all the Standard Prelude types. -- Basic types instance Parse Int where parse = parseByRead "Int" instance Parse Integer where parse = parseByRead "Integer" instance Parse Float where parse = parseByRead "Float" instance Parse Double where parse = parseByRead "Double" instance Parse Char where parse = parseByRead "Char" -- parseList = bracket (isWord "\"") (satisfy (=='"')) -- (many (satisfy (/='"'))) -- not totally correct for strings... parseList = do { w <- word; if head w == '"' then return w else fail "not a string" } instance Parse Bool where parse = enumeration "Bool" [False,True] instance Parse Ordering where parse = enumeration "Ordering" [LT,EQ,GT] -- Structural types instance Parse () where parse = P p where p [] = (Left (False,"no input: expected a ()"), []) p ('(':cs) = case dropWhile isSpace cs of (')':s) -> (Right (), s) _ -> (Left (False,"Expected ) after ("), cs) p (c:cs) | isSpace c = p cs | otherwise = ( Left (False,"Expected a (), got "++show c) , (c:cs)) instance (Parse a, Parse b) => Parse (a,b) where parse = do{ isWord "(" `adjustErr` ("Opening a 2-tuple\n"++) ; x <- parse `adjustErr` ("In 1st item of a 2-tuple\n"++) ; isWord "," `adjustErr` ("Separating a 2-tuple\n"++) ; y <- parse `adjustErr` ("In 2nd item of a 2-tuple\n"++) ; isWord ")" `adjustErr` ("Closing a 2-tuple\n"++) ; return (x,y) } instance (Parse a, Parse b, Parse c) => Parse (a,b,c) where parse = do{ isWord "(" `adjustErr` ("Opening a 3-tuple\n"++) ; x <- parse `adjustErr` ("In 1st item of a 3-tuple\n"++) ; isWord "," `adjustErr` ("Separating(1) a 3-tuple\n"++) ; y <- parse `adjustErr` ("In 2nd item of a 3-tuple\n"++) ; isWord "," `adjustErr` ("Separating(2) a 3-tuple\n"++) ; z <- parse `adjustErr` ("In 3rd item of a 3-tuple\n"++) ; isWord ")" `adjustErr` ("Closing a 3-tuple\n"++) ; return (x,y,z) } instance Parse a => Parse (Maybe a) where parse = do { isWord "Nothing"; return Nothing } `onFail` do { isWord "Just" ; fmap Just $ optionalParens parse `adjustErrBad` ("but within Just, "++) } `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2) instance (Parse a, Parse b) => Parse (Either a b) where parse = constructors [ ("Left", do { fmap Left $ optionalParens parse } ) , ("Right", do { fmap Right $ optionalParens parse } ) ] instance Parse a => Parse [a] where parse = parseList ------------------------------------------------------------------------ hugs98-plus-Sep2006/packages/HaXml/src/Text/ParserCombinators/PolyLazy.hs0000644006511100651110000002535110504340466025051 0ustar rossrossmodule Text.ParserCombinators.PolyLazy ( -- * A Parser datatype parameterised on arbitrary token type. -- Parsers do not return explicit failure. An exception is -- raised instead. This allows partial results to be returned -- before a full parse is complete. Parser(P) -- datatype, instance of: Functor, Monad , runParser -- :: Parser t a -> [t] -> (a, [t]) , failBad -- :: String -> Parser t a , commit -- :: Parser t a -> Parser t a -- * Combinators -- ** primitives , next -- :: Parser t t , satisfy -- :: (t->Bool) -> Parser t t , apply -- :: Parser t (a->b) -> Parser t a -> Parser t b , discard -- :: Parser t a -> Parser t b -> Parser t a -- ** error-handling , adjustErr -- :: Parser t a -> (String->String) -> Parser t a , adjustErrBad-- :: Parser t a -> (String->String) -> Parser t a , indent -- :: Int -> String -> String -- ** choices , onFail -- :: Parser t a -> Parser t a -> Parser t a , oneOf -- :: Show t => [Parser t a] -> Parser t a , oneOf' -- :: [(String,Parser t a)] -> Parser t a , optional -- :: Parser t a -> Parser t (Maybe a) -- ** sequences , many -- :: Parser t a -> Parser t [a] , many1 -- :: Parser t a -> Parser t [a] , sepBy -- :: Parser t a -> Parser t sep -> Parser t [a] , sepBy1 -- :: Parser t a -> Parser t sep -> Parser t [a] , bracketSep -- :: Parser t bra -> Parser t sep -> Parser t ket -- -> Parser t a -> Parser t [a] , bracket -- :: Parser t bra -> Parser t ket -> Parser t a -- -> Parser t a , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a] -- ** re-parsing , reparse -- :: [t] -> Parser t () ) where #if __GLASGOW_HASKELL__ import Control.Exception hiding (bracket) throwE :: String -> a throwE msg = throw (ErrorCall msg) #else throwE :: String -> a throwE msg = error msg #endif -- | The @Parser@ datatype is a fairly generic parsing monad with error -- reporting. It can be used for arbitrary token types, not just -- String input. (If you require a running state, use module PolyState -- instead.) newtype Parser t a = P ([t] -> (Either String a, [t])) -- A return type like Either, that distinguishes not only between -- right and wrong answers, but also had gradations of wrongness. -- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!!! type EitherE a b = Either (Bool,a) b -- | Apply a parser to an input token sequence. The parser cannot return -- an error value explicitly, so errors raise an exception. Thus, results -- can be partial (lazily constructed, but containing undefined). runParser :: Parser t a -> [t] -> (a, [t]) runParser (P p) = (\ (e,ts)-> (case e of {Left m->throwE m; Right x->x}, ts) ) . p instance Functor (Parser t) where fmap f (P p) = P (\ts-> case p ts of (Left msg, ts') -> (Left msg, ts') (Right x, ts') -> (Right (f x), ts')) instance Monad (Parser t) where return x = P (\ts-> (Right x, ts)) (P f) >>= g = P (\ts-> case f ts of (Left msg, ts') -> (Left msg, ts') (Right x, ts') -> let (P g') = g x in g' ts') fail e = P (\ts-> (Left e, ts)) -- | Simple failure can be corrected, but when a simple fail is not strong -- enough, use failBad for emphasis. It guarantees parsing will -- terminate with an exception. failBad :: String -> Parser t a failBad msg = P (\ts-> (throwE msg, ts)) -- | Commit is a way of raising the severity of any errors found within -- its argument. Used in the middle of a parser definition, it means that -- any operations prior to commitment fail softly, but after commitment, -- they fail hard. commit :: Parser t a -> Parser t a commit (P p) = P (\ts-> case p ts of (Left e, ts') -> (throwE e, ts') right -> right ) -- Combinators -- | One token next :: Parser t t next = P (\ts-> case ts of [] -> (Left "Ran out of input (EOF)", []) (t:ts') -> (Right t, ts') ) -- | One token satifying a predicate satisfy :: (t->Bool) -> Parser t t satisfy p = do{ x <- next ; if p x then return x else fail "Parse.satisfy: failed" } infixl 3 `apply` -- | Apply a parsed function to a parsed value apply :: Parser t (a->b) -> Parser t a -> Parser t b --pf `apply` px = do { f <- pf; x <- px; return (f x) } -- Needs to be lazier! Must not force the argument value too early. (P pf) `apply` (P px) = P (\ts-> case pf ts of (Left msg, ts') -> (Left msg, ts') (Right f, ts') -> let (x',ts'') = px ts' x = case x' of { Right x -> x; Left e -> throwE e } in (Right (f x), ts'') ) infixl 3 `discard` -- | @x `discard` y@ parses both x and y, but discards the result of y discard :: Parser t a -> Parser t b -> Parser t a px `discard` py = do { x <- px; _ <- py; return x } -- | @p `adjustErr` f@ applies the transformation @f@ to any error message -- generated in @p@, having no effect if @p@ succeeds. adjustErr :: Parser t a -> (String->String) -> Parser t a (P p) `adjustErr` f = P (\ts-> case p ts of (Left msg, ts') -> (Left (f msg), ts') right -> right ) -- | @adjustErrBad@ is just like @adjustErr@ except it also raises the -- severity of the error. adjustErrBad :: Parser t a -> (String->String) -> Parser t a p `adjustErrBad` f = commit (p `adjustErr` f) infixl 6 `onFail` -- not sure about precedence 6? -- | @p `onFail` q@ means parse p unless p fails in which case parse q instead. -- Can be chained together to give multiple attempts to parse something. -- (Note that q could itself be a failing parser, e.g. to change the error -- message from that defined in p to something different.) -- However, a *severe* failure in p cannot be ignored. onFail :: Parser t a -> Parser t a -> Parser t a (P p) `onFail` (P q) = P (\ts-> case p ts of (Left _, _) -> q ts right -> right ) -- | Parse the first alternative in the list that succeeds. oneOf :: [Parser t a] -> Parser t a oneOf [] = do { n <- next ; fail ("failed to parse any of the possible choices") } --oneOf :: Show t => [Parser t a] -> Parser t a --oneOf [] = do { n <- next -- ; fail ("failed to parse any of the possible choices" -- ++"\n next token is "++show n) -- } oneOf (p:ps) = p `onFail` oneOf ps -- | Parse the first alternative that succeeds, but if none succeed, -- report only the severe errors, and if none of those, then report -- all the soft errors. oneOf' :: [(String, Parser t a)] -> Parser t a oneOf' ps = accum [] ps where accum errs [] = case errs of [] -> failBad ("internal failure in parser (oneOf'):\n" ++indent 2 (show (map fst ps))) [(_,e)] -> fail e es -> fail ("one of the following failures occurred:\n" ++indent 2 (concatMap showErr (reverse es))) accum errs ((e,P p):ps) = P (\ts-> case p ts of (Left err,_) -> let (P p) = accum ((e,err):errs) ps in p ts right -> right ) showErr (name,err) = name++":\n"++indent 2 err -- | Helper for formatting error messages: indents all lines by a fixed amount. indent :: Int -> String -> String indent n = unlines . map (replicate n ' ' ++) . lines -- | 'optional' indicates whether the parser succeeded through the Maybe type. optional :: Parser t a -> Parser t (Maybe a) optional p = fmap Just p `onFail` return Nothing -- | 'many p' parses a list of elements with individual parser p. -- Cannot fail, since an empty list is a valid return value. many :: Parser t a -> Parser t [a] many p = many1 p `onFail` return [] -- | Parse a non-empty list of items. many1 :: Parser t a -> Parser t [a] many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2) ; xs <- many p ; return (x:xs) } -- `adjustErr` ("When looking for a non-empty sequence:\n\t"++) -- | Parse a list of items separated by discarded junk. sepBy :: Parser t a -> Parser t sep -> Parser t [a] sepBy p sep = do sepBy1 p sep `onFail` return [] -- | Parse a non-empty list of items separated by discarded junk. sepBy1 :: Parser t a -> Parser t sep -> Parser t [a] sepBy1 p sep = do { x <- p ; xs <- many (do {sep; p}) ; return (x:xs) } `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++) -- | Parse a list of items, discarding the start, end, and separator -- items. bracketSep :: Parser t bra -> Parser t sep -> Parser t ket -> Parser t a -> Parser t [a] bracketSep open sep close p = do { open; close; return [] } `onFail` do { open `adjustErr` ("Missing opening bracket:\n\t"++) ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++) ; xs <- many (do {sep; p}) ; close `adjustErrBad` ("When looking for closing bracket:\n\t"++) ; return (x:xs) } -- | Parse a bracketed item, discarding the brackets. bracket :: Parser t bra -> Parser t ket -> Parser t a -> Parser t a bracket open close p = do do { open `adjustErr` ("Missing opening bracket:\n\t"++) ; x <- p ; close `adjustErrBad` ("Missing closing bracket:\n\t"++) ; return x } -- | 'manyFinally e t' parses a possibly-empty sequence of e's, -- terminated by a t. Any parse failures could be due either to -- a badly-formed terminator or a badly-formed element, so raise -- both possible errors. manyFinally :: Parser t a -> Parser t z -> Parser t [a] manyFinally pp@(P p) pt@(P t) = P (\ts -> case p ts of (Left e, _) -> case t ts of (Right _, ts') -> (Right [], ts') (Left e, ts') -> (Left e, ts') (Right x, ts') -> let (tail,ts'') = runParser (manyFinally pp pt) ts' in (Right (x:tail), ts'') ) ------------------------------------------------------------------------ -- | Push some tokens back onto the front of the input stream and reparse. -- This is useful e.g. for recursively expanding macros. When the -- user-parser recognises a macro use, it can lookup the macro -- expansion from the parse state, lex it, and then stuff the -- lexed expansion back down into the parser. reparse :: [t] -> Parser t () reparse ts = P (\inp-> (Right (), ts++inp)) ------------------------------------------------------------------------ hugs98-plus-Sep2006/packages/HaXml/src/Text/ParserCombinators/PolyStateLazy.hs0000644006511100651110000002726410504340466026057 0ustar rossrossmodule Text.ParserCombinators.PolyStateLazy ( -- * A Parser datatype parameterised on arbitrary token type and state type. -- Parsers do not return explicit failure. An exception is raised -- instead. This allows partial results to be returned before a -- full parse is complete. Parser(P) -- datatype, instance of: Functor, Monad , runParser -- :: Parser s t a -> s -> [t] -> (a, s, [t]) , failBad -- :: String -> Parser s t a , commit -- :: Parser s t a -> Parser s t a -- * Combinators -- ** primitives , next -- :: Parser s t t , satisfy -- :: (t->Bool) -> Parser s t t , apply -- :: Parser t (a->b) -> Parser s t a -> Parser s t b , discard -- :: Parser s t a -> Parser s t b -> Parser s t a -- ** error-handling , adjustErr -- :: Parser s t a -> (String->String) -> Parser s t a , adjustErrBad-- :: Parser s t a -> (String->String) -> Parser s t a , indent -- :: Int -> String -> String -- ** choices , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a , oneOf -- :: [Parser s t a] -> Parser s t a , oneOf' -- :: [(String, Parser s t a)] -> Parser s t a , optional -- :: Parser s t a -> Parser s t (Maybe a) -- ** sequences , many -- :: Parser s t a -> Parser s t [a] , many1 -- :: Parser s t a -> Parser s t [a] , sepBy -- :: Parser s t a -> Parser s t sep -> Parser s t [a] , sepBy1 -- :: Parser s t a -> Parser s t sep -> Parser s t [a] , bracketSep -- :: Parser s t bra -> Parser s t sep -> Parser s t ket -- -> Parser s t a -> Parser s t [a] , bracket -- :: Parser s t bra -> Parser s t ket -> Parser s t a -- -> Parser s t a , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a] -- ** state-handling , stUpdate -- :: (s->s) -> Parser s t () , stQuery -- :: (s->a) -> Parser s t a , stGet -- :: Parser s t s -- ** re-parsing , reparse -- :: [t] -> Parser s t () ) where #if __GLASGOW_HASKELL__ import Control.Exception hiding (bracket) throwE :: String -> a throwE msg = throw (ErrorCall msg) #else throwE :: String -> a throwE msg = error msg #endif -- | The @Parser@ datatype is a fairly generic parsing monad with error -- reporting and a running state. It can be used for arbitrary token -- types, not just String input. newtype Parser s t a = P (s -> [t] -> (Either String a, s, [t])) -- | A return type like Either, that distinguishes not only between -- right and wrong answers, but also had gradations of wrongness. -- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!! type EitherE a b = Either (Bool,a) b -- | Apply a parser to an initial state and input token sequence. -- The parser cannot return an error value explicitly, so errors -- raise an exception. Thus, results can be partial (lazily constructed, -- but containing undefined). runParser :: Parser s t a -> s -> [t] -> (a, s, [t]) runParser (P p) s = (\ (e,s,ts)-> (case e of {Left m->throwE m; Right x->x}, s, ts)) . p s instance Functor (Parser s t) where fmap f (P p) = P (\s ts-> case p s ts of (Left msg, s', ts') -> (Left msg, s', ts') (Right x, s', ts') -> (Right (f x), s', ts')) instance Monad (Parser s t) where return x = P (\s ts-> (Right x, s, ts)) (P f) >>= g = P (\s ts-> case f s ts of (Left msg, s', ts') -> (Left msg, s', ts') (Right x, s', ts') -> let (P g') = g x in g' s' ts') fail msg = P (\s ts-> (Left msg, s, ts)) -- | Simple failure can be corrected, but when a simple fail is not strong -- enough, use failBad for emphasis. It guarantees parsing will terminate -- with an exception. failBad :: String -> Parser s t a failBad msg = P (\s ts-> (throwE msg, s, ts)) -- | Commit is a way of raising the severity of any errors found within -- its argument. Used in the middle of a parser definition, it means that -- any operations prior to commitment fail softly, but after commitment, -- they fail hard. commit :: Parser s t a -> Parser s t a commit (P p) = P (\s ts-> case p s ts of (Left e, s', ts') -> (throwE e, s', ts') right -> right ) -- Combinators -- | One token next :: Parser s t t next = P (\s ts-> case ts of [] -> (Left "Ran out of input (EOF)", s, []) (t:ts') -> (Right t, s, ts') ) -- | One token satifying a predicate satisfy :: (t->Bool) -> Parser s t t satisfy p = do{ x <- next ; if p x then return x else fail "Parse.satisfy: failed" } infixl 3 `apply` -- | Apply a parsed function to a parsed value apply :: Parser s t (a->b) -> Parser s t a -> Parser s t b --pf `apply` px = do { f <- pf; x <- px; return (f x) } -- Needs to be lazier! Must not force the argument value too early. (P pf) `apply` (P px) = P (\s ts-> case pf s ts of (Left msg, s', ts') -> (Left msg, s', ts') (Right f, s', ts') -> let (x',s'',ts'') = px s' ts' x = case x' of Right x -> x Left e -> throwE e in (Right (f x), s'', ts'')) infixl 3 `discard` -- | @x `discard` y@ parses both x and y, but discards the result of y discard :: Parser s t a -> Parser s t b -> Parser s t a px `discard` py = do { x <- px; _ <- py; return x } -- | @p `adjustErr` f@ applies the transformation @f@ to any error message -- generated in @p@, having no effect if @p@ succeeds. adjustErr :: Parser s t a -> (String->String) -> Parser s t a (P p) `adjustErr` f = P (\s ts-> case p s ts of (Left msg, s', ts') -> (Left (f msg), s, ts') right -> right ) -- | @adjustErrBad@ is just like @adjustErr@ except it also raises the -- severity of the error. adjustErrBad :: Parser s t a -> (String->String) -> Parser s t a -- p `adjustErrBad` f = commit (p `adjustErr` f) (P p) `adjustErrBad` f = P (\s ts-> case p s ts of (Left msg, s', ts') -> (throwE (f msg), s, ts') right -> right ) infixl 6 `onFail` -- not sure about precedence 6? -- | @p `onFail` q@ means parse p unless p fails in which case parse q instead. -- Can be chained together to give multiple attempts to parse something. -- (Note that q could itself be a failing parser, e.g. to change the error -- message from that defined in p to something different.) -- However, a *severe* failure in p cannot be ignored. onFail :: Parser s t a -> Parser s t a -> Parser s t a (P p) `onFail` (P q) = P (\s ts-> case p s ts of (Left _, _, _) -> q s ts right -> right ) -- | Parse the first alternative in the list that succeeds. oneOf :: [Parser s t a] -> Parser s t a oneOf [] = fail ("Failed to parse any of the possible choices") oneOf (p:ps) = p `onFail` oneOf ps -- | Parse the first alternative that succeeds, but if none succeed, -- report only the severe errors, and if none of those, then report -- all the soft errors. oneOf' :: [(String, Parser s t a)] -> Parser s t a oneOf' ps = accum [] ps where accum errs [] = case errs of [] -> failBad ("internal failure in parser (oneOf'):\n" ++indent 2 (show (map fst ps))) [(_,e)] -> fail e es -> fail ("one of the following failures occurred:\n" ++indent 2 (concatMap showErr (reverse es))) accum errs ((e,P p):ps) = P (\u ts-> case p u ts of (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps in p u ts right -> right ) showErr (name,err) = name++":\n"++indent 2 err -- | Helper for formatting error messages: indents all lines by a fixed amount. indent :: Int -> String -> String indent n = unlines . map (replicate n ' ' ++) . lines -- | 'optional' indicates whether the parser succeeded through the Maybe type. optional :: Parser s t a -> Parser s t (Maybe a) optional p = fmap Just p `onFail` return Nothing -- | 'many p' parses a list of elements with individual parser p. -- Cannot fail, since an empty list is a valid return value. many :: Parser s t a -> Parser s t [a] many p = many1 p `onFail` return [] -- | Parse a non-empty list of items. many1 :: Parser s t a -> Parser s t [a] many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2) ; xs <- many p ; return (x:xs) } -- `adjustErr` ("When looking for a non-empty sequence:\n"++) -- | Parse a list of items separated by discarded junk. sepBy :: Parser s t a -> Parser s t sep -> Parser s t [a] sepBy p sep = do sepBy1 p sep `onFail` return [] -- | Parse a non-empty list of items separated by discarded junk. sepBy1 :: Parser s t a -> Parser s t sep -> Parser s t [a] sepBy1 p sep = do { x <- p ; xs <- many (do {sep; p}) ; return (x:xs) } `adjustErr` ("When looking for a non-empty sequence with separators:\n"++) -- | Parse a list of items, discarding the start, end, and separator -- items. bracketSep :: Parser s t bra -> Parser s t sep -> Parser s t ket -> Parser s t a -> Parser s t [a] bracketSep open sep close p = do { open; close; return [] } `onFail` do { open `adjustErr` ("Missing opening bracket:\n"++) ; x <- p `adjustErr` ("After first bracket in a group:\n"++) ; xs <- many (do {sep; p}) ; close `adjustErrBad` ("When looking for closing bracket:\n"++) ; return (x:xs) } -- | Parse a bracketed item, discarding the brackets. bracket :: Parser s t bra -> Parser s t ket -> Parser s t a -> Parser s t a bracket open close p = do do { open `adjustErr` ("Missing opening bracket:\n"++) ; x <- p ; close `adjustErrBad` ("Missing closing bracket:\n"++) ; return x } -- | 'manyFinally e t' parses a possibly-empty sequence of e's, -- terminated by a t. Any parse failures could be due either to -- a badly-formed terminator or a badly-formed element, so raise -- both possible errors. manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a] manyFinally pp@(P p) pt@(P t) = P (\s ts -> case p s ts of (Left e, _, _) -> case t s ts of (Right _, s', ts') -> (Right [], s', ts') (Left e, s', ts') -> (Left e, s', ts') (Right x, s', ts') -> let (tail,s'',ts'') = runParser (manyFinally pp pt) s' ts' in (Right (x:tail), s'', ts'') ) ------------------------------------------------------------------------ -- State handling -- | Update the internal state. stUpdate :: (s->s) -> Parser s t () stUpdate f = P (\s ts-> (Right (), f s, ts)) -- | Query the internal state. stQuery :: (s->a) -> Parser s t a stQuery f = P (\s ts-> (Right (f s), s, ts)) -- | Deliver the entire internal state. stGet :: Parser s t s stGet = P (\s ts-> (Right s, s, ts)) ------------------------------------------------------------------------ -- | Push some tokens back onto the front of the input stream and reparse. -- This is useful e.g. for recursively expanding macros. When the -- user-parser recognises a macro use, it can lookup the macro -- expansion from the parse state, lex it, and then stuff the -- lexed expansion back down into the parser. reparse :: [t] -> Parser s t () reparse ts = P (\s inp-> (Right (), s, ts++inp)) ------------------------------------------------------------------------ hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/0000755006511100651110000000000010504340456017726 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/0000755006511100651110000000000010504340466020740 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/DtdToHaskell/0000755006511100651110000000000010504340466023262 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/DtdToHaskell/Instance.hs0000644006511100651110000003733510504340456025374 0ustar rossrossmodule Text.XML.HaXml.DtdToHaskell.Instance ( mkInstance ) where import List (intersperse) import Text.XML.HaXml.DtdToHaskell.TypeDef import Text.PrettyPrint.HughesPJ -- | Convert typedef to appropriate instance declaration, either @XmlContent@, -- @XmlAttributes@, or @XmlAttrType@. mkInstance :: TypeDef -> Doc -- no constructors - represents an element with empty content but attributes. mkInstance (DataDef aux n fs []) = let (frpat, frattr, topat, toattr) = attrpats fs frretval = if null fs then ppHName n else frattr topatval = if null fs then ppHName n else topat in text "instance HTypeable" <+> ppHName n <+> text "where" $$ nest 4 ( text "toHType x = Defined \"" <> ppXName n <> text "\" [] []" ) $$ text "instance XmlContent" <+> ppHName n <+> text "where" $$ nest 4 ( text "toContents" <+> topatval <+> text "=" $$ nest 4 (text "[CElem (Elem \"" <> ppXName n <> text "\"" <+> toattr <+> text "[]) ()]") $$ text "parseContents = do" $$ nest 4 (text "{ (Elem _ as []) <- element [\"" <> ppXName n <> text "\"]" $$ text "; return" <+> frretval $$ text "} `adjustErr` (\"in <" <> ppXName n <> text ">, \"++)" ) ) $$ mkInstanceAttrs Same n fs -- single constructor, "real" (non-auxiliary) type mkInstance (DataDef False n fs [(n0,sts)]) = let vs = nameSupply sts (frpat, frattr, topat, toattr) = attrpats fs in text "instance HTypeable" <+> ppHName n <+> text "where" $$ nest 4 ( text "toHType x = Defined \"" <> ppXName n <> text "\" [] []" ) $$ text "instance XmlContent" <+> ppHName n <+> text "where" $$ nest 4 ( text "toContents" <+> parens (mkCpat n0 topat vs) <+> text "=" $$ nest 4 (text "[CElem (Elem \"" <> ppXName n <> text "\"" <+> toattr <+> parens (mkToElem sts vs) <> text ") ()]") $$ text "parseContents = do" $$ nest 4 (text "{ e@(Elem _"<+> frpat <+> text "_) <- element [\"" <> ppXName n <> text "\"]" $$ text "; interior e $" <+> (mkParseConstr frattr (n0,sts)) $$ text "} `adjustErr` (\"in <" <> ppXName n <> text ">, \"++)") ) $$ mkInstanceAttrs Extended n fs -- single constructor, auxiliary type (i.e. no corresponding element tag) -- cannot be attributes here? mkInstance (DataDef True n [] [(n0,sts)]) = let vs = nameSupply sts in text "instance HTypeable" <+> ppHName n <+> text "where" $$ nest 4 ( text "toHType x = Defined \"" <> ppXName n <> text "\" [] []" ) $$ text "instance XmlContent" <+> ppHName n <+> text "where" $$ nest 4 ( text "toContents" <+> parens (mkCpat n0 empty vs) <+> text "=" $$ nest 4 (parens (mkToElem sts vs)) $$ text "parseContents =" <+> mkParseConstr empty (n0,sts) ) -- multiple constructors (real) mkInstance (DataDef False n fs cs) = let vs = nameSupply cs (frpat, frattr, topat, toattr) = attrpats fs mixattrs = if null fs then False else True in text "instance HTypeable" <+> ppHName n <+> text "where" $$ nest 4 ( text "toHType x = Defined \"" <> ppXName n <> text "\" [] []" ) $$ text "instance XmlContent" <+> ppHName n <+> text "where" $$ nest 4 ( vcat (map (mkToMult n topat toattr) cs) $$ text "parseContents = do " $$ nest 4 (text "{ e@(Elem _"<+> frpat <+> text "_) <- element [\"" <> ppXName n <> text "\"]" $$ text "; interior e $ oneOf" $$ nest 4 ( text "[" <+> mkParseConstr frattr (head cs) $$ vcat (map (\c-> text "," <+> mkParseConstr frattr c) (tail cs)) $$ text "] `adjustErr` (\"in <" <> ppXName n <> text ">, \"++)" ) $$ text "}" ) ) $$ mkInstanceAttrs Extended n fs -- multiple constructors (auxiliary) mkInstance (DataDef True n fs cs) = let vs = nameSupply cs (frpat, frattr, topat, toattr) = attrpats fs mixattrs = if null fs then False else True in text "instance HTypeable" <+> ppHName n <+> text "where" $$ nest 4 ( text "toHType x = Defined \"" <> ppXName n <> text "\" [] []" ) $$ text "instance XmlContent" <+> ppHName n <+> text "where" $$ nest 4 ( vcat (map (mkToAux mixattrs) cs) $$ text "parseContents = oneOf" $$ nest 4 ( text "[" <+> mkParseConstr frattr (head cs) $$ vcat (map (\c-> text "," <+> mkParseConstr frattr c) (tail cs)) $$ text "] `adjustErr` (\"in <" <> ppXName n <> text ">, \"++)" ) ) $$ mkInstanceAttrs Extended n fs -- enumeration of attribute values mkInstance (EnumDef n es) = text "instance XmlAttrType" <+> ppHName n <+> text "where" $$ nest 4 ( text "fromAttrToTyp n (n',v)" $$ nest 4 (text "| n==n' = translate (attr2str v)" $$ text "| otherwise = Nothing") $$ nest 2 (text "where" <+> mkTranslate es) $$ vcat (map mkToAttr es) ) data SameName = Same | Extended mkInstanceAttrs :: SameName -> Name -> AttrFields -> Doc mkInstanceAttrs s n [] = empty mkInstanceAttrs s n fs = let ppName = case s of { Same-> ppHName; Extended-> ppAName; } in text "instance XmlAttributes" <+> ppName n <+> text "where" $$ nest 4 ( text "fromAttrs as =" $$ nest 4 ( ppName n $$ nest 2 (vcat ((text "{" <+> mkFrFld n (head fs)): map (\x-> comma <+> mkFrFld n x) (tail fs)) $$ text "}")) $$ text "toAttrs v = catMaybes " $$ nest 4 (vcat ((text "[" <+> mkToFld (head fs)): map (\x-> comma <+> mkToFld x) (tail fs)) $$ text "]") ) -- respectively (frpat,frattr,topat,toattr) attrpats :: AttrFields -> (Doc,Doc,Doc,Doc) attrpats fs = if null fs then (text "[]", empty, empty, text "[]") else (text "as", parens (text "fromAttrs as"), text "as", parens (text "toAttrs as")) mkFrElem :: Name -> [StructType] -> [Doc] -> Doc -> Doc mkFrElem n sts vs inner = foldr (frElem n) inner (zip3 sts vs cvs) where cvs = let ns = nameSupply2 vs in zip ns (text "c0": init ns) frElem n (st,v,(cvi,cvo)) inner = parens (text "\\" <> parens (v<>comma<>cvi) <> text "->" $$ nest 2 inner) $$ parens ( case st of (Maybe String) -> text "fromText" <+> cvo (Maybe s) -> text "fromElem" <+> cvo (List String) -> text "many fromText" <+> cvo (List s) -> text "many fromElem" <+> cvo (List1 s) -> text "definite fromElem" <+> text "\"" <> text (show s)<> text "+\"" <+> text "\"" <> ppXName n <> text "\"" <+> cvo (Tuple ss) -> text "definite fromElem" <+> text "\"(" <> hcat (intersperse (text ",") (map (text.show) ss)) <> text ")\"" <+> text "\"" <> ppXName n <> text "\"" <+> cvo (OneOf ss) -> text "definite fromElem" <+> text "\"OneOf\"" <+> text "\"" <> ppXName n <> text "\"" <+> cvo (String) -> text "definite fromText" <+> text "\"text\" \"" <> ppXName n <> text "\"" <+> cvo (Any) -> text "definite fromElem" <+> text "\"ANY\" \"" <> ppXName n <> text "\"" <+> cvo (Defined m) -> text "definite fromElem" <+> text "\"<" <> ppXName m <> text ">\" \"" <> ppXName n <> text "\"" <+> cvo (Defaultable _ _) -> text "nyi_fromElem_Defaultable" <+> cvo ) -- {- mkParseContents :: Name -> [StructType] -> [Doc] -> Doc -> Doc mkParseContents n sts vs inner = foldr (frElem n) inner (zip3 sts vs cvs) where cvs = let ns = nameSupply2 vs in zip ns (text "c0": init ns) frElem n (st,v,(cvi,cvo)) inner = parens (text "\\" <> parens (v<>comma<>cvi) <> text "->" $$ nest 2 inner) $$ parens ( ) -} mkParseConstr frattr (c,sts) = fsep (text "return" <+> parens (ppHName c <+> frattr) : map mkParseContents sts) mkParseContents st = let ap = text "`apply`" in case st of (Maybe String) -> ap <+> text "optional text" (Maybe s) -> ap <+> text "optional parseContents" (List String) -> ap <+> text "many text" (List s) -> ap <+> text "many parseContents" (List1 s) -> ap <+> text "parseContents" (Tuple ss) -> ap <+> text "parseContents" (OneOf ss) -> ap <+> text "parseContents" (String) -> ap <+> text "(text `onFail` return \"\")" (Any) -> ap <+> text "parseContents" (Defined m) -> ap <+> text "parseContents" (Defaultable _ _) -> ap <+> text "nyi_fromElem_Defaultable" -- mkToElem :: [StructType] -> [Doc] -> Doc mkToElem [] [] = text "[]" mkToElem sts vs = fsep (intersperse (text "++") (zipWith toElem sts vs)) where toElem st v = case st of (Maybe String) -> text "maybe [] toText" <+> v (Maybe s) -> text "maybe [] toContents" <+> v (List String) -> text "concatMap toText" <+> v (List s) -> text "concatMap toContents" <+> v (List1 s) -> text "toContents" <+> v (Tuple ss) -> text "toContents" <+> v (OneOf ss) -> text "toContents" <+> v (String) -> text "toText" <+> v (Any) -> text "toContents" <+> v (Defined m) -> text "toContents" <+> v (Defaultable _ _) -> text "nyi_toElem_Defaultable" <+> v mkRpat :: [Doc] -> Doc mkRpat [v] = v mkRpat vs = (parens . hcat . intersperse comma) vs mkCpat :: Name -> Doc -> [Doc] -> Doc mkCpat n i vs = ppHName n <+> i <+> fsep vs nameSupply,nameSupply2 :: [b] -> [Doc] nameSupply ss = take (length ss) (map char ['a'..]) nameSupply2 ss = take (length ss) [ text ('c':v:[]) | v <- ['a'..]] mkTranslate :: [Name] -> Doc mkTranslate es = vcat (map trans es) $$ text "translate _ = Nothing" where trans n = text "translate \"" <> ppXName n <> text "\" =" <+> text "Just" <+> ppHName n mkToAttr n = text "toAttrFrTyp n" <+> ppHName n <+> text "=" <+> text "Just (n, str2attr" <+> doubleQuotes (ppXName n) <> text ")" mkFrFld :: Name -> (Name,StructType) -> Doc mkFrFld tag (n,st) = ppHName n <+> text "=" <+> ( case st of (Defaultable String s) -> text "defaultA fromAttrToStr" <+> doubleQuotes (text s) (Defaultable _ s) -> text "defaultA fromAttrToTyp" <+> text s (Maybe String) -> text "possibleA fromAttrToStr" (Maybe _) -> text "possibleA fromAttrToTyp" String -> text "definiteA fromAttrToStr" <+> doubleQuotes (ppXName tag) _ -> text "definiteA fromAttrToTyp" <+> doubleQuotes (ppXName tag) ) <+> doubleQuotes (ppXName n) <+> text "as" mkToFld :: (Name,StructType) -> Doc mkToFld (n,st) = ( case st of (Defaultable String _) -> text "defaultToAttr toAttrFrStr" (Defaultable _ _) -> text "defaultToAttr toAttrFrTyp" (Maybe String) -> text "maybeToAttr toAttrFrStr" (Maybe _) -> text "maybeToAttr toAttrFrTyp" String -> text "toAttrFrStr" _ -> text "toAttrFrTyp" ) <+> doubleQuotes (ppXName n) <+> parens (ppHName n <+> text "v") mkFrAux :: Bool -> Doc -> [(Name,[StructType])] -> Doc mkFrAux keeprest attrs cs = foldr frAux inner cs where inner = text "(Nothing, c0)" rest = if keeprest then text "rest" else text "_" frAux (n,sts) inner = let vs = nameSupply sts in nest 4 (text "case" <+> blah sts vs <+> text "of" $$ succpat sts vs <+> text "-> (Just" <+> parens (mkCpat n attrs vs) <> text ", rest)" $$ failpat sts <+> text "->" $$ nest 4 inner ) blah [st] [v] = blahblahblah st (text "c0") blah sts vs = let ns = nameSupply2 vs cvs = zip ns (text "c0": init ns) blahblah (st,v,(cvi,cvo)) inner = parens (text "\\" <> parens (v<>comma<>cvi) <> text "->" $$ nest 2 inner) $$ blahblahblah st cvo in foldr blahblah (mkRpat (vs++[last ns])) (zip3 sts vs cvs) blahblahblah st cvo = parens ( case st of (Maybe String) -> text "fromText" <+> cvo (Maybe s) -> text "fromElem" <+> cvo (List String) -> text "many fromText" <+> cvo (List s) -> text "many fromElem" <+> cvo (List1 s) -> text "fromElem" <+> cvo (Tuple ss) -> text "fromElem" <+> cvo -- ?? (OneOf ss) -> text "fromElem" <+> cvo (String) -> text "fromText" <+> cvo (Any) -> text "fromElem" <+> cvo (Defined m) -> text "fromElem" <+> cvo ) failpat sts = let fp st = case st of (Maybe s) -> text "Nothing" (List s) -> text "[]" (List1 s) -> text "_" (Tuple ss) -> text "_" (OneOf ss) -> text "_" (String) -> text "_" (Any) -> text "_" (Defined m) -> text "_" in parens (hcat (intersperse comma (map fp sts++[text "_"]))) succpat sts vs = let sp st v = case st of (Maybe s) -> v (List s) -> v (List1 s) -> text "Just" <+> v (Tuple ss) -> text "Just" <+> v (OneOf ss) -> text "Just" <+> v (String) -> text "Just" <+> v (Any) -> text "Just" <+> v (Defined m) -> text "Just" <+> v in parens (hcat (intersperse comma (zipWith sp sts vs++[rest]))) mkToAux :: Bool -> (Name,[StructType]) -> Doc mkToAux mixattrs (n,sts) = let vs = nameSupply sts attrs = if mixattrs then text "as" else empty in text "toContents" <+> parens (mkCpat n attrs vs) <+> text "=" <+> mkToElem sts vs mkToMult :: Name -> Doc -> Doc -> (Name,[StructType]) -> Doc mkToMult tag attrpat attrexp (n,sts) = let vs = nameSupply sts in text "toContents" <+> parens (mkCpat n attrpat vs) <+> text "=" $$ nest 4 (text "[CElem (Elem \"" <> ppXName tag <> text "\""<+> attrexp <+> parens (mkToElem sts vs) <+> text ") ()]") hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/DtdToHaskell/Convert.hs0000644006511100651110000001177610504340457025252 0ustar rossross-- | This module performs the translation of a parsed XML DTD into the -- internal representation of corresponding Haskell data\/newtypes. module Text.XML.HaXml.DtdToHaskell.Convert ( dtd2TypeDef ) where import List (intersperse) import Text.XML.HaXml.Types hiding (Name) import Text.XML.HaXml.DtdToHaskell.TypeDef ---- Internal representation for database of DTD decls ---- data Record = R [AttDef] ContentSpec type Db = [(String,Record)] ---- Build a database of DTD decls then convert them to typedefs ---- ---- (Done in two steps because we need to merge ELEMENT and ATTLIST decls.) ---- Apparently multiple ATTLIST decls for the same element are permitted, ---- although only one ELEMENT decl for it is allowed. dtd2TypeDef :: [MarkupDecl] -> [TypeDef] dtd2TypeDef mds = (concatMap convert . reverse . database []) mds where database db [] = db database db (m:ms) = case m of (Element (ElementDecl n cs)) -> case lookup n db of Nothing -> database ((n, R [] cs):db) ms (Just (R as _)) -> database (replace n (R as cs) db) ms (AttList (AttListDecl n as)) -> case lookup n db of Nothing -> database ((n, R as EMPTY):db) ms (Just (R a cs)) -> database (replace n (R (a++as) cs) db) ms -- (MarkupPE _ m') -> database db (m':ms) _ -> database db ms replace n v [] = error "dtd2TypeDef.replace: no element to replace" replace n v (x@(n0,_):db) | n==n0 = (n,v): db | otherwise = x: replace n v db ---- Convert DTD record to typedef ---- convert :: (String, Record) -> [TypeDef] convert (n, R as cs) = case cs of EMPTY -> modifier None [] ANY -> modifier None [[Any]] --error "NYI: contentspec of ANY" (Mixed PCDATA) -> modifier None [[String]] (Mixed (PCDATAplus ns)) -> modifier Star ([String]: map ((:[]) . Defined . name) ns) (ContentSpec cp) -> case cp of (TagName n' m) -> modifier m [[Defined (name n')]] (Choice cps m) -> modifier m (map ((:[]).inner) cps) (Seq cps m) -> modifier m [map inner cps] ++ concatMap (mkAttrDef n) as where attrs :: AttrFields attrs = map (mkAttrField n) as modifier None sts = mkData sts attrs False (name n) modifier m [[st]] = mkData [[modf m st]] attrs False (name n) modifier m sts = mkData [[modf m (Defined (name_ n))]] attrs False (name n) ++ mkData sts [] True (name_ n) inner :: CP -> StructType inner (TagName n' m) = modf m (Defined (name n')) inner (Choice cps m) = modf m (OneOf (map inner cps)) inner (Seq cps None) = Tuple (map inner cps) inner (Seq cps m) = modf m (Tuple (map inner cps)) modf None x = x modf Query x = Maybe x modf Star x = List x modf Plus x = List1 x mkData :: [[StructType]] -> AttrFields -> Bool -> Name -> [TypeDef] mkData [] fs aux n = [DataDef aux n fs []] mkData [ts] fs aux n = [DataDef aux n fs [(n, ts)]] mkData tss fs aux n = [DataDef aux n fs (map (mkConstr n) tss)] where mkConstr n ts = (mkConsName n ts, ts) mkConsName (Name x n) sts = Name x (n++concat (intersperse "_" (map flatten sts))) flatten (Maybe st) = {-"Maybe_" ++ -} flatten st flatten (List st) = {-"List_" ++ -} flatten st flatten (List1 st) = {-"List1_" ++ -} flatten st flatten (Tuple sts) = {-"Tuple" ++ show (length sts) ++ "_" ++ -} concat (intersperse "_" (map flatten sts)) flatten String = "Str" flatten (OneOf sts) = {-"OneOf" ++ show (length sts) ++ "_" ++ -} concat (intersperse "_" (map flatten sts)) flatten Any = "Any" flatten (Defined (Name _ n)) = n mkAttrDef e (AttDef n StringType def) = [] mkAttrDef e (AttDef n (TokenizedType t) def) = [] -- mkData [[String]] [] False (name n) mkAttrDef e (AttDef n (EnumeratedType (NotationType nt)) def) = [EnumDef (name_a e n) (map (name_ac e n) nt)] mkAttrDef e (AttDef n (EnumeratedType (Enumeration es)) def) = [EnumDef (name_a e n) (map (name_ac e n) es)] -- Default attribute values not handled here mkAttrField :: String -> AttDef -> (Name,StructType) mkAttrField e (AttDef n typ req) = (name_f e n, mkType typ req) where mkType StringType REQUIRED = String mkType StringType IMPLIED = Maybe String mkType StringType (DefaultTo (AttValue [Left s]) f) = Defaultable String s mkType (TokenizedType _) REQUIRED = String mkType (TokenizedType _) IMPLIED = Maybe String mkType (TokenizedType _) (DefaultTo (AttValue [Left s]) f) = Defaultable String s mkType (EnumeratedType _) REQUIRED = Defined (name_a e n) mkType (EnumeratedType _) IMPLIED = Maybe (Defined (name_a e n)) mkType (EnumeratedType _) (DefaultTo (AttValue [Left s]) f) = Defaultable (Defined (name_a e n)) (hName (name_ac e n s)) hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/DtdToHaskell/TypeDef.hs0000644006511100651110000002044010504340466025156 0ustar rossross-- | Defines an internal representation of Haskell data\/newtype definitions -- that correspond to the XML DTD types, and provides pretty-printers to -- convert these types into the 'Doc' type of "Text.PrettyPrint.HughesPJ". module Text.XML.HaXml.DtdToHaskell.TypeDef ( -- * Internal representation of types TypeDef(..) , Constructors , AttrFields , StructType(..) -- * Pretty-print a TypeDef , ppTypeDef , ppHName , ppXName , ppAName -- * Name mangling , Name(..) , name, name_, name_a, name_ac, name_f, mangle, manglef ) where import Char (isLower, isUpper, toLower, toUpper, isDigit) import List (intersperse) import Text.PrettyPrint.HughesPJ ---- Internal representation for typedefs ---- -- | Need to keep both the XML and Haskell versions of a name. data Name = Name { xName :: String -- ^ original XML name , hName :: String -- ^ mangled Haskell name } deriving Eq data TypeDef = DataDef Bool Name AttrFields Constructors -- ^ Bool for main\/aux. | EnumDef Name [Name] deriving Eq type Constructors = [(Name,[StructType])] type AttrFields = [(Name, StructType)] data StructType = Maybe StructType | Defaultable StructType String -- ^ String holds default value. | List StructType | List1 StructType -- ^ Non-empty lists. | Tuple [StructType] | OneOf [StructType] | Any -- ^ XML's contentspec allows ANY | String | Defined Name deriving Eq -- used for converting StructType (roughly) back to an XML content model instance Show StructType where showsPrec p (Maybe s) = showsPrec (p+1) s . showChar '?' showsPrec p (Defaultable s _) = shows s showsPrec p (List s) = showsPrec (p+1) s . showChar '*' showsPrec p (List1 s) = showsPrec (p+1) s . showChar '+' showsPrec p (Tuple ss) = showChar '(' . foldr1 (.) (intersperse (showChar ',') (map shows ss)) . showChar ')' showsPrec p (OneOf ss) = showChar '(' . foldr1 (.) (intersperse (showChar '|') (map shows ss)) . showChar ')' showsPrec p (Any) = showString "ANY" showsPrec p (String) = showString "#PCDATA" showsPrec p (Defined (Name n _)) = showString n ---- Pretty-printing typedefs ---- ppTypeDef :: TypeDef -> Doc -- no attrs, no constructors ppTypeDef (DataDef _ n [] []) = let name = ppHName n in text "data" <+> name <+> text "=" <+> name <+> text "\t\t" <> derives -- no attrs, single constructor ppTypeDef (DataDef _ n [] [c@(_,[_])]) = text "newtype" <+> ppHName n <+> text "=" <+> ppC c <+> text "\t\t" <> derives -- no attrs, multiple constrs ppTypeDef (DataDef _ n [] cs) = text "data" <+> ppHName n <+> ( text "=" <+> ppC (head cs) $$ vcat (map (\c-> text "|" <+> ppC c) (tail cs)) $$ derives ) -- nonzero attrs, no constructors ppTypeDef (DataDef _ n fs []) = let name = ppHName n in text "data" <+> name <+> text "=" <+> name $$ nest 4 ( text "{" <+> ppF (head fs) $$ vcat (map (\f-> text "," <+> ppF f) (tail fs)) $$ text "}" <+> derives ) -- nonzero attrs, one or more constrs ppTypeDef (DataDef _ n fs cs) = let attr = ppAName n in text "data" <+> ppHName n <+> ( text "=" <+> ppAC attr (head cs) $$ vcat (map (\c-> text "|" <+> ppAC attr c) (tail cs)) $$ derives ) $$ text "data" <+> attr <+> text "=" <+> attr $$ nest 4 ( text "{" <+> ppF (head fs) $$ vcat (map (\f-> text "," <+> ppF f) (tail fs)) $$ text "}" <+> derives ) -- enumerations (of attribute values) ppTypeDef (EnumDef n es) = text "data" <+> ppHName n <+> ( text "=" <+> fsep (intersperse (text " | ") (map ppHName es)) $$ derives ) ppST :: StructType -> Doc ppST (Defaultable st _) = parens (text "Defaultable" <+> ppST st) ppST (Maybe st) = parens (text "Maybe" <+> ppST st) ppST (List st) = text "[" <> ppST st <> text "]" ppST (List1 st) = parens (text "List1" <+> ppST st) ppST (Tuple sts) = parens (commaList (map ppST sts)) ppST (OneOf sts) = parens (text "OneOf" <> text (show (length sts)) <+> hsep (map ppST sts)) ppST String = text "String" ppST Any = text "ANYContent" ppST (Defined n) = ppHName n -- constructor and components ppC :: (Name,[StructType]) -> Doc ppC (n,sts) = ppHName n <+> fsep (map ppST sts) -- attribute (fieldname and type) ppF :: (Name,StructType) -> Doc ppF (n,st) = ppHName n <+> text "::" <+> ppST st -- constructor and components with initial attr-type ppAC :: Doc -> (Name,[StructType]) -> Doc ppAC atype (n,sts) = ppHName n <+> fsep (atype: map ppST sts) -- | Pretty print Haskell name. ppHName :: Name -> Doc ppHName (Name _ s) = text s -- | Pretty print XML name. ppXName :: Name -> Doc ppXName (Name s _) = text s -- | Pretty print Haskell attributes name. ppAName :: Name -> Doc ppAName (Name _ s) = text s <> text "_Attrs" derives = text "deriving" <+> parens (commaList (map text ["Eq","Show"])) ---- Some operations on Names ---- -- | Make a type name valid in both XML and Haskell. name :: String -> Name name n = Name { xName = n , hName = mangle n } -- | Append an underscore to the Haskell version of the name. name_ :: String -> Name name_ n = Name { xName = n , hName = mangle n ++ "_" } -- | Prefix an attribute enumeration type name with its containing element -- name. name_a :: String -> String -> Name name_a e n = Name { xName = n , hName = mangle e ++ "_" ++ map decolonify n } -- | Prefix an attribute enumeration constructor with its element-tag name, -- and its enumeration type name. name_ac :: String -> String -> String -> Name name_ac e t n = Name { xName = n , hName = mangle e ++ "_" ++ map decolonify t ++ "_" ++ map decolonify n } -- | Prefix a field name with its enclosing element name. name_f :: String -> String -> Name name_f e n = Name { xName = n , hName = manglef e ++ mangle n } ---- obsolete -- elementname_at :: String -> Name -- elementname_at n = Name n (mangle n ++ "_Attrs") -- | Convert an XML name to a Haskell conid. mangle :: String -> String mangle (n:ns) | isLower n = notPrelude (toUpper n: map decolonify ns) | isDigit n = 'I': n: map decolonify ns | otherwise = notPrelude (n: map decolonify ns) -- | Ensure a generated name does not conflict with a standard haskell one. notPrelude :: String -> String notPrelude "String" = "AString" notPrelude "Maybe" = "AMaybe" notPrelude "Either" = "AEither" notPrelude "Char" = "AChar" notPrelude "String" = "AString" notPrelude "Int" = "AInt" notPrelude "Integer" = "AInteger" notPrelude "Float" = "AFloat" notPrelude "Double" = "ADouble" notPrelude "List1" = "AList1" -- part of HaXml notPrelude "IO" = "AIO" notPrelude "IOError" = "AIOError" notPrelude "FilePath"= "AFilePath" notPrelude "Bool" = "ABool" notPrelude "Ordering"= "AOrdering" notPrelude "Eq" = "AEq" notPrelude "Ord" = "AOrd" notPrelude "Enum" = "AEnum" notPrelude "Bounded" = "ABounded" notPrelude "Functor" = "AFunctor" notPrelude "Monad" = "AMonad" notPrelude "Rational"= "ARational" notPrelude "Integral"= "AIntegral" notPrelude "Num" = "ANum" notPrelude "Real" = "AReal" notPrelude "RealFrac"= "ARealFrac" notPrelude "Floating"= "AFloating" notPrelude "RealFloat" = "ARealFloat" notPrelude "Fractional"= "AFractional" notPrelude "Read" = "ARead" notPrelude "Show" = "AShow" notPrelude "ReadS" = "AReadS" notPrelude "ShowS" = "AShowS" notPrelude n = n -- | Convert an XML name to a Haskell varid. manglef :: String -> String manglef (n:ns) | isUpper n = toLower n: map decolonify ns | isDigit n = '_': n: map decolonify ns | otherwise = n: map decolonify ns -- | Convert colon to prime, hyphen to underscore. decolonify :: Char -> Char decolonify ':' = '\'' -- TODO: turn namespaces into qualified identifiers decolonify '-' = '_' decolonify '.' = '_' decolonify c = c commaList = hcat . intersperse comma hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Combinators.hs0000644006511100651110000003263110504340456023560 0ustar rossross-------------------------------------------- -- | This module defines the notion of filters and filter combinators -- for processing XML documents. -- -- These XML transformation combinators are described in the paper -- ``Haskell and XML: Generic Combinators or Type-Based Translation?'' -- Malcolm Wallace and Colin Runciman, Proceedings ICFP'99. -------------------------------------------- module Text.XML.HaXml.Combinators (-- * The content filter type. CFilter -- * Simple filters. -- ** Selection filters. -- $selection , keep, none, children, position -- ** Predicate filters. -- $pred , elm, txt, tag, attr, attrval, tagWith -- ** Search filters. , find, iffind, ifTxt -- * Filter combinators -- ** Basic combinators. , o, union, cat, andThen , (|>|), with, without , (/>), () -- * Filters with labelled results. , LabelFilter -- ** Using and combining labelled filters. , oo, x -- ** Some label-generating filters. , numbered, interspersed, tagged, attributed, textlabelled, extracted ) where import Text.XML.HaXml.Types import Maybe (fromMaybe) infixl 6 `with`, `without` infixr 5 `o`, `oo`, `union`, `andThen` -- , `orelse` infixl 5 />, | infixr 4 `when`, `guards` infixr 3 ?>, :> -- THE CONTENT FILTER TYPE -- | All document transformations are /content filters/. -- A filter takes a single XML 'Content' value and returns a sequence -- of 'Content' values, possibly empty. type CFilter i = Content i -> [Content i] -- BASIC SELECTION FILTERS -- $selection -- In the algebra of combinators, @none@ is the zero, and @keep@ the identity. -- (They have a more general type than just CFilter.) keep :: a->[a] keep = \x->[x] none :: a->[b] none = \x->[] -- | Throw away current node, keep just the (unprocessed) children. children :: CFilter i children (CElem (Elem _ _ cs) _) = cs children _ = [] -- | Select the @n@'th positional result of a filter. position :: Int -> CFilter i -> CFilter i position n f = (\cs-> [cs!!n]) . f -- BASIC PREDICATE FILTERS -- $pred -- These filters either keep or throw away some content based on -- a simple test. For instance, @elm@ keeps only a tagged element, -- @txt@ keeps only non-element text, @tag@ keeps only an element -- with the named tag, @attr@ keeps only an element with the named -- attribute, @attrval@ keeps only an element with the given -- attribute value, @tagWith@ keeps only an element whose tag name -- satisfies the given predicate. elm, txt :: CFilter i tag :: String -> CFilter i attr :: Name -> CFilter i attrval :: Attribute -> CFilter i tagWith :: (String->Bool) -> CFilter i elm x@(CElem _ _) = [x] elm _ = [] txt x@(CString _ _ _) = [x] txt x@(CRef _ _) = [x] txt _ = [] tag t x@(CElem (Elem n _ _) _) | t==n = [x] tag t _ = [] tagWith p x@(CElem (Elem n _ _) _) | p n = [x] tagWith p _ = [] attr n x@(CElem (Elem _ as _) _) | n `elem` (map fst as) = [x] attr n _ = [] attrval av x@(CElem (Elem _ as _) _) | av `elem` as = [x] attrval av _ = [] -- SEARCH FILTERS -- | For a mandatory attribute field, @find key cont@ looks up the value of -- the attribute name @key@, and applies the continuation @cont@ to -- the value. find :: String -> (String->CFilter i) -> CFilter i find key cont c@(CElem (Elem _ as _) _) = cont (value (lookfor key as)) c where lookfor x = fromMaybe (error ("missing attribute: "++show x)) . lookup x value (AttValue [Left x]) = x -- 'lookfor' has the more general type :: (Eq a,Show a) => a -> [(a,b)] -> b -- | When an attribute field may be absent, use @iffind key yes no@ to lookup -- its value. If the attribute is absent, it acts as the @no@ filter, -- otherwise it applies the @yes@ filter. iffind :: String -> (String->CFilter i) -> CFilter i -> CFilter i iffind key yes no c@(CElem (Elem _ as _) _) = case (lookup key as) of Nothing -> no c (Just (AttValue [Left s])) -> yes s c iffind key yes no other = no other -- | @ifTxt yes no@ processes any textual content with the @yes@ filter, -- but otherwise is the same as the @no@ filter. ifTxt :: (String->CFilter i) -> CFilter i -> CFilter i ifTxt yes no c@(CString _ s _) = yes s c ifTxt yes no c = no c -- C-LIKE CONDITIONALS -- -- $cond -- These definitions provide C-like conditionals, lifted to the filter level. -- -- The @(cond ? yes : no)@ style in C becomes @(cond ?> yes :> no)@ in Haskell. -- | Conjoin the two branches of a conditional. data ThenElse a = a :> a -- | Select between the two branches of a joined conditional. (?>) :: (a->[b]) -> ThenElse (a->[b]) -> (a->[b]) p ?> (f :> g) = \c-> if (not.null.p) c then f c else g c -- FILTER COMBINATORS -- | Sequential (/Irish/,/backwards/) composition o :: CFilter i -> CFilter i -> CFilter i f `o` g = concatMap f . g -- | Binary parallel composition. Each filter uses a copy of the input, -- rather than one filter using the result of the other. -- (Has a more general type than just CFilter.) union :: (a->[b]) -> (a->[b]) -> (a->[b]) union = lift (++) -- in Haskell 98: union = lift List.union where lift :: (a->b->d) -> (c->a) -> (c->b) -> c -> d lift f g h = \x-> f (g x) (h x) -- | Glue a list of filters together. (A list version of union; -- also has a more general type than just CFilter.) cat :: [a->[b]] -> (a->[b]) -- Specification: cat fs = \e-> concat [ f e | f <- fs ] -- more efficient implementation below: cat [] = const [] cat fs = foldr1 union fs -- | A special form of filter composition where the second filter -- works over the same data as the first, but also uses the -- first's result. andThen :: (a->c) -> (c->a->b) -> (a->b) andThen f g = \x-> g (f x) x -- lift g f id -- | Process children using specified filters. /not exported/ childrenBy :: CFilter i -> CFilter i childrenBy f = f `o` children -- | Directional choice: -- in @f |>| g@ give g-productions only if no f-productions (|>|) :: (a->[b]) -> (a->[b]) -> (a->[b]) f |>| g = \x-> let fx = f x in if null fx then g x else fx -- f |>| g = f ?> f :> g -- | Pruning: in @f `with` g@, -- keep only those f-productions which have at least one g-production with :: CFilter i -> CFilter i -> CFilter i f `with` g = filter (not.null.g) . f -- | Pruning: in @f `without` g@, -- keep only those f-productions which have no g-productions without :: CFilter i -> CFilter i -> CFilter i f `without` g = filter (null.g) . f -- | Pronounced /slash/, @f \/> g@ means g inside f (/>) :: CFilter i -> CFilter i -> CFilter i f /> g = g `o` children `o` f -- | Pronounced /outside/, @f \<\/ g@ means f containing g ( CFilter i -> CFilter i f CFilter i) -> CFilter i -> CFilter i et f g = (f `oo` tagged elm) |>| (g `o` txt) -- | Express a list of filters like an XPath query, e.g. -- @path [children, tag \"name1\", attr \"attr1\", children, tag \"name2\"]@ -- is like the XPath query @\/name1[\@attr1]\/name2@. path :: [CFilter i] -> CFilter i path fs = foldr (flip (o)) keep fs -- RECURSIVE SEARCH -- $recursive -- Recursive search has three variants: @deep@ does a breadth-first -- search of the tree, @deepest@ does a depth-first search, @multi@ returns -- content at all tree-levels, even those strictly contained within results -- that have already been returned. deep, deepest, multi :: CFilter i -> CFilter i deep f = f |>| (deep f `o` children) deepest f = (deepest f `o` children) |>| f multi f = f `union` (multi f `o` children) -- | Interior editing: -- @f `when` g@ applies @f@ only when the predicate @g@ succeeds, -- otherwise the content is unchanged. when :: CFilter i -> CFilter i -> CFilter i -- | Interior editing: -- @g `guards` f@ applies @f@ only when the predicate @g@ succeeds, -- otherwise the content is discarded. guards :: CFilter i -> CFilter i -> CFilter i f `when` g = g ?> f :> keep g `guards` f = g ?> f :> none -- = f `o` (keep `with` g) -- | Process CHildren In Place. The filter is applied to any children -- of an element content, and the element rebuilt around the results. chip :: CFilter i -> CFilter i chip f (CElem (Elem n as cs) i) = [ CElem (Elem n as (concatMap f cs)) i ] chip f c = [c] -- | Recursive application of filters: a fold-like operator. Defined -- as @f `o` chip (foldXml f)@. foldXml :: CFilter i -> CFilter i foldXml f = f `o` chip (foldXml f) -- CONSTRUCTIVE CONTENT FILTERS -- | Build an element with the given tag name - its content is the results -- of the given list of filters. mkElem :: String -> [CFilter i] -> CFilter i mkElem h cfs = \t-> [ CElem (Elem h [] (cat cfs t)) undefined ] -- | Build an element with the given name, attributes, and content. mkElemAttr :: String -> [(String,CFilter i)] -> [CFilter i] -> CFilter i mkElemAttr h as cfs = \t-> [ CElem (Elem h (map (attr t) as) (cat cfs t)) undefined ] where attr t (n,vf) = let v = concat [ s | (CString _ s _) <- (deep txt `o` vf) t ] in (n, AttValue [Left v]) -- | Build some textual content. literal :: String -> CFilter i literal s = const [CString False s undefined] -- | Build some CDATA content. cdata :: String -> CFilter i cdata s = const [CString True s undefined] -- | Rename an element tag (leaving attributes in place). replaceTag :: String -> CFilter i replaceTag n (CElem (Elem _ as cs) i) = [CElem (Elem n as cs) i] replaceTag n _ = [] -- | Replace the attributes of an element (leaving tag the same). replaceAttrs :: [(String,String)] -> CFilter i replaceAttrs as (CElem (Elem n _ cs) i) = [CElem (Elem n as' cs) i] where as' = map (\(n,v)-> (n, AttValue [Left v])) as replaceAttrs as _ = [] -- LABELLING -- | A LabelFilter is like a CFilter except that it pairs up a polymorphic -- value (label) with each of its results. type LabelFilter i a = Content i -> [(a,Content i)] -- | Compose a label-processing filter with a label-generating filter. oo :: (a->CFilter i) -> LabelFilter i a -> CFilter i f `oo` g = concatMap (uncurry f) . g {- -- | Process the information labels (very nearly monadic bind). oo :: (b -> CFilter b c) -> CFilter a b -> CFilter a c f `oo` g = concatMap info . g where info c@(CElem _ i) = f i c info c@(CString _ _ i) = f i c info c@(CRef _ i) = f i c info c = [c] -} -- | Combine labels. Think of this as a pair-wise zip on labels. -- e.g. @(numbered `x` tagged)@ x :: (CFilter i->LabelFilter i a) -> (CFilter i->LabelFilter i b) -> (CFilter i->LabelFilter i (a,b)) f `x` g = \cf c-> let gs = map fst (g cf c) fs = map fst (f cf c) in zip (zip fs gs) (cf c) -- Some basic label-generating filters. -- | Number the results from 1 upwards. numbered :: CFilter i -> LabelFilter i Int numbered f = zip [1..] . f -- | In @interspersed a f b@, label each result of @f@ with the string @a@, -- except for the last one which is labelled with the string @b@. interspersed :: String -> CFilter i -> String -> LabelFilter i String interspersed a f b = (\xs-> zip (replicate (len xs) a ++ [b]) xs) . f where len [] = 0 len xs = length xs - 1 -- | Label each element in the result with its tag name. Non-element -- results get an empty string label. tagged :: CFilter i -> LabelFilter i String tagged f = extracted name f where name (CElem (Elem n _ _) _) = n name _ = "" -- | Label each element in the result with the value of the named attribute. -- Elements without the attribute, and non-element results, get an -- empty string label. attributed :: String -> CFilter i -> LabelFilter i String attributed key f = extracted att f where att (CElem (Elem _ as _) _) = case (lookup key as) of Nothing -> "" (Just (AttValue [Left s])) -> s att _ = "" -- | Label each textual part of the result with its text. Element -- results get an empty string label. textlabelled :: CFilter i -> LabelFilter i (Maybe String) textlabelled f = extracted text f where text (CString _ s _) = Just s text _ = Nothing -- | Label each content with some information extracted from itself. extracted :: (Content i->a) -> CFilter i -> LabelFilter i a extracted proj f = concatMap (\c->[(proj c, c)]) . f {- -- MISC -- | I haven't yet remembered \/ worked out what this does. combine :: (Read a,Show a) => ([a]->a) -> LabelFilter String -> CFilter combine f lf = \c-> [ CString False (show (f [ read l | (l,_) <- lf c ])) ] -} {- OLD STUFF - OBSOLETE -- Keep an element by its numbered position (starting at 1). position :: Int -> [Content] -> [Content] position n | n>0 = (:[]) . (!!(n-1)) | otherwise = const [] -- Chop and remove the root portions of trees to depth n. layer :: Int -> [Content] -> [Content] layer n = apply n (concatMap lay) where lay (CElem (Elem _ _ cs)) = cs lay _ = [] apply 0 f xs = xs apply n f xs = apply (n-1) f (f xs) combine :: (Read a, Show a) => ([a]->a) -> [Content] -> [Content] combine f = \cs-> [ CString False (show (f [ read s | CString _ s <- cs ])) ] -} hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Html/0000755006511100651110000000000010504340466021644 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Html/Generate.hs0000644006511100651110000001257110504340456023737 0ustar rossross-- | These are just some common abbreviations for generating HTML -- content within the XML transformation framework defined -- by "Text.Xml.HaXml.Combinators". module Text.XML.HaXml.Html.Generate ( -- * HTML construction filters -- ** Containers html , hhead , htitle , hbody , h1, h2, h3, h4 , hpara , hdiv, hspan, margin -- ** Anchors , anchor, makehref, anchorname -- ** Text style , hpre , hcentre , hem, htt, hbold , parens, bullet -- ** Tables , htable, hrow, hcol -- ** Breaks, lines , hbr, hhr -- ** Attributes , showattr, (!), (?) -- * A simple HTML pretty-printer , htmlprint ) where import Char (isSpace) import List (partition) import Text.XML.HaXml.Types import Text.XML.HaXml.Combinators import qualified Text.PrettyPrint.HughesPJ as Pretty ---- Constructor functions html, hhead, htitle, hbody, h1, h2, h3, h4, hpara, hpre, hcentre, hem, htt, hbold, htable, hrow, hcol, hdiv, hspan, margin :: [CFilter i] -> CFilter i html = mkElem "html" hhead = mkElem "head" htitle = mkElem "title" hbody = mkElem "body" h1 = mkElem "h1" h2 = mkElem "h2" h3 = mkElem "h3" h4 = mkElem "h4" hpara = mkElem "p" hpre = mkElem "pre" hcentre = mkElem "center" hem = mkElem "em" htt = mkElem "tt" hbold = mkElem "b" htable = mkElem "table" hrow = mkElem "tr" hcol = mkElem "td" hdiv = mkElem "div" hspan = mkElem "span" margin = mkElemAttr "div" [("margin-left",("2em"!)), ("margin-top", ("1em"!))] anchor :: [(String, CFilter i)] -> [CFilter i] -> CFilter i anchor = mkElemAttr "a" makehref, anchorname :: CFilter i -> [CFilter i] -> CFilter i makehref r = anchor [ ("href",r) ] anchorname n = anchor [ ("name",n) ] hbr, hhr :: CFilter i hbr = mkElem "br" [] hhr = mkElem "hr" [] showattr, (!), (?) :: String -> CFilter i showattr n = find n literal (!) = literal (?) = showattr parens :: CFilter i -> CFilter i parens f = cat [ literal "(", f, literal ")" ] bullet :: [CFilter i] -> CFilter i bullet = cat . (literal "M-^U":) ---- Printing function -- htmlprint :: [Content] -> String -- htmlprint = concatMap cprint -- where -- cprint (CElem e _) = elem e -- cprint (CString _ s) = s -- cprint (CMisc m) = "" -- -- elem (Elem n as []) = "\n<"++n++attrs as++" />" -- elem (Elem n as cs) = "\n<"++n++attrs as++">"++htmlprint cs++"\n" -- -- attrs = concatMap attr -- attr (n,v) = " "++n++"='"++v++"'" htmlprint :: [Content i] -> Pretty.Doc htmlprint = Pretty.cat . map cprint . foldrefs where foldrefs [] = [] foldrefs (CString ws s1 i:CRef r _:CString _ s2 _:cs) = CString ws (s1++"&"++ref r++";"++s2) i: foldrefs cs foldrefs (c:cs) = c : foldrefs cs --ref (RefEntity (EntityRef n)) = n -- Actually, should look-up symtable. --ref (RefChar (CharRef s)) = s ref (RefEntity n) = n -- Actually, should look-up symtable. ref (RefChar s) = show s cprint (CElem e _) = elem e cprint (CString ws s _) = Pretty.cat (map Pretty.text (fmt 60 ((if ws then id else deSpace) s))) cprint (CRef r _) = Pretty.text ("&"++ref r++";") cprint (CMisc m _) = Pretty.empty elem (Elem n as []) = Pretty.text "<" Pretty.<> Pretty.text n Pretty.<> attrs as Pretty.<> Pretty.text " />" elem (Elem n as cs) = -- ( Pretty.text "<" Pretty.<> -- Pretty.text n Pretty.<> -- attrs as Pretty.<> -- Pretty.text ">") Pretty.$$ -- Pretty.nest 6 (htmlprint cs) Pretty.$$ -- ( Pretty.text " -- Pretty.text n Pretty.<> -- Pretty.text ">" ) Pretty.fcat [ ( Pretty.text "<" Pretty.<> Pretty.text n Pretty.<> attrs as Pretty.<> Pretty.text ">") , Pretty.nest 4 (htmlprint cs) , ( Pretty.text " Pretty.text n Pretty.<> Pretty.text ">" ) ] attrs = Pretty.cat . map attr attr (n,AttValue [Left v]) = Pretty.text " " Pretty.<> Pretty.text n Pretty.<> Pretty.text "='" Pretty.<> Pretty.text v Pretty.<> Pretty.text "'" fmt n [] = [] fmt n s = let (top,bot) = splitAt n s (word,left) = keepUntil isSpace (reverse top) in if length top < n then [s] else if not (null left) then reverse left: fmt n (word++bot) else let (big,rest) = keepUntil isSpace s in reverse big: fmt n rest deSpace [] = [] deSpace (c:cs) | c=='\n' = deSpace (' ':cs) | isSpace c = c : deSpace (dropWhile isSpace cs) | otherwise = c : deSpace cs keepUntil p xs = select p ([],xs) where select p (ls,[]) = (ls,[]) select p (ls,(x:xs)) | p x = (ls,x:xs) | otherwise = select p (x:ls,xs) hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Html/Parse.hs0000644006511100651110000005632510504340466023265 0ustar rossross-- | This is a parser for HTML documents. Unlike for XML documents, it -- must include a certain amount of error-correction to account for -- HTML features like self-terminating tags, unterminated tags, and -- incorrect nesting. The input is tokenised by the -- XML lexer (a separate lexer is not required for HTML). -- It uses a slightly extended version of the Hutton/Meijer parser -- combinators. module Text.XML.HaXml.Html.Parse ( htmlParse ) where import Prelude hiding (either,maybe,sequence) import qualified Prelude (either) import Maybe hiding (maybe) import Char (toLower, isSpace, isDigit, isHexDigit) import Numeric (readDec,readHex) import Monad import Text.XML.HaXml.Types import Text.XML.HaXml.Lex import Text.XML.HaXml.Posn import Text.ParserCombinators.Poly -- #define DEBUG #if defined(DEBUG) # if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \ ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__) import Debug.Trace(trace) # elif defined(__GLASGOW_HASKELL__) import IOExts(trace) # elif defined(__NHC__) || defined(__HBC__) import NonStdTrace # endif debug :: Monad m => String -> m () debug s = trace s (return ()) #else debug :: Monad m => String -> m () debug s = return () #endif -- | The first argument is the name of the file, the second is the string -- contents of the file. The result is the generic representation of -- an XML document. Any errors cause program failure with message to stderr. htmlParse :: String -> String -> Document Posn htmlParse name = Prelude.either error id . htmlParse' name -- | The first argument is the name of the file, the second is the string -- contents of the file. The result is the generic representation of -- an XML document. Any parsing errors are returned in the @Either@ type. htmlParse' :: String -> String -> Either String (Document Posn) htmlParse' name = Prelude.either Left (Right . simplify) . fst . runParser document . xmlLex name ---- Document simplification ---- simplify :: Document i -> Document i simplify (Document p st (Elem n avs cs) ms) = Document p st (Elem n avs (deepfilter simp cs)) ms where simp (CElem (Elem "null" [] []) _) = False simp (CElem (Elem n _ []) _) | n `elem` ["font","p","i","b","em" ,"tt","big","small"] = False -- simp (CString False s _) | all isSpace s = False simp _ = True deepfilter p = filter p . map (\c-> case c of CElem (Elem n avs cs) i -> CElem (Elem n avs (deepfilter p cs)) i _ -> c) -- opening any of these, they close again immediately selfclosingtags = ["img","hr","br","meta","col","link","base" ,"param","area","frame","input"] --closing this, implicitly closes any of those which are contained in it closeInnerTags = [ ("ul", ["li"]) , ("ol", ["li"]) , ("dl", ["dt","dd"]) , ("tr", ["th","td"]) , ("div", ["p"]) , ("thead", ["th","tr","td"]) , ("tfoot", ["th","tr","td"]) , ("tbody", ["th","tr","td"]) , ("table", ["th","tr","td","thead","tfoot","tbody"]) , ("caption", ["p"]) , ("th", ["p"]) , ("td", ["p"]) , ("li", ["p"]) , ("dt", ["p"]) , ("dd", ["p"]) , ("object", ["p"]) , ("map", ["p"]) , ("body", ["p"]) ] --opening this, implicitly closes that closes :: Name -> Name -> Bool "a" `closes` "a" = True "li" `closes` "li" = True "th" `closes` t | t `elem` ["th","td"] = True "td" `closes` t | t `elem` ["th","td"] = True "tr" `closes` t | t `elem` ["th","td","tr"] = True "dt" `closes` t | t `elem` ["dt","dd"] = True "dd" `closes` t | t `elem` ["dt","dd"] = True "form" `closes` "form" = True "label" `closes` "label" = True _ `closes` "option" = True "thead" `closes` t | t `elem` ["colgroup"] = True "tfoot" `closes` t | t `elem` ["thead","colgroup"] = True "tbody" `closes` t | t `elem` ["tbody","tfoot","thead","colgroup"] = True "colgroup" `closes` "colgroup" = True t `closes` "p" | t `elem` ["p","h1","h2","h3","h4","h5","h6" ,"hr","div","ul","dl","ol","table"] = True _ `closes` _ = False ---- Misc ---- fst3 (a,_,_) = a snd3 (_,a,_) = a thd3 (_,_,a) = a ---- Auxiliary Parsing Functions ---- type HParser a = Parser (Posn,TokenT) a tok :: TokenT -> HParser TokenT tok t = do (p,t') <- next case t' of TokError s -> report failBad (show t) p t' _ | t'==t -> return t | otherwise -> report fail (show t) p t' name :: HParser Name --name = do {(p,TokName s) <- next; return s} name = do (p,tok) <- next case tok of TokName s -> return s TokError s -> report failBad "a name" p tok _ -> report fail "a name" p tok string, freetext :: HParser String string = do (p,t) <- next case t of TokName s -> return s _ -> report fail "text" p t freetext = do (p,t) <- next case t of TokFreeText s -> return s _ -> report fail "text" p t maybe :: HParser a -> HParser (Maybe a) maybe p = ( p >>= return . Just) `onFail` ( return Nothing) either :: HParser a -> HParser b -> HParser (Either a b) either p q = ( p >>= return . Left) `onFail` ( q >>= return . Right) word :: String -> HParser () word s = do { x <- next ; case x of (p,TokName n) | s==n -> return () (p,TokFreeText n) | s==n -> return () (p,t@(TokError _)) -> report failBad (show s) p t (p,t) -> report fail (show s) p t } posn :: HParser Posn posn = do { x@(p,_) <- next ; reparse [x] ; return p } `onFail` return noPos nmtoken :: HParser NmToken nmtoken = (string `onFail` freetext) failP, failBadP :: String -> HParser a failP msg = do { p <- posn; fail (msg++"\n at "++show p) } failBadP msg = do { p <- posn; failBad (msg++"\n at "++show p) } report :: (String->HParser a) -> String -> Posn -> TokenT -> HParser a report fail exp p t = fail ("Expected "++show exp++" but found "++show t ++"\n at "++show p) adjustErrP :: HParser a -> (String->String) -> HParser a p `adjustErrP` f = p `onFail` do pn <- posn (p `adjustErr` f) `adjustErr` (++show pn) ---- XML Parsing Functions ---- document :: HParser (Document Posn) document = do p <- prolog `adjustErr` ("unrecognisable XML prolog\n"++) es <- many1 (element "HTML document") ms <- many misc return (Document p emptyST (case map snd es of [e] -> e es -> Elem "html" [] (map mkCElem es)) ms) where mkCElem e = CElem e noPos comment :: HParser Comment comment = do bracket (tok TokCommentOpen) (tok TokCommentClose) freetext processinginstruction :: HParser ProcessingInstruction processinginstruction = do tok TokPIOpen commit $ do n <- string `onFail` failP "processing instruction has no target" f <- freetext (tok TokPIClose `onFail` tok TokAnyClose) `onFail` failP "missing ?> or >" return (n, f) cdsect :: HParser CDSect cdsect = do tok TokSectionOpen bracket (tok (TokSection CDATAx)) (tok TokSectionClose) chardata prolog :: HParser Prolog prolog = do x <- maybe xmldecl m1 <- many misc dtd <- maybe doctypedecl m2 <- many misc return (Prolog x m1 dtd m2) xmldecl :: HParser XMLDecl xmldecl = do tok TokPIOpen (word "xml" `onFail` word "XML") p <- posn s <- freetext tok TokPIClose `onFail` failBadP "missing ?> in " (Prelude.either failP return . fst . runParser aux . xmlReLex p) s where aux = do v <- versioninfo `onFail` failP "missing XML version info" e <- maybe encodingdecl s <- maybe sddecl return (XMLDecl v e s) versioninfo :: HParser VersionInfo versioninfo = do (word "version" `onFail` word "VERSION") tok TokEqual bracket (tok TokQuote) (tok TokQuote) freetext misc :: HParser Misc misc = oneOf' [ ("", comment >>= return . Comment) , ("", processinginstruction >>= return . PI) ] -- Question: for HTML, should we disallow in-line DTDs, allowing only externals? -- Answer: I think so. doctypedecl :: HParser DocTypeDecl doctypedecl = do tok TokSpecialOpen tok (TokSpecial DOCTYPEx) commit $ do n <- name eid <- maybe externalid -- es <- maybe (bracket (tok TokSqOpen) (tok TokSqClose)) (many markupdecl) tok TokAnyClose `onFail` failP "missing > in DOCTYPE decl" -- return (DTD n eid (case es of { Nothing -> []; Just e -> e })) return (DTD n eid []) --markupdecl :: HParser MarkupDecl --markupdecl = -- ( elementdecl >>= return . Element) `onFail` -- ( attlistdecl >>= return . AttList) `onFail` -- ( entitydecl >>= return . Entity) `onFail` -- ( notationdecl >>= return . Notation) `onFail` -- ( misc >>= return . MarkupMisc) `onFail` -- PEREF(MarkupPE,markupdecl) -- --extsubset :: HParser ExtSubset --extsubset = do -- td <- maybe textdecl -- ds <- many extsubsetdecl -- return (ExtSubset td ds) -- --extsubsetdecl :: HParser ExtSubsetDecl --extsubsetdecl = -- ( markupdecl >>= return . ExtMarkupDecl) `onFail` -- ( conditionalsect >>= return . ExtConditionalSect) `onFail` -- PEREF(ExtPEReference,extsubsetdecl) sddecl :: HParser SDDecl sddecl = do (word "standalone" `onFail` word "STANDALONE") commit $ do tok TokEqual `onFail` failP "missing = in 'standalone' decl" bracket (tok TokQuote) (tok TokQuote) ( (word "yes" >> return True) `onFail` (word "no" >> return False) `onFail` failP "'standalone' decl requires 'yes' or 'no' value" ) ---- -- VERY IMPORTANT NOTE: The stack returned here contains those tags which -- have been closed implicitly and need to be reopened again at the -- earliest opportunity. type Stack = [(Name,[Attribute])] element :: Name -> HParser (Stack,Element Posn) element ctx = do tok TokAnyOpen (ElemTag e avs) <- elemtag ( if e `closes` ctx then -- insert the missing close-tag, fail forward, and reparse. ( do debug ("/") unparse ([TokEndOpen, TokName ctx, TokAnyClose, TokAnyOpen, TokName e] ++ reformatAttrs avs) return ([], Elem "null" [] [])) else if e `elem` selfclosingtags then -- complete the parse straightaway. ( do tok TokEndClose -- self-closing debug (e++"[+]") return ([], Elem e avs [])) `onFail` -- ( do tok TokAnyClose -- sequence (**not HTML?**) -- debug (e++"[+") -- n <- bracket (tok TokEndOpen) (tok TokAnyClose) name -- debug "]" -- if e == (map toLower n :: Name) -- then return ([], Elem e avs []) -- else return (error "no nesting in empty tag")) `onFail` ( do tok TokAnyClose -- with no close (e.g. ) debug (e++"[+]") return ([], Elem e avs [])) else (( do tok TokEndClose debug (e++"[]") return ([], Elem e avs [])) `onFail` ( do tok TokAnyClose `onFail` failP "missing > or /> in element tag" debug (e++"[") -- zz <- many (content e) -- n <- bracket (tok TokEndOpen) (tok TokAnyClose) name zz <- manyFinally (content e) (tok TokEndOpen) n <- name commit (tok TokAnyClose) debug "]" let (ss,cs) = unzip zz let s = if null ss then [] else last ss ( if e == (map toLower n :: Name) then do unparse (reformatTags (closeInner e s)) debug "^" return ([], Elem e avs cs) else do unparse [TokEndOpen, TokName n, TokAnyClose] debug "-" return (((e,avs):s), Elem e avs cs)) ) `onFail` failP ("failed to repair non-matching tags in context: "++ctx))) closeInner :: Name -> [(Name,[Attribute])] -> [(Name,[Attribute])] closeInner c ts = case lookup c closeInnerTags of (Just these) -> filter ((`notElem` these).fst) ts Nothing -> ts unparse ts = do p <- posn reparse (zip (repeat p) ts) reformatAttrs avs = concatMap f0 avs where f0 (a, AttValue [Left s]) = [TokName a, TokEqual, TokQuote, TokFreeText s, TokQuote] reformatTags ts = concatMap f0 ts where f0 (t,avs) = [TokAnyOpen, TokName t]++reformatAttrs avs++[TokAnyClose] content :: Name -> HParser (Stack,Content Posn) content ctx = do { p <- posn ; content' p ctx } where content' p ctx = oneOf' [ ( "element", element ctx >>= \(s,e)-> return (s, CElem e p)) , ( "chardata", chardata >>= \s-> return ([], CString False s p)) , ( "reference", reference >>= \r-> return ([], CRef r p)) , ( "cdsect", cdsect >>= \c-> return ([], CString True c p)) , ( "misc", misc >>= \m-> return ([], CMisc m p)) ] `adjustErrP` ("when looking for a content item,\n"++) ---- elemtag :: HParser ElemTag elemtag = do n <- name `adjustErrBad` ("malformed element tag\n"++) as <- many attribute return (ElemTag (map toLower n) as) attribute :: HParser Attribute attribute = do n <- name v <- (do tok TokEqual attvalue) `onFail` (return (AttValue [Left "TRUE"])) return (map toLower n,v) --elementdecl :: HParser ElementDecl --elementdecl = do -- tok TokSpecialOpen -- tok (TokSpecial ELEMENTx) -- n <- name `onFail` failP "missing identifier in ELEMENT decl" -- c <- contentspec `onFail` failP "missing content spec in ELEMENT decl" -- tok TokAnyClose `onFail` failP "expected > terminating ELEMENT decl" -- return (ElementDecl n c) -- --contentspec :: HParser ContentSpec --contentspec = -- ( word "EMPTY" >> return EMPTY) `onFail` -- ( word "ANY" >> return ANY) `onFail` -- ( mixed >>= return . Mixed) `onFail` -- ( cp >>= return . ContentSpec) `onFail` -- PEREF(ContentPE,contentspec) -- --choice :: HParser [CP] --choice = do -- bracket (tok TokBraOpen) (tok TokBraClose) -- (cp `sepby1` (tok TokPipe)) -- --sequence :: HParser [CP] --sequence = do -- bracket (tok TokBraOpen) (tok TokBraClose) -- (cp `sepby1` (tok TokComma)) -- --cp :: HParser CP --cp = -- ( do n <- name -- m <- modifier -- return (TagName n m)) `onFail` -- ( do ss <- sequence -- m <- modifier -- return (Seq ss m)) `onFail` -- ( do cs <- choice -- m <- modifier -- return (Choice cs m)) `onFail` -- PEREF(CPPE,cp) -- --modifier :: HParser Modifier --modifier = -- ( tok TokStar >> return Star) `onFail` -- ( tok TokQuery >> return Query) `onFail` -- ( tok TokPlus >> return Plus) `onFail` -- ( return None) -- --mixed :: HParser Mixed --mixed = do -- tok TokBraOpen -- tok TokHash -- word "PCDATA" -- cont -- where -- cont = ( tok TokBraClose >> return PCDATA) `onFail` -- ( do cs <- many ( do tok TokPipe -- n <- name -- return n) -- tok TokBraClose -- tok TokStar -- return (PCDATAplus cs)) -- --attlistdecl :: HParser AttListDecl --attlistdecl = do -- tok TokSpecialOpen -- tok (TokSpecial ATTLISTx) -- n <- name `onFail` failP "missing identifier in ATTLIST" -- ds <- many attdef -- tok TokAnyClose `onFail` failP "missing > terminating ATTLIST" -- return (AttListDecl n ds) -- --attdef :: HParser AttDef --attdef = do -- n <- name -- t <- atttype `onFail` failP "missing attribute type in attlist defn" -- d <- defaultdecl -- return (AttDef n t d) -- --atttype :: HParser AttType --atttype = -- ( word "CDATA" >> return StringType) `onFail` -- ( tokenizedtype >>= return . TokenizedType) `onFail` -- ( enumeratedtype >>= return . EnumeratedType) -- --tokenizedtype :: HParser TokenizedType --tokenizedtype = -- ( word "ID" >> return ID) `onFail` -- ( word "IDREF" >> return IDREF) `onFail` -- ( word "IDREFS" >> return IDREFS) `onFail` -- ( word "ENTITY" >> return ENTITY) `onFail` -- ( word "ENTITIES" >> return ENTITIES) `onFail` -- ( word "NMTOKEN" >> return NMTOKEN) `onFail` -- ( word "NMTOKENS" >> return NMTOKENS) -- --enumeratedtype :: HParser EnumeratedType --enumeratedtype = -- ( notationtype >>= return . NotationType) `onFail` -- ( enumeration >>= return . Enumeration) -- --notationtype :: HParser NotationType --notationtype = do -- word "NOTATION" -- bracket (tok TokBraOpen) (tok TokBraClose) -- (name `sepby1` (tok TokPipe)) -- --enumeration :: HParser Enumeration --enumeration = -- bracket (tok TokBraOpen) (tok TokBraClose) -- (nmtoken `sepby1` (tok TokPipe)) -- --defaultdecl :: HParser DefaultDecl --defaultdecl = -- ( tok TokHash >> word "REQUIRED" >> return REQUIRED) `onFail` -- ( tok TokHash >> word "IMPLIED" >> return IMPLIED) `onFail` -- ( do f <- maybe (tok TokHash >> word "FIXED" >> return FIXED) -- a <- attvalue -- return (DefaultTo a f)) -- --conditionalsect :: HParser ConditionalSect --conditionalsect = -- ( do tok TokSectionOpen -- tok (TokSection INCLUDEx) -- tok TokSqOpen `onFail` failP "missing [ after INCLUDE" -- i <- extsubsetdecl `onFail` failP "missing ExtSubsetDecl in INCLUDE" -- tok TokSectionClose `onFail` failP "missing ] after INCLUDE" -- return (IncludeSect i)) `onFail` -- ( do tok TokSectionOpen -- tok (TokSection IGNOREx) -- tok TokSqOpen `onFail` failP "missing [ after IGNORE" -- i <- many ignoresectcontents -- tok TokSectionClose `onFail` failP "missing ] after IGNORE" -- return (IgnoreSect i)) -- --ignoresectcontents :: HParser IgnoreSectContents --ignoresectcontents = do -- i <- ignore -- is <- many (do tok TokSectionOpen -- ic <- ignoresectcontents -- tok TokSectionClose -- ig <- ignore -- return (ic,ig)) -- return (IgnoreSectContents i is) -- --ignore :: HParser Ignore --ignore = freetext >>= return . Ignore reference :: HParser Reference reference = do bracket (tok TokAmp) (tok TokSemi) (freetext >>= val) where val ('#':'x':i) | all isHexDigit i = return . RefChar . fst . head . readHex $ i val ('#':i) | all isDigit i = return . RefChar . fst . head . readDec $ i val name = return . RefEntity $ name {- reference :: HParser Reference reference = ( charref >>= return . RefChar) `onFail` ( entityref >>= return . RefEntity) entityref :: HParser EntityRef entityref = do n <- bracket (tok TokAmp) (tok TokSemi) name return n charref :: HParser CharRef charref = do bracket (tok TokAmp) (tok TokSemi) (freetext >>= readCharVal) where readCharVal ('#':'x':i) = return . fst . head . readHex $ i readCharVal ('#':i) = return . fst . head . readDec $ i readCharVal _ = mzero -} --pereference :: HParser PEReference --pereference = do -- bracket (tok TokPercent) (tok TokSemi) nmtoken -- --entitydecl :: HParser EntityDecl --entitydecl = -- ( gedecl >>= return . EntityGEDecl) `onFail` -- ( pedecl >>= return . EntityPEDecl) -- --gedecl :: HParser GEDecl --gedecl = do -- tok TokSpecialOpen -- tok (TokSpecial ENTITYx) -- n <- name -- e <- entitydef `onFail` failP "missing entity defn in G ENTITY decl" -- tok TokAnyClose `onFail` failP "expected > terminating G ENTITY decl" -- return (GEDecl n e) -- --pedecl :: HParser PEDecl --pedecl = do -- tok TokSpecialOpen -- tok (TokSpecial ENTITYx) -- tok TokPercent -- n <- name -- e <- pedef `onFail` failP "missing entity defn in P ENTITY decl" -- tok TokAnyClose `onFail` failP "expected > terminating P ENTITY decl" -- return (PEDecl n e) -- --entitydef :: HParser EntityDef --entitydef = -- ( entityvalue >>= return . DefEntityValue) `onFail` -- ( do eid <- externalid -- ndd <- maybe ndatadecl -- return (DefExternalID eid ndd)) -- --pedef :: HParser PEDef --pedef = -- ( entityvalue >>= return . PEDefEntityValue) `onFail` -- ( externalid >>= return . PEDefExternalID) externalid :: HParser ExternalID externalid = ( do word "SYSTEM" s <- systemliteral return (SYSTEM s)) `onFail` ( do word "PUBLIC" p <- pubidliteral s <- (systemliteral `onFail` return (SystemLiteral "")) return (PUBLIC p s)) --ndatadecl :: HParser NDataDecl --ndatadecl = do -- word "NDATA" -- n <- name -- return (NDATA n) textdecl :: HParser TextDecl textdecl = do tok TokPIOpen (word "xml" `onFail` word "XML") v <- maybe versioninfo e <- encodingdecl tok TokPIClose `onFail` failP "expected ?> terminating text decl" return (TextDecl v e) --extparsedent :: HParser ExtParsedEnt --extparsedent = do -- t <- maybe textdecl -- (_,c) <- (content "") -- return (ExtParsedEnt t c) -- --extpe :: HParser ExtPE --extpe = do -- t <- maybe textdecl -- e <- extsubsetdecl -- return (ExtPE t e) encodingdecl :: HParser EncodingDecl encodingdecl = do (word "encoding" `onFail` word "ENCODING") tok TokEqual `onFail` failBadP "expected = in 'encoding' decl" f <- bracket (tok TokQuote) (tok TokQuote) freetext return (EncodingDecl f) --notationdecl :: HParser NotationDecl --notationdecl = do -- tok TokSpecialOpen -- word "NOTATION" -- n <- name -- e <- either externalid publicid -- tok TokAnyClose `onFail` failP "expected > terminating NOTATION decl" -- return (NOTATION n e) publicid :: HParser PublicID publicid = do word "PUBLICID" p <- pubidliteral return (PUBLICID p) entityvalue :: HParser EntityValue entityvalue = do evs <- bracket (tok TokQuote) (tok TokQuote) (many ev) return (EntityValue evs) ev :: HParser EV ev = ( freetext >>= return . EVString) `onFail` -- PEREF(EVPERef,ev) `onFail` ( reference >>= return . EVRef) attvalue :: HParser AttValue attvalue = ( do avs <- bracket (tok TokQuote) (tok TokQuote) (many (either freetext reference)) return (AttValue avs) ) `onFail` ( do v <- nmtoken s <- (tok TokPercent >> return "%") `onFail` return "" return (AttValue [Left (v++s)]) ) `onFail` ( do s <- oneOf [ tok TokPlus >> return "+" , tok TokHash >> return "#" ] v <- nmtoken return (AttValue [Left (s++v)]) ) `onFail` failP "Badly formatted attribute value" systemliteral :: HParser SystemLiteral systemliteral = do s <- bracket (tok TokQuote) (tok TokQuote) freetext return (SystemLiteral s) -- note: need to fold &...; escapes pubidliteral :: HParser PubidLiteral pubidliteral = do s <- bracket (tok TokQuote) (tok TokQuote) freetext return (PubidLiteral s) -- note: need to fold &...; escapes chardata :: HParser CharData chardata = freetext -- >>= return . CharData hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Html/Pretty.hs0000644006511100651110000002420510504340456023471 0ustar rossross-- | This is a separate pretty-printer for HTML documents, recognising -- some of the differences between HTML and true XML. module Text.XML.HaXml.Html.Pretty ( document , element , attribute , content ) where import Prelude hiding (maybe,either) import Maybe hiding (maybe) import List (intersperse) import Char (isSpace) import Text.PrettyPrint.HughesPJ import Text.XML.HaXml.Types either f g (Left x) = f x either f g (Right x) = g x maybe f Nothing = empty maybe f (Just x) = f x --peref p = text "%" <> text p <> text ";" ---- document :: Document i -> Doc prolog :: Prolog -> Doc xmldecl :: XMLDecl -> Doc misc :: Misc -> Doc sddecl :: Bool -> Doc doctypedecl :: DocTypeDecl -> Doc markupdecl :: MarkupDecl -> Doc extsubset :: ExtSubset -> Doc extsubsetdecl :: ExtSubsetDecl -> Doc element :: Element i -> Doc attribute :: Attribute -> Doc --etc content :: Content i -> Doc ---- document (Document p _ e m)= prolog p $$ element e $$ vcat (map misc m) prolog (Prolog x m1 dtd m2)= maybe xmldecl x $$ vcat (map misc m1) $$ maybe doctypedecl dtd $$ vcat (map misc m2) xmldecl (XMLDecl v e sd) = text " text v <> text "'" <+> maybe encodingdecl e <+> maybe sddecl sd <+> text "?>" misc (Comment s) = text "" misc (PI (n,s)) = text " text n <+> text s <+> text "?>" sddecl sd | sd = text "standalone='yes'" | otherwise = text "standalone='no'" doctypedecl (DTD n eid ds) = if null ds then hd <> text ">" else hd <+> text " [" $$ vcat (map markupdecl ds) $$ text "]>" where hd = text " text n <+> maybe externalid eid markupdecl (Element e) = elementdecl e markupdecl (AttList a) = attlistdecl a markupdecl (Entity e) = entitydecl e markupdecl (Notation n) = notationdecl n markupdecl (MarkupMisc m) = misc m --markupdecl (MarkupPE p m) = peref p extsubset (ExtSubset t ds) = maybe textdecl t $$ vcat (map extsubsetdecl ds) extsubsetdecl (ExtMarkupDecl m) = markupdecl m extsubsetdecl (ExtConditionalSect c) = conditionalsect c --extsubsetdecl (ExtPEReference p e) = peref p element (Elem n as []) = text "<" <> text n <+> fsep (map attribute as) <> text "/>" element e@(Elem n as cs) -- | any isText cs = text "<" <> text n <+> fsep (map attribute as) <> -- text ">" <> hcat (map content cs) <> -- text " text n <> text ">" | isText (head cs) = text "<" <> text n <+> fsep (map attribute as) <> text ">" <> hcat (map content cs) <> text " text n <> text ">" | otherwise = let (d,c) = carryelem e empty in d <> c isText (CString _ _ _) = True isText (CRef _ _) = True isText _ = False carryelem (Elem n as []) c = ( c <> text "<" <> text n <+> fsep (map attribute as) , text "/>") --carryelem e@(Elem n as cs) c ---- | any isText cs = ( c <> element e, empty) -- | otherwise = let (cs',d') = carryscan carrycontent cs (text ">") -- in -- ( c <> -- text "<" <> text n <+> fsep (map attribute as) $$ -- nest 2 (vcat cs') <> -- $$ -- c' <> text " text n -- , text ">") --carrycontent (CElem e) c = carryelem e c --carrycontent (CString _ s) c = (c <> chardata s, empty) --carrycontent (CRef r) c = (c <> reference r, empty) --carrycontent (CMisc m) c = (c <> misc m, empty) -- --carryscan :: (a->c->(b,c)) -> [a] -> c -> ([b],c) --carryscan f [] c = ([],c) --carryscan f (a:as) c = let (b, c') = f a c -- (bs,c'') = carryscan f as c' -- in (b:bs, c'') carryelem e@(Elem n as cs) c | isText (head cs) = ( start <> text ">" <> hcat (map content cs) <> text " text n , text ">") | otherwise = let (d,c') = foldl carrycontent (start, text ">") cs in ( d <> c' <> text " text n , text ">") where start = c <> text "<" <> text n <+> fsep (map attribute as) carrycontent (d,c) (CElem e _) = let (d',c') = carryelem e c in (d $$ nest 2 d', c') carrycontent (d,c) (CString _ s _) = (d <> c <> chardata s, empty) carrycontent (d,c) (CRef r _) = (d <> c <> reference r,empty) carrycontent (d,c) (CMisc m _) = (d $$ c <> misc m, empty) attribute (n,v) = text n <> text "=" <> attvalue v content (CElem e _) = element e content (CString _ s _) = chardata s content (CRef r _) = reference r content (CMisc m _) = misc m elementdecl (ElementDecl n cs) = text " text n <+> contentspec cs <> text ">" contentspec EMPTY = text "EMPTY" contentspec ANY = text "ANY" contentspec (Mixed m) = mixed m contentspec (ContentSpec c) = cp c --contentspec (ContentPE p cs) = peref p cp (TagName n m) = text n <> modifier m cp (Choice cs m) = parens (hcat (intersperse (text "|") (map cp cs))) <> modifier m cp (Seq cs m) = parens (hcat (intersperse (text ",") (map cp cs))) <> modifier m --cp (CPPE p c) = peref p modifier None = empty modifier Query = text "?" modifier Star = text "*" modifier Plus = text "+" mixed PCDATA = text "(#PCDATA)" mixed (PCDATAplus ns) = text "(#PCDATA |" <+> hcat (intersperse (text "|") (map text ns)) <> text ")*" attlistdecl (AttListDecl n ds) = text " text n <+> fsep (map attdef ds) <> text ">" attdef (AttDef n t d) = text n <+> atttype t <+> defaultdecl d atttype StringType = text "CDATA" atttype (TokenizedType t) = tokenizedtype t atttype (EnumeratedType t) = enumeratedtype t tokenizedtype ID = text "ID" tokenizedtype IDREF = text "IDREF" tokenizedtype IDREFS = text "IDREFS" tokenizedtype ENTITY = text "ENTITY" tokenizedtype ENTITIES = text "ENTITIES" tokenizedtype NMTOKEN = text "NMTOKEN" tokenizedtype NMTOKENS = text "NMTOKENS" enumeratedtype (NotationType n)= notationtype n enumeratedtype (Enumeration e) = enumeration e notationtype ns = text "NOTATION" <+> parens (hcat (intersperse (text "|") (map text ns))) enumeration ns = parens (hcat (intersperse (text "|") (map nmtoken ns))) defaultdecl REQUIRED = text "#REQUIRED" defaultdecl IMPLIED = text "#IMPLIED" defaultdecl (DefaultTo a f) = maybe (const (text "#FIXED")) f <+> attvalue a conditionalsect (IncludeSect i)= text " vcat (map extsubsetdecl i) <+> text "]]>" conditionalsect (IgnoreSect i) = text " fsep (map ignoresectcontents i) <+> text "]]>" ignore (Ignore) = empty ignoresectcontents (IgnoreSectContents i is) = ignore i <+> vcat (map internal is) where internal (ics,i) = text " ignoresectcontents ics <+> text "]]>" <+> ignore i reference (RefEntity er) = entityref er reference (RefChar cr) = charref cr entityref n = text "&" <> text n <> text ";" charref c = text "&#" <> text (show c) <> text ";" entitydecl (EntityGEDecl d) = gedecl d entitydecl (EntityPEDecl d) = pedecl d gedecl (GEDecl n ed) = text " text n <+> entitydef ed <> text ">" pedecl (PEDecl n pd) = text " text n <+> pedef pd <> text ">" entitydef (DefEntityValue ev) = entityvalue ev entitydef (DefExternalID i nd) = externalid i <+> maybe ndatadecl nd pedef (PEDefEntityValue ev) = entityvalue ev pedef (PEDefExternalID eid) = externalid eid externalid (SYSTEM sl) = text "SYSTEM" <+> systemliteral sl externalid (PUBLIC i sl) = text "PUBLIC" <+> pubidliteral i <+> systemliteral sl ndatadecl (NDATA n) = text "NDATA" <+> text n textdecl (TextDecl vi ed) = text " maybe text vi <+> encodingdecl ed <> text "?>" extparsedent (ExtParsedEnt t c)= maybe textdecl t <+> content c extpe (ExtPE t esd) = maybe textdecl t <+> vcat (map extsubsetdecl esd) notationdecl (NOTATION n e) = text " text n <+> either externalid publicid e <> text ">" publicid (PUBLICID p) = text "PUBLICID" <+> pubidliteral p encodingdecl (EncodingDecl s) = text "encoding='" <> text s <> text "'" nmtoken s = text s attvalue (AttValue esr) = text "\"" <> hcat (map (either text reference) esr) <> text "\"" entityvalue (EntityValue evs) = text "'" <> hcat (map ev evs) <> text "'" ev (EVString s) = text s --ev (EVPERef p e) = peref p ev (EVRef r) = reference r pubidliteral (PubidLiteral s) = text "'" <> text s <> text "'" systemliteral (SystemLiteral s)= text "'" <> text s <> text "'" chardata s = if all isSpace s then empty else text s cdsect c = text " chardata c <> text "]]>" ---- hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Html/ParseLazy.hs0000644006511100651110000005653010504340466024123 0ustar rossross-- | This is a parser for HTML documents. Unlike for XML documents, it -- must include a certain amount of error-correction to account for -- HTML features like self-terminating tags, unterminated tags, and -- incorrect nesting. The input is tokenised by the -- XML lexer (a separate lexer is not required for HTML). -- It uses a slightly extended version of the Hutton/Meijer parser -- combinators. module Text.XML.HaXml.Html.ParseLazy ( htmlParse ) where import Prelude hiding (either,maybe,sequence) import qualified Prelude (either) import Maybe hiding (maybe) import Char (toLower, isSpace, isDigit, isHexDigit) import Numeric (readDec,readHex) import Monad import Text.XML.HaXml.Types import Text.XML.HaXml.Lex import Text.XML.HaXml.Posn import Text.ParserCombinators.PolyLazy -- #define DEBUG #if defined(DEBUG) # if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \ ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__) import Debug.Trace(trace) # elif defined(__GLASGOW_HASKELL__) import IOExts(trace) # elif defined(__NHC__) || defined(__HBC__) import NonStdTrace # endif debug :: Monad m => String -> m () debug s = trace s (return ()) #else debug :: Monad m => String -> m () debug s = return () #endif -- | The first argument is the name of the file, the second is the string -- contents of the file. The result is the generic representation of -- an XML document. Any errors cause program failure with message to stderr. htmlParse :: String -> String -> Document Posn htmlParse name = simplify . fst . runParser document . xmlLex name {- -- | The first argument is the name of the file, the second is the string -- contents of the file. The result is the generic representation of -- an XML document. Any parsing errors are returned in the @Either@ type. htmlParse' :: String -> String -> Either String (Document Posn) htmlParse' name = Prelude.either Left (Right . simplify) . fst . runParser document . xmlLex name -} ---- Document simplification ---- simplify :: Document i -> Document i simplify (Document p st (Elem n avs cs) ms) = Document p st (Elem n avs (deepfilter simp cs)) ms where simp (CElem (Elem "null" [] []) _) = False simp (CElem (Elem n _ []) _) | n `elem` ["font","p","i","b","em" ,"tt","big","small"] = False -- simp (CString False s _) | all isSpace s = False simp _ = True deepfilter p = filter p . map (\c-> case c of CElem (Elem n avs cs) i -> CElem (Elem n avs (deepfilter p cs)) i _ -> c) -- opening any of these, they close again immediately selfclosingtags = ["img","hr","br","meta","col","link","base" ,"param","area","frame","input"] --closing this, implicitly closes any of those which are contained in it closeInnerTags = [ ("ul", ["li"]) , ("ol", ["li"]) , ("dl", ["dt","dd"]) , ("tr", ["th","td"]) , ("div", ["p"]) , ("thead", ["th","tr","td"]) , ("tfoot", ["th","tr","td"]) , ("tbody", ["th","tr","td"]) , ("table", ["th","tr","td","thead","tfoot","tbody"]) , ("caption", ["p"]) , ("th", ["p"]) , ("td", ["p"]) , ("li", ["p"]) , ("dt", ["p"]) , ("dd", ["p"]) , ("object", ["p"]) , ("map", ["p"]) , ("body", ["p"]) ] --opening this, implicitly closes that closes :: Name -> Name -> Bool "a" `closes` "a" = True "li" `closes` "li" = True "th" `closes` t | t `elem` ["th","td"] = True "td" `closes` t | t `elem` ["th","td"] = True "tr" `closes` t | t `elem` ["th","td","tr"] = True "dt" `closes` t | t `elem` ["dt","dd"] = True "dd" `closes` t | t `elem` ["dt","dd"] = True "form" `closes` "form" = True "label" `closes` "label" = True _ `closes` "option" = True "thead" `closes` t | t `elem` ["colgroup"] = True "tfoot" `closes` t | t `elem` ["thead","colgroup"] = True "tbody" `closes` t | t `elem` ["tbody","tfoot","thead","colgroup"] = True "colgroup" `closes` "colgroup" = True t `closes` "p" | t `elem` ["p","h1","h2","h3","h4","h5","h6" ,"hr","div","ul","dl","ol","table"] = True _ `closes` _ = False ---- Misc ---- fst3 (a,_,_) = a snd3 (_,a,_) = a thd3 (_,_,a) = a ---- Auxiliary Parsing Functions ---- type HParser a = Parser (Posn,TokenT) a tok :: TokenT -> HParser TokenT tok t = do (p,t') <- next case t' of TokError s -> report failBad (show t) p t' _ | t'==t -> return t | otherwise -> report fail (show t) p t' name :: HParser Name --name = do {(p,TokName s) <- next; return s} name = do (p,tok) <- next case tok of TokName s -> return s TokError s -> report failBad "a name" p tok _ -> report fail "a name" p tok string, freetext :: HParser String string = do (p,t) <- next case t of TokName s -> return s _ -> report fail "text" p t freetext = do (p,t) <- next case t of TokFreeText s -> return s _ -> report fail "text" p t maybe :: HParser a -> HParser (Maybe a) maybe p = ( p >>= return . Just) `onFail` ( return Nothing) either :: HParser a -> HParser b -> HParser (Either a b) either p q = ( p >>= return . Left) `onFail` ( q >>= return . Right) word :: String -> HParser () word s = do { x <- next ; case x of (p,TokName n) | s==n -> return () (p,TokFreeText n) | s==n -> return () (p,t@(TokError _)) -> report failBad (show s) p t (p,t) -> report fail (show s) p t } posn :: HParser Posn posn = do { x@(p,_) <- next ; reparse [x] ; return p } `onFail` return noPos nmtoken :: HParser NmToken nmtoken = (string `onFail` freetext) failP, failBadP :: String -> HParser a failP msg = do { p <- posn; fail (msg++"\n at "++show p) } failBadP msg = do { p <- posn; failBad (msg++"\n at "++show p) } report :: (String->HParser a) -> String -> Posn -> TokenT -> HParser a report fail exp p t = fail ("Expected "++show exp++" but found "++show t ++"\n at "++show p) adjustErrP :: HParser a -> (String->String) -> HParser a p `adjustErrP` f = p `onFail` do pn <- posn (p `adjustErr` f) `adjustErr` (++show pn) ---- XML Parsing Functions ---- document :: HParser (Document Posn) document = do return Document `apply` (prolog `adjustErr` ("unrecognisable XML prolog\n"++)) `apply` (return emptyST) `apply` (do es <- many1 (element "HTML document") return (case map snd es of [e] -> e es -> Elem "html" [] (map mkCElem es))) `apply` (many misc) where mkCElem e = CElem e noPos comment :: HParser Comment comment = do bracket (tok TokCommentOpen) (tok TokCommentClose) freetext processinginstruction :: HParser ProcessingInstruction processinginstruction = do tok TokPIOpen commit $ do n <- string `onFail` failP "processing instruction has no target" f <- freetext (tok TokPIClose `onFail` tok TokAnyClose) `onFail` failP "missing ?> or >" return (n, f) cdsect :: HParser CDSect cdsect = do tok TokSectionOpen bracket (tok (TokSection CDATAx)) (tok TokSectionClose) chardata prolog :: HParser Prolog prolog = do x <- maybe xmldecl m1 <- many misc dtd <- maybe doctypedecl m2 <- many misc return (Prolog x m1 dtd m2) xmldecl :: HParser XMLDecl xmldecl = do tok TokPIOpen (word "xml" `onFail` word "XML") p <- posn s <- freetext tok TokPIClose `onFail` failBadP "missing ?> in " (return . fst . runParser aux . xmlReLex p) s where aux = do v <- versioninfo `onFail` failP "missing XML version info" e <- maybe encodingdecl s <- maybe sddecl return (XMLDecl v e s) versioninfo :: HParser VersionInfo versioninfo = do (word "version" `onFail` word "VERSION") tok TokEqual bracket (tok TokQuote) (tok TokQuote) freetext misc :: HParser Misc misc = oneOf' [ ("", comment >>= return . Comment) , ("", processinginstruction >>= return . PI) ] -- Question: for HTML, should we disallow in-line DTDs, allowing only externals? -- Answer: I think so. doctypedecl :: HParser DocTypeDecl doctypedecl = do tok TokSpecialOpen tok (TokSpecial DOCTYPEx) commit $ do n <- name eid <- maybe externalid -- es <- maybe (bracket (tok TokSqOpen) (tok TokSqClose)) (many markupdecl) tok TokAnyClose `onFail` failP "missing > in DOCTYPE decl" -- return (DTD n eid (case es of { Nothing -> []; Just e -> e })) return (DTD n eid []) --markupdecl :: HParser MarkupDecl --markupdecl = -- ( elementdecl >>= return . Element) `onFail` -- ( attlistdecl >>= return . AttList) `onFail` -- ( entitydecl >>= return . Entity) `onFail` -- ( notationdecl >>= return . Notation) `onFail` -- ( misc >>= return . MarkupMisc) `onFail` -- PEREF(MarkupPE,markupdecl) -- --extsubset :: HParser ExtSubset --extsubset = do -- td <- maybe textdecl -- ds <- many extsubsetdecl -- return (ExtSubset td ds) -- --extsubsetdecl :: HParser ExtSubsetDecl --extsubsetdecl = -- ( markupdecl >>= return . ExtMarkupDecl) `onFail` -- ( conditionalsect >>= return . ExtConditionalSect) `onFail` -- PEREF(ExtPEReference,extsubsetdecl) sddecl :: HParser SDDecl sddecl = do (word "standalone" `onFail` word "STANDALONE") commit $ do tok TokEqual `onFail` failP "missing = in 'standalone' decl" bracket (tok TokQuote) (tok TokQuote) ( (word "yes" >> return True) `onFail` (word "no" >> return False) `onFail` failP "'standalone' decl requires 'yes' or 'no' value" ) ---- -- VERY IMPORTANT NOTE: The stack returned here contains those tags which -- have been closed implicitly and need to be reopened again at the -- earliest opportunity. type Stack = [(Name,[Attribute])] element :: Name -> HParser (Stack,Element Posn) element ctx = do tok TokAnyOpen (ElemTag e avs) <- elemtag ( if e `closes` ctx then -- insert the missing close-tag, fail forward, and reparse. ( do debug ("/") unparse ([TokEndOpen, TokName ctx, TokAnyClose, TokAnyOpen, TokName e] ++ reformatAttrs avs) return ([], Elem "null" [] [])) else if e `elem` selfclosingtags then -- complete the parse straightaway. ( do tok TokEndClose -- self-closing debug (e++"[+]") return ([], Elem e avs [])) `onFail` -- ( do tok TokAnyClose -- sequence (**not HTML?**) -- debug (e++"[+") -- n <- bracket (tok TokEndOpen) (tok TokAnyClose) name -- debug "]" -- if e == (map toLower n :: Name) -- then return ([], Elem e avs []) -- else return (error "no nesting in empty tag")) `onFail` ( do tok TokAnyClose -- with no close (e.g. ) debug (e++"[+]") return ([], Elem e avs [])) else (( do tok TokEndClose debug (e++"[]") return ([], Elem e avs [])) `onFail` ( do tok TokAnyClose `onFail` failP "missing > or /> in element tag" debug (e++"[") return (\ (stack,contained)-> (stack, Elem e avs contained)) `apply` (do zz <- manyFinally (content e) (tok TokEndOpen) n <- name commit (tok TokAnyClose) debug "]" let (ss,cs) = unzip zz let s = if null ss then [] else last ss ( if e == (map toLower n :: Name) then do unparse (reformatTags (closeInner e s)) debug "^" return ([], cs) else do unparse [TokEndOpen, TokName n, TokAnyClose] debug "-" return (((e,avs):s), cs))) ) `onFail` failP ("failed to repair non-matching tags in context: "++ctx))) closeInner :: Name -> [(Name,[Attribute])] -> [(Name,[Attribute])] closeInner c ts = case lookup c closeInnerTags of (Just these) -> filter ((`notElem` these).fst) ts Nothing -> ts unparse ts = do p <- posn reparse (zip (repeat p) ts) reformatAttrs avs = concatMap f0 avs where f0 (a, AttValue [Left s]) = [TokName a, TokEqual, TokQuote, TokFreeText s, TokQuote] reformatTags ts = concatMap f0 ts where f0 (t,avs) = [TokAnyOpen, TokName t]++reformatAttrs avs++[TokAnyClose] content :: Name -> HParser (Stack,Content Posn) content ctx = do { p <- posn ; content' p ctx } where content' p ctx = oneOf' [ ( "element", element ctx >>= \(s,e)-> return (s, CElem e p)) , ( "chardata", chardata >>= \s-> return ([], CString False s p)) , ( "reference", reference >>= \r-> return ([], CRef r p)) , ( "cdsect", cdsect >>= \c-> return ([], CString True c p)) , ( "misc", misc >>= \m-> return ([], CMisc m p)) ] `adjustErrP` ("when looking for a content item,\n"++) ---- elemtag :: HParser ElemTag elemtag = do n <- name `adjustErrBad` ("malformed element tag\n"++) as <- many attribute return (ElemTag (map toLower n) as) attribute :: HParser Attribute attribute = do n <- name v <- (do tok TokEqual attvalue) `onFail` (return (AttValue [Left "TRUE"])) return (map toLower n,v) --elementdecl :: HParser ElementDecl --elementdecl = do -- tok TokSpecialOpen -- tok (TokSpecial ELEMENTx) -- n <- name `onFail` failP "missing identifier in ELEMENT decl" -- c <- contentspec `onFail` failP "missing content spec in ELEMENT decl" -- tok TokAnyClose `onFail` failP "expected > terminating ELEMENT decl" -- return (ElementDecl n c) -- --contentspec :: HParser ContentSpec --contentspec = -- ( word "EMPTY" >> return EMPTY) `onFail` -- ( word "ANY" >> return ANY) `onFail` -- ( mixed >>= return . Mixed) `onFail` -- ( cp >>= return . ContentSpec) `onFail` -- PEREF(ContentPE,contentspec) -- --choice :: HParser [CP] --choice = do -- bracket (tok TokBraOpen) (tok TokBraClose) -- (cp `sepby1` (tok TokPipe)) -- --sequence :: HParser [CP] --sequence = do -- bracket (tok TokBraOpen) (tok TokBraClose) -- (cp `sepby1` (tok TokComma)) -- --cp :: HParser CP --cp = -- ( do n <- name -- m <- modifier -- return (TagName n m)) `onFail` -- ( do ss <- sequence -- m <- modifier -- return (Seq ss m)) `onFail` -- ( do cs <- choice -- m <- modifier -- return (Choice cs m)) `onFail` -- PEREF(CPPE,cp) -- --modifier :: HParser Modifier --modifier = -- ( tok TokStar >> return Star) `onFail` -- ( tok TokQuery >> return Query) `onFail` -- ( tok TokPlus >> return Plus) `onFail` -- ( return None) -- --mixed :: HParser Mixed --mixed = do -- tok TokBraOpen -- tok TokHash -- word "PCDATA" -- cont -- where -- cont = ( tok TokBraClose >> return PCDATA) `onFail` -- ( do cs <- many ( do tok TokPipe -- n <- name -- return n) -- tok TokBraClose -- tok TokStar -- return (PCDATAplus cs)) -- --attlistdecl :: HParser AttListDecl --attlistdecl = do -- tok TokSpecialOpen -- tok (TokSpecial ATTLISTx) -- n <- name `onFail` failP "missing identifier in ATTLIST" -- ds <- many attdef -- tok TokAnyClose `onFail` failP "missing > terminating ATTLIST" -- return (AttListDecl n ds) -- --attdef :: HParser AttDef --attdef = do -- n <- name -- t <- atttype `onFail` failP "missing attribute type in attlist defn" -- d <- defaultdecl -- return (AttDef n t d) -- --atttype :: HParser AttType --atttype = -- ( word "CDATA" >> return StringType) `onFail` -- ( tokenizedtype >>= return . TokenizedType) `onFail` -- ( enumeratedtype >>= return . EnumeratedType) -- --tokenizedtype :: HParser TokenizedType --tokenizedtype = -- ( word "ID" >> return ID) `onFail` -- ( word "IDREF" >> return IDREF) `onFail` -- ( word "IDREFS" >> return IDREFS) `onFail` -- ( word "ENTITY" >> return ENTITY) `onFail` -- ( word "ENTITIES" >> return ENTITIES) `onFail` -- ( word "NMTOKEN" >> return NMTOKEN) `onFail` -- ( word "NMTOKENS" >> return NMTOKENS) -- --enumeratedtype :: HParser EnumeratedType --enumeratedtype = -- ( notationtype >>= return . NotationType) `onFail` -- ( enumeration >>= return . Enumeration) -- --notationtype :: HParser NotationType --notationtype = do -- word "NOTATION" -- bracket (tok TokBraOpen) (tok TokBraClose) -- (name `sepby1` (tok TokPipe)) -- --enumeration :: HParser Enumeration --enumeration = -- bracket (tok TokBraOpen) (tok TokBraClose) -- (nmtoken `sepby1` (tok TokPipe)) -- --defaultdecl :: HParser DefaultDecl --defaultdecl = -- ( tok TokHash >> word "REQUIRED" >> return REQUIRED) `onFail` -- ( tok TokHash >> word "IMPLIED" >> return IMPLIED) `onFail` -- ( do f <- maybe (tok TokHash >> word "FIXED" >> return FIXED) -- a <- attvalue -- return (DefaultTo a f)) -- --conditionalsect :: HParser ConditionalSect --conditionalsect = -- ( do tok TokSectionOpen -- tok (TokSection INCLUDEx) -- tok TokSqOpen `onFail` failP "missing [ after INCLUDE" -- i <- extsubsetdecl `onFail` failP "missing ExtSubsetDecl in INCLUDE" -- tok TokSectionClose `onFail` failP "missing ] after INCLUDE" -- return (IncludeSect i)) `onFail` -- ( do tok TokSectionOpen -- tok (TokSection IGNOREx) -- tok TokSqOpen `onFail` failP "missing [ after IGNORE" -- i <- many ignoresectcontents -- tok TokSectionClose `onFail` failP "missing ] after IGNORE" -- return (IgnoreSect i)) -- --ignoresectcontents :: HParser IgnoreSectContents --ignoresectcontents = do -- i <- ignore -- is <- many (do tok TokSectionOpen -- ic <- ignoresectcontents -- tok TokSectionClose -- ig <- ignore -- return (ic,ig)) -- return (IgnoreSectContents i is) -- --ignore :: HParser Ignore --ignore = freetext >>= return . Ignore reference :: HParser Reference reference = do bracket (tok TokAmp) (tok TokSemi) (freetext >>= val) where val ('#':'x':i) | all isHexDigit i = return . RefChar . fst . head . readHex $ i val ('#':i) | all isDigit i = return . RefChar . fst . head . readDec $ i val name = return . RefEntity $ name {- reference :: HParser Reference reference = ( charref >>= return . RefChar) `onFail` ( entityref >>= return . RefEntity) entityref :: HParser EntityRef entityref = do n <- bracket (tok TokAmp) (tok TokSemi) name return n charref :: HParser CharRef charref = do bracket (tok TokAmp) (tok TokSemi) (freetext >>= readCharVal) where readCharVal ('#':'x':i) = return . fst . head . readHex $ i readCharVal ('#':i) = return . fst . head . readDec $ i readCharVal _ = mzero -} --pereference :: HParser PEReference --pereference = do -- bracket (tok TokPercent) (tok TokSemi) nmtoken -- --entitydecl :: HParser EntityDecl --entitydecl = -- ( gedecl >>= return . EntityGEDecl) `onFail` -- ( pedecl >>= return . EntityPEDecl) -- --gedecl :: HParser GEDecl --gedecl = do -- tok TokSpecialOpen -- tok (TokSpecial ENTITYx) -- n <- name -- e <- entitydef `onFail` failP "missing entity defn in G ENTITY decl" -- tok TokAnyClose `onFail` failP "expected > terminating G ENTITY decl" -- return (GEDecl n e) -- --pedecl :: HParser PEDecl --pedecl = do -- tok TokSpecialOpen -- tok (TokSpecial ENTITYx) -- tok TokPercent -- n <- name -- e <- pedef `onFail` failP "missing entity defn in P ENTITY decl" -- tok TokAnyClose `onFail` failP "expected > terminating P ENTITY decl" -- return (PEDecl n e) -- --entitydef :: HParser EntityDef --entitydef = -- ( entityvalue >>= return . DefEntityValue) `onFail` -- ( do eid <- externalid -- ndd <- maybe ndatadecl -- return (DefExternalID eid ndd)) -- --pedef :: HParser PEDef --pedef = -- ( entityvalue >>= return . PEDefEntityValue) `onFail` -- ( externalid >>= return . PEDefExternalID) externalid :: HParser ExternalID externalid = ( do word "SYSTEM" s <- systemliteral return (SYSTEM s)) `onFail` ( do word "PUBLIC" p <- pubidliteral s <- (systemliteral `onFail` return (SystemLiteral "")) return (PUBLIC p s)) --ndatadecl :: HParser NDataDecl --ndatadecl = do -- word "NDATA" -- n <- name -- return (NDATA n) textdecl :: HParser TextDecl textdecl = do tok TokPIOpen (word "xml" `onFail` word "XML") v <- maybe versioninfo e <- encodingdecl tok TokPIClose `onFail` failP "expected ?> terminating text decl" return (TextDecl v e) --extparsedent :: HParser ExtParsedEnt --extparsedent = do -- t <- maybe textdecl -- (_,c) <- (content "") -- return (ExtParsedEnt t c) -- --extpe :: HParser ExtPE --extpe = do -- t <- maybe textdecl -- e <- extsubsetdecl -- return (ExtPE t e) encodingdecl :: HParser EncodingDecl encodingdecl = do (word "encoding" `onFail` word "ENCODING") tok TokEqual `onFail` failBadP "expected = in 'encoding' decl" f <- bracket (tok TokQuote) (tok TokQuote) freetext return (EncodingDecl f) --notationdecl :: HParser NotationDecl --notationdecl = do -- tok TokSpecialOpen -- word "NOTATION" -- n <- name -- e <- either externalid publicid -- tok TokAnyClose `onFail` failP "expected > terminating NOTATION decl" -- return (NOTATION n e) publicid :: HParser PublicID publicid = do word "PUBLICID" p <- pubidliteral return (PUBLICID p) entityvalue :: HParser EntityValue entityvalue = do evs <- bracket (tok TokQuote) (tok TokQuote) (many ev) return (EntityValue evs) ev :: HParser EV ev = ( freetext >>= return . EVString) `onFail` -- PEREF(EVPERef,ev) `onFail` ( reference >>= return . EVRef) attvalue :: HParser AttValue attvalue = ( do avs <- bracket (tok TokQuote) (tok TokQuote) (many (either freetext reference)) return (AttValue avs) ) `onFail` ( do v <- nmtoken s <- (tok TokPercent >> return "%") `onFail` return "" return (AttValue [Left (v++s)]) ) `onFail` ( do s <- oneOf [ tok TokPlus >> return "+" , tok TokHash >> return "#" ] v <- nmtoken return (AttValue [Left (s++v)]) ) `onFail` failP "Badly formatted attribute value" systemliteral :: HParser SystemLiteral systemliteral = do s <- bracket (tok TokQuote) (tok TokQuote) freetext return (SystemLiteral s) -- note: need to fold &...; escapes pubidliteral :: HParser PubidLiteral pubidliteral = do s <- bracket (tok TokQuote) (tok TokQuote) freetext return (PubidLiteral s) -- note: need to fold &...; escapes chardata :: HParser CharData chardata = freetext -- >>= return . CharData hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Escape.hs0000644006511100651110000002311110504340466022472 0ustar rossross{- This module contains code for escaping/unescaping text in attributes and elements in the HaXml Element type, replacing characters by character references or vice-versa. Two uses are envisaged for this: (1) stopping HaXml generating incorrect XML when a character is included which is also the appropriate XML terminating character, for example when an attribute includes a double quote. (2) representing XML which contains non-ASCII characters as ASCII. -} module Text.XML.HaXml.Escape( xmlEscape, -- :: XmlEscaper -> Element i -> Element i xmlUnEscape, -- :: XmlEscaper -> Element i -> Element i xmlEscapeContent, -- :: XmlEscaper -> [Content i] -> [Content i] XmlEscaper, -- Something describing a particular set of escapes. stdXmlEscaper, -- Standard boilerplate escaper, escaping everything that is -- nonprintable, non-ASCII, or might conceivably cause problems by -- parsing XML, for example quotes, < signs, and ampersands. mkXmlEscaper, -- :: [(Char,String)] -> (Char -> Bool) -> XmlEscaper -- The first argument contains a list of characters, with their -- corresponding character reference names. -- For example [('\60',"lt"),('\62',"gt"),('\38',"amp"), -- ('\39',"apos"),('\34',"quot")] will give you the "standard" -- XML escapes listed in section 4.6 of the XML standard, so that -- """ will automatically get translated into a double -- quotation mark. -- -- It's the caller's responsibility to see that the reference -- names ("lt","gt","amp","apos" and "quot" in the above example) -- are valid XML reference names. A sequence of letters, digits, -- "." or ":" characters should be fine so long as the first one -- isn't a digit. -- -- The second argument is a function applied to each text character. -- If it returns True, that means we should escape this character. -- Policy: on escaping, we expand all characters for which the -- (Char -> Bool) function returns True, either giving the corresponding -- character reference name if one was supplied, or else using a -- hexadecimal CharRef. -- -- on unescaping, we translate all the references we understand -- (hexadecimal,decimal, and the ones in the [(Char,String)] list, -- and leave the others alone. ) where import Char import Numeric import Text.XML.HaXml.Types #if __GLASGOW_HASKELL__ >= 604 || __NHC__ >= 118 || defined(__HUGS__) -- emulate older finite map interface using Data.Map, if it is available import qualified Data.Map as Map type FiniteMap a b = Map.Map a b listToFM :: Ord a => [(a,b)] -> FiniteMap a b listToFM = Map.fromList lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b lookupFM = flip Map.lookup #elif __GLASGOW_HASKELL__ >= 504 || __NHC__ > 114 -- real finite map, if it is available import Data.FiniteMap #else -- otherwise, a very simple and inefficient implementation of a finite map type FiniteMap a b = [(a,b)] listToFM :: Eq a => [(a,b)] -> FiniteMap a b listToFM = id lookupFM :: Eq a => FiniteMap a b -> a -> Maybe b lookupFM fm k = lookup k fm #endif -- ------------------------------------------------------------------------ -- Data types -- ------------------------------------------------------------------------ data XmlEscaper = XmlEscaper { toEscape :: FiniteMap Char String, fromEscape :: FiniteMap String Char, isEscape :: Char -> Bool } -- ------------------------------------------------------------------------ -- Escaping -- ------------------------------------------------------------------------ xmlEscape :: XmlEscaper -> Element i -> Element i xmlEscape xmlEscaper element = compressElement (escapeElement xmlEscaper element) xmlEscapeContent :: XmlEscaper -> [Content i] -> [Content i] xmlEscapeContent xmlEscaper cs = compressContent (escapeContent xmlEscaper cs) escapeElement :: XmlEscaper -> Element i -> Element i escapeElement xmlEscaper (Elem name attributes content) = Elem name (escapeAttributes xmlEscaper attributes) (escapeContent xmlEscaper content) escapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute] escapeAttributes xmlEscaper atts = map (\ (name,av) -> (name,escapeAttValue xmlEscaper av)) atts escapeAttValue :: XmlEscaper -> AttValue -> AttValue escapeAttValue xmlEscaper (AttValue attValList) = AttValue ( concat ( map (\ av -> case av of Right ref -> [av] Left s -> map (\ c -> if isEscape xmlEscaper c then Right (mkEscape xmlEscaper c) else Left [c] ) s ) attValList ) ) escapeContent :: XmlEscaper -> [Content i] -> [Content i] escapeContent xmlEscaper contents = concat (map (\ content -> case content of (CString b str i) -> map (\ c -> if isEscape xmlEscaper c then CRef (mkEscape xmlEscaper c) i else CString b [c] i ) str (CElem elem i) -> [CElem (escapeElement xmlEscaper elem) i] _ -> [content] ) contents ) mkEscape :: XmlEscaper -> Char -> Reference mkEscape (XmlEscaper {toEscape = toEscape}) ch = case lookupFM toEscape ch of Nothing -> RefChar (ord ch) Just str -> RefEntity str where showHex = showIntAtBase 16 intToDigit -- It should be, but in GHC it isn't. -- ------------------------------------------------------------------------ -- Unescaping -- ------------------------------------------------------------------------ xmlUnEscape :: XmlEscaper -> Element i -> Element i xmlUnEscape xmlEscaper element = compressElement (unEscapeElement xmlEscaper element) unEscapeElement :: XmlEscaper -> Element i -> Element i unEscapeElement xmlEscaper (Elem name attributes content) = Elem name (unEscapeAttributes xmlEscaper attributes) (unEscapeContent xmlEscaper content) unEscapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute] unEscapeAttributes xmlEscaper atts = map (\ (name,av) -> (name,unEscapeAttValue xmlEscaper av)) atts unEscapeAttValue :: XmlEscaper -> AttValue -> AttValue unEscapeAttValue xmlEscaper (AttValue attValList) = AttValue ( map (\ av -> case av of Left s -> av Right ref -> case unEscapeChar xmlEscaper ref of Just c -> Left [c] Nothing -> av ) attValList ) unEscapeContent :: XmlEscaper -> [Content i] -> [Content i] unEscapeContent xmlEscaper content = map (\ content -> case content of CRef ref i -> case unEscapeChar xmlEscaper ref of Just c -> CString True [c] i Nothing -> content CElem elem i -> CElem (unEscapeElement xmlEscaper elem) i _ -> content ) content unEscapeChar :: XmlEscaper -> Reference -> Maybe Char unEscapeChar xmlEscaper ref = case ref of RefChar i -> Just (chr i) RefEntity name -> lookupFM (fromEscape xmlEscaper) name -- ------------------------------------------------------------------------ -- After escaping and unescaping we rebuild the lists, compressing -- adjacent identical character data. -- ------------------------------------------------------------------------ compressElement :: Element i -> Element i compressElement (Elem name attributes content) = Elem name (compressAttributes attributes) (compressContent content) compressAttributes :: [(Name,AttValue)] -> [(Name,AttValue)] compressAttributes atts = map (\ (name,av) -> (name,compressAttValue av)) atts compressAttValue :: AttValue -> AttValue compressAttValue (AttValue l) = AttValue (compress l) where compress :: [Either String Reference] -> [Either String Reference] compress [] = [] compress (Right ref : es) = Right ref : (compress es) compress ( (ls @ (Left s1)) : es) = case compress es of (Left s2 : es2) -> Left (s1 ++ s2) : es2 es2 -> ls : es2 compressContent :: [Content i] -> [Content i] compressContent [] = [] compressContent ((csb @ (CString b1 s1 i1)) : cs) = case compressContent cs of (CString b2 s2 i2) : cs2 | b1 == b2 -> CString b1 (s1 ++ s2) i1: cs2 cs2 -> csb : cs2 compressContent (CElem element i : cs) = CElem (compressElement element) i : compressContent cs compressContent (c : cs) = c : compressContent cs -- ------------------------------------------------------------------------ -- Making XmlEscaper values. -- ------------------------------------------------------------------------ stdXmlEscaper :: XmlEscaper stdXmlEscaper = mkXmlEscaper [('\60',"lt"),('\62',"gt"),('\38',"amp"),('\39',"apos"),('\34',"quot")] (\ ch -> let i = ord ch in i < 32 || i >= 127 || case ch of '\"' -> True '&' -> True '<' -> True '>' -> True _ -> False ) mkXmlEscaper :: [(Char,String)] -> (Char -> Bool) -> XmlEscaper mkXmlEscaper escapes isEscape = XmlEscaper { toEscape = listToFM escapes, fromEscape = listToFM (map (\ (c,str) -> (str,c)) escapes), isEscape = isEscape } hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Parse.hs0000644006511100651110000007346710504340466022367 0ustar rossross-- | A non-validating XML parser. For the input grammar, see -- . module Text.XML.HaXml.Parse ( -- * Parse a whole document xmlParse, xmlParse' -- * Parse just a DTD , dtdParse, dtdParse' -- * Parse a partial document , xmlParseWith -- * Individual parsers for use with /xmlParseWith/ and module SAX , document, element, content , comment, cdsect, chardata , reference, doctypedecl , processinginstruction , elemtag, name, tok , elemOpenTag, elemCloseTag , emptySTs, XParser -- * These general utility functions don't belong here , fst3, snd3, thd3 ) where -- An XML parser, written using a slightly extended version of the -- Hutton/Meijer parser combinators. The input is tokenised internally -- by the lexer xmlLex. Whilst parsing, we gather a symbol -- table of entity references. PERefs must be defined before use, so we -- expand their uses as we encounter them, forcing the remainder of the -- input to be re-lexed and re-parsed. GERefs are simply stored for -- later retrieval. import Prelude hiding (either,maybe,sequence) import qualified Prelude (either) import Maybe hiding (maybe) import List (intersperse) -- debugging only import Char (isSpace,isDigit,isHexDigit) import Monad hiding (sequence) import Numeric (readDec,readHex) import Text.XML.HaXml.Types import Text.XML.HaXml.Posn import Text.XML.HaXml.Lex import Text.ParserCombinators.PolyState #if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \ ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__) import System.IO.Unsafe (unsafePerformIO) #elif defined(__GLASGOW_HASKELL__) import IOExts (unsafePerformIO) #elif defined(__NHC__) import IOExtras (unsafePerformIO) #elif defined(__HBC__) import UnsafePerformIO #endif -- #define DEBUG #if defined(DEBUG) # if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \ ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__) import Debug.Trace(trace) # elif defined(__GLASGOW_HASKELL__) import IOExts(trace) # elif defined(__NHC__) || defined(__HBC__) import NonStdTrace # endif debug :: a -> String -> a v `debug` s = trace s v #else v `debug` s = v #endif -- | To parse a whole document, @xmlParse file content@ takes a filename -- (for generating error reports) and the string content of that file. -- A parse error causes program failure, with message to stderr. xmlParse :: String -> String -> Document Posn -- | To parse a whole document, @xmlParse' file content@ takes a filename -- (for generating error reports) and the string content of that file. -- Any parse error message is passed back to the caller through the -- @Either@ type. xmlParse' :: String -> String -> Either String (Document Posn) -- | To parse just a DTD, @dtdParse file content@ takes a filename -- (for generating error reports) and the string content of that -- file. If no DTD was found, you get @Nothing@ rather than an error. -- However, if a DTD is found but contains errors, the program crashes. dtdParse :: String -> String -> Maybe DocTypeDecl -- | To parse just a DTD, @dtdParse' file content@ takes a filename -- (for generating error reports) and the string content of that -- file. If no DTD was found, you get @Right Nothing@. -- If a DTD was found but contains errors, you get a @Left message@. dtdParse' :: String -> String -> Either String (Maybe DocTypeDecl) xmlParse name = Prelude.either error id . xmlParse' name dtdParse name = Prelude.either error id . dtdParse' name xmlParse' name = fst3 . runParser (toEOF document) emptySTs . xmlLex name dtdParse' name = fst3 . runParser justDTD emptySTs . xmlLex name toEOF = id -- there are other possible implementations... -- | To parse a partial document, e.g. from an XML-based stream protocol, -- where you may later want to get more document elements from the same -- stream. Arguments are: a parser for the item you want, and the -- already-lexed input to parse from. Returns the item you wanted -- (or an error message), plus the remainder of the input. xmlParseWith :: XParser a -> [(Posn,TokenT)] -> (Either String a, [(Posn,TokenT)]) xmlParseWith p = (\(v,_,s)->(v,s)) . runParser p emptySTs ---- Symbol table stuff ---- type SymTabs = (SymTab PEDef, SymTab EntityDef) -- | Some empty symbol tables for GE and PE references. emptySTs :: SymTabs emptySTs = (emptyST, emptyST) addPE :: String -> PEDef -> SymTabs -> SymTabs addPE n v (pe,ge) = (addST n v pe, ge) addGE :: String -> EntityDef -> SymTabs -> SymTabs addGE n v (pe,ge) = let newge = addST n v ge in newge `seq` (pe, newge) lookupPE :: String -> SymTabs -> Maybe PEDef lookupPE s (pe,ge) = lookupST s pe flattenEV :: EntityValue -> String flattenEV (EntityValue evs) = concatMap flatten evs where flatten (EVString s) = s flatten (EVRef (RefEntity r)) = "&" ++r++";" flatten (EVRef (RefChar r)) = "&#"++show r++";" -- flatten (EVPERef n) = "%" ++n++";" ---- Misc ---- fst3 :: (a,b,c) -> a snd3 :: (a,b,c) -> b thd3 :: (a,b,c) -> c fst3 (a,_,_) = a snd3 (_,a,_) = a thd3 (_,_,a) = a ---- Auxiliary Parsing Functions ---- -- | XParser is just a specialisation of the PolyState parser. type XParser a = Parser SymTabs (Posn,TokenT) a -- | Return the next token from the input only if it matches the given token. tok :: TokenT -> XParser TokenT tok t = do (p,t') <- next case t' of TokError _ -> report failBad (show t) p t' _ | t'==t -> return t | otherwise -> report fail (show t) p t' nottok :: [TokenT] -> XParser TokenT nottok ts = do (p,t) <- next if t`elem`ts then report fail ("no "++show t) p t else return t -- | Return just a name, e.g. element name, attribute name. name :: XParser Name name = do (p,tok) <- next case tok of TokName s -> return s TokError _ -> report failBad "a name" p tok _ -> report fail "a name" p tok string, freetext :: XParser String string = do (p,t) <- next case t of TokName s -> return s _ -> report fail "text" p t freetext = do (p,t) <- next case t of TokFreeText s -> return s _ -> report fail "text" p t maybe :: XParser a -> XParser (Maybe a) maybe p = ( p >>= return . Just) `onFail` ( return Nothing) either :: XParser a -> XParser b -> XParser (Either a b) either p q = ( p >>= return . Left) `onFail` ( q >>= return . Right) word :: String -> XParser () word s = do { x <- next ; case x of (p,TokName n) | s==n -> return () (p,TokFreeText n) | s==n -> return () (p,t@(TokError _)) -> report failBad (show s) p t (p,t) -> report fail (show s) p t } posn = do { x@(p,_) <- next ; reparse [x] ; return p } nmtoken :: XParser NmToken nmtoken = (string `onFail` freetext) failP, failBadP :: String -> XParser a failP msg = do { p <- posn; fail (msg++"\n at "++show p) } failBadP msg = do { p <- posn; failBad (msg++"\n at "++show p) } report :: (String->XParser a) -> String -> Posn -> TokenT -> XParser a report fail exp p t = fail ("Expected "++exp++" but found "++show t ++"\n in "++show p) adjustErrP :: XParser a -> (String->String) -> XParser a p `adjustErrP` f = p `onFail` do pn <- posn (p `adjustErr` f) `adjustErr` (++show pn) peRef :: XParser a -> XParser a peRef p = p `onFail` do pn <- posn n <- pereference tr <- stQuery (lookupPE n) `debug` ("Looking up %"++n) case tr of Just (PEDefEntityValue ev) -> do reparse (xmlReLex (posInNewCxt ("macro %"++n++";") (Just pn)) (flattenEV ev)) `debug` (" defn: "++flattenEV ev) peRef p Just (PEDefExternalID (PUBLIC _ (SystemLiteral f))) -> do let val = unsafePerformIO (readFile f) reparse (xmlReLex (posInNewCxt ("file "++f) (Just pn)) val) `debug` (" reading from file "++f) peRef p Just (PEDefExternalID (SYSTEM (SystemLiteral f))) -> do let val = unsafePerformIO (readFile f) reparse (xmlReLex (posInNewCxt ("file "++f) (Just pn)) val) `debug` (" reading from file "++f) peRef p Nothing -> fail ("PEReference use before definition: "++"%"++n++";" ++"\n at "++show pn) blank :: XParser a -> XParser a blank p = p `onFail` do n <- pereference tr <- stQuery (lookupPE n) `debug` ("Looking up %"++n++" (is blank?)") case tr of Just (PEDefEntityValue ev) | all isSpace (flattenEV ev) -> do blank p `debug` "Empty macro definition" Just _ -> failP ("expected a blank PERef macro: "++"%"++n++";") Nothing -> failP ("PEReference use before definition: "++"%"++n++";") ---- XML Parsing Functions ---- justDTD :: XParser (Maybe DocTypeDecl) justDTD = do (ExtSubset _ ds) <- extsubset `debug` "Trying external subset" if null ds then fail "empty" else return (Just (DTD "extsubset" Nothing (concatMap extract ds))) `onFail` do (Prolog _ _ dtd _) <- prolog return dtd where extract (ExtMarkupDecl m) = [m] extract (ExtConditionalSect (IncludeSect i)) = concatMap extract i extract (ExtConditionalSect (IgnoreSect i)) = [] -- | Return an entire XML document including prolog and trailing junk. document :: XParser (Document Posn) document = do p <- prolog `adjustErr` ("unrecognisable XML prolog\n"++) e <- element ms <- many misc (_,ge) <- stGet return (Document p ge e ms) -- | Return an XML comment. comment :: XParser Comment comment = do bracket (tok TokCommentOpen) (tok TokCommentClose) freetext -- tok TokCommentOpen -- commit $ do -- c <- freetext -- tok TokCommentClose -- return c -- | Parse a processing instruction. processinginstruction :: XParser ProcessingInstruction processinginstruction = do tok TokPIOpen commit $ do n <- string `onFail` failP "processing instruction has no target" f <- freetext tok TokPIClose `onFail` failP ("missing ?> in in " raise ((runParser aux emptySTs . xmlReLex p) s) where aux = do v <- versioninfo `onFail` failP "missing XML version info" e <- maybe encodingdecl s <- maybe sddecl return (XMLDecl v e s) raise (Left err, _, _) = failP err raise (Right ok, _, _) = return ok versioninfo :: XParser VersionInfo versioninfo = do (word "version" `onFail` word "VERSION") tok TokEqual bracket (tok TokQuote) (tok TokQuote) freetext misc :: XParser Misc misc = oneOf' [ ("", comment >>= return . Comment) , ("", processinginstruction >>= return . PI) ] -- | Return a DOCTYPE decl, indicating a DTD. doctypedecl :: XParser DocTypeDecl doctypedecl = do tok TokSpecialOpen tok (TokSpecial DOCTYPEx) commit $ do n <- name eid <- maybe externalid es <- maybe (bracket (tok TokSqOpen) (tok TokSqClose) (many (peRef markupdecl))) blank (tok TokAnyClose) `onFail` failP "missing > in DOCTYPE decl" return (DTD n eid (case es of { Nothing -> []; Just e -> e })) -- | Return a DTD markup decl, e.g. ELEMENT, ATTLIST, etc markupdecl :: XParser MarkupDecl markupdecl = oneOf' [ ("ELEMENT", elementdecl >>= return . Element) , ("ATTLIST", attlistdecl >>= return . AttList) , ("ENTITY", entitydecl >>= return . Entity) , ("NOTATION", notationdecl >>= return . Notation) , ("misc", misc >>= return . MarkupMisc) ] `adjustErrP` ("when looking for a markup decl,\n"++) -- (\ (ELEMENT, ATTLIST, ENTITY, NOTATION, , or ") extsubset :: XParser ExtSubset extsubset = do td <- maybe textdecl ds <- many (peRef extsubsetdecl) return (ExtSubset td ds) extsubsetdecl :: XParser ExtSubsetDecl extsubsetdecl = ( markupdecl >>= return . ExtMarkupDecl) `onFail` ( conditionalsect >>= return . ExtConditionalSect) sddecl :: XParser SDDecl sddecl = do (word "standalone" `onFail` word "STANDALONE") commit $ do tok TokEqual `onFail` failP "missing = in 'standalone' decl" bracket (tok TokQuote) (tok TokQuote) ( (word "yes" >> return True) `onFail` (word "no" >> return False) `onFail` failP "'standalone' decl requires 'yes' or 'no' value" ) {- element :: XParser (Element Posn) element = do tok TokAnyOpen (ElemTag n as) <- elemtag oneOf' [ ("self-closing tag <"++n++"/>" , do tok TokEndClose return (Elem n as [])) , ("after open tag <"++n++">" , do tok TokAnyClose cs <- many content p <- posn m <- bracket (tok TokEndOpen) (tok TokAnyClose) name checkmatch p n m return (Elem n as cs)) ] `adjustErr` (("in element tag "++n++",\n")++) -} -- | Return a complete element including all its inner content. element :: XParser (Element Posn) element = do tok TokAnyOpen (ElemTag n as) <- elemtag ( do tok TokEndClose return (Elem n as []) `onFail` do tok TokAnyClose cs <- manyFinally content (do p <- posn m <- bracket (tok TokEndOpen) (tok TokAnyClose) name checkmatch p n m) return (Elem n as cs) ) `adjustErrBad` (("in element tag "++n++",\n")++) checkmatch :: Posn -> Name -> Name -> XParser () checkmatch p n m = if n == m then return () else failBadP ("tag <"++n++"> terminated by ") -- | Parse only the parts between angle brackets in an element tag. elemtag :: XParser ElemTag elemtag = do n <- name `adjustErrBad` ("malformed element tag\n"++) as <- many attribute return (ElemTag n as) -- | For use with stream parsers - returns the complete opening element tag. elemOpenTag :: XParser ElemTag elemOpenTag = do tok TokAnyOpen e <- elemtag tok TokAnyClose return e -- | For use with stream parsers - accepts a closing tag, provided it -- matches the given element name. elemCloseTag :: Name -> XParser () elemCloseTag n = do tok TokEndOpen p <- posn m <- name tok TokAnyClose checkmatch p n m attribute :: XParser Attribute attribute = do n <- name `adjustErr` ("malformed attribute name\n"++) tok TokEqual `onFail` failBadP "missing = in attribute" v <- attvalue `onFail` failBadP "missing attvalue" return (n,v) -- | Return a content particle, e.g. text, element, reference, etc content :: XParser (Content Posn) content = do { p <- posn ; c' <- content' ; return (c' p) } where content' = oneOf' [ ("element", element >>= return . CElem) , ("chardata", chardata >>= return . CString False) , ("reference", reference >>= return . CRef) , ("CDATA", cdsect >>= return . CString True) , ("misc", misc >>= return . CMisc) ] `adjustErrP` ("when looking for a content item,\n"++) -- (\ (element, text, reference, CDATA section, , or ") elementdecl :: XParser ElementDecl elementdecl = do tok TokSpecialOpen tok (TokSpecial ELEMENTx) n <- peRef name `adjustErrBad` ("expecting identifier in ELEMENT decl\n"++) c <- peRef contentspec `adjustErrBad` (("in content spec of ELEMENT decl: "++n++"\n")++) blank (tok TokAnyClose) `onFail` failBadP ("expected > terminating ELEMENT decl" ++"\n element name was "++show n ++"\n contentspec was "++(\ (ContentSpec p)-> show p) c) return (ElementDecl n c) contentspec :: XParser ContentSpec contentspec = oneOf' [ ("EMPTY", peRef (word "EMPTY") >> return EMPTY) , ("ANY", peRef (word "ANY") >> return ANY) , ("mixed", peRef mixed >>= return . Mixed) , ("simple", peRef cp >>= return . ContentSpec) ] -- `adjustErr` ("when looking for content spec,\n"++) -- `adjustErr` (++"\nLooking for content spec (EMPTY, ANY, mixed, etc)") choice :: XParser [CP] choice = do bracket (tok TokBraOpen `debug` "Trying choice") (blank (tok TokBraClose `debug` "Succeeded with choice")) (peRef cp `sepBy1` blank (tok TokPipe)) sequence :: XParser [CP] sequence = do -- bracket is inappropriate because of inner failBad -- bracket (tok TokBraOpen `debug` "Trying sequence") -- (blank (tok TokBraClose `debug` "Succeeded with sequence")) -- (peRef cp `sepBy1` blank (tok TokComma)) tok TokBraOpen `debug` "Trying sequence" cps <- peRef cp `sepBy1` blank (tok TokComma) blank (tok TokBraClose `debug` "Succeeded with sequence") return cps cp :: XParser CP cp = oneOf [ ( do n <- name m <- modifier let c = TagName n m return c `debug` ("ContentSpec: name "++show c)) , ( do ss <- sequence m <- modifier let c = Seq ss m return c `debug` ("ContentSpec: sequence "++show c)) , ( do cs <- choice m <- modifier let c = Choice cs m return c `debug` ("ContentSpec: choice "++show c)) ] `adjustErr` (++"\nwhen looking for a content particle") modifier :: XParser Modifier modifier = oneOf [ ( tok TokStar >> return Star ) , ( tok TokQuery >> return Query ) , ( tok TokPlus >> return Plus ) , ( return None ) ] -- just for debugging instance Show CP where show (TagName n m) = n++show m show (Choice cps m) = '(': concat (intersperse "|" (map show cps)) ++")"++show m show (Seq cps m) = '(': concat (intersperse "," (map show cps)) ++")"++show m instance Show Modifier where show None = "" show Query = "?" show Star = "*" show Plus = "+" ---- mixed :: XParser Mixed mixed = do tok TokBraOpen peRef (do tok TokHash word "PCDATA") commit $ oneOf [ ( do cs <- many (peRef (do tok TokPipe peRef name)) blank (tok TokBraClose >> tok TokStar) return (PCDATAplus cs)) , ( blank (tok TokBraClose >> tok TokStar) >> return PCDATA) , ( blank (tok TokBraClose) >> return PCDATA) ] `adjustErrP` (++"\nLooking for mixed content spec (#PCDATA | ...)*\n") attlistdecl :: XParser AttListDecl attlistdecl = do tok TokSpecialOpen tok (TokSpecial ATTLISTx) n <- peRef name `adjustErrBad` ("expecting identifier in ATTLIST\n"++) ds <- peRef (many1 (peRef attdef)) blank (tok TokAnyClose) `onFail` failBadP "missing > terminating ATTLIST" return (AttListDecl n ds) attdef :: XParser AttDef attdef = do n <- peRef name `adjustErr` ("expecting attribute name\n"++) t <- peRef atttype `adjustErr` (("within attlist defn: "++n++",\n")++) d <- peRef defaultdecl `adjustErr` (("in attlist defn: "++n++",\n")++) return (AttDef n t d) atttype :: XParser AttType atttype = oneOf' [ ("CDATA", word "CDATA" >> return StringType) , ("tokenized", tokenizedtype >>= return . TokenizedType) , ("enumerated", enumeratedtype >>= return . EnumeratedType) ] `adjustErr` ("looking for ATTTYPE,\n"++) -- `adjustErr` (++"\nLooking for ATTTYPE (CDATA, tokenized, or enumerated") tokenizedtype :: XParser TokenizedType tokenizedtype = oneOf [ ( word "ID" >> return ID) , ( word "IDREF" >> return IDREF) , ( word "IDREFS" >> return IDREFS) , ( word "ENTITY" >> return ENTITY) , ( word "ENTITIES" >> return ENTITIES) , ( word "NMTOKEN" >> return NMTOKEN) , ( word "NMTOKENS" >> return NMTOKENS) ] `onFail` do { t <- next ; failP ("Expected one of" ++" (ID, IDREF, IDREFS, ENTITY, ENTITIES, NMTOKEN, NMTOKENS)" ++"\nbut got "++show t) } -- `adjustErr` (++"\nLooking for a tokenized type:\n\ -- \ (ID, IDREF, IDREFS, ENTITY, ENTITIES, NMTOKEN, NMTOKENS)") enumeratedtype :: XParser EnumeratedType enumeratedtype = oneOf' [ ("NOTATION", notationtype >>= return . NotationType) , ("enumerated", enumeration >>= return . Enumeration) ] `adjustErr` ("looking for an enumerated or NOTATION type,\n"++) notationtype :: XParser NotationType notationtype = do word "NOTATION" bracket (tok TokBraOpen) (blank (tok TokBraClose)) (peRef name `sepBy1` peRef (tok TokPipe)) enumeration :: XParser Enumeration enumeration = bracket (tok TokBraOpen) (blank (tok TokBraClose)) (peRef nmtoken `sepBy1` blank (peRef (tok TokPipe))) defaultdecl :: XParser DefaultDecl defaultdecl = oneOf' [ ("REQUIRED", tok TokHash >> word "REQUIRED" >> return REQUIRED) , ("IMPLIED", tok TokHash >> word "IMPLIED" >> return IMPLIED) , ("FIXED", do f <- maybe (tok TokHash >> word "FIXED" >> return FIXED) a <- peRef attvalue return (DefaultTo a f) ) ] `adjustErr` ("looking for an attribute default decl,\n"++) -- `adjustErr` (++"\nLooking for an attribute default decl:\n\ -- \ (REQUIRED, IMPLIED, FIXED)") conditionalsect :: XParser ConditionalSect conditionalsect = oneOf' [ ( "INCLUDE" , do tok TokSectionOpen peRef (tok (TokSection INCLUDEx)) p <- posn tok TokSqOpen `onFail` failBadP "missing [ after INCLUDE" i <- many (peRef extsubsetdecl) tok TokSectionClose `onFail` failBadP ("missing ]]> for INCLUDE section" ++"\n begun at "++show p) return (IncludeSect i)) , ( "IGNORE" , do tok TokSectionOpen peRef (tok (TokSection IGNOREx)) p <- posn tok TokSqOpen `onFail` failBadP "missing [ after IGNORE" i <- many newIgnore -- many ignoresectcontents tok TokSectionClose `onFail` failBadP ("missing ]]> for IGNORE section" ++"\n begun at "++show p) return (IgnoreSect [])) ] `adjustErr` ("in a conditional section,\n"++) newIgnore :: XParser Ignore newIgnore = ( do tok TokSectionOpen many newIgnore `debug` "IGNORING conditional section" tok TokSectionClose return Ignore `debug` "end of IGNORED conditional section") `onFail` ( do t <- nottok [TokSectionOpen,TokSectionClose] return Ignore `debug` ("ignoring: "++show t)) --- obsolete? ignoresectcontents :: XParser IgnoreSectContents ignoresectcontents = do i <- ignore is <- many (do tok TokSectionOpen ic <- ignoresectcontents tok TokSectionClose ig <- ignore return (ic,ig)) return (IgnoreSectContents i is) ignore :: XParser Ignore ignore = do is <- many1 (nottok [TokSectionOpen,TokSectionClose]) return Ignore `debug` ("ignored all of: "++show is) ---- -- | Return either a general entity reference, or a character reference. reference :: XParser Reference reference = do bracket (tok TokAmp) (tok TokSemi) (freetext >>= val) where val ('#':'x':i) | all isHexDigit i = return . RefChar . fst . head . readHex $ i val ('#':i) | all isDigit i = return . RefChar . fst . head . readDec $ i val name = return . RefEntity $ name {- -- following is incorrect reference = ( charref >>= return . RefChar) `onFail` ( entityref >>= return . RefEntity) entityref :: XParser EntityRef entityref = do bracket (tok TokAmp) (tok TokSemi) name charref :: XParser CharRef charref = do bracket (tok TokAmp) (tok TokSemi) (freetext >>= readCharVal) where readCharVal ('#':'x':i) = return . fst . head . readHex $ i readCharVal ('#':i) = return . fst . head . readDec $ i readCharVal _ = mzero -} pereference :: XParser PEReference pereference = do bracket (tok TokPercent) (tok TokSemi) nmtoken entitydecl :: XParser EntityDecl entitydecl = ( gedecl >>= return . EntityGEDecl) `onFail` ( pedecl >>= return . EntityPEDecl) gedecl :: XParser GEDecl gedecl = do tok TokSpecialOpen tok (TokSpecial ENTITYx) n <- name e <- entitydef `adjustErrBad` (("in general entity defn "++n++",\n")++) tok TokAnyClose `onFail` failBadP ("expected > terminating G ENTITY decl "++n) stUpdate (addGE n e) `debug` ("added GE defn &"++n++";") return (GEDecl n e) pedecl :: XParser PEDecl pedecl = do tok TokSpecialOpen tok (TokSpecial ENTITYx) tok TokPercent n <- name e <- pedef `adjustErrBad` (("in parameter entity defn "++n++",\n")++) tok TokAnyClose `onFail` failBadP ("expected > terminating P ENTITY decl "++n) stUpdate (addPE n e) `debug` ("added PE defn %"++n++";\n"++show e) return (PEDecl n e) entitydef :: XParser EntityDef entitydef = oneOf' [ ("entityvalue", entityvalue >>= return . DefEntityValue) , ("external", do eid <- externalid ndd <- maybe ndatadecl return (DefExternalID eid ndd)) ] pedef :: XParser PEDef pedef = oneOf' [ ("entityvalue", entityvalue >>= return . PEDefEntityValue) , ("externalid", externalid >>= return . PEDefExternalID) ] externalid :: XParser ExternalID externalid = oneOf' [ ("SYSTEM", do word "SYSTEM" s <- systemliteral return (SYSTEM s) ) , ("PUBLIC", do word "PUBLIC" p <- pubidliteral s <- systemliteral return (PUBLIC p s) ) ] `adjustErr` ("looking for an external id,\n"++) ndatadecl :: XParser NDataDecl ndatadecl = do word "NDATA" n <- name return (NDATA n) textdecl :: XParser TextDecl textdecl = do tok TokPIOpen (word "xml" `onFail` word "XML") v <- maybe versioninfo e <- encodingdecl tok TokPIClose `onFail` failP "expected ?> terminating text decl" return (TextDecl v e) extparsedent :: XParser (ExtParsedEnt Posn) extparsedent = do t <- maybe textdecl c <- content return (ExtParsedEnt t c) extpe :: XParser ExtPE extpe = do t <- maybe textdecl e <- many (peRef extsubsetdecl) return (ExtPE t e) encodingdecl :: XParser EncodingDecl encodingdecl = do (word "encoding" `onFail` word "ENCODING") tok TokEqual `onFail` failBadP "expected = in 'encoding' decl" f <- bracket (tok TokQuote) (tok TokQuote) freetext return (EncodingDecl f) notationdecl :: XParser NotationDecl notationdecl = do tok TokSpecialOpen tok (TokSpecial NOTATIONx) n <- name e <- either externalid publicid tok TokAnyClose `onFail` failBadP ("expected > terminating NOTATION decl "++n) return (NOTATION n e) publicid :: XParser PublicID publicid = do word "PUBLIC" p <- pubidliteral return (PUBLICID p) entityvalue :: XParser EntityValue entityvalue = do -- evs <- bracket (tok TokQuote) (tok TokQuote) (many (peRef ev)) tok TokQuote pn <- posn evs <- many ev tok TokQuote `onFail` failBadP "expected quote to terminate entityvalue" -- quoted text must be rescanned for possible PERefs st <- stGet Prelude.either failBad (return . EntityValue) . fst3 $ (runParser (many ev) st (reLexEntityValue (\s-> stringify (lookupPE s st)) pn (flattenEV (EntityValue evs)))) where stringify (Just (PEDefEntityValue ev)) = Just (flattenEV ev) stringify _ = Nothing ev :: XParser EV ev = oneOf' [ ("string", (string`onFail`freetext) >>= return . EVString) , ("reference", reference >>= return . EVRef) ] `adjustErr` ("looking for entity value,\n"++) attvalue :: XParser AttValue attvalue = do avs <- bracket (tok TokQuote) (tok TokQuote) (many (either freetext reference)) return (AttValue avs) systemliteral :: XParser SystemLiteral systemliteral = do s <- bracket (tok TokQuote) (tok TokQuote) freetext return (SystemLiteral s) -- note: refs &...; not permitted pubidliteral :: XParser PubidLiteral pubidliteral = do s <- bracket (tok TokQuote) (tok TokQuote) freetext return (PubidLiteral s) -- note: freetext is too liberal here -- | Return parsed freetext (i.e. until the next markup) chardata :: XParser CharData chardata = freetext hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Lex.hs0000644006511100651110000003503510504340466022032 0ustar rossross-- | You don't normally need to use this Lex module directly - it is -- called automatically by the parser. (This interface is only exposed -- for debugging purposes.) -- -- This is a hand-written lexer for tokenising the text of an XML -- document so that it is ready for parsing. It attaches position -- information in (line,column) format to every token. The main -- entry point is 'xmlLex'. A secondary entry point, 'xmlReLex', is -- provided for when the parser needs to stuff a string back onto -- the front of the text and re-tokenise it (typically when expanding -- macros). -- -- As one would expect, the lexer is essentially a small finite -- state machine. module Text.XML.HaXml.Lex ( -- * Entry points to the lexer xmlLex -- :: String -> String -> [Token] , xmlReLex -- :: Posn -> String -> [Token] , reLexEntityValue -- :: (String->Maybe String) -> Posn -> String -> [Token] -- * Token types , Token , TokenT(..) , Special(..) , Section(..) ) where import Char import Text.XML.HaXml.Posn data Where = InTag String | NotInTag deriving (Eq) -- | All tokens are paired up with a source position. -- Lexical errors are passed back as a special @TokenT@ value. type Token = (Posn, TokenT) -- | The basic token type. data TokenT = TokCommentOpen -- ^ \ | TokPIOpen -- ^ \ | TokSectionOpen -- ^ \ | TokSection Section -- ^ CDATA INCLUDE IGNORE etc | TokSpecialOpen -- ^ \ | TokAnyOpen -- ^ \< | TokAnyClose -- ^ > | TokSqOpen -- ^ \[ | TokSqClose -- ^ \] | TokEqual -- ^ = | TokQuery -- ^ ? | TokStar -- ^ \* | TokPlus -- ^ + | TokAmp -- ^ & | TokSemi -- ^ ; | TokHash -- ^ # | TokBraOpen -- ^ ( | TokBraClose -- ^ ) | TokPipe -- ^ | | TokPercent -- ^ % | TokComma -- ^ , | TokQuote -- ^ \'\' or \"\" | TokName String -- ^ begins with letter, no spaces | TokFreeText String -- ^ any character data | TokNull -- ^ fake token | TokError String -- ^ lexical error deriving (Eq) data Special = DOCTYPEx | ELEMENTx | ATTLISTx | ENTITYx | NOTATIONx deriving (Eq,Show) data Section = CDATAx | INCLUDEx | IGNOREx deriving (Eq,Show) instance Show TokenT where showsPrec p TokCommentOpen = showString "" showsPrec p TokPIOpen = showString "" showsPrec p TokSectionOpen = showString "" showsPrec p (TokSection s) = showsPrec p s showsPrec p TokSpecialOpen = showString "" showsPrec p TokAnyOpen = showString "<" showsPrec p TokAnyClose = showString ">" showsPrec p TokSqOpen = showString "[" showsPrec p TokSqClose = showString "]" showsPrec p TokEqual = showString "=" showsPrec p TokQuery = showString "?" showsPrec p TokStar = showString "*" showsPrec p TokPlus = showString "+" showsPrec p TokAmp = showString "&" showsPrec p TokSemi = showString ";" showsPrec p TokHash = showString "#" showsPrec p TokBraOpen = showString "(" showsPrec p TokBraClose = showString ")" showsPrec p TokPipe = showString "|" showsPrec p TokPercent = showString "%" showsPrec p TokComma = showString "," showsPrec p TokQuote = showString "' or \"" showsPrec p (TokName s) = showString s showsPrec p (TokFreeText s) = showString s showsPrec p TokNull = showString "(null)" showsPrec p (TokError s) = showString s --trim, revtrim :: String -> String --trim = f . f where f = reverse . dropWhile isSpace --revtrim = f.reverse.f where f = dropWhile isSpace --revtrim = reverse . dropWhile (=='\n') -- most recently used defn. emit :: TokenT -> Posn -> Token emit tok p = forcep p `seq` (p,tok) lexerror :: String -> Posn -> [Token] lexerror s p = [(p, TokError ("Lexical error:\n "++s))] skip :: Int -> Posn -> String -> (Posn->String->[Token]) -> [Token] skip n p s k = k (addcol n p) (drop n s) blank :: ([Where]->Posn->String->[Token]) -> [Where]-> Posn-> String-> [Token] blank k (InTag t:_) p [] = lexerror ("unexpected EOF within "++t) p blank k _ p [] = [] blank k w p (' ': s) = blank k w (addcol 1 p) s blank k w p ('\t':s) = blank k w (tab p) s blank k w p ('\n':s) = blank k w (newline p) s blank k w p ('\r':s) = blank k w p s blank k w p ('\xa0': s) = blank k w (addcol 1 p) s blank k w p s = k w p s prefixes :: String -> String -> Bool [] `prefixes` ys = True (x:xs) `prefixes` (y:ys) = x==y && xs `prefixes` ys (x:xs) `prefixes` [] = False --error "unexpected EOF in prefix" textUntil close tok acc pos p [] k = lexerror ("unexpected EOF while looking for closing token "++close ++"\n to match the opening token in "++show pos) p textUntil close tok acc pos p (s:ss) k | close `prefixes` (s:ss) = emit (TokFreeText (reverse acc)) pos: emit tok p: skip (length close-1) (addcol 1 p) ss k | isSpace s = textUntil close tok (s:acc) pos (white s p) ss k | otherwise = textUntil close tok (s:acc) pos (addcol 1 p) ss k textOrRefUntil close tok acc pos p [] k = lexerror ("unexpected EOF while looking for closing token "++close ++"\n to match the opening token in "++show pos) p textOrRefUntil close tok acc pos p (s:ss) k | close `prefixes` (s:ss) = emit (TokFreeText (reverse acc)) pos: emit tok p: skip (length close-1) (addcol 1 p) ss k | s=='&' = (if not (null acc) then (emit (TokFreeText (reverse acc)) pos:) else id) (emit TokAmp p: textUntil ";" TokSemi "" p (addcol 1 p) ss (\p' i-> textOrRefUntil close tok "" p p' i k)) | isSpace s = textOrRefUntil close tok (s:acc) pos (white s p) ss k | otherwise = textOrRefUntil close tok (s:acc) pos (addcol 1 p) ss k ---- -- | The first argument to 'xmlLex' is the filename (used for source positions, -- especially in error messages), and the second is the string content of -- the XML file. xmlLex :: String -> String -> [Token] xmlLex filename = xmlAny [] (posInNewCxt ("file "++filename) Nothing) -- | 'xmlReLex' is used when the parser expands a macro (PE reference). -- The expansion of the macro must be re-lexed as if for the first time. xmlReLex :: Posn -> String -> [Token] xmlReLex p s | "INCLUDE" `prefixes` s = emit (TokSection INCLUDEx) p: k 7 | "IGNORE" `prefixes` s = emit (TokSection IGNOREx) p: k 6 | otherwise = blank xmlAny [] p s where k n = skip n p s (blank xmlAny []) -- | 'reLexEntityValue' is used solely within parsing an entityvalue. -- Normally, a PERef is logically separated from its surroundings by -- whitespace. But in an entityvalue, a PERef can be juxtaposed to -- an identifier, so the expansion forms a new identifier. -- Thus the need to rescan the whole text for possible PERefs. reLexEntityValue :: (String->Maybe String) -> Posn -> String -> [Token] reLexEntityValue lookup p s = textOrRefUntil "%" TokNull [] p p (expand s++"%") (xmlAny []) where expand [] = [] expand ('%':ss) = let (sym,rest) = break (==';') ss in case lookup sym of Just val -> expand val ++ expand (tail rest) Nothing -> "%"++sym++";"++ expand (tail rest) -- hmmm expand (s:ss) = s: expand ss --xmltop :: Posn -> String -> [Token] --xmltop p [] = [] --xmltop p s -- | ""]) -- | "" TokCommentClose "" p p s (blank xmlAny w) -- Note: the order of the clauses in xmlAny is very important. -- Some matches must precede the NotInTag test, the rest must follow it. xmlAny :: [Where] -> Posn -> String -> [Token] xmlAny (InTag t:_) p [] = lexerror ("unexpected EOF within "++t) p xmlAny _ p [] = [] xmlAny w p s@('<':ss) | "?" `prefixes` ss = emit TokPIOpen p: skip 2 p s (xmlPI (InTag "":w)) | "!--" `prefixes` ss = emit TokCommentOpen p: skip 4 p s (xmlComment w) | "![" `prefixes` ss = emit TokSectionOpen p: skip 3 p s (xmlSection w) | "!" `prefixes` ss = emit TokSpecialOpen p: skip 2 p s (xmlSpecial (InTag "":w)) | "/" `prefixes` ss = emit TokEndOpen p: skip 2 p s (xmlTag (InTag "":tail w)) | otherwise = emit TokAnyOpen p: skip 1 p s (xmlTag (InTag "<...>":NotInTag:w)) xmlAny (_:_:w) p s@('/':ss) | ">" `prefixes` ss = emit TokEndClose p: skip 2 p s (xmlAny w) xmlAny w p ('&':ss) = emit TokAmp p: textUntil ";" TokSemi "" p (addcol 1 p) ss (xmlAny w) xmlAny w@(NotInTag:_) p s = xmlContent "" w p p s -- everything below here is implicitly InTag. xmlAny w p ('>':ss) = emit TokAnyClose p: xmlAny (tail w) (addcol 1 p) ss xmlAny w p ('[':ss) = emit TokSqOpen p: blank xmlAny (InTag "[...]":w) (addcol 1 p) ss xmlAny w p (']':ss) | "]>" `prefixes` ss = emit TokSectionClose p: skip 3 p (']':ss) (xmlAny (tail w)) | otherwise = emit TokSqClose p: blank xmlAny (tail w) (addcol 1 p) ss xmlAny w p ('(':ss) = emit TokBraOpen p: blank xmlAny (InTag "(...)":w) (addcol 1 p) ss xmlAny w p (')':ss) = emit TokBraClose p: blank xmlAny (tail w) (addcol 1 p) ss xmlAny w p ('=':ss) = emit TokEqual p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('*':ss) = emit TokStar p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('+':ss) = emit TokPlus p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('?':ss) = emit TokQuery p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('|':ss) = emit TokPipe p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('%':ss) = emit TokPercent p: blank xmlAny w (addcol 1 p) ss xmlAny w p (';':ss) = emit TokSemi p: blank xmlAny w (addcol 1 p) ss xmlAny w p (',':ss) = emit TokComma p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('#':ss) = emit TokHash p: blank xmlAny w (addcol 1 p) ss xmlAny w p ('"':ss) = emit TokQuote p: textOrRefUntil "\"" TokQuote "" p1 p1 ss (xmlAny w) where p1 = addcol 1 p xmlAny w p ('\'':ss) = emit TokQuote p: textOrRefUntil "'" TokQuote "" p1 p1 ss (xmlAny w) where p1 = addcol 1 p xmlAny w p s | isSpace (head s) = blank xmlAny w p s | isAlphaNum (head s) || (head s)`elem`":_" = xmlName p s "some kind of name" (blank xmlAny w) | otherwise = lexerror ("unrecognised token: "++take 4 s) p xmlTag w p s = xmlName p s "tagname for element in < >" (blank xmlAny w) xmlSection = blank xmlSection0 where xmlSection0 w p s | "CDATA[" `prefixes` s = emit (TokSection CDATAx) p: accum w p s 6 | "INCLUDE" `prefixes` s = emit (TokSection INCLUDEx) p: k w p s 7 | "IGNORE" `prefixes` s = emit (TokSection IGNOREx) p: k w p s 6 | "%" `prefixes` s = emit TokPercent p: k w p s 1 | otherwise = lexerror ("expected CDATA, IGNORE, or INCLUDE, but got " ++take 7 s) p accum w p s n = let p0 = addcol n p in textUntil "]]>" TokSectionClose "" p0 p0 (drop n s) (blank xmlAny w) k w p s n = skip n p s (xmlAny ({-InTag "": -}w)) xmlSpecial w p s | "DOCTYPE" `prefixes` s = emit (TokSpecial DOCTYPEx) p: k 7 | "ELEMENT" `prefixes` s = emit (TokSpecial ELEMENTx) p: k 7 | "ATTLIST" `prefixes` s = emit (TokSpecial ATTLISTx) p: k 7 | "ENTITY" `prefixes` s = emit (TokSpecial ENTITYx) p: k 6 | "NOTATION" `prefixes` s = emit (TokSpecial NOTATIONx) p: k 8 | otherwise = lexerror ("expected DOCTYPE, ELEMENT, ENTITY, ATTLIST, or NOTATION," ++" but got "++take 7 s) p where k n = skip n p s (blank xmlAny w) xmlName p (s:ss) cxt k | isAlphaNum s || s==':' || s=='_' = gatherName (s:[]) p (addcol 1 p) ss k | otherwise = lexerror ("expected a "++cxt++", but got char "++show s) p where gatherName acc pos p [] k = emit (TokName (reverse acc)) pos: k p [] -- lexerror ("unexpected EOF in name at "++show pos) p gatherName acc pos p (s:ss) k | isAlphaNum s || s `elem` ".-_:" = gatherName (s:acc) pos (addcol 1 p) ss k | otherwise = emit (TokName (reverse acc)) pos: k p (s:ss) xmlName p [] cxt k = lexerror ("expected a "++cxt++", but got end of input") p xmlContent acc w pos p [] = if all isSpace acc then [] else lexerror "unexpected EOF between tags" p xmlContent acc w pos p (s:ss) | elem s "<&" = {- if all isSpace acc then xmlAny w p (s:ss) else -} emit (TokFreeText (reverse acc)) pos: xmlAny w p (s:ss) | isSpace s = xmlContent (s:acc) w pos (white s p) ss | otherwise = xmlContent (s:acc) w pos (addcol 1 p) ss --ident :: (String->TokenT) -> -- Posn -> String -> [String] -> -- (Posn->String->[String]->[Token]) -> [Token] --ident tok p s ss k = -- let (name,s0) = span (\c-> isAlphaNum c || c `elem` "`-_#.'/\\") s -- in emit (tok name) p: skip (length name) p s ss k hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Validate.hs0000644006511100651110000002660710504340466023040 0ustar rossross-- | Validate a document against a dtd. module Text.XML.HaXml.Validate ( validate , partialValidate ) where import Text.XML.HaXml.Types import Text.XML.HaXml.Combinators (multi,tag,iffind,literal,none,o) import Text.XML.HaXml.XmlContent (attr2str) import Maybe (fromMaybe,isNothing,fromJust) import List (intersperse,nub,(\\)) import Char (isSpace) #if __GLASGOW_HASKELL__ >= 604 || __NHC__ >= 118 || defined(__HUGS__) -- emulate older finite map interface using Data.Map, if it is available import qualified Data.Map as Map type FiniteMap a b = Map.Map a b listToFM :: Ord a => [(a,b)] -> FiniteMap a b listToFM = Map.fromList lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b lookupFM = flip Map.lookup #elif __GLASGOW_HASKELL__ >= 504 || __NHC__ > 114 -- real finite map, if it is available import Data.FiniteMap #else -- otherwise, a very simple and inefficient implementation of a finite map type FiniteMap a b = [(a,b)] listToFM :: Eq a => [(a,b)] -> FiniteMap a b listToFM = id lookupFM :: Eq a => FiniteMap a b -> a -> Maybe b lookupFM fm k = lookup k fm #endif -- gather appropriate information out of the DTD data SimpleDTD = SimpleDTD { elements :: FiniteMap Name ContentSpec -- content model of elem , attributes :: FiniteMap (Name,Name) AttType -- type of (elem,attr) , required :: FiniteMap Name [Name] -- required attributes of elem , ids :: [(Name,Name)] -- all (element,attr) with ID type , idrefs :: [(Name,Name)] -- all (element,attr) with IDREF type } simplifyDTD :: DocTypeDecl -> SimpleDTD simplifyDTD (DTD _ _ decls) = SimpleDTD { elements = listToFM [ (name,content) | Element (ElementDecl name content) <- decls ] , attributes = listToFM [ ((elem,attr),typ) | AttList (AttListDecl elem attdefs) <- decls , AttDef attr typ _ <- attdefs ] , required = listToFM [ (elem, [ attr | AttDef attr _ REQUIRED <- attdefs ]) | AttList (AttListDecl elem attdefs) <- decls ] , ids = [ (elem,attr) | Element (ElementDecl elem _) <- decls , AttList (AttListDecl name attdefs) <- decls , elem == name , AttDef attr (TokenizedType ID) _ <- attdefs ] , idrefs = [] -- not implemented } -- simple auxiliary to avoid lots of if-then-else with empty else clauses. gives :: Bool -> a -> [a] True `gives` x = [x] False `gives` _ = [] -- | 'validate' takes a DTD and a tagged element, and returns a list of -- errors in the document with respect to its DTD. -- -- If you have several documents to validate against a single DTD, -- then you will gain efficiency by freezing-in the DTD through partial -- application, e.g. @checkMyDTD = validate myDTD@. validate :: DocTypeDecl -> Element i -> [String] validate dtd' elem = root dtd' elem ++ partialValidate dtd' elem where root (DTD name _ _) (Elem name' _ _) = (name/=name') `gives` ("Document type should be <"++name ++"> but appears to be <"++name'++">.") -- | 'partialValidate' is like validate, except that it does not check that -- the element type matches that of the DTD's root element. partialValidate :: DocTypeDecl -> Element i -> [String] partialValidate dtd' elem = valid elem ++ checkIDs elem where dtd = simplifyDTD dtd' valid (Elem name attrs contents) = -- is the element defined in the DTD? let spec = lookupFM (elements dtd) name in (isNothing spec) `gives` ("Element <"++name++"> not known.") -- is each attribute mentioned only once? ++ (let dups = duplicates (map fst attrs) in not (null dups) `gives` ("Element <"++name++"> has duplicate attributes: " ++concat (intersperse "," dups)++".")) -- does each attribute belong to this element? value is in range? ++ concatMap (checkAttr name) attrs -- are all required attributes present? ++ concatMap (checkRequired name attrs) (fromMaybe [] (lookupFM (required dtd) name)) -- are its children in a permissible sequence? ++ checkContentSpec name (fromMaybe ANY spec) contents -- now recursively check the element children ++ concatMap valid [ elem | CElem elem _ <- contents ] checkAttr elem (attr, val) = let typ = lookupFM (attributes dtd) (elem,attr) attval = attr2str val in if isNothing typ then ["Attribute \""++attr ++"\" not known for element <"++elem++">."] else case fromJust typ of EnumeratedType e -> case e of Enumeration es -> (not (attval `Prelude.elem` es)) `gives` ("Value \""++attval++"\" of attribute \"" ++attr++"\" in element <"++elem ++"> is not in the required enumeration range: " ++unwords es) _ -> [] _ -> [] checkRequired elem attrs req = (not (req `Prelude.elem` map fst attrs)) `gives` ("Element <"++elem++"> requires the attribute \""++req ++"\" but it is missing.") checkContentSpec elem ANY _ = [] checkContentSpec elem EMPTY [] = [] checkContentSpec elem EMPTY (_:_) = ["Element <"++elem++"> is not empty but should be."] checkContentSpec elem (Mixed PCDATA) cs = concatMap (checkMixed elem []) cs checkContentSpec elem (Mixed (PCDATAplus names)) cs = concatMap (checkMixed elem names) cs checkContentSpec elem (ContentSpec cp) cs = excludeText elem cs ++ (let (errs,rest) = checkCP elem cp (flatten cs) in case rest of [] -> errs _ -> errs++["Element <"++elem++"> contains extra " ++"elements beyond its content spec."]) checkMixed elem permitted (CElem (Elem name _ _) _) | not (name `Prelude.elem` permitted) = ["Element <"++elem++"> contains an element <"++name ++"> but should not."] checkMixed elem permitted _ = [] flatten (CElem (Elem name _ _) _: cs) = name: flatten cs flatten (_: cs) = flatten cs flatten [] = [] excludeText elem (CElem _ _: cs) = excludeText elem cs excludeText elem (CMisc _ _: cs) = excludeText elem cs excludeText elem (CString _ s _: cs) | all isSpace s = excludeText elem cs excludeText elem (_: cs) = ["Element <"++elem++"> contains text/references but should not."] excludeText elem [] = [] -- This is a little parser really. Returns any errors, plus the remainder -- of the input string. checkCP :: Name -> CP -> [Name] -> ([String],[Name]) checkCP elem cp@(TagName n None) [] = (cpError elem cp, []) checkCP elem cp@(TagName n None) (n':ns) | n==n' = ([], ns) | otherwise = (cpError elem cp, n':ns) checkCP elem cp@(TagName n Query) [] = ([],[]) checkCP elem cp@(TagName n Query) (n':ns) | n==n' = ([], ns) | otherwise = ([], n':ns) checkCP elem cp@(TagName n Star) [] = ([],[]) checkCP elem cp@(TagName n Star) (n':ns) | n==n' = checkCP elem (TagName n Star) ns | otherwise = ([], n':ns) checkCP elem cp@(TagName n Plus) [] = (cpError elem cp, []) checkCP elem cp@(TagName n Plus) (n':ns) | n==n' = checkCP elem (TagName n Star) ns | otherwise = (cpError elem cp, n':ns) -- omit this clause, to permit (a?|b?) as a valid but empty choice -- checkCP elem cp@(Choice cps None) [] = (cpError elem cp, []) checkCP elem cp@(Choice cps None) ns = let next = choice elem ns cps in if null next then (cpError elem cp, ns) else ([], head next) -- choose the first alternative with no errors checkCP elem cp@(Choice cps Query) [] = ([],[]) checkCP elem cp@(Choice cps Query) ns = let next = choice elem ns cps in if null next then ([],ns) else ([], head next) checkCP elem cp@(Choice cps Star) [] = ([],[]) checkCP elem cp@(Choice cps Star) ns = let next = choice elem ns cps in if null next then ([],ns) else checkCP elem (Choice cps Star) (head next) checkCP elem cp@(Choice cps Plus) [] = (cpError elem cp, []) checkCP elem cp@(Choice cps Plus) ns = let next = choice elem ns cps in if null next then (cpError elem cp, ns) else checkCP elem (Choice cps Star) (head next) -- omit this clause, to permit (a?,b?) as a valid but empty sequence -- checkCP elem cp@(Seq cps None) [] = (cpError elem cp, []) checkCP elem cp@(Seq cps None) ns = let (errs,next) = sequence elem ns cps in if null errs then ([],next) else (cpError elem cp++errs, ns) checkCP elem cp@(Seq cps Query) [] = ([],[]) checkCP elem cp@(Seq cps Query) ns = let (errs,next) = sequence elem ns cps in if null errs then ([],next) else ([], ns) checkCP elem cp@(Seq cps Star) [] = ([],[]) checkCP elem cp@(Seq cps Star) ns = let (errs,next) = sequence elem ns cps in if null errs then checkCP elem (Seq cps Star) next else ([], ns) checkCP elem cp@(Seq cps Plus) [] = (cpError elem cp, []) checkCP elem cp@(Seq cps Plus) ns = let (errs,next) = sequence elem ns cps in if null errs then checkCP elem (Seq cps Star) next else (cpError elem cp++errs, ns) choice elem ns cps = -- return only those parses that don't give any errors [ rem | ([],rem) <- map (\cp-> checkCP elem (definite cp) ns) cps ] where definite (TagName n Query) = TagName n None definite (Choice cps Query) = Choice cps None definite (Seq cps Query) = Seq cps None definite (TagName n Star) = TagName n Plus definite (Choice cps Star) = Choice cps Plus definite (Seq cps Star) = Seq cps Plus definite x = x sequence elem ns cps = -- accumulate errors down the sequence foldl (\(es,ns) cp-> let (es',ns') = checkCP elem cp ns in (es++es', ns')) ([],ns) cps checkIDs elem = let celem = CElem elem undefined showAttr a = iffind a literal none idElems = concatMap (\(name,at)-> multi (showAttr at `o` tag name) celem) (ids dtd) badIds = duplicates (map (\(CString _ s _)->s) idElems) in not (null badIds) `gives` ("These attribute values of type ID are not unique: " ++concat (intersperse "," badIds)++".") cpError :: Name -> CP -> [String] cpError elem cp = ["Element <"++elem++"> should contain "++display cp++" but does not."] display :: CP -> String display (TagName name mod) = name ++ modifier mod display (Choice cps mod) = "(" ++ concat (intersperse "|" (map display cps)) ++ ")" ++ modifier mod display (Seq cps mod) = "(" ++ concat (intersperse "," (map display cps)) ++ ")" ++ modifier mod modifier :: Modifier -> String modifier None = "" modifier Query = "?" modifier Star = "*" modifier Plus = "+" duplicates :: Eq a => [a] -> [a] duplicates xs = xs \\ (nub xs) hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/OneOfN.hs0000644006511100651110000006673610504340456022441 0ustar rossrossmodule Text.XML.HaXml.OneOfN where import Text.XML.HaXml.XmlContent data OneOf2 a b = OneOf2 a | TwoOf2 b deriving (Eq,Show) instance (HTypeable a,HTypeable b) => HTypeable (OneOf2 a b) where toHType m = Defined "OneOf2" [] [] -- toHType m = Defined "OneOf2" [a,b] [] -- where a = toHType $ (\ (OneOf2 a)->a) $ m -- b = toHType $ (\ (TwoOf2 b)->b) $ m instance (XmlContent a,XmlContent b) => XmlContent (OneOf2 a b) where parseContents = (choice OneOf2 $ choice TwoOf2 $ fail "OneOf2") toContents (OneOf2 x) = toContents x toContents (TwoOf2 x) = toContents x ---- data OneOf3 a b c = OneOf3 a | TwoOf3 b | ThreeOf3 c deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c) => HTypeable (OneOf3 a b c) where toHType m = Defined "OneOf3" [] [] instance (XmlContent a,XmlContent b,XmlContent c) => XmlContent (OneOf3 a b c) where parseContents = (choice OneOf3 $ choice TwoOf3 $ choice ThreeOf3 $ fail "OneOf3") toContents (OneOf3 x) = toContents x toContents (TwoOf3 x) = toContents x toContents (ThreeOf3 x) = toContents x ---- data OneOf4 a b c d = OneOf4 a | TwoOf4 b | ThreeOf4 c | FourOf4 d deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d) => HTypeable (OneOf4 a b c d) where toHType m = Defined "OneOf4" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d) => XmlContent (OneOf4 a b c d) where parseContents = (choice OneOf4 $ choice TwoOf4 $ choice ThreeOf4 $ choice FourOf4 $ fail "OneOf4") toContents (OneOf4 x) = toContents x toContents (TwoOf4 x) = toContents x toContents (ThreeOf4 x) = toContents x toContents (FourOf4 x) = toContents x ---- data OneOf5 a b c d e = OneOf5 a | TwoOf5 b | ThreeOf5 c | FourOf5 d | FiveOf5 e deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e) => HTypeable (OneOf5 a b c d e) where toHType m = Defined "OneOf5" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e) => XmlContent (OneOf5 a b c d e) where parseContents = (choice OneOf5 $ choice TwoOf5 $ choice ThreeOf5 $ choice FourOf5 $ choice FiveOf5 $ fail "OneOf5") toContents (OneOf5 x) = toContents x toContents (TwoOf5 x) = toContents x toContents (ThreeOf5 x) = toContents x toContents (FourOf5 x) = toContents x toContents (FiveOf5 x) = toContents x ---- data OneOf6 a b c d e f = OneOf6 a | TwoOf6 b | ThreeOf6 c | FourOf6 d | FiveOf6 e | SixOf6 f deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f) => HTypeable (OneOf6 a b c d e f) where toHType m = Defined "OneOf6" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f) => XmlContent (OneOf6 a b c d e f) where parseContents = (choice OneOf6 $ choice TwoOf6 $ choice ThreeOf6 $ choice FourOf6 $ choice FiveOf6 $ choice SixOf6 $ fail "OneOf6") toContents (OneOf6 x) = toContents x toContents (TwoOf6 x) = toContents x toContents (ThreeOf6 x) = toContents x toContents (FourOf6 x) = toContents x toContents (FiveOf6 x) = toContents x toContents (SixOf6 x) = toContents x ---- data OneOf7 a b c d e f g = OneOf7 a | TwoOf7 b | ThreeOf7 c | FourOf7 d | FiveOf7 e | SixOf7 f | SevenOf7 g deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g) => HTypeable (OneOf7 a b c d e f g) where toHType m = Defined "OneOf7" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g) => XmlContent (OneOf7 a b c d e f g) where parseContents = (choice OneOf7 $ choice TwoOf7 $ choice ThreeOf7 $ choice FourOf7 $ choice FiveOf7 $ choice SixOf7 $ choice SevenOf7 $ fail "OneOf7") toContents (OneOf7 x) = toContents x toContents (TwoOf7 x) = toContents x toContents (ThreeOf7 x) = toContents x toContents (FourOf7 x) = toContents x toContents (FiveOf7 x) = toContents x toContents (SixOf7 x) = toContents x toContents (SevenOf7 x) = toContents x ---- data OneOf8 a b c d e f g h = OneOf8 a | TwoOf8 b | ThreeOf8 c | FourOf8 d | FiveOf8 e | SixOf8 f | SevenOf8 g | EightOf8 h deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h) => HTypeable (OneOf8 a b c d e f g h) where toHType m = Defined "OneOf8" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h) => XmlContent (OneOf8 a b c d e f g h) where parseContents = (choice OneOf8 $ choice TwoOf8 $ choice ThreeOf8 $ choice FourOf8 $ choice FiveOf8 $ choice SixOf8 $ choice SevenOf8 $ choice EightOf8 $ fail "OneOf8") toContents (OneOf8 x) = toContents x toContents (TwoOf8 x) = toContents x toContents (ThreeOf8 x) = toContents x toContents (FourOf8 x) = toContents x toContents (FiveOf8 x) = toContents x toContents (SixOf8 x) = toContents x toContents (SevenOf8 x) = toContents x toContents (EightOf8 x) = toContents x ---- data OneOf9 a b c d e f g h i = OneOf9 a | TwoOf9 b | ThreeOf9 c | FourOf9 d | FiveOf9 e | SixOf9 f | SevenOf9 g | EightOf9 h | NineOf9 i deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i) => HTypeable (OneOf9 a b c d e f g h i) where toHType m = Defined "OneOf9" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i) => XmlContent (OneOf9 a b c d e f g h i) where parseContents = (choice OneOf9 $ choice TwoOf9 $ choice ThreeOf9 $ choice FourOf9 $ choice FiveOf9 $ choice SixOf9 $ choice SevenOf9 $ choice EightOf9 $ choice NineOf9 $ fail "OneOf9") toContents (OneOf9 x) = toContents x toContents (TwoOf9 x) = toContents x toContents (ThreeOf9 x) = toContents x toContents (FourOf9 x) = toContents x toContents (FiveOf9 x) = toContents x toContents (SixOf9 x) = toContents x toContents (SevenOf9 x) = toContents x toContents (EightOf9 x) = toContents x toContents (NineOf9 x) = toContents x ---- data OneOf10 a b c d e f g h i j = OneOf10 a | TwoOf10 b | ThreeOf10 c | FourOf10 d | FiveOf10 e | SixOf10 f | SevenOf10 g | EightOf10 h | NineOf10 i | TenOf10 j deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j) => HTypeable (OneOf10 a b c d e f g h i j) where toHType m = Defined "OneOf10" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j) => XmlContent (OneOf10 a b c d e f g h i j) where parseContents = (choice OneOf10 $ choice TwoOf10 $ choice ThreeOf10 $ choice FourOf10 $ choice FiveOf10 $ choice SixOf10 $ choice SevenOf10 $ choice EightOf10 $ choice NineOf10 $ choice TenOf10 $ fail "OneOf10") toContents (OneOf10 x) = toContents x toContents (TwoOf10 x) = toContents x toContents (ThreeOf10 x) = toContents x toContents (FourOf10 x) = toContents x toContents (FiveOf10 x) = toContents x toContents (SixOf10 x) = toContents x toContents (SevenOf10 x) = toContents x toContents (EightOf10 x) = toContents x toContents (NineOf10 x) = toContents x toContents (TenOf10 x) = toContents x ---- data OneOf11 a b c d e f g h i j k = OneOf11 a | TwoOf11 b | ThreeOf11 c | FourOf11 d | FiveOf11 e | SixOf11 f | SevenOf11 g | EightOf11 h | NineOf11 i | TenOf11 j | ElevenOf11 k deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k) => HTypeable (OneOf11 a b c d e f g h i j k) where toHType m = Defined "OneOf11" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k) => XmlContent (OneOf11 a b c d e f g h i j k) where parseContents = (choice OneOf11 $ choice TwoOf11 $ choice ThreeOf11 $ choice FourOf11 $ choice FiveOf11 $ choice SixOf11 $ choice SevenOf11 $ choice EightOf11 $ choice NineOf11 $ choice TenOf11 $ choice ElevenOf11 $ fail "OneOf11") toContents (OneOf11 x) = toContents x toContents (TwoOf11 x) = toContents x toContents (ThreeOf11 x) = toContents x toContents (FourOf11 x) = toContents x toContents (FiveOf11 x) = toContents x toContents (SixOf11 x) = toContents x toContents (SevenOf11 x) = toContents x toContents (EightOf11 x) = toContents x toContents (NineOf11 x) = toContents x toContents (TenOf11 x) = toContents x toContents (ElevenOf11 x) = toContents x ---- data OneOf12 a b c d e f g h i j k l = OneOf12 a | TwoOf12 b | ThreeOf12 c | FourOf12 d | FiveOf12 e | SixOf12 f | SevenOf12 g | EightOf12 h | NineOf12 i | TenOf12 j | ElevenOf12 k | TwelveOf12 l deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k,HTypeable l) => HTypeable (OneOf12 a b c d e f g h i j k l) where toHType m = Defined "OneOf12" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k,XmlContent l) => XmlContent (OneOf12 a b c d e f g h i j k l) where parseContents = (choice OneOf12 $ choice TwoOf12 $ choice ThreeOf12 $ choice FourOf12 $ choice FiveOf12 $ choice SixOf12 $ choice SevenOf12 $ choice EightOf12 $ choice NineOf12 $ choice TenOf12 $ choice ElevenOf12 $ choice TwelveOf12 $ fail "OneOf12") toContents (OneOf12 x) = toContents x toContents (TwoOf12 x) = toContents x toContents (ThreeOf12 x) = toContents x toContents (FourOf12 x) = toContents x toContents (FiveOf12 x) = toContents x toContents (SixOf12 x) = toContents x toContents (SevenOf12 x) = toContents x toContents (EightOf12 x) = toContents x toContents (NineOf12 x) = toContents x toContents (TenOf12 x) = toContents x toContents (ElevenOf12 x) = toContents x toContents (TwelveOf12 x) = toContents x ---- data OneOf13 a b c d e f g h i j k l m = OneOf13 a | TwoOf13 b | ThreeOf13 c | FourOf13 d | FiveOf13 e | SixOf13 f | SevenOf13 g | EightOf13 h | NineOf13 i | TenOf13 j | ElevenOf13 k | TwelveOf13 l | ThirteenOf13 m deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k,HTypeable l,HTypeable m) => HTypeable (OneOf13 a b c d e f g h i j k l m) where toHType m = Defined "OneOf13" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k,XmlContent l,XmlContent m) => XmlContent (OneOf13 a b c d e f g h i j k l m) where parseContents = (choice OneOf13 $ choice TwoOf13 $ choice ThreeOf13 $ choice FourOf13 $ choice FiveOf13 $ choice SixOf13 $ choice SevenOf13 $ choice EightOf13 $ choice NineOf13 $ choice TenOf13 $ choice ElevenOf13 $ choice TwelveOf13 $ choice ThirteenOf13 $ fail "OneOf13") toContents (OneOf13 x) = toContents x toContents (TwoOf13 x) = toContents x toContents (ThreeOf13 x) = toContents x toContents (FourOf13 x) = toContents x toContents (FiveOf13 x) = toContents x toContents (SixOf13 x) = toContents x toContents (SevenOf13 x) = toContents x toContents (EightOf13 x) = toContents x toContents (NineOf13 x) = toContents x toContents (TenOf13 x) = toContents x toContents (ElevenOf13 x) = toContents x toContents (TwelveOf13 x) = toContents x toContents (ThirteenOf13 x) = toContents x ---- data OneOf14 a b c d e f g h i j k l m n = OneOf14 a | TwoOf14 b | ThreeOf14 c | FourOf14 d | FiveOf14 e | SixOf14 f | SevenOf14 g | EightOf14 h | NineOf14 i | TenOf14 j | ElevenOf14 k | TwelveOf14 l | ThirteenOf14 m | FourteenOf14 n deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k,HTypeable l,HTypeable m,HTypeable n) => HTypeable (OneOf14 a b c d e f g h i j k l m n) where toHType m = Defined "OneOf14" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k,XmlContent l,XmlContent m,XmlContent n) => XmlContent (OneOf14 a b c d e f g h i j k l m n) where parseContents = (choice OneOf14 $ choice TwoOf14 $ choice ThreeOf14 $ choice FourOf14 $ choice FiveOf14 $ choice SixOf14 $ choice SevenOf14 $ choice EightOf14 $ choice NineOf14 $ choice TenOf14 $ choice ElevenOf14 $ choice TwelveOf14 $ choice ThirteenOf14 $ choice FourteenOf14 $ fail "OneOf14") toContents (OneOf14 x) = toContents x toContents (TwoOf14 x) = toContents x toContents (ThreeOf14 x) = toContents x toContents (FourOf14 x) = toContents x toContents (FiveOf14 x) = toContents x toContents (SixOf14 x) = toContents x toContents (SevenOf14 x) = toContents x toContents (EightOf14 x) = toContents x toContents (NineOf14 x) = toContents x toContents (TenOf14 x) = toContents x toContents (ElevenOf14 x) = toContents x toContents (TwelveOf14 x) = toContents x toContents (ThirteenOf14 x) = toContents x toContents (FourteenOf14 x) = toContents x ---- data OneOf15 a b c d e f g h i j k l m n o = OneOf15 a | TwoOf15 b | ThreeOf15 c | FourOf15 d | FiveOf15 e | SixOf15 f | SevenOf15 g | EightOf15 h | NineOf15 i | TenOf15 j | ElevenOf15 k | TwelveOf15 l | ThirteenOf15 m | FourteenOf15 n | FifteenOf15 o deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o) => HTypeable (OneOf15 a b c d e f g h i j k l m n o) where toHType m = Defined "OneOf15" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o) => XmlContent (OneOf15 a b c d e f g h i j k l m n o) where parseContents = (choice OneOf15 $ choice TwoOf15 $ choice ThreeOf15 $ choice FourOf15 $ choice FiveOf15 $ choice SixOf15 $ choice SevenOf15 $ choice EightOf15 $ choice NineOf15 $ choice TenOf15 $ choice ElevenOf15 $ choice TwelveOf15 $ choice ThirteenOf15 $ choice FourteenOf15 $ choice FifteenOf15 $ fail "OneOf15") toContents (OneOf15 x) = toContents x toContents (TwoOf15 x) = toContents x toContents (ThreeOf15 x) = toContents x toContents (FourOf15 x) = toContents x toContents (FiveOf15 x) = toContents x toContents (SixOf15 x) = toContents x toContents (SevenOf15 x) = toContents x toContents (EightOf15 x) = toContents x toContents (NineOf15 x) = toContents x toContents (TenOf15 x) = toContents x toContents (ElevenOf15 x) = toContents x toContents (TwelveOf15 x) = toContents x toContents (ThirteenOf15 x) = toContents x toContents (FourteenOf15 x) = toContents x toContents (FifteenOf15 x) = toContents x ---- data OneOf16 a b c d e f g h i j k l m n o p = OneOf16 a | TwoOf16 b | ThreeOf16 c | FourOf16 d | FiveOf16 e | SixOf16 f | SevenOf16 g | EightOf16 h | NineOf16 i | TenOf16 j | ElevenOf16 k | TwelveOf16 l | ThirteenOf16 m | FourteenOf16 n | FifteenOf16 o | SixteenOf16 p deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o ,HTypeable p) => HTypeable (OneOf16 a b c d e f g h i j k l m n o p) where toHType m = Defined "OneOf16" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o ,XmlContent p) => XmlContent (OneOf16 a b c d e f g h i j k l m n o p) where parseContents = (choice OneOf16 $ choice TwoOf16 $ choice ThreeOf16 $ choice FourOf16 $ choice FiveOf16 $ choice SixOf16 $ choice SevenOf16 $ choice EightOf16 $ choice NineOf16 $ choice TenOf16 $ choice ElevenOf16 $ choice TwelveOf16 $ choice ThirteenOf16 $ choice FourteenOf16 $ choice FifteenOf16 $ choice SixteenOf16 $ fail "OneOf16") toContents (OneOf16 x) = toContents x toContents (TwoOf16 x) = toContents x toContents (ThreeOf16 x) = toContents x toContents (FourOf16 x) = toContents x toContents (FiveOf16 x) = toContents x toContents (SixOf16 x) = toContents x toContents (SevenOf16 x) = toContents x toContents (EightOf16 x) = toContents x toContents (NineOf16 x) = toContents x toContents (TenOf16 x) = toContents x toContents (ElevenOf16 x) = toContents x toContents (TwelveOf16 x) = toContents x toContents (ThirteenOf16 x) = toContents x toContents (FourteenOf16 x) = toContents x toContents (FifteenOf16 x) = toContents x toContents (SixteenOf16 x) = toContents x ---- data OneOf17 a b c d e f g h i j k l m n o p q = OneOf17 a | TwoOf17 b | ThreeOf17 c | FourOf17 d | FiveOf17 e | SixOf17 f | SevenOf17 g | EightOf17 h | NineOf17 i | TenOf17 j | ElevenOf17 k | TwelveOf17 l | ThirteenOf17 m | FourteenOf17 n | FifteenOf17 o | SixteenOf17 p | SeventeenOf17 q deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o ,HTypeable p,HTypeable q) => HTypeable (OneOf17 a b c d e f g h i j k l m n o p q) where toHType m = Defined "OneOf17" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o ,XmlContent p,XmlContent q) => XmlContent (OneOf17 a b c d e f g h i j k l m n o p q) where parseContents = (choice OneOf17 $ choice TwoOf17 $ choice ThreeOf17 $ choice FourOf17 $ choice FiveOf17 $ choice SixOf17 $ choice SevenOf17 $ choice EightOf17 $ choice NineOf17 $ choice TenOf17 $ choice ElevenOf17 $ choice TwelveOf17 $ choice ThirteenOf17 $ choice FourteenOf17 $ choice FifteenOf17 $ choice SixteenOf17 $ choice SeventeenOf17 $ fail "OneOf17") toContents (OneOf17 x) = toContents x toContents (TwoOf17 x) = toContents x toContents (ThreeOf17 x) = toContents x toContents (FourOf17 x) = toContents x toContents (FiveOf17 x) = toContents x toContents (SixOf17 x) = toContents x toContents (SevenOf17 x) = toContents x toContents (EightOf17 x) = toContents x toContents (NineOf17 x) = toContents x toContents (TenOf17 x) = toContents x toContents (ElevenOf17 x) = toContents x toContents (TwelveOf17 x) = toContents x toContents (ThirteenOf17 x) = toContents x toContents (FourteenOf17 x) = toContents x toContents (FifteenOf17 x) = toContents x toContents (SixteenOf17 x) = toContents x toContents (SeventeenOf17 x) = toContents x ---- data OneOf18 a b c d e f g h i j k l m n o p q r = OneOf18 a | TwoOf18 b | ThreeOf18 c | FourOf18 d | FiveOf18 e | SixOf18 f | SevenOf18 g | EightOf18 h | NineOf18 i | TenOf18 j | ElevenOf18 k | TwelveOf18 l | ThirteenOf18 m | FourteenOf18 n | FifteenOf18 o | SixteenOf18 p | SeventeenOf18 q | EighteenOf18 r deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o ,HTypeable p,HTypeable q,HTypeable r) => HTypeable (OneOf18 a b c d e f g h i j k l m n o p q r) where toHType m = Defined "OneOf18" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o ,XmlContent p,XmlContent q,XmlContent r) => XmlContent (OneOf18 a b c d e f g h i j k l m n o p q r) where parseContents = (choice OneOf18 $ choice TwoOf18 $ choice ThreeOf18 $ choice FourOf18 $ choice FiveOf18 $ choice SixOf18 $ choice SevenOf18 $ choice EightOf18 $ choice NineOf18 $ choice TenOf18 $ choice ElevenOf18 $ choice TwelveOf18 $ choice ThirteenOf18 $ choice FourteenOf18 $ choice FifteenOf18 $ choice SixteenOf18 $ choice SeventeenOf18 $ choice EighteenOf18 $ fail "OneOf18") toContents (OneOf18 x) = toContents x toContents (TwoOf18 x) = toContents x toContents (ThreeOf18 x) = toContents x toContents (FourOf18 x) = toContents x toContents (FiveOf18 x) = toContents x toContents (SixOf18 x) = toContents x toContents (SevenOf18 x) = toContents x toContents (EightOf18 x) = toContents x toContents (NineOf18 x) = toContents x toContents (TenOf18 x) = toContents x toContents (ElevenOf18 x) = toContents x toContents (TwelveOf18 x) = toContents x toContents (ThirteenOf18 x) = toContents x toContents (FourteenOf18 x) = toContents x toContents (FifteenOf18 x) = toContents x toContents (SixteenOf18 x) = toContents x toContents (SeventeenOf18 x) = toContents x toContents (EighteenOf18 x) = toContents x ---- data OneOf19 a b c d e f g h i j k l m n o p q r s = OneOf19 a | TwoOf19 b | ThreeOf19 c | FourOf19 d | FiveOf19 e | SixOf19 f | SevenOf19 g | EightOf19 h | NineOf19 i | TenOf19 j | ElevenOf19 k | TwelveOf19 l | ThirteenOf19 m | FourteenOf19 n | FifteenOf19 o | SixteenOf19 p | SeventeenOf19 q | EighteenOf19 r | NineteenOf19 s deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o ,HTypeable p,HTypeable q,HTypeable r,HTypeable s) => HTypeable (OneOf19 a b c d e f g h i j k l m n o p q r s) where toHType m = Defined "OneOf19" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o ,XmlContent p,XmlContent q,XmlContent r,XmlContent s) => XmlContent (OneOf19 a b c d e f g h i j k l m n o p q r s) where parseContents = (choice OneOf19 $ choice TwoOf19 $ choice ThreeOf19 $ choice FourOf19 $ choice FiveOf19 $ choice SixOf19 $ choice SevenOf19 $ choice EightOf19 $ choice NineOf19 $ choice TenOf19 $ choice ElevenOf19 $ choice TwelveOf19 $ choice ThirteenOf19 $ choice FourteenOf19 $ choice FifteenOf19 $ choice SixteenOf19 $ choice SeventeenOf19 $ choice EighteenOf19 $ choice NineteenOf19 $ fail "OneOf19") toContents (OneOf19 x) = toContents x toContents (TwoOf19 x) = toContents x toContents (ThreeOf19 x) = toContents x toContents (FourOf19 x) = toContents x toContents (FiveOf19 x) = toContents x toContents (SixOf19 x) = toContents x toContents (SevenOf19 x) = toContents x toContents (EightOf19 x) = toContents x toContents (NineOf19 x) = toContents x toContents (TenOf19 x) = toContents x toContents (ElevenOf19 x) = toContents x toContents (TwelveOf19 x) = toContents x toContents (ThirteenOf19 x) = toContents x toContents (FourteenOf19 x) = toContents x toContents (FifteenOf19 x) = toContents x toContents (SixteenOf19 x) = toContents x toContents (SeventeenOf19 x) = toContents x toContents (EighteenOf19 x) = toContents x toContents (NineteenOf19 x) = toContents x ---- data OneOf20 a b c d e f g h i j k l m n o p q r s t = OneOf20 a | TwoOf20 b | ThreeOf20 c | FourOf20 d | FiveOf20 e | SixOf20 f | SevenOf20 g | EightOf20 h | NineOf20 i | TenOf20 j | ElevenOf20 k | TwelveOf20 l | ThirteenOf20 m | FourteenOf20 n | FifteenOf20 o | SixteenOf20 p | SeventeenOf20 q | EighteenOf20 r | NineteenOf20 s | TwentyOf20 t deriving (Eq,Show) instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o ,HTypeable p,HTypeable q,HTypeable r,HTypeable s,HTypeable t) => HTypeable (OneOf20 a b c d e f g h i j k l m n o p q r s t) where toHType m = Defined "OneOf20" [] [] instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o ,XmlContent p,XmlContent q,XmlContent r,XmlContent s,XmlContent t) => XmlContent (OneOf20 a b c d e f g h i j k l m n o p q r s t) where parseContents = (choice OneOf20 $ choice TwoOf20 $ choice ThreeOf20 $ choice FourOf20 $ choice FiveOf20 $ choice SixOf20 $ choice SevenOf20 $ choice EightOf20 $ choice NineOf20 $ choice TenOf20 $ choice ElevenOf20 $ choice TwelveOf20 $ choice ThirteenOf20 $ choice FourteenOf20 $ choice FifteenOf20 $ choice SixteenOf20 $ choice SeventeenOf20 $ choice EighteenOf20 $ choice NineteenOf20 $ choice TwentyOf20 $ fail "OneOf20") toContents (OneOf20 x) = toContents x toContents (TwoOf20 x) = toContents x toContents (ThreeOf20 x) = toContents x toContents (FourOf20 x) = toContents x toContents (FiveOf20 x) = toContents x toContents (SixOf20 x) = toContents x toContents (SevenOf20 x) = toContents x toContents (EightOf20 x) = toContents x toContents (NineOf20 x) = toContents x toContents (TenOf20 x) = toContents x toContents (ElevenOf20 x) = toContents x toContents (TwelveOf20 x) = toContents x toContents (ThirteenOf20 x) = toContents x toContents (FourteenOf20 x) = toContents x toContents (FifteenOf20 x) = toContents x toContents (SixteenOf20 x) = toContents x toContents (SeventeenOf20 x) = toContents x toContents (EighteenOf20 x) = toContents x toContents (NineteenOf20 x) = toContents x toContents (TwentyOf20 x) = toContents x ---- hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Posn.hs0000644006511100651110000000420610504340456022214 0ustar rossross-- | Define a position datatype for giving locations in error messages. module Text.XML.HaXml.Posn ( -- * Position type Posn() -- ** Constructors of a new position , posInNewCxt -- :: String -> Maybe Posn -> Posn , noPos -- :: Posn -- ** Strictifier , forcep -- ** Modifiers , addcol, newline, tab, white ) where import Char -- | Source positions contain a filename, line, column, and an -- inclusion point, which is itself another source position, -- recursively. data Posn = Pn String !Int !Int (Maybe Posn) deriving (Eq) -- | Dummy value for generated data, where a true source position does -- not exist. noPos :: Posn noPos = Pn "no recorded position" 0 0 Nothing -- | @posInNewCxt name pos@ creates a new source position from an old one. -- It is used when opening a new file (e.g. a DTD inclusion), to denote -- the start of the file @name@, but retain the stacked information that -- it was included from the old @pos@. posInNewCxt :: String -> Maybe Posn -> Posn posInNewCxt name pos = Pn name 1 1 pos instance Show Posn where showsPrec p (Pn f l c i) = showString f . showString " at line " . shows l . showString " col " . shows c . ( case i of Nothing -> id Just p -> showString "\n used by " . shows p ) -- | Just used to strictify the internal values of a position, to avoid -- space leaks. forcep :: Posn -> Int forcep (Pn f n m i) = m `seq` n -- | Add n character positions to the given position. addcol :: Int -> Posn -> Posn addcol n (Pn f r c i) = Pn f r (c+n) i -- | Add a newline or tab to the given position. newline, tab :: Posn -> Posn newline (Pn f r c i) = Pn f (r+1) 1 i tab (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i -- | Add the given whitespace char to the given position. -- Precondition: @white c | isSpace c = True@ white :: Char -> Posn -> Posn white ' ' = addcol 1 white '\n' = newline white '\r' = id white '\t' = tab white '\xa0' = addcol 1 hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/Pretty.hs0000644006511100651110000002616210504340456022571 0ustar rossross-- | This is a pretty-printer for turning the internal representation -- of generic structured XML documents into the Doc type (which can -- later be rendered using Text.ParserCombinators.HughesPJ.render). -- Essentially there is one pp function for each type in -- Text.Xml.HaXml.Types, so you can pretty-print as much or as little -- of the document as you wish. module Text.XML.HaXml.Pretty ( -- * Pretty-print a whole document document -- ** Just one content , content -- ** Just one tagged element , element -- * Pretty-print just a DTD , doctypedecl -- ** The prolog , prolog -- ** A content particle description , cp ) where import Prelude hiding (maybe,either) import Maybe hiding (maybe) import List (intersperse) --import Char (isSpace) import Text.PrettyPrint.HughesPJ import Text.XML.HaXml.Types either f g (Left x) = f x either f g (Right x) = g x maybe f Nothing = empty maybe f (Just x) = f x --peref p = text "%" <> text p <> text ";" ---- document :: Document i -> Doc prolog :: Prolog -> Doc xmldecl :: XMLDecl -> Doc misc :: Misc -> Doc sddecl :: Bool -> Doc doctypedecl :: DocTypeDecl -> Doc markupdecl :: MarkupDecl -> Doc extsubset :: ExtSubset -> Doc extsubsetdecl :: ExtSubsetDecl -> Doc cp :: CP -> Doc element :: Element i -> Doc attribute :: Attribute -> Doc --etc content :: Content i -> Doc ---- document (Document p _ e m)= prolog p $$ element e $$ vcat (map misc m) prolog (Prolog x m1 dtd m2)= maybe xmldecl x $$ vcat (map misc m1) $$ maybe doctypedecl dtd $$ vcat (map misc m2) xmldecl (XMLDecl v e sd) = text " text v <> text "'" <+> maybe encodingdecl e <+> maybe sddecl sd <+> text "?>" misc (Comment s) = text "" misc (PI (n,s)) = text " text n <+> text s <+> text "?>" sddecl sd | sd = text "standalone='yes'" | otherwise = text "standalone='no'" doctypedecl (DTD n eid ds) = if null ds then hd <> text ">" else hd <+> text " [" $$ vcat (map markupdecl ds) $$ text "]>" where hd = text " text n <+> maybe externalid eid markupdecl (Element e) = elementdecl e markupdecl (AttList a) = attlistdecl a markupdecl (Entity e) = entitydecl e markupdecl (Notation n) = notationdecl n markupdecl (MarkupMisc m) = misc m --markupdecl (MarkupPE p m) = peref p extsubset (ExtSubset t ds) = maybe textdecl t $$ vcat (map extsubsetdecl ds) extsubsetdecl (ExtMarkupDecl m) = markupdecl m extsubsetdecl (ExtConditionalSect c) = conditionalsect c --extsubsetdecl (ExtPEReference p e) = peref p element (Elem n as []) = text "<" <> text n <+> fsep (map attribute as) <> text "/>" element e@(Elem n as cs) -- | any isText cs = text "<" <> text n <+> fsep (map attribute as) <> -- text ">" <> hcat (map content cs) <> -- text " text n <> text ">" | isText (head cs) = text "<" <> text n <+> fsep (map attribute as) <> text ">" <> hcat (map content cs) <> text " text n <> text ">" | otherwise = let (d,c) = carryelem e empty in d <> c isText (CString _ _ _) = True isText (CRef _ _) = True isText _ = False carryelem (Elem n as []) c = ( c <> text "<" <> text n <+> fsep (map attribute as) , text "/>") carryelem e@(Elem n as cs) c -- | any isText cs = ( c <> element e, empty) | otherwise = let (cs0,d0) = carryscan carrycontent cs (text ">") in ( c <> text "<" <> text n <+> fsep (map attribute as) $$ nest 2 (vcat cs0) <> --- $$ d0 <> text " text n , text ">") carrycontent (CElem e _) c = carryelem e c carrycontent (CString False s _) c = (c <> chardata s, empty) carrycontent (CString True s _) c = (c <> cdsect s, empty) carrycontent (CRef r _) c = (c <> reference r, empty) carrycontent (CMisc m _) c = (c <> misc m, empty) carryscan :: (a->c->(b,c)) -> [a] -> c -> ([b],c) carryscan f [] c = ([],c) carryscan f (a:as) c = let (b, c0) = f a c (bs,c1) = carryscan f as c0 in (b:bs, c1) --carryelem e@(Elem n as cs) c -- | isText (head cs) = -- ( start <> -- text ">" <> hcat (map content cs) <> text " text n -- , text ">") -- | otherwise = -- let (d,c0) = foldl carrycontent (start, text ">") cs in -- ( d <> c0 <> text " text n -- , text ">") -- where start = c <> text "<" <> text n <+> fsep (map attribute as) -- --carrycontent (d,c) (CElem e) = let (d',c') = carryelem e c in -- (d $$ nest 2 d', c') --carrycontent (d,c) (CString _ s) = (d <> c <> chardata s, empty) --carrycontent (d,c) (CRef r) = (d <> c <> reference r,empty) --carrycontent (d,c) (CMisc m) = (d $$ c <> misc m, empty) attribute (n,v) = text n <> text "=" <> attvalue v content (CElem e _) = element e content (CString False s _) = chardata s content (CString True s _) = cdsect s content (CRef r _) = reference r content (CMisc m _) = misc m elementdecl (ElementDecl n cs) = text " text n <+> contentspec cs <> text ">" contentspec EMPTY = text "EMPTY" contentspec ANY = text "ANY" contentspec (Mixed m) = mixed m contentspec (ContentSpec c) = cp c --contentspec (ContentPE p cs) = peref p cp (TagName n m) = text n <> modifier m cp (Choice cs m) = parens (hcat (intersperse (text "|") (map cp cs))) <> modifier m cp (Seq cs m) = parens (hcat (intersperse (text ",") (map cp cs))) <> modifier m --cp (CPPE p c) = peref p modifier None = empty modifier Query = text "?" modifier Star = text "*" modifier Plus = text "+" mixed PCDATA = text "(#PCDATA)" mixed (PCDATAplus ns) = text "(#PCDATA |" <+> hcat (intersperse (text "|") (map text ns)) <> text ")*" attlistdecl (AttListDecl n ds) = text " text n <+> fsep (map attdef ds) <> text ">" attdef (AttDef n t d) = text n <+> atttype t <+> defaultdecl d atttype StringType = text "CDATA" atttype (TokenizedType t) = tokenizedtype t atttype (EnumeratedType t) = enumeratedtype t tokenizedtype ID = text "ID" tokenizedtype IDREF = text "IDREF" tokenizedtype IDREFS = text "IDREFS" tokenizedtype ENTITY = text "ENTITY" tokenizedtype ENTITIES = text "ENTITIES" tokenizedtype NMTOKEN = text "NMTOKEN" tokenizedtype NMTOKENS = text "NMTOKENS" enumeratedtype (NotationType n)= notationtype n enumeratedtype (Enumeration e) = enumeration e notationtype ns = text "NOTATION" <+> parens (hcat (intersperse (text "|") (map text ns))) enumeration ns = parens (hcat (intersperse (text "|") (map nmtoken ns))) defaultdecl REQUIRED = text "#REQUIRED" defaultdecl IMPLIED = text "#IMPLIED" defaultdecl (DefaultTo a f) = maybe (const (text "#FIXED")) f <+> attvalue a conditionalsect (IncludeSect i)= text " vcat (map extsubsetdecl i) <+> text "]]>" conditionalsect (IgnoreSect i) = text " fsep (map ignoresectcontents i) <+> text "]]>" ignore (Ignore) = empty ignoresectcontents (IgnoreSectContents i is) = ignore i <+> vcat (map internal is) where internal (ics,i) = text " ignoresectcontents ics <+> text "]]>" <+> ignore i reference (RefEntity er) = entityref er reference (RefChar cr) = charref cr entityref n = text "&" <> text n <> text ";" charref c = text "&#" <> text (show c) <> text ";" entitydecl (EntityGEDecl d) = gedecl d entitydecl (EntityPEDecl d) = pedecl d gedecl (GEDecl n ed) = text " text n <+> entitydef ed <> text ">" pedecl (PEDecl n pd) = text " text n <+> pedef pd <> text ">" entitydef (DefEntityValue ev) = entityvalue ev entitydef (DefExternalID i nd) = externalid i <+> maybe ndatadecl nd pedef (PEDefEntityValue ev) = entityvalue ev pedef (PEDefExternalID eid) = externalid eid externalid (SYSTEM sl) = text "SYSTEM" <+> systemliteral sl externalid (PUBLIC i sl) = text "PUBLIC" <+> pubidliteral i <+> systemliteral sl ndatadecl (NDATA n) = text "NDATA" <+> text n textdecl (TextDecl vi ed) = text " maybe text vi <+> encodingdecl ed <> text "?>" extparsedent (ExtParsedEnt t c)= maybe textdecl t <+> content c extpe (ExtPE t esd) = maybe textdecl t <+> vcat (map extsubsetdecl esd) notationdecl (NOTATION n e) = text " text n <+> either externalid publicid e <> text ">" publicid (PUBLICID p) = text "PUBLICID" <+> pubidliteral p encodingdecl (EncodingDecl s) = text "encoding='" <> text s <> text "'" nmtoken s = text s attvalue (AttValue esr) = text "\"" <> hcat (map (either text reference) esr) <> text "\"" entityvalue (EntityValue evs) | containsDoubleQuote evs = text "'" <> hcat (map ev evs) <> text "'" | otherwise = text "\"" <> hcat (map ev evs) <> text "\"" ev (EVString s) = text s --ev (EVPERef p e) = peref p ev (EVRef r) = reference r pubidliteral (PubidLiteral s) | '"' `elem` s = text "'" <> text s <> text "'" | otherwise = text "\"" <> text s <> text "\"" systemliteral (SystemLiteral s) | '"' `elem` s = text "'" <> text s <> text "'" | otherwise = text "\"" <> text s <> text "\"" chardata s = {-if all isSpace s then empty else-} text s cdsect c = text " chardata c <> text "]]>" ---- containsDoubleQuote evs = any csq evs where csq (EVString s) = '"' `elem` s csq _ = False hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/SAX.hs0000644006511100651110000000631010504340466021727 0ustar rossross-- | A streaming XML parser, using a method known as SAX. SAX isn't really a -- standard, but an implementation, so it's just an \"SAX-like\" parser. -- This module allows you parse an XML document without having to evaluate -- it as a whole. This is needed for protocols like jabber, which use xml -- streams for communication. module Text.XML.HaXml.SAX ( SaxElement(..) , saxParse ) where import Text.XML.HaXml.Types import Text.XML.HaXml.Parse import Text.XML.HaXml.Lex import Text.ParserCombinators.PolyState data SaxElement = SaxDocTypeDecl DocTypeDecl -- ^ A doctype declaration occured(\) | SaxProcessingInstruction ProcessingInstruction -- ^ A processing instruction occured (\) | SaxComment String -- ^ A comment occured (\", comment >>= return . Comment) , ("", processinginstruction >>= return . PI) ] -- | Return a DOCTYPE decl, indicating a DTD. doctypedecl :: XParser DocTypeDecl doctypedecl = do tok TokSpecialOpen tok (TokSpecial DOCTYPEx) commit $ do n <- name eid <- maybe externalid es <- maybe (bracket (tok TokSqOpen) (tok TokSqClose) (many (peRef markupdecl))) blank (tok TokAnyClose) `onFail` failP "missing > in DOCTYPE decl" return (DTD n eid (case es of { Nothing -> []; Just e -> e })) -- | Return a DTD markup decl, e.g. ELEMENT, ATTLIST, etc markupdecl :: XParser MarkupDecl markupdecl = oneOf' [ ("ELEMENT", elementdecl >>= return . Element) , ("ATTLIST", attlistdecl >>= return . AttList) , ("ENTITY", entitydecl >>= return . Entity) , ("NOTATION", notationdecl >>= return . Notation) , ("misc", misc >>= return . MarkupMisc) ] `adjustErrP` ("when looking for a markup decl,\n"++) -- (\ (ELEMENT, ATTLIST, ENTITY, NOTATION, , or ") extsubset :: XParser ExtSubset extsubset = do td <- maybe textdecl ds <- many (peRef extsubsetdecl) return (ExtSubset td ds) extsubsetdecl :: XParser ExtSubsetDecl extsubsetdecl = ( markupdecl >>= return . ExtMarkupDecl) `onFail` ( conditionalsect >>= return . ExtConditionalSect) sddecl :: XParser SDDecl sddecl = do (word "standalone" `onFail` word "STANDALONE") commit $ do tok TokEqual `onFail` failP "missing = in 'standalone' decl" bracket (tok TokQuote) (tok TokQuote) ( (word "yes" >> return True) `onFail` (word "no" >> return False) `onFail` failP "'standalone' decl requires 'yes' or 'no' value" ) {- element :: XParser (Element Posn) element = do tok TokAnyOpen (ElemTag n as) <- elemtag oneOf' [ ("self-closing tag <"++n++"/>" , do tok TokEndClose return (Elem n as [])) , ("after open tag <"++n++">" , do tok TokAnyClose cs <- many content p <- posn m <- bracket (tok TokEndOpen) (tok TokAnyClose) name checkmatch p n m return (Elem n as cs)) ] `adjustErr` (("in element tag "++n++",\n")++) -} -- | Return a complete element including all its inner content. element :: XParser (Element Posn) element = do tok TokAnyOpen (ElemTag n as) <- elemtag return (Elem n as) `apply` ( do tok TokEndClose return [] `onFail` do tok TokAnyClose manyFinally content (do p <- posn m <- bracket (tok TokEndOpen) (tok TokAnyClose) name checkmatch p n m) ) `adjustErrBad` (("in element tag "++n++",\n")++) checkmatch :: Posn -> Name -> Name -> XParser () checkmatch p n m = if n == m then return () else failBadP ("tag <"++n++"> terminated by ") -- | Parse only the parts between angle brackets in an element tag. elemtag :: XParser ElemTag elemtag = do n <- name `adjustErrBad` ("malformed element tag\n"++) as <- many attribute return (ElemTag n as) -- | For use with stream parsers - returns the complete opening element tag. elemOpenTag :: XParser ElemTag elemOpenTag = do tok TokAnyOpen e <- elemtag tok TokAnyClose return e -- | For use with stream parsers - accepts a closing tag, provided it -- matches the given element name. elemCloseTag :: Name -> XParser () elemCloseTag n = do tok TokEndOpen p <- posn m <- name tok TokAnyClose checkmatch p n m attribute :: XParser Attribute attribute = do n <- name `adjustErr` ("malformed attribute name\n"++) tok TokEqual `onFail` failBadP "missing = in attribute" v <- attvalue `onFail` failBadP "missing attvalue" return (n,v) -- | Return a content particle, e.g. text, element, reference, etc content :: XParser (Content Posn) content = do { p <- posn ; c' <- content' ; return (c' p) } where content' = oneOf' [ ("element", element >>= return . CElem) , ("chardata", chardata >>= return . CString False) , ("reference", reference >>= return . CRef) , ("CDATA", cdsect >>= return . CString True) , ("misc", misc >>= return . CMisc) ] `adjustErrP` ("when looking for a content item,\n"++) -- (\ (element, text, reference, CDATA section, , or ") elementdecl :: XParser ElementDecl elementdecl = do tok TokSpecialOpen tok (TokSpecial ELEMENTx) n <- peRef name `adjustErrBad` ("expecting identifier in ELEMENT decl\n"++) c <- peRef contentspec `adjustErrBad` (("in content spec of ELEMENT decl: "++n++"\n")++) blank (tok TokAnyClose) `onFail` failBadP ("expected > terminating ELEMENT decl" ++"\n element name was "++show n ++"\n contentspec was "++(\ (ContentSpec p)-> show p) c) return (ElementDecl n c) contentspec :: XParser ContentSpec contentspec = oneOf' [ ("EMPTY", peRef (word "EMPTY") >> return EMPTY) , ("ANY", peRef (word "ANY") >> return ANY) , ("mixed", peRef mixed >>= return . Mixed) , ("simple", peRef cp >>= return . ContentSpec) ] -- `adjustErr` ("when looking for content spec,\n"++) -- `adjustErr` (++"\nLooking for content spec (EMPTY, ANY, mixed, etc)") choice :: XParser [CP] choice = do bracket (tok TokBraOpen `debug` "Trying choice") (blank (tok TokBraClose `debug` "Succeeded with choice")) (peRef cp `sepBy1` blank (tok TokPipe)) sequence :: XParser [CP] sequence = do -- bracket is inappropriate because of inner failBad -- bracket (tok TokBraOpen `debug` "Trying sequence") -- (blank (tok TokBraClose `debug` "Succeeded with sequence")) -- (peRef cp `sepBy1` blank (tok TokComma)) tok TokBraOpen `debug` "Trying sequence" cps <- peRef cp `sepBy1` blank (tok TokComma) blank (tok TokBraClose `debug` "Succeeded with sequence") return cps cp :: XParser CP cp = oneOf [ ( do n <- name m <- modifier let c = TagName n m return c `debug` ("ContentSpec: name "++show c)) , ( do ss <- sequence m <- modifier let c = Seq ss m return c `debug` ("ContentSpec: sequence "++show c)) , ( do cs <- choice m <- modifier let c = Choice cs m return c `debug` ("ContentSpec: choice "++show c)) ] `adjustErr` (++"\nwhen looking for a content particle") modifier :: XParser Modifier modifier = oneOf [ ( tok TokStar >> return Star ) , ( tok TokQuery >> return Query ) , ( tok TokPlus >> return Plus ) , ( return None ) ] -- just for debugging instance Show CP where show (TagName n m) = n++show m show (Choice cps m) = '(': concat (intersperse "|" (map show cps)) ++")"++show m show (Seq cps m) = '(': concat (intersperse "," (map show cps)) ++")"++show m instance Show Modifier where show None = "" show Query = "?" show Star = "*" show Plus = "+" ---- mixed :: XParser Mixed mixed = do tok TokBraOpen peRef (do tok TokHash word "PCDATA") commit $ oneOf [ ( do cs <- many (peRef (do tok TokPipe peRef name)) blank (tok TokBraClose >> tok TokStar) return (PCDATAplus cs)) , ( blank (tok TokBraClose >> tok TokStar) >> return PCDATA) , ( blank (tok TokBraClose) >> return PCDATA) ] `adjustErrP` (++"\nLooking for mixed content spec (#PCDATA | ...)*\n") attlistdecl :: XParser AttListDecl attlistdecl = do tok TokSpecialOpen tok (TokSpecial ATTLISTx) n <- peRef name `adjustErrBad` ("expecting identifier in ATTLIST\n"++) ds <- peRef (many1 (peRef attdef)) blank (tok TokAnyClose) `onFail` failBadP "missing > terminating ATTLIST" return (AttListDecl n ds) attdef :: XParser AttDef attdef = do n <- peRef name `adjustErr` ("expecting attribute name\n"++) t <- peRef atttype `adjustErr` (("within attlist defn: "++n++",\n")++) d <- peRef defaultdecl `adjustErr` (("in attlist defn: "++n++",\n")++) return (AttDef n t d) atttype :: XParser AttType atttype = oneOf' [ ("CDATA", word "CDATA" >> return StringType) , ("tokenized", tokenizedtype >>= return . TokenizedType) , ("enumerated", enumeratedtype >>= return . EnumeratedType) ] `adjustErr` ("looking for ATTTYPE,\n"++) -- `adjustErr` (++"\nLooking for ATTTYPE (CDATA, tokenized, or enumerated") tokenizedtype :: XParser TokenizedType tokenizedtype = oneOf [ ( word "ID" >> return ID) , ( word "IDREF" >> return IDREF) , ( word "IDREFS" >> return IDREFS) , ( word "ENTITY" >> return ENTITY) , ( word "ENTITIES" >> return ENTITIES) , ( word "NMTOKEN" >> return NMTOKEN) , ( word "NMTOKENS" >> return NMTOKENS) ] `onFail` do { t <- next ; failP ("Expected one of" ++" (ID, IDREF, IDREFS, ENTITY, ENTITIES, NMTOKEN, NMTOKENS)" ++"\nbut got "++show t) } -- `adjustErr` (++"\nLooking for a tokenized type:\n\ -- \ (ID, IDREF, IDREFS, ENTITY, ENTITIES, NMTOKEN, NMTOKENS)") enumeratedtype :: XParser EnumeratedType enumeratedtype = oneOf' [ ("NOTATION", notationtype >>= return . NotationType) , ("enumerated", enumeration >>= return . Enumeration) ] `adjustErr` ("looking for an enumerated or NOTATION type,\n"++) notationtype :: XParser NotationType notationtype = do word "NOTATION" bracket (tok TokBraOpen) (blank (tok TokBraClose)) (peRef name `sepBy1` peRef (tok TokPipe)) enumeration :: XParser Enumeration enumeration = bracket (tok TokBraOpen) (blank (tok TokBraClose)) (peRef nmtoken `sepBy1` blank (peRef (tok TokPipe))) defaultdecl :: XParser DefaultDecl defaultdecl = oneOf' [ ("REQUIRED", tok TokHash >> word "REQUIRED" >> return REQUIRED) , ("IMPLIED", tok TokHash >> word "IMPLIED" >> return IMPLIED) , ("FIXED", do f <- maybe (tok TokHash >> word "FIXED" >> return FIXED) a <- peRef attvalue return (DefaultTo a f) ) ] `adjustErr` ("looking for an attribute default decl,\n"++) -- `adjustErr` (++"\nLooking for an attribute default decl:\n\ -- \ (REQUIRED, IMPLIED, FIXED)") conditionalsect :: XParser ConditionalSect conditionalsect = oneOf' [ ( "INCLUDE" , do tok TokSectionOpen peRef (tok (TokSection INCLUDEx)) p <- posn tok TokSqOpen `onFail` failBadP "missing [ after INCLUDE" i <- many (peRef extsubsetdecl) tok TokSectionClose `onFail` failBadP ("missing ]]> for INCLUDE section" ++"\n begun at "++show p) return (IncludeSect i)) , ( "IGNORE" , do tok TokSectionOpen peRef (tok (TokSection IGNOREx)) p <- posn tok TokSqOpen `onFail` failBadP "missing [ after IGNORE" i <- many newIgnore -- many ignoresectcontents tok TokSectionClose `onFail` failBadP ("missing ]]> for IGNORE section" ++"\n begun at "++show p) return (IgnoreSect [])) ] `adjustErr` ("in a conditional section,\n"++) newIgnore :: XParser Ignore newIgnore = ( do tok TokSectionOpen many newIgnore `debug` "IGNORING conditional section" tok TokSectionClose return Ignore `debug` "end of IGNORED conditional section") `onFail` ( do t <- nottok [TokSectionOpen,TokSectionClose] return Ignore `debug` ("ignoring: "++show t)) --- obsolete? ignoresectcontents :: XParser IgnoreSectContents ignoresectcontents = do i <- ignore is <- many (do tok TokSectionOpen ic <- ignoresectcontents tok TokSectionClose ig <- ignore return (ic,ig)) return (IgnoreSectContents i is) ignore :: XParser Ignore ignore = do is <- many1 (nottok [TokSectionOpen,TokSectionClose]) return Ignore `debug` ("ignored all of: "++show is) ---- -- | Return either a general entity reference, or a character reference. reference :: XParser Reference reference = do bracket (tok TokAmp) (tok TokSemi) (freetext >>= val) where val ('#':'x':i) | all isHexDigit i = return . RefChar . fst . head . readHex $ i val ('#':i) | all isDigit i = return . RefChar . fst . head . readDec $ i val name = return . RefEntity $ name {- -- following is incorrect reference = ( charref >>= return . RefChar) `onFail` ( entityref >>= return . RefEntity) entityref :: XParser EntityRef entityref = do bracket (tok TokAmp) (tok TokSemi) name charref :: XParser CharRef charref = do bracket (tok TokAmp) (tok TokSemi) (freetext >>= readCharVal) where readCharVal ('#':'x':i) = return . fst . head . readHex $ i readCharVal ('#':i) = return . fst . head . readDec $ i readCharVal _ = mzero -} pereference :: XParser PEReference pereference = do bracket (tok TokPercent) (tok TokSemi) nmtoken entitydecl :: XParser EntityDecl entitydecl = ( gedecl >>= return . EntityGEDecl) `onFail` ( pedecl >>= return . EntityPEDecl) gedecl :: XParser GEDecl gedecl = do tok TokSpecialOpen tok (TokSpecial ENTITYx) n <- name e <- entitydef `adjustErrBad` (("in general entity defn "++n++",\n")++) tok TokAnyClose `onFail` failBadP ("expected > terminating G ENTITY decl "++n) stUpdate (addGE n e) `debug` ("added GE defn &"++n++";") return (GEDecl n e) pedecl :: XParser PEDecl pedecl = do tok TokSpecialOpen tok (TokSpecial ENTITYx) tok TokPercent n <- name e <- pedef `adjustErrBad` (("in parameter entity defn "++n++",\n")++) tok TokAnyClose `onFail` failBadP ("expected > terminating P ENTITY decl "++n) stUpdate (addPE n e) `debug` ("added PE defn %"++n++";\n"++show e) return (PEDecl n e) entitydef :: XParser EntityDef entitydef = oneOf' [ ("entityvalue", entityvalue >>= return . DefEntityValue) , ("external", do eid <- externalid ndd <- maybe ndatadecl return (DefExternalID eid ndd)) ] pedef :: XParser PEDef pedef = oneOf' [ ("entityvalue", entityvalue >>= return . PEDefEntityValue) , ("externalid", externalid >>= return . PEDefExternalID) ] externalid :: XParser ExternalID externalid = oneOf' [ ("SYSTEM", do word "SYSTEM" s <- systemliteral return (SYSTEM s) ) , ("PUBLIC", do word "PUBLIC" p <- pubidliteral s <- systemliteral return (PUBLIC p s) ) ] `adjustErr` ("looking for an external id,\n"++) ndatadecl :: XParser NDataDecl ndatadecl = do word "NDATA" n <- name return (NDATA n) textdecl :: XParser TextDecl textdecl = do tok TokPIOpen (word "xml" `onFail` word "XML") v <- maybe versioninfo e <- encodingdecl tok TokPIClose `onFail` failP "expected ?> terminating text decl" return (TextDecl v e) extparsedent :: XParser (ExtParsedEnt Posn) extparsedent = do t <- maybe textdecl c <- content return (ExtParsedEnt t c) extpe :: XParser ExtPE extpe = do t <- maybe textdecl e <- many (peRef extsubsetdecl) return (ExtPE t e) encodingdecl :: XParser EncodingDecl encodingdecl = do (word "encoding" `onFail` word "ENCODING") tok TokEqual `onFail` failBadP "expected = in 'encoding' decl" f <- bracket (tok TokQuote) (tok TokQuote) freetext return (EncodingDecl f) notationdecl :: XParser NotationDecl notationdecl = do tok TokSpecialOpen tok (TokSpecial NOTATIONx) n <- name e <- either externalid publicid tok TokAnyClose `onFail` failBadP ("expected > terminating NOTATION decl "++n) return (NOTATION n e) publicid :: XParser PublicID publicid = do word "PUBLIC" p <- pubidliteral return (PUBLICID p) entityvalue :: XParser EntityValue entityvalue = do -- evs <- bracket (tok TokQuote) (tok TokQuote) (many (peRef ev)) tok TokQuote pn <- posn evs <- many ev tok TokQuote `onFail` failBadP "expected quote to terminate entityvalue" -- quoted text must be rescanned for possible PERefs st <- stGet -- Prelude.either failBad (return . EntityValue) . fst3 $ return . EntityValue . fst3 $ (runParser (many ev) st (reLexEntityValue (\s-> stringify (lookupPE s st)) pn (flattenEV (EntityValue evs)))) where stringify (Just (PEDefEntityValue ev)) = Just (flattenEV ev) stringify _ = Nothing ev :: XParser EV ev = oneOf' [ ("string", (string`onFail`freetext) >>= return . EVString) , ("reference", reference >>= return . EVRef) ] `adjustErr` ("looking for entity value,\n"++) attvalue :: XParser AttValue attvalue = do avs <- bracket (tok TokQuote) (tok TokQuote) (many (either freetext reference)) return (AttValue avs) systemliteral :: XParser SystemLiteral systemliteral = do s <- bracket (tok TokQuote) (tok TokQuote) freetext return (SystemLiteral s) -- note: refs &...; not permitted pubidliteral :: XParser PubidLiteral pubidliteral = do s <- bracket (tok TokQuote) (tok TokQuote) freetext return (PubidLiteral s) -- note: freetext is too liberal here -- | Return parsed freetext (i.e. until the next markup) chardata :: XParser CharData chardata = freetext hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml/ShowXmlLazy.hs0000644006511100651110000002716010504340466023543 0ustar rossross module Text.XML.HaXml.ShowXmlLazy (showXmlLazy) where import Text.XML.HaXml.Types import Text.XML.HaXml.TypeMapping import qualified Text.XML.HaXml.XmlContent as X import Prelude hiding (maybe,either) import Maybe hiding (maybe) import Data.List -- | Convert a fully-typed XML document to a string (without DTD). showXmlLazy :: X.XmlContent a => Bool -> a -> String showXmlLazy dtd x = case X.toContents x of [CElem _ _] -> document $ toXmlLazy dtd x _ -> "" -- | Convert a fully-typed XML document to a string (with or without DTD). toXmlLazy :: X.XmlContent a => Bool -> a -> Document () toXmlLazy dtd value = let ht = toHType value in Document (Prolog (Just (XMLDecl "1.0" Nothing Nothing)) [] (if dtd then Just (toDTD ht) else Nothing) []) emptyST ( case (ht, X.toContents value) of (Tuple _, cs) -> Elem (showHType ht "") [] cs (Defined _ _ _, cs) -> Elem (showHType ht "-XML") [] cs (_, [CElem e ()]) -> e ) [] type Doc = String empty = "" ($$) a b = a ++ "\n" ++ b vcat a = foldr ($$) [] a hcat = concat (<>) = (++) (<+>) a b = a ++ " " ++ b fsep = vcat text string = string parens string = "("++string++")" nest _ string = string either f g (Left x) = f x either f g (Right x) = g x maybe f Nothing = empty maybe f (Just x) = f x --peref p = text "%" <> text p <> text ";" ---- document :: Document i -> Doc prolog :: Prolog -> Doc xmldecl :: XMLDecl -> Doc misc :: Misc -> Doc sddecl :: Bool -> Doc doctypedecl :: DocTypeDecl -> Doc markupdecl :: MarkupDecl -> Doc extsubset :: ExtSubset -> Doc extsubsetdecl :: ExtSubsetDecl -> Doc cp :: CP -> Doc element :: Element i -> Doc attribute :: Attribute -> Doc --etc content :: Content i -> Doc ---- document (Document p _ e m)= prolog p $$ element e $$ vcat (map misc m) prolog (Prolog x m1 dtd m2)= maybe xmldecl x $$ vcat (map misc m1) $$ maybe doctypedecl dtd $$ vcat (map misc m2) xmldecl (XMLDecl v e sd) = text " text v <> text "'" <+> maybe encodingdecl e <+> maybe sddecl sd <+> text "?>" misc (Comment s) = text "" misc (PI (n,s)) = text " text n <+> text s <+> text "?>" sddecl sd | sd = text "standalone='yes'" | otherwise = text "standalone='no'" doctypedecl (DTD n eid ds) = if null ds then hd <> text ">" else hd <+> text " [" $$ vcat (map markupdecl ds) $$ text "]>" where hd = text " text n <+> maybe externalid eid markupdecl (Element e) = elementdecl e markupdecl (AttList a) = attlistdecl a markupdecl (Entity e) = entitydecl e markupdecl (Notation n) = notationdecl n markupdecl (MarkupMisc m) = misc m --markupdecl (MarkupPE p m) = peref p extsubset (ExtSubset t ds) = maybe textdecl t $$ vcat (map extsubsetdecl ds) extsubsetdecl (ExtMarkupDecl m) = markupdecl m extsubsetdecl (ExtConditionalSect c) = conditionalsect c --extsubsetdecl (ExtPEReference p e) = peref p element (Elem n as []) = text "<" <> text n <+> fsep (map attribute as) <> text "/>" element e@(Elem n as cs) -- | any isText cs = text "<" <> text n <+> fsep (map attribute as) <> -- text ">" <> hcat (map content cs) <> -- text " text n <> text ">" | isText (head cs) = text "<" <> text n <+> fsep (map attribute as) <> text ">" <> hcat (map content cs) <> text " text n <> text ">" | otherwise = let (d,c) = carryelem e empty in d <> c isText (CString _ _ _) = True isText (CRef _ _) = True isText _ = False carryelem (Elem n as []) c = ( c <> text "<" <> text n <+> fsep (map attribute as) , text "/>") carryelem e@(Elem n as cs) c -- | any isText cs = ( c <> element e, empty) | otherwise = let (cs0,d0) = carryscan carrycontent cs (text ">") in ( c <> text "<" <> text n <+> fsep (map attribute as) $$ nest 2 (vcat cs0) <> --- $$ d0 <> text " text n , text ">") carrycontent (CElem e _) c = carryelem e c carrycontent (CString False s _) c = (c <> chardata s, empty) carrycontent (CString True s _) c = (c <> cdsect s, empty) carrycontent (CRef r _) c = (c <> reference r, empty) carrycontent (CMisc m _) c = (c <> misc m, empty) carryscan :: (a->c->(b,c)) -> [a] -> c -> ([b],c) carryscan f [] c = ([],c) carryscan f (a:as) c = let (b, c0) = f a c (bs,c1) = carryscan f as c0 in (b:bs, c1) --carryelem e@(Elem n as cs) c -- | isText (head cs) = -- ( start <> -- text ">" <> hcat (map content cs) <> text " text n -- , text ">") -- | otherwise = -- let (d,c0) = foldl carrycontent (start, text ">") cs in -- ( d <> c0 <> text " text n -- , text ">") -- where start = c <> text "<" <> text n <+> fsep (map attribute as) -- --carrycontent (d,c) (CElem e) = let (d',c') = carryelem e c in -- (d $$ nest 2 d', c') --carrycontent (d,c) (CString _ s) = (d <> c <> chardata s, empty) --carrycontent (d,c) (CRef r) = (d <> c <> reference r,empty) --carrycontent (d,c) (CMisc m) = (d $$ c <> misc m, empty) attribute (n,v) = text n <> text "=" <> attvalue v content (CElem e _) = element e content (CString False s _) = chardata s content (CString True s _) = cdsect s content (CRef r _) = reference r content (CMisc m _) = misc m elementdecl (ElementDecl n cs) = text " text n <+> contentspec cs <> text ">" contentspec EMPTY = text "EMPTY" contentspec ANY = text "ANY" contentspec (Mixed m) = mixed m contentspec (ContentSpec c) = cp c --contentspec (ContentPE p cs) = peref p cp (TagName n m) = text n <> modifier m cp (Choice cs m) = parens (hcat (intersperse (text "|") (map cp cs))) <> modifier m cp (Seq cs m) = parens (hcat (intersperse (text ",") (map cp cs))) <> modifier m --cp (CPPE p c) = peref p modifier None = empty modifier Query = text "?" modifier Star = text "*" modifier Plus = text "+" mixed PCDATA = text "(#PCDATA)" mixed (PCDATAplus ns) = text "(#PCDATA |" <+> hcat (intersperse (text "|") (map text ns)) <> text ")*" attlistdecl (AttListDecl n ds) = text " text n <+> fsep (map attdef ds) <> text ">" attdef (AttDef n t d) = text n <+> atttype t <+> defaultdecl d atttype StringType = text "CDATA" atttype (TokenizedType t) = tokenizedtype t atttype (EnumeratedType t) = enumeratedtype t tokenizedtype ID = text "ID" tokenizedtype IDREF = text "IDREF" tokenizedtype IDREFS = text "IDREFS" tokenizedtype ENTITY = text "ENTITY" tokenizedtype ENTITIES = text "ENTITIES" tokenizedtype NMTOKEN = text "NMTOKEN" tokenizedtype NMTOKENS = text "NMTOKENS" enumeratedtype (NotationType n)= notationtype n enumeratedtype (Enumeration e) = enumeration e notationtype ns = text "NOTATION" <+> parens (hcat (intersperse (text "|") (map text ns))) enumeration ns = parens (hcat (intersperse (text "|") (map nmtoken ns))) defaultdecl REQUIRED = text "#REQUIRED" defaultdecl IMPLIED = text "#IMPLIED" defaultdecl (DefaultTo a f) = maybe (const (text "#FIXED")) f <+> attvalue a conditionalsect (IncludeSect i)= text " vcat (map extsubsetdecl i) <+> text "]]>" conditionalsect (IgnoreSect i) = text " fsep (map ignoresectcontents i) <+> text "]]>" ignore (Ignore) = empty ignoresectcontents (IgnoreSectContents i is) = ignore i <+> vcat (map internal is) where internal (ics,i) = text " ignoresectcontents ics <+> text "]]>" <+> ignore i reference (RefEntity er) = entityref er reference (RefChar cr) = charref cr entityref n = text "&" <> text n <> text ";" charref c = text "&#" <> text (show c) <> text ";" entitydecl (EntityGEDecl d) = gedecl d entitydecl (EntityPEDecl d) = pedecl d gedecl (GEDecl n ed) = text " text n <+> entitydef ed <> text ">" pedecl (PEDecl n pd) = text " text n <+> pedef pd <> text ">" entitydef (DefEntityValue ev) = entityvalue ev entitydef (DefExternalID i nd) = externalid i <+> maybe ndatadecl nd pedef (PEDefEntityValue ev) = entityvalue ev pedef (PEDefExternalID eid) = externalid eid externalid (SYSTEM sl) = text "SYSTEM" <+> systemliteral sl externalid (PUBLIC i sl) = text "PUBLIC" <+> pubidliteral i <+> systemliteral sl ndatadecl (NDATA n) = text "NDATA" <+> text n textdecl (TextDecl vi ed) = text " maybe text vi <+> encodingdecl ed <> text "?>" extparsedent (ExtParsedEnt t c)= maybe textdecl t <+> content c extpe (ExtPE t esd) = maybe textdecl t <+> vcat (map extsubsetdecl esd) notationdecl (NOTATION n e) = text " text n <+> either externalid publicid e <> text ">" publicid (PUBLICID p) = text "PUBLICID" <+> pubidliteral p encodingdecl (EncodingDecl s) = text "encoding='" <> text s <> text "'" nmtoken s = text s attvalue (AttValue esr) = text "\"" <> hcat (map (either text reference) esr) <> text "\"" entityvalue (EntityValue evs) | containsDoubleQuote evs = text "'" <> hcat (map ev evs) <> text "'" | otherwise = text "\"" <> hcat (map ev evs) <> text "\"" ev (EVString s) = text s --ev (EVPERef p e) = peref p ev (EVRef r) = reference r pubidliteral (PubidLiteral s) | '"' `elem` s = text "'" <> text s <> text "'" | otherwise = text "\"" <> text s <> text "\"" systemliteral (SystemLiteral s) | '"' `elem` s = text "'" <> text s <> text "'" | otherwise = text "\"" <> text s <> text "\"" chardata s = {-if all isSpace s then empty else-} text s cdsect c = text " chardata c <> text "]]>" ---- containsDoubleQuote evs = any csq evs where csq (EVString s) = '"' `elem` s csq _ = False hugs98-plus-Sep2006/packages/HaXml/src/Text/XML/HaXml.hs0000644006511100651110000000223110504340456021271 0ustar rossross#define dummy -- just to ensure cpp gets called on this file -- | This is just a convenient way of bunching the XML combinators -- together with some other things you are likely to want at the -- same time. module Text.XML.HaXml ( module Text.XML.HaXml.Types , module Text.XML.HaXml.Combinators , module Text.XML.HaXml.Parse , module Text.XML.HaXml.Pretty , module Text.XML.HaXml.Html.Generate , module Text.XML.HaXml.Html.Parse , module Text.XML.HaXml.Validate , module Text.XML.HaXml.Wrappers , module Text.XML.HaXml.Verbatim , module Text.XML.HaXml.Escape , render , version ) where import Text.XML.HaXml.Types import Text.XML.HaXml.Combinators import Text.XML.HaXml.Parse (xmlParse,dtdParse) import Text.XML.HaXml.Pretty (element) import Text.XML.HaXml.Html.Generate import Text.XML.HaXml.Html.Parse (htmlParse) import Text.XML.HaXml.Validate (validate) import Text.XML.HaXml.Wrappers (fix2Args,processXmlWith) import Text.XML.HaXml.Verbatim import Text.XML.HaXml.Escape import Text.PrettyPrint.HughesPJ (render) -- | The version of the library. version :: String version = show VERSION -- expect cpp to fill in value hugs98-plus-Sep2006/packages/HaXml/src/hugs/0000755006511100651110000000000010504340456017310 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/src/hugs/exclude0000644006511100651110000000003210504340456020657 0ustar rossrossText.PrettyPrint.HughesPJ hugs98-plus-Sep2006/packages/HaXml/src/Makefile.nhc980000644006511100651110000000251610504340466020737 0ustar rossrossTHISPKG = HaXml VERSION = 1.15 SEARCH = -package base EXTRA_H_FLAGS = -K6M -DVERSION=$(VERSION) EXTRA_HBC_FLAGS = -H50M -A4M SRCS = \ Text/XML/HaXml.hs Text/XML/HaXml/Combinators.hs Text/XML/HaXml/Lex.hs \ Text/XML/HaXml/Posn.hs \ Text/XML/HaXml/Parse.hs Text/XML/HaXml/Pretty.hs \ Text/XML/HaXml/Types.hs Text/XML/HaXml/Validate.hs \ Text/XML/HaXml/Wrappers.hs \ Text/XML/HaXml/Verbatim.hs Text/XML/HaXml/Escape.hs \ Text/XML/HaXml/OneOfN.hs \ Text/XML/HaXml/ParseLazy.hs \ Text/XML/HaXml/TypeMapping.hs Text/XML/HaXml/XmlContent.hs \ Text/XML/HaXml/SAX.hs \ Text/XML/HaXml/Html/Generate.hs Text/XML/HaXml/Html/Parse.hs \ Text/XML/HaXml/Html/Pretty.hs \ Text/XML/HaXml/Html/ParseLazy.hs \ Text/XML/HaXml/Xtract/Combinators.hs \ Text/XML/HaXml/Xtract/Lex.hs \ Text/XML/HaXml/Xtract/Parse.hs \ Text/ParserCombinators/HuttonMeijer.hs \ Text/ParserCombinators/HuttonMeijerWallace.hs \ Text/ParserCombinators/Poly.hs \ Text/ParserCombinators/PolyState.hs \ Text/ParserCombinators/PolyLazy.hs \ Text/ParserCombinators/PolyStateLazy.hs \ Text/ParserCombinators/TextParser.hs \ # Here are the main rules. include ../../Makefile.common # extra rules extra: if [ -f Text/PrettyPrint/HughesPJ.hs ]; then mv Text/PrettyPrint/HughesPJ.hs Text/PrettyPrint/HughesPJ.hs.unused; fi # Here are any extra dependencies. # C-files dependencies. hugs98-plus-Sep2006/packages/HaXml/src/tools/0000755006511100651110000000000010504340466017503 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/src/tools/CanonicaliseLazy.hs0000644006511100651110000000207610504340466023274 0ustar rossrossmodule Main where import IO import List (isSuffixOf) import Text.XML.HaXml.ParseLazy (xmlParse) import Text.XML.HaXml.Html.ParseLazy (htmlParse) import Text.XML.HaXml.Wrappers (fix2Args) import Text.PrettyPrint.HughesPJ (render) import qualified Text.XML.HaXml.Pretty as XmlPP import qualified Text.XML.HaXml.Html.Pretty as HtmlPP -- This is just a trivial application that reads an XML or HTML document -- from a file (or stdin) and writes it back to another file (or stdout). -- It demonstrates the behaviour of the parser and pretty-printer, -- including any shortcomings they may have. main = fix2Args >>= \(inf,outf)-> ( if inf=="-" then getContents else readFile inf ) >>= \content-> ( if outf=="-" then return stdout else openFile outf WriteMode ) >>= \o-> let (parse,format) = if ".html" `isSuffixOf` inf || ".htm" `isSuffixOf` inf then (htmlParse inf, HtmlPP.document) else (xmlParse inf, XmlPP.document) in do ( mapM_ (hPutStrLn o) . lines . render . format . parse) content hFlush o hugs98-plus-Sep2006/packages/HaXml/src/tools/Canonicalise.hs0000644006511100651110000000167410504340456022436 0ustar rossrossmodule Main where import System (getArgs) import IO import List (isSuffixOf) import Text.XML.HaXml.Parse (xmlParse) import Text.XML.HaXml.Html.Parse (htmlParse) import Text.XML.HaXml.Pretty (document) import Text.XML.HaXml.Wrappers (fix2Args) import Text.PrettyPrint.HughesPJ (render) -- This is just a trivial application that reads an XML or HTML document -- from a file (or stdin) and writes it back to another file (or stdout). -- It demonstrates the behaviour of the parser and pretty-printer, -- including any shortcomings they may have. main = fix2Args >>= \(inf,outf)-> ( if inf=="-" then getContents else readFile inf ) >>= \content-> ( if outf=="-" then return stdout else openFile outf WriteMode ) >>= \o-> let parse = if ".html" `isSuffixOf` inf || ".htm" `isSuffixOf` inf then htmlParse inf else xmlParse inf in do ( hPutStrLn o . render . document . parse) content hFlush o hugs98-plus-Sep2006/packages/HaXml/src/tools/DtdToHaskell.hs0000644006511100651110000000447310504340456022370 0ustar rossrossmodule Main where -- This program is provided to convert an XML file containing a DTD -- into a Haskell module containing data/newtype definitions which -- mirror the DTD. Once you have used this program to generate your type -- definitions, you should import Xml2Haskell wherever you intend -- to read and write XML files with your Haskell programs. import System import IO import List (nub,takeWhile,dropWhile) --import Text.XML.HaXml.Wrappers (fix2Args) import Text.XML.HaXml.Types (DocTypeDecl(..)) import Text.XML.HaXml.Parse (dtdParse) import Text.XML.HaXml.DtdToHaskell.TypeDef (TypeDef,ppTypeDef,mangle) import Text.XML.HaXml.DtdToHaskell.Convert (dtd2TypeDef) import Text.XML.HaXml.DtdToHaskell.Instance (mkInstance) import Text.PrettyPrint.HughesPJ (render,vcat) -- sucked in from Text.XML.HaXml.Wrappers to avod dependency on T.X.H.Html fix2Args :: IO (String,String) fix2Args = do args <- getArgs case length args of 0 -> return ("-", "-") 1 -> return (args!!0, "-") 2 -> return (args!!0, args!!1) _ -> do prog <- getProgName putStrLn ("Usage: "++prog++" [xmlfile] [outfile]") exitFailure main = fix2Args >>= \(inf,outf)-> ( if inf=="-" then getContents else readFile inf ) >>= \content-> ( if outf=="-" then return stdout else openFile outf WriteMode ) >>= \o-> let (DTD name _ markup) = (getDtd . dtdParse inf) content decls = (nub . dtd2TypeDef) markup realname = if outf/="-" then mangle (trim outf) else if null name then mangle (trim inf) else mangle name in do hPutStrLn o ("module "++realname ++" where\n\nimport Text.XML.HaXml.XmlContent" ++"\nimport Text.XML.HaXml.OneOfN") -- ++"\nimport Char (isSpace)" -- ++"\nimport List (isPrefixOf)" hPutStrLn o "\n\n{-Type decls-}\n" (hPutStrLn o . render . vcat . map ppTypeDef) decls hPutStrLn o "\n\n{-Instance decls-}\n" mapM_ (hPutStrLn o . (++"\n") . render . mkInstance) decls hPutStrLn o "\n\n{-Done-}" hFlush o getDtd (Just dtd) = dtd getDtd (Nothing) = error "No DTD in this document" trim name | '/' `elem` name = (trim . tail . dropWhile (/='/')) name | '.' `elem` name = takeWhile (/='.') name | otherwise = name hugs98-plus-Sep2006/packages/HaXml/src/tools/MkOneOf.hs0000644006511100651110000000662010504340456021340 0ustar rossrossmodule Main where import System (getArgs) import Char (isDigit) import IO (hFlush,stdout) main = do args <- getArgs case length args of 1 -> do n <- saferead (head args) putStrLn ("module Text.XML.HaXml."++constructor 1 n++" where\n") putStrLn ("import Text.XML.HaXml.XmlContent\n") putStrLn (mkOneOf n) 2 -> do n <- saferead (args!!0) m <- saferead (args!!1) putStrLn ("module Text.XML.HaXml.OneOfN where\n") putStrLn ("import Text.XML.HaXml.XmlContent\n") mapM_ (putStrLn . mkOneOf) [n..m] _ -> error "Usage: MkOneOf n [m]" hFlush stdout ---- main text-generating function ---- mkOneOf :: Int -> String mkOneOf n = "data "++ typename n 12 ++ "\n "++ format 3 78 3 " = " " | " (zipWith (\m v->constructor m n++" "++v) [1..n] (take n variables)) ++ "\n deriving (Eq,Show)" ++ "\n\ninstance "++ format 10 78 10 "(" "," (map ("HTypeable "++) (take n variables)) ++ ")\n => HTypeable ("++ typename n 26 ++")\n where" ++ " toHType m = Defined \""++constructor 1 n++"\" [] []" ++ "\n\ninstance "++ format 10 78 10 "(" "," (map ("XmlContent "++) (take n variables)) ++ ")\n => XmlContent ("++ typename n 26 ++")\n where" ++ "\n parseContents =" ++ "\n "++ format 7 78 7 " (" " $ " (map (\v->"choice "++constructor v n) [1..n]) ++ "\n $ fail \""++constructor 1 n++"\")" ++ concatMap (\v->"\n toContents ("++constructor v n ++" x) = toContents x") [1..n] ++ "\n\n----" ---- constructor names ---- typename :: Int -> Int -> String typename n pos = constructor 1 n ++ format pos 78 pos " " " " (take n variables) constructor :: Int -> Int -> String constructor n m = ordinal n ++"Of" ++ show m ordinal :: Int -> String ordinal n | n <= 20 = ordinals!!n ordinal n | otherwise = "Choice"++show n ordinals = ["Zero","One","Two","Three","Four","Five","Six","Seven","Eight" ,"Nine","Ten","Eleven","Twelve","Thirteen","Fourteen","Fifteen" ,"Sixteen","Seventeen","Eighteen","Nineteen","Twenty"] ---- variable names ---- variables = [ v:[] | v <- ['a'..'z']] ++ [ v:w:[] | v <- ['a'..'z'], w <- ['a'..'z']] ---- simple pretty-printing ---- format :: Int -- current position on page -> Int -- maximum width of page -> Int -- amount to indent when a newline is emitted -> String -- text to precede first value -> String -- text to precede subsequent values -> [String] -- list of values to format -> String format cur max ind s0 s1 [] = "" format cur max ind s0 s1 (x:xs) | sameline < max = s0 ++ x ++ format sameline max ind s1 s1 xs | otherwise = "\n" ++ replicate ind ' ' ++ s0 ++ x ++ format newline max ind s1 s1 xs where sameline = cur + length s0 + length x newline = ind + length s0 + length x ---- safe integer parsing ---- saferead :: String -> IO Int saferead s | all isDigit s = return (read s) saferead s | otherwise = error ("expected a number on the commandline, " ++"but got \""++s++"\" instead") hugs98-plus-Sep2006/packages/HaXml/src/tools/Validate.hs0000644006511100651110000000153510504340456021573 0ustar rossrossmodule Main where import System (getArgs) import IO import List (isSuffixOf) import Maybe (fromJust) import Text.XML.HaXml.Types (Document(..),Content(..)) import Text.XML.HaXml.Parse (xmlParse,dtdParse) import Text.XML.HaXml.Validate (validate) import Text.XML.HaXml.Wrappers (fix2Args) -- This is a fairly trivial application that reads a DTD from a file, -- an XML document from another file (or stdin), and writes any validation -- errors to stdout. main = do (dtdf,xmlf) <- fix2Args dtdtext <- ( if dtdf=="-" then error "Usage: validate dtdfile [xmlfile]" else readFile dtdf ) content <- ( if xmlf=="-" then getContents else readFile xmlf ) let dtd = dtdParse dtdf dtdtext Document _ _ xml _ = xmlParse xmlf content errs = validate (fromJust dtd) xml mapM_ putStrLn errs hFlush stdout hugs98-plus-Sep2006/packages/HaXml/src/tools/Xtract.hs0000644006511100651110000000401510504340456021303 0ustar rossross------------------------------------------------------------ -- The Xtract tool - an XML-grep. ------------------------------------------------------------ module Main where import System (getArgs, exitWith, ExitCode(..)) import IO import Char (toLower) import List (isSuffixOf) import Text.XML.HaXml.Types import Text.XML.HaXml.Posn (posInNewCxt) import Text.XML.HaXml.Parse (xmlParse) import Text.XML.HaXml.Html.Parse (htmlParse) import Text.XML.HaXml.Xtract.Parse (xtract) import Text.PrettyPrint.HughesPJ (render, vcat, hcat, empty) import Text.XML.HaXml.Pretty (content) import Text.XML.HaXml.Html.Generate (htmlprint) main = getArgs >>= \args-> if length args < 1 then putStrLn "Usage: Xtract [xmlfile ...]" >> exitWith (ExitFailure 1) else let (pattern:files) = args -- findcontents = -- if null files then (getContents >>= \x-> return [xmlParse ""x]) -- else mapM (\x-> do c <- (if x=="-" then getContents else readFile x) -- return ((if isHTML x -- then htmlParse x else xmlParse x) c)) -- files in -- findcontents >>= \cs-> -- ( hPutStrLn stdout . render . vcat -- . map (vcat . map content . selection . getElem)) cs mapM_ (\x-> do c <- (if x=="-" then getContents else readFile x) ( if isHTML x then hPutStrLn stdout . render . htmlprint . xtract (map toLower pattern) . getElem x . htmlParse x else hPutStrLn stdout . render . format . xtract pattern . getElem x . xmlParse x) c hFlush stdout) files getElem x (Document _ _ e _) = CElem e (posInNewCxt x Nothing) isHTML x = ".html" `isSuffixOf` x || ".htm" `isSuffixOf` x format [] = empty format cs@(CString _ _ _:_) = hcat . map content $ cs format cs@(CRef _ _:_) = hcat . map content $ cs format cs = vcat . map content $ cs hugs98-plus-Sep2006/packages/HaXml/src/tools/XtractLazy.hs0000644006511100651110000000401510504340466022144 0ustar rossross------------------------------------------------------------ -- The Xtract tool - an XML-grep. ------------------------------------------------------------ module Main where import System (getArgs, exitWith, ExitCode(..)) import IO import Char (toLower) import List (isSuffixOf) import Text.XML.HaXml.Types import Text.XML.HaXml.Posn (posInNewCxt) import Text.XML.HaXml.ParseLazy (xmlParse) import Text.XML.HaXml.Html.ParseLazy(htmlParse) import Text.XML.HaXml.Xtract.Parse (xtract) import Text.PrettyPrint.HughesPJ (render, vcat, hcat, empty) import Text.XML.HaXml.Pretty (content) import Text.XML.HaXml.Html.Generate (htmlprint) main = getArgs >>= \args-> if length args < 1 then putStrLn "Usage: Xtract [xmlfile ...]" >> exitWith (ExitFailure 1) else let (pattern:files) = args -- findcontents = -- if null files then (getContents >>= \x-> return [xmlParse ""x]) -- else mapM (\x-> do c <- (if x=="-" then getContents else readFile x) -- return ((if isHTML x -- then htmlParse x else xmlParse x) c)) -- files in -- findcontents >>= \cs-> -- ( hPutStrLn stdout . render . vcat -- . map (vcat . map content . selection . getElem)) cs mapM_ (\x-> do c <- (if x=="-" then getContents else readFile x) ( if isHTML x then hPutStrLn stdout . render . htmlprint . xtract (map toLower pattern) . getElem x . htmlParse x else hPutStrLn stdout . render . format . xtract pattern . getElem x . xmlParse x) c hFlush stdout) files getElem x (Document _ _ e _) = CElem e (posInNewCxt x Nothing) isHTML x = ".html" `isSuffixOf` x || ".htm" `isSuffixOf` x format [] = empty format cs@(CString _ _ _:_) = hcat . map content $ cs format cs@(CRef _ _:_) = hcat . map content $ cs format cs = vcat . map content $ cs hugs98-plus-Sep2006/packages/HaXml/src/pkg.conf0000644006511100651110000000062710504340456017777 0ustar rossrossPackage { name = "HaXml" , auto = True , import_dirs = ["$libdir/imports/HaXml"] , source_dirs = [] , library_dirs = ["$libdir"] , hs_libraries = ["HSHaXml" ] , extra_libraries = [] , include_dirs = [] , c_includes = [] , package_deps = ["lang","data","base"] , extra_ghc_opts = [] , extra_cc_opts = [] , extra_ld_opts = [] } hugs98-plus-Sep2006/packages/HaXml/tests/0000755006511100651110000000000010504340457016716 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/0000755006511100651110000000000010504340456021247 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/001.xml0000644006511100651110000000000210504340456022261 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/002.xml0000644006511100651110000000000510504340456022265 0ustar rossross< x> hugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/003.xml0000644006511100651110000000000310504340456022264 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/005.xml0000644006511100651110000000001310504340456022267 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/007.xml0000644006511100651110000000000610504340456022273 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/008.xml0000644006511100651110000000000510504340456022273 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/010.xml0000644006511100651110000000001110504340456022261 0ustar rossross& hugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/011.xml0000644006511100651110000000001310504340456022264 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/012.xml0000644006511100651110000000002510504340456022270 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/fail-lexical/013.xml0000644006511100651110000000002410504340456022270 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/0000755006511100651110000000000010504340457017347 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace-master.xml0000644006511100651110000000327710504340457024010 0ustar rossross ]> foo foo hugs98-plus-Sep2006/packages/HaXml/tests/9x9/KAoSOntologiesF.owl0000644006511100651110000000323410504340457023042 0ustar rossross $ http://ontology.ihmc.us/KAoSOntologies.owl $ An ontology created by Andrzej Uszok (auszok@ai.uwf.edu). This ontology includes a list of references (through the owl:imports statement) to core KAoS ontologies. hugs98-plus-Sep2006/packages/HaXml/tests/9x9/KAoSOntologiesI.owl0000644006511100651110000000343310504340457023046 0ustar rossross $ http://ontology.ihmc.us/KAoSOntologies.owl $ An ontology created by Andrzej Uszok (auszok@ai.uwf.edu). This ontology includes a list of references (through the owl:imports statement) to core KAoS ontologies. hugs98-plus-Sep2006/packages/HaXml/tests/9x9/SchemaPart.rdf0000644006511100651110000000203510504340457022073 0ustar rossross Resource Ressource The most general class type type Indicates membership of a class subPropertyOf sousPropriétéDe Indicates specialization of properties hugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlBase01.xml0000644006511100651110000000031010504340457021557 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlBase01F.xml0000644006511100651110000000011410504340457021667 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlBase02.xml0000644006511100651110000000035410504340457021570 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlBase02F.xml0000644006511100651110000000011410504340457021670 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlBase03.xml0000644006511100651110000000044310504340457021570 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlBase03F.xml0000644006511100651110000000015710504340457021700 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlBase04.xml0000644006511100651110000000053310504340457021571 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlBase04F.xml0000644006511100651110000000021010504340457021667 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlLang01.xml0000644006511100651110000000031410504340457021572 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlLang01F.xml0000644006511100651110000000011410504340457021676 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlLang02.xml0000644006511100651110000000036610504340457021602 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlLang02F.xml0000644006511100651110000000011410504340457021677 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlLang03.xml0000644006511100651110000000057310504340457021603 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlLang03F.xml0000644006511100651110000000015710504340457021707 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlLang04.xml0000644006511100651110000000077310504340457021606 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/XmlLang04F.xml0000644006511100651110000000026210504340457021705 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/simple.rdf0000644006511100651110000000105610504340457021337 0ustar rossross Identifies the property used in a statement when representing the statement in reified form" hugs98-plus-Sep2006/packages/HaXml/tests/9x9/simpleF.rdf0000644006511100651110000000106010504340457021440 0ustar rossross Identifies the property used in a statement when representing the statement in reified form"hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData01F.xml0000644006511100651110000000000410504340457021724 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData01I.xml0000644006511100651110000000000410504340457021727 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData02F.xml0000644006511100651110000000032510504340457021733 0ustar rossrossignoreunknownimportantimportanthugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData02I.xml0000644006511100651110000000024610504340457021740 0ustar rossross ignore unknown important important hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData03F.xml0000644006511100651110000000013210504340457021730 0ustar rossrossError: element content or end tag expected at file xmlData03I.xml line 3 col 5 (found: hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData04F.xml0000644006511100651110000000013310504340457021732 0ustar rossrossError: tag terminated by at file xmlData04I.xml line 5 col 1 (found: some text content hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData05F.xml0000644006511100651110000000016110504340457021734 0ustar rossrossError: lexical error: expected a tagname for element in < >, but got char '%' at file xmlData05I.xml line 3 col 6hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData05I.xml0000644006511100651110000000004510504340457021740 0ustar rossross <%%%> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData06F.xml0000644006511100651110000000012210504340457021732 0ustar rossrossError: no toplevel document element at file xmlData06I.xml line 1 col 1 (found: ])hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData06I.xml0000644006511100651110000000012510504340457021740 0ustar rossross] This file is designed to provoke a particular problem with the Parse.hs module hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData07F.xml0000644006511100651110000000012410504340457021735 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData07I.xml0000644006511100651110000000015710504340457021746 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData08F.xml0000644006511100651110000000000610504340457021735 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData08I.xml0000644006511100651110000000007510504340457021746 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData09F.xml0000644006511100651110000000012210504340457021735 0ustar rossrossError: no toplevel document element at file xmlData09I.xml line 1 col 1 (found: >)hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData09I.xml0000644006511100651110000000054510504340457021751 0ustar rossross> ] hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData21F.xml0000644006511100651110000000022410504340457021732 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData21I.xml0000644006511100651110000000025710504340457021743 0ustar rossross "> %e; ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData22F.xml0000644006511100651110000000034310504340457021735 0ustar rossross ]> (La Peste: Albert Camus, © 1947; Editions Gallimard. All rights reserved)hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData22I.xml0000644006511100651110000000026710504340457021745 0ustar rossross ]> (&book;) hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData23F.xml0000644006511100651110000000034110504340457021734 0ustar rossross ]> La Peste: Albert Camus, © 1947; Editions Gallimard. All rights reservedhugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData23I.xml0000644006511100651110000000031210504340457021735 0ustar rossross ]> &book; hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData24F.xml0000644006511100651110000000043710504340457021743 0ustar rossross An ampersand may be escaped numerically (&#38;) or with a general entity (&amp;).

"> ]>

An ampersand may be escaped numerically (&#38;) or with a general entity (&amp;).

hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData24I.xml0000644006511100651110000000035610504340457021746 0ustar rossross An ampersand may be escaped numerically (&#38;#38;) or with a general entity (&amp;).

" > ]> &example; hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData25F.xml0000644006511100651110000000023710504340457021742 0ustar rossross ]> This example shows a error-prone method.hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData25I.xml0000644006511100651110000000040310504340457021740 0ustar rossross ' > %xx; ]> This example shows a &tricky; method. hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData26F.xml0000644006511100651110000000022210504340457021735 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData26I.xml0000644006511100651110000000031310504340457021741 0ustar rossross ' > %xx; ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData27F.xml0000644006511100651110000000033410504340457021742 0ustar rossross ]> att1="<t1&t2>" att2="<t1&t2>" hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData27I.xml0000644006511100651110000000037510504340457021752 0ustar rossross ]> att1="<&t1;&&t2;>" att2="<&t1;&&t2;>" hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData28F.xml0000644006511100651110000000051210504340457021741 0ustar rossross ]> Some text: t1=t2=t3= .......... hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData28I.xml0000644006511100651110000000045410504340457021751 0ustar rossross ]> Some text: &t3;. hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData29F.xml0000644006511100651110000000045110504340457021744 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData29I.xml0000644006511100651110000000052110504340457021745 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData32F.xml0000644006511100651110000000022410504340457021734 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData32I.xml0000644006511100651110000000041610504340457021742 0ustar rossross %e; ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData33F.xml0000644006511100651110000000033310504340457021736 0ustar rossross ]>

some data more data 1more data 2 wrapping up

hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData33I.ent0000644006511100651110000000017510504340457021733 0ustar rossross

some data more data 1 more data 2 wrapping up

hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData33I.xml0000644006511100651110000000014410504340457021741 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlData34I.xml0000644006511100651110000000064110504340457021744 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace01F.xml0000644006511100651110000000046310504340457022760 0ustar rossross ]> foohugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace01.xml0000644006511100651110000000054310504340457022651 0ustar rossross ]> foo hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace02F.xml0000644006511100651110000000047610504340457022765 0ustar rossross ]> foohugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace02.xml0000644006511100651110000000055210504340457022652 0ustar rossross ]> foo hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace03F.xml0000644006511100651110000000055310504340457022762 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace03.xml0000644006511100651110000000066010504340457022653 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace04F.xml0000644006511100651110000000053110504340457022757 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace04.xml0000644006511100651110000000062310504340457022653 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace05F.xml0000644006511100651110000000056110504340457022763 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace05.xml0000644006511100651110000000063710504340457022661 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace06F.xml0000644006511100651110000000056110504340457022764 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace06.xml0000644006511100651110000000066210504340457022660 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace07F.xml0000644006511100651110000000056110504340457022765 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace07.xml0000644006511100651110000000066210504340457022661 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace08F.xml0000644006511100651110000000070510504340457022766 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace08.xml0000644006511100651110000000071010504340457022654 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace09F.xml0000644006511100651110000000056410504340457022772 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlNamespace09.xml0000644006511100651110000000062110504340457022656 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlconf_xmltest_097.ent0000644006511100651110000000015710504340457023707 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlconf_xmltest_097F.xml0000644006511100651110000000042210504340457024022 0ustar rossross ]> Check that replacement text above strips XML decl in attribute a2hugs98-plus-Sep2006/packages/HaXml/tests/9x9/xmlconf_xmltest_097I.xml0000644006511100651110000000035610504340457024033 0ustar rossross %e; ]> Check that replacement text above strips XML decl in attribute a2 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/0000755006511100651110000000000010504340465022005 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/0000755006511100651110000000000010504340457023112 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/0000755006511100651110000000000010504340457024674 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/out/0000755006511100651110000000000010504340457025503 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/out/E18.xml0000644006511100651110000000004710504340457026563 0ustar rossrossentity from main dir, right!hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/out/E19.xml0000644006511100651110000000003210504340457026556 0ustar rossrosshello ! goodbyehugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/out/E24.xml0000644006511100651110000000004710504340457026560 0ustar rossrossYou can use ]]> or ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/subdir1/0000755006511100651110000000000010504340457026245 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/subdir1/E18-ent0000644006511100651110000000003310504340457027305 0ustar rossrossentity from subdir1, wrong!hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/subdir1/E18-pe0000644006511100651110000000011410504340457027123 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/subdir2/0000755006511100651110000000000010504340457026246 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/subdir2/E18-ent0000644006511100651110000000003310504340457027306 0ustar rossrossentity from subdir2, wrong!hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/subdir2/E18-extpe0000644006511100651110000000003710504340457027651 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/errata2e.xml0000644006511100651110000002047210504340457027130 0ustar rossross Duplicate token in enumerated attribute declaration Duplicate token in NOTATION attribute declaration An unused attribute default need only be syntactically correct An attribute default must be syntactically correct even if unused Declarations mis-nested wrt parameter entities are just validity errors (but note that some parsers treat some such errors as fatal) Empty content can't contain an entity reference Empty content can't contain a comment Empty content can't contain a PI Empty content can't contain whitespace Element content can contain entity reference if replacement text is whitespace Element content can contain entity reference if replacement text is whitespace, even if it came from a character reference in the literal entity value Element content can't contain character reference to whitespace Element content can't contain entity reference if replacement text is character reference to whitespace Element content can contain a comment Element content can contain a PI Mixed content can contain a comment Mixed content can contain a PI External entity containing start of entity declaration is base URI for system identifier Parameter entities and character references are included-in-literal, but general entities are bypassed. Tokens, after normalization, must be separated by space, not other whitespace characters UTF-8 entities may start with a BOM Either the built-in entity or a character reference can be used to represent greater-than after two close-square-brackets Contains an irregular UTF-8 sequence (i.e. a surrogate pair) Three-letter language codes are allowed A non-deterministic content model is an error even if the element type is not used. An external ATTLIST declaration does not make a document non-standalone if the normalization would have been the same without the declaration XML 1.0 document refers to 1.1 entity An xml:lang attribute may be empty ANY content allows character data All line-ends are normalized, even those not passed to the application. NB this can only be tested effectively in XML 1.1, since CR is in the S production; in 1.1 we can use NEL which isn't. A reference to an unparsed entity in an entity value is an error rather than forbidden (unless the entity is referenced, of course) A value other than preserve or default for xml:space is an error Conditional sections are allowed in external parameter entities referred to from the internal subset. (From John Cowan) An encoding declaration in ASCII specifying an encoding that is not compatible with ASCII (so the document is not in its declared encoding). It should generate a fatal error. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E14.dtd0000644006511100651110000000011110504340457025713 0ustar rossross "> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15a.xml0000644006511100651110000000011710504340457026110 0ustar rossross ]> ∅ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15b.xml0000644006511100651110000000010410504340457026105 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15c.xml0000644006511100651110000000007610504340457026116 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15d.xml0000644006511100651110000000006510504340457026115 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15e.xml0000644006511100651110000000013410504340457026113 0ustar rossross ]> &space; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15f.xml0000644006511100651110000000014010504340457026111 0ustar rossross ]> &space; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15g.xml0000644006511100651110000000010610504340457026114 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15h.xml0000644006511100651110000000014410504340457026117 0ustar rossross ]> &space; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15i.xml0000644006511100651110000000012110504340457026113 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15j.xml0000644006511100651110000000011310504340457026115 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15k.xml0000644006511100651110000000013010504340457026115 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E15l.xml0000644006511100651110000000012210504340457026117 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E18-ent0000644006511100651110000000003410504340457025735 0ustar rossrossentity from main dir, right!hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E18.xml0000644006511100651110000000015310504340457025752 0ustar rossross %pe; %intpe; ]> &ent; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E19.dtd0000644006511100651110000000040510504340457025726 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E19.xml0000644006511100651110000000006110504340457025751 0ustar rossross &ent; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E20.xml0000644006511100651110000000014310504340457025742 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E22.xml0000644006511100651110000000010610504340457025743 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E24.xml0000644006511100651110000000014010504340457025743 0ustar rossross "> ]> You can use ]]> or ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E27.xml0000644006511100651110000000007010504340457025750 0ustar rossross ]> 𐀀 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E29.xml0000644006511100651110000000021110504340457025747 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E2a.xml0000644006511100651110000000012410504340457026022 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E2b.xml0000644006511100651110000000021110504340457026020 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E34.xml0000644006511100651110000000010610504340457025746 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E36.dtd0000644006511100651110000000007010504340457025723 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E36.xml0000644006511100651110000000013410504340457025751 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E38.ent0000644006511100651110000000005610504340457025744 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E38.xml0000644006511100651110000000012210504340457025750 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E41.xml0000644006511100651110000000014010504340457025742 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E48.xml0000644006511100651110000000006710504340457025761 0ustar rossross ]> hello hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E50.xml0000644006511100651110000000020710504340457025746 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E55.xml0000644006511100651110000000025610504340457025757 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E57.xml0000644006511100651110000000007210504340457025755 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E60.ent0000644006511100651110000000010710504340457025734 0ustar rossross]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E60.xml0000644006511100651110000000014610504340457025751 0ustar rossross %e; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E61.xml0000644006511100651110000000006010504340457025745 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E9a.xml0000644006511100651110000000030110504340457026026 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/E9b.xml0000644006511100651110000000027010504340457026034 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/testcases.dtd0000644006511100651110000000763410504340457027401 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/errata-2e/xmlconf.xml0000644006511100651110000000075510504340457027073 0ustar rossross ]> &eduni-errata2e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/0000755006511100651110000000000010504340457025231 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/0000755006511100651110000000000010504340457025527 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/rmt-ns10.xml0000644006511100651110000001573010504340457027640 0ustar rossross Namespace name test: a perfectly good http URI Namespace name test: a syntactically plausible URI with a fictitious scheme Namespace name test: a perfectly good http URI with a fragment Namespace name test: a relative URI (deprecated) Namespace name test: a same-document relative URI (deprecated) Namespace name test: an http IRI that is not a URI Namespace inequality test: different capitalization Namespace inequality test: different escaping Namespace equality test: plain repetition Namespace equality test: use of character reference Namespace equality test: use of entity reference Namespace inequality test: equal after attribute value normalization Bad QName syntax: multiple colons Bad QName syntax: colon at end Bad QName syntax: colon at start Bad QName syntax: xmlns: Simple legal case: no namespaces Simple legal case: default namespace Simple legal case: prefixed element Simple legal case: prefixed attribute Simple legal case: default namespace and unbinding Simple legal case: default namespace and rebinding Illegal use of 1.1-style prefix unbinding in 1.0 document Simple legal case: prefix rebinding Unbound element prefix Unbound attribute prefix Reserved prefixes and namespaces: using the xml prefix undeclared Reserved prefixes and namespaces: declaring the xml prefix correctly Reserved prefixes and namespaces: declaring the xml prefix incorrectly Reserved prefixes and namespaces: binding another prefix to the xml namespace Reserved prefixes and namespaces: declaring the xmlns prefix with its correct URI (illegal) Reserved prefixes and namespaces: declaring the xmlns prefix with an incorrect URI Reserved prefixes and namespaces: binding another prefix to the xmlns namespace Reserved prefixes and namespaces: binding a reserved prefix Attribute uniqueness: repeated identical attribute Attribute uniqueness: repeated attribute with different prefixes Attribute uniqueness: different attributes with same local name Attribute uniqueness: prefixed and unprefixed attributes with same local name Attribute uniqueness: prefixed and unprefixed attributes with same local name, with default namespace Attribute uniqueness: prefixed and unprefixed attributes with same local name, with default namespace and element in default namespace Attribute uniqueness: prefixed and unprefixed attributes with same local name, element in same namespace as prefixed attribute Colon in PI name Colon in entity name Colon in entity name Colon in ID attribute name Colon in ID attribute name hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/001.xml0000644006511100651110000000030410504340457026546 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/002.xml0000644006511100651110000000035210504340457026552 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/003.xml0000644006511100651110000000033310504340457026552 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/004.xml0000644006511100651110000000027310504340457026556 0ustar rossross ] > hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/005.xml0000644006511100651110000000030310504340457026551 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/006.xml0000644006511100651110000000033110504340457026553 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/007.xml0000644006511100651110000000102110504340457026551 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/008.xml0000644006511100651110000000103010504340457026552 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/009.xml0000644006511100651110000000073310504340457026564 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/010.xml0000644006511100651110000000075210504340457026555 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/011.xml0000644006511100651110000000077410504340457026562 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/012.xml0000644006511100651110000000073010504340457026553 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/013.xml0000644006511100651110000000014210504340457026551 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/014.xml0000644006511100651110000000010710504340457026553 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/015.xml0000644006511100651110000000011110504340457026547 0ustar rossross <:foo /> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/016.xml0000644006511100651110000000014610504340457026560 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/017.xml0000644006511100651110000000010710504340457026556 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/018.xml0000644006511100651110000000016010504340457026556 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/019.xml0000644006511100651110000000016310504340457026562 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/020.xml0000644006511100651110000000017610504340457026556 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/021.xml0000644006511100651110000000022610504340457026553 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/022.xml0000644006511100651110000000027010504340457026553 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/023.xml0000644006511100651110000000024710504340457026560 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/024.xml0000644006511100651110000000026310504340457026557 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/025.xml0000644006511100651110000000007710504340457026563 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/026.xml0000644006511100651110000000011210504340457026552 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/027.xml0000644006511100651110000000016610504340457026564 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/028.xml0000644006511100651110000000023410504340457026561 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/029.xml0000644006511100651110000000022710504340457026564 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/030.xml0000644006511100651110000000025210504340457026552 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/031.xml0000644006511100651110000000026310504340457026555 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/032.xml0000644006511100651110000000025210504340457026554 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/033.xml0000644006511100651110000000024710504340457026561 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/034.xml0000644006511100651110000000021410504340457026554 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/035.xml0000644006511100651110000000031510504340457026557 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/036.xml0000644006511100651110000000033310504340457026560 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/037.xml0000644006511100651110000000033210504340457026560 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/038.xml0000644006511100651110000000030110504340457026555 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/039.xml0000644006511100651110000000045510504340457026570 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/040.xml0000644006511100651110000000044210504340457026554 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/041.xml0000644006511100651110000000036410504340457026560 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/042.xml0000644006511100651110000000010510504340457026552 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/043.xml0000644006511100651110000000016710504340457026563 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/044.xml0000644006511100651110000000020310504340457026553 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/045.xml0000644006511100651110000000021710504340457026561 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.0/046.xml0000644006511100651110000000031010504340457026554 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.1/0000755006511100651110000000000010504340457025530 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.1/rmt-ns11.xml0000644006511100651110000000213410504340457027634 0ustar rossross Namespace name test: a perfectly good http IRI that is not a URI Namespace inequality test: different escaping of non-ascii letter 1.1 style prefix unbinding 1.1 style prefix unbinding and rebinding Illegal use of prefix that has been unbound Test whether non-Latin-1 characters are accepted in IRIs, and whether they are correctly distinguished hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.1/001.xml0000644006511100651110000000034710504340457026556 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.1/002.xml0000644006511100651110000000107710504340457026560 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.1/003.xml0000644006511100651110000000020110504340457026545 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.1/004.xml0000644006511100651110000000032710504340457026557 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.1/005.xml0000644006511100651110000000022410504340457026554 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/1.1/006.xml0000644006511100651110000000112010504340457026551 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/testcases.dtd0000644006511100651110000000763410504340457027736 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/namespaces/xmlconf.xml0000644006511100651110000000100310504340457027413 0ustar rossross ]> &rmt-ns10; &rmt-ns11; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/0000755006511100651110000000000010504340457024207 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/0000755006511100651110000000000010504340457025016 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/006.xml0000644006511100651110000000007510504340457026047 0ustar rossross some text hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/007.xml0000644006511100651110000000004010504340457026040 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/010.xml0000644006511100651110000000001510504340457026034 0ustar rossross€hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/012.xml0000644006511100651110000000001410504340457026035 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/015.xml0000644006511100651110000000004410504340457026043 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/017.xml0000644006511100651110000000004210504340457026043 0ustar rossross<ð€²>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/018.xml0000644006511100651110000000004210504340457026044 0ustar rossross<󯿿>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/022.xml0000644006511100651110000000001510504340457026037 0ustar rossrossÂ…hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/023.xml0000644006511100651110000000004510504340457026043 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/024.xml0000644006511100651110000000001610504340457026042 0ustar rossross
hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/025.xml0000644006511100651110000000004510504340457026045 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/026.xml0000644006511100651110000000002210504340457026041 0ustar rossross Â…hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/027.xml0000644006511100651110000000004510504340457026047 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/028.xml0000644006511100651110000000002310504340457026044 0ustar rossross 
hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/029.xml0000644006511100651110000000005210504340457026047 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/030.xml0000644006511100651110000000003210504340457026035 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/031.xml0000644006511100651110000000005610504340457026044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/032.xml0000644006511100651110000000003310504340457026040 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/033.xml0000644006511100651110000000005610504340457026046 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/034.xml0000644006511100651110000000003110504340457026040 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/035.xml0000644006511100651110000000005610504340457026050 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/036.xml0000644006511100651110000000003210504340457026043 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/037.xml0000644006511100651110000000006310504340457026050 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/040.xml0000644006511100651110000000001510504340457026037 0ustar rossrossÂŒhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/043.xml0000644006511100651110000000004510504340457026045 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/044.xml0000644006511100651110000000001510504340457026043 0ustar rossrossÂŒhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/045.xml0000644006511100651110000000004610504340457026050 0ustar rossrossŒhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/046.xml0000644006511100651110000000001510504340457026045 0ustar rossrossÂ…hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/047.xml0000644006511100651110000000004510504340457026051 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/048.xml0000644006511100651110000000001610504340457026050 0ustar rossross
hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/049.xml0000644006511100651110000000004510504340457026053 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/050.xml0000644006511100651110000000002010504340457026034 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/051.xml0000644006511100651110000000004510504340457026044 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/052.xml0000644006511100651110000000002310504340457026041 0ustar rossrossabcÂ…defhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/053.xml0000644006511100651110000000005410504340457026046 0ustar rossrossabc…defhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/out/054.xml0000644006511100651110000000004510504340457026047 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/xmlconf.xml0000644006511100651110000000070210504340457026376 0ustar rossross ]> &eduni-xml11; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/001.dtd0000644006511100651110000000007210504340457025203 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/001.xml0000644006511100651110000000015710504340457025234 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/002.pe0000644006511100651110000000007210504340457025035 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/002.xml0000644006511100651110000000020210504340457025224 0ustar rossross %pe; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/003.ent0000644006511100651110000000006110504340457025216 0ustar rossross some text hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/003.xml0000644006511100651110000000024610504340457025235 0ustar rossross ]> &ent; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/004.ent0000644006511100651110000000006110504340457025217 0ustar rossross some text hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/004.xml0000644006511100651110000000024410504340457025234 0ustar rossross ]> &ent; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/005.xml0000644006511100651110000000032510504340457025235 0ustar rossross ]> &ent1; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/005_1.ent0000644006511100651110000000005610504340457025444 0ustar rossross &ent2; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/005_2.ent0000644006511100651110000000006110504340457025441 0ustar rossross some text hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/006.xml0000644006511100651110000000043610504340457025241 0ustar rossross ]> &ent1; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/006_1.ent0000644006511100651110000000005610504340457025445 0ustar rossross &ent2; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/006_2.ent0000644006511100651110000000006110504340457025442 0ustar rossross some text hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/007.xml0000644006511100651110000000014710504340457025241 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/008.xml0000644006511100651110000000016010504340457025235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/009.ent0000644006511100651110000000006310504340457025226 0ustar rossross some text hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/009.xml0000644006511100651110000000025410504340457025242 0ustar rossross ]> &ent; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/010.xml0000644006511100651110000000024410504340457025231 0ustar rossross ]> € hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/011.xml0000644006511100651110000000024410504340457025232 0ustar rossross ]> € hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/012.xml0000644006511100651110000000023510504340457025233 0ustar rossross ]>  hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/013.xml0000644006511100651110000000023510504340457025234 0ustar rossross ]>  hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/014.xml0000644006511100651110000000017610504340457025241 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/015.xml0000644006511100651110000000017010504340457025234 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/016.xml0000644006511100651110000000020510504340457025234 0ustar rossross <ð€²/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/017.xml0000644006511100651110000000020510504340457025235 0ustar rossross <ð€²/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/018.xml0000644006511100651110000000014210504340457025236 0ustar rossross <󯿿/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/019.xml0000644006511100651110000000014210504340457025237 0ustar rossross <󯿿/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/020.xml0000644006511100651110000000021610504340457025231 0ustar rossross <ó°€€/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/021.xml0000644006511100651110000000021610504340457025232 0ustar rossross <ó°€€/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/022.xml0000644006511100651110000000034010504340457025231 0ustar rossross ]> … hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/023.xml0000644006511100651110000000034010504340457025232 0ustar rossross ]> … hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/024.xml0000644006511100651110000000031610504340457025236 0ustar rossross ]> 
 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/025.xml0000644006511100651110000000031610504340457025237 0ustar rossross ]> 
 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/026.xml0000644006511100651110000000033010504340457025234 0ustar rossross ]> … hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/027.xml0000644006511100651110000000033010504340457025235 0ustar rossross ]> … hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/028.xml0000644006511100651110000000040310504340457025237 0ustar rossross ]> 
 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/029.xml0000644006511100651110000000030510504340457025241 0ustar rossross ]> 
 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/030.xml0000644006511100651110000000040310504340457025230 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/031.xml0000644006511100651110000000040310504340457025231 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/032.xml0000644006511100651110000000036110504340457025235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/033.xml0000644006511100651110000000036110504340457025236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/034.xml0000644006511100651110000000057010504340457025241 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/035.xml0000644006511100651110000000057010504340457025242 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/036.xml0000644006511100651110000000067210504340457025246 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/037.xml0000644006511100651110000000067210504340457025247 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/038.xml0000644006511100651110000000027210504340457025244 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/039.xml0000644006511100651110000000027210504340457025245 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/040.xml0000644006511100651110000000027510504340457025240 0ustar rossross ]> Œ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/041.xml0000644006511100651110000000027510504340457025241 0ustar rossross ]> Œ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/042.xml0000644006511100651110000000032510504340457025236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/043.xml0000644006511100651110000000032510504340457025237 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/044.xml0000644006511100651110000000037010504340457025240 0ustar rossross ]> Œ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/045.xml0000644006511100651110000000037010504340457025241 0ustar rossross ]> Œ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/046.xml0000644006511100651110000000033610504340457025244 0ustar rossross ]> … hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/047.xml0000644006511100651110000000033610504340457025245 0ustar rossross ]> … hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/048.xml0000644006511100651110000000031510504340457025243 0ustar rossross ]> 
 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/049.xml0000644006511100651110000000031510504340457025244 0ustar rossross ]> 
 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/050.xml0000644006511100651110000000051510504340457025236 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/051.xml0000644006511100651110000000051510504340457025237 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/052.xml0000644006511100651110000000062510504340457025242 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/053.xml0000644006511100651110000000062510504340457025243 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/054.xml0000644006511100651110000000076110504340457025245 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/055.xml0000644006511100651110000000014510504340457025242 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/056.xml0000644006511100651110000000013710504340457025244 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/057.xml0000644006511100651110000000014110504340457025240 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/xml11.xml0000644006511100651110000003243010504340457025675 0ustar rossross External subset has later version number External PE has later version number External general entity has later version number External general entity has later version number (no decl means 1.0) Indirect external general entity has later version number Second-level external general entity has later version number than first-level, but not later than document, so not an error. A vanilla XML 1.1 document an implausibly-versioned document External general entity has implausible version number Contains a C1 control, legal in XML 1.0, illegal in XML 1.1 Contains a C1 control, legal in XML 1.0, illegal in XML 1.1 Contains a DEL, legal in XML 1.0, illegal in XML 1.1 Contains a DEL, legal in XML 1.0, illegal in XML 1.1 Has a "long s" in a name, legal in XML 1.1, illegal in XML 1.0 Has a "long s" in a name, legal in XML 1.1, illegal in XML 1.0 Has a Byzantine Musical Symbol Kratimata in a name, legal in XML 1.1, illegal in XML 1.0 Has a Byzantine Musical Symbol Kratimata in a name, legal in XML 1.1, illegal in XML 1.0 Has the last legal namechar in XML 1.1, illegal in XML 1.0 Has the last legal namechar in XML 1.1, illegal in XML 1.0 Has the first character after the last legal namechar in XML 1.1, illegal in both XML 1.0 and 1.1 Has the first character after the last legal namechar in XML 1.1, illegal in both XML 1.0 and 1.1 Has a NEL character; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1 Has a NEL character; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1 Has an LSEP character; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1 Has an LSEP character; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1 Has CR-NEL; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1 Has CR-NEL; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1 Has CR-LSEP; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1. Note that CR and LSEP are not combined into a single LF Has CR-LSEP; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1 Has a NEL character in an NMTOKENS attribute; well-formed in both XML 1.0 and 1.1, but valid only in 1.1 Has a NEL character in an NMTOKENS attribute; well-formed in both XML 1.0 and 1.1, but valid only in 1.1 Has an LSEP character in an NMTOKENS attribute; well-formed in both XML 1.0 and 1.1, but valid only in 1.1 Has an LSEP character in an NMTOKENS attribute; well-formed in both XML 1.0 and 1.1, but valid only in 1.1 Has an NMTOKENS attribute containing a CR character that comes from a character reference in an internal entity. Because CR is in the S production, this is valid in both XML 1.0 and 1.1. Has an NMTOKENS attribute containing a CR character that comes from a character reference in an internal entity. Because CR is in the S production, this is valid in both XML 1.0 and 1.1. Has an NMTOKENS attribute containing a NEL character that comes from a character reference in an internal entity. Because NEL is not in the S production (even though real NELs are converted to LF on input), this is invalid in both XML 1.0 and 1.1. Has an NMTOKENS attribute containing a NEL character that comes from a character reference in an internal entity. Because NEL is not in the S production (even though real NELs are converted to LF on input), this is invalid in both XML 1.0 and 1.1. Contains a C0 control character (form-feed), illegal in both XML 1.0 and 1.1 Contains a C0 control character (form-feed), illegal in both XML 1.0 and 1.1 Contains a C1 control character (partial line up), legal in XML 1.0 but not 1.1 Contains a C1 control character (partial line up), legal in XML 1.0 but not 1.1 Contains a character reference to a C0 control character (form-feed), legal in XML 1.1 but not 1.0 Contains a character reference to a C0 control character (form-feed), legal in XML 1.1 but not 1.0 Contains a character reference to a C1 control character (partial line up), legal in both XML 1.0 and 1.1 (but for different reasons) Contains a character reference to a C1 control character (partial line up), legal in both XML 1.0 and 1.1 (but for different reasons) Has a NEL character in element content whitespace; well-formed in both XML 1.0 and 1.1, but valid only in 1.1 Has a NEL character in element content whitespace; well-formed in both XML 1.0 and 1.1, but valid only in 1.1 Has an LSEP character in element content whitespace; well-formed in both XML 1.0 and 1.1, but valid only in 1.1 has an LSEP character in element content whitespace; well-formed in both XML 1.0 and 1.1, but valid only in 1.1 Has element content whitespace containing a CR character that comes from a character reference in an internal entity. Because CR is in the S production, this is valid in both XML 1.0 and 1.1. Has element content whitespace containing a CR character that comes from a character reference in an internal entity. Because CR is in the S production, this is valid in both XML 1.0 and 1.1. Has element content whitespace containing a NEL character that comes from a character reference in an internal entity. Because NEL is not in the S production (even though real NELs are converted to LF on input), this is invalid in both XML 1.0 and 1.1. Has element content whitespace containing a NEL character that comes from a character reference in an internal entity. Because NEL is not in the S production (even though real NELs are converted to LF on input), this is invalid in both XML 1.0 and 1.1. Contains a character reference to a C0 control character (form-feed) in an entity value. This will be legal (in XML 1.1) when the entity declaration is parsed, but what about when it is used? According to the grammar in the CR spec, it should be illegal (because the replacement text must match "content"), but this is probably not intended. This will be fixed in the PR version. Has a Latin-1 NEL in the XML declaration (to be made an error in PR) Has a UTF-8 NEL in the XML declaration (to be made an error in PR) Has a UTF-8 LSEP in the XML declaration (to be made an error in PR) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/eduni/xml-1.1/testcases.dtd0000644006511100651110000000763410504340457026714 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/files/0000755006511100651110000000000010504340457023110 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/files/a_oasis-logo.gif0000644006511100651110000002224710504340457026162 0ustar rossrossGIF89aE–÷))199!!!)))111999BJJRZ!J!B!R1Z11J)!R9!Zck!c)c)c!c!k)k1k!s)s){9s1{1{9{9!c9!k91k9!{B1ZB{J9cJ1kJ9kJ1{R9sR9{BBBJJJRRRZZZZRcJB{ZBsZJsZB{cJ{ccckkksss{{{9„BŒB!„J!„B)„B!ŒJ)ŒR)ŒB1ŒR9„R1ŒJ!”J)”R)”R)œZ9”R1œZ1œZ9œc9œZ1¥Z9¥Z9­c9¥ZBŒZRŒZB”cJ„cR„kR„sZŒcB”cJœkR”kZ”sRœscŒ{s„{c”sk”{k”{s”kJ­kR¥sR¥sZ¥{Z¥{Z­sRµ{Rµ{Zµ{c­„sœŒ{œ„Z½„k¥„c­„k­Œ{¥„s­„cµ„kµŒkµ„c½ŒsµŒs½Œ{½”sµ”s½”{½œ{½”{Æ„„„ŒŒŒŒ„””””œœœ”„¥”Œ¥œ”­”Œµœ„½œŒ½¥”¥¥œ­¥Œ½¥”½¥œ½¥¥¥¥¥µ­¥µµµµ½µ½½½½”„Æœ„ÆœŒÆœŒÎ”„Ö¥ŒÆ¥ŒÎ­œÆ­œÎ­œÖµœÞ­¥Æ­¥Îµ­Æµ¥ÎµµÆ½µÆ½½Æ½µÎ½½Îµ¥Ö½¥Ö½­Ö½¥Þ½½Ö½µÞ­„罜罌÷½¥ç½µçƽÖνÖƵÞƽÞνÞÆ­ïƵçƽçεïÆ¥ÿÖ½÷Ö½ÿÆÆÆÎÎÎÎÆÖÎÆÞÖÆÖÖÆÞÖÖÖÖÖÞÞÞÞÎÆçÎÎçÎÆïÖÆçÖÎçÖÎïÞÎïÞÖçÖÖïÞÖïÎÆÿÖÆ÷ÞÆÿÞÎÿçÞïçÞ÷ïÖÿïÞÿçççççïïçïïïï÷÷ç÷÷ï÷ÿïÿÿïïï÷ïçÿ÷çÿ÷ïÿï÷÷÷÷÷ÿÿ÷ÿÿÿ!ùö,E–‡))199!!!)))111999BJJRZ!J!B!R1Z11J)!R9!Zck!c)c)c!c!k)k1k!s)s){9s1{1{9{9!c9!k91k9!{B1ZB{J9cJ1kJ9kJ1{R9sR9{BBBJJJRRRZZZZRcJB{ZBsZJsZB{cJ{ccckkksss{{{9„BŒB!„J!„B)„B!ŒJ)ŒR)ŒB1ŒR9„R1ŒJ!”J)”R)”R)œZ9”R1œZ1œZ9œc9œZ1¥Z9¥Z9­c9¥ZBŒZRŒZB”cJ„cR„kR„sZŒcB”cJœkR”kZ”sRœscŒ{s„{c”sk”{k”{s”kJ­kR¥sR¥sZ¥{Z¥{Z­sRµ{Rµ{Zµ{c­„sœŒ{œ„Z½„k¥„c­„k­Œ{¥„s­„cµ„kµŒkµ„c½ŒsµŒs½Œ{½”sµ”s½”{½œ{½”{Æ„„„ŒŒŒŒ„””””œœœ”„¥”Œ¥œ”­”Œµœ„½œŒ½¥”¥¥œ­¥Œ½¥”½¥œ½¥¥¥¥¥µ­¥µµµµ½µ½½½½”„Æœ„ÆœŒÆœŒÎ”„Ö¥ŒÆ¥ŒÎ­œÆ­œÎ­œÖµœÞ­¥Æ­¥Îµ­Æµ¥ÎµµÆ½µÆ½½Æ½µÎ½½Îµ¥Ö½¥Ö½­Ö½¥Þ½½Ö½µÞ­„罜罌÷½¥ç½µçƽÖνÖƵÞƽÞνÞÆ­ïƵçƽçεïÆ¥ÿÖ½÷Ö½ÿÆÆÆÎÎÎÎÆÖÎÆÞÖÆÖÖÆÞÖÖÖÖÖÞÞÞÞÎÆçÎÎçÎÆïÖÆçÖÎçÖÎïÞÎïÞÖçÖÖïÞÖïÎÆÿÖÆ÷ÞÆÿÞÎÿçÞïçÞ÷ïÖÿïÞÿçççççïïçïïïï÷÷ç÷÷ï÷ÿïÿÿïïï÷ïçÿ÷çÿ÷ïÿï÷÷÷÷÷ÿÿ÷ÿÿÿþí H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱžÃz =Š´7²$Ç“(Sª\ɲ¥KSÆ ó¥Í›8sê”9ò M†=!†$h²fF“>I*5º³©Ó§O™b¤W*Ô… —^ÝʵëF‘CƒF¤GÔkY­Rͪ]Ëö!جmãÊ+7­[’4Åî´K·¯ßºxݹƒ(Ï^aÃñÄ)§LY1_ªN"¥¨P¡P¢$ŸRµjÕ/cÅ´‰ÞVÞa™S«vIo];Á áq£ ¤0;rû㥷.`Ì”G?ÈÛÑÃ\=kÖ°¹CuH™\ÛF.ÞGªYùþ®O¾ ÙƒóèÑkפÕò Ç/Ù©=[d0‘Â_Š˜1rÔñGrÈBÈ!~2!† bÈ N‚È$”d˜¡(¢`2Š(”˜R‰†ÒÇ$šÔR9§ù”×Râ•'£jôÌÓÎ<îÐãHƒ Ÿ=å# /´ 4ô0sÈ1Gh‡€€PIˆB8È–"r¡!‰$B"%¢˜b晧˜‚Šš¨¤ÒJ*¨hRÉ$’HÂÉ,ÜüÓ[ZÁ4ãŸåÍT<ñ”“Œ P Q‚ JH¡ÅmDJǤm¼Q‡ sÔ¡©¦Uò% ‚ȃ "¢"¡$¢H"ˆÈ¡(þŽ"«™’¥¢Š­ªäºŠ*µôúJ*¦d’0Û˜ÖbA1ªl[ìœgÏ;ÐôÁ°`s¸áF¤rpûätä!îvLY% v øë‚:ˆ .èå!^¶Š‡¦pøᙦœ’J*þÖš«®»öZË-µÌòÊ+®pâI,Îä™Ô²³å,YñȳL%˜pN\©VXéȾñFqÀa†pØ!G¹vðaǹBÈ»„‚HÏ={¹¥!“-á$“TRI&f®9Ê™ÿ‰ + /lõ·Ü" .ºèâë,·i—-=Ô Õ2¡…Yœüö¶n@Úm¥oÈÇþpg}ÃÜwßqØQ¸¹ø`½÷Ž8 %£(I%˜ˆ˜I%k¶u*¯ ÒyկؒõèaßÒõ0]Ór ,±ÐÍ;fÇ.”RU—ñ$ãÆ# ÅÛÀ¯Å¶‘–Ü…L$OÃò3Ì°C_€q†ôg°1uØß1õÖG·FÞ;çG„!ö›fš¦ËæÕìÛ"ºèYã¢50ÀÌ2 ýÄ< 1ÄÔÌ6æ2”Š¨$ë 7, pÀQÈ‚¨P…’½m Z(”`#$AMX’Î2£ _€£Çrˆ|ìsˆÈ0.j‘ŠQLȃß$0á¯ôq.jþãÜ+jaµ÷e G¤Ÿ1Œü=ƒPœ…3Æq,»$k€¹A#’vÀ‡P»Á†@„(¼ ŽªB¦Ð¨ XÀ°†Hh<¹b:¨Otâ–ˆ$I L`â_½RÅÂze‹ƒÝˆ¤0²&Éa£‰ü{†&Ÿ kXcÀx†7R8+b±/?‘Jiɣ帰$D! WÈ % á%(BÚ ^ÄÃ;«DH‹ x¼Äd…±Ù†0X¬ýkˆ«ÀE#I'?\ÈoZF‡ñ P’³ØȆ5²ÁÎiLÃÎPÇ{ðâ§SÎÅ”þ ;Ø!cö¢´à„]Bá!@bà4?âÝ7¿dÎ}Òˆ`³Á XSyÐÞÈv:ýío‹›Íš'¹_"ØæpÀt0 ÍC an–Hœ¥EF/¼«Q7þ¦¡_nŒøÖä(t‰ õ¸|Þ·H=¾ëÀ„Pˆm‡,:¤×.ŠD„.t¨%‚ 0Vt×çWß 5ÎÁl+zàŠ68q{v¬ÇG¸€< |vx±í[±³:PŒbul™ê¹¶ó*û‹÷Šä PváÕ²kEoÛïUw¹a¿xŠÌ£-å+o½'Ú§>íñÅ%Íù:ÿÜ™=*½Z ^õÁ«ž#ç) i/êvlþõ6QÕoû†Ô#«á'HÚóÞ¯äX.'®ñ5‚ZØ',Ë_ ï£Ñ7Ÿúا rþ›ýî{ÿûà¿øÇOþò›ÿüè÷}ú×°³ÿý¯÷øMä¯úCÅþð7ÈŘÏ^¯ä<Èö`&þçØ]§·€û7ø—}€™ç?õ€f8€{õ§˜€ Øk˜¨€¡5~%èxÒÐ Ìð‚Ì çf ¸€O±Xƒˆ…€ÁhøØ€é^Ø Ž€J¸„LØ„p Hƒ9(¨‚cQƒ× ›À@`5  °7‹ð @ 'ˆˆ… €?u ° ‹€5ÀcH† €BàÀ 4hä‡Xç þ „ЄŒÈ„‹¸„ pB„ —h‰?ЃØ 8Ј¤Èˆ ›0‰?µw`ˆ7`¯øŠ50‚5¨  ‰XŠº¸?Ð “h‚á§ÔðŠ¨‹HŠÇǸÍ@‹A I¸ˆÉ¨Œ‹( º˜ŒT8Ô ‹!hø¹‰ÚHŠ Oâ×k0ÈxŽÙÈ +aŽÅ¨ŒLèb@(7üxž`©Œ ‚΢ ЄîÈÊX~؈҈Œ0 ™èˆPŽy‘„ˆù6  Pö؉i’︄ 8yJXþŽ&Ù’Ú8¸€Ò„'ùˆÇ(5ÀÒÀ€„õøˆ¹¸ˆŒàŒYh£è‘$ 6iÎR)¹ˆ ðŽÀ Ô@ Ì`‡8À©„À8’ô¨„‹ = •ÅhA° ÍÀ‚žðB€ €‘–X…1Gƒƒø‰È“K˜‹ p–KIŒô˜Œ ð†(‰~™‘J8ˆZ(ÿˆ’ô˜›àÌ  ð˜ X”ÇØ ±Ù„¹X ÙžðƃœflèYÓØ—KÈ™?÷&–ÒŒ(ŽôpŒÕø”õø®‰Ã)œJø!„!¡à€ô:ÙˆøØþ!xyud¡ˆN©„À†ÇiƒúG€ô i‘Ö¨…¿¹žhBPŠàžáÔX˜ž€RÉÌ@ŸA•'É„W‡ÑižªG{ç˜KèXžÔ†h‘PÉV(Ž›YŒpØæÕm¥¶/û¾ÿûÀüÂ?üÄ_üÆüÈŸüÊ¿üÌßüÎþÿü›oæl*ý"]ù¼o‚ºÿ½T Ö˽%{úHJÈ>¨½wìSXÞ5ª§ ʵ]û®…KüÞþ¼åæÑ°r‚½z1[9ù¬oøaOà@uéD8PáB{¤QaÁ†-N¬èðà9†;~RäH’%MžD™áÁGXðС‡iÚSG €Ç™)Ú5 !OšXб¦L{šy,ºÒ€¥ tZ™ðáOƒU{R¬º°&T•eÍžE›VmB* ‘ Ù°Jrˆ£ÆЬ3e XëÊwúÄÈ€GUãâäYp,ı~É^”LYàN¦k=þšäAPäÚÛ¹iFôVP@Ï\Òì%p´¸5 ÒÜ„^€<Ñ[,d‘ðÜ0pôr‘ÇÅI…¸´aïœàÛpÝ壆 ^žkOÀ¹N60@À€M7Þ –`õ&õ°Ïž[„ž 7—š0GìY€‘`Ààè/¾D1DOz!hÚÉ%œ`Æß ³ˆØXs1EF|2í¡©P(i@9,€ PÛ„uh‘¤lOP{ê¡EjP‡@¡g“ÀêœÃÚ‘¡˜ñ±O(í °jÈ“õr8 Ýþè‡Ý à ãˆìšBΆˆ8G·ØùpDEet!$½ã5Ûèq$6{6Y$PÚó)Eï(…€ˆ4Ň©L‡8ˆþdĆM’BHm`à fðÒ“El@¹X¬©§ì ¾Ô%7!t‚Ô­1 /²TØDˆj‘ƒTZoj´\sE;È-~˜Q;$¸€½°§þìYäÁÃœÜìÁ‘Æ=/¯-è‡ „8ÑN!Ý„^«<ÁaBˆömæ Þbʼn«2ÜŒG5‹ôµkh&=«\€™zD(j rÄaªìñD•µƒÙap¡;·gŸÑþàOÙL›Í+ÜŽ©:è†Þܺr³ÁýzIÊ4œB6p¯ƒ R h¿4hf$Àte¨Q·ÇÜ zÑìDN5ok1ÆȬÈ?¼è©‡­úáȃ b@ÏK…jûgÇWé!â‚P0 9Ö XÔ€xd“¸  a­i6fäÅ›ùa/¸HRkz˜N N,‡MTÃhR‡;Fè,ˆôL—<Ƀ` €|ÓÜžx¤4@Z`Ȉµl3à©NÔUÀz€Ø €¼qˆÉ¥¼!g¿ý"¢§d»ºÔîâ‡q+Èt}’fþòÄúv£‹Pc ˆË#þ$vš‡PƒMûC#á!Žx¥÷‚ ˜°²ƒ¨ãp  @áŽ&a éñ·š4Æ}/„!Cz“à @ä¢b.ÕÎ$¤Ì`“œÌ°"AôÈ-Ò“º\¤2N<\¢¤C*þl2—™Šð ýA%,_DZ—˜Ã'Êä‰2L b¾ò>{(ñ#r¹â\Üx¢Ä±ŠwlTg~bD †)rIÏÓx¤‘Ž Aí¨CF%+ó#ä ¯hÆÈC, á!5ùB;Z&3vÔJä.)>ÒeŠ^D#QFÓHN”›„¥gøG1Îe2“l$G¹KVŠä•©´K,…þšÓÌŘºlå‡:)ÕDˆjÊǸL›€²‰J©¥{ÉC Ó›yæoIÈLÞäŒkÄe*kIHAŽ¢LÉ/¿9OLŽ²3Îìæ5A¢Ç’È3”6¡Ë8ÙYÌ#êµ\g!yIPz6Ô$ ­ÌWùO::ĪœŒ6­ÉÆHRŒ—¡¥¥¨H‡–ô¡Ñ#€lBtªÌ¡!E:–@^RbÙDég Á-±‡bìLçȅƸôñ§Ž ¹°Lˆ’&…j;[jØÆ8R®fLlâÄ…5Ñi]Ò™€F  £#vÑ+q¡#Z£ÐcpÊ•:úWþF"ndSKeAñ˜‹FÕ°a&…!=j5X¢Æ&6Q±†Hã)êXŽ4n7AÊÊ'çÂA‚P;á ØK§\dGüàôÒqX„cQãAð („c!°ËÁÒTaÛƒHc´QGÉBè­ äBÌ Ç#»9B­ÁTnìAÄi»ÌBDQ©="4lz+‚¡j©ãH7jzŠœx"7ài[mPc§MÔÀD-QíKn0ûî>àYS߀܀;ÁAp¼´ °50í¨|`íåŒPG6Q- „MKBX ²‚Ö ¯õ(@ôu„4VzþÔ,à 8 ±¢#”áHrP'n7ºAH ó§z…>Â=m£cî&ߎ펪‚àò%éq&ÁÛ*[=‚µHñÈ  ‡ T© D5˜ò"„R6z0#&×zhåd¨0¹c2‘‘Çxd.2Ãa ÑYÙ!­m…°—Jö¦áŠŠf²­wʇA13×ó(ãЃÓ‰nùj„(àdö`ãã<Û`HHÚ„¤1g>¹I ¨à_{Ø@Ë?ˆÕªä„„–­ÖR¢:ñæà@‡™=à#hÎi½þ|ÔtVvBšž;Ú 5cÊèt+ä̵¯ZPþºTÞé„¡¯6®ÛÔŽ+² Œ–"u\ '‚}”F¹Í g®!C[bbÐ !”£ÆƒD%ü6Û `dv’§‚›í!8˜3r,ãí’À€6X°Nä] ÀÑq.št"Óä¤)MšP…±Ý$êÒã:èÎÐFRt¯ $e_-j¤h6³œÈ7’v„{Lîëk¿$À4ÀDÀTÀdÀtÀ„À”À ¤À ´@“;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/files/committee.css0000644006511100651110000000431510504340457025613 0ustar rossrossP { FONT-FAMILY: Times New Roman, Times, serif; FONT-SIZE: 12pt; MARGIN-LEFT: 1pc; TEXT-ALIGN: justify } H1 { COLOR: #000066; FONT-FAMILY: "Trebuchet MS", Helvetica, Arial, sans-serif; FONT-SIZE: 24pt; FONT-WEIGHT: bold; TEXT-ALIGN: center; TEXT-TRANSFORM: uppercase } H2 { COLOR: #000066; FONT-FAMILY: "Trebuchet MS", Helvetica, Arial, sans-serif; TEXT-TRANSFORM: capitalize } H3 { COLOR: #000066; FONT-FAMILY: "Trebuchet MS", Helvetica, Arial, sans-serif; TEXT-TRANSFORM: capitalize } A { COLOR: blue; FONT-WEIGHT: bold } A:visited { COLOR: maroon } A:active { BACKGROUND-COLOR: blue; COLOR: white } A:hover { BACKGROUND-COLOR: purple; COLOR: white } BODY { BACKGROUND-COLOR: white; MARGIN-LEFT: 1pc; MARGIN-RIGHT: 1pc } .topbox { BACKGROUND-COLOR: #cccccc; BORDER-BOTTOM: black thin; BORDER-LEFT: black thin; BORDER-RIGHT: black thin; BORDER-TOP: #000000 thin; COLOR: #000000; FONT-FAMILY: sans-serif; FONT-SIZE: 10pt; FONT-WEIGHT: bold; MARGIN-LEFT: 2%; MARGIN-RIGHT: 2%; PADDING-BOTTOM: 5px; PADDING-TOP: 5px; TEXT-ALIGN: right } .bottom { BACKGROUND-COLOR: #eeeeee; BORDER-BOTTOM: thin; BORDER-LEFT: thin; BORDER-RIGHT: thin; BORDER-TOP: thin; FONT-FAMILY: sans-serif; FONT-SIZE: 10pt; MARGIN-LEFT: 0%; MARGIN-RIGHT: 0%; PADDING-LEFT: 3pc } H4 { COLOR: #0066CC; FONT-FAMILY: "Trebuchet MS", Helvetica, Arial, sans-serif; TEXT-TRANSFORM: capitalize } OL LI { LIST-STYLE: lower-roman } UL LI { LIST-STYLE: square } .main { BACKGROUND-COLOR: #6699ff; BORDER-BOTTOM: black thin dotted; BORDER-LEFT: black thin dotted; BORDER-RIGHT: black thin dotted; BORDER-TOP: #000000 thin dotted; COLOR: #eeeeee; FONT-FAMILY: Verdana, Helvetica, Arial, sans-serif; FONT-SIZE: 24pt; FONT-WEIGHT: bold; MARGIN-LEFT: 4%; MARGIN-RIGHT: 4% } H5 { COLOR: #000066; FONT-FAMILY: "Trebuchet MS", Helvetica, Arial, sans-serif; TEXT-TRANSFORM: capitalize } .purple { COLOR: #6633ff } OL LI LI { LIST-STYLE: lower-alpha } UL LI LI { LIST-STYLE: circle } .membersonly { BACKGROUND-COLOR: #ccccff; BORDER-BOTTOM: thin solid; BORDER-LEFT: solid; BORDER-RIGHT: solid; BORDER-TOP: thin solid; COLOR: blue; FONT-FAMILY: sans-serif; FONT-WEIGHT: bold } .public { COLOR: #aaaaff; FONT-WEIGHT: bold } hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/files/top3.jpe0000644006511100651110000005436710504340457024514 0ustar rossrossÿØÿàJFIFddÿþAdobe ImageReadyÿìDuckyÿî!AdobedÀ `XõÿÛ„   #%'%#//33//@@@@@@@@@@@@@@@&&0##0+.'''.+550055@@?@@@@@@@@@@@@ÿ˜@"ÿÄà!1" 4@30PA#5`%&!1AQa"q‘2¡B#±ÁÑR‚ábr¢3 ð’²Ò0ñCs“$@`ÂâS³t!1AQaq"‘2¡±ÁR ðÑBr@#Páb¢â3s$ÿÚ ßùè~“œ#·ƒÞ“M {Uå6 —òHÈ™„_=ó§~cZŸ-¿>ñö¡M¶UowžEÑDïa—÷Ÿ~Ù•å¶7°84ú,ã (ö‚(;j}ï3ËÌ,O "–qtÚU$MìçKmEÓh HäÞžA²Ž*Š59­%7bÒtŸ¼ºÛÏ[pˆúö¡f«emiW¹MPAtðõ_±Áê5-µƒ‘’>X”Ø'\õEÔóJê¬tE"²/²lƒƒ¾‡ÃÄluÐ\äM”®²¤eÔèRgž~àNêå*ЙlÏŸçF‡‰½£<ë©' õUµ‰wÈÑw M pØaüùÉ´üȾ™¯.›í拪Ÿ.rl¬þt çºÐ˜Ñ¢€È¸µ[r’xz;±^;si-²Íè§ÇjÍ×!]¦P kAvl¨€GäH·™ÆÍ} Åì1ÇÙ"<Íé\²EëUlŠŠKêä1…YSSÁ¼ÍËΠÖøræS±N}ÌžÛ+ZÆËÕÌí¹"ï<î8nÝt/N Ó³Ï'8çÈ?©ˆ¯‰Öcl,L•çÑoJ®ò›:‹\&ƒ/uoA]‘u cEúzìÎŒIš3Òí]:ñê,(<Îʯ8¾Ž‚2’PѪ“»«ª¾f=64RÛ$~ŠÍc0öH‰$ ³Dƒô á®xX6éùîôÅ]Üšg:¡ñ¥ÌSjxÿ§¡±Î:®§„_¹ï~<BÙH¤w¥ó½ùaïhŸÅ°B·SUðÇBéíá$S/Å5åV½ JT[ž“µS# òï(BcËa•)‰…‚:LÞ†©‚¢n¬õº×†aøãèÓe%矇ÕHo\â¬ÅTØý¯Þx;}pÍ2ú+%ÌQ$ÆÚ¶SE©·!ÊâÕ£Ó \˸K ‘E´kõTNŽ§Ë»o-ÈÓ¢Òå-¯1A^·§.²|×bÂ:@g}B&òtáwVZ·/¶Çê«AŸp›Fjx¸ÂAi“½†€ùêN¹ÕÏgzææýmÀmÐdÑ4f‘Í•§8lªû+îʈ¡¤—/pºV‚W–i€U²²PGÛš¨Ò¼KåU/“h(³tzÆ5ftɦ²·°ÐnŽ?IÊʘd7%™b®igMû‹Ú£8ìÄ•°zz ËGžó'Z–Ç&±TÙ¥ÑïŸé6ýMfuZ,µšáf ­ŒÙf5yÈξ¹#e xv:’æÃ/ŒÌ)?s©Ç#9’ä2ê"hì°8ÆÊ tÊï¢q¤…fŠï("‹|óºx½¡ììŠí¢Û|~y$%@ ¥òÍÚÿÞöK4Y÷Û°šÓ)¢¥8¢ÔŸ=ôŒ–¥yY˦µJÖé³K:ÀIrpº› :F·F˜ ñd\™¾§Q§gZDhÅ´Þ.z«‰²„ÌÇÅ~ Ú#ú¸Úâu5ZÅ?—؆ê’.v±¹g4yÅí§Ø@«DéOPFW²zNóº—ÅDzˆòÜã.0Ž½tNÚÔ[6ôù¢s´t«IçC’º&$6èžeO»8+?ÞžodRH+i¦—’i`: =eYÛ…Ê´ÒhP›È<ÃV^M|×Nöë—Îhîe(´J0جɧ$kÎöeÊ1|x*3CÛ1ihv'¥àãN›V³–ŸR¬l>IE ‚oÓ„6-ÓEgA•Më­¤J§r„²®Sƒˆ”óV¸F³ Co+¥¢í-XF+¸s×ʈ¶wc¬Ÿeû$JH8€¢Àº¯y®­0i¨±0_×djŽ;¬o€¶Tv½ˆTr“ļ:ŽÃ‚•;<¤„­hø¿  ª¸ hf¸塘šjd‘úñR}6FŒÏn‡$ø@P=ÝÑ-œœÅÆr|¥š­ÏcE~‚¦':YpÞñ•OµíS¸ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ÿÚ‘þ ö&Üí Oq‘ÖÅæS.€äVnʼ´Ìƒ3E¾!••Ç$š2]zg/òF%> Ç]Ž…r¬…›í Ss¥b%P €¼šB$²±Ä'>,cgýRÄL|³þÅ:ÂÅSRÙât™ó#NW†A&|nµÂ±ãAÜrÑXb¤ò3±,¥—îÚü;uÂ:áVâ1^I "G$üþ²}×IóãÈGLV£•È TÈUíV–U=Gj´fQ(U`r£*X7#t3¯ÌXSÄ~QÛ ðÌ>6%ãƒõñ#x€ öþbCéñø’; ™‹Ñãž‹OC¸ÛäJ) .H…º,‰/'~¿v( âø½øJM)è’x?Âc’1gÁID+!”A¢Ä*DÌ…mª°u ¥¤ÎÁÏbb9ÆŒ‡†X˜/È}±bPt«ñ.äˆ8(Äôd$ˆzUû̵’V´…%útGFZiTy;€ÅÀA¸Ó4vÑú¼‹Wm´²ÌÒ_ërGXØ’Q ‰MŒS‘¾ Y‚†~FA Há'ŽŠXÄ |AP>ƒéÁß ÐÀ!Ò…£mªèÑ ,VTBÇŒ¤î«$—P%wŽÍ¨Ü=˜dÔ`Œ$Ð2 P3ž»‰þ&ÑBñaIž ëf5X©Èb$/éçc£Ù'óø’/Ó®O+*Ë+»4’¢Wàï¸æ–3Kw£a‘Ä.Š~ô=Õ·/Ì×¹ö¢Ã'"†¹ H¿µR"¯ €ÑBÑI]U¬ £Ê¡¢¸½Å?n!ÀÄp’xG|Ž|èzN2!1³!&†ËSC+H`ͱ2C^½pîXþ ì¼Ìg™PI "IK 8<²îK¥¡tWQOõØ ǾËþ¡I-!t@íHë±×|@¤”GIò; “a¥ƒ>´I;á=ÿ§We%‰þ Hà‘¸%qϺü.ÇþQÿÚEù4•T#HµÃ+EUO§$†²Fäð0 «v6SÏ¡ã}$ñœ‚`0'¿Ò’¬œhšg­ ½\OVÉa!5¢&JdXÖÄŠ9 3(ŒôGÓÿ»<†; $?uX4bÄ­É]J[`fçÈ‚³iÕB…*@?>¡º$÷À>¡”†úò8úeA×Äq~ cí‰~|cÂUXº»¿v×\%˜·r#°á?‹~_\ë} 𪎸ßN1WäÍñø•V<*À¯;çÁ€ Ž ì×;=IúG͇!“:…yG|#âY‚—$±,ü‰‚ +@þ‚O}· ={ù};#€žÉÙ€ŽbV_ÒÝð½un9upÌAü×åÀO`·‚;äQÿܘ‚òéúào£Y>(^häãE!â÷ñÿ á s¾¸~<íyúzíO?O;^½ÇŠ6ä1!‘ˆ’J?Ö) 5¤ŽÏ :FW’¾¸O á~Ù›êǾuÈ¡g3ÕýKJSÁJREÎàG>'žtG>'Έ=Á‡|€üd,  ür»±’ÙèF íe ±%ì÷·àÍõ'‡ c+ÓÆø¯óí!TŒP ï2ŽvyÙçׄžvIùs²9Ùï³ÈXž4jÜCúꞤž@î¹ñ8  ö§„ ߟSù«4æ ;kQ]i«—X¥²«Él»ðžÿ9Ðï OC:ë~¨åI¶> ôW¾¡W—;$ xÄW…e2L`¡ŽØ*ó ØbÉá?éÙCs ?ÿ ¸¸$aϸü,ÇþQÿÚá äé|•ƒMv´ 5ºð4f3©CŸÊPçò”9ü¥)CƒR‰L´OCŸV®\TiçÚ²ÊÚgŒ)$W‹Ç$dr¹rŸUWQòzíò¬óDKN“Õ±%eG†ìÔkS•H­À…Ê@“¼õ;b–8‚4uç!¢ºzŸDª&­hZ/M<Ú¬f$+¶=JïòÈ9Z‘|ºÙÌÙèÒH¬%ûqÎÔ°CãØíb=¯á¦H£Z›X:ûW`AÝëõöî;.}<øìÅü4|þ>äÅUJUE©—Aü-'ÉmÄy»E‹kîE"Èý#ú™ögåõ5nEn;$•¡FL¬kw«8± Å4°5{]Î’"ùóæ…*,_/Ë•ÔPÂTRüV’E! ä“Å«n¼66’xŸÕanötA·VÅ›%ÒÄ}âµ+ˆ¾óý˜Ø¤M ¨Ò¸¯XØ­d´Én_±Iç̪ÆÆ|“ãÆ,–3CÇèg3ËTªÙ¿$Ï]ªIû8IS‰9î£|£ü5?°Ãüôóþ|ÍÐûg_ëk_ý±PZÏþ&êŸã/òjW JžjØßÝþ2/Ém€9­,1M£Y¬–bŸ°‡£#€Dä)èáØhìJý—± ¢Ý»eì~åã¬,vú~ùÕêWÖ±z›2Š‰r’ÀðrÊ5W¾"Êxèè~í@)Ñ]--jt¯ kòÝö4Ú)3%’M õžT³ d7c‡ö³'Æ‹Ê ¢0£J9¥#A(FÔÏŠÀ•Þ)k O ç2Ô^Ô°´ëÊ -Xþá·;Ún%šÁ’\iGË5»‡ðÔþÃ}«äÐ&¶•X´®ènlµ8¢Úmú[kϱ¬–¦šÃÖÊ’“Á˜õà±_S:ܯ"F‘läÍÍý¦§_ås?[<HÔGÑä<|¢œ"‘æêÄ.ZEKܤa$L'ê­àìÛ,c+ÚÅ*·4$øÁ ê”®ÇÏ@<ëZ)² ±aZbY£„«§,i%„è(Š‡:ü•ä¡¡U¬Ë£xî~ÆÝIégS•/ÆýŸÜ?Þp‘ÞT‘å=UîNV…#T?òëŽÀȽMB‡iÑaBµÛ“Kn÷鯟Yb’(à?L‡+&;wô{Ÿü%Xôüü>sF}œÆ‹Ñ ±bÊôóãЗØiõ°†ªúKè°âÃj±½èñkùõôrË­»¿ähUβü@ï&ü“Bž*¦yæeä¬k}%»V7½ãQWüÆ8`oq#*ûÏqÑ›ÑEôÂIή•OGv–±KÖ:õ%„O™až\HªÁ£^5~£‚<ºGN§>ÇÙ$«ÑT=eêJèEê&…™öù!,êÈ4g(½ž('з2þ%;)ƒ(hÍÍ›­5{s3 ãvµƒ4¯[>¸Ô·Wö­#…ù0ã†$p~yýÌaÕoéô8'j-o=ü“mæ6¾U,çVò3ÉcgÌÁ©3ùï¹±«åàй»åáÕlŸµnnyÚúãCÌ×½F/<­·L¢Ú¤Îÿl,w£m]‡h­^šf‘æ»-ZÑ×]ña4ÖC]^DèêÒ©ÆdVy¨ÙҞɟ¦*¬Æ>XÒ7;#Ï=˜¬H`Óµ¯Fõ92+ 6 ³D±ZWÆ®mÌÇ[õ[pÈ!ŲjPtÕ+ü9þ•R@Bý›yÊÒÏ"@ŠÒ´ËËñ–͹ÏÛb?m,\ÎöÒ·-¶V4_¯)JÁøzÍ{M¢|…Ø×ÖhÙ£ƒ¹Zl_óìó&W£§ªþÀÍ0ãnRÙ¯£í3éÚ]ȵ=NϧÏÈsïó’-ŸGOáõT[2Ï·§f·˜ÒŠŸ–ÜÒwha—rô%Ò¦I»[íœVM4‘/fÁ7voWxuýˆéXš|{‘uÅ_³ôÕ¥§kí &ºö+1äu‚BÕ‡ÞPWÀ*ÀtïÙ<†\âÓµŠ‰! V2Y1Ý•Eåº ‘²°â!ùät­`|ƒz(¼Ý›Z¾fŽU] V-ø¯I+7•¯4™8ÂSÃS¯&.c=m¯|”-ŠQûL&­7­÷ÑgíPúÞ©¢žŠ´ÇÎÏŠÿžÇ©Ã©JÈ·S“'É4+wͧ¬þÝÔ=òξ[ª‹eÒÔo›éiÒ§¯s;÷YšGN›/gZ/þÒÒ&žG7ÑÌõÃ+-§3Õ—ßîXÀžö+W‹>öÅUŽÈ¯6…F…“”ÖKIj‘\»Öä€ü&ײ¿©€eU’°@’ýR@ÁÜqWêc,¼_E‡1¾b‰¾È<ý¼h%£5T—–3R@r-)ªí ç[nV²ócÍQÕ5|lRÚÌ«f¥_1ŸZŠø w7ÍV̓ šT|ýj—.øz6lPñ¹ônkù::rœRþ ïkâTÕŠ/Ayþ-Cø¨<-‘UQ Uƒ‹¹……lÇŠâÄÊÌ5"Öá)»¥æ¬ÌÖàŽd³¥r¡ú/&XªÏÆŨ G¤S©Îš 5e–#$%ä*b°Èϵ,Ñݱ•vLÈnV¨÷šÇ+å­†zlóÿTÇçÇ|º@c"ñH²á–‘\ö®…{Gä®>}È^BÃ?Î?¼ìQܨä“À’N‡1mr­(ÕŒ…'¡gOZy“gjÚů©«-l©w¼ÑóQÿCjƒ;ØCbÞß¡§Š•ýÊ}ý½³ý…m ‹»~š Yà÷pµ­ÊXÕ×Ý”oej~zMZ™XÃÞ8âíç6`÷Ž_¥ƒR¾>œ[9ô´+èèØ®ª%AÈäP6*iµ™I2ù]&©lýN )ÄеûZ‘/Q¹¤#S§î­…+iD±Øs‚Ä”o¡܇æ.äqgV“*Kyëiç­ú6®\Õ¥WϯÙ̶ìMzÂN9xš[¡Ž:"Õ°ÁÒ`0E"’3säU«:+ÈajV†§s>,ý±Š&•>ì0Ù‰'±Ê´Â„@]òל˷Ŷжc*–T®¨c‰[»+ô2†«¢ ]èð ÌG#‘~ëJƒ‘Kõ7ç­[ÕÑŽ¶ýÈmI u†»d’/šéÛ ²c’½V³Û¥#21ä,àÇr$‘LsÇOº @ð¬F,ÕkÅ"´hܵ¥!VÖ”¦†aîµPTê뉃M5u|å C•äòó%Ô£¨¹þ7&”ÿÁÔ:º˜•5Ö;Wõ±ëjÅwÚÕü.¿£ŠÑÒáì4ô¡ß­bÄ™Etô {’çäXô5ëòÅ굩Ÿ@[R?CFkêæÔZËëdÁ}šW¦¿­›E¬ïæÔ—KÐV¥vÅ…7-k+‹©&>ž×æÕóí£-¬ >ÉxªöìG ïväØ· ÁlyIâkþRnK‘z]Z>RgÍÊsëcÉ ´ól*WóS/Gks\ÈÔ¹_f„÷`_=rY/àÙ±>VuºÖ›.ü»PaêW­GÏÙ‚VÁ¿ˆ¼þ•v£çìÃ,þJQeÓ·ÿÂÿÚ?œÙôDËÁGÖˆ„.y$0ê½HK\*¯cjÞIl|P”mÙ"XWþIý+>?òBp·hÅñüË`”K£ :[0Ò„¢ADqj4wG|Š"U®hfOYuAªx(ÎDôˆú-d<œ ;‚"$/Š”$r¥TØ×A8ýªç #àV!3ÁH>eEó.y T§ °nD™_ú¨ÍªbË¿ø§òVì³™’#ü‰¢÷%ÿÔq1Õ¥•Û“³rå«–Àx‡ò€þj`%íϹi¦8Çùp^¥¨^ £s’&Xdp)À%·!)ŽÉHÃýO'æ…ûS'AbÈœGÉLk$ˆ½p-¿õF†$¸äTá?í6¢p®äÜV(„ q#Tj˜K¢Û€ª5ÝE‘høª³€»~ ·&rbJ¸ŽïÑ™ot #Ñä‰%ÄG‹"w–D[v¬¦ûÎH[57$[e™È´cr$“_÷e˜ýñÔ KˆjrcÜÇÑ™ÆkNÖŒt³Þ­™\qkvÙŒÄØ÷8V® ñ…ˆ[Œgb¯AÝ,ÇQÍ{X šlˆ5Ø¿me'Ñ{sp=¼mÛá˹“ÜáLFAãî®ÜîŒÙˆðBÙ4‘î 4ê 6`$}R¨2öŒÂ˜2ž¨ˆ ÔΩŒÁäUR#v[êŽ+Ž‡vQ™8ßšï ¡S‹©ÍÈ1¨ µTÄ5YKÕ˜€p53↲?‰ú²Œ{Ü4GOî.œŸÁí£* ݼ%(âÀ«€ÎÕ¹]6ç¬ê4à€‰6É„¬^!®ÆàxŠ´€ÇäP3‰›û9ÎŒ¥.ñV"ui½gÔ—>ì8Q{Xm™Zœç'2~´è£;rg ÛõÃü‹!&£·‚Ô"ŒäÀ3ÕV©œ’IÞUo"„ÄA¢&"´3l%²ÙÈGù¿ÁøN+TIÞr tÓ, C¡ÆR‡8e (µS‡Û,·d¹‚"42$ä#S‚·nÕÑpÜ–šÄÄÇy#rÑn2ÿç”™†–=JÑn3ÔĈ¶Rža0,ƒ@4ˆƒ(*ÌA™¸mˆ c“ƒÁ \桵H–“»’Œ`.fe›öË6ú€¤Þ'8Pi‹àXîåUi£.€}팥"MŸv’\’é†4F-E%«VJPzbˆN@—Ç$g–(Zq˜ÈÐÕÓ6%ÿ©‘«í o†&™¶Nš#À#¦% ‘mD`¢À²ªŒ§+îµæ"¬÷OÜÊÕèÜõ'i´cñ^œ§rÝÙÜŒ„P“b„2¾ eýÙÙ1Õºbêvå)Â7#g¼:­Åˆz‚…½W4mè„w¯S³áÁÕ˜ÂW&-FûÈÅ«r,>¬‹“¹n^ß(Eăêp\1W êܯÎç§+b]²ûdàĪSd¢õ!0—`Ê°žY&¦;ÅâÌI¯.¶ÅhÁÃÕf²ªj7)Ë6?¢´ˆ…RCUìw„Z2ž€çH%†òÈU FFaT!îmDſ쇛™¢ÕCýÁ‚&aÜ0:D¾y4·”è‰jUÁóu^çÓ‘„=;×cÀäT}Yjë~¬®w™¹â1Ž’Ej&ÌïÊõ½zã"7ÒR™ºöÖgevà ê#Ot™¢½´%lÊ^æ%æ&Fžã@VD­Jù¾ï!"»KE³U»e{›ñxâtÄ0æY-Ÿm¦ô-âD„ÿ—î ì…‰Y6§‚ds•]ó^ði"6|˜ÑæZ'dá«J‡ù©‰í'Á8Ê@ý$S.FíÈ*9Rç …°d쉢)S¶ª¡9‰æßTà•;q³¯Q}YžjR”tk$ÐR¥Ö°¸ägŒ†ð1Ž«€1™ß™WiÒLu %³±rböê-àŒ#rqÆ"D H 1/åH”·å/åΈÆ',DdBa)ú¨sVs¹§ R%Ì e®á¹†‹à´Æ¡W ÃG(ƒ†ÆH]¸ÐUs܃‡«þ $Èj áÑ¢mËa„À”d¨ú O–yuFhŠÌùzoBD³áÐ&Ô%²U$¶ÿÇŠÅâ]cþÿÚ?Œ~âŠ>™2”<Ñ?E¦D³² {’#Á™ÜqCùeç¹ùèŒe;ùá°ƒDƒP‡TA ‚ÕX ÇŽÃA°ŒÂ$áŠ0ŒHyˆFa'XÌòQŒÃÊ/Ç7Qð,>*(&u>Š=S±n É/R‹`JƒÜZ¹qQˆaW'€Fsˆï/¶–Á –ÿœ~jS‰Áº†VîÄ·¨àÅ[ŒgÎ8ñN ³Þ!†g>HÆfà•4"Çp벆¡HáÐí£µ1¨#aFDŽü+CcirƒdsUÞë.H&I‹:î^@øÐ FäîXb 8 ]ß ¥"§ ià€SsUc]¤pA°wB•qTX~àˆj¾*E¹"áÕw¨ªMØ<§4Irê,Ij14‚ (¸(pØíMƒ–ÆdnéÝ!–_ÊQ Á‘@J´è€š´F:„¤FX­7qÑÑ”cNFFœ‹!¿ðž#䱫…O¹‘à¥Í•vN.ÅÎàƒdíÕ —jMS,8à´i²ÓWªÞƒœ6jûKªýƒæˆé±˜ÅB:‹óÉzb:ð]¢ÌáEË–n{jªUX…Í1OEV¨[ŸaÔìTcVñÅ6 jª H,@ÉJ$yP“pAZM±EÆH,ûl]¤ú`4~Ünw.ë+MJ("HÞóÓ-³s­w=¤íQñ8–ØåƒX`A³€“Û€{2~ÛH0t×ÚÃ,d>dˆ^üôm?—ÿ)É0{qÿÂvqÔtiŸõ »Lü¹þ·Ýý¹þ´û¿· z½ôÃYb° ‘€ú§O·ß‡ÛŸ«U²º¯I †n5lc×HÓFGhûFã…DR@b$˜Á¹•€:‚£QÐÂ7&¤©Â íÝ ‰1”Ñb›6Ë=¨4Vs1ùó7Oä3Ó£¹U€ó¶€ÓL@DÁ?·?Óoˆé„Ø PLÆ]]õ kµ‘KUÔÏUoC‚ŠŽÇ«2)€Ý5œœ*7ö@>ÅŒ:1ÐI·SbD’bí#j‰E>¥ è  …įHrè¬Vf,>f:a‚,´8£Ê­= :öd]bú¯¿MÀôîÌõ’OÉ‹éêö¯¶ÝÐX+,ùµÛ¸ÉÂÛ‚!»f=[˜1€äBƒ;ñ·VÁle‡0{ñv„+©ˆ'¯qöᥙ…'lê@=c.EUP;TŸ~=ŒbTIöœ f@h‘‚^z&0rUÇå[¶˜,º7ÄdZª G™‰þ'(âØbÍ« jH]#Ç6n@<@Ôkû2Lªµh׶á©]Ç·Ý‹R w`£Ús‰ô„ÿJ°,ä°Ðm^Ïk¶%/$ÖìÓ€’~m@ hHé¡Ä©ª¹[e ²ªuüG•á[ ‚ÐF§ã‚dÙÀ0¶ßéÿ™rßwïÃ}#Ïø׿7'ácÙƒÄ sþû²¤˜`%OŽ@qÏþì6?Ê;Aœ¶» ² †7øOíì„81ßœpÛ] ’zºmV>ó–ßk2QL„D€H_〦íÀi` íÀ,ò–7aû-``„$f€˜fÝÄ+©ø¦ ’GS¬c½Ú `À, ‘8NÖRN + qѶ«@S¿gNÀA$.tȶ’5÷ä– ©ÐTœ…²®G!‰hnvÇM½ø«f–œ04#ofRX,±@öå6qW”VmK€¤˜5¹Ó§fzV”¦ŒÆS:æä!UÁVP<²aj{ðZ=HÍ3¹YX‚;võûóe–Œ:‚K;{r°ÌJØF±nV(ò­ŠYŽéËÖ¢ÂÛP"0Óh\ü4œ~búÄ£›ºkòøùc_nzhºë!Sd ‚3Õäå_æ³meC°74ù2ªäA"z(þö ¨{2º‹nÚËz|rËJIgÚ†`üÙ$H2 vIÅ¥L35ì'V¯°aÒtó“Ô‘@ž‡Ç+rUZÄ’'RA‰ÁÛ$i9Ì`Æ /x€:`¹€ÜÂHèLôÖß•ÿøû”ÿb? î:þìf#æcÁ–Ò‘ |ÓóFxýçìÑžïönö×ÿì\ãýS‡6q94ÖüšOÊAPIûúö{3ê_P©XÔõU?4JiœŸ«}MÖ½…É…€O~ƒ»>]$ŠîrÁ?—ðéíʸOX4Ý[Ûh“æÌbz÷ŒúX=ƒÔÎ`æ±ý7”ª™#@vO¾'á•ýWéÍè[UŠ›téï„çÒ«²k^] °B¶ö+û³õ§“UÕÜŠ°Iê®ÚÌÿ&p~„l5q\z–öno9ý‰ÄåÜž(55—Ü 3¡žü¤xÿ~pÿò+ÿ”aÓÁfÍÀ‚™ æŒPž°ºÚFm­·3h¢€s¤±cÔ“öì ®¸X¢X‚»Y}„F¬0ed@#€ÄÞ2扇SÊdËå A÷û²â4 âzâ21¢ê vaÚäO€ÏÌbÐ I˜Æp¤£ÕVã:q¦ Ë Y– I3”«jŒè¤„¨øcúv¬dÓ`õgËÐŒÌV]ij¸ :F™"gÛš€Vg²@?Û˜ˆ¤IÓ Ö °5'7(ííÇû2Ë&±]:@q–‘å \Z›‘P>Kˆ=1ŽH…5£(ø4œ6RX ˆ‚Ðkï1•°bTX´‘–TuÚ Od¨ßû³Ž@·Ô-Þ*1vîu¯p=3Ô¸ìZј³tíÆ4XKT e`T•é8 ƒ¯Ç$ €;õÀÃOlöåa¶–@ÁLɉÅ$€Œn.õjön’á W>’1Tîmº´Áj:‚0Rµj%Ô‰ìÊÒ …í:œ±Ä¼ÀíÓíÜÏö[‹Å ¾Â²X!X7d÷gƒÉ ^šR¶FäP¦'Ùœ‹ëhãßYOOµX²<4Ë[趨¢ã-S€Wö™ÆúŸ>äµÑƒZuE@?fUõ?¦Z*ä×åµX33×±ŽpùçgéøÊC’HbHn‚~©ýßJçÑÕµVǯwvTÿ^½KIÜ(¬@'Æëß®pùèx¼PAÔ†7Aø²®?`‹±r@Ñ]{þl¯›ÂK•N¨ÃãÇç_X¨•_Q‡MÅTiþñ•}*öäS% ‰ß¼DÆ7Ô-[Mgm%DE@ ôÍÎ]H%›ºNly‚t#R5ÂÀˆóhcøç†nÜ4ëà1›RLül0iÒm¨3°þPLfâ›G÷ˆ,kÊH¹p†®`@:“ìËÔ®Ýw}Ø+ꦢb~ÚÓ«nÁ± ªˆù–~ü!¸Œ,'~uþYÎ Ö´k$˜žü>¢i&:GsFªÉ!µ˜$˜'SÖÍ'$ëõÀÀ@#:±  ž€Ær´+c©ö†Èmêf3ÊIÇìý2¨\@s)잺wb¸e Çh;q¾¦ä ÈÅÀŠ6Ÿ») ÀjËÓÓÍü0(Ô¨wƒÓk’¤tëZÞÌ‚Öb '§»ø®×q€•µ4>#dΞªW`Il“#¨q9hB@Å'ǯQeŒ¬IÔ@ÆF°ò@h >8î9U« @’Lv1è3ò.Gdò ˆîîÇ`dÀˆÖhŸ68¹€&ÅH¬Ÿi×îÃÊåØ+¤vêdž€×cÕc+õT€Äô‚'ïÊ>Áôî2²r+Q¡´ §oUϧ‘α*º¦eá„;0hfiëíšawäX~›J5f°4õ©;{uÄúTŸÕXž¢ˆ;vÿӔþ©ˆõßÓM ·›Ç8”S}‰GÁ梈 ÆûÚb}NÛ}.-Š]’ Û©Ÿ ôE­Q&ìR¨}úǾ>Ʋ£Ó4¶áÙ?ž†}-cMŽ#ÿS² § `F’Î!cÐÊ ï"Ý3éµÌ»òTí*þÓŸHB£k\wi-_\ú´F© ô©·JšÂFiÓ·®_Óø¡Ï»‘Ŭùhf1§´Ÿ»8)_ßÁâ¸g⤠PŒ‹´4°c=cUœ.7'™ÅZh ±´ma |tœ ;Du=;IÉ#\e’ ÈŽüêT/ß•W3cˆ @öå|zôJÖ‰í?± êc=6º±gòPÓìÃ2:Œ±®€ºi'rŽžüKâˆ=b=ÀndRÁfe‹¸*¢ ³¬ŽÓŠËª°ÓÜr'P“¦DÌiéÊ’ Ä€DânÐî:t=1ìã wT" Æ%gIÁO‡KKI,Ú|ÄwõÊÓ– EP”7TØ‹#ñ/CñÇX,Ê£H‘öôííÆ$Û£jFšù°S\H†DëhǾ«€( %H$‰UM貂¢¶LŸ¸@Du:c!ÕX;Ìå”ö;7Þ±Œ¦HRTiÙ8Li;ŒgíÏfîžÊßj¹$©õŒ(¦Lê{Î/! lruŸ˜`ÛP.˜’vû†Mîìî™,döwaجĘèN~p4Ö5%ádxN¬#"ÈH`{µ'¿'ržšN œ‹€x}¼o¤SÈýÁ¿‘;~bV iGß®GÒ¾¢ío]þ§”ŸjnWÁ{,³™jüšÆÅ nÛº`gênÇ«†Š–Ùhù¶ªË™<¼^Aãð¢=±9Én:8N)³GœÐWþÜ_ë-$Í@ P;XÉá¿ŠH(bÊßGRzLN7Š­æ\„‡ô‡•Hê'ÃÙŸL³Šö%pËm/*CC˜` Zmw%Ä­ `BÄÀZÞ5õ܉3摦P¼”v^Axdƒ·fÙ™?ÞÇúŸ*»8´­†´Gö$mQ—Th¿Œ-­Ö›ØyK NÓ§ºqy¼ëNÊÚÂÌıùÈvøbúü>M\{ %ì’¦|îœVdi ²:Ãö˜rGg\Vq"¥gþ®ƒ<~À°W}(,f€¦ÄüV? ÷¯îÃÊG×Ì_ËVPMˆ;_¹ ëœ¤¶ü›Ö–Pd™Å·jÈM¨`:O|@Ê@w * U!zW_6'>’K ¬iòwïQû±]. údÌÌ4íÇVmÕcÛ›Ç^ iœbz™é©4ÐëƒïgvxuÀ«ÛÛØ1šÝ®IÐke”ØvVB°1 2àÇ:ÙaÀ(Í©Ä {7±3‘]uÖ?º€‘ñÂM­ʧhû³sK:™$á)dDëÙž`@=Ðz_v:}µñ~£zÕÊ™ÄÃåŸ~ê«fnvìUÛ߉ÈåË^𠇫*ܱ÷ úzÐf–› ž !ÿT{ò»)(¼%¬æ6ª®ïߟW4£ê/¥à‡ÔÛ÷eö²æÖ¼V?n}qx¾C²P»Äåè@<ÏPúÊß>ØO³8iÃ*] Šÿo~nrê¿nvùIüpij$è?Ã`¬ „tÛ`e•aª°$Gny,ý¬zœaHûñŒƒ$ŽÏnXדé0U`âA'Xîï¿P¥¬¬.Ð J³AXÔ€{<0BÐ9 ½)ŠFÕŸ2€-äm>jäQÙc|£P`bÕ`PÄ Â꯴Ïh ®?+•sÙeD RÞbW@6û¸ •R7À€ê¹ÈålHhã) Â#¿.}ºÑUU¡Žë ÷LA"ë›D<{° ÓîÈpÉÔ}2z“„è±Òpîyb0ÃIîÂ$÷g¨ÀOAÛ£Íßža¹›ï/ßšvu=øT{»ÁÂk¨YtûŽCJ°0AA>Ðöˆ°hhßs½ÊÈÇËþP~ @Ú ‘–pT®Ö.Á¼Ú‘ìÂÆÛ=9ŸH7—öOßœš¨vÿÝAo˜ÛÓ¿‰C3#1r[S$áÝœž`f{9Z8cåà õ»ÒÌe½2¾ðrž]lûè’¢gq"%¾9ê™®Ïç]{,f--ao9Ó¤Ä}ÙÅåÜì…•¨:N¿ðŒôïYî= ÷Œ;í²Á®Õb6¬÷ŸL;ž¤bÊX빌̈ïÄ7ÝmÔ¡•¥›Éð`U @ßn¸tÂÀFå#às¦5÷¶Ê«Äzœ›c¬­NF™k5ܦõ˜±E¤i»»s ´q…‚¢+Õ$²€{»ãÄ¥Þ åت–fhêÎÒÙã&}¸Ö0…ºÖ*{ö€Ÿ»é$ ¾õÐ;±ÉÓ,@"`Ïf¸x’zwŽ¥‚ÛQ*§ð°>lß°•#°Hû°Ûr”¥T¨ ÌÇn€ë¤ãåYf;DíÉWܬu‘¨8 [ùHìÇ[‚³´K C˜éÙ‹úC¾ €äï’OͨëÙ¦r¹|mÂ,jÙCTËY¿2´ô8xÕq@²û™Ø’Â5:ëÒtÆâ¬z¨KzÚ‚L?–}ø´Øª¼Û-­+ã.€/kÏM4Î8õ”ÑQÛ¼¦¤GFøg*×ràØÇy’NÐ~ãšAñÂL|3qÏL$@ N˜TIìœÖAøg„àƒO»!´Lë´ÜÚ c†§´‡4ëÞp;4÷ç䈞¹$Dõm0Õ¡'·¿0 ¯F ü§f Ä0læ¹=ÙÏ·‡È«ÆúyÛéØ‹‚Â\’ ƒ0#Ñ}tŠøTòl&°Û¬pÄŽ¢íÊëá]W /®EÅÐ9f¶tˆò¬js]×ù·;2À•¶À ´é®™_ÑÖÖÚõï6™ÚÍû°}6¡g?™Èsp¡#p«©A ã‰Âçñlú}ö¯Ô;‘‰è7^¾ÌOT5·Ûþ• ó7‰î•}Co »L-¤—ñ±OÂs…θ3×W¼©«6ï]i8œNgάvÔîdzLªÄ竪6%û·:Ÿ—nßÃüØ•røVñ8öKÜÏ^Ö]£Oa8/ä’ÅÌUZüÎGvåý2ê8Ìt·tûö”_Ûƒ‘ÇpôÚkdaÐù²ŽW)¡EhF¬í·åQßž­ŸK¹x§ÿt˜ïÚPóaú¨·ÿhs4íÛó¦Sé—7u¿v°:»cüÙËäWQTâ±Zwˆ,AúáW¢72”-¸ù|`g3†”zmÁ` î9$‰ˆÓ :á ¡”õR$‘µ@î Œ»—ÆæzfYZÔy¼‹¨øc’ÅÉbK ë–q˜³W}nƒ ¥TØ[à¸|I#Þs‹§À†3ŽãGy®½`îaÔ{ îÁ¬z$öÀéƒË&N°Nü ’t#YøàmY b1-mC°CàùÏb‘"I²NIêpÜó¬‘Ð`PX¥g©¯fz\ŽB¿œ·§º·"}þüâØü¡Z’e€†V@Å\«“X¼–³ô½‹aGd([ hYùYâܼ*¸ÌÇŠ°’%öv”$×û髼z™«äSå(clµoÓN±…ŸW±žðý[³¿Ã· XHèŒd ÍZ“µ´Ôd iÃp‚ö3KH b1@0{g;CI™"c@&=™µauÓ!†ïÐtÎÁíÂ+R ¥€é>93ür—eùÁ‚{‡nI ä¨ûò&0ÒAfQ«’z ùP~t3߃O³^Ü7ßHw:Þ~2%AC¢ÔòÓå_tåke ­*¢ÛìÅãqWRITã¸ýç*Ž¾‹Güœ“_5x<‹T î±AVXQ°Ð|¹Çã}Sëu=ìß‘^ÀHfíÝ\Døçï«0ô…AÆŠÀ“ýGÝ9Mœ»jVv‰ùµìo(0ì¾þjm·›aµëˆÚ§ ŽÌ¹¹ßNäñÝXí®¶mñmDIþSïÎoÔl£ôµr˜=·mjOg¾0áKÌalìþ¬Ü¤= ‚[꺦ä`¡ŒHìÁ¡’5DzòQ‹‘Lçt*½üþltÂdék²Ùq2¨7AØ¢©¥T˜ L“âp3I$êz’N üFÖfn€ÞÌŽÌÞk»ã a‘3„ÐÌ“Ø5Ýž­À€£H ùzxgË÷gË÷`0Oº3EΘ|²N³ìà Ô`ÒG»4:Àû1Jˆ $ÿˆãŠêh2{u9:Áê à*»@êB{ð\õú¬ ‚ ÀêÝ î9`KG¬ž6»öXÖ éÖ2°è=Tk˜ŸÛš¤‚½`ŽÌÑvƒ¡N-,¤ª°ÛÞ bŽÖêcXÐöà‘c¦©Š“Ú ´A:€u'd['F“§v;ÕJ³¼Ü1Š^ò  ¹¥˜ö™':@Â@× ©Î˜¨°BôÜ$û1—™åJºƒÖz†º‰«ŽŠ ¼XàÐë‚Wû.KrY“ô–×Cˆ³Ú«bìÓkO¸å¼`¶]}n• ê–º—ôÓÌ5UÓwâ]èÞm{Ïôª€Þ·ª—(WttAFrxö—ÚÏM\n.ÁêVÞ˜¶÷³lÀ_QC`vbok¹oλ8uWR†ÛÇoM“FÔ˜ûã)¶šo¶îCXµñWÖü–)aip€+i;£>”±iá]aϤJ´/µsPr¯Êã~­CG’¨Ýù„‰ø·Æõ*áŽBñZµšë t;>ýÀ¿(ì3×LáñÚ›·7ËïáÖˆÖ3ïTY%ˆU\üã³·ê’8öWê‚ÂØFQM¢þ2Þ0æŸJ•BirÅI]ûRš·Þr«)ªþO©Bò™j@ZªH{72Û ’cA•c3òsm}¡UjµœÖ¾Xµ{º Î?Šn±ù×È$*~UWF³sƒíÚ g3™ÌãÛWŽIãÒUC5že¦!\’ÁæcHé'9v_UÜcÁD²úîUnØ+4–ÛÓU,÷‚ºŸH{HD¯ó6±Œ¯ÇäXô ·–µ¢·éѤî·Ï0¤˜ÆæÛ`ePþ ’ ž‘ftȽmàp¸¼WärVôPϽÑ)#nóüг¡8¶S}›«£eª †¹ÚÉÚÍ‚ñŒ•×mö ªÒ¥ÚÕ ´¤6¤ÁctÊy*í_Óò¬VE63[jÕJ wH`6õ9É»•MüVáúfÚmUõ ÜÛ+eÌ'ÇÛ—qÖ‹ø÷Pš»Ô#²v:ÆíÓãÞ2ðj¾ôâyVR¡’’Â@b̺ŸîÌvÆr*ô9¿ ÞH­ô‘×Ô–feÉžéÎOéê·üj·Úõ d§rîOP³/¶59W/êvéMgû`µŒaPuf0ÉnW‘Æž©m–ÒÜèªR²ê]u:íì•wÄknj¸µ¢†{üÌ`Þue¦Ãm”ò+ÛÈ3[V ž³.ýQš`w{§,f¦úî®áÆV@n{YEŠª˜j¦zûc9¶òÔ¥-§‹Åá_\ß°Ùj¤ƒóŶÎ=¯G!]9 Ãôv)´ÞË¿b…r äÙGn¢’ÖŠWk&êÒ㼉’$.èíÁôë+¶ÞW+^g#j-kkV,ó Á†ïŽÏ¶ŸÒ²(¨ š î Šb'+ý+"‘b}@LÕ>p»tÅ6­,Þ» ²ìŸ<#XéŸPåYdþ¯Ži¥ í®Ö¯Ò6žóá9À·‡j?7„öYkß»mïÈXµØ® “¨øg™}Ëe‰g#“|_ÈU¬l¢.Ñ:ã}N‹_}—žZÅlªÆÝJø5zkíÎ5bÙú^é×Cþ«¿©mŸÔ@Ê—Ïãÿý 8Ƕ›5®ö¿®Š†®ÌäéœN-ÃóR¡ë¯æ?žÉþ¦9Äã¿ ›*´žU€¶‚†¯@w.À«ñÎ{Sejü»8¦´`B ø…[ÓmºêwtÎ-¬Eås8ÉǤ€vÔQ^|HÞóôž;„oÓ~™,3ÉéîÓ\ú¢ÕGæqëâñ‰ò’ºb©‰Î]?NäSMÎ=43:±±= ÍP›tó†s(árj§ÌãÓÇÜÊÆÄZ«Ø°bw_ûó‡rµ5q¸Z Þ¯Og¢ÿ‡nívpøœ‹jjø|ÃÊÜ·Z7Y`Ý»£op}ÙeàŸÒpk¥9 ømä¡{k>˜³qñŒª¾3 ²›ê¿m³±ÅM¿km“©Î^=õ%U 9LÊÆÚÈAKú]†Ti=1x¡É¨ŠÀoA)á%—…?‰¥úŸ»9<îu‹g3•±XW>u×;+MÚþ"IíÎ_¾EKÀæò¿Ut«YX¡z¦`/_v}Jƒj‹>¥x±Þ”M=?ý4#ßœþ%\š“ƒÏäE¤«¶ŠõuÚ¯»ºRênªúý@J3Rá¼k0~¢Úoæ}W—ÆU@¬*J¸Šü‚„L•Üºöž¹Cò,ªÏ¨ýG“MkX è'ˆ“³_1–Xøãr¹—Vy]ÇkQzkÇã?ª)BÚÍ©'9ßXž)½Ç òú›žEÿq¯jžéïϧó8í\pÚÍédê-P›”¯â ?»Õ^=•X÷²ò6±äycw•HÝÔu>É·úzÖšUÑ_{ÕS¤ïÜ`EŽÜæYêª/&ŠxÕˆ'mii²éÿ03”þ¨¨[ÅN7þ™K=bÇÀ¢;†]w:ê–ûk¯Ž©PoMh[VëumKY¶<3™ÂÖ¿MçÞy˜o\nÚl© 6ß›³¸å?Làó(æpïçþ¶õ¨´S¿×aÈ3µaÄk©1Ò3êXàÖo È5}6¢ ¬rS%¶þ³¯vîñ—q•Âò-¥«AÚ”®èð'8·#/§Âáž-ÇGb’ÿ8ŒŸ¦äúžnäRé”ÙUT­´ØÕúBÖ-ÚdÏwg\ú_–ªÇúpÚévõ®ÝÕšÜÍ~`dÈÊ9?‘_鸯MTÒ…+K-pÌê5 Ç>Äõ‚§ ›ÒÆPe®¾¿Lؾ÷sïËø¼Z¬¶”ãþ¢¥Q‘JîÞÏÒT|£IÎU•Zµ x- Aò$³åéÝœ>37‘ÇôÛÖAa²—©ºÒtê€ c·®R8Ήúùú€ìcYù[n¹mÜÞEvÛÉåñùRÑã Z”üYÉåÕjCò8·Ð® Hâ È×Vf:g7›Íµ-äs½+Rª‰RíT‰é'ê.õT•%µ)¤?©j?ȶîòù›NÞìúX©øÓô½è³¼ÖébzeCºuŽ™Å·•zÞôò9»ÈR¾¥·.Ä vmS•óx×TyiËärJÚÓ+È_H.»‘”rëäSo>¾O#‘cX¬+Ô'§ÑL‚ª|3w+·½\«ùœ† ·Ô¶Ôô« vmSœ®"òjN/–9vyXÜÊÌŒõ`.‡öaúíMjµ½Q@`×#05úÛ´”³îòWÿÙhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/0000755006511100651110000000000010504340457022555 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/0000755006511100651110000000000010504340457024203 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P28/0000755006511100651110000000000010504340457024554 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P28/out/0000755006511100651110000000000010504340457025363 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P28/out/ibm28i01.xml0000644006511100651110000000002110504340457027331 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P28/ibm28i01.xml0000644006511100651110000000034710504340457026535 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P29/0000755006511100651110000000000010504340457024555 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P29/out/0000755006511100651110000000000010504340457025364 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/0000755006511100651110000000000010504340457024547 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/out/0000755006511100651110000000000010504340457025356 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/out/ibm32i01.xml0000644006511100651110000000004010504340457027320 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/out/ibm32i03.xml0000644006511100651110000000010110504340457027320 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/out/ibm32i04.xml0000644006511100651110000000015310504340457027330 0ustar rossrossThis is a yellow tiger hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/ibm32i01.dtd0000644006511100651110000000005510504340457026472 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/ibm32i01.xml0000644006511100651110000000066210504340457026523 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/ibm32i03.dtd0000644006511100651110000000005010504340457026467 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/ibm32i03.xml0000644006511100651110000000064010504340457026521 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/ibm32i04.dtd0000644006511100651110000000012310504340457026471 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P32/ibm32i04.xml0000644006511100651110000000075510504340457026531 0ustar rossross ]> This is a yellow tiger hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/0000755006511100651110000000000010504340457024556 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/out/0000755006511100651110000000000010504340457025365 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/out/ibm39i01.xml0000644006511100651110000000015010504340457027340 0ustar rossrossshould not have content here content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/out/ibm39i02.xml0000644006511100651110000000016310504340457027345 0ustar rossross root can't have text content content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/out/ibm39i03.xml0000644006511100651110000000020510504340457027343 0ustar rossross content of b element could not have 'a' as 'b's content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/out/ibm39i04.xml0000644006511100651110000000021710504340457027347 0ustar rossross content of b element not declared in dtd hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/ibm39i01.xml0000644006511100651110000000043310504340457026535 0ustar rossross ]> should not have content here content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/ibm39i02.xml0000644006511100651110000000044310504340457026537 0ustar rossross ]> root can't have text content content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/ibm39i03.xml0000644006511100651110000000046210504340457026541 0ustar rossross ]> content of b element could not have 'a' as 'b's content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P39/ibm39i04.xml0000644006511100651110000000053710504340457026545 0ustar rossross ]> content of b element not declared in dtd hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P41/0000755006511100651110000000000010504340457024547 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P41/out/0000755006511100651110000000000010504340457025356 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P41/out/ibm41i01.xml0000644006511100651110000000013310504340457027323 0ustar rossross attr1 not declared hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P41/out/ibm41i02.xml0000644006511100651110000000014510504340457027327 0ustar rossross attr3 value not fixed hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P41/ibm41i01.xml0000644006511100651110000000047610504340457026526 0ustar rossross ]> attr1 not declared hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P41/ibm41i02.xml0000644006511100651110000000055510504340457026525 0ustar rossross ]> attr3 value not fixed hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P45/0000755006511100651110000000000010504340457024553 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P45/out/0000755006511100651110000000000010504340457025362 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P45/out/ibm45i01.xml0000644006511100651110000000025410504340457027337 0ustar rossross without white space with a white space hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P45/ibm45i01.xml0000644006511100651110000000104510504340457026527 0ustar rossross ]> without white space with a white space hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P49/0000755006511100651110000000000010504340457024557 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P49/out/0000755006511100651110000000000010504340457025366 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P49/out/ibm49i01.xml0000644006511100651110000000011310504340457027341 0ustar rossross content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P49/out/ibm49i02.xml0000644006511100651110000000000010504340457027335 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P49/ibm49i01.dtd0000644006511100651110000000036110504340457026512 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P49/ibm49i01.xml0000644006511100651110000000034210504340457026536 0ustar rossross ]> content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P49/ibm49i02.xml0000644006511100651110000000034210504340457026537 0ustar rossross ]> content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P50/0000755006511100651110000000000010504340457024547 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P50/out/0000755006511100651110000000000010504340457025356 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P50/out/ibm50i01.xml0000644006511100651110000000011310504340457027321 0ustar rossross content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P50/ibm50i01.dtd0000644006511100651110000000030210504340457026465 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P50/ibm50i01.xml0000644006511100651110000000034210504340457026516 0ustar rossross ]> content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P51/0000755006511100651110000000000010504340457024550 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P51/out/0000755006511100651110000000000010504340457025357 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P51/out/ibm51i01.xml0000644006511100651110000000011610504340457027326 0ustar rossross Element type a Element type b hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P51/out/ibm51i02.xml0000644006511100651110000000011610504340457027327 0ustar rossross Element type a Element type b hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P51/out/ibm51i03.xml0000644006511100651110000000011610504340457027330 0ustar rossross Element type a Element type b hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P51/ibm51i01.dtd0000644006511100651110000000056710504340457026504 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P51/ibm51i01.xml0000644006511100651110000000034110504340457026517 0ustar rossross ]> Element type a Element type b hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P51/ibm51i03.dtd0000644006511100651110000000003710504340457026476 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P51/ibm51i03.xml0000644006511100651110000000063110504340457026523 0ustar rossross ]> Element type a Element type b hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/0000755006511100651110000000000010504340457024555 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/0000755006511100651110000000000010504340457025364 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i01.xml0000644006511100651110000000026510504340457027345 0ustar rossross This is a negative test for validity constraints the value of the attribute with a type ID does not match the Name production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i02.xml0000644006511100651110000000032610504340457027344 0ustar rossross This is a negative test for validity constraints the value of the attribute with a type ID appears more than once in the XML document hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i03.xml0000644006511100651110000000023210504340457027341 0ustar rossross This is a Negative validity test for ID Attribute Default. Giving the attribute default as #FIXED hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i05.xml0000644006511100651110000000024110504340457027343 0ustar rossross This is a Negative validity test for ID Attribute Default. Giving the attibute default as a const string hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i06.xml0000644006511100651110000000026710504340457027354 0ustar rossross This is a Negative validity test for ID. There is more than attribute of type ID for the element a hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i07.xml0000644006511100651110000000033610504340457027352 0ustar rossross Negative test for validity constraint of IDREF. In an attribute decl, values of type IDREF does not match the name production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i08.xml0000644006511100651110000000050310504340457027347 0ustar rossross Negative test for validity constraint of IDREF. In an attribute decl, values of type IDREF match the name production and IDREF value does not match the value assigned to any ID attribute somewhere in the XML document. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i09.xml0000644006511100651110000000041010504340457027345 0ustar rossross Negative test for validity constraint of IDREFS. In an attribute decl, values of type IDREFS does not match the name production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i10.xml0000644006511100651110000000056510504340457027350 0ustar rossross Negative test for validity constraint of IDREFS. In an attribute decl, values of type IDREFS match the name production but IDREFS value do not match the values assigned to one or more ID attributes somewhere in the XML document hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i11.xml0000644006511100651110000000021510504340457027341 0ustar rossross In the attribute decl, values of type ENTITY do not match the Name production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i12.xml0000644006511100651110000000031210504340457027340 0ustar rossross In the attribute decl, values of type ENTITY match the Name production but does not match the name of any entity declared in the DTD hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i13.xml0000644006511100651110000000034510504340457027347 0ustar rossross In an attribute declaration, values of type ENTITY match the Name production and the ENTITY value matches the name of a parsed entity declared in the DTD. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i14.xml0000644006511100651110000000023610504340457027347 0ustar rossross In an attribute declaration, values of type ENTITIES do not match the Name production. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i15.xml0000644006511100651110000000036310504340457027351 0ustar rossross In an attribute declaration, values of type ENTITIES match the Name production and the ENTITIES value does not match one or more names of entities declared in the DTD. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i16.xml0000644006511100651110000000040210504340457027344 0ustar rossross In an attribute declaration, values of type ENTITIES match the Name production and the ENTITIES value matches one or more names of parsed entities declared in the DTD. . hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i17.xml0000644006511100651110000000024210504340457027347 0ustar rossross In an attribute declaration, values of type NMTOKEN does not match the Nmtoken production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/out/ibm56i18.xml0000644006511100651110000000025610504340457027355 0ustar rossross In an attribute declaration, values of type NMTOKENS does not match the Nmtokens production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i01.xml0000644006511100651110000000056210504340457026536 0ustar rossross ]> This is a negative test for validity constraints the value of the attribute with a type ID does not match the Name production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i02.xml0000644006511100651110000000071310504340457026535 0ustar rossross ]> This is a negative test for validity constraints the value of the attribute with a type ID appears more than once in the XML document hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i03.xml0000644006511100651110000000051110504340457026532 0ustar rossross ]> This is a Negative validity test for ID Attribute Default. Giving the attribute default as #FIXED hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i05.xml0000644006511100651110000000053610504340457026543 0ustar rossross ]> This is a Negative validity test for ID Attribute Default. Giving the attibute default as a const string hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i06.xml0000644006511100651110000000063310504340457026542 0ustar rossross ]> This is a Negative validity test for ID. There is more than attribute of type ID for the element a hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i07.xml0000644006511100651110000000074110504340457026543 0ustar rossross ]> Negative test for validity constraint of IDREF. In an attribute decl, values of type IDREF does not match the name production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i08.xml0000644006511100651110000000110010504340457026532 0ustar rossross ]> Negative test for validity constraint of IDREF. In an attribute decl, values of type IDREF match the name production and IDREF value does not match the value assigned to any ID attribute somewhere in the XML document. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i09.xml0000644006511100651110000000111110504340457026535 0ustar rossross ]> Negative test for validity constraint of IDREFS. In an attribute decl, values of type IDREFS does not match the name production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i10.xml0000644006511100651110000000126010504340457026532 0ustar rossross ]> Negative test for validity constraint of IDREFS. In an attribute decl, values of type IDREFS match the name production but IDREFS value do not match the values assigned to one or more ID attributes somewhere in the XML document hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i11.xml0000644006511100651110000000063310504340457026536 0ustar rossross ]> In the attribute decl, values of type ENTITY do not match the Name production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i12.xml0000644006511100651110000000072510504340457026541 0ustar rossross ]> In the attribute decl, values of type ENTITY match the Name production but does not match the name of any entity declared in the DTD hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i13.xml0000644006511100651110000000073610504340457026544 0ustar rossross ]> In an attribute declaration, values of type ENTITY match the Name production and the ENTITY value matches the name of a parsed entity declared in the DTD. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i14.xml0000644006511100651110000000076610504340457026550 0ustar rossross ]> In an attribute declaration, values of type ENTITIES do not match the Name production. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i15.xml0000644006511100651110000000110710504340457026537 0ustar rossross ]> In an attribute declaration, values of type ENTITIES match the Name production and the ENTITIES value does not match one or more names of entities declared in the DTD. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i16.xml0000644006511100651110000000105610504340457026543 0ustar rossross ]> In an attribute declaration, values of type ENTITIES match the Name production and the ENTITIES value matches one or more names of parsed entities declared in the DTD. . hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i17.xml0000644006511100651110000000056410504340457026547 0ustar rossross ]> In an attribute declaration, values of type NMTOKEN does not match the Nmtoken production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P56/ibm56i18.xml0000644006511100651110000000060310504340457026542 0ustar rossross ]> In an attribute declaration, values of type NMTOKENS does not match the Nmtokens production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P58/0000755006511100651110000000000010504340457024557 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P58/out/0000755006511100651110000000000010504340457025366 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P58/out/ibm58i01.xml0000644006511100651110000000054510504340457027352 0ustar rossross ]> The attribute values of type NOTATION does not match any of the notation names included in the declaration.All notation names in the declaration have been declared. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P58/out/ibm58i02.xml0000644006511100651110000000052010504340457027344 0ustar rossross ]> The attribute values of type NOTATION does match any of the notation names included in the declaration, but some of notation names in the declaration have not been declared hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P58/ibm58i01.xml0000644006511100651110000000106010504340457026534 0ustar rossross ]> The attribute values of type NOTATION does not match any of the notation names included in the declaration.All notation names in the declaration have been declared. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P58/ibm58i02.xml0000644006511100651110000000104310504340457026536 0ustar rossross ]> The attribute values of type NOTATION does match any of the notation names included in the declaration, but some of notation names in the declaration have not been declared hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P59/0000755006511100651110000000000010504340457024560 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P59/out/0000755006511100651110000000000010504340457025367 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P59/out/ibm59i01.xml0000644006511100651110000000026410504340457027352 0ustar rossross This is a Negative test The attribute values of type Enumeration does not match any of the Nmtoken tokens in the declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P59/ibm59i01.xml0000644006511100651110000000061210504340457026540 0ustar rossross ]> This is a Negative test The attribute values of type Enumeration does not match any of the Nmtoken tokens in the declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/0000755006511100651110000000000010504340457024550 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/out/0000755006511100651110000000000010504340457025357 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/out/ibm60i01.xml0000644006511100651110000000037110504340457027331 0ustar rossross Negative test for Required Attribute. Some occurrence of an element with an attribute of #REQUIRED default declaration does not give the value of those attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/out/ibm60i02.xml0000644006511100651110000000041510504340457027331 0ustar rossross Negative Test An attribute has a default value declared with the #FIXED keyword, and an instances of that attribute is given a value which is not the same as the default value in the declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/out/ibm60i03.xml0000644006511100651110000000021610504340457027331 0ustar rossross The default value specified for an attribute does not meet the lexical constraints of the declared attribute type. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/out/ibm60i04.xml0000644006511100651110000000021610504340457027332 0ustar rossross The default value specified for an attribute does not meet the lexical constraints of the declared attribute type. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/ibm60i01.xml0000644006511100651110000000073010504340457026521 0ustar rossross ]> Negative test for Required Attribute. Some occurrence of an element with an attribute of #REQUIRED default declaration does not give the value of those attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/ibm60i02.xml0000644006511100651110000000067310504340457026530 0ustar rossross ]> Negative Test An attribute has a default value declared with the #FIXED keyword, and an instances of that attribute is given a value which is not the same as the default value in the declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/ibm60i03.xml0000644006511100651110000000055310504340457026526 0ustar rossross ]> The default value specified for an attribute does not meet the lexical constraints of the declared attribute type. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P60/ibm60i04.xml0000644006511100651110000000053210504340457026524 0ustar rossross ]> The default value specified for an attribute does not meet the lexical constraints of the declared attribute type. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/0000755006511100651110000000000010504340457024560 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/out/0000755006511100651110000000000010504340457025367 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/out/ibm68i01.xml0000644006511100651110000000010110504340457027340 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/out/ibm68i02.xml0000644006511100651110000000010110504340457027341 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/out/ibm68i03.xml0000644006511100651110000000004710504340457027353 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/out/ibm68i04.xml0000644006511100651110000000004710504340457027354 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/ibm68i01.dtd0000644006511100651110000000021510504340457026512 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/ibm68i01.xml0000644006511100651110000000032310504340457026537 0ustar rossross ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/ibm68i02.dtd0000644006511100651110000000021010504340457026506 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/ibm68i02.xml0000644006511100651110000000032310504340457026540 0ustar rossross ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/ibm68i03.ent0000644006511100651110000000021210504340457026524 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/ibm68i03.xml0000644006511100651110000000034710504340457026547 0ustar rossross %pe1; ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/ibm68i04.ent0000644006511100651110000000021210504340457026525 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P68/ibm68i04.xml0000644006511100651110000000034710504340457026550 0ustar rossross %pe1; ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/0000755006511100651110000000000010504340460024553 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/out/0000755006511100651110000000000010504340460025362 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/out/ibm69i01.xml0000644006511100651110000000010110504340460027334 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/out/ibm69i02.xml0000644006511100651110000000010110504340460027335 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/out/ibm69i03.xml0000644006511100651110000000004710504340460027347 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/out/ibm69i04.xml0000644006511100651110000000004710504340460027350 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/ibm69i01.dtd0000644006511100651110000000031110504340457026511 0ustar rossross "> %pe2; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/ibm69i01.xml0000644006511100651110000000032310504340457026541 0ustar rossross ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/ibm69i02.dtd0000644006511100651110000000030610504340457026516 0ustar rossross %pe1; "> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/ibm69i02.xml0000644006511100651110000000032310504340457026542 0ustar rossross ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/ibm69i03.ent0000644006511100651110000000031110504340457026526 0ustar rossross "> %pe3; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/ibm69i03.xml0000644006511100651110000000034710504340457026551 0ustar rossross %pe1; ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/ibm69i04.ent0000644006511100651110000000031210504340460026522 0ustar rossross %pe2; "> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P69/ibm69i04.xml0000644006511100651110000000035010504340460026536 0ustar rossross %pe1; ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P76/0000755006511100651110000000000010504340460024551 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P76/out/0000755006511100651110000000000010504340460025360 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P76/out/ibm76i01.xml0000644006511100651110000000003010504340460027331 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/invalid/P76/ibm76i01.xml0000644006511100651110000000060310504340460026530 0ustar rossross '> %pe1; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/0000755006511100651110000000000010504340457023767 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P01/0000755006511100651110000000000010504340460024321 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P01/ibm01n01.xml0000644006511100651110000000014010504340460026265 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P01/ibm01n02.xml0000644006511100651110000000017010504340460026271 0ustar rossrossWrong ordering between prolog and element! ]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P01/ibm01n03.xml0000644006511100651110000000033110504340460026271 0ustar rossross ]> Wrong combination! Wrong combination! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/0000755006511100651110000000000010504340460024322 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n01.xml0000644006511100651110000000013310504340460026271 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n02.xml0000644006511100651110000000013310504340460026272 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n03.xml0000644006511100651110000000013310504340460026273 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n04.xml0000644006511100651110000000013310504340460026274 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n05.xml0000644006511100651110000000013310504340460026275 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n06.xml0000644006511100651110000000013310504340460026276 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n07.xml0000644006511100651110000000013310504340460026277 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n08.xml0000644006511100651110000000013310504340460026300 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n09.xml0000644006511100651110000000013310504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n10.xml0000644006511100651110000000013310504340460026271 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n11.xml0000644006511100651110000000013310504340460026272 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n12.xml0000644006511100651110000000013310504340460026273 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n13.xml0000644006511100651110000000013310504340460026274 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n14.xml0000644006511100651110000000013310504340460026275 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n15.xml0000644006511100651110000000013310504340460026276 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n16.xml0000644006511100651110000000013310504340460026277 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n17.xml0000644006511100651110000000013310504340460026300 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n18.xml0000644006511100651110000000013310504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n19.xml0000644006511100651110000000013310504340460026302 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n20.xml0000644006511100651110000000013310504340460026272 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n21.xml0000644006511100651110000000013310504340460026273 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n22.xml0000644006511100651110000000013310504340460026274 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n23.xml0000644006511100651110000000013310504340460026275 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n24.xml0000644006511100651110000000013310504340460026276 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n25.xml0000644006511100651110000000013310504340460026277 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n26.xml0000644006511100651110000000013310504340460026300 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n27.xml0000644006511100651110000000013310504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n28.xml0000644006511100651110000000013310504340460026302 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n29.xml0000644006511100651110000000013310504340460026303 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n30.xml0000644006511100651110000000013710504340460026277 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n31.xml0000644006511100651110000000013710504340460026300 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n32.xml0000644006511100651110000000013710504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P02/ibm02n33.xml0000644006511100651110000000013710504340460026302 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P03/0000755006511100651110000000000010504340460024323 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P03/ibm03n01.xml0000644006511100651110000000021210504340460026271 0ustar rossross ]> Illegal space 3000 in the end tag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/0000755006511100651110000000000010504340460024324 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n01.xml0000644006511100651110000000013710504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n02.xml0000644006511100651110000000013710504340460026302 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n03.xml0000644006511100651110000000013710504340460026303 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n04.xml0000644006511100651110000000013710504340460026304 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n05.xml0000644006511100651110000000013710504340460026305 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n06.xml0000644006511100651110000000013710504340460026306 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n07.xml0000644006511100651110000000013710504340460026307 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n08.xml0000644006511100651110000000013710504340460026310 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n09.xml0000644006511100651110000000013710504340460026311 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n10.xml0000644006511100651110000000013710504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n11.xml0000644006511100651110000000013710504340460026302 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n12.xml0000644006511100651110000000013710504340460026303 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n13.xml0000644006511100651110000000013710504340460026304 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n14.xml0000644006511100651110000000013710504340460026305 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n15.xml0000644006511100651110000000013710504340460026306 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n16.xml0000644006511100651110000000013710504340460026307 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n17.xml0000644006511100651110000000013710504340460026310 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P04/ibm04n18.xml0000644006511100651110000000013710504340460026311 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P05/0000755006511100651110000000000010504340460024325 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P05/ibm05n01.xml0000644006511100651110000000015310504340460026301 0ustar rossross ]> <.A_name_starts_with./> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P05/ibm05n02.xml0000644006511100651110000000015310504340460026302 0ustar rossross ]> <-A_name_starts_With-/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P05/ibm05n03.xml0000644006511100651110000000017210504340460026304 0ustar rossross ]> <5A_name_starts_with_digit/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P05/ibm05n04.xml0000644006511100651110000000020010504340460026275 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P05/ibm05n05.xml0000644006511100651110000000014210504340460026303 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P09/0000755006511100651110000000000010504340460024331 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P09/ibm09n01.xml0000644006511100651110000000033710504340460026315 0ustar rossross ]> My Name is &FullName;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P09/ibm09n02.xml0000644006511100651110000000030410504340460026310 0ustar rossross ]> My Name is &FullName;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P09/ibm09n03.xml0000644006511100651110000000030410504340460026311 0ustar rossross ]> My Name is &FullName;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P09/ibm09n04.xml0000644006511100651110000000030410504340460026312 0ustar rossross ]> My Name is &FullName;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P10/0000755006511100651110000000000010504340460024321 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P10/ibm10n01.xml0000644006511100651110000000054510504340460026276 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P10/ibm10n02.xml0000644006511100651110000000053310504340460026274 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P10/ibm10n03.xml0000644006511100651110000000053310504340460026275 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P10/ibm10n04.xml0000644006511100651110000000055710504340460026304 0ustar rossross ]> ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P10/ibm10n06.xml0000644006511100651110000000053310504340460026300 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P10/ibm10n07.xml0000644006511100651110000000053310504340460026301 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P10/ibm10n08.xml0000644006511100651110000000056410504340460026306 0ustar rossross ]> ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P11/ibm11n03.xml0000644006511100651110000000032110504340460026272 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P11/ibm11n04.xml0000644006511100651110000000032110504340460026273 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P12/0000755006511100651110000000000010504340460024323 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P12/ibm12n01.xml0000644006511100651110000000036310504340460026300 0ustar rossross ]> My Name is &info;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P12/ibm12n02.xml0000644006511100651110000000031110504340460026272 0ustar rossross ]> My Name is &info;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P12/ibm12n03.xml0000644006511100651110000000033610504340460026302 0ustar rossross ]> My Name is &info;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P13/0000755006511100651110000000000010504340460024324 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P13/ibm13n01.xml0000644006511100651110000000031210504340460026274 0ustar rossross ]> My Name is &info;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P13/ibm13n02.xml0000644006511100651110000000027710504340460026307 0ustar rossross ]> My Name is &info;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P13/ibm13n03.xml0000644006511100651110000000031610504340460026302 0ustar rossross ]> My Name is &info;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P13/student.dtd0000644006511100651110000000011710504340460026506 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P14/0000755006511100651110000000000010504340460024325 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P14/ibm14n01.xml0000644006511100651110000000037710504340460026311 0ustar rossross ]> My name is Snow ]]> Man hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P14/ibm14n02.xml0000644006511100651110000000036710504340460026311 0ustar rossross ]> My name is Snow hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P14/ibm14n03.xml0000644006511100651110000000037010504340460026304 0ustar rossross ]> My name is Snow&Man hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P15/0000755006511100651110000000000010504340460024326 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P15/ibm15n01.xml0000644006511100651110000000026610504340460026310 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P15/ibm15n02.xml0000644006511100651110000000026410504340460026307 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P15/ibm15n04.xml0000644006511100651110000000030410504340460026304 0ustar rossross ]> a test ?> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P16/ibm16n02.xml0000644006511100651110000000026510504340460026312 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P16/ibm16n03.xml0000644006511100651110000000030510504340460026306 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P16/ibm16n04.xml0000644006511100651110000000027610504340460026316 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P17/0000755006511100651110000000000010504340460024330 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P17/ibm17n01.xml0000644006511100651110000000027610504340460026315 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P17/ibm17n02.xml0000644006511100651110000000026610504340460026315 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P17/ibm17n03.xml0000644006511100651110000000026610504340460026316 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P17/ibm17n04.xml0000644006511100651110000000026610504340460026317 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P18/0000755006511100651110000000000010504340460024331 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P18/ibm18n01.xml0000644006511100651110000000031710504340460026313 0ustar rossross ]> My Name is SnowMan. This is text]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P18/ibm18n02.xml0000644006511100651110000000031510504340460026312 0ustar rossross ]> My Name is SnowMan. text hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P19/0000755006511100651110000000000010504340460024332 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P19/ibm19n01.xml0000644006511100651110000000026710504340460026321 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P19/ibm19n02.xml0000644006511100651110000000027610504340460026322 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P19/ibm19n03.xml0000644006511100651110000000026710504340460026323 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P20/0000755006511100651110000000000010504340460024322 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P20/ibm20n01.xml0000644006511100651110000000034210504340460026273 0ustar rossross ]> This is ]]> a test]]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P21/0000755006511100651110000000000010504340460024323 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P21/ibm21n01.xml0000644006511100651110000000027310504340460026300 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P21/ibm21n02.xml0000644006511100651110000000026610504340460026303 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P21/ibm21n03.xml0000644006511100651110000000026510504340460026303 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P22/0000755006511100651110000000000010504340460024324 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P22/ibm22n01.xml0000644006511100651110000000021310504340460026274 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P22/ibm22n02.xml0000644006511100651110000000021310504340460026275 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P22/ibm22n03.xml0000644006511100651110000000026410504340460026304 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P23/0000755006511100651110000000000010504340460024325 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P23/ibm23n01.xml0000644006511100651110000000020710504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P23/ibm23n02.xml0000644006511100651110000000024510504340460026304 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P23/ibm23n03.xml0000644006511100651110000000026710504340460026311 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P23/ibm23n04.xml0000644006511100651110000000015610504340460026307 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P23/ibm23n05.xml0000644006511100651110000000023110504340460026302 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P23/ibm23n06.xml0000644006511100651110000000023210504340460026304 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/0000755006511100651110000000000010504340460024326 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/ibm24n01.xml0000644006511100651110000000016510504340460026306 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/ibm24n02.xml0000644006511100651110000000016110504340460026303 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/ibm24n03.xml0000644006511100651110000000016310504340460026306 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/ibm24n04.xml0000644006511100651110000000017510504340460026312 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/ibm24n05.xml0000644006511100651110000000017310504340460026311 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/ibm24n06.xml0000644006511100651110000000015710504340460026314 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/ibm24n07.xml0000644006511100651110000000015710504340460026315 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/ibm24n08.xml0000644006511100651110000000016610504340460026316 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P24/ibm24n09.xml0000644006511100651110000000016510504340460026316 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P25/0000755006511100651110000000000010504340460024327 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P25/ibm25n01.xml0000644006511100651110000000016110504340460026304 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P25/ibm25n02.xml0000644006511100651110000000016310504340460026307 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P26/0000755006511100651110000000000010504340460024330 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P26/ibm26n01.xml0000644006511100651110000000017410504340460026312 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P27/0000755006511100651110000000000010504340460024331 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P27/ibm27n01.xml0000644006511100651110000000023310504340460026310 0ustar rossross ]> Wrong type of Misc following this element! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/0000755006511100651110000000000010504340460024332 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/ibm28n01.dtd0000644006511100651110000000002710504340460026266 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/ibm28n01.xml0000644006511100651110000000017710504340460026321 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/ibm28n02.xml0000644006511100651110000000022610504340460026315 0ustar rossross ] animal> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/ibm28n03.xml0000644006511100651110000000033110504340460026313 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/ibm28n04.xml0000644006511100651110000000057410504340460026325 0ustar rossross &generalE; "> %parameterE; ] animal> &generalE hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/ibm28n05.xml0000644006511100651110000000022710504340460026321 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/ibm28n06.xml0000644006511100651110000000023010504340460026314 0ustar rossross > hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/ibm28n07.xml0000644006511100651110000000022610504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P28/ibm28n08.xml0000644006511100651110000000023010504340460026316 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P29/0000755006511100651110000000000010504340460024333 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P29/ibm29n01.xml0000644006511100651110000000076210504340460026323 0ustar rossross ]> This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P29/cat.txt0000644006511100651110000000003610504340460025642 0ustar rossrossThis is a text book about cat.hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P29/ibm29n02.xml0000644006511100651110000000037710504340460026326 0ustar rossross "> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P29/ibm29n03.xml0000644006511100651110000000041510504340460026320 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P29/ibm29n04.xml0000644006511100651110000000041410504340460026320 0ustar rossross ]> &content; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P29/ibm29n05.xml0000644006511100651110000000036710504340460026330 0ustar rossross "> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P29/ibm29n06.xml0000644006511100651110000000040210504340460026317 0ustar rossross "> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P30/0000755006511100651110000000000010504340460024323 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P30/ibm30n01.dtd0000644006511100651110000000020110504340460026242 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P30/ibm30n01.xml0000644006511100651110000000016610504340460026301 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P31/0000755006511100651110000000000010504340460024324 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P31/ibm31n01.dtd0000644006511100651110000000024710504340460026256 0ustar rossross &generalE; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P31/ibm31n01.xml0000644006511100651110000000014610504340460026301 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/0000755006511100651110000000000010504340460024325 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n01.xml0000644006511100651110000000020710504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n02.xml0000644006511100651110000000020610504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n03.xml0000644006511100651110000000021210504340460026277 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n04.xml0000644006511100651110000000021210504340460026300 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n05.xml0000644006511100651110000000021210504340460026301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n06.dtd0000644006511100651110000000002710504340460026261 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n06.xml0000644006511100651110000000017610504340460026313 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n07.xml0000644006511100651110000000017610504340460026314 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n08.xml0000644006511100651110000000021310504340460026305 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n09.dtd0000644006511100651110000000006310504340460026264 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P32/ibm32n09.xml0000644006511100651110000000064710504340460026321 0ustar rossross ]> &animal_content; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P39/0000755006511100651110000000000010504340460024334 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P39/ibm39n01.xml0000644006511100651110000000014110504340460026314 0ustar rossross ]> missing end tag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P39/ibm39n02.xml0000644006511100651110000000014210504340460026316 0ustar rossross ]> missing start tag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P39/ibm39n03.xml0000644006511100651110000000017210504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P39/ibm39n04.xml0000644006511100651110000000020110504340460026314 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P39/ibm39n05.xml0000644006511100651110000000016210504340460026323 0ustar rossross ]> switched start and end tags hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P39/ibm39n06.xml0000644006511100651110000000015410504340460026325 0ustar rossross ]> content after end tag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P40/0000755006511100651110000000000010504340460024324 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P40/ibm40n01.xml0000644006511100651110000000030310504340460026274 0ustar rossross ]> missing name in start tag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P40/ibm40n02.xml0000644006511100651110000000031010504340460026273 0ustar rossross ]> missing white space in start tag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P40/ibm40n03.xml0000644006511100651110000000030410504340460026277 0ustar rossross ]> Wrong ordering in start tag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P40/ibm40n04.xml0000644006511100651110000000031610504340460026303 0ustar rossross ]> wrong begining sequence in start tag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P40/ibm40n05.xml0000644006511100651110000000033410504340460026304 0ustar rossross ]> duplicate attr names in start tag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/0000755006511100651110000000000010504340460024325 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n01.xml0000644006511100651110000000027510504340460026306 0ustar rossross ]> missing name in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n.ent0000644006511100651110000000003210504340460026122 0ustar rossross anyhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n02.xml0000644006511100651110000000027710504340460026311 0ustar rossross ]> missing Eq in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n03.xml0000644006511100651110000000030210504340460026277 0ustar rossross ]> missing AttValue in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n04.xml0000644006511100651110000000030310504340460026301 0ustar rossross ]> missing name and Eq in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n05.xml0000644006511100651110000000030710504340460026306 0ustar rossross ]> missing Eq and AttValue in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n06.xml0000644006511100651110000000030610504340460026306 0ustar rossross ]> missing Name and AttValue in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n07.xml0000644006511100651110000000030410504340460026305 0ustar rossross ]> wrong ordering in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n08.xml0000644006511100651110000000030410504340460026306 0ustar rossross ]> wrong ordering in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n09.xml0000644006511100651110000000030410504340460026307 0ustar rossross ]> wrong ordering in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n10.ent0000644006511100651110000000003210504340460026263 0ustar rossross anyhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n10.xml0000644006511100651110000000041610504340460026303 0ustar rossross ]> direct reference to external entinity in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n11.ent0000644006511100651110000000003210504340460026264 0ustar rossross anyhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n11.xml0000644006511100651110000000046310504340460026306 0ustar rossross ]> indirect reference to external entinity in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n12.xml0000644006511100651110000000051210504340460026302 0ustar rossross ]> direct reference to external unparsed entinity in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n13.xml0000644006511100651110000000045510504340460026311 0ustar rossross inside"> ]> Direct reference to an entity with < as part of its replacement text in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P41/ibm41n14.xml0000644006511100651110000000052210504340460026305 0ustar rossross inside"> ]> indirect reference to an entity with < as part of its replacement text in Attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P42/0000755006511100651110000000000010504340460024326 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P42/ibm42n01.xml0000644006511100651110000000022310504340460026301 0ustar rossross ]> missing Name in ETag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P42/ibm42n02.xml0000644006511100651110000000024310504340460026304 0ustar rossross ]> Wrong begining sequence in ETag <\root> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P42/ibm42n03.xml0000644006511100651110000000024210504340460026304 0ustar rossross ]> Wrong begining sequence in ETag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P42/ibm42n04.xml0000644006511100651110000000025210504340460026306 0ustar rossross ]> Extra white space before Name in ETag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P42/ibm42n05.xml0000644006511100651110000000022610504340460026310 0ustar rossross ]> Attribute in ETag hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P43/0000755006511100651110000000000010504340460024327 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P43/ibm43n01.xml0000644006511100651110000000031410504340460026304 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P43/ibm43n02.xml0000644006511100651110000000027410504340460026312 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P43/ibm43n04.xml0000644006511100651110000000032510504340460026311 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P43/ibm43n05.xml0000644006511100651110000000031210504340460026306 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P44/0000755006511100651110000000000010504340460024330 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P44/ibm44n01.xml0000644006511100651110000000031210504340460026304 0ustar rossross ]> < /> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P44/ibm44n02.xml0000644006511100651110000000034710504340460026315 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P44/ibm44n03.xml0000644006511100651110000000034010504340460026307 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P44/ibm44n04.xml0000644006511100651110000000035010504340460026311 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/0000755006511100651110000000000010504340460024331 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/ibm45n01.xml0000644006511100651110000000024310504340460026311 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/ibm45n02.xml0000644006511100651110000000025210504340460026312 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/ibm45n03.xml0000644006511100651110000000024210504340460026312 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/ibm45n04.xml0000644006511100651110000000026110504340460026314 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/ibm45n05.xml0000644006511100651110000000024410504340460026316 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/ibm45n06.xml0000644006511100651110000000025410504340460026320 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/ibm45n07.xml0000644006511100651110000000026310504340460026321 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/ibm45n08.xml0000644006511100651110000000026310504340460026322 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P45/ibm45n09.xml0000644006511100651110000000026310504340460026323 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P46/0000755006511100651110000000000010504340460024332 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P46/ibm46n01.xml0000644006511100651110000000025710504340460026320 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P46/ibm46n02.xml0000644006511100651110000000025610504340460026320 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P46/ibm46n03.xml0000644006511100651110000000025110504340460026314 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P46/ibm46n04.xml0000644006511100651110000000025210504340460026316 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P46/ibm46n05.xml0000644006511100651110000000026410504340460026322 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P47/0000755006511100651110000000000010504340460024333 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P47/ibm47n01.xml0000644006511100651110000000024510504340460026317 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P47/ibm47n02.xml0000644006511100651110000000024510504340460026320 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P47/ibm47n03.xml0000644006511100651110000000024510504340460026321 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P47/ibm47n04.xml0000644006511100651110000000027410504340460026324 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P47/ibm47n05.xml0000644006511100651110000000031210504340460026316 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P47/ibm47n06.xml0000644006511100651110000000027310504340460026325 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P48/0000755006511100651110000000000010504340460024334 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P48/ibm48n01.xml0000644006511100651110000000030210504340460026313 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P48/ibm48n02.xml0000644006511100651110000000027010504340460026320 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P48/ibm48n03.xml0000644006511100651110000000030010504340460026313 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P48/ibm48n04.xml0000644006511100651110000000026610504340460026327 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P48/ibm48n05.xml0000644006511100651110000000031010504340460026316 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P48/ibm48n06.xml0000644006511100651110000000026510504340460026330 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P48/ibm48n07.xml0000644006511100651110000000027010504340460026325 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P49/0000755006511100651110000000000010504340460024335 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P49/ibm49n01.xml0000644006511100651110000000026010504340460026320 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P49/ibm49n02.xml0000644006511100651110000000030610504340460026322 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P49/ibm49n03.xml0000644006511100651110000000031510504340460026323 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P49/ibm49n04.xml0000644006511100651110000000031210504340460026321 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P49/ibm49n05.xml0000644006511100651110000000031310504340460026323 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P49/ibm49n06.xml0000644006511100651110000000032410504340460026326 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P50/0000755006511100651110000000000010504340460024325 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P50/ibm50n01.xml0000644006511100651110000000027610504340460026307 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P50/ibm50n02.xml0000644006511100651110000000030210504340460026276 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P50/ibm50n03.xml0000644006511100651110000000031010504340460026276 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P50/ibm50n04.xml0000644006511100651110000000031010504340460026277 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P50/ibm50n05.xml0000644006511100651110000000031310504340460026303 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P50/ibm50n06.xml0000644006511100651110000000031710504340460026310 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P50/ibm50n07.xml0000644006511100651110000000031510504340460026307 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P51/0000755006511100651110000000000010504340460024326 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P51/ibm51n01.xml0000644006511100651110000000032510504340460026304 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P51/ibm51n02.xml0000644006511100651110000000033610504340460026307 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P51/ibm51n03.xml0000644006511100651110000000031510504340460026305 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P51/ibm51n04.xml0000644006511100651110000000032110504340460026303 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P51/ibm51n05.xml0000644006511100651110000000032510504340460026310 0ustar rossross ]> Any contenthugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P51/ibm51n06.xml0000644006511100651110000000033110504340460026306 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P51/ibm51n07.xml0000644006511100651110000000032510504340460026312 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P52/0000755006511100651110000000000010504340460024327 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P52/ibm52n01.xml0000644006511100651110000000027510504340460026312 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P52/ibm52n02.xml0000644006511100651110000000030510504340460026305 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P52/ibm52n03.xml0000644006511100651110000000033710504340460026313 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P52/ibm52n04.xml0000644006511100651110000000031310504340460026306 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P52/ibm52n05.xml0000644006511100651110000000031010504340460026304 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P52/ibm52n06.xml0000644006511100651110000000031210504340460026307 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P53/0000755006511100651110000000000010504340460024330 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P53/ibm53n01.xml0000644006511100651110000000027510504340460026314 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P53/ibm53n02.xml0000644006511100651110000000034110504340460026307 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P53/ibm53n03.xml0000644006511100651110000000026710504340460026317 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P53/ibm53n04.xml0000644006511100651110000000033310504340460026312 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P53/ibm53n05.xml0000644006511100651110000000026610504340460026320 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P53/ibm53n06.xml0000644006511100651110000000034010504340460026312 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P53/ibm53n07.xml0000644006511100651110000000027510504340460026322 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P53/ibm53n08.xml0000644006511100651110000000027610504340460026324 0ustar rossross ]> Any content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P54/0000755006511100651110000000000010504340460024331 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P54/ibm54n01.xml0000644006511100651110000000033110504340460026307 0ustar rossross ]> Giving a Bogus attribute. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P54/ibm54n02.xml0000644006511100651110000000037110504340460026314 0ustar rossross ]> Giving a wrong AttType for the attribute. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P55/0000755006511100651110000000000010504340460024332 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P55/ibm55n01.xml0000644006511100651110000000037010504340460026314 0ustar rossross ]> Giving a lowercase for CDATA attribute. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P55/ibm55n02.xml0000644006511100651110000000035310504340460026316 0ustar rossross ]> Giving a wrong character. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P55/ibm55n03.xml0000644006511100651110000000037310504340460026321 0ustar rossross ]> Giving a wrong key word of the StringType. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P56/0000755006511100651110000000000010504340460024333 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P56/ibm56n01.xml0000644006511100651110000000031410504340460026314 0ustar rossross ]> Invalid TokenizedType id(lowercase) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P56/ibm56n02.xml0000644006511100651110000000032710504340460026321 0ustar rossross ]> Invalid TokenizedType Idref(case sensitive) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P56/ibm56n03.xml0000644006511100651110000000033110504340460026315 0ustar rossross ]> Invalid TokenizedType IdRefs(case sensitive) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P56/ibm56n04.xml0000644006511100651110000000033110504340460026316 0ustar rossross ]> Invalid TokenizedType EntitY(case sensitive) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P56/ibm56n05.xml0000644006511100651110000000033310504340460026321 0ustar rossross ]> Invalid TokenizedType nmTOKEN(case sensitive) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P56/ibm56n06.xml0000644006511100651110000000033510504340460026324 0ustar rossross ]> Invalid TokenizedType NMtokens(case sensitive) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P56/ibm56n07.xml0000644006511100651110000000032410504340460026323 0ustar rossross ]> Invalid TokenizedType #ID(Wrong Character) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P57/0000755006511100651110000000000010504340460024334 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P57/ibm57n01.xml0000644006511100651110000000034010504340460026315 0ustar rossross ]> This test case tests the illegal enumerated types hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P58/0000755006511100651110000000000010504340460024335 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P58/ibm58n01.xml0000644006511100651110000000045410504340460026325 0ustar rossross ]> This is a Negative test with notation (name) It is case sensitive. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P58/ibm58n02.xml0000644006511100651110000000045210504340460026324 0ustar rossross ]> This is a Negative test with (name) Missing the open parenthesis hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P58/ibm58n03.xml0000644006511100651110000000045210504340460026325 0ustar rossross ]> This is a Negative test with NOTATION () Missing the required field hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P58/ibm58n04.xml0000644006511100651110000000046210504340460026327 0ustar rossross ]> This is a Negative test with NOTATION (Name Missing the closing brackets hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P58/ibm58n05.xml0000644006511100651110000000044610504340460026332 0ustar rossross ]> This is a Negative test with (Name) NOTATION Wrong Ordering hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P58/ibm58n06.xml0000644006511100651110000000061010504340460026324 0ustar rossross ]> Negative Test. This test tests the presence of a correct seperator. There is a wrong seperator(,) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P58/ibm58n07.xml0000644006511100651110000000045310504340460026332 0ustar rossross ]> Negative Test. Missing space after NOTATION hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P58/ibm58n08.xml0000644006511100651110000000046510504340460026336 0ustar rossross ]> Negative Test. Presence of quotes around the value hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P59/0000755006511100651110000000000010504340460024336 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P59/ibm59n01.xml0000644006511100651110000000041010504340460026317 0ustar rossross ]> This is a Negative test Missing the required field hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P59/ibm59n02.xml0000644006511100651110000000041510504340460026325 0ustar rossross ]> This is a Negative test Missing the closing brackets hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P59/ibm59n03.xml0000644006511100651110000000045410504340460026331 0ustar rossross ]> This is a Negative test Wrong Separator(, instead of |) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P59/ibm59n04.xml0000644006511100651110000000043710504340460026333 0ustar rossross ]> This is a Negative test Illegal presence of quotes around the value hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P59/ibm59n05.xml0000644006511100651110000000041710504340460026332 0ustar rossross ]> This is a Negative test Missing the begining bracket hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P59/ibm59n06.xml0000644006511100651110000000041510504340460026331 0ustar rossross ]> This is a Negative test Missing the Opening brackets hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P60/0000755006511100651110000000000010504340460024326 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P60/ibm60n01.xml0000644006511100651110000000040210504340460026300 0ustar rossross ]> Negative Test. Case sensitive. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P60/ibm60n02.xml0000644006511100651110000000040010504340460026277 0ustar rossross ]> Negative test. Case Sensitive hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P60/ibm60n03.xml0000644006511100651110000000040210504340460026302 0ustar rossross ]> Negative Test. Wrong Character. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P60/ibm60n04.xml0000644006511100651110000000044310504340460026310 0ustar rossross ]> Negative test. Missing required field(#FIXED should have a value) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P60/ibm60n05.xml0000644006511100651110000000047510504340460026316 0ustar rossross ]> Negative test. Missing required field(#FIXED should have a space before value) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P60/ibm60n06.xml0000644006511100651110000000041510504340460026311 0ustar rossross ]> Negative test. Wrong Ordering hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P60/ibm60n07.xml0000644006511100651110000000061510504340460026314 0ustar rossross ]> Negative test. The replacement text of any entity referred to directly or indirectly in an attribute value contains a less than character hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P60/ibm60n08.xml0000644006511100651110000000044610504340460026317 0ustar rossross ]> Negative Test. More than one Default type declarations. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P61/0000755006511100651110000000000010504340460024327 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P61/ibm61n01.dtd0000644006511100651110000000021410504340460026256 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P61/ibm61n01.xml0000644006511100651110000000021010504340460026277 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/0000755006511100651110000000000010504340460024330 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n01.dtd0000644006511100651110000000032610504340460026264 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n01.xml0000644006511100651110000000030610504340460026307 0ustar rossross Negative test. Test includeSect with include(Case sensitive) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n02.dtd0000644006511100651110000000032310504340460026262 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n02.xml0000644006511100651110000000025710504340460026315 0ustar rossross Negative test. An extra '[' is used. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n03.dtd0000644006511100651110000000035410504340460026267 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n03.xml0000644006511100651110000000027010504340460026311 0ustar rossross Negative test. Wrong character is used is used. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n04.dtd0000644006511100651110000000033010504340460026262 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n04.xml0000644006511100651110000000027310504340460026315 0ustar rossross Negative test. Missing the required field INCLUDE. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n05.dtd0000644006511100651110000000035010504340460026265 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n05.xml0000644006511100651110000000030510504340460026312 0ustar rossross Negative test. Missing the required field '[' after INCLUDE. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n06.dtd0000644006511100651110000000040710504340460026271 0ustar rossross [INCLUDE ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n06.xml0000644006511100651110000000034010504340460026312 0ustar rossross Negative test. Wrong Ordering. External subset declaration prior to the keyword INCLUDE hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n07.dtd0000644006511100651110000000032310504340460026267 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n07.xml0000644006511100651110000000026010504340460026314 0ustar rossross Negative test. Missing closing sequence. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n08.dtd0000644006511100651110000000033510504340460026273 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P62/ibm62n08.xml0000644006511100651110000000027310504340460026321 0ustar rossross Negative test. Missing external subset declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/0000755006511100651110000000000010504340460024331 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n01.dtd0000644006511100651110000000027410504340460026270 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n01.xml0000644006511100651110000000045310504340460026314 0ustar rossross ]> Negative test. Case sensitive(ignore is used instead of IGNORE). hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n02.dtd0000644006511100651110000000033610504340460026270 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n02.xml0000644006511100651110000000034510504340460026315 0ustar rossross ]> Negative test. Extra '[' is used before IGNORE. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n03.dtd0000644006511100651110000000025610504340460026272 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n03.xml0000644006511100651110000000041310504340460026312 0ustar rossross ]> Negative test. Wrong character. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n04.dtd0000644006511100651110000000027310504340460026272 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n04.xml0000644006511100651110000000046110504340460026316 0ustar rossross ]> Negative test. Missing required field(The keyword IGNORE is missing). hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n05.dtd0000644006511100651110000000030110504340460026263 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n05.xml0000644006511100651110000000046110504340460026317 0ustar rossross ]> Negative test. Missing required field( '[' is missing after IGNORE ). hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n06.dtd0000644006511100651110000000036510504340460026276 0ustar rossross [IGNORE ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n06.xml0000644006511100651110000000037410504340460026323 0ustar rossross ]> Negative test. Wrong Ordering. Ignore sect contents preceding IGNORE. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n07.dtd0000644006511100651110000000032210504340460026270 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P63/ibm63n07.xml0000644006511100651110000000042410504340460026320 0ustar rossross ]> Negative test. Missing closing sequence. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P64/0000755006511100651110000000000010504340460024332 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P64/ibm64n01.dtd0000644006511100651110000000031110504340460026262 0ustar rossross ]]> end ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P64/ibm64n01.xml0000644006511100651110000000030310504340460026310 0ustar rossross ]> Negative Test. Pattern2. Wrong character. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P64/ibm64n02.dtd0000644006511100651110000000026210504340460026270 0ustar rossross end ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P64/ibm64n02.xml0000644006511100651110000000031410504340460026313 0ustar rossross ]> Negative Test. Pattern3. Missing closing sequence. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P64/ibm64n03.dtd0000644006511100651110000000026210504340460026271 0ustar rossross ]]> end ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P64/ibm64n03.xml0000644006511100651110000000031410504340460026314 0ustar rossross ]> Negative Test. Pattern4. Missing opening sequence. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P65/0000755006511100651110000000000010504340460024333 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P65/ibm65n01.dtd0000644006511100651110000000047710504340460026301 0ustar rossross this is illegal ]]> hello ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P65/ibm65n01.xml0000644006511100651110000000031210504340460026312 0ustar rossross ]> Negative Test. Pattern1.Illegal sequence of ']]' hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P65/ibm65n02.dtd0000644006511100651110000000054310504340460026274 0ustar rossross ]]> hello ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P65/ibm65n02.xml0000644006511100651110000000026310504340460026320 0ustar rossross ]> Negative Test. Pattern2. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/0000755006511100651110000000000010504340460024334 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n01.xml0000644006511100651110000000021710504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n02.xml0000644006511100651110000000020710504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n03.xml0000644006511100651110000000021410504340460026317 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n04.xml0000644006511100651110000000020410504340460026317 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n05.xml0000644006511100651110000000022010504340460026316 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n06.xml0000644006511100651110000000020610504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n07.xml0000644006511100651110000000022010504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n08.xml0000644006511100651110000000020510504340460026324 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n09.xml0000644006511100651110000000022110504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n10.xml0000644006511100651110000000020510504340460026315 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n11.xml0000644006511100651110000000022110504340460026314 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n12.xml0000644006511100651110000000022410504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n13.xml0000644006511100651110000000021210504340460026316 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n14.xml0000644006511100651110000000021310504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P66/ibm66n15.xml0000644006511100651110000000021210504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/0000755006511100651110000000000010504340460024336 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n01.xml0000644006511100651110000000022510504340460026323 0ustar rossross ]> missing entity name &; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n02.xml0000644006511100651110000000023410504340460026324 0ustar rossross ]> missing semi-colon hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n03.xml0000644006511100651110000000024310504340460026325 0ustar rossross ]> extra space after ampsand & aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n04.xml0000644006511100651110000000025510504340460026331 0ustar rossross ]> reference doesn't match delaration hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n05.xml0000644006511100651110000000017610504340460026334 0ustar rossross ]> undefined entitiy &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n06.dtd0000644006511100651110000000010110504340460026274 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n06.xml0000644006511100651110000000034110504340460026327 0ustar rossross ]> entity declared externally but standalone is yes hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n07.xml0000644006511100651110000000031310504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n08.xml0000644006511100651110000000042310504340460026332 0ustar rossross ]> unparsed entity reference in the wrong place &aImage; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n09.xml0000644006511100651110000000030210504340460026327 0ustar rossross ]> &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P68/ibm68n10.xml0000644006511100651110000000042210504340460026322 0ustar rossross ]> &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P69/0000755006511100651110000000000010504340460024337 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P69/ibm69n01.xml0000644006511100651110000000026310504340460026327 0ustar rossross "> %; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P69/ibm69n02.xml0000644006511100651110000000031010504340460026321 0ustar rossross "> %paaa ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P69/ibm69n03.xml0000644006511100651110000000034010504340460026325 0ustar rossross "> %paaa ; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P69/ibm69n04.xml0000644006511100651110000000032610504340460026332 0ustar rossross "> % paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P69/ibm69n05.xml0000644006511100651110000000040310504340460026327 0ustar rossross %paaa; "> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P69/ibm69n06.xml0000644006511100651110000000022010504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P69/ibm69n07.xml0000644006511100651110000000034010504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/0000755006511100651110000000000010504340460024330 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/ibm70n01.xml0000644006511100651110000000030510504340460026305 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/ibm71n01.xml0000644006511100651110000000024210504340460026306 0ustar rossross ]> &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/ibm71n02.xml0000644006511100651110000000024010504340460026305 0ustar rossross ]> &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/ibm71n03.xml0000644006511100651110000000023310504340460026310 0ustar rossross ]> &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/ibm71n04.xml0000644006511100651110000000023410504340460026312 0ustar rossross ]> &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/ibm71n05.xml0000644006511100651110000000024010504340460026310 0ustar rossross ]> &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/ibm71n06.xml0000644006511100651110000000024610504340460026317 0ustar rossross ]> &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/ibm71n07.xml0000644006511100651110000000025210504340460026315 0ustar rossross &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P71/ibm71n08.xml0000644006511100651110000000025310504340460026317 0ustar rossross ]> &aaa; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/0000755006511100651110000000000010504340460024331 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/ibm72n01.xml0000644006511100651110000000026210504340460026312 0ustar rossross "> %paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/ibm72n02.xml0000644006511100651110000000024310504340460026312 0ustar rossross "> %paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/ibm72n03.xml0000644006511100651110000000025010504340460026311 0ustar rossross "> %paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/ibm72n04.xml0000644006511100651110000000022510504340460026314 0ustar rossross %paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/ibm72n05.xml0000644006511100651110000000024710504340460026321 0ustar rossross " paaa> %paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/ibm72n06.xml0000644006511100651110000000025010504340460026314 0ustar rossross " % paaa > %paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/ibm72n07.xml0000644006511100651110000000025110504340460026316 0ustar rossross "> %paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/ibm72n08.xml0000644006511100651110000000026210504340460026321 0ustar rossross " %paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P72/ibm72n09.xml0000644006511100651110000000031210504340460026316 0ustar rossross " !> %paaa; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P73/0000755006511100651110000000000010504340460024332 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P73/ibm73n01.xml0000644006511100651110000000035710504340460026321 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P73/ibm73n03.xml0000644006511100651110000000031510504340460026315 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P74/0000755006511100651110000000000010504340460024333 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P74/ibm74n01.xml0000644006511100651110000000036010504340460026315 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/0000755006511100651110000000000010504340460024334 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n01.xml0000644006511100651110000000025010504340460026315 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/empty.dtd0000644006511100651110000000003110504340460026161 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n02.xml0000644006511100651110000000030410504340460026316 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n03.xml0000644006511100651110000000030410504340460026317 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n04.xml0000644006511100651110000000027110504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n05.xml0000644006511100651110000000023610504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n06.xml0000644006511100651110000000023510504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n07.xml0000644006511100651110000000027310504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n08.xml0000644006511100651110000000027710504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n09.xml0000644006511100651110000000027310504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n10.xml0000644006511100651110000000026310504340460026321 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n11.xml0000644006511100651110000000027010504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n12.xml0000644006511100651110000000023510504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P75/ibm75n13.xml0000644006511100651110000000027110504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P76/0000755006511100651110000000000010504340460024335 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P76/ibm76n01.xml0000644006511100651110000000040410504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P76/ibm76n02.xml0000644006511100651110000000040410504340460026321 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P76/ibm76n03.xml0000644006511100651110000000037410504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P76/ibm76n04.xml0000644006511100651110000000040110504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P76/ibm76n05.xml0000644006511100651110000000037010504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P76/ibm76n06.xml0000644006511100651110000000037410504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P76/ibm76n07.xml0000644006511100651110000000037310504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P77/0000755006511100651110000000000010504340460024336 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P77/ibm77n01.ent0000644006511100651110000000014210504340460026307 0ustar rossross ANY CONTENT hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P77/ibm77n01.xml0000644006511100651110000000030210504340460026317 0ustar rossross ]> &aExternal; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P77/ibm77n02.ent0000644006511100651110000000012210504340460026306 0ustar rossross ANY CONTENT hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P77/ibm77n02.xml0000644006511100651110000000030210504340460026320 0ustar rossross ]> &aExternal; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P77/ibm77n03.ent0000644006511100651110000000011610504340460026312 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P77/ibm77n03.xml0000644006511100651110000000030010504340460026317 0ustar rossross %pExternal; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P77/ibm77n04.ent0000644006511100651110000000012110504340460026307 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P77/ibm77n04.xml0000644006511100651110000000030010504340460026320 0ustar rossross %pExternal; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P78/0000755006511100651110000000000010504340460024337 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P78/ibm78n01.ent0000644006511100651110000000014210504340460026311 0ustar rossross ANY CONTENT hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P78/ibm78n01.xml0000644006511100651110000000031010504340460026320 0ustar rossross ]> &aExternal; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P78/ibm78n02.ent0000644006511100651110000000013710504340460026316 0ustar rossross ANY CONTENT hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P78/ibm78n02.xml0000644006511100651110000000030210504340460026322 0ustar rossross ]> &aExternal; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P79/0000755006511100651110000000000010504340460024340 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P79/ibm79n01.ent0000644006511100651110000000010010504340460026305 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P79/ibm79n01.xml0000644006511100651110000000030010504340460026321 0ustar rossross %pExternal; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P79/ibm79n02.ent0000644006511100651110000000013110504340460026312 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P79/ibm79n02.xml0000644006511100651110000000030010504340460026322 0ustar rossross %pExternal; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P80/0000755006511100651110000000000010504340460024330 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P80/ibm80n01.xml0000644006511100651110000000027510504340460026314 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P80/ibm80n02.xml0000644006511100651110000000026510504340460026314 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P80/ibm80n03.xml0000644006511100651110000000026410504340460026314 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P80/ibm80n04.xml0000644006511100651110000000027110504340460026313 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P80/ibm80n05.xml0000644006511100651110000000027110504340460026314 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P80/ibm80n06.xml0000644006511100651110000000030110504340460026307 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/0000755006511100651110000000000010504340460024331 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/ibm81n01.xml0000644006511100651110000000030010504340460026303 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/ibm81n02.xml0000644006511100651110000000027610504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/ibm81n03.xml0000644006511100651110000000027610504340460026321 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/ibm81n04.xml0000644006511100651110000000027610504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/ibm81n05.xml0000644006511100651110000000026610504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/ibm81n06.xml0000644006511100651110000000026610504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/ibm81n07.xml0000644006511100651110000000026510504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/ibm81n08.xml0000644006511100651110000000026610504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P81/ibm81n09.xml0000644006511100651110000000026610504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P82/0000755006511100651110000000000010504340460024332 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P82/ibm82n01.xml0000644006511100651110000000040410504340460026312 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P82/ibm82n02.xml0000644006511100651110000000040210504340460026311 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P82/ibm82n03.xml0000644006511100651110000000037710504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P82/ibm82n04.xml0000644006511100651110000000040210504340460026313 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P82/ibm82n05.xml0000644006511100651110000000041210504340460026315 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P82/ibm82n06.xml0000644006511100651110000000042610504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P82/ibm82n07.xml0000644006511100651110000000044710504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P82/ibm82n08.xml0000644006511100651110000000041210504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P83/0000755006511100651110000000000010504340460024333 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P83/ibm83n01.xml0000644006511100651110000000041310504340460026314 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P83/ibm83n02.xml0000644006511100651110000000042310504340460026316 0ustar rossrossr ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P83/ibm83n03.xml0000644006511100651110000000040410504340460026316 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P83/ibm83n04.xml0000644006511100651110000000041610504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P83/ibm83n05.xml0000644006511100651110000000037010504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P83/ibm83n06.xml0000644006511100651110000000041210504340460026320 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/0000755006511100651110000000000010504340460024335 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n01.xml0000644006511100651110000000014710504340460026324 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n02.xml0000644006511100651110000000014710504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n03.xml0000644006511100651110000000014710504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n04.xml0000644006511100651110000000014710504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n05.xml0000644006511100651110000000014710504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n06.xml0000644006511100651110000000014710504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n07.xml0000644006511100651110000000014710504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n08.xml0000644006511100651110000000014710504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n09.xml0000644006511100651110000000014710504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n10.xml0000644006511100651110000000014710504340460026324 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n100.xml0000644006511100651110000000015110504340460026377 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n101.xml0000644006511100651110000000015110504340460026400 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n102.xml0000644006511100651110000000015110504340460026401 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n103.xml0000644006511100651110000000015110504340460026402 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n104.xml0000644006511100651110000000015110504340460026403 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n105.xml0000644006511100651110000000015110504340460026404 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n106.xml0000644006511100651110000000015110504340460026405 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n107.xml0000644006511100651110000000015110504340460026406 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n108.xml0000644006511100651110000000015110504340460026407 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n109.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n11.xml0000644006511100651110000000014710504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n110.xml0000644006511100651110000000015110504340460026400 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n111.xml0000644006511100651110000000015110504340460026401 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n112.xml0000644006511100651110000000015110504340460026402 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n113.xml0000644006511100651110000000015110504340460026403 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n114.xml0000644006511100651110000000015110504340460026404 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n115.xml0000644006511100651110000000015110504340460026405 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n116.xml0000644006511100651110000000015110504340460026406 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n117.xml0000644006511100651110000000015110504340460026407 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n118.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n119.xml0000644006511100651110000000015110504340460026411 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n12.xml0000644006511100651110000000014710504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n120.xml0000644006511100651110000000015110504340460026401 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n121.xml0000644006511100651110000000015110504340460026402 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n122.xml0000644006511100651110000000015110504340460026403 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n123.xml0000644006511100651110000000015110504340460026404 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n124.xml0000644006511100651110000000015110504340460026405 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n125.xml0000644006511100651110000000015110504340460026406 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n126.xml0000644006511100651110000000015110504340460026407 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n127.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n128.xml0000644006511100651110000000015110504340460026411 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n129.xml0000644006511100651110000000015110504340460026412 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n13.xml0000644006511100651110000000014710504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n130.xml0000644006511100651110000000015110504340460026402 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n131.xml0000644006511100651110000000015110504340460026403 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n132.xml0000644006511100651110000000015110504340460026404 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n133.xml0000644006511100651110000000015110504340460026405 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n134.xml0000644006511100651110000000015110504340460026406 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n135.xml0000644006511100651110000000015110504340460026407 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n136.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n137.xml0000644006511100651110000000015110504340460026411 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n138.xml0000644006511100651110000000015110504340460026412 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n139.xml0000644006511100651110000000015110504340460026413 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n14.xml0000644006511100651110000000014710504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n140.xml0000644006511100651110000000015110504340460026403 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n141.xml0000644006511100651110000000015110504340460026404 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n142.xml0000644006511100651110000000015110504340460026405 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n143.xml0000644006511100651110000000015110504340460026406 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n144.xml0000644006511100651110000000015110504340460026407 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n145.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n146.xml0000644006511100651110000000015110504340460026411 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n147.xml0000644006511100651110000000015110504340460026412 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n148.xml0000644006511100651110000000015110504340460026413 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n149.xml0000644006511100651110000000015110504340460026414 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n15.xml0000644006511100651110000000014710504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n150.xml0000644006511100651110000000015110504340460026404 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n151.xml0000644006511100651110000000015110504340460026405 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n152.xml0000644006511100651110000000015110504340460026406 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n153.xml0000644006511100651110000000015110504340460026407 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n154.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n155.xml0000644006511100651110000000015110504340460026411 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n156.xml0000644006511100651110000000015110504340460026412 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n157.xml0000644006511100651110000000015110504340460026413 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n158.xml0000644006511100651110000000015110504340460026414 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n159.xml0000644006511100651110000000015110504340460026415 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n16.xml0000644006511100651110000000014710504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n160.xml0000644006511100651110000000015110504340460026405 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n161.xml0000644006511100651110000000015110504340460026406 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n162.xml0000644006511100651110000000015110504340460026407 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n163.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n164.xml0000644006511100651110000000015110504340460026411 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n165.xml0000644006511100651110000000015110504340460026412 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n166.xml0000644006511100651110000000015110504340460026413 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n167.xml0000644006511100651110000000015110504340460026414 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n168.xml0000644006511100651110000000015110504340460026415 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n169.xml0000644006511100651110000000015110504340460026416 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n17.xml0000644006511100651110000000014710504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n170.xml0000644006511100651110000000015110504340460026406 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n171.xml0000644006511100651110000000015110504340460026407 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n172.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n173.xml0000644006511100651110000000015110504340460026411 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n174.xml0000644006511100651110000000015110504340460026412 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n175.xml0000644006511100651110000000015110504340460026413 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n176.xml0000644006511100651110000000015110504340460026414 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n177.xml0000644006511100651110000000015110504340460026415 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n178.xml0000644006511100651110000000015110504340460026416 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n179.xml0000644006511100651110000000015110504340460026417 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n18.xml0000644006511100651110000000014710504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n180.xml0000644006511100651110000000015110504340460026407 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n181.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n182.xml0000644006511100651110000000015110504340460026411 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n183.xml0000644006511100651110000000015110504340460026412 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n184.xml0000644006511100651110000000015110504340460026413 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n185.xml0000644006511100651110000000015110504340460026414 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n186.xml0000644006511100651110000000015110504340460026415 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n187.xml0000644006511100651110000000015110504340460026416 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n188.xml0000644006511100651110000000015110504340460026417 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n189.xml0000644006511100651110000000015110504340460026420 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n19.xml0000644006511100651110000000014710504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n190.xml0000644006511100651110000000015110504340460026410 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n191.xml0000644006511100651110000000015110504340460026411 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n192.xml0000644006511100651110000000015110504340460026412 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n193.xml0000644006511100651110000000015110504340460026413 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n194.xml0000644006511100651110000000015110504340460026414 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n195.xml0000644006511100651110000000015110504340460026415 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n196.xml0000644006511100651110000000015110504340460026416 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n197.xml0000644006511100651110000000015110504340460026417 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n198.xml0000644006511100651110000000015110504340460026420 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n20.xml0000644006511100651110000000014710504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n21.xml0000644006511100651110000000014710504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n22.xml0000644006511100651110000000014710504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n23.xml0000644006511100651110000000014710504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n24.xml0000644006511100651110000000014710504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n25.xml0000644006511100651110000000014710504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n26.xml0000644006511100651110000000014710504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n27.xml0000644006511100651110000000014710504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n28.xml0000644006511100651110000000014710504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n29.xml0000644006511100651110000000014710504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n30.xml0000644006511100651110000000014710504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n31.xml0000644006511100651110000000014710504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n32.xml0000644006511100651110000000014710504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n33.xml0000644006511100651110000000014710504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n34.xml0000644006511100651110000000014710504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n35.xml0000644006511100651110000000014710504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n36.xml0000644006511100651110000000014710504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n37.xml0000644006511100651110000000014710504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n38.xml0000644006511100651110000000014710504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n39.xml0000644006511100651110000000014710504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n40.xml0000644006511100651110000000014710504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n41.xml0000644006511100651110000000014710504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n42.xml0000644006511100651110000000014710504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n43.xml0000644006511100651110000000014710504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n44.xml0000644006511100651110000000014710504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n45.xml0000644006511100651110000000014710504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n46.xml0000644006511100651110000000014710504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n47.xml0000644006511100651110000000014710504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n48.xml0000644006511100651110000000014710504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n49.xml0000644006511100651110000000014710504340460026340 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n50.xml0000644006511100651110000000014710504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n51.xml0000644006511100651110000000014710504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n52.xml0000644006511100651110000000015110504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n53.xml0000644006511100651110000000015110504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n54.xml0000644006511100651110000000015110504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n55.xml0000644006511100651110000000015110504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n56.xml0000644006511100651110000000015110504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n57.xml0000644006511100651110000000015110504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n58.xml0000644006511100651110000000015110504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n59.xml0000644006511100651110000000015110504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n60.xml0000644006511100651110000000015110504340460026324 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n61.xml0000644006511100651110000000015110504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n62.xml0000644006511100651110000000015110504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n63.xml0000644006511100651110000000015110504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n64.xml0000644006511100651110000000015110504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n65.xml0000644006511100651110000000015110504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n66.xml0000644006511100651110000000015110504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n67.xml0000644006511100651110000000015110504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n68.xml0000644006511100651110000000015110504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n69.xml0000644006511100651110000000015110504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n70.xml0000644006511100651110000000015110504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n71.xml0000644006511100651110000000015110504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n72.xml0000644006511100651110000000015110504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n73.xml0000644006511100651110000000015110504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n74.xml0000644006511100651110000000015110504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n75.xml0000644006511100651110000000015110504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n76.xml0000644006511100651110000000015110504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n77.xml0000644006511100651110000000015110504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n78.xml0000644006511100651110000000015110504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n79.xml0000644006511100651110000000015110504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n80.xml0000644006511100651110000000015110504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n81.xml0000644006511100651110000000015110504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n82.xml0000644006511100651110000000015110504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n83.xml0000644006511100651110000000015110504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n84.xml0000644006511100651110000000015110504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n85.xml0000644006511100651110000000015110504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n86.xml0000644006511100651110000000015110504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n87.xml0000644006511100651110000000015110504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n88.xml0000644006511100651110000000015110504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n89.xml0000644006511100651110000000015110504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n90.xml0000644006511100651110000000015110504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n91.xml0000644006511100651110000000015110504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n92.xml0000644006511100651110000000015110504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n93.xml0000644006511100651110000000015110504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n94.xml0000644006511100651110000000015110504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n95.xml0000644006511100651110000000015110504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n96.xml0000644006511100651110000000015110504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n97.xml0000644006511100651110000000015110504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n98.xml0000644006511100651110000000015110504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P85/ibm85n99.xml0000644006511100651110000000015110504340460026340 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P86/0000755006511100651110000000000010504340460024336 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P86/ibm86n01.xml0000644006511100651110000000015110504340460026321 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P86/ibm86n02.xml0000644006511100651110000000015110504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P86/ibm86n03.xml0000644006511100651110000000015110504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P86/ibm86n04.xml0000644006511100651110000000015110504340460026324 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/0000755006511100651110000000000010504340460024337 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n01.xml0000644006511100651110000000015010504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n02.xml0000644006511100651110000000015010504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n03.xml0000644006511100651110000000015010504340460026324 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n04.xml0000644006511100651110000000015010504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n05.xml0000644006511100651110000000015010504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n06.xml0000644006511100651110000000015010504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n07.xml0000644006511100651110000000015010504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n08.xml0000644006511100651110000000015010504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n09.xml0000644006511100651110000000015010504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n10.xml0000644006511100651110000000015010504340460026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n11.xml0000644006511100651110000000015010504340460026323 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n12.xml0000644006511100651110000000015010504340460026324 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n13.xml0000644006511100651110000000015010504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n14.xml0000644006511100651110000000015010504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n15.xml0000644006511100651110000000015210504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n16.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n17.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n18.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n19.xml0000644006511100651110000000015210504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n20.xml0000644006511100651110000000015210504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n21.xml0000644006511100651110000000015210504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n22.xml0000644006511100651110000000015210504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n23.xml0000644006511100651110000000015210504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n24.xml0000644006511100651110000000015210504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n25.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n26.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n27.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n28.xml0000644006511100651110000000015210504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n29.xml0000644006511100651110000000015210504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n30.xml0000644006511100651110000000015210504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n31.xml0000644006511100651110000000015210504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n32.xml0000644006511100651110000000015210504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n33.xml0000644006511100651110000000015210504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n34.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n35.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n36.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n37.xml0000644006511100651110000000015210504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n38.xml0000644006511100651110000000015210504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n39.xml0000644006511100651110000000015210504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n40.xml0000644006511100651110000000015210504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n41.xml0000644006511100651110000000015210504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n42.xml0000644006511100651110000000015210504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n43.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n44.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n45.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n46.xml0000644006511100651110000000015210504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n47.xml0000644006511100651110000000015210504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n48.xml0000644006511100651110000000015210504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n49.xml0000644006511100651110000000015210504340460026340 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n50.xml0000644006511100651110000000015210504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n51.xml0000644006511100651110000000015210504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n52.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n53.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n54.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n55.xml0000644006511100651110000000015210504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n56.xml0000644006511100651110000000015210504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n57.xml0000644006511100651110000000015210504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n58.xml0000644006511100651110000000015210504340460026340 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n59.xml0000644006511100651110000000015210504340460026341 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n60.xml0000644006511100651110000000015210504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n61.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n62.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n63.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n64.xml0000644006511100651110000000015210504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n66.xml0000644006511100651110000000015210504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n67.xml0000644006511100651110000000015210504340460026340 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n68.xml0000644006511100651110000000015210504340460026341 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n69.xml0000644006511100651110000000015210504340460026342 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n70.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n71.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n72.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n73.xml0000644006511100651110000000015210504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n74.xml0000644006511100651110000000015210504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n75.xml0000644006511100651110000000015210504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n76.xml0000644006511100651110000000015210504340460026340 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n77.xml0000644006511100651110000000015210504340460026341 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n78.xml0000644006511100651110000000015210504340460026342 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n79.xml0000644006511100651110000000015210504340460026343 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n80.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n81.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n82.xml0000644006511100651110000000015210504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n83.xml0000644006511100651110000000015210504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n84.xml0000644006511100651110000000015210504340460026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P87/ibm87n85.xml0000644006511100651110000000015210504340460026340 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/0000755006511100651110000000000010504340460024340 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n01.xml0000644006511100651110000000014410504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n02.xml0000644006511100651110000000014410504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n03.xml0000644006511100651110000000015010504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n04.xml0000644006511100651110000000015010504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n05.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n06.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n08.xml0000644006511100651110000000015210504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n09.xml0000644006511100651110000000015210504340460026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n10.xml0000644006511100651110000000015210504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n11.xml0000644006511100651110000000015210504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n12.xml0000644006511100651110000000015210504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n13.xml0000644006511100651110000000015210504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n14.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n15.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P88/ibm88n16.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/0000755006511100651110000000000010504340460024341 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n01.xml0000644006511100651110000000015210504340460026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n02.xml0000644006511100651110000000015210504340460026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n03.xml0000644006511100651110000000015210504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n04.xml0000644006511100651110000000015210504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n05.xml0000644006511100651110000000015210504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n06.xml0000644006511100651110000000020310504340460026332 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n07.xml0000644006511100651110000000020310504340460026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n08.xml0000644006511100651110000000020310504340460026334 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n09.xml0000644006511100651110000000020310504340460026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n10.xml0000644006511100651110000000020310504340460026325 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n11.xml0000644006511100651110000000020310504340460026326 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/P89/ibm89n12.xml0000644006511100651110000000020310504340460026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/misc/0000755006511100651110000000000010504340460024714 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/misc/432gewf.xml0000644006511100651110000000073010504340460026617 0ustar rossross "> ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/misc/ltinentval.xml0000644006511100651110000000056110504340460027620 0ustar rossross ]> <--* this is to test "<" can not be included in an entity that is referenced in AttValue, even indirectly *--> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/misc/simpleltinentval.xml0000644006511100651110000000076210504340460031035 0ustar rossross ]> <--* this is to test "<" can not be included in the replacement text of an entity that is referenced in AttValue. Anyway, this file should be rejected because the internal GE "gewithlt" is not even well-formed by definition. *--> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/p28a/0000755006511100651110000000000010504340460024533 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/p28a/out/0000755006511100651110000000000010504340457025350 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/p28a/ibm28an01.dtd0000644006511100651110000000052010504340460026626 0ustar rossross %make_leopard_element;ANY> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/not-wf/p28a/ibm28an01.xml0000644006511100651110000000115110504340460026654 0ustar rossross ]> &forcat; This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/0000755006511100651110000000000010504340457023654 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P01/0000755006511100651110000000000010504340460024206 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P01/out/0000755006511100651110000000000010504340460025015 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P01/out/ibm01v01.xml0000644006511100651110000000035610504340460027002 0ustar rossross This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P01/ibm01v01.xml0000644006511100651110000000106510504340460026171 0ustar rossross ]> This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P02/0000755006511100651110000000000010504340460024207 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P02/out/0000755006511100651110000000000010504340460025016 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P02/out/ibm02v01.xml0000644006511100651110000000022110504340460026773 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P02/ibm02v01.xml0000644006511100651110000000053110504340460026170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P03/0000755006511100651110000000000010504340460024210 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P03/out/0000755006511100651110000000000010504340460025017 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P03/out/ibm03v01.xml0000644006511100651110000000007710504340460027006 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P03/ibm03v01.xml0000644006511100651110000000041510504340460026173 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/0000755006511100651110000000000010504340460024216 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/out/0000755006511100651110000000000010504340460025025 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/out/ibm09v01.xml0000644006511100651110000000004010504340460027010 0ustar rossrossMy Name is . hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/out/ibm09v02.xml0000644006511100651110000000004710504340460027020 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/out/ibm09v03.xml0000644006511100651110000000006710504340460027023 0ustar rossrossI am a new student with first , lasthugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/out/ibm09v04.xml0000644006511100651110000000004710504340460027022 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/out/ibm09v05.xml0000644006511100651110000000040110504340460027015 0ustar rossrossThis is a test of My Name is first , last , middle and my age is 21 Again first , last , middle first , last , middle and my status is freshman freshman and first , last , middle 21 first , last , middle freshman That is all.hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/ibm09v01.xml0000644006511100651110000000026210504340460026207 0ustar rossross ]> My Name is &FullName;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/ibm09v02.xml0000644006511100651110000000023410504340460026207 0ustar rossross ]> My Name is &FullName;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/ibm09v03.dtd0000644006511100651110000000022210504340460026160 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/ibm09v03.xml0000644006511100651110000000016510504340460026213 0ustar rossross I am a new student with &Name; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/ibm09v04.xml0000644006511100651110000000035510504340460026215 0ustar rossross ]> My Name is &FullName;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/ibm09v05.xml0000644006511100651110000000047110504340460026215 0ustar rossross ]> This is a test of &combine; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P09/student.dtd0000644006511100651110000000035010504340460026377 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/0000755006511100651110000000000010504340460024206 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/out/0000755006511100651110000000000010504340460025015 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/out/ibm10v01.xml0000644006511100651110000000007210504340460026775 0ustar rossrossMy Name is Snow Man. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/out/ibm10v02.xml0000644006511100651110000000007210504340460026776 0ustar rossrossMy Name is Snow Man. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/out/ibm10v03.xml0000644006511100651110000000010210504340460026771 0ustar rossrossMy Name is Snow Man'. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/out/ibm10v04.xml0000644006511100651110000000011410504340460026775 0ustar rossrossMy Name is Snow Man". hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/out/ibm10v05.xml0000644006511100651110000000010410504340460026775 0ustar rossrossMy Name is Snow Man. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/out/ibm10v06.xml0000644006511100651110000000010510504340460026777 0ustar rossrossMy Name is Snow Man. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/out/ibm10v07.xml0000644006511100651110000000033010504340460027000 0ustar rossrossMy first Name is Snow and my last name is Man Snow and Snow mymiddle;.. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/out/ibm10v08.xml0000644006511100651110000000034010504340460027002 0ustar rossrossMy first Name is Snow and my last name is Man Snow and Snow mymiddle;.. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/ibm10v01.xml0000644006511100651110000000061110504340460026165 0ustar rossross ]> My Name is Snow &mylast; Man. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/ibm10v02.xml0000644006511100651110000000057710504340460026201 0ustar rossross ]> My Name is Snow &mylast; Man. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/ibm10v03.xml0000644006511100651110000000060610504340460026173 0ustar rossross ]> My Name is &myfirst; &mylast;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/ibm10v04.xml0000644006511100651110000000061210504340460026171 0ustar rossross ]> My Name is &myfirst; &mylast;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/ibm10v05.xml0000644006511100651110000000062010504340460026171 0ustar rossross ]> My Name is &mylast;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/ibm10v06.xml0000644006511100651110000000062110504340460026173 0ustar rossross ]> My Name is &mylast;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/ibm10v07.xml0000644006511100651110000000100710504340460026173 0ustar rossross ]> My first Name is &myfirst; and my last name is &mylast;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P10/ibm10v08.xml0000644006511100651110000000100510504340460026172 0ustar rossross ]> My first Name is &myfirst; and my last name is &mylast;. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/0000755006511100651110000000000010504340460024207 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/out/0000755006511100651110000000000010504340460025016 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/out/ibm11v01.xml0000644006511100651110000000004710504340460027001 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/out/ibm11v02.xml0000644006511100651110000000004710504340460027002 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/out/ibm11v03.xml0000644006511100651110000000004710504340460027003 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/out/ibm11v04.xml0000644006511100651110000000004710504340460027004 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/ibm11v01.xml0000644006511100651110000000036210504340460026172 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/ibm11v02.xml0000644006511100651110000000034110504340460026170 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/ibm11v03.xml0000644006511100651110000000024410504340460026173 0ustar rossross My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/ibm11v04.xml0000644006511100651110000000025110504340460026172 0ustar rossross My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P11/student.dtd0000644006511100651110000000011710504340460026371 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/0000755006511100651110000000000010504340460024210 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/out/0000755006511100651110000000000010504340460025017 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/out/ibm12v01.xml0000644006511100651110000000004710504340460027003 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/out/ibm12v02.xml0000644006511100651110000000004710504340460027004 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/out/ibm12v03.xml0000644006511100651110000000004710504340460027005 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/out/ibm12v04.xml0000644006511100651110000000004710504340460027006 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/ibm12v01.xml0000644006511100651110000000030710504340460026173 0ustar rossross My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/ibm12v02.xml0000644006511100651110000000027110504340460026174 0ustar rossross My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/ibm12v03.xml0000644006511100651110000000027710504340460026203 0ustar rossross My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/ibm12v04.xml0000644006511100651110000000030610504340460026175 0ustar rossross My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P12/student.dtd0000644006511100651110000000011710504340460026372 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P13/0000755006511100651110000000000010504340460024211 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P13/out/0000755006511100651110000000000010504340460025020 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P13/out/ibm13v01.xml0000644006511100651110000000004710504340460027005 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P13/ibm13v01.xml0000644006511100651110000000043310504340460026175 0ustar rossross My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P13/student.dtd0000644006511100651110000000011710504340460026373 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P14/0000755006511100651110000000000010504340460024212 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P14/out/0000755006511100651110000000000010504340460025021 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P14/out/ibm14v01.xml0000644006511100651110000000004010504340460027000 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P14/out/ibm14v02.xml0000644006511100651110000000006210504340460027005 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P14/out/ibm14v03.xml0000644006511100651110000000007110504340460027006 0ustar rossrossThis is a testhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P14/ibm14v01.xml0000644006511100651110000000035210504340460026177 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P14/ibm14v02.xml0000644006511100651110000000040410504340460026176 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P14/ibm14v03.xml0000644006511100651110000000050410504340460026200 0ustar rossross ]> This is a testhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/0000755006511100651110000000000010504340460024213 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/out/0000755006511100651110000000000010504340460025022 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/out/ibm15v01.xml0000644006511100651110000000004710504340460027011 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/out/ibm15v02.xml0000644006511100651110000000004710504340460027012 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/out/ibm15v03.xml0000644006511100651110000000004710504340460027013 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/out/ibm15v04.xml0000644006511100651110000000004710504340460027014 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/ibm15v01.xml0000644006511100651110000000024610504340460026203 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/ibm15v02.xml0000644006511100651110000000022210504340460026176 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/ibm15v03.xml0000644006511100651110000000022210504340460026177 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P15/ibm15v04.xml0000644006511100651110000000025410504340460026205 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P16/0000755006511100651110000000000010504340460024214 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P16/out/0000755006511100651110000000000010504340460025023 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P16/out/ibm16v01.xml0000644006511100651110000000006610504340460027014 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P16/out/ibm16v02.xml0000644006511100651110000000006610504340460027015 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P16/out/ibm16v03.xml0000644006511100651110000000011510504340460027011 0ustar rossross IN PI ?>My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P16/ibm16v01.xml0000644006511100651110000000021710504340460026203 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P16/ibm16v02.xml0000644006511100651110000000021210504340460026177 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P16/ibm16v03.xml0000644006511100651110000000024110504340460026202 0ustar rossross ]> IN PI ?> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P17/0000755006511100651110000000000010504340460024215 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P17/out/0000755006511100651110000000000010504340460025024 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P17/out/ibm17v01.xml0000644006511100651110000000010510504340460027010 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P17/ibm17v01.xml0000644006511100651110000000023710504340460026207 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P18/0000755006511100651110000000000010504340460024216 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P18/out/0000755006511100651110000000000010504340460025025 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P18/out/ibm18v01.xml0000644006511100651110000000010310504340460027010 0ustar rossrossMy Name is SnowMan. This is <normal> text hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P18/ibm18v01.xml0000644006511100651110000000032310504340460026205 0ustar rossross ]> My Name is SnowMan. text]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P19/0000755006511100651110000000000010504340460024217 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P19/out/0000755006511100651110000000000010504340460025026 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P19/out/ibm19v01.xml0000644006511100651110000000006610504340460027022 0ustar rossrossMy Name is SnowMan. This is a test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P19/ibm19v01.xml0000644006511100651110000000026410504340460026213 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P20/0000755006511100651110000000000010504340460024207 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P20/out/0000755006511100651110000000000010504340460025016 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P20/out/ibm20v01.xml0000644006511100651110000000004710504340460027001 0ustar rossrossMy Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P20/out/ibm20v02.xml0000644006511100651110000000012410504340460026776 0ustar rossrossMy Name is SnowMan. <testing>This is a test</testing>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P20/ibm20v01.xml0000644006511100651110000000026710504340460026176 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P20/ibm20v02.xml0000644006511100651110000000032110504340460026166 0ustar rossross ]> My Name is SnowMan. This is a test]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P21/0000755006511100651110000000000010504340460024210 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P21/out/0000755006511100651110000000000010504340460025017 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P21/out/ibm21v01.xml0000644006511100651110000000006610504340460027004 0ustar rossrossMy Name is SnowMan. This is a test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P21/ibm21v01.xml0000644006511100651110000000026510504340460026176 0ustar rossross ]> My Name is SnowMan. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/0000755006511100651110000000000010504340461024212 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/out/0000755006511100651110000000000010504340461025021 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/out/ibm22v01.xml0000644006511100651110000000001310504340461026777 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/out/ibm22v02.xml0000644006511100651110000000001310504340461027000 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/out/ibm22v03.xml0000644006511100651110000000001310504340461027001 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/out/ibm22v04.xml0000644006511100651110000000001310504340461027002 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/out/ibm22v05.xml0000644006511100651110000000001310504340461027003 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/out/ibm22v06.xml0000644006511100651110000000001310504340461027004 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/out/ibm22v07.xml0000644006511100651110000000001310504340461027005 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/ibm22v01.xml0000644006511100651110000000013410504340460026173 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/ibm22v02.xml0000644006511100651110000000006310504340460026175 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/ibm22v03.xml0000644006511100651110000000011410504340460026173 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/ibm22v04.xml0000644006511100651110000000011410504340460026174 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/ibm22v05.xml0000644006511100651110000000016510504340460026203 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/ibm22v06.xml0000644006511100651110000000016510504340461026205 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P22/ibm22v07.xml0000644006511100651110000000021610504340461026203 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/0000755006511100651110000000000010504340461024213 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/out/0000755006511100651110000000000010504340461025022 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/out/ibm23v01.xml0000644006511100651110000000001310504340461027001 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/out/ibm23v02.xml0000644006511100651110000000001310504340461027002 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/out/ibm23v03.xml0000644006511100651110000000001310504340461027003 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/out/ibm23v04.xml0000644006511100651110000000001310504340461027004 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/out/ibm23v05.xml0000644006511100651110000000001310504340461027005 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/out/ibm23v06.xml0000644006511100651110000000001310504340461027006 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/ibm23v01.xml0000644006511100651110000000011210504340461026172 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/ibm23v02.xml0000644006511100651110000000013410504340461026177 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/ibm23v03.xml0000644006511100651110000000013410504340461026200 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/ibm23v04.xml0000644006511100651110000000011310504340461026176 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/ibm23v05.xml0000644006511100651110000000015410504340461026204 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P23/ibm23v06.xml0000644006511100651110000000015510504340461026206 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P24/0000755006511100651110000000000010504340461024214 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P24/out/0000755006511100651110000000000010504340461025023 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P24/out/ibm24v01.xml0000644006511100651110000000001310504340461027003 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P24/out/ibm24v02.xml0000644006511100651110000000001310504340461027004 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P24/ibm24v01.xml0000644006511100651110000000011210504340461026174 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P24/ibm24v02.xml0000644006511100651110000000011210504340461026175 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/0000755006511100651110000000000010504340461024215 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/out/0000755006511100651110000000000010504340461025024 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/out/ibm25v01.xml0000644006511100651110000000001310504340461027005 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/out/ibm25v02.xml0000644006511100651110000000001310504340461027006 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/out/ibm25v03.xml0000644006511100651110000000001310504340461027007 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/out/ibm25v04.xml0000644006511100651110000000001310504340461027010 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/ibm25v01.xml0000644006511100651110000000011210504340461026176 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/ibm25v02.xml0000644006511100651110000000011310504340461026200 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/ibm25v03.xml0000644006511100651110000000011310504340461026201 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P25/ibm25v04.xml0000644006511100651110000000011410504340461026203 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P26/0000755006511100651110000000000010504340461024216 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P26/out/0000755006511100651110000000000010504340461025025 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P26/out/ibm26v01.xml0000644006511100651110000000001310504340461027007 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P26/ibm26v01.xml0000644006511100651110000000011610504340461026204 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P27/0000755006511100651110000000000010504340461024217 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P27/out/0000755006511100651110000000000010504340461025026 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P27/out/ibm27v01.xml0000644006511100651110000000001310504340461027011 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P27/out/ibm27v02.xml0000644006511100651110000000005310504340461027016 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P27/out/ibm27v03.xml0000644006511100651110000000004510504340461027020 0ustar rossrossS is in the following Mischugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P27/ibm27v01.xml0000644006511100651110000000016010504340461026205 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P27/ibm27v02.xml0000644006511100651110000000015610504340461026213 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P27/ibm27v03.xml0000644006511100651110000000015310504340461026211 0ustar rossross ]> S is in the following Misc hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P28/0000755006511100651110000000000010504340461024220 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P28/out/0000755006511100651110000000000010504340461025027 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P28/out/ibm28v01.xml0000644006511100651110000000002110504340461027012 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P28/out/ibm28v02.xml0000644006511100651110000000050610504340461027023 0ustar rossross ]> This is a small cat This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P28/ibm28v01.xml0000644006511100651110000000023510504340461026212 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P28/ibm28v02.dtd0000644006511100651110000000005010504340461026161 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P28/ibm28v02.txt0000644006511100651110000000002210504340461026224 0ustar rossrossThis is an animal!hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P28/ibm28v02.xml0000644006511100651110000000144510504340461026217 0ustar rossross "> "> "> %make_leopard_element; %make_small; "> %make_big; %make_attlist; ]> &forcat; This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P29/0000755006511100651110000000000010504340461024221 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P29/out/0000755006511100651110000000000010504340461025030 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P29/out/ibm29v01.xml0000644006511100651110000000050610504340461027024 0ustar rossross ]> This is a small cat This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P29/out/ibm29v02.xml0000644006511100651110000000050610504340461027025 0ustar rossross ]> This is a small cat This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P29/ibm29v01.txt0000644006511100651110000000006310504340461026232 0ustar rossrossThis animal calss includes tiger, leopard, and cat.hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P29/ibm29v01.xml0000644006511100651110000000116310504340461026215 0ustar rossross ]> &forcat; This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P29/ibm29v02.xml0000644006511100651110000000126210504340461026216 0ustar rossross "> %make_leopard_element; ]> &forcat; This is a white tiger in Mirage!! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P30/0000755006511100651110000000000010504340461024211 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P30/out/0000755006511100651110000000000010504340461025020 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P30/out/ibm30v01.xml0000644006511100651110000000002110504340461026774 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P30/out/ibm30v02.xml0000644006511100651110000000002110504340461026775 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P30/ibm30v01.dtd0000644006511100651110000000003110504340461026141 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P30/ibm30v01.xml0000644006511100651110000000016610504340461026177 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P30/ibm30v02.dtd0000644006511100651110000000010110504340461026140 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P30/ibm30v02.xml0000644006511100651110000000017610504340461026201 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P31/0000755006511100651110000000000010504340461024212 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P31/out/0000755006511100651110000000000010504340461025021 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P31/out/ibm31v01.xml0000644006511100651110000000005510504340461027005 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P31/ibm31v01.dtd0000644006511100651110000000043610504340461026154 0ustar rossross "> ]]> %rootElement; "> %make_tiger_element; ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P31/ibm31v01.xml0000644006511100651110000000027310504340461026200 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/0000755006511100651110000000000010504340461024213 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/out/0000755006511100651110000000000010504340461025022 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/out/ibm32v01.xml0000644006511100651110000000004010504340461027001 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/out/ibm32v02.xml0000644006511100651110000000004710504340461027011 0ustar rossrossThis is a yellow tigerhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/out/ibm32v03.xml0000644006511100651110000000003310504340461027005 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/out/ibm32v04.xml0000644006511100651110000000013210504340461027006 0ustar rossrossThis is a yellow tigerhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/ibm32v01.dtd0000644006511100651110000000010610504340461026150 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/ibm32v01.xml0000644006511100651110000000032210504340461026175 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/ibm32v02.dtd0000644006511100651110000000011610504340461026152 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/ibm32v02.xml0000644006511100651110000000033510504340461026202 0ustar rossross &animal_content; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/ibm32v03.dtd0000644006511100651110000000010510504340461026151 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/ibm32v03.xml0000644006511100651110000000032610504340461026203 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/ibm32v04.dtd0000644006511100651110000000015610504340461026160 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P32/ibm32v04.xml0000644006511100651110000000034110504340461026201 0ustar rossross This is a yellow tiger hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P33/0000755006511100651110000000000010504340461024214 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P33/out/0000755006511100651110000000000010504340461025023 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P33/out/ibm33v01.xml0000644006511100651110000000006610504340461027013 0ustar rossrossIt is written in Englishhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P33/ibm33v01.xml0000644006511100651110000000030410504340461026177 0ustar rossross ]> It is written in English hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P34/0000755006511100651110000000000010504340461024215 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P34/out/0000755006511100651110000000000010504340461025024 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P34/out/ibm34v01.xml0000644006511100651110000000006610504340461027015 0ustar rossrossIt is written in Englishhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P34/ibm34v01.xml0000644006511100651110000000022310504340461026201 0ustar rossross ]> It is written in English hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P35/0000755006511100651110000000000010504340461024216 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P35/out/0000755006511100651110000000000010504340461025025 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P35/out/ibm35v01.xml0000644006511100651110000000006310504340461027014 0ustar rossrossIt is written in Englishhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P35/ibm35v01.xml0000644006511100651110000000022010504340461026200 0ustar rossross ]> It is written in English hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P36/0000755006511100651110000000000010504340461024217 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P36/out/0000755006511100651110000000000010504340461025026 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P36/out/ibm36v01.xml0000644006511100651110000000007210504340461027016 0ustar rossrossIt is written in Englishhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P36/ibm36v01.xml0000644006511100651110000000022710504340461026211 0ustar rossross ]> It is written in English hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P37/0000755006511100651110000000000010504340461024220 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P37/out/0000755006511100651110000000000010504340461025027 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P37/out/ibm37v01.xml0000644006511100651110000000007110504340461027017 0ustar rossrossIt is written in Englishhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P37/ibm37v01.xml0000644006511100651110000000022610504340461026212 0ustar rossross ]> It is written in English hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P38/0000755006511100651110000000000010504340461024221 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P38/out/0000755006511100651110000000000010504340461025030 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P38/out/ibm38v01.xml0000644006511100651110000000006710504340461027026 0ustar rossrossIt is written in Englishhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P38/ibm38v01.xml0000644006511100651110000000022410504340461026212 0ustar rossross ]> It is written in English hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P39/0000755006511100651110000000000010504340461024222 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P39/out/0000755006511100651110000000000010504340461025031 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P39/out/ibm39v01.xml0000644006511100651110000000024110504340461027022 0ustar rossross content of b element no more children hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P39/ibm39v01.xml0000644006511100651110000000061710504340461026222 0ustar rossross ]> content of b element no more children hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P40/0000755006511100651110000000000010504340461024212 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P40/out/0000755006511100651110000000000010504340461025021 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P40/out/ibm40v01.xml0000644006511100651110000000030610504340461027004 0ustar rossross without white space with a white space one attribute one attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P40/ibm40v01.xml0000644006511100651110000000065410504340461026203 0ustar rossross ]> without white space with a white space one attribute one attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P41/0000755006511100651110000000000010504340461024213 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P41/out/0000755006511100651110000000000010504340461025022 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P41/out/ibm41v01.xml0000644006511100651110000000013110504340461027002 0ustar rossross Name eq AttValue hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P41/ibm41v01.xml0000644006511100651110000000051510504340461026201 0ustar rossross ]> Name eq AttValue hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P42/0000755006511100651110000000000010504340461024214 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P42/out/0000755006511100651110000000000010504340461025023 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P42/out/ibm42v01.xml0000644006511100651110000000015110504340461027006 0ustar rossross : End tag with a space inside content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P42/ibm42v01.xml0000644006511100651110000000040510504340461026201 0ustar rossross ]> : End tag with a space inside content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P43/0000755006511100651110000000000010504340461024215 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P43/out/0000755006511100651110000000000010504340461025024 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P43/out/ibm43v01.xml0000644006511100651110000000070510504340461027015 0ustar rossross CharData: content of b element %paaa; : PE reference should not be recognized in element content General entity reference in element content Charater reference: A CDSect in content: <html>markups<head>HEAD</head><body>nothing</body></html> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P43/ibm43v01.xml0000644006511100651110000000135210504340461026205 0ustar rossross General entity reference in element content"> ]> CharData: content of b element %paaa; : PE reference should not be recognized in element content &inContent; Charater reference: A CDSect in content: markupsHEADnothing ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P44/0000755006511100651110000000000010504340461024216 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P44/out/0000755006511100651110000000000010504340461025025 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P44/out/ibm44v01.xml0000644006511100651110000000025410504340461027016 0ustar rossross without white space with a white space hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P44/ibm44v01.xml0000644006511100651110000000061110504340461026204 0ustar rossross ]> without white space with a white space hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P45/0000755006511100651110000000000010504340461024217 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P45/out/0000755006511100651110000000000010504340461025026 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P45/out/ibm45v01.xml0000644006511100651110000000025410504340461027020 0ustar rossross without white space with a white space hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P45/ibm45v01.xml0000644006511100651110000000105610504340461026212 0ustar rossross ]> without white space with a white space hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P47/0000755006511100651110000000000010504340461024221 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P47/out/0000755006511100651110000000000010504340461025030 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P47/out/ibm47v01.xml0000644006511100651110000000011310504340461027016 0ustar rossross content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P47/ibm47v01.xml0000644006511100651110000000147310504340461026221 0ustar rossross ]> content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P49/0000755006511100651110000000000010504340461024223 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P49/out/0000755006511100651110000000000010504340461025032 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P49/out/ibm49v01.xml0000644006511100651110000000011310504340461027022 0ustar rossross content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P49/ibm49v01.dtd0000644006511100651110000000051610504340461026175 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P49/ibm49v01.xml0000644006511100651110000000034410504340461026221 0ustar rossross ]> content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P50/0000755006511100651110000000000010504340461024213 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P50/out/0000755006511100651110000000000010504340461025022 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P50/out/ibm50v01.xml0000644006511100651110000000024610504340461027011 0ustar rossross content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P50/ibm50v01.dtd0000644006511100651110000000047310504340461026157 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P50/ibm50v01.xml0000644006511100651110000000046310504340461026203 0ustar rossross ]> content of b element hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P51/0000755006511100651110000000000010504340461024214 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P51/out/0000755006511100651110000000000010504340461025023 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P51/out/ibm51v01.xml0000644006511100651110000000031010504340461027003 0ustar rossross Element type a Element type b Element type c Element type d Element type e hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P51/out/ibm51v02.xml0000644006511100651110000000031010504340461027004 0ustar rossross Element type a Element type b Element type c Element type d Element type e hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P51/ibm51v01.xml0000644006511100651110000000113410504340461026201 0ustar rossross ]> Element type a Element type b Element type c Element type d Element type e hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P51/ibm51v02.dtd0000644006511100651110000000075710504340461026167 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P51/ibm51v02.xml0000644006511100651110000000052010504340461026200 0ustar rossross ]> Element type a Element type b Element type c Element type d Element type e hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P52/0000755006511100651110000000000010504340461024215 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P52/out/0000755006511100651110000000000010504340461025024 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P52/out/ibm52v01.xml0000644006511100651110000000020310504340461027006 0ustar rossross Element type a test P52 and P53 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P52/ibm52v01.xml0000644006511100651110000000102410504340461026201 0ustar rossross ]> Element type a test P52 and P53 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/0000755006511100651110000000000010504340461024217 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/out/0000755006511100651110000000000010504340461025026 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/out/ibm54v01.xml0000644006511100651110000000122410504340461027016 0ustar rossross ]> Element type a Element type b Element type c Element type d Element type e Element type f Element type g Element type h Element type i Element type j hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/out/ibm54v02.xml0000644006511100651110000000013410504340461027016 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/out/ibm54v03.xml0000644006511100651110000000007510504340461027023 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/ibm54v01.xml0000644006511100651110000000350110504340461026207 0ustar rossross ]> Element type a Element type b Element type c Element type d Element type e Element type f Element type g Element type h Element type i Element type j hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/ibm54v02.xml0000644006511100651110000000056010504340461026212 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/ibm54v03.xml0000644006511100651110000000033410504340461026212 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/ibmlogo.gif0000644006511100651110000000207210504340461026337 0ustar rossrossGIF87af1÷ÿÿÿÌÿÿÌÿÌÌÌÿÌÌÌ™ÌÌÿÌÿ™™Ì™™™f™Ìf™™ffÌff™fff3fÿ3fÌ3f™3ff33™33f3™3f333™f3,f1þ7H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\É¥ƒ—0cÆ(³¦MoÎ<¨¦@ {îÜ TgÁ¢‹mÉ´©S–E_ÒŒzsªÐ£Q9RµJU&W£·.}J¶¬Y5¦Å:4,X¢=I®M8÷+Îœo¯žÝË·oź<»ÞÅkéHÀ„³&lÓ¯ãÇKU(˜®×¸ˆÑz¥ÜÕòLÌ›#‹m6³Û¶3¯mœ:tHÓv%>ínhؤsë¹µ5ãÚ¶YŸ÷4ÅÞÃÛêºxjš»;âô9;úÅéw«7Dþ{òrà¶Ù ŸN´|Dî¿e·Ÿ|=tëZ½ÃŸO¿¾ýûøóë߯? ;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P54/xmltech.gif0000644006511100651110000000774610504340461026370 0ustar rossrossGIF89al2„ÿÿÿÿÌÌÌÿÿÌÌÌÌ™™ÌffÌ™™™™ff™33™ffff33f3fÿ3fÌ33Ì33™33f33™3fÿÿÿÌ33333ÿ™™!ù,l2þ %Ždižhª®lë¾0:ÍSÓÐvÞ(ymóºàO§àwÆcq¹k.ŸÐ§3jPT¯Öìukèz¿à°xL.›Ïè´zÍn»ßð¸|Ng£Í-Æïûÿ' ‚ƒƒ€)8B;UR9_O‹ZwŽ]‘TE–”QužŸ ¡¢£¤¥¦§¨g†«¬­®04³>9@6GD»NHSHLœÂÃF¶˜KX•Z\©ÍÎÏÐÑÒÓhwPB³¯ÚÛ.„ÞÚ53:5™È@”—Ö—[VXè‘ÄæòñÔõö÷øùú÷Üýþÿ‡Äù—'‘.[{)–Dɵ` ‡%d¸(Ù£JÌöiÜȱ£Ç3Ö êÙƒ‚ƒ“(þS¦„`áÊ—/!T(a&J '(Ø\áWáÆûáH&K3­˜.^H)I?JJµªU9(\îLùÀBÍ­0qŽÐº“¥‰`tƒÖ rD<Ø ¡B§Á’Lá¤Ð ½rîÚµ»J¸°áÃižN|‹­ãW> Š50î:£Y~<5çnŒ²¿›$vBLº´éÓ¤«^ÝV–ÀD )F{/1_µóà¹;"àÍÊP NÜž° ´R|Ë’lÚ˜"–Û;BgZ³/" 2Äx.¾u «¸l0˜òM¿—» ¬¸û÷ðQg}®Ö+}˜kÛÄýùZÖ%„ã.µ q.·$þ8„^xÕ¦ànLôÆ yêŸFæ­‘¡gdlè°ƒÎ;€¢ A4'@ˆÔl6Q6Öƒv ðјox fX¸žzuHaƒÇ%8Ú…†ÀD @P…‹P>@h)å–b(e”PÙe™R–ù"EŒ)å›pF & <¥•Î(P@RÂx•€ÚˆAµ84N.‹ I[<¸ùµ]Ž^äTg"2ù  HyÔð¸¦SFyMd"Ãf|@9H™C¨SzÄ—òp@”÷ð…,À¤‚t4½D[QgÝ~à‹k”Í  Q þeQx‚™! 1GægFzh©>GL0æ‚@ƒ1ê˜%:¢ÀŒ¹Þ r¥!P²[®¦º”i«\¸æ©«©…µ l ú• Ÿ&l…Z;ý'h´ˆWP³õðm_P9X l ñF2’9nŒ 0 e¼E@À2›$0À®µÊ;­ž:2A¾oðëýl* 0°ÑxæÙÎÆñe2°Vm‚³/Ì c¸àV®fV´Í"Ǩ9}‡+KUÄ8ƒ©@¦ ŒŠ@Hy© Œ)¯Ñs¶!tÝE @Q Üý Á®Bsðá [-9PÐÒ2Ë8$'ºËCÀüb2/þŽFŠ2gÙfÛö¥øFY@Uvª¹Sòºß>“ ëí2ù"4=ÇÛ±7Ã׳ۯ$ûÒ°÷AñV]IX³€ñ¡>Ü‹ ØØ~zÙ&n:oCV«öé½³§I‹[DÀ-gQuÂjoí9»óy†·›€ï¿cšãžÆ«È­`aó¡F–”T@%ËB‰ÅX#Ëu ÒÂ`o& ˆ0HBu‰KC¾Å¦¬3âBŸðRç*ø)LwkY«èÐnFSZÐ2¼Žh)XšR¼ä…%*ᩇHš0D HfP@Òø4€&¥eÊâ ‡çÃ+fñI/\þD€A)D½“™ÌVäD5j`u¾BÞŽ&'¹ê­` 9ÞÆHx­AɤøŒÒ-̤+dªRáTx·;¥°1”_ãb6³¾€3Qÿ&á…LÍŒ‹:¤D0v5~cÜ“tQ°¹ONeÜŸš3­£lÚãrG¼[ê©qEá“¿ˆ‡Å\Bò•I\DŠ^F5Ðñ™°àå…œi.mžë‹„èbÈ.j›c+Ûy H€aPÀÝxà²Z±Ž]°ÛÝ"—BÁéÎ3¤ò ³LEqŸ(ãÐŨ-Â’ÿ<‚A1K)ä’ÜëêÐIŠÉU¬tUþŽ¨€vÎ ¢U”ÑÔ’£°å)ç>D–JšÃ¬éõÁŽ'Pò¸Ç·!¡ ;$ “2H@I7›"9;ÂÎ>uhnQdáôiIyV!“‹3ܨ ôÑ#¼rŽ„¨êˆ¸LtžPB×A;õÕ*õ¨r!N¯*»â1!Jeôj@ÕMÙ°€K­§*”§w¶€KùSÜ ±[3gߢ/¹$6wyùî1’þD„Q‰ !QJŽ£V&\¼lTð›ç+pÄxæ.‡£z£à6 †ˆÂQmMuãtÙeÞbY0VkGƒ÷åÃí² =ODpÆ"ìj¶º&ke6‡’Î9(q˜±J X<Ð TIJý1G Ø r¸pMA³Ç{ûc#û6!Ä­à¨lÒ£øå&ÐN&ËNn °²¬7\d¨î‰lºg:ÛiÅã,É´åp†¯ŒÐo9àd¾ðZñ*@ GXWIœR™ˆ¦Ô SË=Ž«=âÕôY#hŒ9kœâkÚˆDÙe-½af¼éI$º{EªÙ¾mL脤Í 4"ÿí´{s7H¤šþNP‡DïwlkÛå䆵« V¸…ùYëÌDX×ü\¯)ÏÇ?d¢³ è¸?’ Qc·Ð\"kVv1A‰»op]z¤m² šAY42äóXq‡Õ$^Þ¦$D’8f}¿³'­B%+Â:n2%­£ƒrb&6zTâ&jr&­r€o€Wò$Hh&Öeœæ"Õ2^G%%‚h"'V²'_‚.vB&[†CˆS‰£…«W/Ù'EnB%hx7L´†¥”?x€h¶}îõz"=}#vÛÐÎã<$S%& ‚¦A–Aå h#5s'¶A±-o'^\‡ƒÓpªò5@!bT—¥ …þÂAûŠ2[§$3§ÆŠ "¯R–¡Š5}–q ÿ#3þŠö»H½ˆS6Ã/H@ ×)<ÔIˆÚÐ Hˆ:’XÙV j÷10ˆ9™8-˜ó…r "Š\S Ý#‰7F6œ˜oK2 ¡1¥3!踉Õ0£Â6|Ø ˜1÷ŽúÒùXhòØVŸt*Ħ3J§qØÃõB{×ÑxÔ‘{'Á&1A¾G„(#€5Õæ p1S&÷ŠÝ4¢AŽ°$àã™!Š4¸F²Žøà„3)e’f“’ÿø^=‰“ q^RO”“QBq!±QV¤.:IyPò€þЃgÍ@Xigøag€1¯á#ߘÙ“vãbæ(cåÈ=Þ¤Šq–Ó§h”B“rÉwib¬³7£u^ÐÕ6ó”ÎèqÂráP|“G¹xï àõ| á’Õr2úH”©Žsy™sifé„E·.r€Ecò—tÄm‚m—S–±‘‚fn*ˆ ?ÒmwÇ9Úxbhy’=e!–‰™º¹2›ç@F Uâ\G…AÀô"%¢©8bAfmÒ"BÔò=¡QŠNñ-Õ'TÆb ³hÔ×”»ù–"È%JO‚ȵ&pð.¤%É(”abs„G¿¢š ±m†/FþœŠ)ƒ3 -f>‰¦r¹ žº€EU24ÙGxIlzÉ €IóƒíéË鈆&˜3uS„ä<´ F@!#’2¿a^± Ý៥è¡îèú¢ïÁ-Ò·Ši@/õ'*(Ú¶×Øb?¢B¢b‚¤ãA,è#Tbá ˜ŠE%ä˜-šw. £Vê6,ùzÚb 6z£z‡¤t30¦dZ¦fz¦hš¦jº¦lÚ¦nú¦p§r:§tZ§vz§xš§zº§|Ú§~ú§€¨‚:¨kZ/†Ê„†*¦„º¨JŒú¨©’:©”Z©–z©˜ú§7“¨õÂ'À„d©¢þ:ª¤Zª¦zª¨šªªºª¬Úª®úª°«²:«´Z«¶z«¸š«ºº«¼Ú«¾ «ð© ú&aµžÅz¬Æš¬Èº¬ÊÚ¬Ìú¬Î­Ð:­Õz­Öš­Øº­ÚÚ­Üú­ÚVà:®ÞZ®äú­Ôj®êz®ëÚ®ìú®î¯ð:¯òZ¯ôz¯öš¯øº¯úÚ¯üú¯þ°ã:¬[°{°›° »° Û°û°±;±[±{±›±»±ë°Âª±²R"²QB²Á:²([²){²*Û²,û²&³++³.K³0;³8[³9{³:Û³<û³6´;+´>K´@;´H[´I{´PJÛ´Lû´FµK+µNKµP;µX[µYû³Ûµ^ûµ`¶b;¶d[¶f{¶h›¶j»¶lÛ¶nû¶p·r;·t[·v{·x›·z»·|Û·~‹±!;;F89al2„ÿÿÿÿÌÌÌÿÿÌÌÌÌ™™ÌffÌhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P55/0000755006511100651110000000000010504340461024220 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P55/out/0000755006511100651110000000000010504340461025027 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P55/out/ibm55v01.xml0000644006511100651110000000013510504340461027020 0ustar rossross Testing with a valid stringType attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P55/ibm55v01.xml0000644006511100651110000000037610504340461026220 0ustar rossross ]> Testing with a valid stringType attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/0000755006511100651110000000000010504340461024221 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/0000755006511100651110000000000010504340461025030 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v01.xml0000644006511100651110000000001510504340461027017 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v02.xml0000644006511100651110000000026710504340461027031 0ustar rossross This is a positive test for validity constraints Giving a unique name to the attribute ID an ID Attribute default as #required hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v03.xml0000644006511100651110000000022110504340461027020 0ustar rossross This is a positive test for validity constraints Giving ID attribute default as #IMPLIED hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v04.xml0000644006511100651110000000033610504340461027030 0ustar rossross This is a positive test for validity constraints the value of the attribute with a type ID does not appear more than once in the XML document hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v05.xml0000644006511100651110000000031010504340461027021 0ustar rossross This is a positive validity test for ID. any element type has no more than one attribute of type ID specified hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v06.xml0000644006511100651110000000047710504340461027040 0ustar rossross Positive test for validity constraint of IDREF. In an attribute decl, values of type IDREF match tha name production and the IDREF value matches the value assigned to an ID attribute somewhere in the XML document. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v07.xml0000644006511100651110000000055010504340461027031 0ustar rossross Positive test for validity constraint of IDREFS. In an attribute decl, values of type IDREFS match tha name production and the IDREFS value matches the values assigned to an ID attributes somewhere in the XML document. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v08.xml0000644006511100651110000000036410504340461027035 0ustar rossross ]> values of type ENTITY match the Name production and the ENTITY value matches the name of an unparsed entity declared in the DTD. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v09.xml0000644006511100651110000000022710504340461027034 0ustar rossross In an attribute declaration, values of type NMTOKEN match the Nmtoken production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/out/ibm56v10.xml0000644006511100651110000000024410504340461027023 0ustar rossross In an attribute declaration, values of type NMTOKENS match the Nmtokens production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v01.xml0000644006511100651110000000102210504340461026207 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v02.xml0000644006511100651110000000056610504340461026224 0ustar rossross ]> This is a positive test for validity constraints Giving a unique name to the attribute ID an ID Attribute default as #required hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v03.xml0000644006511100651110000000051510504340461026217 0ustar rossross ]> This is a positive test for validity constraints Giving ID attribute default as #IMPLIED hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v04.xml0000644006511100651110000000072310504340461026221 0ustar rossross ]> This is a positive test for validity constraints the value of the attribute with a type ID does not appear more than once in the XML document hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v05.xml0000644006511100651110000000070110504340461026216 0ustar rossross ]> This is a positive validity test for ID. any element type has no more than one attribute of type ID specified hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v06.xml0000644006511100651110000000107410504340461026223 0ustar rossross ]> Positive test for validity constraint of IDREF. In an attribute decl, values of type IDREF match tha name production and the IDREF value matches the value assigned to an ID attribute somewhere in the XML document. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v07.xml0000644006511100651110000000124110504340461026220 0ustar rossross ]> Positive test for validity constraint of IDREFS. In an attribute decl, values of type IDREFS match tha name production and the IDREFS value matches the values assigned to an ID attributes somewhere in the XML document. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v08.xml0000644006511100651110000000076710504340461026235 0ustar rossross ]> values of type ENTITY match the Name production and the ENTITY value matches the name of an unparsed entity declared in the DTD. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v09.xml0000644006511100651110000000055110504340461026225 0ustar rossross ]> In an attribute declaration, values of type NMTOKEN match the Nmtoken production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P56/ibm56v10.xml0000644006511100651110000000057110504340461026217 0ustar rossross ]> In an attribute declaration, values of type NMTOKENS match the Nmtokens production hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P57/0000755006511100651110000000000010504340461024222 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P57/out/0000755006511100651110000000000010504340461025031 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P57/out/ibm57v01.xml0000644006511100651110000000024210504340461027023 0ustar rossross ]> This test case tests the kinds of enumerated types hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P57/ibm57v01.xml0000644006511100651110000000056210504340461026221 0ustar rossross ]> This test case tests the kinds of enumerated types hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P58/0000755006511100651110000000000010504340461024223 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P58/out/0000755006511100651110000000000010504340461025032 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P58/out/ibm58v01.xml0000644006511100651110000000024610504340461027031 0ustar rossross ]> This is a positive test with different patterns for NOTATION hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P58/out/ibm58v02.xml0000644006511100651110000000054510504340461027034 0ustar rossross ]> The attribute values of type NOTATION matches one of the notation names included in the declaration; all notation names in the declaration have been declared hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P58/ibm58v01.xml0000644006511100651110000000115210504340461026217 0ustar rossross ]> This is a positive test with different patterns for NOTATION hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P58/ibm58v02.xml0000644006511100651110000000104410504340461026220 0ustar rossross ]> The attribute values of type NOTATION matches one of the notation names included in the declaration; all notation names in the declaration have been declared hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P59/0000755006511100651110000000000010504340461024224 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P59/out/0000755006511100651110000000000010504340461025033 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P59/out/ibm59v01.xml0000644006511100651110000000005610504340461027032 0ustar rossross This is a Positive test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P59/out/ibm59v02.xml0000644006511100651110000000025310504340461027032 0ustar rossross This is a Positive test The attribute values of type Enumeration match one of the Nmtoken tokens in the declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P59/ibm59v01.xml0000644006511100651110000000073410504340461026226 0ustar rossross ]> This is a Positive test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P59/ibm59v02.xml0000644006511100651110000000060110504340461026220 0ustar rossross ]> This is a Positive test The attribute values of type Enumeration match one of the Nmtoken tokens in the declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/0000755006511100651110000000000010504340461024214 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/out/0000755006511100651110000000000010504340461025023 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/out/ibm60v01.xml0000644006511100651110000000027010504340461027010 0ustar rossross Positive test DefaultDecl attributes values IMPLIED, REQUIRED, FIXED and default hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/out/ibm60v02.xml0000644006511100651110000000037310504340461027015 0ustar rossross Positive test. Required attribute. Every occurrence of an element with a #REQUIRED attribute default declaration gives the value of that attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/out/ibm60v03.xml0000644006511100651110000000040210504340461027007 0ustar rossross An attribute has a default value declared with the #FIXED keyword, and an instances of that attribute is given a value which is exactly the same as the default value in the declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/out/ibm60v04.xml0000644006511100651110000000020610504340461027012 0ustar rossross The default value specified for an attribute meets the lexical constraints of the declared attribute type. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/ibm60v01.xml0000644006511100651110000000106710504340461026206 0ustar rossross ]> Positive test DefaultDecl attributes values IMPLIED, REQUIRED, FIXED and default hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/ibm60v02.xml0000644006511100651110000000073510504340461026210 0ustar rossross ]> Positive test. Required attribute. Every occurrence of an element with a #REQUIRED attribute default declaration gives the value of that attribute hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/ibm60v03.xml0000644006511100651110000000066310504340461026211 0ustar rossross ]> An attribute has a default value declared with the #FIXED keyword, and an instances of that attribute is given a value which is exactly the same as the default value in the declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P60/ibm60v04.xml0000644006511100651110000000064510504340461026212 0ustar rossross ]> The default value specified for an attribute meets the lexical constraints of the declared attribute type. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P61/0000755006511100651110000000000010504340461024215 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P61/out/0000755006511100651110000000000010504340461025024 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P61/out/ibm61v01.xml0000644006511100651110000000005310504340461027011 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P61/out/ibm61v02.xml0000644006511100651110000000002110504340461027005 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P61/ibm61v01.dtd0000644006511100651110000000021310504340461026153 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P61/ibm61v01.xml0000644006511100651110000000021110504340461026176 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P61/ibm61v02.dtd0000644006511100651110000000015610504340461026162 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P61/ibm61v02.xml0000644006511100651110000000022710504340461026206 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/0000755006511100651110000000000010504340461024216 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/out/0000755006511100651110000000000010504340461025025 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/out/ibm62v01.xml0000644006511100651110000000017010504340461027013 0ustar rossross Positive test. Test includeSect with pattern1 of p62. Normal Pattern hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/out/ibm62v02.xml0000644006511100651110000000020710504340461027015 0ustar rossross Positive test. Test includeSect with pattern2 of p62. space included before INCLUDE hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/out/ibm62v03.xml0000644006511100651110000000020610504340461027015 0ustar rossross Positive test. Test includeSect with pattern3 of p62. space included after INCLUDE hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/out/ibm62v04.xml0000644006511100651110000000022110504340461027013 0ustar rossross Positive test. Test includeSect with pattern4 of p62. space included before and after INCLUDE hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/out/ibm62v05.xml0000644006511100651110000000014310504340461027017 0ustar rossross Positive test. Missing external subset declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v01.dtd0000644006511100651110000000026510504340461026164 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v01.xml0000644006511100651110000000031510504340461026205 0ustar rossross Positive test. Test includeSect with pattern1 of p62. Normal Pattern hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v02.dtd0000644006511100651110000000033010504340461026156 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v02.xml0000644006511100651110000000033610504340461026211 0ustar rossross Positive test. Test includeSect with pattern2 of p62. space included before INCLUDE hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v03.dtd0000644006511100651110000000032510504340461026163 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v03.xml0000644006511100651110000000033510504340461026211 0ustar rossross Positive test. Test includeSect with pattern3 of p62. space included after INCLUDE hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v04.dtd0000644006511100651110000000034110504340461026162 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v04.xml0000644006511100651110000000035010504340461026207 0ustar rossross Positive test. Test includeSect with pattern4 of p62. space included before and after INCLUDE hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v05.dtd0000644006511100651110000000027710504340461026173 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P62/ibm62v05.xml0000644006511100651110000000036210504340461026213 0ustar rossross ]> Positive test. Missing external subset declaration. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/0000755006511100651110000000000010504340461024217 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/out/0000755006511100651110000000000010504340461025026 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/out/ibm63v01.xml0000644006511100651110000000012310504340461027013 0ustar rossross Positive test. Test for IGNORE with pattern 1. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/out/ibm63v02.xml0000644006511100651110000000012310504340461027014 0ustar rossross Positive test. Test for IGNORE with pattern 2. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/out/ibm63v03.xml0000644006511100651110000000012310504340461027015 0ustar rossross Positive test. Test for IGNORE with pattern 3. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/out/ibm63v04.xml0000644006511100651110000000012310504340461027016 0ustar rossross Positive test. Test for IGNORE with pattern 4. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/out/ibm63v05.xml0000644006511100651110000000012310504340461027017 0ustar rossross Positive test. Test for IGNORE with pattern 5. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v01.dtd0000644006511100651110000000027310504340461026165 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v01.xml0000644006511100651110000000043010504340461026205 0ustar rossross ]> Positive test. Test for IGNORE with pattern 1. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v02.dtd0000644006511100651110000000027410504340461026167 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v02.xml0000644006511100651110000000043010504340461026206 0ustar rossross ]> Positive test. Test for IGNORE with pattern 2. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v03.dtd0000644006511100651110000000027410504340461026170 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v03.xml0000644006511100651110000000043010504340461026207 0ustar rossross ]> Positive test. Test for IGNORE with pattern 3. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v04.dtd0000644006511100651110000000035410504340461026170 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v04.xml0000644006511100651110000000043010504340461026210 0ustar rossross ]> Positive test. Test for IGNORE with pattern 4. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v05.dtd0000644006511100651110000000037310504340461026172 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P63/ibm63v05.xml0000644006511100651110000000043010504340461026211 0ustar rossross ]> Positive test. Test for IGNORE with pattern 5. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/0000755006511100651110000000000010504340461024220 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/out/0000755006511100651110000000000010504340461025027 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/out/ibm64v01.xml0000644006511100651110000000006210504340461027017 0ustar rossross Positive Test. Pattern1 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/out/ibm64v02.xml0000644006511100651110000000006210504340461027020 0ustar rossross Positive Test. Pattern2 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/out/ibm64v03.xml0000644006511100651110000000006210504340461027021 0ustar rossross Positive Test. Pattern3 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/ibm64v01.dtd0000644006511100651110000000035210504340461026165 0ustar rossross '. These must be balanced hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/ibm64v01.xml0000644006511100651110000000026110504340461026211 0ustar rossross ]> Positive Test. Pattern1 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/ibm64v02.dtd0000644006511100651110000000043210504340461026165 0ustar rossross '. These must be balanced ]]> ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/ibm64v02.xml0000644006511100651110000000026110504340461026212 0ustar rossross ]> Positive Test. Pattern2 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/ibm64v03.dtd0000644006511100651110000000060210504340461026165 0ustar rossross '. These must be balanced ]]> nesting ]]> nesting again ]]> end ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P64/ibm64v03.xml0000644006511100651110000000026110504340461026213 0ustar rossross ]> Positive Test. Pattern3 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P65/0000755006511100651110000000000010504340461024221 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P65/out/0000755006511100651110000000000010504340461025030 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P65/out/ibm65v01.xml0000644006511100651110000000010110504340461027013 0ustar rossross Positive Test. Pattern1. Empty string. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P65/out/ibm65v02.xml0000644006511100651110000000006310504340461027023 0ustar rossross Positive Test. Pattern2. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P65/ibm65v01.dtd0000644006511100651110000000025310504340461026167 0ustar rossross ]]> ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P65/ibm65v01.xml0000644006511100651110000000030010504340461026205 0ustar rossross ]> Positive Test. Pattern1. Empty string. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P65/ibm65v02.dtd0000644006511100651110000000034710504340461026174 0ustar rossross ]]> this is another string without brackets ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P65/ibm65v02.xml0000644006511100651110000000026210504340461026215 0ustar rossross ]> Positive Test. Pattern2. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P66/0000755006511100651110000000000010504340461024222 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P66/out/0000755006511100651110000000000010504340461025031 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P66/out/ibm66v01.xml0000644006511100651110000000027610504340461027032 0ustar rossross Test all valid Charater references for P66: « « à à ï ï C C _ 힣 ê°€ 豈 � ð€€ ô¿¿ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P66/ibm66v01.xml0000644006511100651110000000055310504340461026221 0ustar rossross ]> Test all valid Charater references for P66: « « Í Í ï ï C C _ 힣 가 豈 � 𐀀 􏿿 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P67/0000755006511100651110000000000010504340461024223 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P67/out/0000755006511100651110000000000010504340461025032 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P67/out/ibm67v01.xml0000644006511100651110000000005010504340461027022 0ustar rossross xyz B hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P67/ibm67v01.xml0000644006511100651110000000033210504340461026216 0ustar rossross ]> &ge1; B hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P68/0000755006511100651110000000000010504340461024224 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P68/out/0000755006511100651110000000000010504340461025033 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P68/out/ibm68v01.xml0000644006511100651110000000010110504340461027021 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P68/out/ibm68v02.xml0000644006511100651110000000004710504340461027033 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P68/ibm68v01.dtd0000644006511100651110000000012010504340461026166 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P68/ibm68v01.xml0000644006511100651110000000031710504340461026223 0ustar rossross ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P68/ibm68v02.ent0000644006511100651110000000011610504340461026207 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P68/ibm68v02.xml0000644006511100651110000000034510504340461026225 0ustar rossross %pe1; ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P69/0000755006511100651110000000000010504340461024225 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P69/out/0000755006511100651110000000000010504340461025034 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P69/out/ibm69v01.xml0000644006511100651110000000010110504340461027023 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P69/out/ibm69v02.xml0000644006511100651110000000004710504340461027035 0ustar rossross pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P69/ibm69v01.dtd0000644006511100651110000000012510504340461026175 0ustar rossross %pe1; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P69/ibm69v01.xml0000644006511100651110000000042510504340461026225 0ustar rossross "> %pe1; ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P69/ibm69v02.ent0000644006511100651110000000020310504340461026206 0ustar rossross "> %epe1; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P69/ibm69v02.xml0000644006511100651110000000034510504340461026227 0ustar rossross %pe1; ]> pcdata content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P70/0000755006511100651110000000000010504340461024215 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P70/out/0000755006511100651110000000000010504340461025024 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P70/out/ibm70v01.xml0000644006511100651110000000012510504340461027011 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P70/ibm70v01.ent0000644006511100651110000000002110504340461026163 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P70/ibm70v01.xml0000644006511100651110000000073610504340461026212 0ustar rossross '> %pe1; %pe2; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P78/0000755006511100651110000000000010504340461024225 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P78/out/0000755006511100651110000000000010504340461025034 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P78/out/ibm78v01.xml0000644006511100651110000000031610504340461027033 0ustar rossross anything legal as PCDATA.... N.B. also tested P77 and P80 anything legal as PCDATA.... N.B. also tested P77anything legal as PCDATA.... e.g. 12345678E-33, "hello"hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P78/ibm78v01.ent0000644006511100651110000000012410504340461026207 0ustar rossross anything legal as PCDATA.... N.B. also tested P77 and P80hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P78/ibm78v01.xml0000644006511100651110000000055510504340461026231 0ustar rossross ]> &epe1;&epe2;&epe3; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P78/ibm78v02.ent0000644006511100651110000000011410504340461026207 0ustar rossross anything legal as PCDATA.... N.B. also tested P77hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P78/ibm78v03.ent0000644006511100651110000000007010504340461026211 0ustar rossrossanything legal as PCDATA.... e.g. 12345678E-33, "hello"hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P79/0000755006511100651110000000000010504340461024226 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P79/out/0000755006511100651110000000000010504340461025035 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P79/out/ibm79v01.xml0000644006511100651110000000006510504340461027036 0ustar rossrossXML Handbook This is a bookhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P79/ibm79v01.ent0000644006511100651110000000007110504340461026212 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P79/ibm79v01.xml0000644006511100651110000000037210504340461026230 0ustar rossross %epe; ]> XML Handbook This is a book hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P82/0000755006511100651110000000000010504340461024220 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P82/out/0000755006511100651110000000000010504340461025027 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P82/out/ibm82v01.xml0000644006511100651110000000017210504340461027021 0ustar rossross ]> test PublicID in P82hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P82/ibm82v01.xml0000644006511100651110000000061510504340461026214 0ustar rossross ]> test PublicID in P82 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P85/0000755006511100651110000000000010504340461024223 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P85/out/0000755006511100651110000000000010504340461025032 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P85/out/ibm85v01.xml0000644006511100651110000001027610504340461027035 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P85/ibm85v01.xml0000644006511100651110000001060610504340461026223 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P86/0000755006511100651110000000000010504340461024224 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P86/out/0000755006511100651110000000000010504340461025033 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P86/out/ibm86v01.xml0000644006511100651110000000015110504340461027026 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P86/ibm86v01.xml0000644006511100651110000000045610504340461026227 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P87/0000755006511100651110000000000010504340461024225 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P87/out/0000755006511100651110000000000010504340461025034 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P87/out/ibm87v01.xml0000644006511100651110000000372110504340461027036 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P87/ibm87v01.xml0000644006511100651110000000423010504340461026223 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P88/0000755006511100651110000000000010504340461024226 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P88/out/0000755006511100651110000000000010504340461025035 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P88/out/ibm88v01.xml0000644006511100651110000000064710504340461027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P88/ibm88v01.xml0000644006511100651110000000115510504340461026230 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P89/0000755006511100651110000000000010504340461024227 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P89/out/0000755006511100651110000000000010504340461025036 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P89/out/ibm89v01.xml0000644006511100651110000000027110504340461027037 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/valid/P89/ibm89v01.xml0000644006511100651110000000057610504340461026240 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/0000755006511100651110000000000010504340461023645 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/invalid/0000755006511100651110000000000010504340457025300 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/invalid/P46/0000755006511100651110000000000010504340461025644 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/invalid/P46/ibm46i01.xml0000644006511100651110000000031310504340461027616 0ustar rossross ]> ∫ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/invalid/P46/ibm46i02.xml0000644006511100651110000000031510504340461027621 0ustar rossross ]> ∫ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/0000755006511100651110000000000010504340457025064 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/0000755006511100651110000000000010504340461025420 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n01.xml0000644006511100651110000000016710504340461027376 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n02.xml0000644006511100651110000000016710504340461027377 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n03.xml0000644006511100651110000000016710504340461027400 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n04.xml0000644006511100651110000000016710504340461027401 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n05.xml0000644006511100651110000000016710504340461027402 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n06.xml0000644006511100651110000000016710504340461027403 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n07.xml0000644006511100651110000000016710504340461027404 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n08.xml0000644006511100651110000000016710504340461027405 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n09.xml0000644006511100651110000000017110504340461027401 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n10.xml0000644006511100651110000000030010504340461027363 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n11.xml0000644006511100651110000000016610504340461027376 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n12.xml0000644006511100651110000000016610504340461027377 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n13.xml0000644006511100651110000000035510504340461027400 0ustar rossross ]> &ent; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n14.xml0000644006511100651110000000016710504340461027402 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n15.xml0000644006511100651110000000016710504340461027403 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n16.xml0000644006511100651110000000017210504340461027400 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n17.xml0000644006511100651110000000017210504340461027401 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n18.xml0000644006511100651110000000017210504340461027402 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n19.xml0000644006511100651110000000017210504340461027403 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n20.xml0000644006511100651110000000017210504340461027373 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n21.xml0000644006511100651110000000017210504340461027374 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n22.xml0000644006511100651110000000017210504340461027375 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n23.xml0000644006511100651110000000017210504340461027376 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n24.xml0000644006511100651110000000017210504340461027377 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n25.xml0000644006511100651110000000017210504340461027400 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n26.xml0000644006511100651110000000017210504340461027401 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n27.xml0000644006511100651110000000017210504340461027402 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n28.xml0000644006511100651110000000017210504340461027403 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n29.xml0000644006511100651110000000017210504340461027404 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n30.xml0000644006511100651110000000017210504340461027374 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n31.xml0000644006511100651110000000017210504340461027375 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n32.xml0000644006511100651110000000017210504340461027376 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n33.xml0000644006511100651110000000017610504340461027403 0ustar rossross €hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n34.xml0000644006511100651110000000017610504340461027404 0ustar rossross Âhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n35.xml0000644006511100651110000000017610504340461027405 0ustar rossross ‚hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n36.xml0000644006511100651110000000017610504340461027406 0ustar rossross ƒhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n37.xml0000644006511100651110000000017610504340461027407 0ustar rossross „hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n38.xml0000644006511100651110000000017410504340461027406 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n39.xml0000644006511100651110000000017410504340461027407 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n40.xml0000644006511100651110000000017610504340461027401 0ustar rossross ‡hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n41.xml0000644006511100651110000000017410504340461027400 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n42.xml0000644006511100651110000000017610504340461027403 0ustar rossross ‰hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n43.xml0000644006511100651110000000017610504340461027404 0ustar rossross Šhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n44.xml0000644006511100651110000000017610504340461027405 0ustar rossross ‹hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n45.xml0000644006511100651110000000017610504340461027406 0ustar rossross ÂŒhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n46.xml0000644006511100651110000000017610504340461027407 0ustar rossross Âhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n47.xml0000644006511100651110000000017610504340461027410 0ustar rossross ÂŽhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n48.xml0000644006511100651110000000017610504340461027411 0ustar rossross Âhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n49.xml0000644006511100651110000000017610504340461027412 0ustar rossross Âhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n50.xml0000644006511100651110000000017610504340461027402 0ustar rossross ‘hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n51.xml0000644006511100651110000000017610504340461027403 0ustar rossross Â’hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n52.xml0000644006511100651110000000017610504340461027404 0ustar rossross “hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n53.xml0000644006511100651110000000017610504340461027405 0ustar rossross ”hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n54.xml0000644006511100651110000000017610504340461027406 0ustar rossross •hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n55.xml0000644006511100651110000000017610504340461027407 0ustar rossross –hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n56.xml0000644006511100651110000000017610504340461027410 0ustar rossross —hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n57.xml0000644006511100651110000000017610504340461027411 0ustar rossross ˜hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n58.xml0000644006511100651110000000017610504340461027412 0ustar rossross Á£ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n59.xml0000644006511100651110000000017610504340461027413 0ustar rossross šhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n60.xml0000644006511100651110000000017610504340461027403 0ustar rossross ›hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n61.xml0000644006511100651110000000017610504340461027404 0ustar rossross Âœhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n62.xml0000644006511100651110000000017610504340461027405 0ustar rossross Âhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n63.xml0000644006511100651110000000017610504340461027406 0ustar rossross žhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n64.ent0000644006511100651110000000131610504340461027372 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n64.xml0000644006511100651110000000020410504340461027377 0ustar rossross ]> &e;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n65.ent0000644006511100651110000000130410504340461027370 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n65.xml0000644006511100651110000000020410504340461027400 0ustar rossross ]> &e;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n66.ent0000644006511100651110000000130610504340461027373 0ustar rossross ![CDATA[ 0x0x1: , 0x2: , 0x3: , 0x4: , 0x5: , 0x6: , 0x7: , 0x8: , 0x9: , 0xa: , 0xb: , 0xc: , 0xd: , 0xe: , 0xf: , 0x10: , 0x11: , 0x12: , 0x13: , 0x14: , 0x15: , 0x16: , 0x17: , 0x18: , 0x19: , 0x1a: , 0x1b: , 0x1c: , 0x1d: , 0x1e: , 0x1f: , 0x7f: , 0x80: €, 0x81: Â, 0x82: ‚, 0x83: ƒ, 0x84: „, 0x85: Â…, 0x86: †, 0x87: ‡, 0x88: ˆ, 0x89: ‰, 0x8a: Š, 0x8b: ‹, 0x8c: ÂŒ, 0x8d: Â, 0x8e: ÂŽ, 0x8f: Â, 0x90: Â, 0x91: ‘, 0x92: Â’, 0x93: “, 0x94: ”, 0x95: •, 0x96: –, 0x97: —, 0x98: ˜, 0x0: , 0x9a: š, 0x9b: ›, 0x9c: Âœ, 0x9d: Â, 0x9e: ž, 0x9f: Ÿ, ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n66.xml0000644006511100651110000000020410504340461027401 0ustar rossross ]> &e;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n67.xml0000644006511100651110000000020410504340461027402 0ustar rossross í €hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n68.xml0000644006511100651110000000020410504340461027403 0ustar rossross ￾hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n69.xml0000644006511100651110000000020710504340461027407 0ustar rossross ï¿¿hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n70.xml0000644006511100651110000000023310504340461027376 0ustar rossross ￾hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P02/ibm02n71.xml0000644006511100651110000000023310504340461027377 0ustar rossross ￿hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/0000755006511100651110000000000010504340461025422 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n01.xml0000644006511100651110000000026010504340461027374 0ustar rossross ]> <Ì€IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n02.xml0000644006511100651110000000026510504340461027402 0ustar rossross ]> <̳IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n03.xml0000644006511100651110000000026210504340461027400 0ustar rossross ]> <Í©IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n04.xml0000644006511100651110000000026310504340461027402 0ustar rossross ]> <;IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n05.xml0000644006511100651110000000026510504340461027405 0ustar rossross ]> < IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n06.xml0000644006511100651110000000026410504340461027405 0ustar rossross ]> <â€IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n07.xml0000644006511100651110000000026410504340461027406 0ustar rossross ]> < IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n08.xml0000644006511100651110000000026410504340461027407 0ustar rossross ]> < IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n09.xml0000644006511100651110000000026510504340461027411 0ustar rossross ]> <​IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n10.xml0000644006511100651110000000026510504340461027401 0ustar rossross ]> <‎IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n11.xml0000644006511100651110000000026610504340461027403 0ustar rossross ]> <â€IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n12.xml0000644006511100651110000000026510504340461027403 0ustar rossross ]> <â©IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n13.xml0000644006511100651110000000026510504340461027404 0ustar rossross ]> <â†IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n14.xml0000644006511100651110000000026410504340461027404 0ustar rossross ]> <â¿IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n15.xml0000644006511100651110000000026610504340461027407 0ustar rossross ]> <â IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n16.xml0000644006511100651110000000026510504340461027407 0ustar rossross ]> <⨀IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n17.xml0000644006511100651110000000027310504340461027407 0ustar rossross ]> <⬀IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n18.xml0000644006511100651110000000030410504340461027403 0ustar rossross ]> <⯿IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n19.xml0000644006511100651110000000026510504340461027412 0ustar rossross ]> <â¿¿IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n20.xml0000644006511100651110000000026510504340461027402 0ustar rossross ]> <　IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n21.xml0000644006511100651110000000026610504340461027404 0ustar rossross ]> <í €IllegalNameStartChar/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n22.xml0000644006511100651110000000026610504340461027405 0ustar rossross ]> <í IllegalNameStartChar/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n23.xml0000644006511100651110000000026610504340461027406 0ustar rossross ]> <í«¿IllegalNameStartChar/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n24.xml0000644006511100651110000000026610504340461027407 0ustar rossross ]> <í¿¿IllegalNameStartChar/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n25.xml0000644006511100651110000000026510504340461027407 0ustar rossross ]> <î¿¿IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n26.xml0000644006511100651110000000026510504340461027410 0ustar rossross ]> <IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n27.xml0000644006511100651110000000026510504340461027411 0ustar rossross ]> <IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04/ibm04n28.xml0000644006511100651110000000026610504340461027413 0ustar rossross ]> <ï¿¿IllegalNameStartChar/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/0000755006511100651110000000000010504340461025563 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an01.xml0000644006511100651110000000023410504340461027677 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an02.xml0000644006511100651110000000023510504340461027701 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an03.xml0000644006511100651110000000023710504340461027704 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an04.xml0000644006511100651110000000023510504340461027703 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an05.xml0000644006511100651110000000024110504340461027701 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an06.xml0000644006511100651110000000024110504340461027702 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an07.xml0000644006511100651110000000024110504340461027703 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an08.xml0000644006511100651110000000024110504340461027704 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an09.xml0000644006511100651110000000024110504340461027705 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an10.xml0000644006511100651110000000024110504340461027675 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an11.xml0000644006511100651110000000024610504340461027703 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an12.xml0000644006511100651110000000024610504340461027704 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an13.xml0000644006511100651110000000024110504340461027700 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an14.xml0000644006511100651110000000024110504340461027701 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an15.xml0000644006511100651110000000024110504340461027702 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an16.xml0000644006511100651110000000024110504340461027703 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an17.xml0000644006511100651110000000024210504340461027705 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an18.xml0000644006511100651110000000024210504340461027706 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an19.xml0000644006511100651110000000024110504340461027706 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an20.xml0000644006511100651110000000024210504340461027677 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an21.xml0000644006511100651110000000024210504340461027700 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an22.xml0000644006511100651110000000024210504340461027701 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an23.xml0000644006511100651110000000024210504340461027702 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an24.xml0000644006511100651110000000024210504340461027703 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an25.xml0000644006511100651110000000024110504340461027703 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an26.xml0000644006511100651110000000024110504340461027704 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an27.xml0000644006511100651110000000024110504340461027705 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P04a/ibm04an28.xml0000644006511100651110000000024210504340461027707 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P05/0000755006511100651110000000000010504340461025423 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P05/ibm05n01.xml0000644006511100651110000000025410504340461027401 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P05/ibm05n02.xml0000644006511100651110000000026010504340461027377 0ustar rossross ]> <Ì€BadName/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P05/ibm05n03.xml0000644006511100651110000000025710504340461027406 0ustar rossross ]> <ͯBadName/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P05/ibm05n04.xml0000644006511100651110000000026210504340461027403 0ustar rossross ]> <‿BadName/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P05/ibm05n05.xml0000644006511100651110000000026210504340461027404 0ustar rossross ]> <â€BadName/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P05/ibm05n06.xml0000644006511100651110000000025610504340461027410 0ustar rossross ]> <·BadName/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/0000755006511100651110000000000010504340461025434 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n01.dtd0000644006511100651110000000015610504340461027377 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n01.xml0000644006511100651110000000013310504340461027417 0ustar rossross &root_content; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n02.dtd0000644006511100651110000000016110504340461027374 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n02.xml0000644006511100651110000000012410504340461027420 0ustar rossross Content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n03.dtd0000644006511100651110000000013310504340461027374 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n03.xml0000644006511100651110000000012410504340461027421 0ustar rossross Content hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n04.ent0000644006511100651110000000005210504340461027410 0ustar rossross ‰hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n04.xml0000644006511100651110000000017110504340461027424 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n05.ent0000644006511100651110000000005210504340461027411 0ustar rossross ”hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n05.xml0000644006511100651110000000017110504340461027425 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n06.ent0000644006511100651110000000005210504340461027412 0ustar rossross Ÿhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n06.xml0000644006511100651110000000017110504340461027426 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n07.dtd0000644006511100651110000000010610504340461027400 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n07.xml0000644006511100651110000000013310504340461027425 0ustar rossross &root_content; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n08.dtd0000644006511100651110000000014110504340461027400 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n08.xml0000644006511100651110000000013710504340461027432 0ustar rossross &root_content; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n09.dtd0000644006511100651110000000006210504340461027403 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n09.xml0000644006511100651110000000013710504340461027433 0ustar rossross &root_content; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n10.ent0000644006511100651110000000003410504340461027405 0ustar rossross „hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n10.xml0000644006511100651110000000017110504340461027421 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n11.ent0000644006511100651110000000000210504340461027401 0ustar rossrossˆhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n11.xml0000644006511100651110000000017110504340461027422 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n12.ent0000644006511100651110000000000210504340461027402 0ustar rossrossÂŽhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n12.xml0000644006511100651110000000017110504340461027423 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n13.dtd0000644006511100651110000000016310504340461027400 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n13.ent0000644006511100651110000000010710504340461027411 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n13.xml0000644006511100651110000000012010504340461027416 0ustar rossross &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n14.dtd0000644006511100651110000000015010504340461027375 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n14.xml0000644006511100651110000000011710504340461027425 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n15.dtd0000644006511100651110000000014510504340461027402 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n15.ent0000644006511100651110000000007510504340461027417 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n15.xml0000644006511100651110000000012010504340461027420 0ustar rossross &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n16.ent0000644006511100651110000000006110504340461027413 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n16.xml0000644006511100651110000000021610504340461027427 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n17.ent0000644006511100651110000000005310504340461027415 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n17.xml0000644006511100651110000000016710504340461027435 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n18.ent0000644006511100651110000000010110504340461027410 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n18.xml0000644006511100651110000000021610504340461027431 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n19.dtd0000644006511100651110000000014010504340461027401 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n19.ent0000644006511100651110000000001510504340461027415 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n19.xml0000644006511100651110000000014110504340461027427 0ustar rossross &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n20.dtd0000644006511100651110000000021010504340461027367 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n20.ent0000644006511100651110000000006510504340461027412 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n20.xml0000644006511100651110000000013710504340461027424 0ustar rossross &e;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n21.dtd0000644006511100651110000000012210504340461027372 0ustar rossross %e; ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n21.ent0000644006511100651110000000006510504340461027413 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/not-wf/P77/ibm77n21.xml0000644006511100651110000000013610504340461027424 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/0000755006511100651110000000000010504340457024751 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P02/0000755006511100651110000000000010504340461025305 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P02/ibm02v01.xml0000644006511100651110000000153010504340461027266 0ustar rossross ]> x9 : xA : xD : x20 to x7E : ! " # $ % ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ ` a b c d e f g h i j k l m n o p q r s t u v w x y z { | } ~ x85 : Â… x2028 : 
 xA0-xD7FF :   Å€ Ê€ Ô€ ਀ ဠ⠀ 倀 ꀀ xE000-xFFFD : î€î€î€­îƒ°î„‘ïŠï¾ï¿¼ï¿½ x10000-x10FFFF : က0က1á€1ကFဂ7á€1á‚1á‚«1á¼€1á“°5á«°5ᬀ0᳿7á·²9ỿ1á€A0á€08á€ABဟ08ီCDáŠAAá–78á‚«CDჿ05ჿFAჿFF hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P02/ibm02v02.xml0000644006511100651110000000126310504340461027272 0ustar rossross ]>     pwrstuvwxy  €ˆ‚ƒ„…†‡ˆ‰ Š‹ŒŽ ™’“”•–—˜™ š›œžŸ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P02/ibm02v03.xml0000644006511100651110000000122010504340461027264 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P02/ibm02v04.xml0000644006511100651110000000051310504340461027271 0ustar rossross ]> &data; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P02/ibm02v05.xml0000644006511100651110000000127010504340461027273 0ustar rossross ]> Test all valid new Charater references for P66:     €   Ÿ ~ …  ሴ퟿ ﻰ� 𐀀񟻜􏿿 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P02/ibm02v06.ent0000644006511100651110000000607110504340461027266 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P02/ibm02v06.xml0000644006511100651110000000020010504340461027264 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/0000755006511100651110000000000010504340461025306 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/out/0000755006511100651110000000000010504340457026122 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v01.ent0000644006511100651110000000000710504340461027254 0ustar rossrossData Â…hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v01.xml0000644006511100651110000000017110504340461027270 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v02.ent0000644006511100651110000000000610504340461027254 0ustar rossrossDataÂ…hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v02.xml0000644006511100651110000000017110504340461027271 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v03.ent0000644006511100651110000000000310504340461027252 0ustar rossross Â…hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v03.xml0000644006511100651110000000017110504340461027272 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v04.ent0000644006511100651110000000000210504340461027252 0ustar rossrossÂ…hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v04.xml0000644006511100651110000000017110504340461027273 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v05.xml0000644006511100651110000000021210504340461027270 0ustar rossross ]> x&e;yhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v06.xml0000644006511100651110000000021110504340461027270 0ustar rossross ]> x&e;yhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v07.xml0000644006511100651110000000021210504340461027272 0ustar rossross ]> x&e;yhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v08.xml0000644006511100651110000000016510504340461027302 0ustar rossross ]> Test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v09.ent0000644006511100651110000000003110504340461027261 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P03/ibm03v09.xml0000644006511100651110000000023110504340461027275 0ustar rossross ]> Testhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P04/0000755006511100651110000000000010504340461025307 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P04/ibm04v01.xml0000644006511100651110000000434210504340461027276 0ustar rossross ]> <:LegalNameStartChar/> <ÀLegalNameStartChar/> <ÃLegalNameStartChar/> <˾LegalNameStartChar/> <Ë¿LegalNameStartChar/> <Í°LegalNameStartChar/> <ͱLegalNameStartChar/> <ͼLegalNameStartChar/> <ͽLegalNameStartChar/> <Í¿LegalNameStartChar/> <΀LegalNameStartChar/> <῾LegalNameStartChar/> <á¿¿LegalNameStartChar/> <‌LegalNameStartChar/> <â€LegalNameStartChar/> <â°LegalNameStartChar/> <â±LegalNameStartChar/> <↎LegalNameStartChar/> <â†LegalNameStartChar/> <â°€LegalNameStartChar/> <â°LegalNameStartChar/> <â¿®LegalNameStartChar/> <⿯LegalNameStartChar/> <ã€LegalNameStartChar/> <。LegalNameStartChar/> <퟾LegalNameStartChar/> <퟿LegalNameStartChar/> <豈LegalNameStartChar/> <ï¤LegalNameStartChar/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P04a/0000755006511100651110000000000010504340461025450 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P04a/ibm04av01.xml0000644006511100651110000000536110504340461027602 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P05/0000755006511100651110000000000010504340461025310 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P05/ibm05v01.xml0000644006511100651110000000561210504340461027301 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P05/ibm05v02.xml0000644006511100651110000000431210504340461027276 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P05/ibm05v03.xml0000644006511100651110000001001710504340461027276 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P05/ibm05v04.xml0000644006511100651110000001716210504340461027307 0ustar rossross ]> attr0=":" attr00=":" attr1="À" attr10="À" attr2="Ã" attr20="Ã" attr3="˾" attr30="˾" attr4="Â" attr40="Â" attr5="Ã" attr50="Ã" attr6="˽" attr60="˽" attr7="Ë¿" attr70="Ë¿" attr8="Í°" attr80="Í°" attr9="ͱ" attr90="ͱ" attr10="ͼͽ" attr100="ͼͽ" attr11="ͽͿ" attr110="ͽͿ" attr12="Ϳ΀" attr120="Ϳ΀" attr13="΀῾" attr130="΀῾" attr14="῾῿" attr140="῾῿" attr15="῿‌" attr150="῿‌" attr16="‌â€" attr160="‌â€" attr17="â€â°" attr170="â€â°" attr18="â°â±" attr180="â°â±" attr19="â±â†Ž" attr190="â±â†Ž" attr20="↎â†â°€" attr200="↎â†â°€" attr21="â†â°€â°" attr210="â†â°€â°" attr22="â°€â°â¿®" attr220="â°€â°â¿®" attr23="â°â¿®â¿¯" attr230="â°â¿®â¿¯" attr24="⿮⿯ã€" attr240="⿮⿯ã€" attr25="⿯ã€ã€‚" attr250="⿯ã€ã€‚" attr26="ã€ã€‚퟾" attr260="ã€ã€‚퟾" attr27="。퟾퟿" attr270="。퟾퟿" attr28="퟾퟿豈" attr280="퟾퟿豈" attr29="퟿豈ï¤" attr290="퟿豈ï¤" attr30="豈퟿퟾。" attr300="豈퟿퟾。" attr31="ï¤ï¤€íŸ¿íŸ¾" attr310="ï¤ï¤€íŸ¿íŸ¾" attr32="�ï¤ï¤€íŸ¿" attr320="�ï¤ï¤€íŸ¿" attr33="-�ï¤ï¤€" attr330="-�ï¤ï¤€" attr34=".-�ï¤" attr340=".-�ï¤" attr35="A.-�" attr350="A.-�" attr36="zA.-" attr360="zA.-" attr37="0zA." attr370="0zA." attr38="·0zA" attr380="·0zA" attr39="̀·0z" attr390="̀·0z" attr40="Ì̀·0" attr400="Ì̀·0" attr41="Í®Ì̀·" attr410="Í®Ì̀·" attr42="ͯͮÌÌ€" attr420="ͯͮÌÌ€" attr43="‿ͯͮÌ" attr430="‿ͯͮÌ" attr44="â€â€¿Í¯Í®" attr440="â€â€¿Í¯Í®" attr45="nullâ€â€¿Í¯" attr450="nullâ€â€¿Í¯" attr46="nullnullâ€â€¿" attr460="nullnullâ€â€¿" attr47="nullnullnullâ€" attr470="nullnullnullâ€" hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P05/ibm05v05.xml0000644006511100651110000001407210504340461027305 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P07/0000755006511100651110000000000010504340461025312 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P07/ibm07v01.xml0000644006511100651110000000570110504340461027304 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/0000755006511100651110000000000010504340461025321 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v01.dtd0000644006511100651110000000014410504340461027271 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v01.xml0000644006511100651110000000012610504340461027316 0ustar rossross <Ànode/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v02.dtd0000644006511100651110000000015010504340461027267 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v02.xml0000644006511100651110000000013410504340461027316 0ustar rossross <á¿¿node/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v03.dtd0000644006511100651110000000015010504340461027270 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v03.xml0000644006511100651110000000013410504340461027317 0ustar rossross <ï¤node/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v04.ent0000644006511100651110000000010310504340461027302 0ustar rossross <Önode/><Önode/><Önode/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v04.xml0000644006511100651110000000021310504340461027316 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v05.ent0000644006511100651110000000010610504340461027306 0ustar rossross <á¿¿node/><á¿¿node/><á¿¿node/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v05.xml0000644006511100651110000000022410504340461027321 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v06.ent0000644006511100651110000000010610504340461027307 0ustar rossross <ï¤root/><ï¤root/><ï¤root/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v06.xml0000644006511100651110000000022410504340461027322 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v07.dtd0000644006511100651110000000014410504340461027277 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v07.xml0000644006511100651110000000012610504340461027324 0ustar rossross <Ønode/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v08.dtd0000644006511100651110000000015010504340461027275 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v08.xml0000644006511100651110000000013410504340461027324 0ustar rossross <á¿¿node/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v09.dtd0000644006511100651110000000015010504340461027276 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v09.xml0000644006511100651110000000013410504340461027325 0ustar rossross <ï¤node/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v10.ent0000644006511100651110000000010310504340461027277 0ustar rossross <öroot/><öroot/><öroot/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v10.xml0000644006511100651110000000021310504340461027313 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v11.ent0000644006511100651110000000010610504340461027303 0ustar rossross <á¿¿root/><á¿¿root/><á¿¿root/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v11.xml0000644006511100651110000000022410504340461027316 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v12.ent0000644006511100651110000000010610504340461027304 0ustar rossross <ï¤root/><ï¤root/><ï¤root/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v12.xml0000644006511100651110000000022410504340461027317 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v13.dtd0000644006511100651110000000007510504340461027277 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v13.xml0000644006511100651110000000012610504340461027321 0ustar rossross <ønode/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v14.dtd0000644006511100651110000000010010504340461027265 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v14.xml0000644006511100651110000000013410504340461027321 0ustar rossross <á¿¿node/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v15.dtd0000644006511100651110000000010010504340461027266 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v15.xml0000644006511100651110000000013410504340461027322 0ustar rossross <ï¤node/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v16.ent0000644006511100651110000000003410504340461027310 0ustar rossross<Ë¿root/><Ë¿root/><Ë¿root/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v16.xml0000644006511100651110000000021310504340461027321 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v17.ent0000644006511100651110000000003610504340461027313 0ustar rossross<á¿¿root/><á¿¿root/><á¿¿root/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v17.xml0000644006511100651110000000022410504340461027324 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v18.ent0000644006511100651110000000003610504340461027314 0ustar rossross<ï¤root/><ï¤root/><ï¤root/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v18.xml0000644006511100651110000000022410504340461027325 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v19.dtd0000644006511100651110000000016510504340461027305 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v19.xml0000644006511100651110000000012110504340461027322 0ustar rossross Test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v20.dtd0000644006511100651110000000016710504340461027277 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v20.xml0000644006511100651110000000012110504340461027312 0ustar rossross Test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v21.dtd0000644006511100651110000000016710504340461027300 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v21.xml0000644006511100651110000000012110504340461027313 0ustar rossross Test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v22.ent0000644006511100651110000000006010504340461027304 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v22.xml0000644006511100651110000000017110504340461027321 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v23.ent0000644006511100651110000000006010504340461027305 0ustar rossross €hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v23.xml0000644006511100651110000000017110504340461027322 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v24.ent0000644006511100651110000000006010504340461027306 0ustar rossross Ÿhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v24.xml0000644006511100651110000000017110504340461027323 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v25.dtd0000644006511100651110000000011410504340461027274 0ustar rossross ">hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v25.xml0000644006511100651110000000012110504340461027317 0ustar rossross Test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v26.dtd0000644006511100651110000000013010504340461027273 0ustar rossross ">hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v26.xml0000644006511100651110000000012110504340461027320 0ustar rossross Test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v27.dtd0000644006511100651110000000013610504340461027302 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v27.xml0000644006511100651110000000012110504340461027321 0ustar rossross Test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v28.ent0000644006511100651110000000003010504340461027307 0ustar rossrossŸ€hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v28.xml0000644006511100651110000000017110504340461027327 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v29.ent0000644006511100651110000000002010504340461027307 0ustar rossross…hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v29.xml0000644006511100651110000000017110504340461027330 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v30.ent0000644006511100651110000000005210504340461027304 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/valid/P77/ibm77v30.xml0000644006511100651110000000017110504340461027320 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/ibm_invalid.xml0000644006511100651110000000306710504340461026652 0ustar rossross An element with Element-Only content contains the character #x85 (NEL not a whitespace character as defined by S). An element with Element-Only content contains the character #x2028 (LESP not a whitespace character as defined by S). hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/ibm_not-wf.xml0000644006511100651110000012304410504340461026434 0ustar rossross This test contains embeded control character 0x1. This test contains embeded control character 0x2. This test contains embeded control character 0x3. This test contains embeded control character 0x4. This test contains embeded control character 0x5. This test contains embeded control character 0x6. This test contains embeded control character 0x7. This test contains embeded control character 0x8. This test contains embeded control character 0x0. This test contains embeded control character 0x100. This test contains embeded control character 0x0B. This test contains embeded control character 0x0C. This test contains embeded control character 0x0E. This test contains embeded control character 0x0F. This test contains embeded control character 0x10. This test contains embeded control character 0x11. This test contains embeded control character 0x12. This test contains embeded control character 0x13. This test contains embeded control character 0x14. This test contains embeded control character 0x15. This test contains embeded control character 0x16. This test contains embeded control character 0x17. This test contains embeded control character 0x18. This test contains embeded control character 0x19. This test contains embeded control character 0x1A. This test contains embeded control character 0x1B. This test contains embeded control character 0x1C. This test contains embeded control character 0x1D. This test contains embeded control character 0x1E. This test contains embeded control character 0x1F. This test contains embeded control character 0x7F. This test contains embeded control character 0x80. This test contains embeded control character 0x81. This test contains embeded control character 0x82. This test contains embeded control character 0x83. This test contains embeded control character 0x84. This test contains embeded control characters x82, x83 and x84. This test contains embeded control character 0x86. This test contains embeded control character 0x87. This test contains embeded control character 0x88. This test contains embeded control character 0x89. This test contains embeded control character 0x8A. This test contains embeded control character 0x8B. This test contains embeded control character 0x8C. This test contains embeded control character 0x8D. This test contains embeded control character 0x8E. This test contains embeded control character 0x8F. This test contains embeded control character 0x90. This test contains embeded control character 0x91. This test contains embeded control character 0x92. This test contains embeded control character 0x93. This test contains embeded control character 0x94. This test contains embeded control character 0x95. This test contains embeded control character 0x96. This test contains embeded control character 0x97. This test contains embeded control character 0x98. This test contains embeded control character 0x99. This test contains embeded control character 0x9A. This test contains embeded control character 0x9B. This test contains embeded control character 0x9C. This test contains embeded control character 0x9D. This test contains embeded control character 0x9E. This test contains embeded control characters present in an external entity. This test contains embeded control characters present in an external entity. This test contains embeded control characters present in an external entity. This test contains embeded character 0xD800. (Invalid UTF8 sequence) This test contains embeded character 0xFFFE. This test contains embeded character 0xFFFF. This test contains a reference to character 0xFFFE. This test contains a reference to character 0xFFFF. Tests an element with an illegal NameStartChar: #x300 Tests an element with an illegal NameStartChar: #0x333 Tests an element with an illegal NameStartChar: #0x369 Tests an element with an illegal NameStartChar: #0x37E Tests an element with an illegal NameStartChar: #0x2000 Tests an element with an illegal NameStartChar: #0x2001 Tests an element with an illegal NameStartChar: #0x2002 Tests an element with an illegal NameStartChar: #0x2005 Tests an element with an illegal NameStartChar: #0x200B Tests an element with an illegal NameStartChar: #0x200E Tests an element with an illegal NameStartChar: #0x200F Tests an element with an illegal NameStartChar: #0x2069 Tests an element with an illegal NameStartChar: #0x2190 Tests an element with an illegal NameStartChar: #0x23FF Tests an element with an illegal NameStartChar: #0x280F Tests an element with an illegal NameStartChar: #0x2A00 Tests an element with an illegal NameStartChar: #0x2EDC Tests an element with an illegal NameStartChar: #0x2B00 Tests an element with an illegal NameStartChar: #0x2BFF Tests an element with an illegal NameStartChar: #0x3000 Tests an element with an illegal NameStartChar: #0xD800 Tests an element with an illegal NameStartChar: #0xD801 Tests an element with an illegal NameStartChar: #0xDAFF Tests an element with an illegal NameStartChar: #0xDFFF Tests an element with an illegal NameStartChar: #0xEFFF Tests an element with an illegal NameStartChar: #0xF1FF Tests an element with an illegal NameStartChar: #0xF8FF Tests an element with an illegal NameStartChar: #0xFFFFF Tests an element with an illegal NameChar: #xB8 Tests an element with an illegal NameChar: #0xA1 Tests an element with an illegal NameChar: #0xAF Tests an element with an illegal NameChar: #0x37E Tests an element with an illegal NameChar: #0x2000 Tests an element with an illegal NameChar: #0x2001 Tests an element with an illegal NameChar: #0x2002 Tests an element with an illegal NameChar: #0x2005 Tests an element with an illegal NameChar: #0x200B Tests an element with an illegal NameChar: #0x200E Tests an element with an illegal NameChar: #0x2038 Tests an element with an illegal NameChar: #0x2041 Tests an element with an illegal NameChar: #0x2190 Tests an element with an illegal NameChar: #0x23FF Tests an element with an illegal NameChar: #0x280F Tests an element with an illegal NameChar: #0x2A00 Tests an element with an illegal NameChar: #0xFDD0 Tests an element with an illegal NameChar: #0xFDEF Tests an element with an illegal NameChar: #0x2FFF Tests an element with an illegal NameChar: #0x3000 Tests an element with an illegal NameChar: #0xD800 Tests an element with an illegal NameChar: #0xD801 Tests an element with an illegal NameChar: #0xDAFF Tests an element with an illegal NameChar: #0xDFFF Tests an element with an illegal NameChar: #0xEFFF Tests an element with an illegal NameChar: #0xF1FF Tests an element with an illegal NameChar: #0xF8FF Tests an element with an illegal NameChar: #0xFFFFF Tests an element with an illegal Name containing #0x0B Tests an element with an illegal Name containing #0x300 Tests an element with an illegal Name containing #0x36F Tests an element with an illegal Name containing #0x203F Tests an element with an illegal Name containing #x2040 Tests an element with an illegal Name containing #0xB7 The VersionNum of the document entity is 1.1 and that of the external dtd 1.0. The external dtd contains the invalid XML1.1 but valid XML 1.0 character #x7F. The VersionNum of the document entity is 1.1 and that of the external dtd 1.0. The external dtd contains a comment with the invalid XML1.1 but valid XML 1.0 character #x80. The VersionNum of the document entity is 1.1 and that of the external dtd 1.0. The external dtd contains a PI with the invalid XML1.1 but valid XML 1.0 character #x9F. The VersionNum of the document entity is 1.1 and that of the external entity 1.0. The external entity the contains invalid XML1.1 but valid XML 1.0 character #x89. The VersionNum of the document entity is 1.1 and that of the external entity 1.0. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x94. The VersionNum of the document entity is 1.1 and that of the external entity 1.0. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x9F. The VersionNum of the document entity is 1.1 and the external dtd does not contain a textDecl. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x7F. The VersionNum of the document entity is 1.1 and the external dtd does not contain a VersionNum in the textDecl. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x9B. The VersionNum of the document entity is 1.1 and the external dtd does not contain a textDecl. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x8D. The VersionNum of the document entity is 1.1 and the external dtd does not contain a VersionNum in the textDecl. The external entity contains the invalid XML 1.1 but valid XML 1.0 character #x84. The VersionNum of the document entity is 1.1 and the external dtd does not contain a textDecl. The external entity contains the invalid XML 1.1 but valid XML 1.0 character #x88. The VersionNum of the document entity is 1.1 and the external dtd does not contain a textDecl. The external entity contains the invalid XML 1.1 but valid XML 1.0 character #x8E. The VersionNum of the primary document entity is 1.0 and that of the external dtd is 1.0. The external dtd contains an external entity whose VersionNum is 1.1. The VersionNum of the primary document entity is 1.1 and that of the external dtd is 1.0. The external dtd contains an element declaration with an invalid XML 1.1 and 1.0 name. The VersionNum of the primary document entity is 1.1 and testDecl of the external dtd is absent. The external dtd contains an external entity whose VersionNum is 1.1 containing a valid XML1.0 but an invalid XML 1.1 character #x7F. The VersionNum of the primary document entity is 1.0 and VersioNum of the external entity is absent. The replacement text of the entity contains an element followed by the valid XML 1.1 of line character NEL #x85 in its empty elem tag. The VersionNum of the primary document entity is absent and that of the external entity is 1.0. The textDecl in the external entity contains an invalid XML1.0 but valid XML 1.1 enf of line character NEL #x85. The VersionNum of the primary document entity is absent and that of the external entity is 1.0. The textDecl in the external entity contains an invalid XML1.0 but valid XML 1.1 of line character Unicode line separator #x2028. The VersionNum of the primary document entity is 1.1 and that of the external dtd is absent. The external dtd contains an external entity whose VersionNum is absent and it contains a valid XML 1.0 but an invalid XML 1.1 character #x94. The VersionNum of the primary document entity is 1.1 and that of the external dtd is 1.1. The external dtd contains an external entity whose VersionNum is absent and it contains a valid XML 1.0 but an invalid XML 1.1 character #x8F. The VersionNum of the primary document entity is 1.1 and the texlDecl of the external dtd is absent. The external dtd contains a reference to an external parameter entity whose VersionNum is absent from the textDecl and it contains an invalid XML 1.1 character #x8F. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/xml-1.1/ibm_valid.xml0000644006511100651110000004754110504340461026330 0ustar rossross This test case covers legal character ranges plus discrete legal characters for production 02 of the XML1.1 sepcification. This test case covers control characters x1 to x1F and x7F to x9F which should only appear as character references. This test case covers control characters x1 to x1F and x7F to x9F which appear as character references as an entity's replacement text. This test case contains embeded whitespace characters some form the range 1 - 1F. This test case contains valid char references that match the char production. This test case contains valid char references in the CDATA section, comment and processing instruction of an external entity that match the char production. The two character sequence #x0D #x85 in an external entity must be normalized to a single newline. The single character sequence #x85 in an external entity must be normalized to a single newline. The two character sequence #x0D #x85 in an external entity must be normalized to a single newline. The single character sequence #x85 in an external entity must be normalized to a single newline. The two character sequence #x0D #x85 in a document entity must be normalized to a single newline. The single character sequence #x85 in a document entity must be normalized to a single newline. The single character sequence #x2028 in a document entity must be normalized to a single newline. The single character sequence #x85 in the XMLDecl must be normalized to a single newline. The single character sequence #x2028 in the XMLDecl must be normalized to a single newline. (This test is questionable) This test case covers legal NameStartChars character ranges plus discrete legal characters for production 04. This test case covers legal NameChars character ranges plus discrete legal characters for production 04a. This test case covers legal Element Names as per production 5. This test case covers legal PITarget (Names) as per production 5. This test case covers legal Attribute (Names) as per production 5. This test case covers legal ID/IDREF (Names) as per production 5. This test case covers legal ENTITY (Names) as per production 5. This test case covers legal NMTOKEN Name character ranges plus discrete legal characters for production 7. The VersionNum of the document entity is 1.1 whereas the VersionNum of the external DTD is 1.0. The character #xC0 which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents. The VersionNum of the document entity is 1.1 whereas the VersionNum of the external DTD is 1.0. The character #x1FFF which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents. The VersionNum of the document entity is 1.1 whereas the VersionNum of the external DTD is 1.0. The character #xF901 which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents. The VersionNum of the document entity is 1.1 whereas the VersionNum of the external entity is 1.0. The character #xD6 which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents. The VersionNum of the document entity is 1.1 whereas the VersionNum of the external entity is 1.0. The character #x1FFF which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents. The VersionNum of the document entity is 1.1 whereas the VersionNum of the external entity is 1.0. The character #xF901 which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents. The VersionNum of the document and external dtd is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #xD8. The VersionNum of the document and external dtd is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #x1FFF. The VersionNum of the document and external dtd is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #xF901. The VersionNum of the document and external entity is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #xF6. The VersionNum of the document and external entity is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #x1FFF. The VersionNum of the document and external entity is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #xF901. The VersionNum of the document entity is 1.1 but the external dtd does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #xF8. The VersionNum of the document entity is 1.1 but the external dtd does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #x1FFF. The VersionNum of the document entity is 1.1 but the external dtd does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #xF901. The VersionNum of the document entity is 1.1 but the external entity does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #x2FF. The VersionNum of the document entity is 1.1 but the external entity does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #x1FFF. The VersionNum of the document entity is 1.1 but the external entity does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #xF901. The VersionNum of the document and external dtd is 1.1. The replacement text of an entity declared in the external DTD contains a reference to the character #x7F. This entity is not referenced in the document entity. The VersionNum of the document and external dtd is 1.1. The replacement text of an entity declared in the external DTD contains a reference to the character #x80. This entity is not referenced in the document entity. The VersionNum of the document and external dtd is 1.1. The replacement text of an entity declared in the external DTD contains a reference to the character #x9F. This entity is not referenced in the document entity. The VersionNum of the document and the external entity is 1.1. The entity contains a reference to the character #x7F. The VersionNum of the document and the external entity is 1.1. The entity contains a reference to the character #x80. The VersionNum of the document and the external entity is 1.1. The entity contains a reference to the character #x9F. The VersionNum of the document is 1.1 and the textDecl is missing in the external DTD. The replacement text of an entity declared in the external DTD contains a reference to the character #x7F, #x8F. This entity is not referenced in the document entity. The VersionNum of the document is 1.1 and the textDecl is missing in the external DTD. The replacement text of an entity declared in the external DTD contains a reference to the character #x80, #x90. This entity is not referenced in the document entity. The VersionNum of the document is 1.1 and the textDecl is missing in the external DTD. The replacement text of an entity declared in the external DTD contains a reference to the character #x81, #x9F. This entity is not referenced in the document entity. The VersionNum of the document is 1.1 and the textDecl is missing in the external entity. The replacement text of an entity declared in the external DTD contains a reference to the character #x7F, #x80, #x9F. The VersionNum of the document is 1.1 and the textDecl is missing in the external entity. The replacement text of an entity declared in the external DTD contains a reference to the character #x85, #x8F. The VersionNum of the document is 1.1 and the textDecl is missing in the external entity. The replacement text of an entity declared in the external DTD contains a reference to the character #x1, #x7F. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/ibm_oasis_invalid.xml0000644006511100651110000004456510504340457026770 0ustar rossross The test violates VC:Root Element Type in P28. The Name in the document type declaration does not match the element type of the root element. This test violates VC: Standalone Document Declaration in P32. The standalone document declaration has the value yes, BUT there is an external markup declaration of attributes with default values, and the associated element appears in the document with specified values for those attributes. This test violates VC: Standalone Document Declaration in P32. The standalone document declaration has the value yes, BUT there is an external markup declaration of attributes with values that will change if normalized. This test violates VC: Standalone Document Declaration in P32. The standalone document declaration has the value yes, BUT there is an external markup declaration of element with element content, and white space occurs directly within the mixed content. This test violates VC: Element Valid in P39. Element a is declared empty in DTD, but has content in the document. This test violates VC: Element Valid in P39. root is declared only having element children in DTD, but have text content in the document. This test violates VC: Element Valid in P39. Illegal elements are inserted in b's content of Mixed type. This test violates VC: Element Valid in P39. Element c has undeclared element as its content of ANY type This test violates VC: Attribute Value Type in P41. attr1 for Element b is not declared. This test violates VC: Attribute Value Type in P41. attr3 for Element b is given a value that does not match the declaration in the DTD. This test violates VC: Unique Element Type Declaration. Element not_unique has been declared 3 time in the DTD. Violates VC:Proper Group/PE Nesting in P49. Open and close parenthesis for a choice content model are in different PE replace Texts. Violates VC:Proper Group/PE Nesting in P50. Open and close parenthesis for a seq content model are in different PE replace Texts. Violates VC:Proper Group/PE Nesting in P51. Open and close parenthesis for a Mixed content model are in different PE replace Texts. Violates VC:No Duplicate Types in P51. Element a appears twice in the Mixed content model of Element e. Tests invalid TokenizedType which is against P56 VC: ID. The value of the ID attribute "UniqueName" is "@999" which does not meet the Name production. Tests invalid TokenizedType which is against P56 VC: ID. The two ID attributes "attr" and "UniqueName" have the same value "Ac999" for the element "b" and the element "tokenizer". Tests invalid TokenizedType which is against P56 VC: ID Attribute Default. The "#FIXED" occurs in the DefaultDecl for the ID attribute "UniqueName". Tests invalid TokenizedType which is against P56 VC: ID Attribute Default. The constant string "BOGUS" occurs in the DefaultDecl for the ID attribute "UniqueName". Tests invalid TokenizedType which is against P56 VC: One ID per Element Type. The element "a" has two ID attributes "first" and "second". Tests invalid TokenizedType which is against P56 VC: IDREF. The value of the IDREF attribute "reference" is "@456" which does not meet the Name production. Tests invalid TokenizedType which is against P56 VC: IDREF. The value of the IDREF attribute "reference" is "BC456" which does not match the value assigned to any ID attributes. Tests invalid TokenizedType which is against P56 VC: IDREFS. The value of the IDREFS attribute "reference" is "AC456 #567" which does not meet the Names production. Tests invalid TokenizedType which is against P56 VC: IDREFS. The value of the IDREFS attribute "reference" is "EF456 DE355" which does not match the values assigned to two ID attributes. Tests invalid TokenizedType which is against P56 VC: Entity Name. The value of the ENTITY attribute "sun" is "ima ge" which does not meet the Name production. Tests invalid TokenizedType which is against P56 VC: Entity Name. The value of the ENTITY attribute "sun" is "notimage" which does not match the name of any unparsed entity declared. Tests invalid TokenizedType which is against P56 VC: Entity Name. The value of the ENTITY attribute "sun" is "parsedentity" which matches the name of a parsed entity instead of an unparsed entity declared. Tests invalid TokenizedType which is against P56 VC: Entity Name. The value of the ENTITIES attribute "sun" is "#image1 @image" which does not meet the Names production. Tests invalid TokenizedType which is against P56 VC: ENTITIES. The value of the ENTITIES attribute "sun" is "image3 image4" which does not match the names of two unparsed entities declared. Tests invalid TokenizedType which is against P56 VC: ENTITIES. The value of the ENTITIES attribute "sun" is "parsedentity1 parsedentity2" which matches the names of two parsed entities instead of two unparsed entities declared. Tests invalid TokenizedType which is against P56 VC: Name Token. The value of the NMTOKEN attribute "thistoken" is "x : image" which does not meet the Nmtoken production. Tests invalid TokenizedType which is against P56 VC: Name Token. The value of the NMTOKENS attribute "thistoken" is "@lang y: #country" which does not meet the Nmtokens production. Tests invalid NotationType which is against P58 VC: Notation Attributes. The attribute "content-encoding" with value "raw" is not a value from the list "(base64|uuencode)". Tests invalid NotationType which is against P58 VC: Notation Attributes. The attribute "content-encoding" with value "raw" is a value from the list "(base64|uuencode|raw|ascii)", but "raw" is not a declared notation. Tests invalid Enumeration which is against P59 VC: Enumeration. The value of the attribute is "ONE" which matches neither "one" nor "two" as declared in the Enumeration in the AttDef in the AttlistDecl. Tests invalid DefaultDecl which is against P60 VC: Required Attribute. The attribute "chapter" for the element "two" is declared as #REQUIRED in the DefaultDecl in the AttlistDecl, but the value of this attribute is not given. Tests invalid DefaultDecl which is against P60 VC: Fixed Attribute Default.. The attribute "chapter" for the element "one" is declared as #FIXED with the given value "Introduction" in the DefaultDecl in the AttlistDecl, but the value of a instance of this attribute is assigned to "JavaBeans". Tests invalid DefaultDecl which is against P60 VC: Attribute Default Legal. The declared default value "c" is not legal for the type (a|b) in the AttDef in the AttlistDecl. Tests invalid DefaultDecl which is against P60 VC: Attribute Default Legal. The declared default value "@#$" is not legal for the type NMTOKEN the AttDef in the AttlistDecl. Tests invalid EntityRef which is against P68 VC: Entity Declared. The GE with the name "ge2" is referred in the file ibm68i01.dtd", but not declared. Tests invalid EntityRef which is against P68 VC: Entity Declared. The GE with the name "ge1" is referred before declared in the file ibm68i01.dtd". Tests invalid EntityRef which is against P68 VC: Entity Declared. The GE with the name "ge2" is referred in the file ibm68i03.ent", but not declared. Tests invalid EntityRef which is against P68 VC: Entity Declared. The GE with the name "ge1" is referred before declared in the file ibm68i04.ent". Tests invalid PEReference which is against P69 VC: Entity Declared. The Name "pe2" in the PEReference in the file ibm69i01.dtd does not match the Name of any declared PE. Tests invalid PEReference which is against P69 VC: Entity Declared. The PE with the name "pe1" is referred before declared in the file ibm69i02.dtd Tests invalid PEReference which is against P69 VC: Entity Declared. The Name "pe3" in the PEReference in the file ibm69i03.ent does not match the Name of any declared PE. Tests invalid PEReference which is against P69 VC: Entity Declared. The PE with the name "pe2" is referred before declared in the file ibm69i04.ent. Tests invalid NDataDecl which is against P76 VC: Notation declared. The Name "JPGformat" in the NDataDecl in the EntityDecl for "ge2" does not match the Name of any declared notation. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/ibm_oasis_not-wf.xml0000644006511100651110000060570410504340457026552 0ustar rossross Tests a document with no element. A well-formed document should have at lease one elements. Tests a document with wrong ordering of its prolog and element. The element occurs before the xml declaration and the DTD. Tests a document with wrong combination of misc and element. One PI occurs between two elements. Tests a comment which contains an illegal Char: #x00 Tests a comment which contains an illegal Char: #x01 Tests a comment which contains an illegal Char: #x02 Tests a comment which contains an illegal Char: #x03 Tests a comment which contains an illegal Char: #x04 Tests a comment which contains an illegal Char: #x05 Tests a comment which contains an illegal Char: #x06 Tests a comment which contains an illegal Char: #x07 Tests a comment which contains an illegal Char: #x08 Tests a comment which contains an illegal Char: #x0B Tests a comment which contains an illegal Char: #x0C Tests a comment which contains an illegal Char: #x0E Tests a comment which contains an illegal Char: #x0F Tests a comment which contains an illegal Char: #x10 Tests a comment which contains an illegal Char: #x11 Tests a comment which contains an illegal Char: #x12 Tests a comment which contains an illegal Char: #x13 Tests a comment which contains an illegal Char: #x14 Tests a comment which contains an illegal Char: #x15 Tests a comment which contains an illegal Char: #x16 Tests a comment which contains an illegal Char: #x17 Tests a comment which contains an illegal Char: #x18 Tests a comment which contains an illegal Char: #x19 Tests a comment which contains an illegal Char: #x1A Tests a comment which contains an illegal Char: #x1B Tests a comment which contains an illegal Char: #x1C Tests a comment which contains an illegal Char: #x1D Tests a comment which contains an illegal Char: #x1E Tests a comment which contains an illegal Char: #x1F Tests a comment which contains an illegal Char: #xD800 Tests a comment which contains an illegal Char: #xDFFF Tests a comment which contains an illegal Char: #xFFFE Tests a comment which contains an illegal Char: #xFFFF Tests an end tag which contains an illegal space character #x3000 which follows the element name "book". Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x21 Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x28 Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x29 Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x2B Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x2C Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x2F Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x3B Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x3C Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x3D Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x3F Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x5B Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x5C Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x5D Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x5E Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x60 Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x7B Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x7C Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x7D Tests an element name which has an illegal first character. An illegal first character "." is followed by "A_name-starts_with.". Tests an element name which has an illegal first character. An illegal first character "-" is followed by "A_name-starts_with-". Tests an element name which has an illegal first character. An illegal first character "5" is followed by "A_name-starts_with_digit". Tests an internal general entity with an invalid value. The entity "Fullname" contains "%". Tests an internal general entity with an invalid value. The entity "Fullname" contains the ampersand character. Tests an internal general entity with an invalid value. The entity "Fullname" contains the double quote character in the middle. Tests an internal general entity with an invalid value. The closing bracket (double quote) is missing with the value of the entity "FullName". Tests an attribute with an invalid value. The value of the attribute "first" contains the character "less than". Tests an attribute with an invalid value. The value of the attribute "first" contains the character ampersand. Tests an attribute with an invalid value. The value of the attribute "first" contains the double quote character in the middle. Tests an attribute with an invalid value. The closing bracket (double quote) is missing with The value of the attribute "first". Tests an attribute with an invalid value. The value of the attribute "first" contains the character "less than". Tests an attribute with an invalid value. The value of the attribute "first" contains the character ampersand. Tests an attribute with an invalid value. The value of the attribute "first" contains the double quote character in the middle. Tests an attribute with an invalid value. The closing bracket (single quote) is missing with the value of the attribute "first". Tests SystemLiteral. The systemLiteral for the element "student" has a double quote character in the middle. Tests SystemLiteral. The systemLiteral for the element "student" has a single quote character in the middle. Tests SystemLiteral. The closing bracket (double quote) is missing with the systemLiteral for the element "student". Tests SystemLiteral. The closing bracket (single quote) is missing with the systemLiteral for the element "student". Tests PubidLiteral. The closing bracket (double quote) is missing with the value of the PubidLiteral for the entity "info". Tests PubidLiteral. The value of the PubidLiteral for the entity "info" has a single quote character in the middle.. Tests PubidLiteral. The closing bracket (single quote) is missing with the value of the PubidLiteral for the entity "info". Tests PubidChar. The pubidChar of the PubidLiteral for the entity "info" contains the character "{". Tests PubidChar. The pubidChar of the PubidLiteral for the entity "info" contains the character "~". Tests PubidChar. The pubidChar of the PubidLiteral for the entity "info" contains the character double quote in the middle. Tests CharData. The content of the element "student" contains the character "[[>". Tests CharData. The content of the element "student" contains the character "less than". Tests CharData. The content of the element "student" contains the character ampersand. Tests comment. The text of the second comment contains the character "-". Tests comment. The second comment has a wrong closing sequence "-(greater than)". Tests comment. The second comment has a wrong beginning sequence "(less than)!-". Tests comment. The closing sequence is missing with the second comment. Tests PI. The content of the PI includes the sequence "(less than)?". Tests PI. The PITarget is missing in the PI. Tests PI. The PI has a wrong closing sequence ">". Tests PI. The closing sequence is missing in the PI. Tests PITarget. The PITarget contains the string "XML". Tests PITarget. The PITarget contains the string "xML". Tests PITarget. The PITarget contains the string "xml". Tests PITarget. The PITarget contains the string "xmL". Tests CDSect. The CDStart is missing in the CDSect in the content of element "student". Tests CDSect. The CDEnd is missing in the CDSect in the content of element "student". Tests CDStart. The CDStart contains a lower case string "cdata". Tests CDStart. The CDStart contains an extra character "[". Tests CDStart. The CDStart contains a wrong character "?". Tests CDATA with an illegal sequence. The CDATA contains the string "[[>". Tests CDEnd. One "]" is missing in the CDEnd. Tests CDEnd. An extra "]" is placed in the CDEnd. Tests CDEnd. A wrong character ")" is placed in the CDEnd. Tests prolog with wrong field ordering. The XMLDecl occurs after the DTD. Tests prolog with wrong field ordering. The Misc (comment) occurs before the XMLDecl. Tests prolog with wrong field ordering. The XMLDecl occurs after the DTD and a comment. The other comment occurs before the DTD. Tests XMLDecl with a required field missing. The Versioninfo is missing in the XMLDecl. Tests XMLDecl with wrong field ordering. The VersionInfo occurs after the EncodingDecl. Tests XMLDecl with wrong field ordering. The VersionInfo occurs after the SDDecl and the SDDecl occurs after the VersionInfo. Tests XMLDecl with wrong key word. An upper case string "XML" is used as the key word in the XMLDecl. Tests XMLDecl with a wrong closing sequence ">". Tests XMLDecl with a wrong opening sequence "(less than)!". Tests VersionInfo with a required field missing. The VersionNum is missing in the VersionInfo in the XMLDecl. Tests VersionInfo with a required field missing. The white space is missing between the key word "xml" and the VersionInfo in the XMLDecl. Tests VersionInfo with a required field missing. The "=" (equal sign) is missing between the key word "version" and the VersionNum. Tests VersionInfo with wrong field ordering. The VersionNum occurs before "=" and "version". Tests VersionInfo with wrong field ordering. The "=" occurs after "version" and the VersionNum. Tests VersionInfo with the wrong key word "Version". Tests VersionInfo with the wrong key word "versioN". Tests VersionInfo with mismatched quotes around the VersionNum. version = '1.0" is used as the VersionInfo. Tests VersionInfo with mismatched quotes around the VersionNum. The closing bracket for the VersionNum is missing. Tests eq with a wrong key word "==". Tests eq with a wrong key word "eq". Tests VersionNum with an illegal character "#". Tests type of Misc. An element declaration is used as a type of Misc After the element "animal". Tests doctypedecl with a required field missing. The Name "animal" is missing in the doctypedecl. Tests doctypedecl with wrong field ordering. The Name "animal" occurs after the markup declarations inside the "[]". Tests doctypedecl with wrong field ordering. The Name "animal" occurs after the markup declarations inside the "[]". Tests doctypedecl with general entity reference.The "(ampersand)generalE" occurs in the DTD. Tests doctypedecl with wrong key word. A wrong key word "DOCtYPE" occurs on line 2. Tests doctypedecl with mismatched brackets. The closing bracket "]" of the DTD is missing. Tests doctypedecl with wrong bracket. The opening bracket "}" occurs in the DTD. Tests doctypedecl with wrong opening sequence. The opening sequence "(less than)?DOCTYPE" occurs in the DTD. This test violates WFC:PE Between Declarations in Production 28a. The last character of a markup declaration is not contained in the same parameter-entity text replacement. Tests markupdecl with an illegal markup declaration. A XMLDecl occurs inside the DTD. Tests WFC "PEs in Internal Subset". A PE reference occurs inside an elementdecl in the DTD. Tests WFC "PEs in Internal Subset". A PE reference occurs inside an ATTlistDecl in the DTD. Tests WFC "PEs in Internal Subset". A PE reference occurs inside an EntityDecl in the DTD. Tests WFC "PEs in Internal Subset". A PE reference occurs inside a PI in the DTD. Tests WFC "PEs in Internal Subset". A PE reference occurs inside a comment in the DTD. Tests WFC "PEs in Internal Subset". A PE reference occurs inside a NotationDecl in the DTD. Tests extSubset with wrong field ordering. In the file "ibm30n01.dtd", the TextDecl occurs after the extSubsetDecl (the element declaration). Tests extSubsetDecl with an illegal field. A general entity reference occurs in file "ibm31n01.dtd". Tests SDDecl with a required field missing. The leading white space is missing with the SDDecl in the XMLDecl. Tests SDDecl with a required field missing. The "=" sign is missing in the SDDecl in the XMLDecl. Tests SDDecl with wrong key word. The word "Standalone" occurs in the SDDecl in the XMLDecl. Tests SDDecl with wrong key word. The word "Yes" occurs in the SDDecl in the XMLDecl. Tests SDDecl with wrong key word. The word "YES" occurs in the SDDecl in the XMLDecl. Tests SDDecl with wrong key word. The word "No" occurs in the SDDecl in the XMLDecl. Tests SDDecl with wrong key word. The word "NO" occurs in the SDDecl in the XMLDecl. Tests SDDecl with wrong field ordering. The "=" sign occurs after the key word "yes" in the SDDecl in the XMLDecl. This is test violates WFC: Entity Declared in P68. The standalone document declaration has the value yes, BUT there is an external markup declaration of an entity (other than amp, lt, gt, apos, quot), and references to this entity appear in the document. Tests element with a required field missing. The ETag is missing for the element "root". Tests element with a required field missing. The STag is missing for the element "root". Tests element with required fields missing. Both the content and the ETag are missing in the element "root". Tests element with required fields missing. Both the content and the STag are missing in the element "root". Tests element with wrong field ordering. The STag and the ETag are swapped in the element "root". Tests element with wrong field ordering. The content occurs after the ETag of the element "root". Tests STag with a required field missing. The Name "root" is in the STag of the element "root". Tests STag with a required field missing. The white space between the Name "root" and the attribute "attr1" is missing in the STag of the element "root". Tests STag with wrong field ordering. The Name "root" occurs after the attribute "attr1" in the STag of the element "root". Tests STag with a wrong opening sequence. The string "(less than)!" is used as the opening sequence for the STag of the element "root". Tests STag with duplicate attribute names. The attribute name "attr1" occurs twice in the STag of the element "root". Tests Attribute with a required field missing. The attribute name is missing in the Attribute in the STag of the element "root". Tests Attribute with a required field missing. The "=" is missing between the attribute name and the attribute value in the Attribute in the STag of the element "root". Tests Attribute with a required field missing. The AttValue is missing in the Attribute in the STag of the element "root". Tests Attribute with a required field missing. The Name and the "=" are missing in the Attribute in the STag of the element "root". Tests Attribute with a required field missing. The "=" and the AttValue are missing in the Attribute in the STag of the element "root". Tests Attribute with a required field missing. The Name and the AttValue are missing in the Attribute in the STag of the element "root". Tests Attribute with wrong field ordering. The "=" occurs after the Name and the AttValue in the Attribute in the STag of the element "root". Tests Attribute with wrong field ordering. The Name and the AttValue are swapped in the Attribute in the STag of the element "root". Tests Attribute with wrong field ordering. The "=" occurs before the Name and the AttValue in the Attribute in the STag of the element "root". Tests Attribute against WFC "no external entity references". A direct references to the external entity "aExternal" is contained in the value of the attribute "attr1". Tests Attribute against WFC "no external entity references". A indirect references to the external entity "aExternal" is contained in the value of the attribute "attr1". Tests Attribute against WFC "no external entity references". A direct references to the external unparsed entity "aImage" is contained in the value of the attribute "attr1". Tests Attribute against WFC "No (less that) character in Attribute Values". The character "less than" is contained in the value of the attribute "attr1". Tests Attribute against WFC "No (less than) in Attribute Values". The character "less than" is contained in the value of the attribute "attr1" through indirect internal entity reference. Tests ETag with a required field missing. The Name is missing in the ETag of the element "root". Tests ETag with a wrong beginning sequence. The string "(less than)\" is used as a beginning sequence of the ETag of the element "root". Tests ETag with a wrong beginning sequence. The string "less than" is used as a beginning sequence of the ETag of the element "root". Tests ETag with a wrong structure. An white space occurs between The beginning sequence and the Name of the ETag of the element "root". Tests ETag with a wrong structure. The ETag of the element "root" contains an Attribute (attr1="any"). Tests element content with a wrong option. A NotationDecl is used as the content of the element "root". Tests element content with a wrong option. A elementdecl is used as the content of the element "root". Tests element content with a wrong option. An elementdecl is used as the content of the element "root". Tests element content with a wrong option. An AttlistDecl is used as the content of the element "root". Tests EmptyElemTag with a required field missing. The Name "root" is missing in the EmptyElemTag. Tests EmptyElemTag with wrong field ordering. The Attribute (attri1 = "any") occurs before the name of the element "root" in the EmptyElemTag. Tests EmptyElemTag with wrong closing sequence. The string "\>" is used as the closing sequence in the EmptyElemtag of the element "root". Tests EmptyElemTag which against the WFC "Unique Att Spec". The attribute name "attr1" occurs twice in the EmptyElemTag of the element "root". Tests elementdecl with a required field missing. The Name is missing in the second elementdecl in the DTD. Tests elementdecl with a required field missing. The white space is missing between "aEle" and "(#PCDATA)" in the second elementdecl in the DTD. Tests elementdecl with a required field missing. The contentspec is missing in the second elementdecl in the DTD. Tests elementdecl with a required field missing. The contentspec and the white space is missing in the second elementdecl in the DTD. Tests elementdecl with a required field missing. The Name, the white space, and the contentspec are missing in the second elementdecl in the DTD. Tests elementdecl with wrong field ordering. The Name occurs after the contentspec in the second elementdecl in the DTD. Tests elementdecl with wrong beginning sequence. The string "(less than)ELEMENT" is used as the beginning sequence in the second elementdecl in the DTD. Tests elementdecl with wrong key word. The string "Element" is used as the key word in the second elementdecl in the DTD. Tests elementdecl with wrong key word. The string "element" is used as the key word in the second elementdecl in the DTD. Tests contentspec with wrong key word. the string "empty" is used as the key word in the contentspec of the second elementdecl in the DTD. Tests contentspec with wrong key word. the string "Empty" is used as the key word in the contentspec of the second elementdecl in the DTD. Tests contentspec with wrong key word. the string "Any" is used as the key word in the contentspec of the second elementdecl in the DTD. Tests contentspec with wrong key word. the string "any" is used as the key word in the contentspec of the second elementdecl in the DTD. Tests contentspec with a wrong option. The string "#CDATA" is used as the contentspec in the second elementdecl in the DTD. Tests children with a required field missing. The "+" is used as the choice or seq field in the second elementdecl in the DTD. Tests children with a required field missing. The "*" is used as the choice or seq field in the second elementdecl in the DTD. Tests children with a required field missing. The "?" is used as the choice or seq field in the second elementdecl in the DTD. Tests children with wrong field ordering. The "*" occurs before the seq field (a,a) in the second elementdecl in the DTD. Tests children with wrong field ordering. The "+" occurs before the choice field (a|a) in the second elementdecl in the DTD. Tests children with wrong key word. The "^" occurs after the seq field in the second elementdecl in the DTD. Tests cp with a required fields missing. The field Name|choice|seq is missing in the second cp in the choice field in the third elementdecl in the DTD. Tests cp with a required fields missing. The field Name|choice|seq is missing in the cp in the third elementdecl in the DTD. Tests cp with a required fields missing. The field Name|choice|seq is missing in the first cp in the choice field in the third elementdecl in the DTD. Tests cp with wrong field ordering. The "+" occurs before the seq (a,a) in the first cp in the choice field in the third elementdecl in the DTD. Tests cp with wrong field ordering. The "*" occurs before the choice (a|b) in the first cp in the seq field in the third elementdecl in the DTD. Tests cp with wrong field ordering. The "?" occurs before the Name "a" in the second cp in the seq field in the third elementdecl in the DTD. Tests cp with wrong key word. The "^" occurs after the Name "a" in the first cp in the choice field in the third elementdecl in the DTD. Tests choice with a required field missing. The two cps are missing in the choice field in the third elementdecl in the DTD. Tests choice with a required field missing. The third cp is missing in the choice field in the fourth elementdecl in the DTD. Tests choice with a wrong separator. The "!" is used as the separator in the choice field in the fourth elementdecl in the DTD. Tests choice with a required field missing. The separator "|" is missing in the choice field (a b)+ in the fourth elementdecl in the DTD. Tests choice with an extra separator. An extra "|" occurs between a and b in the choice field in the fourth elementdecl in the DTD. Tests choice with a required field missing. The closing bracket ")" is missing in the choice field (a |b * in the fourth elementdecl in the DTD. Tests seq with a required field missing. The two cps are missing in the seq field in the fourth elementdecl in the DTD. Tests seq with a required field missing. The third cp is missing in the seq field in the fourth elementdecl in the DTD. Tests seq with a wrong separator. The "|" is used as the separator between a and b in the seq field in the fourth elementdecl in the DTD. Tests seq with a wrong separator. The "." is used as the separator between a and b in the seq field in the fourth elementdecl in the DTD. Tests seq with an extra separator. An extra "," occurs between (a|b) and a in the seq field in the fourth elementdecl in the DTD. Tests seq with a required field missing. The separator between (a|b) and (b|a) is missing in the seq field in the fourth elementdecl in the DTD. Tests seq with wrong closing bracket. The "]" is used as the closing bracket in the seq field in the fourth elementdecl in the DTD. Tests Mixed with a wrong key word. The string "#pcdata" is used as the key word in the Mixed field in the fourth elementdecl in the DTD. Tests Mixed with wrong field ordering. The field #PCDATA does not occur as the first component in the Mixed field in the fourth elementdecl in the DTD. Tests Mixed with a separator missing. The separator "|" is missing in between #PCDATA and a in the Mixed field in the fourth elementdecl in the DTD. Tests Mixed with a wrong key word. The string "#CDATA" is used as the key word in the Mixed field in the fourth elementdecl in the DTD. Tests Mixed with a required field missing. The "*" is missing after the ")" in the Mixed field in the fourth elementdecl in the DTD. Tests Mixed with wrong closing bracket. The "]" is used as the closing bracket in the Mixed field in the fourth elementdecl in the DTD. Tests Mixed with a required field missing. The closing bracket ")" is missing after (#PCDATA in the Mixed field in the fourth elementdecl in the DTD. Tests AttlistDecl with a required field missing. The Name is missing in the AttlistDecl in the DTD. Tests AttlistDecl with a required field missing. The white space is missing between the beginning sequence and the name in the AttlistDecl in the DTD. Tests AttlistDecl with wrong field ordering. The Name "a" occurs after the first AttDef in the AttlistDecl in the DTD. Tests AttlistDecl with wrong key word. The string "Attlist" is used as the key word in the beginning sequence in the AttlistDecl in the DTD. Tests AttlistDecl with a required field missing. The closing bracket "greater than" is missing in the AttlistDecl in the DTD. Tests AttlistDecl with wrong beginning sequence. The string "(less than)ATTLIST" is used as the beginning sequence in the AttlistDecl in the DTD. Tests AttDef with a required field missing. The DefaultDecl is missing in the AttDef for the name "attr1" in the AttlistDecl in the DTD. Tests AttDef with a required field missing. The white space is missing between (abc|def) and "def" in the AttDef in the AttlistDecl in the DTD. Tests AttDef with a required field missing. The AttType is missing for "attr1" in the AttDef in the AttlistDecl in the DTD. Tests AttDef with a required field missing. The white space is missing between "attr1" and (abc|def) in the AttDef in the AttlistDecl in the DTD. Tests AttDef with a required field missing. The Name is missing in the AttDef in the AttlistDecl in the DTD. Tests AttDef with a required field missing. The white space before the name "attr2" is missing in the AttDef in the AttlistDecl in the DTD. Tests AttDef with wrong field ordering. The Name "attr1" occurs after the AttType in the AttDef in the AttlistDecl in the DTD. Tests AttDef with wrong field ordering. The Name "attr1" occurs after the AttType and "default" occurs before the AttType in the AttDef in the AttlistDecl in the DTD. Tests AttType with a wrong option. The string "BOGUSATTR" is used as the AttType in the AttlistDecl in the DTD. Tests AttType with a wrong option. The string "PCDATA" is used as the AttType in the AttlistDecl in the DTD. Tests StringType with a wrong key word. The lower case string "cdata" is used as the StringType in the AttType in the AttlistDecl in the DTD. Tests StringType with a wrong key word. The string "#CDATA" is used as the StringType in the AttType in the AttlistDecl in the DTD. Tests StringType with a wrong key word. The string "CData" is used as the StringType in the AttType in the AttlistDecl in the DTD. Tests TokenizedType with wrong key word. The "id" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD. Tests TokenizedType with wrong key word. The "Idref" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD. Tests TokenizedType with wrong key word. The "Idrefs" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD. Tests TokenizedType with wrong key word. The "EntitY" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD. Tests TokenizedType with wrong key word. The "nmTOKEN" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD. Tests TokenizedType with wrong key word. The "NMtokens" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD. Tests TokenizedType with wrong key word. The "#ID" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD. Tests EnumeratedType with an illegal option. The "NMTOKEN (a|b)" is used in the EnumeratedType in the AttlistDecl in the DTD. Tests NotationType with wrong key word. The lower case "notation" is used as the key word in the NotationType in the AttDef in the AttlistDecl in the DTD. Tests NotationType with a required field missing. The beginning bracket "(" is missing in the NotationType in the AttDef in the AttlistDecl in the DTD. Tests NotationType with a required field missing. The Name is missing in the "()" in the NotationType in the AttDef in the AttlistDecl in the DTD. Tests NotationType with a required field missing. The closing bracket is missing in the NotationType in the AttDef in the AttlistDecl in the DTD. Tests NotationType with wrong field ordering. The key word "NOTATION" occurs after "(this)" in the NotationType in the AttDef in the AttlistDecl in the DTD. Tests NotationType with wrong separator. The "," is used as a separator between "this" and "that" in the NotationType in the AttDef in the AttlistDecl in the DTD. Tests NotationType with a required field missing. The white space is missing between "NOTATION" and "(this)" in the NotationType in the AttDef in the AttlistDecl in the DTD. Tests NotationType with extra wrong characters. The double quote character occurs after "(" and before ")" in the NotationType in the AttDef in the AttlistDecl in the DTD. Tests Enumeration with required fields missing. The Nmtokens and "|"s are missing in the AttDef in the AttlistDecl in the DTD. Tests Enumeration with a required field missing. The closing bracket ")" is missing in the AttDef in the AttlistDecl in the DTD. Tests Enumeration with wrong separator. The "," is used as the separator in the AttDef in the AttlistDecl in the DTD. Tests Enumeration with illegal presence. The double quotes occur around the Enumeration value in the AttDef in the AttlistDecl in the DTD. Tests Enumeration with a required field missing. The white space is missing between in the AttDef in the AttlistDecl in the DTD. Tests Enumeration with a required field missing. The beginning bracket "(" is missing in the AttDef in the AttlistDecl in the DTD. Tests DefaultDecl with wrong key word. The string "#required" is used as the key word in the DefaultDecl in the AttDef in the AttlistDecl in the DTD. Tests DefaultDecl with wrong key word. The string "Implied" is used as the key word in the DefaultDecl in the AttDef in the AttlistDecl in the DTD. Tests DefaultDecl with wrong key word. The string "!IMPLIED" is used as the key word in the DefaultDecl in the AttDef in the AttlistDecl in the DTD. Tests DefaultDecl with a required field missing. There is no attribute value specified after the key word "#FIXED" in the DefaultDecl in the AttDef in the AttlistDecl in the DTD. Tests DefaultDecl with a required field missing. The white space is missing between the key word "#FIXED" and the attribute value in the DefaultDecl in the AttDef in the AttlistDecl in the DTD. Tests DefaultDecl with wrong field ordering. The key word "#FIXED" occurs after the attribute value "introduction" in the DefaultDecl in the AttDef in the AttlistDecl in the DTD. Tests DefaultDecl against WFC of P60. The text replacement of the entity "avalue" contains the "less than" character in the DefaultDecl in the AttDef in the AttlistDecl in the DTD. Tests DefaultDecl with more than one key word. The "#REQUIRED" and the "#IMPLIED" are used as the key words in the DefaultDecl in the AttDef in the AttlistDecl in the DTD. Tests conditionalSect with a wrong option. The word "NOTINCLUDE" is used as part of an option which is wrong in the coditionalSect. Tests includeSect with wrong key word. The string "include" is used as a key word in the beginning sequence in the includeSect in the file ibm62n01.dtd. Tests includeSect with wrong beginning sequence. An extra "[" occurs in the beginning sequence in the includeSect in the file ibm62n02.dtd. Tests includeSect with wrong beginning sequence. A wrong character "?" occurs in the beginning sequence in the includeSect in the file ibm62n03.dtd. Tests includeSect with a required field missing. The key word "INCLUDE" is missing in the includeSect in the file ibm62n04.dtd. Tests includeSect with a required field missing. The "]" is missing after the key word "INCLUDE" in the includeSect in the file ibm62n05.dtd. Tests includeSect with wrong field ordering. The two external subset declarations occur before the key word "INCLUDE" in the includeSect in the file ibm62n06.dtd. Tests includeSect with a required field missing. The closing sequence "]](greater than)" is missing in the includeSect in the file ibm62n07.dtd. Tests includeSect with a required field missing. One "]" is missing in the closing sequence in the includeSect in the file ibm62n08.dtd. Tests ignoreSect with wrong key word. The string "ignore" is used as a key word in the beginning sequence in the ignoreSect in the file ibm63n01.dtd. Tests ignoreSect with wrong beginning sequence. An extra "[" occurs in the beginning sequence in the ignoreSect in the file ibm63n02.dtd. Tests ignoreSect with wrong beginning sequence. A wrong character "?" occurs in the beginning sequence in the ignoreSect in the file ibm63n03.dtd. Tests ignoreSect with a required field missing. The key word "IGNORE" is missing in the ignoreSect in the file ibm63n04.dtd. Tests ignoreSect with a required field missing. The "]" is missing after the key word "IGNORE" in the ignoreSect in the file ibm63n05.dtd. Tests includeSect with wrong field ordering. The two external subset declarations occur before the key word "IGNORE" in the ignoreSect in the file ibm63n06.dtd. Tests ignoreSect with a required field missing. The closing sequence "]](greater than)" is missing in the ignoreSect in the file ibm63n07.dtd. Tests ignoreSectContents with wrong beginning sequence. The "?" occurs in beginning sequence the ignoreSectContents in the file ibm64n01.dtd. Tests ignoreSectContents with a required field missing.The closing sequence is missing in the ignoreSectContents in the file ibm64n02.dtd. Tests ignoreSectContents with a required field missing.The beginning sequence is missing in the ignoreSectContents in the file ibm64n03.dtd. Tests Ignore with illegal string included. The string "]](greater than)" is contained before "this" in the Ignore in the ignoreSectContents in the file ibm65n01.dtd Tests Ignore with illegal string included. The string "(less than)![" is contained before "this" in the Ignore in the ignoreSectContents in the file ibm65n02.dtd Tests CharRef with an illegal character referred to. The "#002f" is used as the referred character in the CharRef in the EntityDecl in the DTD. Tests CharRef with the semicolon character missing. The semicolon character is missing at the end of the CharRef in the attribute value in the STag of element "root". Tests CharRef with an illegal character referred to. The "49" is used as the referred character in the CharRef in the EntityDecl in the DTD. Tests CharRef with an illegal character referred to. The "#5~0" is used as the referred character in the attribute value in the EmptyElemTag of the element "root". Tests CharRef with an illegal character referred to. The "#x002g" is used as the referred character in the CharRef in the EntityDecl in the DTD. Tests CharRef with an illegal character referred to. The "#x006G" is used as the referred character in the attribute value in the EmptyElemTag of the element "root". Tests CharRef with an illegal character referred to. The "#0=2f" is used as the referred character in the CharRef in the EntityDecl in the DTD. Tests CharRef with an illegal character referred to. The "#56.0" is used as the referred character in the attribute value in the EmptyElemTag of the element "root". Tests CharRef with an illegal character referred to. The "#x00/2f" is used as the referred character in the CharRef in the EntityDecl in the DTD. Tests CharRef with an illegal character referred to. The "#51)" is used as the referred character in the attribute value in the EmptyElemTag of the element "root". Tests CharRef with an illegal character referred to. The "#00 2f" is used as the referred character in the CharRef in the EntityDecl in the DTD. Tests CharRef with an illegal character referred to. The "#x0000" is used as the referred character in the attribute value in the EmptyElemTag of the element "root". Tests CharRef with an illegal character referred to. The "#x001f" is used as the referred character in the attribute value in the EmptyElemTag of the element "root". Tests CharRef with an illegal character referred to. The "#xfffe" is used as the referred character in the attribute value in the EmptyElemTag of the element "root". Tests CharRef with an illegal character referred to. The "#xffff" is used as the referred character in the attribute value in the EmptyElemTag of the element "root". Tests EntityRef with a required field missing. The Name is missing in the EntityRef in the content of the element "root". Tests EntityRef with a required field missing. The semicolon is missing in the EntityRef in the attribute value in the element "root". Tests EntityRef with an extra white space. A white space occurs after the ampersand in the EntityRef in the content of the element "root". Tests EntityRef which is against P68 WFC: Entity Declared. The name "aAa" in the EntityRef in the AttValue in the STage of the element "root" does not match the Name of any declared entity in the DTD. Tests EntityRef which is against P68 WFC: Entity Declared. The entity with the name "aaa" in the EntityRef in the AttValue in the STag of the element "root" is not declared. Tests EntityRef which is against P68 WFC: Entity Declared. The entity with the name "aaa" in the EntityRef in the AttValue in the STag of the element "root" is externally declared, but standalone is "yes". Tests EntityRef which is against P68 WFC: Entity Declared. The entity with the name "aaa" in the EntityRef in the AttValue in the STag of the element "root" is referred before declared. Tests EntityRef which is against P68 WFC: Parsed Entity. The EntityRef in the AttValue in the STag of the element "root" contains the name "aImage" of an unparsed entity. Tests EntityRef which is against P68 WFC: No Recursion. The recursive entity reference occurs with the entity declarations for "aaa" and "bbb" in the DTD. Tests EntityRef which is against P68 WFC: No Recursion. The indirect recursive entity reference occurs with the entity declarations for "aaa", "bbb", "ccc", "ddd", and "eee" in the DTD. Tests PEReference with a required field missing. The Name "paaa" is missing in the PEReference in the DTD. Tests PEReference with a required field missing. The semicolon is missing in the PEReference "%paaa" in the DTD. Tests PEReference with an extra white space. There is an extra white space occurs before ";" in the PEReference in the DTD. Tests PEReference with an extra white space. There is an extra white space occurs after "%" in the PEReference in the DTD. Based on E29 substantial source: minutes XML-Syntax 1999-02-24 E38 in XML 1.0 Errata, this WFC does not apply to P69, but the VC Entity declared still apply. Tests PEReference which is against P69 WFC: Entity Declared. The PE with the name "paaa" is referred before declared in the DTD. Tests PEReference which is against P69 WFC: No Recursion. The recursive PE reference occurs with the entity declarations for "paaa" and "bbb" in the DTD. Tests PEReference which is against P69 WFC: No Recursion. The indirect recursive PE reference occurs with the entity declarations for "paaa", "bbb", "ccc", "ddd", and "eee" in the DTD. Tests Tests EntityDecl with a required field missing. The white space is missing between the beginning sequence and the Name "aaa" in the EntityDecl in the DTD. Tests EntityDecl with a required field missing. The white space is missing between the Name "aaa" and the EntityDef "aString" in the EntityDecl in the DTD. Tests EntityDecl with a required field missing. The EntityDef is missing in the EntityDecl with the Name "aaa" in the DTD. Tests EntityDecl with a required field missing. The Name is missing in the EntityDecl with the EntityDef "aString" in the DTD. Tests EntityDecl with wrong ordering. The Name "aaa" occurs after the EntityDef in the EntityDecl in the DTD. Tests EntityDecl with wrong key word. The string "entity" is used as the key word in the beginning sequence in the EntityDecl in the DTD. Tests EntityDecl with a required field missing. The closing bracket (greater than) is missing in the EntityDecl in the DTD. Tests EntityDecl with a required field missing. The exclamation mark is missing in the beginning sequence in the EntityDecl in the DTD. Tests PEdecl with a required field missing. The white space is missing between the beginning sequence and the "%" in the PEDecl in the DTD. Tests PEdecl with a required field missing. The Name is missing in the PEDecl in the DTD. Tests PEdecl with a required field missing. The white space is missing between the Name and the PEDef in the PEDecl in the DTD. Tests PEdecl with a required field missing. The PEDef is missing after the Name "paaa" in the PEDecl in the DTD. Tests PEdecl with wrong field ordering. The Name "paaa" occurs after the PEDef in the PEDecl in the DTD. Tests PEdecl with wrong field ordering. The "%" and the Name "paaa" occurs after the PEDef in the PEDecl in the DTD. Tests PEdecl with wrong key word. The string "entity" is used as the key word in the beginning sequence in the PEDecl in the DTD. Tests PEdecl with a required field missing. The closing bracket (greater than) is missing in the PEDecl in the DTD. Tests PEdecl with wrong closing sequence. The string "!(greater than)" is used as the closing sequence in the PEDecl in the DTD. Tests EntityDef with wrong field ordering. The NDataDecl "NDATA JPGformat" occurs before the ExternalID in the EntityDef in the EntityDecl. Tests EntityDef with a required field missing. The ExternalID is missing before the NDataDecl in the EntityDef in the EntityDecl. Tests PEDef with extra fields. The NDataDecl occurs after the ExternalID in the PEDef in the PEDecl in the DTD. Tests ExternalID with wrong key word. The string "system" is used as the key word in the ExternalID in the EntityDef in the EntityDecl. Tests ExternalID with wrong key word. The string "public" is used as the key word in the ExternalID in the doctypedecl. Tests ExternalID with wrong key word. The string "Public" is used as the key word in the ExternalID in the doctypedecl. Tests ExternalID with wrong field ordering. The key word "PUBLIC" occurs after the PublicLiteral and the SystemLiteral in the ExternalID in the doctypedecl. Tests ExternalID with a required field missing. The white space between "SYSTEM" and the Systemliteral is missing in the ExternalID in the EntityDef in the EntityDecl in the DTD. Tests ExternalID with a required field missing. The Systemliteral is missing after "SYSTEM" in the ExternalID in the EntityDef in the EntityDecl in the DTD. Tests ExternalID with a required field missing. The white space between the PublicLiteral and the Systemliteral is missing in the ExternalID in the doctypedecl. Tests ExternalID with a required field missing. The key word "PUBLIC" is missing in the ExternalID in the doctypedecl. Tests ExternalID with a required field missing. The white space between "PUBLIC" and the PublicLiteral is missing in the ExternalID in the doctypedecl. Tests ExternalID with a required field missing. The PublicLiteral is missing in the ExternalID in the doctypedecl. Tests ExternalID with a required field missing. The PublicLiteral is missing in the ExternalID in the doctypedecl. Tests ExternalID with a required field missing. The SystemLiteral is missing in the ExternalID in the doctypedecl. Tests ExternalID with wrong field ordering. The key word "PUBLIC" occurs after the PublicLiteral in the ExternalID in the doctypedecl. Tests NDataDecl with wrong key word. The string "ndata" is used as the key word in the NDataDecl in the EntityDef in the GEDecl. Tests NDataDecl with wrong key word. The string "NData" is used as the key word in the NDataDecl in the EntityDef in the GEDecl. Tests NDataDecl with a required field missing. The leading white space is missing in the NDataDecl in the EntityDef in the GEDecl. Tests NDataDecl with a required field missing. The key word "NDATA" is missing in the NDataDecl in the EntityDef in the GEDecl. Tests NDataDecl with a required field missing. The Name after the key word "NDATA" is missing in the NDataDecl in the EntityDef in the GEDecl. Tests NDataDecl with a required field missing. The white space between "NDATA" and the Name is missing in the NDataDecl in the EntityDef in the GEDecl. Tests NDataDecl with wrong field ordering. The key word "NDATA" occurs after the Name in the NDataDecl in the EntityDef in the GEDecl. Tests TextDecl with wrong field ordering. The VersionInfo occurs after the EncodingDecl in the TextDecl in the file "ibm77n01.ent". Tests TextDecl with wrong key word. The string "XML" is used in the beginning sequence in the TextDecl in the file "ibm77n02.ent". Tests TextDecl with wrong closing sequence. The character "greater than" is used as the closing sequence in the TextDecl in the file "ibm77n03.ent". Tests TextDecl with a required field missing. The closing sequence is missing in the TextDecl in the file "ibm77n04.ent". Tests extParsedEnt with wrong field ordering. The TextDecl occurs after the content in the file ibm78n01.ent. Tests extParsedEnt with extra field. A blank line occurs before the TextDecl in the file ibm78n02.ent. Tests extPE with wrong field ordering. The TextDecl occurs after the extSubsetDecl (the white space and the comment) in the file ibm79n01.ent. Tests extPE with extra field. A blank line occurs before the TextDecl in the file ibm78n02.ent. Tests EncodingDecl with a required field missing. The leading white space is missing in the EncodingDecl in the XMLDecl. Tests EncodingDecl with a required field missing. The "=" sign is missing in the EncodingDecl in the XMLDecl. Tests EncodingDecl with a required field missing. The double quoted EncName are missing in the EncodingDecl in the XMLDecl. Tests EncodingDecl with wrong field ordering. The string "encoding=" occurs after the double quoted EncName in the EncodingDecl in the XMLDecl. Tests EncodingDecl with wrong field ordering. The "encoding" occurs after the double quoted EncName in the EncodingDecl in the XMLDecl. Tests EncodingDecl with wrong key word. The string "Encoding" is used as the key word in the EncodingDecl in the XMLDecl. Tests EncName with an illegal character. The "_" is used as the first character in the EncName in the EncodingDecl in the XMLDecl. Tests EncName with an illegal character. The "-" is used as the first character in the EncName in the EncodingDecl in the XMLDecl. Tests EncName with an illegal character. The "." is used as the first character in the EncName in the EncodingDecl in the XMLDecl. Tests EncName with illegal characters. The "8-" is used as the initial characters in the EncName in the EncodingDecl in the XMLDecl. Tests EncName with an illegal character. The "~" is used as one character in the EncName in the EncodingDecl in the XMLDecl. Tests EncName with an illegal character. The "#" is used as one character in the EncName in the EncodingDecl in the XMLDecl. Tests EncName with an illegal character. The ":" is used as one character in the EncName in the EncodingDecl in the XMLDecl. Tests EncName with an illegal character. The "/" is used as one character in the EncName in the EncodingDecl in the XMLDecl. Tests EncName with an illegal character. The ";" is used as one character in the EncName in the EncodingDecl in the XMLDecl. Tests NotationDecl with a required field missing. The white space after the beginning sequence of the NotationDecl is missing in the DTD. Tests NotationDecl with a required field missing. The Name in the NotationDecl is missing in the DTD. Tests NotationDecl with a required field missing. The externalID or the PublicID is missing in the NotationDecl in the DTD. Tests NotationDecl with wrong field ordering. The Name occurs after the "SYSTEM" and the externalID in the NotationDecl in the DTD. Tests NotationDecl with wrong key word. The string "notation" is used as a key word in the NotationDecl in the DTD. Tests NotationDecl with a required field missing. The closing bracket (the greater than character) is missing in the NotationDecl. Tests NotationDecl with wrong beginning sequence. The "!" is missing in the beginning sequence in the NotationDecl in the DTD. Tests NotationDecl with wrong closing sequence. The extra "!" occurs in the closing sequence in the NotationDecl in the DTD. Tests PublicID with wrong key word. The string "public" is used as the key word in the PublicID in the NotationDcl in the DTD. Tests PublicID with wrong key word. The string "Public" is used as the key word in the PublicID in the NotationDcl in the DTD. Tests PublicID with a required field missing. The key word "PUBLIC" is missing in the PublicID in the NotationDcl in the DTD. Tests PublicID with a required field missing. The white space between the "PUBLIC" and the PubidLiteral is missing in the PublicID in the NotationDcl in the DTD. Tests PublicID with a required field missing. The PubidLiteral is missing in the PublicID in the NotationDcl in the DTD. Tests PublicID with wrong field ordering. The key word "PUBLIC" occurs after the PubidLiteral in the PublicID in the NotationDcl. Tests BaseChar with an illegal character. The character #x00D7 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x00F7 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0132 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0133 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x013F occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0140 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0149 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x017F occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x01c4 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x01CC occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0BB6 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0BBA occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0C0D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0C11 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0C29 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0C34 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0C5F occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0C62 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0C8D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0C91 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x01F1 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0CA9 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0CB4 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0CBA occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0CDF occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0CE2 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0D0D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0D11 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0D29 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0D3A occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0D62 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x01F3 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E2F occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E31 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E34 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E46 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E83 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E85 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E89 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E8B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E8E occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0E98 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x01F6 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EA0 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EA4 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EA6 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EA8 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EAC occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EAF occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EB1 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EB4 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EBE occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0EC5 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x01F9 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0F48 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0F6A occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x10C6 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x10F7 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1011 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1104 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1108 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x110A occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x110D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x113B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x01F9 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x113F occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1141 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x114D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x114f occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1151 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1156 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x115A occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1162 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1164 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1166 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0230 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x116B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x116F occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1174 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x119F occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x11AC occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x11B6 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x11B9 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x11BB occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x11C3 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x11F1 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x02AF occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x11FA occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1E9C occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1EFA occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1F16 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1F1E occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1F46 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1F4F occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1F58 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1F5A occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1F5C occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x02CF occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1F5E occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #xF17E occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FB5 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FBD occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FBF occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FC5 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FCD occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FD5 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FDC occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FED occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0387 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FF5 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x1FFD occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x2127 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x212F occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x2183 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x3095 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x30FB occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x312D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #xD7A4 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x038B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x03A2 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x03CF occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x03D7 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x03DD occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x03E1 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x03F4 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x040D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0450 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x045D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0482 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x04C5 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x04C6 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x04C9 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x04EC occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x04ED occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x04F6 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x04FA occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0557 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0558 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0587 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x05EB occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x05F3 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0620 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x063B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x064B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x06B8 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x06BF occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x06CF occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x06D4 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x06D6 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x06E7 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x093A occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x093E occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0962 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x098D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0991 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0992 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x09A9 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x09B1 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x09B5 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x09BA occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x09DE occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x09E2 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x09F2 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A0B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A11 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A29 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A31 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A34 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A37 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A3A occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A5B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A70 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A75 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0ABC occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0A92 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0AA9 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0AB1 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0AB4 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0ABA occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B04 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B0D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B11 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B29 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B31 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B34 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B3A occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B3E occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B5E occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B62 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B8B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B91 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B98 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B9B occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0B9D occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0BA0 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0BA7 occurs as the first character of the PITarget in the PI in the DTD. Tests BaseChar with an illegal character. The character #x0BAB occurs as the first character of the PITarget in the PI in the DTD. Tests Ideographic with an illegal character. The character #x4CFF occurs as the first character in the PITarget in the PI in the DTD. Tests Ideographic with an illegal character. The character #x9FA6 occurs as the first character in the PITarget in the PI in the DTD. Tests Ideographic with an illegal character. The character #x3008 occurs as the first character in the PITarget in the PI in the DTD. Tests Ideographic with an illegal character. The character #x302A occurs as the first character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x02FF occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0346 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0362 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0487 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x05A2 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x05BA occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x05BE occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x05C0 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x05C3 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0653 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x06B8 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x06B9 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x06E9 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x06EE occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0904 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x093B occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x094E occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0955 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0964 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0984 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x09C5 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x09C9 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x09CE occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x09D8 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x09E4 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0A03 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0A3D occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0A46 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0A49 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0A4E occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0A80 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0A84 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0ABB occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0AC6 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0ACA occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0ACE occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0B04 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0B3B occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0B44 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0B4A occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0B4E occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0B58 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0B84 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0BC3 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0BC9 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0BD6 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0C0D occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0C45 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0C49 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0C54 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0C81 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0C84 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0CC5 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0CC9 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0CD4 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0CD7 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0D04 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0D45 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0D49 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0D4E occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0D58 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0E3F occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0E3B occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0E4F occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0EBA occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0EBE occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0ECE occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F1A occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F36 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F38 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F3B occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F3A occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F70 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F85 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F8C occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F96 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0F98 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0FB0 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0FB8 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x0FBA occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x20DD occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x20E2 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x3030 occurs as the second character in the PITarget in the PI in the DTD. Tests CombiningChar with an illegal character. The character #x309B occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0029 occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x003B occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x066A occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x06FA occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0970 occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x09F2 occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0AF0 occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0B70 occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0C65 occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0CE5 occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0CF0 occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0D70 occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0E5A occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0EDA occurs as the second character in the PITarget in the PI in the DTD. Tests Digit with an illegal character. The character #x0F2A occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x00B6 occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x00B8 occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x02D2 occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x03FE occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x065F occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x0EC7 occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x3006 occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x3030 occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x3036 occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x309C occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x309F occurs as the second character in the PITarget in the PI in the DTD. Tests Extender with an illegal character. The character #x30FF occurs as the second character in the PITarget in the PI in the DTD. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/ibm_oasis_readme.txt0000644006511100651110000000347110504340457026605 0ustar rossross1. Introduction This test suite is contributed by the testing team in the IBM Java Technology Center and used for the conformance test on the XML parsers based on XML 1.0 Specification. 2. Test Suite Structure This XML conformance test suite consists of 149 valid tests, 51 invalid tests, and 746 not-well-formed tests. The configure files "ibm_oasis_valid.xml", "ibm_oasis_invalid.xml", and "ibm_oasis_not-wf.xml" are located in a directory called "ibm". All test cases are in the directory tree starting from "ibm" as shown below: ibm _______________________|_______________________ | | | valid invalid not-wf _______|______ ______|_______ ______|_______ | | | | | | | | | P01 P02 ...... P89 P28 P29 ...... P76 P01 P02 ...... P89 __|__ | | out ibm01v01.xml ...... | ibm01v01.xml 3. File Naming Style The naming for a XML test cases follows the general form ibmXXYZZ.xml where XX is the number of XML production to be tested, Y is the character which indicates the test type (v: valid, i: invalid, n: not-wf), ZZ is the test case order number for the same XML production. For instance, ibm85n98.xml means that it is an IBM not-well-formed test case number 98 for testing XML production 85. 4. Test Coverage The XML test cases are designed based on the test patterns created according to the syntax rules and the WFC/VC constraints specified in each XML 1.0 production. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/ibm/ibm_oasis_valid.xml0000644006511100651110000012212610504340457026427 0ustar rossross Tests with a xml document consisting of prolog followed by element then Misc This test case covers legal character ranges plus discrete legal characters for production 02. Tests all 4 legal white space characters - #x20 #x9 #xD #xA Empty EntityValue is legal Tests a normal EnitityValue Tests EnitityValue referencing a Parameter Entity Tests EnitityValue referencing a General Entity Tests EnitityValue with combination of GE, PE and text, the GE used is declared in the student.dtd Tests empty AttValue with double quotes as the delimiters Tests empty AttValue with single quotes as the delimiters Test AttValue with double quotes as the delimiters and single quote inside Test AttValue with single quotes as the delimiters and double quote inside Test AttValue with a GE reference and double quotes as the delimiters Test AttValue with a GE reference and single quotes as the delimiters testing AttValue with mixed references and text content in double quotes testing AttValue with mixed references and text content in single quotes Tests empty systemliteral using the double quotes Tests empty systemliteral using the single quotes Tests regular systemliteral using the single quotes Tests regular systemliteral using the double quotes Tests empty systemliteral using the double quotes Tests empty systemliteral using the single quotes Tests regular systemliteral using the double quotes Tests regular systemliteral using the single quotes Testing PubidChar with all legal PubidChar in a PubidLiteral Testing CharData with empty string Testing CharData with white space character Testing CharData with a general text string Tests empty comment Tests comment with regular text Tests comment with one dash inside Tests comment with more comprehensive content Tests PI definition with only PItarget name and nothing else Tests PI definition with only PItarget name and a white space Tests PI definition with PItarget name and text that contains question mark and right angle Tests PITarget name Tests CDSect with CDStart CData CDEnd Tests CDStart Tests CDATA with empty string Tests CDATA with regular content Tests CDEnd Tests prolog with XMLDecl and doctypedecl Tests prolog with doctypedecl Tests prolog with Misc doctypedecl Tests prolog with doctypedecl Misc Tests prolog with XMLDecl Misc doctypedecl Tests prolog with XMLDecl doctypedecl Misc Tests prolog with XMLDecl Misc doctypedecl Misc Tests XMLDecl with VersionInfo only Tests XMLDecl with VersionInfo EncodingDecl Tests XMLDecl with VersionInfo SDDecl Tests XMLDecl with VerstionInfo and a trailing whitespace char Tests XMLDecl with VersionInfo EncodingDecl SDDecl Tests XMLDecl with VersionInfo EncodingDecl SDDecl and a trailing whitespace Tests VersionInfo with single quote Tests VersionInfo with double quote Tests EQ with = Tests EQ with = and spaces on both sides Tests EQ with = and space in front of it Tests EQ with = and space after it Tests VersionNum 1.0 Tests Misc with comment Tests Misc with PI Tests Misc with white spaces Tests doctypedecl with internal DTD only Tests doctypedecl with external subset and combinations of different markup declarations and PEReferences Tests markupdecl with combinations of elementdecl, AttlistDecl,EntityDecl, NotationDecl, PI and comment Tests WFC: PE in internal subset as a positive test Tests extSubset with extSubsetDecl only in the dtd file Tests extSubset with TextDecl and extSubsetDecl in the dtd file Tests extSubsetDecl with combinations of markupdecls, conditionalSects, PEReferences and white spaces Tests VC: Standalone Document Declaration with absent attribute that has default value and standalone is no Tests VC: Standalone Document Declaration with external entity reference and standalone is no Tests VC: Standalone Document Declaration with attribute values that need to be normalized and standalone is no Tests VC: Standalone Document Declaration with whitespace in mixed content and standalone is no Tests LanguageID with Langcode - Subcode Duplicate Test as ibm33v01.xml Tests ISO639Code Tests IanaCode Tests UserCode Tests SubCode Tests element with EmptyElemTag and STag content Etag, also tests the VC: Element Valid with elements that have children, Mixed and ANY contents Tests STag with possible combinations of its fields, also tests WFC: Unique Att Spec. Tests Attribute with Name Eq AttValue and VC: Attribute Value Type Tests ETag with possible combinations of its fields Tests content with all possible constructs: element, CharData, Reference, CDSect, Comment Tests EmptyElemTag with possible combinations of its fields Tests both P45 elementDecl and P46 contentspec with possible combinations of their constructs Tests all possible children,cp,choice,seq patterns in P47,P48,P49,P50 Tests VC:Proper Group/PE Nesting with PEs of choices that are properly nested with parenthesized groups in external subsets Tests VC:Proper Group/PE Nesting with PEs of seq that are properly nested with parenthesized groups in external subsets Tests Mixed with possible combinations of its fields amd VC: No Duplicate Types Tests VC:Proper Group/PE Nesting with PEs of Mixed that are properly nested with parenthesized groups in external subsets Tests all AttlistDecl and AttDef Patterns in P52 and P53 Tests all AttTypes : StringType, TokenizedTypes, EnumeratedTypes in P55,P56,P57,P58,P59. Also tests all DefaultDecls in P60. Tests all AttTypes : StringType, TokenizedType, EnumeratedTypes in P55,P56,P57. Tests AttTypes with StringType in P55. Tests StringType for P55. The "CDATA" occurs in the StringType for the attribute "att" for the element "a". Tests TokenizedType for P56. The "ID", "IDREF", "IDREFS", "ENTITY", "ENTITIES", "NMTOKEN", and "NMTOKENS" occur in the TokenizedType for the attribute "attr". Tests TokenizedType for P56 VC: ID Attribute Default. The value "AC1999" is assigned to the ID attribute "attr" with "#REQUIRED" in the DeaultDecl. Tests TokenizedType for P56 VC: ID Attribute Default. The value "AC1999" is assigned to the ID attribute "attr" with "#IMPLIED" in the DeaultDecl. Tests TokenizedType for P56 VC: ID. The ID attribute "UniqueName" appears only once in the document. Tests TokenizedType for P56 VC: One ID per element type. The element "a" or "b" has only one ID attribute. Tests TokenizedType for P56 VC: IDREF. The IDREF value "AC456" matches the value assigned to an ID attribute "UniqueName". Tests TokenizedType for P56 VC: IDREF. The IDREFS value "AC456 Q123" matches the values assigned to the ID attribute "UniqueName" and "Uname". Tests TokenizedType for P56 VC: Entity Name. The value "image" of the ENTITY attribute "sun" matches the name of an unparsed entity declared. Tests TokenizedType for P56 VC: Name Token. The value of the NMTOKEN attribute "thistoken" matches the Nmtoken production. Tests TokenizedType for P56 VC: Name Token. The value of the NMTOKENS attribute "thistoken" matches the Nmtoken production. Tests EnumeratedType in the AttType. The attribute "att" has a type (a|b) with the element "a". the Tests NotationType for P58. It shows different patterns fro the NOTATION attribute "attr". Tests NotationType for P58: Notation Attributes. The value "base64" of the NOTATION attribute "attr" matches one of the notation names declared. Tests Enumeration in the EnumeratedType for P59. It shows different patterns for the Enumeration attribute "attr". Tests Enumeration for P59 VC: Enumeration. The value "one" of the Enumeration attribute "attr" matches one of the element names declared. Tests DefaultDecl for P60. It shows different options "#REQUIRED", "#FIXED", "#IMPLIED", and default for the attribute "chapter". Tests DefaultDecl for P60 VC: Required Attribute. In the element "one" and "two" the value of the #REQUIRED attribute "chapter" is given. Tests DefaultDecl for P60 VC: Fixed Attribute Default. The value of the #FIXED attribute "chapter" is exactly the same as the default value. Tests DefaultDecl for P60 VC: Attribute Default Legal. The default value specified for the attribute "attr" meets the lexical constraints of the declared attribute type. Tests conditionalSect for P61. It takes the option "invludeSect" in the file ibm61v01.dtd. Tests conditionalSect for P61. It takes the option "ignoreSect" in the file ibm61v02.dtd. Tests includeSect for P62. The white space is not included before the key word "INCLUDE" in the beginning sequence. Tests includeSect for P62. The white space is not included after the key word "INCLUDE" in the beginning sequence. Tests includeSect for P62. The white space is included after the key word "INCLUDE" in the beginning sequence. Tests includeSect for P62. The white space is included before the key word "INCLUDE" in the beginning sequence. Tests includeSect for P62. The extSubsetDecl is not included. Tests ignoreSect for P63. The white space is not included before the key word "IGNORE" in the beginning sequence. Tests ignoreSect for P63. The white space is not included after the key word "IGNORE" in the beginning sequence. Tests ignoreSect for P63. The white space is included after the key word "IGNORE" in the beginning sequence. Tests ignoreSect for P63. The ignireSectContents is included. Tests ignoreSect for P63. The white space is included before and after the key word "IGNORE" in the beginning sequence. Tests ignoreSectContents for P64. One "ignore" field is included. Tests ignoreSectContents for P64. Two "ignore" and one "ignoreSectContents" fields are included. Tests ignoreSectContents for P64. Four "ignore" and three "ignoreSectContents" fields are included. Tests Ignore for P65. An empty string occurs in the Ignore filed. Tests Ignore for P65. An string not including the brackets occurs in each of the Ignore filed. Tests all legal CharRef's. Tests Reference could be EntityRef or CharRef. Tests P68 VC:Entity Declared with Entities in External Subset , standalone is no Tests P68 VC:Entity Declared with Entities in External Parameter Entities , standalone is no Tests P68 VC:Entity Declared with Parameter Entities in External Subset , standalone is no Tests P68 VC:Entity Declared with Parameter Entities in External Parameter Entities, standalone is no Tests all legal GEDecls and PEDecls constructs derived from P70-76 Tests ExtParsedEnt, also TextDecl in P77 and EncodingDecl in P80 Tests extPE Tests NotationDecl in P82 and PublicID in P83 This test case covers 149 legal character ranges plus 51 single legal characters for BaseChar in P85 using a PI target Name This test case covers 2 legal character ranges plus 1 single legal characters for IdeoGraphic in P86 using a PI target Name This test case covers 65 legal character ranges plus 30 single legal characters for CombiningChar in P87 using a PI target Name This test case covers 15 legal character ranges for Digit in P88 using a PI target Name This test case covers 3 legal character ranges plus 8 single legal characters for Extender in P89 using a PI target Name hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/0000755006511100651110000000000010504340462023570 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/pr-xml-utf-8.xml0000644006511100651110000062450410504340462026505 0ustar rossross "> '"> amp, lt, gt, apos, quot"> ]>
æ‹¡å¼µå¯èƒ½ãª&markup;言語 (XML) 第1.0&version; PR-xml-&iso6.doc.date; World Wide Web Consortium &draft.day;&draft.month;&draft.year;

ã“ã®è‰æ¡ˆã¯ï¼ŒXML WGåŠã³ä»–ã®é–¢ä¿‚者ã«ã‚ˆã‚‹ãƒ¬ãƒ“ューã®ãŸã‚ã®ã‚‚ã®ã§ã‚ã£ã¦ï¼Œå…¬é–‹ã®è­°è«–ã®ãŸã‚ã®ã‚‚ã®ã§ã¯ãªã„。

http://www.w3.org/TR/PR-xml-&iso6.doc.date; http://www.w3.org/TR/WD-xml-961114 http://www.w3.org/TR/WD-xml-lang-970331 http://www.w3.org/TR/WD-xml-lang-970630 http://www.w3.org/TR/WD-xml-970807 http://www.w3.org/TR/WD-xml-971117 Tim Bray Textuality and Netscape tbray@textuality.com Jean Paoli Microsoft jeanpa@microsoft.com C. M. Sperberg-McQueen University of Illinois at Chicago cmsmcq@uic.edu

ã“ã®&TR-or-Rec;ã¯, 1997å¹´12月ã«World Wide Web Consortiumã‹ã‚‰ 公表ã•ã‚ŒãŸå‹§å‘Šæ¡ˆExtensible Markup Language version第1.0版を翻訳ã—, 技 術的内容を変更ã™ã‚‹ã“ã¨ãªã作æˆã—ãŸ&TR-or-Rec;ã§ã‚る。This &eTR-or-Rec; is a translation of the XML proposed recommendation 1.0 published by the World Wide Web Consortium in December 1997. It is intended that &eTR-or-Rec; is technically identical to the original.

原文ã«ã‚ã‚‹ã€è‘—作権ã«é–¢ã—ã¦ã®è¨˜è¿°ã‚’次ã«ç¤ºã™ã€‚The original copyright notice is shown below:

ã“ã®ç‰ˆã®XMLã®è¦å®šã¯ï¼Œå…¬é–‹ãƒ¬ãƒ“ューåŠã³è­°è«–ã‚’ 目的ã¨ã™ã‚‹ã€‚テキストåŠã³æ³•å¾‹ä¸Šã®æ³¨æ„を改変ã—ãªã„é™ã‚Šï¼Œè‡ªç”±ã« é…布ã—ã¦ã‚‚よã„。This version of the XML specification is for public review and discussion. It may be distributed freely, as long as all text and legal notices remain intact.

ã“ã®&TR-or-Rec;ã®å…ƒã¨ãªã£ãŸXML勧告案ã¯ï¼Œ1998å¹´2月ã«World Wide Web Consortiumã‹ã‚‰å…¬è¡¨ã•ã‚ŒãŸXML勧告ã«ã‚ˆã£ã¦ã™ã§ã«ç½®ãæ› ãˆã‚‰ã‚Œã¦ã„る。ã“ã®æ¨™æº–情報ã¯ï¼ŒXML勧告ã«å¾“ã£ã¦è¨‚æ­£ã™ã‚‹ã“ã¨ã‚’ 予定ã—ã¦ã„る。The XML Proposed Recommendation is superseded by the XML Recommendation which was published by the World Wide Web Consortium in February 1998. It is intended that this &eTR-or-Rec; be revised accordingly in the near future.

ã“ã®&TR-or-Rec;ã¯ï¼Œå®‰å®šã—ãŸã‚‚ã®ã§ã‚ã£ã¦ï¼Œæ˜¨å¹´æ¥ã®XML活動を通ã˜ã¦ä½œæˆã•ã‚ŒãŸï¼Œä¸€é€£ã®ä½œ 業è‰æ¡ˆã‚’å…ƒã¨ã™ã‚‹ã€‚ç¾åœ¨ï¼Œåºƒç¯„囲ã«ä½¿ç”¨ã•ã‚Œã¦ã„る国際的ãªãƒ†ã‚­ã‚¹ãƒˆå‡¦ç†ã®æ¨™ 準(標準一般化&markup;言語，Standard Generalized Markup Language, ISO 8879:1986ã«è¿½åŠ åŠã³è¨‚正を加ãˆãŸã‚‚ã®)ã®ï¼ŒWWW上ã§ã®ä½¿ç”¨ã®ãŸã‚ã«⊂ 化ã—ãŸè¨€èªžã‚’，ã“ã®&TR-or-Rec;ã¯ï¼Œè¦å®šã™ã‚‹ã€‚ISO 8879ã®ã©ã®æ©Ÿèƒ½ã‚’ã“ã® ⊂ã«æ®‹ã™ã‹ï¼Œã¨ã„ã†æ±ºå®šã«ã¤ã„ã¦ã®è©³ç´°ã¯ï¼Œåˆ¥é€”用æ„ã™ã‚‹ã€‚XMLã¯ï¼Œ æ—¢ã«ã„ãã¤ã‹ã®å•†å“ã§ã‚µãƒãƒ¼ãƒˆã•ã‚Œï¼ŒXMLをサãƒãƒ¼ãƒˆã™ã‚‹ãƒ•ãƒªãƒ¼ã‚¦ã‚§ã‚¢ã®æ•°ã‚‚増ãˆã¦ ã„る。XMLã«é–¢ã™ã‚‹å…¬é–‹ã®è«–議も，オンラインã§å…¥æ‰‹ã§ãる。It is a stable document derived from a series of working drafts produced over the last year as deliverables of the XML activity. It specifies a language created by subsetting an existing, widely used international text processing standard (Standard Generalized Markup Language, ISO 8879:1986 as amended and corrected) for use on the World Wide Web. Details of the decisions regarding which features of ISO 8879 to retain in the subset are available separately. XML is already supported by some commercial products, and there are a growing number of free implementations. Public discussions of XML are accessible online.

ã“ã®&TR-or-Rec;ã§ã¯ï¼Œã«å®šç¾©ã™ã‚‹ URI(Uniform Resource Identifier)を使用ã™ã‚‹ã€‚URIã®åˆ¶å®šä½œæ¥­ã¯é€²è¡Œä¸­ã§ã‚㣠ã¦ï¼ŒåŠã³ã‚’æ›´æ–°ã™ã‚‹äºˆå®šã¨ ãªã£ã¦ã„る。ã“ã®ä½œæ¥­ãŒRFCã¨ã—ã¦å—ã‘入れられãªã„å ´åˆã¯ï¼Œã“ã®è¦ç¨‹å†…ã®URI ã¸ã®å‚ç…§ã¯ï¼ŒURL(Uniform Resource Locator)ã¸ã®å‚ç…§ã«ä»£ã‚る。This specification uses the term URI, which is defined by , a work in progress expected to update and . Should the work not be accepted as an RFC, the references to uniform resource identifiers (URIs) in this specification will become references to uniform resource locators (URLs).

XMLã®ä»•æ§˜ã«æº–æ‹ ã—ã¦ã„ã‚‹ã‹ã©ã†ã‹ã®åŸºæº–ã¨ãªã‚‹ã¯W3Cã®ã‚µã‚¤ãƒˆã«ã‚ る原文ã§ã‚る。The normative version of the specification is the English version found at the W3C site.

ã“ã®æ¨™æº–情報ã¯åŽŸä»•æ§˜ã¨æŠ€è¡“çš„ã«åŒä¸€ã§ã‚ã‚‹ã“ã¨ã‚’æ„図ã—ã¦ã„ã‚‹ãŒã€ 翻訳上ã®èª¤ã‚Šã¯ã‚り得る。Although this technical report is intended to be technically identical to the original, it may contain errors from the translation.

備考: 原è¦å®šã¨ã®è¦å®šç®‡æ‰€ã®å¯¾å¿œé–¢ä¿‚を明らã‹ã«ã™ã‚‹ãŸã‚ã€ã“ã® &TR-or-Rec;ã®ç¯€æ§‹æˆåŠã³ç¯€ç•ªå·ã¯ã€åŽŸè¦å®šã®ãれらをã§ãã‚‹ã ã‘ä¿å­˜ã—ã¦ã„ る。ã“ã®&TR-or-Rec;ã®Web版ã¯ã€åŽŸè¦å®šã®HTMLã‚¿ã‚°ã‚’ãã®ã¾ã¾ä¿å­˜ã—ã¦ã„る。

æ‹¡å¼µå¯èƒ½ãª&markup;言語(XML)ã¯SGMLã®ç°¡å˜ãªæ–¹è¨€ã§ã‚ã£ã¦ï¼Œã“ã®&TR-or-Rec;ã§ï¼Œãã®ã™ã¹ã¦ã‚’è¦å®šã™ã‚‹ã€‚XMLã®ç›®æ¨™ã¯ï¼Œç¾åœ¨ã®HTMLã¨åŒæ§˜ã«ï¼Œä¸€èˆ¬æ€§ã®ã‚ã‚‹SGMLをウェブ上ã§é…布，å—ä¿¡åŠã³å‡¦ç†ã§ãã‚‹ã“ã¨ã¨ã™ã‚‹ã€‚XMLã¯å®Ÿè£…ãŒå®¹æ˜“ã§ã‚ã£ã¦ï¼ŒSGMLåŠã³HTMLã®ã©ã¡ã‚‰ã«å¯¾ã—ã¦ã‚‚相互é‹ç”¨æ€§ã‚’ä¿ã¤è¨­è¨ˆãŒãªã•ã‚Œã¦ã„る。

Chicago, Vancouver, Mountain View, et al.: World-Wide Web Consortium, XML作業グループ, 1996, 1997.

Created in electronic form.

 English Extended Backus-Naur Form (formal grammar) 1997-12-03 : CMSMcQ : yet further changes 1997-12-02 : TB : further changes (see TB to XML WG, 2 December 1997) 1997-12-02 : CMSMcQ : deal with as many corrections and comments from the proofreaders as possible: entify hard-coded document date in pubdate element, change expansion of entity WebSGML, update status description as per Dan Connolly (am not sure about refernece to Berners-Lee et al.), add 'The' to abstract as per WG decision, move Relationship to Existing Standards to back matter and combine with References, re-order back matter so normative appendices come first, re-tag back matter so informative appendices are tagged informdiv1, remove XXX XXX from list of 'normative' specs in prose, move some references from Other References to Normative References, add RFC 1738, 1808, and 2141 to Other References (they are not normative since we do not require the processor to enforce any rules based on them), add reference to 'Fielding draft' (Berners-Lee et al.), move notation section to end of body, drop URIchar non-terminal and use SkipLit instead, lose stray reference to defunct nonterminal 'markupdecls', move reference to Aho et al. into appendix (Tim's right), add prose note saying that hash marks and fragment identifiers are NOT part of the URI formally speaking, and are NOT legal in system identifiers (processor 'may' signal an error). Work through: Tim Bray reacting to James Clark, Tim Bray on his own, Eve Maler, NOT DONE YET: change binary / text to unparsed / parsed. handle James's suggestion about < in attriubte values uppercase hex characters, namechar list, 1997-12-01 : JB : add some column-width parameters 1997-12-01 : CMSMcQ : begin round of changes to incorporate recent WG decisions and other corrections: binding sources of character encoding info (27 Aug / 3 Sept), correct wording of Faust quotation (restore dropped line), drop SDD from EncodingDecl, change text at version number 1.0, drop misleading (wrong!) sentence about ignorables and extenders, modify definition of PCData to make bar on msc grammatical, change grammar's handling of internal subset (drop non-terminal markupdecls), change definition of includeSect to allow conditional sections, add integral-declaration constraint on internal subset, drop misleading / dangerous sentence about relationship of entities with system storage objects, change table body tag to htbody as per EM change to DTD, add rule about space normalization in public identifiers, add description of how to generate our name-space rules from Unicode character database (needs further work!). 1997-10-08 : TB : Removed %-constructs again, new rules for PE appearance. 1997-10-01 : TB : Case-sensitive markup; cleaned up element-type defs, lotsa little edits for style 1997-09-25 : TB : Change to elm's new DTD, with substantial detail cleanup as a side-effect 1997-07-24 : CMSMcQ : correct error (lost *) in definition of ignoreSectContents (thanks to Makoto Murata) Allow all empty elements to have end-tags, consistent with SGML TC (as per JJC). 1997-07-23 : CMSMcQ : pre-emptive strike on pending corrections: introduce the term 'empty-element tag', note that all empty elements may use it, and elements declared EMPTY must use it. Add WFC requiring encoding decl to come first in an entity. Redefine notations to point to PIs as well as binary entities. Change autodetection table by removing bytes 3 and 4 from examples with Byte Order Mark. Add content model as a term and clarify that it applies to both mixed and element content. 1997-06-30 : CMSMcQ : change date, some cosmetic changes, changes to productions for choice, seq, Mixed, NotationType, Enumeration. Follow James Clark's suggestion and prohibit conditional sections in internal subset. TO DO: simplify production for ignored sections as a result, since we don't need to worry about parsers which don't expand PErefs finding a conditional section. 1997-06-29 : TB : various edits 1997-06-29 : CMSMcQ : further changes: Suppress old FINAL EDIT comments and some dead material. Revise occurrences of % in grammar to exploit Henry Thompson's pun, especially markupdecl and attdef. Remove RMD requirement relating to element content (?). 1997-06-28 : CMSMcQ : Various changes for 1 July draft: Add text for draconian error handling (introduce the term Fatal Error). RE deleta est (changing wording from original announcement to restrict the requirement to validating parsers). Tag definition of validating processor and link to it. Add colon as name character. Change def of %operator. Change standard definitions of lt, gt, amp. Strip leading zeros from #x00nn forms. 1997-04-02 : CMSMcQ : final corrections of editorial errors found in last night's proofreading. Reverse course once more on well-formed: Webster's Second hyphenates it, and that's enough for me. 1997-04-01 : CMSMcQ : corrections from JJC, EM, HT, and self 1997-03-31 : Tim Bray : many changes 1997-03-29 : CMSMcQ : some Henry Thompson (on entity handling), some Charles Goldfarb, some ERB decisions (PE handling in miscellaneous declarations. Changed Ident element to accept def attribute. Allow normalization of Unicode characters. move def of systemliteral into section on literals. 1997-03-28 : CMSMcQ : make as many corrections as possible, from Terry Allen, Norbert Mikula, James Clark, Jon Bosak, Henry Thompson, Paul Grosso, and self. Among other things: give in on "well formed" (Terry is right), tentatively rename QuotedCData as AttValue and Literal as EntityValue to be more informative, since attribute values are the only place QuotedCData was used, and vice versa for entity text and Literal. (I'd call it Entity Text, but 8879 uses that name for both internal and external entities.) 1997-03-26 : CMSMcQ : resynch the two forks of this draft, reapply my changes dated 03-20 and 03-21. Normalize old 'may not' to 'must not' except in the one case where it meant 'may or may not'. 1997-03-21 : TB : massive changes on plane flight from Chicago to Vancouver 1997-03-21 : CMSMcQ : correct as many reported errors as possible. 1997-03-20 : CMSMcQ : correct typos listed in CMSMcQ hand copy of spec. 1997-03-20 : CMSMcQ : cosmetic changes preparatory to revision for WWW conference April 1997: restore some of the internal entity references (e.g. to docdate, etc.), change character xA0 to &nbsp; and define nbsp as &#160;, and refill a lot of paragraphs for legibility. 1996-11-12 : CMSMcQ : revise using Tim's edits: Add list type of NUMBERED and change most lists either to BULLETS or to NUMBERED. Suppress QuotedNames, Names (not used). Correct trivial-grammar doc type decl. Rename 'marked section' as 'CDATA section' passim. Also edits from James Clark: Define the set of characters from which [^abc] subtracts. Charref should use just [0-9] not Digit. Location info needs cleaner treatment: remove? (ERB question). One example of a PI has wrong pic. Clarify discussion of encoding names. Encoding failure should lead to unspecified results; don't prescribe error recovery. Don't require exposure of entity boundaries. Ignore white space in element content. Reserve entity names of the form u-NNNN. Clarify relative URLs. And some of my own: Correct productions for content model: model cannot consist of a name, so "elements ::= cp" is no good. 1996-11-11 : CMSMcQ : revise for style. Add new rhs to entity declaration, for parameter entities. 1996-11-10 : CMSMcQ : revise for style. Fix / complete section on names, characters. Add sections on parameter entities, conditional sections. Still to do: Add compatibility note on deterministic content models. Finish stylistic revision. 1996-10-31 : TB : Add Entity Handling section 1996-10-30 : TB : Clean up term & termdef. Slip in ERB decision re EMPTY. 1996-10-28 : TB : Change DTD. Implement some of Michael's suggestions. Change comments back to //. Introduce language for XML namespace reservation. Add section on white-space handling. Lots more cleanup. 1996-10-24 : CMSMcQ : quick tweaks, implement some ERB decisions. Characters are not integers. Comments are /* */ not //. Add bibliographic refs to 10646, HyTime, Unicode. Rename old Cdata as MsData since it's only seen in marked sections. Call them attribute-value pairs not name-value pairs, except once. Internal subset is optional, needs '?'. Implied attributes should be signaled to the app, not have values supplied by processor. 1996-10-16 : TB : track down & excise all DSD references; introduce some EBNF for entity declarations. 1996-10-?? : TB : consistency check, fix up scraps so they all parse, get formatter working, correct a few productions. 1996-10-10/11 : CMSMcQ : various maintenance, stylistic, and organizational changes: Replace a few literals with xmlpio and pic entities, to make them consistent and ensure we can change pic reliably when the ERB votes. Drop paragraph on recognizers from notation section. Add match, exact match to terminology. Move old 2.2 XML Processors and Apps into intro. Mention comments, PIs, and marked sections in discussion of delimiter escaping. Streamline discussion of doctype decl syntax. Drop old section of 'PI syntax' for doctype decl, and add section on partial-DTD summary PIs to end of Logical Structures section. Revise DSD syntax section to use Tim's subset-in-a-PI mechanism. 1996-10-10 : TB : eliminate name recognizers (and more?) 1996-10-09 : CMSMcQ : revise for style, consistency through 2.3 (Characters) 1996-10-09 : CMSMcQ : re-unite everything for convenience, at least temporarily, and revise quickly 1996-10-08 : TB : first major homogenization pass 1996-10-08 : TB : turn "current" attribute on div type into CDATA 1996-10-02 : TB : remould into skeleton + entities 1996-09-30 : CMSMcQ : add a few more sections prior to exchange with Tim. 1996-09-20 : CMSMcQ : finish transcribing notes. 1996-09-19 : CMSMcQ : begin transcribing notes for draft. 1996-09-13 : CMSMcQ : made outline from notes of 09-06, do some housekeeping
一般事項

æ‹¡å¼µå¯èƒ½ãª&markup;言語XML(eXtensible Markup Language)ã¯ï¼ŒXML文書ã¨ã„ã†ãƒ‡ãƒ¼ã‚¿ã‚ªãƒ–ジェクトã®ã‚¯ãƒ©ã‚¹ã‚’è¦å®šã—，XML文書を処ç†ã™ã‚‹ãƒ—ログラムã®å‹•ä½œã®ä¸€éƒ¨ã‚’è¦å®šã™ã‚‹ã€‚XMLã¯ï¼ŒSGML(標準一般化&markup;言語，Standard Generalized Markup Language)ã®åˆ¶é™ã—ãŸ⊂ã¨ã™ã‚‹ã€‚構造上，XML文書ã¯ï¼Œã‹ãªã‚‰ãšSGMLè¦æ ¼ã«é©åˆã™ã‚‹ã€‚

XML文書ã¯ï¼Œå®Ÿä½“ã¨ã„ã†è¨˜æ†¶å˜ä½ã‹ã‚‰ãªã‚Šï¼Œå®Ÿä½“ã¯ï¼Œ&parsed-data;åˆã¯&unparsed-data;ã‹ã‚‰ãªã‚‹ã€‚&parsed-data;ã¯ï¼Œæ–‡å­—ã‹ã‚‰ãªã‚Šï¼Œãã®ä¸€éƒ¨ã¯ï¼Œæ–‡æ›¸ã®æ–‡å­—データを構æˆã—，一部ã¯ï¼Œ&markup;を構æˆã™ã‚‹ã€‚&markup;ã¯ï¼Œæ–‡æ›¸ã®è¨˜æ†¶ãƒ¬ã‚¤ã‚¢ã‚¦ãƒˆåŠã³è«–ç†æ§‹é€ ã«ã¤ã„ã¦ã®è¨˜è¿°ã‚’表ã™ç¬¦å·ã¨ã™ã‚‹ã€‚XMLã¯ï¼Œè¨˜æ†¶ãƒ¬ã‚¤ã‚¢ã‚¦ãƒˆåŠã³è«–ç†æ§‹é€ ã«ã¤ã„ã¦ã®åˆ¶ç´„æ¡ä»¶ã‚’記述ã™ã‚‹æ©Ÿæ§‹ã‚’æä¾›ã™ã‚‹ã€‚

XML&processor;ã¨ã„ã†ã‚½ãƒ•ãƒˆã‚¦ã‚§ã‚¢ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã¯ï¼ŒXML文書を読ã¿è¾¼ã¿ï¼Œãã®å†…容åŠã³æ§‹é€ ã¸ã®ã‚¢ã‚¯ã‚»ã‚¹ã‚’æä¾›ã™ã‚‹ãŸã‚ã«ç”¨ã„る。 XML&processor;ã¯ï¼Œä»–ã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã®ãŸã‚ã«å‹•ä½œã™ã‚‹ã“ã¨ã‚’å‰æã¨ã—，ãã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã‚’&application;ã¨ã„ã†ã€‚ã“ã®&TR-or-Rec;ã¯ï¼ŒXML&processor;ãŒè¡Œã‚ãªã‘ã‚Œã°ãªã‚‰ãªã„振舞ã„ã‚’è¦å®šã™ã‚‹ã€‚ã¤ã¾ã‚Šï¼ŒXMLデータã®èª­è¾¼ã¿æ–¹æ³•ã‚’è¦å®šã—，&application;ã«æä¾›ã™ã‚‹æƒ…報をè¦å®šã™ã‚‹ã€‚

経緯åŠã³ç›®æ¨™

1996å¹´ã«World Wide Web Consortium(W3C)ã®ä¸­ã«è¨­ç«‹ã—ãŸXML作業グループ(以å‰ã¯ï¼Œ SGML編集レビュー委員会ã¨å‘¼ã°ã‚ŒãŸ)ãŒï¼ŒXMLを開発ã—ãŸã€‚ã“ã®ä½œæ¥­ã‚°ãƒ«ãƒ¼ãƒ—ã®è­°é•·ã‚’，Sun Microsystemsã®Jon BosakãŒå‹¤ã‚る。W3CãŒçµ„ç¹”ã—，以å‰ã¯SGML作業グループã¨å‘¼ã°ã‚ŒãŸXML SIG(Special Interest Group)も，XMLã®åˆ¶å®šã«éžå¸¸ã«æ´»ç™ºã«å‚ç”»ã—ãŸã€‚ Dan Connollyã¯ï¼Œä½œæ¥­ã‚°ãƒ«ãƒ¼ãƒ—ã®W3Cã«ãŠã‘る連絡係を務ã‚ãŸã€‚

XMLã®è¨­è¨ˆç›®æ¨™ã‚’，次ã«ç¤ºã™ã€‚

a) XMLã¯ï¼ŒInternet上ã§ãã®ã¾ã¾ä½¿ç”¨ã§ãる。

b) XMLã¯ï¼Œåºƒç¯„囲ã®&application;を支æ´ã™ã‚‹ã€‚

c) XMLã¯ï¼ŒSGMLã¨äº’æ›æ€§ã‚’ã‚‚ã¤ã€‚

d) XML文書を処ç†ã™ã‚‹ãƒ—ログラムを書ãã“ã¨ã¯ï¼Œå®¹æ˜“ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。

e) XMLã§ã¯ï¼Œã‚ªãƒ—ションã®æ©Ÿèƒ½ã¯ã§ãã‚‹ã ã‘å°‘ãªãã—，一ã¤ã‚‚存在ã—ãªã„ã“ã¨ã‚’目指ã™ã€‚

f) XML文書ã¯ï¼Œäººé–“ã«ã¨ã£ã¦èª­ã¿ã‚„ã™ã，å分ã«ç†è§£ã—ã‚„ã™ã„。

g) XMLã®è¨­è¨ˆã¯ï¼Œã™ã¿ã‚„ã‹ã«è¡Œãˆãªã‘ã‚Œã°ãªã‚‰ãªã„。

h) XMLã®è¨­è¨ˆã¯ï¼ŒåŽ³å¯†åŠã³ç°¡æ½”ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。

i) XML文書ã¯ï¼Œå®¹æ˜“ã«ä½œæˆã§ãる。

j) XMLã§ã¯ï¼Œ&markup;ã®æ•°ã‚’減らã™ã“ã¨ã¯ï¼Œé‡è¦ã§ã¯ãªã„。

XML第&XML.version;&version;ã‚’ç†è§£ã—，ãれを処ç†ã™ã‚‹è¨ˆç®—機プログラムを書ããŸã‚ã«å分ãªæƒ…å ±ã¯ï¼Œã“ã®&TR-or-Rec;åŠã³é–¢é€£ã™ã‚‹è¦æ ¼(文字用ã¨ã—ã¦ï¼ŒUnicodeåŠã³ISO/IEC 10646，&language-identification;タグ用ã¨ã—ã¦ï¼Œã‚¤ãƒ³ã‚¿ãƒãƒƒãƒˆ RFC 1766，&language-code;用ã¨ã—ã¦ï¼ŒISO 639，並ã³ã«&country-code;用ã¨ã—ã¦ï¼ŒISO 3166)ã§ï¼Œã™ã¹ã¦ç¤ºã™ã€‚

ã“ã®&version;ã®XMLã®è¦å®šã¯ï¼Œå…¬é–‹ãƒ¬ãƒ“ューåŠã³è­°è«–を目的ã¨ã™ã‚‹ã€‚テキストåŠã³æ³•å¾‹ä¸Šã®æ³¨æ„を改変ã—ãªã„é™ã‚Šï¼Œè‡ªç”±ã«é…布ã—ã¦ã‚‚よã„。

定義

XML文書ã®è¦å®šã®ãŸã‚ã«ä½¿ç”¨ã™ã‚‹ç”¨èªžã¯ï¼Œã“ã®&TR-or-Rec;内ã§å®šç¾©ã™ã‚‹ã€‚次ã«ç¤ºã™èªžå¥ã¯ï¼Œãれらã®ç”¨èªžã‚’定義ã™ã‚‹ãŸã‚，åŠã³XML&processor;ã®å‹•ãã‚’è¦å®šã™ã‚‹ãŸã‚ã«ä½¿ç”¨ã™ã‚‹ã€‚

é©åˆã™ã‚‹æ–‡æ›¸åˆã¯XML&processor;ã¯ï¼Œè¨˜è¿°ã•ã‚ŒãŸã¨ãŠã‚Šã«å‹•ä½œã—ã¦ã‚‚よã„ãŒï¼Œãã®ã¨ãŠã‚Šã«ã™ã‚‹å¿…è¦ã¯ãªã„。

é©åˆã™ã‚‹æ–‡æ›¸åˆã¯XML&processor;ã¯ï¼Œè¨˜è¿°ã•ã‚ŒãŸã¨ãŠã‚Šã«å‹•ä½œã™ã‚‹ã“ã¨ãŒè¦æ±‚ã•ã‚Œã‚‹ã€‚ãã†ã§ãªã‘ã‚Œã°ï¼Œ&error;ã¨ã™ã‚‹ã€‚

ã“ã®&TR-or-Rec;ãŒå®šã‚ã‚‹è¦å‰‡ã«å¯¾ã™ã‚‹é•å。çµæžœã¯å®šç¾©ã—ãªã„。é©åˆã™ã‚‹ã‚½ãƒ•ãƒˆã‚¦ã‚§ã‚¢ã¯ï¼Œ&error;を検出ã—ã¦å ±å‘Šã—ã¦ã‚‚よã，&error;ã‹ã‚‰å›žå¾©ã—ã¦ã‚‚よã„。

é©åˆã™ã‚‹XML&processor;ãŒæ¤œå‡ºã—ãªã‘ã‚Œã°ãªã‚‰ãšï¼Œ&application;ã«å ±å‘Šã—ãªã‘ã‚Œã°ãªã‚‰ãªã„&error;。&fatal-error;を発見ã—ãŸã‚ã¨ï¼Œ&processor;ã¯ï¼Œãれ以é™ã®&error;を探ã™ãŸã‚ã«ãƒ‡ãƒ¼ã‚¿å‡¦ç†ã‚’続行ã—ã¦ã‚‚よã，&error;を発見ã—ãŸå ´åˆã¯ï¼Œãã®&error;ã‚’&application;ã«å ±å‘Šã—ã¦ã‚‚よã„。&error;訂正をサãƒãƒ¼ãƒˆã™ã‚‹ãŸã‚ã«ï¼Œ&processor;ã¯ï¼Œæœªå‡¦ç†ãƒ‡ãƒ¼ã‚¿(文字データåŠã³&markup;ã®æ··åœ¨ã—ãŸã‚‚ã®)を文書ã‹ã‚‰å–り出ã—，&application;ã«æ¸¡ã—ã¦ã‚‚よã„。ã—ã‹ã—，一度，&fatal-error;を検出ã—ãŸã‚‰ï¼Œ&processor;ã¯ï¼Œé€šå¸¸ã®å‡¦ç†ã‚’続行ã—ã¦ã¯ãªã‚‰ãªã„。ã¤ã¾ã‚Šï¼Œ&processor;ã¯ï¼Œæ–‡å­—データåŠã³æ–‡æ›¸ã®è«–ç†æ§‹é€ ã«ã¤ã„ã¦ã®æƒ…報を，通常ã®æ–¹æ³•ã§&application;ã«æ¸¡ã—続ã‘ã¦ã¯ãªã‚‰ãªã„。

é©åˆã™ã‚‹ã‚½ãƒ•ãƒˆã‚¦ã‚¨ã‚¢ã¯ï¼Œè¨˜è¿°ã•ã‚ŒãŸã¨ãŠã‚Šã«æŒ¯ã‚‹èˆžã£ã¦ã‚‚よã„(may)，åˆã¯æŒ¯ã‚‹èˆžã‚ãªãã¦ã¯ãªã‚‰ãªã„(must)(文章中ã®åŠ©å‹•è©žã«ã‚ˆã‚‹ã€‚)。ãã®ã¨ãŠã‚Šã«æŒ¯ã‚‹èˆžã†å ´åˆã¯ï¼Œè¨˜è¿°ã•ã‚ŒãŸæŒ¯èˆžã„ã‚’é¸æŠžåˆã¯æ‹’å¦ã™ã‚‹æ‰‹æ®µã‚’&user;ã«æä¾›ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

ã™ã¹ã¦ã®&valid;ãªXML文書ã«é©ç”¨ã™ã‚‹è¦å‰‡ã€‚&validity;制約ã®é•åã¯ï¼Œ&error;ã¨ã™ã‚‹ã€‚&at-user-option;，検証を行ã†XML&processor;ã¯ï¼Œã“ã®&error;を報告ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

ã™ã¹ã¦ã®&well-formed;ã®XML文書ã«é©ç”¨ã™ã‚‹è¦å‰‡ã€‚&well-formed;制約ã®é•åã¯ï¼Œ&fatal-error;ã¨ã™ã‚‹ã€‚

a) &string;åˆã¯åå‰ã®&match;　比較ã™ã‚‹äºŒã¤ã®&string;åˆã¯åå‰ã¯ï¼ŒåŒä¸€ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。ISO/IEC 10646ã«ãŠã„ã¦ï¼Œè¤‡æ•°ã®è¡¨ç¾ãŒå¯èƒ½ãªæ–‡å­—［例ãˆã°ï¼Œ&composed-form;åŠã³åŸºåº•+&diacritical-mark;(ダイアクリティカルマーク)å½¢å¼ï¼½ã¯ï¼Œã©ã¡ã‚‰ã®&string;ã‚‚åŒã˜è¡¨ç¾ã®ã¨ãã«é™ã‚Šï¼Œ&match;ã™ã‚‹ã€‚&at-user-option;，&processor;ã¯ï¼Œãã®æ–‡å­—を標準形ã«æ­£è¦åŒ–ã—ã¦ã‚‚よã„。比較ã®ã¨ãã€å¤§æ–‡å­—ã¨å°æ–‡å­—ã¨ã®åŒºåˆ¥ã‚’ã™ã‚‹ã€‚<BR>b) &string;ã¨æ–‡æ³•ä¸­ã®è¦å‰‡ã¨ã®&match;　ã‚る生æˆè¦å‰‡ã‹ã‚‰ç”Ÿæˆã™ã‚‹è¨€èªžã«ï¼Œã‚ã‚‹&string;ãŒå±žã™ã‚‹ã¨ã，ã“ã®&string;ã¯ï¼Œã“ã®ç”Ÿæˆè¦å‰‡ã«&match;ã™ã‚‹ã¨ã„ã†ã€‚<BR>c) 内容ã¨å†…容モデルã¨ã®&match;　ã‚ã‚‹è¦ç´ ãŒï¼Œè¦ç´ ã®&validity;ã®åˆ¶ç´„ã«ç¤ºã™æ„味ã§é©åˆã™ã‚‹ã¨ã，ã“ã®è¦ç´ ã¯ï¼Œãã®å®£è¨€ã«&match;ã™ã‚‹ã¨ã„ã†ã€‚

XMLã®æ©Ÿèƒ½ã§ã‚ã£ã¦ï¼ŒXMLãŒSGMLã¨äº’æ›ã§ã‚ã‚‹ã“ã¨ã‚’ä¿è¨¼ã™ã‚‹ãŸã‚ã ã‘ã«å°Žå…¥ã•ã‚Œã‚‹ã‚‚ã®ã€‚

拘æŸåŠ›ã¯ã‚‚ãŸãªã„推奨事項。&WebSGML;以å‰ã‹ã‚‰å­˜åœ¨ã™ã‚‹SGML&processor;ãŒï¼ŒXML文書を処ç†ã§ãã‚‹å¯èƒ½æ€§ã‚’高ã‚ã‚‹ãŸã‚ã«å–り入れるもã®ã€‚

文書

ã“ã®&TR-or-Rec;ã§å®šç¾©ã™ã‚‹æ„味ã§ï¼Œ&well-formed;ã¨ã™ã‚‹ãƒ‡ãƒ¼ã‚¿ã‚ªãƒ–ジェクトを，XML文書ã¨ã„ã†ã€‚&well-formed;ã®XML文書ãŒï¼Œã•ã‚‰ã«ï¼Œã‚る制約æ¡ä»¶ã‚’満足ã™ã‚Œã°ï¼Œ&valid;ãªXML文書ã¨ã™ã‚‹ã€‚

ã„ãšã‚Œã®XML文書も，論ç†æ§‹é€ åŠã³ç‰©ç†æ§‹é€ ã‚’ã‚‚ã¤ã€‚物ç†çš„ã«ã¯ï¼Œæ–‡æ›¸ã¯ï¼Œå®Ÿä½“ã¨å‘¼ã¶å˜ä½ã‹ã‚‰ãªã‚‹ã€‚ã‚る実体ã¯ï¼Œæ–‡æ›¸å†…ã«ä»–ã®å®Ÿä½“ã‚’å«ã‚€ãŸã‚ã«ï¼Œãã®ä»–ã®å®Ÿä½“ã‚’å‚ç…§ã—ã¦ã‚‚よã„。文書ã¯ï¼Œâ€œãƒ«ãƒ¼ãƒˆâ€ã™ãªã‚ã¡æ–‡æ›¸å®Ÿä½“ã‹ã‚‰å§‹ã¾ã‚‹ã€‚è«–ç†çš„ã«ã¯ï¼Œæ–‡æ›¸ã¯ï¼Œå®£è¨€ï¼Œè¦ç´ ï¼Œã‚³ãƒ¡ãƒ³ãƒˆï¼Œæ–‡å­—å‚ç…§åŠã³å‡¦ç†å‘½ä»¤ã‚’å«ã¿ï¼Œã“れらã™ã¹ã¦ã¯ï¼Œæ–‡æ›¸å†…ã§æ˜Žç¤ºçš„ãª&markup;ã«ã‚ˆã£ã¦ç¤ºã™ã€‚è«–ç†æ§‹é€ åŠã³ç‰©ç†æ§‹é€ ã¯ï¼Œä»¥é™ã«ç¤ºã™ã¨ãŠã‚Šã«ï¼ŒåŽ³å¯†ã«å…¥ã‚Œå­ã«ãªã£ã¦ã„ãªã‘ã‚Œã°ãªã‚‰ãªã„。

&well-formed;ã®XML文書

ã‚るテキストオブジェクトãŒï¼Œæ¬¡ã®ã„ãšã‚Œã‹ã®ã¨ã，ãã®ãƒ†ã‚­ã‚¹ãƒˆã‚ªãƒ–ジェクトを&well-formed;ã®XML文書ã¨å‘¼ã¶ã€‚

a) 全体ã¨ã—ã¦ï¼Œdocumentã¨ã„ã†ãƒ©ãƒ™ãƒ«ã‚’ã‚‚ã¤ç”Ÿæˆè¦å‰‡ã«&match;ã™ã‚‹ã€‚

b) ã“ã®&TR-or-Rec;ã§å®šç¾©ã™ã‚‹ï¼Œã™ã¹ã¦ã®&well-formed;制約ã«å¾“ã†ã€‚

c) ãã‚Œãžã‚Œã®&parsed-entity;ãŒï¼Œ&well-formed;ã¨ãªã‚‹ã€‚

文書 document prolog element Misc*

document生æˆè¦å‰‡ã«&match;ã™ã‚‹ã¨ã¯ï¼Œæ¬¡ã‚’æ„味ã™ã‚‹ã€‚

a) 一ã¤ä»¥ä¸Šã®è¦ç´ ã‚’å«ã‚€ã€‚

b) ルートåˆã¯æ–‡æ›¸è¦ç´ ã¨ã„ã†è¦ç´ ãŒä¸€ã¤ã ã‘存在ã—，ã“ã‚Œã¯ï¼Œä»–ã®è¦ç´ ã®å†…容ã«å«ã¾ã‚Œãªã„。ã“れ以外ã®ã™ã¹ã¦ã®è¦ç´ ã¯ï¼Œãã®é–‹å§‹ã‚¿ã‚°ãŒä»–ã®è¦ç´ ã®å†…容ã«å«ã¾ã‚Œã‚Œã°ï¼Œå¯¾å¿œã™ã‚‹çµ‚了タグもåŒã˜è¦ç´ ã®å†…容ã«å«ã¾ã‚Œã‚‹ã€‚ã¤ã¾ã‚Šï¼Œè¦ç´ ã¯ï¼Œé–‹å§‹ã‚¿ã‚°åŠã³çµ‚了タグã«ã‚ˆã£ã¦åŒºåˆ‡ã‚‰ã‚Œï¼Œå…¥ã‚Œå­æ§‹é€ ã‚’ãªã™ã€‚

ã“れらã®çµæžœã¨ã—ã¦ï¼Œæ–‡æ›¸å†…ã®ã©ã®éžãƒ«ãƒ¼ãƒˆè¦ç´ Cã«å¯¾ã—ã¦ã‚‚，ã‚ã‚‹ä»–ã®è¦ç´ PãŒå­˜åœ¨ã—，Cã¯ï¼ŒPã®å†…容ã«å«ã¾ã‚Œã‚‹ãŒï¼ŒPã®å†…容ã«å«ã¾ã‚Œã‚‹ä»–ã®è¦ç´ ã«å«ã¾ã‚Œã‚‹ã“ã¨ã¯ãªã„。ã“ã®ã¨ã，Pã‚’Cã®è¦ªã¨ã„ã„，Cã‚’Pã®å­ã¨ã„ã†ã€‚

 文字

&parsed-entity;ã¯ï¼Œãƒ†ã‚­ã‚¹ãƒˆ(文字ã®ä¸¦ã³ã§ã‚ã£ã¦ï¼Œ&markup;åˆã¯æ–‡å­—データを表ã—ã¦ã‚‚よã„。)ã‚’å«ã‚€ã€‚文字ã¯ï¼Œãƒ†ã‚­ã‚¹ãƒˆã®æœ€å°å˜ä½ã§ã‚ã£ã¦ï¼ŒISO/IEC 10646ã«è¦å®šã•ã‚Œã‚‹ã€‚許容ã™ã‚‹æ–‡å­—ã¯ï¼Œã‚¿ãƒ–，改行，復帰並ã³ã«UnicodeåŠã³ISO/IEC 10646ãŒè¨±å®¹ã™ã‚‹å›³å½¢æ–‡å­—ã¨ã™ã‚‹ã€‚ 文字ã®ç¯„囲 Char #x9 | #xA | #xD | [#x20-#D7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF] ä»»æ„ã®Unicode文字。ãŸã ã—，&surrogate-blocks;，FFFEåŠã³FFFFã¯é™¤ã。

&character-value;をビットパタンã«ç¬¦å·åŒ–ã™ã‚‹æ©Ÿæ§‹ã¯ï¼Œå®Ÿä½“ã”ã¨ã«é•ã£ã¦ã‚‚よã„。ã™ã¹ã¦ã®XML&processor;ã¯ï¼ŒISO/IEC 10646ã®UTF-8符å·åŒ–åŠã³UTF-16符å·åŒ–ã‚’å—ã‘付ã‘ãªã‘ã‚Œã°ãªã‚‰ãªã„。二ã¤ã®ã©ã¡ã‚‰ãŒç”¨ã„られã¦ã„ã‚‹ã‹ã‚’明示ã™ã‚‹ãŸã‚ã®æ©Ÿæ§‹ï¼ŒåŠã³ä»–ã®ç¬¦å·åŒ–方法を利用ã™ã‚‹ãŸã‚ã®æ©Ÿæ§‹ã¯ï¼Œæ–‡å­—ã®ç¬¦å·åŒ–ã«è¨˜è¿°ã™ã‚‹ã€‚

ã©ã®ç¬¦å·åŒ–方法を用ã„ã‚‹ã‹ã«é–¢ä¿‚ãªã，ISO/IEC 10646ã®æ–‡å­—集åˆã«ã‚ã‚‹ã™ã¹ã¦ã®æ–‡å­—ã¯ï¼Œãã®UCS-4&code-value;ã¨ç­‰ä¾¡ãª10進数åˆã¯16進数ã«ã‚ˆã£ã¦ï¼Œå‚ç…§ã§ãる。

 共通ã®æ§‹æ–‡æ§‹æˆå­

2.3ã§ã¯ï¼Œæ–‡æ³•å†…ã§åºƒã使用ã™ã‚‹ã„ãã¤ã‹ã®è¨˜å·ã‚’定義ã™ã‚‹ã€‚

S (空白)ã¯ï¼Œä¸€ã¤è‹¥ã—ãã¯è¤‡æ•°ã®&space-character;(#x20)，復帰，改行åˆã¯ã‚¿ãƒ–ã‹ã‚‰æˆã‚‹ã€‚ 空白 S (#x20 | #x9 | #xD | #xA)+

便宜上，文字を，&letter;，数字åˆã¯ä»–ã®æ–‡å­—ã«åˆ†é¡žã™ã‚‹ã€‚&letter;ã¯ï¼Œã‚¢ãƒ«ãƒ•ã‚¡ãƒ™ãƒƒãƒˆçš„åˆã¯è¡¨éŸ³çš„ã§ã‚る基本文字(一ã¤åˆã¯è¤‡æ•°ã®&combining-character;ãŒï¼Œå¾Œã«ç¶šãã“ã¨ã‚‚ã‚る。)，&ideographic;ã‹ã‚‰æˆã‚‹ã€‚ å„クラスã«ãŠã‘る実際ã®æ–‡å­—ã«ã¤ã„ã¦ã®å®Œå…¨ãªå®šç¾©ã¯ï¼Œæ–‡å­—クラスã«é–¢ã™ã‚‹ä»˜éŒ²ã«è¦å®šã™ã‚‹ã€‚

Nameã¯ï¼Œ&letter;åˆã¯ã„ãã¤ã‹ã®åŒºåˆ‡ã‚Šæ–‡å­—ã®ä¸€ã¤ã§å§‹ã¾ã‚Šï¼Œãã®å¾Œã«&letter;，数字，ãƒã‚¤ãƒ•ãƒ³ï¼Œä¸‹ç·šï¼Œã‚³ãƒ­ãƒ³åˆã¯ãƒ”リオドãŒç¶šã(ã“れらをåå‰æ–‡å­—ã¨ã„ã†ã€‚)。&string;"xml"åˆã¯(('X'|'x') ('M'|'m') ('L'|'l'))ã«&match;ã™ã‚‹ä»»æ„ã®&string;ã§å§‹ã¾ã‚‹åå‰ã¯ï¼Œã“ã®&TR-or-Rec;ã®ç¾åœ¨ã®ç‰ˆåˆã¯å°†æ¥ã®ç‰ˆã§ã®æ¨™æº–化ã®ãŸã‚ã«äºˆç´„ã™ã‚‹ã€‚

XMLã®åå‰ã®ä¸­ã®ã‚³ãƒ­ãƒ³ã¯ï¼Œåå‰ç©ºé–“ã§ã®å®Ÿé¨“ã®ãŸã‚ã«äºˆç´„ã™ã‚‹ã€‚コロンã®æ„味ã¯ï¼Œå°†æ¥ã®ã‚る時点ã§æ¨™æº–化ã™ã‚‹ã‚‚ã®ã¨ã—，ãã®ã¨ãã«ã¯ï¼Œå®Ÿé¨“çš„ãªç›®çš„ã§ã‚³ãƒ­ãƒ³ã‚’使用ã™ã‚‹æ–‡æ›¸ã‚’æ›´æ–°ã™ã‚‹å¿…è¦ãŒç”Ÿã˜ã‚‹å¯èƒ½æ€§ãŒã‚る。XMLã§æŽ¡ç”¨ã™ã‚‹åå‰ç©ºé–“ã®æ©Ÿæ§‹ãŒï¼ŒåŒºåˆ‡ã‚Šå­ã¨ã—ã¦å®Ÿéš›ã«ã‚³ãƒ­ãƒ³ã‚’使用ã™ã‚‹ã¨ã„ã†ä¿è¨¼ã¯ãªã„。事実上，ã“ã‚Œã¯ï¼Œåå‰ç©ºé–“ã®å®Ÿé¨“ã®ä¸€ã¤ã¨ã—ã¦ä»¥å¤–ã«ã¯ï¼ŒXMLã®åå‰ã®ä¸­ã§ã‚³ãƒ­ãƒ³ã‚’使用ã—ãªã„ã»ã†ãŒã‚ˆã„ã“ã¨ã‚’æ„味ã™ã‚‹ã€‚ã—ã‹ã—，XML&processor;ã¯ï¼Œåå‰æ–‡å­—ã¨ã—ã¦ã‚³ãƒ­ãƒ³ã‚’å—ã‘付ã‘ã‚‹ã“ã¨ãŒæœ›ã¾ã—ã„。

Nmtoken (åå‰&token;)ã¯ï¼Œåå‰æ–‡å­—ã§æ§‹æˆã™ã‚‹åˆ—ã¨ã™ã‚‹ã€‚ åå‰åŠã³&token; NameChar Letter | Digit | '.' | '-' | '_' | ':' | CombiningChar | Extender Name (Letter | '_' | ':') (NameChar)* Names Name (S Name)* Nmtoken (NameChar)+ Nmtokens Nmtoken (S Nmtoken)*

&literal;データã¯ï¼Œå¼•ç”¨ç¬¦ã§å›²ã¾ã‚ŒãŸ&string;ã¨ã—，ãã®åˆ—ã®åŒºåˆ‡ã‚Šå­ã¨ã—ã¦ä½¿ç”¨ã™ã‚‹å¼•ç”¨ç¬¦ã¯å«ã¾ãªã„。&literal;ã¯ï¼Œå†…部実体(EntityValue)，属性値(AttValue)，外部&identifier;(SystemLiteral)ã®å†…容ã®æŒ‡å®šã«ä½¿ç”¨ã™ã‚‹ã€‚目的ã«ã‚ˆã£ã¦ã¯ï¼Œ&literal;全体を，ãã®ä¸­ã®&markup;ã®èµ°æŸ»ã‚’è¡Œãªã‚ãšã«ï¼Œã‚¹ã‚­ãƒƒãƒ—ã™ã‚‹ã“ã¨ãŒã‚ã‚‹(SkipLit。)。 &literal; EntityValue ' " ' ([^%&"] | PEReference | Reference)* ' " ' |  " ' " ([^%&'] | PEReference | Reference)* " ' " AttValue ' " ' ([^<&"] | Reference)* ' " ' |  " ' " ([^<&'] | Reference)* " ' " SystemLiteral SkipLit PubidLiteral ' " ' PubidChar* ' " ' | " ' " (PubidChar - " ' ")* " ' " PubidChar #x20 | #xD | #xA | [a-zA-Z0-9] | [-'()+,./:=?] SkipLit (' " ' [^"]* ' " ') | (" ' " [^']* " ' ")

文字データåŠã³&markup;

テキストã¯ï¼Œæ–‡å­—データåŠã³&markup;ãŒæ··åœ¨ã™ã‚‹ã‚‚ã®ã¨ã—ã¦æ§‹æˆã™ã‚‹ã€‚&markup;ã¯ï¼Œé–‹å§‹ã‚¿ã‚°ï¼Œçµ‚了タグ，空è¦ç´ ï¼Œå®Ÿä½“å‚照，文字å‚照，コメント，CDATAセクション ã®åŒºåˆ‡ã‚Šå­ï¼Œæ–‡æ›¸åž‹å®£è¨€åŠã³å‡¦ç†å‘½ä»¤ã®å½¢ã‚’å–る。

&markup;ã§ã¯ãªã„ã™ã¹ã¦ã®ãƒ†ã‚­ã‚¹ãƒˆã¯ï¼Œæ–‡æ›¸ã®æ–‡å­—データを構æˆã™ã‚‹ã€‚

アンパサンド文字 (&)åŠã³&left-angle-bracket; (<)ã¯ï¼Œ&markup;ã®åŒºåˆ‡ã‚Šå­ã¨ã—ã¦ï¼Œåˆã¯ã‚³ãƒ¡ãƒ³ãƒˆï¼Œå‡¦ç†å‘½ä»¤è‹¥ã—ãã¯CDATAセクション内ã§ä½¿ç”¨ã™ã‚‹å ´åˆã«ã ã‘，ãã®ã¾ã¾ã®å½¢ã§å‡ºç¾ã—ã¦ã‚ˆã„。ã“れらã®æ–‡å­—ã¯ï¼Œå†…部実体宣言ã®&literal;実体値内ã«è¨˜è¿°ã—ã¦ã‚‚よã„。 詳ã—ãã¯ï¼Œ&well-formed;ã®å®Ÿä½“ã«é–¢ã™ã‚‹è¦å®šã‚’å‚照。ã“れらã®æ–‡å­—ãŒä»–ã®éƒ¨åˆ†ã§å¿…è¦ãªå ´åˆï¼Œæ•°å€¤ã«ã‚ˆã‚‹æ–‡å­—å‚ç…§åˆã¯&string;"&amp;"åŠã³&string;"&lt;"を使用ã—，&escape;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。&right-angle-bracket; (>) ã¯ï¼Œ&string;"&gt;"を使用ã—ã¦è¡¨ç¾ã—ã¦ã‚‚よã„。内容ã®ä¸­ã§åˆ—"]]>"を使用ã™ã‚‹ã¨ãã¯ï¼Œãã‚ŒãŒï¼ŒCDATAセクションã®çµ‚了を&markup;ã—ãªã„é™ã‚Šï¼Œäº’æ›æ€§ã®ãŸã‚，"&gt;"åˆã¯æ–‡å­—å‚照を使用ã—，&escape;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

è¦ç´ ã®å†…容ã§ã¯ï¼Œæ–‡å­—データã¯ï¼Œã„ã‹ãªã‚‹&markup;ã®é–‹å§‹åŒºåˆ‡ã‚Šå­ã‚’å«ã¾ãªã„ä»»æ„ã®&char-string;ã¨ã™ã‚‹ã€‚CDATAセクションã§ã¯ï¼Œæ–‡å­—データã¨ã¯ï¼ŒCDATAセクションã®çµ‚了区切りå­"]]>"ã‚’å«ã¾ãªã„ä»»æ„ã®&char-string;ã¨ã™ã‚‹ã€‚

属性値ã«&single-quote;åŠã³&double-quote;ã‚’å«ã‚€ãŸã‚ã«ã¯ï¼Œã‚¢ãƒã‚¹ãƒˆãƒ­ãƒ•ã‚£åˆã¯&single-quote;(') ã¯ï¼Œ"&apos;"ã¨ã—ã¦è¡¨ç¾ã—，&double-quote;(")ã¯ï¼Œ"&quot;"ã¨ã—ã¦è¡¨ç¾ã™ã‚‹ã€‚ 文字データ CharData [^<&]* - ([^<&]* ']]>' [^<&]*)

コメント

コメントã¯ï¼Œä»–ã®&markup;ã®å¤–ãªã‚‰ã°ï¼Œæ–‡æ›¸ã®ã©ã“ã«ç¾ã‚Œã¦ã‚‚よã„。ã•ã‚‰ã«ï¼Œæ–‡æ›¸åž‹å®£è¨€å†…ã§ï¼Œæ–‡æ³•ãŒè¨±ã™å ´æ‰€ã«ç¾ã‚Œã¦ã‚‚よã„。 コメントã¯ï¼Œæ–‡æ›¸ã®æ–‡å­—データã®ä¸€éƒ¨ã§ã¯ãªã„。XML&processor;ã¯ï¼Œ&application;ãŒã‚³ãƒ¡ãƒ³ãƒˆã®ãƒ†ã‚­ã‚¹ãƒˆã‚’å–り出ã™ã“ã¨ã‚’å¯èƒ½ã¨ã—ã¦ã‚‚よã„ãŒï¼Œãã†ã—ãªãã¨ã‚‚よã„。 互æ›æ€§ã®ãŸã‚，&string;"--" （&double-hyphen;）ã¯ï¼Œã‚³ãƒ¡ãƒ³ãƒˆå†…ã§ç¾ã‚Œã¦ã¯ãªã‚‰ãªã„。 コメント Comment '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->'

コメントã®ä¾‹ã‚’次ã«ç¤ºã™ã€‚ <!&como; declarations for <head> & <body> &comc;>

処ç†å‘½ä»¤

処ç†å‘½ä»¤(PI)ã«ã‚ˆã£ã¦ï¼Œ&application;ã®ãŸã‚ã®å‘½ä»¤ã‚’文書ã«å…¥ã‚Œã‚‹ã“ã¨ãŒã§ãる。 処ç†å‘½ä»¤ PI '<?' PITarget (S (Char* - (Char* &pic; Char*)))? &pic; PITarget Name - (('X' | 'x') ('M' | 'm') ('L' | 'l')) PIã¯ï¼Œæ–‡æ›¸ã®æ–‡å­—データã®ä¸€éƒ¨ã§ã¯ãªã„ãŒï¼Œ&application;ã«æ¸¡ã•ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。PIã¯ï¼Œå‘½ä»¤ãŒæ¸¡ã•ã‚Œã‚‹&application;ã‚’&identify;ãŸã‚ã«ä½¿ç”¨ã™ã‚‹⌖ (PITarget) ã§å§‹ã¾ã‚‹ã€‚⌖å "XML"，"xml"ãªã©ã¯ï¼Œã“ã®&TR-or-Rec;ã®ç¾åœ¨ã®ç‰ˆåˆã¯å°†æ¥ã®ç‰ˆã®è¦æ ¼åŒ–用ã«äºˆç´„ã™ã‚‹ã€‚XMLã®è¨˜æ³•æ©Ÿæ§‹ã‚’，PIã®⌖を宣言ã™ã‚‹ãŸã‚ã«ä½¿ç”¨ã—ã¦ã‚‚よã„。

CDATAセクション

CDATAセクションã¯ï¼Œæ–‡å­—データãŒå‡ºç¾ã™ã‚‹ã¨ã“ã‚ã§ã‚ã‚Œã°ï¼Œã©ã“ã«å‡ºç¾ã—ã¦ã‚‚よã„。ã“ã‚Œã¯ï¼Œãã†ã§ãªã‘ã‚Œã°ï¼Œ&markup;ã¨ã—ã¦èªè­˜ã™ã‚‹æ–‡å­—ã‚’å«ã‚€ï¼Œãƒ†ã‚­ã‚¹ãƒˆã®åŒºç”»ã‚’&escape;ã™ã‚‹ã®ã«ä½¿ç”¨ã™ã‚‹ã€‚CDATAセクションã¯ï¼Œ&string;"<![CDATA["ã§å§‹ã¾ã‚Šï¼Œ&string; "]]>"ã§çµ‚ã‚る。 CDATAセクション CDSect CDStart CData CDEnd CDStart '<![CDATA[' CData (Char* - (Char* ']]>' Char*)) CDEnd ']]>' CDATAセクション内ã§ã¯ï¼Œåˆ—CDEndã ã‘ã‚’&markup;ã¨ã—ã¦èªè­˜ã™ã‚‹ã®ã§ï¼Œ&left-angle-bracket;åŠã³ã‚¢ãƒ³ãƒ‘サンドã¯ï¼Œãã®&literal;å½¢å¼ã§å‡ºç¾ã—ã¦ã‚ˆã„。ãれらã¯ï¼Œ"&lt;"åŠã³"&amp;"を使用ã—ã¦&escape;ã™ã‚‹å¿…è¦ã¯ãªã„。CDATAセクションã¯ï¼Œå…¥ã‚Œå­ã«ã¯ã§ããªã„。

"<greeting>"åŠã³"</greeting>"を，&markup;ã§ã¯ãªã，文字データã¨ã—ã¦èªè­˜ã™ã‚‹CDATAセクションã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <![CDATA[<greeting>Hello, world!</greeting>]]>

&prolog;åŠã³æ–‡æ›¸åž‹å®£è¨€

XML文書ã¯ï¼Œä½¿ç”¨ã™ã‚‹XMLã®&version;を指定ã™ã‚‹XML宣言ã§å§‹ã‚ã¦ã‚‚よã，åˆãã†ã™ã‚‹ã®ãŒæœ›ã¾ã—ã„。

ã“ã®&TR-or-Rec;ã®ã“ã®&version;ã«é©åˆã™ã‚‹ã“ã¨ã‚’示ã™ãŸã‚ã«ã¯ï¼Œ&version;ç•ªå· "1.0" を使用ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã‚る文書ãŒï¼Œã“ã®&TR-or-Rec;ã®ã“ã®&version;ã«é©åˆã—ãªã„ã¨ã，値"1.0"を使用ã™ã‚‹ã®ã¯ï¼Œ&error;ã¨ã™ã‚‹ã€‚ã“ã®&TR-or-Rec;ã®ä»Šå¾Œã®&version;ã«"1.0"以外ã®å€¤ã‚’付与ã™ã‚‹ã“ã¨ãŒï¼ŒXML作業グループã®æ„図ã ãŒï¼ŒXMLã®å°†æ¥ã®&version;を作æˆã™ã‚‹ã“ã¨ã®ç¢ºç´„を示ã™ã‚ã‘ã§ã¯ãªã，作æˆã—ãŸã¨ã—ã¦ã‚‚，番å·ä»˜ã‘ã«ã¤ã„ã¦ï¼Œç‰¹å®šã®æ–¹æ³•ã‚’使用ã™ã‚‹ã“ã¨ã®ç¢ºç´„を示ã™ã‚ã‘ã§ã‚‚ãªã„。将æ¥ã®&version;ã®å¯èƒ½æ€§ã‚’除外ã—ãªã„ã®ã§ï¼Œå¿…è¦ãªå ´åˆï¼Œè‡ªå‹•çš„ãª&version;ã®èªè­˜ã‚’å¯èƒ½ã¨ã™ã‚‹æ‰‹æ®µã¨ã—ã¦ï¼Œã“ã®æ§‹æˆå­ã‚’æä¾›ã™ã‚‹ã€‚&processor;ã¯ï¼Œã‚µãƒãƒ¼ãƒˆã—ã¦ã„ãªã„&version;ã§ãƒ©ãƒ™ãƒ«ä»˜ã‘ã—ãŸæ–‡æ›¸ã‚’å—ã‘å–ã£ãŸã¨ã，&error;を通知ã—ã¦ã‚‚よã„。

XML文書内ã®&markup;ã®æ©Ÿèƒ½ã¯ï¼Œè¨˜æ†¶æ§‹é€ åŠã³è«–ç†æ§‹é€ ã‚’記述ã™ã‚‹ã“ã¨ï¼Œä¸¦ã³ã«å±žæ€§åŠã³å±žæ€§å€¤ã®å¯¾ã‚’è«–ç†æ§‹é€ ã«é–¢é€£ã¥ã‘ã‚‹ã“ã¨ã«ã‚る。XMLã¯ï¼Œè«–ç†æ§‹é€ ã«ã¤ã„ã¦ã®åˆ¶ç´„æ¡ä»¶ã‚’定義ã™ã‚‹ãŸã‚，åŠã³ã‚らã‹ã˜ã‚定義ã•ã‚ŒãŸè¨˜æ†¶å˜ä½ã‚’使用ã§ãã‚‹ãŸã‚ã®æ©Ÿæ§‹ã¨ã—ã¦ï¼Œæ–‡æ›¸åž‹å®£è¨€ã‚’æä¾›ã™ã‚‹ã€‚XML文書ãŒ&valid;ã¨ã¯ï¼Œæ–‡æ›¸åž‹å®£è¨€ã‚’ã‚‚ã¡ï¼Œãã®æ–‡æ›¸åž‹å®£è¨€ã«ç¤ºã™åˆ¶ç´„æ¡ä»¶ã‚’満ãŸã™ã“ã¨ã¨ã™ã‚‹ã€‚

文書型宣言ã¯ï¼Œæ–‡æ›¸ã®æœ€åˆã®è¦ç´ ã®å‰ã«ç¾ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。 &prolog; prolog XMLDecl? Misc* (doctypedecl Misc*)? XMLDecl &xmlpio; VersionInfo EncodingDecl? SDDecl? S? &pic; VersionInfo S 'version' Eq ('"VersionNum"' | "'VersionNum'") Eq S? '=' S? VersionNum ([a-zA-Z0-9_.:] | '-')+ Misc Comment | PI | S

例ãˆã°ï¼Œæ¬¡ã«ç¤ºã™å®Œå…¨ãªXML文書ã¯ï¼Œ&well-formed;ã§ã‚ã‚‹ãŒ&valid;ã§ã¯ãªã„。 Hello, world! ]]> 次ã®æ–‡æ›¸ã‚‚åŒæ§˜ã¨ã™ã‚‹ã€‚ Hello, world! ]]>

XMLã®æ–‡æ›¸åž‹å®£è¨€ã¯ï¼Œã‚る文書クラスã®ãŸã‚ã®æ–‡æ³•ã‚’æä¾›ã™ã‚‹&markup;宣言をå«ã‚€ã‹ï¼Œåˆã¯å‚ç…§ã™ã‚‹ã€‚ã“ã®æ–‡æ³•ã‚’，文書型定義åˆã¯DTDã¨ã„ã†ã€‚文書型宣言ã¯ï¼Œ&markup;宣言をå«ã‚“ã å¤–部⊂(特別ãªç¨®é¡žã®å¤–部実体)ã‚’å‚ç…§ã§ã，åˆã¯å†…部⊂ã«ç›´æŽ¥&markup;宣言をå«ã‚€ã“ã¨ã‚‚ã§ãる。ã•ã‚‰ã«ï¼Œãã®ä¸¡æ–¹ã‚‚å¯èƒ½ã¨ã™ã‚‹ã€‚ã‚る文書ã®DTDã¯ï¼Œä¸¡æ–¹ã®⊂ã‚’ã¾ã¨ã‚ãŸã‚‚ã®ã¨ã—ã¦æ§‹æˆã™ã‚‹ã€‚

&markup;宣言ã¯ï¼Œè¦ç´ åž‹å®£è¨€ï¼Œ 属性リスト宣言，実体宣言åˆã¯è¨˜æ³•å®£è¨€ã¨ã™ã‚‹ã€‚次ã«ç¤ºã™&well-formed;制約åŠã³&validity;制約ã«è¦å®šã™ã‚‹ãŒï¼Œã“れらã®å®£è¨€ã¯ï¼Œ¶meter;実体内ã«å…¨ä½“åˆã¯ä¸€éƒ¨ãŒå«ã¾ã‚Œã¦ã‚‚よã„。詳ã—ã„è¦å®šã¯ï¼Œç‰©ç†æ§‹é€ ã«é–¢ã™ã‚‹è¦å®šã‚’å‚ç…§ã®ã“ã¨ã€‚

文書型定義 doctypedecl '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>' markupdecl elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment &root;è¦ç´ åž‹

文書型宣言ã«ãŠã‘ã‚‹Nameã¯ï¼Œ&root;è¦ç´ ã®åž‹ã¨&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

宣言åŠã³¶meter;実体ãŒåŽ³å¯†ã«å…¥ã‚Œå­ã‚’ãªã™ã“ã¨

¶meter;実体ã®&replacement-text;ã¯ï¼Œ&markup;宣言内ã«ãŠã„ã¦ï¼ŒåŽ³å¯†ã«å…¥ã‚Œå­ã«ãªã£ã¦ã„ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã¤ã¾ã‚Šï¼Œ&markup;宣言(markupdecl)ã®æœ€åˆåˆã¯æœ€å¾Œã®æ–‡å­—ãŒï¼Œ¶meter;実体å‚ç…§ã®å¯¾è±¡ã¨ãªã‚‹&replacement-text;ã«å«ã¾ã‚Œã‚Œã°ï¼Œä¸¡æ–¹ã¨ã‚‚åŒã˜&replacement-text;ã«å«ã¾ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。

 内部⊂内㮶meter;実体

DTDã®å†…部⊂ã§ã¯ï¼Œ¶meter;実体å‚ç…§ã¯ï¼Œ&markup;宣言ãŒå‡ºç¾å¯èƒ½ãªå ´æ‰€ã ã‘ã«å‡ºç¾ã§ãる。&markup;宣言内ã«ã¯å‡ºç¾ã§ããªã„(ã“ã®åˆ¶ç´„ã¯ï¼Œå¤–部¶meter;実体åˆã¯å¤–部⊂ã§ã®å‚ç…§ã«ã¯é©ç”¨ã—ãªã„。)。

内部⊂ã®ã¨ãã¨åŒæ§˜ã«ï¼Œå¤–部⊂åŠã³DTDã«ãŠã„ã¦å‚ç…§ã™ã‚‹ä»»æ„ã®å¤–部¶meter;実体ã¯ï¼Œéžçµ‚端記å·markupdeclã«ã‚ˆã£ã¦è¨±ã•ã‚Œã‚‹åž‹ã®ï¼Œä¸€é€£ã®å®Œå…¨ãª&markup;宣言ã§æ§‹æˆã•ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。&markup;宣言ã®é–“ã«ã¯ï¼Œç©ºç™½åˆã¯¶meter;実体å‚照を置ã„ã¦ã‚‚よã„。ã—ã‹ã—，外部⊂åˆã¯å¤–部¶meter;実体ã®å†…容ã®ä¸€éƒ¨ã¯ï¼Œæ¡ä»¶ä»˜ãセクションを使用ã—ã¦ç„¡è¦–ã—ã¦ã‚‚よã„。内部サブセットã§ã¯ï¼Œã“ã‚Œã¯è¨±ã•ã‚Œãªã„。 外部⊂ extSubset ( markupdecl | conditionalSect | PEReference | S )*

外部⊂åŠã³å¤–部¶meter;実体ã¯ï¼Œãã®å†…ã§ã¯ï¼Œ¶meter;実体ãŒ&markup;宣言ã®é–“ã ã‘ã§ãªã，&markup;宣言ã®å†…ã§ã‚‚èªè­˜ã•ã‚Œã‚‹ï¼Œã¨ã„ã†ç‚¹ã§ã‚‚内部⊂ã¨ã¯ç•°ãªã‚‹ã€‚

文書型宣言付ãã®XML文書ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ Hello, world! ]]> システム&identifier; "hello.dtd"ãŒï¼Œæ–‡æ›¸ã®DTDã®URIã¨ãªã‚‹ã€‚

次ã®ä¾‹ã®ã¨ãŠã‚Šï¼Œå®£è¨€ã‚’局所的ã«ä¸Žãˆã‚‹ã“ã¨ã‚‚ã§ãる。 ]> Hello, world! ]]> 外部⊂åŠã³å†…部⊂ã®ä¸¡æ–¹ã‚’使用ã™ã‚‹ã¨ãã¯ï¼Œå†…部⊂ãŒå¤–部⊂より先ã«å‡ºç¾ã—ãŸã¨è¦‹ãªã™ã€‚ã“ã‚Œã¯ï¼Œå†…部⊂ã®å®Ÿä½“åŠã³å±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ãŒï¼Œå¤–部⊂ã®å®Ÿä½“åŠã³å±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ã‚ˆã‚Šå„ªå…ˆã™ã‚‹ã¨ã„ã†åŠ¹æžœã‚’ã‚‚ãŸã‚‰ã™ã€‚

&standalone;文書宣言

XML&processor;ã¯ï¼Œ&application;ã«æ–‡æ›¸ã®å†…容を渡ã™ãŒï¼Œ&markup;宣言ã¯ï¼Œã“ã®å†…容ã«å½±éŸ¿ã‚’与ãˆã‚‹ã“ã¨ãŒã‚る。属性ã®&default-value;åŠã³å®Ÿä½“宣言をãã®ä¾‹ã¨ã™ã‚‹ã€‚XML宣言ã®ä¸€éƒ¨åˆ†ã¨ã—ã¦å‡ºç¾ã§ãã‚‹&standalone;文書宣言ã¯ï¼Œæ–‡æ›¸ãŒï¼Œãã®&markup;宣言ã®å­˜åœ¨ã«ã‚ˆã£ã¦å½±éŸ¿ã•ã‚Œãªã„ã“ã¨ã‚’指ã—示ã™ï¼ˆæ™®é€šï¼Œãã®&markup;宣言ãŒå­˜åœ¨ã—ãªã„ãŸã‚ã«ï¼Œã“ã‚ŒãŒã„ãˆã‚‹ã€‚）。 &standalone;文書宣言 SDDecl S 'standalone' Eq "'" ('yes' | 'no') "'" | S 'standalone' Eq '"' ('yes' | 'no') '"'

&standalone;文書宣言ã«ãŠã„ã¦ã¯, "yes"ã®å€¤ã¯ï¼Œæ–‡æ›¸å®Ÿä½“ã®å¤–部ã«ï¼ˆDTDã®å¤–部⊂内ã«ï¼Œåˆã¯å†…部⊂ã‹ã‚‰å‚ç…§ã•ã‚Œã‚‹å¤–部パラメタ実体内ã«ï¼‰ï¼ŒXML&processor;ã‹ã‚‰&application;ã¸ã¨æ¸¡ã•ã‚Œã‚‹æƒ…å ±ã«å½±éŸ¿ã™ã‚‹&markup;宣言ãŒå­˜åœ¨ã—ãªã„ã“ã¨ã‚’æ„味ã™ã‚‹ã€‚"no"ã®å€¤ã¯ï¼Œãã®å¤–部&markup;宣言ãŒå­˜åœ¨ã™ã‚‹ã‹ï¼Œåˆã¯å­˜åœ¨ã™ã‚‹å¯èƒ½æ€§ãŒã‚ã‚‹ã“ã¨ã‚’æ„味ã™ã‚‹ã€‚&standalone;文書宣言ã¯ï¼Œãã®å®£è¨€ãŒæ–‡æ›¸å¤–部ã«å­˜åœ¨ã™ã‚‹ã‹ã©ã†ã‹ã‚’示ã™ã ã‘ã«æ³¨æ„ã™ã‚‹ã“ã¨ã€‚外部実体ã¸ã®å‚ç…§ãŒæ–‡æ›¸å†…ã«å­˜åœ¨ã—ã¦ã„ã¦ã‚‚，ãã®å®Ÿä½“ãŒå†…部的ã«å®£è¨€ã•ã‚Œã¦ã„ã‚‹ã¨ãã¯ï¼Œæ–‡æ›¸ã®&standalone;ã®çŠ¶æ…‹ã«ã¯å½±éŸ¿ã‚’与ãˆãªã„。

外部ã«&markup;宣言ãŒå­˜åœ¨ã—ãªã‘ã‚Œã°ï¼Œ&standalone;文書宣言ã¯æ„味をもãŸãªã„。外部ã«&markup;宣言ãŒå­˜åœ¨ã—，&standalone;文書宣言ãŒå­˜åœ¨ã—ãªã„å ´åˆã¯ï¼Œ"no" ã®å€¤ã®è¨­å®šã‚’仮定ã™ã‚‹ã€‚

XML文書㧠standalone="no" ãŒè¨­å®šã•ã‚Œã¦ã„ã‚‹ã‚‚ã®ã¯ï¼Œã‚るアルゴリズムã§&standalone;文書ã«å¤‰æ›ã§ã，ã“ã®æ–‡æ›¸ã¯ï¼Œãƒãƒƒãƒˆãƒ¯ãƒ¼ã‚¯é…ä¿¡&application;ã«ã¨ã£ã¦æœ›ã¾ã—ã„ã‹ã‚‚ã—ã‚Œãªã„。

&standalone;文書宣言

&standalone;文書宣言ã¯ï¼Œä½•ã‚‰ã‹ã®å¤–部&markup;宣言ãŒæ¬¡ã®ã„ãšã‚Œã‹ã‚’宣言ã—ã¦ã„ã‚‹ã¨ãã¯ï¼Œå€¤ "no" ã‚’å–らãªã‘ã‚Œã°ãªã‚‰ãªã„。

a) &default;値付ãã®å±žæ€§ã§ã‚ã£ã¦ï¼Œã“ã®å±žæ€§ãŒé©ç”¨ã•ã‚Œã‚‹è¦ç´ ãŒï¼Œå±žæ€§å€¤ã‚’指定ã›ãšã«æ–‡æ›¸å†…ã«ç¾ã‚Œã‚‹ã‚‚ã®ã€‚

b) &magicents;以外ã®å®Ÿä½“ã§ã‚ã£ã¦ï¼Œãã®å®Ÿä½“ã«å¯¾ã™ã‚‹å‚ç…§ãŒæ–‡æ›¸å†…ã«å‡ºç¾ã™ã‚‹ã‚‚ã®ã€‚

c) 値ãŒæ­£è¦åŒ–ã®å¯¾è±¡ã¨ãªã‚‹å±žæ€§ã§ã‚ã£ã¦ï¼Œæ­£è¦åŒ–ã®çµæžœã¨ã—ã¦å¤‰åŒ–ã™ã‚‹å€¤ãŒæ–‡æ›¸å†…ã§å±žæ€§ã«æŒ‡å®šã•ã‚Œã‚‹ã‚‚ã®ã€‚

d) è¦ç´ å†…容をもã¤è¦ç´ åž‹ã§ã‚ã£ã¦ï¼Œç©ºç™½ãŒãã®è¦ç´ åž‹ã®ã„ãšã‚Œã‹ã®ã‚¤ãƒ³ã‚¹ã‚¿ãƒ³ã‚¹å†…ã«ç›´æŽ¥ç¾ã‚Œã‚‹ã‚‚ã®ã€‚

&standalone;文書宣言付ãã®XML宣言ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <?xml version="&XML.version;" standalone='yes'?>

 空白ã®å–扱ã„

XML文書を編集ã™ã‚‹ã¨ãã¯ï¼Œ&markup;を目立ãŸã›èª­ã¿ã‚„ã™ãã™ã‚‹ãŸã‚ã«ï¼Œâ€œç©ºç™½â€(&space;，タブåŠã³ç©ºç™½è¡Œã€‚ã“ã®&TR-or-Rec;ã§ã¯ï¼Œéžçµ‚端記å·ã®Sã§è¡¨ã™)を使ã†ã¨ä¾¿åˆ©ãªã“ã¨ãŒå¤šã„。ãã®ç©ºç™½ã¯ï¼Œé…布ã™ã‚‹&version;ã®æ–‡æ›¸ã®ä¸€éƒ¨ã¨ã—ã¦å«ã‚ã‚‹ã“ã¨ã‚’æ„図ã—ãªã„ã®ã‚’普通ã¨ã™ã‚‹ã€‚ã—ã‹ã—，“æ„味ã®ã‚ã‚‹â€ç©ºç™½ã§ã‚ã£ã¦ï¼Œé…布ã™ã‚‹&version;ã«æ®‹ã•ãªã‘ã‚Œã°ãªã‚‰ãªã„ã‚‚ã®ã‚‚多ã„。例ãˆã°ï¼Œè©©åŠã³ã‚½ãƒ¼ã‚¹ã‚³ãƒ¼ãƒ‰ã«ãŠã‘る空白ãŒã‚る。

XML&processor;ã¯ï¼Œæ–‡æ›¸å†…ã®&markup;以外ã®ã™ã¹ã¦ã®æ–‡å­—を，ãã®ã¾ã¾å¤‰æ›´ã›ãšã«&application;ã«æ¸¡ã•ãªã‘ã‚Œã°ãªã‚‰ãªã„。&validating;XML&processor;ã¯ï¼Œè¦ç´ å†…容ã®ä¸­ã®ç©ºç™½ã‚’ä»–ã®éž&markup;文字ã‹ã‚‰åŒºåˆ¥ã—，&application;å´ã«è¦ç´ å†…容ã®ä¸­ã®ç©ºç™½ãŒé‡è¦ã§ãªã„ã¨ã„ã†ã“ã¨ã‚’ä¼ãˆãªã‘ã‚Œã°ãªã‚‰ãªã„。

"xml:space"ã¨ã„ã†ç‰¹åˆ¥ãªå±žæ€§ã‚’文書ã«æŒ¿å…¥ã™ã‚‹ã“ã¨ã«ã‚ˆã£ã¦ï¼Œç©ºç™½ã‚’é‡è¦ã¨ã™ã‚‹æ„図を示ã—ã¦ã‚‚よã„。ã“ã®å±žæ€§ã‚’é©ç”¨ã™ã‚‹è¦ç´ ã«ç¾ã‚Œã‚‹ç©ºç™½ã‚’，アプリケーションãŒé‡è¦ãªã‚‚ã®ã¨ã—ã¦æ‰±ã†ã“ã¨ã‚’è¦æ±‚ã™ã‚‹ï¼Œã¨ã„ã†æ„図を示ã™ã€‚

&valid;ãªæ–‡æ›¸ã§ã¯ï¼Œã“ã®å±žæ€§ã‚’使用ã™ã‚‹å ´åˆã¯ï¼Œä»–ã®å±žæ€§ã¨åŒã˜ã‚ˆã†ã«å®£è¨€ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。宣言ã™ã‚‹ã¨ãã¯ï¼Œå–り得る値を"default"åŠã³ "preserve"ã ã‘ã¨ã™ã‚‹åˆ—挙型ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。

値"default"ã¯ï¼Œ&application;ã®&default;ã®ç©ºç™½å‡¦ç†ãƒ¢ãƒ¼ãƒ‰ã‚’，ãã®è¦ç´ ã«é©ç”¨å¯èƒ½ã¨ã™ã‚‹ã“ã¨ã‚’æ„味ã™ã‚‹ã€‚値"preserve"ã¯ï¼Œ&application;ãŒã™ã¹ã¦ã®ç©ºç™½ã‚’ä¿å­˜ã™ã‚‹ã“ã¨ã‚’æ„味ã™ã‚‹ã€‚ã“ã®å®£è¨€ã®æ„図ã¯ï¼Œ"xml:space" 属性ã®åˆ¥ã®æŒ‡å®šã§ä¸Šæ›¸ãã—ãªã„é™ã‚Šï¼Œè¦ç´ ã®å†…容ã«ç¾ã‚Œã‚‹ã™ã¹ã¦ã®è¦ç´ ã«é©ç”¨ã™ã‚‹ã¨è§£é‡ˆã™ã‚‹ã€‚

文書ã®&root;è¦ç´ ã«ã¤ã„ã¦ã¯ï¼Œã“ã®å±žæ€§ã®å€¤ã‚’指定ã™ã‚‹ã‹ï¼Œåˆã¯ã“ã®å±žæ€§ã®&default-value;ãŒã‚ã‚‹å ´åˆã‚’除ã„ã¦ã¯ï¼Œ&application;ã«ã‚ˆã‚‹ç©ºç™½ã®å–扱ã„ã«ã¤ã„ã¦ï¼Œã„ã‹ãªã‚‹æ„図も示ã•ãªã„ã¨è§£é‡ˆã™ã‚‹ã€‚

例を次ã«ç¤ºã™ã€‚ ]]>

行末ã®å–扱ã„

XMLã®æ§‹æ–‡&parsed-entity;ã¯ï¼Œé€šå¸¸ã‚³ãƒ³ãƒ”ュータã®ãƒ•ã‚¡ã‚¤ãƒ«å†…ã«ä¿å­˜ã•ã‚Œï¼Œç·¨é›†ã®ä¾¿å®œã®ãŸã‚ã«è¤‡æ•°ã®è¡Œã«åˆ†ã‘ã‚‹ã“ã¨ãŒå¤šã„。ã“れらã®è¡Œã¯ï¼Œæ™®é€šã¯ï¼ŒCR (#xD)コードåŠã³ LF (#xA)コードã®ä½•ã‚‰ã‹ã®çµ„åˆã›ã«ã‚ˆã£ã¦åˆ†ã‘られる。

&application;ã®å‡¦ç†ã‚’ç°¡å˜ã«ã™ã‚‹ãŸã‚，外部&parsed-entity;åˆã¯å†…部&parsed-entity;ã®&literal;実体値ãŒï¼Œ"#xD#xA" ã®ï¼’文字ã®é€£ç¶šã¨ã™ã‚‹&literal;åˆã¯#xDã®å˜ç‹¬ã®&literal;ã‚’å«ã‚€å ´åˆã«ï¼ŒXML&processor;ã¯ï¼Œ&application;ã«å˜ä¸€ã®æ–‡å­—#xAã ã‘を渡ã•ãªã‘ã‚Œã°ãªã‚‰ãªã„(ã“ã®å‡¦ç†ã¯ï¼Œå…¥åŠ›å†…ã«å­˜åœ¨ã™ã‚‹æ”¹è¡Œã‚³ãƒ¼ãƒ‰ã‚’構文解æžã®å‰ã«æ­£è¦åŒ–ã™ã‚‹ã“ã¨ã«ã‚ˆã£ã¦ï¼Œå®¹æ˜“ã«å®Ÿç¾ã§ãる。)。

 &language-identification;

文書処ç†ã«ãŠã„ã¦ã¯ï¼Œãã®æ–‡æ›¸ã®ä¸­èº«ãŒã©ã‚“ãªè‡ªç„¶è¨€èªžåˆã¯å½¢å¼è¨€èªžã§æ›¸ã‹ã‚Œã¦ã„ã‚‹ã‹æ˜Žç¤ºã™ã‚‹ã“ã¨ãŒï¼Œå½¹ã«ç«‹ã¤ã“ã¨ãŒå¤šã„。

XML文書内ã®è¦ç´ ã®ã‚‚ã¤å†…容åˆã¯å±žæ€§å€¤ã«ãŠã„ã¦ä½¿ç”¨ã™ã‚‹è¨€èªžã‚’指定ã™ã‚‹ãŸã‚ã«ï¼Œ"xml:lang" ã¨ã„ã†åå‰ã®ç‰¹åˆ¥ãªå±žæ€§ã‚’，文書内ã«æŒ¿å…¥ã—ã¦ã‚‚よã„。 属性ã®å€¤ã¯ï¼Œâ€œRFC1766：&language-identification;ã®ãŸã‚ã®ã‚¿ã‚°â€ã«ã‚ˆã£ã¦è¦å®šã•ã‚Œã‚‹&language-identification;コードã«å¾“ã†ã€‚ &language-identification; LanguageID Langcode ('-' Subcode)* Langcode ISO639Code | IanaCode | UserCode ISO639Code ([a-z] | [A-Z]) ([a-z] | [A-Z]) IanaCode ('i' | 'I') '-' ([a-z] | [A-Z])+ UserCode ('x' | 'X') '-' ([a-z] | [A-Z])+ Subcode ([a-z] | [A-Z])+ Langcodeã¯ï¼Œæ¬¡ã®ã©ã‚Œã§ã‚‚よã„。

a) “言語ã®åå‰è¡¨ç¾ã®ãŸã‚ã®ã‚³ãƒ¼ãƒ‰â€ã§è¦å®šã•ã‚Œã‚‹2文字ã®&language-code;

b) Internet Assigned Numbers Authority (IANA)ã§ç™»éŒ²ã•ã‚Œã¦ã„ã‚‹&language-code;。ã“ã‚Œã¯ï¼Œå…ˆé ­ãŒ "i-" (åˆã¯"I-")ã§å§‹ã¾ã‚‹ã€‚

c) &user;ã«ã‚ˆã£ã¦å®šã‚られãŸ&language-code;，åˆã¯ç§çš„ãªä½¿ç”¨ã®ãŸã‚ã«è¤‡æ•°ã®å›£ä½“é–“ãŒå–り決ã‚ãŸã‚³ãƒ¼ãƒ‰ã€‚ã“れらã¯ï¼Œä»Šå¾ŒIANAã«ãŠã„ã¦æ¨™æº–化åˆã¯ç™»éŒ²ã•ã‚Œã‚‹ã‚³ãƒ¼ãƒ‰ã¨ã®ç«¶åˆã‚’é¿ã‘ã‚‹ãŸã‚ã«ï¼Œå…ˆé ­ã‚’"x-" åˆã¯ "X-" ã§å§‹ã‚る。

Subcodeã¯ï¼Œè¤‡æ•°å›žä½¿ã£ã¦ã‚‚よã„。最åˆã®ã‚µãƒ–コードãŒå­˜åœ¨ã—，ãã®å†…容ãŒäºŒã¤ã®æ–‡å­—ã‹ã‚‰æˆã‚‹ã¨ãã¯ï¼ŒISO3166ã®â€œå›½åを表ã™ã‚³ãƒ¼ãƒ‰(国コード)â€ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。最åˆã®ã‚µãƒ–コードãŒ3文字以上ã‹ã‚‰æˆã‚‹ã¨ãã¯ï¼ŒLangcodeã®å…ˆé ­ãŒï¼Œ"x-" åˆã¯ "X-"ã§å§‹ã¾ã‚‰ãªã„é™ã‚Šï¼ŒæŒ‡å®šã—ãŸè¨€èªžã«å¯¾ã™ã‚‹ã‚µãƒ–コードã¨ã—，IANAã«ç™»éŒ²ã•ã‚ŒãŸã‚‚ã®ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。

&language-code;ã¯ï¼Œå°æ–‡å­—ã§ã®è¡¨è¨˜ã‚’，&country-code;ã¯ï¼Œ(存在ã™ã‚‹ãªã‚‰ã°)大文字ã§ã®è¡¨è¨˜ã‚’慣行ã¨ã™ã‚‹ã€‚ã—ã‹ã—，XML文書内ã«ãŠã‘ã‚‹ä»–ã®åå‰ã¨ã¯ç•°ãªã‚Šï¼Œã“れらã®å€¤ã«ã¤ã„ã¦ã¯ï¼Œå¤§æ–‡å­—åŠã³å°æ–‡å­—ã®åŒºåˆ¥ã‚’ã—ãªã„ã“ã¨ã«æ³¨æ„ã™ã‚‹ã“ã¨ã€‚

例を次ã«ç¤ºã™ã€‚ The quick brown fox jumps over the lazy dog.

What colour is it?

What color is it?

Habe nun, ach! Philosophie, Juristerei, und Medizin und leider auch Theologie ]]>durchaus studiert mit heißem Bemüh'n. ]]>

xml:langã§å®£è¨€ã™ã‚‹æ„図ã¯ï¼Œxml:langã®åˆ¥ã®æŒ‡å®šã§ä¸Šæ›¸ã—ãªã„é™ã‚Šï¼ŒæŒ‡å®šã—ãŸè¦ç´ ã®å†…容ã«å«ã‚€ã™ã¹ã¦ã®è¦ç´ ã«é©ç”¨ã™ã‚‹ã€‚

&valid;ãªæ–‡æ›¸ã«ãŠã„ã¦ã¯ï¼Œã“ã®&TR-or-Rec;ã®ä»–ã®å ´æ‰€ã§è¦å®šã™ã‚‹ã¨ãŠã‚Šï¼Œã“ã®å±žæ€§ã‚’å¿…ãšå®£è¨€ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。通常，宣言ã¯ï¼Œæ¬¡ã®å½¢ã¨ã™ã‚‹ã€‚ xml:lang NMTOKEN #IMPLIED å¿…è¦ãªã‚‰ã°ï¼Œç‰¹å®šã®&default-value;を与ãˆã¦ã‚‚よã„。英語をæ¯èªžã¨ã™ã‚‹å­¦ç”Ÿç”¨ã®ãƒ•ãƒ©ãƒ³ã‚¹èªžã®è©©é›†ã§ã¯ï¼Œèª¬æ˜ŽåŠã³æ³¨ã‚’英語ã§è¨˜è¿°ã™ã‚Œã°ï¼Œxml:lang 属性を次ã®ã¨ãŠã‚Šã«å®£è¨€ã™ã‚‹ã“ã¨ã¨ãªã‚‹ã€‚ ]]>

è«–ç†æ§‹é€ 

ã„ã‹ãªã‚‹XML文書も，一ã¤ä»¥ä¸Šã®è¦ç´ ã‚’å«ã‚€ã€‚è¦ç´ ã®å¢ƒç•Œã¯, 開始タグåŠã³çµ‚了タグã«ã‚ˆã£ã¦åŒºåˆ‡ã‚‹ã€‚è¦ç´ ãŒç©ºè¦ç´ ã®ã¨ãã¯ï¼Œç©ºè¦ç´ ã‚¿ã‚°ã§ç¤ºã™ã€‚å„々ã®è¦ç´ ã¯ï¼Œåž‹ã‚’ã‚‚ã¤ã€‚è¦ç´ åž‹ã¯åå‰(共通&identifier;(generic identifier)åˆã¯GIã¨å‘¼ã¶ã“ã¨ãŒã‚る。)ã«ã‚ˆã£ã¦&identified;。è¦ç´ ã¯ï¼Œã„ãã¤ã‹ã®å±žæ€§ã‚’ã‚‚ã¤ã“ã¨ãŒã§ãる。属性ã¯ï¼Œåå‰åŠã³å€¤ã‚’ã‚‚ã¤ã€‚

è¦ç´  element EmptyElemTag | STag content ETag

ã“ã®&TR-or-Rec;ã¯ï¼Œè¦ç´ åž‹åŠã³å±žæ€§ã®æ„味，使用方法，åˆã¯(構文ã«é–¢ã™ã‚‹ã“ã¨ã‚’除ã)åå‰ã«åˆ¶ç´„を与ãˆãªã„。ãŸã ã—，先頭ãŒ(('X'|'x')('M'|'m')('L'|'l'))ã«&match;ã™ã‚‹åå‰ã¯ï¼Œã“ã®ç‰ˆåˆã¯ä»Šå¾Œã®ç‰ˆã®ã“ã®&TR-or-Rec;ã§ã®æ¨™æº–化ã®ãŸã‚ã«äºˆç´„ã™ã‚‹ã€‚

è¦ç´ åž‹ã®&match;

è¦ç´ ã®çµ‚了タグã®åå‰ã¯ï¼Œãã®è¦ç´ ã®é–‹å§‹ã‚¿ã‚°ã«ãŠã‘ã‚‹åž‹ã¨&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

 開始タグ，終了タグåŠã³ç©ºè¦ç´ ã‚¿ã‚°

空ã§ãªã„ä»»æ„ã®XMLè¦ç´ ã®å§‹ã¾ã‚Šã¯ï¼Œé–‹å§‹ã‚¿ã‚°ã«ã‚ˆã£ã¦&markup;ã™ã‚‹ã€‚ 開始タグ STag'<' Name (S Attribute)* S? '>' AttributeName Eq AttValue 開始タグåŠã³çµ‚了タグ内ã®Nameã¯ï¼Œè¦ç´ ã®åž‹ã‚’表ã‚ã™ã€‚NameåŠã³AttValueã®å¯¾ã‚’è¦ç´ ã®å±žæ€§æŒ‡å®šã¨ã„ã„，個々ã®å¯¾ã«ãŠã‘ã‚‹Nameã¯ï¼Œå±žæ€§ååŠã³AttValueã®å†…容(区切りå­'åˆã¯"ã®é–“ã®&string;)を属性値ã¨ã„ã†ã€‚

属性指定ã®ä¸€æ„性

開始タグåˆã¯ç©ºè¦ç´ ã‚¿ã‚°ã§ã¯ï¼ŒåŒä¸€ã®å±žæ€§åãŒï¼’度以上出ç¾ã—ã¦ã¯ãªã‚‰ãªã„。

 属性値ã®åž‹

属性ã¯å®£è¨€ã•ã‚Œã¦ã„ãªã‘ã‚Œã°ãªã‚‰ãªã„。属性値ã®åž‹ã¯ï¼Œãã®å±žæ€§ã«å¯¾ã—ã¦å®£è¨€ã—ãŸåž‹ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„(属性ã®åž‹ã«ã¤ã„ã¦ã¯ï¼Œå±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ã«ã¤ã„ã¦ã®è¦å®šã‚’å‚照。)。

 外部実体ã¸ã®å‚ç…§ãŒãªã„ã“ã¨

属性値ã«ã¯ï¼Œå¤–部実体ã¸ã®ç›´æŽ¥çš„åˆã¯é–“接的ãªå‚照をå«ã‚€ã“ã¨ã¯ã§ããªã„。

 属性値ã«<ã‚’å«ã¾ãªã„ã“ã¨

属性値内ã§ç›´æŽ¥çš„åˆã¯é–“接的ã«å‚ç…§ã™ã‚‹å®Ÿä½“(&lt;を除ã。)ã®&replacement-text;ã«ã¯ï¼Œ<ã‚’å«ã‚“ã§ã¯ãªã‚‰ãªã„。

開始タグã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <termdef id="dt-dog" term="dog">

開始タグã§å§‹ã¾ã‚‹è¦ç´ ã®çµ‚ã‚ã‚Šã¯ï¼Œçµ‚了タグã§&markup;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã“ã®çµ‚了タグã¯ï¼Œå¯¾å¿œã™ã‚‹é–‹å§‹ã‚¿ã‚°ã®è¦ç´ åž‹ã¨åŒã˜åå‰ã‚’ã‚‚ã¤ã€‚ 終了タグETag'</' Name S? '>'

終了タグã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ </termdef>

è¦ç´ ã®é–‹å§‹ã‚¿ã‚°ã¨çµ‚了タグã¨ã®é–“ã®ãƒ†ã‚­ã‚¹ãƒˆã‚’，ãã®è¦ç´ ã®å†…容ã¨ã„ã†ã€‚ è¦ç´ ã®å†…容 content(element | CharData | Reference | CDSect | PI | Comment)*

è¦ç´ ãŒç©ºã®ã¨ã，ãã®è¦ç´ ã¯ï¼Œç›´å¾Œã«çµ‚了タグをもã¤é–‹å§‹ã‚¿ã‚°åˆã¯ç©ºè¦ç´ ã‚¿ã‚°ã§è¡¨ç¾ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。空è¦ç´ ã‚¿ã‚°ã¯ï¼Œæ¬¡ã®ç‰¹åˆ¥ãªå½¢å¼ã‚’ã¨ã‚‹ã€‚ 空è¦ç´ ã®ãŸã‚ã®ã‚¿ã‚°EmptyElemTag'<' Name (S Attribute)* S? '/>'

空è¦ç´ ã‚¿ã‚°ã¯ï¼Œå†…容をもãŸãªã„ä»»æ„ã®è¦ç´ ã®è¡¨ç¾ã«åˆ©ç”¨ã§ãる。空è¦ç´ ã‚¿ã‚°ã§è¡¨ç¾ã™ã‚‹è¦ç´ ã‚’，キーワードEMPTYを用ã„ã¦å®£è¨€ã—ãªãã¨ã‚‚よã„。

空è¦ç´ ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <IMG align="left" src="http://www.w3.org/Icons/WWW/w3c_home" /><br></br><br/>

 è¦ç´ å®£è¨€

&validity;ã‚’ä¿è¨¼ã™ã‚‹ãŸã‚，è¦ç´ å®£è¨€åŠã³å±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ã‚’用ã„ã¦XML文書ã®è¦ç´ ã®æ§‹é€ ã«ï¼Œåˆ¶ç´„を加ãˆã‚‹ã“ã¨ãŒã§ãる。

è¦ç´ å®£è¨€ã¯ï¼Œè¦ç´ ã®å†…容ã«ã¤ã„ã¦ã®åˆ¶ç´„ã¨ã™ã‚‹ã€‚

è¦ç´ å®£è¨€ã¯ï¼Œè¦ç´ ã®å­ã¨ã—ã¦å‡ºç¾å¯èƒ½ãªè¦ç´ åž‹ã«ã¤ã„ã¦ï¼Œåˆ¶ç´„を加ãˆã‚‹ã“ã¨ãŒå¤šã„。&at-user-option;，è¦ç´ å®£è¨€ã‚’ã‚‚ãŸãªã„è¦ç´ åž‹ãŒä»–ã®è¦ç´ å®£è¨€ã«ã‚ˆã£ã¦å‚ç…§ã•ã‚Œã‚Œã°ï¼ŒXML&processor;ã¯ï¼Œè­¦å‘Šã‚’出ã—ã¦ã‚‚よã„。ã—ã‹ã—，ã“ã‚Œã¯&error;ã¨ã¯ã—ãªã„。

è¦ç´ åž‹å®£è¨€ã¯ï¼Œæ¬¡ã®å½¢å¼ã‚’ã¨ã‚‹ã€‚ è¦ç´ åž‹å®£è¨€ elementdecl '<!ELEMENT' S Name S contentspec S? '>' contentspec 'EMPTY' | 'ANY' | Mixed | children ã“ã“ã§ï¼ŒNameã¯ï¼Œå®£è¨€ã•ã‚Œã¦ã„ã‚‹è¦ç´ ã®åž‹ã¨ã™ã‚‹ã€‚

è¦ç´ å®£è¨€ã®ä¸€æ„性

è¦ç´ åž‹ã‚’２度以上宣言ã§ããªã„。

 è¦ç´ ã®&validity;

è¦ç´ ãŒ&valid;ã¨ã¯ï¼Œelementdeclã«&match;ã™ã‚‹å®£è¨€ã§ã‚ã£ã¦ï¼Œãã®NameãŒãã®è¦ç´ åž‹ã¨&match;ã—，次ã®ã„ãšã‚Œã‹ã®æ¡ä»¶ã‚’満ãŸã™å ´åˆã¨ã™ã‚‹ã€‚

a) 宣言ãŒEMPTYã«&match;ã—，è¦ç´ ãŒå†…容をもãŸãªã„。

b) 宣言ãŒchildrenã«&match;ã—，è¦ç´ ã®å­è¦ç´ ã®ä¸¦ã³ãŒï¼Œå†…容モデルã®æ­£è¦è¡¨ç¾ã«ã‚ˆã£ã¦ç”Ÿæˆã•ã‚Œã‚‹è¨€èªžã«å±žã™ã‚‹ã€‚

c) 宣言ãŒmixedã«&match;ã—，è¦ç´ ã®å†…容ãŒæ–‡å­—データåŠã³å­è¦ç´ ã‹ã‚‰ãªã‚‹ã€‚å­è¦ç´ ã®è¦ç´ åž‹ã¯ï¼Œè¦ç´ ã®å†…容モデルã«å‡ºç¾ã™ã‚‹åå‰ã«&match;ã™ã‚‹ã€‚

d) 宣言ãŒANYã«&match;ã—，ã©ã®å­è¦ç´ ã®è¦ç´ åž‹ã‚‚宣言ã•ã‚Œã¦ã„る。

è¦ç´ å®£è¨€ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <!ELEMENT br EMPTY> <!ELEMENT p (#PCDATA|emph)* > <!ELEMENT %name.para; %content.para; > <!ELEMENT container ANY>

è¦ç´ å†…容

ã‚ã‚‹åž‹ã®è¦ç´ ãŒå­è¦ç´ ã ã‘ã‚’å«ã‚€(文字データをå«ã¾ãªã„。)ã¨ã，ãã®è¦ç´ åž‹ã¯ï¼Œè¦ç´ å†…容をもã¤ï¼Œã¨ã„ã†ã€‚ã“ã®å ´åˆï¼Œåˆ¶ç´„ã¯ï¼Œå†…容モデルをå«ã‚€ã€‚内容モデルã¯ï¼Œå­è¦ç´ ã®åž‹åŠã³å­è¦ç´ ã®å‡ºç¾é †åºã‚’制御ã™ã‚‹ç°¡å˜ãªæ–‡æ³•ã¨ã™ã‚‹ã€‚ã“ã®æ–‡æ³•ã¯ï¼Œ&content-particle;(cps)ã‹ã‚‰ãªã‚‹ã€‚&content-particle;ã¯ï¼Œåå‰ï¼Œ&content-particle;ã®é¸æŠžãƒªã‚¹ãƒˆåˆã¯&content-particle;ã®åˆ—リストã‹ã‚‰æ§‹æˆã•ã‚Œã‚‹ã€‚ è¦ç´ å†…容モデル children(choice | seq) ('?' | '*' | '+')?cp(Name | choice | seq) ('?' | '*' | '+')? choice'(' S? cp ( S? '|' S? cp )*S? ')' seq'(' S? cp ( S? ',' S? cp )*S? ')' ã“ã“ã§ï¼ŒNameã¯ï¼Œå­ã¨ã—ã¦å‡ºç¾ã—ã¦ã‚ˆã„è¦ç´ ã®åž‹ã‚’示ã™ã€‚ã“ã®æ–‡æ³•ã§é¸æŠžãƒªã‚¹ãƒˆãŒç¾ã‚Œã‚‹ä½ç½®ã§ã¯ï¼Œé¸æŠžãƒªã‚¹ãƒˆå†…ã®ã„ãšã‚Œã®&content-particle;ã‚‚è¦ç´ å†…容ã®ä¸­ã«ç¾ã‚Œã¦ã‚ˆã„。列リストã«ç¾ã‚Œã‚‹&content-particle;ã¯ï¼Œãƒªã‚¹ãƒˆã§æŒ‡å®šã™ã‚‹é †ç•ªã®ã¨ãŠã‚Šã«ï¼Œè¦ç´ å†…容ã«ç¾ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。åå‰åˆã¯ãƒªã‚¹ãƒˆã®å¾Œã«å‡ºç¾ã™ã‚‹ã‚ªãƒ—ションã®æ–‡å­—ã¯ï¼Œãƒªã‚¹ãƒˆå†…ã®è¦ç´ åˆã¯&content-particle;ãŒï¼Œ1回以上任æ„ã®å›žæ•°(+)，0回以上任æ„ã®å›žæ•°(*)åˆã¯0回若ã—ãã¯1回(?)出ç¾å¯èƒ½ãªã“ã¨ã‚’è¦å®šã™ã‚‹ã€‚ã“ã“ã§ç¤ºã™æ§‹æ–‡åŠã³æ„味ã¯ï¼Œã“ã®&TR-or-Rec;ã«ãŠã‘る生æˆè¦å‰‡ã§ç”¨ã„ã‚‹ã‚‚ã®ã¨åŒä¸€ã¨ã™ã‚‹ã€‚

è¦ç´ ã®å†…容ãŒå†…容モデルã«&match;ã™ã‚‹ã®ã¯ï¼Œåˆ—，é¸æŠžåŠã³ç¹°è¿”ã—演算å­ã«ã—ãŸãŒã£ã¦ï¼Œå†…容ã®ä¸­ã®è¦ç´ ã¨å†…容モデル内ã®è¦ç´ åž‹ã¨ã‚’&match;ã•ã›ãªãŒã‚‰ï¼Œå†…容モデル内ã®ä¸€ã¤ã®ãƒ‘スをãŸã©ã‚Œã‚‹ã¨ãã«é™ã‚‹ã€‚互æ›æ€§ã®ãŸã‚，文書内ã®è¦ç´ ãŒï¼Œå†…容モデルã«ãŠã‘ã‚‹è¦ç´ åž‹ã®è¤‡æ•°ã®å‡ºç¾ä½ç½®ã¨&match;ã™ã‚‹ã“ã¨ã¯ï¼Œ&error;ã¨ã™ã‚‹ã€‚詳細ãªè¦å®šã«ã¤ã„ã¦ã¯ï¼Œé™„属書ã®æ±ºå®šçš„内容モデルã®é …ã‚’å‚照。

グループåŠã³ãƒ‘ラメタ実体ãŒåŽ³å¯†ãªå…¥ã‚Œå­ã‚’ãªã—ã¦ã„ã‚‹ã“ã¨

パラメタ実体ã®&replacement-text;ã¯ï¼Œ&parenthesis;ã§å›²ã¾ã‚ŒãŸã‚°ãƒ«ãƒ¼ãƒ—ã«ã‚ˆã£ã¦ï¼ŒåŽ³å¯†ãªå…¥ã‚Œå­ã‚’構æˆã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã¤ã¾ã‚Šï¼Œé¸æŠžï¼Œåˆ—åˆã¯æ··åœ¨éƒ¨å“ã«ï¼Œ&left-parenthesis;åˆã¯&right-parenthesis;ã®ã„ãšã‚Œã‹ä¸€æ–¹ãŒãƒ‘ラメタ実体ã®&replacement-text;ã«å«ã‚Œã‚Œã°ï¼Œä»–方もåŒã˜&replacement-text;ã«å«ã¾ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。

相互é‹ç”¨æ€§ã®ãŸã‚，パラメタ実体å‚ç…§ãŒé¸æŠžï¼Œåˆ—åˆã¯æ··åœ¨å†…容ã«å«ã¾ã‚Œã‚Œã°ï¼Œãã®&replacement-text;ã¯ç©ºã§ãªã„ã“ã¨ãŒæœ›ã¾ã—ã，&replacement-text;ã®å…ˆé ­åŠã³æœ«å°¾ã®ç©ºç™½ã§ãªã„文字ã¯ï¼Œã‚³ãƒã‚¯ã‚¿(|åˆã¯,)ã§ãªã„æ–¹ãŒã‚ˆã„。

è¦ç´ å†…容モデルã®ã„ãã¤ã‹ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <!ELEMENT spec (front, body, back?)> <!ELEMENT div1 (head, (p | list | note)*, div2*)> <!ELEMENT dictionary-body (%div.mix; | %dict.mix;)*>

 &mixed-content;

ã‚ã‚‹è¦ç´ åž‹ã®è¦ç´ å†…ã«ï¼Œå­è¦ç´ ã«æ··åœ¨ã—ã¦æ–‡å­—データãŒå«ã¾ã‚Œã‚‹å¯èƒ½æ€§ãŒã‚ã‚‹ã¨ã，ãã®è¦ç´ åž‹ã¯ï¼Œ&mixed-content;ã‚’ã‚‚ã¤ã¨ã„ã†ã€‚ã“ã®å ´åˆï¼Œå­è¦ç´ ã®åž‹ã«ã¤ã„ã¦ã®åˆ¶ç´„ãŒå­˜åœ¨ã—ã¦ã‚‚よã„ãŒï¼Œå­è¦ç´ ã®é †åºåˆã¯å‡ºç¾å›žæ•°ã«ã¤ã„ã¦ã®åˆ¶ç´„ã¯ãªã„ã¨ã™ã‚‹ã€‚ &mixed-content;宣言 Mixed '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' | '(' S? '#PCDATA' S? ')' ã“ã“ã§ï¼ŒNameã¯ï¼Œå­ã¨ã—ã¦å‡ºç¾ã—ã¦ã‚‚よã„è¦ç´ ã®åž‹ã‚’示ã™ã€‚

è¦ç´ åž‹ã®é‡è¤‡ã®ç¦æ­¢

一ã¤ã®&mixed-content;宣言内ã«ï¼ŒåŒã˜åå‰ãŒè¤‡æ•°å›žå‡ºç¾ã—ã¦ã¯ãªã‚‰ãªã„。

&mixed-content;宣言ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <!ELEMENT p (#PCDATA|a|ul|b|i|em)*> <!ELEMENT p (#PCDATA | %font; | %phrase; | %special; | %form;)* > <!ELEMENT b (#PCDATA)>

 属性リスト宣言

属性ã¯ï¼Œåå‰åŠã³å€¤ã®å¯¾ã‚’è¦ç´ ã«é–¢é€£ä»˜ã‘ã‚‹ãŸã‚ã«ç”¨ã„る。属性指定ã¯ï¼Œé–‹å§‹ã‚¿ã‚°åˆã¯ç©ºè¦ç´ ã‚¿ã‚°å†…ã§ã ã‘å¯èƒ½ã¨ã™ã‚‹ã€‚ã—ãŸãŒã£ã¦ï¼Œå±žæ€§ã‚’èªè­˜ã™ã‚‹ãŸã‚ã®ç”Ÿæˆè¦å‰‡ã¯ï¼Œé–‹å§‹ã‚¿ã‚°ã«ã¤ã„ã¦ã®è¦å®šã§ç¤ºã™ã€‚属性リスト宣言ã¯ï¼Œæ¬¡ã®ç›®çš„ã§ç”¨ã„る。

a) ã‚ã‚‹è¦ç´ åž‹ã«é©ç”¨ã™ã‚‹å±žæ€§ã®é›†åˆã‚’è¦å®šã™ã‚‹ã€‚

b) 属性ã¸ã®åž‹åˆ¶ç´„を設定ã™ã‚‹ã€‚

c) 属性ã®&default-value;ã‚’è¦å®šã™ã‚‹ã€‚

属性リスト宣言ã¯ï¼Œã‚ã‚‹è¦ç´ åž‹ã¨é–¢é€£ä»˜ã‘られãŸå„属性ã«å¯¾ã—，åå‰ï¼Œãƒ‡ãƒ¼ã‚¿åž‹åŠã³(存在ã™ã‚Œã°)&default-value;ã‚’è¦å®šã™ã‚‹ã€‚ 属性リスト宣言 AttlistDecl '<!ATTLIST' S Name AttDef* S? '>' AttDef S Name S AttType S Default AttlistDeclè¦å‰‡ã«å­˜åœ¨ã™ã‚‹Nameã¯ï¼Œè¦ç´ åž‹ã®åå‰ã¨ã™ã‚‹ã€‚&at-user-option;，宣言ã—ã¦ã„ãªã„è¦ç´ åž‹ã«å¯¾ã—属性を宣言ã—ãŸãªã‚‰ã°ï¼ŒXML&processor;ã¯ï¼Œè­¦å‘Šã‚’出ã—ã¦ã‚‚よã„。ã—ã‹ã—，ã“ã‚Œã¯&error;ã¨ã¯ã—ãªã„。 AttDefè¦å‰‡ã«ãŠã‘ã‚‹Nameã¯ï¼Œå±žæ€§ã®åå‰ã¨ã™ã‚‹ã€‚

ã‚ã‚‹è¦ç´ ã«å¯¾ã—ã¦ï¼Œè¤‡æ•°ã®AttlistDeclを与ãˆã‚‹å ´åˆï¼Œã“れらã™ã¹ã¦ã®å†…容ã¯ãƒžãƒ¼ã‚¸ã™ã‚‹ã€‚ã‚ã‚‹è¦ç´ åž‹ã®åŒã˜å±žæ€§ã«ï¼Œè¤‡æ•°ã®å®šç¾©ã‚’与ãˆã‚‹å ´åˆã«ã¯ï¼Œæœ€åˆã®å®£è¨€ã‚’有効ã¨ã—，他ã®å®£è¨€ã¯ç„¡è¦–ã™ã‚‹ã€‚相互é‹ç”¨æ€§ã®ãŸã‚ã«ï¼ŒDTDã®ä½œæˆè€…ã¯ï¼Œã‚ã‚‹è¦ç´ åž‹ã«ã¯é«˜ã€…一ã¤ã®å±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ã—ã‹ä¸Žãˆãªã„，ã‚る属性åã«ã¯é«˜ã€…一ã¤ã®å±žæ€§å®šç¾©ã—ã‹ä¸Žãˆãªã„，åŠã³ã™ã¹ã¦ã®å±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ã«ã¯å°‘ãªãã¨ã‚‚一ã¤ã®å±žæ€§å®šç¾©ã‚’与ãˆã‚‹ï¼Œã¨ã„ã†é¸æŠžã‚’ã—ã¦ã‚‚よã„。相互é‹ç”¨æ€§ã®ãŸã‚ã«ï¼ŒXML&processor;ã¯ï¼Œ&at-user-option;，ã‚ã‚‹è¦ç´ åž‹ã«è¤‡æ•°ã®å±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ã‚’与ãˆãŸã‚Šï¼Œã‚る属性ã«è¤‡æ•°ã®å±žæ€§å®šç¾©ã‚’与ãˆãŸã‚Šã—ãŸã¨ãã«ï¼Œè­¦å‘Šã‚’出ã—ã¦ã‚‚よã„。ã—ã‹ã—，ã“ã‚Œã¯ï¼Œ&error;ã¨ã¯ã—ãªã„。

属性ã®åž‹

XMLã®å±žæ€§ã®åž‹ã¯ï¼Œï¼“種類ã¨ã™ã‚‹ã€‚ã“れらã¯ï¼Œ&string;型，&token;化型åŠã³åˆ—挙型ã¨ã™ã‚‹ã€‚&string;åž‹ã¯ï¼Œå€¤ã¨ã—ã¦ä»»æ„ã®&string;ã‚’ã¨ã‚‹ã€‚&token;化型ã¯ï¼Œæ¬¡ã«ç¤ºã™å­—å¥åŠã³æ„味ã«é–¢ã™ã‚‹æ§˜ã€…ãªåˆ¶ç´„ã‚’ã‚‚ã¤ã€‚ Attribute Types AttType StringType | TokenizedType | EnumeratedType StringType 'CDATA' TokenizedType 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'

ID

ã“ã®åž‹ã®å€¤ã¯ï¼Œç”Ÿæˆè¦å‰‡Nameã«&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。一ã¤ã®XML文書内ã§ã¯ï¼Œä¸€ã¤ã®åå‰ãŒï¼Œã“ã®åž‹ã®å€¤ã¨ã—ã¦è¤‡æ•°å›žç¾ã‚Œã¦ã¯ãªã‚‰ãªã„。ã¤ã¾ã‚Šï¼ŒIDã®å€¤ã¯ï¼Œè¦ç´ ã‚’一æ„ã«&identify;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

1è¦ç´ ã”ã¨ã«1ID

è¦ç´ åž‹ã¯ï¼Œè¤‡æ•°ã®ID属性値をもã£ã¦ã¯ãªã‚‰ãªã„。

ID属性ã®&default;

ID属性ã¯ï¼Œ&default;ã¨ã—ã¦ï¼Œ#IMPLIEDåˆã¯#REQUIREDを宣言ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

IDREF

IDREFåž‹ã®å€¤ã¯ï¼Œç”Ÿæˆè¦å‰‡Nameã«&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。IDREFSåž‹ã®å€¤ã¯ï¼Œç”Ÿæˆè¦å‰‡Namesã«&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。å„々ã®Nameã¯ï¼ŒXML文書内ã«å­˜åœ¨ã™ã‚‹è¦ç´ ã®ID属性ã®å€¤ã¨&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã¤ã¾ã‚Šï¼ŒIDREFã®å€¤ã¯ï¼Œã‚ã‚‹ID属性ã®å€¤ã¨&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

実体å

ENTITYåž‹ã®å€¤ã¯ï¼Œç”Ÿæˆè¦å‰‡Nameã«&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。ENTITIESåž‹ã®å€¤ã¯ï¼Œç”Ÿæˆè¦å‰‡Namesã«&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。å„々ã®Nameã¯ï¼ŒDTDã§å®£è¨€ã™ã‚‹&unparsed-entity;ã¨&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

åå‰&token;

NMTOKENåž‹ã®å€¤ã¯ï¼Œéžçµ‚端記å·Nmtokenã¨&match;ã™ã‚‹&string;ã‹ã‚‰æ§‹æˆã•ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。NMTOKENSåž‹ã®å€¤ã¯ï¼Œéžçµ‚端記å·Nmtokensã¨&match;ã™ã‚‹&string;ã‹ã‚‰æ§‹æˆã•ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。

XML&processor;ã¯ï¼Œ&application;ã«å±žæ€§å€¤ã‚’渡ã™å‰ã«ï¼Œå±žæ€§å€¤ã®æ­£è¦åŒ–ã§è¦å®šã™ã‚‹ã¨ãŠã‚Šã«ï¼Œå±žæ€§å€¤ã‚’æ­£è¦åŒ–ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

列挙型ã®å±žæ€§ã¯ï¼Œå®£è¨€ã—ãŸå€¤ã®ä¸€ã¤ã‚’å–ã‚‹ã“ã¨ãŒã§ãる。列挙型ã«ã¯ï¼Œ2種類ã‚る。 列挙属性ã®åž‹ EnumeratedType NotationType | Enumeration NotationType 'NOTATION' S '(' S? Name (S? '|' Name)* S? ')' Enumeration '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'

記法属性

ã“ã®åž‹ã®å€¤ã¯ï¼Œå®£è¨€ã—ã¦ã„る記法ã®åå‰ã®ä¸€ã¤ã¨&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã¤ã¾ã‚Šï¼Œå®£è¨€ã«å­˜åœ¨ã™ã‚‹è¨˜æ³•åã¯ï¼Œã™ã¹ã¦å®£è¨€ã•ã‚Œã¦ã„ãªã‘ã‚Œã°ãªã‚‰ãªã„。

列挙

ã“ã®åž‹ã®å€¤ã¯ï¼Œå®£è¨€ã«å­˜åœ¨ã™ã‚‹Nmtoken&token;ã®ä¸€ã¤ã¨&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

相互é‹ç”¨æ€§ã®ãŸã‚，åŒã˜Nmtokenã¯ï¼Œå˜ä¸€è¦ç´ åž‹ã®åˆ—挙型ã®å±žæ€§ã¨ã—ã¦ï¼Œè¤‡æ•°å›žç¾ã‚Œãªã„æ–¹ãŒã‚ˆã„。

属性ã®&default;

属性宣言ã¯ï¼Œå±žæ€§ã®æŒ‡å®šãŒå¿…é ˆã‹ã©ã†ã‹ã«ã¤ã„ã¦ã®æƒ…報を与ãˆã‚‹ã€‚å¿…é ˆã§ãªã„å ´åˆã«ã¯ï¼Œæ–‡æ›¸å†…ã§å±žæ€§ã‚’指定ã—ãªã„ã¨ã，XML&processor;ã®å‡¦ç†æ–¹æ³•ã®æƒ…報も与ãˆã‚‹ã€‚ 属性ã®&default; Default '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)

属性&default;ã®æ­£ã—ã•

宣言ã—ãŸ&default-value;ã¯ï¼Œå®£è¨€ã—ãŸå±žæ€§åž‹ã®å­—å¥åˆ¶ç´„を満ãŸã•ãªã‘ã‚Œã°ãªã‚‰ãªã„。

#REQUIREDを指定ã—ãŸã¨ã，ã“ã®è¦ç´ åž‹ã®é–‹å§‹ã‚¿ã‚°ã§ã‚ã£ã¦ï¼Œã“ã®å±žæ€§ã«å€¤ã‚’与ãˆãªã„ã‚‚ã®ã‚’XML&processor;ãŒè¦‹ã¤ã‘ãŸãªã‚‰ã°ï¼Œãã®æ–‡æ›¸ã¯&valid;ã¨ã¯ã—ãªã„。#IMPLIEDを指定ã—ãŸã¨ã，ã“ã®å±žæ€§ã‚’çœç•¥ã—ãŸã‚‰ï¼ŒXML&processor;ã¯ï¼Œå±žæ€§å€¤ã‚’指定ã—ãªã„ã“ã¨ã‚’アプリケーションã«ä¼ãˆãªã‘ã‚Œã°ãªã‚‰ãªã„。ã“ã®ã¨ã，&application;ã®æŒ¯èˆžã„ã«ã¤ã„ã¦ã®åˆ¶ç´„ã¯ãªã„。

属性ãŒ#REQUIREDã§ã‚‚#IMPLIEDã§ã‚‚ãªã„ã¨ãã«ã¯ï¼ŒAttValueã®å€¤ãŒï¼Œ&default-value;ã¨ãªã‚‹ã€‚#FIXEDã®å ´åˆï¼Œ&default-value;ã¨ç•°ãªã‚‹å€¤ãŒæŒ‡å®šã•ã‚Œã‚Œã°ï¼Œãã®æ–‡æ›¸ã¯ï¼Œ&valid;ã¨ã—ãªã„。&default-value;を宣言ã—ã¦ã„ã‚‹å ´åˆï¼Œã“ã®å±žæ€§ã®çœç•¥ã‚’見ã¤ã‘ãŸã‚‰ï¼Œå®£è¨€ã—ãŸ&default-value;を属性値ã«æŒ‡å®šã—ã¦ã„ã‚‹ã¨ã—ã¦ï¼ŒXML&processor;ã¯æŒ¯ã‚‹èˆžã†ã“ã¨ãŒæœ›ã¾ã—ã„。

属性リスト宣言ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <!ATTLIST termdef id ID #REQUIRED name CDATA #IMPLIED> <!ATTLIST list type (bullets|ordered|glossary) "ordered"> <!ATTLIST form method CDATA #FIXED "POST">

 属性値ã®æ­£è¦åŒ–

XML&processor;ã¯ï¼Œå±žæ€§å€¤ã‚’&application;ã«æ¸¡ã™å‰ã«ï¼Œæ¬¡ã®ã¨ãŠã‚Šã«æ­£è¦åŒ–ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

a) ã¾ãšï¼Œå±žæ€§å€¤åŠã³ãã®ä¸­ã®å®Ÿä½“内ã§ï¼Œè¡Œæœ«åˆã¯è¡Œå¢ƒç•Œ(åˆã¯ã‚·ã‚¹ãƒ†ãƒ ã«ã‚ˆã£ã¦ã¯ãƒ¬ã‚³ãƒ¼ãƒ‰å¢ƒç•Œ)ã¨ã—ã¦ä½¿ã‚れる&string;を，&space-character;(#x20)一ã¤ã«ç½®ãæ›ãˆãªã‘ã‚Œã°ãªã‚‰ãªã„(「行末ã®æ‰±ã„ã€ã‚‚å‚ç…§ã®ã“ã¨ã€‚)。

b) 次ã«ï¼Œæ–‡å­—å‚ç…§åŠã³å†…部&parsed-entity;ã¸ã®å‚ç…§ã¯ï¼Œå±•é–‹ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。外部実体ã¸ã®å‚ç…§ã¯ï¼Œ&error;ã¨ã™ã‚‹ã€‚

c) 最後ã«ï¼Œå±žæ€§ã®åž‹ãŒCDATAã§ãªã‘ã‚Œã°ï¼Œç©ºç™½&string;ã¯ï¼Œã™ã¹ã¦&space-character;(#x20)一ã¤ã«æ­£è¦åŒ–ã—，残りã®ç©ºç™½æ–‡å­—ã¯ï¼Œå‰Šé™¤ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

&non-validating;&parser;ã¯ï¼Œå®£è¨€ãŒè¦‹ã¤ã‹ã‚‰ãªã„属性ã¯ï¼Œã™ã¹ã¦ï¼ŒCDATAを宣言ã—ã¦ã„ã‚‹ã¨ã—ã¦æ‰±ã†ã“ã¨ãŒæœ›ã¾ã—ã„。

 æ¡ä»¶ä»˜ãセクション

æ¡ä»¶ä»˜ãセクションã¨ã¯ï¼Œæ–‡æ›¸åž‹å®£è¨€ã®å¤–部⊂ã®ä¸€éƒ¨ã¨ã—，制御キーワードã®æŒ‡å®šã«ã‚ˆã£ã¦ï¼ŒDTDã®è«–ç†æ§‹é€ ã«å«ã‚ãŸã‚Šï¼Œé™¤ã„ãŸã‚Šã™ã‚‹éƒ¨åˆ†ã¨ã™ã‚‹ã€‚ æ¡ä»¶ä»˜ãセクション conditionalSect includeSect | ignoreSect includeSect '<![' S? 'INCLUDE' S? '[' extSubset ']]>' ignoreSect '<![' S? 'IGNORE' S? '[' ignoreSectContents* ']]>' ignoreSectContents Ignore ('<![' ignoreSectContents ']]>' Ignore)* Ignore Char* - (Char* ('<![' | ']]>') Char*)

æ¡ä»¶ä»˜ãセクションã¯ï¼ŒDTDã®å†…部⊂åŠã³å¤–部⊂ã¨åŒæ§˜ã«ï¼Œå®Œå…¨ãªå®£è¨€ï¼Œã‚³ãƒ¡ãƒ³ãƒˆåˆã¯å…¥ã‚Œå­ã«ãªã£ãŸæ¡ä»¶ä»˜ãセクションを，ã„ãã¤ã‹å«ã‚“ã§ã‚ˆã„。ã“れらã®é–“ã«ï¼Œç©ºç™½ãŒç¾ã‚Œã¦ã‚‚よã„。

æ¡ä»¶ä»˜ãセクションã®ã‚­ãƒ¼ãƒ¯ãƒ¼ãƒ‰ãŒINCLUDEãªã‚‰ã°ï¼ŒXML&processor;ã¯ï¼Œã“ã®æ¡ä»¶ä»˜ãセクションã®å†…容を，文書ã®ä¸€éƒ¨ã¨ã—ã¦æ‰±ã‚ãªã‘ã‚Œã°ãªã‚‰ãªã„。æ¡ä»¶ä»˜ãセクションã®ã‚­ãƒ¼ãƒ¯ãƒ¼ãƒ‰ãŒIGNOREãªã‚‰ã°ï¼Œãã®æ¡ä»¶ä»˜ãセクションã®å†…容ã¯ï¼Œæ–‡æ›¸ã®ä¸€éƒ¨ã¨ã—ã¦æ‰±ã‚ãªã„。構文解æžã‚’æ­£ã—ãè¡Œã†ãŸã‚ã«ã¯ï¼Œç„¡è¦–ã™ã‚‹æ¡ä»¶ä»˜ãセクション(IGNORE)ã«é–¢ã—ã¦ã‚‚，内容を読ã¾ãªã‘ã‚Œã°ãªã‚‰ãªã„ã“ã¨ã«æ³¨æ„ã™ã‚‹ã“ã¨ã€‚ã“ã‚Œã¯ï¼Œå…¥ã‚Œå­ã«ãªã£ãŸæ¡ä»¶ä»˜ãセクションを見ã¤ã‘，(無視ã™ã‚‹)最も外å´ã®æ¡ä»¶ä»˜ãセクションを正ã—ã検出ã™ã‚‹ãŸã‚ã¨ã™ã‚‹ã€‚キーワードをINCLUDEã¨ã™ã‚‹å°ã•ãªæ¡ä»¶ä»˜ãセクションãŒï¼Œã‚­ãƒ¼ãƒ¯ãƒ¼ãƒ‰ã‚’IGNOREã¨ã™ã‚‹ã‚ˆã‚Šå¤§ããªæ¡ä»¶ä»˜ãセクションã«å«ã¾ã‚Œã‚‹ãªã‚‰ã°ï¼Œå¤–å´åŠã³å†…å´ã®æ¡ä»¶ä»˜ãセクションã®ä¸¡æ–¹ã¨ã‚‚無視ã™ã‚‹ã€‚

æ¡ä»¶ä»˜ãセクションã®ã‚­ãƒ¼ãƒ¯ãƒ¼ãƒ‰ãŒãƒ‘ラメタ実体å‚ç…§ãªã‚‰ã°ï¼ŒXML&processor;ã¯æ¡ä»¶ä»˜ãセクションã®æ‰±ã„を判断ã™ã‚‹å‰ã«ï¼Œã“ã®ãƒ‘ラメタ実体を展開ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

例を次ã«ç¤ºã™ã€‚ <!ENTITY % draft 'INCLUDE' > <!ENTITY % final 'IGNORE' > <![%draft;[ <!ELEMENT book (comments*, title, body, supplements?)> ]]> <![%final;[ <!ELEMENT book (title, body, supplements?)> ]]>

物ç†æ§‹é€ 

XML文書ã¯ï¼Œä¸€ã¤ä»¥ä¸Šã®è¨˜æ†¶å˜ä½ã‹ã‚‰æ§‹æˆã™ã‚‹ã€‚ã“ã®è¨˜æ†¶å˜ä½ã‚’，実体ã¨ã„ã†ã€‚実体ã¯ï¼Œå†…容をもã¡ï¼Œæ–‡æ›¸å®Ÿä½“(以é™å‚ç…§)åŠã³å¤–部DTD⊂を除ã„ã¦ï¼Œåå‰ã§&identified;。 å„XML文書ã¯ï¼Œæ–‡æ›¸å®Ÿä½“ã¨å‘¼ã¶å®Ÿä½“を一ã¤ã‚‚ã¤ã€‚XML&processor;ã¯ï¼Œã“ã®æ–‡æ›¸å®Ÿä½“ã‹ã‚‰å‡¦ç†ã‚’開始ã™ã‚‹ã€‚文書実体ãŒï¼Œæ–‡æ›¸ã®ã™ã¹ã¦ã‚’å«ã‚“ã§ã‚‚よã„。

実体ã¯ï¼Œ&parsed-entity;åˆã¯&unparsed-entity;ã¨ã™ã‚‹ã€‚&parsed-entity;ã®å†…容ã¯ï¼Œ&parsed-entity;ã®&replacement-text;ã¨å‘¼ã¶ã€‚ã“ã®ãƒ†ã‚­ã‚¹ãƒˆã¯ï¼Œæ–‡æ›¸ã®æœ¬ä½“ã®ä¸€éƒ¨ã¨ã—ã¦è§£é‡ˆã™ã‚‹ã€‚

&unparsed-entity;ã¯ï¼Œå†…容ãŒãƒ†ã‚­ã‚¹ãƒˆã§ã‚‚ãã†ã§ãªãã¨ã‚‚よã„リソースã¨ã™ã‚‹ã€‚テキストã®å ´åˆï¼ŒXMLã§ãªãã¨ã‚‚よã„。å„&unparsed-entity;ã«ã¯ï¼Œè¨˜æ³•ãŒé–¢é€£ä»˜ã‘られ，ã“ã®è¨˜æ³•ã¯ï¼Œåå‰ã§&identified;。記法ã®åå‰åŠã³é–¢é€£ä»˜ã‘られãŸ&identifier;を，XML&processor;ãŒ&application;ã«æ¸¡ã™ã¨ã„ã†è¦ä»¶ä»¥å¤–ã¯ï¼ŒXMLã¯ï¼Œ&unparsed-entity;ã®å†…容を制é™ã—ãªã„。

&parsed-entity;ã¯ï¼Œå®Ÿä½“å‚ç…§ã«ã‚ˆã£ã¦åå‰ã§å‘¼ã³å‡ºã™ã€‚&unparsed-entity;ã¯ï¼ŒENTITYåž‹åˆã¯ENTITIESåž‹ã®å±žæ€§ã®å€¤ã¨ã—ã¦ï¼Œåå‰ã§å‚ç…§ã™ã‚‹ã€‚

一般実体ã¯ï¼Œæ–‡æ›¸å†…容ã®ä¸­ã§ä½¿ç”¨ã™ã‚‹&parsed-entity;ã¨ã™ã‚‹ã€‚ã‚ã„ã¾ã„ã«ãªã‚‰ãªã„é™ã‚Šï¼Œã“ã®&TR-or-Rec;ã§ã¯ï¼Œä¸€èˆ¬å®Ÿä½“ã‚’å˜ã«å®Ÿä½“ã¨å‘¼ã¶ã€‚パラメタ実体ã¯ï¼ŒDTD内ã§ä½¿ç”¨ã™ã‚‹&parsed-entity;ã¨ã™ã‚‹ã€‚ã“れらã®ï¼’種類ã®å®Ÿä½“ã¯ï¼Œç•°ãªã‚‹æ›¸å¼ã§å‚ç…§ã—，異ãªã‚‹æ–‡è„ˆã§èªè­˜ã™ã‚‹ã€‚

文字å‚ç…§åŠã³å®Ÿä½“å‚ç…§

文字å‚ç…§ã¯ï¼ŒISO/IEC 10646文字集åˆã®ç‰¹å®šã®æ–‡å­—，例ãˆã°ï¼Œå…¥åŠ›æ©Ÿå™¨ã‹ã‚‰ç›´æŽ¥å…¥åŠ›ä¸å¯èƒ½ãªæ–‡å­—ã‚’å‚ç…§ã™ã‚‹ã€‚ 文字å‚ç…§ CharRef '&#' [0-9]+ ';' | '&hcro;' [0-9a-fA-F]+ ';' 正当ãªæ–‡å­—

文字å‚ç…§ã§å‚ç…§ã™ã‚‹æ–‡å­—ã¯ï¼Œéžçµ‚端記å·Charã«å¾“ã‚ãªã‘ã‚Œã°ãªã‚‰ãªã„。

文字㌠"&#x" ã§å§‹ã¾ã‚Œã°ï¼Œçµ‚端㮠";" ã¾ã§ã®æ•°å­—åŠã³ã‚¢ãƒ«ãƒ•ã‚¡ãƒ™ãƒƒãƒˆã¯ï¼ŒISO/IEC 10646 ã®æ–‡å­—コードã®16進数表ç¾ã¨ã™ã‚‹ã€‚ 文字㌠"&#" ã§å§‹ã¾ã‚Œã°ï¼Œçµ‚端㮠";" ã¾ã§ã®æ•°å­—ã¯ï¼Œæ–‡å­—コードã®10進数表ç¾ã¨ã™ã‚‹ã€‚

実体å‚ç…§ã¯ï¼Œåå‰ã®ä»˜ã„ãŸå®Ÿä½“ã®å†…容をå‚ç…§ã™ã‚‹ã€‚一般実体ã¸ã®å‚ç…§ã¯ï¼Œã‚¢ãƒ³ãƒ‘サンド(&)åŠã³ã‚»ãƒŸã‚³ãƒ­ãƒ³(;)を区切りå­ã¨ã—ã¦ç”¨ã„る。パラメタ実体ã¸ã®å‚ç…§ã¯ï¼Œãƒ‘ーセント記å·(%)åŠã³ã‚»ãƒŸã‚³ãƒ­ãƒ³(;)を区切りå­ã¨ã—ã¦ç”¨ã„る。

実体å‚ç…§ Reference EntityRef | CharRef EntityRef '&' Name ';' PEReference '%' Name ';' 実体ãŒå®£è¨€ã•ã‚Œã¦ã„ã‚‹ã“ã¨

DTDã‚’ã‚‚ãŸãªã„文書，パラメタ実体å‚照をå«ã¾ãªã„内部DTD⊂ã ã‘ã‚’ã‚‚ã¤æ–‡æ›¸ï¼Œåˆã¯ "standalone='yes'" ã‚’ã‚‚ã¤æ–‡æ›¸ã«ãŠã„ã¦ï¼Œå®Ÿä½“å‚ç…§ã§ç”¨ã„ã‚‹ Name ã¯ï¼Œãã®å®Ÿä½“ã®å®£è¨€ã§ä¸Žãˆã‚‹åå‰ã¨ï¼Œ&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。ãŸã ã—，&well-formed;ã®æ–‡æ›¸ã¯ï¼Œå®Ÿä½“&magicents; を宣言ã™ã‚‹å¿…è¦ã¯ãªã„。パラメタ実体ã®å ´åˆã¯ï¼Œå®£è¨€ã¯ï¼Œå‚ç…§ã«å…ˆè¡Œã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。åŒæ§˜ã«ï¼Œä¸€èˆ¬å®Ÿä½“ã®å ´åˆã¯ï¼Œå±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ã®&default-value;内ã§ã®å‚照より先ã«ï¼Œå®£è¨€ãŒç¾ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。

外部⊂åˆã¯å¤–部パラメタ実体ã§å®Ÿä½“を宣言ã™ã‚‹ã¨ã，&non-validating;&processor;ãŒï¼Œå®£è¨€ã‚’読ã¿ï¼Œå‡¦ç†ã™ã‚‹ã“ã¨ã‚’義務ã¥ã‘ãªã„。ãれらã®æ–‡æ›¸ã§ã¯ï¼Œå®Ÿä½“ã¯å®£è¨€ã•ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„ã¨ã„ã†è¦å‰‡ã¯ï¼Œ&well-formed;制約ã§ã¯ãªã„。

実体ãŒå®£è¨€ã•ã‚Œã¦ã„ã‚‹ã“ã¨

外部⊂åˆã¯å¤–部パラメタ実体をもã£ã¦ã„ã¦ï¼Œ"standalone='no'"ã‚’ã‚‚ã¤æ–‡æ›¸ã«ãŠã„ã¦ï¼Œå®Ÿä½“å‚ç…§ã§ç”¨ã„ã‚‹ Name ã¯ï¼Œãã®å®Ÿä½“ã®å®£è¨€ã§ä¸Žãˆã‚‹åå‰ã¨&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。相互é‹ç”¨æ€§ã®ãŸã‚，&valid;ãªæ–‡æ›¸ã¯ã‚らã‹ã˜ã‚定義ã—ãŸå®Ÿä½“ã®è¦å®šã§æŒ‡å®šã—ãŸæ›¸å¼ã«ã‚ˆã£ã¦ï¼Œå®Ÿä½“ &magicents;を宣言ã™ã‚‹ã“ã¨ãŒæœ›ã¾ã—ã„。パラメタ実体ã®å ´åˆã¯ï¼Œå®£è¨€ã¯ï¼Œå‚ç…§ã«å…ˆè¡Œã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。åŒæ§˜ã«ï¼Œä¸€èˆ¬å®Ÿä½“ã®å ´åˆã¯ï¼Œå±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ã®&default-value;内ã§ã®å‚照よりも先ã«ï¼Œå®£è¨€ãŒç¾ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。

&parsed-entity;

実体å‚ç…§ã¯ï¼Œ&unparsed-entity;ã®åå‰ã‚’å«ã‚“ã§ã„ã¦ã¯ãªã‚‰ãªã„。&unparsed-entity;ã¯ï¼ŒENTITYåž‹åˆã¯ENTITIES åž‹ã¨ã—ã¦å®£è¨€ã—ãŸå±žæ€§å€¤ã¨ã—ã¦ã ã‘å‚ç…§ã§ãる。

å†å¸°ãªã—

&parsed-entity;ã¯ï¼Œãれ自体ã¸ã®å‚照を，直接ã«ã‚‚間接ã«ã‚‚å«ã‚“ã§ã¯ãªã‚‰ãªã„。

 DTDã®ä¸­

パラメタ実体å‚ç…§ã¯ï¼ŒDTD内ã«ã ã‘，出ç¾ã—ã¦ã‚ˆã„。

文字å‚ç…§åŠã³å®Ÿä½“å‚ç…§ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ Type <key>less-than</key> (&hcro;3C;) to save options. This document was prepared on &docdate; and is classified &security-level;.

パラメタ実体å‚ç…§ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <!ENTITY % ISOLat2 SYSTEM "http://www.xml.com/iso/isolat2-xml.entities" > %ISOLat2;

実体宣言

実体ã¯ï¼Œæ¬¡ã®ã¨ãŠã‚Šã«å®£è¨€ã™ã‚‹ã€‚ 実体宣言 EntityDecl GEDecl一般実体 | PEDeclパラメタ実体 GEDecl '<!ENTITY' S Name S EntityDef S? '>' PEDecl | '<!ENTITY' S '%' S Name S PEDef S? '>' パラメタ実体 EntityDef EntityValue | ExternalDef PEDef EntityValue | ExternalID Name ã¯ï¼Œå®Ÿä½“å‚ç…§ã«ãŠã„ã¦å®Ÿä½“ã‚’&identify;。&unparsed-entity;ãªã‚‰ã°ï¼ŒENTITY åž‹åˆã¯ENTITIESåž‹ã®å±žæ€§å€¤å†…ã§ï¼Œå®Ÿä½“ã‚’&identify;。åŒä¸€ã®å®Ÿä½“ãŒä¸€å›žä»¥ä¸Šå®£è¨€ã•ã‚Œã‚Œã°ï¼Œæœ€åˆã®å®£è¨€ã‚’用ã„る。&at-user-option;，複数回宣言ã•ã‚Œã‚‹å®Ÿä½“ã«é–¢ã—，XML&processor;ã¯ï¼Œè­¦å‘Šã‚’出ã—ã¦ã‚‚よã„。

内部実体

実体ã®å®šç¾©ãŒ EntityValueã®ã¨ã，ã“れを内部実体ã¨ã„ã†ã€‚ã“ã‚Œã¯ï¼Œåˆ¥å€‹ã®ç‰©ç†çš„記憶å˜ä½ã‚’ã‚‚ãŸãšï¼Œå®Ÿä½“ã®å†…容ã¯ï¼Œå®£è¨€å†…ã§ä¸Žãˆã‚‹ã€‚æ­£ã—ã&replacement-text;を生æˆã™ã‚‹ã«ã¯ï¼Œ&literal;実体値内ã§ã®å®Ÿä½“å‚ç…§åŠã³æ–‡å­—å‚ç…§ã®å‡¦ç†ãŒï¼Œå¿…è¦ã¨ãªã‚‹ã‹ã‚‚ã—ã‚Œãªã„ã“ã¨ã«æ³¨æ„ã™ã‚‹ã€‚詳細ã¯ï¼Œå†…部実体ã®&replacement-text;ã®æ§‹ç¯‰ã‚’å‚照。

内部実体ã¯ï¼Œ&parsed-entity;ã¨ã™ã‚‹ã€‚

内部実体宣言ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <!ENTITY Pub-Status "This is a pre-release of the specification.">

 外部実体

実体ãŒå†…部実体ã§ãªã‘ã‚Œã°ï¼Œå¤–部実体ã¨ã—，次ã®ã¨ãŠã‚Šã«å®£è¨€ã™ã‚‹ã€‚ 外部実体宣言 ExternalDef ExternalID NDataDecl? ExternalID 'SYSTEM' S SystemLiteral | 'PUBLIC' S PubidLiteral S SystemLiteral NDataDecl S 'NDATA' S Name NDataDecl ãŒå­˜åœ¨ã™ã‚Œã°ï¼Œã“ã®å®Ÿä½“ã¯ï¼Œ&unparsed-entity;ã¨ã—，ãã†ã§ãªã‘ã‚Œã°ï¼Œ&parsed-entity;ã¨ã™ã‚‹ã€‚

記法ãŒå®£è¨€ã•ã‚Œã¦ã„ã‚‹ã“ã¨

Name ã¯ï¼Œå®£è¨€ã—ãŸè¨˜æ³•ã®åå‰ã¨&match;ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

キーワード SYSTEM ã®å¾Œã® SystemLiteral を，実体ã®ã‚·ã‚¹ãƒ†ãƒ &identifier;ã¨å‘¼ã¶ã€‚ã“ã‚Œã¯URIã¨ã—，ãã®å®Ÿä½“ã®å†…容をå–り出ã™ã®ã«ç”¨ã„ã¦ã‚‚よã„。URIã¨å…±ã«ä½¿ã†ã“ã¨ã®å¤šã„ãƒãƒƒã‚·ãƒ¥("#")åŠã³ãƒ•ãƒ©ã‚°ãƒ¡ãƒ³ãƒˆ&identifier;ã¯ï¼Œæ­£å¼ã«ã¯ï¼ŒURI自体ã®ä¸€éƒ¨ã¨ã¯ã—ãªã„。フラグメント&identifier;ãŒï¼Œã‚·ã‚¹ãƒ†ãƒ &identifier;ã®éƒ¨åˆ†ã¨ã—ã¦ä¸Žãˆã‚‰ã‚Œã¦ã„ã‚‹å ´åˆï¼ŒXML&processor;ã¯ï¼Œ&error;を出ã—ã¦ã‚‚よã„。ã“ã®&TR-or-Rec;ã®ç¯„囲外ã®æƒ…å ±(例ãˆã°ï¼Œã‚る特定ã®DTDã®ç‰¹åˆ¥ãªXMLè¦ç´ åˆã¯ç‰¹å®šã®&application;ã®ä»•æ§˜ã«ã‚ˆã£ã¦å®šç¾©ã•ã‚ŒãŸå‡¦ç†å‘½ä»¤)ã«ã‚ˆã£ã¦ä¸Šæ›¸ãã•ã‚Œãªã„é™ã‚Šï¼Œç›¸å¯¾çš„ãªURIã¯ï¼Œãã®å®Ÿä½“ã®ä½ç½®ï¼Œã™ãªã‚ã¡ï¼Œãã®å®Ÿä½“ã®å®£è¨€ãŒã‚るファイルã«ç›¸å¯¾çš„ã¨ã™ã‚‹ã€‚ã—ãŸãŒã£ã¦ï¼ŒDTDã®å†…部⊂ã«ã‚る実体宣言ã§ã®ç›¸å¯¾çš„ãªURIã¯ï¼Œæ–‡æ›¸ã®ä½ç½®ã«ã¤ã„ã¦ç›¸å¯¾çš„ã¨ã™ã‚‹ã€‚外部⊂ã«ã‚る実体宣言ã§ã®ç›¸å¯¾çš„ãªURIã¯ï¼Œãã®å¤–部⊂ã‚’å«ã‚€ãƒ•ã‚¡ã‚¤ãƒ«ã®ä½ç½®ã«ç›¸å¯¾çš„ã¨ã™ã‚‹ã€‚

システム&identifier;以外ã«ï¼Œå¤–部実体ã¯ï¼Œå…¬é–‹&identifier;ã‚’å«ã‚“ã§ã‚‚よã„。 実体ã®å†…容をå–り出ã™XML&processor;ã¯ï¼Œã“ã®å…¬é–‹&identifier;を用ã„ã¦ï¼Œä»£ã‚ã‚Šã®URIã®ç”Ÿæˆã‚’試ã¿ã¦ã‚‚よã„。XML&processor;ãŒã“ã‚Œã«å¤±æ•—ã—ãŸå ´åˆã¯ï¼Œã‚·ã‚¹ãƒ†ãƒ &literal;ã¨ã—ã¦æŒ‡å®šã—ãŸURIを用ã„ãªã‘ã‚Œã°ãªã‚‰ãªã„。&match;ã™ã‚‹å‰ã«ï¼Œå…¬é–‹&identifier;内ã«ã‚る空白文字ã‹ã‚‰ãªã‚‹&string;ã¯ï¼Œã™ã¹ã¦å˜ä¸€ã®&space-character;(#x20)ã«æ­£è¦åŒ–ã—ãªã‘ã‚Œã°ãªã‚‰ãšï¼Œå‰å¾Œã®ç©ºç™½æ–‡å­—ã¯å‰Šé™¤ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

外部実体宣言ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <!ENTITY open-hatch SYSTEM "http://www.textuality.com/boilerplate/OpenHatch.xml"> <!ENTITY open-hatch PUBLIC "-//Textuality//TEXT Standard open-hatch boilerplate//EN" "http://www.textuality.com/boilerplate/OpenHatch.xml"> <!ENTITY hatch-pic SYSTEM "../grafix/OpenHatch.gif" NDATA gif >

 &parsed-entity; テキスト宣言

外部&parsed-entity;ã¯ï¼Œãƒ†ã‚­ã‚¹ãƒˆå®£è¨€ã§å§‹ã¾ã£ã¦ã‚‚よã„。 テキスト宣言 TextDecl &xmlpio; VersionInfo? EncodingDecl S? &pic;

テキスト宣言ã¯ï¼Œãã®ã¾ã¾ã®å½¢ã§ç¾ã‚Œãªã‘ã‚Œã°ãªã‚‰ãšï¼Œ&parsed-entity;ã¸ã®å‚照を経由ã—ã¦ã¯ãªã‚‰ãªã„ã“ã¨ã«æ³¨æ„ã™ã‚‹ã€‚

外部&parsed-entity;ã«ãŠã„ã¦ï¼Œãƒ†ã‚­ã‚¹ãƒˆå®£è¨€ã¯ï¼Œå…ˆé ­ä»¥å¤–ã®ã„ã‹ãªã‚‹ä½ç½®ã«ã‚‚出ç¾ã—ãªã„。

 &well-formed;ã®&parsed-entity;

ラベルdocumentã‚’ã‚‚ã¤ç”Ÿæˆè¦å‰‡ã«&match;ã™ã‚Œã°ï¼Œæ–‡æ›¸å®Ÿä½“ã¯ï¼Œ&well-formed;ã¨ã™ã‚‹ã€‚ラベルExtParsedEntã‚’ã‚‚ã¤ç”Ÿæˆè¦å‰‡ã«&match;ã™ã‚Œã°ï¼Œå¤–部ã®ä¸€èˆ¬&parsed-entity;ã¯ï¼Œ&well-formed;ã¨ã™ã‚‹ã€‚ラベルExtPEã‚’ã‚‚ã¤ç”Ÿæˆè¦å‰‡ã«&match;ã™ã‚Œã°ï¼Œå¤–部パラメタ実体ã¯ï¼Œ&well-formed;ã¨ã™ã‚‹ã€‚ &well-formed;ã®&parsed-entity; ExtParsedEnt TextDecl? content ExtPE TextDecl? extSubset &replacement-text;ãŒï¼Œãƒ©ãƒ™ãƒ«contentã‚’ã‚‚ã¤ç”Ÿæˆè¦å‰‡ã«&match;ã™ã‚Œã°ï¼Œå†…部ã®ä¸€èˆ¬&parsed-entity;ã¯ï¼Œ&well-formed;ã¨ã™ã‚‹ã€‚DTDを最後ã¾ã§èª­ã¿è¾¼ã¾ãªã„ã¨ï¼Œç¢ºå®Ÿã«ã“れを判定ã§ããªã„ã“ã¨ã«æ³¨æ„。ã™ã¹ã¦ã®å†…部ã®ãƒ‘ラメタ実体ã¯ï¼Œå®šç¾©ã«ã‚ˆã£ã¦&well-formed;ã¨ã™ã‚‹ã€‚

実体ãŒ&well-formed;ãªçµæžœã¨ã—ã¦ï¼ŒXML文書ã®è«–ç†çš„åŠã³ç‰©ç†çš„構造ã¯ï¼Œæ­£ã—ã入れå­ã¨ãªã‚‹ã€‚開始タグ，終了タグ，空è¦ç´ ã‚¿ã‚°ï¼Œè¦ç´ ï¼Œã‚³ãƒ¡ãƒ³ãƒˆï¼Œå‡¦ç†å‘½ä»¤ï¼Œæ–‡å­—å‚ç…§åŠã³å®Ÿä½“å‚ç…§ãŒï¼Œä¸€ã¤ã®å®Ÿä½“ã§é–‹å§‹ã—，別ã®å®Ÿä½“ã§çµ‚了ã™ã‚‹ã“ã¨ã¯ãªã„。

 実体ã«ãŠã‘る文字符å·åŒ–

XML文書内ã®å¤–部&parsed-entity;ã¯ï¼Œå„々，別ã®æ–‡å­—符å·åŒ–æ–¹å¼ã‚’用ã„ã¦ã‚‚よã„。ã™ã¹ã¦ã®XML&processor;ã¯ï¼ŒUTF-8ã§ç¬¦å·åŒ–ã—ãŸå®Ÿä½“，UTF-16ã§ç¬¦å·åŒ–ã—ãŸå®Ÿä½“を処ç†ã§ããªã‘ã‚Œã°ãªã‚‰ãªã„。

UTF-16ã§ç¬¦å·åŒ–ã—ãŸå®Ÿä½“ã¯ï¼ŒISO/IEC 10646ã®ä»˜éŒ²EåŠã³Unicodeã®ä»˜éŒ²Bã§è¦å®šã™ã‚‹&byte-order-mark;(ZERO WIDTH NO-BREAK SPACE文字，#xFEFF)ã§å§‹ã¾ã‚‰ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã“ã‚Œã¯ï¼Œç¬¦å·åŒ–ã®æ¨™è­˜ã§ã‚ã£ã¦ï¼ŒXML文書ã®&markup;ã®ä¸€éƒ¨ã§ã‚‚，文字データã®ä¸€éƒ¨ã§ã‚‚ãªã„。XML&processor;ã¯ï¼ŒUTF-8ã§ç¬¦å·åŒ–ã—ãŸæ–‡æ›¸ã¨UTF-16ã§ç¬¦å·åŒ–ã—ãŸæ–‡æ›¸ã¨ã®åŒºåˆ¥ã‚’è¡Œã†ãŸã‚ã«ï¼Œã“ã®æ–‡å­—を使用å¯èƒ½ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。

XML&processor;ã¯ï¼ŒUTF-8åŠã³UTF-16ã§ç¬¦å·åŒ–ã—ãŸå®Ÿä½“ã ã‘を読むã“ã¨ã‚’å¿…é ˆã¨ã™ã‚‹ãŒï¼Œä»–ã®ç¬¦å·åŒ–を世界ã§ã¯ç”¨ã„ã¦ãŠã‚Šï¼Œãれらã®ç¬¦å·åŒ–を用ã„る実体をXML&processor;ãŒå‡¦ç†ã§ãã‚‹ã“ã¨ãŒæœ›ã¾ã—ã„。UTF-8åˆã¯UTF-16以外ã®ç¬¦å·åŒ–æ–¹å¼ã‚’用ã„ã¦æ ¼ç´ã™ã‚‹&parsed-entity;ã¯ï¼Œç¬¦å·åŒ–宣言をå«ã‚€ãƒ†ã‚­ã‚¹ãƒˆå®£è¨€ã§å§‹ã‚ãªã‘ã‚Œã°ãªã‚‰ãªã„。 符å·åŒ–宣言 EncodingDecl S 'encoding' Eq '"' EncName '"' | "'" EncName "'" EncName [A-Za-z] ([A-Za-z0-9._] | '-')* ラテン文字ã ã‘ã‚’å«ã‚€ç¬¦å·åŒ–å 文書実体ã§ã¯ï¼Œç¬¦å·åŒ–宣言ã¯ï¼ŒXML宣言ã®ä¸€éƒ¨ã¨ã™ã‚‹ã€‚EncNameã¯ï¼Œä½¿ç”¨ã™ã‚‹ç¬¦å·åŒ–æ–¹å¼ã®åå‰ã¨ã™ã‚‹ã€‚

符å·åŒ–宣言ã§ã¯ï¼Œå€¤UTF-8，UTF-16，ISO-10646-UCS-2åŠã³ISO-10646-UCS-4ã¯ï¼ŒUnicodeåŠã³ISO/IEC 10646ã®å„種符å·åŒ–ã®ãŸã‚ã«ç”¨ã„る。値ISO-8859-1ã‹ã‚‰ISO-8859-9ã¾ã§ã¯ï¼ŒISO 8859ã®å¯¾å¿œã™ã‚‹ãƒ‘ートã®ãŸã‚ã«ç”¨ã„る。値ISO-2022-JP，Shift_JISåŠã³EUC-JPã¯ï¼ŒJIS X-0208-1997ã®å„種符å·åŒ–ã®ãŸã‚ã«ç”¨ã„る。XML&processor;ã¯ï¼Œãれ以外ã®ç¬¦å·åŒ–æ–¹å¼ã‚’èªè­˜ã—ã¦ã‚‚よã„。Internet Assigned Numbers Authority (IANA)ã«ï¼Œ(charsetsã¨ã—ã¦)登録ã•ã‚ŒãŸæ–‡å­—符å·åŒ–æ–¹å¼ã«ã¤ã„ã¦ã¯ï¼Œã“れら以外ã«ã¤ã„ã¦ã‚‚，登録ã•ã‚ŒãŸåå‰ã§å‚ç…§ã™ã‚‹ã“ã¨ãŒæœ›ã¾ã—ã„。ã“れらã®ç™»éŒ²ã•ã‚ŒãŸåå‰ã¯ï¼Œå¤§æ–‡å­—・å°æ–‡å­—ã®åŒºåˆ¥ã‚’ã›ãšã«å®šç¾©ã•ã‚Œã¦ã„ã‚‹ã®ã§ï¼Œã“れらã«å¯¾ã™ã‚‹æ¯”較を試ã¿ã‚‹&processor;ã¯ï¼Œå¤§æ–‡å­—・å°æ–‡å­—ã®åŒºåˆ¥ã‚’ã—ãªã„方法をã¨ã‚‹ã®ãŒæœ›ã¾ã—ã„ã“ã¨ã«æ³¨æ„ã™ã‚‹ã€‚

XML処ç†ç³»ã«æ¸¡ã•ã‚ŒãŸå®Ÿä½“ãŒï¼Œç¬¦å·åŒ–宣言をå«ã‚€ã«ã‚‚ã‹ã‹ã‚らãšï¼Œå®£è¨€ã§ç¤ºã—ãŸã‚‚ã®ä»¥å¤–ã®æ–¹å¼ã§ç¬¦å·åŒ–ã•ã‚Œã¦ã„ãŸã‚Šï¼Œç¬¦å·åŒ–宣言ãŒï¼Œå¤–部実体ã®æœ€åˆä»¥å¤–ã®ä½ç½®ã«å‡ºç¾ã™ã‚Œã°ï¼Œ&error;ã¨ã™ã‚‹ã€‚

&byte-order-mark;ã§ã‚‚符å·åŒ–宣言ã§ã‚‚始ã¾ã‚‰ãªã„実体ã¯ï¼ŒUTF-8符å·åŒ–ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。

処ç†ã§ããªã„符å·åŒ–ã‚’ã‚‚ã£ãŸå®Ÿä½“ã‚’XML&processor;ãŒç™ºè¦‹ã—ãŸã¨ãã¯ï¼Œ&application;ã«ãã®äº‹å®Ÿã‚’通知ã—，&fatal-error;ã¨ã—ã¦ï¼Œå‡¦ç†ã‚’終了ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

符å·åŒ–宣言ã®ä¾‹ã‚’，次ã«ç¤ºã™ã€‚ <?xml encoding='UTF-8'?> <?xml encoding='EUC-JP'?>

 XML&processor;ã«ã‚ˆã‚‹å®Ÿä½“åŠã³å‚ç…§ã®æ‰±ã„

次ã®è¡¨ã¯ï¼Œæ–‡å­—å‚照，実体å‚ç…§åŠã³&unparsed-entity;ã®å‘¼å‡ºã—ãŒç¾ã‚Œã‚‹æ–‡è„ˆåŠã³å„々ã®å ´åˆã«ãŠã‘ã‚‹XML&processor;ã«è¦æ±‚ã™ã‚‹æŒ¯èˆžã„ã‚’è¦ç´„ã™ã‚‹ã€‚一番左ã®åˆ—ã®ãƒ©ãƒ™ãƒ«ã¯ï¼Œèªè­˜ã®æ–‡è„ˆã‚’示ã™ã€‚

è¦ç´ ã®é–‹å§‹ã‚¿ã‚°åŠã³çµ‚了タグã®é–“ã®ä»»æ„ã®å ´æ‰€ã§ã®å‚照。éžçµ‚端記å·contentã«å¯¾å¿œã™ã‚‹ã€‚

開始タグã®å±žæ€§ã®å€¤ï¼Œåˆã¯å±žæ€§å®£è¨€ã«ãŠã‘ã‚‹&default-value;ã®ã„ãšã‚Œã‹ã§ã®å‚照。éžçµ‚端記å·AttValueã«å¯¾å¿œã™ã‚‹ã€‚

å‚ç…§ã§ã¯ãªã，Nameã¨ã—ã¦å‡ºç¾ã€‚ENTITYåž‹ã¨ã—ã¦å®£è¨€ã—ãŸå±žæ€§ã®å€¤ï¼Œåˆã¯ENTITIESåž‹ã¨ã—ã¦å®£è¨€ã—ãŸå±žæ€§ã®å€¤ã«ãŠã‘ã‚‹&space;ã§åŒºåˆ‡ã‚‹&token;ã®ä¸€ã¤ã¨ã—ã¦å‡ºç¾ã™ã‚‹ã€‚

実体ã®å®£è¨€ã«ãŠã‘る，パラメタåˆã¯å†…部実体ã®&literal;実体値内ã®å‚照。éžçµ‚端記å·EntityValueã«å¯¾å¿œã™ã‚‹ã€‚

DTDã®å†…部⊂åˆã¯å¤–部⊂ã§ã®å‚照。ãŸã ã—，EntityValueåˆã¯AttValueã®å¤–å´ã¨ã™ã‚‹ã€‚

実体ã®åž‹ 文字 パラメタ 内部&newline;一般 外部&newline;&parsed-entity;&newline;一般 &unparsed-entity; 内容ã§ã®&newline;å‚ç…§ èªè­˜&newline;ã—ãªã„ å–込㿠検証ã®ãŸã‚ã«å–込㿠ç¦æ­¢ å–込㿠属性値ã§ã®&newline;å‚ç…§ èªè­˜&newline;ã—ãªã„ å–込㿠ç¦æ­¢ ç¦æ­¢ å–込㿠属性値ã¨ã—ã¦&newline;å‡ºç¾ èªè­˜&newline;ã—ãªã„ ç¦æ­¢ ç¦æ­¢ 通知 èªè­˜&newline;ã—ãªã„ 実体値ã§ã®&newline;å‚ç…§ å–込㿠&bypass; &bypass; ç¦æ­¢ å–込㿠DTDã§ã®&newline;å‚ç…§ PEã¨ã—ã¦&newline;å–込㿠ç¦æ­¢ ç¦æ­¢ ç¦æ­¢ ç¦æ­¢ “èªè­˜ã—ãªã„â€

DTDã®å¤–ã§ã¯ï¼Œ%文字ã¯ï¼Œã„ã‹ãªã‚‹ç‰¹å®šã®æ„味も，もãŸãªã„。ã—ãŸãŒã£ã¦ï¼ŒDTDã§ã¯ãƒ‘ラメタ実体å‚ç…§ã¨ã—ã¦èªè­˜ã™ã‚‹ã‚‚ã®ã§ã‚ã£ã¦ã‚‚，content内ã§ã¯&markup;ã¨ã—ã¦ã¯èªè­˜ã—ãªã„。åŒæ§˜ã«ï¼Œé©åˆ‡ã«å®£è¨€ã—ãŸå±žæ€§ã®å€¤ã®ä¸­ã«ç¾ã‚Œã‚‹å ´åˆã‚’除ã，&unparsed-entity;ã®åå‰ã¯ï¼Œèªè­˜ã—ãªã„。

“å–è¾¼ã¿â€

実体ã¯ï¼Œãã®&replacement-text;ã‚’å–り出ã—，処ç†ã™ã‚‹ã¨ï¼Œå‚照自体ã®ä»£ã‚ã‚Šã«ï¼Œå‚ç…§ãŒã‚ã£ãŸä½ç½®ã§ï¼Œæ–‡æ›¸ã®ä¸€éƒ¨ã¨ã—ã¦å«ã¾ã‚Œã‚‹ã‹ã®ã‚ˆã†ã«å–ã‚Šè¾¼ã¾ã‚Œã‚‹ã€‚&replacement-text;ã¯ï¼Œæ–‡å­—データåŠã³(パラメタ実体を除ã。)&markup;ã®ã„ãšã‚Œã‚’å«ã‚“ã§ã‚‚よã，ã“れらã¯ï¼Œé€šå¸¸ã®æ–¹æ³•ã§èªè­˜ã•ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。ãŸã ã—，&markup;ã®åŒºåˆ‡ã‚Šå­ã‚’&escape;ã™ã‚‹ãŸã‚ã«ç”¨ã„る実体(&magicents;)ã®&replacement-text;ã¯ï¼Œå¸¸ã«ãƒ‡ãƒ¼ã‚¿ã¨ã—ã¦æ‰±ã†(&string;"AT&amp;T;"ã¯ï¼Œ"AT&T;"ã«å±•é–‹ã•ã‚Œï¼Œæ®‹ã•ã‚ŒãŸã‚¢ãƒ³ãƒ‘サンドã¯ï¼Œå®Ÿä½“å‚ç…§ã®åŒºåˆ‡ã‚Šå­ã¨ã—ã¦ã¯èªè­˜ã—ãªã„。)。文字å‚ç…§ã¯ï¼Œç¤ºã—ãŸæ–‡å­—ã‚’å‚照自体ã®ä»£ã‚ã‚Šã«å‡¦ç†ã™ã‚‹ã¨ã，å–ã‚Šè¾¼ã¾ã‚Œã‚‹ã€‚

“検証ã®ãŸã‚ã«å–è¾¼ã¿â€

文書ã®&validity;を検証ã™ã‚‹ã«ã¯ï¼ŒXML&processor;ãŒ&parsed-entity;ã¸ã®å‚照をèªè­˜ã—ãŸã¨ã，ãã®&replacement-text;ã‚’å–ã‚Šè¾¼ã¾ãªã‘ã‚Œã°ãªã‚‰ãªã„。実体ãŒå¤–部実体ã§ã‚ã£ã¦ï¼ŒXML文書ã®&validity;を検証ã—ãªã‘ã‚Œã°ï¼Œå®Ÿä½“ã®&replacement-text;ã‚’å–り込んã§ã‚‚よã„ãŒï¼Œãã†ã—ãªãã¨ã‚‚よã„。

ã“ã®å–決ã‚ã¯ï¼ŒSGMLåŠã³XMLã®å®Ÿä½“ã®æ©Ÿæ§‹ãŒæä¾›ã™ã‚‹è‡ªå‹•å–è¾¼ã¿æ©Ÿèƒ½ãŒï¼Œæ–‡æ›¸ä½œæˆæ™‚ã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«åŒ–を主ãªç›®çš„ã¨ã—ã¦è¨­è¨ˆã•ã‚Œã¦ãŠã‚Šï¼Œãã®ä»–ã®&application;(特ã«ï¼Œæ–‡æ›¸ã®ãƒ–ラウズ)ã«ã¯ï¼Œå¿…ãšã—ã‚‚é©åˆ‡ã§ã¯ãªã„，ã¨ã„ã†èªè­˜ã«ã‚ˆã‚‹ã€‚例ãˆã°ï¼Œãƒ–ラウザã¯å¤–部&parsed-entity;ã¸ã®å‚照を見ã¤ã‘ã‚‹ã¨ï¼Œãã®å®Ÿä½“ãŒå­˜åœ¨ã™ã‚‹ã¨ã„ã†è¡¨ç¤ºã ã‘ã‚’è¡Œã„，表示をè¦æ±‚ã•ã‚ŒãŸã¨ãã«ã ã‘，内容をå–り出ã™ã‹ã‚‚ã—ã‚Œãªã„。

“ç¦æ­¢â€

次ã¯ç¦æ­¢ã•ã‚Œã¦ãŠã‚Šï¼Œ&fatal-error;ã¨ã™ã‚‹ã€‚

a) &unparsed-entity;ã¸ã®å‚ç…§ã®å‡ºç¾ã€‚

b) DTDã®EntityValueåˆã¯AttValue以外ã®éƒ¨åˆ†ã«ãŠã‘る，文字å‚ç…§åˆã¯ä¸€èˆ¬å®Ÿä½“ã¸ã®å‚ç…§ã®å‡ºç¾ã€‚

c) 属性値内ã®å¤–部実体ã¸ã®å‚照。

“通知â€

&unparsed-entity;ã®åå‰ãŒï¼ŒENTITYåˆã¯ENTITIESã®å±žæ€§ã®å€¤ã«ãŠã„ã¦&token;ã¨ã—ã¦ç¾ã‚ŒãŸã¨ã，&processor;ã¯ï¼Œ&application;ã«å¯¾ã—ã¦ï¼Œé–¢é€£ä»˜ã‘られãŸè¨˜æ³•å，記法ã«å¯¾ã™ã‚‹ã‚·ã‚¹ãƒ†ãƒ &identifier;åŠã³(存在ã™ã‚Œã°)公開&identifier;を通知ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

 “&bypass;â€

一般実体å‚ç…§ãŒï¼Œå®Ÿä½“宣言ã«ãŠã‘ã‚‹EntityValue内ã«ç¾ã‚Œã‚‹ã¨ã，ãã‚Œã¯ç„¡è¦–ã•ã‚Œï¼Œãã®ã¾ã¾æ®‹ã‚‹ã€‚

 “PEã¨ã—ã¦å–è¾¼ã¿â€

外部&parsed-entity;ã®å ´åˆã¨åŒæ§˜ã«ï¼Œãƒ‘ラメタ実体ã¯ï¼Œ&validity;を検証ã™ã‚‹ã¨ãã ã‘å–ã‚Šè¾¼ã¾ã‚Œã‚‹å¿…è¦ãŒã‚る。パラメタ実体å‚照をDTD内ã«èªè­˜ã—ã¦å–り込むã¨ã，ãã®&replacement-text;ã¯ï¼Œãã®å‰å¾Œã«ä¸€ã¤ã®&space-character;(#x20)ã®ä»˜åŠ ã«ã‚ˆã£ã¦å¼•ã伸ã°ã•ã‚Œã‚‹ã€‚ã“ã®æ„図ã¯ï¼Œãƒ‘ラメタ実体ã®&replacement-text;ãŒï¼ŒDTD内ã®ã„ãã¤ã‹ã®æ–‡æ³•çš„&token;を完全ã«å«ã‚€ã¨ï¼Œåˆ¶ç´„ã™ã‚‹ã“ã¨ã«ã‚る。

内部実体&replacement-text;ã®æ§‹ç¯‰

内部実体ã®å–扱ã„ã®è¦å®šã§ï¼Œå®Ÿä½“値を二ã¤ã®å½¢å¼ã«åŒºåˆ¥ã™ã‚‹ã“ã¨ã¯å½¹ã«ç«‹ã¤ã€‚&literal;実体値ã¯ï¼Œå®Ÿä½“宣言内ã«å®Ÿéš›ã«å­˜åœ¨ã™ã‚‹ï¼Œå¼•ç”¨ç¬¦ã§å›²ã‚€&string;ã¨ã™ã‚‹ã€‚ã“ã‚Œã¯ï¼Œéžçµ‚端記å·EntityValueã«&match;ã™ã‚‹ã€‚&replacement-text;ã¯ï¼Œæ–‡å­—å‚ç…§åŠã³¶meter;実体å‚ç…§ã®ç½®æ›ãˆå¾Œã«ãŠã‘る，実体ã®å†…容ã¨ã™ã‚‹ã€‚

内部実体宣言内ã§ä¸Žãˆã‚‹&literal;実体値(EntityValue)ã¯ï¼Œæ–‡å­—å‚照，¶meter;実体å‚ç…§åŠã³ä¸€èˆ¬å®Ÿä½“å‚照をå«ã‚“ã§ã‚ˆã„。ã“れらã®å‚ç…§ã¯ï¼Œ&literal;実体値内ã«å®Œå…¨ã«å«ã¾ã‚Œã¦ã„ãªã‘ã‚Œã°ãªã‚‰ãªã„。展開ã™ã‚‹å®Ÿéš›ã®&replacement-text;(å…ˆã«ç¤ºã—ãŸã‚‚ã®)ã¯ï¼Œå‚ç…§ã™ã‚‹¶meter;実体ã®&replacement-text;ã‚’å«ã¾ãªã‘ã‚Œã°ãªã‚‰ãšï¼Œ&literal;実体値内ã§ã®æ–‡å­—å‚ç…§ã®ä»£ã‚ã‚Šã«å‚ç…§ã—ãŸæ–‡å­—ã‚’å«ã¾ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã—ã‹ã—，一般実体å‚ç…§ã¯ï¼Œãã®ã¾ã¾æ®‹ã—, 展開ã—ã¦ã¯ãªã‚‰ãªã„。 例ãˆã°ï¼Œæ¬¡ã®å®£è¨€ã‚’与ãˆãŸã¨ã™ã‚‹ã€‚ ]]> 実体ã®&replacement-text;"book"ã¯ï¼Œæ¬¡ã®ã¨ãŠã‚Šã¨ãªã‚‹ã€‚ La Peste: Albert Camus, © 1947 Éditions Gallimard. &rights; å‚ç…§"&book;"ãŒï¼Œæ–‡æ›¸ã®å†…容åˆã¯å±žæ€§å€¤å†…ã«å‡ºç¾ã—ã¦ã„ã‚Œã°ï¼Œä¸€èˆ¬å®Ÿä½“å‚ç…§"&rights;"ã¯ï¼Œå±•é–‹ã•ã‚Œã¦ã„る。

ã“れらã®å˜ç´”ãªè¦å‰‡ã¯ï¼Œè¤‡åˆç›¸äº’作用をもã¤ã€‚ 難ã—ã„例ã«ã¤ã„ã¦ã®è©³ç´°ã¯ï¼Œå®Ÿä½“å‚ç…§ã®å±•é–‹ã®ä»˜éŒ²ã‚’å‚ç…§ã®ã“ã¨ã€‚

定義済ã¿å®Ÿä½“

実体å‚ç…§åŠã³æ–‡å­—å‚ç…§ã®ã„ãšã‚Œã‚‚，&left-angle-bracket;，アンãƒã‚µãƒ³ãƒ‰åŠã³ä»–ã®åŒºåˆ‡ã‚Šå­ã‚’&escape;ã™ã‚‹ãŸã‚ã«ä½¿ç”¨ã§ãる。ã„ãã¤ã‹ã®ä¸€èˆ¬å®Ÿä½“（&magicents;）を，ã“ã®ç›®çš„ã®ãŸã‚ã«æŒ‡å®šã™ã‚‹ã€‚数値ã«ã‚ˆã‚‹æ–‡å­—å‚照も，åŒæ§˜ã®ç›®çš„ã®ãŸã‚ã«ä½¿ç”¨ã§ãる。文字å‚ç…§ã¯ï¼Œèªè­˜ã•ã‚Œã‚‹ã¨ç›´ã¡ã«å±•é–‹ã•ã‚Œï¼Œæ–‡å­—データã¨ã—ã¦æ‰±ã‚れるã®ã§ï¼Œæ•°å€¤ã«ã‚ˆã‚‹æ–‡å­—å‚ç…§"&#60;"åŠã³"&#38;"ã¯ï¼Œæ–‡å­—データ内ã«å‡ºç¾ã™ã‚‹<åŠã³&ã‚’&escape;ã™ã‚‹ãŸã‚ã«ä½¿ç”¨ã§ãる。

ã™ã¹ã¦ã®XML&processor;ã¯ï¼Œå®£è¨€ã•ã‚Œã¦ã„ã‚‹ã‹ã©ã†ã‹ã«é–¢ä¿‚ãªã，ã“れらã®å®Ÿä½“ã‚’èªè­˜ã—ãªãã¦ã¯ãªã‚‰ãªã„。相互é‹ç”¨æ€§ã®ãŸã‚，&valid;ãªXML文書ã¯ï¼Œã“れらã®å®Ÿä½“を使用ã™ã‚‹å‰ã«ï¼Œä»–ã®å®Ÿä½“ã¨åŒæ§˜ã«ï¼Œå®£è¨€ã™ã‚‹ã“ã¨ãŒæœ›ã¾ã—ã„。実体を宣言ã™ã‚‹å ´åˆã¯ï¼Œ&replacement-text;ã‚’&escape;ã™ã‚‹ä¸€æ–‡å­—ã¨ã™ã‚‹å†…部実体ã¨ã—ã¦ï¼Œæ¬¡ã®ã¨ãŠã‚Šã«å®£è¨€ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。 ]]> "lt"åŠã³"amp"宣言内ã®"<"åŠã³"&"文字ã¯ï¼Œå®Ÿä½“ã®ç½®æ›ãƒ†ã‚­ã‚¹ãƒˆãŒï¼Œ&well-formed;ã¨ãªã‚‹ã‚ˆã†ã«äºŒé‡ã«&escape;ã•ã‚Œã‚‹ã“ã¨ã«æ³¨æ„。

記法宣言

記法ã¯ï¼Œ&unparsed-entity;ã®å½¢å¼ã‚’&identify;åå‰ã‹ï¼Œåˆã¯å‡¦ç†å‘½ä»¤ã®å¯¾è±¡ã¨ã™ã‚‹&application;ã‚’&identify;åå‰ã¨ã™ã‚‹ã€‚

記法宣言ã¯ï¼Œè¨˜æ³•ã®åå‰åŠã³å¤–部&identifier;ã‚’æä¾›ã™ã‚‹ã€‚ã“ã®åå‰ã¯ï¼Œå®Ÿä½“åŠã³å±žæ€§ãƒªã‚¹ãƒˆå®£è¨€ä¸¦ã³ã«å±žæ€§æŒ‡å®šã«ç”¨ã„る。外部&identifier;ã¯ï¼Œä¸Žãˆã‚‰ã‚ŒãŸè¨˜æ³•ã®ãƒ‡ãƒ¼ã‚¿ã‚’処ç†ã§ãるヘルパ&application;を，XML&processor;åˆã¯ã‚¯ãƒ©ã‚¤ã‚¢ãƒ³ãƒˆã‚¢ãƒ—リケーションãŒæŽ¢ã™ãŸã‚ã«ï¼Œåˆ©ç”¨ã§ãる。 記法宣言 NotationDecl '<!NOTATION' S Name S (ExternalID | PublicID) S? '>' PublicID 'PUBLIC' S PubidLiteral

宣言ã—，属性値，属性定義åˆã¯å®Ÿä½“宣言ã§å‚ç…§ã™ã‚‹ã™ã¹ã¦ã®è¨˜æ³•ã«ã¤ã„ã¦ï¼ŒXML&processor;ã¯ï¼Œè¨˜æ³•ã®åå‰åŠã³å¤–部&identifier;ã‚’&application;ã«æä¾›ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã•ã‚‰ã«ï¼Œå¤–部&identifier;を，システム&identifier;，ファイルååˆã¯ãã®ä»–ã®æƒ…å ±ã«å±•é–‹ã—ã¦ã‚‚よã，ã“れらを用ã„ã¦ï¼Œ&application;ã¯ï¼Œãã®è¨˜æ³•ã®ãƒ‡ãƒ¼ã‚¿ã‚’処ç†ã™ã‚‹&processor;ã‚’èµ·å‹•ã™ã‚‹ã€‚(ã—ã‹ã—，XML&processor;åˆã¯&application;ãŒå‹•ä½œã™ã‚‹ã‚·ã‚¹ãƒ†ãƒ ã§ã¯åˆ©ç”¨ã§ããªã„記法を，XML文書ãŒå®£è¨€ã—å‚ç…§ã—ã¦ã‚‚，ã“ã‚Œã¯ï¼Œ&error;ã¨ã¯ã—ãªã„。）

 文書実体

文書実体ã¯ï¼Œå®Ÿä½“ã®å½¢æˆã™ã‚‹æœ¨æ§‹é€ ã®&root;ã§ã‚ã£ã¦ï¼ŒXML&processor;ãŒï¼Œå‡¦ç†ã‚’開始ã™ã‚‹åœ°ç‚¹ã¨ã™ã‚‹ã€‚ã“ã®&TR-or-Rec;ã¯ï¼ŒXML&processor;ãŒï¼Œæ–‡æ›¸å®Ÿä½“ã®å­˜åœ¨ã™ã‚‹å ´æ‰€ã‚’ã©ã®ã‚ˆã†ã«è¦‹ã¤ã‘ã‚‹ã‹ã¯ï¼Œè¦å®šã—ãªã„。他ã®å®Ÿä½“ã¨ç•°ãªã‚Šï¼Œæ–‡æ›¸å®Ÿä½“ã¯åå‰ã‚’ã‚‚ãŸãšï¼Œã„ã‹ãªã‚‹è­˜åˆ¥ã‚‚ãªã—ã«&processor;ã¸ã®å…¥åŠ›&stream;ã«å‡ºç¾ã—ã¦ã‚‚よã„。

 é©åˆæ€§

é©åˆã™ã‚‹XML&processor;ã¯ï¼Œ&validating;ã‚‚ã®åŠã³&non-validating;ã‚‚ã®ã®ï¼ŒäºŒã¤ã«åˆ†é¡žã•ã‚Œã‚‹ã€‚

&validating;システムåŠã³&non-validating;システムã¯ï¼Œã“ã®&TR-or-Rec;ãŒè¦å®šã™ã‚‹&well-formed;制約ã¸ã®é•åを報告ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

&validating;&processor;ã¯ï¼ŒDTD内ã®å®£è¨€ã«ã‚ˆã£ã¦ç¤ºã•ã‚ŒãŸï¼Œåˆ¶ç´„ã¸ã®é•åを報告ã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã•ã‚‰ã«ï¼Œã“ã®&TR-or-Rec;ãŒè¦å®šã™ã‚‹&validity;制約ã¸ã®é•åを，ã™ã¹ã¦å ±å‘Šã—ãªã‘ã‚Œã°ãªã‚‰ãªã„。

記法

XMLã®å½¢å¼çš„ãªæ–‡æ³•ã¯ï¼Œç°¡å˜ãªæ‹¡å¼µBackus-Naur Form(EBNF)記法ã«ã‚ˆã£ã¦ä¸Žãˆã‚‹ã€‚文法ã®å„è¦å‰‡ã¯ï¼Œæ¬¡ã®å½¢å¼ã§ï¼Œè¨˜å·ã‚’一ã¤å®šç¾©ã™ã‚‹ã€‚ symbol ::= expression

記å·ã¯ï¼Œæ­£è¦è¡¨ç¾ã§å®šç¾©ã™ã‚‹ã¨ãã¯å¤§æ–‡å­—ã§å§‹ã‚，ãã†ã§ãªã‘ã‚Œã°ï¼Œå°æ–‡å­—ã§å§‹ã‚る。&string;&literal;ã¯ï¼Œå¼•ç”¨ç¬¦ã§å›²ã‚€ã€‚

è¦å‰‡ã®å³å´ã®å¼å†…ã§ã¯ï¼Œä¸€ã¤åˆã¯è¤‡æ•°ã®æ–‡å­—ã‹ã‚‰ãªã‚‹&string;ã¨&match;ã™ã‚‹ãŸã‚ã«ï¼Œæ¬¡ã®å¼ã‚’使用ã™ã‚‹ã€‚

ã“ã“ã§ï¼ŒNã¯16進ã®æ•´æ•°ã¨ã™ã‚‹ã€‚ISO/IEC 10646ã®æ–‡å­—ã§ã‚ã£ã¦ï¼Œæ­£è¦å½¢(UCS-4)ã®&code-value;を符å·ãªã—2進数ã¨ã—ã¦è§£é‡ˆã—ãŸã¨ã，指定ã—ãŸå€¤ã¨ç­‰ã—ã„ã‚‚ã®ã¨&match;ã™ã‚‹ã€‚#xNå½¢å¼ã®å…ˆé ­ã«ã‚¼ãƒ­ãŒã„ãã¤ã‹ç¾ã‚Œã‚‹ã‹ã¯ï¼Œæ„味をもãŸãªã„。&code-value;ã«ãŠã‘る先頭ã®ã‚¼ãƒ­ã®æ•°ã¯ï¼Œæ–‡å­—ã®ç¬¦å·åŒ–ã«ã‚ˆã£ã¦æ±ºå®šã•ã‚Œã‚‹ã®ã§ï¼ŒXMLã«ã¨ã£ã¦ã¯æ„味ãŒãªã„。

指定ã—ãŸç¯„囲ã®å€¤(両端ã®å€¤ã‚’å«ã‚€ã€‚）をもã¤ä»»æ„ã®æ–‡å­—ã¨&match;ã™ã‚‹ã€‚

指定ã—ãŸç¯„囲外ã®å€¤ã‚’ã‚‚ã¤ä»»æ„ã®æ–‡å­—ã¨&match;ã™ã‚‹ã€‚

指定ã—ãŸæ–‡å­—以外ã®å€¤ã‚’ã‚‚ã¤ä»»æ„ã®æ–‡å­—ã¨&match;ã™ã‚‹ã€‚

&double-quote;ã§å›²ã‚€&string;&literal;ã¨&match;ã—ã¦ã„ã‚‹&string;&literal;ã¨&match;ã™ã‚‹ã€‚

&single-quote;ã§å›²ã‚€&string;&literal;ã¨&match;ã—ã¦ã„ã‚‹&string;&literal;ã¨&match;ã™ã‚‹ã€‚

 ã“れらã®è¨˜å·ã¯ï¼Œæ¬¡ã®å½¢å¼ã®çµ„åˆã›ã§ä½¿ç”¨ã™ã‚‹ã€‚ã“ã“ã§ï¼ŒAåŠã³Bã¯ï¼Œå˜ç´”ãªå¼ã¨ã™ã‚‹ã€‚

expressionã¯ï¼Œä¸€ã¤ã®ã¾ã¨ã¾ã‚Šã¨ã—ã¦æ‰±ã„，ã“ã“ã«ç¤ºã™çµ„åˆã›ã§ä½¿ã£ã¦ã‚‚よã„。

Aåˆã¯ä½•ã‚‚ãªã—ã¨&match;ã™ã‚‹(オプションã®A)。

Aã®æ¬¡ã«BãŒå‡ºç¾ã™ã‚‹ã‚‚ã®ã¨&match;ã™ã‚‹ã€‚

Aåˆã¯B，ãŸã ã—，両方ã§ã¯ãªã„，ã¨&match;ã™ã‚‹ã€‚

Aã¨&match;ã™ã‚‹ãŒï¼ŒBã¨ã¯&match;ã—ãªã„，任æ„ã®&string;ã¨&match;ã™ã‚‹ã€‚

Aã®1回以上ã®ç¹°è¿”ã—ã¨&match;ã™ã‚‹ã€‚

Aã®0回以上ã®ç¹°è¿”ã—ã¨&match;ã™ã‚‹ã€‚

 生æˆè¦å‰‡å†…ã§ä½¿ç”¨ã™ã‚‹ä»–ã®è¨˜æ³•ã‚’，次ã«ç¤ºã™ã€‚

コメント。

&well-formed;制約。生æˆè¦å‰‡ã«ä»˜ä¸Žã—ãŸï¼Œ&well-formed;ã®æ–‡æ›¸ã«é–¢ã™ã‚‹åˆ¶ç´„を，åå‰ã«ã‚ˆã£ã¦&identify;。

&validity;制約。生æˆè¦å‰‡ã«ä»˜ä¸Žã—ãŸï¼Œ&valid;ãªæ–‡æ›¸ã«é–¢ã™ã‚‹åˆ¶ç´„を，åå‰ã«ã‚ˆã£ã¦&identify;。

å‚考文献 &normative;å‚考文献 IETF (Internet Engineering Task Force). RFC 1766: Tags for the Identification of Languages, ed. H. Alvestrand. 1995. (International Organization for Standardization). ISO 8879:1988 (E). Code for the representation of names of languages. [Geneva]: International Organization for Standardization, 1988. (International Organization for Standardization). ISO 3166-1:1997 (E). Codes for the representation of names of countries and their subdivisions — Part 1: Country codes [Geneva]: International Organization for Standardization, 1997. ISO (International Organization for Standardization). ISO/IEC 10646-1993 (E). Information technology — Universal Multiple-Octet Coded Character Set (UCS) — Part 1: Architecture and Basic Multilingual Plane. [Geneva]: International Organization for Standardization, 1993 (plus amendments AM 1 through AM 7). The Unicode Consortium. The Unicode Standard, Version 2.0. Reading, Mass.: Addison-Wesley Developers Press, 1996. ä»–ã®å‚考文献 Aho, Alfred V., Ravi Sethi, and Jeffrey D. Ullman. Compilers: Principles, Techniques, and Tools. Reading: Addison-Wesley, 1986, rpt. corr. 1988. Berners-Lee, T., R. Fielding, and L. Masinter. Uniform Resource Identifiers (URI): Generic Syntax and Semantics. 1997. (Work in progress; see updates to RFC1738.) Brüggemann-Klein, Anne. Regular Expressions into Finite Automata. Extended abstract in I. Simon, Hrsg., LATIN 1992, S. 97-98. Springer-Verlag, Berlin 1992. Full Version in Theoretical Computer Science 120: 197-213, 1993. Brüggemann-Klein, Anne, and Derick Wood. Deterministic Regular Languages. Universität Freiburg, Institut für Informatik, Bericht 38, Oktober 1991. IETF (Internet Engineering Task Force). RFC 1738: Uniform Resource Locators (URL), ed. T. Berners-Lee, L. Masinter, M. McCahill. 1994. IETF (Internet Engineering Task Force). RFC 1808: Relative Uniform Resource Locators, ed. R. Fielding. 1995. IETF (Internet Engineering Task Force). RFC 2141: URN Syntax, ed. R. Moats. 1997. ISO (International Organization for Standardization). ISO/IEC 8879-1986 (E). Information processing — Text and Office Systems — Standard Generalized Markup Language (SGML). First edition — 1986-10-15. [Geneva]: International Organization for Standardization, 1986. ISO (International Organization for Standardization). ISO/IEC 10744-1992 (E). Information technology — Hypermedia/Time-based Structuring Language (HyTime). [Geneva]: International Organization for Standardization, 1992. Extended Facilities Annexe. [Geneva]: International Organization for Standardization, 1996. 文字クラス

Unicode標準ã«å®šç¾©ã™ã‚‹&property;ã«ã—ãŸãŒã£ã¦ï¼Œæ–‡å­—ã¯ï¼Œ&base-character;(BaseChar)(ã“れらã¯ï¼Œ&diacritical-mark;を除ãラテンアルファベットã®ã‚¢ãƒ«ãƒ•ã‚¡ãƒ™ãƒƒãƒˆæ–‡å­—ã‚’å«ã‚€)，&ideographic;(ideographic)åŠã³&combining-character;(CombiningChar)(ã“ã®ã‚¯ãƒ©ã‚¹ã¯ï¼Œã»ã¨ã‚“ã©ã®&diacritical-mark;ã‚’å«ã‚€)ã«ã‚¯ãƒ©ã‚¹åˆ†ã‘ã™ã‚‹ã€‚ã“れらã®ã‚¯ãƒ©ã‚¹ã¯ï¼Œçµåˆã—，&letter;(Letter)ã®ã‚¯ãƒ©ã‚¹ã¨ãªã‚‹ã€‚10進数値(Digit)åŠã³&extender;(Extender)も区別ã™ã‚‹ã€‚ 文字 Letter BaseChar | Ideographic BaseChar [#x0041-#x005A] | [#x0061-#x007A] | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x00FF] | [#x0100-#x0131] | [#x0134-#x013E] | [#x0141-#x0148] | [#x014A-#x017E] | [#x0180-#x01C3] | [#x01CD-#x01F0] | [#x01F4-#x01F5] | [#x01FA-#x0217] | [#x0250-#x02A8] | [#x02BB-#x02C1] | #x0386 | [#x0388-#x038A] | #x038C | [#x038E-#x03A1] | [#x03A3-#x03CE] | [#x03D0-#x03D6] | #x03DA | #x03DC | #x03DE | #x03E0 | [#x03E2-#x03F3] | [#x0401-#x040C] | [#x040E-#x044F] | [#x0451-#x045C] | [#x045E-#x0481] | [#x0490-#x04C4] | [#x04C7-#x04C8] | [#x04CB-#x04CC] | [#x04D0-#x04EB] | [#x04EE-#x04F5] | [#x04F8-#x04F9] | [#x0531-#x0556] | #x0559 | [#x0561-#x0586] | [#x05D0-#x05EA] | [#x05F0-#x05F2] | [#x0621-#x063A] | [#x0641-#x064A] | [#x0671-#x06B7] | [#x06BA-#x06BE] | [#x06C0-#x06CE] | [#x06D0-#x06D3] | #x06D5 | [#x06E5-#x06E6] | [#x0905-#x0939] | #x093D | [#x0958-#x0961] | [#x0985-#x098C] | [#x098F-#x0990] | [#x0993-#x09A8] | [#x09AA-#x09B0] | #x09B2 | [#x09B6-#x09B9] | [#x09DC-#x09DD] | [#x09DF-#x09E1] | [#x09F0-#x09F1] | [#x0A05-#x0A0A] | [#x0A0F-#x0A10] | [#x0A13-#x0A28] | [#x0A2A-#x0A30] | [#x0A32-#x0A33] | [#x0A35-#x0A36] | [#x0A38-#x0A39] | [#x0A59-#x0A5C] | #x0A5E | [#x0A72-#x0A74] | [#x0A85-#x0A8B] | #x0A8D | [#x0A8F-#x0A91] | [#x0A93-#x0AA8] | [#x0AAA-#x0AB0] | [#x0AB2-#x0AB3] | [#x0AB5-#x0AB9] | #x0ABD | #x0AE0 | [#x0B05-#x0B0C] | [#x0B0F-#x0B10] | [#x0B13-#x0B28] | [#x0B2A-#x0B30] | [#x0B32-#x0B33] | [#x0B36-#x0B39] | #x0B3D | [#x0B5C-#x0B5D] | [#x0B5F-#x0B61] | [#x0B85-#x0B8A] | [#x0B8E-#x0B90] | [#x0B92-#x0B95] | [#x0B99-#x0B9A] | #x0B9C | [#x0B9E-#x0B9F] | [#x0BA3-#x0BA4] | [#x0BA8-#x0BAA] | [#x0BAE-#x0BB5] | [#x0BB7-#x0BB9] | [#x0C05-#x0C0C] | [#x0C0E-#x0C10] | [#x0C12-#x0C28] | [#x0C2A-#x0C33] | [#x0C35-#x0C39] | [#x0C60-#x0C61] | [#x0C85-#x0C8C] | [#x0C8E-#x0C90] | [#x0C92-#x0CA8] | [#x0CAA-#x0CB3] | [#x0CB5-#x0CB9] | #x0CDE | [#x0CE0-#x0CE1] | [#x0D05-#x0D0C] | [#x0D0E-#x0D10] | [#x0D12-#x0D28] | [#x0D2A-#x0D39] | [#x0D60-#x0D61] | [#x0E01-#x0E2E] | #x0E30 | [#x0E32-#x0E33] | [#x0E40-#x0E45] | [#x0E81-#x0E82] | #x0E84 | [#x0E87-#x0E88] | #x0E8A | #x0E8D | [#x0E94-#x0E97] | [#x0E99-#x0E9F] | [#x0EA1-#x0EA3] | #x0EA5 | #x0EA7 | [#x0EAA-#x0EAB] | [#x0EAD-#x0EAE] | #x0EB0 | [#x0EB2-#x0EB3] | #x0EBD | [#x0EC0-#x0EC4] | [#x0F40-#x0F47] | [#x0F49-#x0F69] | [#x10A0-#x10C5] | [#x10D0-#x10F6] | #x1100 | [#x1102-#x1103] | [#x1105-#x1107] | #x1109 | [#x110B-#x110C] | [#x110E-#x1112] | #x113C | #x113E | #x1140 | #x114C | #x114E | #x1150 | [#x1154-#x1155] | #x1159 | [#x115F-#x1161] | #x1163 | #x1165 | #x1167 | #x1169 | [#x116D-#x116E] | [#x1172-#x1173] | #x1175 | #x119E | #x11A8 | #x11AB | [#x11AE-#x11AF] | [#x11B7-#x11B8] | #x11BA | [#x11BC-#x11C2] | #x11EB | #x11F0 | #x11F9 | [#x1E00-#x1E9B] | [#x1EA0-#x1EF9] | [#x1F00-#x1F15] | [#x1F18-#x1F1D] | [#x1F20-#x1F45] | [#x1F48-#x1F4D] | [#x1F50-#x1F57] | #x1F59 | #x1F5B | #x1F5D | [#x1F5F-#x1F7D] | [#x1F80-#x1FB4] | [#x1FB6-#x1FBC] | #x1FBE | [#x1FC2-#x1FC4] | [#x1FC6-#x1FCC] | [#x1FD0-#x1FD3] | [#x1FD6-#x1FDB] | [#x1FE0-#x1FEC] | [#x1FF2-#x1FF4] | [#x1FF6-#x1FFC] | #x2126 | [#x212A-#x212B] | #x212E | [#x2180-#x2182] | [#x3041-#x3094] | [#x30A1-#x30FA] | [#x3105-#x312C] | [#xAC00-#xD7A3] Ideographic [#x4E00-#x9FA5] | #x3007 | [#x3021-#x3029] CombiningChar [#x0300-#x0345] | [#x0360-#x0361] | [#x0483-#x0486] | [#x0591-#x05A1] | [#x05A3-#x05B9] | #x05BB#x05BD | #x05BF | [#x05C1-#x05C2] | #x05C4 | #x064B#x0652 | #x0670 | [#x06D6-#x06DC] | #x06DD#x06DF | [#x06E0-#x06E4] | [#x06E7-#x06E8] | [#x06EA-#x06ED] | [#x0901-#x0903] | #x093C | [#x093E-#x094C] | #x094D | [#x0951-#x0954] | [#x0962-#x0963] | [#x0981-#x0983] | #x09BC | #x09BE | #x09BF | [#x09C0-#x09C4] | [#x09C7-#x09C8] | [#x09CB-#x09CD] | #x09D7 | [#x09E2-#x09E3] | #x0A02 | #x0A3C | #x0A3E | #x0A3F | [#x0A40-#x0A42] | [#x0A47-#x0A48] | [#x0A4B-#x0A4D] | [#x0A70-#x0A71] | [#x0A81-#x0A83] | #x0ABC | [#x0ABE-#x0AC5] | [#x0AC7-#x0AC9] | [#x0ACB-#x0ACD] | [#x0B01-#x0B03] | #x0B3C | [#x0B3E-#x0B43] | [#x0B47-#x0B48] | [#x0B4B-#x0B4D] | [#x0B56-#x0B57] | [#x0B82-#x0B83] | [#x0BBE-#x0BC2] | [#x0BC6-#x0BC8] | [#x0BCA-#x0BCD] | #x0BD7 | [#x0C01-#x0C03] | [#x0C3E-#x0C44] | [#x0C46-#x0C48] | [#x0C4A-#x0C4D] | [#x0C55-#x0C56] | [#x0C82-#x0C83] | [#x0CBE-#x0CC4] | [#x0CC6-#x0CC8] | [#x0CCA-#x0CCD] | [#x0CD5-#x0CD6] | [#x0D02-#x0D03] | [#x0D3E-#x0D43] | [#x0D46-#x0D48] | [#x0D4A-#x0D4D] | #x0D57 | #x0E31 | [#x0E34-#x0E3A] | [#x0E47-#x0E4E] | #x0EB1 | [#x0EB4-#x0EB9] | [#x0EBB-#x0EBC] | [#x0EC8-#x0ECD] | [#x0F18-#x0F19] | #x0F35 | #x0F37 | #x0F39 | #x0F3E | #x0F3F | [#x0F71-#x0F84] | [#x0F86-#x0F8B] | [#x0F90-#x0F95] | #x0F97 | [#x0F99-#x0FAD] | [#x0FB1-#x0FB7] | #x0FB9 | [#x20D0-#x20DC] | #x20E1 | [#x302A-#x302F] | #x3099 | #x309A Digit [#x0030-#x0039] | [#x0660-#x0669] | [#x06F0-#x06F9] | [#x0966-#x096F] | [#x09E6-#x09EF] | [#x0A66-#x0A6F] | [#x0AE6-#x0AEF] | [#x0B66-#x0B6F] | [#x0BE7-#x0BEF] | [#x0C66-#x0C6F] | [#x0CE6-#x0CEF] | [#x0D66-#x0D6F] | [#x0E50-#x0E59] | [#x0ED0-#x0ED9] | [#x0F20-#x0F29] Extender #x00B7 | #x02D0 | #x02D1 | #x0387 | #x0640 | #x0E46 | #x0EC6 | #x3005 | [#x3031-#x3035] | [#x309D-#x309E] | [#x30FC-#x30FE]

ã“ã“ã§å®šç¾©ã™ã‚‹æ–‡å­—クラスã¯ï¼ŒUnicode文字データベースã‹ã‚‰ï¼Œæ¬¡ã®ã¨ãŠã‚Šã«å¾—ã‚‹ã“ã¨ãŒã§ãる。

a) åå‰é–‹å§‹æ–‡å­—ã¯ï¼ŒLl, Lu, Lo, Lt, Nlカテゴリ内ã®ä¸€ã¤ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。

b) åå‰é–‹å§‹æ–‡å­—以外ã®åå‰æ–‡å­—ã¯ï¼ŒMc, Me, Mn, Lm, Ndカテゴリ内ã®ä¸€ã¤ã§ãªã‘ã‚Œã°ãªã‚‰ãªã„。

c) &compatibility-area;ã«ã‚る文字(文字符å·ã§#xF900より大ãã#xFFFEよりå°ã•ã„文字)ã¯ï¼ŒXMLã«ãŠã‘ã‚‹åå‰ã¨ã—ã¦ã¯ï¼Œè¨±ã•ã‚Œãªã„。

d) &font-decomposition;ã‹&compatibility-decomposition;ã‚’ã‚‚ã¤æ–‡å­—(ã¤ã¾ã‚Šï¼Œãƒ‡ãƒ¼ã‚¿ãƒ™ãƒ¼ã‚¹å†…ã®ï¼•ç•ªç›®ã®ãƒ•ã‚£ãƒ¼ãƒ«ãƒ‰ã«"compatibility formatting tag"ãŒã‚ã‚‹ã‚‚ã®ã€‚ã“ã‚Œã¯ï¼Œï¼•ç•ªç›®ã®ãƒ•ã‚£ãƒ¼ãƒ«ãƒ‰ãŒï¼Œ"<"ã§å§‹ã¾ã‚‹ã“ã¨ã«ã‚ˆã£ã¦ãƒžãƒ¼ã‚¯ä»˜ã‘ã•ã‚Œã‚‹ã€‚)ã¯ï¼Œè¨±ã•ã‚Œãªã„。

e) 次ã®æ–‡å­—ã¯ï¼Œåå‰é–‹å§‹æ–‡å­—ã¨ã—ã¦æ‰±ã†ã€‚ã“ã‚Œã¯ï¼Œ&property-file;ãŒï¼Œã“れらã®æ–‡å­—をアルファベットã«é¡žä¼¼ã™ã‚‹ã¨è¦‹ãªã™ã“ã¨ã«ã‚ˆã‚‹ã€‚ãれら㯠[#x02BB-#x02C1], #x0559, #x06E5, #x06E6ã¨ã™ã‚‹ã€‚

f) 文字符å·ãŒ#x20DD-#x20E0ã®æ–‡å­—ã¯ï¼Œ(Unicode ã®5.14ã«ã—ãŸãŒã£ã¦)除外ã™ã‚‹ã€‚

g) 文字符å·ãŒ#x00B7ã®æ–‡å­—ã¯ï¼Œ&property-list;ã«ã—ãŸãŒã£ã¦ï¼Œ&extender;(extender)ã«åˆ†é¡žã™ã‚‹ã€‚

h) 文字#x0387ã¯ï¼Œã“ã‚Œã«ç›¸å½“ã™ã‚‹æ­£è¦å½¢ãŒ#x00B7ãªã®ã§ï¼Œåå‰æ–‡å­—ã«è¿½åŠ ã™ã‚‹ã€‚

i) 文字':'åŠã³'_'ã¯ï¼Œåå‰é–‹å§‹æ–‡å­—ã¨ã—ã¦è¨±ã™ã€‚

j) 文字'-'åŠã³'.'ã¯ï¼Œåå‰æ–‡å­—ã¨ã—ã¦è¨±ã™ã€‚

XMLåŠã³SGML

XMLã¯ï¼ŒSGMLã®⊂ã¨ã—ã¦è¨­è¨ˆã•ã‚Œã¦ã„る。ã™ãªã‚ã¡ï¼Œã™ã¹ã¦ã®&valid;ãªXML文書ã¯ï¼Œè¦æ ¼ã«é©åˆã™ã‚‹SGML文書ã«ã‚‚ãªã‚‹ã€‚SGMLãŒæ–‡æ›¸ã«èª²ã™åˆ¶é™ä»¥å¤–ã«ï¼ŒXMLãŒã„ã‹ãªã‚‹åˆ¶é™ã‚’課ã™ã‹ã«é–¢ã™ã‚‹è©³ç´°ã¯ï¼Œåˆ¥ã®è¦ç¨‹ã‚’å‚ç…§ã®ã“ã¨ã€‚ã“ã®è¦ç¨‹ã¯ï¼ŒXMLã®åˆ¶ç´„æ¡ä»¶ã‚’示ã™SGML宣言をå«ã¿ï¼Œã“ã‚Œã¯ï¼ŒSGML&parser;ã«ä½¿ç”¨ã§ãる。

実体å‚ç…§åŠã³æ–‡å­—å‚ç…§ã®å±•é–‹

ã“ã®ä»˜éŒ²ã¯ï¼Œå®Ÿä½“å‚ç…§åŠã³æ–‡å­—å‚照をèªè­˜ã—，展開ã™ã‚‹ï¼Œä¸€é€£ã®æµã‚Œã‚’，例ã«ä½¿ã£ã¦ç¤ºã™ã€‚

DTDãŒï¼Œæ¬¡ã®å®£è¨€ã‚’å«ã‚€å ´åˆã‚’考ãˆã‚‹ã€‚ An ampersand (&#38;) may be escaped numerically (&#38;#38;) or with a general entity (&amp;).

" > ]]> XML&processor;ã¯ï¼Œå®Ÿä½“ã®å®£è¨€ã‚’構文解æžã—ãŸæ™‚点ã§æ–‡å­—å‚照をèªè­˜ã—，ã“れを解決ã™ã‚‹ã€‚実体"example"ã®å€¤ã¨ã—ã¦ï¼Œæ¬¡ã®&string;ã‚’ä¿å­˜ã™ã‚‹ã€‚ An ampersand (&) may be escaped numerically (&#38;) or with a general entity (&amp;).

]]> 文書内ã§"&example;"ã‚’å‚ç…§ã™ã‚‹ã¨ï¼Œã“ã®ãƒ†ã‚­ã‚¹ãƒˆã¯ï¼Œå†ã³æ§‹æ–‡è§£æžã•ã‚Œã‚‹ã€‚ã“ã®ã¨ã，è¦ç´ "p"ã®é–‹å§‹ã‚¿ã‚°åŠã³çµ‚了タグをèªè­˜ã—，三ã¤ã®å‚照をèªè­˜ã—展開ã™ã‚‹ã€‚ãã®çµæžœï¼Œè¦ç´ "p"ã¯ï¼Œæ¬¡ã®å†…容をもã¤(ã™ã¹ã¦ãƒ‡ãƒ¼ã‚¿ã¨ã—，区切りå­åˆã¯&markup;ã¯å­˜åœ¨ã—ãªã„。)。

è¦å‰‡åŠã³ãã®åŠ¹æžœã‚’より詳細ã«ç¤ºã™ãŸã‚，ã•ã‚‰ã«è¤‡é›‘ãªä¾‹ã‚’示ã™ã€‚次ã®ä¾‹ã§ï¼Œè¡Œç•ªå·ã¯ï¼Œå‚ç…§ã®ä¾¿å®œã®ãŸã‚ã ã‘ã«ä»˜ã‘る。 2 4 5 ' > 6 %xx; 7 ]> 8 This sample shows a &tricky; method. ]]> ã“れを処ç†ã™ã‚‹ã¨ï¼Œæ¬¡ã®ã¨ãŠã‚Šã¨ãªã‚‹ã€‚

a) 4行目ã§ï¼Œ37番目ã®æ–‡å­—ã¸ã®å‚照を直ã¡ã«å±•é–‹ã—，パラメタ実体"xx"を，シンボルテーブルã«"%zz;"ã¨ã„ã†å€¤ã¨ã¨ã‚‚ã«ä¿å­˜ã™ã‚‹ã€‚&replacement-text;ã‚’å†ã³èµ°æŸ»ã™ã‚‹ã“ã¨ã¯ãªã„ã®ã§ï¼Œãƒ‘ラメタ実体"zz"ã¸ã®å‚ç…§ã¯èªè­˜ã—ãªã„("zz"ã¯ï¼Œã¾ã å®£è¨€ã•ã‚Œã¦ã„ãªã„ã®ã§ï¼Œèµ°æŸ»ã•ã‚Œã‚Œã°ï¼Œ&error;ã¨ãªã‚‹ã€‚)。

b) 5行目ã§ï¼Œæ–‡å­—å‚ç…§"&#60;"ã‚’ç›´ã¡ã«å±•é–‹ã—，パラメタ実体"zz"ã‚’"<!ENTITY tricky "error-prone" >"ã¨ã„ã†&replacement-text;ã¨ã¨ã‚‚ã«ä¿å­˜ã™ã‚‹ã€‚ã“ã‚Œã¯ï¼Œ&well-formed;ã®å®Ÿä½“宣言ã¨ã™ã‚‹ã€‚

c) 6行目ã§ï¼Œ"xx"ã¸ã®å‚照をèªè­˜ã—，"xx"ã®&replacement-text;(ã™ãªã‚ã¡ï¼Œ"%zz;")を構文解æžã™ã‚‹ã€‚"zz"ã¸ã®å‚照を続ã„ã¦èªè­˜ã—，&replacement-text;("<!ENTITY tricky "error-prone" >")を構文解æžã™ã‚‹ã€‚一般実体"tricky"ã¯ï¼Œã“ã®æ™‚点ã§ã¯ï¼Œå®£è¨€ã•ã‚Œã¦ãŠã‚Šï¼Œãã®&replacement-text;ã¯ï¼Œ"error-prone"ã¨ã™ã‚‹ã€‚

d) 8行目ã§ï¼Œä¸€èˆ¬å®Ÿä½“"tricky"ã¸ã®å‚照をèªè­˜ã—，展開ã™ã‚‹ã€‚è¦ç´ "test"ã®å®Œå…¨ãªå†…容ã¯ï¼Œæ¬¡ã®(内容をãれ自体表ç¾ã™ã‚‹ã€‚)&string;ã¨ãªã‚‹ã€‚ã¤ã¾ã‚Šï¼ŒThis sample shows a error-prone method.

決定的内容モデル

互æ›æ€§ã®ãŸã‚，è¦ç´ å®£è¨€ã«ãŠã‘る内容モデルã¯ï¼Œæ±ºå®šçš„ã¨ã™ã‚‹å¿…è¦ãŒã‚る。

SGMLã¯ï¼Œæ±ºå®šçš„内容モデル(SGMLã§ã¯ï¼Œéžã‚ã„ã¾ã„ã¨å‘¼ã¶ã€‚)ã‚’è¦æ±‚ã™ã‚‹ã€‚SGMLシステムを用ã„ã¦ä½œæˆã—ãŸXML&processor;ã¯ï¼Œéžæ±ºå®šçš„内容モデルを&error;ã¨ã—ã¦ã‚‚よã„。

例ãˆã°ï¼Œå†…容モデル((b, c) | (b, d))ã¯éžæ±ºå®šçš„ã¨ãªã‚‹ã€‚ã“ã‚Œã¯ï¼Œæœ€åˆã«bを与ãˆãŸã¨ã，モデル内ã®ã„ãšã‚Œã®bã¨&match;ã™ã‚‹ã®ãŒæœ›ã¾ã—ã„ã‹ï¼Œãã®æ¬¡ã®è¦ç´ ã‚’先読ã¿ã™ã‚‹ã“ã¨ãªã—ã«ã¯ï¼Œ&parser;ã¯çŸ¥ã‚‹ã“ã¨ãŒã§ããªã„ã“ã¨ã«ã‚ˆã‚‹ã€‚ã“ã®å ´åˆã¯ï¼Œbã¸ã®äºŒã¤ã®å‚ç…§ã¯ï¼Œä¸€ã¤ã®å‚ç…§ã«ã¾ã¨ã‚ã‚‹ã“ã¨ãŒã§ã，モデルã¯ï¼Œ(b, (c | d))ã¨ãªã‚‹ã€‚ã“ã‚Œã§ï¼Œæœ€åˆã®bãŒï¼Œå†…容モデル内ã®ä¸€ã¤ã®åå‰ã¨ã ã‘&match;ã™ã‚‹ã“ã¨ã¯æ˜Žã‚‰ã‹ã¨ãªã‚‹ã€‚&parser;ã¯ï¼Œå…ˆèª­ã¿ã—ã¦ï¼Œæ¬¡ã«æ¥ã‚‹ã‚‚ã®ã‚’知る必è¦ãŒãªã„。cã‚‚dも，å—ç†ã•ã‚Œã‚‹ã€‚

å½¢å¼çš„ã«ç¤ºã™ã€‚Aho, Sethi, and Ullman ã®3.9ã®ã‚¢ãƒ«ã‚´ãƒªã‚ºãƒ 3.5ã®æ¨™æº–çš„ãªã‚¢ãƒ«ã‚´ãƒªã‚ºãƒ ã‚’用ã„ã¦ï¼Œå†…容モデルã‹ã‚‰æœ‰é™ã‚ªãƒ¼ãƒˆãƒžãƒˆãƒ³ã‚’構æˆã™ã‚‹ã“ã¨ãŒã§ãる。ã“ã®ç¨®ã®å¤šãã®ã‚¢ãƒ«ã‚´ãƒªã‚ºãƒ ã§ã¯ï¼Œæ­£è¦è¡¨ç¾ã«ãŠã‘ã‚‹å„々ã®ä½ç½®(ã¤ã¾ã‚Šï¼Œæ­£è¦è¡¨ç¾ã®æ§‹æ–‡æœ¨ã«ãŠã‘ã‚‹å„々ã®æœ«ç«¯ãƒŽãƒ¼ãƒ‰)ã«å¯¾ã—ã¦ï¼Œfollow set(次ã«ã©ã®ä½ç½®ã«ç§»å‹•å¯èƒ½ã‹ã‚’表ã™ã‚‚ã®)を構æˆã™ã‚‹ã€‚ã‚ã‚‹ä½ç½®ã«å¯¾ã™ã‚‹follow setã«ãŠã„ã¦ï¼Œè¤‡æ•°ã®ä½ç½®ãŒåŒã˜è¦ç´ åž‹åã§ãƒ©ãƒ™ãƒ«ä»˜ã‘ã•ã‚Œã¦ã„ã‚Œã°ï¼Œãã®å†…容モデルã¯&error;ã¨ãªã‚Šï¼Œ&error;ã‚’è¿”ã™å ´åˆã‚‚ã‚る。

ã™ã¹ã¦ã®éžæ±ºå®šçš„内容モデルを等価ãªæ±ºå®šçš„内容モデルã«å¤‰æ›ã™ã‚‹ã“ã¨ã¯ã§ããªã„ãŒï¼Œå¤šãã®éžæ±ºå®šçš„内容モデルを変æ›ã™ã‚‹ã‚¢ãƒ«ã‚´ãƒªã‚ºãƒ ãŒå­˜åœ¨ã™ã‚‹ã€‚Brüggemann-Klein 1991 ã‚’å‚ç…§ã®ã“ã¨ã€‚

 文字符å·åŒ–ã®è‡ªå‹•æ¤œå‡º

XMLã®ç¬¦å·åŒ–宣言ã¯ï¼Œå„実体ã®å†…部ラベルã¨ã—ã¦æ©Ÿèƒ½ã—，ã©ã®æ–‡å­—符å·åŒ–を使用ã™ã‚‹ã‹ã‚’示ã™ã€‚ã—ã‹ã—，XML&processor;ã¯ï¼Œå†…部ラベルを読むå‰ã«ï¼Œã©ã®æ–‡å­—符å·åŒ–を使用ã™ã‚‹ã‹ã‚’知る必è¦ãŒã‚り，ã“ã‚ŒãŒï¼Œå†…部ラベルãŒç¤ºãã†ã¨ã™ã‚‹ã“ã¨ã«ãªã‚‹ã€‚一般的ã«ã¯ï¼Œã“ã‚Œã¯ï¼Œçµ¶æœ›çš„ãªçŠ¶æ…‹ã¨ãªã‚‹ã€‚ã—ã‹ã—，XMLã«ãŠã„ã¦ã¯ï¼Œå®Œå…¨ã«ã¯çµ¶æœ›çš„ã§ã¯ãªã„。ã“ã‚Œã¯ï¼ŒXMLãŒï¼Œæ¬¡ã®äºŒã¤ã®ç‚¹ã§ä¸€èˆ¬çš„ãªå ´åˆã«å¯¾ã™ã‚‹åˆ¶é™ã‚’加ãˆã‚‹ã“ã¨ã«ã‚ˆã‚‹ã€‚一ã¤ã®åˆ¶é™ã¯ï¼Œã©ã®å®Ÿè£…も有é™å€‹ã®æ–‡å­—符å·åŒ–ã ã‘ã®ã‚µãƒãƒ¼ãƒˆã‚’想定ã™ã‚‹ã“ã¨ã¨ã™ã‚‹ã€‚ä»–ã®ä¸€ã¤ã®åˆ¶é™ã¯ï¼Œå„実体ã§ä½¿ç”¨ã™ã‚‹æ–‡å­—符å·åŒ–を自動検出å¯èƒ½ã¨ã™ã‚‹ï¼ŒXMLã®ç¬¦å·åŒ–宣言ã®ä½ç½®åŠã³å†…容ã«é–¢ã™ã‚‹åˆ¶é™ã¨ã™ã‚‹ã€‚多ãã®å ´åˆã«ï¼ŒXMLã®ãƒ‡ãƒ¼ã‚¿ã‚¹ãƒˆãƒªãƒ¼ãƒ ã«åŠ ãˆï¼Œä»–ã®æƒ…å ±ãŒåˆ©ç”¨ã§ãる。ã“ã“ã§ã¯ï¼ŒXMLã®å®Ÿä½“ãŒ&processor;ã«æ¸¡ã•ã‚Œã‚‹ã¨ã，(外部)情報を伴ã†ã‹ã©ã†ã‹ã«ã‚ˆã£ã¦ï¼ŒäºŒã¤ã®å ´åˆã«åˆ†ã‘る。ã¾ãšæœ€åˆã®å ´åˆã‚’示ã™ã€‚

UTF-8å½¢å¼åˆã¯UTF-16å½¢å¼ã§ã¯ãªã„XML実体ã¯ï¼Œæœ€åˆã®æ–‡å­—を‘<?xml'ã¨ã™ã‚‹XML符å·åŒ–宣言ã§å§‹ã¾ã‚‰ãªã‘ã‚Œã°ãªã‚‰ãªã„ã®ã§ï¼Œã©ã®é©åˆã—ãŸ&processor;も，入力ã«ã‚ã‚‹2オクテットåˆã¯4オクテットを調ã¹ã‚Œã°ï¼Œæ¬¡ã®ã©ã®å ´åˆãŒã‚ã¦ã¯ã¾ã‚‹ã‹ã‚’検出ã§ãる。ã“ã®ãƒªã‚¹ãƒˆã‚’読む際ã«ã¯ï¼ŒUCS-4ã®'<'ãŒ"#x0000003C"，'?'ãŒ"#x0000003F"，åŠã³UTF-16ã®ãƒ‡ãƒ¼ã‚¿&stream;ã®å¿…è¦ã¨ã™ã‚‹&byte-order-mark;ãŒ"#xFEFF"ã¨ã„ã†ã“ã¨ã‚’知ã£ã¦ãŠãã¨å½¹ç«‹ã¤ã‹ã‚‚ã—ã‚Œãªã„。

a) 00 00 00 3C: UCS-4, big-endian マシン (1234順)

b) 3C 00 00 00: UCS-4, little-endian マシン (4321順)

c) 00 00 3C 00: UCS-4, 普通ã§ã¯ãªã„オクテット順 (2143)

d) 00 3C 00 00: UCS-4, 普通ã§ã¯ãªã„オクテット順 (3412)

e) FE FF: UTF-16, big-endian

f) FF FE: UTF-16, little-endian

g) 00 3C 00 3F: UTF-16, big-endian, &byte-order-mark;ãªã—(ã—ãŸãŒã£ã¦ï¼ŒåŽ³å¯†ã«ã„ãˆã°ï¼Œ&error;ã¨ã™ã‚‹ã€‚)。

h) 3C 00 3F 00: UTF-16, little-endian, &byte-order-mark;ãªã—(ã—ãŸãŒã£ã¦ï¼ŒåŽ³å¯†ã«ã„ãˆã°ï¼Œ&error;ã¨ã™ã‚‹ã€‚)。

i) 3C 3F 78 6D: UTF-8, ISO 646, ASCII, ISO 8859ã®å„パート，Shift-JIS，EUC，並ã³ã«ä»»æ„ã®ä»–ã®7ビット，8ビットåˆã¯æ··åœ¨å¹…ã®ç¬¦å·åŒ–ã§ã‚ã£ã¦ï¼ŒASCII文字を通常ã®ä½ç½®ï¼Œå¹…åŠã³å€¤ã¨ã™ã‚‹ã“ã¨ã‚’ä¿è¨¼ã™ã‚‹ã‚‚ã®ã€‚ã“れらã®ã©ã‚Œã«å¯¾å¿œã™ã‚‹ã‹ã‚’検出ã™ã‚‹ãŸã‚ã«ã¯ï¼Œå®Ÿéš›ã®ç¬¦å·åŒ–宣言を読ã¿è¾¼ã¾ãªã‘ã‚Œã°ãªã‚‰ãªã„。ã—ã‹ã—，ã“れらã™ã¹ã¦ã®ç¬¦å·åŒ–ã¯ï¼ŒASCII文字ã«å¯¾ã—ã¦åŒã˜ãƒ“ットパターンを使用ã™ã‚‹ã®ã§ï¼Œç¬¦å·åŒ–宣言自体ã¯ï¼Œæ­£ç¢ºã«èª­è¾¼ã¿å¯èƒ½ã¨ã™ã‚‹ã€‚

j) 4C 6F A7 94: EBCDIC (åˆã¯ãã®å¤‰ç¨®ã€‚ã©ã®ã‚³ãƒ¼ãƒ‰ãƒšãƒ¼ã‚¸ã‚’使用ã™ã‚‹ã‹ã‚’知るãŸã‚ã«ã¯ï¼Œç¬¦å·åŒ–宣言全体を読ã¿è¾¼ã¾ã‚Œãªã‘ã‚Œã°ãªã‚‰ãªã„。)

k) ãã®ä»–: 符å·åŒ–宣言ãªã—ã®UTF-8。ãã†ã§ãªã„ã¨ãã«ã¯ï¼Œãƒ‡ãƒ¼ã‚¿&stream;ãŒå£Šã‚Œã¦ã„ã‚‹ã‹ï¼Œæ–­ç‰‡çš„ã«ãªã£ã¦ã„ã‚‹ã‹ï¼Œä½•ã‚‰ã‹ã®å½¢å¼ã«ã—ãŸãŒã£ã¦åŸ‹ã‚è¾¼ã¾ã‚Œã¦ã„る。

ã“ã®ç¨‹åº¦ã®è‡ªå‹•åˆ¤åˆ¥ã§ã‚‚，XMLã®ç¬¦å·åŒ–宣言を読ã¿è¾¼ã¿ï¼Œæ–‡å­—符å·åŒ–ã®&identifier;を解æžã™ã‚‹ã«ã¯å分ã¨ã™ã‚‹ã€‚&identifier;ã®è§£æžã¯ï¼Œé¡žä¼¼ã™ã‚‹å„々ã®ç¬¦å·åŒ–ã®ä¸€ã¤ä¸€ã¤ã‚’区別ã™ã‚‹ãŸã‚ã«å¿…è¦ã¨ã™ã‚‹(例ãˆã°ï¼ŒUTF-8åŠã³8859を区別ã™ã‚‹ãŸã‚，8859ã®å„パートを区別ã™ã‚‹ãŸã‚，使用ã—ã¦ã„る特定ã®EBCDICコードページを区別ã™ã‚‹ãŸã‚，ãªã©ã€‚)。

符å·åŒ–宣言ã®å†…容をASCII文字ã«é™å®šã—ã¦ã„ã‚‹ã®ã§ï¼Œã©ã®åˆ†é¡žã®ç¬¦å·åŒ–を使用ã™ã‚‹ã‹ã‚’検出ã™ã‚Œã°ï¼Œ&processor;ã¯ï¼Œç¬¦å·åŒ–宣言全体を正確ã«èª­ã¿è¾¼ã‚€ã“ã¨ãŒã§ãる。ç¾å®Ÿå•é¡Œã¨ã—ã¦ï¼Œåºƒã使用ã•ã‚Œã¦ã„る文字符å·åŒ–ã¯ï¼Œä¸Šã®åˆ†é¡žã®ã„ãšã‚Œã‹ã«ã‚ã¦ã¯ã¾ã‚‹ã®ã§ï¼Œã‚ªãƒšãƒ¬ãƒ¼ãƒ†ã‚£ãƒ³ã‚°ã‚·ã‚¹ãƒ†ãƒ åˆã¯ä¼é€ãƒ—ロトコルãŒä¸Žãˆã‚‹å¤–部情報を信頼ä¸å¯èƒ½ãªã¨ãã§ã•ãˆã‚‚，内部ラベルã§æ–‡å­—符å·åŒ–ã‚’ã‹ãªã‚Šæ­£ç¢ºã«ç¤ºã™ã“ã¨ãŒï¼ŒXML符å·åŒ–宣言ã«ã‚ˆã£ã¦å¯èƒ½ã¨ãªã‚‹ã€‚

&processor;ãŒä½¿ç”¨ã™ã‚‹æ–‡å­—符å·åŒ–を検出ã—ã•ãˆã™ã‚Œã°ï¼Œãã‚Œãžã‚Œã®å ´åˆã«å¯¾ã—ã¦åˆ¥å€‹ã®å…¥åŠ›ãƒ«ãƒ¼ãƒãƒ³ã‚’呼ã³å‡ºã™ï¼Œåˆã¯å…¥åŠ›ã™ã‚‹å„文字ã«å¯¾ã—é©åˆ‡ãªå¤‰æ›é–¢æ•°ã‚’呼ã³å‡ºã™ã“ã¨ã«ã‚ˆã£ã¦ï¼Œé©åˆ‡ãªå‹•ä½œãŒå¯èƒ½ã¨ãªã‚‹ã€‚

自分自体ã«ãƒ©ãƒ™ãƒ«ä»˜ã‘ã‚’ã™ã‚‹ã„ã‹ãªã‚‹ã‚·ã‚¹ãƒ†ãƒ ã§ã‚‚åŒæ§˜ã ãŒï¼Œã‚½ãƒ•ãƒˆã‚¦ã‚§ã‚¢ãŒï¼Œç¬¦å·åŒ–宣言を更新ã›ãšã«å®Ÿä½“ã®æ–‡å­—集åˆåˆã¯ç¬¦å·åŒ–を変ãˆãŸãªã‚‰ã°ï¼ŒXMLã®ç¬¦å·åŒ–宣言ã¯ï¼Œæ©Ÿèƒ½ã—ãªã„。文字符å·åŒ–ルーãƒãƒ³ã®å®Ÿè£…者ã¯ï¼Œå®Ÿä½“ã®ãƒ©ãƒ™ãƒ«ä»˜ã‘ã«ä½¿ç”¨ã™ã‚‹å†…部åŠã³å¤–部ã®æƒ…å ±ã®æ­£ç¢ºã•ã®ä¿è¨¼ã«æ³¨æ„ã™ã‚‹ã®ãŒæœ›ã¾ã—ã„。

２番目ã®å ´åˆã¯ï¼ŒXMLã®å®Ÿä½“ã®ä»–ã«ï¼Œç¬¦å·åŒ–情報ãŒå­˜åœ¨ã™ã‚‹ã¨ãã§ã‚ã£ã¦ï¼Œã„ãã¤ã‹ã®ãƒ•ã‚¡ã‚¤ãƒ«ã‚·ã‚¹ãƒ†ãƒ åŠã³ãƒãƒƒãƒˆãƒ¯ãƒ¼ã‚¯ãƒ—ロトコルã§ã¯ï¼Œãã®ç¬¦å·åŒ–情報ãŒå­˜åœ¨ã™ã‚‹ã€‚複数ã®æƒ…å ±ãŒåˆ©ç”¨ã§ãã‚‹ã¨ã，ãれらã®ç›¸å¯¾çš„ãªå„ªå…ˆåº¦åŠã³ãれらãŒçŸ›ç›¾ã—ãŸã¨ãã®æœ›ã¾ã—ã„処ç†æ–¹æ³•ã¯ï¼ŒXMLã®é…é€ã«ä½¿ç”¨ã™ã‚‹ï¼Œã‚ˆã‚Šé«˜æ°´æº–ã®ãƒ—ロトコルã®ä¸€éƒ¨ã¨ã—ã¦è¦ç¨‹ã™ã‚‹ã®ãŒã‚ˆã„。例ãˆã°ï¼Œå†…部ラベルåŠã³å¤–部&header;ã«å­˜åœ¨ã™ã‚‹MIMEå½¢å¼ã®ãƒ©ãƒ™ãƒ«ã®ç›¸å¯¾çš„ãªå„ªå…ˆåº¦ã«å¯¾ã™ã‚‹è¦å‰‡ã¯ï¼Œtext/xmlåŠã³application/xmlã®MIME型を定義ã™ã‚‹RFC文書ã®ä¸€éƒ¨ã¨ãªã‚‹æ–¹ãŒã‚ˆã„。ã—ã‹ã—，相互é‹ç”¨æ€§ã®ãŸã‚ã«ï¼Œæ¬¡ã®è¦å‰‡ã«å¾“ã†ã“ã¨ãŒæœ›ã¾ã—ã„。

a) XMLã®å®Ÿä½“ãŒãƒ•ã‚¡ã‚¤ãƒ«ã«å­˜åœ¨ã™ã‚Œã°ï¼Œ&byte-order-mark;åŠã³ç¬¦å·åŒ–宣言PIã¯ï¼Œ(存在ã™ã‚Œã°)文字符å·åŒ–を決定ã™ã‚‹ãŸã‚ã«ä½¿ç”¨ã™ã‚‹ã€‚ä»–ã®ã™ã¹ã¦ã®&hueristics;åŠã³æƒ…å ±ã¯ï¼Œ&error;回復ã®ãŸã‚ã ã‘ã«ç”¨ã„る。

b) XMLã®å®Ÿä½“ã‚’MIMEåž‹text/xmlã§é…é€ã™ã‚‹ã¨ãã¯ï¼Œã“ã®MIMEåž‹ã®ã‚‚ã¤charsetパラメタãŒæ–‡å­—符å·åŒ–方法を決定ã™ã‚‹ã€‚ä»–ã®ã™ã¹ã¦ã®&hueristics;åŠã³æƒ…å ±ã¯ï¼Œ&error;回復ã®ãŸã‚ã ã‘ã«ç”¨ã„る。

c) XMLã®å®Ÿä½“ã‚’ MIMEåž‹application/xmlã§é…é€ã™ã‚‹ã¨ãã¯ï¼Œ&byte-order-mark;åŠã³ç¬¦å·åŒ–宣言PIã‚’(存在ã™ã‚Œã°)文字符å·åŒ–ã®æ±ºå®šã®ãŸã‚ã«ä½¿ç”¨ã™ã‚‹ã€‚ä»–ã®ã™ã¹ã¦ã®&hueristics;åŠã³æƒ…å ±ã¯&error;回復ã®ãŸã‚ã ã‘ã«ç”¨ã„る。

ã“れらã®è¦å‰‡ã¯ï¼Œãƒ—ロトコルã«ã¤ã„ã¦ã®è³‡æ–™ãŒãªã„ã¨ãã«ã ã‘用ã„る。特ã«ï¼ŒMIMEåž‹text/xmlåŠã³application/xmlを定義ã—ãŸã‚‰ï¼Œã“れらをè¦å®šã™ã‚‹RFCã«å­˜åœ¨ã™ã‚‹è¦å®šãŒï¼Œã“れらã®è¦å‰‡ã«å–ã£ã¦ä»£ã‚る。

&informative;W3C XML ワーキンググループ

ã“ã®&TR-or-Rec;ã¯ï¼ŒW3C XML ワーキンググループ(WG)ãŒæº–å‚™ã—，公開を承èªã—ãŸã€‚WGãŒã“ã®&TR-or-Rec;を承èªã™ã‚‹ã¨ã„ã†ã“ã¨ã¯ï¼ŒWGã®ã™ã¹ã¦ã®å§”å“¡ãŒæ‰¿èªæŠ•ç¥¨ã‚’è¡Œã£ãŸã¨ã„ã†ã“ã¨ã‚’å¿…ãšã—ã‚‚æ„味ã—ãªã„。XML WGã®ç¾åœ¨ã®å§”å“¡åŠã³ä»¥å‰ã®å§”員を次ã«ç¤ºã™ã€‚

Jon Bosak, SunChair James ClarkTechnical Lead Tim Bray, Textuality and NetscapeXML Co-editor Jean Paoli, MicrosoftXML Co-editor C. M. Sperberg-McQueen, U. of Ill.XML Co-editor Dan Connolly, W3C Steve DeRose, INSO Dave Hollander, HP Eliot Kimber, Highland Eve Maler, ArborText Tom Magliery, NCSA Murray Maloney, Muzmo and Grif æ‘田　真，富士ゼロックス情報システム(æ ª) Joel Nava, Adobe Peter Sharpe, SoftQuad John Tigue, DataChannel hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/japanese.xml0000644006511100651110000000720410504340461026102 0ustar rossross Test support for the EUC-JP encoding, and for text which relies on Japanese characters. If a processor does not support this encoding, it must report a fatal error. (Also requires ability to process a moderately complex DTD.) Test support for the ISO-2022-JP encoding, and for text which relies on Japanese characters. If a processor does not support this encoding, it must report a fatal error. (Also requires ability to process a moderately complex DTD.) Test support for little-endian UTF-16 text which relies on Japanese characters. (Also requires ability to process a moderately complex DTD.) Test support for the Shift_JIS encoding, and for text which relies on Japanese characters. If a processor does not support this encoding, it must report a fatal error. (Also requires ability to process a moderately complex DTD.) Test support UTF-16 text which relies on Japanese characters. (Also requires ability to process a moderately complex DTD.) Test support for UTF-8 text which relies on Japanese characters. (Also requires ability to process a moderately complex DTD.) Test support for EUC-JP encoding, and XML names which contain Japanese characters. If a processor does not support this encoding, it must report a fatal error. Test support for ISO-2022-JP encoding, and XML names which contain Japanese characters. If a processor does not support this encoding, it must report a fatal error. Test support for little-endian UTF-16 encoding, and XML names which contain Japanese characters. Test support for Shift_JIS encoding, and XML names which contain Japanese characters. If a processor does not support this encoding, it must report a fatal error. Test support for UTF-16 encoding, and XML names which contain Japanese characters. Test support for UTF-8 encoding and XML names which contain Japanese characters. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/pr-xml-shift_jis.xml0000644006511100651110000054321210504340462027520 0ustar rossross "> '"> amp, lt, gt, apos, quot"> ]>
Šg’£‰Â”\‚È&markup;Œ¾Œê (XML) ‘æ1.0&version; PR-xml-&iso6.doc.date; World Wide Web Consortium &draft.day;&draft.month;&draft.year;

‚±‚Ì‘ˆÄ‚ÍCXML WG‹y‚Ñ‘¼‚ÌŠÖŒWŽÒ‚É‚æ‚郌ƒrƒ…[‚Ì‚½‚ß‚Ì‚à‚Ì‚Å‚ ‚Á‚ÄCŒöŠJ‚Ì‹c˜_‚Ì‚½‚ß‚Ì‚à‚Ì‚Å‚Í‚È‚¢B

http://www.w3.org/TR/PR-xml-&iso6.doc.date; http://www.w3.org/TR/WD-xml-961114 http://www.w3.org/TR/WD-xml-lang-970331 http://www.w3.org/TR/WD-xml-lang-970630 http://www.w3.org/TR/WD-xml-970807 http://www.w3.org/TR/WD-xml-971117 Tim Bray Textuality and Netscape tbray@textuality.com Jean Paoli Microsoft jeanpa@microsoft.com C. M. Sperberg-McQueen University of Illinois at Chicago cmsmcq@uic.edu

‚±‚Ì&TR-or-Rec;‚Í, 1997”N12ŒŽ‚ÉWorld Wide Web Consortium‚©‚ç Œö•\‚³‚ꂽŠ©ˆÄExtensible Markup Language version‘æ1.0”Å‚ð–|–ó‚µ, ‹Z p“I“à—e‚ð•ÏX‚·‚邱‚Æ‚È‚­ì¬‚µ‚½&TR-or-Rec;‚Å‚ ‚éBThis &eTR-or-Rec; is a translation of the XML proposed recommendation 1.0 published by the World Wide Web Consortium in December 1997. It is intended that &eTR-or-Rec; is technically identical to the original.

Œ´•¶‚É‚ ‚éA’˜ìŒ ‚ÉŠÖ‚µ‚Ä‚Ì‹Lq‚ðŽŸ‚ÉŽ¦‚·BThe original copyright notice is shown below:

‚±‚̔łÌXML‚Ì‹K’è‚ÍCŒöŠJƒŒƒrƒ…[‹y‚Ñ‹c˜_‚ð –Ú“I‚Æ‚·‚éBƒeƒLƒXƒg‹y‚Ñ–@—¥ã‚Ì’ˆÓ‚ð‰ü•Ï‚µ‚È‚¢ŒÀ‚èCŽ©—R‚É ”z•z‚µ‚Ä‚à‚æ‚¢BThis version of the XML specification is for public review and discussion. It may be distributed freely, as long as all text and legal notices remain intact.

‚±‚Ì&TR-or-Rec;‚ÌŒ³‚Æ‚È‚Á‚½XMLŠ©ˆÄ‚ÍC1998”N2ŒŽ‚ÉWorld Wide Web Consortium‚©‚çŒö•\‚³‚ꂽXMLŠ©‚É‚æ‚Á‚Ä‚·‚Å‚É’u‚«Š· ‚¦‚ç‚ê‚Ä‚¢‚éB‚±‚Ì•W€î•ñ‚ÍCXMLŠ©‚É]‚Á‚Ä’ù³‚·‚邱‚Æ‚ð —\’肵‚Ä‚¢‚éBThe XML Proposed Recommendation is superseded by the XML Recommendation which was published by the World Wide Web Consortium in February 1998. It is intended that this &eTR-or-Rec; be revised accordingly in the near future.

‚±‚Ì&TR-or-Rec;‚ÍCˆÀ’肵‚½‚à‚Ì‚Å‚ ‚Á‚ÄCð”N—ˆ‚ÌXMLŠˆ“®‚ð’Ê‚¶‚Ä쬂³‚ꂽCˆê˜A‚Ìì ‹Æ‘ˆÄ‚ðŒ³‚Æ‚·‚éBŒ»ÝCL”͈͂Ɏg—p‚³‚ê‚Ä‚¢‚é‘Û“I‚ȃeƒLƒXƒgˆ—‚Ì•W €(•W€ˆê”ʉ»&markup;Œ¾ŒêCStandard Generalized Markup Language, ISO 8879:1986‚ɒljÁ‹y‚Ñ’ù³‚ð‰Á‚¦‚½‚à‚Ì)‚ÌCWWWã‚Å‚ÌŽg—p‚Ì‚½‚ß‚É⊂ ‰»‚µ‚½Œ¾Œê‚ðC‚±‚Ì&TR-or-Rec;‚ÍC‹K’è‚·‚éBISO 8879‚Ì‚Ç‚Ì‹@”\‚ð‚±‚Ì ⊂‚ÉŽc‚·‚©C‚Æ‚¢‚¤Œˆ’è‚ɂ‚¢‚Ä‚ÌÚׂÍC•Ê“r—pˆÓ‚·‚éBXML‚ÍC Šù‚É‚¢‚­‚‚©‚̤•i‚ŃTƒ|[ƒg‚³‚êCXML‚ðƒTƒ|[ƒg‚·‚éƒtƒŠ[ƒEƒFƒA‚Ì”‚à‘‚¦‚Ä ‚¢‚éBXML‚ÉŠÖ‚·‚éŒöŠJ‚̘_‹c‚àCƒIƒ“ƒ‰ƒCƒ“‚Å“üŽè‚Å‚«‚éBIt is a stable document derived from a series of working drafts produced over the last year as deliverables of the XML activity. It specifies a language created by subsetting an existing, widely used international text processing standard (Standard Generalized Markup Language, ISO 8879:1986 as amended and corrected) for use on the World Wide Web. Details of the decisions regarding which features of ISO 8879 to retain in the subset are available separately. XML is already supported by some commercial products, and there are a growing number of free implementations. Public discussions of XML are accessible online.

‚±‚Ì&TR-or-Rec;‚Å‚ÍC‚É’è‹`‚·‚é URI(Uniform Resource Identifier)‚ðŽg—p‚·‚éBURI‚̧’èì‹Æ‚Íis’†‚Å‚ ‚Á ‚ÄC‹y‚Ñ‚ðXV‚·‚é—\’è‚Æ ‚È‚Á‚Ä‚¢‚éB‚±‚Ìì‹Æ‚ªRFC‚Æ‚µ‚Ď󂯓ü‚ê‚ç‚ê‚È‚¢ê‡‚ÍC‚±‚Ì‹K’ö“à‚ÌURI ‚Ö‚ÌŽQÆ‚ÍCURL(Uniform Resource Locator)‚Ö‚ÌŽQÆ‚É‘ã‚í‚éBThis specification uses the term URI, which is defined by , a work in progress expected to update and . Should the work not be accepted as an RFC, the references to uniform resource identifiers (URIs) in this specification will become references to uniform resource locators (URLs).

XML‚ÌŽd—l‚É€‹’‚µ‚Ä‚¢‚é‚©‚Ç‚¤‚©‚̊ƂȂé‚ÍW3C‚̃TƒCƒg‚É‚  ‚錴•¶‚Å‚ ‚éBThe normative version of the specification is the English version found at the W3C site.

‚±‚Ì•W€î•ñ‚ÍŒ´Žd—l‚Æ‹Zp“I‚É“¯ˆê‚Å‚ ‚邱‚Æ‚ðˆÓ}‚µ‚Ä‚¢‚邪A –|–óã‚ÌŒë‚è‚Í‚ ‚蓾‚éBAlthough this technical report is intended to be technically identical to the original, it may contain errors from the translation.

”õl: Œ´‹K’è‚Æ‚Ì‹K’è‰ÓŠ‚̑ΉžŠÖŒW‚𖾂炩‚É‚·‚邽‚ßA‚±‚Ì &TR-or-Rec;‚Ìß\¬‹y‚ÑߔԆ‚ÍAŒ´‹K’è‚Ì‚»‚ê‚ç‚ð‚Å‚«‚邾‚¯•Û‘¶‚µ‚Ä‚¢ ‚éB‚±‚Ì&TR-or-Rec;‚ÌWeb”Å‚ÍAŒ´‹K’è‚ÌHTMLƒ^ƒO‚ð‚»‚Ì‚Ü‚Ü•Û‘¶‚µ‚Ä‚¢‚éB

Šg’£‰Â”\‚È&markup;Œ¾Œê(XML)‚ÍSGML‚ÌŠÈ’P‚È•ûŒ¾‚Å‚ ‚Á‚ÄC‚±‚Ì&TR-or-Rec;‚ÅC‚»‚Ì‚·‚ׂĂð‹K’è‚·‚éBXML‚Ì–Ú•W‚ÍCŒ»Ý‚ÌHTML‚Æ“¯—l‚ÉCˆê”Ê«‚Ì‚ ‚éSGML‚ðƒEƒFƒuã‚Å”z•zCŽóM‹y‚ш—‚Å‚«‚邱‚Æ‚Æ‚·‚éBXML‚ÍŽÀ‘•‚ª—eˆÕ‚Å‚ ‚Á‚ÄCSGML‹y‚ÑHTML‚Ì‚Ç‚¿‚ç‚ɑ΂µ‚Ä‚à‘ŠŒÝ‰^—p«‚ð•Û‚ÂÝŒv‚ª‚È‚³‚ê‚Ä‚¢‚éB

Chicago, Vancouver, Mountain View, et al.: World-Wide Web Consortium, XMLì‹ÆƒOƒ‹[ƒv, 1996, 1997.

Created in electronic form.

 English Extended Backus-Naur Form (formal grammar) 1997-12-03 : CMSMcQ : yet further changes 1997-12-02 : TB : further changes (see TB to XML WG, 2 December 1997) 1997-12-02 : CMSMcQ : deal with as many corrections and comments from the proofreaders as possible: entify hard-coded document date in pubdate element, change expansion of entity WebSGML, update status description as per Dan Connolly (am not sure about refernece to Berners-Lee et al.), add 'The' to abstract as per WG decision, move Relationship to Existing Standards to back matter and combine with References, re-order back matter so normative appendices come first, re-tag back matter so informative appendices are tagged informdiv1, remove XXX XXX from list of 'normative' specs in prose, move some references from Other References to Normative References, add RFC 1738, 1808, and 2141 to Other References (they are not normative since we do not require the processor to enforce any rules based on them), add reference to 'Fielding draft' (Berners-Lee et al.), move notation section to end of body, drop URIchar non-terminal and use SkipLit instead, lose stray reference to defunct nonterminal 'markupdecls', move reference to Aho et al. into appendix (Tim's right), add prose note saying that hash marks and fragment identifiers are NOT part of the URI formally speaking, and are NOT legal in system identifiers (processor 'may' signal an error). Work through: Tim Bray reacting to James Clark, Tim Bray on his own, Eve Maler, NOT DONE YET: change binary / text to unparsed / parsed. handle James's suggestion about < in attriubte values uppercase hex characters, namechar list, 1997-12-01 : JB : add some column-width parameters 1997-12-01 : CMSMcQ : begin round of changes to incorporate recent WG decisions and other corrections: binding sources of character encoding info (27 Aug / 3 Sept), correct wording of Faust quotation (restore dropped line), drop SDD from EncodingDecl, change text at version number 1.0, drop misleading (wrong!) sentence about ignorables and extenders, modify definition of PCData to make bar on msc grammatical, change grammar's handling of internal subset (drop non-terminal markupdecls), change definition of includeSect to allow conditional sections, add integral-declaration constraint on internal subset, drop misleading / dangerous sentence about relationship of entities with system storage objects, change table body tag to htbody as per EM change to DTD, add rule about space normalization in public identifiers, add description of how to generate our name-space rules from Unicode character database (needs further work!). 1997-10-08 : TB : Removed %-constructs again, new rules for PE appearance. 1997-10-01 : TB : Case-sensitive markup; cleaned up element-type defs, lotsa little edits for style 1997-09-25 : TB : Change to elm's new DTD, with substantial detail cleanup as a side-effect 1997-07-24 : CMSMcQ : correct error (lost *) in definition of ignoreSectContents (thanks to Makoto Murata) Allow all empty elements to have end-tags, consistent with SGML TC (as per JJC). 1997-07-23 : CMSMcQ : pre-emptive strike on pending corrections: introduce the term 'empty-element tag', note that all empty elements may use it, and elements declared EMPTY must use it. Add WFC requiring encoding decl to come first in an entity. Redefine notations to point to PIs as well as binary entities. Change autodetection table by removing bytes 3 and 4 from examples with Byte Order Mark. Add content model as a term and clarify that it applies to both mixed and element content. 1997-06-30 : CMSMcQ : change date, some cosmetic changes, changes to productions for choice, seq, Mixed, NotationType, Enumeration. Follow James Clark's suggestion and prohibit conditional sections in internal subset. TO DO: simplify production for ignored sections as a result, since we don't need to worry about parsers which don't expand PErefs finding a conditional section. 1997-06-29 : TB : various edits 1997-06-29 : CMSMcQ : further changes: Suppress old FINAL EDIT comments and some dead material. Revise occurrences of % in grammar to exploit Henry Thompson's pun, especially markupdecl and attdef. Remove RMD requirement relating to element content (?). 1997-06-28 : CMSMcQ : Various changes for 1 July draft: Add text for draconian error handling (introduce the term Fatal Error). RE deleta est (changing wording from original announcement to restrict the requirement to validating parsers). Tag definition of validating processor and link to it. Add colon as name character. Change def of %operator. Change standard definitions of lt, gt, amp. Strip leading zeros from #x00nn forms. 1997-04-02 : CMSMcQ : final corrections of editorial errors found in last night's proofreading. Reverse course once more on well-formed: Webster's Second hyphenates it, and that's enough for me. 1997-04-01 : CMSMcQ : corrections from JJC, EM, HT, and self 1997-03-31 : Tim Bray : many changes 1997-03-29 : CMSMcQ : some Henry Thompson (on entity handling), some Charles Goldfarb, some ERB decisions (PE handling in miscellaneous declarations. Changed Ident element to accept def attribute. Allow normalization of Unicode characters. move def of systemliteral into section on literals. 1997-03-28 : CMSMcQ : make as many corrections as possible, from Terry Allen, Norbert Mikula, James Clark, Jon Bosak, Henry Thompson, Paul Grosso, and self. Among other things: give in on "well formed" (Terry is right), tentatively rename QuotedCData as AttValue and Literal as EntityValue to be more informative, since attribute values are the only place QuotedCData was used, and vice versa for entity text and Literal. (I'd call it Entity Text, but 8879 uses that name for both internal and external entities.) 1997-03-26 : CMSMcQ : resynch the two forks of this draft, reapply my changes dated 03-20 and 03-21. Normalize old 'may not' to 'must not' except in the one case where it meant 'may or may not'. 1997-03-21 : TB : massive changes on plane flight from Chicago to Vancouver 1997-03-21 : CMSMcQ : correct as many reported errors as possible. 1997-03-20 : CMSMcQ : correct typos listed in CMSMcQ hand copy of spec. 1997-03-20 : CMSMcQ : cosmetic changes preparatory to revision for WWW conference April 1997: restore some of the internal entity references (e.g. to docdate, etc.), change character xA0 to &nbsp; and define nbsp as &#160;, and refill a lot of paragraphs for legibility. 1996-11-12 : CMSMcQ : revise using Tim's edits: Add list type of NUMBERED and change most lists either to BULLETS or to NUMBERED. Suppress QuotedNames, Names (not used). Correct trivial-grammar doc type decl. Rename 'marked section' as 'CDATA section' passim. Also edits from James Clark: Define the set of characters from which [^abc] subtracts. Charref should use just [0-9] not Digit. Location info needs cleaner treatment: remove? (ERB question). One example of a PI has wrong pic. Clarify discussion of encoding names. Encoding failure should lead to unspecified results; don't prescribe error recovery. Don't require exposure of entity boundaries. Ignore white space in element content. Reserve entity names of the form u-NNNN. Clarify relative URLs. And some of my own: Correct productions for content model: model cannot consist of a name, so "elements ::= cp" is no good. 1996-11-11 : CMSMcQ : revise for style. Add new rhs to entity declaration, for parameter entities. 1996-11-10 : CMSMcQ : revise for style. Fix / complete section on names, characters. Add sections on parameter entities, conditional sections. Still to do: Add compatibility note on deterministic content models. Finish stylistic revision. 1996-10-31 : TB : Add Entity Handling section 1996-10-30 : TB : Clean up term & termdef. Slip in ERB decision re EMPTY. 1996-10-28 : TB : Change DTD. Implement some of Michael's suggestions. Change comments back to //. Introduce language for XML namespace reservation. Add section on white-space handling. Lots more cleanup. 1996-10-24 : CMSMcQ : quick tweaks, implement some ERB decisions. Characters are not integers. Comments are /* */ not //. Add bibliographic refs to 10646, HyTime, Unicode. Rename old Cdata as MsData since it's only seen in marked sections. Call them attribute-value pairs not name-value pairs, except once. Internal subset is optional, needs '?'. Implied attributes should be signaled to the app, not have values supplied by processor. 1996-10-16 : TB : track down & excise all DSD references; introduce some EBNF for entity declarations. 1996-10-?? : TB : consistency check, fix up scraps so they all parse, get formatter working, correct a few productions. 1996-10-10/11 : CMSMcQ : various maintenance, stylistic, and organizational changes: Replace a few literals with xmlpio and pic entities, to make them consistent and ensure we can change pic reliably when the ERB votes. Drop paragraph on recognizers from notation section. Add match, exact match to terminology. Move old 2.2 XML Processors and Apps into intro. Mention comments, PIs, and marked sections in discussion of delimiter escaping. Streamline discussion of doctype decl syntax. Drop old section of 'PI syntax' for doctype decl, and add section on partial-DTD summary PIs to end of Logical Structures section. Revise DSD syntax section to use Tim's subset-in-a-PI mechanism. 1996-10-10 : TB : eliminate name recognizers (and more?) 1996-10-09 : CMSMcQ : revise for style, consistency through 2.3 (Characters) 1996-10-09 : CMSMcQ : re-unite everything for convenience, at least temporarily, and revise quickly 1996-10-08 : TB : first major homogenization pass 1996-10-08 : TB : turn "current" attribute on div type into CDATA 1996-10-02 : TB : remould into skeleton + entities 1996-09-30 : CMSMcQ : add a few more sections prior to exchange with Tim. 1996-09-20 : CMSMcQ : finish transcribing notes. 1996-09-19 : CMSMcQ : begin transcribing notes for draft. 1996-09-13 : CMSMcQ : made outline from notes of 09-06, do some housekeeping
ˆê”ÊŽ–€

Šg’£‰Â”\‚È&markup;Œ¾ŒêXML(eXtensible Markup Language)‚ÍCXML•¶‘‚Æ‚¢‚¤ƒf[ƒ^ƒIƒuƒWƒFƒNƒg‚̃Nƒ‰ƒX‚ð‹K’肵CXML•¶‘‚ðˆ—‚·‚éƒvƒƒOƒ‰ƒ€‚Ì“®ì‚̈ꕔ‚ð‹K’è‚·‚éBXML‚ÍCSGML(•W€ˆê”ʉ»&markup;Œ¾ŒêCStandard Generalized Markup Language)‚̧ŒÀ‚µ‚½⊂‚Æ‚·‚éB\‘¢ãCXML•¶‘‚ÍC‚©‚Ȃ炸SGML‹KŠi‚É“K‡‚·‚éB

XML•¶‘‚ÍCŽÀ‘Ì‚Æ‚¢‚¤‹L‰¯’PˆÊ‚©‚ç‚È‚èCŽÀ‘Ì‚ÍC&parsed-data;–”‚Í&unparsed-data;‚©‚ç‚È‚éB&parsed-data;‚ÍC•¶Žš‚©‚ç‚È‚èC‚»‚̈ꕔ‚ÍC•¶‘‚Ì•¶Žšƒf[ƒ^‚ð\¬‚µCˆê•”‚ÍC&markup;‚ð\¬‚·‚éB&markup;‚ÍC•¶‘‚Ì‹L‰¯ƒŒƒCƒAƒEƒg‹y‚ј_—\‘¢‚ɂ‚¢‚Ä‚Ì‹Lq‚ð•\‚·•„†‚Æ‚·‚éBXML‚ÍC‹L‰¯ƒŒƒCƒAƒEƒg‹y‚ј_—\‘¢‚ɂ‚¢‚Ă̧–ñðŒ‚ð‹Lq‚·‚é‹@\‚ð’ñ‹Ÿ‚·‚éB

XML&processor;‚Æ‚¢‚¤ƒ\ƒtƒgƒEƒFƒAƒ‚ƒWƒ…[ƒ‹‚ÍCXML•¶‘‚ð“Ç‚Ýž‚ÝC‚»‚Ì“à—e‹y‚Ñ\‘¢‚ւ̃AƒNƒZƒX‚ð’ñ‹Ÿ‚·‚邽‚ß‚É—p‚¢‚éB XML&processor;‚ÍC‘¼‚̃‚ƒWƒ…[ƒ‹‚Ì‚½‚ß‚É“®ì‚·‚邱‚Æ‚ð‘O’ñ‚Æ‚µC‚»‚̃‚ƒWƒ…[ƒ‹‚ð&application;‚Æ‚¢‚¤B‚±‚Ì&TR-or-Rec;‚ÍCXML&processor;‚ªs‚í‚È‚¯‚ê‚΂Ȃç‚È‚¢U•‘‚¢‚ð‹K’è‚·‚éB‚‚܂èCXMLƒf[ƒ^‚Ì“Çž‚Ý•û–@‚ð‹K’肵C&application;‚É’ñ‹Ÿ‚·‚éî•ñ‚ð‹K’è‚·‚éB

ŒoˆÜ‹y‚Ñ–Ú•W

1996”N‚ÉWorld Wide Web Consortium(W3C)‚Ì’†‚ÉÝ—§‚µ‚½XMLì‹ÆƒOƒ‹[ƒv(ˆÈ‘O‚ÍC SGML•ÒWƒŒƒrƒ…[ˆÏˆõ‰ï‚ƌĂ΂ꂽ)‚ªCXML‚ðŠJ”­‚µ‚½B‚±‚Ìì‹ÆƒOƒ‹[ƒv‚Ì‹c’·‚ðCSun Microsystems‚ÌJon Bosak‚ª‹Î‚ß‚éBW3C‚ª‘gD‚µCˆÈ‘O‚ÍSGMLì‹ÆƒOƒ‹[ƒv‚ƌĂ΂ꂽXML SIG(Special Interest Group)‚àCXML‚̧’è‚É”ñí‚ÉŠˆ”­‚ÉŽQ‰æ‚µ‚½B Dan Connolly‚ÍCì‹ÆƒOƒ‹[ƒv‚ÌW3C‚É‚¨‚¯‚é˜A—ŒW‚𖱂߂½B

XML‚ÌÝŒv–Ú•W‚ðCŽŸ‚ÉŽ¦‚·B

a) XML‚ÍCInternetã‚Å‚»‚Ì‚Ü‚ÜŽg—p‚Å‚«‚éB

b) XML‚ÍCL”͈͂Ì&application;‚ðŽx‰‡‚·‚éB

c) XML‚ÍCSGML‚ƌ݊·«‚ð‚à‚ÂB

d) XML•¶‘‚ðˆ—‚·‚éƒvƒƒOƒ‰ƒ€‚ð‘‚­‚±‚Æ‚ÍC—eˆÕ‚Å‚È‚¯‚ê‚΂Ȃç‚È‚¢B

e) XML‚Å‚ÍCƒIƒvƒVƒ‡ƒ“‚Ì‹@”\‚Í‚Å‚«‚邾‚¯­‚È‚­‚µCˆê‚Â‚à‘¶Ý‚µ‚È‚¢‚±‚Æ‚ð–ÚŽw‚·B

f) XML•¶‘‚ÍClŠÔ‚É‚Æ‚Á‚Ä“Ç‚Ý‚â‚·‚­C\•ª‚É—‰ð‚µ‚â‚·‚¢B

g) XML‚ÌÝŒv‚ÍC‚·‚Ý‚â‚©‚És‚¦‚È‚¯‚ê‚΂Ȃç‚È‚¢B

h) XML‚ÌÝŒv‚ÍCŒµ–§‹y‚ÑŠÈŒ‰‚Å‚È‚¯‚ê‚΂Ȃç‚È‚¢B

i) XML•¶‘‚ÍC—eˆÕ‚É쬂ł«‚éB

j) XML‚Å‚ÍC&markup;‚Ì”‚ðŒ¸‚ç‚·‚±‚Æ‚ÍCd—v‚Å‚Í‚È‚¢B

XML‘æ&XML.version;&version;‚ð—‰ð‚µC‚»‚ê‚ðˆ—‚·‚éŒvŽZ‹@ƒvƒƒOƒ‰ƒ€‚ð‘‚­‚½‚ß‚É\•ª‚Èî•ñ‚ÍC‚±‚Ì&TR-or-Rec;‹y‚ÑŠÖ˜A‚·‚é‹KŠi(•¶Žš—p‚Æ‚µ‚ÄCUnicode‹y‚ÑISO/IEC 10646C&language-identification;ƒ^ƒO—p‚Æ‚µ‚ÄCƒCƒ“ƒ^ƒlƒbƒg RFC 1766C&language-code;—p‚Æ‚µ‚ÄCISO 639C•À‚Ñ‚É&country-code;—p‚Æ‚µ‚ÄCISO 3166)‚ÅC‚·‚ׂϦ‚·B

‚±‚Ì&version;‚ÌXML‚Ì‹K’è‚ÍCŒöŠJƒŒƒrƒ…[‹y‚Ñ‹c˜_‚ð–Ú“I‚Æ‚·‚éBƒeƒLƒXƒg‹y‚Ñ–@—¥ã‚Ì’ˆÓ‚ð‰ü•Ï‚µ‚È‚¢ŒÀ‚èCŽ©—R‚É”z•z‚µ‚Ä‚à‚æ‚¢B

 ’è‹`

XML•¶‘‚Ì‹K’è‚Ì‚½‚ß‚ÉŽg—p‚·‚é—pŒê‚ÍC‚±‚Ì&TR-or-Rec;“à‚Å’è‹`‚·‚éBŽŸ‚ÉŽ¦‚·Œê‹å‚ÍC‚»‚ê‚ç‚Ì—pŒê‚ð’è‹`‚·‚邽‚ßC‹y‚ÑXML&processor;‚Ì“®‚«‚ð‹K’è‚·‚邽‚ß‚ÉŽg—p‚·‚éB

“K‡‚·‚镶‘–”‚ÍXML&processor;‚ÍC‹Lq‚³‚ꂽ‚Æ‚¨‚è‚É“®ì‚µ‚Ä‚à‚æ‚¢‚ªC‚»‚Ì‚Æ‚¨‚è‚É‚·‚é•K—v‚Í‚È‚¢B

“K‡‚·‚镶‘–”‚ÍXML&processor;‚ÍC‹Lq‚³‚ꂽ‚Æ‚¨‚è‚É“®ì‚·‚邱‚Æ‚ª—v‹‚³‚ê‚éB‚»‚¤‚Å‚È‚¯‚ê‚ÎC&error;‚Æ‚·‚éB

‚±‚Ì&TR-or-Rec;‚ª’è‚ß‚é‹K‘¥‚ɑ΂·‚éˆá”½BŒ‹‰Ê‚Í’è‹`‚µ‚È‚¢B“K‡‚·‚éƒ\ƒtƒgƒEƒFƒA‚ÍC&error;‚ðŒŸo‚µ‚Ä•ñ‚µ‚Ä‚à‚æ‚­C&error;‚©‚ç‰ñ•œ‚µ‚Ä‚à‚æ‚¢B

“K‡‚·‚éXML&processor;‚ªŒŸo‚µ‚È‚¯‚ê‚΂Ȃ炸C&application;‚É•ñ‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢&error;B&fatal-error;‚ð”­Œ©‚µ‚½‚ ‚ÆC&processor;‚ÍC‚»‚êˆÈ~‚Ì&error;‚ð’T‚·‚½‚߂Ƀf[ƒ^ˆ—‚ð‘±s‚µ‚Ä‚à‚æ‚­C&error;‚ð”­Œ©‚µ‚½ê‡‚ÍC‚»‚Ì&error;‚ð&application;‚É•ñ‚µ‚Ä‚à‚æ‚¢B&error;’ù³‚ðƒTƒ|[ƒg‚·‚邽‚ß‚ÉC&processor;‚ÍC–¢ˆ—ƒf[ƒ^(•¶Žšƒf[ƒ^‹y‚Ñ&markup;‚̬݂µ‚½‚à‚Ì)‚𕶑‚©‚çŽæ‚èo‚µC&application;‚É“n‚µ‚Ä‚à‚æ‚¢B‚µ‚©‚µCˆê“xC&fatal-error;‚ðŒŸo‚µ‚½‚çC&processor;‚ÍC’Êí‚̈—‚ð‘±s‚µ‚Ä‚Í‚È‚ç‚È‚¢B‚‚܂èC&processor;‚ÍC•¶Žšƒf[ƒ^‹y‚Ñ•¶‘‚̘_—\‘¢‚ɂ‚¢‚Ä‚Ìî•ñ‚ðC’Êí‚Ì•û–@‚Å&application;‚É“n‚µ‘±‚¯‚Ä‚Í‚È‚ç‚È‚¢B

“K‡‚·‚éƒ\ƒtƒgƒEƒGƒA‚ÍC‹Lq‚³‚ꂽ‚Æ‚¨‚è‚ÉU‚é•‘‚Á‚Ä‚à‚æ‚¢(may)C–”‚ÍU‚é•‘‚í‚È‚­‚Ä‚Í‚È‚ç‚È‚¢(must)(•¶Í’†‚Ì•“®ŽŒ‚É‚æ‚éB)B‚»‚Ì‚Æ‚¨‚è‚ÉU‚é•‘‚¤ê‡‚ÍC‹Lq‚³‚ꂽU•‘‚¢‚ð‘I‘ð–”‚Í‹‘”Û‚·‚éŽè’i‚ð&user;‚É’ñ‹Ÿ‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

‚·‚ׂĂÌ&valid;‚ÈXML•¶‘‚É“K—p‚·‚é‹K‘¥B&validity;§–ñ‚̈ᔽ‚ÍC&error;‚Æ‚·‚éB&at-user-option;CŒŸØ‚ðs‚¤XML&processor;‚ÍC‚±‚Ì&error;‚ð•ñ‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

‚·‚ׂĂÌ&well-formed;‚ÌXML•¶‘‚É“K—p‚·‚é‹K‘¥B&well-formed;§–ñ‚̈ᔽ‚ÍC&fatal-error;‚Æ‚·‚éB

a) &string;–”‚Í–¼‘O‚Ì&match;@”äŠr‚·‚é“ñ‚‚Ì&string;–”‚Í–¼‘O‚ÍC“¯ˆê‚Å‚È‚¯‚ê‚΂Ȃç‚È‚¢BISO/IEC 10646‚É‚¨‚¢‚ÄC•¡”‚Ì•\Œ»‚ª‰Â”\‚È•¶Žšm—Ⴆ‚ÎC&composed-form;‹y‚ÑŠî’ê+&diacritical-mark;(ƒ_ƒCƒAƒNƒŠƒeƒBƒJƒ‹ƒ}[ƒN)Œ`Ž®n‚ÍC‚Ç‚¿‚ç‚Ì&string;‚à“¯‚¶•\Œ»‚Ì‚Æ‚«‚ÉŒÀ‚èC&match;‚·‚éB&at-user-option;C&processor;‚ÍC‚»‚Ì•¶Žš‚ð•W€Œ`‚ɳ‹K‰»‚µ‚Ä‚à‚æ‚¢B”äŠr‚Ì‚Æ‚«A‘啶Žš‚Ƭ•¶Žš‚Æ‚Ì‹æ•Ê‚ð‚·‚éB<BR>b) &string;‚Æ•¶–@’†‚Ì‹K‘¥‚Æ‚Ì&match;@‚ ‚鶬‹K‘¥‚©‚綬‚·‚錾Œê‚ÉC‚ ‚é&string;‚ª‘®‚·‚é‚Æ‚«C‚±‚Ì&string;‚ÍC‚±‚̶¬‹K‘¥‚É&match;‚·‚é‚Æ‚¢‚¤B<BR>c) “à—e‚Æ“à—eƒ‚ƒfƒ‹‚Æ‚Ì&match;@‚ ‚é—v‘f‚ªC—v‘f‚Ì&validity;‚̧–ñ‚ÉŽ¦‚·ˆÓ–¡‚Å“K‡‚·‚é‚Æ‚«C‚±‚Ì—v‘f‚ÍC‚»‚Ì錾‚É&match;‚·‚é‚Æ‚¢‚¤B

XML‚Ì‹@”\‚Å‚ ‚Á‚ÄCXML‚ªSGML‚ƌ݊·‚Å‚ ‚邱‚Æ‚ð•ÛØ‚·‚邽‚ß‚¾‚¯‚É“±“ü‚³‚ê‚é‚à‚ÌB

S‘©—Í‚Í‚à‚½‚È‚¢„§Ž–€B&WebSGML;ˆÈ‘O‚©‚瑶݂·‚éSGML&processor;‚ªCXML•¶‘‚ðˆ—‚Å‚«‚é‰Â”\«‚ð‚‚߂邽‚ß‚ÉŽæ‚è“ü‚ê‚é‚à‚ÌB

•¶‘

‚±‚Ì&TR-or-Rec;‚Å’è‹`‚·‚éˆÓ–¡‚ÅC&well-formed;‚Æ‚·‚éƒf[ƒ^ƒIƒuƒWƒFƒNƒg‚ðCXML•¶‘‚Æ‚¢‚¤B&well-formed;‚ÌXML•¶‘‚ªC‚³‚ç‚ÉC‚ ‚駖ñðŒ‚ð–ž‘«‚·‚ê‚ÎC&valid;‚ÈXML•¶‘‚Æ‚·‚éB

‚¢‚¸‚ê‚ÌXML•¶‘‚àC˜_—\‘¢‹y‚Ñ•¨—\‘¢‚ð‚à‚ÂB•¨—“I‚É‚ÍC•¶‘‚ÍCŽÀ‘̂ƌĂԒPˆÊ‚©‚ç‚È‚éB‚ ‚éŽÀ‘Ì‚ÍC•¶‘“à‚É‘¼‚ÌŽÀ‘Ì‚ðŠÜ‚Þ‚½‚ß‚ÉC‚»‚Ì‘¼‚ÌŽÀ‘Ì‚ðŽQÆ‚µ‚Ä‚à‚æ‚¢B•¶‘‚ÍCgƒ‹[ƒgh‚·‚È‚í‚¿•¶‘ŽÀ‘Ì‚©‚çŽn‚Ü‚éB˜_—“I‚É‚ÍC•¶‘‚ÍC錾C—v‘fCƒRƒƒ“ƒgC•¶ŽšŽQÆ‹y‚ш—–½—ß‚ðŠÜ‚ÝC‚±‚ê‚ç‚·‚ׂĂÍC•¶‘“à‚Å–¾Ž¦“I‚È&markup;‚É‚æ‚Á‚ÄŽ¦‚·B˜_—\‘¢‹y‚Ñ•¨—\‘¢‚ÍCˆÈ~‚ÉŽ¦‚·‚Æ‚¨‚è‚ÉCŒµ–§‚É“ü‚êŽq‚É‚È‚Á‚Ä‚¢‚È‚¯‚ê‚΂Ȃç‚È‚¢B

&well-formed;‚ÌXML•¶‘

‚ ‚éƒeƒLƒXƒgƒIƒuƒWƒFƒNƒg‚ªCŽŸ‚Ì‚¢‚¸‚ê‚©‚Ì‚Æ‚«C‚»‚̃eƒLƒXƒgƒIƒuƒWƒFƒNƒg‚ð&well-formed;‚ÌXML•¶‘‚ƌĂÔB

a) ‘S‘Ì‚Æ‚µ‚ÄCdocument‚Æ‚¢‚¤ƒ‰ƒxƒ‹‚ð‚à‚¶¬‹K‘¥‚É&match;‚·‚éB

b) ‚±‚Ì&TR-or-Rec;‚Å’è‹`‚·‚éC‚·‚ׂĂÌ&well-formed;§–ñ‚É]‚¤B

c) ‚»‚ꂼ‚ê‚Ì&parsed-entity;‚ªC&well-formed;‚Æ‚È‚éB

•¶‘ document prolog element Misc*

document¶¬‹K‘¥‚É&match;‚·‚é‚Æ‚ÍCŽŸ‚ðˆÓ–¡‚·‚éB

a) ˆê‚ˆÈã‚Ì—v‘f‚ðŠÜ‚ÞB

b) ƒ‹[ƒg–”‚Í•¶‘—v‘f‚Æ‚¢‚¤—v‘f‚ªˆê‚‚¾‚¯‘¶Ý‚µC‚±‚ê‚ÍC‘¼‚Ì—v‘f‚Ì“à—e‚ÉŠÜ‚Ü‚ê‚È‚¢B‚±‚êˆÈŠO‚Ì‚·‚ׂĂ̗v‘f‚ÍC‚»‚ÌŠJŽnƒ^ƒO‚ª‘¼‚Ì—v‘f‚Ì“à—e‚ÉŠÜ‚Ü‚ê‚ê‚ÎC‘Ήž‚·‚éI—¹ƒ^ƒO‚à“¯‚¶—v‘f‚Ì“à—e‚ÉŠÜ‚Ü‚ê‚éB‚‚܂èC—v‘f‚ÍCŠJŽnƒ^ƒO‹y‚ÑI—¹ƒ^ƒO‚É‚æ‚Á‚Ä‹æØ‚ç‚êC“ü‚êŽq\‘¢‚ð‚È‚·B

‚±‚ê‚ç‚ÌŒ‹‰Ê‚Æ‚µ‚ÄC•¶‘“à‚Ì‚Ç‚Ì”ñƒ‹[ƒg—v‘fC‚ɑ΂µ‚Ä‚àC‚ ‚鑼‚Ì—v‘fP‚ª‘¶Ý‚µCC‚ÍCP‚Ì“à—e‚ÉŠÜ‚Ü‚ê‚邪CP‚Ì“à—e‚ÉŠÜ‚Ü‚ê‚鑼‚Ì—v‘f‚ÉŠÜ‚Ü‚ê‚邱‚Æ‚Í‚È‚¢B‚±‚Ì‚Æ‚«CP‚ðC‚Ìe‚Æ‚¢‚¢CC‚ðP‚ÌŽq‚Æ‚¢‚¤B

 •¶Žš

&parsed-entity;‚ÍCƒeƒLƒXƒg(•¶Žš‚Ì•À‚Ñ‚Å‚ ‚Á‚ÄC&markup;–”‚Í•¶Žšƒf[ƒ^‚ð•\‚µ‚Ä‚à‚æ‚¢B)‚ðŠÜ‚ÞB•¶Žš‚ÍCƒeƒLƒXƒg‚ÌŬ’PˆÊ‚Å‚ ‚Á‚ÄCISO/IEC 10646‚É‹K’肳‚ê‚éB‹–—e‚·‚镶Žš‚ÍCƒ^ƒuC‰üsC•œ‹A•À‚Ñ‚ÉUnicode‹y‚ÑISO/IEC 10646‚ª‹–—e‚·‚é}Œ`•¶Žš‚Æ‚·‚éB •¶Žš‚Ì”ÍˆÍ Char #x9 | #xA | #xD | [#x20-#D7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF] ”CˆÓ‚ÌUnicode•¶ŽšB‚½‚¾‚µC&surrogate-blocks;CFFFE‹y‚ÑFFFF‚Íœ‚­B

&character-value;‚ðƒrƒbƒgƒpƒ^ƒ“‚É•„†‰»‚·‚é‹@\‚ÍCŽÀ‘Ì‚²‚ƂɈá‚Á‚Ä‚à‚æ‚¢B‚·‚ׂĂÌXML&processor;‚ÍCISO/IEC 10646‚ÌUTF-8•„†‰»‹y‚ÑUTF-16•„†‰»‚ðŽó‚¯•t‚¯‚È‚¯‚ê‚΂Ȃç‚È‚¢B“ñ‚‚̂ǂ¿‚炪—p‚¢‚ç‚ê‚Ä‚¢‚é‚©‚𖾎¦‚·‚邽‚ß‚Ì‹@\C‹y‚Ñ‘¼‚Ì•„†‰»•û–@‚ð—˜—p‚·‚邽‚ß‚Ì‹@\‚ÍC•¶Žš‚Ì•„†‰»‚É‹Lq‚·‚éB

‚Ç‚Ì•„†‰»•û–@‚ð—p‚¢‚é‚©‚ÉŠÖŒW‚È‚­CISO/IEC 10646‚Ì•¶ŽšW‡‚É‚ ‚é‚·‚ׂĂ̕¶Žš‚ÍC‚»‚ÌUCS-4&code-value;‚Æ“™‰¿‚È10i”–”‚Í16i”‚É‚æ‚Á‚ÄCŽQÆ‚Å‚«‚éB

 ‹¤’Ê‚Ì\•¶\¬Žq

2.3‚Å‚ÍC•¶–@“à‚ÅL‚­Žg—p‚·‚é‚¢‚­‚‚©‚Ì‹L†‚ð’è‹`‚·‚éB

S (‹ó”’)‚ÍCˆê‚ŽႵ‚­‚Í•¡”‚Ì&space-character;(#x20)C•œ‹AC‰üs–”‚̓^ƒu‚©‚笂éB ‹ó”’ S (#x20 | #x9 | #xD | #xA)+

•Ö‹XãC•¶Žš‚ðC&letter;C”Žš–”‚Í‘¼‚Ì•¶Žš‚É•ª—Þ‚·‚éB&letter;‚ÍCƒAƒ‹ƒtƒ@ƒxƒbƒg“I–”‚Í•\‰¹“I‚Å‚ ‚éŠî–{•¶Žš(ˆê‚–”‚Í•¡”‚Ì&combining-character;‚ªCŒã‚É‘±‚­‚±‚Æ‚à‚ ‚éB)C&ideographic;‚©‚笂éB ŠeƒNƒ‰ƒX‚É‚¨‚¯‚éŽÀÛ‚Ì•¶Žš‚ɂ‚¢‚Ä‚ÌŠ®‘S‚È’è‹`‚ÍC•¶ŽšƒNƒ‰ƒX‚ÉŠÖ‚·‚é•t˜^‚É‹K’è‚·‚éB

Name‚ÍC&letter;–”‚Í‚¢‚­‚‚©‚Ì‹æ؂蕶Žš‚̈ê‚‚Ŏn‚Ü‚èC‚»‚ÌŒã‚É&letter;C”ŽšCƒnƒCƒtƒ“C‰ºüCƒRƒƒ“–”‚̓sƒŠƒIƒh‚ª‘±‚­(‚±‚ê‚ç‚𖼑O•¶Žš‚Æ‚¢‚¤B)B&string;"xml"–”‚Í(('X'|'x') ('M'|'m') ('L'|'l'))‚É&match;‚·‚é”CˆÓ‚Ì&string;‚ÅŽn‚Ü‚é–¼‘O‚ÍC‚±‚Ì&TR-or-Rec;‚ÌŒ»Ý‚̔Ŗ”‚Í«—ˆ‚̔łł̕W€‰»‚Ì‚½‚ß‚É—\–ñ‚·‚éB

XML‚Ì–¼‘O‚Ì’†‚̃Rƒƒ“‚ÍC–¼‘O‹óŠÔ‚Å‚ÌŽÀŒ±‚Ì‚½‚ß‚É—\–ñ‚·‚éBƒRƒƒ“‚̈Ӗ¡‚ÍC«—ˆ‚Ì‚ ‚鎞“_‚Å•W€‰»‚·‚é‚à‚Ì‚Æ‚µC‚»‚Ì‚Æ‚«‚É‚ÍCŽÀŒ±“I‚È–Ú“I‚ŃRƒƒ“‚ðŽg—p‚·‚镶‘‚ðXV‚·‚é•K—v‚ª¶‚¶‚é‰Â”\«‚ª‚ ‚éBXML‚ÅÌ—p‚·‚é–¼‘O‹óŠÔ‚Ì‹@\‚ªC‹æØ‚èŽq‚Æ‚µ‚ÄŽÀۂɃRƒƒ“‚ðŽg—p‚·‚é‚Æ‚¢‚¤•ÛØ‚Í‚È‚¢BŽ–ŽÀãC‚±‚ê‚ÍC–¼‘O‹óŠÔ‚ÌŽÀŒ±‚̈ê‚‚Ƃµ‚ĈȊO‚É‚ÍCXML‚Ì–¼‘O‚Ì’†‚ŃRƒƒ“‚ðŽg—p‚µ‚È‚¢‚Ù‚¤‚ª‚æ‚¢‚±‚Æ‚ðˆÓ–¡‚·‚éB‚µ‚©‚µCXML&processor;‚ÍC–¼‘O•¶Žš‚Æ‚µ‚ăRƒƒ“‚ðŽó‚¯•t‚¯‚邱‚Æ‚ª–]‚Ü‚µ‚¢B

Nmtoken (–¼‘O&token;)‚ÍC–¼‘O•¶Žš‚Å\¬‚·‚é—ñ‚Æ‚·‚éB –¼‘O‹y‚Ñ&token; NameChar Letter | Digit | '.' | '-' | '_' | ':' | CombiningChar | Extender Name (Letter | '_' | ':') (NameChar)* Names Name (S Name)* Nmtoken (NameChar)+ Nmtokens Nmtoken (S Nmtoken)*

&literal;ƒf[ƒ^‚ÍCˆø—p•„‚ň͂܂ꂽ&string;‚Æ‚µC‚»‚Ì—ñ‚Ì‹æØ‚èŽq‚Æ‚µ‚ÄŽg—p‚·‚éˆø—p•„‚ÍŠÜ‚Ü‚È‚¢B&literal;‚ÍC“à•”ŽÀ‘Ì(EntityValue)C‘®«’l(AttValue)CŠO•”&identifier;(SystemLiteral)‚Ì“à—e‚ÌŽw’è‚ÉŽg—p‚·‚éB–Ú“I‚É‚æ‚Á‚Ä‚ÍC&literal;‘S‘Ì‚ðC‚»‚Ì’†‚Ì&markup;‚Ì‘–¸‚ðs‚Ȃ킸‚ÉCƒXƒLƒbƒv‚·‚邱‚Æ‚ª‚ ‚é(SkipLitB)B &literal; EntityValue ' " ' ([^%&"] | PEReference | Reference)* ' " ' |  " ' " ([^%&'] | PEReference | Reference)* " ' " AttValue ' " ' ([^<&"] | Reference)* ' " ' |  " ' " ([^<&'] | Reference)* " ' " SystemLiteral SkipLit PubidLiteral ' " ' PubidChar* ' " ' | " ' " (PubidChar - " ' ")* " ' " PubidChar #x20 | #xD | #xA | [a-zA-Z0-9] | [-'()+,./:=?] SkipLit (' " ' [^"]* ' " ') | (" ' " [^']* " ' ")

•¶Žšƒf[ƒ^‹y‚Ñ&markup;

ƒeƒLƒXƒg‚ÍC•¶Žšƒf[ƒ^‹y‚Ñ&markup;‚ª¬Ý‚·‚é‚à‚Ì‚Æ‚µ‚Ä\¬‚·‚éB&markup;‚ÍCŠJŽnƒ^ƒOCI—¹ƒ^ƒOC‹ó—v‘fCŽÀ‘ÌŽQÆC•¶ŽšŽQÆCƒRƒƒ“ƒgCCDATAƒZƒNƒVƒ‡ƒ“ ‚Ì‹æØ‚èŽqC•¶‘Œ^錾‹y‚ш—–½—ß‚ÌŒ`‚ðŽæ‚éB

&markup;‚Å‚Í‚È‚¢‚·‚ׂẴeƒLƒXƒg‚ÍC•¶‘‚Ì•¶Žšƒf[ƒ^‚ð\¬‚·‚éB

ƒAƒ“ƒpƒTƒ“ƒh•¶Žš (&)‹y‚Ñ&left-angle-bracket; (<)‚ÍC&markup;‚Ì‹æØ‚èŽq‚Æ‚µ‚ÄC–”‚̓Rƒƒ“ƒgCˆ—–½—ߎႵ‚­‚ÍCDATAƒZƒNƒVƒ‡ƒ““à‚ÅŽg—p‚·‚éꇂɂ¾‚¯C‚»‚Ì‚Ü‚Ü‚ÌŒ`‚ÅoŒ»‚µ‚Ä‚æ‚¢B‚±‚ê‚ç‚Ì•¶Žš‚ÍC“à•”ŽÀ‘Ì錾‚Ì&literal;ŽÀ‘Ì’l“à‚É‹Lq‚µ‚Ä‚à‚æ‚¢B Ú‚µ‚­‚ÍC&well-formed;‚ÌŽÀ‘Ì‚ÉŠÖ‚·‚é‹K’è‚ðŽQÆB‚±‚ê‚ç‚Ì•¶Žš‚ª‘¼‚Ì•”•ª‚Å•K—v‚Èê‡C”’l‚É‚æ‚镶ŽšŽQÆ–”‚Í&string;"&amp;"‹y‚Ñ&string;"&lt;"‚ðŽg—p‚µC&escape;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B&right-angle-bracket; (>) ‚ÍC&string;"&gt;"‚ðŽg—p‚µ‚Ä•\Œ»‚µ‚Ä‚à‚æ‚¢B“à—e‚Ì’†‚Å—ñ"]]>"‚ðŽg—p‚·‚é‚Æ‚«‚ÍC‚»‚ꂪCCDATAƒZƒNƒVƒ‡ƒ“‚ÌI—¹‚ð&markup;‚µ‚È‚¢ŒÀ‚èCŒÝŠ·«‚Ì‚½‚ßC"&gt;"–”‚Í•¶ŽšŽQÆ‚ðŽg—p‚µC&escape;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

—v‘f‚Ì“à—e‚Å‚ÍC•¶Žšƒf[ƒ^‚ÍC‚¢‚©‚È‚é&markup;‚ÌŠJŽn‹æØ‚èŽq‚ðŠÜ‚Ü‚È‚¢”CˆÓ‚Ì&char-string;‚Æ‚·‚éBCDATAƒZƒNƒVƒ‡ƒ“‚Å‚ÍC•¶Žšƒf[ƒ^‚Æ‚ÍCCDATAƒZƒNƒVƒ‡ƒ“‚ÌI—¹‹æØ‚èŽq"]]>"‚ðŠÜ‚Ü‚È‚¢”CˆÓ‚Ì&char-string;‚Æ‚·‚éB

‘®«’l‚É&single-quote;‹y‚Ñ&double-quote;‚ðŠÜ‚Þ‚½‚ß‚É‚ÍCƒAƒ|ƒXƒgƒƒtƒB–”‚Í&single-quote;(') ‚ÍC"&apos;"‚Æ‚µ‚Ä•\Œ»‚µC&double-quote;(")‚ÍC"&quot;"‚Æ‚µ‚Ä•\Œ»‚·‚éB •¶Žšƒf[ƒ^ CharData [^<&]* - ([^<&]* ']]>' [^<&]*)

ƒRƒƒ“ƒg

ƒRƒƒ“ƒg‚ÍC‘¼‚Ì&markup;‚ÌŠO‚È‚ç‚ÎC•¶‘‚Ì‚Ç‚±‚ÉŒ»‚ê‚Ä‚à‚æ‚¢B‚³‚ç‚ÉC•¶‘Œ^錾“à‚ÅC•¶–@‚ª‹–‚·êŠ‚ÉŒ»‚ê‚Ä‚à‚æ‚¢B ƒRƒƒ“ƒg‚ÍC•¶‘‚Ì•¶Žšƒf[ƒ^‚̈ꕔ‚Å‚Í‚È‚¢BXML&processor;‚ÍC&application;‚ªƒRƒƒ“ƒg‚̃eƒLƒXƒg‚ðŽæ‚èo‚·‚±‚Æ‚ð‰Â”\‚Æ‚µ‚Ä‚à‚æ‚¢‚ªC‚»‚¤‚µ‚È‚­‚Æ‚à‚æ‚¢B ŒÝŠ·«‚Ì‚½‚ßC&string;"--" i&double-hyphen;j‚ÍCƒRƒƒ“ƒg“à‚ÅŒ»‚ê‚Ä‚Í‚È‚ç‚È‚¢B ƒRƒƒ“ƒg Comment '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->'

ƒRƒƒ“ƒg‚Ì—á‚ðŽŸ‚ÉŽ¦‚·B <!&como; declarations for <head> & <body> &comc;>

ˆ—–½—ß

ˆ—–½—ß(PI)‚É‚æ‚Á‚ÄC&application;‚Ì‚½‚ß‚Ì–½—߂𕶑‚É“ü‚ê‚邱‚Æ‚ª‚Å‚«‚éB ˆ—–½—ß PI '<?' PITarget (S (Char* - (Char* &pic; Char*)))? &pic; PITarget Name - (('X' | 'x') ('M' | 'm') ('L' | 'l')) PI‚ÍC•¶‘‚Ì•¶Žšƒf[ƒ^‚̈ꕔ‚Å‚Í‚È‚¢‚ªC&application;‚É“n‚³‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢BPI‚ÍC–½—ß‚ª“n‚³‚ê‚é&application;‚ð&identify;‚½‚ß‚ÉŽg—p‚·‚é⌖ (PITarget) ‚ÅŽn‚Ü‚éB⌖–¼ "XML"C"xml"‚È‚Ç‚ÍC‚±‚Ì&TR-or-Rec;‚ÌŒ»Ý‚̔Ŗ”‚Í«—ˆ‚̔ł̋KŠi‰»—p‚É—\–ñ‚·‚éBXML‚Ì‹L–@‹@\‚ðCPI‚Ì⌖‚ð錾‚·‚邽‚ß‚ÉŽg—p‚µ‚Ä‚à‚æ‚¢B

CDATAƒZƒNƒVƒ‡ƒ“

CDATAƒZƒNƒVƒ‡ƒ“‚ÍC•¶Žšƒf[ƒ^‚ªoŒ»‚·‚é‚Æ‚±‚ë‚Å‚ ‚ê‚ÎC‚Ç‚±‚ÉoŒ»‚µ‚Ä‚à‚æ‚¢B‚±‚ê‚ÍC‚»‚¤‚Å‚È‚¯‚ê‚ÎC&markup;‚Æ‚µ‚Ä”FŽ¯‚·‚镶Žš‚ðŠÜ‚ÞCƒeƒLƒXƒg‚Ì‹æ‰æ‚ð&escape;‚·‚é‚Ì‚ÉŽg—p‚·‚éBCDATAƒZƒNƒVƒ‡ƒ“‚ÍC&string;"<![CDATA["‚ÅŽn‚Ü‚èC&string; "]]>"‚ÅI‚í‚éB CDATAƒZƒNƒVƒ‡ƒ“ CDSect CDStart CData CDEnd CDStart '<![CDATA[' CData (Char* - (Char* ']]>' Char*)) CDEnd ']]>' CDATAƒZƒNƒVƒ‡ƒ““à‚Å‚ÍC—ñCDEnd‚¾‚¯‚ð&markup;‚Æ‚µ‚Ä”FŽ¯‚·‚é‚Ì‚ÅC&left-angle-bracket;‹y‚уAƒ“ƒpƒTƒ“ƒh‚ÍC‚»‚Ì&literal;Œ`Ž®‚ÅoŒ»‚µ‚Ä‚æ‚¢B‚»‚ê‚ç‚ÍC"&lt;"‹y‚Ñ"&amp;"‚ðŽg—p‚µ‚Ä&escape;‚·‚é•K—v‚Í‚È‚¢BCDATAƒZƒNƒVƒ‡ƒ“‚ÍC“ü‚êŽq‚É‚Í‚Å‚«‚È‚¢B

"<greeting>"‹y‚Ñ"</greeting>"‚ðC&markup;‚Å‚Í‚È‚­C•¶Žšƒf[ƒ^‚Æ‚µ‚Ä”FŽ¯‚·‚éCDATAƒZƒNƒVƒ‡ƒ“‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <![CDATA[<greeting>Hello, world!</greeting>]]>

&prolog;‹y‚Ñ•¶‘Œ^錾

XML•¶‘‚ÍCŽg—p‚·‚éXML‚Ì&version;‚ðŽw’è‚·‚éXML錾‚ÅŽn‚ß‚Ä‚à‚æ‚­C–”‚»‚¤‚·‚é‚Ì‚ª–]‚Ü‚µ‚¢B

‚±‚Ì&TR-or-Rec;‚Ì‚±‚Ì&version;‚É“K‡‚·‚邱‚Æ‚ðŽ¦‚·‚½‚ß‚É‚ÍC&version;”Ô† "1.0" ‚ðŽg—p‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚ ‚镶‘‚ªC‚±‚Ì&TR-or-Rec;‚Ì‚±‚Ì&version;‚É“K‡‚µ‚È‚¢‚Æ‚«C’l"1.0"‚ðŽg—p‚·‚é‚Ì‚ÍC&error;‚Æ‚·‚éB‚±‚Ì&TR-or-Rec;‚Ì¡Œã‚Ì&version;‚É"1.0"ˆÈŠO‚Ì’l‚ð•t—^‚·‚邱‚Æ‚ªCXMLì‹ÆƒOƒ‹[ƒv‚̈Ó}‚¾‚ªCXML‚Ì«—ˆ‚Ì&version;‚ð쬂·‚邱‚Æ‚ÌŠm–ñ‚ðŽ¦‚·‚킯‚Å‚Í‚È‚­C쬂µ‚½‚Æ‚µ‚Ä‚àC”Ô†•t‚¯‚ɂ‚¢‚ÄC“Á’è‚Ì•û–@‚ðŽg—p‚·‚邱‚Æ‚ÌŠm–ñ‚ðŽ¦‚·‚킯‚Å‚à‚È‚¢B«—ˆ‚Ì&version;‚̉”\«‚ðœŠO‚µ‚È‚¢‚Ì‚ÅC•K—v‚Èê‡CŽ©“®“I‚È&version;‚Ì”FŽ¯‚ð‰Â”\‚Æ‚·‚éŽè’i‚Æ‚µ‚ÄC‚±‚Ì\¬Žq‚ð’ñ‹Ÿ‚·‚éB&processor;‚ÍCƒTƒ|[ƒg‚µ‚Ä‚¢‚È‚¢&version;‚щƒxƒ‹•t‚¯‚µ‚½•¶‘‚ðŽó‚¯Žæ‚Á‚½‚Æ‚«C&error;‚ð’Ê’m‚µ‚Ä‚à‚æ‚¢B

XML•¶‘“à‚Ì&markup;‚Ì‹@”\‚ÍC‹L‰¯\‘¢‹y‚ј_—\‘¢‚ð‹Lq‚·‚邱‚ÆC•À‚Ñ‚É‘®«‹y‚Ñ‘®«’l‚̑΂ð˜_—\‘¢‚ÉŠÖ˜A‚¯‚邱‚Æ‚É‚ ‚éBXML‚ÍC˜_—\‘¢‚ɂ‚¢‚Ă̧–ñðŒ‚ð’è‹`‚·‚邽‚ßC‹y‚Ñ‚ ‚ç‚©‚¶‚ß’è‹`‚³‚ꂽ‹L‰¯’PˆÊ‚ðŽg—p‚Å‚«‚邽‚ß‚Ì‹@\‚Æ‚µ‚ÄC•¶‘Œ^錾‚ð’ñ‹Ÿ‚·‚éBXML•¶‘‚ª&valid;‚Æ‚ÍC•¶‘Œ^錾‚ð‚à‚¿C‚»‚Ì•¶‘Œ^錾‚ÉŽ¦‚·§–ñðŒ‚ð–ž‚½‚·‚±‚Æ‚Æ‚·‚éB

•¶‘Œ^錾‚ÍC•¶‘‚Ìʼn‚Ì—v‘f‚Ì‘O‚ÉŒ»‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B &prolog; prolog XMLDecl? Misc* (doctypedecl Misc*)? XMLDecl &xmlpio; VersionInfo EncodingDecl? SDDecl? S? &pic; VersionInfo S 'version' Eq ('"VersionNum"' | "'VersionNum'") Eq S? '=' S? VersionNum ([a-zA-Z0-9_.:] | '-')+ Misc Comment | PI | S

—Ⴆ‚ÎCŽŸ‚ÉŽ¦‚·Š®‘S‚ÈXML•¶‘‚ÍC&well-formed;‚Å‚ ‚邪&valid;‚Å‚Í‚È‚¢B Hello, world! ]]> ŽŸ‚Ì•¶‘‚à“¯—l‚Æ‚·‚éB Hello, world! ]]>

XML‚Ì•¶‘Œ^錾‚ÍC‚ ‚镶‘ƒNƒ‰ƒX‚Ì‚½‚ß‚Ì•¶–@‚ð’ñ‹Ÿ‚·‚é&markup;錾‚ðŠÜ‚Þ‚©C–”‚ÍŽQÆ‚·‚éB‚±‚Ì•¶–@‚ðC•¶‘Œ^’è‹`–”‚ÍDTD‚Æ‚¢‚¤B•¶‘Œ^錾‚ÍC&markup;錾‚ðŠÜ‚ñ‚¾ŠO•”⊂(“Á•Ê‚ÈŽí—Þ‚ÌŠO•”ŽÀ‘Ì)‚ðŽQÆ‚Å‚«C–”‚Í“à•”⊂‚É’¼Ú&markup;錾‚ðŠÜ‚Þ‚±‚Æ‚à‚Å‚«‚éB‚³‚ç‚ÉC‚»‚Ì—¼•û‚à‰Â”\‚Æ‚·‚éB‚ ‚镶‘‚ÌDTD‚ÍC—¼•û‚Ì⊂‚ð‚Ü‚Æ‚ß‚½‚à‚Ì‚Æ‚µ‚Ä\¬‚·‚éB

&markup;錾‚ÍC—v‘fŒ^錾C ‘®«ƒŠƒXƒg錾CŽÀ‘Ì錾–”‚Í‹L–@錾‚Æ‚·‚éBŽŸ‚ÉŽ¦‚·&well-formed;§–ñ‹y‚Ñ&validity;§–ñ‚É‹K’è‚·‚邪C‚±‚ê‚ç‚Ì錾‚ÍC¶meter;ŽÀ‘Ì“à‚É‘S‘Ì–”‚͈ꕔ‚ªŠÜ‚Ü‚ê‚Ä‚à‚æ‚¢BÚ‚µ‚¢‹K’è‚ÍC•¨—\‘¢‚ÉŠÖ‚·‚é‹K’è‚ðŽQÆ‚Ì‚±‚ÆB

•¶‘Œ^’è‹` doctypedecl '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>' markupdecl elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment &root;—v‘fŒ^

•¶‘Œ^錾‚É‚¨‚¯‚éName‚ÍC&root;—v‘f‚ÌŒ^‚Æ&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

錾‹y‚Ѷmeter;ŽÀ‘Ì‚ªŒµ–§‚É“ü‚êŽq‚ð‚È‚·‚±‚Æ

¶meter;ŽÀ‘Ì‚Ì&replacement-text;‚ÍC&markup;錾“à‚É‚¨‚¢‚ÄCŒµ–§‚É“ü‚êŽq‚É‚È‚Á‚Ä‚¢‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚‚܂èC&markup;錾(markupdecl)‚Ìʼn–”‚ÍÅŒã‚Ì•¶Žš‚ªC¶meter;ŽÀ‘ÌŽQÆ‚Ì‘ÎÛ‚Æ‚È‚é&replacement-text;‚ÉŠÜ‚Ü‚ê‚ê‚ÎC—¼•û‚Æ‚à“¯‚¶&replacement-text;‚ÉŠÜ‚Ü‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B

 “à•”⊂“à‚̶meter;ŽÀ‘Ì

DTD‚Ì“à•”⊂‚Å‚ÍC¶meter;ŽÀ‘ÌŽQÆ‚ÍC&markup;錾‚ªoŒ»‰Â”\‚Èꊂ¾‚¯‚ÉoŒ»‚Å‚«‚éB&markup;錾“à‚É‚ÍoŒ»‚Å‚«‚È‚¢(‚±‚̧–ñ‚ÍCŠO•”¶meter;ŽÀ‘Ì–”‚ÍŠO•”⊂‚Å‚ÌŽQÆ‚É‚Í“K—p‚µ‚È‚¢B)B

“à•”⊂‚Ì‚Æ‚«‚Æ“¯—l‚ÉCŠO•”⊂‹y‚ÑDTD‚É‚¨‚¢‚ÄŽQÆ‚·‚é”CˆÓ‚ÌŠO•”¶meter;ŽÀ‘Ì‚ÍC”ñI’[‹L†markupdecl‚É‚æ‚Á‚Ä‹–‚³‚ê‚éŒ^‚ÌCˆê˜A‚ÌŠ®‘S‚È&markup;錾‚Å\¬‚³‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B&markup;錾‚ÌŠÔ‚É‚ÍC‹ó”’–”‚Ͷmeter;ŽÀ‘ÌŽQÆ‚ð’u‚¢‚Ä‚à‚æ‚¢B‚µ‚©‚µCŠO•”⊂–”‚ÍŠO•”¶meter;ŽÀ‘Ì‚Ì“à—e‚̈ꕔ‚ÍCðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚ðŽg—p‚µ‚Ä–³Ž‹‚µ‚Ä‚à‚æ‚¢B“à•”ƒTƒuƒZƒbƒg‚Å‚ÍC‚±‚ê‚Í‹–‚³‚ê‚È‚¢B ŠO•”⊂ extSubset ( markupdecl | conditionalSect | PEReference | S )*

ŠO•”⊂‹y‚ÑŠO•”¶meter;ŽÀ‘Ì‚ÍC‚»‚Ì“à‚Å‚ÍC¶meter;ŽÀ‘Ì‚ª&markup;錾‚ÌŠÔ‚¾‚¯‚Å‚È‚­C&markup;錾‚Ì“à‚Å‚à”FŽ¯‚³‚ê‚éC‚Æ‚¢‚¤“_‚Å‚à“à•”⊂‚Ƃ͈قȂéB

•¶‘Œ^錾•t‚«‚ÌXML•¶‘‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B Hello, world! ]]> ƒVƒXƒeƒ€&identifier; "hello.dtd"‚ªC•¶‘‚ÌDTD‚ÌURI‚Æ‚È‚éB

ŽŸ‚Ì—á‚Ì‚Æ‚¨‚èC錾‚ð‹ÇŠ“I‚É—^‚¦‚邱‚Æ‚à‚Å‚«‚éB ]> Hello, world! ]]> ŠO•”⊂‹y‚Ñ“à•”⊂‚Ì—¼•û‚ðŽg—p‚·‚é‚Æ‚«‚ÍC“à•”⊂‚ªŠO•”⊂‚æ‚èæ‚ÉoŒ»‚µ‚½‚ÆŒ©‚È‚·B‚±‚ê‚ÍC“à•”⊂‚ÌŽÀ‘Ì‹y‚Ñ‘®«ƒŠƒXƒg錾‚ªCŠO•”⊂‚ÌŽÀ‘Ì‹y‚Ñ‘®«ƒŠƒXƒg錾‚æ‚è—Dæ‚·‚é‚Æ‚¢‚¤Œø‰Ê‚ð‚à‚½‚ç‚·B

&standalone;•¶‘錾

XML&processor;‚ÍC&application;‚É•¶‘‚Ì“à—e‚ð“n‚·‚ªC&markup;錾‚ÍC‚±‚Ì“à—e‚ɉe‹¿‚ð—^‚¦‚邱‚Æ‚ª‚ ‚éB‘®«‚Ì&default-value;‹y‚ÑŽÀ‘Ì錾‚ð‚»‚Ì—á‚Æ‚·‚éBXML錾‚̈ꕔ•ª‚Æ‚µ‚ÄoŒ»‚Å‚«‚é&standalone;•¶‘錾‚ÍC•¶‘‚ªC‚»‚Ì&markup;錾‚Ì‘¶Ý‚É‚æ‚Á‚ĉe‹¿‚³‚ê‚È‚¢‚±‚Æ‚ðŽw‚µŽ¦‚·i•’ÊC‚»‚Ì&markup;錾‚ª‘¶Ý‚µ‚È‚¢‚½‚ß‚ÉC‚±‚ꂪ‚¢‚¦‚éBjB &standalone;•¶‘錾 SDDecl S 'standalone' Eq "'" ('yes' | 'no') "'" | S 'standalone' Eq '"' ('yes' | 'no') '"'

&standalone;•¶‘錾‚É‚¨‚¢‚Ä‚Í, "yes"‚Ì’l‚ÍC•¶‘ŽÀ‘Ì‚ÌŠO•”‚ÉiDTD‚ÌŠO•”⊂“à‚ÉC–”‚Í“à•”⊂‚©‚çŽQÆ‚³‚ê‚éŠO•”ƒpƒ‰ƒƒ^ŽÀ‘Ì“à‚ÉjCXML&processor;‚©‚ç&application;‚Ö‚Æ“n‚³‚ê‚éî•ñ‚ɉe‹¿‚·‚é&markup;錾‚ª‘¶Ý‚µ‚È‚¢‚±‚Æ‚ðˆÓ–¡‚·‚éB"no"‚Ì’l‚ÍC‚»‚ÌŠO•”&markup;錾‚ª‘¶Ý‚·‚é‚©C–”‚Í‘¶Ý‚·‚é‰Â”\«‚ª‚ ‚邱‚Æ‚ðˆÓ–¡‚·‚éB&standalone;•¶‘錾‚ÍC‚»‚Ì錾‚ª•¶‘ŠO•”‚É‘¶Ý‚·‚é‚©‚Ç‚¤‚©‚ðŽ¦‚·‚¾‚¯‚É’ˆÓ‚·‚邱‚ÆBŠO•”ŽÀ‘Ì‚Ö‚ÌŽQÆ‚ª•¶‘“à‚É‘¶Ý‚µ‚Ä‚¢‚Ä‚àC‚»‚ÌŽÀ‘Ì‚ª“à•”“I‚É錾‚³‚ê‚Ä‚¢‚é‚Æ‚«‚ÍC•¶‘‚Ì&standalone;‚Ìó‘Ԃɂ͉e‹¿‚ð—^‚¦‚È‚¢B

ŠO•”‚É&markup;錾‚ª‘¶Ý‚µ‚È‚¯‚ê‚ÎC&standalone;•¶‘錾‚͈Ӗ¡‚ð‚à‚½‚È‚¢BŠO•”‚É&markup;錾‚ª‘¶Ý‚µC&standalone;•¶‘錾‚ª‘¶Ý‚µ‚È‚¢ê‡‚ÍC"no" ‚Ì’l‚ÌÝ’è‚ð‰¼’è‚·‚éB

XML•¶‘‚Å standalone="no" ‚ªÝ’肳‚ê‚Ä‚¢‚é‚à‚Ì‚ÍC‚ ‚éƒAƒ‹ƒSƒŠƒYƒ€‚Å&standalone;•¶‘‚É•ÏŠ·‚Å‚«C‚±‚Ì•¶‘‚ÍCƒlƒbƒgƒ[ƒN”zM&application;‚É‚Æ‚Á‚Ä–]‚Ü‚µ‚¢‚©‚à‚µ‚ê‚È‚¢B

&standalone;•¶‘錾

&standalone;•¶‘錾‚ÍC‰½‚ç‚©‚ÌŠO•”&markup;錾‚ªŽŸ‚Ì‚¢‚¸‚ê‚©‚ð錾‚µ‚Ä‚¢‚é‚Æ‚«‚ÍC’l "no" ‚ðŽæ‚ç‚È‚¯‚ê‚΂Ȃç‚È‚¢B

a) &default;’l•t‚«‚Ì‘®«‚Å‚ ‚Á‚ÄC‚±‚Ì‘®«‚ª“K—p‚³‚ê‚é—v‘f‚ªC‘®«’l‚ðŽw’肹‚¸‚É•¶‘“à‚ÉŒ»‚ê‚é‚à‚ÌB

b) &magicents;ˆÈŠO‚ÌŽÀ‘Ì‚Å‚ ‚Á‚ÄC‚»‚ÌŽÀ‘̂ɑ΂·‚éŽQÆ‚ª•¶‘“à‚ÉoŒ»‚·‚é‚à‚ÌB

c) ’l‚ª³‹K‰»‚Ì‘ÎÛ‚Æ‚È‚é‘®«‚Å‚ ‚Á‚ÄC³‹K‰»‚ÌŒ‹‰Ê‚Æ‚µ‚ĕω»‚·‚é’l‚ª•¶‘“à‚Å‘®«‚ÉŽw’肳‚ê‚é‚à‚ÌB

d) —v‘f“à—e‚ð‚à‚—v‘fŒ^‚Å‚ ‚Á‚ÄC‹ó”’‚ª‚»‚Ì—v‘fŒ^‚Ì‚¢‚¸‚ê‚©‚̃Cƒ“ƒXƒ^ƒ“ƒX“à‚É’¼ÚŒ»‚ê‚é‚à‚ÌB

&standalone;•¶‘錾•t‚«‚ÌXML錾‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <?xml version="&XML.version;" standalone='yes'?>

 ‹ó”’‚̎戵‚¢

XML•¶‘‚ð•ÒW‚·‚é‚Æ‚«‚ÍC&markup;‚ð–Ú—§‚½‚¹“Ç‚Ý‚â‚·‚­‚·‚邽‚ß‚ÉCg‹ó”’h(&space;Cƒ^ƒu‹y‚Ñ‹ó”’sB‚±‚Ì&TR-or-Rec;‚Å‚ÍC”ñI’[‹L†‚ÌS‚Å•\‚·)‚ðŽg‚¤‚Æ•Ö—˜‚È‚±‚Æ‚ª‘½‚¢B‚»‚Ì‹ó”’‚ÍC”z•z‚·‚é&version;‚Ì•¶‘‚̈ꕔ‚Æ‚µ‚Ċ܂߂邱‚Æ‚ðˆÓ}‚µ‚È‚¢‚Ì‚ð•’Ê‚Æ‚·‚éB‚µ‚©‚µCgˆÓ–¡‚Ì‚ ‚éh‹ó”’‚Å‚ ‚Á‚ÄC”z•z‚·‚é&version;‚ÉŽc‚³‚È‚¯‚ê‚΂Ȃç‚È‚¢‚à‚Ì‚à‘½‚¢B—Ⴆ‚ÎCŽ‹y‚у\[ƒXƒR[ƒh‚É‚¨‚¯‚é‹ó”’‚ª‚ ‚éB

XML&processor;‚ÍC•¶‘“à‚Ì&markup;ˆÈŠO‚Ì‚·‚ׂĂ̕¶Žš‚ðC‚»‚Ì‚Ü‚Ü•ÏX‚¹‚¸‚É&application;‚É“n‚³‚È‚¯‚ê‚΂Ȃç‚È‚¢B&validating;XML&processor;‚ÍC—v‘f“à—e‚Ì’†‚̋󔒂𑼂̔ñ&markup;•¶Žš‚©‚ç‹æ•Ê‚µC&application;‘¤‚É—v‘f“à—e‚Ì’†‚Ì‹ó”’‚ªd—v‚Å‚È‚¢‚Æ‚¢‚¤‚±‚Æ‚ð“`‚¦‚È‚¯‚ê‚΂Ȃç‚È‚¢B

"xml:space"‚Æ‚¢‚¤“Á•Ê‚È‘®«‚𕶑‚É‘}“ü‚·‚邱‚Æ‚É‚æ‚Á‚ÄC‹ó”’‚ðd—v‚Æ‚·‚éˆÓ}‚ðŽ¦‚µ‚Ä‚à‚æ‚¢B‚±‚Ì‘®«‚ð“K—p‚·‚é—v‘f‚ÉŒ»‚ê‚é‹ó”’‚ðCƒAƒvƒŠƒP[ƒVƒ‡ƒ“‚ªd—v‚È‚à‚Ì‚Æ‚µ‚Ĉµ‚¤‚±‚Æ‚ð—v‹‚·‚éC‚Æ‚¢‚¤ˆÓ}‚ðŽ¦‚·B

&valid;‚È•¶‘‚Å‚ÍC‚±‚Ì‘®«‚ðŽg—p‚·‚éꇂÍC‘¼‚Ì‘®«‚Æ“¯‚¶‚悤‚É錾‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B錾‚·‚é‚Æ‚«‚ÍCŽæ‚蓾‚é’l‚ð"default"‹y‚Ñ "preserve"‚¾‚¯‚Æ‚·‚é—ñ‹“Œ^‚Å‚È‚¯‚ê‚΂Ȃç‚È‚¢B

’l"default"‚ÍC&application;‚Ì&default;‚Ì‹ó”’ˆ—ƒ‚[ƒh‚ðC‚»‚Ì—v‘f‚É“K—p‰Â”\‚Æ‚·‚邱‚Æ‚ðˆÓ–¡‚·‚éB’l"preserve"‚ÍC&application;‚ª‚·‚ׂĂ̋󔒂ð•Û‘¶‚·‚邱‚Æ‚ðˆÓ–¡‚·‚éB‚±‚Ì錾‚̈Ó}‚ÍC"xml:space" ‘®«‚Ì•Ê‚ÌŽw’è‚Åã‘‚«‚µ‚È‚¢ŒÀ‚èC—v‘f‚Ì“à—e‚ÉŒ»‚ê‚é‚·‚ׂĂ̗v‘f‚É“K—p‚·‚é‚ƉðŽß‚·‚éB

•¶‘‚Ì&root;—v‘f‚ɂ‚¢‚Ä‚ÍC‚±‚Ì‘®«‚Ì’l‚ðŽw’è‚·‚é‚©C–”‚Í‚±‚Ì‘®«‚Ì&default-value;‚ª‚ ‚éꇂ𜂢‚Ä‚ÍC&application;‚É‚æ‚é‹ó”’‚̎戵‚¢‚ɂ‚¢‚ÄC‚¢‚©‚È‚éˆÓ}‚àŽ¦‚³‚È‚¢‚ƉðŽß‚·‚éB

—á‚ðŽŸ‚ÉŽ¦‚·B ]]>

s––‚̎戵‚¢

XML‚Ì\•¶&parsed-entity;‚ÍC’ÊíƒRƒ“ƒsƒ…[ƒ^‚̃tƒ@ƒCƒ‹“à‚É•Û‘¶‚³‚êC•ÒW‚Ì•Ö‹X‚Ì‚½‚ß‚É•¡”‚Ìs‚É•ª‚¯‚邱‚Æ‚ª‘½‚¢B‚±‚ê‚ç‚Ìs‚ÍC•’Ê‚ÍCCR (#xD)ƒR[ƒh‹y‚Ñ LF (#xA)ƒR[ƒh‚̉½‚ç‚©‚Ì‘g‡‚¹‚É‚æ‚Á‚Ä•ª‚¯‚ç‚ê‚éB

&application;‚̈—‚ðŠÈ’P‚É‚·‚邽‚ßCŠO•”&parsed-entity;–”‚Í“à•”&parsed-entity;‚Ì&literal;ŽÀ‘Ì’l‚ªC"#xD#xA" ‚Ì‚Q•¶Žš‚̘A‘±‚Æ‚·‚é&literal;–”‚Í#xD‚Ì’P“Æ‚Ì&literal;‚ðŠÜ‚ÞꇂÉCXML&processor;‚ÍC&application;‚É’Pˆê‚Ì•¶Žš#xA‚¾‚¯‚ð“n‚³‚È‚¯‚ê‚΂Ȃç‚È‚¢(‚±‚̈—‚ÍC“ü—Í“à‚É‘¶Ý‚·‚é‰üsƒR[ƒh‚ð\•¶‰ðÍ‚Ì‘O‚ɳ‹K‰»‚·‚邱‚Æ‚É‚æ‚Á‚ÄC—eˆÕ‚ÉŽÀŒ»‚Å‚«‚éB)B

 &language-identification;

•¶‘ˆ—‚É‚¨‚¢‚Ä‚ÍC‚»‚Ì•¶‘‚Ì’†g‚ª‚Ç‚ñ‚ÈŽ©‘RŒ¾Œê–”‚ÍŒ`Ž®Œ¾Œê‚Å‘‚©‚ê‚Ä‚¢‚é‚©–¾Ž¦‚·‚邱‚Æ‚ªC–ð‚É—§‚‚±‚Æ‚ª‘½‚¢B

XML•¶‘“à‚Ì—v‘f‚Ì‚à‚“à—e–”‚Í‘®«’l‚É‚¨‚¢‚ÄŽg—p‚·‚錾Œê‚ðŽw’è‚·‚邽‚ß‚ÉC"xml:lang" ‚Æ‚¢‚¤–¼‘O‚Ì“Á•Ê‚È‘®«‚ðC•¶‘“à‚É‘}“ü‚µ‚Ä‚à‚æ‚¢B ‘®«‚Ì’l‚ÍCgRFC1766F&language-identification;‚Ì‚½‚߂̃^ƒOh‚É‚æ‚Á‚Ä‹K’肳‚ê‚é&language-identification;ƒR[ƒh‚É]‚¤B &language-identification; LanguageID Langcode ('-' Subcode)* Langcode ISO639Code | IanaCode | UserCode ISO639Code ([a-z] | [A-Z]) ([a-z] | [A-Z]) IanaCode ('i' | 'I') '-' ([a-z] | [A-Z])+ UserCode ('x' | 'X') '-' ([a-z] | [A-Z])+ Subcode ([a-z] | [A-Z])+ Langcode‚ÍCŽŸ‚Ì‚Ç‚ê‚Å‚à‚æ‚¢B

a) gŒ¾Œê‚Ì–¼‘O•\Œ»‚Ì‚½‚߂̃R[ƒhh‚Å‹K’肳‚ê‚é2•¶Žš‚Ì&language-code;

b) Internet Assigned Numbers Authority (IANA)‚Å“o˜^‚³‚ê‚Ä‚¢‚é&language-code;B‚±‚ê‚ÍC擪‚ª "i-" (–”‚Í"I-")‚ÅŽn‚Ü‚éB

c) &user;‚É‚æ‚Á‚Ä’è‚ß‚ç‚ꂽ&language-code;C–”‚ÍŽ„“I‚ÈŽg—p‚Ì‚½‚ß‚É•¡”‚Ì’c‘ÌŠÔ‚ªŽæ‚茈‚ß‚½ƒR[ƒhB‚±‚ê‚ç‚ÍC¡ŒãIANA‚É‚¨‚¢‚Ä•W€‰»–”‚Í“o˜^‚³‚ê‚éƒR[ƒh‚Æ‚Ì‹£‡‚ð”ð‚¯‚é‚½‚ß‚ÉC擪‚ð"x-" –”‚Í "X-" ‚ÅŽn‚ß‚éB

Subcode‚ÍC•¡”‰ñŽg‚Á‚Ä‚à‚æ‚¢Bʼn‚̃TƒuƒR[ƒh‚ª‘¶Ý‚µC‚»‚Ì“à—e‚ª“ñ‚‚̕¶Žš‚©‚笂é‚Æ‚«‚ÍCISO3166‚Ìg‘–¼‚ð•\‚·ƒR[ƒh(‘ƒR[ƒh)h‚Å‚È‚¯‚ê‚΂Ȃç‚È‚¢Bʼn‚̃TƒuƒR[ƒh‚ª3•¶ŽšˆÈã‚©‚笂é‚Æ‚«‚ÍCLangcode‚Ì擪‚ªC"x-" –”‚Í "X-"‚ÅŽn‚Ü‚ç‚È‚¢ŒÀ‚èCŽw’肵‚½Œ¾Œê‚ɑ΂·‚éƒTƒuƒR[ƒh‚Æ‚µCIANA‚É“o˜^‚³‚ꂽ‚à‚Ì‚Å‚È‚¯‚ê‚΂Ȃç‚È‚¢B

&language-code;‚ÍC¬•¶Žš‚Å‚Ì•\‹L‚ðC&country-code;‚ÍC(‘¶Ý‚·‚é‚È‚ç‚Î)‘啶Žš‚Å‚Ì•\‹L‚ðŠµs‚Æ‚·‚éB‚µ‚©‚µCXML•¶‘“à‚É‚¨‚¯‚鑼‚Ì–¼‘O‚Ƃ͈قȂèC‚±‚ê‚ç‚Ì’l‚ɂ‚¢‚Ä‚ÍC‘啶Žš‹y‚Ѭ•¶Žš‚Ì‹æ•Ê‚ð‚µ‚È‚¢‚±‚Æ‚É’ˆÓ‚·‚邱‚ÆB

—á‚ðŽŸ‚ÉŽ¦‚·B The quick brown fox jumps over the lazy dog.

What colour is it?

What color is it?

Habe nun, ach! Philosophie, Juristerei, und Medizin und leider auch Theologie ]]>durchaus studiert mit heißem Bemüh'n. ]]>

xml:lang‚Å錾‚·‚éˆÓ}‚ÍCxml:lang‚Ì•Ê‚ÌŽw’è‚Åã‘‚µ‚È‚¢ŒÀ‚èCŽw’肵‚½—v‘f‚Ì“à—e‚ÉŠÜ‚Þ‚·‚ׂĂ̗v‘f‚É“K—p‚·‚éB

&valid;‚È•¶‘‚É‚¨‚¢‚Ä‚ÍC‚±‚Ì&TR-or-Rec;‚Ì‘¼‚ÌꊂŋK’è‚·‚é‚Æ‚¨‚èC‚±‚Ì‘®«‚ð•K‚¸éŒ¾‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B’ÊíC錾‚ÍCŽŸ‚ÌŒ`‚Æ‚·‚éB xml:lang NMTOKEN #IMPLIED •K—v‚È‚ç‚ÎC“Á’è‚Ì&default-value;‚ð—^‚¦‚Ä‚à‚æ‚¢B‰pŒê‚ð•êŒê‚Æ‚·‚éŠw¶—p‚̃tƒ‰ƒ“ƒXŒê‚ÌŽW‚Å‚ÍCà–¾‹y‚Ñ’‚ð‰pŒê‚Å‹Lq‚·‚ê‚ÎCxml:lang ‘®«‚ðŽŸ‚Ì‚Æ‚¨‚è‚É錾‚·‚邱‚Æ‚Æ‚È‚éB ]]>

˜_—\‘¢

‚¢‚©‚È‚éXML•¶‘‚àCˆê‚ˆÈã‚Ì—v‘f‚ðŠÜ‚ÞB—v‘f‚Ì‹«ŠE‚Í, ŠJŽnƒ^ƒO‹y‚ÑI—¹ƒ^ƒO‚É‚æ‚Á‚Ä‹æØ‚éB—v‘f‚ª‹ó—v‘f‚Ì‚Æ‚«‚ÍC‹ó—v‘fƒ^ƒO‚ÅŽ¦‚·BŠeX‚Ì—v‘f‚ÍCŒ^‚ð‚à‚ÂB—v‘fŒ^‚Í–¼‘O(‹¤’Ê&identifier;(generic identifier)–”‚ÍGI‚ƌĂԂ±‚Æ‚ª‚ ‚éB)‚É‚æ‚Á‚Ä&identified;B—v‘f‚ÍC‚¢‚­‚‚©‚Ì‘®«‚ð‚à‚‚±‚Æ‚ª‚Å‚«‚éB‘®«‚ÍC–¼‘O‹y‚Ñ’l‚ð‚à‚ÂB

—v‘f element EmptyElemTag | STag content ETag

‚±‚Ì&TR-or-Rec;‚ÍC—v‘fŒ^‹y‚Ñ‘®«‚̈Ӗ¡CŽg—p•û–@C–”‚Í(\•¶‚ÉŠÖ‚·‚邱‚Ƃ𜂫)–¼‘O‚ɧ–ñ‚ð—^‚¦‚È‚¢B‚½‚¾‚µC擪‚ª(('X'|'x')('M'|'m')('L'|'l'))‚É&match;‚·‚é–¼‘O‚ÍC‚±‚̔Ŗ”‚Í¡Œã‚̔ł̂±‚Ì&TR-or-Rec;‚Å‚Ì•W€‰»‚Ì‚½‚ß‚É—\–ñ‚·‚éB

—v‘fŒ^‚Ì&match;

—v‘f‚ÌI—¹ƒ^ƒO‚Ì–¼‘O‚ÍC‚»‚Ì—v‘f‚ÌŠJŽnƒ^ƒO‚É‚¨‚¯‚éŒ^‚Æ&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

 ŠJŽnƒ^ƒOCI—¹ƒ^ƒO‹y‚Ñ‹ó—v‘fƒ^ƒO

‹ó‚Å‚È‚¢”CˆÓ‚ÌXML—v‘f‚ÌŽn‚Ü‚è‚ÍCŠJŽnƒ^ƒO‚É‚æ‚Á‚Ä&markup;‚·‚éB ŠJŽnƒ^ƒO STag'<' Name (S Attribute)* S? '>' AttributeName Eq AttValue ŠJŽnƒ^ƒO‹y‚ÑI—¹ƒ^ƒO“à‚ÌName‚ÍC—v‘f‚ÌŒ^‚ð•\‚í‚·BName‹y‚ÑAttValue‚̑΂ð—v‘f‚Ì‘®«Žw’è‚Æ‚¢‚¢CŒÂX‚̑΂ɂ¨‚¯‚éName‚ÍC‘®«–¼‹y‚ÑAttValue‚Ì“à—e(‹æØ‚èŽq'–”‚Í"‚ÌŠÔ‚Ì&string;)‚ð‘®«’l‚Æ‚¢‚¤B

‘®«Žw’è‚̈êˆÓ«

ŠJŽnƒ^ƒO–”‚Í‹ó—v‘fƒ^ƒO‚Å‚ÍC“¯ˆê‚Ì‘®«–¼‚ª‚Q“xˆÈãoŒ»‚µ‚Ä‚Í‚È‚ç‚È‚¢B

 ‘®«’l‚ÌŒ^

‘®«‚Í錾‚³‚ê‚Ä‚¢‚È‚¯‚ê‚΂Ȃç‚È‚¢B‘®«’l‚ÌŒ^‚ÍC‚»‚Ì‘®«‚ɑ΂µ‚Ä錾‚µ‚½Œ^‚Å‚È‚¯‚ê‚΂Ȃç‚È‚¢(‘®«‚ÌŒ^‚ɂ‚¢‚Ä‚ÍC‘®«ƒŠƒXƒg錾‚ɂ‚¢‚Ä‚Ì‹K’è‚ðŽQÆB)B

 ŠO•”ŽÀ‘Ì‚Ö‚ÌŽQÆ‚ª‚È‚¢‚±‚Æ

‘®«’l‚É‚ÍCŠO•”ŽÀ‘Ì‚Ö‚Ì’¼Ú“I–”‚ÍŠÔÚ“I‚ÈŽQÆ‚ðŠÜ‚Þ‚±‚Æ‚Í‚Å‚«‚È‚¢B

 ‘®«’l‚É<‚ðŠÜ‚Ü‚È‚¢‚±‚Æ

‘®«’l“à‚Å’¼Ú“I–”‚ÍŠÔÚ“I‚ÉŽQÆ‚·‚éŽÀ‘Ì(&lt;‚𜂭B)‚Ì&replacement-text;‚É‚ÍC<‚ðŠÜ‚ñ‚Å‚Í‚È‚ç‚È‚¢B

ŠJŽnƒ^ƒO‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <termdef id="dt-dog" term="dog">

ŠJŽnƒ^ƒO‚ÅŽn‚Ü‚é—v‘f‚ÌI‚í‚è‚ÍCI—¹ƒ^ƒO‚Å&markup;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚±‚ÌI—¹ƒ^ƒO‚ÍC‘Ήž‚·‚éŠJŽnƒ^ƒO‚Ì—v‘fŒ^‚Æ“¯‚¶–¼‘O‚ð‚à‚ÂB I—¹ƒ^ƒOETag'</' Name S? '>'

I—¹ƒ^ƒO‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B </termdef>

—v‘f‚ÌŠJŽnƒ^ƒO‚ÆI—¹ƒ^ƒO‚Ƃ̊Ԃ̃eƒLƒXƒg‚ðC‚»‚Ì—v‘f‚Ì“à—e‚Æ‚¢‚¤B —v‘f‚Ì“à—e content(element | CharData | Reference | CDSect | PI | Comment)*

—v‘f‚ª‹ó‚Ì‚Æ‚«C‚»‚Ì—v‘f‚ÍC’¼Œã‚ÉI—¹ƒ^ƒO‚ð‚à‚ŠJŽnƒ^ƒO–”‚Í‹ó—v‘fƒ^ƒO‚Å•\Œ»‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‹ó—v‘fƒ^ƒO‚ÍCŽŸ‚Ì“Á•Ê‚ÈŒ`Ž®‚ð‚Æ‚éB ‹ó—v‘f‚Ì‚½‚߂̃^ƒOEmptyElemTag'<' Name (S Attribute)* S? '/>'

‹ó—v‘fƒ^ƒO‚ÍC“à—e‚ð‚à‚½‚È‚¢”CˆÓ‚Ì—v‘f‚Ì•\Œ»‚É—˜—p‚Å‚«‚éB‹ó—v‘fƒ^ƒO‚Å•\Œ»‚·‚é—v‘f‚ðCƒL[ƒ[ƒhEMPTY‚ð—p‚¢‚Ä錾‚µ‚È‚­‚Æ‚à‚æ‚¢B

‹ó—v‘f‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <IMG align="left" src="http://www.w3.org/Icons/WWW/w3c_home" /><br></br><br/>

 —v‘f錾

&validity;‚ð•ÛØ‚·‚邽‚ßC—v‘f錾‹y‚Ñ‘®«ƒŠƒXƒg錾‚ð—p‚¢‚ÄXML•¶‘‚Ì—v‘f‚Ì\‘¢‚ÉC§–ñ‚ð‰Á‚¦‚邱‚Æ‚ª‚Å‚«‚éB

—v‘f錾‚ÍC—v‘f‚Ì“à—e‚ɂ‚¢‚Ă̧–ñ‚Æ‚·‚éB

—v‘f錾‚ÍC—v‘f‚ÌŽq‚Æ‚µ‚ÄoŒ»‰Â”\‚È—v‘fŒ^‚ɂ‚¢‚ÄC§–ñ‚ð‰Á‚¦‚邱‚Æ‚ª‘½‚¢B&at-user-option;C—v‘f錾‚ð‚à‚½‚È‚¢—v‘fŒ^‚ª‘¼‚Ì—v‘f錾‚É‚æ‚Á‚ÄŽQÆ‚³‚ê‚ê‚ÎCXML&processor;‚ÍCŒx‚ðo‚µ‚Ä‚à‚æ‚¢B‚µ‚©‚µC‚±‚ê‚Í&error;‚Æ‚Í‚µ‚È‚¢B

—v‘fŒ^錾‚ÍCŽŸ‚ÌŒ`Ž®‚ð‚Æ‚éB —v‘fŒ^錾 elementdecl '<!ELEMENT' S Name S contentspec S? '>' contentspec 'EMPTY' | 'ANY' | Mixed | children ‚±‚±‚ÅCName‚ÍC錾‚³‚ê‚Ä‚¢‚é—v‘f‚ÌŒ^‚Æ‚·‚éB

—v‘f錾‚̈êˆÓ«

—v‘fŒ^‚ð‚Q“xˆÈã錾‚Å‚«‚È‚¢B

 —v‘f‚Ì&validity;

—v‘f‚ª&valid;‚Æ‚ÍCelementdecl‚É&match;‚·‚é錾‚Å‚ ‚Á‚ÄC‚»‚ÌName‚ª‚»‚Ì—v‘fŒ^‚Æ&match;‚µCŽŸ‚Ì‚¢‚¸‚ê‚©‚ÌðŒ‚ð–ž‚½‚·ê‡‚Æ‚·‚éB

a) 錾‚ªEMPTY‚É&match;‚µC—v‘f‚ª“à—e‚ð‚à‚½‚È‚¢B

b) 錾‚ªchildren‚É&match;‚µC—v‘f‚ÌŽq—v‘f‚Ì•À‚Ñ‚ªC“à—eƒ‚ƒfƒ‹‚̳‹K•\Œ»‚É‚æ‚Á‚Ķ¬‚³‚ê‚錾Œê‚É‘®‚·‚éB

c) 錾‚ªmixed‚É&match;‚µC—v‘f‚Ì“à—e‚ª•¶Žšƒf[ƒ^‹y‚ÑŽq—v‘f‚©‚ç‚È‚éBŽq—v‘f‚Ì—v‘fŒ^‚ÍC—v‘f‚Ì“à—eƒ‚ƒfƒ‹‚ÉoŒ»‚·‚é–¼‘O‚É&match;‚·‚éB

d) 錾‚ªANY‚É&match;‚µC‚Ç‚ÌŽq—v‘f‚Ì—v‘fŒ^‚à錾‚³‚ê‚Ä‚¢‚éB

—v‘f錾‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <!ELEMENT br EMPTY> <!ELEMENT p (#PCDATA|emph)* > <!ELEMENT %name.para; %content.para; > <!ELEMENT container ANY>

—v‘f“à—e

‚ ‚éŒ^‚Ì—v‘f‚ªŽq—v‘f‚¾‚¯‚ðŠÜ‚Þ(•¶Žšƒf[ƒ^‚ðŠÜ‚Ü‚È‚¢B)‚Æ‚«C‚»‚Ì—v‘fŒ^‚ÍC—v‘f“à—e‚ð‚à‚ÂC‚Æ‚¢‚¤B‚±‚Ìê‡C§–ñ‚ÍC“à—eƒ‚ƒfƒ‹‚ðŠÜ‚ÞB“à—eƒ‚ƒfƒ‹‚ÍCŽq—v‘f‚ÌŒ^‹y‚ÑŽq—v‘f‚ÌoŒ»‡˜‚ð§Œä‚·‚éŠÈ’P‚È•¶–@‚Æ‚·‚éB‚±‚Ì•¶–@‚ÍC&content-particle;(cps)‚©‚ç‚È‚éB&content-particle;‚ÍC–¼‘OC&content-particle;‚Ì‘I‘ðƒŠƒXƒg–”‚Í&content-particle;‚Ì—ñƒŠƒXƒg‚©‚ç\¬‚³‚ê‚éB —v‘f“à—eƒ‚ƒfƒ‹ children(choice | seq) ('?' | '*' | '+')?cp(Name | choice | seq) ('?' | '*' | '+')? choice'(' S? cp ( S? '|' S? cp )*S? ')' seq'(' S? cp ( S? ',' S? cp )*S? ')' ‚±‚±‚ÅCName‚ÍCŽq‚Æ‚µ‚ÄoŒ»‚µ‚Ä‚æ‚¢—v‘f‚ÌŒ^‚ðŽ¦‚·B‚±‚Ì•¶–@‚Å‘I‘ðƒŠƒXƒg‚ªŒ»‚ê‚éˆÊ’u‚Å‚ÍC‘I‘ðƒŠƒXƒg“à‚Ì‚¢‚¸‚ê‚Ì&content-particle;‚à—v‘f“à—e‚Ì’†‚ÉŒ»‚ê‚Ä‚æ‚¢B—ñƒŠƒXƒg‚ÉŒ»‚ê‚é&content-particle;‚ÍCƒŠƒXƒg‚ÅŽw’è‚·‚釔Ԃ̂Ƃ¨‚è‚ÉC—v‘f“à—e‚ÉŒ»‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B–¼‘O–”‚̓ŠƒXƒg‚ÌŒã‚ÉoŒ»‚·‚éƒIƒvƒVƒ‡ƒ“‚Ì•¶Žš‚ÍCƒŠƒXƒg“à‚Ì—v‘f–”‚Í&content-particle;‚ªC1‰ñˆÈã”CˆÓ‚̉ñ”(+)C0‰ñˆÈã”CˆÓ‚̉ñ”(*)–”‚Í0‰ñŽá‚µ‚­‚Í1‰ñ(?)oŒ»‰Â”\‚È‚±‚Æ‚ð‹K’è‚·‚éB‚±‚±‚ÅŽ¦‚·\•¶‹y‚шӖ¡‚ÍC‚±‚Ì&TR-or-Rec;‚É‚¨‚¯‚鶬‹K‘¥‚Å—p‚¢‚é‚à‚Ì‚Æ“¯ˆê‚Æ‚·‚éB

—v‘f‚Ì“à—e‚ª“à—eƒ‚ƒfƒ‹‚É&match;‚·‚é‚Ì‚ÍC—ñC‘I‘ð‹y‚ÑŒJ•Ô‚µ‰‰ŽZŽq‚É‚µ‚½‚ª‚Á‚ÄC“à—e‚Ì’†‚Ì—v‘f‚Æ“à—eƒ‚ƒfƒ‹“à‚Ì—v‘fŒ^‚Æ‚ð&match;‚³‚¹‚È‚ª‚çC“à—eƒ‚ƒfƒ‹“à‚̈ê‚‚̃pƒX‚ð‚½‚Ç‚ê‚é‚Æ‚«‚ÉŒÀ‚éBŒÝŠ·«‚Ì‚½‚ßC•¶‘“à‚Ì—v‘f‚ªC“à—eƒ‚ƒfƒ‹‚É‚¨‚¯‚é—v‘fŒ^‚Ì•¡”‚ÌoŒ»ˆÊ’u‚Æ&match;‚·‚邱‚Æ‚ÍC&error;‚Æ‚·‚éBÚׂȋK’è‚ɂ‚¢‚Ä‚ÍC•‘®‘‚ÌŒˆ’è“I“à—eƒ‚ƒfƒ‹‚Ì€‚ðŽQÆB

ƒOƒ‹[ƒv‹y‚уpƒ‰ƒƒ^ŽÀ‘Ì‚ªŒµ–§‚È“ü‚êŽq‚ð‚È‚µ‚Ä‚¢‚邱‚Æ

ƒpƒ‰ƒƒ^ŽÀ‘Ì‚Ì&replacement-text;‚ÍC&parenthesis;‚ň͂܂ꂽƒOƒ‹[ƒv‚É‚æ‚Á‚ÄCŒµ–§‚È“ü‚êŽq‚ð\¬‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚‚܂èC‘I‘ðC—ñ–”‚ͬݕ”•i‚ÉC&left-parenthesis;–”‚Í&right-parenthesis;‚Ì‚¢‚¸‚ê‚©ˆê•û‚ªƒpƒ‰ƒƒ^ŽÀ‘Ì‚Ì&replacement-text;‚ÉŠÜ‚ê‚ê‚ÎC‘¼•û‚à“¯‚¶&replacement-text;‚ÉŠÜ‚Ü‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B

‘ŠŒÝ‰^—p«‚Ì‚½‚ßCƒpƒ‰ƒƒ^ŽÀ‘ÌŽQÆ‚ª‘I‘ðC—ñ–”‚ͬݓà—e‚ÉŠÜ‚Ü‚ê‚ê‚ÎC‚»‚Ì&replacement-text;‚Í‹ó‚Å‚È‚¢‚±‚Æ‚ª–]‚Ü‚µ‚­C&replacement-text;‚Ì擪‹y‚Ñ––”ö‚Ì‹ó”’‚Å‚È‚¢•¶Žš‚ÍCƒRƒlƒNƒ^(|–”‚Í,)‚Å‚È‚¢•û‚ª‚æ‚¢B

—v‘f“à—eƒ‚ƒfƒ‹‚Ì‚¢‚­‚‚©‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <!ELEMENT spec (front, body, back?)> <!ELEMENT div1 (head, (p | list | note)*, div2*)> <!ELEMENT dictionary-body (%div.mix; | %dict.mix;)*>

 &mixed-content;

‚ ‚é—v‘fŒ^‚Ì—v‘f“à‚ÉCŽq—v‘f‚ɬ݂µ‚Ä•¶Žšƒf[ƒ^‚ªŠÜ‚Ü‚ê‚é‰Â”\«‚ª‚ ‚é‚Æ‚«C‚»‚Ì—v‘fŒ^‚ÍC&mixed-content;‚ð‚à‚‚Ƃ¢‚¤B‚±‚Ìê‡CŽq—v‘f‚ÌŒ^‚ɂ‚¢‚Ă̧–ñ‚ª‘¶Ý‚µ‚Ä‚à‚æ‚¢‚ªCŽq—v‘f‚̇˜–”‚ÍoŒ»‰ñ”‚ɂ‚¢‚Ă̧–ñ‚Í‚È‚¢‚Æ‚·‚éB &mixed-content;錾 Mixed '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' | '(' S? '#PCDATA' S? ')' ‚±‚±‚ÅCName‚ÍCŽq‚Æ‚µ‚ÄoŒ»‚µ‚Ä‚à‚æ‚¢—v‘f‚ÌŒ^‚ðŽ¦‚·B

—v‘fŒ^‚Ìd•¡‚Ì‹ÖŽ~

ˆê‚‚Ì&mixed-content;錾“à‚ÉC“¯‚¶–¼‘O‚ª•¡”‰ñoŒ»‚µ‚Ä‚Í‚È‚ç‚È‚¢B

&mixed-content;錾‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <!ELEMENT p (#PCDATA|a|ul|b|i|em)*> <!ELEMENT p (#PCDATA | %font; | %phrase; | %special; | %form;)* > <!ELEMENT b (#PCDATA)>

 ‘®«ƒŠƒXƒg錾

‘®«‚ÍC–¼‘O‹y‚Ñ’l‚̑΂ð—v‘f‚ÉŠÖ˜A•t‚¯‚邽‚ß‚É—p‚¢‚éB‘®«Žw’è‚ÍCŠJŽnƒ^ƒO–”‚Í‹ó—v‘fƒ^ƒO“à‚Å‚¾‚¯‰Â”\‚Æ‚·‚éB‚µ‚½‚ª‚Á‚ÄC‘®«‚ð”FŽ¯‚·‚邽‚߂̶¬‹K‘¥‚ÍCŠJŽnƒ^ƒO‚ɂ‚¢‚Ä‚Ì‹K’è‚ÅŽ¦‚·B‘®«ƒŠƒXƒg錾‚ÍCŽŸ‚Ì–Ú“I‚Å—p‚¢‚éB

a) ‚ ‚é—v‘fŒ^‚É“K—p‚·‚é‘®«‚ÌW‡‚ð‹K’è‚·‚éB

b) ‘®«‚Ö‚ÌŒ^§–ñ‚ðÝ’è‚·‚éB

c) ‘®«‚Ì&default-value;‚ð‹K’è‚·‚éB

‘®«ƒŠƒXƒg錾‚ÍC‚ ‚é—v‘fŒ^‚ÆŠÖ˜A•t‚¯‚ç‚ꂽŠe‘®«‚ɑ΂µC–¼‘OCƒf[ƒ^Œ^‹y‚Ñ(‘¶Ý‚·‚ê‚Î)&default-value;‚ð‹K’è‚·‚éB ‘®«ƒŠƒXƒg錾 AttlistDecl '<!ATTLIST' S Name AttDef* S? '>' AttDef S Name S AttType S Default AttlistDecl‹K‘¥‚É‘¶Ý‚·‚éName‚ÍC—v‘fŒ^‚Ì–¼‘O‚Æ‚·‚éB&at-user-option;C錾‚µ‚Ä‚¢‚È‚¢—v‘fŒ^‚ɑ΂µ‘®«‚ð錾‚µ‚½‚È‚ç‚ÎCXML&processor;‚ÍCŒx‚ðo‚µ‚Ä‚à‚æ‚¢B‚µ‚©‚µC‚±‚ê‚Í&error;‚Æ‚Í‚µ‚È‚¢B AttDef‹K‘¥‚É‚¨‚¯‚éName‚ÍC‘®«‚Ì–¼‘O‚Æ‚·‚éB

‚ ‚é—v‘f‚ɑ΂µ‚ÄC•¡”‚ÌAttlistDecl‚ð—^‚¦‚éê‡C‚±‚ê‚ç‚·‚ׂĂ̓à—e‚̓}[ƒW‚·‚éB‚ ‚é—v‘fŒ^‚Ì“¯‚¶‘®«‚ÉC•¡”‚Ì’è‹`‚ð—^‚¦‚éꇂɂÍCʼn‚Ì錾‚ð—LŒø‚Æ‚µC‘¼‚Ì錾‚Í–³Ž‹‚·‚éB‘ŠŒÝ‰^—p«‚Ì‚½‚ß‚ÉCDTD‚Ì쬎҂ÍC‚ ‚é—v‘fŒ^‚É‚Í‚Xˆê‚‚̑®«ƒŠƒXƒg錾‚µ‚©—^‚¦‚È‚¢C‚ ‚é‘®«–¼‚É‚Í‚Xˆê‚‚̑®«’è‹`‚µ‚©—^‚¦‚È‚¢C‹y‚Ñ‚·‚ׂĂ̑®«ƒŠƒXƒg錾‚É‚Í­‚È‚­‚Æ‚àˆê‚‚̑®«’è‹`‚ð—^‚¦‚éC‚Æ‚¢‚¤‘I‘ð‚ð‚µ‚Ä‚à‚æ‚¢B‘ŠŒÝ‰^—p«‚Ì‚½‚ß‚ÉCXML&processor;‚ÍC&at-user-option;C‚ ‚é—v‘fŒ^‚É•¡”‚Ì‘®«ƒŠƒXƒg錾‚ð—^‚¦‚½‚èC‚ ‚é‘®«‚É•¡”‚Ì‘®«’è‹`‚ð—^‚¦‚½‚肵‚½‚Æ‚«‚ÉCŒx‚ðo‚µ‚Ä‚à‚æ‚¢B‚µ‚©‚µC‚±‚ê‚ÍC&error;‚Æ‚Í‚µ‚È‚¢B

‘®«‚ÌŒ^

XML‚Ì‘®«‚ÌŒ^‚ÍC‚RŽí—Þ‚Æ‚·‚éB‚±‚ê‚ç‚ÍC&string;Œ^C&token;‰»Œ^‹y‚Ñ—ñ‹“Œ^‚Æ‚·‚éB&string;Œ^‚ÍC’l‚Æ‚µ‚Ä”CˆÓ‚Ì&string;‚ð‚Æ‚éB&token;‰»Œ^‚ÍCŽŸ‚ÉŽ¦‚·Žš‹å‹y‚шӖ¡‚ÉŠÖ‚·‚é—lX‚ȧ–ñ‚ð‚à‚ÂB Attribute Types AttType StringType | TokenizedType | EnumeratedType StringType 'CDATA' TokenizedType 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'

ID

‚±‚ÌŒ^‚Ì’l‚ÍC¶¬‹K‘¥Name‚É&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢Bˆê‚‚ÌXML•¶‘“à‚Å‚ÍCˆê‚‚̖¼‘O‚ªC‚±‚ÌŒ^‚Ì’l‚Æ‚µ‚Ä•¡”‰ñŒ»‚ê‚Ä‚Í‚È‚ç‚È‚¢B‚‚܂èCID‚Ì’l‚ÍC—v‘f‚ðˆêˆÓ‚É&identify;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

1—v‘f‚²‚Æ‚É1ID

—v‘fŒ^‚ÍC•¡”‚ÌID‘®«’l‚ð‚à‚Á‚Ä‚Í‚È‚ç‚È‚¢B

ID‘®«‚Ì&default;

ID‘®«‚ÍC&default;‚Æ‚µ‚ÄC#IMPLIED–”‚Í#REQUIRED‚ð錾‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

IDREF

IDREFŒ^‚Ì’l‚ÍC¶¬‹K‘¥Name‚É&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢BIDREFSŒ^‚Ì’l‚ÍC¶¬‹K‘¥Names‚É&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢BŠeX‚ÌName‚ÍCXML•¶‘“à‚É‘¶Ý‚·‚é—v‘f‚ÌID‘®«‚Ì’l‚Æ&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚‚܂èCIDREF‚Ì’l‚ÍC‚ ‚éID‘®«‚Ì’l‚Æ&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

ŽÀ‘Ì–¼

ENTITYŒ^‚Ì’l‚ÍC¶¬‹K‘¥Name‚É&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢BENTITIESŒ^‚Ì’l‚ÍC¶¬‹K‘¥Names‚É&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢BŠeX‚ÌName‚ÍCDTD‚Å錾‚·‚é&unparsed-entity;‚Æ&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

–¼‘O&token;

NMTOKENŒ^‚Ì’l‚ÍC”ñI’[‹L†Nmtoken‚Æ&match;‚·‚é&string;‚©‚ç\¬‚³‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢BNMTOKENSŒ^‚Ì’l‚ÍC”ñI’[‹L†Nmtokens‚Æ&match;‚·‚é&string;‚©‚ç\¬‚³‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B

XML&processor;‚ÍC&application;‚É‘®«’l‚ð“n‚·‘O‚ÉC‘®«’l‚̳‹K‰»‚Å‹K’è‚·‚é‚Æ‚¨‚è‚ÉC‘®«’l‚ð³‹K‰»‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

—ñ‹“Œ^‚Ì‘®«‚ÍC錾‚µ‚½’l‚̈ê‚‚ðŽæ‚邱‚Æ‚ª‚Å‚«‚éB—ñ‹“Œ^‚É‚ÍC2Ží—Þ‚ ‚éB —ñ‹“‘®«‚ÌŒ^ EnumeratedType NotationType | Enumeration NotationType 'NOTATION' S '(' S? Name (S? '|' Name)* S? ')' Enumeration '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'

‹L–@‘®«

‚±‚ÌŒ^‚Ì’l‚ÍC錾‚µ‚Ä‚¢‚é‹L–@‚Ì–¼‘O‚̈ê‚‚Æ&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚‚܂èC錾‚É‘¶Ý‚·‚é‹L–@–¼‚ÍC‚·‚ׂÄ錾‚³‚ê‚Ä‚¢‚È‚¯‚ê‚΂Ȃç‚È‚¢B

—ñ‹“

‚±‚ÌŒ^‚Ì’l‚ÍC錾‚É‘¶Ý‚·‚éNmtoken&token;‚̈ê‚‚Æ&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

‘ŠŒÝ‰^—p«‚Ì‚½‚ßC“¯‚¶Nmtoken‚ÍC’Pˆê—v‘fŒ^‚Ì—ñ‹“Œ^‚Ì‘®«‚Æ‚µ‚ÄC•¡”‰ñŒ»‚ê‚È‚¢•û‚ª‚æ‚¢B

‘®«‚Ì&default;

‘®«éŒ¾‚ÍC‘®«‚ÌŽw’肪•K{‚©‚Ç‚¤‚©‚ɂ‚¢‚Ä‚Ìî•ñ‚ð—^‚¦‚éB•K{‚Å‚È‚¢ê‡‚É‚ÍC•¶‘“à‚Å‘®«‚ðŽw’肵‚È‚¢‚Æ‚«CXML&processor;‚̈—•û–@‚Ìî•ñ‚à—^‚¦‚éB ‘®«‚Ì&default; Default '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)

‘®«&default;‚̳‚µ‚³

錾‚µ‚½&default-value;‚ÍC錾‚µ‚½‘®«Œ^‚ÌŽš‹å§–ñ‚ð–ž‚½‚³‚È‚¯‚ê‚΂Ȃç‚È‚¢B

#REQUIRED‚ðŽw’肵‚½‚Æ‚«C‚±‚Ì—v‘fŒ^‚ÌŠJŽnƒ^ƒO‚Å‚ ‚Á‚ÄC‚±‚Ì‘®«‚É’l‚ð—^‚¦‚È‚¢‚à‚Ì‚ðXML&processor;‚ªŒ©‚‚¯‚½‚È‚ç‚ÎC‚»‚Ì•¶‘‚Í&valid;‚Æ‚Í‚µ‚È‚¢B#IMPLIED‚ðŽw’肵‚½‚Æ‚«C‚±‚Ì‘®«‚ðÈ—ª‚µ‚½‚çCXML&processor;‚ÍC‘®«’l‚ðŽw’肵‚È‚¢‚±‚Æ‚ðƒAƒvƒŠƒP[ƒVƒ‡ƒ“‚É“`‚¦‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚±‚Ì‚Æ‚«C&application;‚ÌU•‘‚¢‚ɂ‚¢‚Ă̧–ñ‚Í‚È‚¢B

‘®«‚ª#REQUIRED‚Å‚à#IMPLIED‚Å‚à‚È‚¢‚Æ‚«‚É‚ÍCAttValue‚Ì’l‚ªC&default-value;‚Æ‚È‚éB#FIXED‚Ìê‡C&default-value;‚ƈقȂé’l‚ªŽw’肳‚ê‚ê‚ÎC‚»‚Ì•¶‘‚ÍC&valid;‚Æ‚µ‚È‚¢B&default-value;‚ð錾‚µ‚Ä‚¢‚éê‡C‚±‚Ì‘®«‚ÌÈ—ª‚ðŒ©‚Â‚¯‚½‚çC錾‚µ‚½&default-value;‚ð‘®«’l‚ÉŽw’肵‚Ä‚¢‚é‚Æ‚µ‚ÄCXML&processor;‚ÍU‚é•‘‚¤‚±‚Æ‚ª–]‚Ü‚µ‚¢B

‘®«ƒŠƒXƒg錾‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <!ATTLIST termdef id ID #REQUIRED name CDATA #IMPLIED> <!ATTLIST list type (bullets|ordered|glossary) "ordered"> <!ATTLIST form method CDATA #FIXED "POST">

 ‘®«’l‚̳‹K‰»

XML&processor;‚ÍC‘®«’l‚ð&application;‚É“n‚·‘O‚ÉCŽŸ‚Ì‚Æ‚¨‚è‚ɳ‹K‰»‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

a) ‚Ü‚¸C‘®«’l‹y‚Ñ‚»‚Ì’†‚ÌŽÀ‘Ì“à‚ÅCs–––”‚Ís‹«ŠE(–”‚̓VƒXƒeƒ€‚É‚æ‚Á‚Ă̓ŒƒR[ƒh‹«ŠE)‚Æ‚µ‚ÄŽg‚í‚ê‚é&string;‚ðC&space-character;(#x20)ˆê‚‚ɒu‚«Š·‚¦‚È‚¯‚ê‚΂Ȃç‚È‚¢(us––‚̈µ‚¢v‚àŽQÆ‚Ì‚±‚ÆB)B

b) ŽŸ‚ÉC•¶ŽšŽQÆ‹y‚Ñ“à•”&parsed-entity;‚Ö‚ÌŽQÆ‚ÍC“WŠJ‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢BŠO•”ŽÀ‘Ì‚Ö‚ÌŽQÆ‚ÍC&error;‚Æ‚·‚éB

c) ÅŒã‚ÉC‘®«‚ÌŒ^‚ªCDATA‚Å‚È‚¯‚ê‚ÎC‹ó”’&string;‚ÍC‚·‚ׂÄ&space-character;(#x20)ˆê‚‚ɳ‹K‰»‚µCŽc‚è‚Ì‹ó”’•¶Žš‚ÍC휂µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

&non-validating;&parser;‚ÍC錾‚ªŒ©‚‚©‚ç‚È‚¢‘®«‚ÍC‚·‚ׂÄCCDATA‚ð錾‚µ‚Ä‚¢‚é‚Æ‚µ‚Ĉµ‚¤‚±‚Æ‚ª–]‚Ü‚µ‚¢B

 ðŒ•t‚«ƒZƒNƒVƒ‡ƒ“

ðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚Æ‚ÍC•¶‘Œ^錾‚ÌŠO•”⊂‚̈ꕔ‚Æ‚µC§ŒäƒL[ƒ[ƒh‚ÌŽw’è‚É‚æ‚Á‚ÄCDTD‚̘_—\‘¢‚ÉŠÜ‚ß‚½‚èCœ‚¢‚½‚è‚·‚é•”•ª‚Æ‚·‚éB ðŒ•t‚«ƒZƒNƒVƒ‡ƒ“ conditionalSect includeSect | ignoreSect includeSect '<![' S? 'INCLUDE' S? '[' extSubset ']]>' ignoreSect '<![' S? 'IGNORE' S? '[' ignoreSectContents* ']]>' ignoreSectContents Ignore ('<![' ignoreSectContents ']]>' Ignore)* Ignore Char* - (Char* ('<![' | ']]>') Char*)

ðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚ÍCDTD‚Ì“à•”⊂‹y‚ÑŠO•”⊂‚Æ“¯—l‚ÉCŠ®‘S‚È錾CƒRƒƒ“ƒg–”‚Í“ü‚êŽq‚É‚È‚Á‚½ðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚ðC‚¢‚­‚‚©ŠÜ‚ñ‚Å‚æ‚¢B‚±‚ê‚ç‚ÌŠÔ‚ÉC‹ó”’‚ªŒ»‚ê‚Ä‚à‚æ‚¢B

ðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚̃L[ƒ[ƒh‚ªINCLUDE‚È‚ç‚ÎCXML&processor;‚ÍC‚±‚ÌðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚Ì“à—e‚ðC•¶‘‚̈ꕔ‚Æ‚µ‚Ĉµ‚í‚È‚¯‚ê‚΂Ȃç‚È‚¢BðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚̃L[ƒ[ƒh‚ªIGNORE‚È‚ç‚ÎC‚»‚ÌðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚Ì“à—e‚ÍC•¶‘‚̈ꕔ‚Æ‚µ‚Ĉµ‚í‚È‚¢B\•¶‰ð͂𳂵‚­s‚¤‚½‚ß‚É‚ÍC–³Ž‹‚·‚éðŒ•t‚«ƒZƒNƒVƒ‡ƒ“(IGNORE)‚ÉŠÖ‚µ‚Ä‚àC“à—e‚ð“Ç‚Ü‚È‚¯‚ê‚΂Ȃç‚È‚¢‚±‚Æ‚É’ˆÓ‚·‚邱‚ÆB‚±‚ê‚ÍC“ü‚êŽq‚É‚È‚Á‚½ðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚ðŒ©‚Â‚¯C(–³Ž‹‚·‚é)Å‚àŠO‘¤‚ÌðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚𳂵‚­ŒŸo‚·‚邽‚ß‚Æ‚·‚éBƒL[ƒ[ƒh‚ðINCLUDE‚Æ‚·‚鬂³‚ÈðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚ªCƒL[ƒ[ƒh‚ðIGNORE‚Æ‚·‚é‚æ‚è‘å‚«‚ÈðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚ÉŠÜ‚Ü‚ê‚é‚È‚ç‚ÎCŠO‘¤‹y‚Ñ“à‘¤‚ÌðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚Ì—¼•û‚Æ‚à–³Ž‹‚·‚éB

ðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚̃L[ƒ[ƒh‚ªƒpƒ‰ƒƒ^ŽÀ‘ÌŽQÆ‚È‚ç‚ÎCXML&processor;‚ÍðŒ•t‚«ƒZƒNƒVƒ‡ƒ“‚̈µ‚¢‚ð”»’f‚·‚é‘O‚ÉC‚±‚̃pƒ‰ƒƒ^ŽÀ‘Ì‚ð“WŠJ‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

—á‚ðŽŸ‚ÉŽ¦‚·B <!ENTITY % draft 'INCLUDE' > <!ENTITY % final 'IGNORE' > <![%draft;[ <!ELEMENT book (comments*, title, body, supplements?)> ]]> <![%final;[ <!ELEMENT book (title, body, supplements?)> ]]>

•¨—\‘¢

XML•¶‘‚ÍCˆê‚ˆÈã‚Ì‹L‰¯’PˆÊ‚©‚ç\¬‚·‚éB‚±‚Ì‹L‰¯’PˆÊ‚ðCŽÀ‘Ì‚Æ‚¢‚¤BŽÀ‘Ì‚ÍC“à—e‚ð‚à‚¿C•¶‘ŽÀ‘Ì(ˆÈ~ŽQÆ)‹y‚ÑŠO•”DTD⊂‚𜂢‚ÄC–¼‘O‚Å&identified;B ŠeXML•¶‘‚ÍC•¶‘ŽÀ‘̂ƌĂԎÀ‘Ì‚ðˆê‚‚à‚ÂBXML&processor;‚ÍC‚±‚Ì•¶‘ŽÀ‘Ì‚©‚爗‚ðŠJŽn‚·‚éB•¶‘ŽÀ‘Ì‚ªC•¶‘‚Ì‚·‚ׂĂðŠÜ‚ñ‚Å‚à‚æ‚¢B

ŽÀ‘Ì‚ÍC&parsed-entity;–”‚Í&unparsed-entity;‚Æ‚·‚éB&parsed-entity;‚Ì“à—e‚ÍC&parsed-entity;‚Ì&replacement-text;‚ƌĂÔB‚±‚̃eƒLƒXƒg‚ÍC•¶‘‚Ì–{‘̂̈ꕔ‚Æ‚µ‚ĉðŽß‚·‚éB

&unparsed-entity;‚ÍC“à—e‚ªƒeƒLƒXƒg‚Å‚à‚»‚¤‚Å‚È‚­‚Æ‚à‚æ‚¢ƒŠƒ\[ƒX‚Æ‚·‚éBƒeƒLƒXƒg‚Ìê‡CXML‚Å‚È‚­‚Æ‚à‚æ‚¢BŠe&unparsed-entity;‚É‚ÍC‹L–@‚ªŠÖ˜A•t‚¯‚ç‚êC‚±‚Ì‹L–@‚ÍC–¼‘O‚Å&identified;B‹L–@‚Ì–¼‘O‹y‚ÑŠÖ˜A•t‚¯‚ç‚ꂽ&identifier;‚ðCXML&processor;‚ª&application;‚É“n‚·‚Æ‚¢‚¤—vŒˆÈŠO‚ÍCXML‚ÍC&unparsed-entity;‚Ì“à—e‚ð§ŒÀ‚µ‚È‚¢B

&parsed-entity;‚ÍCŽÀ‘ÌŽQÆ‚É‚æ‚Á‚Ä–¼‘O‚ŌĂÑo‚·B&unparsed-entity;‚ÍCENTITYŒ^–”‚ÍENTITIESŒ^‚Ì‘®«‚Ì’l‚Æ‚µ‚ÄC–¼‘O‚ÅŽQÆ‚·‚éB

ˆê”ÊŽÀ‘Ì‚ÍC•¶‘“à—e‚Ì’†‚ÅŽg—p‚·‚é&parsed-entity;‚Æ‚·‚éB‚ ‚¢‚Ü‚¢‚É‚È‚ç‚È‚¢ŒÀ‚èC‚±‚Ì&TR-or-Rec;‚Å‚ÍCˆê”ÊŽÀ‘Ì‚ð’P‚ÉŽÀ‘̂ƌĂÔBƒpƒ‰ƒƒ^ŽÀ‘Ì‚ÍCDTD“à‚ÅŽg—p‚·‚é&parsed-entity;‚Æ‚·‚éB‚±‚ê‚ç‚Ì‚QŽí—Þ‚ÌŽÀ‘Ì‚ÍCˆÙ‚È‚é‘Ž®‚ÅŽQÆ‚µCˆÙ‚Ȃ镶–¬‚Å”FŽ¯‚·‚éB

•¶ŽšŽQÆ‹y‚ÑŽÀ‘ÌŽQÆ

•¶ŽšŽQÆ‚ÍCISO/IEC 10646•¶ŽšW‡‚Ì“Á’è‚Ì•¶ŽšC—Ⴆ‚ÎC“ü—Í‹@Ší‚©‚ç’¼Ú“ü—Í•s‰Â”\‚È•¶Žš‚ðŽQÆ‚·‚éB •¶ŽšŽQÆ CharRef '&#' [0-9]+ ';' | '&hcro;' [0-9a-fA-F]+ ';' ³“–‚È•¶Žš

•¶ŽšŽQÆ‚ÅŽQÆ‚·‚镶Žš‚ÍC”ñI’[‹L†Char‚É]‚í‚È‚¯‚ê‚΂Ȃç‚È‚¢B

•¶Žš‚ª "&#x" ‚ÅŽn‚Ü‚ê‚ÎCI’[‚Ì ";" ‚Ü‚Å‚Ì”Žš‹y‚уAƒ‹ƒtƒ@ƒxƒbƒg‚ÍCISO/IEC 10646 ‚Ì•¶ŽšƒR[ƒh‚Ì16i”•\Œ»‚Æ‚·‚éB •¶Žš‚ª "&#" ‚ÅŽn‚Ü‚ê‚ÎCI’[‚Ì ";" ‚Ü‚Å‚Ì”Žš‚ÍC•¶ŽšƒR[ƒh‚Ì10i”•\Œ»‚Æ‚·‚éB

ŽÀ‘ÌŽQÆ‚ÍC–¼‘O‚Ì•t‚¢‚½ŽÀ‘Ì‚Ì“à—e‚ðŽQÆ‚·‚éBˆê”ÊŽÀ‘Ì‚Ö‚ÌŽQÆ‚ÍCƒAƒ“ƒpƒTƒ“ƒh(&)‹y‚уZƒ~ƒRƒƒ“(;)‚ð‹æØ‚èŽq‚Æ‚µ‚Ä—p‚¢‚éBƒpƒ‰ƒƒ^ŽÀ‘Ì‚Ö‚ÌŽQÆ‚ÍCƒp[ƒZƒ“ƒg‹L†(%)‹y‚уZƒ~ƒRƒƒ“(;)‚ð‹æØ‚èŽq‚Æ‚µ‚Ä—p‚¢‚éB

ŽÀ‘ÌŽQÆ Reference EntityRef | CharRef EntityRef '&' Name ';' PEReference '%' Name ';' ŽÀ‘Ì‚ªéŒ¾‚³‚ê‚Ä‚¢‚邱‚Æ

DTD‚ð‚à‚½‚È‚¢•¶‘Cƒpƒ‰ƒƒ^ŽÀ‘ÌŽQÆ‚ðŠÜ‚Ü‚È‚¢“à•”DTD⊂‚¾‚¯‚ð‚à‚•¶‘C–”‚Í "standalone='yes'" ‚ð‚à‚•¶‘‚É‚¨‚¢‚ÄCŽÀ‘ÌŽQÆ‚Å—p‚¢‚é Name ‚ÍC‚»‚ÌŽÀ‘Ì‚Ì錾‚Å—^‚¦‚é–¼‘O‚ÆC&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚½‚¾‚µC&well-formed;‚Ì•¶‘‚ÍCŽÀ‘Ì&magicents; ‚ð錾‚·‚é•K—v‚Í‚È‚¢Bƒpƒ‰ƒƒ^ŽÀ‘Ì‚ÌꇂÍC錾‚ÍCŽQÆ‚Éæs‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B“¯—l‚ÉCˆê”ÊŽÀ‘Ì‚ÌꇂÍC‘®«ƒŠƒXƒg錾‚Ì&default-value;“à‚Å‚ÌŽQÆ‚æ‚èæ‚ÉC錾‚ªŒ»‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B

ŠO•”⊂–”‚ÍŠO•”ƒpƒ‰ƒƒ^ŽÀ‘Ì‚ÅŽÀ‘Ì‚ð錾‚·‚é‚Æ‚«C&non-validating;&processor;‚ªC錾‚ð“Ç‚ÝCˆ—‚·‚邱‚Æ‚ð‹`–±‚¯‚È‚¢B‚»‚ê‚ç‚Ì•¶‘‚Å‚ÍCŽÀ‘Ì‚Í錾‚³‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢‚Æ‚¢‚¤‹K‘¥‚ÍC&well-formed;§–ñ‚Å‚Í‚È‚¢B

ŽÀ‘Ì‚ªéŒ¾‚³‚ê‚Ä‚¢‚邱‚Æ

ŠO•”⊂–”‚ÍŠO•”ƒpƒ‰ƒƒ^ŽÀ‘Ì‚ð‚à‚Á‚Ä‚¢‚ÄC"standalone='no'"‚ð‚à‚•¶‘‚É‚¨‚¢‚ÄCŽÀ‘ÌŽQÆ‚Å—p‚¢‚é Name ‚ÍC‚»‚ÌŽÀ‘Ì‚Ì錾‚Å—^‚¦‚é–¼‘O‚Æ&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‘ŠŒÝ‰^—p«‚Ì‚½‚ßC&valid;‚È•¶‘‚Í‚ ‚ç‚©‚¶‚ß’è‹`‚µ‚½ŽÀ‘Ì‚Ì‹K’è‚ÅŽw’肵‚½‘Ž®‚É‚æ‚Á‚ÄCŽÀ‘Ì &magicents;‚ð錾‚·‚邱‚Æ‚ª–]‚Ü‚µ‚¢Bƒpƒ‰ƒƒ^ŽÀ‘Ì‚ÌꇂÍC錾‚ÍCŽQÆ‚Éæs‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B“¯—l‚ÉCˆê”ÊŽÀ‘Ì‚ÌꇂÍC‘®«ƒŠƒXƒg錾‚Ì&default-value;“à‚Å‚ÌŽQÆ‚æ‚è‚àæ‚ÉC錾‚ªŒ»‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B

&parsed-entity;

ŽÀ‘ÌŽQÆ‚ÍC&unparsed-entity;‚Ì–¼‘O‚ðŠÜ‚ñ‚Å‚¢‚Ä‚Í‚È‚ç‚È‚¢B&unparsed-entity;‚ÍCENTITYŒ^–”‚ÍENTITIES Œ^‚Æ‚µ‚Ä錾‚µ‚½‘®«’l‚Æ‚µ‚Ä‚¾‚¯ŽQÆ‚Å‚«‚éB

Ä‹A‚È‚µ

&parsed-entity;‚ÍC‚»‚ꎩ‘Ì‚Ö‚ÌŽQÆ‚ðC’¼Ú‚É‚àŠÔÚ‚É‚àŠÜ‚ñ‚Å‚Í‚È‚ç‚È‚¢B

 DTD‚Ì’†

ƒpƒ‰ƒƒ^ŽÀ‘ÌŽQÆ‚ÍCDTD“à‚É‚¾‚¯CoŒ»‚µ‚Ä‚æ‚¢B

•¶ŽšŽQÆ‹y‚ÑŽÀ‘ÌŽQÆ‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B Type <key>less-than</key> (&hcro;3C;) to save options. This document was prepared on &docdate; and is classified &security-level;.

ƒpƒ‰ƒƒ^ŽÀ‘ÌŽQÆ‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <!ENTITY % ISOLat2 SYSTEM "http://www.xml.com/iso/isolat2-xml.entities" > %ISOLat2;

ŽÀ‘Ì錾

ŽÀ‘Ì‚ÍCŽŸ‚Ì‚Æ‚¨‚è‚É錾‚·‚éB ŽÀ‘Ì錾 EntityDecl GEDeclˆê”ÊŽÀ‘Ì | PEDeclƒpƒ‰ƒƒ^ŽÀ‘Ì GEDecl '<!ENTITY' S Name S EntityDef S? '>' PEDecl | '<!ENTITY' S '%' S Name S PEDef S? '>' ƒpƒ‰ƒƒ^ŽÀ‘Ì EntityDef EntityValue | ExternalDef PEDef EntityValue | ExternalID Name ‚ÍCŽÀ‘ÌŽQÆ‚É‚¨‚¢‚ÄŽÀ‘Ì‚ð&identify;B&unparsed-entity;‚È‚ç‚ÎCENTITY Œ^–”‚ÍENTITIESŒ^‚Ì‘®«’l“à‚ÅCŽÀ‘Ì‚ð&identify;B“¯ˆê‚ÌŽÀ‘Ì‚ªˆê‰ñˆÈã錾‚³‚ê‚ê‚ÎCʼn‚Ì錾‚ð—p‚¢‚éB&at-user-option;C•¡”‰ñ錾‚³‚ê‚éŽÀ‘Ì‚ÉŠÖ‚µCXML&processor;‚ÍCŒx‚ðo‚µ‚Ä‚à‚æ‚¢B

“à•”ŽÀ‘Ì

ŽÀ‘Ì‚Ì’è‹`‚ª EntityValue‚Ì‚Æ‚«C‚±‚ê‚ð“à•”ŽÀ‘Ì‚Æ‚¢‚¤B‚±‚ê‚ÍC•ÊŒÂ‚Ì•¨—“I‹L‰¯’PˆÊ‚ð‚à‚½‚¸CŽÀ‘Ì‚Ì“à—e‚ÍC錾“à‚Å—^‚¦‚éB³‚µ‚­&replacement-text;‚𶬂·‚é‚É‚ÍC&literal;ŽÀ‘Ì’l“à‚Å‚ÌŽÀ‘ÌŽQÆ‹y‚Ñ•¶ŽšŽQƂ̈—‚ªC•K—v‚Æ‚È‚é‚©‚à‚µ‚ê‚È‚¢‚±‚Æ‚É’ˆÓ‚·‚éBÚׂÍC“à•”ŽÀ‘Ì‚Ì&replacement-text;‚Ì\’z‚ðŽQÆB

“à•”ŽÀ‘Ì‚ÍC&parsed-entity;‚Æ‚·‚éB

“à•”ŽÀ‘Ì錾‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <!ENTITY Pub-Status "This is a pre-release of the specification.">

 ŠO•”ŽÀ‘Ì

ŽÀ‘Ì‚ª“à•”ŽÀ‘Ì‚Å‚È‚¯‚ê‚ÎCŠO•”ŽÀ‘Ì‚Æ‚µCŽŸ‚Ì‚Æ‚¨‚è‚É錾‚·‚éB ŠO•”ŽÀ‘Ì錾 ExternalDef ExternalID NDataDecl? ExternalID 'SYSTEM' S SystemLiteral | 'PUBLIC' S PubidLiteral S SystemLiteral NDataDecl S 'NDATA' S Name NDataDecl ‚ª‘¶Ý‚·‚ê‚ÎC‚±‚ÌŽÀ‘Ì‚ÍC&unparsed-entity;‚Æ‚µC‚»‚¤‚Å‚È‚¯‚ê‚ÎC&parsed-entity;‚Æ‚·‚éB

‹L–@‚ªéŒ¾‚³‚ê‚Ä‚¢‚邱‚Æ

Name ‚ÍC錾‚µ‚½‹L–@‚Ì–¼‘O‚Æ&match;‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

ƒL[ƒ[ƒh SYSTEM ‚ÌŒã‚Ì SystemLiteral ‚ðCŽÀ‘̂̃VƒXƒeƒ€&identifier;‚ƌĂÔB‚±‚ê‚ÍURI‚Æ‚µC‚»‚ÌŽÀ‘Ì‚Ì“à—e‚ðŽæ‚èo‚·‚Ì‚É—p‚¢‚Ä‚à‚æ‚¢BURI‚Æ‹¤‚ÉŽg‚¤‚±‚Æ‚Ì‘½‚¢ƒnƒbƒVƒ…("#")‹y‚уtƒ‰ƒOƒƒ“ƒg&identifier;‚ÍC³Ž®‚É‚ÍCURIŽ©‘̂̈ꕔ‚Æ‚Í‚µ‚È‚¢Bƒtƒ‰ƒOƒƒ“ƒg&identifier;‚ªCƒVƒXƒeƒ€&identifier;‚Ì•”•ª‚Æ‚µ‚Ä—^‚¦‚ç‚ê‚Ä‚¢‚éê‡CXML&processor;‚ÍC&error;‚ðo‚µ‚Ä‚à‚æ‚¢B‚±‚Ì&TR-or-Rec;‚͈̔͊O‚Ìî•ñ(—Ⴆ‚ÎC‚ ‚é“Á’è‚ÌDTD‚Ì“Á•Ê‚ÈXML—v‘f–”‚Í“Á’è‚Ì&application;‚ÌŽd—l‚É‚æ‚Á‚Ä’è‹`‚³‚ꂽˆ—–½—ß)‚É‚æ‚Á‚Äã‘‚«‚³‚ê‚È‚¢ŒÀ‚èC‘Š‘ΓI‚ÈURI‚ÍC‚»‚ÌŽÀ‘̂̈ʒuC‚·‚È‚í‚¿C‚»‚ÌŽÀ‘Ì‚Ì錾‚ª‚ ‚éƒtƒ@ƒCƒ‹‚É‘Š‘ΓI‚Æ‚·‚éB‚µ‚½‚ª‚Á‚ÄCDTD‚Ì“à•”⊂‚É‚ ‚éŽÀ‘Ì錾‚Å‚Ì‘Š‘ΓI‚ÈURI‚ÍC•¶‘‚̈ʒu‚ɂ‚¢‚Ä‘Š‘ΓI‚Æ‚·‚éBŠO•”⊂‚É‚ ‚éŽÀ‘Ì錾‚Å‚Ì‘Š‘ΓI‚ÈURI‚ÍC‚»‚ÌŠO•”⊂‚ðŠÜ‚Þƒtƒ@ƒCƒ‹‚̈ʒu‚É‘Š‘ΓI‚Æ‚·‚éB

ƒVƒXƒeƒ€&identifier;ˆÈŠO‚ÉCŠO•”ŽÀ‘Ì‚ÍCŒöŠJ&identifier;‚ðŠÜ‚ñ‚Å‚à‚æ‚¢B ŽÀ‘Ì‚Ì“à—e‚ðŽæ‚èo‚·XML&processor;‚ÍC‚±‚ÌŒöŠJ&identifier;‚ð—p‚¢‚ÄC‘ã‚í‚è‚ÌURI‚̶¬‚ðŽŽ‚Ý‚Ä‚à‚æ‚¢BXML&processor;‚ª‚±‚ê‚ÉŽ¸”s‚µ‚½ê‡‚ÍCƒVƒXƒeƒ€&literal;‚Æ‚µ‚ÄŽw’肵‚½URI‚ð—p‚¢‚È‚¯‚ê‚΂Ȃç‚È‚¢B&match;‚·‚é‘O‚ÉCŒöŠJ&identifier;“à‚É‚ ‚é‹ó”’•¶Žš‚©‚ç‚È‚é&string;‚ÍC‚·‚ׂĒPˆê‚Ì&space-character;(#x20)‚ɳ‹K‰»‚µ‚È‚¯‚ê‚΂Ȃ炸C‘OŒã‚Ì‹ó”’•¶Žš‚Í휂µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

ŠO•”ŽÀ‘Ì錾‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <!ENTITY open-hatch SYSTEM "http://www.textuality.com/boilerplate/OpenHatch.xml"> <!ENTITY open-hatch PUBLIC "-//Textuality//TEXT Standard open-hatch boilerplate//EN" "http://www.textuality.com/boilerplate/OpenHatch.xml"> <!ENTITY hatch-pic SYSTEM "../grafix/OpenHatch.gif" NDATA gif >

 &parsed-entity; ƒeƒLƒXƒg錾

ŠO•”&parsed-entity;‚ÍCƒeƒLƒXƒg錾‚ÅŽn‚Ü‚Á‚Ä‚à‚æ‚¢B ƒeƒLƒXƒg錾 TextDecl &xmlpio; VersionInfo? EncodingDecl S? &pic;

ƒeƒLƒXƒg錾‚ÍC‚»‚Ì‚Ü‚Ü‚ÌŒ`‚ÅŒ»‚ê‚È‚¯‚ê‚΂Ȃ炸C&parsed-entity;‚Ö‚ÌŽQÆ‚ðŒo—R‚µ‚Ä‚Í‚È‚ç‚È‚¢‚±‚Æ‚É’ˆÓ‚·‚éB

ŠO•”&parsed-entity;‚É‚¨‚¢‚ÄCƒeƒLƒXƒg錾‚ÍC擪ˆÈŠO‚Ì‚¢‚©‚È‚éˆÊ’u‚É‚àoŒ»‚µ‚È‚¢B

 &well-formed;‚Ì&parsed-entity;

ƒ‰ƒxƒ‹document‚ð‚à‚¶¬‹K‘¥‚É&match;‚·‚ê‚ÎC•¶‘ŽÀ‘Ì‚ÍC&well-formed;‚Æ‚·‚éBƒ‰ƒxƒ‹ExtParsedEnt‚ð‚à‚¶¬‹K‘¥‚É&match;‚·‚ê‚ÎCŠO•”‚̈ê”Ê&parsed-entity;‚ÍC&well-formed;‚Æ‚·‚éBƒ‰ƒxƒ‹ExtPE‚ð‚à‚¶¬‹K‘¥‚É&match;‚·‚ê‚ÎCŠO•”ƒpƒ‰ƒƒ^ŽÀ‘Ì‚ÍC&well-formed;‚Æ‚·‚éB &well-formed;‚Ì&parsed-entity; ExtParsedEnt TextDecl? content ExtPE TextDecl? extSubset &replacement-text;‚ªCƒ‰ƒxƒ‹content‚ð‚à‚¶¬‹K‘¥‚É&match;‚·‚ê‚ÎC“à•”‚̈ê”Ê&parsed-entity;‚ÍC&well-formed;‚Æ‚·‚éBDTD‚ðÅŒã‚Ü‚Å“Ç‚Ýž‚Ü‚È‚¢‚ÆCŠmŽÀ‚É‚±‚ê‚ð”»’è‚Å‚«‚È‚¢‚±‚Æ‚É’ˆÓB‚·‚×‚Ä‚Ì“à•”‚̃pƒ‰ƒƒ^ŽÀ‘Ì‚ÍC’è‹`‚É‚æ‚Á‚Ä&well-formed;‚Æ‚·‚éB

ŽÀ‘Ì‚ª&well-formed;‚ÈŒ‹‰Ê‚Æ‚µ‚ÄCXML•¶‘‚̘_—“I‹y‚Ñ•¨—“I\‘¢‚ÍC³‚µ‚­“ü‚êŽq‚Æ‚È‚éBŠJŽnƒ^ƒOCI—¹ƒ^ƒOC‹ó—v‘fƒ^ƒOC—v‘fCƒRƒƒ“ƒgCˆ—–½—ßC•¶ŽšŽQÆ‹y‚ÑŽÀ‘ÌŽQÆ‚ªCˆê‚‚̎À‘Ì‚ÅŠJŽn‚µC•Ê‚ÌŽÀ‘Ì‚ÅI—¹‚·‚邱‚Æ‚Í‚È‚¢B

 ŽÀ‘Ì‚É‚¨‚¯‚镶Žš•„†‰»

XML•¶‘“à‚ÌŠO•”&parsed-entity;‚ÍCŠeXC•Ê‚Ì•¶Žš•„†‰»•ûŽ®‚ð—p‚¢‚Ä‚à‚æ‚¢B‚·‚ׂĂÌXML&processor;‚ÍCUTF-8‚Å•„†‰»‚µ‚½ŽÀ‘ÌCUTF-16‚Å•„†‰»‚µ‚½ŽÀ‘Ì‚ðˆ—‚Å‚«‚È‚¯‚ê‚΂Ȃç‚È‚¢B

UTF-16‚Å•„†‰»‚µ‚½ŽÀ‘Ì‚ÍCISO/IEC 10646‚Ì•t˜^E‹y‚ÑUnicode‚Ì•t˜^B‚Å‹K’è‚·‚é&byte-order-mark;(ZERO WIDTH NO-BREAK SPACE•¶ŽšC#xFEFF)‚ÅŽn‚Ü‚ç‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚±‚ê‚ÍC•„†‰»‚Ì•WŽ¯‚Å‚ ‚Á‚ÄCXML•¶‘‚Ì&markup;‚̈ꕔ‚Å‚àC•¶Žšƒf[ƒ^‚̈ꕔ‚Å‚à‚È‚¢BXML&processor;‚ÍCUTF-8‚Å•„†‰»‚µ‚½•¶‘‚ÆUTF-16‚Å•„†‰»‚µ‚½•¶‘‚Æ‚Ì‹æ•Ê‚ðs‚¤‚½‚ß‚ÉC‚±‚Ì•¶Žš‚ðŽg—p‰Â”\‚Å‚È‚¯‚ê‚΂Ȃç‚È‚¢B

XML&processor;‚ÍCUTF-8‹y‚ÑUTF-16‚Å•„†‰»‚µ‚½ŽÀ‘Ì‚¾‚¯‚ð“Ç‚Þ‚±‚Æ‚ð•K{‚Æ‚·‚邪C‘¼‚Ì•„†‰»‚ð¢ŠE‚Å‚Í—p‚¢‚Ä‚¨‚èC‚»‚ê‚ç‚Ì•„†‰»‚ð—p‚¢‚éŽÀ‘Ì‚ðXML&processor;‚ªˆ—‚Å‚«‚邱‚Æ‚ª–]‚Ü‚µ‚¢BUTF-8–”‚ÍUTF-16ˆÈŠO‚Ì•„†‰»•ûŽ®‚ð—p‚¢‚ÄŠi”[‚·‚é&parsed-entity;‚ÍC•„†‰»éŒ¾‚ðŠÜ‚ÞƒeƒLƒXƒg錾‚ÅŽn‚ß‚È‚¯‚ê‚΂Ȃç‚È‚¢B •„†‰»éŒ¾ EncodingDecl S 'encoding' Eq '"' EncName '"' | "'" EncName "'" EncName [A-Za-z] ([A-Za-z0-9._] | '-')* ƒ‰ƒeƒ“•¶Žš‚¾‚¯‚ðŠÜ‚Þ•„†‰»–¼ •¶‘ŽÀ‘Ì‚Å‚ÍC•„†‰»éŒ¾‚ÍCXML錾‚̈ꕔ‚Æ‚·‚éBEncName‚ÍCŽg—p‚·‚é•„†‰»•ûŽ®‚Ì–¼‘O‚Æ‚·‚éB

•„†‰»éŒ¾‚Å‚ÍC’lUTF-8CUTF-16CISO-10646-UCS-2‹y‚ÑISO-10646-UCS-4‚ÍCUnicode‹y‚ÑISO/IEC 10646‚ÌŠeŽí•„†‰»‚Ì‚½‚ß‚É—p‚¢‚éB’lISO-8859-1‚©‚çISO-8859-9‚Ü‚Å‚ÍCISO 8859‚̑Ήž‚·‚éƒp[ƒg‚Ì‚½‚ß‚É—p‚¢‚éB’lISO-2022-JPCShift_JIS‹y‚ÑEUC-JP‚ÍCJIS X-0208-1997‚ÌŠeŽí•„†‰»‚Ì‚½‚ß‚É—p‚¢‚éBXML&processor;‚ÍC‚»‚êˆÈŠO‚Ì•„†‰»•ûŽ®‚ð”FŽ¯‚µ‚Ä‚à‚æ‚¢BInternet Assigned Numbers Authority (IANA)‚ÉC(charsets‚Æ‚µ‚Ä)“o˜^‚³‚ꂽ•¶Žš•„†‰»•ûŽ®‚ɂ‚¢‚Ä‚ÍC‚±‚ê‚çˆÈŠO‚ɂ‚¢‚Ä‚àC“o˜^‚³‚ꂽ–¼‘O‚ÅŽQÆ‚·‚邱‚Æ‚ª–]‚Ü‚µ‚¢B‚±‚ê‚ç‚Ì“o˜^‚³‚ꂽ–¼‘O‚ÍC‘啶ŽšE¬•¶Žš‚Ì‹æ•Ê‚ð‚¹‚¸‚É’è‹`‚³‚ê‚Ä‚¢‚é‚Ì‚ÅC‚±‚ê‚ç‚ɑ΂·‚é”äŠr‚ðŽŽ‚Ý‚é&processor;‚ÍC‘啶ŽšE¬•¶Žš‚Ì‹æ•Ê‚ð‚µ‚È‚¢•û–@‚ð‚Æ‚é‚Ì‚ª–]‚Ü‚µ‚¢‚±‚Æ‚É’ˆÓ‚·‚éB

XMLˆ—Œn‚É“n‚³‚ꂽŽÀ‘Ì‚ªC•„†‰»éŒ¾‚ðŠÜ‚Þ‚É‚à‚©‚©‚í‚炸C錾‚ÅŽ¦‚µ‚½‚à‚̈ȊO‚Ì•ûŽ®‚Å•„†‰»‚³‚ê‚Ä‚¢‚½‚èC•„†‰»éŒ¾‚ªCŠO•”ŽÀ‘Ì‚ÌʼnˆÈŠO‚̈ʒu‚ÉoŒ»‚·‚ê‚ÎC&error;‚Æ‚·‚éB

&byte-order-mark;‚Å‚à•„†‰»éŒ¾‚Å‚àŽn‚Ü‚ç‚È‚¢ŽÀ‘Ì‚ÍCUTF-8•„†‰»‚Å‚È‚¯‚ê‚΂Ȃç‚È‚¢B

ˆ—‚Å‚«‚È‚¢•„†‰»‚ð‚à‚Á‚½ŽÀ‘Ì‚ðXML&processor;‚ª”­Œ©‚µ‚½‚Æ‚«‚ÍC&application;‚É‚»‚ÌŽ–ŽÀ‚ð’Ê’m‚µC&fatal-error;‚Æ‚µ‚ÄCˆ—‚ðI—¹‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

•„†‰»éŒ¾‚Ì—á‚ðCŽŸ‚ÉŽ¦‚·B <?xml encoding='UTF-8'?> <?xml encoding='EUC-JP'?>

 XML&processor;‚É‚æ‚éŽÀ‘Ì‹y‚ÑŽQƂ̈µ‚¢

ŽŸ‚Ì•\‚ÍC•¶ŽšŽQÆCŽÀ‘ÌŽQÆ‹y‚Ñ&unparsed-entity;‚ÌŒÄo‚µ‚ªŒ»‚ê‚镶–¬‹y‚ÑŠeX‚Ìꇂɂ¨‚¯‚éXML&processor;‚É—v‹‚·‚éU•‘‚¢‚ð—v–ñ‚·‚éBˆê”Ô¶‚Ì—ñ‚̃‰ƒxƒ‹‚ÍC”FŽ¯‚Ì•¶–¬‚ðŽ¦‚·B

—v‘f‚ÌŠJŽnƒ^ƒO‹y‚ÑI—¹ƒ^ƒO‚ÌŠÔ‚Ì”CˆÓ‚Ìꊂł̎QÆB”ñI’[‹L†content‚ɑΉž‚·‚éB

ŠJŽnƒ^ƒO‚Ì‘®«‚Ì’lC–”‚Í‘®«éŒ¾‚É‚¨‚¯‚é&default-value;‚Ì‚¢‚¸‚ê‚©‚Å‚ÌŽQÆB”ñI’[‹L†AttValue‚ɑΉž‚·‚éB

ŽQÆ‚Å‚Í‚È‚­CName‚Æ‚µ‚ÄoŒ»BENTITYŒ^‚Æ‚µ‚Ä錾‚µ‚½‘®«‚Ì’lC–”‚ÍENTITIESŒ^‚Æ‚µ‚Ä錾‚µ‚½‘®«‚Ì’l‚É‚¨‚¯‚é&space;‚Å‹æØ‚é&token;‚̈ê‚‚Ƃµ‚ÄoŒ»‚·‚éB

ŽÀ‘Ì‚Ì錾‚É‚¨‚¯‚éCƒpƒ‰ƒƒ^–”‚Í“à•”ŽÀ‘Ì‚Ì&literal;ŽÀ‘Ì’l“à‚ÌŽQÆB”ñI’[‹L†EntityValue‚ɑΉž‚·‚éB

DTD‚Ì“à•”⊂–”‚ÍŠO•”⊂‚Å‚ÌŽQÆB‚½‚¾‚µCEntityValue–”‚ÍAttValue‚ÌŠO‘¤‚Æ‚·‚éB

ŽÀ‘Ì‚ÌŒ^ •¶Žš ƒpƒ‰ƒƒ^ “à•”&newline;ˆê”Ê ŠO•”&newline;&parsed-entity;&newline;ˆê”Ê &unparsed-entity; “à—e‚Å‚Ì&newline;ŽQÆ ”FŽ¯&newline;‚µ‚È‚¢ Žæž‚Ý ŒŸØ‚Ì‚½‚ß‚ÉŽæž‚Ý ‹ÖŽ~ Žæž‚Ý ‘®«’l‚Å‚Ì&newline;ŽQÆ ”FŽ¯&newline;‚µ‚È‚¢ Žæž‚Ý ‹ÖŽ~ ‹ÖŽ~ Žæž‚Ý ‘®«’l‚Æ‚µ‚Ä&newline;oŒ» ”FŽ¯&newline;‚µ‚È‚¢ ‹ÖŽ~ ‹ÖŽ~ ’Ê’m ”FŽ¯&newline;‚µ‚È‚¢ ŽÀ‘Ì’l‚Å‚Ì&newline;ŽQÆ Žæž‚Ý &bypass; &bypass; ‹ÖŽ~ Žæž‚Ý DTD‚Å‚Ì&newline;ŽQÆ PE‚Æ‚µ‚Ä&newline;Žæž‚Ý ‹ÖŽ~ ‹ÖŽ~ ‹ÖŽ~ ‹ÖŽ~ g”FŽ¯‚µ‚È‚¢h

DTD‚ÌŠO‚Å‚ÍC%•¶Žš‚ÍC‚¢‚©‚È‚é“Á’è‚̈Ӗ¡‚àC‚à‚½‚È‚¢B‚µ‚½‚ª‚Á‚ÄCDTD‚ł̓pƒ‰ƒƒ^ŽÀ‘ÌŽQÆ‚Æ‚µ‚Ä”FŽ¯‚·‚é‚à‚Ì‚Å‚ ‚Á‚Ä‚àCcontent“à‚Å‚Í&markup;‚Æ‚µ‚Ä‚Í”FŽ¯‚µ‚È‚¢B“¯—l‚ÉC“KØ‚É錾‚µ‚½‘®«‚Ì’l‚Ì’†‚ÉŒ»‚ê‚éꇂ𜂫C&unparsed-entity;‚Ì–¼‘O‚ÍC”FŽ¯‚µ‚È‚¢B

gŽæž‚Ýh

ŽÀ‘Ì‚ÍC‚»‚Ì&replacement-text;‚ðŽæ‚èo‚µCˆ—‚·‚é‚ÆCŽQÆŽ©‘Ì‚Ì‘ã‚í‚è‚ÉCŽQÆ‚ª‚ ‚Á‚½ˆÊ’u‚ÅC•¶‘‚̈ꕔ‚Æ‚µ‚ÄŠÜ‚Ü‚ê‚é‚©‚̂悤‚ÉŽæ‚èž‚Ü‚ê‚éB&replacement-text;‚ÍC•¶Žšƒf[ƒ^‹y‚Ñ(ƒpƒ‰ƒƒ^ŽÀ‘̂𜂭B)&markup;‚Ì‚¢‚¸‚ê‚ðŠÜ‚ñ‚Å‚à‚æ‚­C‚±‚ê‚ç‚ÍC’Êí‚Ì•û–@‚Å”FŽ¯‚³‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚½‚¾‚µC&markup;‚Ì‹æØ‚èŽq‚ð&escape;‚·‚邽‚ß‚É—p‚¢‚éŽÀ‘Ì(&magicents;)‚Ì&replacement-text;‚ÍCí‚Ƀf[ƒ^‚Æ‚µ‚Ĉµ‚¤(&string;"AT&amp;T;"‚ÍC"AT&T;"‚É“WŠJ‚³‚êCŽc‚³‚ꂽƒAƒ“ƒpƒTƒ“ƒh‚ÍCŽÀ‘ÌŽQÆ‚Ì‹æØ‚èŽq‚Æ‚µ‚Ä‚Í”FŽ¯‚µ‚È‚¢B)B•¶ŽšŽQÆ‚ÍCŽ¦‚µ‚½•¶Žš‚ðŽQÆŽ©‘Ì‚Ì‘ã‚í‚è‚Ɉ—‚·‚é‚Æ‚«CŽæ‚èž‚Ü‚ê‚éB

gŒŸØ‚Ì‚½‚ß‚ÉŽæž‚Ýh

•¶‘‚Ì&validity;‚ðŒŸØ‚·‚é‚É‚ÍCXML&processor;‚ª&parsed-entity;‚Ö‚ÌŽQÆ‚ð”FŽ¯‚µ‚½‚Æ‚«C‚»‚Ì&replacement-text;‚ðŽæ‚èž‚Ü‚È‚¯‚ê‚΂Ȃç‚È‚¢BŽÀ‘Ì‚ªŠO•”ŽÀ‘Ì‚Å‚ ‚Á‚ÄCXML•¶‘‚Ì&validity;‚ðŒŸØ‚µ‚È‚¯‚ê‚ÎCŽÀ‘Ì‚Ì&replacement-text;‚ðŽæ‚èž‚ñ‚Å‚à‚æ‚¢‚ªC‚»‚¤‚µ‚È‚­‚Æ‚à‚æ‚¢B

‚±‚̎挈‚ß‚ÍCSGML‹y‚ÑXML‚ÌŽÀ‘Ì‚Ì‹@\‚ª’ñ‹Ÿ‚·‚鎩“®Žæž‚Ý‹@”\‚ªC•¶‘쬎ž‚̃‚ƒWƒ…[ƒ‹‰»‚ðŽå‚È–Ú“I‚Æ‚µ‚ÄÝŒv‚³‚ê‚Ä‚¨‚èC‚»‚Ì‘¼‚Ì&application;(“Á‚ÉC•¶‘‚̃uƒ‰ƒEƒY)‚É‚ÍC•K‚¸‚µ‚à“KØ‚Å‚Í‚È‚¢C‚Æ‚¢‚¤”FŽ¯‚É‚æ‚éB—Ⴆ‚ÎCƒuƒ‰ƒEƒU‚ÍŠO•”&parsed-entity;‚Ö‚ÌŽQÆ‚ðŒ©‚Â‚¯‚é‚ÆC‚»‚ÌŽÀ‘Ì‚ª‘¶Ý‚·‚é‚Æ‚¢‚¤•\Ž¦‚¾‚¯‚ðs‚¢C•\Ž¦‚ð—v‹‚³‚ꂽ‚Æ‚«‚É‚¾‚¯C“à—e‚ðŽæ‚èo‚·‚©‚à‚µ‚ê‚È‚¢B

g‹ÖŽ~h

ŽŸ‚Í‹ÖŽ~‚³‚ê‚Ä‚¨‚èC&fatal-error;‚Æ‚·‚éB

a) &unparsed-entity;‚Ö‚ÌŽQÆ‚ÌoŒ»B

b) DTD‚ÌEntityValue–”‚ÍAttValueˆÈŠO‚Ì•”•ª‚É‚¨‚¯‚éC•¶ŽšŽQÆ–”‚͈ê”ÊŽÀ‘Ì‚Ö‚ÌŽQÆ‚ÌoŒ»B

c) ‘®«’l“à‚ÌŠO•”ŽÀ‘Ì‚Ö‚ÌŽQÆB

g’Ê’mh

&unparsed-entity;‚Ì–¼‘O‚ªCENTITY–”‚ÍENTITIES‚Ì‘®«‚Ì’l‚É‚¨‚¢‚Ä&token;‚Æ‚µ‚ÄŒ»‚ꂽ‚Æ‚«C&processor;‚ÍC&application;‚ɑ΂µ‚ÄCŠÖ˜A•t‚¯‚ç‚ꂽ‹L–@–¼C‹L–@‚ɑ΂·‚éƒVƒXƒeƒ€&identifier;‹y‚Ñ(‘¶Ý‚·‚ê‚Î)ŒöŠJ&identifier;‚ð’Ê’m‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

 g&bypass;h

ˆê”ÊŽÀ‘ÌŽQÆ‚ªCŽÀ‘Ì錾‚É‚¨‚¯‚éEntityValue“à‚ÉŒ»‚ê‚é‚Æ‚«C‚»‚ê‚Í–³Ž‹‚³‚êC‚»‚Ì‚Ü‚ÜŽc‚éB

 gPE‚Æ‚µ‚ÄŽæž‚Ýh

ŠO•”&parsed-entity;‚ÌꇂƓ¯—l‚ÉCƒpƒ‰ƒƒ^ŽÀ‘Ì‚ÍC&validity;‚ðŒŸØ‚·‚é‚Æ‚«‚¾‚¯Žæ‚èž‚Ü‚ê‚é•K—v‚ª‚ ‚éBƒpƒ‰ƒƒ^ŽÀ‘ÌŽQÆ‚ðDTD“à‚É”FŽ¯‚µ‚ÄŽæ‚èž‚Þ‚Æ‚«C‚»‚Ì&replacement-text;‚ÍC‚»‚Ì‘OŒã‚Ɉê‚‚Ì&space-character;(#x20)‚Ì•t‰Á‚É‚æ‚Á‚Ĉø‚«L‚΂³‚ê‚éB‚±‚̈Ó}‚ÍCƒpƒ‰ƒƒ^ŽÀ‘Ì‚Ì&replacement-text;‚ªCDTD“à‚Ì‚¢‚­‚‚©‚Ì•¶–@“I&token;‚ðŠ®‘S‚ÉŠÜ‚Þ‚ÆC§–ñ‚·‚邱‚Æ‚É‚ ‚éB

“à•”ŽÀ‘Ì&replacement-text;‚Ì\’z

“à•”ŽÀ‘̂̎戵‚¢‚Ì‹K’è‚ÅCŽÀ‘Ì’l‚ð“ñ‚‚̌`Ž®‚É‹æ•Ê‚·‚邱‚Æ‚Í–ð‚É—§‚ÂB&literal;ŽÀ‘Ì’l‚ÍCŽÀ‘Ì錾“à‚ÉŽÀÛ‚É‘¶Ý‚·‚éCˆø—p•„‚ň͂Þ&string;‚Æ‚·‚éB‚±‚ê‚ÍC”ñI’[‹L†EntityValue‚É&match;‚·‚éB&replacement-text;‚ÍC•¶ŽšŽQÆ‹y‚Ѷmeter;ŽÀ‘ÌŽQÆ‚Ì’uŠ·‚¦Œã‚É‚¨‚¯‚éCŽÀ‘Ì‚Ì“à—e‚Æ‚·‚éB

“à•”ŽÀ‘Ì錾“à‚Å—^‚¦‚é&literal;ŽÀ‘Ì’l(EntityValue)‚ÍC•¶ŽšŽQÆC¶meter;ŽÀ‘ÌŽQÆ‹y‚шê”ÊŽÀ‘ÌŽQÆ‚ðŠÜ‚ñ‚Å‚æ‚¢B‚±‚ê‚ç‚ÌŽQÆ‚ÍC&literal;ŽÀ‘Ì’l“à‚ÉŠ®‘S‚ÉŠÜ‚Ü‚ê‚Ä‚¢‚È‚¯‚ê‚΂Ȃç‚È‚¢B“WŠJ‚·‚éŽÀÛ‚Ì&replacement-text;(æ‚ÉŽ¦‚µ‚½‚à‚Ì)‚ÍCŽQÆ‚·‚é¶meter;ŽÀ‘Ì‚Ì&replacement-text;‚ðŠÜ‚Ü‚È‚¯‚ê‚΂Ȃ炸C&literal;ŽÀ‘Ì’l“à‚Å‚Ì•¶ŽšŽQÆ‚Ì‘ã‚í‚è‚ÉŽQÆ‚µ‚½•¶Žš‚ðŠÜ‚Ü‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚µ‚©‚µCˆê”ÊŽÀ‘ÌŽQÆ‚ÍC‚»‚Ì‚Ü‚ÜŽc‚µ, “WŠJ‚µ‚Ä‚Í‚È‚ç‚È‚¢B —Ⴆ‚ÎCŽŸ‚Ì錾‚ð—^‚¦‚½‚Æ‚·‚éB ]]> ŽÀ‘Ì‚Ì&replacement-text;"book"‚ÍCŽŸ‚Ì‚Æ‚¨‚è‚Æ‚È‚éB La Peste: Albert Camus, © 1947 Éditions Gallimard. &rights; ŽQÆ"&book;"‚ªC•¶‘‚Ì“à—e–”‚Í‘®«’l“à‚ÉoŒ»‚µ‚Ä‚¢‚ê‚ÎCˆê”ÊŽÀ‘ÌŽQÆ"&rights;"‚ÍC“WŠJ‚³‚ê‚Ä‚¢‚éB

‚±‚ê‚ç‚Ì’Pƒ‚È‹K‘¥‚ÍC•¡‡‘ŠŒÝì—p‚ð‚à‚ÂB “‚¢—á‚ɂ‚¢‚Ä‚ÌÚׂÍCŽÀ‘ÌŽQÆ‚Ì“WŠJ‚Ì•t˜^‚ðŽQÆ‚Ì‚±‚ÆB

’è‹`Ï‚ÝŽÀ‘Ì

ŽÀ‘ÌŽQÆ‹y‚Ñ•¶ŽšŽQÆ‚Ì‚¢‚¸‚ê‚àC&left-angle-bracket;CƒAƒ“ƒoƒTƒ“ƒh‹y‚Ñ‘¼‚Ì‹æØ‚èŽq‚ð&escape;‚·‚邽‚ß‚ÉŽg—p‚Å‚«‚éB‚¢‚­‚‚©‚̈ê”ÊŽÀ‘Ìi&magicents;j‚ðC‚±‚Ì–Ú“I‚Ì‚½‚ß‚ÉŽw’è‚·‚éB”’l‚É‚æ‚镶ŽšŽQÆ‚àC“¯—l‚Ì–Ú“I‚Ì‚½‚ß‚ÉŽg—p‚Å‚«‚éB•¶ŽšŽQÆ‚ÍC”FŽ¯‚³‚ê‚é‚Æ’¼‚¿‚É“WŠJ‚³‚êC•¶Žšƒf[ƒ^‚Æ‚µ‚Ĉµ‚í‚ê‚é‚Ì‚ÅC”’l‚É‚æ‚镶ŽšŽQÆ"&#60;"‹y‚Ñ"&#38;"‚ÍC•¶Žšƒf[ƒ^“à‚ÉoŒ»‚·‚é<‹y‚Ñ&‚ð&escape;‚·‚邽‚ß‚ÉŽg—p‚Å‚«‚éB

‚·‚ׂĂÌXML&processor;‚ÍC錾‚³‚ê‚Ä‚¢‚é‚©‚Ç‚¤‚©‚ÉŠÖŒW‚È‚­C‚±‚ê‚ç‚ÌŽÀ‘Ì‚ð”FŽ¯‚µ‚È‚­‚Ä‚Í‚È‚ç‚È‚¢B‘ŠŒÝ‰^—p«‚Ì‚½‚ßC&valid;‚ÈXML•¶‘‚ÍC‚±‚ê‚ç‚ÌŽÀ‘Ì‚ðŽg—p‚·‚é‘O‚ÉC‘¼‚ÌŽÀ‘Ì‚Æ“¯—l‚ÉC錾‚·‚邱‚Æ‚ª–]‚Ü‚µ‚¢BŽÀ‘Ì‚ð錾‚·‚éꇂÍC&replacement-text;‚ð&escape;‚·‚éˆê•¶Žš‚Æ‚·‚é“à•”ŽÀ‘Ì‚Æ‚µ‚ÄCŽŸ‚Ì‚Æ‚¨‚è‚É錾‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B ]]> "lt"‹y‚Ñ"amp"錾“à‚Ì"<"‹y‚Ñ"&"•¶Žš‚ÍCŽÀ‘Ì‚Ì’uŠ·ƒeƒLƒXƒg‚ªC&well-formed;‚Æ‚È‚é‚悤‚É“ñd‚É&escape;‚³‚ê‚邱‚Æ‚É’ˆÓB

‹L–@錾

‹L–@‚ÍC&unparsed-entity;‚ÌŒ`Ž®‚ð&identify;–¼‘O‚©C–”‚͈—–½—ß‚Ì‘ÎÛ‚Æ‚·‚é&application;‚ð&identify;–¼‘O‚Æ‚·‚éB

‹L–@錾‚ÍC‹L–@‚Ì–¼‘O‹y‚ÑŠO•”&identifier;‚ð’ñ‹Ÿ‚·‚éB‚±‚Ì–¼‘O‚ÍCŽÀ‘Ì‹y‚Ñ‘®«ƒŠƒXƒg錾•À‚Ñ‚É‘®«Žw’è‚É—p‚¢‚éBŠO•”&identifier;‚ÍC—^‚¦‚ç‚ꂽ‹L–@‚̃f[ƒ^‚ðˆ—‚Å‚«‚éƒwƒ‹ƒp&application;‚ðCXML&processor;–”‚̓Nƒ‰ƒCƒAƒ“ƒgƒAƒvƒŠƒP[ƒVƒ‡ƒ“‚ª’T‚·‚½‚ß‚ÉC—˜—p‚Å‚«‚éB ‹L–@錾 NotationDecl '<!NOTATION' S Name S (ExternalID | PublicID) S? '>' PublicID 'PUBLIC' S PubidLiteral

錾‚µC‘®«’lC‘®«’è‹`–”‚ÍŽÀ‘Ì錾‚ÅŽQÆ‚·‚é‚·‚ׂĂ̋L–@‚ɂ‚¢‚ÄCXML&processor;‚ÍC‹L–@‚Ì–¼‘O‹y‚ÑŠO•”&identifier;‚ð&application;‚É’ñ‹Ÿ‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚³‚ç‚ÉCŠO•”&identifier;‚ðCƒVƒXƒeƒ€&identifier;Cƒtƒ@ƒCƒ‹–¼–”‚Í‚»‚Ì‘¼‚Ìî•ñ‚É“WŠJ‚µ‚Ä‚à‚æ‚­C‚±‚ê‚ç‚ð—p‚¢‚ÄC&application;‚ÍC‚»‚Ì‹L–@‚̃f[ƒ^‚ðˆ—‚·‚é&processor;‚ð‹N“®‚·‚éB(‚µ‚©‚µCXML&processor;–”‚Í&application;‚ª“®ì‚·‚éƒVƒXƒeƒ€‚Å‚Í—˜—p‚Å‚«‚È‚¢‹L–@‚ðCXML•¶‘‚ªéŒ¾‚µŽQÆ‚µ‚Ä‚àC‚±‚ê‚ÍC&error;‚Æ‚Í‚µ‚È‚¢Bj

 •¶‘ŽÀ‘Ì

•¶‘ŽÀ‘Ì‚ÍCŽÀ‘Ì‚ÌŒ`¬‚·‚é–Ø\‘¢‚Ì&root;‚Å‚ ‚Á‚ÄCXML&processor;‚ªCˆ—‚ðŠJŽn‚·‚é’n“_‚Æ‚·‚éB‚±‚Ì&TR-or-Rec;‚ÍCXML&processor;‚ªC•¶‘ŽÀ‘Ì‚Ì‘¶Ý‚·‚éꊂð‚ǂ̂悤‚ÉŒ©‚‚¯‚é‚©‚ÍC‹K’肵‚È‚¢B‘¼‚ÌŽÀ‘̂ƈقȂèC•¶‘ŽÀ‘Ì‚Í–¼‘O‚ð‚à‚½‚¸C‚¢‚©‚Ȃ鎯•Ê‚à‚È‚µ‚É&processor;‚Ö‚Ì“ü—Í&stream;‚ÉoŒ»‚µ‚Ä‚à‚æ‚¢B

 “K‡«

“K‡‚·‚éXML&processor;‚ÍC&validating;‚à‚Ì‹y‚Ñ&non-validating;‚à‚Ì‚ÌC“ñ‚‚ɕª—Þ‚³‚ê‚éB

&validating;ƒVƒXƒeƒ€‹y‚Ñ&non-validating;ƒVƒXƒeƒ€‚ÍC‚±‚Ì&TR-or-Rec;‚ª‹K’è‚·‚é&well-formed;§–ñ‚ւ̈ᔽ‚ð•ñ‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

&validating;&processor;‚ÍCDTD“à‚Ì錾‚É‚æ‚Á‚ÄŽ¦‚³‚ꂽC§–ñ‚ւ̈ᔽ‚ð•ñ‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚³‚ç‚ÉC‚±‚Ì&TR-or-Rec;‚ª‹K’è‚·‚é&validity;§–ñ‚ւ̈ᔽ‚ðC‚·‚ׂĕñ‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢B

‹L–@

XML‚ÌŒ`Ž®“I‚È•¶–@‚ÍCŠÈ’P‚ÈŠg’£Backus-Naur Form(EBNF)‹L–@‚É‚æ‚Á‚Ä—^‚¦‚éB•¶–@‚ÌŠe‹K‘¥‚ÍCŽŸ‚ÌŒ`Ž®‚ÅC‹L†‚ðˆê‚Â’è‹`‚·‚éB symbol ::= expression

‹L†‚ÍC³‹K•\Œ»‚Å’è‹`‚·‚é‚Æ‚«‚͑啶Žš‚ÅŽn‚ßC‚»‚¤‚Å‚È‚¯‚ê‚ÎC¬•¶Žš‚ÅŽn‚ß‚éB&string;&literal;‚ÍCˆø—p•„‚ň͂ÞB

‹K‘¥‚̉E‘¤‚ÌŽ®“à‚Å‚ÍCˆê‚–”‚Í•¡”‚Ì•¶Žš‚©‚ç‚È‚é&string;‚Æ&match;‚·‚邽‚ß‚ÉCŽŸ‚ÌŽ®‚ðŽg—p‚·‚éB

‚±‚±‚ÅCN‚Í16i‚Ì®”‚Æ‚·‚éBISO/IEC 10646‚Ì•¶Žš‚Å‚ ‚Á‚ÄC³‹KŒ`(UCS-4)‚Ì&code-value;‚𕄆‚È‚µ2i”‚Æ‚µ‚ĉðŽß‚µ‚½‚Æ‚«CŽw’肵‚½’l‚Æ“™‚µ‚¢‚à‚Ì‚Æ&match;‚·‚éB#xNŒ`Ž®‚Ì擪‚Ƀ[ƒ‚ª‚¢‚­‚‚©Œ»‚ê‚é‚©‚ÍCˆÓ–¡‚ð‚à‚½‚È‚¢B&code-value;‚É‚¨‚¯‚é擪‚̃[ƒ‚Ì”‚ÍC•¶Žš‚Ì•„†‰»‚É‚æ‚Á‚ÄŒˆ’肳‚ê‚é‚Ì‚ÅCXML‚É‚Æ‚Á‚Ă͈Ӗ¡‚ª‚È‚¢B

Žw’肵‚½”͈͂̒l(—¼’[‚Ì’l‚ðŠÜ‚ÞBj‚ð‚à‚”CˆÓ‚Ì•¶Žš‚Æ&match;‚·‚éB

Žw’肵‚½”͈͊O‚Ì’l‚ð‚à‚”CˆÓ‚Ì•¶Žš‚Æ&match;‚·‚éB

Žw’肵‚½•¶ŽšˆÈŠO‚Ì’l‚ð‚à‚”CˆÓ‚Ì•¶Žš‚Æ&match;‚·‚éB

&double-quote;‚ň͂Þ&string;&literal;‚Æ&match;‚µ‚Ä‚¢‚é&string;&literal;‚Æ&match;‚·‚éB

&single-quote;‚ň͂Þ&string;&literal;‚Æ&match;‚µ‚Ä‚¢‚é&string;&literal;‚Æ&match;‚·‚éB

 ‚±‚ê‚ç‚Ì‹L†‚ÍCŽŸ‚ÌŒ`Ž®‚Ì‘g‡‚¹‚ÅŽg—p‚·‚éB‚±‚±‚ÅCA‹y‚ÑB‚ÍC’Pƒ‚ÈŽ®‚Æ‚·‚éB

expression‚ÍCˆê‚‚̂܂Ƃ܂è‚Æ‚µ‚Ĉµ‚¢C‚±‚±‚ÉŽ¦‚·‘g‡‚¹‚ÅŽg‚Á‚Ä‚à‚æ‚¢B

A–”‚͉½‚à‚È‚µ‚Æ&match;‚·‚é(ƒIƒvƒVƒ‡ƒ“‚ÌA)B

A‚ÌŽŸ‚ÉB‚ªoŒ»‚·‚é‚à‚Ì‚Æ&match;‚·‚éB

A–”‚ÍBC‚½‚¾‚µC—¼•û‚Å‚Í‚È‚¢C‚Æ&match;‚·‚éB

A‚Æ&match;‚·‚邪CB‚Æ‚Í&match;‚µ‚È‚¢C”CˆÓ‚Ì&string;‚Æ&match;‚·‚éB

A‚Ì1‰ñˆÈã‚ÌŒJ•Ô‚µ‚Æ&match;‚·‚éB

A‚Ì0‰ñˆÈã‚ÌŒJ•Ô‚µ‚Æ&match;‚·‚éB

 ¶¬‹K‘¥“à‚ÅŽg—p‚·‚鑼‚Ì‹L–@‚ðCŽŸ‚ÉŽ¦‚·B

ƒRƒƒ“ƒgB

&well-formed;§–ñB¶¬‹K‘¥‚É•t—^‚µ‚½C&well-formed;‚Ì•¶‘‚ÉŠÖ‚·‚駖ñ‚ðC–¼‘O‚É‚æ‚Á‚Ä&identify;B

&validity;§–ñB¶¬‹K‘¥‚É•t—^‚µ‚½C&valid;‚È•¶‘‚ÉŠÖ‚·‚駖ñ‚ðC–¼‘O‚É‚æ‚Á‚Ä&identify;B

ŽQl•¶Œ£ &normative;ŽQl•¶Œ£ IETF (Internet Engineering Task Force). RFC 1766: Tags for the Identification of Languages, ed. H. Alvestrand. 1995. (International Organization for Standardization). ISO 8879:1988 (E). Code for the representation of names of languages. [Geneva]: International Organization for Standardization, 1988. (International Organization for Standardization). ISO 3166-1:1997 (E). Codes for the representation of names of countries and their subdivisions — Part 1: Country codes [Geneva]: International Organization for Standardization, 1997. ISO (International Organization for Standardization). ISO/IEC 10646-1993 (E). Information technology — Universal Multiple-Octet Coded Character Set (UCS) — Part 1: Architecture and Basic Multilingual Plane. [Geneva]: International Organization for Standardization, 1993 (plus amendments AM 1 through AM 7). The Unicode Consortium. The Unicode Standard, Version 2.0. Reading, Mass.: Addison-Wesley Developers Press, 1996. ‘¼‚ÌŽQl•¶Œ£ Aho, Alfred V., Ravi Sethi, and Jeffrey D. Ullman. Compilers: Principles, Techniques, and Tools. Reading: Addison-Wesley, 1986, rpt. corr. 1988. Berners-Lee, T., R. Fielding, and L. Masinter. Uniform Resource Identifiers (URI): Generic Syntax and Semantics. 1997. (Work in progress; see updates to RFC1738.) Brüggemann-Klein, Anne. Regular Expressions into Finite Automata. Extended abstract in I. Simon, Hrsg., LATIN 1992, S. 97-98. Springer-Verlag, Berlin 1992. Full Version in Theoretical Computer Science 120: 197-213, 1993. Brüggemann-Klein, Anne, and Derick Wood. Deterministic Regular Languages. Universität Freiburg, Institut für Informatik, Bericht 38, Oktober 1991. IETF (Internet Engineering Task Force). RFC 1738: Uniform Resource Locators (URL), ed. T. Berners-Lee, L. Masinter, M. McCahill. 1994. IETF (Internet Engineering Task Force). RFC 1808: Relative Uniform Resource Locators, ed. R. Fielding. 1995. IETF (Internet Engineering Task Force). RFC 2141: URN Syntax, ed. R. Moats. 1997. ISO (International Organization for Standardization). ISO/IEC 8879-1986 (E). Information processing — Text and Office Systems — Standard Generalized Markup Language (SGML). First edition — 1986-10-15. [Geneva]: International Organization for Standardization, 1986. ISO (International Organization for Standardization). ISO/IEC 10744-1992 (E). Information technology — Hypermedia/Time-based Structuring Language (HyTime). [Geneva]: International Organization for Standardization, 1992. Extended Facilities Annexe. [Geneva]: International Organization for Standardization, 1996. •¶ŽšƒNƒ‰ƒX

Unicode•W€‚É’è‹`‚·‚é&property;‚É‚µ‚½‚ª‚Á‚ÄC•¶Žš‚ÍC&base-character;(BaseChar)(‚±‚ê‚ç‚ÍC&diacritical-mark;‚𜂭ƒ‰ƒeƒ“ƒAƒ‹ƒtƒ@ƒxƒbƒg‚̃Aƒ‹ƒtƒ@ƒxƒbƒg•¶Žš‚ðŠÜ‚Þ)C&ideographic;(ideographic)‹y‚Ñ&combining-character;(CombiningChar)(‚±‚̃Nƒ‰ƒX‚ÍC‚Ù‚Æ‚ñ‚Ç‚Ì&diacritical-mark;‚ðŠÜ‚Þ)‚ɃNƒ‰ƒX•ª‚¯‚·‚éB‚±‚ê‚ç‚̃Nƒ‰ƒX‚ÍCŒ‹‡‚µC&letter;(Letter)‚̃Nƒ‰ƒX‚Æ‚È‚éB10i”’l(Digit)‹y‚Ñ&extender;(Extender)‚à‹æ•Ê‚·‚éB •¶Žš Letter BaseChar | Ideographic BaseChar [#x0041-#x005A] | [#x0061-#x007A] | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x00FF] | [#x0100-#x0131] | [#x0134-#x013E] | [#x0141-#x0148] | [#x014A-#x017E] | [#x0180-#x01C3] | [#x01CD-#x01F0] | [#x01F4-#x01F5] | [#x01FA-#x0217] | [#x0250-#x02A8] | [#x02BB-#x02C1] | #x0386 | [#x0388-#x038A] | #x038C | [#x038E-#x03A1] | [#x03A3-#x03CE] | [#x03D0-#x03D6] | #x03DA | #x03DC | #x03DE | #x03E0 | [#x03E2-#x03F3] | [#x0401-#x040C] | [#x040E-#x044F] | [#x0451-#x045C] | [#x045E-#x0481] | [#x0490-#x04C4] | [#x04C7-#x04C8] | [#x04CB-#x04CC] | [#x04D0-#x04EB] | [#x04EE-#x04F5] | [#x04F8-#x04F9] | [#x0531-#x0556] | #x0559 | [#x0561-#x0586] | [#x05D0-#x05EA] | [#x05F0-#x05F2] | [#x0621-#x063A] | [#x0641-#x064A] | [#x0671-#x06B7] | [#x06BA-#x06BE] | [#x06C0-#x06CE] | [#x06D0-#x06D3] | #x06D5 | [#x06E5-#x06E6] | [#x0905-#x0939] | #x093D | [#x0958-#x0961] | [#x0985-#x098C] | [#x098F-#x0990] | [#x0993-#x09A8] | [#x09AA-#x09B0] | #x09B2 | [#x09B6-#x09B9] | [#x09DC-#x09DD] | [#x09DF-#x09E1] | [#x09F0-#x09F1] | [#x0A05-#x0A0A] | [#x0A0F-#x0A10] | [#x0A13-#x0A28] | [#x0A2A-#x0A30] | [#x0A32-#x0A33] | [#x0A35-#x0A36] | [#x0A38-#x0A39] | [#x0A59-#x0A5C] | #x0A5E | [#x0A72-#x0A74] | [#x0A85-#x0A8B] | #x0A8D | [#x0A8F-#x0A91] | [#x0A93-#x0AA8] | [#x0AAA-#x0AB0] | [#x0AB2-#x0AB3] | [#x0AB5-#x0AB9] | #x0ABD | #x0AE0 | [#x0B05-#x0B0C] | [#x0B0F-#x0B10] | [#x0B13-#x0B28] | [#x0B2A-#x0B30] | [#x0B32-#x0B33] | [#x0B36-#x0B39] | #x0B3D | [#x0B5C-#x0B5D] | [#x0B5F-#x0B61] | [#x0B85-#x0B8A] | [#x0B8E-#x0B90] | [#x0B92-#x0B95] | [#x0B99-#x0B9A] | #x0B9C | [#x0B9E-#x0B9F] | [#x0BA3-#x0BA4] | [#x0BA8-#x0BAA] | [#x0BAE-#x0BB5] | [#x0BB7-#x0BB9] | [#x0C05-#x0C0C] | [#x0C0E-#x0C10] | [#x0C12-#x0C28] | [#x0C2A-#x0C33] | [#x0C35-#x0C39] | [#x0C60-#x0C61] | [#x0C85-#x0C8C] | [#x0C8E-#x0C90] | [#x0C92-#x0CA8] | [#x0CAA-#x0CB3] | [#x0CB5-#x0CB9] | #x0CDE | [#x0CE0-#x0CE1] | [#x0D05-#x0D0C] | [#x0D0E-#x0D10] | [#x0D12-#x0D28] | [#x0D2A-#x0D39] | [#x0D60-#x0D61] | [#x0E01-#x0E2E] | #x0E30 | [#x0E32-#x0E33] | [#x0E40-#x0E45] | [#x0E81-#x0E82] | #x0E84 | [#x0E87-#x0E88] | #x0E8A | #x0E8D | [#x0E94-#x0E97] | [#x0E99-#x0E9F] | [#x0EA1-#x0EA3] | #x0EA5 | #x0EA7 | [#x0EAA-#x0EAB] | [#x0EAD-#x0EAE] | #x0EB0 | [#x0EB2-#x0EB3] | #x0EBD | [#x0EC0-#x0EC4] | [#x0F40-#x0F47] | [#x0F49-#x0F69] | [#x10A0-#x10C5] | [#x10D0-#x10F6] | #x1100 | [#x1102-#x1103] | [#x1105-#x1107] | #x1109 | [#x110B-#x110C] | [#x110E-#x1112] | #x113C | #x113E | #x1140 | #x114C | #x114E | #x1150 | [#x1154-#x1155] | #x1159 | [#x115F-#x1161] | #x1163 | #x1165 | #x1167 | #x1169 | [#x116D-#x116E] | [#x1172-#x1173] | #x1175 | #x119E | #x11A8 | #x11AB | [#x11AE-#x11AF] | [#x11B7-#x11B8] | #x11BA | [#x11BC-#x11C2] | #x11EB | #x11F0 | #x11F9 | [#x1E00-#x1E9B] | [#x1EA0-#x1EF9] | [#x1F00-#x1F15] | [#x1F18-#x1F1D] | [#x1F20-#x1F45] | [#x1F48-#x1F4D] | [#x1F50-#x1F57] | #x1F59 | #x1F5B | #x1F5D | [#x1F5F-#x1F7D] | [#x1F80-#x1FB4] | [#x1FB6-#x1FBC] | #x1FBE | [#x1FC2-#x1FC4] | [#x1FC6-#x1FCC] | [#x1FD0-#x1FD3] | [#x1FD6-#x1FDB] | [#x1FE0-#x1FEC] | [#x1FF2-#x1FF4] | [#x1FF6-#x1FFC] | #x2126 | [#x212A-#x212B] | #x212E | [#x2180-#x2182] | [#x3041-#x3094] | [#x30A1-#x30FA] | [#x3105-#x312C] | [#xAC00-#xD7A3] Ideographic [#x4E00-#x9FA5] | #x3007 | [#x3021-#x3029] CombiningChar [#x0300-#x0345] | [#x0360-#x0361] | [#x0483-#x0486] | [#x0591-#x05A1] | [#x05A3-#x05B9] | #x05BB#x05BD | #x05BF | [#x05C1-#x05C2] | #x05C4 | #x064B#x0652 | #x0670 | [#x06D6-#x06DC] | #x06DD#x06DF | [#x06E0-#x06E4] | [#x06E7-#x06E8] | [#x06EA-#x06ED] | [#x0901-#x0903] | #x093C | [#x093E-#x094C] | #x094D | [#x0951-#x0954] | [#x0962-#x0963] | [#x0981-#x0983] | #x09BC | #x09BE | #x09BF | [#x09C0-#x09C4] | [#x09C7-#x09C8] | [#x09CB-#x09CD] | #x09D7 | [#x09E2-#x09E3] | #x0A02 | #x0A3C | #x0A3E | #x0A3F | [#x0A40-#x0A42] | [#x0A47-#x0A48] | [#x0A4B-#x0A4D] | [#x0A70-#x0A71] | [#x0A81-#x0A83] | #x0ABC | [#x0ABE-#x0AC5] | [#x0AC7-#x0AC9] | [#x0ACB-#x0ACD] | [#x0B01-#x0B03] | #x0B3C | [#x0B3E-#x0B43] | [#x0B47-#x0B48] | [#x0B4B-#x0B4D] | [#x0B56-#x0B57] | [#x0B82-#x0B83] | [#x0BBE-#x0BC2] | [#x0BC6-#x0BC8] | [#x0BCA-#x0BCD] | #x0BD7 | [#x0C01-#x0C03] | [#x0C3E-#x0C44] | [#x0C46-#x0C48] | [#x0C4A-#x0C4D] | [#x0C55-#x0C56] | [#x0C82-#x0C83] | [#x0CBE-#x0CC4] | [#x0CC6-#x0CC8] | [#x0CCA-#x0CCD] | [#x0CD5-#x0CD6] | [#x0D02-#x0D03] | [#x0D3E-#x0D43] | [#x0D46-#x0D48] | [#x0D4A-#x0D4D] | #x0D57 | #x0E31 | [#x0E34-#x0E3A] | [#x0E47-#x0E4E] | #x0EB1 | [#x0EB4-#x0EB9] | [#x0EBB-#x0EBC] | [#x0EC8-#x0ECD] | [#x0F18-#x0F19] | #x0F35 | #x0F37 | #x0F39 | #x0F3E | #x0F3F | [#x0F71-#x0F84] | [#x0F86-#x0F8B] | [#x0F90-#x0F95] | #x0F97 | [#x0F99-#x0FAD] | [#x0FB1-#x0FB7] | #x0FB9 | [#x20D0-#x20DC] | #x20E1 | [#x302A-#x302F] | #x3099 | #x309A Digit [#x0030-#x0039] | [#x0660-#x0669] | [#x06F0-#x06F9] | [#x0966-#x096F] | [#x09E6-#x09EF] | [#x0A66-#x0A6F] | [#x0AE6-#x0AEF] | [#x0B66-#x0B6F] | [#x0BE7-#x0BEF] | [#x0C66-#x0C6F] | [#x0CE6-#x0CEF] | [#x0D66-#x0D6F] | [#x0E50-#x0E59] | [#x0ED0-#x0ED9] | [#x0F20-#x0F29] Extender #x00B7 | #x02D0 | #x02D1 | #x0387 | #x0640 | #x0E46 | #x0EC6 | #x3005 | [#x3031-#x3035] | [#x309D-#x309E] | [#x30FC-#x30FE]

‚±‚±‚Å’è‹`‚·‚镶ŽšƒNƒ‰ƒX‚ÍCUnicode•¶Žšƒf[ƒ^ƒx[ƒX‚©‚çCŽŸ‚Ì‚Æ‚¨‚è‚É“¾‚邱‚Æ‚ª‚Å‚«‚éB

a) –¼‘OŠJŽn•¶Žš‚ÍCLl, Lu, Lo, Lt, NlƒJƒeƒSƒŠ“à‚̈ê‚‚łȂ¯‚ê‚΂Ȃç‚È‚¢B

b) –¼‘OŠJŽn•¶ŽšˆÈŠO‚Ì–¼‘O•¶Žš‚ÍCMc, Me, Mn, Lm, NdƒJƒeƒSƒŠ“à‚̈ê‚‚łȂ¯‚ê‚΂Ȃç‚È‚¢B

c) &compatibility-area;‚É‚ ‚镶Žš(•¶Žš•„†‚Å#xF900‚æ‚è‘å‚«‚­#xFFFE‚æ‚謂³‚¢•¶Žš)‚ÍCXML‚É‚¨‚¯‚é–¼‘O‚Æ‚µ‚Ä‚ÍC‹–‚³‚ê‚È‚¢B

d) &font-decomposition;‚©&compatibility-decomposition;‚ð‚à‚•¶Žš(‚‚܂èCƒf[ƒ^ƒx[ƒX“à‚Ì‚T”Ԗڂ̃tƒB[ƒ‹ƒh‚É"compatibility formatting tag"‚ª‚ ‚é‚à‚ÌB‚±‚ê‚ÍC‚T”Ԗڂ̃tƒB[ƒ‹ƒh‚ªC"<"‚ÅŽn‚܂邱‚Æ‚É‚æ‚Á‚ă}[ƒN•t‚¯‚³‚ê‚éB)‚ÍC‹–‚³‚ê‚È‚¢B

e) ŽŸ‚Ì•¶Žš‚ÍC–¼‘OŠJŽn•¶Žš‚Æ‚µ‚Ĉµ‚¤B‚±‚ê‚ÍC&property-file;‚ªC‚±‚ê‚ç‚Ì•¶Žš‚ðƒAƒ‹ƒtƒ@ƒxƒbƒg‚É—ÞŽ—‚·‚é‚ÆŒ©‚È‚·‚±‚Æ‚É‚æ‚éB‚»‚ê‚ç‚Í [#x02BB-#x02C1], #x0559, #x06E5, #x06E6‚Æ‚·‚éB

f) •¶Žš•„†‚ª#x20DD-#x20E0‚Ì•¶Žš‚ÍC(Unicode ‚Ì5.14‚É‚µ‚½‚ª‚Á‚Ä)œŠO‚·‚éB

g) •¶Žš•„†‚ª#x00B7‚Ì•¶Žš‚ÍC&property-list;‚É‚µ‚½‚ª‚Á‚ÄC&extender;(extender)‚É•ª—Þ‚·‚éB

h) •¶Žš#x0387‚ÍC‚±‚ê‚É‘Š“–‚·‚鳋KŒ`‚ª#x00B7‚È‚Ì‚ÅC–¼‘O•¶Žš‚ɒljÁ‚·‚éB

i) •¶Žš':'‹y‚Ñ'_'‚ÍC–¼‘OŠJŽn•¶Žš‚Æ‚µ‚Ä‹–‚·B

j) •¶Žš'-'‹y‚Ñ'.'‚ÍC–¼‘O•¶Žš‚Æ‚µ‚Ä‹–‚·B

XML‹y‚ÑSGML

XML‚ÍCSGML‚Ì⊂‚Æ‚µ‚ÄÝŒv‚³‚ê‚Ä‚¢‚éB‚·‚È‚í‚¿C‚·‚ׂĂÌ&valid;‚ÈXML•¶‘‚ÍC‹KŠi‚É“K‡‚·‚éSGML•¶‘‚É‚à‚È‚éBSGML‚ª•¶‘‚ɉۂ·§ŒÀˆÈŠO‚ÉCXML‚ª‚¢‚©‚Ȃ駌À‚ð‰Û‚·‚©‚ÉŠÖ‚·‚éÚׂÍC•Ê‚Ì‹K’ö‚ðŽQÆ‚Ì‚±‚ÆB‚±‚Ì‹K’ö‚ÍCXML‚̧–ñðŒ‚ðŽ¦‚·SGML錾‚ðŠÜ‚ÝC‚±‚ê‚ÍCSGML&parser;‚ÉŽg—p‚Å‚«‚éB

ŽÀ‘ÌŽQÆ‹y‚Ñ•¶ŽšŽQÆ‚Ì“WŠJ

‚±‚Ì•t˜^‚ÍCŽÀ‘ÌŽQÆ‹y‚Ñ•¶ŽšŽQÆ‚ð”FŽ¯‚µC“WŠJ‚·‚éCˆê˜A‚Ì—¬‚ê‚ðC—á‚ÉŽg‚Á‚ÄŽ¦‚·B

DTD‚ªCŽŸ‚Ì錾‚ðŠÜ‚Þꇂðl‚¦‚éB An ampersand (&#38;) may be escaped numerically (&#38;#38;) or with a general entity (&amp;).

" > ]]> XML&processor;‚ÍCŽÀ‘Ì‚Ì錾‚ð\•¶‰ðÍ‚µ‚½Žž“_‚Å•¶ŽšŽQÆ‚ð”FŽ¯‚µC‚±‚ê‚ð‰ðŒˆ‚·‚éBŽÀ‘Ì"example"‚Ì’l‚Æ‚µ‚ÄCŽŸ‚Ì&string;‚ð•Û‘¶‚·‚éB An ampersand (&) may be escaped numerically (&#38;) or with a general entity (&amp;).

]]> •¶‘“à‚Å"&example;"‚ðŽQÆ‚·‚é‚ÆC‚±‚̃eƒLƒXƒg‚ÍCÄ‚Ñ\•¶‰ðÍ‚³‚ê‚éB‚±‚Ì‚Æ‚«C—v‘f"p"‚ÌŠJŽnƒ^ƒO‹y‚ÑI—¹ƒ^ƒO‚ð”FŽ¯‚µCŽO‚‚̎QÆ‚ð”FŽ¯‚µ“WŠJ‚·‚éB‚»‚ÌŒ‹‰ÊC—v‘f"p"‚ÍCŽŸ‚Ì“à—e‚ð‚à‚Â(‚·‚ׂăf[ƒ^‚Æ‚µC‹æØ‚èŽq–”‚Í&markup;‚Í‘¶Ý‚µ‚È‚¢B)B

‹K‘¥‹y‚Ñ‚»‚ÌŒø‰Ê‚ð‚æ‚èÚׂɎ¦‚·‚½‚ßC‚³‚ç‚É•¡ŽG‚È—á‚ðŽ¦‚·BŽŸ‚Ì—á‚ÅCs”Ô†‚ÍCŽQÆ‚Ì•Ö‹X‚Ì‚½‚ß‚¾‚¯‚É•t‚¯‚éB 2 4 5 ' > 6 %xx; 7 ]> 8 This sample shows a &tricky; method. ]]> ‚±‚ê‚ðˆ—‚·‚é‚ÆCŽŸ‚Ì‚Æ‚¨‚è‚Æ‚È‚éB

a) 4s–Ú‚ÅC37”Ô–Ú‚Ì•¶Žš‚Ö‚ÌŽQƂ𒼂¿‚É“WŠJ‚µCƒpƒ‰ƒƒ^ŽÀ‘Ì"xx"‚ðCƒVƒ“ƒ{ƒ‹ƒe[ƒuƒ‹‚É"%zz;"‚Æ‚¢‚¤’l‚Æ‚Æ‚à‚É•Û‘¶‚·‚éB&replacement-text;‚ðÄ‚Ñ‘–¸‚·‚邱‚Æ‚Í‚È‚¢‚Ì‚ÅCƒpƒ‰ƒƒ^ŽÀ‘Ì"zz"‚Ö‚ÌŽQÆ‚Í”FŽ¯‚µ‚È‚¢("zz"‚ÍC‚Ü‚¾éŒ¾‚³‚ê‚Ä‚¢‚È‚¢‚Ì‚ÅC‘–¸‚³‚ê‚ê‚ÎC&error;‚Æ‚È‚éB)B

b) 5s–Ú‚ÅC•¶ŽšŽQÆ"&#60;"‚𒼂¿‚É“WŠJ‚µCƒpƒ‰ƒƒ^ŽÀ‘Ì"zz"‚ð"<!ENTITY tricky "error-prone" >"‚Æ‚¢‚¤&replacement-text;‚Æ‚Æ‚à‚É•Û‘¶‚·‚éB‚±‚ê‚ÍC&well-formed;‚ÌŽÀ‘Ì錾‚Æ‚·‚éB

c) 6s–Ú‚ÅC"xx"‚Ö‚ÌŽQÆ‚ð”FŽ¯‚µC"xx"‚Ì&replacement-text;(‚·‚È‚í‚¿C"%zz;")‚ð\•¶‰ðÍ‚·‚éB"zz"‚Ö‚ÌŽQƂ𑱂¢‚Ä”FŽ¯‚µC&replacement-text;("<!ENTITY tricky "error-prone" >")‚ð\•¶‰ðÍ‚·‚éBˆê”ÊŽÀ‘Ì"tricky"‚ÍC‚±‚ÌŽž“_‚Å‚ÍC錾‚³‚ê‚Ä‚¨‚èC‚»‚Ì&replacement-text;‚ÍC"error-prone"‚Æ‚·‚éB

d) 8s–Ú‚ÅCˆê”ÊŽÀ‘Ì"tricky"‚Ö‚ÌŽQÆ‚ð”FŽ¯‚µC“WŠJ‚·‚éB—v‘f"test"‚ÌŠ®‘S‚È“à—e‚ÍCŽŸ‚Ì(“à—e‚ð‚»‚êŽ©‘Ì•\Œ»‚·‚éB)&string;‚Æ‚È‚éB‚‚܂èCThis sample shows a error-prone method.

Œˆ’è“I“à—eƒ‚ƒfƒ‹

ŒÝŠ·«‚Ì‚½‚ßC—v‘f錾‚É‚¨‚¯‚é“à—eƒ‚ƒfƒ‹‚ÍCŒˆ’è“I‚Æ‚·‚é•K—v‚ª‚ ‚éB

SGML‚ÍCŒˆ’è“I“à—eƒ‚ƒfƒ‹(SGML‚Å‚ÍC”ñ‚ ‚¢‚Ü‚¢‚ƌĂÔB)‚ð—v‹‚·‚éBSGMLƒVƒXƒeƒ€‚ð—p‚¢‚Ä쬂µ‚½XML&processor;‚ÍC”ñŒˆ’è“I“à—eƒ‚ƒfƒ‹‚ð&error;‚Æ‚µ‚Ä‚à‚æ‚¢B

—Ⴆ‚ÎC“à—eƒ‚ƒfƒ‹((b, c) | (b, d))‚Í”ñŒˆ’è“I‚Æ‚È‚éB‚±‚ê‚ÍCʼn‚Éb‚ð—^‚¦‚½‚Æ‚«Cƒ‚ƒfƒ‹“à‚Ì‚¢‚¸‚ê‚Ìb‚Æ&match;‚·‚é‚Ì‚ª–]‚Ü‚µ‚¢‚©C‚»‚ÌŽŸ‚Ì—v‘f‚ðæ“Ç‚Ý‚·‚邱‚Æ‚È‚µ‚É‚ÍC&parser;‚Í’m‚邱‚Æ‚ª‚Å‚«‚È‚¢‚±‚Æ‚É‚æ‚éB‚±‚ÌꇂÍCb‚Ö‚Ì“ñ‚‚̎QÆ‚ÍCˆê‚‚̎QƂɂ܂Ƃ߂邱‚Æ‚ª‚Å‚«Cƒ‚ƒfƒ‹‚ÍC(b, (c | d))‚Æ‚È‚éB‚±‚ê‚ÅCʼn‚Ìb‚ªC“à—eƒ‚ƒfƒ‹“à‚̈ê‚‚̖¼‘O‚Æ‚¾‚¯&match;‚·‚邱‚Æ‚Í–¾‚ç‚©‚Æ‚È‚éB&parser;‚ÍCæ“Ç‚Ý‚µ‚ÄCŽŸ‚É—ˆ‚é‚à‚Ì‚ð’m‚é•K—v‚ª‚È‚¢Bc‚àd‚àCŽó—‚³‚ê‚éB

Œ`Ž®“I‚ÉŽ¦‚·BAho, Sethi, and Ullman ‚Ì3.9‚̃Aƒ‹ƒSƒŠƒYƒ€3.5‚Ì•W€“I‚ȃAƒ‹ƒSƒŠƒYƒ€‚ð—p‚¢‚ÄC“à—eƒ‚ƒfƒ‹‚©‚ç—LŒÀƒI[ƒgƒ}ƒgƒ“‚ð\¬‚·‚邱‚Æ‚ª‚Å‚«‚éB‚±‚ÌŽí‚Ì‘½‚­‚̃Aƒ‹ƒSƒŠƒYƒ€‚Å‚ÍC³‹K•\Œ»‚É‚¨‚¯‚éŠeX‚̈ʒu(‚‚܂èC³‹K•\Œ»‚Ì\•¶–Ø‚É‚¨‚¯‚éŠeX‚Ì––’[ƒm[ƒh)‚ɑ΂µ‚ÄCfollow set(ŽŸ‚ɂǂ̈ʒu‚Ɉړ®‰Â”\‚©‚ð•\‚·‚à‚Ì)‚ð\¬‚·‚éB‚ ‚éˆÊ’u‚ɑ΂·‚éfollow set‚É‚¨‚¢‚ÄC•¡”‚̈ʒu‚ª“¯‚¶—v‘fŒ^–¼‚щƒxƒ‹•t‚¯‚³‚ê‚Ä‚¢‚ê‚ÎC‚»‚Ì“à—eƒ‚ƒfƒ‹‚Í&error;‚Æ‚È‚èC&error;‚ð•Ô‚·ê‡‚à‚ ‚éB

‚·‚ׂĂ̔ñŒˆ’è“I“à—eƒ‚ƒfƒ‹‚𓙉¿‚ÈŒˆ’è“I“à—eƒ‚ƒfƒ‹‚É•ÏŠ·‚·‚邱‚Æ‚Í‚Å‚«‚È‚¢‚ªC‘½‚­‚Ì”ñŒˆ’è“I“à—eƒ‚ƒfƒ‹‚ð•ÏŠ·‚·‚éƒAƒ‹ƒSƒŠƒYƒ€‚ª‘¶Ý‚·‚éBBrüggemann-Klein 1991 ‚ðŽQÆ‚Ì‚±‚ÆB

 •¶Žš•„†‰»‚ÌŽ©“®ŒŸo

XML‚Ì•„†‰»éŒ¾‚ÍCŠeŽÀ‘Ì‚Ì“à•”ƒ‰ƒxƒ‹‚Æ‚µ‚Ä‹@”\‚µC‚Ç‚Ì•¶Žš•„†‰»‚ðŽg—p‚·‚é‚©‚ðŽ¦‚·B‚µ‚©‚µCXML&processor;‚ÍC“à•”ƒ‰ƒxƒ‹‚ð“Ç‚Þ‘O‚ÉC‚Ç‚Ì•¶Žš•„†‰»‚ðŽg—p‚·‚é‚©‚ð’m‚é•K—v‚ª‚ ‚èC‚±‚ꂪC“à•”ƒ‰ƒxƒ‹‚ªŽ¦‚»‚¤‚Æ‚·‚邱‚Æ‚É‚È‚éBˆê”Ê“I‚É‚ÍC‚±‚ê‚ÍCâ–]“I‚Èó‘Ô‚Æ‚È‚éB‚µ‚©‚µCXML‚É‚¨‚¢‚Ä‚ÍCŠ®‘S‚É‚Íâ–]“I‚Å‚Í‚È‚¢B‚±‚ê‚ÍCXML‚ªCŽŸ‚Ì“ñ‚‚̓_‚ňê”Ê“I‚Èꇂɑ΂·‚駌À‚ð‰Á‚¦‚邱‚Æ‚É‚æ‚éBˆê‚‚̧ŒÀ‚ÍC‚Ç‚ÌŽÀ‘•‚à—LŒÀŒÂ‚Ì•¶Žš•„†‰»‚¾‚¯‚̃Tƒ|[ƒg‚ð‘z’è‚·‚邱‚Æ‚Æ‚·‚éB‘¼‚̈ê‚‚̧ŒÀ‚ÍCŠeŽÀ‘Ì‚ÅŽg—p‚·‚镶Žš•„†‰»‚ðŽ©“®ŒŸo‰Â”\‚Æ‚·‚éCXML‚Ì•„†‰»éŒ¾‚̈ʒu‹y‚Ñ“à—e‚ÉŠÖ‚·‚駌À‚Æ‚·‚éB‘½‚­‚ÌꇂÉCXML‚̃f[ƒ^ƒXƒgƒŠ[ƒ€‚ɉÁ‚¦C‘¼‚Ìî•ñ‚ª—˜—p‚Å‚«‚éB‚±‚±‚Å‚ÍCXML‚ÌŽÀ‘Ì‚ª&processor;‚É“n‚³‚ê‚é‚Æ‚«C(ŠO•”)î•ñ‚𔺂¤‚©‚Ç‚¤‚©‚É‚æ‚Á‚ÄC“ñ‚‚Ìꇂɕª‚¯‚éB‚Ü‚¸Å‰‚Ìê‡‚ðŽ¦‚·B

UTF-8Œ`Ž®–”‚ÍUTF-16Œ`Ž®‚Å‚Í‚È‚¢XMLŽÀ‘Ì‚ÍCʼn‚Ì•¶Žš‚ðe<?xml'‚Æ‚·‚éXML•„†‰»éŒ¾‚ÅŽn‚Ü‚ç‚È‚¯‚ê‚΂Ȃç‚È‚¢‚Ì‚ÅC‚Ç‚Ì“K‡‚µ‚½&processor;‚àC“ü—Í‚É‚ ‚é2ƒIƒNƒeƒbƒg–”‚Í4ƒIƒNƒeƒbƒg‚𒲂ׂê‚ÎCŽŸ‚Ì‚Ç‚Ìꇂª‚ ‚Ä‚Í‚Ü‚é‚©‚ðŒŸo‚Å‚«‚éB‚±‚̃ŠƒXƒg‚ð“Ç‚ÞÛ‚É‚ÍCUCS-4‚Ì'<'‚ª"#x0000003C"C'?'‚ª"#x0000003F"C‹y‚ÑUTF-16‚̃f[ƒ^&stream;‚Ì•K—v‚Æ‚·‚é&byte-order-mark;‚ª"#xFEFF"‚Æ‚¢‚¤‚±‚Æ‚ð’m‚Á‚Ä‚¨‚­‚Ɩ𗧂‚©‚à‚µ‚ê‚È‚¢B

a) 00 00 00 3C: UCS-4, big-endian ƒ}ƒVƒ“ (1234‡)

b) 3C 00 00 00: UCS-4, little-endian ƒ}ƒVƒ“ (4321‡)

c) 00 00 3C 00: UCS-4, •’Ê‚Å‚Í‚È‚¢ƒIƒNƒeƒbƒg‡ (2143)

d) 00 3C 00 00: UCS-4, •’Ê‚Å‚Í‚È‚¢ƒIƒNƒeƒbƒg‡ (3412)

e) FE FF: UTF-16, big-endian

f) FF FE: UTF-16, little-endian

g) 00 3C 00 3F: UTF-16, big-endian, &byte-order-mark;‚È‚µ(‚µ‚½‚ª‚Á‚ÄCŒµ–§‚É‚¢‚¦‚ÎC&error;‚Æ‚·‚éB)B

h) 3C 00 3F 00: UTF-16, little-endian, &byte-order-mark;‚È‚µ(‚µ‚½‚ª‚Á‚ÄCŒµ–§‚É‚¢‚¦‚ÎC&error;‚Æ‚·‚éB)B

i) 3C 3F 78 6D: UTF-8, ISO 646, ASCII, ISO 8859‚ÌŠeƒp[ƒgCShift-JISCEUCC•À‚Ñ‚É”CˆÓ‚Ì‘¼‚Ì7ƒrƒbƒgC8ƒrƒbƒg–”‚ͬݕ‚Ì•„†‰»‚Å‚ ‚Á‚ÄCASCII•¶Žš‚ð’Êí‚̈ʒuC•‹y‚Ñ’l‚Æ‚·‚邱‚Æ‚ð•ÛØ‚·‚é‚à‚ÌB‚±‚ê‚ç‚Ì‚Ç‚ê‚ɑΉž‚·‚é‚©‚ðŒŸo‚·‚邽‚ß‚É‚ÍCŽÀÛ‚Ì•„†‰»éŒ¾‚ð“Ç‚Ýž‚Ü‚È‚¯‚ê‚΂Ȃç‚È‚¢B‚µ‚©‚µC‚±‚ê‚ç‚·‚ׂĂ̕„†‰»‚ÍCASCII•¶Žš‚ɑ΂µ‚Ä“¯‚¶ƒrƒbƒgƒpƒ^[ƒ“‚ðŽg—p‚·‚é‚Ì‚ÅC•„†‰»éŒ¾Ž©‘Ì‚ÍC³Šm‚É“Çž‚݉”\‚Æ‚·‚éB

j) 4C 6F A7 94: EBCDIC (–”‚Í‚»‚Ì•ÏŽíB‚ǂ̃R[ƒhƒy[ƒW‚ðŽg—p‚·‚é‚©‚ð’m‚邽‚ß‚É‚ÍC•„†‰»éŒ¾‘S‘Ì‚ð“Ç‚Ýž‚Ü‚ê‚È‚¯‚ê‚΂Ȃç‚È‚¢B)

k) ‚»‚Ì‘¼: •„†‰»éŒ¾‚È‚µ‚ÌUTF-8B‚»‚¤‚Å‚È‚¢‚Æ‚«‚É‚ÍCƒf[ƒ^&stream;‚ª‰ó‚ê‚Ä‚¢‚é‚©C’f•Ð“I‚É‚È‚Á‚Ä‚¢‚é‚©C‰½‚ç‚©‚ÌŒ`Ž®‚É‚µ‚½‚ª‚Á‚Ä–„‚ßž‚Ü‚ê‚Ä‚¢‚éB

‚±‚Ì’ö“x‚ÌŽ©“®”»•Ê‚Å‚àCXML‚Ì•„†‰»éŒ¾‚ð“Ç‚Ýž‚ÝC•¶Žš•„†‰»‚Ì&identifier;‚ð‰ðÍ‚·‚é‚É‚Í\•ª‚Æ‚·‚éB&identifier;‚̉ðÍ‚ÍC—ÞŽ—‚·‚éŠeX‚Ì•„†‰»‚̈ꂈꂂð‹æ•Ê‚·‚邽‚ß‚É•K—v‚Æ‚·‚é(—Ⴆ‚ÎCUTF-8‹y‚Ñ8859‚ð‹æ•Ê‚·‚邽‚ßC8859‚ÌŠeƒp[ƒg‚ð‹æ•Ê‚·‚邽‚ßCŽg—p‚µ‚Ä‚¢‚é“Á’è‚ÌEBCDICƒR[ƒhƒy[ƒW‚ð‹æ•Ê‚·‚邽‚ßC‚È‚ÇB)B

•„†‰»éŒ¾‚Ì“à—e‚ðASCII•¶Žš‚ÉŒÀ’肵‚Ä‚¢‚é‚Ì‚ÅC‚Ç‚Ì•ª—Þ‚Ì•„†‰»‚ðŽg—p‚·‚é‚©‚ðŒŸo‚·‚ê‚ÎC&processor;‚ÍC•„†‰»éŒ¾‘S‘Ì‚ð³Šm‚É“Ç‚Ýž‚Þ‚±‚Æ‚ª‚Å‚«‚éBŒ»ŽÀ–â‘è‚Æ‚µ‚ÄCL‚­Žg—p‚³‚ê‚Ä‚¢‚镶Žš•„†‰»‚ÍCã‚Ì•ª—Þ‚Ì‚¢‚¸‚ê‚©‚É‚ ‚Ä‚Í‚Ü‚é‚Ì‚ÅCƒIƒyƒŒ[ƒeƒBƒ“ƒOƒVƒXƒeƒ€–”‚Í“`‘—ƒvƒƒgƒRƒ‹‚ª—^‚¦‚éŠO•”î•ñ‚ðM—Š•s‰Â”\‚È‚Æ‚«‚Å‚³‚¦‚àC“à•”ƒ‰ƒxƒ‹‚Å•¶Žš•„†‰»‚ð‚©‚È‚è³Šm‚ÉŽ¦‚·‚±‚Æ‚ªCXML•„†‰»éŒ¾‚É‚æ‚Á‚ĉ”\‚Æ‚È‚éB

&processor;‚ªŽg—p‚·‚镶Žš•„†‰»‚ðŒŸo‚µ‚³‚¦‚·‚ê‚ÎC‚»‚ꂼ‚ê‚Ìꇂɑ΂µ‚ĕʌ‚̓ü—̓‹[ƒ`ƒ“‚ðŒÄ‚Ño‚·C–”‚Í“ü—Í‚·‚éŠe•¶Žš‚ɑ΂µ“KØ‚È•ÏŠ·ŠÖ”‚ðŒÄ‚Ño‚·‚±‚Æ‚É‚æ‚Á‚ÄC“KØ‚È“®ì‚ª‰Â”\‚Æ‚È‚éB

Ž©•ªŽ©‘̂Ƀ‰ƒxƒ‹•t‚¯‚ð‚·‚é‚¢‚©‚È‚éƒVƒXƒeƒ€‚Å‚à“¯—l‚¾‚ªCƒ\ƒtƒgƒEƒFƒA‚ªC•„†‰»éŒ¾‚ðXV‚¹‚¸‚ÉŽÀ‘Ì‚Ì•¶ŽšW‡–”‚Í•„†‰»‚ð•Ï‚¦‚½‚È‚ç‚ÎCXML‚Ì•„†‰»éŒ¾‚ÍC‹@”\‚µ‚È‚¢B•¶Žš•„†‰»ƒ‹[ƒ`ƒ“‚ÌŽÀ‘•ŽÒ‚ÍCŽÀ‘̂̃‰ƒxƒ‹•t‚¯‚ÉŽg—p‚·‚é“à•”‹y‚ÑŠO•”‚Ìî•ñ‚̳Šm‚³‚Ì•ÛØ‚É’ˆÓ‚·‚é‚Ì‚ª–]‚Ü‚µ‚¢B

‚Q”Ô–Ú‚ÌꇂÍCXML‚ÌŽÀ‘Ì‚Ì‘¼‚ÉC•„†‰»î•ñ‚ª‘¶Ý‚·‚é‚Æ‚«‚Å‚ ‚Á‚ÄC‚¢‚­‚‚©‚̃tƒ@ƒCƒ‹ƒVƒXƒeƒ€‹y‚уlƒbƒgƒ[ƒNƒvƒƒgƒRƒ‹‚Å‚ÍC‚»‚Ì•„†‰»î•ñ‚ª‘¶Ý‚·‚éB•¡”‚Ìî•ñ‚ª—˜—p‚Å‚«‚é‚Æ‚«C‚»‚ê‚ç‚Ì‘Š‘ΓI‚È—Dæ“x‹y‚Ñ‚»‚ê‚炪–µ‚‚µ‚½‚Æ‚«‚Ì–]‚Ü‚µ‚¢ˆ—•û–@‚ÍCXML‚Ì”z‘—‚ÉŽg—p‚·‚éC‚æ‚è‚…€‚̃vƒƒgƒRƒ‹‚̈ꕔ‚Æ‚µ‚Ä‹K’ö‚·‚é‚Ì‚ª‚æ‚¢B—Ⴆ‚ÎC“à•”ƒ‰ƒxƒ‹‹y‚ÑŠO•”&header;‚É‘¶Ý‚·‚éMIMEŒ`Ž®‚̃‰ƒxƒ‹‚Ì‘Š‘ΓI‚È—Dæ“x‚ɑ΂·‚é‹K‘¥‚ÍCtext/xml‹y‚Ñapplication/xml‚ÌMIMEŒ^‚ð’è‹`‚·‚éRFC•¶‘‚̈ꕔ‚Æ‚È‚é•û‚ª‚æ‚¢B‚µ‚©‚µC‘ŠŒÝ‰^—p«‚Ì‚½‚ß‚ÉCŽŸ‚Ì‹K‘¥‚É]‚¤‚±‚Æ‚ª–]‚Ü‚µ‚¢B

a) XML‚ÌŽÀ‘Ì‚ªƒtƒ@ƒCƒ‹‚É‘¶Ý‚·‚ê‚ÎC&byte-order-mark;‹y‚Ñ•„†‰»éŒ¾PI‚ÍC(‘¶Ý‚·‚ê‚Î)•¶Žš•„†‰»‚ðŒˆ’è‚·‚邽‚ß‚ÉŽg—p‚·‚éB‘¼‚Ì‚·‚ׂĂÌ&hueristics;‹y‚Ñî•ñ‚ÍC&error;‰ñ•œ‚Ì‚½‚ß‚¾‚¯‚É—p‚¢‚éB

b) XML‚ÌŽÀ‘Ì‚ðMIMEŒ^text/xml‚Å”z‘—‚·‚é‚Æ‚«‚ÍC‚±‚ÌMIMEŒ^‚Ì‚à‚Âcharsetƒpƒ‰ƒƒ^‚ª•¶Žš•„†‰»•û–@‚ðŒˆ’è‚·‚éB‘¼‚Ì‚·‚ׂĂÌ&hueristics;‹y‚Ñî•ñ‚ÍC&error;‰ñ•œ‚Ì‚½‚ß‚¾‚¯‚É—p‚¢‚éB

c) XML‚ÌŽÀ‘Ì‚ð MIMEŒ^application/xml‚Å”z‘—‚·‚é‚Æ‚«‚ÍC&byte-order-mark;‹y‚Ñ•„†‰»éŒ¾PI‚ð(‘¶Ý‚·‚ê‚Î)•¶Žš•„†‰»‚ÌŒˆ’è‚Ì‚½‚ß‚ÉŽg—p‚·‚éB‘¼‚Ì‚·‚ׂĂÌ&hueristics;‹y‚Ñî•ñ‚Í&error;‰ñ•œ‚Ì‚½‚ß‚¾‚¯‚É—p‚¢‚éB

‚±‚ê‚ç‚Ì‹K‘¥‚ÍCƒvƒƒgƒRƒ‹‚ɂ‚¢‚Ä‚ÌŽ‘—¿‚ª‚È‚¢‚Æ‚«‚É‚¾‚¯—p‚¢‚éB“Á‚ÉCMIMEŒ^text/xml‹y‚Ñapplication/xml‚ð’è‹`‚µ‚½‚çC‚±‚ê‚ç‚ð‹K’è‚·‚éRFC‚É‘¶Ý‚·‚é‹K’肪C‚±‚ê‚ç‚Ì‹K‘¥‚ÉŽæ‚Á‚Ä‘ã‚í‚éB

&informative;W3C XML ƒ[ƒLƒ“ƒOƒOƒ‹[ƒv

‚±‚Ì&TR-or-Rec;‚ÍCW3C XML ƒ[ƒLƒ“ƒOƒOƒ‹[ƒv(WG)‚ª€”õ‚µCŒöŠJ‚ð³”F‚µ‚½BWG‚ª‚±‚Ì&TR-or-Rec;‚ð³”F‚·‚é‚Æ‚¢‚¤‚±‚Æ‚ÍCWG‚Ì‚·‚ׂĂ̈ψõ‚ª³”F“Š•[‚ðs‚Á‚½‚Æ‚¢‚¤‚±‚Æ‚ð•K‚¸‚µ‚àˆÓ–¡‚µ‚È‚¢BXML WG‚ÌŒ»Ý‚̈ψõ‹y‚шȑO‚̈ψõ‚ðŽŸ‚ÉŽ¦‚·B

Jon Bosak, SunChair James ClarkTechnical Lead Tim Bray, Textuality and NetscapeXML Co-editor Jean Paoli, MicrosoftXML Co-editor C. M. Sperberg-McQueen, U. of Ill.XML Co-editor Dan Connolly, W3C Steve DeRose, INSO Dave Hollander, HP Eliot Kimber, Highland Eve Maler, ArborText Tom Magliery, NCSA Murray Maloney, Muzmo and Grif ‘º“c@^C•xŽmƒ[ƒƒbƒNƒXî•ñƒVƒXƒeƒ€(Š”) Joel Nava, Adobe Peter Sharpe, SoftQuad John Tigue, DataChannel hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/pr-xml-euc-jp.xml0000644006511100651110000054320710504340461026724 0ustar rossross "> '"> amp, lt, gt, apos, quot"> ]>
³ÈÄ¥²Äǽ¤Ê&markup;¸À¸ì (XML) Âè1.0&version; PR-xml-&iso6.doc.date; World Wide Web Consortium &draft.day;&draft.month;&draft.year;

¤³¤ÎÁð°Æ¤Ï¡¤XML WGµÚ¤Ó¾¤Î´Ø·¸¼Ô¤Ë¤è¤ë¥ì¥Ó¥å¡¼¤Î¤¿¤á¤Î¤â¤Î¤Ç¤¢¤Ã¤Æ¡¤¸ø³«¤ÎµÄÏÀ¤Î¤¿¤á¤Î¤â¤Î¤Ç¤Ï¤Ê¤¤¡£

http://www.w3.org/TR/PR-xml-&iso6.doc.date; http://www.w3.org/TR/WD-xml-961114 http://www.w3.org/TR/WD-xml-lang-970331 http://www.w3.org/TR/WD-xml-lang-970630 http://www.w3.org/TR/WD-xml-970807 http://www.w3.org/TR/WD-xml-971117 Tim Bray Textuality and Netscape tbray@textuality.com Jean Paoli Microsoft jeanpa@microsoft.com C. M. Sperberg-McQueen University of Illinois at Chicago cmsmcq@uic.edu

¤³¤Î&TR-or-Rec;¤Ï, 1997ǯ12·î¤ËWorld Wide Web Consortium¤«¤é ¸øɽ¤µ¤ì¤¿´«¹ð°ÆExtensible Markup Language versionÂè1.0ÈǤòËÝÌõ¤·, µ» ½ÑŪÆâÍƤòÊѹ¹¤¹¤ë¤³¤È¤Ê¤¯ºîÀ®¤·¤¿&TR-or-Rec;¤Ç¤¢¤ë¡£This &eTR-or-Rec; is a translation of the XML proposed recommendation 1.0 published by the World Wide Web Consortium in December 1997. It is intended that &eTR-or-Rec; is technically identical to the original.

¸¶Ê¸¤Ë¤¢¤ë¡¢Ãøºî¸¢¤Ë´Ø¤·¤Æ¤Îµ­½Ò¤ò¼¡¤Ë¼¨¤¹¡£The original copyright notice is shown below:

¤³¤ÎÈǤÎXML¤Îµ¬Äê¤Ï¡¤¸ø³«¥ì¥Ó¥å¡¼µÚ¤ÓµÄÏÀ¤ò ÌÜŪ¤È¤¹¤ë¡£¥Æ¥­¥¹¥ÈµÚ¤ÓˡΧ¾å¤ÎÃí°Õ¤ò²þÊѤ·¤Ê¤¤¸Â¤ê¡¤¼«Í³¤Ë ÇÛÉÛ¤·¤Æ¤â¤è¤¤¡£This version of the XML specification is for public review and discussion. It may be distributed freely, as long as all text and legal notices remain intact.

¤³¤Î&TR-or-Rec;¤Î¸µ¤È¤Ê¤Ã¤¿XML´«¹ð°Æ¤Ï¡¤1998ǯ2·î¤ËWorld Wide Web Consortium¤«¤é¸øɽ¤µ¤ì¤¿XML´«¹ð¤Ë¤è¤Ã¤Æ¤¹¤Ç¤ËÃÖ¤­´¹ ¤¨¤é¤ì¤Æ¤¤¤ë¡£¤³¤Îɸ½à¾ðÊó¤Ï¡¤XML´«¹ð¤Ë½¾¤Ã¤ÆÄûÀµ¤¹¤ë¤³¤È¤ò ͽÄꤷ¤Æ¤¤¤ë¡£The XML Proposed Recommendation is superseded by the XML Recommendation which was published by the World Wide Web Consortium in February 1998. It is intended that this &eTR-or-Rec; be revised accordingly in the near future.

¤³¤Î&TR-or-Rec;¤Ï¡¤°ÂÄꤷ¤¿¤â¤Î¤Ç¤¢¤Ã¤Æ¡¤ºòǯÍè¤ÎXML³èÆ°¤òÄ̤¸¤ÆºîÀ®¤µ¤ì¤¿¡¤°ìÏ¢¤Îºî ¶ÈÁð°Æ¤ò¸µ¤È¤¹¤ë¡£¸½ºß¡¤¹­ÈϰϤ˻ÈÍѤµ¤ì¤Æ¤¤¤ë¹ñºÝŪ¤Ê¥Æ¥­¥¹¥È½èÍý¤Îɸ ½à(ɸ½à°ìÈ̲½&markup;¸À¸ì¡¤Standard Generalized Markup Language, ISO 8879:1986¤ËÄɲõڤÓÄûÀµ¤ò²Ã¤¨¤¿¤â¤Î)¤Î¡¤WWW¾å¤Ç¤Î»ÈÍѤΤ¿¤á¤Ë⊂ ²½¤·¤¿¸À¸ì¤ò¡¤¤³¤Î&TR-or-Rec;¤Ï¡¤µ¬Äꤹ¤ë¡£ISO 8879¤Î¤É¤Îµ¡Ç½¤ò¤³¤Î ⊂¤Ë»Ä¤¹¤«¡¤¤È¤¤¤¦·èÄê¤Ë¤Ä¤¤¤Æ¤Î¾ÜºÙ¤Ï¡¤ÊÌÅÓÍÑ°Õ¤¹¤ë¡£XML¤Ï¡¤ ´û¤Ë¤¤¤¯¤Ä¤«¤Î¾¦Éʤǥµ¥Ý¡¼¥È¤µ¤ì¡¤XML¤ò¥µ¥Ý¡¼¥È¤¹¤ë¥Õ¥ê¡¼¥¦¥§¥¢¤Î¿ô¤âÁý¤¨¤Æ ¤¤¤ë¡£XML¤Ë´Ø¤¹¤ë¸ø³«¤ÎÏÀµÄ¤â¡¤¥ª¥ó¥é¥¤¥ó¤ÇÆþ¼ê¤Ç¤­¤ë¡£It is a stable document derived from a series of working drafts produced over the last year as deliverables of the XML activity. It specifies a language created by subsetting an existing, widely used international text processing standard (Standard Generalized Markup Language, ISO 8879:1986 as amended and corrected) for use on the World Wide Web. Details of the decisions regarding which features of ISO 8879 to retain in the subset are available separately. XML is already supported by some commercial products, and there are a growing number of free implementations. Public discussions of XML are accessible online.

¤³¤Î&TR-or-Rec;¤Ç¤Ï¡¤¤ËÄêµÁ¤¹¤ë URI(Uniform Resource Identifier)¤ò»ÈÍѤ¹¤ë¡£URI¤ÎÀ©Äêºî¶È¤Ï¿Ê¹ÔÃæ¤Ç¤¢¤Ã ¤Æ¡¤µÚ¤Ó¤ò¹¹¿·¤¹¤ëͽÄê¤È ¤Ê¤Ã¤Æ¤¤¤ë¡£¤³¤Îºî¶È¤¬RFC¤È¤·¤Æ¼õ¤±Æþ¤ì¤é¤ì¤Ê¤¤¾ì¹ç¤Ï¡¤¤³¤Îµ¬ÄøÆâ¤ÎURI ¤Ø¤Î»²¾È¤Ï¡¤URL(Uniform Resource Locator)¤Ø¤Î»²¾È¤ËÂå¤ï¤ë¡£This specification uses the term URI, which is defined by , a work in progress expected to update and . Should the work not be accepted as an RFC, the references to uniform resource identifiers (URIs) in this specification will become references to uniform resource locators (URLs).

XML¤Î»ÅÍͤ˽àµò¤·¤Æ¤¤¤ë¤«¤É¤¦¤«¤Î´ð½à¤È¤Ê¤ë¤ÏW3C¤Î¥µ¥¤¥È¤Ë¤¢ ¤ë¸¶Ê¸¤Ç¤¢¤ë¡£The normative version of the specification is the English version found at the W3C site.

¤³¤Îɸ½à¾ðÊó¤Ï¸¶»ÅÍͤȵ»½ÑŪ¤ËƱ°ì¤Ç¤¢¤ë¤³¤È¤ò°Õ¿Þ¤·¤Æ¤¤¤ë¤¬¡¢ ËÝÌõ¾å¤Î¸í¤ê¤Ï¤¢¤êÆÀ¤ë¡£Although this technical report is intended to be technically identical to the original, it may contain errors from the translation.

È÷¹Í: ¸¶µ¬Äê¤È¤Îµ¬Äê²Õ½ê¤ÎÂбþ´Ø·¸¤òÌÀ¤é¤«¤Ë¤¹¤ë¤¿¤á¡¢¤³¤Î &TR-or-Rec;¤ÎÀá¹½À®µÚ¤ÓÀáÈÖ¹æ¤Ï¡¢¸¶µ¬Äê¤Î¤½¤ì¤é¤ò¤Ç¤­¤ë¤À¤±Êݸ¤·¤Æ¤¤ ¤ë¡£¤³¤Î&TR-or-Rec;¤ÎWebÈǤϡ¢¸¶µ¬Äê¤ÎHTML¥¿¥°¤ò¤½¤Î¤Þ¤ÞÊݸ¤·¤Æ¤¤¤ë¡£

³ÈÄ¥²Äǽ¤Ê&markup;¸À¸ì(XML)¤ÏSGML¤Î´Êñ¤ÊÊý¸À¤Ç¤¢¤Ã¤Æ¡¤¤³¤Î&TR-or-Rec;¤Ç¡¤¤½¤Î¤¹¤Ù¤Æ¤òµ¬Äꤹ¤ë¡£XML¤ÎÌÜɸ¤Ï¡¤¸½ºß¤ÎHTML¤ÈƱÍͤˡ¤°ìÈÌÀ­¤Î¤¢¤ëSGML¤ò¥¦¥§¥Ö¾å¤ÇÇÛÉÛ¡¤¼õ¿®µÚ¤Ó½èÍý¤Ç¤­¤ë¤³¤È¤È¤¹¤ë¡£XML¤Ï¼ÂÁõ¤¬ÍưפǤ¢¤Ã¤Æ¡¤SGMLµÚ¤ÓHTML¤Î¤É¤Á¤é¤ËÂФ·¤Æ¤âÁê¸ß±¿ÍÑÀ­¤òÊݤÄÀ߷פ¬¤Ê¤µ¤ì¤Æ¤¤¤ë¡£

Chicago, Vancouver, Mountain View, et al.: World-Wide Web Consortium, XMLºî¶È¥°¥ë¡¼¥×, 1996, 1997.

Created in electronic form.

 English Extended Backus-Naur Form (formal grammar) 1997-12-03 : CMSMcQ : yet further changes 1997-12-02 : TB : further changes (see TB to XML WG, 2 December 1997) 1997-12-02 : CMSMcQ : deal with as many corrections and comments from the proofreaders as possible: entify hard-coded document date in pubdate element, change expansion of entity WebSGML, update status description as per Dan Connolly (am not sure about refernece to Berners-Lee et al.), add 'The' to abstract as per WG decision, move Relationship to Existing Standards to back matter and combine with References, re-order back matter so normative appendices come first, re-tag back matter so informative appendices are tagged informdiv1, remove XXX XXX from list of 'normative' specs in prose, move some references from Other References to Normative References, add RFC 1738, 1808, and 2141 to Other References (they are not normative since we do not require the processor to enforce any rules based on them), add reference to 'Fielding draft' (Berners-Lee et al.), move notation section to end of body, drop URIchar non-terminal and use SkipLit instead, lose stray reference to defunct nonterminal 'markupdecls', move reference to Aho et al. into appendix (Tim's right), add prose note saying that hash marks and fragment identifiers are NOT part of the URI formally speaking, and are NOT legal in system identifiers (processor 'may' signal an error). Work through: Tim Bray reacting to James Clark, Tim Bray on his own, Eve Maler, NOT DONE YET: change binary / text to unparsed / parsed. handle James's suggestion about < in attriubte values uppercase hex characters, namechar list, 1997-12-01 : JB : add some column-width parameters 1997-12-01 : CMSMcQ : begin round of changes to incorporate recent WG decisions and other corrections: binding sources of character encoding info (27 Aug / 3 Sept), correct wording of Faust quotation (restore dropped line), drop SDD from EncodingDecl, change text at version number 1.0, drop misleading (wrong!) sentence about ignorables and extenders, modify definition of PCData to make bar on msc grammatical, change grammar's handling of internal subset (drop non-terminal markupdecls), change definition of includeSect to allow conditional sections, add integral-declaration constraint on internal subset, drop misleading / dangerous sentence about relationship of entities with system storage objects, change table body tag to htbody as per EM change to DTD, add rule about space normalization in public identifiers, add description of how to generate our name-space rules from Unicode character database (needs further work!). 1997-10-08 : TB : Removed %-constructs again, new rules for PE appearance. 1997-10-01 : TB : Case-sensitive markup; cleaned up element-type defs, lotsa little edits for style 1997-09-25 : TB : Change to elm's new DTD, with substantial detail cleanup as a side-effect 1997-07-24 : CMSMcQ : correct error (lost *) in definition of ignoreSectContents (thanks to Makoto Murata) Allow all empty elements to have end-tags, consistent with SGML TC (as per JJC). 1997-07-23 : CMSMcQ : pre-emptive strike on pending corrections: introduce the term 'empty-element tag', note that all empty elements may use it, and elements declared EMPTY must use it. Add WFC requiring encoding decl to come first in an entity. Redefine notations to point to PIs as well as binary entities. Change autodetection table by removing bytes 3 and 4 from examples with Byte Order Mark. Add content model as a term and clarify that it applies to both mixed and element content. 1997-06-30 : CMSMcQ : change date, some cosmetic changes, changes to productions for choice, seq, Mixed, NotationType, Enumeration. Follow James Clark's suggestion and prohibit conditional sections in internal subset. TO DO: simplify production for ignored sections as a result, since we don't need to worry about parsers which don't expand PErefs finding a conditional section. 1997-06-29 : TB : various edits 1997-06-29 : CMSMcQ : further changes: Suppress old FINAL EDIT comments and some dead material. Revise occurrences of % in grammar to exploit Henry Thompson's pun, especially markupdecl and attdef. Remove RMD requirement relating to element content (?). 1997-06-28 : CMSMcQ : Various changes for 1 July draft: Add text for draconian error handling (introduce the term Fatal Error). RE deleta est (changing wording from original announcement to restrict the requirement to validating parsers). Tag definition of validating processor and link to it. Add colon as name character. Change def of %operator. Change standard definitions of lt, gt, amp. Strip leading zeros from #x00nn forms. 1997-04-02 : CMSMcQ : final corrections of editorial errors found in last night's proofreading. Reverse course once more on well-formed: Webster's Second hyphenates it, and that's enough for me. 1997-04-01 : CMSMcQ : corrections from JJC, EM, HT, and self 1997-03-31 : Tim Bray : many changes 1997-03-29 : CMSMcQ : some Henry Thompson (on entity handling), some Charles Goldfarb, some ERB decisions (PE handling in miscellaneous declarations. Changed Ident element to accept def attribute. Allow normalization of Unicode characters. move def of systemliteral into section on literals. 1997-03-28 : CMSMcQ : make as many corrections as possible, from Terry Allen, Norbert Mikula, James Clark, Jon Bosak, Henry Thompson, Paul Grosso, and self. Among other things: give in on "well formed" (Terry is right), tentatively rename QuotedCData as AttValue and Literal as EntityValue to be more informative, since attribute values are the only place QuotedCData was used, and vice versa for entity text and Literal. (I'd call it Entity Text, but 8879 uses that name for both internal and external entities.) 1997-03-26 : CMSMcQ : resynch the two forks of this draft, reapply my changes dated 03-20 and 03-21. Normalize old 'may not' to 'must not' except in the one case where it meant 'may or may not'. 1997-03-21 : TB : massive changes on plane flight from Chicago to Vancouver 1997-03-21 : CMSMcQ : correct as many reported errors as possible. 1997-03-20 : CMSMcQ : correct typos listed in CMSMcQ hand copy of spec. 1997-03-20 : CMSMcQ : cosmetic changes preparatory to revision for WWW conference April 1997: restore some of the internal entity references (e.g. to docdate, etc.), change character xA0 to &nbsp; and define nbsp as &#160;, and refill a lot of paragraphs for legibility. 1996-11-12 : CMSMcQ : revise using Tim's edits: Add list type of NUMBERED and change most lists either to BULLETS or to NUMBERED. Suppress QuotedNames, Names (not used). Correct trivial-grammar doc type decl. Rename 'marked section' as 'CDATA section' passim. Also edits from James Clark: Define the set of characters from which [^abc] subtracts. Charref should use just [0-9] not Digit. Location info needs cleaner treatment: remove? (ERB question). One example of a PI has wrong pic. Clarify discussion of encoding names. Encoding failure should lead to unspecified results; don't prescribe error recovery. Don't require exposure of entity boundaries. Ignore white space in element content. Reserve entity names of the form u-NNNN. Clarify relative URLs. And some of my own: Correct productions for content model: model cannot consist of a name, so "elements ::= cp" is no good. 1996-11-11 : CMSMcQ : revise for style. Add new rhs to entity declaration, for parameter entities. 1996-11-10 : CMSMcQ : revise for style. Fix / complete section on names, characters. Add sections on parameter entities, conditional sections. Still to do: Add compatibility note on deterministic content models. Finish stylistic revision. 1996-10-31 : TB : Add Entity Handling section 1996-10-30 : TB : Clean up term & termdef. Slip in ERB decision re EMPTY. 1996-10-28 : TB : Change DTD. Implement some of Michael's suggestions. Change comments back to //. Introduce language for XML namespace reservation. Add section on white-space handling. Lots more cleanup. 1996-10-24 : CMSMcQ : quick tweaks, implement some ERB decisions. Characters are not integers. Comments are /* */ not //. Add bibliographic refs to 10646, HyTime, Unicode. Rename old Cdata as MsData since it's only seen in marked sections. Call them attribute-value pairs not name-value pairs, except once. Internal subset is optional, needs '?'. Implied attributes should be signaled to the app, not have values supplied by processor. 1996-10-16 : TB : track down & excise all DSD references; introduce some EBNF for entity declarations. 1996-10-?? : TB : consistency check, fix up scraps so they all parse, get formatter working, correct a few productions. 1996-10-10/11 : CMSMcQ : various maintenance, stylistic, and organizational changes: Replace a few literals with xmlpio and pic entities, to make them consistent and ensure we can change pic reliably when the ERB votes. Drop paragraph on recognizers from notation section. Add match, exact match to terminology. Move old 2.2 XML Processors and Apps into intro. Mention comments, PIs, and marked sections in discussion of delimiter escaping. Streamline discussion of doctype decl syntax. Drop old section of 'PI syntax' for doctype decl, and add section on partial-DTD summary PIs to end of Logical Structures section. Revise DSD syntax section to use Tim's subset-in-a-PI mechanism. 1996-10-10 : TB : eliminate name recognizers (and more?) 1996-10-09 : CMSMcQ : revise for style, consistency through 2.3 (Characters) 1996-10-09 : CMSMcQ : re-unite everything for convenience, at least temporarily, and revise quickly 1996-10-08 : TB : first major homogenization pass 1996-10-08 : TB : turn "current" attribute on div type into CDATA 1996-10-02 : TB : remould into skeleton + entities 1996-09-30 : CMSMcQ : add a few more sections prior to exchange with Tim. 1996-09-20 : CMSMcQ : finish transcribing notes. 1996-09-19 : CMSMcQ : begin transcribing notes for draft. 1996-09-13 : CMSMcQ : made outline from notes of 09-06, do some housekeeping
°ìÈÌ»ö¹à

³ÈÄ¥²Äǽ¤Ê&markup;¸À¸ìXML(eXtensible Markup Language)¤Ï¡¤XMLʸ½ñ¤È¤¤¤¦¥Ç¡¼¥¿¥ª¥Ö¥¸¥§¥¯¥È¤Î¥¯¥é¥¹¤òµ¬Äꤷ¡¤XMLʸ½ñ¤ò½èÍý¤¹¤ë¥×¥í¥°¥é¥à¤ÎÆ°ºî¤Î°ìÉô¤òµ¬Äꤹ¤ë¡£XML¤Ï¡¤SGML(ɸ½à°ìÈ̲½&markup;¸À¸ì¡¤Standard Generalized Markup Language)¤ÎÀ©¸Â¤·¤¿⊂¤È¤¹¤ë¡£¹½Â¤¾å¡¤XMLʸ½ñ¤Ï¡¤¤«¤Ê¤é¤ºSGMLµ¬³Ê¤ËŬ¹ç¤¹¤ë¡£

XMLʸ½ñ¤Ï¡¤¼ÂÂΤȤ¤¤¦µ­²±Ã±°Ì¤«¤é¤Ê¤ê¡¤¼ÂÂΤϡ¤&parsed-data;Ëô¤Ï&unparsed-data;¤«¤é¤Ê¤ë¡£&parsed-data;¤Ï¡¤Ê¸»ú¤«¤é¤Ê¤ê¡¤¤½¤Î°ìÉô¤Ï¡¤Ê¸½ñ¤Îʸ»ú¥Ç¡¼¥¿¤ò¹½À®¤·¡¤°ìÉô¤Ï¡¤&markup;¤ò¹½À®¤¹¤ë¡£&markup;¤Ï¡¤Ê¸½ñ¤Îµ­²±¥ì¥¤¥¢¥¦¥ÈµÚ¤ÓÏÀÍý¹½Â¤¤Ë¤Ä¤¤¤Æ¤Îµ­½Ò¤òɽ¤¹Éä¹æ¤È¤¹¤ë¡£XML¤Ï¡¤µ­²±¥ì¥¤¥¢¥¦¥ÈµÚ¤ÓÏÀÍý¹½Â¤¤Ë¤Ä¤¤¤Æ¤ÎÀ©Ìó¾ò·ï¤òµ­½Ò¤¹¤ëµ¡¹½¤òÄ󶡤¹¤ë¡£

XML&processor;¤È¤¤¤¦¥½¥Õ¥È¥¦¥§¥¢¥â¥¸¥å¡¼¥ë¤Ï¡¤XMLʸ½ñ¤òÆɤ߹þ¤ß¡¤¤½¤ÎÆâÍƵڤӹ½Â¤¤Ø¤Î¥¢¥¯¥»¥¹¤òÄ󶡤¹¤ë¤¿¤á¤ËÍѤ¤¤ë¡£ XML&processor;¤Ï¡¤Â¾¤Î¥â¥¸¥å¡¼¥ë¤Î¤¿¤á¤ËÆ°ºî¤¹¤ë¤³¤È¤òÁ°Äó¤È¤·¡¤¤½¤Î¥â¥¸¥å¡¼¥ë¤ò&application;¤È¤¤¤¦¡£¤³¤Î&TR-or-Rec;¤Ï¡¤XML&processor;¤¬¹Ô¤ï¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¿¶Éñ¤¤¤òµ¬Äꤹ¤ë¡£¤Ä¤Þ¤ê¡¤XML¥Ç¡¼¥¿¤ÎÆɹþ¤ßÊýË¡¤òµ¬Äꤷ¡¤&application;¤ËÄ󶡤¹¤ë¾ðÊó¤òµ¬Äꤹ¤ë¡£

·Ð°ÞµÚ¤ÓÌÜɸ

1996ǯ¤ËWorld Wide Web Consortium(W3C)¤ÎÃæ¤ËÀßΩ¤·¤¿XMLºî¶È¥°¥ë¡¼¥×(°ÊÁ°¤Ï¡¤ SGMLÊÔ½¸¥ì¥Ó¥å¡¼°Ñ°÷²ñ¤È¸Æ¤Ð¤ì¤¿)¤¬¡¤XML¤ò³«È¯¤·¤¿¡£¤³¤Îºî¶È¥°¥ë¡¼¥×¤ÎµÄŤò¡¤Sun Microsystems¤ÎJon Bosak¤¬¶Ð¤á¤ë¡£W3C¤¬ÁÈ¿¥¤·¡¤°ÊÁ°¤ÏSGMLºî¶È¥°¥ë¡¼¥×¤È¸Æ¤Ð¤ì¤¿XML SIG(Special Interest Group)¤â¡¤XML¤ÎÀ©Äê¤ËÈó¾ï¤Ë³èȯ¤Ë»²²è¤·¤¿¡£ Dan Connolly¤Ï¡¤ºî¶È¥°¥ë¡¼¥×¤ÎW3C¤Ë¤ª¤±¤ëÏ¢Íí·¸¤ò̳¤á¤¿¡£

XML¤ÎÀß·×ÌÜɸ¤ò¡¤¼¡¤Ë¼¨¤¹¡£

a) XML¤Ï¡¤Internet¾å¤Ç¤½¤Î¤Þ¤Þ»ÈÍѤǤ­¤ë¡£

b) XML¤Ï¡¤¹­ÈϰϤÎ&application;¤ò»Ù±ç¤¹¤ë¡£

c) XML¤Ï¡¤SGML¤È¸ß´¹À­¤ò¤â¤Ä¡£

d) XMLʸ½ñ¤ò½èÍý¤¹¤ë¥×¥í¥°¥é¥à¤ò½ñ¤¯¤³¤È¤Ï¡¤ÍưפǤʤ±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

e) XML¤Ç¤Ï¡¤¥ª¥×¥·¥ç¥ó¤Îµ¡Ç½¤Ï¤Ç¤­¤ë¤À¤±¾¯¤Ê¤¯¤·¡¤°ì¤Ä¤â¸ºß¤·¤Ê¤¤¤³¤È¤òÌܻؤ¹¡£

f) XMLʸ½ñ¤Ï¡¤¿Í´Ö¤Ë¤È¤Ã¤ÆÆɤߤ䤹¤¯¡¤½½Ê¬¤ËÍý²ò¤·¤ä¤¹¤¤¡£

g) XML¤ÎÀ߷פϡ¤¤¹¤ß¤ä¤«¤Ë¹Ô¤¨¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

h) XML¤ÎÀ߷פϡ¤¸·Ì©µÚ¤Ó´Ê·é¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

i) XMLʸ½ñ¤Ï¡¤Íưפ˺îÀ®¤Ç¤­¤ë¡£

j) XML¤Ç¤Ï¡¤&markup;¤Î¿ô¤ò¸º¤é¤¹¤³¤È¤Ï¡¤½ÅÍפǤϤʤ¤¡£

XMLÂè&XML.version;&version;¤òÍý²ò¤·¡¤¤½¤ì¤ò½èÍý¤¹¤ë·×»»µ¡¥×¥í¥°¥é¥à¤ò½ñ¤¯¤¿¤á¤Ë½½Ê¬¤Ê¾ðÊó¤Ï¡¤¤³¤Î&TR-or-Rec;µÚ¤Ó´ØÏ¢¤¹¤ëµ¬³Ê(ʸ»úÍѤȤ·¤Æ¡¤UnicodeµÚ¤ÓISO/IEC 10646¡¤&language-identification;¥¿¥°ÍѤȤ·¤Æ¡¤¥¤¥ó¥¿¥Í¥Ã¥È RFC 1766¡¤&language-code;ÍѤȤ·¤Æ¡¤ISO 639¡¤Ê¤ӤË&country-code;ÍѤȤ·¤Æ¡¤ISO 3166)¤Ç¡¤¤¹¤Ù¤Æ¼¨¤¹¡£

¤³¤Î&version;¤ÎXML¤Îµ¬Äê¤Ï¡¤¸ø³«¥ì¥Ó¥å¡¼µÚ¤ÓµÄÏÀ¤òÌÜŪ¤È¤¹¤ë¡£¥Æ¥­¥¹¥ÈµÚ¤ÓˡΧ¾å¤ÎÃí°Õ¤ò²þÊѤ·¤Ê¤¤¸Â¤ê¡¤¼«Í³¤ËÇÛÉÛ¤·¤Æ¤â¤è¤¤¡£

 ÄêµÁ

XMLʸ½ñ¤Îµ¬Äê¤Î¤¿¤á¤Ë»ÈÍѤ¹¤ëÍѸì¤Ï¡¤¤³¤Î&TR-or-Rec;Æâ¤ÇÄêµÁ¤¹¤ë¡£¼¡¤Ë¼¨¤¹¸ì¶ç¤Ï¡¤¤½¤ì¤é¤ÎÍѸì¤òÄêµÁ¤¹¤ë¤¿¤á¡¤µÚ¤ÓXML&processor;¤ÎÆ°¤­¤òµ¬Äꤹ¤ë¤¿¤á¤Ë»ÈÍѤ¹¤ë¡£

Ŭ¹ç¤¹¤ëʸ½ñËô¤ÏXML&processor;¤Ï¡¤µ­½Ò¤µ¤ì¤¿¤È¤ª¤ê¤ËÆ°ºî¤·¤Æ¤â¤è¤¤¤¬¡¤¤½¤Î¤È¤ª¤ê¤Ë¤¹¤ëɬÍפϤʤ¤¡£

Ŭ¹ç¤¹¤ëʸ½ñËô¤ÏXML&processor;¤Ï¡¤µ­½Ò¤µ¤ì¤¿¤È¤ª¤ê¤ËÆ°ºî¤¹¤ë¤³¤È¤¬Í׵ᤵ¤ì¤ë¡£¤½¤¦¤Ç¤Ê¤±¤ì¤Ð¡¤&error;¤È¤¹¤ë¡£

¤³¤Î&TR-or-Rec;¤¬Äê¤á¤ëµ¬Â§¤ËÂФ¹¤ë°ãÈ¿¡£·ë²Ì¤ÏÄêµÁ¤·¤Ê¤¤¡£Å¬¹ç¤¹¤ë¥½¥Õ¥È¥¦¥§¥¢¤Ï¡¤&error;¤ò¸¡½Ð¤·¤ÆÊó¹ð¤·¤Æ¤â¤è¤¯¡¤&error;¤«¤é²óÉü¤·¤Æ¤â¤è¤¤¡£

Ŭ¹ç¤¹¤ëXML&processor;¤¬¸¡½Ð¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤º¡¤&application;¤ËÊó¹ð¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤&error;¡£&fatal-error;¤òȯ¸«¤·¤¿¤¢¤È¡¤&processor;¤Ï¡¤¤½¤ì°Ê¹ß¤Î&error;¤òõ¤¹¤¿¤á¤Ë¥Ç¡¼¥¿½èÍý¤ò³¹Ô¤·¤Æ¤â¤è¤¯¡¤&error;¤òȯ¸«¤·¤¿¾ì¹ç¤Ï¡¤¤½¤Î&error;¤ò&application;¤ËÊó¹ð¤·¤Æ¤â¤è¤¤¡£&error;ÄûÀµ¤ò¥µ¥Ý¡¼¥È¤¹¤ë¤¿¤á¤Ë¡¤&processor;¤Ï¡¤Ì¤½èÍý¥Ç¡¼¥¿(ʸ»ú¥Ç¡¼¥¿µÚ¤Ó&markup;¤Îº®ºß¤·¤¿¤â¤Î)¤òʸ½ñ¤«¤é¼è¤ê½Ð¤·¡¤&application;¤ËÅϤ·¤Æ¤â¤è¤¤¡£¤·¤«¤·¡¤°ìÅÙ¡¤&fatal-error;¤ò¸¡½Ð¤·¤¿¤é¡¤&processor;¤Ï¡¤Ä̾ï¤Î½èÍý¤ò³¹Ô¤·¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£¤Ä¤Þ¤ê¡¤&processor;¤Ï¡¤Ê¸»ú¥Ç¡¼¥¿µÚ¤Óʸ½ñ¤ÎÏÀÍý¹½Â¤¤Ë¤Ä¤¤¤Æ¤Î¾ðÊó¤ò¡¤Ä̾ï¤ÎÊýË¡¤Ç&application;¤ËÅϤ·Â³¤±¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£

Ŭ¹ç¤¹¤ë¥½¥Õ¥È¥¦¥¨¥¢¤Ï¡¤µ­½Ò¤µ¤ì¤¿¤È¤ª¤ê¤Ë¿¶¤ëÉñ¤Ã¤Æ¤â¤è¤¤(may)¡¤Ëô¤Ï¿¶¤ëÉñ¤ï¤Ê¤¯¤Æ¤Ï¤Ê¤é¤Ê¤¤(must)(ʸ¾ÏÃæ¤Î½õÆ°»ì¤Ë¤è¤ë¡£)¡£¤½¤Î¤È¤ª¤ê¤Ë¿¶¤ëÉñ¤¦¾ì¹ç¤Ï¡¤µ­½Ò¤µ¤ì¤¿¿¶Éñ¤¤¤òÁªÂòËô¤ÏµñÈݤ¹¤ë¼êÃʤò&user;¤ËÄ󶡤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

¤¹¤Ù¤Æ¤Î&valid;¤ÊXMLʸ½ñ¤ËŬÍѤ¹¤ëµ¬Â§¡£&validity;À©Ìó¤Î°ãÈ¿¤Ï¡¤&error;¤È¤¹¤ë¡£&at-user-option;¡¤¸¡¾Ú¤ò¹Ô¤¦XML&processor;¤Ï¡¤¤³¤Î&error;¤òÊó¹ð¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

¤¹¤Ù¤Æ¤Î&well-formed;¤ÎXMLʸ½ñ¤ËŬÍѤ¹¤ëµ¬Â§¡£&well-formed;À©Ìó¤Î°ãÈ¿¤Ï¡¤&fatal-error;¤È¤¹¤ë¡£

a) &string;Ëô¤Ï̾Á°¤Î&match;¡¡Èæ³Ó¤¹¤ëÆó¤Ä¤Î&string;Ëô¤Ï̾Á°¤Ï¡¤Æ±°ì¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£ISO/IEC 10646¤Ë¤ª¤¤¤Æ¡¤Ê£¿ô¤Îɽ¸½¤¬²Äǽ¤Êʸ»ú¡ÎÎ㤨¤Ð¡¤&composed-form;µÚ¤Ó´ðÄì+&diacritical-mark;(¥À¥¤¥¢¥¯¥ê¥Æ¥£¥«¥ë¥Þ¡¼¥¯)·Á¼°¡Ï¤Ï¡¤¤É¤Á¤é¤Î&string;¤âƱ¤¸É½¸½¤Î¤È¤­¤Ë¸Â¤ê¡¤&match;¤¹¤ë¡£&at-user-option;¡¤&processor;¤Ï¡¤¤½¤Îʸ»ú¤òɸ½à·Á¤ËÀµµ¬²½¤·¤Æ¤â¤è¤¤¡£Èæ³Ó¤Î¤È¤­¡¢Âçʸ»ú¤È¾®Ê¸»ú¤È¤Î¶èÊ̤ò¤¹¤ë¡£<BR>b) &string;¤ÈʸˡÃæ¤Îµ¬Â§¤È¤Î&match;¡¡¤¢¤ëÀ¸À®µ¬Â§¤«¤éÀ¸À®¤¹¤ë¸À¸ì¤Ë¡¤¤¢¤ë&string;¤¬Â°¤¹¤ë¤È¤­¡¤¤³¤Î&string;¤Ï¡¤¤³¤ÎÀ¸À®µ¬Â§¤Ë&match;¤¹¤ë¤È¤¤¤¦¡£<BR>c) ÆâÍƤÈÆâÍÆ¥â¥Ç¥ë¤È¤Î&match;¡¡¤¢¤ëÍ×ÁǤ¬¡¤Í×ÁǤÎ&validity;¤ÎÀ©Ìó¤Ë¼¨¤¹°ÕÌ£¤ÇŬ¹ç¤¹¤ë¤È¤­¡¤¤³¤ÎÍ×ÁǤϡ¤¤½¤ÎÀë¸À¤Ë&match;¤¹¤ë¤È¤¤¤¦¡£

XML¤Îµ¡Ç½¤Ç¤¢¤Ã¤Æ¡¤XML¤¬SGML¤È¸ß´¹¤Ç¤¢¤ë¤³¤È¤òÊݾڤ¹¤ë¤¿¤á¤À¤±¤ËƳÆþ¤µ¤ì¤ë¤â¤Î¡£

¹´Â«ÎϤϤ⤿¤Ê¤¤¿ä¾©»ö¹à¡£&WebSGML;°ÊÁ°¤«¤é¸ºß¤¹¤ëSGML&processor;¤¬¡¤XMLʸ½ñ¤ò½èÍý¤Ç¤­¤ë²ÄǽÀ­¤ò¹â¤á¤ë¤¿¤á¤Ë¼è¤êÆþ¤ì¤ë¤â¤Î¡£

ʸ½ñ

¤³¤Î&TR-or-Rec;¤ÇÄêµÁ¤¹¤ë°ÕÌ£¤Ç¡¤&well-formed;¤È¤¹¤ë¥Ç¡¼¥¿¥ª¥Ö¥¸¥§¥¯¥È¤ò¡¤XMLʸ½ñ¤È¤¤¤¦¡£&well-formed;¤ÎXMLʸ½ñ¤¬¡¤¤µ¤é¤Ë¡¤¤¢¤ëÀ©Ìó¾ò·ï¤òËþ­¤¹¤ì¤Ð¡¤&valid;¤ÊXMLʸ½ñ¤È¤¹¤ë¡£

¤¤¤º¤ì¤ÎXMLʸ½ñ¤â¡¤ÏÀÍý¹½Â¤µÚ¤ÓʪÍý¹½Â¤¤ò¤â¤Ä¡£ÊªÍýŪ¤Ë¤Ï¡¤Ê¸½ñ¤Ï¡¤¼ÂÂΤȸƤÖñ°Ì¤«¤é¤Ê¤ë¡£¤¢¤ë¼ÂÂΤϡ¤Ê¸½ñÆâ¤Ë¾¤Î¼ÂÂΤò´Þ¤à¤¿¤á¤Ë¡¤¤½¤Î¾¤Î¼ÂÂΤò»²¾È¤·¤Æ¤â¤è¤¤¡£Ê¸½ñ¤Ï¡¤¡È¥ë¡¼¥È¡É¤¹¤Ê¤ï¤Áʸ½ñ¼ÂÂΤ«¤é»Ï¤Þ¤ë¡£ÏÀÍýŪ¤Ë¤Ï¡¤Ê¸½ñ¤Ï¡¤Àë¸À¡¤Í×ÁÇ¡¤¥³¥á¥ó¥È¡¤Ê¸»ú»²¾ÈµÚ¤Ó½èÍýÌ¿Îá¤ò´Þ¤ß¡¤¤³¤ì¤é¤¹¤Ù¤Æ¤Ï¡¤Ê¸½ñÆâ¤ÇÌÀ¼¨Åª¤Ê&markup;¤Ë¤è¤Ã¤Æ¼¨¤¹¡£ÏÀÍý¹½Â¤µÚ¤ÓʪÍý¹½Â¤¤Ï¡¤°Ê¹ß¤Ë¼¨¤¹¤È¤ª¤ê¤Ë¡¤¸·Ì©¤ËÆþ¤ì»Ò¤Ë¤Ê¤Ã¤Æ¤¤¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

&well-formed;¤ÎXMLʸ½ñ

¤¢¤ë¥Æ¥­¥¹¥È¥ª¥Ö¥¸¥§¥¯¥È¤¬¡¤¼¡¤Î¤¤¤º¤ì¤«¤Î¤È¤­¡¤¤½¤Î¥Æ¥­¥¹¥È¥ª¥Ö¥¸¥§¥¯¥È¤ò&well-formed;¤ÎXMLʸ½ñ¤È¸Æ¤Ö¡£

a) Á´ÂΤȤ·¤Æ¡¤document¤È¤¤¤¦¥é¥Ù¥ë¤ò¤â¤ÄÀ¸À®µ¬Â§¤Ë&match;¤¹¤ë¡£

b) ¤³¤Î&TR-or-Rec;¤ÇÄêµÁ¤¹¤ë¡¤¤¹¤Ù¤Æ¤Î&well-formed;À©Ìó¤Ë½¾¤¦¡£

c) ¤½¤ì¤¾¤ì¤Î&parsed-entity;¤¬¡¤&well-formed;¤È¤Ê¤ë¡£

ʸ½ñ document prolog element Misc*

documentÀ¸À®µ¬Â§¤Ë&match;¤¹¤ë¤È¤Ï¡¤¼¡¤ò°ÕÌ£¤¹¤ë¡£

a) °ì¤Ä°Ê¾å¤ÎÍ×ÁǤò´Þ¤à¡£

b) ¥ë¡¼¥ÈËô¤Ïʸ½ñÍ×ÁǤȤ¤¤¦Í×ÁǤ¬°ì¤Ä¤À¤±Â¸ºß¤·¡¤¤³¤ì¤Ï¡¤Â¾¤ÎÍ×ÁǤÎÆâÍƤ˴ޤޤì¤Ê¤¤¡£¤³¤ì°Ê³°¤Î¤¹¤Ù¤Æ¤ÎÍ×ÁǤϡ¤¤½¤Î³«»Ï¥¿¥°¤¬Â¾¤ÎÍ×ÁǤÎÆâÍƤ˴ޤޤì¤ì¤Ð¡¤Âбþ¤¹¤ë½ªÎ»¥¿¥°¤âƱ¤¸Í×ÁǤÎÆâÍƤ˴ޤޤì¤ë¡£¤Ä¤Þ¤ê¡¤Í×ÁǤϡ¤³«»Ï¥¿¥°µÚ¤Ó½ªÎ»¥¿¥°¤Ë¤è¤Ã¤Æ¶èÀÚ¤é¤ì¡¤Æþ¤ì»Ò¹½Â¤¤ò¤Ê¤¹¡£

¤³¤ì¤é¤Î·ë²Ì¤È¤·¤Æ¡¤Ê¸½ñÆâ¤Î¤É¤ÎÈó¥ë¡¼¥ÈÍ×ÁÇC¤ËÂФ·¤Æ¤â¡¤¤¢¤ë¾¤ÎÍ×ÁÇP¤¬Â¸ºß¤·¡¤C¤Ï¡¤P¤ÎÆâÍƤ˴ޤޤì¤ë¤¬¡¤P¤ÎÆâÍƤ˴ޤޤì¤ë¾¤ÎÍ×ÁǤ˴ޤޤì¤ë¤³¤È¤Ï¤Ê¤¤¡£¤³¤Î¤È¤­¡¤P¤òC¤Î¿Æ¤È¤¤¤¤¡¤C¤òP¤Î»Ò¤È¤¤¤¦¡£

 ʸ»ú

&parsed-entity;¤Ï¡¤¥Æ¥­¥¹¥È(ʸ»ú¤ÎʤӤǤ¢¤Ã¤Æ¡¤&markup;Ëô¤Ïʸ»ú¥Ç¡¼¥¿¤òɽ¤·¤Æ¤â¤è¤¤¡£)¤ò´Þ¤à¡£Ê¸»ú¤Ï¡¤¥Æ¥­¥¹¥È¤ÎºÇ¾®Ã±°Ì¤Ç¤¢¤Ã¤Æ¡¤ISO/IEC 10646¤Ëµ¬Äꤵ¤ì¤ë¡£µöÍƤ¹¤ëʸ»ú¤Ï¡¤¥¿¥Ö¡¤²þ¹Ô¡¤Éüµ¢Ê¤ӤËUnicodeµÚ¤ÓISO/IEC 10646¤¬µöÍƤ¹¤ë¿Þ·Áʸ»ú¤È¤¹¤ë¡£ ʸ»ú¤ÎÈÏ°Ï Char #x9 | #xA | #xD | [#x20-#D7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF] Ǥ°Õ¤ÎUnicodeʸ»ú¡£¤¿¤À¤·¡¤&surrogate-blocks;¡¤FFFEµÚ¤ÓFFFF¤Ï½ü¤¯¡£

&character-value;¤ò¥Ó¥Ã¥È¥Ñ¥¿¥ó¤ËÉä¹æ²½¤¹¤ëµ¡¹½¤Ï¡¤¼ÂÂΤ´¤È¤Ë°ã¤Ã¤Æ¤â¤è¤¤¡£¤¹¤Ù¤Æ¤ÎXML&processor;¤Ï¡¤ISO/IEC 10646¤ÎUTF-8Éä¹æ²½µÚ¤ÓUTF-16Éä¹æ²½¤ò¼õ¤±ÉÕ¤±¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£Æó¤Ä¤Î¤É¤Á¤é¤¬ÍѤ¤¤é¤ì¤Æ¤¤¤ë¤«¤òÌÀ¼¨¤¹¤ë¤¿¤á¤Îµ¡¹½¡¤µÚ¤Ó¾¤ÎÉä¹æ²½ÊýË¡¤òÍøÍѤ¹¤ë¤¿¤á¤Îµ¡¹½¤Ï¡¤Ê¸»ú¤ÎÉä¹æ²½¤Ëµ­½Ò¤¹¤ë¡£

¤É¤ÎÉä¹æ²½ÊýË¡¤òÍѤ¤¤ë¤«¤Ë´Ø·¸¤Ê¤¯¡¤ISO/IEC 10646¤Îʸ»ú½¸¹ç¤Ë¤¢¤ë¤¹¤Ù¤Æ¤Îʸ»ú¤Ï¡¤¤½¤ÎUCS-4&code-value;¤ÈÅù²Á¤Ê10¿Ê¿ôËô¤Ï16¿Ê¿ô¤Ë¤è¤Ã¤Æ¡¤»²¾È¤Ç¤­¤ë¡£

 ¶¦Ä̤ι½Ê¸¹½À®»Ò

2.3¤Ç¤Ï¡¤Ê¸Ë¡Æâ¤Ç¹­¤¯»ÈÍѤ¹¤ë¤¤¤¯¤Ä¤«¤Îµ­¹æ¤òÄêµÁ¤¹¤ë¡£

S (¶õÇò)¤Ï¡¤°ì¤Ä¼ã¤·¤¯¤ÏÊ£¿ô¤Î&space-character;(#x20)¡¤Éüµ¢¡¤²þ¹ÔËô¤Ï¥¿¥Ö¤«¤éÀ®¤ë¡£ ¶õÇò S (#x20 | #x9 | #xD | #xA)+

Êص¹¾å¡¤Ê¸»ú¤ò¡¤&letter;¡¤¿ô»úËô¤Ï¾¤Îʸ»ú¤ËʬÎह¤ë¡£&letter;¤Ï¡¤¥¢¥ë¥Õ¥¡¥Ù¥Ã¥ÈŪËô¤Ïɽ²»Åª¤Ç¤¢¤ë´ðËÜʸ»ú(°ì¤ÄËô¤ÏÊ£¿ô¤Î&combining-character;¤¬¡¤¸å¤Ë³¤¯¤³¤È¤â¤¢¤ë¡£)¡¤&ideographic;¤«¤éÀ®¤ë¡£ ³Æ¥¯¥é¥¹¤Ë¤ª¤±¤ë¼ÂºÝ¤Îʸ»ú¤Ë¤Ä¤¤¤Æ¤Î´°Á´¤ÊÄêµÁ¤Ï¡¤Ê¸»ú¥¯¥é¥¹¤Ë´Ø¤¹¤ëÉÕÏ¿¤Ëµ¬Äꤹ¤ë¡£

Name¤Ï¡¤&letter;Ëô¤Ï¤¤¤¯¤Ä¤«¤Î¶èÀÚ¤êʸ»ú¤Î°ì¤Ä¤Ç»Ï¤Þ¤ê¡¤¤½¤Î¸å¤Ë&letter;¡¤¿ô»ú¡¤¥Ï¥¤¥Õ¥ó¡¤²¼Àþ¡¤¥³¥í¥óËô¤Ï¥Ô¥ê¥ª¥É¤¬Â³¤¯(¤³¤ì¤é¤ò̾Á°Ê¸»ú¤È¤¤¤¦¡£)¡£&string;"xml"Ëô¤Ï(('X'|'x') ('M'|'m') ('L'|'l'))¤Ë&match;¤¹¤ëǤ°Õ¤Î&string;¤Ç»Ï¤Þ¤ë̾Á°¤Ï¡¤¤³¤Î&TR-or-Rec;¤Î¸½ºß¤ÎÈÇËô¤Ï¾­Íè¤ÎÈǤǤÎɸ½à²½¤Î¤¿¤á¤ËͽÌ󤹤롣

XML¤Î̾Á°¤ÎÃæ¤Î¥³¥í¥ó¤Ï¡¤Ì¾Á°¶õ´Ö¤Ç¤Î¼Â¸³¤Î¤¿¤á¤ËͽÌ󤹤롣¥³¥í¥ó¤Î°ÕÌ£¤Ï¡¤¾­Íè¤Î¤¢¤ë»þÅÀ¤Çɸ½à²½¤¹¤ë¤â¤Î¤È¤·¡¤¤½¤Î¤È¤­¤Ë¤Ï¡¤¼Â¸³Åª¤ÊÌÜŪ¤Ç¥³¥í¥ó¤ò»ÈÍѤ¹¤ëʸ½ñ¤ò¹¹¿·¤¹¤ëɬÍפ¬À¸¤¸¤ë²ÄǽÀ­¤¬¤¢¤ë¡£XML¤ÇºÎÍѤ¹¤ë̾Á°¶õ´Ö¤Îµ¡¹½¤¬¡¤¶èÀÚ¤ê»Ò¤È¤·¤Æ¼ÂºÝ¤Ë¥³¥í¥ó¤ò»ÈÍѤ¹¤ë¤È¤¤¤¦ÊݾڤϤʤ¤¡£»ö¼Â¾å¡¤¤³¤ì¤Ï¡¤Ì¾Á°¶õ´Ö¤Î¼Â¸³¤Î°ì¤Ä¤È¤·¤Æ°Ê³°¤Ë¤Ï¡¤XML¤Î̾Á°¤ÎÃæ¤Ç¥³¥í¥ó¤ò»ÈÍѤ·¤Ê¤¤¤Û¤¦¤¬¤è¤¤¤³¤È¤ò°ÕÌ£¤¹¤ë¡£¤·¤«¤·¡¤XML&processor;¤Ï¡¤Ì¾Á°Ê¸»ú¤È¤·¤Æ¥³¥í¥ó¤ò¼õ¤±ÉÕ¤±¤ë¤³¤È¤¬Ë¾¤Þ¤·¤¤¡£

Nmtoken (̾Á°&token;)¤Ï¡¤Ì¾Á°Ê¸»ú¤Ç¹½À®¤¹¤ëÎó¤È¤¹¤ë¡£ ̾Á°µÚ¤Ó&token; NameChar Letter | Digit | '.' | '-' | '_' | ':' | CombiningChar | Extender Name (Letter | '_' | ':') (NameChar)* Names Name (S Name)* Nmtoken (NameChar)+ Nmtokens Nmtoken (S Nmtoken)*

&literal;¥Ç¡¼¥¿¤Ï¡¤°úÍÑÉä¤Ç°Ï¤Þ¤ì¤¿&string;¤È¤·¡¤¤½¤ÎÎó¤Î¶èÀÚ¤ê»Ò¤È¤·¤Æ»ÈÍѤ¹¤ë°úÍÑÉä¤Ï´Þ¤Þ¤Ê¤¤¡£&literal;¤Ï¡¤ÆâÉô¼ÂÂÎ(EntityValue)¡¤Â°À­ÃÍ(AttValue)¡¤³°Éô&identifier;(SystemLiteral)¤ÎÆâÍƤλØÄê¤Ë»ÈÍѤ¹¤ë¡£ÌÜŪ¤Ë¤è¤Ã¤Æ¤Ï¡¤&literal;Á´ÂΤò¡¤¤½¤ÎÃæ¤Î&markup;¤ÎÁöºº¤ò¹Ô¤Ê¤ï¤º¤Ë¡¤¥¹¥­¥Ã¥×¤¹¤ë¤³¤È¤¬¤¢¤ë(SkipLit¡£)¡£ &literal; EntityValue ' " ' ([^%&"] | PEReference | Reference)* ' " ' |  " ' " ([^%&'] | PEReference | Reference)* " ' " AttValue ' " ' ([^<&"] | Reference)* ' " ' |  " ' " ([^<&'] | Reference)* " ' " SystemLiteral SkipLit PubidLiteral ' " ' PubidChar* ' " ' | " ' " (PubidChar - " ' ")* " ' " PubidChar #x20 | #xD | #xA | [a-zA-Z0-9] | [-'()+,./:=?] SkipLit (' " ' [^"]* ' " ') | (" ' " [^']* " ' ")

ʸ»ú¥Ç¡¼¥¿µÚ¤Ó&markup;

¥Æ¥­¥¹¥È¤Ï¡¤Ê¸»ú¥Ç¡¼¥¿µÚ¤Ó&markup;¤¬º®ºß¤¹¤ë¤â¤Î¤È¤·¤Æ¹½À®¤¹¤ë¡£&markup;¤Ï¡¤³«»Ï¥¿¥°¡¤½ªÎ»¥¿¥°¡¤¶õÍ×ÁÇ¡¤¼ÂÂλ²¾È¡¤Ê¸»ú»²¾È¡¤¥³¥á¥ó¥È¡¤CDATA¥»¥¯¥·¥ç¥ó ¤Î¶èÀÚ¤ê»Ò¡¤Ê¸½ñ·¿Àë¸ÀµÚ¤Ó½èÍýÌ¿Îá¤Î·Á¤ò¼è¤ë¡£

&markup;¤Ç¤Ï¤Ê¤¤¤¹¤Ù¤Æ¤Î¥Æ¥­¥¹¥È¤Ï¡¤Ê¸½ñ¤Îʸ»ú¥Ç¡¼¥¿¤ò¹½À®¤¹¤ë¡£

¥¢¥ó¥Ñ¥µ¥ó¥Éʸ»ú (&)µÚ¤Ó&left-angle-bracket; (<)¤Ï¡¤&markup;¤Î¶èÀÚ¤ê»Ò¤È¤·¤Æ¡¤Ëô¤Ï¥³¥á¥ó¥È¡¤½èÍýÌ¿Îá¼ã¤·¤¯¤ÏCDATA¥»¥¯¥·¥ç¥óÆâ¤Ç»ÈÍѤ¹¤ë¾ì¹ç¤Ë¤À¤±¡¤¤½¤Î¤Þ¤Þ¤Î·Á¤Ç½Ð¸½¤·¤Æ¤è¤¤¡£¤³¤ì¤é¤Îʸ»ú¤Ï¡¤ÆâÉô¼ÂÂÎÀë¸À¤Î&literal;¼ÂÂÎÃÍÆâ¤Ëµ­½Ò¤·¤Æ¤â¤è¤¤¡£ ¾Ü¤·¤¯¤Ï¡¤&well-formed;¤Î¼ÂÂΤ˴ؤ¹¤ëµ¬Äê¤ò»²¾È¡£¤³¤ì¤é¤Îʸ»ú¤¬Â¾¤ÎÉôʬ¤ÇɬÍפʾì¹ç¡¤¿ôÃͤˤè¤ëʸ»ú»²¾ÈËô¤Ï&string;"&amp;"µÚ¤Ó&string;"&lt;"¤ò»ÈÍѤ·¡¤&escape;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£&right-angle-bracket; (>) ¤Ï¡¤&string;"&gt;"¤ò»ÈÍѤ·¤Æɽ¸½¤·¤Æ¤â¤è¤¤¡£ÆâÍƤÎÃæ¤ÇÎó"]]>"¤ò»ÈÍѤ¹¤ë¤È¤­¤Ï¡¤¤½¤ì¤¬¡¤CDATA¥»¥¯¥·¥ç¥ó¤Î½ªÎ»¤ò&markup;¤·¤Ê¤¤¸Â¤ê¡¤¸ß´¹À­¤Î¤¿¤á¡¤"&gt;"Ëô¤Ïʸ»ú»²¾È¤ò»ÈÍѤ·¡¤&escape;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

Í×ÁǤÎÆâÍƤǤϡ¤Ê¸»ú¥Ç¡¼¥¿¤Ï¡¤¤¤¤«¤Ê¤ë&markup;¤Î³«»Ï¶èÀÚ¤ê»Ò¤ò´Þ¤Þ¤Ê¤¤Ç¤°Õ¤Î&char-string;¤È¤¹¤ë¡£CDATA¥»¥¯¥·¥ç¥ó¤Ç¤Ï¡¤Ê¸»ú¥Ç¡¼¥¿¤È¤Ï¡¤CDATA¥»¥¯¥·¥ç¥ó¤Î½ªÎ»¶èÀÚ¤ê»Ò"]]>"¤ò´Þ¤Þ¤Ê¤¤Ç¤°Õ¤Î&char-string;¤È¤¹¤ë¡£

°À­ÃͤË&single-quote;µÚ¤Ó&double-quote;¤ò´Þ¤à¤¿¤á¤Ë¤Ï¡¤¥¢¥Ý¥¹¥È¥í¥Õ¥£Ëô¤Ï&single-quote;(') ¤Ï¡¤"&apos;"¤È¤·¤Æɽ¸½¤·¡¤&double-quote;(")¤Ï¡¤"&quot;"¤È¤·¤Æɽ¸½¤¹¤ë¡£ ʸ»ú¥Ç¡¼¥¿ CharData [^<&]* - ([^<&]* ']]>' [^<&]*)

¥³¥á¥ó¥È

¥³¥á¥ó¥È¤Ï¡¤Â¾¤Î&markup;¤Î³°¤Ê¤é¤Ð¡¤Ê¸½ñ¤Î¤É¤³¤Ë¸½¤ì¤Æ¤â¤è¤¤¡£¤µ¤é¤Ë¡¤Ê¸½ñ·¿Àë¸ÀÆâ¤Ç¡¤Ê¸Ë¡¤¬µö¤¹¾ì½ê¤Ë¸½¤ì¤Æ¤â¤è¤¤¡£ ¥³¥á¥ó¥È¤Ï¡¤Ê¸½ñ¤Îʸ»ú¥Ç¡¼¥¿¤Î°ìÉô¤Ç¤Ï¤Ê¤¤¡£XML&processor;¤Ï¡¤&application;¤¬¥³¥á¥ó¥È¤Î¥Æ¥­¥¹¥È¤ò¼è¤ê½Ð¤¹¤³¤È¤ò²Äǽ¤È¤·¤Æ¤â¤è¤¤¤¬¡¤¤½¤¦¤·¤Ê¤¯¤È¤â¤è¤¤¡£ ¸ß´¹À­¤Î¤¿¤á¡¤&string;"--" ¡Ê&double-hyphen;¡Ë¤Ï¡¤¥³¥á¥ó¥ÈÆâ¤Ç¸½¤ì¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£ ¥³¥á¥ó¥È Comment '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->'

¥³¥á¥ó¥È¤ÎÎã¤ò¼¡¤Ë¼¨¤¹¡£ <!&como; declarations for <head> & <body> &comc;>

½èÍýÌ¿Îá

½èÍýÌ¿Îá(PI)¤Ë¤è¤Ã¤Æ¡¤&application;¤Î¤¿¤á¤ÎÌ¿Îá¤òʸ½ñ¤ËÆþ¤ì¤ë¤³¤È¤¬¤Ç¤­¤ë¡£ ½èÍýÌ¿Îá PI '<?' PITarget (S (Char* - (Char* &pic; Char*)))? &pic; PITarget Name - (('X' | 'x') ('M' | 'm') ('L' | 'l')) PI¤Ï¡¤Ê¸½ñ¤Îʸ»ú¥Ç¡¼¥¿¤Î°ìÉô¤Ç¤Ï¤Ê¤¤¤¬¡¤&application;¤ËÅϤµ¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£PI¤Ï¡¤Ì¿Î᤬ÅϤµ¤ì¤ë&application;¤ò&identify;¤¿¤á¤Ë»ÈÍѤ¹¤ë⌖ (PITarget) ¤Ç»Ï¤Þ¤ë¡£⌖̾ "XML"¡¤"xml"¤Ê¤É¤Ï¡¤¤³¤Î&TR-or-Rec;¤Î¸½ºß¤ÎÈÇËô¤Ï¾­Íè¤ÎÈǤε¬³Ê²½ÍѤËͽÌ󤹤롣XML¤Îµ­Ë¡µ¡¹½¤ò¡¤PI¤Î⌖¤òÀë¸À¤¹¤ë¤¿¤á¤Ë»ÈÍѤ·¤Æ¤â¤è¤¤¡£

CDATA¥»¥¯¥·¥ç¥ó

CDATA¥»¥¯¥·¥ç¥ó¤Ï¡¤Ê¸»ú¥Ç¡¼¥¿¤¬½Ð¸½¤¹¤ë¤È¤³¤í¤Ç¤¢¤ì¤Ð¡¤¤É¤³¤Ë½Ð¸½¤·¤Æ¤â¤è¤¤¡£¤³¤ì¤Ï¡¤¤½¤¦¤Ç¤Ê¤±¤ì¤Ð¡¤&markup;¤È¤·¤Æǧ¼±¤¹¤ëʸ»ú¤ò´Þ¤à¡¤¥Æ¥­¥¹¥È¤Î¶è²è¤ò&escape;¤¹¤ë¤Î¤Ë»ÈÍѤ¹¤ë¡£CDATA¥»¥¯¥·¥ç¥ó¤Ï¡¤&string;"<![CDATA["¤Ç»Ï¤Þ¤ê¡¤&string; "]]>"¤Ç½ª¤ï¤ë¡£ CDATA¥»¥¯¥·¥ç¥ó CDSect CDStart CData CDEnd CDStart '<![CDATA[' CData (Char* - (Char* ']]>' Char*)) CDEnd ']]>' CDATA¥»¥¯¥·¥ç¥óÆâ¤Ç¤Ï¡¤ÎóCDEnd¤À¤±¤ò&markup;¤È¤·¤Æǧ¼±¤¹¤ë¤Î¤Ç¡¤&left-angle-bracket;µÚ¤Ó¥¢¥ó¥Ñ¥µ¥ó¥É¤Ï¡¤¤½¤Î&literal;·Á¼°¤Ç½Ð¸½¤·¤Æ¤è¤¤¡£¤½¤ì¤é¤Ï¡¤"&lt;"µÚ¤Ó"&amp;"¤ò»ÈÍѤ·¤Æ&escape;¤¹¤ëɬÍפϤʤ¤¡£CDATA¥»¥¯¥·¥ç¥ó¤Ï¡¤Æþ¤ì»Ò¤Ë¤Ï¤Ç¤­¤Ê¤¤¡£

"<greeting>"µÚ¤Ó"</greeting>"¤ò¡¤&markup;¤Ç¤Ï¤Ê¤¯¡¤Ê¸»ú¥Ç¡¼¥¿¤È¤·¤Æǧ¼±¤¹¤ëCDATA¥»¥¯¥·¥ç¥ó¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <![CDATA[<greeting>Hello, world!</greeting>]]>

&prolog;µÚ¤Óʸ½ñ·¿Àë¸À

XMLʸ½ñ¤Ï¡¤»ÈÍѤ¹¤ëXML¤Î&version;¤ò»ØÄꤹ¤ëXMLÀë¸À¤Ç»Ï¤á¤Æ¤â¤è¤¯¡¤Ëô¤½¤¦¤¹¤ë¤Î¤¬Ë¾¤Þ¤·¤¤¡£

¤³¤Î&TR-or-Rec;¤Î¤³¤Î&version;¤ËŬ¹ç¤¹¤ë¤³¤È¤ò¼¨¤¹¤¿¤á¤Ë¤Ï¡¤&version;ÈÖ¹æ "1.0" ¤ò»ÈÍѤ·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤¢¤ëʸ½ñ¤¬¡¤¤³¤Î&TR-or-Rec;¤Î¤³¤Î&version;¤ËŬ¹ç¤·¤Ê¤¤¤È¤­¡¤ÃÍ"1.0"¤ò»ÈÍѤ¹¤ë¤Î¤Ï¡¤&error;¤È¤¹¤ë¡£¤³¤Î&TR-or-Rec;¤Îº£¸å¤Î&version;¤Ë"1.0"°Ê³°¤ÎÃͤòÉÕÍ¿¤¹¤ë¤³¤È¤¬¡¤XMLºî¶È¥°¥ë¡¼¥×¤Î°Õ¿Þ¤À¤¬¡¤XML¤Î¾­Íè¤Î&version;¤òºîÀ®¤¹¤ë¤³¤È¤Î³ÎÌó¤ò¼¨¤¹¤ï¤±¤Ç¤Ï¤Ê¤¯¡¤ºîÀ®¤·¤¿¤È¤·¤Æ¤â¡¤ÈÖ¹æÉÕ¤±¤Ë¤Ä¤¤¤Æ¡¤ÆÃÄê¤ÎÊýË¡¤ò»ÈÍѤ¹¤ë¤³¤È¤Î³ÎÌó¤ò¼¨¤¹¤ï¤±¤Ç¤â¤Ê¤¤¡£¾­Íè¤Î&version;¤Î²ÄǽÀ­¤ò½ü³°¤·¤Ê¤¤¤Î¤Ç¡¤É¬Íפʾì¹ç¡¤¼«Æ°Åª¤Ê&version;¤Îǧ¼±¤ò²Äǽ¤È¤¹¤ë¼êÃʤȤ·¤Æ¡¤¤³¤Î¹½À®»Ò¤òÄ󶡤¹¤ë¡£&processor;¤Ï¡¤¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤Ê¤¤&version;¤Ç¥é¥Ù¥ëÉÕ¤±¤·¤¿Ê¸½ñ¤ò¼õ¤±¼è¤Ã¤¿¤È¤­¡¤&error;¤òÄÌÃΤ·¤Æ¤â¤è¤¤¡£

XMLʸ½ñÆâ¤Î&markup;¤Îµ¡Ç½¤Ï¡¤µ­²±¹½Â¤µÚ¤ÓÏÀÍý¹½Â¤¤òµ­½Ò¤¹¤ë¤³¤È¡¤Ê¤ӤË°À­µÚ¤Ó°À­ÃͤÎÂФòÏÀÍý¹½Â¤¤Ë´ØÏ¢¤Å¤±¤ë¤³¤È¤Ë¤¢¤ë¡£XML¤Ï¡¤ÏÀÍý¹½Â¤¤Ë¤Ä¤¤¤Æ¤ÎÀ©Ìó¾ò·ï¤òÄêµÁ¤¹¤ë¤¿¤á¡¤µÚ¤Ó¤¢¤é¤«¤¸¤áÄêµÁ¤µ¤ì¤¿µ­²±Ã±°Ì¤ò»ÈÍѤǤ­¤ë¤¿¤á¤Îµ¡¹½¤È¤·¤Æ¡¤Ê¸½ñ·¿Àë¸À¤òÄ󶡤¹¤ë¡£XMLʸ½ñ¤¬&valid;¤È¤Ï¡¤Ê¸½ñ·¿Àë¸À¤ò¤â¤Á¡¤¤½¤Îʸ½ñ·¿Àë¸À¤Ë¼¨¤¹À©Ìó¾ò·ï¤òËþ¤¿¤¹¤³¤È¤È¤¹¤ë¡£

ʸ½ñ·¿Àë¸À¤Ï¡¤Ê¸½ñ¤ÎºÇ½é¤ÎÍ×ÁǤÎÁ°¤Ë¸½¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£ &prolog; prolog XMLDecl? Misc* (doctypedecl Misc*)? XMLDecl &xmlpio; VersionInfo EncodingDecl? SDDecl? S? &pic; VersionInfo S 'version' Eq ('"VersionNum"' | "'VersionNum'") Eq S? '=' S? VersionNum ([a-zA-Z0-9_.:] | '-')+ Misc Comment | PI | S

Î㤨¤Ð¡¤¼¡¤Ë¼¨¤¹´°Á´¤ÊXMLʸ½ñ¤Ï¡¤&well-formed;¤Ç¤¢¤ë¤¬&valid;¤Ç¤Ï¤Ê¤¤¡£ Hello, world! ]]> ¼¡¤Îʸ½ñ¤âƱÍͤȤ¹¤ë¡£ Hello, world! ]]>

XML¤Îʸ½ñ·¿Àë¸À¤Ï¡¤¤¢¤ëʸ½ñ¥¯¥é¥¹¤Î¤¿¤á¤Îʸˡ¤òÄ󶡤¹¤ë&markup;Àë¸À¤ò´Þ¤à¤«¡¤Ëô¤Ï»²¾È¤¹¤ë¡£¤³¤Îʸˡ¤ò¡¤Ê¸½ñ·¿ÄêµÁËô¤ÏDTD¤È¤¤¤¦¡£Ê¸½ñ·¿Àë¸À¤Ï¡¤&markup;Àë¸À¤ò´Þ¤ó¤À³°Éô⊂(ÆÃÊ̤ʼïÎà¤Î³°Éô¼ÂÂÎ)¤ò»²¾È¤Ç¤­¡¤Ëô¤ÏÆâÉô⊂¤ËľÀÜ&markup;Àë¸À¤ò´Þ¤à¤³¤È¤â¤Ç¤­¤ë¡£¤µ¤é¤Ë¡¤¤½¤ÎξÊý¤â²Äǽ¤È¤¹¤ë¡£¤¢¤ëʸ½ñ¤ÎDTD¤Ï¡¤Î¾Êý¤Î⊂¤ò¤Þ¤È¤á¤¿¤â¤Î¤È¤·¤Æ¹½À®¤¹¤ë¡£

&markup;Àë¸À¤Ï¡¤Í×ÁÇ·¿Àë¸À¡¤ °À­¥ê¥¹¥ÈÀë¸À¡¤¼ÂÂÎÀë¸ÀËô¤Ïµ­Ë¡Àë¸À¤È¤¹¤ë¡£¼¡¤Ë¼¨¤¹&well-formed;À©ÌóµÚ¤Ó&validity;À©Ìó¤Ëµ¬Äꤹ¤ë¤¬¡¤¤³¤ì¤é¤ÎÀë¸À¤Ï¡¤¶meter;¼ÂÂÎÆâ¤ËÁ´ÂÎËô¤Ï°ìÉô¤¬´Þ¤Þ¤ì¤Æ¤â¤è¤¤¡£¾Ü¤·¤¤µ¬Äê¤Ï¡¤ÊªÍý¹½Â¤¤Ë´Ø¤¹¤ëµ¬Äê¤ò»²¾È¤Î¤³¤È¡£

ʸ½ñ·¿ÄêµÁ doctypedecl '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>' markupdecl elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment &root;Í×ÁÇ·¿

ʸ½ñ·¿Àë¸À¤Ë¤ª¤±¤ëName¤Ï¡¤&root;Í×ÁǤη¿¤È&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

Àë¸ÀµÚ¤Ó¶meter;¼ÂÂΤ¬¸·Ì©¤ËÆþ¤ì»Ò¤ò¤Ê¤¹¤³¤È

¶meter;¼ÂÂΤÎ&replacement-text;¤Ï¡¤&markup;Àë¸ÀÆâ¤Ë¤ª¤¤¤Æ¡¤¸·Ì©¤ËÆþ¤ì»Ò¤Ë¤Ê¤Ã¤Æ¤¤¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤Ä¤Þ¤ê¡¤&markup;Àë¸À(markupdecl)¤ÎºÇ½éËô¤ÏºÇ¸å¤Îʸ»ú¤¬¡¤¶meter;¼ÂÂλ²¾È¤ÎÂоݤȤʤë&replacement-text;¤Ë´Þ¤Þ¤ì¤ì¤Ð¡¤Î¾Êý¤È¤âƱ¤¸&replacement-text;¤Ë´Þ¤Þ¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

 ÆâÉô⊂Æâ¤Î¶meter;¼ÂÂÎ

DTD¤ÎÆâÉô⊂¤Ç¤Ï¡¤¶meter;¼ÂÂλ²¾È¤Ï¡¤&markup;Àë¸À¤¬½Ð¸½²Äǽ¤Ê¾ì½ê¤À¤±¤Ë½Ð¸½¤Ç¤­¤ë¡£&markup;Àë¸ÀÆâ¤Ë¤Ï½Ð¸½¤Ç¤­¤Ê¤¤(¤³¤ÎÀ©Ìó¤Ï¡¤³°Éô¶meter;¼ÂÂÎËô¤Ï³°Éô⊂¤Ç¤Î»²¾È¤Ë¤ÏŬÍѤ·¤Ê¤¤¡£)¡£

ÆâÉô⊂¤Î¤È¤­¤ÈƱÍͤˡ¤³°Éô⊂µÚ¤ÓDTD¤Ë¤ª¤¤¤Æ»²¾È¤¹¤ëǤ°Õ¤Î³°Éô¶meter;¼ÂÂΤϡ¤Èó½ªÃ¼µ­¹æmarkupdecl¤Ë¤è¤Ã¤Æµö¤µ¤ì¤ë·¿¤Î¡¤°ìÏ¢¤Î´°Á´¤Ê&markup;Àë¸À¤Ç¹½À®¤µ¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£&markup;Àë¸À¤Î´Ö¤Ë¤Ï¡¤¶õÇòËô¤Ï¶meter;¼ÂÂλ²¾È¤òÃÖ¤¤¤Æ¤â¤è¤¤¡£¤·¤«¤·¡¤³°Éô⊂Ëô¤Ï³°Éô¶meter;¼ÂÂΤÎÆâÍƤΰìÉô¤Ï¡¤¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤ò»ÈÍѤ·¤Æ̵»ë¤·¤Æ¤â¤è¤¤¡£ÆâÉô¥µ¥Ö¥»¥Ã¥È¤Ç¤Ï¡¤¤³¤ì¤Ïµö¤µ¤ì¤Ê¤¤¡£ ³°Éô⊂ extSubset ( markupdecl | conditionalSect | PEReference | S )*

³°Éô⊂µÚ¤Ó³°Éô¶meter;¼ÂÂΤϡ¤¤½¤ÎÆâ¤Ç¤Ï¡¤¶meter;¼ÂÂΤ¬&markup;Àë¸À¤Î´Ö¤À¤±¤Ç¤Ê¤¯¡¤&markup;Àë¸À¤ÎÆâ¤Ç¤âǧ¼±¤µ¤ì¤ë¡¤¤È¤¤¤¦ÅÀ¤Ç¤âÆâÉô⊂¤È¤Ï°Û¤Ê¤ë¡£

ʸ½ñ·¿Àë¸ÀÉÕ¤­¤ÎXMLʸ½ñ¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ Hello, world! ]]> ¥·¥¹¥Æ¥à&identifier; "hello.dtd"¤¬¡¤Ê¸½ñ¤ÎDTD¤ÎURI¤È¤Ê¤ë¡£

¼¡¤ÎÎã¤Î¤È¤ª¤ê¡¤Àë¸À¤ò¶É½êŪ¤ËÍ¿¤¨¤ë¤³¤È¤â¤Ç¤­¤ë¡£ ]> Hello, world! ]]> ³°Éô⊂µÚ¤ÓÆâÉô⊂¤ÎξÊý¤ò»ÈÍѤ¹¤ë¤È¤­¤Ï¡¤ÆâÉô⊂¤¬³°Éô⊂¤è¤êÀè¤Ë½Ð¸½¤·¤¿¤È¸«¤Ê¤¹¡£¤³¤ì¤Ï¡¤ÆâÉô⊂¤Î¼ÂÂεڤÓ°À­¥ê¥¹¥ÈÀë¸À¤¬¡¤³°Éô⊂¤Î¼ÂÂεڤÓ°À­¥ê¥¹¥ÈÀë¸À¤è¤êÍ¥À褹¤ë¤È¤¤¤¦¸ú²Ì¤ò¤â¤¿¤é¤¹¡£

&standalone;ʸ½ñÀë¸À

XML&processor;¤Ï¡¤&application;¤Ëʸ½ñ¤ÎÆâÍƤòÅϤ¹¤¬¡¤&markup;Àë¸À¤Ï¡¤¤³¤ÎÆâÍƤ˱ƶÁ¤òÍ¿¤¨¤ë¤³¤È¤¬¤¢¤ë¡£Â°À­¤Î&default-value;µÚ¤Ó¼ÂÂÎÀë¸À¤ò¤½¤ÎÎã¤È¤¹¤ë¡£XMLÀë¸À¤Î°ìÉôʬ¤È¤·¤Æ½Ð¸½¤Ç¤­¤ë&standalone;ʸ½ñÀë¸À¤Ï¡¤Ê¸½ñ¤¬¡¤¤½¤Î&markup;Àë¸À¤Î¸ºß¤Ë¤è¤Ã¤Æ±Æ¶Á¤µ¤ì¤Ê¤¤¤³¤È¤ò»Ø¤·¼¨¤¹¡ÊÉáÄÌ¡¤¤½¤Î&markup;Àë¸À¤¬Â¸ºß¤·¤Ê¤¤¤¿¤á¤Ë¡¤¤³¤ì¤¬¤¤¤¨¤ë¡£¡Ë¡£ &standalone;ʸ½ñÀë¸À SDDecl S 'standalone' Eq "'" ('yes' | 'no') "'" | S 'standalone' Eq '"' ('yes' | 'no') '"'

&standalone;ʸ½ñÀë¸À¤Ë¤ª¤¤¤Æ¤Ï, "yes"¤ÎÃͤϡ¤Ê¸½ñ¼ÂÂΤγ°Éô¤Ë¡ÊDTD¤Î³°Éô⊂Æâ¤Ë¡¤Ëô¤ÏÆâÉô⊂¤«¤é»²¾È¤µ¤ì¤ë³°Éô¥Ñ¥é¥á¥¿¼ÂÂÎÆâ¤Ë¡Ë¡¤XML&processor;¤«¤é&application;¤Ø¤ÈÅϤµ¤ì¤ë¾ðÊó¤Ë±Æ¶Á¤¹¤ë&markup;Àë¸À¤¬Â¸ºß¤·¤Ê¤¤¤³¤È¤ò°ÕÌ£¤¹¤ë¡£"no"¤ÎÃͤϡ¤¤½¤Î³°Éô&markup;Àë¸À¤¬Â¸ºß¤¹¤ë¤«¡¤Ëô¤Ï¸ºß¤¹¤ë²ÄǽÀ­¤¬¤¢¤ë¤³¤È¤ò°ÕÌ£¤¹¤ë¡£&standalone;ʸ½ñÀë¸À¤Ï¡¤¤½¤ÎÀë¸À¤¬Ê¸½ñ³°Éô¤Ë¸ºß¤¹¤ë¤«¤É¤¦¤«¤ò¼¨¤¹¤À¤±¤ËÃí°Õ¤¹¤ë¤³¤È¡£³°Éô¼ÂÂΤؤλ²¾È¤¬Ê¸½ñÆâ¤Ë¸ºß¤·¤Æ¤¤¤Æ¤â¡¤¤½¤Î¼ÂÂΤ¬ÆâÉôŪ¤ËÀë¸À¤µ¤ì¤Æ¤¤¤ë¤È¤­¤Ï¡¤Ê¸½ñ¤Î&standalone;¤Î¾õÂ֤ˤϱƶÁ¤òÍ¿¤¨¤Ê¤¤¡£

³°Éô¤Ë&markup;Àë¸À¤¬Â¸ºß¤·¤Ê¤±¤ì¤Ð¡¤&standalone;ʸ½ñÀë¸À¤Ï°ÕÌ£¤ò¤â¤¿¤Ê¤¤¡£³°Éô¤Ë&markup;Àë¸À¤¬Â¸ºß¤·¡¤&standalone;ʸ½ñÀë¸À¤¬Â¸ºß¤·¤Ê¤¤¾ì¹ç¤Ï¡¤"no" ¤ÎÃͤÎÀßÄê¤ò²¾Äꤹ¤ë¡£

XMLʸ½ñ¤Ç standalone="no" ¤¬ÀßÄꤵ¤ì¤Æ¤¤¤ë¤â¤Î¤Ï¡¤¤¢¤ë¥¢¥ë¥´¥ê¥º¥à¤Ç&standalone;ʸ½ñ¤ËÊÑ´¹¤Ç¤­¡¤¤³¤Îʸ½ñ¤Ï¡¤¥Í¥Ã¥È¥ï¡¼¥¯ÇÛ¿®&application;¤Ë¤È¤Ã¤Æ˾¤Þ¤·¤¤¤«¤â¤·¤ì¤Ê¤¤¡£

&standalone;ʸ½ñÀë¸À

&standalone;ʸ½ñÀë¸À¤Ï¡¤²¿¤é¤«¤Î³°Éô&markup;Àë¸À¤¬¼¡¤Î¤¤¤º¤ì¤«¤òÀë¸À¤·¤Æ¤¤¤ë¤È¤­¤Ï¡¤ÃÍ "no" ¤ò¼è¤é¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

a) &default;ÃÍÉÕ¤­¤Î°À­¤Ç¤¢¤Ã¤Æ¡¤¤³¤Î°À­¤¬Å¬ÍѤµ¤ì¤ëÍ×ÁǤ¬¡¤Â°À­Ãͤò»ØÄꤻ¤º¤Ëʸ½ñÆâ¤Ë¸½¤ì¤ë¤â¤Î¡£

b) &magicents;°Ê³°¤Î¼ÂÂΤǤ¢¤Ã¤Æ¡¤¤½¤Î¼ÂÂΤËÂФ¹¤ë»²¾È¤¬Ê¸½ñÆâ¤Ë½Ð¸½¤¹¤ë¤â¤Î¡£

c) Ãͤ¬Àµµ¬²½¤ÎÂоݤȤʤë°À­¤Ç¤¢¤Ã¤Æ¡¤Àµµ¬²½¤Î·ë²Ì¤È¤·¤ÆÊѲ½¤¹¤ëÃͤ¬Ê¸½ñÆâ¤Ç°À­¤Ë»ØÄꤵ¤ì¤ë¤â¤Î¡£

d) Í×ÁÇÆâÍƤò¤â¤ÄÍ×ÁÇ·¿¤Ç¤¢¤Ã¤Æ¡¤¶õÇò¤¬¤½¤ÎÍ×ÁÇ·¿¤Î¤¤¤º¤ì¤«¤Î¥¤¥ó¥¹¥¿¥ó¥¹Æâ¤ËľÀܸ½¤ì¤ë¤â¤Î¡£

&standalone;ʸ½ñÀë¸ÀÉÕ¤­¤ÎXMLÀë¸À¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <?xml version="&XML.version;" standalone='yes'?>

 ¶õÇò¤Î¼è°·¤¤

XMLʸ½ñ¤òÊÔ½¸¤¹¤ë¤È¤­¤Ï¡¤&markup;¤òÌÜΩ¤¿¤»Æɤߤ䤹¤¯¤¹¤ë¤¿¤á¤Ë¡¤¡È¶õÇò¡É(&space;¡¤¥¿¥ÖµÚ¤Ó¶õÇò¹Ô¡£¤³¤Î&TR-or-Rec;¤Ç¤Ï¡¤Èó½ªÃ¼µ­¹æ¤ÎS¤Çɽ¤¹)¤ò»È¤¦¤ÈÊØÍø¤Ê¤³¤È¤¬Â¿¤¤¡£¤½¤Î¶õÇò¤Ï¡¤ÇÛÉÛ¤¹¤ë&version;¤Îʸ½ñ¤Î°ìÉô¤È¤·¤Æ´Þ¤á¤ë¤³¤È¤ò°Õ¿Þ¤·¤Ê¤¤¤Î¤òÉáÄ̤Ȥ¹¤ë¡£¤·¤«¤·¡¤¡È°ÕÌ£¤Î¤¢¤ë¡É¶õÇò¤Ç¤¢¤Ã¤Æ¡¤ÇÛÉÛ¤¹¤ë&version;¤Ë»Ä¤µ¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¤â¤Î¤â¿¤¤¡£Î㤨¤Ð¡¤»íµÚ¤Ó¥½¡¼¥¹¥³¡¼¥É¤Ë¤ª¤±¤ë¶õÇò¤¬¤¢¤ë¡£

XML&processor;¤Ï¡¤Ê¸½ñÆâ¤Î&markup;°Ê³°¤Î¤¹¤Ù¤Æ¤Îʸ»ú¤ò¡¤¤½¤Î¤Þ¤ÞÊѹ¹¤»¤º¤Ë&application;¤ËÅϤµ¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£&validating;XML&processor;¤Ï¡¤Í×ÁÇÆâÍƤÎÃæ¤Î¶õÇò¤ò¾¤ÎÈó&markup;ʸ»ú¤«¤é¶èÊ̤·¡¤&application;¦¤ËÍ×ÁÇÆâÍƤÎÃæ¤Î¶õÇò¤¬½ÅÍפǤʤ¤¤È¤¤¤¦¤³¤È¤òÅÁ¤¨¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

"xml:space"¤È¤¤¤¦ÆÃÊ̤Ê°À­¤òʸ½ñ¤ËÁÞÆþ¤¹¤ë¤³¤È¤Ë¤è¤Ã¤Æ¡¤¶õÇò¤ò½ÅÍפȤ¹¤ë°Õ¿Þ¤ò¼¨¤·¤Æ¤â¤è¤¤¡£¤³¤Î°À­¤òŬÍѤ¹¤ëÍ×ÁǤ˸½¤ì¤ë¶õÇò¤ò¡¤¥¢¥×¥ê¥±¡¼¥·¥ç¥ó¤¬½ÅÍפʤâ¤Î¤È¤·¤Æ°·¤¦¤³¤È¤òÍ׵᤹¤ë¡¤¤È¤¤¤¦°Õ¿Þ¤ò¼¨¤¹¡£

&valid;¤Êʸ½ñ¤Ç¤Ï¡¤¤³¤Î°À­¤ò»ÈÍѤ¹¤ë¾ì¹ç¤Ï¡¤Â¾¤Î°À­¤ÈƱ¤¸¤è¤¦¤ËÀë¸À¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£Àë¸À¤¹¤ë¤È¤­¤Ï¡¤¼è¤êÆÀ¤ëÃͤò"default"µÚ¤Ó "preserve"¤À¤±¤È¤¹¤ëÎóµó·¿¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

ÃÍ"default"¤Ï¡¤&application;¤Î&default;¤Î¶õÇò½èÍý¥â¡¼¥É¤ò¡¤¤½¤ÎÍ×ÁǤËŬÍѲÄǽ¤È¤¹¤ë¤³¤È¤ò°ÕÌ£¤¹¤ë¡£ÃÍ"preserve"¤Ï¡¤&application;¤¬¤¹¤Ù¤Æ¤Î¶õÇò¤òÊݸ¤¹¤ë¤³¤È¤ò°ÕÌ£¤¹¤ë¡£¤³¤ÎÀë¸À¤Î°Õ¿Þ¤Ï¡¤"xml:space" °À­¤ÎÊ̤λØÄê¤Ç¾å½ñ¤­¤·¤Ê¤¤¸Â¤ê¡¤Í×ÁǤÎÆâÍƤ˸½¤ì¤ë¤¹¤Ù¤Æ¤ÎÍ×ÁǤËŬÍѤ¹¤ë¤È²ò¼á¤¹¤ë¡£

ʸ½ñ¤Î&root;Í×ÁǤˤĤ¤¤Æ¤Ï¡¤¤³¤Î°À­¤ÎÃͤò»ØÄꤹ¤ë¤«¡¤Ëô¤Ï¤³¤Î°À­¤Î&default-value;¤¬¤¢¤ë¾ì¹ç¤ò½ü¤¤¤Æ¤Ï¡¤&application;¤Ë¤è¤ë¶õÇò¤Î¼è°·¤¤¤Ë¤Ä¤¤¤Æ¡¤¤¤¤«¤Ê¤ë°Õ¿Þ¤â¼¨¤µ¤Ê¤¤¤È²ò¼á¤¹¤ë¡£

Îã¤ò¼¡¤Ë¼¨¤¹¡£ ]]>

¹ÔËö¤Î¼è°·¤¤

XML¤Î¹½Ê¸&parsed-entity;¤Ï¡¤Ä̾拾¥ó¥Ô¥å¡¼¥¿¤Î¥Õ¥¡¥¤¥ëÆâ¤ËÊݸ¤µ¤ì¡¤ÊÔ½¸¤ÎÊص¹¤Î¤¿¤á¤ËÊ£¿ô¤Î¹Ô¤Ëʬ¤±¤ë¤³¤È¤¬Â¿¤¤¡£¤³¤ì¤é¤Î¹Ô¤Ï¡¤ÉáÄ̤ϡ¤CR (#xD)¥³¡¼¥ÉµÚ¤Ó LF (#xA)¥³¡¼¥É¤Î²¿¤é¤«¤ÎÁȹ礻¤Ë¤è¤Ã¤Æʬ¤±¤é¤ì¤ë¡£

&application;¤Î½èÍý¤ò´Êñ¤Ë¤¹¤ë¤¿¤á¡¤³°Éô&parsed-entity;Ëô¤ÏÆâÉô&parsed-entity;¤Î&literal;¼ÂÂÎÃͤ¬¡¤"#xD#xA" ¤Î£²Ê¸»ú¤ÎϢ³¤È¤¹¤ë&literal;Ëô¤Ï#xD¤ÎñÆȤÎ&literal;¤ò´Þ¤à¾ì¹ç¤Ë¡¤XML&processor;¤Ï¡¤&application;¤Ëñ°ì¤Îʸ»ú#xA¤À¤±¤òÅϤµ¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤(¤³¤Î½èÍý¤Ï¡¤ÆþÎÏÆâ¤Ë¸ºß¤¹¤ë²þ¹Ô¥³¡¼¥É¤ò¹½Ê¸²òÀϤÎÁ°¤ËÀµµ¬²½¤¹¤ë¤³¤È¤Ë¤è¤Ã¤Æ¡¤Íưפ˼¸½¤Ç¤­¤ë¡£)¡£

 &language-identification;

ʸ½ñ½èÍý¤Ë¤ª¤¤¤Æ¤Ï¡¤¤½¤Îʸ½ñ¤ÎÃæ¿È¤¬¤É¤ó¤Ê¼«Á³¸À¸ìËô¤Ï·Á¼°¸À¸ì¤Ç½ñ¤«¤ì¤Æ¤¤¤ë¤«ÌÀ¼¨¤¹¤ë¤³¤È¤¬¡¤Ìò¤ËΩ¤Ä¤³¤È¤¬Â¿¤¤¡£

XMLʸ½ñÆâ¤ÎÍ×ÁǤΤâ¤ÄÆâÍÆËô¤Ï°À­Ãͤˤª¤¤¤Æ»ÈÍѤ¹¤ë¸À¸ì¤ò»ØÄꤹ¤ë¤¿¤á¤Ë¡¤"xml:lang" ¤È¤¤¤¦Ì¾Á°¤ÎÆÃÊ̤Ê°À­¤ò¡¤Ê¸½ñÆâ¤ËÁÞÆþ¤·¤Æ¤â¤è¤¤¡£ °À­¤ÎÃͤϡ¤¡ÈRFC1766¡§&language-identification;¤Î¤¿¤á¤Î¥¿¥°¡É¤Ë¤è¤Ã¤Æµ¬Äꤵ¤ì¤ë&language-identification;¥³¡¼¥É¤Ë½¾¤¦¡£ &language-identification; LanguageID Langcode ('-' Subcode)* Langcode ISO639Code | IanaCode | UserCode ISO639Code ([a-z] | [A-Z]) ([a-z] | [A-Z]) IanaCode ('i' | 'I') '-' ([a-z] | [A-Z])+ UserCode ('x' | 'X') '-' ([a-z] | [A-Z])+ Subcode ([a-z] | [A-Z])+ Langcode¤Ï¡¤¼¡¤Î¤É¤ì¤Ç¤â¤è¤¤¡£

a) ¡È¸À¸ì¤Î̾Á°É½¸½¤Î¤¿¤á¤Î¥³¡¼¥É¡É¤Çµ¬Äꤵ¤ì¤ë2ʸ»ú¤Î&language-code;

b) Internet Assigned Numbers Authority (IANA)¤ÇÅÐÏ¿¤µ¤ì¤Æ¤¤¤ë&language-code;¡£¤³¤ì¤Ï¡¤ÀèƬ¤¬ "i-" (Ëô¤Ï"I-")¤Ç»Ï¤Þ¤ë¡£

c) &user;¤Ë¤è¤Ã¤ÆÄê¤á¤é¤ì¤¿&language-code;¡¤Ëô¤Ï»äŪ¤Ê»ÈÍѤΤ¿¤á¤ËÊ£¿ô¤ÎÃÄÂδ֤¬¼è¤ê·è¤á¤¿¥³¡¼¥É¡£¤³¤ì¤é¤Ï¡¤º£¸åIANA¤Ë¤ª¤¤¤Æɸ½à²½Ëô¤ÏÅÐÏ¿¤µ¤ì¤ë¥³¡¼¥É¤È¤Î¶¥¹ç¤òÈò¤±¤ë¤¿¤á¤Ë¡¤ÀèƬ¤ò"x-" Ëô¤Ï "X-" ¤Ç»Ï¤á¤ë¡£

Subcode¤Ï¡¤Ê£¿ô²ó»È¤Ã¤Æ¤â¤è¤¤¡£ºÇ½é¤Î¥µ¥Ö¥³¡¼¥É¤¬Â¸ºß¤·¡¤¤½¤ÎÆâÍƤ¬Æó¤Ä¤Îʸ»ú¤«¤éÀ®¤ë¤È¤­¤Ï¡¤ISO3166¤Î¡È¹ñ̾¤òɽ¤¹¥³¡¼¥É(¹ñ¥³¡¼¥É)¡É¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£ºÇ½é¤Î¥µ¥Ö¥³¡¼¥É¤¬3ʸ»ú°Ê¾å¤«¤éÀ®¤ë¤È¤­¤Ï¡¤Langcode¤ÎÀèƬ¤¬¡¤"x-" Ëô¤Ï "X-"¤Ç»Ï¤Þ¤é¤Ê¤¤¸Â¤ê¡¤»ØÄꤷ¤¿¸À¸ì¤ËÂФ¹¤ë¥µ¥Ö¥³¡¼¥É¤È¤·¡¤IANA¤ËÅÐÏ¿¤µ¤ì¤¿¤â¤Î¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

&language-code;¤Ï¡¤¾®Ê¸»ú¤Ç¤Îɽµ­¤ò¡¤&country-code;¤Ï¡¤(¸ºß¤¹¤ë¤Ê¤é¤Ð)Âçʸ»ú¤Ç¤Îɽµ­¤ò´·¹Ô¤È¤¹¤ë¡£¤·¤«¤·¡¤XMLʸ½ñÆâ¤Ë¤ª¤±¤ë¾¤Î̾Á°¤È¤Ï°Û¤Ê¤ê¡¤¤³¤ì¤é¤ÎÃͤˤĤ¤¤Æ¤Ï¡¤Âçʸ»úµÚ¤Ó¾®Ê¸»ú¤Î¶èÊ̤ò¤·¤Ê¤¤¤³¤È¤ËÃí°Õ¤¹¤ë¤³¤È¡£

Îã¤ò¼¡¤Ë¼¨¤¹¡£ The quick brown fox jumps over the lazy dog.

What colour is it?

What color is it?

Habe nun, ach! Philosophie, Juristerei, und Medizin und leider auch Theologie ]]>durchaus studiert mit heißem Bemüh'n. ]]>

xml:lang¤ÇÀë¸À¤¹¤ë°Õ¿Þ¤Ï¡¤xml:lang¤ÎÊ̤λØÄê¤Ç¾å½ñ¤·¤Ê¤¤¸Â¤ê¡¤»ØÄꤷ¤¿Í×ÁǤÎÆâÍƤ˴ޤह¤Ù¤Æ¤ÎÍ×ÁǤËŬÍѤ¹¤ë¡£

&valid;¤Êʸ½ñ¤Ë¤ª¤¤¤Æ¤Ï¡¤¤³¤Î&TR-or-Rec;¤Î¾¤Î¾ì½ê¤Çµ¬Äꤹ¤ë¤È¤ª¤ê¡¤¤³¤Î°À­¤òɬ¤ºÀë¸À¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£Ä̾Àë¸À¤Ï¡¤¼¡¤Î·Á¤È¤¹¤ë¡£ xml:lang NMTOKEN #IMPLIED ɬÍפʤé¤Ð¡¤ÆÃÄê¤Î&default-value;¤òÍ¿¤¨¤Æ¤â¤è¤¤¡£±Ñ¸ì¤òÊì¸ì¤È¤¹¤ë³ØÀ¸ÍѤΥեé¥ó¥¹¸ì¤Î»í½¸¤Ç¤Ï¡¤ÀâÌÀµÚ¤ÓÃí¤ò±Ñ¸ì¤Çµ­½Ò¤¹¤ì¤Ð¡¤xml:lang °À­¤ò¼¡¤Î¤È¤ª¤ê¤ËÀë¸À¤¹¤ë¤³¤È¤È¤Ê¤ë¡£ ]]>

ÏÀÍý¹½Â¤

¤¤¤«¤Ê¤ëXMLʸ½ñ¤â¡¤°ì¤Ä°Ê¾å¤ÎÍ×ÁǤò´Þ¤à¡£Í×ÁǤζ­³¦¤Ï, ³«»Ï¥¿¥°µÚ¤Ó½ªÎ»¥¿¥°¤Ë¤è¤Ã¤Æ¶èÀڤ롣Í×ÁǤ¬¶õÍ×ÁǤΤȤ­¤Ï¡¤¶õÍ×ÁÇ¥¿¥°¤Ç¼¨¤¹¡£³Æ¡¹¤ÎÍ×ÁǤϡ¤·¿¤ò¤â¤Ä¡£Í×ÁÇ·¿¤Ï̾Á°(¶¦ÄÌ&identifier;(generic identifier)Ëô¤ÏGI¤È¸Æ¤Ö¤³¤È¤¬¤¢¤ë¡£)¤Ë¤è¤Ã¤Æ&identified;¡£Í×ÁǤϡ¤¤¤¤¯¤Ä¤«¤Î°À­¤ò¤â¤Ä¤³¤È¤¬¤Ç¤­¤ë¡£Â°À­¤Ï¡¤Ì¾Á°µÚ¤ÓÃͤò¤â¤Ä¡£

Í×ÁÇ element EmptyElemTag | STag content ETag

¤³¤Î&TR-or-Rec;¤Ï¡¤Í×ÁÇ·¿µÚ¤Ó°À­¤Î°ÕÌ£¡¤»ÈÍÑÊýË¡¡¤Ëô¤Ï(¹½Ê¸¤Ë´Ø¤¹¤ë¤³¤È¤ò½ü¤­)̾Á°¤ËÀ©Ìó¤òÍ¿¤¨¤Ê¤¤¡£¤¿¤À¤·¡¤ÀèƬ¤¬(('X'|'x')('M'|'m')('L'|'l'))¤Ë&match;¤¹¤ë̾Á°¤Ï¡¤¤³¤ÎÈÇËô¤Ïº£¸å¤ÎÈǤΤ³¤Î&TR-or-Rec;¤Ç¤Îɸ½à²½¤Î¤¿¤á¤ËͽÌ󤹤롣

Í×ÁÇ·¿¤Î&match;

Í×ÁǤνªÎ»¥¿¥°¤Î̾Á°¤Ï¡¤¤½¤ÎÍ×ÁǤγ«»Ï¥¿¥°¤Ë¤ª¤±¤ë·¿¤È&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

 ³«»Ï¥¿¥°¡¤½ªÎ»¥¿¥°µÚ¤Ó¶õÍ×ÁÇ¥¿¥°

¶õ¤Ç¤Ê¤¤Ç¤°Õ¤ÎXMLÍ×ÁǤλϤޤê¤Ï¡¤³«»Ï¥¿¥°¤Ë¤è¤Ã¤Æ&markup;¤¹¤ë¡£ ³«»Ï¥¿¥° STag'<' Name (S Attribute)* S? '>' AttributeName Eq AttValue ³«»Ï¥¿¥°µÚ¤Ó½ªÎ»¥¿¥°Æâ¤ÎName¤Ï¡¤Í×ÁǤη¿¤òɽ¤ï¤¹¡£NameµÚ¤ÓAttValue¤ÎÂФòÍ×ÁǤΰÀ­»ØÄê¤È¤¤¤¤¡¤¸Ä¡¹¤ÎÂФˤª¤±¤ëName¤Ï¡¤Â°À­Ì¾µÚ¤ÓAttValue¤ÎÆâÍÆ(¶èÀÚ¤ê»Ò'Ëô¤Ï"¤Î´Ö¤Î&string;)¤ò°À­ÃͤȤ¤¤¦¡£

°À­»ØÄê¤Î°ì°ÕÀ­

³«»Ï¥¿¥°Ëô¤Ï¶õÍ×ÁÇ¥¿¥°¤Ç¤Ï¡¤Æ±°ì¤Î°À­Ì¾¤¬£²Åٰʾå½Ð¸½¤·¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£

 °À­Ãͤη¿

°À­¤ÏÀë¸À¤µ¤ì¤Æ¤¤¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£Â°À­Ãͤη¿¤Ï¡¤¤½¤Î°À­¤ËÂФ·¤ÆÀë¸À¤·¤¿·¿¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤(°À­¤Î·¿¤Ë¤Ä¤¤¤Æ¤Ï¡¤Â°À­¥ê¥¹¥ÈÀë¸À¤Ë¤Ä¤¤¤Æ¤Îµ¬Äê¤ò»²¾È¡£)¡£

 ³°Éô¼ÂÂΤؤλ²¾È¤¬¤Ê¤¤¤³¤È

°À­Ãͤˤϡ¤³°Éô¼ÂÂΤؤÎľÀÜŪËô¤Ï´ÖÀÜŪ¤Ê»²¾È¤ò´Þ¤à¤³¤È¤Ï¤Ç¤­¤Ê¤¤¡£

 °À­ÃͤË<¤ò´Þ¤Þ¤Ê¤¤¤³¤È

°À­ÃÍÆâ¤ÇľÀÜŪËô¤Ï´ÖÀÜŪ¤Ë»²¾È¤¹¤ë¼ÂÂÎ(&lt;¤ò½ü¤¯¡£)¤Î&replacement-text;¤Ë¤Ï¡¤<¤ò´Þ¤ó¤Ç¤Ï¤Ê¤é¤Ê¤¤¡£

³«»Ï¥¿¥°¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <termdef id="dt-dog" term="dog">

³«»Ï¥¿¥°¤Ç»Ï¤Þ¤ëÍ×ÁǤνª¤ï¤ê¤Ï¡¤½ªÎ»¥¿¥°¤Ç&markup;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤³¤Î½ªÎ»¥¿¥°¤Ï¡¤Âбþ¤¹¤ë³«»Ï¥¿¥°¤ÎÍ×ÁÇ·¿¤ÈƱ¤¸Ì¾Á°¤ò¤â¤Ä¡£ ½ªÎ»¥¿¥°ETag'</' Name S? '>'

½ªÎ»¥¿¥°¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ </termdef>

Í×ÁǤγ«»Ï¥¿¥°¤È½ªÎ»¥¿¥°¤È¤Î´Ö¤Î¥Æ¥­¥¹¥È¤ò¡¤¤½¤ÎÍ×ÁǤÎÆâÍƤȤ¤¤¦¡£ Í×ÁǤÎÆâÍÆ content(element | CharData | Reference | CDSect | PI | Comment)*

Í×ÁǤ¬¶õ¤Î¤È¤­¡¤¤½¤ÎÍ×ÁǤϡ¤Ä¾¸å¤Ë½ªÎ»¥¿¥°¤ò¤â¤Ä³«»Ï¥¿¥°Ëô¤Ï¶õÍ×ÁÇ¥¿¥°¤Çɽ¸½¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¶õÍ×ÁÇ¥¿¥°¤Ï¡¤¼¡¤ÎÆÃÊ̤ʷÁ¼°¤ò¤È¤ë¡£ ¶õÍ×ÁǤΤ¿¤á¤Î¥¿¥°EmptyElemTag'<' Name (S Attribute)* S? '/>'

¶õÍ×ÁÇ¥¿¥°¤Ï¡¤ÆâÍƤò¤â¤¿¤Ê¤¤Ç¤°Õ¤ÎÍ×ÁǤÎɽ¸½¤ËÍøÍѤǤ­¤ë¡£¶õÍ×ÁÇ¥¿¥°¤Çɽ¸½¤¹¤ëÍ×ÁǤò¡¤¥­¡¼¥ï¡¼¥ÉEMPTY¤òÍѤ¤¤ÆÀë¸À¤·¤Ê¤¯¤È¤â¤è¤¤¡£

¶õÍ×ÁǤÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <IMG align="left" src="http://www.w3.org/Icons/WWW/w3c_home" /><br></br><br/>

 Í×ÁÇÀë¸À

&validity;¤òÊݾڤ¹¤ë¤¿¤á¡¤Í×ÁÇÀë¸ÀµÚ¤Ó°À­¥ê¥¹¥ÈÀë¸À¤òÍѤ¤¤ÆXMLʸ½ñ¤ÎÍ×ÁǤι½Â¤¤Ë¡¤À©Ìó¤ò²Ã¤¨¤ë¤³¤È¤¬¤Ç¤­¤ë¡£

Í×ÁÇÀë¸À¤Ï¡¤Í×ÁǤÎÆâÍƤˤĤ¤¤Æ¤ÎÀ©Ìó¤È¤¹¤ë¡£

Í×ÁÇÀë¸À¤Ï¡¤Í×ÁǤλҤȤ·¤Æ½Ð¸½²Äǽ¤ÊÍ×ÁÇ·¿¤Ë¤Ä¤¤¤Æ¡¤À©Ìó¤ò²Ã¤¨¤ë¤³¤È¤¬Â¿¤¤¡£&at-user-option;¡¤Í×ÁÇÀë¸À¤ò¤â¤¿¤Ê¤¤Í×ÁÇ·¿¤¬Â¾¤ÎÍ×ÁÇÀë¸À¤Ë¤è¤Ã¤Æ»²¾È¤µ¤ì¤ì¤Ð¡¤XML&processor;¤Ï¡¤·Ù¹ð¤ò½Ð¤·¤Æ¤â¤è¤¤¡£¤·¤«¤·¡¤¤³¤ì¤Ï&error;¤È¤Ï¤·¤Ê¤¤¡£

Í×ÁÇ·¿Àë¸À¤Ï¡¤¼¡¤Î·Á¼°¤ò¤È¤ë¡£ Í×ÁÇ·¿Àë¸À elementdecl '<!ELEMENT' S Name S contentspec S? '>' contentspec 'EMPTY' | 'ANY' | Mixed | children ¤³¤³¤Ç¡¤Name¤Ï¡¤Àë¸À¤µ¤ì¤Æ¤¤¤ëÍ×ÁǤη¿¤È¤¹¤ë¡£

Í×ÁÇÀë¸À¤Î°ì°ÕÀ­

Í×ÁÇ·¿¤ò£²ÅٰʾåÀë¸À¤Ç¤­¤Ê¤¤¡£

 Í×ÁǤÎ&validity;

Í×ÁǤ¬&valid;¤È¤Ï¡¤elementdecl¤Ë&match;¤¹¤ëÀë¸À¤Ç¤¢¤Ã¤Æ¡¤¤½¤ÎName¤¬¤½¤ÎÍ×ÁÇ·¿¤È&match;¤·¡¤¼¡¤Î¤¤¤º¤ì¤«¤Î¾ò·ï¤òËþ¤¿¤¹¾ì¹ç¤È¤¹¤ë¡£

a) Àë¸À¤¬EMPTY¤Ë&match;¤·¡¤Í×ÁǤ¬ÆâÍƤò¤â¤¿¤Ê¤¤¡£

b) Àë¸À¤¬children¤Ë&match;¤·¡¤Í×ÁǤλÒÍ×ÁǤÎʤӤ¬¡¤ÆâÍÆ¥â¥Ç¥ë¤ÎÀµµ¬É½¸½¤Ë¤è¤Ã¤ÆÀ¸À®¤µ¤ì¤ë¸À¸ì¤Ë°¤¹¤ë¡£

c) Àë¸À¤¬mixed¤Ë&match;¤·¡¤Í×ÁǤÎÆâÍƤ¬Ê¸»ú¥Ç¡¼¥¿µÚ¤Ó»ÒÍ×ÁǤ«¤é¤Ê¤ë¡£»ÒÍ×ÁǤÎÍ×ÁÇ·¿¤Ï¡¤Í×ÁǤÎÆâÍÆ¥â¥Ç¥ë¤Ë½Ð¸½¤¹¤ë̾Á°¤Ë&match;¤¹¤ë¡£

d) Àë¸À¤¬ANY¤Ë&match;¤·¡¤¤É¤Î»ÒÍ×ÁǤÎÍ×ÁÇ·¿¤âÀë¸À¤µ¤ì¤Æ¤¤¤ë¡£

Í×ÁÇÀë¸À¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <!ELEMENT br EMPTY> <!ELEMENT p (#PCDATA|emph)* > <!ELEMENT %name.para; %content.para; > <!ELEMENT container ANY>

Í×ÁÇÆâÍÆ

¤¢¤ë·¿¤ÎÍ×ÁǤ¬»ÒÍ×ÁǤÀ¤±¤ò´Þ¤à(ʸ»ú¥Ç¡¼¥¿¤ò´Þ¤Þ¤Ê¤¤¡£)¤È¤­¡¤¤½¤ÎÍ×ÁÇ·¿¤Ï¡¤Í×ÁÇÆâÍƤò¤â¤Ä¡¤¤È¤¤¤¦¡£¤³¤Î¾ì¹ç¡¤À©Ìó¤Ï¡¤ÆâÍÆ¥â¥Ç¥ë¤ò´Þ¤à¡£ÆâÍÆ¥â¥Ç¥ë¤Ï¡¤»ÒÍ×ÁǤη¿µÚ¤Ó»ÒÍ×ÁǤνи½½ç½ø¤òÀ©¸æ¤¹¤ë´Êñ¤Êʸˡ¤È¤¹¤ë¡£¤³¤Îʸˡ¤Ï¡¤&content-particle;(cps)¤«¤é¤Ê¤ë¡£&content-particle;¤Ï¡¤Ì¾Á°¡¤&content-particle;¤ÎÁªÂò¥ê¥¹¥ÈËô¤Ï&content-particle;¤ÎÎó¥ê¥¹¥È¤«¤é¹½À®¤µ¤ì¤ë¡£ Í×ÁÇÆâÍÆ¥â¥Ç¥ë children(choice | seq) ('?' | '*' | '+')?cp(Name | choice | seq) ('?' | '*' | '+')? choice'(' S? cp ( S? '|' S? cp )*S? ')' seq'(' S? cp ( S? ',' S? cp )*S? ')' ¤³¤³¤Ç¡¤Name¤Ï¡¤»Ò¤È¤·¤Æ½Ð¸½¤·¤Æ¤è¤¤Í×ÁǤη¿¤ò¼¨¤¹¡£¤³¤Îʸˡ¤ÇÁªÂò¥ê¥¹¥È¤¬¸½¤ì¤ë°ÌÃ֤Ǥϡ¤ÁªÂò¥ê¥¹¥ÈÆâ¤Î¤¤¤º¤ì¤Î&content-particle;¤âÍ×ÁÇÆâÍƤÎÃæ¤Ë¸½¤ì¤Æ¤è¤¤¡£Îó¥ê¥¹¥È¤Ë¸½¤ì¤ë&content-particle;¤Ï¡¤¥ê¥¹¥È¤Ç»ØÄꤹ¤ë½çÈ֤ΤȤª¤ê¤Ë¡¤Í×ÁÇÆâÍƤ˸½¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£Ì¾Á°Ëô¤Ï¥ê¥¹¥È¤Î¸å¤Ë½Ð¸½¤¹¤ë¥ª¥×¥·¥ç¥ó¤Îʸ»ú¤Ï¡¤¥ê¥¹¥ÈÆâ¤ÎÍ×ÁÇËô¤Ï&content-particle;¤¬¡¤1²ó°Ê¾åǤ°Õ¤Î²ó¿ô(+)¡¤0²ó°Ê¾åǤ°Õ¤Î²ó¿ô(*)Ëô¤Ï0²ó¼ã¤·¤¯¤Ï1²ó(?)½Ð¸½²Äǽ¤Ê¤³¤È¤òµ¬Äꤹ¤ë¡£¤³¤³¤Ç¼¨¤¹¹½Ê¸µÚ¤Ó°ÕÌ£¤Ï¡¤¤³¤Î&TR-or-Rec;¤Ë¤ª¤±¤ëÀ¸À®µ¬Â§¤ÇÍѤ¤¤ë¤â¤Î¤ÈƱ°ì¤È¤¹¤ë¡£

Í×ÁǤÎÆâÍƤ¬ÆâÍÆ¥â¥Ç¥ë¤Ë&match;¤¹¤ë¤Î¤Ï¡¤Îó¡¤ÁªÂòµÚ¤Ó·«ÊÖ¤·±é»»»Ò¤Ë¤·¤¿¤¬¤Ã¤Æ¡¤ÆâÍƤÎÃæ¤ÎÍ×ÁǤÈÆâÍÆ¥â¥Ç¥ëÆâ¤ÎÍ×ÁÇ·¿¤È¤ò&match;¤µ¤»¤Ê¤¬¤é¡¤ÆâÍÆ¥â¥Ç¥ëÆâ¤Î°ì¤Ä¤Î¥Ñ¥¹¤ò¤¿¤É¤ì¤ë¤È¤­¤Ë¸Â¤ë¡£¸ß´¹À­¤Î¤¿¤á¡¤Ê¸½ñÆâ¤ÎÍ×ÁǤ¬¡¤ÆâÍÆ¥â¥Ç¥ë¤Ë¤ª¤±¤ëÍ×ÁÇ·¿¤ÎÊ£¿ô¤Î½Ð¸½°ÌÃÖ¤È&match;¤¹¤ë¤³¤È¤Ï¡¤&error;¤È¤¹¤ë¡£¾ÜºÙ¤Êµ¬Äê¤Ë¤Ä¤¤¤Æ¤Ï¡¤Éí°½ñ¤Î·èÄêŪÆâÍÆ¥â¥Ç¥ë¤Î¹à¤ò»²¾È¡£

¥°¥ë¡¼¥×µÚ¤Ó¥Ñ¥é¥á¥¿¼ÂÂΤ¬¸·Ì©¤ÊÆþ¤ì»Ò¤ò¤Ê¤·¤Æ¤¤¤ë¤³¤È

¥Ñ¥é¥á¥¿¼ÂÂΤÎ&replacement-text;¤Ï¡¤&parenthesis;¤Ç°Ï¤Þ¤ì¤¿¥°¥ë¡¼¥×¤Ë¤è¤Ã¤Æ¡¤¸·Ì©¤ÊÆþ¤ì»Ò¤ò¹½À®¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤Ä¤Þ¤ê¡¤ÁªÂò¡¤ÎóËô¤Ïº®ºßÉôÉʤˡ¤&left-parenthesis;Ëô¤Ï&right-parenthesis;¤Î¤¤¤º¤ì¤«°ìÊý¤¬¥Ñ¥é¥á¥¿¼ÂÂΤÎ&replacement-text;¤Ë´Þ¤ì¤ì¤Ð¡¤Â¾Êý¤âƱ¤¸&replacement-text;¤Ë´Þ¤Þ¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

Áê¸ß±¿ÍÑÀ­¤Î¤¿¤á¡¤¥Ñ¥é¥á¥¿¼ÂÂλ²¾È¤¬ÁªÂò¡¤ÎóËô¤Ïº®ºßÆâÍƤ˴ޤޤì¤ì¤Ð¡¤¤½¤Î&replacement-text;¤Ï¶õ¤Ç¤Ê¤¤¤³¤È¤¬Ë¾¤Þ¤·¤¯¡¤&replacement-text;¤ÎÀèƬµÚ¤ÓËöÈø¤Î¶õÇò¤Ç¤Ê¤¤Ê¸»ú¤Ï¡¤¥³¥Í¥¯¥¿(|Ëô¤Ï,)¤Ç¤Ê¤¤Êý¤¬¤è¤¤¡£

Í×ÁÇÆâÍÆ¥â¥Ç¥ë¤Î¤¤¤¯¤Ä¤«¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <!ELEMENT spec (front, body, back?)> <!ELEMENT div1 (head, (p | list | note)*, div2*)> <!ELEMENT dictionary-body (%div.mix; | %dict.mix;)*>

 &mixed-content;

¤¢¤ëÍ×ÁÇ·¿¤ÎÍ×ÁÇÆâ¤Ë¡¤»ÒÍ×ÁǤ˺®ºß¤·¤Æʸ»ú¥Ç¡¼¥¿¤¬´Þ¤Þ¤ì¤ë²ÄǽÀ­¤¬¤¢¤ë¤È¤­¡¤¤½¤ÎÍ×ÁÇ·¿¤Ï¡¤&mixed-content;¤ò¤â¤Ä¤È¤¤¤¦¡£¤³¤Î¾ì¹ç¡¤»ÒÍ×ÁǤη¿¤Ë¤Ä¤¤¤Æ¤ÎÀ©Ìó¤¬Â¸ºß¤·¤Æ¤â¤è¤¤¤¬¡¤»ÒÍ×ÁǤνç½øËô¤Ï½Ð¸½²ó¿ô¤Ë¤Ä¤¤¤Æ¤ÎÀ©Ìó¤Ï¤Ê¤¤¤È¤¹¤ë¡£ &mixed-content;Àë¸À Mixed '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' | '(' S? '#PCDATA' S? ')' ¤³¤³¤Ç¡¤Name¤Ï¡¤»Ò¤È¤·¤Æ½Ð¸½¤·¤Æ¤â¤è¤¤Í×ÁǤη¿¤ò¼¨¤¹¡£

Í×ÁÇ·¿¤Î½ÅÊ£¤Î¶Ø»ß

°ì¤Ä¤Î&mixed-content;Àë¸ÀÆâ¤Ë¡¤Æ±¤¸Ì¾Á°¤¬Ê£¿ô²ó½Ð¸½¤·¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£

&mixed-content;Àë¸À¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <!ELEMENT p (#PCDATA|a|ul|b|i|em)*> <!ELEMENT p (#PCDATA | %font; | %phrase; | %special; | %form;)* > <!ELEMENT b (#PCDATA)>

 °À­¥ê¥¹¥ÈÀë¸À

°À­¤Ï¡¤Ì¾Á°µÚ¤ÓÃͤÎÂФòÍ×ÁǤ˴ØÏ¢ÉÕ¤±¤ë¤¿¤á¤ËÍѤ¤¤ë¡£Â°À­»ØÄê¤Ï¡¤³«»Ï¥¿¥°Ëô¤Ï¶õÍ×ÁÇ¥¿¥°Æâ¤Ç¤À¤±²Äǽ¤È¤¹¤ë¡£¤·¤¿¤¬¤Ã¤Æ¡¤Â°À­¤òǧ¼±¤¹¤ë¤¿¤á¤ÎÀ¸À®µ¬Â§¤Ï¡¤³«»Ï¥¿¥°¤Ë¤Ä¤¤¤Æ¤Îµ¬Äê¤Ç¼¨¤¹¡£Â°À­¥ê¥¹¥ÈÀë¸À¤Ï¡¤¼¡¤ÎÌÜŪ¤ÇÍѤ¤¤ë¡£

a) ¤¢¤ëÍ×ÁÇ·¿¤ËŬÍѤ¹¤ë°À­¤Î½¸¹ç¤òµ¬Äꤹ¤ë¡£

b) °À­¤Ø¤Î·¿À©Ìó¤òÀßÄꤹ¤ë¡£

c) °À­¤Î&default-value;¤òµ¬Äꤹ¤ë¡£

°À­¥ê¥¹¥ÈÀë¸À¤Ï¡¤¤¢¤ëÍ×ÁÇ·¿¤È´ØÏ¢ÉÕ¤±¤é¤ì¤¿³Æ°À­¤ËÂФ·¡¤Ì¾Á°¡¤¥Ç¡¼¥¿·¿µÚ¤Ó(¸ºß¤¹¤ì¤Ð)&default-value;¤òµ¬Äꤹ¤ë¡£ °À­¥ê¥¹¥ÈÀë¸À AttlistDecl '<!ATTLIST' S Name AttDef* S? '>' AttDef S Name S AttType S Default AttlistDeclµ¬Â§¤Ë¸ºß¤¹¤ëName¤Ï¡¤Í×ÁÇ·¿¤Î̾Á°¤È¤¹¤ë¡£&at-user-option;¡¤Àë¸À¤·¤Æ¤¤¤Ê¤¤Í×ÁÇ·¿¤ËÂФ·Â°À­¤òÀë¸À¤·¤¿¤Ê¤é¤Ð¡¤XML&processor;¤Ï¡¤·Ù¹ð¤ò½Ð¤·¤Æ¤â¤è¤¤¡£¤·¤«¤·¡¤¤³¤ì¤Ï&error;¤È¤Ï¤·¤Ê¤¤¡£ AttDefµ¬Â§¤Ë¤ª¤±¤ëName¤Ï¡¤Â°À­¤Î̾Á°¤È¤¹¤ë¡£

¤¢¤ëÍ×ÁǤËÂФ·¤Æ¡¤Ê£¿ô¤ÎAttlistDecl¤òÍ¿¤¨¤ë¾ì¹ç¡¤¤³¤ì¤é¤¹¤Ù¤Æ¤ÎÆâÍƤϥޡ¼¥¸¤¹¤ë¡£¤¢¤ëÍ×ÁÇ·¿¤ÎƱ¤¸Â°À­¤Ë¡¤Ê£¿ô¤ÎÄêµÁ¤òÍ¿¤¨¤ë¾ì¹ç¤Ë¤Ï¡¤ºÇ½é¤ÎÀë¸À¤òÍ­¸ú¤È¤·¡¤Â¾¤ÎÀë¸À¤Ï̵»ë¤¹¤ë¡£Áê¸ß±¿ÍÑÀ­¤Î¤¿¤á¤Ë¡¤DTD¤ÎºîÀ®¼Ô¤Ï¡¤¤¢¤ëÍ×ÁÇ·¿¤Ë¤Ï¹â¡¹°ì¤Ä¤Î°À­¥ê¥¹¥ÈÀë¸À¤·¤«Í¿¤¨¤Ê¤¤¡¤¤¢¤ë°À­Ì¾¤Ë¤Ï¹â¡¹°ì¤Ä¤Î°À­ÄêµÁ¤·¤«Í¿¤¨¤Ê¤¤¡¤µÚ¤Ó¤¹¤Ù¤Æ¤Î°À­¥ê¥¹¥ÈÀë¸À¤Ë¤Ï¾¯¤Ê¤¯¤È¤â°ì¤Ä¤Î°À­ÄêµÁ¤òÍ¿¤¨¤ë¡¤¤È¤¤¤¦ÁªÂò¤ò¤·¤Æ¤â¤è¤¤¡£Áê¸ß±¿ÍÑÀ­¤Î¤¿¤á¤Ë¡¤XML&processor;¤Ï¡¤&at-user-option;¡¤¤¢¤ëÍ×ÁÇ·¿¤ËÊ£¿ô¤Î°À­¥ê¥¹¥ÈÀë¸À¤òÍ¿¤¨¤¿¤ê¡¤¤¢¤ë°À­¤ËÊ£¿ô¤Î°À­ÄêµÁ¤òÍ¿¤¨¤¿¤ê¤·¤¿¤È¤­¤Ë¡¤·Ù¹ð¤ò½Ð¤·¤Æ¤â¤è¤¤¡£¤·¤«¤·¡¤¤³¤ì¤Ï¡¤&error;¤È¤Ï¤·¤Ê¤¤¡£

°À­¤Î·¿

XML¤Î°À­¤Î·¿¤Ï¡¤£³¼ïÎà¤È¤¹¤ë¡£¤³¤ì¤é¤Ï¡¤&string;·¿¡¤&token;²½·¿µÚ¤ÓÎóµó·¿¤È¤¹¤ë¡£&string;·¿¤Ï¡¤ÃͤȤ·¤ÆǤ°Õ¤Î&string;¤ò¤È¤ë¡£&token;²½·¿¤Ï¡¤¼¡¤Ë¼¨¤¹»ú¶çµÚ¤Ó°ÕÌ£¤Ë´Ø¤¹¤ëÍÍ¡¹¤ÊÀ©Ìó¤ò¤â¤Ä¡£ Attribute Types AttType StringType | TokenizedType | EnumeratedType StringType 'CDATA' TokenizedType 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'

ID

¤³¤Î·¿¤ÎÃͤϡ¤À¸À®µ¬Â§Name¤Ë&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£°ì¤Ä¤ÎXMLʸ½ñÆâ¤Ç¤Ï¡¤°ì¤Ä¤Î̾Á°¤¬¡¤¤³¤Î·¿¤ÎÃͤȤ·¤ÆÊ£¿ô²ó¸½¤ì¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£¤Ä¤Þ¤ê¡¤ID¤ÎÃͤϡ¤Í×ÁǤò°ì°Õ¤Ë&identify;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

1Í×ÁǤ´¤È¤Ë1ID

Í×ÁÇ·¿¤Ï¡¤Ê£¿ô¤ÎID°À­Ãͤò¤â¤Ã¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£

ID°À­¤Î&default;

ID°À­¤Ï¡¤&default;¤È¤·¤Æ¡¤#IMPLIEDËô¤Ï#REQUIRED¤òÀë¸À¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

IDREF

IDREF·¿¤ÎÃͤϡ¤À¸À®µ¬Â§Name¤Ë&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£IDREFS·¿¤ÎÃͤϡ¤À¸À®µ¬Â§Names¤Ë&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£³Æ¡¹¤ÎName¤Ï¡¤XMLʸ½ñÆâ¤Ë¸ºß¤¹¤ëÍ×ÁǤÎID°À­¤ÎÃͤÈ&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤Ä¤Þ¤ê¡¤IDREF¤ÎÃͤϡ¤¤¢¤ëID°À­¤ÎÃͤÈ&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

¼ÂÂÎ̾

ENTITY·¿¤ÎÃͤϡ¤À¸À®µ¬Â§Name¤Ë&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£ENTITIES·¿¤ÎÃͤϡ¤À¸À®µ¬Â§Names¤Ë&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£³Æ¡¹¤ÎName¤Ï¡¤DTD¤ÇÀë¸À¤¹¤ë&unparsed-entity;¤È&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

̾Á°&token;

NMTOKEN·¿¤ÎÃͤϡ¤Èó½ªÃ¼µ­¹æNmtoken¤È&match;¤¹¤ë&string;¤«¤é¹½À®¤µ¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£NMTOKENS·¿¤ÎÃͤϡ¤Èó½ªÃ¼µ­¹æNmtokens¤È&match;¤¹¤ë&string;¤«¤é¹½À®¤µ¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

XML&processor;¤Ï¡¤&application;¤Ë°À­ÃͤòÅϤ¹Á°¤Ë¡¤Â°À­ÃͤÎÀµµ¬²½¤Çµ¬Äꤹ¤ë¤È¤ª¤ê¤Ë¡¤Â°À­ÃͤòÀµµ¬²½¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

Îóµó·¿¤Î°À­¤Ï¡¤Àë¸À¤·¤¿Ãͤΰì¤Ä¤ò¼è¤ë¤³¤È¤¬¤Ç¤­¤ë¡£Îóµó·¿¤Ë¤Ï¡¤2¼ïÎढ¤ë¡£ Îóµó°À­¤Î·¿ EnumeratedType NotationType | Enumeration NotationType 'NOTATION' S '(' S? Name (S? '|' Name)* S? ')' Enumeration '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'

µ­Ë¡Â°À­

¤³¤Î·¿¤ÎÃͤϡ¤Àë¸À¤·¤Æ¤¤¤ëµ­Ë¡¤Î̾Á°¤Î°ì¤Ä¤È&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤Ä¤Þ¤ê¡¤Àë¸À¤Ë¸ºß¤¹¤ëµ­Ë¡Ì¾¤Ï¡¤¤¹¤Ù¤ÆÀë¸À¤µ¤ì¤Æ¤¤¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

Îóµó

¤³¤Î·¿¤ÎÃͤϡ¤Àë¸À¤Ë¸ºß¤¹¤ëNmtoken&token;¤Î°ì¤Ä¤È&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

Áê¸ß±¿ÍÑÀ­¤Î¤¿¤á¡¤Æ±¤¸Nmtoken¤Ï¡¤Ã±°ìÍ×ÁÇ·¿¤ÎÎóµó·¿¤Î°À­¤È¤·¤Æ¡¤Ê£¿ô²ó¸½¤ì¤Ê¤¤Êý¤¬¤è¤¤¡£

°À­¤Î&default;

°À­Àë¸À¤Ï¡¤Â°À­¤Î»ØÄ꤬ɬ¿Ü¤«¤É¤¦¤«¤Ë¤Ä¤¤¤Æ¤Î¾ðÊó¤òÍ¿¤¨¤ë¡£É¬¿Ü¤Ç¤Ê¤¤¾ì¹ç¤Ë¤Ï¡¤Ê¸½ñÆâ¤Ç°À­¤ò»ØÄꤷ¤Ê¤¤¤È¤­¡¤XML&processor;¤Î½èÍýÊýË¡¤Î¾ðÊó¤âÍ¿¤¨¤ë¡£ °À­¤Î&default; Default '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)

°À­&default;¤ÎÀµ¤·¤µ

Àë¸À¤·¤¿&default-value;¤Ï¡¤Àë¸À¤·¤¿Â°À­·¿¤Î»ú¶çÀ©Ìó¤òËþ¤¿¤µ¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

#REQUIRED¤ò»ØÄꤷ¤¿¤È¤­¡¤¤³¤ÎÍ×ÁÇ·¿¤Î³«»Ï¥¿¥°¤Ç¤¢¤Ã¤Æ¡¤¤³¤Î°À­¤ËÃͤòÍ¿¤¨¤Ê¤¤¤â¤Î¤òXML&processor;¤¬¸«¤Ä¤±¤¿¤Ê¤é¤Ð¡¤¤½¤Îʸ½ñ¤Ï&valid;¤È¤Ï¤·¤Ê¤¤¡£#IMPLIED¤ò»ØÄꤷ¤¿¤È¤­¡¤¤³¤Î°À­¤ò¾Êά¤·¤¿¤é¡¤XML&processor;¤Ï¡¤Â°À­Ãͤò»ØÄꤷ¤Ê¤¤¤³¤È¤ò¥¢¥×¥ê¥±¡¼¥·¥ç¥ó¤ËÅÁ¤¨¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤³¤Î¤È¤­¡¤&application;¤Î¿¶Éñ¤¤¤Ë¤Ä¤¤¤Æ¤ÎÀ©Ìó¤Ï¤Ê¤¤¡£

°À­¤¬#REQUIRED¤Ç¤â#IMPLIED¤Ç¤â¤Ê¤¤¤È¤­¤Ë¤Ï¡¤AttValue¤ÎÃͤ¬¡¤&default-value;¤È¤Ê¤ë¡£#FIXED¤Î¾ì¹ç¡¤&default-value;¤È°Û¤Ê¤ëÃͤ¬»ØÄꤵ¤ì¤ì¤Ð¡¤¤½¤Îʸ½ñ¤Ï¡¤&valid;¤È¤·¤Ê¤¤¡£&default-value;¤òÀë¸À¤·¤Æ¤¤¤ë¾ì¹ç¡¤¤³¤Î°À­¤Î¾Êά¤ò¸«¤Ä¤±¤¿¤é¡¤Àë¸À¤·¤¿&default-value;¤ò°À­Ãͤ˻ØÄꤷ¤Æ¤¤¤ë¤È¤·¤Æ¡¤XML&processor;¤Ï¿¶¤ëÉñ¤¦¤³¤È¤¬Ë¾¤Þ¤·¤¤¡£

°À­¥ê¥¹¥ÈÀë¸À¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <!ATTLIST termdef id ID #REQUIRED name CDATA #IMPLIED> <!ATTLIST list type (bullets|ordered|glossary) "ordered"> <!ATTLIST form method CDATA #FIXED "POST">

 °À­ÃͤÎÀµµ¬²½

XML&processor;¤Ï¡¤Â°À­Ãͤò&application;¤ËÅϤ¹Á°¤Ë¡¤¼¡¤Î¤È¤ª¤ê¤ËÀµµ¬²½¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

a) ¤Þ¤º¡¤Â°À­Ã͵ڤӤ½¤ÎÃæ¤Î¼ÂÂÎÆâ¤Ç¡¤¹ÔËöËô¤Ï¹Ô¶­³¦(Ëô¤Ï¥·¥¹¥Æ¥à¤Ë¤è¤Ã¤Æ¤Ï¥ì¥³¡¼¥É¶­³¦)¤È¤·¤Æ»È¤ï¤ì¤ë&string;¤ò¡¤&space-character;(#x20)°ì¤Ä¤ËÃÖ¤­´¹¤¨¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤(¡Ö¹ÔËö¤Î°·¤¤¡×¤â»²¾È¤Î¤³¤È¡£)¡£

b) ¼¡¤Ë¡¤Ê¸»ú»²¾ÈµÚ¤ÓÆâÉô&parsed-entity;¤Ø¤Î»²¾È¤Ï¡¤Å¸³«¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£³°Éô¼ÂÂΤؤλ²¾È¤Ï¡¤&error;¤È¤¹¤ë¡£

c) ºÇ¸å¤Ë¡¤Â°À­¤Î·¿¤¬CDATA¤Ç¤Ê¤±¤ì¤Ð¡¤¶õÇò&string;¤Ï¡¤¤¹¤Ù¤Æ&space-character;(#x20)°ì¤Ä¤ËÀµµ¬²½¤·¡¤»Ä¤ê¤Î¶õÇòʸ»ú¤Ï¡¤ºï½ü¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

&non-validating;&parser;¤Ï¡¤Àë¸À¤¬¸«¤Ä¤«¤é¤Ê¤¤Â°À­¤Ï¡¤¤¹¤Ù¤Æ¡¤CDATA¤òÀë¸À¤·¤Æ¤¤¤ë¤È¤·¤Æ°·¤¦¤³¤È¤¬Ë¾¤Þ¤·¤¤¡£

 ¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó

¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤È¤Ï¡¤Ê¸½ñ·¿Àë¸À¤Î³°Éô⊂¤Î°ìÉô¤È¤·¡¤À©¸æ¥­¡¼¥ï¡¼¥É¤Î»ØÄê¤Ë¤è¤Ã¤Æ¡¤DTD¤ÎÏÀÍý¹½Â¤¤Ë´Þ¤á¤¿¤ê¡¤½ü¤¤¤¿¤ê¤¹¤ëÉôʬ¤È¤¹¤ë¡£ ¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó conditionalSect includeSect | ignoreSect includeSect '<![' S? 'INCLUDE' S? '[' extSubset ']]>' ignoreSect '<![' S? 'IGNORE' S? '[' ignoreSectContents* ']]>' ignoreSectContents Ignore ('<![' ignoreSectContents ']]>' Ignore)* Ignore Char* - (Char* ('<![' | ']]>') Char*)

¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤Ï¡¤DTD¤ÎÆâÉô⊂µÚ¤Ó³°Éô⊂¤ÈƱÍͤˡ¤´°Á´¤ÊÀë¸À¡¤¥³¥á¥ó¥ÈËô¤ÏÆþ¤ì»Ò¤Ë¤Ê¤Ã¤¿¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤ò¡¤¤¤¤¯¤Ä¤«´Þ¤ó¤Ç¤è¤¤¡£¤³¤ì¤é¤Î´Ö¤Ë¡¤¶õÇò¤¬¸½¤ì¤Æ¤â¤è¤¤¡£

¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤Î¥­¡¼¥ï¡¼¥É¤¬INCLUDE¤Ê¤é¤Ð¡¤XML&processor;¤Ï¡¤¤³¤Î¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤ÎÆâÍƤò¡¤Ê¸½ñ¤Î°ìÉô¤È¤·¤Æ°·¤ï¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤Î¥­¡¼¥ï¡¼¥É¤¬IGNORE¤Ê¤é¤Ð¡¤¤½¤Î¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤ÎÆâÍƤϡ¤Ê¸½ñ¤Î°ìÉô¤È¤·¤Æ°·¤ï¤Ê¤¤¡£¹½Ê¸²òÀϤòÀµ¤·¤¯¹Ô¤¦¤¿¤á¤Ë¤Ï¡¤Ìµ»ë¤¹¤ë¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó(IGNORE)¤Ë´Ø¤·¤Æ¤â¡¤ÆâÍƤòÆɤޤʤ±¤ì¤Ð¤Ê¤é¤Ê¤¤¤³¤È¤ËÃí°Õ¤¹¤ë¤³¤È¡£¤³¤ì¤Ï¡¤Æþ¤ì»Ò¤Ë¤Ê¤Ã¤¿¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤ò¸«¤Ä¤±¡¤(̵»ë¤¹¤ë)ºÇ¤â³°Â¦¤Î¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤òÀµ¤·¤¯¸¡½Ð¤¹¤ë¤¿¤á¤È¤¹¤ë¡£¥­¡¼¥ï¡¼¥É¤òINCLUDE¤È¤¹¤ë¾®¤µ¤Ê¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤¬¡¤¥­¡¼¥ï¡¼¥É¤òIGNORE¤È¤¹¤ë¤è¤êÂ礭¤Ê¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤Ë´Þ¤Þ¤ì¤ë¤Ê¤é¤Ð¡¤³°Â¦µÚ¤ÓÆ⦤ξò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤ÎξÊý¤È¤â̵»ë¤¹¤ë¡£

¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤Î¥­¡¼¥ï¡¼¥É¤¬¥Ñ¥é¥á¥¿¼ÂÂλ²¾È¤Ê¤é¤Ð¡¤XML&processor;¤Ï¾ò·ïÉÕ¤­¥»¥¯¥·¥ç¥ó¤Î°·¤¤¤òȽÃǤ¹¤ëÁ°¤Ë¡¤¤³¤Î¥Ñ¥é¥á¥¿¼ÂÂΤòŸ³«¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

Îã¤ò¼¡¤Ë¼¨¤¹¡£ <!ENTITY % draft 'INCLUDE' > <!ENTITY % final 'IGNORE' > <![%draft;[ <!ELEMENT book (comments*, title, body, supplements?)> ]]> <![%final;[ <!ELEMENT book (title, body, supplements?)> ]]>

ʪÍý¹½Â¤

XMLʸ½ñ¤Ï¡¤°ì¤Ä°Ê¾å¤Îµ­²±Ã±°Ì¤«¤é¹½À®¤¹¤ë¡£¤³¤Îµ­²±Ã±°Ì¤ò¡¤¼ÂÂΤȤ¤¤¦¡£¼ÂÂΤϡ¤ÆâÍƤò¤â¤Á¡¤Ê¸½ñ¼ÂÂÎ(°Ê¹ß»²¾È)µÚ¤Ó³°ÉôDTD⊂¤ò½ü¤¤¤Æ¡¤Ì¾Á°¤Ç&identified;¡£ ³ÆXMLʸ½ñ¤Ï¡¤Ê¸½ñ¼ÂÂΤȸƤּÂÂΤò°ì¤Ä¤â¤Ä¡£XML&processor;¤Ï¡¤¤³¤Îʸ½ñ¼ÂÂΤ«¤é½èÍý¤ò³«»Ï¤¹¤ë¡£Ê¸½ñ¼ÂÂΤ¬¡¤Ê¸½ñ¤Î¤¹¤Ù¤Æ¤ò´Þ¤ó¤Ç¤â¤è¤¤¡£

¼ÂÂΤϡ¤&parsed-entity;Ëô¤Ï&unparsed-entity;¤È¤¹¤ë¡£&parsed-entity;¤ÎÆâÍƤϡ¤&parsed-entity;¤Î&replacement-text;¤È¸Æ¤Ö¡£¤³¤Î¥Æ¥­¥¹¥È¤Ï¡¤Ê¸½ñ¤ÎËÜÂΤΰìÉô¤È¤·¤Æ²ò¼á¤¹¤ë¡£

&unparsed-entity;¤Ï¡¤ÆâÍƤ¬¥Æ¥­¥¹¥È¤Ç¤â¤½¤¦¤Ç¤Ê¤¯¤È¤â¤è¤¤¥ê¥½¡¼¥¹¤È¤¹¤ë¡£¥Æ¥­¥¹¥È¤Î¾ì¹ç¡¤XML¤Ç¤Ê¤¯¤È¤â¤è¤¤¡£³Æ&unparsed-entity;¤Ë¤Ï¡¤µ­Ë¡¤¬´ØÏ¢ÉÕ¤±¤é¤ì¡¤¤³¤Îµ­Ë¡¤Ï¡¤Ì¾Á°¤Ç&identified;¡£µ­Ë¡¤Î̾Á°µÚ¤Ó´ØÏ¢ÉÕ¤±¤é¤ì¤¿&identifier;¤ò¡¤XML&processor;¤¬&application;¤ËÅϤ¹¤È¤¤¤¦Í×·ï°Ê³°¤Ï¡¤XML¤Ï¡¤&unparsed-entity;¤ÎÆâÍƤòÀ©¸Â¤·¤Ê¤¤¡£

&parsed-entity;¤Ï¡¤¼ÂÂλ²¾È¤Ë¤è¤Ã¤Æ̾Á°¤Ç¸Æ¤Ó½Ð¤¹¡£&unparsed-entity;¤Ï¡¤ENTITY·¿Ëô¤ÏENTITIES·¿¤Î°À­¤ÎÃͤȤ·¤Æ¡¤Ì¾Á°¤Ç»²¾È¤¹¤ë¡£

°ìÈ̼ÂÂΤϡ¤Ê¸½ñÆâÍƤÎÃæ¤Ç»ÈÍѤ¹¤ë&parsed-entity;¤È¤¹¤ë¡£¤¢¤¤¤Þ¤¤¤Ë¤Ê¤é¤Ê¤¤¸Â¤ê¡¤¤³¤Î&TR-or-Rec;¤Ç¤Ï¡¤°ìÈ̼ÂÂΤòñ¤Ë¼ÂÂΤȸƤ֡£¥Ñ¥é¥á¥¿¼ÂÂΤϡ¤DTDÆâ¤Ç»ÈÍѤ¹¤ë&parsed-entity;¤È¤¹¤ë¡£¤³¤ì¤é¤Î£²¼ïÎà¤Î¼ÂÂΤϡ¤°Û¤Ê¤ë½ñ¼°¤Ç»²¾È¤·¡¤°Û¤Ê¤ëʸ̮¤Çǧ¼±¤¹¤ë¡£

ʸ»ú»²¾ÈµÚ¤Ó¼ÂÂλ²¾È

ʸ»ú»²¾È¤Ï¡¤ISO/IEC 10646ʸ»ú½¸¹ç¤ÎÆÃÄê¤Îʸ»ú¡¤Î㤨¤Ð¡¤ÆþÎϵ¡´ï¤«¤éľÀÜÆþÎÏÉÔ²Äǽ¤Êʸ»ú¤ò»²¾È¤¹¤ë¡£ ʸ»ú»²¾È CharRef '&#' [0-9]+ ';' | '&hcro;' [0-9a-fA-F]+ ';' ÀµÅö¤Êʸ»ú

ʸ»ú»²¾È¤Ç»²¾È¤¹¤ëʸ»ú¤Ï¡¤Èó½ªÃ¼µ­¹æChar¤Ë½¾¤ï¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

ʸ»ú¤¬ "&#x" ¤Ç»Ï¤Þ¤ì¤Ð¡¤½ªÃ¼¤Î ";" ¤Þ¤Ç¤Î¿ô»úµÚ¤Ó¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È¤Ï¡¤ISO/IEC 10646 ¤Îʸ»ú¥³¡¼¥É¤Î16¿Ê¿ôɽ¸½¤È¤¹¤ë¡£ ʸ»ú¤¬ "&#" ¤Ç»Ï¤Þ¤ì¤Ð¡¤½ªÃ¼¤Î ";" ¤Þ¤Ç¤Î¿ô»ú¤Ï¡¤Ê¸»ú¥³¡¼¥É¤Î10¿Ê¿ôɽ¸½¤È¤¹¤ë¡£

¼ÂÂλ²¾È¤Ï¡¤Ì¾Á°¤ÎÉÕ¤¤¤¿¼ÂÂΤÎÆâÍƤò»²¾È¤¹¤ë¡£°ìÈ̼ÂÂΤؤλ²¾È¤Ï¡¤¥¢¥ó¥Ñ¥µ¥ó¥É(&)µÚ¤Ó¥»¥ß¥³¥í¥ó(;)¤ò¶èÀÚ¤ê»Ò¤È¤·¤ÆÍѤ¤¤ë¡£¥Ñ¥é¥á¥¿¼ÂÂΤؤλ²¾È¤Ï¡¤¥Ñ¡¼¥»¥ó¥Èµ­¹æ(%)µÚ¤Ó¥»¥ß¥³¥í¥ó(;)¤ò¶èÀÚ¤ê»Ò¤È¤·¤ÆÍѤ¤¤ë¡£

¼ÂÂλ²¾È Reference EntityRef | CharRef EntityRef '&' Name ';' PEReference '%' Name ';' ¼ÂÂΤ¬Àë¸À¤µ¤ì¤Æ¤¤¤ë¤³¤È

DTD¤ò¤â¤¿¤Ê¤¤Ê¸½ñ¡¤¥Ñ¥é¥á¥¿¼ÂÂλ²¾È¤ò´Þ¤Þ¤Ê¤¤ÆâÉôDTD⊂¤À¤±¤ò¤â¤Äʸ½ñ¡¤Ëô¤Ï "standalone='yes'" ¤ò¤â¤Äʸ½ñ¤Ë¤ª¤¤¤Æ¡¤¼ÂÂλ²¾È¤ÇÍѤ¤¤ë Name ¤Ï¡¤¤½¤Î¼ÂÂΤÎÀë¸À¤ÇÍ¿¤¨¤ë̾Á°¤È¡¤&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤¿¤À¤·¡¤&well-formed;¤Îʸ½ñ¤Ï¡¤¼ÂÂÎ&magicents; ¤òÀë¸À¤¹¤ëɬÍפϤʤ¤¡£¥Ñ¥é¥á¥¿¼ÂÂΤξì¹ç¤Ï¡¤Àë¸À¤Ï¡¤»²¾È¤ËÀè¹Ô¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£Æ±Íͤˡ¤°ìÈ̼ÂÂΤξì¹ç¤Ï¡¤Â°À­¥ê¥¹¥ÈÀë¸À¤Î&default-value;Æâ¤Ç¤Î»²¾È¤è¤êÀè¤Ë¡¤Àë¸À¤¬¸½¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

³°Éô⊂Ëô¤Ï³°Éô¥Ñ¥é¥á¥¿¼ÂÂΤǼÂÂΤòÀë¸À¤¹¤ë¤È¤­¡¤&non-validating;&processor;¤¬¡¤Àë¸À¤òÆɤߡ¤½èÍý¤¹¤ë¤³¤È¤òµÁ̳¤Å¤±¤Ê¤¤¡£¤½¤ì¤é¤Îʸ½ñ¤Ç¤Ï¡¤¼ÂÂΤÏÀë¸À¤µ¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¤È¤¤¤¦µ¬Â§¤Ï¡¤&well-formed;À©Ìó¤Ç¤Ï¤Ê¤¤¡£

¼ÂÂΤ¬Àë¸À¤µ¤ì¤Æ¤¤¤ë¤³¤È

³°Éô⊂Ëô¤Ï³°Éô¥Ñ¥é¥á¥¿¼ÂÂΤò¤â¤Ã¤Æ¤¤¤Æ¡¤"standalone='no'"¤ò¤â¤Äʸ½ñ¤Ë¤ª¤¤¤Æ¡¤¼ÂÂλ²¾È¤ÇÍѤ¤¤ë Name ¤Ï¡¤¤½¤Î¼ÂÂΤÎÀë¸À¤ÇÍ¿¤¨¤ë̾Á°¤È&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£Áê¸ß±¿ÍÑÀ­¤Î¤¿¤á¡¤&valid;¤Êʸ½ñ¤Ï¤¢¤é¤«¤¸¤áÄêµÁ¤·¤¿¼ÂÂΤε¬Äê¤Ç»ØÄꤷ¤¿½ñ¼°¤Ë¤è¤Ã¤Æ¡¤¼ÂÂÎ &magicents;¤òÀë¸À¤¹¤ë¤³¤È¤¬Ë¾¤Þ¤·¤¤¡£¥Ñ¥é¥á¥¿¼ÂÂΤξì¹ç¤Ï¡¤Àë¸À¤Ï¡¤»²¾È¤ËÀè¹Ô¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£Æ±Íͤˡ¤°ìÈ̼ÂÂΤξì¹ç¤Ï¡¤Â°À­¥ê¥¹¥ÈÀë¸À¤Î&default-value;Æâ¤Ç¤Î»²¾È¤è¤ê¤âÀè¤Ë¡¤Àë¸À¤¬¸½¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

&parsed-entity;

¼ÂÂλ²¾È¤Ï¡¤&unparsed-entity;¤Î̾Á°¤ò´Þ¤ó¤Ç¤¤¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£&unparsed-entity;¤Ï¡¤ENTITY·¿Ëô¤ÏENTITIES ·¿¤È¤·¤ÆÀë¸À¤·¤¿Â°À­ÃͤȤ·¤Æ¤À¤±»²¾È¤Ç¤­¤ë¡£

ºÆµ¢¤Ê¤·

&parsed-entity;¤Ï¡¤¤½¤ì¼«ÂΤؤλ²¾È¤ò¡¤Ä¾Àܤˤâ´ÖÀܤˤâ´Þ¤ó¤Ç¤Ï¤Ê¤é¤Ê¤¤¡£

 DTD¤ÎÃæ

¥Ñ¥é¥á¥¿¼ÂÂλ²¾È¤Ï¡¤DTDÆâ¤Ë¤À¤±¡¤½Ð¸½¤·¤Æ¤è¤¤¡£

ʸ»ú»²¾ÈµÚ¤Ó¼ÂÂλ²¾È¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ Type <key>less-than</key> (&hcro;3C;) to save options. This document was prepared on &docdate; and is classified &security-level;.

¥Ñ¥é¥á¥¿¼ÂÂλ²¾È¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <!ENTITY % ISOLat2 SYSTEM "http://www.xml.com/iso/isolat2-xml.entities" > %ISOLat2;

¼ÂÂÎÀë¸À

¼ÂÂΤϡ¤¼¡¤Î¤È¤ª¤ê¤ËÀë¸À¤¹¤ë¡£ ¼ÂÂÎÀë¸À EntityDecl GEDecl°ìÈ̼ÂÂÎ | PEDecl¥Ñ¥é¥á¥¿¼ÂÂÎ GEDecl '<!ENTITY' S Name S EntityDef S? '>' PEDecl | '<!ENTITY' S '%' S Name S PEDef S? '>' ¥Ñ¥é¥á¥¿¼ÂÂÎ EntityDef EntityValue | ExternalDef PEDef EntityValue | ExternalID Name ¤Ï¡¤¼ÂÂλ²¾È¤Ë¤ª¤¤¤Æ¼ÂÂΤò&identify;¡£&unparsed-entity;¤Ê¤é¤Ð¡¤ENTITY ·¿Ëô¤ÏENTITIES·¿¤Î°À­ÃÍÆâ¤Ç¡¤¼ÂÂΤò&identify;¡£Æ±°ì¤Î¼ÂÂΤ¬°ì²ó°Ê¾åÀë¸À¤µ¤ì¤ì¤Ð¡¤ºÇ½é¤ÎÀë¸À¤òÍѤ¤¤ë¡£&at-user-option;¡¤Ê£¿ô²óÀë¸À¤µ¤ì¤ë¼ÂÂΤ˴ؤ·¡¤XML&processor;¤Ï¡¤·Ù¹ð¤ò½Ð¤·¤Æ¤â¤è¤¤¡£

ÆâÉô¼ÂÂÎ

¼ÂÂΤÎÄêµÁ¤¬ EntityValue¤Î¤È¤­¡¤¤³¤ì¤òÆâÉô¼ÂÂΤȤ¤¤¦¡£¤³¤ì¤Ï¡¤Ê̸ĤÎʪÍýŪµ­²±Ã±°Ì¤ò¤â¤¿¤º¡¤¼ÂÂΤÎÆâÍƤϡ¤Àë¸ÀÆâ¤ÇÍ¿¤¨¤ë¡£Àµ¤·¤¯&replacement-text;¤òÀ¸À®¤¹¤ë¤Ë¤Ï¡¤&literal;¼ÂÂÎÃÍÆâ¤Ç¤Î¼ÂÂλ²¾ÈµÚ¤Óʸ»ú»²¾È¤Î½èÍý¤¬¡¤É¬ÍפȤʤ뤫¤â¤·¤ì¤Ê¤¤¤³¤È¤ËÃí°Õ¤¹¤ë¡£¾ÜºÙ¤Ï¡¤ÆâÉô¼ÂÂΤÎ&replacement-text;¤Î¹½ÃÛ¤ò»²¾È¡£

ÆâÉô¼ÂÂΤϡ¤&parsed-entity;¤È¤¹¤ë¡£

ÆâÉô¼ÂÂÎÀë¸À¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <!ENTITY Pub-Status "This is a pre-release of the specification.">

 ³°Éô¼ÂÂÎ

¼ÂÂΤ¬ÆâÉô¼ÂÂΤǤʤ±¤ì¤Ð¡¤³°Éô¼ÂÂΤȤ·¡¤¼¡¤Î¤È¤ª¤ê¤ËÀë¸À¤¹¤ë¡£ ³°Éô¼ÂÂÎÀë¸À ExternalDef ExternalID NDataDecl? ExternalID 'SYSTEM' S SystemLiteral | 'PUBLIC' S PubidLiteral S SystemLiteral NDataDecl S 'NDATA' S Name NDataDecl ¤¬Â¸ºß¤¹¤ì¤Ð¡¤¤³¤Î¼ÂÂΤϡ¤&unparsed-entity;¤È¤·¡¤¤½¤¦¤Ç¤Ê¤±¤ì¤Ð¡¤&parsed-entity;¤È¤¹¤ë¡£

µ­Ë¡¤¬Àë¸À¤µ¤ì¤Æ¤¤¤ë¤³¤È

Name ¤Ï¡¤Àë¸À¤·¤¿µ­Ë¡¤Î̾Á°¤È&match;¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

¥­¡¼¥ï¡¼¥É SYSTEM ¤Î¸å¤Î SystemLiteral ¤ò¡¤¼ÂÂΤΥ·¥¹¥Æ¥à&identifier;¤È¸Æ¤Ö¡£¤³¤ì¤ÏURI¤È¤·¡¤¤½¤Î¼ÂÂΤÎÆâÍƤò¼è¤ê½Ð¤¹¤Î¤ËÍѤ¤¤Æ¤â¤è¤¤¡£URI¤È¶¦¤Ë»È¤¦¤³¤È¤Î¿¤¤¥Ï¥Ã¥·¥å("#")µÚ¤Ó¥Õ¥é¥°¥á¥ó¥È&identifier;¤Ï¡¤Àµ¼°¤Ë¤Ï¡¤URI¼«ÂΤΰìÉô¤È¤Ï¤·¤Ê¤¤¡£¥Õ¥é¥°¥á¥ó¥È&identifier;¤¬¡¤¥·¥¹¥Æ¥à&identifier;¤ÎÉôʬ¤È¤·¤ÆÍ¿¤¨¤é¤ì¤Æ¤¤¤ë¾ì¹ç¡¤XML&processor;¤Ï¡¤&error;¤ò½Ð¤·¤Æ¤â¤è¤¤¡£¤³¤Î&TR-or-Rec;¤ÎÈϰϳ°¤Î¾ðÊó(Î㤨¤Ð¡¤¤¢¤ëÆÃÄê¤ÎDTD¤ÎÆÃÊ̤ÊXMLÍ×ÁÇËô¤ÏÆÃÄê¤Î&application;¤Î»ÅÍͤˤè¤Ã¤ÆÄêµÁ¤µ¤ì¤¿½èÍýÌ¿Îá)¤Ë¤è¤Ã¤Æ¾å½ñ¤­¤µ¤ì¤Ê¤¤¸Â¤ê¡¤ÁêÂÐŪ¤ÊURI¤Ï¡¤¤½¤Î¼ÂÂΤΰÌÃÖ¡¤¤¹¤Ê¤ï¤Á¡¤¤½¤Î¼ÂÂΤÎÀë¸À¤¬¤¢¤ë¥Õ¥¡¥¤¥ë¤ËÁêÂÐŪ¤È¤¹¤ë¡£¤·¤¿¤¬¤Ã¤Æ¡¤DTD¤ÎÆâÉô⊂¤Ë¤¢¤ë¼ÂÂÎÀë¸À¤Ç¤ÎÁêÂÐŪ¤ÊURI¤Ï¡¤Ê¸½ñ¤Î°ÌÃ֤ˤĤ¤¤ÆÁêÂÐŪ¤È¤¹¤ë¡£³°Éô⊂¤Ë¤¢¤ë¼ÂÂÎÀë¸À¤Ç¤ÎÁêÂÐŪ¤ÊURI¤Ï¡¤¤½¤Î³°Éô⊂¤ò´Þ¤à¥Õ¥¡¥¤¥ë¤Î°ÌÃÖ¤ËÁêÂÐŪ¤È¤¹¤ë¡£

¥·¥¹¥Æ¥à&identifier;°Ê³°¤Ë¡¤³°Éô¼ÂÂΤϡ¤¸ø³«&identifier;¤ò´Þ¤ó¤Ç¤â¤è¤¤¡£ ¼ÂÂΤÎÆâÍƤò¼è¤ê½Ð¤¹XML&processor;¤Ï¡¤¤³¤Î¸ø³«&identifier;¤òÍѤ¤¤Æ¡¤Âå¤ï¤ê¤ÎURI¤ÎÀ¸À®¤ò»î¤ß¤Æ¤â¤è¤¤¡£XML&processor;¤¬¤³¤ì¤Ë¼ºÇÔ¤·¤¿¾ì¹ç¤Ï¡¤¥·¥¹¥Æ¥à&literal;¤È¤·¤Æ»ØÄꤷ¤¿URI¤òÍѤ¤¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£&match;¤¹¤ëÁ°¤Ë¡¤¸ø³«&identifier;Æâ¤Ë¤¢¤ë¶õÇòʸ»ú¤«¤é¤Ê¤ë&string;¤Ï¡¤¤¹¤Ù¤Æñ°ì¤Î&space-character;(#x20)¤ËÀµµ¬²½¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤º¡¤Á°¸å¤Î¶õÇòʸ»ú¤Ïºï½ü¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

³°Éô¼ÂÂÎÀë¸À¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <!ENTITY open-hatch SYSTEM "http://www.textuality.com/boilerplate/OpenHatch.xml"> <!ENTITY open-hatch PUBLIC "-//Textuality//TEXT Standard open-hatch boilerplate//EN" "http://www.textuality.com/boilerplate/OpenHatch.xml"> <!ENTITY hatch-pic SYSTEM "../grafix/OpenHatch.gif" NDATA gif >

 &parsed-entity; ¥Æ¥­¥¹¥ÈÀë¸À

³°Éô&parsed-entity;¤Ï¡¤¥Æ¥­¥¹¥ÈÀë¸À¤Ç»Ï¤Þ¤Ã¤Æ¤â¤è¤¤¡£ ¥Æ¥­¥¹¥ÈÀë¸À TextDecl &xmlpio; VersionInfo? EncodingDecl S? &pic;

¥Æ¥­¥¹¥ÈÀë¸À¤Ï¡¤¤½¤Î¤Þ¤Þ¤Î·Á¤Ç¸½¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤º¡¤&parsed-entity;¤Ø¤Î»²¾È¤ò·Ðͳ¤·¤Æ¤Ï¤Ê¤é¤Ê¤¤¤³¤È¤ËÃí°Õ¤¹¤ë¡£

³°Éô&parsed-entity;¤Ë¤ª¤¤¤Æ¡¤¥Æ¥­¥¹¥ÈÀë¸À¤Ï¡¤ÀèƬ°Ê³°¤Î¤¤¤«¤Ê¤ë°ÌÃ֤ˤâ½Ð¸½¤·¤Ê¤¤¡£

 &well-formed;¤Î&parsed-entity;

¥é¥Ù¥ëdocument¤ò¤â¤ÄÀ¸À®µ¬Â§¤Ë&match;¤¹¤ì¤Ð¡¤Ê¸½ñ¼ÂÂΤϡ¤&well-formed;¤È¤¹¤ë¡£¥é¥Ù¥ëExtParsedEnt¤ò¤â¤ÄÀ¸À®µ¬Â§¤Ë&match;¤¹¤ì¤Ð¡¤³°Éô¤Î°ìÈÌ&parsed-entity;¤Ï¡¤&well-formed;¤È¤¹¤ë¡£¥é¥Ù¥ëExtPE¤ò¤â¤ÄÀ¸À®µ¬Â§¤Ë&match;¤¹¤ì¤Ð¡¤³°Éô¥Ñ¥é¥á¥¿¼ÂÂΤϡ¤&well-formed;¤È¤¹¤ë¡£ &well-formed;¤Î&parsed-entity; ExtParsedEnt TextDecl? content ExtPE TextDecl? extSubset &replacement-text;¤¬¡¤¥é¥Ù¥ëcontent¤ò¤â¤ÄÀ¸À®µ¬Â§¤Ë&match;¤¹¤ì¤Ð¡¤ÆâÉô¤Î°ìÈÌ&parsed-entity;¤Ï¡¤&well-formed;¤È¤¹¤ë¡£DTD¤òºÇ¸å¤Þ¤ÇÆɤ߹þ¤Þ¤Ê¤¤¤È¡¤³Î¼Â¤Ë¤³¤ì¤òȽÄê¤Ç¤­¤Ê¤¤¤³¤È¤ËÃí°Õ¡£¤¹¤Ù¤Æ¤ÎÆâÉô¤Î¥Ñ¥é¥á¥¿¼ÂÂΤϡ¤ÄêµÁ¤Ë¤è¤Ã¤Æ&well-formed;¤È¤¹¤ë¡£

¼ÂÂΤ¬&well-formed;¤Ê·ë²Ì¤È¤·¤Æ¡¤XMLʸ½ñ¤ÎÏÀÍýŪµÚ¤ÓʪÍýŪ¹½Â¤¤Ï¡¤Àµ¤·¤¯Æþ¤ì»Ò¤È¤Ê¤ë¡£³«»Ï¥¿¥°¡¤½ªÎ»¥¿¥°¡¤¶õÍ×ÁÇ¥¿¥°¡¤Í×ÁÇ¡¤¥³¥á¥ó¥È¡¤½èÍýÌ¿Îᡤʸ»ú»²¾ÈµÚ¤Ó¼ÂÂλ²¾È¤¬¡¤°ì¤Ä¤Î¼ÂÂΤdz«»Ï¤·¡¤Ê̤μÂÂΤǽªÎ»¤¹¤ë¤³¤È¤Ï¤Ê¤¤¡£

 ¼ÂÂΤˤª¤±¤ëʸ»úÉä¹æ²½

XMLʸ½ñÆâ¤Î³°Éô&parsed-entity;¤Ï¡¤³Æ¡¹¡¤Ê̤Îʸ»úÉä¹æ²½Êý¼°¤òÍѤ¤¤Æ¤â¤è¤¤¡£¤¹¤Ù¤Æ¤ÎXML&processor;¤Ï¡¤UTF-8¤ÇÉä¹æ²½¤·¤¿¼ÂÂΡ¤UTF-16¤ÇÉä¹æ²½¤·¤¿¼ÂÂΤò½èÍý¤Ç¤­¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

UTF-16¤ÇÉä¹æ²½¤·¤¿¼ÂÂΤϡ¤ISO/IEC 10646¤ÎÉÕÏ¿EµÚ¤ÓUnicode¤ÎÉÕÏ¿B¤Çµ¬Äꤹ¤ë&byte-order-mark;(ZERO WIDTH NO-BREAK SPACEʸ»ú¡¤#xFEFF)¤Ç»Ï¤Þ¤é¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤³¤ì¤Ï¡¤Éä¹æ²½¤Îɸ¼±¤Ç¤¢¤Ã¤Æ¡¤XMLʸ½ñ¤Î&markup;¤Î°ìÉô¤Ç¤â¡¤Ê¸»ú¥Ç¡¼¥¿¤Î°ìÉô¤Ç¤â¤Ê¤¤¡£XML&processor;¤Ï¡¤UTF-8¤ÇÉä¹æ²½¤·¤¿Ê¸½ñ¤ÈUTF-16¤ÇÉä¹æ²½¤·¤¿Ê¸½ñ¤È¤Î¶èÊ̤ò¹Ô¤¦¤¿¤á¤Ë¡¤¤³¤Îʸ»ú¤ò»ÈÍѲÄǽ¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

XML&processor;¤Ï¡¤UTF-8µÚ¤ÓUTF-16¤ÇÉä¹æ²½¤·¤¿¼ÂÂΤÀ¤±¤òÆɤळ¤È¤òɬ¿Ü¤È¤¹¤ë¤¬¡¤Â¾¤ÎÉä¹æ²½¤òÀ¤³¦¤Ç¤ÏÍѤ¤¤Æ¤ª¤ê¡¤¤½¤ì¤é¤ÎÉä¹æ²½¤òÍѤ¤¤ë¼ÂÂΤòXML&processor;¤¬½èÍý¤Ç¤­¤ë¤³¤È¤¬Ë¾¤Þ¤·¤¤¡£UTF-8Ëô¤ÏUTF-16°Ê³°¤ÎÉä¹æ²½Êý¼°¤òÍѤ¤¤Æ³ÊǼ¤¹¤ë&parsed-entity;¤Ï¡¤Éä¹æ²½Àë¸À¤ò´Þ¤à¥Æ¥­¥¹¥ÈÀë¸À¤Ç»Ï¤á¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£ Éä¹æ²½Àë¸À EncodingDecl S 'encoding' Eq '"' EncName '"' | "'" EncName "'" EncName [A-Za-z] ([A-Za-z0-9._] | '-')* ¥é¥Æ¥óʸ»ú¤À¤±¤ò´Þ¤àÉä¹æ²½Ì¾ ʸ½ñ¼ÂÂΤǤϡ¤Éä¹æ²½Àë¸À¤Ï¡¤XMLÀë¸À¤Î°ìÉô¤È¤¹¤ë¡£EncName¤Ï¡¤»ÈÍѤ¹¤ëÉä¹æ²½Êý¼°¤Î̾Á°¤È¤¹¤ë¡£

Éä¹æ²½Àë¸À¤Ç¤Ï¡¤ÃÍUTF-8¡¤UTF-16¡¤ISO-10646-UCS-2µÚ¤ÓISO-10646-UCS-4¤Ï¡¤UnicodeµÚ¤ÓISO/IEC 10646¤Î³Æ¼ïÉä¹æ²½¤Î¤¿¤á¤ËÍѤ¤¤ë¡£ÃÍISO-8859-1¤«¤éISO-8859-9¤Þ¤Ç¤Ï¡¤ISO 8859¤ÎÂбþ¤¹¤ë¥Ñ¡¼¥È¤Î¤¿¤á¤ËÍѤ¤¤ë¡£ÃÍISO-2022-JP¡¤Shift_JISµÚ¤ÓEUC-JP¤Ï¡¤JIS X-0208-1997¤Î³Æ¼ïÉä¹æ²½¤Î¤¿¤á¤ËÍѤ¤¤ë¡£XML&processor;¤Ï¡¤¤½¤ì°Ê³°¤ÎÉä¹æ²½Êý¼°¤òǧ¼±¤·¤Æ¤â¤è¤¤¡£Internet Assigned Numbers Authority (IANA)¤Ë¡¤(charsets¤È¤·¤Æ)ÅÐÏ¿¤µ¤ì¤¿Ê¸»úÉä¹æ²½Êý¼°¤Ë¤Ä¤¤¤Æ¤Ï¡¤¤³¤ì¤é°Ê³°¤Ë¤Ä¤¤¤Æ¤â¡¤ÅÐÏ¿¤µ¤ì¤¿Ì¾Á°¤Ç»²¾È¤¹¤ë¤³¤È¤¬Ë¾¤Þ¤·¤¤¡£¤³¤ì¤é¤ÎÅÐÏ¿¤µ¤ì¤¿Ì¾Á°¤Ï¡¤Âçʸ»ú¡¦¾®Ê¸»ú¤Î¶èÊ̤ò¤»¤º¤ËÄêµÁ¤µ¤ì¤Æ¤¤¤ë¤Î¤Ç¡¤¤³¤ì¤é¤ËÂФ¹¤ëÈæ³Ó¤ò»î¤ß¤ë&processor;¤Ï¡¤Âçʸ»ú¡¦¾®Ê¸»ú¤Î¶èÊ̤ò¤·¤Ê¤¤ÊýË¡¤ò¤È¤ë¤Î¤¬Ë¾¤Þ¤·¤¤¤³¤È¤ËÃí°Õ¤¹¤ë¡£

XML½èÍý·Ï¤ËÅϤµ¤ì¤¿¼ÂÂΤ¬¡¤Éä¹æ²½Àë¸À¤ò´Þ¤à¤Ë¤â¤«¤«¤ï¤é¤º¡¤Àë¸À¤Ç¼¨¤·¤¿¤â¤Î°Ê³°¤ÎÊý¼°¤ÇÉä¹æ²½¤µ¤ì¤Æ¤¤¤¿¤ê¡¤Éä¹æ²½Àë¸À¤¬¡¤³°Éô¼ÂÂΤκǽé°Ê³°¤Î°ÌÃ֤˽и½¤¹¤ì¤Ð¡¤&error;¤È¤¹¤ë¡£

&byte-order-mark;¤Ç¤âÉä¹æ²½Àë¸À¤Ç¤â»Ï¤Þ¤é¤Ê¤¤¼ÂÂΤϡ¤UTF-8Éä¹æ²½¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

½èÍý¤Ç¤­¤Ê¤¤Éä¹æ²½¤ò¤â¤Ã¤¿¼ÂÂΤòXML&processor;¤¬È¯¸«¤·¤¿¤È¤­¤Ï¡¤&application;¤Ë¤½¤Î»ö¼Â¤òÄÌÃΤ·¡¤&fatal-error;¤È¤·¤Æ¡¤½èÍý¤ò½ªÎ»¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

Éä¹æ²½Àë¸À¤ÎÎã¤ò¡¤¼¡¤Ë¼¨¤¹¡£ <?xml encoding='UTF-8'?> <?xml encoding='EUC-JP'?>

 XML&processor;¤Ë¤è¤ë¼ÂÂεڤӻ²¾È¤Î°·¤¤

¼¡¤Îɽ¤Ï¡¤Ê¸»ú»²¾È¡¤¼ÂÂλ²¾ÈµÚ¤Ó&unparsed-entity;¤Î¸Æ½Ð¤·¤¬¸½¤ì¤ëʸ̮µÚ¤Ó³Æ¡¹¤Î¾ì¹ç¤Ë¤ª¤±¤ëXML&processor;¤ËÍ׵᤹¤ë¿¶Éñ¤¤¤òÍ×Ì󤹤롣°ìÈÖº¸¤ÎÎó¤Î¥é¥Ù¥ë¤Ï¡¤Ç§¼±¤Îʸ̮¤ò¼¨¤¹¡£

Í×ÁǤγ«»Ï¥¿¥°µÚ¤Ó½ªÎ»¥¿¥°¤Î´Ö¤ÎǤ°Õ¤Î¾ì½ê¤Ç¤Î»²¾È¡£Èó½ªÃ¼µ­¹æcontent¤ËÂбþ¤¹¤ë¡£

³«»Ï¥¿¥°¤Î°À­¤ÎÃÍ¡¤Ëô¤Ï°À­Àë¸À¤Ë¤ª¤±¤ë&default-value;¤Î¤¤¤º¤ì¤«¤Ç¤Î»²¾È¡£Èó½ªÃ¼µ­¹æAttValue¤ËÂбþ¤¹¤ë¡£

»²¾È¤Ç¤Ï¤Ê¤¯¡¤Name¤È¤·¤Æ½Ð¸½¡£ENTITY·¿¤È¤·¤ÆÀë¸À¤·¤¿Â°À­¤ÎÃÍ¡¤Ëô¤ÏENTITIES·¿¤È¤·¤ÆÀë¸À¤·¤¿Â°À­¤ÎÃͤˤª¤±¤ë&space;¤Ç¶èÀÚ¤ë&token;¤Î°ì¤Ä¤È¤·¤Æ½Ð¸½¤¹¤ë¡£

¼ÂÂΤÎÀë¸À¤Ë¤ª¤±¤ë¡¤¥Ñ¥é¥á¥¿Ëô¤ÏÆâÉô¼ÂÂΤÎ&literal;¼ÂÂÎÃÍÆâ¤Î»²¾È¡£Èó½ªÃ¼µ­¹æEntityValue¤ËÂбþ¤¹¤ë¡£

DTD¤ÎÆâÉô⊂Ëô¤Ï³°Éô⊂¤Ç¤Î»²¾È¡£¤¿¤À¤·¡¤EntityValueËô¤ÏAttValue¤Î³°Â¦¤È¤¹¤ë¡£

¼ÂÂΤη¿ ʸ»ú ¥Ñ¥é¥á¥¿ ÆâÉô&newline;°ìÈÌ ³°Éô&newline;&parsed-entity;&newline;°ìÈÌ &unparsed-entity; ÆâÍƤǤÎ&newline;»²¾È ǧ¼±&newline;¤·¤Ê¤¤ ¼è¹þ¤ß ¸¡¾Ú¤Î¤¿¤á¤Ë¼è¹þ¤ß ¶Ø»ß ¼è¹þ¤ß °À­ÃͤǤÎ&newline;»²¾È ǧ¼±&newline;¤·¤Ê¤¤ ¼è¹þ¤ß ¶Ø»ß ¶Ø»ß ¼è¹þ¤ß °À­ÃͤȤ·¤Æ&newline;½Ð¸½ ǧ¼±&newline;¤·¤Ê¤¤ ¶Ø»ß ¶Ø»ß ÄÌÃΠǧ¼±&newline;¤·¤Ê¤¤ ¼ÂÂÎÃͤǤÎ&newline;»²¾È ¼è¹þ¤ß &bypass; &bypass; ¶Ø»ß ¼è¹þ¤ß DTD¤Ç¤Î&newline;»²¾È PE¤È¤·¤Æ&newline;¼è¹þ¤ß ¶Ø»ß ¶Ø»ß ¶Ø»ß ¶Ø»ß ¡Èǧ¼±¤·¤Ê¤¤¡É

DTD¤Î³°¤Ç¤Ï¡¤%ʸ»ú¤Ï¡¤¤¤¤«¤Ê¤ëÆÃÄê¤Î°ÕÌ£¤â¡¤¤â¤¿¤Ê¤¤¡£¤·¤¿¤¬¤Ã¤Æ¡¤DTD¤Ç¤Ï¥Ñ¥é¥á¥¿¼ÂÂλ²¾È¤È¤·¤Æǧ¼±¤¹¤ë¤â¤Î¤Ç¤¢¤Ã¤Æ¤â¡¤contentÆâ¤Ç¤Ï&markup;¤È¤·¤Æ¤Ïǧ¼±¤·¤Ê¤¤¡£Æ±Íͤˡ¤Å¬ÀÚ¤ËÀë¸À¤·¤¿Â°À­¤ÎÃͤÎÃæ¤Ë¸½¤ì¤ë¾ì¹ç¤ò½ü¤­¡¤&unparsed-entity;¤Î̾Á°¤Ï¡¤Ç§¼±¤·¤Ê¤¤¡£

¡È¼è¹þ¤ß¡É

¼ÂÂΤϡ¤¤½¤Î&replacement-text;¤ò¼è¤ê½Ð¤·¡¤½èÍý¤¹¤ë¤È¡¤»²¾È¼«ÂΤÎÂå¤ï¤ê¤Ë¡¤»²¾È¤¬¤¢¤Ã¤¿°ÌÃ֤ǡ¤Ê¸½ñ¤Î°ìÉô¤È¤·¤Æ´Þ¤Þ¤ì¤ë¤«¤Î¤è¤¦¤Ë¼è¤ê¹þ¤Þ¤ì¤ë¡£&replacement-text;¤Ï¡¤Ê¸»ú¥Ç¡¼¥¿µÚ¤Ó(¥Ñ¥é¥á¥¿¼ÂÂΤò½ü¤¯¡£)&markup;¤Î¤¤¤º¤ì¤ò´Þ¤ó¤Ç¤â¤è¤¯¡¤¤³¤ì¤é¤Ï¡¤Ä̾ï¤ÎÊýË¡¤Çǧ¼±¤µ¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤¿¤À¤·¡¤&markup;¤Î¶èÀÚ¤ê»Ò¤ò&escape;¤¹¤ë¤¿¤á¤ËÍѤ¤¤ë¼ÂÂÎ(&magicents;)¤Î&replacement-text;¤Ï¡¤¾ï¤Ë¥Ç¡¼¥¿¤È¤·¤Æ°·¤¦(&string;"AT&amp;T;"¤Ï¡¤"AT&T;"¤ËŸ³«¤µ¤ì¡¤»Ä¤µ¤ì¤¿¥¢¥ó¥Ñ¥µ¥ó¥É¤Ï¡¤¼ÂÂλ²¾È¤Î¶èÀÚ¤ê»Ò¤È¤·¤Æ¤Ïǧ¼±¤·¤Ê¤¤¡£)¡£Ê¸»ú»²¾È¤Ï¡¤¼¨¤·¤¿Ê¸»ú¤ò»²¾È¼«ÂΤÎÂå¤ï¤ê¤Ë½èÍý¤¹¤ë¤È¤­¡¤¼è¤ê¹þ¤Þ¤ì¤ë¡£

¡È¸¡¾Ú¤Î¤¿¤á¤Ë¼è¹þ¤ß¡É

ʸ½ñ¤Î&validity;¤ò¸¡¾Ú¤¹¤ë¤Ë¤Ï¡¤XML&processor;¤¬&parsed-entity;¤Ø¤Î»²¾È¤òǧ¼±¤·¤¿¤È¤­¡¤¤½¤Î&replacement-text;¤ò¼è¤ê¹þ¤Þ¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¼ÂÂΤ¬³°Éô¼ÂÂΤǤ¢¤Ã¤Æ¡¤XMLʸ½ñ¤Î&validity;¤ò¸¡¾Ú¤·¤Ê¤±¤ì¤Ð¡¤¼ÂÂΤÎ&replacement-text;¤ò¼è¤ê¹þ¤ó¤Ç¤â¤è¤¤¤¬¡¤¤½¤¦¤·¤Ê¤¯¤È¤â¤è¤¤¡£

¤³¤Î¼è·è¤á¤Ï¡¤SGMLµÚ¤ÓXML¤Î¼ÂÂΤε¡¹½¤¬Ä󶡤¹¤ë¼«Æ°¼è¹þ¤ßµ¡Ç½¤¬¡¤Ê¸½ñºîÀ®»þ¤Î¥â¥¸¥å¡¼¥ë²½¤ò¼ç¤ÊÌÜŪ¤È¤·¤ÆÀ߷פµ¤ì¤Æ¤ª¤ê¡¤¤½¤Î¾¤Î&application;(Æäˡ¤Ê¸½ñ¤Î¥Ö¥é¥¦¥º)¤Ë¤Ï¡¤É¬¤º¤·¤âŬÀڤǤϤʤ¤¡¤¤È¤¤¤¦Ç§¼±¤Ë¤è¤ë¡£Î㤨¤Ð¡¤¥Ö¥é¥¦¥¶¤Ï³°Éô&parsed-entity;¤Ø¤Î»²¾È¤ò¸«¤Ä¤±¤ë¤È¡¤¤½¤Î¼ÂÂΤ¬Â¸ºß¤¹¤ë¤È¤¤¤¦É½¼¨¤À¤±¤ò¹Ô¤¤¡¤É½¼¨¤òÍ׵ᤵ¤ì¤¿¤È¤­¤Ë¤À¤±¡¤ÆâÍƤò¼è¤ê½Ð¤¹¤«¤â¤·¤ì¤Ê¤¤¡£

¡È¶Ø»ß¡É

¼¡¤Ï¶Ø»ß¤µ¤ì¤Æ¤ª¤ê¡¤&fatal-error;¤È¤¹¤ë¡£

a) &unparsed-entity;¤Ø¤Î»²¾È¤Î½Ð¸½¡£

b) DTD¤ÎEntityValueËô¤ÏAttValue°Ê³°¤ÎÉôʬ¤Ë¤ª¤±¤ë¡¤Ê¸»ú»²¾ÈËô¤Ï°ìÈ̼ÂÂΤؤλ²¾È¤Î½Ð¸½¡£

c) °À­ÃÍÆâ¤Î³°Éô¼ÂÂΤؤλ²¾È¡£

¡ÈÄÌÃΡÉ

&unparsed-entity;¤Î̾Á°¤¬¡¤ENTITYËô¤ÏENTITIES¤Î°À­¤ÎÃͤˤª¤¤¤Æ&token;¤È¤·¤Æ¸½¤ì¤¿¤È¤­¡¤&processor;¤Ï¡¤&application;¤ËÂФ·¤Æ¡¤´ØÏ¢ÉÕ¤±¤é¤ì¤¿µ­Ë¡Ì¾¡¤µ­Ë¡¤ËÂФ¹¤ë¥·¥¹¥Æ¥à&identifier;µÚ¤Ó(¸ºß¤¹¤ì¤Ð)¸ø³«&identifier;¤òÄÌÃΤ·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

 ¡È&bypass;¡É

°ìÈ̼ÂÂλ²¾È¤¬¡¤¼ÂÂÎÀë¸À¤Ë¤ª¤±¤ëEntityValueÆâ¤Ë¸½¤ì¤ë¤È¤­¡¤¤½¤ì¤Ï̵»ë¤µ¤ì¡¤¤½¤Î¤Þ¤Þ»Ä¤ë¡£

 ¡ÈPE¤È¤·¤Æ¼è¹þ¤ß¡É

³°Éô&parsed-entity;¤Î¾ì¹ç¤ÈƱÍͤˡ¤¥Ñ¥é¥á¥¿¼ÂÂΤϡ¤&validity;¤ò¸¡¾Ú¤¹¤ë¤È¤­¤À¤±¼è¤ê¹þ¤Þ¤ì¤ëɬÍפ¬¤¢¤ë¡£¥Ñ¥é¥á¥¿¼ÂÂλ²¾È¤òDTDÆâ¤Ëǧ¼±¤·¤Æ¼è¤ê¹þ¤à¤È¤­¡¤¤½¤Î&replacement-text;¤Ï¡¤¤½¤ÎÁ°¸å¤Ë°ì¤Ä¤Î&space-character;(#x20)¤ÎÉղäˤè¤Ã¤Æ°ú¤­¿­¤Ð¤µ¤ì¤ë¡£¤³¤Î°Õ¿Þ¤Ï¡¤¥Ñ¥é¥á¥¿¼ÂÂΤÎ&replacement-text;¤¬¡¤DTDÆâ¤Î¤¤¤¯¤Ä¤«¤ÎʸˡŪ&token;¤ò´°Á´¤Ë´Þ¤à¤È¡¤À©Ì󤹤뤳¤È¤Ë¤¢¤ë¡£

ÆâÉô¼ÂÂÎ&replacement-text;¤Î¹½ÃÛ

ÆâÉô¼ÂÂΤμ谷¤¤¤Îµ¬Äê¤Ç¡¤¼ÂÂÎÃͤòÆó¤Ä¤Î·Á¼°¤Ë¶èÊ̤¹¤ë¤³¤È¤ÏÌò¤ËΩ¤Ä¡£&literal;¼ÂÂÎÃͤϡ¤¼ÂÂÎÀë¸ÀÆâ¤Ë¼ÂºÝ¤Ë¸ºß¤¹¤ë¡¤°úÍÑÉä¤Ç°Ï¤à&string;¤È¤¹¤ë¡£¤³¤ì¤Ï¡¤Èó½ªÃ¼µ­¹æEntityValue¤Ë&match;¤¹¤ë¡£&replacement-text;¤Ï¡¤Ê¸»ú»²¾ÈµÚ¤Ó¶meter;¼ÂÂλ²¾È¤ÎÃÖ´¹¤¨¸å¤Ë¤ª¤±¤ë¡¤¼ÂÂΤÎÆâÍƤȤ¹¤ë¡£

ÆâÉô¼ÂÂÎÀë¸ÀÆâ¤ÇÍ¿¤¨¤ë&literal;¼ÂÂÎÃÍ(EntityValue)¤Ï¡¤Ê¸»ú»²¾È¡¤¶meter;¼ÂÂλ²¾ÈµÚ¤Ó°ìÈ̼ÂÂλ²¾È¤ò´Þ¤ó¤Ç¤è¤¤¡£¤³¤ì¤é¤Î»²¾È¤Ï¡¤&literal;¼ÂÂÎÃÍÆâ¤Ë´°Á´¤Ë´Þ¤Þ¤ì¤Æ¤¤¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£Å¸³«¤¹¤ë¼ÂºÝ¤Î&replacement-text;(Àè¤Ë¼¨¤·¤¿¤â¤Î)¤Ï¡¤»²¾È¤¹¤ë¶meter;¼ÂÂΤÎ&replacement-text;¤ò´Þ¤Þ¤Ê¤±¤ì¤Ð¤Ê¤é¤º¡¤&literal;¼ÂÂÎÃÍÆâ¤Ç¤Îʸ»ú»²¾È¤ÎÂå¤ï¤ê¤Ë»²¾È¤·¤¿Ê¸»ú¤ò´Þ¤Þ¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤·¤«¤·¡¤°ìÈ̼ÂÂλ²¾È¤Ï¡¤¤½¤Î¤Þ¤Þ»Ä¤·, Ÿ³«¤·¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£ Î㤨¤Ð¡¤¼¡¤ÎÀë¸À¤òÍ¿¤¨¤¿¤È¤¹¤ë¡£ ]]> ¼ÂÂΤÎ&replacement-text;"book"¤Ï¡¤¼¡¤Î¤È¤ª¤ê¤È¤Ê¤ë¡£ La Peste: Albert Camus, © 1947 Éditions Gallimard. &rights; »²¾È"&book;"¤¬¡¤Ê¸½ñ¤ÎÆâÍÆËô¤Ï°À­ÃÍÆâ¤Ë½Ð¸½¤·¤Æ¤¤¤ì¤Ð¡¤°ìÈ̼ÂÂλ²¾È"&rights;"¤Ï¡¤Å¸³«¤µ¤ì¤Æ¤¤¤ë¡£

¤³¤ì¤é¤Îñ½ã¤Êµ¬Â§¤Ï¡¤Ê£¹çÁê¸ßºîÍѤò¤â¤Ä¡£ Æñ¤·¤¤Îã¤Ë¤Ä¤¤¤Æ¤Î¾ÜºÙ¤Ï¡¤¼ÂÂλ²¾È¤ÎŸ³«¤ÎÉÕÏ¿¤ò»²¾È¤Î¤³¤È¡£

ÄêµÁºÑ¤ß¼ÂÂÎ

¼ÂÂλ²¾ÈµÚ¤Óʸ»ú»²¾È¤Î¤¤¤º¤ì¤â¡¤&left-angle-bracket;¡¤¥¢¥ó¥Ð¥µ¥ó¥ÉµÚ¤Ó¾¤Î¶èÀÚ¤ê»Ò¤ò&escape;¤¹¤ë¤¿¤á¤Ë»ÈÍѤǤ­¤ë¡£¤¤¤¯¤Ä¤«¤Î°ìÈ̼ÂÂΡÊ&magicents;¡Ë¤ò¡¤¤³¤ÎÌÜŪ¤Î¤¿¤á¤Ë»ØÄꤹ¤ë¡£¿ôÃͤˤè¤ëʸ»ú»²¾È¤â¡¤Æ±ÍͤÎÌÜŪ¤Î¤¿¤á¤Ë»ÈÍѤǤ­¤ë¡£Ê¸»ú»²¾È¤Ï¡¤Ç§¼±¤µ¤ì¤ë¤Èľ¤Á¤ËŸ³«¤µ¤ì¡¤Ê¸»ú¥Ç¡¼¥¿¤È¤·¤Æ°·¤ï¤ì¤ë¤Î¤Ç¡¤¿ôÃͤˤè¤ëʸ»ú»²¾È"&#60;"µÚ¤Ó"&#38;"¤Ï¡¤Ê¸»ú¥Ç¡¼¥¿Æâ¤Ë½Ð¸½¤¹¤ë<µÚ¤Ó&¤ò&escape;¤¹¤ë¤¿¤á¤Ë»ÈÍѤǤ­¤ë¡£

¤¹¤Ù¤Æ¤ÎXML&processor;¤Ï¡¤Àë¸À¤µ¤ì¤Æ¤¤¤ë¤«¤É¤¦¤«¤Ë´Ø·¸¤Ê¤¯¡¤¤³¤ì¤é¤Î¼ÂÂΤòǧ¼±¤·¤Ê¤¯¤Æ¤Ï¤Ê¤é¤Ê¤¤¡£Áê¸ß±¿ÍÑÀ­¤Î¤¿¤á¡¤&valid;¤ÊXMLʸ½ñ¤Ï¡¤¤³¤ì¤é¤Î¼ÂÂΤò»ÈÍѤ¹¤ëÁ°¤Ë¡¤Â¾¤Î¼ÂÂΤÈƱÍͤˡ¤Àë¸À¤¹¤ë¤³¤È¤¬Ë¾¤Þ¤·¤¤¡£¼ÂÂΤòÀë¸À¤¹¤ë¾ì¹ç¤Ï¡¤&replacement-text;¤ò&escape;¤¹¤ë°ìʸ»ú¤È¤¹¤ëÆâÉô¼ÂÂΤȤ·¤Æ¡¤¼¡¤Î¤È¤ª¤ê¤ËÀë¸À¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£ ]]> "lt"µÚ¤Ó"amp"Àë¸ÀÆâ¤Î"<"µÚ¤Ó"&"ʸ»ú¤Ï¡¤¼ÂÂΤÎÃÖ´¹¥Æ¥­¥¹¥È¤¬¡¤&well-formed;¤È¤Ê¤ë¤è¤¦¤ËÆó½Å¤Ë&escape;¤µ¤ì¤ë¤³¤È¤ËÃí°Õ¡£

µ­Ë¡Àë¸À

µ­Ë¡¤Ï¡¤&unparsed-entity;¤Î·Á¼°¤ò&identify;̾Á°¤«¡¤Ëô¤Ï½èÍýÌ¿Îá¤ÎÂоݤȤ¹¤ë&application;¤ò&identify;̾Á°¤È¤¹¤ë¡£

µ­Ë¡Àë¸À¤Ï¡¤µ­Ë¡¤Î̾Á°µÚ¤Ó³°Éô&identifier;¤òÄ󶡤¹¤ë¡£¤³¤Î̾Á°¤Ï¡¤¼ÂÂεڤÓ°À­¥ê¥¹¥ÈÀë¸ÀʤӤË°À­»ØÄê¤ËÍѤ¤¤ë¡£³°Éô&identifier;¤Ï¡¤Í¿¤¨¤é¤ì¤¿µ­Ë¡¤Î¥Ç¡¼¥¿¤ò½èÍý¤Ç¤­¤ë¥Ø¥ë¥Ñ&application;¤ò¡¤XML&processor;Ëô¤Ï¥¯¥é¥¤¥¢¥ó¥È¥¢¥×¥ê¥±¡¼¥·¥ç¥ó¤¬Ãµ¤¹¤¿¤á¤Ë¡¤ÍøÍѤǤ­¤ë¡£ µ­Ë¡Àë¸À NotationDecl '<!NOTATION' S Name S (ExternalID | PublicID) S? '>' PublicID 'PUBLIC' S PubidLiteral

Àë¸À¤·¡¤Â°À­ÃÍ¡¤Â°À­ÄêµÁËô¤Ï¼ÂÂÎÀë¸À¤Ç»²¾È¤¹¤ë¤¹¤Ù¤Æ¤Îµ­Ë¡¤Ë¤Ä¤¤¤Æ¡¤XML&processor;¤Ï¡¤µ­Ë¡¤Î̾Á°µÚ¤Ó³°Éô&identifier;¤ò&application;¤ËÄ󶡤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤µ¤é¤Ë¡¤³°Éô&identifier;¤ò¡¤¥·¥¹¥Æ¥à&identifier;¡¤¥Õ¥¡¥¤¥ë̾Ëô¤Ï¤½¤Î¾¤Î¾ðÊó¤ËŸ³«¤·¤Æ¤â¤è¤¯¡¤¤³¤ì¤é¤òÍѤ¤¤Æ¡¤&application;¤Ï¡¤¤½¤Îµ­Ë¡¤Î¥Ç¡¼¥¿¤ò½èÍý¤¹¤ë&processor;¤òµ¯Æ°¤¹¤ë¡£(¤·¤«¤·¡¤XML&processor;Ëô¤Ï&application;¤¬Æ°ºî¤¹¤ë¥·¥¹¥Æ¥à¤Ç¤ÏÍøÍѤǤ­¤Ê¤¤µ­Ë¡¤ò¡¤XMLʸ½ñ¤¬Àë¸À¤·»²¾È¤·¤Æ¤â¡¤¤³¤ì¤Ï¡¤&error;¤È¤Ï¤·¤Ê¤¤¡£¡Ë

 ʸ½ñ¼ÂÂÎ

ʸ½ñ¼ÂÂΤϡ¤¼ÂÂΤηÁÀ®¤¹¤ëÌÚ¹½Â¤¤Î&root;¤Ç¤¢¤Ã¤Æ¡¤XML&processor;¤¬¡¤½èÍý¤ò³«»Ï¤¹¤ëÃÏÅÀ¤È¤¹¤ë¡£¤³¤Î&TR-or-Rec;¤Ï¡¤XML&processor;¤¬¡¤Ê¸½ñ¼ÂÂΤθºß¤¹¤ë¾ì½ê¤ò¤É¤Î¤è¤¦¤Ë¸«¤Ä¤±¤ë¤«¤Ï¡¤µ¬Äꤷ¤Ê¤¤¡£Â¾¤Î¼ÂÂΤȰۤʤꡤʸ½ñ¼ÂÂΤÏ̾Á°¤ò¤â¤¿¤º¡¤¤¤¤«¤Ê¤ë¼±Ê̤â¤Ê¤·¤Ë&processor;¤Ø¤ÎÆþÎÏ&stream;¤Ë½Ð¸½¤·¤Æ¤â¤è¤¤¡£

 Ŭ¹çÀ­

Ŭ¹ç¤¹¤ëXML&processor;¤Ï¡¤&validating;¤â¤ÎµÚ¤Ó&non-validating;¤â¤Î¤Î¡¤Æó¤Ä¤ËʬÎव¤ì¤ë¡£

&validating;¥·¥¹¥Æ¥àµÚ¤Ó&non-validating;¥·¥¹¥Æ¥à¤Ï¡¤¤³¤Î&TR-or-Rec;¤¬µ¬Äꤹ¤ë&well-formed;À©Ìó¤Ø¤Î°ãÈ¿¤òÊó¹ð¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

&validating;&processor;¤Ï¡¤DTDÆâ¤ÎÀë¸À¤Ë¤è¤Ã¤Æ¼¨¤µ¤ì¤¿¡¤À©Ìó¤Ø¤Î°ãÈ¿¤òÊó¹ð¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤µ¤é¤Ë¡¤¤³¤Î&TR-or-Rec;¤¬µ¬Äꤹ¤ë&validity;À©Ìó¤Ø¤Î°ãÈ¿¤ò¡¤¤¹¤Ù¤ÆÊó¹ð¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

µ­Ë¡

XML¤Î·Á¼°Åª¤Êʸˡ¤Ï¡¤´Êñ¤Ê³ÈÄ¥Backus-Naur Form(EBNF)µ­Ë¡¤Ë¤è¤Ã¤ÆÍ¿¤¨¤ë¡£Ê¸Ë¡¤Î³Æµ¬Â§¤Ï¡¤¼¡¤Î·Á¼°¤Ç¡¤µ­¹æ¤ò°ì¤ÄÄêµÁ¤¹¤ë¡£ symbol ::= expression

µ­¹æ¤Ï¡¤Àµµ¬É½¸½¤ÇÄêµÁ¤¹¤ë¤È¤­¤ÏÂçʸ»ú¤Ç»Ï¤á¡¤¤½¤¦¤Ç¤Ê¤±¤ì¤Ð¡¤¾®Ê¸»ú¤Ç»Ï¤á¤ë¡£&string;&literal;¤Ï¡¤°úÍÑÉä¤Ç°Ï¤à¡£

µ¬Â§¤Î±¦Â¦¤Î¼°Æâ¤Ç¤Ï¡¤°ì¤ÄËô¤ÏÊ£¿ô¤Îʸ»ú¤«¤é¤Ê¤ë&string;¤È&match;¤¹¤ë¤¿¤á¤Ë¡¤¼¡¤Î¼°¤ò»ÈÍѤ¹¤ë¡£

¤³¤³¤Ç¡¤N¤Ï16¿Ê¤ÎÀ°¿ô¤È¤¹¤ë¡£ISO/IEC 10646¤Îʸ»ú¤Ç¤¢¤Ã¤Æ¡¤Àµµ¬·Á(UCS-4)¤Î&code-value;¤òÉä¹æ¤Ê¤·2¿Ê¿ô¤È¤·¤Æ²ò¼á¤·¤¿¤È¤­¡¤»ØÄꤷ¤¿ÃͤÈÅù¤·¤¤¤â¤Î¤È&match;¤¹¤ë¡£#xN·Á¼°¤ÎÀèƬ¤Ë¥¼¥í¤¬¤¤¤¯¤Ä¤«¸½¤ì¤ë¤«¤Ï¡¤°ÕÌ£¤ò¤â¤¿¤Ê¤¤¡£&code-value;¤Ë¤ª¤±¤ëÀèƬ¤Î¥¼¥í¤Î¿ô¤Ï¡¤Ê¸»ú¤ÎÉä¹æ²½¤Ë¤è¤Ã¤Æ·èÄꤵ¤ì¤ë¤Î¤Ç¡¤XML¤Ë¤È¤Ã¤Æ¤Ï°ÕÌ£¤¬¤Ê¤¤¡£

»ØÄꤷ¤¿ÈϰϤÎÃÍ(ξü¤ÎÃͤò´Þ¤à¡£¡Ë¤ò¤â¤ÄǤ°Õ¤Îʸ»ú¤È&match;¤¹¤ë¡£

»ØÄꤷ¤¿Èϰϳ°¤ÎÃͤò¤â¤ÄǤ°Õ¤Îʸ»ú¤È&match;¤¹¤ë¡£

»ØÄꤷ¤¿Ê¸»ú°Ê³°¤ÎÃͤò¤â¤ÄǤ°Õ¤Îʸ»ú¤È&match;¤¹¤ë¡£

&double-quote;¤Ç°Ï¤à&string;&literal;¤È&match;¤·¤Æ¤¤¤ë&string;&literal;¤È&match;¤¹¤ë¡£

&single-quote;¤Ç°Ï¤à&string;&literal;¤È&match;¤·¤Æ¤¤¤ë&string;&literal;¤È&match;¤¹¤ë¡£

 ¤³¤ì¤é¤Îµ­¹æ¤Ï¡¤¼¡¤Î·Á¼°¤ÎÁȹ礻¤Ç»ÈÍѤ¹¤ë¡£¤³¤³¤Ç¡¤AµÚ¤ÓB¤Ï¡¤Ã±½ã¤Ê¼°¤È¤¹¤ë¡£

expression¤Ï¡¤°ì¤Ä¤Î¤Þ¤È¤Þ¤ê¤È¤·¤Æ°·¤¤¡¤¤³¤³¤Ë¼¨¤¹Áȹ礻¤Ç»È¤Ã¤Æ¤â¤è¤¤¡£

AËô¤Ï²¿¤â¤Ê¤·¤È&match;¤¹¤ë(¥ª¥×¥·¥ç¥ó¤ÎA)¡£

A¤Î¼¡¤ËB¤¬½Ð¸½¤¹¤ë¤â¤Î¤È&match;¤¹¤ë¡£

AËô¤ÏB¡¤¤¿¤À¤·¡¤Î¾Êý¤Ç¤Ï¤Ê¤¤¡¤¤È&match;¤¹¤ë¡£

A¤È&match;¤¹¤ë¤¬¡¤B¤È¤Ï&match;¤·¤Ê¤¤¡¤Ç¤°Õ¤Î&string;¤È&match;¤¹¤ë¡£

A¤Î1²ó°Ê¾å¤Î·«ÊÖ¤·¤È&match;¤¹¤ë¡£

A¤Î0²ó°Ê¾å¤Î·«ÊÖ¤·¤È&match;¤¹¤ë¡£

 À¸À®µ¬Â§Æâ¤Ç»ÈÍѤ¹¤ë¾¤Îµ­Ë¡¤ò¡¤¼¡¤Ë¼¨¤¹¡£

¥³¥á¥ó¥È¡£

&well-formed;À©Ìó¡£À¸À®µ¬Â§¤ËÉÕÍ¿¤·¤¿¡¤&well-formed;¤Îʸ½ñ¤Ë´Ø¤¹¤ëÀ©Ìó¤ò¡¤Ì¾Á°¤Ë¤è¤Ã¤Æ&identify;¡£

&validity;À©Ìó¡£À¸À®µ¬Â§¤ËÉÕÍ¿¤·¤¿¡¤&valid;¤Êʸ½ñ¤Ë´Ø¤¹¤ëÀ©Ìó¤ò¡¤Ì¾Á°¤Ë¤è¤Ã¤Æ&identify;¡£

»²¹Íʸ¸¥ &normative;»²¹Íʸ¸¥ IETF (Internet Engineering Task Force). RFC 1766: Tags for the Identification of Languages, ed. H. Alvestrand. 1995. (International Organization for Standardization). ISO 8879:1988 (E). Code for the representation of names of languages. [Geneva]: International Organization for Standardization, 1988. (International Organization for Standardization). ISO 3166-1:1997 (E). Codes for the representation of names of countries and their subdivisions — Part 1: Country codes [Geneva]: International Organization for Standardization, 1997. ISO (International Organization for Standardization). ISO/IEC 10646-1993 (E). Information technology — Universal Multiple-Octet Coded Character Set (UCS) — Part 1: Architecture and Basic Multilingual Plane. [Geneva]: International Organization for Standardization, 1993 (plus amendments AM 1 through AM 7). The Unicode Consortium. The Unicode Standard, Version 2.0. Reading, Mass.: Addison-Wesley Developers Press, 1996. ¾¤Î»²¹Íʸ¸¥ Aho, Alfred V., Ravi Sethi, and Jeffrey D. Ullman. Compilers: Principles, Techniques, and Tools. Reading: Addison-Wesley, 1986, rpt. corr. 1988. Berners-Lee, T., R. Fielding, and L. Masinter. Uniform Resource Identifiers (URI): Generic Syntax and Semantics. 1997. (Work in progress; see updates to RFC1738.) Brüggemann-Klein, Anne. Regular Expressions into Finite Automata. Extended abstract in I. Simon, Hrsg., LATIN 1992, S. 97-98. Springer-Verlag, Berlin 1992. Full Version in Theoretical Computer Science 120: 197-213, 1993. Brüggemann-Klein, Anne, and Derick Wood. Deterministic Regular Languages. Universität Freiburg, Institut für Informatik, Bericht 38, Oktober 1991. IETF (Internet Engineering Task Force). RFC 1738: Uniform Resource Locators (URL), ed. T. Berners-Lee, L. Masinter, M. McCahill. 1994. IETF (Internet Engineering Task Force). RFC 1808: Relative Uniform Resource Locators, ed. R. Fielding. 1995. IETF (Internet Engineering Task Force). RFC 2141: URN Syntax, ed. R. Moats. 1997. ISO (International Organization for Standardization). ISO/IEC 8879-1986 (E). Information processing — Text and Office Systems — Standard Generalized Markup Language (SGML). First edition — 1986-10-15. [Geneva]: International Organization for Standardization, 1986. ISO (International Organization for Standardization). ISO/IEC 10744-1992 (E). Information technology — Hypermedia/Time-based Structuring Language (HyTime). [Geneva]: International Organization for Standardization, 1992. Extended Facilities Annexe. [Geneva]: International Organization for Standardization, 1996. ʸ»ú¥¯¥é¥¹

Unicodeɸ½à¤ËÄêµÁ¤¹¤ë&property;¤Ë¤·¤¿¤¬¤Ã¤Æ¡¤Ê¸»ú¤Ï¡¤&base-character;(BaseChar)(¤³¤ì¤é¤Ï¡¤&diacritical-mark;¤ò½ü¤¯¥é¥Æ¥ó¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È¤Î¥¢¥ë¥Õ¥¡¥Ù¥Ã¥Èʸ»ú¤ò´Þ¤à)¡¤&ideographic;(ideographic)µÚ¤Ó&combining-character;(CombiningChar)(¤³¤Î¥¯¥é¥¹¤Ï¡¤¤Û¤È¤ó¤É¤Î&diacritical-mark;¤ò´Þ¤à)¤Ë¥¯¥é¥¹Ê¬¤±¤¹¤ë¡£¤³¤ì¤é¤Î¥¯¥é¥¹¤Ï¡¤·ë¹ç¤·¡¤&letter;(Letter)¤Î¥¯¥é¥¹¤È¤Ê¤ë¡£10¿Ê¿ôÃÍ(Digit)µÚ¤Ó&extender;(Extender)¤â¶èÊ̤¹¤ë¡£ ʸ»ú Letter BaseChar | Ideographic BaseChar [#x0041-#x005A] | [#x0061-#x007A] | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x00FF] | [#x0100-#x0131] | [#x0134-#x013E] | [#x0141-#x0148] | [#x014A-#x017E] | [#x0180-#x01C3] | [#x01CD-#x01F0] | [#x01F4-#x01F5] | [#x01FA-#x0217] | [#x0250-#x02A8] | [#x02BB-#x02C1] | #x0386 | [#x0388-#x038A] | #x038C | [#x038E-#x03A1] | [#x03A3-#x03CE] | [#x03D0-#x03D6] | #x03DA | #x03DC | #x03DE | #x03E0 | [#x03E2-#x03F3] | [#x0401-#x040C] | [#x040E-#x044F] | [#x0451-#x045C] | [#x045E-#x0481] | [#x0490-#x04C4] | [#x04C7-#x04C8] | [#x04CB-#x04CC] | [#x04D0-#x04EB] | [#x04EE-#x04F5] | [#x04F8-#x04F9] | [#x0531-#x0556] | #x0559 | [#x0561-#x0586] | [#x05D0-#x05EA] | [#x05F0-#x05F2] | [#x0621-#x063A] | [#x0641-#x064A] | [#x0671-#x06B7] | [#x06BA-#x06BE] | [#x06C0-#x06CE] | [#x06D0-#x06D3] | #x06D5 | [#x06E5-#x06E6] | [#x0905-#x0939] | #x093D | [#x0958-#x0961] | [#x0985-#x098C] | [#x098F-#x0990] | [#x0993-#x09A8] | [#x09AA-#x09B0] | #x09B2 | [#x09B6-#x09B9] | [#x09DC-#x09DD] | [#x09DF-#x09E1] | [#x09F0-#x09F1] | [#x0A05-#x0A0A] | [#x0A0F-#x0A10] | [#x0A13-#x0A28] | [#x0A2A-#x0A30] | [#x0A32-#x0A33] | [#x0A35-#x0A36] | [#x0A38-#x0A39] | [#x0A59-#x0A5C] | #x0A5E | [#x0A72-#x0A74] | [#x0A85-#x0A8B] | #x0A8D | [#x0A8F-#x0A91] | [#x0A93-#x0AA8] | [#x0AAA-#x0AB0] | [#x0AB2-#x0AB3] | [#x0AB5-#x0AB9] | #x0ABD | #x0AE0 | [#x0B05-#x0B0C] | [#x0B0F-#x0B10] | [#x0B13-#x0B28] | [#x0B2A-#x0B30] | [#x0B32-#x0B33] | [#x0B36-#x0B39] | #x0B3D | [#x0B5C-#x0B5D] | [#x0B5F-#x0B61] | [#x0B85-#x0B8A] | [#x0B8E-#x0B90] | [#x0B92-#x0B95] | [#x0B99-#x0B9A] | #x0B9C | [#x0B9E-#x0B9F] | [#x0BA3-#x0BA4] | [#x0BA8-#x0BAA] | [#x0BAE-#x0BB5] | [#x0BB7-#x0BB9] | [#x0C05-#x0C0C] | [#x0C0E-#x0C10] | [#x0C12-#x0C28] | [#x0C2A-#x0C33] | [#x0C35-#x0C39] | [#x0C60-#x0C61] | [#x0C85-#x0C8C] | [#x0C8E-#x0C90] | [#x0C92-#x0CA8] | [#x0CAA-#x0CB3] | [#x0CB5-#x0CB9] | #x0CDE | [#x0CE0-#x0CE1] | [#x0D05-#x0D0C] | [#x0D0E-#x0D10] | [#x0D12-#x0D28] | [#x0D2A-#x0D39] | [#x0D60-#x0D61] | [#x0E01-#x0E2E] | #x0E30 | [#x0E32-#x0E33] | [#x0E40-#x0E45] | [#x0E81-#x0E82] | #x0E84 | [#x0E87-#x0E88] | #x0E8A | #x0E8D | [#x0E94-#x0E97] | [#x0E99-#x0E9F] | [#x0EA1-#x0EA3] | #x0EA5 | #x0EA7 | [#x0EAA-#x0EAB] | [#x0EAD-#x0EAE] | #x0EB0 | [#x0EB2-#x0EB3] | #x0EBD | [#x0EC0-#x0EC4] | [#x0F40-#x0F47] | [#x0F49-#x0F69] | [#x10A0-#x10C5] | [#x10D0-#x10F6] | #x1100 | [#x1102-#x1103] | [#x1105-#x1107] | #x1109 | [#x110B-#x110C] | [#x110E-#x1112] | #x113C | #x113E | #x1140 | #x114C | #x114E | #x1150 | [#x1154-#x1155] | #x1159 | [#x115F-#x1161] | #x1163 | #x1165 | #x1167 | #x1169 | [#x116D-#x116E] | [#x1172-#x1173] | #x1175 | #x119E | #x11A8 | #x11AB | [#x11AE-#x11AF] | [#x11B7-#x11B8] | #x11BA | [#x11BC-#x11C2] | #x11EB | #x11F0 | #x11F9 | [#x1E00-#x1E9B] | [#x1EA0-#x1EF9] | [#x1F00-#x1F15] | [#x1F18-#x1F1D] | [#x1F20-#x1F45] | [#x1F48-#x1F4D] | [#x1F50-#x1F57] | #x1F59 | #x1F5B | #x1F5D | [#x1F5F-#x1F7D] | [#x1F80-#x1FB4] | [#x1FB6-#x1FBC] | #x1FBE | [#x1FC2-#x1FC4] | [#x1FC6-#x1FCC] | [#x1FD0-#x1FD3] | [#x1FD6-#x1FDB] | [#x1FE0-#x1FEC] | [#x1FF2-#x1FF4] | [#x1FF6-#x1FFC] | #x2126 | [#x212A-#x212B] | #x212E | [#x2180-#x2182] | [#x3041-#x3094] | [#x30A1-#x30FA] | [#x3105-#x312C] | [#xAC00-#xD7A3] Ideographic [#x4E00-#x9FA5] | #x3007 | [#x3021-#x3029] CombiningChar [#x0300-#x0345] | [#x0360-#x0361] | [#x0483-#x0486] | [#x0591-#x05A1] | [#x05A3-#x05B9] | #x05BB#x05BD | #x05BF | [#x05C1-#x05C2] | #x05C4 | #x064B#x0652 | #x0670 | [#x06D6-#x06DC] | #x06DD#x06DF | [#x06E0-#x06E4] | [#x06E7-#x06E8] | [#x06EA-#x06ED] | [#x0901-#x0903] | #x093C | [#x093E-#x094C] | #x094D | [#x0951-#x0954] | [#x0962-#x0963] | [#x0981-#x0983] | #x09BC | #x09BE | #x09BF | [#x09C0-#x09C4] | [#x09C7-#x09C8] | [#x09CB-#x09CD] | #x09D7 | [#x09E2-#x09E3] | #x0A02 | #x0A3C | #x0A3E | #x0A3F | [#x0A40-#x0A42] | [#x0A47-#x0A48] | [#x0A4B-#x0A4D] | [#x0A70-#x0A71] | [#x0A81-#x0A83] | #x0ABC | [#x0ABE-#x0AC5] | [#x0AC7-#x0AC9] | [#x0ACB-#x0ACD] | [#x0B01-#x0B03] | #x0B3C | [#x0B3E-#x0B43] | [#x0B47-#x0B48] | [#x0B4B-#x0B4D] | [#x0B56-#x0B57] | [#x0B82-#x0B83] | [#x0BBE-#x0BC2] | [#x0BC6-#x0BC8] | [#x0BCA-#x0BCD] | #x0BD7 | [#x0C01-#x0C03] | [#x0C3E-#x0C44] | [#x0C46-#x0C48] | [#x0C4A-#x0C4D] | [#x0C55-#x0C56] | [#x0C82-#x0C83] | [#x0CBE-#x0CC4] | [#x0CC6-#x0CC8] | [#x0CCA-#x0CCD] | [#x0CD5-#x0CD6] | [#x0D02-#x0D03] | [#x0D3E-#x0D43] | [#x0D46-#x0D48] | [#x0D4A-#x0D4D] | #x0D57 | #x0E31 | [#x0E34-#x0E3A] | [#x0E47-#x0E4E] | #x0EB1 | [#x0EB4-#x0EB9] | [#x0EBB-#x0EBC] | [#x0EC8-#x0ECD] | [#x0F18-#x0F19] | #x0F35 | #x0F37 | #x0F39 | #x0F3E | #x0F3F | [#x0F71-#x0F84] | [#x0F86-#x0F8B] | [#x0F90-#x0F95] | #x0F97 | [#x0F99-#x0FAD] | [#x0FB1-#x0FB7] | #x0FB9 | [#x20D0-#x20DC] | #x20E1 | [#x302A-#x302F] | #x3099 | #x309A Digit [#x0030-#x0039] | [#x0660-#x0669] | [#x06F0-#x06F9] | [#x0966-#x096F] | [#x09E6-#x09EF] | [#x0A66-#x0A6F] | [#x0AE6-#x0AEF] | [#x0B66-#x0B6F] | [#x0BE7-#x0BEF] | [#x0C66-#x0C6F] | [#x0CE6-#x0CEF] | [#x0D66-#x0D6F] | [#x0E50-#x0E59] | [#x0ED0-#x0ED9] | [#x0F20-#x0F29] Extender #x00B7 | #x02D0 | #x02D1 | #x0387 | #x0640 | #x0E46 | #x0EC6 | #x3005 | [#x3031-#x3035] | [#x309D-#x309E] | [#x30FC-#x30FE]

¤³¤³¤ÇÄêµÁ¤¹¤ëʸ»ú¥¯¥é¥¹¤Ï¡¤Unicodeʸ»ú¥Ç¡¼¥¿¥Ù¡¼¥¹¤«¤é¡¤¼¡¤Î¤È¤ª¤ê¤ËÆÀ¤ë¤³¤È¤¬¤Ç¤­¤ë¡£

a) ̾Á°³«»Ïʸ»ú¤Ï¡¤Ll, Lu, Lo, Lt, Nl¥«¥Æ¥´¥êÆâ¤Î°ì¤Ä¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

b) ̾Á°³«»Ïʸ»ú°Ê³°¤Î̾Á°Ê¸»ú¤Ï¡¤Mc, Me, Mn, Lm, Nd¥«¥Æ¥´¥êÆâ¤Î°ì¤Ä¤Ç¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£

c) &compatibility-area;¤Ë¤¢¤ëʸ»ú(ʸ»úÉä¹æ¤Ç#xF900¤è¤êÂ礭¤¯#xFFFE¤è¤ê¾®¤µ¤¤Ê¸»ú)¤Ï¡¤XML¤Ë¤ª¤±¤ë̾Á°¤È¤·¤Æ¤Ï¡¤µö¤µ¤ì¤Ê¤¤¡£

d) &font-decomposition;¤«&compatibility-decomposition;¤ò¤â¤Äʸ»ú(¤Ä¤Þ¤ê¡¤¥Ç¡¼¥¿¥Ù¡¼¥¹Æâ¤Î£µÈÖÌܤΥե£¡¼¥ë¥É¤Ë"compatibility formatting tag"¤¬¤¢¤ë¤â¤Î¡£¤³¤ì¤Ï¡¤£µÈÖÌܤΥե£¡¼¥ë¥É¤¬¡¤"<"¤Ç»Ï¤Þ¤ë¤³¤È¤Ë¤è¤Ã¤Æ¥Þ¡¼¥¯ÉÕ¤±¤µ¤ì¤ë¡£)¤Ï¡¤µö¤µ¤ì¤Ê¤¤¡£

e) ¼¡¤Îʸ»ú¤Ï¡¤Ì¾Á°³«»Ïʸ»ú¤È¤·¤Æ°·¤¦¡£¤³¤ì¤Ï¡¤&property-file;¤¬¡¤¤³¤ì¤é¤Îʸ»ú¤ò¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È¤ËÎà»÷¤¹¤ë¤È¸«¤Ê¤¹¤³¤È¤Ë¤è¤ë¡£¤½¤ì¤é¤Ï [#x02BB-#x02C1], #x0559, #x06E5, #x06E6¤È¤¹¤ë¡£

f) ʸ»úÉä¹æ¤¬#x20DD-#x20E0¤Îʸ»ú¤Ï¡¤(Unicode ¤Î5.14¤Ë¤·¤¿¤¬¤Ã¤Æ)½ü³°¤¹¤ë¡£

g) ʸ»úÉä¹æ¤¬#x00B7¤Îʸ»ú¤Ï¡¤&property-list;¤Ë¤·¤¿¤¬¤Ã¤Æ¡¤&extender;(extender)¤ËʬÎह¤ë¡£

h) ʸ»ú#x0387¤Ï¡¤¤³¤ì¤ËÁêÅö¤¹¤ëÀµµ¬·Á¤¬#x00B7¤Ê¤Î¤Ç¡¤Ì¾Á°Ê¸»ú¤ËÄɲ乤롣

i) ʸ»ú':'µÚ¤Ó'_'¤Ï¡¤Ì¾Á°³«»Ïʸ»ú¤È¤·¤Æµö¤¹¡£

j) ʸ»ú'-'µÚ¤Ó'.'¤Ï¡¤Ì¾Á°Ê¸»ú¤È¤·¤Æµö¤¹¡£

XMLµÚ¤ÓSGML

XML¤Ï¡¤SGML¤Î⊂¤È¤·¤ÆÀ߷פµ¤ì¤Æ¤¤¤ë¡£¤¹¤Ê¤ï¤Á¡¤¤¹¤Ù¤Æ¤Î&valid;¤ÊXMLʸ½ñ¤Ï¡¤µ¬³Ê¤ËŬ¹ç¤¹¤ëSGMLʸ½ñ¤Ë¤â¤Ê¤ë¡£SGML¤¬Ê¸½ñ¤Ë²Ý¤¹À©¸Â°Ê³°¤Ë¡¤XML¤¬¤¤¤«¤Ê¤ëÀ©¸Â¤ò²Ý¤¹¤«¤Ë´Ø¤¹¤ë¾ÜºÙ¤Ï¡¤Ê̤ε¬Äø¤ò»²¾È¤Î¤³¤È¡£¤³¤Îµ¬Äø¤Ï¡¤XML¤ÎÀ©Ìó¾ò·ï¤ò¼¨¤¹SGMLÀë¸À¤ò´Þ¤ß¡¤¤³¤ì¤Ï¡¤SGML&parser;¤Ë»ÈÍѤǤ­¤ë¡£

¼ÂÂλ²¾ÈµÚ¤Óʸ»ú»²¾È¤ÎŸ³«

¤³¤ÎÉÕÏ¿¤Ï¡¤¼ÂÂλ²¾ÈµÚ¤Óʸ»ú»²¾È¤òǧ¼±¤·¡¤Å¸³«¤¹¤ë¡¤°ìÏ¢¤Îή¤ì¤ò¡¤Îã¤Ë»È¤Ã¤Æ¼¨¤¹¡£

DTD¤¬¡¤¼¡¤ÎÀë¸À¤ò´Þ¤à¾ì¹ç¤ò¹Í¤¨¤ë¡£ An ampersand (&#38;) may be escaped numerically (&#38;#38;) or with a general entity (&amp;).

" > ]]> XML&processor;¤Ï¡¤¼ÂÂΤÎÀë¸À¤ò¹½Ê¸²òÀϤ·¤¿»þÅÀ¤Çʸ»ú»²¾È¤òǧ¼±¤·¡¤¤³¤ì¤ò²ò·è¤¹¤ë¡£¼ÂÂÎ"example"¤ÎÃͤȤ·¤Æ¡¤¼¡¤Î&string;¤òÊݸ¤¹¤ë¡£ An ampersand (&) may be escaped numerically (&#38;) or with a general entity (&amp;).

]]> ʸ½ñÆâ¤Ç"&example;"¤ò»²¾È¤¹¤ë¤È¡¤¤³¤Î¥Æ¥­¥¹¥È¤Ï¡¤ºÆ¤Ó¹½Ê¸²òÀϤµ¤ì¤ë¡£¤³¤Î¤È¤­¡¤Í×ÁÇ"p"¤Î³«»Ï¥¿¥°µÚ¤Ó½ªÎ»¥¿¥°¤òǧ¼±¤·¡¤»°¤Ä¤Î»²¾È¤òǧ¼±¤·Å¸³«¤¹¤ë¡£¤½¤Î·ë²Ì¡¤Í×ÁÇ"p"¤Ï¡¤¼¡¤ÎÆâÍƤò¤â¤Ä(¤¹¤Ù¤Æ¥Ç¡¼¥¿¤È¤·¡¤¶èÀÚ¤ê»ÒËô¤Ï&markup;¤Ï¸ºß¤·¤Ê¤¤¡£)¡£

µ¬Â§µÚ¤Ó¤½¤Î¸ú²Ì¤ò¤è¤ê¾ÜºÙ¤Ë¼¨¤¹¤¿¤á¡¤¤µ¤é¤ËÊ£»¨¤ÊÎã¤ò¼¨¤¹¡£¼¡¤ÎÎã¤Ç¡¤¹ÔÈÖ¹æ¤Ï¡¤»²¾È¤ÎÊص¹¤Î¤¿¤á¤À¤±¤ËÉÕ¤±¤ë¡£ 2 4 5 ' > 6 %xx; 7 ]> 8 This sample shows a &tricky; method. ]]> ¤³¤ì¤ò½èÍý¤¹¤ë¤È¡¤¼¡¤Î¤È¤ª¤ê¤È¤Ê¤ë¡£

a) 4¹ÔÌܤǡ¤37ÈÖÌܤÎʸ»ú¤Ø¤Î»²¾È¤òľ¤Á¤ËŸ³«¤·¡¤¥Ñ¥é¥á¥¿¼ÂÂÎ"xx"¤ò¡¤¥·¥ó¥Ü¥ë¥Æ¡¼¥Ö¥ë¤Ë"%zz;"¤È¤¤¤¦ÃͤȤȤâ¤ËÊݸ¤¹¤ë¡£&replacement-text;¤òºÆ¤ÓÁöºº¤¹¤ë¤³¤È¤Ï¤Ê¤¤¤Î¤Ç¡¤¥Ñ¥é¥á¥¿¼ÂÂÎ"zz"¤Ø¤Î»²¾È¤Ïǧ¼±¤·¤Ê¤¤("zz"¤Ï¡¤¤Þ¤ÀÀë¸À¤µ¤ì¤Æ¤¤¤Ê¤¤¤Î¤Ç¡¤Áöºº¤µ¤ì¤ì¤Ð¡¤&error;¤È¤Ê¤ë¡£)¡£

b) 5¹ÔÌܤǡ¤Ê¸»ú»²¾È"&#60;"¤òľ¤Á¤ËŸ³«¤·¡¤¥Ñ¥é¥á¥¿¼ÂÂÎ"zz"¤ò"<!ENTITY tricky "error-prone" >"¤È¤¤¤¦&replacement-text;¤È¤È¤â¤ËÊݸ¤¹¤ë¡£¤³¤ì¤Ï¡¤&well-formed;¤Î¼ÂÂÎÀë¸À¤È¤¹¤ë¡£

c) 6¹ÔÌܤǡ¤"xx"¤Ø¤Î»²¾È¤òǧ¼±¤·¡¤"xx"¤Î&replacement-text;(¤¹¤Ê¤ï¤Á¡¤"%zz;")¤ò¹½Ê¸²òÀϤ¹¤ë¡£"zz"¤Ø¤Î»²¾È¤ò³¤¤¤Æǧ¼±¤·¡¤&replacement-text;("<!ENTITY tricky "error-prone" >")¤ò¹½Ê¸²òÀϤ¹¤ë¡£°ìÈ̼ÂÂÎ"tricky"¤Ï¡¤¤³¤Î»þÅÀ¤Ç¤Ï¡¤Àë¸À¤µ¤ì¤Æ¤ª¤ê¡¤¤½¤Î&replacement-text;¤Ï¡¤"error-prone"¤È¤¹¤ë¡£

d) 8¹ÔÌܤǡ¤°ìÈ̼ÂÂÎ"tricky"¤Ø¤Î»²¾È¤òǧ¼±¤·¡¤Å¸³«¤¹¤ë¡£Í×ÁÇ"test"¤Î´°Á´¤ÊÆâÍƤϡ¤¼¡¤Î(ÆâÍƤò¤½¤ì¼«ÂÎɽ¸½¤¹¤ë¡£)&string;¤È¤Ê¤ë¡£¤Ä¤Þ¤ê¡¤This sample shows a error-prone method.

·èÄêŪÆâÍÆ¥â¥Ç¥ë

¸ß´¹À­¤Î¤¿¤á¡¤Í×ÁÇÀë¸À¤Ë¤ª¤±¤ëÆâÍÆ¥â¥Ç¥ë¤Ï¡¤·èÄêŪ¤È¤¹¤ëɬÍפ¬¤¢¤ë¡£

SGML¤Ï¡¤·èÄêŪÆâÍÆ¥â¥Ç¥ë(SGML¤Ç¤Ï¡¤È󤢤¤¤Þ¤¤¤È¸Æ¤Ö¡£)¤òÍ׵᤹¤ë¡£SGML¥·¥¹¥Æ¥à¤òÍѤ¤¤ÆºîÀ®¤·¤¿XML&processor;¤Ï¡¤Èó·èÄêŪÆâÍÆ¥â¥Ç¥ë¤ò&error;¤È¤·¤Æ¤â¤è¤¤¡£

Î㤨¤Ð¡¤ÆâÍÆ¥â¥Ç¥ë((b, c) | (b, d))¤ÏÈó·èÄêŪ¤È¤Ê¤ë¡£¤³¤ì¤Ï¡¤ºÇ½é¤Ëb¤òÍ¿¤¨¤¿¤È¤­¡¤¥â¥Ç¥ëÆâ¤Î¤¤¤º¤ì¤Îb¤È&match;¤¹¤ë¤Î¤¬Ë¾¤Þ¤·¤¤¤«¡¤¤½¤Î¼¡¤ÎÍ×ÁǤòÀèÆɤߤ¹¤ë¤³¤È¤Ê¤·¤Ë¤Ï¡¤&parser;¤ÏÃΤ뤳¤È¤¬¤Ç¤­¤Ê¤¤¤³¤È¤Ë¤è¤ë¡£¤³¤Î¾ì¹ç¤Ï¡¤b¤Ø¤ÎÆó¤Ä¤Î»²¾È¤Ï¡¤°ì¤Ä¤Î»²¾È¤Ë¤Þ¤È¤á¤ë¤³¤È¤¬¤Ç¤­¡¤¥â¥Ç¥ë¤Ï¡¤(b, (c | d))¤È¤Ê¤ë¡£¤³¤ì¤Ç¡¤ºÇ½é¤Îb¤¬¡¤ÆâÍÆ¥â¥Ç¥ëÆâ¤Î°ì¤Ä¤Î̾Á°¤È¤À¤±&match;¤¹¤ë¤³¤È¤ÏÌÀ¤é¤«¤È¤Ê¤ë¡£&parser;¤Ï¡¤ÀèÆɤߤ·¤Æ¡¤¼¡¤ËÍè¤ë¤â¤Î¤òÃΤëɬÍפ¬¤Ê¤¤¡£c¤âd¤â¡¤¼õÍý¤µ¤ì¤ë¡£

·Á¼°Åª¤Ë¼¨¤¹¡£Aho, Sethi, and Ullman ¤Î3.9¤Î¥¢¥ë¥´¥ê¥º¥à3.5¤Îɸ½àŪ¤Ê¥¢¥ë¥´¥ê¥º¥à¤òÍѤ¤¤Æ¡¤ÆâÍÆ¥â¥Ç¥ë¤«¤éÍ­¸Â¥ª¡¼¥È¥Þ¥È¥ó¤ò¹½À®¤¹¤ë¤³¤È¤¬¤Ç¤­¤ë¡£¤³¤Î¼ï¤Î¿¤¯¤Î¥¢¥ë¥´¥ê¥º¥à¤Ç¤Ï¡¤Àµµ¬É½¸½¤Ë¤ª¤±¤ë³Æ¡¹¤Î°ÌÃÖ(¤Ä¤Þ¤ê¡¤Àµµ¬É½¸½¤Î¹½Ê¸Ìڤˤª¤±¤ë³Æ¡¹¤ÎËöü¥Î¡¼¥É)¤ËÂФ·¤Æ¡¤follow set(¼¡¤Ë¤É¤Î°ÌÃ֤˰ÜÆ°²Äǽ¤«¤òɽ¤¹¤â¤Î)¤ò¹½À®¤¹¤ë¡£¤¢¤ë°ÌÃÖ¤ËÂФ¹¤ëfollow set¤Ë¤ª¤¤¤Æ¡¤Ê£¿ô¤Î°ÌÃÖ¤¬Æ±¤¸Í×ÁÇ·¿Ì¾¤Ç¥é¥Ù¥ëÉÕ¤±¤µ¤ì¤Æ¤¤¤ì¤Ð¡¤¤½¤ÎÆâÍÆ¥â¥Ç¥ë¤Ï&error;¤È¤Ê¤ê¡¤&error;¤òÊÖ¤¹¾ì¹ç¤â¤¢¤ë¡£

¤¹¤Ù¤Æ¤ÎÈó·èÄêŪÆâÍÆ¥â¥Ç¥ë¤òÅù²Á¤Ê·èÄêŪÆâÍÆ¥â¥Ç¥ë¤ËÊÑ´¹¤¹¤ë¤³¤È¤Ï¤Ç¤­¤Ê¤¤¤¬¡¤Â¿¤¯¤ÎÈó·èÄêŪÆâÍÆ¥â¥Ç¥ë¤òÊÑ´¹¤¹¤ë¥¢¥ë¥´¥ê¥º¥à¤¬Â¸ºß¤¹¤ë¡£Brüggemann-Klein 1991 ¤ò»²¾È¤Î¤³¤È¡£

 ʸ»úÉä¹æ²½¤Î¼«Æ°¸¡½Ð

XML¤ÎÉä¹æ²½Àë¸À¤Ï¡¤³Æ¼ÂÂΤÎÆâÉô¥é¥Ù¥ë¤È¤·¤Æµ¡Ç½¤·¡¤¤É¤Îʸ»úÉä¹æ²½¤ò»ÈÍѤ¹¤ë¤«¤ò¼¨¤¹¡£¤·¤«¤·¡¤XML&processor;¤Ï¡¤ÆâÉô¥é¥Ù¥ë¤òÆɤàÁ°¤Ë¡¤¤É¤Îʸ»úÉä¹æ²½¤ò»ÈÍѤ¹¤ë¤«¤òÃΤëɬÍפ¬¤¢¤ê¡¤¤³¤ì¤¬¡¤ÆâÉô¥é¥Ù¥ë¤¬¼¨¤½¤¦¤È¤¹¤ë¤³¤È¤Ë¤Ê¤ë¡£°ìÈÌŪ¤Ë¤Ï¡¤¤³¤ì¤Ï¡¤Àä˾Ū¤Ê¾õÂ֤Ȥʤ롣¤·¤«¤·¡¤XML¤Ë¤ª¤¤¤Æ¤Ï¡¤´°Á´¤Ë¤ÏÀä˾Ū¤Ç¤Ï¤Ê¤¤¡£¤³¤ì¤Ï¡¤XML¤¬¡¤¼¡¤ÎÆó¤Ä¤ÎÅÀ¤Ç°ìÈÌŪ¤Ê¾ì¹ç¤ËÂФ¹¤ëÀ©¸Â¤ò²Ã¤¨¤ë¤³¤È¤Ë¤è¤ë¡£°ì¤Ä¤ÎÀ©¸Â¤Ï¡¤¤É¤Î¼ÂÁõ¤âÍ­¸Â¸Ä¤Îʸ»úÉä¹æ²½¤À¤±¤Î¥µ¥Ý¡¼¥È¤òÁÛÄꤹ¤ë¤³¤È¤È¤¹¤ë¡£Â¾¤Î°ì¤Ä¤ÎÀ©¸Â¤Ï¡¤³Æ¼ÂÂΤǻÈÍѤ¹¤ëʸ»úÉä¹æ²½¤ò¼«Æ°¸¡½Ð²Äǽ¤È¤¹¤ë¡¤XML¤ÎÉä¹æ²½Àë¸À¤Î°ÌÃÖµÚ¤ÓÆâÍƤ˴ؤ¹¤ëÀ©¸Â¤È¤¹¤ë¡£Â¿¤¯¤Î¾ì¹ç¤Ë¡¤XML¤Î¥Ç¡¼¥¿¥¹¥È¥ê¡¼¥à¤Ë²Ã¤¨¡¤Â¾¤Î¾ðÊó¤¬ÍøÍѤǤ­¤ë¡£¤³¤³¤Ç¤Ï¡¤XML¤Î¼ÂÂΤ¬&processor;¤ËÅϤµ¤ì¤ë¤È¤­¡¤(³°Éô)¾ðÊó¤òȼ¤¦¤«¤É¤¦¤«¤Ë¤è¤Ã¤Æ¡¤Æó¤Ä¤Î¾ì¹ç¤Ëʬ¤±¤ë¡£¤Þ¤ººÇ½é¤Î¾ì¹ç¤ò¼¨¤¹¡£

UTF-8·Á¼°Ëô¤ÏUTF-16·Á¼°¤Ç¤Ï¤Ê¤¤XML¼ÂÂΤϡ¤ºÇ½é¤Îʸ»ú¤ò¡Æ<?xml'¤È¤¹¤ëXMLÉä¹æ²½Àë¸À¤Ç»Ï¤Þ¤é¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¤Î¤Ç¡¤¤É¤ÎŬ¹ç¤·¤¿&processor;¤â¡¤ÆþÎϤˤ¢¤ë2¥ª¥¯¥Æ¥Ã¥ÈËô¤Ï4¥ª¥¯¥Æ¥Ã¥È¤òÄ´¤Ù¤ì¤Ð¡¤¼¡¤Î¤É¤Î¾ì¹ç¤¬¤¢¤Æ¤Ï¤Þ¤ë¤«¤ò¸¡½Ð¤Ç¤­¤ë¡£¤³¤Î¥ê¥¹¥È¤òÆɤàºÝ¤Ë¤Ï¡¤UCS-4¤Î'<'¤¬"#x0000003C"¡¤'?'¤¬"#x0000003F"¡¤µÚ¤ÓUTF-16¤Î¥Ç¡¼¥¿&stream;¤ÎɬÍפȤ¹¤ë&byte-order-mark;¤¬"#xFEFF"¤È¤¤¤¦¤³¤È¤òÃΤäƤª¤¯¤ÈÌòΩ¤Ä¤«¤â¤·¤ì¤Ê¤¤¡£

a) 00 00 00 3C: UCS-4, big-endian ¥Þ¥·¥ó (1234½ç)

b) 3C 00 00 00: UCS-4, little-endian ¥Þ¥·¥ó (4321½ç)

c) 00 00 3C 00: UCS-4, ÉáÄ̤ǤϤʤ¤¥ª¥¯¥Æ¥Ã¥È½ç (2143)

d) 00 3C 00 00: UCS-4, ÉáÄ̤ǤϤʤ¤¥ª¥¯¥Æ¥Ã¥È½ç (3412)

e) FE FF: UTF-16, big-endian

f) FF FE: UTF-16, little-endian

g) 00 3C 00 3F: UTF-16, big-endian, &byte-order-mark;¤Ê¤·(¤·¤¿¤¬¤Ã¤Æ¡¤¸·Ì©¤Ë¤¤¤¨¤Ð¡¤&error;¤È¤¹¤ë¡£)¡£

h) 3C 00 3F 00: UTF-16, little-endian, &byte-order-mark;¤Ê¤·(¤·¤¿¤¬¤Ã¤Æ¡¤¸·Ì©¤Ë¤¤¤¨¤Ð¡¤&error;¤È¤¹¤ë¡£)¡£

i) 3C 3F 78 6D: UTF-8, ISO 646, ASCII, ISO 8859¤Î³Æ¥Ñ¡¼¥È¡¤Shift-JIS¡¤EUC¡¤Ê¤ӤËǤ°Õ¤Î¾¤Î7¥Ó¥Ã¥È¡¤8¥Ó¥Ã¥ÈËô¤Ïº®ºßÉý¤ÎÉä¹æ²½¤Ç¤¢¤Ã¤Æ¡¤ASCIIʸ»ú¤òÄ̾ï¤Î°ÌÃÖ¡¤ÉýµÚ¤ÓÃͤȤ¹¤ë¤³¤È¤òÊݾڤ¹¤ë¤â¤Î¡£¤³¤ì¤é¤Î¤É¤ì¤ËÂбþ¤¹¤ë¤«¤ò¸¡½Ð¤¹¤ë¤¿¤á¤Ë¤Ï¡¤¼ÂºÝ¤ÎÉä¹æ²½Àë¸À¤òÆɤ߹þ¤Þ¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£¤·¤«¤·¡¤¤³¤ì¤é¤¹¤Ù¤Æ¤ÎÉä¹æ²½¤Ï¡¤ASCIIʸ»ú¤ËÂФ·¤ÆƱ¤¸¥Ó¥Ã¥È¥Ñ¥¿¡¼¥ó¤ò»ÈÍѤ¹¤ë¤Î¤Ç¡¤Éä¹æ²½Àë¸À¼«ÂΤϡ¤Àµ³Î¤ËÆɹþ¤ß²Äǽ¤È¤¹¤ë¡£

j) 4C 6F A7 94: EBCDIC (Ëô¤Ï¤½¤ÎÊѼ¤É¤Î¥³¡¼¥É¥Ú¡¼¥¸¤ò»ÈÍѤ¹¤ë¤«¤òÃΤ뤿¤á¤Ë¤Ï¡¤Éä¹æ²½Àë¸ÀÁ´ÂΤòÆɤ߹þ¤Þ¤ì¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£)

k) ¤½¤Î¾: Éä¹æ²½Àë¸À¤Ê¤·¤ÎUTF-8¡£¤½¤¦¤Ç¤Ê¤¤¤È¤­¤Ë¤Ï¡¤¥Ç¡¼¥¿&stream;¤¬²õ¤ì¤Æ¤¤¤ë¤«¡¤ÃÇÊÒŪ¤Ë¤Ê¤Ã¤Æ¤¤¤ë¤«¡¤²¿¤é¤«¤Î·Á¼°¤Ë¤·¤¿¤¬¤Ã¤ÆËä¤á¹þ¤Þ¤ì¤Æ¤¤¤ë¡£

¤³¤ÎÄøÅ٤μ«Æ°È½Ê̤Ǥ⡤XML¤ÎÉä¹æ²½Àë¸À¤òÆɤ߹þ¤ß¡¤Ê¸»úÉä¹æ²½¤Î&identifier;¤ò²òÀϤ¹¤ë¤Ë¤Ï½½Ê¬¤È¤¹¤ë¡£&identifier;¤Î²òÀϤϡ¤Îà»÷¤¹¤ë³Æ¡¹¤ÎÉä¹æ²½¤Î°ì¤Ä°ì¤Ä¤ò¶èÊ̤¹¤ë¤¿¤á¤ËɬÍפȤ¹¤ë(Î㤨¤Ð¡¤UTF-8µÚ¤Ó8859¤ò¶èÊ̤¹¤ë¤¿¤á¡¤8859¤Î³Æ¥Ñ¡¼¥È¤ò¶èÊ̤¹¤ë¤¿¤á¡¤»ÈÍѤ·¤Æ¤¤¤ëÆÃÄê¤ÎEBCDIC¥³¡¼¥É¥Ú¡¼¥¸¤ò¶èÊ̤¹¤ë¤¿¤á¡¤¤Ê¤É¡£)¡£

Éä¹æ²½Àë¸À¤ÎÆâÍƤòASCIIʸ»ú¤Ë¸ÂÄꤷ¤Æ¤¤¤ë¤Î¤Ç¡¤¤É¤ÎʬÎà¤ÎÉä¹æ²½¤ò»ÈÍѤ¹¤ë¤«¤ò¸¡½Ð¤¹¤ì¤Ð¡¤&processor;¤Ï¡¤Éä¹æ²½Àë¸ÀÁ´ÂΤòÀµ³Î¤ËÆɤ߹þ¤à¤³¤È¤¬¤Ç¤­¤ë¡£¸½¼ÂÌäÂê¤È¤·¤Æ¡¤¹­¤¯»ÈÍѤµ¤ì¤Æ¤¤¤ëʸ»úÉä¹æ²½¤Ï¡¤¾å¤ÎʬÎà¤Î¤¤¤º¤ì¤«¤Ë¤¢¤Æ¤Ï¤Þ¤ë¤Î¤Ç¡¤¥ª¥Ú¥ì¡¼¥Æ¥£¥ó¥°¥·¥¹¥Æ¥àËô¤ÏÅÁÁ÷¥×¥í¥È¥³¥ë¤¬Í¿¤¨¤ë³°Éô¾ðÊó¤ò¿®ÍêÉÔ²Äǽ¤Ê¤È¤­¤Ç¤µ¤¨¤â¡¤ÆâÉô¥é¥Ù¥ë¤Çʸ»úÉä¹æ²½¤ò¤«¤Ê¤êÀµ³Î¤Ë¼¨¤¹¤³¤È¤¬¡¤XMLÉä¹æ²½Àë¸À¤Ë¤è¤Ã¤Æ²Äǽ¤È¤Ê¤ë¡£

&processor;¤¬»ÈÍѤ¹¤ëʸ»úÉä¹æ²½¤ò¸¡½Ð¤·¤µ¤¨¤¹¤ì¤Ð¡¤¤½¤ì¤¾¤ì¤Î¾ì¹ç¤ËÂФ·¤ÆÊ̸ĤÎÆþÎϥ롼¥Á¥ó¤ò¸Æ¤Ó½Ð¤¹¡¤Ëô¤ÏÆþÎϤ¹¤ë³Æʸ»ú¤ËÂФ·Å¬ÀÚ¤ÊÊÑ´¹´Ø¿ô¤ò¸Æ¤Ó½Ð¤¹¤³¤È¤Ë¤è¤Ã¤Æ¡¤Å¬ÀÚ¤ÊÆ°ºî¤¬²Äǽ¤È¤Ê¤ë¡£

¼«Ê¬¼«ÂΤ˥é¥Ù¥ëÉÕ¤±¤ò¤¹¤ë¤¤¤«¤Ê¤ë¥·¥¹¥Æ¥à¤Ç¤âƱÍͤÀ¤¬¡¤¥½¥Õ¥È¥¦¥§¥¢¤¬¡¤Éä¹æ²½Àë¸À¤ò¹¹¿·¤»¤º¤Ë¼ÂÂΤÎʸ»ú½¸¹çËô¤ÏÉä¹æ²½¤òÊѤ¨¤¿¤Ê¤é¤Ð¡¤XML¤ÎÉä¹æ²½Àë¸À¤Ï¡¤µ¡Ç½¤·¤Ê¤¤¡£Ê¸»úÉä¹æ²½¥ë¡¼¥Á¥ó¤Î¼ÂÁõ¼Ô¤Ï¡¤¼ÂÂΤΥé¥Ù¥ëÉÕ¤±¤Ë»ÈÍѤ¹¤ëÆâÉôµÚ¤Ó³°Éô¤Î¾ðÊó¤ÎÀµ³Î¤µ¤ÎÊݾڤËÃí°Õ¤¹¤ë¤Î¤¬Ë¾¤Þ¤·¤¤¡£

£²ÈÖÌܤξì¹ç¤Ï¡¤XML¤Î¼ÂÂΤξ¤Ë¡¤Éä¹æ²½¾ðÊó¤¬Â¸ºß¤¹¤ë¤È¤­¤Ç¤¢¤Ã¤Æ¡¤¤¤¤¯¤Ä¤«¤Î¥Õ¥¡¥¤¥ë¥·¥¹¥Æ¥àµÚ¤Ó¥Í¥Ã¥È¥ï¡¼¥¯¥×¥í¥È¥³¥ë¤Ç¤Ï¡¤¤½¤ÎÉä¹æ²½¾ðÊó¤¬Â¸ºß¤¹¤ë¡£Ê£¿ô¤Î¾ðÊó¤¬ÍøÍѤǤ­¤ë¤È¤­¡¤¤½¤ì¤é¤ÎÁêÂÐŪ¤ÊÍ¥ÀèÅÙµÚ¤Ó¤½¤ì¤é¤¬Ì·½â¤·¤¿¤È¤­¤Î˾¤Þ¤·¤¤½èÍýÊýË¡¤Ï¡¤XML¤ÎÇÛÁ÷¤Ë»ÈÍѤ¹¤ë¡¤¤è¤ê¹â¿å½à¤Î¥×¥í¥È¥³¥ë¤Î°ìÉô¤È¤·¤Æµ¬Äø¤¹¤ë¤Î¤¬¤è¤¤¡£Î㤨¤Ð¡¤ÆâÉô¥é¥Ù¥ëµÚ¤Ó³°Éô&header;¤Ë¸ºß¤¹¤ëMIME·Á¼°¤Î¥é¥Ù¥ë¤ÎÁêÂÐŪ¤ÊÍ¥ÀèÅÙ¤ËÂФ¹¤ëµ¬Â§¤Ï¡¤text/xmlµÚ¤Óapplication/xml¤ÎMIME·¿¤òÄêµÁ¤¹¤ëRFCʸ½ñ¤Î°ìÉô¤È¤Ê¤ëÊý¤¬¤è¤¤¡£¤·¤«¤·¡¤Áê¸ß±¿ÍÑÀ­¤Î¤¿¤á¤Ë¡¤¼¡¤Îµ¬Â§¤Ë½¾¤¦¤³¤È¤¬Ë¾¤Þ¤·¤¤¡£

a) XML¤Î¼ÂÂΤ¬¥Õ¥¡¥¤¥ë¤Ë¸ºß¤¹¤ì¤Ð¡¤&byte-order-mark;µÚ¤ÓÉä¹æ²½Àë¸ÀPI¤Ï¡¤(¸ºß¤¹¤ì¤Ð)ʸ»úÉä¹æ²½¤ò·èÄꤹ¤ë¤¿¤á¤Ë»ÈÍѤ¹¤ë¡£Â¾¤Î¤¹¤Ù¤Æ¤Î&hueristics;µÚ¤Ó¾ðÊó¤Ï¡¤&error;²óÉü¤Î¤¿¤á¤À¤±¤ËÍѤ¤¤ë¡£

b) XML¤Î¼ÂÂΤòMIME·¿text/xml¤ÇÇÛÁ÷¤¹¤ë¤È¤­¤Ï¡¤¤³¤ÎMIME·¿¤Î¤â¤Ächarset¥Ñ¥é¥á¥¿¤¬Ê¸»úÉä¹æ²½ÊýË¡¤ò·èÄꤹ¤ë¡£Â¾¤Î¤¹¤Ù¤Æ¤Î&hueristics;µÚ¤Ó¾ðÊó¤Ï¡¤&error;²óÉü¤Î¤¿¤á¤À¤±¤ËÍѤ¤¤ë¡£

c) XML¤Î¼ÂÂΤò MIME·¿application/xml¤ÇÇÛÁ÷¤¹¤ë¤È¤­¤Ï¡¤&byte-order-mark;µÚ¤ÓÉä¹æ²½Àë¸ÀPI¤ò(¸ºß¤¹¤ì¤Ð)ʸ»úÉä¹æ²½¤Î·èÄê¤Î¤¿¤á¤Ë»ÈÍѤ¹¤ë¡£Â¾¤Î¤¹¤Ù¤Æ¤Î&hueristics;µÚ¤Ó¾ðÊó¤Ï&error;²óÉü¤Î¤¿¤á¤À¤±¤ËÍѤ¤¤ë¡£

¤³¤ì¤é¤Îµ¬Â§¤Ï¡¤¥×¥í¥È¥³¥ë¤Ë¤Ä¤¤¤Æ¤Î»ñÎÁ¤¬¤Ê¤¤¤È¤­¤Ë¤À¤±ÍѤ¤¤ë¡£Æäˡ¤MIME·¿text/xmlµÚ¤Óapplication/xml¤òÄêµÁ¤·¤¿¤é¡¤¤³¤ì¤é¤òµ¬Äꤹ¤ëRFC¤Ë¸ºß¤¹¤ëµ¬Ä꤬¡¤¤³¤ì¤é¤Îµ¬Â§¤Ë¼è¤Ã¤ÆÂå¤ï¤ë¡£

&informative;W3C XML ¥ï¡¼¥­¥ó¥°¥°¥ë¡¼¥×

¤³¤Î&TR-or-Rec;¤Ï¡¤W3C XML ¥ï¡¼¥­¥ó¥°¥°¥ë¡¼¥×(WG)¤¬½àÈ÷¤·¡¤¸ø³«¤ò¾µÇ§¤·¤¿¡£WG¤¬¤³¤Î&TR-or-Rec;¤ò¾µÇ§¤¹¤ë¤È¤¤¤¦¤³¤È¤Ï¡¤WG¤Î¤¹¤Ù¤Æ¤Î°Ñ°÷¤¬¾µÇ§Åêɼ¤ò¹Ô¤Ã¤¿¤È¤¤¤¦¤³¤È¤òɬ¤º¤·¤â°ÕÌ£¤·¤Ê¤¤¡£XML WG¤Î¸½ºß¤Î°Ñ°÷µÚ¤Ó°ÊÁ°¤Î°Ñ°÷¤ò¼¡¤Ë¼¨¤¹¡£

Jon Bosak, SunChair James ClarkTechnical Lead Tim Bray, Textuality and NetscapeXML Co-editor Jean Paoli, MicrosoftXML Co-editor C. M. Sperberg-McQueen, U. of Ill.XML Co-editor Dan Connolly, W3C Steve DeRose, INSO Dave Hollander, HP Eliot Kimber, Highland Eve Maler, ArborText Tom Magliery, NCSA Murray Maloney, Muzmo and Grif ¼ÅÄ¡¡¿¿¡¤ÉٻΥ¼¥í¥Ã¥¯¥¹¾ðÊó¥·¥¹¥Æ¥à(³ô) Joel Nava, Adobe Peter Sharpe, SoftQuad John Tigue, DataChannel hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/pr-xml-little-endian.xml0000644006511100651110000114336410504340462030274 0ustar rossrossÿþ<?xml version="1.0"?> <!DOCTYPE spec SYSTEM "spec.dtd" [ <!-- åe,gžŠ3Šn0_00n0ã‰gþ[aŒŸ[SOÿS0S0K0‰0 ÿ --> <!ENTITY TR-or-Rec "ÕNØiøf"> <!-- <!ENTITY TR-or-Rec "j–nÅ`1X(TR)"> --> <!ENTITY eTR-or-Rec "specification"> <!-- <!ENTITY eTR-or-Rec "technical report(TR)"> --> <!ENTITY application "¢0×0ê0±0ü0·0ç0ó0"> <!ENTITY error "¨0é0ü0"> <!ENTITY fatal-error "ô}T„v¨0é0ü0"> <!ENTITY parsed-data "ã‰gU0Œ0‹0Ç0ü0¿0"> <!ENTITY unparsed-data "ã‰gU0Œ0j0D0Ç0ü0¿0"> <!ENTITY parsed-entity "ã‰gþ[aŒŸ[SO"> <!ENTITY parser "Ñ0ü0µ0"> <!ENTITY unparsed-entity "ã‰gþ[aŒYŸ[SO"> <!ENTITY well-formed "teb__"> <!ENTITY valid "¥YS_"> <!ENTITY validity "¥YS_'`"> <!ENTITY escape "%RqbD0"> <!ENTITY prolog "øfM0"> <!ENTITY surrogate-blocks "µ0í0²0ü0È0Ö0í0Ã0¯0"> <!ENTITY letter "W["> <!ENTITY ideographic "q}T"oW["> <!ENTITY markup "Þ0ü0¯0ØNQ0"> <!ENTITY left-angle-bracket " NI{÷S(\j0Š0)"> <!ENTITY right-angle-bracket " NI{÷S('Yj0Š0)"> <!ENTITY string "‡eW[R"> <!ENTITY char-string "‡eW[R"><!-- string of chararacters, character strings, strings, characters o0Y0y0f0‡eW[Rh0Y0‹0 --> <!ENTITY replacement-text "nÛcÆ0­0¹0È0"> <!ENTITY single-quote "NÍ‘_(u&{"> <!ENTITY double-quote "ŒNÍ‘_(u&{"> <!ENTITY adaptations-annex "i(uD–^\øf"> <!ENTITY root "ë0ü0È0"> <!ENTITY base-character "úW•^‡eW["> <!ENTITY diacritical-mark "zvó—&{"><!--(À0¤0¢0¯0ê0Æ0£0«0ë0Þ0ü0¯0)’0RúQn0h0M0܈F0--> <!ENTITY composed-form "Tbb__"> <!ENTITY standalone "¹0¿0ó0É0¢0í0ó0"> <!ENTITY double-hyphen "ŒN#Ï0¤0Õ0ó0"> <!--<!ENTITY case-fold "'Y‡eW[K0\‡eW[x0n0q}N">--> <!-- <!ENTITY case-fold "Ôkn0h0M0 ÿ'Y‡eW[h0\‡eW[n0 TN–‰">--> <!ENTITY parameter "Ñ0é0á0¿0"> <!ENTITY stream "¹0È0ê0ü0à0"> <!ENTITY validating "¥YS_'`’0i<ŠY0‹0"> <!ENTITY non-validating "¥YS_'`’0i<ŠW0j0D0"> <!ENTITY user "æ0ü0¶0"> <!--<!ENTITY at-user-option "æ0ü0¶0L0ª0×0·0ç0ó0’0cš[W0_0h0M0">--> <!ENTITY at-user-option "æ0ü0¶0n0ª0×0·0ç0ó0cš[k0ˆ0c0f0o0"> <!ENTITY content-particle "…Q¹[ }P["> <!ENTITY processor "×0í0»0µ0"> <!ENTITY default "Ç0Õ0©0ë0È0"> <!ENTITY default-value "Ç0Õ0©0ë0È0$P"> <!ENTITY header "Ø0Ã0À0"> <!ENTITY target "¿0ü0²0Ã0È0"> <!ENTITY mixed-content "÷mT…Q¹["> <!ENTITY country-code "ýV³0ü0É0"> <!ENTITY language-code "ŠžŠ³0ü0É0"> <!ENTITY version "Hr"> <!-- version 1.0o0,{1.0Hr --> <!ENTITY match "Þ0Ã0Á0"> <!ENTITY character-value "‡eW[ju÷S"> <!ENTITY byte-order-mark "Ð0¤0È0˜Þ0ü0¯0"> <!ENTITY bypass "æQtW0j0D0"> <!ENTITY identifier "X‹%RP["> <!-- <!ENTITY identify "X‹%RY0‹0"> --> <!ENTITY identify "yrš[Y0‹0"> <!-- <!ENTITY identified "X‹%RU0Œ0‹0"> --> <!ENTITY identified "yrš[U0Œ0‹0"> <!ENTITY combining-character "P}T‡eW["> <!ENTITY subset "µ0Ö0»0Ã0È0"> <!ENTITY token "È0ü0¯0ó0"> <!ENTITY literal "ê0Æ0é0ë0"> <!ENTITY parenthesis "K0c0S0"> <!ENTITY left-parenthesis "‹•M0K0c0S0"> <!ENTITY right-parenthesis "‰•X0K0c0S0"> <!-- B0h0g0lL0d0D0_0‚0n0 JIS X0221’0‹‰‹0Å_‰B0Š0 --> <!ENTITY extender "¨0¯0¹0Æ0ó0À0"> <!ENTITY property "×0í0Ñ0Æ0£0"> <!ENTITY property-list "×0í0Ñ0Æ0£0ê0¹0È0"> <!ENTITY property-file "×0í0Ñ0Æ0£0Õ0¡0¤0ë0"> <!ENTITY font-decomposition "Õ0©0ó0È0Rã‰"> <!ENTITY compatibility-decomposition "’NÛc'`Rã‰"> <!ENTITY compatibility-area "’NÛc'`˜ßW"> <!ENTITY language-identification "ŠžŠX‹%R"> <!ENTITY space-character "¹0Ú0ü0¹0‡eW["> <!ENTITY space "¹0Ú0ü0¹0"> <!ENTITY code-value "³0ü0É0$P"> <!ENTITY normative "‰š[n0"> <!ENTITY hueristics "Ò0å0ü0ê0¹0Æ0£0Ã0¯0"> <!ENTITY informative ""> <!ENTITY WebSGML 'ISO 8879x0n0WebSGML&adaptations-annex;'> <!ENTITY XML.version "1.0"> <!ENTITY doc.date "1997t^12g8åe"> <!ENTITY iso6.doc.date "971208"> <!ENTITY w3c.doc.date "97t^12g3åe"> <!ENTITY draft.day '8åe'> <!ENTITY draft.month '12g'> <!ENTITY draft.year '1997t^'> <!-- åe,gžŠ3Šn0_00n0ã‰gþ[aŒŸ[SOÿS0S0~0g0 ÿ --> <!-- LAST TOUCHED BY: Tim Bray, 3 Dec 1997 --> <!-- The words 'FINAL EDIT' in comments mark places where changes need to be made after approval of the document by the ERB, before publication. --> <!ENTITY XML.version "1.0"> <!ENTITY doc.date "8 December 1997"> <!ENTITY iso6.doc.date "971208"> <!ENTITY w3c.doc.date "03-Dec-97"> <!ENTITY draft.day '8'> <!ENTITY draft.month 'December'> <!ENTITY draft.year '1997'> <!ENTITY WebSGML 'WebSGML Adaptations Annex to ISO 8879'> <!ENTITY newline " "> <!-- old: <!ENTITY newline "&#8232;"> --> <!ENTITY gt ">"> <!--<!ENTITY amp "&"> --> <!ENTITY xmlpio "'&lt;?xml'"> <!ENTITY pic "'?>'"> <!ENTITY br "\n"> <!ENTITY cellback '#c0d9c0'> <!ENTITY mdash "--"> <!-- was: <!ENTITY mdash "&#38;#151;"> --> <!ENTITY com "--"> <!ENTITY como "--"> <!ENTITY comc "--"> <!ENTITY hcro "&amp;#x"> <!-- <!ENTITY nbsp ""> --> <!ENTITY nbsp "&#160;"> <!ENTITY magicents "<code>amp</code>, <code>lt</code>, <code>gt</code>, <code>apos</code>, <code>quot</code>"> <!--åe,gžŠ3Šk0d0D0f0: ³0á0ó0È0o0û3Šþ[aŒK0‰0YW0~0W0_004’(gŒT+Y --> <!-- audience and distribution status: for use at publication time --> <!-- --> <!ENTITY doc.audience "lQ‹•ì0Ó0å0ü0ÊSs0p‹ÖŠ"> <!ENTITY doc.distribution "Æ0­0¹0È0ÊSs0Õl‹_ Nn0èla’09e YW0j0D0P–Š0 ÿ ê1uk0M‘^W0f0‚0ˆ0D0"> ]> <!-- for Panorama *--> <?VERBATIM "eg" ?> <spec> <header> <title>áb5_ïSý€j0&markup;ŠžŠ (XML)</title> <version>,{1.0&version;</version> <w3c-designation>PR-xml-&iso6.doc.date;</w3c-designation> <w3c-doctype>World Wide Web Consortium</w3c-doctype> <pubdate><day>&draft.day;</day><month>&draft.month;</month><year>&draft.year;</year></pubdate> <notice><p>S0n0IƒHho0 ÿXML WGÊSs0ÖNn0¢•ÂO€k0ˆ0‹0ì0Ó0å0ü0n0_00n0‚0n0g0B0c0f0 ÿlQ‹•n0p‹ÖŠn0_00n0‚0n0g0o0j0D00 <!-- FINAL EDIT: FIX --></p></notice> <publoc> <loc href="http://www.w3.org/TR/PR-xml-&iso6.doc.date;"> http://www.w3.org/TR/PR-xml-&iso6.doc.date;</loc></publoc> <prevlocs> <loc href='http://www.w3.org/TR/WD-xml-961114'> http://www.w3.org/TR/WD-xml-961114</loc> <loc href='http://www.w3.org/TR/WD-xml-lang-970331'> http://www.w3.org/TR/WD-xml-lang-970331</loc> <loc href='http://www.w3.org/TR/WD-xml-lang-970630'> http://www.w3.org/TR/WD-xml-lang-970630</loc> <loc href='http://www.w3.org/TR/WD-xml-970807'> http://www.w3.org/TR/WD-xml-970807</loc> <loc href='http://www.w3.org/TR/WD-xml-971117'> http://www.w3.org/TR/WD-xml-971117</loc> </prevlocs> <authlist> <author><name>Tim Bray</name> <affiliation>Textuality and Netscape</affiliation> <email href="mailto:tbray@textuality.com">tbray@textuality.com</email></author> <author><name>Jean Paoli</name> <affiliation>Microsoft</affiliation> <email href="mailto:jeanpa@microsoft.com">jeanpa@microsoft.com</email></author> <author><name>C. M. Sperberg-McQueen</name> <affiliation>University of Illinois at Chicago</affiliation> <email href="mailto:cmsmcq@uic.edu">cmsmcq@uic.edu</email></author> </authlist> <status> <p>S0n0&TR-or-Rec;o0, 1997t^12gk0World Wide Web ConsortiumK0‰0 lQhˆU0Œ0_0çRJTHhExtensible Markup Language version,{1.0Hr’0û3ŠW0, €b Sˆ„v…Q¹[’0 YôfY0‹0S0h0j0O0\ObW0_0&TR-or-Rec;g0B0‹00This &eTR-or-Rec; is a translation of the XML proposed recommendation 1.0 published by the World Wide Web Consortium in December 1997. It is intended that &eTR-or-Rec; is technically identical to the original.</p> <p>ŸS‡ek0B0‹00W„\O)jk0¢•W0f0n0Šð’0!kk0:yY00The original copyright notice is shown below:</p> <p>S0n0Hrn0XMLn0‰š[o0 ÿlQ‹•ì0Ó0å0ü0ÊSs0p‹ÖŠ’0 îv„vh0Y0‹00Æ0­0¹0È0ÊSs0Õl‹_ Nn0èla’09e YW0j0D0P–Š0 ÿê1uk0 M‘^W0f0‚0ˆ0D00This version of the XML specification is for public review and discussion. It may be distributed freely, as long as all text and legal notices remain intact.</p> <p>S0n0&TR-or-Rec;n0CQh0j0c0_0XMLçRJTHho0 ÿ1998t^2gk0World Wide Web ConsortiumK0‰0lQhˆU0Œ0_0XMLçRJTk0ˆ0c0f0Y0g0k0nM0Ûc H0‰0Œ0f0D0‹00S0n0j–nÅ`1Xo0 ÿXMLçRJTk0“_c0f0ŠckY0‹0S0h0’0 ˆNš[W0f0D0‹00The XML Proposed Recommendation is superseded by the XML Recommendation which was published by the World Wide Web Consortium in February 1998. It is intended that this &eTR-or-Rec; be revised accordingly in the near future.</p> <p>S0n0&TR-or-Rec;o0 ÿ‰[š[W0_0‚0n0g0B0c0f0 ÿ(ft^egn0<loc href='http://www.w3.org/XML'>XML;mÕR</loc>’0X0f0\ObU0Œ0_0 ÿN#n0\O miIƒHh’0CQh0Y0‹00þs(W ÿƒ^Ä{òVk0O(uU0Œ0f0D0‹0ýV›–„vj0Æ0­0¹0È0æQtn0j –n(j–nN,‚S&markup;ŠžŠ ÿStandard Generalized Markup Language, ISO 8879:1986k0ý RÊSs0Šck’0 RH0_0‚0n0)n0 ÿWWW Ng0n0O(un0_00k0&subset; SW0_0ŠžŠ’0 ÿS0n0&TR-or-Rec;o0 ÿ‰š[Y0‹00ISO 8879n0i0n0_jý€’0S0n0 &subset;k0‹kY0K0 ÿh0D0F0zlš[k0d0D0f0n0sŠ0}o0 ÿ<loc href='http://www.w3.org/XML/#WG-decisions'>%R(uaY0‹0</loc>0XMLo0 ÿ âek0D0O0d0K0n0FUÁTg0µ0Ý0ü0È0U0Œ0 ÿXML’0µ0Ý0ü0È0Y0‹0<loc href='http://www.w3.org/XML/#software'>Õ0ê0ü0¦0§0¢0</loc>n0pe‚0—XH0f0 D0‹00XMLk0¢•Y0‹0lQ‹•n0ÖŠp‹‚0 ÿª0ó0é0¤0ó0g0<loc href='http://www.w3.org/XML/#discussion'>eQKbg0M0‹0</loc>0It is a stable document derived from a series of working drafts produced over the last year as deliverables of the <loc href='http://www.w3.org/XML'>XML activity</loc>. It specifies a language created by subsetting an existing, widely used international text processing standard (Standard Generalized Markup Language, ISO 8879:1986 as amended and corrected) for use on the World Wide Web. Details of the decisions regarding which features of ISO 8879 to retain in the subset <loc href='http://www.w3.org/XML/#WG-decisions'>are available separately</loc>. XML is already supported by some commercial products, and there are a growing number of <loc href='http://www.w3.org/XML/#software'>free implementations</loc>. Public discussions of XML <loc href='http://www.w3.org/XML/#discussion'>are accessible online</loc>.</p> <p>S0n0&TR-or-Rec;g0o0 ÿ<bibref ref="Berners-Lee"/>k0š[©Y0‹0 URI(Uniform Resource Identifier)’0O(uY0‹00URIn06Rš[\Omio02Lˆ-Ng0B0c0 f0 ÿ<bibref ref="RFC1738"/>ÊSs0<bibref ref="RFC1808"/>’0ôf°eY0‹0ˆNš[h0 j0c0f0D0‹00S0n0\OmiL0RFCh0W0f0×SQ0eQŒ0‰0Œ0j0D04XTo0 ÿS0n0‰ z…Qn0URI x0n0ÂSgqo0 ÿURL(Uniform Resource Locator)x0n0ÂSgqk0ãN0‹00This specification uses the term URI, which is defined by <bibref ref="Berners-Lee"/>, a work in progress expected to update <bibref ref="RFC1738"/> and <bibref ref="RFC1808"/>. Should the work not be accepted as an RFC, the references to uniform resource identifiers (URIs) in this specification will become references to uniform resource locators (URLs).</p> <p>XMLn0ÕNØik0–nàbW0f0D0‹0K0i0F0K0n0úW–nh0j0‹0o0W3Cn0µ0¤0È0k0B0 ‹0ŸS‡eg0B0‹00The normative version of the specification is the English version found at the W3C site.</p> <p>S0n0j–nÅ`1Xo0ŸSÕNØih0€bSˆ„vk0 TNg0B0‹0S0h0’0aóVW0f0D0‹0L00 û3Š Nn0¤ŠŠ0o0B0Š0—_‹00Although this technical report is intended to be technically identical to the original, it may contain errors from the translation.</p> <p>™P€: ŸS‰š[h0n0‰š[‡{@bn0þ[Ü_¢•ÂO’0f‰0K0k0Y0‹0_000S0n0 &TR-or-Rec;n0À{ËibÊSs0À{ju÷So00ŸS‰š[n0]0Œ0‰0’0g0M0‹0`0Q0ÝOX[W0f0D0 ‹00S0n0&TR-or-Rec;n0WebHro00ŸS‰š[n0HTML¿0°0’0]0n0~0~0ÝOX[W0f0D0‹00 </p> </status> <!-- out of date <statusp>This is a W3C Working Draft for review by W3C members and other interested parties. It is a draft document and may be updated, replaced, or obsoleted by other documents at any time. It is inappropriate to use W3C Working Drafts as reference material or to cite them as other than "work in progress". A list of current W3C working drafts can be found at <loc href="http://www.w3.org/TR">http://www.w3.org/TR</loc>.</statusp> <statusp><emph>Note:</emph> Since working drafts are subject to frequent change, you are advised to reference the above URL, rather than the URLs for working drafts themselves.</statusp> <statusp>This work is part of the W3C SGML Activity (for current status, see <loc href="http://www.w3.org/MarkUp/SGML/Activity" >http://www.w3.org/MarkUp/SGML/Activity</loc>).</statusp> <p>The current draft of this specification presupposes the successful completion of the current work on the &WebSGML;, being prepared by ISO/IEC JTC1 at the time this draft specification was drafted. If it is not adopted in the expected form, some clauses of this specification may change, and some recommendations now labeled "<termref def="dt-interop">for interoperability</termref>" will become requirements labeled "<termref def="dt-compat">for compatibility</termref>". </p> <p>The current draft of this specification uses the term URI, which is defined by <bibref ref="Berners-Lee"/>, which is work in progress expected to update <bibref ref="RFC1738"/> and <bibref ref="RFC1808"/>. Should the work in this draft not be accepted as an RFC, the references to uniform resource identifiers (URIs) in this specification will become references to uniform resource locators (URLs).</p> </status> --> <abstract> <p>áb5_ïSý€j0&markup;ŠžŠ(XML)o0SGMLn0!|XSj0¹eŠg0B0c0f0 ÿS0n0&TR-or-Rec;g0 ÿ]0n0Y0y0f0’0‰š[Y0‹00XMLn0îvjo0 ÿþs(Wn0HTMLh0 TØik0 ÿN,‚'`n0B0‹0SGML’0¦0§0Ö0 Ng0M‘^ ÿ×SáOÊSs0æQtg0M0‹0S0h0h0Y0‹00XMLo0Ÿ[ňL0¹[fg0B0c0f0 ÿSGMLÊSs0HTMLn0i0a0‰0k0þ[W0f0‚0øv’NK(u'`’0ÝOd0-ŠŠL0j0U0Œ0f0D0‹00</p> </abstract> <pubstmt> <p>Chicago, Vancouver, Mountain View, et al.: World-Wide Web Consortium, XML\Omi°0ë0ü0×0, 1996, 1997.</p> </pubstmt> <sourcedesc> <p>Created in electronic form.</p> </sourcedesc> <langusage> <language id='EN'>English</language> <language id='ebnf'>Extended Backus-Naur Form (formal grammar)</language> </langusage> <revisiondesc> <slist> <sitem>1997-12-03 : CMSMcQ : yet further changes</sitem> <sitem>1997-12-02 : TB : further changes (see TB to XML WG, 2 December 1997)</sitem> <sitem>1997-12-02 : CMSMcQ : deal with as many corrections and comments from the proofreaders as possible: entify hard-coded document date in pubdate element, change expansion of entity WebSGML, update status description as per Dan Connolly (am not sure about refernece to Berners-Lee et al.), add 'The' to abstract as per WG decision, move Relationship to Existing Standards to back matter and combine with References, re-order back matter so normative appendices come first, re-tag back matter so informative appendices are tagged informdiv1, remove XXX XXX from list of 'normative' specs in prose, move some references from Other References to Normative References, add RFC 1738, 1808, and 2141 to Other References (they are not normative since we do not require the processor to enforce any rules based on them), add reference to 'Fielding draft' (Berners-Lee et al.), move notation section to end of body, drop URIchar non-terminal and use SkipLit instead, lose stray reference to defunct nonterminal 'markupdecls', move reference to Aho et al. into appendix (Tim's right), add prose note saying that hash marks and fragment identifiers are NOT part of the URI formally speaking, and are NOT legal in system identifiers (processor 'may' signal an error). Work through: Tim Bray reacting to James Clark, Tim Bray on his own, Eve Maler, NOT DONE YET: change binary / text to unparsed / parsed. handle James's suggestion about &lt; in attriubte values uppercase hex characters, namechar list, </sitem> <sitem>1997-12-01 : JB : add some column-width parameters</sitem> <sitem>1997-12-01 : CMSMcQ : begin round of changes to incorporate recent WG decisions and other corrections: binding sources of character encoding info (27 Aug / 3 Sept), correct wording of Faust quotation (restore dropped line), drop SDD from EncodingDecl, change text at version number 1.0, drop misleading (wrong!) sentence about ignorables and extenders, modify definition of PCData to make bar on msc grammatical, change grammar's handling of internal subset (drop non-terminal markupdecls), change definition of includeSect to allow conditional sections, add integral-declaration constraint on internal subset, drop misleading / dangerous sentence about relationship of entities with system storage objects, change table body tag to htbody as per EM change to DTD, add rule about space normalization in public identifiers, add description of how to generate our name-space rules from Unicode character database (needs further work!). </sitem> <sitem>1997-10-08 : TB : Removed %-constructs again, new rules for PE appearance.</sitem> <sitem>1997-10-01 : TB : Case-sensitive markup; cleaned up element-type defs, lotsa little edits for style</sitem> <sitem>1997-09-25 : TB : Change to elm's new DTD, with substantial detail cleanup as a side-effect</sitem> <sitem>1997-07-24 : CMSMcQ : correct error (lost *) in definition of ignoreSectContents (thanks to Makoto Murata)</sitem> <sitem>Allow all empty elements to have end-tags, consistent with SGML TC (as per JJC).</sitem> <sitem>1997-07-23 : CMSMcQ : pre-emptive strike on pending corrections: introduce the term 'empty-element tag', note that all empty elements may use it, and elements declared EMPTY must use it. Add WFC requiring encoding decl to come first in an entity. Redefine notations to point to PIs as well as binary entities. Change autodetection table by removing bytes 3 and 4 from examples with Byte Order Mark. Add content model as a term and clarify that it applies to both mixed and element content. </sitem> <sitem>1997-06-30 : CMSMcQ : change date, some cosmetic changes, changes to productions for choice, seq, Mixed, NotationType, Enumeration. Follow James Clark's suggestion and prohibit conditional sections in internal subset. TO DO: simplify production for ignored sections as a result, since we don't need to worry about parsers which don't expand PErefs finding a conditional section.</sitem> <sitem>1997-06-29 : TB : various edits</sitem> <sitem>1997-06-29 : CMSMcQ : further changes: Suppress old FINAL EDIT comments and some dead material. Revise occurrences of % in grammar to exploit Henry Thompson's pun, especially markupdecl and attdef. Remove RMD requirement relating to element content (?). </sitem> <sitem>1997-06-28 : CMSMcQ : Various changes for 1 July draft: Add text for draconian error handling (introduce the term Fatal Error). RE deleta est (changing wording from original announcement to restrict the requirement to validating parsers). Tag definition of validating processor and link to it. Add colon as name character. Change def of %operator. Change standard definitions of lt, gt, amp. Strip leading zeros from #x00nn forms.</sitem> <sitem>1997-04-02 : CMSMcQ : final corrections of editorial errors found in last night's proofreading. Reverse course once more on well-formed: Webster's Second hyphenates it, and that's enough for me.</sitem> <sitem>1997-04-01 : CMSMcQ : corrections from JJC, EM, HT, and self</sitem> <sitem>1997-03-31 : Tim Bray : many changes</sitem> <sitem>1997-03-29 : CMSMcQ : some Henry Thompson (on entity handling), some Charles Goldfarb, some ERB decisions (PE handling in miscellaneous declarations. Changed Ident element to accept def attribute. Allow normalization of Unicode characters. move def of systemliteral into section on literals.</sitem> <sitem>1997-03-28 : CMSMcQ : make as many corrections as possible, from Terry Allen, Norbert Mikula, James Clark, Jon Bosak, Henry Thompson, Paul Grosso, and self. Among other things: give in on "well formed" (Terry is right), tentatively rename QuotedCData as AttValue and Literal as EntityValue to be more informative, since attribute values are the <emph>only</emph> place QuotedCData was used, and vice versa for entity text and Literal. (I'd call it Entity Text, but 8879 uses that name for both internal and external entities.)</sitem> <sitem>1997-03-26 : CMSMcQ : resynch the two forks of this draft, reapply my changes dated 03-20 and 03-21. Normalize old 'may not' to 'must not' except in the one case where it meant 'may or may not'.</sitem> <sitem>1997-03-21 : TB : massive changes on plane flight from Chicago to Vancouver</sitem> <sitem>1997-03-21 : CMSMcQ : correct as many reported errors as possible. </sitem> <sitem>1997-03-20 : CMSMcQ : correct typos listed in CMSMcQ hand copy of spec.</sitem> <sitem>1997-03-20 : CMSMcQ : cosmetic changes preparatory to revision for WWW conference April 1997: restore some of the internal entity references (e.g. to docdate, etc.), change character xA0 to &amp;nbsp; and define nbsp as &amp;#160;, and refill a lot of paragraphs for legibility.</sitem> <sitem>1996-11-12 : CMSMcQ : revise using Tim's edits: Add list type of NUMBERED and change most lists either to BULLETS or to NUMBERED. Suppress QuotedNames, Names (not used). Correct trivial-grammar doc type decl. Rename 'marked section' as 'CDATA section' passim. Also edits from James Clark: Define the set of characters from which [^abc] subtracts. Charref should use just [0-9] not Digit. Location info needs cleaner treatment: remove? (ERB question). One example of a PI has wrong pic. Clarify discussion of encoding names. Encoding failure should lead to unspecified results; don't prescribe error recovery. Don't require exposure of entity boundaries. Ignore white space in element content. Reserve entity names of the form u-NNNN. Clarify relative URLs. And some of my own: Correct productions for content model: model cannot consist of a name, so "elements ::= cp" is no good. </sitem> <sitem>1996-11-11 : CMSMcQ : revise for style. Add new rhs to entity declaration, for parameter entities.</sitem> <sitem>1996-11-10 : CMSMcQ : revise for style. Fix / complete section on names, characters. Add sections on parameter entities, conditional sections. Still to do: Add compatibility note on deterministic content models. Finish stylistic revision.</sitem> <sitem>1996-10-31 : TB : Add Entity Handling section</sitem> <sitem>1996-10-30 : TB : Clean up term &amp; termdef. Slip in ERB decision re EMPTY.</sitem> <sitem>1996-10-28 : TB : Change DTD. Implement some of Michael's suggestions. Change comments back to //. Introduce language for XML namespace reservation. Add section on white-space handling. Lots more cleanup.</sitem> <sitem>1996-10-24 : CMSMcQ : quick tweaks, implement some ERB decisions. Characters are not integers. Comments are /* */ not //. Add bibliographic refs to 10646, HyTime, Unicode. Rename old Cdata as MsData since it's <emph>only</emph> seen in marked sections. Call them attribute-value pairs not name-value pairs, except once. Internal subset is optional, needs '?'. Implied attributes should be signaled to the app, not have values supplied by processor.</sitem> <sitem>1996-10-16 : TB : track down &amp; excise all DSD references; introduce some EBNF for entity declarations.</sitem> <sitem>1996-10-?? : TB : consistency check, fix up scraps so they all parse, get formatter working, correct a few productions.</sitem> <sitem>1996-10-10/11 : CMSMcQ : various maintenance, stylistic, and organizational changes: Replace a few literals with xmlpio and pic entities, to make them consistent and ensure we can change pic reliably when the ERB votes. Drop paragraph on recognizers from notation section. Add match, exact match to terminology. Move old 2.2 XML Processors and Apps into intro. Mention comments, PIs, and marked sections in discussion of delimiter escaping. Streamline discussion of doctype decl syntax. Drop old section of 'PI syntax' for doctype decl, and add section on partial-DTD summary PIs to end of Logical Structures section. Revise DSD syntax section to use Tim's subset-in-a-PI mechanism.</sitem> <sitem>1996-10-10 : TB : eliminate name recognizers (and more?)</sitem> <sitem>1996-10-09 : CMSMcQ : revise for style, consistency through 2.3 (Characters)</sitem> <sitem>1996-10-09 : CMSMcQ : re-unite everything for convenience, at least temporarily, and revise quickly</sitem> <sitem>1996-10-08 : TB : first major homogenization pass</sitem> <sitem>1996-10-08 : TB : turn "current" attribute on div type into CDATA</sitem> <sitem>1996-10-02 : TB : remould into skeleton + entities</sitem> <sitem>1996-09-30 : CMSMcQ : add a few more sections prior to exchange with Tim.</sitem> <sitem>1996-09-20 : CMSMcQ : finish transcribing notes.</sitem> <sitem>1996-09-19 : CMSMcQ : begin transcribing notes for draft.</sitem> <sitem>1996-09-13 : CMSMcQ : made outline from notes of 09-06, do some housekeeping</sitem> </slist> </revisiondesc> </header> <body> <div1 id='sec-intro'> <head>N,‚‹N˜</head> <!-- <div2 id='sec-scope'> <head>i(uÄ{òV</head> --> <p>áb5_ïSý€j0&markup;ŠžŠXML(eXtensible Markup Language)o0 ÿ<termref def="dt-xml-doc">XML‡eøf</termref>h0D0F0Ç0ü0¿0ª0Ö0¸0§0¯0È0n0¯0é0¹0’0‰š[W0 ÿXML‡eøf’0æQtY0‹0×0í0°0é0à0n0ÕR\On0Nè’0‰š[Y0‹00XMLo0 ÿSGML(j–nN,‚S&markup;ŠžŠ ÿStandard Generalized Markup Language)<bibref ref='ISO8879'/>n06RP–W0_0&subset;h0Y0‹00Ëi N ÿXML‡eøfo0 ÿK0j0‰0Z0SGML‰ <p>XML‡eøfo0 ÿ<termref def="dt-entity">Ÿ[SO</termref>h0D0F0Š¶aXSMOK0‰0j0Š0 ÿŸ[SOo0 ÿ&parsed-data;ÈSo0&unparsed-data;K0‰0j0‹00&parsed-data;o0 ÿ<termref def="dt-character">‡eW[</termref>K0‰0j0Š0 ÿ]0n0Nèo0 ÿ‡eøfn0<termref def="dt-chardata">‡eW[Ç0ü0¿0</termref>’0ËibW0 ÿNèo0 ÿ<termref def="dt-markup">&markup;</termref>’0ËibY0‹00&markup;o0 ÿ‡eøfn0Š¶aì0¤0¢0¦0È0ÊSs0ÖŠtËi k0d0D0f0n0Šð’0hˆY0&{÷Sh0Y0‹00XMLo0 ÿŠ¶aì0¤0¢0¦0È0ÊSs0ÖŠtËi k0d0D0f0n06R}agöN’0ŠðY0‹0_jËi’0Ðc›OY0‹00</p> <p><termdef id="dt-xml-proc" term="XML&processor;"><term>XML&processor;</term>h0D0F0½0Õ0È0¦0§0¢0â0¸0å0ü0ë0o0 ÿXML‡eøf’0­Š0¼0 ÿ]0n0…Q¹[ÊSs0Ëi x0n0¢0¯0»0¹0’0Ðc›OY0‹0_00k0(uD0‹00 </termdef> <termdef id="dt-app" term="&application;">XML&processor;o0 ÿÖNn0â0¸0å0ü0ë0n0_00k0ÕR\OY0‹0S0h0’0MRÐch0W0 ÿ]0n0â0¸0å0ü0ë0’0<term>&application;</term>h0D0F00</termdef>S0n0&TR-or-Rec;o0 ÿXML&processor;L0Lˆ0j0Q0Œ0p0j0‰0j0D0/c‚D0’0‰š[Y0‹00d0~0Š0 ÿXMLÇ0ü0¿0n0­Š¼0¹eÕl’0‰š[W0 ÿ&application;k0Ðc›OY0‹0Å`1X’0‰š[Y0‹00</p> <!-- </div2> --> <div2 id='sec-origin-goals'> <head>L}ï}ÊSs0îvj</head> <p>1996t^k0World Wide Web Consortium(W3C)n0-Nk0-ŠËzW0_0XML\Omi°0ë0ü0×0(åNMRo0 ÿ SGMLè}Æ–ì0Ó0å0ü0ÔYáTOh0|Tp0Œ0_0)L0 ÿXML’0‹•zvW0_00S0n0\Omi°0ë0ü0×0n0p‹w•’0 ÿSun Microsystemsn0Jon BosakL0äR0‹00W3CL0D}T~W0 ÿåNMRo0SGML\Omi°0ë0ü0×0h0|Tp0Œ0_0XML SIG(Special Interest Group)‚0 ÿXMLn06Rš[k0^—8^k0;mzvk0ÂS;uW0_00 <!--JISg0o0? XML\Omi°0ë0ü0×0n0á0ó0Ð0’0ØN2“k0:yY00-->Dan Connollyo0 ÿ\Omi°0ë0ü0×0n0W3Ck0J0Q0‹0#a}ÂO’0ÙR0_00</p> <p>XMLn0-ŠŠîvj’0 ÿ!kk0:yY00<ulist> <item><p>a) XMLo0 ÿInternet Ng0]0n0~0~0O(ug0M0‹00</p></item> <item><p>b) XMLo0 ÿƒ^Ä{òVn0&application;’0/eôcY0‹00</p></item> <item><p>c) XMLo0 ÿSGMLh0’NÛc'`’0‚0d00</p></item> <item><p>d) XML‡eøf’0æQtY0‹0×0í0°0é0à0’0øfO0S0h0o0 ÿ¹[fg0j0Q0Œ0p0j0‰0j0D00</p></item> <item><p>e) XMLg0o0 ÿª0×0·0ç0ó0n0_jý€o0g0M0‹0`0Q0\j0O0W0 ÿNd0‚0X[(WW0j0D0S0h0’0îvcY00</p></item> <item><p>f) XML‡eøfo0 ÿºN“•k0h0c0f0­Š0„0Y0O0 ÿASRk0tã‰W0„0Y0D00</p></item> <item><p>g) XMLn0-ŠŠo0 ÿY00„0K0k0LˆH0j0Q0Œ0p0j0‰0j0D00</p></item> <item><p>h) XMLn0-ŠŠo0 ÿ³SÆ[ÊSs0!|Tog0j0Q0Œ0p0j0‰0j0D00</p></item> <item><p>i) XML‡eøfo0 ÿ¹[fk0\Obg0M0‹00</p></item> <item><p>j) XMLg0o0 ÿ&markup;n0pe’0n‰0Y0S0h0o0 ÿÍ‘‰g0o0j0D00</p></item></ulist> </p> <p>XML,{&XML.version;&version;’0tã‰W0 ÿ]0Œ0’0æQtY0‹0Š—{_j×0í0°0é0à0’0øfO0_00k0ASRj0Å`1Xo0 ÿS0n0&TR-or-Rec;ÊSs0¢•#Y0‹0‰&language-identification;¿0°0(uh0W0f0 ÿ¤0ó0¿0Í0Ã0È0 RFC 1766 ÿ&language-code;(uh0W0f0 ÿISO 639 ÿ&Ns0k0&country-code;(uh0W0f0 ÿISO 3166)g0 ÿY0y0f0:yY00</p> <p>S0n0&version;n0XMLn0‰š[<!-- (&doc.date;) -->o0 ÿlQ‹•ì0Ó0å0ü0ÊSs0p‹ÖŠ’0îv„vh0Y0‹00Æ0­0¹0È0ÊSs0Õl‹_ Nn0èla’09e YW0j0D0P–Š0 ÿê1uk0M‘^W0f0‚0ˆ0D00</p> </div2> <div2 id='sec-terminology'> <head>š[©</head> <p>XML‡eøfn0‰š[n0_00k0O(uY0‹0(užŠo0 ÿS0n0&TR-or-Rec;…Qg0š[©Y0‹00!kk0:yY0žŠåSo0 ÿ]0Œ0‰0n0(užŠ’0š[©Y0‹0_00 ÿÊSs0XML&processor;n0ÕRM0’0‰š[Y0‹0_00k0O(uY0‹00 <glist> <gitem> <label>1.2.1 W0f0‚0ˆ0D0(may)</label> <def><p><termdef id="dt-may" term="W0f0‚0ˆ0D0">iTY0‹0‡eøfÈSo0XML&processor;o0 ÿŠðU0Œ0_0h0J0Š0k0ÕR\OW0f0‚0ˆ0D0L0 ÿ]0n0h0J0Š0k0Y0‹0Å_‰o0j0D00</termdef></p></def> </gitem> <gitem> <label>1.2.2 W0j0Q0Œ0p0j0‰0j0D0(must)</label> <def><p>iTY0‹0‡eøfÈSo0XML&processor;o0 ÿŠðU0Œ0_0h0J0Š0k0ÕR\OY0‹0S0h0L0‰BlU0Œ0‹00]0F0g0j0Q0Œ0p0 ÿ&error;h0Y0‹00<!-- do NOT change this! this is what defines a violation ofa 'must' clause as 'an error'. -MSM --> </p></def> </gitem> <gitem> <label>1.2.3 &error;(error)</label> <def><p><termdef id="dt-error" term="&error;">S0n0&TR-or-Rec;L0š[0‹0‰GRk0þ[Y0‹0UÍS0P}œgo0š[©W0j0D00iTY0‹0½0Õ0È0¦0§0¢0o0 ÿ&error;’0iúQW0f01XJTW0f0‚0ˆ0O0 ÿ&error;K0‰0ÞV©_W0f0‚0ˆ0D00</termdef></p></def> </gitem> <gitem> <label>1.2.4 &fatal-error;(fatal error)</label> <def><p><termdef id="dt-fatal" term="&fatal-error;">iTY0‹0<termref def="dt-xml-proc">XML&processor;</termref>L0iúQW0j0Q0Œ0p0j0‰0Z0 ÿ&application;k01XJTW0j0Q0Œ0p0j0‰0j0D0&error;0&fatal-error;’0zv‹‰W0_0B0h0 ÿ&processor;o0 ÿ]0Œ0åNM–n0&error;’0¢cY0_00k0Ç0ü0¿0æQt’0š}LˆW0f0‚0ˆ0O0 ÿ&error;’0zv‹‰W0_04XTo0 ÿ]0n0&error;’0&application;k01XJTW0f0‚0ˆ0D00&error;Šck’0µ0Ý0ü0È0Y0‹0_00k0 ÿ&processor;o0 ÿ*gæQtÇ0ü0¿0(‡eW[Ç0ü0¿0ÊSs0&markup;n0÷m(WW0_0‚0n0)’0‡eøfK0‰0ÖSŠ0úQW0 ÿ&application;k0!nW0f0‚0ˆ0D00W0K0W0 ÿN¦^ ÿ&fatal-error;’0iúQW0_0‰0 ÿ&processor;o0 ÿ8^n0æQt’0š}LˆW0f0o0j0‰0j0D00d0~0Š0 ÿ&processor;o0 ÿ‡eW[Ç0ü0¿0ÊSs0‡eøfn0ÖŠtËi k0d0D0f0n0Å`1X’0 ÿ8^n0¹eÕlg0&application;k0!nW0š}Q0f0o0j0‰0j0D00</termdef></p></def> </gitem> <gitem> <label>1.2.5 &at-user-option;(at user option)</label> <def><p>iTY0‹0½0Õ0È0¦0¨0¢0o0 ÿŠðU0Œ0_0h0J0Š0k0/c‹0‚c0f0‚0ˆ0D0(may) ÿÈSo0/c‹0‚0j0O0f0o0j0‰0j0D0(must)(‡eàz-Nn0©RÕR^Šk0ˆ0‹00)0]0n0h0J0Š0k0/c‹0‚F04XTo0 ÿŠðU0Œ0_0/c‚D0’0xžbÈSo0Òb&TY0‹0Kbµk’0&user;k0Ðc›OW0j0Q0Œ0p0j0‰0j0D00</p></def> </gitem> <gitem> <label>1.2.6 &validity;6R}(validity constraint)</label> <def><p>Y0y0f0n0<termref def="dt-valid">&valid;j0</termref>XML‡eøfk0i(uY0‹0‰GR0&validity;6R}n0UÍSo0 ÿ&error;h0Y0‹00&at-user-option; ÿ<termref def="dt-validating">i<Š’0LˆF0XML&processor;</termref>o0 ÿS0n0&error;’01XJTW0j0Q0Œ0p0j0‰0j0D00</p></def> </gitem> <gitem> <label>1.2.7 &well-formed;6R}(well-formedness constraint)</label> <def><p>Y0y0f0n0<termref def="dt-wellformed">&well-formed;</termref>n0XML‡eøfk0i(uY0‹0‰GR0&well-formed;6R}n0UÍSo0 ÿ<termref def="dt-fatal">&fatal-error;</termref>h0Y0‹00</p></def> </gitem> <gitem> <label>1.2.8 &match;(match)</label> <def><p>a) <termdef id="dt-match" term="&match;">&string;ÈSo0 TMRn0&match;0ÔkY0‹0ŒNd0n0&string;ÈSo0 TMRo0 ÿ TNg0j0Q0Œ0p0j0‰0j0D00ISO/IEC 10646k0J0D0f0 ÿ‰pen0hˆþsL0ïSý€j0‡eW[;ÿ‹OH0p0 ÿ&composed-form;ÊSs0úW•^+&diacritical-mark;(À0¤0¢0¯0ê0Æ0£0«0ë0Þ0ü0¯0)b__=ÿo0 ÿi0a0‰0n0&string;‚0 TX0hˆþsn0h0M0k0P–Š0 ÿ&match;Y0‹00&at-user-option; ÿ&processor;o0 ÿ]0n0‡eW[’0j–nb_k0ck‰SW0f0‚0ˆ0D00Ôkn0h0M00'Y‡eW[h0\‡eW[h0n0:S%R’0Y0‹00<!-- Note that no processing of characters with respect to case is part of the matching process. -->&lt;BR>b) &string;h0‡eÕl-Nn0‰GRh0n0&match;0B0‹0ub‰GRK0‰0ubY0‹0ŠžŠk0 ÿB0‹0&string;L0^\Y0‹0h0M0 ÿS0n0&string;o0 ÿS0n0ub‰GRk0&match;Y0‹0h0D0F00&lt;BR>c) …Q¹[h0…Q¹[â0Ç0ë0h0n0&match;0B0‹0‰ }L0 ÿ<titleref href='elementvalid'>‰ }n0&validity;</titleref>n06R}k0:yY0asTg0iTY0‹0h0M0 ÿS0n0‰ }o0 ÿ]0n0£[Šk0&match;Y0‹0h0D0F00</termdef></p></def> </gitem> <gitem> <label>1.2.9 ’NÛc'`n0_00(for compatibility)</label> <def><p><termdef id="dt-compat" term="’NÛc'`n0_00">XMLn0_jý€g0B0c0f0 ÿXMLL0SGMLh0’NÛcg0B0‹0S0h0’0ÝO<ŠY0‹0_00`0Q0k0\eQU0Œ0‹0‚0n00</termdef></p></def> </gitem> <gitem> <label>1.2.10 øv’NK(u'`n0_00(for interoperability)</label> <def><p><termdef id="dt-interop" term="øv’NK(u'`n0_00">Øb_g›Ro0‚0_0j0D0¨chY‹N˜0&WebSGML;åNMRK0‰0X[(WY0‹0SGML&processor;L0 ÿXML‡eøf’0æQtg0M0‹0ïSý€'`’0Øš0‹0_00k0ÖSŠ0eQŒ0‹0‚0n00</termdef></p></def> </gitem> </glist> </p> </div2> </div1> <!-- &Docs; --> <div1 id='sec-documents'> <head>‡eøf</head> <p><termdef id="dt-xml-doc" term="XML‡eøf"> <!-- A textual object --> S0n0&TR-or-Rec;g0š[©Y0‹0asTg0 ÿ<termref def="dt-wellformed">&well-formed;</termref>h0Y0‹0Ç0ü0¿0ª0Ö0¸0§0¯0È0’0 ÿ<term>XML‡eøf</term>h0D0F00&well-formed;n0XML‡eøfL0 ÿU0‰0k0 ÿB0‹06R}agöN’0€n³Y0Œ0p0 ÿ<termref def="dt-valid">&valid;</termref>j0XML‡eøfh0Y0‹00 </termdef></p> <!-- why this div? -TB <div2 id='sec-log-phys'> <head>Logical and Physical Structure</head> --> <p>D0Z0Œ0n0XML‡eøf‚0 ÿÖŠtËi ÊSs0irtËi ’0‚0d00irt„vk0o0 ÿ‡eøfo0 ÿ<termref def="dt-entity">Ÿ[SO</termref>h0|Tv0XSMOK0‰0j0‹00B0‹0Ÿ[SOo0 ÿ‡eøf…Qk0ÖNn0Ÿ[SO’0+T€0_00k0 ÿ]0n0ÖNn0Ÿ[SO’0<termref def="dt-entref">ÂSgq</termref>W0f0‚0ˆ0D00‡eøfo0 ÿ ë0ü0È0 Y0j00a0<termref def="dt-docent">‡eøfŸ[SO</termref>K0‰0ËY~0‹00ÖŠt„vk0o0 ÿ‡eøfo0 ÿ£[Š ÿ‰ } ÿ³0á0ó0È0 ÿ‡eW[ÂSgqÊSs0æQt}TäN’0+T0 ÿS0Œ0‰0Y0y0f0o0 ÿ‡eøf…Qg0f:y„vj0&markup;k0ˆ0c0f0:yY00ÖŠtËi ÊSs0irtËi o0 ÿ<titleref href="wf-entities">åNM–</titleref>k0:yY0h0J0Š0k0 ÿ³SÆ[k0eQŒ0P[k0j0c0f0D0j0Q0Œ0p0j0‰0j0D00</p> <!-- </div2> --> <div2 id='sec-well-formed'> <head>&well-formed;n0XML‡eøf</head> <p><termdef id="dt-wellformed" term="&well-formed;">B0‹0Æ0­0¹0È0ª0Ö0¸0§0¯0È0L0 ÿ!kn0D0Z0Œ0K0n0h0M0 ÿ]0n0Æ0­0¹0È0ª0Ö0¸0§0¯0È0’0&well-formed;n0XML‡eøfh0|Tv00</termdef> <ulist> <item><p>a) hQSOh0W0f0 ÿ<nt def='NT-document'>document</nt>h0D0F0é0Ù0ë0’0‚0d0ub‰GRk0&match;Y0‹00</p></item> <item><p>b) S0n0&TR-or-Rec;g0š[©Y0‹0 ÿY0y0f0n0&well-formed;6R}k0“_F00</p> </item> <item><p>c) ]0Œ0^0Œ0n0<termref def='dt-parsedent'>&parsed-entity;</termref>L0 ÿ<titleref href='wf-entities'>&well-formed;</titleref>h0j0‹00</p></item> </ulist></p> <p> <scrap lang='ebnf' id='document'> <head>‡eøf</head> <prod id='NT-document'><lhs>document</lhs> <rhs><nt def='NT-prolog'>prolog</nt> <nt def='NT-element'>element</nt> <nt def='NT-Misc'>Misc</nt>*</rhs></prod> </scrap> </p> <p><nt def="NT-document">document</nt>ub‰GRk0&match;Y0‹0h0o0 ÿ!k’0asTY0‹00 <ulist> <item><p>a) Nd0åN Nn0<termref def="dt-element">‰ }</termref>’0+T€00</p> </item> <!--* N.B. some readers (notably JC) find the following paragraph awkward and redundant. I agree it's logically redundant: it *says* it is summarizing the logical implications of matching the grammar, and that means by definition it's logically redundant. I don't think it's rhetorically redundant or unnecessary, though, so I'm keeping it. It could however use some recasting when the editors are feeling stronger. -MSM *--> <item><p>b) <termdef id="dt-root" term="ë0ü0È0‰ }"><term>ë0ü0È0</term>ÈSo0‡eøf‰ }h0D0F0‰ }L0Nd0`0Q0X[(WW0 ÿS0Œ0o0 ÿÖNn0‰ }n0<termref def="dt-content">…Q¹[</termref>k0+T~0Œ0j0D00</termdef>S0Œ0åNYn0Y0y0f0n0‰ }o0 ÿ]0n0‹•ËY¿0°0L0ÖNn0‰ }n0…Q¹[k0+T~0Œ0Œ0p0 ÿþ[Ü_Y0‹0B}†N¿0°0‚0 TX0‰ }n0…Q¹[k0+T~0Œ0‹00d0~0Š0 ÿ‰ }o0 ÿ‹•ËY¿0°0ÊSs0B}†N¿0°0k0ˆ0c0f0:SR‰0Œ0 ÿeQŒ0P[Ëi ’0j0Y00 </p></item> </ulist> </p> <p><termdef id="dt-parentchild" term="ª‰‰ }/P[‰ }">S0Œ0‰0n0P}œgh0W0f0 ÿ‡eøf…Qn0i0n0^—ë0ü0È0‰ }<code>C</code>k0þ[W0f0‚0 ÿB0‹0ÖNn0‰ }<code>P</code>L0X[(WW0 ÿ<code>C</code>o0 ÿ<code>P</code>n0…Q¹[k0+T~0Œ0‹0L0 ÿ<code>P</code>n0…Q¹[k0+T~0Œ0‹0ÖNn0‰ }k0+T~0Œ0‹0S0h0o0j0D00S0n0h0M0 ÿ<code>P</code>’0<code>C</code>n0<code>ª‰</code>h0D0D0 ÿ<code>C</code>’0<code>P</code>n0<code>P[</code>h0D0F00</termdef></p> </div2> <div2 id="charsets"> <head>‡eW[</head> <p> <!--The data stored in an XML <termref def="dt-entity">entity</termref> is either <termref def="dt-text">parsed</termref> or <termref def="dt-unparsed">unparsed</termref>. --> <termdef id="dt-text" term="Æ0­0¹0È0">&parsed-entity;o0 ÿ<term>Æ0­0¹0È0</term>(<termref def="dt-character">‡eW[</termref>n0&Ns0g0B0c0f0 ÿ&markup;ÈSo0‡eW[Ç0ü0¿0’0hˆW0f0‚0ˆ0D00)’0+T€00</termdef><termdef id="dt-character" term="‡eW["><term>‡eW[</term>o0 ÿÆ0­0¹0È0n0g\XSMOg0B0c0f0 ÿISO/IEC 10646<bibref ref="ISO10646"/>k0‰š[U0Œ0‹00<!--Users may extend the ISO/IEC 10646 character repertoire by exploiting the private use areas. -->1Š¹[Y0‹0‡eW[o0 ÿ¿0Ö0 ÿ9eLˆ ÿ©_0^&Ns0k0UnicodeÊSs0ISO/IEC 10646L01Š¹[Y0‹0óVb_‡eW[h0Y0‹00</termdef> <scrap lang="ebnf" id="char32"> <head>‡eW[n0Ä{òV</head> <prodgroup pcw2="4" pcw4="17.5" pcw5="11"> <prod id="NT-Char"><lhs>Char</lhs> <rhs>#x9 | #xA | #xD | [#x20-#D7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]</rhs> <com>ûNan0Unicode‡eW[0_0`0W0 ÿ&surrogate-blocks; ÿFFFEÊSs0FFFFo0d–O00</com> </prod> </prodgroup> </scrap> </p> <p>&character-value;’0Ó0Ã0È0Ñ0¿0ó0k0&{÷SSY0‹0_jËio0 ÿŸ[SOT0h0k0Uc0f0‚0ˆ0D00Y0y0f0n0XML&processor;o0 ÿISO/IEC 10646n0UTF-8&{÷SSÊSs0UTF-16&{÷SS’0×SQ0ØNQ0j0Q0Œ0p0j0‰0j0D00ŒNd0n0i0a0‰0L0(uD0‰0Œ0f0D0‹0K0’0f:yY0‹0_00n0_jËi ÿÊSs0ÖNn0&{÷SS¹eÕl’0)R(uY0‹0_00n0_jËio0 ÿ<titleref href='charencoding'>‡eW[n0&{÷SS</titleref>k0ŠðY0‹00</p> <p>i0n0&{÷SS¹eÕl’0(uD0‹0K0k0¢•ÂOj0O0 ÿISO/IEC 10646n0‡eW[Æ–Tk0B0‹0Y0y0f0n0‡eW[o0 ÿ]0n0UCS-4&code-value;<!-- bit string. -->h0I{¡Oj0102peÈSo0162pek0ˆ0c0f0 ÿÂSgqg0M0‹00</p> </div2> <div2 id='sec-common-syn'> <head>qQn0Ëi‡eËibP[</head> <p>2.3g0o0 ÿ‡eÕl…Qg0ƒ^O0O(uY0‹0D0O0d0K0n0Š÷S’0š[©Y0‹00</p> <p><nt def="NT-S">S</nt> (zz}v)o0 ÿNd0å‚W0O0o0‰pen0&space-character;(#x20) ÿ©_0^ ÿ9eLˆÈSo0¿0Ö0K0‰0b‹00 <scrap lang="ebnf" id='white'> <head>zz}v</head> <prodgroup pcw2="4" pcw4="17.5" pcw5="11"> <prod id='NT-S'><lhs>S</lhs> <rhs>(#x20 | #x9 | #xD | #xA)+</rhs> </prod> </prodgroup> </scrap></p> <p>¿Oœ[ N ÿ‡eW[’0 ÿ&letter; ÿpeW[ÈSo0ÖNn0‡eW[k0R^˜Y0‹00&letter;o0 ÿ¢0ë0Õ0¡0Ù0Ã0È0„vÈSo0hˆó—„vg0B0‹0úW,g‡eW[(Nd0ÈSo0‰pen0&combining-character;L0 ÿŒ_k0š}O0S0h0‚0B0‹00) ÿ&ideographic;K0‰0b‹00 <!-- Certain layout and format-control characters defined by ISO/IEC 10646 should be ignored when recognizing identifiers; these are defined by the classes <nt def='NT-Ignorable'>Ignorable</nt> and <nt def='NT- Extender'>Extender</nt>. --> T¯0é0¹0k0J0Q0‹0Ÿ[›–n0‡eW[k0d0D0f0n0Œ[hQj0š[©o0 ÿ<titleref href='CharClasses'>‡eW[¯0é0¹0</titleref>k0¢•Y0‹0ØN2“k0‰š[Y0‹00</p> <p><termdef id="dt-name" term="Name"><term>Name</term>o0 ÿ&letter;ÈSo0D0O0d0K0n0:SRŠ0‡eW[n0Nd0g0ËY~0Š0 ÿ]0n0Œ_k0&letter; ÿpeW[ ÿÏ0¤0Õ0ó0 ÿ NÚ} ÿ³0í0ó0ÈSo0Ô0ê0ª0É0L0š}O0(S0Œ0‰0’0 TMR‡eW[h0D0F00)0</termdef>&string;"<code>xml</code>"ÈSo0<code>(('X'|'x') ('M'|'m') ('L'|'l'))</code>k0&match;Y0‹0ûNan0&string;g0ËY~0‹0 TMRo0 ÿS0n0&TR-or-Rec;n0þs(Wn0HrÈSo0\egn0Hrg0n0j–nSn0_00k0ˆN}Y0‹00 </p> <note> <p>XMLn0 TMRn0-Nn0³0í0ó0o0 ÿ TMRzz“•g0n0Ÿ[šn0_00k0ˆN}Y0‹00³0í0ó0n0asTo0 ÿ\egn0B0‹0Bf¹pg0j–nSY0‹0‚0n0h0W0 ÿ]0n0h0M0k0o0 ÿŸ[š„vj0îv„vg0³0í0ó0’0O(uY0‹0‡eøf’0ôf°eY0‹0Å_‰L0uX0‹0ïSý€'`L0B0‹00XMLg0¡c(uY0‹0 TMRzz“•n0_jËiL0 ÿ:SRŠ0P[h0W0f0Ÿ[›–k0³0í0ó0’0O(uY0‹0h0D0F0ÝO<Šo0j0D00‹NŸ[ N ÿS0Œ0o0 ÿ TMRzz“•n0Ÿ[šn0Nd0h0W0f0åNYk0o0 ÿXMLn0 TMRn0-Ng0³0í0ó0’0O(uW0j0D0{0F0L0ˆ0D0S0h0’0asTY0‹00W0K0W0 ÿXML&processor;o0 ÿ TMR‡eW[h0W0f0³0í0ó0’0×SQ0ØNQ0‹0S0h0L0g~0W0D00 </p> </note> <p> <nt def='NT-Nmtoken'>Nmtoken</nt> ( TMR&token;)o0 ÿ TMR‡eW[g0ËibY0‹0Rh0Y0‹00 <scrap lang='ebnf'> <head> TMRÊSs0&token;</head> <!-- <prod id='NT-MiscName'><lhs>MiscName</lhs> <rhs></rhs> </prod>--> <prod id='NT-NameChar'><lhs>NameChar</lhs> <rhs><nt def="NT-Letter">Letter</nt> | <nt def='NT-Digit'>Digit</nt> <!--| <nt def='NT-MiscName'>MiscName</nt>--> | '.' | '-' | '_' | ':' | <nt def='NT-CombiningChar'>CombiningChar</nt> <!-- | <nt def='NT-Ignorable'>Ignorable</nt> --> | <nt def='NT-Extender'>Extender</nt></rhs> </prod> <prod id='NT-Name'><lhs>Name</lhs> <rhs>(<nt def='NT-Letter'>Letter</nt> | '_' | ':') (<nt def='NT-NameChar'>NameChar</nt>)*</rhs></prod> <prod id='NT-Names'><lhs>Names</lhs> <rhs><nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt>)*</rhs></prod> <prod id='NT-Nmtoken'><lhs>Nmtoken</lhs> <rhs>(<nt def='NT-NameChar'>NameChar</nt>)+</rhs></prod> <prod id='NT-Nmtokens'><lhs>Nmtokens</lhs> <rhs><nt def='NT-Nmtoken'>Nmtoken</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Nmtoken'>Nmtoken</nt>)*</rhs></prod> </scrap> </p> <p>&literal;Ç0ü0¿0o0 ÿ_(u&{g0òV~0Œ0_0&string;h0W0 ÿ]0n0Rn0:SRŠ0P[h0W0f0O(uY0‹0_(u&{o0+T~0j0D00&literal;o0 ÿ…QèŸ[SO(<nt def='NT-EntityValue'>EntityValue</nt>) ÿ^\'`$P(<nt def='NT-AttValue'>AttValue</nt>) ÿYè&identifier;(<nt def="NT-SystemLiteral">SystemLiteral</nt>)n0…Q¹[n0cš[k0O(uY0‹00îv„vk0ˆ0c0f0o0 ÿ&literal;hQSO’0 ÿ]0n0-Nn0&markup;n0pûg’0Lˆj00Z0k0 ÿ¹0­0Ã0×0Y0‹0S0h0L0B0‹0(<nt def='NT-SkipLit'>SkipLit</nt>0)0 <scrap lang='ebnf'> <head>&literal;</head> <!-- is marked section end legal in entity values etc.? James says yes. Handbook page 392, sec. 10.4 seems to me to say no. If James is right, leave as is. Otherwise, uncomment the next comment and ... --> <!-- <prod id='NT-EntityValue'><lhs>EntityValue</lhs> <rhs>' " ' (([^%&amp;"] | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-Reference'>Reference</nt>)* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-char'>Char</nt>*)) ' " ' </rhs> <rhs>|&nbsp; " ' " (([^%&amp;'] | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-Reference'>Reference</nt>)* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-char'>Char</nt>*)) " ' "</rhs> </prod> <prod id='NT-AttValue'><lhs>AttValue</lhs> <rhs>'"' (([^&lt;&amp;"] | <nt def='NT-Reference'>Reference</nt>)* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-char'>Char</nt>*)) ' " ' </rhs> <rhs>|&nbsp; " ' " (([^&lt;&amp;'] | <nt def='NT-Reference'>Reference</nt>)* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-char'>Char</nt>*)) " ' "</rhs> <wfc def="CleanAttrVals"/> </prod> --> <!-- ... and comment out the following, down to ... --> <prod id='NT-EntityValue'><lhs>EntityValue</lhs> <rhs>' " ' ([^%&amp;"] | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-Reference'>Reference</nt>)* ' " ' </rhs> <rhs>|&nbsp; " ' " ([^%&amp;'] | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-Reference'>Reference</nt>)* " ' "</rhs> </prod> <prod id='NT-AttValue'><lhs>AttValue</lhs> <rhs>' " ' ([^&lt;&amp;"] | <nt def='NT-Reference'>Reference</nt>)* ' " ' </rhs> <rhs>|&nbsp; " ' " ([^&lt;&amp;'] | <nt def='NT-Reference'>Reference</nt>)* " ' "</rhs> <!--<wfc def="WF-Attvaldelim"/>--> </prod> <!-- ... down to here. --> <prod id="NT-SystemLiteral"><lhs>SystemLiteral</lhs> <rhs><nt def='NT-SkipLit'>SkipLit</nt></rhs> </prod> <!-- <prod id="NT-URIchar"><lhs>URIchar</lhs> <rhs><com>See <loc href="http://www.w3.org/XXX">XXX</loc></com> </rhs></prod> --> <prod id="NT-PubidLiteral"><lhs>PubidLiteral</lhs> <rhs>' " ' <nt def='NT-PubidChar'>PubidChar</nt>* ' " ' | " ' " (<nt def='NT-PubidChar'>PubidChar</nt> - " ' ")* " ' "</rhs> </prod> <prod id="NT-PubidChar"><lhs>PubidChar</lhs> <rhs>#x20 | #xD | #xA |&nbsp;[a-zA-Z0-9] |&nbsp;[-'()+,./:=?]</rhs> </prod> <prod id="NT-SkipLit"><lhs>SkipLit</lhs> <rhs>(' " ' [^"]* ' " ') |&nbsp;(" ' " [^']* " ' ")</rhs> </prod> <!-- alternate form, making ms end illegal: --> <!-- <prod id="NT-SkipLit"><lhs>SkipLit</lhs> <rhs>(' " ' ([^"]* - ([^"]* ']]&gt;' [^"]*)) ' " ') |&nbsp;(" ' " ([^']* - ([^']* ']]&gt;' [^']*)) " ' ")</rhs> </prod> --> </scrap> </p> <!-- <wfcnote id="WF-Attvaldelim"> <head>Delimiters in Attribute Values</head> <p>After the expansion of character and entity references, an attribute value must not contain a "<code>&lt;</code>" or "<code>&amp;</code>" character unless that character was introduced by the expansion of a character reference or one of the entities &magicents;.</p> </wfcnote>--> <!-- This is not quite right: &lt; should be legal, should it not? Suppress this WFC until we get it right. --> <!-- Henry Thompson suggests (in substance, not form: the wording needs to be clarified): "Cooked Attribute values must not contain &lt; &amp; or the quote which closed their uncooked literal, unless arising from the expansion of a character reference or magic reference directly contained in their uncooked literal." I'm not sure I agree with this rule, but it's at least coherent, which is more than I can say for my attempt. --> </div2> <div2 id='syntax'> <head>‡eW[Ç0ü0¿0ÊSs0&markup;</head> <p><termref def='dt-text'>Æ0­0¹0È0</termref>o0 ÿ<termref def="dt-chardata">‡eW[Ç0ü0¿0</termref>ÊSs0&markup;L0÷m(WY0‹0‚0n0h0W0f0ËibY0‹00<termdef id="dt-markup" term="Markup"><term>&markup;</term>o0 ÿ<termref def="dt-stag">‹•ËY¿0°0</termref> ÿ<termref def="dt-etag">B}†N¿0°0</termref> ÿ<termref def="dt-empty">zz‰ }</termref> ÿ<termref def="dt-entref">Ÿ[SOÂSgq</termref> ÿ<termref def="dt-charref">‡eW[ÂSgq</termref> ÿ<termref def="dt-comment">³0á0ó0È0</termref> ÿ<termref def="dt-cdsection">CDATA»0¯0·0ç0ó0</termref> n0:SRŠ0P[ ÿ<termref def="dt-doctype">‡eøf‹W£[Š</termref>ÊSs0<termref def="dt-pi">æQt}TäN</termref>n0b_’0ÖS‹00 </termdef> </p> <p><termdef id="dt-chardata" term="Character Data">&markup;g0o0j0D0Y0y0f0n0Æ0­0¹0È0o0 ÿ‡eøfn0<term>‡eW[Ç0ü0¿0</term>’0ËibY0‹00</termdef></p> <p>¢0ó0Ñ0µ0ó0É0‡eW[ (&amp;)ÊSs0&left-angle-bracket; (&lt;)o0 ÿ&markup;n0:SRŠ0P[h0W0f0 ÿÈSo0<termref def="dt-comment">³0á0ó0È0</termref> ÿ<termref def="dt-pi">æQt}TäN</termref>å‚W0O0o0<termref def="dt-cdsection">CDATA»0¯0·0ç0ó0</termref>…Qg0O(uY0‹04XTk0<emph>`0Q0</emph> ÿ]0n0~0~0n0b_g0úQþsW0f0ˆ0D00S0Œ0‰0n0‡eW[o0 ÿ…QèŸ[SO£[Šn0<termref def='dt-litentval'>&literal;Ÿ[SO$P</termref>…Qk0ŠðW0f0‚0ˆ0D00 sŠW0O0o0 ÿ<titleref href='wf-entities'>&well-formed;n0Ÿ[SO</titleref>k0¢•Y0‹0‰š[’0ÂSgq0<!-- FINAL EDIT: restore internal entity decl or leave it out. -->S0Œ0‰0n0‡eW[L0ÖNn0èRg0Å_‰j04XT ÿpe$Pk0ˆ0‹0‡eW[ÂSgqÈSo0&string;"<code>&amp;amp;</code>"ÊSs0&string;"<code>&amp;lt;</code>"’0O(uW0 ÿ<termref def="dt-escape">&escape;</termref>W0j0Q0Œ0p0j0‰0j0D00&right-angle-bracket; (>) o0 ÿ&string;"<code>&amp;gt;</code>"’0O(uW0f0hˆþsW0f0‚0ˆ0D00…Q¹[n0-Ng0R"<code>]]&gt;</code>"’0O(uY0‹0h0M0o0 ÿ]0Œ0L0 ÿ<termref def="dt-cdsection">CDATA»0¯0·0ç0ó0</termref>n0B}†N’0&markup;W0j0D0P–Š0 ÿ<termref def='dt-compat'>’NÛc'`n0_00</termref> ÿ"<code>&amp;gt;</code>"ÈSo0‡eW[ÂSgq’0O(uW0 ÿ&escape;W0j0Q0Œ0p0j0‰0j0D00</p> <p>‰ }n0…Q¹[g0o0 ÿ‡eW[Ç0ü0¿0o0 ÿD0K0j0‹0&markup;n0‹•ËY:SRŠ0P[’0+T~0j0D0ûNan0&char-string;h0Y0‹00CDATA»0¯0·0ç0ó0g0o0 ÿ‡eW[Ç0ü0¿0h0o0 ÿCDATA»0¯0·0ç0ó0n0B}†N:SRŠ0P["<code>]]&gt;</code>"’0+T~0j0D0ûNan0&char-string;h0Y0‹00 </p> <p> ^\'`$Pk0&single-quote;ÊSs0&double-quote;’0+T€0_00k0o0 ÿ¢0Ý0¹0È0í0Õ0£0ÈSo0&single-quote;(') o0 ÿ"<code>&amp;apos;</code>"h0W0f0hˆþsW0 ÿ&double-quote;(")o0 ÿ"<code>&amp;quot;</code>"h0W0f0hˆþsY0‹00 <scrap lang="ebnf"> <head>‡eW[Ç0ü0¿0</head> <prod id='NT-CharData'> <lhs>CharData</lhs> <rhs>[^&lt;&amp;]* - ([^&lt;&amp;]* ']]&gt;' [^&lt;&amp;]*)</rhs> </prod> </scrap> </p> </div2> <div2 id='sec-comments'> <head>³0á0ó0È0</head> <p><termdef id="dt-comment" term="Comment"><term>³0á0ó0È0</term>o0 ÿÖNn0<termref def='dt-markup'>&markup;</termref>n0Yj0‰0p0 ÿ‡eøfn0i0S0k0þsŒ0f0‚0ˆ0D00U0‰0k0 ÿ‡eøf‹W£[Š…Qg0 ÿ‡eÕlL01ŠY04X@bk0þsŒ0f0‚0ˆ0D00 <!-- TB except in a <termref def="dt-cdsection">CDATA section</termref>, i.e. within <termref def="dt-elemcontent">element content</termref>, in <termref def="dt-mixed">mixed content</termref>, or in the prolog. They must not occur within declarations or tags. --> ³0á0ó0È0o0 ÿ‡eøfn0<termref def="dt-chardata">‡eW[Ç0ü0¿0</termref>n0Nèg0o0j0D00XML&processor;o0 ÿ&application;L0³0á0ó0È0n0Æ0­0¹0È0’0ÖSŠ0úQY0S0h0’0ïSý€h0W0f0‚0ˆ0D0L0 ÿ]0F0W0j0O0h0‚0ˆ0D00 <termref def="dt-compat">’NÛc'`n0_00</termref> ÿ&string;"<code>--</code>" ÿ&double-hyphen; ÿo0 ÿ³0á0ó0È0…Qg0þsŒ0f0o0j0‰0j0D00 <scrap lang="ebnf"> <head>³0á0ó0È0</head> <prod id='NT-Comment'><lhs>Comment</lhs> <rhs>'&lt;!--' ((<nt def='NT-Char'>Char</nt> - '-') | ('-' (<nt def='NT-Char'>Char</nt> - '-')))* '-->'</rhs> <!-- <rhs>'&lt;!&como;' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* '&comc;' <nt def='NT-Char'>Char</nt>*)) '&comc;&gt;'</rhs> --> </prod> </scrap> </termdef></p> <p>³0á0ó0È0n0‹O’0!kk0:yY00 <eg>&lt;!&como; declarations for &lt;head> &amp; &lt;body> &comc;&gt;</eg> </p> </div2> <div2 id='sec-pi'> <head>æQt}TäN</head> <p><termdef id="dt-pi" term="Processing instruction"><term>æQt}TäN</term>(PI)k0ˆ0c0f0 ÿ&application;n0_00n0}TäN’0‡eøfk0eQŒ0‹0S0h0L0g0M0‹00 <scrap lang="ebnf"> <head>æQt}TäN</head> <prod id='NT-PI'><lhs>PI</lhs> <rhs>'&lt;?' <nt def='NT-PITarget'>PITarget</nt> (<nt def='NT-S'>S</nt> (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* &pic; <nt def='NT-Char'>Char</nt>*)))? &pic;</rhs></prod> <prod id='NT-PITarget'><lhs>PITarget</lhs> <rhs><nt def='NT-Name'>Name</nt> - (('X' | 'x') ('M' | 'm') ('L' | 'l'))</rhs> </prod> </scrap></termdef> PIo0 ÿ‡eøfn0<termref def="dt-chardata">‡eW[Ç0ü0¿0</termref>n0Nèg0o0j0D0L0 ÿ&application;k0!nU0Œ0j0Q0Œ0p0j0‰0j0D00PIo0 ÿ}TäNL0!nU0Œ0‹0&application;’0&identify;_00k0O(uY0‹0&target; (<nt def='NT-PITarget'>PITarget</nt>) g0ËY~0‹00&target; T "<code>XML</code>" ÿ"<code>xml</code>"j0i0o0 ÿS0n0&TR-or-Rec;n0þs(Wn0HrÈSo0\egn0Hrn0‰ŠÕl</termref>_jËi’0 ÿPIn0&target;’0£[ŠY0‹0_00k0O(uW0f0‚0ˆ0D00 </p> </div2> <div2 id='sec-cdata-sect'> <head>CDATA»0¯0·0ç0ó0</head> <p><termdef id="dt-cdsection" term="CDATA Section"><term>CDATA»0¯0·0ç0ó0</term>o0 ÿ‡eW[Ç0ü0¿0L0úQþsY0‹0h0S00g0B0Œ0p0 ÿi0S0k0úQþsW0f0‚0ˆ0D00S0Œ0o0 ÿ]0F0g0j0Q0Œ0p0 ÿ&markup;h0W0f0ŠX‹Y0‹0‡eW[’0+T€0 ÿÆ0­0¹0È0n0:S;u’0&escape;Y0‹0n0k0O(uY0‹00CDATA»0¯0·0ç0ó0o0 ÿ&string;"<code>&lt;![CDATA[</code>"g0ËY~0Š0 ÿ&string; "<code>]]&gt;</code>"g0B}0‹00 <scrap lang="ebnf"> <head>CDATA»0¯0·0ç0ó0</head> <prod id='NT-CDSect'><lhs>CDSect</lhs> <rhs><nt def='NT-CDStart'>CDStart</nt> <nt def='NT-CData'>CData</nt> <nt def='NT-CDEnd'>CDEnd</nt></rhs></prod> <prod id='NT-CDStart'><lhs>CDStart</lhs> <rhs>'&lt;![CDATA['</rhs> </prod> <prod id='NT-CData'><lhs>CData</lhs> <rhs>(<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-Char'>Char</nt>*)) </rhs> </prod> <prod id='NT-CDEnd'><lhs>CDEnd</lhs> <rhs>']]&gt;'</rhs> </prod> </scrap> CDATA»0¯0·0ç0ó0…Qg0o0 ÿR<nt def='NT-CDEnd'>CDEnd</nt>`0Q0’0&markup;h0W0f0ŠX‹Y0‹0n0g0 ÿ&left-angle-bracket;ÊSs0¢0ó0Ñ0µ0ó0É0o0 ÿ]0n0&literal;b__g0úQþsW0f0ˆ0D00]0Œ0‰0o0 ÿ"<code>&amp;lt;</code>"ÊSs0"<code>&amp;amp;</code>"’0O(uW0f0&escape;Y0‹0Å_‰o0j0D00CDATA»0¯0·0ç0ó0o0 ÿeQŒ0P[k0o0g0M0j0D00 </termdef> </p> <p>"<code>&lt;greeting></code>"ÊSs0"<code>&lt;/greeting></code>"’0 ÿ<termref def='dt-markup'>&markup;</termref>g0o0j0O0 ÿ<termref def='dt-chardata'>‡eW[Ç0ü0¿0</termref>h0W0f0ŠX‹Y0‹0CDATA»0¯0·0ç0ó0n0‹O’0 ÿ!kk0:yY00 <eg>&lt;![CDATA[&lt;greeting>Hello, world!&lt;/greeting>]]&gt;</eg> </p> </div2> <div2 id='sec-prolog-dtd'> <head>&prolog;ÊSs0‡eøf‹W£[Š</head> <p><termdef id='dt-xmldecl' term='XML Declaration'>XML‡eøfo0 ÿO(uY0‹0XMLn0&version;’0cš[Y0‹0<term>XML£[Š</term>g0ËY0f0‚0ˆ0O0 ÿÈS]0F0Y0‹0n0L0g~0W0D00 </termdef> </p> <p>S0n0&TR-or-Rec;n0S0n0&version;k0iTY0‹0S0h0’0:yY0_00k0o0 ÿ&version;ju÷S "<code>1.0</code>" ’0O(uW0j0Q0Œ0p0j0‰0j0D00B0‹0‡eøfL0 ÿS0n0&TR-or-Rec;n0S0n0&version;k0iTW0j0D0h0M0 ÿ$P"<code>1.0</code>"’0O(uY0‹0n0o0 ÿ&error;h0Y0‹00S0n0&TR-or-Rec;n0ÊNŒ_n0&version;k0"<code>1.0</code>"åNYn0$P’0ØNNY0‹0S0h0L0 ÿXML\Omi°0ë0ü0×0n0aóV`0L0 ÿXMLn0\egn0&version;’0\ObY0‹0S0h0n0ºx}’0:yY00Q0g0o0j0O0 ÿ\ObW0_0h0W0f0‚0 ÿju÷SØNQ0k0d0D0f0 ÿyrš[n0¹eÕl’0O(uY0‹0S0h0n0ºx}’0:yY00Q0g0‚0j0D00\egn0&version;n0ïSý€'`’0d–YW0j0D0n0g0 ÿÅ_‰j04XT ÿêÕR„vj0&version;n0ŠX‹’0ïSý€h0Y0‹0Kbµkh0W0f0 ÿS0n0ËibP[’0Ðc›OY0‹00&processor;o0 ÿµ0Ý0ü0È0W0f0D0j0D0&version;g0é0Ù0ë0ØNQ0W0_0‡eøf’0×SQ0ÖSc0_0h0M0 ÿ&error;’0åwW0f0‚0ˆ0D00 </p> <p>XML‡eøf…Qn0&markup;n0_jý€o0 ÿŠ¶aËi ÊSs0ÖŠtËi ’0ŠðY0‹0S0h0 ÿ&Ns0k0^\'`ÊSs0^\'`$Pn0þ[’0ÖŠtËi k0¢•#e0Q0‹0S0h0k0B0‹00XMLo0 ÿÖŠtËi k0d0D0f0n06R}agöN’0š[©Y0‹0_00 ÿÊSs0B0‰0K0X00š[©U0Œ0_0Š¶aXSMO’0O(ug0M0‹0_00n0_jËih0W0f0 ÿ<termref def="dt-doctype">‡eøf‹W£[Š</termref>’0Ðc›OY0‹00<!-- old The function of the markup in an XML document is to describe its storage and logical structures, and associate attribute-value pairs with the logical structure. XML provides a mechanism, the <termref def="dt-doctype">document type declaration</termref>, to define constraints on that logical structure and to support the use of predefined storage units. --><termdef id="dt-valid" term="Validity">XML‡eøfL0<term>&valid;</term>h0o0 ÿ‡eøf‹W£[Š’0‚0a0 ÿ]0n0‡eøf‹W£[Šk0:yY06R}agöN’0€n_0Y0S0h0h0Y0‹00 </termdef></p> <p>‡eøf‹W£[Šo0 ÿ‡eøfn0gRn0<termref def="dt-element">‰ }</termref>n0MRk0þsŒ0j0Q0Œ0p0j0‰0j0D00 <scrap lang="ebnf" id='xmldoc'> <head>&prolog;</head> <prodgroup pcw2="6" pcw4="17.5" pcw5="9"> <prod id='NT-prolog'><lhs>prolog</lhs> <rhs><nt def='NT-XMLDecl'>XMLDecl</nt>? <nt def='NT-Misc'>Misc</nt>* (<nt def='NT-doctypedecl'>doctypedecl</nt> <nt def='NT-Misc'>Misc</nt>*)?</rhs></prod> <prod id='NT-XMLDecl'><lhs>XMLDecl</lhs> <rhs>&xmlpio; <nt def='NT-VersionInfo'>VersionInfo</nt> <nt def='NT-EncodingDecl'>EncodingDecl</nt>? <nt def='NT-SDDecl'>SDDecl</nt>? <nt def="NT-S">S</nt>? &pic;</rhs> </prod> <prod id='NT-VersionInfo'><lhs>VersionInfo</lhs> <rhs><nt def="NT-S">S</nt> 'version' <nt def='NT-Eq'>Eq</nt> ('"<nt def="NT-VersionNum">VersionNum</nt>"' | "'<nt def="NT-VersionNum">VersionNum</nt>'")</rhs> </prod> <prod id='NT-Eq'><lhs>Eq</lhs> <rhs><nt def='NT-S'>S</nt>? '=' <nt def='NT-S'>S</nt>?</rhs></prod> <prod id="NT-VersionNum"> <lhs>VersionNum</lhs> <rhs>([a-zA-Z0-9_.:] | '-')+</rhs> </prod> <prod id='NT-Misc'><lhs>Misc</lhs> <rhs><nt def='NT-Comment'>Comment</nt> | <nt def='NT-PI'>PI</nt> | <nt def='NT-S'>S</nt></rhs></prod> </prodgroup> </scrap></p> <p> ‹OH0p0 ÿ!kk0:yY0Œ[hQj0XML‡eøfo0 ÿ<termref def="dt-wellformed">&well-formed;</termref>g0B0‹0L0<termref def="dt-valid">&valid;</termref>g0o0j0D00 <eg><![CDATA[<?xml version="1.0"?> <greeting>Hello, world!</greeting> ]]></eg> !kn0‡eøf‚0 TØih0Y0‹00 <eg><![CDATA[<greeting>Hello, world!</greeting> ]]></eg> </p> <p><termdef id="dt-doctype" term="Document Type Declaration"> XMLn0<term>‡eøf‹W£[Š</term>o0 ÿB0‹0‡eøf¯0é0¹0n0_00n0‡eÕl’0Ðc›OY0‹0<termref def='dt-markupdecl'>&markup;£[Š</termref>’0+T€0K0 ÿÈSo0ÂSgqY0‹00S0n0‡eÕl’0 ÿ‡eøf‹Wš[©ÈSo0<term>DTD</term>h0D0F00‡eøf‹W£[Šo0 ÿ&markup;£[Š’0+T“0`0Yè&subset;(yr%Rj0.z^˜n0<termref def='dt-extent'>YèŸ[SO</termref>)’0ÂSgqg0M0 ÿÈSo0…Qè&subset;k0ôv¥c&markup;£[Š’0+T€0S0h0‚0g0M0‹00U0‰0k0 ÿ]0n0!N¹e‚0ïSý€h0Y0‹00B0‹0‡eøfn0DTDo0 ÿ!N¹en0&subset;’0~0h00_0‚0n0h0W0f0ËibY0‹00</termdef> </p> <p><termdef id="dt-markupdecl" term="markup declaration"> <term>&markup;£[Š</term>o0 ÿ<termref def="dt-eldecl">‰ }‹W£[Š</termref> ÿ <termref def="dt-attdecl">^\'`ê0¹0È0£[Š</termref> ÿ<termref def="dt-entdecl">Ÿ[SO£[Š</termref>ÈSo0<termref def="dt-notdecl">ŠÕl£[Š</termref>h0Y0‹00</termdef>!kk0:yY0&well-formed;6R}ÊSs0&validity;6R}k0‰š[Y0‹0L0 ÿS0Œ0‰0n0£[Šo0 ÿ<termref def='dt-PE'>&parameter;Ÿ[SO</termref>…Qk0hQSOÈSo0NèL0+T~0Œ0f0‚0ˆ0D00sŠW0D0‰š[o0 ÿ<titleref xml-link="simple" href="sec-physical-struct">irtËi </titleref>k0¢•Y0‹0‰š[’0ÂSgqn0S0h00</p> <scrap lang="ebnf" id='dtd'> <head>‡eøf‹Wš[©</head> <prodgroup pcw2="6" pcw4="17.5" pcw5="9"> <prod id='NT-doctypedecl'><lhs>doctypedecl</lhs> <rhs>'&lt;!DOCTYPE' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-ExternalID'>ExternalID</nt>)? <nt def='NT-S'>S</nt>? ('[' (<nt def='NT-markupdecl'>markupdecl</nt> | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-S'>S</nt>)* ']' <nt def='NT-S'>S</nt>?)? '>'</rhs> <vc def="vc-roottype"/> <!--<vc def="vc-nonnullDTD"/>--> </prod> <!-- <prod id='NT-markupdecls'><lhs>markupdecls</lhs> <rhs> (<nt def='NT-S'>S</nt>? <nt def='NT-markupdecl'>markupdecl</nt> <nt def='NT-S'>S</nt>?)* </rhs></prod> --> <prod id='NT-markupdecl'><lhs>markupdecl</lhs> <rhs><nt def='NT-elementdecl'>elementdecl</nt> | <nt def='NT-AttlistDecl'>AttlistDecl</nt> | <nt def='NT-EntityDecl'>EntityDecl</nt> | <nt def='NT-NotationDecl'>NotationDecl</nt> | <nt def='NT-PI'>PI</nt> | <nt def='NT-Comment'>Comment</nt> <!--| <nt def='NT-InternalPERef'>InternalPERef</nt> --></rhs> <vc def='vc-PEinMarkupDecl'/> <wfc def="wfc-PEinInternalSubset"/> </prod> <!-- <prod id="NT-InternalPERef"><lhs>InternalPERef</lhs> <rhs><nt def="NT-PEReference">PEReference</nt></rhs> <wfc def="wfc-integraldec"/> </prod> --> </prodgroup> </scrap> <vcnote id="vc-roottype"> <head>&root;‰ }‹W</head> <p> ‡eøf‹W£[Šk0J0Q0‹0<nt def='NT-Name'>Name</nt>o0 ÿ&root;‰ }n0‹Wh0&match;W0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <!-- <vcnote id="vc-nonnullDTD"> <head>Non-null DTD</head> <p> The internal and external subsets of the DTD must not both be empty. </p> </vcnote> --> <vcnote id='vc-PEinMarkupDecl'> <head>£[ŠÊSs0&parameter;Ÿ[SOL0³SÆ[k0eQŒ0P[’0j0Y0S0h0</head> <p>&parameter;Ÿ[SO<termref def='dt-repltext'>n0&replacement-text;</termref>o0 ÿ&markup;£[Š…Qk0J0D0f0 ÿ³SÆ[k0eQŒ0P[k0j0c0f0D0j0Q0Œ0p0j0‰0j0D00d0~0Š0 ÿ&markup;£[Š(<nt def='NT-markupdecl'>markupdecl</nt>)n0gRÈSo0gŒ_n0‡eW[L0 ÿ<termref def='dt-PERef'>&parameter;Ÿ[SOÂSgq</termref>n0þ[aŒh0j0‹0&replacement-text;k0+T~0Œ0Œ0p0 ÿ!N¹eh0‚0 TX0&replacement-text;k0+T~0Œ0j0Q0Œ0p0j0‰0j0D00</p> </vcnote> <wfcnote id="wfc-PEinInternalSubset"> <head>…Qè&subset;…Qn0&parameter;Ÿ[SO</head> <p>DTDn0…Qè&subset;g0o0 ÿ<termref def='dt-PERef'>&parameter;Ÿ[SOÂSgq</termref>o0 ÿ&markup;£[ŠL0úQþsïSý€j04X@b`0Q0k0úQþsg0M0‹00&markup;£[Š…Qk0o0úQþsg0M0j0D0(S0n06R}o0 ÿYè&parameter;Ÿ[SOÈSo0Yè&subset;g0n0ÂSgqk0o0i(uW0j0D00)0 </p> </wfcnote> <p> …Qè&subset;n0h0M0h0 TØik0 ÿYè&subset;ÊSs0DTDk0J0D0f0ÂSgqY0‹0ûNan0Yè&parameter;Ÿ[SOo0 ÿ^—B}ïzŠ÷S<nt def="NT-markupdecl">markupdecl</nt>k0ˆ0c0f01ŠU0Œ0‹0‹Wn0 ÿN#n0Œ[hQj0&markup;£[Šg0ËibU0Œ0j0Q0Œ0p0j0‰0j0D00&markup;£[Šn0“•k0o0 ÿzz}vÈSo0<termref def="dt-PERef">&parameter;Ÿ[SOÂSgq</termref>’0nD0f0‚0ˆ0D00W0K0W0 ÿYè&subset;ÈSo0Yè&parameter;Ÿ[SOn0…Q¹[n0Nèo0 ÿ<termref def="dt-cond-section">agöNØNM0»0¯0·0ç0ó0</termref>’0O(uW0f0!q–‰W0f0‚0ˆ0D00…Qèµ0Ö0»0Ã0È0g0o0 ÿS0Œ0o01ŠU0Œ0j0D00 <!--In the external subset, however, parameter-entity references can be used to replace constructs prefixed by "<code>%</code>" in a production of the grammar, and <termref def="dt-cond-section">conditional sections</termref> may occur. In the internal subset, by contrast, conditional sections may not occur and the only parameter-entity references allowed are those which match the non-terminal <nt def="NT-InternalPERef">InternalPERef</nt> within the rule for <nt def="NT-doctypedecl">markupdecl</nt>. --> <scrap id="ext-Subset"> <head>Yè&subset;</head> <prodgroup pcw2="6" pcw4="17.5" pcw5="9"> <prod id='NT-extSubset'><lhs>extSubset</lhs> <rhs>( <nt def='NT-markupdecl'>markupdecl</nt> | <nt def='NT-conditionalSect'>conditionalSect</nt> | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-S'>S</nt> )*</rhs> </prod> </prodgroup> </scrap></p> <p>Yè&subset;ÊSs0Yè&parameter;Ÿ[SOo0 ÿ]0n0…Qg0o0 ÿ&parameter;Ÿ[SOL0&markup;£[Šn0<emph>“•</emph>`0Q0g0j0O0 ÿ&markup;£[Šn0<emph>…Q</emph>g0‚0ŠX‹U0Œ0‹0 ÿh0D0F0¹pg0‚0…Qè&subset;h0o0puj0‹00 </p> <p>‡eøf‹W£[ŠØNM0n0XML‡eøfn0‹O’0 ÿ!kk0:yY00 <eg><![CDATA[<?xml version="1.0"?> <!DOCTYPE greeting SYSTEM "hello.dtd"> <greeting>Hello, world!</greeting> ]]></eg> <termref def="dt-sysid">·0¹0Æ0à0&identifier;</termref> "<code>hello.dtd</code>"L0 ÿ‡eøfn0DTDn0URIh0j0‹00</p> <p>!kn0‹On0h0J0Š0 ÿ£[Š’0@\@b„vk0NH0‹0S0h0‚0g0M0‹00 <eg><![CDATA[<?xml version="1.0" encoding="UTF-8" ?> <!DOCTYPE greeting [ <!ELEMENT greeting (#PCDATA)> ]> <greeting>Hello, world!</greeting> ]]></eg> Yè&subset;ÊSs0…Qè&subset;n0!N¹e’0O(uY0‹0h0M0o0 ÿ…Qè&subset;L0Yè&subset;ˆ0Š0HQk0úQþsW0_0h0‹‰j0Y00<!--* 'is considered to'? boo. whazzat mean? -->S0Œ0o0 ÿ…Qè&subset;n0Ÿ[SOÊSs0^\'`ê0¹0È0£[ŠL0 ÿYè&subset;n0Ÿ[SOÊSs0^\'`ê0¹0È0£[Šˆ0Š0*QHQY0‹0h0D0F0¹Rœg’0‚0_0‰0Y00 </p> </div2> <div2 id='sec-rmd'> <head>&standalone;‡eøf£[Š</head> <p><termref def="dt-xml-proc">XML&processor;</termref>o0 ÿ&application;k0‡eøfn0…Q¹[’0!nY0L0 ÿ&markup;£[Šo0 ÿS0n0…Q¹[k0q_ÿ—’0NH0‹0S0h0L0B0‹00^\'`n0&default-value;ÊSs0Ÿ[SO£[Š’0]0n0‹Oh0Y0‹00XML£[Šn0NèRh0W0f0úQþsg0M0‹0&standalone;‡eøf£[Šo0 ÿ‡eøfL0 ÿ]0n0&markup;£[Šn0X[(Wk0ˆ0c0f0q_ÿ—U0Œ0j0D0S0h0’0cW0:yY0ÿnf ÿ]0n0&markup;£[ŠL0X[(WW0j0D0_00k0 ÿS0Œ0L0D0H0‹00 ÿ0 <scrap lang="ebnf" id='fulldtd'> <head>&standalone;‡eøf£[Š</head> <prodgroup pcw2="4" pcw4="19.5" pcw5="9"> <prod id='NT-SDDecl'><lhs>SDDecl</lhs> <rhs> <nt def="NT-S">S</nt> 'standalone' <nt def='NT-Eq'>Eq</nt> "'" ('yes' | 'no') "'" </rhs> <rhs> | <nt def="NT-S">S</nt> 'standalone' <nt def='NT-Eq'>Eq</nt> '"' ('yes' | 'no') '"' </rhs><vc def='vc-check-rmd'/></prod> </prodgroup> </scrap></p> <p>&standalone;‡eøf£[Šk0J0D0f0o0, "<code>yes</code>"n0$Po0 ÿ<termref def='dt-docent'>‡eøfŸ[SO</termref>n0Yèk0ÿDTDn0Yè&subset;…Qk0 ÿÈSo0…Qè&subset;K0‰0ÂSgqU0Œ0‹0YèÑ0é0á0¿0Ÿ[SO…Qk0 ÿ ÿXML&processor;K0‰0&application;x0h0!nU0Œ0‹0Å`1Xk0q_ÿ—Y0‹0&markup;£[ŠL0X[(WW0j0D0S0h0’0asTY0‹00"<code>no</code>"n0$Po0 ÿ]0n0Yè&markup;£[ŠL0X[(WY0‹0K0 ÿÈSo0X[(WY0‹0ïSý€'`L0B0‹0S0h0’0asTY0‹00&standalone;‡eøf£[Šo0 ÿ]0n0<emph>£[Š</emph>L0‡eøfYèk0X[(WY0‹0K0i0F0K0’0:yY0`0Q0k0èlaY0‹0S0h00YèŸ[SOx0n0ÂSgqL0‡eøf…Qk0X[(WW0f0D0f0‚0 ÿ]0n0Ÿ[SOL0…Qè„vk0£[ŠU0Œ0f0D0‹0h0M0o0 ÿ‡eøfn0&standalone;n0¶rKak0o0q_ÿ—’0NH0j0D00</p> <p>Yèk0&markup;£[ŠL0X[(WW0j0Q0Œ0p0 ÿ&standalone;‡eøf£[Šo0asT’0‚0_0j0D00Yèk0&markup;£[ŠL0X[(WW0 ÿ&standalone;‡eøf£[ŠL0X[(WW0j0D04XTo0 ÿ<code>"no"</code> n0$Pn0-Šš[’0îNš[Y0‹00</p> <p>XML‡eøfg0 <code>standalone="no"</code> L0-Šš[U0Œ0f0D0‹0‚0n0o0 ÿB0‹0¢0ë0´0ê0º0à0g0&standalone;‡eøfk0 YÛcg0M0 ÿS0n0‡eøfo0 ÿÍ0Ã0È0ï0ü0¯0M‘áO&application;k0h0c0f0g~0W0D0K0‚0W0Œ0j0D00</p> <vcnote id='vc-check-rmd'> <head>&standalone;‡eøf£[Š</head> <p>&standalone;‡eøf£[Šo0 ÿUO‰0K0n0Yè&markup;£[ŠL0!kn0D0Z0Œ0K0’0£[ŠW0f0D0‹0h0M0o0 ÿ$P "<code>no</code>" ’0ÖS‰0j0Q0Œ0p0j0‰0j0D00 <ulist> <item><p>a) <termref def="dt-default">&default;</termref>$PØNM0n0^\'`g0B0c0f0 ÿS0n0^\'`L0i(uU0Œ0‹0‰ }L0 ÿ^\'`$P’0cš[[0Z0k0‡eøf…Qk0þsŒ0‹0‚0n00</p></item> <item><p>b) &magicents;åNYn0Ÿ[SOg0B0c0f0 ÿ]0n0Ÿ[SOk0þ[Y0‹0<termref def="dt-entref">ÂSgq</termref>L0‡eøf…Qk0úQþsY0‹0‚0n00</p> </item> <item><p>c) $PL0<titleref href='AVNormalize'>ck‰S</titleref>n0þ[aŒh0j0‹0^\'`g0B0c0f0 ÿck‰Sn0P}œgh0W0f0 YSY0‹0$PL0‡eøf…Qg0^\'`k0cš[U0Œ0‹0‚0n00</p></item> <item> <p>d) <termref def="dt-elemcontent">‰ }…Q¹[</termref>’0‚0d0‰ }‹Wg0B0c0f0 ÿzz}vL0]0n0‰ }‹Wn0D0Z0Œ0K0n0¤0ó0¹0¿0ó0¹0…Qk0ôv¥cþsŒ0‹0‚0n00 </p></item> </ulist> </p> </vcnote> <p>&standalone;‡eøf£[ŠØNM0n0XML£[Šn0‹O’0 ÿ!kk0:yY00 <eg>&lt;?xml version="&XML.version;" standalone='yes'?></eg></p> </div2> <div2 id='sec-white-space'> <head>zz}vn0ÖSqbD0</head> <p>XML‡eøf’0è}Æ–Y0‹0h0M0o0 ÿ&markup;’0îvËz_0[0­Š0„0Y0O0Y0‹0_00k0 ÿ zz}v (&space; ÿ¿0Ö0ÊSs0zz}vLˆ0S0n0&TR-or-Rec;g0o0 ÿ^—B}ïzŠ÷Sn0<nt def='NT-S'>S</nt>g0hˆY0)’0OF0h0¿O)Rj0S0h0L0YD00]0n0zz}vo0 ÿM‘^Y0‹0&version;n0‡eøfn0Nèh0W0f0+T0‹0S0h0’0aóVW0j0D0n0’0nfh0Y0‹00W0K0W0 ÿ asTn0B0‹0 zz}vg0B0c0f0 ÿM‘^Y0‹0&version;k0‹kU0j0Q0Œ0p0j0‰0j0D0‚0n0‚0YD00‹OH0p0 ÿiŠÊSs0½0ü0¹0³0ü0É0k0J0Q0‹0zz}vL0B0‹00</p> <p><termref def='dt-xml-proc'>XML&processor;</termref>o0 ÿ‡eøf…Qn0&markup;åNYn0Y0y0f0n0‡eW[’0 ÿ]0n0~0~0 Yôf[0Z0k0&application;k0!nU0j0Q0Œ0p0j0‰0j0D00<termref def='dt-validating'>&validating;XML&processor;</termref>o0 ÿ<termref def="dt-elemcontent">‰ }…Q¹[</termref>n0-Nn0zz}v’0ÖNn0^—&markup;‡eW[K0‰0:S%RW0 ÿ&application;tPk0‰ }…Q¹[n0-Nn0zz}vL0Í‘‰g0j0D0h0D0F0S0h0’0OH0j0Q0Œ0p0j0‰0j0D00</p> <p> "<code>xml:space</code>"h0D0F0yr%Rj0<termref def='dt-attr'>^\'`</termref>’0‡eøfk0?ceQY0‹0S0h0k0ˆ0c0f0 ÿzz}v’0Í‘‰h0Y0‹0aóV’0:yW0f0‚0ˆ0D00S0n0^\'`’0i(uY0‹0‰ }k0þsŒ0‹0zz}v’0 ÿ¢0×0ê0±0ü0·0ç0ó0L0Í‘‰j0‚0n0h0W0f0qbF0S0h0’0‰BlY0‹0 ÿh0D0F0aóV’0:yY00</p> <p>&valid;j0‡eøfg0o0 ÿS0n0^\'`’0O(uY0‹04XTo0 ÿÖNn0^\'`h0 TX0ˆ0F0k0<termref def="dt-attdecl">£[Š</termref>W0j0Q0Œ0p0j0‰0j0D00£[ŠY0‹0h0M0o0 ÿÖSŠ0—_‹0$P’0"<code>default</code>"ÊSs0 "<code>preserve</code>"`0Q0h0Y0‹0<termref def='dt-enumerated'>Rc‹W</termref>g0j0Q0Œ0p0j0‰0j0D00 </p> <p>$P"<code>default</code>"o0 ÿ&application;n0&default;n0zz}væQtâ0ü0É0’0 ÿ]0n0‰ }k0i(uïSý€h0Y0‹0S0h0’0asTY0‹00$P"<code>preserve</code>"o0 ÿ&application;L0Y0y0f0n0zz}v’0ÝOX[Y0‹0S0h0’0asTY0‹00S0n0£[Šn0aóVo0 ÿ"<code>xml:space</code>" ^\'`n0%Rn0cš[g0 NøfM0W0j0D0P–Š0 ÿ‰ }n0…Q¹[k0þsŒ0‹0Y0y0f0n0‰ }k0i(uY0‹0h0ã‰È‘Y0‹00</p> <p>‡eøfn0<termref def='dt-root'>&root;‰ }</termref>k0d0D0f0o0 ÿS0n0^\'`n0$P’0cš[Y0‹0K0 ÿÈSo0S0n0^\'`n0&default-value;L0B0‹04XT’0d–D0f0o0 ÿ&application;k0ˆ0‹0zz}vn0ÖSqbD0k0d0D0f0 ÿD0K0j0‹0aóV‚0:yU0j0D0h0ã‰È‘Y0‹00</p> <p>‹O’0!kk0:yY00 <eg><![CDATA[ <!ATTLIST poem xml:space (default|preserve) 'preserve'>]]></eg> </p> </div2> <div2 id='sec-line-ends'> <head>Lˆ+gn0ÖSqbD0</head> <p>XMLn0<termref def='dt-parsedent'>Ëi‡e&parsed-entity;</termref>o0 ÿ8^³0ó0Ô0å0ü0¿0n0Õ0¡0¤0ë0…Qk0ÝOX[U0Œ0 ÿè}Æ–n0¿Oœ[n0_00k0‰pen0Lˆk0RQ0‹0S0h0L0YD00S0Œ0‰0n0Lˆo0 ÿnfo0 ÿ<code>CR</code> (#xD)³0ü0É0ÊSs0 <code>LF</code> (#xA)³0ü0É0n0UO‰0K0n0D}T[0k0ˆ0c0f0RQ0‰0Œ0‹00</p> <p><termref def='dt-app'>&application;</termref>n0æQt’0!|XSk0Y0‹0_00 ÿYè&parsed-entity;ÈSo0…Qè&parsed-entity;n0&literal;Ÿ[SO$PL0 ÿ"<code>#xD#xA</code>" n0ÿ‡eW[n0#š}h0Y0‹0&literal;ÈSo0<code>#xD</code>n0XSìrn0&literal;’0+T€04XTk0 ÿ<termref def='dt-xml-proc'>XML&processor;</termref>o0 ÿ&application;k0XSNn0‡eW[<code>#xA</code>`0Q0’0!nU0j0Q0Œ0p0j0‰0j0D0(S0n0æQto0 ÿeQ›R…Qk0X[(WY0‹09eLˆ³0ü0É0’0Ëi‡eã‰gn0MRk0ck‰SY0‹0S0h0k0ˆ0c0f0 ÿ¹[fk0Ÿ[þsg0M0‹00)0</p> </div2> <div2 id='sec-lang-tag'> <head>&language-identification;</head> <p>‡eøfæQtk0J0D0f0o0 ÿ]0n0‡eøfn0-N«ŽL0i0“0j0ê6qŠžŠÈSo0b__ŠžŠg0øfK0Œ0f0D0‹0K0f:yY0‹0S0h0L0 ÿy_k0Ëzd0S0h0L0YD00<!--S0S0g0O(uY0‹0 ŠžŠ h0D0F0ŠI„n0asTo0 ÿ"Espa&#x00F1;ol" ÊSs0"EBNF"n0ÌS¹eg0‹O:yU0Œ0‹0asTh0Y0‹00--><!-- x00F1: spanish's small ntilde--></p> <!--; S0n0Å`1Xo0ÿ‹O’0B0R0Œ0p0 ÿ‡eøfn0‡eW[n0hˆ:y ÿ&Ns0k0Å`1X½búQn0_00n0žŠy^û0b_Ka }ã‰gÊSs0Æ0­0¹0È0Ö0í0Ã0¯0n0teb_k0q_ÿ—’0ÊS|0Y0ïSý€'`L0B0‹00--> <p>XML‡eøf…Qn0‰ }n0‚0d0…Q¹[ÈSo0^\'`$Pk0J0D0f0O(uY0‹0<!--ê6qÈSo0b__-->ŠžŠ’0cš[Y0‹0_00k0 ÿ"<code>xml:lang</code>" h0D0F0 TMRn0yr%Rj0<termref def="dt-attr">^\'`</termref>’0 ÿ‡eøf…Qk0?ceQW0f0‚0ˆ0D00 <!--; S0n0^\'`o0XML‰š[n0Nèh0W0f0 ÿ‰pen0XML&application;n0øv’NK(u'`’0Øš0‹0_00k0š[©Y0‹00--> ^\'`n0$Po0 ÿ<bibref ref="RFC1766"/> RFC1766ÿ&language-identification;n0_00n0¿0°0 k0ˆ0c0f0‰š[U0Œ0‹0&language-identification;³0ü0É0k0“_F00 <scrap lang='ebnf'> <head>&language-identification;</head> <prod id='NT-LanguageID'><lhs>LanguageID</lhs> <rhs><nt def='NT-Langcode'>Langcode</nt> ('-' <nt def='NT-Subcode'>Subcode</nt>)*</rhs></prod> <prod id='NT-Langcode'><lhs>Langcode</lhs> <rhs><nt def='NT-ISO639Code'>ISO639Code</nt> | <nt def='NT-IanaCode'>IanaCode</nt> | <nt def='NT-UserCode'>UserCode</nt></rhs> </prod> <prod id='NT-ISO639Code'><lhs>ISO639Code</lhs> <rhs>([a-z] | [A-Z]) ([a-z] | [A-Z])</rhs></prod> <prod id='NT-IanaCode'><lhs>IanaCode</lhs> <rhs>('i' | 'I') '-' ([a-z] | [A-Z])+</rhs></prod> <prod id='NT-UserCode'><lhs>UserCode</lhs> <rhs>('x' | 'X') '-' ([a-z] | [A-Z])+</rhs></prod> <prod id='NT-Subcode'><lhs>Subcode</lhs> <rhs>([a-z] | [A-Z])+</rhs></prod> </scrap> <nt def='NT-Langcode'>Langcode</nt>o0 ÿ!kn0i0Œ0g0‚0ˆ0D00 <ulist> <item><p>a) <bibref ref="ISO639"/> ŠžŠn0 TMRhˆþsn0_00n0³0ü0É0 g0‰š[U0Œ0‹02‡eW[n0&language-code;</p></item> <item><p>b) Internet Assigned Numbers Authority (IANA)g0{v2“U0Œ0f0D0‹0&language-code;0S0Œ0o0 ÿHQ-˜L0 "<code>i-</code>" (ÈSo0"<code>I-</code>")g0ËY~0‹00</p></item> <item><p>c) &user;k0ˆ0c0f0š[0‰0Œ0_0&language-code; ÿÈSo0Áy„vj0O(un0_00k0‰pen0ãVSO“•L0ÖSŠ0zl0_0³0ü0É00S0Œ0‰0o0 ÿÊNŒ_IANAk0J0D0f0j–nSÈSo0{v2“U0Œ0‹0³0ü0É0h0n0özT’0Q0‹0_00k0 ÿHQ-˜’0"<code>x-</code>" ÈSo0 "<code>X-</code>" g0ËY0‹00</p></item> </ulist></p> <p><nt def='NT-Subcode'>Subcode</nt>o0 ÿ‰peÞVOc0f0‚0ˆ0D00gRn0µ0Ö0³0ü0É0L0X[(WW0 ÿ]0n0…Q¹[L0ŒNd0n0‡eW[K0‰0b‹0h0M0o0 ÿ<bibref ref="ISO3166"/>ISO3166n0 ýV T’0hˆY0³0ü0É0(ýV³0ü0É0) g0j0Q0Œ0p0j0‰0j0D00gRn0µ0Ö0³0ü0É0L03‡eW[åN NK0‰0b‹0h0M0o0 ÿ<nt def='NT-Langcode'>Langcode</nt>n0HQ-˜L0 ÿ"<code>x-</code>" ÈSo0 "<code>X-</code>"g0ËY~0‰0j0D0P–Š0 ÿcš[W0_0ŠžŠk0þ[Y0‹0µ0Ö0³0ü0É0h0W0 ÿIANAk0{v2“U0Œ0_0‚0n0g0j0Q0Œ0p0j0‰0j0D00</p> <p>&language-code;o0 ÿ\‡eW[g0n0hˆŠ’0 ÿ&country-code;o0 ÿ(X[(WY0‹0j0‰0p0)'Y‡eW[g0n0hˆŠ’0caLˆh0Y0‹00W0K0W0 ÿXML‡eøf…Qk0J0Q0‹0ÖNn0 TMRh0o0puj0Š0 ÿS0Œ0‰0n0$Pk0d0D0f0o0 ÿ'Y‡eW[ÊSs0\‡eW[n0:S%R’0W0j0D0S0h0k0èlaY0‹0S0h00</p> <p>‹O’0!kk0:yY00 <eg><![CDATA[<p xml:lang="en">The quick brown fox jumps over the lazy dog.</p> <p xml:lang="en-GB">What colour is it?</p> <p xml:lang="en-US">What color is it?</p> <sp who="Faust" desc='leise' xml:lang="de"> <l>Habe nun, ach! Philosophie,</l> <l>Juristerei, und Medizin</l> <l>und leider auch Theologie</l> <l>]]><!-- x00DF german's es-zet; x00FC german's u-umlaut -->durchaus studiert mit hei&#223;em Bem&#252;h'n.<![CDATA[</l> </sp>]]></eg></p> <!--<p>xml:lang n0$Po0 ÿ‰ }n0…Q¹[ÊSs0(^\'`n0&default-value;g0š[0j0D0P–Š0)Õ0ê0ü0Æ0­0¹0È0(CDATA)n0$P’0‚0d0]0n0‰ }x0n0Y0y0f0n0^\'`n0$Pk0d0D0f0 ÿ]0n0!N¹ek0i(uY0‹00--> <p><code>xml:lang</code>g0£[ŠY0‹0aóVo0 ÿ<code>xml:lang</code>n0%Rn0cš[g0 NøfW0j0D0P–Š0 ÿcš[W0_0‰ }n0…Q¹[k0+T€0Y0y0f0n0‰ }k0i(uY0‹00</p> <!--B0‹0‰ }k0J0Q0‹0 xml:lang ^\'`n0$PL0š[0‰0Œ0f0J0‰0Z0 ÿDTDk0J0D0f0]0n0&default-value;L0š[0‰0Œ0f0D0j0D04XT ÿ]0n0‰ }n0xml:lang ^\'`n0$Po0 ÿª‰‰ }g0n0$PL0X[(WY0‹04XTo0 ÿ]0Œ0’0_M0™}P00 !kn0‹Ok0J0Q0‹0ŒNd0n0<term>h0D0F0 TMRn0\€•(užŠ’0hˆY0‰ }o0 ÿxml:langn0$Pk0¢•W0f0o0 ÿŸ[›– N ÿ TX0$P’0‚0d00 <p xml:lang="en">Here the keywords are <term xml:lang="en">shift</term> and <term>reduce</term>. ...</p> XML&processor;g0o0j0O0&application;L0 ÿS0n0^\'`$Pn0™}bk0d0D0f0¬ŒûN’0‚0d00 --> <p> &valid;j0‡eøfk0J0D0f0o0 ÿS0n0&TR-or-Rec;n0ÖNn04X@bg0‰š[Y0‹0h0J0Š0 ÿS0n0^\'`’0Å_Z0£[ŠW0j0Q0Œ0p0j0‰0j0D008^ ÿ£[Šo0 ÿ!kn0b_h0Y0‹00 <eg>xml:lang NMTOKEN #IMPLIED</eg> Å_‰j0‰0p0 ÿyrš[n0&default-value;’0NH0f0‚0ˆ0D00ñ‚žŠ’0ÍkžŠh0Y0‹0f[u(un0Õ0é0ó0¹0žŠn0iŠÆ–g0o0 ÿ¬ŠfÊSs0èl’0ñ‚žŠg0ŠðY0Œ0p0 ÿxml:lang ^\'`’0!kn0h0J0Š0k0£[ŠY0‹0S0h0h0j0‹00 <eg><![CDATA[ <!ATTLIST poem xml:lang NMTOKEN 'fr'> <!ATTLIST gloss xml:lang NMTOKEN 'en'> <!ATTLIST note xml:lang NMTOKEN 'en'>]]></eg> </p> <!-- DTDn0-ŠŠ€o0 ÿ¹0¯0ê0×0È0’0ŠžŠ(ÊSs0]0n0>muSO)k0SBdW0f0qbF0n0g0o0j0O0 ÿ¹0¯0ê0×0È0ÊSs0ŠžŠ’0 T!kCQg0qbF0n0L0iS_j04XT ÿŠžŠ^\'`h0 TØik0¹0¯0ê0×0È0^\'`L0X[(WY0Œ0p0 g(u`0h0`F0K0‚0W0Œ0j0D00ê0ó0¯0‰ }k0J0D0f0 ÿÂSgqU0Œ0_0ÈSo0ê0ó0¯0U0Œ0_0ê0½0ü0¹0k0J0Q0‹0(;N‰j0)ŠžŠ(4XTk0ˆ0c0f0o0‰pe)’0hˆY0‰ }’0š[©Y0‹0n0‚0g~0W0D00W0K0W0 ÿS0Œ0‰0n0&application;o0 ÿS0n0&TR-or-Rec;L0‰š[Y0‹0Ä{òVYh0Y0‹00--> </div2> </div1> <!-- &Elements; --> <div1 id='sec-logical-struct'> <head>ÖŠtËi </head> <p><termdef id="dt-element" term="Element">D0K0j0‹0<termref def="dt-xml-doc">XML‡eøf</termref>‚0 ÿNd0åN Nn0<term>‰ }</term>’0+T€00‰ }n0ƒXLuo0, <termref def="dt-stag">‹•ËY¿0°0</termref>ÊSs0<termref def="dt-etag">B}†N¿0°0</termref>k0ˆ0c0f0:SR‹00‰ }L0<termref def="dt-empty">zz</termref>‰ }n0h0M0o0 ÿ<termref def="dt-eetag">zz‰ }¿0°0</termref>g0:yY00T0n0‰ }o0 ÿ‹W’0‚0d00‰ }‹Wo0 TMR(qQ&identifier;(generic identifier)ÈSo0GIh0|Tv0S0h0L0B0‹00)k0ˆ0c0f0&identified;0‰ }o0 ÿD0O0d0K0n0^\'`’0‚0d0S0h0L0g0M0‹00</termdef>^\'`o0 ÿ<termref def="dt-attrname"> TMR</termref>ÊSs0<termref def="dt-attrval">$P</termref>’0‚0d00</p> <scrap lang='ebnf'><head>‰ }</head> <prod id='NT-element'><lhs>element</lhs> <rhs><nt def='NT-EmptyElemTag'>EmptyElemTag</nt></rhs> <rhs>| <nt def='NT-STag'>STag</nt> <nt def='NT-content'>content</nt> <nt def='NT-ETag'>ETag</nt></rhs><wfc def='GIMatch'/></prod> </scrap> <p>S0n0&TR-or-Rec;o0 ÿ‰ }‹WÊSs0^\'`n0asT ÿO(u¹eÕl ÿÈSo0(Ëi‡ek0¢•Y0‹0S0h0’0d–M0) TMRk06R}’0NH0j0D00_0`0W0 ÿHQ-˜L0<code>(('X'|'x')('M'|'m')('L'|'l'))</code>k0&match;Y0‹0 TMRo0 ÿS0n0HrÈSo0ÊNŒ_n0Hrn0S0n0&TR-or-Rec;g0n0j–nSn0_00k0ˆN}Y0‹00</p> <wfcnote id='GIMatch'><head>‰ }‹Wn0&match;</head> <p>‰ }n0B}†N¿0°0n0<nt def='NT-Name'> TMR</nt>o0 ÿ]0n0‰ }n0‹•ËY¿0°0k0J0Q0‹0‹Wh0&match;W0j0Q0Œ0p0j0‰0j0D00</p> </wfcnote> <div2 id='sec-starttags'> <head>‹•ËY¿0°0 ÿB}†N¿0°0ÊSs0zz‰ }¿0°0</head> <p><termdef id="dt-stag" term="Start-Tag">zzg0j0D0ûNan0XML‰ }n0ËY~0Š0o0 ÿ<term>‹•ËY¿0°0</term>k0ˆ0c0f0&markup;Y0‹00 <scrap lang='ebnf'><head>‹•ËY¿0°0</head> <prodgroup pcw2="6" pcw4="15" pcw5="11.5"> <prod id='NT-STag'><lhs>STag</lhs><rhs>'&lt;' <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Attribute'>Attribute</nt>)* <nt def='NT-S'>S</nt>? '>'</rhs><wfc def="uniqattspec"/></prod> <prod id='NT-Attribute'><lhs>Attribute</lhs><rhs><nt def='NT-Name'>Name</nt> <nt def='NT-Eq'>Eq</nt> <nt def='NT-AttValue'>AttValue</nt></rhs><vc def='ValueType'/><wfc def='NoExternalRefs'/><wfc def='CleanAttrVals'/></prod> </prodgroup> </scrap> ‹•ËY¿0°0ÊSs0B}†N¿0°0…Qn0<nt def='NT-Name'>Name</nt>o0 ÿ‰ }n0<term>‹W</term>’0hˆ0Y00</termdef><termdef id="dt-attr" term="Attribute"><nt def='NT-Name'>Name</nt>ÊSs0<nt def='NT-AttValue'>AttValue</nt>n0þ[’0‰ }n0<term>^\'`cš[</term>h0D0D0</termdef> ÿ<termdef id="dt-attrname" term="Attribute Name"> P0n0þ[k0J0Q0‹0<nt def='NT-Name'>Name</nt>o0 ÿ<term>^\'` T</term></termdef>ÊSs0<termdef id="dt-attrval" term="Attribute Value"><nt def='NT-AttValue'>AttValue</nt>n0…Q¹[(:SRŠ0P[<code>'</code>ÈSo0<code>"</code>n0“•n0&string;)’0<term>^\'`$P</term>h0D0F00</termdef></p> <wfcnote id='uniqattspec'><head>^\'`cš[n0Na'`</head> <p>‹•ËY¿0°0ÈSo0zz‰ }¿0°0g0o0 ÿ TNn0^\'` TL0ÿ¦^åN NúQþsW0f0o0j0‰0j0D00</p></wfcnote> <vcnote id='ValueType'><head>^\'`$Pn0‹W</head> <p>^\'`o0£[ŠU0Œ0f0D0j0Q0Œ0p0j0‰0j0D00^\'`$Pn0‹Wo0 ÿ]0n0^\'`k0þ[W0f0£[ŠW0_0‹Wg0j0Q0Œ0p0j0‰0j0D0(^\'`n0‹Wk0d0D0f0o0 ÿ<titleref href='AttDecls'>^\'`ê0¹0È0£[Š</titleref>k0d0D0f0n0‰š[’0ÂSgq0)0</p></vcnote> <wfcnote id='NoExternalRefs'><head>YèŸ[SOx0n0ÂSgqL0j0D0S0h0</head> <p>^\'`$Pk0o0 ÿYèŸ[SOx0n0ôv¥c„vÈSo0“•¥c„vj0ÂSgq’0+T€0S0h0o0g0M0j0D00</p></wfcnote> <wfcnote id='CleanAttrVals'><head>^\'`$Pk0<code>&lt;</code>’0+T~0j0D0S0h0</head> <p>^\'`$P…Qg0ôv¥c„vÈSo0“•¥c„vk0ÂSgqY0‹0Ÿ[SO(<code>&amp;lt;</code>’0d–O00)n0<termref def='dt-repltext'>&replacement-text;</termref>k0o0 ÿ<code>&lt;</code>’0+T“0g0o0j0‰0j0D00</p></wfcnote> <p>‹•ËY¿0°0n0‹O’0 ÿ!kk0:yY00 <eg>&lt;termdef id="dt-dog" term="dog"></eg></p> <p><termdef id="dt-etag" term="End Tag">‹•ËY¿0°0g0ËY~0‹0‰ }n0B}0Š0o0 ÿ<term>B}†N¿0°0</term>g0&markup;W0j0Q0Œ0p0j0‰0j0D00S0n0B}†N¿0°0o0 ÿþ[Ü_Y0‹0‹•ËY¿0°0n0‰ }‹Wh0 TX0 TMR’0‚0d00 <scrap lang='ebnf'><head>B}†N¿0°0</head><prodgroup pcw2="6" pcw4="15" pcw5="11.5"><prod id='NT-ETag'><lhs>ETag</lhs><rhs>'&lt;/' <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt>? '>'</rhs></prod></prodgroup></scrap></termdef></p> <p>B}†N¿0°0n0‹O’0 ÿ!kk0:yY00 <eg>&lt;/termdef></eg></p> <p><termdef id="dt-content" term="Content">‰ }n0‹•ËY¿0°0h0B}†N¿0°0h0n0“•n0<termref def='dt-text'>Æ0­0¹0È0</termref>’0 ÿ]0n0‰ }n0<term>…Q¹[</term>h0D0F00 <scrap lang='ebnf'><head>‰ }n0…Q¹[</head> <prodgroup pcw2="6" pcw4="15" pcw5="11.5"><prod id='NT-content'><lhs>content</lhs><rhs>(<nt def='NT-element'>element</nt> | <nt def='NT-CharData'>CharData</nt> | <nt def='NT-Reference'>Reference</nt> | <nt def='NT-CDSect'>CDSect</nt> | <nt def='NT-PI'>PI</nt> | <nt def='NT-Comment'>Comment</nt>)*</rhs></prod></prodgroup></scrap></termdef></p> <p><termdef id="dt-empty" term="Empty">‰ }L0<term>zz</term>n0h0M0 ÿ]0n0‰ }o0 ÿôvŒ_k0B}†N¿0°0’0‚0d0‹•ËY¿0°0ÈSo0zz‰ }¿0°0g0hˆþsW0j0Q0Œ0p0j0‰0j0D00</termdef><termdef id="dt-eetag" term="empty-element tag"><term>zz‰ }¿0°0</term>o0 ÿ!kn0yr%Rj0b__’0h0‹00 <scrap lang='ebnf'><head>zz‰ }n0_00n0¿0°0</head><prodgroup pcw2="6" pcw4="15" pcw5="11.5"><prod id='NT-EmptyElemTag'><lhs>EmptyElemTag</lhs><rhs>'&lt;' <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Attribute'>Attribute</nt>)* <nt def='NT-S'>S</nt>? '/&gt;'</rhs><wfc def="uniqattspec"/></prod></prodgroup></scrap></termdef></p> <!-- €•¬™ÿ Nn0 zz‰ }n0_00n0¿0°0(tags for empty elements) o0 zz‰ }¿0°0(empty-element tag) h0Y0y0M0`0h0`D0~0Y0L0 ÿD0K0L0g0W0‡0F0K0 --> <p>zz‰ }¿0°0o0 ÿ…Q¹[’0‚0_0j0D0ûNan0‰ }n0hˆþsk0)R(ug0M0‹00zz‰ }¿0°0g0hˆþsY0‹0‰ }’0 ÿ­0ü0ï0ü0É0<kw>EMPTY</kw>’0(uD0f0£[ŠW0j0O0h0‚0ˆ0D00</p> <p>zz‰ }n0‹O’0 ÿ!kk0:yY00 <eg>&lt;IMG align="left" src="http://www.w3.org/Icons/WWW/w3c_home" />&lt;br>&lt;/br>&lt;br/></eg></p> </div2> <div2 id='elemdecls'><head>‰ }£[Š</head> <p><termref def="dt-valid">&validity;</termref>’0ÝO<ŠY0‹0_00 ÿ‰ }£[ŠÊSs0^\'`ê0¹0È0£[Š’0(uD0f0<termref def="dt-xml-doc">XML‡eøf</termref>n0<termref def="dt-element">‰ }</termref>n0Ëi k0 ÿ6R}’0 RH0‹0S0h0L0g0M0‹00</p> <p>‰ }£[Šo0 ÿ‰ }n0<termref def="dt-content">…Q¹[</termref>k0d0D0f0n06R}h0Y0‹00</p> <p>‰ }£[Šo0 ÿ‰ }n0<termref def="dt-parentchild">P[</termref>h0W0f0úQþsïSý€j0‰ }‹Wk0d0D0f0 ÿ6R}’0 RH0‹0S0h0L0YD00&at-user-option; ÿ‰ }£[Š’0‚0_0j0D0‰ }‹WL0ÖNn0‰ }£[Šk0ˆ0c0f0ÂSgqU0Œ0Œ0p0 ÿXML&processor;o0 ÿf‹JT’0úQW0f0‚0ˆ0D00W0K0W0 ÿS0Œ0o0&error;h0o0W0j0D00</p> <p><termdef id="dt-eldecl" term="Element Type declaration"><term>‰ }‹W£[Š</term>o0 ÿ!kn0b__’0h0‹00 <scrap lang='ebnf'><head>‰ }‹W£[Š</head><prodgroup pcw2="5.5" pcw4="18" pcw5="9"> <prod id='NT-elementdecl'><lhs>elementdecl</lhs> <rhs>'&lt;!ELEMENT' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> <nt def='NT-contentspec'>contentspec</nt> <nt def='NT-S'>S</nt>? '>'</rhs> <vc def='EDUnique'/></prod> <prod id='NT-contentspec'><lhs>contentspec</lhs> <rhs>'EMPTY' | 'ANY' | <nt def='NT-Mixed'>Mixed</nt> | <nt def='NT-children'>children</nt> </rhs> <vc def='elementvalid'/> </prod> </prodgroup> </scrap> S0S0g0 ÿ<nt def='NT-Name'>Name</nt>o0 ÿ£[ŠU0Œ0f0D0‹0‰ }n0‹Wh0Y0‹00</termdef></p> <vcnote id='EDUnique'><head>‰ }£[Šn0Na'`</head> <p>‰ }‹W’0ÿ¦^åN N£[Šg0M0j0D00</p></vcnote> <vcnote id='elementvalid'><head>‰ }n0&validity;</head> <p>‰ }L0<!-- said to be -->&valid;h0o0 ÿ<nt def='NT-elementdecl'>elementdecl</nt>k0&match;Y0‹0£[Šg0B0c0f0 ÿ]0n0<nt def='NT-Name'>Name</nt>L0]0n0‰ }‹Wh0&match;W0 ÿ!kn0D0Z0Œ0K0n0agöN’0€n_0Y04XTh0Y0‹00<ulist> <item><p>a) £[ŠL0<kw>EMPTY</kw>k0&match;W0 ÿ‰ }L0<termref def='dt-content'>…Q¹[</termref>’0‚0_0j0D00</p></item> <item><p>b) £[ŠL0<nt def='NT-children'>children</nt>k0&match;W0 ÿ‰ }n0<termref def="dt-parentchild">P[‰ }</termref>n0&Ns0L0 ÿ…Q¹[â0Ç0ë0n0ck‰hˆþsk0ˆ0c0f0ubU0Œ0‹0ŠžŠk0^\Y0‹00</p></item> <item><p>c) £[ŠL0<nt def='NT-Mixed'>mixed</nt>k0&match;W0 ÿ‰ }n0…Q¹[L0<termref def='dt-chardata'>‡eW[Ç0ü0¿0</termref>ÊSs0<termref def='dt-parentchild'>P[‰ }</termref>K0‰0j0‹00P[‰ }n0‰ }‹Wo0 ÿ‰ }n0…Q¹[â0Ç0ë0k0úQþsY0‹0 TMRk0&match;Y0‹00</p></item> <item><p>d) £[ŠL0<kw>ANY</kw>k0&match;W0 ÿi0n0<termref def='dt-parentchild'>P[‰ }</termref>n0‰ }‹W‚0£[ŠU0Œ0f0D0‹00</p></item></ulist> </p></vcnote> <!-- with the new VC, I don't think the next few paras add anything -TWB <p><termdef id="dt-model" term="content model">An element can declared using a <term>content model</term>, in which case its content can be categorized as <termref def="dt-elemcontent">element content</termref> or <termref def='dt-mixed'>mixed content</termref>, as explained below.</termdef></p> <p>An element whose type declared using the keyword <kw>EMPTY</kw> must be <termref def="dt-empty">empty</termref> and may be tagged using an <termref def="dt-eetag">empty-element tag</termref> when it appears in the document.</p> <p>If an element type is declared using the keyword <kw>ANY</kw>, then there are no validity constraints on its content: it may contain <termref def='dt-parentchild'>child elements</termref> of any type and number, interspersed with character data.</p> --> <p>‰ }£[Šn0‹O’0 ÿ!kk0:yY00 <eg> &lt;!ELEMENT br EMPTY> &lt;!ELEMENT p (#PCDATA|emph)* > &lt;!ELEMENT %name.para; %content.para; > &lt;!ELEMENT container ANY> </eg></p> <div3 id='sec-element-content'><head>‰ }…Q¹[</head> <p><termdef id='dt-elemcontent' term='Element content'>B0‹0‹Wn0‰ }L0<termref def='dt-parentchild'>P[</termref>‰ }`0Q0’0+T€0(‡eW[Ç0ü0¿0’0+T~0j0D00)h0M0 ÿ]0n0‰ }<termref def="dt-stag">‹W</termref>o0 ÿ<term>‰ }…Q¹[</term>’0‚0d0 ÿh0D0F00</termdef>S0n04XT ÿ6R}o0 ÿ…Q¹[â0Ç0ë0’0+T€00…Q¹[â0Ç0ë0o0 ÿP[‰ }n0‹WÊSs0P[‰ }n0úQþs˜^’06R¡_Y0‹0!|XSj0‡eÕlh0Y0‹00S0n0‡eÕlo0 ÿ&content-particle;(<nt def='NT-cp'>cp</nt>s)K0‰0j0‹00&content-particle;o0 ÿ TMR ÿ&content-particle;n0xžbê0¹0È0ÈSo0&content-particle;n0Rê0¹0È0K0‰0ËibU0Œ0‹00 <scrap lang='ebnf'><head>‰ }…Q¹[â0Ç0ë0</head><prodgroup pcw2="5.5" pcw4="16" pcw5="11"> <prod id='NT-children'><lhs>children</lhs><rhs>(<nt def='NT-choice'>choice</nt> | <nt def='NT-seq'>seq</nt>) ('?' | '*' | '+')?</rhs></prod><prod id='NT-cp'><lhs>cp</lhs><rhs>(<nt def='NT-Name'>Name</nt> | <nt def='NT-choice'>choice</nt> | <nt def='NT-seq'>seq</nt>) ('?' | '*' | '+')?</rhs></prod> <prod id='NT-choice'><lhs>choice</lhs><rhs>'(' <nt def='NT-S'>S</nt>? cp ( <nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def='NT-cp'>cp</nt> )*<nt def='NT-S'>S</nt>? ')'</rhs><vc def='vc-PEinGroup'/></prod> <prod id='NT-seq'><lhs>seq</lhs><rhs>'(' <nt def='NT-S'>S</nt>? cp ( <nt def='NT-S'>S</nt>? ',' <nt def='NT-S'>S</nt>? <nt def='NT-cp'>cp</nt> )*<nt def='NT-S'>S</nt>? ')'</rhs><vc def='vc-PEinGroup'/></prod> <!-- <prod id='NT-cps'><lhs>cps</lhs><rhs><nt def='NT-S'>S</nt>? <nt def='NT-cp'>cp</nt> <nt def='NT-S'>S</nt>?</rhs></prod> <prod id='NT-choice'><lhs>choice</lhs><rhs>'(' <nt def='NT-S'>S</nt>? <nt def='NT-ctokplus'>ctokplus</nt> (<nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def='NT-ctoks'>ctoks</nt>)* <nt def='NT-S'>S</nt>? ')'</rhs></prod> <prod id="NT-ctokplus"><lhs>ctokplus</lhs><rhs><nt def="NT-cps">cps</nt>('|' <nt def="NT-cps">cps</nt>)+</rhs></prod> <prod id="NT-ctoks"><lhs>ctoks</lhs><rhs><nt def="NT-cps">cps</nt>('|' <nt def="NT-cps">cps</nt>)*</rhs></prod> <prod id='NT-seq'><lhs>seq</lhs><rhs>'(' <nt def='NT-S'>S</nt>?<nt def='NT-stoks'>stoks</nt> (<nt def='NT-S'>S</nt>? ',' <nt def='NT-S'>S</nt>? <nt def='NT-stoks'>stoks</nt>)*<nt def='NT-S'>S</nt>? ')'</rhs></prod> <prod id="NT-stoks"><lhs>stoks</lhs><rhs><nt def="NT-cps">cps</nt>(',' <nt def="NT-cps">cps</nt>)*</rhs></prod> --> </prodgroup></scrap> S0S0g0 ÿ<nt def='NT-Name'>Name</nt>o0 ÿ<termref def="dt-parentchild">P[</termref>h0W0f0úQþsW0f0ˆ0D0‰ }n0‹W’0:yY00S0n0‡eÕlg0xžbê0¹0È0L0þsŒ0‹0MOng0o0 ÿxžbê0¹0È0…Qn0D0Z0Œ0n0&content-particle;‚0<termref def="dt-elemcontent">‰ }…Q¹[</termref>n0-Nk0þsŒ0f0ˆ0D00Rê0¹0È0k0þsŒ0‹0&content-particle;o0 ÿê0¹0È0g0cš[Y0‹0˜jun0h0J0Š0k0 ÿ<termref def="dt-elemcontent">‰ }…Q¹[</termref>k0þsŒ0j0Q0Œ0p0j0‰0j0D00 TMRÈSo0ê0¹0È0n0Œ_k0úQþsY0‹0ª0×0·0ç0ó0n0‡eW[<!-- €•¬™ÿcharacter’0‡eW[h03ŠW0~0W0_0 -->o0 ÿê0¹0È0…Qn0‰ }ÈSo0&content-particle;L0 ÿ1ÞVåN NûNan0ÞVpe(<code>+</code>) ÿ0ÞVåN NûNan0ÞVpe(<code>*</code>)ÈSo00ÞVå‚W0O0o01ÞV(<code>?</code>)úQþsïSý€j0S0h0’0‰š[Y0‹00S0S0g0:yY0Ëi‡eÊSs0asTo0 ÿS0n0&TR-or-Rec;k0J0Q0‹0ub‰GRg0(uD0‹0‚0n0h0 TNh0Y0‹00</p> <!-- €•¬™ÿ Nn0‡eg0o0 ÿ nameÈSo0listn0Œ_k0š}O0‡eW[ L0 listn0úQþs’0‰š[Y0‹0 h0B0c0f0 ÿnamen0úQþs’0‰š[Y0‹0h0o0øfD0f0B0Š0~0[0“00îOckL0Å_‰h0€H0~0Y00 --> <p>‰ }n0…Q¹[L0…Q¹[â0Ç0ë0k0&match;Y0‹0n0o0 ÿR ÿxžbÊSs0p~ÔW0o—{P[k0W0_0L0c0f0 ÿ…Q¹[n0-Nn0‰ }h0…Q¹[â0Ç0ë0…Qn0‰ }‹Wh0’0&match;U0[0j0L0‰0 ÿ…Q¹[â0Ç0ë0…Qn0Nd0n0Ñ0¹0’0_0i0Œ0‹0h0M0k0P–‹00<termref def='dt-compat'>’NÛc'`n0_00</termref> ÿ‡eøf…Qn0‰ }L0 ÿ…Q¹[â0Ç0ë0k0J0Q0‹0‰ }‹Wn0‰pen0úQþsMOnh0&match;Y0‹0S0h0o0 ÿ&error;h0Y0‹00sŠ0}j0‰š[k0d0D0f0o0 ÿD–^\øfn0<titleref xml-link="simple" href="determinism">zlš[„v…Q¹[â0Ç0ë0</titleref>n0˜’0ÂSgq0 <!-- appendix <specref ref="determinism"/>. --> <!-- appendix on deterministic content models. --> </p> <vcnote id='vc-PEinGroup'> <head>°0ë0ü0×0ÊSs0Ñ0é0á0¿0Ÿ[SOL0³SÆ[j0eQŒ0P[’0j0W0f0D0‹0S0h0</head> <p>Ñ0é0á0¿0Ÿ[SOn0<termref def='dt-repltext'>&replacement-text;</termref>o0 ÿ&parenthesis;g0òV~0Œ0_0°0ë0ü0×0k0ˆ0c0f0 ÿ³SÆ[j0eQŒ0P[’0ËibW0j0Q0Œ0p0j0‰0j0D00d0~0Š0 ÿ<nt def='NT-choice'>xžb</nt> ÿ<nt def='NT-seq'>R</nt>ÈSo0<nt def='NT-Mixed'>÷m(W</nt>èÁTk0 ÿ&left-parenthesis;ÈSo0&right-parenthesis;n0D0Z0Œ0K0N¹eL0<termref def='dt-PERef'>Ñ0é0á0¿0Ÿ[SO</termref>n0&replacement-text;k0+TŒ0Œ0p0 ÿÖN¹e‚0 TX0&replacement-text;k0+T~0Œ0j0Q0Œ0p0j0‰0j0D00</p> <p><termref def='dt-interop'>øv’NK(u'`n0_00</termref> ÿÑ0é0á0¿0Ÿ[SOÂSgqL0<nt def='NT-choice'>xžb</nt> ÿ<nt def='NT-seq'>R</nt>ÈSo0<nt def='NT-Mixed'>÷m(W</nt>…Q¹[k0+T~0Œ0Œ0p0 ÿ]0n0&replacement-text;o0zzg0j0D0S0h0L0g~0W0O0 ÿ&replacement-text;n0HQ-˜ÊSs0+g>\n0zz}vg0j0D0‡eW[o0 ÿ³0Í0¯0¿0(<code>|</code>ÈSo0<code>,</code>)g0j0D0¹eL0ˆ0D00 </p> </vcnote> <p>‰ }…Q¹[â0Ç0ë0n0D0O0d0K0n0‹O’0 ÿ!kk0:yY00 <eg>&lt;!ELEMENT spec (front, body, back?)> &lt;!ELEMENT div1 (head, (p | list | note)*, div2*)> &lt;!ELEMENT dictionary-body (%div.mix; | %dict.mix;)*></eg></p> </div3> <div3 id='sec-mixed-content'> <head>&mixed-content;</head> <p><termdef id='dt-mixed' term='Mixed Content'>B0‹0‰ }‹Wn0‰ }…Qk0 ÿ<termref def="dt-parentchild">P[</termref>‰ }k0÷m(WW0f0‡eW[Ç0ü0¿0L0+T~0Œ0‹0ïSý€'`L0B0‹0h0M0 ÿ]0n0‰ }<termref def='dt-stag'>‹W</termref>o0 ÿ<term>&mixed-content;</term>’0‚0d0h0D0F00</termdef>S0n04XT ÿP[‰ }n0‹Wk0d0D0f0n06R}L0X[(WW0f0‚0ˆ0D0<!-- €•¬™ÿ may be constrained ’0XSk0 06R}U0Œ0‹0 0h03ŠW0~0W0_00 -->L0 ÿP[‰ }n0˜^ÈSo0úQþsÞVpek0d0D0f0n06R}o0j0D0h0Y0‹00 <scrap lang='ebnf'> <head>&mixed-content;£[Š</head> <prodgroup pcw2="5.5" pcw4="16" pcw5="11"> <prod id='NT-Mixed'><lhs>Mixed</lhs> <rhs>'(' <nt def='NT-S'>S</nt>? '#PCDATA' (<nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def='NT-Name'>Name</nt>)* <nt def='NT-S'>S</nt>? ')*' </rhs> <rhs>| '(' <nt def='NT-S'>S</nt>? '#PCDATA' <nt def='NT-S'>S</nt>? ')' </rhs><vc def='vc-PEinGroup'/> <vc def='vc-MixedChildrenUnique'/> </prod> <!-- <prod id="NT-Mtoks"><lhs>Mtoks</lhs> <rhs><nt def="NT-Name">Name</nt> (<nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def="NT-Name">Name</nt>)* </rhs> </prod> --> </prodgroup> </scrap> S0S0g0 ÿ<nt def='NT-Name'>Name</nt>o0 ÿP[h0W0f0úQþsW0f0‚0ˆ0D0‰ }n0‹W’0:yY00 </p> <vcnote id='vc-MixedChildrenUnique'> <head>‰ }‹Wn0Í‘‰n0ybk</head> <p>Nd0n0&mixed-content;£[Š…Qk0 ÿ TX0 TMRL0‰peÞVúQþsW0f0o0j0‰0j0D00 </p></vcnote> <p>&mixed-content;£[Šn0‹O’0 ÿ!kk0:yY00 <eg>&lt;!ELEMENT p (#PCDATA|a|ul|b|i|em)*> &lt;!ELEMENT p (#PCDATA | %font; | %phrase; | %special; | %form;)* > &lt;!ELEMENT b (#PCDATA)></eg></p> </div3> </div2> <div2 id='attdecls'> <head>^\'`ê0¹0È0£[Š</head> <p> <termref def="dt-attr">^\'`</termref>o0 ÿ TMRÊSs0$Pn0þ[’0<termref def="dt-element">‰ }</termref>k0¢•#ØNQ0‹0_00k0(uD0‹00^\'`cš[o0 ÿ<termref def="dt-stag">‹•ËY¿0°0</termref>ÈSo0<termref def="dt-eetag">zz‰ }</termref>¿0°0…Qg0`0Q0ïSý€h0Y0‹00W0_0L0c0f0 ÿ^\'`’0ŠX‹Y0‹0_00n0ub‰GRo0 ÿ<titleref href='sec-starttags'>‹•ËY¿0°0</titleref>k0d0D0f0n0‰š[g0:yY00^\'`ê0¹0È0£[Šo0 ÿ!kn0îv„vg0(uD0‹00 <ulist> <item><p>a) B0‹0‰ }‹Wk0i(uY0‹0^\'`n0Æ–T’0‰š[Y0‹00</p></item> <item><p>b) ^\'`x0n0‹W6R}’0-Šš[Y0‹00</p></item> <item><p>c) ^\'`n0<termref def="dt-default">&default-value;</termref>’0‰š[Y0‹00</p></item> </ulist> </p> <p> <termdef id="dt-attdecl" term="Attribute-List Declaration"> <term>^\'`ê0¹0È0£[Š</term>o0 ÿB0‹0‰ }‹Wh0¢•#ØNQ0‰0Œ0_0T^\'`k0þ[W0 ÿ TMR ÿÇ0ü0¿0‹WÊSs0(X[(WY0Œ0p0)&default-value;’0‰š[Y0‹00 <scrap lang='ebnf'> <head>^\'`ê0¹0È0£[Š</head> <prod id='NT-AttlistDecl'><lhs>AttlistDecl</lhs> <rhs>'&lt;!ATTLIST' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-AttDef'>AttDef</nt>* <nt def='NT-S'>S</nt>? '&gt;'</rhs> </prod> <prod id='NT-AttDef'><lhs>AttDef</lhs> <rhs><nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> <nt def='NT-AttType'>AttType</nt> <nt def='NT-S'>S</nt> <nt def='NT-Default'>Default</nt></rhs> </prod> </scrap> <nt def='NT-AttlistDecl'>AttlistDecl</nt>‰GRk0X[(WY0‹0<nt def="NT-Name">Name</nt>o0 ÿ‰ }‹Wn0 TMRh0Y0‹00&at-user-option; ÿ£[ŠW0f0D0j0D0‰ }‹Wk0þ[W0^\'`’0£[ŠW0_0j0‰0p0 ÿXML&processor;o0 ÿf‹JT’0úQW0f0‚0ˆ0D00W0K0W0 ÿS0Œ0o0&error;h0o0W0j0D00 <nt def='NT-AttDef'>AttDef</nt>‰GRk0J0Q0‹0<nt def='NT-Name'>Name</nt>o0 ÿ^\'`n0 TMRh0Y0‹00 </termdef> </p> <p> B0‹0‰ }k0þ[W0f0 ÿ‰pen0<nt def='NT-AttlistDecl'>AttlistDecl</nt>’0NH0‹04XT ÿS0Œ0‰0Y0y0f0n0…Q¹[o0Þ0ü0¸0Y0‹00B0‹0‰ }‹Wn0 TX0^\'`k0 ÿ‰pen0š[©’0NH0‹04XTk0o0 ÿgRn0£[Š’0 g¹Rh0W0 ÿÖNn0£[Šo0!q–‰Y0‹00<termref def='dt-interop'>øv’NK(u'`n0_00k0</termref> ÿDTDn0\Ob€o0 ÿB0‹0‰ }‹Wk0o0Øš0Nd0n0^\'`ê0¹0È0£[ŠW0K0NH0j0D0 ÿB0‹0^\'` Tk0o0Øš0Nd0n0^\'`š[©W0K0NH0j0D0 ÿÊSs0Y0y0f0n0^\'`ê0¹0È0£[Šk0o0\j0O0h0‚0Nd0n0^\'`š[©’0NH0‹0 ÿh0D0F0xžb’0W0f0‚0ˆ0D00øv’NK(u'`n0_00k0 ÿXML&processor;o0 ÿ&at-user-option; ÿB0‹0‰ }‹Wk0‰pen0^\'`ê0¹0È0£[Š’0NH0_0Š0 ÿB0‹0^\'`k0‰pen0^\'`š[©’0NH0_0Š0W0_0h0M0k0 ÿf‹JT’0úQW0f0‚0ˆ0D00W0K0W0 ÿS0Œ0o0 ÿ&error;h0o0W0j0D00 </p> <div3 id='sec-attribute-types'> <head>^\'`n0‹W</head> <p> XMLn0^\'`n0‹Wo0 ÿÿ.z^˜h0Y0‹00S0Œ0‰0o0 ÿ&string;‹W ÿ&token;S‹WÊSs0Rc‹Wh0Y0‹00&string;‹Wo0 ÿ$Ph0W0f0ûNan0&string;’0h0‹00&token;S‹Wo0 ÿ!kk0:yY0W[åSÊSs0asTk0¢•Y0‹0Øi0j06R}’0‚0d00 <scrap lang='ebnf'> <head>Attribute Types</head> <prodgroup pcw4="14" pcw5="11.5"> <prod id='NT-AttType'><lhs>AttType</lhs> <rhs><nt def='NT-StringType'>StringType</nt> | <nt def='NT-TokenizedType'>TokenizedType</nt> | <nt def='NT-EnumeratedType'>EnumeratedType</nt> </rhs> </prod> <prod id='NT-StringType'><lhs>StringType</lhs> <rhs>'CDATA'</rhs> </prod> <prod id='NT-TokenizedType'><lhs>TokenizedType</lhs> <rhs>'ID'</rhs> <vc def='id'/> <vc def='one-id-per-el'/> <vc def='id-default'/> <rhs>| 'IDREF'</rhs> <vc def='idref'/> <rhs>| 'IDREFS'</rhs> <vc def='idref'/> <rhs>| 'ENTITY'</rhs> <vc def='entname'/> <rhs>| 'ENTITIES'</rhs> <vc def='entname'/> <rhs>| 'NMTOKEN'</rhs> <vc def='nmtok'/> <rhs>| 'NMTOKENS'</rhs> <vc def='nmtok'/></prod> </prodgroup> </scrap> </p> <vcnote id='id' > <head>ID</head> <p> S0n0‹Wn0$Po0 ÿub‰GR<code>Name</code>k0&match;W0j0Q0Œ0p0j0‰0j0D00Nd0n0XML‡eøf…Qg0o0 ÿNd0n0 TMRL0 ÿS0n0‹Wn0$Ph0W0f0‰peÞVþsŒ0f0o0j0‰0j0D00d0~0Š0 ÿIDn0$Po0 ÿ‰ }’0Nak0&identify;W0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <vcnote id='one-id-per-el'> <head>1‰ }T0h0k01ID</head> <p> ‰ }‹Wo0 ÿ‰pen0ID^\'`$P’0‚0c0f0o0j0‰0j0D00 </p> </vcnote> <vcnote id='id-default'> <head>ID^\'`n0&default;</head> <p> ID^\'`o0 ÿ&default;h0W0f0 ÿ<code>#IMPLIED</code>ÈSo0<code>#REQUIRED</code>’0£[ŠW0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <vcnote id='idref'> <head>IDREF</head> <p> <kw>IDREF</kw>‹Wn0$Po0 ÿub‰GR<nt def="NT-Name">Name</nt>k0&match;W0j0Q0Œ0p0j0‰0j0D00<kw>IDREFS</kw>‹Wn0$Po0 ÿub‰GR<nt def="NT-Names">Names</nt>k0&match;W0j0Q0Œ0p0j0‰0j0D00T0n0<nt def='NT-Name'>Name</nt>o0 ÿXML‡eøf…Qk0X[(WY0‹0‰ }n0ID^\'`n0$Ph0&match;W0j0Q0Œ0p0j0‰0j0D00d0~0Š0 ÿ<kw>IDREF</kw>n0$Po0 ÿB0‹0ID^\'`n0$Ph0&match;W0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <vcnote id='entname'> <head>Ÿ[SO T</head> <p> <kw>ENTITY</kw>‹Wn0$Po0 ÿub‰GR<nt def="NT-Name">Name</nt>k0&match;W0j0Q0Œ0p0j0‰0j0D00<kw>ENTITIES</kw>‹Wn0$Po0 ÿub‰GR<nt def="NT-Names">Names</nt>k0&match;W0j0Q0Œ0p0j0‰0j0D00T0n0<nt def="NT-Name">Name</nt>o0 ÿ<termref def="dt-doctype">DTD</termref>g0£[ŠY0‹0<termref def="dt-unparsed">&unparsed-entity;</termref>h0&match;W0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <vcnote id='nmtok'> <head> TMR&token;</head> <p> <kw>NMTOKEN</kw>‹Wn0$Po0 ÿ^—B}ïzŠ÷S<termref def="NT-Nmtoken">Nmtoken</termref>h0&match;Y0‹0&string;K0‰0ËibU0Œ0j0Q0Œ0p0j0‰0j0D00<kw>NMTOKENS</kw>‹Wn0$Po0 ÿ^—B}ïzŠ÷S<termref def="NT-Nmtokens">Nmtokens</termref>h0&match;Y0‹0&string;K0‰0ËibU0Œ0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <p> XML&processor;o0 ÿ&application;k0^\'`$P’0!nY0MRk0 ÿ<titleref href="AVNormalize">^\'`$Pn0ck‰S</titleref>g0‰š[Y0‹0h0J0Š0k0 ÿ^\'`$P’0ck‰SW0j0Q0Œ0p0j0‰0j0D00 </p> <p> <termdef id='dt-enumerated' term='Enumerated Attribute Values'><term>Rc‹Wn0^\'`</term>o0 ÿ£[ŠW0_0$Pn0Nd0’0ÖS‹0S0h0L0g0M0‹00</termdef>Rc‹Wk0o0 ÿ2.z^˜B0‹00 <scrap lang='ebnf'> <head>Rc^\'`n0‹W</head> <prod id='NT-EnumeratedType'><lhs>EnumeratedType</lhs> <rhs><nt def='NT-NotationType'>NotationType</nt> | <nt def='NT-Enumeration'>Enumeration</nt> </rhs></prod> <prod id='NT-NotationType'><lhs>NotationType</lhs> <rhs>'NOTATION' <nt def='NT-S'>S</nt> '(' <nt def='NT-S'>S</nt>? <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt>? '|' <nt def='NT-Name'>Name</nt>)* <nt def='NT-S'>S</nt>? ')' </rhs> <vc def='notatn' /></prod> <prod id='NT-Enumeration'><lhs>Enumeration</lhs> <rhs>'(' <nt def='NT-S'>S</nt>? <nt def='NT-Nmtoken'>Nmtoken</nt> (<nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def='NT-Nmtoken'>Nmtoken</nt>)* <nt def='NT-S'>S</nt>? ')'</rhs> <vc def='enum'/></prod> </scrap> </p> <vcnote id='notatn'> <head>ŠÕl^\'`</head> <p>S0n0‹Wn0$Po0 ÿ£[ŠW0f0D0‹0<titleref href='Notations'>ŠÕl</titleref>n0 TMRn0Nd0h0&match;W0j0Q0Œ0p0j0‰0j0D00d0~0Š0 ÿ£[Šk0X[(WY0‹0ŠÕl To0 ÿY0y0f0£[ŠU0Œ0f0D0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <vcnote id='enum'> <head>Rc</head> <p> S0n0‹Wn0$Po0 ÿ£[Šk0X[(WY0‹0<nt def='NT-Nmtoken'>Nmtoken</nt>&token;n0Nd0h0&match;W0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <p> <termref def='dt-interop'>øv’NK(u'`n0_00</termref> ÿ TX0<nt def='NT-Nmtoken'>Nmtoken</nt>o0 ÿXSN‰ }‹Wn0Rc‹Wn0^\'`h0W0f0 ÿ‰peÞVþsŒ0j0D0¹eL0ˆ0D00 </p> </div3> <div3 id='sec-attr-defaults'> <head>^\'`n0&default;</head> <p> <termref def="dt-attdecl">^\'`£[Š</termref>o0 ÿ^\'`n0cš[L0Å_˜K0i0F0K0k0d0D0f0n0Å`1X’0NH0‹00Å_˜g0j0D04XTk0o0 ÿ‡eøf…Qg0^\'`’0cš[W0j0D0h0M0 ÿXML&processor;n0æQt¹eÕln0Å`1X‚0NH0‹00 <scrap lang='ebnf'> <head>^\'`n0&default;</head> <prodgroup pcw4="14" pcw5="11.5"> <prod id='NT-Default'><lhs>Default</lhs> <rhs>'#REQUIRED' |&nbsp;'#IMPLIED' </rhs> <rhs>| (('#FIXED' S)? <nt def='NT-AttValue'>AttValue</nt>)</rhs> <vc def='defattrvalid'/> <wfc def="CleanAttrVals"/> </prod> </prodgroup> </scrap> <!-- improved by bosak <scrap lang='ebnf'> <head>Attribute Defaults</head> <prod id='NT-Default'><lhs>Default</lhs> <rhs>'#REQUIRED' |&nbsp;'#IMPLIED' </rhs> <vc def='defattrvalid'/> <wfc def="CleanAttrVals"/> <rhs>| (('#FIXED' S)? <nt def='NT-AttValue'>AttValue</nt>)</rhs> </prod> </scrap>--> </p> <vcnote id='defattrvalid'> <head>^\'`&default;n0ckW0U0</head> <p> £[ŠW0_0&default-value;o0 ÿ£[ŠW0_0^\'`‹Wn0W[åS6R}’0€n_0U0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <p> <kw>#REQUIRED</kw>’0cš[W0_0h0M0 ÿS0n0‰ }‹Wn0<termref def="dt-stag">‹•ËY¿0°0</termref>g0B0c0f0 ÿS0n0^\'`k0$P’0NH0j0D0‚0n0’0XML&processor;L0‹‰d0Q0_0j0‰0p0 ÿ]0n0‡eøfo0<termref def="dt-valid">&valid;</termref>h0o0W0j0D00<kw>#IMPLIED</kw>’0cš[W0_0h0M0 ÿS0n0^\'`’0weuW0_0‰0 ÿXML&processor;o0 ÿ^\'`$P’0cš[W0j0D0S0h0’0¢0×0ê0±0ü0·0ç0ó0k0OH0j0Q0Œ0p0j0‰0j0D00S0n0h0M0 ÿ&application;n0/c‚D0k0d0D0f0n06R}o0j0D00 </p> <p> <termdef id="dt-default" term="Attribute Default"> ^\'`L0<kw>#REQUIRED</kw>g0‚0<kw>#IMPLIED</kw>g0‚0j0D0h0M0k0o0 ÿ<nt def='NT-AttValue'>AttValue</nt>n0$PL0 ÿ<term>&default-value;</term>h0j0‹00<kw>#FIXED</kw>n04XT ÿ&default-value;h0puj0‹0$PL0cš[U0Œ0Œ0p0 ÿ]0n0‡eøfo0 ÿ<termref def="dt-valid">&valid;</termref>h0W0j0D00&default-value;’0£[ŠW0f0D0‹04XT ÿS0n0^\'`n0weu’0‹‰d0Q0_0‰0 ÿ£[ŠW0_0&default-value;’0^\'`$Pk0cš[W0f0D0‹0h0W0f0 ÿXML&processor;o0/c‹0‚F0S0h0L0g~0W0D00 </termdef></p> <p>^\'`ê0¹0È0£[Šn0‹O’0 ÿ!kk0:yY00 <eg>&lt;!ATTLIST termdef id ID #REQUIRED name CDATA #IMPLIED> &lt;!ATTLIST list type (bullets|ordered|glossary) "ordered"> &lt;!ATTLIST form method CDATA #FIXED "POST"></eg></p> </div3> <div3 id='AVNormalize'> <head>^\'`$Pn0ck‰S</head> <p> XML&processor;o0 ÿ^\'`$P’0&application;k0!nY0MRk0 ÿ!kn0h0J0Š0k0ck‰SW0j0Q0Œ0p0j0‰0j0D00 <ulist> <item> <p>a) ~0Z0 ÿ^\'`$PÊSs0]0n0-Nn0Ÿ[SO…Qg0 ÿLˆ+gÈSo0LˆƒXLu(ÈSo0·0¹0Æ0à0k0ˆ0c0f0o0ì0³0ü0É0ƒXLu)h0W0f0O0Œ0‹0&string;’0 ÿ&space-character;(#x20)Nd0k0nM0ÛcH0j0Q0Œ0p0j0‰0j0D0( 0<titleref xml-link="simple" href="sec-line-ends">Lˆ+gn0qbD0</titleref> 0‚0ÂSgqn0S0h00)0 </p></item> <item> <p>b) !kk0 ÿ‡eW[ÂSgqÊSs0…Qè&parsed-entity;x0n0ÂSgqo0 ÿU\‹•W0j0Q0Œ0p0j0‰0j0D00YèŸ[SOx0n0ÂSgqo0 ÿ&error;h0Y0‹00 </p></item> <item> <p>c) gŒ_k0 ÿ^\'`n0‹WL0<kw>CDATA</kw>g0j0Q0Œ0p0 ÿzz}v&string;o0 ÿY0y0f0&space-character;(#x20)Nd0k0ck‰SW0 ÿ‹kŠ0n0zz}v‡eW[o0 ÿJRd–W0j0Q0Œ0p0j0‰0j0D00 </p></item> </ulist> &non-validating;&parser;o0 ÿ£[ŠL0‹‰d0K0‰0j0D0^\'`o0 ÿY0y0f0 ÿ<kw>CDATA</kw>’0£[ŠW0f0D0‹0h0W0f0qbF0S0h0L0g~0W0D00</p> </div3> </div2> <div2 id='sec-condition-sect'> <head>agöNØNM0»0¯0·0ç0ó0</head> <p> <termdef id='dt-cond-section' term='conditional section'> <term>agöNØNM0»0¯0·0ç0ó0</term>h0o0 ÿ<termref def='dt-doctype'>‡eøf‹W£[Šn0Yè&subset;</termref>n0Nèh0W0 ÿ6R¡_­0ü0ï0ü0É0n0cš[k0ˆ0c0f0 ÿDTDn0ÖŠtËi k0+T0_0Š0 ÿd–D0_0Š0Y0‹0èRh0Y0‹00 </termdef> <scrap lang='ebnf'> <head>agöNØNM0»0¯0·0ç0ó0</head> <prodgroup pcw2="9" pcw4="14.5"> <prod id='NT-conditionalSect'><lhs>conditionalSect</lhs> <rhs><nt def='NT-includeSect'>includeSect</nt> | <nt def='NT-ignoreSect'>ignoreSect</nt> </rhs> </prod> <prod id='NT-includeSect'><lhs>includeSect</lhs> <rhs>'&lt;![' S? 'INCLUDE' S? '[' <!-- (<nt def='NT-markupdecl'>markupdecl</nt> | <nt def="NT-conditionalSect">conditionalSect</nt> | <nt def="NT-S">S</nt>)* --> <nt def="NT-extSubset">extSubset</nt> ']]&gt;' </rhs> </prod> <prod id='NT-ignoreSect'><lhs>ignoreSect</lhs> <rhs>'&lt;![' S? 'IGNORE' S? '[' <nt def="NT-ignoreSectContents">ignoreSectContents</nt>* ']]&gt;'</rhs> </prod> <prod id='NT-ignoreSectContents'><lhs>ignoreSectContents</lhs> <rhs><nt def='NT-Ignore'>Ignore</nt> ('&lt;![' <nt def='NT-ignoreSectContents'>ignoreSectContents</nt> ']]&gt;' <nt def='NT-Ignore'>Ignore</nt>)*</rhs></prod> <prod id='NT-Ignore'><lhs>Ignore</lhs> <rhs><nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* ('&lt;![' | ']]&gt;') <nt def='NT-Char'>Char</nt>*) </rhs></prod> <!--<rhs> ((<nt def='NT-SkipLit'>SkipLit</nt> | <nt def='NT-Comment'>Comment</nt> | <nt def='NT-PI'>PI</nt>) - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-Char'>Char</nt>*)) | ('&lt;![' <nt def='NT-ignoreSectContents'>ignoreSectContents</nt>* ']]&gt;') </rhs> <rhs> | (<nt def='NT-Char'>Char</nt> - (']' | [&lt;'"])) </rhs> <rhs> | ('&lt;!' (<nt def='NT-Char'>Char</nt> - ('-' | '['))) </rhs>--> </prodgroup> </scrap> </p> <p>agöNØNM0»0¯0·0ç0ó0o0 ÿDTDn0…Qè&subset;ÊSs0Yè&subset;h0 TØik0 ÿŒ[hQj0£[Š ÿ³0á0ó0È0ÈSo0eQŒ0P[k0j0c0_0agöNØNM0»0¯0·0ç0ó0’0 ÿD0O0d0K0+T“0g0ˆ0D00S0Œ0‰0n0“•k0 ÿzz}vL0þsŒ0f0‚0ˆ0D00 </p> <p> agöNØNM0»0¯0·0ç0ó0n0­0ü0ï0ü0É0L0<code>INCLUDE</code>j0‰0p0 ÿXML&processor;o0 ÿS0n0agöNØNM0»0¯0·0ç0ó0n0…Q¹[’0 ÿ‡eøfn0Nèh0W0f0qb0j0Q0Œ0p0j0‰0j0D00agöNØNM0»0¯0·0ç0ó0n0­0ü0ï0ü0É0L0<code>IGNORE</code>j0‰0p0 ÿ]0n0agöNØNM0»0¯0·0ç0ó0n0…Q¹[o0 ÿ‡eøfn0Nèh0W0f0qb0j0D00Ëi‡eã‰g’0ckW0O0LˆF0_00k0o0 ÿ!q–‰Y0‹0agöNØNM0»0¯0·0ç0ó0(IGNORE)k0¢•W0f0‚0 ÿ…Q¹[’0­Š~0j0Q0Œ0p0j0‰0j0D0S0h0k0èlaY0‹0S0h00S0Œ0o0 ÿeQŒ0P[k0j0c0_0agöNØNM0»0¯0·0ç0ó0’0‹‰d0Q0 ÿ(!q–‰Y0‹0)g‚0YtPn0agöNØNM0»0¯0·0ç0ó0’0ckW0O0iúQY0‹0_00h0Y0‹00­0ü0ï0ü0É0’0<code>INCLUDE</code>h0Y0‹0\U0j0agöNØNM0»0¯0·0ç0ó0L0 ÿ­0ü0ï0ü0É0’0<code>IGNORE</code>h0Y0‹0ˆ0Š0'YM0j0agöNØNM0»0¯0·0ç0ó0k0+T~0Œ0‹0j0‰0p0 ÿYtPÊSs0…QtPn0agöNØNM0»0¯0·0ç0ó0n0!N¹eh0‚0!q–‰Y0‹00 </p> <p> agöNØNM0»0¯0·0ç0ó0n0­0ü0ï0ü0É0L0Ñ0é0á0¿0Ÿ[SOÂSgqj0‰0p0 ÿXML&processor;o0agöNØNM0»0¯0·0ç0ó0n0qbD0’0$R­eY0‹0MRk0 ÿS0n0Ñ0é0á0¿0Ÿ[SO’0U\‹•W0j0Q0Œ0p0j0‰0j0D00 </p> <p>‹O’0!kk0:yY00 <eg>&lt;!ENTITY % draft 'INCLUDE' > &lt;!ENTITY % final 'IGNORE' > &lt;![%draft;[ &lt;!ELEMENT book (comments*, title, body, supplements?)> ]]&gt; &lt;![%final;[ &lt;!ELEMENT book (title, body, supplements?)> ]]&gt; </eg> </p> </div2> <!-- <div2 id='sec-pass-to-app'> <head>XML Processor Treatment of Logical Structure</head> <p>When an XML processor encounters a start-tag, it must make at least the following information available to the application: <ulist> <item> <p>the element type's generic identifier</p> </item> <item> <p>the names of attributes known to apply to this element type (validating processors must make available names of all attributes declared for the element type; non-validating processors must make available at least the names of the attributes for which values are specified. </p> </item> </ulist> </p> </div2> --> </div1> <!-- &Entities; --> <div1 id='sec-physical-struct'> <head>irtËi </head> <p> <termdef id="dt-entity" term="Entity"> XML‡eøfo0 ÿNd0åN Nn0Š¶aXSMOK0‰0ËibY0‹00S0n0Š¶aXSMO’0 ÿ<term>Ÿ[SO</term>h0D0F00Ÿ[SOo0 ÿ<term>…Q¹[</term>’0‚0a0 ÿ‡eøfŸ[SO(åNM–ÂSgq)ÊSs0<termref def='dt-doctype'>YèDTD&subset;</termref>’0d–D0f0 ÿ<term> TMR</term>g0&identified;0 </termdef> <!-- Added for CFG --> <!-- obscurity amputated by TWB --> <!-- entire sentence amputated by CMSMcQ: no one but NO ONE is ready for entities declared as <!ENTITY foo "http://www.foo.com/bar.xml#id"> and it's pointless to suggest that it's possible under current circumstances. --> <!-- An entity may be stored in, --> <!--but need not be coterminous with, --> <!-- but need not comprise the whole of, --> <!-- a single physical storage object such as a file or --> <!-- database field. --> <!-- End sentence added for CFG -->TXML‡eøfo0 ÿ<termref def="dt-docent">‡eøfŸ[SO</termref>h0|Tv0Ÿ[SO’0Nd0‚0d00<termref def="dt-xml-proc">XML&processor;</termref>o0 ÿS0n0‡eøfŸ[SOK0‰0æQt’0‹•ËYY0‹00‡eøfŸ[SOL0 ÿ‡eøfn0Y0y0f0’0+T“0g0‚0ˆ0D00</p> <p>Ÿ[SOo0 ÿ&parsed-entity;ÈSo0&unparsed-entity;h0Y0‹00<termdef id="dt-parsedent" term="Text Entity"><term>&parsed-entity;</term>n0…Q¹[o0 ÿ&parsed-entity;n0<termref def='dt-repltext'>&replacement-text;</termref>h0|Tv00S0n0<termref def="dt-text">Æ0­0¹0È0</termref>o0 ÿ‡eøfn0,gSOn0Nèh0W0f0ã‰È‘Y0‹00 </termdef> </p> <p> <termdef id="dt-unparsed" term="Unparsed Entity"> <term>&unparsed-entity;</term>o0 ÿ…Q¹[L0<termref def='dt-text'>Æ0­0¹0È0</termref>g0‚0]0F0g0j0O0h0‚0ˆ0D0ê0½0ü0¹0h0Y0‹00Æ0­0¹0È0n04XT ÿXMLg0j0O0h0‚0ˆ0D00T&unparsed-entity;k0o0 ÿ<termref def="dt-notation">ŠÕl</termref>L0¢•#ØNQ0‰0Œ0 ÿS0n0ŠÕlo0 ÿ TMRg0&identified;0ŠÕln0 TMRÊSs0¢•#ØNQ0‰0Œ0_0&identifier;’0 ÿXML&processor;L0&application;k0!nY0h0D0F0‰öNåNYo0 ÿXMLo0 ÿ&unparsed-entity;n0…Q¹[’06RP–W0j0D00 </termdef> </p> <p>&parsed-entity;o0 ÿŸ[SOÂSgqk0ˆ0c0f0 TMRg0|Ts0úQY00&unparsed-entity;o0 ÿ<kw>ENTITY</kw>‹WÈSo0<kw>ENTITIES</kw>‹Wn0^\'`n0$Ph0W0f0 ÿ TMRg0ÂSgqY0‹00</p> <p> <termdef id='gen-entity' term='general entity'><term>N,‚Ÿ[SO</term>o0 ÿ‡eøf…Q¹[n0-Ng0O(uY0‹0&parsed-entity;h0Y0‹00B0D0~0D0k0j0‰0j0D0P–Š0 ÿS0n0&TR-or-Rec;g0o0 ÿN,‚Ÿ[SO’0XSk0<emph>Ÿ[SO</emph>h0|Tv00</termdef><termdef id='dt-PE' term='Parameter entity'>Ñ0é0á0¿0Ÿ[SOo0 ÿDTD…Qg0O(uY0‹0&parsed-entity;h0Y0‹00</termdef>S0Œ0‰0n0ÿ.z^˜n0Ÿ[SOo0 ÿpuj0‹0øf_g0ÂSgqW0 ÿpuj0‹0‡eg0ŠX‹Y0‹00</p> <!-- <div2 id='sec-synchro'> <head>Logical and Physical Structures</head> <p>The logical and physical structures (elements and entities) in an XML document must be properly nested. <termref def='dt-stag'>Tags</termref> and <termref def='dt-element'>elements</termref> must each begin and end in the same <termref def='dt-entity'>entity</termref>, but may refer to other entities internally; <termref def='dt-comment'>comments</termref>, <termref def='dt-pi'>processing instructions</termref>, <termref def='dt-charref'>character references</termref>, and <termref def='dt-entref'>entity references</termref> must each be contained entirely within a single entity. Entities must each contain an integral number of elements, comments, processing instructions, and references, possibly together with character data not contained within any element in the entity, or else they must contain non-textual data, which by definition contains no elements.</p></div2> --> <div2 id='sec-references'> <head>‡eW[ÂSgqÊSs0Ÿ[SOÂSgq</head> <p> <termdef id="dt-charref" term="Character Reference"> <term>‡eW[ÂSgq</term>o0 ÿISO/IEC 10646‡eW[Æ–Tn0yrš[n0‡eW[ ÿ‹OH0p0 ÿeQ›R_jhVK0‰0ôv¥ceQ›R NïSý€j0‡eW[’0ÂSgqY0‹00 <scrap lang='ebnf'> <head>‡eW[ÂSgq</head> <prod id='NT-CharRef'><lhs>CharRef</lhs> <rhs>'&amp;#' [0-9]+ ';' </rhs> <rhs>| '&hcro;' [0-9a-fA-F]+ ';'</rhs> <wfc def="wf-Legalchar"/> </prod> </scrap> <wfcnote id="wf-Legalchar"> <head>ckS_j0‡eW[</head> <p>‡eW[ÂSgqg0ÂSgqY0‹0‡eW[o0 ÿ^—B}ïzŠ÷S<termref def="NT-Char">Char</termref>k0“_0j0Q0Œ0p0j0‰0j0D00</p> </wfcnote> ‡eW[L0 "<code>&amp;#x</code>" g0ËY~0Œ0p0 ÿB}ïzn0 "<code>;</code>" ~0g0n0peW[ÊSs0¢0ë0Õ0¡0Ù0Ã0È0o0 ÿISO/IEC 10646 n0‡eW[³0ü0É0n0162pehˆþsh0Y0‹00 <!--åe,gžŠ3Šk0d0D0f0: lettero0¢0ë0Õ0¡0Ù0Ã0È0h03ŠW0_00 N}Y --> ‡eW[L0 "<code>&amp;#</code>" g0ËY~0Œ0p0 ÿB}ïzn0 "<code>;</code>" ~0g0n0peW[o0 ÿ‡eW[³0ü0É0n0102pehˆþsh0Y0‹00 </termdef> </p> <p> <termdef id="dt-entref" term="Entity Reference"> <term>Ÿ[SOÂSgq</term>o0 ÿ TMRn0ØND0_0Ÿ[SOn0…Q¹[’0ÂSgqY0‹00</termdef><termdef id='dt-GERef' term='General Entity Reference'>N,‚Ÿ[SOx0n0ÂSgqo0 ÿ¢0ó0Ñ0µ0ó0É0(<code>&amp;</code>)ÊSs0»0ß0³0í0ó0(<code>;</code>)’0:SRŠ0P[h0W0f0(uD0‹00</termdef><termdef id='dt-PERef' term='Parameter-entity reference'><term>Ñ0é0á0¿0Ÿ[SO</term>x0n0ÂSgqo0 ÿÑ0ü0»0ó0È0Š÷S(<code>%</code>)ÊSs0»0ß0³0í0ó0(<code>;</code>)’0:SRŠ0P[h0W0f0(uD0‹00 </termdef> </p> <scrap lang="ebnf"> <head>Ÿ[SOÂSgq</head> <prod id='NT-Reference'><lhs>Reference</lhs> <rhs><nt def='NT-EntityRef'>EntityRef</nt> | <nt def='NT-CharRef'>CharRef</nt></rhs></prod> <prod id='NT-EntityRef'><lhs>EntityRef</lhs> <rhs>'&amp;' <nt def='NT-Name'>Name</nt> ';'</rhs> <wfc def='wf-entdeclared'/> <vc def='vc-entdeclared'/> <wfc def='textent'/> <wfc def='norecursion'/> </prod> <prod id='NT-PEReference'><lhs>PEReference</lhs> <rhs>'%' <nt def='NT-Name'>Name</nt> ';'</rhs> <wfc def='wf-entdeclared'/> <vc def='vc-entdeclared'/> <wfc def='textent'/> <wfc def='norecursion'/> <wfc def='indtd'/> </prod> </scrap> <wfcnote id='wf-entdeclared'> <head>Ÿ[SOL0£[ŠU0Œ0f0D0‹0S0h0</head> <p>DTD’0‚0_0j0D0‡eøf ÿÑ0é0á0¿0Ÿ[SOÂSgq’0+T~0j0D0…QèDTD&subset;`0Q0’0‚0d0‡eøf ÿÈSo0 "<code>standalone='yes'</code>" ’0‚0d0‡eøfk0J0D0f0 ÿŸ[SOÂSgqg0(uD0‹0 <nt def='NT-Name'>Name</nt> o0 ÿ]0n0Ÿ[SOn0£[Šg0NH0‹0 TMRh0 ÿ<termref def="dt-match">&match;</termref>W0j0Q0Œ0p0j0‰0j0D00_0`0W0 ÿ&well-formed;n0‡eøfo0 ÿŸ[SO&magicents; ’0£[ŠY0‹0Å_‰o0j0D00Ñ0é0á0¿0Ÿ[SOn04XTo0 ÿ£[Šo0 ÿÂSgqk0HQLˆW0j0Q0Œ0p0j0‰0j0D00 TØik0 ÿN,‚Ÿ[SOn04XTo0 ÿ^\'`ê0¹0È0£[Šn0&default-value;…Qg0n0ÂSgqˆ0Š0HQk0 ÿ£[ŠL0þsŒ0j0Q0Œ0p0j0‰0j0D00</p> <p>Yè&subset;ÈSo0YèÑ0é0á0¿0Ÿ[SOg0Ÿ[SO’0£[ŠY0‹0h0M0 ÿ&non-validating;&processor;L0 ÿ£[Š’0­Š0 ÿæQtY0‹0S0h0’0<titleref href='include-if-valid'>©ÙRe0Q0j0D0</titleref>0]0Œ0‰0n0‡eøfg0o0 ÿŸ[SOo0£[ŠU0Œ0j0Q0Œ0p0j0‰0j0D0h0D0F0‰GRo0 ÿ&well-formed;6R}g0o0j0D00 </p> </wfcnote> <vcnote id="vc-entdeclared"> <head>Ÿ[SOL0£[ŠU0Œ0f0D0‹0S0h0</head> <p> Yè&subset;ÈSo0YèÑ0é0á0¿0Ÿ[SO’0‚0c0f0D0f0 ÿ"<code>standalone='no'</code>"’0‚0d0‡eøfk0J0D0f0 ÿŸ[SOÂSgqg0(uD0‹0 <nt def='NT-Name'>Name</nt> o0 ÿ]0n0Ÿ[SOn0£[Šg0NH0‹0 TMRh0<termref def="dt-match">&match;</termref>W0j0Q0Œ0p0j0‰0j0D00øv’NK(u'`n0_00 ÿ&valid;j0‡eøfo0<titleref href="sec-escapes">B0‰0K0X00š[©W0_0Ÿ[SOn0‰š[</titleref>g0cš[W0_0øf_k0ˆ0c0f0 ÿŸ[SO &magicents;’0£[ŠY0‹0S0h0L0g~0W0D00Ñ0é0á0¿0Ÿ[SOn04XTo0 ÿ£[Šo0 ÿÂSgqk0HQLˆW0j0Q0Œ0p0j0‰0j0D00 TØik0 ÿN,‚Ÿ[SOn04XTo0 ÿ^\'`ê0¹0È0£[Šn0&default-value;…Qg0n0ÂSgqˆ0Š0‚0HQk0 ÿ£[ŠL0þsŒ0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <!-- FINAL EDIT: is this duplication too clumsy? --> <wfcnote id='textent'> <head>&parsed-entity;</head> <p> Ÿ[SOÂSgqo0 ÿ<termref def="dt-unparsed">&unparsed-entity;</termref>n0 TMR’0+T“0g0D0f0o0j0‰0j0D00&unparsed-entity;o0 ÿ<kw>ENTITY</kw>‹WÈSo0<kw>ENTITIES</kw> ‹Wh0W0f0£[ŠW0_0<termref def="dt-attrval">^\'`$P</termref>h0W0f0`0Q0ÂSgqg0M0‹00 </p> </wfcnote> <wfcnote id='norecursion'> <head>Q0^j0W0</head> <p>&parsed-entity;o0 ÿ]0Œ0êSOx0n0ÂSgq’0 ÿôv¥ck0‚0“•¥ck0‚0+T“0g0o0j0‰0j0D00</p> </wfcnote> <wfcnote id='indtd'> <head>DTDn0-N</head> <p> Ñ0é0á0¿0Ÿ[SOÂSgqo0 ÿ<termref def='dt-doctype'>DTD</termref>…Qk0`0Q0 ÿúQþsW0f0ˆ0D00 <!-- In the external DTD subset, a parameter-entity reference is recognized only at the locations where the nonterminal <nt def="NT-PEReference">PEReference</nt> or the special operator <code>%</code> appears in a production of the grammar. In the internal subset, parameter-entity references are recognized only when they match the <nt def="NT-InternalPERef">InternalPERef</nt> non-terminal in the production for <nt def="NT-markupdecl">markupdecl</nt>. --> </p> </wfcnote> <p> ‡eW[ÂSgqÊSs0Ÿ[SOÂSgqn0‹O’0 ÿ!kk0:yY00 <eg>Type &lt;key>less-than&lt;/key> (&hcro;3C;) to save options. This document was prepared on &amp;docdate; and is classified &amp;security-level;.</eg> </p> <p> Ñ0é0á0¿0Ÿ[SOÂSgqn0‹O’0 ÿ!kk0:yY00 <eg>&lt;!ENTITY % ISOLat2 SYSTEM "http://www.xml.com/iso/isolat2-xml.entities" > %ISOLat2; </eg> </p> </div2> <div2 id='sec-entity-decl'> <head>Ÿ[SO£[Š</head> <p> <termdef id="dt-entdecl" term="entity declaration"> Ÿ[SOo0 ÿ!kn0h0J0Š0k0£[ŠY0‹00 <scrap lang='ebnf'> <head>Ÿ[SO£[Š</head> <prodgroup pcw2="5" pcw4="18.5"> <prod id='NT-EntityDecl'><lhs>EntityDecl</lhs> <rhs><nt def="NT-GEDecl">GEDecl</nt></rhs><com>N,‚Ÿ[SO</com> <rhs>| <nt def="NT-PEDecl">PEDecl</nt></rhs><com>Ñ0é0á0¿0Ÿ[SO</com> </prod> <prod id='NT-GEDecl'><lhs>GEDecl</lhs> <rhs>'&lt;!ENTITY' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> <nt def='NT-EntityDef'>EntityDef</nt> <nt def='NT-S'>S</nt>? '&gt;'</rhs> </prod> <prod id='NT-PEDecl'><lhs>PEDecl</lhs> <rhs>| '&lt;!ENTITY' <nt def='NT-S'>S</nt> '%' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> <nt def='NT-PEDef'>PEDef</nt> <nt def='NT-S'>S</nt>? '&gt;'</rhs> <com>Ñ0é0á0¿0Ÿ[SO</com> </prod> <prod id='NT-EntityDef'><lhs>EntityDef</lhs> <rhs><nt def='NT-EntityValue'>EntityValue</nt> </rhs> <!--<wfc def="WF-EntityValue"/>--> <rhs>| <nt def='NT-ExternalDef'>ExternalDef</nt></rhs> <!--<wfc def="WF-External"/>--> </prod> <!-- FINAL EDIT: what happened to WFs here? --> <prod id='NT-PEDef'><lhs>PEDef</lhs> <rhs><nt def='NT-EntityValue'>EntityValue</nt> | <nt def='NT-ExternalID'>ExternalID</nt></rhs></prod> </prodgroup> </scrap> <nt def='NT-Name'>Name</nt> o0 ÿ<termref def="dt-entref">Ÿ[SOÂSgq</termref>k0J0D0f0Ÿ[SO’0&identify;0&unparsed-entity;j0‰0p0 ÿ<kw>ENTITY</kw> ‹WÈSo0<kw>ENTITIES</kw>‹Wn0^\'`$P…Qg0 ÿŸ[SO’0&identify;0 TNn0Ÿ[SOL0NÞVåN N£[ŠU0Œ0Œ0p0 ÿgRn0£[Š’0(uD0‹00&at-user-option; ÿ‰peÞV£[ŠU0Œ0‹0Ÿ[SOk0¢•W0 ÿXML&processor;o0 ÿf‹JT’0úQW0f0‚0ˆ0D00 </termdef> </p> <!-- <wfcnote id="WF-Entityvalue"> <head>Well-Formed Internal Entity</head> <p>General entities defined by an <nt def="NT-EntityValue">EntityValue</nt> must be well-formed, as defined in section <specref ref="wf-entities"/>. </p> </wfcnote> <wfcnote id="WF-External"> <head>Well-Formed External Entity</head> <p>General text entities defined by an <nt def="NT-ExternalDef">ExternalDef</nt>, must be well-formed, as defined in the section on <titleref xml-link="simple" href="wf-entities">well-formed entities.</titleref>.</p> </wfcnote> --> <div3 id='sec-internal-ent'> <head>…QèŸ[SO</head> <p> <termdef id='dt-internent' term="Internal Entity Replacement Text"> Ÿ[SOn0š[©L0 <nt def='NT-EntityValue'>EntityValue</nt>n0h0M0 ÿS0Œ0’0<term>…QèŸ[SO</term>h0D0F00S0Œ0o0 ÿ%R Pn0irt„vŠ¶aXSMO’0‚0_0Z0 ÿŸ[SOn0…Q¹[o0 ÿ£[Š…Qg0NH0‹00</termdef>ckW0O0<termref def='dt-repltext'>&replacement-text;</termref>’0ubY0‹0k0o0 ÿ<termref def='dt-litentval'>&literal;Ÿ[SO$P</termref>…Qg0n0Ÿ[SOÂSgqÊSs0‡eW[ÂSgqn0æQtL0 ÿÅ_‰h0j0‹0K0‚0W0Œ0j0D0S0h0k0èlaY0‹00sŠ0}o0 ÿ<titleref href='intern-replacement'>…QèŸ[SOn0&replacement-text;n0ËiÉ{</titleref>’0ÂSgq0 <!-- redundant -TWB Within the <nt def="NT-EntityValue">EntityValue</nt>, parameter-entity references and character references are recognized and expanded immediately. General-entity references within the replacement text are not recognized at the time the entity declaration is parsed, though they may be recognized when the entity itself is referred to. --> </p> <p> …QèŸ[SOo0 ÿ<termref def="dt-parsedent">&parsed-entity;</termref>h0Y0‹00 </p> <p>…QèŸ[SO£[Šn0‹O’0 ÿ!kk0:yY00 <eg>&lt;!ENTITY Pub-Status "This is a pre-release of the specification."></eg></p> </div3> <div3 id='sec-external-ent'> <head>YèŸ[SO</head> <p> <termdef id="dt-extent" term="External Entity"> Ÿ[SOL0…QèŸ[SOg0j0Q0Œ0p0 ÿ<term>YèŸ[SO</term>h0W0 ÿ!kn0h0J0Š0k0£[ŠY0‹00 <scrap lang='ebnf'> <head>YèŸ[SO£[Š</head> <prod id='NT-ExternalDef'><lhs>ExternalDef</lhs> <rhs><nt def='NT-ExternalID'>ExternalID</nt> <nt def='NT-NDataDecl'>NDataDecl</nt>?</rhs></prod> <prod id='NT-ExternalID'><lhs>ExternalID</lhs> <rhs>'SYSTEM' <nt def='NT-S'>S</nt> <nt def='NT-SystemLiteral'>SystemLiteral</nt></rhs> <rhs>| 'PUBLIC' <nt def='NT-S'>S</nt> <nt def='NT-PubidLiteral'>PubidLiteral</nt> <nt def='NT-S'>S</nt> <nt def='NT-SystemLiteral'>SystemLiteral</nt> </rhs> </prod> <prod id='NT-NDataDecl'><lhs>NDataDecl</lhs> <rhs><nt def='NT-S'>S</nt> 'NDATA' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt></rhs> <vc def='not-declared'/></prod> </scrap> <nt def='NT-NDataDecl'>NDataDecl</nt> L0X[(WY0Œ0p0 ÿS0n0Ÿ[SOo0 ÿ<termref def="dt-unparsed">&unparsed-entity;</termref>h0W0 ÿ]0F0g0j0Q0Œ0p0 ÿ&parsed-entity;h0Y0‹00</termdef> </p> <vcnote id='not-declared'> <head>ŠÕlL0£[ŠU0Œ0f0D0‹0S0h0</head> <p> <nt def='NT-Name'>Name</nt> o0 ÿ£[ŠW0_0<termref def="dt-notation">ŠÕl</termref>n0 TMRh0&match;W0j0Q0Œ0p0j0‰0j0D00 </p> </vcnote> <p> <termdef id="dt-sysid" term="System Identifier"> ­0ü0ï0ü0É0 <kw>SYSTEM</kw> n0Œ_n0 <nt def='NT-SystemLiteral'>SystemLiteral</nt> ’0 ÿŸ[SOn0<term>·0¹0Æ0à0&identifier;</term>h0|Tv00S0Œ0o0URIh0W0 ÿ]0n0Ÿ[SOn0…Q¹[’0ÖSŠ0úQY0n0k0(uD0f0‚0ˆ0D00</termdef>URIh0qQk0OF0S0h0n0YD0Ï0Ã0·0å0("<code>#</code>")ÊSs0Õ0é0°0á0ó0È0&identifier;o0 ÿck_k0o0 ÿURIêSOn0Nèh0o0W0j0D00Õ0é0°0á0ó0È0&identifier;L0 ÿ·0¹0Æ0à0&identifier;n0èRh0W0f0NH0‰0Œ0f0D0‹04XT ÿXML&processor;o0 ÿ&error;’0úQW0f0‚0ˆ0D00S0n0&TR-or-Rec;n0Ä{òVYn0Å`1X(‹OH0p0 ÿB0‹0yrš[n0DTDn0yr%Rj0XML‰ }ÈSo0yrš[n0&application;n0ÕNØik0ˆ0c0f0š[©U0Œ0_0æQt}TäN)k0ˆ0c0f0 NøfM0U0Œ0j0D0P–Š0 ÿøvþ[„vj0URIo0 ÿ]0n0Ÿ[SOn0MOn ÿY0j00a0 ÿ]0n0Ÿ[SOn0£[ŠL0B0‹0Õ0¡0¤0ë0k0øvþ[„vh0Y0‹00W0_0L0c0f0 ÿDTDn0…Qè&subset;k0B0‹0Ÿ[SO£[Šg0n0øvþ[„vj0URIo0 ÿ‡eøfn0MOnk0d0D0f0øvþ[„vh0Y0‹00Yè&subset;k0B0‹0Ÿ[SO£[Šg0n0øvþ[„vj0URIo0 ÿ]0n0Yè&subset;’0+T€0Õ0¡0¤0ë0n0MOnk0øvþ[„vh0Y0‹00 </p> <p> <termdef id="dt-pubid" term="Public identifier"> ·0¹0Æ0à0&identifier;åNYk0 ÿYèŸ[SOo0 ÿ<term>lQ‹•&identifier;</term>’0+T“0g0‚0ˆ0D00 </termdef> Ÿ[SOn0…Q¹[’0ÖSŠ0úQY0XML&processor;o0 ÿS0n0lQ‹•&identifier;’0(uD0f0 ÿãN0Š0n0URIn0ub’0fŠ0f0‚0ˆ0D00XML&processor;L0S0Œ0k01YWeW0_04XTo0 ÿ·0¹0Æ0à0&literal;h0W0f0cš[W0_0URI’0(uD0j0Q0Œ0p0j0‰0j0D00&match;Y0‹0MRk0 ÿlQ‹•&identifier;…Qk0B0‹0zz}v‡eW[K0‰0j0‹0&string;o0 ÿY0y0f0XSNn0&space-character;(#x20)k0ck‰SW0j0Q0Œ0p0j0‰0Z0 ÿMRŒ_n0zz}v‡eW[o0JRd–W0j0Q0Œ0p0j0‰0j0D00 </p> <p>YèŸ[SO£[Šn0‹O’0 ÿ!kk0:yY00 <eg>&lt;!ENTITY open-hatch SYSTEM "http://www.textuality.com/boilerplate/OpenHatch.xml"> &lt;!ENTITY open-hatch PUBLIC "-//Textuality//TEXT Standard open-hatch boilerplate//EN" "http://www.textuality.com/boilerplate/OpenHatch.xml"> &lt;!ENTITY hatch-pic SYSTEM "../grafix/OpenHatch.gif" NDATA gif ></eg></p> </div3> </div2> <div2 id='TextEntities'> <head>&parsed-entity;</head> <div3 id='sec-TextDecl'> <head>Æ0­0¹0È0£[Š</head> <p>Yè&parsed-entity;o0 ÿ<term>Æ0­0¹0È0£[Š</term>g0ËY~0c0f0‚0ˆ0D00 <scrap lang='ebnf'> <head>Æ0­0¹0È0£[Š</head> <prodgroup pcw4="12.5" pcw5="13"> <prod id='NT-TextDecl'><lhs>TextDecl</lhs> <rhs>&xmlpio; <nt def='NT-VersionInfo'>VersionInfo</nt>? <nt def='NT-EncodingDecl'>EncodingDecl</nt> <nt def='NT-S'>S</nt>? &pic;</rhs> <!-- <wfc def='wfc-xmldecliteral'/> --> <!-- <wfc def='wfc-no-nonleading-encdec'/> --> </prod> </prodgroup> </scrap> </p> <p>Æ0­0¹0È0£[Šo0 ÿ]0n0~0~0n0b_g0þsŒ0j0Q0Œ0p0j0‰0Z0 ÿ&parsed-entity;x0n0ÂSgq’0L}1uW0f0o0j0‰0j0D0S0h0k0èlaY0‹00</p> <p>Yè&parsed-entity;k0J0D0f0 ÿÆ0­0¹0È0£[Šo0 ÿHQ-˜åNYn0D0K0j0‹0MOnk0‚0úQþsW0j0D00</p> </div3> <div3 id='wf-entities'> <head>&well-formed;n0&parsed-entity;</head> <p>é0Ù0ë0<nt def='NT-document'>document</nt>’0‚0d0ub‰GRk0&match;Y0Œ0p0 ÿ‡eøfŸ[SOo0 ÿ&well-formed;h0Y0‹00é0Ù0ë0<nt def='NT-ExtParsedEnt'>ExtParsedEnt</nt>’0‚0d0ub‰GRk0&match;Y0Œ0p0 ÿYèn0N,‚&parsed-entity;o0 ÿ&well-formed;h0Y0‹00é0Ù0ë0<nt def='NT-ExtPE'>ExtPE</nt>’0‚0d0ub‰GRk0&match;Y0Œ0p0 ÿYèÑ0é0á0¿0Ÿ[SOo0 ÿ&well-formed;h0Y0‹00 <scrap lang='ebnf'> <head>&well-formed;n0&parsed-entity;</head> <prod id='NT-ExtParsedEnt'><lhs>ExtParsedEnt</lhs> <rhs><nt def='NT-TextDecl'>TextDecl</nt>? <nt def='NT-content'>content</nt></rhs> </prod> <prod id='NT-ExtPE'><lhs>ExtPE</lhs> <rhs><nt def='NT-TextDecl'>TextDecl</nt>? <nt def='NT-extSubset'>extSubset</nt></rhs> </prod> </scrap> &replacement-text;L0 ÿé0Ù0ë0<nt def='NT-content'>content</nt>’0‚0d0ub‰GRk0&match;Y0Œ0p0 ÿ…Qèn0N,‚&parsed-entity;o0 ÿ&well-formed;h0Y0‹00DTD’0gŒ_~0g0­Š0¼~0j0D0h0 ÿºxŸ[k0S0Œ0’0$Rš[g0M0j0D0S0h0k0èla0Y0y0f0n0…Qèn0Ñ0é0á0¿0Ÿ[SOo0 ÿš[©k0ˆ0c0f0&well-formed;h0Y0‹00 </p> <p>Ÿ[SOL0&well-formed;j0P}œgh0W0f0 ÿXML‡eøfn0ÖŠt„vÊSs0irt„vËi o0 ÿckW0O0eQŒ0P[h0j0‹00<termref def='dt-stag'>‹•ËY¿0°0</termref> ÿ<termref def='dt-etag'>B}†N¿0°0</termref> ÿ<termref def="dt-empty">zz‰ }¿0°0</termref> ÿ<termref def='dt-element'>‰ }</termref> ÿ<termref def='dt-comment'>³0á0ó0È0</termref> ÿ<termref def='dt-pi'>æQt}TäN</termref> ÿ<termref def='dt-charref'>‡eW[ÂSgq</termref>ÊSs0<termref def='dt-entref'>Ÿ[SOÂSgq</termref>L0 ÿNd0n0Ÿ[SOg0‹•ËYW0 ÿ%Rn0Ÿ[SOg0B}†NY0‹0S0h0o0j0D00</p> </div3> <div3 id='charencoding'> <head>Ÿ[SOk0J0Q0‹0‡eW[&{÷SS</head> <p>XML‡eøf…Qn0Yè&parsed-entity;o0 ÿT0 ÿ%Rn0‡eW[&{÷SS¹e_’0(uD0f0‚0ˆ0D00Y0y0f0n0XML&processor;o0 ÿUTF-8g0&{÷SSW0_0Ÿ[SO ÿUTF-16g0&{÷SSW0_0Ÿ[SO’0æQtg0M0j0Q0Œ0p0j0‰0j0D00 <!-- It is recognized that for some purposes, the use of additional ISO/IEC 10646 planes other than the Basic Multilingual Plane may be required. A facility for handling characters in these planes is therefore a desirable characteristic in XML processors and applications. --> </p> <p>UTF-16g0&{÷SSW0_0Ÿ[SOo0 ÿISO/IEC 10646n0ØN2“EÊSs0Unicoden0ØN2“Bg0‰š[Y0‹0&byte-order-mark;(ZERO WIDTH NO-BREAK SPACE‡eW[ ÿ#xFEFF)g0ËY~0‰0j0Q0Œ0p0j0‰0j0D00S0Œ0o0 ÿ&{÷SSn0jX‹g0B0c0f0 ÿXML‡eøfn0&markup;n0Nèg0‚0 ÿ‡eW[Ç0ü0¿0n0Nèg0‚0j0D00XML&processor;o0 ÿUTF-8g0&{÷SSW0_0‡eøfh0UTF-16g0&{÷SSW0_0‡eøfh0n0:S%R’0LˆF0_00k0 ÿS0n0‡eW[’0O(uïSý€g0j0Q0Œ0p0j0‰0j0D00</p> <p>XML&processor;o0 ÿUTF-8ÊSs0UTF-16g0&{÷SSW0_0Ÿ[SO`0Q0’0­Š€0S0h0’0Å_˜h0Y0‹0L0 ÿÖNn0&{÷SS’0NLug0o0(uD0f0J0Š0 ÿ]0Œ0‰0n0&{÷SS’0(uD0‹0Ÿ[SO’0XML&processor;L0æQtg0M0‹0S0h0L0g~0W0D00UTF-8ÈSo0UTF-16åNYn0&{÷SS¹e_’0(uD0f0Æ0­0¹0È0£[Š</titleref>g0ËY0j0Q0Œ0p0j0‰0j0D00 <scrap lang='ebnf'> <head>&{÷SS£[Š</head> <prod id='NT-EncodingDecl'><lhs>EncodingDecl</lhs> <rhs><nt def="NT-S">S</nt> 'encoding' <nt def='NT-Eq'>Eq</nt> '"' <nt def='NT-EncName'>EncName</nt> '"' | "'" <nt def='NT-EncName'>EncName</nt> "'" </rhs> </prod> <prod id='NT-EncName'><lhs>EncName</lhs> <rhs>[A-Za-z] ([A-Za-z0-9._] | '-')*</rhs> <com>é0Æ0ó0‡eW[`0Q0’0+T€0&{÷SS T</com> </prod> </scrap> <termref def='dt-docent'>‡eøfŸ[SO</termref>g0o0 ÿ&{÷SS£[Šo0 ÿ<termref def="dt-xmldecl">XML£[Š</termref>n0Nèh0Y0‹00<nt def="NT-EncName">EncName</nt>o0 ÿO(uY0‹0&{÷SS¹e_n0 TMRh0Y0‹00 </p> <!-- FINAL EDIT: check name of IANA and charset names --> <p>&{÷SS£[Šg0o0 ÿ$P<code>UTF-8</code> ÿ<code>UTF-16</code> ÿ<code>ISO-10646-UCS-2</code>ÊSs0<code>ISO-10646-UCS-4</code>o0 ÿUnicodeÊSs0ISO/IEC 10646n0T.z&{÷SSn0_00k0(uD0‹00$P<code>ISO-8859-1</code>K0‰0<code>ISO-8859-9</code>~0g0o0 ÿISO 8859n0þ[Ü_Y0‹0Ñ0ü0È0n0_00k0(uD0‹00$P<code>ISO-2022-JP</code> ÿ<code>Shift_JIS</code>ÊSs0<code>EUC-JP</code>o0 ÿJIS X-0208-1997n0T.z&{÷SSn0_00k0(uD0‹00XML&processor;o0 ÿ]0Œ0åNYn0&{÷SS¹e_’0ŠX‹W0f0‚0ˆ0D00Internet Assigned Numbers Authority (IANA)k0 ÿ(<emph>charset</emph>sh0W0f0){v2“U0Œ0_0‡eW[&{÷SS¹e_k0d0D0f0o0 ÿS0Œ0‰0åNYk0d0D0f0‚0 ÿ{v2“U0Œ0_0 TMRg0ÂSgqY0‹0S0h0L0g~0W0D00S0Œ0‰0n0{v2“U0Œ0_0 TMRo0 ÿ'Y‡eW[û0\‡eW[n0:S%R’0[0Z0k0š[©U0Œ0f0D0‹0n0g0 ÿS0Œ0‰0k0þ[Y0‹0Ôk’0fŠ0‹0&processor;o0 ÿ'Y‡eW[û0\‡eW[n0:S%R’0W0j0D0¹eÕl’0h0‹0n0L0g~0W0D0S0h0k0èlaY0‹00</p> <p>XMLæQtû|k0!nU0Œ0_0Ÿ[SOL0 ÿ&{÷SS£[Š’0+T€0k0‚0K0K00‰0Z0 ÿ£[Šg0:yW0_0‚0n0åNYn0¹e_g0&{÷SSU0Œ0f0D0_0Š0 ÿ&{÷SS£[ŠL0 ÿYèŸ[SOn0gRåNYn0MOnk0úQþsY0Œ0p0 ÿ<termref def="dt-error">&error;</termref>h0Y0‹00 </p> <p>&byte-order-mark;g0‚0&{÷SS£[Šg0‚0ËY~0‰0j0D0Ÿ[SOo0 ÿUTF-8&{÷SSg0j0Q0Œ0p0j0‰0j0D00</p> <p><!-- XML processors should make an effort to use all available information, internal and external, to aid in detecting an entity's correct encoding. Such information may include, but is not limited to: <ulist><item><p>An HTTP header</p></item> <item><p>A MIME header obtained other than through HTTP</p></item> <item><p>Metadata provided by the native OS file system or by document management software</p></item> <item><p>The bit patterns at the front of an entity, which may be analyzed to determine if the application of any known encoding yields a valid encoding declaration. See <titleref href='sec-guessing'>the appendix on autodetection of character sets</titleref> for a fuller description.</p></item></ulist> --> æQtg0M0j0D0&{÷SS’0‚0c0_0Ÿ[SO’0XML&processor;L0zv‹‰W0_0h0M0o0 ÿ&application;k0]0n0‹NŸ[’0åwW0 ÿ<termref def='dt-fatal'>&fatal-error;</termref>h0W0f0 ÿæQt’0B}†NW0j0Q0Œ0p0j0‰0j0D00 <!-- inform the application of this fact and may allow the application to request either that the entity should be treated as an <termref def="dt-unparsed">unparsed entity</termref>, or that processing should cease.--> </p> <p>&{÷SS£[Šn0‹O’0 ÿ!kk0:yY00 <eg>&lt;?xml encoding='UTF-8'?> &lt;?xml encoding='EUC-JP'?></eg></p> </div3> </div2> <div2 id='entproc'> <head>XML&processor;k0ˆ0‹0Ÿ[SOÊSs0ÂSgqn0qbD0</head> <p>!kn0hˆo0 ÿ‡eW[ÂSgq ÿŸ[SOÂSgqÊSs0&unparsed-entity;n0|TúQW0L0þsŒ0‹0‡eÊSs0T0n04XTk0J0Q0‹0<termref def='dt-xml-proc'>XML&processor;</termref>k0‰BlY0‹0/c‚D0’0‰}Y0‹00Njuæ]n0Rn0é0Ù0ë0o0 ÿŠX‹n0‡e’0:yY00 <glist> <gitem><label>…Q¹[k0J0Q0‹0ÂSgq</label> <def><p>‰ }n0<termref def='dt-stag'>‹•ËY¿0°0</termref>ÊSs0<termref def='dt-etag'>B}†N¿0°0</termref>n0“•n0ûNan04X@bg0n0ÂSgq0^—B}ïzŠ÷S<nt def='NT-content'>content</nt>k0þ[Ü_Y0‹00</p></def> </gitem> <gitem> <label>^\'`$Pk0J0Q0‹0ÂSgq</label> <def><p><termref def='dt-stag'>‹•ËY¿0°0</termref>n0^\'`n0$P ÿÈSo0<termref def='dt-attdecl'>^\'`£[Š</termref>k0J0Q0‹0&default-value;n0D0Z0Œ0K0g0n0ÂSgq0^—B}ïzŠ÷S<nt def='NT-AttValue'>AttValue</nt>k0þ[Ü_Y0‹00</p></def></gitem> <gitem> <label>^\'`$Ph0W0f0úQþs</label> <def><p>ÂSgqg0o0j0O0 ÿ<nt def='NT-Name'>Name</nt>h0W0f0úQþs0<code>ENTITY</code>‹Wh0W0f0£[ŠW0_0^\'`n0$P ÿÈSo0<code>ENTITIES</code>‹Wh0W0f0£[ŠW0_0^\'`n0$Pk0J0Q0‹0&space;g0:SR‹0&token;n0Nd0h0W0f0úQþsY0‹00</p> </def></gitem> <gitem><label>Ÿ[SO$Pk0J0Q0‹0ÂSgq</label> <def><p>Ÿ[SOn0£[Šk0J0Q0‹0 ÿÑ0é0á0¿0ÈSo0…QèŸ[SOn0<termref def='dt-litentval'>&literal;Ÿ[SO$P</termref>…Qn0ÂSgq0^—B}ïzŠ÷S<nt def='NT-EntityValue'>EntityValue</nt>k0þ[Ü_Y0‹00</p></def></gitem> <gitem><label>DTDk0J0Q0‹0ÂSgq</label> <def><p><termref def='dt-doctype'>DTD</termref>n0…Qè&subset;ÈSo0Yè&subset;g0n0ÂSgq0_0`0W0 ÿ<nt def='NT-EntityValue'>EntityValue</nt>ÈSo0<nt def="NT-AttValue">AttValue</nt>n0YtPh0Y0‹00</p></def> </gitem> </glist></p> <!-- border value changed by bosak --> <htable border='1' cellpadding='7' align='center'> <!-- tbody wrapper added by bosak --> <htbody> <tr><td bgcolor='&cellback;' rowspan='2' colspan='1'></td> <td bgcolor='&cellback;' align='center' valign='bottom' colspan='4'>Ÿ[SOn0‹W</td> <td bgcolor='&cellback;' rowspan='2' align='center'>‡eW[</td> </tr> <tr align='center' valign='bottom'> <td bgcolor='&cellback;'>Ñ0é0á0¿0</td> <td bgcolor='&cellback;'>…Qè&newline;N,‚</td> <td bgcolor='&cellback;'>Yè&newline;&parsed-entity;&newline;N,‚</td> <td bgcolor='&cellback;'>&unparsed-entity;</td> </tr> <tr align='center' valign='middle'> <!--<td bgcolor='&cellback;' rowspan='4'>Recognition Context</td>--> <td bgcolor='&cellback;' align='right'>…Q¹[g0n0&newline;ÂSgq</td> <td bgcolor='&cellback;'><titleref href='not-recognized'>ŠX‹&newline;W0j0D0</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>ÖS¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='include-if-valid'>i<Šn0_00k0ÖS¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ybk</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>ÖS¼0</titleref></td> </tr> <tr align='center' valign='middle'> <td bgcolor='&cellback;' align='right'>^\'`$Pg0n0&newline;ÂSgq</td> <td bgcolor='&cellback;'><titleref href='not-recognized'>ŠX‹&newline;W0j0D0</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>ÖS¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ybk</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ybk</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>ÖS¼0</titleref></td> </tr> <tr align='center' valign='middle'> <td bgcolor='&cellback;' align='right'>^\'`$Ph0W0f0&newline;úQþs</td> <td bgcolor='&cellback;'><titleref href='not-recognized'>ŠX‹&newline;W0j0D0</titleref></td> <td bgcolor='&cellback;'><titleref href='not-recognized'>ybk</titleref></td> <td bgcolor='&cellback;'><titleref href='not-recognized'>ybk</titleref></td> <td bgcolor='&cellback;'><titleref href='notify'>åw</titleref></td> <td bgcolor='&cellback;'><titleref href='not recognized'>ŠX‹&newline;W0j0D0</titleref></td> </tr> <tr align='center' valign='middle'> <td bgcolor='&cellback;' align='right'>Ÿ[SO$Pg0n0&newline;ÂSgq</td> <td bgcolor='&cellback;'><titleref href='included'>ÖS¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='bypass'>&bypass;</titleref></td> <td bgcolor='&cellback;'><titleref href='bypass'>&bypass;</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ybk</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>ÖS¼0</titleref></td> </tr> <tr align='center' valign='middle'> <td bgcolor='&cellback;' align='right'>DTDg0n0&newline;ÂSgq</td> <td bgcolor='&cellback;'><titleref href='as-PE'>PEh0W0f0&newline;ÖS¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ybk</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ybk</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ybk</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ybk</titleref></td> </tr> </htbody> </htable> <div3 id='not-recognized'> <head> ŠX‹W0j0D0 </head> <p>DTDn0Yg0o0 ÿ<code>%</code>‡eW[o0 ÿD0K0j0‹0yrš[n0asT‚0 ÿ‚0_0j0D00W0_0L0c0f0 ÿDTDg0o0Ñ0é0á0¿0Ÿ[SOÂSgqh0W0f0ŠX‹Y0‹0‚0n0g0B0c0f0‚0 ÿ<nt def='NT-content'>content</nt>…Qg0o0&markup;h0W0f0o0ŠX‹W0j0D00 TØik0 ÿiRk0£[ŠW0_0^\'`n0$Pn0-Nk0þsŒ0‹04XT’0d–M0 ÿ&unparsed-entity;n0 TMRo0 ÿŠX‹W0j0D00 </p> </div3> <div3 id='included'> <head> ÖS¼0 </head> <p><termdef id="dt-include" term="Include">Ÿ[SOo0 ÿ]0n0<termref def='dt-repltext'>&replacement-text;</termref>’0ÖSŠ0úQW0 ÿæQtY0‹0h0 ÿÂSgqêSOn0ãN0Š0k0 ÿÂSgqL0B0c0_0MOng0 ÿ‡eøfn0Nèh0W0f0+T~0Œ0‹0K0n0ˆ0F0k0<term>ÖSŠ0¼~0Œ0‹0</term>0&replacement-text;o0 ÿ<termref def='dt-chardata'>‡eW[Ç0ü0¿0</termref>ÊSs0(Ñ0é0á0¿0Ÿ[SO’0d–O00)<termref def="dt-markup">&markup;</termref>n0D0Z0Œ0’0+T“0g0‚0ˆ0O0 ÿS0Œ0‰0o0 ÿ8^n0¹eÕlg0ŠX‹U0Œ0j0Q0Œ0p0j0‰0j0D00_0`0W0 ÿ&markup;n0:SRŠ0P[’0&escape;Y0‹0_00k0(uD0‹0Ÿ[SO(&magicents;)n0&replacement-text;o0 ÿ8^k0Ç0ü0¿0h0W0f0qbF0(&string;"<code>AT&amp;amp;T;</code>"o0 ÿ"<code>AT&amp;T;</code>"k0U\‹•U0Œ0 ÿ‹kU0Œ0_0¢0ó0Ñ0µ0ó0É0o0 ÿŸ[SOÂSgqn0:SRŠ0P[h0W0f0o0ŠX‹W0j0D00)0‡eW[ÂSgqo0 ÿ:yW0_0‡eW[’0ÂSgqêSOn0ãN0Š0k0æQtY0‹0h0M0 ÿ<term>ÖSŠ0¼~0Œ0‹0</term>0 </termdef></p> </div3> <div3 id='include-if-valid'> <head> i<Šn0_00k0ÖS¼0 </head> <p>‡eøfn0&validity;’0<termref def="dt-valid">i<Š</termref>Y0‹0k0o0 ÿXML&processor;L0&parsed-entity;x0n0ÂSgq’0ŠX‹W0_0h0M0 ÿ]0n0&replacement-text;’0<termref def="dt-include">ÖSŠ0¼~0</termref>j0Q0Œ0p0j0‰0j0D00Ÿ[SOL0YèŸ[SOg0B0c0f0 ÿXML‡eøfn0&validity;’0i<ŠW0j0Q0Œ0p0 ÿŸ[SOn0&replacement-text;’0ÖSŠ0¼“0g0‚0<termref def="dt-may">ˆ0D0</termref>L0 ÿ]0F0W0j0O0h0‚0ˆ0D00</p> <p>S0n0ÖSzl0o0 ÿSGMLÊSs0XMLn0Ÿ[SOn0_jËiL0Ðc›OY0‹0êÕRÖS¼0_jý€L0 ÿ‡eøf\ObBfn0â0¸0å0ü0ë0S’0;Nj0îv„vh0W0f0-ŠŠU0Œ0f0J0Š0 ÿ]0n0ÖNn0&application;(yrk0 ÿ‡eøfn0Ö0é0¦0º0)k0o0 ÿÅ_Z0W0‚0iRg0o0j0D0 ÿh0D0F0ŠX‹k0ˆ0‹00‹OH0p0 ÿÖ0é0¦0¶0o0Yè&parsed-entity;x0n0ÂSgq’0‹‰d0Q0‹0h0 ÿ]0n0Ÿ[SOL0X[(WY0‹0h0D0F0hˆ:y`0Q0’0LˆD0 ÿhˆ:y’0‰BlU0Œ0_0h0M0k0`0Q0 ÿ…Q¹[’0ÖSŠ0úQY0K0‚0W0Œ0j0D00 </p> </div3> <div3 id='forbidden'> <head> ybk </head> <p>!ko0ybkU0Œ0f0J0Š0 ÿ<termref def='dt-fatal'>&fatal-error;</termref>h0Y0‹00 <ulist> <item><p>a) <termref def='dt-unparsed'>&unparsed-entity;</termref>x0n0ÂSgqn0úQþs0 </p></item> <item><p>b) DTDn0<nt def='NT-EntityValue'>EntityValue</nt>ÈSo0<nt def="NT-AttValue">AttValue</nt>åNYn0èRk0J0Q0‹0 ÿ‡eW[ÂSgqÈSo0N,‚Ÿ[SOx0n0ÂSgqn0úQþs0</p></item> <item><p>c) ^\'`$P…Qn0YèŸ[SOx0n0ÂSgq0</p> </item> </ulist> </p> </div3> <div3 id='notify'> <head> åw </head> <p><termref def='dt-unparsed'>&unparsed-entity;</termref>n0 TMRL0 ÿ<kw>ENTITY</kw>ÈSo0<kw>ENTITIES</kw>n0^\'`n0$Pk0J0D0f0&token;h0W0f0þsŒ0_0h0M0 ÿ&processor;o0 ÿ&application;k0þ[W0f0 ÿ¢•#ØNQ0‰0Œ0_0<termref def="dt-notation">ŠÕl</termref> T ÿŠÕlk0þ[Y0‹0<termref def='dt-sysid'>·0¹0Æ0à0</termref>&identifier;ÊSs0(X[(WY0Œ0p0)<termref def='dt-pubid'>lQ‹•</termref>&identifier;’0åwW0j0Q0Œ0p0j0‰0j0D00</p> </div3> <div3 id='bypass'> <head> &bypass; </head> <p>N,‚Ÿ[SOÂSgqL0 ÿŸ[SO£[Šk0J0Q0‹0<nt def='NT-EntityValue'>EntityValue</nt>…Qk0þsŒ0‹0h0M0 ÿ]0Œ0o0!q–‰U0Œ0 ÿ]0n0~0~0‹k‹00</p> </div3> <div3 id='as-PE'> <head> PEh0W0f0ÖS¼0 </head> <p>Yè&parsed-entity;n04XTh0 TØik0 ÿÑ0é0á0¿0Ÿ[SOo0 ÿ&validity;’0<titleref href='include-if-valid'>i<ŠY0‹0h0M0`0Q0ÖSŠ0¼~0Œ0‹0</titleref>Å_‰L0B0‹00Ñ0é0á0¿0Ÿ[SOÂSgq’0DTD…Qk0ŠX‹W0f0ÖSŠ0¼€0h0M0 ÿ]0n0<termref def='dt-repltext'>&replacement-text;</termref>o0 ÿ]0n0MRŒ_k0Nd0n0&space-character;(#x20)n0ØN Rk0ˆ0c0f0_M08Op0U0Œ0‹00S0n0aóVo0 ÿÑ0é0á0¿0Ÿ[SOn0&replacement-text;L0 ÿDTD…Qn0D0O0d0K0n0‡eÕl„v&token;’0Œ[hQk0+T€0h0 ÿ6R}Y0‹0S0h0k0B0‹00 </p> </div3> <!-- <div3 id='gen-char-entproc'> <head>General and Character Entity Processing</head> <p>General-entity and character references are recognized in three contexts: wherever the nonterminal <nt def='NT-content'>content</nt> may appear, at any point within the nonterminal <nt def='NT-AttValue'>AttValue</nt>, and within the <termref def='dt-litentval'>literal entity value</termref> (<nt def='NT-EntityValue'>EntityValue</nt>) of an internal entity declaration. This section discusses the first two cases; the third is discussed <titleref href='intern-replacement'>below</titleref>. When an <termref def="dt-xml-proc">XML processor</termref> encounters such a reference, or the name of an unparsed entity as the value of an <kw>ENTITY</kw> or <kw>ENTITIES</kw> attribute, then: <olist> <item><p>In all cases, the XML processor may inform the application of the reference's occurrence and its identifier (for an entity reference, the name; for a character reference, the character number in decimal, hexadecimal, or binary form).</p></item> <item><p>For both character and entity references, the processor must remove the reference itself from the <termref def="dt-text">text</termref> data before passing the data to the application. </p></item> <item><p>For character references, the processor must pass the character indicated to the application in place of the reference. </p></item> <item><p>For an external entity, the processor must inform the application of the entity's <termref def="dt-sysid">system identifier</termref>, and <termref def="dt-pubid">public identifier</termref> if any. All strings of white space in the public identifier must be normalized to single space characters (#x20), and leading and trailing white space must be removed.</p></item> <item><p>If the external entity is binary, the processor must inform the application of the associated <termref def="dt-notation">notation</termref> name, and the notation's associated <termref def='dt-sysid'>system</termref> and <termref def='dt-pubid'>public</termref> (if any) identifiers.</p></item> <item><p><termdef id="dt-include" term="Include">For an internal (parsed) entity, the processor must <term>include</term> the entity; that is, retrieve its replacement text and process it as a part of the document (i.e. as <nt def="NT-content">content</nt> or <nt def="NT-AttValue">AttValue</nt>, whichever was being processed when the reference was recognized), passing the result to the application in place of the reference. The replacement text may contain both <termref def='dt-chardata'>character data</termref> and <termref def="dt-markup">markup</termref>, which must be recognized in the usual way, except that the replacement text of entities used to escape markup delimiters (the entities &magicents;) is always treated as data. (The string "<code>AT&amp;amp;T;</code>" expands to "<code>AT&amp;T;</code>" since the ampersand replacing "<code>&amp;amp;</code>" is not recognized as an entity-reference delimiter.) </termdef></p> <p>Since the entity may contain other entity references, an XML processor may have to repeat the inclusion process recursively.</p> </item> <item><p>If the entity is an external parsed entity, then in order to <termref def="dt-valid">validate</termref> the XML document, the processor must <termref def="dt-include">include</termref> the content of the entity.</p></item> <item><p>If the entity is an external parsed entity, and the processor is not attempting to <termref def="dt-valid">validate</termref> the XML document, the processor <termref def="dt-may">may</termref>, but need not, <termref def="dt-include">include</termref> the entity's content.</p> <p>This rule is based on the recognition that the automatic inclusion provided by the SGML and XML entity mechanism, primarily designed to support modularity in authoring, is not necessarily appropriate for other applications, in particular document browsing. Browsers, for example, when encountering an external parsed entity reference, might choose to provide a visual indication of the entity's presence and retrieve it for display only on demand. </p></item> </olist> </p> <p><termdef id="dt-escape" term="escape">Entity and character references can both be used to <term>escape</term> the left angle bracket, ampersand, and other delimiters. A set of general entities (&magicents;) is specified for this purpose. Numeric character references may also be used; they are expanded immediately when recognized, and must be treated as character data, so the numeric character references "<code>&amp;#60;</code>" and "<code>&amp;#38;</code>" may be used to escape <code>&lt;</code> and <code>&amp;</code> when they occur in character data.</termdef></p> </div3> <div3 id='PE-proc'> <head>Parameter Entity Processing</head> <p>Parameter-entity references are only recognized in the <termref def='dt-doctype'>DTD</termref>. Their processing, when they appear within the <termref def='dt-litentval'>literal entity value</termref> (<nt def='NT-EntityValue'>EntityValue</nt>) of an internal entity declaration, is discussed <titleref href='intern-replacement'>below</titleref>. They have these intended uses: <olist> <item><p>as a replacement for one or more complete markup declarations</p></item> <item><p>as a replacement for one or more complete "groups" in element declarations</p></item> <item><p>as a replacement for one or more complete "tokens" in markup declarations</p></item> </olist> </p> <p>The constraints requiring that PE replacement texts be properly nested with <titleref href='vc-PEinMarkupDecl'>markup declarations</titleref> and <titleref href='vc-PEinGroup'>content groups</titleref> govern the first two usages.</p> <p>To support the third intended usage, when an XML processor encounters a parameter-entity reference (outside of the <termref def='dt-litentval'>literal entity value</termref> in an entity declaration), it must <termref def="dt-include">include</termref> the named entity, but first expand its <termref def='dt-repltext'>replacement text</termref> by attaching space (#x20) characters to its beginning and the end, before processing it.</p> <p>The DTD text must match the relevant rules of this specification's grammar after all parameter-entity references have been expanded. <!-In addition, parameter entities referred to in specific contexts are required to satisfy certain constraints in their replacement text; for example, a parameter entity referred to within the internal DTD subset must match the rule for <nt def="NT-markupdecl">markupdecl</nt>. -> </p> </div3> --> </div2> <div2 id='intern-replacement'> <head>…QèŸ[SO&replacement-text;n0ËiÉ{</head> <p>…QèŸ[SOn0ÖSqbD0n0‰š[g0 ÿŸ[SO$P’0ŒNd0n0b__k0:S%RY0‹0S0h0o0y_k0Ëzd00<termdef id="dt-litentval" term='Literal Entity Value'><term>&literal;Ÿ[SO$P</term>o0 ÿŸ[SO£[Š…Qk0Ÿ[›–k0X[(WY0‹0 ÿ_(u&{g0òV€0&string;h0Y0‹00S0Œ0o0 ÿ^—B}ïzŠ÷S<nt def='NT-EntityValue'>EntityValue</nt>k0&match;Y0‹00</termdef><termdef id='dt-repltext' term='Replacement Text'><term>&replacement-text;</term>o0 ÿ‡eW[ÂSgqÊSs0&parameter;Ÿ[SOÂSgqn0nÛcH0Œ_k0J0Q0‹0 ÿŸ[SOn0…Q¹[h0Y0‹00</termdef></p> <p>…QèŸ[SO£[Š…Qg0NH0‹0&literal;Ÿ[SO$P<!-- replacement text -->(<nt def='NT-EntityValue'>EntityValue</nt>)o0 ÿ‡eW[ÂSgq ÿ&parameter;Ÿ[SOÂSgqÊSs0N,‚Ÿ[SOÂSgq’0+T“0g0ˆ0D00S0Œ0‰0n0ÂSgqo0 ÿ<!-- replacement text. -->&literal;Ÿ[SO$P…Qk0Œ[hQk0+T~0Œ0f0D0j0Q0Œ0p0j0‰0j0D00<termref def='dt-include'>U\‹•Y0‹0</termref>Ÿ[›–n0&replacement-text;(HQk0:yW0_0‚0n0)o0 ÿÂSgqY0‹0&parameter;Ÿ[SOn0<emph>&replacement-text;</emph>’0+T~0j0Q0Œ0p0j0‰0Z0 ÿ&literal;Ÿ[SO$P…Qg0n0‡eW[ÂSgqn0ãN0Š0k0ÂSgqW0_0‡eW[’0+T~0j0Q0Œ0p0j0‰0j0D00W0K0W0 ÿN,‚Ÿ[SOÂSgqo0 ÿ]0n0~0~0‹kW0, U\‹•W0f0o0j0‰0j0D00 <!-- in the replacement text that is to be included. --> ‹OH0p0 ÿ!kn0£[Š’0NH0_0h0Y0‹00 <eg><![CDATA[<!ENTITY % pub "&#xc9;ditions Gallimard" > <!ENTITY rights "All rights reserved" > <!ENTITY book "La Peste: Albert Camus, &#xA9; 1947 %pub;. &rights;" >]]></eg> Ÿ[SOn0&replacement-text;"<code>book</code>"o0 ÿ!kn0h0J0Š0h0j0‹00 <eg>La Peste: Albert Camus, &#169; 1947 &#201;ditions Gallimard. &amp;rights;</eg> ÂSgq"<code>&amp;book;</code>"L0 ÿ‡eøfn0…Q¹[ÈSo0^\'`$P…Qk0úQþsW0f0D0Œ0p0 ÿN,‚Ÿ[SOÂSgq"<code>&amp;rights;</code>"o0 ÿU\‹•U0Œ0f0D0‹00</p> <p>S0Œ0‰0n0XS}j0‰GRo0 ÿ‰Tøv’N\O(u’0‚0d00 <!-- åe,gžŠ3Šk0d0D0f0ÿ interaction = øv’N\O(uÿÑ‘,g ÿ--> ã–W0D0‹Ok0d0D0f0n0sŠ0}o0 ÿ<titleref href='sec-entexpand'>Ÿ[SOÂSgqn0U\‹•n0ØN2“</titleref>’0ÂSgqn0S0h00 </p> <!-- Replaced by the above -TB <p>Implementors of XML processors need to know the rules for expansion of references in more detail. These rules only come into play when the replacement text for an internal entity itself contains other references. <olist> <item><p>In the replacement text of an internal entity, parameter-entity references and character references in the replacement text are recognized and resolved when the entity declaration is parsed, before the replacement text is stored in the processor's symbol table. General-entity references in the replacement text are not resolved when the entity declaration is parsed.</p></item> <item><p>In the document, when a general-entity reference is resolved, its replacement text is parsed. Character references encountered in the replacement text are resolved immediately; general-entity references encountered in the replacement text may be resolved or left unresolved, as described <titleref href="entproc">above</titleref>. Character and general-entity references must be contained entirely within the entity's replacement text. </p></item> </olist> </p> <p>Simple character references do not suffice to escape delimiters within the replacement text of an internal entity: they will be expanded when the entity declaration is parsed, before the replacement text is stored in the symbol table. When the entity itself is referred to, the replacement text will be parsed again, and the delimiters (no longer character references) will be recognized as delimiters. To escape the characters &magicents; in an entity replacement text, use a general-entity reference or a doubly-escaped character reference. See <titleref href='sec-entexpand'>the appendix on expansion of entity references</titleref> for detailed examples.</p> --> </div2> <div2 id='sec-predefined-ent'> <head>š[©n0Ÿ[SO</head> <p><termdef id="dt-escape" term="escape"> Ÿ[SOÂSgqÊSs0‡eW[ÂSgqn0D0Z0Œ0‚0 ÿ&left-angle-bracket; ÿ¢0ó0Ð0µ0ó0É0ÊSs0ÖNn0:SRŠ0P[’0<term>&escape;</term>Y0‹0_00k0O(ug0M0‹00D0O0d0K0n0N,‚Ÿ[SOÿ&magicents; ÿ’0 ÿS0n0îv„vn0_00k0cš[Y0‹00pe$Pk0ˆ0‹0‡eW[ÂSgq‚0 ÿ TØin0îv„vn0_00k0O(ug0M0‹00‡eW[ÂSgqo0 ÿŠX‹U0Œ0‹0h0ôva0k0U\‹•U0Œ0 ÿ‡eW[Ç0ü0¿0h0W0f0qb0Œ0‹0n0g0 ÿpe$Pk0ˆ0‹0‡eW[ÂSgq"<code>&amp;#60;</code>"ÊSs0"<code>&amp;#38;</code>"o0 ÿ‡eW[Ç0ü0¿0…Qk0úQþsY0‹0<code>&lt;</code>ÊSs0<code>&amp;</code>’0&escape;Y0‹0_00k0O(ug0M0‹00</termdef></p> <p>Y0y0f0n0XML&processor;o0 ÿ£[ŠU0Œ0f0D0‹0K0i0F0K0k0¢•ÂOj0O0 ÿS0Œ0‰0n0Ÿ[SO’0ŠX‹W0j0O0f0o0j0‰0j0D00<termref def='dt-interop'>øv’NK(u'`n0_00</termref> ÿ&valid;j0XML‡eøfo0 ÿS0Œ0‰0n0Ÿ[SO’0O(uY0‹0MRk0 ÿÖNn0Ÿ[SOh0 TØik0 ÿ£[ŠY0‹0S0h0L0g~0W0D00Ÿ[SO’0£[ŠY0‹04XTo0 ÿ&replacement-text;’0&escape;Y0‹0N‡eW[h0Y0‹0…QèŸ[SOh0W0f0 ÿ!kn0h0J0Š0k0£[ŠW0j0Q0Œ0p0j0‰0j0D00 <eg><![CDATA[<!ENTITY lt "&#38;#60;"> <!ENTITY gt "&#62;"> <!ENTITY amp "&#38;#38;"> <!ENTITY apos "&#39;"> <!ENTITY quot "&#34;"> ]]></eg> "<code>lt</code>"ÊSs0"<code>amp</code>"£[Š…Qn0"<code>&lt;</code>"ÊSs0"<code>&amp;</code>"‡eW[o0 ÿŸ[SOn0nÛcÆ0­0¹0È0L0 ÿ&well-formed;h0j0‹0ˆ0F0k0ŒNÍ‘k0&escape;U0Œ0‹0S0h0k0èla0 </p> </div2> <div2 id='Notations'> <head>ŠÕl£[Š</head> <p> <termdef id="dt-notation" term="Notation"> <term>ŠÕl</term>o0 ÿ<termref def="dt-extent">&unparsed-entity;</termref>n0b__’0&identify; TMRK0 ÿÈSo0<termref def="dt-pi">æQt}TäN</termref>n0þ[aŒh0Y0‹0&application;’0&identify; TMRh0Y0‹00</termdef></p> <p><termdef id="dt-notdecl" term="Notation Declaration"> <term>ŠÕl£[Š</term>o0 ÿŠÕln0 TMRÊSs0Yè&identifier;’0Ðc›OY0‹00S0n0 TMRo0 ÿŸ[SOÊSs0^\'`ê0¹0È0£[Š&Ns0k0^\'`cš[k0(uD0‹00Yè&identifier;o0 ÿNH0‰0Œ0_0ŠÕln0Ç0ü0¿0’0æQtg0M0‹0Ø0ë0Ñ0&application;’0 ÿXML&processor;ÈSo0¯0é0¤0¢0ó0È0¢0×0ê0±0ü0·0ç0ó0L0¢cY0_00k0 ÿ)R(ug0M0‹00 <scrap lang='ebnf'> <head>ŠÕl£[Š</head> <prod id='NT-NotationDecl'><lhs>NotationDecl</lhs> <rhs>'&lt;!NOTATION' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> (<nt def='NT-ExternalID'>ExternalID</nt> | <nt def='NT-PublicID'>PublicID</nt>) <nt def='NT-S'>S</nt>? '>'</rhs></prod> <prod id='NT-PublicID'><lhs>PublicID</lhs> <rhs>'PUBLIC' <nt def='NT-S'>S</nt> <nt def='NT-PubidLiteral'>PubidLiteral</nt> </rhs></prod> </scrap> </termdef></p> <p>£[ŠW0 ÿ^\'`$P ÿ^\'`š[©ÈSo0Ÿ[SO£[Šg0ÂSgqY0‹0Y0y0f0n0ŠÕlk0d0D0f0 ÿXML&processor;o0 ÿŠÕln0 TMRÊSs0Yè&identifier;’0&application;k0Ðc›OW0j0Q0Œ0p0j0‰0j0D00U0‰0k0 ÿYè&identifier;’0 ÿ<termref def="dt-sysid">·0¹0Æ0à0&identifier;</termref> ÿÕ0¡0¤0ë0 TÈSo0]0n0ÖNn0Å`1Xk0U\‹•W0f0‚0ˆ0O0 ÿS0Œ0‰0’0(uD0f0 ÿ&application;o0 ÿ]0n0ŠÕln0Ç0ü0¿0’0æQtY0‹0&processor;’0wÕRY0‹00(W0K0W0 ÿXML&processor;ÈSo0&application;L0ÕR\OY0‹0·0¹0Æ0à0g0o0)R(ug0M0j0D0ŠÕl’0 ÿXML‡eøfL0£[ŠW0ÂSgqW0f0‚0 ÿS0Œ0o0 ÿ&error;h0o0W0j0D00 ÿ</p> </div2> <div2 id='sec-doc-entity'> <head>‡eøfŸ[SO</head> <p><termdef id="dt-docent" term="Document Entity"><term>‡eøfŸ[SO</term>o0 ÿŸ[SOn0b_bY0‹0(gËi n0&root;g0B0c0f0 ÿ<termref def="dt-xml-proc">XML&processor;</termref>L0 ÿæQt’0‹•ËYY0‹00W¹ph0Y0‹00</termdef>S0n0&TR-or-Rec;o0 ÿXML&processor;L0 ÿ‡eøfŸ[SOn0X[(WY0‹04X@b’0i0n0ˆ0F0k0‹‰d0Q0‹0K0o0 ÿ‰š[W0j0D00ÖNn0Ÿ[SOh0puj0Š0 ÿ‡eøfŸ[SOo0 TMR’0‚0_0Z0 ÿD0K0j0‹0X‹%R‚0j0W0k0&processor;x0n0eQ›R&stream;k0úQþsW0f0‚0ˆ0D00</p> </div2> </div1> <!-- &Conformance; --> <div1 id='sec-conformance'> <head>iT'`</head> <p>iTY0‹0<termref def="dt-xml-proc">XML&processor;</termref>o0 ÿ&validating;‚0n0ÊSs0&non-validating;‚0n0n0 ÿŒNd0k0R^˜U0Œ0‹00</p> <p>&validating;·0¹0Æ0à0ÊSs0&non-validating;·0¹0Æ0à0o0 ÿS0n0&TR-or-Rec;L0‰š[Y0‹0&well-formed;6R}x0n0UÍS’01XJTW0j0Q0Œ0p0j0‰0j0D00</p> <p><termdef id="dt-validating" term="Validating Processor"><term>&validating;&processor;</term>o0 ÿ<termref def="dt-doctype">DTD</termref>…Qn0£[Šk0ˆ0c0f0:yU0Œ0_0 ÿ6R}x0n0UÍS’01XJTW0j0Q0Œ0p0j0‰0j0D00U0‰0k0 ÿS0n0&TR-or-Rec;L0‰š[Y0‹0&validity;6R}x0n0UÍS’0 ÿY0y0f01XJTW0j0Q0Œ0p0j0‰0j0D00 </termdef> </p> </div1> <div1 id='sec-notation'> <head>ŠÕl</head> <p>XMLn0b__„vj0‡eÕlo0 ÿ!|XSj0áb5_Backus-Naur Form(EBNF)ŠÕlk0ˆ0c0f0NH0‹00‡eÕln0T‰GRo0 ÿ!kn0b__g0 ÿŠ÷S’0Nd0š[©Y0‹00 <eg>symbol ::= expression</eg></p> <p>Š÷So0 ÿck‰hˆþsg0š[©Y0‹0h0M0o0'Y‡eW[g0ËY0 ÿ]0F0g0j0Q0Œ0p0 ÿ\‡eW[g0ËY0‹00&string;&literal;o0 ÿ_(u&{g0òV€00 <!--* The distinction between symbols which can and cannot be recognized using simple regular expressions may be used to set the boundary between an implementation's lexical scanner and its parser, but this specification neither constrains the placement of that boundary nor presupposes that all implementations will have one. *--> </p> <p>‰GRn0óStPn0_…Qg0o0 ÿNd0ÈSo0‰pen0‡eW[K0‰0j0‹0&string;h0&match;Y0‹0_00k0 ÿ!kn0_’0O(uY0‹00 <glist> <gitem> <label><code>#xN</code></label> <def><p>S0S0g0 ÿ<code>N</code>o0162n0tepeh0Y0‹00ISO/IEC 10646n0‡eW[g0B0c0f0 ÿck‰b_(UCS-4)n0&code-value;’0&{÷Sj0W022peh0W0f0ã‰È‘W0_0h0M0 ÿcš[W0_0$Ph0I{W0D0‚0n0h0&match;Y0‹00<code>#xN</code>b__n0HQ-˜k0¼0í0L0D0O0d0K0þsŒ0‹0K0o0 ÿasT’0‚0_0j0D00&code-value;<!-- bit string -->k0J0Q0‹0HQ-˜n0¼0í0n0peo0 ÿ‡eW[n0&{÷SSk0ˆ0c0f0zlš[U0Œ0‹0n0g0 ÿXMLk0h0c0f0o0asTL0j0D00 </p></def> </gitem> <gitem> <label><code>[a-zA-Z]</code>, <code>[#xN-#xN]</code></label> <def><p>cš[W0_0Ä{òVn0$P(!Nïzn0$P’0+T€00 ÿ’0‚0d0ûNan0<termref def='dt-character'>‡eW[</termref>h0&match;Y0‹00</p></def> </gitem> <gitem> <label><code>[^a-z]</code>, <code>[^#xN-#xN]</code></label> <def><p>cš[W0_0Ä{òV<emph>Y</emph>n0$P’0‚0d0ûNan0<termref def='dt-character'>‡eW[</termref>h0&match;Y0‹00</p></def> </gitem> <gitem> <label><code>[^abc]</code>, <code>[^#xN#xN#xN]</code></label> <def><p>cš[W0_0‡eW[åNYn0$P’0‚0d0ûNan0<termref def='dt-character'>‡eW[</termref>h0&match;Y0‹00</p></def> </gitem> <gitem> <label><code>"string"</code></label> <def><p>&double-quote;g0òV€0&string;&literal;h0<termref def="dt-match">&match;W0f0D0‹0</termref>&string;&literal;h0&match;Y0‹00</p></def> </gitem> <gitem> <label><code>'string'</code></label> <def><p>&single-quote;g0òV€0&string;&literal;h0<termref def="dt-match">&match;W0f0D0‹0</termref>&string;&literal;h0&match;Y0‹00</p></def> </gitem> </glist> S0Œ0‰0n0Š÷So0 ÿ!kn0b__n0D}T[0g0O(uY0‹00S0S0g0 ÿ<code>A</code>ÊSs0<code>B</code>o0 ÿXS}j0_h0Y0‹00 <glist> <gitem> <label>(<code>expression</code>)</label> <def><p><code>expression</code>o0 ÿNd0n0~0h0~0Š0h0W0f0qbD0 ÿS0S0k0:yY0D}T[0g0Oc0f0‚0ˆ0D00</p></def> </gitem> <gitem> <label><code>A?</code></label> <def><p><code>A</code>ÈSo0UO‚0j0W0h0&match;Y0‹0(ª0×0·0ç0ó0n0<code>A</code>)0</p></def> </gitem> <gitem> <label><code>A B</code></label> <def><p><code>A</code>n0!kk0<code>B</code>L0úQþsY0‹0‚0n0h0&match;Y0‹00 </p></def> </gitem> <gitem> <label><code>A | B</code></label> <def><p><code>A</code>ÈSo0<code>B</code> ÿ_0`0W0 ÿ!N¹eg0o0j0D0 ÿh0&match;Y0‹00 </p></def> </gitem> <gitem> <label><code>A - B</code></label> <def><p><code>A</code>h0&match;Y0‹0L0 ÿ<code>B</code>h0o0&match;W0j0D0 ÿûNan0&string;h0&match;Y0‹00</p></def> </gitem> <gitem> <label><code>A+</code></label> <def><p><code>A</code>n01ÞVåN Nn0p~ÔW0h0&match;Y0‹00</p></def> </gitem> <gitem> <label><code>A*</code></label> <def><p><code>A</code>n00ÞVåN Nn0p~ÔW0h0&match;Y0‹00</p></def> </gitem> <!-- DEATH TO %'s <gitem> <label><code>%a</code></label> <def><p>specifies that <emph>in the external DTD subset</emph> a <termref def='dt-param-entity'>parameter entity</termref> may occur in the text at the position where <code>a</code> may occur; if so, its replacement text must match <code>S? a S?</code>. If the expression <code>a</code> is governed by a suffix operator, then the suffix operator determines both the maximum number of parameter-entity references allowed and the number of occurrences of <code>a</code> in the replacement text of the parameter entities: <code>%a*</code> means that <code>a</code> must occur zero or more times, and that some of its occurrences may be replaced by references to parameter entities whose replacement text must contain zero or more occurrences of <code>a</code>; it is thus a more compact way of writing <code>%(a*)*</code>. Similarly, <code>%a+</code> means that <code>a</code> must occur one or more times, and may be replaced by parameter entities with replacement text matching <code>S? (a S?)+</code>. The recognition of parameter entities in the internal subset is much more highly constrained. </p></def> </gitem> --> </glist> ub‰GR…Qg0O(uY0‹0ÖNn0ŠÕl’0 ÿ!kk0:yY00 <glist> <gitem> <label><code>/* ... */</code></label> <def><p>³0á0ó0È00</p></def> </gitem> <gitem> <label><code>[ wfc: ... ]</code></label> <def><p>&well-formed;6R}0ub‰GRk0ØNNW0_0 ÿ<termref def="dt-wellformed">&well-formed;</termref>n0‡eøfk0¢•Y0‹06R}’0 ÿ TMRk0ˆ0c0f0&identify;0</p></def> </gitem> <gitem> <label><code>[ vc: ... ]</code></label> <def><p>&validity;6R}0ub‰GRk0ØNNW0_0 ÿ<termref def="dt-valid">&valid;</termref>j0‡eøfk0¢•Y0‹06R}’0 ÿ TMRk0ˆ0c0f0&identify;0 </p></def> </gitem> </glist> </p></div1> </body> <back> <!-- &SGML; --> <!-- &Biblio; --> <div1 id='sec-bibliography'> <head>ÂS€‡e.s</head> <div2 id='sec-existing-stds'> <head>&normative;ÂS€‡e.s</head> <!--* <ulist><item> <p>Unicode and ISO/IEC 10646. This specification depends on the international standard ISO/IEC 10646 (with amendments AM 1 through AM 7) and the Unicode Standard, Version 2.0 <bibref ref='Unicode'/>, which define the encodings and meanings of the <termref def="dt-character">characters</termref> which make up XML <termref def="dt-text">text</termref>. All the characters in ISO/IEC 10646 are present, at the same code points, in Unicode.</p></item> <item><p>XXX XXX defines the syntax and semantics of Uniform Resource Identifiers, or URIs.</p></item> <item><p>IETF RFC 1766, with ISO 639 and 3166, describe the codes that may be used in the special <titleref href='sec-lang-tag'>xml:lang</titleref> attribute.</p> </item></ulist> *--> <blist> <bibl id='RFC1766' key='IETF RFC 1766'> IETF (Internet Engineering Task Force). <emph>RFC 1766: Tags for the Identification of Languages</emph>, ed. H. Alvestrand. 1995. </bibl> <bibl id='ISO639' key='ISO 639'> (International Organization for Standardization). <emph>ISO 8879:1988 (E). Code for the representation of names of languages.</emph> [Geneva]: International Organization for Standardization, 1988.</bibl> <bibl id='ISO3166' key='ISO 3166'> (International Organization for Standardization). <emph>ISO 3166-1:1997 (E). Codes for the representation of names of countries and their subdivisions &mdash; Part 1: Country codes</emph> [Geneva]: International Organization for Standardization, 1997.</bibl> <bibl id='ISO10646' key='ISO/IEC 10646'>ISO (International Organization for Standardization). <emph>ISO/IEC 10646-1993 (E). Information technology &mdash; Universal Multiple-Octet Coded Character Set (UCS) &mdash; Part 1: Architecture and Basic Multilingual Plane.</emph> [Geneva]: International Organization for Standardization, 1993 (plus amendments AM 1 through AM 7). </bibl> <bibl id='Unicode' key='Unicode'>The Unicode Consortium. <emph>The Unicode Standard, Version 2.0.</emph> Reading, Mass.: Addison-Wesley Developers Press, 1996.</bibl> </blist> </div2> <div2><head>ÖNn0ÂS€‡e.s</head> <blist> <bibl id='Aho' key='Aho/Ullman'>Aho, Alfred V., Ravi Sethi, and Jeffrey D. Ullman. <emph>Compilers: Principles, Techniques, and Tools</emph>. Reading: Addison-Wesley, 1986, rpt. corr. 1988.</bibl> <bibl id="Berners-Lee" xml-link="simple" key="Berners-Lee et al."> Berners-Lee, T., R. Fielding, and L. Masinter. <emph>Uniform Resource Identifiers (URI): Generic Syntax and Semantics</emph>. 1997. (Work in progress; see updates to RFC1738.)</bibl> <bibl id='ABK' key='Br&#252;ggemann-Klein'>Br&#252;ggemann-Klein, Anne. <emph>Regular Expressions into Finite Automata</emph>. Extended abstract in I. Simon, Hrsg., LATIN 1992, S. 97-98. Springer-Verlag, Berlin 1992. Full Version in Theoretical Computer Science 120: 197-213, 1993. <!-- Universitat Freiburg, Institut fur Informatik, Bericht 33, Juli 1991.--> </bibl> <bibl id='ABKDW' key='Br&#252;ggemann-Klein and Wood'>Br&#252;ggemann-Klein, Anne, and Derick Wood. <emph>Deterministic Regular Languages</emph>. Universit&#228;t Freiburg, Institut f&#252;r Informatik, Bericht 38, Oktober 1991. </bibl> <bibl id="RFC1738" xml-link="simple" key="IETF RFC1738"> IETF (Internet Engineering Task Force). <emph>RFC 1738: Uniform Resource Locators (URL)</emph>, ed. T. Berners-Lee, L. Masinter, M. McCahill. 1994. </bibl> <bibl id="RFC1808" xml-link="simple" key="IETF RFC1808"> IETF (Internet Engineering Task Force). <emph>RFC 1808: Relative Uniform Resource Locators</emph>, ed. R. Fielding. 1995. </bibl> <bibl id="RFC2141" xml-link="simple" key="IETF RFC2141"> IETF (Internet Engineering Task Force). <emph>RFC 2141: URN Syntax</emph>, ed. R. Moats. 1997. </bibl> <bibl id='ISO8879' key='ISO/IEC 8879'>ISO (International Organization for Standardization). <emph>ISO/IEC 8879-1986 (E). Information processing &mdash; Text and Office Systems &mdash; Standard Generalized Markup Language (SGML).</emph> First edition &mdash; 1986-10-15. [Geneva]: International Organization for Standardization, 1986. </bibl> <bibl id='ISO10744' key='ISO/IEC 10744'>ISO (International Organization for Standardization). <emph>ISO/IEC 10744-1992 (E). Information technology &mdash; Hypermedia/Time-based Structuring Language (HyTime). </emph> [Geneva]: International Organization for Standardization, 1992. <emph>Extended Facilities Annexe.</emph> [Geneva]: International Organization for Standardization, 1996. </bibl> </blist> </div2> </div1> <div1 id='CharClasses'> <head>‡eW[¯0é0¹0</head> <p>Unicodej–nk0š[©Y0‹0&property;k0W0_0L0c0f0 ÿ‡eW[o0 ÿ&base-character;(BaseChar)(S0Œ0‰0o0 ÿ&diacritical-mark;’0d–O0é0Æ0ó0¢0ë0Õ0¡0Ù0Ã0È0n0¢0ë0Õ0¡0Ù0Ã0È0‡eW[’0+T€0) ÿ&ideographic;(ideographic)ÊSs0&combining-character;(CombiningChar)(S0n0¯0é0¹0o0 ÿ{0h0“0i0n0&diacritical-mark;’0+T€0)k0¯0é0¹0RQ0Y0‹00S0Œ0‰0n0¯0é0¹0o0 ÿP}TW0 ÿ&letter;(Letter)n0¯0é0¹0h0j0‹00102pe$P(Digit)ÊSs0&extender;(Extender)‚0:S%RY0‹00 <scrap lang="ebnf" id="CHARACTERS"> <head>‡eW[</head> <prodgroup pcw3="3" pcw4="15"> <prod id="NT-Letter"><lhs>Letter</lhs> <rhs><nt def="NT-BaseChar">BaseChar</nt> | <nt def="NT-Ideographic">Ideographic</nt></rhs> </prod> <prod id='NT-BaseChar'><lhs>BaseChar</lhs> <rhs>[#x0041-#x005A] |&nbsp;[#x0061-#x007A] |&nbsp;[#x00C0-#x00D6] |&nbsp;[#x00D8-#x00F6] |&nbsp;[#x00F8-#x00FF] |&nbsp;[#x0100-#x0131] |&nbsp;[#x0134-#x013E] |&nbsp;[#x0141-#x0148] |&nbsp;[#x014A-#x017E] |&nbsp;[#x0180-#x01C3] |&nbsp;[#x01CD-#x01F0] |&nbsp;[#x01F4-#x01F5] |&nbsp;[#x01FA-#x0217] |&nbsp;[#x0250-#x02A8] |&nbsp;[#x02BB-#x02C1] |&nbsp;#x0386 |&nbsp;[#x0388-#x038A] |&nbsp;#x038C |&nbsp;[#x038E-#x03A1] |&nbsp;[#x03A3-#x03CE] |&nbsp;[#x03D0-#x03D6] |&nbsp;#x03DA |&nbsp;#x03DC |&nbsp;#x03DE |&nbsp;#x03E0 |&nbsp;[#x03E2-#x03F3] |&nbsp;[#x0401-#x040C] |&nbsp;[#x040E-#x044F] |&nbsp;[#x0451-#x045C] |&nbsp;[#x045E-#x0481] |&nbsp;[#x0490-#x04C4] |&nbsp;[#x04C7-#x04C8] |&nbsp;[#x04CB-#x04CC] |&nbsp;[#x04D0-#x04EB] |&nbsp;[#x04EE-#x04F5] |&nbsp;[#x04F8-#x04F9] |&nbsp;[#x0531-#x0556] |&nbsp;#x0559 |&nbsp;[#x0561-#x0586] |&nbsp;[#x05D0-#x05EA] |&nbsp;[#x05F0-#x05F2] |&nbsp;[#x0621-#x063A] |&nbsp;[#x0641-#x064A] |&nbsp;[#x0671-#x06B7] |&nbsp;[#x06BA-#x06BE] |&nbsp;[#x06C0-#x06CE] |&nbsp;[#x06D0-#x06D3] |&nbsp;#x06D5 |&nbsp;[#x06E5-#x06E6] |&nbsp;[#x0905-#x0939] |&nbsp;#x093D |&nbsp;[#x0958-#x0961] |&nbsp;[#x0985-#x098C] |&nbsp;[#x098F-#x0990] |&nbsp;[#x0993-#x09A8] |&nbsp;[#x09AA-#x09B0] |&nbsp;#x09B2 |&nbsp;[#x09B6-#x09B9] |&nbsp;[#x09DC-#x09DD] |&nbsp;[#x09DF-#x09E1] |&nbsp;[#x09F0-#x09F1] |&nbsp;[#x0A05-#x0A0A] |&nbsp;[#x0A0F-#x0A10] |&nbsp;[#x0A13-#x0A28] |&nbsp;[#x0A2A-#x0A30] |&nbsp;[#x0A32-#x0A33] |&nbsp;[#x0A35-#x0A36] |&nbsp;[#x0A38-#x0A39] |&nbsp;[#x0A59-#x0A5C] |&nbsp;#x0A5E |&nbsp;[#x0A72-#x0A74] |&nbsp;[#x0A85-#x0A8B] |&nbsp;#x0A8D |&nbsp;[#x0A8F-#x0A91] |&nbsp;[#x0A93-#x0AA8] |&nbsp;[#x0AAA-#x0AB0] |&nbsp;[#x0AB2-#x0AB3] |&nbsp;[#x0AB5-#x0AB9] |&nbsp;#x0ABD |&nbsp;#x0AE0 |&nbsp;[#x0B05-#x0B0C] |&nbsp;[#x0B0F-#x0B10] |&nbsp;[#x0B13-#x0B28] |&nbsp;[#x0B2A-#x0B30] |&nbsp;[#x0B32-#x0B33] |&nbsp;[#x0B36-#x0B39] |&nbsp;#x0B3D |&nbsp;[#x0B5C-#x0B5D] |&nbsp;[#x0B5F-#x0B61] |&nbsp;[#x0B85-#x0B8A] |&nbsp;[#x0B8E-#x0B90] |&nbsp;[#x0B92-#x0B95] |&nbsp;[#x0B99-#x0B9A] |&nbsp;#x0B9C |&nbsp;[#x0B9E-#x0B9F] |&nbsp;[#x0BA3-#x0BA4] |&nbsp;[#x0BA8-#x0BAA] |&nbsp;[#x0BAE-#x0BB5] |&nbsp;[#x0BB7-#x0BB9] |&nbsp;[#x0C05-#x0C0C] |&nbsp;[#x0C0E-#x0C10] |&nbsp;[#x0C12-#x0C28] |&nbsp;[#x0C2A-#x0C33] |&nbsp;[#x0C35-#x0C39] |&nbsp;[#x0C60-#x0C61] |&nbsp;[#x0C85-#x0C8C] |&nbsp;[#x0C8E-#x0C90] |&nbsp;[#x0C92-#x0CA8] |&nbsp;[#x0CAA-#x0CB3] |&nbsp;[#x0CB5-#x0CB9] |&nbsp;#x0CDE |&nbsp;[#x0CE0-#x0CE1] |&nbsp;[#x0D05-#x0D0C] |&nbsp;[#x0D0E-#x0D10] |&nbsp;[#x0D12-#x0D28] |&nbsp;[#x0D2A-#x0D39] |&nbsp;[#x0D60-#x0D61] |&nbsp;[#x0E01-#x0E2E] |&nbsp;#x0E30 |&nbsp;[#x0E32-#x0E33] |&nbsp;[#x0E40-#x0E45] |&nbsp;[#x0E81-#x0E82] |&nbsp;#x0E84 |&nbsp;[#x0E87-#x0E88] |&nbsp;#x0E8A |&nbsp;#x0E8D |&nbsp;[#x0E94-#x0E97] |&nbsp;[#x0E99-#x0E9F] |&nbsp;[#x0EA1-#x0EA3] |&nbsp;#x0EA5 |&nbsp;#x0EA7 |&nbsp;[#x0EAA-#x0EAB] |&nbsp;[#x0EAD-#x0EAE] |&nbsp;#x0EB0 |&nbsp;[#x0EB2-#x0EB3] |&nbsp;#x0EBD |&nbsp;[#x0EC0-#x0EC4] |&nbsp;[#x0F40-#x0F47] |&nbsp;[#x0F49-#x0F69] |&nbsp;[#x10A0-#x10C5] |&nbsp;[#x10D0-#x10F6] |&nbsp;#x1100 |&nbsp;[#x1102-#x1103] |&nbsp;[#x1105-#x1107] |&nbsp;#x1109 |&nbsp;[#x110B-#x110C] |&nbsp;[#x110E-#x1112] |&nbsp;#x113C |&nbsp;#x113E |&nbsp;#x1140 |&nbsp;#x114C |&nbsp;#x114E |&nbsp;#x1150 |&nbsp;[#x1154-#x1155] |&nbsp;#x1159 |&nbsp;[#x115F-#x1161] |&nbsp;#x1163 |&nbsp;#x1165 |&nbsp;#x1167 |&nbsp;#x1169 |&nbsp;[#x116D-#x116E] |&nbsp;[#x1172-#x1173] |&nbsp;#x1175 |&nbsp;#x119E |&nbsp;#x11A8 |&nbsp;#x11AB |&nbsp;[#x11AE-#x11AF] |&nbsp;[#x11B7-#x11B8] |&nbsp;#x11BA |&nbsp;[#x11BC-#x11C2] |&nbsp;#x11EB |&nbsp;#x11F0 |&nbsp;#x11F9 |&nbsp;[#x1E00-#x1E9B] |&nbsp;[#x1EA0-#x1EF9] |&nbsp;[#x1F00-#x1F15] |&nbsp;[#x1F18-#x1F1D] |&nbsp;[#x1F20-#x1F45] |&nbsp;[#x1F48-#x1F4D] |&nbsp;[#x1F50-#x1F57] |&nbsp;#x1F59 |&nbsp;#x1F5B |&nbsp;#x1F5D |&nbsp;[#x1F5F-#x1F7D] |&nbsp;[#x1F80-#x1FB4] |&nbsp;[#x1FB6-#x1FBC] |&nbsp;#x1FBE |&nbsp;[#x1FC2-#x1FC4] |&nbsp;[#x1FC6-#x1FCC] |&nbsp;[#x1FD0-#x1FD3] |&nbsp;[#x1FD6-#x1FDB] |&nbsp;[#x1FE0-#x1FEC] |&nbsp;[#x1FF2-#x1FF4] |&nbsp;[#x1FF6-#x1FFC] |&nbsp;#x2126 |&nbsp;[#x212A-#x212B] |&nbsp;#x212E |&nbsp;[#x2180-#x2182] |&nbsp;[#x3041-#x3094] |&nbsp;[#x30A1-#x30FA] |&nbsp;[#x3105-#x312C] |&nbsp;[#xAC00-#xD7A3] </rhs></prod> <prod id='NT-Ideographic'><lhs>Ideographic</lhs> <rhs>[#x4E00-#x9FA5] |&nbsp;#x3007 |&nbsp;[#x3021-#x3029] </rhs></prod> <prod id='NT-CombiningChar'><lhs>CombiningChar</lhs> <rhs>[#x0300-#x0345] |&nbsp;[#x0360-#x0361] |&nbsp;[#x0483-#x0486] |&nbsp;[#x0591-#x05A1] |&nbsp;[#x05A3-#x05B9] |&nbsp;#x05BB#x05BD |&nbsp;#x05BF |&nbsp;[#x05C1-#x05C2] |&nbsp;#x05C4 |&nbsp;#x064B#x0652 |&nbsp;#x0670 |&nbsp;[#x06D6-#x06DC] |&nbsp;#x06DD#x06DF |&nbsp;[#x06E0-#x06E4] |&nbsp;[#x06E7-#x06E8] |&nbsp;[#x06EA-#x06ED] |&nbsp;[#x0901-#x0903] |&nbsp;#x093C |&nbsp;[#x093E-#x094C] |&nbsp;#x094D |&nbsp;[#x0951-#x0954] |&nbsp;[#x0962-#x0963] |&nbsp;[#x0981-#x0983] |&nbsp;#x09BC |&nbsp;#x09BE |&nbsp;#x09BF |&nbsp;[#x09C0-#x09C4] |&nbsp;[#x09C7-#x09C8] |&nbsp;[#x09CB-#x09CD] |&nbsp;#x09D7 |&nbsp;[#x09E2-#x09E3] |&nbsp;#x0A02 |&nbsp;#x0A3C |&nbsp;#x0A3E |&nbsp;#x0A3F |&nbsp;[#x0A40-#x0A42] |&nbsp;[#x0A47-#x0A48] |&nbsp;[#x0A4B-#x0A4D] |&nbsp;[#x0A70-#x0A71] |&nbsp;[#x0A81-#x0A83] |&nbsp;#x0ABC |&nbsp;[#x0ABE-#x0AC5] |&nbsp;[#x0AC7-#x0AC9] |&nbsp;[#x0ACB-#x0ACD] |&nbsp;[#x0B01-#x0B03] |&nbsp;#x0B3C |&nbsp;[#x0B3E-#x0B43] |&nbsp;[#x0B47-#x0B48] |&nbsp;[#x0B4B-#x0B4D] |&nbsp;[#x0B56-#x0B57] |&nbsp;[#x0B82-#x0B83] |&nbsp;[#x0BBE-#x0BC2] |&nbsp;[#x0BC6-#x0BC8] |&nbsp;[#x0BCA-#x0BCD] |&nbsp;#x0BD7 |&nbsp;[#x0C01-#x0C03] |&nbsp;[#x0C3E-#x0C44] |&nbsp;[#x0C46-#x0C48] |&nbsp;[#x0C4A-#x0C4D] |&nbsp;[#x0C55-#x0C56] |&nbsp;[#x0C82-#x0C83] |&nbsp;[#x0CBE-#x0CC4] |&nbsp;[#x0CC6-#x0CC8] |&nbsp;[#x0CCA-#x0CCD] |&nbsp;[#x0CD5-#x0CD6] |&nbsp;[#x0D02-#x0D03] |&nbsp;[#x0D3E-#x0D43] |&nbsp;[#x0D46-#x0D48] |&nbsp;[#x0D4A-#x0D4D] |&nbsp;#x0D57 |&nbsp;#x0E31 |&nbsp;[#x0E34-#x0E3A] |&nbsp;[#x0E47-#x0E4E] |&nbsp;#x0EB1 |&nbsp;[#x0EB4-#x0EB9] |&nbsp;[#x0EBB-#x0EBC] |&nbsp;[#x0EC8-#x0ECD] |&nbsp;[#x0F18-#x0F19] |&nbsp;#x0F35 |&nbsp;#x0F37 |&nbsp;#x0F39 |&nbsp;#x0F3E |&nbsp;#x0F3F |&nbsp;[#x0F71-#x0F84] |&nbsp;[#x0F86-#x0F8B] |&nbsp;[#x0F90-#x0F95] |&nbsp;#x0F97 |&nbsp;[#x0F99-#x0FAD] |&nbsp;[#x0FB1-#x0FB7] |&nbsp;#x0FB9 |&nbsp;[#x20D0-#x20DC] |&nbsp;#x20E1 |&nbsp;[#x302A-#x302F] |&nbsp;#x3099 |&nbsp;#x309A </rhs></prod> <prod id='NT-Digit'><lhs>Digit</lhs> <rhs>[#x0030-#x0039] |&nbsp;[#x0660-#x0669] |&nbsp;[#x06F0-#x06F9] |&nbsp;[#x0966-#x096F] |&nbsp;[#x09E6-#x09EF] |&nbsp;[#x0A66-#x0A6F] |&nbsp;[#x0AE6-#x0AEF] |&nbsp;[#x0B66-#x0B6F] |&nbsp;[#x0BE7-#x0BEF] |&nbsp;[#x0C66-#x0C6F] |&nbsp;[#x0CE6-#x0CEF] |&nbsp;[#x0D66-#x0D6F] |&nbsp;[#x0E50-#x0E59] |&nbsp;[#x0ED0-#x0ED9] |&nbsp;[#x0F20-#x0F29] </rhs></prod> <prod id='NT-Extender'><lhs>Extender</lhs> <rhs>#x00B7 |&nbsp;#x02D0 |&nbsp;#x02D1 |&nbsp;#x0387 |&nbsp;#x0640 |&nbsp;#x0E46 |&nbsp;#x0EC6 |&nbsp;#x3005 |&nbsp;[#x3031-#x3035] |&nbsp;[#x309D-#x309E] |&nbsp;[#x30FC-#x30FE] </rhs></prod> </prodgroup> </scrap> </p> <p>S0S0g0š[©Y0‹0‡eW[¯0é0¹0o0 ÿUnicode‡eW[Ç0ü0¿0Ù0ü0¹0K0‰0 ÿ!kn0h0J0Š0k0—_‹0S0h0L0g0M0‹00 <ulist> <item> <p>a) TMR‹•ËY‡eW[o0 ÿLl, Lu, Lo, Lt, Nl«0Æ0´0ê0…Qn0Nd0g0j0Q0Œ0p0j0‰0j0D00</p> </item> <item> <p>b) TMR‹•ËY‡eW[åNYn0 TMR‡eW[o0 ÿMc, Me, Mn, Lm, Nd«0Æ0´0ê0…Qn0Nd0g0j0Q0Œ0p0j0‰0j0D00</p> </item> <item> <p>c) &compatibility-area;k0B0‹0‡eW[(‡eW[&{÷Sg0#xF900ˆ0Š0'YM0O0#xFFFEˆ0Š0\U0D0‡eW[)o0 ÿXMLk0J0Q0‹0 TMRh0W0f0o0 ÿ1ŠU0Œ0j0D00</p> </item> <item> <p>d) &font-decomposition;K0&compatibility-decomposition;’0‚0d0‡eW[(d0~0Š0 ÿÇ0ü0¿0Ù0ü0¹0…Qn0ÿjuîvn0Õ0£0ü0ë0É0k0"compatibility formatting tag"L0B0‹0‚0n00S0Œ0o0 ÿÿjuîvn0Õ0£0ü0ë0É0L0 ÿ"&lt;"g0ËY~0‹0S0h0k0ˆ0c0f0Þ0ü0¯0ØNQ0U0Œ0‹00)o0 ÿ1ŠU0Œ0j0D00</p> </item> <item> <p>e) !kn0‡eW[o0 ÿ TMR‹•ËY‡eW[h0W0f0qbF00S0Œ0o0 ÿ&property-file;L0 ÿS0Œ0‰0n0‡eW[’0¢0ë0Õ0¡0Ù0Ã0È0k0^˜ </item> <item> <p>f) ‡eW[&{÷SL0#x20DD-#x20E0n0‡eW[o0 ÿ(Unicode n05.14k0W0_0L0c0f0)d–YY0‹00</p> </item> <item> <p>g) ‡eW[&{÷SL0#x00B7n0‡eW[o0 ÿ&property-list;k0W0_0L0c0f0 ÿ&extender;(extender)k0R^˜Y0‹00</p> </item> <item> <p>h) ‡eW[#x0387o0 ÿS0Œ0k0øvS_Y0‹0ck‰b_L0#x00B7j0n0g0 ÿ TMR‡eW[k0ý RY0‹00</p> </item> <item> <p>i) ‡eW[':'ÊSs0'_'o0 ÿ TMR‹•ËY‡eW[h0W0f01ŠY00</p> </item> <item> <p>j) ‡eW['-'ÊSs0'.'o0 ÿ TMR‡eW[h0W0f01ŠY00</p> </item> </ulist> </p> </div1> <inform-div1 id="sec-xml-and-sgml"> <head>XMLÊSs0SGML</head> <p>XMLo0 ÿSGMLn0&subset;h0W0f0-ŠŠU0Œ0f0D0‹00Y0j00a0 ÿY0y0f0n0<termref def="dt-valid">&valid;</termref>j0XML‡eøfo0 ÿ‰‰ z</loc>’0ÂSgqn0S0h00S0n0‰ zo0 ÿXMLn06R}agöN’0:yY0SGML£[Š’0+T0 ÿS0Œ0o0 ÿSGML&parser;k0O(ug0M0‹00 </p> </inform-div1> <inform-div1 id="sec-entexpand"> <head>Ÿ[SOÂSgqÊSs0‡eW[ÂSgqn0U\‹•</head> <p>S0n0ØN2“o0 ÿŸ[SOÂSgqÊSs0‡eW[ÂSgq’0ŠX‹W0 ÿU\‹•Y0‹0 ÿN#n0AmŒ0’0 ÿ‹Ok0Oc0f0:yY00</p> <p> DTDL0 ÿ!kn0£[Š’0+T€04XT’0€H0‹00 <eg><![CDATA[<!ENTITY example "<p>An ampersand (&#38;#38;) may be escaped numerically (&#38;#38;#38;) or with a general entity (&amp;amp;).</p>" > ]]></eg> XML&processor;o0 ÿŸ[SOn0£[Š’0Ëi‡eã‰gW0_0Bf¹pg0‡eW[ÂSgq’0ŠX‹W0 ÿS0Œ0’0ã‰zlY0‹00Ÿ[SO"<code>example</code>"n0$Ph0W0f0 ÿ!kn0&string;’0ÝOX[Y0‹00 <eg><![CDATA[<p>An ampersand (&#38;) may be escaped numerically (&#38;#38;) or with a general entity (&amp;amp;).</p> ]]></eg> ‡eøf…Qg0"<code>&amp;example;</code>"’0ÂSgqY0‹0h0 ÿS0n0Æ0­0¹0È0o0 ÿQs0Ëi‡eã‰gU0Œ0‹00S0n0h0M0 ÿ‰ }"<code>p</code>"n0‹•ËY¿0°0ÊSs0B}†N¿0°0’0ŠX‹W0 ÿ Nd0n0ÂSgq’0ŠX‹W0U\‹•Y0‹00]0n0P}œg ÿ‰ }"<code>p</code>"o0 ÿ!kn0…Q¹[’0‚0d0(Y0y0f0Ç0ü0¿0h0W0 ÿ:SRŠ0P[ÈSo0&markup;o0X[(WW0j0D00)0 <eg><![CDATA[An ampersand (&) may be escaped numerically (&#38;) or with a general entity (&amp;). ]]></eg> </p> <p>‰GRÊSs0]0n0¹Rœg’0ˆ0Š0sŠ0}k0:yY0_00 ÿU0‰0k0‰Ñ–j0‹O’0:yY00!kn0‹Og0 ÿLˆju÷So0 ÿÂSgqn0¿Oœ[n0_00`0Q0k0ØNQ0‹00 <eg><![CDATA[1 <?xml version='1.0'?> 2 <!DOCTYPE test [ 3 <!ELEMENT test (#PCDATA) > 4 <!ENTITY % xx '&#37;zz;'> 5 <!ENTITY % zz '&#60;!ENTITY tricky "error-prone" >' > 6 %xx; 7 ]> 8 <test>This sample shows a &tricky; method.</test> ]]></eg> S0Œ0’0æQtY0‹0h0 ÿ!kn0h0J0Š0h0j0‹00 <ulist spacing="compact"> <item><p>a) 4Lˆîvg0 ÿ37juîvn0‡eW[x0n0ÂSgq’0ôva0k0U\‹•W0 ÿÑ0é0á0¿0Ÿ[SO"<code>xx</code>"’0 ÿ·0ó0Ü0ë0Æ0ü0Ö0ë0k0"<code>%zz;</code>"h0D0F0$Ph0h0‚0k0ÝOX[Y0‹00&replacement-text;’0Qs0pûgY0‹0S0h0o0j0D0n0g0 ÿÑ0é0á0¿0Ÿ[SO"<code>zz</code>"x0n0ÂSgqo0ŠX‹W0j0D0("<code>zz</code>"o0 ÿ~0`0£[ŠU0Œ0f0D0j0D0n0g0 ÿpûgU0Œ0Œ0p0 ÿ&error;h0j0‹00)0</p></item> <item><p>b) 5Lˆîvg0 ÿ‡eW[ÂSgq"<code>&amp;#60;</code>"’0ôva0k0U\‹•W0 ÿÑ0é0á0¿0Ÿ[SO"<code>zz</code>"’0"<code>&lt;!ENTITY tricky "error-prone" ></code>"h0D0F0&replacement-text;h0h0‚0k0ÝOX[Y0‹00S0Œ0o0 ÿ&well-formed;n0Ÿ[SO£[Šh0Y0‹00</p></item> <item><p>c) 6Lˆîvg0 ÿ"<code>xx</code>"x0n0ÂSgq’0ŠX‹W0 ÿ"<code>xx</code>"n0&replacement-text;(Y0j00a0 ÿ"<code>%zz;</code>")’0Ëi‡eã‰gY0‹00"<code>zz</code>"x0n0ÂSgq’0š}D0f0ŠX‹W0 ÿ&replacement-text;("<code>&lt;!ENTITY tricky "error-prone" ></code>")’0Ëi‡eã‰gY0‹00N,‚Ÿ[SO"<code>tricky</code>"o0 ÿS0n0Bf¹pg0o0 ÿ£[ŠU0Œ0f0J0Š0 ÿ]0n0&replacement-text;o0 ÿ"<code>error-prone</code>"h0Y0‹00 </p></item> <item><p>d) 8Lˆîvg0 ÿN,‚Ÿ[SO"<code>tricky</code>"x0n0ÂSgq’0ŠX‹W0 ÿU\‹•Y0‹00‰ }"<code>test</code>"n0Œ[hQj0…Q¹[o0 ÿ!kn0(…Q¹[’0]0Œ0êSOhˆþsY0‹00)&string;h0j0‹00d0~0Š0 ÿ<emph>This sample shows a error-prone method.</emph> </p></item> </ulist> </p> </inform-div1> <inform-div1 id="determinism"> <head>zlš[„v…Q¹[â0Ç0ë0</head> <p><termref def='dt-compat'>’NÛc'`n0_00</termref> ÿ‰ }£[Šk0J0Q0‹0…Q¹[â0Ç0ë0o0 ÿzlš[„vh0Y0‹0Å_‰L0B0‹00 </p> <!-- FINAL EDIT: WebSGML allows ambiguity? --> <p>SGMLo0 ÿzlš[„v…Q¹[â0Ç0ë0(SGMLg0o0 ÿ^—B0D0~0D0h0|Tv00)’0‰BlY0‹00SGML·0¹0Æ0à0’0(uD0f0\ObW0_0XML&processor;o0 ÿ^—zlš[„v…Q¹[â0Ç0ë0’0&error;h0W0f0‚0ˆ0D00</p> <p>‹OH0p0 ÿ…Q¹[â0Ç0ë0<code>((b, c) | (b, d))</code>o0^—zlš[„vh0j0‹00S0Œ0o0 ÿgRk0<code>b</code>’0NH0_0h0M0 ÿâ0Ç0ë0…Qn0D0Z0Œ0n0<code>b</code>h0&match;Y0‹0n0L0g~0W0D0K0 ÿ]0n0!kn0‰ }’0HQ­Š0Y0‹0S0h0j0W0k0o0 ÿ&parser;o0åw‹0S0h0L0g0M0j0D0S0h0k0ˆ0‹00S0n04XTo0 ÿ<code>b</code>x0n0ŒNd0n0ÂSgqo0 ÿNd0n0ÂSgqk0~0h00‹0S0h0L0g0M0 ÿâ0Ç0ë0o0 ÿ<code>(b, (c | d))</code>h0j0‹00S0Œ0g0 ÿgRn0<code>b</code>L0 ÿ…Q¹[â0Ç0ë0…Qn0Nd0n0 TMRh0`0Q0&match;Y0‹0S0h0o0f‰0K0h0j0‹00&parser;o0 ÿHQ­Š0W0f0 ÿ!kk0eg‹0‚0n0’0åw‹0Å_‰L0j0D00<code>c</code>‚0<code>d</code>‚0 ÿ×StU0Œ0‹00</p> <p>b__„vk0:yY00Aho, Sethi, and Ullman <bibref ref='Aho'/>n03.9n0¢0ë0´0ê0º0à03.5n0j–n„vj0¢0ë0´0ê0º0à0’0(uD0f0 ÿ…Q¹[â0Ç0ë0K0‰0 gP–ª0ü0È0Þ0È0ó0’0ËibY0‹0S0h0L0g0M0‹00S0n0.zn0YO0n0¢0ë0´0ê0º0à0g0o0 ÿck‰hˆþsk0J0Q0‹0T0n0MOn(d0~0Š0 ÿck‰hˆþsn0Ëi‡e(gk0J0Q0‹0T0n0+gïzÎ0ü0É0)k0þ[W0f0 ÿfollow set(!kk0i0n0MOnk0ûyÕRïSý€K0’0hˆY0‚0n0)’0ËibY0‹00B0‹0MOnk0þ[Y0‹0follow setk0J0D0f0 ÿ‰pen0MOnL0 TX0‰ }‹W Tg0é0Ù0ë0ØNQ0U0Œ0f0D0Œ0p0 ÿ]0n0…Q¹[â0Ç0ë0o0&error;h0j0Š0 ÿ&error;’0ÔY04XT‚0B0‹00 </p> <p>Y0y0f0n0^—zlš[„v…Q¹[â0Ç0ë0’0I{¡Oj0zlš[„v…Q¹[â0Ç0ë0k0 YÛcY0‹0S0h0o0g0M0j0D0L0 ÿYO0n0^—zlš[„v…Q¹[â0Ç0ë0’0 YÛcY0‹0¢0ë0´0ê0º0à0L0X[(WY0‹00Br&#252;ggemann-Klein 1991 <bibref ref='ABK'/>’0ÂSgqn0S0h00</p> </inform-div1> <inform-div1 id="sec-guessing"> <head>‡eW[&{÷SSn0êÕRiúQ</head> <p> XMLn0&{÷SS£[Šo0 ÿTŸ[SOn0…Qèé0Ù0ë0h0W0f0_jý€W0 ÿi0n0‡eW[&{÷SS’0O(uY0‹0K0’0:yY00W0K0W0 ÿXML&processor;o0 ÿ…Qèé0Ù0ë0’0­Š€0MRk0 ÿi0n0‡eW[&{÷SS’0O(uY0‹0K0’0åw‹0Å_‰L0B0Š0 ÿS0Œ0L0 ÿ…Qèé0Ù0ë0L0:y]0F0h0Y0‹0S0h0k0j0‹00N,‚„vk0o0 ÿS0Œ0o0 ÿv}g„vj0¶rKah0j0‹00W0K0W0 ÿXMLk0J0D0f0o0 ÿŒ[hQk0o0v}g„vg0o0j0D00S0Œ0o0 ÿXMLL0 ÿ!kn0ŒNd0n0¹pg0N,‚„vj04XTk0þ[Y0‹06RP–’0 RH0‹0S0h0k0ˆ0‹00Nd0n06RP–o0 ÿi0n0Ÿ[ň‚0 gP– Pn0‡eW[&{÷SS`0Q0n0µ0Ý0ü0È0’0ó`š[Y0‹0S0h0h0Y0‹00ÖNn0Nd0n06RP–o0 ÿTŸ[SOg0O(uY0‹0‡eW[&{÷SS’0êÕRiúQïSý€h0Y0‹0 ÿXMLn0&{÷SS£[Šn0MOnÊSs0…Q¹[k0¢•Y0‹06RP–h0Y0‹00YO0n04XTk0 ÿXMLn0Ç0ü0¿0¹0È0ê0ü0à0k0 RH0 ÿÖNn0Å`1XL0)R(ug0M0‹00S0S0g0o0 ÿXMLn0Ÿ[SOL0&processor;k0!nU0Œ0‹0h0M0 ÿ(Yè)Å`1X’04OF0K0i0F0K0k0ˆ0c0f0 ÿŒNd0n04XTk0RQ0‹00~0Z0gRn04XT’0:yY00</p> <p> UTF-8b__ÈSo0UTF-16b__g0o0j0D0XMLŸ[SOo0 ÿgRn0‡eW[’0 <code>&lt;?xml</code>'h0Y0‹0XML&{÷SS£[Šg0ËY~0‰0<emph>j0Q0Œ0p0j0‰0j0D0</emph>n0g0 ÿi0n0iTW0_0&processor;‚0 ÿeQ›Rk0B0‹02ª0¯0Æ0Ã0È0ÈSo04ª0¯0Æ0Ã0È0’0¿Šy0Œ0p0 ÿ!kn0i0n04XTL0B0f0o0~0‹0K0’0iúQg0M0‹00S0n0ê0¹0È0’0­Š€0›–k0o0 ÿUCS-4n0'&lt;'L0"<code>#x0000003C</code>" ÿ'?'L0"<code>#x0000003F</code>" ÿÊSs0UTF-16n0Ç0ü0¿0&stream;n0Å_‰h0Y0‹0&byte-order-mark;L0"<code>#xFEFF</code>"h0D0F0S0h0’0åwc0f0J0O0h0y_Ëzd0K0‚0W0Œ0j0D00</p> <p> <ulist> <item> <p>a) <code>00 00 00 3C</code>: UCS-4, big-endian Þ0·0ó0 (1234˜)</p> </item> <item> <p>b) <code>3C 00 00 00</code>: UCS-4, little-endian Þ0·0ó0 (4321˜)</p> </item> <item> <p>c) <code>00 00 3C 00</code>: UCS-4, nfg0o0j0D0ª0¯0Æ0Ã0È0˜ (2143)</p> </item> <item> <p>d) <code>00 3C 00 00</code>: UCS-4, nfg0o0j0D0ª0¯0Æ0Ã0È0˜ (3412)</p> </item> <item> <p>e) <code>FE FF</code>: UTF-16, big-endian</p> </item> <item> <p>f) <code>FF FE</code>: UTF-16, little-endian</p> </item> <item> <p>g) <code>00 3C 00 3F</code>: UTF-16, big-endian, &byte-order-mark;j0W0(W0_0L0c0f0 ÿ³SÆ[k0D0H0p0 ÿ&error;h0Y0‹00)0</p> </item> <item> <p>h) <code>3C 00 3F 00</code>: UTF-16, little-endian, &byte-order-mark;j0W0(W0_0L0c0f0 ÿ³SÆ[k0D0H0p0 ÿ&error;h0Y0‹00)0</p> </item> <item> <p>i) <code>3C 3F 78 6D</code>: UTF-8, ISO 646, ASCII, ISO 8859n0TÑ0ü0È0 ÿShift-JIS ÿEUC ÿ&Ns0k0ûNan0ÖNn07Ó0Ã0È0 ÿ8Ó0Ã0È0ÈSo0÷m(WE^n0&{÷SSg0B0c0f0 ÿASCII‡eW[’08^n0MOn ÿE^ÊSs0$Ph0Y0‹0S0h0’0ÝO<ŠY0‹0‚0n00S0Œ0‰0n0i0Œ0k0þ[Ü_Y0‹0K0’0iúQY0‹0_00k0o0 ÿŸ[›–n0&{÷SS£[Š’0­Š0¼~0j0Q0Œ0p0j0‰0j0D00W0K0W0 ÿS0Œ0‰0Y0y0f0n0&{÷SSo0 ÿASCII‡eW[k0þ[W0f0 TX0Ó0Ã0È0Ñ0¿0ü0ó0’0O(uY0‹0n0g0 ÿ&{÷SS£[ŠêSOo0 ÿckºxk0­Š¼0ïSý€h0Y0‹00 </p> </item> <item> <p>j) <code>4C 6F A7 94</code>: EBCDIC (ÈSo0]0n0 Y.z0i0n0³0ü0É0Ú0ü0¸0’0O(uY0‹0K0’0åw‹0_00k0o0 ÿ&{÷SS£[ŠhQSO’0­Š0¼~0Œ0j0Q0Œ0p0j0‰0j0D00)</p> </item> <item> <p>k) ]0n0ÖN: &{÷SS£[Šj0W0n0UTF-80]0F0g0j0D0h0M0k0o0 ÿÇ0ü0¿0&stream;L0ÊXŒ0f0D0‹0K0 ÿ­eGr„vk0j0c0f0D0‹0K0 ÿUO‰0K0n0b__k0W0_0L0c0f0ËW0¼~0Œ0f0D0‹00</p> </item> </ulist> </p> <p> S0n0 z¦^n0êÕR$R%Rg0‚0 ÿXMLn0&{÷SS£[Š’0­Š0¼0 ÿ‡eW[&{÷SSn0&identifier;’0ã‰gY0‹0k0o0ASRh0Y0‹00&identifier;n0ã‰go0 ÿ^˜ <p> &{÷SS£[Šn0…Q¹[’0ASCII‡eW[k0P–š[W0f0D0‹0n0g0 ÿi0n0R^˜n0&{÷SS’0O(uY0‹0K0’0iúQY0Œ0p0 ÿ&processor;o0 ÿ&{÷SS£[ŠhQSO’0ckºxk0­Š0¼€0S0h0L0g0M0‹00þsŸ[OUL˜h0W0f0 ÿƒ^O0O(uU0Œ0f0D0‹0‡eW[&{÷SSo0 ÿ Nn0R^˜n0D0Z0Œ0K0k0B0f0o0~0‹0n0g0 ÿª0Ú0ì0ü0Æ0£0ó0°0·0¹0Æ0à0ÈSo0O×0í0È0³0ë0L0NH0‹0YèÅ`1X’0áO<˜ NïSý€j0h0M0g0U0H0‚0 ÿ…Qèé0Ù0ë0g0‡eW[&{÷SS’0K0j0Š0ckºxk0:yY0S0h0L0 ÿXML&{÷SS£[Šk0ˆ0c0f0ïSý€h0j0‹00 </p> <p> &processor;L0O(uY0‹0‡eW[&{÷SS’0iúQW0U0H0Y0Œ0p0 ÿ]0Œ0^0Œ0n04XTk0þ[W0f0%R Pn0eQ›Rë0ü0Á0ó0’0|Ts0úQY0 ÿÈSo0eQ›RY0‹0T‡eW[k0þ[W0iRj0 YÛc¢•pe’0|Ts0úQY0S0h0k0ˆ0c0f0 ÿiRj0ÕR\OL0ïSý€h0j0‹00</p> <p> êRêSOk0é0Ù0ë0ØNQ0’0Y0‹0D0K0j0‹0·0¹0Æ0à0g0‚0 TØi`0L0 ÿ½0Õ0È0¦0§0¢0L0 ÿ&{÷SS£[Š’0ôf°e[0Z0k0Ÿ[SOn0‡eW[Æ–TÈSo0&{÷SS’0 YH0_0j0‰0p0 ÿXMLn0&{÷SS£[Šo0 ÿ_jý€W0j0D00‡eW[&{÷SSë0ü0Á0ó0n0Ÿ[ň€o0 ÿŸ[SOn0é0Ù0ë0ØNQ0k0O(uY0‹0…QèÊSs0Yèn0Å`1Xn0ckºxU0n0ÝO<Šk0èlaY0‹0n0L0g~0W0D00 </p> <p>ÿjuîvn04XTo0 ÿXMLn0Ÿ[SOn0ÖNk0 ÿ&{÷SSÅ`1XL0X[(WY0‹0h0M0g0B0c0f0 ÿD0O0d0K0n0Õ0¡0¤0ë0·0¹0Æ0à0ÊSs0Í0Ã0È0ï0ü0¯0×0í0È0³0ë0g0o0 ÿ]0n0&{÷SSÅ`1XL0X[(WY0‹00‰pen0Å`1XL0)R(ug0M0‹0h0M0 ÿ<!-- (e.g. both the internal encoding declaration and an external label), -->]0Œ0‰0n0øvþ[„vj0*QHQ¦^ÊSs0]0Œ0‰0L0ÛwþvW0_0h0M0n0g~0W0D0æQt¹eÕlo0 ÿXMLn0M‘k0O(uY0‹0 ÿˆ0Š0Øš4l–nn0×0í0È0³0ë0n0Nèh0W0f0‰ zY0‹0n0L0ˆ0D00‹OH0p0 ÿ…Qèé0Ù0ë0ÊSs0Yè&header;k0X[(WY0‹0MIMEb__n0é0Ù0ë0n0øvþ[„vj0*QHQ¦^k0þ[Y0‹0‰GRo0 ÿtext/xmlÊSs0application/xmln0MIME‹W’0š[©Y0‹0RFC‡eøfn0Nèh0j0‹0¹eL0ˆ0D00W0K0W0 ÿøv’NK(u'`n0_00k0 ÿ!kn0‰GRk0“_F0S0h0L0g~0W0D00 <ulist> <item><p>a) XMLn0Ÿ[SOL0Õ0¡0¤0ë0k0X[(WY0Œ0p0 ÿ&byte-order-mark;ÊSs0&{÷SS£[ŠPIo0 ÿ(X[(WY0Œ0p0)‡eW[&{÷SS’0zlš[Y0‹0_00k0O(uY0‹00ÖNn0Y0y0f0n0&hueristics;ÊSs0Å`1Xo0 ÿ&error;ÞV©_n0_00`0Q0k0(uD0‹00 </p></item> <item><p>b) XMLn0Ÿ[SO’0MIME‹Wtext/xmlg0M‘Y0‹0h0M0o0 ÿS0n0MIME‹Wn0‚0d0charsetÑ0é0á0¿0L0‡eW[&{÷SS¹eÕl’0zlš[Y0‹00ÖNn0Y0y0f0n0&hueristics;ÊSs0Å`1Xo0 ÿ&error;ÞV©_n0_00`0Q0k0(uD0‹00 </p></item> <item><p>c) XMLn0Ÿ[SO’0 <!-- via the HTTP protocol -->MIME‹Wapplication/xmlg0M‘Y0‹0h0M0o0 ÿ&byte-order-mark;ÊSs0&{÷SS£[ŠPI’0(X[(WY0Œ0p0)‡eW[&{÷SSn0zlš[n0_00k0O(uY0‹00ÖNn0Y0y0f0n0&hueristics;ÊSs0Å`1Xo0&error;ÞV©_n0_00`0Q0k0(uD0‹00 </p></item> </ulist> S0Œ0‰0n0‰GRo0 ÿ×0í0È0³0ë0k0d0D0f0n0ÇŒ™eL0j0D0h0M0k0`0Q0(uD0‹00yrk0 ÿMIME‹Wtext/xmlÊSs0application/xml’0š[©W0_0‰0 ÿS0Œ0‰0’0‰š[Y0‹0RFCk0X[(WY0‹0‰š[L0 ÿS0Œ0‰0n0‰GRk0ÖSc0f0ãN0‹00 </p> </inform-div1> <!-- <div1 id='sec-trival-grammar'> <head>A Trivial Grammar for XML Documents</head> <p>The grammar given in the body of this specification is relatively simple, but for some purposes it is convenient to have an even simpler one. A very simple, though non-conforming, <termref def="dt-xml-proc">XML processor</termref> could parse a <termref def="dt-wellformed">well-formed</termref> XML document using the following simplified grammar, recognizing all element boundaries correctly, though not expanding entity references and not detecting all errors: <scrap lang="ebnf"> <head>Trivial text grammar</head> <prodgroup pcw2="5.5" pcw4="17" pcw5="10"> <prod id='NT-simpleDoc'><lhs>simpleDoc</lhs> <rhs>(<nt def='NT-SimpleData'>SimpleData</nt> | <nt def='NT-Markup'>Markup</nt>)*</rhs></prod> <prod id="NT-SimpleData"><lhs>SimpleData</lhs> <rhs>[^&lt;&amp;]*</rhs> <com>cf. PCData</com> </prod> <prod id="NT-SimpleLit"><lhs>SimpleLit</lhs> <rhs>('"' [^"]* '"')</rhs> <rhs>|&nbsp;("'" [^']* "'")</rhs> <com>cf. SkipLit</com> </prod> <prod id='NT-Markup'><lhs>Markup</lhs> <rhs>'&lt;' <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt>? '=' <nt def='NT-S'>S</nt>? <nt def='NT-SimpleLit'>SimpleLit</nt>)* <nt def='NT-S'>S</nt>? '&gt;'</rhs><com>start-tags </com> <rhs>| '&lt;' <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt>? '=' <nt def='NT-S'>S</nt>? <nt def='NT-SimpleLit'>SimpleLit</nt>)* <nt def='NT-S'>S</nt>? '/&gt;'</rhs><com>empty elements</com> <rhs>| '&lt;/' <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt>? '&gt;'</rhs> <com>end-tags </com> <rhs>| '&amp;' <nt def='NT-Name'>Name</nt> ';'</rhs> <com>entity references </com> <rhs>| '&amp;#' [0-9]+ ';'</rhs> <com>decimal character references </com> <rhs>| '&hcro;' [0-9a-fA-F]+ ';'</rhs> <com>hexadecimal character references </com> <rhs>| '&lt;!&como;' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* '&comc;' <nt def='NT-Char'>Char</nt>*)) '&comc;&gt;'</rhs> <com>comments </com> <rhs>| '&lt;?' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* &pic; <nt def='NT-Char'>Char</nt>*)) '&pic;'</rhs> <com>processing instructions </com> <rhs>| '&lt;![CDATA[' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-Char'>Char</nt>*)) ']]&gt;'</rhs> <com>CDATA sections</com> <rhs>| '&lt;!DOCTYPE' (<nt def="NT-Char">Char</nt> - ('[' | ']'))+ ('[' <nt def="NT-simpleDTD">simpleDTD</nt>* ']')? '&gt;'</rhs> <com>doc type declaration</com> </prod> <prod id="NT-simpleDTD"><lhs>simpleDTD</lhs> <rhs>'&lt;!&como;' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* '&comc;' <nt def='NT-Char'>Char</nt>*)) '&comc;&gt;'</rhs> <com>comment </com> <rhs>| '&lt;?' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* &pic; <nt def='NT-Char'>Char</nt>*)) '&pic;'</rhs> <com>processing instruction </com> <rhs><nt def="NT-SimpleLit">SimpleLit</nt></rhs> <rhs>(<nt def="NT-Char">Char</nt> - (']' | '&lt;' | '"' | "'"))+ </rhs> <rhs>'&lt;!' (<nt def="NT-Char">Char</nt> - ('-'))+</rhs> <com>declarations other than comment</com> </prod> </prodgroup> </scrap> Most processors will require the more complex grammar given in the body of this specification. </p> </div1> --> <inform-div1 id="sec-xml-wg"> <head>&informative;W3C XML ï0ü0­0ó0°0°0ë0ü0×0</head> <p>S0n0&TR-or-Rec;o0 ÿW3C XML ï0ü0­0ó0°0°0ë0ü0×0(WG)L0–n™PW0 ÿlQ‹•’0bŠW0_00WGL0S0n0&TR-or-Rec;’0bŠY0‹0h0D0F0S0h0o0 ÿWGn0Y0y0f0n0ÔYáTL0bŠ•bhy’0Lˆc0_0h0D0F0S0h0’0Å_Z0W0‚0asTW0j0D00XML WGn0þs(Wn0ÔYáTÊSs0åNMRn0ÔYáT’0!kk0:yY00</p> <!-- parens and spaces removed from role elements by bosak 1997.11.07 --> <orglist> <member><name>Jon Bosak, Sun</name><role>Chair</role></member> <member><name>James Clark</name><role>Technical Lead</role></member> <member><name>Tim Bray, Textuality and Netscape</name><role>XML Co-editor</role></member> <member><name>Jean Paoli, Microsoft</name><role>XML Co-editor</role></member> <member><name>C. M. Sperberg-McQueen, U. of Ill.</name><role>XML Co-editor</role></member> <member><name>Dan Connolly, W3C</name></member> <member><name>Steve DeRose, INSO</name></member> <member><name>Dave Hollander, HP</name></member> <member><name>Eliot Kimber, Highland</name></member> <member><name>Eve Maler, ArborText</name></member> <member><name>Tom Magliery, NCSA</name></member> <member><name>Murray Maloney, Muzmo and Grif</name></member> <member><name>Qg0u0w ÿÌ[ëX¼0í0Ã0¯0¹0Å`1X·0¹0Æ0à0(*h)</name></member> <member><name>Joel Nava, Adobe</name></member> <member><name>Peter Sharpe, SoftQuad</name></member> <member><name>John Tigue, DataChannel</name></member> </orglist> </inform-div1> </back> </spec> <!-- Keep this comment at the end of the file Local variables: mode: sgml sgml-omittag:t sgml-shorttag:t End: --> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/pr-xml-iso-2022-jp.xml0000644006511100651110000057704410504340461027333 0ustar rossross ] ] ]30 .$J$j(B)"> Z$9$k(B"> Z$7$J$$(B"> "> '"> amp, lt, gt, apos, quot"> e$NCm0U$r2~JQ$7$J$$8B$j!$(B $B<+M3$KG[I[$7$F$b$h$$(B"> ]>
$B3HD%2DG=$J(B&markup;$B8@8l(B (XML) $BBh(B1.0&version; PR-xml-&iso6.doc.date; World Wide Web Consortium &draft.day;&draft.month;&draft.year;

$B$3$NAp0F$O!$(BXML WG$B5Z$SB>$N4X78

 http://www.w3.org/TR/PR-xml-&iso6.doc.date; http://www.w3.org/TR/WD-xml-961114 http://www.w3.org/TR/WD-xml-lang-970331 http://www.w3.org/TR/WD-xml-lang-970630 http://www.w3.org/TR/WD-xml-970807 http://www.w3.org/TR/WD-xml-971117 Tim Bray Textuality and Netscape tbray@textuality.com Jean Paoli Microsoft jeanpa@microsoft.com C. M. Sperberg-McQueen University of Illinois at Chicago cmsmcq@uic.edu

$B$3$N(B&TR-or-Rec;$B$O(B, 1997$BG/(B12$B7n$K(BWorld Wide Web Consortium$B$+$i(B $B8xI=$5$l$?4+9p0F(BExtensible Markup Language version$BBh(B1.0$BHG$rK]Lu$7(B, $B5;(B $B=QE*FbMF$rJQ99$9$k$3$H$J$/:n@.$7$?(B&TR-or-Rec;$B$G$"$k!#(BThis &eTR-or-Rec; is a translation of the XML proposed recommendation 1.0 published by the World Wide Web Consortium in December 1997. It is intended that &eTR-or-Rec; is technically identical to the original.

$B86J8$K$"$k!"Cx:n8"$K4X$7$F$N5-=R$r

$B$3$NHG$N(BXML$B$N5,Dj$O!$8x3+%l%S%e!<5Z$S5DO@$r(B $BL\E*$H$9$k!#%F%-%9%H5Z$SK!N'>e$NCm0U$r2~JQ$7$J$$8B$j!$<+M3$K(B $BG[I[$7$F$b$h$$!#(BThis version of the XML specification is for public review and discussion. It may be distributed freely, as long as all text and legal notices remain intact.

$B$3$N(B&TR-or-Rec;$B$N85$H$J$C$?(BXML$B4+9p0F$O!$(B1998$BG/(B2$B7n$K(BWorld Wide Web Consortium$B$+$i8xI=$5$l$?(BXML$B4+9p$K$h$C$F$9$G$KCV$-49(B $B$($i$l$F$$$k!#$3$NI8=`>pJs$O!$(BXML$B4+9p$K=>$C$FD{@5$9$k$3$H$r(B $BM=Dj$7$F$$$k!#(BThe XML Proposed Recommendation is superseded by the XML Recommendation which was published by the World Wide Web Consortium in February 1998. It is intended that this &eTR-or-Rec; be revised accordingly in the near future.

$B$3$N(B&TR-or-Rec;$B$O!$0BDj$7$?$b$N$G$"$C$F!$:rG/Mh$N(BXML$B3hF0(B$B$rDL$8$F:n@.$5$l$?!$0lO"$N:n(B $B6HAp0F$r85$H$9$k!#8=:_!$9-HO0O$K;HMQ$5$l$F$$$k9q:]E*$J%F%-%9%H=hM}$NI8(B $B=`(B($BI8=`0lHL2=(B&markup;$B8@8l!$(BStandard Generalized Markup Language, ISO 8879:1986$B$KDI2C5Z$SD{@5$r2C$($?$b$N(B)$B$N!$(BWWW$B>e$G$N;HMQ$N$?$a$K(B⊂ $B2=$7$?8@8l$r!$$3$N(B&TR-or-Rec;$B$O!$5,Dj$9$k!#(BISO 8879$B$N$I$N5!G=$r$3$N(B ⊂$B$K;D$9$+!$$H$$$&7hDj$K$D$$$F$N>\:Y$O!$(B$BJLESMQ0U$9$k(B$B!#(BXML$B$O!$(B $B4{$K$$$/$D$+$N>&IJ$G%5%]!<%H$5$l!$(BXML$B$r%5%]!<%H$9$k(B$B%U%j!<%&%'%"(B$B$N?t$bA}$($F(B $B$$$k!#(BXML$B$K4X$9$k8x3+$NO@5D$b!$%*%s%i%$%s$G(B$BF~$B!#(BIt is a stable document derived from a series of working drafts produced over the last year as deliverables of the XML activity. It specifies a language created by subsetting an existing, widely used international text processing standard (Standard Generalized Markup Language, ISO 8879:1986 as amended and corrected) for use on the World Wide Web. Details of the decisions regarding which features of ISO 8879 to retain in the subset are available separately. XML is already supported by some commercial products, and there are a growing number of free implementations. Public discussions of XML are accessible online.

$B$3$N(B&TR-or-Rec;$B$G$O!$(B$B$KDj5A$9$k(B URI(Uniform Resource Identifier)$B$r;HMQ$9$k!#(BURI$B$N@)Dj:n6H$O?J9TCf$G$"$C(B $B$F!$(B$B5Z$S(B$B$r99?7$9$kM=Dj$H(B $B$J$C$F$$$k!#$3$N:n6H$,(BRFC$B$H$7$Fl9g$O!$$3$N5,DxFb$N(BURI $B$X$N;2>H$O!$(BURL(Uniform Resource Locator)$B$X$N;2>H$KBe$o$k!#(BThis specification uses the term URI, which is defined by , a work in progress expected to update and . Should the work not be accepted as an RFC, the references to uniform resource identifiers (URIs) in this specification will become references to uniform resource locators (URLs).

XML$B$N;EMM$K=`5r$7$F$$$k$+$I$&$+$N4p=`$H$J$k$O(BW3C$B$N%5%$%H$K$"(B $B$k86J8$G$"$k!#(BThe normative version of the specification is the English version found at the W3C site.

$B$3$NI8=`>pJs$O86;EMM$H5;=QE*$KF10l$G$"$k$3$H$r0U?^$7$F$$$k$,!"(B $BK]Lu>e$N8m$j$O$"$jF@$k!#(BAlthough this technical report is intended to be technically identical to the original, it may contain errors from the translation.

$BHw9M(B: $B865,Dj$H$N5,Dj2U=j$NBP1~4X78$rL@$i$+$K$9$k$?$a!"$3$N(B &TR-or-Rec;$B$N@a9=@.5Z$S@aHV9f$O!"865,Dj$N$=$l$i$r$G$-$k$@$1J]B8$7$F$$(B $B$k!#$3$N(B&TR-or-Rec;$B$N(BWeb$BHG$O!"865,Dj$N(BHTML$B%?%0$r$=$N$^$^J]B8$7$F$$$k!#(B

$B3HD%2DG=$J(B&markup;$B8@8l(B(XML)$B$O(BSGML$B$N4JC1$JJ}8@$G$"$C$F!$$3$N(B&TR-or-Rec;$B$G!$$=$N$9$Y$F$r5,Dj$9$k!#(BXML$B$NL\I8$O!$8=:_$N(BHTML$B$HF1MM$K!$0lHL@-$N$"$k(BSGML$B$r%&%'%V>e$GG[I[!$

Chicago, Vancouver, Mountain View, et al.: World-Wide Web Consortium, XML$B:n6H%0%k!<%W(B, 1996, 1997.

Created in electronic form.

 English Extended Backus-Naur Form (formal grammar) 1997-12-03 : CMSMcQ : yet further changes 1997-12-02 : TB : further changes (see TB to XML WG, 2 December 1997) 1997-12-02 : CMSMcQ : deal with as many corrections and comments from the proofreaders as possible: entify hard-coded document date in pubdate element, change expansion of entity WebSGML, update status description as per Dan Connolly (am not sure about refernece to Berners-Lee et al.), add 'The' to abstract as per WG decision, move Relationship to Existing Standards to back matter and combine with References, re-order back matter so normative appendices come first, re-tag back matter so informative appendices are tagged informdiv1, remove XXX XXX from list of 'normative' specs in prose, move some references from Other References to Normative References, add RFC 1738, 1808, and 2141 to Other References (they are not normative since we do not require the processor to enforce any rules based on them), add reference to 'Fielding draft' (Berners-Lee et al.), move notation section to end of body, drop URIchar non-terminal and use SkipLit instead, lose stray reference to defunct nonterminal 'markupdecls', move reference to Aho et al. into appendix (Tim's right), add prose note saying that hash marks and fragment identifiers are NOT part of the URI formally speaking, and are NOT legal in system identifiers (processor 'may' signal an error). Work through: Tim Bray reacting to James Clark, Tim Bray on his own, Eve Maler, NOT DONE YET: change binary / text to unparsed / parsed. handle James's suggestion about < in attriubte values uppercase hex characters, namechar list, 1997-12-01 : JB : add some column-width parameters 1997-12-01 : CMSMcQ : begin round of changes to incorporate recent WG decisions and other corrections: binding sources of character encoding info (27 Aug / 3 Sept), correct wording of Faust quotation (restore dropped line), drop SDD from EncodingDecl, change text at version number 1.0, drop misleading (wrong!) sentence about ignorables and extenders, modify definition of PCData to make bar on msc grammatical, change grammar's handling of internal subset (drop non-terminal markupdecls), change definition of includeSect to allow conditional sections, add integral-declaration constraint on internal subset, drop misleading / dangerous sentence about relationship of entities with system storage objects, change table body tag to htbody as per EM change to DTD, add rule about space normalization in public identifiers, add description of how to generate our name-space rules from Unicode character database (needs further work!). 1997-10-08 : TB : Removed %-constructs again, new rules for PE appearance. 1997-10-01 : TB : Case-sensitive markup; cleaned up element-type defs, lotsa little edits for style 1997-09-25 : TB : Change to elm's new DTD, with substantial detail cleanup as a side-effect 1997-07-24 : CMSMcQ : correct error (lost *) in definition of ignoreSectContents (thanks to Makoto Murata) Allow all empty elements to have end-tags, consistent with SGML TC (as per JJC). 1997-07-23 : CMSMcQ : pre-emptive strike on pending corrections: introduce the term 'empty-element tag', note that all empty elements may use it, and elements declared EMPTY must use it. Add WFC requiring encoding decl to come first in an entity. Redefine notations to point to PIs as well as binary entities. Change autodetection table by removing bytes 3 and 4 from examples with Byte Order Mark. Add content model as a term and clarify that it applies to both mixed and element content. 1997-06-30 : CMSMcQ : change date, some cosmetic changes, changes to productions for choice, seq, Mixed, NotationType, Enumeration. Follow James Clark's suggestion and prohibit conditional sections in internal subset. TO DO: simplify production for ignored sections as a result, since we don't need to worry about parsers which don't expand PErefs finding a conditional section. 1997-06-29 : TB : various edits 1997-06-29 : CMSMcQ : further changes: Suppress old FINAL EDIT comments and some dead material. Revise occurrences of % in grammar to exploit Henry Thompson's pun, especially markupdecl and attdef. Remove RMD requirement relating to element content (?). 1997-06-28 : CMSMcQ : Various changes for 1 July draft: Add text for draconian error handling (introduce the term Fatal Error). RE deleta est (changing wording from original announcement to restrict the requirement to validating parsers). Tag definition of validating processor and link to it. Add colon as name character. Change def of %operator. Change standard definitions of lt, gt, amp. Strip leading zeros from #x00nn forms. 1997-04-02 : CMSMcQ : final corrections of editorial errors found in last night's proofreading. Reverse course once more on well-formed: Webster's Second hyphenates it, and that's enough for me. 1997-04-01 : CMSMcQ : corrections from JJC, EM, HT, and self 1997-03-31 : Tim Bray : many changes 1997-03-29 : CMSMcQ : some Henry Thompson (on entity handling), some Charles Goldfarb, some ERB decisions (PE handling in miscellaneous declarations. Changed Ident element to accept def attribute. Allow normalization of Unicode characters. move def of systemliteral into section on literals. 1997-03-28 : CMSMcQ : make as many corrections as possible, from Terry Allen, Norbert Mikula, James Clark, Jon Bosak, Henry Thompson, Paul Grosso, and self. Among other things: give in on "well formed" (Terry is right), tentatively rename QuotedCData as AttValue and Literal as EntityValue to be more informative, since attribute values are the only place QuotedCData was used, and vice versa for entity text and Literal. (I'd call it Entity Text, but 8879 uses that name for both internal and external entities.) 1997-03-26 : CMSMcQ : resynch the two forks of this draft, reapply my changes dated 03-20 and 03-21. Normalize old 'may not' to 'must not' except in the one case where it meant 'may or may not'. 1997-03-21 : TB : massive changes on plane flight from Chicago to Vancouver 1997-03-21 : CMSMcQ : correct as many reported errors as possible. 1997-03-20 : CMSMcQ : correct typos listed in CMSMcQ hand copy of spec. 1997-03-20 : CMSMcQ : cosmetic changes preparatory to revision for WWW conference April 1997: restore some of the internal entity references (e.g. to docdate, etc.), change character xA0 to &nbsp; and define nbsp as &#160;, and refill a lot of paragraphs for legibility. 1996-11-12 : CMSMcQ : revise using Tim's edits: Add list type of NUMBERED and change most lists either to BULLETS or to NUMBERED. Suppress QuotedNames, Names (not used). Correct trivial-grammar doc type decl. Rename 'marked section' as 'CDATA section' passim. Also edits from James Clark: Define the set of characters from which [^abc] subtracts. Charref should use just [0-9] not Digit. Location info needs cleaner treatment: remove? (ERB question). One example of a PI has wrong pic. Clarify discussion of encoding names. Encoding failure should lead to unspecified results; don't prescribe error recovery. Don't require exposure of entity boundaries. Ignore white space in element content. Reserve entity names of the form u-NNNN. Clarify relative URLs. And some of my own: Correct productions for content model: model cannot consist of a name, so "elements ::= cp" is no good. 1996-11-11 : CMSMcQ : revise for style. Add new rhs to entity declaration, for parameter entities. 1996-11-10 : CMSMcQ : revise for style. Fix / complete section on names, characters. Add sections on parameter entities, conditional sections. Still to do: Add compatibility note on deterministic content models. Finish stylistic revision. 1996-10-31 : TB : Add Entity Handling section 1996-10-30 : TB : Clean up term & termdef. Slip in ERB decision re EMPTY. 1996-10-28 : TB : Change DTD. Implement some of Michael's suggestions. Change comments back to //. Introduce language for XML namespace reservation. Add section on white-space handling. Lots more cleanup. 1996-10-24 : CMSMcQ : quick tweaks, implement some ERB decisions. Characters are not integers. Comments are /* */ not //. Add bibliographic refs to 10646, HyTime, Unicode. Rename old Cdata as MsData since it's only seen in marked sections. Call them attribute-value pairs not name-value pairs, except once. Internal subset is optional, needs '?'. Implied attributes should be signaled to the app, not have values supplied by processor. 1996-10-16 : TB : track down & excise all DSD references; introduce some EBNF for entity declarations. 1996-10-?? : TB : consistency check, fix up scraps so they all parse, get formatter working, correct a few productions. 1996-10-10/11 : CMSMcQ : various maintenance, stylistic, and organizational changes: Replace a few literals with xmlpio and pic entities, to make them consistent and ensure we can change pic reliably when the ERB votes. Drop paragraph on recognizers from notation section. Add match, exact match to terminology. Move old 2.2 XML Processors and Apps into intro. Mention comments, PIs, and marked sections in discussion of delimiter escaping. Streamline discussion of doctype decl syntax. Drop old section of 'PI syntax' for doctype decl, and add section on partial-DTD summary PIs to end of Logical Structures section. Revise DSD syntax section to use Tim's subset-in-a-PI mechanism. 1996-10-10 : TB : eliminate name recognizers (and more?) 1996-10-09 : CMSMcQ : revise for style, consistency through 2.3 (Characters) 1996-10-09 : CMSMcQ : re-unite everything for convenience, at least temporarily, and revise quickly 1996-10-08 : TB : first major homogenization pass 1996-10-08 : TB : turn "current" attribute on div type into CDATA 1996-10-02 : TB : remould into skeleton + entities 1996-09-30 : CMSMcQ : add a few more sections prior to exchange with Tim. 1996-09-20 : CMSMcQ : finish transcribing notes. 1996-09-19 : CMSMcQ : begin transcribing notes for draft. 1996-09-13 : CMSMcQ : made outline from notes of 09-06, do some housekeeping
$B0lHL;v9`(B

$B3HD%2DG=$J(B&markup;$B8@8l(BXML(eXtensible Markup Language)$B$O!$(BXML$BJ8=q(B$B$H$$$&%G!<%?%*%V%8%'%/%H$N%/%i%9$r5,Dj$7!$(BXML$BJ8=q$r=hM}$9$k%W%m%0%i%`$NF0:n$N0lIt$r5,Dj$9$k!#(BXML$B$O!$(BSGML($BI8=`0lHL2=(B&markup;$B8@8l!$(BStandard Generalized Markup Language)$B$N@)8B$7$?(B⊂$B$H$9$k!#9=B$>e!$(BXML$BJ8=q$O!$$+$J$i$:(BSGML$B5,3J$KE,9g$9$k!#(B

XML$BJ8=q$O!$(B$B$B$H$$$&5-21C10L$+$i$J$j!$$BJ8;z(B$B$+$i$J$j!$$=$N0lIt$O!$J8=q$N(B$BJ8;z%G!<%?(B$B$r9=@.$7!$0lIt$O!$(B&markup;$B$r9=@.$9$k!#(B&markup;$B$O!$J8=q$N5-21%l%$%"%&%H5Z$SO@M}9=B$$K$D$$$F$N5-=R$rI=$9Id9f$H$9$k!#(BXML$B$O!$5-21%l%$%"%&%H5Z$SO@M}9=B$$K$D$$$F$N@)Ls>r7o$r5-=R$9$k5!9=$rDs6!$9$k!#(B

XML&processor;$B$H$$$&%=%U%H%&%'%"%b%8%e!<%k$O!$(BXML$BJ8=q$rFI$_9~$_!$$=$NFbMF5Z$S9=B$$X$N%"%/%;%9$rDs6!$9$k$?$a$KMQ$$$k!#(B XML&processor;$B$O!$B>$N%b%8%e!<%k$N$?$a$KF0:n$9$k$3$H$rA0Ds$H$7!$$=$N%b%8%e!<%k$r(B&application;$B$H$$$&!#(B$B$3$N(B&TR-or-Rec;$B$O!$(BXML&processor;$B$,9T$o$J$1$l$P$J$i$J$$?6Iq$$$r5,Dj$9$k!#$D$^$j!$(BXML$B%G!<%?$NFI9~$_J}K!$r5,Dj$7!$(B&application;$B$KDs6!$9$k>pJs$r5,Dj$9$k!#(B

$B7P0^5Z$SL\I8(B

1996$BG/$K(BWorld Wide Web Consortium(W3C)$B$NCf$K@_N)$7$?(BXML$B:n6H%0%k!<%W(B($B0JA0$O!$(B SGML$BJT=8%l%S%e!<0Q0w2q$H8F$P$l$?(B)$B$,!$(BXML$B$r3+H/$7$?!#$3$N:n6H%0%k!<%W$N5DD9$r!$(BSun Microsystems$B$N(BJon Bosak$B$,6P$a$k!#(BW3C$B$,AH?%$7!$0JA0$O(BSGML$B:n6H%0%k!<%W$H8F$P$l$?(BXML SIG(Special Interest Group)$B$b!$(BXML$B$N@)Dj$KHs>o$K3hH/$K;22h$7$?!#(B Dan Connolly$B$O!$:n6H%0%k!<%W$N(BW3C$B$K$*$1$kO"Mm78$rL3$a$?!#(B

XML$B$N@_7WL\I8$r!$

a) XML$B$O!$(BInternet$B>e$G$=$N$^$^;HMQ$G$-$k!#(B

b) XML$B$O!$9-HO0O$N(B&application;$B$r;Y1g$9$k!#(B

c) XML$B$O!$(BSGML$B$H8_49@-$r$b$D!#(B

d) XML$BJ8=q$r=hM}$9$k%W%m%0%i%`$r=q$/$3$H$O!$MF0W$G$J$1$l$P$J$i$J$$!#(B

e) XML$B$G$O!$%*%W%7%g%s$N5!G=$O$G$-$k$@$1>/$J$/$7!$0l$D$bB8:_$7$J$$$3$H$rL\;X$9!#(B

f) XML$BJ8=q$O!$?M4V$K$H$C$FFI$_$d$9$/!$==J,$KM}2r$7$d$9$$!#(B

g) XML$B$N@_7W$O!$$9$_$d$+$K9T$($J$1$l$P$J$i$J$$!#(B

h) XML$B$N@_7W$O!$87L)5Z$S4J7i$G$J$1$l$P$J$i$J$$!#(B

i) XML$BJ8=q$O!$MF0W$K:n@.$G$-$k!#(B

j) XML$B$G$O!$(B&markup;$B$N?t$r8:$i$9$3$H$O!$=EMW$G$O$J$$!#(B

XML$BBh(B&XML.version;&version;$B$rM}2r$7!$$=$l$r=hM}$9$k7W;;5!%W%m%0%i%`$r=q$/$?$a$K==J,$J>pJs$O!$$3$N(B&TR-or-Rec;$B5Z$S4XO"$9$k5,3J(B($BJ8;zMQ$H$7$F!$(BUnicode$B5Z$S(BISO/IEC 10646$B!$(B&language-identification;$B%?%0MQ$H$7$F!$%$%s%?%M%C%H(B RFC 1766$B!$(B&language-code;$BMQ$H$7$F!$(BISO 639$B!$JB$S$K(B&country-code;$BMQ$H$7$F!$(BISO 3166)$B$G!$$9$Y$F<($9!#(B

$B$3$N(B&version;$B$N(BXML$B$N5,Dj(B$B$O!$8x3+%l%S%e!<5Z$S5DO@$rL\E*$H$9$k!#%F%-%9%H5Z$SK!N'>e$NCm0U$r2~JQ$7$J$$8B$j!$<+M3$KG[I[$7$F$b$h$$!#(B

 $BDj5A(B

XML$BJ8=q$N5,Dj$N$?$a$K;HMQ$9$kMQ8l$O!$$3$N(B&TR-or-Rec;$BFb$GDj5A$9$k!#

$BE,9g$9$kJ8=qKt$O(BXML&processor;$B$O!$5-=R$5$l$?$H$*$j$KF0:n$7$F$b$h$$$,!$$=$N$H$*$j$K$9$kI,MW$O$J$$!#(B

$BE,9g$9$kJ8=qKt$O(BXML&processor;$B$O!$5-=R$5$l$?$H$*$j$KF0:n$9$k$3$H$,MW5a$5$l$k!#$=$&$G$J$1$l$P!$(B&error;$B$H$9$k!#(B

$B$3$N(B&TR-or-Rec;$B$,Dj$a$k5,B'$KBP$9$k0cH?!#7k2L$ODj5A$7$J$$!#E,9g$9$k%=%U%H%&%'%"$O!$(B&error;$B$r8!=P$7$FJs9p$7$F$b$h$/!$(B&error;$B$+$i2sI|$7$F$b$h$$!#(B

$BE,9g$9$k(BXML&processor;$B$,8!=P$7$J$1$l$P$J$i$:!$(B&application;$B$KJs9p$7$J$1$l$P$J$i$J$$(B&error;$B!#(B&fatal-error;$B$rH/8+$7$?$"$H!$(B&processor;$B$O!$$=$l0J9_$N(B&error;$B$rC5$9$?$a$K%G!<%?=hM}$rB39T$7$F$b$h$/!$(B&error;$B$rH/8+$7$?>l9g$O!$$=$N(B&error;$B$r(B&application;$B$KJs9p$7$F$b$h$$!#(B&error;$BD{@5$r%5%]!<%H$9$k$?$a$K!$(B&processor;$B$O!$L$=hM}%G!<%?(B($BJ8;z%G!<%?5Z$S(B&markup;$B$N:.:_$7$?$b$N(B)$B$rJ8=q$+$io$N=hM}$rB39T$7$F$O$J$i$J$$!#$D$^$j!$(B&processor;$B$O!$J8;z%G!<%?5Z$SJ8=q$NO@M}9=B$$K$D$$$F$N>pJs$r!$DL>o$NJ}K!$G(B&application;$B$KEO$7B3$1$F$O$J$i$J$$!#(B

$BE,9g$9$k%=%U%H%&%(%"$O!$5-=R$5$l$?$H$*$j$K?6$kIq$C$F$b$h$$(B(may)$B!$Kt$O?6$kIq$o$J$/$F$O$J$i$J$$(B(must)($BJ8>OCf$N=uF0;l$K$h$k!#(B)$B!#$=$N$H$*$j$K?6$kIq$&>l9g$O!$5-=R$5$l$??6Iq$$$rA*BrKt$O5qH]$9$k

$B$9$Y$F$N(B&valid;$B$J(BXML$BJ8=q$KE,MQ$9$k5,B'!#(B&validity;$B@)Ls$N0cH?$O!$(B&error;$B$H$9$k!#(B&at-user-option;$B!$(B$B8!>Z$r9T$&(BXML&processor;$B$O!$$3$N(B&error;$B$rJs9p$7$J$1$l$P$J$i$J$$!#(B

$B$9$Y$F$N(B&well-formed;$B$N(BXML$BJ8=q$KE,MQ$9$k5,B'!#(B&well-formed;$B@)Ls$N0cH?$O!$(B&fatal-error;$B$H$9$k!#(B

a) &string;$BKt$OL>A0$N(B&match;$B!!Hf3S$9$kFs$D$N(B&string;$BKt$OL>A0$O!$F10l$G$J$1$l$P$J$i$J$$!#(BISO/IEC 10646$B$K$*$$$F!$J#?t$NI=8=$,2DG=$JJ8;z!NNc$($P!$(B&composed-form;$B5Z$S4pDl(B+&diacritical-mark;($B%@%$%"%/%j%F%#%+%k%^!<%/(B)$B7A<0!O$O!$$I$A$i$N(B&string;$B$bF1$8I=8=$N$H$-$K8B$j!$(B&match;$B$9$k!#(B&at-user-option;$B!$(B&processor;$B$O!$$=$NJ8;z$rI8=`7A$K@55,2=$7$F$b$h$$!#Hf3S$N$H$-!"BgJ8;z$H>.J8;z$H$N6hJL$r$9$k!#(B<BR>b) &string;$B$HJ8K!Cf$N5,B'$H$N(B&match;$B!!$"$k@8@.5,B'$+$i@8@.$9$k8@8l$K!$$"$k(B&string;$B$,B0$9$k$H$-!$$3$N(B&string;$B$O!$$3$N@8@.5,B'$K(B&match;$B$9$k$H$$$&!#(B<BR>c) $BFbMF$HFbMF%b%G%k$H$N(B&match;$B!!$"$kMWAG$,!$(B$BMWAG$N(B&validity;$B$N@)Ls$K<($90UL#$GE,9g$9$k$H$-!$$3$NMWAG$O!$$=$N@k8@$K(B&match;$B$9$k$H$$$&!#(B

XML$B$N5!G=$G$"$C$F!$(BXML$B$,(BSGML$B$H8_49$G$"$k$3$H$rJ]>Z$9$k$?$a$@$1$KF3F~$5$l$k$b$N!#(B

$B94B+NO$O$b$?$J$$?d>);v9`!#(B&WebSGML;$B0JA0$+$iB8:_$9$k(BSGML&processor;$B$,!$(BXML$BJ8=q$r=hM}$G$-$k2DG=@-$r9b$a$k$?$a$K

$BJ8=q(B

$B$3$N(B&TR-or-Rec;$B$GDj5A$9$k0UL#$G!$(B&well-formed;$B$H$9$k%G!<%?%*%V%8%'%/%H$r!$(BXML$BJ8=q(B$B$H$$$&!#(B&well-formed;$B$N(BXML$BJ8=q$,!$$5$i$K!$$"$k@)Ls>r7o$rK~B-$9$l$P!$(B&valid;$B$J(BXML$BJ8=q$H$9$k!#(B

$B$$$:$l$N(BXML$BJ8=q$b!$O@M}9=B$5Z$SJ*M}9=B$$r$b$D!#J*M}E*$K$O!$J8=q$O!$(B$B$B$H8F$VC10L$+$i$J$k!#$"$k$N$N$B;2>H(B$B$7$F$b$h$$!#J8=q$O!$!H%k!<%H!I$9$J$o$A(B$BJ8=q$B$+$i;O$^$k!#O@M}E*$K$O!$J8=q$O!$@k8@!$MWAG!$%3%a%s%H!$J8;z;2>H5Z$S=hM}L?Na$r4^$_!$$3$l$i$9$Y$F$O!$J8=qFb$GL@<(E*$J(B&markup;$B$K$h$C$F<($9!#O@M}9=B$5Z$SJ*M}9=B$$O!$(B$B0J9_(B$B$K<($9$H$*$j$K!$87L)$KF~$l;R$K$J$C$F$$$J$1$l$P$J$i$J$$!#(B

&well-formed;$B$N(BXML$BJ8=q(B

$B$"$k%F%-%9%H%*%V%8%'%/%H$,!$

a) $BA4BN$H$7$F!$(Bdocument$B$H$$$&%i%Y%k$r$b$D@8@.5,B'$K(B&match;$B$9$k!#(B

b) $B$3$N(B&TR-or-Rec;$B$GDj5A$9$k!$$9$Y$F$N(B&well-formed;$B@)Ls$K=>$&!#(B

c) $B$=$l$>$l$N(B&parsed-entity;$B$,!$(B&well-formed;$B$H$J$k!#(B

$BJ8=q(B document prolog element Misc*

document$B@8@.5,B'$K(B&match;$B$9$k$H$O!$

a) $B0l$D0J>e$N(B$BMWAG(B$B$r4^$`!#(B

b) $B%k!<%H(B$BKt$OJ8=qMWAG$H$$$&MWAG$,0l$D$@$1B8:_$7!$$3$l$O!$B>$NMWAG$N(B$BFbMF(B$B$K4^$^$l$J$$!#(B$B$3$l0J30$N$9$Y$F$NMWAG$O!$$=$N3+;O%?%0$,B>$NMWAG$NFbMF$K4^$^$l$l$P!$BP1~$9$k=*N;%?%0$bF1$8MWAG$NFbMF$K4^$^$l$k!#$D$^$j!$MWAG$O!$3+;O%?%05Z$S=*N;%?%0$K$h$C$F6h@Z$i$l!$F~$l;R9=B$$r$J$9!#(B

$B$3$l$i$N7k2L$H$7$F!$J8=qFb$N$I$NHs%k!<%HMWAG(BC$B$KBP$7$F$b!$$"$kB>$NMWAG(BP$B$,B8:_$7!$(BC$B$O!$(BP$B$NFbMF$K4^$^$l$k$,!$(BP$B$NFbMF$K4^$^$l$kB>$NMWAG$K4^$^$l$k$3$H$O$J$$!#$3$N$H$-!$(BP$B$r(BC$B$N(B$B?F(B$B$H$$$$!$(BC$B$r(BP$B$N(B$B;R(B$B$H$$$&!#(B

 $BJ8;z(B

&parsed-entity;$B$O!$(B$B%F%-%9%H(B($BJ8;z(B$B$NJB$S$G$"$C$F!$(B&markup;$BKt$OJ8;z%G!<%?$rI=$7$F$b$h$$!#(B)$B$r4^$`!#(B$BJ8;z(B$B$O!$%F%-%9%H$N:G>.C10L$G$"$C$F!$(BISO/IEC 10646$B$K5,Dj$5$l$k!#(B$B5vMF$9$kJ8;z$O!$%?%V!$2~9T!$I|5"JB$S$K(BUnicode$B5Z$S(BISO/IEC 10646$B$,5vMF$9$k?^7AJ8;z$H$9$k!#(B $BJ8;z$NHO0O(B Char #x9 | #xA | #xD | [#x20-#D7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF] $BG$0U$N(BUnicode$BJ8;z!#$?$@$7!$(B&surrogate-blocks;$B!$(BFFFE$B5Z$S(BFFFF$B$O=|$/!#(B

&character-value;$B$r%S%C%H%Q%?%s$KId9f2=$9$k5!9=$O!$$NId9f2=J}K!$rMxMQ$9$k$?$a$N5!9=$O!$(B$BJ8;z$NId9f2=(B$B$K5-=R$9$k!#(B

$B$I$NId9f2=J}K!$rMQ$$$k$+$K4X78$J$/!$(BISO/IEC 10646$B$NJ8;z=89g$K$"$k$9$Y$F$NJ8;z$O!$$=$N(BUCS-4&code-value;$B$HEy2A$J(B10$B?J?tKt$O(B16$B?J?t$K$h$C$F!$;2>H$G$-$k!#(B

 $B6&DL$N9=J89=@.;R(B

2.3$B$G$O!$J8K!Fb$G9-$/;HMQ$9$k$$$/$D$+$N5-9f$rDj5A$9$k!#(B

S ($B6uGr(B)$B$O!$0l$D $B6uGr(B S (#x20 | #x9 | #xD | #xA)+

$BJX59>e!$J8;z$r!$(B&letter;$B!$?t;zKt$OB>$NJ8;z$KJ,N`$9$k!#(B&letter;$B$O!$%"%k%U%!%Y%C%HE*Kt$OI=2;E*$G$"$k4pK\J8;z(B($B0l$DKt$OJ#?t$N(B&combining-character;$B$,!$8e$KB3$/$3$H$b$"$k!#(B)$B!$(B&ideographic;$B$+$i@.$k!#(B $B3F%/%i%9$K$*$1$k$BJ8;z%/%i%9(B$B$K4X$9$kIUO?$K5,Dj$9$k!#(B

Name$B$O!$(B&letter;$BKt$O$$$/$D$+$N6h@Z$jJ8;z$N0l$D$G;O$^$j!$$=$N8e$K(B&letter;$B!$?t;z!$%O%$%U%s!$2<@~!$%3%m%sKt$O%T%j%*%I$,B3$/(B($B$3$l$i$rL>A0J8;z$H$$$&!#(B)$B!#(B&string;"xml"$BKt$O(B(('X'|'x') ('M'|'m') ('L'|'l'))$B$K(B&match;$B$9$kG$0U$N(B&string;$B$G;O$^$kL>A0$O!$$3$N(B&TR-or-Rec;$B$N8=:_$NHGKt$O>-Mh$NHG$G$NI8=`2=$N$?$a$KM=Ls$9$k!#(B

XML$B$NL>A0$NCf$N%3%m%s$O!$L>A06u4V$G$N-Mh$N$"$k;~E@$GI8=`2=$9$k$b$N$H$7!$$=$N$H$-$K$O!$A06u4V$N5!9=$,!$6h@Z$j;R$H$7$FZ$O$J$$!#;ve!$$3$l$O!$L>A06u4V$NA0$NCf$G%3%m%s$r;HMQ$7$J$$$[$&$,$h$$$3$H$r0UL#$9$k!#$7$+$7!$(BXML&processor;$B$O!$L>A0J8;z$H$7$F%3%m%s$r$^$7$$!#(B

Nmtoken ($BL>A0(B&token;)$B$O!$L>A0J8;z$G9=@.$9$kNs$H$9$k!#(B $BL>A05Z$S(B&token; NameChar Letter | Digit | '.' | '-' | '_' | ':' | CombiningChar | Extender Name (Letter | '_' | ':') (NameChar)* Names Name (S Name)* Nmtoken (NameChar)+ Nmtokens Nmtoken (S Nmtoken)*

&literal;$B%G!<%?$O!$0zMQId$G0O$^$l$?(B&string;$B$H$7!$$=$NNs$N6h@Z$j;R$H$7$F;HMQ$9$k0zMQId$O4^$^$J$$!#(B&literal;$B$O!$FbItEntityValue)$B!$B0@-CM(B(AttValue)$B!$30It(B&identifier;(SystemLiteral)$B$NFbMF$N;XDj$K;HMQ$9$k!#L\E*$K$h$C$F$O!$(B&literal;$BA4BN$r!$$=$NCf$N(B&markup;$B$NAv::$r9T$J$o$:$K!$%9%-%C%W$9$k$3$H$,$"$k(B(SkipLit$B!#(B)$B!#(B &literal; EntityValue ' " ' ([^%&"] | PEReference | Reference)* ' " ' |  " ' " ([^%&'] | PEReference | Reference)* " ' " AttValue ' " ' ([^<&"] | Reference)* ' " ' |  " ' " ([^<&'] | Reference)* " ' " SystemLiteral SkipLit PubidLiteral ' " ' PubidChar* ' " ' | " ' " (PubidChar - " ' ")* " ' " PubidChar #x20 | #xD | #xA | [a-zA-Z0-9] | [-'()+,./:=?] SkipLit (' " ' [^"]* ' " ') | (" ' " [^']* " ' ")

$BJ8;z%G!<%?5Z$S(B&markup;

$B%F%-%9%H(B$B$O!$(B$BJ8;z%G!<%?(B$B5Z$S(B&markup;$B$,:.:_$9$k$b$N$H$7$F9=@.$9$k!#(B&markup;$B$O!$(B$B3+;O%?%0(B$B!$(B$B=*N;%?%0(B$B!$(B$B6uMWAG(B$B!$(B$BH(B$B!$(B$BJ8;z;2>H(B$B!$(B$B%3%a%s%H(B$B!$(BCDATA$B%;%/%7%g%s(B $B$N6h@Z$j;R!$(B$BJ8=q7?@k8@(B$B5Z$S(B$B=hM}L?Na(B$B$N7A$r

&markup;$B$G$O$J$$$9$Y$F$N%F%-%9%H$O!$J8=q$N(B$BJ8;z%G!<%?(B$B$r9=@.$9$k!#(B

$B%"%s%Q%5%s%IJ8;z(B (&)$B5Z$S(B&left-angle-bracket; (<)$B$O!$(B&markup;$B$N6h@Z$j;R$H$7$F!$Kt$O(B$B%3%a%s%H(B$B!$(B$B=hM}L?Na(B$BCDATA$B%;%/%7%g%s(B$BFb$G;HMQ$9$k>l9g$K(B$B$@$1(B$B!$$=$N$^$^$N7A$G=P8=$7$F$h$$!#$3$l$i$NJ8;z$O!$FbIt&literal;$B$BFb$K5-=R$7$F$b$h$$!#(B $B>\$7$/$O!$(B&well-formed;$B$N$B$K4X$9$k5,Dj$r;2>H!#(B$B$3$l$i$NJ8;z$,B>$NItJ,$GI,MW$J>l9g!$?tCM$K$h$kJ8;z;2>HKt$O(B&string;"&amp;"$B5Z$S(B&string;"&lt;"$B$r;HMQ$7!$(B&escape;$B$7$J$1$l$P$J$i$J$$!#(B&right-angle-bracket; (>) $B$O!$(B&string;"&gt;"$B$r;HMQ$7$FI=8=$7$F$b$h$$!#FbMF$NCf$GNs(B"]]>"$B$r;HMQ$9$k$H$-$O!$$=$l$,!$(BCDATA$B%;%/%7%g%s(B$B$N=*N;$r(B&markup;$B$7$J$$8B$j!$(B$B8_49@-$N$?$a(B$B!$(B"&gt;"$BKt$OJ8;z;2>H$r;HMQ$7!$(B&escape;$B$7$J$1$l$P$J$i$J$$!#(B

$BMWAG$NFbMF$G$O!$J8;z%G!<%?$O!$$$$+$J$k(B&markup;$B$N3+;O6h@Z$j;R$r4^$^$J$$G$0U$N(B&char-string;$B$H$9$k!#(BCDATA$B%;%/%7%g%s$G$O!$J8;z%G!<%?$H$O!$(BCDATA$B%;%/%7%g%s$N=*N;6h@Z$j;R(B"]]>"$B$r4^$^$J$$G$0U$N(B&char-string;$B$H$9$k!#(B

$BB0@-CM$K(B&single-quote;$B5Z$S(B&double-quote;$B$r4^$`$?$a$K$O!$%"%]%9%H%m%U%#Kt$O(B&single-quote;(') $B$O!$(B"&apos;"$B$H$7$FI=8=$7!$(B&double-quote;(")$B$O!$(B"&quot;"$B$H$7$FI=8=$9$k!#(B $BJ8;z%G!<%?(B CharData [^<&]* - ([^<&]* ']]>' [^<&]*)

$B%3%a%s%H(B

$B%3%a%s%H(B$B$O!$B>$N(B&markup;$B$N30$J$i$P!$J8=q$N$I$3$K8=$l$F$b$h$$!#$5$i$K!$J8=q7?@k8@Fb$G!$J8K!$,5v$9>l=j$K8=$l$F$b$h$$!#(B $B%3%a%s%H$O!$J8=q$N(B$BJ8;z%G!<%?(B$B$N0lIt$G$O$J$$!#(BXML&processor;$B$O!$(B&application;$B$,%3%a%s%H$N%F%-%9%H$r$B8_49@-$N$?$a(B$B!$(B&string;"--" $B!J(B&double-hyphen;$B!K$O!$%3%a%s%HFb$G8=$l$F$O$J$i$J$$!#(B $B%3%a%s%H(B Comment '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->'

$B%3%a%s%H$NNc$r<!&como; declarations for <head> & <body> &comc;>

$B=hM}L?Na(B

$B=hM}L?Na(B(PI)$B$K$h$C$F!$(B&application;$B$N$?$a$NL?Na$rJ8=q$KF~$l$k$3$H$,$G$-$k!#(B $B=hM}L?Na(B PI '<?' PITarget (S (Char* - (Char* &pic; Char*)))? &pic; PITarget Name - (('X' | 'x') ('M' | 'm') ('L' | 'l')) PI$B$O!$J8=q$N(B$BJ8;z%G!<%?(B$B$N0lIt$G$O$J$$$,!$(B&application;$B$KEO$5$l$J$1$l$P$J$i$J$$!#(BPI$B$O!$L?Na$,EO$5$l$k(B&application;$B$r(B&identify;$B$?$a$K;HMQ$9$k(B⌖ (PITarget) $B$G;O$^$k!#(B⌖$BL>(B "XML"$B!$(B"xml"$B$J$I$O!$$3$N(B&TR-or-Rec;$B$N8=:_$NHGKt$O>-Mh$NHG$N5,3J2=MQ$KM=Ls$9$k!#(BXML$B$N(B$B5-K!(B$B5!9=$r!$(BPI$B$N(B⌖$B$r@k8@$9$k$?$a$K;HMQ$7$F$b$h$$!#(B

CDATA$B%;%/%7%g%s(B

CDATA$B%;%/%7%g%s(B$B$O!$J8;z%G!<%?$,=P8=$9$k$H$3$m$G$"$l$P!$$I$3$K=P8=$7$F$b$h$$!#$3$l$O!$$=$&$G$J$1$l$P!$(B&markup;$B$H$7$FG'<1$9$kJ8;z$r4^$`!$%F%-%9%H$N6h2h$r(B&escape;$B$9$k$N$K;HMQ$9$k!#(BCDATA$B%;%/%7%g%s$O!$(B&string;"<![CDATA["$B$G;O$^$j!$(B&string; "]]>"$B$G=*$o$k!#(B CDATA$B%;%/%7%g%s(B CDSect CDStart CData CDEnd CDStart '<![CDATA[' CData (Char* - (Char* ']]>' Char*)) CDEnd ']]>' CDATA$B%;%/%7%g%sFb$G$O!$Ns(BCDEnd$B$@$1$r(B&markup;$B$H$7$FG'<1$9$k$N$G!$(B&left-angle-bracket;$B5Z$S%"%s%Q%5%s%I$O!$$=$N(B&literal;$B7A<0$G=P8=$7$F$h$$!#$=$l$i$O!$(B"&lt;"$B5Z$S(B"&amp;"$B$r;HMQ$7$F(B&escape;$B$9$kI,MW$O$J$$!#(BCDATA$B%;%/%7%g%s$O!$F~$l;R$K$O$G$-$J$$!#(B

"<greeting>"$B5Z$S(B"</greeting>"$B$r!$(B&markup;$B$G$O$J$/!$(B$BJ8;z%G!<%?(B$B$H$7$FG'<1$9$k(BCDATA$B%;%/%7%g%s$NNc$r!$<![CDATA[<greeting>Hello, world!</greeting>]]>

&prolog;$B5Z$SJ8=q7?@k8@(B

XML$BJ8=q$O!$;HMQ$9$k(BXML$B$N(B&version;$B$r;XDj$9$k(BXML$B@k8@(B$B$G;O$a$F$b$h$/!$Kt$=$&$9$k$N$,K>$^$7$$!#(B

$B$3$N(B&TR-or-Rec;$B$N$3$N(B&version;$B$KE,9g$9$k$3$H$r<($9$?$a$K$O!$(B&version;$BHV9f(B "1.0" $B$r;HMQ$7$J$1$l$P$J$i$J$$!#$"$kJ8=q$,!$$3$N(B&TR-or-Rec;$B$N$3$N(B&version;$B$KE,9g$7$J$$$H$-!$CM(B"1.0"$B$r;HMQ$9$k$N$O!$(B&error;$B$H$9$k!#$3$N(B&TR-or-Rec;$B$N:#8e$N(B&version;$B$K(B"1.0"$B0J30$NCM$rIUM?$9$k$3$H$,!$(BXML$B:n6H%0%k!<%W$N0U?^$@$,!$(BXML$B$N>-Mh$N(B&version;$B$r:n@.$9$k$3$H$N3NLs$r<($9$o$1$G$O$J$/!$:n@.$7$?$H$7$F$b!$HV9fIU$1$K$D$$$F!$FCDj$NJ}K!$r;HMQ$9$k$3$H$N3NLs$r<($9$o$1$G$b$J$$!#>-Mh$N(B&version;$B$N2DG=@-$r=|30$7$J$$$N$G!$I,MW$J>l9g!$<+F0E*$J(B&version;$B$NG'<1$r2DG=$H$9$k

XML$BJ8=qFb$N(B&markup;$B$N5!G=$O!$5-219=B$5Z$SO@M}9=B$$r5-=R$9$k$3$H!$JB$S$KB0@-5Z$SB0@-CM$NBP$rO@M}9=B$$K4XO"$E$1$k$3$H$K$"$k!#(BXML$B$O!$O@M}9=B$$K$D$$$F$N@)Ls>r7o$rDj5A$9$k$?$a!$5Z$S$"$i$+$8$aDj5A$5$l$?5-21C10L$r;HMQ$G$-$k$?$a$N5!9=$H$7$F!$(B$BJ8=q7?@k8@(B$B$rDs6!$9$k!#(BXML$BJ8=q$,(B&valid;$B$H$O!$J8=q7?@k8@$r$b$A!$$=$NJ8=q7?@k8@$K<($9@)Ls>r7o$rK~$?$9$3$H$H$9$k!#(B

$BJ8=q7?@k8@$O!$J8=q$N:G=i$N(B$BMWAG(B$B$NA0$K8=$l$J$1$l$P$J$i$J$$!#(B &prolog; prolog XMLDecl? Misc* (doctypedecl Misc*)? XMLDecl &xmlpio; VersionInfo EncodingDecl? SDDecl? S? &pic; VersionInfo S 'version' Eq ('"VersionNum"' | "'VersionNum'") Eq S? '=' S? VersionNum ([a-zA-Z0-9_.:] | '-')+ Misc Comment | PI | S

$BNc$($P!$&well-formed;$B$G$"$k$,(B&valid;$B$G$O$J$$!#(B Hello, world! ]]> $BHello, world! ]]>

XML$B$N(B$BJ8=q7?@k8@(B$B$O!$$"$kJ8=q%/%i%9$N$?$a$NJ8K!$rDs6!$9$k(B&markup;$B@k8@(B$B$r4^$`$+!$Kt$O;2>H$9$k!#$3$NJ8K!$r!$J8=q7?Dj5AKt$O(BDTD$B$H$$$&!#J8=q7?@k8@$O!$(B&markup;$B@k8@$r4^$s$@30It(B⊂($BFCJL$J$B30It)$B$r;2>H$G$-!$Kt$OFbIt(B⊂$B$KD>@\(B&markup;$B@k8@$r4^$`$3$H$b$G$-$k!#$5$i$K!$$=$NN>J}$b2DG=$H$9$k!#$"$kJ8=q$N(BDTD$B$O!$N>J}$N(B⊂$B$r$^$H$a$?$b$N$H$7$F9=@.$9$k!#(B

&markup;$B@k8@(B$B$O!$(B$BMWAG7?@k8@(B$B!$(B $BB0@-%j%9%H@k8@(B$B!$(B$B$BKt$O(B$B5-K!@k8@(B$B$H$9$k!#(B$B¶meter;$B$BFb$KA4BNKt$O0lIt$,4^$^$l$F$b$h$$!#>\$7$$5,Dj$O!$(B$BJ*M}9=B$(B$B$K4X$9$k5,Dj$r;2>H$N$3$H!#(B

$BJ8=q7?Dj5A(B doctypedecl '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>' markupdecl elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment &root;$BMWAG7?(B

$BJ8=q7?@k8@$K$*$1$k(BName$B$O!$(B&root;$BMWAG$N7?$H(B&match;$B$7$J$1$l$P$J$i$J$$!#(B

$B@k8@5Z$S(B¶meter;$B

¶meter;$B$B$N(B&replacement-text;$B$O!$(B&markup;$B@k8@Fb$K$*$$$F!$87L)$KF~$l;R$K$J$C$F$$$J$1$l$P$J$i$J$$!#$D$^$j!$(B&markup;$B@k8@(B(markupdecl)$B$N:G=iKt$O:G8e$NJ8;z$,!$(B¶meter;$BH(B$B$NBP>]$H$J$k(B&replacement-text;$B$K4^$^$l$l$P!$N>J}$H$bF1$8(B&replacement-text;$B$K4^$^$l$J$1$l$P$J$i$J$$!#(B

 $BFbIt(B⊂$BFb$N(B¶meter;$B

DTD$B$NFbIt(B⊂$B$G$O!$(B¶meter;$BH(B$B$O!$(B&markup;$B@k8@$,=P8=2DG=$J>l=j$@$1$K=P8=$G$-$k!#(B&markup;$B@k8@Fb$K$O=P8=$G$-$J$$(B($B$3$N@)Ls$O!$30It(B¶meter;$BH$K$OE,MQ$7$J$$!#(B)$B!#(B

$BFbIt(B⊂$B$N$H$-$HF1MM$K!$30It(B⊂$B5Z$S(BDTD$B$K$*$$$F;2>H$9$kG$0U$N30It(B¶meter;$Bmarkupdecl$B$K$h$C$F5v$5$l$k7?$N!$0lO"$N40A4$J(B&markup;$B@k8@$G9=@.$5$l$J$1$l$P$J$i$J$$!#(B&markup;$B@k8@$N4V$K$O!$6uGrKt$O(B¶meter;$BH(B$B$rCV$$$F$b$h$$!#$7$+$7!$30It(B⊂$BKt$O30It(B¶meter;$B$B>r7oIU$-%;%/%7%g%s(B$B$r;HMQ$7$FL5;k$7$F$b$h$$!#FbIt%5%V%;%C%H$G$O!$$3$l$O5v$5$l$J$$!#(B $B30It(B⊂ extSubset ( markupdecl | conditionalSect | PEReference | S )*

$B30It(B⊂$B5Z$S30It(B¶meter;$B$B4V(B$B$@$1$G$J$/!$(B&markup;$B@k8@$N(B$BFb(B$B$G$bG'<1$5$l$k!$$H$$$&E@$G$bFbIt(B⊂$B$H$O0[$J$k!#(B

$BJ8=q7?@k8@IU$-$N(BXML$BJ8=q$NNc$r!$ Hello, world! ]]> $B%7%9%F%`(B&identifier; "hello.dtd"$B$,!$J8=q$N(BDTD$B$N(BURI$B$H$J$k!#(B

$B ]> Hello, world! ]]> $B30It(B⊂$B5Z$SFbIt(B⊂$B$NN>J}$r;HMQ$9$k$H$-$O!$FbIt(B⊂$B$,30It(B⊂$B$h$j@h$K=P8=$7$?$H8+$J$9!#(B$B$3$l$O!$FbIt(B⊂$B$N &standalone;$BJ8=q@k8@(B

XML&processor;$B$O!$(B&application;$B$KJ8=q$NFbMF$rEO$9$,!$(B&markup;$B@k8@$O!$$3$NFbMF$K1F6A$rM?$($k$3$H$,$"$k!#B0@-$N(B&default-value;$B5Z$S &standalone;$BJ8=q@k8@(B SDDecl S 'standalone' Eq "'" ('yes' | 'no') "'" | S 'standalone' Eq '"' ('yes' | 'no') '"'

&standalone;$BJ8=q@k8@$K$*$$$F$O(B, "yes"$B$NCM$O!$(B$BJ8=q$B$N30It$K!J(BDTD$B$N30It(B⊂$BFb$K!$Kt$OFbIt(B⊂$B$+$i;2>H$5$l$k30It%Q%i%a%?pJs$K1F6A$9$k(B&markup;$B@k8@$,B8:_$7$J$$$3$H$r0UL#$9$k!#(B"no"$B$NCM$O!$$=$N30It(B&markup;$B@k8@$,B8:_$9$k$+!$Kt$OB8:_$9$k2DG=@-$,$"$k$3$H$r0UL#$9$k!#(B&standalone;$BJ8=q@k8@$O!$$=$N(B$B@k8@(B$B$,J8=q30It$KB8:_$9$k$+$I$&$+$r<($9$@$1$KCm0U$9$k$3$H!#30ItH$,J8=qFb$KB8:_$7$F$$$F$b!$$=$NuBV$K$O1F6A$rM?$($J$$!#(B

$B30It$K(B&markup;$B@k8@$,B8:_$7$J$1$l$P!$(B&standalone;$BJ8=q@k8@$O0UL#$r$b$?$J$$!#30It$K(B&markup;$B@k8@$,B8:_$7!$(B&standalone;$BJ8=q@k8@$,B8:_$7$J$$>l9g$O!$(B"no" $B$NCM$N@_Dj$r2>Dj$9$k!#(B

XML$BJ8=q$G(B standalone="no" $B$,@_Dj$5$l$F$$$k$b$N$O!$$"$k%"%k%4%j%:%`$G(B&standalone;$BJ8=q$KJQ49$G$-!$$3$NJ8=q$O!$%M%C%H%o!<%/G[?.(B&application;$B$K$H$C$FK>$^$7$$$+$b$7$l$J$$!#(B

&standalone;$BJ8=q@k8@(B

&standalone;$BJ8=q@k8@$O!$2?$i$+$N30It(B&markup;$B@k8@$,no" $B$r

a) &default;$BCMIU$-$NB0@-$G$"$C$F!$$3$NB0@-$,E,MQ$5$l$kMWAG$,!$B0@-CM$r;XDj$;$:$KJ8=qFb$K8=$l$k$b$N!#(B

b) &magicents;$B0J30$N$B;2>H(B$B$,J8=qFb$K=P8=$9$k$b$N!#(B

c) $BCM$,(B$B@55,2=(B$B$NBP>]$H$J$kB0@-$G$"$C$F!$@55,2=$N7k2L$H$7$FJQ2=$9$kCM$,J8=qFb$GB0@-$K;XDj$5$l$k$b$N!#(B

d) $BMWAGFbMF(B$B$r$b$DMWAG7?$G$"$C$F!$6uGr$,$=$NMWAG7?$N$$$:$l$+$N%$%s%9%?%s%9Fb$KD>@\8=$l$k$b$N!#(B

&standalone;$BJ8=q@k8@IU$-$N(BXML$B@k8@$NNc$r!$<?xml version="&XML.version;" standalone='yes'?>

 $B6uGr$N

XML$BJ8=q$rJT=8$9$k$H$-$O!$(B&markup;$B$rL\N)$?$;FI$_$d$9$/$9$k$?$a$K!$!H6uGr!I(B(&space;$B!$%?%V5Z$S6uGr9T!#$3$N(B&TR-or-Rec;$B$G$O!$Hs=*C<5-9f$N(BS$B$GI=$9(B)$B$r;H$&$HJXMx$J$3$H$,B?$$!#$=$N6uGr$O!$G[I[$9$k(B&version;$B$NJ8=q$N0lIt$H$7$F4^$a$k$3$H$r0U?^$7$J$$$N$rIaDL$H$9$k!#$7$+$7!$!H0UL#$N$"$k!I6uGr$G$"$C$F!$G[I[$9$k(B&version;$B$K;D$5$J$1$l$P$J$i$J$$$b$N$bB?$$!#Nc$($P!$;m5Z$S%=!<%9%3!<%I$K$*$1$k6uGr$,$"$k!#(B

XML&processor;$B$O!$J8=qFb$N(B&markup;$B0J30$N$9$Y$F$NJ8;z$r!$$=$N$^$^JQ99$;$:$K(B&application;$B$KEO$5$J$1$l$P$J$i$J$$!#(B&validating;XML&processor;$B$O!$(B$BMWAGFbMF(B$B$NCf$N6uGr$rB>$NHs(B&markup;$BJ8;z$+$i6hJL$7!$(B&application;$BB&$KMWAGFbMF$NCf$N6uGr$,=EMW$G$J$$$H$$$&$3$H$rEA$($J$1$l$P$J$i$J$$!#(B

"xml:space"$B$H$$$&FCJL$J(B$BB0@-(B$B$rJ8=q$KA^F~$9$k$3$H$K$h$C$F!$6uGr$r=EMW$H$9$k0U?^$r<($7$F$b$h$$!#$3$NB0@-$rE,MQ$9$kMWAG$K8=$l$k6uGr$r!$%"%W%j%1!<%7%g%s$,=EMW$J$b$N$H$7$F07$&$3$H$rMW5a$9$k!$$H$$$&0U?^$r<($9!#(B

&valid;$B$JJ8=q$G$O!$$3$NB0@-$r;HMQ$9$k>l9g$O!$B>$NB0@-$HF1$8$h$&$K(B$B@k8@(B$B$7$J$1$l$P$J$i$J$$!#@k8@$9$k$H$-$O!$default"$B5Z$S(B "preserve"$B$@$1$H$9$k(B$BNs5s7?(B$B$G$J$1$l$P$J$i$J$$!#(B

$BCM(B"default"$B$O!$(B&application;$B$N(B&default;$B$N6uGr=hM}%b!<%I$r!$$=$NMWAG$KE,MQ2DG=$H$9$k$3$H$r0UL#$9$k!#CM(B"preserve"$B$O!$(B&application;$B$,$9$Y$F$N6uGr$rJ]B8$9$k$3$H$r0UL#$9$k!#$3$N@k8@$N0U?^$O!$(B"xml:space" $BB0@-$NJL$N;XDj$G>e=q$-$7$J$$8B$j!$MWAG$NFbMF$K8=$l$k$9$Y$F$NMWAG$KE,MQ$9$k$H2r

$BJ8=q$N(B&root;$BMWAG(B$B$K$D$$$F$O!$$3$NB0@-$NCM$r;XDj$9$k$+!$Kt$O$3$NB0@-$N(B&default-value;$B$,$"$k>l9g$r=|$$$F$O!$(B&application;$B$K$h$k6uGr$N

$BNc$r]]>

$B9TKv$N

XML$B$N(B$B9=J8(B&parsed-entity;$B$O!$DL>o%3%s%T%e!<%?$N%U%!%$%kFb$KJ]B8$5$l!$JT=8$NJX59$N$?$a$KJ#?t$N9T$KJ,$1$k$3$H$,B?$$!#$3$l$i$N9T$O!$IaDL$O!$(BCR (#xD)$B%3!<%I5Z$S(B LF (#xA)$B%3!<%I$N2?$i$+$NAH9g$;$K$h$C$FJ,$1$i$l$k!#(B

&application;$B$N=hM}$r4JC1$K$9$k$?$a!$30It(B&parsed-entity;$BKt$OFbIt(B&parsed-entity;$B$N(B&literal;$B#xD#xA" $B$N#2J8;z$NO"B3$H$9$k(B&literal;$BKt$O(B#xD$B$NC1FH$N(B&literal;$B$r4^$`>l9g$K!$(BXML&processor;$B$O!$(B&application;$B$KC10l$NJ8;z(B#xA$B$@$1$rEO$5$J$1$l$P$J$i$J$$(B($B$3$N=hM}$O!$F~NOFb$KB8:_$9$k2~9T%3!<%I$r9=J82r@O$NA0$K@55,2=$9$k$3$H$K$h$C$F!$MF0W$K &language-identification;

$BJ8=q=hM}$K$*$$$F$O!$$=$NJ8=q$NCf?H$,$I$s$J<+A38@8lKt$O7A<08@8l$G=q$+$l$F$$$k$+L@<($9$k$3$H$,!$Lr$KN)$D$3$H$,B?$$!#(B

XML$BJ8=qFb$NMWAG$N$b$DFbMFKt$OB0@-CM$K$*$$$F;HMQ$9$k(B$B8@8l$r;XDj$9$k$?$a$K!$(B"xml:lang" $B$H$$$&L>A0$NFCJL$J(B$BB0@-(B$B$r!$J8=qFb$KA^F~$7$F$b$h$$!#(B $BB0@-$NCM$O!$(B$B!H(BRFC1766$B!'(B&language-identification;$B$N$?$a$N%?%0!I$K$h$C$F5,Dj$5$l$k(B&language-identification;$B%3!<%I$K=>$&!#(B &language-identification; LanguageID Langcode ('-' Subcode)* Langcode ISO639Code | IanaCode | UserCode ISO639Code ([a-z] | [A-Z]) ([a-z] | [A-Z]) IanaCode ('i' | 'I') '-' ([a-z] | [A-Z])+ UserCode ('x' | 'X') '-' ([a-z] | [A-Z])+ Subcode ([a-z] | [A-Z])+ Langcode$B$O!$

a) $B!H8@8l$NL>A0I=8=$N$?$a$N%3!<%I!I$G5,Dj$5$l$k(B2$BJ8;z$N(B&language-code;

b) Internet Assigned Numbers Authority (IANA)$B$GEPO?$5$l$F$$$k(B&language-code;$B!#$3$l$O!$@hF,$,(B "i-" ($BKt$O(B"I-")$B$G;O$^$k!#(B

c) &user;$B$K$h$C$FDj$a$i$l$?(B&language-code;$B!$Kt$O;dE*$J;HMQ$N$?$a$KJ#?t$NCDBN4V$,x-" $BKt$O(B "X-" $B$G;O$a$k!#(B

Subcode$B$O!$J#?t2s;H$C$F$b$h$$!#:G=i$N%5%V%3!<%I$,B8:_$7!$$=$NFbMF$,Fs$D$NJ8;z$+$i@.$k$H$-$O!$(BISO3166$B$N!H9qL>$rI=$9%3!<%I(B($B9q%3!<%I(B)$B!I$G$J$1$l$P$J$i$J$$!#:G=i$N%5%V%3!<%I$,(B3$BJ8;z0J>e$+$i@.$k$H$-$O!$(BLangcode$B$N@hF,$,!$(B"x-" $BKt$O(B "X-"$B$G;O$^$i$J$$8B$j!$;XDj$7$?8@8l$KBP$9$k%5%V%3!<%I$H$7!$(BIANA$B$KEPO?$5$l$?$b$N$G$J$1$l$P$J$i$J$$!#(B

&language-code;$B$O!$>.J8;z$G$NI=5-$r!$(B&country-code;$B$O!$(B($BB8:_$9$k$J$i$P(B)$BBgJ8;z$G$NI=5-$r479T$H$9$k!#$7$+$7!$(BXML$BJ8=qFb$K$*$1$kB>$NL>A0$H$O0[$J$j!$$3$l$i$NCM$K$D$$$F$O!$BgJ8;z5Z$S>.J8;z$N6hJL$r$7$J$$$3$H$KCm0U$9$k$3$H!#(B

$BNc$rThe quick brown fox jumps over the lazy dog.

What colour is it?

What color is it?

Habe nun, ach! Philosophie, Juristerei, und Medizin und leider auch Theologie ]]>durchaus studiert mit heißem Bemüh'n. ]]>

xml:lang$B$G@k8@$9$k0U?^$O!$(Bxml:lang$B$NJL$N;XDj$G>e=q$7$J$$8B$j!$;XDj$7$?MWAG$NFbMF$K4^$`$9$Y$F$NMWAG$KE,MQ$9$k!#(B

&valid;$B$JJ8=q$K$*$$$F$O!$$3$N(B&TR-or-Rec;$B$NB>$N>l=j$G5,Dj$9$k$H$*$j!$$3$NB0@-$rI,$:@k8@$7$J$1$l$P$J$i$J$$!#DL>o!$@k8@$O!$xml:lang NMTOKEN #IMPLIED $BI,MW$J$i$P!$FCDj$N(B&default-value;$B$rM?$($F$b$h$$!#1Q8l$rJl8l$H$9$k3X@8MQ$N%U%i%s%98l$N;m=8$G$O!$@bL@5Z$SCm$r1Q8l$G5-=R$9$l$P!$(Bxml:lang $BB0@-$r ]]>

$BO@M}9=B$(B

$B$$$+$J$k(BXML$BJ8=q(B$B$b!$0l$D0J>e$N(B$BMWAG(B$B$r4^$`!#MWAG$N6-3&$O(B, $B3+;O%?%0(B$B5Z$S(B$B=*N;%?%0(B$B$K$h$C$F6h@Z$k!#MWAG$,(B$B6u(B$BMWAG$N$H$-$O!$(B$B6uMWAG%?%0(B$B$G<($9!#3F!9$NMWAG$O!$7?$r$b$D!#MWAG7?$OL>A0(B($B6&DL(B&identifier;(generic identifier)$BKt$O(BGI$B$H8F$V$3$H$,$"$k!#(B)$B$K$h$C$F(B&identified;$B!#MWAG$O!$$$$/$D$+$NB0@-$r$b$D$3$H$,$G$-$k!#(B$BB0@-$O!$(B$BL>A0(B$B5Z$S(B$BCM(B$B$r$b$D!#(B

$BMWAG(B element EmptyElemTag | STag content ETag

$B$3$N(B&TR-or-Rec;$B$O!$MWAG7?5Z$SB0@-$N0UL#!$;HMQJ}K!!$Kt$O(B($B9=J8$K4X$9$k$3$H$r=|$-(B)$BL>A0$K@)Ls$rM?$($J$$!#$?$@$7!$@hF,$,(B(('X'|'x')('M'|'m')('L'|'l'))$B$K(B&match;$B$9$kL>A0$O!$$3$NHGKt$O:#8e$NHG$N$3$N(B&TR-or-Rec;$B$G$NI8=`2=$N$?$a$KM=Ls$9$k!#(B

$BMWAG7?$N(B&match;

$BMWAG$N=*N;%?%0$N(B$BL>A0(B$B$O!$$=$NMWAG$N3+;O%?%0$K$*$1$k7?$H(B&match;$B$7$J$1$l$P$J$i$J$$!#(B

 $B3+;O%?%0!$=*N;%?%05Z$S6uMWAG%?%0(B

$B6u$G$J$$G$0U$N(BXML$BMWAG$N;O$^$j$O!$(B$B3+;O%?%0(B$B$K$h$C$F(B&markup;$B$9$k!#(B $B3+;O%?%0(B STag'<' Name (S Attribute)* S? '>' AttributeName Eq AttValue $B3+;O%?%05Z$S=*N;%?%0Fb$N(BName$B$O!$MWAG$N(B$B7?(B$B$rI=$o$9!#(BName$B5Z$S(BAttValue$B$NBP$rMWAG$N(B$BB0@-;XDj(B$B$H$$$$(B$B!$(B$B8D!9$NBP$K$*$1$k(BName$B$O!$(B$BB0@-L>(B$B5Z$S(BAttValue$B$NFbMF(B($B6h@Z$j;R(B'$BKt$O(B"$B$N4V$N(B&string;)$B$r(B$BB0@-CM(B$B$H$$$&!#(B

$BB0@-;XDj$N0l0U@-(B

$B3+;O%?%0Kt$O6uMWAG%?%0$G$O!$F10l$NB0@-L>$,#2EY0J>e=P8=$7$F$O$J$i$J$$!#(B

 $BB0@-CM$N7?(B

$BB0@-$O@k8@$5$l$F$$$J$1$l$P$J$i$J$$!#B0@-CM$N7?$O!$$=$NB0@-$KBP$7$F@k8@$7$?7?$G$J$1$l$P$J$i$J$$(B($BB0@-$N7?$K$D$$$F$O!$(B$BB0@-%j%9%H@k8@(B$B$K$D$$$F$N5,Dj$r;2>H!#(B)$B!#(B

 $B30ItH$,$J$$$3$H(B

$BB0@-CM$K$O!$30It@\E*Kt$O4V@\E*$J;2>H$r4^$`$3$H$O$G$-$J$$!#(B

 $BB0@-CM$K(B<$B$r4^$^$J$$$3$H(B

$BB0@-CMFb$GD>@\E*Kt$O4V@\E*$K;2>H$9$k&lt;$B$r=|$/!#(B)$B$N(B&replacement-text;$B$K$O!$(B<$B$r4^$s$G$O$J$i$J$$!#(B

$B3+;O%?%0$NNc$r!$<termdef id="dt-dog" term="dog">

$B3+;O%?%0$G;O$^$kMWAG$N=*$o$j$O!$(B$B=*N;%?%0(B$B$G(B&markup;$B$7$J$1$l$P$J$i$J$$!#$3$N=*N;%?%0$O!$BP1~$9$k3+;O%?%0$NMWAG7?$HF1$8L>A0$r$b$D!#(B $B=*N;%?%0(BETag'</' Name S? '>'

$B=*N;%?%0$NNc$r!$</termdef>

$BMWAG$N3+;O%?%0$H=*N;%?%0$H$N4V$N(B$B%F%-%9%H(B$B$r!$$=$NMWAG$N(B$BFbMF(B$B$H$$$&!#(B $BMWAG$NFbMF(B content(element | CharData | Reference | CDSect | PI | Comment)*

$BMWAG$,(B$B6u(B$B$N$H$-!$$=$NMWAG$O!$D>8e$K=*N;%?%0$r$b$D3+;O%?%0Kt$O6uMWAG%?%0$GI=8=$7$J$1$l$P$J$i$J$$!#(B$B6uMWAG%?%0(B$B$O!$$B6uMWAG$N$?$a$N%?%0(BEmptyElemTag'<' Name (S Attribute)* S? '/>'

$B6uMWAG%?%0$O!$FbMF$r$b$?$J$$G$0U$NMWAG$NI=8=$KMxMQ$G$-$k!#6uMWAG%?%0$GI=8=$9$kMWAG$r!$%-!<%o!<%I(BEMPTY$B$rMQ$$$F@k8@$7$J$/$H$b$h$$!#(B

$B6uMWAG$NNc$r!$<IMG align="left" src="http://www.w3.org/Icons/WWW/w3c_home" /><br></br><br/>

 $BMWAG@k8@(B

&validity;$B$rJ]>Z$9$k$?$a!$MWAG@k8@5Z$SB0@-%j%9%H@k8@$rMQ$$$F(BXML$BJ8=q(B$B$N(B$BMWAG(B$B$N9=B$$K!$@)Ls$r2C$($k$3$H$,$G$-$k!#(B

$BMWAG@k8@$O!$MWAG$N(B$BFbMF(B$B$K$D$$$F$N@)Ls$H$9$k!#(B

$BMWAG@k8@$O!$MWAG$N(B$B;R(B$B$H$7$F=P8=2DG=$JMWAG7?$K$D$$$F!$@)Ls$r2C$($k$3$H$,B?$$!#(B&at-user-option;$B!$MWAG@k8@$r$b$?$J$$MWAG7?$,B>$NMWAG@k8@$K$h$C$F;2>H$5$l$l$P!$(BXML&processor;$B$O!$7Y9p$r=P$7$F$b$h$$!#$7$+$7!$$3$l$O(B&error;$B$H$O$7$J$$!#(B

$BMWAG7?@k8@(B$B$O!$$BMWAG7?@k8@(B elementdecl '<!ELEMENT' S Name S contentspec S? '>' contentspec 'EMPTY' | 'ANY' | Mixed | children $B$3$3$G!$(BName$B$O!$@k8@$5$l$F$$$kMWAG$N7?$H$9$k!#(B

$BMWAG@k8@$N0l0U@-(B

$BMWAG7?$r#2EY0J>e@k8@$G$-$J$$!#(B

 $BMWAG$N(B&validity;

$BMWAG$,(B&valid;$B$H$O!$(Belementdecl$B$K(B&match;$B$9$k@k8@$G$"$C$F!$$=$N(BName$B$,$=$NMWAG7?$H(B&match;$B$7!$r7o$rK~$?$9>l9g$H$9$k!#(B

a) $B@k8@$,(BEMPTY$B$K(B&match;$B$7!$MWAG$,(B$BFbMF(B$B$r$b$?$J$$!#(B

b) $B@k8@$,(Bchildren$B$K(B&match;$B$7!$MWAG$N(B$B;RMWAG(B$B$NJB$S$,!$FbMF%b%G%k$N@55,I=8=$K$h$C$F@8@.$5$l$k8@8l$KB0$9$k!#(B

c) $B@k8@$,(Bmixed$B$K(B&match;$B$7!$MWAG$NFbMF$,(B$BJ8;z%G!<%?(B$B5Z$S(B$B;RMWAG(B$B$+$i$J$k!#;RMWAG$NMWAG7?$O!$MWAG$NFbMF%b%G%k$K=P8=$9$kL>A0$K(B&match;$B$9$k!#(B

d) $B@k8@$,(BANY$B$K(B&match;$B$7!$$I$N(B$B;RMWAG(B$B$NMWAG7?$b@k8@$5$l$F$$$k!#(B

$BMWAG@k8@$NNc$r!$ <!ELEMENT br EMPTY> <!ELEMENT p (#PCDATA|emph)* > <!ELEMENT %name.para; %content.para; > <!ELEMENT container ANY>

$BMWAGFbMF(B

$B$"$k7?$NMWAG$,(B$B;R(B$BMWAG$@$1$r4^$`(B($BJ8;z%G!<%?$r4^$^$J$$!#(B)$B$H$-!$$=$NMWAG(B$B7?(B$B$O!$(B$BMWAGFbMF(B$B$r$b$D!$$H$$$&!#(B$B$3$N>l9g!$@)Ls$O!$FbMF%b%G%k$r4^$`!#FbMF%b%G%k$O!$;RMWAG$N7?5Z$S;RMWAG$N=P8==g=x$r@)8f$9$k4JC1$JJ8K!$H$9$k!#$3$NJ8K!$O!$(B&content-particle;(cps)$B$+$i$J$k!#(B&content-particle;$B$O!$L>A0!$(B&content-particle;$B$NA*Br%j%9%HKt$O(B&content-particle;$B$NNs%j%9%H$+$i9=@.$5$l$k!#(B $BMWAGFbMF%b%G%k(B children(choice | seq) ('?' | '*' | '+')?cp(Name | choice | seq) ('?' | '*' | '+')? choice'(' S? cp ( S? '|' S? cp )*S? ')' seq'(' S? cp ( S? ',' S? cp )*S? ')' $B$3$3$G!$(BName$B$O!$(B$B;R(B$B$H$7$F=P8=$7$F$h$$MWAG$N7?$r<($9!#$3$NJ8K!$GA*Br%j%9%H$,8=$l$k0LCV$G$O!$A*Br%j%9%HFb$N$$$:$l$N(B&content-particle;$B$b(B$BMWAGFbMF(B$B$NCf$K8=$l$F$h$$!#Ns%j%9%H$K8=$l$k(B&content-particle;$B$O!$%j%9%H$G;XDj$9$k=gHV$N$H$*$j$K!$(B$BMWAGFbMF(B$B$K8=$l$J$1$l$P$J$i$J$$!#L>A0Kt$O%j%9%H$N8e$K=P8=$9$k%*%W%7%g%s$NJ8;z(B$B$O!$%j%9%HFb$NMWAGKt$O(B&content-particle;$B$,!$(B1$B2s0J>eG$0U$N2s?t(B(+)$B!$(B0$B2s0J>eG$0U$N2s?t(B(*)$BKt$O(B0$B2s?)$B=P8=2DG=$J$3$H$r5,Dj$9$k!#$3$3$G<($99=J85Z$S0UL#$O!$$3$N(B&TR-or-Rec;$B$K$*$1$k@8@.5,B'$GMQ$$$k$b$N$HF10l$H$9$k!#(B

$BMWAG$NFbMF$,FbMF%b%G%k$K(B&match;$B$9$k$N$O!$Ns!$A*Br5Z$S7+JV$71i;;;R$K$7$?$,$C$F!$FbMF$NCf$NMWAG$HFbMF%b%G%kFb$NMWAG7?$H$r(B&match;$B$5$;$J$,$i!$FbMF%b%G%kFb$N0l$D$N%Q%9$r$?$I$l$k$H$-$K8B$k!#(B$B8_49@-$N$?$a(B$B!$J8=qFb$NMWAG$,!$FbMF%b%G%k$K$*$1$kMWAG7?$NJ#?t$N=P8=0LCV$H(B&match;$B$9$k$3$H$O!$(B&error;$B$H$9$k!#>\:Y$J5,Dj$K$D$$$F$O!$ImB0=q$N(B$B7hDjE*FbMF%b%G%k(B$B$N9`$r;2>H!#(B

$B%0%k!<%W5Z$S%Q%i%a%?

$B%Q%i%a%?&replacement-text;$B$O!$(B&parenthesis;$B$G0O$^$l$?%0%k!<%W$K$h$C$F!$87L)$JF~$l;R$r9=@.$7$J$1$l$P$J$i$J$$!#$D$^$j!$(B$BA*Br(B$B!$(B$BNs(B$BKt$O(B$B:.:_(B$BItIJ$K!$(B&left-parenthesis;$BKt$O(B&right-parenthesis;$B$N$$$:$l$+0lJ}$,(B$B%Q%i%a%?$B$N(B&replacement-text;$B$K4^$l$l$P!$B>J}$bF1$8(B&replacement-text;$B$K4^$^$l$J$1$l$P$J$i$J$$!#(B

$BAj8_1?MQ@-$N$?$a(B$B!$%Q%i%a%?H$,(B$BA*Br(B$B!$(B$BNs(B$BKt$O(B$B:.:_(B$BFbMF$K4^$^$l$l$P!$$=$N(B&replacement-text;$B$O6u$G$J$$$3$H$,K>$^$7$/!$(B&replacement-text;$B$N@hF,5Z$SKvHx$N6uGr$G$J$$J8;z$O!$%3%M%/%?(B(|$BKt$O(B,)$B$G$J$$J}$,$h$$!#(B

$BMWAGFbMF%b%G%k$N$$$/$D$+$NNc$r!$<!ELEMENT spec (front, body, back?)> <!ELEMENT div1 (head, (p | list | note)*, div2*)> <!ELEMENT dictionary-body (%div.mix; | %dict.mix;)*>

 &mixed-content;

$B$"$kMWAG7?$NMWAGFb$K!$(B$B;R(B$BMWAG$K:.:_$7$FJ8;z%G!<%?$,4^$^$l$k2DG=@-$,$"$k$H$-!$$=$NMWAG(B$B7?(B$B$O!$(B&mixed-content;$B$r$b$D$H$$$&!#(B$B$3$N>l9g!$;RMWAG$N7?$K$D$$$F$N@)Ls$,B8:_$7$F$b$h$$(B$B$,!$;RMWAG$N=g=xKt$O=P8=2s?t$K$D$$$F$N@)Ls$O$J$$$H$9$k!#(B &mixed-content;$B@k8@(B Mixed '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' | '(' S? '#PCDATA' S? ')' $B$3$3$G!$(BName$B$O!$;R$H$7$F=P8=$7$F$b$h$$MWAG$N7?$r<($9!#(B

$BMWAG7?$N=EJ#$N6X;_(B

$B0l$D$N(B&mixed-content;$B@k8@Fb$K!$F1$8L>A0$,J#?t2s=P8=$7$F$O$J$i$J$$!#(B

&mixed-content;$B@k8@$NNc$r!$<!ELEMENT p (#PCDATA|a|ul|b|i|em)*> <!ELEMENT p (#PCDATA | %font; | %phrase; | %special; | %form;)* > <!ELEMENT b (#PCDATA)>

 $BB0@-%j%9%H@k8@(B

$BB0@-(B$B$O!$L>A05Z$SCM$NBP$r(B$BMWAG(B$B$K4XO"IU$1$k$?$a$KMQ$$$k!#B0@-;XDj$O!$(B$B3+;O%?%0(B$BKt$O(B$B6uMWAG(B$B%?%0Fb$G$@$12DG=$H$9$k!#$7$?$,$C$F!$B0@-$rG'<1$9$k$?$a$N@8@.5,B'$O!$(B$B3+;O%?%0(B$B$K$D$$$F$N5,Dj$G<($9!#B0@-%j%9%H@k8@$O!$

a) $B$"$kMWAG7?$KE,MQ$9$kB0@-$N=89g$r5,Dj$9$k!#(B

b) $BB0@-$X$N7?@)Ls$r@_Dj$9$k!#(B

c) $BB0@-$N(B&default-value;$B$r5,Dj$9$k!#(B

$BB0@-%j%9%H@k8@(B$B$O!$$"$kMWAG7?$H4XO"IU$1$i$l$?3FB0@-$KBP$7!$L>A0!$%G!<%?7?5Z$S(B($BB8:_$9$l$P(B)&default-value;$B$r5,Dj$9$k!#(B $BB0@-%j%9%H@k8@(B AttlistDecl '<!ATTLIST' S Name AttDef* S? '>' AttDef S Name S AttType S Default AttlistDecl$B5,B'$KB8:_$9$k(BName$B$O!$MWAG7?$NL>A0$H$9$k!#(B&at-user-option;$B!$@k8@$7$F$$$J$$MWAG7?$KBP$7B0@-$r@k8@$7$?$J$i$P!$(BXML&processor;$B$O!$7Y9p$r=P$7$F$b$h$$!#$7$+$7!$$3$l$O(B&error;$B$H$O$7$J$$!#(B AttDef$B5,B'$K$*$1$k(BName$B$O!$B0@-$NL>A0$H$9$k!#(B

$B$"$kMWAG$KBP$7$F!$J#?t$N(BAttlistDecl$B$rM?$($k>l9g!$$3$l$i$9$Y$F$NFbMF$O%^!<%8$9$k!#$"$kMWAG7?$NF1$8B0@-$K!$J#?t$NDj5A$rM?$($k>l9g$K$O!$:G=i$N@k8@$rM-8z$H$7!$B>$N@k8@$OL5;k$9$k!#(B$BAj8_1?MQ@-$N$?$a$K(B$B!$(BDTD$B$N:n@.$K$O9b!90l$D$NB0@-Dj5A$7$+M?$($J$$!$5Z$S$9$Y$F$NB0@-%j%9%H@k8@$K$O>/$J$/$H$b0l$D$NB0@-Dj5A$rM?$($k!$$H$$$&A*Br$r$7$F$b$h$$!#Aj8_1?MQ@-$N$?$a$K!$(BXML&processor;$B$O!$(B&at-user-option;$B!$$"$kMWAG7?$KJ#?t$NB0@-%j%9%H@k8@$rM?$($?$j!$$"$kB0@-$KJ#?t$NB0@-Dj5A$rM?$($?$j$7$?$H$-$K!$7Y9p$r=P$7$F$b$h$$!#$7$+$7!$$3$l$O!$(B&error;$B$H$O$7$J$$!#(B

$BB0@-$N7?(B

XML$B$NB0@-$N7?$O!$#3 Attribute Types AttType StringType | TokenizedType | EnumeratedType StringType 'CDATA' TokenizedType 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'

ID

$B$3$N7?$NCM$O!$@8@.5,B'(BName$B$K(B&match;$B$7$J$1$l$P$J$i$J$$!#0l$D$N(BXML$BJ8=qFb$G$O!$0l$D$NL>A0$,!$$3$N7?$NCM$H$7$FJ#?t2s8=$l$F$O$J$i$J$$!#$D$^$j!$(BID$B$NCM$O!$MWAG$r0l0U$K(B&identify;$B$7$J$1$l$P$J$i$J$$!#(B

1$BMWAG$4$H$K(B1ID

$BMWAG7?$O!$J#?t$N(BID$BB0@-CM$r$b$C$F$O$J$i$J$$!#(B

ID$BB0@-$N(B&default;

ID$BB0@-$O!$(B&default;$B$H$7$F!$(B#IMPLIED$BKt$O(B#REQUIRED$B$r@k8@$7$J$1$l$P$J$i$J$$!#(B

IDREF

IDREF$B7?$NCM$O!$@8@.5,B'(BName$B$K(B&match;$B$7$J$1$l$P$J$i$J$$!#(BIDREFS$B7?$NCM$O!$@8@.5,B'(BNames$B$K(B&match;$B$7$J$1$l$P$J$i$J$$!#3F!9$N(BName$B$O!$(BXML$BJ8=qFb$KB8:_$9$kMWAG$N(BID$BB0@-$NCM$H(B&match;$B$7$J$1$l$P$J$i$J$$!#$D$^$j!$(BIDREF$B$NCM$O!$$"$k(BID$BB0@-$NCM$H(B&match;$B$7$J$1$l$P$J$i$J$$!#(B

$B(B

ENTITY$B7?$NCM$O!$@8@.5,B'(BName$B$K(B&match;$B$7$J$1$l$P$J$i$J$$!#(BENTITIES$B7?$NCM$O!$@8@.5,B'(BNames$B$K(B&match;$B$7$J$1$l$P$J$i$J$$!#3F!9$N(BName$B$O!$(BDTD$B$G@k8@$9$k(B&unparsed-entity;$B$H(B&match;$B$7$J$1$l$P$J$i$J$$!#(B

$BL>A0(B&token;

NMTOKEN$B7?$NCM$O!$Hs=*C<5-9f(BNmtoken$B$H(B&match;$B$9$k(B&string;$B$+$i9=@.$5$l$J$1$l$P$J$i$J$$!#(BNMTOKENS$B7?$NCM$O!$Hs=*C<5-9f(BNmtokens$B$H(B&match;$B$9$k(B&string;$B$+$i9=@.$5$l$J$1$l$P$J$i$J$$!#(B

XML&processor;$B$O!$(B&application;$B$KB0@-CM$rEO$9A0$K!$(B$BB0@-CM$N@55,2=(B$B$G5,Dj$9$k$H$*$j$K!$B0@-CM$r@55,2=$7$J$1$l$P$J$i$J$$!#(B

$BNs5s7?$NB0@-(B$B$O!$@k8@$7$?CM$N0l$D$r$BNs5s7?$K$O!$(B2$B $BNs5sB0@-$N7?(B EnumeratedType NotationType | Enumeration NotationType 'NOTATION' S '(' S? Name (S? '|' Name)* S? ')' Enumeration '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'

$B5-K!B0@-(B

$B$3$N7?$NCM$O!$@k8@$7$F$$$k(B$B5-K!(B$B$NL>A0$N0l$D$H(B&match;$B$7$J$1$l$P$J$i$J$$!#$D$^$j!$@k8@$KB8:_$9$k5-K!L>$O!$$9$Y$F@k8@$5$l$F$$$J$1$l$P$J$i$J$$!#(B

$BNs5s(B

$B$3$N7?$NCM$O!$@k8@$KB8:_$9$k(BNmtoken&token;$B$N0l$D$H(B&match;$B$7$J$1$l$P$J$i$J$$!#(B

$BAj8_1?MQ@-$N$?$a(B$B!$F1$8(BNmtoken$B$O!$C10lMWAG7?$NNs5s7?$NB0@-$H$7$F!$J#?t2s8=$l$J$$J}$,$h$$!#(B

$BB0@-$N(B&default;

$BB0@-@k8@(B$B$O!$B0@-$N;XDj$,I,?\$+$I$&$+$K$D$$$F$N>pJs$rM?$($k!#I,?\$G$J$$>l9g$K$O!$J8=qFb$GB0@-$r;XDj$7$J$$$H$-!$(BXML&processor;$B$N=hM}J}K!$N>pJs$bM?$($k!#(B $BB0@-$N(B&default; Default '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)

$BB0@-(B&default;$B$N@5$7$5(B

$B@k8@$7$?(B&default-value;$B$O!$@k8@$7$?B0@-7?$N;z6g@)Ls$rK~$?$5$J$1$l$P$J$i$J$$!#(B

#REQUIRED$B$r;XDj$7$?$H$-!$$3$NMWAG7?$N(B$B3+;O%?%0(B$B$G$"$C$F!$$3$NB0@-$KCM$rM?$($J$$$b$N$r(BXML&processor;$B$,8+$D$1$?$J$i$P!$$=$NJ8=q$O(B&valid;$B$H$O$7$J$$!#(B#IMPLIED$B$r;XDj$7$?$H$-!$$3$NB0@-$r>JN,$7$?$i!$(BXML&processor;$B$O!$B0@-CM$r;XDj$7$J$$$3$H$r%"%W%j%1!<%7%g%s$KEA$($J$1$l$P$J$i$J$$!#$3$N$H$-!$(B&application;$B$N?6Iq$$$K$D$$$F$N@)Ls$O$J$$!#(B

$BB0@-$,(B#REQUIRED$B$G$b(B#IMPLIED$B$G$b$J$$$H$-$K$O!$(BAttValue$B$NCM$,!$(B&default-value;$B$H$J$k!#(B#FIXED$B$N>l9g!$(B&default-value;$B$H0[$J$kCM$,;XDj$5$l$l$P!$$=$NJ8=q$O!$(B&valid;$B$H$7$J$$!#(B&default-value;$B$r@k8@$7$F$$$k>l9g!$$3$NB0@-$N>JN,$r8+$D$1$?$i!$@k8@$7$?(B&default-value;$B$rB0@-CM$K;XDj$7$F$$$k$H$7$F!$(BXML&processor;$B$O?6$kIq$&$3$H$,K>$^$7$$!#(B

$BB0@-%j%9%H@k8@$NNc$r!$<!ATTLIST termdef id ID #REQUIRED name CDATA #IMPLIED> <!ATTLIST list type (bullets|ordered|glossary) "ordered"> <!ATTLIST form method CDATA #FIXED "POST">

 $BB0@-CM$N@55,2=(B

XML&processor;$B$O!$B0@-CM$r(B&application;$B$KEO$9A0$K!$

a) $B$^$:!$B0@-CM5Z$S$=$NCf$N$B9TKv$N07$$(B$B!W$b;2>H$N$3$H!#(B)$B!#(B

b) $BH5Z$SFbIt(B&parsed-entity;$B$X$N;2>H$O!$E83+$7$J$1$l$P$J$i$J$$!#30ItH$O!$(B&error;$B$H$9$k!#(B

c) $B:G8e$K!$B0@-$N7?$,(BCDATA$B$G$J$1$l$P!$6uGr(B&string;$B$O!$$9$Y$F(B&space-character;(#x20)$B0l$D$K@55,2=$7!$;D$j$N6uGrJ8;z$O!$:o=|$7$J$1$l$P$J$i$J$$!#(B

&non-validating;&parser;$B$O!$@k8@$,8+$D$+$i$J$$B0@-$O!$$9$Y$F!$(BCDATA$B$r@k8@$7$F$$$k$H$7$F07$&$3$H$,K>$^$7$$!#(B

 $B>r7oIU$-%;%/%7%g%s(B

$B>r7oIU$-%;%/%7%g%s(B$B$H$O!$(B$BJ8=q7?@k8@$N30It(B⊂$B$N0lIt$H$7!$@)8f%-!<%o!<%I$N;XDj$K$h$C$F!$(BDTD$B$NO@M}9=B$$K4^$a$?$j!$=|$$$?$j$9$kItJ,$H$9$k!#(B $B>r7oIU$-%;%/%7%g%s(B conditionalSect includeSect | ignoreSect includeSect '<![' S? 'INCLUDE' S? '[' extSubset ']]>' ignoreSect '<![' S? 'IGNORE' S? '[' ignoreSectContents* ']]>' ignoreSectContents Ignore ('<![' ignoreSectContents ']]>' Ignore)* Ignore Char* - (Char* ('<![' | ']]>') Char*)

$B>r7oIU$-%;%/%7%g%s$O!$(BDTD$B$NFbIt(B⊂$B5Z$S30It(B⊂$B$HF1MM$K!$40A4$J@k8@!$%3%a%s%HKt$OF~$l;R$K$J$C$?>r7oIU$-%;%/%7%g%s$r!$$$$/$D$+4^$s$G$h$$!#$3$l$i$N4V$K!$6uGr$,8=$l$F$b$h$$!#(B

$B>r7oIU$-%;%/%7%g%s$N%-!<%o!<%I$,(BINCLUDE$B$J$i$P!$(BXML&processor;$B$O!$$3$N>r7oIU$-%;%/%7%g%s$NFbMF$r!$J8=q$N0lIt$H$7$F07$o$J$1$l$P$J$i$J$$!#>r7oIU$-%;%/%7%g%s$N%-!<%o!<%I$,(BIGNORE$B$J$i$P!$$=$N>r7oIU$-%;%/%7%g%s$NFbMF$O!$J8=q$N0lIt$H$7$F07$o$J$$!#9=J82r@O$r@5$7$/9T$&$?$a$K$O!$L5;k$9$k>r7oIU$-%;%/%7%g%s(B(IGNORE)$B$K4X$7$F$b!$FbMF$rFI$^$J$1$l$P$J$i$J$$$3$H$KCm0U$9$k$3$H!#$3$l$O!$F~$l;R$K$J$C$?>r7oIU$-%;%/%7%g%s$r8+$D$1!$(B($BL5;k$9$k(B)$B:G$b30B&$N>r7oIU$-%;%/%7%g%s$r@5$7$/8!=P$9$k$?$a$H$9$k!#%-!<%o!<%I$r(BINCLUDE$B$H$9$k>.$5$J>r7oIU$-%;%/%7%g%s$,!$%-!<%o!<%I$r(BIGNORE$B$H$9$k$h$jBg$-$J>r7oIU$-%;%/%7%g%s$K4^$^$l$k$J$i$P!$30B&5Z$SFbB&$N>r7oIU$-%;%/%7%g%s$NN>J}$H$bL5;k$9$k!#(B

$B>r7oIU$-%;%/%7%g%s$N%-!<%o!<%I$,%Q%i%a%?H$J$i$P!$(BXML&processor;$B$O>r7oIU$-%;%/%7%g%s$N07$$$rH=CG$9$kA0$K!$$3$N%Q%i%a%?

$BNc$r<!ENTITY % draft 'INCLUDE' > <!ENTITY % final 'IGNORE' > <![%draft;[ <!ELEMENT book (comments*, title, body, supplements?)> ]]> <![%final;[ <!ELEMENT book (title, body, supplements?)> ]]>

$BJ*M}9=B$(B

XML$BJ8=q$O!$0l$D0J>e$N5-21C10L$+$i9=@.$9$k!#$3$N5-21C10L$r!$(B$B$B$H$$$&!#$BFbMF(B$B$r$b$A!$J8=qH(B)$B5Z$S(B$B30It(BDTD⊂$B$r=|$$$F!$(B$BL>A0(B$B$G(B&identified;$B!#(B $B3F(BXML$BJ8=q$O!$(B$BJ8=q$B$H8F$VXML&processor;$B$O!$$3$NJ8=q

$B&parsed-entity;$B$NFbMF$O!$(B&parsed-entity;$B$N(B&replacement-text;$B$H8F$V!#$3$N(B$B%F%-%9%H(B$B$O!$J8=q$NK\BN$N0lIt$H$7$F2r

&unparsed-entity;$B$O!$FbMF$,(B$B%F%-%9%H(B$B$G$b$=$&$G$J$/$H$b$h$$%j%=!<%9$H$9$k!#%F%-%9%H$N>l9g!$(BXML$B$G$J$/$H$b$h$$!#3F(B&unparsed-entity;$B$K$O!$(B$B5-K!(B$B$,4XO"IU$1$i$l!$$3$N5-K!$O!$L>A0$G(B&identified;$B!#5-K!$NL>A05Z$S4XO"IU$1$i$l$?(B&identifier;$B$r!$(BXML&processor;$B$,(B&application;$B$KEO$9$H$$$&MW7o0J30$O!$(BXML$B$O!$(B&unparsed-entity;$B$NFbMF$r@)8B$7$J$$!#(B

&parsed-entity;$B$O!$H$K$h$C$FL>A0$G8F$S=P$9!#(B&unparsed-entity;$B$O!$(BENTITY$B7?Kt$O(BENTITIES$B7?$NB0@-$NCM$H$7$F!$L>A0$G;2>H$9$k!#(B

$B0lHL$B$O!$J8=qFbMF$NCf$G;HMQ$9$k(B&parsed-entity;$B$H$9$k!#$"$$$^$$$K$J$i$J$$8B$j!$$3$N(B&TR-or-Rec;$B$G$O!$0lHL$B$B$H8F$V!#(B$B%Q%i%a%?$B$3$l$i$N#2H$7!$0[$J$kJ8L.$GG'<1$9$k!#(B

$BJ8;z;2>H5Z$SH(B

$BJ8;z;2>H(B$B$O!$(BISO/IEC 10646$BJ8;z=89g$NFCDj$NJ8;z!$Nc$($P!$F~NO5!4o$+$iD>@\F~NOIT2DG=$JJ8;z$r;2>H$9$k!#(B $BJ8;z;2>H(B CharRef '&#' [0-9]+ ';' | '&hcro;' [0-9a-fA-F]+ ';' $B@5Ev$JJ8;z(B

$BJ8;z;2>H$G;2>H$9$kJ8;z$O!$Hs=*C<5-9f(BChar$B$K=>$o$J$1$l$P$J$i$J$$!#(B

$BJ8;z$,(B "&#x" $B$G;O$^$l$P!$=*C<$N(B ";" $B$^$G$N?t;z5Z$S%"%k%U%!%Y%C%H$O!$(BISO/IEC 10646 $B$NJ8;z%3!<%I$N(B16$B?J?tI=8=$H$9$k!#(B $BJ8;z$,(B "&#" $B$G;O$^$l$P!$=*C<$N(B ";" $B$^$G$N?t;z$O!$J8;z%3!<%I$N(B10$B?J?tI=8=$H$9$k!#(B

$BH(B$B$O!$L>A0$NIU$$$?H$9$k!#(B$B0lHLH$O!$%"%s%Q%5%s%I(B(&)$B5Z$S%;%_%3%m%s(B(;)$B$r6h@Z$j;R$H$7$FMQ$$$k!#(B$B%Q%i%a%?$B$X$N;2>H$O!$%Q!<%;%s%H5-9f(B(%)$B5Z$S%;%_%3%m%s(B(;)$B$r6h@Z$j;R$H$7$FMQ$$$k!#(B

$BH(B Reference EntityRef | CharRef EntityRef '&' Name ';' PEReference '%' Name ';' $B

DTD$B$r$b$?$J$$J8=q!$%Q%i%a%?H$r4^$^$J$$FbIt(BDTD⊂$B$@$1$r$b$DJ8=q!$Kt$O(B "standalone='yes'" $B$r$b$DJ8=q$K$*$$$F!$H$GMQ$$$k(B Name $B$O!$$=$NA0$H!$(B&match;$B$7$J$1$l$P$J$i$J$$!#$?$@$7!$(B&well-formed;$B$NJ8=q$O!$l9g$O!$@k8@$O!$;2>H$K@h9T$7$J$1$l$P$J$i$J$$!#F1MM$K!$0lHLl9g$O!$B0@-%j%9%H@k8@$N(B&default-value;$BFb$G$N;2>H$h$j@h$K!$@k8@$,8=$l$J$1$l$P$J$i$J$$!#(B

$B30It(B⊂$BKt$O30It%Q%i%a%?$B5AL3$E$1$J$$(B$B!#$=$l$i$NJ8=q$G$O!$ $B

$B30It(B⊂$BKt$O30It%Q%i%a%?standalone='no'"$B$r$b$DJ8=q$K$*$$$F!$H$GMQ$$$k(B Name $B$O!$$=$NA0$H(B&match;$B$7$J$1$l$P$J$i$J$$!#Aj8_1?MQ@-$N$?$a!$(B&valid;$B$JJ8=q$O(B$B$"$i$+$8$aDj5A$7$?$B$G;XDj$7$?=q<0$K$h$C$F!$$^$7$$!#%Q%i%a%?l9g$O!$@k8@$O!$;2>H$K@h9T$7$J$1$l$P$J$i$J$$!#F1MM$K!$0lHLl9g$O!$B0@-%j%9%H@k8@$N(B&default-value;$BFb$G$N;2>H$h$j$b@h$K!$@k8@$,8=$l$J$1$l$P$J$i$J$$!#(B

&parsed-entity;

$BH$O!$(B&unparsed-entity;$B$NL>A0$r4^$s$G$$$F$O$J$i$J$$!#(B&unparsed-entity;$B$O!$(BENTITY$B7?Kt$O(BENTITIES $B7?$H$7$F@k8@$7$?(B$BB0@-CM(B$B$H$7$F$@$1;2>H$G$-$k!#(B

$B:F5"$J$7(B

&parsed-entity;$B$O!$$=$l<+BN$X$N;2>H$r!$D>@\$K$b4V@\$K$b4^$s$G$O$J$i$J$$!#(B

 DTD$B$NCf(B

$B%Q%i%a%?H$O!$(BDTD$BFb$K$@$1!$=P8=$7$F$h$$!#(B

$BJ8;z;2>H5Z$SH$NNc$r!$Type <key>less-than</key> (&hcro;3C;) to save options. This document was prepared on &docdate; and is classified &security-level;.

$B%Q%i%a%?H$NNc$r!$<!ENTITY % ISOLat2 SYSTEM "http://www.xml.com/iso/isolat2-xml.entities" > %ISOLat2;

$B

$B $B EntityDecl GEDecl$B0lHL | PEDecl$B%Q%i%a%? GEDecl '<!ENTITY' S Name S EntityDef S? '>' PEDecl | '<!ENTITY' S '%' S Name S PEDef S? '>' $B%Q%i%a%? EntityDef EntityValue | ExternalDef PEDef EntityValue | ExternalID Name $B$O!$(B$BH(B$B$K$*$$$FENTITY $B7?Kt$O(BENTITIES$B7?$NB0@-CMFb$G!$e@k8@$5$l$l$P!$:G=i$N@k8@$rMQ$$$k!#(B&at-user-option;$B!$J#?t2s@k8@$5$l$k

$BFbIt

$BEntityValue$B$N$H$-!$$3$l$r(B$BFbIt$B$H$$$&!#$3$l$O!$JL8D$NJ*M}E*5-21C10L$r$b$?$:!$$B@5$7$/(B&replacement-text;$B$r@8@.$9$k$K$O!$(B&literal;$B$BFb$G$NH5Z$SJ8;z;2>H$N=hM}$,!$I,MW$H$J$k$+$b$7$l$J$$$3$H$KCm0U$9$k!#>\:Y$O!$(B$BFbIt$B$r;2>H!#(B

$BFbIt&parsed-entity;$B$H$9$k!#(B

$BFbIt<!ENTITY Pub-Status "This is a pre-release of the specification.">

 $B30It

$B$B30It$B$H$7!$ $B30It ExternalDef ExternalID NDataDecl? ExternalID 'SYSTEM' S SystemLiteral | 'PUBLIC' S PubidLiteral S SystemLiteral NDataDecl S 'NDATA' S Name NDataDecl $B$,B8:_$9$l$P!$$3$N&unparsed-entity;$B$H$7!$$=$&$G$J$1$l$P!$(B&parsed-entity;$B$H$9$k!#(B

$B5-K!$,@k8@$5$l$F$$$k$3$H(B

Name $B$O!$@k8@$7$?(B$B5-K!(B$B$NL>A0$H(B&match;$B$7$J$1$l$P$J$i$J$$!#(B

$B%-!<%o!<%I(B SYSTEM $B$N8e$N(B SystemLiteral $B$r!$$B%7%9%F%`(B&identifier;$B$H8F$V!#$3$l$O(BURI$B$H$7!$$=$NURI$B$H6&$K;H$&$3$H$NB?$$%O%C%7%e(B("#")$B5Z$S%U%i%0%a%s%H(B&identifier;$B$O!$@5<0$K$O!$(BURI$B<+BN$N0lIt$H$O$7$J$$!#%U%i%0%a%s%H(B&identifier;$B$,!$%7%9%F%`(B&identifier;$B$NItJ,$H$7$FM?$($i$l$F$$$k>l9g!$(BXML&processor;$B$O!$(B&error;$B$r=P$7$F$b$h$$!#$3$N(B&TR-or-Rec;$B$NHO0O30$N>pJs(B($BNc$($P!$$"$kFCDj$N(BDTD$B$NFCJL$J(BXML$BMWAGKt$OFCDj$N(B&application;$B$N;EMM$K$h$C$FDj5A$5$l$?=hM}L?Na(B)$B$K$h$C$F>e=q$-$5$l$J$$8B$j!$AjBPE*$J(BURI$B$O!$$=$N

$B%7%9%F%`(B&identifier;$B0J30$K!$30It$B8x3+(B&identifier;$B$r4^$s$G$b$h$$!#(B $Bl9g$O!$%7%9%F%`(B&literal;$B$H$7$F;XDj$7$?(BURI$B$rMQ$$$J$1$l$P$J$i$J$$!#(B&match;$B$9$kA0$K!$8x3+(B&identifier;$BFb$K$"$k6uGrJ8;z$+$i$J$k(B&string;$B$O!$$9$Y$FC10l$N(B&space-character;(#x20)$B$K@55,2=$7$J$1$l$P$J$i$:!$A08e$N6uGrJ8;z$O:o=|$7$J$1$l$P$J$i$J$$!#(B

$B30It<!ENTITY open-hatch SYSTEM "http://www.textuality.com/boilerplate/OpenHatch.xml"> <!ENTITY open-hatch PUBLIC "-//Textuality//TEXT Standard open-hatch boilerplate//EN" "http://www.textuality.com/boilerplate/OpenHatch.xml"> <!ENTITY hatch-pic SYSTEM "../grafix/OpenHatch.gif" NDATA gif >

 &parsed-entity; $B%F%-%9%H@k8@(B

$B30It(B&parsed-entity;$B$O!$(B$B%F%-%9%H@k8@(B$B$G;O$^$C$F$b$h$$!#(B $B%F%-%9%H@k8@(B TextDecl &xmlpio; VersionInfo? EncodingDecl S? &pic;

$B%F%-%9%H@k8@$O!$$=$N$^$^$N7A$G8=$l$J$1$l$P$J$i$:!$(B&parsed-entity;$B$X$N;2>H$r7PM3$7$F$O$J$i$J$$$3$H$KCm0U$9$k!#(B

$B30It(B&parsed-entity;$B$K$*$$$F!$%F%-%9%H@k8@$O!$@hF,0J30$N$$$+$J$k0LCV$K$b=P8=$7$J$$!#(B

 &well-formed;$B$N(B&parsed-entity;

$B%i%Y%k(Bdocument$B$r$b$D@8@.5,B'$K(B&match;$B$9$l$P!$J8=qExtParsedEnt$B$r$b$D@8@.5,B'$K(B&match;$B$9$l$P!$30It$N0lHL(B&parsed-entity;$B$O!$(B&well-formed;$B$H$9$k!#%i%Y%k(BExtPE$B$r$b$D@8@.5,B'$K(B&match;$B$9$l$P!$30It%Q%i%a%? &well-formed;$B$N(B&parsed-entity; ExtParsedEnt TextDecl? content ExtPE TextDecl? extSubset &replacement-text;$B$,!$%i%Y%k(Bcontent$B$r$b$D@8@.5,B'$K(B&match;$B$9$l$P!$FbIt$N0lHL(B&parsed-entity;$B$O!$(B&well-formed;$B$H$9$k!#(BDTD$B$r:G8e$^$GFI$_9~$^$J$$$H!$3N

$B$B3+;O%?%0(B$B!$(B$B=*N;%?%0(B$B!$(B$B6uMWAG%?%0(B$B!$(B$BMWAG(B$B!$(B$B%3%a%s%H(B$B!$(B$B=hM}L?Na(B$B!$(B$BJ8;z;2>H(B$B5Z$S(B$BH(B$B$,!$0l$D$N $B

XML$BJ8=qFb$N30It(B&parsed-entity;$B$O!$3F!9!$JL$NJ8;zId9f2=J}<0$rMQ$$$F$b$h$$!#$9$Y$F$N(BXML&processor;$B$O!$(BUTF-8$B$GId9f2=$7$?

UTF-16$B$GId9f2=$7$?

XML&processor;$B$O!$(BUTF-8$B5Z$S(BUTF-16$B$GId9f2=$7$?$NId9f2=$r@$3&$G$OMQ$$$F$*$j!$$=$l$i$NId9f2=$rMQ$$$k$^$7$$!#(BUTF-8$BKt$O(BUTF-16$B0J30$NId9f2=J}<0$rMQ$$$F3JG<$9$k(B&parsed-entity;$B$O!$Id9f2=@k8@$r4^$`(B$B%F%-%9%H@k8@(B$B$G;O$a$J$1$l$P$J$i$J$$!#(B $BId9f2=@k8@(B EncodingDecl S 'encoding' Eq '"' EncName '"' | "'" EncName "'" EncName [A-Za-z] ([A-Za-z0-9._] | '-')* $B%i%F%sJ8;z$@$1$r4^$`Id9f2=L>(B $BJ8=q$B$G$O!$Id9f2=@k8@$O!$(BXML$B@k8@(B$B$N0lIt$H$9$k!#(BEncName$B$O!$;HMQ$9$kId9f2=J}<0$NL>A0$H$9$k!#(B

$BId9f2=@k8@$G$O!$CM(BUTF-8$B!$(BUTF-16$B!$(BISO-10646-UCS-2$B5Z$S(BISO-10646-UCS-4$B$O!$(BUnicode$B5Z$S(BISO/IEC 10646$B$N3FISO-8859-1$B$+$i(BISO-8859-9$B$^$G$O!$(BISO 8859$B$NBP1~$9$k%Q!<%H$N$?$a$KMQ$$$k!#CM(BISO-2022-JP$B!$(BShift_JIS$B5Z$S(BEUC-JP$B$O!$(BJIS X-0208-1997$B$N3Fcharsets$B$H$7$F(B)$BEPO?$5$l$?J8;zId9f2=J}<0$K$D$$$F$O!$$3$l$i0J30$K$D$$$F$b!$EPO?$5$l$?L>A0$G;2>H$9$k$3$H$,K>$^$7$$!#$3$l$i$NEPO?$5$l$?L>A0$O!$BgJ8;z!&>.J8;z$N6hJL$r$;$:$KDj5A$5$l$F$$$k$N$G!$$3$l$i$KBP$9$kHf3S$r;n$_$k(B&processor;$B$O!$BgJ8;z!&>.J8;z$N6hJL$r$7$J$$J}K!$r$H$k$N$,K>$^$7$$$3$H$KCm0U$9$k!#(B

XML$B=hM}7O$KEO$5$l$?&error;$B$H$9$k!#(B

&byte-order-mark;$B$G$bId9f2=@k8@$G$b;O$^$i$J$$

$B=hM}$G$-$J$$Id9f2=$r$b$C$?&fatal-error;$B$H$7$F!$=hM}$r=*N;$7$J$1$l$P$J$i$J$$!#(B

$BId9f2=@k8@$NNc$r!$<?xml encoding='UTF-8'?> <?xml encoding='EUC-JP'?>

 XML&processor;$B$K$h$kH$N07$$(B

$BH!$H5Z$S(B&unparsed-entity;$B$N8F=P$7$,8=$l$kJ8L.5Z$S3F!9$N>l9g$K$*$1$k(BXML&processor;$B$KMW5a$9$k?6Iq$$$rMWLs$9$k!#0lHV:8$NNs$N%i%Y%k$O!$G'<1$NJ8L.$r<($9!#(B

$BMWAG$N(B$B3+;O%?%0(B$B5Z$S(B$B=*N;%?%0(B$B$N4V$NG$0U$N>l=j$G$N;2>H!#Hs=*C<5-9f(Bcontent$B$KBP1~$9$k!#(B

$B3+;O%?%0(B$B$NB0@-$NCM!$Kt$O(B$BB0@-@k8@(B$B$K$*$1$k(B&default-value;$B$N$$$:$l$+$G$N;2>H!#Hs=*C<5-9f(BAttValue$B$KBP1~$9$k!#(B

$B;2>H$G$O$J$/!$(BName$B$H$7$F=P8=!#(BENTITY$B7?$H$7$F@k8@$7$?B0@-$NCM!$Kt$O(BENTITIES$B7?$H$7$F@k8@$7$?B0@-$NCM$K$*$1$k(B&space;$B$G6h@Z$k(B&token;$B$N0l$D$H$7$F=P8=$9$k!#(B

$B&literal;$B$BFb$N;2>H!#Hs=*C<5-9f(BEntityValue$B$KBP1~$9$k!#(B

DTD$B$NFbIt(B⊂$BKt$O30It(B⊂$B$G$N;2>H!#$?$@$7!$(BEntityValue$BKt$O(BAttValue$B$N30B&$H$9$k!#(B

$B $BJ8;z(B $B%Q%i%a%?(B $BFbIt(B&newline;$B0lHL(B $B30It(B&newline;&parsed-entity;&newline;$B0lHL(B &unparsed-entity; $BFbMF$G$N(B&newline;$B;2>H(B $BG'<1(B&newline;$B$7$J$$(B $B $B8!>Z$N$?$a$K $B6X;_(B $B $BB0@-CM$G$N(B&newline;$B;2>H(B $BG'<1(B&newline;$B$7$J$$(B $B $B6X;_(B $B6X;_(B $B $BB0@-CM$H$7$F(B&newline;$B=P8=(B $BG'<1(B&newline;$B$7$J$$(B $B6X;_(B $B6X;_(B $BDLCN(B $BG'<1(B&newline;$B$7$J$$(B $BH(B $B &bypass; &bypass; $B6X;_(B $B DTD$B$G$N(B&newline;$B;2>H(B PE$B$H$7$F(B&newline;$B $B6X;_(B $B6X;_(B $B6X;_(B $B6X;_(B $B!HG'<1$7$J$$!I(B

DTD$B$N30$G$O!$(B%$BJ8;z$O!$$$$+$J$kFCDj$N0UL#$b!$$b$?$J$$!#$7$?$,$C$F!$(BDTD$B$G$O%Q%i%a%?H$H$7$FG'<1$9$k$b$N$G$"$C$F$b!$(Bcontent$BFb$G$O(B&markup;$B$H$7$F$OG'<1$7$J$$!#F1MM$K!$E,@Z$K@k8@$7$?B0@-$NCM$NCf$K8=$l$k>l9g$r=|$-!$(B&unparsed-entity;$B$NL>A0$O!$G'<1$7$J$$!#(B

$B!H

$B&replacement-text;$B$rH<+BN$NBe$o$j$K!$;2>H$,$"$C$?0LCV$G!$J8=q$N0lIt$H$7$F4^$^$l$k$+$N$h$&$K(B$B$B!#(B&replacement-text;$B$O!$(B$BJ8;z%G!<%?(B$B5Z$S(B($B%Q%i%a%?&markup;$B$N$$$:$l$r4^$s$G$b$h$/!$$3$l$i$O!$DL>o$NJ}K!$GG'<1$5$l$J$1$l$P$J$i$J$$!#$?$@$7!$(B&markup;$B$N6h@Z$j;R$r(B&escape;$B$9$k$?$a$KMQ$$$ko$K%G!<%?$H$7$F07$&(B(&string;"AT&amp;T;"$B$O!$(B"AT&T;"$B$KE83+$5$l!$;D$5$l$?%"%s%Q%5%s%I$O!$H$N6h@Z$j;R$H$7$F$OG'<1$7$J$$!#(B)$B!#J8;z;2>H$O!$<($7$?J8;z$r;2>H<+BN$NBe$o$j$K=hM}$9$k$H$-!$(B$B$B!#(B

$B!H8!>Z$N$?$a$K

$BJ8=q$N(B&validity;$B$r(B$B8!>Z(B$B$9$k$K$O!$(BXML&processor;$B$,(B&parsed-entity;$B$X$N;2>H$rG'<1$7$?$H$-!$$=$N(B&replacement-text;$B$r(B$B$B$J$1$l$P$J$i$J$$!#Z$7$J$1$l$P!$$B$h$$(B$B$,!$$=$&$7$J$/$H$b$h$$!#(B

$B$3$N$N(B&application;($BFC$K!$J8=q$N%V%i%&%:(B)$B$K$O!$I,$:$7$bE,@Z$G$O$J$$!$$H$$$&G'<1$K$h$k!#Nc$($P!$%V%i%&%6$O30It(B&parsed-entity;$B$X$N;2>H$r8+$D$1$k$H!$$=$N $B!H6X;_!I(B

$B&fatal-error;$B$H$9$k!#(B

a) &unparsed-entity;$B$X$N;2>H$N=P8=!#(B

b) DTD$B$N(BEntityValue$BKt$O(BAttValue$B0J30$NItJ,$K$*$1$k!$J8;z;2>HKt$O0lHLH$N=P8=!#(B

c) $BB0@-CMFb$N30ItH!#(B

$B!HDLCN!I(B

&unparsed-entity;$B$NL>A0$,!$(BENTITY$BKt$O(BENTITIES$B$NB0@-$NCM$K$*$$$F(B&token;$B$H$7$F8=$l$?$H$-!$(B&processor;$B$O!$(B&application;$B$KBP$7$F!$4XO"IU$1$i$l$?(B$B5-K!(B$BL>!$5-K!$KBP$9$k(B$B%7%9%F%`(B&identifier;$B5Z$S(B($BB8:_$9$l$P(B)$B8x3+(B&identifier;$B$rDLCN$7$J$1$l$P$J$i$J$$!#(B

 $B!H(B&bypass;$B!I(B

$B0lHLH$,!$EntityValue$BFb$K8=$l$k$H$-!$$=$l$OL5;k$5$l!$$=$N$^$^;D$k!#(B

 $B!H(BPE$B$H$7$F

$B30It(B&parsed-entity;$B$N>l9g$HF1MM$K!$%Q%i%a%?$B8!>Z$9$k$H$-$@$1$BI,MW$,$"$k!#%Q%i%a%?H$r(BDTD$BFb$KG'<1$7$F&replacement-text;$B$O!$$=$NA08e$K0l$D$N(B&space-character;(#x20)$B$NIU2C$K$h$C$F0z$-?-$P$5$l$k!#$3$N0U?^$O!$%Q%i%a%? $BFbIt

$BFbIt&literal;$B$B$O!$EntityValue$B$K(B&match;$B$9$k!#(B&replacement-text;$B$O!$J8;z;2>H5Z$S(B¶meter;$BH$NCV49$(8e$K$*$1$k!$

$BFbIt(EntityValue)$B$O!$J8;z;2>H!$(B¶meter;$BH5Z$S0lHLH$r4^$s$G$h$$!#$3$l$i$N;2>H$O!$(B&literal;$B$BE83+$9$k(B$BH$9$k(B¶meter;$B&replacement-text;$B$r4^$^$J$1$l$P$J$i$:!$(B&literal;$BH$NBe$o$j$K;2>H$7$?J8;z$r4^$^$J$1$l$P$J$i$J$$!#$7$+$7!$0lHLH$O!$$=$N$^$^;D$7(B, $BE83+$7$F$O$J$i$J$$!#(B $BNc$($P!$ ]]> $Bbook"$B$O!$La Peste: Albert Camus, © 1947 Éditions Gallimard. &rights; $B;2>H(B"&book;"$B$,!$J8=q$NFbMFKt$OB0@-CMFb$K=P8=$7$F$$$l$P!$0lHLH(B"&rights;"$B$O!$E83+$5$l$F$$$k!#(B

$B$3$l$i$NC1=c$J5,B'$O!$J#9gAj8_:nMQ$r$b$D!#(B $BFq$7$$Nc$K$D$$$F$N>\:Y$O!$(B$BH$NE83+$NIUO?(B$B$r;2>H$N$3$H!#(B

$BDj5A:Q$_

$BH5Z$SJ8;z;2>H$N$$$:$l$b!$(B&left-angle-bracket;$B!$%"%s%P%5%s%I5Z$SB>$N6h@Z$j;R$r(B&escape;$B$9$k$?$a$K;HMQ$G$-$k!#$$$/$D$+$N0lHLH$b!$F1MM$NL\E*$N$?$a$K;HMQ$G$-$k!#J8;z;2>H$O!$G'<1$5$l$k$HD>$A$KE83+$5$l!$J8;z%G!<%?$H$7$F07$o$l$k$N$G!$?tCM$K$h$kJ8;z;2>H(B"&#60;"$B5Z$S(B"&#38;"$B$O!$J8;z%G!<%?Fb$K=P8=$9$k(B<$B5Z$S(B&$B$r(B&escape;$B$9$k$?$a$K;HMQ$G$-$k!#(B

$B$9$Y$F$N(BXML&processor;$B$O!$@k8@$5$l$F$$$k$+$I$&$+$K4X78$J$/!$$3$l$i$N$BAj8_1?MQ@-$N$?$a(B$B!$(B&valid;$B$J(BXML$BJ8=q$O!$$3$l$i$N$N$^$7$$!#l9g$O!$(B&replacement-text;$B$r(B&escape;$B$9$k0lJ8;z$H$9$kFbIt ]]> "lt"$B5Z$S(B"amp"$B@k8@Fb$N(B"<"$B5Z$S(B"&"$BJ8;z$O!$ $B5-K!@k8@(B

$B5-K!(B$B$O!$(B&unparsed-entity;$B$N7A<0$r(B&identify;$BL>A0$+!$Kt$O(B$B=hM}L?Na(B$B$NBP>]$H$9$k(B&application;$B$r(B&identify;$BL>A0$H$9$k!#(B

$B5-K!@k8@(B$B$O!$5-K!$NL>A05Z$S30It(B&identifier;$B$rDs6!$9$k!#$3$NL>A0$O!$ $B5-K!@k8@(B NotationDecl '<!NOTATION' S Name S (ExternalID | PublicID) S? '>' PublicID 'PUBLIC' S PubidLiteral

$B@k8@$7!$B0@-CM!$B0@-Dj5AKt$OH$9$k$9$Y$F$N5-K!$K$D$$$F!$(BXML&processor;$B$O!$5-K!$NL>A05Z$S30It(B&identifier;$B$r(B&application;$B$KDs6!$7$J$1$l$P$J$i$J$$!#$5$i$K!$30It(B&identifier;$B$r!$(B$B%7%9%F%`(B&identifier;$B!$%U%!%$%kL>Kt$O$=$NB>$N>pJs$KE83+$7$F$b$h$/!$$3$l$i$rMQ$$$F!$(B&application;$B$O!$$=$N5-K!$N%G!<%?$r=hM}$9$k(B&processor;$B$r5/F0$9$k!#(B($B$7$+$7!$(BXML&processor;$BKt$O(B&application;$B$,F0:n$9$k%7%9%F%`$G$OMxMQ$G$-$J$$5-K!$r!$(BXML$BJ8=q$,@k8@$7;2>H$7$F$b!$$3$l$O!$(B&error;$B$H$O$7$J$$!#!K(B

 $BJ8=q

$BJ8=q$B$O!$XML&processor;$B$,!$=hM}$r3+;O$9$kCOE@$H$9$k!#(B$B$3$N(B&TR-or-Rec;$B$O!$(BXML&processor;$B$,!$J8=ql=j$r$I$N$h$&$K8+$D$1$k$+$O!$5,Dj$7$J$$!#B>$NA0$r$b$?$:!$$$$+$J$k<1JL$b$J$7$K(B&processor;$B$X$NF~NO(B&stream;$B$K=P8=$7$F$b$h$$!#(B

 $BE,9g@-(B

$BE,9g$9$k(BXML&processor;$B$O!$(B&validating;$B$b$N5Z$S(B&non-validating;$B$b$N$N!$Fs$D$KJ,N`$5$l$k!#(B

&validating;$B%7%9%F%`5Z$S(B&non-validating;$B%7%9%F%`$O!$$3$N(B&TR-or-Rec;$B$,5,Dj$9$k(B&well-formed;$B@)Ls$X$N0cH?$rJs9p$7$J$1$l$P$J$i$J$$!#(B

&validating;&processor;$B$O!$(BDTD$BFb$N@k8@$K$h$C$F<($5$l$?!$@)Ls$X$N0cH?$rJs9p$7$J$1$l$P$J$i$J$$!#$5$i$K!$$3$N(B&TR-or-Rec;$B$,5,Dj$9$k(B&validity;$B@)Ls$X$N0cH?$r!$$9$Y$FJs9p$7$J$1$l$P$J$i$J$$!#(B

$B5-K!(B

XML$B$N7A<0E*$JJ8K!$O!$4JC1$J3HD%(BBackus-Naur Form(EBNF)$B5-K!$K$h$C$FM?$($k!#J8K!$N3F5,B'$O!$symbol ::= expression

$B5-9f$O!$@55,I=8=$GDj5A$9$k$H$-$OBgJ8;z$G;O$a!$$=$&$G$J$1$l$P!$>.J8;z$G;O$a$k!#(B&string;&literal;$B$O!$0zMQId$G0O$`!#(B

$B5,B'$N1&B&$N<0Fb$G$O!$0l$DKt$OJ#?t$NJ8;z$+$i$J$k(B&string;$B$H(B&match;$B$9$k$?$a$K!$

$B$3$3$G!$(BN$B$O(B16$B?J$N@0?t$H$9$k!#(BISO/IEC 10646$B$NJ8;z$G$"$C$F!$@55,7A(B(UCS-4)$B$N(B&code-value;$B$rId9f$J$7(B2$B?J?t$H$7$F2r#xN$B7A<0$N@hF,$K%<%m$,$$$/$D$+8=$l$k$+$O!$0UL#$r$b$?$J$$!#(B&code-value;$B$K$*$1$k@hF,$N%<%m$N?t$O!$J8;z$NId9f2=$K$h$C$F7hDj$5$l$k$N$G!$(BXML$B$K$H$C$F$O0UL#$,$J$$!#(B

$B;XDj$7$?HO0O$NCM(B($BN>C<$NCM$r4^$`!#!K$r$b$DG$0U$N(B$BJ8;z(B$B$H(B&match;$B$9$k!#(B

$B;XDj$7$?HO0O(B$B30(B$B$NCM$r$b$DG$0U$N(B$BJ8;z(B$B$H(B&match;$B$9$k!#(B

$B;XDj$7$?J8;z0J30$NCM$r$b$DG$0U$N(B$BJ8;z(B$B$H(B&match;$B$9$k!#(B

&double-quote;$B$G0O$`(B&string;&literal;$B$H(B&match;$B$7$F$$$k(B&string;&literal;$B$H(B&match;$B$9$k!#(B

&single-quote;$B$G0O$`(B&string;&literal;$B$H(B&match;$B$7$F$$$k(B&string;&literal;$B$H(B&match;$B$9$k!#(B

 $B$3$l$i$N5-9f$O!$A$B5Z$S(BB$B$O!$C1=c$J<0$H$9$k!#(B

expression$B$O!$0l$D$N$^$H$^$j$H$7$F07$$!$$3$3$K<($9AH9g$;$G;H$C$F$b$h$$!#(B

A$BKt$O2?$b$J$7$H(B&match;$B$9$k(B($B%*%W%7%g%s$N(BA)$B!#(B

A$B$NB$B$,=P8=$9$k$b$N$H(B&match;$B$9$k!#(B

A$BKt$O(BB$B!$$?$@$7!$N>J}$G$O$J$$!$$H(B&match;$B$9$k!#(B

A$B$H(B&match;$B$9$k$,!$(BB$B$H$O(B&match;$B$7$J$$!$G$0U$N(B&string;$B$H(B&match;$B$9$k!#(B

A$B$N(B1$B2s0J>e$N7+JV$7$H(B&match;$B$9$k!#(B

A$B$N(B0$B2s0J>e$N7+JV$7$H(B&match;$B$9$k!#(B

 $B@8@.5,B'Fb$G;HMQ$9$kB>$N5-K!$r!$

$B%3%a%s%H!#(B

&well-formed;$B@)Ls!#@8@.5,B'$KIUM?$7$?!$(B&well-formed;$B$NJ8=q$K4X$9$k@)Ls$r!$L>A0$K$h$C$F(B&identify;$B!#(B

&validity;$B@)Ls!#@8@.5,B'$KIUM?$7$?!$(B&valid;$B$JJ8=q$K4X$9$k@)Ls$r!$L>A0$K$h$C$F(B&identify;$B!#(B

$B;29MJ88%(B &normative;$B;29MJ88%(B IETF (Internet Engineering Task Force). RFC 1766: Tags for the Identification of Languages, ed. H. Alvestrand. 1995. (International Organization for Standardization). ISO 8879:1988 (E). Code for the representation of names of languages. [Geneva]: International Organization for Standardization, 1988. (International Organization for Standardization). ISO 3166-1:1997 (E). Codes for the representation of names of countries and their subdivisions — Part 1: Country codes [Geneva]: International Organization for Standardization, 1997. ISO (International Organization for Standardization). ISO/IEC 10646-1993 (E). Information technology — Universal Multiple-Octet Coded Character Set (UCS) — Part 1: Architecture and Basic Multilingual Plane. [Geneva]: International Organization for Standardization, 1993 (plus amendments AM 1 through AM 7). The Unicode Consortium. The Unicode Standard, Version 2.0. Reading, Mass.: Addison-Wesley Developers Press, 1996. $BB>$N;29MJ88%(B Aho, Alfred V., Ravi Sethi, and Jeffrey D. Ullman. Compilers: Principles, Techniques, and Tools. Reading: Addison-Wesley, 1986, rpt. corr. 1988. Berners-Lee, T., R. Fielding, and L. Masinter. Uniform Resource Identifiers (URI): Generic Syntax and Semantics. 1997. (Work in progress; see updates to RFC1738.) Brüggemann-Klein, Anne. Regular Expressions into Finite Automata. Extended abstract in I. Simon, Hrsg., LATIN 1992, S. 97-98. Springer-Verlag, Berlin 1992. Full Version in Theoretical Computer Science 120: 197-213, 1993. Brüggemann-Klein, Anne, and Derick Wood. Deterministic Regular Languages. Universität Freiburg, Institut für Informatik, Bericht 38, Oktober 1991. IETF (Internet Engineering Task Force). RFC 1738: Uniform Resource Locators (URL), ed. T. Berners-Lee, L. Masinter, M. McCahill. 1994. IETF (Internet Engineering Task Force). RFC 1808: Relative Uniform Resource Locators, ed. R. Fielding. 1995. IETF (Internet Engineering Task Force). RFC 2141: URN Syntax, ed. R. Moats. 1997. ISO (International Organization for Standardization). ISO/IEC 8879-1986 (E). Information processing — Text and Office Systems — Standard Generalized Markup Language (SGML). First edition — 1986-10-15. [Geneva]: International Organization for Standardization, 1986. ISO (International Organization for Standardization). ISO/IEC 10744-1992 (E). Information technology — Hypermedia/Time-based Structuring Language (HyTime). [Geneva]: International Organization for Standardization, 1992. Extended Facilities Annexe. [Geneva]: International Organization for Standardization, 1996. $BJ8;z%/%i%9(B

Unicode$BI8=`$KDj5A$9$k(B&property;$B$K$7$?$,$C$F!$J8;z$O!$(B&base-character;(BaseChar)($B$3$l$i$O!$(B&diacritical-mark;$B$r=|$/%i%F%s%"%k%U%!%Y%C%H$N%"%k%U%!%Y%C%HJ8;z$r4^$`(B)$B!$(B&ideographic;(ideographic)$B5Z$S(B&combining-character;(CombiningChar)($B$3$N%/%i%9$O!$$[$H$s$I$N(B&diacritical-mark;$B$r4^$`(B)$B$K%/%i%9J,$1$9$k!#$3$l$i$N%/%i%9$O!$7k9g$7!$(B&letter;(Letter)$B$N%/%i%9$H$J$k!#(B10$B?J?tCM(B(Digit)$B5Z$S(B&extender;(Extender)$B$b6hJL$9$k!#(B $BJ8;z(B Letter BaseChar | Ideographic BaseChar [#x0041-#x005A] | [#x0061-#x007A] | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x00FF] | [#x0100-#x0131] | [#x0134-#x013E] | [#x0141-#x0148] | [#x014A-#x017E] | [#x0180-#x01C3] | [#x01CD-#x01F0] | [#x01F4-#x01F5] | [#x01FA-#x0217] | [#x0250-#x02A8] | [#x02BB-#x02C1] | #x0386 | [#x0388-#x038A] | #x038C | [#x038E-#x03A1] | [#x03A3-#x03CE] | [#x03D0-#x03D6] | #x03DA | #x03DC | #x03DE | #x03E0 | [#x03E2-#x03F3] | [#x0401-#x040C] | [#x040E-#x044F] | [#x0451-#x045C] | [#x045E-#x0481] | [#x0490-#x04C4] | [#x04C7-#x04C8] | [#x04CB-#x04CC] | [#x04D0-#x04EB] | [#x04EE-#x04F5] | [#x04F8-#x04F9] | [#x0531-#x0556] | #x0559 | [#x0561-#x0586] | [#x05D0-#x05EA] | [#x05F0-#x05F2] | [#x0621-#x063A] | [#x0641-#x064A] | [#x0671-#x06B7] | [#x06BA-#x06BE] | [#x06C0-#x06CE] | [#x06D0-#x06D3] | #x06D5 | [#x06E5-#x06E6] | [#x0905-#x0939] | #x093D | [#x0958-#x0961] | [#x0985-#x098C] | [#x098F-#x0990] | [#x0993-#x09A8] | [#x09AA-#x09B0] | #x09B2 | [#x09B6-#x09B9] | [#x09DC-#x09DD] | [#x09DF-#x09E1] | [#x09F0-#x09F1] | [#x0A05-#x0A0A] | [#x0A0F-#x0A10] | [#x0A13-#x0A28] | [#x0A2A-#x0A30] | [#x0A32-#x0A33] | [#x0A35-#x0A36] | [#x0A38-#x0A39] | [#x0A59-#x0A5C] | #x0A5E | [#x0A72-#x0A74] | [#x0A85-#x0A8B] | #x0A8D | [#x0A8F-#x0A91] | [#x0A93-#x0AA8] | [#x0AAA-#x0AB0] | [#x0AB2-#x0AB3] | [#x0AB5-#x0AB9] | #x0ABD | #x0AE0 | [#x0B05-#x0B0C] | [#x0B0F-#x0B10] | [#x0B13-#x0B28] | [#x0B2A-#x0B30] | [#x0B32-#x0B33] | [#x0B36-#x0B39] | #x0B3D | [#x0B5C-#x0B5D] | [#x0B5F-#x0B61] | [#x0B85-#x0B8A] | [#x0B8E-#x0B90] | [#x0B92-#x0B95] | [#x0B99-#x0B9A] | #x0B9C | [#x0B9E-#x0B9F] | [#x0BA3-#x0BA4] | [#x0BA8-#x0BAA] | [#x0BAE-#x0BB5] | [#x0BB7-#x0BB9] | [#x0C05-#x0C0C] | [#x0C0E-#x0C10] | [#x0C12-#x0C28] | [#x0C2A-#x0C33] | [#x0C35-#x0C39] | [#x0C60-#x0C61] | [#x0C85-#x0C8C] | [#x0C8E-#x0C90] | [#x0C92-#x0CA8] | [#x0CAA-#x0CB3] | [#x0CB5-#x0CB9] | #x0CDE | [#x0CE0-#x0CE1] | [#x0D05-#x0D0C] | [#x0D0E-#x0D10] | [#x0D12-#x0D28] | [#x0D2A-#x0D39] | [#x0D60-#x0D61] | [#x0E01-#x0E2E] | #x0E30 | [#x0E32-#x0E33] | [#x0E40-#x0E45] | [#x0E81-#x0E82] | #x0E84 | [#x0E87-#x0E88] | #x0E8A | #x0E8D | [#x0E94-#x0E97] | [#x0E99-#x0E9F] | [#x0EA1-#x0EA3] | #x0EA5 | #x0EA7 | [#x0EAA-#x0EAB] | [#x0EAD-#x0EAE] | #x0EB0 | [#x0EB2-#x0EB3] | #x0EBD | [#x0EC0-#x0EC4] | [#x0F40-#x0F47] | [#x0F49-#x0F69] | [#x10A0-#x10C5] | [#x10D0-#x10F6] | #x1100 | [#x1102-#x1103] | [#x1105-#x1107] | #x1109 | [#x110B-#x110C] | [#x110E-#x1112] | #x113C | #x113E | #x1140 | #x114C | #x114E | #x1150 | [#x1154-#x1155] | #x1159 | [#x115F-#x1161] | #x1163 | #x1165 | #x1167 | #x1169 | [#x116D-#x116E] | [#x1172-#x1173] | #x1175 | #x119E | #x11A8 | #x11AB | [#x11AE-#x11AF] | [#x11B7-#x11B8] | #x11BA | [#x11BC-#x11C2] | #x11EB | #x11F0 | #x11F9 | [#x1E00-#x1E9B] | [#x1EA0-#x1EF9] | [#x1F00-#x1F15] | [#x1F18-#x1F1D] | [#x1F20-#x1F45] | [#x1F48-#x1F4D] | [#x1F50-#x1F57] | #x1F59 | #x1F5B | #x1F5D | [#x1F5F-#x1F7D] | [#x1F80-#x1FB4] | [#x1FB6-#x1FBC] | #x1FBE | [#x1FC2-#x1FC4] | [#x1FC6-#x1FCC] | [#x1FD0-#x1FD3] | [#x1FD6-#x1FDB] | [#x1FE0-#x1FEC] | [#x1FF2-#x1FF4] | [#x1FF6-#x1FFC] | #x2126 | [#x212A-#x212B] | #x212E | [#x2180-#x2182] | [#x3041-#x3094] | [#x30A1-#x30FA] | [#x3105-#x312C] | [#xAC00-#xD7A3] Ideographic [#x4E00-#x9FA5] | #x3007 | [#x3021-#x3029] CombiningChar [#x0300-#x0345] | [#x0360-#x0361] | [#x0483-#x0486] | [#x0591-#x05A1] | [#x05A3-#x05B9] | #x05BB#x05BD | #x05BF | [#x05C1-#x05C2] | #x05C4 | #x064B#x0652 | #x0670 | [#x06D6-#x06DC] | #x06DD#x06DF | [#x06E0-#x06E4] | [#x06E7-#x06E8] | [#x06EA-#x06ED] | [#x0901-#x0903] | #x093C | [#x093E-#x094C] | #x094D | [#x0951-#x0954] | [#x0962-#x0963] | [#x0981-#x0983] | #x09BC | #x09BE | #x09BF | [#x09C0-#x09C4] | [#x09C7-#x09C8] | [#x09CB-#x09CD] | #x09D7 | [#x09E2-#x09E3] | #x0A02 | #x0A3C | #x0A3E | #x0A3F | [#x0A40-#x0A42] | [#x0A47-#x0A48] | [#x0A4B-#x0A4D] | [#x0A70-#x0A71] | [#x0A81-#x0A83] | #x0ABC | [#x0ABE-#x0AC5] | [#x0AC7-#x0AC9] | [#x0ACB-#x0ACD] | [#x0B01-#x0B03] | #x0B3C | [#x0B3E-#x0B43] | [#x0B47-#x0B48] | [#x0B4B-#x0B4D] | [#x0B56-#x0B57] | [#x0B82-#x0B83] | [#x0BBE-#x0BC2] | [#x0BC6-#x0BC8] | [#x0BCA-#x0BCD] | #x0BD7 | [#x0C01-#x0C03] | [#x0C3E-#x0C44] | [#x0C46-#x0C48] | [#x0C4A-#x0C4D] | [#x0C55-#x0C56] | [#x0C82-#x0C83] | [#x0CBE-#x0CC4] | [#x0CC6-#x0CC8] | [#x0CCA-#x0CCD] | [#x0CD5-#x0CD6] | [#x0D02-#x0D03] | [#x0D3E-#x0D43] | [#x0D46-#x0D48] | [#x0D4A-#x0D4D] | #x0D57 | #x0E31 | [#x0E34-#x0E3A] | [#x0E47-#x0E4E] | #x0EB1 | [#x0EB4-#x0EB9] | [#x0EBB-#x0EBC] | [#x0EC8-#x0ECD] | [#x0F18-#x0F19] | #x0F35 | #x0F37 | #x0F39 | #x0F3E | #x0F3F | [#x0F71-#x0F84] | [#x0F86-#x0F8B] | [#x0F90-#x0F95] | #x0F97 | [#x0F99-#x0FAD] | [#x0FB1-#x0FB7] | #x0FB9 | [#x20D0-#x20DC] | #x20E1 | [#x302A-#x302F] | #x3099 | #x309A Digit [#x0030-#x0039] | [#x0660-#x0669] | [#x06F0-#x06F9] | [#x0966-#x096F] | [#x09E6-#x09EF] | [#x0A66-#x0A6F] | [#x0AE6-#x0AEF] | [#x0B66-#x0B6F] | [#x0BE7-#x0BEF] | [#x0C66-#x0C6F] | [#x0CE6-#x0CEF] | [#x0D66-#x0D6F] | [#x0E50-#x0E59] | [#x0ED0-#x0ED9] | [#x0F20-#x0F29] Extender #x00B7 | #x02D0 | #x02D1 | #x0387 | #x0640 | #x0E46 | #x0EC6 | #x3005 | [#x3031-#x3035] | [#x309D-#x309E] | [#x30FC-#x30FE]

$B$3$3$GDj5A$9$kJ8;z%/%i%9$O!$(BUnicode$BJ8;z%G!<%?%Y!<%9$+$i!$

a) $BL>A03+;OJ8;z$O!$(BLl, Lu, Lo, Lt, Nl$B%+%F%4%jFb$N0l$D$G$J$1$l$P$J$i$J$$!#(B

b) $BL>A03+;OJ8;z0J30$NL>A0J8;z$O!$(BMc, Me, Mn, Lm, Nd$B%+%F%4%jFb$N0l$D$G$J$1$l$P$J$i$J$$!#(B

c) &compatibility-area;$B$K$"$kJ8;z(B($BJ8;zId9f$G(B#xF900$B$h$jBg$-$/(B#xFFFE$B$h$j>.$5$$J8;z(B)$B$O!$(BXML$B$K$*$1$kL>A0$H$7$F$O!$5v$5$l$J$$!#(B

d) &font-decomposition;$B$+(B&compatibility-decomposition;$B$r$b$DJ8;z(B($B$D$^$j!$%G!<%?%Y!<%9Fb$N#5HVL\$N%U%#!<%k%I$K(B"compatibility formatting tag"$B$,$"$k$b$N!#$3$l$O!$#5HVL\$N%U%#!<%k%I$,!$(B"<"$B$G;O$^$k$3$H$K$h$C$F%^!<%/IU$1$5$l$k!#(B)$B$O!$5v$5$l$J$$!#(B

e) $BA03+;OJ8;z$H$7$F07$&!#$3$l$O!$(B&property-file;$B$,!$$3$l$i$NJ8;z$r%"%k%U%!%Y%C%H$KN`;w$9$k$H8+$J$9$3$H$K$h$k!#$=$l$i$O(B [#x02BB-#x02C1], #x0559, #x06E5, #x06E6$B$H$9$k!#(B

f) $BJ8;zId9f$,(B#x20DD-#x20E0$B$NJ8;z$O!$(B(Unicode $B$N(B5.14$B$K$7$?$,$C$F(B)$B=|30$9$k!#(B

g) $BJ8;zId9f$,(B#x00B7$B$NJ8;z$O!$(B&property-list;$B$K$7$?$,$C$F!$(B&extender;(extender)$B$KJ,N`$9$k!#(B

h) $BJ8;z(B#x0387$B$O!$$3$l$KAjEv$9$k@55,7A$,(B#x00B7$B$J$N$G!$L>A0J8;z$KDI2C$9$k!#(B

i) $BJ8;z(B':'$B5Z$S(B'_'$B$O!$L>A03+;OJ8;z$H$7$F5v$9!#(B

j) $BJ8;z(B'-'$B5Z$S(B'.'$B$O!$L>A0J8;z$H$7$F5v$9!#(B

XML$B5Z$S(BSGML

XML$B$O!$(BSGML$B$N(B⊂$B$H$7$F@_7W$5$l$F$$$k!#$9$J$o$A!$$9$Y$F$N(B&valid;$B$J(BXML$BJ8=q$O!$5,3J$KE,9g$9$k(BSGML$BJ8=q$K$b$J$k!#(BSGML$B$,J8=q$K2]$9@)8B0J30$K!$(BXML$B$,$$$+$J$k@)8B$r2]$9$+$K4X$9$k>\:Y$O!$JL$N(B$B5,Dx(B$B$r;2>H$N$3$H!#$3$N5,Dx$O!$(BXML$B$N@)Ls>r7o$r<($9(BSGML$B@k8@$r4^$_!$$3$l$O!$(BSGML&parser;$B$K;HMQ$G$-$k!#(B

$BH5Z$SJ8;z;2>H$NE83+(B

$B$3$NIUO?$O!$H5Z$SJ8;z;2>H$rG'<1$7!$E83+$9$k!$0lO"$NN.$l$r!$Nc$K;H$C$F<($9!#(B

DTD$B$,!$l9g$r9M$($k!#(B An ampersand (&#38;) may be escaped numerically (&#38;#38;) or with a general entity (&amp;).

" > ]]> XML&processor;$B$O!$H$rG'<1$7!$$3$l$r2r7h$9$k!#example"$B$NCM$H$7$F!$An ampersand (&) may be escaped numerically (&#38;) or with a general entity (&amp;).

]]> $BJ8=qFb$G(B"&example;"$B$r;2>H$9$k$H!$$3$N%F%-%9%H$O!$:F$S9=J82r@O$5$l$k!#$3$N$H$-!$MWAG(B"p"$B$N3+;O%?%05Z$S=*N;%?%0$rG'<1$7!$;0$D$N;2>H$rG'<1$7E83+$9$k!#$=$N7k2L!$MWAG(B"p"$B$O!$

$B5,B'5Z$S$=$N8z2L$r$h$j>\:Y$K<($9$?$a!$$5$i$KJ#;($JNc$r<($9!#H$NJX59$N$?$a$@$1$KIU$1$k!#(B 2 4 5 ' > 6 %xx; 7 ]> 8 This sample shows a &tricky; method. ]]> $B$3$l$r=hM}$9$k$H!$

a) 4$B9TL\$G!$(B37$BHVL\$NJ8;z$X$N;2>H$rD>$A$KE83+$7!$%Q%i%a%?xx"$B$r!$%7%s%\%k%F!<%V%k$K(B"%zz;"$B$H$$$&CM$H$H$b$KJ]B8$9$k!#(B&replacement-text;$B$r:F$SAv::$9$k$3$H$O$J$$$N$G!$%Q%i%a%?zz"$B$X$N;2>H$OG'<1$7$J$$(B("zz"$B$O!$$^$@@k8@$5$l$F$$$J$$$N$G!$Av::$5$l$l$P!$(B&error;$B$H$J$k!#(B)$B!#(B

b) 5$B9TL\$G!$J8;z;2>H(B"&#60;"$B$rD>$A$KE83+$7!$%Q%i%a%?zz"$B$r(B"<!ENTITY tricky "error-prone" >"$B$H$$$&(B&replacement-text;$B$H$H$b$KJ]B8$9$k!#$3$l$O!$(B&well-formed;$B$N

c) 6$B9TL\$G!$(B"xx"$B$X$N;2>H$rG'<1$7!$(B"xx"$B$N(B&replacement-text;($B$9$J$o$A!$(B"%zz;")$B$r9=J82r@O$9$k!#(B"zz"$B$X$N;2>H$rB3$$$FG'<1$7!$(B&replacement-text;("<!ENTITY tricky "error-prone" >")$B$r9=J82r@O$9$k!#0lHLtricky"$B$O!$$3$N;~E@$G$O!$@k8@$5$l$F$*$j!$$=$N(B&replacement-text;$B$O!$(B"error-prone"$B$H$9$k!#(B

d) 8$B9TL\$G!$0lHLtricky"$B$X$N;2>H$rG'<1$7!$E83+$9$k!#MWAG(B"test"$B$N40A4$JFbMF$O!$This sample shows a error-prone method.

$B7hDjE*FbMF%b%G%k(B

$B8_49@-$N$?$a(B$B!$MWAG@k8@$K$*$1$kFbMF%b%G%k$O!$7hDjE*$H$9$kI,MW$,$"$k!#(B

SGML$B$O!$7hDjE*FbMF%b%G%k(B(SGML$B$G$O!$Hs$"$$$^$$$H8F$V!#(B)$B$rMW5a$9$k!#(BSGML$B%7%9%F%`$rMQ$$$F:n@.$7$?(BXML&processor;$B$O!$Hs7hDjE*FbMF%b%G%k$r(B&error;$B$H$7$F$b$h$$!#(B

$BNc$($P!$FbMF%b%G%k(B((b, c) | (b, d))$B$OHs7hDjE*$H$J$k!#$3$l$O!$:G=i$K(Bb$B$rM?$($?$H$-!$%b%G%kFb$N$$$:$l$N(Bb$B$H(B&match;$B$9$k$N$,K>$^$7$$$+!$$=$Nl9g$O!$(Bb$B$X$NFs$D$N;2>H$O!$0l$D$N;2>H$K$^$H$a$k$3$H$,$G$-!$%b%G%k$O!$(B(b, (c | d))$B$H$J$k!#$3$l$G!$:G=i$N(Bb$B$,!$FbMF%b%G%kFb$N0l$D$NL>A0$H$@$1(B&match;$B$9$k$3$H$OL@$i$+$H$J$k!#(B&parser;$B$O!$@hFI$_$7$F!$c$B$b(Bd$B$b!$

$B7A<0E*$K<($9!#(BAho, Sethi, and Ullman $B$N(B3.9$B$N%"%k%4%j%:%`(B3.5$B$NI8=`E*$J%"%k%4%j%:%`$rMQ$$$F!$FbMF%b%G%k$+$iM-8B%*!<%H%^%H%s$r9=@.$9$k$3$H$,$G$-$k!#$3$N$G%i%Y%kIU$1$5$l$F$$$l$P!$$=$NFbMF%b%G%k$O(B&error;$B$H$J$j!$(B&error;$B$rJV$9>l9g$b$"$k!#(B

$B$9$Y$F$NHs7hDjE*FbMF%b%G%k$rEy2A$J7hDjE*FbMF%b%G%k$KJQ49$9$k$3$H$O$G$-$J$$$,!$B?$/$NHs7hDjE*FbMF%b%G%k$rJQ49$9$k%"%k%4%j%:%`$,B8:_$9$k!#(BBrüggemann-Klein 1991 $B$r;2>H$N$3$H!#(B

 $BJ8;zId9f2=$N<+F08!=P(B

XML$B$NId9f2=@k8@$O!$3FE*$J>uBV$H$J$k!#$7$+$7!$(BXML$B$K$*$$$F$O!$40A4$K$O@dK>E*$G$O$J$$!#$3$l$O!$(BXML$B$,!$l9g$KBP$9$k@)8B$r2C$($k$3$H$K$h$k!#0l$D$N@)8B$O!$$I$N$N0l$D$N@)8B$O!$3Fl9g$K!$(BXML$B$N%G!<%?%9%H%j!<%`$K2C$(!$B>$N>pJs$,MxMQ$G$-$k!#$3$3$G$O!$(BXML$B$NpJs$rH<$&$+$I$&$+$K$h$C$F!$Fs$D$N>l9g$KJ,$1$k!#$^$::G=i$N>l9g$r<($9!#(B

UTF-8$B7A<0Kt$O(BUTF-16$B7A<0$G$O$J$$(BXML$B<?xml'$B$H$9$k(BXML$BId9f2=@k8@$G;O$^$i(B$B$J$1$l$P$J$i$J$$(B$B$N$G!$$I$NE,9g$7$?(B&processor;$B$b!$F~NO$K$"$k(B2$B%*%/%F%C%HKt$O(B4$B%*%/%F%C%H$rD4$Y$l$P!$l9g$,$"$F$O$^$k$+$r8!=P$G$-$k!#$3$N%j%9%H$rFI$`:]$K$O!$(BUCS-4$B$N(B'<'$B$,(B"#x0000003C"$B!$(B'?'$B$,(B"#x0000003F"$B!$5Z$S(BUTF-16$B$N%G!<%?(B&stream;$B$NI,MW$H$9$k(B&byte-order-mark;$B$,(B"#xFEFF"$B$H$$$&$3$H$rCN$C$F$*$/$HLrN)$D$+$b$7$l$J$$!#(B

a) 00 00 00 3C: UCS-4, big-endian $B%^%7%s(B (1234$B=g(B)

b) 3C 00 00 00: UCS-4, little-endian $B%^%7%s(B (4321$B=g(B)

c) 00 00 3C 00: UCS-4, $BIaDL$G$O$J$$%*%/%F%C%H=g(B (2143)

d) 00 3C 00 00: UCS-4, $BIaDL$G$O$J$$%*%/%F%C%H=g(B (3412)

e) FE FF: UTF-16, big-endian

f) FF FE: UTF-16, little-endian

g) 00 3C 00 3F: UTF-16, big-endian, &byte-order-mark;$B$J$7(B($B$7$?$,$C$F!$87L)$K$$$($P!$(B&error;$B$H$9$k!#(B)$B!#(B

h) 3C 00 3F 00: UTF-16, little-endian, &byte-order-mark;$B$J$7(B($B$7$?$,$C$F!$87L)$K$$$($P!$(B&error;$B$H$9$k!#(B)$B!#(B

i) 3C 3F 78 6D: UTF-8, ISO 646, ASCII, ISO 8859$B$N3F%Q!<%H!$(BShift-JIS$B!$(BEUC$B!$JB$S$KG$0U$NB>$N(B7$B%S%C%H!$(B8$B%S%C%HKt$O:.:_I}$NId9f2=$G$"$C$F!$(BASCII$BJ8;z$rDL>o$N0LCV!$I}5Z$SCM$H$9$k$3$H$rJ]>Z$9$k$b$N!#$3$l$i$N$I$l$KBP1~$9$k$+$r8!=P$9$k$?$a$K$O!$

j) 4C 6F A7 94: EBCDIC ($BKt$O$=$NJQ

k) $B$=$NB>(B: $BId9f2=@k8@$J$7$N(BUTF-8$B!#$=$&$G$J$$$H$-$K$O!$%G!<%?(B&stream;$B$,2u$l$F$$$k$+!$CGJRE*$K$J$C$F$$$k$+!$2?$i$+$N7A<0$K$7$?$,$C$FKd$a9~$^$l$F$$$k!#(B

$B$3$NDxEY$N<+F0H=JL$G$b!$(BXML$B$NId9f2=@k8@$rFI$_9~$_!$J8;zId9f2=$N(B&identifier;$B$r2r@O$9$k$K$O==J,$H$9$k!#(B&identifier;$B$N2r@O$O!$N`;w$9$k3F!9$NId9f2=$N0l$D0l$D$r6hJL$9$k$?$a$KI,MW$H$9$k(B($BNc$($P!$(BUTF-8$B5Z$S(B8859$B$r6hJL$9$k$?$a!$(B8859$B$N3F%Q!<%H$r6hJL$9$k$?$a!$;HMQ$7$F$$$kFCDj$N(BEBCDIC$B%3!<%I%Z!<%8$r6hJL$9$k$?$a!$$J$I!#(B)$B!#(B

$BId9f2=@k8@$NFbMF$r(BASCII$BJ8;z$K8BDj$7$F$$$k$N$G!$$I$NJ,N`$NId9f2=$r;HMQ$9$k$+$r8!=P$9$l$P!$(B&processor;$B$O!$Id9f2=@k8@A4BN$r@53N$KFI$_9~$`$3$H$,$G$-$k!#8=e$NJ,N`$N$$$:$l$+$K$"$F$O$^$k$N$G!$%*%Z%l!<%F%#%s%0%7%9%F%`Kt$OEAAw%W%m%H%3%k$,M?$($k30It>pJs$r?.MjIT2DG=$J$H$-$G$5$($b!$FbIt%i%Y%k$GJ8;zId9f2=$r$+$J$j@53N$K<($9$3$H$,!$(BXML$BId9f2=@k8@$K$h$C$F2DG=$H$J$k!#(B

&processor;$B$,;HMQ$9$kJ8;zId9f2=$r8!=P$7$5$($9$l$P!$$=$l$>$l$N>l9g$KBP$7$FJL8D$NF~NO%k!<%A%s$r8F$S=P$9!$Kt$OF~NO$9$k3FJ8;z$KBP$7E,@Z$JJQ494X?t$r8F$S=P$9$3$H$K$h$C$F!$E,@Z$JF0:n$,2DG=$H$J$k!#(B

$B<+J,<+BN$K%i%Y%kIU$1$r$9$k$$$+$J$k%7%9%F%`$G$bF1MM$@$,!$%=%U%H%&%'%"$,!$Id9f2=@k8@$r99?7$;$:$KpJs$N@53N$5$NJ]>Z$KCm0U$9$k$N$,K>$^$7$$!#(B

$B#2HVL\$N>l9g$O!$(BXML$B$N$K!$Id9f2=>pJs$,B8:_$9$k$H$-$G$"$C$F!$$$$/$D$+$N%U%!%$%k%7%9%F%`5Z$S%M%C%H%o!<%/%W%m%H%3%k$G$O!$$=$NId9f2=>pJs$,B8:_$9$k!#J#?t$N>pJs$,MxMQ$G$-$k$H$-!$(B$B$=$l$i$NAjBPE*$JM%@hEY5Z$S$=$l$i$,L7=b$7$?$H$-$NK>$^$7$$=hM}J}K!$O!$(BXML$B$NG[Aw$K;HMQ$9$k!$$h$j9b?e=`$N%W%m%H%3%k$N0lIt$H$7$F5,Dx$9$k$N$,$h$$!#Nc$($P!$FbIt%i%Y%k5Z$S30It(B&header;$B$KB8:_$9$k(BMIME$B7A<0$N%i%Y%k$NAjBPE*$JM%@hEY$KBP$9$k5,B'$O!$(Btext/xml$B5Z$S(Bapplication/xml$B$N(BMIME$B7?$rDj5A$9$k(BRFC$BJ8=q$N0lIt$H$J$kJ}$,$h$$!#$7$+$7!$Aj8_1?MQ@-$N$?$a$K!$$&$3$H$,K>$^$7$$!#(B

a) XML$B$N$N$9$Y$F$N(B&hueristics;$B5Z$S>pJs$O!$(B&error;$B2sI|$N$?$a$@$1$KMQ$$$k!#(B

b) XML$B$N$N$9$Y$F$N(B&hueristics;$B5Z$S>pJs$O!$(B&error;$B2sI|$N$?$a$@$1$KMQ$$$k!#(B

c) XML$B$NMIME$B7?(Bapplication/xml$B$GG[Aw$9$k$H$-$O!$(B&byte-order-mark;$B5Z$SId9f2=@k8@(BPI$B$r(B($BB8:_$9$l$P(B)$BJ8;zId9f2=$N7hDj$N$?$a$K;HMQ$9$k!#B>$N$9$Y$F$N(B&hueristics;$B5Z$S>pJs$O(B&error;$B2sI|$N$?$a$@$1$KMQ$$$k!#(B

$B$3$l$i$N5,B'$O!$%W%m%H%3%k$K$D$$$F$N;qNA$,$J$$$H$-$K$@$1MQ$$$k!#FC$K!$(BMIME$B7?(Btext/xml$B5Z$S(Bapplication/xml$B$rDj5A$7$?$i!$$3$l$i$r5,Dj$9$k(BRFC$B$KB8:_$9$k5,Dj$,!$$3$l$i$N5,B'$K &informative;W3C XML $B%o!<%-%s%0%0%k!<%W(B

$B$3$N(B&TR-or-Rec;$B$O!$(BW3C XML $B%o!<%-%s%0%0%k!<%W(B(WG)$B$,=`Hw$7!$8x3+$r>5G'$7$?!#(BWG$B$,$3$N(B&TR-or-Rec;$B$r>5G'$9$k$H$$$&$3$H$O!$(BWG$B$N$9$Y$F$N0Q0w$,>5G'EjI<$r9T$C$?$H$$$&$3$H$rI,$:$7$b0UL#$7$J$$!#(BXML WG$B$N8=:_$N0Q0w5Z$S0JA0$N0Q0w$r Jon Bosak, SunChair James ClarkTechnical Lead Tim Bray, Textuality and NetscapeXML Co-editor Jean Paoli, MicrosoftXML Co-editor C. M. Sperberg-McQueen, U. of Ill.XML Co-editor Dan Connolly, W3C Steve DeRose, INSO Dave Hollander, HP Eliot Kimber, Highland Eve Maler, ArborText Tom Magliery, NCSA Murray Maloney, Muzmo and Grif $BBpJs%7%9%F%`(B($B3t(B) Joel Nava, Adobe Peter Sharpe, SoftQuad John Tigue, DataChannel hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-shift_jis.dtd0000644006511100651110000000560310504340462027551 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/pr-xml-utf-16.xml0000644006511100651110000114336210504340462026563 0ustar rossrossþÿ<?xml version="1.0"?> <!DOCTYPE spec SYSTEM "spec.dtd" [ <!-- eåg,ŠžŠ30n0_00n‰ãg[þŒa[ŸOSÿ0S0S0K0‰ÿ --> <!ENTITY TR-or-Rec "NÕiØfø"> <!-- <!ENTITY TR-or-Rec "jn–`ÅX1(TR)"> --> <!ENTITY eTR-or-Rec "specification"> <!-- <!ENTITY eTR-or-Rec "technical report(TR)"> --> <!ENTITY application "0¢0×0ê0±0ü0·0ç0ó"> <!ENTITY error "0¨0é0ü"> <!ENTITY fatal-error "ôT}v„0¨0é0ü"> <!ENTITY parsed-data "‰ãg0U0Œ0‹0Ç0ü0¿"> <!ENTITY unparsed-data "‰ãg0U0Œ0j0D0Ç0ü0¿"> <!ENTITY parsed-entity "‰ãg[þŒa[ŸOS"> <!ENTITY parser "0Ñ0ü0µ"> <!ENTITY unparsed-entity "‰ãg[þŒaY[ŸOS"> <!ENTITY well-formed "et_b_"> <!ENTITY valid "Y¥_S"> <!ENTITY validity "Y¥_S`'"> <!ENTITY escape "R%bq0D"> <!ENTITY prolog "fø0M"> <!ENTITY surrogate-blocks "0µ0í0²0ü0È0Ö0í0Ã0¯"> <!ENTITY letter "[W"> <!ENTITY ideographic "}qTo"[W"> <!ENTITY markup "0Þ0ü0¯NØ0Q"> <!ENTITY left-angle-bracket "N {IS÷(\0j0Š)"> <!ENTITY right-angle-bracket "N {IS÷(Y'0j0Š)"> <!ENTITY string "e‡[WR"> <!ENTITY char-string "e‡[WR"><!-- string of chararacters, character strings, strings, characters 0o0Y0y0fe‡[WR0h0Y0‹ --> <!ENTITY replacement-text "ncÛ0Æ0­0¹0È"> <!ENTITY single-quote "N‘Í_u({&"> <!ENTITY double-quote "NŒ‘Í_u({&"> <!ENTITY adaptations-annex "iu(–D\^fø"> <!ENTITY root "0ë0ü0È"> <!ENTITY base-character "Wú^•e‡[W"> <!ENTITY diacritical-mark "vz—ó{&"><!--(0À0¤0¢0¯0ê0Æ0£0«0ë0Þ0ü0¯)0’RQú0n0h0MˆÜ0F--> <!ENTITY composed-form "Tb_b_"> <!ENTITY standalone "0¹0¿0ó0É0¢0í0ó"> <!ENTITY double-hyphen "NŒ#0Ï0¤0Õ0ó"> <!--<!ENTITY case-fold "Y'e‡[W0K\e‡[W0x0n}qN">--> <!-- <!ENTITY case-fold "kÔ0n0h0Mÿ Y'e‡[W0h\e‡[W0nT N‰–">--> <!ENTITY parameter "0Ñ0é0á0¿"> <!ENTITY stream "0¹0È0ê0ü0à"> <!ENTITY validating "Y¥_S`'0’iŠ<0Y0‹"> <!ENTITY non-validating "Y¥_S`'0’iŠ<0W0j0D"> <!ENTITY user "0æ0ü0¶"> <!--<!ENTITY at-user-option "0æ0ü0¶0L0ª0×0·0ç0ó0’c[š0W0_0h0M">--> <!ENTITY at-user-option "0æ0ü0¶0n0ª0×0·0ç0óc[š0k0ˆ0c0f0o"> <!ENTITY content-particle "Q…[¹} [P"> <!ENTITY processor "0×0í0»0µ"> <!ENTITY default "0Ç0Õ0©0ë0È"> <!ENTITY default-value "0Ç0Õ0©0ë0ÈP$"> <!ENTITY header "0Ø0Ã0À"> <!ENTITY target "0¿0ü0²0Ã0È"> <!ENTITY mixed-content "m÷TQ…[¹"> <!ENTITY country-code "Vý0³0ü0É"> <!ENTITY language-code "ŠŠž0³0ü0É"> <!ENTITY version "rH"> <!-- version 1.00o{,1.0rH --> <!ENTITY match "0Þ0Ã0Á"> <!ENTITY character-value "e‡[WujS÷"> <!ENTITY byte-order-mark "0Ð0¤0Ș0Þ0ü0¯"> <!ENTITY bypass "Qæt0W0j0D"> <!ENTITY identifier "‹XR%[P"> <!-- <!ENTITY identify "‹XR%0Y0‹"> --> <!ENTITY identify "ry[š0Y0‹"> <!-- <!ENTITY identified "‹XR%0U0Œ0‹"> --> <!ENTITY identified "ry[š0U0Œ0‹"> <!ENTITY combining-character "}PTe‡[W"> <!ENTITY subset "0µ0Ö0»0Ã0È"> <!ENTITY token "0È0ü0¯0ó"> <!ENTITY literal "0ê0Æ0é0ë"> <!ENTITY parenthesis "0K0c0S"> <!ENTITY left-parenthesis "•‹0M0K0c0S"> <!ENTITY right-parenthesis "•‰0X0K0c0S"> <!-- 0B0h0gl0L0d0D0_0‚0n JIS X02210’‰‹0‹_ʼn0B0Š --> <!ENTITY extender "0¨0¯0¹0Æ0ó0À"> <!ENTITY property "0×0í0Ñ0Æ0£"> <!ENTITY property-list "0×0í0Ñ0Æ0£0ê0¹0È"> <!ENTITY property-file "0×0í0Ñ0Æ0£0Õ0¡0¤0ë"> <!ENTITY font-decomposition "0Õ0©0ó0ÈR‰ã"> <!ENTITY compatibility-decomposition "N’cÛ`'R‰ã"> <!ENTITY compatibility-area "N’cÛ`'˜Wß"> <!ENTITY language-identification "ŠŠž‹XR%"> <!ENTITY space-character "0¹0Ú0ü0¹e‡[W"> <!ENTITY space "0¹0Ú0ü0¹"> <!ENTITY code-value "0³0ü0ÉP$"> <!ENTITY normative "‰[š0n"> <!ENTITY hueristics "0Ò0å0ü0ê0¹0Æ0£0Ã0¯"> <!ENTITY informative ""> <!ENTITY WebSGML 'ISO 88790x0nWebSGML&adaptations-annex;'> <!ENTITY XML.version "1.0"> <!ENTITY doc.date "1997^t12g8eå"> <!ENTITY iso6.doc.date "971208"> <!ENTITY w3c.doc.date "97^t12g3eå"> <!ENTITY draft.day '8eå'> <!ENTITY draft.month '12g'> <!ENTITY draft.year '1997^t'> <!-- eåg,ŠžŠ30n0_00n‰ãg[þŒa[ŸOSÿ0S0S0~0gÿ --> <!-- LAST TOUCHED BY: Tim Bray, 3 Dec 1997 --> <!-- The words 'FINAL EDIT' in comments mark places where changes need to be made after approval of the document by the ERB, before publication. --> <!ENTITY XML.version "1.0"> <!ENTITY doc.date "8 December 1997"> <!ENTITY iso6.doc.date "971208"> <!ENTITY w3c.doc.date "03-Dec-97"> <!ENTITY draft.day '8'> <!ENTITY draft.month 'December'> <!ENTITY draft.year '1997'> <!ENTITY WebSGML 'WebSGML Adaptations Annex to ISO 8879'> <!ENTITY newline " "> <!-- old: <!ENTITY newline "&#8232;"> --> <!ENTITY gt ">"> <!--<!ENTITY amp "&"> --> <!ENTITY xmlpio "'&lt;?xml'"> <!ENTITY pic "'?>'"> <!ENTITY br "\n"> <!ENTITY cellback '#c0d9c0'> <!ENTITY mdash "--"> <!-- was: <!ENTITY mdash "&#38;#151;"> --> <!ENTITY com "--"> <!ENTITY como "--"> <!ENTITY comc "--"> <!ENTITY hcro "&amp;#x"> <!-- <!ENTITY nbsp ""> --> <!ENTITY nbsp "&#160;"> <!ENTITY magicents "<code>amp</code>, <code>lt</code>, <code>gt</code>, <code>apos</code>, <code>quot</code>"> <!--eåg,ŠžŠ30k0d0D0f: 0³0á0ó0È0oûŠ3[þŒa0K0‰Y0W0~0W0_0’4g(TŒY+ --> <!-- audience and distribution status: for use at publication time --> <!-- --> <!ENTITY doc.audience "Ql•‹0ì0Ó0å0üSÊ0s‹pŠÖ"> <!ENTITY doc.distribution "0Æ0­0¹0ÈSÊ0slÕ_‹N 0nlèa0’e9Y 0W0j0D–P0Šÿ êu10k‘M^0W0f0‚0ˆ0D"> ]> <!-- for Panorama *--> <?VERBATIM "eg" ?> <spec> <header> <title>bá_5Sï€ý0j&markup;ŠŠž (XML)</title> <version>{,1.0&version;</version> <w3c-designation>PR-xml-&iso6.doc.date;</w3c-designation> <w3c-doctype>World Wide Web Consortium</w3c-doctype> <pubdate><day>&draft.day;</day><month>&draft.month;</month><year>&draft.year;</year></pubdate> <notice><p>0S0nƒIhH0oÿ XML WGSÊ0sNÖ0n•¢O€0k0ˆ0‹0ì0Ó0å0ü0n0_00n0‚0n0g0B0c0fÿ Ql•‹0n‹pŠÖ0n0_00n0‚0n0g0o0j0D0 <!-- FINAL EDIT: FIX --></p></notice> <publoc> <loc href="http://www.w3.org/TR/PR-xml-&iso6.doc.date;"> http://www.w3.org/TR/PR-xml-&iso6.doc.date;</loc></publoc> <prevlocs> <loc href='http://www.w3.org/TR/WD-xml-961114'> http://www.w3.org/TR/WD-xml-961114</loc> <loc href='http://www.w3.org/TR/WD-xml-lang-970331'> http://www.w3.org/TR/WD-xml-lang-970331</loc> <loc href='http://www.w3.org/TR/WD-xml-lang-970630'> http://www.w3.org/TR/WD-xml-lang-970630</loc> <loc href='http://www.w3.org/TR/WD-xml-970807'> http://www.w3.org/TR/WD-xml-970807</loc> <loc href='http://www.w3.org/TR/WD-xml-971117'> http://www.w3.org/TR/WD-xml-971117</loc> </prevlocs> <authlist> <author><name>Tim Bray</name> <affiliation>Textuality and Netscape</affiliation> <email href="mailto:tbray@textuality.com">tbray@textuality.com</email></author> <author><name>Jean Paoli</name> <affiliation>Microsoft</affiliation> <email href="mailto:jeanpa@microsoft.com">jeanpa@microsoft.com</email></author> <author><name>C. M. Sperberg-McQueen</name> <affiliation>University of Illinois at Chicago</affiliation> <email href="mailto:cmsmcq@uic.edu">cmsmcq@uic.edu</email></author> </authlist> <status> <p>0S0n&TR-or-Rec;0o, 1997^t12g0kWorld Wide Web Consortium0K0‰ Qlˆh0U0Œ0_RçTJhHExtensible Markup Language version{,1.0rH0’ûŠ30W, b€ ˆSv„Q…[¹0’Y fô0Y0‹0S0h0j0OO\b0W0_&TR-or-Rec;0g0B0‹0This &eTR-or-Rec; is a translation of the XML proposed recommendation 1.0 published by the World Wide Web Consortium in December 1997. It is intended that &eTR-or-Rec; is technically identical to the original.</p> <p>SŸe‡0k0B0‹0„WO\j)0k•¢0W0f0nŠð0’k!0ky:0Y0The original copyright notice is shown below:</p> <p>0S0nrH0nXML0n‰[š0oÿ Ql•‹0ì0Ó0å0üSÊ0s‹pŠÖ0’ vîv„0h0Y0‹00Æ0­0¹0ÈSÊ0slÕ_‹N 0nlèa0’e9Y 0W0j0D–P0Šÿ êu10k ‘M^0W0f0‚0ˆ0D0This version of the XML specification is for public review and discussion. It may be distributed freely, as long as all text and legal notices remain intact.</p> <p>0S0n&TR-or-Rec;0nQC0h0j0c0_XMLRçTJhH0oÿ 1998^t2g0kWorld Wide Web Consortium0K0‰Qlˆh0U0Œ0_XMLRçTJ0k0ˆ0c0f0Y0g0kn0McÛ 0H0‰0Œ0f0D0‹00S0njn–`ÅX10oÿ XMLRçTJ0k_“0c0fŠkc0Y0‹0S0h0’ Nˆ[š0W0f0D0‹0The XML Proposed Recommendation is superseded by the XML Recommendation which was published by the World Wide Web Consortium in February 1998. It is intended that this &eTR-or-Rec; be revised accordingly in the near future.</p> <p>0S0n&TR-or-Rec;0oÿ [‰[š0W0_0‚0n0g0B0c0fÿ f(^tge0n<loc href='http://www.w3.org/XML'>XMLm;RÕ</loc>0’0X0fO\b0U0Œ0_ÿ N#0nO\ imƒIhH0’QC0h0Y0‹0sþW(ÿ ^ƒ{ÄVò0kOu(0U0Œ0f0D0‹Vý–›v„0j0Æ0­0¹0ÈQæt0nj n–(jn–N‚,S&markup;ŠŠžÿ Standard Generalized Markup Language, ISO 8879:19860kýR SÊ0sŠkc0’R 0H0_0‚0n)0nÿ WWWN 0g0nOu(0n0_00k&subset; S0W0_ŠŠž0’ÿ 0S0n&TR-or-Rec;0oÿ ‰[š0Y0‹0ISO 88790n0i0nj_€ý0’0S0n &subset;0kk‹0Y0Kÿ 0h0D0Flz[š0k0d0D0f0nŠs}00oÿ <loc href='http://www.w3.org/XML/#WG-decisions'>R%u(a0Y0‹</loc>0XML0oÿ eâ0k0D0O0d0K0nUFTÁ0g0µ0Ý0ü0È0U0Œÿ XML0’0µ0Ý0ü0È0Y0‹<loc href='http://www.w3.org/XML/#software'>0Õ0ê0ü0¦0§0¢</loc>0nep0‚X—0H0f 0D0‹0XML0k•¢0Y0‹Ql•‹0nŠÖ‹p0‚ÿ 0ª0ó0é0¤0ó0g<loc href='http://www.w3.org/XML/#discussion'>QebK0g0M0‹</loc>0It is a stable document derived from a series of working drafts produced over the last year as deliverables of the <loc href='http://www.w3.org/XML'>XML activity</loc>. It specifies a language created by subsetting an existing, widely used international text processing standard (Standard Generalized Markup Language, ISO 8879:1986 as amended and corrected) for use on the World Wide Web. Details of the decisions regarding which features of ISO 8879 to retain in the subset <loc href='http://www.w3.org/XML/#WG-decisions'>are available separately</loc>. XML is already supported by some commercial products, and there are a growing number of <loc href='http://www.w3.org/XML/#software'>free implementations</loc>. Public discussions of XML <loc href='http://www.w3.org/XML/#discussion'>are accessible online</loc>.</p> <p>0S0n&TR-or-Rec;0g0oÿ <bibref ref="Berners-Lee"/>0k[š©0Y0‹ URI(Uniform Resource Identifier)0’Ou(0Y0‹0URI0nR6[šO\im0o2ˆLN-0g0B0c 0fÿ <bibref ref="RFC1738"/>SÊ0s<bibref ref="RFC1808"/>0’fôe°0Y0‹Nˆ[š0h 0j0c0f0D0‹00S0nO\im0LRFC0h0W0fS×0QQe0Œ0‰0Œ0j0DX4T0oÿ 0S0n‰z Q…0nURI 0x0nSÂqg0oÿ URL(Uniform Resource Locator)0x0nSÂqg0kNã00‹0This specification uses the term URI, which is defined by <bibref ref="Berners-Lee"/>, a work in progress expected to update <bibref ref="RFC1738"/> and <bibref ref="RFC1808"/>. Should the work not be accepted as an RFC, the references to uniform resource identifiers (URIs) in this specification will become references to uniform resource locators (URLs).</p> <p>XML0nNÕiØ0kn–bà0W0f0D0‹0K0i0F0K0nWún–0h0j0‹0oW3C0n0µ0¤0È0k0B 0‹SŸe‡0g0B0‹0The normative version of the specification is the English version found at the W3C site.</p> <p>0S0njn–`ÅX10oSŸNÕiØ0hb€ˆSv„0kT N0g0B0‹0S0h0’aVó0W0f0D0‹0L0 ûŠ3N 0nŠ¤0Š0o0B0Š_—0‹0Although this technical report is intended to be technically identical to the original, it may contain errors from the translation.</p> <p>P™€: SŸ‰[š0h0n‰[š{‡b@0n[þ_Ü•¢OÂ0’f0‰0K0k0Y0‹0_000S0n &TR-or-Rec;0n{ÀiËbSÊ0s{ÀujS÷0o0SŸ‰[š0n0]0Œ0‰0’0g0M0‹0`0QOÝ[X0W0f0D 0‹00S0n&TR-or-Rec;0nWebrH0o0SŸ‰[š0nHTML0¿0°0’0]0n0~0~OÝ[X0W0f0D0‹0 </p> </status> <!-- out of date <statusp>This is a W3C Working Draft for review by W3C members and other interested parties. It is a draft document and may be updated, replaced, or obsoleted by other documents at any time. It is inappropriate to use W3C Working Drafts as reference material or to cite them as other than "work in progress". A list of current W3C working drafts can be found at <loc href="http://www.w3.org/TR">http://www.w3.org/TR</loc>.</statusp> <statusp><emph>Note:</emph> Since working drafts are subject to frequent change, you are advised to reference the above URL, rather than the URLs for working drafts themselves.</statusp> <statusp>This work is part of the W3C SGML Activity (for current status, see <loc href="http://www.w3.org/MarkUp/SGML/Activity" >http://www.w3.org/MarkUp/SGML/Activity</loc>).</statusp> <p>The current draft of this specification presupposes the successful completion of the current work on the &WebSGML;, being prepared by ISO/IEC JTC1 at the time this draft specification was drafted. If it is not adopted in the expected form, some clauses of this specification may change, and some recommendations now labeled "<termref def="dt-interop">for interoperability</termref>" will become requirements labeled "<termref def="dt-compat">for compatibility</termref>". </p> <p>The current draft of this specification uses the term URI, which is defined by <bibref ref="Berners-Lee"/>, which is work in progress expected to update <bibref ref="RFC1738"/> and <bibref ref="RFC1808"/>. Should the work in this draft not be accepted as an RFC, the references to uniform resource identifiers (URIs) in this specification will become references to uniform resource locators (URLs).</p> </status> --> <abstract> <p>bá_5Sï€ý0j&markup;ŠŠž(XML)0oSGML0n|!SX0je¹Š0g0B0c0fÿ 0S0n&TR-or-Rec;0gÿ 0]0n0Y0y0f0’‰[š0Y0‹0XML0nvîj0oÿ sþW(0nHTML0hT iØ0kÿ N‚,`'0n0B0‹SGML0’0¦0§0ÖN 0g‘M^ÿ S×OáSÊ0sQæt0g0M0‹0S0h0h0Y0‹0XML0o[ŸˆÅ0L[¹f0g0B0c0fÿ SGMLSÊ0sHTML0n0i0a0‰0k[þ0W0f0‚vøN’Ku(`'0’OÝ0dŠ-Š0L0j0U0Œ0f0D0‹0</p> </abstract> <pubstmt> <p>Chicago, Vancouver, Mountain View, et al.: World-Wide Web Consortium, XMLO\im0°0ë0ü0×, 1996, 1997.</p> </pubstmt> <sourcedesc> <p>Created in electronic form.</p> </sourcedesc> <langusage> <language id='EN'>English</language> <language id='ebnf'>Extended Backus-Naur Form (formal grammar)</language> </langusage> <revisiondesc> <slist> <sitem>1997-12-03 : CMSMcQ : yet further changes</sitem> <sitem>1997-12-02 : TB : further changes (see TB to XML WG, 2 December 1997)</sitem> <sitem>1997-12-02 : CMSMcQ : deal with as many corrections and comments from the proofreaders as possible: entify hard-coded document date in pubdate element, change expansion of entity WebSGML, update status description as per Dan Connolly (am not sure about refernece to Berners-Lee et al.), add 'The' to abstract as per WG decision, move Relationship to Existing Standards to back matter and combine with References, re-order back matter so normative appendices come first, re-tag back matter so informative appendices are tagged informdiv1, remove XXX XXX from list of 'normative' specs in prose, move some references from Other References to Normative References, add RFC 1738, 1808, and 2141 to Other References (they are not normative since we do not require the processor to enforce any rules based on them), add reference to 'Fielding draft' (Berners-Lee et al.), move notation section to end of body, drop URIchar non-terminal and use SkipLit instead, lose stray reference to defunct nonterminal 'markupdecls', move reference to Aho et al. into appendix (Tim's right), add prose note saying that hash marks and fragment identifiers are NOT part of the URI formally speaking, and are NOT legal in system identifiers (processor 'may' signal an error). Work through: Tim Bray reacting to James Clark, Tim Bray on his own, Eve Maler, NOT DONE YET: change binary / text to unparsed / parsed. handle James's suggestion about &lt; in attriubte values uppercase hex characters, namechar list, </sitem> <sitem>1997-12-01 : JB : add some column-width parameters</sitem> <sitem>1997-12-01 : CMSMcQ : begin round of changes to incorporate recent WG decisions and other corrections: binding sources of character encoding info (27 Aug / 3 Sept), correct wording of Faust quotation (restore dropped line), drop SDD from EncodingDecl, change text at version number 1.0, drop misleading (wrong!) sentence about ignorables and extenders, modify definition of PCData to make bar on msc grammatical, change grammar's handling of internal subset (drop non-terminal markupdecls), change definition of includeSect to allow conditional sections, add integral-declaration constraint on internal subset, drop misleading / dangerous sentence about relationship of entities with system storage objects, change table body tag to htbody as per EM change to DTD, add rule about space normalization in public identifiers, add description of how to generate our name-space rules from Unicode character database (needs further work!). </sitem> <sitem>1997-10-08 : TB : Removed %-constructs again, new rules for PE appearance.</sitem> <sitem>1997-10-01 : TB : Case-sensitive markup; cleaned up element-type defs, lotsa little edits for style</sitem> <sitem>1997-09-25 : TB : Change to elm's new DTD, with substantial detail cleanup as a side-effect</sitem> <sitem>1997-07-24 : CMSMcQ : correct error (lost *) in definition of ignoreSectContents (thanks to Makoto Murata)</sitem> <sitem>Allow all empty elements to have end-tags, consistent with SGML TC (as per JJC).</sitem> <sitem>1997-07-23 : CMSMcQ : pre-emptive strike on pending corrections: introduce the term 'empty-element tag', note that all empty elements may use it, and elements declared EMPTY must use it. Add WFC requiring encoding decl to come first in an entity. Redefine notations to point to PIs as well as binary entities. Change autodetection table by removing bytes 3 and 4 from examples with Byte Order Mark. Add content model as a term and clarify that it applies to both mixed and element content. </sitem> <sitem>1997-06-30 : CMSMcQ : change date, some cosmetic changes, changes to productions for choice, seq, Mixed, NotationType, Enumeration. Follow James Clark's suggestion and prohibit conditional sections in internal subset. TO DO: simplify production for ignored sections as a result, since we don't need to worry about parsers which don't expand PErefs finding a conditional section.</sitem> <sitem>1997-06-29 : TB : various edits</sitem> <sitem>1997-06-29 : CMSMcQ : further changes: Suppress old FINAL EDIT comments and some dead material. Revise occurrences of % in grammar to exploit Henry Thompson's pun, especially markupdecl and attdef. Remove RMD requirement relating to element content (?). </sitem> <sitem>1997-06-28 : CMSMcQ : Various changes for 1 July draft: Add text for draconian error handling (introduce the term Fatal Error). RE deleta est (changing wording from original announcement to restrict the requirement to validating parsers). Tag definition of validating processor and link to it. Add colon as name character. Change def of %operator. Change standard definitions of lt, gt, amp. Strip leading zeros from #x00nn forms.</sitem> <sitem>1997-04-02 : CMSMcQ : final corrections of editorial errors found in last night's proofreading. Reverse course once more on well-formed: Webster's Second hyphenates it, and that's enough for me.</sitem> <sitem>1997-04-01 : CMSMcQ : corrections from JJC, EM, HT, and self</sitem> <sitem>1997-03-31 : Tim Bray : many changes</sitem> <sitem>1997-03-29 : CMSMcQ : some Henry Thompson (on entity handling), some Charles Goldfarb, some ERB decisions (PE handling in miscellaneous declarations. Changed Ident element to accept def attribute. Allow normalization of Unicode characters. move def of systemliteral into section on literals.</sitem> <sitem>1997-03-28 : CMSMcQ : make as many corrections as possible, from Terry Allen, Norbert Mikula, James Clark, Jon Bosak, Henry Thompson, Paul Grosso, and self. Among other things: give in on "well formed" (Terry is right), tentatively rename QuotedCData as AttValue and Literal as EntityValue to be more informative, since attribute values are the <emph>only</emph> place QuotedCData was used, and vice versa for entity text and Literal. (I'd call it Entity Text, but 8879 uses that name for both internal and external entities.)</sitem> <sitem>1997-03-26 : CMSMcQ : resynch the two forks of this draft, reapply my changes dated 03-20 and 03-21. Normalize old 'may not' to 'must not' except in the one case where it meant 'may or may not'.</sitem> <sitem>1997-03-21 : TB : massive changes on plane flight from Chicago to Vancouver</sitem> <sitem>1997-03-21 : CMSMcQ : correct as many reported errors as possible. </sitem> <sitem>1997-03-20 : CMSMcQ : correct typos listed in CMSMcQ hand copy of spec.</sitem> <sitem>1997-03-20 : CMSMcQ : cosmetic changes preparatory to revision for WWW conference April 1997: restore some of the internal entity references (e.g. to docdate, etc.), change character xA0 to &amp;nbsp; and define nbsp as &amp;#160;, and refill a lot of paragraphs for legibility.</sitem> <sitem>1996-11-12 : CMSMcQ : revise using Tim's edits: Add list type of NUMBERED and change most lists either to BULLETS or to NUMBERED. Suppress QuotedNames, Names (not used). Correct trivial-grammar doc type decl. Rename 'marked section' as 'CDATA section' passim. Also edits from James Clark: Define the set of characters from which [^abc] subtracts. Charref should use just [0-9] not Digit. Location info needs cleaner treatment: remove? (ERB question). One example of a PI has wrong pic. Clarify discussion of encoding names. Encoding failure should lead to unspecified results; don't prescribe error recovery. Don't require exposure of entity boundaries. Ignore white space in element content. Reserve entity names of the form u-NNNN. Clarify relative URLs. And some of my own: Correct productions for content model: model cannot consist of a name, so "elements ::= cp" is no good. </sitem> <sitem>1996-11-11 : CMSMcQ : revise for style. Add new rhs to entity declaration, for parameter entities.</sitem> <sitem>1996-11-10 : CMSMcQ : revise for style. Fix / complete section on names, characters. Add sections on parameter entities, conditional sections. Still to do: Add compatibility note on deterministic content models. Finish stylistic revision.</sitem> <sitem>1996-10-31 : TB : Add Entity Handling section</sitem> <sitem>1996-10-30 : TB : Clean up term &amp; termdef. Slip in ERB decision re EMPTY.</sitem> <sitem>1996-10-28 : TB : Change DTD. Implement some of Michael's suggestions. Change comments back to //. Introduce language for XML namespace reservation. Add section on white-space handling. Lots more cleanup.</sitem> <sitem>1996-10-24 : CMSMcQ : quick tweaks, implement some ERB decisions. Characters are not integers. Comments are /* */ not //. Add bibliographic refs to 10646, HyTime, Unicode. Rename old Cdata as MsData since it's <emph>only</emph> seen in marked sections. Call them attribute-value pairs not name-value pairs, except once. Internal subset is optional, needs '?'. Implied attributes should be signaled to the app, not have values supplied by processor.</sitem> <sitem>1996-10-16 : TB : track down &amp; excise all DSD references; introduce some EBNF for entity declarations.</sitem> <sitem>1996-10-?? : TB : consistency check, fix up scraps so they all parse, get formatter working, correct a few productions.</sitem> <sitem>1996-10-10/11 : CMSMcQ : various maintenance, stylistic, and organizational changes: Replace a few literals with xmlpio and pic entities, to make them consistent and ensure we can change pic reliably when the ERB votes. Drop paragraph on recognizers from notation section. Add match, exact match to terminology. Move old 2.2 XML Processors and Apps into intro. Mention comments, PIs, and marked sections in discussion of delimiter escaping. Streamline discussion of doctype decl syntax. Drop old section of 'PI syntax' for doctype decl, and add section on partial-DTD summary PIs to end of Logical Structures section. Revise DSD syntax section to use Tim's subset-in-a-PI mechanism.</sitem> <sitem>1996-10-10 : TB : eliminate name recognizers (and more?)</sitem> <sitem>1996-10-09 : CMSMcQ : revise for style, consistency through 2.3 (Characters)</sitem> <sitem>1996-10-09 : CMSMcQ : re-unite everything for convenience, at least temporarily, and revise quickly</sitem> <sitem>1996-10-08 : TB : first major homogenization pass</sitem> <sitem>1996-10-08 : TB : turn "current" attribute on div type into CDATA</sitem> <sitem>1996-10-02 : TB : remould into skeleton + entities</sitem> <sitem>1996-09-30 : CMSMcQ : add a few more sections prior to exchange with Tim.</sitem> <sitem>1996-09-20 : CMSMcQ : finish transcribing notes.</sitem> <sitem>1996-09-19 : CMSMcQ : begin transcribing notes for draft.</sitem> <sitem>1996-09-13 : CMSMcQ : made outline from notes of 09-06, do some housekeeping</sitem> </slist> </revisiondesc> </header> <body> <div1 id='sec-intro'> <head>N‚,N‹˜</head> <!-- <div2 id='sec-scope'> <head>iu({ÄVò</head> --> <p>bá_5Sï€ý0j&markup;ŠŠžXML(eXtensible Markup Language)0oÿ <termref def="dt-xml-doc">XMLe‡fø</termref>0h0D0F0Ç0ü0¿0ª0Ö0¸0§0¯0È0n0¯0é0¹0’‰[š0Wÿ XMLe‡fø0’Qæt0Y0‹0×0í0°0é0à0nRÕO\0nNè0’‰[š0Y0‹0XML0oÿ SGML(jn–N‚,S&markup;ŠŠžÿ Standard Generalized Markup Language)<bibref ref='ISO8879'/>0nR6–P0W0_&subset;0h0Y0‹0iË N ÿ XMLe‡fø0oÿ 0K0j0‰0ZSGML‰h<0kiT0Y0‹0</p> <p>XMLe‡fø0oÿ <termref def="dt-entity">[ŸOS</termref>0h0D0FŠa¶SXOM0K0‰0j0Šÿ [ŸOS0oÿ &parsed-data;SÈ0o&unparsed-data;0K0‰0j0‹0&parsed-data;0oÿ <termref def="dt-character">e‡[W</termref>0K0‰0j0Šÿ 0]0nNè0oÿ e‡fø0n<termref def="dt-chardata">e‡[W0Ç0ü0¿</termref>0’iËb0Wÿ Nè0oÿ <termref def="dt-markup">&markup;</termref>0’iËb0Y0‹0&markup;0oÿ e‡fø0nŠa¶0ì0¤0¢0¦0ÈSÊ0sŠÖtiË 0k0d0D0f0nŠð0’ˆh0Y{&S÷0h0Y0‹0XML0oÿ Ša¶0ì0¤0¢0¦0ÈSÊ0sŠÖtiË 0k0d0D0f0nR6}gaNö0’Šð0Y0‹j_iË0’cÐO›0Y0‹0</p> <p><termdef id="dt-xml-proc" term="XML&processor;"><term>XML&processor;</term>0h0D0F0½0Õ0È0¦0§0¢0â0¸0å0ü0ë0oÿ XMLe‡fø0’Š­0¼0ÿ 0]0nQ…[¹SÊ0siË 0x0n0¢0¯0»0¹0’cÐO›0Y0‹0_00ku(0D0‹0 </termdef> <termdef id="dt-app" term="&application;">XML&processor;0oÿ NÖ0n0â0¸0å0ü0ë0n0_00kRÕO\0Y0‹0S0h0’RMcÐ0h0Wÿ 0]0n0â0¸0å0ü0ë0’<term>&application;</term>0h0D0F0</termdef>0S0n&TR-or-Rec;0oÿ XML&processor;0LˆL00j0Q0Œ0p0j0‰0j0Dc/‚0D0’‰[š0Y0‹00d0~0Šÿ XML0Ç0ü0¿0nŠ­¼0e¹lÕ0’‰[š0Wÿ &application;0kcÐO›0Y0‹`ÅX10’‰[š0Y0‹0</p> <!-- </div2> --> <div2 id='sec-origin-goals'> <head>}L}ïSÊ0svîj</head> <p>1996^t0kWorld Wide Web Consortium(W3C)0nN-0kŠ-zË0W0_XMLO\im0°0ë0ü0×(NåRM0oÿ SGML}è–Æ0ì0Ó0å0üYÔTáO0hT|0p0Œ0_)0Lÿ XML0’•‹vz0W0_00S0nO\im0°0ë0ü0×0n‹p•w0’ÿ Sun Microsystems0nJon Bosak0LRä00‹0W3C0L}D~T0Wÿ NåRM0oSGMLO\im0°0ë0ü0×0hT|0p0Œ0_XML SIG(Special Interest Group)0‚ÿ XML0nR6[š0k—^^80km;vz0kSÂu;0W0_0 <!--JIS0g0o? XMLO\im0°0ë0ü0×0n0á0ó0Ð0’NØ“20ky:0Y0-->Dan Connolly0oÿ O\im0°0ë0ü0×0nW3C0k0J0Q0‹#}aOÂ0’RÙ00_0</p> <p>XML0nŠ-Švîj0’ÿ k!0ky:0Y0<ulist> <item><p>a) XML0oÿ InternetN 0g0]0n0~0~Ou(0g0M0‹0</p></item> <item><p>b) XML0oÿ ^ƒ{ÄVò0n&application;0’e/cô0Y0‹0</p></item> <item><p>c) XML0oÿ SGML0hN’cÛ`'0’0‚0d0</p></item> <item><p>d) XMLe‡fø0’Qæt0Y0‹0×0í0°0é0à0’fø0O0S0h0oÿ [¹f0g0j0Q0Œ0p0j0‰0j0D0</p></item> <item><p>e) XML0g0oÿ 0ª0×0·0ç0ó0nj_€ý0o0g0M0‹0`0Q\0j0O0Wÿ N0d0‚[XW(0W0j0D0S0h0’vîc0Y0</p></item> <item><p>f) XMLe‡fø0oÿ Nº•“0k0h0c0fŠ­00„0Y0Oÿ SAR0kt‰ã0W0„0Y0D0</p></item> <item><p>g) XML0nŠ-Š0oÿ 0Y00„0K0kˆL0H0j0Q0Œ0p0j0‰0j0D0</p></item> <item><p>h) XML0nŠ-Š0oÿ S³[ÆSÊ0s|!oT0g0j0Q0Œ0p0j0‰0j0D0</p></item> <item><p>i) XMLe‡fø0oÿ [¹f0kO\b0g0M0‹0</p></item> <item><p>j) XML0g0oÿ &markup;0nep0’n0‰0Y0S0h0oÿ ‘͉0g0o0j0D0</p></item></ulist> </p> <p>XML{,&XML.version;&version;0’t‰ã0Wÿ 0]0Œ0’Qæt0Y0‹Š{—j_0×0í0°0é0à0’fø0O0_00kSAR0j`ÅX10oÿ 0S0n&TR-or-Rec;SÊ0s•¢#0Y0‹‰h<(e‡[Wu(0h0W0fÿ UnicodeSÊ0sISO/IEC 10646ÿ <!--* XXX for Uniform Resource Identifiers, *-->&language-identification;0¿0°u(0h0W0fÿ 0¤0ó0¿0Í0Ã0È RFC 1766ÿ &language-code;u(0h0W0fÿ ISO 639ÿ N&0s0k&country-code;u(0h0W0fÿ ISO 3166)0gÿ 0Y0y0fy:0Y0</p> <p>0S0n&version;0nXML0n‰[š<!-- (&doc.date;) -->0oÿ Ql•‹0ì0Ó0å0üSÊ0s‹pŠÖ0’vîv„0h0Y0‹00Æ0­0¹0ÈSÊ0slÕ_‹N 0nlèa0’e9Y 0W0j0D–P0Šÿ êu10k‘M^0W0f0‚0ˆ0D0</p> </div2> <div2 id='sec-terminology'> <head>[š©</head> <p>XMLe‡fø0n‰[š0n0_00kOu(0Y0‹u(Šž0oÿ 0S0n&TR-or-Rec;Q…0g[š©0Y0‹0k!0ky:0YŠžSå0oÿ 0]0Œ0‰0nu(Šž0’[š©0Y0‹0_0ÿ SÊ0sXML&processor;0nRÕ0M0’‰[š0Y0‹0_00kOu(0Y0‹0 <glist> <gitem> <label>1.2.1 0W0f0‚0ˆ0D(may)</label> <def><p><termdef id="dt-may" term="0W0f0‚0ˆ0D">iT0Y0‹e‡føSÈ0oXML&processor;0oÿ Šð0U0Œ0_0h0J0Š0kRÕO\0W0f0‚0ˆ0D0Lÿ 0]0n0h0J0Š0k0Y0‹_ʼn0o0j0D0</termdef></p></def> </gitem> <gitem> <label>1.2.2 0W0j0Q0Œ0p0j0‰0j0D(must)</label> <def><p>iT0Y0‹e‡føSÈ0oXML&processor;0oÿ Šð0U0Œ0_0h0J0Š0kRÕO\0Y0‹0S0h0L‰lB0U0Œ0‹00]0F0g0j0Q0Œ0pÿ &error;0h0Y0‹0<!-- do NOT change this! this is what defines a violation ofa 'must' clause as 'an error'. -MSM --> </p></def> </gitem> <gitem> <label>1.2.3 &error;(error)</label> <def><p><termdef id="dt-error" term="&error;">0S0n&TR-or-Rec;0L[š00‹‰RG0k[þ0Y0‹USÍ0}Pgœ0o[š©0W0j0D0iT0Y0‹0½0Õ0È0¦0§0¢0oÿ &error;0’iQú0W0fX1TJ0W0f0‚0ˆ0Oÿ &error;0K0‰VÞ_©0W0f0‚0ˆ0D0</termdef></p></def> </gitem> <gitem> <label>1.2.4 &fatal-error;(fatal error)</label> <def><p><termdef id="dt-fatal" term="&fatal-error;">iT0Y0‹<termref def="dt-xml-proc">XML&processor;</termref>0LiQú0W0j0Q0Œ0p0j0‰0Zÿ &application;0kX1TJ0W0j0Q0Œ0p0j0‰0j0D&error;0&fatal-error;0’vz‰‹0W0_0B0hÿ &processor;0oÿ 0]0ŒNå–M0n&error;0’c¢0Y0_00k0Ç0ü0¿Qæt0’}šˆL0W0f0‚0ˆ0Oÿ &error;0’vz‰‹0W0_X4T0oÿ 0]0n&error;0’&application;0kX1TJ0W0f0‚0ˆ0D0&error;Škc0’0µ0Ý0ü0È0Y0‹0_00kÿ &processor;0oÿ g*Qæt0Ç0ü0¿(e‡[W0Ç0ü0¿SÊ0s&markup;0nm÷W(0W0_0‚0n)0’e‡fø0K0‰SÖ0ŠQú0Wÿ &application;0kn!0W0f0‚0ˆ0D00W0K0Wÿ N^¦ÿ &fatal-error;0’iQú0W0_0‰ÿ &processor;0oÿ ^80nQæt0’}šˆL0W0f0o0j0‰0j0D00d0~0Šÿ &processor;0oÿ e‡[W0Ç0ü0¿SÊ0se‡fø0nŠÖtiË 0k0d0D0f0n`ÅX10’ÿ ^80ne¹lÕ0g&application;0kn!0W}š0Q0f0o0j0‰0j0D0</termdef></p></def> </gitem> <gitem> <label>1.2.5 &at-user-option;(at user option)</label> <def><p>iT0Y0‹0½0Õ0È0¦0¨0¢0oÿ Šð0U0Œ0_0h0J0Š0kc/0‹‚0c0f0‚0ˆ0D(may)ÿ SÈ0oc/0‹‚00j0O0f0o0j0‰0j0D(must)(e‡zàN-0nR©RÕŠ^0k0ˆ0‹0)00]0n0h0J0Š0kc/0‹‚0FX4T0oÿ Šð0U0Œ0_c/‚0D0’xbžSÈ0obÒT&0Y0‹bKkµ0’&user;0kcÐO›0W0j0Q0Œ0p0j0‰0j0D0</p></def> </gitem> <gitem> <label>1.2.6 &validity;R6}(validity constraint)</label> <def><p>0Y0y0f0n<termref def="dt-valid">&valid;0j</termref>XMLe‡fø0kiu(0Y0‹‰RG0&validity;R6}0nUSÍ0oÿ &error;0h0Y0‹0&at-user-option;ÿ <termref def="dt-validating">iŠ<0’ˆL0FXML&processor;</termref>0oÿ 0S0n&error;0’X1TJ0W0j0Q0Œ0p0j0‰0j0D0</p></def> </gitem> <gitem> <label>1.2.7 &well-formed;R6}(well-formedness constraint)</label> <def><p>0Y0y0f0n<termref def="dt-wellformed">&well-formed;</termref>0nXMLe‡fø0kiu(0Y0‹‰RG0&well-formed;R6}0nUSÍ0oÿ <termref def="dt-fatal">&fatal-error;</termref>0h0Y0‹0</p></def> </gitem> <gitem> <label>1.2.8 &match;(match)</label> <def><p>a) <termdef id="dt-match" term="&match;">&string;SÈ0oT RM0n&match;0kÔ0Y0‹NŒ0d0n&string;SÈ0oT RM0oÿ T N0g0j0Q0Œ0p0j0‰0j0D0ISO/IEC 106460k0J0D0fÿ ‰ep0nˆhsþ0LSï€ý0je‡[Wÿ;O‹0H0pÿ &composed-form;SÊ0sWú^•+&diacritical-mark;(0À0¤0¢0¯0ê0Æ0£0«0ë0Þ0ü0¯)_b_ÿ=0oÿ 0i0a0‰0n&string;0‚T 0Xˆhsþ0n0h0M0k–P0Šÿ &match;0Y0‹0&at-user-option;ÿ &processor;0oÿ 0]0ne‡[W0’jn–_b0kkc‰S0W0f0‚0ˆ0D0kÔ0n0h0M0Y'e‡[W0h\e‡[W0h0nS:R%0’0Y0‹0<!-- Note that no processing of characters with respect to case is part of the matching process. -->&lt;BR>b) &string;0he‡lÕN-0n‰RG0h0n&match;00B0‹ub‰RG0K0‰ub0Y0‹ŠŠž0kÿ 0B0‹&string;0L\^0Y0‹0h0Mÿ 0S0n&string;0oÿ 0S0nub‰RG0k&match;0Y0‹0h0D0F0&lt;BR>c) Q…[¹0hQ…[¹0â0Ç0ë0h0n&match;00B0‹‰} 0Lÿ <titleref href='elementvalid'>‰} 0n&validity;</titleref>0nR6}0ky:0YaTs0giT0Y0‹0h0Mÿ 0S0n‰} 0oÿ 0]0n[£Š0k&match;0Y0‹0h0D0F0</termdef></p></def> </gitem> <gitem> <label>1.2.9 N’cÛ`'0n0_0(for compatibility)</label> <def><p><termdef id="dt-compat" term="N’cÛ`'0n0_0">XML0nj_€ý0g0B0c0fÿ XML0LSGML0hN’cÛ0g0B0‹0S0h0’OÝŠ<0Y0‹0_00`0Q0k\Qe0U0Œ0‹0‚0n0</termdef></p></def> </gitem> <gitem> <label>1.2.10 vøN’Ku(`'0n0_0(for interoperability)</label> <def><p><termdef id="dt-interop" term="vøN’Ku(`'0n0_0">bØg_R›0o0‚0_0j0Dc¨YhN‹˜0&WebSGML;NåRM0K0‰[XW(0Y0‹SGML&processor;0Lÿ XMLe‡fø0’Qæt0g0M0‹Sï€ý`'0’šØ00‹0_00kSÖ0ŠQe0Œ0‹0‚0n0</termdef></p></def> </gitem> </glist> </p> </div2> </div1> <!-- &Docs; --> <div1 id='sec-documents'> <head>e‡fø</head> <p><termdef id="dt-xml-doc" term="XMLe‡fø"> <!-- A textual object --> 0S0n&TR-or-Rec;0g[š©0Y0‹aTs0gÿ <termref def="dt-wellformed">&well-formed;</termref>0h0Y0‹0Ç0ü0¿0ª0Ö0¸0§0¯0È0’ÿ <term>XMLe‡fø</term>0h0D0F0&well-formed;0nXMLe‡fø0Lÿ 0U0‰0kÿ 0B0‹R6}gaNö0’n€³0Y0Œ0pÿ <termref def="dt-valid">&valid;</termref>0jXMLe‡fø0h0Y0‹0 </termdef></p> <!-- why this div? -TB <div2 id='sec-log-phys'> <head>Logical and Physical Structure</head> --> <p>0D0Z0Œ0nXMLe‡fø0‚ÿ ŠÖtiË SÊ0sritiË 0’0‚0d0ritv„0k0oÿ e‡fø0oÿ <termref def="dt-entity">[ŸOS</termref>0hT|0vSXOM0K0‰0j0‹00B0‹[ŸOS0oÿ e‡føQ…0kNÖ0n[ŸOS0’T+0€0_00kÿ 0]0nNÖ0n[ŸOS0’<termref def="dt-entref">SÂqg</termref>0W0f0‚0ˆ0D0e‡fø0oÿ 0ë0ü0È 0Y0j00a<termref def="dt-docent">e‡fø[ŸOS</termref>0K0‰YË0~0‹0ŠÖtv„0k0oÿ e‡fø0oÿ [£Šÿ ‰} ÿ 0³0á0ó0Èÿ e‡[WSÂqgSÊ0sQætT}Nä0’T+0ÿ 0S0Œ0‰0Y0y0f0oÿ e‡føQ…0gfy:v„0j&markup;0k0ˆ0c0fy:0Y0ŠÖtiË SÊ0sritiË 0oÿ <titleref href="wf-entities">Nå–M</titleref>0ky:0Y0h0J0Š0kÿ S³[Æ0kQe0Œ[P0k0j0c0f0D0j0Q0Œ0p0j0‰0j0D0</p> <!-- </div2> --> <div2 id='sec-well-formed'> <head>&well-formed;0nXMLe‡fø</head> <p><termdef id="dt-wellformed" term="&well-formed;">0B0‹0Æ0­0¹0È0ª0Ö0¸0§0¯0È0Lÿ k!0n0D0Z0Œ0K0n0h0Mÿ 0]0n0Æ0­0¹0È0ª0Ö0¸0§0¯0È0’&well-formed;0nXMLe‡fø0hT|0v0</termdef> <ulist> <item><p>a) QhOS0h0W0fÿ <nt def='NT-document'>document</nt>0h0D0F0é0Ù0ë0’0‚0dub‰RG0k&match;0Y0‹0</p></item> <item><p>b) 0S0n&TR-or-Rec;0g[š©0Y0‹ÿ 0Y0y0f0n&well-formed;R6}0k_“0F0</p> </item> <item><p>c) 0]0Œ0^0Œ0n<termref def='dt-parsedent'>&parsed-entity;</termref>0Lÿ <titleref href='wf-entities'>&well-formed;</titleref>0h0j0‹0</p></item> </ulist></p> <p> <scrap lang='ebnf' id='document'> <head>e‡fø</head> <prod id='NT-document'><lhs>document</lhs> <rhs><nt def='NT-prolog'>prolog</nt> <nt def='NT-element'>element</nt> <nt def='NT-Misc'>Misc</nt>*</rhs></prod> </scrap> </p> <p><nt def="NT-document">document</nt>ub‰RG0k&match;0Y0‹0h0oÿ k!0’aTs0Y0‹0 <ulist> <item><p>a) N0dNåN 0n<termref def="dt-element">‰} </termref>0’T+0€0</p> </item> <!--* N.B. some readers (notably JC) find the following paragraph awkward and redundant. I agree it's logically redundant: it *says* it is summarizing the logical implications of matching the grammar, and that means by definition it's logically redundant. I don't think it's rhetorically redundant or unnecessary, though, so I'm keeping it. It could however use some recasting when the editors are feeling stronger. -MSM *--> <item><p>b) <termdef id="dt-root" term="0ë0ü0ȉ} "><term>0ë0ü0È</term>SÈ0oe‡fø‰} 0h0D0F‰} 0LN0d0`0Q[XW(0Wÿ 0S0Œ0oÿ NÖ0n‰} 0n<termref def="dt-content">Q…[¹</termref>0kT+0~0Œ0j0D0</termdef>0S0ŒNåY0n0Y0y0f0n‰} 0oÿ 0]0n•‹YË0¿0°0LNÖ0n‰} 0nQ…[¹0kT+0~0Œ0Œ0pÿ [þ_Ü0Y0‹}BN†0¿0°0‚T 0X‰} 0nQ…[¹0kT+0~0Œ0‹00d0~0Šÿ ‰} 0oÿ •‹YË0¿0°SÊ0s}BN†0¿0°0k0ˆ0c0fS:R0‰0Œÿ Qe0Œ[PiË 0’0j0Y0 </p></item> </ulist> </p> <p><termdef id="dt-parentchild" term="‰ª‰} /[P‰} ">0S0Œ0‰0n}Pgœ0h0W0fÿ e‡føQ…0n0i0n—^0ë0ü0ȉ} <code>C</code>0k[þ0W0f0‚ÿ 0B0‹NÖ0n‰} <code>P</code>0L[XW(0Wÿ <code>C</code>0oÿ <code>P</code>0nQ…[¹0kT+0~0Œ0‹0Lÿ <code>P</code>0nQ…[¹0kT+0~0Œ0‹NÖ0n‰} 0kT+0~0Œ0‹0S0h0o0j0D00S0n0h0Mÿ <code>P</code>0’<code>C</code>0n<code>‰ª</code>0h0D0Dÿ <code>C</code>0’<code>P</code>0n<code>[P</code>0h0D0F0</termdef></p> </div2> <div2 id="charsets"> <head>e‡[W</head> <p> <!--The data stored in an XML <termref def="dt-entity">entity</termref> is either <termref def="dt-text">parsed</termref> or <termref def="dt-unparsed">unparsed</termref>. --> <termdef id="dt-text" term="0Æ0­0¹0È">&parsed-entity;0oÿ <term>0Æ0­0¹0È</term>(<termref def="dt-character">e‡[W</termref>0nN&0s0g0B0c0fÿ &markup;SÈ0oe‡[W0Ç0ü0¿0’ˆh0W0f0‚0ˆ0D0)0’T+0€0</termdef><termdef id="dt-character" term="e‡[W"><term>e‡[W</term>0oÿ 0Æ0­0¹0È0ng\SXOM0g0B0c0fÿ ISO/IEC 10646<bibref ref="ISO10646"/>0k‰[š0U0Œ0‹0<!--Users may extend the ISO/IEC 10646 character repertoire by exploiting the private use areas. -->Š1[¹0Y0‹e‡[W0oÿ 0¿0Öÿ e9ˆLÿ _©^0N&0s0kUnicodeSÊ0sISO/IEC 106460LŠ1[¹0Y0‹Vó_be‡[W0h0Y0‹0</termdef> <scrap lang="ebnf" id="char32"> <head>e‡[W0n{ÄVò</head> <prodgroup pcw2="4" pcw4="17.5" pcw5="11"> <prod id="NT-Char"><lhs>Char</lhs> <rhs>#x9 | #xA | #xD | [#x20-#D7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]</rhs> <com>Nûa0nUnicodee‡[W00_0`0Wÿ &surrogate-blocks;ÿ FFFESÊ0sFFFF0o–d0O0</com> </prod> </prodgroup> </scrap> </p> <p>&character-value;0’0Ó0Ã0È0Ñ0¿0ó0k{&S÷S0Y0‹j_iË0oÿ [ŸOS0T0h0kU0c0f0‚0ˆ0D00Y0y0f0nXML&processor;0oÿ ISO/IEC 106460nUTF-8{&S÷SSÊ0sUTF-16{&S÷S0’S×0QNØ0Q0j0Q0Œ0p0j0‰0j0D0NŒ0d0n0i0a0‰0Lu(0D0‰0Œ0f0D0‹0K0’fy:0Y0‹0_00nj_iËÿ SÊ0sNÖ0n{&S÷Se¹lÕ0’R)u(0Y0‹0_00nj_iË0oÿ <titleref href='charencoding'>e‡[W0n{&S÷S</titleref>0kŠð0Y0‹0</p> <p>0i0n{&S÷Se¹lÕ0’u(0D0‹0K0k•¢OÂ0j0Oÿ ISO/IEC 106460ne‡[W–ÆT0k0B0‹0Y0y0f0ne‡[W0oÿ 0]0nUCS-4&code-value;<!-- bit string. -->0h{IO¡0j102epSÈ0o162ep0k0ˆ0c0fÿ SÂqg0g0M0‹0</p> </div2> <div2 id='sec-common-syn'> <head>Qq0niËe‡iËb[P</head> <p>2.30g0oÿ e‡lÕQ…0g^ƒ0OOu(0Y0‹0D0O0d0K0nŠS÷0’[š©0Y0‹0</p> <p><nt def="NT-S">S</nt> (zzv})0oÿ N0d‚å0W0O0o‰ep0n&space-character;(#x20)ÿ _©^0ÿ e9ˆLSÈ0o0¿0Ö0K0‰b0‹0 <scrap lang="ebnf" id='white'> <head>zzv}</head> <prodgroup pcw2="4" pcw4="17.5" pcw5="11"> <prod id='NT-S'><lhs>S</lhs> <rhs>(#x20 | #x9 | #xD | #xA)+</rhs> </prod> </prodgroup> </scrap></p> <p>O¿[œN ÿ e‡[W0’ÿ &letter;ÿ ep[WSÈ0oNÖ0ne‡[W0kR˜^0Y0‹0&letter;0oÿ 0¢0ë0Õ0¡0Ù0Ã0Èv„SÈ0oˆh—óv„0g0B0‹Wúg,e‡[W(N0dSÈ0o‰ep0n&combining-character;0Lÿ _Œ0k}š0O0S0h0‚0B0‹0)ÿ &ideographic;0K0‰b0‹0 <!-- Certain layout and format-control characters defined by ISO/IEC 10646 should be ignored when recognizing identifiers; these are defined by the classes <nt def='NT-Ignorable'>Ignorable</nt> and <nt def='NT- Extender'>Extender</nt>. --> T0¯0é0¹0k0J0Q0‹[Ÿ–›0ne‡[W0k0d0D0f0n[ŒQh0j[š©0oÿ <titleref href='CharClasses'>e‡[W0¯0é0¹</titleref>0k•¢0Y0‹NØ“20k‰[š0Y0‹0</p> <p><termdef id="dt-name" term="Name"><term>Name</term>0oÿ &letter;SÈ0o0D0O0d0K0nS:R0Še‡[W0nN0d0gYË0~0Šÿ 0]0n_Œ0k&letter;ÿ ep[Wÿ 0Ï0¤0Õ0óÿ N }Úÿ 0³0í0óSÈ0o0Ô0ê0ª0É0L}š0O(0S0Œ0‰0’T RMe‡[W0h0D0F0)0</termdef>&string;"<code>xml</code>"SÈ0o<code>(('X'|'x') ('M'|'m') ('L'|'l'))</code>0k&match;0Y0‹Nûa0n&string;0gYË0~0‹T RM0oÿ 0S0n&TR-or-Rec;0nsþW(0nrHSÈ0o\ge0nrH0g0njn–S0n0_00kNˆ}0Y0‹0 </p> <note> <p>XML0nT RM0nN-0n0³0í0ó0oÿ T RMzz•“0g0n[Ÿš0n0_00kNˆ}0Y0‹00³0í0ó0naTs0oÿ \ge0n0B0‹fBp¹0gjn–S0Y0‹0‚0n0h0Wÿ 0]0n0h0M0k0oÿ [Ÿšv„0jvîv„0g0³0í0ó0’Ou(0Y0‹e‡fø0’fôe°0Y0‹_ʼn0Lu0X0‹Sï€ý`'0L0B0‹0XML0gc¡u(0Y0‹T RMzz•“0nj_iË0Lÿ S:R0Š[P0h0W0f[Ÿ–›0k0³0í0ó0’Ou(0Y0‹0h0D0FOÝŠ<0o0j0D0N‹[ŸN ÿ 0S0Œ0oÿ T RMzz•“0n[Ÿš0nN0d0h0W0fNåY0k0oÿ XML0nT RM0nN-0g0³0í0ó0’Ou(0W0j0D0{0F0L0ˆ0D0S0h0’aTs0Y0‹00W0K0Wÿ XML&processor;0oÿ T RMe‡[W0h0W0f0³0í0ó0’S×0QNØ0Q0‹0S0h0Lg0~0W0D0 </p> </note> <p> <nt def='NT-Nmtoken'>Nmtoken</nt> (T RM&token;)0oÿ T RMe‡[W0giËb0Y0‹R0h0Y0‹0 <scrap lang='ebnf'> <head>T RMSÊ0s&token;</head> <!-- <prod id='NT-MiscName'><lhs>MiscName</lhs> <rhs></rhs> </prod>--> <prod id='NT-NameChar'><lhs>NameChar</lhs> <rhs><nt def="NT-Letter">Letter</nt> | <nt def='NT-Digit'>Digit</nt> <!--| <nt def='NT-MiscName'>MiscName</nt>--> | '.' | '-' | '_' | ':' | <nt def='NT-CombiningChar'>CombiningChar</nt> <!-- | <nt def='NT-Ignorable'>Ignorable</nt> --> | <nt def='NT-Extender'>Extender</nt></rhs> </prod> <prod id='NT-Name'><lhs>Name</lhs> <rhs>(<nt def='NT-Letter'>Letter</nt> | '_' | ':') (<nt def='NT-NameChar'>NameChar</nt>)*</rhs></prod> <prod id='NT-Names'><lhs>Names</lhs> <rhs><nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt>)*</rhs></prod> <prod id='NT-Nmtoken'><lhs>Nmtoken</lhs> <rhs>(<nt def='NT-NameChar'>NameChar</nt>)+</rhs></prod> <prod id='NT-Nmtokens'><lhs>Nmtokens</lhs> <rhs><nt def='NT-Nmtoken'>Nmtoken</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Nmtoken'>Nmtoken</nt>)*</rhs></prod> </scrap> </p> <p>&literal;0Ç0ü0¿0oÿ _u({&0gVò0~0Œ0_&string;0h0Wÿ 0]0nR0nS:R0Š[P0h0W0fOu(0Y0‹_u({&0oT+0~0j0D0&literal;0oÿ Q…è[ŸOS(<nt def='NT-EntityValue'>EntityValue</nt>)ÿ \^`'P$(<nt def='NT-AttValue'>AttValue</nt>)ÿ Yè&identifier;(<nt def="NT-SystemLiteral">SystemLiteral</nt>)0nQ…[¹0nc[š0kOu(0Y0‹0vîv„0k0ˆ0c0f0oÿ &literal;QhOS0’ÿ 0]0nN-0n&markup;0npgû0’ˆL0j00Z0kÿ 0¹0­0Ã0×0Y0‹0S0h0L0B0‹(<nt def='NT-SkipLit'>SkipLit</nt>0)0 <scrap lang='ebnf'> <head>&literal;</head> <!-- is marked section end legal in entity values etc.? James says yes. Handbook page 392, sec. 10.4 seems to me to say no. If James is right, leave as is. Otherwise, uncomment the next comment and ... --> <!-- <prod id='NT-EntityValue'><lhs>EntityValue</lhs> <rhs>' " ' (([^%&amp;"] | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-Reference'>Reference</nt>)* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-char'>Char</nt>*)) ' " ' </rhs> <rhs>|&nbsp; " ' " (([^%&amp;'] | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-Reference'>Reference</nt>)* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-char'>Char</nt>*)) " ' "</rhs> </prod> <prod id='NT-AttValue'><lhs>AttValue</lhs> <rhs>'"' (([^&lt;&amp;"] | <nt def='NT-Reference'>Reference</nt>)* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-char'>Char</nt>*)) ' " ' </rhs> <rhs>|&nbsp; " ' " (([^&lt;&amp;'] | <nt def='NT-Reference'>Reference</nt>)* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-char'>Char</nt>*)) " ' "</rhs> <wfc def="CleanAttrVals"/> </prod> --> <!-- ... and comment out the following, down to ... --> <prod id='NT-EntityValue'><lhs>EntityValue</lhs> <rhs>' " ' ([^%&amp;"] | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-Reference'>Reference</nt>)* ' " ' </rhs> <rhs>|&nbsp; " ' " ([^%&amp;'] | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-Reference'>Reference</nt>)* " ' "</rhs> </prod> <prod id='NT-AttValue'><lhs>AttValue</lhs> <rhs>' " ' ([^&lt;&amp;"] | <nt def='NT-Reference'>Reference</nt>)* ' " ' </rhs> <rhs>|&nbsp; " ' " ([^&lt;&amp;'] | <nt def='NT-Reference'>Reference</nt>)* " ' "</rhs> <!--<wfc def="WF-Attvaldelim"/>--> </prod> <!-- ... down to here. --> <prod id="NT-SystemLiteral"><lhs>SystemLiteral</lhs> <rhs><nt def='NT-SkipLit'>SkipLit</nt></rhs> </prod> <!-- <prod id="NT-URIchar"><lhs>URIchar</lhs> <rhs><com>See <loc href="http://www.w3.org/XXX">XXX</loc></com> </rhs></prod> --> <prod id="NT-PubidLiteral"><lhs>PubidLiteral</lhs> <rhs>' " ' <nt def='NT-PubidChar'>PubidChar</nt>* ' " ' | " ' " (<nt def='NT-PubidChar'>PubidChar</nt> - " ' ")* " ' "</rhs> </prod> <prod id="NT-PubidChar"><lhs>PubidChar</lhs> <rhs>#x20 | #xD | #xA |&nbsp;[a-zA-Z0-9] |&nbsp;[-'()+,./:=?]</rhs> </prod> <prod id="NT-SkipLit"><lhs>SkipLit</lhs> <rhs>(' " ' [^"]* ' " ') |&nbsp;(" ' " [^']* " ' ")</rhs> </prod> <!-- alternate form, making ms end illegal: --> <!-- <prod id="NT-SkipLit"><lhs>SkipLit</lhs> <rhs>(' " ' ([^"]* - ([^"]* ']]&gt;' [^"]*)) ' " ') |&nbsp;(" ' " ([^']* - ([^']* ']]&gt;' [^']*)) " ' ")</rhs> </prod> --> </scrap> </p> <!-- <wfcnote id="WF-Attvaldelim"> <head>Delimiters in Attribute Values</head> <p>After the expansion of character and entity references, an attribute value must not contain a "<code>&lt;</code>" or "<code>&amp;</code>" character unless that character was introduced by the expansion of a character reference or one of the entities &magicents;.</p> </wfcnote>--> <!-- This is not quite right: &lt; should be legal, should it not? Suppress this WFC until we get it right. --> <!-- Henry Thompson suggests (in substance, not form: the wording needs to be clarified): "Cooked Attribute values must not contain &lt; &amp; or the quote which closed their uncooked literal, unless arising from the expansion of a character reference or magic reference directly contained in their uncooked literal." I'm not sure I agree with this rule, but it's at least coherent, which is more than I can say for my attempt. --> </div2> <div2 id='syntax'> <head>e‡[W0Ç0ü0¿SÊ0s&markup;</head> <p><termref def='dt-text'>0Æ0­0¹0È</termref>0oÿ <termref def="dt-chardata">e‡[W0Ç0ü0¿</termref>SÊ0s&markup;0Lm÷W(0Y0‹0‚0n0h0W0fiËb0Y0‹0<termdef id="dt-markup" term="Markup"><term>&markup;</term>0oÿ <termref def="dt-stag">•‹YË0¿0°</termref>ÿ <termref def="dt-etag">}BN†0¿0°</termref>ÿ <termref def="dt-empty">zz‰} </termref>ÿ <termref def="dt-entref">[ŸOSSÂqg</termref>ÿ <termref def="dt-charref">e‡[WSÂqg</termref>ÿ <termref def="dt-comment">0³0á0ó0È</termref>ÿ <termref def="dt-cdsection">CDATA0»0¯0·0ç0ó</termref> 0nS:R0Š[Pÿ <termref def="dt-doctype">e‡føW‹[£Š</termref>SÊ0s<termref def="dt-pi">QætT}Nä</termref>0n_b0’SÖ0‹0 </termdef> </p> <p><termdef id="dt-chardata" term="Character Data">&markup;0g0o0j0D0Y0y0f0n0Æ0­0¹0È0oÿ e‡fø0n<term>e‡[W0Ç0ü0¿</term>0’iËb0Y0‹0</termdef></p> <p>0¢0ó0Ñ0µ0ó0Ée‡[W (&amp;)SÊ0s&left-angle-bracket; (&lt;)0oÿ &markup;0nS:R0Š[P0h0W0fÿ SÈ0o<termref def="dt-comment">0³0á0ó0È</termref>ÿ <termref def="dt-pi">QætT}Nä</termref>‚å0W0O0o<termref def="dt-cdsection">CDATA0»0¯0·0ç0ó</termref>Q…0gOu(0Y0‹X4T0k<emph>0`0Q</emph>ÿ 0]0n0~0~0n_b0gQúsþ0W0f0ˆ0D00S0Œ0‰0ne‡[W0oÿ Q…è[ŸOS[£Š0n<termref def='dt-litentval'>&literal;[ŸOSP$</termref>Q…0kŠð0W0f0‚0ˆ0D0 Šs0W0O0oÿ <titleref href='wf-entities'>&well-formed;0n[ŸOS</titleref>0k•¢0Y0‹‰[š0’SÂqg0<!-- FINAL EDIT: restore internal entity decl or leave it out. -->0S0Œ0‰0ne‡[W0LNÖ0nèR0g_ʼn0jX4Tÿ epP$0k0ˆ0‹e‡[WSÂqgSÈ0o&string;"<code>&amp;amp;</code>"SÊ0s&string;"<code>&amp;lt;</code>"0’Ou(0Wÿ <termref def="dt-escape">&escape;</termref>0W0j0Q0Œ0p0j0‰0j0D0&right-angle-bracket; (>) 0oÿ &string;"<code>&amp;gt;</code>"0’Ou(0W0fˆhsþ0W0f0‚0ˆ0D0Q…[¹0nN-0gR"<code>]]&gt;</code>"0’Ou(0Y0‹0h0M0oÿ 0]0Œ0Lÿ <termref def="dt-cdsection">CDATA0»0¯0·0ç0ó</termref>0n}BN†0’&markup;0W0j0D–P0Šÿ <termref def='dt-compat'>N’cÛ`'0n0_0</termref>ÿ "<code>&amp;gt;</code>"SÈ0oe‡[WSÂqg0’Ou(0Wÿ &escape;0W0j0Q0Œ0p0j0‰0j0D0</p> <p>‰} 0nQ…[¹0g0oÿ e‡[W0Ç0ü0¿0oÿ 0D0K0j0‹&markup;0n•‹YËS:R0Š[P0’T+0~0j0DNûa0n&char-string;0h0Y0‹0CDATA0»0¯0·0ç0ó0g0oÿ e‡[W0Ç0ü0¿0h0oÿ CDATA0»0¯0·0ç0ó0n}BN†S:R0Š[P"<code>]]&gt;</code>"0’T+0~0j0DNûa0n&char-string;0h0Y0‹0 </p> <p> \^`'P$0k&single-quote;SÊ0s&double-quote;0’T+0€0_00k0oÿ 0¢0Ý0¹0È0í0Õ0£SÈ0o&single-quote;(') 0oÿ "<code>&amp;apos;</code>"0h0W0fˆhsþ0Wÿ &double-quote;(")0oÿ "<code>&amp;quot;</code>"0h0W0fˆhsþ0Y0‹0 <scrap lang="ebnf"> <head>e‡[W0Ç0ü0¿</head> <prod id='NT-CharData'> <lhs>CharData</lhs> <rhs>[^&lt;&amp;]* - ([^&lt;&amp;]* ']]&gt;' [^&lt;&amp;]*)</rhs> </prod> </scrap> </p> </div2> <div2 id='sec-comments'> <head>0³0á0ó0È</head> <p><termdef id="dt-comment" term="Comment"><term>0³0á0ó0È</term>0oÿ NÖ0n<termref def='dt-markup'>&markup;</termref>0nY0j0‰0pÿ e‡fø0n0i0S0ksþ0Œ0f0‚0ˆ0D00U0‰0kÿ e‡føW‹[£ŠQ…0gÿ e‡lÕ0LŠ10YX4b@0ksþ0Œ0f0‚0ˆ0D0 <!-- TB except in a <termref def="dt-cdsection">CDATA section</termref>, i.e. within <termref def="dt-elemcontent">element content</termref>, in <termref def="dt-mixed">mixed content</termref>, or in the prolog. They must not occur within declarations or tags. --> 0³0á0ó0È0oÿ e‡fø0n<termref def="dt-chardata">e‡[W0Ç0ü0¿</termref>0nNè0g0o0j0D0XML&processor;0oÿ &application;0L0³0á0ó0È0n0Æ0­0¹0È0’SÖ0ŠQú0Y0S0h0’Sï€ý0h0W0f0‚0ˆ0D0Lÿ 0]0F0W0j0O0h0‚0ˆ0D0 <termref def="dt-compat">N’cÛ`'0n0_0</termref>ÿ &string;"<code>--</code>" ÿ&double-hyphen;ÿ 0oÿ 0³0á0ó0ÈQ…0gsþ0Œ0f0o0j0‰0j0D0 <scrap lang="ebnf"> <head>0³0á0ó0È</head> <prod id='NT-Comment'><lhs>Comment</lhs> <rhs>'&lt;!--' ((<nt def='NT-Char'>Char</nt> - '-') | ('-' (<nt def='NT-Char'>Char</nt> - '-')))* '-->'</rhs> <!-- <rhs>'&lt;!&como;' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* '&comc;' <nt def='NT-Char'>Char</nt>*)) '&comc;&gt;'</rhs> --> </prod> </scrap> </termdef></p> <p>0³0á0ó0È0nO‹0’k!0ky:0Y0 <eg>&lt;!&como; declarations for &lt;head> &amp; &lt;body> &comc;&gt;</eg> </p> </div2> <div2 id='sec-pi'> <head>QætT}Nä</head> <p><termdef id="dt-pi" term="Processing instruction"><term>QætT}Nä</term>(PI)0k0ˆ0c0fÿ &application;0n0_00nT}Nä0’e‡fø0kQe0Œ0‹0S0h0L0g0M0‹0 <scrap lang="ebnf"> <head>QætT}Nä</head> <prod id='NT-PI'><lhs>PI</lhs> <rhs>'&lt;?' <nt def='NT-PITarget'>PITarget</nt> (<nt def='NT-S'>S</nt> (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* &pic; <nt def='NT-Char'>Char</nt>*)))? &pic;</rhs></prod> <prod id='NT-PITarget'><lhs>PITarget</lhs> <rhs><nt def='NT-Name'>Name</nt> - (('X' | 'x') ('M' | 'm') ('L' | 'l'))</rhs> </prod> </scrap></termdef> PI0oÿ e‡fø0n<termref def="dt-chardata">e‡[W0Ç0ü0¿</termref>0nNè0g0o0j0D0Lÿ &application;0kn!0U0Œ0j0Q0Œ0p0j0‰0j0D0PI0oÿ T}Nä0Ln!0U0Œ0‹&application;0’&identify;0_00kOu(0Y0‹&target; (<nt def='NT-PITarget'>PITarget</nt>) 0gYË0~0‹0&target;T "<code>XML</code>"ÿ "<code>xml</code>"0j0i0oÿ 0S0n&TR-or-Rec;0nsþW(0nrHSÈ0o\ge0nrH0n‰hŠlÕ</termref>j_iË0’ÿ PI0n&target;0’[£Š0Y0‹0_00kOu(0W0f0‚0ˆ0D0 </p> </div2> <div2 id='sec-cdata-sect'> <head>CDATA0»0¯0·0ç0ó</head> <p><termdef id="dt-cdsection" term="CDATA Section"><term>CDATA0»0¯0·0ç0ó</term>0oÿ e‡[W0Ç0ü0¿0LQúsþ0Y0‹0h0S00g0B0Œ0pÿ 0i0S0kQúsþ0W0f0‚0ˆ0D00S0Œ0oÿ 0]0F0g0j0Q0Œ0pÿ &markup;0h0W0fŠ‹X0Y0‹e‡[W0’T+0€ÿ 0Æ0­0¹0È0nS:u;0’&escape;0Y0‹0n0kOu(0Y0‹0CDATA0»0¯0·0ç0ó0oÿ &string;"<code>&lt;![CDATA[</code>"0gYË0~0Šÿ &string; "<code>]]&gt;</code>"0g}B00‹0 <scrap lang="ebnf"> <head>CDATA0»0¯0·0ç0ó</head> <prod id='NT-CDSect'><lhs>CDSect</lhs> <rhs><nt def='NT-CDStart'>CDStart</nt> <nt def='NT-CData'>CData</nt> <nt def='NT-CDEnd'>CDEnd</nt></rhs></prod> <prod id='NT-CDStart'><lhs>CDStart</lhs> <rhs>'&lt;![CDATA['</rhs> </prod> <prod id='NT-CData'><lhs>CData</lhs> <rhs>(<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-Char'>Char</nt>*)) </rhs> </prod> <prod id='NT-CDEnd'><lhs>CDEnd</lhs> <rhs>']]&gt;'</rhs> </prod> </scrap> CDATA0»0¯0·0ç0óQ…0g0oÿ R<nt def='NT-CDEnd'>CDEnd</nt>0`0Q0’&markup;0h0W0fŠ‹X0Y0‹0n0gÿ &left-angle-bracket;SÊ0s0¢0ó0Ñ0µ0ó0É0oÿ 0]0n&literal;_b_0gQúsþ0W0f0ˆ0D00]0Œ0‰0oÿ "<code>&amp;lt;</code>"SÊ0s"<code>&amp;amp;</code>"0’Ou(0W0f&escape;0Y0‹_ʼn0o0j0D0CDATA0»0¯0·0ç0ó0oÿ Qe0Œ[P0k0o0g0M0j0D0 </termdef> </p> <p>"<code>&lt;greeting></code>"SÊ0s"<code>&lt;/greeting></code>"0’ÿ <termref def='dt-markup'>&markup;</termref>0g0o0j0Oÿ <termref def='dt-chardata'>e‡[W0Ç0ü0¿</termref>0h0W0fŠ‹X0Y0‹CDATA0»0¯0·0ç0ó0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;![CDATA[&lt;greeting>Hello, world!&lt;/greeting>]]&gt;</eg> </p> </div2> <div2 id='sec-prolog-dtd'> <head>&prolog;SÊ0se‡føW‹[£Š</head> <p><termdef id='dt-xmldecl' term='XML Declaration'>XMLe‡fø0oÿ Ou(0Y0‹XML0n&version;0’c[š0Y0‹<term>XML[£Š</term>0gYË00f0‚0ˆ0Oÿ SÈ0]0F0Y0‹0n0Lg0~0W0D0 </termdef> </p> <p>0S0n&TR-or-Rec;0n0S0n&version;0kiT0Y0‹0S0h0’y:0Y0_00k0oÿ &version;ujS÷ "<code>1.0</code>" 0’Ou(0W0j0Q0Œ0p0j0‰0j0D00B0‹e‡fø0Lÿ 0S0n&TR-or-Rec;0n0S0n&version;0kiT0W0j0D0h0Mÿ P$"<code>1.0</code>"0’Ou(0Y0‹0n0oÿ &error;0h0Y0‹00S0n&TR-or-Rec;0nNÊ_Œ0n&version;0k"<code>1.0</code>"NåY0nP$0’NØN0Y0‹0S0h0Lÿ XMLO\im0°0ë0ü0×0naVó0`0Lÿ XML0n\ge0n&version;0’O\b0Y0‹0S0h0nxº}0’y:0Y00Q0g0o0j0Oÿ O\b0W0_0h0W0f0‚ÿ ujS÷NØ0Q0k0d0D0fÿ ry[š0ne¹lÕ0’Ou(0Y0‹0S0h0nxº}0’y:0Y00Q0g0‚0j0D0\ge0n&version;0nSï€ý`'0’–dY0W0j0D0n0gÿ _ʼn0jX4Tÿ êRÕv„0j&version;0nŠ‹X0’Sï€ý0h0Y0‹bKkµ0h0W0fÿ 0S0niËb[P0’cÐO›0Y0‹0&processor;0oÿ 0µ0Ý0ü0È0W0f0D0j0D&version;0g0é0Ù0ëNØ0Q0W0_e‡fø0’S×0QSÖ0c0_0h0Mÿ &error;0’wå0W0f0‚0ˆ0D0 </p> <p>XMLe‡føQ…0n&markup;0nj_€ý0oÿ Ša¶iË SÊ0sŠÖtiË 0’Šð0Y0‹0S0hÿ N&0s0k\^`'SÊ0s\^`'P$0n[þ0’ŠÖtiË 0k•¢#0e0Q0‹0S0h0k0B0‹0XML0oÿ ŠÖtiË 0k0d0D0f0nR6}gaNö0’[š©0Y0‹0_0ÿ SÊ0s0B0‰0K0X0[š©0U0Œ0_Ša¶SXOM0’Ou(0g0M0‹0_00nj_iË0h0W0fÿ <termref def="dt-doctype">e‡føW‹[£Š</termref>0’cÐO›0Y0‹0<!-- old The function of the markup in an XML document is to describe its storage and logical structures, and associate attribute-value pairs with the logical structure. XML provides a mechanism, the <termref def="dt-doctype">document type declaration</termref>, to define constraints on that logical structure and to support the use of predefined storage units. --><termdef id="dt-valid" term="Validity">XMLe‡fø0L<term>&valid;</term>0h0oÿ e‡føW‹[£Š0’0‚0aÿ 0]0ne‡føW‹[£Š0ky:0YR6}gaNö0’n€0_0Y0S0h0h0Y0‹0 </termdef></p> <p>e‡føW‹[£Š0oÿ e‡fø0ngR0n<termref def="dt-element">‰} </termref>0nRM0ksþ0Œ0j0Q0Œ0p0j0‰0j0D0 <scrap lang="ebnf" id='xmldoc'> <head>&prolog;</head> <prodgroup pcw2="6" pcw4="17.5" pcw5="9"> <prod id='NT-prolog'><lhs>prolog</lhs> <rhs><nt def='NT-XMLDecl'>XMLDecl</nt>? <nt def='NT-Misc'>Misc</nt>* (<nt def='NT-doctypedecl'>doctypedecl</nt> <nt def='NT-Misc'>Misc</nt>*)?</rhs></prod> <prod id='NT-XMLDecl'><lhs>XMLDecl</lhs> <rhs>&xmlpio; <nt def='NT-VersionInfo'>VersionInfo</nt> <nt def='NT-EncodingDecl'>EncodingDecl</nt>? <nt def='NT-SDDecl'>SDDecl</nt>? <nt def="NT-S">S</nt>? &pic;</rhs> </prod> <prod id='NT-VersionInfo'><lhs>VersionInfo</lhs> <rhs><nt def="NT-S">S</nt> 'version' <nt def='NT-Eq'>Eq</nt> ('"<nt def="NT-VersionNum">VersionNum</nt>"' | "'<nt def="NT-VersionNum">VersionNum</nt>'")</rhs> </prod> <prod id='NT-Eq'><lhs>Eq</lhs> <rhs><nt def='NT-S'>S</nt>? '=' <nt def='NT-S'>S</nt>?</rhs></prod> <prod id="NT-VersionNum"> <lhs>VersionNum</lhs> <rhs>([a-zA-Z0-9_.:] | '-')+</rhs> </prod> <prod id='NT-Misc'><lhs>Misc</lhs> <rhs><nt def='NT-Comment'>Comment</nt> | <nt def='NT-PI'>PI</nt> | <nt def='NT-S'>S</nt></rhs></prod> </prodgroup> </scrap></p> <p> O‹0H0pÿ k!0ky:0Y[ŒQh0jXMLe‡fø0oÿ <termref def="dt-wellformed">&well-formed;</termref>0g0B0‹0L<termref def="dt-valid">&valid;</termref>0g0o0j0D0 <eg><![CDATA[<?xml version="1.0"?> <greeting>Hello, world!</greeting> ]]></eg> k!0ne‡fø0‚T iØ0h0Y0‹0 <eg><![CDATA[<greeting>Hello, world!</greeting> ]]></eg> </p> <p><termdef id="dt-doctype" term="Document Type Declaration"> XML0n<term>e‡føW‹[£Š</term>0oÿ 0B0‹e‡fø0¯0é0¹0n0_00ne‡lÕ0’cÐO›0Y0‹<termref def='dt-markupdecl'>&markup;[£Š</termref>0’T+0€0Kÿ SÈ0oSÂqg0Y0‹00S0ne‡lÕ0’ÿ e‡føW‹[š©SÈ0o<term>DTD</term>0h0D0F0e‡føW‹[£Š0oÿ &markup;[£Š0’T+0“0`Yè&subset;(ryR%0jz.˜^0n<termref def='dt-extent'>Yè[ŸOS</termref>)0’SÂqg0g0Mÿ SÈ0oQ…è&subset;0kvôc¥&markup;[£Š0’T+0€0S0h0‚0g0M0‹00U0‰0kÿ 0]0nN!e¹0‚Sï€ý0h0Y0‹00B0‹e‡fø0nDTD0oÿ N!e¹0n&subset;0’0~0h00_0‚0n0h0W0fiËb0Y0‹0</termdef> </p> <p><termdef id="dt-markupdecl" term="markup declaration"> <term>&markup;[£Š</term>0oÿ <termref def="dt-eldecl">‰} W‹[£Š</termref>ÿ <termref def="dt-attdecl">\^`'0ê0¹0È[£Š</termref>ÿ <termref def="dt-entdecl">[ŸOS[£Š</termref>SÈ0o<termref def="dt-notdecl">ŠlÕ[£Š</termref>0h0Y0‹0</termdef>k!0ky:0Y&well-formed;R6}SÊ0s&validity;R6}0k‰[š0Y0‹0Lÿ 0S0Œ0‰0n[£Š0oÿ <termref def='dt-PE'>&parameter;[ŸOS</termref>Q…0kQhOSSÈ0oNè0LT+0~0Œ0f0‚0ˆ0D0Šs0W0D‰[š0oÿ <titleref xml-link="simple" href="sec-physical-struct">ritiË </titleref>0k•¢0Y0‹‰[š0’SÂqg0n0S0h0</p> <scrap lang="ebnf" id='dtd'> <head>e‡føW‹[š©</head> <prodgroup pcw2="6" pcw4="17.5" pcw5="9"> <prod id='NT-doctypedecl'><lhs>doctypedecl</lhs> <rhs>'&lt;!DOCTYPE' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-ExternalID'>ExternalID</nt>)? <nt def='NT-S'>S</nt>? ('[' (<nt def='NT-markupdecl'>markupdecl</nt> | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-S'>S</nt>)* ']' <nt def='NT-S'>S</nt>?)? '>'</rhs> <vc def="vc-roottype"/> <!--<vc def="vc-nonnullDTD"/>--> </prod> <!-- <prod id='NT-markupdecls'><lhs>markupdecls</lhs> <rhs> (<nt def='NT-S'>S</nt>? <nt def='NT-markupdecl'>markupdecl</nt> <nt def='NT-S'>S</nt>?)* </rhs></prod> --> <prod id='NT-markupdecl'><lhs>markupdecl</lhs> <rhs><nt def='NT-elementdecl'>elementdecl</nt> | <nt def='NT-AttlistDecl'>AttlistDecl</nt> | <nt def='NT-EntityDecl'>EntityDecl</nt> | <nt def='NT-NotationDecl'>NotationDecl</nt> | <nt def='NT-PI'>PI</nt> | <nt def='NT-Comment'>Comment</nt> <!--| <nt def='NT-InternalPERef'>InternalPERef</nt> --></rhs> <vc def='vc-PEinMarkupDecl'/> <wfc def="wfc-PEinInternalSubset"/> </prod> <!-- <prod id="NT-InternalPERef"><lhs>InternalPERef</lhs> <rhs><nt def="NT-PEReference">PEReference</nt></rhs> <wfc def="wfc-integraldec"/> </prod> --> </prodgroup> </scrap> <vcnote id="vc-roottype"> <head>&root;‰} W‹</head> <p> e‡føW‹[£Š0k0J0Q0‹<nt def='NT-Name'>Name</nt>0oÿ &root;‰} 0nW‹0h&match;0W0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <!-- <vcnote id="vc-nonnullDTD"> <head>Non-null DTD</head> <p> The internal and external subsets of the DTD must not both be empty. </p> </vcnote> --> <vcnote id='vc-PEinMarkupDecl'> <head>[£ŠSÊ0s&parameter;[ŸOS0LS³[Æ0kQe0Œ[P0’0j0Y0S0h</head> <p>&parameter;[ŸOS<termref def='dt-repltext'>0n&replacement-text;</termref>0oÿ &markup;[£ŠQ…0k0J0D0fÿ S³[Æ0kQe0Œ[P0k0j0c0f0D0j0Q0Œ0p0j0‰0j0D00d0~0Šÿ &markup;[£Š(<nt def='NT-markupdecl'>markupdecl</nt>)0ngRSÈ0og_Œ0ne‡[W0Lÿ <termref def='dt-PERef'>&parameter;[ŸOSSÂqg</termref>0n[þŒa0h0j0‹&replacement-text;0kT+0~0Œ0Œ0pÿ N!e¹0h0‚T 0X&replacement-text;0kT+0~0Œ0j0Q0Œ0p0j0‰0j0D0</p> </vcnote> <wfcnote id="wfc-PEinInternalSubset"> <head>Q…è&subset;Q…0n&parameter;[ŸOS</head> <p>DTD0nQ…è&subset;0g0oÿ <termref def='dt-PERef'>&parameter;[ŸOSSÂqg</termref>0oÿ &markup;[£Š0LQúsþSï€ý0jX4b@0`0Q0kQúsþ0g0M0‹0&markup;[£ŠQ…0k0oQúsþ0g0M0j0D(0S0nR6}0oÿ Yè&parameter;[ŸOSSÈ0oYè&subset;0g0nSÂqg0k0oiu(0W0j0D0)0 </p> </wfcnote> <p> Q…è&subset;0n0h0M0hT iØ0kÿ Yè&subset;SÊ0sDTD0k0J0D0fSÂqg0Y0‹Nûa0nYè&parameter;[ŸOS0oÿ —^}BzïŠS÷<nt def="NT-markupdecl">markupdecl</nt>0k0ˆ0c0fŠ10U0Œ0‹W‹0nÿ N#0n[ŒQh0j&markup;[£Š0giËb0U0Œ0j0Q0Œ0p0j0‰0j0D0&markup;[£Š0n•“0k0oÿ zzv}SÈ0o<termref def="dt-PERef">&parameter;[ŸOSSÂqg</termref>0’n0D0f0‚0ˆ0D00W0K0Wÿ Yè&subset;SÈ0oYè&parameter;[ŸOS0nQ…[¹0nNè0oÿ <termref def="dt-cond-section">gaNöNØ0M0»0¯0·0ç0ó</termref>0’Ou(0W0fq!‰–0W0f0‚0ˆ0D0Q…è0µ0Ö0»0Ã0È0g0oÿ 0S0Œ0oŠ10U0Œ0j0D0 <!--In the external subset, however, parameter-entity references can be used to replace constructs prefixed by "<code>%</code>" in a production of the grammar, and <termref def="dt-cond-section">conditional sections</termref> may occur. In the internal subset, by contrast, conditional sections may not occur and the only parameter-entity references allowed are those which match the non-terminal <nt def="NT-InternalPERef">InternalPERef</nt> within the rule for <nt def="NT-doctypedecl">markupdecl</nt>. --> <scrap id="ext-Subset"> <head>Yè&subset;</head> <prodgroup pcw2="6" pcw4="17.5" pcw5="9"> <prod id='NT-extSubset'><lhs>extSubset</lhs> <rhs>( <nt def='NT-markupdecl'>markupdecl</nt> | <nt def='NT-conditionalSect'>conditionalSect</nt> | <nt def='NT-PEReference'>PEReference</nt> | <nt def='NT-S'>S</nt> )*</rhs> </prod> </prodgroup> </scrap></p> <p>Yè&subset;SÊ0sYè&parameter;[ŸOS0oÿ 0]0nQ…0g0oÿ &parameter;[ŸOS0L&markup;[£Š0n<emph>•“</emph>0`0Q0g0j0Oÿ &markup;[£Š0n<emph>Q…</emph>0g0‚Š‹X0U0Œ0‹ÿ 0h0D0Fp¹0g0‚Q…è&subset;0h0oup0j0‹0 </p> <p>e‡føW‹[£ŠNØ0M0nXMLe‡fø0nO‹0’ÿ k!0ky:0Y0 <eg><![CDATA[<?xml version="1.0"?> <!DOCTYPE greeting SYSTEM "hello.dtd"> <greeting>Hello, world!</greeting> ]]></eg> <termref def="dt-sysid">0·0¹0Æ0à&identifier;</termref> "<code>hello.dtd</code>"0Lÿ e‡fø0nDTD0nURI0h0j0‹0</p> <p>k!0nO‹0n0h0J0Šÿ [£Š0’\@b@v„0kN0H0‹0S0h0‚0g0M0‹0 <eg><![CDATA[<?xml version="1.0" encoding="UTF-8" ?> <!DOCTYPE greeting [ <!ELEMENT greeting (#PCDATA)> ]> <greeting>Hello, world!</greeting> ]]></eg> Yè&subset;SÊ0sQ…è&subset;0nN!e¹0’Ou(0Y0‹0h0M0oÿ Q…è&subset;0LYè&subset;0ˆ0ŠQH0kQúsþ0W0_0h‰‹0j0Y0<!--* 'is considered to'? boo. whazzat mean? -->0S0Œ0oÿ Q…è&subset;0n[ŸOSSÊ0s\^`'0ê0¹0È[£Š0Lÿ Yè&subset;0n[ŸOSSÊ0s\^`'0ê0¹0È[£Š0ˆ0ŠQ*QH0Y0‹0h0D0FR¹gœ0’0‚0_0‰0Y0 </p> </div2> <div2 id='sec-rmd'> <head>&standalone;e‡fø[£Š</head> <p><termref def="dt-xml-proc">XML&processor;</termref>0oÿ &application;0ke‡fø0nQ…[¹0’n!0Y0Lÿ &markup;[£Š0oÿ 0S0nQ…[¹0k_q—ÿ0’N0H0‹0S0h0L0B0‹0\^`'0n&default-value;SÊ0s[ŸOS[£Š0’0]0nO‹0h0Y0‹0XML[£Š0nNèR0h0W0fQúsþ0g0M0‹&standalone;e‡fø[£Š0oÿ e‡fø0Lÿ 0]0n&markup;[£Š0n[XW(0k0ˆ0c0f_q—ÿ0U0Œ0j0D0S0h0’c0Wy:0Yÿfnÿ 0]0n&markup;[£Š0L[XW(0W0j0D0_00kÿ 0S0Œ0L0D0H0‹0ÿ 0 <scrap lang="ebnf" id='fulldtd'> <head>&standalone;e‡fø[£Š</head> <prodgroup pcw2="4" pcw4="19.5" pcw5="9"> <prod id='NT-SDDecl'><lhs>SDDecl</lhs> <rhs> <nt def="NT-S">S</nt> 'standalone' <nt def='NT-Eq'>Eq</nt> "'" ('yes' | 'no') "'" </rhs> <rhs> | <nt def="NT-S">S</nt> 'standalone' <nt def='NT-Eq'>Eq</nt> '"' ('yes' | 'no') '"' </rhs><vc def='vc-check-rmd'/></prod> </prodgroup> </scrap></p> <p>&standalone;e‡fø[£Š0k0J0D0f0o, "<code>yes</code>"0nP$0oÿ <termref def='dt-docent'>e‡fø[ŸOS</termref>0nYè0kÿDTD0nYè&subset;Q…0kÿ SÈ0oQ…è&subset;0K0‰SÂqg0U0Œ0‹Yè0Ñ0é0á0¿[ŸOSQ…0kÿ ÿ XML&processor;0K0‰&application;0x0hn!0U0Œ0‹`ÅX10k_q—ÿ0Y0‹&markup;[£Š0L[XW(0W0j0D0S0h0’aTs0Y0‹0"<code>no</code>"0nP$0oÿ 0]0nYè&markup;[£Š0L[XW(0Y0‹0Kÿ SÈ0o[XW(0Y0‹Sï€ý`'0L0B0‹0S0h0’aTs0Y0‹0&standalone;e‡fø[£Š0oÿ 0]0n<emph>[£Š</emph>0Le‡føYè0k[XW(0Y0‹0K0i0F0K0’y:0Y0`0Q0klèa0Y0‹0S0h0Yè[ŸOS0x0nSÂqg0Le‡føQ…0k[XW(0W0f0D0f0‚ÿ 0]0n[ŸOS0LQ…èv„0k[£Š0U0Œ0f0D0‹0h0M0oÿ e‡fø0n&standalone;0nr¶aK0k0o_q—ÿ0’N0H0j0D0</p> <p>Yè0k&markup;[£Š0L[XW(0W0j0Q0Œ0pÿ &standalone;e‡fø[£Š0oaTs0’0‚0_0j0D0Yè0k&markup;[£Š0L[XW(0Wÿ &standalone;e‡fø[£Š0L[XW(0W0j0DX4T0oÿ <code>"no"</code> 0nP$0nŠ-[š0’Nî[š0Y0‹0</p> <p>XMLe‡fø0g <code>standalone="no"</code> 0LŠ-[š0U0Œ0f0D0‹0‚0n0oÿ 0B0‹0¢0ë0´0ê0º0à0g&standalone;e‡fø0kY cÛ0g0Mÿ 0S0ne‡fø0oÿ 0Í0Ã0È0ï0ü0¯‘MOá&application;0k0h0c0fg0~0W0D0K0‚0W0Œ0j0D0</p> <vcnote id='vc-check-rmd'> <head>&standalone;e‡fø[£Š</head> <p>&standalone;e‡fø[£Š0oÿ OU0‰0K0nYè&markup;[£Š0Lk!0n0D0Z0Œ0K0’[£Š0W0f0D0‹0h0M0oÿ P$ "<code>no</code>" 0’SÖ0‰0j0Q0Œ0p0j0‰0j0D0 <ulist> <item><p>a) <termref def="dt-default">&default;</termref>P$NØ0M0n\^`'0g0B0c0fÿ 0S0n\^`'0Liu(0U0Œ0‹‰} 0Lÿ \^`'P$0’c[š0[0Z0ke‡føQ…0ksþ0Œ0‹0‚0n0</p></item> <item><p>b) &magicents;NåY0n[ŸOS0g0B0c0fÿ 0]0n[ŸOS0k[þ0Y0‹<termref def="dt-entref">SÂqg</termref>0Le‡føQ…0kQúsþ0Y0‹0‚0n0</p> </item> <item><p>c) P$0L<titleref href='AVNormalize'>kc‰S</titleref>0n[þŒa0h0j0‹\^`'0g0B0c0fÿ kc‰S0n}Pgœ0h0W0fY S0Y0‹P$0Le‡føQ…0g\^`'0kc[š0U0Œ0‹0‚0n0</p></item> <item> <p>d) <termref def="dt-elemcontent">‰} Q…[¹</termref>0’0‚0d‰} W‹0g0B0c0fÿ zzv}0L0]0n‰} W‹0n0D0Z0Œ0K0n0¤0ó0¹0¿0ó0¹Q…0kvôc¥sþ0Œ0‹0‚0n0 </p></item> </ulist> </p> </vcnote> <p>&standalone;e‡fø[£ŠNØ0M0nXML[£Š0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;?xml version="&XML.version;" standalone='yes'?></eg></p> </div2> <div2 id='sec-white-space'> <head>zzv}0nSÖbq0D</head> <p>XMLe‡fø0’}è–Æ0Y0‹0h0M0oÿ &markup;0’vîzË0_0[Š­00„0Y0O0Y0‹0_00kÿ zzv} (&space;ÿ 0¿0ÖSÊ0szzv}ˆL00S0n&TR-or-Rec;0g0oÿ —^}BzïŠS÷0n<nt def='NT-S'>S</nt>0gˆh0Y)0’O0F0hO¿R)0j0S0h0LY0D00]0nzzv}0oÿ ‘M^0Y0‹&version;0ne‡fø0nNè0h0W0fT+00‹0S0h0’aVó0W0j0D0n0’fn0h0Y0‹00W0K0Wÿ aTs0n0B0‹ zzv}0g0B0c0fÿ ‘M^0Y0‹&version;0kk‹0U0j0Q0Œ0p0j0‰0j0D0‚0n0‚Y0D0O‹0H0pÿ ŠiSÊ0s0½0ü0¹0³0ü0É0k0J0Q0‹zzv}0L0B0‹0</p> <p><termref def='dt-xml-proc'>XML&processor;</termref>0oÿ e‡føQ…0n&markup;NåY0n0Y0y0f0ne‡[W0’ÿ 0]0n0~0~Y fô0[0Z0k&application;0kn!0U0j0Q0Œ0p0j0‰0j0D0<termref def='dt-validating'>&validating;XML&processor;</termref>0oÿ <termref def="dt-elemcontent">‰} Q…[¹</termref>0nN-0nzzv}0’NÖ0n—^&markup;e‡[W0K0‰S:R%0Wÿ &application;Pt0k‰} Q…[¹0nN-0nzzv}0L‘͉0g0j0D0h0D0F0S0h0’O0H0j0Q0Œ0p0j0‰0j0D0</p> <p> "<code>xml:space</code>"0h0D0FryR%0j<termref def='dt-attr'>\^`'</termref>0’e‡fø0kc?Qe0Y0‹0S0h0k0ˆ0c0fÿ zzv}0’‘͉0h0Y0‹aVó0’y:0W0f0‚0ˆ0D00S0n\^`'0’iu(0Y0‹‰} 0ksþ0Œ0‹zzv}0’ÿ 0¢0×0ê0±0ü0·0ç0ó0L‘͉0j0‚0n0h0W0fbq0F0S0h0’‰lB0Y0‹ÿ 0h0D0FaVó0’y:0Y0</p> <p>&valid;0je‡fø0g0oÿ 0S0n\^`'0’Ou(0Y0‹X4T0oÿ NÖ0n\^`'0hT 0X0ˆ0F0k<termref def="dt-attdecl">[£Š</termref>0W0j0Q0Œ0p0j0‰0j0D0[£Š0Y0‹0h0M0oÿ SÖ0Š_—0‹P$0’"<code>default</code>"SÊ0s "<code>preserve</code>"0`0Q0h0Y0‹<termref def='dt-enumerated'>RcW‹</termref>0g0j0Q0Œ0p0j0‰0j0D0 </p> <p>P$"<code>default</code>"0oÿ &application;0n&default;0nzzv}Qæt0â0ü0É0’ÿ 0]0n‰} 0kiu(Sï€ý0h0Y0‹0S0h0’aTs0Y0‹0P$"<code>preserve</code>"0oÿ &application;0L0Y0y0f0nzzv}0’OÝ[X0Y0‹0S0h0’aTs0Y0‹00S0n[£Š0naVó0oÿ "<code>xml:space</code>" \^`'0nR%0nc[š0gN fø0M0W0j0D–P0Šÿ ‰} 0nQ…[¹0ksþ0Œ0‹0Y0y0f0n‰} 0kiu(0Y0‹0h‰ã‘È0Y0‹0</p> <p>e‡fø0n<termref def='dt-root'>&root;‰} </termref>0k0d0D0f0oÿ 0S0n\^`'0nP$0’c[š0Y0‹0Kÿ SÈ0o0S0n\^`'0n&default-value;0L0B0‹X4T0’–d0D0f0oÿ &application;0k0ˆ0‹zzv}0nSÖbq0D0k0d0D0fÿ 0D0K0j0‹aVó0‚y:0U0j0D0h‰ã‘È0Y0‹0</p> <p>O‹0’k!0ky:0Y0 <eg><![CDATA[ <!ATTLIST poem xml:space (default|preserve) 'preserve'>]]></eg> </p> </div2> <div2 id='sec-line-ends'> <head>ˆLg+0nSÖbq0D</head> <p>XML0n<termref def='dt-parsedent'>iËe‡&parsed-entity;</termref>0oÿ ^80³0ó0Ô0å0ü0¿0n0Õ0¡0¤0ëQ…0kOÝ[X0U0Œÿ }è–Æ0nO¿[œ0n0_00k‰ep0nˆL0kR0Q0‹0S0h0LY0D00S0Œ0‰0nˆL0oÿ fn0oÿ <code>CR</code> (#xD)0³0ü0ÉSÊ0s <code>LF</code> (#xA)0³0ü0É0nOU0‰0K0n}DT0[0k0ˆ0c0fR0Q0‰0Œ0‹0</p> <p><termref def='dt-app'>&application;</termref>0nQæt0’|!SX0k0Y0‹0_0ÿ Yè&parsed-entity;SÈ0oQ…è&parsed-entity;0n&literal;[ŸOSP$0Lÿ "<code>#xD#xA</code>" 0nÿe‡[W0n#}š0h0Y0‹&literal;SÈ0o<code>#xD</code>0nSXrì0n&literal;0’T+0€X4T0kÿ <termref def='dt-xml-proc'>XML&processor;</termref>0oÿ &application;0kSXN0ne‡[W<code>#xA</code>0`0Q0’n!0U0j0Q0Œ0p0j0‰0j0D(0S0nQæt0oÿ QeR›Q…0k[XW(0Y0‹e9ˆL0³0ü0É0’iËe‡‰ãg0nRM0kkc‰S0Y0‹0S0h0k0ˆ0c0fÿ [¹f0k[Ÿsþ0g0M0‹0)0</p> </div2> <div2 id='sec-lang-tag'> <head>&language-identification;</head> <p>e‡føQæt0k0J0D0f0oÿ 0]0ne‡fø0nN-Ž«0L0i0“0jêq6ŠŠžSÈ0o_b_ŠŠž0gfø0K0Œ0f0D0‹0Kfy:0Y0‹0S0h0Lÿ _y0kzË0d0S0h0LY0D0<!--0S0S0gOu(0Y0‹ ŠŠž 0h0D0FŠ„I0naTs0oÿ "Espa&#x00F1;ol" SÊ0s"EBNF"0nSÌe¹0gO‹y:0U0Œ0‹aTs0h0Y0‹0--><!-- x00F1: spanish's small ntilde--></p> <!--; 0S0n`ÅX10oÿO‹0’0B0R0Œ0pÿ e‡fø0ne‡[W0nˆhy:ÿ N&0s0k`ÅX1b½Qú0n0_00nŠž^y0û_baK} ‰ãgSÊ0s0Æ0­0¹0È0Ö0í0Ã0¯0net_b0k_q—ÿ0’SÊ0|0YSï€ý`'0L0B0‹0--> <p>XMLe‡føQ…0n‰} 0n0‚0dQ…[¹SÈ0o\^`'P$0k0J0D0fOu(0Y0‹<!--êq6SÈ0o_b_-->ŠŠž0’c[š0Y0‹0_00kÿ "<code>xml:lang</code>" 0h0D0FT RM0nryR%0j<termref def="dt-attr">\^`'</termref>0’ÿ e‡føQ…0kc?Qe0W0f0‚0ˆ0D0 <!--; 0S0n\^`'0oXML‰[š0nNè0h0W0fÿ ‰ep0nXML&application;0nvøN’Ku(`'0’šØ00‹0_00k[š©0Y0‹0--> \^`'0nP$0oÿ <bibref ref="RFC1766"/> RFC1766ÿ&language-identification;0n0_00n0¿0° 0k0ˆ0c0f‰[š0U0Œ0‹&language-identification;0³0ü0É0k_“0F0 <scrap lang='ebnf'> <head>&language-identification;</head> <prod id='NT-LanguageID'><lhs>LanguageID</lhs> <rhs><nt def='NT-Langcode'>Langcode</nt> ('-' <nt def='NT-Subcode'>Subcode</nt>)*</rhs></prod> <prod id='NT-Langcode'><lhs>Langcode</lhs> <rhs><nt def='NT-ISO639Code'>ISO639Code</nt> | <nt def='NT-IanaCode'>IanaCode</nt> | <nt def='NT-UserCode'>UserCode</nt></rhs> </prod> <prod id='NT-ISO639Code'><lhs>ISO639Code</lhs> <rhs>([a-z] | [A-Z]) ([a-z] | [A-Z])</rhs></prod> <prod id='NT-IanaCode'><lhs>IanaCode</lhs> <rhs>('i' | 'I') '-' ([a-z] | [A-Z])+</rhs></prod> <prod id='NT-UserCode'><lhs>UserCode</lhs> <rhs>('x' | 'X') '-' ([a-z] | [A-Z])+</rhs></prod> <prod id='NT-Subcode'><lhs>Subcode</lhs> <rhs>([a-z] | [A-Z])+</rhs></prod> </scrap> <nt def='NT-Langcode'>Langcode</nt>0oÿ k!0n0i0Œ0g0‚0ˆ0D0 <ulist> <item><p>a) <bibref ref="ISO639"/> ŠŠž0nT RMˆhsþ0n0_00n0³0ü0É 0g‰[š0U0Œ0‹2e‡[W0n&language-code;</p></item> <item><p>b) Internet Assigned Numbers Authority (IANA)0gv{“20U0Œ0f0D0‹&language-code;00S0Œ0oÿ QH˜-0L "<code>i-</code>" (SÈ0o"<code>I-</code>")0gYË0~0‹0</p></item> <item><p>c) &user;0k0ˆ0c0f[š00‰0Œ0_&language-code;ÿ SÈ0oyÁv„0jOu(0n0_00k‰ep0nVãOS•“0LSÖ0Šlz00_0³0ü0É00S0Œ0‰0oÿ NÊ_ŒIANA0k0J0D0fjn–SSÈ0ov{“20U0Œ0‹0³0ü0É0h0nzöT0’0Q0‹0_00kÿ QH˜-0’"<code>x-</code>" SÈ0o "<code>X-</code>" 0gYË00‹0</p></item> </ulist></p> <p><nt def='NT-Subcode'>Subcode</nt>0oÿ ‰epVÞO0c0f0‚0ˆ0D0gR0n0µ0Ö0³0ü0É0L[XW(0Wÿ 0]0nQ…[¹0LNŒ0d0ne‡[W0K0‰b0‹0h0M0oÿ <bibref ref="ISO3166"/>ISO31660n VýT 0’ˆh0Y0³0ü0É(Vý0³0ü0É) 0g0j0Q0Œ0p0j0‰0j0D0gR0n0µ0Ö0³0ü0É0L3e‡[WNåN 0K0‰b0‹0h0M0oÿ <nt def='NT-Langcode'>Langcode</nt>0nQH˜-0Lÿ "<code>x-</code>" SÈ0o "<code>X-</code>"0gYË0~0‰0j0D–P0Šÿ c[š0W0_ŠŠž0k[þ0Y0‹0µ0Ö0³0ü0É0h0Wÿ IANA0kv{“20U0Œ0_0‚0n0g0j0Q0Œ0p0j0‰0j0D0</p> <p>&language-code;0oÿ \e‡[W0g0nˆhŠ0’ÿ &country-code;0oÿ ([XW(0Y0‹0j0‰0p)Y'e‡[W0g0nˆhŠ0’acˆL0h0Y0‹00W0K0Wÿ XMLe‡føQ…0k0J0Q0‹NÖ0nT RM0h0oup0j0Šÿ 0S0Œ0‰0nP$0k0d0D0f0oÿ Y'e‡[WSÊ0s\e‡[W0nS:R%0’0W0j0D0S0h0klèa0Y0‹0S0h0</p> <p>O‹0’k!0ky:0Y0 <eg><![CDATA[<p xml:lang="en">The quick brown fox jumps over the lazy dog.</p> <p xml:lang="en-GB">What colour is it?</p> <p xml:lang="en-US">What color is it?</p> <sp who="Faust" desc='leise' xml:lang="de"> <l>Habe nun, ach! Philosophie,</l> <l>Juristerei, und Medizin</l> <l>und leider auch Theologie</l> <l>]]><!-- x00DF german's es-zet; x00FC german's u-umlaut -->durchaus studiert mit hei&#223;em Bem&#252;h'n.<![CDATA[</l> </sp>]]></eg></p> <!--<p>xml:lang 0nP$0oÿ ‰} 0nQ…[¹SÊ0s(\^`'0n&default-value;0g[š00j0D–P0Š)0Õ0ê0ü0Æ0­0¹0È(CDATA)0nP$0’0‚0d0]0n‰} 0x0n0Y0y0f0n\^`'0nP$0k0d0D0fÿ 0]0nN!e¹0kiu(0Y0‹0--> <p><code>xml:lang</code>0g[£Š0Y0‹aVó0oÿ <code>xml:lang</code>0nR%0nc[š0gN fø0W0j0D–P0Šÿ c[š0W0_‰} 0nQ…[¹0kT+0€0Y0y0f0n‰} 0kiu(0Y0‹0</p> <!--0B0‹‰} 0k0J0Q0‹ xml:lang \^`'0nP$0L[š00‰0Œ0f0J0‰0Zÿ DTD0k0J0D0f0]0n&default-value;0L[š00‰0Œ0f0D0j0DX4Tÿ 0]0n‰} 0nxml:lang \^`'0nP$0oÿ ‰ª‰} 0g0nP$0L[XW(0Y0‹X4T0oÿ 0]0Œ0’_0M}™0P0 k!0nO‹0k0J0Q0‹NŒ0d0n<term>0h0D0FT RM0n\•€u(Šž0’ˆh0Y‰} 0oÿ xml:lang0nP$0k•¢0W0f0oÿ [Ÿ–›N ÿ T 0XP$0’0‚0d0 <p xml:lang="en">Here the keywords are <term xml:lang="en">shift</term> and <term>reduce</term>. ...</p> XML&processor;0g0o0j0O&application;0Lÿ 0S0n\^`'P$0n}™b0k0d0D0fŒ¬Nû0’0‚0d0 --> <p> &valid;0je‡fø0k0J0D0f0oÿ 0S0n&TR-or-Rec;0nNÖ0nX4b@0g‰[š0Y0‹0h0J0Šÿ 0S0n\^`'0’_Å0Z[£Š0W0j0Q0Œ0p0j0‰0j0D0^8ÿ [£Š0oÿ k!0n_b0h0Y0‹0 <eg>xml:lang NMTOKEN #IMPLIED</eg> _ʼn0j0‰0pÿ ry[š0n&default-value;0’N0H0f0‚0ˆ0D0‚ñŠž0’kÍŠž0h0Y0‹[fuu(0n0Õ0é0ó0¹Šž0nŠi–Æ0g0oÿ Š¬fSÊ0slè0’‚ñŠž0gŠð0Y0Œ0pÿ xml:lang \^`'0’k!0n0h0J0Š0k[£Š0Y0‹0S0h0h0j0‹0 <eg><![CDATA[ <!ATTLIST poem xml:lang NMTOKEN 'fr'> <!ATTLIST gloss xml:lang NMTOKEN 'en'> <!ATTLIST note xml:lang NMTOKEN 'en'>]]></eg> </p> <!-- DTD0nŠ-Š€0oÿ 0¹0¯0ê0×0È0’ŠŠž(SÊ0s0]0nm>uOS)0kSdB0W0fbq0F0n0g0o0j0Oÿ 0¹0¯0ê0×0ÈSÊ0sŠŠž0’T k!QC0gbq0F0n0Li_S0jX4Tÿ ŠŠž\^`'0hT iØ0k0¹0¯0ê0×0È\^`'0L[XW(0Y0Œ0pg u(0`0h`0F0K0‚0W0Œ0j0D00ê0ó0¯‰} 0k0J0D0fÿ SÂqg0U0Œ0_SÈ0o0ê0ó0¯0U0Œ0_0ê0½0ü0¹0k0J0Q0‹(N;‰0j)ŠŠž(X4T0k0ˆ0c0f0o‰ep)0’ˆh0Y‰} 0’[š©0Y0‹0n0‚g0~0W0D00W0K0Wÿ 0S0Œ0‰0n&application;0oÿ 0S0n&TR-or-Rec;0L‰[š0Y0‹{ÄVòY0h0Y0‹0--> </div2> </div1> <!-- &Elements; --> <div1 id='sec-logical-struct'> <head>ŠÖtiË </head> <p><termdef id="dt-element" term="Element">0D0K0j0‹<termref def="dt-xml-doc">XMLe‡fø</termref>0‚ÿ N0dNåN 0n<term>‰} </term>0’T+0€0‰} 0nXƒuL0o, <termref def="dt-stag">•‹YË0¿0°</termref>SÊ0s<termref def="dt-etag">}BN†0¿0°</termref>0k0ˆ0c0fS:R0‹0‰} 0L<termref def="dt-empty">zz</termref>‰} 0n0h0M0oÿ <termref def="dt-eetag">zz‰} 0¿0°</termref>0gy:0Y0T00n‰} 0oÿ W‹0’0‚0d0‰} W‹0oT RM(Qq&identifier;(generic identifier)SÈ0oGI0hT|0v0S0h0L0B0‹0)0k0ˆ0c0f&identified;0‰} 0oÿ 0D0O0d0K0n\^`'0’0‚0d0S0h0L0g0M0‹0</termdef>\^`'0oÿ <termref def="dt-attrname">T RM</termref>SÊ0s<termref def="dt-attrval">P$</termref>0’0‚0d0</p> <scrap lang='ebnf'><head>‰} </head> <prod id='NT-element'><lhs>element</lhs> <rhs><nt def='NT-EmptyElemTag'>EmptyElemTag</nt></rhs> <rhs>| <nt def='NT-STag'>STag</nt> <nt def='NT-content'>content</nt> <nt def='NT-ETag'>ETag</nt></rhs><wfc def='GIMatch'/></prod> </scrap> <p>0S0n&TR-or-Rec;0oÿ ‰} W‹SÊ0s\^`'0naTsÿ Ou(e¹lÕÿ SÈ0o(iËe‡0k•¢0Y0‹0S0h0’–d0M)T RM0kR6}0’N0H0j0D00_0`0Wÿ QH˜-0L<code>(('X'|'x')('M'|'m')('L'|'l'))</code>0k&match;0Y0‹T RM0oÿ 0S0nrHSÈ0oNÊ_Œ0nrH0n0S0n&TR-or-Rec;0g0njn–S0n0_00kNˆ}0Y0‹0</p> <wfcnote id='GIMatch'><head>‰} W‹0n&match;</head> <p>‰} 0n}BN†0¿0°0n<nt def='NT-Name'>T RM</nt>0oÿ 0]0n‰} 0n•‹YË0¿0°0k0J0Q0‹W‹0h&match;0W0j0Q0Œ0p0j0‰0j0D0</p> </wfcnote> <div2 id='sec-starttags'> <head>•‹YË0¿0°ÿ }BN†0¿0°SÊ0szz‰} 0¿0°</head> <p><termdef id="dt-stag" term="Start-Tag">zz0g0j0DNûa0nXML‰} 0nYË0~0Š0oÿ <term>•‹YË0¿0°</term>0k0ˆ0c0f&markup;0Y0‹0 <scrap lang='ebnf'><head>•‹YË0¿0°</head> <prodgroup pcw2="6" pcw4="15" pcw5="11.5"> <prod id='NT-STag'><lhs>STag</lhs><rhs>'&lt;' <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Attribute'>Attribute</nt>)* <nt def='NT-S'>S</nt>? '>'</rhs><wfc def="uniqattspec"/></prod> <prod id='NT-Attribute'><lhs>Attribute</lhs><rhs><nt def='NT-Name'>Name</nt> <nt def='NT-Eq'>Eq</nt> <nt def='NT-AttValue'>AttValue</nt></rhs><vc def='ValueType'/><wfc def='NoExternalRefs'/><wfc def='CleanAttrVals'/></prod> </prodgroup> </scrap> •‹YË0¿0°SÊ0s}BN†0¿0°Q…0n<nt def='NT-Name'>Name</nt>0oÿ ‰} 0n<term>W‹</term>0’ˆh00Y0</termdef><termdef id="dt-attr" term="Attribute"><nt def='NT-Name'>Name</nt>SÊ0s<nt def='NT-AttValue'>AttValue</nt>0n[þ0’‰} 0n<term>\^`'c[š</term>0h0D0D</termdef>ÿ <termdef id="dt-attrname" term="Attribute Name">P 00n[þ0k0J0Q0‹<nt def='NT-Name'>Name</nt>0oÿ <term>\^`'T </term></termdef>SÊ0s<termdef id="dt-attrval" term="Attribute Value"><nt def='NT-AttValue'>AttValue</nt>0nQ…[¹(S:R0Š[P<code>'</code>SÈ0o<code>"</code>0n•“0n&string;)0’<term>\^`'P$</term>0h0D0F0</termdef></p> <wfcnote id='uniqattspec'><head>\^`'c[š0nNa`'</head> <p>•‹YË0¿0°SÈ0ozz‰} 0¿0°0g0oÿ T N0n\^`'T 0Lÿ^¦NåN Qúsþ0W0f0o0j0‰0j0D0</p></wfcnote> <vcnote id='ValueType'><head>\^`'P$0nW‹</head> <p>\^`'0o[£Š0U0Œ0f0D0j0Q0Œ0p0j0‰0j0D0\^`'P$0nW‹0oÿ 0]0n\^`'0k[þ0W0f[£Š0W0_W‹0g0j0Q0Œ0p0j0‰0j0D(\^`'0nW‹0k0d0D0f0oÿ <titleref href='AttDecls'>\^`'0ê0¹0È[£Š</titleref>0k0d0D0f0n‰[š0’SÂqg0)0</p></vcnote> <wfcnote id='NoExternalRefs'><head>Yè[ŸOS0x0nSÂqg0L0j0D0S0h</head> <p>\^`'P$0k0oÿ Yè[ŸOS0x0nvôc¥v„SÈ0o•“c¥v„0jSÂqg0’T+0€0S0h0o0g0M0j0D0</p></wfcnote> <wfcnote id='CleanAttrVals'><head>\^`'P$0k<code>&lt;</code>0’T+0~0j0D0S0h</head> <p>\^`'P$Q…0gvôc¥v„SÈ0o•“c¥v„0kSÂqg0Y0‹[ŸOS(<code>&amp;lt;</code>0’–d0O0)0n<termref def='dt-repltext'>&replacement-text;</termref>0k0oÿ <code>&lt;</code>0’T+0“0g0o0j0‰0j0D0</p></wfcnote> <p>•‹YË0¿0°0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;termdef id="dt-dog" term="dog"></eg></p> <p><termdef id="dt-etag" term="End Tag">•‹YË0¿0°0gYË0~0‹‰} 0n}B00Š0oÿ <term>}BN†0¿0°</term>0g&markup;0W0j0Q0Œ0p0j0‰0j0D00S0n}BN†0¿0°0oÿ [þ_Ü0Y0‹•‹YË0¿0°0n‰} W‹0hT 0XT RM0’0‚0d0 <scrap lang='ebnf'><head>}BN†0¿0°</head><prodgroup pcw2="6" pcw4="15" pcw5="11.5"><prod id='NT-ETag'><lhs>ETag</lhs><rhs>'&lt;/' <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt>? '>'</rhs></prod></prodgroup></scrap></termdef></p> <p>}BN†0¿0°0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;/termdef></eg></p> <p><termdef id="dt-content" term="Content">‰} 0n•‹YË0¿0°0h}BN†0¿0°0h0n•“0n<termref def='dt-text'>0Æ0­0¹0È</termref>0’ÿ 0]0n‰} 0n<term>Q…[¹</term>0h0D0F0 <scrap lang='ebnf'><head>‰} 0nQ…[¹</head> <prodgroup pcw2="6" pcw4="15" pcw5="11.5"><prod id='NT-content'><lhs>content</lhs><rhs>(<nt def='NT-element'>element</nt> | <nt def='NT-CharData'>CharData</nt> | <nt def='NT-Reference'>Reference</nt> | <nt def='NT-CDSect'>CDSect</nt> | <nt def='NT-PI'>PI</nt> | <nt def='NT-Comment'>Comment</nt>)*</rhs></prod></prodgroup></scrap></termdef></p> <p><termdef id="dt-empty" term="Empty">‰} 0L<term>zz</term>0n0h0Mÿ 0]0n‰} 0oÿ vô_Œ0k}BN†0¿0°0’0‚0d•‹YË0¿0°SÈ0ozz‰} 0¿0°0gˆhsþ0W0j0Q0Œ0p0j0‰0j0D0</termdef><termdef id="dt-eetag" term="empty-element tag"><term>zz‰} 0¿0°</term>0oÿ k!0nryR%0j_b_0’0h0‹0 <scrap lang='ebnf'><head>zz‰} 0n0_00n0¿0°</head><prodgroup pcw2="6" pcw4="15" pcw5="11.5"><prod id='NT-EmptyElemTag'><lhs>EmptyElemTag</lhs><rhs>'&lt;' <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Attribute'>Attribute</nt>)* <nt def='NT-S'>S</nt>? '/&gt;'</rhs><wfc def="uniqattspec"/></prod></prodgroup></scrap></termdef></p> <!-- •€™¬ÿN 0n zz‰} 0n0_00n0¿0°(tags for empty elements) 0o zz‰} 0¿0°(empty-element tag) 0h0Y0y0M0`0h`0D0~0Y0Lÿ 0D0K0L0g0W0‡0F0K --> <p>zz‰} 0¿0°0oÿ Q…[¹0’0‚0_0j0DNûa0n‰} 0nˆhsþ0kR)u(0g0M0‹0zz‰} 0¿0°0gˆhsþ0Y0‹‰} 0’ÿ 0­0ü0ï0ü0É<kw>EMPTY</kw>0’u(0D0f[£Š0W0j0O0h0‚0ˆ0D0</p> <p>zz‰} 0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;IMG align="left" src="http://www.w3.org/Icons/WWW/w3c_home" />&lt;br>&lt;/br>&lt;br/></eg></p> </div2> <div2 id='elemdecls'><head>‰} [£Š</head> <p><termref def="dt-valid">&validity;</termref>0’OÝŠ<0Y0‹0_0ÿ ‰} [£ŠSÊ0s\^`'0ê0¹0È[£Š0’u(0D0f<termref def="dt-xml-doc">XMLe‡fø</termref>0n<termref def="dt-element">‰} </termref>0niË 0kÿ R6}0’R 0H0‹0S0h0L0g0M0‹0</p> <p>‰} [£Š0oÿ ‰} 0n<termref def="dt-content">Q…[¹</termref>0k0d0D0f0nR6}0h0Y0‹0</p> <p>‰} [£Š0oÿ ‰} 0n<termref def="dt-parentchild">[P</termref>0h0W0fQúsþSï€ý0j‰} W‹0k0d0D0fÿ R6}0’R 0H0‹0S0h0LY0D0&at-user-option;ÿ ‰} [£Š0’0‚0_0j0D‰} W‹0LNÖ0n‰} [£Š0k0ˆ0c0fSÂqg0U0Œ0Œ0pÿ XML&processor;0oÿ ‹fTJ0’Qú0W0f0‚0ˆ0D00W0K0Wÿ 0S0Œ0o&error;0h0o0W0j0D0</p> <p><termdef id="dt-eldecl" term="Element Type declaration"><term>‰} W‹[£Š</term>0oÿ k!0n_b_0’0h0‹0 <scrap lang='ebnf'><head>‰} W‹[£Š</head><prodgroup pcw2="5.5" pcw4="18" pcw5="9"> <prod id='NT-elementdecl'><lhs>elementdecl</lhs> <rhs>'&lt;!ELEMENT' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> <nt def='NT-contentspec'>contentspec</nt> <nt def='NT-S'>S</nt>? '>'</rhs> <vc def='EDUnique'/></prod> <prod id='NT-contentspec'><lhs>contentspec</lhs> <rhs>'EMPTY' | 'ANY' | <nt def='NT-Mixed'>Mixed</nt> | <nt def='NT-children'>children</nt> </rhs> <vc def='elementvalid'/> </prod> </prodgroup> </scrap> 0S0S0gÿ <nt def='NT-Name'>Name</nt>0oÿ [£Š0U0Œ0f0D0‹‰} 0nW‹0h0Y0‹0</termdef></p> <vcnote id='EDUnique'><head>‰} [£Š0nNa`'</head> <p>‰} W‹0’ÿ^¦NåN [£Š0g0M0j0D0</p></vcnote> <vcnote id='elementvalid'><head>‰} 0n&validity;</head> <p>‰} 0L<!-- said to be -->&valid;0h0oÿ <nt def='NT-elementdecl'>elementdecl</nt>0k&match;0Y0‹[£Š0g0B0c0fÿ 0]0n<nt def='NT-Name'>Name</nt>0L0]0n‰} W‹0h&match;0Wÿ k!0n0D0Z0Œ0K0ngaNö0’n€0_0YX4T0h0Y0‹0<ulist> <item><p>a) [£Š0L<kw>EMPTY</kw>0k&match;0Wÿ ‰} 0L<termref def='dt-content'>Q…[¹</termref>0’0‚0_0j0D0</p></item> <item><p>b) [£Š0L<nt def='NT-children'>children</nt>0k&match;0Wÿ ‰} 0n<termref def="dt-parentchild">[P‰} </termref>0nN&0s0Lÿ Q…[¹0â0Ç0ë0nkc‰ˆhsþ0k0ˆ0c0fub0U0Œ0‹ŠŠž0k\^0Y0‹0</p></item> <item><p>c) [£Š0L<nt def='NT-Mixed'>mixed</nt>0k&match;0Wÿ ‰} 0nQ…[¹0L<termref def='dt-chardata'>e‡[W0Ç0ü0¿</termref>SÊ0s<termref def='dt-parentchild'>[P‰} </termref>0K0‰0j0‹0[P‰} 0n‰} W‹0oÿ ‰} 0nQ…[¹0â0Ç0ë0kQúsþ0Y0‹T RM0k&match;0Y0‹0</p></item> <item><p>d) [£Š0L<kw>ANY</kw>0k&match;0Wÿ 0i0n<termref def='dt-parentchild'>[P‰} </termref>0n‰} W‹0‚[£Š0U0Œ0f0D0‹0</p></item></ulist> </p></vcnote> <!-- with the new VC, I don't think the next few paras add anything -TWB <p><termdef id="dt-model" term="content model">An element can declared using a <term>content model</term>, in which case its content can be categorized as <termref def="dt-elemcontent">element content</termref> or <termref def='dt-mixed'>mixed content</termref>, as explained below.</termdef></p> <p>An element whose type declared using the keyword <kw>EMPTY</kw> must be <termref def="dt-empty">empty</termref> and may be tagged using an <termref def="dt-eetag">empty-element tag</termref> when it appears in the document.</p> <p>If an element type is declared using the keyword <kw>ANY</kw>, then there are no validity constraints on its content: it may contain <termref def='dt-parentchild'>child elements</termref> of any type and number, interspersed with character data.</p> --> <p>‰} [£Š0nO‹0’ÿ k!0ky:0Y0 <eg> &lt;!ELEMENT br EMPTY> &lt;!ELEMENT p (#PCDATA|emph)* > &lt;!ELEMENT %name.para; %content.para; > &lt;!ELEMENT container ANY> </eg></p> <div3 id='sec-element-content'><head>‰} Q…[¹</head> <p><termdef id='dt-elemcontent' term='Element content'>0B0‹W‹0n‰} 0L<termref def='dt-parentchild'>[P</termref>‰} 0`0Q0’T+0€(e‡[W0Ç0ü0¿0’T+0~0j0D0)0h0Mÿ 0]0n‰} <termref def="dt-stag">W‹</termref>0oÿ <term>‰} Q…[¹</term>0’0‚0dÿ 0h0D0F0</termdef>0S0nX4Tÿ R6}0oÿ Q…[¹0â0Ç0ë0’T+0€0Q…[¹0â0Ç0ë0oÿ [P‰} 0nW‹SÊ0s[P‰} 0nQúsþ˜^0’R6_¡0Y0‹|!SX0je‡lÕ0h0Y0‹00S0ne‡lÕ0oÿ &content-particle;(<nt def='NT-cp'>cp</nt>s)0K0‰0j0‹0&content-particle;0oÿ T RMÿ &content-particle;0nxbž0ê0¹0ÈSÈ0o&content-particle;0nR0ê0¹0È0K0‰iËb0U0Œ0‹0 <scrap lang='ebnf'><head>‰} Q…[¹0â0Ç0ë</head><prodgroup pcw2="5.5" pcw4="16" pcw5="11"> <prod id='NT-children'><lhs>children</lhs><rhs>(<nt def='NT-choice'>choice</nt> | <nt def='NT-seq'>seq</nt>) ('?' | '*' | '+')?</rhs></prod><prod id='NT-cp'><lhs>cp</lhs><rhs>(<nt def='NT-Name'>Name</nt> | <nt def='NT-choice'>choice</nt> | <nt def='NT-seq'>seq</nt>) ('?' | '*' | '+')?</rhs></prod> <prod id='NT-choice'><lhs>choice</lhs><rhs>'(' <nt def='NT-S'>S</nt>? cp ( <nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def='NT-cp'>cp</nt> )*<nt def='NT-S'>S</nt>? ')'</rhs><vc def='vc-PEinGroup'/></prod> <prod id='NT-seq'><lhs>seq</lhs><rhs>'(' <nt def='NT-S'>S</nt>? cp ( <nt def='NT-S'>S</nt>? ',' <nt def='NT-S'>S</nt>? <nt def='NT-cp'>cp</nt> )*<nt def='NT-S'>S</nt>? ')'</rhs><vc def='vc-PEinGroup'/></prod> <!-- <prod id='NT-cps'><lhs>cps</lhs><rhs><nt def='NT-S'>S</nt>? <nt def='NT-cp'>cp</nt> <nt def='NT-S'>S</nt>?</rhs></prod> <prod id='NT-choice'><lhs>choice</lhs><rhs>'(' <nt def='NT-S'>S</nt>? <nt def='NT-ctokplus'>ctokplus</nt> (<nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def='NT-ctoks'>ctoks</nt>)* <nt def='NT-S'>S</nt>? ')'</rhs></prod> <prod id="NT-ctokplus"><lhs>ctokplus</lhs><rhs><nt def="NT-cps">cps</nt>('|' <nt def="NT-cps">cps</nt>)+</rhs></prod> <prod id="NT-ctoks"><lhs>ctoks</lhs><rhs><nt def="NT-cps">cps</nt>('|' <nt def="NT-cps">cps</nt>)*</rhs></prod> <prod id='NT-seq'><lhs>seq</lhs><rhs>'(' <nt def='NT-S'>S</nt>?<nt def='NT-stoks'>stoks</nt> (<nt def='NT-S'>S</nt>? ',' <nt def='NT-S'>S</nt>? <nt def='NT-stoks'>stoks</nt>)*<nt def='NT-S'>S</nt>? ')'</rhs></prod> <prod id="NT-stoks"><lhs>stoks</lhs><rhs><nt def="NT-cps">cps</nt>(',' <nt def="NT-cps">cps</nt>)*</rhs></prod> --> </prodgroup></scrap> 0S0S0gÿ <nt def='NT-Name'>Name</nt>0oÿ <termref def="dt-parentchild">[P</termref>0h0W0fQúsþ0W0f0ˆ0D‰} 0nW‹0’y:0Y00S0ne‡lÕ0gxbž0ê0¹0È0Lsþ0Œ0‹OMn0g0oÿ xbž0ê0¹0ÈQ…0n0D0Z0Œ0n&content-particle;0‚<termref def="dt-elemcontent">‰} Q…[¹</termref>0nN-0ksþ0Œ0f0ˆ0D0R0ê0¹0È0ksþ0Œ0‹&content-particle;0oÿ 0ê0¹0È0gc[š0Y0‹˜uj0n0h0J0Š0kÿ <termref def="dt-elemcontent">‰} Q…[¹</termref>0ksþ0Œ0j0Q0Œ0p0j0‰0j0D0T RMSÈ0o0ê0¹0È0n_Œ0kQúsþ0Y0‹0ª0×0·0ç0ó0ne‡[W<!-- •€™¬ÿcharacter0’e‡[W0hŠ30W0~0W0_ -->0oÿ 0ê0¹0ÈQ…0n‰} SÈ0o&content-particle;0Lÿ 1VÞNåN Nûa0nVÞep(<code>+</code>)ÿ 0VÞNåN Nûa0nVÞep(<code>*</code>)SÈ0o0VÞ‚å0W0O0o1VÞ(<code>?</code>)QúsþSï€ý0j0S0h0’‰[š0Y0‹00S0S0gy:0YiËe‡SÊ0saTs0oÿ 0S0n&TR-or-Rec;0k0J0Q0‹ub‰RG0gu(0D0‹0‚0n0hT N0h0Y0‹0</p> <!-- •€™¬ÿN 0ne‡0g0oÿ nameSÈ0olist0n_Œ0k}š0Oe‡[W 0L list0nQúsþ0’‰[š0Y0‹ 0h0B0c0fÿ name0nQúsþ0’‰[š0Y0‹0h0ofø0D0f0B0Š0~0[0“0Oîkc0L_ʼn0h€0H0~0Y0 --> <p>‰} 0nQ…[¹0LQ…[¹0â0Ç0ë0k&match;0Y0‹0n0oÿ Rÿ xbžSÊ0s~pÔ0Wo{—[P0k0W0_0L0c0fÿ Q…[¹0nN-0n‰} 0hQ…[¹0â0Ç0ëQ…0n‰} W‹0h0’&match;0U0[0j0L0‰ÿ Q…[¹0â0Ç0ëQ…0nN0d0n0Ñ0¹0’0_0i0Œ0‹0h0M0k–P0‹0<termref def='dt-compat'>N’cÛ`'0n0_0</termref>ÿ e‡føQ…0n‰} 0Lÿ Q…[¹0â0Ç0ë0k0J0Q0‹‰} W‹0n‰ep0nQúsþOMn0h&match;0Y0‹0S0h0oÿ &error;0h0Y0‹0Šs}00j‰[š0k0d0D0f0oÿ –D\^fø0n<titleref xml-link="simple" href="determinism">lz[šv„Q…[¹0â0Ç0ë</titleref>0n˜0’SÂqg0 <!-- appendix <specref ref="determinism"/>. --> <!-- appendix on deterministic content models. --> </p> <vcnote id='vc-PEinGroup'> <head>0°0ë0ü0×SÊ0s0Ñ0é0á0¿[ŸOS0LS³[Æ0jQe0Œ[P0’0j0W0f0D0‹0S0h</head> <p>0Ñ0é0á0¿[ŸOS0n<termref def='dt-repltext'>&replacement-text;</termref>0oÿ &parenthesis;0gVò0~0Œ0_0°0ë0ü0×0k0ˆ0c0fÿ S³[Æ0jQe0Œ[P0’iËb0W0j0Q0Œ0p0j0‰0j0D00d0~0Šÿ <nt def='NT-choice'>xbž</nt>ÿ <nt def='NT-seq'>R</nt>SÈ0o<nt def='NT-Mixed'>m÷W(</nt>èTÁ0kÿ &left-parenthesis;SÈ0o&right-parenthesis;0n0D0Z0Œ0KNe¹0L<termref def='dt-PERef'>0Ñ0é0á0¿[ŸOS</termref>0n&replacement-text;0kT+0Œ0Œ0pÿ NÖe¹0‚T 0X&replacement-text;0kT+0~0Œ0j0Q0Œ0p0j0‰0j0D0</p> <p><termref def='dt-interop'>vøN’Ku(`'0n0_0</termref>ÿ 0Ñ0é0á0¿[ŸOSSÂqg0L<nt def='NT-choice'>xbž</nt>ÿ <nt def='NT-seq'>R</nt>SÈ0o<nt def='NT-Mixed'>m÷W(</nt>Q…[¹0kT+0~0Œ0Œ0pÿ 0]0n&replacement-text;0ozz0g0j0D0S0h0Lg0~0W0Oÿ &replacement-text;0nQH˜-SÊ0sg+\>0nzzv}0g0j0De‡[W0oÿ 0³0Í0¯0¿(<code>|</code>SÈ0o<code>,</code>)0g0j0De¹0L0ˆ0D0 </p> </vcnote> <p>‰} Q…[¹0â0Ç0ë0n0D0O0d0K0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;!ELEMENT spec (front, body, back?)> &lt;!ELEMENT div1 (head, (p | list | note)*, div2*)> &lt;!ELEMENT dictionary-body (%div.mix; | %dict.mix;)*></eg></p> </div3> <div3 id='sec-mixed-content'> <head>&mixed-content;</head> <p><termdef id='dt-mixed' term='Mixed Content'>0B0‹‰} W‹0n‰} Q…0kÿ <termref def="dt-parentchild">[P</termref>‰} 0km÷W(0W0fe‡[W0Ç0ü0¿0LT+0~0Œ0‹Sï€ý`'0L0B0‹0h0Mÿ 0]0n‰} <termref def='dt-stag'>W‹</termref>0oÿ <term>&mixed-content;</term>0’0‚0d0h0D0F0</termdef>0S0nX4Tÿ [P‰} 0nW‹0k0d0D0f0nR6}0L[XW(0W0f0‚0ˆ0D<!-- •€™¬ÿ may be constrained 0’SX0k0 R6}0U0Œ0‹0 0hŠ30W0~0W0_0 -->0Lÿ [P‰} 0n˜^SÈ0oQúsþVÞep0k0d0D0f0nR6}0o0j0D0h0Y0‹0 <scrap lang='ebnf'> <head>&mixed-content;[£Š</head> <prodgroup pcw2="5.5" pcw4="16" pcw5="11"> <prod id='NT-Mixed'><lhs>Mixed</lhs> <rhs>'(' <nt def='NT-S'>S</nt>? '#PCDATA' (<nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def='NT-Name'>Name</nt>)* <nt def='NT-S'>S</nt>? ')*' </rhs> <rhs>| '(' <nt def='NT-S'>S</nt>? '#PCDATA' <nt def='NT-S'>S</nt>? ')' </rhs><vc def='vc-PEinGroup'/> <vc def='vc-MixedChildrenUnique'/> </prod> <!-- <prod id="NT-Mtoks"><lhs>Mtoks</lhs> <rhs><nt def="NT-Name">Name</nt> (<nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def="NT-Name">Name</nt>)* </rhs> </prod> --> </prodgroup> </scrap> 0S0S0gÿ <nt def='NT-Name'>Name</nt>0oÿ [P0h0W0fQúsþ0W0f0‚0ˆ0D‰} 0nW‹0’y:0Y0 </p> <vcnote id='vc-MixedChildrenUnique'> <head>‰} W‹0n‘͉0nykb</head> <p>N0d0n&mixed-content;[£ŠQ…0kÿ T 0XT RM0L‰epVÞQúsþ0W0f0o0j0‰0j0D0 </p></vcnote> <p>&mixed-content;[£Š0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;!ELEMENT p (#PCDATA|a|ul|b|i|em)*> &lt;!ELEMENT p (#PCDATA | %font; | %phrase; | %special; | %form;)* > &lt;!ELEMENT b (#PCDATA)></eg></p> </div3> </div2> <div2 id='attdecls'> <head>\^`'0ê0¹0È[£Š</head> <p> <termref def="dt-attr">\^`'</termref>0oÿ T RMSÊ0sP$0n[þ0’<termref def="dt-element">‰} </termref>0k•¢#NØ0Q0‹0_00ku(0D0‹0\^`'c[š0oÿ <termref def="dt-stag">•‹YË0¿0°</termref>SÈ0o<termref def="dt-eetag">zz‰} </termref>0¿0°Q…0g0`0QSï€ý0h0Y0‹00W0_0L0c0fÿ \^`'0’Š‹X0Y0‹0_00nub‰RG0oÿ <titleref href='sec-starttags'>•‹YË0¿0°</titleref>0k0d0D0f0n‰[š0gy:0Y0\^`'0ê0¹0È[£Š0oÿ k!0nvîv„0gu(0D0‹0 <ulist> <item><p>a) 0B0‹‰} W‹0kiu(0Y0‹\^`'0n–ÆT0’‰[š0Y0‹0</p></item> <item><p>b) \^`'0x0nW‹R6}0’Š-[š0Y0‹0</p></item> <item><p>c) \^`'0n<termref def="dt-default">&default-value;</termref>0’‰[š0Y0‹0</p></item> </ulist> </p> <p> <termdef id="dt-attdecl" term="Attribute-List Declaration"> <term>\^`'0ê0¹0È[£Š</term>0oÿ 0B0‹‰} W‹0h•¢#NØ0Q0‰0Œ0_T\^`'0k[þ0Wÿ T RMÿ 0Ç0ü0¿W‹SÊ0s([XW(0Y0Œ0p)&default-value;0’‰[š0Y0‹0 <scrap lang='ebnf'> <head>\^`'0ê0¹0È[£Š</head> <prod id='NT-AttlistDecl'><lhs>AttlistDecl</lhs> <rhs>'&lt;!ATTLIST' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-AttDef'>AttDef</nt>* <nt def='NT-S'>S</nt>? '&gt;'</rhs> </prod> <prod id='NT-AttDef'><lhs>AttDef</lhs> <rhs><nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> <nt def='NT-AttType'>AttType</nt> <nt def='NT-S'>S</nt> <nt def='NT-Default'>Default</nt></rhs> </prod> </scrap> <nt def='NT-AttlistDecl'>AttlistDecl</nt>‰RG0k[XW(0Y0‹<nt def="NT-Name">Name</nt>0oÿ ‰} W‹0nT RM0h0Y0‹0&at-user-option;ÿ [£Š0W0f0D0j0D‰} W‹0k[þ0W\^`'0’[£Š0W0_0j0‰0pÿ XML&processor;0oÿ ‹fTJ0’Qú0W0f0‚0ˆ0D00W0K0Wÿ 0S0Œ0o&error;0h0o0W0j0D0 <nt def='NT-AttDef'>AttDef</nt>‰RG0k0J0Q0‹<nt def='NT-Name'>Name</nt>0oÿ \^`'0nT RM0h0Y0‹0 </termdef> </p> <p> 0B0‹‰} 0k[þ0W0fÿ ‰ep0n<nt def='NT-AttlistDecl'>AttlistDecl</nt>0’N0H0‹X4Tÿ 0S0Œ0‰0Y0y0f0nQ…[¹0o0Þ0ü0¸0Y0‹00B0‹‰} W‹0nT 0X\^`'0kÿ ‰ep0n[š©0’N0H0‹X4T0k0oÿ gR0n[£Š0’g R¹0h0Wÿ NÖ0n[£Š0oq!‰–0Y0‹0<termref def='dt-interop'>vøN’Ku(`'0n0_00k</termref>ÿ DTD0nO\b€0oÿ 0B0‹‰} W‹0k0ošØ0N0d0n\^`'0ê0¹0È[£Š0W0KN0H0j0Dÿ 0B0‹\^`'T 0k0ošØ0N0d0n\^`'[š©0W0KN0H0j0Dÿ SÊ0s0Y0y0f0n\^`'0ê0¹0È[£Š0k0o\0j0O0h0‚N0d0n\^`'[š©0’N0H0‹ÿ 0h0D0Fxbž0’0W0f0‚0ˆ0D0vøN’Ku(`'0n0_00kÿ XML&processor;0oÿ &at-user-option;ÿ 0B0‹‰} W‹0k‰ep0n\^`'0ê0¹0È[£Š0’N0H0_0Šÿ 0B0‹\^`'0k‰ep0n\^`'[š©0’N0H0_0Š0W0_0h0M0kÿ ‹fTJ0’Qú0W0f0‚0ˆ0D00W0K0Wÿ 0S0Œ0oÿ &error;0h0o0W0j0D0 </p> <div3 id='sec-attribute-types'> <head>\^`'0nW‹</head> <p> XML0n\^`'0nW‹0oÿ ÿz.˜^0h0Y0‹00S0Œ0‰0oÿ &string;W‹ÿ &token;SW‹SÊ0sRcW‹0h0Y0‹0&string;W‹0oÿ P$0h0W0fNûa0n&string;0’0h0‹0&token;SW‹0oÿ k!0ky:0Y[WSåSÊ0saTs0k•¢0Y0‹iØ00jR6}0’0‚0d0 <scrap lang='ebnf'> <head>Attribute Types</head> <prodgroup pcw4="14" pcw5="11.5"> <prod id='NT-AttType'><lhs>AttType</lhs> <rhs><nt def='NT-StringType'>StringType</nt> | <nt def='NT-TokenizedType'>TokenizedType</nt> | <nt def='NT-EnumeratedType'>EnumeratedType</nt> </rhs> </prod> <prod id='NT-StringType'><lhs>StringType</lhs> <rhs>'CDATA'</rhs> </prod> <prod id='NT-TokenizedType'><lhs>TokenizedType</lhs> <rhs>'ID'</rhs> <vc def='id'/> <vc def='one-id-per-el'/> <vc def='id-default'/> <rhs>| 'IDREF'</rhs> <vc def='idref'/> <rhs>| 'IDREFS'</rhs> <vc def='idref'/> <rhs>| 'ENTITY'</rhs> <vc def='entname'/> <rhs>| 'ENTITIES'</rhs> <vc def='entname'/> <rhs>| 'NMTOKEN'</rhs> <vc def='nmtok'/> <rhs>| 'NMTOKENS'</rhs> <vc def='nmtok'/></prod> </prodgroup> </scrap> </p> <vcnote id='id' > <head>ID</head> <p> 0S0nW‹0nP$0oÿ ub‰RG<code>Name</code>0k&match;0W0j0Q0Œ0p0j0‰0j0D0N0d0nXMLe‡føQ…0g0oÿ N0d0nT RM0Lÿ 0S0nW‹0nP$0h0W0f‰epVÞsþ0Œ0f0o0j0‰0j0D00d0~0Šÿ ID0nP$0oÿ ‰} 0’Na0k&identify;0W0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <vcnote id='one-id-per-el'> <head>1‰} 0T0h0k1ID</head> <p> ‰} W‹0oÿ ‰ep0nID\^`'P$0’0‚0c0f0o0j0‰0j0D0 </p> </vcnote> <vcnote id='id-default'> <head>ID\^`'0n&default;</head> <p> ID\^`'0oÿ &default;0h0W0fÿ <code>#IMPLIED</code>SÈ0o<code>#REQUIRED</code>0’[£Š0W0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <vcnote id='idref'> <head>IDREF</head> <p> <kw>IDREF</kw>W‹0nP$0oÿ ub‰RG<nt def="NT-Name">Name</nt>0k&match;0W0j0Q0Œ0p0j0‰0j0D0<kw>IDREFS</kw>W‹0nP$0oÿ ub‰RG<nt def="NT-Names">Names</nt>0k&match;0W0j0Q0Œ0p0j0‰0j0D0T00n<nt def='NT-Name'>Name</nt>0oÿ XMLe‡føQ…0k[XW(0Y0‹‰} 0nID\^`'0nP$0h&match;0W0j0Q0Œ0p0j0‰0j0D00d0~0Šÿ <kw>IDREF</kw>0nP$0oÿ 0B0‹ID\^`'0nP$0h&match;0W0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <vcnote id='entname'> <head>[ŸOST </head> <p> <kw>ENTITY</kw>W‹0nP$0oÿ ub‰RG<nt def="NT-Name">Name</nt>0k&match;0W0j0Q0Œ0p0j0‰0j0D0<kw>ENTITIES</kw>W‹0nP$0oÿ ub‰RG<nt def="NT-Names">Names</nt>0k&match;0W0j0Q0Œ0p0j0‰0j0D0T00n<nt def="NT-Name">Name</nt>0oÿ <termref def="dt-doctype">DTD</termref>0g[£Š0Y0‹<termref def="dt-unparsed">&unparsed-entity;</termref>0h&match;0W0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <vcnote id='nmtok'> <head>T RM&token;</head> <p> <kw>NMTOKEN</kw>W‹0nP$0oÿ —^}BzïŠS÷<termref def="NT-Nmtoken">Nmtoken</termref>0h&match;0Y0‹&string;0K0‰iËb0U0Œ0j0Q0Œ0p0j0‰0j0D0<kw>NMTOKENS</kw>W‹0nP$0oÿ —^}BzïŠS÷<termref def="NT-Nmtokens">Nmtokens</termref>0h&match;0Y0‹&string;0K0‰iËb0U0Œ0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <p> XML&processor;0oÿ &application;0k\^`'P$0’n!0YRM0kÿ <titleref href="AVNormalize">\^`'P$0nkc‰S</titleref>0g‰[š0Y0‹0h0J0Š0kÿ \^`'P$0’kc‰S0W0j0Q0Œ0p0j0‰0j0D0 </p> <p> <termdef id='dt-enumerated' term='Enumerated Attribute Values'><term>RcW‹0n\^`'</term>0oÿ [£Š0W0_P$0nN0d0’SÖ0‹0S0h0L0g0M0‹0</termdef>RcW‹0k0oÿ 2z.˜^0B0‹0 <scrap lang='ebnf'> <head>Rc\^`'0nW‹</head> <prod id='NT-EnumeratedType'><lhs>EnumeratedType</lhs> <rhs><nt def='NT-NotationType'>NotationType</nt> | <nt def='NT-Enumeration'>Enumeration</nt> </rhs></prod> <prod id='NT-NotationType'><lhs>NotationType</lhs> <rhs>'NOTATION' <nt def='NT-S'>S</nt> '(' <nt def='NT-S'>S</nt>? <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt>? '|' <nt def='NT-Name'>Name</nt>)* <nt def='NT-S'>S</nt>? ')' </rhs> <vc def='notatn' /></prod> <prod id='NT-Enumeration'><lhs>Enumeration</lhs> <rhs>'(' <nt def='NT-S'>S</nt>? <nt def='NT-Nmtoken'>Nmtoken</nt> (<nt def='NT-S'>S</nt>? '|' <nt def='NT-S'>S</nt>? <nt def='NT-Nmtoken'>Nmtoken</nt>)* <nt def='NT-S'>S</nt>? ')'</rhs> <vc def='enum'/></prod> </scrap> </p> <vcnote id='notatn'> <head>ŠlÕ\^`'</head> <p>0S0nW‹0nP$0oÿ [£Š0W0f0D0‹<titleref href='Notations'>ŠlÕ</titleref>0nT RM0nN0d0h&match;0W0j0Q0Œ0p0j0‰0j0D00d0~0Šÿ [£Š0k[XW(0Y0‹ŠlÕT 0oÿ 0Y0y0f[£Š0U0Œ0f0D0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <vcnote id='enum'> <head>Rc</head> <p> 0S0nW‹0nP$0oÿ [£Š0k[XW(0Y0‹<nt def='NT-Nmtoken'>Nmtoken</nt>&token;0nN0d0h&match;0W0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <p> <termref def='dt-interop'>vøN’Ku(`'0n0_0</termref>ÿ T 0X<nt def='NT-Nmtoken'>Nmtoken</nt>0oÿ SXN‰} W‹0nRcW‹0n\^`'0h0W0fÿ ‰epVÞsþ0Œ0j0De¹0L0ˆ0D0 </p> </div3> <div3 id='sec-attr-defaults'> <head>\^`'0n&default;</head> <p> <termref def="dt-attdecl">\^`'[£Š</termref>0oÿ \^`'0nc[š0L_Ř0K0i0F0K0k0d0D0f0n`ÅX10’N0H0‹0_Ř0g0j0DX4T0k0oÿ e‡føQ…0g\^`'0’c[š0W0j0D0h0Mÿ XML&processor;0nQæte¹lÕ0n`ÅX10‚N0H0‹0 <scrap lang='ebnf'> <head>\^`'0n&default;</head> <prodgroup pcw4="14" pcw5="11.5"> <prod id='NT-Default'><lhs>Default</lhs> <rhs>'#REQUIRED' |&nbsp;'#IMPLIED' </rhs> <rhs>| (('#FIXED' S)? <nt def='NT-AttValue'>AttValue</nt>)</rhs> <vc def='defattrvalid'/> <wfc def="CleanAttrVals"/> </prod> </prodgroup> </scrap> <!-- improved by bosak <scrap lang='ebnf'> <head>Attribute Defaults</head> <prod id='NT-Default'><lhs>Default</lhs> <rhs>'#REQUIRED' |&nbsp;'#IMPLIED' </rhs> <vc def='defattrvalid'/> <wfc def="CleanAttrVals"/> <rhs>| (('#FIXED' S)? <nt def='NT-AttValue'>AttValue</nt>)</rhs> </prod> </scrap>--> </p> <vcnote id='defattrvalid'> <head>\^`'&default;0nkc0W0U</head> <p> [£Š0W0_&default-value;0oÿ [£Š0W0_\^`'W‹0n[WSåR6}0’n€0_0U0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <p> <kw>#REQUIRED</kw>0’c[š0W0_0h0Mÿ 0S0n‰} W‹0n<termref def="dt-stag">•‹YË0¿0°</termref>0g0B0c0fÿ 0S0n\^`'0kP$0’N0H0j0D0‚0n0’XML&processor;0L‰‹0d0Q0_0j0‰0pÿ 0]0ne‡fø0o<termref def="dt-valid">&valid;</termref>0h0o0W0j0D0<kw>#IMPLIED</kw>0’c[š0W0_0h0Mÿ 0S0n\^`'0’wue0W0_0‰ÿ XML&processor;0oÿ \^`'P$0’c[š0W0j0D0S0h0’0¢0×0ê0±0ü0·0ç0ó0kO0H0j0Q0Œ0p0j0‰0j0D00S0n0h0Mÿ &application;0nc/‚0D0k0d0D0f0nR6}0o0j0D0 </p> <p> <termdef id="dt-default" term="Attribute Default"> \^`'0L<kw>#REQUIRED</kw>0g0‚<kw>#IMPLIED</kw>0g0‚0j0D0h0M0k0oÿ <nt def='NT-AttValue'>AttValue</nt>0nP$0Lÿ <term>&default-value;</term>0h0j0‹0<kw>#FIXED</kw>0nX4Tÿ &default-value;0hup0j0‹P$0Lc[š0U0Œ0Œ0pÿ 0]0ne‡fø0oÿ <termref def="dt-valid">&valid;</termref>0h0W0j0D0&default-value;0’[£Š0W0f0D0‹X4Tÿ 0S0n\^`'0nwue0’‰‹0d0Q0_0‰ÿ [£Š0W0_&default-value;0’\^`'P$0kc[š0W0f0D0‹0h0W0fÿ XML&processor;0oc/0‹‚0F0S0h0Lg0~0W0D0 </termdef></p> <p>\^`'0ê0¹0È[£Š0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;!ATTLIST termdef id ID #REQUIRED name CDATA #IMPLIED> &lt;!ATTLIST list type (bullets|ordered|glossary) "ordered"> &lt;!ATTLIST form method CDATA #FIXED "POST"></eg></p> </div3> <div3 id='AVNormalize'> <head>\^`'P$0nkc‰S</head> <p> XML&processor;0oÿ \^`'P$0’&application;0kn!0YRM0kÿ k!0n0h0J0Š0kkc‰S0W0j0Q0Œ0p0j0‰0j0D0 <ulist> <item> <p>a) 0~0Zÿ \^`'P$SÊ0s0]0nN-0n[ŸOSQ…0gÿ ˆLg+SÈ0oˆLXƒuL(SÈ0o0·0¹0Æ0à0k0ˆ0c0f0o0ì0³0ü0ÉXƒuL)0h0W0fO00Œ0‹&string;0’ÿ &space-character;(#x20)N0d0kn0McÛ0H0j0Q0Œ0p0j0‰0j0D(0 <titleref xml-link="simple" href="sec-line-ends">ˆLg+0nbq0D</titleref>0 0‚SÂqg0n0S0h0)0 </p></item> <item> <p>b) k!0kÿ e‡[WSÂqgSÊ0sQ…è&parsed-entity;0x0nSÂqg0oÿ \U•‹0W0j0Q0Œ0p0j0‰0j0D0Yè[ŸOS0x0nSÂqg0oÿ &error;0h0Y0‹0 </p></item> <item> <p>c) g_Œ0kÿ \^`'0nW‹0L<kw>CDATA</kw>0g0j0Q0Œ0pÿ zzv}&string;0oÿ 0Y0y0f&space-character;(#x20)N0d0kkc‰S0Wÿ k‹0Š0nzzv}e‡[W0oÿ RJ–d0W0j0Q0Œ0p0j0‰0j0D0 </p></item> </ulist> &non-validating;&parser;0oÿ [£Š0L‰‹0d0K0‰0j0D\^`'0oÿ 0Y0y0fÿ <kw>CDATA</kw>0’[£Š0W0f0D0‹0h0W0fbq0F0S0h0Lg0~0W0D0</p> </div3> </div2> <div2 id='sec-condition-sect'> <head>gaNöNØ0M0»0¯0·0ç0ó</head> <p> <termdef id='dt-cond-section' term='conditional section'> <term>gaNöNØ0M0»0¯0·0ç0ó</term>0h0oÿ <termref def='dt-doctype'>e‡føW‹[£Š0nYè&subset;</termref>0nNè0h0Wÿ R6_¡0­0ü0ï0ü0É0nc[š0k0ˆ0c0fÿ DTD0nŠÖtiË 0kT+00_0Šÿ –d0D0_0Š0Y0‹èR0h0Y0‹0 </termdef> <scrap lang='ebnf'> <head>gaNöNØ0M0»0¯0·0ç0ó</head> <prodgroup pcw2="9" pcw4="14.5"> <prod id='NT-conditionalSect'><lhs>conditionalSect</lhs> <rhs><nt def='NT-includeSect'>includeSect</nt> | <nt def='NT-ignoreSect'>ignoreSect</nt> </rhs> </prod> <prod id='NT-includeSect'><lhs>includeSect</lhs> <rhs>'&lt;![' S? 'INCLUDE' S? '[' <!-- (<nt def='NT-markupdecl'>markupdecl</nt> | <nt def="NT-conditionalSect">conditionalSect</nt> | <nt def="NT-S">S</nt>)* --> <nt def="NT-extSubset">extSubset</nt> ']]&gt;' </rhs> </prod> <prod id='NT-ignoreSect'><lhs>ignoreSect</lhs> <rhs>'&lt;![' S? 'IGNORE' S? '[' <nt def="NT-ignoreSectContents">ignoreSectContents</nt>* ']]&gt;'</rhs> </prod> <prod id='NT-ignoreSectContents'><lhs>ignoreSectContents</lhs> <rhs><nt def='NT-Ignore'>Ignore</nt> ('&lt;![' <nt def='NT-ignoreSectContents'>ignoreSectContents</nt> ']]&gt;' <nt def='NT-Ignore'>Ignore</nt>)*</rhs></prod> <prod id='NT-Ignore'><lhs>Ignore</lhs> <rhs><nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* ('&lt;![' | ']]&gt;') <nt def='NT-Char'>Char</nt>*) </rhs></prod> <!--<rhs> ((<nt def='NT-SkipLit'>SkipLit</nt> | <nt def='NT-Comment'>Comment</nt> | <nt def='NT-PI'>PI</nt>) - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-Char'>Char</nt>*)) | ('&lt;![' <nt def='NT-ignoreSectContents'>ignoreSectContents</nt>* ']]&gt;') </rhs> <rhs> | (<nt def='NT-Char'>Char</nt> - (']' | [&lt;'"])) </rhs> <rhs> | ('&lt;!' (<nt def='NT-Char'>Char</nt> - ('-' | '['))) </rhs>--> </prodgroup> </scrap> </p> <p>gaNöNØ0M0»0¯0·0ç0ó0oÿ DTD0nQ…è&subset;SÊ0sYè&subset;0hT iØ0kÿ [ŒQh0j[£Šÿ 0³0á0ó0ÈSÈ0oQe0Œ[P0k0j0c0_gaNöNØ0M0»0¯0·0ç0ó0’ÿ 0D0O0d0KT+0“0g0ˆ0D00S0Œ0‰0n•“0kÿ zzv}0Lsþ0Œ0f0‚0ˆ0D0 </p> <p> gaNöNØ0M0»0¯0·0ç0ó0n0­0ü0ï0ü0É0L<code>INCLUDE</code>0j0‰0pÿ XML&processor;0oÿ 0S0ngaNöNØ0M0»0¯0·0ç0ó0nQ…[¹0’ÿ e‡fø0nNè0h0W0fbq00j0Q0Œ0p0j0‰0j0D0gaNöNØ0M0»0¯0·0ç0ó0n0­0ü0ï0ü0É0L<code>IGNORE</code>0j0‰0pÿ 0]0ngaNöNØ0M0»0¯0·0ç0ó0nQ…[¹0oÿ e‡fø0nNè0h0W0fbq00j0D0iËe‡‰ãg0’kc0W0OˆL0F0_00k0oÿ q!‰–0Y0‹gaNöNØ0M0»0¯0·0ç0ó(IGNORE)0k•¢0W0f0‚ÿ Q…[¹0’Š­0~0j0Q0Œ0p0j0‰0j0D0S0h0klèa0Y0‹0S0h00S0Œ0oÿ Qe0Œ[P0k0j0c0_gaNöNØ0M0»0¯0·0ç0ó0’‰‹0d0Qÿ (q!‰–0Y0‹)g0‚YPt0ngaNöNØ0M0»0¯0·0ç0ó0’kc0W0OiQú0Y0‹0_00h0Y0‹00­0ü0ï0ü0É0’<code>INCLUDE</code>0h0Y0‹\0U0jgaNöNØ0M0»0¯0·0ç0ó0Lÿ 0­0ü0ï0ü0É0’<code>IGNORE</code>0h0Y0‹0ˆ0ŠY'0M0jgaNöNØ0M0»0¯0·0ç0ó0kT+0~0Œ0‹0j0‰0pÿ YPtSÊ0sQ…Pt0ngaNöNØ0M0»0¯0·0ç0ó0nN!e¹0h0‚q!‰–0Y0‹0 </p> <p> gaNöNØ0M0»0¯0·0ç0ó0n0­0ü0ï0ü0É0L0Ñ0é0á0¿[ŸOSSÂqg0j0‰0pÿ XML&processor;0ogaNöNØ0M0»0¯0·0ç0ó0nbq0D0’R$e­0Y0‹RM0kÿ 0S0n0Ñ0é0á0¿[ŸOS0’\U•‹0W0j0Q0Œ0p0j0‰0j0D0 </p> <p>O‹0’k!0ky:0Y0 <eg>&lt;!ENTITY % draft 'INCLUDE' > &lt;!ENTITY % final 'IGNORE' > &lt;![%draft;[ &lt;!ELEMENT book (comments*, title, body, supplements?)> ]]&gt; &lt;![%final;[ &lt;!ELEMENT book (title, body, supplements?)> ]]&gt; </eg> </p> </div2> <!-- <div2 id='sec-pass-to-app'> <head>XML Processor Treatment of Logical Structure</head> <p>When an XML processor encounters a start-tag, it must make at least the following information available to the application: <ulist> <item> <p>the element type's generic identifier</p> </item> <item> <p>the names of attributes known to apply to this element type (validating processors must make available names of all attributes declared for the element type; non-validating processors must make available at least the names of the attributes for which values are specified. </p> </item> </ulist> </p> </div2> --> </div1> <!-- &Entities; --> <div1 id='sec-physical-struct'> <head>ritiË </head> <p> <termdef id="dt-entity" term="Entity"> XMLe‡fø0oÿ N0dNåN 0nŠa¶SXOM0K0‰iËb0Y0‹00S0nŠa¶SXOM0’ÿ <term>[ŸOS</term>0h0D0F0[ŸOS0oÿ <term>Q…[¹</term>0’0‚0aÿ e‡fø[ŸOS(Nå–MSÂqg)SÊ0s<termref def='dt-doctype'>YèDTD&subset;</termref>0’–d0D0fÿ <term>T RM</term>0g&identified;0 </termdef> <!-- Added for CFG --> <!-- obscurity amputated by TWB --> <!-- entire sentence amputated by CMSMcQ: no one but NO ONE is ready for entities declared as <!ENTITY foo "http://www.foo.com/bar.xml#id"> and it's pointless to suggest that it's possible under current circumstances. --> <!-- An entity may be stored in, --> <!--but need not be coterminous with, --> <!-- but need not comprise the whole of, --> <!-- a single physical storage object such as a file or --> <!-- database field. --> <!-- End sentence added for CFG -->TXMLe‡fø0oÿ <termref def="dt-docent">e‡fø[ŸOS</termref>0hT|0v[ŸOS0’N0d0‚0d0<termref def="dt-xml-proc">XML&processor;</termref>0oÿ 0S0ne‡fø[ŸOS0K0‰Qæt0’•‹YË0Y0‹0e‡fø[ŸOS0Lÿ e‡fø0n0Y0y0f0’T+0“0g0‚0ˆ0D0</p> <p>[ŸOS0oÿ &parsed-entity;SÈ0o&unparsed-entity;0h0Y0‹0<termdef id="dt-parsedent" term="Text Entity"><term>&parsed-entity;</term>0nQ…[¹0oÿ &parsed-entity;0n<termref def='dt-repltext'>&replacement-text;</termref>0hT|0v00S0n<termref def="dt-text">0Æ0­0¹0È</termref>0oÿ e‡fø0ng,OS0nNè0h0W0f‰ã‘È0Y0‹0 </termdef> </p> <p> <termdef id="dt-unparsed" term="Unparsed Entity"> <term>&unparsed-entity;</term>0oÿ Q…[¹0L<termref def='dt-text'>0Æ0­0¹0È</termref>0g0‚0]0F0g0j0O0h0‚0ˆ0D0ê0½0ü0¹0h0Y0‹00Æ0­0¹0È0nX4Tÿ XML0g0j0O0h0‚0ˆ0D0T&unparsed-entity;0k0oÿ <termref def="dt-notation">ŠlÕ</termref>0L•¢#NØ0Q0‰0Œÿ 0S0nŠlÕ0oÿ T RM0g&identified;0ŠlÕ0nT RMSÊ0s•¢#NØ0Q0‰0Œ0_&identifier;0’ÿ XML&processor;0L&application;0kn!0Y0h0D0F‰NöNåY0oÿ XML0oÿ &unparsed-entity;0nQ…[¹0’R6–P0W0j0D0 </termdef> </p> <p>&parsed-entity;0oÿ [ŸOSSÂqg0k0ˆ0c0fT RM0gT|0sQú0Y0&unparsed-entity;0oÿ <kw>ENTITY</kw>W‹SÈ0o<kw>ENTITIES</kw>W‹0n\^`'0nP$0h0W0fÿ T RM0gSÂqg0Y0‹0</p> <p> <termdef id='gen-entity' term='general entity'><term>N‚,[ŸOS</term>0oÿ e‡føQ…[¹0nN-0gOu(0Y0‹&parsed-entity;0h0Y0‹00B0D0~0D0k0j0‰0j0D–P0Šÿ 0S0n&TR-or-Rec;0g0oÿ N‚,[ŸOS0’SX0k<emph>[ŸOS</emph>0hT|0v0</termdef><termdef id='dt-PE' term='Parameter entity'>0Ñ0é0á0¿[ŸOS0oÿ DTDQ…0gOu(0Y0‹&parsed-entity;0h0Y0‹0</termdef>0S0Œ0‰0nÿz.˜^0n[ŸOS0oÿ up0j0‹fø_0gSÂqg0Wÿ up0j0‹e‡0gŠ‹X0Y0‹0</p> <!-- <div2 id='sec-synchro'> <head>Logical and Physical Structures</head> <p>The logical and physical structures (elements and entities) in an XML document must be properly nested. <termref def='dt-stag'>Tags</termref> and <termref def='dt-element'>elements</termref> must each begin and end in the same <termref def='dt-entity'>entity</termref>, but may refer to other entities internally; <termref def='dt-comment'>comments</termref>, <termref def='dt-pi'>processing instructions</termref>, <termref def='dt-charref'>character references</termref>, and <termref def='dt-entref'>entity references</termref> must each be contained entirely within a single entity. Entities must each contain an integral number of elements, comments, processing instructions, and references, possibly together with character data not contained within any element in the entity, or else they must contain non-textual data, which by definition contains no elements.</p></div2> --> <div2 id='sec-references'> <head>e‡[WSÂqgSÊ0s[ŸOSSÂqg</head> <p> <termdef id="dt-charref" term="Character Reference"> <term>e‡[WSÂqg</term>0oÿ ISO/IEC 10646e‡[W–ÆT0nry[š0ne‡[Wÿ O‹0H0pÿ QeR›j_Vh0K0‰vôc¥QeR›N Sï€ý0je‡[W0’SÂqg0Y0‹0 <scrap lang='ebnf'> <head>e‡[WSÂqg</head> <prod id='NT-CharRef'><lhs>CharRef</lhs> <rhs>'&amp;#' [0-9]+ ';' </rhs> <rhs>| '&hcro;' [0-9a-fA-F]+ ';'</rhs> <wfc def="wf-Legalchar"/> </prod> </scrap> <wfcnote id="wf-Legalchar"> <head>kc_S0je‡[W</head> <p>e‡[WSÂqg0gSÂqg0Y0‹e‡[W0oÿ —^}BzïŠS÷<termref def="NT-Char">Char</termref>0k_“00j0Q0Œ0p0j0‰0j0D0</p> </wfcnote> e‡[W0L "<code>&amp;#x</code>" 0gYË0~0Œ0pÿ }Bzï0n "<code>;</code>" 0~0g0nep[WSÊ0s0¢0ë0Õ0¡0Ù0Ã0È0oÿ ISO/IEC 10646 0ne‡[W0³0ü0É0n162epˆhsþ0h0Y0‹0 <!--eåg,ŠžŠ30k0d0D0f: letter0o0¢0ë0Õ0¡0Ù0Ã0È0hŠ30W0_0 N Y} --> e‡[W0L "<code>&amp;#</code>" 0gYË0~0Œ0pÿ }Bzï0n "<code>;</code>" 0~0g0nep[W0oÿ e‡[W0³0ü0É0n102epˆhsþ0h0Y0‹0 </termdef> </p> <p> <termdef id="dt-entref" term="Entity Reference"> <term>[ŸOSSÂqg</term>0oÿ T RM0nNØ0D0_[ŸOS0nQ…[¹0’SÂqg0Y0‹0</termdef><termdef id='dt-GERef' term='General Entity Reference'>N‚,[ŸOS0x0nSÂqg0oÿ 0¢0ó0Ñ0µ0ó0É(<code>&amp;</code>)SÊ0s0»0ß0³0í0ó(<code>;</code>)0’S:R0Š[P0h0W0fu(0D0‹0</termdef><termdef id='dt-PERef' term='Parameter-entity reference'><term>0Ñ0é0á0¿[ŸOS</term>0x0nSÂqg0oÿ 0Ñ0ü0»0ó0ÈŠS÷(<code>%</code>)SÊ0s0»0ß0³0í0ó(<code>;</code>)0’S:R0Š[P0h0W0fu(0D0‹0 </termdef> </p> <scrap lang="ebnf"> <head>[ŸOSSÂqg</head> <prod id='NT-Reference'><lhs>Reference</lhs> <rhs><nt def='NT-EntityRef'>EntityRef</nt> | <nt def='NT-CharRef'>CharRef</nt></rhs></prod> <prod id='NT-EntityRef'><lhs>EntityRef</lhs> <rhs>'&amp;' <nt def='NT-Name'>Name</nt> ';'</rhs> <wfc def='wf-entdeclared'/> <vc def='vc-entdeclared'/> <wfc def='textent'/> <wfc def='norecursion'/> </prod> <prod id='NT-PEReference'><lhs>PEReference</lhs> <rhs>'%' <nt def='NT-Name'>Name</nt> ';'</rhs> <wfc def='wf-entdeclared'/> <vc def='vc-entdeclared'/> <wfc def='textent'/> <wfc def='norecursion'/> <wfc def='indtd'/> </prod> </scrap> <wfcnote id='wf-entdeclared'> <head>[ŸOS0L[£Š0U0Œ0f0D0‹0S0h</head> <p>DTD0’0‚0_0j0De‡føÿ 0Ñ0é0á0¿[ŸOSSÂqg0’T+0~0j0DQ…èDTD&subset;0`0Q0’0‚0de‡føÿ SÈ0o "<code>standalone='yes'</code>" 0’0‚0de‡fø0k0J0D0fÿ [ŸOSSÂqg0gu(0D0‹ <nt def='NT-Name'>Name</nt> 0oÿ 0]0n[ŸOS0n[£Š0gN0H0‹T RM0hÿ <termref def="dt-match">&match;</termref>0W0j0Q0Œ0p0j0‰0j0D00_0`0Wÿ &well-formed;0ne‡fø0oÿ [ŸOS&magicents; 0’[£Š0Y0‹_ʼn0o0j0D00Ñ0é0á0¿[ŸOS0nX4T0oÿ [£Š0oÿ SÂqg0kQHˆL0W0j0Q0Œ0p0j0‰0j0D0T iØ0kÿ N‚,[ŸOS0nX4T0oÿ \^`'0ê0¹0È[£Š0n&default-value;Q…0g0nSÂqg0ˆ0ŠQH0kÿ [£Š0Lsþ0Œ0j0Q0Œ0p0j0‰0j0D0</p> <p>Yè&subset;SÈ0oYè0Ñ0é0á0¿[ŸOS0g[ŸOS0’[£Š0Y0‹0h0Mÿ &non-validating;&processor;0Lÿ [£Š0’Š­0ÿ Qæt0Y0‹0S0h0’<titleref href='include-if-valid'>©RÙ0e0Q0j0D</titleref>00]0Œ0‰0ne‡fø0g0oÿ [ŸOS0o[£Š0U0Œ0j0Q0Œ0p0j0‰0j0D0h0D0F‰RG0oÿ &well-formed;R6}0g0o0j0D0 </p> </wfcnote> <vcnote id="vc-entdeclared"> <head>[ŸOS0L[£Š0U0Œ0f0D0‹0S0h</head> <p> Yè&subset;SÈ0oYè0Ñ0é0á0¿[ŸOS0’0‚0c0f0D0fÿ "<code>standalone='no'</code>"0’0‚0de‡fø0k0J0D0fÿ [ŸOSSÂqg0gu(0D0‹ <nt def='NT-Name'>Name</nt> 0oÿ 0]0n[ŸOS0n[£Š0gN0H0‹T RM0h<termref def="dt-match">&match;</termref>0W0j0Q0Œ0p0j0‰0j0D0vøN’Ku(`'0n0_0ÿ &valid;0je‡fø0o<titleref href="sec-escapes">0B0‰0K0X0[š©0W0_[ŸOS0n‰[š</titleref>0gc[š0W0_fø_0k0ˆ0c0fÿ [ŸOS &magicents;0’[£Š0Y0‹0S0h0Lg0~0W0D00Ñ0é0á0¿[ŸOS0nX4T0oÿ [£Š0oÿ SÂqg0kQHˆL0W0j0Q0Œ0p0j0‰0j0D0T iØ0kÿ N‚,[ŸOS0nX4T0oÿ \^`'0ê0¹0È[£Š0n&default-value;Q…0g0nSÂqg0ˆ0Š0‚QH0kÿ [£Š0Lsþ0Œ0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <!-- FINAL EDIT: is this duplication too clumsy? --> <wfcnote id='textent'> <head>&parsed-entity;</head> <p> [ŸOSSÂqg0oÿ <termref def="dt-unparsed">&unparsed-entity;</termref>0nT RM0’T+0“0g0D0f0o0j0‰0j0D0&unparsed-entity;0oÿ <kw>ENTITY</kw>W‹SÈ0o<kw>ENTITIES</kw> W‹0h0W0f[£Š0W0_<termref def="dt-attrval">\^`'P$</termref>0h0W0f0`0QSÂqg0g0M0‹0 </p> </wfcnote> <wfcnote id='norecursion'> <head>Q^00j0W</head> <p>&parsed-entity;0oÿ 0]0ŒêOS0x0nSÂqg0’ÿ vôc¥0k0‚•“c¥0k0‚T+0“0g0o0j0‰0j0D0</p> </wfcnote> <wfcnote id='indtd'> <head>DTD0nN-</head> <p> 0Ñ0é0á0¿[ŸOSSÂqg0oÿ <termref def='dt-doctype'>DTD</termref>Q…0k0`0Qÿ Qúsþ0W0f0ˆ0D0 <!-- In the external DTD subset, a parameter-entity reference is recognized only at the locations where the nonterminal <nt def="NT-PEReference">PEReference</nt> or the special operator <code>%</code> appears in a production of the grammar. In the internal subset, parameter-entity references are recognized only when they match the <nt def="NT-InternalPERef">InternalPERef</nt> non-terminal in the production for <nt def="NT-markupdecl">markupdecl</nt>. --> </p> </wfcnote> <p> e‡[WSÂqgSÊ0s[ŸOSSÂqg0nO‹0’ÿ k!0ky:0Y0 <eg>Type &lt;key>less-than&lt;/key> (&hcro;3C;) to save options. This document was prepared on &amp;docdate; and is classified &amp;security-level;.</eg> </p> <p> 0Ñ0é0á0¿[ŸOSSÂqg0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;!ENTITY % ISOLat2 SYSTEM "http://www.xml.com/iso/isolat2-xml.entities" > %ISOLat2; </eg> </p> </div2> <div2 id='sec-entity-decl'> <head>[ŸOS[£Š</head> <p> <termdef id="dt-entdecl" term="entity declaration"> [ŸOS0oÿ k!0n0h0J0Š0k[£Š0Y0‹0 <scrap lang='ebnf'> <head>[ŸOS[£Š</head> <prodgroup pcw2="5" pcw4="18.5"> <prod id='NT-EntityDecl'><lhs>EntityDecl</lhs> <rhs><nt def="NT-GEDecl">GEDecl</nt></rhs><com>N‚,[ŸOS</com> <rhs>| <nt def="NT-PEDecl">PEDecl</nt></rhs><com>0Ñ0é0á0¿[ŸOS</com> </prod> <prod id='NT-GEDecl'><lhs>GEDecl</lhs> <rhs>'&lt;!ENTITY' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> <nt def='NT-EntityDef'>EntityDef</nt> <nt def='NT-S'>S</nt>? '&gt;'</rhs> </prod> <prod id='NT-PEDecl'><lhs>PEDecl</lhs> <rhs>| '&lt;!ENTITY' <nt def='NT-S'>S</nt> '%' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> <nt def='NT-PEDef'>PEDef</nt> <nt def='NT-S'>S</nt>? '&gt;'</rhs> <com>0Ñ0é0á0¿[ŸOS</com> </prod> <prod id='NT-EntityDef'><lhs>EntityDef</lhs> <rhs><nt def='NT-EntityValue'>EntityValue</nt> </rhs> <!--<wfc def="WF-EntityValue"/>--> <rhs>| <nt def='NT-ExternalDef'>ExternalDef</nt></rhs> <!--<wfc def="WF-External"/>--> </prod> <!-- FINAL EDIT: what happened to WFs here? --> <prod id='NT-PEDef'><lhs>PEDef</lhs> <rhs><nt def='NT-EntityValue'>EntityValue</nt> | <nt def='NT-ExternalID'>ExternalID</nt></rhs></prod> </prodgroup> </scrap> <nt def='NT-Name'>Name</nt> 0oÿ <termref def="dt-entref">[ŸOSSÂqg</termref>0k0J0D0f[ŸOS0’&identify;0&unparsed-entity;0j0‰0pÿ <kw>ENTITY</kw> W‹SÈ0o<kw>ENTITIES</kw>W‹0n\^`'P$Q…0gÿ [ŸOS0’&identify;0T N0n[ŸOS0LNVÞNåN [£Š0U0Œ0Œ0pÿ gR0n[£Š0’u(0D0‹0&at-user-option;ÿ ‰epVÞ[£Š0U0Œ0‹[ŸOS0k•¢0Wÿ XML&processor;0oÿ ‹fTJ0’Qú0W0f0‚0ˆ0D0 </termdef> </p> <!-- <wfcnote id="WF-Entityvalue"> <head>Well-Formed Internal Entity</head> <p>General entities defined by an <nt def="NT-EntityValue">EntityValue</nt> must be well-formed, as defined in section <specref ref="wf-entities"/>. </p> </wfcnote> <wfcnote id="WF-External"> <head>Well-Formed External Entity</head> <p>General text entities defined by an <nt def="NT-ExternalDef">ExternalDef</nt>, must be well-formed, as defined in the section on <titleref xml-link="simple" href="wf-entities">well-formed entities.</titleref>.</p> </wfcnote> --> <div3 id='sec-internal-ent'> <head>Q…è[ŸOS</head> <p> <termdef id='dt-internent' term="Internal Entity Replacement Text"> [ŸOS0n[š©0L <nt def='NT-EntityValue'>EntityValue</nt>0n0h0Mÿ 0S0Œ0’<term>Q…è[ŸOS</term>0h0D0F00S0Œ0oÿ R%P 0nritv„Ša¶SXOM0’0‚0_0Zÿ [ŸOS0nQ…[¹0oÿ [£ŠQ…0gN0H0‹0</termdef>kc0W0O<termref def='dt-repltext'>&replacement-text;</termref>0’ub0Y0‹0k0oÿ <termref def='dt-litentval'>&literal;[ŸOSP$</termref>Q…0g0n[ŸOSSÂqgSÊ0se‡[WSÂqg0nQæt0Lÿ _ʼn0h0j0‹0K0‚0W0Œ0j0D0S0h0klèa0Y0‹0Šs}00oÿ <titleref href='intern-replacement'>Q…è[ŸOS0n&replacement-text;0niË{É</titleref>0’SÂqg0 <!-- redundant -TWB Within the <nt def="NT-EntityValue">EntityValue</nt>, parameter-entity references and character references are recognized and expanded immediately. General-entity references within the replacement text are not recognized at the time the entity declaration is parsed, though they may be recognized when the entity itself is referred to. --> </p> <p> Q…è[ŸOS0oÿ <termref def="dt-parsedent">&parsed-entity;</termref>0h0Y0‹0 </p> <p>Q…è[ŸOS[£Š0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;!ENTITY Pub-Status "This is a pre-release of the specification."></eg></p> </div3> <div3 id='sec-external-ent'> <head>Yè[ŸOS</head> <p> <termdef id="dt-extent" term="External Entity"> [ŸOS0LQ…è[ŸOS0g0j0Q0Œ0pÿ <term>Yè[ŸOS</term>0h0Wÿ k!0n0h0J0Š0k[£Š0Y0‹0 <scrap lang='ebnf'> <head>Yè[ŸOS[£Š</head> <prod id='NT-ExternalDef'><lhs>ExternalDef</lhs> <rhs><nt def='NT-ExternalID'>ExternalID</nt> <nt def='NT-NDataDecl'>NDataDecl</nt>?</rhs></prod> <prod id='NT-ExternalID'><lhs>ExternalID</lhs> <rhs>'SYSTEM' <nt def='NT-S'>S</nt> <nt def='NT-SystemLiteral'>SystemLiteral</nt></rhs> <rhs>| 'PUBLIC' <nt def='NT-S'>S</nt> <nt def='NT-PubidLiteral'>PubidLiteral</nt> <nt def='NT-S'>S</nt> <nt def='NT-SystemLiteral'>SystemLiteral</nt> </rhs> </prod> <prod id='NT-NDataDecl'><lhs>NDataDecl</lhs> <rhs><nt def='NT-S'>S</nt> 'NDATA' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt></rhs> <vc def='not-declared'/></prod> </scrap> <nt def='NT-NDataDecl'>NDataDecl</nt> 0L[XW(0Y0Œ0pÿ 0S0n[ŸOS0oÿ <termref def="dt-unparsed">&unparsed-entity;</termref>0h0Wÿ 0]0F0g0j0Q0Œ0pÿ &parsed-entity;0h0Y0‹0</termdef> </p> <vcnote id='not-declared'> <head>ŠlÕ0L[£Š0U0Œ0f0D0‹0S0h</head> <p> <nt def='NT-Name'>Name</nt> 0oÿ [£Š0W0_<termref def="dt-notation">ŠlÕ</termref>0nT RM0h&match;0W0j0Q0Œ0p0j0‰0j0D0 </p> </vcnote> <p> <termdef id="dt-sysid" term="System Identifier"> 0­0ü0ï0ü0É <kw>SYSTEM</kw> 0n_Œ0n <nt def='NT-SystemLiteral'>SystemLiteral</nt> 0’ÿ [ŸOS0n<term>0·0¹0Æ0à&identifier;</term>0hT|0v00S0Œ0oURI0h0Wÿ 0]0n[ŸOS0nQ…[¹0’SÖ0ŠQú0Y0n0ku(0D0f0‚0ˆ0D0</termdef>URI0hQq0kO0F0S0h0nY0D0Ï0Ã0·0å("<code>#</code>")SÊ0s0Õ0é0°0á0ó0È&identifier;0oÿ kc_0k0oÿ URIêOS0nNè0h0o0W0j0D00Õ0é0°0á0ó0È&identifier;0Lÿ 0·0¹0Æ0à&identifier;0nèR0h0W0fN0H0‰0Œ0f0D0‹X4Tÿ XML&processor;0oÿ &error;0’Qú0W0f0‚0ˆ0D00S0n&TR-or-Rec;0n{ÄVòY0n`ÅX1(O‹0H0pÿ 0B0‹ry[š0nDTD0nryR%0jXML‰} SÈ0ory[š0n&application;0nNÕiØ0k0ˆ0c0f[š©0U0Œ0_QætT}Nä)0k0ˆ0c0fN fø0M0U0Œ0j0D–P0Šÿ vø[þv„0jURI0oÿ 0]0n[ŸOS0nOMnÿ 0Y0j00aÿ 0]0n[ŸOS0n[£Š0L0B0‹0Õ0¡0¤0ë0kvø[þv„0h0Y0‹00W0_0L0c0fÿ DTD0nQ…è&subset;0k0B0‹[ŸOS[£Š0g0nvø[þv„0jURI0oÿ e‡fø0nOMn0k0d0D0fvø[þv„0h0Y0‹0Yè&subset;0k0B0‹[ŸOS[£Š0g0nvø[þv„0jURI0oÿ 0]0nYè&subset;0’T+0€0Õ0¡0¤0ë0nOMn0kvø[þv„0h0Y0‹0 </p> <p> <termdef id="dt-pubid" term="Public identifier"> 0·0¹0Æ0à&identifier;NåY0kÿ Yè[ŸOS0oÿ <term>Ql•‹&identifier;</term>0’T+0“0g0‚0ˆ0D0 </termdef> [ŸOS0nQ…[¹0’SÖ0ŠQú0YXML&processor;0oÿ 0S0nQl•‹&identifier;0’u(0D0fÿ Nã00Š0nURI0nub0’Šf00f0‚0ˆ0D0XML&processor;0L0S0Œ0kY1eW0W0_X4T0oÿ 0·0¹0Æ0à&literal;0h0W0fc[š0W0_URI0’u(0D0j0Q0Œ0p0j0‰0j0D0&match;0Y0‹RM0kÿ Ql•‹&identifier;Q…0k0B0‹zzv}e‡[W0K0‰0j0‹&string;0oÿ 0Y0y0fSXN0n&space-character;(#x20)0kkc‰S0W0j0Q0Œ0p0j0‰0Zÿ RM_Œ0nzzv}e‡[W0oRJ–d0W0j0Q0Œ0p0j0‰0j0D0 </p> <p>Yè[ŸOS[£Š0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;!ENTITY open-hatch SYSTEM "http://www.textuality.com/boilerplate/OpenHatch.xml"> &lt;!ENTITY open-hatch PUBLIC "-//Textuality//TEXT Standard open-hatch boilerplate//EN" "http://www.textuality.com/boilerplate/OpenHatch.xml"> &lt;!ENTITY hatch-pic SYSTEM "../grafix/OpenHatch.gif" NDATA gif ></eg></p> </div3> </div2> <div2 id='TextEntities'> <head>&parsed-entity;</head> <div3 id='sec-TextDecl'> <head>0Æ0­0¹0È[£Š</head> <p>Yè&parsed-entity;0oÿ <term>0Æ0­0¹0È[£Š</term>0gYË0~0c0f0‚0ˆ0D0 <scrap lang='ebnf'> <head>0Æ0­0¹0È[£Š</head> <prodgroup pcw4="12.5" pcw5="13"> <prod id='NT-TextDecl'><lhs>TextDecl</lhs> <rhs>&xmlpio; <nt def='NT-VersionInfo'>VersionInfo</nt>? <nt def='NT-EncodingDecl'>EncodingDecl</nt> <nt def='NT-S'>S</nt>? &pic;</rhs> <!-- <wfc def='wfc-xmldecliteral'/> --> <!-- <wfc def='wfc-no-nonleading-encdec'/> --> </prod> </prodgroup> </scrap> </p> <p>0Æ0­0¹0È[£Š0oÿ 0]0n0~0~0n_b0gsþ0Œ0j0Q0Œ0p0j0‰0Zÿ &parsed-entity;0x0nSÂqg0’}Lu10W0f0o0j0‰0j0D0S0h0klèa0Y0‹0</p> <p>Yè&parsed-entity;0k0J0D0fÿ 0Æ0­0¹0È[£Š0oÿ QH˜-NåY0n0D0K0j0‹OMn0k0‚Qúsþ0W0j0D0</p> </div3> <div3 id='wf-entities'> <head>&well-formed;0n&parsed-entity;</head> <p>0é0Ù0ë<nt def='NT-document'>document</nt>0’0‚0dub‰RG0k&match;0Y0Œ0pÿ e‡fø[ŸOS0oÿ &well-formed;0h0Y0‹00é0Ù0ë<nt def='NT-ExtParsedEnt'>ExtParsedEnt</nt>0’0‚0dub‰RG0k&match;0Y0Œ0pÿ Yè0nN‚,&parsed-entity;0oÿ &well-formed;0h0Y0‹00é0Ù0ë<nt def='NT-ExtPE'>ExtPE</nt>0’0‚0dub‰RG0k&match;0Y0Œ0pÿ Yè0Ñ0é0á0¿[ŸOS0oÿ &well-formed;0h0Y0‹0 <scrap lang='ebnf'> <head>&well-formed;0n&parsed-entity;</head> <prod id='NT-ExtParsedEnt'><lhs>ExtParsedEnt</lhs> <rhs><nt def='NT-TextDecl'>TextDecl</nt>? <nt def='NT-content'>content</nt></rhs> </prod> <prod id='NT-ExtPE'><lhs>ExtPE</lhs> <rhs><nt def='NT-TextDecl'>TextDecl</nt>? <nt def='NT-extSubset'>extSubset</nt></rhs> </prod> </scrap> &replacement-text;0Lÿ 0é0Ù0ë<nt def='NT-content'>content</nt>0’0‚0dub‰RG0k&match;0Y0Œ0pÿ Q…è0nN‚,&parsed-entity;0oÿ &well-formed;0h0Y0‹0DTD0’g_Œ0~0gŠ­0¼0~0j0D0hÿ xº[Ÿ0k0S0Œ0’R$[š0g0M0j0D0S0h0klèa00Y0y0f0nQ…è0n0Ñ0é0á0¿[ŸOS0oÿ [š©0k0ˆ0c0f&well-formed;0h0Y0‹0 </p> <p>[ŸOS0L&well-formed;0j}Pgœ0h0W0fÿ XMLe‡fø0nŠÖtv„SÊ0sritv„iË 0oÿ kc0W0OQe0Œ[P0h0j0‹0<termref def='dt-stag'>•‹YË0¿0°</termref>ÿ <termref def='dt-etag'>}BN†0¿0°</termref>ÿ <termref def="dt-empty">zz‰} 0¿0°</termref>ÿ <termref def='dt-element'>‰} </termref>ÿ <termref def='dt-comment'>0³0á0ó0È</termref>ÿ <termref def='dt-pi'>QætT}Nä</termref>ÿ <termref def='dt-charref'>e‡[WSÂqg</termref>SÊ0s<termref def='dt-entref'>[ŸOSSÂqg</termref>0Lÿ N0d0n[ŸOS0g•‹YË0Wÿ R%0n[ŸOS0g}BN†0Y0‹0S0h0o0j0D0</p> </div3> <div3 id='charencoding'> <head>[ŸOS0k0J0Q0‹e‡[W{&S÷S</head> <p>XMLe‡føQ…0nYè&parsed-entity;0oÿ T0ÿ R%0ne‡[W{&S÷Se¹_0’u(0D0f0‚0ˆ0D00Y0y0f0nXML&processor;0oÿ UTF-80g{&S÷S0W0_[ŸOSÿ UTF-160g{&S÷S0W0_[ŸOS0’Qæt0g0M0j0Q0Œ0p0j0‰0j0D0 <!-- It is recognized that for some purposes, the use of additional ISO/IEC 10646 planes other than the Basic Multilingual Plane may be required. A facility for handling characters in these planes is therefore a desirable characteristic in XML processors and applications. --> </p> <p>UTF-160g{&S÷S0W0_[ŸOS0oÿ ISO/IEC 106460nNØ“2ESÊ0sUnicode0nNØ“2B0g‰[š0Y0‹&byte-order-mark;(ZERO WIDTH NO-BREAK SPACEe‡[Wÿ #xFEFF)0gYË0~0‰0j0Q0Œ0p0j0‰0j0D00S0Œ0oÿ {&S÷S0nj‹X0g0B0c0fÿ XMLe‡fø0n&markup;0nNè0g0‚ÿ e‡[W0Ç0ü0¿0nNè0g0‚0j0D0XML&processor;0oÿ UTF-80g{&S÷S0W0_e‡fø0hUTF-160g{&S÷S0W0_e‡fø0h0nS:R%0’ˆL0F0_00kÿ 0S0ne‡[W0’Ou(Sï€ý0g0j0Q0Œ0p0j0‰0j0D0</p> <p>XML&processor;0oÿ UTF-8SÊ0sUTF-160g{&S÷S0W0_[ŸOS0`0Q0’Š­0€0S0h0’_Ř0h0Y0‹0Lÿ NÖ0n{&S÷S0’NuL0g0ou(0D0f0J0Šÿ 0]0Œ0‰0n{&S÷S0’u(0D0‹[ŸOS0’XML&processor;0LQæt0g0M0‹0S0h0Lg0~0W0D0UTF-8SÈ0oUTF-16NåY0n{&S÷Se¹_0’u(0D0fh<} 0Y0‹&parsed-entity;0oÿ {&S÷S[£Š0’T+0€<titleref href='TextDecl'>0Æ0­0¹0È[£Š</titleref>0gYË00j0Q0Œ0p0j0‰0j0D0 <scrap lang='ebnf'> <head>{&S÷S[£Š</head> <prod id='NT-EncodingDecl'><lhs>EncodingDecl</lhs> <rhs><nt def="NT-S">S</nt> 'encoding' <nt def='NT-Eq'>Eq</nt> '"' <nt def='NT-EncName'>EncName</nt> '"' | "'" <nt def='NT-EncName'>EncName</nt> "'" </rhs> </prod> <prod id='NT-EncName'><lhs>EncName</lhs> <rhs>[A-Za-z] ([A-Za-z0-9._] | '-')*</rhs> <com>0é0Æ0óe‡[W0`0Q0’T+0€{&S÷ST </com> </prod> </scrap> <termref def='dt-docent'>e‡fø[ŸOS</termref>0g0oÿ {&S÷S[£Š0oÿ <termref def="dt-xmldecl">XML[£Š</termref>0nNè0h0Y0‹0<nt def="NT-EncName">EncName</nt>0oÿ Ou(0Y0‹{&S÷Se¹_0nT RM0h0Y0‹0 </p> <!-- FINAL EDIT: check name of IANA and charset names --> <p>{&S÷S[£Š0g0oÿ P$<code>UTF-8</code>ÿ <code>UTF-16</code>ÿ <code>ISO-10646-UCS-2</code>SÊ0s<code>ISO-10646-UCS-4</code>0oÿ UnicodeSÊ0sISO/IEC 106460nTz.{&S÷S0n0_00ku(0D0‹0P$<code>ISO-8859-1</code>0K0‰<code>ISO-8859-9</code>0~0g0oÿ ISO 88590n[þ_Ü0Y0‹0Ñ0ü0È0n0_00ku(0D0‹0P$<code>ISO-2022-JP</code>ÿ <code>Shift_JIS</code>SÊ0s<code>EUC-JP</code>0oÿ JIS X-0208-19970nTz.{&S÷S0n0_00ku(0D0‹0XML&processor;0oÿ 0]0ŒNåY0n{&S÷Se¹_0’Š‹X0W0f0‚0ˆ0D0Internet Assigned Numbers Authority (IANA)0kÿ (<emph>charset</emph>s0h0W0f)v{“20U0Œ0_e‡[W{&S÷Se¹_0k0d0D0f0oÿ 0S0Œ0‰NåY0k0d0D0f0‚ÿ v{“20U0Œ0_T RM0gSÂqg0Y0‹0S0h0Lg0~0W0D00S0Œ0‰0nv{“20U0Œ0_T RM0oÿ Y'e‡[W0û\e‡[W0nS:R%0’0[0Z0k[š©0U0Œ0f0D0‹0n0gÿ 0S0Œ0‰0k[þ0Y0‹kÔ0’Šf00‹&processor;0oÿ Y'e‡[W0û\e‡[W0nS:R%0’0W0j0De¹lÕ0’0h0‹0n0Lg0~0W0D0S0h0klèa0Y0‹0</p> <p>XMLQæt|û0kn!0U0Œ0_[ŸOS0Lÿ {&S÷S[£Š0’T+0€0k0‚0K0K00‰0Zÿ [£Š0gy:0W0_0‚0nNåY0ne¹_0g{&S÷S0U0Œ0f0D0_0Šÿ {&S÷S[£Š0Lÿ Yè[ŸOS0ngRNåY0nOMn0kQúsþ0Y0Œ0pÿ <termref def="dt-error">&error;</termref>0h0Y0‹0 </p> <p>&byte-order-mark;0g0‚{&S÷S[£Š0g0‚YË0~0‰0j0D[ŸOS0oÿ UTF-8{&S÷S0g0j0Q0Œ0p0j0‰0j0D0</p> <p><!-- XML processors should make an effort to use all available information, internal and external, to aid in detecting an entity's correct encoding. Such information may include, but is not limited to: <ulist><item><p>An HTTP header</p></item> <item><p>A MIME header obtained other than through HTTP</p></item> <item><p>Metadata provided by the native OS file system or by document management software</p></item> <item><p>The bit patterns at the front of an entity, which may be analyzed to determine if the application of any known encoding yields a valid encoding declaration. See <titleref href='sec-guessing'>the appendix on autodetection of character sets</titleref> for a fuller description.</p></item></ulist> --> Qæt0g0M0j0D{&S÷S0’0‚0c0_[ŸOS0’XML&processor;0Lvz‰‹0W0_0h0M0oÿ &application;0k0]0nN‹[Ÿ0’wå0Wÿ <termref def='dt-fatal'>&fatal-error;</termref>0h0W0fÿ Qæt0’}BN†0W0j0Q0Œ0p0j0‰0j0D0 <!-- inform the application of this fact and may allow the application to request either that the entity should be treated as an <termref def="dt-unparsed">unparsed entity</termref>, or that processing should cease.--> </p> <p>{&S÷S[£Š0nO‹0’ÿ k!0ky:0Y0 <eg>&lt;?xml encoding='UTF-8'?> &lt;?xml encoding='EUC-JP'?></eg></p> </div3> </div2> <div2 id='entproc'> <head>XML&processor;0k0ˆ0‹[ŸOSSÊ0sSÂqg0nbq0D</head> <p>k!0nˆh0oÿ e‡[WSÂqgÿ [ŸOSSÂqgSÊ0s&unparsed-entity;0nT|Qú0W0Lsþ0Œ0‹e‡SÊ0sT00nX4T0k0J0Q0‹<termref def='dt-xml-proc'>XML&processor;</termref>0k‰lB0Y0‹c/‚0D0’‰}0Y0‹0Nuj]æ0nR0n0é0Ù0ë0oÿ Š‹X0ne‡0’y:0Y0 <glist> <gitem><label>Q…[¹0k0J0Q0‹SÂqg</label> <def><p>‰} 0n<termref def='dt-stag'>•‹YË0¿0°</termref>SÊ0s<termref def='dt-etag'>}BN†0¿0°</termref>0n•“0nNûa0nX4b@0g0nSÂqg0—^}BzïŠS÷<nt def='NT-content'>content</nt>0k[þ_Ü0Y0‹0</p></def> </gitem> <gitem> <label>\^`'P$0k0J0Q0‹SÂqg</label> <def><p><termref def='dt-stag'>•‹YË0¿0°</termref>0n\^`'0nP$ÿ SÈ0o<termref def='dt-attdecl'>\^`'[£Š</termref>0k0J0Q0‹&default-value;0n0D0Z0Œ0K0g0nSÂqg0—^}BzïŠS÷<nt def='NT-AttValue'>AttValue</nt>0k[þ_Ü0Y0‹0</p></def></gitem> <gitem> <label>\^`'P$0h0W0fQúsþ</label> <def><p>SÂqg0g0o0j0Oÿ <nt def='NT-Name'>Name</nt>0h0W0fQúsþ0<code>ENTITY</code>W‹0h0W0f[£Š0W0_\^`'0nP$ÿ SÈ0o<code>ENTITIES</code>W‹0h0W0f[£Š0W0_\^`'0nP$0k0J0Q0‹&space;0gS:R0‹&token;0nN0d0h0W0fQúsþ0Y0‹0</p> </def></gitem> <gitem><label>[ŸOSP$0k0J0Q0‹SÂqg</label> <def><p>[ŸOS0n[£Š0k0J0Q0‹ÿ 0Ñ0é0á0¿SÈ0oQ…è[ŸOS0n<termref def='dt-litentval'>&literal;[ŸOSP$</termref>Q…0nSÂqg0—^}BzïŠS÷<nt def='NT-EntityValue'>EntityValue</nt>0k[þ_Ü0Y0‹0</p></def></gitem> <gitem><label>DTD0k0J0Q0‹SÂqg</label> <def><p><termref def='dt-doctype'>DTD</termref>0nQ…è&subset;SÈ0oYè&subset;0g0nSÂqg00_0`0Wÿ <nt def='NT-EntityValue'>EntityValue</nt>SÈ0o<nt def="NT-AttValue">AttValue</nt>0nYPt0h0Y0‹0</p></def> </gitem> </glist></p> <!-- border value changed by bosak --> <htable border='1' cellpadding='7' align='center'> <!-- tbody wrapper added by bosak --> <htbody> <tr><td bgcolor='&cellback;' rowspan='2' colspan='1'></td> <td bgcolor='&cellback;' align='center' valign='bottom' colspan='4'>[ŸOS0nW‹</td> <td bgcolor='&cellback;' rowspan='2' align='center'>e‡[W</td> </tr> <tr align='center' valign='bottom'> <td bgcolor='&cellback;'>0Ñ0é0á0¿</td> <td bgcolor='&cellback;'>Q…è&newline;N‚,</td> <td bgcolor='&cellback;'>Yè&newline;&parsed-entity;&newline;N‚,</td> <td bgcolor='&cellback;'>&unparsed-entity;</td> </tr> <tr align='center' valign='middle'> <!--<td bgcolor='&cellback;' rowspan='4'>Recognition Context</td>--> <td bgcolor='&cellback;' align='right'>Q…[¹0g0n&newline;SÂqg</td> <td bgcolor='&cellback;'><titleref href='not-recognized'>Š‹X&newline;0W0j0D</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>SÖ¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='include-if-valid'>iŠ<0n0_00kSÖ¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ykb</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>SÖ¼0</titleref></td> </tr> <tr align='center' valign='middle'> <td bgcolor='&cellback;' align='right'>\^`'P$0g0n&newline;SÂqg</td> <td bgcolor='&cellback;'><titleref href='not-recognized'>Š‹X&newline;0W0j0D</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>SÖ¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ykb</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ykb</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>SÖ¼0</titleref></td> </tr> <tr align='center' valign='middle'> <td bgcolor='&cellback;' align='right'>\^`'P$0h0W0f&newline;Qúsþ</td> <td bgcolor='&cellback;'><titleref href='not-recognized'>Š‹X&newline;0W0j0D</titleref></td> <td bgcolor='&cellback;'><titleref href='not-recognized'>ykb</titleref></td> <td bgcolor='&cellback;'><titleref href='not-recognized'>ykb</titleref></td> <td bgcolor='&cellback;'><titleref href='notify'>wå</titleref></td> <td bgcolor='&cellback;'><titleref href='not recognized'>Š‹X&newline;0W0j0D</titleref></td> </tr> <tr align='center' valign='middle'> <td bgcolor='&cellback;' align='right'>[ŸOSP$0g0n&newline;SÂqg</td> <td bgcolor='&cellback;'><titleref href='included'>SÖ¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='bypass'>&bypass;</titleref></td> <td bgcolor='&cellback;'><titleref href='bypass'>&bypass;</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ykb</titleref></td> <td bgcolor='&cellback;'><titleref href='included'>SÖ¼0</titleref></td> </tr> <tr align='center' valign='middle'> <td bgcolor='&cellback;' align='right'>DTD0g0n&newline;SÂqg</td> <td bgcolor='&cellback;'><titleref href='as-PE'>PE0h0W0f&newline;SÖ¼0</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ykb</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ykb</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ykb</titleref></td> <td bgcolor='&cellback;'><titleref href='forbidden'>ykb</titleref></td> </tr> </htbody> </htable> <div3 id='not-recognized'> <head> Š‹X0W0j0D </head> <p>DTD0nY0g0oÿ <code>%</code>e‡[W0oÿ 0D0K0j0‹ry[š0naTs0‚ÿ 0‚0_0j0D00W0_0L0c0fÿ DTD0g0o0Ñ0é0á0¿[ŸOSSÂqg0h0W0fŠ‹X0Y0‹0‚0n0g0B0c0f0‚ÿ <nt def='NT-content'>content</nt>Q…0g0o&markup;0h0W0f0oŠ‹X0W0j0D0T iØ0kÿ iR0k[£Š0W0_\^`'0nP$0nN-0ksþ0Œ0‹X4T0’–d0Mÿ &unparsed-entity;0nT RM0oÿ Š‹X0W0j0D0 </p> </div3> <div3 id='included'> <head> SÖ¼0 </head> <p><termdef id="dt-include" term="Include">[ŸOS0oÿ 0]0n<termref def='dt-repltext'>&replacement-text;</termref>0’SÖ0ŠQú0Wÿ Qæt0Y0‹0hÿ SÂqgêOS0nNã00Š0kÿ SÂqg0L0B0c0_OMn0gÿ e‡fø0nNè0h0W0fT+0~0Œ0‹0K0n0ˆ0F0k<term>SÖ0Š¼0~0Œ0‹</term>0&replacement-text;0oÿ <termref def='dt-chardata'>e‡[W0Ç0ü0¿</termref>SÊ0s(0Ñ0é0á0¿[ŸOS0’–d0O0)<termref def="dt-markup">&markup;</termref>0n0D0Z0Œ0’T+0“0g0‚0ˆ0Oÿ 0S0Œ0‰0oÿ ^80ne¹lÕ0gŠ‹X0U0Œ0j0Q0Œ0p0j0‰0j0D00_0`0Wÿ &markup;0nS:R0Š[P0’&escape;0Y0‹0_00ku(0D0‹[ŸOS(&magicents;)0n&replacement-text;0oÿ ^80k0Ç0ü0¿0h0W0fbq0F(&string;"<code>AT&amp;amp;T;</code>"0oÿ "<code>AT&amp;T;</code>"0k\U•‹0U0Œÿ k‹0U0Œ0_0¢0ó0Ñ0µ0ó0É0oÿ [ŸOSSÂqg0nS:R0Š[P0h0W0f0oŠ‹X0W0j0D0)0e‡[WSÂqg0oÿ y:0W0_e‡[W0’SÂqgêOS0nNã00Š0kQæt0Y0‹0h0Mÿ <term>SÖ0Š¼0~0Œ0‹</term>0 </termdef></p> </div3> <div3 id='include-if-valid'> <head> iŠ<0n0_00kSÖ¼0 </head> <p>e‡fø0n&validity;0’<termref def="dt-valid">iŠ<</termref>0Y0‹0k0oÿ XML&processor;0L&parsed-entity;0x0nSÂqg0’Š‹X0W0_0h0Mÿ 0]0n&replacement-text;0’<termref def="dt-include">SÖ0Š¼0~</termref>0j0Q0Œ0p0j0‰0j0D0[ŸOS0LYè[ŸOS0g0B0c0fÿ XMLe‡fø0n&validity;0’iŠ<0W0j0Q0Œ0pÿ [ŸOS0n&replacement-text;0’SÖ0Š¼0“0g0‚<termref def="dt-may">0ˆ0D</termref>0Lÿ 0]0F0W0j0O0h0‚0ˆ0D0</p> <p>0S0nSÖlz00oÿ SGMLSÊ0sXML0n[ŸOS0nj_iË0LcÐO›0Y0‹êRÕSÖ¼0j_€ý0Lÿ e‡føO\bfB0n0â0¸0å0ü0ëS0’N;0jvîv„0h0W0fŠ-Š0U0Œ0f0J0Šÿ 0]0nNÖ0n&application;(ry0kÿ e‡fø0n0Ö0é0¦0º)0k0oÿ _Å0Z0W0‚iR0g0o0j0Dÿ 0h0D0FŠ‹X0k0ˆ0‹0O‹0H0pÿ 0Ö0é0¦0¶0oYè&parsed-entity;0x0nSÂqg0’‰‹0d0Q0‹0hÿ 0]0n[ŸOS0L[XW(0Y0‹0h0D0Fˆhy:0`0Q0’ˆL0Dÿ ˆhy:0’‰lB0U0Œ0_0h0M0k0`0Qÿ Q…[¹0’SÖ0ŠQú0Y0K0‚0W0Œ0j0D0 </p> </div3> <div3 id='forbidden'> <head> ykb </head> <p>k!0oykb0U0Œ0f0J0Šÿ <termref def='dt-fatal'>&fatal-error;</termref>0h0Y0‹0 <ulist> <item><p>a) <termref def='dt-unparsed'>&unparsed-entity;</termref>0x0nSÂqg0nQúsþ0 </p></item> <item><p>b) DTD0n<nt def='NT-EntityValue'>EntityValue</nt>SÈ0o<nt def="NT-AttValue">AttValue</nt>NåY0nèR0k0J0Q0‹ÿ e‡[WSÂqgSÈ0oN‚,[ŸOS0x0nSÂqg0nQúsþ0</p></item> <item><p>c) \^`'P$Q…0nYè[ŸOS0x0nSÂqg0</p> </item> </ulist> </p> </div3> <div3 id='notify'> <head> wå </head> <p><termref def='dt-unparsed'>&unparsed-entity;</termref>0nT RM0Lÿ <kw>ENTITY</kw>SÈ0o<kw>ENTITIES</kw>0n\^`'0nP$0k0J0D0f&token;0h0W0fsþ0Œ0_0h0Mÿ &processor;0oÿ &application;0k[þ0W0fÿ •¢#NØ0Q0‰0Œ0_<termref def="dt-notation">ŠlÕ</termref>T ÿ ŠlÕ0k[þ0Y0‹<termref def='dt-sysid'>0·0¹0Æ0à</termref>&identifier;SÊ0s([XW(0Y0Œ0p)<termref def='dt-pubid'>Ql•‹</termref>&identifier;0’wå0W0j0Q0Œ0p0j0‰0j0D0</p> </div3> <div3 id='bypass'> <head> &bypass; </head> <p>N‚,[ŸOSSÂqg0Lÿ [ŸOS[£Š0k0J0Q0‹<nt def='NT-EntityValue'>EntityValue</nt>Q…0ksþ0Œ0‹0h0Mÿ 0]0Œ0oq!‰–0U0Œÿ 0]0n0~0~k‹0‹0</p> </div3> <div3 id='as-PE'> <head> PE0h0W0fSÖ¼0 </head> <p>Yè&parsed-entity;0nX4T0hT iØ0kÿ 0Ñ0é0á0¿[ŸOS0oÿ &validity;0’<titleref href='include-if-valid'>iŠ<0Y0‹0h0M0`0QSÖ0Š¼0~0Œ0‹</titleref>_ʼn0L0B0‹00Ñ0é0á0¿[ŸOSSÂqg0’DTDQ…0kŠ‹X0W0fSÖ0Š¼0€0h0Mÿ 0]0n<termref def='dt-repltext'>&replacement-text;</termref>0oÿ 0]0nRM_Œ0kN0d0n&space-character;(#x20)0nNØR 0k0ˆ0c0f_0MO80p0U0Œ0‹00S0naVó0oÿ 0Ñ0é0á0¿[ŸOS0n&replacement-text;0Lÿ DTDQ…0n0D0O0d0K0ne‡lÕv„&token;0’[ŒQh0kT+0€0hÿ R6}0Y0‹0S0h0k0B0‹0 </p> </div3> <!-- <div3 id='gen-char-entproc'> <head>General and Character Entity Processing</head> <p>General-entity and character references are recognized in three contexts: wherever the nonterminal <nt def='NT-content'>content</nt> may appear, at any point within the nonterminal <nt def='NT-AttValue'>AttValue</nt>, and within the <termref def='dt-litentval'>literal entity value</termref> (<nt def='NT-EntityValue'>EntityValue</nt>) of an internal entity declaration. This section discusses the first two cases; the third is discussed <titleref href='intern-replacement'>below</titleref>. When an <termref def="dt-xml-proc">XML processor</termref> encounters such a reference, or the name of an unparsed entity as the value of an <kw>ENTITY</kw> or <kw>ENTITIES</kw> attribute, then: <olist> <item><p>In all cases, the XML processor may inform the application of the reference's occurrence and its identifier (for an entity reference, the name; for a character reference, the character number in decimal, hexadecimal, or binary form).</p></item> <item><p>For both character and entity references, the processor must remove the reference itself from the <termref def="dt-text">text</termref> data before passing the data to the application. </p></item> <item><p>For character references, the processor must pass the character indicated to the application in place of the reference. </p></item> <item><p>For an external entity, the processor must inform the application of the entity's <termref def="dt-sysid">system identifier</termref>, and <termref def="dt-pubid">public identifier</termref> if any. All strings of white space in the public identifier must be normalized to single space characters (#x20), and leading and trailing white space must be removed.</p></item> <item><p>If the external entity is binary, the processor must inform the application of the associated <termref def="dt-notation">notation</termref> name, and the notation's associated <termref def='dt-sysid'>system</termref> and <termref def='dt-pubid'>public</termref> (if any) identifiers.</p></item> <item><p><termdef id="dt-include" term="Include">For an internal (parsed) entity, the processor must <term>include</term> the entity; that is, retrieve its replacement text and process it as a part of the document (i.e. as <nt def="NT-content">content</nt> or <nt def="NT-AttValue">AttValue</nt>, whichever was being processed when the reference was recognized), passing the result to the application in place of the reference. The replacement text may contain both <termref def='dt-chardata'>character data</termref> and <termref def="dt-markup">markup</termref>, which must be recognized in the usual way, except that the replacement text of entities used to escape markup delimiters (the entities &magicents;) is always treated as data. (The string "<code>AT&amp;amp;T;</code>" expands to "<code>AT&amp;T;</code>" since the ampersand replacing "<code>&amp;amp;</code>" is not recognized as an entity-reference delimiter.) </termdef></p> <p>Since the entity may contain other entity references, an XML processor may have to repeat the inclusion process recursively.</p> </item> <item><p>If the entity is an external parsed entity, then in order to <termref def="dt-valid">validate</termref> the XML document, the processor must <termref def="dt-include">include</termref> the content of the entity.</p></item> <item><p>If the entity is an external parsed entity, and the processor is not attempting to <termref def="dt-valid">validate</termref> the XML document, the processor <termref def="dt-may">may</termref>, but need not, <termref def="dt-include">include</termref> the entity's content.</p> <p>This rule is based on the recognition that the automatic inclusion provided by the SGML and XML entity mechanism, primarily designed to support modularity in authoring, is not necessarily appropriate for other applications, in particular document browsing. Browsers, for example, when encountering an external parsed entity reference, might choose to provide a visual indication of the entity's presence and retrieve it for display only on demand. </p></item> </olist> </p> <p><termdef id="dt-escape" term="escape">Entity and character references can both be used to <term>escape</term> the left angle bracket, ampersand, and other delimiters. A set of general entities (&magicents;) is specified for this purpose. Numeric character references may also be used; they are expanded immediately when recognized, and must be treated as character data, so the numeric character references "<code>&amp;#60;</code>" and "<code>&amp;#38;</code>" may be used to escape <code>&lt;</code> and <code>&amp;</code> when they occur in character data.</termdef></p> </div3> <div3 id='PE-proc'> <head>Parameter Entity Processing</head> <p>Parameter-entity references are only recognized in the <termref def='dt-doctype'>DTD</termref>. Their processing, when they appear within the <termref def='dt-litentval'>literal entity value</termref> (<nt def='NT-EntityValue'>EntityValue</nt>) of an internal entity declaration, is discussed <titleref href='intern-replacement'>below</titleref>. They have these intended uses: <olist> <item><p>as a replacement for one or more complete markup declarations</p></item> <item><p>as a replacement for one or more complete "groups" in element declarations</p></item> <item><p>as a replacement for one or more complete "tokens" in markup declarations</p></item> </olist> </p> <p>The constraints requiring that PE replacement texts be properly nested with <titleref href='vc-PEinMarkupDecl'>markup declarations</titleref> and <titleref href='vc-PEinGroup'>content groups</titleref> govern the first two usages.</p> <p>To support the third intended usage, when an XML processor encounters a parameter-entity reference (outside of the <termref def='dt-litentval'>literal entity value</termref> in an entity declaration), it must <termref def="dt-include">include</termref> the named entity, but first expand its <termref def='dt-repltext'>replacement text</termref> by attaching space (#x20) characters to its beginning and the end, before processing it.</p> <p>The DTD text must match the relevant rules of this specification's grammar after all parameter-entity references have been expanded. <!-In addition, parameter entities referred to in specific contexts are required to satisfy certain constraints in their replacement text; for example, a parameter entity referred to within the internal DTD subset must match the rule for <nt def="NT-markupdecl">markupdecl</nt>. -> </p> </div3> --> </div2> <div2 id='intern-replacement'> <head>Q…è[ŸOS&replacement-text;0niË{É</head> <p>Q…è[ŸOS0nSÖbq0D0n‰[š0gÿ [ŸOSP$0’NŒ0d0n_b_0kS:R%0Y0‹0S0h0o_y0kzË0d0<termdef id="dt-litentval" term='Literal Entity Value'><term>&literal;[ŸOSP$</term>0oÿ [ŸOS[£ŠQ…0k[Ÿ–›0k[XW(0Y0‹ÿ _u({&0gVò0€&string;0h0Y0‹00S0Œ0oÿ —^}BzïŠS÷<nt def='NT-EntityValue'>EntityValue</nt>0k&match;0Y0‹0</termdef><termdef id='dt-repltext' term='Replacement Text'><term>&replacement-text;</term>0oÿ e‡[WSÂqgSÊ0s&parameter;[ŸOSSÂqg0nncÛ0H_Œ0k0J0Q0‹ÿ [ŸOS0nQ…[¹0h0Y0‹0</termdef></p> <p>Q…è[ŸOS[£ŠQ…0gN0H0‹&literal;[ŸOSP$<!-- replacement text -->(<nt def='NT-EntityValue'>EntityValue</nt>)0oÿ e‡[WSÂqgÿ &parameter;[ŸOSSÂqgSÊ0sN‚,[ŸOSSÂqg0’T+0“0g0ˆ0D00S0Œ0‰0nSÂqg0oÿ <!-- replacement text. -->&literal;[ŸOSP$Q…0k[ŒQh0kT+0~0Œ0f0D0j0Q0Œ0p0j0‰0j0D0<termref def='dt-include'>\U•‹0Y0‹</termref>[Ÿ–›0n&replacement-text;(QH0ky:0W0_0‚0n)0oÿ SÂqg0Y0‹&parameter;[ŸOS0n<emph>&replacement-text;</emph>0’T+0~0j0Q0Œ0p0j0‰0Zÿ &literal;[ŸOSP$Q…0g0ne‡[WSÂqg0nNã00Š0kSÂqg0W0_e‡[W0’T+0~0j0Q0Œ0p0j0‰0j0D00W0K0Wÿ N‚,[ŸOSSÂqg0oÿ 0]0n0~0~k‹0W, \U•‹0W0f0o0j0‰0j0D0 <!-- in the replacement text that is to be included. --> O‹0H0pÿ k!0n[£Š0’N0H0_0h0Y0‹0 <eg><![CDATA[<!ENTITY % pub "&#xc9;ditions Gallimard" > <!ENTITY rights "All rights reserved" > <!ENTITY book "La Peste: Albert Camus, &#xA9; 1947 %pub;. &rights;" >]]></eg> [ŸOS0n&replacement-text;"<code>book</code>"0oÿ k!0n0h0J0Š0h0j0‹0 <eg>La Peste: Albert Camus, &#169; 1947 &#201;ditions Gallimard. &amp;rights;</eg> SÂqg"<code>&amp;book;</code>"0Lÿ e‡fø0nQ…[¹SÈ0o\^`'P$Q…0kQúsþ0W0f0D0Œ0pÿ N‚,[ŸOSSÂqg"<code>&amp;rights;</code>"0oÿ \U•‹0U0Œ0f0D0‹0</p> <p>0S0Œ0‰0nSX}0j‰RG0oÿ ‰TvøN’O\u(0’0‚0d0 <!-- eåg,ŠžŠ30k0d0D0fÿ interaction = vøN’O\u(ÿ‘Ñg,ÿ --> –ã0W0DO‹0k0d0D0f0nŠs}00oÿ <titleref href='sec-entexpand'>[ŸOSSÂqg0n\U•‹0nNØ“2</titleref>0’SÂqg0n0S0h0 </p> <!-- Replaced by the above -TB <p>Implementors of XML processors need to know the rules for expansion of references in more detail. These rules only come into play when the replacement text for an internal entity itself contains other references. <olist> <item><p>In the replacement text of an internal entity, parameter-entity references and character references in the replacement text are recognized and resolved when the entity declaration is parsed, before the replacement text is stored in the processor's symbol table. General-entity references in the replacement text are not resolved when the entity declaration is parsed.</p></item> <item><p>In the document, when a general-entity reference is resolved, its replacement text is parsed. Character references encountered in the replacement text are resolved immediately; general-entity references encountered in the replacement text may be resolved or left unresolved, as described <titleref href="entproc">above</titleref>. Character and general-entity references must be contained entirely within the entity's replacement text. </p></item> </olist> </p> <p>Simple character references do not suffice to escape delimiters within the replacement text of an internal entity: they will be expanded when the entity declaration is parsed, before the replacement text is stored in the symbol table. When the entity itself is referred to, the replacement text will be parsed again, and the delimiters (no longer character references) will be recognized as delimiters. To escape the characters &magicents; in an entity replacement text, use a general-entity reference or a doubly-escaped character reference. See <titleref href='sec-entexpand'>the appendix on expansion of entity references</titleref> for detailed examples.</p> --> </div2> <div2 id='sec-predefined-ent'> <head>[š©n0[ŸOS</head> <p><termdef id="dt-escape" term="escape"> [ŸOSSÂqgSÊ0se‡[WSÂqg0n0D0Z0Œ0‚ÿ &left-angle-bracket;ÿ 0¢0ó0Ð0µ0ó0ÉSÊ0sNÖ0nS:R0Š[P0’<term>&escape;</term>0Y0‹0_00kOu(0g0M0‹00D0O0d0K0nN‚,[ŸOSÿ&magicents;ÿ 0’ÿ 0S0nvîv„0n0_00kc[š0Y0‹0epP$0k0ˆ0‹e‡[WSÂqg0‚ÿ T iØ0nvîv„0n0_00kOu(0g0M0‹0e‡[WSÂqg0oÿ Š‹X0U0Œ0‹0hvô0a0k\U•‹0U0Œÿ e‡[W0Ç0ü0¿0h0W0fbq00Œ0‹0n0gÿ epP$0k0ˆ0‹e‡[WSÂqg"<code>&amp;#60;</code>"SÊ0s"<code>&amp;#38;</code>"0oÿ e‡[W0Ç0ü0¿Q…0kQúsþ0Y0‹<code>&lt;</code>SÊ0s<code>&amp;</code>0’&escape;0Y0‹0_00kOu(0g0M0‹0</termdef></p> <p>0Y0y0f0nXML&processor;0oÿ [£Š0U0Œ0f0D0‹0K0i0F0K0k•¢OÂ0j0Oÿ 0S0Œ0‰0n[ŸOS0’Š‹X0W0j0O0f0o0j0‰0j0D0<termref def='dt-interop'>vøN’Ku(`'0n0_0</termref>ÿ &valid;0jXMLe‡fø0oÿ 0S0Œ0‰0n[ŸOS0’Ou(0Y0‹RM0kÿ NÖ0n[ŸOS0hT iØ0kÿ [£Š0Y0‹0S0h0Lg0~0W0D0[ŸOS0’[£Š0Y0‹X4T0oÿ &replacement-text;0’&escape;0Y0‹Ne‡[W0h0Y0‹Q…è[ŸOS0h0W0fÿ k!0n0h0J0Š0k[£Š0W0j0Q0Œ0p0j0‰0j0D0 <eg><![CDATA[<!ENTITY lt "&#38;#60;"> <!ENTITY gt "&#62;"> <!ENTITY amp "&#38;#38;"> <!ENTITY apos "&#39;"> <!ENTITY quot "&#34;"> ]]></eg> "<code>lt</code>"SÊ0s"<code>amp</code>"[£ŠQ…0n"<code>&lt;</code>"SÊ0s"<code>&amp;</code>"e‡[W0oÿ [ŸOS0nncÛ0Æ0­0¹0È0Lÿ &well-formed;0h0j0‹0ˆ0F0kNŒ‘Í0k&escape;0U0Œ0‹0S0h0klèa0 </p> </div2> <div2 id='Notations'> <head>ŠlÕ[£Š</head> <p> <termdef id="dt-notation" term="Notation"> <term>ŠlÕ</term>0oÿ <termref def="dt-extent">&unparsed-entity;</termref>0n_b_0’&identify;T RM0Kÿ SÈ0o<termref def="dt-pi">QætT}Nä</termref>0n[þŒa0h0Y0‹&application;0’&identify;T RM0h0Y0‹0</termdef></p> <p><termdef id="dt-notdecl" term="Notation Declaration"> <term>ŠlÕ[£Š</term>0oÿ ŠlÕ0nT RMSÊ0sYè&identifier;0’cÐO›0Y0‹00S0nT RM0oÿ [ŸOSSÊ0s\^`'0ê0¹0È[£ŠN&0s0k\^`'c[š0ku(0D0‹0Yè&identifier;0oÿ N0H0‰0Œ0_ŠlÕ0n0Ç0ü0¿0’Qæt0g0M0‹0Ø0ë0Ñ&application;0’ÿ XML&processor;SÈ0o0¯0é0¤0¢0ó0È0¢0×0ê0±0ü0·0ç0ó0Lc¢0Y0_00kÿ R)u(0g0M0‹0 <scrap lang='ebnf'> <head>ŠlÕ[£Š</head> <prod id='NT-NotationDecl'><lhs>NotationDecl</lhs> <rhs>'&lt;!NOTATION' <nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt> (<nt def='NT-ExternalID'>ExternalID</nt> | <nt def='NT-PublicID'>PublicID</nt>) <nt def='NT-S'>S</nt>? '>'</rhs></prod> <prod id='NT-PublicID'><lhs>PublicID</lhs> <rhs>'PUBLIC' <nt def='NT-S'>S</nt> <nt def='NT-PubidLiteral'>PubidLiteral</nt> </rhs></prod> </scrap> </termdef></p> <p>[£Š0Wÿ \^`'P$ÿ \^`'[š©SÈ0o[ŸOS[£Š0gSÂqg0Y0‹0Y0y0f0nŠlÕ0k0d0D0fÿ XML&processor;0oÿ ŠlÕ0nT RMSÊ0sYè&identifier;0’&application;0kcÐO›0W0j0Q0Œ0p0j0‰0j0D00U0‰0kÿ Yè&identifier;0’ÿ <termref def="dt-sysid">0·0¹0Æ0à&identifier;</termref>ÿ 0Õ0¡0¤0ëT SÈ0o0]0nNÖ0n`ÅX10k\U•‹0W0f0‚0ˆ0Oÿ 0S0Œ0‰0’u(0D0fÿ &application;0oÿ 0]0nŠlÕ0n0Ç0ü0¿0’Qæt0Y0‹&processor;0’wRÕ0Y0‹0(0W0K0Wÿ XML&processor;SÈ0o&application;0LRÕO\0Y0‹0·0¹0Æ0à0g0oR)u(0g0M0j0DŠlÕ0’ÿ XMLe‡fø0L[£Š0WSÂqg0W0f0‚ÿ 0S0Œ0oÿ &error;0h0o0W0j0D0ÿ </p> </div2> <div2 id='sec-doc-entity'> <head>e‡fø[ŸOS</head> <p><termdef id="dt-docent" term="Document Entity"><term>e‡fø[ŸOS</term>0oÿ [ŸOS0n_bb0Y0‹g(iË 0n&root;0g0B0c0fÿ <termref def="dt-xml-proc">XML&processor;</termref>0Lÿ Qæt0’•‹YË0Y0‹W0p¹0h0Y0‹0</termdef>0S0n&TR-or-Rec;0oÿ XML&processor;0Lÿ e‡fø[ŸOS0n[XW(0Y0‹X4b@0’0i0n0ˆ0F0k‰‹0d0Q0‹0K0oÿ ‰[š0W0j0D0NÖ0n[ŸOS0hup0j0Šÿ e‡fø[ŸOS0oT RM0’0‚0_0Zÿ 0D0K0j0‹‹XR%0‚0j0W0k&processor;0x0nQeR›&stream;0kQúsþ0W0f0‚0ˆ0D0</p> </div2> </div1> <!-- &Conformance; --> <div1 id='sec-conformance'> <head>iT`'</head> <p>iT0Y0‹<termref def="dt-xml-proc">XML&processor;</termref>0oÿ &validating;0‚0nSÊ0s&non-validating;0‚0n0nÿ NŒ0d0kR˜^0U0Œ0‹0</p> <p>&validating;0·0¹0Æ0àSÊ0s&non-validating;0·0¹0Æ0à0oÿ 0S0n&TR-or-Rec;0L‰[š0Y0‹&well-formed;R6}0x0nUSÍ0’X1TJ0W0j0Q0Œ0p0j0‰0j0D0</p> <p><termdef id="dt-validating" term="Validating Processor"><term>&validating;&processor;</term>0oÿ <termref def="dt-doctype">DTD</termref>Q…0n[£Š0k0ˆ0c0fy:0U0Œ0_ÿ R6}0x0nUSÍ0’X1TJ0W0j0Q0Œ0p0j0‰0j0D00U0‰0kÿ 0S0n&TR-or-Rec;0L‰[š0Y0‹&validity;R6}0x0nUSÍ0’ÿ 0Y0y0fX1TJ0W0j0Q0Œ0p0j0‰0j0D0 </termdef> </p> </div1> <div1 id='sec-notation'> <head>ŠlÕ</head> <p>XML0n_b_v„0je‡lÕ0oÿ |!SX0jbá_5Backus-Naur Form(EBNF)ŠlÕ0k0ˆ0c0fN0H0‹0e‡lÕ0nT‰RG0oÿ k!0n_b_0gÿ ŠS÷0’N0d[š©0Y0‹0 <eg>symbol ::= expression</eg></p> <p>ŠS÷0oÿ kc‰ˆhsþ0g[š©0Y0‹0h0M0oY'e‡[W0gYË0ÿ 0]0F0g0j0Q0Œ0pÿ \e‡[W0gYË00‹0&string;&literal;0oÿ _u({&0gVò0€0 <!--* The distinction between symbols which can and cannot be recognized using simple regular expressions may be used to set the boundary between an implementation's lexical scanner and its parser, but this specification neither constrains the placement of that boundary nor presupposes that all implementations will have one. *--> </p> <p>‰RG0nSóPt0n_Q…0g0oÿ N0dSÈ0o‰ep0ne‡[W0K0‰0j0‹&string;0h&match;0Y0‹0_00kÿ k!0n_0’Ou(0Y0‹0 <glist> <gitem> <label><code>#xN</code></label> <def><p>0S0S0gÿ <code>N</code>0o1620netep0h0Y0‹0ISO/IEC 106460ne‡[W0g0B0c0fÿ kc‰_b(UCS-4)0n&code-value;0’{&S÷0j0W22ep0h0W0f‰ã‘È0W0_0h0Mÿ c[š0W0_P$0h{I0W0D0‚0n0h&match;0Y0‹0<code>#xN</code>_b_0nQH˜-0k0¼0í0L0D0O0d0Ksþ0Œ0‹0K0oÿ aTs0’0‚0_0j0D0&code-value;<!-- bit string -->0k0J0Q0‹QH˜-0n0¼0í0nep0oÿ e‡[W0n{&S÷S0k0ˆ0c0flz[š0U0Œ0‹0n0gÿ XML0k0h0c0f0oaTs0L0j0D0 </p></def> </gitem> <gitem> <label><code>[a-zA-Z]</code>, <code>[#xN-#xN]</code></label> <def><p>c[š0W0_{ÄVò0nP$(N!zï0nP$0’T+0€0ÿ 0’0‚0dNûa0n<termref def='dt-character'>e‡[W</termref>0h&match;0Y0‹0</p></def> </gitem> <gitem> <label><code>[^a-z]</code>, <code>[^#xN-#xN]</code></label> <def><p>c[š0W0_{ÄVò<emph>Y</emph>0nP$0’0‚0dNûa0n<termref def='dt-character'>e‡[W</termref>0h&match;0Y0‹0</p></def> </gitem> <gitem> <label><code>[^abc]</code>, <code>[^#xN#xN#xN]</code></label> <def><p>c[š0W0_e‡[WNåY0nP$0’0‚0dNûa0n<termref def='dt-character'>e‡[W</termref>0h&match;0Y0‹0</p></def> </gitem> <gitem> <label><code>"string"</code></label> <def><p>&double-quote;0gVò0€&string;&literal;0h<termref def="dt-match">&match;0W0f0D0‹</termref>&string;&literal;0h&match;0Y0‹0</p></def> </gitem> <gitem> <label><code>'string'</code></label> <def><p>&single-quote;0gVò0€&string;&literal;0h<termref def="dt-match">&match;0W0f0D0‹</termref>&string;&literal;0h&match;0Y0‹0</p></def> </gitem> </glist> 0S0Œ0‰0nŠS÷0oÿ k!0n_b_0n}DT0[0gOu(0Y0‹00S0S0gÿ <code>A</code>SÊ0s<code>B</code>0oÿ SX}0j_0h0Y0‹0 <glist> <gitem> <label>(<code>expression</code>)</label> <def><p><code>expression</code>0oÿ N0d0n0~0h0~0Š0h0W0fbq0Dÿ 0S0S0ky:0Y}DT0[0gO0c0f0‚0ˆ0D0</p></def> </gitem> <gitem> <label><code>A?</code></label> <def><p><code>A</code>SÈ0oOU0‚0j0W0h&match;0Y0‹(0ª0×0·0ç0ó0n<code>A</code>)0</p></def> </gitem> <gitem> <label><code>A B</code></label> <def><p><code>A</code>0nk!0k<code>B</code>0LQúsþ0Y0‹0‚0n0h&match;0Y0‹0 </p></def> </gitem> <gitem> <label><code>A | B</code></label> <def><p><code>A</code>SÈ0o<code>B</code>ÿ 0_0`0Wÿ N!e¹0g0o0j0Dÿ 0h&match;0Y0‹0 </p></def> </gitem> <gitem> <label><code>A - B</code></label> <def><p><code>A</code>0h&match;0Y0‹0Lÿ <code>B</code>0h0o&match;0W0j0Dÿ Nûa0n&string;0h&match;0Y0‹0</p></def> </gitem> <gitem> <label><code>A+</code></label> <def><p><code>A</code>0n1VÞNåN 0n~pÔ0W0h&match;0Y0‹0</p></def> </gitem> <gitem> <label><code>A*</code></label> <def><p><code>A</code>0n0VÞNåN 0n~pÔ0W0h&match;0Y0‹0</p></def> </gitem> <!-- DEATH TO %'s <gitem> <label><code>%a</code></label> <def><p>specifies that <emph>in the external DTD subset</emph> a <termref def='dt-param-entity'>parameter entity</termref> may occur in the text at the position where <code>a</code> may occur; if so, its replacement text must match <code>S? a S?</code>. If the expression <code>a</code> is governed by a suffix operator, then the suffix operator determines both the maximum number of parameter-entity references allowed and the number of occurrences of <code>a</code> in the replacement text of the parameter entities: <code>%a*</code> means that <code>a</code> must occur zero or more times, and that some of its occurrences may be replaced by references to parameter entities whose replacement text must contain zero or more occurrences of <code>a</code>; it is thus a more compact way of writing <code>%(a*)*</code>. Similarly, <code>%a+</code> means that <code>a</code> must occur one or more times, and may be replaced by parameter entities with replacement text matching <code>S? (a S?)+</code>. The recognition of parameter entities in the internal subset is much more highly constrained. </p></def> </gitem> --> </glist> ub‰RGQ…0gOu(0Y0‹NÖ0nŠlÕ0’ÿ k!0ky:0Y0 <glist> <gitem> <label><code>/* ... */</code></label> <def><p>0³0á0ó0È0</p></def> </gitem> <gitem> <label><code>[ wfc: ... ]</code></label> <def><p>&well-formed;R6}0ub‰RG0kNØN0W0_ÿ <termref def="dt-wellformed">&well-formed;</termref>0ne‡fø0k•¢0Y0‹R6}0’ÿ T RM0k0ˆ0c0f&identify;0</p></def> </gitem> <gitem> <label><code>[ vc: ... ]</code></label> <def><p>&validity;R6}0ub‰RG0kNØN0W0_ÿ <termref def="dt-valid">&valid;</termref>0je‡fø0k•¢0Y0‹R6}0’ÿ T RM0k0ˆ0c0f&identify;0 </p></def> </gitem> </glist> </p></div1> </body> <back> <!-- &SGML; --> <!-- &Biblio; --> <div1 id='sec-bibliography'> <head>S€e‡s.</head> <div2 id='sec-existing-stds'> <head>&normative;S€e‡s.</head> <!--* <ulist><item> <p>Unicode and ISO/IEC 10646. This specification depends on the international standard ISO/IEC 10646 (with amendments AM 1 through AM 7) and the Unicode Standard, Version 2.0 <bibref ref='Unicode'/>, which define the encodings and meanings of the <termref def="dt-character">characters</termref> which make up XML <termref def="dt-text">text</termref>. All the characters in ISO/IEC 10646 are present, at the same code points, in Unicode.</p></item> <item><p>XXX XXX defines the syntax and semantics of Uniform Resource Identifiers, or URIs.</p></item> <item><p>IETF RFC 1766, with ISO 639 and 3166, describe the codes that may be used in the special <titleref href='sec-lang-tag'>xml:lang</titleref> attribute.</p> </item></ulist> *--> <blist> <bibl id='RFC1766' key='IETF RFC 1766'> IETF (Internet Engineering Task Force). <emph>RFC 1766: Tags for the Identification of Languages</emph>, ed. H. Alvestrand. 1995. </bibl> <bibl id='ISO639' key='ISO 639'> (International Organization for Standardization). <emph>ISO 8879:1988 (E). Code for the representation of names of languages.</emph> [Geneva]: International Organization for Standardization, 1988.</bibl> <bibl id='ISO3166' key='ISO 3166'> (International Organization for Standardization). <emph>ISO 3166-1:1997 (E). Codes for the representation of names of countries and their subdivisions &mdash; Part 1: Country codes</emph> [Geneva]: International Organization for Standardization, 1997.</bibl> <bibl id='ISO10646' key='ISO/IEC 10646'>ISO (International Organization for Standardization). <emph>ISO/IEC 10646-1993 (E). Information technology &mdash; Universal Multiple-Octet Coded Character Set (UCS) &mdash; Part 1: Architecture and Basic Multilingual Plane.</emph> [Geneva]: International Organization for Standardization, 1993 (plus amendments AM 1 through AM 7). </bibl> <bibl id='Unicode' key='Unicode'>The Unicode Consortium. <emph>The Unicode Standard, Version 2.0.</emph> Reading, Mass.: Addison-Wesley Developers Press, 1996.</bibl> </blist> </div2> <div2><head>NÖ0nS€e‡s.</head> <blist> <bibl id='Aho' key='Aho/Ullman'>Aho, Alfred V., Ravi Sethi, and Jeffrey D. Ullman. <emph>Compilers: Principles, Techniques, and Tools</emph>. Reading: Addison-Wesley, 1986, rpt. corr. 1988.</bibl> <bibl id="Berners-Lee" xml-link="simple" key="Berners-Lee et al."> Berners-Lee, T., R. Fielding, and L. Masinter. <emph>Uniform Resource Identifiers (URI): Generic Syntax and Semantics</emph>. 1997. (Work in progress; see updates to RFC1738.)</bibl> <bibl id='ABK' key='Br&#252;ggemann-Klein'>Br&#252;ggemann-Klein, Anne. <emph>Regular Expressions into Finite Automata</emph>. Extended abstract in I. Simon, Hrsg., LATIN 1992, S. 97-98. Springer-Verlag, Berlin 1992. Full Version in Theoretical Computer Science 120: 197-213, 1993. <!-- Universitat Freiburg, Institut fur Informatik, Bericht 33, Juli 1991.--> </bibl> <bibl id='ABKDW' key='Br&#252;ggemann-Klein and Wood'>Br&#252;ggemann-Klein, Anne, and Derick Wood. <emph>Deterministic Regular Languages</emph>. Universit&#228;t Freiburg, Institut f&#252;r Informatik, Bericht 38, Oktober 1991. </bibl> <bibl id="RFC1738" xml-link="simple" key="IETF RFC1738"> IETF (Internet Engineering Task Force). <emph>RFC 1738: Uniform Resource Locators (URL)</emph>, ed. T. Berners-Lee, L. Masinter, M. McCahill. 1994. </bibl> <bibl id="RFC1808" xml-link="simple" key="IETF RFC1808"> IETF (Internet Engineering Task Force). <emph>RFC 1808: Relative Uniform Resource Locators</emph>, ed. R. Fielding. 1995. </bibl> <bibl id="RFC2141" xml-link="simple" key="IETF RFC2141"> IETF (Internet Engineering Task Force). <emph>RFC 2141: URN Syntax</emph>, ed. R. Moats. 1997. </bibl> <bibl id='ISO8879' key='ISO/IEC 8879'>ISO (International Organization for Standardization). <emph>ISO/IEC 8879-1986 (E). Information processing &mdash; Text and Office Systems &mdash; Standard Generalized Markup Language (SGML).</emph> First edition &mdash; 1986-10-15. [Geneva]: International Organization for Standardization, 1986. </bibl> <bibl id='ISO10744' key='ISO/IEC 10744'>ISO (International Organization for Standardization). <emph>ISO/IEC 10744-1992 (E). Information technology &mdash; Hypermedia/Time-based Structuring Language (HyTime). </emph> [Geneva]: International Organization for Standardization, 1992. <emph>Extended Facilities Annexe.</emph> [Geneva]: International Organization for Standardization, 1996. </bibl> </blist> </div2> </div1> <div1 id='CharClasses'> <head>e‡[W0¯0é0¹</head> <p>Unicodejn–0k[š©0Y0‹&property;0k0W0_0L0c0fÿ e‡[W0oÿ &base-character;(BaseChar)(0S0Œ0‰0oÿ &diacritical-mark;0’–d0O0é0Æ0ó0¢0ë0Õ0¡0Ù0Ã0È0n0¢0ë0Õ0¡0Ù0Ã0Èe‡[W0’T+0€)ÿ &ideographic;(ideographic)SÊ0s&combining-character;(CombiningChar)(0S0n0¯0é0¹0oÿ 0{0h0“0i0n&diacritical-mark;0’T+0€)0k0¯0é0¹R0Q0Y0‹00S0Œ0‰0n0¯0é0¹0oÿ }PT0Wÿ &letter;(Letter)0n0¯0é0¹0h0j0‹0102epP$(Digit)SÊ0s&extender;(Extender)0‚S:R%0Y0‹0 <scrap lang="ebnf" id="CHARACTERS"> <head>e‡[W</head> <prodgroup pcw3="3" pcw4="15"> <prod id="NT-Letter"><lhs>Letter</lhs> <rhs><nt def="NT-BaseChar">BaseChar</nt> | <nt def="NT-Ideographic">Ideographic</nt></rhs> </prod> <prod id='NT-BaseChar'><lhs>BaseChar</lhs> <rhs>[#x0041-#x005A] |&nbsp;[#x0061-#x007A] |&nbsp;[#x00C0-#x00D6] |&nbsp;[#x00D8-#x00F6] |&nbsp;[#x00F8-#x00FF] |&nbsp;[#x0100-#x0131] |&nbsp;[#x0134-#x013E] |&nbsp;[#x0141-#x0148] |&nbsp;[#x014A-#x017E] |&nbsp;[#x0180-#x01C3] |&nbsp;[#x01CD-#x01F0] |&nbsp;[#x01F4-#x01F5] |&nbsp;[#x01FA-#x0217] |&nbsp;[#x0250-#x02A8] |&nbsp;[#x02BB-#x02C1] |&nbsp;#x0386 |&nbsp;[#x0388-#x038A] |&nbsp;#x038C |&nbsp;[#x038E-#x03A1] |&nbsp;[#x03A3-#x03CE] |&nbsp;[#x03D0-#x03D6] |&nbsp;#x03DA |&nbsp;#x03DC |&nbsp;#x03DE |&nbsp;#x03E0 |&nbsp;[#x03E2-#x03F3] |&nbsp;[#x0401-#x040C] |&nbsp;[#x040E-#x044F] |&nbsp;[#x0451-#x045C] |&nbsp;[#x045E-#x0481] |&nbsp;[#x0490-#x04C4] |&nbsp;[#x04C7-#x04C8] |&nbsp;[#x04CB-#x04CC] |&nbsp;[#x04D0-#x04EB] |&nbsp;[#x04EE-#x04F5] |&nbsp;[#x04F8-#x04F9] |&nbsp;[#x0531-#x0556] |&nbsp;#x0559 |&nbsp;[#x0561-#x0586] |&nbsp;[#x05D0-#x05EA] |&nbsp;[#x05F0-#x05F2] |&nbsp;[#x0621-#x063A] |&nbsp;[#x0641-#x064A] |&nbsp;[#x0671-#x06B7] |&nbsp;[#x06BA-#x06BE] |&nbsp;[#x06C0-#x06CE] |&nbsp;[#x06D0-#x06D3] |&nbsp;#x06D5 |&nbsp;[#x06E5-#x06E6] |&nbsp;[#x0905-#x0939] |&nbsp;#x093D |&nbsp;[#x0958-#x0961] |&nbsp;[#x0985-#x098C] |&nbsp;[#x098F-#x0990] |&nbsp;[#x0993-#x09A8] |&nbsp;[#x09AA-#x09B0] |&nbsp;#x09B2 |&nbsp;[#x09B6-#x09B9] |&nbsp;[#x09DC-#x09DD] |&nbsp;[#x09DF-#x09E1] |&nbsp;[#x09F0-#x09F1] |&nbsp;[#x0A05-#x0A0A] |&nbsp;[#x0A0F-#x0A10] |&nbsp;[#x0A13-#x0A28] |&nbsp;[#x0A2A-#x0A30] |&nbsp;[#x0A32-#x0A33] |&nbsp;[#x0A35-#x0A36] |&nbsp;[#x0A38-#x0A39] |&nbsp;[#x0A59-#x0A5C] |&nbsp;#x0A5E |&nbsp;[#x0A72-#x0A74] |&nbsp;[#x0A85-#x0A8B] |&nbsp;#x0A8D |&nbsp;[#x0A8F-#x0A91] |&nbsp;[#x0A93-#x0AA8] |&nbsp;[#x0AAA-#x0AB0] |&nbsp;[#x0AB2-#x0AB3] |&nbsp;[#x0AB5-#x0AB9] |&nbsp;#x0ABD |&nbsp;#x0AE0 |&nbsp;[#x0B05-#x0B0C] |&nbsp;[#x0B0F-#x0B10] |&nbsp;[#x0B13-#x0B28] |&nbsp;[#x0B2A-#x0B30] |&nbsp;[#x0B32-#x0B33] |&nbsp;[#x0B36-#x0B39] |&nbsp;#x0B3D |&nbsp;[#x0B5C-#x0B5D] |&nbsp;[#x0B5F-#x0B61] |&nbsp;[#x0B85-#x0B8A] |&nbsp;[#x0B8E-#x0B90] |&nbsp;[#x0B92-#x0B95] |&nbsp;[#x0B99-#x0B9A] |&nbsp;#x0B9C |&nbsp;[#x0B9E-#x0B9F] |&nbsp;[#x0BA3-#x0BA4] |&nbsp;[#x0BA8-#x0BAA] |&nbsp;[#x0BAE-#x0BB5] |&nbsp;[#x0BB7-#x0BB9] |&nbsp;[#x0C05-#x0C0C] |&nbsp;[#x0C0E-#x0C10] |&nbsp;[#x0C12-#x0C28] |&nbsp;[#x0C2A-#x0C33] |&nbsp;[#x0C35-#x0C39] |&nbsp;[#x0C60-#x0C61] |&nbsp;[#x0C85-#x0C8C] |&nbsp;[#x0C8E-#x0C90] |&nbsp;[#x0C92-#x0CA8] |&nbsp;[#x0CAA-#x0CB3] |&nbsp;[#x0CB5-#x0CB9] |&nbsp;#x0CDE |&nbsp;[#x0CE0-#x0CE1] |&nbsp;[#x0D05-#x0D0C] |&nbsp;[#x0D0E-#x0D10] |&nbsp;[#x0D12-#x0D28] |&nbsp;[#x0D2A-#x0D39] |&nbsp;[#x0D60-#x0D61] |&nbsp;[#x0E01-#x0E2E] |&nbsp;#x0E30 |&nbsp;[#x0E32-#x0E33] |&nbsp;[#x0E40-#x0E45] |&nbsp;[#x0E81-#x0E82] |&nbsp;#x0E84 |&nbsp;[#x0E87-#x0E88] |&nbsp;#x0E8A |&nbsp;#x0E8D |&nbsp;[#x0E94-#x0E97] |&nbsp;[#x0E99-#x0E9F] |&nbsp;[#x0EA1-#x0EA3] |&nbsp;#x0EA5 |&nbsp;#x0EA7 |&nbsp;[#x0EAA-#x0EAB] |&nbsp;[#x0EAD-#x0EAE] |&nbsp;#x0EB0 |&nbsp;[#x0EB2-#x0EB3] |&nbsp;#x0EBD |&nbsp;[#x0EC0-#x0EC4] |&nbsp;[#x0F40-#x0F47] |&nbsp;[#x0F49-#x0F69] |&nbsp;[#x10A0-#x10C5] |&nbsp;[#x10D0-#x10F6] |&nbsp;#x1100 |&nbsp;[#x1102-#x1103] |&nbsp;[#x1105-#x1107] |&nbsp;#x1109 |&nbsp;[#x110B-#x110C] |&nbsp;[#x110E-#x1112] |&nbsp;#x113C |&nbsp;#x113E |&nbsp;#x1140 |&nbsp;#x114C |&nbsp;#x114E |&nbsp;#x1150 |&nbsp;[#x1154-#x1155] |&nbsp;#x1159 |&nbsp;[#x115F-#x1161] |&nbsp;#x1163 |&nbsp;#x1165 |&nbsp;#x1167 |&nbsp;#x1169 |&nbsp;[#x116D-#x116E] |&nbsp;[#x1172-#x1173] |&nbsp;#x1175 |&nbsp;#x119E |&nbsp;#x11A8 |&nbsp;#x11AB |&nbsp;[#x11AE-#x11AF] |&nbsp;[#x11B7-#x11B8] |&nbsp;#x11BA |&nbsp;[#x11BC-#x11C2] |&nbsp;#x11EB |&nbsp;#x11F0 |&nbsp;#x11F9 |&nbsp;[#x1E00-#x1E9B] |&nbsp;[#x1EA0-#x1EF9] |&nbsp;[#x1F00-#x1F15] |&nbsp;[#x1F18-#x1F1D] |&nbsp;[#x1F20-#x1F45] |&nbsp;[#x1F48-#x1F4D] |&nbsp;[#x1F50-#x1F57] |&nbsp;#x1F59 |&nbsp;#x1F5B |&nbsp;#x1F5D |&nbsp;[#x1F5F-#x1F7D] |&nbsp;[#x1F80-#x1FB4] |&nbsp;[#x1FB6-#x1FBC] |&nbsp;#x1FBE |&nbsp;[#x1FC2-#x1FC4] |&nbsp;[#x1FC6-#x1FCC] |&nbsp;[#x1FD0-#x1FD3] |&nbsp;[#x1FD6-#x1FDB] |&nbsp;[#x1FE0-#x1FEC] |&nbsp;[#x1FF2-#x1FF4] |&nbsp;[#x1FF6-#x1FFC] |&nbsp;#x2126 |&nbsp;[#x212A-#x212B] |&nbsp;#x212E |&nbsp;[#x2180-#x2182] |&nbsp;[#x3041-#x3094] |&nbsp;[#x30A1-#x30FA] |&nbsp;[#x3105-#x312C] |&nbsp;[#xAC00-#xD7A3] </rhs></prod> <prod id='NT-Ideographic'><lhs>Ideographic</lhs> <rhs>[#x4E00-#x9FA5] |&nbsp;#x3007 |&nbsp;[#x3021-#x3029] </rhs></prod> <prod id='NT-CombiningChar'><lhs>CombiningChar</lhs> <rhs>[#x0300-#x0345] |&nbsp;[#x0360-#x0361] |&nbsp;[#x0483-#x0486] |&nbsp;[#x0591-#x05A1] |&nbsp;[#x05A3-#x05B9] |&nbsp;#x05BB#x05BD |&nbsp;#x05BF |&nbsp;[#x05C1-#x05C2] |&nbsp;#x05C4 |&nbsp;#x064B#x0652 |&nbsp;#x0670 |&nbsp;[#x06D6-#x06DC] |&nbsp;#x06DD#x06DF |&nbsp;[#x06E0-#x06E4] |&nbsp;[#x06E7-#x06E8] |&nbsp;[#x06EA-#x06ED] |&nbsp;[#x0901-#x0903] |&nbsp;#x093C |&nbsp;[#x093E-#x094C] |&nbsp;#x094D |&nbsp;[#x0951-#x0954] |&nbsp;[#x0962-#x0963] |&nbsp;[#x0981-#x0983] |&nbsp;#x09BC |&nbsp;#x09BE |&nbsp;#x09BF |&nbsp;[#x09C0-#x09C4] |&nbsp;[#x09C7-#x09C8] |&nbsp;[#x09CB-#x09CD] |&nbsp;#x09D7 |&nbsp;[#x09E2-#x09E3] |&nbsp;#x0A02 |&nbsp;#x0A3C |&nbsp;#x0A3E |&nbsp;#x0A3F |&nbsp;[#x0A40-#x0A42] |&nbsp;[#x0A47-#x0A48] |&nbsp;[#x0A4B-#x0A4D] |&nbsp;[#x0A70-#x0A71] |&nbsp;[#x0A81-#x0A83] |&nbsp;#x0ABC |&nbsp;[#x0ABE-#x0AC5] |&nbsp;[#x0AC7-#x0AC9] |&nbsp;[#x0ACB-#x0ACD] |&nbsp;[#x0B01-#x0B03] |&nbsp;#x0B3C |&nbsp;[#x0B3E-#x0B43] |&nbsp;[#x0B47-#x0B48] |&nbsp;[#x0B4B-#x0B4D] |&nbsp;[#x0B56-#x0B57] |&nbsp;[#x0B82-#x0B83] |&nbsp;[#x0BBE-#x0BC2] |&nbsp;[#x0BC6-#x0BC8] |&nbsp;[#x0BCA-#x0BCD] |&nbsp;#x0BD7 |&nbsp;[#x0C01-#x0C03] |&nbsp;[#x0C3E-#x0C44] |&nbsp;[#x0C46-#x0C48] |&nbsp;[#x0C4A-#x0C4D] |&nbsp;[#x0C55-#x0C56] |&nbsp;[#x0C82-#x0C83] |&nbsp;[#x0CBE-#x0CC4] |&nbsp;[#x0CC6-#x0CC8] |&nbsp;[#x0CCA-#x0CCD] |&nbsp;[#x0CD5-#x0CD6] |&nbsp;[#x0D02-#x0D03] |&nbsp;[#x0D3E-#x0D43] |&nbsp;[#x0D46-#x0D48] |&nbsp;[#x0D4A-#x0D4D] |&nbsp;#x0D57 |&nbsp;#x0E31 |&nbsp;[#x0E34-#x0E3A] |&nbsp;[#x0E47-#x0E4E] |&nbsp;#x0EB1 |&nbsp;[#x0EB4-#x0EB9] |&nbsp;[#x0EBB-#x0EBC] |&nbsp;[#x0EC8-#x0ECD] |&nbsp;[#x0F18-#x0F19] |&nbsp;#x0F35 |&nbsp;#x0F37 |&nbsp;#x0F39 |&nbsp;#x0F3E |&nbsp;#x0F3F |&nbsp;[#x0F71-#x0F84] |&nbsp;[#x0F86-#x0F8B] |&nbsp;[#x0F90-#x0F95] |&nbsp;#x0F97 |&nbsp;[#x0F99-#x0FAD] |&nbsp;[#x0FB1-#x0FB7] |&nbsp;#x0FB9 |&nbsp;[#x20D0-#x20DC] |&nbsp;#x20E1 |&nbsp;[#x302A-#x302F] |&nbsp;#x3099 |&nbsp;#x309A </rhs></prod> <prod id='NT-Digit'><lhs>Digit</lhs> <rhs>[#x0030-#x0039] |&nbsp;[#x0660-#x0669] |&nbsp;[#x06F0-#x06F9] |&nbsp;[#x0966-#x096F] |&nbsp;[#x09E6-#x09EF] |&nbsp;[#x0A66-#x0A6F] |&nbsp;[#x0AE6-#x0AEF] |&nbsp;[#x0B66-#x0B6F] |&nbsp;[#x0BE7-#x0BEF] |&nbsp;[#x0C66-#x0C6F] |&nbsp;[#x0CE6-#x0CEF] |&nbsp;[#x0D66-#x0D6F] |&nbsp;[#x0E50-#x0E59] |&nbsp;[#x0ED0-#x0ED9] |&nbsp;[#x0F20-#x0F29] </rhs></prod> <prod id='NT-Extender'><lhs>Extender</lhs> <rhs>#x00B7 |&nbsp;#x02D0 |&nbsp;#x02D1 |&nbsp;#x0387 |&nbsp;#x0640 |&nbsp;#x0E46 |&nbsp;#x0EC6 |&nbsp;#x3005 |&nbsp;[#x3031-#x3035] |&nbsp;[#x309D-#x309E] |&nbsp;[#x30FC-#x30FE] </rhs></prod> </prodgroup> </scrap> </p> <p>0S0S0g[š©0Y0‹e‡[W0¯0é0¹0oÿ Unicodee‡[W0Ç0ü0¿0Ù0ü0¹0K0‰ÿ k!0n0h0J0Š0k_—0‹0S0h0L0g0M0‹0 <ulist> <item> <p>a) T RM•‹YËe‡[W0oÿ Ll, Lu, Lo, Lt, Nl0«0Æ0´0êQ…0nN0d0g0j0Q0Œ0p0j0‰0j0D0</p> </item> <item> <p>b) T RM•‹YËe‡[WNåY0nT RMe‡[W0oÿ Mc, Me, Mn, Lm, Nd0«0Æ0´0êQ…0nN0d0g0j0Q0Œ0p0j0‰0j0D0</p> </item> <item> <p>c) &compatibility-area;0k0B0‹e‡[W(e‡[W{&S÷0g#xF9000ˆ0ŠY'0M0O#xFFFE0ˆ0Š\0U0De‡[W)0oÿ XML0k0J0Q0‹T RM0h0W0f0oÿ Š10U0Œ0j0D0</p> </item> <item> <p>d) &font-decomposition;0K&compatibility-decomposition;0’0‚0de‡[W(0d0~0Šÿ 0Ç0ü0¿0Ù0ü0¹Q…0nÿujvî0n0Õ0£0ü0ë0É0k"compatibility formatting tag"0L0B0‹0‚0n00S0Œ0oÿ ÿujvî0n0Õ0£0ü0ë0É0Lÿ "&lt;"0gYË0~0‹0S0h0k0ˆ0c0f0Þ0ü0¯NØ0Q0U0Œ0‹0)0oÿ Š10U0Œ0j0D0</p> </item> <item> <p>e) k!0ne‡[W0oÿ T RM•‹YËe‡[W0h0W0fbq0F00S0Œ0oÿ &property-file;0Lÿ 0S0Œ0‰0ne‡[W0’0¢0ë0Õ0¡0Ù0Ã0È0k˜^O<0Y0‹0h‰‹0j0Y0S0h0k0ˆ0‹00]0Œ0‰0o [#x02BB-#x02C1], #x0559, #x06E5, #x06E60h0Y0‹0</p> </item> <item> <p>f) e‡[W{&S÷0L#x20DD-#x20E00ne‡[W0oÿ (Unicode 0n5.140k0W0_0L0c0f)–dY0Y0‹0</p> </item> <item> <p>g) e‡[W{&S÷0L#x00B70ne‡[W0oÿ &property-list;0k0W0_0L0c0fÿ &extender;(extender)0kR˜^0Y0‹0</p> </item> <item> <p>h) e‡[W#x03870oÿ 0S0Œ0kvø_S0Y0‹kc‰_b0L#x00B70j0n0gÿ T RMe‡[W0kýR 0Y0‹0</p> </item> <item> <p>i) e‡[W':'SÊ0s'_'0oÿ T RM•‹YËe‡[W0h0W0fŠ10Y0</p> </item> <item> <p>j) e‡[W'-'SÊ0s'.'0oÿ T RMe‡[W0h0W0fŠ10Y0</p> </item> </ulist> </p> </div1> <inform-div1 id="sec-xml-and-sgml"> <head>XMLSÊ0sSGML</head> <p>XML0oÿ SGML0n&subset;0h0W0fŠ-Š0U0Œ0f0D0‹00Y0j00aÿ 0Y0y0f0n<termref def="dt-valid">&valid;</termref>0jXMLe‡fø0oÿ ‰h<0kiT0Y0‹SGMLe‡fø0k0‚0j0‹0SGML0Le‡fø0kŠ²0YR6–PNåY0kÿ XML0L0D0K0j0‹R6–P0’Š²0Y0K0k•¢0Y0‹Šs}00oÿ R%0n<loc href='http://www.w3.org/TR/NOTE-sgml-xml'>‰z </loc>0’SÂqg0n0S0h00S0n‰z 0oÿ XML0nR6}gaNö0’y:0YSGML[£Š0’T+0ÿ 0S0Œ0oÿ SGML&parser;0kOu(0g0M0‹0 </p> </inform-div1> <inform-div1 id="sec-entexpand"> <head>[ŸOSSÂqgSÊ0se‡[WSÂqg0n\U•‹</head> <p>0S0nNØ“20oÿ [ŸOSSÂqgSÊ0se‡[WSÂqg0’Š‹X0Wÿ \U•‹0Y0‹ÿ N#0nmA0Œ0’ÿ O‹0kO0c0fy:0Y0</p> <p> DTD0Lÿ k!0n[£Š0’T+0€X4T0’€0H0‹0 <eg><![CDATA[<!ENTITY example "<p>An ampersand (&#38;#38;) may be escaped numerically (&#38;#38;#38;) or with a general entity (&amp;amp;).</p>" > ]]></eg> XML&processor;0oÿ [ŸOS0n[£Š0’iËe‡‰ãg0W0_fBp¹0ge‡[WSÂqg0’Š‹X0Wÿ 0S0Œ0’‰ãlz0Y0‹0[ŸOS"<code>example</code>"0nP$0h0W0fÿ k!0n&string;0’OÝ[X0Y0‹0 <eg><![CDATA[<p>An ampersand (&#38;) may be escaped numerically (&#38;#38;) or with a general entity (&amp;amp;).</p> ]]></eg> e‡føQ…0g"<code>&amp;example;</code>"0’SÂqg0Y0‹0hÿ 0S0n0Æ0­0¹0È0oÿ Q0siËe‡‰ãg0U0Œ0‹00S0n0h0Mÿ ‰} "<code>p</code>"0n•‹YË0¿0°SÊ0s}BN†0¿0°0’Š‹X0Wÿ N 0d0nSÂqg0’Š‹X0W\U•‹0Y0‹00]0n}Pgœÿ ‰} "<code>p</code>"0oÿ k!0nQ…[¹0’0‚0d(0Y0y0f0Ç0ü0¿0h0Wÿ S:R0Š[PSÈ0o&markup;0o[XW(0W0j0D0)0 <eg><![CDATA[An ampersand (&) may be escaped numerically (&#38;) or with a general entity (&amp;). ]]></eg> </p> <p>‰RGSÊ0s0]0nR¹gœ0’0ˆ0ŠŠs}00ky:0Y0_0ÿ 0U0‰0k‰–Ñ0jO‹0’y:0Y0k!0nO‹0gÿ ˆLujS÷0oÿ SÂqg0nO¿[œ0n0_00`0Q0kNØ0Q0‹0 <eg><![CDATA[1 <?xml version='1.0'?> 2 <!DOCTYPE test [ 3 <!ELEMENT test (#PCDATA) > 4 <!ENTITY % xx '&#37;zz;'> 5 <!ENTITY % zz '&#60;!ENTITY tricky "error-prone" >' > 6 %xx; 7 ]> 8 <test>This sample shows a &tricky; method.</test> ]]></eg> 0S0Œ0’Qæt0Y0‹0hÿ k!0n0h0J0Š0h0j0‹0 <ulist spacing="compact"> <item><p>a) 4ˆLvî0gÿ 37ujvî0ne‡[W0x0nSÂqg0’vô0a0k\U•‹0Wÿ 0Ñ0é0á0¿[ŸOS"<code>xx</code>"0’ÿ 0·0ó0Ü0ë0Æ0ü0Ö0ë0k"<code>%zz;</code>"0h0D0FP$0h0h0‚0kOÝ[X0Y0‹0&replacement-text;0’Q0spgû0Y0‹0S0h0o0j0D0n0gÿ 0Ñ0é0á0¿[ŸOS"<code>zz</code>"0x0nSÂqg0oŠ‹X0W0j0D("<code>zz</code>"0oÿ 0~0`[£Š0U0Œ0f0D0j0D0n0gÿ pgû0U0Œ0Œ0pÿ &error;0h0j0‹0)0</p></item> <item><p>b) 5ˆLvî0gÿ e‡[WSÂqg"<code>&amp;#60;</code>"0’vô0a0k\U•‹0Wÿ 0Ñ0é0á0¿[ŸOS"<code>zz</code>"0’"<code>&lt;!ENTITY tricky "error-prone" ></code>"0h0D0F&replacement-text;0h0h0‚0kOÝ[X0Y0‹00S0Œ0oÿ &well-formed;0n[ŸOS[£Š0h0Y0‹0</p></item> <item><p>c) 6ˆLvî0gÿ "<code>xx</code>"0x0nSÂqg0’Š‹X0Wÿ "<code>xx</code>"0n&replacement-text;(0Y0j00aÿ "<code>%zz;</code>")0’iËe‡‰ãg0Y0‹0"<code>zz</code>"0x0nSÂqg0’}š0D0fŠ‹X0Wÿ &replacement-text;("<code>&lt;!ENTITY tricky "error-prone" ></code>")0’iËe‡‰ãg0Y0‹0N‚,[ŸOS"<code>tricky</code>"0oÿ 0S0nfBp¹0g0oÿ [£Š0U0Œ0f0J0Šÿ 0]0n&replacement-text;0oÿ "<code>error-prone</code>"0h0Y0‹0 </p></item> <item><p>d) 8ˆLvî0gÿ N‚,[ŸOS"<code>tricky</code>"0x0nSÂqg0’Š‹X0Wÿ \U•‹0Y0‹0‰} "<code>test</code>"0n[ŒQh0jQ…[¹0oÿ k!0n(Q…[¹0’0]0ŒêOSˆhsþ0Y0‹0)&string;0h0j0‹00d0~0Šÿ <emph>This sample shows a error-prone method.</emph> </p></item> </ulist> </p> </inform-div1> <inform-div1 id="determinism"> <head>lz[šv„Q…[¹0â0Ç0ë</head> <p><termref def='dt-compat'>N’cÛ`'0n0_0</termref>ÿ ‰} [£Š0k0J0Q0‹Q…[¹0â0Ç0ë0oÿ lz[šv„0h0Y0‹_ʼn0L0B0‹0 </p> <!-- FINAL EDIT: WebSGML allows ambiguity? --> <p>SGML0oÿ lz[šv„Q…[¹0â0Ç0ë(SGML0g0oÿ —^0B0D0~0D0hT|0v0)0’‰lB0Y0‹0SGML0·0¹0Æ0à0’u(0D0fO\b0W0_XML&processor;0oÿ —^lz[šv„Q…[¹0â0Ç0ë0’&error;0h0W0f0‚0ˆ0D0</p> <p>O‹0H0pÿ Q…[¹0â0Ç0ë<code>((b, c) | (b, d))</code>0o—^lz[šv„0h0j0‹00S0Œ0oÿ gR0k<code>b</code>0’N0H0_0h0Mÿ 0â0Ç0ëQ…0n0D0Z0Œ0n<code>b</code>0h&match;0Y0‹0n0Lg0~0W0D0Kÿ 0]0nk!0n‰} 0’QHŠ­00Y0‹0S0h0j0W0k0oÿ &parser;0owå0‹0S0h0L0g0M0j0D0S0h0k0ˆ0‹00S0nX4T0oÿ <code>b</code>0x0nNŒ0d0nSÂqg0oÿ N0d0nSÂqg0k0~0h00‹0S0h0L0g0Mÿ 0â0Ç0ë0oÿ <code>(b, (c | d))</code>0h0j0‹00S0Œ0gÿ gR0n<code>b</code>0Lÿ Q…[¹0â0Ç0ëQ…0nN0d0nT RM0h0`0Q&match;0Y0‹0S0h0of0‰0K0h0j0‹0&parser;0oÿ QHŠ­00W0fÿ k!0kge0‹0‚0n0’wå0‹_ʼn0L0j0D0<code>c</code>0‚<code>d</code>0‚ÿ S×t0U0Œ0‹0</p> <p>_b_v„0ky:0Y0Aho, Sethi, and Ullman <bibref ref='Aho'/>0n3.90n0¢0ë0´0ê0º0à3.50njn–v„0j0¢0ë0´0ê0º0à0’u(0D0fÿ Q…[¹0â0Ç0ë0K0‰g –P0ª0ü0È0Þ0È0ó0’iËb0Y0‹0S0h0L0g0M0‹00S0nz.0nY0O0n0¢0ë0´0ê0º0à0g0oÿ kc‰ˆhsþ0k0J0Q0‹T00nOMn(0d0~0Šÿ kc‰ˆhsþ0niËe‡g(0k0J0Q0‹T00ng+zï0Î0ü0É)0k[þ0W0fÿ follow set(k!0k0i0nOMn0kyûRÕSï€ý0K0’ˆh0Y0‚0n)0’iËb0Y0‹00B0‹OMn0k[þ0Y0‹follow set0k0J0D0fÿ ‰ep0nOMn0LT 0X‰} W‹T 0g0é0Ù0ëNØ0Q0U0Œ0f0D0Œ0pÿ 0]0nQ…[¹0â0Ç0ë0o&error;0h0j0Šÿ &error;0’Ô0YX4T0‚0B0‹0 </p> <p>0Y0y0f0n—^lz[šv„Q…[¹0â0Ç0ë0’{IO¡0jlz[šv„Q…[¹0â0Ç0ë0kY cÛ0Y0‹0S0h0o0g0M0j0D0Lÿ Y0O0n—^lz[šv„Q…[¹0â0Ç0ë0’Y cÛ0Y0‹0¢0ë0´0ê0º0à0L[XW(0Y0‹0Br&#252;ggemann-Klein 1991 <bibref ref='ABK'/>0’SÂqg0n0S0h0</p> </inform-div1> <inform-div1 id="sec-guessing"> <head>e‡[W{&S÷S0nêRÕiQú</head> <p> XML0n{&S÷S[£Š0oÿ T[ŸOS0nQ…è0é0Ù0ë0h0W0fj_€ý0Wÿ 0i0ne‡[W{&S÷S0’Ou(0Y0‹0K0’y:0Y00W0K0Wÿ XML&processor;0oÿ Q…è0é0Ù0ë0’Š­0€RM0kÿ 0i0ne‡[W{&S÷S0’Ou(0Y0‹0K0’wå0‹_ʼn0L0B0Šÿ 0S0Œ0Lÿ Q…è0é0Ù0ë0Ly:0]0F0h0Y0‹0S0h0k0j0‹0N‚,v„0k0oÿ 0S0Œ0oÿ }vgv„0jr¶aK0h0j0‹00W0K0Wÿ XML0k0J0D0f0oÿ [ŒQh0k0o}vgv„0g0o0j0D00S0Œ0oÿ XML0Lÿ k!0nNŒ0d0np¹0gN‚,v„0jX4T0k[þ0Y0‹R6–P0’R 0H0‹0S0h0k0ˆ0‹0N0d0nR6–P0oÿ 0i0n[ŸˆÅ0‚g –PP 0ne‡[W{&S÷S0`0Q0n0µ0Ý0ü0È0’`ó[š0Y0‹0S0h0h0Y0‹0NÖ0nN0d0nR6–P0oÿ T[ŸOS0gOu(0Y0‹e‡[W{&S÷S0’êRÕiQúSï€ý0h0Y0‹ÿ XML0n{&S÷S[£Š0nOMnSÊ0sQ…[¹0k•¢0Y0‹R6–P0h0Y0‹0Y0O0nX4T0kÿ XML0n0Ç0ü0¿0¹0È0ê0ü0à0kR 0Hÿ NÖ0n`ÅX10LR)u(0g0M0‹00S0S0g0oÿ XML0n[ŸOS0L&processor;0kn!0U0Œ0‹0h0Mÿ (Yè)`ÅX10’O40F0K0i0F0K0k0ˆ0c0fÿ NŒ0d0nX4T0kR0Q0‹00~0ZgR0nX4T0’y:0Y0</p> <p> UTF-8_b_SÈ0oUTF-16_b_0g0o0j0DXML[ŸOS0oÿ gR0ne‡[W0’ <code>&lt;?xml</code>'0h0Y0‹XML{&S÷S[£Š0gYË0~0‰<emph>0j0Q0Œ0p0j0‰0j0D</emph>0n0gÿ 0i0niT0W0_&processor;0‚ÿ QeR›0k0B0‹20ª0¯0Æ0Ã0ÈSÈ0o40ª0¯0Æ0Ã0È0’Š¿0y0Œ0pÿ k!0n0i0nX4T0L0B0f0o0~0‹0K0’iQú0g0M0‹00S0n0ê0¹0È0’Š­0€–›0k0oÿ UCS-40n'&lt;'0L"<code>#x0000003C</code>"ÿ '?'0L"<code>#x0000003F</code>"ÿ SÊ0sUTF-160n0Ç0ü0¿&stream;0n_ʼn0h0Y0‹&byte-order-mark;0L"<code>#xFEFF</code>"0h0D0F0S0h0’wå0c0f0J0O0h_yzË0d0K0‚0W0Œ0j0D0</p> <p> <ulist> <item> <p>a) <code>00 00 00 3C</code>: UCS-4, big-endian 0Þ0·0ó (1234˜)</p> </item> <item> <p>b) <code>3C 00 00 00</code>: UCS-4, little-endian 0Þ0·0ó (4321˜)</p> </item> <item> <p>c) <code>00 00 3C 00</code>: UCS-4, fn0g0o0j0D0ª0¯0Æ0Ã0Ș (2143)</p> </item> <item> <p>d) <code>00 3C 00 00</code>: UCS-4, fn0g0o0j0D0ª0¯0Æ0Ã0Ș (3412)</p> </item> <item> <p>e) <code>FE FF</code>: UTF-16, big-endian</p> </item> <item> <p>f) <code>FF FE</code>: UTF-16, little-endian</p> </item> <item> <p>g) <code>00 3C 00 3F</code>: UTF-16, big-endian, &byte-order-mark;0j0W(0W0_0L0c0fÿ S³[Æ0k0D0H0pÿ &error;0h0Y0‹0)0</p> </item> <item> <p>h) <code>3C 00 3F 00</code>: UTF-16, little-endian, &byte-order-mark;0j0W(0W0_0L0c0fÿ S³[Æ0k0D0H0pÿ &error;0h0Y0‹0)0</p> </item> <item> <p>i) <code>3C 3F 78 6D</code>: UTF-8, ISO 646, ASCII, ISO 88590nT0Ñ0ü0Èÿ Shift-JISÿ EUCÿ N&0s0kNûa0nNÖ0n70Ó0Ã0Èÿ 80Ó0Ã0ÈSÈ0om÷W(^E0n{&S÷S0g0B0c0fÿ ASCIIe‡[W0’^80nOMnÿ ^ESÊ0sP$0h0Y0‹0S0h0’OÝŠ<0Y0‹0‚0n00S0Œ0‰0n0i0Œ0k[þ_Ü0Y0‹0K0’iQú0Y0‹0_00k0oÿ [Ÿ–›0n{&S÷S[£Š0’Š­0¼0~0j0Q0Œ0p0j0‰0j0D00W0K0Wÿ 0S0Œ0‰0Y0y0f0n{&S÷S0oÿ ASCIIe‡[W0k[þ0W0fT 0X0Ó0Ã0È0Ñ0¿0ü0ó0’Ou(0Y0‹0n0gÿ {&S÷S[£ŠêOS0oÿ kcxº0kŠ­¼0Sï€ý0h0Y0‹0 </p> </item> <item> <p>j) <code>4C 6F A7 94</code>: EBCDIC (SÈ0o0]0nY z.00i0n0³0ü0É0Ú0ü0¸0’Ou(0Y0‹0K0’wå0‹0_00k0oÿ {&S÷S[£ŠQhOS0’Š­0¼0~0Œ0j0Q0Œ0p0j0‰0j0D0)</p> </item> <item> <p>k) 0]0nNÖ: {&S÷S[£Š0j0W0nUTF-800]0F0g0j0D0h0M0k0oÿ 0Ç0ü0¿&stream;0LXÊ0Œ0f0D0‹0Kÿ e­rGv„0k0j0c0f0D0‹0Kÿ OU0‰0K0n_b_0k0W0_0L0c0fWË0¼0~0Œ0f0D0‹0</p> </item> </ulist> </p> <p> 0S0nz ^¦0nêRÕR$R%0g0‚ÿ XML0n{&S÷S[£Š0’Š­0¼0ÿ e‡[W{&S÷S0n&identifier;0’‰ãg0Y0‹0k0oSAR0h0Y0‹0&identifier;0n‰ãg0oÿ ˜^O<0Y0‹T00n{&S÷S0nN0dN0d0’S:R%0Y0‹0_00k_ʼn0h0Y0‹(O‹0H0pÿ UTF-8SÊ0s88590’S:R%0Y0‹0_0ÿ 88590nT0Ñ0ü0È0’S:R%0Y0‹0_0ÿ Ou(0W0f0D0‹ry[š0nEBCDIC0³0ü0É0Ú0ü0¸0’S:R%0Y0‹0_0ÿ 0j0i0)0 </p> <p> {&S÷S[£Š0nQ…[¹0’ASCIIe‡[W0k–P[š0W0f0D0‹0n0gÿ 0i0nR˜^0n{&S÷S0’Ou(0Y0‹0K0’iQú0Y0Œ0pÿ &processor;0oÿ {&S÷S[£ŠQhOS0’kcxº0kŠ­0¼0€0S0h0L0g0M0‹0sþ[ŸUO˜L0h0W0fÿ ^ƒ0OOu(0U0Œ0f0D0‹e‡[W{&S÷S0oÿ N 0nR˜^0n0D0Z0Œ0K0k0B0f0o0~0‹0n0gÿ 0ª0Ú0ì0ü0Æ0£0ó0°0·0¹0Æ0àSÈ0oO0×0í0È0³0ë0LN0H0‹Yè`ÅX10’Oᘠ<p> &processor;0LOu(0Y0‹e‡[W{&S÷S0’iQú0W0U0H0Y0Œ0pÿ 0]0Œ0^0Œ0nX4T0k[þ0W0fR%P 0nQeR›0ë0ü0Á0ó0’T|0sQú0Yÿ SÈ0oQeR›0Y0‹Te‡[W0k[þ0WiR0jY cÛ•¢ep0’T|0sQú0Y0S0h0k0ˆ0c0fÿ iR0jRÕO\0LSï€ý0h0j0‹0</p> <p> êRêOS0k0é0Ù0ëNØ0Q0’0Y0‹0D0K0j0‹0·0¹0Æ0à0g0‚T iØ0`0Lÿ 0½0Õ0È0¦0§0¢0Lÿ {&S÷S[£Š0’fôe°0[0Z0k[ŸOS0ne‡[W–ÆTSÈ0o{&S÷S0’Y 0H0_0j0‰0pÿ XML0n{&S÷S[£Š0oÿ j_€ý0W0j0D0e‡[W{&S÷S0ë0ü0Á0ó0n[ŸˆÅ€0oÿ [ŸOS0n0é0Ù0ëNØ0Q0kOu(0Y0‹Q…èSÊ0sYè0n`ÅX10nkcxº0U0nOÝŠ<0klèa0Y0‹0n0Lg0~0W0D0 </p> <p>ÿujvî0nX4T0oÿ XML0n[ŸOS0nNÖ0kÿ {&S÷S`ÅX10L[XW(0Y0‹0h0M0g0B0c0fÿ 0D0O0d0K0n0Õ0¡0¤0ë0·0¹0Æ0àSÊ0s0Í0Ã0È0ï0ü0¯0×0í0È0³0ë0g0oÿ 0]0n{&S÷S`ÅX10L[XW(0Y0‹0‰ep0n`ÅX10LR)u(0g0M0‹0h0Mÿ <!-- (e.g. both the internal encoding declaration and an external label), -->0]0Œ0‰0nvø[þv„0jQ*QH^¦SÊ0s0]0Œ0‰0LwÛvþ0W0_0h0M0ng0~0W0DQæte¹lÕ0oÿ XML0n‘M0kOu(0Y0‹ÿ 0ˆ0ŠšØl4n–0n0×0í0È0³0ë0nNè0h0W0f‰z 0Y0‹0n0L0ˆ0D0O‹0H0pÿ Q…è0é0Ù0ëSÊ0sYè&header;0k[XW(0Y0‹MIME_b_0n0é0Ù0ë0nvø[þv„0jQ*QH^¦0k[þ0Y0‹‰RG0oÿ text/xmlSÊ0sapplication/xml0nMIMEW‹0’[š©0Y0‹RFCe‡fø0nNè0h0j0‹e¹0L0ˆ0D00W0K0Wÿ vøN’Ku(`'0n0_00kÿ k!0n‰RG0k_“0F0S0h0Lg0~0W0D0 <ulist> <item><p>a) XML0n[ŸOS0L0Õ0¡0¤0ë0k[XW(0Y0Œ0pÿ &byte-order-mark;SÊ0s{&S÷S[£ŠPI0oÿ ([XW(0Y0Œ0p)e‡[W{&S÷S0’lz[š0Y0‹0_00kOu(0Y0‹0NÖ0n0Y0y0f0n&hueristics;SÊ0s`ÅX10oÿ &error;VÞ_©0n0_00`0Q0ku(0D0‹0 </p></item> <item><p>b) XML0n[ŸOS0’MIMEW‹text/xml0g‘M0Y0‹0h0M0oÿ 0S0nMIMEW‹0n0‚0dcharset0Ñ0é0á0¿0Le‡[W{&S÷Se¹lÕ0’lz[š0Y0‹0NÖ0n0Y0y0f0n&hueristics;SÊ0s`ÅX10oÿ &error;VÞ_©0n0_00`0Q0ku(0D0‹0 </p></item> <item><p>c) XML0n[ŸOS0’ <!-- via the HTTP protocol -->MIMEW‹application/xml0g‘M0Y0‹0h0M0oÿ &byte-order-mark;SÊ0s{&S÷S[£ŠPI0’([XW(0Y0Œ0p)e‡[W{&S÷S0nlz[š0n0_00kOu(0Y0‹0NÖ0n0Y0y0f0n&hueristics;SÊ0s`ÅX10o&error;VÞ_©0n0_00`0Q0ku(0D0‹0 </p></item> </ulist> 0S0Œ0‰0n‰RG0oÿ 0×0í0È0³0ë0k0d0D0f0nŒÇe™0L0j0D0h0M0k0`0Qu(0D0‹0ry0kÿ MIMEW‹text/xmlSÊ0sapplication/xml0’[š©0W0_0‰ÿ 0S0Œ0‰0’‰[š0Y0‹RFC0k[XW(0Y0‹‰[š0Lÿ 0S0Œ0‰0n‰RG0kSÖ0c0fNã00‹0 </p> </inform-div1> <!-- <div1 id='sec-trival-grammar'> <head>A Trivial Grammar for XML Documents</head> <p>The grammar given in the body of this specification is relatively simple, but for some purposes it is convenient to have an even simpler one. A very simple, though non-conforming, <termref def="dt-xml-proc">XML processor</termref> could parse a <termref def="dt-wellformed">well-formed</termref> XML document using the following simplified grammar, recognizing all element boundaries correctly, though not expanding entity references and not detecting all errors: <scrap lang="ebnf"> <head>Trivial text grammar</head> <prodgroup pcw2="5.5" pcw4="17" pcw5="10"> <prod id='NT-simpleDoc'><lhs>simpleDoc</lhs> <rhs>(<nt def='NT-SimpleData'>SimpleData</nt> | <nt def='NT-Markup'>Markup</nt>)*</rhs></prod> <prod id="NT-SimpleData"><lhs>SimpleData</lhs> <rhs>[^&lt;&amp;]*</rhs> <com>cf. PCData</com> </prod> <prod id="NT-SimpleLit"><lhs>SimpleLit</lhs> <rhs>('"' [^"]* '"')</rhs> <rhs>|&nbsp;("'" [^']* "'")</rhs> <com>cf. SkipLit</com> </prod> <prod id='NT-Markup'><lhs>Markup</lhs> <rhs>'&lt;' <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt>? '=' <nt def='NT-S'>S</nt>? <nt def='NT-SimpleLit'>SimpleLit</nt>)* <nt def='NT-S'>S</nt>? '&gt;'</rhs><com>start-tags </com> <rhs>| '&lt;' <nt def='NT-Name'>Name</nt> (<nt def='NT-S'>S</nt> <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt>? '=' <nt def='NT-S'>S</nt>? <nt def='NT-SimpleLit'>SimpleLit</nt>)* <nt def='NT-S'>S</nt>? '/&gt;'</rhs><com>empty elements</com> <rhs>| '&lt;/' <nt def='NT-Name'>Name</nt> <nt def='NT-S'>S</nt>? '&gt;'</rhs> <com>end-tags </com> <rhs>| '&amp;' <nt def='NT-Name'>Name</nt> ';'</rhs> <com>entity references </com> <rhs>| '&amp;#' [0-9]+ ';'</rhs> <com>decimal character references </com> <rhs>| '&hcro;' [0-9a-fA-F]+ ';'</rhs> <com>hexadecimal character references </com> <rhs>| '&lt;!&como;' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* '&comc;' <nt def='NT-Char'>Char</nt>*)) '&comc;&gt;'</rhs> <com>comments </com> <rhs>| '&lt;?' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* &pic; <nt def='NT-Char'>Char</nt>*)) '&pic;'</rhs> <com>processing instructions </com> <rhs>| '&lt;![CDATA[' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* ']]&gt;' <nt def='NT-Char'>Char</nt>*)) ']]&gt;'</rhs> <com>CDATA sections</com> <rhs>| '&lt;!DOCTYPE' (<nt def="NT-Char">Char</nt> - ('[' | ']'))+ ('[' <nt def="NT-simpleDTD">simpleDTD</nt>* ']')? '&gt;'</rhs> <com>doc type declaration</com> </prod> <prod id="NT-simpleDTD"><lhs>simpleDTD</lhs> <rhs>'&lt;!&como;' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* '&comc;' <nt def='NT-Char'>Char</nt>*)) '&comc;&gt;'</rhs> <com>comment </com> <rhs>| '&lt;?' (<nt def='NT-Char'>Char</nt>* - (<nt def='NT-Char'>Char</nt>* &pic; <nt def='NT-Char'>Char</nt>*)) '&pic;'</rhs> <com>processing instruction </com> <rhs><nt def="NT-SimpleLit">SimpleLit</nt></rhs> <rhs>(<nt def="NT-Char">Char</nt> - (']' | '&lt;' | '"' | "'"))+ </rhs> <rhs>'&lt;!' (<nt def="NT-Char">Char</nt> - ('-'))+</rhs> <com>declarations other than comment</com> </prod> </prodgroup> </scrap> Most processors will require the more complex grammar given in the body of this specification. </p> </div1> --> <inform-div1 id="sec-xml-wg"> <head>&informative;W3C XML 0ï0ü0­0ó0°0°0ë0ü0×</head> <p>0S0n&TR-or-Rec;0oÿ W3C XML 0ï0ü0­0ó0°0°0ë0ü0×(WG)0Ln–P™0Wÿ Ql•‹0’bŠ0W0_0WG0L0S0n&TR-or-Rec;0’bŠ0Y0‹0h0D0F0S0h0oÿ WG0n0Y0y0f0nYÔTá0LbŠb•yh0’ˆL0c0_0h0D0F0S0h0’_Å0Z0W0‚aTs0W0j0D0XML WG0nsþW(0nYÔTáSÊ0sNåRM0nYÔTá0’k!0ky:0Y0</p> <!-- parens and spaces removed from role elements by bosak 1997.11.07 --> <orglist> <member><name>Jon Bosak, Sun</name><role>Chair</role></member> <member><name>James Clark</name><role>Technical Lead</role></member> <member><name>Tim Bray, Textuality and Netscape</name><role>XML Co-editor</role></member> <member><name>Jean Paoli, Microsoft</name><role>XML Co-editor</role></member> <member><name>C. M. Sperberg-McQueen, U. of Ill.</name><role>XML Co-editor</role></member> <member><name>Dan Connolly, W3C</name></member> <member><name>Steve DeRose, INSO</name></member> <member><name>Dave Hollander, HP</name></member> <member><name>Eliot Kimber, Highland</name></member> <member><name>Eve Maler, ArborText</name></member> <member><name>Tom Magliery, NCSA</name></member> <member><name>Murray Maloney, Muzmo and Grif</name></member> <member><name>gQu00wÿ [ÌXë0¼0í0Ã0¯0¹`ÅX10·0¹0Æ0à(h*)</name></member> <member><name>Joel Nava, Adobe</name></member> <member><name>Peter Sharpe, SoftQuad</name></member> <member><name>John Tigue, DataChannel</name></member> </orglist> </inform-div1> </back> </spec> <!-- Keep this comment at the end of the file Local variables: mode: sgml sgml-omittag:t sgml-shorttag:t End: --> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/spec.dtd0000644006511100651110000007726510504340462025240 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-euc-jp.dtd0000644006511100651110000000560010504340462026747 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-euc-jp.xml0000644006511100651110000000416410504340462027000 0ustar rossross <½µÊó> <ǯ·î½µ> <ǯÅÙ>1997 <·îÅÙ>1 <½µ>1 <»á̾> <»á>»³ÅÄ <̾>ÂÀϺ <¶È̳Êó¹ð¥ê¥¹¥È> <¶È̳Êó¹ð> <¶È̳̾>XML¥¨¥Ç¥£¥¿¡¼¤ÎºîÀ® <¶È̳¥³¡¼¥É>X3355-23 <¹©¿ô´ÉÍý> <¸«ÀѤâ¤ê¹©¿ô>1600 <¼ÂÀÓ¹©¿ô>320 <Åö·î¸«ÀѤâ¤ê¹©¿ô>160 <Åö·î¼ÂÀÓ¹©¿ô>24 <ͽÄê¹àÌܥꥹ¥È> <ͽÄê¹àÌÜ>

XML¥¨¥Ç¥£¥¿¡¼¤Î´ðËÜ»ÅÍͤκîÀ®

<¼Â»Ü»ö¹à¥ê¥¹¥È> <¼Â»Ü»ö¹à>

XML¥¨¥Ç¥£¥¿¡¼¤Î´ðËÜ»ÅÍͤκîÀ®

<¼Â»Ü»ö¹à>

¶¥¹ç¾¼ÒÀ½Éʤε¡Ç½Ä´ºº

<¾åĹ¤Ø¤ÎÍ×ÀÁ»ö¹à¥ê¥¹¥È> <¾åĹ¤Ø¤ÎÍ×ÀÁ»ö¹à>

Æäˤʤ·

<ÌäÂêÅÀÂкö>

XML¤È¤Ï²¿¤«¤ï¤«¤é¤Ê¤¤¡£

<¶È̳Êó¹ð> <¶È̳̾>¸¡º÷¥¨¥ó¥¸¥ó¤Î³«È¯ <¶È̳¥³¡¼¥É>S8821-76 <¹©¿ô´ÉÍý> <¸«ÀѤâ¤ê¹©¿ô>120 <¼ÂÀÓ¹©¿ô>6 <Åö·î¸«ÀѤâ¤ê¹©¿ô>32 <Åö·î¼ÂÀÓ¹©¿ô>2 <ͽÄê¹àÌܥꥹ¥È> <ͽÄê¹àÌÜ>

goo¤Îµ¡Ç½¤òÄ´¤Ù¤Æ¤ß¤ë

<¼Â»Ü»ö¹à¥ê¥¹¥È> <¼Â»Ü»ö¹à>

¹¹¤Ë¡¢¤É¤¦¤¤¤¦¸¡º÷¥¨¥ó¥¸¥ó¤¬¤¢¤ë¤«Ä´ºº¤¹¤ë

<¾åĹ¤Ø¤ÎÍ×ÀÁ»ö¹à¥ê¥¹¥È> <¾åĹ¤Ø¤ÎÍ×ÀÁ»ö¹à>

³«È¯¤ò¤¹¤ë¤Î¤Ï¤á¤ó¤É¤¦¤Ê¤Î¤Ç¡¢Yahoo!¤òÇã¼ý¤·¤Æ²¼¤µ¤¤¡£

<ÌäÂêÅÀÂкö>

¸¡º÷¥¨¥ó¥¸¥ó¤Ç¼Ö¤òÁö¤é¤»¤ë¤³¤È¤¬¤Ç¤­¤Ê¤¤¡£¡ÊÍ×Ä´ºº¡Ë

hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-little-endian.xml0000644006511100651110000000616210504340462030346 0ustar rossrossÿþ<?xml version="1.0"?> <!DOCTYPE 11X SYSTEM "weekly-utf-16.dtd"> <!-- 11Xµ0ó0×0ë0 --> <11X> <t^g1> <t^¦^>1997</t^¦^> <g¦^>1</g¦^> <1>1</1> </t^g1> <l T> <l>q\0u</l> < T>*YÎ</ T> </l T> <miÙR1XJTê0¹0È0> <miÙR1XJT> <miÙR T>XML¨0Ç0£0¿0ü0n0\Ob</miÙR T> <miÙR³0ü0É0>X3355-23</miÙR³0ü0É0> <å]pe¡{t> <‹‰Mz‚0Š0å]pe>1600</‹‰Mz‚0Š0å]pe> <Ÿ[>~å]pe>320</Ÿ[>~å]pe> <S_g‹‰Mz‚0Š0å]pe>160</S_g‹‰Mz‚0Š0å]pe> <S_gŸ[>~å]pe>24</S_gŸ[>~å]pe> </å]pe¡{t> <ˆNš[˜îvê0¹0È0> <ˆNš[˜îv> <P>XML¨0Ç0£0¿0ü0n0úW,gÕNØin0\Ob</P> </ˆNš[˜îv> </ˆNš[˜îvê0¹0È0> <Ÿ[½e‹N˜ê0¹0È0> <Ÿ[½e‹N˜> <P>XML¨0Ç0£0¿0ü0n0úW,gÕNØin0\Ob</P> </Ÿ[½e‹N˜> <Ÿ[½e‹N˜> <P>özTÖN>yýˆÁTn0_jý€¿Šûg</P> </Ÿ[½e‹N˜> </Ÿ[½e‹N˜ê0¹0È0> < Nw•x0n0‰ËŠ‹N˜ê0¹0È0> < Nw•x0n0‰ËŠ‹N˜> <P>yrk0j0W0</P> </ Nw•x0n0‰ËŠ‹N˜> </ Nw•x0n0‰ËŠ‹N˜ê0¹0È0> <OUL˜¹pþ[V{> <P>XMLh0o0UOK00K0‰0j0D00</P> </OUL˜¹pþ[V{> </miÙR1XJT> <miÙR1XJT> <miÙR T>i"}¨0ó0¸0ó0n0‹•zv</miÙR T> <miÙR³0ü0É0>S8821-76</miÙR³0ü0É0> <å]pe¡{t> <‹‰Mz‚0Š0å]pe>120</‹‰Mz‚0Š0å]pe> <Ÿ[>~å]pe>6</Ÿ[>~å]pe> <S_g‹‰Mz‚0Š0å]pe>32</S_g‹‰Mz‚0Š0å]pe> <S_gŸ[>~å]pe>2</S_gŸ[>~å]pe> </å]pe¡{t> <ˆNš[˜îvê0¹0È0> <ˆNš[˜îv> <P><A href="http://www.goo.ne.jp">goo</A>n0_jý€’0¿Šy0f00‹0</P> </ˆNš[˜îv> </ˆNš[˜îvê0¹0È0> <Ÿ[½e‹N˜ê0¹0È0> <Ÿ[½e‹N˜> <P>ôfk00i0F0D0F0i"}¨0ó0¸0ó0L0B0‹0K0¿ŠûgY0‹0</P> </Ÿ[½e‹N˜> </Ÿ[½e‹N˜ê0¹0È0> < Nw•x0n0‰ËŠ‹N˜ê0¹0È0> < Nw•x0n0‰ËŠ‹N˜> <P>‹•zv’0Y0‹0n0o00“0i0F0j0n0g00Yahoo!’0·ŒÎSW0f0 NU0D00</P> </ Nw•x0n0‰ËŠ‹N˜> </ Nw•x0n0‰ËŠ‹N˜ê0¹0È0> <OUL˜¹pþ[V{> <P>i"}¨0ó0¸0ó0g0ÊŽ’0p‰0[0‹0S0h0L0g0M0j0D00ÿ‰¿Šûg ÿ</P> </OUL˜¹pþ[V{> </miÙR1XJT> </miÙR1XJTê0¹0È0> </11X> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-iso-2022-jp.dtd0000644006511100651110000000637110504340462027356 0ustar rossross (B, $B6HL3Js9p%j%9%H(B)> (B ($B;a(B, $BL>(B)> (B (#PCDATA)> (B, $B6HL3%3!<%I(B, $B9)?t4IM}(B, $BM=Dj9`L\%j%9%H(B, $BeD9$X$NMW@A;v9`%j%9%H(B, $BLdBjE@BP:v(B?)> (B (#PCDATA)> eD9$X$NMW@A;v9`%j%9%H(B ($B>eD9$X$NMW@A;v9`(B*)> eD9$X$NMW@A;v9`(B ((P | OL | UL)+)> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-iso-2022-jp.xml0000644006511100651110000000527610504340462027406 0ustar rossross <$B=5Js(B> <$BG/7n=5(B> <$BG/EY(B>1997 <$B7nEY(B>1 <$B=5(B>1 <$B;aL>(B> <$B;a(B>$B;3ED(B <$BL>(B>$BB@O:(B(B> (B> <$B6HL3Js9p%j%9%H(B> <$B6HL3Js9p(B> <$B6HL3L>(B>XML$B%(%G%#%?!<$N:n@.(B(B> <$B6HL3%3!<%I(B>X3355-23 <$B9)?t4IM}(B> <$B8+@Q$b$j9)?t(B>1600 <$B320 <$BEv7n8+@Q$b$j9)?t(B>160 <$BEv7n24 <$BM=Dj9`L\%j%9%H(B> <$BM=Dj9`L\(B>

XML$B%(%G%#%?!<$N4pK\;EMM$N:n@.(B

<$B <$B

XML$B%(%G%#%?!<$N4pK\;EMM$N:n@.(B

<$B

$B6%9gB> <$B>eD9$X$NMW@A;v9`%j%9%H(B> <$B>eD9$X$NMW@A;v9`(B>

$BFC$K$J$7(B

eD9$X$NMW@A;v9`(B> eD9$X$NMW@A;v9`%j%9%H(B> <$BLdBjE@BP:v(B>

XML$B$H$O2?$+$o$+$i$J$$!#(B

<$B6HL3Js9p(B> <$B6HL3L>(B>$B8!:w%(%s%8%s$N3+H/(B(B> <$B6HL3%3!<%I(B>S8821-76 <$B9)?t4IM}(B> <$B8+@Q$b$j9)?t(B>120 <$B6 <$BEv7n8+@Q$b$j9)?t(B>32 <$BEv7n2 <$BM=Dj9`L\%j%9%H(B> <$BM=Dj9`L\(B>

goo$B$N5!G=$rD4$Y$F$_$k(B

<$B <$B

$B99$K!"$I$&$$$&8!:w%(%s%8%s$,$"$k$+D4::$9$k(B

<$B>eD9$X$NMW@A;v9`%j%9%H(B> <$B>eD9$X$NMW@A;v9`(B>

$B3+H/$r$9$k$N$O$a$s$I$&$J$N$G!"(BYahoo!$B$rGc<}$7$F2<$5$$!#(B

eD9$X$NMW@A;v9`(B> eD9$X$NMW@A;v9`%j%9%H(B> <$BLdBjE@BP:v(B>

$B8!:w%(%s%8%s$G hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-shift_jis.xml0000644006511100651110000000417210504340462027576 0ustar rossross <”NŒŽT> <”N“x>1997 <ŒŽ“x>1 1 <Ž–¼> <Ž>ŽR“c <–¼>‘¾˜Y <‹Æ–±•ñƒŠƒXƒg> <‹Æ–±•ñ> <‹Æ–±–¼>XMLƒGƒfƒBƒ^[‚Ìì¬ <‹Æ–±ƒR[ƒh>X3355-23 <Œ©Ï‚à‚èH”>1600 <ŽÀÑH”>320 <“–ŒŽŒ©Ï‚à‚èH”>160 <“–ŒŽŽÀÑH”>24 <—\’耖ڃŠƒXƒg> <—\’耖Ú>

XMLƒGƒfƒBƒ^[‚ÌŠî–{Žd—l‚Ìì¬

<ŽÀŽ{Ž–€ƒŠƒXƒg> <ŽÀŽ{Ž–€>

XMLƒGƒfƒBƒ^[‚ÌŠî–{Žd—l‚Ìì¬

<ŽÀŽ{Ž–€>

‹£‡‘¼ŽÐ»•i‚Ì‹@”\’²¸

<ã’·‚Ö‚Ì—v¿Ž–€ƒŠƒXƒg> <ã’·‚Ö‚Ì—v¿Ž–€>

“Á‚É‚È‚µ

<–â‘è“_‘Îô>

XML‚Ƃ͉½‚©‚í‚©‚ç‚È‚¢B

<‹Æ–±•ñ> <‹Æ–±–¼>ŒŸõƒGƒ“ƒWƒ“‚ÌŠJ”­ <‹Æ–±ƒR[ƒh>S8821-76 <Œ©Ï‚à‚èH”>120 <ŽÀÑH”>6 <“–ŒŽŒ©Ï‚à‚èH”>32 <“–ŒŽŽÀÑH”>2 <—\’耖ڃŠƒXƒg> <—\’耖Ú>

goo‚Ì‹@”\‚𒲂ׂĂ݂é

<ŽÀŽ{Ž–€ƒŠƒXƒg> <ŽÀŽ{Ž–€>

X‚ÉA‚Ç‚¤‚¢‚¤ŒŸõƒGƒ“ƒWƒ“‚ª‚ ‚é‚©’²¸‚·‚é

<ã’·‚Ö‚Ì—v¿Ž–€ƒŠƒXƒg> <ã’·‚Ö‚Ì—v¿Ž–€>

ŠJ”­‚ð‚·‚é‚Ì‚Í‚ß‚ñ‚Ç‚¤‚È‚Ì‚ÅAYahoo!‚𔃎û‚µ‚ĉº‚³‚¢B

<–â‘è“_‘Îô>

ŒŸõƒGƒ“ƒWƒ“‚ŎԂ𑖂点‚邱‚Æ‚ª‚Å‚«‚È‚¢Bi—v’²¸j

hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-utf-16.dtd0000644006511100651110000001214610504340462026611 0ustar rossrossþÿ<!-- ************************************************************************* * * * DPSD PDG1X1u(DTD weekly.dtd * * * * Copyright 1997 Fuji Xerox Information Systems Co.,Ltd. * * * ************************************************************************* --> <!-- Y fô\ekt Version 1.0 1997/10/29 O\b gQu0w --> <!ELEMENT 1X1 (^tg1, lT , imRÙX1TJ0ê0¹0È)> <!ELEMENT ^tg1 (^t^¦, g^¦, 1)> <!ELEMENT ^t^¦ (#PCDATA)> <!-- ^t^¦0’ˆh0Yep[W --> <!ELEMENT g^¦ (#PCDATA)> <!-- g^¦0’ˆh0Yep[W --> <!ELEMENT 1 (#PCDATA)> <!-- OU1vî0K0’ˆh0Yep[W --> <!ELEMENT lT (l, T )> <!ELEMENT l (#PCDATA)> <!ELEMENT T (#PCDATA)> <!ELEMENT imRÙX1TJ0ê0¹0È (imRÙX1TJ+)> <!ELEMENT imRÙX1TJ (imRÙT , imRÙ0³0ü0É, ]åep{¡t, Nˆ[š˜vî0ê0¹0È, [Ÿe½N‹˜0ê0¹0È, N •w0x0n‰ŠËN‹˜0ê0¹0È, UO˜Lp¹[þ{V?)> <!ELEMENT imRÙT (#PCDATA)> <!-- imRÙ0³0ü0ÉN‰§0’SÂqg --> <!ELEMENT imRÙ0³0ü0É (#PCDATA)> <!-- imRÙ0³0ü0ÉN‰§0’SÂqg --> <!ELEMENT ]åep{¡t (‰‹zM0‚0Š]åep, [Ÿ~>]åep, _Sg‰‹zM0‚0Š]åep, _Sg[Ÿ~>]åep)> <!ELEMENT ‰‹zM0‚0Š]åep (#PCDATA)> <!-- SXOM0ofB•“ --> <!ELEMENT [Ÿ~>]åep (#PCDATA)> <!-- SXOM0ofB•“ --> <!ELEMENT _Sg‰‹zM0‚0Š]åep (#PCDATA)> <!-- SXOM0ofB•“ --> <!ELEMENT _Sg[Ÿ~>]åep (#PCDATA)> <!-- SXOM0ofB•“ --> <!ELEMENT Nˆ[š˜vî0ê0¹0È (Nˆ[š˜vî*)> <!ELEMENT Nˆ[š˜vî ((P | OL | UL)+)> <!ELEMENT [Ÿe½N‹˜0ê0¹0È ([Ÿe½N‹˜*)> <!ELEMENT [Ÿe½N‹˜ ((P | OL | UL)+)> <!ELEMENT UO˜Lp¹[þ{V ((P | OL | UL)+)> <!ELEMENT N •w0x0n‰ŠËN‹˜0ê0¹0È (N •w0x0n‰ŠËN‹˜*)> <!ELEMENT N •w0x0n‰ŠËN‹˜ ((P | OL | UL)+)> <!-- XML0g0B0‰0K0X0[š©0U0Œ0_[ŸOS --> <!ENTITY lt "&#38;#60;"> <!ENTITY gt "&#62;"> <!ENTITY amp "&#38;#38;"> <!ENTITY apos "&#39;"> <!ENTITY quot "&#34;"> <!-- HTML0nlNu(v„0j0¿0° --> <!ELEMENT P (#PCDATA | EM | STRONG | A)*> <!ELEMENT OL (LI)*> <!ELEMENT UL (LI)*> <!ELEMENT LI (#PCDATA | EM | STRONG | A)*> <!ELEMENT EM (#PCDATA | EM | STRONG | A)*> <!ELEMENT STRONG (#PCDATA | EM | STRONG | A)*> <!ELEMENT A (#PCDATA | EM | STRONG)*> <!ATTLIST A name CDATA #IMPLIED href CDATA #IMPLIED > hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-utf-16.xml0000644006511100651110000000616210504340462026637 0ustar rossrossþÿ<?xml version="1.0"?> <!DOCTYPE 1X1 SYSTEM "weekly-utf-16.dtd"> <!-- 1X10µ0ó0×0ë --> <1X1> <^tg1> <^t^¦>1997</^t^¦> 1</g^¦> <1>1</1> </^tg1> \qu0</l> Y*Î</T > </lT > XML0¨0Ç0£0¿0ü0nO\b</imRÙT > X3355-23</imRÙ0³0ü0É> <]åep{¡t> <‰‹zM0‚0Š]åep>1600</‰‹zM0‚0Š]åep> <[Ÿ~>]åep>320</[Ÿ~>]åep> <_Sg‰‹zM0‚0Š]åep>160</_Sg‰‹zM0‚0Š]åep> <_Sg[Ÿ~>]åep>24</_Sg[Ÿ~>]åep> </]åep{¡t> <P>XML0¨0Ç0£0¿0ü0nWúg,NÕiØ0nO\b</P> </Nˆ[š˜vî> </Nˆ[š˜vî0ê0¹0È> <[Ÿe½N‹˜0ê0¹0È> <[Ÿe½N‹˜> <P>XML0¨0Ç0£0¿0ü0nWúg,NÕiØ0nO\b</P> </[Ÿe½N‹˜> <[Ÿe½N‹˜> <P>zöTNÖy>ˆýTÁ0nj_€ýŠ¿gû</P> </[Ÿe½N‹˜> </[Ÿe½N‹˜0ê0¹0È> <P>ry0k0j0W</P> </N •w0x0n‰ŠËN‹˜> </N •w0x0n‰ŠËN‹˜0ê0¹0È> <P>XML0h0oOU0K00K0‰0j0D0</P> </UO˜Lp¹[þ{V> </imRÙX1TJ> i}"0¨0ó0¸0ó0n•‹vz</imRÙT > S8821-76</imRÙ0³0ü0É> <]åep{¡t> <‰‹zM0‚0Š]åep>120</‰‹zM0‚0Š]åep> <[Ÿ~>]åep>6</[Ÿ~>]åep> <_Sg‰‹zM0‚0Š]åep>32</_Sg‰‹zM0‚0Š]åep> <_Sg[Ÿ~>]åep>2</_Sg[Ÿ~>]åep> </]åep{¡t> <P><A href="http://www.goo.ne.jp">goo</A>0nj_€ý0’Š¿0y0f00‹</P> </Nˆ[š˜vî> </Nˆ[š˜vî0ê0¹0È> <[Ÿe½N‹˜0ê0¹0È> <[Ÿe½N‹˜> <P>fô0k00i0F0D0Fi}"0¨0ó0¸0ó0L0B0‹0KŠ¿gû0Y0‹</P> </[Ÿe½N‹˜> </[Ÿe½N‹˜0ê0¹0È> <P>•‹vz0’0Y0‹0n0o00“0i0F0j0n0g0Yahoo!0’Œ·SÎ0W0fN 0U0D0</P> </N •w0x0n‰ŠËN‹˜> </N •w0x0n‰ŠËN‹˜0ê0¹0È> <P>i}"0¨0ó0¸0ó0gŽÊ0’p0‰0[0‹0S0h0L0g0M0j0D0ÿ‰Š¿gûÿ </P> </UO˜Lp¹[þ{V> </imRÙX1TJ> </imRÙX1TJ0ê0¹0È> </1X1> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-utf-8.dtd0000644006511100651110000000623010504340462026527 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/japanese/weekly-utf-8.xml0000644006511100651110000000521310504340462026554 0ustar rossross <週報> <年月週> <年度>1997 <月度>1 <週>1 <æ°å> <æ°>山田 <å>太郎 <業務報告リスト> <業務報告> <業務å>XMLエディターã®ä½œæˆ <業務コード>X3355-23 <工数管ç†> <見ç©ã‚‚り工数>1600 <実績工数>320 <当月見ç©ã‚‚り工数>160 <当月実績工数>24 <予定項目リスト> <予定項目>

XMLエディターã®åŸºæœ¬ä»•æ§˜ã®ä½œæˆ

<実施事項リスト> <実施事項>

XMLエディターã®åŸºæœ¬ä»•æ§˜ã®ä½œæˆ

<実施事項>

競åˆä»–社製å“ã®æ©Ÿèƒ½èª¿æŸ»

<上長ã¸ã®è¦è«‹äº‹é …リスト> <上長ã¸ã®è¦è«‹äº‹é …>

特ã«ãªã—

<å•é¡Œç‚¹å¯¾ç­–>

XMLã¨ã¯ä½•ã‹ã‚ã‹ã‚‰ãªã„。

<業務報告> <業務å>検索エンジンã®é–‹ç™º <業務コード>S8821-76 <工数管ç†> <見ç©ã‚‚り工数>120 <実績工数>6 <当月見ç©ã‚‚り工数>32 <当月実績工数>2 <予定項目リスト> <予定項目>

gooã®æ©Ÿèƒ½ã‚’調ã¹ã¦ã¿ã‚‹

<実施事項リスト> <実施事項>

æ›´ã«ã€ã©ã†ã„ã†æ¤œç´¢ã‚¨ãƒ³ã‚¸ãƒ³ãŒã‚ã‚‹ã‹èª¿æŸ»ã™ã‚‹

<上長ã¸ã®è¦è«‹äº‹é …リスト> <上長ã¸ã®è¦è«‹äº‹é …>

開発をã™ã‚‹ã®ã¯ã‚ã‚“ã©ã†ãªã®ã§ã€Yahoo!ã‚’è²·åŽã—ã¦ä¸‹ã•ã„。

<å•é¡Œç‚¹å¯¾ç­–>

検索エンジンã§è»Šã‚’走らã›ã‚‹ã“ã¨ãŒã§ããªã„。（è¦èª¿æŸ»ï¼‰

hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/0000755006511100651110000000000010504340463023121 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/e2.xml0000644006511100651110000000014210504340462024145 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p01fail1.xml0000644006511100651110000000042110504340462025154 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/oasis.xml0000644006511100651110000014456310504340462024775 0ustar rossross various Misc items where they can occur various satisfactions of the Names production in a NAMES attribute various valid Nmtoken 's in an attribute list declaration. various satisfaction of an NMTOKENS attribute value. valid EntityValue's. Except for entity references, markup is not recognized. valid public IDs. XML decl and doctypedecl just doctypedecl S between decls is not required Empty-element tag must be used for element which are declared EMPTY. Valid doctypedecl with Parameter entity reference. The declaration of a parameter entity must precede any reference to it. Valid doctypedecl with ExternalID as an External Entity declaration. Valid doctypedecl with ExternalID as an External Entity. A parameter entity reference is also used. Valid types of markupdecl. Valid doctypedecl with ExternalID as an External Entity. The external entity has an element declaration. Valid doctypedecl with ExternalID as an Enternal Entity. The external entity begins with a Text Declaration. external subset can be empty Valid doctypedecl with EXternalID as Enternal Entity. The external entity contains a parameter entity reference and condtional sections. Valid use of character data, comments, processing instructions and CDATA sections within the start and end tag. valid element declarations Valid use of contentspec, element content models, and mixed content within an element type declaration. Valid use of contentspec, element content models, choices, sequences and content particles within an element type declaration. The optional character following a name or list governs the number of times the element or content particle may appear. Valid use of contentspec, element content models, choices, sequences and content particles within an element type declaration. The optional character following a name or list governs the number of times the element or content particle may appear. Valid use of contentspec, element content models, choices, and content particles within an element type declaration. The optional character following a name or list governs the number of times the element or content particle may appear. Whitespace is also valid between choices. Valid use of contentspec, element content models, sequences and content particles within an element type declaration. The optional character following a name or list governs the number of times the element or content particle may appear. Whitespace is also valid between sequences. valid Mixed contentspec's. valid AttlistDecls: No AttDef's are required, and the terminating S is optional, multiple ATTLISTS per element are OK, and multiple declarations of the same attribute are OK. a valid AttDef the three kinds of attribute types StringType = "CDATA" the 7 tokenized attribute types enumerated types are NMTOKEN or NOTATION lists NOTATION enumeration has on or more items NMTOKEN enumerations haveon or more items the four types of default values valid conditional sections are INCLUDE and IGNORE valid INCLUDE sections -- options S before and after keyword, sections can nest valid IGNORE sections IGNOREd sections ignore everything except section delimiters Valid entity references. Also ensures that a charref to '&' isn't interpreted as an entity reference open delimiter Valid PEReferences. An EntityDecl is either a GEDecl or a PEDecl Valid GEDecls Valid PEDecls EntityDef is either Entity value or an external id, with an optional NDataDecl valid NDataDecls no prolog Misc items after the document all valid S characters names with all valid ASCII characters, and one from each other class in NameChar various valid Name constructions Requires at least one name. at least one Nmtoken is required. an invalid Nmtoken character. valid attribute values valid CharData valid comments Valid form of Processing Instruction. Shows that whitespace character data is valid before end of processing instruction. Valid form of Processing Instruction. Shows that whitespace character data is valid before end of processing instruction. Valid form of Processing Instruction. Shows that whitespace character data is valid before end of processing instruction. valid CDSect's. Note that a CDStart in a CDSect is not recognized as such prolog can be empty XML declaration only XML decl and Misc Test shows a valid XML declaration along with version info. Test shows a valid XML declaration along with encoding declaration. Test shows a valid XML declaration along with Standalone Document Declaration. Test shows a valid XML declaration, encoding declarationand Standalone Document Declaration. Test shows a prolog that has the VersionInfo delimited by double quotes. Test shows a prolog that has the VersionInfo delimited by single quotes. Test shows whitespace is allowed in prolog before version info. Test shows whitespace is allowed in prolog on both sides of equal sign. Test shows whitespace is NOT necessary before or after equal sign of versioninfo. Test shows whitespace can be used on both sides of equal sign of versioninfo. The valid version number. We cannot test others because a 1.0 processor is allowed to fail them. Comments are valid as the Misc part of the prolog. Processing Instructions are valid as the Misc part of the prolog. Whitespace is valid as the Misc part of the prolog. A combination of comments, whitespaces and processing instructions are valid as the Misc part of the prolog. Double quotes can be used as delimeters for the value of a Standalone Document Declaration. Single quotes can be used as delimeters for the value of a Standalone Document Declaration. Empty element tag may be used for any element which has no content. Character data is valid element content. Elements content can be empty. Whitespace is valid within a Start-tag. Attributes are valid within a Start-tag. Whitespace and Multiple Attributes are valid within a Start-tag. Attributes are valid within a Start-tag. Whitespace is valid within a Start-tags Attribute. Test shows proper syntax for an End-tag. Whitespace is valid after name in End-tag. Valid display of an Empty Element Tag. Empty Element Tags can contain an Attribute. Whitespace is valid in an Empty Element Tag following the end of the attribute value. Whitespace is valid after the name in an Empty Element Tag. Whitespace and Multiple Attributes are valid in an Empty Element Tag. valid character references PEDef is either an entity value or an external id valid external identifiers Validity Constraint: No duplicate tokens S cannot occur before the prolog comments cannot occur before the prolog only one document element document element must be complete. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Use of illegal character within XML document. Name contains invalid character. Name contains invalid character. Name contains invalid character. a Name cannot start with a digit a Name cannot start with a '.' a Name cannot start with a "-" a Name cannot start with a CombiningChar a Name cannot start with an Extender EntityValue excludes '%' EntityValue excludes '&' incomplete character reference quote types must match quote types must match attribute values exclude '<' attribute values exclude '&' quote types must match quote types must match cannot contain delimiting quotes '"' excluded '\' excluded entity references excluded '>' excluded '<' excluded built-in entity refs excluded The public ID has a tab character, which is disallowed '<' excluded '&' excluded "]]>" excluded comments can't end in '-' one comment per comment (contrasted with SGML) can't include 2 or more adjacent '-'s "xml" is an invalid PITarget a PITarget must be present S after PITarget is required no space before "CDATA" no space after "CDATA" CDSect's can't nest prolog must start with XML decl prolog must start with XML decl "xml" must be lower-case VersionInfo must be supplied VersionInfo must come first SDDecl must come last no SGML-type PIs quote types must match quote types must match Comment is illegal in VersionInfo. Illegal character in VersionNum. Illegal character in VersionNum. References aren't allowed in Misc, even if they would resolve to valid Misc. only declarations in DTD. A processor must not pass unknown declaration types. An XML declaration is not the same as a TextDecl external subset excludes doctypedecl quote types must match quote types must match initial S is required quotes are required yes or no must be lower case start-tag requires end-tag end-tag requires start-tag XML documents contain one or more elements XML declarations must be correctly terminated XML declarations must be correctly terminated S is required between attributes tags start with names, not nmtokens tags start with names, not nmtokens no space before name quotes are required (contrast with SGML) attribute name is required (contrast with SGML) Eq required no space before name cannot end with "/>" no NET (contrast with SGML) no non-comment declarations no conditional sections no conditional sections Illegal space before Empty element tag. Illegal space after Empty element tag. Illegal comment in Empty element tag. Whitespace required between attributes. Duplicate attribute name is illegal. ELEMENT must be upper case. S before contentspec is required. only one content spec no comments in declarations (contrast with SGML) no parens on declared content no inclusions (contrast with SGML) no exclusions (contrast with SGML) no space before occurrence single group can't be both declared and modeled Invalid operator '|' must match previous operator ',' Illegal character '-' in Element-content model Optional character must follow a name or list Illegal space before optional character Illegal space before optional character Illegal space before optional character connectors must match connectors must match occurrence on #PCDATA group must be * occurrence on #PCDATA group must be * #PCDATA must come first occurrence on #PCDATA group must be * only '|' connectors Only '|' connectors and occurrence on #PCDATA group must be * no nested groups A name is required A name is required S is required before default S is required before type type is required default is required name is requried don't pass unknown attribute types must be upper case no IDS type no NUMBER type no NAME type no ENTITYS type - types must be upper case types must be upper case no keyword for NMTOKEN enumeration at least one value required separator must be '|' notations are NAMEs, not NMTOKENs -- note: Leaving the invalid notation undeclared would cause a validating parser to fail without checking the name syntax, so the notation is declared with an invalid name. A parser that reports error positions should report an error at the AttlistDecl on line 6, before reaching the notation declaration. NOTATION must be upper case S after keyword is required parentheses are require values are unquoted values are unquoted at least one required separator must be "," values are unquoted keywords must be upper case S is required after #FIXED only #FIXED has both keyword and value #FIXED required value only one default type no other types, including TEMP, which is valid in SGML INCLUDE must be upper case no spaces in terminating delimiter IGNORE must be upper case delimiters must be balanced section delimiters must balance section delimiters must balance terminating ';' is required no S after '&#' no hex digits in numeric reference only hex digits in hex references no references to non-characters no references to non-characters terminating ';' is required no S after '&' no S before ';' terminating ';' is required no S after '%' no S before ';' This is neither S is required before EntityDef Entity name is a Name, not an NMToken no S after "<!" S is required after "<!ENTITY" S is required after "<!ENTITY" S is required after '%' S is required after name Entity name is a name, not an NMToken No typed replacement text Only one replacement value No NDataDecl on replacement text Value is required No NDataDecl without value no NDataDecls on parameter entities value is required only one value S required after "PUBLIC" S required after "SYSTEM" S required between literals "SYSTEM" implies only one literal only one keyword "PUBLIC" requires two literals (contrast with SGML) S is required before "NDATA" "NDATA" is upper-case notation name is required notation names are Names system literals may not contain URI fragments hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p01fail2.xml0000644006511100651110000000044110504340462025157 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p01fail3.xml0000644006511100651110000000034310504340462025161 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p01fail4.xml0000644006511100651110000000000510504340462025155 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p01pass1.xml0000644006511100651110000000004110504340462025205 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p01pass2.xml0000644006511100651110000000112010504340462025205 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p01pass3.xml0000644006511100651110000000037010504340462025214 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail1.xml0000644006511100651110000000003210504340462025153 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail10.xml0000644006511100651110000000003210504340462025233 0ustar rossrossÿþ<doc> </doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail11.xml0000644006511100651110000000003210504340462025234 0ustar rossrossÿþ<doc> </doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail12.xml0000644006511100651110000000003210504340462025235 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail13.xml0000644006511100651110000000003210504340462025236 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail14.xml0000644006511100651110000000003210504340462025237 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail15.xml0000644006511100651110000000003210504340462025240 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail16.xml0000644006511100651110000000003210504340462025241 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail17.xml0000644006511100651110000000003210504340462025242 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail18.xml0000644006511100651110000000003210504340462025243 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail19.xml0000644006511100651110000000003210504340462025244 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail2.xml0000644006511100651110000000003210504340462025154 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail20.xml0000644006511100651110000000003210504340462025234 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail21.xml0000644006511100651110000000003210504340462025235 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail22.xml0000644006511100651110000000003210504340462025236 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail23.xml0000644006511100651110000000003210504340462025237 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail24.xml0000644006511100651110000000003210504340462025240 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail25.xml0000644006511100651110000000003210504340462025241 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail26.xml0000644006511100651110000000003210504340462025242 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail27.xml0000644006511100651110000000003210504340462025243 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail28.xml0000644006511100651110000000003210504340462025244 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail29.xml0000644006511100651110000000003210504340462025245 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail3.xml0000644006511100651110000000003210504340462025155 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail30.xml0000644006511100651110000000003210504340462025235 0ustar rossrossÿþ<doc>þÿ</doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail31.xml0000644006511100651110000000003210504340462025236 0ustar rossrossÿþ<doc>ÿÿ</doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail4.xml0000644006511100651110000000003210504340462025156 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail5.xml0000644006511100651110000000003210504340462025157 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail6.xml0000644006511100651110000000003210504340462025160 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail7.xml0000644006511100651110000000003210504340462025161 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail8.xml0000644006511100651110000000003210504340462025162 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p02fail9.xml0000644006511100651110000000003210504340462025163 0ustar rossrossÿþ<doc></doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail1.xml0000644006511100651110000000000710504340462025156 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail10.xml0000644006511100651110000000000710504340462025236 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail11.xml0000644006511100651110000000000710504340462025237 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail12.xml0000644006511100651110000000000710504340462025240 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail13.xml0000644006511100651110000000000710504340462025241 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail14.xml0000644006511100651110000000000710504340462025242 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail15.xml0000644006511100651110000000000710504340462025243 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail16.xml0000644006511100651110000000000710504340462025244 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail17.xml0000644006511100651110000000000710504340462025245 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail18.xml0000644006511100651110000000000710504340462025246 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail19.xml0000644006511100651110000000000710504340462025247 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail2.xml0000644006511100651110000000000710504340462025157 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail20.xml0000644006511100651110000000000710504340462025237 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail21.xml0000644006511100651110000000000710504340462025240 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail22.xml0000644006511100651110000000000710504340462025241 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail23.xml0000644006511100651110000000000710504340462025242 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail24.xml0000644006511100651110000000000710504340462025243 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail25.xml0000644006511100651110000000000710504340462025244 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail26.xml0000644006511100651110000000000710504340462025245 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail27.xml0000644006511100651110000000000710504340462025246 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail28.xml0000644006511100651110000000000710504340462025247 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail29.xml0000644006511100651110000000000710504340462025250 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail3.xml0000644006511100651110000000000710504340462025160 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail4.xml0000644006511100651110000000000710504340462025161 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail5.xml0000644006511100651110000000000710504340462025162 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail7.xml0000644006511100651110000000000710504340462025164 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail8.xml0000644006511100651110000000000710504340462025165 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03fail9.xml0000644006511100651110000000000710504340462025166 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p03pass1.xml0000644006511100651110000000001210504340462025205 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p04fail1.xml0000644006511100651110000000000710504340462025157 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p04fail2.xml0000644006511100651110000000000710504340462025160 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p04fail3.xml0000644006511100651110000000000710504340462025161 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p04pass1.xml0000644006511100651110000000015110504340462025212 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p05fail1.xml0000644006511100651110000000000510504340462025156 0ustar rossross<0A/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p05fail2.xml0000644006511100651110000000000510504340462025157 0ustar rossross<.A/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p05fail3.xml0000644006511100651110000000000510504340462025160 0ustar rossross<-A/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p05fail4.xml0000644006511100651110000000000610504340462025162 0ustar rossross<Ì€A/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p05fail5.xml0000644006511100651110000000000610504340462025163 0ustar rossross<·A/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p05pass1.xml0000644006511100651110000000010010504340462025205 0ustar rossross <::._-0/> <_:._-0/> <_/> <:/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p06fail1.xml0000644006511100651110000000052010504340462025161 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p06pass1.xml0000644006511100651110000000043110504340462025215 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p07pass1.xml0000644006511100651110000000014710504340462025222 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p08fail1.xml0000644006511100651110000000027310504340462025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p08fail2.xml0000644006511100651110000000030410504340462025164 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p08pass1.xml0000644006511100651110000000025510504340462025223 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p09fail1.dtd0000644006511100651110000000006010504340462025136 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p09fail1.xml0000644006511100651110000000005410504340462025166 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p09fail2.dtd0000644006511100651110000000006010504340462025137 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p09fail2.xml0000644006511100651110000000005410504340462025167 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p09fail3.xml0000644006511100651110000000011710504340462025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p09fail4.xml0000644006511100651110000000011010504340462025162 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p09fail5.xml0000644006511100651110000000011010504340462025163 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p09pass1.dtd0000644006511100651110000000025410504340462025176 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p09pass1.xml0000644006511100651110000000005410504340462025221 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p10fail1.xml0000644006511100651110000000002210504340462025151 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p10fail2.xml0000644006511100651110000000002010504340462025150 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p10fail3.xml0000644006511100651110000000002010504340462025151 0ustar rossross asdf ?>%"/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p11fail1.xml0000644006511100651110000000023410504340462025157 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p11fail2.xml0000644006511100651110000000023410504340462025160 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p11pass1.xml0000644006511100651110000000042710504340462025216 0ustar rossross ?>/\''"> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p12fail1.xml0000644006511100651110000000023410504340462025160 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p12fail2.xml0000644006511100651110000000023510504340463025163 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p12fail3.xml0000644006511100651110000000025710504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p12fail4.xml0000644006511100651110000000023410504340463025164 0ustar rossross "> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p12fail5.xml0000644006511100651110000000023410504340463025165 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p12fail6.xml0000644006511100651110000000024010504340463025163 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p12fail7.xml0000644006511100651110000000023410504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p12pass1.xml0000644006511100651110000000050310504340463025213 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p14fail1.xml0000644006511100651110000000001710504340463025162 0ustar rossross< hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p14fail2.xml0000644006511100651110000000001710504340463025163 0ustar rossross& hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p14fail3.xml0000644006511100651110000000002210504340463025160 0ustar rossrossa]]>b hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p14pass1.xml0000644006511100651110000000005710504340463025221 0ustar rossrossa%b%</doc></doc>]]<& hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p15fail1.xml0000644006511100651110000000002110504340463025156 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p15fail2.xml0000644006511100651110000000002610504340463025164 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p15fail3.xml0000644006511100651110000000002410504340463025163 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p15pass1.xml0000644006511100651110000000011110504340463025211 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p16fail1.xml0000644006511100651110000000003510504340463025164 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p16fail2.xml0000644006511100651110000000001410504340463025162 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p16fail3.xml0000644006511100651110000000003110504340463025162 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p16pass1.xml0000644006511100651110000000016610504340463025224 0ustar rossross &a%b&#c?> ?> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p16pass2.xml0000644006511100651110000000002610504340463025220 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p16pass3.xml0000644006511100651110000000002610504340463025221 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p18fail1.xml0000644006511100651110000000003110504340463025162 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p18fail2.xml0000644006511100651110000000003110504340463025163 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p18fail3.xml0000644006511100651110000000012310504340463025166 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p18pass1.xml0000644006511100651110000000013610504340463025223 0ustar rossross] ]> ]]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p22fail1.xml0000644006511100651110000000004110504340463025156 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p22fail2.xml0000644006511100651110000000011210504340463025156 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p22pass1.xml0000644006511100651110000000001010504340463025205 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p22pass2.xml0000644006511100651110000000003710504340463025217 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p22pass3.xml0000644006511100651110000000006610504340463025222 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p22pass4.xml0000644006511100651110000000017510504340463025224 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p22pass5.xml0000644006511100651110000000014610504340463025223 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p22pass6.xml0000644006511100651110000000010710504340463025221 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p23fail1.xml0000644006511100651110000000003710504340463025164 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p23fail2.xml0000644006511100651110000000004210504340463025161 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p23fail3.xml0000644006511100651110000000006010504340463025162 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p23fail4.xml0000644006511100651110000000010110504340463025157 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p23fail5.xml0000644006511100651110000000003610504340463025167 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p23pass1.xml0000644006511100651110000000003710504340463025217 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p23pass2.xml0000644006511100651110000000006010504340463025214 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p23pass3.xml0000644006511100651110000000006010504340463025215 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p23pass4.xml0000644006511100651110000000010110504340463025212 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p24fail1.xml0000644006511100651110000000004110504340463025160 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p24fail2.xml0000644006511100651110000000004110504340463025161 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p24pass1.xml0000644006511100651110000000003710504340463025220 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p24pass2.xml0000644006511100651110000000003710504340463025221 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p24pass3.xml0000644006511100651110000000005210504340463025217 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p24pass4.xml0000644006511100651110000000004110504340463025216 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p25fail1.xml0000644006511100651110000000006310504340463025165 0ustar rossross ="1.0"?> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p25pass1.xml0000644006511100651110000000003710504340463025221 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p25pass2.xml0000644006511100651110000000005710504340463025224 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p26fail1.xml0000644006511100651110000000004010504340463025161 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p26fail2.xml0000644006511100651110000000004010504340463025162 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p26pass1.xml0000644006511100651110000000036010504340463025221 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p27fail1.xml0000644006511100651110000000004610504340463025170 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p27pass1.xml0000644006511100651110000000024310504340463025222 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p27pass2.xml0000644006511100651110000000004710504340463025225 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p27pass3.xml0000644006511100651110000000004710504340463025226 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p27pass4.xml0000644006511100651110000000014310504340463025224 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p28fail1.xml0000644006511100651110000000006310504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p28pass1.xml0000644006511100651110000000007210504340463025223 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p28pass2.xml0000644006511100651110000000007210504340463025224 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p28pass3.xml0000644006511100651110000000012210504340463025221 0ustar rossross"> %eldecl; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p28pass4.dtd0000644006511100651110000000002610504340463025200 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p28pass4.xml0000644006511100651110000000005610504340463025230 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p28pass5.dtd0000644006511100651110000000001610504340463025200 0ustar rossross%rootdecl; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p28pass5.xml0000644006511100651110000000021210504340463025223 0ustar rossross "> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p29fail1.xml0000644006511100651110000000014710504340463025174 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p29pass1.xml0000644006511100651110000000040010504340463025217 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p30fail1.dtd0000644006511100651110000000011710504340463025134 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p30fail1.xml0000644006511100651110000000005610504340463025163 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p30pass1.dtd0000644006511100651110000000003210504340463025163 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p30pass1.xml0000644006511100651110000000005610504340463025216 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p30pass2.dtd0000644006511100651110000000006010504340463025165 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p30pass2.xml0000644006511100651110000000005610504340463025217 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p31fail1.dtd0000644006511100651110000000005410504340463025135 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p31fail1.xml0000644006511100651110000000005610504340463025164 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p31pass1.dtd0000644006511100651110000000000010504340463025157 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p31pass1.xml0000644006511100651110000000010510504340463025212 0ustar rossross]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p31pass2.dtd0000644006511100651110000000022310504340463025167 0ustar rossross"> ]]> %rootel; ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p31pass2.xml0000644006511100651110000000005610504340463025220 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p32fail1.xml0000644006511100651110000000006010504340463025160 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p32fail2.xml0000644006511100651110000000006010504340463025161 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p32fail3.xml0000644006511100651110000000005710504340463025170 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p32fail4.xml0000644006511100651110000000005610504340463025170 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p32fail5.xml0000644006511100651110000000006010504340463025164 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p32pass1.xml0000644006511100651110000000006010504340463025213 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p32pass2.xml0000644006511100651110000000005710504340463025222 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p39fail1.xml0000644006511100651110000000001410504340463025166 0ustar rossrosscontenthugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p39fail2.xml0000644006511100651110000000002610504340463025172 0ustar rossrosscontenthugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p39fail3.xml0000644006511100651110000000000010504340463025163 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p39fail4.xml0000644006511100651110000000002610504340463025174 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p39fail5.xml0000644006511100651110000000013410504340463025175 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p39pass1.xml0000644006511100651110000000000610504340463025222 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p39pass2.xml0000644006511100651110000000002210504340463025221 0ustar rossrosscontenthugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p40fail1.xml0000644006511100651110000000004010504340463025155 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p40fail2.xml0000644006511100651110000000002510504340463025161 0ustar rossross<3notname>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p40fail3.xml0000644006511100651110000000002410504340463025161 0ustar rossross<3notname>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p40fail4.xml0000644006511100651110000000001410504340463025161 0ustar rossross< doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p40pass1.xml0000644006511100651110000000001310504340463025210 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p40pass2.xml0000644006511100651110000000002010504340463025207 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p40pass3.xml0000644006511100651110000000002510504340463025215 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p40pass4.xml0000644006511100651110000000006010504340463025215 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p41fail1.xml0000644006511100651110000000011010504340463025154 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p41fail2.xml0000644006511100651110000000010410504340463025160 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p41fail3.xml0000644006511100651110000000002510504340463025163 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p41pass1.xml0000644006511100651110000000002510504340463025214 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p41pass2.xml0000644006511100651110000000003410504340463025215 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p42fail1.xml0000644006511100651110000000001410504340463025160 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p42fail2.xml0000644006511100651110000000001410504340463025161 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p42fail3.xml0000644006511100651110000000001110504340463025157 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p42pass2.xml0000644006511100651110000000001710504340463025217 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p43fail1.xml0000644006511100651110000000021010504340463025157 0ustar rossross CharData"> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p43fail2.xml0000644006511100651110000000024210504340463025165 0ustar rossross CharData"> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p43fail3.xml0000644006511100651110000000024310504340463025167 0ustar rossross CharData"> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p43pass1.xml0000644006511100651110000000054610504340463025226 0ustar rossross CharData"> ]> CharData CharData &ent;" CharData ]]> CharData &ent;" CharData ]]> &ent;" CharData hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44fail1.xml0000644006511100651110000000000710504340463025164 0ustar rossross< doc/>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44fail2.xml0000644006511100651110000000000710504340463025165 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44fail3.xml0000644006511100651110000000002610504340463025167 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44fail4.xml0000644006511100651110000000003310504340463025166 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44fail5.xml0000644006511100651110000000003210504340463025166 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44pass1.xml0000644006511100651110000000000610504340463025216 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44pass2.xml0000644006511100651110000000002010504340463025213 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44pass3.xml0000644006511100651110000000002610504340463025222 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44pass4.xml0000644006511100651110000000001410504340463025220 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p44pass5.xml0000644006511100651110000000005110504340463025222 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p45fail1.xml0000644006511100651110000000006210504340463025166 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p45fail2.xml0000644006511100651110000000006510504340463025172 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p45fail3.xml0000644006511100651110000000007210504340463025171 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p45fail4.xml0000644006511100651110000000010610504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p45pass1.xml0000644006511100651110000000013510504340463025222 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p46fail1.xml0000644006511100651110000000010710504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p46fail2.xml0000644006511100651110000000011710504340463025171 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p46fail3.xml0000644006511100651110000000011710504340463025172 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p46fail4.xml0000644006511100651110000000010610504340463025171 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p46fail5.xml0000644006511100651110000000011510504340463025172 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p46fail6.xml0000644006511100651110000000011210504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p46pass1.xml0000644006511100651110000000016110504340463025222 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p47fail1.xml0000644006511100651110000000011210504340463025164 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p47fail2.xml0000644006511100651110000000010510504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p47fail3.xml0000644006511100651110000000010510504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p47fail4.xml0000644006511100651110000000010610504340463025172 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p47pass1.xml0000644006511100651110000000026410504340463025227 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p48fail1.xml0000644006511100651110000000010610504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p48fail2.xml0000644006511100651110000000011310504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p48pass1.xml0000644006511100651110000000036710504340463025234 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p49fail1.xml0000644006511100651110000000010610504340463025171 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p49pass1.xml0000644006511100651110000000030410504340463025224 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p50fail1.xml0000644006511100651110000000010610504340463025161 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p50pass1.xml0000644006511100651110000000030410504340463025214 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p51fail1.xml0000644006511100651110000000006710504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p51fail2.xml0000644006511100651110000000006710504340463025171 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p51fail3.xml0000644006511100651110000000012310504340463025163 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p51fail4.xml0000644006511100651110000000012310504340463025164 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p51fail5.xml0000644006511100651110000000012610504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p51fail6.xml0000644006511100651110000000012610504340463025171 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p51fail7.xml0000644006511100651110000000012710504340463025173 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p51pass1.xml0000644006511100651110000000023510504340463025220 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p52fail1.xml0000644006511100651110000000010010504340463025155 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p52fail2.xml0000644006511100651110000000007610504340463025172 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p52pass1.xml0000644006511100651110000000057710504340463025232 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p53fail1.xml0000644006511100651110000000012610504340463025166 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p53fail2.xml0000644006511100651110000000012610504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p53fail3.xml0000644006511100651110000000012110504340463025163 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p53fail4.xml0000644006511100651110000000011610504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p53fail5.xml0000644006511100651110000000012310504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p53pass1.xml0000644006511100651110000000012710504340463025222 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p54fail1.xml0000644006511100651110000000012710504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p54pass1.xml0000644006511100651110000000033110504340463025220 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p55fail1.xml0000644006511100651110000000012710504340463025171 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p55pass1.xml0000644006511100651110000000012710504340463025224 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p56fail1.xml0000644006511100651110000000012510504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p56fail2.xml0000644006511100651110000000013010504340463025165 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p56fail3.xml0000644006511100651110000000012610504340463025173 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p56fail4.xml0000644006511100651110000000013110504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p56fail5.xml0000644006511100651110000000012410504340463025173 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p56pass1.xml0000644006511100651110000000067110504340463025231 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p57fail1.xml0000644006511100651110000000013710504340463025174 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p57pass1.xml0000644006511100651110000000033010504340463025222 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p58fail1.xml0000644006511100651110000000022110504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p58fail2.xml0000644006511100651110000000022410504340463025173 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p58fail3.xml0000644006511100651110000000033310504340463025175 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p58fail4.xml0000644006511100651110000000022410504340463025175 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p58fail5.xml0000644006511100651110000000022310504340463025175 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p58fail6.xml0000644006511100651110000000016610504340463025204 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p58fail7.xml0000644006511100651110000000017010504340463025200 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p58fail8.xml0000644006511100651110000000017210504340463025203 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p58pass1.xml0000644006511100651110000000034310504340463025227 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p59fail1.xml0000644006511100651110000000012410504340463025172 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p59fail2.xml0000644006511100651110000000012710504340463025176 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p59fail3.xml0000644006511100651110000000012710504340463025177 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p59pass1.xml0000644006511100651110000000024110504340463025225 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p60fail1.xml0000644006511100651110000000012710504340463025165 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p60fail2.xml0000644006511100651110000000013410504340463025164 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p60fail3.xml0000644006511100651110000000015410504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p60fail4.xml0000644006511100651110000000012510504340463025166 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p60fail5.xml0000644006511100651110000000015510504340463025172 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p60pass1.xml0000644006511100651110000000045610504340463025225 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p61fail1.dtd0000644006511100651110000000011010504340463025131 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p61fail1.xml0000644006511100651110000000005410504340463025165 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p61pass1.dtd0000644006511100651110000000021410504340463025171 0ustar rossross ]]>]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p61pass1.xml0000644006511100651110000000005410504340463025220 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p62fail1.dtd0000644006511100651110000000005010504340463025135 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p62fail1.xml0000644006511100651110000000005410504340463025166 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p62fail2.dtd0000644006511100651110000000005110504340463025137 0ustar rossross ] ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p62fail2.xml0000644006511100651110000000005410504340463025167 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p62pass1.dtd0000644006511100651110000000021010504340463025166 0ustar rossross ]]>]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p62pass1.xml0000644006511100651110000000005410504340463025221 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p63fail1.dtd0000644006511100651110000000004510504340463025142 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p63fail1.xml0000644006511100651110000000005410504340463025167 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p63fail2.dtd0000644006511100651110000000005010504340463025137 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p63fail2.xml0000644006511100651110000000005410504340463025170 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p63pass1.dtd0000644006511100651110000000021110504340463025170 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p63pass1.xml0000644006511100651110000000005410504340463025222 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p64fail1.dtd0000644006511100651110000000007110504340463025142 0ustar rossross ]]>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p64fail1.xml0000644006511100651110000000005610504340463025172 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p64fail2.dtd0000644006511100651110000000007610504340463025150 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p64fail2.xml0000644006511100651110000000005610504340463025173 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p64pass1.dtd0000644006511100651110000000047010504340463025200 0ustar rossross '. These must be balanced, but it is no section keyword is required: ] ]> ]] > ]]> ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p64pass1.xml0000644006511100651110000000005610504340463025225 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p66fail1.xml0000644006511100651110000000001710504340463025171 0ustar rossrossAhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p66fail2.xml0000644006511100651110000000002110504340463025165 0ustar rossross&# 65;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p66fail3.xml0000644006511100651110000000001710504340463025173 0ustar rossross&#A;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p66fail4.xml0000644006511100651110000000002110504340463025167 0ustar rossrossG;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p66fail5.xml0000644006511100651110000000001710504340463025175 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p66fail6.xml0000644006511100651110000000003310504340463025174 0ustar rossross��hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p66pass1.xml0000644006511100651110000000012110504340463025220 0ustar rossross A AOO 􏋬 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p68fail1.xml0000644006511100651110000000014710504340463025177 0ustar rossross ]> &ent hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p68fail2.xml0000644006511100651110000000015110504340463025173 0ustar rossross ]> & ent; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p68fail3.xml0000644006511100651110000000015110504340463025174 0ustar rossross ]> &ent ; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p68pass1.xml0000644006511100651110000000030010504340463025221 0ustar rossross ]> &ent;aaa&ent; &en hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p69fail1.xml0000644006511100651110000000013610504340463025176 0ustar rossross "> %pe ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p69fail2.xml0000644006511100651110000000013110504340463025172 0ustar rossross "> % pe; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p69fail3.xml0000644006511100651110000000013110504340463025173 0ustar rossross "> %pe ; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p69pass1.xml0000644006511100651110000000014310504340463025227 0ustar rossross "> %pe;%pe; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p70fail1.xml0000644006511100651110000000013410504340463025164 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p70pass1.xml0000644006511100651110000000020510504340463025216 0ustar rossross "> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p71fail1.xml0000644006511100651110000000013010504340463025161 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p71fail2.xml0000644006511100651110000000013210504340463025164 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p71fail3.xml0000644006511100651110000000013210504340463025165 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p71fail4.xml0000644006511100651110000000013010504340463025164 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p71pass1.xml0000644006511100651110000000020210504340463025214 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p72fail1.xml0000644006511100651110000000014110504340463025164 0ustar rossross "> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p72fail2.xml0000644006511100651110000000014110504340463025165 0ustar rossross "> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p72fail3.xml0000644006511100651110000000014110504340463025166 0ustar rossross "> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p72fail4.xml0000644006511100651110000000014310504340463025171 0ustar rossross "> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p72pass1.xml0000644006511100651110000000023210504340463025220 0ustar rossross "> " > ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p73fail1.xml0000644006511100651110000000020410504340463025165 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p73fail2.xml0000644006511100651110000000021210504340463025165 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p73fail3.xml0000644006511100651110000000021310504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p73fail4.xml0000644006511100651110000000015410504340463025174 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p73fail5.xml0000644006511100651110000000017010504340463025173 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p73pass1.xml0000644006511100651110000000031310504340463025221 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p74fail1.xml0000644006511100651110000000016110504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p74fail2.xml0000644006511100651110000000012310504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p74fail3.xml0000644006511100651110000000011610504340463025172 0ustar rossross" SYSTEM "nop.ent"> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p74pass1.xml0000644006511100651110000000015210504340463025223 0ustar rossross"> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p75fail1.xml0000644006511100651110000000011010504340463025163 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p75fail2.xml0000644006511100651110000000007510504340463025176 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p75fail3.xml0000644006511100651110000000011010504340463025165 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p75fail4.xml0000644006511100651110000000011110504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p75fail5.xml0000644006511100651110000000012010504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p75fail6.xml0000644006511100651110000000007710504340463025204 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p75pass1.xml0000644006511100651110000000030410504340463025223 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p76fail1.xml0000644006511100651110000000021010504340463025165 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p76fail2.xml0000644006511100651110000000021110504340463025167 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p76fail3.xml0000644006511100651110000000020210504340463025170 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p76fail4.xml0000644006511100651110000000035110504340463025176 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/oasis/p76pass1.xml0000644006511100651110000000030010504340463025220 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/0000755006511100651110000000000010504340464022611 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/0000755006511100651110000000000010504340464024237 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa01.xml0000644006511100651110000000032510504340464026323 0ustar rossross The whitespace before and after this element keeps this from being standalone. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr01.xml0000644006511100651110000000035410504340463026075 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr02.xml0000644006511100651110000000061610504340463026077 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr03.xml0000644006511100651110000000100510504340463026071 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr04.xml0000644006511100651110000000052310504340463026076 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr05.xml0000644006511100651110000000026210504340463026077 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr06.xml0000644006511100651110000000027410504340463026103 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr07.xml0000644006511100651110000000036010504340463026100 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr08.xml0000644006511100651110000000036610504340463026107 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr09.xml0000644006511100651110000000056310504340463026107 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr10.xml0000644006511100651110000000060610504340463026075 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr11.xml0000644006511100651110000000063110504340463026074 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr12.xml0000644006511100651110000000065310504340463026101 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr13.xml0000644006511100651110000000026110504340463026075 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr14.xml0000644006511100651110000000027410504340463026102 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr15.xml0000644006511100651110000000051410504340463026100 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/attr16.xml0000644006511100651110000000027710504340463026107 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/dtd01.xml0000644006511100651110000000021610504340463025673 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/dtd02.xml0000644006511100651110000000017210504340463025675 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/dtd03.xml0000644006511100651110000000046610504340463025704 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/dtd06.xml0000644006511100651110000000012410504340463025676 0ustar rossross %undefined; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/el01.xml0000644006511100651110000000010610504340463025516 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/el02.xml0000644006511100651110000000007710504340463025526 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/el03.xml0000644006511100651110000000021610504340463025522 0ustar rossross ]> this is ok this isn't hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/el04.xml0000644006511100651110000000015610504340464025527 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/el05.xml0000644006511100651110000000017710504340464025533 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/el06.xml0000644006511100651110000000020510504340464025524 0ustar rossross ]> & hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/empty.xml0000644006511100651110000000052010504340464026114 0ustar rossross ]> ∅ &space; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/id01.xml0000644006511100651110000000020210504340464025510 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/id02.xml0000644006511100651110000000026610504340464025523 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/id03.xml0000644006511100651110000000025410504340464025521 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/id04.xml0000644006511100651110000000022610504340464025521 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/id05.xml0000644006511100651110000000026610504340464025526 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/id06.xml0000644006511100651110000000030410504340464025520 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/id07.xml0000644006511100651110000000034410504340464025525 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/id08.xml0000644006511100651110000000032310504340464025523 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/id09.xml0000644006511100651110000000040610504340464025526 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa02.xml0000644006511100651110000000133610504340464026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa04.xml0000644006511100651110000000025410504340464026327 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa05.xml0000644006511100651110000000025510504340464026331 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa06.xml0000644006511100651110000000031010504340464026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa07.xml0000644006511100651110000000032410504340464026330 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa08.xml0000644006511100651110000000035610504340464026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa09.xml0000644006511100651110000000027310504340464026335 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa10.xml0000644006511100651110000000032410504340464026322 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa11.xml0000644006511100651110000000035210504340464026324 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa12.xml0000644006511100651110000000031010504340464026317 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa13.xml0000644006511100651110000000035010504340464026324 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/not-sa14.xml0000644006511100651110000000044310504340464026330 0ustar rossross The whitespace before and after this element keeps this from being standalone. (CDATA is just another way to represent text...) hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional01.xml0000644006511100651110000000011710504340464026746 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional02.xml0000644006511100651110000000013010504340464026742 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional03.xml0000644006511100651110000000012210504340464026744 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional04.xml0000644006511100651110000000013610504340464026752 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional05.xml0000644006511100651110000000014610504340464026754 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional06.xml0000644006511100651110000000014710504340464026756 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional07.xml0000644006511100651110000000014710504340464026757 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional08.xml0000644006511100651110000000014710504340464026760 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional09.xml0000644006511100651110000000014710504340464026761 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional10.xml0000644006511100651110000000016310504340464026747 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional11.xml0000644006511100651110000000016410504340464026751 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional12.xml0000644006511100651110000000016410504340464026752 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional13.xml0000644006511100651110000000016410504340464026753 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional14.xml0000644006511100651110000000016410504340464026754 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional20.xml0000644006511100651110000000014510504340464026750 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional21.xml0000644006511100651110000000014610504340464026752 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional22.xml0000644006511100651110000000014610504340464026753 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional23.xml0000644006511100651110000000014610504340464026754 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional24.xml0000644006511100651110000000014610504340464026755 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/optional25.xml0000644006511100651110000000016610504340464026760 0ustar rossross No text allowed! hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/required00.xml0000644006511100651110000000022510504340464026740 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/required01.xml0000644006511100651110000000017210504340464026742 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/required02.xml0000644006511100651110000000016410504340464026744 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/root.xml0000644006511100651110000000026210504340464025744 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/utf16b.xml0000644006511100651110000000014210504340464026065 0ustar rossrossþÿ<?xml version='1.0' encoding='UTF-16'?> <root/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/invalid/utf16l.xml0000644006511100651110000000014210504340464026077 0ustar rossrossÿþ<?xml version='1.0' encoding='UTF-16'?> <root/> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/0000755006511100651110000000000010504340464024023 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist01.xml0000644006511100651110000000022410504340464026370 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist02.xml0000644006511100651110000000023210504340464026370 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist03.xml0000644006511100651110000000022510504340464026373 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist04.xml0000644006511100651110000000022410504340464026373 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist05.xml0000644006511100651110000000023410504340464026375 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist06.xml0000644006511100651110000000022610504340464026377 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist07.xml0000644006511100651110000000023210504340464026375 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist08.xml0000644006511100651110000000023310504340464026377 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist09.xml0000644006511100651110000000022110504340464026375 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist10.xml0000644006511100651110000000031610504340464026372 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/attlist11.xml0000644006511100651110000000030710504340464026373 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/cond.dtd0000644006511100651110000000014310504340464025441 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/cond01.xml0000644006511100651110000000011510504340464025626 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/cond02.xml0000644006511100651110000000011110504340464025623 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/content01.xml0000644006511100651110000000015310504340464026357 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/content02.xml0000644006511100651110000000015410504340464026361 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/content03.xml0000644006511100651110000000015210504340464026360 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/decl01.ent0000644006511100651110000000015210504340464025601 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/decl01.xml0000644006511100651110000000022610504340464025615 0ustar rossross %ent01; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/dtd00.xml0000644006511100651110000000024010504340464025454 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/dtd01.xml0000644006511100651110000000026310504340464025462 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/dtd02.xml0000644006511100651110000000021310504340464025456 0ustar rossross "> % foo; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/dtd03.xml0000644006511100651110000000021710504340464025463 0ustar rossross "> %foo ; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/dtd04.xml0000644006511100651110000000023610504340464025465 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/dtd05.xml0000644006511100651110000000020010504340464025455 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/dtd07.dtd0000644006511100651110000000033610504340464025444 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/dtd07.xml0000644006511100651110000000011110504340464025460 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/element00.xml0000644006511100651110000000004310504340464026333 0ustar rossross Incomplete end tag. Incomplete end tag. ]> <% @ LANGUAGE="VBSCRIPT" %> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/element03.xml0000644006511100651110000000014510504340464026341 0ustar rossross ]> <% document.println ("hello, world"); %> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/element04.xml0000644006511100651110000000012010504340464026333 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/encoding01.xml0000644006511100651110000000006010504340464026470 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/encoding02.xml0000644006511100651110000000005610504340464026476 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/encoding03.xml0000644006511100651110000000007010504340464026473 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/encoding04.xml0000644006511100651110000000006010504340464026473 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/encoding05.xml0000644006511100651110000000010010504340464026467 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/encoding06.xml0000644006511100651110000000016210504340464026500 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/encoding07.xml0000644006511100651110000000034010504340464026477 0ustar rossross ]> ∅ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/not-sa03.xml0000644006511100651110000000030210504340464026104 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/pi.xml0000644006511100651110000000014310504340464025153 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/pubid01.xml0000644006511100651110000000023610504340464026012 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/pubid02.xml0000644006511100651110000000022110504340464026005 0ustar rossross " "ignored"> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/pubid03.xml0000644006511100651110000000022110504340464026006 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/pubid04.xml0000644006511100651110000000022310504340464026011 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/pubid05.xml0000644006511100651110000000017710504340464026022 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml01.xml0000644006511100651110000000013710504340464025651 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml02.xml0000644006511100651110000000017110504340464025650 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml03.xml0000644006511100651110000000013510504340464025651 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml04.xml0000644006511100651110000000027510504340464025657 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml05.xml0000644006511100651110000000032110504340464025650 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml06.xml0000644006511100651110000000023210504340464025652 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml07.xml0000644006511100651110000000016010504340464025653 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml08.xml0000644006511100651110000000016110504340464025655 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml09.xml0000644006511100651110000000016010504340464025655 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml10.xml0000644006511100651110000000021010504340464025641 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml11.xml0000644006511100651110000000014310504340464025647 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml12.xml0000644006511100651110000000014610504340464025653 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/sgml13.xml0000644006511100651110000000030510504340464025651 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/not-wf/uri01.xml0000644006511100651110000000016310504340464025505 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/0000755006511100651110000000000010504340464023710 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/0000755006511100651110000000000010504340464024517 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/element.xml0000644006511100651110000000130110504340464026665 0ustar rossross allowed <allowed> also <% illegal otherwise %> moreover allowed & stuff also moreover moreover too hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/dtd00.xml0000644006511100651110000000001510504340464026150 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/dtd01.xml0000644006511100651110000000001510504340464026151 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/not-sa01.xml0000644006511100651110000000046310504340464026606 0ustar rossross ]> The whitespace before and after this element keeps this from being standalone. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/ext01.xml0000644006511100651110000000036410504340464026205 0ustar rossross "dumber than a bag full of hammers" "dumber than a bag full of hammers" hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/ext02.xml0000644006511100651110000000007410504340464026204 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/not-sa02.xml0000644006511100651110000000067410504340464026613 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/not-sa03.xml0000644006511100651110000000070410504340464026606 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/not-sa04.xml0000644006511100651110000000073110504340464026607 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/notation01.xml0000644006511100651110000000023210504340464027232 0ustar rossross ]> testhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/optional.xml0000644006511100651110000000353410504340464027073 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/pe00.xml0000644006511100651110000000013110504340464026000 0ustar rossrossLa Peste: Albert Camus, © 1947 Éditions Gallimard. All rights reservedhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/pe02.xml0000644006511100651110000000006410504340464026007 0ustar rossrossThis sample shows a error-prone method.hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/pe03.xml0000644006511100651110000000017010504340464026006 0ustar rossross

An ampersand (&) may be escaped numerically (&#38) or with a general entity (&amp;).

hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/required00.xml0000644006511100651110000000002710504340464027220 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/sa01.xml0000644006511100651110000000023410504340464026004 0ustar rossross The whitespace around this element would be invalid as standalone were the DTD external. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/sa02.xml0000644006511100651110000000070610504340464026011 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/sa03.xml0000644006511100651110000000070410504340464026010 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/sa04.xml0000644006511100651110000000073110504340464026011 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/sa05.xml0000644006511100651110000000040110504340464026004 0ustar rossross ]> No whitespace before or after this standalone element. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/sgml01.xml0000644006511100651110000000006510504340464026345 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/v-lang01.xml0000644006511100651110000000003310504340464026562 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/v-lang02.xml0000644006511100651110000000003610504340464026566 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/v-lang03.xml0000644006511100651110000000005010504340464026563 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/v-lang04.xml0000644006511100651110000000005510504340464026571 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/v-lang05.xml0000644006511100651110000000003310504340464026566 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/out/v-lang06.xml0000644006511100651110000000003710504340464026573 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/dtdtest.dtd0000644006511100651110000000243110504340464026060 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/dtd00.xml0000644006511100651110000000015610504340464025347 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/dtd01.xml0000644006511100651110000000017710504340464025353 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/element.xml0000644006511100651110000000130210504340464026057 0ustar rossross ]> allowed ]]> also ]]> moreover allowed & stuff also moreover moreover too hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/ext01.ent0000644006511100651110000000017510504340464025364 0ustar rossross "dumber than a bag full of hammers" hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/ext01.xml0000644006511100651110000000031610504340464025373 0ustar rossross ]> &root; &root; &null; &null; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/ext02.xml0000644006511100651110000000030010504340464025365 0ustar rossross ]> &utf16b; &utf16l; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/not-sa01.xml0000644006511100651110000000030710504340464025774 0ustar rossross The whitespace before and after this element keeps this from being standalone. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/not-sa02.xml0000644006511100651110000000123510504340464025776 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/not-sa03.xml0000644006511100651110000000117310504340464026000 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/not-sa04.xml0000644006511100651110000000131410504340464025776 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/notation01.dtd0000644006511100651110000000030310504340464026375 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/notation01.xml0000644006511100651110000000021710504340464026426 0ustar rossross ]> test hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/null.ent0000644006511100651110000000000010504340464025360 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/optional.xml0000644006511100651110000000314410504340464026261 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/pe00.dtd0000644006511100651110000000033710504340464025154 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/pe00.xml0000644006511100651110000000006610504340464025200 0ustar rossross &book; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/pe01.dtd0000644006511100651110000000022410504340464025150 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/pe01.ent0000644006511100651110000000013510504340464025164 0ustar rossrossThis is not a legal parameter entity, because it does not match the "markupdecl" production. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/pe01.xml0000644006511100651110000000005210504340464025174 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/pe02.xml0000644006511100651110000000037410504340464025204 0ustar rossross ' > %xx; ]> This sample shows a &tricky; method. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/pe03.xml0000644006511100651110000000041310504340464025177 0ustar rossross An ampersand (&#38;) may be escaped numerically (&#38;#38) or with a general entity (&amp;).

" > ]> &example; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/required00.xml0000644006511100651110000000015410504340464026412 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/sa.dtd0000644006511100651110000000204610504340464025012 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/sa01.xml0000644006511100651110000000040210504340464025172 0ustar rossross ]> The whitespace around this element would be invalid as standalone were the DTD external. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/sa02.xml0000644006511100651110000000243610504340464025204 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/sa03.xml0000644006511100651110000000137510504340464025206 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/sa04.xml0000644006511100651110000000203210504340464025176 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/sa05.xml0000644006511100651110000000024210504340464025200 0ustar rossross No whitespace before or after this standalone element. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/sgml01.xml0000644006511100651110000000052010504340464025532 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/v-lang01.xml0000644006511100651110000000015010504340464025753 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/v-lang02.xml0000644006511100651110000000015410504340464025760 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/v-lang03.xml0000644006511100651110000000016610504340464025764 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/v-lang04.xml0000644006511100651110000000017310504340464025763 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/v-lang05.xml0000644006511100651110000000015110504340464025760 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/valid/v-lang06.xml0000644006511100651110000000015510504340464025765 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/cxml.html0000644006511100651110000001306310504340463024444 0ustar rossross XML Canonical Forms

XML Canonical Forms

DRAFT 1

As with many sorts of structured information, there are many categories of information that may be deemed "important" for some task. Canonical forms are standard ways to represent such classes of information. For testing XML, and potentially for other purposes, three XML Canonical Forms have been defined as of this writing:

  • First XML Canonical Form, defined by James Clark, is also called Canonical XML.
  • Second XML Canonical Form, defined by Sun, supports testing a larger subset of the XML 1.0 processor requirements by exposing notation declarations.
  • Third XML Canonical Form, defined by Sun, extends the second form to reflect information which validating XML 1.0 processors are required to report.

For a document already in a given canonical form, recanonicalizing to that same form will change nothing. Canonicalizing second or third forms to the first canonical form discards all declarations. Canonicalizing second or third forms to the other form has no effect.

The author is pleased to acknowledge help from James Clark in defining the additional canonical forms.

First XML Canonical Form

This description has been extracted from the version at http://www.jclark.com/xml/canonxml.html.

Every well-formed XML document has a unique structurally equivalent canonical XML document. Two structurally equivalent XML documents have a byte-for-byte identical canonical XML document. Canonicalizing an XML document requires only information that an XML processor is required to make available to an application.

A canonical XML document conforms to the following grammar: 

CanonXML    ::= Pi* element Pi*
element     ::= Stag (Datachar | Pi | element)* Etag
Stag        ::= '<'  Name Atts '>'
Etag        ::= '</' Name '>'
Pi          ::= '<?' Name ' ' (((Char - S) Char*)? - (Char* '?>' Char*)) '?>'
Atts        ::= (' ' Name '=' '"' Datachar* '"')*
Datachar    ::= '&amp;' | '&lt;' | '&gt;' | '&quot;'
                 | '&#9;'| '&#10;'| '&#13;'
                 | (Char - ('&' | '<' | '>' | '"' | #x9 | #xA | #xD))
Name        ::= (see XML spec)
Char        ::= (see XML spec)
S           ::= (see XML spec)

Attributes are in lexicographical order (in Unicode bit order).

A canonical XML document is encoded in UTF-8.

Ignorable white space is considered significant and is treated equivalently to data.

Second XML Canonical Form

Modified to ensure that literals are surrounded by single quotes.

This canonical form is identical to the first form, with one significant addition. All XML processors are required to report the name and external identifiers of notations that are declared and referred to in an XML document (section 4.7); those reports are reflected in declarations in this form, presented in lexicographic order.

Note that all public identifiers must be normalized before being presented to applications (section 4.2.2).

System identifiers are normalized on output to be relative to the input document, if that is possible, with the shortest such relative URI. All other URIs must be absolute. Any hash mark and fragment ID, if erroneously present on input, are removed. Any non-ASCII characters in the URI must be escaped as specified in the XML specification (section 4.2.2). 

CanonXML2    ::= DTD2? CanonXML
DTD2         ::= '<!DOCTYPE ' name ' [' #xA Notations? ']>' #xA
Notations    ::= ( '<!NOTATION ' Name '
			(('PUBLIC ' PubidLiteral ' ' SystemLiteral)
			|('PUBLIC ' PubidLiteral)
			|('SYSTEM ' SystemLiteral))
			'>' #xA )*
PubidLiteral ::= "'" PubidChar* "'"
SystemLiteral ::= "'" [^']* "'"

The requirement of this canonical form differs slightly from that of the XML specification itself in that all declared notations must be listed, not just those which were referred to. Should that change? SAX supports it easily.

Third XML Canonical Form

This canonical form is identical to the second form, with two significant exceptions reflecting requirements placed on validating XML processors:

  • They are required to report "white space appearing in element content" (section 2.10). Ignorable whitespace is not represented in this canonical form.
  • They must report the external identifiers and notation name for unparsed entities appearing as attribute values (section 4.4.6). Such entities are declared in this canonical form, in lexicographic order.

This builds on the grammar productions included above. 

CanonXML3    ::= DTD3? CanonXML
DTD3         ::= '<!DOCTYPE ' name ' [' #xA Notations? Unparsed? ']>' #xA
Unparsed    ::= ( '<!ENTITY ' Name '
			(('PUBLIC ' PubidLiteral ' ' SystemLiteral)
			|('SYSTEM ' SystemLiteral))
			'NDATA ' Name
			'>' #xA )*

The requirement of this canonical form differs slightly from that of the XML specification itself in that all declared unparsed entities must be listed, not just those which were referred to. Should that change? SAX supports it easily.

xml-feedback@java.sun.com
hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/sun-invalid.xml0000644006511100651110000003631310504340464025572 0ustar rossross Tests the No Duplicate Types VC Tests the "Notation Declared" VC by using an undeclared notation name. Tests the "Element Valid" VC (clause 2) by omitting a required element. Tests the Element Valid VC (clause 4) by including an undeclared child element. Tests the Element Valid VC (clause 1) by including elements in an EMPTY content model. Tests the Element Valid VC (clause 3) by including a child element not permitted by a mixed content model. Tests the Unique Element Type Declaration VC. Tests the No Duplicate Types VC. Tests the Element Valid VC (clause 1), using one of the predefined internal entities inside an EMPTY content model. Tests the ID (is a Name) VC Tests the ID (appears once) VC Tests the One ID per Element Type VC Tests the ID Attribute Default VC Tests the ID Attribute Default VC Tests the IDREF (is a Name) VC Tests the IDREFS (is a Names) VC Tests the IDREF (matches an ID) VC Tests the IDREF (IDREFS matches an ID) VC Tests the Standalone Document Declaration VC, ensuring that optional whitespace causes a validity error. Tests the Standalone Document Declaration VC, ensuring that attributes needing normalization cause a validity error. Tests the Standalone Document Declaration VC, ensuring that attributes needing defaulting cause a validity error. Tests the Standalone Document Declaration VC, ensuring that a token attribute that needs normalization causes a validity error. Tests the Standalone Document Declaration VC, ensuring that a NOTATION attribute that needs normalization causes a validity error. Tests the Standalone Document Declaration VC, ensuring that an NMTOKEN attribute needing normalization causes a validity error. Tests the Standalone Document Declaration VC, ensuring that an NMTOKENS attribute needing normalization causes a validity error. Tests the Standalone Document Declaration VC, ensuring that an ID attribute needing normalization causes a validity error. Tests the Standalone Document Declaration VC, ensuring that an IDREF attribute needing normalization causes a validity error. Tests the Standalone Document Declaration VC, ensuring that an IDREFS attribute needing normalization causes a validity error. Tests the Standalone Document Declaration VC, ensuring that an ENTITY attribute needing normalization causes a validity error. Tests the Standalone Document Declaration VC, ensuring that an ENTITIES attribute needing normalization causes a validity error. CDATA sections containing only whitespace do not match the nonterminal S, and cannot appear in these positions. Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one is required. Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing two children where one is required. Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where two are required. Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where two are required. Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (one construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (a second construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (a third construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (a fourth construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (a fifth construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a basic construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a second construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a third construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a fourth construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a fifth construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (a sixth construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (a seventh construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (an eigth construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (a ninth construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (a tenth construction of that model). Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing text content where one or more elements are required. Tests the Required Attribute VC. Tests the Attribute Value Type (declared) VC for the xml:space attribute Tests the Attribute Value Type (declared) VC for the xml:lang attribute Tests the Root Element Type VC Tests the "Entity Name" VC for the ENTITY attribute type. Tests the "Entity Name" VC for the ENTITIES attribute type. Tests the "Notation Attributes" VC for the NOTATION attribute type, first clause: value must be one of the ones that's declared. Tests the "Notation Attributes" VC for the NOTATION attribute type, second clause: the names in the declaration must all be declared. Tests the "Name Token" VC for the NMTOKEN attribute type. Tests the "Name Token" VC for the NMTOKENS attribute type. Tests the "Enumeration" VC by providing a value which wasn't one of the choices. Tests the "Fixed Attribute Default" VC by providing the wrong value. Tests the "Attribute Default Legal" VC by providing an illegal IDREF value. Tests the "Attribute Default Legal" VC by providing an illegal IDREFS value. Tests the "Attribute Default Legal" VC by providing an illegal ENTITY value. Tests the "Attribute Default Legal" VC by providing an illegal ENTITIES value. Tests the "Attribute Default Legal" VC by providing an illegal NMTOKEN value. Tests the "Attribute Default Legal" VC by providing an illegal NMTOKENS value. Tests the "Attribute Default Legal" VC by providing an illegal NOTATIONS value. Tests the "Attribute Default Legal" VC by providing an illegal enumeration value. Tests reading an invalid "big endian" UTF-16 document Tests reading an invalid "little endian" UTF-16 document CDATA section containing only white space does not match the nonterminal S, and cannot appear in these positions. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/sun-error.xml0000644006511100651110000000042410504340464025267 0ustar rossross SYSTEM ids may not have URI fragments hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/sun-not-wf.xml0000644006511100651110000001757610504340464025370 0ustar rossross Tests the Entity Declared WFC, ensuring that a reference to externally defined entity causes a well-formedness error. SGML's NUTOKEN is not allowed. SGML's NUTOKENS attribute type is not allowed. Comma doesn't separate enumerations, unlike in SGML. SGML's NUMBER attribute type is not allowed. SGML's NUMBERS attribute type is not allowed. SGML's NAME attribute type is not allowed. SGML's NAMES attribute type is not allowed. SGML's #CURRENT is not allowed. SGML's #CONREF is not allowed. Whitespace required between attributes Whitespace required between attributes Only INCLUDE and IGNORE are conditional section keywords Must have keyword in conditional sections No whitespace before "?" in content model No whitespace before "*" in content model No whitespace before "+" in content model External entities may not have standalone decls. Comma mandatory in content model Can't mix comma and vertical bar in content models PE name immediately after "%" PE name immediately followed by ";" PUBLIC literal must be quoted SYSTEM identifier must be quoted Text declarations (which optionally begin any external entity) are required to have "encoding=...". EOF in middle of incomplete ETAG EOF in middle of incomplete ETAG Illegal markup (<%@ ... %>) Illegal markup (<% ... %>) Illegal markup (<!ELEMENT ... >) Illegal character " " in encoding name Illegal character "/" in encoding name Illegal character reference in encoding name Illegal character ":" in encoding name Illegal character "@" in encoding name Illegal character "+" in encoding name Text declarations (which optionally begin any external entity) are required to have "encoding=...". No space between PI target name and data Illegal entity ref in public ID Illegal characters in public ID Illegal characters in public ID Illegal characters in public ID SGML-ism: public ID without system ID SGML-ism: omitted end tag for EMPTY content XML declaration must be at the very beginning of a document; it"s not a processing instruction Comments may not contain "--" ATTLIST declarations apply to only one element, unlike SGML ELEMENT declarations apply to only one element, unlike SGML ATTLIST declarations are never global, unlike in SGML SGML Tag minimization specifications are not allowed SGML Tag minimization specifications are not allowed SGML Content model exception specifications are not allowed SGML Content model exception specifications are not allowed CDATA is not a valid content model spec RCDATA is not a valid content model spec SGML Unordered content models not allowed hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/sun/sun-valid.xml0000644006511100651110000001400010504340464025230 0ustar rossross Parameter entities references are NOT RECOGNIZED in default attribute values. Tests parsing of alternative forms of text-only mixed content declaration. Comments don't get parameter entity expansion Tests clauses 1, 3, and 4 of the Element Valid validity constraint. Tests use of external parsed entities with and without content. Tests use of external parsed entities with different encodings than the base document. A non-standalone document is valid if declared as such. A non-standalone document is valid if declared as such. A non-standalone document is valid if declared as such. A non-standalone document is valid if declared as such. NOTATION declarations don't need SYSTEM IDs; and externally declared notations may be used to declare unparsed entities in the internal DTD subset. The notation must be reported to the application. Tests declarations of "children" content models, and the validity constraints associated with them. Tests the #REQUIRED attribute declaration syntax, and the associated validity constraint. A document may be marked 'standalone' if any optional whitespace is defined within the internal DTD subset. A document may be marked 'standalone' if any attributes that need normalization are defined within the internal DTD subset. A document may be marked 'standalone' if any the defined entities need expanding are internal, and no attributes need defaulting or normalization. On output, requires notations to be correctly reported. Like sa03 but relies on attribute defaulting defined in the internal subset. On output, requires notations to be correctly reported. Like sa01 but this document is standalone since it has no optional whitespace. On output, requires notations to be correctly reported. XML permits token reuse, while SGML does not. Tests a lowercase ISO language code. Tests a ISO language code with a subcode. Tests a IANA language code with a subcode. Tests a user language code with a subcode. Tests an uppercase ISO language code. Tests a user language code. Tests construction of internal entity replacement text, using an example in the XML specification. Tests construction of internal entity replacement text, using an example in the XML specification. Tests construction of internal entity replacement text, using a complex example in the XML specification. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/0000755006511100651110000000000010504340466023506 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/0000755006511100651110000000000010504340465025133 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/not-sa/0000755006511100651110000000000010504340465026334 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/not-sa/out/0000755006511100651110000000000010504340465027143 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/not-sa/out/022.xml0000644006511100651110000000002310504340465030163 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/not-sa/022.ent0000644006511100651110000000013610504340465027347 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/not-sa/022.xml0000644006511100651110000000005610504340465027362 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/002.ent0000644006511100651110000000005710504340465026146 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/002.xml0000644006511100651110000000005610504340465026157 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/005.ent0000644006511100651110000000006010504340465026143 0ustar rossross"> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/invalid/006.ent0000644006511100651110000000005710504340465026152 0ustar rossross"> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/0000755006511100651110000000000010504340457024720 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/ext-sa/0000755006511100651110000000000010504340465026120 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/ext-sa/001.ent0000644006511100651110000000000310504340465027121 0ustar rossross&e;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/ext-sa/001.xml0000644006511100651110000000010310504340465027134 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/ext-sa/002.ent0000644006511100651110000000006010504340465027125 0ustar rossross data hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/ext-sa/002.xml0000644006511100651110000000013510504340465027142 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/ext-sa/003.ent0000644006511100651110000000012410504340465027127 0ustar rossross data hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/ext-sa/003.xml0000644006511100651110000000013510504340465027143 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/0000755006511100651110000000000010504340465026120 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/001.ent0000644006511100651110000000005510504340465027130 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/001.xml0000644006511100651110000000005610504340465027143 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/002.xml0000644006511100651110000000016710504340465027147 0ustar rossross "> %e; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/003.ent0000644006511100651110000000005010504340465027125 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/004.ent0000644006511100651110000000005110504340465027127 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/005.ent0000644006511100651110000000003710504340465027134 0ustar rossross %e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/005.xml0000644006511100651110000000005610504340465027147 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/006.ent0000644006511100651110000000005310504340465027133 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/006.xml0000644006511100651110000000005610504340465027150 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/007.ent0000644006511100651110000000005710504340465027140 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/007.xml0000644006511100651110000000005610504340465027151 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/008.ent0000644006511100651110000000005010504340465027132 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/008.xml0000644006511100651110000000005610504340465027152 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/009.ent0000644006511100651110000000006510504340465027141 0ustar rossross %e; --> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/009.xml0000644006511100651110000000005610504340465027153 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/010.ent0000644006511100651110000000006010504340465027124 0ustar rossross %e; doc (#PCDATA)> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/010.xml0000644006511100651110000000005610504340465027143 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/011.ent0000644006511100651110000000011210504340465027123 0ustar rossross "> %e1; doc (#PCDATA) %e2; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/not-sa/011.xml0000644006511100651110000000005610504340465027144 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/0000755006511100651110000000000010504340466025323 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/001.xml0000644006511100651110000000004010504340465026336 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/002.xml0000644006511100651110000000004010504340465026337 0ustar rossross <.doc> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/003.xml0000644006511100651110000000002210504340465026340 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/004.xml0000644006511100651110000000004010504340465026341 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/005.xml0000644006511100651110000000004010504340465026342 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/006.xml0000644006511100651110000000005210504340465026346 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/007.xml0000644006511100651110000000003110504340465026344 0ustar rossross& no refc hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/008.xml0000644006511100651110000000002610504340465026351 0ustar rossross&.entity; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/009.xml0000644006511100651110000000002210504340465026346 0ustar rossross&#RE; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/010.xml0000644006511100651110000000002210504340465026336 0ustar rossrossA & B hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/011.xml0000644006511100651110000000002010504340465026335 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/012.xml0000644006511100651110000000002310504340465026341 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/013.xml0000644006511100651110000000002510504340465026344 0ustar rossross"> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/015.xml0000644006511100651110000000002110504340465026342 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/016.xml0000644006511100651110000000003210504340465026345 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/017.xml0000644006511100651110000000002610504340465026351 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/018.xml0000644006511100651110000000004010504340465026346 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/019.xml0000644006511100651110000000001210504340465026346 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/020.xml0000644006511100651110000000003010504340465026336 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/021.xml0000644006511100651110000000002610504340465026344 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/022.xml0000644006511100651110000000003110504340465026341 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/023.xml0000644006511100651110000000002510504340465026345 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/024.xml0000644006511100651110000000003410504340465026346 0ustar rossross <123> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/025.xml0000644006511100651110000000002010504340465026342 0ustar rossross]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/026.xml0000644006511100651110000000002110504340465026344 0ustar rossross]]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/027.xml0000644006511100651110000000003110504340465026346 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/033.xml0000644006511100651110000000002410504340465026345 0ustar rossrossabcdef hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/034.xml0000644006511100651110000000010110504340465026342 0ustar rossrossA form-feed is not white space or a name character hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/035.xml0000644006511100651110000000004110504340465026346 0ustar rossross1 < 2 but not in XML hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/036.xml0000644006511100651110000000003310504340465026350 0ustar rossross Illegal data hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/037.xml0000644006511100651110000000002410504340465026351 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/038.xml0000644006511100651110000000004510504340465026355 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/039.xml0000644006511100651110000000002510504340465026354 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/040.xml0000644006511100651110000000003210504340465026342 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/041.xml0000644006511100651110000000002510504340465026345 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/042.xml0000644006511100651110000000001710504340465026347 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/043.xml0000644006511100651110000000002610504340465026350 0ustar rossross Illegal data hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/044.xml0000644006511100651110000000001610504340465026350 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/045.xml0000644006511100651110000000002610504340465026352 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/046.xml0000644006511100651110000000003010504340465026346 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/047.xml0000644006511100651110000000002710504340465026355 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/048.xml0000644006511100651110000000003510504340465026355 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/049.xml0000644006511100651110000000007210504340465026357 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/050.xml0000644006511100651110000000000010504340465026336 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/051.xml0000644006511100651110000000005710504340465026353 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/052.xml0000644006511100651110000000005010504340465026345 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/053.xml0000644006511100651110000000001510504340465026347 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/054.xml0000644006511100651110000000011110504340465026345 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/055.xml0000644006511100651110000000003610504340465026354 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/056.xml0000644006511100651110000000006010504340465026352 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/057.xml0000644006511100651110000000011210504340465026351 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/058.xml0000644006511100651110000000014210504340465026355 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/059.xml0000644006511100651110000000013210504340465026355 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/060.xml0000644006511100651110000000013510504340465026350 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/061.xml0000644006511100651110000000011010504340465026342 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/062.xml0000644006511100651110000000007410504340465026354 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/063.xml0000644006511100651110000000006310504340465026353 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/064.xml0000644006511100651110000000013010504340465026347 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/065.xml0000644006511100651110000000014110504340465026352 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/066.xml0000644006511100651110000000014110504340465026353 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/067.xml0000644006511100651110000000013210504340465026354 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/068.xml0000644006511100651110000000014610504340465026362 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/069.xml0000644006511100651110000000022210504340465026356 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/070.xml0000644006511100651110000000007310504340465026352 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/071.xml0000644006511100651110000000014510504340465026353 0ustar rossross ]> &e1; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/072.xml0000644006511100651110000000002210504340465026346 0ustar rossross&foo; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/073.xml0000644006511100651110000000007510504340465026357 0ustar rossross ]> &f; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/074.xml0000644006511100651110000000011710504340465026355 0ustar rossross"> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/075.xml0000644006511100651110000000015410504340465026357 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/076.xml0000644006511100651110000000002710504340465026357 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/077.xml0000644006511100651110000000010310504340465026353 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/078.xml0000644006511100651110000000013410504340465026360 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/079.xml0000644006511100651110000000023210504340465026360 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/080.xml0000644006511100651110000000024110504340465026350 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/081.xml0000644006511100651110000000010410504340465026347 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/082.xml0000644006511100651110000000016410504340465026356 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/083.xml0000644006511100651110000000010710504340465026354 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/084.xml0000644006511100651110000000017410504340465026361 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/085.xml0000644006511100651110000000006310504340465026357 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/086.xml0000644006511100651110000000010710504340465026357 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/087.xml0000644006511100651110000000011110504340465026353 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/088.xml0000644006511100651110000000016510504340465026365 0ustar rossross ]> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/090.xml0000644006511100651110000000011210504340465026346 0ustar rossross"> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/091.xml0000644006511100651110000000014610504340465026356 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/092.xml0000644006511100651110000000011210504340465026350 0ustar rossross"> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/093.xml0000644006511100651110000000002310504340465026352 0ustar rossrossX hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/094.xml0000644006511100651110000000004410504340465026356 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/095.xml0000644006511100651110000000006510504340465026362 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/096.xml0000644006511100651110000000006310504340465026361 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/097.xml0000644006511100651110000000006410504340465026363 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/098.xml0000644006511100651110000000006010504340465026360 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/099.xml0000644006511100651110000000005610504340465026366 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/100.xml0000644006511100651110000000006610504340465026346 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/101.xml0000644006511100651110000000006610504340465026347 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/102.xml0000644006511100651110000000004610504340465026346 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/103.xml0000644006511100651110000000007610504340465026352 0ustar rossross"> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/104.xml0000644006511100651110000000010010504340465026337 0ustar rossross"> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/105.xml0000644006511100651110000000005310504340465026347 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/106.xml0000644006511100651110000000003710504340465026352 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/107.xml0000644006511100651110000000006010504340465026347 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/108.xml0000644006511100651110000000004010504340465026346 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/109.xml0000644006511100651110000000006510504340465026356 0ustar rossross"> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/110.xml0000644006511100651110000000006710504340465026350 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/111.xml0000644006511100651110000000007710504340465026352 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/112.xml0000644006511100651110000000004110504340465026342 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/113.xml0000644006511100651110000000006710504340465026353 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/114.xml0000644006511100651110000000006510504340465026352 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/115.xml0000644006511100651110000000007710504340465026356 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/116.xml0000644006511100651110000000007610504340465026356 0ustar rossross ]> &e;7; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/117.xml0000644006511100651110000000007610504340465026357 0ustar rossross ]> &e;#97; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/118.xml0000644006511100651110000000007210504340465026354 0ustar rossross ]> &&e;97; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/119.xml0000644006511100651110000000010210504340465026347 0ustar rossross ]> &e;#38; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/120.xml0000644006511100651110000000007610504340465026351 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/121.xml0000644006511100651110000000010010504340465026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/122.xml0000644006511100651110000000010010504340465026337 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/123.xml0000644006511100651110000000007410504340465026352 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/124.xml0000644006511100651110000000010110504340465026342 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/125.xml0000644006511100651110000000007610504340465026356 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/126.xml0000644006511100651110000000007510504340465026356 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/127.xml0000644006511100651110000000007510504340465026357 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/128.xml0000644006511100651110000000007010504340465026353 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/129.xml0000644006511100651110000000010010504340465026346 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/130.xml0000644006511100651110000000010010504340465026336 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/131.xml0000644006511100651110000000010010504340466026340 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/132.xml0000644006511100651110000000012010504340466026343 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/133.xml0000644006511100651110000000007010504340466026350 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/134.xml0000644006511100651110000000007010504340466026351 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/135.xml0000644006511100651110000000007310504340466026355 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/136.xml0000644006511100651110000000010010504340466026345 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/137.xml0000644006511100651110000000007310504340466026357 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/138.xml0000644006511100651110000000007210504340466026357 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/139.xml0000644006511100651110000000006510504340466026362 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/140.xml0000644006511100651110000000011210504340466026343 0ustar rossross"> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/141.xml0000644006511100651110000000011210504340466026344 0ustar rossross"> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/142.xml0000644006511100651110000000010010504340466026342 0ustar rossross ]> � hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/143.xml0000644006511100651110000000010110504340466026344 0ustar rossross ]>  hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/144.xml0000644006511100651110000000010410504340466026350 0ustar rossross ]> ￿ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/145.xml0000644006511100651110000000010410504340466026351 0ustar rossross ]> � hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/146.xml0000644006511100651110000000010610504340466026354 0ustar rossross ]> � hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/147.xml0000644006511100651110000000004610504340466026360 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/148.xml0000644006511100651110000000005610504340466026362 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/149.xml0000644006511100651110000000012310504340466026356 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/150.xml0000644006511100651110000000004610504340466026352 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/151.xml0000644006511100651110000000004610504340466026353 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/152.xml0000644006511100651110000000004710504340466026355 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/153.xml0000644006511100651110000000014710504340466026357 0ustar rossross "> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/154.xml0000644006511100651110000000004410504340466026354 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/155.xml0000644006511100651110000000004410504340466026355 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/156.xml0000644006511100651110000000004610504340466026360 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/157.xml0000644006511100651110000000003010504340466026352 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/158.xml0000644006511100651110000000021710504340466026362 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/159.xml0000644006511100651110000000015010504340466026357 0ustar rossross "> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/160.xml0000644006511100651110000000014310504340466026351 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/161.xml0000644006511100651110000000012110504340466026346 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/162.xml0000644006511100651110000000014610504340466026356 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/163.xml0000644006511100651110000000012310504340466026352 0ustar rossross ]> %e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/164.xml0000644006511100651110000000012310504340466026353 0ustar rossross ] %e; > hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/165.xml0000644006511100651110000000011510504340466026355 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/166.xml0000644006511100651110000000002010504340466026351 0ustar rossrossï¿¿ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/167.xml0000644006511100651110000000002010504340466026352 0ustar rossross￾ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/168.xml0000644006511100651110000000002010504340466026353 0ustar rossrossí € hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/169.xml0000644006511100651110000000002010504340466026354 0ustar rossrossí°€ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/170.xml0000644006511100651110000000002110504340466026345 0ustar rossross÷€€€ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/171.xml0000644006511100651110000000003310504340466026351 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/172.xml0000644006511100651110000000003110504340466026350 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/173.xml0000644006511100651110000000002510504340466026354 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/174.xml0000644006511100651110000000003410504340466026355 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/175.xml0000644006511100651110000000012110504340466026353 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/176.xml0000644006511100651110000000006210504340466026360 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/177.xml0000644006511100651110000000010010504340466026352 0ustar rossross ]> Aï¿¿ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/178.xml0000644006511100651110000000014610504340466026365 0ustar rossross ]> ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/180.xml0000644006511100651110000000015310504340466026354 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/181.xml0000644006511100651110000000013710504340466026357 0ustar rossross ]> &e;]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/182.xml0000644006511100651110000000013210504340466026353 0ustar rossross ]> &e;--> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/183.xml0000644006511100651110000000013310504340466026355 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/184.xml0000644006511100651110000000013610504340466026361 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/185.ent0000644006511100651110000000003210504340466026343 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/185.xml0000644006511100651110000000013110504340466026355 0ustar rossross &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/186.xml0000644006511100651110000000015010504340466026357 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/not-wf/sa/null.ent0000644006511100651110000000000010504340466026773 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/0000755006511100651110000000000010504340457024605 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/0000755006511100651110000000000010504340466026006 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/0000755006511100651110000000000010504340466026615 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/001.xml0000644006511100651110000000002410504340466027633 0ustar rossrossData hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/002.xml0000644006511100651110000000001710504340466027636 0ustar rossrossDatahugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/003.xml0000644006511100651110000000001310504340466027633 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/004.xml0000644006511100651110000000002410504340466027636 0ustar rossrossData hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/005.xml0000644006511100651110000000004010504340466027635 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/006.xml0000644006511100651110000000007210504340466027643 0ustar rossrossData More data hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/007.xml0000644006511100651110000000001610504340466027642 0ustar rossrossXYZhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/008.xml0000644006511100651110000000001610504340466027643 0ustar rossrossXYZhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/009.xml0000644006511100651110000000002010504340466027637 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/010.xml0000644006511100651110000000001310504340466027631 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/011.xml0000644006511100651110000000002510504340466027635 0ustar rossrossxyzzy hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/012.xml0000644006511100651110000000001710504340466027637 0ustar rossross(e5)hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/013.xml0000644006511100651110000000006210504340466027640 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/out/014.xml0000644006511100651110000000002210504340466027635 0ustar rossrossdatahugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/001.ent0000644006511100651110000000000610504340466027012 0ustar rossrossData hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/001.xml0000644006511100651110000000013510504340466027027 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/002.ent0000644006511100651110000000000410504340466027011 0ustar rossrossDatahugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/002.xml0000644006511100651110000000013510504340466027030 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/003.ent0000644006511100651110000000000010504340466027006 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/003.xml0000644006511100651110000000013510504340466027031 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/004.ent0000644006511100651110000000000510504340466027014 0ustar rossrossData hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/004.xml0000644006511100651110000000013510504340466027032 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/005.ent0000644006511100651110000000001410504340466027015 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/005.xml0000644006511100651110000000015410504340466027034 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/006.ent0000644006511100651110000000003510504340466027021 0ustar rossrossData More data hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/006.xml0000644006511100651110000000016410504340466027036 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/007.ent0000644006511100651110000000000410504340466027016 0ustar rossrossÿþYhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/007.xml0000644006511100651110000000013710504340466027037 0ustar rossross ]> X&e;Z hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/008.ent0000644006511100651110000000006610504340466027027 0ustar rossrossÿþ<?xml encoding="UTF-16"?>Yhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/008.xml0000644006511100651110000000013710504340466027040 0ustar rossross ]> X&e;Z hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/009.ent0000644006511100651110000000000110504340466027015 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/009.xml0000644006511100651110000000013510504340466027037 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/010.ent0000644006511100651110000000000010504340466027004 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/010.xml0000644006511100651110000000013510504340466027027 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/011.ent0000644006511100651110000000000710504340466027014 0ustar rossrossxyzzy hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/011.xml0000644006511100651110000000017310504340466027032 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/012.ent0000644006511100651110000000000410504340466027012 0ustar rossross&e4;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/012.xml0000644006511100651110000000026310504340466027033 0ustar rossross ]> &e1; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/013.ent0000644006511100651110000000000410504340466027013 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/013.xml0000644006511100651110000000026410504340466027035 0ustar rossross ]> &x; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/014.ent0000644006511100651110000000001410504340466027015 0ustar rossrossÿþÿþdatahugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/ext-sa/014.xml0000644006511100651110000000013510504340466027033 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/0000755006511100651110000000000010504340466026006 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/0000755006511100651110000000000010504340466026615 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/001.xml0000644006511100651110000000001310504340466027631 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/002.xml0000644006511100651110000000001310504340466027632 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/003.xml0000644006511100651110000000002310504340466027634 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/004.xml0000644006511100651110000000002610504340466027640 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/005.xml0000644006511100651110000000002310504340466027636 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/006.xml0000644006511100651110000000003310504340466027640 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/007.xml0000644006511100651110000000002310504340466027640 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/008.xml0000644006511100651110000000002310504340466027641 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/009.xml0000644006511100651110000000003310504340466027643 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/010.xml0000644006511100651110000000002310504340466027632 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/011.xml0000644006511100651110000000002310504340466027633 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/012.xml0000644006511100651110000000002310504340466027634 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/013.xml0000644006511100651110000000002310504340466027635 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/014.xml0000644006511100651110000000002310504340466027636 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/015.xml0000644006511100651110000000002310504340466027637 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/016.xml0000644006511100651110000000002310504340466027640 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/017.xml0000644006511100651110000000002310504340466027641 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/018.xml0000644006511100651110000000002310504340466027642 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/019.xml0000644006511100651110000000002310504340466027643 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/020.xml0000644006511100651110000000002310504340466027633 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/021.xml0000644006511100651110000000002310504340466027634 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/022.xml0000644006511100651110000000002310504340466027635 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/023.xml0000644006511100651110000000002310504340466027636 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/024.xml0000644006511100651110000000002310504340466027637 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/025.xml0000644006511100651110000000002210504340466027637 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/026.xml0000644006511100651110000000003310504340466027642 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/027.xml0000644006511100651110000000001310504340466027641 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/028.xml0000644006511100651110000000002310504340466027643 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/029.xml0000644006511100651110000000002310504340466027644 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/030.xml0000644006511100651110000000001310504340466027633 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/out/031.xml0000644006511100651110000000007410504340466027643 0ustar rossross<!ATTLIST doc a1 CDATA "v1"> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/001.ent0000644006511100651110000000000010504340466027004 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/001.xml0000644006511100651110000000011110504340466027021 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/002.ent0000644006511100651110000000000110504340466027006 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/002.xml0000644006511100651110000000011110504340466027022 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/003-1.ent0000644006511100651110000000013210504340466027152 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/003-2.ent0000644006511100651110000000000010504340466027145 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/003.xml0000644006511100651110000000006010504340466027026 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/004-1.ent0000644006511100651110000000012610504340466027156 0ustar rossross %e1; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/004-2.ent0000644006511100651110000000004110504340466027153 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/004.xml0000644006511100651110000000006010504340466027027 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/005-1.ent0000644006511100651110000000007510504340466027162 0ustar rossross %e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/005-2.ent0000644006511100651110000000003610504340466027160 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/005.xml0000644006511100651110000000006010504340466027030 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/006.ent0000644006511100651110000000010210504340466027014 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/006.xml0000644006511100651110000000012110504340466027027 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/007.ent0000644006511100651110000000007010504340466027021 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/007.xml0000644006511100651110000000005610504340466027037 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/008.ent0000644006511100651110000000007010504340466027022 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/008.xml0000644006511100651110000000007110504340466027035 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/009.ent0000644006511100651110000000007010504340466027023 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/009.xml0000644006511100651110000000013410504340466027036 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/010.ent0000644006511100651110000000007010504340466027013 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/010.xml0000644006511100651110000000012110504340466027022 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/011.ent0000644006511100651110000000007010504340466027014 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/011.xml0000644006511100651110000000010710504340466027027 0ustar rossross %e; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/012.ent0000644006511100651110000000014010504340466027013 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/012.xml0000644006511100651110000000010710504340466027030 0ustar rossross %e; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/013.ent0000644006511100651110000000011410504340466027015 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/013.xml0000644006511100651110000000005610504340466027034 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/014.ent0000644006511100651110000000011010504340466027012 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/014.xml0000644006511100651110000000011410504340466027030 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/015.ent0000644006511100651110000000014610504340466027024 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/015.xml0000644006511100651110000000011310504340466027030 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/016.ent0000644006511100651110000000010610504340466027021 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/016.xml0000644006511100651110000000011410504340466027032 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/017.ent0000644006511100651110000000011510504340466027022 0ustar rossross "> %e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/017.xml0000644006511100651110000000005610504340466027040 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/018.ent0000644006511100651110000000011510504340466027023 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/018.xml0000644006511100651110000000005610504340466027041 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/019.ent0000644006511100651110000000011410504340466027023 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/019.xml0000644006511100651110000000005610504340466027042 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/020.ent0000644006511100651110000000011310504340466027012 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/020.xml0000644006511100651110000000005610504340466027032 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/021.ent0000644006511100651110000000011510504340466027015 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/021.xml0000644006511100651110000000005610504340466027033 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/023.ent0000644006511100651110000000017510504340466027025 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/023.xml0000644006511100651110000000005610504340466027035 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/024.ent0000644006511100651110000000014610504340466027024 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/024.xml0000644006511100651110000000005610504340466027036 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/025.ent0000644006511100651110000000016010504340466027021 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/025.xml0000644006511100651110000000005610504340466027037 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/026.ent0000644006511100651110000000003610504340466027024 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/026.xml0000644006511100651110000000020710504340466027036 0ustar rossross %e; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/027.ent0000644006511100651110000000006010504340466027022 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/027.xml0000644006511100651110000000005610504340466027041 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/028.ent0000644006511100651110000000010610504340466027024 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/028.xml0000644006511100651110000000005610504340466027042 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/029.ent0000644006511100651110000000014310504340466027026 0ustar rossross ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/029.xml0000644006511100651110000000005610504340466027043 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/030.ent0000644006511100651110000000007110504340466027016 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/030.xml0000644006511100651110000000005610504340466027033 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/031-1.ent0000644006511100651110000000013310504340466027154 0ustar rossross "> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/031-2.ent0000644006511100651110000000003610504340466027157 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/not-sa/031.xml0000644006511100651110000000006310504340466027032 0ustar rossross &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/0000755006511100651110000000000010504340466025210 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/0000755006511100651110000000000010504340466026017 5ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/001.xml0000644006511100651110000000001310504340466027033 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/002.xml0000644006511100651110000000001310504340466027034 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/003.xml0000644006511100651110000000001310504340466027035 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/004.xml0000644006511100651110000000002310504340466027037 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/005.xml0000644006511100651110000000002310504340466027040 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/006.xml0000644006511100651110000000002310504340466027041 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/007.xml0000644006511100651110000000001410504340466027042 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/008.xml0000644006511100651110000000003710504340466027050 0ustar rossross&<>"'hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/009.xml0000644006511100651110000000001410504340466027044 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/010.xml0000644006511100651110000000002310504340466027034 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/011.xml0000644006511100651110000000003310504340466027036 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/012.xml0000644006511100651110000000002210504340466027035 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/013.xml0000644006511100651110000000003610504340466027043 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/014.xml0000644006511100651110000000005310504340466027043 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/015.xml0000644006511100651110000000005310504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/016.xml0000644006511100651110000000002210504340466027041 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/017.xml0000644006511100651110000000004210504340466027044 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/018.xml0000644006511100651110000000002610504340466027047 0ustar rossross<foo>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/019.xml0000644006511100651110000000002410504340466027046 0ustar rossross<&hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/020.xml0000644006511100651110000000003210504340466027035 0ustar rossross<&]>]hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/021.xml0000644006511100651110000000001310504340466027035 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/022.xml0000644006511100651110000000001310504340466027036 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/023.xml0000644006511100651110000000001310504340466027037 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/024.xml0000644006511100651110000000002610504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/025.xml0000644006511100651110000000004110504340466027042 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/026.xml0000644006511100651110000000004110504340466027043 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/027.xml0000644006511100651110000000004110504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/028.xml0000644006511100651110000000001310504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/029.xml0000644006511100651110000000001310504340466027045 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/030.xml0000644006511100651110000000001310504340466027035 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/031.xml0000644006511100651110000000001310504340466027036 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/032.xml0000644006511100651110000000001310504340466027037 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/033.xml0000644006511100651110000000001310504340466027040 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/034.xml0000644006511100651110000000001310504340466027041 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/035.xml0000644006511100651110000000001310504340466027042 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/036.xml0000644006511100651110000000002610504340466027047 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/037.xml0000644006511100651110000000001310504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/038.xml0000644006511100651110000000001310504340466027045 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/039.xml0000644006511100651110000000002610504340466027052 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/040.xml0000644006511100651110000000004510504340466027043 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/041.xml0000644006511100651110000000002210504340466027037 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/042.xml0000644006511100651110000000001410504340466027041 0ustar rossrossAhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/043.xml0000644006511100651110000000003010504340466027040 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/044.xml0000644006511100651110000000016410504340466027051 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/045.xml0000644006511100651110000000002310504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/046.xml0000644006511100651110000000003310504340466027046 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/047.xml0000644006511100651110000000002210504340466027045 0ustar rossrossX Yhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/048.xml0000644006511100651110000000001410504340466027047 0ustar rossross]hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/049.xml0000644006511100651110000000001510504340466027051 0ustar rossross£hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/050.xml0000644006511100651110000000003210504340466027040 0ustar rossrossเจมส์hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/051.xml0000644006511100651110000000004310504340466027043 0ustar rossross<เจมส์>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/052.xml0000644006511100651110000000002310504340466027042 0ustar rossrossð€€ô¿½hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/053.xml0000644006511100651110000000002210504340466027042 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/054.xml0000644006511100651110000000001310504340466027043 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/055.xml0000644006511100651110000000002610504340466027050 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/056.xml0000644006511100651110000000001410504340466027046 0ustar rossrossAhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/057.xml0000644006511100651110000000001310504340466027046 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/058.xml0000644006511100651110000000002410504340466027051 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/059.xml0000644006511100651110000000016410504340466027057 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/060.xml0000644006511100651110000000002210504340466027040 0ustar rossrossX Yhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/061.xml0000644006511100651110000000001510504340466027043 0ustar rossross£hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/062.xml0000644006511100651110000000003210504340466027043 0ustar rossrossเจมส์hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/063.xml0000644006511100651110000000004310504340466027046 0ustar rossross<เจมส์>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/064.xml0000644006511100651110000000002310504340466027045 0ustar rossrossð€€ô¿½hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/065.xml0000644006511100651110000000001310504340466027045 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/066.xml0000644006511100651110000000002710504340466027053 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/067.xml0000644006511100651110000000002010504340466027045 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/068.xml0000644006511100651110000000002010504340466027046 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/069.xml0000644006511100651110000000007610504340466027062 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/070.xml0000644006511100651110000000001310504340466027041 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/071.xml0000644006511100651110000000001310504340466027042 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/072.xml0000644006511100651110000000001310504340466027043 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/073.xml0000644006511100651110000000001310504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/074.xml0000644006511100651110000000001310504340466027045 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/075.xml0000644006511100651110000000001310504340466027046 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/076.xml0000644006511100651110000000016410504340466027056 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/077.xml0000644006511100651110000000001310504340466027050 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/078.xml0000644006511100651110000000002110504340466027050 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/079.xml0000644006511100651110000000002110504340466027051 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/080.xml0000644006511100651110000000002110504340466027041 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/081.xml0000644006511100651110000000004710504340466027052 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/082.xml0000644006511100651110000000001310504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/083.xml0000644006511100651110000000001310504340466027045 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/084.xml0000644006511100651110000000001310504340466027046 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/085.xml0000644006511100651110000000001310504340466027047 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/086.xml0000644006511100651110000000001310504340466027050 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/087.xml0000644006511100651110000000002610504340466027055 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/088.xml0000644006511100651110000000002610504340466027056 0ustar rossross<foo>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/089.xml0000644006511100651110000000002710504340466027060 0ustar rossrossð€€ô¿½ô¿¿hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/090.xml0000644006511100651110000000007610504340466027054 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/091.xml0000644006511100651110000000011610504340466027050 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/092.xml0000644006511100651110000000010110504340466027043 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/093.xml0000644006511100651110000000003210504340466027047 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/094.xml0000644006511100651110000000002410504340466027051 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/095.xml0000644006511100651110000000002510504340466027053 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/096.xml0000644006511100651110000000002410504340466027053 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/097.xml0000644006511100651110000000002310504340466027053 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/098.xml0000644006511100651110000000002510504340466027056 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/099.xml0000644006511100651110000000001310504340466027054 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/100.xml0000644006511100651110000000001310504340466027033 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/101.xml0000644006511100651110000000001310504340466027034 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/102.xml0000644006511100651110000000002610504340466027041 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/103.xml0000644006511100651110000000002610504340466027042 0ustar rossross<doc>hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/104.xml0000644006511100651110000000002310504340466027040 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/105.xml0000644006511100651110000000002610504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/106.xml0000644006511100651110000000002710504340466027046 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/107.xml0000644006511100651110000000002710504340466027047 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/108.xml0000644006511100651110000000002310504340466027044 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/109.xml0000644006511100651110000000002010504340466027042 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/110.xml0000644006511100651110000000002410504340466027036 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/111.xml0000644006511100651110000000002310504340466027036 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/112.xml0000644006511100651110000000002210504340466027036 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/113.xml0000644006511100651110000000001310504340466027037 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/114.xml0000644006511100651110000000002410504340466027042 0ustar rossross&foo;hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/115.xml0000644006511100651110000000001410504340466027042 0ustar rossrossvhugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/116.xml0000644006511100651110000000002010504340466027040 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/117.xml0000644006511100651110000000001410504340466027044 0ustar rossross]hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/118.xml0000644006511100651110000000001510504340466027046 0ustar rossross]]hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/out/119.xml0000644006511100651110000000001310504340466027045 0ustar rossrosshugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/001.xml0000644006511100651110000000007410504340466026233 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/002.xml0000644006511100651110000000007510504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/003.xml0000644006511100651110000000007510504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/004.xml0000644006511100651110000000014610504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/005.xml0000644006511100651110000000015010504340466026232 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/006.xml0000644006511100651110000000014610504340466026240 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/007.xml0000644006511100651110000000010110504340466026230 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/008.xml0000644006511100651110000000012510504340466026237 0ustar rossross ]> &<>"' hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/009.xml0000644006511100651110000000010210504340466026233 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/010.xml0000644006511100651110000000014710504340466026234 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/011.xml0000644006511100651110000000020010504340466026223 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/012.xml0000644006511100651110000000014410504340466026233 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/013.xml0000644006511100651110000000017410504340466026237 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/014.xml0000644006511100651110000000022610504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/015.xml0000644006511100651110000000022610504340466026237 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/016.xml0000644006511100651110000000010210504340466026231 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/017.xml0000644006511100651110000000012310504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/018.xml0000644006511100651110000000011510504340466026237 0ustar rossross ]> ]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/019.xml0000644006511100651110000000011210504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/020.xml0000644006511100651110000000011510504340466026230 0ustar rossross ]> ]]]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/021.xml0000644006511100651110000000011610504340466026232 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/022.xml0000644006511100651110000000012010504340466026226 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/023.xml0000644006511100651110000000011710504340466026235 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/024.xml0000644006511100651110000000016410504340466026240 0ustar rossross "> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/025.xml0000644006511100651110000000014410504340466026237 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/026.xml0000644006511100651110000000014010504340466026234 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/027.xml0000644006511100651110000000013610504340466026242 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/028.xml0000644006511100651110000000012310504340466026237 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/029.xml0000644006511100651110000000012310504340466026240 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/030.xml0000644006511100651110000000012510504340466026232 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/031.xml0000644006511100651110000000014410504340466026234 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/032.xml0000644006511100651110000000014410504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/033.xml0000644006511100651110000000016510504340466026241 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/034.xml0000644006511100651110000000006710504340466026243 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/035.xml0000644006511100651110000000007010504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/036.xml0000644006511100651110000000011110504340466026233 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/037.xml0000644006511100651110000000012010504340466026234 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/038.xml0000644006511100651110000000012010504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/039.xml0000644006511100651110000000011110504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/040.xml0000644006511100651110000000017510504340466026240 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/041.xml0000644006511100651110000000015110504340466026233 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/042.xml0000644006511100651110000000014210504340466026234 0ustar rossross ]> A hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/043.xml0000644006511100651110000000015410504340466026240 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/044.xml0000644006511100651110000000027310504340466026243 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/045.xml0000644006511100651110000000017010504340466026240 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/046.xml0000644006511100651110000000017010504340466026241 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/047.xml0000644006511100651110000000010010504340466026233 0ustar rossross ]> X Y hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/048.xml0000644006511100651110000000007510504340466026247 0ustar rossross ]> ] hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/049.xml0000644006511100651110000000017410504340466026250 0ustar rossrossÿþ<!DOCTYPE doc [ <!ELEMENT doc (#PCDATA)> ]> <doc>£</doc> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/050.xml0000644006511100651110000000020410504340466026232 0ustar rossrossÿþ<!DOCTYPE doc [ <!ELEMENT doc (#PCDATA)> ]> <doc>@!*L</doc> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/051.xml0000644006511100651110000000021410504340466026234 0ustar rossrossÿþ<!DOCTYPE @!*L [ <!ELEMENT @!*L (#PCDATA)> ]> <@!*L></@!*L> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/052.xml0000644006511100651110000000010410504340466026233 0ustar rossross ]> ð€€ô¿½ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/053.xml0000644006511100651110000000014110504340466026235 0ustar rossross"> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/054.xml0000644006511100651110000000011010504340466026232 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/055.xml0000644006511100651110000000011210504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/056.xml0000644006511100651110000000015010504340466026240 0ustar rossross ]> A hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/057.xml0000644006511100651110000000006710504340466026250 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/058.xml0000644006511100651110000000015710504340466026251 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/059.xml0000644006511100651110000000034310504340466026247 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/060.xml0000644006511100651110000000010310504340466026231 0ustar rossross ]> X Y hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/061.xml0000644006511100651110000000010210504340466026231 0ustar rossross ]> £ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/062.xml0000644006511100651110000000012710504340466026241 0ustar rossross ]> เจมส์ hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/063.xml0000644006511100651110000000015410504340466026242 0ustar rossross ]> <เจมส์> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/064.xml0000644006511100651110000000011710504340466026242 0ustar rossross ]> 𐀀􏿽 hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/065.xml0000644006511100651110000000012110504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/066.xml0000644006511100651110000000023310504340466026243 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/067.xml0000644006511100651110000000010110504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/068.xml0000644006511100651110000000012410504340466026244 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/069.xml0000644006511100651110000000013510504340466026247 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/070.xml0000644006511100651110000000012110504340466026232 0ustar rossross"> %e; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/071.xml0000644006511100651110000000013210504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/072.xml0000644006511100651110000000013510504340466026241 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/073.xml0000644006511100651110000000013610504340466026243 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/074.xml0000644006511100651110000000013610504340466026244 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/075.xml0000644006511100651110000000014010504340466026240 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/076.xml0000644006511100651110000000030010504340466026237 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/077.xml0000644006511100651110000000013510504340466026246 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/078.xml0000644006511100651110000000014410504340466026247 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/079.xml0000644006511100651110000000014510504340466026251 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/080.xml0000644006511100651110000000013710504340466026242 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/081.xml0000644006511100651110000000021410504340466026237 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/082.xml0000644006511100651110000000013210504340466026237 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/083.xml0000644006511100651110000000014510504340466026244 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/084.xml0000644006511100651110000000006610504340466026247 0ustar rossross]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/085.xml0000644006511100651110000000014610504340466026247 0ustar rossross "> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/086.xml0000644006511100651110000000014410504340466026246 0ustar rossross "> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/087.xml0000644006511100651110000000015310504340466026247 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/088.xml0000644006511100651110000000012710504340466026251 0ustar rossross "> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/089.xml0000644006511100651110000000015410504340466026252 0ustar rossross ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/090.xml0000644006511100651110000000022610504340466026242 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/091.xml0000644006511100651110000000026510504340466026246 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/092.xml0000644006511100651110000000014610504340466026245 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/093.xml0000644006511100651110000000007310504340466026245 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/094.xml0000644006511100651110000000016010504340466026243 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/095.xml0000644006511100651110000000021510504340466026245 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/096.xml0000644006511100651110000000014310504340466026246 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/097.ent0000644006511100651110000000004210504340466026233 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/097.xml0000644006511100651110000000023510504340466026251 0ustar rossross %e; ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/098.xml0000644006511100651110000000010710504340466026250 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/099.xml0000644006511100651110000000014410504340466026252 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/100.xml0000644006511100651110000000014510504340466026232 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/101.xml0000644006511100651110000000012110504340466026225 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/102.xml0000644006511100651110000000014710504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/103.xml0000644006511100651110000000010510504340466026231 0ustar rossross ]> <doc> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/104.xml0000644006511100651110000000014510504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/105.xml0000644006511100651110000000015010504340466026233 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/106.xml0000644006511100651110000000015110504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/107.xml0000644006511100651110000000015110504340466026236 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/108.xml0000644006511100651110000000017110504340466026241 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/109.xml0000644006511100651110000000014210504340466026240 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/110.xml0000644006511100651110000000020110504340466026224 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/111.xml0000644006511100651110000000017310504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/112.xml0000644006511100651110000000013110504340466026230 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/113.xml0000644006511100651110000000013310504340466026233 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/114.xml0000644006511100651110000000014010504340466026232 0ustar rossross "> ]> &e; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/115.xml0000644006511100651110000000014710504340466026242 0ustar rossross ]> &e1; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/116.xml0000644006511100651110000000011210504340466026233 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/117.xml0000644006511100651110000000012610504340466026241 0ustar rossross ]> ] hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/118.xml0000644006511100651110000000012710504340466026243 0ustar rossross ]> ] hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/valid/sa/119.xml0000644006511100651110000000010210504340466026235 0ustar rossross ]> hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/canonxml.html0000644006511100651110000000306710504340465026220 0ustar rossross Canonical XML

Canonical XML

This document defines a subset of XML called canonical XML. The intended use of canonical XML is in testing XML processors, as a representation of the result of parsing an XML document.

Every well-formed XML document has a unique structurally equivalent canonical XML document. Two structurally equivalent XML documents have a byte-for-byte identical canonical XML document. Canonicalizing an XML document requires only information that an XML processor is required to make available to an application.

A canonical XML document conforms to the following grammar: 

CanonXML    ::= Pi* element Pi*
element     ::= Stag (Datachar | Pi | element)* Etag
Stag        ::= '<'  Name Atts '>'
Etag        ::= '</' Name '>'
Pi          ::= '<?' Name ' ' (((Char - S) Char*)? - (Char* '?>' Char*)) '?>'
Atts        ::= (' ' Name '=' '"' Datachar* '"')*
Datachar    ::= '&amp;' | '&lt;' | '&gt;' | '&quot;'
                 | '&#9;'| '&#10;'| '&#13;'
                 | (Char - ('&' | '<' | '>' | '"' | #x9 | #xA | #xD))
Name        ::= (see XML spec)
Char        ::= (see XML spec)
S           ::= (see XML spec)

Attributes are in lexicographical order (in Unicode bit order).

A canonical XML document is encoded in UTF-8.

Ignorable white space is considered significant and is treated equivalently to data.

James Clark
hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/readme.html0000644006511100651110000000364010504340466025634 0ustar rossross XML Test Cases

XML Test Cases version 1998-11-18

Copyright (C) 1998 James Clark. All rights reserved. Permission is granted to copy and modify this collection in any way for internal use within a company or organization. Permission is granted to redistribute the file xmltest.zip containing this collection to third parties provided that no modifications of any kind are made to this file. Note that permission to distribute the collection in any other form is not granted.

The collection is structured into three directories:

not-wf
this contains cases that are not well-formed XML documents
valid
this contains cases that are valid XML documents
invalid
this contains cases that are well-formed XML documents but are not valid XML documents

The not-wf and valid directories each have three subdirectories:

sa
this contains cases that are standalone (as defined in XML) and do not have references to external general entities
ext-sa
this contains case that are standalone and have references to external general entities
not-sa
this contains cases that are not standalone

In each directory, files with a .xml extension are the XML document test cases, and files with a .ent extension are external entities referenced by the test cases.

Within the valid directory, each of these three subdirectories has an out subdirectory which contains an equivalent canonical XML document for each of the cases.

Bug reports and contributions of new test cases are welcome.

James Clark
hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmltest/xmltest.xml0000644006511100651110000023361510504340466025742 0ustar rossross Attribute values must start with attribute names, not "?". Names may not start with "."; it's not a Letter. Processing Instruction target name is required. SGML-ism: processing instructions end in '?>' not '>'. Processing instructions end in '?>' not '?'. XML comments may not contain "--" General entity references have no whitespace after the entity name and before the semicolon. Entity references must include names, which don't begin with '.' (it's not a Letter or other name start character). Character references may have only decimal or numeric strings. Ampersand may only appear as part of a general entity reference. SGML-ism: attribute values must be explicitly assigned a value, it can't act as a boolean toggle. SGML-ism: attribute values must be quoted in all cases. The quotes on both ends of an attribute value must match. Attribute values may not contain literal '<' characters. Attribute values need a value, not just an equals sign. Attribute values need an associated name. CDATA sections need a terminating ']]>'. CDATA sections begin with a literal '<![CDATA[', no space. End tags may not be abbreviated as '</>'. Attribute values may not contain literal '&' characters except as part of an entity reference. Attribute values may not contain literal '&' characters except as part of an entity reference. Character references end with semicolons, always! Digits are not valid name start characters. Digits are not valid name start characters. Text may not contain a literal ']]>' sequence. Text may not contain a literal ']]>' sequence. Comments must be terminated with "-->". Processing instructions must end with '?>'. Text may not contain a literal ']]>' sequence. A form feed is not a legal XML character. A form feed is not a legal XML character. A form feed is not a legal XML character. An ESC (octal 033) is not a legal XML character. A form feed is not a legal XML character. The '<' character is a markup delimiter and must start an element, CDATA section, PI, or comment. Text may not appear after the root element. Character references may not appear after the root element. Tests the "Unique Att Spec" WF constraint by providing multiple values for an attribute. Tests the Element Type Match WFC - end tag name must match start tag name. Provides two document elements. Provides two document elements. Invalid End Tag Provides #PCDATA text after the document element. Provides two document elements. Invalid Empty Element Tag This start (or empty element) tag was not terminated correctly. Invalid empty element tag invalid whitespace Provides a CDATA section after the roor element. Missing start tag Empty document, with no root element. CDATA is invalid at top level of document. Invalid character reference. End tag does not match start tag. PUBLIC requires two literals. Invalid Document Type Definition format. Invalid Document Type Definition format - misplaced comment. This isn't SGML; comments can't exist in declarations. Invalid character , in ATTLIST enumeration String literal must be in quotes. Invalid type NAME defined in ATTLIST. External entity declarations require whitespace between public and system IDs. Entity declarations need space after the entity name. Conditional sections may only appear in the external DTD subset. Space is required between attribute type and default values in <!ATTLIST...> declarations. Space is required between attribute name and type in <!ATTLIST...> declarations. Required whitespace is missing. Space is required between attribute type and default values in <!ATTLIST...> declarations. Space is required between NOTATION keyword and list of enumerated choices in <!ATTLIST...> declarations. Space is required before an NDATA entity annotation. XML comments may not contain "--" ENTITY can't reference itself directly or indirectly. Undefined ENTITY foo. Undefined ENTITY f. Internal general parsed entities are only well formed if they match the "content" production. ENTITY can't reference itself directly or indirectly. Undefined ENTITY foo. Undefined ENTITY bar. Undefined ENTITY foo. ENTITY can't reference itself directly or indirectly. ENTITY can't reference itself directly or indirectly. This tests the No External Entity References WFC, since the entity is referred to within an attribute. This tests the No External Entity References WFC, since the entity is referred to within an attribute. Undefined NOTATION n. Tests the Parsed Entity WFC by referring to an unparsed entity. (This precedes the error of not declaring that entity's notation, which may be detected any time before the DTD parsing is completed.) Public IDs may not contain "[". Public IDs may not contain "[". Public IDs may not contain "[". Attribute values are terminated by literal quote characters, and any entity expansion is done afterwards. Parameter entities "are" always parsed; NDATA annotations are not permitted. Attributes may not contain a literal "<" character; this one has one because of reference expansion. Parameter entities "are" always parsed; NDATA annotations are not permitted. The replacement text of this entity has an illegal reference, because the character reference is expanded immediately. Hexadecimal character references may not use the uppercase 'X'. Prolog VERSION must be lowercase. VersionInfo must come before EncodingDecl. Space is required before the standalone declaration. Both quotes surrounding VersionNum must be the same. Only one "version=..." string may appear in an XML declaration. Only three pseudo-attributes are in the XML declaration, and "valid=..." is not one of them. Only "yes" and "no" are permitted as values of "standalone". Space is not permitted in an encoding name. Provides an illegal XML version number; spaces are illegal. End-tag required for element foo. Internal general parsed entities are only well formed if they match the "content" production. Invalid placement of CDATA section. Invalid placement of entity declaration. Invalid document type declaration. CDATA alone is invalid. No space in '<![CDATA['. Tags invalid within EntityDecl. Entity reference must be in content of element. Entiry reference must be in content of element not Start-tag. CDATA sections start '<![CDATA[', not '<!cdata['. Parameter entity values must use valid reference syntax; this reference is malformed. General entity values must use valid reference syntax; this reference is malformed. The replacement text of this entity is an illegal character reference, which must be rejected when it is parsed in the context of an attribute value. Internal general parsed entities are only well formed if they match the "content" production. This is a partial character reference, not a full one. Internal general parsed entities are only well formed if they match the "content" production. This is a partial character reference, not a full one. Entity reference expansion is not recursive. Internal general parsed entities are only well formed if they match the "content" production. This is a partial character reference, not a full one. Character references are expanded in the replacement text of an internal entity, which is then parsed as usual. Accordingly, & must be doubly quoted - encoded either as &amp; or as &#38;#38;. A name of an ENTITY was started with an invalid character. Invalid syntax mixed connectors are used. Invalid syntax mismatched parenthesis. Invalid format of Mixed-content declaration. Invalid syntax extra set of parenthesis not necessary. Invalid syntax Mixed-content must be defined as zero or more. Invalid syntax Mixed-content must be defined as zero or more. Invalid CDATA syntax. Invalid syntax for Element Type Declaration. Invalid syntax for Element Type Declaration. Invalid syntax for Element Type Declaration. Invalid syntax mixed connectors used. Illegal whitespace before optional character causes syntax error. Illegal whitespace before optional character causes syntax error. Invalid character used as connector. Tag omission is invalid in XML. Space is required before a content model. Invalid syntax for content particle. The element-content model should not be empty. Character '&#x309a;' is a CombiningChar, not a Letter, and so may not begin a name. Character #x0E5C is not legal in XML names. Character #x0000 is not legal anywhere in an XML document. Character #x001F is not legal anywhere in an XML document. Character #xFFFF is not legal anywhere in an XML document. Character #xD800 is not legal anywhere in an XML document. (If it appeared in a UTF-16 surrogate pair, it'd represent half of a UCS-4 character and so wouldn't really be in the document.) Character references must also refer to legal XML characters; #x00110000 is one more than the largest legal character. XML Declaration may not be preceded by whitespace. XML Declaration may not be preceded by comments or whitespace. XML Declaration may not be within a DTD. XML declarations may not be within element content. XML declarations may not follow document content. XML declarations must include the "version=..." string. Text declarations may not begin internal parsed entities; they may only appear at the beginning of external parsed (parameter or general) entities. '<?XML ...?>' is neither an XML declaration nor a legal processing instruction target name. '<?xmL ...?>' is neither an XML declaration nor a legal processing instruction target name. '<?xMl ...?>' is neither an XML declaration nor a legal processing instruction target name. '<?xmL ...?>' is not a legal processing instruction target name. SGML-ism: "#NOTATION gif" can't have attributes. Uses '&' unquoted in an entity declaration, which is illegal syntax for an entity reference. Violates the PEs in Internal Subset WFC by using a PE reference within a declaration. Violates the PEs in Internal Subset WFC by using a PE reference within a declaration. Violates the PEs in Internal Subset WFC by using a PE reference within a declaration. Invalid placement of Parameter entity reference. Invalid placement of Parameter entity reference. Parameter entity declarations must have a space before the '%'. Character FFFF is not legal anywhere in an XML document. Character FFFE is not legal anywhere in an XML document. An unpaired surrogate (D800) is not legal anywhere in an XML document. An unpaired surrogate (DC00) is not legal anywhere in an XML document. Four byte UTF-8 encodings can encode UCS-4 characters which are beyond the range of legal XML characters (and can't be expressed in Unicode surrogate pairs). This document holds such a character. Character FFFF is not legal anywhere in an XML document. Character FFFF is not legal anywhere in an XML document. Character FFFF is not legal anywhere in an XML document. Character FFFF is not legal anywhere in an XML document. Character FFFF is not legal anywhere in an XML document. Start tags must have matching end tags. Character FFFF is not legal anywhere in an XML document. Invalid syntax matching double quote is missing. Invalid syntax matching double quote is missing. The Entity Declared WFC requires entities to be declared before they are used in an attribute list declaration. Internal parsed entities must match the content production to be well formed. Internal parsed entities must match the content production to be well formed. Mixed content declarations may not include content particles. In mixed content models, element names must not be parenthesized. Tests the Entity Declared WFC. Note: a nonvalidating parser is permitted not to report this WFC violation, since it would need to read an external parameter entity to distinguish it from a violation of the Standalone Declaration VC. Whitespace is required between attribute/value pairs. Conditional sections must be properly terminated ("]>" used instead of "]]>"). Processing instruction target names may not be "XML" in any combination of cases. Conditional sections must be properly terminated ("]]>" omitted). Conditional sections must be properly terminated ("]]>" omitted). Tests the Entity Declared VC by referring to an undefined parameter entity within an external entity. Conditional sections need a '[' after the INCLUDE or IGNORE. A <!DOCTYPE ...> declaration may not begin any external entity; it's only found once, in the document entity. In DTDs, the '%' character must be part of a parameter entity reference. This test violates WFC:PE Between Declarations in Production 28a. The last character of a markup declaration is not contained in the same parameter-entity text replacement. Tests the No Recursion WFC by having an external general entity be self-recursive. External entities have "text declarations", which do not permit the "standalone=..." attribute that's allowed in XML declarations. Only one text declaration is permitted; a second one looks like an illegal processing instruction (target names of "xml" in any case are not allowed). Tests the "Proper Group/PE Nesting" validity constraint by fragmenting a content model between two parameter entities. Tests the "Proper Declaration/PE Nesting" validity constraint by fragmenting an element declaration between two parameter entities. Tests the "Proper Declaration/PE Nesting" validity constraint by fragmenting an element declaration between two parameter entities. Test the "Proper Conditional Section/ PE Nesting" validity constraint. Test demonstrates an Element Type Declaration with Mixed Content. Test demonstrates that whitespace is permitted after the tag name in a Start-tag. Test demonstrates that whitespace is permitted after the tag name in an End-tag. Test demonstrates a valid attribute specification within a Start-tag. Test demonstrates a valid attribute specification within a Start-tag that contains whitespace on both sides of the equal sign. Test demonstrates that the AttValue within a Start-tag can use a single quote as a delimter. Test demonstrates numeric character references can be used for element content. Test demonstrates character references can be used for element content. Test demonstrates that PubidChar can be used for element content. Test demonstrates that whitespace is valid after the Attribute in a Start-tag. Test demonstrates mutliple Attibutes within the Start-tag. Uses a legal XML 1.0 name consisting of a single colon character (disallowed by the latest XML Namespaces draft). Test demonstrates that the Attribute in a Start-tag can consist of numerals along with special characters. Test demonstrates that all lower case letters are valid for the Attribute in a Start-tag. Test demonstrates that all upper case letters are valid for the Attribute in a Start-tag. Test demonstrates that Processing Instructions are valid element content. Test demonstrates that Processing Instructions are valid element content and there can be more than one. Test demonstrates that CDATA sections are valid element content. Test demonstrates that CDATA sections are valid element content and that ampersands may occur in their literal form. Test demonstractes that CDATA sections are valid element content and that everyting between the CDStart and CDEnd is recognized as character data not markup. Test demonstrates that comments are valid element content. Test demonstrates that comments are valid element content and that all characters before the double-hypen right angle combination are considered part of thecomment. Test demonstrates that Entity References are valid element content. Test demonstrates that Entity References are valid element content and also demonstrates a valid Entity Declaration. Test demonstrates an Element Type Declaration and that the contentspec can be of mixed content. Test demonstrates an Element Type Declaration and that EMPTY is a valid contentspec. Test demonstrates an Element Type Declaration and that ANY is a valid contenspec. Test demonstrates a valid prolog that uses double quotes as delimeters around the VersionNum. Test demonstrates a valid prolog that uses single quotes as delimters around the VersionNum. Test demonstrates a valid prolog that contains whitespace on both sides of the equal sign in the VersionInfo. Test demonstrates a valid EncodingDecl within the prolog. Test demonstrates a valid SDDecl within the prolog. Test demonstrates that both a EncodingDecl and SDDecl are valid within the prolog. Test demonstrates the correct syntax for an Empty element tag. Test demonstrates that whitespace is permissible after the name in an Empty element tag. Test demonstrates a valid processing instruction. Test demonstrates a valid comment and that it may appear anywhere in the document including at the end. Test demonstrates a valid comment and that it may appear anywhere in the document including the beginning. Test demonstrates a valid processing instruction and that it may appear at the beginning of the document. Test demonstrates an Attribute List declaration that uses a StringType as the AttType. Test demonstrates an Attribute List declaration that uses a StringType as the AttType and also expands the CDATA attribute with a character reference. Test demonstrates an Attribute List declaration that uses a StringType as the AttType and also expands the CDATA attribute with a character reference. The test also shows that the leading zeros in the character reference are ignored. An element's attributes may be declared before its content model; and attribute values may contain newlines. Test demonstrates that the empty-element tag must be use for an elements that are declared EMPTY. Tests whether more than one definition can be provided for the same attribute of a given element type with the first declaration being binding. Test demonstrates that when more than one AttlistDecl is provided for a given element type, the contents of all those provided are merged. Test demonstrates that extra whitespace is normalized into single space character. Test demonstrates that character data is valid element content. Test demonstrates that characters outside of normal ascii range can be used as element content. Test demonstrates that characters outside of normal ascii range can be used as element content. The document is encoded in UTF-16 and uses some name characters well outside of the normal ASCII range. The document is encoded in UTF-8 and the text inside the root element uses two non-ASCII characters, encoded in UTF-8 and each of which expands to a Unicode surrogate pair. Tests inclusion of a well-formed internal entity, which holds an element required by the content model. Test demonstrates that extra whitespace within Start-tags and End-tags are nomalized into single spaces. Test demonstrates that extra whitespace within a processing instruction willnormalized into s single space character. Test demonstrates an Attribute List declaration that uses a StringType as the AttType and also expands the CDATA attribute with a character reference. The test also shows that the leading zeros in the character reference are ignored. Test demonstrates an element content model whose element can occur zero or more times. Test demonstrates that extra whitespace be normalized into a single space character in an attribute of type NMTOKENS. Test demonstrates an Element Type Declaration that uses the contentspec of EMPTY. The element cannot have any contents and must always appear as an empty element in the document. The test also shows an Attribute-list declaration with multiple AttDef's. Test demonstrates the use of decimal Character References within element content. Test demonstrates the use of decimal Character References within element content. Test demonstrates the use of hexadecimal Character References within element. The document is encoded in UTF-8 and the name of the root element type uses non-ASCII characters. Tests in-line handling of two legal character references, which each expand to a Unicode surrogate pair. Tests ability to define an internal entity which can't legally be expanded (contains an unquoted <). Expands a CDATA attribute with a character reference. Test demonstrates the use of decimal character references within element content. Tests definition of an internal entity holding a carriage return character reference, which must not be normalized before reporting to the application. Line break normalization only occurs when parsing external parsed entities. Verifies that an XML parser will parse a NOTATION declaration; the output phase of this test ensures that it's reported to the application. Verifies that internal parameter entities are correctly expanded within the internal subset. Test demonstrates that an AttlistDecl can use ID as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl. Test demonstrates that an AttlistDecl can use IDREF as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl. Test demonstrates that an AttlistDecl can use IDREFS as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl. Test demonstrates that an AttlistDecl can use ENTITY as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl. Test demonstrates that an AttlistDecl can use ENTITIES as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl. Verifies that an XML parser will parse a NOTATION attribute; the output phase of this test ensures that both notations are reported to the application. Test demonstrates that an AttlistDecl can use an EnumeratedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl. Test demonstrates that an AttlistDecl can use an StringType of CDATA within the Attribute type. The test also shows that REQUIRED is a valid DefaultDecl. Test demonstrates that an AttlistDecl can use an StringType of CDATA within the Attribute type. The test also shows that FIXED is a valid DefaultDecl and that a value can be given to the attribute in the Start-tag as well as the AttListDecl. Test demonstrates that an AttlistDecl can use an StringType of CDATA within the Attribute type. The test also shows that FIXED is a valid DefaultDecl and that an value can be given to the attribute. Test demonstrates the use of the optional character following a name or list to govern the number of times an element or content particles in the list occur. Tests that an external PE may be defined (but not referenced). Tests that an external PE may be defined (but not referenced). Test demonstrates that although whitespace can be used to set apart markup for greater readability it is not necessary. Parameter and General entities use different namespaces, so there can be an entity of each type with a given name. Tests whether entities may be declared more than once, with the first declaration being the binding one. Tests whether character references in internal entities are expanded early enough, by relying on correct handling to make the entity be well formed. Tests whether entity references in internal entities are expanded late enough, by relying on correct handling to make the expanded text be valid. (If it's expanded too early, the entity will parse as an element that's not valid in that context.) Tests entity expansion of three legal character references, which each expand to a Unicode surrogate pair. Verifies that an XML parser will parse a NOTATION attribute; the output phase of this test ensures that the notation is reported to the application. Verifies that an XML parser will parse an ENTITY attribute; the output phase of this test ensures that the notation is reported to the application, and for validating parsers it further tests that the entity is so reported. Test demostrates that extra whitespace is normalized into a single space character. Test demonstrates that extra whitespace is not intended for inclusion in the delivered version of the document. Attribute defaults with a DTD have special parsing rules, different from other strings. That means that characters found there may look like an undefined parameter entity reference "within a markup declaration", but they aren't ... so they can't be violating the PEs in Internal Subset WFC. Basically an output test, this requires extra whitespace to be normalized into a single space character in an attribute of type NMTOKENS. Test demonstrates that extra whitespace is normalized into a single space character in an attribute of type NMTOKENS. Basically an output test, this tests whether an externally defined attribute declaration (with a default) takes proper precedence over a subsequent internal declaration. Test demonstrates that extra whitespace within a processing instruction is converted into a single space character. Test demonstrates the name of the encoding can be composed of lowercase characters. Makes sure that PUBLIC identifiers may have some strange characters. NOTE: The XML editors have said that the XML specification errata will specify that parameter entity expansion does not occur in PUBLIC identifiers, so that the '%' character will not flag a malformed parameter entity reference. This tests whether entity expansion is (incorrectly) done while processing entity declarations; if it is, the entity value literal will terminate prematurely. Test demonstrates that a CDATA attribute can pass a double quote as its value. Test demonstrates that an attribute can pass a less than sign as its value. Test demonstrates that extra whitespace within an Attribute of a Start-tag is normalized to a single space character. Basically an output test, this requires a CDATA attribute with a tab character to be passed through as one space. Basically an output test, this requires a CDATA attribute with a newline character to be passed through as one space. Basically an output test, this requires a CDATA attribute with a return character to be passed through as one space. This tests normalization of end-of-line characters (CRLF) within entities to LF, primarily as an output test. Test demonstrates that an attribute can have a null value. Basically an output test, this requires that a CDATA attribute with a CRLF be normalized to one space. Character references expanding to spaces doesn't affect treatment of attributes. Test demonstrates shows the use of content particles within the element content. Test demonstrates that it is not an error to have attributes declared for an element not itself declared. Test demonstrates that all text within a valid CDATA section is considered text and not recognized as markup. Test demonstrates that an entity reference is processed by recursively processing the replacement text of the entity. Test demonstrates that a line break within CDATA will be normalized. Test demonstrates that entity expansion is done while processing entity declarations. Test demonstrates that entity expansion is done while processing entity declarations. Comments may contain any legal XML characters; only the string "--" is disallowed. Test demonstrates the use of an ExternalID within a document type definition. Test demonstrates the use of an ExternalID within a document type definition. Test demonstrates the expansion of an external parameter entity that declares an attribute. Expands an external parameter entity in two different ways, with one of them declaring an attribute. Test demonstrates the expansion of an external parameter entity that declares an attribute. Test demonstrates that when more than one definition is provided for the same attribute of a given element type only the first declaration is binding. Test demonstrates the use of an Attribute list declaration within an external entity. Test demonstrates that an external identifier may include a public identifier. Test demonstrates that an external identifier may include a public identifier. Test demonstrates that when more that one definition is provided for the same attribute of a given element type only the first declaration is binding. Test demonstrates a parameter entity declaration whose parameter entity definition is an ExternalID. Test demonstrates an enternal parsed entity that begins with a text declaration. Test demonstrates the use of the conditional section INCLUDE that will include its contents as part of the DTD. Test demonstrates the use of the conditional section INCLUDE that will include its contents as part of the DTD. The keyword is a parameter-entity reference. Test demonstrates the use of the conditonal section IGNORE the will ignore its content from being part of the DTD. The keyword is a parameter-entity reference. Test demonstrates the use of the conditional section INCLUDE that will include its contents as part of the DTD. The keyword is a parameter-entity reference. Test demonstrates a parameter entity declaration that contains an attribute list declaration. Test demonstrates an EnternalID whose contents contain an parameter entity declaration and a attribute list definition. Test demonstrates that a parameter entity will be expanded with spaces on either side. Parameter entities expand with spaces on either side. Test demonstrates a parameter entity declaration that contains a partial attribute list declaration. Test demonstrates the use of a parameter entity reference within an attribute list declaration. Constructs an <!ATTLIST...> declaration from several PEs. Test demonstrates that when more that one definition is provided for the same entity only the first declaration is binding. Test demonstrates that when more that one definition is provided for the same attribute of a given element type only the first declaration is binding. Test demonstrates a parameter entity reference whose value is NULL. Test demonstrates the use of the conditional section INCLUDE that will include its contents. Test demonstrates the use of the conditonal section IGNORE the will ignore its content from being used. Test demonstrates the use of the conditonal section IGNORE the will ignore its content from being used. Expands a general entity which contains a CDATA section with what looks like a markup declaration (but is just text since it's in a CDATA section). A combination of carriage return line feed in an external entity must be normalized to a single newline. A carriage return (also CRLF) in an external entity must be normalized to a single newline. Test demonstrates that the content of an element can be empty. In this case the external entity is an empty file. A carriage return (also CRLF) in an external entity must be normalized to a single newline. Test demonstrates the use of optional character and content particles within an element content. The test also show the use of external entity. Test demonstrates the use of optional character and content particles within mixed element content. The test also shows the use of an external entity and that a carriage control line feed in an external entity must be normalized to a single newline. Test demonstrates the use of external entity and how replacement text is retrieved and processed. Test demonstrates the use of external entity and how replacement text is retrieved and processed. Also tests the use of an EncodingDecl of UTF-16. A carriage return (also CRLF) in an external entity must be normalized to a single newline. Test demonstrates the use of a public identifier with and external entity. The test also show that a carriage control line feed combination in an external entity must be normalized to a single newline. Test demonstrates both internal and external entities and that processing of entity references may be required to produce the correct replacement text. Test demonstrates that whitespace is handled by adding a single whitespace to the normalized value in the attribute list. Test demonstrates use of characters outside of normal ASCII range. hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/changes.html0000644006511100651110000002476710504340457024324 0ustar rossross NIST XML Conformance Testing

A Joint Development Effort

OASIS XML Conformance Subcommittee
Second Edition (Working Draft)
15 March 2001

Filename Collection Action Rationale Status
/ibm directory IBM add Additional 1000 tests contributed by IBM Closed
p02pass1.xml OASIS delete Test was in error - was inadvertently included in the test suite Closed
o-p12fail7 OASIS modify Changed test description to "The public ID has a tab character, which is disallowed" Closed
o-p39fail4 OASIS modify Changed test description to "The XML declaration is improperly terminated" Closed
sa02.xml SUN modify Canonical output file changed -- characters coming from character references are not normalized. Closed
not-sa02.xml SUN modify Canonical output file changed -- characters coming from character references are not normalized. Closed
valid-sa-111.xml James Clark no change Question regarding canonical output - W3C WG clarification confirms that the canonical output was okay. Closed
valid-sa-068.xml James Clark modify Changed canonical output. Line break normalization only happens when parsing external parsed entities, including the document entity. See 2.11 XML 1.0 Second Edition. Closed
valid-sa-094 James Clark no change Test description indicates that it is not well-formed. W3C WG indicates that PE refs in attribute values are simply not recognized. See 4.4.1 XML 1.0 Second Edition Closed
ibm-not-wf-P33-ibm33n01.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P33-ibm33n02.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P34-ibm34n01.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P35-ibm35n01.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P35-ibm35n02.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P35-ibm35n03.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P35-ibm35n04.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P35-ibm35n05.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P36-ibm36n01.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P36-ibm36n02.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P37-ibm37n01.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P37-ibm37n02.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P37-ibm37n03.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P37-ibm37n04.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P37-ibm37n05.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P38-ibm38n01.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P38-ibm38n02.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P38-ibm38n03.xml IBM remove No longer relevant. See 2.12 XML 1.0 Second Edition Closed
ibm-not-wf-P41-ibm41n11.xml IBM modify Typo -- changed almage to aImage Closed
ibm-not-wf-P41-ibm41n12.xml IBM modify Typo -- changed aIndrect to aIndirect Closed
lang01-lang06 SUN remove Constraints tested are no longer valid. See 2.12 XML 1.0 Second Edition Closed
valid-sa-012, o-p04pass1, o-p05pass1, p-08pass1 James Clark, OASIS/NIST Modify Conform to XML but not to XML Namespaces spec. In testcases.dtd, added a NAMESPACE attribute on the TEST element to indicate whether or not the test conforms to the XML Namespaces spec. Closed
valid-sa-065, valid-sa-100, o-p73pass1, cond01.xml, cond02.xml, decl01.xml, dtd07.dtd, encoding07.xml SUN, OASIS/NIST, James Clark no change Tests define general entities which are not used, and which are either malformed or missing. W3C Core WG confirms that entities only need to be expanded if they are used. If they are not used, it doesn't matter whether or not they are well-formed. See Section 2.1. Closed
empty,
inv-not-sa14		 SUN reclassify CDATA section containing only whitespace does not match the nonterminal S. See Section 3 Logical Structure, VC: Element Valid, item 2 Closed
sa04.xml SUN Modify Literals are quoted with double quotes but appear in the output file with single quotes. Modified Second Canonical Form to surround literals with single quotes. Closed
pr-xml-* Fuji Xerox replace These files refer to spec.dtd which is missing. Include right version with the test suite. Closed
Four of James Clark's tests James Clark modify These tests have NOTATIONS and need a DOCTYPE in canonical form 2. Output files were modified. Closed
sa03-sa05 SUN No change Tests are standalone, but need to read the external subset to produce the right canonical XML. XML processors need not read the external subset if the file is standalone. If your processor produces Second Canonical Form, then it must read the external subset to match the supplied output file. Closed
invalid--003 - invalid--006 James Clark modify Changed test description from entity declaration to element declaration. Closed
inv-not-sa02, inv-not-sa08 SUN no change Have character references to whitespace characters in a tokenized attribute. W3C Core WG confirms that files are invalid. Closed
p74pass1.xml OASIS no change Comment indicated that the file was classified as Invalid, but seems to be valid. The root element 'doc' is not declared, so the file is invalid. Closed
p16fail3.xml OASIS modify Description is erroneous. File is well-formed but not valid. Updated test description to indicate that a document must conform to the constraints expressed in a dtd to be valid. Closed
001.xml, 001.ent James Clark no change Section 4.3.2 applies, not the validity constraint. Comment indicates that test should change to not-wf instead of invalid. W3C Core WG confirms that file is invalid -- spec is confusing and will be clarified. Closed
e2.xml OASIS add Errata [E2] imposes a VC on productions [58] and [59]. No duplicate tokens are permitted. Closed
attr11.xml, attr12.xml SUN modify Files marked invalid, but are actually valid. The tests refer to "Attribute Default Legal" VC but this VC is only about lexical constraints. The two tests pass the lexical test, and since the default attributes in error are not effectively used, because the instance documents specify a value for these attributes, the fact that they refer to an undeclared entity does not matter. Changed tests to effectively make them invalid with respect to the VC that they claim to test. Closed

Please forward all comments/suggestions/bugs to <mbrady@nist.gov>

NIST / Information Technology Lab
OASIS Home / OASIS Committee Pages
hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/readme.html0000644006511100651110000001375610504340463024142 0ustar rossross NIST XML Conformance Testing

A Joint Development Effort

OASIS XML Conformance Subcommittee
XML 1.0 Test Suite, Second Edition
Working Draft
15 March 2001

This version:

Current Version:

Previous Version:

OASIS XML Conformance Technical Committee:

Comments:

The XML Conformance Test Suite, v1.0, Second Edition contains over 2000 test files and an associated test report. The test report contains background information on conformance testing for XML as well as test descriptions for each of the test files included in this release. This test suite provides a set of metrics for determining conformance to the W3C XML 1.0 (Second Edition) Recommendation. The XML Conformance Test Suite is intended to complement the W3C XML 1.0 (Second Edition) Recommendation. All interpretations of this Recommendation are subject to confirmation by the W3C XML Coordination Group.

This second edition includes 1000 additional tests contributed by IBM. In addition, several tests have been either updated or further documented to be in accordance with the XML 1.0 (Second Edition) Recommendation. Many thanks to Arnaud Le Hors and Richard Tobin, of the W3C XML Core WG, for their insightful comments regarding interpretations of the specification. See http://www.oasis-open.org/committees/xml-conformance/suite-v1se/changes.html for additional details.

This release contains the following files/directories:

Filename Description
xmlconf.xml Primary xml file - includes xml description files from contributors.
xmlconformance.msxsl Microsoft XSL stylesheet to dynamically render XML Conformance report within IE5 5.00.2014.2016 or later.
xmlconf.htm HTML version of the XML Conformance report. Generated using LOTUS Xalan and applying conformance.xsl.
xmlconformance.xsl W3C XSL (19990421) stylesheet to produce the HTML rendition of the XML Conformance report.
testcases.dtd DTD used by all test description files.
changes.html Details regarding changes in this release.
japanese/japanese.xml Fuji Xerox, contributed by Makota Murata, xml test description file.
japanese/* Fuji Xerox character set tests.
oasis/oasis.xml OASIS xml test description file. These tests were supplied primarily by Matt Timmermans and modified/documented by NIST.
oasis/* OASIS xml test files - binary tests for productions 1-76.
xmltest/xmltest.xml James Clark's xml test description file. These tests were supplied by James Clark and documented by Dave Brownell, SUN, and NIST.
xmltest/* James Clark's test files - strong where parsers are likely to fail.
sun/valid/sun-valid.xml
sun/invalid/sun-invalid.xml
sun/not-wf/sun-not-wf.xml
sun/error/sun-error.xml 		SUN Microsystems xml test description files. Contributions include valid, invalid, not-wf, and error tests.
sun/valid/*
sun/invalid/*
sun/not-wf/*
sun/error/* 		SUN Microsystems xml test files. Developed to complement James Clark's tests.
ibm/ibm_oasis_valid.xml
ibm/ibm_oasis_not-wf.xml
ibm/ibm_oasis_invalid.xml 		IBM xml test description files. Contributions include valid, invalid, and not-wf tests.
ibm/valid/*
ibm/invalid/*
ibm/not-wf/* 		IBM xml test files. Developed to complement v1.0 tests.

Please forward all comments/suggestions/bugs to <mbrady@nist.gov>

NIST / Information Technology Lab
OASIS Home / OASIS Committee Pages
hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/testcases.dtd0000644006511100651110000001246010504340464024502 0ustar rossross hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmlconf.xml0000644006511100651110000000417710504340465024206 0ustar rossross ]> &jclark-xmltest; &xerox-japanese; &sun-valid; &sun-invalid; &sun-not-wf; &sun-error; &nist-oasis; &ibm-invalid; &ibm-not-wf; &ibm-valid; &ibm-xml1.1-invalid; &ibm-xml1.1-not-wf; &ibm-xml1.1-valid; &eduni-errata2e; &eduni-xml11; &eduni-ns10; &eduni-ns11; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmlconf-20010315.xml0000644006511100651110000000304710504340464025071 0ustar rossross ]> &jclark-xmltest; &xerox-japanese; &sun-valid; &sun-invalid; &sun-not-wf; &sun-error; &nist-oasis; &ibm-invalid; &ibm-not-wf; &ibm-valid; hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmlconf-20031210.html0000644006511100651110001033534410504340465025244 0ustar rossross XML Conformance Tests

W3C Architecture Domain XML | Member-Confidential!

XML W3C Conformance Test Suite

10 December 2003

This version:
Current Version:
Previous Version:
Test Archive:
W3C XML Core Working Group:
Comments:

Table of Contents

  1. Introduction
  2. Test Matrix
    1. Binary Tests
    2. Output Tests
  3. Test Case Descriptions
    1. Valid Documents
    2. Invalid Documents
    3. Not-WF Documents
    4. Optional Errors
  4. Contributors

1. Introduction

The tests described in this document provide an initial set of metrics to determine how well a particular implementation conforms to the following recommendations: W3C XML 1.0 (Second Edition) Recommendation, Extensible Markup Language (XML) 1.0 (Third Edition), Extensible Markup Language (XML) 1.1 (First Edition), and Namespaces in XML 1.1. The report properly identify the tests associated to each recommendation. All interpretations of these Recommendations are subject to confirmation by the W3C XML Group .

Conformance tests can be used by developers, content creators, and users alike to increase their level of confidence in product quality. In circumstances where interoperability is necessary, these tests can also be used to determine that differing implementations support the same set of features.

The XML Test Suite was transferred from OASIS to W3C and is being augmented to reflect the current work of the W3C XML Core Working Group, This report provides supporting documentation for all the tests included in the test suite. Sources from which these tests have been collected include: James Clark XMLTEST cases, 18-Nov-1998; Fuji Xerox Japanese Text Tests; Sun Microsystems XML Tests; OASIS/NIST TESTS, 1-Nov-1998; IBM XML Tests; Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003; Richard Tobin's XML 1.1 test suite 13 Feb 2003; Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003; Richard Tobin's XML Namespaces 1.1 test suite 14 Feb 2003; .

2. Test Matrix

Two basic types of test are presented here. These are respectively Binary Tests and Output Tests .

2.1 Binary Tests

Binary conformance tests are documents which are grouped into one of four categories. Given a document in a given category, each kind of XML parser must treat it consistently and either accept it (a positive test) or reject it (a negative test). It is in that sense that the tests are termed "binary". The XML 1.0 (Second Edition) Recommendation talks in terms of two types of XML processor: validating ones, and nonvalidating ones. There are two differences between these types of processors:

  1. Validating processors check special productions that nonvalidating parsers don't, called validity constraints. (Both must check a basic set of productions, requiring XML documents to be well formed.)
  2. Nonvalidating processors are permitted to not include external entities, such as files with text. Accordingly, they may not report errors which would have been detected had those entities been read.

There are two types of such entity, parameter entities holding definitions which affect validation and other processing; and general entities which hold marked up text. It will be appreciated that there are then five kinds of XML processor: validating processors, and four kinds of nonvalidating processor based on the combinations of external entity which they include.

Basic XML Parsing Test Matrix
Test Document Type v. Parser Type
Nonvalidating Validating
External Entities
Ignored (3 cases)		 External Entities
Read
Valid Documents accept accept accept
Invalid Documents accept accept reject
Non-WF Documents reject reject reject
WF Errors tied
to External Entity		 accept
(varies)		 reject reject
Documents with
Optional Errors		 (not specified) (not specified) (not specified)

At this time, the XML community primarily uses parsers which are in the rightmost two columns of this table, calling them Well Formed XML Parsers (or "WF Parsers") and Validating XML Parsers. A second test matrix could be defined to address the variations in the types of of XML processor which do not read all external entities. That additional matrix is not provided here at this time.

2.2 Output Tests

The XML 1.0 (Second Edition) Recommendation places a number of requirements on XML processors, to ensure that they report information to applications as needed. Such requirements are testable. Validating processors are required to report slightly more information than nonvalidating ones, so some tests will require separate output files. Some of the information that must be reported will not be reportable without reading all the external entities in a particular test. Many of the tests for valid documents are paired with an output file as the canonical representation of the input file, to ensure that the XML processor provides the correct information.

3. Test Case Descriptions

This section of this report contains descriptions of test cases, each of which fits into the categories noted above. Each test case includes a document of one of the types in the binary test matrix above (e.g. valid or invalid documents).

In some cases, an output file , as described in Section 2.2, will also be associated with a valid document, which is used for output testing. If such a file exists, it will be noted at the end of the description of the input document.

The description for each test case is presented as a two part table. The right part describes what the test does. This description is intended to have enough detail to evaluate diagnostic messages. The left part includes:

  • An entry describing the Sections and/or Rules from the XML 1.0 (Second Edition) Recommendation which this case excercises.
  • The unique Test ID within a given Collection for this test.
  • The Collection from which this test originated. Given the Test ID and the Collection, each test can be uniquely identified.
  • Some tests may have a field identifying the kinds of external Entities a nonvalidating processor must include (parameter, general, or both) to be able to detect any errors in that test case.

3.1 Valid XML Documents

All conforming XML 1.0 Processors are required to accept valid documents, reporting no errors. In this section of this test report are found descriptions of test cases which fit into this category.

Sections [Rules]:1
Test ID:rmt-ns10-007
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace inequality test: different capitalization

Sections [Rules]:1
Test ID:rmt-ns10-008
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace inequality test: different escaping

Sections [Rules]:2
Test ID:rmt-ns10-001
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace name test: a perfectly good http URI

Sections [Rules]:2
Test ID:rmt-ns10-002
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace name test: a syntactically plausible URI with a fictitious scheme

Sections [Rules]:2
Test ID:rmt-ns10-003
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace name test: a perfectly good http URI with a fragment

Sections [Rules]:2.1
Test ID:ibm-valid-P01-ibm01v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 1

Tests with a xml document consisting of prolog followed by element then Misc

There is an output test associated with this input file.
Sections [Rules]:2.1
Test ID:rmt-ns11-001
RECOMMENDATION:NS1.1
Collection:Richard Tobin's XML Namespaces 1.1 test suite 14 Feb 2003

Namespace name test: a perfectly good http IRI that is not a URI

Sections [Rules]:2.1
Test ID:rmt-ns11-006
RECOMMENDATION:NS1.1
Collection:Richard Tobin's XML Namespaces 1.1 test suite 14 Feb 2003

Test whether non-Latin-1 characters are accepted in IRIs, and whether they are correctly distinguished

Sections [Rules]:2.10
Test ID:valid-sa-084
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that although whitespace can be used to set apart markup for greater readability it is not necessary.

There is an output test associated with this input file.
Sections [Rules]:2.10
Test ID:valid-sa-093
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that extra whitespace is not intended for inclusion in the delivered version of the document.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:valid-sa-116
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that a line break within CDATA will be normalized.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:valid-ext-sa-001
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

A combination of carriage return line feed in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:valid-ext-sa-002
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

A carriage return (also CRLF) in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:valid-ext-sa-004
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

A carriage return (also CRLF) in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:valid-ext-sa-009
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

A carriage return (also CRLF) in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:ibm-1-1-valid-P03-ibm03v01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 3

The two character sequence #x0D #x85 in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:ibm-1-1-valid-P03-ibm03v02.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 3

The single character sequence #x85 in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:ibm-1-1-valid-P03-ibm03v03.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 3

The two character sequence #x0D #x85 in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:ibm-1-1-valid-P03-ibm03v04.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 3

The single character sequence #x85 in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:ibm-1-1-valid-P03-ibm03v05.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 3

The two character sequence #x0D #x85 in a document entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:ibm-1-1-valid-P03-ibm03v06.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 3

The single character sequence #x85 in a document entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:ibm-1-1-valid-P03-ibm03v07.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 3

The single character sequence #x2028 in a document entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:ibm-1-1-valid-P03-ibm03v08.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 3

The single character sequence #x85 in the XMLDecl must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:ibm-1-1-valid-P03-ibm03v09.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 3

The single character sequence #x2028 in the XMLDecl must be normalized to a single newline. (This test is questionable)

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-022
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a NEL character; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-023
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a NEL character; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-024
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has an LSEP character; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-025
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has an LSEP character; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-026
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has CR-NEL; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-027
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has CR-NEL; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-028
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has CR-LSEP; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1. Note that CR and LSEP are not combined into a single LF

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-029
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has CR-LSEP; legal in both XML 1.0 and 1.1, but different canonical output because of normalization in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-031
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a NEL character in an NMTOKENS attribute; well-formed in both XML 1.0 and 1.1, but valid only in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-033
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has an LSEP character in an NMTOKENS attribute; well-formed in both XML 1.0 and 1.1, but valid only in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-047
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a NEL character in element content whitespace; well-formed in both XML 1.0 and 1.1, but valid only in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-049
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

has an LSEP character in element content whitespace; well-formed in both XML 1.0 and 1.1, but valid only in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11, 3.3.3
Test ID:valid-sa-108
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

This tests normalization of end-of-line characters (CRLF) within entities to LF, primarily as an output test.

There is an output test associated with this input file.
Sections [Rules]:2.11, 4.5
Test ID:valid-sa-068
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests definition of an internal entity holding a carriage return character reference, which must not be normalized before reporting to the application. Line break normalization only occurs when parsing external parsed entities.

There is an output test associated with this input file.
Sections [Rules]:2.11 3.2.1 3.2.2 4.2.2 [48] [51] [75]
Test ID:valid-ext-sa-006
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of optional character and content particles within mixed element content. The test also shows the use of an external entity and that a carriage control line feed in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.11 4.2.2 [75]
Test ID:valid-ext-sa-011
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of a public identifier with and external entity. The test also show that a carriage control line feed combination in an external entity must be normalized to a single newline.

There is an output test associated with this input file.
Sections [Rules]:2.12
Test ID:ibm-valid-P33-ibm33v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 33

Tests LanguageID with Langcode - Subcode

There is an output test associated with this input file.
Sections [Rules]:2.12
Test ID:ibm-valid-P34-ibm34v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 34

Duplicate Test as ibm33v01.xml

There is an output test associated with this input file.
Sections [Rules]:2.12
Test ID:ibm-valid-P35-ibm35v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 35

Tests ISO639Code

There is an output test associated with this input file.
Sections [Rules]:2.12
Test ID:ibm-valid-P36-ibm36v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 36

Tests IanaCode

There is an output test associated with this input file.
Sections [Rules]:2.12
Test ID:ibm-valid-P37-ibm37v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 37

Tests UserCode

There is an output test associated with this input file.
Sections [Rules]:2.12
Test ID:ibm-valid-P38-ibm38v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 38

Tests SubCode

There is an output test associated with this input file.
Sections [Rules]:2.12 [35]
Test ID:v-lang01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests a lowercase ISO language code.

There is an output test associated with this input file.
Sections [Rules]:2.12 [35]
Test ID:v-lang02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests a ISO language code with a subcode.

There is an output test associated with this input file.
Sections [Rules]:2.12 [35]
Test ID:v-lang05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests an uppercase ISO language code.

There is an output test associated with this input file.
Sections [Rules]:2.12 [36]
Test ID:v-lang03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests a IANA language code with a subcode.

There is an output test associated with this input file.
Sections [Rules]:2.12 [37]
Test ID:v-lang04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests a user language code with a subcode.

There is an output test associated with this input file.
Sections [Rules]:2.12 [37]
Test ID:v-lang06
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests a user language code.

There is an output test associated with this input file.
Sections [Rules]:2.2
Test ID:ibm-valid-P02-ibm02v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

This test case covers legal character ranges plus discrete legal characters for production 02.

Sections [Rules]:2.2
Test ID:ibm-1-1-valid-P02-ibm02v01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test case covers legal character ranges plus discrete legal characters for production 02 of the XML1.1 sepcification.

Sections [Rules]:2.2
Test ID:rmt-010
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a C1 control, legal in XML 1.0, illegal in XML 1.1

There is an output test associated with this input file.
Sections [Rules]:2.2
Test ID:rmt-012
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a DEL, legal in XML 1.0, illegal in XML 1.1

There is an output test associated with this input file.
Sections [Rules]:2.2
Test ID:rmt-040
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a C1 control character (partial line up), legal in XML 1.0 but not 1.1

There is an output test associated with this input file.
Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-valid-P02-ibm02v02.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test case covers control characters x1 to x1F and x7F to x9F which should only appear as character references.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-valid-P02-ibm02v03.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test case covers control characters x1 to x1F and x7F to x9F which appear as character references as an entity's replacement text.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-valid-P02-ibm02v04.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test case contains embeded whitespace characters some form the range 1 - 1F.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-valid-P02-ibm02v05.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test case contains valid char references that match the char production.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-valid-P02-ibm02v06.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test case contains valid char references in the CDATA section, comment and processing instruction of an external entity that match the char production.

Sections [Rules]:2.2 [1]
Test ID:o-p01pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

various Misc items where they can occur

Sections [Rules]:2.2 [2]
Test ID:valid-sa-049
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that characters outside of normal ascii range can be used as element content.

There is an output test associated with this input file.
Sections [Rules]:2.2 [2]
Test ID:valid-sa-050
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that characters outside of normal ascii range can be used as element content.

There is an output test associated with this input file.
Sections [Rules]:2.2 [2]
Test ID:valid-sa-051
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

The document is encoded in UTF-16 and uses some name characters well outside of the normal ASCII range.

There is an output test associated with this input file.
Sections [Rules]:2.2 [2]
Test ID:valid-sa-052
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

The document is encoded in UTF-8 and the text inside the root element uses two non-ASCII characters, encoded in UTF-8 and each of which expands to a Unicode surrogate pair.

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P03-ibm03v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 3

Tests all 4 legal white space characters - #x20 #x9 #xD #xA

Sections [Rules]:2.3
Test ID:ibm-valid-P09-ibm09v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 9

Empty EntityValue is legal

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P09-ibm09v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 9

Tests a normal EnitityValue

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P09-ibm09v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 9

Tests EnitityValue referencing a Parameter Entity

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P09-ibm09v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 9

Tests EnitityValue referencing a General Entity

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P09-ibm09v05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 9

Tests EnitityValue with combination of GE, PE and text, the GE used is declared in the student.dtd

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P10-ibm10v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests empty AttValue with double quotes as the delimiters

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P10-ibm10v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests empty AttValue with single quotes as the delimiters

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P10-ibm10v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Test AttValue with double quotes as the delimiters and single quote inside

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P10-ibm10v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Test AttValue with single quotes as the delimiters and double quote inside

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P10-ibm10v05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Test AttValue with a GE reference and double quotes as the delimiters

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P10-ibm10v06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Test AttValue with a GE reference and single quotes as the delimiters

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P10-ibm10v07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

testing AttValue with mixed references and text content in double quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P10-ibm10v08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

testing AttValue with mixed references and text content in single quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P11-ibm11v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 11

Tests empty systemliteral using the double quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P11-ibm11v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 11

Tests empty systemliteral using the single quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P11-ibm11v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 11

Tests regular systemliteral using the single quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P11-ibm11v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 11

Tests regular systemliteral using the double quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P12-ibm12v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 12

Tests empty systemliteral using the double quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P12-ibm12v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 12

Tests empty systemliteral using the single quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P12-ibm12v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 12

Tests regular systemliteral using the double quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P12-ibm12v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 12

Tests regular systemliteral using the single quotes

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-valid-P13-ibm13v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 13

Testing PubidChar with all legal PubidChar in a PubidLiteral

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:ibm-1-1-valid-P04-ibm04v01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

This test case covers legal NameStartChars character ranges plus discrete legal characters for production 04.

Sections [Rules]:2.3
Test ID:ibm-1-1-valid-P04-ibm04av01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

This test case covers legal NameChars character ranges plus discrete legal characters for production 04a.

Sections [Rules]:2.3
Test ID:ibm-1-1-valid-P05-ibm05v01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

This test case covers legal Element Names as per production 5.

Sections [Rules]:2.3
Test ID:ibm-1-1-valid-P05-ibm05v02.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

This test case covers legal PITarget (Names) as per production 5.

Sections [Rules]:2.3
Test ID:ibm-1-1-valid-P05-ibm05v03.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

This test case covers legal Attribute (Names) as per production 5.

Sections [Rules]:2.3
Test ID:ibm-1-1-valid-P05-ibm05v04.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

This test case covers legal ID/IDREF (Names) as per production 5.

Sections [Rules]:2.3
Test ID:ibm-1-1-valid-P05-ibm05v05.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

This test case covers legal ENTITY (Names) as per production 5.

Sections [Rules]:2.3
Test ID:ibm-1-1-valid-P047-ibm07v01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 7

This test case covers legal NMTOKEN Name character ranges plus discrete legal characters for production 7.

Sections [Rules]:2.3
Test ID:rmt-034
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has an NMTOKENS attribute containing a CR character that comes from a character reference in an internal entity. Because CR is in the S production, this is valid in both XML 1.0 and 1.1.

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-035
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has an NMTOKENS attribute containing a CR character that comes from a character reference in an internal entity. Because CR is in the S production, this is valid in both XML 1.0 and 1.1.

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-050
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has element content whitespace containing a CR character that comes from a character reference in an internal entity. Because CR is in the S production, this is valid in both XML 1.0 and 1.1.

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-051
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has element content whitespace containing a CR character that comes from a character reference in an internal entity. Because CR is in the S production, this is valid in both XML 1.0 and 1.1.

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-ns11-002
RECOMMENDATION:NS1.1
Collection:Richard Tobin's XML Namespaces 1.1 test suite 14 Feb 2003

Namespace inequality test: different escaping of non-ascii letter

Sections [Rules]:2.3 [12]
Test ID:valid-sa-100
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Makes sure that PUBLIC identifiers may have some strange characters. NOTE: The XML editors have said that the XML specification errata will specify that parameter entity expansion does not occur in PUBLIC identifiers, so that the '%' character will not flag a malformed parameter entity reference.

There is an output test associated with this input file.
Sections [Rules]:2.3 [12]
Test ID:o-p12pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid public IDs.

Sections [Rules]:2.3 [4]
Test ID:valid-sa-012
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Uses a legal XML 1.0 name consisting of a single colon character (disallowed by the latest XML Namespaces draft).

There is an output test associated with this input file.
Sections [Rules]:2.3 [5]
Test ID:valid-sa-063
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

The document is encoded in UTF-8 and the name of the root element type uses non-ASCII characters.

There is an output test associated with this input file.
Sections [Rules]:2.3 [6]
Test ID:o-p06pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

various satisfactions of the Names production in a NAMES attribute

Sections [Rules]:2.3 [7]
Test ID:o-p07pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

various valid Nmtoken 's in an attribute list declaration.

Sections [Rules]:2.3 [8]
Test ID:o-p08pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

various satisfaction of an NMTOKENS attribute value.

Sections [Rules]:2.3 [9]
Test ID:o-p09pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid EntityValue's. Except for entity references, markup is not recognized.

Sections [Rules]:2.3 2.10
Test ID:valid-sa-092
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demostrates that extra whitespace is normalized into a single space character.

There is an output test associated with this input file.
Sections [Rules]:2.3 3.1 [10][40][41]
Test ID:valid-sa-109
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an attribute can have a null value.

There is an output test associated with this input file.
Sections [Rules]:2.3 3.1 [13] [40]
Test ID:valid-sa-013
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that the Attribute in a Start-tag can consist of numerals along with special characters.

There is an output test associated with this input file.
Sections [Rules]:2.3 3.1 [13] [40]
Test ID:valid-sa-014
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that all lower case letters are valid for the Attribute in a Start-tag.

There is an output test associated with this input file.
Sections [Rules]:2.3 3.1 [13] [40]
Test ID:valid-sa-015
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that all upper case letters are valid for the Attribute in a Start-tag.

There is an output test associated with this input file.
Sections [Rules]:2.3 3.1 [43]
Test ID:valid-sa-009
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that PubidChar can be used for element content.

There is an output test associated with this input file.
Sections [Rules]:2.3 4.1 [10] [69]
Test ID:valid-not-sa-023
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of a parameter entity reference within an attribute list declaration.

There is an output test associated with this input file.
Sections [Rules]:2.4
Test ID:ibm-valid-P14-ibm14v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 14

Testing CharData with empty string

There is an output test associated with this input file.
Sections [Rules]:2.4
Test ID:ibm-valid-P14-ibm14v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 14

Testing CharData with white space character

There is an output test associated with this input file.
Sections [Rules]:2.4
Test ID:ibm-valid-P14-ibm14v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 14

Testing CharData with a general text string

There is an output test associated with this input file.
Sections [Rules]:2.4 2.5 2.6 2.7 [15] [16] [18]
Test ID:o-p43pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid use of character data, comments, processing instructions and CDATA sections within the start and end tag.

Sections [Rules]:2.4 3.1 [14] [43]
Test ID:valid-sa-048
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that character data is valid element content.

There is an output test associated with this input file.
Sections [Rules]:2.4 3.1 [43]
Test ID:valid-sa-008
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates character references can be used for element content.

There is an output test associated with this input file.
Sections [Rules]:2.5
Test ID:valid-sa-119
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Comments may contain any legal XML characters; only the string "--" is disallowed.

There is an output test associated with this input file.
Sections [Rules]:2.5
Test ID:ibm-valid-P15-ibm15v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 15

Tests empty comment

There is an output test associated with this input file.
Sections [Rules]:2.5
Test ID:ibm-valid-P15-ibm15v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 15

Tests comment with regular text

There is an output test associated with this input file.
Sections [Rules]:2.5
Test ID:ibm-valid-P15-ibm15v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 15

Tests comment with one dash inside

There is an output test associated with this input file.
Sections [Rules]:2.5
Test ID:ibm-valid-P15-ibm15v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 15

Tests comment with more comprehensive content

There is an output test associated with this input file.
Sections [Rules]:2.5 [15]
Test ID:dtd01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Comments don't get parameter entity expansion

There is an output test associated with this input file.
Sections [Rules]:2.5 3.1 [15] [43]
Test ID:valid-sa-021
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that comments are valid element content.

There is an output test associated with this input file.
Sections [Rules]:2.5 3.1 [15] [43]
Test ID:valid-sa-022
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that comments are valid element content and that all characters before the double-hypen right angle combination are considered part of thecomment.

There is an output test associated with this input file.
Sections [Rules]:2.6
Test ID:ibm-valid-P16-ibm16v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 16

Tests PI definition with only PItarget name and nothing else

There is an output test associated with this input file.
Sections [Rules]:2.6
Test ID:ibm-valid-P16-ibm16v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 16

Tests PI definition with only PItarget name and a white space

There is an output test associated with this input file.
Sections [Rules]:2.6
Test ID:ibm-valid-P16-ibm16v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 16

Tests PI definition with PItarget name and text that contains question mark and right angle

There is an output test associated with this input file.
Sections [Rules]:2.6
Test ID:ibm-valid-P17-ibm17v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 17

Tests PITarget name

There is an output test associated with this input file.
Sections [Rules]:2.6 [15]
Test ID:valid-sa-037
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid comment and that it may appear anywhere in the document including at the end.

There is an output test associated with this input file.
Sections [Rules]:2.6 [15]
Test ID:valid-sa-038
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid comment and that it may appear anywhere in the document including the beginning.

There is an output test associated with this input file.
Sections [Rules]:2.6 [16]
Test ID:valid-sa-036
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid processing instruction.

There is an output test associated with this input file.
Sections [Rules]:2.6 [16]
Test ID:valid-sa-039
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid processing instruction and that it may appear at the beginning of the document.

There is an output test associated with this input file.
Sections [Rules]:2.6 2.10 [16]
Test ID:valid-sa-055
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that extra whitespace within a processing instruction willnormalized into s single space character.

There is an output test associated with this input file.
Sections [Rules]:2.6 2.10 [16]
Test ID:valid-sa-098
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that extra whitespace within a processing instruction is converted into a single space character.

There is an output test associated with this input file.
Sections [Rules]:2.6 3.1 [16] [43]
Test ID:valid-sa-016
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that Processing Instructions are valid element content.

There is an output test associated with this input file.
Sections [Rules]:2.6 3.1 [16] [43]
Test ID:valid-sa-017
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that Processing Instructions are valid element content and there can be more than one.

There is an output test associated with this input file.
Sections [Rules]:2.7
Test ID:valid-not-sa-031
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Expands a general entity which contains a CDATA section with what looks like a markup declaration (but is just text since it's in a CDATA section).

There is an output test associated with this input file.
Sections [Rules]:2.7
Test ID:ibm-valid-P18-ibm18v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 18

Tests CDSect with CDStart CData CDEnd

There is an output test associated with this input file.
Sections [Rules]:2.7
Test ID:ibm-valid-P19-ibm19v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 19

Tests CDStart

There is an output test associated with this input file.
Sections [Rules]:2.7
Test ID:ibm-valid-P20-ibm20v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 20

Tests CDATA with empty string

There is an output test associated with this input file.
Sections [Rules]:2.7
Test ID:ibm-valid-P20-ibm20v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 20

Tests CDATA with regular content

There is an output test associated with this input file.
Sections [Rules]:2.7
Test ID:ibm-valid-P21-ibm21v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 21

Tests CDEnd

There is an output test associated with this input file.
Sections [Rules]:2.7 [20]
Test ID:valid-sa-114
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that all text within a valid CDATA section is considered text and not recognized as markup.

There is an output test associated with this input file.
Sections [Rules]:2.7 3.1 [18] [43]
Test ID:valid-sa-018
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that CDATA sections are valid element content.

There is an output test associated with this input file.
Sections [Rules]:2.7 3.1 [18] [43]
Test ID:valid-sa-019
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that CDATA sections are valid element content and that ampersands may occur in their literal form.

There is an output test associated with this input file.
Sections [Rules]:2.7 3.1 [18] [43]
Test ID:valid-sa-020
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstractes that CDATA sections are valid element content and that everyting between the CDStart and CDEnd is recognized as character data not markup.

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:valid-sa-094
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Attribute defaults with a DTD have special parsing rules, different from other strings. That means that characters found there may look like an undefined parameter entity reference "within a markup declaration", but they aren't ... so they can't be violating the PEs in Internal Subset WFC.

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:pe01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Parameter entities references are NOT RECOGNIZED in default attribute values.
Sections [Rules]:2.8
Test ID:ibm-valid-P22-ibm22v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with XMLDecl and doctypedecl

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P22-ibm22v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with doctypedecl

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P22-ibm22v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with Misc doctypedecl

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P22-ibm22v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with doctypedecl Misc

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P22-ibm22v05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with XMLDecl Misc doctypedecl

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P22-ibm22v06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with XMLDecl doctypedecl Misc

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P22-ibm22v07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with XMLDecl Misc doctypedecl Misc

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P23-ibm23v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with VersionInfo only

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P23-ibm23v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with VersionInfo EncodingDecl

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P23-ibm23v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with VersionInfo SDDecl

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P23-ibm23v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with VerstionInfo and a trailing whitespace char

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P23-ibm23v05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with VersionInfo EncodingDecl SDDecl

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P23-ibm23v06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with VersionInfo EncodingDecl SDDecl and a trailing whitespace

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P24-ibm24v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with single quote

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P24-ibm24v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with double quote

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P25-ibm25v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 25

Tests EQ with =

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P25-ibm25v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 25

Tests EQ with = and spaces on both sides

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P25-ibm25v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 25

Tests EQ with = and space in front of it

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P25-ibm25v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 25

Tests EQ with = and space after it

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P26-ibm26v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 26

Tests VersionNum 1.0

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P27-ibm27v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 27

Tests Misc with comment

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P27-ibm27v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 27

Tests Misc with PI

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P27-ibm27v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 27

Tests Misc with white spaces

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P28-ibm28v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with internal DTD only

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P28-ibm28v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with external subset and combinations of different markup declarations and PEReferences

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P29-ibm29v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 29

Tests markupdecl with combinations of elementdecl, AttlistDecl,EntityDecl, NotationDecl, PI and comment

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P29-ibm29v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 29

Tests WFC: PE in internal subset as a positive test

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P30-ibm30v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 30

Tests extSubset with extSubsetDecl only in the dtd file

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P30-ibm30v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 30

Tests extSubset with TextDecl and extSubsetDecl in the dtd file

There is an output test associated with this input file.
Sections [Rules]:2.8
Test ID:ibm-valid-P31-ibm31v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 31

Tests extSubsetDecl with combinations of markupdecls, conditionalSects, PEReferences and white spaces

There is an output test associated with this input file.
Sections [Rules]:2.8, 4.1 [69]
Test ID:valid-not-sa-024
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Constructs an <!ATTLIST...> declaration from several PEs.

There is an output test associated with this input file.
Sections [Rules]:2.8 [22]
Test ID:o-p22pass4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

XML decl and doctypedecl

Sections [Rules]:2.8 [22]
Test ID:o-p22pass5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

just doctypedecl

Sections [Rules]:2.8 [22]
Test ID:o-p22pass6
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S between decls is not required

Sections [Rules]:2.8 [23]
Test ID:valid-sa-033
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that both a EncodingDecl and SDDecl are valid within the prolog.

There is an output test associated with this input file.
Sections [Rules]:2.8 [24]
Test ID:valid-sa-028
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid prolog that uses double quotes as delimeters around the VersionNum.

There is an output test associated with this input file.
Sections [Rules]:2.8 [24]
Test ID:valid-sa-029
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid prolog that uses single quotes as delimters around the VersionNum.

There is an output test associated with this input file.
Sections [Rules]:2.8 [25]
Test ID:valid-sa-030
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid prolog that contains whitespace on both sides of the equal sign in the VersionInfo.

There is an output test associated with this input file.
Sections [Rules]:2.8 [29]
Test ID:o-p29pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid types of markupdecl.

Sections [Rules]:2.8 [31]
Test ID:o-p31pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

external subset can be empty

Sections [Rules]:2.8 3.4 4.2.2 [31] [62] [63] [75]
Test ID:o-p31pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid doctypedecl with EXternalID as Enternal Entity. The external entity contains a parameter entity reference and condtional sections.
Sections [Rules]:2.8 4.1 [28] [69]
Test ID:o-p28pass3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid doctypedecl with Parameter entity reference. The declaration of a parameter entity must precede any reference to it.

Sections [Rules]:2.8 4.1 [28] [69]
Test ID:o-p28pass5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid doctypedecl with ExternalID as an External Entity. A parameter entity reference is also used.

Sections [Rules]:2.8 4.2.2 [28] [75]
Test ID:o-p28pass4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid doctypedecl with ExternalID as an External Entity declaration.

Sections [Rules]:2.8 4.2.2 [30] [75]
Test ID:o-p30pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid doctypedecl with ExternalID as an External Entity. The external entity has an element declaration.

Sections [Rules]:2.8 4.2.2 4.3.1 [30] [75] [77]
Test ID:o-p30pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid doctypedecl with ExternalID as an Enternal Entity. The external entity begins with a Text Declaration.

Sections [Rules]:2.8 4.3.4
Test ID:rmt-006
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Second-level external general entity has later version number than first-level, but not later than document, so not an error.

There is an output test associated with this input file.
Sections [Rules]:2.8 4.3.4
Test ID:rmt-007
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

A vanilla XML 1.1 document

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:not-sa01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

A non-standalone document is valid if declared as such.

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:not-sa02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

A non-standalone document is valid if declared as such.

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:not-sa03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

A non-standalone document is valid if declared as such.

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:not-sa04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

A non-standalone document is valid if declared as such.

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:ibm-valid-P32-ibm32v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests VC: Standalone Document Declaration with absent attribute that has default value and standalone is no

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:ibm-valid-P32-ibm32v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests VC: Standalone Document Declaration with external entity reference and standalone is no

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:ibm-valid-P32-ibm32v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests VC: Standalone Document Declaration with attribute values that need to be normalized and standalone is no

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:ibm-valid-P32-ibm32v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests VC: Standalone Document Declaration with whitespace in mixed content and standalone is no

There is an output test associated with this input file.
Sections [Rules]:2.9 [32]
Test ID:valid-sa-032
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid SDDecl within the prolog.

There is an output test associated with this input file.
Sections [Rules]:2.9 [32]
Test ID:sa01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

A document may be marked 'standalone' if any optional whitespace is defined within the internal DTD subset.

There is an output test associated with this input file.
Sections [Rules]:2.9 [32]
Test ID:sa02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

A document may be marked 'standalone' if any attributes that need normalization are defined within the internal DTD subset.

There is an output test associated with this input file.
Sections [Rules]:2.9 [32]
Test ID:sa03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

A document may be marked 'standalone' if any the defined entities need expanding are internal, and no attributes need defaulting or normalization. On output, requires notations to be correctly reported.

There is an output test associated with this input file.
Sections [Rules]:2.9 [32]
Test ID:sa04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Like sa03 but relies on attribute defaulting defined in the internal subset. On output, requires notations to be correctly reported.

There is an output test associated with this input file.
Sections [Rules]:2.9 [32]
Test ID:sa05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Like sa01 but this document is standalone since it has no optional whitespace. On output, requires notations to be correctly reported.

There is an output test associated with this input file.
Sections [Rules]:3
Test ID:element
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests clauses 1, 3, and 4 of the Element Valid validity constraint.

There is an output test associated with this input file.
Sections [Rules]:3
Test ID:ibm-valid-P39-ibm39v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

Tests element with EmptyElemTag and STag content Etag, also tests the VC: Element Valid with elements that have children, Mixed and ANY contents

There is an output test associated with this input file.
Sections [Rules]:3.1
Test ID:ibm-valid-P40-ibm40v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 40

Tests STag with possible combinations of its fields, also tests WFC: Unique Att Spec.

There is an output test associated with this input file.
Sections [Rules]:3.1
Test ID:ibm-valid-P41-ibm41v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with Name Eq AttValue and VC: Attribute Value Type

There is an output test associated with this input file.
Sections [Rules]:3.1
Test ID:ibm-valid-P42-ibm42v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 42

Tests ETag with possible combinations of its fields

There is an output test associated with this input file.
Sections [Rules]:3.1
Test ID:ibm-valid-P43-ibm43v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 43

Tests content with all possible constructs: element, CharData, Reference, CDSect, Comment

There is an output test associated with this input file.
Sections [Rules]:3.1
Test ID:ibm-valid-P44-ibm44v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 44

Tests EmptyElemTag with possible combinations of its fields

There is an output test associated with this input file.
Sections [Rules]:3.1 [40]
Test ID:valid-sa-002
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that whitespace is permitted after the tag name in a Start-tag.

There is an output test associated with this input file.
Sections [Rules]:3.1 [40]
Test ID:valid-sa-005
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid attribute specification within a Start-tag that contains whitespace on both sides of the equal sign.

There is an output test associated with this input file.
Sections [Rules]:3.1 [40]
Test ID:valid-sa-010
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that whitespace is valid after the Attribute in a Start-tag.

There is an output test associated with this input file.
Sections [Rules]:3.1 [40]
Test ID:valid-sa-011
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates mutliple Attibutes within the Start-tag.

There is an output test associated with this input file.
Sections [Rules]:3.1 [40]
Test ID:valid-sa-104
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that extra whitespace within an Attribute of a Start-tag is normalized to a single space character.

There is an output test associated with this input file.
Sections [Rules]:3.1 [40] [42]
Test ID:valid-sa-054
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that extra whitespace within Start-tags and End-tags are nomalized into single spaces.

There is an output test associated with this input file.
Sections [Rules]:3.1 [41]
Test ID:valid-sa-004
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid attribute specification within a Start-tag.

There is an output test associated with this input file.
Sections [Rules]:3.1 [41]
Test ID:valid-sa-006
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that the AttValue within a Start-tag can use a single quote as a delimter.

There is an output test associated with this input file.
Sections [Rules]:3.1 [42]
Test ID:valid-sa-003
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that whitespace is permitted after the tag name in an End-tag.

There is an output test associated with this input file.
Sections [Rules]:3.1 [43]
Test ID:valid-sa-023
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that Entity References are valid element content.

There is an output test associated with this input file.
Sections [Rules]:3.1 [43]
Test ID:valid-sa-047
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that extra whitespace is normalized into single space character.

There is an output test associated with this input file.
Sections [Rules]:3.1 [43] [44]
Test ID:o-p28pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Empty-element tag must be used for element which are declared EMPTY.

Sections [Rules]:3.1 [44]
Test ID:valid-sa-034
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the correct syntax for an Empty element tag.

There is an output test associated with this input file.
Sections [Rules]:3.1 [44]
Test ID:valid-sa-035
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that whitespace is permissible after the name in an Empty element tag.

There is an output test associated with this input file.
Sections [Rules]:3.1 [44]
Test ID:valid-sa-044
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that the empty-element tag must be use for an elements that are declared EMPTY.

There is an output test associated with this input file.
Sections [Rules]:3.1 4.1 [43] [66]
Test ID:valid-sa-024
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that Entity References are valid element content and also demonstrates a valid Entity Declaration.

There is an output test associated with this input file.
Sections [Rules]:3.1 4.1 [43] [68]
Test ID:valid-ext-sa-003
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that the content of an element can be empty. In this case the external entity is an empty file.

There is an output test associated with this input file.
Sections [Rules]:3.1 4.6 [43]
Test ID:valid-sa-007
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates numeric character references can be used for element content.

There is an output test associated with this input file.
Sections [Rules]:3.2
Test ID:ibm-valid-P45-ibm45v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests both P45 elementDecl and P46 contentspec with possible combinations of their constructs

There is an output test associated with this input file.
Sections [Rules]:3.2.1
Test ID:ibm-valid-P47-ibm47v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 47

Tests all possible children,cp,choice,seq patterns in P47,P48,P49,P50

There is an output test associated with this input file.
Sections [Rules]:3.2.1
Test ID:ibm-valid-P49-ibm49v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 49

Tests VC:Proper Group/PE Nesting with PEs of choices that are properly nested with parenthesized groups in external subsets

There is an output test associated with this input file.
Sections [Rules]:3.2.1
Test ID:ibm-valid-P50-ibm50v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 50

Tests VC:Proper Group/PE Nesting with PEs of seq that are properly nested with parenthesized groups in external subsets

There is an output test associated with this input file.
Sections [Rules]:3.2.1 [47]
Test ID:valid-sa-057
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an element content model whose element can occur zero or more times.

There is an output test associated with this input file.
Sections [Rules]:3.2.1 [48][49]
Test ID:valid-sa-112
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates shows the use of content particles within the element content.

There is an output test associated with this input file.
Sections [Rules]:3.2.1 [50]
Test ID:valid-sa-081
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of the optional character following a name or list to govern the number of times an element or content particles in the list occur.

There is an output test associated with this input file.
Sections [Rules]:3.2.1 4.2.2 [48] [75]
Test ID:valid-ext-sa-005
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of optional character and content particles within an element content. The test also show the use of external entity.

There is an output test associated with this input file.
Sections [Rules]:3.2.2
Test ID:ibm-valid-P51-ibm51v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Tests Mixed with possible combinations of its fields amd VC: No Duplicate Types

There is an output test associated with this input file.
Sections [Rules]:3.2.2
Test ID:ibm-valid-P51-ibm51v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Tests VC:Proper Group/PE Nesting with PEs of Mixed that are properly nested with parenthesized groups in external subsets

There is an output test associated with this input file.
Sections [Rules]:3.2.2 [51]
Test ID:valid-sa-001
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an Element Type Declaration with Mixed Content.

There is an output test associated with this input file.
Sections [Rules]:3.2.2 [51]
Test ID:dtd00
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests parsing of alternative forms of text-only mixed content declaration.

There is an output test associated with this input file.
Sections [Rules]:3.2.2 [51]
Test ID:o-p51pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid Mixed contentspec's.

Sections [Rules]:3.2 [45]
Test ID:o-p45pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid element declarations

Sections [Rules]:3.2 [46]
Test ID:valid-sa-025
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an Element Type Declaration and that the contentspec can be of mixed content.

There is an output test associated with this input file.
Sections [Rules]:3.2 [46]
Test ID:valid-sa-026
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an Element Type Declaration and that EMPTY is a valid contentspec.

There is an output test associated with this input file.
Sections [Rules]:3.2 [46]
Test ID:valid-sa-027
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an Element Type Declaration and that ANY is a valid contenspec.

There is an output test associated with this input file.
Sections [Rules]:3.2 3.2.1 [45] [46] [47]
Test ID:o-p48pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid use of contentspec, element content models, choices, sequences and content particles within an element type declaration. The optional character following a name or list governs the number of times the element or content particle may appear.

Sections [Rules]:3.2 3.2.1 [45] [46] [47]
Test ID:o-p49pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid use of contentspec, element content models, choices, and content particles within an element type declaration. The optional character following a name or list governs the number of times the element or content particle may appear. Whitespace is also valid between choices.

Sections [Rules]:3.2 3.2.1 [45] [46] [47]
Test ID:o-p50pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid use of contentspec, element content models, sequences and content particles within an element type declaration. The optional character following a name or list governs the number of times the element or content particle may appear. Whitespace is also valid between sequences.

Sections [Rules]:3.2 3.2.1 [45] [46] [47]
Test ID:o-p47pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid use of contentspec, element content models, choices, sequences and content particles within an element type declaration. The optional character following a name or list governs the number of times the element or content particle may appear.

Sections [Rules]:3.2 3.2.1 3.2.2 [45] [46] [47] [51]
Test ID:o-p46pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid use of contentspec, element content models, and mixed content within an element type declaration.

Sections [Rules]:3.2 3.3 [46] [53]
Test ID:valid-sa-059
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an Element Type Declaration that uses the contentspec of EMPTY. The element cannot have any contents and must always appear as an empty element in the document. The test also shows an Attribute-list declaration with multiple AttDef's.

There is an output test associated with this input file.
Sections [Rules]:3.3
Test ID:valid-sa-043
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

An element's attributes may be declared before its content model; and attribute values may contain newlines.

There is an output test associated with this input file.
Sections [Rules]:3.3
Test ID:valid-sa-097
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Basically an output test, this tests whether an externally defined attribute declaration (with a default) takes proper precedence over a subsequent internal declaration.

There is an output test associated with this input file.
Sections [Rules]:3.3
Test ID:ibm-valid-P52-ibm52v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 52

Tests all AttlistDecl and AttDef Patterns in P52 and P53

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:valid-sa-076
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Verifies that an XML parser will parse a NOTATION attribute; the output phase of this test ensures that both notations are reported to the application.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:valid-sa-090
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Verifies that an XML parser will parse a NOTATION attribute; the output phase of this test ensures that the notation is reported to the application.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:valid-sa-091
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Verifies that an XML parser will parse an ENTITY attribute; the output phase of this test ensures that the notation is reported to the application, and for validating parsers it further tests that the entity is so reported.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P54-ibm54v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 54

Tests all AttTypes : StringType, TokenizedTypes, EnumeratedTypes in P55,P56,P57,P58,P59. Also tests all DefaultDecls in P60.

Sections [Rules]:3.3.1
Test ID:ibm-valid-P54-ibm54v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 54

Tests all AttTypes : StringType, TokenizedType, EnumeratedTypes in P55,P56,P57.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P54-ibm54v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 54

Tests AttTypes with StringType in P55.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P55-ibm55v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 55

Tests StringType for P55. The "CDATA" occurs in the StringType for the attribute "att" for the element "a".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56. The "ID", "IDREF", "IDREFS", "ENTITY", "ENTITIES", "NMTOKEN", and "NMTOKENS" occur in the TokenizedType for the attribute "attr".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56 VC: ID Attribute Default. The value "AC1999" is assigned to the ID attribute "attr" with "#REQUIRED" in the DeaultDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56 VC: ID Attribute Default. The value "AC1999" is assigned to the ID attribute "attr" with "#IMPLIED" in the DeaultDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56 VC: ID. The ID attribute "UniqueName" appears only once in the document.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56 VC: One ID per element type. The element "a" or "b" has only one ID attribute.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56 VC: IDREF. The IDREF value "AC456" matches the value assigned to an ID attribute "UniqueName".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56 VC: IDREF. The IDREFS value "AC456 Q123" matches the values assigned to the ID attribute "UniqueName" and "Uname".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56 VC: Entity Name. The value "image" of the ENTITY attribute "sun" matches the name of an unparsed entity declared.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56 VC: Name Token. The value of the NMTOKEN attribute "thistoken" matches the Nmtoken production.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P56-ibm56v10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType for P56 VC: Name Token. The value of the NMTOKENS attribute "thistoken" matches the Nmtoken production.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P57-ibm57v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 57

Tests EnumeratedType in the AttType. The attribute "att" has a type (a|b) with the element "a". the

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P58-ibm58v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType for P58. It shows different patterns fro the NOTATION attribute "attr".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P58-ibm58v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType for P58: Notation Attributes. The value "base64" of the NOTATION attribute "attr" matches one of the notation names declared.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P59-ibm59v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 59

Tests Enumeration in the EnumeratedType for P59. It shows different patterns for the Enumeration attribute "attr".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-valid-P59-ibm59v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 59

Tests Enumeration for P59 VC: Enumeration. The value "one" of the Enumeration attribute "attr" matches one of the element names declared.

There is an output test associated with this input file.
Sections [Rules]:3.3.1 [54]
Test ID:o-p54pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

the three kinds of attribute types

Sections [Rules]:3.3.1 [55]
Test ID:o-p55pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

StringType = "CDATA"

Sections [Rules]:3.3.1 [56]
Test ID:o-p56pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

the 7 tokenized attribute types

Sections [Rules]:3.3.1 [57]
Test ID:o-p57pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

enumerated types are NMTOKEN or NOTATION lists

Sections [Rules]:3.3.1 [58]
Test ID:o-p58pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

NOTATION enumeration has on or more items

Sections [Rules]:3.3.1 [59]
Test ID:v-sgml01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

XML permits token reuse, while SGML does not.

There is an output test associated with this input file.
Sections [Rules]:3.3.1 [59]
Test ID:o-p59pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

NMTOKEN enumerations haveon or more items

Sections [Rules]:3.3.1 4.1 [54] [66]
Test ID:valid-sa-041
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an Attribute List declaration that uses a StringType as the AttType and also expands the CDATA attribute with a character reference.

There is an output test associated with this input file.
Sections [Rules]:3.3.1 4.1 [54] [66]
Test ID:valid-sa-042
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an Attribute List declaration that uses a StringType as the AttType and also expands the CDATA attribute with a character reference. The test also shows that the leading zeros in the character reference are ignored.

There is an output test associated with this input file.
Sections [Rules]:3.3.1 4.1 [54] [66]
Test ID:valid-sa-056
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an Attribute List declaration that uses a StringType as the AttType and also expands the CDATA attribute with a character reference. The test also shows that the leading zeros in the character reference are ignored.

There is an output test associated with this input file.
Sections [Rules]:3.3.2
Test ID:ibm-valid-P60-ibm60v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl for P60. It shows different options "#REQUIRED", "#FIXED", "#IMPLIED", and default for the attribute "chapter".

There is an output test associated with this input file.
Sections [Rules]:3.3.2
Test ID:ibm-valid-P60-ibm60v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl for P60 VC: Required Attribute. In the element "one" and "two" the value of the #REQUIRED attribute "chapter" is given.

There is an output test associated with this input file.
Sections [Rules]:3.3.2
Test ID:ibm-valid-P60-ibm60v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl for P60 VC: Fixed Attribute Default. The value of the #FIXED attribute "chapter" is exactly the same as the default value.

There is an output test associated with this input file.
Sections [Rules]:3.3.2
Test ID:ibm-valid-P60-ibm60v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl for P60 VC: Attribute Default Legal. The default value specified for the attribute "attr" meets the lexical constraints of the declared attribute type.

There is an output test associated with this input file.
Sections [Rules]:3.3.2 [60]
Test ID:required00
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the #REQUIRED attribute declaration syntax, and the associated validity constraint.

There is an output test associated with this input file.
Sections [Rules]:3.3.2 [60]
Test ID:o-p60pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

the four types of default values

Sections [Rules]:3.3.3
Test ID:valid-sa-058
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that extra whitespace be normalized into a single space character in an attribute of type NMTOKENS.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-095
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Basically an output test, this requires extra whitespace to be normalized into a single space character in an attribute of type NMTOKENS.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-096
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that extra whitespace is normalized into a single space character in an attribute of type NMTOKENS.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-102
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that a CDATA attribute can pass a double quote as its value.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-103
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an attribute can pass a less than sign as its value.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-105
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Basically an output test, this requires a CDATA attribute with a tab character to be passed through as one space.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-106
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Basically an output test, this requires a CDATA attribute with a newline character to be passed through as one space.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-107
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Basically an output test, this requires a CDATA attribute with a return character to be passed through as one space.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-110
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Basically an output test, this requires that a CDATA attribute with a CRLF be normalized to one space.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-111
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character references expanding to spaces doesn't affect treatment of attributes.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-sa-115
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an entity reference is processed by recursively processing the replacement text of the entity.

There is an output test associated with this input file.
Sections [Rules]:3.3.3
Test ID:valid-ext-sa-013
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that whitespace is handled by adding a single whitespace to the normalized value in the attribute list.

There is an output test associated with this input file.
Sections [Rules]:3.3 [52]
Test ID:valid-sa-045
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests whether more than one definition can be provided for the same attribute of a given element type with the first declaration being binding.

There is an output test associated with this input file.
Sections [Rules]:3.3 [52]
Test ID:valid-sa-046
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that when more than one AttlistDecl is provided for a given element type, the contents of all those provided are merged.

There is an output test associated with this input file.
Sections [Rules]:3.3 [52]
Test ID:valid-not-sa-006
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that when more than one definition is provided for the same attribute of a given element type only the first declaration is binding.

There is an output test associated with this input file.
Sections [Rules]:3.3 [52]
Test ID:valid-not-sa-007
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of an Attribute list declaration within an external entity.

There is an output test associated with this input file.
Sections [Rules]:3.3 [52]
Test ID:valid-not-sa-010
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that when more that one definition is provided for the same attribute of a given element type only the first declaration is binding.

There is an output test associated with this input file.
Sections [Rules]:3.3 [52]
Test ID:valid-not-sa-026
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that when more that one definition is provided for the same attribute of a given element type only the first declaration is binding.

There is an output test associated with this input file.
Sections [Rules]:3.3 [52]
Test ID:o-p52pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid AttlistDecls: No AttDef's are required, and the terminating S is optional, multiple ATTLISTS per element are OK, and multiple declarations of the same attribute are OK.

Sections [Rules]:3.3 [52][53]
Test ID:valid-sa-113
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that it is not an error to have attributes declared for an element not itself declared.

There is an output test associated with this input file.
Sections [Rules]:3.3 [53]
Test ID:o-p53pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

a valid AttDef

Sections [Rules]:3.3 3.3.1 [52] [54]
Test ID:valid-sa-040
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an Attribute List declaration that uses a StringType as the AttType.

There is an output test associated with this input file.
Sections [Rules]:3.3 3.3.1 [52] [54]
Test ID:valid-sa-077
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an AttlistDecl can use an EnumeratedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3 3.3.1 [52] [54]
Test ID:valid-sa-078
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an AttlistDecl can use an StringType of CDATA within the Attribute type. The test also shows that REQUIRED is a valid DefaultDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3 3.3.1 [52] [56]
Test ID:valid-sa-071
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an AttlistDecl can use ID as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3 3.3.1 [52] [56]
Test ID:valid-sa-072
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an AttlistDecl can use IDREF as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3 3.3.1 [52] [56]
Test ID:valid-sa-073
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an AttlistDecl can use IDREFS as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3 3.3.1 [52] [56]
Test ID:valid-sa-074
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an AttlistDecl can use ENTITY as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3 3.3.1 [52] [56]
Test ID:valid-sa-075
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an AttlistDecl can use ENTITIES as the TokenizedType within the Attribute type. The test also shows that IMPLIED is a valid DefaultDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3 3.3.2 [52] [60]
Test ID:valid-sa-079
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an AttlistDecl can use an StringType of CDATA within the Attribute type. The test also shows that FIXED is a valid DefaultDecl and that a value can be given to the attribute in the Start-tag as well as the AttListDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3 3.3.2 [52] [60]
Test ID:valid-sa-080
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an AttlistDecl can use an StringType of CDATA within the Attribute type. The test also shows that FIXED is a valid DefaultDecl and that an value can be given to the attribute.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P61-ibm61v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 61

Tests conditionalSect for P61. It takes the option "invludeSect" in the file ibm61v01.dtd.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P61-ibm61v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 61

Tests conditionalSect for P61. It takes the option "ignoreSect" in the file ibm61v02.dtd.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P62-ibm62v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect for P62. The white space is not included before the key word "INCLUDE" in the beginning sequence.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P62-ibm62v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect for P62. The white space is not included after the key word "INCLUDE" in the beginning sequence.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P62-ibm62v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect for P62. The white space is included after the key word "INCLUDE" in the beginning sequence.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P62-ibm62v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect for P62. The white space is included before the key word "INCLUDE" in the beginning sequence.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P62-ibm62v05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect for P62. The extSubsetDecl is not included.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P63-ibm63v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect for P63. The white space is not included before the key word "IGNORE" in the beginning sequence.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P63-ibm63v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect for P63. The white space is not included after the key word "IGNORE" in the beginning sequence.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P63-ibm63v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect for P63. The white space is included after the key word "IGNORE" in the beginning sequence.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P63-ibm63v04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect for P63. The ignireSectContents is included.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P63-ibm63v05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect for P63. The white space is included before and after the key word "IGNORE" in the beginning sequence.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P64-ibm64v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 64

Tests ignoreSectContents for P64. One "ignore" field is included.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P64-ibm64v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 64

Tests ignoreSectContents for P64. Two "ignore" and one "ignoreSectContents" fields are included.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P64-ibm64v03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 64

Tests ignoreSectContents for P64. Four "ignore" and three "ignoreSectContents" fields are included.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P65-ibm65v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 65

Tests Ignore for P65. An empty string occurs in the Ignore filed.

There is an output test associated with this input file.
Sections [Rules]:3.4
Test ID:ibm-valid-P65-ibm65v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 65

Tests Ignore for P65. An string not including the brackets occurs in each of the Ignore filed.

There is an output test associated with this input file.
Sections [Rules]:3.4 [61]
Test ID:o-p61pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid conditional sections are INCLUDE and IGNORE

Sections [Rules]:3.4 [62]
Test ID:valid-not-sa-013
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of the conditional section INCLUDE that will include its contents as part of the DTD.

There is an output test associated with this input file.
Sections [Rules]:3.4 [62]
Test ID:valid-not-sa-014
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of the conditional section INCLUDE that will include its contents as part of the DTD. The keyword is a parameter-entity reference.

There is an output test associated with this input file.
Sections [Rules]:3.4 [62]
Test ID:valid-not-sa-016
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of the conditional section INCLUDE that will include its contents as part of the DTD. The keyword is a parameter-entity reference.

There is an output test associated with this input file.
Sections [Rules]:3.4 [62]
Test ID:valid-not-sa-028
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of the conditional section INCLUDE that will include its contents.

There is an output test associated with this input file.
Sections [Rules]:3.4 [62]
Test ID:valid-not-sa-029
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of the conditonal section IGNORE the will ignore its content from being used.

There is an output test associated with this input file.
Sections [Rules]:3.4 [62]
Test ID:valid-not-sa-030
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of the conditonal section IGNORE the will ignore its content from being used.

There is an output test associated with this input file.
Sections [Rules]:3.4 [62]
Test ID:o-p62pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid INCLUDE sections -- options S before and after keyword, sections can nest

Sections [Rules]:3.4 [63]
Test ID:valid-not-sa-015
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of the conditonal section IGNORE the will ignore its content from being part of the DTD. The keyword is a parameter-entity reference.

There is an output test associated with this input file.
Sections [Rules]:3.4 [63]
Test ID:o-p63pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid IGNORE sections

Sections [Rules]:3.4 [64]
Test ID:o-p64pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

IGNOREd sections ignore everything except section delimiters

Sections [Rules]:3 3.2.1 [47]
Test ID:optional
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests declarations of "children" content models, and the validity constraints associated with them.

There is an output test associated with this input file.
Sections [Rules]:4
Test ID:valid-sa-085
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Parameter and General entities use different namespaces, so there can be an entity of each type with a given name.

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-valid-P66-ibm66v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests all legal CharRef's.

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-valid-P67-ibm67v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 67

Tests Reference could be EntityRef or CharRef.

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-valid-P68-ibm68v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests P68 VC:Entity Declared with Entities in External Subset , standalone is no

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-valid-P68-ibm68v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests P68 VC:Entity Declared with Entities in External Parameter Entities , standalone is no

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-valid-P69-ibm69v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests P68 VC:Entity Declared with Parameter Entities in External Subset , standalone is no

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-valid-P69-ibm69v02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests P68 VC:Entity Declared with Parameter Entities in External Parameter Entities, standalone is no

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:rmt-043
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a character reference to a C0 control character (form-feed), legal in XML 1.1 but not 1.0

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:rmt-044
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a character reference to a C1 control character (partial line up), legal in both XML 1.0 and 1.1 (but for different reasons)

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:rmt-045
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a character reference to a C1 control character (partial line up), legal in both XML 1.0 and 1.1 (but for different reasons)

There is an output test associated with this input file.
Sections [Rules]:4.1 [66]
Test ID:valid-sa-060
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of decimal Character References within element content.

There is an output test associated with this input file.
Sections [Rules]:4.1 [66]
Test ID:valid-sa-061
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of decimal Character References within element content.

There is an output test associated with this input file.
Sections [Rules]:4.1 [66]
Test ID:valid-sa-062
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of hexadecimal Character References within element.

There is an output test associated with this input file.
Sections [Rules]:4.1 [66]
Test ID:valid-sa-064
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests in-line handling of two legal character references, which each expand to a Unicode surrogate pair.

There is an output test associated with this input file.
Sections [Rules]:4.1 [66]
Test ID:valid-sa-066
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Expands a CDATA attribute with a character reference.

There is an output test associated with this input file.
Sections [Rules]:4.1 [66]
Test ID:valid-sa-067
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of decimal character references within element content.

There is an output test associated with this input file.
Sections [Rules]:4.1 [66]
Test ID:valid-sa-089
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests entity expansion of three legal character references, which each expand to a Unicode surrogate pair.

There is an output test associated with this input file.
Sections [Rules]:4.1 [68]
Test ID:o-p68pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid entity references. Also ensures that a charref to '&' isn't interpreted as an entity reference open delimiter

Sections [Rules]:4.1 [69]
Test ID:valid-not-sa-003
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the expansion of an external parameter entity that declares an attribute.

There is an output test associated with this input file.
Sections [Rules]:4.1 [69]
Test ID:valid-not-sa-004
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Expands an external parameter entity in two different ways, with one of them declaring an attribute.

There is an output test associated with this input file.
Sections [Rules]:4.1 [69]
Test ID:valid-not-sa-005
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the expansion of an external parameter entity that declares an attribute.

There is an output test associated with this input file.
Sections [Rules]:4.1 [69]
Test ID:valid-not-sa-027
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a parameter entity reference whose value is NULL.

There is an output test associated with this input file.
Sections [Rules]:4.1 [69]
Test ID:o-p69pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid PEReferences.

Sections [Rules]:4.1 4.4.3 [68]
Test ID:valid-ext-sa-014
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates use of characters outside of normal ASCII range.

There is an output test associated with this input file.
Sections [Rules]:4.2
Test ID:valid-sa-086
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests whether entities may be declared more than once, with the first declaration being the binding one.

There is an output test associated with this input file.
Sections [Rules]:4.2
Test ID:valid-not-sa-025
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that when more that one definition is provided for the same entity only the first declaration is binding.

There is an output test associated with this input file.
Sections [Rules]:4.2
Test ID:ibm-valid-P70-ibm70v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 70

Tests all legal GEDecls and PEDecls constructs derived from P70-76

There is an output test associated with this input file.
Sections [Rules]:4.2.1 4.2.2
Test ID:valid-ext-sa-012
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates both internal and external entities and that processing of entity references may be required to produce the correct replacement text.

There is an output test associated with this input file.
Sections [Rules]:4.2.2 [75]
Test ID:valid-not-sa-001
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of an ExternalID within a document type definition.

There is an output test associated with this input file.
Sections [Rules]:4.2.2 [75]
Test ID:valid-not-sa-002
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of an ExternalID within a document type definition.

There is an output test associated with this input file.
Sections [Rules]:4.2.2 [75]
Test ID:valid-not-sa-008
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an external identifier may include a public identifier.

There is an output test associated with this input file.
Sections [Rules]:4.2.2 [75]
Test ID:valid-not-sa-009
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that an external identifier may include a public identifier.

There is an output test associated with this input file.
Sections [Rules]:4.2.2 [75]
Test ID:valid-not-sa-018
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an EnternalID whose contents contain an parameter entity declaration and a attribute list definition.

There is an output test associated with this input file.
Sections [Rules]:4.2.2 [76]
Test ID:o-p76pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid NDataDecls

Sections [Rules]:4.2.2 4.3.3. 4.4.3 [75] [80]
Test ID:valid-ext-sa-008
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of external entity and how replacement text is retrieved and processed. Also tests the use of an EncodingDecl of UTF-16.

There is an output test associated with this input file.
Sections [Rules]:4.2.2 4.4.3 [75]
Test ID:valid-ext-sa-007
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the use of external entity and how replacement text is retrieved and processed.

There is an output test associated with this input file.
Sections [Rules]:4.2 [70]
Test ID:o-p70pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

An EntityDecl is either a GEDecl or a PEDecl

Sections [Rules]:4.2 [71]
Test ID:o-p71pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid GEDecls

Sections [Rules]:4.2 [72]
Test ID:valid-sa-082
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests that an external PE may be defined (but not referenced).

There is an output test associated with this input file.
Sections [Rules]:4.2 [72]
Test ID:valid-sa-083
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests that an external PE may be defined (but not referenced).

There is an output test associated with this input file.
Sections [Rules]:4.2 [72]
Test ID:valid-not-sa-017
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a parameter entity declaration that contains an attribute list declaration.

There is an output test associated with this input file.
Sections [Rules]:4.2 [72]
Test ID:valid-not-sa-021
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a parameter entity declaration that contains a partial attribute list declaration.

There is an output test associated with this input file.
Sections [Rules]:4.2 [72]
Test ID:o-p72pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid PEDecls

Sections [Rules]:4.2 [73]
Test ID:o-p73pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

EntityDef is either Entity value or an external id, with an optional NDataDecl

Sections [Rules]:4.2 4.2.1 [72] [75]
Test ID:valid-not-sa-011
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a parameter entity declaration whose parameter entity definition is an ExternalID.

There is an output test associated with this input file.
Sections [Rules]:4.3.1 [77]
Test ID:valid-not-sa-012
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates an enternal parsed entity that begins with a text declaration.

There is an output test associated with this input file.
Sections [Rules]:4.3.1 4.3.2 [77] [78]
Test ID:ext01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests use of external parsed entities with and without content.

There is an output test associated with this input file.
Sections [Rules]:4.3.2
Test ID:ibm-valid-P78-ibm78v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 78

Tests ExtParsedEnt, also TextDecl in P77 and EncodingDecl in P80

There is an output test associated with this input file.
Sections [Rules]:4.3.2
Test ID:ibm-valid-P79-ibm79v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 79

Tests extPE

Sections [Rules]:4.3.2
Test ID:rmt-054
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a character reference to a C0 control character (form-feed) in an entity value. This will be legal (in XML 1.1) when the entity declaration is parsed, but what about when it is used? According to the grammar in the CR spec, it should be illegal (because the replacement text must match "content"), but this is probably not intended. This will be fixed in the PR version.

There is an output test associated with this input file.
Sections [Rules]:4.3.2 [78]
Test ID:ext02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests use of external parsed entities with different encodings than the base document.

There is an output test associated with this input file.
Sections [Rules]:4.3.3 [4,84]
Test ID:pr-xml-little
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for little-endian UTF-16 text which relies on Japanese characters. (Also requires ability to process a moderately complex DTD.)

Sections [Rules]:4.3.3 [4,84]
Test ID:pr-xml-utf-16
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support UTF-16 text which relies on Japanese characters. (Also requires ability to process a moderately complex DTD.)

Sections [Rules]:4.3.3 [4,84]
Test ID:pr-xml-utf-8
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for UTF-8 text which relies on Japanese characters. (Also requires ability to process a moderately complex DTD.)

Sections [Rules]:4.3.3 [4,84]
Test ID:weekly-little
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for little-endian UTF-16 encoding, and XML names which contain Japanese characters.

Sections [Rules]:4.3.3 [4,84]
Test ID:weekly-utf-16
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for UTF-16 encoding, and XML names which contain Japanese characters.

Sections [Rules]:4.3.3 [4,84]
Test ID:weekly-utf-8
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for UTF-8 encoding and XML names which contain Japanese characters.

Sections [Rules]:4.3.3 [80]
Test ID:valid-sa-031
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates a valid EncodingDecl within the prolog.

There is an output test associated with this input file.
Sections [Rules]:4.3.3 [81]
Test ID:valid-sa-099
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates the name of the encoding can be composed of lowercase characters.

There is an output test associated with this input file.
Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 whereas the VersionNum of the external DTD is 1.0. The character #xC0 which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v02.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 whereas the VersionNum of the external DTD is 1.0. The character #x1FFF which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v03.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 whereas the VersionNum of the external DTD is 1.0. The character #xF901 which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v04.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 whereas the VersionNum of the external entity is 1.0. The character #xD6 which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v05.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 whereas the VersionNum of the external entity is 1.0. The character #x1FFF which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v06.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 whereas the VersionNum of the external entity is 1.0. The character #xF901 which is a valid XML 1.1 but an invalid XML 1.0 character is present in both documents.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v07.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and external dtd is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #xD8.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v08.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and external dtd is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #x1FFF.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v09.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and external dtd is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #xF901.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v10.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and external entity is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #xF6.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v11.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and external entity is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #x1FFF.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v12.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and external entity is 1.1 and both contain the valid XML1.1 but invalid XML1.0 character #xF901.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v13.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 but the external dtd does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #xF8.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v14.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 but the external dtd does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #x1FFF.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v15.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 but the external dtd does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #xF901.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v16.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 but the external entity does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #x2FF.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v17.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 but the external entity does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #x1FFF.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v18.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 but the external entity does not contain a textDecl and both contain the valid XML1.1 but invalid XML1.0 character #xF901.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v19.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and external dtd is 1.1. The replacement text of an entity declared in the external DTD contains a reference to the character #x7F. This entity is not referenced in the document entity.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v20.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and external dtd is 1.1. The replacement text of an entity declared in the external DTD contains a reference to the character #x80. This entity is not referenced in the document entity.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v21.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and external dtd is 1.1. The replacement text of an entity declared in the external DTD contains a reference to the character #x9F. This entity is not referenced in the document entity.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v22.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and the external entity is 1.1. The entity contains a reference to the character #x7F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v23.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and the external entity is 1.1. The entity contains a reference to the character #x80.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v24.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document and the external entity is 1.1. The entity contains a reference to the character #x9F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v25.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document is 1.1 and the textDecl is missing in the external DTD. The replacement text of an entity declared in the external DTD contains a reference to the character #x7F, #x8F. This entity is not referenced in the document entity.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v26.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document is 1.1 and the textDecl is missing in the external DTD. The replacement text of an entity declared in the external DTD contains a reference to the character #x80, #x90. This entity is not referenced in the document entity.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v27.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document is 1.1 and the textDecl is missing in the external DTD. The replacement text of an entity declared in the external DTD contains a reference to the character #x81, #x9F. This entity is not referenced in the document entity.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v28.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document is 1.1 and the textDecl is missing in the external entity. The replacement text of an entity declared in the external DTD contains a reference to the character #x7F, #x80, #x9F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v29.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document is 1.1 and the textDecl is missing in the external entity. The replacement text of an entity declared in the external DTD contains a reference to the character #x85, #x8F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-valid-P77-ibm77v30.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document is 1.1 and the textDecl is missing in the external entity. The replacement text of an entity declared in the external DTD contains a reference to the character #x1, #x7F.

Sections [Rules]:4.4.2
Test ID:valid-sa-053
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests inclusion of a well-formed internal entity, which holds an element required by the content model.

There is an output test associated with this input file.
Sections [Rules]:4.4.8
Test ID:valid-sa-070
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Verifies that internal parameter entities are correctly expanded within the internal subset.

There is an output test associated with this input file.
Sections [Rules]:4.4.8
Test ID:valid-not-sa-019
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that a parameter entity will be expanded with spaces on either side.

There is an output test associated with this input file.
Sections [Rules]:4.4.8
Test ID:valid-not-sa-020
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Parameter entities expand with spaces on either side.

There is an output test associated with this input file.
Sections [Rules]:4.5
Test ID:valid-sa-065
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests ability to define an internal entity which can't legally be expanded (contains an unquoted <).

There is an output test associated with this input file.
Sections [Rules]:4.5
Test ID:valid-sa-087
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests whether character references in internal entities are expanded early enough, by relying on correct handling to make the entity be well formed.

There is an output test associated with this input file.
Sections [Rules]:4.5
Test ID:valid-sa-088
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests whether entity references in internal entities are expanded late enough, by relying on correct handling to make the expanded text be valid. (If it's expanded too early, the entity will parse as an element that's not valid in that context.)

There is an output test associated with this input file.
Sections [Rules]:4.5
Test ID:valid-sa-101
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

This tests whether entity expansion is (incorrectly) done while processing entity declarations; if it is, the entity value literal will terminate prematurely.

There is an output test associated with this input file.
Sections [Rules]:4.5
Test ID:valid-sa-117
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that entity expansion is done while processing entity declarations.

There is an output test associated with this input file.
Sections [Rules]:4.5
Test ID:valid-sa-118
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test demonstrates that entity expansion is done while processing entity declarations.

There is an output test associated with this input file.
Sections [Rules]:4.5
Test ID:v-pe00
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests construction of internal entity replacement text, using an example in the XML specification.

There is an output test associated with this input file.
Sections [Rules]:4.5
Test ID:v-pe03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests construction of internal entity replacement text, using an example in the XML specification.

There is an output test associated with this input file.
Sections [Rules]:4.5
Test ID:v-pe02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests construction of internal entity replacement text, using a complex example in the XML specification.

There is an output test associated with this input file.
Sections [Rules]:4.7
Test ID:valid-sa-069
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Verifies that an XML parser will parse a NOTATION declaration; the output phase of this test ensures that it's reported to the application.

There is an output test associated with this input file.
Sections [Rules]:4.7
Test ID:ibm-valid-P82-ibm82v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 82

Tests NotationDecl in P82 and PublicID in P83

There is an output test associated with this input file.
Sections [Rules]:4.7 [82]
Test ID:notation01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

NOTATION declarations don't need SYSTEM IDs; and externally declared notations may be used to declare unparsed entities in the internal DTD subset. The notation must be reported to the application.

There is an output test associated with this input file.
Sections [Rules]:B.
Test ID:ibm-valid-P85-ibm85v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

This test case covers 149 legal character ranges plus 51 single legal characters for BaseChar in P85 using a PI target Name

Sections [Rules]:B.
Test ID:ibm-valid-P86-ibm86v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 86

This test case covers 2 legal character ranges plus 1 single legal characters for IdeoGraphic in P86 using a PI target Name

Sections [Rules]:B.
Test ID:ibm-valid-P87-ibm87v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

This test case covers 65 legal character ranges plus 30 single legal characters for CombiningChar in P87 using a PI target Name

Sections [Rules]:B.
Test ID:ibm-valid-P88-ibm88v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

This test case covers 15 legal character ranges for Digit in P88 using a PI target Name

Sections [Rules]:B.
Test ID:ibm-valid-P89-ibm89v01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

This test case covers 3 legal character ranges plus 8 single legal characters for Extender in P89 using a PI target Name

Sections [Rules]:E15
Test ID:rmt-e2e-15e
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Element content can contain entity reference if replacement text is whitespace

Sections [Rules]:E15
Test ID:rmt-e2e-15f
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Element content can contain entity reference if replacement text is whitespace, even if it came from a character reference in the literal entity value

Sections [Rules]:E15
Test ID:rmt-e2e-15i
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Element content can contain a comment

Sections [Rules]:E15
Test ID:rmt-e2e-15j
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Element content can contain a PI

Sections [Rules]:E15
Test ID:rmt-e2e-15k
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Mixed content can contain a comment

Sections [Rules]:E15
Test ID:rmt-e2e-15l
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Mixed content can contain a PI

Sections [Rules]:E18
Test ID:rmt-e2e-18
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

External entity containing start of entity declaration is base URI for system identifier

There is an output test associated with this input file.
Sections [Rules]:E19
Test ID:rmt-e2e-19
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Parameter entities and character references are included-in-literal, but general entities are bypassed.

There is an output test associated with this input file.
Sections [Rules]:E22
Test ID:rmt-e2e-22
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

UTF-8 entities may start with a BOM

Sections [Rules]:E24
Test ID:rmt-e2e-24
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Either the built-in entity or a character reference can be used to represent greater-than after two close-square-brackets

Sections [Rules]:E29
Test ID:rmt-e2e-29
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Three-letter language codes are allowed

Sections [Rules]:E36
Test ID:rmt-e2e-36
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

An external ATTLIST declaration does not make a document non-standalone if the normalization would have been the same without the declaration

Sections [Rules]:E41
Test ID:rmt-e2e-41
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

An xml:lang attribute may be empty

Sections [Rules]:E48
Test ID:rmt-e2e-48
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

ANY content allows character data

Sections [Rules]:E50
Test ID:rmt-e2e-50
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

All line-ends are normalized, even those not passed to the application. NB this can only be tested effectively in XML 1.1, since CR is in the S production; in 1.1 we can use NEL which isn't.

Sections [Rules]:E60
Test ID:rmt-e2e-60
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Conditional sections are allowed in external parameter entities referred to from the internal subset.

Sections [Rules]:E9
Test ID:rmt-e2e-9a
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

An unused attribute default need only be syntactically correct

3.2 Invalid XML Documents

All conforming XML 1.0 Validating Processors are required to report recoverable errors in the case of documents which are Invalid. Such errors are violations of some validity constraint (VC).

If a validating processor does not report an error when given one of these test cases, or if the error reported is a fatal error, it is not conformant. If the error reported does not correspond to the problem listed in this test description, that could also be a conformance problem; it might instead be a faulty diagnostic.

All conforming XML 1.0 Nonvalidating Processors should accept these documents, reporting no errors.

Sections [Rules]:-
Test ID:rmt-ns10-017
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Simple legal case: no namespaces

Sections [Rules]:2
Test ID:rmt-ns10-027
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Reserved prefixes and namespaces: using the xml prefix undeclared

Sections [Rules]:2.1 [1]
Test ID:o-p01pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no prolog

Sections [Rules]:2.1 [1]
Test ID:o-p01pass3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Misc items after the document

Sections [Rules]:2.11
Test ID:rmt-030
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a NEL character in an NMTOKENS attribute; well-formed in both XML 1.0 and 1.1, but valid only in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-032
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has an LSEP character in an NMTOKENS attribute; well-formed in both XML 1.0 and 1.1, but valid only in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-046
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a NEL character in element content whitespace; well-formed in both XML 1.0 and 1.1, but valid only in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.11
Test ID:rmt-048
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has an LSEP character in element content whitespace; well-formed in both XML 1.0 and 1.1, but valid only in 1.1

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-015
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a "long s" in a name, legal in XML 1.1, illegal in XML 1.0

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-017
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a Byzantine Musical Symbol Kratimata in a name, legal in XML 1.1, illegal in XML 1.0

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-018
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has the last legal namechar in XML 1.1, illegal in XML 1.0

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-036
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has an NMTOKENS attribute containing a NEL character that comes from a character reference in an internal entity. Because NEL is not in the S production (even though real NELs are converted to LF on input), this is invalid in both XML 1.0 and 1.1.

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-037
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has an NMTOKENS attribute containing a NEL character that comes from a character reference in an internal entity. Because NEL is not in the S production (even though real NELs are converted to LF on input), this is invalid in both XML 1.0 and 1.1.

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-052
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has element content whitespace containing a NEL character that comes from a character reference in an internal entity. Because NEL is not in the S production (even though real NELs are converted to LF on input), this is invalid in both XML 1.0 and 1.1.

There is an output test associated with this input file.
Sections [Rules]:2.3
Test ID:rmt-053
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has element content whitespace containing a NEL character that comes from a character reference in an internal entity. Because NEL is not in the S production (even though real NELs are converted to LF on input), this is invalid in both XML 1.0 and 1.1.

There is an output test associated with this input file.
Sections [Rules]:2.3 [10]
Test ID:o-p10pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid attribute values

Sections [Rules]:2.3 [3]
Test ID:o-p03pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

all valid S characters

Sections [Rules]:2.3 [4]
Test ID:o-p04pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

names with all valid ASCII characters, and one from each other class in NameChar

Sections [Rules]:2.3 [5]
Test ID:o-p05pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

various valid Name constructions

Sections [Rules]:2.3 [6]
Test ID:o-p06fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Requires at least one name.

Sections [Rules]:2.3 [8]
Test ID:o-p08fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

at least one Nmtoken is required.

Sections [Rules]:2.3 [8]
Test ID:o-p08fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

an invalid Nmtoken character.

Sections [Rules]:2.4 [14]
Test ID:o-p14pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid CharData

Sections [Rules]:2.4 2.7 [18] 3
Test ID:empty
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

CDATA section containing only white space does not match the nonterminal S, and cannot appear in these positions.

Sections [Rules]:2.5 [15]
Test ID:o-p15pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid comments

Sections [Rules]:2.6 [16]
Test ID:o-p16pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid form of Processing Instruction. Shows that whitespace character data is valid before end of processing instruction.

Sections [Rules]:2.6 [16]
Test ID:o-p16pass3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid form of Processing Instruction. Shows that whitespace character data is valid before end of processing instruction.

Sections [Rules]:2.6 [16] [17]
Test ID:o-p16pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid form of Processing Instruction. Shows that whitespace character data is valid before end of processing instruction.

Sections [Rules]:2.7 [18]
Test ID:o-p18pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid CDSect's. Note that a CDStart in a CDSect is not recognized as such

Sections [Rules]:2.8
Test ID:invalid--005
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests the "Proper Declaration/PE Nesting" validity constraint by fragmenting an element declaration between two parameter entities.
Sections [Rules]:2.8
Test ID:invalid--006
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests the "Proper Declaration/PE Nesting" validity constraint by fragmenting an element declaration between two parameter entities.
Sections [Rules]:2.8
Test ID:root
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Root Element Type VC
Sections [Rules]:2.8
Test ID:ibm-invalid-P28-ibm28i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

The test violates VC:Root Element Type in P28. The Name in the document type declaration does not match the element type of the root element.

There is an output test associated with this input file.
Sections [Rules]:2.8 [22]
Test ID:o-p22pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

prolog can be empty

Sections [Rules]:2.8 [22]
Test ID:o-p22pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

XML declaration only

Sections [Rules]:2.8 [22]
Test ID:o-p22pass3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

XML decl and Misc

Sections [Rules]:2.8 [23]
Test ID:o-p23pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows a valid XML declaration along with version info.

Sections [Rules]:2.8 [23]
Test ID:o-p23pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows a valid XML declaration along with encoding declaration.

Sections [Rules]:2.8 [23]
Test ID:o-p23pass3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows a valid XML declaration along with Standalone Document Declaration.

Sections [Rules]:2.8 [23]
Test ID:o-p23pass4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows a valid XML declaration, encoding declarationand Standalone Document Declaration.

Sections [Rules]:2.8 [24]
Test ID:o-p24pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows a prolog that has the VersionInfo delimited by double quotes.

Sections [Rules]:2.8 [24]
Test ID:o-p24pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows a prolog that has the VersionInfo delimited by single quotes.

Sections [Rules]:2.8 [24]
Test ID:o-p24pass3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows whitespace is allowed in prolog before version info.

Sections [Rules]:2.8 [24]
Test ID:o-p24pass4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows whitespace is allowed in prolog on both sides of equal sign.

Sections [Rules]:2.8 [25]
Test ID:o-p25pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows whitespace is NOT necessary before or after equal sign of versioninfo.

Sections [Rules]:2.8 [25]
Test ID:o-p25pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows whitespace can be used on both sides of equal sign of versioninfo.

Sections [Rules]:2.8 [26]
Test ID:o-p26pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

The valid version number. We cannot test others because a 1.0 processor is allowed to fail them.

Sections [Rules]:2.8 [27]
Test ID:o-p27pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Comments are valid as the Misc part of the prolog.

Sections [Rules]:2.8 [27]
Test ID:o-p27pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Processing Instructions are valid as the Misc part of the prolog.

Sections [Rules]:2.8 [27]
Test ID:o-p27pass3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Whitespace is valid as the Misc part of the prolog.

Sections [Rules]:2.8 [27]
Test ID:o-p27pass4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

A combination of comments, whitespaces and processing instructions are valid as the Misc part of the prolog.

Sections [Rules]:2.9
Test ID:inv-not-sa01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that optional whitespace causes a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that attributes needing normalization cause a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that attributes needing defaulting cause a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that a token attribute that needs normalization causes a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa06
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that a NOTATION attribute that needs normalization causes a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa07
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that an NMTOKEN attribute needing normalization causes a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa08
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that an NMTOKENS attribute needing normalization causes a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa09
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that an ID attribute needing normalization causes a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa10
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that an IDREF attribute needing normalization causes a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa11
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that an IDREFS attribute needing normalization causes a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa12
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that an ENTITY attribute needing normalization causes a validity error.
Sections [Rules]:2.9
Test ID:inv-not-sa13
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Standalone Document Declaration VC, ensuring that an ENTITIES attribute needing normalization causes a validity error.
Sections [Rules]:2.9
Test ID:ibm-invalid-P32-ibm32i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

This test violates VC: Standalone Document Declaration in P32. The standalone document declaration has the value yes, BUT there is an external markup declaration of attributes with default values, and the associated element appears in the document with specified values for those attributes.

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:ibm-invalid-P32-ibm32i03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

This test violates VC: Standalone Document Declaration in P32. The standalone document declaration has the value yes, BUT there is an external markup declaration of attributes with values that will change if normalized.

There is an output test associated with this input file.
Sections [Rules]:2.9
Test ID:ibm-invalid-P32-ibm32i04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

This test violates VC: Standalone Document Declaration in P32. The standalone document declaration has the value yes, BUT there is an external markup declaration of element with element content, and white space occurs directly within the mixed content.

There is an output test associated with this input file.
Sections [Rules]:2.9 [32]
Test ID:o-p32pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Double quotes can be used as delimeters for the value of a Standalone Document Declaration.

Sections [Rules]:2.9 [32]
Test ID:o-p32pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Single quotes can be used as delimeters for the value of a Standalone Document Declaration.

Sections [Rules]:3
Test ID:inv-dtd03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Element Valid" VC (clause 2) by omitting a required element.

Sections [Rules]:3
Test ID:el01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 4) by including an undeclared child element.

Sections [Rules]:3
Test ID:el02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 1) by including elements in an EMPTY content model.

Sections [Rules]:3
Test ID:el03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 3) by including a child element not permitted by a mixed content model.

Sections [Rules]:3
Test ID:el06
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 1), using one of the predefined internal entities inside an EMPTY content model.
Sections [Rules]:3
Test ID:inv-not-sa14
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

CDATA sections containing only whitespace do not match the nonterminal S, and cannot appear in these positions.
Sections [Rules]:3
Test ID:optional01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one is required.
Sections [Rules]:3
Test ID:optional02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing two children where one is required.
Sections [Rules]:3
Test ID:optional03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where two are required.
Sections [Rules]:3
Test ID:optional04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where two are required.
Sections [Rules]:3
Test ID:optional05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (one construction of that model).
Sections [Rules]:3
Test ID:optional06
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (a second construction of that model).
Sections [Rules]:3
Test ID:optional07
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (a third construction of that model).
Sections [Rules]:3
Test ID:optional08
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (a fourth construction of that model).
Sections [Rules]:3
Test ID:optional09
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or two are required (a fifth construction of that model).
Sections [Rules]:3
Test ID:optional10
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a basic construction of that model).
Sections [Rules]:3
Test ID:optional11
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a second construction of that model).
Sections [Rules]:3
Test ID:optional12
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a third construction of that model).
Sections [Rules]:3
Test ID:optional13
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a fourth construction of that model).
Sections [Rules]:3
Test ID:optional14
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing three children where one or two are required (a fifth construction of that model).
Sections [Rules]:3
Test ID:optional20
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (a sixth construction of that model).
Sections [Rules]:3
Test ID:optional21
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (a seventh construction of that model).
Sections [Rules]:3
Test ID:optional22
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (an eigth construction of that model).
Sections [Rules]:3
Test ID:optional23
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (a ninth construction of that model).
Sections [Rules]:3
Test ID:optional24
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing no children where one or more are required (a tenth construction of that model).
Sections [Rules]:3
Test ID:optional25
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Element Valid VC (clause 2) for one instance of "children" content model, providing text content where one or more elements are required.
Sections [Rules]:3
Test ID:ibm-invalid-P39-ibm39i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

This test violates VC: Element Valid in P39. Element a is declared empty in DTD, but has content in the document.

There is an output test associated with this input file.
Sections [Rules]:3
Test ID:ibm-invalid-P39-ibm39i02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

This test violates VC: Element Valid in P39. root is declared only having element children in DTD, but have text content in the document.

There is an output test associated with this input file.
Sections [Rules]:3
Test ID:ibm-invalid-P39-ibm39i03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

This test violates VC: Element Valid in P39. Illegal elements are inserted in b's content of Mixed type.

There is an output test associated with this input file.
Sections [Rules]:3
Test ID:ibm-invalid-P39-ibm39i04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

This test violates VC: Element Valid in P39. Element c has undeclared element as its content of ANY type

There is an output test associated with this input file.
Sections [Rules]:3.1
Test ID:ibm-invalid-P41-ibm41i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

This test violates VC: Attribute Value Type in P41. attr1 for Element b is not declared.

There is an output test associated with this input file.
Sections [Rules]:3.1
Test ID:ibm-invalid-P41-ibm41i02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

This test violates VC: Attribute Value Type in P41. attr3 for Element b is given a value that does not match the declaration in the DTD.

There is an output test associated with this input file.
Sections [Rules]:3.1 [40]
Test ID:o-p40pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Elements content can be empty.

Sections [Rules]:3.1 [40]
Test ID:o-p40pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Whitespace is valid within a Start-tag.

Sections [Rules]:3.1 [40]
Test ID:o-p40pass4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Whitespace and Multiple Attributes are valid within a Start-tag.

Sections [Rules]:3.1 [40] [41]
Test ID:o-p40pass3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Attributes are valid within a Start-tag.

Sections [Rules]:3.1 [41]
Test ID:o-p41pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Attributes are valid within a Start-tag.

Sections [Rules]:3.1 [41]
Test ID:o-p41pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Whitespace is valid within a Start-tags Attribute.

Sections [Rules]:3.1 [42]
Test ID:o-p42pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Test shows proper syntax for an End-tag.

Sections [Rules]:3.1 [42]
Test ID:o-p42pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Whitespace is valid after name in End-tag.

Sections [Rules]:3.1 [44]
Test ID:o-p44pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Valid display of an Empty Element Tag.

Sections [Rules]:3.1 [44]
Test ID:o-p44pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Empty Element Tags can contain an Attribute.

Sections [Rules]:3.1 [44]
Test ID:o-p44pass3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Whitespace is valid in an Empty Element Tag following the end of the attribute value.

Sections [Rules]:3.1 [44]
Test ID:o-p44pass4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Whitespace is valid after the name in an Empty Element Tag.

Sections [Rules]:3.1 [44]
Test ID:o-p44pass5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Whitespace and Multiple Attributes are valid in an Empty Element Tag.

Sections [Rules]:3.1 2.10
Test ID:inv-required01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Attribute Value Type (declared) VC for the xml:space attribute
Sections [Rules]:3.1 2.12
Test ID:inv-required02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Attribute Value Type (declared) VC for the xml:lang attribute
Sections [Rules]:3.2
Test ID:el04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Unique Element Type Declaration VC.

Sections [Rules]:3.2
Test ID:ibm-invalid-P45-ibm45i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

This test violates VC: Unique Element Type Declaration. Element not_unique has been declared 3 time in the DTD.

There is an output test associated with this input file.
Sections [Rules]:3.2.1
Test ID:invalid--002
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests the "Proper Group/PE Nesting" validity constraint by fragmenting a content model between two parameter entities.
Sections [Rules]:3.2.1
Test ID:ibm-invalid-P49-ibm49i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 49

Violates VC:Proper Group/PE Nesting in P49. Open and close parenthesis for a choice content model are in different PE replace Texts.

There is an output test associated with this input file.
Sections [Rules]:3.2.1
Test ID:ibm-invalid-P50-ibm50i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 50

Violates VC:Proper Group/PE Nesting in P50. Open and close parenthesis for a seq content model are in different PE replace Texts.

There is an output test associated with this input file.
Sections [Rules]:3.2.1, 2.2
Test ID:ibm-1-1-valid-P46-ibm46i01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite

An element with Element-Only content contains the character #x85 (NEL not a whitespace character as defined by S).

Sections [Rules]:3.2.1, 2.2
Test ID:ibm-1-1-valid-P46-ibm46i02.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite

An element with Element-Only content contains the character #x2028 (LESP not a whitespace character as defined by S).

Sections [Rules]:3.2.2
Test ID:inv-dtd01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the No Duplicate Types VC
Sections [Rules]:3.2.2
Test ID:el05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the No Duplicate Types VC.

Sections [Rules]:3.2.2
Test ID:ibm-invalid-P51-ibm51i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Violates VC:Proper Group/PE Nesting in P51. Open and close parenthesis for a Mixed content model are in different PE replace Texts.

There is an output test associated with this input file.
Sections [Rules]:3.2.2
Test ID:ibm-invalid-P51-ibm51i03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Violates VC:No Duplicate Types in P51. Element a appears twice in the Mixed content model of Element e.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:id01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the ID (is a Name) VC
Sections [Rules]:3.3.1
Test ID:id02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the ID (appears once) VC
Sections [Rules]:3.3.1
Test ID:id03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the One ID per Element Type VC
Sections [Rules]:3.3.1
Test ID:id04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the ID Attribute Default VC
Sections [Rules]:3.3.1
Test ID:id05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the ID Attribute Default VC
Sections [Rules]:3.3.1
Test ID:id06
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the IDREF (is a Name) VC
Sections [Rules]:3.3.1
Test ID:id07
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the IDREFS (is a Names) VC
Sections [Rules]:3.3.1
Test ID:id08
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the IDREF (matches an ID) VC
Sections [Rules]:3.3.1
Test ID:id09
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the IDREF (IDREFS matches an ID) VC
Sections [Rules]:3.3.1
Test ID:attr01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Entity Name" VC for the ENTITY attribute type.
Sections [Rules]:3.3.1
Test ID:attr02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Entity Name" VC for the ENTITIES attribute type.
Sections [Rules]:3.3.1
Test ID:attr03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Notation Attributes" VC for the NOTATION attribute type, first clause: value must be one of the ones that's declared.
Sections [Rules]:3.3.1
Test ID:attr04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Notation Attributes" VC for the NOTATION attribute type, second clause: the names in the declaration must all be declared.
Sections [Rules]:3.3.1
Test ID:attr05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Name Token" VC for the NMTOKEN attribute type.
Sections [Rules]:3.3.1
Test ID:attr06
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Name Token" VC for the NMTOKENS attribute type.
Sections [Rules]:3.3.1
Test ID:attr07
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Enumeration" VC by providing a value which wasn't one of the choices.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: ID. The value of the ID attribute "UniqueName" is "@999" which does not meet the Name production.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: ID. The two ID attributes "attr" and "UniqueName" have the same value "Ac999" for the element "b" and the element "tokenizer".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: ID Attribute Default. The "#FIXED" occurs in the DefaultDecl for the ID attribute "UniqueName".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: ID Attribute Default. The constant string "BOGUS" occurs in the DefaultDecl for the ID attribute "UniqueName".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: One ID per Element Type. The element "a" has two ID attributes "first" and "second".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: IDREF. The value of the IDREF attribute "reference" is "@456" which does not meet the Name production.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: IDREF. The value of the IDREF attribute "reference" is "BC456" which does not match the value assigned to any ID attributes.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: IDREFS. The value of the IDREFS attribute "reference" is "AC456 #567" which does not meet the Names production.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: IDREFS. The value of the IDREFS attribute "reference" is "EF456 DE355" which does not match the values assigned to two ID attributes.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: Entity Name. The value of the ENTITY attribute "sun" is "ima ge" which does not meet the Name production.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: Entity Name. The value of the ENTITY attribute "sun" is "notimage" which does not match the name of any unparsed entity declared.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i13.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: Entity Name. The value of the ENTITY attribute "sun" is "parsedentity" which matches the name of a parsed entity instead of an unparsed entity declared.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i14.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: Entity Name. The value of the ENTITIES attribute "sun" is "#image1 @image" which does not meet the Names production.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i15.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: ENTITIES. The value of the ENTITIES attribute "sun" is "image3 image4" which does not match the names of two unparsed entities declared.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i16.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: ENTITIES. The value of the ENTITIES attribute "sun" is "parsedentity1 parsedentity2" which matches the names of two parsed entities instead of two unparsed entities declared.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i17.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: Name Token. The value of the NMTOKEN attribute "thistoken" is "x : image" which does not meet the Nmtoken production.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P56-ibm56i18.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests invalid TokenizedType which is against P56 VC: Name Token. The value of the NMTOKENS attribute "thistoken" is "@lang y: #country" which does not meet the Nmtokens production.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P58-ibm58i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests invalid NotationType which is against P58 VC: Notation Attributes. The attribute "content-encoding" with value "raw" is not a value from the list "(base64|uuencode)".

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P58-ibm58i02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests invalid NotationType which is against P58 VC: Notation Attributes. The attribute "content-encoding" with value "raw" is a value from the list "(base64|uuencode|raw|ascii)", but "raw" is not a declared notation.

There is an output test associated with this input file.
Sections [Rules]:3.3.1
Test ID:ibm-invalid-P59-ibm59i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 59

Tests invalid Enumeration which is against P59 VC: Enumeration. The value of the attribute is "ONE" which matches neither "one" nor "two" as declared in the Enumeration in the AttDef in the AttlistDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3.1 [58] [59] Errata [E2]
Test ID:o-e2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Validity Constraint: No duplicate tokens

Sections [Rules]:3.3.2
Test ID:inv-required00
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the Required Attribute VC.
Sections [Rules]:3.3.2
Test ID:attr08
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Fixed Attribute Default" VC by providing the wrong value.
Sections [Rules]:3.3.2
Test ID:attr09
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Attribute Default Legal" VC by providing an illegal IDREF value.
Sections [Rules]:3.3.2
Test ID:attr10
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Attribute Default Legal" VC by providing an illegal IDREFS value.
Sections [Rules]:3.3.2
Test ID:attr11
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Attribute Default Legal" VC by providing an illegal ENTITY value.
Sections [Rules]:3.3.2
Test ID:attr12
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Attribute Default Legal" VC by providing an illegal ENTITIES value.
Sections [Rules]:3.3.2
Test ID:attr13
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Attribute Default Legal" VC by providing an illegal NMTOKEN value.
Sections [Rules]:3.3.2
Test ID:attr14
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Attribute Default Legal" VC by providing an illegal NMTOKENS value.
Sections [Rules]:3.3.2
Test ID:attr15
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Attribute Default Legal" VC by providing an illegal NOTATIONS value.
Sections [Rules]:3.3.2
Test ID:attr16
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Attribute Default Legal" VC by providing an illegal enumeration value.
Sections [Rules]:3.3.2
Test ID:ibm-invalid-P60-ibm60i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests invalid DefaultDecl which is against P60 VC: Required Attribute. The attribute "chapter" for the element "two" is declared as #REQUIRED in the DefaultDecl in the AttlistDecl, but the value of this attribute is not given.

There is an output test associated with this input file.
Sections [Rules]:3.3.2
Test ID:ibm-invalid-P60-ibm60i02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests invalid DefaultDecl which is against P60 VC: Fixed Attribute Default.. The attribute "chapter" for the element "one" is declared as #FIXED with the given value "Introduction" in the DefaultDecl in the AttlistDecl, but the value of a instance of this attribute is assigned to "JavaBeans".

There is an output test associated with this input file.
Sections [Rules]:3.3.2
Test ID:ibm-invalid-P60-ibm60i03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests invalid DefaultDecl which is against P60 VC: Attribute Default Legal. The declared default value "c" is not legal for the type (a|b) in the AttDef in the AttlistDecl.

There is an output test associated with this input file.
Sections [Rules]:3.3.2
Test ID:ibm-invalid-P60-ibm60i04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests invalid DefaultDecl which is against P60 VC: Attribute Default Legal. The declared default value "@#$" is not legal for the type NMTOKEN the AttDef in the AttlistDecl.

There is an output test associated with this input file.
Sections [Rules]:3.4 [62]
Test ID:invalid-not-sa-022
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Test the "Proper Conditional Section/ PE Nesting" validity constraint.

There is an output test associated with this input file.
Sections [Rules]:3 3.1 [39] [43]
Test ID:o-p39pass2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Character data is valid element content.

Sections [Rules]:3 3.1 [39] [44]
Test ID:o-p39pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Empty element tag may be used for any element which has no content.

Sections [Rules]:4
Test ID:rmt-ns10-019
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Simple legal case: prefixed element

Sections [Rules]:4
Test ID:rmt-ns10-020
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Simple legal case: prefixed attribute

Sections [Rules]:4.1 [66]
Test ID:o-p66pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid character references

Sections [Rules]:4.2.2
Test ID:inv-dtd02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests the "Notation Declared" VC by using an undeclared notation name.
Sections [Rules]:4.2.2
Test ID:ibm-invalid-P76-ibm76i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 76

Tests invalid NDataDecl which is against P76 VC: Notation declared. The Name "JPGformat" in the NDataDecl in the EntityDecl for "ge2" does not match the Name of any declared notation.

There is an output test associated with this input file.
Sections [Rules]:4.2.2 [75]
Test ID:o-p75pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

valid external identifiers

Sections [Rules]:4.2 [74]
Test ID:o-p74pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

PEDef is either an entity value or an external id

Sections [Rules]:4.3.3 2.8
Test ID:utf16b
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests reading an invalid "big endian" UTF-16 document
Sections [Rules]:4.3.3 2.8
Test ID:utf16l
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Tests reading an invalid "little endian" UTF-16 document
Sections [Rules]:5.1
Test ID:rmt-ns10-024
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Simple legal case: prefix rebinding

Sections [Rules]:5.2
Test ID:rmt-ns10-018
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Simple legal case: default namespace

Sections [Rules]:5.2
Test ID:rmt-ns10-021
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Simple legal case: default namespace and unbinding

Sections [Rules]:5.2
Test ID:rmt-ns10-022
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Simple legal case: default namespace and rebinding

Sections [Rules]:5.3
Test ID:rmt-ns10-037
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Attribute uniqueness: different attributes with same local name

Sections [Rules]:5.3
Test ID:rmt-ns10-038
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Attribute uniqueness: prefixed and unprefixed attributes with same local name

Sections [Rules]:5.3
Test ID:rmt-ns10-039
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Attribute uniqueness: prefixed and unprefixed attributes with same local name, with default namespace

Sections [Rules]:5.3
Test ID:rmt-ns10-040
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Attribute uniqueness: prefixed and unprefixed attributes with same local name, with default namespace and element in default namespace

Sections [Rules]:5.3
Test ID:rmt-ns10-041
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Attribute uniqueness: prefixed and unprefixed attributes with same local name, element in same namespace as prefixed attribute

Sections [Rules]:6.1
Test ID:rmt-ns11-003
RECOMMENDATION:NS1.1
Collection:Richard Tobin's XML Namespaces 1.1 test suite 14 Feb 2003

1.1 style prefix unbinding

Sections [Rules]:6.1
Test ID:rmt-ns11-004
RECOMMENDATION:NS1.1
Collection:Richard Tobin's XML Namespaces 1.1 test suite 14 Feb 2003

1.1 style prefix unbinding and rebinding

Sections [Rules]:E14
Test ID:rmt-e2e-14
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Declarations mis-nested wrt parameter entities are just validity errors (but note that some parsers treat some such errors as fatal)

Sections [Rules]:E15
Test ID:rmt-e2e-15a
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Empty content can't contain an entity reference

Sections [Rules]:E15
Test ID:rmt-e2e-15b
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Empty content can't contain a comment

Sections [Rules]:E15
Test ID:rmt-e2e-15c
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Empty content can't contain a PI

Sections [Rules]:E15
Test ID:rmt-e2e-15d
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Empty content can't contain whitespace

Sections [Rules]:E15
Test ID:rmt-e2e-15g
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Element content can't contain character reference to whitespace

Sections [Rules]:E15
Test ID:rmt-e2e-15h
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Element content can't contain entity reference if replacement text is character reference to whitespace

Sections [Rules]:E2
Test ID:rmt-e2e-2a
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Duplicate token in enumerated attribute declaration

Sections [Rules]:E2
Test ID:rmt-e2e-2b
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Duplicate token in NOTATION attribute declaration

Sections [Rules]:E20
Test ID:rmt-e2e-20
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Tokens, after normalization, must be separated by space, not other whitespace characters

Sections [Rules]:E9
Test ID:rmt-e2e-9b
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

An attribute default must be syntactically correct even if unused

Sections [Rules]:NE05
Test ID:rmt-ns10-028
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Reserved prefixes and namespaces: declaring the xml prefix correctly

Sections [Rules]:NE05
Test ID:rmt-ns10-034
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Reserved prefixes and namespaces: binding a reserved prefix

Sections [Rules]:NE08
Test ID:rmt-ns10-045
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Colon in ID attribute name

Sections [Rules]:NE08
Test ID:rmt-ns10-046
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Colon in ID attribute name

3.3 Documents that are Not Well Formed

All conforming XML 1.0 Processors are required to report fatal errors in the case of documents which are not Well Formed. Such errors are basically of two types: (a) the document violates the XML grammar; or else (b) it violates a well formedness constraint (WFC). There is a single exception to that requirement: nonvalidating processors which do not read certain types of external entities are not required to detect (and hence report) these errors.

If a processor does not report a fatal error when given one of these test cases, it is not conformant. If the error reported does not correspond to the problem listed in this test description, that could also be a conformance problem; it might instead be a faulty diagnostic.

Sections [Rules]:1
Test ID:rmt-ns10-009
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace equality test: plain repetition

Sections [Rules]:1
Test ID:rmt-ns10-010
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace equality test: use of character reference

Sections [Rules]:1
Test ID:rmt-ns10-011
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace equality test: use of entity reference

Sections [Rules]:1
Test ID:rmt-ns10-012
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace inequality test: equal after attribute value normalization

Sections [Rules]:2
Test ID:rmt-ns10-016
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Bad QName syntax: xmlns:

Sections [Rules]:2
Test ID:rmt-ns10-023
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Illegal use of 1.1-style prefix unbinding in 1.0 document

Sections [Rules]:2.1
Test ID:ibm-not-wf-P01-ibm01n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 1

Tests a document with no element. A well-formed document should have at lease one elements.

Sections [Rules]:2.1
Test ID:ibm-not-wf-P01-ibm01n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 1

Tests a document with wrong ordering of its prolog and element. The element occurs before the xml declaration and the DTD.

Sections [Rules]:2.1
Test ID:ibm-not-wf-P01-ibm01n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 1

Tests a document with wrong combination of misc and element. One PI occurs between two elements.

Sections [Rules]:2.1 [1]
Test ID:not-wf-sa-050
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Empty document, with no root element.

Sections [Rules]:2.1 [1]
Test ID:o-p01fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S cannot occur before the prolog

Sections [Rules]:2.1 [1]
Test ID:o-p01fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

comments cannot occur before the prolog

Sections [Rules]:2.1 [1]
Test ID:o-p01fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

only one document element

Sections [Rules]:2.1 [1]
Test ID:o-p01fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

document element must be complete.

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x00

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x01

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x02

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x03

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x04

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x05

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x06

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x07

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x08

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x0B

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x0C

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x0E

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n13.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x0F

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n14.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x10

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n15.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x11

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n16.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x12

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n17.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x13

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n18.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x14

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n19.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x15

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n20.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x16

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n21.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x17

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n22.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x18

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n23.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x19

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n24.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x1A

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n25.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x1B

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n26.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x1C

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n27.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x1D

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n28.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x1E

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n29.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #x1F

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n30.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #xD800

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n31.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #xDFFF

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n32.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #xFFFE

Sections [Rules]:2.2
Test ID:ibm-not-wf-P02-ibm02n33.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 2

Tests a comment which contains an illegal Char: #xFFFF

Sections [Rules]:2.2
Test ID:rmt-011
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a C1 control, legal in XML 1.0, illegal in XML 1.1

Sections [Rules]:2.2
Test ID:rmt-013
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a DEL, legal in XML 1.0, illegal in XML 1.1

Sections [Rules]:2.2
Test ID:rmt-038
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a C0 control character (form-feed), illegal in both XML 1.0 and 1.1

Sections [Rules]:2.2
Test ID:rmt-039
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a C0 control character (form-feed), illegal in both XML 1.0 and 1.1

Sections [Rules]:2.2
Test ID:rmt-041
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a C1 control character (partial line up), legal in XML 1.0 but not 1.1

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x1.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n02.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x2.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n03.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x3.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n04.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x4.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n05.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x5.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n06.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x6.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n07.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x7.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n08.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x8.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n09.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x0.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n10.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x100.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n11.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x0B.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n12.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x0C.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n14.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x0E.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n15.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x0F.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n16.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x10.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n17.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x11.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n18.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x12.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n19.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x13.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n20.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x14.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n21.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x15.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n22.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x16.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n23.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x17.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n24.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x18.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n25.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x19.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n26.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x1A.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n27.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x1B.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n28.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x1C.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n29.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x1D.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n30.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x1E.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n31.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x1F.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n32.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x7F.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n33.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x80.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n34.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x81.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n35.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x82.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n36.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x83.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n37.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x84.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n38.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control characters x82, x83 and x84.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n39.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x86.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n40.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x87.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n41.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x88.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n42.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x89.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n43.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x8A.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n44.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x8B.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n45.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x8C.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n46.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x8D.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n47.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x8E.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n48.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x8F.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n49.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x90.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n50.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x91.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n51.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x92.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n52.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x93.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n53.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x94.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n54.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x95.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n55.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x96.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n56.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x97.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n57.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x98.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n58.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x99.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n59.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x9A.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n60.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x9B.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n61.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x9C.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n62.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x9D.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n63.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control character 0x9E.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n64.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control characters present in an external entity.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n65.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control characters present in an external entity.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n66.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded control characters present in an external entity.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n67.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded character 0xD800. (Invalid UTF8 sequence)

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n68.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded character 0xFFFE.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n69.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains embeded character 0xFFFF.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n70.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains a reference to character 0xFFFE.

Sections [Rules]:2.2,4.1
Test ID:ibm-1-1-not-wf-P02-ibm02n71.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 2

This test contains a reference to character 0xFFFF.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-030
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

A form feed is not a legal XML character.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-031
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

A form feed is not a legal XML character.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-032
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

A form feed is not a legal XML character.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-033
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

An ESC (octal 033) is not a legal XML character.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-034
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

A form feed is not a legal XML character.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-142
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character #x0000 is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-143
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character #x001F is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-144
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character #xFFFF is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-145
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character #xD800 is not legal anywhere in an XML document. (If it appeared in a UTF-16 surrogate pair, it'd represent half of a UCS-4 character and so wouldn't really be in the document.)

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-146
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character references must also refer to legal XML characters; #x00110000 is one more than the largest legal character.
Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-166
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character FFFF is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-167
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character FFFE is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-168
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

An unpaired surrogate (D800) is not legal anywhere in an XML document.
Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-169
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

An unpaired surrogate (DC00) is not legal anywhere in an XML document.
Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-170
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Four byte UTF-8 encodings can encode UCS-4 characters which are beyond the range of legal XML characters (and can't be expressed in Unicode surrogate pairs). This document holds such a character.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-171
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character FFFF is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-172
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character FFFF is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-173
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character FFFF is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-174
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character FFFF is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-175
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character FFFF is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:not-wf-sa-177
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character FFFF is not legal anywhere in an XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail10
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail11
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail12
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail13
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail14
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail15
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail16
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail17
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail18
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail19
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail20
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail21
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail22
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail23
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail24
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail25
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail26
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail27
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail28
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail29
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail30
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail31
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail6
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail7
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail8
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.2 [2]
Test ID:o-p02fail9
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3
Test ID:ibm-not-wf-P03-ibm03n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 3

Tests an end tag which contains an illegal space character #x3000 which follows the element name "book".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x21

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x28

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x29

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x2B

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x2C

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x2F

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x3B

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x3C

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x3D

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x3F

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x5B

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x5C

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n13.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x5D

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n14.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x5E

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n15.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x60

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n16.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x7B

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n17.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x7C

Sections [Rules]:2.3
Test ID:ibm-not-wf-P04-ibm04n18.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element name which contains an illegal ASCII NameChar. "IllegalNameChar" is followed by #x7D

Sections [Rules]:2.3
Test ID:ibm-not-wf-P05-ibm05n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 5

Tests an element name which has an illegal first character. An illegal first character "." is followed by "A_name-starts_with.".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P05-ibm05n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 5

Tests an element name which has an illegal first character. An illegal first character "-" is followed by "A_name-starts_with-".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P05-ibm05n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 5

Tests an element name which has an illegal first character. An illegal first character "5" is followed by "A_name-starts_with_digit".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P09-ibm09n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 9

Tests an internal general entity with an invalid value. The entity "Fullname" contains "%".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P09-ibm09n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 9

Tests an internal general entity with an invalid value. The entity "Fullname" contains the ampersand character.

Sections [Rules]:2.3
Test ID:ibm-not-wf-P09-ibm09n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 9

Tests an internal general entity with an invalid value. The entity "Fullname" contains the double quote character in the middle.

Sections [Rules]:2.3
Test ID:ibm-not-wf-P09-ibm09n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 9

Tests an internal general entity with an invalid value. The closing bracket (double quote) is missing with the value of the entity "FullName".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P10-ibm10n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests an attribute with an invalid value. The value of the attribute "first" contains the character "less than".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P10-ibm10n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests an attribute with an invalid value. The value of the attribute "first" contains the character ampersand.

Sections [Rules]:2.3
Test ID:ibm-not-wf-P10-ibm10n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests an attribute with an invalid value. The value of the attribute "first" contains the double quote character in the middle.

Sections [Rules]:2.3
Test ID:ibm-not-wf-P10-ibm10n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests an attribute with an invalid value. The closing bracket (double quote) is missing with The value of the attribute "first".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P10-ibm10n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests an attribute with an invalid value. The value of the attribute "first" contains the character "less than".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P10-ibm10n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests an attribute with an invalid value. The value of the attribute "first" contains the character ampersand.

Sections [Rules]:2.3
Test ID:ibm-not-wf-P10-ibm10n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests an attribute with an invalid value. The value of the attribute "first" contains the double quote character in the middle.

Sections [Rules]:2.3
Test ID:ibm-not-wf-P10-ibm10n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 10

Tests an attribute with an invalid value. The closing bracket (single quote) is missing with the value of the attribute "first".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P11-ibm11n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 11

Tests SystemLiteral. The systemLiteral for the element "student" has a double quote character in the middle.

Sections [Rules]:2.3
Test ID:ibm-not-wf-P11-ibm11n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 11

Tests SystemLiteral. The systemLiteral for the element "student" has a single quote character in the middle.

Sections [Rules]:2.3
Test ID:ibm-not-wf-P11-ibm11n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 11

Tests SystemLiteral. The closing bracket (double quote) is missing with the systemLiteral for the element "student".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P11-ibm11n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 11

Tests SystemLiteral. The closing bracket (single quote) is missing with the systemLiteral for the element "student".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P12-ibm12n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 12

Tests PubidLiteral. The closing bracket (double quote) is missing with the value of the PubidLiteral for the entity "info".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P12-ibm12n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 12

Tests PubidLiteral. The value of the PubidLiteral for the entity "info" has a single quote character in the middle..

Sections [Rules]:2.3
Test ID:ibm-not-wf-P12-ibm12n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 12

Tests PubidLiteral. The closing bracket (single quote) is missing with the value of the PubidLiteral for the entity "info".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P13-ibm13n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 13

Tests PubidChar. The pubidChar of the PubidLiteral for the entity "info" contains the character "{".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P13-ibm13n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 13

Tests PubidChar. The pubidChar of the PubidLiteral for the entity "info" contains the character "~".

Sections [Rules]:2.3
Test ID:ibm-not-wf-P13-ibm13n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 13

Tests PubidChar. The pubidChar of the PubidLiteral for the entity "info" contains the character double quote in the middle.

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #x300

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n02.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x333

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n03.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x369

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n04.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x37E

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n05.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2000

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n06.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2001

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n07.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2002

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n08.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2005

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n09.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x200B

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n10.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x200E

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n11.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x200F

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n12.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2069

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n13.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2190

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n14.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x23FF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n15.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x280F

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n16.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2A00

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n17.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2EDC

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n18.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2B00

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n19.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x2BFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n20.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0x3000

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n21.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0xD800

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n22.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0xD801

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n23.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0xDAFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n24.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0xDFFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n25.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0xEFFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n26.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0xF1FF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n27.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0xF8FF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04-ibm04n28.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4

Tests an element with an illegal NameStartChar: #0xFFFFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #xB8

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an02.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xA1

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an03.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xAF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an04.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x37E

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an05.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x2000

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an06.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x2001

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an07.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x2002

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an08.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x2005

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an09.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x200B

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an10.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x200E

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an11.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x2038

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an12.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x2041

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an13.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x2190

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an14.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x23FF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an15.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x280F

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an16.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x2A00

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an17.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xFDD0

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an18.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xFDEF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an19.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x2FFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an20.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0x3000

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an21.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xD800

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an22.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xD801

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an23.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xDAFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an24.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xDFFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an25.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xEFFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an26.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xF1FF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an27.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xF8FF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P04a-ibm04an28.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 4a

Tests an element with an illegal NameChar: #0xFFFFF

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P05-ibm05n01.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

Tests an element with an illegal Name containing #0x0B

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P05-ibm05n02.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

Tests an element with an illegal Name containing #0x300

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P05-ibm05n03.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

Tests an element with an illegal Name containing #0x36F

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P05-ibm05n04.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

Tests an element with an illegal Name containing #0x203F

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P05-ibm05n05.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

Tests an element with an illegal Name containing #x2040

Sections [Rules]:2.3
Test ID:ibm-1-1-not-wf-P05-ibm05n06.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 5

Tests an element with an illegal Name containing #0xB7

Sections [Rules]:2.3
Test ID:rmt-014
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a "long s" in a name, legal in XML 1.1, illegal in XML 1.0

Sections [Rules]:2.3
Test ID:rmt-016
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a Byzantine Musical Symbol Kratimata in a name, legal in XML 1.1, illegal in XML 1.0

Sections [Rules]:2.3
Test ID:rmt-019
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has the last legal namechar in XML 1.1, illegal in XML 1.0

Sections [Rules]:2.3
Test ID:rmt-020
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has the first character after the last legal namechar in XML 1.1, illegal in both XML 1.0 and 1.1

Sections [Rules]:2.3
Test ID:rmt-021
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has the first character after the last legal namechar in XML 1.1, illegal in both XML 1.0 and 1.1

Sections [Rules]:2.3 [10]
Test ID:not-wf-sa-012
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

SGML-ism: attribute values must be quoted in all cases.

Sections [Rules]:2.3 [10]
Test ID:not-wf-sa-013
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

The quotes on both ends of an attribute value must match.

Sections [Rules]:2.3 [10]
Test ID:not-wf-sa-014
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Attribute values may not contain literal '<' characters.

Sections [Rules]:2.3 [10]
Test ID:not-wf-sa-020
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Attribute values may not contain literal '&' characters except as part of an entity reference.

Sections [Rules]:2.3 [10]
Test ID:not-wf-sa-021
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Attribute values may not contain literal '&' characters except as part of an entity reference.

Sections [Rules]:2.3 [10]
Test ID:not-wf-sa-088
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Attribute values are terminated by literal quote characters, and any entity expansion is done afterwards.

Sections [Rules]:2.3 [10]
Test ID:not-wf-sa-090
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Attributes may not contain a literal "<" character; this one has one because of reference expansion.

Sections [Rules]:2.3 [10]
Test ID:o-p10fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

attribute values exclude '<'

Sections [Rules]:2.3 [10]
Test ID:o-p10fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

attribute values exclude '&'

Sections [Rules]:2.3 [10]
Test ID:o-p10fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quote types must match

Sections [Rules]:2.3 [11]
Test ID:o-p11fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quote types must match

Sections [Rules]:2.3 [11]
Test ID:o-p11fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

cannot contain delimiting quotes

Sections [Rules]:2.3 [12]
Test ID:pubid01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal entity ref in public ID
Sections [Rules]:2.3 [12]
Test ID:pubid02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal characters in public ID
Sections [Rules]:2.3 [12]
Test ID:pubid03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal characters in public ID
Sections [Rules]:2.3 [12]
Test ID:pubid04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal characters in public ID
Sections [Rules]:2.3 [12]
Test ID:pubid05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML-ism: public ID without system ID
Sections [Rules]:2.3 [12]
Test ID:o-p12fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

'"' excluded

Sections [Rules]:2.3 [12]
Test ID:o-p12fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

'\' excluded

Sections [Rules]:2.3 [12]
Test ID:o-p12fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

entity references excluded

Sections [Rules]:2.3 [12]
Test ID:o-p12fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

'>' excluded

Sections [Rules]:2.3 [12]
Test ID:o-p12fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

'<' excluded

Sections [Rules]:2.3 [12]
Test ID:o-p12fail6
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

built-in entity refs excluded

Sections [Rules]:2.3 [13]
Test ID:not-wf-sa-085
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Public IDs may not contain "[".

Sections [Rules]:2.3 [13]
Test ID:not-wf-sa-086
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Public IDs may not contain "[".

Sections [Rules]:2.3 [13]
Test ID:not-wf-sa-087
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Public IDs may not contain "[".

Sections [Rules]:2.3 [13]
Test ID:o-p12fail7
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

The public ID has a tab character, which is disallowed

Sections [Rules]:2.3 [3]
Test ID:o-p03fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail10
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail11
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail12
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail13
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail14
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail15
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail16
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail17
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail18
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail19
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail20
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail21
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail22
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail23
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail24
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail25
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail26
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail27
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail28
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail29
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail7
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail8
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [3]
Test ID:o-p03fail9
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Use of illegal character within XML document.

Sections [Rules]:2.3 [4]
Test ID:not-wf-sa-002
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Names may not start with "."; it's not a Letter.

Sections [Rules]:2.3 [4]
Test ID:not-wf-sa-140
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character '&#x309a;' is a CombiningChar, not a Letter, and so may not begin a name.
Sections [Rules]:2.3 [4]
Test ID:o-p04fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Name contains invalid character.

Sections [Rules]:2.3 [4]
Test ID:o-p04fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Name contains invalid character.

Sections [Rules]:2.3 [4]
Test ID:o-p04fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Name contains invalid character.

Sections [Rules]:2.3 [5]
Test ID:not-wf-sa-008
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Entity references must include names, which don't begin with '.' (it's not a Letter or other name start character).

Sections [Rules]:2.3 [5]
Test ID:not-wf-sa-023
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Digits are not valid name start characters.

Sections [Rules]:2.3 [5]
Test ID:not-wf-sa-024
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Digits are not valid name start characters.

Sections [Rules]:2.3 [5]
Test ID:not-wf-sa-141
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character #x0E5C is not legal in XML names.

Sections [Rules]:2.3 [5]
Test ID:o-p05fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

a Name cannot start with a digit

Sections [Rules]:2.3 [5]
Test ID:o-p05fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

a Name cannot start with a '.'

Sections [Rules]:2.3 [5]
Test ID:o-p05fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

a Name cannot start with a "-"

Sections [Rules]:2.3 [5]
Test ID:o-p05fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

a Name cannot start with a CombiningChar

Sections [Rules]:2.3 [5]
Test ID:o-p05fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

a Name cannot start with an Extender

Sections [Rules]:2.3 [9]
Test ID:not-wf-sa-113
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Parameter entity values must use valid reference syntax; this reference is malformed.
Sections [Rules]:2.3 [9]
Test ID:not-wf-sa-114
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

General entity values must use valid reference syntax; this reference is malformed.
Sections [Rules]:2.3 [9]
Test ID:not-wf-sa-159
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Uses '&' unquoted in an entity declaration, which is illegal syntax for an entity reference.
Sections [Rules]:2.3 [9]
Test ID:o-p09fail1
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

EntityValue excludes '%'

Sections [Rules]:2.3 [9]
Test ID:o-p09fail2
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

EntityValue excludes '&'

Sections [Rules]:2.3 [9]
Test ID:o-p09fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

incomplete character reference

Sections [Rules]:2.3 [9]
Test ID:o-p09fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quote types must match

Sections [Rules]:2.3 [9]
Test ID:o-p09fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quote types must match

Sections [Rules]:2.4
Test ID:ibm-not-wf-P14-ibm14n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 14

Tests CharData. The content of the element "student" contains the character "[[>".

Sections [Rules]:2.4
Test ID:ibm-not-wf-P14-ibm14n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 14

Tests CharData. The content of the element "student" contains the character "less than".

Sections [Rules]:2.4
Test ID:ibm-not-wf-P14-ibm14n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 14

Tests CharData. The content of the element "student" contains the character ampersand.

Sections [Rules]:2.4 [14]
Test ID:not-wf-sa-025
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Text may not contain a literal ']]>' sequence.

Sections [Rules]:2.4 [14]
Test ID:not-wf-sa-026
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Text may not contain a literal ']]>' sequence.

Sections [Rules]:2.4 [14]
Test ID:not-wf-sa-029
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Text may not contain a literal ']]>' sequence.

Sections [Rules]:2.4 [14]
Test ID:o-p14fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

'<' excluded

Sections [Rules]:2.4 [14]
Test ID:o-p14fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

'&' excluded

Sections [Rules]:2.4 [14]
Test ID:o-p14fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

"]]>" excluded

Sections [Rules]:2.5
Test ID:ibm-not-wf-P15-ibm15n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 15

Tests comment. The text of the second comment contains the character "-".

Sections [Rules]:2.5
Test ID:ibm-not-wf-P15-ibm15n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 15

Tests comment. The second comment has a wrong closing sequence "-(greater than)".

Sections [Rules]:2.5
Test ID:ibm-not-wf-P15-ibm15n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 15

Tests comment. The second comment has a wrong beginning sequence "(less than)!-".

Sections [Rules]:2.5
Test ID:ibm-not-wf-P15-ibm15n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 15

Tests comment. The closing sequence is missing with the second comment.

Sections [Rules]:2.5 [15]
Test ID:not-wf-sa-027
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Comments must be terminated with "-->".
Sections [Rules]:2.5 [15]
Test ID:sgml03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Comments may not contain "--"
Sections [Rules]:2.5 [15]
Test ID:o-p15fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

comments can't end in '-'

Sections [Rules]:2.5 [15]
Test ID:o-p15fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

one comment per comment (contrasted with SGML)

Sections [Rules]:2.5 [15]
Test ID:o-p15fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

can't include 2 or more adjacent '-'s

Sections [Rules]:2.5 [16]
Test ID:not-wf-sa-006
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

XML comments may not contain "--"

Sections [Rules]:2.5 [16]
Test ID:not-wf-sa-070
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

XML comments may not contain "--"

Sections [Rules]:2.6
Test ID:ibm-not-wf-P16-ibm16n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 16

Tests PI. The content of the PI includes the sequence "(less than)?".

Sections [Rules]:2.6
Test ID:ibm-not-wf-P16-ibm16n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 16

Tests PI. The PITarget is missing in the PI.

Sections [Rules]:2.6
Test ID:ibm-not-wf-P16-ibm16n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 16

Tests PI. The PI has a wrong closing sequence ">".

Sections [Rules]:2.6
Test ID:ibm-not-wf-P16-ibm16n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 16

Tests PI. The closing sequence is missing in the PI.

Sections [Rules]:2.6
Test ID:ibm-not-wf-P17-ibm17n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 17

Tests PITarget. The PITarget contains the string "XML".

Sections [Rules]:2.6
Test ID:ibm-not-wf-P17-ibm17n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 17

Tests PITarget. The PITarget contains the string "xML".

Sections [Rules]:2.6
Test ID:ibm-not-wf-P17-ibm17n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 17

Tests PITarget. The PITarget contains the string "xml".

Sections [Rules]:2.6
Test ID:ibm-not-wf-P17-ibm17n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 17

Tests PITarget. The PITarget contains the string "xmL".

Sections [Rules]:2.6 [16]
Test ID:not-wf-sa-003
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Processing Instruction target name is required.
Sections [Rules]:2.6 [16]
Test ID:not-wf-sa-004
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

SGML-ism: processing instructions end in '?>' not '>'.

Sections [Rules]:2.6 [16]
Test ID:not-wf-sa-005
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Processing instructions end in '?>' not '?'.

Sections [Rules]:2.6 [16]
Test ID:not-wf-sa-028
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Processing instructions must end with '?>'.

Sections [Rules]:2.6 [16]
Test ID:pi
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

No space between PI target name and data
Sections [Rules]:2.6 [16]
Test ID:o-p16fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

"xml" is an invalid PITarget

Sections [Rules]:2.6 [16]
Test ID:o-p16fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

a PITarget must be present

Sections [Rules]:2.6 [16]
Test ID:o-p16fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S after PITarget is required

Sections [Rules]:2.6 [17]
Test ID:not-wf-sa-157
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

'<?xmL ...?>' is not a legal processing instruction target name.

Sections [Rules]:2.6 [17]
Test ID:not-wf-not-sa-002
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

Processing instruction target names may not be "XML" in any combination of cases.

Sections [Rules]:2.6 [17]
Test ID:not-wf-ext-sa-003
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

Only one text declaration is permitted; a second one looks like an illegal processing instruction (target names of "xml" in any case are not allowed).

Sections [Rules]:2.7
Test ID:ibm-not-wf-P18-ibm18n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 18

Tests CDSect. The CDStart is missing in the CDSect in the content of element "student".

Sections [Rules]:2.7
Test ID:ibm-not-wf-P18-ibm18n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 18

Tests CDSect. The CDEnd is missing in the CDSect in the content of element "student".

Sections [Rules]:2.7
Test ID:ibm-not-wf-P19-ibm19n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 19

Tests CDStart. The CDStart contains a lower case string "cdata".

Sections [Rules]:2.7
Test ID:ibm-not-wf-P19-ibm19n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 19

Tests CDStart. The CDStart contains an extra character "[".

Sections [Rules]:2.7
Test ID:ibm-not-wf-P19-ibm19n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 19

Tests CDStart. The CDStart contains a wrong character "?".

Sections [Rules]:2.7
Test ID:ibm-not-wf-P20-ibm20n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 20

Tests CDATA with an illegal sequence. The CDATA contains the string "[[>".

Sections [Rules]:2.7
Test ID:ibm-not-wf-P21-ibm21n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 21

Tests CDEnd. One "]" is missing in the CDEnd.

Sections [Rules]:2.7
Test ID:ibm-not-wf-P21-ibm21n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 21

Tests CDEnd. An extra "]" is placed in the CDEnd.

Sections [Rules]:2.7
Test ID:ibm-not-wf-P21-ibm21n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 21

Tests CDEnd. A wrong character ")" is placed in the CDEnd.

Sections [Rules]:2.7
Test ID:not-wf-sa-105
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid placement of CDATA section.

Sections [Rules]:2.7 [18]
Test ID:not-wf-sa-017
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

CDATA sections need a terminating ']]>'.

Sections [Rules]:2.7 [18]
Test ID:not-wf-sa-051
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

CDATA is invalid at top level of document.
Sections [Rules]:2.7 [18]
Test ID:not-wf-sa-128
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid CDATA syntax.

Sections [Rules]:2.7 [18]
Test ID:o-p18fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no space before "CDATA"

Sections [Rules]:2.7 [18]
Test ID:o-p18fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no space after "CDATA"

Sections [Rules]:2.7 [18]
Test ID:o-p18fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

CDSect's can't nest

Sections [Rules]:2.7 [19]
Test ID:not-wf-sa-018
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

CDATA sections begin with a literal '<![CDATA[', no space.
Sections [Rules]:2.7 [19]
Test ID:not-wf-sa-108
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

No space in '<![CDATA['.
Sections [Rules]:2.7 [19]
Test ID:not-wf-sa-112
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

CDATA sections start '<![CDATA[', not '<!cdata['.
Sections [Rules]:2.8
Test ID:not-wf-sa-160
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Violates the PEs in Internal Subset WFC by using a PE reference within a declaration.

Sections [Rules]:2.8
Test ID:not-wf-sa-161
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Violates the PEs in Internal Subset WFC by using a PE reference within a declaration.

Sections [Rules]:2.8
Test ID:not-wf-sa-162
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Violates the PEs in Internal Subset WFC by using a PE reference within a declaration.

Sections [Rules]:2.8
Test ID:not-wf-not-sa-009
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

This test violates WFC:PE Between Declarations in Production 28a. The last character of a markup declaration is not contained in the same parameter-entity text replacement.
Sections [Rules]:2.8
Test ID:ibm-not-wf-P22-ibm22n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with wrong field ordering. The XMLDecl occurs after the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P22-ibm22n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with wrong field ordering. The Misc (comment) occurs before the XMLDecl.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P22-ibm22n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 22

Tests prolog with wrong field ordering. The XMLDecl occurs after the DTD and a comment. The other comment occurs before the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P23-ibm23n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with a required field missing. The Versioninfo is missing in the XMLDecl.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P23-ibm23n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with wrong field ordering. The VersionInfo occurs after the EncodingDecl.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P23-ibm23n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with wrong field ordering. The VersionInfo occurs after the SDDecl and the SDDecl occurs after the VersionInfo.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P23-ibm23n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with wrong key word. An upper case string "XML" is used as the key word in the XMLDecl.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P23-ibm23n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with a wrong closing sequence ">".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P23-ibm23n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 23

Tests XMLDecl with a wrong opening sequence "(less than)!".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P24-ibm24n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with a required field missing. The VersionNum is missing in the VersionInfo in the XMLDecl.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P24-ibm24n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with a required field missing. The white space is missing between the key word "xml" and the VersionInfo in the XMLDecl.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P24-ibm24n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with a required field missing. The "=" (equal sign) is missing between the key word "version" and the VersionNum.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P24-ibm24n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with wrong field ordering. The VersionNum occurs before "=" and "version".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P24-ibm24n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with wrong field ordering. The "=" occurs after "version" and the VersionNum.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P24-ibm24n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with the wrong key word "Version".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P24-ibm24n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with the wrong key word "versioN".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P24-ibm24n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with mismatched quotes around the VersionNum. version = '1.0" is used as the VersionInfo.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P24-ibm24n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 24

Tests VersionInfo with mismatched quotes around the VersionNum. The closing bracket for the VersionNum is missing.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P25-ibm25n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 25

Tests eq with a wrong key word "==".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P25-ibm25n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 25

Tests eq with a wrong key word "eq".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P26-ibm26n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 26

Tests VersionNum with an illegal character "#".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P27-ibm27n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 27

Tests type of Misc. An element declaration is used as a type of Misc After the element "animal".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P28-ibm28n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with a required field missing. The Name "animal" is missing in the doctypedecl.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P28-ibm28n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with wrong field ordering. The Name "animal" occurs after the markup declarations inside the "[]".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P28-ibm28n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with wrong field ordering. The Name "animal" occurs after the markup declarations inside the "[]".

Sections [Rules]:2.8
Test ID:ibm-not-wf-P28-ibm28n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with general entity reference.The "(ampersand)generalE" occurs in the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P28-ibm28n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with wrong key word. A wrong key word "DOCtYPE" occurs on line 2.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P28-ibm28n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with mismatched brackets. The closing bracket "]" of the DTD is missing.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P28-ibm28n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with wrong bracket. The opening bracket "}" occurs in the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P28-ibm28n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 28

Tests doctypedecl with wrong opening sequence. The opening sequence "(less than)?DOCTYPE" occurs in the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-p28a-ibm28an01.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 28a

This test violates WFC:PE Between Declarations in Production 28a. The last character of a markup declaration is not contained in the same parameter-entity text replacement.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P29-ibm29n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 29

Tests markupdecl with an illegal markup declaration. A XMLDecl occurs inside the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P29-ibm29n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 29

Tests WFC "PEs in Internal Subset". A PE reference occurs inside an elementdecl in the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P29-ibm29n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 29

Tests WFC "PEs in Internal Subset". A PE reference occurs inside an ATTlistDecl in the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P29-ibm29n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 29

Tests WFC "PEs in Internal Subset". A PE reference occurs inside an EntityDecl in the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P29-ibm29n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 29

Tests WFC "PEs in Internal Subset". A PE reference occurs inside a PI in the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P29-ibm29n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 29

Tests WFC "PEs in Internal Subset". A PE reference occurs inside a comment in the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P29-ibm29n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 29

Tests WFC "PEs in Internal Subset". A PE reference occurs inside a NotationDecl in the DTD.

Sections [Rules]:2.8
Test ID:ibm-not-wf-P30-ibm30n01.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 30

Tests extSubset with wrong field ordering. In the file "ibm30n01.dtd", the TextDecl occurs after the extSubsetDecl (the element declaration).

Sections [Rules]:2.8
Test ID:ibm-not-wf-P31-ibm31n01.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 31

Tests extSubsetDecl with an illegal field. A general entity reference occurs in file "ibm31n01.dtd".

Sections [Rules]:2.8
Test ID:sgml02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

XML declaration must be at the very beginning of a document; it"s not a processing instruction
Sections [Rules]:2.8 [22]
Test ID:not-wf-sa-147
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

XML Declaration may not be preceded by whitespace.
Sections [Rules]:2.8 [22]
Test ID:not-wf-sa-148
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

XML Declaration may not be preceded by comments or whitespace.
Sections [Rules]:2.8 [22]
Test ID:not-wf-sa-152
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

XML declarations must include the "version=..." string.
Sections [Rules]:2.8 [22]
Test ID:o-p22fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

prolog must start with XML decl

Sections [Rules]:2.8 [22]
Test ID:o-p22fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

prolog must start with XML decl

Sections [Rules]:2.8 [23]
Test ID:not-wf-sa-095
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

VersionInfo must come before EncodingDecl.

Sections [Rules]:2.8 [23]
Test ID:not-wf-sa-098
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Only one "version=..." string may appear in an XML declaration.
Sections [Rules]:2.8 [23]
Test ID:not-wf-sa-099
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Only three pseudo-attributes are in the XML declaration, and "valid=..." is not one of them.

Sections [Rules]:2.8 [23]
Test ID:o-p23fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

"xml" must be lower-case

Sections [Rules]:2.8 [23]
Test ID:o-p23fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

VersionInfo must be supplied

Sections [Rules]:2.8 [23]
Test ID:o-p23fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

VersionInfo must come first

Sections [Rules]:2.8 [23]
Test ID:o-p23fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

SDDecl must come last

Sections [Rules]:2.8 [23]
Test ID:o-p23fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no SGML-type PIs

Sections [Rules]:2.8 [23]
Test ID:o-p39fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

XML declarations must be correctly terminated

Sections [Rules]:2.8 [23]
Test ID:o-p39fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

XML declarations must be correctly terminated

Sections [Rules]:2.8 [24]
Test ID:not-wf-sa-094
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Prolog VERSION must be lowercase.

Sections [Rules]:2.8 [24]
Test ID:not-wf-sa-097
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Both quotes surrounding VersionNum must be the same.

Sections [Rules]:2.8 [24]
Test ID:o-p24fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quote types must match

Sections [Rules]:2.8 [24]
Test ID:o-p24fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quote types must match

Sections [Rules]:2.8 [25]
Test ID:o-p25fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Comment is illegal in VersionInfo.

Sections [Rules]:2.8 [26]
Test ID:not-wf-sa-102
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Provides an illegal XML version number; spaces are illegal.
Sections [Rules]:2.8 [26]
Test ID:o-p26fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Illegal character in VersionNum.

Sections [Rules]:2.8 [26]
Test ID:o-p26fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Illegal character in VersionNum.

Sections [Rules]:2.8 [27]
Test ID:not-wf-sa-036
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Text may not appear after the root element.

Sections [Rules]:2.8 [27]
Test ID:not-wf-sa-037
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character references may not appear after the root element.

Sections [Rules]:2.8 [27]
Test ID:not-wf-sa-040
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Provides two document elements.
Sections [Rules]:2.8 [27]
Test ID:not-wf-sa-041
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Provides two document elements.
Sections [Rules]:2.8 [27]
Test ID:not-wf-sa-043
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Provides #PCDATA text after the document element.

Sections [Rules]:2.8 [27]
Test ID:not-wf-sa-044
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Provides two document elements.
Sections [Rules]:2.8 [27]
Test ID:not-wf-sa-048
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Provides a CDATA section after the roor element.
Sections [Rules]:2.8 [27]
Test ID:not-wf-sa-151
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

XML declarations may not follow document content.
Sections [Rules]:2.8 [27]
Test ID:o-p27fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

References aren't allowed in Misc, even if they would resolve to valid Misc.

Sections [Rules]:2.8 [28]
Test ID:not-wf-sa-055
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid Document Type Definition format.

Sections [Rules]:2.8 [28]
Test ID:not-wf-sa-056
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid Document Type Definition format - misplaced comment.

Sections [Rules]:2.8 [28]
Test ID:not-wf-sa-107
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid document type declaration. CDATA alone is invalid.
Sections [Rules]:2.8 [28]
Test ID:not-wf-sa-149
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

XML Declaration may not be within a DTD.
Sections [Rules]:2.8 [28]
Test ID:o-p28fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

only declarations in DTD.

Sections [Rules]:2.8 [29]
Test ID:not-wf-sa-063
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Conditional sections may only appear in the external DTD subset.

Sections [Rules]:2.8 [29]
Test ID:o-p29fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

A processor must not pass unknown declaration types.

Sections [Rules]:2.8 [30]
Test ID:o-p30fail1
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

An XML declaration is not the same as a TextDecl

Sections [Rules]:2.8 [31]
Test ID:o-p31fail1
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

external subset excludes doctypedecl

Sections [Rules]:2.8 2.6 [23, 17]
Test ID:not-wf-sa-154
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

'<?XML ...?>' is neither an XML declaration nor a legal processing instruction target name.

Sections [Rules]:2.8 2.6 [23, 17]
Test ID:not-wf-sa-155
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

'<?xmL ...?>' is neither an XML declaration nor a legal processing instruction target name.

Sections [Rules]:2.8 2.6 [23, 17]
Test ID:not-wf-sa-156
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

'<?xMl ...?>' is neither an XML declaration nor a legal processing instruction target name.

Sections [Rules]:2.8 4.3.4
Test ID:rmt-001
RECOMMENDATION:XML1.1
Entities:parameter
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

External subset has later version number

Sections [Rules]:2.8 4.3.4
Test ID:rmt-002
RECOMMENDATION:XML1.1
Entities:parameter
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

External PE has later version number

Sections [Rules]:2.8 4.3.4
Test ID:rmt-003
RECOMMENDATION:XML1.1
Entities:general
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

External general entity has later version number

Sections [Rules]:2.8 4.3.4
Test ID:rmt-004
RECOMMENDATION:XML1.1
Entities:general
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

External general entity has later version number (no decl means 1.0)

Sections [Rules]:2.8 4.3.4
Test ID:rmt-005
RECOMMENDATION:XML1.1
Entities:general
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Indirect external general entity has later version number

Sections [Rules]:2.9
Test ID:not-wf-sa03
RECOMMENDATION:XML1.0
Entities:parameter
Collection:Sun Microsystems XML Tests

Tests the Entity Declared WFC, ensuring that a reference to externally defined entity causes a well-formedness error.
Sections [Rules]:2.9
Test ID:ibm-not-wf-P32-ibm32n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests SDDecl with a required field missing. The leading white space is missing with the SDDecl in the XMLDecl.

Sections [Rules]:2.9
Test ID:ibm-not-wf-P32-ibm32n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests SDDecl with a required field missing. The "=" sign is missing in the SDDecl in the XMLDecl.

Sections [Rules]:2.9
Test ID:ibm-not-wf-P32-ibm32n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests SDDecl with wrong key word. The word "Standalone" occurs in the SDDecl in the XMLDecl.

Sections [Rules]:2.9
Test ID:ibm-not-wf-P32-ibm32n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests SDDecl with wrong key word. The word "Yes" occurs in the SDDecl in the XMLDecl.

Sections [Rules]:2.9
Test ID:ibm-not-wf-P32-ibm32n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests SDDecl with wrong key word. The word "YES" occurs in the SDDecl in the XMLDecl.

Sections [Rules]:2.9
Test ID:ibm-not-wf-P32-ibm32n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests SDDecl with wrong key word. The word "No" occurs in the SDDecl in the XMLDecl.

Sections [Rules]:2.9
Test ID:ibm-not-wf-P32-ibm32n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests SDDecl with wrong key word. The word "NO" occurs in the SDDecl in the XMLDecl.

Sections [Rules]:2.9
Test ID:ibm-not-wf-P32-ibm32n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 32

Tests SDDecl with wrong field ordering. The "=" sign occurs after the key word "yes" in the SDDecl in the XMLDecl.

Sections [Rules]:2.9
Test ID:ibm-not-wf-P32-ibm32n09.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 32

This is test violates WFC: Entity Declared in P68. The standalone document declaration has the value yes, BUT there is an external markup declaration of an entity (other than amp, lt, gt, apos, quot), and references to this entity appear in the document.

Sections [Rules]:2.9 [32]
Test ID:not-wf-sa-096
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Space is required before the standalone declaration.

Sections [Rules]:2.9 [32]
Test ID:not-wf-sa-100
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Only "yes" and "no" are permitted as values of "standalone".

Sections [Rules]:2.9 [32]
Test ID:o-p32fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quote types must match

Sections [Rules]:2.9 [32]
Test ID:o-p32fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quote types must match

Sections [Rules]:2.9 [32]
Test ID:o-p32fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

initial S is required

Sections [Rules]:2.9 [32]
Test ID:o-p32fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quotes are required

Sections [Rules]:2.9 [32]
Test ID:o-p32fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

yes or no must be lower case

Sections [Rules]:3
Test ID:not-wf-sa-039
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests the Element Type Match WFC - end tag name must match start tag name.
Sections [Rules]:3
Test ID:ibm-not-wf-P39-ibm39n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

Tests element with a required field missing. The ETag is missing for the element "root".

Sections [Rules]:3
Test ID:ibm-not-wf-P39-ibm39n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

Tests element with a required field missing. The STag is missing for the element "root".

Sections [Rules]:3
Test ID:ibm-not-wf-P39-ibm39n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

Tests element with required fields missing. Both the content and the ETag are missing in the element "root".

Sections [Rules]:3
Test ID:ibm-not-wf-P39-ibm39n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

Tests element with required fields missing. Both the content and the STag are missing in the element "root".

Sections [Rules]:3
Test ID:ibm-not-wf-P39-ibm39n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

Tests element with wrong field ordering. The STag and the ETag are swapped in the element "root".

Sections [Rules]:3
Test ID:ibm-not-wf-P39-ibm39n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 39

Tests element with wrong field ordering. The content occurs after the ETag of the element "root".

Sections [Rules]:3
Test ID:rmt-ns10-013
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Bad QName syntax: multiple colons

Sections [Rules]:3
Test ID:rmt-ns10-014
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Bad QName syntax: colon at end

Sections [Rules]:3
Test ID:rmt-ns10-015
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Bad QName syntax: colon at start

Sections [Rules]:3.1
Test ID:not-wf-sa-038
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests the "Unique Att Spec" WF constraint by providing multiple values for an attribute.
Sections [Rules]:3.1
Test ID:not-wf-sa-081
RECOMMENDATION:XML1.0
Entities:general
Collection:James Clark XMLTEST cases, 18-Nov-1998

This tests the No External Entity References WFC, since the entity is referred to within an attribute.

Sections [Rules]:3.1
Test ID:not-wf-sa-082
RECOMMENDATION:XML1.0
Entities:general
Collection:James Clark XMLTEST cases, 18-Nov-1998

This tests the No External Entity References WFC, since the entity is referred to within an attribute.

Sections [Rules]:3.1
Test ID:ibm-not-wf-P40-ibm40n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 40

Tests STag with a required field missing. The Name "root" is in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P40-ibm40n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 40

Tests STag with a required field missing. The white space between the Name "root" and the attribute "attr1" is missing in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P40-ibm40n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 40

Tests STag with wrong field ordering. The Name "root" occurs after the attribute "attr1" in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P40-ibm40n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 40

Tests STag with a wrong opening sequence. The string "(less than)!" is used as the opening sequence for the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P40-ibm40n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 40

Tests STag with duplicate attribute names. The attribute name "attr1" occurs twice in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with a required field missing. The attribute name is missing in the Attribute in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with a required field missing. The "=" is missing between the attribute name and the attribute value in the Attribute in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with a required field missing. The AttValue is missing in the Attribute in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with a required field missing. The Name and the "=" are missing in the Attribute in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with a required field missing. The "=" and the AttValue are missing in the Attribute in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with a required field missing. The Name and the AttValue are missing in the Attribute in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with wrong field ordering. The "=" occurs after the Name and the AttValue in the Attribute in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with wrong field ordering. The Name and the AttValue are swapped in the Attribute in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute with wrong field ordering. The "=" occurs before the Name and the AttValue in the Attribute in the STag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute against WFC "no external entity references". A direct references to the external entity "aExternal" is contained in the value of the attribute "attr1".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute against WFC "no external entity references". A indirect references to the external entity "aExternal" is contained in the value of the attribute "attr1".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute against WFC "no external entity references". A direct references to the external unparsed entity "aImage" is contained in the value of the attribute "attr1".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n13.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute against WFC "No (less that) character in Attribute Values". The character "less than" is contained in the value of the attribute "attr1".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P41-ibm41n14.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 41

Tests Attribute against WFC "No (less than) in Attribute Values". The character "less than" is contained in the value of the attribute "attr1" through indirect internal entity reference.

Sections [Rules]:3.1
Test ID:ibm-not-wf-P42-ibm42n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 42

Tests ETag with a required field missing. The Name is missing in the ETag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P42-ibm42n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 42

Tests ETag with a wrong beginning sequence. The string "(less than)\" is used as a beginning sequence of the ETag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P42-ibm42n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 42

Tests ETag with a wrong beginning sequence. The string "less than" is used as a beginning sequence of the ETag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P42-ibm42n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 42

Tests ETag with a wrong structure. An white space occurs between The beginning sequence and the Name of the ETag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P42-ibm42n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 42

Tests ETag with a wrong structure. The ETag of the element "root" contains an Attribute (attr1="any").

Sections [Rules]:3.1
Test ID:ibm-not-wf-P43-ibm43n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 43

Tests element content with a wrong option. A NotationDecl is used as the content of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P43-ibm43n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 43

Tests element content with a wrong option. A elementdecl is used as the content of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P43-ibm43n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 43

Tests element content with a wrong option. An elementdecl is used as the content of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P43-ibm43n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 43

Tests element content with a wrong option. An AttlistDecl is used as the content of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P44-ibm44n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 44

Tests EmptyElemTag with a required field missing. The Name "root" is missing in the EmptyElemTag.

Sections [Rules]:3.1
Test ID:ibm-not-wf-P44-ibm44n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 44

Tests EmptyElemTag with wrong field ordering. The Attribute (attri1 = "any") occurs before the name of the element "root" in the EmptyElemTag.

Sections [Rules]:3.1
Test ID:ibm-not-wf-P44-ibm44n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 44

Tests EmptyElemTag with wrong closing sequence. The string "\>" is used as the closing sequence in the EmptyElemtag of the element "root".

Sections [Rules]:3.1
Test ID:ibm-not-wf-P44-ibm44n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 44

Tests EmptyElemTag which against the WFC "Unique Att Spec". The attribute name "attr1" occurs twice in the EmptyElemTag of the element "root".

Sections [Rules]:3.1 [40]
Test ID:not-wf-sa-046
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

This start (or empty element) tag was not terminated correctly.

Sections [Rules]:3.1 [40]
Test ID:not-wf-sa-049
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Missing start tag

Sections [Rules]:3.1 [40]
Test ID:attlist10
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Whitespace required between attributes
Sections [Rules]:3.1 [40]
Test ID:o-p40fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required between attributes

Sections [Rules]:3.1 [40]
Test ID:o-p40fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

tags start with names, not nmtokens

Sections [Rules]:3.1 [40]
Test ID:o-p40fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

tags start with names, not nmtokens

Sections [Rules]:3.1 [40]
Test ID:o-p40fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no space before name

Sections [Rules]:3.1 [41]
Test ID:not-wf-sa-001
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Attribute values must start with attribute names, not "?".

Sections [Rules]:3.1 [41]
Test ID:not-wf-sa-011
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

SGML-ism: attribute values must be explicitly assigned a value, it can't act as a boolean toggle.

Sections [Rules]:3.1 [41]
Test ID:not-wf-sa-015
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Attribute values need a value, not just an equals sign.

Sections [Rules]:3.1 [41]
Test ID:not-wf-sa-016
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Attribute values need an associated name.
Sections [Rules]:3.1 [41]
Test ID:not-wf-sa-178
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax matching double quote is missing.

Sections [Rules]:3.1 [41]
Test ID:o-p41fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

quotes are required (contrast with SGML)

Sections [Rules]:3.1 [41]
Test ID:o-p41fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

attribute name is required (contrast with SGML)

Sections [Rules]:3.1 [41]
Test ID:o-p41fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Eq required

Sections [Rules]:3.1 [42]
Test ID:not-wf-sa-019
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

End tags may not be abbreviated as '</>'.
Sections [Rules]:3.1 [42]
Test ID:not-wf-sa-042
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid End Tag

Sections [Rules]:3.1 [42]
Test ID:not-wf-sa-053
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

End tag does not match start tag.

Sections [Rules]:3.1 [42]
Test ID:element00
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

EOF in middle of incomplete ETAG
Sections [Rules]:3.1 [42]
Test ID:element01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

EOF in middle of incomplete ETAG
Sections [Rules]:3.1 [42]
Test ID:o-p42fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no space before name

Sections [Rules]:3.1 [42]
Test ID:o-p42fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

cannot end with "/>"

Sections [Rules]:3.1 [42]
Test ID:o-p42fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no NET (contrast with SGML)

Sections [Rules]:3.1 [43]
Test ID:not-wf-sa-035
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

The '<' character is a markup delimiter and must start an element, CDATA section, PI, or comment.

Sections [Rules]:3.1 [43]
Test ID:not-wf-sa-111
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Entiry reference must be in content of element not Start-tag.

Sections [Rules]:3.1 [43]
Test ID:not-wf-sa-150
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

XML declarations may not be within element content.

Sections [Rules]:3.1 [43]
Test ID:element02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal markup (<%@ ... %>)
Sections [Rules]:3.1 [43]
Test ID:element03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal markup (<% ... %>)
Sections [Rules]:3.1 [43]
Test ID:element04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal markup (<!ELEMENT ... >)
Sections [Rules]:3.1 [43]
Test ID:o-p43fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no non-comment declarations

Sections [Rules]:3.1 [43]
Test ID:o-p43fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no conditional sections

Sections [Rules]:3.1 [43]
Test ID:o-p43fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no conditional sections

Sections [Rules]:3.1 [44]
Test ID:not-wf-sa-045
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid Empty Element Tag

Sections [Rules]:3.1 [44]
Test ID:not-wf-sa-047
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid empty element tag invalid whitespace

Sections [Rules]:3.1 [44]
Test ID:not-wf-sa-186
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Whitespace is required between attribute/value pairs.

Sections [Rules]:3.1 [44]
Test ID:attlist11
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Whitespace required between attributes
Sections [Rules]:3.1 [44]
Test ID:o-p44fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Illegal space before Empty element tag.

Sections [Rules]:3.1 [44]
Test ID:o-p44fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Illegal space after Empty element tag.

Sections [Rules]:3.1 [44]
Test ID:o-p44fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Illegal comment in Empty element tag.

Sections [Rules]:3.1 [44]
Test ID:o-p44fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Whitespace required between attributes.

Sections [Rules]:3.1 [44]
Test ID:o-p44fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Duplicate attribute name is illegal.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P45-ibm45n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests elementdecl with a required field missing. The Name is missing in the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P45-ibm45n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests elementdecl with a required field missing. The white space is missing between "aEle" and "(#PCDATA)" in the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P45-ibm45n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests elementdecl with a required field missing. The contentspec is missing in the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P45-ibm45n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests elementdecl with a required field missing. The contentspec and the white space is missing in the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P45-ibm45n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests elementdecl with a required field missing. The Name, the white space, and the contentspec are missing in the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P45-ibm45n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests elementdecl with wrong field ordering. The Name occurs after the contentspec in the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P45-ibm45n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests elementdecl with wrong beginning sequence. The string "(less than)ELEMENT" is used as the beginning sequence in the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P45-ibm45n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests elementdecl with wrong key word. The string "Element" is used as the key word in the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P45-ibm45n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 45

Tests elementdecl with wrong key word. The string "element" is used as the key word in the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P46-ibm46n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 46

Tests contentspec with wrong key word. the string "empty" is used as the key word in the contentspec of the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P46-ibm46n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 46

Tests contentspec with wrong key word. the string "Empty" is used as the key word in the contentspec of the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P46-ibm46n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 46

Tests contentspec with wrong key word. the string "Any" is used as the key word in the contentspec of the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P46-ibm46n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 46

Tests contentspec with wrong key word. the string "any" is used as the key word in the contentspec of the second elementdecl in the DTD.

Sections [Rules]:3.2
Test ID:ibm-not-wf-P46-ibm46n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 46

Tests contentspec with a wrong option. The string "#CDATA" is used as the contentspec in the second elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:not-wf-sa-133
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Illegal whitespace before optional character causes syntax error.

Sections [Rules]:3.2.1
Test ID:not-wf-sa-134
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Illegal whitespace before optional character causes syntax error.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P47-ibm47n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 47

Tests children with a required field missing. The "+" is used as the choice or seq field in the second elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P47-ibm47n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 47

Tests children with a required field missing. The "*" is used as the choice or seq field in the second elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P47-ibm47n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 47

Tests children with a required field missing. The "?" is used as the choice or seq field in the second elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P47-ibm47n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 47

Tests children with wrong field ordering. The "*" occurs before the seq field (a,a) in the second elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P47-ibm47n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 47

Tests children with wrong field ordering. The "+" occurs before the choice field (a|a) in the second elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P47-ibm47n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 47

Tests children with wrong key word. The "^" occurs after the seq field in the second elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P48-ibm48n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 48

Tests cp with a required fields missing. The field Name|choice|seq is missing in the second cp in the choice field in the third elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P48-ibm48n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 48

Tests cp with a required fields missing. The field Name|choice|seq is missing in the cp in the third elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P48-ibm48n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 48

Tests cp with a required fields missing. The field Name|choice|seq is missing in the first cp in the choice field in the third elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P48-ibm48n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 48

Tests cp with wrong field ordering. The "+" occurs before the seq (a,a) in the first cp in the choice field in the third elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P48-ibm48n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 48

Tests cp with wrong field ordering. The "*" occurs before the choice (a|b) in the first cp in the seq field in the third elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P48-ibm48n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 48

Tests cp with wrong field ordering. The "?" occurs before the Name "a" in the second cp in the seq field in the third elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P48-ibm48n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 48

Tests cp with wrong key word. The "^" occurs after the Name "a" in the first cp in the choice field in the third elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P49-ibm49n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 49

Tests choice with a required field missing. The two cps are missing in the choice field in the third elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P49-ibm49n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 49

Tests choice with a required field missing. The third cp is missing in the choice field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P49-ibm49n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 49

Tests choice with a wrong separator. The "!" is used as the separator in the choice field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P49-ibm49n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 49

Tests choice with a required field missing. The separator "|" is missing in the choice field (a b)+ in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P49-ibm49n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 49

Tests choice with an extra separator. An extra "|" occurs between a and b in the choice field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P49-ibm49n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 49

Tests choice with a required field missing. The closing bracket ")" is missing in the choice field (a |b * in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P50-ibm50n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 50

Tests seq with a required field missing. The two cps are missing in the seq field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P50-ibm50n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 50

Tests seq with a required field missing. The third cp is missing in the seq field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P50-ibm50n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 50

Tests seq with a wrong separator. The "|" is used as the separator between a and b in the seq field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P50-ibm50n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 50

Tests seq with a wrong separator. The "." is used as the separator between a and b in the seq field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P50-ibm50n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 50

Tests seq with an extra separator. An extra "," occurs between (a|b) and a in the seq field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P50-ibm50n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 50

Tests seq with a required field missing. The separator between (a|b) and (b|a) is missing in the seq field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1
Test ID:ibm-not-wf-P50-ibm50n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 50

Tests seq with wrong closing bracket. The "]" is used as the closing bracket in the seq field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.1 [46]
Test ID:not-wf-sa-139
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

The element-content model should not be empty.

Sections [Rules]:3.2.1 [47]
Test ID:not-wf-sa-122
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax mixed connectors are used.

Sections [Rules]:3.2.1 [47]
Test ID:not-wf-sa-135
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid character used as connector.

Sections [Rules]:3.2.1 [47]
Test ID:sgml13
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML Unordered content models not allowed
Sections [Rules]:3.2.1 [47]
Test ID:o-p47fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Invalid operator '|' must match previous operator ','
Sections [Rules]:3.2.1 [47]
Test ID:o-p47fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Illegal character '-' in Element-content model

Sections [Rules]:3.2.1 [47]
Test ID:o-p47fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Optional character must follow a name or list

Sections [Rules]:3.2.1 [47]
Test ID:o-p47fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Illegal space before optional character
Sections [Rules]:3.2.1 [48]
Test ID:not-wf-sa-123
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax mismatched parenthesis.

Sections [Rules]:3.2.1 [48]
Test ID:not-wf-sa-138
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax for content particle.

Sections [Rules]:3.2.1 [48]
Test ID:content01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

No whitespace before "?" in content model
Sections [Rules]:3.2.1 [48]
Test ID:content02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

No whitespace before "*" in content model
Sections [Rules]:3.2.1 [48]
Test ID:content03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

No whitespace before "+" in content model
Sections [Rules]:3.2.1 [48]
Test ID:o-p48fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Illegal space before optional character

Sections [Rules]:3.2.1 [48]
Test ID:o-p48fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Illegal space before optional character

Sections [Rules]:3.2.1 [49]
Test ID:o-p49fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

connectors must match

Sections [Rules]:3.2.1 [50]
Test ID:not-wf-sa-132
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax mixed connectors used.

Sections [Rules]:3.2.1 [50]
Test ID:o-p50fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

connectors must match

Sections [Rules]:3.2.1 [55]
Test ID:nwf-dtd00
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Comma mandatory in content model
Sections [Rules]:3.2.1 [55]
Test ID:nwf-dtd01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Can't mix comma and vertical bar in content models
Sections [Rules]:3.2.2
Test ID:ibm-not-wf-P51-ibm51n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Tests Mixed with a wrong key word. The string "#pcdata" is used as the key word in the Mixed field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.2
Test ID:ibm-not-wf-P51-ibm51n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Tests Mixed with wrong field ordering. The field #PCDATA does not occur as the first component in the Mixed field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.2
Test ID:ibm-not-wf-P51-ibm51n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Tests Mixed with a separator missing. The separator "|" is missing in between #PCDATA and a in the Mixed field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.2
Test ID:ibm-not-wf-P51-ibm51n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Tests Mixed with a wrong key word. The string "#CDATA" is used as the key word in the Mixed field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.2
Test ID:ibm-not-wf-P51-ibm51n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Tests Mixed with a required field missing. The "*" is missing after the ")" in the Mixed field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.2
Test ID:ibm-not-wf-P51-ibm51n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Tests Mixed with wrong closing bracket. The "]" is used as the closing bracket in the Mixed field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.2
Test ID:ibm-not-wf-P51-ibm51n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 51

Tests Mixed with a required field missing. The closing bracket ")" is missing after (#PCDATA in the Mixed field in the fourth elementdecl in the DTD.

Sections [Rules]:3.2.2 [51]
Test ID:not-wf-sa-124
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid format of Mixed-content declaration.

Sections [Rules]:3.2.2 [51]
Test ID:not-wf-sa-125
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax extra set of parenthesis not necessary.

Sections [Rules]:3.2.2 [51]
Test ID:not-wf-sa-126
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax Mixed-content must be defined as zero or more.

Sections [Rules]:3.2.2 [51]
Test ID:not-wf-sa-127
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax Mixed-content must be defined as zero or more.

Sections [Rules]:3.2.2 [51]
Test ID:not-wf-sa-183
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Mixed content declarations may not include content particles.
Sections [Rules]:3.2.2 [51]
Test ID:not-wf-sa-184
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

In mixed content models, element names must not be parenthesized.

Sections [Rules]:3.2.2 [51]
Test ID:o-p51fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

occurrence on #PCDATA group must be *

Sections [Rules]:3.2.2 [51]
Test ID:o-p51fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

occurrence on #PCDATA group must be *

Sections [Rules]:3.2.2 [51]
Test ID:o-p51fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

#PCDATA must come first

Sections [Rules]:3.2.2 [51]
Test ID:o-p51fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

occurrence on #PCDATA group must be *

Sections [Rules]:3.2.2 [51]
Test ID:o-p51fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

only '|' connectors

Sections [Rules]:3.2.2 [51]
Test ID:o-p51fail6
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Only '|' connectors and occurrence on #PCDATA group must be *

Sections [Rules]:3.2.2 [51]
Test ID:o-p51fail7
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no nested groups

Sections [Rules]:3.2 [45]
Test ID:not-wf-sa-057
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

This isn't SGML; comments can't exist in declarations.

Sections [Rules]:3.2 [45]
Test ID:not-wf-sa-129
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax for Element Type Declaration.

Sections [Rules]:3.2 [45]
Test ID:not-wf-sa-130
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax for Element Type Declaration.

Sections [Rules]:3.2 [45]
Test ID:not-wf-sa-131
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax for Element Type Declaration.

Sections [Rules]:3.2 [45]
Test ID:not-wf-sa-136
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tag omission is invalid in XML.

Sections [Rules]:3.2 [45]
Test ID:not-wf-sa-137
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Space is required before a content model.

Sections [Rules]:3.2 [45]
Test ID:sgml05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

ELEMENT declarations apply to only one element, unlike SGML
Sections [Rules]:3.2 [45]
Test ID:sgml07
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML Tag minimization specifications are not allowed
Sections [Rules]:3.2 [45]
Test ID:sgml08
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML Tag minimization specifications are not allowed
Sections [Rules]:3.2 [45]
Test ID:sgml09
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML Content model exception specifications are not allowed
Sections [Rules]:3.2 [45]
Test ID:sgml10
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML Content model exception specifications are not allowed
Sections [Rules]:3.2 [45]
Test ID:o-p45fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

ELEMENT must be upper case.

Sections [Rules]:3.2 [45]
Test ID:o-p45fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S before contentspec is required.

Sections [Rules]:3.2 [45]
Test ID:o-p45fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

only one content spec

Sections [Rules]:3.2 [45]
Test ID:o-p45fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no comments in declarations (contrast with SGML)

Sections [Rules]:3.2 [46]
Test ID:sgml11
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

CDATA is not a valid content model spec
Sections [Rules]:3.2 [46]
Test ID:sgml12
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

RCDATA is not a valid content model spec
Sections [Rules]:3.2 [46]
Test ID:o-p46fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no parens on declared content

Sections [Rules]:3.2 [46]
Test ID:o-p46fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no inclusions (contrast with SGML)

Sections [Rules]:3.2 [46]
Test ID:o-p46fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no exclusions (contrast with SGML)

Sections [Rules]:3.2 [46]
Test ID:o-p46fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no space before occurrence

Sections [Rules]:3.2 [46]
Test ID:o-p46fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

single group

Sections [Rules]:3.2 [46]
Test ID:o-p46fail6
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

can't be both declared and modeled

Sections [Rules]:3.3
Test ID:ibm-not-wf-P52-ibm52n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 52

Tests AttlistDecl with a required field missing. The Name is missing in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P52-ibm52n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 52

Tests AttlistDecl with a required field missing. The white space is missing between the beginning sequence and the name in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P52-ibm52n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 52

Tests AttlistDecl with wrong field ordering. The Name "a" occurs after the first AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P52-ibm52n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 52

Tests AttlistDecl with wrong key word. The string "Attlist" is used as the key word in the beginning sequence in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P52-ibm52n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 52

Tests AttlistDecl with a required field missing. The closing bracket "greater than" is missing in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P52-ibm52n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 52

Tests AttlistDecl with wrong beginning sequence. The string "(less than)ATTLIST" is used as the beginning sequence in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P53-ibm53n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 53

Tests AttDef with a required field missing. The DefaultDecl is missing in the AttDef for the name "attr1" in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P53-ibm53n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 53

Tests AttDef with a required field missing. The white space is missing between (abc|def) and "def" in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P53-ibm53n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 53

Tests AttDef with a required field missing. The AttType is missing for "attr1" in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P53-ibm53n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 53

Tests AttDef with a required field missing. The white space is missing between "attr1" and (abc|def) in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P53-ibm53n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 53

Tests AttDef with a required field missing. The Name is missing in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P53-ibm53n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 53

Tests AttDef with a required field missing. The white space before the name "attr2" is missing in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P53-ibm53n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 53

Tests AttDef with wrong field ordering. The Name "attr1" occurs after the AttType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3
Test ID:ibm-not-wf-P53-ibm53n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 53

Tests AttDef with wrong field ordering. The Name "attr1" occurs after the AttType and "default" occurs before the AttType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P54-ibm54n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 54

Tests AttType with a wrong option. The string "BOGUSATTR" is used as the AttType in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P54-ibm54n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 54

Tests AttType with a wrong option. The string "PCDATA" is used as the AttType in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P55-ibm55n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 55

Tests StringType with a wrong key word. The lower case string "cdata" is used as the StringType in the AttType in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P55-ibm55n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 55

Tests StringType with a wrong key word. The string "#CDATA" is used as the StringType in the AttType in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P55-ibm55n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 55

Tests StringType with a wrong key word. The string "CData" is used as the StringType in the AttType in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P56-ibm56n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType with wrong key word. The "id" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P56-ibm56n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType with wrong key word. The "Idref" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P56-ibm56n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType with wrong key word. The "Idrefs" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P56-ibm56n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType with wrong key word. The "EntitY" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P56-ibm56n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType with wrong key word. The "nmTOKEN" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P56-ibm56n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType with wrong key word. The "NMtokens" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P56-ibm56n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 56

Tests TokenizedType with wrong key word. The "#ID" is used in the TokenizedType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P57-ibm57n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 57

Tests EnumeratedType with an illegal option. The "NMTOKEN (a|b)" is used in the EnumeratedType in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P58-ibm58n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType with wrong key word. The lower case "notation" is used as the key word in the NotationType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P58-ibm58n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType with a required field missing. The beginning bracket "(" is missing in the NotationType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P58-ibm58n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType with a required field missing. The Name is missing in the "()" in the NotationType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P58-ibm58n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType with a required field missing. The closing bracket is missing in the NotationType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P58-ibm58n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType with wrong field ordering. The key word "NOTATION" occurs after "(this)" in the NotationType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P58-ibm58n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType with wrong separator. The "," is used as a separator between "this" and "that" in the NotationType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P58-ibm58n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType with a required field missing. The white space is missing between "NOTATION" and "(this)" in the NotationType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P58-ibm58n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 58

Tests NotationType with extra wrong characters. The double quote character occurs after "(" and before ")" in the NotationType in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P59-ibm59n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 59

Tests Enumeration with required fields missing. The Nmtokens and "|"s are missing in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P59-ibm59n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 59

Tests Enumeration with a required field missing. The closing bracket ")" is missing in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P59-ibm59n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 59

Tests Enumeration with wrong separator. The "," is used as the separator in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P59-ibm59n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 59

Tests Enumeration with illegal presence. The double quotes occur around the Enumeration value in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P59-ibm59n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 59

Tests Enumeration with a required field missing. The white space is missing between in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1
Test ID:ibm-not-wf-P59-ibm59n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 59

Tests Enumeration with a required field missing. The beginning bracket "(" is missing in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.1 [54]
Test ID:not-wf-sa-058
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid character , in ATTLIST enumeration

Sections [Rules]:3.3.1 [54]
Test ID:o-p54fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

don't pass unknown attribute types

Sections [Rules]:3.3.1 [55]
Test ID:o-p55fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

must be upper case

Sections [Rules]:3.3.1 [56]
Test ID:not-wf-sa-060
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid type NAME defined in ATTLIST.
Sections [Rules]:3.3.1 [56]
Test ID:attlist01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML's NUTOKEN is not allowed.
Sections [Rules]:3.3.1 [56]
Test ID:attlist02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML's NUTOKENS attribute type is not allowed.
Sections [Rules]:3.3.1 [56]
Test ID:attlist04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML's NUMBER attribute type is not allowed.
Sections [Rules]:3.3.1 [56]
Test ID:attlist05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML's NUMBERS attribute type is not allowed.
Sections [Rules]:3.3.1 [56]
Test ID:attlist06
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML's NAME attribute type is not allowed.
Sections [Rules]:3.3.1 [56]
Test ID:attlist07
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML's NAMES attribute type is not allowed.
Sections [Rules]:3.3.1 [56]
Test ID:attlist08
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML's #CURRENT is not allowed.
Sections [Rules]:3.3.1 [56]
Test ID:attlist09
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML's #CONREF is not allowed.
Sections [Rules]:3.3.1 [56]
Test ID:o-p56fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no IDS type

Sections [Rules]:3.3.1 [56]
Test ID:o-p56fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no NUMBER type

Sections [Rules]:3.3.1 [56]
Test ID:o-p56fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no NAME type

Sections [Rules]:3.3.1 [56]
Test ID:o-p56fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no ENTITYS type - types must be upper case

Sections [Rules]:3.3.1 [56]
Test ID:o-p56fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

types must be upper case

Sections [Rules]:3.3.1 [57]
Test ID:o-p57fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no keyword for NMTOKEN enumeration

Sections [Rules]:3.3.1 [58]
Test ID:not-wf-sa-068
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Space is required between NOTATION keyword and list of enumerated choices in <!ATTLIST...> declarations.

Sections [Rules]:3.3.1 [58]
Test ID:o-p58fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

at least one value required

Sections [Rules]:3.3.1 [58]
Test ID:o-p58fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

separator must be '|'

Sections [Rules]:3.3.1 [58]
Test ID:o-p58fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

notations are NAMEs, not NMTOKENs -- note: Leaving the invalid notation undeclared would cause a validating parser to fail without checking the name syntax, so the notation is declared with an invalid name. A parser that reports error positions should report an error at the AttlistDecl on line 6, before reaching the notation declaration.

Sections [Rules]:3.3.1 [58]
Test ID:o-p58fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

NOTATION must be upper case

Sections [Rules]:3.3.1 [58]
Test ID:o-p58fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S after keyword is required

Sections [Rules]:3.3.1 [58]
Test ID:o-p58fail6
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

parentheses are require

Sections [Rules]:3.3.1 [58]
Test ID:o-p58fail7
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

values are unquoted

Sections [Rules]:3.3.1 [58]
Test ID:o-p58fail8
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

values are unquoted

Sections [Rules]:3.3.1 [59]
Test ID:not-wf-sa-059
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

String literal must be in quotes.

Sections [Rules]:3.3.1 [59]
Test ID:attlist03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Comma doesn't separate enumerations, unlike in SGML.
Sections [Rules]:3.3.1 [59]
Test ID:o-p59fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

at least one required

Sections [Rules]:3.3.1 [59]
Test ID:o-p59fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

separator must be ","

Sections [Rules]:3.3.1 [59]
Test ID:o-p59fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

values are unquoted

Sections [Rules]:3.3.2
Test ID:ibm-not-wf-P60-ibm60n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl with wrong key word. The string "#required" is used as the key word in the DefaultDecl in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.2
Test ID:ibm-not-wf-P60-ibm60n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl with wrong key word. The string "Implied" is used as the key word in the DefaultDecl in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.2
Test ID:ibm-not-wf-P60-ibm60n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl with wrong key word. The string "!IMPLIED" is used as the key word in the DefaultDecl in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.2
Test ID:ibm-not-wf-P60-ibm60n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl with a required field missing. There is no attribute value specified after the key word "#FIXED" in the DefaultDecl in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.2
Test ID:ibm-not-wf-P60-ibm60n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl with a required field missing. The white space is missing between the key word "#FIXED" and the attribute value in the DefaultDecl in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.2
Test ID:ibm-not-wf-P60-ibm60n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl with wrong field ordering. The key word "#FIXED" occurs after the attribute value "introduction" in the DefaultDecl in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.2
Test ID:ibm-not-wf-P60-ibm60n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl against WFC of P60. The text replacement of the entity "avalue" contains the "less than" character in the DefaultDecl in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.2
Test ID:ibm-not-wf-P60-ibm60n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 60

Tests DefaultDecl with more than one key word. The "#REQUIRED" and the "#IMPLIED" are used as the key words in the DefaultDecl in the AttDef in the AttlistDecl in the DTD.

Sections [Rules]:3.3.2 [60]
Test ID:o-p60fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

keywords must be upper case

Sections [Rules]:3.3.2 [60]
Test ID:o-p60fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required after #FIXED

Sections [Rules]:3.3.2 [60]
Test ID:o-p60fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

only #FIXED has both keyword and value

Sections [Rules]:3.3.2 [60]
Test ID:o-p60fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

#FIXED required value

Sections [Rules]:3.3.2 [60]
Test ID:o-p60fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

only one default type

Sections [Rules]:3.3 [52]
Test ID:not-wf-sa-066
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Required whitespace is missing.

Sections [Rules]:3.3 [52]
Test ID:not-wf-sa-158
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

SGML-ism: "#NOTATION gif" can't have attributes.

Sections [Rules]:3.3 [52]
Test ID:sgml04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

ATTLIST declarations apply to only one element, unlike SGML
Sections [Rules]:3.3 [52]
Test ID:sgml06
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

ATTLIST declarations are never global, unlike in SGML
Sections [Rules]:3.3 [52]
Test ID:o-p52fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

A name is required

Sections [Rules]:3.3 [52]
Test ID:o-p52fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

A name is required

Sections [Rules]:3.3 [53]
Test ID:not-wf-sa-064
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Space is required between attribute type and default values in <!ATTLIST...> declarations.

Sections [Rules]:3.3 [53]
Test ID:not-wf-sa-065
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Space is required between attribute name and type in <!ATTLIST...> declarations.

Sections [Rules]:3.3 [53]
Test ID:not-wf-sa-067
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Space is required between attribute type and default values in <!ATTLIST...> declarations.

Sections [Rules]:3.3 [53]
Test ID:o-p53fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required before default

Sections [Rules]:3.3 [53]
Test ID:o-p53fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required before type

Sections [Rules]:3.3 [53]
Test ID:o-p53fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

type is required

Sections [Rules]:3.3 [53]
Test ID:o-p53fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

default is required

Sections [Rules]:3.3 [53]
Test ID:o-p53fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

name is requried

Sections [Rules]:3.4
Test ID:ibm-not-wf-P61-ibm61n01.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 61

Tests conditionalSect with a wrong option. The word "NOTINCLUDE" is used as part of an option which is wrong in the coditionalSect.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P62-ibm62n01.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect with wrong key word. The string "include" is used as a key word in the beginning sequence in the includeSect in the file ibm62n01.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P62-ibm62n02.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect with wrong beginning sequence. An extra "[" occurs in the beginning sequence in the includeSect in the file ibm62n02.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P62-ibm62n03.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect with wrong beginning sequence. A wrong character "?" occurs in the beginning sequence in the includeSect in the file ibm62n03.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P62-ibm62n04.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect with a required field missing. The key word "INCLUDE" is missing in the includeSect in the file ibm62n04.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P62-ibm62n05.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect with a required field missing. The "]" is missing after the key word "INCLUDE" in the includeSect in the file ibm62n05.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P62-ibm62n06.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect with wrong field ordering. The two external subset declarations occur before the key word "INCLUDE" in the includeSect in the file ibm62n06.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P62-ibm62n07.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect with a required field missing. The closing sequence "]](greater than)" is missing in the includeSect in the file ibm62n07.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P62-ibm62n08.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 62

Tests includeSect with a required field missing. One "]" is missing in the closing sequence in the includeSect in the file ibm62n08.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P63-ibm63n01.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect with wrong key word. The string "ignore" is used as a key word in the beginning sequence in the ignoreSect in the file ibm63n01.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P63-ibm63n02.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect with wrong beginning sequence. An extra "[" occurs in the beginning sequence in the ignoreSect in the file ibm63n02.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P63-ibm63n03.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect with wrong beginning sequence. A wrong character "?" occurs in the beginning sequence in the ignoreSect in the file ibm63n03.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P63-ibm63n04.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect with a required field missing. The key word "IGNORE" is missing in the ignoreSect in the file ibm63n04.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P63-ibm63n05.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect with a required field missing. The "]" is missing after the key word "IGNORE" in the ignoreSect in the file ibm63n05.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P63-ibm63n06.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 63

Tests includeSect with wrong field ordering. The two external subset declarations occur before the key word "IGNORE" in the ignoreSect in the file ibm63n06.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P63-ibm63n07.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 63

Tests ignoreSect with a required field missing. The closing sequence "]](greater than)" is missing in the ignoreSect in the file ibm63n07.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P64-ibm64n01.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 64

Tests ignoreSectContents with wrong beginning sequence. The "?" occurs in beginning sequence the ignoreSectContents in the file ibm64n01.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P64-ibm64n02.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 64

Tests ignoreSectContents with a required field missing.The closing sequence is missing in the ignoreSectContents in the file ibm64n02.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P64-ibm64n03.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 64

Tests ignoreSectContents with a required field missing.The beginning sequence is missing in the ignoreSectContents in the file ibm64n03.dtd.

Sections [Rules]:3.4
Test ID:ibm-not-wf-P65-ibm65n01.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 65

Tests Ignore with illegal string included. The string "]](greater than)" is contained before "this" in the Ignore in the ignoreSectContents in the file ibm65n01.dtd

Sections [Rules]:3.4
Test ID:ibm-not-wf-P65-ibm65n02.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 65

Tests Ignore with illegal string included. The string "(less than)![" is contained before "this" in the Ignore in the ignoreSectContents in the file ibm65n02.dtd

Sections [Rules]:3.4 [61]
Test ID:cond01
RECOMMENDATION:XML1.0
Entities:parameter
Collection:Sun Microsystems XML Tests

Only INCLUDE and IGNORE are conditional section keywords
Sections [Rules]:3.4 [61]
Test ID:cond02
RECOMMENDATION:XML1.0
Entities:parameter
Collection:Sun Microsystems XML Tests

Must have keyword in conditional sections
Sections [Rules]:3.4 [61]
Test ID:o-p61fail1
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

no other types, including TEMP, which is valid in SGML

Sections [Rules]:3.4 [62]
Test ID:not-wf-not-sa-001
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

Conditional sections must be properly terminated ("]>" used instead of "]]>").

Sections [Rules]:3.4 [62]
Test ID:not-wf-not-sa-003
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

Conditional sections must be properly terminated ("]]>" omitted).

Sections [Rules]:3.4 [62]
Test ID:not-wf-not-sa-004
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

Conditional sections must be properly terminated ("]]>" omitted).

Sections [Rules]:3.4 [62]
Test ID:not-wf-not-sa-006
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

Conditional sections need a '[' after the INCLUDE or IGNORE.

Sections [Rules]:3.4 [62]
Test ID:o-p62fail1
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

INCLUDE must be upper case

Sections [Rules]:3.4 [62]
Test ID:o-p62fail2
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

no spaces in terminating delimiter

Sections [Rules]:3.4 [63]
Test ID:o-p63fail1
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

IGNORE must be upper case

Sections [Rules]:3.4 [63]
Test ID:o-p63fail2
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

delimiters must be balanced

Sections [Rules]:3.4 [64]
Test ID:o-p64fail1
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

section delimiters must balance

Sections [Rules]:3.4 [64]
Test ID:o-p64fail2
RECOMMENDATION:XML1.0
Entities:parameter
Collection:OASIS/NIST TESTS, 1-Nov-1998

section delimiters must balance

Sections [Rules]:3 [39]
Test ID:not-wf-sa-176
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Start tags must have matching end tags.
Sections [Rules]:3 [39]
Test ID:sgml01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SGML-ism: omitted end tag for EMPTY content
Sections [Rules]:3 [39]
Test ID:o-p39fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

start-tag requires end-tag

Sections [Rules]:3 [39]
Test ID:o-p39fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

end-tag requires start-tag

Sections [Rules]:3 [39]
Test ID:o-p39fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

XML documents contain one or more elements
Sections [Rules]:4
Test ID:rmt-ns10-025
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Unbound element prefix

Sections [Rules]:4
Test ID:rmt-ns10-026
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Unbound attribute prefix

Sections [Rules]:4.1
Test ID:not-wf-sa-084
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests the Parsed Entity WFC by referring to an unparsed entity. (This precedes the error of not declaring that entity's notation, which may be detected any time before the DTD parsing is completed.)

Sections [Rules]:4.1
Test ID:not-wf-sa-180
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

The Entity Declared WFC requires entities to be declared before they are used in an attribute list declaration.

Sections [Rules]:4.1
Test ID:not-wf-sa-185
RECOMMENDATION:XML1.0
Entities:parameter
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests the Entity Declared WFC. Note: a nonvalidating parser is permitted not to report this WFC violation, since it would need to read an external parameter entity to distinguish it from a violation of the Standalone Declaration VC.
Sections [Rules]:4.1
Test ID:not-wf-ext-sa-001
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests the No Recursion WFC by having an external general entity be self-recursive.
Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#002f" is used as the referred character in the CharRef in the EntityDecl in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with the semicolon character missing. The semicolon character is missing at the end of the CharRef in the attribute value in the STag of element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "49" is used as the referred character in the CharRef in the EntityDecl in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#5~0" is used as the referred character in the attribute value in the EmptyElemTag of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#x002g" is used as the referred character in the CharRef in the EntityDecl in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#x006G" is used as the referred character in the attribute value in the EmptyElemTag of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#0=2f" is used as the referred character in the CharRef in the EntityDecl in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#56.0" is used as the referred character in the attribute value in the EmptyElemTag of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#x00/2f" is used as the referred character in the CharRef in the EntityDecl in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#51)" is used as the referred character in the attribute value in the EmptyElemTag of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#00 2f" is used as the referred character in the CharRef in the EntityDecl in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#x0000" is used as the referred character in the attribute value in the EmptyElemTag of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n13.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#x001f" is used as the referred character in the attribute value in the EmptyElemTag of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n14.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#xfffe" is used as the referred character in the attribute value in the EmptyElemTag of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P66-ibm66n15.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 66

Tests CharRef with an illegal character referred to. The "#xffff" is used as the referred character in the attribute value in the EmptyElemTag of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef with a required field missing. The Name is missing in the EntityRef in the content of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef with a required field missing. The semicolon is missing in the EntityRef in the attribute value in the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef with an extra white space. A white space occurs after the ampersand in the EntityRef in the content of the element "root".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef which is against P68 WFC: Entity Declared. The name "aAa" in the EntityRef in the AttValue in the STage of the element "root" does not match the Name of any declared entity in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef which is against P68 WFC: Entity Declared. The entity with the name "aaa" in the EntityRef in the AttValue in the STag of the element "root" is not declared.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n06.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef which is against P68 WFC: Entity Declared. The entity with the name "aaa" in the EntityRef in the AttValue in the STag of the element "root" is externally declared, but standalone is "yes".

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef which is against P68 WFC: Entity Declared. The entity with the name "aaa" in the EntityRef in the AttValue in the STag of the element "root" is referred before declared.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef which is against P68 WFC: Parsed Entity. The EntityRef in the AttValue in the STag of the element "root" contains the name "aImage" of an unparsed entity.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef which is against P68 WFC: No Recursion. The recursive entity reference occurs with the entity declarations for "aaa" and "bbb" in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P68-ibm68n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests EntityRef which is against P68 WFC: No Recursion. The indirect recursive entity reference occurs with the entity declarations for "aaa", "bbb", "ccc", "ddd", and "eee" in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P69-ibm69n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests PEReference with a required field missing. The Name "paaa" is missing in the PEReference in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P69-ibm69n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests PEReference with a required field missing. The semicolon is missing in the PEReference "%paaa" in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P69-ibm69n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests PEReference with an extra white space. There is an extra white space occurs before ";" in the PEReference in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P69-ibm69n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests PEReference with an extra white space. There is an extra white space occurs after "%" in the PEReference in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P69-ibm69n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests PEReference which is against P69 WFC: No Recursion. The recursive PE reference occurs with the entity declarations for "paaa" and "bbb" in the DTD.

Sections [Rules]:4.1
Test ID:ibm-not-wf-P69-ibm69n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests PEReference which is against P69 WFC: No Recursion. The indirect recursive PE reference occurs with the entity declarations for "paaa", "bbb", "ccc", "ddd", and "eee" in the DTD.

Sections [Rules]:4.1
Test ID:rmt-042
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Contains a character reference to a C0 control character (form-feed), legal in XML 1.1 but not 1.0

Sections [Rules]:4.1 [66]
Test ID:not-wf-sa-009
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character references may have only decimal or numeric strings.
Sections [Rules]:4.1 [66]
Test ID:not-wf-sa-022
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character references end with semicolons, always!
Sections [Rules]:4.1 [66]
Test ID:not-wf-sa-052
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid character reference.

Sections [Rules]:4.1 [66]
Test ID:not-wf-sa-093
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Hexadecimal character references may not use the uppercase 'X'.
Sections [Rules]:4.1 [66]
Test ID:not-wf-sa-179
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid syntax matching double quote is missing.

Sections [Rules]:4.1 [66]
Test ID:o-p66fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

terminating ';' is required

Sections [Rules]:4.1 [66]
Test ID:o-p66fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no S after '&#'

Sections [Rules]:4.1 [66]
Test ID:o-p66fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no hex digits in numeric reference

Sections [Rules]:4.1 [66]
Test ID:o-p66fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

only hex digits in hex references

Sections [Rules]:4.1 [66]
Test ID:o-p66fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no references to non-characters

Sections [Rules]:4.1 [66]
Test ID:o-p66fail6
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no references to non-characters

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-007
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

General entity references have no whitespace after the entity name and before the semicolon.

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-010
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Ampersand may only appear as part of a general entity reference.
Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-071
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

ENTITY can't reference itself directly or indirectly.
Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-072
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Undefined ENTITY foo.

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-073
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Undefined ENTITY f.

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-075
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

ENTITY can't reference itself directly or indirectly.

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-076
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Undefined ENTITY foo.

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-078
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Undefined ENTITY foo.

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-079
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

ENTITY can't reference itself directly or indirectly.

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-080
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

ENTITY can't reference itself directly or indirectly.

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-110
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Entity reference must be in content of element.

Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-118
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Entity reference expansion is not recursive.
Sections [Rules]:4.1 [68]
Test ID:not-wf-sa-121
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

A name of an ENTITY was started with an invalid character.

Sections [Rules]:4.1 [68]
Test ID:o-p68fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

terminating ';' is required

Sections [Rules]:4.1 [68]
Test ID:o-p68fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no S after '&'

Sections [Rules]:4.1 [68]
Test ID:o-p68fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no S before ';'

Sections [Rules]:4.1 [69]
Test ID:not-wf-sa-163
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid placement of Parameter entity reference.

Sections [Rules]:4.1 [69]
Test ID:not-wf-sa-164
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid placement of Parameter entity reference.

Sections [Rules]:4.1 [69]
Test ID:not-wf-not-sa-008
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

In DTDs, the '%' character must be part of a parameter entity reference.
Sections [Rules]:4.1 [69]
Test ID:dtd02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

PE name immediately after "%"
Sections [Rules]:4.1 [69]
Test ID:dtd03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

PE name immediately followed by ";"
Sections [Rules]:4.1 [69]
Test ID:o-p69fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

terminating ';' is required

Sections [Rules]:4.1 [69]
Test ID:o-p69fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no S after '%'

Sections [Rules]:4.1 [69]
Test ID:o-p69fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no S before ';'

Sections [Rules]:4.2
Test ID:not-wf-sa-106
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Invalid placement of entity declaration.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P71-ibm70n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 71

Tests

Sections [Rules]:4.2
Test ID:ibm-not-wf-P71-ibm71n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 71

Tests EntityDecl with a required field missing. The white space is missing between the beginning sequence and the Name "aaa" in the EntityDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P71-ibm71n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 71

Tests EntityDecl with a required field missing. The white space is missing between the Name "aaa" and the EntityDef "aString" in the EntityDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P71-ibm71n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 71

Tests EntityDecl with a required field missing. The EntityDef is missing in the EntityDecl with the Name "aaa" in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P71-ibm71n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 71

Tests EntityDecl with a required field missing. The Name is missing in the EntityDecl with the EntityDef "aString" in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P71-ibm71n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 71

Tests EntityDecl with wrong ordering. The Name "aaa" occurs after the EntityDef in the EntityDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P71-ibm71n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 71

Tests EntityDecl with wrong key word. The string "entity" is used as the key word in the beginning sequence in the EntityDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P71-ibm71n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 71

Tests EntityDecl with a required field missing. The closing bracket (greater than) is missing in the EntityDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P71-ibm71n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 71

Tests EntityDecl with a required field missing. The exclamation mark is missing in the beginning sequence in the EntityDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P72-ibm72n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 72

Tests PEdecl with a required field missing. The white space is missing between the beginning sequence and the "%" in the PEDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P72-ibm72n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 72

Tests PEdecl with a required field missing. The Name is missing in the PEDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P72-ibm72n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 72

Tests PEdecl with a required field missing. The white space is missing between the Name and the PEDef in the PEDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P72-ibm72n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 72

Tests PEdecl with a required field missing. The PEDef is missing after the Name "paaa" in the PEDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P72-ibm72n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 72

Tests PEdecl with wrong field ordering. The Name "paaa" occurs after the PEDef in the PEDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P72-ibm72n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 72

Tests PEdecl with wrong field ordering. The "%" and the Name "paaa" occurs after the PEDef in the PEDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P72-ibm72n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 72

Tests PEdecl with wrong key word. The string "entity" is used as the key word in the beginning sequence in the PEDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P72-ibm72n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 72

Tests PEdecl with a required field missing. The closing bracket (greater than) is missing in the PEDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P72-ibm72n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 72

Tests PEdecl with wrong closing sequence. The string "!(greater than)" is used as the closing sequence in the PEDecl in the DTD.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P73-ibm73n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 73

Tests EntityDef with wrong field ordering. The NDataDecl "NDATA JPGformat" occurs before the ExternalID in the EntityDef in the EntityDecl.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P73-ibm73n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 73

Tests EntityDef with a required field missing. The ExternalID is missing before the NDataDecl in the EntityDef in the EntityDecl.

Sections [Rules]:4.2
Test ID:ibm-not-wf-P74-ibm74n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 74

Tests PEDef with extra fields. The NDataDecl occurs after the ExternalID in the PEDef in the PEDecl in the DTD.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with wrong key word. The string "system" is used as the key word in the ExternalID in the EntityDef in the EntityDecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with wrong key word. The string "public" is used as the key word in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with wrong key word. The string "Public" is used as the key word in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with wrong field ordering. The key word "PUBLIC" occurs after the PublicLiteral and the SystemLiteral in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with a required field missing. The white space between "SYSTEM" and the Systemliteral is missing in the ExternalID in the EntityDef in the EntityDecl in the DTD.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with a required field missing. The Systemliteral is missing after "SYSTEM" in the ExternalID in the EntityDef in the EntityDecl in the DTD.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with a required field missing. The white space between the PublicLiteral and the Systemliteral is missing in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with a required field missing. The key word "PUBLIC" is missing in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with a required field missing. The white space between "PUBLIC" and the PublicLiteral is missing in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with a required field missing. The PublicLiteral is missing in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with a required field missing. The PublicLiteral is missing in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with a required field missing. The SystemLiteral is missing in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P75-ibm75n13.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 75

Tests ExternalID with wrong field ordering. The key word "PUBLIC" occurs after the PublicLiteral in the ExternalID in the doctypedecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P76-ibm76n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 76

Tests NDataDecl with wrong key word. The string "ndata" is used as the key word in the NDataDecl in the EntityDef in the GEDecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P76-ibm76n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 76

Tests NDataDecl with wrong key word. The string "NData" is used as the key word in the NDataDecl in the EntityDef in the GEDecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P76-ibm76n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 76

Tests NDataDecl with a required field missing. The leading white space is missing in the NDataDecl in the EntityDef in the GEDecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P76-ibm76n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 76

Tests NDataDecl with a required field missing. The key word "NDATA" is missing in the NDataDecl in the EntityDef in the GEDecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P76-ibm76n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 76

Tests NDataDecl with a required field missing. The Name after the key word "NDATA" is missing in the NDataDecl in the EntityDef in the GEDecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P76-ibm76n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 76

Tests NDataDecl with a required field missing. The white space between "NDATA" and the Name is missing in the NDataDecl in the EntityDef in the GEDecl.

Sections [Rules]:4.2.2
Test ID:ibm-not-wf-P76-ibm76n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 76

Tests NDataDecl with wrong field ordering. The key word "NDATA" occurs after the Name in the NDataDecl in the EntityDef in the GEDecl.

Sections [Rules]:4.2.2 [75]
Test ID:not-wf-sa-054
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

PUBLIC requires two literals.
Sections [Rules]:4.2.2 [75]
Test ID:not-wf-sa-061
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

External entity declarations require whitespace between public and system IDs.
Sections [Rules]:4.2.2 [75]
Test ID:dtd04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

PUBLIC literal must be quoted
Sections [Rules]:4.2.2 [75]
Test ID:dtd05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SYSTEM identifier must be quoted
Sections [Rules]:4.2.2 [75]
Test ID:o-p75fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S required after "PUBLIC"

Sections [Rules]:4.2.2 [75]
Test ID:o-p75fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S required after "SYSTEM"

Sections [Rules]:4.2.2 [75]
Test ID:o-p75fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S required between literals

Sections [Rules]:4.2.2 [75]
Test ID:o-p75fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

"SYSTEM" implies only one literal

Sections [Rules]:4.2.2 [75]
Test ID:o-p75fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

only one keyword

Sections [Rules]:4.2.2 [75]
Test ID:o-p75fail6
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

"PUBLIC" requires two literals (contrast with SGML)

Sections [Rules]:4.2.2 [76]
Test ID:not-wf-sa-069
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Space is required before an NDATA entity annotation.
Sections [Rules]:4.2.2 [76]
Test ID:not-wf-sa-083
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Undefined NOTATION n.

Sections [Rules]:4.2.2 [76]
Test ID:o-p76fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required before "NDATA"

Sections [Rules]:4.2.2 [76]
Test ID:o-p76fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

"NDATA" is upper-case

Sections [Rules]:4.2.2 [76]
Test ID:o-p76fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

notation name is required

Sections [Rules]:4.2.2 [76]
Test ID:o-p76fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

notation names are Names

Sections [Rules]:4.2 [70]
Test ID:not-wf-sa-109
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tags invalid within EntityDecl.

Sections [Rules]:4.2 [70]
Test ID:o-p70fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

This is neither

Sections [Rules]:4.2 [71]
Test ID:not-wf-sa-062
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Entity declarations need space after the entity name.

Sections [Rules]:4.2 [71]
Test ID:o-p71fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required before EntityDef

Sections [Rules]:4.2 [71]
Test ID:o-p71fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Entity name is a Name, not an NMToken

Sections [Rules]:4.2 [71]
Test ID:o-p71fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no S after "<!"

Sections [Rules]:4.2 [71]
Test ID:o-p71fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required after "<!ENTITY"

Sections [Rules]:4.2 [72]
Test ID:not-wf-sa-165
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Parameter entity declarations must have a space before the '%'.

Sections [Rules]:4.2 [72]
Test ID:o-p72fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required after "<!ENTITY"

Sections [Rules]:4.2 [72]
Test ID:o-p72fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required after '%'

Sections [Rules]:4.2 [72]
Test ID:o-p72fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

S is required after name

Sections [Rules]:4.2 [72]
Test ID:o-p72fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Entity name is a name, not an NMToken

Sections [Rules]:4.2 [73]
Test ID:o-p73fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

No typed replacement text

Sections [Rules]:4.2 [73]
Test ID:o-p73fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Only one replacement value

Sections [Rules]:4.2 [73]
Test ID:o-p73fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

No NDataDecl on replacement text

Sections [Rules]:4.2 [73]
Test ID:o-p73fail4
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

Value is required

Sections [Rules]:4.2 [73]
Test ID:o-p73fail5
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

No NDataDecl without value

Sections [Rules]:4.2 [74]
Test ID:not-wf-sa-089
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Parameter entities "are" always parsed; NDATA annotations are not permitted.
Sections [Rules]:4.2 [74]
Test ID:not-wf-sa-091
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Parameter entities "are" always parsed; NDATA annotations are not permitted.
Sections [Rules]:4.2 [74]
Test ID:o-p74fail1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

no NDataDecls on parameter entities

Sections [Rules]:4.2 [74]
Test ID:o-p74fail2
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

value is required

Sections [Rules]:4.2 [74]
Test ID:o-p74fail3
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

only one value

Sections [Rules]:4.3.1
Test ID:ibm-not-wf-P77-ibm77n01.xml
RECOMMENDATION:XML1.0
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

Tests TextDecl with wrong field ordering. The VersionInfo occurs after the EncodingDecl in the TextDecl in the file "ibm77n01.ent".

Sections [Rules]:4.3.1
Test ID:ibm-not-wf-P77-ibm77n02.xml
RECOMMENDATION:XML1.0
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

Tests TextDecl with wrong key word. The string "XML" is used in the beginning sequence in the TextDecl in the file "ibm77n02.ent".

Sections [Rules]:4.3.1
Test ID:ibm-not-wf-P77-ibm77n03.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 77

Tests TextDecl with wrong closing sequence. The character "greater than" is used as the closing sequence in the TextDecl in the file "ibm77n03.ent".

Sections [Rules]:4.3.1
Test ID:ibm-not-wf-P77-ibm77n04.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 77

Tests TextDecl with a required field missing. The closing sequence is missing in the TextDecl in the file "ibm77n04.ent".

Sections [Rules]:4.3.1 [77]
Test ID:decl01
RECOMMENDATION:XML1.0
Entities:parameter
Collection:Sun Microsystems XML Tests

External entities may not have standalone decls.

Sections [Rules]:4.3.1 [77]
Test ID:dtd07
RECOMMENDATION:XML1.0
Entities:parameter
Collection:Sun Microsystems XML Tests

Text declarations (which optionally begin any external entity) are required to have "encoding=...".

Sections [Rules]:4.3.1 [77]
Test ID:encoding07
RECOMMENDATION:XML1.0
Entities:parameter
Collection:Sun Microsystems XML Tests

Text declarations (which optionally begin any external entity) are required to have "encoding=...".

Sections [Rules]:4.3.1 4.3.2 [77, 78]
Test ID:not-wf-ext-sa-002
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

External entities have "text declarations", which do not permit the "standalone=..." attribute that's allowed in XML declarations.
Sections [Rules]:4.3.2
Test ID:not-wf-sa-074
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Internal general parsed entities are only well formed if they match the "content" production.

Sections [Rules]:4.3.2
Test ID:not-wf-sa-103
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

End-tag required for element foo.

Sections [Rules]:4.3.2
Test ID:not-wf-sa-104
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Internal general parsed entities are only well formed if they match the "content" production.

Sections [Rules]:4.3.2
Test ID:not-wf-sa-116
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Internal general parsed entities are only well formed if they match the "content" production. This is a partial character reference, not a full one.

Sections [Rules]:4.3.2
Test ID:not-wf-sa-117
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Internal general parsed entities are only well formed if they match the "content" production. This is a partial character reference, not a full one.

Sections [Rules]:4.3.2
Test ID:not-wf-sa-119
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Internal general parsed entities are only well formed if they match the "content" production. This is a partial character reference, not a full one.

Sections [Rules]:4.3.2
Test ID:not-wf-sa-153
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Text declarations may not begin internal parsed entities; they may only appear at the beginning of external parsed (parameter or general) entities.

Sections [Rules]:4.3.2
Test ID:not-wf-sa-181
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Internal parsed entities must match the content production to be well formed.

Sections [Rules]:4.3.2
Test ID:not-wf-sa-182
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Internal parsed entities must match the content production to be well formed.

Sections [Rules]:4.3.2
Test ID:ibm-not-wf-P78-ibm78n01.xml
RECOMMENDATION:XML1.0
Entities:general
Collection:IBM XML Conformance Test Suite - Production 78

Tests extParsedEnt with wrong field ordering. The TextDecl occurs after the content in the file ibm78n01.ent.

Sections [Rules]:4.3.2
Test ID:ibm-not-wf-P78-ibm78n02.xml
RECOMMENDATION:XML1.0
Entities:general
Collection:IBM XML Conformance Test Suite - Production 78

Tests extParsedEnt with extra field. A blank line occurs before the TextDecl in the file ibm78n02.ent.

Sections [Rules]:4.3.2
Test ID:ibm-not-wf-P79-ibm79n01.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 79

Tests extPE with wrong field ordering. The TextDecl occurs after the extSubsetDecl (the white space and the comment) in the file ibm79n01.ent.

Sections [Rules]:4.3.2
Test ID:ibm-not-wf-P79-ibm79n02.xml
RECOMMENDATION:XML1.0
Entities:parameter
Collection:IBM XML Conformance Test Suite - Production 79

Tests extPE with extra field. A blank line occurs before the TextDecl in the file ibm78n02.ent.

Sections [Rules]:4.3.2 [79]
Test ID:not-wf-not-sa-007
RECOMMENDATION:XML1.0
Entities:both
Collection:James Clark XMLTEST cases, 18-Nov-1998

A <!DOCTYPE ...> declaration may not begin any external entity; it's only found once, in the document entity.
Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P80-ibm80n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 80

Tests EncodingDecl with a required field missing. The leading white space is missing in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P80-ibm80n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 80

Tests EncodingDecl with a required field missing. The "=" sign is missing in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P80-ibm80n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 80

Tests EncodingDecl with a required field missing. The double quoted EncName are missing in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P80-ibm80n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 80

Tests EncodingDecl with wrong field ordering. The string "encoding=" occurs after the double quoted EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P80-ibm80n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 80

Tests EncodingDecl with wrong field ordering. The "encoding" occurs after the double quoted EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P80-ibm80n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 80

Tests EncodingDecl with wrong key word. The string "Encoding" is used as the key word in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P81-ibm81n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 81

Tests EncName with an illegal character. The "_" is used as the first character in the EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P81-ibm81n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 81

Tests EncName with an illegal character. The "-" is used as the first character in the EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P81-ibm81n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 81

Tests EncName with an illegal character. The "." is used as the first character in the EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P81-ibm81n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 81

Tests EncName with illegal characters. The "8-" is used as the initial characters in the EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P81-ibm81n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 81

Tests EncName with an illegal character. The "~" is used as one character in the EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P81-ibm81n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 81

Tests EncName with an illegal character. The "#" is used as one character in the EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P81-ibm81n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 81

Tests EncName with an illegal character. The ":" is used as one character in the EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P81-ibm81n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 81

Tests EncName with an illegal character. The "/" is used as one character in the EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3
Test ID:ibm-not-wf-P81-ibm81n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 81

Tests EncName with an illegal character. The ";" is used as one character in the EncName in the EncodingDecl in the XMLDecl.

Sections [Rules]:4.3.3 [81]
Test ID:not-wf-sa-101
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Space is not permitted in an encoding name.

Sections [Rules]:4.3.3 [81]
Test ID:encoding01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal character " " in encoding name
Sections [Rules]:4.3.3 [81]
Test ID:encoding02
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal character "/" in encoding name
Sections [Rules]:4.3.3 [81]
Test ID:encoding03
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal character reference in encoding name
Sections [Rules]:4.3.3 [81]
Test ID:encoding04
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal character ":" in encoding name
Sections [Rules]:4.3.3 [81]
Test ID:encoding05
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal character "@" in encoding name
Sections [Rules]:4.3.3 [81]
Test ID:encoding06
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

Illegal character "+" in encoding name
Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n01.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and that of the external dtd 1.0. The external dtd contains the invalid XML1.1 but valid XML 1.0 character #x7F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n02.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and that of the external dtd 1.0. The external dtd contains a comment with the invalid XML1.1 but valid XML 1.0 character #x80.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n03.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and that of the external dtd 1.0. The external dtd contains a PI with the invalid XML1.1 but valid XML 1.0 character #x9F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n04.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and that of the external entity 1.0. The external entity the contains invalid XML1.1 but valid XML 1.0 character #x89.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n05.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and that of the external entity 1.0. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x94.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n06.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and that of the external entity 1.0. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x9F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n07.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and the external dtd does not contain a textDecl. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x7F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n08.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and the external dtd does not contain a VersionNum in the textDecl. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x9B.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n09.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and the external dtd does not contain a textDecl. The external entity contains the invalid XML1.1 but valid XML 1.0 character #x8D.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n10.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and the external dtd does not contain a VersionNum in the textDecl. The external entity contains the invalid XML 1.1 but valid XML 1.0 character #x84.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n11.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and the external dtd does not contain a textDecl. The external entity contains the invalid XML 1.1 but valid XML 1.0 character #x88.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n12.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the document entity is 1.1 and the external dtd does not contain a textDecl. The external entity contains the invalid XML 1.1 but valid XML 1.0 character #x8E.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n13.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the primary document entity is 1.0 and that of the external dtd is 1.0. The external dtd contains an external entity whose VersionNum is 1.1.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n14.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the primary document entity is 1.1 and that of the external dtd is 1.0. The external dtd contains an element declaration with an invalid XML 1.1 and 1.0 name.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n15.xml
RECOMMENDATION:XML1.1
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the primary document entity is 1.1 and testDecl of the external dtd is absent. The external dtd contains an external entity whose VersionNum is 1.1 containing a valid XML1.0 but an invalid XML 1.1 character #x7F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n16.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the primary document entity is 1.0 and VersioNum of the external entity is absent. The replacement text of the entity contains an element followed by the valid XML 1.1 of line character NEL #x85 in its empty elem tag.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n17.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the primary document entity is absent and that of the external entity is 1.0. The textDecl in the external entity contains an invalid XML1.0 but valid XML 1.1 enf of line character NEL #x85.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n18.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the primary document entity is absent and that of the external entity is 1.0. The textDecl in the external entity contains an invalid XML1.0 but valid XML 1.1 of line character Unicode line separator #x2028.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n19.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the primary document entity is 1.1 and that of the external dtd is absent. The external dtd contains an external entity whose VersionNum is absent and it contains a valid XML 1.0 but an invalid XML 1.1 character #x94.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n20.xml
RECOMMENDATION:XML1.1
Entities:general
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the primary document entity is 1.1 and that of the external dtd is 1.1. The external dtd contains an external entity whose VersionNum is absent and it contains a valid XML 1.0 but an invalid XML 1.1 character #x8F.

Sections [Rules]:4.3.4
Test ID:ibm-1-1-not-wf-P77-ibm77n21.xml
RECOMMENDATION:XML1.1
Entities:both
Collection:IBM XML Conformance Test Suite - Production 77

The VersionNum of the primary document entity is 1.1 and the texlDecl of the external dtd is absent. The external dtd contains a reference to an external parameter entity whose VersionNum is absent from the textDecl and it contains an invalid XML 1.1 character #x8F.

Sections [Rules]:4.5
Test ID:not-wf-sa-092
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

The replacement text of this entity has an illegal reference, because the character reference is expanded immediately.

Sections [Rules]:4.5
Test ID:not-wf-sa-115
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

The replacement text of this entity is an illegal character reference, which must be rejected when it is parsed in the context of an attribute value.
Sections [Rules]:4.5
Test ID:not-wf-sa-120
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Character references are expanded in the replacement text of an internal entity, which is then parsed as usual. Accordingly, & must be doubly quoted - encoded either as &amp; or as &#38;#38;.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P82-ibm82n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 82

Tests NotationDecl with a required field missing. The white space after the beginning sequence of the NotationDecl is missing in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P82-ibm82n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 82

Tests NotationDecl with a required field missing. The Name in the NotationDecl is missing in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P82-ibm82n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 82

Tests NotationDecl with a required field missing. The externalID or the PublicID is missing in the NotationDecl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P82-ibm82n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 82

Tests NotationDecl with wrong field ordering. The Name occurs after the "SYSTEM" and the externalID in the NotationDecl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P82-ibm82n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 82

Tests NotationDecl with wrong key word. The string "notation" is used as a key word in the NotationDecl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P82-ibm82n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 82

Tests NotationDecl with a required field missing. The closing bracket (the greater than character) is missing in the NotationDecl.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P82-ibm82n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 82

Tests NotationDecl with wrong beginning sequence. The "!" is missing in the beginning sequence in the NotationDecl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P82-ibm82n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 82

Tests NotationDecl with wrong closing sequence. The extra "!" occurs in the closing sequence in the NotationDecl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P83-ibm83n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 83

Tests PublicID with wrong key word. The string "public" is used as the key word in the PublicID in the NotationDcl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P83-ibm83n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 83

Tests PublicID with wrong key word. The string "Public" is used as the key word in the PublicID in the NotationDcl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P83-ibm83n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 83

Tests PublicID with a required field missing. The key word "PUBLIC" is missing in the PublicID in the NotationDcl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P83-ibm83n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 83

Tests PublicID with a required field missing. The white space between the "PUBLIC" and the PubidLiteral is missing in the PublicID in the NotationDcl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P83-ibm83n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 83

Tests PublicID with a required field missing. The PubidLiteral is missing in the PublicID in the NotationDcl in the DTD.

Sections [Rules]:4.7
Test ID:ibm-not-wf-P83-ibm83n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 83

Tests PublicID with wrong field ordering. The key word "PUBLIC" occurs after the PubidLiteral in the PublicID in the NotationDcl.

Sections [Rules]:41. [68]
Test ID:not-wf-sa-077
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Undefined ENTITY bar.

Sections [Rules]:5
Test ID:rmt-ns11-005
RECOMMENDATION:NS1.1
Collection:Richard Tobin's XML Namespaces 1.1 test suite 14 Feb 2003

Illegal use of prefix that has been unbound

Sections [Rules]:5.3
Test ID:rmt-ns10-035
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Attribute uniqueness: repeated identical attribute

Sections [Rules]:5.3
Test ID:rmt-ns10-036
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Attribute uniqueness: repeated attribute with different prefixes

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x00D7 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x00F7 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0132 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0133 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x013F occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0140 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0149 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x017F occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x01c4 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x01CC occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n100.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0BB6 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n101.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0BBA occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n102.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0C0D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n103.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0C11 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n104.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0C29 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n105.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0C34 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n106.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0C5F occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n107.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0C62 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n108.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0C8D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n109.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0C91 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x01F1 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n110.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0CA9 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n111.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0CB4 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n112.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0CBA occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n113.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0CDF occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n114.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0CE2 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n115.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0D0D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n116.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0D11 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n117.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0D29 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n118.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0D3A occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n119.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0D62 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x01F3 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n120.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E2F occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n121.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E31 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n122.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E34 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n123.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E46 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n124.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E83 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n125.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E85 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n126.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E89 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n127.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E8B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n128.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E8E occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n129.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0E98 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n13.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x01F6 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n130.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EA0 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n131.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EA4 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n132.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EA6 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n133.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EA8 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n134.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EAC occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n135.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EAF occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n136.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EB1 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n137.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EB4 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n138.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EBE occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n139.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0EC5 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n14.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x01F9 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n140.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0F48 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n141.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0F6A occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n142.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x10C6 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n143.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x10F7 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n144.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1011 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n145.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1104 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n146.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1108 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n147.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x110A occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n148.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x110D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n149.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x113B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n15.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x01F9 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n150.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x113F occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n151.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1141 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n152.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x114D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n153.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x114f occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n154.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1151 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n155.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1156 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n156.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x115A occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n157.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1162 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n158.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1164 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n159.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1166 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n16.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0230 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n160.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x116B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n161.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x116F occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n162.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1174 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n163.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x119F occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n164.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x11AC occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n165.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x11B6 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n166.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x11B9 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n167.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x11BB occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n168.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x11C3 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n169.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x11F1 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n17.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x02AF occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n170.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x11FA occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n171.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1E9C occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n172.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1EFA occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n173.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1F16 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n174.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1F1E occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n175.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1F46 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n176.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1F4F occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n177.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1F58 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n178.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1F5A occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n179.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1F5C occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n18.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x02CF occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n180.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1F5E occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n181.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #xF17E occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n182.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FB5 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n183.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FBD occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n184.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FBF occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n185.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FC5 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n186.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FCD occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n187.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FD5 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n188.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FDC occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n189.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FED occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n19.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0387 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n190.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FF5 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n191.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x1FFD occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n192.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x2127 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n193.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x212F occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n194.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x2183 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n195.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x3095 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n196.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x30FB occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n197.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x312D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n198.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #xD7A4 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n20.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x038B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n21.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x03A2 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n22.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x03CF occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n23.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x03D7 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n24.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x03DD occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n25.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x03E1 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n26.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x03F4 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n27.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x040D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n28.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0450 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n29.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x045D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n30.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0482 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n31.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x04C5 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n32.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x04C6 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n33.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x04C9 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n34.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x04EC occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n35.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x04ED occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n36.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x04F6 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n37.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x04FA occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n38.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0557 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n39.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0558 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n40.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0587 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n41.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x05EB occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n42.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x05F3 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n43.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0620 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n44.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x063B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n45.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x064B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n46.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x06B8 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n47.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x06BF occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n48.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x06CF occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n49.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x06D4 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n50.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x06D6 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n51.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x06E7 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n52.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x093A occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n53.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x093E occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n54.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0962 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n55.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x098D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n56.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0991 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n57.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0992 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n58.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x09A9 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n59.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x09B1 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n60.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x09B5 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n61.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x09BA occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n62.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x09DE occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n63.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x09E2 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n64.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x09F2 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n65.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A0B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n66.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A11 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n67.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A29 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n68.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A31 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n69.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A34 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n70.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A37 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n71.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A3A occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n72.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A5B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n73.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A70 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n74.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A75 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n75.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n76.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0ABC occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n77.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0A92 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n78.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0AA9 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n79.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0AB1 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n80.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0AB4 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n81.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0ABA occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n82.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B04 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n83.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B0D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n84.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B11 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n85.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B29 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n86.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B31 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n87.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B34 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n88.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B3A occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n89.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B3E occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n90.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B5E occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n91.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B62 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n92.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B8B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n93.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B91 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n94.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B98 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n95.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B9B occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n96.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0B9D occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n97.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0BA0 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n98.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0BA7 occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P85-ibm85n99.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 85

Tests BaseChar with an illegal character. The character #x0BAB occurs as the first character of the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P86-ibm86n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 86

Tests Ideographic with an illegal character. The character #x4CFF occurs as the first character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P86-ibm86n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 86

Tests Ideographic with an illegal character. The character #x9FA6 occurs as the first character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P86-ibm86n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 86

Tests Ideographic with an illegal character. The character #x3008 occurs as the first character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P86-ibm86n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 86

Tests Ideographic with an illegal character. The character #x302A occurs as the first character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x02FF occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0346 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0362 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0487 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x05A2 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x05BA occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x05BE occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x05C0 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x05C3 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0653 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x06B8 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x06B9 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n13.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x06E9 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n14.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x06EE occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n15.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0904 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n16.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x093B occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n17.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x094E occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n18.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0955 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n19.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0964 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n20.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0984 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n21.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x09C5 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n22.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x09C9 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n23.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x09CE occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n24.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x09D8 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n25.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x09E4 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n26.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0A03 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n27.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0A3D occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n28.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0A46 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n29.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0A49 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n30.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0A4E occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n31.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0A80 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n32.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0A84 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n33.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0ABB occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n34.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0AC6 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n35.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0ACA occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n36.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0ACE occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n37.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0B04 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n38.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0B3B occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n39.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0B44 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n40.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0B4A occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n41.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0B4E occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n42.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0B58 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n43.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0B84 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n44.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0BC3 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n45.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0BC9 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n46.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0BD6 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n47.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0C0D occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n48.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0C45 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n49.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0C49 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n50.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0C54 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n51.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0C81 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n52.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0C84 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n53.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0CC5 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n54.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0CC9 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n55.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0CD4 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n56.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0CD7 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n57.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0D04 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n58.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0D45 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n59.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0D49 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n60.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0D4E occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n61.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0D58 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n62.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0E3F occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n63.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0E3B occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n64.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0E4F occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n66.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0EBA occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n67.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0EBE occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n68.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0ECE occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n69.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F1A occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n70.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F36 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n71.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F38 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n72.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F3B occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n73.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F3A occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n74.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F70 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n75.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F85 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n76.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F8C occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n77.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F96 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n78.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0F98 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n79.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0FB0 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n80.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0FB8 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n81.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x0FBA occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n82.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x20DD occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n83.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x20E2 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n84.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x3030 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P87-ibm87n85.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 87

Tests CombiningChar with an illegal character. The character #x309B occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0029 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x003B occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x066A occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x06FA occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0970 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x09F2 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0AF0 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0B70 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0C65 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0CE5 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0CF0 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n13.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0D70 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n14.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0E5A occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n15.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0EDA occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P88-ibm88n16.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 88

Tests Digit with an illegal character. The character #x0F2A occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x00B6 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x00B8 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x02D2 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x03FE occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x065F occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n06.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x0EC7 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n07.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x3006 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n08.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x3030 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n09.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x3036 occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n10.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x309C occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n11.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x309F occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:B.
Test ID:ibm-not-wf-P89-ibm89n12.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 89

Tests Extender with an illegal character. The character #x30FF occurs as the second character in the PITarget in the PI in the DTD.

Sections [Rules]:E27
Test ID:rmt-e2e-27
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

Contains an irregular UTF-8 sequence (i.e. a surrogate pair)

Sections [Rules]:E38
Test ID:rmt-e2e-38
RECOMMENDATION:XML1.0-errata2e
Entities:general
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

XML 1.0 document refers to 1.1 entity

Sections [Rules]:E61
Test ID:rmt-e2e-61
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

(From John Cowan) An encoding declaration in ASCII specifying an encoding that is not compatible with ASCII (so the document is not in its declared encoding). It should generate a fatal error.

Sections [Rules]:NE05
Test ID:rmt-ns10-029
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Reserved prefixes and namespaces: declaring the xml prefix incorrectly

Sections [Rules]:NE05
Test ID:rmt-ns10-030
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Reserved prefixes and namespaces: binding another prefix to the xml namespace

Sections [Rules]:NE05
Test ID:rmt-ns10-031
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Reserved prefixes and namespaces: declaring the xmlns prefix with its correct URI (illegal)

Sections [Rules]:NE05
Test ID:rmt-ns10-032
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Reserved prefixes and namespaces: declaring the xmlns prefix with an incorrect URI

Sections [Rules]:NE05
Test ID:rmt-ns10-033
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Reserved prefixes and namespaces: binding another prefix to the xmlns namespace

Sections [Rules]:NE08
Test ID:rmt-ns10-042
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Colon in PI name

Sections [Rules]:NE08
Test ID:rmt-ns10-043
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Colon in entity name

Sections [Rules]:NE08
Test ID:rmt-ns10-044
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Colon in entity name

3.4 XML Documents with Optional Errors

Conforming XML 1.0 Processors are permitted to ignore certain errors, or to report them at user option. In this section of this test report are found descriptions of test cases which fit into this category.

Processor behavior on such test cases does not affect conformance to the XML 1.0 (Second Edition) Recommendation, except as noted.

Sections [Rules]:2
Test ID:rmt-ns10-004
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace name test: a relative URI (deprecated)

Sections [Rules]:2
Test ID:rmt-ns10-005
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace name test: a same-document relative URI (deprecated)

Sections [Rules]:2
Test ID:rmt-ns10-006
RECOMMENDATION:NS1.0
Collection:Richard Tobin's XML Namespaces 1.0 test suite 14 Feb 2003

Namespace name test: an http IRI that is not a URI

Sections [Rules]:2.11
Test ID:rmt-055
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a Latin-1 NEL in the XML declaration (to be made an error in PR)

Sections [Rules]:2.11
Test ID:rmt-056
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a UTF-8 NEL in the XML declaration (to be made an error in PR)

Sections [Rules]:2.11
Test ID:rmt-057
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

Has a UTF-8 LSEP in the XML declaration (to be made an error in PR)

Sections [Rules]:2.3, 4.2.2 [11]
Test ID:o-p11pass1
RECOMMENDATION:XML1.0
Collection:OASIS/NIST TESTS, 1-Nov-1998

system literals may not contain URI fragments

Sections [Rules]:2.8 4.3.4
Test ID:rmt-008
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

an implausibly-versioned document

Sections [Rules]:2.8 4.3.4
Test ID:rmt-009
RECOMMENDATION:XML1.1
Collection:Richard Tobin's XML 1.1 test suite 13 Feb 2003

External general entity has implausible version number

Sections [Rules]:4.1
Test ID:not-wf-not-sa-005
RECOMMENDATION:XML1.0
Collection:James Clark XMLTEST cases, 18-Nov-1998

Tests the Entity Declared VC by referring to an undefined parameter entity within an external entity.
Sections [Rules]:4.1
Test ID:ibm-invalid-P68-ibm68i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests invalid EntityRef which is against P68 VC: Entity Declared. The GE with the name "ge2" is referred in the file ibm68i01.dtd", but not declared.

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-invalid-P68-ibm68i02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests invalid EntityRef which is against P68 VC: Entity Declared. The GE with the name "ge1" is referred before declared in the file ibm68i01.dtd".

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-invalid-P68-ibm68i03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests invalid EntityRef which is against P68 VC: Entity Declared. The GE with the name "ge2" is referred in the file ibm68i03.ent", but not declared.

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-invalid-P68-ibm68i04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 68

Tests invalid EntityRef which is against P68 VC: Entity Declared. The GE with the name "ge1" is referred before declared in the file ibm68i04.ent".

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-invalid-P69-ibm69i01.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests invalid PEReference which is against P69 VC: Entity Declared. The Name "pe2" in the PEReference in the file ibm69i01.dtd does not match the Name of any declared PE.

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-invalid-P69-ibm69i02.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests invalid PEReference which is against P69 VC: Entity Declared. The PE with the name "pe1" is referred before declared in the file ibm69i02.dtd

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-invalid-P69-ibm69i03.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests invalid PEReference which is against P69 VC: Entity Declared. The Name "pe3" in the PEReference in the file ibm69i03.ent does not match the Name of any declared PE.

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-invalid-P69-ibm69i04.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Tests invalid PEReference which is against P69 VC: Entity Declared. The PE with the name "pe2" is referred before declared in the file ibm69i04.ent.

There is an output test associated with this input file.
Sections [Rules]:4.1
Test ID:ibm-not-wf-P69-ibm69n05.xml
RECOMMENDATION:XML1.0
Collection:IBM XML Conformance Test Suite - Production 69

Based on E29 substantial source: minutes XML-Syntax 1999-02-24 E38 in XML 1.0 Errata, this WFC does not apply to P69, but the VC Entity declared still apply. Tests PEReference which is against P69 WFC: Entity Declared. The PE with the name "paaa" is referred before declared in the DTD.

Sections [Rules]:4.2.2 [75]
Test ID:uri01
RECOMMENDATION:XML1.0
Collection:Sun Microsystems XML Tests

SYSTEM ids may not have URI fragments
Sections [Rules]:4.3.3 [4,84]
Test ID:pr-xml-euc-jp
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for the EUC-JP encoding, and for text which relies on Japanese characters. If a processor does not support this encoding, it must report a fatal error. (Also requires ability to process a moderately complex DTD.)

Sections [Rules]:4.3.3 [4,84]
Test ID:pr-xml-iso-2022-jp
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for the ISO-2022-JP encoding, and for text which relies on Japanese characters. If a processor does not support this encoding, it must report a fatal error. (Also requires ability to process a moderately complex DTD.)

Sections [Rules]:4.3.3 [4,84]
Test ID:pr-xml-shift_jis
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for the Shift_JIS encoding, and for text which relies on Japanese characters. If a processor does not support this encoding, it must report a fatal error. (Also requires ability to process a moderately complex DTD.)

Sections [Rules]:4.3.3 [4,84]
Test ID:weekly-euc-jp
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for EUC-JP encoding, and XML names which contain Japanese characters. If a processor does not support this encoding, it must report a fatal error.

Sections [Rules]:4.3.3 [4,84]
Test ID:weekly-iso-2022-jp
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for ISO-2022-JP encoding, and XML names which contain Japanese characters. If a processor does not support this encoding, it must report a fatal error.

Sections [Rules]:4.3.3 [4,84]
Test ID:weekly-shift_jis
RECOMMENDATION:XML1.0
Collection:Fuji Xerox Japanese Text Tests

Test support for Shift_JIS encoding, and XML names which contain Japanese characters. If a processor does not support this encoding, it must report a fatal error.

Sections [Rules]:E34
Test ID:rmt-e2e-34
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

A non-deterministic content model is an error even if the element type is not used.

Sections [Rules]:E55
Test ID:rmt-e2e-55
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

A reference to an unparsed entity in an entity value is an error rather than forbidden (unless the entity is referenced, of course)

Sections [Rules]:E57
Test ID:rmt-e2e-57
RECOMMENDATION:XML1.0-errata2e
Collection:Richard Tobin's XML 1.0 2nd edition errata test suite 21 Jul 2003

A value other than preserve or default for xml:space is an error

4. Contributors (Non-normative)

A team of volunteer members have participated in the development of this work. Contributions have come from:

  • Murry Altheim, Sun Microsystems
  • Mary Brady, NIST
  • Tim Boland, NIST
  • David Brownell, Sun Microsystems
  • James Clark
  • Karin Donker, IBM
  • Irina Golfman, Inera Incorporated
  • Tony Graham, Mulberry Technologies
  • G. Ken Holman, Crane Softwrights Ltd
  • Alex Milowski, Veo Systems, Inc
  • Makota Murata, Fuji Xerox
  • Miles O'Reilly, Microstar Software, Ltd
  • Matt Timmermans, Microstar Software, Ltd
  • Richard Rivello, NIST
  • Lynne Rosenthal, NIST
  • Brian Schellar, Chrystal Software
  • Bill Smith, Sun Microsystems
  • Trevor Veary, Software AG
  • Richard Tobin, University of Edinburgh
  • Jonathan Marsh, Microsoft
  • Daniel Veillard, Red Hat Network
  • Jonathan Marsh, Microsoft
  • Paul Grosso, Arbortext

End

hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmlconformance.msxsl0000644006511100651110000004741310504340465026121 0ustar rossross Generated by an XSL stylesheet. XML Conformance Tests
A Joint Development Effort

OASIS XML Conformance Subcommittee
XML 1.0 Test Suite, Second Edition
Working Draft
15 March 2001

This version:

Current Version:

Previous Version:

Test Archive:

OASIS XML Conformance Technical Committee:

Comments:

Table of Contents

  1. Introduction
  2. Test Matrix
    1. Binary Tests
    2. Output Tests
  3. Test Case Descriptions
    1. Valid Documents
    2. Invalid Documents
    3. Not-WF Documents
    4. Optional Errors
  4. Contributors

1. Introduction

The OASIS XML Conformance Subcommittee is concerned with improving the quality of XML processors. The tests described in this document provide a set of metrics to determine how well a particular implementation conforms to the W3C XML 1.0 (Second Edition) Recommendation . The XML Conformance Test Suite is intended to complement the W3C XML 1.0 (Second Edition) Recommendation. All interpretations of this Recommendation are subject to confirmation by the W3C XML Coordination Group.

Conformance tests can be used by developers, content creators, and users alike to increase their level of confidence in product quality. In circumstances where interoperability is necessary, these tests can also be used to determine that differing implementations support the same set of features.

This report provides supporting documentation for all of the tests contributed by members of the OASIS XML Conformance Subcommittee. Sources from which these tests have been collected include: ; . Although the tests came from a variety of sources, the actual test descriptions and references back to the recommendation were in many instances added by members of this subcommittee. It is anticipated that this report will supplement the actual tests, which are available from http://www.oasis-open.org/committees/xml-conformance/xml-test-suite.html.

Comments/suggestions should be forwarded to the XML Conformance Subcommittee Chair, Mary Brady <mbrady@nist.gov>.

2. Test Matrix

Two basic types of test are presented here. These are respectively Binary Tests and Output Tests.

2.1 Binary Tests

Binary conformance tests are documents which are grouped into one of four categories. Given a document in a given category, each kind of XML parser must treat it consistently and either accept it (a positive test) or reject it (a negative test). It is in that sense that the tests are termed "binary". The XML 1.0 (Second Edition) Recommendation talks in terms of two types of XML processor: validating ones, and nonvalidating ones. There are two differences between these types of processors:

  1. Validating processors check special productions that nonvalidating parsers don't, called validity constraints. (Both must check a basic set of productions, requiring XML documents to be well formed.)
  2. Nonvalidating processors are permitted to not include external entities, such as files with text. Accordingly, they may not report errors which would have been detected had those entities been read.

There are two types of such entity, parameter entities holding definitions which affect validation and other processing; and general entities which hold marked up text. It will be appreciated that there are then five kinds of XML processor: validating processors, and four kinds of nonvalidating processor based on the combinations of external entity which they include.

Basic XML Parsing Test Matrix
Test Document Type v. Parser Type
  Nonvalidating Validating
External Entities
Ignored (3 cases)		 External Entities
Read
Valid Documents accept accept accept
Invalid Documents accept accept reject
Non-WF Documents reject reject reject
WF Errors tied
to External Entity		 accept
(varies)		 reject reject
Documents with
Optional Errors		 (not specified) (not specified) (not specified)

At this time, the XML community primarily uses parsers which are in the rightmost two columns of this table, calling them Well Formed XML Parsers (or "WF Parsers") and Validating XML Parsers. A second test matrix could be defined to address the variations in the types of of XML processor which do not read all external entities. That additional matrix is not provided here at this time.

2.2 Output Tests

The XML 1.0 (Second Edition) Recommendation places a number of requirements on XML processors, to ensure that they report information to applications as needed. Such requirements are testable. Validating processors are required to report slightly more information than nonvalidating ones, so some tests will require separate output files. Some of the information that must be reported will not be reportable without reading all the external entities in a particular test. Many of the tests for valid documents are paired with an output file to ensure that the XML processor provides the correct information.

The output of these tests is provided in two forms, as described in SUN Microsystems XML Canonical Forms. At present, the James Clark collection provides corresponding output in First XML Canonical Form, and the SUN Microsystems collection provides corresponding output in Second XML Canonical Form. When the W3C XML Group finalizes its work on Canonical XML, these output files will be updated.

3. Test Case Descriptions

This section of this report contains descriptions of test cases, each of which fits into the categories noted above. Each test case includes a document of one of the types in the binary test matrix above (e.g. valid or invalid documents).

In some cases, an output file , as described in Section 2.2, will also be associated with a valid document, which is used for output testing. If such a file exists, it will be noted at the end of the description of the input document.

The description for each test case is presented as a two part table. The right part describes what the test does. This description is intended to have enough detail to evaluate diagnostic messages. The left part includes:

  • An entry describing the Sections and/or Rules from the XML 1.0 (Second Edition) Recommendation which this case excercises.
  • The unique Test ID within a given Collection for this test.
  • The Collection from which this test originated. Given the Test ID and the Collection, each test can be uniquely identified.
  • Some tests may have a field identifying the kinds of external Entities a nonvalidating processor must include (parameter, general, or both) to be able to detect any errors in that test case.

Note that the output format of this report is subject to change. Also, since XSL does not currently support the type of sorting rule necessary to make section numbers like 2.12 appear after 2.2, the ordering is not quite what is desired.

3.1 Valid XML Documents

All conforming XML 1.0 Processors are required to accept valid documents, reporting no errors. In this section of this test report are found descriptions of test cases which fit into this category.

3.2 Invalid XML Documents

All conforming XML 1.0 Validating Processors are required to report recoverable errors in the case of documents which are Invalid. Such errors are violations of some validity constraint (VC).

If a validating processor does not report an error when given one of these test cases, or if the error reported is a fatal error, it is not conformant. If the error reported does not correspond to the problem listed in this test description, that could also be a conformance problem; it might instead be a faulty diagnostic.

All conforming XML 1.0 Nonvalidating Processors should accept these documents, reporting no errors.

3.3 Documents that are Not Well Formed

All conforming XML 1.0 Processors are required to report fatal errors in the case of documents which are not Well Formed. Such errors are basically of two types: (a) the document violates the XML grammar; or else (b) it violates a well formedness constraint (WFC). There is a single exception to that requirement: nonvalidating processors which do not read certain types of external entities are not required to detect (and hence report) these errors.

If a processor does not report a fatal error when given one of these test cases, it is not conformant. If the error reported does not correspond to the problem listed in this test description, that could also be a conformance problem; it might instead be a faulty diagnostic.

3.4 XML Documents with Optional Errors

Conforming XML 1.0 Processors are permitted to ignore certain errors, or to report them at user option. In this section of this test report are found descriptions of test cases which fit into this category.

Processor behavior on such test cases does not affect conformance to the XML 1.0 (Second Edition) Recommendation, except as noted.

4. Contributors (Non-normative)

A team of volunteer members have participated in the development of this work. Contributions have come from:

  • Murry Altheim, Sun Microsystems
  • Mary Brady, NIST
  • Tim Boland, NIST
  • David Brownell, Sun Microsystems
  • James Clark
  • Karin Donker, IBM
  • Irina Golfman, Inera Incorporated
  • Tony Graham, Mulberry Technologies
  • G. Ken Holman, Crane Softwrights Ltd
  • Alex Milowski, Veo Systems, Inc
  • Makota Murata, Fuji Xerox
  • Miles O'Reilly, Microstar Software, Ltd
  • Matt Timmermans, Microstar Software, Ltd
  • Richard Rivello, NIST
  • Lynne Rosenthal, NIST
  • Brian Schellar, Chrystal Software
  • Bill Smith, Sun Microsystems
  • Trevor Veary, Software AG
  • Eric Ye, IBM

End

Sections [Rules]:
Test ID:
Entities:
Collection:

There is an output test associated with this input file.
hugs98-plus-Sep2006/packages/HaXml/tests/xml-conformance/xmlconformance.xsl0000644006511100651110000004534310504340465025561 0ustar rossross XML Conformance Tests

W3C Architecture Domain XML | Member-Confidential!

XML W3C Conformance Test Suite

10 December 2003

This version:
Current Version:
Previous Version:
Test Archive:
W3C XML Core Working Group:
Comments:

Table of Contents

  1. Introduction
  2. Test Matrix
    1. Binary Tests
    2. Output Tests
  3. Test Case Descriptions
    1. Valid Documents
    2. Invalid Documents
    3. Not-WF Documents
    4. Optional Errors
  4. Contributors

1. Introduction

The tests described in this document provide an initial set of metrics to determine how well a particular implementation conforms to the following recommendations: W3C XML 1.0 (Second Edition) Recommendation, Extensible Markup Language (XML) 1.0 (Third Edition), Extensible Markup Language (XML) 1.1 (First Edition), and Namespaces in XML 1.1. The report properly identify the tests associated to each recommendation. All interpretations of these Recommendations are subject to confirmation by the W3C XML Group .

Conformance tests can be used by developers, content creators, and users alike to increase their level of confidence in product quality. In circumstances where interoperability is necessary, these tests can also be used to determine that differing implementations support the same set of features.

The XML Test Suite was transferred from OASIS to W3C and is being augmented to reflect the current work of the W3C XML Core Working Group, This report provides supporting documentation for all the tests included in the test suite. Sources from which these tests have been collected include: ; .

2. Test Matrix

Two basic types of test are presented here. These are respectively Binary Tests and Output Tests.

2.1 Binary Tests

Binary conformance tests are documents which are grouped into one of four categories. Given a document in a given category, each kind of XML parser must treat it consistently and either accept it (a positive test) or reject it (a negative test). It is in that sense that the tests are termed "binary". The XML 1.0 (Second Edition) Recommendation talks in terms of two types of XML processor: validating ones, and nonvalidating ones. There are two differences between these types of processors:

  1. Validating processors check special productions that nonvalidating parsers don't, called validity constraints. (Both must check a basic set of productions, requiring XML documents to be well formed.)
  2. Nonvalidating processors are permitted to not include external entities, such as files with text. Accordingly, they may not report errors which would have been detected had those entities been read.

There are two types of such entity, parameter entities holding definitions which affect validation and other processing; and general entities which hold marked up text. It will be appreciated that there are then five kinds of XML processor: validating processors, and four kinds of nonvalidating processor based on the combinations of external entity which they include.

Basic XML Parsing Test Matrix
Test Document Type v. Parser Type
Nonvalidating Validating
External Entities
Ignored (3 cases)		 External Entities
Read
Valid Documents accept accept accept
Invalid Documents accept accept reject
Non-WF Documents reject reject reject
WF Errors tied
to External Entity		 accept
(varies)		 reject reject
Documents with
Optional Errors		 (not specified) (not specified) (not specified)

At this time, the XML community primarily uses parsers which are in the rightmost two columns of this table, calling them Well Formed XML Parsers (or "WF Parsers") and Validating XML Parsers. A second test matrix could be defined to address the variations in the types of of XML processor which do not read all external entities. That additional matrix is not provided here at this time.

2.2 Output Tests

The XML 1.0 (Second Edition) Recommendation places a number of requirements on XML processors, to ensure that they report information to applications as needed. Such requirements are testable. Validating processors are required to report slightly more information than nonvalidating ones, so some tests will require separate output files. Some of the information that must be reported will not be reportable without reading all the external entities in a particular test. Many of the tests for valid documents are paired with an output file as the canonical representation of the input file, to ensure that the XML processor provides the correct information.

3. Test Case Descriptions

This section of this report contains descriptions of test cases, each of which fits into the categories noted above. Each test case includes a document of one of the types in the binary test matrix above (e.g. valid or invalid documents).

In some cases, an output file , as described in Section 2.2, will also be associated with a valid document, which is used for output testing. If such a file exists, it will be noted at the end of the description of the input document.

The description for each test case is presented as a two part table. The right part describes what the test does. This description is intended to have enough detail to evaluate diagnostic messages. The left part includes:

  • An entry describing the Sections and/or Rules from the XML 1.0 (Second Edition) Recommendation which this case excercises.
  • The unique Test ID within a given Collection for this test.
  • The Collection from which this test originated. Given the Test ID and the Collection, each test can be uniquely identified.
  • Some tests may have a field identifying the kinds of external Entities a nonvalidating processor must include (parameter, general, or both) to be able to detect any errors in that test case.

3.1 Valid XML Documents

All conforming XML 1.0 Processors are required to accept valid documents, reporting no errors. In this section of this test report are found descriptions of test cases which fit into this category.

3.2 Invalid XML Documents

All conforming XML 1.0 Validating Processors are required to report recoverable errors in the case of documents which are Invalid. Such errors are violations of some validity constraint (VC).

If a validating processor does not report an error when given one of these test cases, or if the error reported is a fatal error, it is not conformant. If the error reported does not correspond to the problem listed in this test description, that could also be a conformance problem; it might instead be a faulty diagnostic.

All conforming XML 1.0 Nonvalidating Processors should accept these documents, reporting no errors.

3.3 Documents that are Not Well Formed

All conforming XML 1.0 Processors are required to report fatal errors in the case of documents which are not Well Formed. Such errors are basically of two types: (a) the document violates the XML grammar; or else (b) it violates a well formedness constraint (WFC). There is a single exception to that requirement: nonvalidating processors which do not read certain types of external entities are not required to detect (and hence report) these errors.

If a processor does not report a fatal error when given one of these test cases, it is not conformant. If the error reported does not correspond to the problem listed in this test description, that could also be a conformance problem; it might instead be a faulty diagnostic.

3.4 XML Documents with Optional Errors

Conforming XML 1.0 Processors are permitted to ignore certain errors, or to report them at user option. In this section of this test report are found descriptions of test cases which fit into this category.

Processor behavior on such test cases does not affect conformance to the XML 1.0 (Second Edition) Recommendation, except as noted.

4. Contributors (Non-normative)

A team of volunteer members have participated in the development of this work. Contributions have come from:

  • Murry Altheim, Sun Microsystems
  • Mary Brady, NIST
  • Tim Boland, NIST
  • David Brownell, Sun Microsystems
  • James Clark
  • Karin Donker, IBM
  • Irina Golfman, Inera Incorporated
  • Tony Graham, Mulberry Technologies
  • G. Ken Holman, Crane Softwrights Ltd
  • Alex Milowski, Veo Systems, Inc
  • Makota Murata, Fuji Xerox
  • Miles O'Reilly, Microstar Software, Ltd
  • Matt Timmermans, Microstar Software, Ltd
  • Richard Rivello, NIST
  • Lynne Rosenthal, NIST
  • Brian Schellar, Chrystal Software
  • Bill Smith, Sun Microsystems
  • Trevor Veary, Software AG
  • Richard Tobin, University of Edinburgh
  • Jonathan Marsh, Microsoft
  • Daniel Veillard, Red Hat Network
  • Jonathan Marsh, Microsoft
  • Paul Grosso, Arbortext

End

Sections [Rules]:
Test ID:
RECOMMENDATION:
Entities:
Collection:

There is an output test associated with this input file.
hugs98-plus-Sep2006/packages/HaXml/tests/TestXml.hs0000644006511100651110000013070210504340457020655 0ustar rossross-------------------------------------------------------------------------------- -- $Id: TestXml.hs,v 1.35 2004/07/13 17:32:29 graham Exp $ -- -- Copyright (c) 2004, G. KLYNE. All rights reserved. -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : TestXml -- Copyright : (c) 2004, Graham Klyne -- License : LGPL V2 -- -- Maintainer : Graham Klyne -- Stability : provisional -- Portability : H98 -- -- This module contains test cases for XML parsing and XML handling libraries. -- -- The test cases make reference to externally stored test data files. -- -- The module is designed to be retargetable to alternative XML libraries -- with reasonable effort: the main body of test cases is isolated from the -- details of the XML library used. -- -------------------------------------------------------------------------------- module Main where import Text.XML.HaXml.Parse ( xmlParse' ) import Text.XML.HaXml.SubstitutePE ( subIntParamEntities ) import Text.XML.HaXml.SubstituteGEFilter ( subIntGenEntities , subExtGenEntities ) import Text.XML.HaXml.Validate ( validate ) import Text.XML.HaXml.Namespace ( processNamespaces ) import Text.XML.HaXml.XmlBase ( processXmlBase ) import Text.XML.HaXml.XmlLang ( processXmlLang ) import Text.XML.HaXml.Lex ( xmlLex , xmlLexTextDecl , xmlLexEntity , Posn(..), testPosn ) import Text.XML.HaXml.Traverse ( docReplaceContent , docErrorContent , xmlTreeElements , xmlListElements , xmlListTextContent , filterSingle , docContent ) import Text.XML.HaXml.Pretty ( document ) import Text.XML.HaXml.QName ( makeQN, showQN ) import Text.XML.HaXml.Types import HUnit ( Test(TestCase,TestList,TestLabel) , Assertable(..) , Assertion , assertBool, assertEqual, assertString, assertFailure , runTestTT, runTestText, putTextToHandle ) import IO ( Handle, IOMode(WriteMode) , openFile, hClose, hPutStr, hPutStrLn ) import List ( (\\) ) ------------------------------------------------------------ -- XML handling interfaces ------------------------------------------------------------ -- -- Subsequent tests are based on these interfaces. -- Re-implement these interfaces to use the XML package -- under test. -- doXmlLexOK :: String -> String -> Bool doXmlLexOK filepath filedata = not $ null (xmlLex filepath filedata) doXmlPreOK :: String -> String -> Bool doXmlPreOK filepath filedata = not $ null $ (subIntParamEntities filepath . xmlLex filepath) filedata doXmlParseOK :: String -> String -> Bool doXmlParseOK filepath filedata = either (const False) (const True) (xmlParse' filepath filedata) doXmlParseFormat :: String -> String -> String doXmlParseFormat filepath filedata = either ("Error: "++) (show . document) (xmlParse' filepath filedata) doXmlParseGESub :: String -> String -> String doXmlParseGESub filepath filedata = either ("Error: "++) (show . document . replaceContent) (xmlParse' filepath filedata) where replaceContent (Document p s e) = Document p s (docContent (subExtGenEntities s (CElem e))) docContent [CElem e] = e docContent [] = errElem "produced no output" docContent _ = errElem "produced more than one output" errElem err = Elem (makeQN "error") () [] [CErr err] doXmlParseGESub1 :: String -> String -> String doXmlParseGESub1 filepath filedata = either ("Error: "++) (show . document . replaceContent) (xmlParse' filepath filedata) where replaceContent (Document p s e) = processXmlLang . processXmlBase . processNamespaces $ Document p s (docContent (subExtGenEntities s (CElem e))) docContent [CElem e] = e docContent [] = errElem "produced no output" docContent _ = errElem "produced more than one output" errElem err = Elem (makeQN "error") () [] [CErr err] doXmlValidate :: String -> String -> [String] doXmlValidate filepath filedata = either (return . ("Error: "++)) (doValidate . replaceContent) (xmlParse' filepath filedata) where replaceContent (Document p s e) = Document p s (docContent (subExtGenEntities s (CElem e))) docContent [CElem e] = e docContent [] = errElem "produced no output" docContent _ = errElem "produced more than one output" errElem err = Elem (makeQN "error") () [] [CErr err] doValidate (Document (Prolog _ _ (Just dtd)) s e) = validate dtd e doValidate _ = ["No DTD in document for validation"] parseGESubDocument :: String -> String -> Document parseGESubDocument filepath filedata = subContent . either docErrorContent id $ (xmlParse' filepath filedata) where subContent doc@(Document p s e) = docReplaceContent (subExtGenEntities s) doc ------------------------------------------------------------ -- Test case helpers ------------------------------------------------------------ testEq :: (Eq a, Show a) => String -> a -> a -> Test testEq lab a1 a2 = TestCase ( assertEqual ("testEq:"++lab) a1 a2 ) assertParseOK :: String -> Bool -> (Either String Document) -> Assertion assertParseOK lab ok result = if ok then assertEqual lab "OK" (either id (const "OK") result) else assertEqual lab "error" (either (const "error") (const "OK") result) assertValid :: String -> Bool -> [String] -> Assertion assertValid lab ok [] = assertEqual lab (if ok then [] else ["error"]) [] assertValid lab ok result = assertEqual lab (if ok then [] else result) result ------------------------------------------------------------ -- XML test case functions ------------------------------------------------------------ testXmlLexOK :: String -> Bool -> String -> Test testXmlLexOK lab ok filepath = TestCase $ do { -- putStrLn ("\nTest "++lab) ; s <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; assertEqual lab ok (doXmlLexOK filepath s) } testXmlPreOK :: String -> Bool -> String -> Test testXmlPreOK lab ok filepath = TestCase $ do { -- putStrLn ("\nTest "++lab) ; s <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; assertEqual lab ok (doXmlPreOK filepath s) } testXmlParseOK :: String -> Bool -> String -> Test testXmlParseOK lab ok filepath = TestCase $ do { -- putStrLn ("\nTest "++lab) ; s <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; assertParseOK lab ok (xmlParse' filepath s) } testXmlFormat :: String -> String -> String -> Test testXmlFormat lab filepathI filepathF = TestCase $ do { si <- readFile filepathI -- ; writeFile (filepathF++".tmp") (doXmlParseFormat filepathI si) ; sf <- readFile filepathF ; assertEqual lab sf (doXmlParseFormat filepathI si) } -- Test substitution of General Entities testXmlGESub :: String -> String -> String -> Test testXmlGESub lab filepathI filepathF = TestCase $ do { si <- readFile filepathI -- ; writeFile (filepathF++".tmp") (doXmlParseGESub filepathI si) ; sf <- readFile filepathF ; assertEqual lab sf (doXmlParseGESub filepathI si) } -- Test substitution of General Entities testXmlGESub1 :: String -> String -> String -> Test testXmlGESub1 lab filepathI filepathF = TestCase $ do { si <- readFile filepathI -- ; writeFile (filepathF++".tmp") (doXmlParseGESub1 filepathI si) ; sf <- readFile filepathF ; assertEqual lab sf (doXmlParseGESub1 filepathI si) } -- Test validation following substitution of General Entities testXmlValid :: String -> Bool -> String -> Test testXmlValid lab ok filepathI = TestCase $ do { si <- readFile filepathI -- ; writeFile (filepathF++".tmp") (doXmlValidate filepathI si) ; assertValid lab ok (doXmlValidate filepathI si) } -- Test namespace handling. This test works by namespace-processing a file, -- building a list of QNames correspondingto the elements and attributes -- within the file, and comparing that list with a supplied value. testXmlQNames :: String -> String -> [QName] -> Test testXmlQNames lab filepathI qns = TestCase $ do { si <- readFile filepathI ; let doc = parseGESubDocument filepathI si ; let docns = processNamespaces doc ; let docqns = concatMap elemQNs (xmlListElements docns) ; assertEqual lab qns docqns } where elemQNs (CElem (Elem en _ ats _)) = en:(map attrQN ats) elemQNs _ = [] attrQN (an,_) = an egns, egns1, egns2 :: Namespace egns = NS "eg" "http://id.example.org/namespace" egns1 = NS "eg" "http://id.example.org/ns1" egns2 = NS "eg" "http://id.example.org/ns2" mknsQN :: Namespace -> String -> QName mknsQN ns ln = QN ln (Just ns) -- Test XML base. This works like the namespace test -- (to confirm xml:base attributes are removed), but also -- includes the xml:base QName for each element in the -- resulting list. testXmlBase :: String -> String -> [QName] -> Test testXmlBase lab filepathI qns = TestCase $ do { si <- readFile filepathI ; let doc = parseGESubDocument filepathI si ; let docns = processNamespaces doc ; let docbas = processXmlBase docns ; let docqns = concatMap elemQNs (xmlListElements docbas) ; assertEqual lab qns docqns } where elemQNs (CElem (Elem en ei ats _)) = en:baseQN ei:(map attrQN ats) elemQNs _ = [] baseQN = makeQN . eiBase attrQN (an,_) = an egbas = NS "egbas" "http://id.example.org/" -- Test XML language. This works like the namespace test -- (to confirm xml:base attributes are removed), but also -- includes an xml:lang-basedQName for each element in the -- resulting list. testXmlLang :: String -> String -> [QName] -> Test testXmlLang lab filepathI qns = TestCase $ do { si <- readFile filepathI ; let doc = parseGESubDocument filepathI si ; let docns = processNamespaces doc ; let docbas = processXmlBase docns ; let doclng = processXmlLang docbas ; let docqns = concatMap elemQNs (xmlListElements doclng) ; assertEqual lab qns docqns } where elemQNs (CElem (Elem en ei ats _)) = en:baseQN ei:langQN ei :(map attrQN ats) elemQNs _ = [] baseQN = makeQN . eiBase langQN = makeQN . eiLang attrQN (an,_) = an -- Test attribute values. -- Read, parse and namespace-process an XML file, -- then list all attribute values, checking that each attribute -- is a single string value. testAttributes :: String -> String -> [String] -> Test testAttributes lab filepathI qns = TestCase $ do { si <- readFile filepathI ; let doc = parseGESubDocument filepathI si ; let docns = processNamespaces doc ; let docqns = concatMap elemAttrs (xmlListElements docns) ; assertEqual lab qns docqns } where elemAttrs (CElem (Elem en ei ats _)) = (map attrVal ats) elemAttrs _ = [] attrVal (_,AttValue [Left av]) = av attrVal (_,av) = "Bad attr: "++show av -- Test free-text content -- Read, parse and namespace-process an XML file, -- then list all free-text values testFreetext :: String -> String -> [String] -> Test testFreetext lab filepathI qns = TestCase $ do { si <- readFile filepathI ; let doc = parseGESubDocument filepathI si ; let docns = processNamespaces doc ; let docqns = map elemText (xmlListTextContent docns) ; assertEqual lab qns docqns } where elemText (CString _ txt) = txt elemText (CRef (RefEntity ref)) = "&"++ref++";" elemText (CRef (RefChar code)) = "&#"++show code++";" -- Construct test suites from file and list of suffixes makeTestXmlParseOK :: String -> Bool -> String -> [String] -> Test makeTestXmlParseOK lab ok fileroot suffixes = TestList [ testXmlParseOK (lab++s) ok (fileroot++s++".xml") | s <- suffixes ] makeTestXmlValidOK :: String -> Bool -> String -> [String] -> Test makeTestXmlValidOK lab ok fileroot suffixes = TestList [ testXmlValid (lab++s) ok (fileroot++s++".xml") | s <- suffixes ] ------------------------------------------------------------ -- Basic XML parsing tests ------------------------------------------------------------ testXmlLex01 = testXmlLexOK "TestXmlLex01" True "9x9/xmlData01I.xml" testXmlLex06 = testXmlPreOK "TestXmlLex06" True "9x9/xmlData06I.xml" testXmlLex07 = testXmlPreOK "TestXmlLex07" True "9x9/xmlData07I.xml" testXmlLex22 = testXmlPreOK "TestXmlLex22" True "9x9/xmlData22I.xml" testXmlParse01 = testXmlParseOK "TestXmlParse01" True "9x9/xmlData01I.xml" testXmlParse02 = testXmlParseOK "TestXmlParse02" True "9x9/xmlData02I.xml" testXmlParse03 = testXmlParseOK "TestXmlParse03" False "9x9/xmlData03I.xml" testXmlParse04 = testXmlParseOK "TestXmlParse04" False "9x9/xmlData04I.xml" testXmlParse05 = testXmlParseOK "TestXmlParse05" False "9x9/xmlData05I.xml" testXmlParse06 = testXmlParseOK "TestXmlParse06" False "9x9/xmlData06I.xml" testXmlParse07 = testXmlParseOK "TestXmlParse07" True "9x9/xmlData07I.xml" testXmlParse08 = testXmlParseOK "TestXmlParse08" True "9x9/xmlData08I.xml" testXmlParse09 = testXmlParseOK "TestXmlParse09" False "9x9/xmlData09I.xml" -- Internal subset tests testXmlParse20 = testXmlParseOK "TestXmlParse20" True "9x9/KAoSOntologiesI.owl" testXmlParse21 = testXmlParseOK "TestXmlParse21" True "9x9/xmlData21I.xml" testXmlParse22 = testXmlParseOK "TestXmlParse22" True "9x9/xmlData22I.xml" testXmlParse23 = testXmlParseOK "TestXmlParse23" True "9x9/xmlData23I.xml" testXmlParse24 = testXmlParseOK "TestXmlParse24" True "9x9/xmlData24I.xml" testXmlParse25 = testXmlParseOK "TestXmlParse25" True "9x9/xmlData25I.xml" testXmlParse26 = testXmlParseOK "TestXmlParse26" True "9x9/xmlData26I.xml" testXmlParse27 = testXmlParseOK "TestXmlParse27" True "9x9/xmlData27I.xml" testXmlParse28 = testXmlParseOK "TestXmlParse28" True "9x9/xmlData28I.xml" testXmlParse29 = testXmlParseOK "TestXmlParse29" True "9x9/xmlData29I.xml" -- External subset tests testXmlParse31 = testXmlParseOK "TestXmlParse31" True "9x9/xmlconf_xmltest_097I.xml" -- This test requires Internet/HTTP access: test32uri = "http://dev.w3.org/cvsweb/~checkout~/2001/XML-Test-Suite/xmlconf/xmltest/valid/sa/097.ent?rev=1.1&content-type=text/plain" testXmlParse32 = testXmlParseOK "TestXmlParse32" True "9x9/xmlData32I.xml" -- testXmlParse33 = testXmlParseOK "TestXmlParse33" True "9x9/xmlData33I.xml" -- Check namespace tests parse OK testXmlParse41 = testXmlParseOK "TestXmlParse41" True "9x9/xmlNamespace01.xml" testXmlParse42 = testXmlParseOK "TestXmlParse42" True "9x9/xmlNamespace02.xml" testXmlParse43 = testXmlParseOK "TestXmlParse43" True "9x9/xmlNamespace03.xml" testXmlParse44 = testXmlParseOK "TestXmlParse44" True "9x9/xmlNamespace04.xml" testXmlParse45 = testXmlParseOK "TestXmlParse45" True "9x9/xmlNamespace05.xml" testXmlParse46 = testXmlParseOK "TestXmlParse46" True "9x9/xmlNamespace06.xml" testXmlParse47 = testXmlParseOK "TestXmlParse47" True "9x9/xmlNamespace07.xml" testXmlParse48 = testXmlParseOK "TestXmlParse48" True "9x9/xmlNamespace08.xml" testXmlParse49 = testXmlParseOK "TestXmlParse49" True "9x9/xmlNamespace09.xml" testXmlParse50 = testXmlParseOK "TestXmlParse50" True "9x9/simple.rdf" testXmlFormat01 = testXmlFormat "TestXmlFormat01" "9x9/xmlData01I.xml" "9x9/xmlData01F.xml" testXmlFormat02 = testXmlFormat "TestXmlFormat02" "9x9/xmlData02I.xml" "9x9/xmlData02F.xml" testXmlFormat03 = testXmlFormat "TestXmlFormat03" "9x9/xmlData03I.xml" "9x9/xmlData03F.xml" testXmlFormat04 = testXmlFormat "TestXmlFormat04" "9x9/xmlData04I.xml" "9x9/xmlData04F.xml" testXmlFormat05 = testXmlFormat "TestXmlFormat05" "9x9/xmlData05I.xml" "9x9/xmlData05F.xml" testXmlFormat06 = testXmlFormat "TestXmlFormat06" "9x9/xmlData06I.xml" "9x9/xmlData06F.xml" testXmlFormat07 = testXmlFormat "TestXmlFormat07" "9x9/xmlData07I.xml" "9x9/xmlData07F.xml" testXmlFormat08 = testXmlFormat "TestXmlFormat08" "9x9/xmlData08I.xml" "9x9/xmlData08F.xml" testXmlFormat09 = testXmlFormat "TestXmlFormat09" "9x9/xmlData09I.xml" "9x9/xmlData09F.xml" -- Internal subset tests testXmlFormat20 = testXmlFormat "TestXmlFormat20" "9x9/KAoSOntologiesI.owl" "9x9/KAoSOntologiesF.owl" testXmlFormat21 = testXmlFormat "TestXmlFormat21" "9x9/xmlData21I.xml" "9x9/xmlData21F.xml" testXmlFormat22 = testXmlGESub "TestXmlFormat22" "9x9/xmlData22I.xml" "9x9/xmlData22F.xml" testXmlFormat23 = testXmlGESub "TestXmlFormat23" "9x9/xmlData23I.xml" "9x9/xmlData23F.xml" testXmlFormat24 = testXmlGESub "TestXmlFormat24" "9x9/xmlData24I.xml" "9x9/xmlData24F.xml" testXmlFormat25 = testXmlGESub "TestXmlFormat25" "9x9/xmlData25I.xml" "9x9/xmlData25F.xml" testXmlFormat26 = testXmlGESub "TestXmlFormat26" "9x9/xmlData26I.xml" "9x9/xmlData26F.xml" testXmlFormat27 = testXmlGESub "TestXmlFormat27" "9x9/xmlData27I.xml" "9x9/xmlData27F.xml" testXmlFormat28 = testXmlGESub "TestXmlFormat28" "9x9/xmlData28I.xml" "9x9/xmlData28F.xml" testXmlFormat29 = testXmlGESub "TestXmlFormat29" "9x9/xmlData29I.xml" "9x9/xmlData29F.xml" -- External subset tests testXmlFormat31 = testXmlFormat "TestXmlFormat31" "9x9/xmlconf_xmltest_097I.xml" "9x9/xmlconf_xmltest_097F.xml" testXmlFormat32 = testXmlFormat "TestXmlFormat32" "9x9/xmlData32I.xml" "9x9/xmlData32F.xml" testXmlFormat33 = testXmlGESub "TestXmlFormat33" "9x9/xmlData33I.xml" "9x9/xmlData33F.xml" -- Namespace tests testXmlFormat41 = testXmlGESub "TestXmlFormat41" "9x9/xmlNamespace01.xml" "9x9/xmlNamespace01F.xml" testXmlFormat42 = testXmlGESub "TestXmlFormat42" "9x9/xmlNamespace02.xml" "9x9/xmlNamespace02F.xml" testXmlFormat43 = testXmlGESub "TestXmlFormat43" "9x9/xmlNamespace03.xml" "9x9/xmlNamespace03F.xml" testXmlFormat44 = testXmlGESub "TestXmlFormat44" "9x9/xmlNamespace04.xml" "9x9/xmlNamespace04F.xml" testXmlFormat45 = testXmlGESub "TestXmlFormat45" "9x9/xmlNamespace05.xml" "9x9/xmlNamespace05F.xml" testXmlFormat46 = testXmlGESub "TestXmlFormat46" "9x9/xmlNamespace06.xml" "9x9/xmlNamespace06F.xml" testXmlFormat47 = testXmlGESub "TestXmlFormat47" "9x9/xmlNamespace07.xml" "9x9/xmlNamespace07F.xml" testXmlFormat48 = testXmlGESub "TestXmlFormat48" "9x9/xmlNamespace08.xml" "9x9/xmlNamespace08F.xml" testXmlFormat49 = testXmlGESub "TestXmlFormat49" "9x9/xmlNamespace09.xml" "9x9/xmlNamespace09F.xml" testXmlFormat50 = testXmlGESub "testXmlFormat50" "9x9/simple.rdf" "9x9/simpleF.rdf" testXmlFormat51 = testXmlGESub1 "testXmlFormat51" "9x9/XmlBase01.xml" "9x9/XmlBase01F.xml" testXmlFormat52 = testXmlGESub1 "testXmlFormat52" "9x9/XmlBase02.xml" "9x9/XmlBase02F.xml" testXmlFormat53 = testXmlGESub1 "testXmlFormat53" "9x9/XmlBase03.xml" "9x9/XmlBase03F.xml" testXmlFormat54 = testXmlGESub1 "testXmlFormat54" "9x9/XmlBase04.xml" "9x9/XmlBase04F.xml" testXmlFormat61 = testXmlGESub1 "testXmlFormat61" "9x9/XmlLang01.xml" "9x9/XmlLang01F.xml" testXmlFormat62 = testXmlGESub1 "testXmlFormat62" "9x9/XmlLang02.xml" "9x9/XmlLang02F.xml" testXmlFormat63 = testXmlGESub1 "testXmlFormat63" "9x9/XmlLang03.xml" "9x9/XmlLang03F.xml" testXmlFormat64 = testXmlGESub1 "testXmlFormat64" "9x9/XmlLang04.xml" "9x9/XmlLang04F.xml" -- Validation tests testXmlValid07 = testXmlValid "testXmlValid07" True "9x9/xmlData07I.xml" testXmlValid21 = testXmlValid "testXmlValid21" True "9x9/xmlData21I.xml" testXmlValid22 = testXmlValid "testXmlValid22" False "9x9/xmlData22I.xml" testXmlValid23 = testXmlValid "testXmlValid23" False "9x9/xmlData23I.xml" testXmlValid24 = testXmlValid "testXmlValid24" False "9x9/xmlData24I.xml" testXmlValid25 = testXmlValid "testXmlValid25" True "9x9/xmlData25I.xml" testXmlValid26 = testXmlValid "testXmlValid26" False "9x9/xmlData26I.xml" testXmlValid27 = testXmlValid "testXmlValid27" False "9x9/xmlData27I.xml" testXmlValid28 = testXmlValid "testXmlValid28" True "9x9/xmlData28I.xml" testXmlValid29 = testXmlValid "testXmlValid29" True "9x9/xmlData29I.xml" -- Namespace tests testXmlNamespace01 = testXmlQNames "testXmlNamespace01" "9x9/xmlNamespace01.xml" [ mknsQN egns "doc" ] testXmlNamespace02 = testXmlQNames "testXmlNamespace02" "9x9/xmlNamespace02.xml" [ makeQN "doc", mknsQN egns "a1" ] testXmlNamespace03 = testXmlQNames "testXmlNamespace03" "9x9/xmlNamespace03.xml" [ makeQN "doc" , mknsQN egns "inner", mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egns "a3" ] testXmlNamespace04 = testXmlQNames "testXmlNamespace04" "9x9/xmlNamespace04.xml" [ mknsQN egns "doc" , mknsQN egns "inner", makeQN "a2" , mknsQN egns "deeper", makeQN "a3" ] testXmlNamespace05 = testXmlQNames "testXmlNamespace05" "9x9/xmlNamespace05.xml" [ mknsQN egns "doc" , mknsQN egns "inner", mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egns "a3" ] testXmlNamespace06 = testXmlQNames "testXmlNamespace06" "9x9/xmlNamespace06.xml" [ mknsQN egns "doc" , mknsQN egns "inner", mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egns "a3" ] testXmlNamespace07 = testXmlQNames "testXmlNamespace07" "9x9/xmlNamespace07.xml" [ mknsQN egns "doc" , mknsQN egns "inner", mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egns "a3" ] testXmlNamespace08 = testXmlQNames "testXmlNamespace08" "9x9/xmlNamespace08.xml" [ mknsQN egns "doc" , mknsQN egns1 "inner", mknsQN egns1 "a2" , mknsQN egns2 "deeper", mknsQN egns2 "a3" ] testXmlNamespace09 = testXmlQNames "testXmlNamespace09" "9x9/xmlNamespace09.xml" [ mknsQN egns "doc" , mknsQN egns1 "inner", mknsQN egns1 "a2" ] -- xml:base tests testXmlBase01 = testXmlBase "testXmlBase01" "9x9/XmlBase01.xml" [ makeQN "doc", makeQN "9x9/XmlBase01.xml" , mknsQN egns "inner", makeQN "9x9/XmlBase01.xml", mknsQN egns "a2" , mknsQN egns "deeper", makeQN "9x9/XmlBase01.xml", mknsQN egns "a3" ] testXmlBase02 = testXmlBase "testXmlBase02" "9x9/XmlBase02.xml" [ makeQN "doc", mknsQN egbas "base1" , mknsQN egns "inner", mknsQN egbas "base1", mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egbas "base1", mknsQN egns "a3" ] testXmlBase03 = testXmlBase "testXmlBase03" "9x9/XmlBase03.xml" [ makeQN "doc", makeQN "9x9/XmlBase03.xml" , mknsQN egns "inner", mknsQN egbas "base1", mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egbas "base2", mknsQN egns "a3" , mknsQN egns "evendeeper", mknsQN egbas "base2" ] testXmlBase04 = testXmlBase "testXmlBase04" "9x9/XmlBase04.xml" [ makeQN "doc", makeQN "9x9/XmlBase04.xml" , mknsQN egns "inner", mknsQN egbas "base1", mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egbas "base2", mknsQN egns "a3" , mknsQN egns "evendeeper", mknsQN egbas "base2" , mknsQN egns "anotherdeeper", mknsQN egbas "base1" ] -- xml:lang tests testXmlLang01 = testXmlLang "testXmlLang01" "9x9/XmlLang01.xml" [ makeQN "doc", makeQN "9x9/XmlLang01.xml", makeQN "" , mknsQN egns "inner", makeQN "9x9/XmlLang01.xml", makeQN "" , mknsQN egns "a2" , mknsQN egns "deeper", makeQN "9x9/XmlLang01.xml", makeQN "" , mknsQN egns "a3" ] testXmlLang02 = testXmlLang "testXmlLang02" "9x9/XmlLang02.xml" [ makeQN "doc", mknsQN egbas "base1", makeQN "en" , mknsQN egns "inner", mknsQN egbas "base1", makeQN "en" , mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egbas "base1", makeQN "en" , mknsQN egns "a3" ] testXmlLang03 = testXmlLang "testXmlLang03" "9x9/XmlLang03.xml" [ makeQN "doc", makeQN "9x9/XmlLang03.xml", makeQN "" , mknsQN egns "inner", mknsQN egbas "base1", makeQN "fr" , mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egbas "base2", makeQN "de" , mknsQN egns "a3" , mknsQN egns "evendeeper", mknsQN egbas "base2", makeQN "de" ] testXmlLang04 = testXmlLang "testXmlLang04" "9x9/XmlLang04.xml" [ makeQN "doc", makeQN "9x9/XmlLang04.xml", makeQN "" , mknsQN egns "inner", mknsQN egbas "base1", makeQN "fr" , mknsQN egns "a2" , mknsQN egns "deeper", mknsQN egbas "base2", makeQN "de" , mknsQN egns "a3" , mknsQN egns "evendeeper", mknsQN egbas "base2", makeQN "de" , mknsQN egns "anotherdeeper", mknsQN egbas "base1", makeQN "fr" , mknsQN egns "evendeeper", makeQN "", makeQN "" ] -- Attribute-value tests testXmlAttributes01 = testAttributes "testXmlAttributes01" "9x9/SchemaPart.rdf" [ "Resource" , "en" , "fr" , "http://www.w3.org/1999/02/22-rdf-syntax-ns#type" , "en" , "fr" , "#Class" , "subPropertyOf" , "en" , "fr" , "http://www.w3.org/1999/02/22-rdf-syntax-ns#Property" , "http://www.w3.org/1999/02/22-rdf-syntax-ns#Property" ] -- Text-content-value tests testXmlFreetext01 = testFreetext "testXmlFreetext01" "9x9/SchemaPart.rdf" [ "Resource" , "Ressource" , "The most general class" , "type" , "type" , "Indicates membership of a class" , "subPropertyOf" , "sousPropri\233\&t\233\&De" , "Indicates specialization of properties" ] -- Complete test suite testXmlParseSuite = TestList [ testXmlLex01 , testXmlLex06 , testXmlLex07 , testXmlLex22 , testXmlParse01 , testXmlParse02 , testXmlParse03 , testXmlParse04 , testXmlParse05 , testXmlParse06 , testXmlParse07 , testXmlParse08 , testXmlParse09 , testXmlParse20 , testXmlParse21 , testXmlParse22 , testXmlParse23 , testXmlParse24 , testXmlParse25 , testXmlParse26 , testXmlParse27 , testXmlParse28 , testXmlParse29 , testXmlParse31 -- , testXmlParse32 -- requires internet access, see below , testXmlParse33 , testXmlParse41 , testXmlParse42 , testXmlParse43 , testXmlParse44 , testXmlParse45 , testXmlParse46 , testXmlParse47 , testXmlParse48 , testXmlParse49 , testXmlParse50 , testXmlFormat01 , testXmlFormat02 , testXmlFormat03 , testXmlFormat04 , testXmlFormat05 , testXmlFormat06 , testXmlFormat07 , testXmlFormat08 , testXmlFormat09 , testXmlFormat20 , testXmlFormat21 , testXmlFormat22 , testXmlFormat23 , testXmlFormat24 , testXmlFormat25 , testXmlFormat26 , testXmlFormat27 , testXmlFormat28 , testXmlFormat29 , testXmlFormat31 -- , testXmlFormat32 -- requires internet access, see below , testXmlFormat33 , testXmlFormat41 , testXmlFormat42 , testXmlFormat43 , testXmlFormat44 , testXmlFormat45 , testXmlFormat46 , testXmlFormat47 , testXmlFormat48 , testXmlFormat49 , testXmlFormat50 , testXmlFormat51 , testXmlFormat52 , testXmlFormat53 , testXmlFormat54 , testXmlFormat61 , testXmlFormat62 , testXmlFormat63 , testXmlFormat64 , testXmlValid07 , testXmlValid21 , testXmlValid22 , testXmlValid23 , testXmlValid24 , testXmlValid25 , testXmlValid26 , testXmlValid27 , testXmlValid28 , testXmlValid29 , testXmlNamespace01 , testXmlNamespace02 , testXmlNamespace03 , testXmlNamespace04 , testXmlNamespace05 , testXmlNamespace06 , testXmlNamespace07 , testXmlNamespace08 , testXmlNamespace09 , testXmlBase01 , testXmlBase02 , testXmlBase03 , testXmlBase04 , testXmlLang01 , testXmlLang02 , testXmlLang03 , testXmlLang04 , testXmlAttributes01 , testXmlFreetext01 ] testXmlHTTPSuite = TestList [ testXmlParse32 -- HTTP access test , testXmlFormat32 -- HTTP access test ] -- The following tests are designed to work with files from the -- W3C XML test suite, which can be obtained from: -- http://www.w3.org/XML/Test/ -- Retrieve the test suite archive and unpack the directory structure -- into a directory from which the test program is run (I use the source -- code directory: the archive has all its content in subdirectories). -- -- The tests are generated from the 3-digit number that is used to form -- the test suite filename in each case, with tests known not to work being -- removed from the list. I expect these omissions to be removed as the -- parser is refined. -- -- Note: at this time, the "Valid" XML test suite is used only for testing -- well-formedness chacks by the parser. Additional tests may perform validity -- checking. jamesClarkParseSASuite = makeTestXmlParseOK "JamesClarkParseWFSA" True "xml-conformance/xmltest/valid/sa/" ( map (showNDigits 3) [1..119] ) jamesClarkNotWfSASuite = makeTestXmlParseOK "jamesClarkNotWfSA" False "xml-conformance/xmltest/not-wf/sa/" ( map (showNDigits 3) [1..186] \\ ["006" -- comment containing '--' ,"014" -- Literal '<' in attribute value ,"025","026","029" -- content containing ']]>' ,"038" -- duplicate attr name (is XML WFC) ,"061","062","064","065","066","067","068","069" -- Missing spaces in DTD ,"070" -- ,"071","075","079","080" -- Mutually recursive entities ,"072","073","076","077","078" -- Entity not declared ,"074" -- Entity closes containing element ,"081","082" -- Attribute ref external entity ,"083","084" -- Entity reference unparsed entity ,"090" -- Char ref makes ill-formed content ,"092" -- Char ref makes ill-formed attribute ,"096" -- Missing space in ?XML PI ,"101" -- encoding name format ,"102" -- version number format ,"103" -- Char ref in entity makes ill-formed ,"113" -- Unused PE has ill-formed content ,"115","116","117","119","120" -- Char ref makes ill-formed ent value ,"133","134" -- Extra spaces between tokens ,"137" -- Missing space ,"140","141" -- Char ref makes bad element name ,"147" -- Whitespace before ,"153" -- Entity gives invalid ,"160","161" -- Violates use of PE in internal subset ,"162" -- Unused indirect PE has bad content ,"165" -- Missing space before % ,"180" -- Entity used before declaration: fix when processing entities ,"181","182" -- Entity value not "content" production: fix when processing entities ,"185" -- External entity in standalone document: fix when processing entities ,"186" -- Missing whitespace between attrs ] ) jamesClarkValidSASuite = makeTestXmlValidOK "JamesClarkValidSA" True "xml-conformance/xmltest/valid/sa/" ( map (showNDigits 3) [1..119] ) showNDigits :: Int -> Int -> String showNDigits places val = pad places (show val) where pad places str = replicate (places-length str) '0' ++ str ------------------------------------------------------------ -- All tests ------------------------------------------------------------ allTests = TestList [ testXmlParseSuite -- , testXmlHTTPSuite -- requires Internet/HTTP access , jamesClarkParseSASuite , jamesClarkNotWfSASuite , jamesClarkValidSASuite ] main = runTestTT allTests nwf = runTestTT jamesClarkNotWfSASuite check = runTestTT testXmlParseSuite testValid s = makeTestXmlParseOK "JamesClarkValidSA" True "xml-conformance/xmltest/valid/sa/" [s] runTestFile t = do h <- openFile "a.tmp" WriteMode runTestText (putTextToHandle h False) t hClose h tf = runTestFile tt = runTestTT xmlLexData :: String -> IO String xmlLexData filepath = do { s <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; let l = xmlLex filepath s ; let r = show (length l) ++ "\n**\n" ++ concatMap ((++"\n") . show) l ++ "\n**\n" ; putStrLn r ; return r } xmlEntData :: String -> IO String xmlEntData filepath = do { s <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; let l = xmlLexTextDecl filepath Nothing s ; let r = show (length l) ++ "\n**\n" ++ concatMap ((++"\n") . show) l ++ "\n**\n" ; putStrLn r ; return r } xmlPreData :: String -> String -> IO String xmlPreData p f = do { let filepath = p++f ; filedata <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; let l = (subIntParamEntities filepath . xmlLex filepath) filedata ; let r = show (length l) ++ "\n**\n" ++ concatMap ((++"\n") . show) l ++ "\n**\n" ; putStrLn r ; return r } xmlSymData :: String -> String -> IO String xmlSymData p f = do { let filepath = p++f ; filedata <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; let p = (xmlParse' filepath filedata) ; let r = case p of (Left err) -> ("Error: "++err) (Right (Document pro sym root)) -> show (length sym) ++ "\n**\n" ++ concatMap ((++"\n") . showste) sym ++ "\n**\n" ; putStrLn r ; return r } where showste (nam,entdef) = nam++": "++showent entdef++"\n" showent (DefEntityValue (EntityValue evs)) = concatMap (("\n "++) . showev) evs showent (DefExternalID bas eid _ ) = ("\n External base="++bas++", eid="++showeid eid) showeid (SYSTEM (SystemLiteral uri)) = uri showeid (PUBLIC _ (SystemLiteral uri)) = uri showev (EVString str) = str showev (EVRef (RefEntity nam)) = "&"++nam++";" showev (EVRef (RefChar code)) = "&#"++show code++";" xmlDocData :: String -> String -> IO String xmlDocData p f = do { let filepath = p++f ; filedata <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; let p = (xmlParse' filepath filedata) ; let r = case p of (Left err) -> ("Error: "++err) (Right doc) -> (show . document) doc ; putStrLn r ; return r } xmlSubData :: String -> String -> IO String xmlSubData p f = do { let filepath = p++f ; filedata <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; let p = (xmlParse' filepath filedata) ; let r = case p of (Left err) -> ("Error: "++err) (Right doc) -> (show . document) (subContent doc) ; putStrLn r ; return r } where subContent doc@(Document _ s _) = docReplaceContent (subExtGenEntities s) doc validPath = "xml-conformance/xmltest/valid/sa/" notwfPath = "xml-conformance/xmltest/not-wf/sa/" localPath = "" entdata = xmlEntData "9x9/xmlconf_xmltest_097.ent" lexdata = xmlLexData "9x9/xmlData26I.xml" predata = xmlPreData localPath "9x9/xmlNamespace05.xml" symdata = xmlSymData localPath "9x9/xmlNamespace05.xml" docdata = xmlDocData localPath "9x9/xmlNamespace05.xml" subdata = xmlSubData localPath "9x9/xmlNamespace05.xml" lexent = xmlLexEntity testPosn "abc &def; ghi %jkl; mno" -------------------------------------------------------------------------------- -- -- Copyright (c) 2004, G. KLYNE. All rights reserved. -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version. -- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, write to: -- The Free Software Foundation, Inc., -- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- or view the web page at: -- http://www.gnu.org/copyleft/lesser.html -- -------------------------------------------------------------------------------- -- $Source: /file/cvsdev/HaskellUtils/HaXml-1.12/test/TestXml.hs,v $ -- $Author: graham $ -- $Revision: 1.35 $ -- $Log: TestXml.hs,v $ -- Revision 1.35 2004/07/13 17:32:29 graham -- Add xml:lang processing filter test cases. Fix some old test cases. -- -- Revision 1.34 2004/07/12 22:20:09 graham -- New XML parser test cases. -- -- Revision 1.33 2004/07/06 21:09:28 graham -- Add specific Show instances for Namespace and QName. -- -- Revision 1.32 2004/06/28 20:20:21 graham -- Added new test cases for recursive substutition detection, and -- document reformatting after -- namespace processing. -- -- Revision 1.31 2004/06/28 20:15:54 graham -- Reorganized general entity substitution logic to separate traversal from -- substitution, reprocessing and recursive reprocessing logic. -- Added detection of recursive entity substitution. -- -- Revision 1.30 2004/06/24 17:48:36 graham -- Include document filename/URI in parsed document prolog, -- for subsequent use as a base URI. -- -- Revision 1.29 2004/06/24 14:06:57 graham -- Rearranged various lexing functions to be slightly less obscure in their usage. -- Factored out common code from entity value and attribute value parsing as -- a new function 'parseString'. -- -- Revision 1.28 2004/06/22 14:38:53 graham -- Basic namespace processing is working. -- Some problems with attribute handling/normalization still to be fixed. -- -- Revision 1.27 2004/06/18 15:27:46 graham -- Validation test suote added. Minor validation bug fixed. All tests pass. -- -- Revision 1.26 2004/06/17 17:20:37 graham -- Substitution of external general entities tested. -- -- Revision 1.25 2004/06/17 17:08:38 graham -- Refactored SubstitutePE.hs into SubstitutePE.hs and EntityHelpers.hs, -- so common functions can be shared between PE and GE substitution code. -- -- Revision 1.24 2004/06/17 15:11:35 graham -- Pass test cases for general entity substitution in attribute values. -- -- Revision 1.23 2004/06/17 11:40:43 graham -- Internal general entity substitution now passes all test cases. -- -- Revision 1.22 2004/06/16 18:17:15 graham -- Parameter entity and lexical phases re-worked to better support -- general entity substitution. -- Passes all but two tricky GE substitution -- regression tests. -- -- Revision 1.21 2004/06/15 20:01:39 graham -- First steps of internal general entity substitution filter are working. -- Some of the parsing has been re-worked to support this. -- All regression tests still pass. -- -- Revision 1.20 2004/06/09 10:30:26 graham -- HTTP access to external entity tested. -- -- Revision 1.19 2004/06/08 21:21:59 graham -- Fixed up grammar for 'contentspec'. Another test case passes. -- -- Revision 1.18 2004/06/08 20:20:11 graham -- Relative filename handling for external entitities now works. -- URI handling and HTTP access is coded, not fully tested. -- -- Revision 1.17 2004/06/08 11:35:59 graham -- External parameter entity substitution test passes. -- -- Revision 1.16 2004/06/08 11:00:06 graham -- Internal subset PE tests all pass. -- NOTE changes from previous test cases: -- PE definitions are stripped out by PE substitution processing, -- Ill-formed content in unused PEs is not detected. -- -- Revision 1.15 2004/06/08 10:42:50 graham -- Parameter entity definition body submitted to full reLex when defined. -- -- Revision 1.14 2004/06/07 16:42:28 graham -- Substitution logic now compiles, but not yet built into PE handling code. -- Two non-well-formed test cases now fail. -- Not yet decided if they're important enough to fix. -- -- Revision 1.13 2004/06/03 14:55:37 graham -- Re-arrange parameter entity handling to distinguish internal subset usage -- in the syntax, and to leave parameter entities un-substituted in the parse -- tree. Test case testXmlFormat21 changes as a result. -- -- Revision 1.12 2004/06/03 12:52:21 graham -- First stage of parameter entity re-work: -- limit recognition of PEs to designated places in syntax. -- -- Revision 1.11 2004/06/03 10:44:55 graham -- Modified Unicode module to return a null character when an invalid or -- out-of-range UTF-8 sequence is encountered. -- -- Revision 1.10 2004/06/02 19:34:18 graham -- Various small XML conformance improvements. -- -- Revision 1.9 2004/06/02 15:14:37 graham -- Restricted characters allowed in public identifier literal -- -- Revision 1.8 2004/06/02 13:49:18 graham -- Fixed Lex.hs to reject illegal XML characters. This also fixes some -- run-time failures occurring when documents containing -- formfeed -- characters are presented. -- -- Revision 1.7 2004/06/02 11:00:43 graham -- Fixed up some comments and code layout. -- -- Revision 1.6 2004/06/02 08:39:05 graham -- Re-worked handling of attribute values so that entitry references -- can be recognized. -- -- Revision 1.5 2004/05/28 15:28:16 graham -- Improved conformance with XML, per conformance tests. -- All but one of the xmltext/valid/sa tests now pass. -- There are still several xmltext/not-wf/sa tests that are not detected as -- incorrect XML, notably problems with attribute value handling. -- -- Revision 1.4 2004/05/28 10:47:48 graham -- Changed test harness to report error diagnostics on failure (foir debugging). -- Fixed lexing problem for names beginning with ':' and '_'. -- Two additional test cases (012,013) passed. -- -- Revision 1.3 2004/05/25 21:29:48 graham -- Refactored parser diagnostics handling. -- Added new type classes to isolate token details. -- All previous conformance tests still passed. -- -- Revision 1.2 2004/05/24 12:42:37 graham -- Create new module ExtEntity to isolate acess to external entity data. -- Updated parse module to use this. All tests passed. -- -- Revision 1.1 2004/05/24 11:54:03 graham -- Add HaXml 1.12 to local CVS repository, prior to refactoring. -- Added CVS tags to source files to help track changes. -- hugs98-plus-Sep2006/packages/HUnit/0000755006511100651110000000000010504340573015571 5ustar rossrosshugs98-plus-Sep2006/packages/HUnit/Test/0000755006511100651110000000000010504340471016505 5ustar rossrosshugs98-plus-Sep2006/packages/HUnit/Test/HUnit/0000755006511100651110000000000010504340471017534 5ustar rossrosshugs98-plus-Sep2006/packages/HUnit/Test/HUnit/Terminal.lhs0000644006511100651110000000235610504340471022025 0ustar rossross> module Test.HUnit.Terminal > ( > terminalAppearance > ) > where > import Data.Char (isPrint) Simplifies the input string by interpreting '\r' and '\b' characters specially so that the result string has the same final (or "terminal", pun intended) appearance as would the input string when written to a terminal that overwrites character positions following carriage returns and backspaces. The helper function `ta` takes an accumlating `ShowS`-style function that holds "committed" lines of text, a (reversed) list of characters on the current line *before* the cursor, a (normal) list of characters on the current line *after* the cursor, and the remaining input. > terminalAppearance :: String -> String > terminalAppearance str = ta id "" "" str > where > ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs > ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs > ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs > ta f "" as ('\b':cs) = error "'\\b' at beginning of line" > ta f bs as (c:cs) | not (isPrint c) = error "invalid nonprinting character" > | null as = ta f (c:bs) "" cs > | otherwise = ta f (c:bs) (tail as) cs > ta f bs as "" = f (reverse bs ++ as) hugs98-plus-Sep2006/packages/HUnit/Test/HUnit/Base.lhs0000644006511100651110000001477410504340471021133 0ustar rossrossHUnitBase.lhs -- basic definitions > module Test.HUnit.Base > ( > {- from Test.HUnit.Lang: -} Assertion, assertFailure, > assertString, assertBool, assertEqual, > Assertable(..), ListAssertable(..), > AssertionPredicate, AssertionPredicable(..), > (@?), (@=?), (@?=), > Test(..), Node(..), Path, > testCaseCount, > Testable(..), > (~?), (~=?), (~?=), (~:), > Counts(..), State(..), > ReportStart, ReportProblem, > testCasePaths, > performTest > ) > where > import Control.Monad (unless, foldM) Assertion Definition ==================== > import Test.HUnit.Lang Conditional Assertion Functions ------------------------------- > assertBool :: String -> Bool -> Assertion > assertBool msg b = unless b (assertFailure msg) > assertString :: String -> Assertion > assertString s = unless (null s) (assertFailure s) > assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion > assertEqual preface expected actual = > unless (actual == expected) (assertFailure msg) > where msg = (if null preface then "" else preface ++ "\n") ++ > "expected: " ++ show expected ++ "\n but got: " ++ show actual Overloaded `assert` Function ---------------------------- > class Assertable t > where assert :: t -> Assertion > instance Assertable () > where assert = return > instance Assertable Bool > where assert = assertBool "" > instance (ListAssertable t) => Assertable [t] > where assert = listAssert > instance (Assertable t) => Assertable (IO t) > where assert = (>>= assert) We define the assertability of `[Char]` (that is, `String`) and leave other types of list to possible user extension. > class ListAssertable t > where listAssert :: [t] -> Assertion > instance ListAssertable Char > where listAssert = assertString Overloaded `assertionPredicate` Function ---------------------------------------- > type AssertionPredicate = IO Bool > class AssertionPredicable t > where assertionPredicate :: t -> AssertionPredicate > instance AssertionPredicable Bool > where assertionPredicate = return > instance (AssertionPredicable t) => AssertionPredicable (IO t) > where assertionPredicate = (>>= assertionPredicate) Assertion Construction Operators -------------------------------- > infix 1 @?, @=?, @?= > (@?) :: (AssertionPredicable t) => t -> String -> Assertion > pred @? msg = assertionPredicate pred >>= assertBool msg > (@=?) :: (Eq a, Show a) => a -> a -> Assertion > expected @=? actual = assertEqual "" expected actual > (@?=) :: (Eq a, Show a) => a -> a -> Assertion > actual @?= expected = assertEqual "" expected actual Test Definition =============== > data Test = TestCase Assertion > | TestList [Test] > | TestLabel String Test > instance Show Test where > showsPrec p (TestCase _) = showString "TestCase _" > showsPrec p (TestList ts) = showString "TestList " . showList ts > showsPrec p (TestLabel l t) = showString "TestLabel " . showString l > . showChar ' ' . showsPrec p t > testCaseCount :: Test -> Int > testCaseCount (TestCase _) = 1 > testCaseCount (TestList ts) = sum (map testCaseCount ts) > testCaseCount (TestLabel _ t) = testCaseCount t > data Node = ListItem Int | Label String > deriving (Eq, Show, Read) > type Path = [Node] -- Node order is from test case to root. > testCasePaths :: Test -> [Path] > testCasePaths t = tcp t [] > where tcp (TestCase _) p = [p] > tcp (TestList ts) p = > concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ] > tcp (TestLabel l t) p = tcp t (Label l : p) Overloaded `test` Function -------------------------- > class Testable t > where test :: t -> Test > instance Testable Test > where test = id > instance (Assertable t) => Testable (IO t) > where test = TestCase . assert > instance (Testable t) => Testable [t] > where test = TestList . map test Test Construction Operators --------------------------- > infix 1 ~?, ~=?, ~?= > infixr 0 ~: > (~?) :: (AssertionPredicable t) => t -> String -> Test > pred ~? msg = TestCase (pred @? msg) > (~=?) :: (Eq a, Show a) => a -> a -> Test > expected ~=? actual = TestCase (expected @=? actual) > (~?=) :: (Eq a, Show a) => a -> a -> Test > actual ~?= expected = TestCase (actual @?= expected) > (~:) :: (Testable t) => String -> t -> Test > label ~: t = TestLabel label (test t) Test Execution ============== > data Counts = Counts { cases, tried, errors, failures :: Int } > deriving (Eq, Show, Read) > data State = State { path :: Path, counts :: Counts } > deriving (Eq, Show, Read) > type ReportStart us = State -> us -> IO us > type ReportProblem us = String -> State -> us -> IO us Note that the counts in a start report do not include the test case being started, whereas the counts in a problem report do include the test case just finished. The principle is that the counts are sampled only between test case executions. As a result, the number of test case successes always equals the difference of test cases tried and the sum of test case errors and failures. > performTest :: ReportStart us -> ReportProblem us -> ReportProblem us > -> us -> Test -> IO (Counts, us) > performTest reportStart reportError reportFailure us t = do > (ss', us') <- pt initState us t > unless (null (path ss')) $ error "performTest: Final path is nonnull" > return (counts ss', us') > where > initState = State{ path = [], counts = initCounts } > initCounts = Counts{ cases = testCaseCount t, tried = 0, > errors = 0, failures = 0} > pt ss us (TestCase a) = do > us' <- reportStart ss us > r <- performTestCase a > case r of Nothing -> do return (ss', us') > Just (True, m) -> do usF <- reportFailure m ssF us' > return (ssF, usF) > Just (False, m) -> do usE <- reportError m ssE us' > return (ssE, usE) > where c@Counts{ tried = t } = counts ss > ss' = ss{ counts = c{ tried = t + 1 } } > ssF = ss{ counts = c{ tried = t + 1, failures = failures c + 1 } } > ssE = ss{ counts = c{ tried = t + 1, errors = errors c + 1 } } > pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..]) > where f (ss, us) (t, n) = withNode (ListItem n) ss us t > pt ss us (TestLabel label t) = withNode (Label label) ss us t > withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t > return (ss2{ path = path0 }, us1) > where path0 = path ss0 > ss1 = ss0{ path = node : path0 } hugs98-plus-Sep2006/packages/HUnit/Test/HUnit/Lang.lhs0000644006511100651110000000371110504340471021127 0ustar rossrossTest/HUnit/Lang.lhs -- HUnit language support. > module Test.HUnit.Lang > ( > Assertion, > assertFailure, > performTestCase > ) > where When adapting this module for other Haskell language systems, change the imports and the implementations but not the interfaces. Imports ------- > import Data.List (isPrefixOf) #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) > import Control.Exception (try) #else > import System.IO.Error (ioeGetErrorString, try) #endif Interfaces ---------- An assertion is an `IO` computation with trivial result. > type Assertion = IO () `assertFailure` signals an assertion failure with a given message. > assertFailure :: String -> Assertion `performTestCase` performs a single test case. The meaning of the result is as follows: Nothing test case success Just (True, msg) test case failure with the given message Just (False, msg) test case error with the given message > performTestCase :: Assertion -> IO (Maybe (Bool, String)) Implementations --------------- > hunitPrefix = "HUnit:" > hugsPrefix = "IO Error: User error\nReason: " > nhc98Prefix = "I/O error (user-defined), call to function `userError':\n " > -- GHC prepends no prefix to the user-supplied string. > assertFailure msg = ioError (userError (hunitPrefix ++ msg)) > performTestCase action = do r <- try action > case r of Right () -> return Nothing > Left e -> return (Just (decode e)) > where #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) > decode e = let s0 = show e #else > decode e = let s0 = ioeGetErrorString e #endif > (_, s1) = dropPrefix hugsPrefix s0 > (_, s2) = dropPrefix nhc98Prefix s1 > in dropPrefix hunitPrefix s2 > dropPrefix pref str = if pref `isPrefixOf` str > then (True, drop (length pref) str) > else (False, str) hugs98-plus-Sep2006/packages/HUnit/Test/HUnit/Text.lhs0000644006511100651110000001203710504340471021173 0ustar rossrossHUnitText.lhs -- text-based test controller > module Test.HUnit.Text > ( > PutText(..), > putTextToHandle, putTextToShowS, > runTestText, > showPath, showCounts, > runTestTT > ) > where > import Test.HUnit.Base > import Control.Monad (when) > import System.IO (Handle, stderr, hPutStr, hPutStrLn) As the general text-based test controller (`runTestText`) executes a test, it reports each test case start, error, and failure by constructing a string and passing it to the function embodied in a `PutText`. A report string is known as a "line", although it includes no line terminator; the function in a `PutText` is responsible for terminating lines appropriately. Besides the line, the function receives a flag indicating the intended "persistence" of the line: `True` indicates that the line should be part of the final overall report; `False` indicates that the line merely indicates progress of the test execution. Each progress line shows the current values of the cumulative test execution counts; a final, persistent line shows the final count values. The `PutText` function is also passed, and returns, an arbitrary state value (called `st` here). The initial state value is given in the `PutText`; the final value is returned by `runTestText`. > data PutText st = PutText (String -> Bool -> st -> IO st) st Two reporting schemes are defined here. `putTextToHandle` writes report lines to a given handle. `putTextToShowS` accumulates persistent lines for return as a whole by `runTestText`. `putTextToHandle` writes persistent lines to the given handle, following each by a newline character. In addition, if the given flag is `True`, it writes progress lines to the handle as well. A progress line is written with no line termination, so that it can be overwritten by the next report line. As overwriting involves writing carriage return and blank characters, its proper effect is usually only obtained on terminal devices. > putTextToHandle :: Handle -> Bool -> PutText Int > putTextToHandle handle showProgress = PutText put initCnt > where > initCnt = if showProgress then 0 else -1 > put line pers (-1) = do when pers (hPutStrLn handle line); return (-1) > put line True cnt = do hPutStrLn handle (erase cnt ++ line); return 0 > put line False cnt = do hPutStr handle ('\r' : line); return (length line) > -- The "erasing" strategy with a single '\r' relies on the fact that the > -- lengths of successive summary lines are monotonically nondecreasing. > erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" `putTextToShowS` accumulates persistent lines (dropping progess lines) for return by `runTestText`. The accumulated lines are represented by a `ShowS` (`String -> String`) function whose first argument is the string to be appended to the accumulated report lines. > putTextToShowS :: PutText ShowS > putTextToShowS = PutText put id > where put line pers f = return (if pers then acc f line else f) > acc f line tail = f (line ++ '\n' : tail) `runTestText` executes a test, processing each report line according to the given reporting scheme. The reporting scheme's state is threaded through calls to the reporting scheme's function and finally returned, along with final count values. > runTestText :: PutText st -> Test -> IO (Counts, st) > runTestText (PutText put us) t = do > (counts, us') <- performTest reportStart reportError reportFailure us t > us'' <- put (showCounts counts) True us' > return (counts, us'') > where > reportStart ss us = put (showCounts (counts ss)) False us > reportError = reportProblem "Error:" "Error in: " > reportFailure = reportProblem "Failure:" "Failure in: " > reportProblem p0 p1 msg ss us = put line True us > where line = "### " ++ kind ++ path' ++ '\n' : msg > kind = if null path' then p0 else p1 > path' = showPath (path ss) `showCounts` converts test execution counts to a string. > showCounts :: Counts -> String > showCounts Counts{ cases = cases, tried = tried, > errors = errors, failures = failures } = > "Cases: " ++ show cases ++ " Tried: " ++ show tried ++ > " Errors: " ++ show errors ++ " Failures: " ++ show failures `showPath` converts a test case path to a string, separating adjacent elements by ':'. An element of the path is quoted (as with `show`) when there is potential ambiguity. > showPath :: Path -> String > showPath [] = "" > showPath nodes = foldl1 f (map showNode nodes) > where f b a = a ++ ":" ++ b > showNode (ListItem n) = show n > showNode (Label label) = safe label (show label) > safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s `runTestTT` provides the "standard" text-based test controller. Reporting is made to standard error, and progress reports are included. For possible programmatic use, the final counts are returned. The "TT" in the name suggests "Text-based reporting to the Terminal". > runTestTT :: Test -> IO Counts > runTestTT t = do (counts, 0) <- runTestText (putTextToHandle stderr True) t > return counts hugs98-plus-Sep2006/packages/HUnit/Test/HUnit.lhs0000644006511100651110000000027110504340471020244 0ustar rossrossHUnit.lhs -- interface module for HUnit > module Test.HUnit > ( > module Test.HUnit.Base, > module Test.HUnit.Text > ) > where > import Test.HUnit.Base > import Test.HUnit.Text hugs98-plus-Sep2006/packages/HUnit/doc/0000755006511100651110000000000010504340471016333 5ustar rossrosshugs98-plus-Sep2006/packages/HUnit/doc/Guide.html0000644006511100651110000006516010504340471020266 0ustar rossross HUnit 1.0 User's Guide

HUnit 1.0 User's Guide

HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java. This guide describes how to use HUnit, assuming you are familiar with Haskell, though not necessarily with JUnit. You can obtain HUnit, including this guide, at http://hunit.sourceforge.net.

Introduction

A test-centered methodology for software development is most effective when tests are easy to create, change, and execute. The JUnit tool pioneered support for test-first development in Java. HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely functional programming language. (To learn more about Haskell, see http://www.haskell.org.)

With HUnit, as with JUnit, you can easily create tests, name them, group them into suites, and execute them, with the framework checking the results automatically. Test specification in HUnit is even more concise and flexible than in JUnit, thanks to the nature of the Haskell language. HUnit currently includes only a text-based test controller, but the framework is designed for easy extension. (Would anyone care to write a graphical test controller for HUnit?)

The next section helps you get started using HUnit in simple ways. Subsequent sections give details on writing tests and running tests. The document concludes with a section describing HUnit's constituent files and a section giving references to further information.

Getting Started

In the Haskell module where your tests will reside, import module Test.HUnit: 
    import Test.HUnit
Define test cases as appropriate: 
    test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3))
    test2 = TestCase (do (x,y) <- partA 3
                         assertEqual "for the first result of partA," 5 x
                         b <- partB y
                         assertBool ("(partB " ++ show y ++ ") failed") b)
Name the test cases and group them together: 
    tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]
Run the tests as a group. At a Haskell interpreter prompt, apply the function runTestTT to the collected tests. (The "TT" suggests text orientation with output to the terminal.) 
    > runTestTT tests
    Cases: 2  Tried: 2  Errors: 0  Failures: 0
    >
If the tests are proving their worth, you might see: 
    > runTestTT tests
    ### Failure in: 0:test1
    for (foo 3),
    expected: (1,2)
     but got: (1,3)
    Cases: 2  Tried: 2  Errors: 0  Failures: 1
    >
Isn't that easy?

You can specify tests even more succinctly using operators and overloaded functions that HUnit provides: 

    tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3),
                   "test2" ~: do (x, y) <- partA 3
                                 assertEqual "for the first result of partA," 5 x
                                 partB y @? "(partB " ++ show y ++ ") failed" ]
Assuming the same test failures as before, you would see: 
    > runTestTT tests
    ### Failure in: 0:test1:(foo 3)
    expected: (1,2)
     but got: (1,3)
    Cases: 2  Tried: 2  Errors: 0  Failures: 1
    >

Writing Tests

Tests are specified compositionally. Assertions are combined to make a test case, and test cases are combined into tests. HUnit also provides advanced features for more convenient test specification.

Assertions

The basic building block of a test is an assertion. 
    type Assertion = IO ()
An assertion is an IO computation that always produces a void result. Why is an assertion an IO computation? So that programs with real-world side effects can be tested. How does an assertion assert anything if it produces no useful result? The answer is that an assertion can signal failure by calling assertFailure. 
    assertFailure :: String -> Assertion
    assertFailure msg = ioError (userError ("HUnit:" ++ msg))
(assertFailure msg) raises an exception. The string argument identifies the failure. The failure message is prefixed by "HUnit:" to mark it as an HUnit assertion failure message. The HUnit test framework interprets such an exception as indicating failure of the test whose execution raised the exception. (Note: The details concerning the implementation of assertFailure are subject to change and should not be relied upon.)

assertFailure can be used directly, but it is much more common to use it indirectly through other assertion functions that conditionally assert failure. 

    assertBool :: String -> Bool -> Assertion
    assertBool msg b = unless b (assertFailure msg)

    assertString :: String -> Assertion
    assertString s = unless (null s) (assertFailure s)

    assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion
    assertEqual preface expected actual =
      unless (actual == expected) (assertFailure msg)
     where msg = (if null preface then "" else preface ++ "\n") ++
                 "expected: " ++ show expected ++ "\n but got: " ++ show actual
With assertBool you give the assertion condition and failure message separately. With assertString the two are combined. With assertEqual you provide a "preface", an expected value, and an actual value; the failure message shows the two unequal values and is prefixed by the preface. Additional ways to create assertions are described later under Advanced Features.

Since assertions are IO computations, they may be combined--along with other IO computations--using (>>=), (>>), and the do notation. As long as its result is of type (IO ()), such a combination constitutes a single, collective assertion, incorporating any number of constituent assertions. The important features of such a collective assertion are that it fails if any of its constituent assertions is executed and fails, and that the first constituent assertion to fail terminates execution of the collective assertion. Such behavior is essential to specifying a test case.

Test Case

A test case is the unit of test execution. That is, distinct test cases are executed independently. The failure of one is independent of the failure of any other.

A test case consists of a single, possibly collective, assertion. The possibly multiple constituent assertions in a test case's collective assertion are not independent. Their interdependence may be crucial to specifying correct operation for a test. A test case may involve a series of steps, each concluding in an assertion, where each step must succeed in order for the test case to continue. As another example, a test may require some "set up" to be performed that must be undone ("torn down" in JUnit parlance) once the test is complete. In this case, you could use Haskell's IO.bracket function to achieve the desired effect.

You can make a test case from an assertion by applying the TestCase constructor. For example, (TestCase (return ())) is a test case that never fails, and (TestCase (assertEqual "for x," 3 x)) is a test case that checks that the value of x is 3.  Additional ways to create test cases are described later under Advanced Features.

Tests

As soon as you have more than one test, you'll want to name them to tell them apart. As soon as you have more than several tests, you'll want to group them to process them more easily. So, naming and grouping are the two keys to managing collections of tests.

In tune with the "composite" design pattern [1], a test is defined as a package of test cases. Concretely, a test is either a single test case, a group of tests, or either of the first two identified by a label. 

    data Test = TestCase Assertion
              | TestList [Test]
              | TestLabel String Test
There are three important features of this definition to note:
  • A TestList consists of a list of tests rather than a list of test cases. This means that the structure of a Test is actually a tree. Using a hierarchy helps organize tests just as it helps organize files in a file system.
  • A TestLabel is attached to a test rather than to a test case. This means that all nodes in the test tree, not just test case (leaf) nodes, can be labeled. Hierarchical naming helps organize tests just as it helps organize files in a file system.
  • A TestLabel is separate from both TestCase and TestList. This means that labeling is optional everywhere in the tree. Why is this a good thing? Because of the hierarchical structure of a test, each constituent test case is uniquely identified by its path in the tree, ignoring all labels. Sometimes a test case's path (or perhaps its subpath below a certain node) is a perfectly adequate "name" for the test case (perhaps relative to a certain node). In this case, creating a label for the test case is both unnecessary and inconvenient.

The number of test cases that a test comprises can be computed with testCaseCount. 

    testCaseCount :: Test -> Int

As mentioned above, a test is identified by its path in the test hierarchy. 

    data Node  = ListItem Int | Label String
      deriving (Eq, Show, Read)

    type Path = [Node]    -- Node order is from test case to root.
Each occurrence of TestList gives rise to a ListItem and each occurrence of TestLabel gives rise to a Label. The ListItems by themselves ensure uniqueness among test case paths, while the Labels allow you to add mnemonic names for individual test cases and collections of them.

Note that the order of nodes in a path is reversed from what you might expect: The first node in the list is the one deepest in the tree. This order is a concession to efficiency: It allows common path prefixes to be shared.

The paths of the test cases that a test comprises can be computed with testCasePaths. The paths are listed in the order in which the corresponding test cases would be executed. 

    testCasePaths :: Test -> [Path]

The three variants of Test can be constructed simply by applying TestCase, TestList, and TestLabel to appropriate arguments. Additional ways to create tests are described later under Advanced Features.

The design of the type Test provides great conciseness, flexibility, and convenience in specifying tests. Moreover, the nature of Haskell significantly augments these qualities:

  • Combining assertions and other code to construct test cases is easy with the IO monad.
  • Using overloaded functions and special operators (see below), specification of assertions and tests is extremely compact.
  • Structuring a test tree by value, rather than by name as in JUnit, provides for more convenient, flexible, and robust test suite specification. In particular, a test suite can more easily be computed "on the fly" than in other test frameworks.
  • Haskell's powerful abstraction facilities provide unmatched support for test refactoring.

Advanced Features

HUnit provides additional features for specifying assertions and tests more conveniently and concisely. These facilities make use of Haskell type classes.

The following operators can be used to construct assertions. 

    infix 1 @?, @=?, @?=

    (@?) :: (AssertionPredicable t) => t -> String -> Assertion
    pred @? msg = assertionPredicate pred >>= assertBool msg

    (@=?) :: (Eq a, Show a) => a -> a -> Assertion
    expected @=? actual = assertEqual "" expected actual

    (@?=) :: (Eq a, Show a) => a -> a -> Assertion
    actual @?= expected = assertEqual "" expected actual
You provide a boolean condition and failure message separately to (@?), as for assertBool, but in a different order. The (@=?) and (@?=) operators provide shorthands for assertEqual when no preface is required. They differ only in the order in which the expected and actual values are provided. (The actual value--the uncertain one--goes on the "?" side of the operator.)

The (@?) operator's first argument is something from which an assertion predicate can be made, that is, its type must be AssertionPredicable. 

    type AssertionPredicate = IO Bool

    class AssertionPredicable t
     where assertionPredicate :: t -> AssertionPredicate

    instance AssertionPredicable Bool
     where assertionPredicate = return

    instance (AssertionPredicable t) => AssertionPredicable (IO t)
     where assertionPredicate = (>>= assertionPredicate)
The overloaded assert function in the Assertable type class constructs an assertion. 
    class Assertable t
     where assert :: t -> Assertion

    instance Assertable ()
     where assert = return

    instance Assertable Bool
     where assert = assertBool ""

    instance (ListAssertable t) => Assertable [t]
     where assert = listAssert

    instance (Assertable t) => Assertable (IO t)
     where assert = (>>= assert)
The ListAssertable class allows assert to be applied to [Char] (that is, String). 
    class ListAssertable t
     where listAssert :: [t] -> Assertion

    instance ListAssertable Char
     where listAssert = assertString
With the above declarations, (assert ()), (assert True), and (assert "") (as well as IO forms of these values, such as (return ())) are all assertions that never fail, while (assert False) and (assert "some failure message") (and their IO forms) are assertions that always fail. You may define additional instances for the type classes Assertable, ListAssertable, and AssertionPredicable if that should be useful in your application.

The overloaded test function in the Testable type class constructs a test. 

    class Testable t
     where test :: t -> Test

    instance Testable Test
     where test = id

    instance (Assertable t) => Testable (IO t)
     where test = TestCase . assert

    instance (Testable t) => Testable [t]
     where test = TestList . map test
The test function makes a test from either an Assertion (using TestCase), a list of Testable items (using TestList), or a Test (making no change).

The following operators can be used to construct tests. 

    infix  1 ~?, ~=?, ~?=
    infixr 0 ~:

    (~?) :: (AssertionPredicable t) => t -> String -> Test
    pred ~? msg = TestCase (pred @? msg)

    (~=?) :: (Eq a, Show a) => a -> a -> Test
    expected ~=? actual = TestCase (expected @=? actual)

    (~?=) :: (Eq a, Show a) => a -> a -> Test
    actual ~?= expected = TestCase (actual @?= expected)

    (~:) :: (Testable t) => String -> t -> Test
    label ~: t = TestLabel label (test t)
(~?), (~=?), and (~?=) each make an assertion, as for (@?), (@=?), and (@?=), respectively, and then a test case from that assertion. (~:) attaches a label to something that is Testable. You may define additional instances for the type class Testable should that be useful.

Running Tests

HUnit is structured to support multiple test controllers. The first subsection below describes the test execution characteristics common to all test controllers. The second subsection describes the text-based controller that is included with HUnit.

Test Execution

All test controllers share a common test execution model. They differ only in how the results of test execution are shown.

The execution of a test (a value of type Test) involves the serial execution (in the IO monad) of its constituent test cases. The test cases are executed in a depth-first, left-to-right order. During test execution, four counts of test cases are maintained: 

    data Counts = Counts { cases, tried, errors, failures :: Int }
      deriving (Eq, Show, Read)
  • cases is the number of test cases included in the test. This number is a static property of a test and remains unchanged during test execution.
  • tried is the number of test cases that have been executed so far during the test execution.
  • errors is the number of test cases whose execution ended with an unexpected exception being raised. Errors indicate problems with test cases, as opposed to the code under test.
  • failures is the number of test cases whose execution asserted failure. Failures indicate problems with the code under test.
Why is there no count for test case successes? The technical reason is that the counts are maintained such that the number of test case successes is always equal to (tried - (errors + failures)). The psychosocial reason is that, with test-centered development and the expectation that test failures will be few and short-lived, attention should be focused on the failures rather than the successes.

As test execution proceeds, three kinds of reporting event are communicated to the test controller. (What the controller does in response to the reporting events depends on the controller.)

  • start -- Just prior to initiation of a test case, the path of the test case and the current counts (excluding the current test case) are reported.
  • error -- When a test case terminates with an error, the error message is reported, along with the test case path and current counts (including the current test case).
  • failure -- When a test case terminates with a failure, the failure message is reported, along with the test case path and current counts (including the current test case).
Typically, a test controller shows error and failure reports immediately but uses the start report merely to update an indication of overall test execution progress.

Text-Based Controller

A text-based test controller is included with HUnit. 
    runTestText :: PutText st -> Test -> IO (Counts, st)
runTestText is generalized on a reporting scheme given as its first argument. During execution of the test given as its second argument, the controller creates a string for each reporting event and processes it according to the reporting scheme. When test execution is complete, the controller returns the final counts along with the final state for the reporting scheme.

The strings for the three kinds of reporting event are as follows.

  • A start report is the result of the function showCounts applied to the counts current immediately prior to initiation of the test case being started.
  • An error report is of the form "Error in:   path\nmessage", where path is the path of the test case in error, as shown by showPath, and message is a message describing the error. If the path is empty, the report has the form "Error:\nmessage".
  • A failure report is of the form "Failure in: path\nmessage", where path is the path of the test case in error, as shown by showPath, and message is the failure message. If the path is empty, the report has the form "Failure:\nmessage".

The function showCounts shows a set of counts. 

    showCounts :: Counts -> String
The form of its result is "Cases: cases  Tried: tried  Errors: errors  Failures: failures" where cases, tried, errors, and failures are the count values.

The function showPath shows a test case path. 

    showPath :: Path -> String
The nodes in the path are reversed (so that the path reads from the root down to the test case), and the representations for the nodes are joined by ':' separators. The representation for (ListItem n) is (show n). The representation for (Label label) is normally label. However, if label contains a colon or if (show label) is different from label surrounded by quotation marks--that is, if any ambiguity could exist--then (Label label) is represented as (show label).

HUnit includes two reporting schemes for the text-based test controller. You may define others if you wish. 

    putTextToHandle :: Handle -> Bool -> PutText Int
putTextToHandle writes error and failure reports, plus a report of the final counts, to the given handle. Each of these reports is terminated by a newline. In addition, if the given flag is True, it writes start reports to the handle as well. A start report, however, is not terminated by a newline. Before the next report is written, the start report is "erased" with an appropriate sequence of carriage return and space characters. Such overwriting realizes its intended effect on terminal devices. 
    putTextToShowS :: PutText ShowS
putTextToShowS ignores start reports and simply accumulates error and failure reports, terminating them with newlines. The accumulated reports are returned (as the second element of the pair returned by runTestText) as a ShowS function (that is, one with type (String -> String)) whose first argument is a string to be appended to the accumulated report lines.

HUnit provides a shorthand for the most common use of the text-based test controller. 

    runTestTT :: Test -> IO Counts
runTestTT invokes runTestText, specifying (putTextToHandle stderr True) for the reporting scheme, and returns the final counts from the test execution.

Constituent Files

HUnit 1.0 consists of the following files.
doc/Guide.html
This document.
examples/Example.hs
Haskell module that includes the examples given in the Getting Started section. Run this program to make sure you understand how to use HUnit.
Test/HUnit.lhs
Haskell module that you import to use HUnit.
Test/HUnit/Base.lhs
Haskell module that defines HUnit's basic facilities.
Test/HUnit/Lang.lhs
Haskell module that defines how assertion failure is signaled and caught. By default, it is a copy of Test/HUnit/Lang98.lhs. Replace it by a copy of Test/HUnit/LangExtended.lhs for more robust exception behavior.
Test/HUnit/Lang98.lhs
Haskell module that defines generic assertion failure handling.  It is compliant to Haskell 98 but catches only IO errors.
Test/HUnit/LangExtended.lhs
Haskell module that defines more robust assertion failure handling. It catches more (though unfortunately not all) kinds of exceptions. However, it works only with Hugs (Dec. 2001 or later) and GHC (5.00 and later).
examples/test/HUnitTest98.lhs
Haskell module that tests HUnit, assuming the generic assertion failure handling of HUnitLang98.lhs.
examples/test/HUnitTestBase.lhs
Haskell module that defines testing support and basic (Haskell 98 compliant) tests of HUnit (using HUnit, of course!). Contains more extensive and advanced examples of testing with HUnit.
examples/test/HUnitTestExtended.lhs
Haskell module that tests HUnit, assuming the extended assertion failure handling of HUnitLangExc.lhs.
Test/HUnit/Text.lhs
Haskell module that defines HUnit's text-based test controller.
LICENSE
The license for use of HUnit.
Test/HUnit/Terminal.lhs
Haskell module that assists in checking the output of HUnit tests performed by the text-based test controller.
examples/test/TerminalTest.lhs
Haskell module that tests Test/HUnit/Terminal.lhs (using HUnit, of course!).

References

[1] Gamma, E., et al. Design Patterns: Elements of Reusable Object-Oriented Software, Addison-Wesley, Reading, MA, 1995.
The classic book describing design patterns in an object-oriented context.
http://www.junit.org
Web page for JUnit, the tool after which HUnit is modeled.
http://junit.sourceforge.net/doc/testinfected/testing.htm
A good introduction to test-first development and the use of JUnit.
http://junit.sourceforge.net/doc/cookstour/cookstour.htm
A description of the internal structure of JUnit. Makes for an interesting comparison between JUnit and HUnit.

The HUnit software and this guide were written by Dean Herington (heringto@cs.unc.edu).

HUnit development is supported by SourceForge.net Logo hugs98-plus-Sep2006/packages/HUnit/HUnit.cabal0000644006511100651110000000071410504340471017603 0ustar rossrossname: HUnit version: 1.1 license: BSD3 license-file: LICENSE author: Dean Herington homepage: http://hunit.sourceforge.net/ category: Testing build-depends: base synopsis: A unit testing framework for Haskell description: HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java, see: . exposed-modules: Test.HUnit.Base, Test.HUnit.Lang, Test.HUnit.Terminal, Test.HUnit.Text, Test.HUnit extensions: CPP hugs98-plus-Sep2006/packages/HUnit/LICENSE0000644006511100651110000000272410504340471016600 0ustar rossrossHUnit is Copyright (c) Dean Herington, 2002, all rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions, and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions, and the following disclaimer in the documentation and/or other materials provided with the distribution. - The names of the copyright holders may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/HUnit/Makefile0000644006511100651110000000106510504340471017230 0ustar rossross# ----------------------------------------------------------------------------- TOP=.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- ifeq "$(IncludeExampleDirsInBuild)" "YES" SUBDIRS += examples endif ALL_DIRS = \ Test \ Test/HUnit PACKAGE = HUnit VERSION = 1.1 PACKAGE_DEPS = base SRC_HC_OPTS += -cpp SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/HUnit/Makefile.inc0000644006511100651110000000022310504340471017773 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/packages/HUnit/Makefile.nhc980000644006511100651110000000044010504340471020154 0ustar rossrossTHISPKG = HUnit SEARCH = -package base EXTRA_H_FLAGS = SRCS = \ Test/HUnit.lhs Test/HUnit/Base.lhs Test/HUnit/Lang.lhs \ Test/HUnit/Terminal.lhs Test/HUnit/Text.lhs # Here are the main rules. include ../Makefile.common # Here are any extra dependencies. # C-files dependencies. hugs98-plus-Sep2006/packages/HUnit/README0000644006511100651110000000101310504340471016441 0ustar rossrossHUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java. HUnit is free software; see its "License" file for details. HUnit is available at . HUnit 1.1 consists of a number of files. Besides Haskell source files in Test/HUnit (whose names end in ".hs" or ".lhs"), these files include: * README -- this file * doc/Guide.html -- user's guide, in HTML format * LICENSE -- license for use of HUnit See the user's guide for more information. hugs98-plus-Sep2006/packages/HUnit/examples/0000755006511100651110000000000010504340471017404 5ustar rossrosshugs98-plus-Sep2006/packages/HUnit/examples/test/0000755006511100651110000000000010504340471020363 5ustar rossrosshugs98-plus-Sep2006/packages/HUnit/examples/test/HUnitTest98.lhs0000644006511100651110000000031310504340471023140 0ustar rossrossHUnitTest98.lhs -- test for HUnit, using Haskell language system "98" > module Main (main) where > import Test.HUnit > import HUnitTestBase > main :: IO Counts > main = runTestTT (test [baseTests]) hugs98-plus-Sep2006/packages/HUnit/examples/test/HUnitTestBase.lhs0000644006511100651110000003043610504340471023563 0ustar rossrossHUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant) > module HUnitTestBase where > import Test.HUnit > import Test.HUnit.Terminal (terminalAppearance) > import System.IO (IOMode(..), openFile, hClose) > data Report = Start State > | Error String State > | UnspecifiedError State > | Failure String State > deriving (Show, Read) > instance Eq Report where > Start s1 == Start s2 = s1 == s2 > Error m1 s1 == Error m2 s2 = m1 == m2 && s1 == s2 > Error m1 s1 == UnspecifiedError s2 = s1 == s2 > UnspecifiedError s1 == Error m2 s2 = s1 == s2 > UnspecifiedError s1 == UnspecifiedError s2 = s1 == s2 > Failure m1 s1 == Failure m2 s2 = m1 == m2 && s1 == s2 > _ == _ = False > expectReports :: [Report] -> Counts -> Test -> Test > expectReports reports counts test = TestCase $ do > (counts', reports') <- performTest (\ ss us -> return (Start ss : us)) > (\m ss us -> return (Error m ss : us)) > (\m ss us -> return (Failure m ss : us)) > [] test > assertEqual "for the reports from a test," reports (reverse reports') > assertEqual "for the counts from a test," counts counts' > simpleStart = Start (State [] (Counts 1 0 0 0)) > expectSuccess :: Test -> Test > expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0) > expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test > expectProblem kind err msg = > expectReports [simpleStart, kind msg (State [] counts)] counts > where counts = Counts 1 1 err (1-err) > expectError, expectFailure :: String -> Test -> Test > expectError = expectProblem Error 1 > expectFailure = expectProblem Failure 0 > expectUnspecifiedError :: Test -> Test > expectUnspecifiedError = expectProblem (\ msg st -> UnspecifiedError st) 1 undefined > data Expect = Succ | Err String | UErr | Fail String > expect :: Expect -> Test -> Test > expect Succ test = expectSuccess test > expect (Err m) test = expectError m test > expect UErr test = expectUnspecifiedError test > expect (Fail m) test = expectFailure m test > baseTests = test [ assertTests, > testCaseCountTests, > testCasePathsTests, > reportTests, > textTests, > showPathTests, > showCountsTests, > assertableTests, > predicableTests, > compareTests, > extendedTestTests ] > ok = test (assert ()) > bad m = test (assertFailure m) > assertTests = test [ > "null" ~: expectSuccess ok, > "userError" ~: > expectError "error" (TestCase (ioError (userError "error"))), > "IO error (file missing)" ~: > expectUnspecifiedError > (test (do openFile "3g9djs" ReadMode; return ())), "error" ~: expectError "error" (TestCase (error "error")), "tail []" ~: expectUnspecifiedError (TestCase (tail [] `seq` return ())), -- GHC doesn't currently catch arithmetic exceptions. "div by 0" ~: expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), > "assertFailure" ~: > let msg = "simple assertFailure" > in expectFailure msg (test (assertFailure msg)), > "assertString null" ~: expectSuccess (TestCase (assertString "")), > "assertString nonnull" ~: > let msg = "assertString nonnull" > in expectFailure msg (TestCase (assertString msg)), > let exp v non = > show v ++ " with " ++ non ++ "null message" ~: > expect (if v then Succ else Fail non) $ test $ assertBool non v > in "assertBool" ~: [ exp v non | v <- [True, False], non <- ["non", ""] ], > let msg = "assertBool True" > in msg ~: expectSuccess (test (assertBool msg True)), > let msg = "assertBool False" > in msg ~: expectFailure msg (test (assertBool msg False)), > "assertEqual equal" ~: > expectSuccess (test (assertEqual "" 3 3)), > "assertEqual unequal no msg" ~: > expectFailure "expected: 3\n but got: 4" > (test (assertEqual "" 3 4)), > "assertEqual unequal with msg" ~: > expectFailure "for x,\nexpected: 3\n but got: 4" > (test (assertEqual "for x," 3 4)) > ] > emptyTest0 = TestList [] > emptyTest1 = TestLabel "empty" emptyTest0 > emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ] > emptyTests = [emptyTest0, emptyTest1, emptyTest2] > testCountEmpty test = TestCase (assertEqual "" 0 (testCaseCount test)) > suite0 = (0, ok) > suite1 = (1, TestList []) > suite2 = (2, TestLabel "3" ok) > suite3 = (3, suite) > suite = > TestLabel "0" > (TestList [ TestLabel "1" (bad "1"), > TestLabel "2" (TestList [ TestLabel "2.1" ok, > ok, > TestLabel "2.3" (bad "2") ]), > TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))), > TestList [ TestList [ TestLabel "6" (bad "4") ] ] ]) > suiteCount = (6 :: Int) > suitePaths = [ > [Label "0", ListItem 0, Label "1"], > [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"], > [Label "0", ListItem 1, Label "2", ListItem 1], > [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"], > [Label "0", ListItem 2, Label "3", Label "4", Label "5"], > [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]] > suiteReports = [ Start (State (p 0) (Counts 6 0 0 0)), > Failure "1" (State (p 0) (Counts 6 1 0 1)), > Start (State (p 1) (Counts 6 1 0 1)), > Start (State (p 2) (Counts 6 2 0 1)), > Start (State (p 3) (Counts 6 3 0 1)), > Failure "2" (State (p 3) (Counts 6 4 0 2)), > Start (State (p 4) (Counts 6 4 0 2)), > Failure "3" (State (p 4) (Counts 6 5 0 3)), > Start (State (p 5) (Counts 6 5 0 3)), > Failure "4" (State (p 5) (Counts 6 6 0 4))] > where p n = reverse (suitePaths !! n) > suiteCounts = Counts 6 6 0 4 > suiteOutput = "### Failure in: 0:0:1\n\ > \1\n\ > \### Failure in: 0:1:2:2:2.3\n\ > \2\n\ > \### Failure in: 0:2:3:4:5\n\ > \3\n\ > \### Failure in: 0:3:0:0:6\n\ > \4\n\ > \Cases: 6 Tried: 6 Errors: 0 Failures: 4\n" > suites = [suite0, suite1, suite2, suite3] > testCount (num, test) count = > "testCaseCount suite" ++ show num ~: > TestCase $ assertEqual "for test count," count (testCaseCount test) > testCaseCountTests = TestList [ > "testCaseCount empty" ~: test (map testCountEmpty emptyTests), > testCount suite0 1, > testCount suite1 0, > testCount suite2 1, > testCount suite3 suiteCount > ] > testPaths (num, test) paths = > "testCasePaths suite" ++ show num ~: > TestCase $ assertEqual "for test paths," > (map reverse paths) (testCasePaths test) > testPathsEmpty test = TestCase $ assertEqual "" [] (testCasePaths test) > testCasePathsTests = TestList [ > "testCasePaths empty" ~: test (map testPathsEmpty emptyTests), > testPaths suite0 [[]], > testPaths suite1 [], > testPaths suite2 [[Label "3"]], > testPaths suite3 suitePaths > ] > reportTests = "reports" ~: expectReports suiteReports suiteCounts suite > expectText counts text test = TestCase $ do > (counts', text') <- runTestText putTextToShowS test > assertEqual "for the final counts," counts counts' > assertEqual "for the failure text output," text (text' "") > textTests = test [ > "lone error" ~: > expectText (Counts 1 1 1 0) > "### Error:\nxyz\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" > (test (do ioError (userError "xyz"); return ())), > "lone failure" ~: > expectText (Counts 1 1 0 1) > "### Failure:\nxyz\nCases: 1 Tried: 1 Errors: 0 Failures: 1\n" > (test (assert "xyz")), > "putTextToShowS" ~: > expectText suiteCounts suiteOutput suite, > "putTextToHandle (file)" ~: > let filename = "HUnitTest.tmp" > trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines > in map test > [ "show progress = " ++ show flag ~: do > handle <- openFile filename WriteMode > (counts, _) <- runTestText (putTextToHandle handle flag) suite > hClose handle > assertEqual "for the final counts," suiteCounts counts > text <- readFile filename > let text' = if flag then trim (terminalAppearance text) else text > assertEqual "for the failure text output," suiteOutput text' > | flag <- [False, True] ] > ] > showPathTests = "showPath" ~: [ > "empty" ~: showPath [] ~?= "", > ":" ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"", > "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"", > "misc" ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?= > "foo:3:2:b" > ] > showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?= > "Cases: 4 Tried: 3 Errors: 2 Failures: 1" > lift :: a -> IO a > lift a = return a > assertableTests = > let assertables x = [ > ( "", assert x , test (lift x)) , > ( "IO ", assert (lift x) , test (lift (lift x))) , > ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))] > assertabled l e x = > test [ test [ "assert" ~: pre ++ l ~: expect e $ test $ a, > "test" ~: pre ++ "IO " ++ l ~: expect e $ t ] > | (pre, a, t) <- assertables x ] > in "assertable" ~: [ > assertabled "()" Succ (), > assertabled "True" Succ True, > assertabled "False" (Fail "") False, > assertabled "\"\"" Succ "", > assertabled "\"x\"" (Fail "x") "x" > ] > predicableTests = > let predicables x m = [ > ( "", assertionPredicate x , x @? m, x ~? m ), > ( "IO ", assertionPredicate (l x) , l x @? m, l x ~? m ), > ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )] > l x = lift x > predicabled l e m x = > test [ test [ "pred" ~: pre ++ l ~: m ~: expect e $ test $ tst p, > "(@?)" ~: pre ++ l ~: m ~: expect e $ test $ a, > "(~?)" ~: pre ++ l ~: m ~: expect e $ t ] > | (pre, p, a, t) <- predicables x m ] > where tst p = p >>= assertBool m > in "predicable" ~: [ > predicabled "True" Succ "error" True, > predicabled "False" (Fail "error") "error" False, > predicabled "True" Succ "" True, > predicabled "False" (Fail "" ) "" False > ] > compareTests = test [ > let succ = const Succ > compare f exp act = test [ "(@=?)" ~: expect e $ test (exp @=? act), > "(@?=)" ~: expect e $ test (act @?= exp), > "(~=?)" ~: expect e $ exp ~=? act, > "(~?=)" ~: expect e $ act ~?= exp ] > where e = f $ "expected: " ++ show exp ++ "\n but got: " ++ show act > in test [ > compare succ 1 1, > compare Fail 1 2, > compare succ (1,'b',3.0) (1,'b',3.0), > compare Fail (1,'b',3.0) (1,'b',3.1) > ] > ] > expectList1 :: Int -> Test -> Test > expectList1 c = > expectReports > [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ] > (Counts c c 0 0) > expectList2 :: [Int] -> Test -> Test > expectList2 cs test = > expectReports > [ Start (State [ListItem j, ListItem i] (Counts c n 0 0)) > | ((i,j),n) <- zip coords [0..] ] > (Counts c c 0 0) > test > where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ] > c = testCaseCount test > extendedTestTests = test [ > "test idempotent" ~: expect Succ $ test $ test $ test $ ok, > "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True], > "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]] > ] hugs98-plus-Sep2006/packages/HUnit/examples/test/Makefile0000644006511100651110000000160310504340471022023 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- EXAMPLES := $(filter-out HUnitTestBase.lhs,$(wildcard *.lhs)) BINS := $(addsuffix $(exeext),$(EXAMPLES:.lhs=)) CLEAN_FILES += $(BINS) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -Wall -package HUnit all:: $(BINS) USES_HUNITTESTBASE := $(EXAMPLES:.lhs=) .PRECIOUS: HUnitTestBase.o $(addsuffix .o,$(USES_HUNITTESTBASE)): HUnitTestBase.hi $(addsuffix $(exeext),$(USES_HUNITTESTBASE)): HUnitTestBase.o $(BINS): %$(exeext): %.o $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $< $(patsubst %,HUnitTestBase.o,$(filter $(<:.o=),$(USES_HUNITTESTBASE))) # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/HUnit/examples/test/HUnitTestExtended.lhs0000644006511100651110000000174610504340471024453 0ustar rossrossHUnitTestExc.lhs -- test for HUnit, using Haskell language system "Exc" > module Main (main) where > import Test.HUnit > import HUnitTestBase import qualified Control.Exception (assert) assertionMessage = "HUnitTestExc.lhs:13: Assertion failed\n" assertion = Control.Exception.assert False (return ()) > main :: IO Counts > main = runTestTT (test [baseTests, excTests]) > excTests :: Test > excTests = test [ -- Hugs and GHC don't currently catch arithmetic exceptions. "div by 0" ~: expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), -- GHC doesn't currently catch array-related exceptions. "array ref out of bounds" ~: expectUnspecifiedError (TestCase (... `seq` return ())), > "error" ~: > expectError "error" (TestCase (error "error")), > "tail []" ~: > expectUnspecifiedError (TestCase (tail [] `seq` return ())) -- Hugs doesn't provide `assert`. "assert" ~: expectError assertionMessage (TestCase assertion) > ] hugs98-plus-Sep2006/packages/HUnit/examples/test/TerminalTest.lhs0000644006511100651110000000130310504340471023503 0ustar rossrossTerminalTest.lhs > import Test.HUnit.Terminal > import Test.HUnit > main :: IO Counts > main = runTestTT tests > try :: String -> String -> String -> Test > try lab inp exp' = lab ~: terminalAppearance inp ~?= exp' > tests :: Test > tests = test [ > try "empty" "" "", > try "end in \\n" "abc\ndef\n" "abc\ndef\n", > try "not end in \\n" "abc\ndef" "abc\ndef", > try "return 1" "abc\ndefgh\rxyz" "abc\nxyzgh", > try "return 2" "\nabcdefgh\rijklm\rxy\n" "\nxyklmfgh\n", > try "return 3" "\r\rabc\r\rdef\r\r\r\nghi\r\r\n" "def\nghi\n", > try "back 1" "abc\bdef\b\bgh\b" "abdgh", > try "back 2" "abc\b\b\bdef\b\bxy\b\b\n" "dxy\n" > -- \b at beginning of line > -- nonprinting char > ] hugs98-plus-Sep2006/packages/HUnit/examples/Example.hs0000644006511100651110000000172210504340471021335 0ustar rossross-- Example.hs -- Examples from HUnit user's guide module Main where import Test.HUnit foo :: Int -> (Int, Int) foo x = (1, x) partA :: Int -> IO (Int, Int) partA v = return (v+2, v+3) partB :: Int -> IO Bool partB v = return (v > 5) test1 :: Test test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3)) test2 :: Test test2 = TestCase (do (x,y) <- partA 3 assertEqual "for the first result of partA," 5 x b <- partB y assertBool ("(partB " ++ show y ++ ") failed") b) tests :: Test tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2] tests' :: Test tests' = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3), "test2" ~: do (x, y) <- partA 3 assertEqual "for the first result of partA," 5 x partB y @? "(partB " ++ show y ++ ") failed" ] main :: IO Counts main = do runTestTT tests runTestTT tests' hugs98-plus-Sep2006/packages/HUnit/examples/Makefile0000644006511100651110000000120310504340471021040 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- ifeq "$(way)" "" SUBDIRS = test EXAMPLES := $(wildcard *.hs) BINS := $(addsuffix $(exeext),$(EXAMPLES:.hs=)) CLEAN_FILES += $(BINS) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -Wall -package HUnit all:: $(BINS) $(BINS): %$(exeext): %.o $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $< endif # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/HUnit/package.conf.in0000644006511100651110000000070410504340471020436 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: exposed: True exposed-modules: Test.HUnit.Base, Test.HUnit.Lang, Test.HUnit.Terminal, Test.HUnit.Text, Test.HUnit hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSHUnit" extra-libraries: include-dirs: includes: depends: base hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/HUnit/prologue.txt0000644006511100651110000000016110504340471020161 0ustar rossrossHUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java, see: . hugs98-plus-Sep2006/packages/Win32/0000755006511100651110000000000010504340573015444 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/Graphics/0000755006511100651110000000000010504340503017175 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/Graphics/Win32/0000755006511100651110000000000010504340503020077 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/0000755006511100651110000000000010504340503020502 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Palette.hsc0000644006511100651110000000262210504340503022601 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Palette -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Palette where import System.Win32.Types import Graphics.Win32.GDI.Types #include ---------------------------------------------------------------- -- Palettes ---------------------------------------------------------------- type StockPalette = WORD #{enum StockPalette, , dEFAULT_PALETTE = DEFAULT_PALETTE } getStockPalette :: StockPalette -> IO HPALETTE getStockPalette sp = failIfNull "GetStockPalette" $ c_GetStockPalette sp foreign import stdcall unsafe "windows.h GetStockObject" c_GetStockPalette :: StockPalette -> IO HPALETTE deletePalette :: HPALETTE -> IO () deletePalette p = failIfFalse_ "DeletePalette" $ c_DeletePalette p foreign import stdcall unsafe "windows.h DeleteObject" c_DeletePalette :: HPALETTE -> IO Bool ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Bitmap.hsc0000644006511100651110000003352010504340503022420 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Bitmap -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Bitmap( RasterOp3, RasterOp4, sRCCOPY, sRCPAINT, sRCAND, sRCINVERT, sRCERASE, nOTSRCCOPY, nOTSRCERASE, mERGECOPY, mERGEPAINT, pATCOPY, pATPAINT, pATINVERT, dSTINVERT, bLACKNESS, wHITENESS, mAKEROP4, BITMAP, LPBITMAP, setBITMAP, deleteBitmap, createCompatibleBitmap, createBitmap, createBitmapIndirect, createDIBPatternBrushPt, getBitmapDimensionEx, setBitmapDimensionEx, getBitmapInfo, BitmapCompression, bI_RGB, bI_RLE8, bI_RLE4, bI_BITFIELDS, ColorFormat, dIB_PAL_COLORS, dIB_RGB_COLORS, LPBITMAPINFO, BITMAPINFOHEADER, LPBITMAPINFOHEADER, getBITMAPINFOHEADER_, BITMAPFILEHEADER, LPBITMAPFILEHEADER, getBITMAPFILEHEADER, sizeofBITMAP, sizeofBITMAPINFO, sizeofBITMAPINFOHEADER, sizeofBITMAPFILEHEADER, sizeofLPBITMAPFILEHEADER, createBMPFile, cBM_INIT, getDIBits, setDIBits, createDIBitmap ) where import System.Win32.Types import Graphics.Win32.GDI.Types import Control.Monad (liftM) import Foreign import Foreign.C #include "Win32Aux.h" #include ---------------------------------------------------------------- -- Resources ---------------------------------------------------------------- -- Yoiks - name clash -- %dis bitmap x = ptr ({LPTSTR} x) -- -- type Bitmap = LPCTSTR -- -- intToBitmap :: Int -> Bitmap -- intToBitmap i = makeIntResource (toWord i) -- -- %fun LoadBitmap :: MbHINSTANCE -> Bitmap -> IO HBITMAP -- %fail { res1 == 0 } { ErrorString("LoadBitmap") } -- -- %const Bitmap -- % [ OBM_CLOSE = { MAKEINTRESOURCE(OBM_CLOSE) } -- % , OBM_UPARROW = { MAKEINTRESOURCE(OBM_UPARROW) } -- % , OBM_DNARROW = { MAKEINTRESOURCE(OBM_DNARROW) } -- % , OBM_RGARROW = { MAKEINTRESOURCE(OBM_RGARROW) } -- % , OBM_LFARROW = { MAKEINTRESOURCE(OBM_LFARROW) } -- % , OBM_REDUCE = { MAKEINTRESOURCE(OBM_REDUCE) } -- % , OBM_ZOOM = { MAKEINTRESOURCE(OBM_ZOOM) } -- % , OBM_RESTORE = { MAKEINTRESOURCE(OBM_RESTORE) } -- % , OBM_REDUCED = { MAKEINTRESOURCE(OBM_REDUCED) } -- % , OBM_ZOOMD = { MAKEINTRESOURCE(OBM_ZOOMD) } -- % , OBM_RESTORED = { MAKEINTRESOURCE(OBM_RESTORED) } -- % , OBM_UPARROWD = { MAKEINTRESOURCE(OBM_UPARROWD) } -- % , OBM_DNARROWD = { MAKEINTRESOURCE(OBM_DNARROWD) } -- % , OBM_RGARROWD = { MAKEINTRESOURCE(OBM_RGARROWD) } -- % , OBM_LFARROWD = { MAKEINTRESOURCE(OBM_LFARROWD) } -- % , OBM_MNARROW = { MAKEINTRESOURCE(OBM_MNARROW) } -- % , OBM_COMBO = { MAKEINTRESOURCE(OBM_COMBO) } -- % , OBM_UPARROWI = { MAKEINTRESOURCE(OBM_UPARROWI) } -- % , OBM_DNARROWI = { MAKEINTRESOURCE(OBM_DNARROWI) } -- % , OBM_RGARROWI = { MAKEINTRESOURCE(OBM_RGARROWI) } -- % , OBM_LFARROWI = { MAKEINTRESOURCE(OBM_LFARROWI) } -- % , OBM_OLD_CLOSE = { MAKEINTRESOURCE(OBM_OLD_CLOSE) } -- % , OBM_SIZE = { MAKEINTRESOURCE(OBM_SIZE) } -- % , OBM_OLD_UPARROW = { MAKEINTRESOURCE(OBM_OLD_UPARROW) } -- % , OBM_OLD_DNARROW = { MAKEINTRESOURCE(OBM_OLD_DNARROW) } -- % , OBM_OLD_RGARROW = { MAKEINTRESOURCE(OBM_OLD_RGARROW) } -- % , OBM_OLD_LFARROW = { MAKEINTRESOURCE(OBM_OLD_LFARROW) } -- % , OBM_BTSIZE = { MAKEINTRESOURCE(OBM_BTSIZE) } -- % , OBM_CHECK = { MAKEINTRESOURCE(OBM_CHECK) } -- % , OBM_CHECKBOXES = { MAKEINTRESOURCE(OBM_CHECKBOXES) } -- % , OBM_BTNCORNERS = { MAKEINTRESOURCE(OBM_BTNCORNERS) } -- % , OBM_OLD_REDUCE = { MAKEINTRESOURCE(OBM_OLD_REDUCE) } -- % , OBM_OLD_ZOOM = { MAKEINTRESOURCE(OBM_OLD_ZOOM) } -- % , OBM_OLD_RESTORE = { MAKEINTRESOURCE(OBM_OLD_RESTORE) } -- % ] ---------------------------------------------------------------- -- Raster Ops ---------------------------------------------------------------- #{enum RasterOp3, , sRCCOPY = SRCCOPY , sRCPAINT = SRCPAINT , sRCAND = SRCAND , sRCINVERT = SRCINVERT , sRCERASE = SRCERASE , nOTSRCCOPY = NOTSRCCOPY , nOTSRCERASE = NOTSRCERASE , mERGECOPY = MERGECOPY , mERGEPAINT = MERGEPAINT , pATCOPY = PATCOPY , pATPAINT = PATPAINT , pATINVERT = PATINVERT , dSTINVERT = DSTINVERT , bLACKNESS = BLACKNESS , wHITENESS = WHITENESS } ---------------------------------------------------------------- -- BITMAP ---------------------------------------------------------------- type BITMAP = ( INT -- bmType , INT -- bmWidth , INT -- bmHeight , INT -- bmWidthBytes , WORD -- bmPlanes , WORD -- bmBitsPixel , LPVOID -- bmBits ) peekBITMAP :: Ptr BITMAP -> IO BITMAP peekBITMAP p = do ty <- #{peek BITMAP,bmType} p width <- #{peek BITMAP,bmWidth} p height <- #{peek BITMAP,bmHeight} p wbytes <- #{peek BITMAP,bmWidthBytes} p planes <- #{peek BITMAP,bmPlanes} p pixel <- #{peek BITMAP,bmBitsPixel} p bits <- #{peek BITMAP,bmBits} p return (ty, width, height, wbytes, planes, pixel, bits) pokeBITMAP :: Ptr BITMAP -> BITMAP -> IO () pokeBITMAP p (ty, width, height, wbytes, planes, pixel, bits) = do #{poke BITMAP,bmType} p ty #{poke BITMAP,bmWidth} p width #{poke BITMAP,bmHeight} p height #{poke BITMAP,bmWidthBytes} p wbytes #{poke BITMAP,bmPlanes} p planes #{poke BITMAP,bmBitsPixel} p pixel #{poke BITMAP,bmBits} p bits type LPBITMAP = Ptr BITMAP setBITMAP :: LPBITMAP -> BITMAP -> IO () setBITMAP = pokeBITMAP ---------------------------------------------------------------- -- Misc ---------------------------------------------------------------- deleteBitmap :: HBITMAP -> IO () deleteBitmap bitmap = failIfFalse_ "DeleteBitmap" $ c_DeleteBitmap bitmap foreign import stdcall unsafe "windows.h DeleteObject" c_DeleteBitmap :: HBITMAP -> IO Bool createBitmap :: INT -> INT -> UINT -> UINT -> Maybe LPVOID -> IO HBITMAP createBitmap w h planes bits mb_color_data = failIfNull "CreateBitmap" $ c_CreateBitmap w h planes bits (maybePtr mb_color_data) foreign import stdcall unsafe "windows.h CreateBitmap" c_CreateBitmap :: INT -> INT -> UINT -> UINT -> LPVOID -> IO HBITMAP createBitmapIndirect :: LPBITMAP -> IO HBITMAP createBitmapIndirect p_bm = failIfNull "CreateBitmapIndirect" $ c_CreateBitmapIndirect p_bm foreign import stdcall unsafe "windows.h CreateBitmapIndirect" c_CreateBitmapIndirect :: LPBITMAP -> IO HBITMAP createCompatibleBitmap :: HDC -> Int32 -> Int32 -> IO HBITMAP createCompatibleBitmap dc w h = failIfNull "CreateCompatibleBitmap" $ c_CreateCompatibleBitmap dc w h foreign import stdcall unsafe "windows.h CreateCompatibleBitmap" c_CreateCompatibleBitmap :: HDC -> Int32 -> Int32 -> IO HBITMAP createDIBPatternBrushPt :: LPVOID -> ColorFormat -> IO HBRUSH createDIBPatternBrushPt bm usage = failIfNull "CreateDIBPatternBrushPt" $ c_CreateDIBPatternBrushPt bm usage foreign import stdcall unsafe "windows.h CreateDIBPatternBrushPt" c_CreateDIBPatternBrushPt :: LPVOID -> ColorFormat -> IO HBRUSH ---------------------------------------------------------------- -- Querying ---------------------------------------------------------------- getBitmapDimensionEx :: HBITMAP -> IO SIZE getBitmapDimensionEx bm = allocaSIZE $ \ p_size -> do failIfFalse_ "GetBitmapDimensionEx" $ c_GetBitmapDimensionEx bm p_size peekSIZE p_size foreign import stdcall unsafe "windows.h GetBitmapDimensionEx" c_GetBitmapDimensionEx :: HBITMAP -> Ptr SIZE -> IO Bool setBitmapDimensionEx :: HBITMAP -> SIZE -> IO SIZE setBitmapDimensionEx bm (cx,cy) = allocaSIZE $ \ p_size -> do failIfFalse_ "SetBitmapDimensionEx" $ do c_SetBitmapDimensionEx bm cx cy p_size peekSIZE p_size foreign import stdcall unsafe "windows.h SetBitmapDimensionEx" c_SetBitmapDimensionEx :: HBITMAP -> LONG -> LONG -> Ptr SIZE -> IO Bool getBitmapInfo :: HBITMAP -> IO BITMAP getBitmapInfo bm = allocaBytes (fromIntegral sizeofBITMAP) $ \ p_bm -> do failIfFalse_ "GetBitmapInfo" $ c_GetBitmapInfo bm sizeofBITMAP p_bm peekBITMAP p_bm foreign import stdcall unsafe "windows.h GetObjectW" c_GetBitmapInfo :: HBITMAP -> DWORD -> LPBITMAP -> IO Bool ---------------------------------------------------------------- -- ---------------------------------------------------------------- type BitmapCompression = DWORD #{enum BitmapCompression, , bI_RGB = BI_RGB , bI_RLE8 = BI_RLE8 , bI_RLE4 = BI_RLE4 , bI_BITFIELDS = BI_BITFIELDS } type ColorFormat = DWORD #{enum ColorFormat, , dIB_PAL_COLORS = DIB_PAL_COLORS , dIB_RGB_COLORS = DIB_RGB_COLORS } ---------------------------------------------------------------- -- BITMAPINFO ---------------------------------------------------------------- type LPBITMAPINFO = Ptr () ---------------------------------------------------------------- -- BITMAPINFOHEADER ---------------------------------------------------------------- type BITMAPINFOHEADER = ( DWORD -- biSize -- sizeof(BITMAPINFOHEADER) , LONG -- biWidth , LONG -- biHeight , WORD -- biPlanes , WORD -- biBitCount -- 1, 4, 8, 16, 24 or 32 , BitmapCompression -- biCompression , DWORD -- biSizeImage , LONG -- biXPelsPerMeter , LONG -- biYPelsPerMeter , Maybe DWORD -- biClrUsed , Maybe DWORD -- biClrImportant ) peekBITMAPINFOHEADER :: Ptr BITMAPINFOHEADER -> IO BITMAPINFOHEADER peekBITMAPINFOHEADER p = do size <- #{peek BITMAPINFOHEADER,biSize} p width <- #{peek BITMAPINFOHEADER,biWidth} p height <- #{peek BITMAPINFOHEADER,biHeight} p planes <- #{peek BITMAPINFOHEADER,biPlanes} p nbits <- #{peek BITMAPINFOHEADER,biBitCount} p comp <- #{peek BITMAPINFOHEADER,biCompression} p imsize <- #{peek BITMAPINFOHEADER,biSizeImage} p xDensity <- #{peek BITMAPINFOHEADER,biXPelsPerMeter} p yDensity <- #{peek BITMAPINFOHEADER,biYPelsPerMeter} p clrUsed <- liftM numToMaybe $ #{peek BITMAPINFOHEADER,biClrUsed} p clrImp <- liftM numToMaybe $ #{peek BITMAPINFOHEADER,biClrImportant} p return (size, width, height, planes, nbits, comp, imsize, xDensity, yDensity, clrUsed, clrImp) type LPBITMAPINFOHEADER = Ptr BITMAPINFOHEADER getBITMAPINFOHEADER_ :: LPBITMAPINFOHEADER -> IO BITMAPINFOHEADER getBITMAPINFOHEADER_ = peekBITMAPINFOHEADER ---------------------------------------------------------------- -- BITMAPFILEHEADER ---------------------------------------------------------------- type BITMAPFILEHEADER = ( WORD -- bfType -- "BM" == 0x4d42 , DWORD -- bfSize -- number of bytes in file , WORD -- bfReserved1 -- == 0 , WORD -- bfReserved2 -- == 0 , DWORD -- bfOffBits -- == (char*) bits - (char*) filehdr ) peekBITMAPFILEHEADER :: Ptr BITMAPFILEHEADER -> IO BITMAPFILEHEADER peekBITMAPFILEHEADER p = do ty <- #{peek BITMAPFILEHEADER,bfType} p size <- #{peek BITMAPFILEHEADER,bfSize} p res1 <- #{peek BITMAPFILEHEADER,bfReserved1} p res2 <- #{peek BITMAPFILEHEADER,bfReserved2} p offset <- #{peek BITMAPFILEHEADER,bfOffBits} p return (ty, size, res1, res2, offset) type LPBITMAPFILEHEADER = Ptr BITMAPFILEHEADER getBITMAPFILEHEADER :: LPBITMAPFILEHEADER -> IO BITMAPFILEHEADER getBITMAPFILEHEADER = peekBITMAPFILEHEADER sizeofBITMAP :: Word32 sizeofBITMAP = #{size BITMAP} sizeofBITMAPINFO :: Word32 sizeofBITMAPINFO = #{size BITMAPINFO} sizeofBITMAPINFOHEADER :: Word32 sizeofBITMAPINFOHEADER = #{size BITMAPINFOHEADER} sizeofBITMAPFILEHEADER :: Word32 sizeofBITMAPFILEHEADER = #{size BITMAPFILEHEADER} sizeofLPBITMAPFILEHEADER :: Word32 sizeofLPBITMAPFILEHEADER = #{size BITMAPFILEHEADER} ---------------------------------------------------------------- -- CreateBMPFile ---------------------------------------------------------------- -- A (large) helper function - courtesy of Microsoft createBMPFile :: String -> HBITMAP -> HDC -> IO () createBMPFile name bm dc = withCString name $ \ c_name -> c_CreateBMPFile c_name bm dc foreign import ccall unsafe "dumpBMP.h CreateBMPFile" c_CreateBMPFile :: LPCSTR -> HBITMAP -> HDC -> IO () {-# CFILES cbits/dumpBMP.c #-} ---------------------------------------------------------------- -- Device Independent Bitmaps ---------------------------------------------------------------- #{enum DWORD, , cBM_INIT = CBM_INIT } getDIBits :: HDC -> HBITMAP -> INT -> INT -> Maybe LPVOID -> LPBITMAPINFO -> ColorFormat -> IO INT getDIBits dc bm start nlines mb_bits info usage = failIfZero "GetDIBits" $ c_GetDIBits dc bm start nlines (maybePtr mb_bits) info usage foreign import stdcall unsafe "windows.h GetDIBits" c_GetDIBits :: HDC -> HBITMAP -> INT -> INT -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO INT setDIBits :: HDC -> HBITMAP -> INT -> INT -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO INT setDIBits dc bm start nlines bits info use = failIfZero "SetDIBits" $ c_SetDIBits dc bm start nlines bits info use foreign import stdcall unsafe "windows.h SetDIBits" c_SetDIBits :: HDC -> HBITMAP -> INT -> INT -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO INT createDIBitmap :: HDC -> LPBITMAPINFOHEADER -> DWORD -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO HBITMAP createDIBitmap dc hdr option init_val info usage = failIfNull "CreateDIBitmap" $ c_CreateDIBitmap dc hdr option init_val info usage foreign import stdcall unsafe "windows.h CreateDIBitmap" c_CreateDIBitmap :: HDC -> LPBITMAPINFOHEADER -> DWORD -> LPVOID -> LPBITMAPINFO -> ColorFormat -> IO HBITMAP ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Brush.hsc0000644006511100651110000000451210504340503022266 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Brush -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Brush where import System.Win32.Types import Graphics.Win32.GDI.Types #include ---------------------------------------------------------------- -- Brush ---------------------------------------------------------------- createSolidBrush :: COLORREF -> IO HBRUSH createSolidBrush color = failIfNull "CreateSolidBrush" $ c_CreateSolidBrush color foreign import stdcall unsafe "windows.h CreateSolidBrush" c_CreateSolidBrush :: COLORREF -> IO HBRUSH createHatchBrush :: HatchStyle -> COLORREF -> IO HBRUSH createHatchBrush style color = failIfNull "CreateHatchBrush" $ c_CreateHatchBrush style color foreign import stdcall unsafe "windows.h CreateHatchBrush" c_CreateHatchBrush :: HatchStyle -> COLORREF -> IO HBRUSH createPatternBrush :: HBITMAP -> IO HBRUSH createPatternBrush bitmap = failIfNull "CreatePatternBrush" $ c_CreatePatternBrush bitmap foreign import stdcall unsafe "windows.h CreatePatternBrush" c_CreatePatternBrush :: HBITMAP -> IO HBRUSH deleteBrush :: HBRUSH -> IO () deleteBrush brush = failIfFalse_ "DeleteBrush" $ c_DeleteBrush brush foreign import stdcall unsafe "windows.h DeleteObject" c_DeleteBrush :: HBRUSH -> IO Bool ---------------------------------------------------------------- type StockBrush = INT #{enum StockBrush, , wHITE_BRUSH = WHITE_BRUSH , lTGRAY_BRUSH = LTGRAY_BRUSH , gRAY_BRUSH = GRAY_BRUSH , dKGRAY_BRUSH = DKGRAY_BRUSH , bLACK_BRUSH = BLACK_BRUSH , nULL_BRUSH = NULL_BRUSH , hOLLOW_BRUSH = HOLLOW_BRUSH } getStockBrush :: StockBrush -> IO HBRUSH getStockBrush sb = failIfNull "GetStockBrush" $ c_GetStockBrush sb foreign import stdcall unsafe "windows.h GetStockObject" c_GetStockBrush :: StockBrush -> IO HBRUSH ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Clip.hsc0000644006511100651110000001226010504340503022071 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Clip -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Clip where import Graphics.Win32.GDI.Types import System.Win32.Types import Foreign #include type ClipboardFormat = UINT #{enum ClipboardFormat, , cF_BITMAP = CF_BITMAP , cF_DIB = CF_DIB , cF_DIF = CF_DIF , cF_DSPBITMAP = CF_DSPBITMAP , cF_DSPENHMETAFILE = CF_DSPENHMETAFILE , cF_DSPMETAFILEPICT = CF_DSPMETAFILEPICT , cF_DSPTEXT = CF_DSPTEXT , cF_ENHMETAFILE = CF_ENHMETAFILE , cF_GDIOBJFIRST = CF_GDIOBJFIRST , cF_HDROP = CF_HDROP , cF_LOCALE = CF_LOCALE , cF_METAFILEPICT = CF_METAFILEPICT , cF_OEMTEXT = CF_OEMTEXT , cF_OWNERDISPLAY = CF_OWNERDISPLAY , cF_PALETTE = CF_PALETTE , cF_PENDATA = CF_PENDATA , cF_PRIVATEFIRST = CF_PRIVATEFIRST , cF_PRIVATELAST = CF_PRIVATELAST , cF_RIFF = CF_RIFF , cF_SYLK = CF_SYLK , cF_TEXT = CF_TEXT , cF_WAVE = CF_WAVE , cF_TIFF = CF_TIFF } -- % , CF_UNICODETEXT -- WinNT only foreign import stdcall unsafe "windows.h ChangeClipboardChain" changeClipboardChain :: HWND -> HWND -> IO Bool closeClipboard :: IO () closeClipboard = failIfFalse_ "CloseClipboard" c_CloseClipboard foreign import stdcall unsafe "windows.h CloseClipboard" c_CloseClipboard :: IO BOOL foreign import stdcall unsafe "windows.h CountClipboardFormats" countClipboardFormats :: IO Int emptyClipboard :: IO () emptyClipboard = failIfFalse_ "EmptyClipboard" c_EmptyClipboard foreign import stdcall unsafe "windows.h EmptyClipboard" c_EmptyClipboard :: IO BOOL -- original also tested GetLastError() != NO_ERROR enumClipboardFormats :: ClipboardFormat -> IO ClipboardFormat enumClipboardFormats format = failIfZero "EnumClipboardFormats" $ c_EnumClipboardFormats format foreign import stdcall unsafe "windows.h EnumClipboardFormats" c_EnumClipboardFormats :: ClipboardFormat -> IO ClipboardFormat getClipboardData :: ClipboardFormat -> IO HANDLE getClipboardData format = failIfNull "GetClipboardData" $ c_GetClipboardData format foreign import stdcall unsafe "windows.h GetClipboardData" c_GetClipboardData :: ClipboardFormat -> IO HANDLE getClipboardFormatName :: ClipboardFormat -> IO String getClipboardFormatName format = allocaArray 256 $ \ c_name -> do len <- failIfZero "GetClipboardFormatName" $ c_GetClipboardFormatName format c_name 256 peekTStringLen (c_name, len) foreign import stdcall unsafe "windows.h GetClipboardFormatNameW" c_GetClipboardFormatName :: ClipboardFormat -> LPTSTR -> Int -> IO Int getClipboardOwner :: IO HWND getClipboardOwner = failIfNull "GetClipboardOwner" c_GetClipboardOwner foreign import stdcall unsafe "windows.h GetClipboardOwner" c_GetClipboardOwner :: IO HWND getClipboardViewer :: IO HWND getClipboardViewer = failIfNull "GetClipboardViewer" c_GetClipboardViewer foreign import stdcall unsafe "windows.h GetClipboardViewer" c_GetClipboardViewer :: IO HWND getOpenClipboardWindow :: IO HWND getOpenClipboardWindow = failIfNull "GetClipboardWindow" c_GetOpenClipboardWindow foreign import stdcall unsafe "windows.h GetOpenClipboardWindow" c_GetOpenClipboardWindow :: IO HWND getPriorityClipboardFormat :: [ClipboardFormat] -> IO Int getPriorityClipboardFormat formats = withArray formats $ \ format_array -> failIf (== -1) "GetPriorityClipboardFormat" $ c_GetPriorityClipboardFormat format_array (length formats) foreign import stdcall unsafe "windows.h GetPriorityClipboardFormat" c_GetPriorityClipboardFormat :: Ptr UINT -> Int -> IO Int foreign import stdcall unsafe "windows.h IsClipboardFormatAvailable" isClipboardFormatAvailable :: ClipboardFormat -> IO BOOL openClipboard :: HWND -> IO () openClipboard wnd = failIfFalse_ "OpenClipboard" $ c_OpenClipboard wnd foreign import stdcall unsafe "windows.h OpenClipboard" c_OpenClipboard :: HWND -> IO BOOL registerClipboardFormat :: String -> IO ClipboardFormat registerClipboardFormat name = withTString name $ \ c_name -> failIfZero "RegisterClipboardFormat" $ c_RegisterClipboardFormat c_name foreign import stdcall unsafe "windows.h RegisterClipboardFormatW" c_RegisterClipboardFormat :: LPCTSTR -> IO ClipboardFormat setClipboardData :: ClipboardFormat -> HANDLE -> IO HANDLE setClipboardData format mem = failIfNull "SetClipboardData" $ c_SetClipboardData format mem foreign import stdcall unsafe "windows.h SetClipboardData" c_SetClipboardData :: ClipboardFormat -> HANDLE -> IO HANDLE setClipboardViewer :: HWND -> IO HWND setClipboardViewer wnd = failIfNull "SetClipboardViewer" $ c_SetClipboardViewer wnd foreign import stdcall unsafe "windows.h SetClipboardViewer" c_SetClipboardViewer :: HWND -> IO HWND hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Font.hsc0000644006511100651110000001344210504340503022113 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Font -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Font {- ( CharSet , PitchAndFamily , OutPrecision , ClipPrecision , FontQuality , FontWeight , createFont, deleteFont , StockFont, getStockFont , oEM_FIXED_FONT, aNSI_FIXED_FONT, aNSI_VAR_FONT, sYSTEM_FONT , dEVICE_DEFAULT_FONT, sYSTEM_FIXED_FONT ) where -} where import System.Win32.Types import Graphics.Win32.GDI.Types import Foreign #include ---------------------------------------------------------------- -- Types ---------------------------------------------------------------- type CharSet = UINT type PitchAndFamily = UINT type OutPrecision = UINT type ClipPrecision = UINT type FontQuality = UINT type FontWeight = Word32 type FaceName = String -- A FaceName is a string no more that LF_FACESIZE in length -- (including null terminator). -- %const Int LF_FACESIZE # == 32 -- %sentinel_array : FaceName : CHAR : char : $0 = '\0' : ('\0' == $0) : LF_FACESIZE ---------------------------------------------------------------- -- Constants ---------------------------------------------------------------- #{enum CharSet, , aNSI_CHARSET = ANSI_CHARSET , dEFAULT_CHARSET = DEFAULT_CHARSET , sYMBOL_CHARSET = SYMBOL_CHARSET , sHIFTJIS_CHARSET = SHIFTJIS_CHARSET , hANGEUL_CHARSET = HANGEUL_CHARSET , cHINESEBIG5_CHARSET = CHINESEBIG5_CHARSET , oEM_CHARSET = OEM_CHARSET } #{enum PitchAndFamily, , dEFAULT_PITCH = DEFAULT_PITCH , fIXED_PITCH = FIXED_PITCH , vARIABLE_PITCH = VARIABLE_PITCH , fF_DONTCARE = FF_DONTCARE , fF_ROMAN = FF_ROMAN , fF_SWISS = FF_SWISS , fF_MODERN = FF_MODERN , fF_SCRIPT = FF_SCRIPT , fF_DECORATIVE = FF_DECORATIVE } familyMask, pitchMask :: PitchAndFamily familyMask = 0xF0 pitchMask = 0x0F #{enum OutPrecision, , oUT_DEFAULT_PRECIS = OUT_DEFAULT_PRECIS , oUT_STRING_PRECIS = OUT_STRING_PRECIS , oUT_CHARACTER_PRECIS = OUT_CHARACTER_PRECIS , oUT_STROKE_PRECIS = OUT_STROKE_PRECIS , oUT_TT_PRECIS = OUT_TT_PRECIS , oUT_DEVICE_PRECIS = OUT_DEVICE_PRECIS , oUT_RASTER_PRECIS = OUT_RASTER_PRECIS , oUT_TT_ONLY_PRECIS = OUT_TT_ONLY_PRECIS } #{enum ClipPrecision, , cLIP_DEFAULT_PRECIS = CLIP_DEFAULT_PRECIS , cLIP_CHARACTER_PRECIS = CLIP_CHARACTER_PRECIS , cLIP_STROKE_PRECIS = CLIP_STROKE_PRECIS , cLIP_MASK = CLIP_MASK , cLIP_LH_ANGLES = CLIP_LH_ANGLES , cLIP_TT_ALWAYS = CLIP_TT_ALWAYS , cLIP_EMBEDDED = CLIP_EMBEDDED } #{enum FontQuality, , dEFAULT_QUALITY = DEFAULT_QUALITY , dRAFT_QUALITY = DRAFT_QUALITY , pROOF_QUALITY = PROOF_QUALITY } #{enum FontWeight, , fW_DONTCARE = FW_DONTCARE , fW_THIN = FW_THIN , fW_EXTRALIGHT = FW_EXTRALIGHT , fW_LIGHT = FW_LIGHT , fW_NORMAL = FW_NORMAL , fW_MEDIUM = FW_MEDIUM , fW_SEMIBOLD = FW_SEMIBOLD , fW_BOLD = FW_BOLD , fW_EXTRABOLD = FW_EXTRABOLD , fW_HEAVY = FW_HEAVY , fW_REGULAR = FW_REGULAR , fW_ULTRALIGHT = FW_ULTRALIGHT , fW_DEMIBOLD = FW_DEMIBOLD , fW_ULTRABOLD = FW_ULTRABOLD , fW_BLACK = FW_BLACK } ---------------------------------------------------------------- -- Functions ---------------------------------------------------------------- -- was: ErrorMsg("CreateFont","NullHandle") createFont :: INT -> INT -> INT -> INT -> FontWeight -> Bool -> Bool -> Bool -> CharSet -> OutPrecision -> ClipPrecision -> FontQuality -> PitchAndFamily -> FaceName -> IO HFONT createFont h w esc orient wt ital under strike cset out clip q pf face = withTString face $ \ c_face -> failIfNull "CreateFont" $ c_CreateFont h w esc orient wt ital under strike cset out clip q pf c_face foreign import stdcall unsafe "windows.h CreateFontW" c_CreateFont :: INT -> INT -> INT -> INT -> FontWeight -> Bool -> Bool -> Bool -> CharSet -> OutPrecision -> ClipPrecision -> FontQuality -> PitchAndFamily -> LPCTSTR -> IO HFONT -- test :: IO () -- test = do -- f <- createFont_adr (100,100) 0 False False "Arial" -- putStrLn "Created first font" -- f <- createFont_adr (100,100) (-90) False False "Bogus" -- putStrLn "Created second font" -- -- createFont_adr (width, height) escapement bold italic family = -- createFont height width -- (round (escapement * 1800/pi)) -- 0 -- orientation -- weight -- italic False False -- italic, underline, strikeout -- aNSI_CHARSET -- oUT_DEFAULT_PRECIS -- cLIP_DEFAULT_PRECIS -- dEFAULT_QUALITY -- dEFAULT_PITCH -- family -- where -- weight | bold = fW_BOLD -- | otherwise = fW_NORMAL -- missing CreateFontIndirect from WinFonts.ss; GSL ??? foreign import stdcall unsafe "windows.h DeleteObject" deleteFont :: HFONT -> IO () ---------------------------------------------------------------- type StockFont = WORD #{enum StockFont, , oEM_FIXED_FONT = OEM_FIXED_FONT , aNSI_FIXED_FONT = ANSI_FIXED_FONT , aNSI_VAR_FONT = ANSI_VAR_FONT , sYSTEM_FONT = SYSTEM_FONT , dEVICE_DEFAULT_FONT = DEVICE_DEFAULT_FONT , sYSTEM_FIXED_FONT = SYSTEM_FIXED_FONT } foreign import stdcall unsafe "windows.h GetStockObject" getStockFont :: StockFont -> IO HFONT ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/HDC.hs0000644006511100651110000002546210504340503021445 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.HDC -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.HDC ( module Graphics.Win32.GDI.HDC ) where import System.Win32.Types import Graphics.Win32.GDI.Types import Foreign ---------------------------------------------------------------- setArcDirection :: HDC -> ArcDirection -> IO ArcDirection setArcDirection dc dir = failIfZero "SetArcDirection" $ c_SetArcDirection dc dir foreign import stdcall unsafe "windows.h SetArcDirection" c_SetArcDirection :: HDC -> ArcDirection -> IO ArcDirection getArcDirection :: HDC -> IO ArcDirection getArcDirection dc = failIfZero "GetArcDirection" $ c_GetArcDirection dc foreign import stdcall unsafe "windows.h GetArcDirection" c_GetArcDirection :: HDC -> IO ArcDirection setPolyFillMode :: HDC -> PolyFillMode -> IO PolyFillMode setPolyFillMode dc mode = failIfZero "SetPolyFillMode" $ c_SetPolyFillMode dc mode foreign import stdcall unsafe "windows.h SetPolyFillMode" c_SetPolyFillMode :: HDC -> PolyFillMode -> IO PolyFillMode getPolyFillMode :: HDC -> IO PolyFillMode getPolyFillMode dc = failIfZero "GetPolyFillMode" $ c_GetPolyFillMode dc foreign import stdcall unsafe "windows.h GetPolyFillMode" c_GetPolyFillMode :: HDC -> IO PolyFillMode setGraphicsMode :: HDC -> GraphicsMode -> IO GraphicsMode setGraphicsMode dc mode = failIfZero "SetGraphicsMode" $ c_SetGraphicsMode dc mode foreign import stdcall unsafe "windows.h SetGraphicsMode" c_SetGraphicsMode :: HDC -> GraphicsMode -> IO GraphicsMode getGraphicsMode :: HDC -> IO GraphicsMode getGraphicsMode dc = failIfZero "GetGraphicsMode" $ c_GetGraphicsMode dc foreign import stdcall unsafe "windows.h GetGraphicsMode" c_GetGraphicsMode :: HDC -> IO GraphicsMode setStretchBltMode :: HDC -> StretchBltMode -> IO StretchBltMode setStretchBltMode dc mode = failIfZero "SetStretchBltMode" $ c_SetStretchBltMode dc mode foreign import stdcall unsafe "windows.h SetStretchBltMode" c_SetStretchBltMode :: HDC -> StretchBltMode -> IO StretchBltMode getStretchBltMode :: HDC -> IO StretchBltMode getStretchBltMode dc = failIfZero "GetStretchBltMode" $ c_GetStretchBltMode dc foreign import stdcall unsafe "windows.h GetStretchBltMode" c_GetStretchBltMode :: HDC -> IO StretchBltMode setBkColor :: HDC -> COLORREF -> IO COLORREF setBkColor dc color = failIfZero "SetBkColor" $ c_SetBkColor dc color foreign import stdcall unsafe "windows.h SetBkColor" c_SetBkColor :: HDC -> COLORREF -> IO COLORREF getBkColor :: HDC -> IO COLORREF getBkColor dc = failIfZero "GetBkColor" $ c_GetBkColor dc foreign import stdcall unsafe "windows.h GetBkColor" c_GetBkColor :: HDC -> IO COLORREF setTextColor :: HDC -> COLORREF -> IO COLORREF setTextColor dc color = failIf (== cLR_INVALID) "SetTextColor" $ c_SetTextColor dc color foreign import stdcall unsafe "windows.h SetTextColor" c_SetTextColor :: HDC -> COLORREF -> IO COLORREF getTextColor :: HDC -> IO COLORREF getTextColor dc = failIf (== cLR_INVALID) "GetTextColor" $ c_GetTextColor dc foreign import stdcall unsafe "windows.h GetTextColor" c_GetTextColor :: HDC -> IO COLORREF setBkMode :: HDC -> BackgroundMode -> IO BackgroundMode setBkMode dc mode = failIfZero "SetBkMode" $ c_SetBkMode dc mode foreign import stdcall unsafe "windows.h SetBkMode" c_SetBkMode :: HDC -> BackgroundMode -> IO BackgroundMode getBkMode :: HDC -> IO BackgroundMode getBkMode dc = failIfZero "GetBkMode" $ c_GetBkMode dc foreign import stdcall unsafe "windows.h GetBkMode" c_GetBkMode :: HDC -> IO BackgroundMode setBrushOrgEx :: HDC -> Int -> Int -> IO POINT setBrushOrgEx dc x y = allocaPOINT $ \ pt -> do failIfFalse_ "SetBrushOrgEx" $ c_SetBrushOrgEx dc x y pt peekPOINT pt foreign import stdcall unsafe "windows.h SetBrushOrgEx" c_SetBrushOrgEx :: HDC -> Int -> Int -> Ptr POINT -> IO Bool getBrushOrgEx :: HDC -> IO POINT getBrushOrgEx dc = allocaPOINT $ \ pt -> do failIfFalse_ "GetBrushOrgEx" $ c_GetBrushOrgEx dc pt peekPOINT pt foreign import stdcall unsafe "windows.h GetBrushOrgEx" c_GetBrushOrgEx :: HDC -> Ptr POINT -> IO Bool setTextAlign :: HDC -> TextAlignment -> IO TextAlignment setTextAlign dc align = failIf (== gDI_ERROR) "SetTextAlign" $ c_SetTextAlign dc align foreign import stdcall unsafe "windows.h SetTextAlign" c_SetTextAlign :: HDC -> TextAlignment -> IO TextAlignment getTextAlign :: HDC -> IO TextAlignment getTextAlign dc = failIf (== gDI_ERROR) "GetTextAlign" $ c_GetTextAlign dc foreign import stdcall unsafe "windows.h GetTextAlign" c_GetTextAlign :: HDC -> IO TextAlignment setTextCharacterExtra :: HDC -> Int -> IO Int setTextCharacterExtra dc extra = failIf (== 0x80000000) "SetTextCharacterExtra" $ c_SetTextCharacterExtra dc extra foreign import stdcall unsafe "windows.h SetTextCharacterExtra" c_SetTextCharacterExtra :: HDC -> Int -> IO Int getTextCharacterExtra :: HDC -> IO Int getTextCharacterExtra dc = failIf (== 0x80000000) "GetTextCharacterExtra" $ c_GetTextCharacterExtra dc foreign import stdcall unsafe "windows.h GetTextCharacterExtra" c_GetTextCharacterExtra :: HDC -> IO Int getMiterLimit :: HDC -> IO Float getMiterLimit dc = alloca $ \ p_res -> do failIfFalse_ "GetMiterLimit" $ c_GetMiterLimit dc p_res peek p_res foreign import stdcall unsafe "windows.h GetMiterLimit" c_GetMiterLimit :: HDC -> Ptr FLOAT -> IO Bool setMiterLimit :: HDC -> Float -> IO Float setMiterLimit dc new_limit = alloca $ \ p_old_limit -> do failIfFalse_ "SetMiterLimit" $ c_SetMiterLimit dc new_limit p_old_limit peek p_old_limit foreign import stdcall unsafe "windows.h SetMiterLimit" c_SetMiterLimit :: HDC -> FLOAT -> Ptr FLOAT -> IO Bool ---------------------------------------------------------------- saveDC :: HDC -> IO Int saveDC dc = failIfZero "SaveDC" $ c_SaveDC dc foreign import stdcall unsafe "windows.h SaveDC" c_SaveDC :: HDC -> IO Int restoreDC :: HDC -> Int -> IO () restoreDC dc saved = failIfFalse_ "RestoreDC" $ c_RestoreDC dc saved foreign import stdcall unsafe "windows.h RestoreDC" c_RestoreDC :: HDC -> Int -> IO Bool ---------------------------------------------------------------- getCurrentBitmap :: HDC -> IO HBITMAP getCurrentBitmap dc = failIfNull "GetCurrentBitmap" $ c_GetCurrentBitmap dc oBJ_BITMAP foreign import stdcall unsafe "windows.h GetCurrentObject" c_GetCurrentBitmap :: HDC -> UINT -> IO HBITMAP getCurrentBrush :: HDC -> IO HBRUSH getCurrentBrush dc = failIfNull "GetCurrentBrush" $ c_GetCurrentBrush dc oBJ_BRUSH foreign import stdcall unsafe "windows.h GetCurrentObject" c_GetCurrentBrush :: HDC -> UINT -> IO HBRUSH getCurrentFont :: HDC -> IO HFONT getCurrentFont dc = failIfNull "GetCurrentFont" $ c_GetCurrentFont dc oBJ_FONT foreign import stdcall unsafe "windows.h GetCurrentObject" c_GetCurrentFont :: HDC -> UINT -> IO HFONT getCurrentPalette :: HDC -> IO HPALETTE getCurrentPalette dc = failIfNull "GetCurrentPalette" $ c_GetCurrentPalette dc oBJ_PAL foreign import stdcall unsafe "windows.h GetCurrentObject" c_GetCurrentPalette :: HDC -> UINT -> IO HPALETTE getCurrentPen :: HDC -> IO HPEN getCurrentPen dc = failIfNull "GetCurrentPen" $ c_GetCurrentPen dc oBJ_PEN foreign import stdcall unsafe "windows.h GetCurrentObject" c_GetCurrentPen :: HDC -> UINT -> IO HPEN selectBitmap :: HDC -> HBITMAP -> IO HBITMAP selectBitmap dc bitmap = failIfNull "SelectBitmap" $ c_SelectBitmap dc bitmap foreign import stdcall unsafe "windows.h SelectObject" c_SelectBitmap :: HDC -> HBITMAP -> IO HBITMAP selectBrush :: HDC -> HBRUSH -> IO HBRUSH selectBrush dc brush = failIfNull "SelectBrush" $ c_SelectBrush dc brush foreign import stdcall unsafe "windows.h SelectObject" c_SelectBrush :: HDC -> HBRUSH -> IO HBRUSH selectFont :: HDC -> HFONT -> IO HFONT selectFont dc font = failIfNull "SelectFont" $ c_SelectFont dc font foreign import stdcall unsafe "windows.h SelectObject" c_SelectFont :: HDC -> HFONT -> IO HFONT selectPen :: HDC -> HPEN -> IO HPEN selectPen dc pen = failIfNull "SelectPen" $ c_SelectPen dc pen foreign import stdcall unsafe "windows.h SelectObject" c_SelectPen :: HDC -> HPEN -> IO HPEN ---------------------------------------------------------------- -- ---------------------------------------------------------------- selectPalette :: HDC -> HPALETTE -> Bool -> IO HPALETTE selectPalette dc palette force_bg = failIfNull "SelectPalette" $ c_SelectPalette dc palette force_bg foreign import stdcall unsafe "windows.h SelectPalette" c_SelectPalette :: HDC -> HPALETTE -> Bool -> IO HPALETTE selectRgn :: HDC -> HRGN -> IO RegionType selectRgn dc rgn = withForeignPtr rgn $ \ p_rgn -> failIf (== gDI_ERROR) "SelectRgn" $ c_SelectRgn dc p_rgn foreign import stdcall unsafe "windows.h SelectObject" c_SelectRgn :: HDC -> PRGN -> IO RegionType selectClipRgn :: HDC -> Maybe HRGN -> IO RegionType selectClipRgn dc mb_rgn = maybeWith withForeignPtr mb_rgn $ \ p_rgn -> failIfZero "SelectClipRgn" $ c_SelectClipRgn dc p_rgn foreign import stdcall unsafe "windows.h SelectClipRgn" c_SelectClipRgn :: HDC -> PRGN -> IO RegionType extSelectClipRgn :: HDC -> Maybe HRGN -> ClippingMode -> IO RegionType extSelectClipRgn dc mb_rgn mode = maybeWith withForeignPtr mb_rgn $ \ p_rgn -> failIfZero "ExtSelectClipRgn" $ c_ExtSelectClipRgn dc p_rgn mode foreign import stdcall unsafe "windows.h ExtSelectClipRgn" c_ExtSelectClipRgn :: HDC -> PRGN -> ClippingMode -> IO RegionType selectClipPath :: HDC -> ClippingMode -> IO RegionType selectClipPath dc mode = failIfZero "SelectClipPath" $ c_SelectClipPath dc mode foreign import stdcall unsafe "windows.h SelectClipPath" c_SelectClipPath :: HDC -> ClippingMode -> IO RegionType ---------------------------------------------------------------- -- Misc ---------------------------------------------------------------- cancelDC :: HDC -> IO () cancelDC dc = failIfFalse_ "CancelDC" $ c_CancelDC dc foreign import stdcall unsafe "windows.h CancelDC" c_CancelDC :: HDC -> IO Bool createCompatibleDC :: Maybe HDC -> IO HDC createCompatibleDC mb_dc = failIfNull "CreateCompatibleDC" $ c_CreateCompatibleDC (maybePtr mb_dc) foreign import stdcall unsafe "windows.h CreateCompatibleDC" c_CreateCompatibleDC :: HDC -> IO HDC deleteDC :: HDC -> IO () deleteDC dc = failIfFalse_ "DeleteDC" $ c_DeleteDC dc foreign import stdcall unsafe "windows.h DeleteDC" c_DeleteDC :: HDC -> IO Bool ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Graphics2D.hs0000644006511100651110000002243710504340503022774 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Graphics2D -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- 2D graphics operations -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Graphics2D where import System.Win32.Types import Graphics.Win32.GDI.Types import Graphics.Win32.GDI.Bitmap import Foreign ---------------------------------------------------------------- -- Lines and Curves ---------------------------------------------------------------- moveToEx :: HDC -> Int32 -> Int32 -> IO POINT moveToEx dc x y = allocaPOINT $ \ p_point -> do failIfFalse_ "MoveToEx" $ c_MoveToEx dc x y p_point peekPOINT p_point foreign import stdcall unsafe "windows.h MoveToEx" c_MoveToEx :: HDC -> Int32 -> Int32 -> Ptr POINT -> IO Bool lineTo :: HDC -> Int32 -> Int32 -> IO () lineTo dc x y = failIfFalse_ "LineTo" $ c_LineTo dc x y foreign import stdcall unsafe "windows.h LineTo" c_LineTo :: HDC -> Int32 -> Int32 -> IO Bool polyline :: HDC -> [POINT] -> IO () polyline dc points = withPOINTArray points $ \ pount_array npoints -> failIfFalse_ "Polyline" $ c_Polyline dc pount_array npoints foreign import stdcall unsafe "windows.h Polyline" c_Polyline :: HDC -> Ptr POINT -> Int -> IO Bool polylineTo :: HDC -> [POINT] -> IO () polylineTo dc points = withPOINTArray points $ \ pount_array npoints -> failIfFalse_ "PolylineTo" $ c_PolylineTo dc pount_array npoints foreign import stdcall unsafe "windows.h PolylineTo" c_PolylineTo :: HDC -> Ptr POINT -> Int -> IO Bool polygon :: HDC -> [POINT] -> IO () polygon dc points = withPOINTArray points $ \ pount_array npoints -> failIfFalse_ "Polygon" $ c_Polygon dc pount_array npoints foreign import stdcall unsafe "windows.h Polygon" c_Polygon :: HDC -> Ptr POINT -> Int -> IO Bool polyBezier :: HDC -> [POINT] -> IO () polyBezier dc points = withPOINTArray points $ \ pount_array npoints -> failIfFalse_ "PolyBezier" $ c_PolyBezier dc pount_array npoints foreign import stdcall unsafe "windows.h PolyBezier" c_PolyBezier :: HDC -> Ptr POINT -> Int -> IO Bool polyBezierTo :: HDC -> [POINT] -> IO () polyBezierTo dc points = withPOINTArray points $ \ pount_array npoints -> failIfFalse_ "PolyBezierTo" $ c_PolyBezierTo dc pount_array npoints foreign import stdcall unsafe "windows.h PolyBezierTo" c_PolyBezierTo :: HDC -> Ptr POINT -> Int -> IO Bool arc :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO () arc dc left top right bottom x1 y1 x2 y2 = failIfFalse_ "Arc" $ c_Arc dc left top right bottom x1 y1 x2 y2 foreign import stdcall unsafe "windows.h Arc" c_Arc :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO Bool arcTo :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO () arcTo dc left top right bottom x1 y1 x2 y2 = failIfFalse_ "ArcTo" $ c_ArcTo dc left top right bottom x1 y1 x2 y2 foreign import stdcall unsafe "windows.h ArcTo" c_ArcTo :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO Bool angleArc :: HDC -> Int32 -> Int32 -> WORD -> Double -> Double -> IO () angleArc dc x y r start sweep = failIfFalse_ "AngleArc" $ c_AngleArc dc x y r start sweep foreign import stdcall unsafe "windows.h AngleArc" c_AngleArc :: HDC -> Int32 -> Int32 -> WORD -> Double -> Double -> IO Bool ---------------------------------------------------------------- -- Filled Shapes ---------------------------------------------------------------- -- ToDo: We ought to be able to specify a colour instead of the -- Brush by adding 1 to colour number. fillRect :: HDC -> RECT -> HBRUSH -> IO () fillRect dc rect brush = withRECT rect $ \ c_rect -> failIfFalse_ "FillRect" $ c_FillRect dc c_rect brush foreign import stdcall unsafe "windows.h FillRect" c_FillRect :: HDC -> Ptr RECT -> HBRUSH -> IO Bool frameRect :: HDC -> RECT -> HBRUSH -> IO () frameRect dc rect brush = withRECT rect $ \ c_rect -> failIfFalse_ "FrameRect" $ c_FrameRect dc c_rect brush foreign import stdcall unsafe "windows.h FrameRect" c_FrameRect :: HDC -> Ptr RECT -> HBRUSH -> IO Bool invertRect :: HDC -> RECT -> IO () invertRect dc rect = withRECT rect $ \ c_rect -> failIfFalse_ "InvertRect" $ c_InvertRect dc c_rect foreign import stdcall unsafe "windows.h InvertRect" c_InvertRect :: HDC -> Ptr RECT -> IO Bool rectangle :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> IO () rectangle dc left top right bottom = failIfFalse_ "Rectangle" $ c_Rectangle dc left top right bottom foreign import stdcall unsafe "windows.h Rectangle" c_Rectangle :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> IO Bool roundRect :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO () roundRect dc left top right bottom w h = failIfFalse_ "RoundRect" $ c_RoundRect dc left top right bottom w h foreign import stdcall unsafe "windows.h RoundRect" c_RoundRect :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO Bool ellipse :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> IO () ellipse dc left top right bottom = failIfFalse_ "Ellipse" $ c_Ellipse dc left top right bottom foreign import stdcall unsafe "windows.h Ellipse" c_Ellipse :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> IO Bool chord :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO () chord dc left top right bottom x1 y1 x2 y2 = failIfFalse_ "Chord" $ c_Chord dc left top right bottom x1 y1 x2 y2 foreign import stdcall unsafe "windows.h Chord" c_Chord :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO Bool pie :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO () pie dc left top right bottom x1 y1 x2 y2 = failIfFalse_ "Pie" $ c_Pie dc left top right bottom x1 y1 x2 y2 foreign import stdcall unsafe "windows.h Pie" c_Pie :: HDC -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO Bool ---------------------------------------------------------------- -- Bitmaps ---------------------------------------------------------------- bitBlt :: HDC -> INT -> INT -> INT -> INT -> HDC -> INT -> INT -> RasterOp3 -> IO () bitBlt dcDest xDest yDest w h dcSrc xSrc ySrc rop = failIfFalse_ "BitBlt" $ c_BitBlt dcDest xDest yDest w h dcSrc xSrc ySrc rop foreign import stdcall unsafe "windows.h BitBlt" c_BitBlt :: HDC -> INT -> INT -> INT -> INT -> HDC -> INT -> INT -> RasterOp3 -> IO Bool maskBlt :: HDC -> INT -> INT -> INT -> INT -> HDC -> INT -> INT -> HBITMAP -> INT -> INT -> RasterOp4 -> IO () maskBlt dcDest xDest yDest w h dcSrc xSrc ySrc bm xMask yMask rop = failIfFalse_ "MaskBlt" $ c_MaskBlt dcDest xDest yDest w h dcSrc xSrc ySrc bm xMask yMask rop foreign import stdcall unsafe "windows.h MaskBlt" c_MaskBlt :: HDC -> INT -> INT -> INT -> INT -> HDC -> INT -> INT -> HBITMAP -> INT -> INT -> RasterOp4 -> IO Bool stretchBlt :: HDC -> INT -> INT -> INT -> INT -> HDC -> INT -> INT -> INT -> INT -> RasterOp3 -> IO () stretchBlt dcDest xDest yDest wDest hDest hdcSrc xSrc ySrc wSrc hSrc rop = failIfFalse_ "StretchBlt" $ c_StretchBlt dcDest xDest yDest wDest hDest hdcSrc xSrc ySrc wSrc hSrc rop foreign import stdcall unsafe "windows.h StretchBlt" c_StretchBlt :: HDC -> INT -> INT -> INT -> INT -> HDC -> INT -> INT -> INT -> INT -> RasterOp3 -> IO Bool -- We deviate slightly from the Win32 interface -- %C typedef POINT ThreePts[3]; -- Old 2nd line: -- %start POINT vertices[3]; plgBlt :: HDC -> POINT -> POINT -> POINT -> HDC -> INT -> INT -> INT -> INT -> MbHBITMAP -> INT -> INT -> IO () plgBlt hdDest p1 p2 p3 hdSrc x y w h mb_bm xMask yMask = withPOINTArray [p1,p2,p3] $ \ vertices _ -> failIfFalse_ "PlgBlt" $ c_PlgBlt hdDest vertices hdSrc x y w h (maybePtr mb_bm) xMask yMask foreign import stdcall unsafe "windows.h PlgBlt" c_PlgBlt :: HDC -> Ptr POINT -> HDC -> INT -> INT -> INT -> INT -> HBITMAP -> INT -> INT -> IO Bool ---------------------------------------------------------------- -- Fonts and Text ---------------------------------------------------------------- textOut :: HDC -> INT -> INT -> String -> IO () textOut dc x y str = withTStringLen str $ \ (c_str, len) -> failIfFalse_ "TextOut" $ c_TextOut dc x y c_str len foreign import stdcall unsafe "windows.h TextOutW" c_TextOut :: HDC -> INT -> INT -> LPCTSTR -> Int -> IO Bool -- missing TabbedTextOut from WinFonts.ss; GSL ??? getTextExtentPoint32 :: HDC -> String -> IO SIZE getTextExtentPoint32 dc str = withTStringLen str $ \ (c_str, len) -> allocaSIZE $ \ p_size -> do failIfFalse_ "GetTextExtentPoint32" $ c_GetTextExtentPoint32 dc c_str len p_size peekSIZE p_size foreign import stdcall unsafe "windows.h GetTextExtentPoint32W" c_GetTextExtentPoint32 :: HDC -> LPCTSTR -> Int -> Ptr SIZE -> IO Bool -- missing getTabbedTextExtent from WinFonts.ss; GSL ??? -- missing SetTextJustification from WinFonts.ss; GSL ??? -- missing a whole family of techandfamily functionality; GSL ??? -- missing DrawText and DrawTextFormat in WinFonts.ss; GSL ??? ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Path.hs0000644006511100651110000000515510504340503021740 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Path -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Path ( beginPath, closeFigure, endPath, fillPath, flattenPath , pathToRegion, strokeAndFillPath, strokePath, widenPath ) where import Graphics.Win32.GDI.Types import System.Win32.Types ---------------------------------------------------------------- -- Paths ---------------------------------------------------------------- -- AbortPath :: HDC -> IO () beginPath :: HDC -> IO () beginPath dc = failIfFalse_ "BeginPath" $ c_BeginPath dc foreign import stdcall unsafe "windows.h BeginPath" c_BeginPath :: HDC -> IO Bool closeFigure :: HDC -> IO () closeFigure dc = failIfFalse_ "CloseFigure" $ c_CloseFigure dc foreign import stdcall unsafe "windows.h CloseFigure" c_CloseFigure :: HDC -> IO Bool endPath :: HDC -> IO () endPath dc = failIfFalse_ "EndPath" $ c_EndPath dc foreign import stdcall unsafe "windows.h EndPath" c_EndPath :: HDC -> IO Bool fillPath :: HDC -> IO () fillPath dc = failIfFalse_ "FillPath" $ c_FillPath dc foreign import stdcall unsafe "windows.h FillPath" c_FillPath :: HDC -> IO Bool flattenPath :: HDC -> IO () flattenPath dc = failIfFalse_ "FlattenPath" $ c_FlattenPath dc foreign import stdcall unsafe "windows.h FlattenPath" c_FlattenPath :: HDC -> IO Bool pathToRegion :: HDC -> IO HRGN pathToRegion dc = do ptr <- failIfNull "PathToRegion" $ c_PathToRegion dc newForeignHANDLE ptr foreign import stdcall unsafe "windows.h PathToRegion" c_PathToRegion :: HDC -> IO PRGN strokeAndFillPath :: HDC -> IO () strokeAndFillPath dc = failIfFalse_ "StrokeAndFillPath" $ c_StrokeAndFillPath dc foreign import stdcall unsafe "windows.h StrokeAndFillPath" c_StrokeAndFillPath :: HDC -> IO Bool strokePath :: HDC -> IO () strokePath dc = failIfFalse_ "StrokePath" $ c_StrokePath dc foreign import stdcall unsafe "windows.h StrokePath" c_StrokePath :: HDC -> IO Bool widenPath :: HDC -> IO () widenPath dc = failIfFalse_ "WidenPath" $ c_WidenPath dc foreign import stdcall unsafe "windows.h WidenPath" c_WidenPath :: HDC -> IO Bool ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Pen.hsc0000644006511100651110000000653310504340503021732 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Pen -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Pen where import System.Win32.Types import Graphics.Win32.GDI.Types #include ---------------------------------------------------------------- -- Stock Objects ---------------------------------------------------------------- type StockPen = INT #{enum StockPen, , wHITE_PEN = WHITE_PEN , bLACK_PEN = BLACK_PEN , nULL_PEN = NULL_PEN } getStockPen :: StockPen -> IO HPEN getStockPen stockpen = failIfNull "GetStockPen" $ c_GetStockPen stockpen foreign import stdcall unsafe "windows.h GetStockObject" c_GetStockPen :: StockPen -> IO HPEN deletePen :: HPEN -> IO () deletePen pen = failIfFalse_ "DeletePen" $ c_DeletePen pen foreign import stdcall unsafe "windows.h DeleteObject" c_DeletePen :: HPEN -> IO Bool ---------------------------------------------------------------- -- Creating pens ---------------------------------------------------------------- type PenStyle = INT #{enum PenStyle, // Pick one of these , pS_SOLID = PS_SOLID // default , pS_DASH = PS_DASH // ------- , pS_DOT = PS_DOT // ....... , pS_DASHDOT = PS_DASHDOT // _._._._ , pS_DASHDOTDOT = PS_DASHDOTDOT // _.._.._ , pS_NULL = PS_NULL , pS_INSIDEFRAME = PS_INSIDEFRAME , pS_USERSTYLE = PS_USERSTYLE , pS_ALTERNATE = PS_ALTERNATE , pS_STYLE_MASK = PS_STYLE_MASK // all the above } #{enum PenStyle , // "or" with one of these , pS_ENDCAP_ROUND = PS_ENDCAP_ROUND // default , pS_ENDCAP_SQUARE = PS_ENDCAP_SQUARE , pS_ENDCAP_FLAT = PS_ENDCAP_FLAT , pS_ENDCAP_MASK = PS_ENDCAP_MASK // all the above } #{enum PenStyle, // "or" with one of these , pS_JOIN_ROUND = PS_JOIN_ROUND // default , pS_JOIN_BEVEL = PS_JOIN_BEVEL , pS_JOIN_MITER = PS_JOIN_MITER } -- , pS_JOIN_MASK = PS_JOIN_MASK {- If PS_JOIN_MASK is not defined with your GNU Windows32 header files, you'll have to define it. -} #{enum PenStyle, // "or" with one of these , pS_COSMETIC = PS_COSMETIC // default , pS_GEOMETRIC = PS_GEOMETRIC , pS_TYPE_MASK = PS_TYPE_MASK // all the above } createPen :: PenStyle -> INT -> COLORREF -> IO HPEN createPen style n color = failIfNull "CreatePen" $ c_CreatePen style n color foreign import stdcall unsafe "windows.h CreatePen" c_CreatePen :: PenStyle -> INT -> COLORREF -> IO HPEN -- Not very well supported on Win'95 -- %fun NullHANDLE ExtCreatePen :: PenStyle -> INT -> LOGBRUSH -> [StyleBit] -> IO HPEN -- ToDo: CreatePenIndirect ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Region.hs0000644006511100651110000001246710504340503022273 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Region -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Region where import System.Win32.Types import Graphics.Win32.GDI.Types import Foreign ---------------------------------------------------------------- -- Regions ---------------------------------------------------------------- badRegion :: RegionType -> Bool badRegion n = n == 0 || n == gDI_ERROR combineRgn :: HRGN -> HRGN -> HRGN -> ClippingMode -> IO RegionType combineRgn dest src1 src2 mode = withForeignPtr dest $ \ p_dest -> withForeignPtr src1 $ \ p_src1 -> withForeignPtr src2 $ \ p_src2 -> failIf badRegion "CombineRgn" $ c_CombineRgn p_dest p_src1 p_src2 mode foreign import stdcall unsafe "windows.h CombineRgn" c_CombineRgn :: PRGN -> PRGN -> PRGN -> ClippingMode -> IO RegionType offsetRgn :: HRGN -> INT -> INT -> IO RegionType offsetRgn rgn xoff yoff = withForeignPtr rgn $ \ p_rgn -> failIf badRegion "OffsetRgn" $ c_OffsetRgn p_rgn xoff yoff foreign import stdcall unsafe "windows.h OffsetRgn" c_OffsetRgn :: PRGN -> INT -> INT -> IO RegionType getRgnBox :: HRGN -> LPRECT -> IO RegionType getRgnBox rgn p_rect = withForeignPtr rgn $ \ p_rgn -> failIf badRegion "GetRgnBox" $ c_GetRgnBox p_rgn p_rect foreign import stdcall unsafe "windows.h GetRgnBox" c_GetRgnBox :: PRGN -> LPRECT -> IO RegionType createEllipticRgn :: INT -> INT -> INT -> INT -> IO HRGN createEllipticRgn x0 y0 x1 y1 = do ptr <- failIfNull "CreateEllipticRgn" $ c_CreateEllipticRgn x0 y0 x1 y1 newForeignHANDLE ptr foreign import stdcall unsafe "windows.h CreateEllipticRgn" c_CreateEllipticRgn :: INT -> INT -> INT -> INT -> IO PRGN createEllipticRgnIndirect :: LPRECT -> IO HRGN createEllipticRgnIndirect rp = do ptr <- failIfNull "CreateEllipticRgnIndirect" $ c_CreateEllipticRgnIndirect rp newForeignHANDLE ptr foreign import stdcall unsafe "windows.h CreateEllipticRgnIndirect" c_CreateEllipticRgnIndirect :: LPRECT -> IO PRGN createRectRgn :: INT -> INT -> INT -> INT -> IO HRGN createRectRgn x0 y0 x1 y1 = do ptr <- failIfNull "CreateRectRgn" $ c_CreateRectRgn x0 y0 x1 y1 newForeignHANDLE ptr foreign import stdcall unsafe "windows.h CreateRectRgn" c_CreateRectRgn :: INT -> INT -> INT -> INT -> IO PRGN createRectRgnIndirect :: LPRECT -> IO HRGN createRectRgnIndirect rp = do ptr <- failIfNull "CreateRectRgnIndirect" $ c_CreateRectRgnIndirect rp newForeignHANDLE ptr foreign import stdcall unsafe "windows.h CreateRectRgnIndirect" c_CreateRectRgnIndirect :: LPRECT -> IO PRGN createRoundRectRgn :: INT -> INT -> INT -> INT -> INT -> INT -> IO HRGN createRoundRectRgn x0 y0 x1 y1 h w = do ptr <- failIfNull "CreateRoundRectRgn" $ c_CreateRoundRectRgn x0 y0 x1 y1 h w newForeignHANDLE ptr foreign import stdcall unsafe "windows.h CreateRoundRectRgn" c_CreateRoundRectRgn :: INT -> INT -> INT -> INT -> INT -> INT -> IO PRGN createPolygonRgn :: [POINT] -> PolyFillMode -> IO HRGN createPolygonRgn ps mode = withPOINTArray ps $ \ point_array npoints -> do ptr <- failIfNull "CreatePolygonRgn" $ c_CreatePolygonRgn point_array npoints mode newForeignHANDLE ptr foreign import stdcall unsafe "windows.h CreatePolygonRgn" c_CreatePolygonRgn :: Ptr POINT -> Int -> PolyFillMode -> IO PRGN -- Needs to do proper error test for EqualRgn; GSL ??? foreign import stdcall unsafe "windows.h EqualRgn" equalRgn :: PRGN -> PRGN -> IO Bool fillRgn :: HDC -> HRGN -> HBRUSH -> IO () fillRgn dc rgn brush = withForeignPtr rgn $ \ p_rgn -> failIfFalse_ "FillRgn" $ c_FillRgn dc p_rgn brush foreign import stdcall unsafe "windows.h FillRgn" c_FillRgn :: HDC -> PRGN -> HBRUSH -> IO Bool invertRgn :: HDC -> HRGN -> IO () invertRgn dc rgn = withForeignPtr rgn $ \ p_rgn -> failIfFalse_ "InvertRgn" $ c_InvertRgn dc p_rgn foreign import stdcall unsafe "windows.h InvertRgn" c_InvertRgn :: HDC -> PRGN -> IO Bool paintRgn :: HDC -> HRGN -> IO () paintRgn dc rgn = withForeignPtr rgn $ \ p_rgn -> failIfFalse_ "PaintRgn" $ c_PaintRgn dc p_rgn foreign import stdcall unsafe "windows.h PaintRgn" c_PaintRgn :: HDC -> PRGN -> IO Bool frameRgn :: HDC -> HRGN -> HBRUSH -> Int -> Int -> IO () frameRgn dc rgn brush w h = withForeignPtr rgn $ \ p_rgn -> failIfFalse_ "FrameRgn" $ c_FrameRgn dc p_rgn brush w h foreign import stdcall unsafe "windows.h FrameRgn" c_FrameRgn :: HDC -> PRGN -> HBRUSH -> Int -> Int -> IO Bool ptInRegion :: HRGN -> Int -> Int -> IO Bool ptInRegion rgn x y = withForeignPtr rgn $ \ p_rgn -> c_PtInRegion p_rgn x y foreign import stdcall unsafe "windows.h PtInRegion" c_PtInRegion :: PRGN -> Int -> Int -> IO Bool rectInRegion :: HRGN -> RECT -> IO Bool rectInRegion rgn rect = withForeignPtr rgn $ \ p_rgn -> withRECT rect $ c_RectInRegion p_rgn foreign import stdcall unsafe "windows.h RectInRegion" c_RectInRegion :: PRGN -> Ptr RECT -> IO Bool ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI/Types.hsc0000644006511100651110000002264610504340503022317 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI.Types -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI.Types {- -- still incomplete ( POINT, marshall_point, unmarshall_point , ListPOINT, marshall_ListPOINT_ , ListLenPOINT, marshall_ListLenPOINT_ , RECT, marshall_rect, unmarshall_rect , SIZE, marshall_size, unmarshall_size , nullPtr , HBITMAP , MbHBITMAP , HFONT , MbHFONT , HCURSOR , MbHCURSOR , HICON , MbHICON , HRGN , MbHRGN , PRGN , HPALETTE , MbHPALETTE , HBRUSH , MbHBRUSH , HPEN , MbHPEN , HACCEL --, MbHACCEL , HDC , MbHDC , HDWP , MbHDWP , HWND , MbHWND , HMENU , MbHMENU , PolyFillMode , ArcDirection , MbArcDirection , GraphicsMode , MbGraphicsMode , BackgroundMode , HatchStyle , StretchBltMode , COLORREF , TextAlignment , ClippingMode , RegionType , gDI_ERROR ) -} where import System.Win32.Types import Control.Monad( zipWithM_ ) import Foreign #include {-# CFILES cbits/HsGDI.c #-} ---------------------------------------------------------------- -- ---------------------------------------------------------------- type POINT = ( LONG -- x , LONG -- y ) sizeofPOINT :: Int sizeofPOINT = #{size POINT} allocaPOINT :: (Ptr POINT -> IO a) -> IO a allocaPOINT = allocaBytes sizeofPOINT peekPOINT :: Ptr POINT -> IO POINT peekPOINT p = do x <- #{peek POINT,x} p y <- #{peek POINT,y} p return (x,y) pokePOINT :: Ptr POINT -> POINT -> IO () pokePOINT p (x,y) = do #{poke POINT,x} p x #{poke POINT,y} p y withPOINT :: POINT -> (Ptr POINT -> IO a) -> IO a withPOINT p f = allocaPOINT $ \ ptr -> do pokePOINT ptr p f ptr type RECT = ( LONG -- left , LONG -- top , LONG -- right , LONG -- bottom ) allocaRECT :: (Ptr RECT -> IO a) -> IO a allocaRECT = allocaBytes (#{size RECT}) peekRECT :: Ptr RECT -> IO RECT peekRECT p = do left <- #{peek RECT,left} p top <- #{peek RECT,top} p right <- #{peek RECT,right} p bottom <- #{peek RECT,bottom} p return (left, top, right, bottom) pokeRECT :: Ptr RECT -> RECT -> IO () pokeRECT p (left, top, right, bottom) = do #{poke RECT,left} p left #{poke RECT,top} p top #{poke RECT,right} p right #{poke RECT,bottom} p bottom type SIZE = ( LONG -- cx , LONG -- cy ) allocaSIZE :: (Ptr SIZE -> IO a) -> IO a allocaSIZE = allocaBytes (#{size SIZE}) peekSIZE :: Ptr SIZE -> IO SIZE peekSIZE p = do cx <- #{peek SIZE,cx} p cy <- #{peek SIZE,cy} p return (cx,cy) pokeSIZE :: Ptr SIZE -> SIZE -> IO () pokeSIZE p (cx,cy) = do #{poke SIZE,cx} p cx #{poke SIZE,cy} p cy ---------------------------------------------------------------- withPOINTArray :: [POINT] -> (Ptr POINT -> Int -> IO a) -> IO a withPOINTArray xs f = allocaBytes (sizeofPOINT * len) $ \ ptr -> do pokePOINTArray ptr xs f ptr len where len = length xs pokePOINTArray :: Ptr POINT -> [POINT] -> IO () pokePOINTArray ptr xs = zipWithM_ (setPOINT ptr) [0..] xs setPOINT :: Ptr POINT -> Int -> POINT -> IO () setPOINT ptr off = pokePOINT (ptr `plusPtr` (off*sizeofPOINT)) type LPRECT = Ptr RECT type MbLPRECT = Maybe LPRECT withRECT :: RECT -> (Ptr RECT -> IO a) -> IO a withRECT r f = allocaRECT $ \ ptr -> do pokeRECT ptr r f ptr getRECT :: LPRECT -> IO RECT getRECT = peekRECT ---------------------------------------------------------------- -- (GDI related) Handles ---------------------------------------------------------------- type HBITMAP = HANDLE type MbHBITMAP = Maybe HBITMAP type HFONT = HANDLE type MbHFONT = Maybe HFONT type HCURSOR = HICON type MbHCURSOR = Maybe HCURSOR type HICON = HANDLE type MbHICON = Maybe HICON -- This is not the only handle / resource that should be -- finalised for you, but it's a start. -- ToDo. type HRGN = ForeignHANDLE type PRGN = HANDLE type MbHRGN = Maybe HRGN type HPALETTE = HANDLE type MbHPALETTE = Maybe HPALETTE type HBRUSH = HANDLE type MbHBRUSH = Maybe HBRUSH type HPEN = HANDLE type MbHPEN = Maybe HPEN type HACCEL = HANDLE type HDC = HANDLE type MbHDC = Maybe HDC type HDWP = HANDLE type MbHDWP = Maybe HDWP type HWND = HANDLE type MbHWND = Maybe HWND #{enum HWND, castUINTToPtr , hWND_BOTTOM = HWND_BOTTOM , hWND_NOTOPMOST = HWND_NOTOPMOST , hWND_TOP = HWND_TOP , hWND_TOPMOST = HWND_TOPMOST } type HMENU = HANDLE type MbHMENU = Maybe HMENU ---------------------------------------------------------------- -- COLORREF ---------------------------------------------------------------- type COLORREF = #{type COLORREF} foreign import ccall unsafe "HsGDI.h" rgb :: BYTE -> BYTE -> BYTE -> COLORREF foreign import ccall unsafe "HsGDI.h" getRValue :: COLORREF -> BYTE foreign import ccall unsafe "HsGDI.h" getGValue :: COLORREF -> BYTE foreign import ccall unsafe "HsGDI.h" getBValue :: COLORREF -> BYTE foreign import ccall unsafe "HsGDI.h" pALETTERGB :: BYTE -> BYTE -> BYTE -> COLORREF foreign import ccall unsafe "HsGDI.h" pALETTEINDEX :: WORD -> COLORREF ---------------------------------------------------------------- -- RasterOp macro ---------------------------------------------------------------- type RasterOp3 = Word32 type RasterOp4 = Word32 foreign import ccall unsafe "HsGDI.h" mAKEROP4 :: RasterOp3 -> RasterOp3 -> RasterOp4 ---------------------------------------------------------------- -- Miscellaneous enumerations ---------------------------------------------------------------- type PolyFillMode = INT #{enum PolyFillMode, , aLTERNATE = ALTERNATE , wINDING = WINDING } ---------------------------------------------------------------- type ArcDirection = INT type MbArcDirection = Maybe ArcDirection #{enum ArcDirection, , aD_COUNTERCLOCKWISE = AD_COUNTERCLOCKWISE , aD_CLOCKWISE = AD_CLOCKWISE } ---------------------------------------------------------------- type GraphicsMode = DWORD type MbGraphicsMode = Maybe GraphicsMode #{enum GraphicsMode, , gM_COMPATIBLE = GM_COMPATIBLE , gM_ADVANCED = GM_ADVANCED } ---------------------------------------------------------------- type BackgroundMode = INT #{enum BackgroundMode, , tRANSPARENT = TRANSPARENT , oPAQUE = OPAQUE } ---------------------------------------------------------------- type HatchStyle = INT #{enum HatchStyle, , hS_HORIZONTAL = HS_HORIZONTAL , hS_VERTICAL = HS_VERTICAL , hS_FDIAGONAL = HS_FDIAGONAL , hS_BDIAGONAL = HS_BDIAGONAL , hS_CROSS = HS_CROSS , hS_DIAGCROSS = HS_DIAGCROSS } ---------------------------------------------------------------- type StretchBltMode = INT #{enum StretchBltMode, , bLACKONWHITE = BLACKONWHITE , wHITEONBLACK = WHITEONBLACK , cOLORONCOLOR = COLORONCOLOR , hALFTONE = HALFTONE , sTRETCH_ANDSCANS = STRETCH_ANDSCANS , sTRETCH_ORSCANS = STRETCH_ORSCANS , sTRETCH_DELETESCANS = STRETCH_DELETESCANS } ---------------------------------------------------------------- type TextAlignment = UINT #{enum TextAlignment, , tA_NOUPDATECP = TA_NOUPDATECP , tA_UPDATECP = TA_UPDATECP , tA_LEFT = TA_LEFT , tA_RIGHT = TA_RIGHT , tA_CENTER = TA_CENTER , tA_TOP = TA_TOP , tA_BOTTOM = TA_BOTTOM , tA_BASELINE = TA_BASELINE } ---------------------------------------------------------------- type ClippingMode = INT #{enum ClippingMode, , rGN_AND = RGN_AND , rGN_OR = RGN_OR , rGN_XOR = RGN_XOR , rGN_DIFF = RGN_DIFF , rGN_COPY = RGN_COPY } ---------------------------------------------------------------- type RegionType = INT #{enum RegionType, , eRROR = ERROR , nULLREGION = NULLREGION , sIMPLEREGION = SIMPLEREGION , cOMPLEXREGION = COMPLEXREGION } gDI_ERROR :: Num a => a gDI_ERROR = #{const GDI_ERROR} cLR_INVALID :: COLORREF cLR_INVALID = #{const CLR_INVALID} ---------------------------------------------------------------- #{enum UINT, , oBJ_PEN = OBJ_PEN , oBJ_BRUSH = OBJ_BRUSH , oBJ_DC = OBJ_DC , oBJ_METADC = OBJ_METADC , oBJ_PAL = OBJ_PAL , oBJ_FONT = OBJ_FONT , oBJ_BITMAP = OBJ_BITMAP , oBJ_REGION = OBJ_REGION , oBJ_METAFILE = OBJ_METAFILE , oBJ_MEMDC = OBJ_MEMDC , oBJ_EXTPEN = OBJ_EXTPEN , oBJ_ENHMETADC = OBJ_ENHMETADC , oBJ_ENHMETAFILE = OBJ_ENHMETAFILE } ---------------------------------------------------------------- -- Miscellaneous primitives ---------------------------------------------------------------- -- Can't pass structs with current FFI, so use C wrappers foreign import ccall unsafe "HsGDI.h" prim_ChildWindowFromPoint :: HWND -> Ptr POINT -> IO HWND foreign import ccall unsafe "HsGDI.h" prim_ChildWindowFromPointEx :: HWND -> Ptr POINT -> DWORD -> IO HWND foreign import ccall unsafe "HsGDI.h" prim_MenuItemFromPoint :: HWND -> HMENU -> Ptr POINT -> IO UINT ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/Control.hsc0000644006511100651110000002533610504340503022227 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Control -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- FFI bindings to the various standard Win32 controls. -- ----------------------------------------------------------------------------- module Graphics.Win32.Control where import Graphics.Win32.GDI.Types import Graphics.Win32.Window import System.Win32.Types import Graphics.Win32.Message import Foreign #include #include -- == Command buttons type ButtonStyle = WindowStyle #{enum ButtonStyle, , bS_PUSHBUTTON = BS_PUSHBUTTON , bS_DEFPUSHBUTTON = BS_DEFPUSHBUTTON , bS_CHECKBOX = BS_CHECKBOX , bS_AUTOCHECKBOX = BS_AUTOCHECKBOX , bS_RADIOBUTTON = BS_RADIOBUTTON , bS_3STATE = BS_3STATE , bS_AUTO3STATE = BS_AUTO3STATE , bS_GROUPBOX = BS_GROUPBOX , bS_AUTORADIOBUTTON = BS_AUTORADIOBUTTON , bS_OWNERDRAW = BS_OWNERDRAW , bS_LEFTTEXT = BS_LEFTTEXT , bS_USERBUTTON = BS_USERBUTTON } createButton :: String -> WindowStyle -> ButtonStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe HWND -> Maybe HMENU -> HANDLE -> IO HWND createButton nm wstyle bstyle mb_x mb_y mb_w mb_h mb_parent mb_menu h = withTString nm $ \ c_nm -> failIfNull "CreateButton" $ c_CreateWindowEx 0 buttonStyle c_nm (wstyle .|. bstyle) (maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h) (maybePtr mb_parent) (maybePtr mb_menu) h nullPtr buttonStyle :: ClassName buttonStyle = unsafePerformIO (newTString "BUTTON") type ButtonState = UINT #{enum ButtonState, , bST_CHECKED = BST_CHECKED , bST_INDETERMINATE = BST_INDETERMINATE , bST_UNCHECKED = BST_UNCHECKED } checkDlgButton :: HWND -> Int -> ButtonState -> IO () checkDlgButton dialog button check = failIfFalse_ "CheckDlgButton" $ c_CheckDlgButton dialog button check foreign import stdcall unsafe "windows.h CheckDlgButton" c_CheckDlgButton :: HWND -> Int -> ButtonState -> IO Bool checkRadioButton :: HWND -> Int -> Int -> Int -> IO () checkRadioButton dialog first_button last_button check = failIfFalse_ "CheckRadioButton" $ c_CheckRadioButton dialog first_button last_button check foreign import stdcall unsafe "windows.h CheckRadioButton" c_CheckRadioButton :: HWND -> Int -> Int -> Int -> IO Bool isDlgButtonChecked :: HWND -> Int -> IO ButtonState isDlgButtonChecked wnd button = failIfZero "IsDlgButtonChecked" $ c_IsDlgButtonChecked wnd button foreign import stdcall unsafe "windows.h IsDlgButtonChecked" c_IsDlgButtonChecked :: HWND -> Int -> IO ButtonState -- == ComboBoxes aka. pop up list boxes/selectors. type ComboBoxStyle = WindowStyle #{enum ComboBoxStyle, , cBS_SIMPLE = CBS_SIMPLE , cBS_DROPDOWN = CBS_DROPDOWN , cBS_DROPDOWNLIST = CBS_DROPDOWNLIST , cBS_OWNERDRAWFIXED = CBS_OWNERDRAWFIXED , cBS_OWNERDRAWVARIABLE = CBS_OWNERDRAWVARIABLE , cBS_AUTOHSCROLL = CBS_AUTOHSCROLL , cBS_OEMCONVERT = CBS_OEMCONVERT , cBS_SORT = CBS_SORT , cBS_HASSTRINGS = CBS_HASSTRINGS , cBS_NOINTEGRALHEIGHT = CBS_NOINTEGRALHEIGHT , cBS_DISABLENOSCROLL = CBS_DISABLENOSCROLL } createComboBox :: String -> WindowStyle -> ComboBoxStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> HWND -> Maybe HMENU -> HANDLE -> IO HWND createComboBox nm wstyle cstyle mb_x mb_y mb_w mb_h parent mb_menu h = withTString nm $ \ c_nm -> failIfNull "CreateComboBox" $ c_CreateWindowEx 0 comboBoxStyle c_nm (wstyle .|. cstyle) (maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h) parent (maybePtr mb_menu) h nullPtr comboBoxStyle :: ClassName comboBoxStyle = unsafePerformIO (newTString "COMBOBOX") -- see comment about freeing windowNames in System.Win32.Window.createWindow -- %end free(nm) --- == Edit controls ---------------------------------------------------------------- type EditStyle = WindowStyle #{enum EditStyle, , eS_LEFT = ES_LEFT , eS_CENTER = ES_CENTER , eS_RIGHT = ES_RIGHT , eS_MULTILINE = ES_MULTILINE , eS_UPPERCASE = ES_UPPERCASE , eS_LOWERCASE = ES_LOWERCASE , eS_PASSWORD = ES_PASSWORD , eS_AUTOVSCROLL = ES_AUTOVSCROLL , eS_AUTOHSCROLL = ES_AUTOHSCROLL , eS_NOHIDESEL = ES_NOHIDESEL , eS_OEMCONVERT = ES_OEMCONVERT , eS_READONLY = ES_READONLY , eS_WANTRETURN = ES_WANTRETURN } createEditWindow :: String -> WindowStyle -> EditStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> HWND -> Maybe HMENU -> HANDLE -> IO HWND createEditWindow nm wstyle estyle mb_x mb_y mb_w mb_h parent mb_menu h = withTString nm $ \ c_nm -> failIfNull "CreateEditWindow" $ c_CreateWindowEx 0 editStyle c_nm (wstyle .|. estyle) (maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h) parent (maybePtr mb_menu) h nullPtr editStyle :: ClassName editStyle = unsafePerformIO (newTString "EDIT") -- see comment about freeing windowNames in System.Win32.Window.createWindow -- %end free(nm) -- == List boxes ---------------------------------------------------------------- type ListBoxStyle = WindowStyle #{enum ListBoxStyle, , lBS_NOTIFY = LBS_NOTIFY , lBS_SORT = LBS_SORT , lBS_NOREDRAW = LBS_NOREDRAW , lBS_MULTIPLESEL = LBS_MULTIPLESEL , lBS_OWNERDRAWFIXED = LBS_OWNERDRAWFIXED , lBS_OWNERDRAWVARIABLE = LBS_OWNERDRAWVARIABLE , lBS_HASSTRINGS = LBS_HASSTRINGS , lBS_USETABSTOPS = LBS_USETABSTOPS , lBS_NOINTEGRALHEIGHT = LBS_NOINTEGRALHEIGHT , lBS_MULTICOLUMN = LBS_MULTICOLUMN , lBS_WANTKEYBOARDINPUT = LBS_WANTKEYBOARDINPUT , lBS_DISABLENOSCROLL = LBS_DISABLENOSCROLL , lBS_STANDARD = LBS_STANDARD } createListBox :: String -> WindowStyle -> ListBoxStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> HWND -> Maybe HMENU -> HANDLE -> IO HWND createListBox nm wstyle lstyle mb_x mb_y mb_w mb_h parent mb_menu h = withTString nm $ \ c_nm -> failIfNull "CreateListBox" $ c_CreateWindowEx 0 listBoxStyle c_nm (wstyle .|. lstyle) (maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h) parent (maybePtr mb_menu) h nullPtr listBoxStyle :: ClassName listBoxStyle = unsafePerformIO (newTString "LISTBOX") -- see comment about freeing windowNames in System.Win32.Window.createWindow -- %end free(nm) -- == Scrollbars ---------------------------------------------------------------- type ScrollbarStyle = WindowStyle #{enum ScrollbarStyle, , sBS_HORZ = SBS_HORZ , sBS_TOPALIGN = SBS_TOPALIGN , sBS_BOTTOMALIGN = SBS_BOTTOMALIGN , sBS_VERT = SBS_VERT , sBS_LEFTALIGN = SBS_LEFTALIGN , sBS_RIGHTALIGN = SBS_RIGHTALIGN , sBS_SIZEBOX = SBS_SIZEBOX , sBS_SIZEBOXTOPLEFTALIGN = SBS_SIZEBOXTOPLEFTALIGN , sBS_SIZEBOXBOTTOMRIGHTALIGN = SBS_SIZEBOXBOTTOMRIGHTALIGN } createScrollbar :: String -> WindowStyle -> ScrollbarStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> HWND -> Maybe HMENU -> HANDLE -> IO HWND createScrollbar nm wstyle sstyle mb_x mb_y mb_w mb_h parent mb_menu h = withTString nm $ \ c_nm -> failIfNull "CreateScrollbar" $ c_CreateWindowEx 0 scrollBarStyle c_nm (wstyle .|. sstyle) (maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h) parent (maybePtr mb_menu) h nullPtr scrollBarStyle :: ClassName scrollBarStyle = unsafePerformIO (newTString "SCROLLBAR") -- see comment about freeing windowNames in System.Win32.Window.createWindow -- %end free(nm) -- == Static controls aka. labels ---------------------------------------------------------------- type StaticControlStyle = WindowStyle #{enum StaticControlStyle, , sS_LEFT = SS_LEFT , sS_CENTER = SS_CENTER , sS_RIGHT = SS_RIGHT , sS_ICON = SS_ICON , sS_BLACKRECT = SS_BLACKRECT , sS_GRAYRECT = SS_GRAYRECT , sS_WHITERECT = SS_WHITERECT , sS_BLACKFRAME = SS_BLACKFRAME , sS_GRAYFRAME = SS_GRAYFRAME , sS_WHITEFRAME = SS_WHITEFRAME , sS_SIMPLE = SS_SIMPLE , sS_LEFTNOWORDWRAP = SS_LEFTNOWORDWRAP , sS_NOPREFIX = SS_NOPREFIX } createStaticWindow :: String -> WindowStyle -> StaticControlStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> HWND -> Maybe HMENU -> HANDLE -> IO HWND createStaticWindow nm wstyle sstyle mb_x mb_y mb_w mb_h parent mb_menu h = withTString nm $ \ c_nm -> failIfNull "CreateStaticWindow" $ c_CreateWindowEx 0 staticStyle c_nm (wstyle .|. sstyle) (maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h) parent (maybePtr mb_menu) h nullPtr staticStyle :: ClassName staticStyle = unsafePerformIO (newTString "STATIC") -- see comment about freeing windowNames in System.Win32.Window.createWindow -- %end free(nm) #if 0 UNTESTED - leave out type CommonControl = Ptr () #{enum CommonControl, , toolTipsControl = TOOLTIPS_CLASS , trackBarControl = TRACKBAR_CLASS , upDownControl = UPDOWN_CLASS , progressBarControl = PROGRESS_CLASS , hotKeyControl = HOTKEY_CLASS , animateControl = ANIMATE_CLASS , statusControl = STATUSCLASSNAME , headerControl = WC_HEADER , listViewControl = WC_LISTVIEW , tabControl = WC_TABCONTROL , treeViewControl = WC_TREEVIEW , monthCalControl = MONTHCAL_CLASS , dateTimePickControl = DATETIMEPICK_CLASS , reBarControl = REBARCLASSNAME } -- Not supplied in mingw-20001111 -- , comboBoxExControl = WC_COMBOBOXEX -- , iPAddressControl = WC_IPADDRESS -- , pageScrollerControl = WC_PAGESCROLLER createCommonControl :: CommonControl -> WindowStyle -> String -> WindowStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe HWND -> Maybe HMENU -> HANDLE -> IO HWND createCommonControl c estyle nm wstyle mb_x mb_y mb_w mb_h mb_parent mb_menu h = withTString nm $ \ c_nm -> do failIfNull "CreateCommonControl" $ c_CreateWindowEx c estyle c_nm wstyle (maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h) (maybePtr mb_parent) (maybePtr mb_menu) h nullPtr foreign import stdcall unsafe "windows.h InitCommonControls" initCommonControls :: IO () #endif #{enum WindowMessage, , pBM_DELTAPOS = PBM_DELTAPOS , pBM_SETPOS = PBM_SETPOS , pBM_SETRANGE = PBM_SETRANGE , pBM_SETSTEP = PBM_SETSTEP , pBM_STEPIT = PBM_STEPIT } -- % , PBM_GETRANGE -- % , PBM_GETPOS -- % , PBM_SETBARCOLOR -- % , PBM_SETBKCOLOR -- % , PBM_SETRANGE32 hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/Dialogue.hsc0000644006511100651110000002731110504340503022333 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Dialogue -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Dialogue where import Graphics.Win32.GDI.Types import Graphics.Win32.Control import Graphics.Win32.Message import Graphics.Win32.Window import System.Win32.Types import Foreign import Foreign.C #include type DTemplate = LPCTSTR type DTemplateMem = Ptr Stub_DTM newtype Stub_DTM = Stub_DTM DTemplateMem newtype DIA_TEMPLATE = DIA_TEMPLATE (Ptr DIA_TEMPLATE) type DialogStyle = WindowStyle mkDialogTemplate :: String -> IO DTemplate mkDialogTemplate = newTString type ResourceID = Int mkResource :: ResourceID -> IO (Ptr a) mkResource res = return (castUINTToPtr (fromIntegral res)) mkDialogTemplateFromResource :: Int -> IO DTemplate mkDialogTemplateFromResource = mkResource type DialogProc = HWND -> WindowMessage -> WPARAM -> LPARAM -> IO Int marshall_dialogProc_ :: DialogProc -> IO (FunPtr DialogProc) marshall_dialogProc_ cl = mkDialogClosure cl -- ToDo: this was declared as a stdcall not a ccall - let's -- hope and pray that it makes no difference - ADR foreign import ccall "wrapper" mkDialogClosure :: DialogProc -> IO (FunPtr DialogProc) dialogBox :: HINSTANCE -> DTemplate -> Maybe HWND -> DialogProc -> IO Int dialogBox inst template mb_parent dia_fn = dialogBoxParam inst template mb_parent dia_fn 0 dialogBoxParam :: HINSTANCE -> DTemplate -> Maybe HWND -> DialogProc -> LPARAM -> IO Int dialogBoxParam inst template mb_parent dia_fn init_val = do c_dia_fn <- mkDialogClosure dia_fn failIf (== -1) "DialogBoxParam" $ c_DialogBoxParam inst template (maybePtr mb_parent) c_dia_fn init_val foreign import stdcall "windows.h DialogBoxParamW" c_DialogBoxParam :: HINSTANCE -> DTemplate -> HWND -> FunPtr DialogProc -> LPARAM -> IO Int dialogBoxIndirect :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> IO Int dialogBoxIndirect inst template mb_parent dia_fn = dialogBoxIndirectParam inst template mb_parent dia_fn 0 dialogBoxIndirectParam :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> LPARAM -> IO Int dialogBoxIndirectParam inst template mb_parent dia_fn init_val = do c_dia_fn <- mkDialogClosure dia_fn failIf (== -1) "DialogBoxIndirectParam" $ c_DialogBoxIndirectParam inst template (maybePtr mb_parent) c_dia_fn init_val foreign import stdcall "windows.h DialogBoxIndirectParamW" c_DialogBoxIndirectParam :: HINSTANCE -> DTemplateMem -> HWND -> FunPtr DialogProc -> LPARAM -> IO Int data DialogTemplate = DialogTemplate Int Int Int Int -- x, y, cx, cy WindowStyle DWORD (Either ResourceID String) -- menu (Either ResourceID String) -- class (Either ResourceID String) -- caption (Either ResourceID String) -- fontname Int -- font height [DialogControl] data DialogControl = DialogControl Int Int Int Int -- x,y, cx, cy (Either ResourceID String) -- text (Either ResourceID String) -- classname WindowStyle DWORD Int -- dia_id mkDialogFromTemplate :: DialogTemplate -> IO DTemplateMem mkDialogFromTemplate (DialogTemplate x y cx cy wstyle extstyle mb_menu mb_class caption font font_height controls) = do prim_hmenu <- marshall_res mb_menu prim_class <- marshall_res mb_class prim_caption <- marshall_res caption prim_font <- marshall_res font dtemp <- mkDiaTemplate 0 x y cx cy wstyle extstyle prim_hmenu prim_class prim_caption prim_font font_height mapM_ (addControl dtemp) controls getFinalDialog dtemp pushButtonControl :: Int -> Int -> Int -> Int -> DWORD -> DWORD -> Int -> String -> DialogControl pushButtonControl x y cx cy style estyle dia_id lab = DialogControl x y cx cy (Left 0x0080) (Right lab) (style + bS_DEFPUSHBUTTON) estyle dia_id labelControl :: Int -> Int -> Int -> Int -> DWORD -> DWORD -> Int -> String -> DialogControl labelControl x y cx cy style estyle dia_id lab = DialogControl x y cx cy (Left 0x0082) (Right lab) (style + sS_LEFT) estyle dia_id listBoxControl :: Int -> Int -> Int -> Int -> DWORD -> DWORD -> Int -> String -> DialogControl listBoxControl x y cx cy style estyle dia_id lab = DialogControl x y cx cy (Left 0x0083) (Right lab) (style) estyle dia_id comboBoxControl :: Int -> Int -> Int -> Int -> DWORD -> DWORD -> Int -> String -> DialogControl comboBoxControl x y cx cy style estyle dia_id lab = DialogControl x y cx cy (Left 0x0085) (Right lab) (style) estyle dia_id editControl :: Int -> Int -> Int -> Int -> DWORD -> DWORD -> Int -> String -> DialogControl editControl x y cx cy style estyle dia_id lab = DialogControl x y cx cy (Left 0x0081) (Right lab) (style + eS_LEFT) estyle dia_id scrollBarControl :: Int -> Int -> Int -> Int -> DWORD -> DWORD -> Int -> String -> DialogControl scrollBarControl x y cx cy style estyle dia_id lab = DialogControl x y cx cy (Left 0x0084) (Right lab) (style) estyle dia_id foreign import ccall unsafe "diatemp.h getFinalDialog" getFinalDialog :: Ptr DIA_TEMPLATE -> IO DTemplateMem foreign import ccall unsafe "diatemp.h mkDiaTemplate" mkDiaTemplate :: Int -> Int -> Int -> Int -> Int -> WindowStyle -> DWORD -> LPCWSTR -> LPCWSTR -> LPCWSTR -> LPCWSTR -> Int -> IO (Ptr DIA_TEMPLATE) addControl :: Ptr DIA_TEMPLATE -> DialogControl -> IO () addControl dtemp (DialogControl x y cx cy mb_text mb_class style exstyle dia_id) = do prim_text <- marshall_res mb_text prim_class <- marshall_res mb_class addDiaControl dtemp prim_text dia_id prim_class style x y cx cy exstyle return () foreign import ccall unsafe "diatemp.h addDiaControl" addDiaControl :: Ptr DIA_TEMPLATE -> LPCWSTR -> Int -> LPCWSTR -> DWORD -> Int -> Int -> Int -> Int -> DWORD -> IO (Ptr DIA_TEMPLATE) {-# CFILES cbits/diatemp.c #-} marshall_res :: Either ResourceID String -> IO LPCWSTR marshall_res (Left r) = mkResource r marshall_res (Right s) = newCWString s -- modeless dialogs createDialog :: HINSTANCE -> DTemplate -> Maybe HWND -> DialogProc -> IO HWND createDialog inst template mb_parent dia_fn = createDialogParam inst template mb_parent dia_fn 0 createDialogParam :: HINSTANCE -> DTemplate -> Maybe HWND -> DialogProc -> LPARAM -> IO HWND createDialogParam inst template mb_parent dia_fn init_val = do c_dia_fn <- mkDialogClosure dia_fn failIfNull "CreateDialogParam" $ c_CreateDialogParam inst template (maybePtr mb_parent) c_dia_fn init_val foreign import stdcall "windows.h CreateDialogParamW" c_CreateDialogParam :: HINSTANCE -> DTemplate -> HWND -> FunPtr DialogProc -> LPARAM -> IO HWND createDialogIndirect :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> IO HWND createDialogIndirect inst template mb_parent dia_fn = createDialogIndirectParam inst template mb_parent dia_fn 0 createDialogIndirectParam :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> LPARAM -> IO HWND createDialogIndirectParam inst template mb_parent dia_fn init_val = do c_dia_fn <- mkDialogClosure dia_fn failIfNull "CreateDialogIndirectParam" $ c_CreateDialogIndirectParam inst template (maybePtr mb_parent) c_dia_fn init_val foreign import stdcall "windows.h CreateDialogIndirectParamW" c_CreateDialogIndirectParam :: HINSTANCE -> DTemplateMem -> HWND -> FunPtr DialogProc -> LPARAM -> IO HWND foreign import stdcall "windows.h DefDlgProcW" defDlgProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT endDialog :: HWND -> Int -> IO () endDialog dlg res = failIfFalse_ "EndDialog" $ c_EndDialog dlg res foreign import stdcall "windows.h EndDialog" c_EndDialog :: HWND -> Int -> IO BOOL foreign import stdcall unsafe "windows.h GetDialogBaseUnits" getDialogBaseUnits :: IO LONG getDlgCtrlID :: HWND -> IO Int getDlgCtrlID ctl = failIfZero "GetDlgCtrlID" $ c_GetDlgCtrlID ctl foreign import stdcall unsafe "windows.h GetDlgCtrlID" c_GetDlgCtrlID :: HWND -> IO Int getDlgItem :: HWND -> Int -> IO HWND getDlgItem dlg item = failIfNull "GetDlgItem" $ c_GetDlgItem dlg item foreign import stdcall unsafe "windows.h GetDlgItem" c_GetDlgItem :: HWND -> Int -> IO HWND getDlgItemInt :: HWND -> Int -> Bool -> IO Int getDlgItemInt dlg item signed = alloca $ \ p_trans -> do res <- c_GetDlgItemInt dlg item p_trans signed failIfFalse_ "GetDlgItemInt" $ peek p_trans return (fromIntegral res) foreign import stdcall "windows.h GetDlgItemInt" c_GetDlgItemInt :: HWND -> Int -> Ptr Bool -> Bool -> IO UINT getDlgItemText :: HWND -> Int -> Int -> IO String getDlgItemText dlg item size = allocaArray size $ \ p_buf -> do failIfZero "GetDlgItemInt" $ c_GetDlgItemText dlg item p_buf size peekTString p_buf foreign import stdcall "windows.h GetDlgItemTextW" c_GetDlgItemText :: HWND -> Int -> LPTSTR -> Int -> IO Int getNextDlgGroupItem :: HWND -> HWND -> BOOL -> IO HWND getNextDlgGroupItem dlg ctl previous = failIfNull "GetNextDlgGroupItem" $ c_GetNextDlgGroupItem dlg ctl previous foreign import stdcall unsafe "windows.h GetNextDlgGroupItem" c_GetNextDlgGroupItem :: HWND -> HWND -> BOOL -> IO HWND getNextDlgTabItem :: HWND -> HWND -> BOOL -> IO HWND getNextDlgTabItem dlg ctl previous = failIfNull "GetNextDlgTabItem" $ c_GetNextDlgTabItem dlg ctl previous foreign import stdcall unsafe "windows.h GetNextDlgTabItem" c_GetNextDlgTabItem :: HWND -> HWND -> BOOL -> IO HWND foreign import stdcall "windows.h IsDialogMessageW" isDialogMessage :: HWND -> LPMSG -> IO BOOL mapDialogRect :: HWND -> LPRECT -> IO () mapDialogRect dlg p_rect = failIfFalse_ "MapDialogRect" $ c_MapDialogRect dlg p_rect foreign import stdcall unsafe "windows.h MapDialogRect" c_MapDialogRect :: HWND -> LPRECT -> IO Bool -- No MessageBox* funs in here just yet. foreign import stdcall "windows.h SendDlgItemMessageW" sendDlgItemMessage :: HWND -> Int -> WindowMessage -> WPARAM -> LPARAM -> IO LONG setDlgItemInt :: HWND -> Int -> UINT -> BOOL -> IO () setDlgItemInt dlg item value signed = failIfFalse_ "SetDlgItemInt" $ c_SetDlgItemInt dlg item value signed foreign import stdcall "windows.h SetDlgItemInt" c_SetDlgItemInt :: HWND -> Int -> UINT -> BOOL -> IO Bool setDlgItemText :: HWND -> Int -> String -> IO () setDlgItemText dlg item str = withTString str $ \ c_str -> failIfFalse_ "SetDlgItemText" $ c_SetDlgItemText dlg item c_str foreign import stdcall "windows.h SetDlgItemTextW" c_SetDlgItemText :: HWND -> Int -> LPCTSTR -> IO Bool #{enum WindowStyle, , dS_3DLOOK = DS_3DLOOK , dS_ABSALIGN = DS_ABSALIGN , dS_CENTER = DS_CENTER , dS_CENTERMOUSE = DS_CENTERMOUSE , dS_CONTEXTHELP = DS_CONTEXTHELP , dS_CONTROL = DS_CONTROL , dS_FIXEDSYS = DS_FIXEDSYS , dS_LOCALEDIT = DS_LOCALEDIT , dS_MODALFRAME = DS_MODALFRAME , dS_NOFAILCREATE = DS_NOFAILCREATE , dS_NOIDLEMSG = DS_NOIDLEMSG , dS_SETFONT = DS_SETFONT , dS_SETFOREGROUND = DS_SETFOREGROUND , dS_SYSMODAL = DS_SYSMODAL } #{enum WindowMessage, , dM_GETDEFID = DM_GETDEFID , dM_REPOSITION = DM_REPOSITION , dM_SETDEFID = DM_SETDEFID , wM_CTLCOLORDLG = WM_CTLCOLORDLG , wM_CTLCOLORMSGBOX = WM_CTLCOLORMSGBOX } ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/Icon.hs0000644006511100651110000000266110504340503021330 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Icon -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Icon where import Graphics.Win32.GDI.Types import System.Win32.Types ---------------------------------------------------------------- -- Icons ---------------------------------------------------------------- copyIcon :: HICON -> IO HICON copyIcon icon = failIfNull "CopyIcon" $ c_CopyIcon icon foreign import stdcall unsafe "windows.h CopyIcon" c_CopyIcon :: HICON -> IO HICON drawIcon :: HDC -> Int -> Int -> HICON -> IO () drawIcon dc x y icon = failIfFalse_ "DrawIcon" $ c_DrawIcon dc x y icon foreign import stdcall unsafe "windows.h DrawIcon" c_DrawIcon :: HDC -> Int -> Int -> HICON -> IO Bool destroyIcon :: HICON -> IO () destroyIcon icon = failIfFalse_ "DestroyIcon" $ c_DestroyIcon icon foreign import stdcall unsafe "windows.h DestroyIcon" c_DestroyIcon :: HICON -> IO Bool ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/GDI.hs0000644006511100651110000000256210504340503021043 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.GDI -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- An interface to the Microsoft Windows graphics device interface (GDI). -- See under /Graphics and Multimedia/ -- for more details of the underlying library. -- ----------------------------------------------------------------------------- module Graphics.Win32.GDI ( module Graphics.Win32.GDI.Bitmap, module Graphics.Win32.GDI.Brush, module Graphics.Win32.GDI.Clip, module Graphics.Win32.GDI.Font, module Graphics.Win32.GDI.Graphics2D, module Graphics.Win32.GDI.HDC, module Graphics.Win32.GDI.Palette, module Graphics.Win32.GDI.Path, module Graphics.Win32.GDI.Pen, module Graphics.Win32.GDI.Region, module Graphics.Win32.GDI.Types ) where import Graphics.Win32.GDI.Bitmap import Graphics.Win32.GDI.Brush import Graphics.Win32.GDI.Clip import Graphics.Win32.GDI.Font import Graphics.Win32.GDI.Graphics2D import Graphics.Win32.GDI.HDC import Graphics.Win32.GDI.Palette import Graphics.Win32.GDI.Path import Graphics.Win32.GDI.Pen import Graphics.Win32.GDI.Region import Graphics.Win32.GDI.Types hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/Message.hsc0000644006511100651110000001450210504340503022164 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Message -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Message where import System.Win32.Types #include type WindowMessage = DWORD #{enum WindowMessage, , wM_COMPACTING = WM_COMPACTING , wM_WININICHANGE = WM_WININICHANGE , wM_SYSCOLORCHANGE = WM_SYSCOLORCHANGE , wM_QUERYNEWPALETTE = WM_QUERYNEWPALETTE , wM_PALETTEISCHANGING = WM_PALETTEISCHANGING , wM_PALETTECHANGED = WM_PALETTECHANGED , wM_FONTCHANGE = WM_FONTCHANGE , wM_SPOOLERSTATUS = WM_SPOOLERSTATUS , wM_DEVMODECHANGE = WM_DEVMODECHANGE , wM_TIMECHANGE = WM_TIMECHANGE , wM_POWER = WM_POWER , wM_QUERYENDSESSION = WM_QUERYENDSESSION , wM_ENDSESSION = WM_ENDSESSION , wM_QUIT = WM_QUIT , wM_CREATE = WM_CREATE , wM_NCCREATE = WM_NCCREATE , wM_DESTROY = WM_DESTROY , wM_NCDESTROY = WM_NCDESTROY , wM_SHOWWINDOW = WM_SHOWWINDOW , wM_SETREDRAW = WM_SETREDRAW , wM_ENABLE = WM_ENABLE , wM_SETTEXT = WM_SETTEXT , wM_GETTEXT = WM_GETTEXT , wM_GETTEXTLENGTH = WM_GETTEXTLENGTH , wM_WINDOWPOSCHANGING = WM_WINDOWPOSCHANGING , wM_WINDOWPOSCHANGED = WM_WINDOWPOSCHANGED , wM_MOVE = WM_MOVE , wM_SIZE = WM_SIZE , wM_QUERYOPEN = WM_QUERYOPEN , wM_CLOSE = WM_CLOSE , wM_GETMINMAXINFO = WM_GETMINMAXINFO , wM_PAINT = WM_PAINT , wM_ERASEBKGND = WM_ERASEBKGND , wM_ICONERASEBKGND = WM_ICONERASEBKGND , wM_NCPAINT = WM_NCPAINT , wM_NCCALCSIZE = WM_NCCALCSIZE , wM_QUERYDRAGICON = WM_QUERYDRAGICON , wM_DROPFILES = WM_DROPFILES , wM_ACTIVATE = WM_ACTIVATE , wM_ACTIVATEAPP = WM_ACTIVATEAPP , wM_NCACTIVATE = WM_NCACTIVATE , wM_SETFOCUS = WM_SETFOCUS , wM_KILLFOCUS = WM_KILLFOCUS , wM_KEYDOWN = WM_KEYDOWN , wM_KEYUP = WM_KEYUP , wM_CHAR = WM_CHAR , wM_DEADCHAR = WM_DEADCHAR , wM_SYSKEYDOWN = WM_SYSKEYDOWN , wM_SYSKEYUP = WM_SYSKEYUP , wM_SYSCHAR = WM_SYSCHAR , wM_SYSDEADCHAR = WM_SYSDEADCHAR , wM_KEYFIRST = WM_KEYFIRST , wM_KEYLAST = WM_KEYLAST , wM_MOUSEMOVE = WM_MOUSEMOVE , wM_LBUTTONDOWN = WM_LBUTTONDOWN , wM_LBUTTONUP = WM_LBUTTONUP , wM_LBUTTONDBLCLK = WM_LBUTTONDBLCLK , wM_RBUTTONDOWN = WM_RBUTTONDOWN , wM_RBUTTONUP = WM_RBUTTONUP , wM_RBUTTONDBLCLK = WM_RBUTTONDBLCLK , wM_MBUTTONDOWN = WM_MBUTTONDOWN , wM_MBUTTONUP = WM_MBUTTONUP , wM_MBUTTONDBLCLK = WM_MBUTTONDBLCLK , wM_MOUSEFIRST = WM_MOUSEFIRST , wM_MOUSELAST = WM_MOUSELAST , wM_NCMOUSEMOVE = WM_NCMOUSEMOVE , wM_NCLBUTTONDOWN = WM_NCLBUTTONDOWN , wM_NCLBUTTONUP = WM_NCLBUTTONUP , wM_NCLBUTTONDBLCLK = WM_NCLBUTTONDBLCLK , wM_NCRBUTTONDOWN = WM_NCRBUTTONDOWN , wM_NCRBUTTONUP = WM_NCRBUTTONUP , wM_NCRBUTTONDBLCLK = WM_NCRBUTTONDBLCLK , wM_NCMBUTTONDOWN = WM_NCMBUTTONDOWN , wM_NCMBUTTONUP = WM_NCMBUTTONUP , wM_NCMBUTTONDBLCLK = WM_NCMBUTTONDBLCLK , wM_MOUSEACTIVATE = WM_MOUSEACTIVATE , wM_CANCELMODE = WM_CANCELMODE , wM_TIMER = WM_TIMER , wM_INITMENU = WM_INITMENU , wM_INITMENUPOPUP = WM_INITMENUPOPUP , wM_MENUSELECT = WM_MENUSELECT , wM_MENUCHAR = WM_MENUCHAR , wM_COMMAND = WM_COMMAND , wM_HSCROLL = WM_HSCROLL , wM_VSCROLL = WM_VSCROLL , wM_CUT = WM_CUT , wM_COPY = WM_COPY , wM_PASTE = WM_PASTE , wM_CLEAR = WM_CLEAR , wM_UNDO = WM_UNDO , wM_RENDERFORMAT = WM_RENDERFORMAT , wM_RENDERALLFORMATS = WM_RENDERALLFORMATS , wM_DESTROYCLIPBOARD = WM_DESTROYCLIPBOARD , wM_DRAWCLIPBOARD = WM_DRAWCLIPBOARD , wM_PAINTCLIPBOARD = WM_PAINTCLIPBOARD , wM_SIZECLIPBOARD = WM_SIZECLIPBOARD , wM_VSCROLLCLIPBOARD = WM_VSCROLLCLIPBOARD , wM_HSCROLLCLIPBOARD = WM_HSCROLLCLIPBOARD , wM_ASKCBFORMATNAME = WM_ASKCBFORMATNAME , wM_CHANGECBCHAIN = WM_CHANGECBCHAIN , wM_SETCURSOR = WM_SETCURSOR , wM_SYSCOMMAND = WM_SYSCOMMAND , wM_MDICREATE = WM_MDICREATE , wM_MDIDESTROY = WM_MDIDESTROY , wM_MDIACTIVATE = WM_MDIACTIVATE , wM_MDIRESTORE = WM_MDIRESTORE , wM_MDINEXT = WM_MDINEXT , wM_MDIMAXIMIZE = WM_MDIMAXIMIZE , wM_MDITILE = WM_MDITILE , wM_MDICASCADE = WM_MDICASCADE , wM_MDIICONARRANGE = WM_MDIICONARRANGE , wM_MDIGETACTIVE = WM_MDIGETACTIVE , wM_MDISETMENU = WM_MDISETMENU , wM_CHILDACTIVATE = WM_CHILDACTIVATE , wM_INITDIALOG = WM_INITDIALOG , wM_NEXTDLGCTL = WM_NEXTDLGCTL , wM_PARENTNOTIFY = WM_PARENTNOTIFY , wM_ENTERIDLE = WM_ENTERIDLE , wM_GETDLGCODE = WM_GETDLGCODE , wM_SETFONT = WM_SETFONT , wM_GETFONT = WM_GETFONT , wM_DRAWITEM = WM_DRAWITEM , wM_MEASUREITEM = WM_MEASUREITEM , wM_DELETEITEM = WM_DELETEITEM , wM_COMPAREITEM = WM_COMPAREITEM , wM_VKEYTOITEM = WM_VKEYTOITEM , wM_CHARTOITEM = WM_CHARTOITEM , wM_QUEUESYNC = WM_QUEUESYNC , wM_USER = WM_USER , wM_APP = WM_APP } registerWindowMessage :: String -> IO WindowMessage registerWindowMessage msg = withTString msg c_RegisterWindowMessage foreign import stdcall unsafe "windows.h RegisterWindowMessageW" c_RegisterWindowMessage :: LPCTSTR -> IO WindowMessage -- These are WM_SIZE specific #{enum WPARAM, , sIZE_RESTORED = SIZE_RESTORED , sIZE_MINIMIZED = SIZE_MINIMIZED , sIZE_MAXIMIZED = SIZE_MAXIMIZED , sIZE_MAXSHOW = SIZE_MAXSHOW , sIZE_MAXHIDE = SIZE_MAXHIDE } ---------------------------------------------------------------- -- Phew! ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/Key.hsc0000644006511100651110000000631010504340503021326 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Key -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Key where import Graphics.Win32.GDI.Types import System.Win32.Types import Control.Monad (liftM) #include type VKey = DWORD #{enum VKey, , vK_LBUTTON = VK_LBUTTON , vK_RBUTTON = VK_RBUTTON , vK_CANCEL = VK_CANCEL , vK_MBUTTON = VK_MBUTTON , vK_BACK = VK_BACK , vK_TAB = VK_TAB , vK_CLEAR = VK_CLEAR , vK_RETURN = VK_RETURN , vK_SHIFT = VK_SHIFT , vK_CONTROL = VK_CONTROL , vK_MENU = VK_MENU , vK_PAUSE = VK_PAUSE , vK_CAPITAL = VK_CAPITAL , vK_ESCAPE = VK_ESCAPE , vK_SPACE = VK_SPACE , vK_PRIOR = VK_PRIOR , vK_NEXT = VK_NEXT , vK_END = VK_END , vK_HOME = VK_HOME , vK_LEFT = VK_LEFT , vK_UP = VK_UP , vK_RIGHT = VK_RIGHT , vK_DOWN = VK_DOWN , vK_SELECT = VK_SELECT , vK_EXECUTE = VK_EXECUTE , vK_SNAPSHOT = VK_SNAPSHOT , vK_INSERT = VK_INSERT , vK_DELETE = VK_DELETE , vK_HELP = VK_HELP , vK_NUMPAD0 = VK_NUMPAD0 , vK_NUMPAD1 = VK_NUMPAD1 , vK_NUMPAD2 = VK_NUMPAD2 , vK_NUMPAD3 = VK_NUMPAD3 , vK_NUMPAD4 = VK_NUMPAD4 , vK_NUMPAD5 = VK_NUMPAD5 , vK_NUMPAD6 = VK_NUMPAD6 , vK_NUMPAD7 = VK_NUMPAD7 , vK_NUMPAD8 = VK_NUMPAD8 , vK_NUMPAD9 = VK_NUMPAD9 , vK_MULTIPLY = VK_MULTIPLY , vK_ADD = VK_ADD , vK_SEPARATOR = VK_SEPARATOR , vK_SUBTRACT = VK_SUBTRACT , vK_DECIMAL = VK_DECIMAL , vK_DIVIDE = VK_DIVIDE , vK_F1 = VK_F1 , vK_F2 = VK_F2 , vK_F3 = VK_F3 , vK_F4 = VK_F4 , vK_F5 = VK_F5 , vK_F6 = VK_F6 , vK_F7 = VK_F7 , vK_F8 = VK_F8 , vK_F9 = VK_F9 , vK_F10 = VK_F10 , vK_F11 = VK_F11 , vK_F12 = VK_F12 , vK_F13 = VK_F13 , vK_F14 = VK_F14 , vK_F15 = VK_F15 , vK_F16 = VK_F16 , vK_F17 = VK_F17 , vK_F18 = VK_F18 , vK_F19 = VK_F19 , vK_F20 = VK_F20 , vK_F21 = VK_F21 , vK_F22 = VK_F22 , vK_F23 = VK_F23 , vK_F24 = VK_F24 , vK_NUMLOCK = VK_NUMLOCK , vK_SCROLL = VK_SCROLL } foreign import stdcall unsafe "windows.h EnableWindow" enableWindow :: HWND -> Bool -> IO Bool getActiveWindow :: IO (Maybe HWND) getActiveWindow = liftM ptrToMaybe c_GetActiveWindow foreign import stdcall unsafe "windows.h GetActiveWindow" c_GetActiveWindow :: IO HWND foreign import stdcall unsafe "windows.h GetAsyncKeyState" getAsyncKeyState :: Int -> IO WORD getFocus :: IO (Maybe HWND) getFocus = liftM ptrToMaybe c_GetFocus foreign import stdcall unsafe "windows.h GetFocus" c_GetFocus :: IO HWND foreign import stdcall unsafe "windows.h GetKBCodePage" getKBCodePage :: IO UINT foreign import stdcall unsafe "windows.h IsWindowEnabled" isWindowEnabled :: HWND -> IO Bool hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/Menu.hsc0000644006511100651110000004051610504340503021510 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Menu -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Menu {- ( MenuName , checkMenuItem , checkMenuRadioItem , createMenu , createPopupMenu , deleteMenu , destroyMenu , drawMenuBar , enableMenuItem , getMenu , getMenuDefaultItem , getMenuItemCount , getMenuItemID , getMenuItemInfo , getMenuItemRect , getMenuState , getSubMenu , getSystemMenu , hiliteMenuItem , insertMenuItem , isMenu , loadMenu , menuItemFromPoint , setMenu , setMenuDefaultItem , setMenuItemBitmaps , setMenuItemInfo , trackPopupMenu , trackPopupMenuEx , GMDIFlag , MenuItem , MenuFlag , MenuState , TrackMenuFlag , SystemMenuCommand -- Obsolete: , appendMenu , insertMenu , modifyMenu , removeMenu ) -} where import Graphics.Win32.GDI.Types import System.Win32.Types import Foreign import Control.Monad (liftM) #include type MenuName = LPCTSTR checkMenuItem :: HMENU -> MenuItem -> MenuFlag -> IO Bool checkMenuItem menu item check = do rv <- failIf (== -1) "CheckMenuItem" $ c_CheckMenuItem menu item check return (rv == mF_CHECKED) foreign import stdcall unsafe "windows.h CheckMenuItem" c_CheckMenuItem :: HMENU -> UINT -> UINT -> IO DWORD checkMenuRadioItem :: HMENU -> MenuItem -> MenuItem -> MenuItem -> MenuFlag -> IO () checkMenuRadioItem menu first_id last_id check flags = failIfFalse_ "CheckMenuRadioItem" $ c_CheckMenuRadioItem menu first_id last_id check flags foreign import stdcall unsafe "windows.h CheckMenuRadioItem" c_CheckMenuRadioItem :: HMENU -> UINT -> UINT -> UINT -> UINT -> IO Bool createMenu :: IO HMENU createMenu = failIfNull "CreateMenu" $ c_CreateMenu foreign import stdcall unsafe "windows.h CreateMenu" c_CreateMenu :: IO HMENU createPopupMenu :: IO HMENU createPopupMenu = failIfNull "CreatePopupMenu" $ c_CreatePopupMenu foreign import stdcall unsafe "windows.h CreatePopupMenu" c_CreatePopupMenu :: IO HMENU drawMenuBar :: HWND -> IO () drawMenuBar wnd = failIfFalse_ "DrawMenuBar" $ c_DrawMenuBar wnd foreign import stdcall unsafe "windows.h DrawMenuBar" c_DrawMenuBar :: HWND -> IO Bool type MenuState = MenuFlag enableMenuItem :: HMENU -> MenuItem -> MenuFlag -> IO MenuState enableMenuItem menu item flag = failIf (== 0xffffffff) "EnableMenuItem" $ c_EnableMenuItem menu item flag foreign import stdcall unsafe "windows.h EnableMenuItem" c_EnableMenuItem :: HMENU -> UINT -> UINT -> IO MenuState type GMDIFlag = UINT type MenuFlag = UINT #{enum GMDIFlag, , gMDI_USEDISABLED = GMDI_USEDISABLED , gMDI_GOINTOPOPUPS = GMDI_GOINTOPOPUPS } #{enum MenuFlag, , mF_BYCOMMAND = MF_BYCOMMAND , mF_BYPOSITION = MF_BYPOSITION , mF_CHECKED = MF_CHECKED } type MenuItem = UINT #{enum MenuItem, , mF_INSERT = MF_INSERT , mF_CHANGE = MF_CHANGE , mF_APPEND = MF_APPEND , mF_DELETE = MF_DELETE , mF_REMOVE = MF_REMOVE , mF_USECHECKBITMAPS = MF_USECHECKBITMAPS , mF_POPUP = MF_POPUP , mF_SYSMENU = MF_SYSMENU , mF_HELP = MF_HELP , mF_MOUSESELECT = MF_MOUSESELECT , mF_END = MF_END // Obsolete -- only used by old RES files } #{enum MenuFlag, , mFT_STRING = MFT_STRING , mFT_BITMAP = MFT_BITMAP , mFT_MENUBARBREAK = MFT_MENUBARBREAK , mFT_MENUBREAK = MFT_MENUBREAK , mFT_OWNERDRAW = MFT_OWNERDRAW , mFT_RADIOCHECK = MFT_RADIOCHECK , mFT_SEPARATOR = MFT_SEPARATOR , mFT_RIGHTORDER = MFT_RIGHTORDER , mFT_RIGHTJUSTIFY = MFT_RIGHTJUSTIFY } #{enum MenuState, , mFS_GRAYED = MFS_GRAYED , mFS_DISABLED = MFS_DISABLED // == MFS_GRAYED , mFS_CHECKED = MFS_CHECKED , mFS_HILITE = MFS_HILITE , mFS_ENABLED = MFS_ENABLED , mFS_UNCHECKED = MFS_UNCHECKED , mFS_UNHILITE = MFS_UNHILITE , mFS_DEFAULT = MFS_DEFAULT } type TrackMenuFlag = UINT #{enum TrackMenuFlag, , tPM_LEFTBUTTON = TPM_LEFTBUTTON , tPM_RIGHTBUTTON = TPM_RIGHTBUTTON , tPM_LEFTALIGN = TPM_LEFTALIGN , tPM_CENTERALIGN = TPM_CENTERALIGN , tPM_RIGHTALIGN = TPM_RIGHTALIGN , tPM_TOPALIGN = TPM_TOPALIGN , tPM_VCENTERALIGN = TPM_VCENTERALIGN , tPM_BOTTOMALIGN = TPM_BOTTOMALIGN , tPM_HORIZONTAL = TPM_HORIZONTAL // Horz alignment matters more , tPM_VERTICAL = TPM_VERTICAL // Vert alignment matters more , tPM_NONOTIFY = TPM_NONOTIFY // Don't send any notification msgs , tPM_RETURNCMD = TPM_RETURNCMD } type SystemMenuCommand = UINT #{enum SystemMenuCommand, , sC_SIZE = SC_SIZE , sC_MOVE = SC_MOVE , sC_MINIMIZE = SC_MINIMIZE , sC_MAXIMIZE = SC_MAXIMIZE , sC_NEXTWINDOW = SC_NEXTWINDOW , sC_PREVWINDOW = SC_PREVWINDOW , sC_CLOSE = SC_CLOSE , sC_VSCROLL = SC_VSCROLL , sC_HSCROLL = SC_HSCROLL , sC_MOUSEMENU = SC_MOUSEMENU , sC_KEYMENU = SC_KEYMENU , sC_ARRANGE = SC_ARRANGE , sC_RESTORE = SC_RESTORE , sC_TASKLIST = SC_TASKLIST , sC_SCREENSAVE = SC_SCREENSAVE , sC_HOTKEY = SC_HOTKEY , sC_DEFAULT = SC_DEFAULT , sC_MONITORPOWER = SC_MONITORPOWER , sC_CONTEXTHELP = SC_CONTEXTHELP , sC_SEPARATOR = SC_SEPARATOR } foreign import stdcall unsafe "windows.h IsMenu" isMenu :: HMENU -> IO Bool getSystemMenu :: HWND -> Bool -> IO (Maybe HMENU) getSystemMenu wnd revert = liftM ptrToMaybe $ c_GetSystemMenu wnd revert foreign import stdcall unsafe "windows.h GetSystemMenu" c_GetSystemMenu :: HWND -> Bool -> IO HMENU getMenu :: HWND -> IO (Maybe HMENU) getMenu wnd = liftM ptrToMaybe $ c_GetMenu wnd foreign import stdcall unsafe "windows.h GetMenu" c_GetMenu :: HWND -> IO HMENU getMenuDefaultItem :: HMENU -> Bool -> GMDIFlag -> IO MenuItem getMenuDefaultItem menu bypos flags = failIf (== -1) "GetMenuDefaultItem" $ c_GetMenuDefaultItem menu bypos flags foreign import stdcall unsafe "windows.h GetMenuDefaultItem" c_GetMenuDefaultItem :: HMENU -> Bool -> UINT -> IO UINT getMenuState :: HMENU -> MenuItem -> MenuFlag -> IO MenuState getMenuState menu item flags = failIf (== -1) "GetMenuState" $ c_GetMenuState menu item flags foreign import stdcall unsafe "windows.h GetMenuState" c_GetMenuState :: HMENU -> UINT -> UINT -> IO MenuState getSubMenu :: HMENU -> MenuItem -> IO (Maybe HMENU) getSubMenu menu pos = liftM ptrToMaybe $ c_GetSubMenu menu pos foreign import stdcall unsafe "windows.h GetSubMenu" c_GetSubMenu :: HMENU -> UINT -> IO HMENU setMenu :: HWND -> HMENU -> IO () setMenu wnd menu = failIfFalse_ "SetMenu" $ c_SetMenu wnd menu foreign import stdcall unsafe "windows.h SetMenu" c_SetMenu :: HWND -> HMENU -> IO Bool getMenuItemCount :: HMENU -> IO Int getMenuItemCount menu = failIf (== -1) "GetMenuItemCount" $ c_GetMenuItemCount menu foreign import stdcall unsafe "windows.h GetMenuItemCount" c_GetMenuItemCount :: HMENU -> IO Int type MenuID = UINT getMenuItemID :: HMENU -> MenuItem -> IO MenuID getMenuItemID menu item = failIf (== -1) "GetMenuItemID" $ c_GetMenuItemID menu item foreign import stdcall unsafe "windows.h GetMenuItemID" c_GetMenuItemID :: HMENU -> UINT -> IO MenuID data MenuItemInfo = MenuItemInfo { menuItemType :: MenuFlag, menuItemState :: MenuState, menuItemID :: UINT, menuItemSubMenu :: HMENU, menuItemBitmapChecked :: HBITMAP, menuItemBitmapUnchecked :: HBITMAP, menuItemData :: DWORD, menuItemTypeData :: String } -- Don't make this an instance of Storable, because poke isn't what we want. peekMenuItemInfo :: Ptr MenuItemInfo -> IO MenuItemInfo peekMenuItemInfo p = do itemType <- #{peek MENUITEMINFO,fType} p itemState <- #{peek MENUITEMINFO,fState} p itemID <- #{peek MENUITEMINFO,wID} p itemSubMenu <- #{peek MENUITEMINFO,hSubMenu} p itemBitmapChecked <- #{peek MENUITEMINFO,hbmpChecked} p itemBitmapUnchecked <- #{peek MENUITEMINFO,hbmpUnchecked} p itemData <- #{peek MENUITEMINFO,dwItemData} p nchars <- #{peek MENUITEMINFO,cch} p c_str <- #{peek MENUITEMINFO,dwTypeData} p itemTypeData <- peekTStringLen (c_str, fromIntegral (nchars::UINT)) return MenuItemInfo { menuItemType = itemType , menuItemState = itemState , menuItemID = itemID , menuItemSubMenu = itemSubMenu , menuItemBitmapChecked = itemBitmapChecked , menuItemBitmapUnchecked = itemBitmapUnchecked , menuItemData = itemData , menuItemTypeData = itemTypeData } allocaMenuItemInfo :: (Ptr MenuItemInfo -> IO a) -> IO a allocaMenuItemInfo f = let size = #{size MENUITEMINFO} in allocaBytes size $ \ p -> do #{poke MENUITEMINFO,cbSize} p (fromIntegral size::DWORD) f p withMenuItemInfo :: MenuItemInfo -> (Ptr MenuItemInfo -> IO a) -> IO a withMenuItemInfo info f = allocaMenuItemInfo $ \ p -> withTStringLen (menuItemTypeData info) $ \ (c_str, nchars) -> do #{poke MENUITEMINFO,fType} p (menuItemType info) #{poke MENUITEMINFO,fState} p (menuItemState info) #{poke MENUITEMINFO,wID} p (menuItemID info) #{poke MENUITEMINFO,hSubMenu} p (menuItemSubMenu info) #{poke MENUITEMINFO,hbmpChecked} p (menuItemBitmapChecked info) #{poke MENUITEMINFO,hbmpUnchecked} p (menuItemBitmapUnchecked info) #{poke MENUITEMINFO,dwItemData} p c_str #{poke MENUITEMINFO,cch} p (fromIntegral nchars::UINT) f p type MenuItemMask = UINT #{enum MenuItemMask, , mIIM_CHECKMARKS = MIIM_CHECKMARKS , mIIM_DATA = MIIM_DATA , mIIM_ID = MIIM_ID , mIIM_STATE = MIIM_STATE , mIIM_SUBMENU = MIIM_SUBMENU , mIIM_TYPE = MIIM_TYPE } pokeFMask :: Ptr MenuItemInfo -> MenuItemMask -> IO () pokeFMask p_info mask = #{poke MENUITEMINFO,fMask} p_info mask getMenuItemInfo :: HMENU -> MenuItem -> Bool -> MenuItemMask -> IO MenuItemInfo getMenuItemInfo menu item bypos mask = allocaMenuItemInfo $ \ p_info -> do pokeFMask p_info mask failIfFalse_ "GetMenuItemInfo" $ c_GetMenuItemInfo menu item bypos p_info peekMenuItemInfo p_info foreign import stdcall unsafe "windows.h GetMenuItemInfoW" c_GetMenuItemInfo :: HMENU -> UINT -> Bool -> Ptr MenuItemInfo -> IO Bool getMenuItemRect :: HWND -> HMENU -> MenuItem -> IO RECT getMenuItemRect wnd menu item = allocaRECT $ \ p_rect -> do failIfFalse_ "GetMenuItemRect" $ c_GetMenuItemRect wnd menu item p_rect peekRECT p_rect foreign import stdcall unsafe "windows.h GetMenuItemRect" c_GetMenuItemRect :: HWND -> HMENU -> UINT -> LPRECT -> IO Bool foreign import stdcall unsafe "windows.h HiliteMenuItem" hiliteMenuItem :: HWND -> HMENU -> MenuItem -> MenuFlag -> IO Bool insertMenuItem :: HMENU -> MenuItem -> Bool -> MenuItemInfo -> IO () insertMenuItem menu item bypos info = withMenuItemInfo info $ \ p_info -> failIfFalse_ "InsertMenuItem" $ c_InsertMenuItem menu item bypos p_info foreign import stdcall unsafe "windows.h InsertMenuItemW" c_InsertMenuItem :: HMENU -> UINT -> Bool -> Ptr MenuItemInfo -> IO Bool type Menu = LPCTSTR -- intToMenu :: Int -> Menu -- intToMenu i = makeIntResource (toWord i) loadMenu :: Maybe HINSTANCE -> Menu -> IO HMENU loadMenu mb_inst menu = failIfNull "LoadMenu" $ c_LoadMenu (maybePtr mb_inst) menu foreign import stdcall unsafe "windows.h LoadMenuW" c_LoadMenu :: HINSTANCE -> Menu -> IO HMENU -- Dealing with mappings to/from structs is a pain in GC, -- so we'll leave this one out for now. -- %fun LoadMenuIndirect :: MenuTemplate -> IO HMENU -- Can't pass structs with current FFI, so use a C wrapper (from Types) menuItemFromPoint :: HWND -> HMENU -> POINT -> IO UINT menuItemFromPoint wnd menu pt = withPOINT pt $ \ p_pt -> prim_MenuItemFromPoint wnd menu p_pt setMenuDefaultItem :: HMENU -> MenuItem -> Bool -> IO () setMenuDefaultItem menu item bypos = failIfFalse_ "SetMenuDefaultItem" $ c_SetMenuDefaultItem menu item bypos foreign import stdcall unsafe "windows.h SetMenuDefaultItem" c_SetMenuDefaultItem :: HMENU -> MenuItem -> Bool -> IO Bool setMenuItemBitmaps :: HMENU -> MenuItem -> MenuFlag -> HBITMAP -> HBITMAP -> IO () setMenuItemBitmaps menu pos flags bm_unchecked bm_checked = failIfFalse_ "SetMenuItemBitmaps" $ c_SetMenuItemBitmaps menu pos flags bm_unchecked bm_checked foreign import stdcall unsafe "windows.h SetMenuItemBitmaps" c_SetMenuItemBitmaps :: HMENU -> UINT -> UINT -> HBITMAP -> HBITMAP -> IO Bool destroyMenu :: HMENU -> IO () destroyMenu menu = failIfFalse_ "DestroyMenu" $ c_DestroyMenu menu foreign import stdcall unsafe "windows.h DestroyMenu" c_DestroyMenu :: HMENU -> IO Bool deleteMenu :: HMENU -> MenuItem -> MenuFlag -> IO () deleteMenu menu item flag = failIfFalse_ "DeleteMenu" $ c_DeleteMenu menu item flag foreign import stdcall unsafe "windows.h DeleteMenu" c_DeleteMenu :: HMENU -> UINT -> UINT -> IO Bool setMenuItemInfo :: HMENU -> MenuItem -> Bool -> MenuItemMask -> MenuItemInfo -> IO () setMenuItemInfo menu item bypos mask info = withMenuItemInfo info $ \ p_info -> do pokeFMask p_info mask failIfFalse_ "SetMenuItemInfo" $ c_SetMenuItemInfo menu item bypos p_info foreign import stdcall unsafe "windows.h SetMenuItemInfoW" c_SetMenuItemInfo :: HMENU -> UINT -> Bool -> Ptr MenuItemInfo -> IO Bool trackPopupMenu :: HMENU -> TrackMenuFlag -> Int -> Int -> HWND -> RECT -> IO () trackPopupMenu menu flags x y wnd rect = withRECT rect $ \ p_rect -> failIfFalse_ "TrackPopupMenu" $ c_TrackPopupMenu menu flags x y 0 wnd p_rect foreign import stdcall unsafe "windows.h TrackPopupMenu" c_TrackPopupMenu :: HMENU -> TrackMenuFlag -> Int -> Int -> Int -> HWND -> LPRECT -> IO Bool type TPMPARAMS = () withTPMPARAMS :: Ptr RECT -> (Ptr TPMPARAMS -> IO a) -> IO a withTPMPARAMS p_rect f = let size = #{size TPMPARAMS} in allocaBytes size $ \ p -> do #{poke TPMPARAMS,cbSize} p (fromIntegral size::UINT) copyBytes (#{ptr TPMPARAMS,rcExclude} p) p_rect size f p trackPopupMenuEx :: HMENU -> TrackMenuFlag -> Int -> Int -> HWND -> Maybe (Ptr RECT) -> IO () trackPopupMenuEx menu flags x y wnd mb_p_rect = maybeWith withTPMPARAMS mb_p_rect $ \ p_ptmp -> failIfFalse_ "TrackPopupMenuEx" $ c_TrackPopupMenuEx menu flags x y wnd p_ptmp foreign import stdcall unsafe "windows.h TrackPopupMenuEx" c_TrackPopupMenuEx :: HMENU -> TrackMenuFlag -> Int -> Int -> HWND -> Ptr TPMPARAMS -> IO Bool -- Note: these 3 assume the flags don't include MF_BITMAP or MF_OWNERDRAW -- (which are hidden by this interface) appendMenu :: HMENU -> MenuFlag -> MenuID -> String -> IO () appendMenu menu flags id_item name = withTString name $ \ c_name -> failIfFalse_ "AppendMenu" $ c_AppendMenu menu flags id_item c_name foreign import stdcall unsafe "windows.h AppendMenuW" c_AppendMenu :: HMENU -> UINT -> MenuID -> LPCTSTR -> IO Bool insertMenu :: HMENU -> MenuItem -> MenuFlag -> MenuID -> String -> IO () insertMenu menu item flags id_item name = withTString name $ \ c_name -> failIfFalse_ "InsertMenu" $ c_InsertMenu menu item flags id_item c_name foreign import stdcall unsafe "windows.h InsertMenuW" c_InsertMenu :: HMENU -> UINT -> UINT -> MenuID -> LPCTSTR -> IO Bool modifyMenu :: HMENU -> MenuItem -> MenuFlag -> MenuID -> String -> IO () modifyMenu menu item flags id_item name = withTString name $ \ c_name -> failIfFalse_ "ModifyMenu" $ c_ModifyMenu menu item flags id_item c_name foreign import stdcall unsafe "windows.h ModifyMenuW" c_ModifyMenu :: HMENU -> UINT -> UINT -> MenuID -> LPCTSTR -> IO Bool removeMenu :: HMENU -> MenuItem -> MenuFlag -> IO () removeMenu menu pos flags = failIfFalse_ "RemoveMenu" $ c_RemoveMenu menu pos flags foreign import stdcall unsafe "windows.h RemoveMenu" c_RemoveMenu :: HMENU -> UINT -> UINT -> IO Bool ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/Resource.hsc0000644006511100651110000001263210504340503022371 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Resource -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Resource where import System.Win32.Types import Foreign #include beginUpdateResource :: String -> Bool -> IO HANDLE beginUpdateResource name del = withTString name $ \ c_name -> failIfNull "BeginUpdateResource" $ c_BeginUpdateResource c_name del foreign import stdcall unsafe "windows.h BeginUpdateResourceW" c_BeginUpdateResource :: LPCTSTR -> Bool -> IO HANDLE type ResourceImageType = UINT type HRSRC = Ptr () type HGLOBAL = Ptr () #{enum ResourceImageType, , iMAGE_BITMAP = IMAGE_BITMAP , iMAGE_ICON = IMAGE_ICON , iMAGE_CURSOR = IMAGE_CURSOR } copyImage :: HANDLE -> ResourceImageType -> Int -> Int -> UINT -> IO HANDLE copyImage h ty x y flags = failIfNull "CopyImage" $ c_CopyImage h ty x y flags foreign import stdcall unsafe "windows.h CopyImage" c_CopyImage :: HANDLE -> ResourceImageType -> Int -> Int -> UINT -> IO HANDLE endUpdateResource :: HANDLE -> BOOL -> IO () endUpdateResource h discard = failIfFalse_ "EndUpdateResource" $ c_EndUpdateResource h discard foreign import stdcall unsafe "windows.h EndUpdateResourceW" c_EndUpdateResource :: HANDLE -> BOOL -> IO Bool type ResourceType = LPCTSTR #{enum ResourceType, castUINTToPtr , rT_ACCELERATOR = (UINT)RT_ACCELERATOR // Accelerator table , rT_ANICURSOR = (UINT)RT_ANICURSOR // Animated cursor , rT_ANIICON = (UINT)RT_ANIICON // Animated icon , rT_BITMAP = (UINT)RT_BITMAP // Bitmap resource , rT_CURSOR = (UINT)RT_CURSOR // Hardware-dependent cursor resource , rT_DIALOG = (UINT)RT_DIALOG // Dialog box , rT_FONT = (UINT)RT_FONT // Font resource , rT_FONTDIR = (UINT)RT_FONTDIR // Font directory resource , rT_GROUP_CURSOR = (UINT)RT_GROUP_CURSOR // Hardware-independent cursor resource , rT_GROUP_ICON = (UINT)RT_GROUP_ICON // Hardware-independent icon resource , rT_HTML = (UINT)RT_HTML // HTML document , rT_ICON = (UINT)RT_ICON // Hardware-dependent icon resource , rT_MENU = (UINT)RT_MENU // Menu resource , rT_MESSAGETABLE = (UINT)RT_MESSAGETABLE // Message-table entry , rT_RCDATA = (UINT)RT_RCDATA // Application-defined resource (raw data) , rT_STRING = (UINT)RT_STRING // String-table entry , rT_VERSION = (UINT)RT_VERSION // Version resource } findResource :: HMODULE -> String -> ResourceType -> IO HRSRC findResource hmod name ty = withTString name $ \ c_name -> failIfNull "FindResource" $ c_FindResource hmod c_name ty foreign import stdcall unsafe "windows.h FindResourceW" c_FindResource :: HMODULE -> LPCTSTR -> LPCTSTR -> IO HRSRC -- was: LPCTSTR_ findResourceEx :: HMODULE -> String -> ResourceType -> WORD -> IO HRSRC findResourceEx hmod name ty lang = withTString name $ \ c_name -> failIfNull "FindResourceEx" $ c_FindResourceEx hmod c_name ty lang foreign import stdcall unsafe "windows.h FindResourceExW" c_FindResourceEx :: HMODULE -> LPCTSTR -> LPCTSTR -> WORD -> IO HRSRC type ResourceSize = Int lR_DEFAULTSIZE :: ResourceSize lR_DEFAULTSIZE = #{const LR_DEFAULTSIZE} type LoadImageFlags = UINT #{enum LoadImageFlags, , lR_DEFAULTCOLOR = LR_DEFAULTCOLOR , lR_CREATEDIBSECTION = LR_CREATEDIBSECTION , lR_LOADFROMFILE = LR_LOADFROMFILE , lR_LOADMAP3DCOLORS = LR_LOADMAP3DCOLORS , lR_LOADTRANSPARENT = LR_LOADTRANSPARENT , lR_MONOCHROME = LR_MONOCHROME , lR_SHARED = LR_SHARED } -- , LR_VGACOLOR (Not in mingw-20001111 headers) -- was: LPCTSTR_ loadImage :: HINSTANCE -> String -> ResourceImageType -> ResourceSize -> ResourceSize -> LoadImageFlags -> IO HANDLE loadImage inst name ty x y load = withTString name $ \ c_name -> failIfNull "LoadImage" $ c_LoadImage inst c_name ty x y load foreign import stdcall unsafe "windows.h LoadImageW" c_LoadImage :: HINSTANCE -> LPCTSTR -> ResourceImageType -> ResourceSize -> ResourceSize -> LoadImageFlags -> IO HANDLE loadResource :: HMODULE -> HRSRC -> IO HGLOBAL loadResource hmod res = failIfNull "LoadResource" $ c_LoadResource hmod res foreign import stdcall unsafe "windows.h LoadResource" c_LoadResource :: HMODULE -> HRSRC -> IO HGLOBAL lockResource :: HGLOBAL -> IO Addr lockResource res = failIfNull "LockResource" $ c_LockResource res foreign import stdcall unsafe "windows.h LockResource" c_LockResource :: HGLOBAL -> IO Addr sizeofResource :: HMODULE -> HRSRC -> IO DWORD sizeofResource hmod res = failIfZero "SizeofResource" $ c_SizeofResource hmod res foreign import stdcall unsafe "windows.h SizeofResource" c_SizeofResource :: HMODULE -> HRSRC -> IO DWORD -- was: LPCTSTR_ updateResource :: HANDLE -> ResourceType -> String -> WORD -> Addr -> DWORD -> IO () updateResource h ty name lang p_data data_len = withTString name $ \ c_name -> failIfFalse_ "UpdateResource" $ c_UpdateResource h ty c_name lang p_data data_len foreign import stdcall unsafe "windows.h UpdateResourceW" c_UpdateResource :: HANDLE -> LPCTSTR -> LPCTSTR -> WORD -> Addr -> DWORD -> IO Bool hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/Misc.hsc0000644006511100651110000002236210504340503021476 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Misc -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Misc where import Graphics.Win32.GDI.Types import System.Win32.Types import Data.Maybe import Foreign #include #include "gettime.h" ---------------------------------------------------------------- -- Resources -- (should probably be distributed between -- Graphics.Win32.{Icon,Cursor,Accelerator,Menu,...}) ---------------------------------------------------------------- type Accelerator = LPCTSTR -- intToAccelerator :: Int -> Accelerator -- intToAccelerator i = makeIntResource (toWord i) -- cursor and icon should not be const pointer; GSL ??? type Cursor = LPTSTR -- intToCursor :: Int -> Cursor -- intToCursor i = makeIntResource (toWord i) type Icon = LPTSTR -- intToIcon :: Int -> Icon -- intToIcon i = makeIntResource (toWord i) loadAccelerators :: Maybe HINSTANCE -> Accelerator -> IO HACCEL loadAccelerators mb_inst accel = failIfNull "LoadAccelerators" $ c_LoadAccelerators (maybePtr mb_inst) accel foreign import stdcall unsafe "windows.h LoadAcceleratorsW" c_LoadAccelerators :: HINSTANCE -> Accelerator -> IO HACCEL loadCursor :: Maybe HINSTANCE -> Cursor -> IO HCURSOR loadCursor mb_inst cursor = failIfNull "LoadCursor" $ c_LoadCursor (maybePtr mb_inst) cursor foreign import stdcall unsafe "windows.h LoadCursorW" c_LoadCursor :: HINSTANCE -> Cursor -> IO HCURSOR loadIcon :: Maybe HINSTANCE -> Icon -> IO HICON loadIcon mb_inst icon = failIfNull "LoadIcon" $ c_LoadIcon (maybePtr mb_inst) icon foreign import stdcall unsafe "windows.h LoadIconW" c_LoadIcon :: HINSTANCE -> Icon -> IO HICON #{enum Cursor, castUINTToPtr , iDC_ARROW = (UINT)IDC_ARROW , iDC_IBEAM = (UINT)IDC_IBEAM , iDC_WAIT = (UINT)IDC_WAIT , iDC_CROSS = (UINT)IDC_CROSS , iDC_UPARROW = (UINT)IDC_UPARROW , iDC_SIZENWSE = (UINT)IDC_SIZENWSE , iDC_SIZENESW = (UINT)IDC_SIZENESW , iDC_SIZEWE = (UINT)IDC_SIZEWE , iDC_SIZENS = (UINT)IDC_SIZENS } #{enum Icon, castUINTToPtr , iDI_APPLICATION = (UINT)IDI_APPLICATION , iDI_HAND = (UINT)IDI_HAND , iDI_QUESTION = (UINT)IDI_QUESTION , iDI_EXCLAMATION = (UINT)IDI_EXCLAMATION , iDI_ASTERISK = (UINT)IDI_ASTERISK } ---------------------------------------------------------------- -- Message Boxes ---------------------------------------------------------------- type MBStyle = UINT #{enum MBStyle, , mB_OK = MB_OK , mB_OKCANCEL = MB_OKCANCEL , mB_ABORTRETRYIGNORE = MB_ABORTRETRYIGNORE , mB_YESNOCANCEL = MB_YESNOCANCEL , mB_YESNO = MB_YESNO , mB_RETRYCANCEL = MB_RETRYCANCEL , mB_ICONHAND = MB_ICONHAND , mB_ICONQUESTION = MB_ICONQUESTION , mB_ICONEXCLAMATION = MB_ICONEXCLAMATION , mB_ICONASTERISK = MB_ICONASTERISK , mB_ICONINFORMATION = MB_ICONINFORMATION , mB_ICONSTOP = MB_ICONSTOP , mB_DEFBUTTON1 = MB_DEFBUTTON1 , mB_DEFBUTTON2 = MB_DEFBUTTON2 , mB_DEFBUTTON3 = MB_DEFBUTTON3 , mB_APPLMODAL = MB_APPLMODAL , mB_SYSTEMMODAL = MB_SYSTEMMODAL , mB_TASKMODAL = MB_TASKMODAL , mB_SETFOREGROUND = MB_SETFOREGROUND } type MBStatus = UINT #{enum MBStatus, , iDABORT = IDABORT , iDCANCEL = IDCANCEL , iDIGNORE = IDIGNORE , iDNO = IDNO , iDOK = IDOK , iDRETRY = IDRETRY , iDYES = IDYES } -- Note: if the error is ever raised, we're in a very sad way! messageBox :: HWND -> String -> String -> MBStyle -> IO MBStatus messageBox wnd text caption style = withTString text $ \ c_text -> withTString caption $ \ c_caption -> failIfZero "MessageBox" $ c_MessageBox wnd c_text c_caption style foreign import stdcall unsafe "windows.h MessageBoxW" c_MessageBox :: HWND -> LPCTSTR -> LPCTSTR -> MBStyle -> IO MBStatus ---------------------------------------------------------------- -- ---------------------------------------------------------------- type StdHandleId = DWORD #{enum StdHandleId, , sTD_INPUT_HANDLE = STD_INPUT_HANDLE , sTD_OUTPUT_HANDLE = STD_OUTPUT_HANDLE , sTD_ERROR_HANDLE = STD_ERROR_HANDLE } getStdHandle :: StdHandleId -> IO HANDLE getStdHandle hid = failIf (== iNVALID_HANDLE_VALUE) "GetStdHandle" $ c_GetStdHandle hid foreign import stdcall unsafe "windows.h GetStdHandle" c_GetStdHandle :: StdHandleId -> IO HANDLE ---------------------------------------------------------------- -- Rotatable Ellipse hack -- -- Win95 (Win32?) doesn't support rotating ellipses - so we -- implement them with polygons. -- -- We use a fixed number of edges rather than varying the number -- according to the radius of the ellipse. -- If anyone feels like improving the code (to vary the number), -- they should place a fixed upper bound on the number of edges -- since it takes a relatively long time to draw 1000 edges. ---------------------------------------------------------------- transformedEllipse :: HDC -> POINT -> POINT -> POINT -> IO () transformedEllipse dc (x0,y0) (x1,y1) (x2,y2) = failIfFalse_ "transformedEllipse" $ c_transformedEllipse dc x0 y0 x1 y1 x2 y2 foreign import ccall unsafe "ellipse.h transformedEllipse" c_transformedEllipse :: HDC -> LONG -> LONG -> LONG -> LONG -> LONG -> LONG -> IO Bool {-# CFILES cbits/ellipse.c #-} ---------------------------------------------------------------- -- Cursor ---------------------------------------------------------------- getCursorPos :: IO POINT getCursorPos = allocaPOINT $ \ p_pt -> do failIfFalse_ "GetCursorPos" $ c_GetCursorPos p_pt peekPOINT p_pt foreign import stdcall unsafe "windows.h GetCursorPos" c_GetCursorPos :: Ptr POINT -> IO Bool setCursorPos :: POINT -> IO () setCursorPos (x,y) = failIfFalse_ "setCursorPos" $ c_SetCursorPos x y foreign import stdcall unsafe "windows.h SetCursorPos" c_SetCursorPos :: LONG -> LONG -> IO Bool clipCursor :: RECT -> IO () clipCursor rect = withRECT rect $ \ p_rect -> failIfFalse_ "ClipCursor" $ c_ClipCursor p_rect foreign import stdcall unsafe "windows.h ClipCursor" c_ClipCursor :: Ptr RECT -> IO Bool getClipCursor :: IO RECT getClipCursor = allocaRECT $ \ p_rect -> do failIfFalse_ "GetClipCursor" $ c_GetClipCursor p_rect peekRECT p_rect foreign import stdcall unsafe "windows.h GetClipCursor" c_GetClipCursor :: Ptr RECT -> IO Bool ---------------------------------------------------------------- -- Exit/shutdown ---------------------------------------------------------------- type ExitOption = UINT #{enum ExitOption, , eWX_FORCE = EWX_FORCE , eWX_LOGOFF = EWX_LOGOFF , eWX_POWEROFF = EWX_POWEROFF , eWX_REBOOT = EWX_REBOOT , eWX_SHUTDOWN = EWX_SHUTDOWN } exitWindowsEx :: ExitOption -> IO () exitWindowsEx opt = failIfFalse_ "ExitWindowsEx" $ c_ExitWindowsEx opt 0 foreign import stdcall unsafe "windows.h ExitWindowsEx" c_ExitWindowsEx :: ExitOption -> DWORD -> IO Bool exitWindows :: IO () exitWindows = exitWindowsEx 0 ---------------------------------------------------------------- -- Beeping ---------------------------------------------------------------- type Beep = UINT type MbBeep = Maybe Beep maybeBeep :: Maybe Beep -> Beep maybeBeep = fromMaybe 0xffffffff type Duration = Int type MbDuration = Maybe Duration maybeDuration :: Maybe Duration -> Duration maybeDuration = fromMaybe (-1) messageBeep :: Maybe Beep -> IO () messageBeep mb_beep = c_MessageBeep (maybeBeep mb_beep) foreign import stdcall unsafe "windows.h MessageBeep" c_MessageBeep :: Beep -> IO () beep :: WORD -> MbDuration -> IO () beep freq mb_dur = failIfFalse_ "Beep" $ c_Beep freq (maybeDuration mb_dur) foreign import stdcall unsafe "windows.h Beep" c_Beep :: WORD -> Duration -> IO Bool ---------------------------------------------------------------- -- Timers ---------------------------------------------------------------- type TimerId = UINT type TIMERPROC = FunPtr (HWND -> UINT -> TimerId -> DWORD -> IO ()) -- ToDo: support the other two forms of timer initialisation -- Cause WM_TIMER events to be sent to window callback setWinTimer :: HWND -> TimerId -> UINT -> IO TimerId setWinTimer wnd timer elapse = failIfZero "SetTimer" $ c_SetTimer wnd timer elapse nullFunPtr foreign import stdcall unsafe "windows.h SetTimer" c_SetTimer :: HWND -> TimerId -> UINT -> TIMERPROC -> IO TimerId killTimer :: Maybe HWND -> TimerId -> IO () killTimer mb_wnd timer = failIfFalse_ "KillTimer" $ c_KillTimer (maybePtr mb_wnd) timer foreign import stdcall unsafe "windows.h KillTimer" c_KillTimer :: HWND -> TimerId -> IO Bool -- For documentation purposes: type MilliSeconds = DWORD foreign import stdcall unsafe "windows.h timeGetTime" timeGetTime :: IO MilliSeconds ---------------------------------------------------------------- -- %fun ezCreateFont :: Unknown -- %result BITMAP({ getBitmapInfo(x) }) ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32/Window.hsc0000644006511100651110000005553510504340503022062 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32.Window -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module Graphics.Win32.Window where import System.Win32.Types import Graphics.Win32.GDI.Types import Graphics.Win32.Message import Control.Monad import Data.Maybe import Foreign #include ---------------------------------------------------------------- -- Window Class ---------------------------------------------------------------- -- The classname must not be deallocated until the corresponding class -- is deallocated. For this reason, we represent classnames by pointers -- and explicitly allocate the className. type ClassName = LPCTSTR -- Note: this is one of those rare functions which doesnt free all -- its String arguments. mkClassName :: String -> ClassName mkClassName name = unsafePerformIO (newTString name) type ClassStyle = UINT #{enum ClassStyle, , cS_VREDRAW = CS_VREDRAW , cS_HREDRAW = CS_HREDRAW , cS_OWNDC = CS_OWNDC , cS_CLASSDC = CS_CLASSDC , cS_PARENTDC = CS_PARENTDC , cS_SAVEBITS = CS_SAVEBITS , cS_DBLCLKS = CS_DBLCLKS , cS_BYTEALIGNCLIENT = CS_BYTEALIGNCLIENT , cS_BYTEALIGNWINDOW = CS_BYTEALIGNWINDOW , cS_NOCLOSE = CS_NOCLOSE , cS_GLOBALCLASS = CS_GLOBALCLASS } type WNDCLASS = (ClassStyle, -- style HINSTANCE, -- hInstance Maybe HICON, -- hIcon Maybe HCURSOR, -- hCursor Maybe HBRUSH, -- hbrBackground Maybe LPCTSTR, -- lpszMenuName ClassName) -- lpszClassName --ToDo! --To avoid confusion with NULL, WNDCLASS requires you to add 1 to a SystemColor --(which can be NULL) -- %fun mkMbHBRUSH :: SystemColor -> MbHBRUSH -- %code -- %result ((HBRUSH)($0+1)); withWNDCLASS :: WNDCLASS -> (Ptr WNDCLASS -> IO a) -> IO a withWNDCLASS (style, inst, mb_icon, mb_cursor, mb_bg, mb_menu, cls) f = allocaBytes #{size WNDCLASS} $ \ p -> do #{poke WNDCLASS,style} p style #{poke WNDCLASS,lpfnWndProc} p genericWndProc_p #{poke WNDCLASS,cbClsExtra} p (0::INT) #{poke WNDCLASS,cbWndExtra} p (0::INT) #{poke WNDCLASS,hInstance} p inst #{poke WNDCLASS,hIcon} p (maybePtr mb_icon) #{poke WNDCLASS,hCursor} p (maybePtr mb_cursor) #{poke WNDCLASS,hbrBackground} p (maybePtr mb_bg) #{poke WNDCLASS,lpszMenuName} p (maybePtr mb_menu) #{poke WNDCLASS,lpszClassName} p cls f p foreign import ccall unsafe "WndProc.h &genericWndProc" genericWndProc_p :: FunPtr WindowClosure {-# CFILES cbits/WndProc.c #-} registerClass :: WNDCLASS -> IO (Maybe ATOM) registerClass cls = withWNDCLASS cls $ \ p -> liftM numToMaybe $ c_RegisterClass p foreign import stdcall unsafe "windows.h RegisterClassW" c_RegisterClass :: Ptr WNDCLASS -> IO ATOM foreign import stdcall unsafe "windows.h UnregisterClassW" unregisterClass :: ClassName -> HINSTANCE -> IO () ---------------------------------------------------------------- -- Window Style ---------------------------------------------------------------- type WindowStyle = DWORD #{enum WindowStyle, , wS_OVERLAPPED = WS_OVERLAPPED , wS_POPUP = WS_POPUP , wS_CHILD = WS_CHILD , wS_CLIPSIBLINGS = WS_CLIPSIBLINGS , wS_CLIPCHILDREN = WS_CLIPCHILDREN , wS_VISIBLE = WS_VISIBLE , wS_DISABLED = WS_DISABLED , wS_MINIMIZE = WS_MINIMIZE , wS_MAXIMIZE = WS_MAXIMIZE , wS_CAPTION = WS_CAPTION , wS_BORDER = WS_BORDER , wS_DLGFRAME = WS_DLGFRAME , wS_VSCROLL = WS_VSCROLL , wS_HSCROLL = WS_HSCROLL , wS_SYSMENU = WS_SYSMENU , wS_THICKFRAME = WS_THICKFRAME , wS_MINIMIZEBOX = WS_MINIMIZEBOX , wS_MAXIMIZEBOX = WS_MAXIMIZEBOX , wS_GROUP = WS_GROUP , wS_TABSTOP = WS_TABSTOP , wS_OVERLAPPEDWINDOW = WS_OVERLAPPEDWINDOW , wS_POPUPWINDOW = WS_POPUPWINDOW , wS_CHILDWINDOW = WS_CHILDWINDOW , wS_TILED = WS_TILED , wS_ICONIC = WS_ICONIC , wS_SIZEBOX = WS_SIZEBOX , wS_TILEDWINDOW = WS_TILEDWINDOW } type WindowStyleEx = DWORD #{enum WindowStyleEx, , wS_EX_DLGMODALFRAME = WS_EX_DLGMODALFRAME , wS_EX_NOPARENTNOTIFY = WS_EX_NOPARENTNOTIFY , wS_EX_TOPMOST = WS_EX_TOPMOST , wS_EX_ACCEPTFILES = WS_EX_ACCEPTFILES , wS_EX_TRANSPARENT = WS_EX_TRANSPARENT , wS_EX_MDICHILD = WS_EX_MDICHILD , wS_EX_TOOLWINDOW = WS_EX_TOOLWINDOW , wS_EX_WINDOWEDGE = WS_EX_WINDOWEDGE , wS_EX_CLIENTEDGE = WS_EX_CLIENTEDGE , wS_EX_CONTEXTHELP = WS_EX_CONTEXTHELP , wS_EX_RIGHT = WS_EX_RIGHT , wS_EX_LEFT = WS_EX_LEFT , wS_EX_RTLREADING = WS_EX_RTLREADING , wS_EX_LTRREADING = WS_EX_LTRREADING , wS_EX_LEFTSCROLLBAR = WS_EX_LEFTSCROLLBAR , wS_EX_RIGHTSCROLLBAR = WS_EX_RIGHTSCROLLBAR , wS_EX_CONTROLPARENT = WS_EX_CONTROLPARENT , wS_EX_STATICEDGE = WS_EX_STATICEDGE , wS_EX_APPWINDOW = WS_EX_APPWINDOW , wS_EX_OVERLAPPEDWINDOW = WS_EX_OVERLAPPEDWINDOW , wS_EX_PALETTEWINDOW = WS_EX_PALETTEWINDOW } cW_USEDEFAULT :: Pos cW_USEDEFAULT = #{const CW_USEDEFAULT} type Pos = Int type MbPos = Maybe Pos maybePos :: Maybe Pos -> Pos maybePos = fromMaybe cW_USEDEFAULT type WindowClosure = HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT foreign import ccall "wrapper" mkWindowClosure :: WindowClosure -> IO (FunPtr WindowClosure) setWindowClosure :: HWND -> WindowClosure -> IO () setWindowClosure wnd closure = do fp <- mkWindowClosure closure c_SetWindowLong wnd (#{const GWL_USERDATA}) (castFunPtrToLONG fp) return () foreign import stdcall unsafe "windows.h SetWindowLongW" c_SetWindowLong :: HWND -> INT -> LONG -> IO LONG createWindow :: ClassName -> String -> WindowStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure -> IO HWND createWindow = createWindowEx 0 -- apparently CreateWindowA/W are just macros for CreateWindowExA/W createWindowEx :: WindowStyle -> ClassName -> String -> WindowStyle -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure -> IO HWND createWindowEx estyle cname wname wstyle mb_x mb_y mb_w mb_h mb_parent mb_menu inst closure = do -- Freeing the title/window name has been reported -- to cause a crash, so let's not do it. -- withTString wname $ \ c_wname -> do c_wname <- newTString wname wnd <- failIfNull "CreateWindowEx" $ c_CreateWindowEx estyle cname c_wname wstyle (maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h) (maybePtr mb_parent) (maybePtr mb_menu) inst nullPtr setWindowClosure wnd closure return wnd foreign import stdcall "windows.h CreateWindowExW" c_CreateWindowEx :: WindowStyle -> ClassName -> LPCTSTR -> WindowStyle -> Pos -> Pos -> Pos -> Pos -> HWND -> HMENU -> HINSTANCE -> LPVOID -> IO HWND ---------------------------------------------------------------- defWindowProc :: Maybe HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT defWindowProc mb_wnd msg w l = c_DefWindowProc (maybePtr mb_wnd) msg w l foreign import stdcall "windows.h DefWindowProcW" c_DefWindowProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT ---------------------------------------------------------------- getClientRect :: HWND -> IO RECT getClientRect wnd = allocaRECT $ \ p_rect -> do failIfFalse_ "GetClientRect" $ c_GetClientRect wnd p_rect peekRECT p_rect foreign import stdcall unsafe "windows.h GetClientRect" c_GetClientRect :: HWND -> Ptr RECT -> IO Bool getWindowRect :: HWND -> IO RECT getWindowRect wnd = allocaRECT $ \ p_rect -> do failIfFalse_ "GetWindowRect" $ c_GetWindowRect wnd p_rect peekRECT p_rect foreign import stdcall unsafe "windows.h GetWindowRect" c_GetWindowRect :: HWND -> Ptr RECT -> IO Bool -- Should it be Maybe RECT instead? invalidateRect :: Maybe HWND -> Maybe LPRECT -> Bool -> IO () invalidateRect wnd p_mb_rect erase = failIfFalse_ "InvalidateRect" $ c_InvalidateRect (maybePtr wnd) (maybePtr p_mb_rect) erase foreign import stdcall "windows.h InvalidateRect" c_InvalidateRect :: HWND -> LPRECT -> Bool -> IO Bool screenToClient :: HWND -> POINT -> IO POINT screenToClient wnd pt = withPOINT pt $ \ p_pt -> do failIfFalse_ "ScreenToClient" $ c_ScreenToClient wnd p_pt peekPOINT p_pt foreign import stdcall unsafe "windows.h ScreenToClient" c_ScreenToClient :: HWND -> Ptr POINT -> IO Bool clientToScreen :: HWND -> POINT -> IO POINT clientToScreen wnd pt = withPOINT pt $ \ p_pt -> do failIfFalse_ "ClientToScreen" $ c_ClientToScreen wnd p_pt peekPOINT p_pt foreign import stdcall unsafe "windows.h ClientToScreen" c_ClientToScreen :: HWND -> Ptr POINT -> IO Bool ---------------------------------------------------------------- -- Setting window text/label ---------------------------------------------------------------- -- For setting the title bar text. But inconvenient to make the LPCTSTR setWindowText :: HWND -> String -> IO () setWindowText wnd text = withTString text $ \ c_text -> failIfFalse_ "SetWindowText" $ c_SetWindowText wnd c_text foreign import stdcall "windows.h SetWindowTextW" c_SetWindowText :: HWND -> LPCTSTR -> IO Bool ---------------------------------------------------------------- -- Paint struct ---------------------------------------------------------------- type PAINTSTRUCT = ( HDC -- hdc , Bool -- fErase , RECT -- rcPaint ) type LPPAINTSTRUCT = Addr sizeofPAINTSTRUCT :: DWORD sizeofPAINTSTRUCT = #{size PAINTSTRUCT} allocaPAINTSTRUCT :: (LPPAINTSTRUCT -> IO a) -> IO a allocaPAINTSTRUCT = allocaBytes #{size PAINTSTRUCT} beginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC beginPaint wnd paint = failIfNull "BeginPaint" $ c_BeginPaint wnd paint foreign import stdcall "windows.h BeginPaint" c_BeginPaint :: HWND -> LPPAINTSTRUCT -> IO HDC foreign import stdcall "windows.h EndPaint" endPaint :: HWND -> LPPAINTSTRUCT -> IO () -- Apparently always succeeds (return non-zero) ---------------------------------------------------------------- -- ShowWindow ---------------------------------------------------------------- type ShowWindowControl = DWORD #{enum ShowWindowControl, , sW_HIDE = SW_HIDE , sW_SHOWNORMAL = SW_SHOWNORMAL , sW_SHOWMINIMIZED = SW_SHOWMINIMIZED , sW_SHOWMAXIMIZED = SW_SHOWMAXIMIZED , sW_MAXIMIZE = SW_MAXIMIZE , sW_SHOWNOACTIVATE = SW_SHOWNOACTIVATE , sW_SHOW = SW_SHOW , sW_MINIMIZE = SW_MINIMIZE , sW_SHOWMINNOACTIVE = SW_SHOWMINNOACTIVE , sW_SHOWNA = SW_SHOWNA , sW_RESTORE = SW_RESTORE } foreign import stdcall "windows.h ShowWindow" showWindow :: HWND -> ShowWindowControl -> IO Bool ---------------------------------------------------------------- -- Misc ---------------------------------------------------------------- adjustWindowRect :: RECT -> WindowStyle -> Bool -> IO RECT adjustWindowRect rect style menu = withRECT rect $ \ p_rect -> do failIfFalse_ "AdjustWindowRect" $ c_AdjustWindowRect p_rect style menu peekRECT p_rect foreign import stdcall unsafe "windows.h AdjustWindowRect" c_AdjustWindowRect :: Ptr RECT -> WindowStyle -> Bool -> IO Bool adjustWindowRectEx :: RECT -> WindowStyle -> Bool -> WindowStyleEx -> IO RECT adjustWindowRectEx rect style menu exstyle = withRECT rect $ \ p_rect -> do failIfFalse_ "AdjustWindowRectEx" $ c_AdjustWindowRectEx p_rect style menu exstyle peekRECT p_rect foreign import stdcall unsafe "windows.h AdjustWindowRectEx" c_AdjustWindowRectEx :: Ptr RECT -> WindowStyle -> Bool -> WindowStyleEx -> IO Bool -- Win2K and later: -- %fun AllowSetForegroundWindow :: DWORD -> IO () -- % -- %dis animateWindowType x = dWORD x -- type AnimateWindowType = DWORD -- %const AnimateWindowType -- [ AW_SLIDE -- , AW_ACTIVATE -- , AW_BLEND -- , AW_HIDE -- , AW_CENTER -- , AW_HOR_POSITIVE -- , AW_HOR_NEGATIVE -- , AW_VER_POSITIVE -- , AW_VER_NEGATIVE -- ] -- Win98 or Win2K: -- %fun AnimateWindow :: HWND -> DWORD -> AnimateWindowType -> IO () -- %code BOOL success = AnimateWindow(arg1,arg2,arg3) -- %fail { !success } { ErrorWin("AnimateWindow") } foreign import stdcall unsafe "windows.h AnyPopup" anyPopup :: IO Bool arrangeIconicWindows :: HWND -> IO () arrangeIconicWindows wnd = failIfFalse_ "ArrangeIconicWindows" $ c_ArrangeIconicWindows wnd foreign import stdcall unsafe "windows.h ArrangeIconicWindows" c_ArrangeIconicWindows :: HWND -> IO Bool beginDeferWindowPos :: Int -> IO HDWP beginDeferWindowPos n = failIfNull "BeginDeferWindowPos" $ c_BeginDeferWindowPos n foreign import stdcall unsafe "windows.h BeginDeferWindowPos" c_BeginDeferWindowPos :: Int -> IO HDWP bringWindowToTop :: HWND -> IO () bringWindowToTop wnd = failIfFalse_ "BringWindowToTop" $ c_BringWindowToTop wnd foreign import stdcall "windows.h BringWindowToTop" c_BringWindowToTop :: HWND -> IO Bool -- Can't pass structs with current FFI, so use a C wrapper (in Types) childWindowFromPoint :: HWND -> POINT -> IO (Maybe HWND) childWindowFromPoint wnd pt = withPOINT pt $ \ p_pt -> liftM ptrToMaybe $ prim_ChildWindowFromPoint wnd p_pt -- Can't pass structs with current FFI, so use a C wrapper (in Types) childWindowFromPointEx :: HWND -> POINT -> DWORD -> IO (Maybe HWND) childWindowFromPointEx parent pt flags = withPOINT pt $ \ p_pt -> liftM ptrToMaybe $ prim_ChildWindowFromPointEx parent p_pt flags closeWindow :: HWND -> IO () closeWindow wnd = failIfFalse_ "CloseWindow" $ c_DestroyWindow wnd deferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP deferWindowPos wp wnd after x y cx cy flags = failIfNull "DeferWindowPos" $ c_DeferWindowPos wp wnd after x y cx cy flags foreign import stdcall unsafe "windows.h DeferWindowPos" c_DeferWindowPos :: HDWP -> HWND -> HWND -> Int -> Int -> Int -> Int -> SetWindowPosFlags -> IO HDWP destroyWindow :: HWND -> IO () destroyWindow wnd = failIfFalse_ "DestroyWindow" $ c_DestroyWindow wnd foreign import stdcall "windows.h DestroyWindow" c_DestroyWindow :: HWND -> IO Bool endDeferWindowPos :: HDWP -> IO () endDeferWindowPos pos = failIfFalse_ "EndDeferWindowPos" $ c_EndDeferWindowPos pos foreign import stdcall unsafe "windows.h EndDeferWindowPos" c_EndDeferWindowPos :: HDWP -> IO Bool findWindow :: String -> String -> IO (Maybe HWND) findWindow cname wname = withTString cname $ \ c_cname -> withTString wname $ \ c_wname -> liftM ptrToMaybe $ c_FindWindow c_cname c_wname foreign import stdcall unsafe "windows.h FindWindowW" c_FindWindow :: LPCTSTR -> LPCTSTR -> IO HWND findWindowEx :: HWND -> HWND -> String -> String -> IO (Maybe HWND) findWindowEx parent after cname wname = withTString cname $ \ c_cname -> withTString wname $ \ c_wname -> liftM ptrToMaybe $ c_FindWindowEx parent after c_cname c_wname foreign import stdcall unsafe "windows.h FindWindowExW" c_FindWindowEx :: HWND -> HWND -> LPCTSTR -> LPCTSTR -> IO HWND foreign import stdcall unsafe "windows.h FlashWindow" flashWindow :: HWND -> Bool -> IO Bool -- No error code moveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO () moveWindow wnd x y w h repaint = failIfFalse_ "MoveWindow" $ c_MoveWindow wnd x y w h repaint foreign import stdcall "windows.h MoveWindow" c_MoveWindow :: HWND -> Int -> Int -> Int -> Int -> Bool -> IO Bool foreign import stdcall unsafe "windows.h GetDesktopWindow" getDesktopWindow :: IO HWND foreign import stdcall unsafe "windows.h GetForegroundWindow" getForegroundWindow :: IO HWND getParent :: HWND -> IO HWND getParent wnd = failIfNull "GetParent" $ c_GetParent wnd foreign import stdcall unsafe "windows.h GetParent" c_GetParent :: HWND -> IO HWND getTopWindow :: HWND -> IO HWND getTopWindow wnd = failIfNull "GetTopWindow" $ c_GetTopWindow wnd foreign import stdcall unsafe "windows.h GetTopWindow" c_GetTopWindow :: HWND -> IO HWND type SetWindowPosFlags = UINT #{enum SetWindowPosFlags, , sWP_NOSIZE = SWP_NOSIZE , sWP_NOMOVE = SWP_NOMOVE , sWP_NOZORDER = SWP_NOZORDER , sWP_NOREDRAW = SWP_NOREDRAW , sWP_NOACTIVATE = SWP_NOACTIVATE , sWP_FRAMECHANGED = SWP_FRAMECHANGED , sWP_SHOWWINDOW = SWP_SHOWWINDOW , sWP_HIDEWINDOW = SWP_HIDEWINDOW , sWP_NOCOPYBITS = SWP_NOCOPYBITS , sWP_NOOWNERZORDER = SWP_NOOWNERZORDER , sWP_NOSENDCHANGING = SWP_NOSENDCHANGING , sWP_DRAWFRAME = SWP_DRAWFRAME , sWP_NOREPOSITION = SWP_NOREPOSITION } ---------------------------------------------------------------- -- HDCs ---------------------------------------------------------------- type GetDCExFlags = DWORD #{enum GetDCExFlags, , dCX_WINDOW = DCX_WINDOW , dCX_CACHE = DCX_CACHE , dCX_CLIPCHILDREN = DCX_CLIPCHILDREN , dCX_CLIPSIBLINGS = DCX_CLIPSIBLINGS , dCX_PARENTCLIP = DCX_PARENTCLIP , dCX_EXCLUDERGN = DCX_EXCLUDERGN , dCX_INTERSECTRGN = DCX_INTERSECTRGN , dCX_LOCKWINDOWUPDATE = DCX_LOCKWINDOWUPDATE } -- apparently mostly fails if you use invalid hwnds getDCEx :: HWND -> HRGN -> GetDCExFlags -> IO HDC getDCEx wnd rgn flags = withForeignPtr rgn $ \ p_rgn -> failIfNull "GetDCEx" $ c_GetDCEx wnd p_rgn flags foreign import stdcall unsafe "windows.h GetDCEx" c_GetDCEx :: HWND -> PRGN -> GetDCExFlags -> IO HDC getDC :: Maybe HWND -> IO HDC getDC mb_wnd = failIfNull "GetDC" $ c_GetDC (maybePtr mb_wnd) foreign import stdcall unsafe "windows.h GetDC" c_GetDC :: HWND -> IO HDC getWindowDC :: Maybe HWND -> IO HDC getWindowDC mb_wnd = failIfNull "GetWindowDC" $ c_GetWindowDC (maybePtr mb_wnd) foreign import stdcall unsafe "windows.h GetWindowDC" c_GetWindowDC :: HWND -> IO HDC releaseDC :: Maybe HWND -> HDC -> IO () releaseDC mb_wnd dc = failIfFalse_ "ReleaseDC" $ c_ReleaseDC (maybePtr mb_wnd) dc foreign import stdcall unsafe "windows.h ReleaseDC" c_ReleaseDC :: HWND -> HDC -> IO Bool getDCOrgEx :: HDC -> IO POINT getDCOrgEx dc = allocaPOINT $ \ p_pt -> do failIfFalse_ "GetDCOrgEx" $ c_GetDCOrgEx dc p_pt peekPOINT p_pt foreign import stdcall unsafe "windows.h GetDCOrgEx" c_GetDCOrgEx :: HDC -> Ptr POINT -> IO Bool ---------------------------------------------------------------- -- Caret ---------------------------------------------------------------- hideCaret :: HWND -> IO () hideCaret wnd = failIfFalse_ "HideCaret" $ c_HideCaret wnd foreign import stdcall unsafe "windows.h HideCaret" c_HideCaret :: HWND -> IO Bool showCaret :: HWND -> IO () showCaret wnd = failIfFalse_ "ShowCaret" $ c_ShowCaret wnd foreign import stdcall unsafe "windows.h ShowCaret" c_ShowCaret :: HWND -> IO Bool -- ToDo: allow arg2 to be NULL or {(HBITMAP)1} createCaret :: HWND -> HBITMAP -> Maybe INT -> Maybe INT -> IO () createCaret wnd bm mb_w mb_h = failIfFalse_ "CreateCaret" $ c_CreateCaret wnd bm (maybeNum mb_w) (maybeNum mb_h) foreign import stdcall unsafe "windows.h CreateCaret" c_CreateCaret :: HWND -> HBITMAP -> INT -> INT -> IO Bool destroyCaret :: IO () destroyCaret = failIfFalse_ "DestroyCaret" $ c_DestroyCaret foreign import stdcall unsafe "windows.h DestroyCaret" c_DestroyCaret :: IO Bool getCaretPos :: IO POINT getCaretPos = allocaPOINT $ \ p_pt -> do failIfFalse_ "GetCaretPos" $ c_GetCaretPos p_pt peekPOINT p_pt foreign import stdcall unsafe "windows.h GetCaretPos" c_GetCaretPos :: Ptr POINT -> IO Bool setCaretPos :: POINT -> IO () setCaretPos (x,y) = failIfFalse_ "SetCaretPos" $ c_SetCaretPos x y foreign import stdcall unsafe "windows.h SetCaretPos" c_SetCaretPos :: LONG -> LONG -> IO Bool -- The remarks on SetCaretBlinkTime are either highly risible or very sad - -- depending on whether you plan to use this function. ---------------------------------------------------------------- -- MSGs and event loops -- -- Note that the following functions have to be reentrant: -- -- DispatchMessage -- SendMessage -- UpdateWindow (I think) -- RedrawWindow (I think) -- -- The following dont have to be reentrant (according to documentation) -- -- GetMessage -- PeekMessage -- TranslateMessage -- -- For Hugs (and possibly NHC too?) this is no big deal. -- For GHC, you have to use casm_GC instead of casm. -- (It might be simpler to just put all this code in another -- file and build it with the appropriate command line option...) ---------------------------------------------------------------- -- type MSG = -- ( HWND -- hwnd; -- , UINT -- message; -- , WPARAM -- wParam; -- , LPARAM -- lParam; -- , DWORD -- time; -- , POINT -- pt; -- ) type LPMSG = Addr allocaMessage :: (LPMSG -> IO a) -> IO a allocaMessage = allocaBytes #{size MSG} -- A NULL window requests messages for any window belonging to this thread. -- a "success" value of 0 indicates that WM_QUIT was received getMessage :: LPMSG -> Maybe HWND -> IO Bool getMessage msg mb_wnd = do res <- failIf (== -1) "GetMessage" $ c_GetMessage msg (maybePtr mb_wnd) 0 0 return (res /= 0) foreign import stdcall "windows.h GetMessageW" c_GetMessage :: LPMSG -> HWND -> UINT -> UINT -> IO LONG -- A NULL window requests messages for any window belonging to this thread. -- Arguably the code block shouldn't be a 'safe' one, but it shouldn't really -- hurt. peekMessage :: LPMSG -> Maybe HWND -> UINT -> UINT -> UINT -> IO () peekMessage msg mb_wnd filterMin filterMax remove = do failIf (== -1) "PeekMessage" $ c_PeekMessage msg (maybePtr mb_wnd) filterMin filterMax remove return () foreign import stdcall "windows.h PeekMessageW" c_PeekMessage :: LPMSG -> HWND -> UINT -> UINT -> UINT -> IO LONG -- Note: you're not supposed to call this if you're using accelerators foreign import stdcall "windows.h TranslateMessage" translateMessage :: LPMSG -> IO BOOL updateWindow :: HWND -> IO () updateWindow wnd = failIfFalse_ "UpdateWindow" $ c_UpdateWindow wnd foreign import stdcall "windows.h UpdateWindow" c_UpdateWindow :: HWND -> IO Bool -- Return value of DispatchMessage is usually ignored foreign import stdcall "windows.h DispatchMessageW" dispatchMessage :: LPMSG -> IO LONG foreign import stdcall "windows.h SendMessageW" sendMessage :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT ---------------------------------------------------------------- -- ToDo: figure out reentrancy stuff -- ToDo: catch error codes -- -- ToDo: how to send HWND_BROADCAST to PostMessage -- %fun PostMessage :: MbHWND -> WindowMessage -> WPARAM -> LPARAM -> IO () -- %fun PostQuitMessage :: Int -> IO () -- %fun PostThreadMessage :: DWORD -> WindowMessage -> WPARAM -> LPARAM -> IO () -- %fun InSendMessage :: IO Bool ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/Graphics/Win32.hs0000644006511100651110000000246410504340503020441 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Graphics.Win32 -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- An interface to the Microsoft Windows user interface. -- See under /User Interface Design -- and Development/ and then /Windows User Interface/ for more details -- of the underlying library. -- ----------------------------------------------------------------------------- module Graphics.Win32 ( module System.Win32.Types, module Graphics.Win32.Control, module Graphics.Win32.Dialogue, module Graphics.Win32.GDI, module Graphics.Win32.Icon, module Graphics.Win32.Key, module Graphics.Win32.Menu, module Graphics.Win32.Message, module Graphics.Win32.Misc, module Graphics.Win32.Resource, module Graphics.Win32.Window ) where import System.Win32.Types import Graphics.Win32.Control import Graphics.Win32.Dialogue import Graphics.Win32.GDI import Graphics.Win32.Icon import Graphics.Win32.Key import Graphics.Win32.Menu import Graphics.Win32.Message import Graphics.Win32.Misc import Graphics.Win32.Resource import Graphics.Win32.Window hugs98-plus-Sep2006/packages/Win32/System/0000755006511100651110000000000010504340503016721 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/System/Win32/0000755006511100651110000000000010504340503017623 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/System/Win32/Process.hsc0000644006511100651110000001132110504340503021736 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.Process -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module System.Win32.Process where import Control.Exception ( bracket ) import Control.Monad ( liftM5 ) import Foreign ( Ptr, peekByteOff, allocaBytes, pokeByteOff , plusPtr ) import System.Win32.File ( closeHandle ) import System.Win32.Types #include #include -- constant to wait for a very long time. iNFINITE :: DWORD iNFINITE = #{const INFINITE} foreign import stdcall unsafe "windows.h Sleep" sleep :: DWORD -> IO () type ProcessId = DWORD type ProcessHandle = HANDLE type ProcessAccessRights = DWORD #{enum ProcessAccessRights, , pROCESS_ALL_ACCESS = PROCESS_ALL_ACCESS , pROCESS_CREATE_PROCESS = PROCESS_CREATE_PROCESS , pROCESS_CREATE_THREAD = PROCESS_CREATE_THREAD , pROCESS_DUP_HANDLE = PROCESS_DUP_HANDLE , pROCESS_QUERY_INFORMATION = PROCESS_QUERY_INFORMATION , pROCESS_SET_QUOTA = PROCESS_SET_QUOTA , pROCESS_SET_INFORMATION = PROCESS_SET_INFORMATION , pROCESS_TERMINATE = PROCESS_TERMINATE , pROCESS_VM_OPERATION = PROCESS_VM_OPERATION , pROCESS_VM_READ = PROCESS_VM_READ , pROCESS_VM_WRITE = PROCESS_VM_WRITE , sYNCHORNIZE = SYNCHRONIZE } foreign import stdcall unsafe "windows.h OpenProcess" c_OpenProcess :: ProcessAccessRights -> BOOL -> ProcessId -> IO ProcessHandle openProcess :: ProcessAccessRights -> BOOL -> ProcessId -> IO ProcessHandle openProcess r inh i = failIfNull "OpenProcess" $ c_OpenProcess r inh i type Th32SnapHandle = HANDLE type Th32SnapFlags = DWORD -- | ProcessId, number of threads, parent ProcessId, process base priority, path of executable file type ProcessEntry32 = (ProcessId, Int, ProcessId, LONG, String) #{enum Th32SnapFlags, , tH32CS_SNAPALL = TH32CS_SNAPALL , tH32CS_SNAPHEAPLIST = TH32CS_SNAPHEAPLIST , tH32CS_SNAPMODULE = TH32CS_SNAPMODULE , tH32CS_SNAPPROCESS = TH32CS_SNAPPROCESS , tH32CS_SNAPTHREAD = TH32CS_SNAPTHREAD } {- , tH32CS_SNAPGETALLMODS = TH32CS_GETALLMODS , tH32CS_SNAPNOHEAPS = TH32CS_SNAPNOHEAPS -} foreign import stdcall unsafe "tlhelp32.h CreateToolhelp32Snapshot" c_CreateToolhelp32Snapshot :: Th32SnapFlags -> ProcessId -> IO Th32SnapHandle foreign import stdcall unsafe "tlhelp32.h Process32FirstW" c_Process32First :: Th32SnapHandle -> Ptr ProcessEntry32 -> IO BOOL foreign import stdcall unsafe "tlhelp32.h Process32NextW" c_Process32Next :: Th32SnapHandle -> Ptr ProcessEntry32 -> IO BOOL -- | Create a snapshot of specified resources. Call closeHandle to close snapshot. createToolhelp32Snapshot :: Th32SnapFlags -> Maybe ProcessId -> IO Th32SnapHandle createToolhelp32Snapshot f p = failIfNull "CreateToolhelp32Snapshot" $ c_CreateToolhelp32Snapshot f (maybe 0 id p) withTh32Snap :: Th32SnapFlags -> Maybe ProcessId -> (Th32SnapHandle -> IO a) -> IO a withTh32Snap f p = bracket (createToolhelp32Snapshot f p) (closeHandle) peekProcessEntry32 :: Ptr ProcessEntry32 -> IO ProcessEntry32 peekProcessEntry32 buf = liftM5 (,,,,) ((#peek PROCESSENTRY32, th32ProcessID) buf) ((#peek PROCESSENTRY32, cntThreads) buf) ((#peek PROCESSENTRY32, th32ParentProcessID) buf) ((#peek PROCESSENTRY32, pcPriClassBase) buf) (peekTString $ (#ptr PROCESSENTRY32, szExeFile) buf) -- | Enumerate processes using Process32First and Process32Next th32SnapEnumProcesses :: Th32SnapHandle -> IO [ProcessEntry32] th32SnapEnumProcesses h = allocaBytes (#size PROCESSENTRY32) $ \pe -> do putStrLn "1" (#poke PROCESSENTRY32, dwSize) pe ((#size PROCESSENTRY32)::DWORD) putStrLn "2" ok <- c_Process32First h pe putStrLn "3" readAndNext ok pe [] where readAndNext ok pe res | not ok = do err <- getLastError print err if err==(#const ERROR_NO_MORE_FILES) then return $ reverse res else failWith "th32SnapEnumProcesses: Process32First/Process32Next" err | otherwise = do putStrLn "reading" entry <- peekProcessEntry32 pe ok' <- c_Process32Next h pe readAndNext ok' pe (entry:res) hugs98-plus-Sep2006/packages/Win32/System/Win32/DLL.hsc0000644006511100651110000000545410504340503020745 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.DLL -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module System.Win32.DLL where import System.Win32.Types import Foreign import Foreign.C #include disableThreadLibraryCalls :: HMODULE -> IO () disableThreadLibraryCalls hmod = failIfFalse_ "DisableThreadLibraryCalls" $ c_DisableThreadLibraryCalls hmod foreign import stdcall unsafe "windows.h DisableThreadLibraryCalls" c_DisableThreadLibraryCalls :: HMODULE -> IO Bool freeLibrary :: HMODULE -> IO () freeLibrary hmod = failIfFalse_ "FreeLibrary" $ c_FreeLibrary hmod foreign import stdcall unsafe "windows.h FreeLibrary" c_FreeLibrary :: HMODULE -> IO Bool {-# CFILES cbits/HsWin32.c #-} foreign import ccall "HsWin32.h &FreeLibraryFinaliser" c_FreeLibraryFinaliser :: FunPtr (HMODULE -> IO ()) getModuleFileName :: HMODULE -> IO String getModuleFileName hmod = allocaArray 512 $ \ c_str -> do failIfFalse_ "GetModuleFileName" $ c_GetModuleFileName hmod c_str 512 peekTString c_str foreign import stdcall unsafe "windows.h GetModuleFileNameW" c_GetModuleFileName :: HMODULE -> LPTSTR -> Int -> IO Bool getModuleHandle :: Maybe String -> IO HMODULE getModuleHandle mb_name = maybeWith withTString mb_name $ \ c_name -> failIfNull "GetModuleHandle" $ c_GetModuleHandle c_name foreign import stdcall unsafe "windows.h GetModuleHandleW" c_GetModuleHandle :: LPCTSTR -> IO HMODULE getProcAddress :: HMODULE -> String -> IO Addr getProcAddress hmod procname = withCString procname $ \ c_procname -> failIfNull "GetProcAddress" $ c_GetProcAddress hmod c_procname foreign import stdcall unsafe "windows.h GetProcAddress" c_GetProcAddress :: HMODULE -> LPCSTR -> IO Addr loadLibrary :: String -> IO HINSTANCE loadLibrary name = withTString name $ \ c_name -> failIfNull "LoadLibrary" $ c_LoadLibrary c_name foreign import stdcall unsafe "windows.h LoadLibraryW" c_LoadLibrary :: LPCTSTR -> IO HINSTANCE type LoadLibraryFlags = DWORD #{enum LoadLibraryFlags, , lOAD_LIBRARY_AS_DATAFILE = LOAD_LIBRARY_AS_DATAFILE , lOAD_WITH_ALTERED_SEARCH_PATH = LOAD_WITH_ALTERED_SEARCH_PATH } loadLibraryEx :: String -> HANDLE -> LoadLibraryFlags -> IO HINSTANCE loadLibraryEx name h flags = withTString name $ \ c_name -> failIfNull "LoadLibraryEx" $ c_LoadLibraryEx c_name h flags foreign import stdcall unsafe "windows.h LoadLibraryExW" c_LoadLibraryEx :: LPCTSTR -> HANDLE -> LoadLibraryFlags -> IO HINSTANCE hugs98-plus-Sep2006/packages/Win32/System/Win32/File.hsc0000644006511100651110000004603310504340503021207 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.File -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module System.Win32.File {- ( AccessMode, ShareMode, CreateMode, FileAttributeOrFlag , CreateFile, CloseHandle, DeleteFile, CopyFile , MoveFileFlag, MoveFile, MoveFileEx, ) -} where import System.Win32.Types import System.Win32.Time import Foreign #include ---------------------------------------------------------------- -- Enumeration types ---------------------------------------------------------------- type AccessMode = UINT gENERIC_NONE :: AccessMode gENERIC_NONE = 0 #{enum AccessMode, , gENERIC_READ = GENERIC_READ , gENERIC_WRITE = GENERIC_WRITE , gENERIC_EXECUTE = GENERIC_EXECUTE , gENERIC_ALL = GENERIC_ALL , dELETE = DELETE , rEAD_CONTROL = READ_CONTROL , wRITE_DAC = WRITE_DAC , wRITE_OWNER = WRITE_OWNER , sYNCHRONIZE = SYNCHRONIZE , sTANDARD_RIGHTS_REQUIRED = STANDARD_RIGHTS_REQUIRED , sTANDARD_RIGHTS_READ = STANDARD_RIGHTS_READ , sTANDARD_RIGHTS_WRITE = STANDARD_RIGHTS_WRITE , sTANDARD_RIGHTS_EXECUTE = STANDARD_RIGHTS_EXECUTE , sTANDARD_RIGHTS_ALL = STANDARD_RIGHTS_ALL , sPECIFIC_RIGHTS_ALL = SPECIFIC_RIGHTS_ALL , aCCESS_SYSTEM_SECURITY = ACCESS_SYSTEM_SECURITY , mAXIMUM_ALLOWED = MAXIMUM_ALLOWED } ---------------------------------------------------------------- type ShareMode = UINT fILE_SHARE_NONE :: ShareMode fILE_SHARE_NONE = 0 #{enum ShareMode, , fILE_SHARE_READ = FILE_SHARE_READ , fILE_SHARE_WRITE = FILE_SHARE_WRITE } ---------------------------------------------------------------- type CreateMode = UINT #{enum CreateMode, , cREATE_NEW = CREATE_NEW , cREATE_ALWAYS = CREATE_ALWAYS , oPEN_EXISTING = OPEN_EXISTING , oPEN_ALWAYS = OPEN_ALWAYS , tRUNCATE_EXISTING = TRUNCATE_EXISTING } ---------------------------------------------------------------- type FileAttributeOrFlag = UINT #{enum FileAttributeOrFlag, , fILE_ATTRIBUTE_READONLY = FILE_ATTRIBUTE_READONLY , fILE_ATTRIBUTE_HIDDEN = FILE_ATTRIBUTE_HIDDEN , fILE_ATTRIBUTE_SYSTEM = FILE_ATTRIBUTE_SYSTEM , fILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY , fILE_ATTRIBUTE_ARCHIVE = FILE_ATTRIBUTE_ARCHIVE , fILE_ATTRIBUTE_NORMAL = FILE_ATTRIBUTE_NORMAL , fILE_ATTRIBUTE_TEMPORARY = FILE_ATTRIBUTE_TEMPORARY , fILE_ATTRIBUTE_COMPRESSED = FILE_ATTRIBUTE_COMPRESSED , fILE_FLAG_WRITE_THROUGH = FILE_FLAG_WRITE_THROUGH , fILE_FLAG_OVERLAPPED = FILE_FLAG_OVERLAPPED , fILE_FLAG_NO_BUFFERING = FILE_FLAG_NO_BUFFERING , fILE_FLAG_RANDOM_ACCESS = FILE_FLAG_RANDOM_ACCESS , fILE_FLAG_SEQUENTIAL_SCAN = FILE_FLAG_SEQUENTIAL_SCAN , fILE_FLAG_DELETE_ON_CLOSE = FILE_FLAG_DELETE_ON_CLOSE , fILE_FLAG_BACKUP_SEMANTICS = FILE_FLAG_BACKUP_SEMANTICS , fILE_FLAG_POSIX_SEMANTICS = FILE_FLAG_POSIX_SEMANTICS } #ifndef __WINE_WINDOWS_H #{enum FileAttributeOrFlag, , sECURITY_ANONYMOUS = SECURITY_ANONYMOUS , sECURITY_IDENTIFICATION = SECURITY_IDENTIFICATION , sECURITY_IMPERSONATION = SECURITY_IMPERSONATION , sECURITY_DELEGATION = SECURITY_DELEGATION , sECURITY_CONTEXT_TRACKING = SECURITY_CONTEXT_TRACKING , sECURITY_EFFECTIVE_ONLY = SECURITY_EFFECTIVE_ONLY , sECURITY_SQOS_PRESENT = SECURITY_SQOS_PRESENT , sECURITY_VALID_SQOS_FLAGS = SECURITY_VALID_SQOS_FLAGS } #endif ---------------------------------------------------------------- type MoveFileFlag = DWORD #{enum MoveFileFlag, , mOVEFILE_REPLACE_EXISTING = MOVEFILE_REPLACE_EXISTING , mOVEFILE_COPY_ALLOWED = MOVEFILE_COPY_ALLOWED , mOVEFILE_DELAY_UNTIL_REBOOT = MOVEFILE_DELAY_UNTIL_REBOOT } ---------------------------------------------------------------- type FilePtrDirection = DWORD #{enum FilePtrDirection, , fILE_BEGIN = FILE_BEGIN , fILE_CURRENT = FILE_CURRENT , fILE_END = FILE_END } ---------------------------------------------------------------- type DriveType = UINT #{enum DriveType, , dRIVE_UNKNOWN = DRIVE_UNKNOWN , dRIVE_NO_ROOT_DIR = DRIVE_NO_ROOT_DIR , dRIVE_REMOVABLE = DRIVE_REMOVABLE , dRIVE_FIXED = DRIVE_FIXED , dRIVE_REMOTE = DRIVE_REMOTE , dRIVE_CDROM = DRIVE_CDROM , dRIVE_RAMDISK = DRIVE_RAMDISK } ---------------------------------------------------------------- type DefineDosDeviceFlags = DWORD #{enum DefineDosDeviceFlags, , dDD_RAW_TARGET_PATH = DDD_RAW_TARGET_PATH , dDD_REMOVE_DEFINITION = DDD_REMOVE_DEFINITION , dDD_EXACT_MATCH_ON_REMOVE = DDD_EXACT_MATCH_ON_REMOVE } ---------------------------------------------------------------- type BinaryType = DWORD #{enum BinaryType, , sCS_32BIT_BINARY = SCS_32BIT_BINARY , sCS_DOS_BINARY = SCS_DOS_BINARY , sCS_WOW_BINARY = SCS_WOW_BINARY , sCS_PIF_BINARY = SCS_PIF_BINARY , sCS_POSIX_BINARY = SCS_POSIX_BINARY , sCS_OS216_BINARY = SCS_OS216_BINARY } ---------------------------------------------------------------- type FileNotificationFlag = DWORD #{enum FileNotificationFlag, , fILE_NOTIFY_CHANGE_FILE_NAME = FILE_NOTIFY_CHANGE_FILE_NAME , fILE_NOTIFY_CHANGE_DIR_NAME = FILE_NOTIFY_CHANGE_DIR_NAME , fILE_NOTIFY_CHANGE_ATTRIBUTES = FILE_NOTIFY_CHANGE_ATTRIBUTES , fILE_NOTIFY_CHANGE_SIZE = FILE_NOTIFY_CHANGE_SIZE , fILE_NOTIFY_CHANGE_LAST_WRITE = FILE_NOTIFY_CHANGE_LAST_WRITE , fILE_NOTIFY_CHANGE_SECURITY = FILE_NOTIFY_CHANGE_SECURITY } ---------------------------------------------------------------- type FileType = DWORD #{enum FileType, , fILE_TYPE_UNKNOWN = FILE_TYPE_UNKNOWN , fILE_TYPE_DISK = FILE_TYPE_DISK , fILE_TYPE_CHAR = FILE_TYPE_CHAR , fILE_TYPE_PIPE = FILE_TYPE_PIPE , fILE_TYPE_REMOTE = FILE_TYPE_REMOTE } ---------------------------------------------------------------- type LPSECURITY_ATTRIBUTES = Ptr () type MbLPSECURITY_ATTRIBUTES = Maybe LPSECURITY_ATTRIBUTES ---------------------------------------------------------------- -- Other types ---------------------------------------------------------------- data BY_HANDLE_FILE_INFORMATION = BY_HANDLE_FILE_INFORMATION { bhfiFileAttributes :: FileAttributeOrFlag , bhfiCreationTime, bhfiLastAccessTime, bhfiLastWriteTime :: FILETIME , bhfiVolumeSerialNumber :: DWORD , bhfiSize :: DDWORD , bhfiNumberOfLinks :: DWORD , bhfiFileIndex :: DDWORD } deriving (Show) instance Storable BY_HANDLE_FILE_INFORMATION where sizeOf = const (#size BY_HANDLE_FILE_INFORMATION) alignment = sizeOf poke buf bhi = do (#poke BY_HANDLE_FILE_INFORMATION, dwFileAttributes) buf (bhfiFileAttributes bhi) (#poke BY_HANDLE_FILE_INFORMATION, ftCreationTime) buf (bhfiCreationTime bhi) (#poke BY_HANDLE_FILE_INFORMATION, ftLastAccessTime) buf (bhfiLastAccessTime bhi) (#poke BY_HANDLE_FILE_INFORMATION, ftLastWriteTime) buf (bhfiLastWriteTime bhi) (#poke BY_HANDLE_FILE_INFORMATION, dwVolumeSerialNumber) buf (bhfiVolumeSerialNumber bhi) (#poke BY_HANDLE_FILE_INFORMATION, nFileSizeHigh) buf sizeHi (#poke BY_HANDLE_FILE_INFORMATION, nFileSizeLow) buf sizeLow (#poke BY_HANDLE_FILE_INFORMATION, nNumberOfLinks) buf (bhfiNumberOfLinks bhi) (#poke BY_HANDLE_FILE_INFORMATION, nFileIndexHigh) buf idxHi (#poke BY_HANDLE_FILE_INFORMATION, nFileIndexLow) buf idxLow where (sizeHi,sizeLow) = ddwordToDwords $ bhfiSize bhi (idxHi,idxLow) = ddwordToDwords $ bhfiFileIndex bhi peek buf = do attr <- (#peek BY_HANDLE_FILE_INFORMATION, dwFileAttributes) buf ctim <- (#peek BY_HANDLE_FILE_INFORMATION, ftCreationTime) buf lati <- (#peek BY_HANDLE_FILE_INFORMATION, ftLastAccessTime) buf lwti <- (#peek BY_HANDLE_FILE_INFORMATION, ftLastWriteTime) buf vser <- (#peek BY_HANDLE_FILE_INFORMATION, dwVolumeSerialNumber) buf fshi <- (#peek BY_HANDLE_FILE_INFORMATION, nFileSizeHigh) buf fslo <- (#peek BY_HANDLE_FILE_INFORMATION, nFileSizeLow) buf link <- (#peek BY_HANDLE_FILE_INFORMATION, nNumberOfLinks) buf idhi <- (#peek BY_HANDLE_FILE_INFORMATION, nFileIndexHigh) buf idlo <- (#peek BY_HANDLE_FILE_INFORMATION, nFileIndexLow) buf return $ BY_HANDLE_FILE_INFORMATION attr ctim lati lwti vser (dwordsToDdword (fshi,fslo)) link (dwordsToDdword (idhi,idlo)) ---------------------------------------------------------------- -- File operations ---------------------------------------------------------------- deleteFile :: String -> IO () deleteFile name = withTString name $ \ c_name -> failIfFalse_ "DeleteFile" $ c_DeleteFile c_name foreign import stdcall unsafe "windows.h DeleteFileW" c_DeleteFile :: LPCTSTR -> IO Bool copyFile :: String -> String -> Bool -> IO () copyFile src dest over = withTString src $ \ c_src -> withTString dest $ \ c_dest -> failIfFalse_ "CopyFile" $ c_CopyFile c_src c_dest over foreign import stdcall unsafe "windows.h CopyFileW" c_CopyFile :: LPCTSTR -> LPCTSTR -> Bool -> IO Bool moveFile :: String -> String -> IO () moveFile src dest = withTString src $ \ c_src -> withTString dest $ \ c_dest -> failIfFalse_ "MoveFile" $ c_MoveFile c_src c_dest foreign import stdcall unsafe "windows.h MoveFileW" c_MoveFile :: LPCTSTR -> LPCTSTR -> IO Bool moveFileEx :: String -> String -> MoveFileFlag -> IO () moveFileEx src dest flags = withTString src $ \ c_src -> withTString dest $ \ c_dest -> failIfFalse_ "MoveFileEx" $ c_MoveFileEx c_src c_dest flags foreign import stdcall unsafe "windows.h MoveFileExW" c_MoveFileEx :: LPCTSTR -> LPCTSTR -> MoveFileFlag -> IO Bool setCurrentDirectory :: String -> IO () setCurrentDirectory name = withTString name $ \ c_name -> failIfFalse_ "SetCurrentDirectory" $ c_SetCurrentDirectory c_name foreign import stdcall unsafe "windows.h SetCurrentDirectoryW" c_SetCurrentDirectory :: LPCTSTR -> IO Bool createDirectory :: String -> Maybe LPSECURITY_ATTRIBUTES -> IO () createDirectory name mb_attr = withTString name $ \ c_name -> failIfFalse_ "CreateDirectory" $ c_CreateDirectory c_name (maybePtr mb_attr) foreign import stdcall unsafe "windows.h CreateDirectoryW" c_CreateDirectory :: LPCTSTR -> LPSECURITY_ATTRIBUTES -> IO Bool createDirectoryEx :: String -> String -> Maybe LPSECURITY_ATTRIBUTES -> IO () createDirectoryEx template name mb_attr = withTString template $ \ c_template -> withTString name $ \ c_name -> failIfFalse_ "CreateDirectoryEx" $ c_CreateDirectoryEx c_template c_name (maybePtr mb_attr) foreign import stdcall unsafe "windows.h CreateDirectoryExW" c_CreateDirectoryEx :: LPCTSTR -> LPCTSTR -> LPSECURITY_ATTRIBUTES -> IO Bool removeDirectory :: String -> IO () removeDirectory name = withTString name $ \ c_name -> failIfFalse_ "RemoveDirectory" $ c_RemoveDirectory c_name foreign import stdcall unsafe "windows.h RemoveDirectoryW" c_RemoveDirectory :: LPCTSTR -> IO Bool getBinaryType :: String -> IO BinaryType getBinaryType name = withTString name $ \ c_name -> alloca $ \ p_btype -> do failIfFalse_ "GetBinaryType" $ c_GetBinaryType c_name p_btype peek p_btype foreign import stdcall unsafe "windows.h GetBinaryTypeW" c_GetBinaryType :: LPCTSTR -> Ptr DWORD -> IO Bool ---------------------------------------------------------------- -- HANDLE operations ---------------------------------------------------------------- createFile :: String -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE createFile name access share mb_attr mode flag mb_h = withTString name $ \ c_name -> failIf (==iNVALID_HANDLE_VALUE) "CreateFile" $ c_CreateFile c_name access share (maybePtr mb_attr) mode flag (maybePtr mb_h) foreign import stdcall unsafe "windows.h CreateFileW" c_CreateFile :: LPCTSTR -> AccessMode -> ShareMode -> LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> HANDLE -> IO HANDLE closeHandle :: HANDLE -> IO () closeHandle h = failIfFalse_ "CloseHandle" $ c_CloseHandle h foreign import stdcall unsafe "windows.h CloseHandle" c_CloseHandle :: HANDLE -> IO Bool {-# CFILES cbits/HsWin32.c #-} foreign import ccall "HsWin32.h &CloseHandleFinaliser" c_CloseHandleFinaliser :: FunPtr (Ptr a -> IO ()) foreign import stdcall unsafe "windows.h GetFileType" getFileType :: HANDLE -> IO FileType --Apparently no error code flushFileBuffers :: HANDLE -> IO () flushFileBuffers h = failIfFalse_ "FlushFileBuffers" $ c_FlushFileBuffers h foreign import stdcall unsafe "windows.h FlushFileBuffers" c_FlushFileBuffers :: HANDLE -> IO Bool setEndOfFile :: HANDLE -> IO () setEndOfFile h = failIfFalse_ "SetEndOfFile" $ c_SetEndOfFile h foreign import stdcall unsafe "windows.h SetEndOfFile" c_SetEndOfFile :: HANDLE -> IO Bool setFileAttributes :: String -> FileAttributeOrFlag -> IO () setFileAttributes name attr = withTString name $ \ c_name -> failIfFalse_ "SetFileAttributes" $ c_SetFileAttributes c_name attr foreign import stdcall unsafe "windows.h SetFileAttributesW" c_SetFileAttributes :: LPCTSTR -> FileAttributeOrFlag -> IO Bool getFileAttributes :: String -> IO FileAttributeOrFlag getFileAttributes name = withTString name $ \ c_name -> failIf (== 0xFFFFFFFF) "GetFileAttributes" $ c_GetFileAttributes c_name foreign import stdcall unsafe "windows.h GetFileAttributesW" c_GetFileAttributes :: LPCTSTR -> IO FileAttributeOrFlag getFileInformationByHandle :: HANDLE -> IO BY_HANDLE_FILE_INFORMATION getFileInformationByHandle h = alloca $ \res -> do failIfFalse_ "GetFileInformationByHandle" $ c_GetFileInformationByHandle h res peek res foreign import stdcall unsafe "windows.h GetFileInformationByHandle" c_GetFileInformationByHandle :: HANDLE -> Ptr BY_HANDLE_FILE_INFORMATION -> IO BOOL ---------------------------------------------------------------- -- Read/write files ---------------------------------------------------------------- -- No support for this yet --type OVERLAPPED = -- (DWORD, -- Offset -- DWORD, -- OffsetHigh -- HANDLE) -- hEvent type LPOVERLAPPED = Ptr () type MbLPOVERLAPPED = Maybe LPOVERLAPPED --Sigh - I give up & prefix win32_ to the next two to avoid -- senseless Prelude name clashes. --sof. win32_ReadFile :: HANDLE -> Ptr a -> DWORD -> Maybe LPOVERLAPPED -> IO DWORD win32_ReadFile h buf n mb_over = alloca $ \ p_n -> do failIfFalse_ "ReadFile" $ c_ReadFile h buf n p_n (maybePtr mb_over) peek p_n foreign import stdcall unsafe "windows.h ReadFile" c_ReadFile :: HANDLE -> Ptr a -> DWORD -> Ptr DWORD -> LPOVERLAPPED -> IO Bool win32_WriteFile :: HANDLE -> Ptr a -> DWORD -> Maybe LPOVERLAPPED -> IO DWORD win32_WriteFile h buf n mb_over = alloca $ \ p_n -> do failIfFalse_ "WriteFile" $ c_WriteFile h buf n p_n (maybePtr mb_over) peek p_n foreign import stdcall unsafe "windows.h WriteFile" c_WriteFile :: HANDLE -> Ptr a -> DWORD -> Ptr DWORD -> LPOVERLAPPED -> IO Bool -- missing Seek functioinality; GSL ??? -- Dont have Word64; ADR -- %fun SetFilePointer :: HANDLE -> Word64 -> FilePtrDirection -> IO Word64 ---------------------------------------------------------------- -- File Notifications -- -- Use these to initialise, "increment" and close a HANDLE you can wait -- on. ---------------------------------------------------------------- findFirstChangeNotification :: String -> Bool -> FileNotificationFlag -> IO HANDLE findFirstChangeNotification path watch flag = withTString path $ \ c_path -> failIfNull "FindFirstChangeNotification" $ c_FindFirstChangeNotification c_path watch flag foreign import stdcall unsafe "windows.h FindFirstChangeNotificationW" c_FindFirstChangeNotification :: LPCTSTR -> Bool -> FileNotificationFlag -> IO HANDLE findNextChangeNotification :: HANDLE -> IO () findNextChangeNotification h = failIfFalse_ "FindNextChangeNotification" $ c_FindNextChangeNotification h foreign import stdcall unsafe "windows.h FindNextChangeNotification" c_FindNextChangeNotification :: HANDLE -> IO Bool findCloseChangeNotification :: HANDLE -> IO () findCloseChangeNotification h = failIfFalse_ "FindCloseChangeNotification" $ c_FindCloseChangeNotification h foreign import stdcall unsafe "windows.h FindCloseChangeNotification" c_FindCloseChangeNotification :: HANDLE -> IO Bool ---------------------------------------------------------------- -- DOS Device flags ---------------------------------------------------------------- defineDosDevice :: DefineDosDeviceFlags -> String -> String -> IO () defineDosDevice flags name path = withTString path $ \ c_path -> withTString name $ \ c_name -> failIfFalse_ "DefineDosDevice" $ c_DefineDosDevice flags c_name c_path foreign import stdcall unsafe "windows.h DefineDosDeviceW" c_DefineDosDevice :: DefineDosDeviceFlags -> LPCTSTR -> LPCTSTR -> IO Bool ---------------------------------------------------------------- -- These functions are very unusual in the Win32 API: -- They dont return error codes foreign import stdcall unsafe "windows.h AreFileApisANSI" areFileApisANSI :: IO Bool foreign import stdcall unsafe "windows.h SetFileApisToOEM" setFileApisToOEM :: IO () foreign import stdcall unsafe "windows.h SetFileApisToANSI" setFileApisToANSI :: IO () foreign import stdcall unsafe "windows.h SetHandleCount" setHandleCount :: UINT -> IO UINT ---------------------------------------------------------------- getLogicalDrives :: IO DWORD getLogicalDrives = failIfZero "GetLogicalDrives" $ c_GetLogicalDrives foreign import stdcall unsafe "windows.h GetLogicalDrives" c_GetLogicalDrives :: IO DWORD -- %fun GetDriveType :: Maybe String -> IO DriveType getDiskFreeSpace :: Maybe String -> IO (DWORD,DWORD,DWORD,DWORD) getDiskFreeSpace path = maybeWith withTString path $ \ c_path -> alloca $ \ p_sectors -> alloca $ \ p_bytes -> alloca $ \ p_nfree -> alloca $ \ p_nclusters -> do failIfFalse_ "GetDiskFreeSpace" $ c_GetDiskFreeSpace c_path p_sectors p_bytes p_nfree p_nclusters sectors <- peek p_sectors bytes <- peek p_bytes nfree <- peek p_nfree nclusters <- peek p_nclusters return (sectors, bytes, nfree, nclusters) foreign import stdcall unsafe "windows.h GetDiskFreeSpaceW" c_GetDiskFreeSpace :: LPCTSTR -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> IO Bool setVolumeLabel :: String -> String -> IO () setVolumeLabel path name = withTString path $ \ c_path -> withTString name $ \ c_name -> failIfFalse_ "SetVolumeLabel" $ c_SetVolumeLabel c_path c_name foreign import stdcall unsafe "windows.h SetVolumeLabelW" c_SetVolumeLabel :: LPCTSTR -> LPCTSTR -> IO Bool ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/System/Win32/Info.hsc0000644006511100651110000003012010504340503021211 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.Info -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module System.Win32.Info where import System.Win32.Types import Foreign ( Storable(sizeOf, alignment, peekByteOff, pokeByteOff, peek, poke) , Ptr, alloca ) #include ---------------------------------------------------------------- -- Environment Strings ---------------------------------------------------------------- -- %fun ExpandEnvironmentStrings :: String -> IO String ---------------------------------------------------------------- -- Computer Name ---------------------------------------------------------------- -- %fun GetComputerName :: IO String -- %fun SetComputerName :: String -> IO () -- %end free(arg1) ---------------------------------------------------------------- -- Hardware Profiles ---------------------------------------------------------------- -- %fun GetCurrentHwProfile :: IO HW_PROFILE_INFO ---------------------------------------------------------------- -- Keyboard Type ---------------------------------------------------------------- -- %fun GetKeyboardType :: KeyboardTypeKind -> IO KeyboardType ---------------------------------------------------------------- -- System Color ---------------------------------------------------------------- type SystemColor = UINT -- ToDo: This list is out of date. #{enum SystemColor, , cOLOR_SCROLLBAR = COLOR_SCROLLBAR , cOLOR_BACKGROUND = COLOR_BACKGROUND , cOLOR_ACTIVECAPTION = COLOR_ACTIVECAPTION , cOLOR_INACTIVECAPTION = COLOR_INACTIVECAPTION , cOLOR_MENU = COLOR_MENU , cOLOR_WINDOW = COLOR_WINDOW , cOLOR_WINDOWFRAME = COLOR_WINDOWFRAME , cOLOR_MENUTEXT = COLOR_MENUTEXT , cOLOR_WINDOWTEXT = COLOR_WINDOWTEXT , cOLOR_CAPTIONTEXT = COLOR_CAPTIONTEXT , cOLOR_ACTIVEBORDER = COLOR_ACTIVEBORDER , cOLOR_INACTIVEBORDER = COLOR_INACTIVEBORDER , cOLOR_APPWORKSPACE = COLOR_APPWORKSPACE , cOLOR_HIGHLIGHT = COLOR_HIGHLIGHT , cOLOR_HIGHLIGHTTEXT = COLOR_HIGHLIGHTTEXT , cOLOR_BTNFACE = COLOR_BTNFACE , cOLOR_BTNSHADOW = COLOR_BTNSHADOW , cOLOR_GRAYTEXT = COLOR_GRAYTEXT , cOLOR_BTNTEXT = COLOR_BTNTEXT , cOLOR_INACTIVECAPTIONTEXT = COLOR_INACTIVECAPTIONTEXT , cOLOR_BTNHIGHLIGHT = COLOR_BTNHIGHLIGHT } -- %fun GetSysColor :: SystemColor -> IO COLORREF -- %fun SetSysColors :: [(SystemColor,COLORREF)] -> IO () ---------------------------------------------------------------- -- Standard Directories ---------------------------------------------------------------- -- %fun GetSystemDirectory :: IO String -- %fun GetWindowsDirectory :: IO String ---------------------------------------------------------------- -- System Info (Info about processor and memory subsystem) ---------------------------------------------------------------- data ProcessorArchitecture = PaUnknown WORD | PaIntel | PaMips | PaAlpha | PaPpc | PaIa64 | PaIa32OnIa64 | PaAmd64 deriving (Show,Eq) instance Storable ProcessorArchitecture where sizeOf _ = sizeOf (undefined::WORD) alignment _ = alignment (undefined::WORD) poke buf pa = pokeByteOff buf 0 $ case pa of PaUnknown w -> w PaIntel -> #const PROCESSOR_ARCHITECTURE_INTEL PaMips -> #const PROCESSOR_ARCHITECTURE_MIPS PaAlpha -> #const PROCESSOR_ARCHITECTURE_ALPHA PaPpc -> #const PROCESSOR_ARCHITECTURE_PPC PaIa64 -> #const PROCESSOR_ARCHITECTURE_IA64 #ifndef __WINE_WINDOWS_H PaIa32OnIa64 -> #const PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 #endif PaAmd64 -> #const PROCESSOR_ARCHITECTURE_AMD64 peek buf = do v <- (peekByteOff buf 0:: IO WORD) return $ case v of (#const PROCESSOR_ARCHITECTURE_INTEL) -> PaIntel (#const PROCESSOR_ARCHITECTURE_MIPS) -> PaMips (#const PROCESSOR_ARCHITECTURE_ALPHA) -> PaAlpha (#const PROCESSOR_ARCHITECTURE_PPC) -> PaPpc (#const PROCESSOR_ARCHITECTURE_IA64) -> PaIa64 #ifndef __WINE_WINDOWS_H (#const PROCESSOR_ARCHITECTURE_IA32_ON_WIN64) -> PaIa32OnIa64 #endif (#const PROCESSOR_ARCHITECTURE_AMD64) -> PaAmd64 w -> PaUnknown w data SYSTEM_INFO = SYSTEM_INFO { siProcessorArchitecture :: ProcessorArchitecture , siPageSize :: DWORD , siMinimumApplicationAddress, siMaximumApplicationAddress :: LPVOID , siActiveProcessorMask :: DWORD , siNumberOfProcessors :: DWORD , siProcessorType :: DWORD , siAllocationGranularity :: DWORD , siProcessorLevel :: WORD , siProcessorRevision :: WORD } deriving (Show) instance Storable SYSTEM_INFO where sizeOf = const #size SYSTEM_INFO alignment = sizeOf poke buf si = do (#poke SYSTEM_INFO, wProcessorArchitecture) buf (siProcessorArchitecture si) (#poke SYSTEM_INFO, dwPageSize) buf (siPageSize si) (#poke SYSTEM_INFO, lpMinimumApplicationAddress) buf (siMinimumApplicationAddress si) (#poke SYSTEM_INFO, lpMaximumApplicationAddress) buf (siMaximumApplicationAddress si) (#poke SYSTEM_INFO, dwActiveProcessorMask) buf (siActiveProcessorMask si) (#poke SYSTEM_INFO, dwNumberOfProcessors) buf (siNumberOfProcessors si) (#poke SYSTEM_INFO, dwProcessorType) buf (siProcessorType si) (#poke SYSTEM_INFO, dwAllocationGranularity) buf (siAllocationGranularity si) (#poke SYSTEM_INFO, wProcessorLevel) buf (siProcessorLevel si) (#poke SYSTEM_INFO, wProcessorRevision) buf (siProcessorRevision si) peek buf = do processorArchitecture <- (#peek SYSTEM_INFO, wProcessorArchitecture) buf pageSize <- (#peek SYSTEM_INFO, dwPageSize) buf minimumApplicationAddress <- (#peek SYSTEM_INFO, lpMinimumApplicationAddress) buf maximumApplicationAddress <- (#peek SYSTEM_INFO, lpMaximumApplicationAddress) buf activeProcessorMask <- (#peek SYSTEM_INFO, dwActiveProcessorMask) buf numberOfProcessors <- (#peek SYSTEM_INFO, dwNumberOfProcessors) buf processorType <- (#peek SYSTEM_INFO, dwProcessorType) buf allocationGranularity <- (#peek SYSTEM_INFO, dwAllocationGranularity) buf processorLevel <- (#peek SYSTEM_INFO, wProcessorLevel) buf processorRevision <- (#peek SYSTEM_INFO, wProcessorRevision) buf return $ SYSTEM_INFO { siProcessorArchitecture = processorArchitecture, siPageSize = pageSize, siMinimumApplicationAddress = minimumApplicationAddress, siMaximumApplicationAddress = maximumApplicationAddress, siActiveProcessorMask = activeProcessorMask, siNumberOfProcessors = numberOfProcessors, siProcessorType = processorType, siAllocationGranularity = allocationGranularity, siProcessorLevel = processorLevel, siProcessorRevision = processorRevision } foreign import stdcall unsafe "windows.h GetSystemInfo" c_GetSystemInfo :: Ptr SYSTEM_INFO -> IO () getSystemInfo :: IO SYSTEM_INFO getSystemInfo = alloca $ \ret -> do c_GetSystemInfo ret peek ret ---------------------------------------------------------------- -- System metrics ---------------------------------------------------------------- type SMSetting = UINT #{enum SMSetting, , sM_ARRANGE = SM_ARRANGE , sM_CLEANBOOT = SM_CLEANBOOT , sM_CMETRICS = SM_CMETRICS , sM_CMOUSEBUTTONS = SM_CMOUSEBUTTONS , sM_CXBORDER = SM_CXBORDER , sM_CYBORDER = SM_CYBORDER , sM_CXCURSOR = SM_CXCURSOR , sM_CYCURSOR = SM_CYCURSOR , sM_CXDLGFRAME = SM_CXDLGFRAME , sM_CYDLGFRAME = SM_CYDLGFRAME , sM_CXDOUBLECLK = SM_CXDOUBLECLK , sM_CYDOUBLECLK = SM_CYDOUBLECLK , sM_CXDRAG = SM_CXDRAG , sM_CYDRAG = SM_CYDRAG , sM_CXEDGE = SM_CXEDGE , sM_CYEDGE = SM_CYEDGE , sM_CXFRAME = SM_CXFRAME , sM_CYFRAME = SM_CYFRAME , sM_CXFULLSCREEN = SM_CXFULLSCREEN , sM_CYFULLSCREEN = SM_CYFULLSCREEN , sM_CXHSCROLL = SM_CXHSCROLL , sM_CYVSCROLL = SM_CYVSCROLL , sM_CXICON = SM_CXICON , sM_CYICON = SM_CYICON , sM_CXICONSPACING = SM_CXICONSPACING , sM_CYICONSPACING = SM_CYICONSPACING , sM_CXMAXIMIZED = SM_CXMAXIMIZED , sM_CYMAXIMIZED = SM_CYMAXIMIZED , sM_CXMENUCHECK = SM_CXMENUCHECK , sM_CYMENUCHECK = SM_CYMENUCHECK , sM_CXMENUSIZE = SM_CXMENUSIZE , sM_CYMENUSIZE = SM_CYMENUSIZE , sM_CXMIN = SM_CXMIN , sM_CYMIN = SM_CYMIN , sM_CXMINIMIZED = SM_CXMINIMIZED , sM_CYMINIMIZED = SM_CYMINIMIZED , sM_CXMINTRACK = SM_CXMINTRACK , sM_CYMINTRACK = SM_CYMINTRACK , sM_CXSCREEN = SM_CXSCREEN , sM_CYSCREEN = SM_CYSCREEN , sM_CXSIZE = SM_CXSIZE , sM_CYSIZE = SM_CYSIZE , sM_CXSIZEFRAME = SM_CXSIZEFRAME , sM_CYSIZEFRAME = SM_CYSIZEFRAME , sM_CXSMICON = SM_CXSMICON , sM_CYSMICON = SM_CYSMICON , sM_CXSMSIZE = SM_CXSMSIZE , sM_CYSMSIZE = SM_CYSMSIZE , sM_CXVSCROLL = SM_CXVSCROLL , sM_CYHSCROLL = SM_CYHSCROLL , sM_CYVTHUMB = SM_CYVTHUMB , sM_CYCAPTION = SM_CYCAPTION , sM_CYKANJIWINDOW = SM_CYKANJIWINDOW , sM_CYMENU = SM_CYMENU , sM_CYSMCAPTION = SM_CYSMCAPTION , sM_DBCSENABLED = SM_DBCSENABLED , sM_DEBUG = SM_DEBUG , sM_MENUDROPALIGNMENT = SM_MENUDROPALIGNMENT , sM_MIDEASTENABLED = SM_MIDEASTENABLED , sM_MOUSEPRESENT = SM_MOUSEPRESENT , sM_NETWORK = SM_NETWORK , sM_PENWINDOWS = SM_PENWINDOWS , sM_SECURE = SM_SECURE , sM_SHOWSOUNDS = SM_SHOWSOUNDS , sM_SLOWMACHINE = SM_SLOWMACHINE , sM_SWAPBUTTON = SM_SWAPBUTTON } -- %fun GetSystemMetrics :: SMSetting -> IO Int ---------------------------------------------------------------- -- Thread Desktops ---------------------------------------------------------------- -- %fun GetThreadDesktop :: ThreadId -> IO HDESK -- %fun SetThreadDesktop :: ThreadId -> HDESK -> IO () ---------------------------------------------------------------- -- User name ---------------------------------------------------------------- -- %fun GetUserName :: IO String ---------------------------------------------------------------- -- Version Info ---------------------------------------------------------------- -- %fun GetVersionEx :: IO VersionInfo -- -- typedef struct _OSVERSIONINFO{ -- DWORD dwOSVersionInfoSize; -- DWORD dwMajorVersion; -- DWORD dwMinorVersion; -- DWORD dwBuildNumber; -- DWORD dwPlatformId; -- TCHAR szCSDVersion[ 128 ]; -- } OSVERSIONINFO; ---------------------------------------------------------------- -- Processor features ---------------------------------------------------------------- -- -- Including these lines causes problems on Win95 -- %fun IsProcessorFeaturePresent :: ProcessorFeature -> Bool -- -- type ProcessorFeature = DWORD -- %dis processorFeature x = dWORD x -- -- %const ProcessorFeature -- % [ PF_FLOATING_POINT_PRECISION_ERRATA -- % , PF_FLOATING_POINT_EMULATED -- % , PF_COMPARE_EXCHANGE_DOUBLE -- % , PF_MMX_INSTRUCTIONS_AVAILABLE -- % ] ---------------------------------------------------------------- -- System Parameter Information ---------------------------------------------------------------- -- %fun SystemParametersInfo :: ?? -> Bool -> IO ?? ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/System/Win32/Mem.hsc0000644006511100651110000002207310504340503021044 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.Mem -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module System.Win32.Mem where import System.Win32.Types import Foreign import Foreign.C.Types #include copyMemory :: Ptr a -> Ptr a -> DWORD -> IO () copyMemory dest src nbytes = copyBytes dest src (fromIntegral nbytes) moveMemory :: Ptr a -> Ptr a -> DWORD -> IO () moveMemory dest src nbytes = moveBytes dest src (fromIntegral nbytes) fillMemory :: Ptr a -> DWORD -> BYTE -> IO () fillMemory dest nbytes val = memset dest (fromIntegral val) (fromIntegral nbytes) zeroMemory :: Ptr a -> DWORD -> IO () zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes) foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO () foreign import stdcall unsafe "windows.h GetProcessHeap" getProcessHeap :: IO HANDLE #ifndef __WINE_WINDOWS_H foreign import stdcall unsafe "windows.h GetProcessHeaps" getProcessHeaps :: DWORD -> Addr -> IO DWORD #endif type HGLOBAL = Addr type GlobalAllocFlags = UINT gMEM_INVALID_HANDLE :: GlobalAllocFlags gMEM_INVALID_HANDLE = #{const GMEM_INVALID_HANDLE} #{enum GlobalAllocFlags, , gMEM_FIXED = GMEM_FIXED , gMEM_MOVEABLE = GMEM_MOVEABLE , gPTR = GPTR , gHND = GHND , gMEM_DDESHARE = GMEM_DDESHARE , gMEM_SHARE = GMEM_SHARE , gMEM_LOWER = GMEM_LOWER , gMEM_NOCOMPACT = GMEM_NOCOMPACT , gMEM_NODISCARD = GMEM_NODISCARD , gMEM_NOT_BANKED = GMEM_NOT_BANKED , gMEM_NOTIFY = GMEM_NOTIFY , gMEM_ZEROINIT = GMEM_ZEROINIT } globalAlloc :: GlobalAllocFlags -> DWORD -> IO HGLOBAL globalAlloc flags size = failIfNull "GlobalAlloc" $ c_GlobalAlloc flags size foreign import stdcall unsafe "windows.h GlobalAlloc" c_GlobalAlloc :: GlobalAllocFlags -> DWORD -> IO HGLOBAL -- %fun GlobalDiscard :: HGLOBAL -> IO HGLOBAL -- %fail {res1==NULL}{ErrorWin("GlobalDiscard")} globalFlags :: HGLOBAL -> IO GlobalAllocFlags globalFlags mem = failIf (== gMEM_INVALID_HANDLE) "GlobalFlags" $ c_GlobalFlags mem foreign import stdcall unsafe "windows.h GlobalFlags" c_GlobalFlags :: HGLOBAL -> IO GlobalAllocFlags globalFree :: HGLOBAL -> IO HGLOBAL globalFree mem = failIfNull "GlobalFree" $ c_GlobalFree mem foreign import stdcall unsafe "windows.h GlobalFree" c_GlobalFree :: HGLOBAL -> IO HGLOBAL globalHandle :: Addr -> IO HGLOBAL globalHandle addr = failIfNull "GlobalHandle" $ c_GlobalHandle addr foreign import stdcall unsafe "windows.h GlobalHandle" c_GlobalHandle :: Addr -> IO HGLOBAL globalLock :: HGLOBAL -> IO Addr globalLock mem = failIfNull "GlobalLock" $ c_GlobalLock mem foreign import stdcall unsafe "windows.h GlobalLock" c_GlobalLock :: HGLOBAL -> IO Addr -- %fun GlobalMemoryStatus :: IO MEMORYSTATUS globalReAlloc :: HGLOBAL -> DWORD -> GlobalAllocFlags -> IO HGLOBAL globalReAlloc mem size flags = failIfNull "GlobalReAlloc" $ c_GlobalReAlloc mem size flags foreign import stdcall unsafe "windows.h GlobalReAlloc" c_GlobalReAlloc :: HGLOBAL -> DWORD -> GlobalAllocFlags -> IO HGLOBAL globalSize :: HGLOBAL -> IO DWORD globalSize mem = failIfZero "GlobalSize" $ c_GlobalSize mem foreign import stdcall unsafe "windows.h GlobalSize" c_GlobalSize :: HGLOBAL -> IO DWORD globalUnlock :: HGLOBAL -> IO () globalUnlock mem = failIfFalse_ "GlobalUnlock" $ c_GlobalUnlock mem foreign import stdcall unsafe "windows.h GlobalUnlock" c_GlobalUnlock :: HGLOBAL -> IO Bool type HeapAllocFlags = DWORD #{enum HeapAllocFlags, , hEAP_GENERATE_EXCEPTIONS = HEAP_GENERATE_EXCEPTIONS , hEAP_NO_SERIALIZE = HEAP_NO_SERIALIZE , hEAP_ZERO_MEMORY = HEAP_ZERO_MEMORY } heapAlloc :: HANDLE -> HeapAllocFlags -> DWORD -> IO Addr heapAlloc heap flags size = failIfNull "HeapAlloc" $ c_HeapAlloc heap flags size foreign import stdcall unsafe "windows.h HeapAlloc" c_HeapAlloc :: HANDLE -> HeapAllocFlags -> DWORD -> IO Addr heapCompact :: HANDLE -> HeapAllocFlags -> IO UINT heapCompact heap flags = failIfZero "HeapCompact" $ c_HeapCompact heap flags foreign import stdcall unsafe "windows.h HeapCompact" c_HeapCompact :: HANDLE -> HeapAllocFlags -> IO UINT heapCreate :: HeapAllocFlags -> DWORD -> DWORD -> IO HANDLE heapCreate flags initSize maxSize = failIfNull "HeapCreate" $ c_HeapCreate flags initSize maxSize foreign import stdcall unsafe "windows.h HeapCreate" c_HeapCreate :: HeapAllocFlags -> DWORD -> DWORD -> IO HANDLE heapDestroy :: HANDLE -> IO () heapDestroy heap = failIfFalse_ "HeapDestroy" $ c_HeapDestroy heap foreign import stdcall unsafe "windows.h HeapDestroy" c_HeapDestroy :: HANDLE -> IO Bool heapFree :: HANDLE -> HeapAllocFlags -> Addr -> IO () heapFree heap flags addr = failIfFalse_ "HeapFree" $ c_HeapFree heap flags addr foreign import stdcall unsafe "windows.h HeapFree" c_HeapFree :: HANDLE -> HeapAllocFlags -> Addr -> IO Bool heapLock :: HANDLE -> IO () heapLock heap = failIfFalse_ "HeapLock" $ c_HeapLock heap foreign import stdcall unsafe "windows.h HeapLock" c_HeapLock :: HANDLE -> IO Bool heapReAlloc :: HANDLE -> HeapAllocFlags -> Addr -> DWORD -> IO Addr heapReAlloc heap flags addr size = failIfNull "HeapReAlloc" $ c_HeapReAlloc heap flags addr size foreign import stdcall unsafe "windows.h HeapReAlloc" c_HeapReAlloc :: HANDLE -> HeapAllocFlags -> Addr -> DWORD -> IO Addr heapSize :: HANDLE -> HeapAllocFlags -> Addr -> IO DWORD heapSize heap flags addr = failIfZero "HeapSize" $ c_HeapSize heap flags addr foreign import stdcall unsafe "windows.h HeapSize" c_HeapSize :: HANDLE -> HeapAllocFlags -> Addr -> IO DWORD heapUnlock :: HANDLE -> IO () heapUnlock heap = failIfFalse_ "HeapUnlock" $ c_HeapUnlock heap foreign import stdcall unsafe "windows.h HeapUnlock" c_HeapUnlock :: HANDLE -> IO Bool foreign import stdcall unsafe "windows.h HeapValidate" heapValidate :: HANDLE -> HeapAllocFlags -> Addr -> IO Bool type VirtualAllocFlags = DWORD #{enum VirtualAllocFlags, , mEM_COMMIT = MEM_COMMIT , mEM_RESERVE = MEM_RESERVE } -- % , MEM_TOP_DOWN (not in mingw-20001111 winnt.h) type ProtectFlags = DWORD #{enum ProtectFlags, , pAGE_READONLY = PAGE_READONLY , pAGE_READWRITE = PAGE_READWRITE , pAGE_EXECUTE = PAGE_EXECUTE , pAGE_EXECUTE_READ = PAGE_EXECUTE_READ , pAGE_EXECUTE_READWRITE = PAGE_EXECUTE_READWRITE , pAGE_GUARD = PAGE_GUARD , pAGE_NOACCESS = PAGE_NOACCESS , pAGE_NOCACHE = PAGE_NOCACHE } type FreeFlags = DWORD #{enum FreeFlags, , mEM_DECOMMIT = MEM_DECOMMIT , mEM_RELEASE = MEM_RELEASE } virtualAlloc :: Addr -> DWORD -> VirtualAllocFlags -> ProtectFlags -> IO Addr virtualAlloc addt size ty flags = failIfNull "VirtualAlloc" $ c_VirtualAlloc addt size ty flags foreign import stdcall unsafe "windows.h VirtualAlloc" c_VirtualAlloc :: Addr -> DWORD -> DWORD -> DWORD -> IO Addr -- %fun VirtualAllocEx :: HANDLE -> Addr -> DWORD -> VirtualAllocFlags -> ProtectFlags ->IO Addr -- %code extern LPVOID WINAPI VirtualAllocEx(HANDLE,LPVOID,DWORD,DWORD,DWORD); -- % LPVOID res1=VirtualAllocEx(arg1,arg2,arg3,arg4,arg5); -- %fail {res1==NULL}{ErrorWin("VirtualAllocEx")} virtualFree :: Addr -> DWORD -> FreeFlags -> IO () virtualFree addr size flags = failIfFalse_ "VirtualFree" $ c_VirtualFree addr size flags foreign import stdcall unsafe "windows.h VirtualFree" c_VirtualFree :: Addr -> DWORD -> FreeFlags -> IO Bool -- %fun VirtualFreeEx :: HANDLE -> Addr -> DWORD -> FreeFlags -> IO () -- %code extern BOOL WINAPI VirtualFreeEx(HANDLE,LPVOID,DWORD,DWORD); -- % BOOL res1=VirtualFreeEx(arg1,arg2,arg3,arg4); -- %fail {res1=0}{ErrorWin("VirtualFreeEx")} virtualLock :: Addr -> DWORD -> IO () virtualLock addr size = failIfFalse_ "VirtualLock" $ c_VirtualLock addr size foreign import stdcall unsafe "windows.h VirtualLock" c_VirtualLock :: Addr -> DWORD -> IO Bool virtualProtect :: Addr -> DWORD -> ProtectFlags -> IO ProtectFlags virtualProtect addr size new_prot = alloca $ \ p_old -> do failIfFalse_ "VirtualProtect" $ c_VirtualProtect addr size new_prot p_old peek p_old foreign import stdcall unsafe "windows.h VirtualProtect" c_VirtualProtect :: Addr -> DWORD -> DWORD -> Ptr DWORD -> IO Bool virtualProtectEx :: HANDLE -> Addr -> DWORD -> ProtectFlags -> IO ProtectFlags virtualProtectEx proc addr size new_prot = alloca $ \ p_old -> do failIfFalse_ "VirtualProtectEx" $ c_VirtualProtectEx proc addr size new_prot p_old peek p_old foreign import stdcall unsafe "windows.h VirtualProtectEx" c_VirtualProtectEx :: HANDLE -> Addr -> DWORD -> DWORD -> Ptr DWORD -> IO Bool -- No VirtualQuery..() virtualUnlock :: Addr -> DWORD -> IO () virtualUnlock addr size = failIfFalse_ "VirtualUnlock" $ c_VirtualUnlock addr size foreign import stdcall unsafe "windows.h VirtualUnlock" c_VirtualUnlock :: Addr -> DWORD -> IO Bool hugs98-plus-Sep2006/packages/Win32/System/Win32/NLS.hsc0000644006511100651110000003366410504340503020772 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.NLS -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module System.Win32.NLS ( module System.Win32.NLS, -- defined in System.Win32.Types LCID, LANGID, SortID, SubLANGID, PrimaryLANGID, mAKELCID, lANGIDFROMLCID, sORTIDFROMLCID, mAKELANGID, pRIMARYLANGID, sUBLANGID ) where import System.Win32.Types import Foreign #include #include "errors.h" #include "win32debug.h" #{enum LCID, , lOCALE_SYSTEM_DEFAULT = LOCALE_SYSTEM_DEFAULT , lOCALE_USER_DEFAULT = LOCALE_USER_DEFAULT , lOCALE_NEUTRAL = LOCALE_NEUTRAL } foreign import stdcall unsafe "windows.h ConvertDefaultLocale" convertDefaultLocale :: LCID -> IO LCID -- ToDo: various enum functions. type CodePage = UINT #{enum CodePage, , cP_ACP = CP_ACP , cP_MACCP = CP_MACCP , cP_OEMCP = CP_OEMCP } foreign import stdcall unsafe "windows.h GetACP" getACP :: IO CodePage foreign import stdcall unsafe "windows.h SetThreadLocale" setThreadLocale :: LCID -> IO () type LCTYPE = UINT #{enum LCTYPE, , lOCALE_ICALENDARTYPE = LOCALE_ICALENDARTYPE , lOCALE_SDATE = LOCALE_SDATE , lOCALE_ICURRDIGITS = LOCALE_ICURRDIGITS , lOCALE_SDECIMAL = LOCALE_SDECIMAL , lOCALE_ICURRENCY = LOCALE_ICURRENCY , lOCALE_SGROUPING = LOCALE_SGROUPING , lOCALE_IDIGITS = LOCALE_IDIGITS , lOCALE_SLIST = LOCALE_SLIST , lOCALE_IFIRSTDAYOFWEEK = LOCALE_IFIRSTDAYOFWEEK , lOCALE_SLONGDATE = LOCALE_SLONGDATE , lOCALE_IFIRSTWEEKOFYEAR = LOCALE_IFIRSTWEEKOFYEAR , lOCALE_SMONDECIMALSEP = LOCALE_SMONDECIMALSEP , lOCALE_ILZERO = LOCALE_ILZERO , lOCALE_SMONGROUPING = LOCALE_SMONGROUPING , lOCALE_IMEASURE = LOCALE_IMEASURE , lOCALE_SMONTHOUSANDSEP = LOCALE_SMONTHOUSANDSEP , lOCALE_INEGCURR = LOCALE_INEGCURR , lOCALE_SNEGATIVESIGN = LOCALE_SNEGATIVESIGN , lOCALE_INEGNUMBER = LOCALE_INEGNUMBER , lOCALE_SPOSITIVESIGN = LOCALE_SPOSITIVESIGN , lOCALE_SSHORTDATE = LOCALE_SSHORTDATE , lOCALE_ITIME = LOCALE_ITIME , lOCALE_STHOUSAND = LOCALE_STHOUSAND , lOCALE_S1159 = LOCALE_S1159 , lOCALE_STIME = LOCALE_STIME , lOCALE_S2359 = LOCALE_S2359 , lOCALE_STIMEFORMAT = LOCALE_STIMEFORMAT , lOCALE_SCURRENCY = LOCALE_SCURRENCY } setLocaleInfo :: LCID -> LCTYPE -> String -> IO () setLocaleInfo locale ty info = withTString info $ \ c_info -> failIfFalse_ "SetLocaleInfo" $ c_SetLocaleInfo locale ty c_info foreign import stdcall unsafe "windows.h SetLocaleInfoW" c_SetLocaleInfo :: LCID -> LCTYPE -> LPCTSTR -> IO Bool type LCMapFlags = DWORD #{enum LCMapFlags, , lCMAP_BYTEREV = LCMAP_BYTEREV , lCMAP_FULLWIDTH = LCMAP_FULLWIDTH , lCMAP_HALFWIDTH = LCMAP_HALFWIDTH , lCMAP_HIRAGANA = LCMAP_HIRAGANA , lCMAP_KATAKANA = LCMAP_KATAKANA , lCMAP_LOWERCASE = LCMAP_LOWERCASE , lCMAP_SORTKEY = LCMAP_SORTKEY , lCMAP_UPPERCASE = LCMAP_UPPERCASE , nORM_IGNORECASE = NORM_IGNORECASE , nORM_IGNORENONSPACE = NORM_IGNORENONSPACE , nORM_IGNOREKANATYPE = NORM_IGNOREKANATYPE , nORM_IGNORESYMBOLS = NORM_IGNORESYMBOLS , nORM_IGNOREWIDTH = NORM_IGNOREWIDTH , sORT_STRINGSORT = SORT_STRINGSORT , lCMAP_LINGUISTIC_CASING = LCMAP_LINGUISTIC_CASING , lCMAP_SIMPLIFIED_CHINESE = LCMAP_SIMPLIFIED_CHINESE , lCMAP_TRADITIONAL_CHINESE = LCMAP_TRADITIONAL_CHINESE } lCMapString :: LCID -> LCMapFlags -> String -> Int -> IO String lCMapString locale flags src dest_size = withTStringLen src $ \ (c_src, src_len) -> allocaArray dest_size $ \ c_dest -> do failIfZero "LCMapString" $ c_LCMapString locale flags c_src src_len c_dest dest_size peekTString c_dest foreign import stdcall unsafe "windows.h LCMapStringW" c_LCMapString :: LCID -> LCMapFlags -> LPCTSTR -> Int -> LPCTSTR -> Int -> IO Int type LocaleTestFlags = DWORD #{enum LocaleTestFlags, , lCID_INSTALLED = LCID_INSTALLED , lCID_SUPPORTED = LCID_SUPPORTED } foreign import stdcall unsafe "windows.h IsValidLocale" isValidLocale :: LCID -> LocaleTestFlags -> IO Bool foreign import stdcall unsafe "windows.h IsValidCodePage" isValidCodePage :: CodePage -> IO Bool foreign import stdcall unsafe "windows.h GetUserDefaultLCID" getUserDefaultLCID :: LCID foreign import stdcall unsafe "windows.h GetUserDefaultLangID" getUserDefaultLangID :: LANGID foreign import stdcall unsafe "windows.h GetThreadLocale" getThreadLocale :: IO LCID foreign import stdcall unsafe "windows.h GetSystemDefaultLCID" getSystemDefaultLCID :: LCID foreign import stdcall unsafe "windows.h GetSystemDefaultLangID" getSystemDefaultLangID :: LANGID foreign import stdcall unsafe "windows.h GetOEMCP" getOEMCP :: CodePage #{enum PrimaryLANGID, , lANG_NEUTRAL = LANG_NEUTRAL , lANG_BULGARIAN = LANG_BULGARIAN , lANG_CHINESE = LANG_CHINESE , lANG_CZECH = LANG_CZECH , lANG_DANISH = LANG_DANISH , lANG_GERMAN = LANG_GERMAN , lANG_GREEK = LANG_GREEK , lANG_ENGLISH = LANG_ENGLISH , lANG_SPANISH = LANG_SPANISH , lANG_FINNISH = LANG_FINNISH , lANG_FRENCH = LANG_FRENCH , lANG_HUNGARIAN = LANG_HUNGARIAN , lANG_ICELANDIC = LANG_ICELANDIC , lANG_ITALIAN = LANG_ITALIAN , lANG_JAPANESE = LANG_JAPANESE , lANG_KOREAN = LANG_KOREAN , lANG_DUTCH = LANG_DUTCH , lANG_NORWEGIAN = LANG_NORWEGIAN , lANG_POLISH = LANG_POLISH , lANG_PORTUGUESE = LANG_PORTUGUESE , lANG_ROMANIAN = LANG_ROMANIAN , lANG_RUSSIAN = LANG_RUSSIAN , lANG_CROATIAN = LANG_CROATIAN , lANG_SLOVAK = LANG_SLOVAK , lANG_SWEDISH = LANG_SWEDISH , lANG_TURKISH = LANG_TURKISH , lANG_SLOVENIAN = LANG_SLOVENIAN , lANG_ARABIC = LANG_ARABIC , lANG_CATALAN = LANG_CATALAN , lANG_HEBREW = LANG_HEBREW , lANG_SERBIAN = LANG_SERBIAN , lANG_ALBANIAN = LANG_ALBANIAN , lANG_THAI = LANG_THAI , lANG_URDU = LANG_URDU , lANG_INDONESIAN = LANG_INDONESIAN , lANG_BELARUSIAN = LANG_BELARUSIAN , lANG_ESTONIAN = LANG_ESTONIAN , lANG_LATVIAN = LANG_LATVIAN , lANG_LITHUANIAN = LANG_LITHUANIAN , lANG_FARSI = LANG_FARSI , lANG_VIETNAMESE = LANG_VIETNAMESE , lANG_ARMENIAN = LANG_ARMENIAN , lANG_AZERI = LANG_AZERI , lANG_BASQUE = LANG_BASQUE , lANG_MACEDONIAN = LANG_MACEDONIAN , lANG_AFRIKAANS = LANG_AFRIKAANS , lANG_GEORGIAN = LANG_GEORGIAN , lANG_FAEROESE = LANG_FAEROESE , lANG_HINDI = LANG_HINDI , lANG_MALAY = LANG_MALAY , lANG_KAZAK = LANG_KAZAK , lANG_SWAHILI = LANG_SWAHILI , lANG_UZBEK = LANG_UZBEK , lANG_TATAR = LANG_TATAR , lANG_BENGALI = LANG_BENGALI , lANG_PUNJABI = LANG_PUNJABI , lANG_GUJARATI = LANG_GUJARATI , lANG_ORIYA = LANG_ORIYA , lANG_TAMIL = LANG_TAMIL , lANG_TELUGU = LANG_TELUGU , lANG_KANNADA = LANG_KANNADA , lANG_MALAYALAM = LANG_MALAYALAM , lANG_ASSAMESE = LANG_ASSAMESE , lANG_MARATHI = LANG_MARATHI , lANG_SANSKRIT = LANG_SANSKRIT , lANG_KONKANI = LANG_KONKANI , lANG_MANIPURI = LANG_MANIPURI , lANG_SINDHI = LANG_SINDHI , lANG_KASHMIRI = LANG_KASHMIRI , lANG_NEPALI = LANG_NEPALI } #{enum SortID, , sORT_DEFAULT = SORT_DEFAULT , sORT_JAPANESE_XJIS = SORT_JAPANESE_XJIS , sORT_JAPANESE_UNICODE = SORT_JAPANESE_UNICODE , sORT_CHINESE_BIG5 = SORT_CHINESE_BIG5 , sORT_CHINESE_UNICODE = SORT_CHINESE_UNICODE , sORT_KOREAN_KSC = SORT_KOREAN_KSC , sORT_KOREAN_UNICODE = SORT_KOREAN_UNICODE } #{enum SubLANGID, , sUBLANG_NEUTRAL = SUBLANG_NEUTRAL , sUBLANG_DEFAULT = SUBLANG_DEFAULT , sUBLANG_SYS_DEFAULT = SUBLANG_SYS_DEFAULT , sUBLANG_CHINESE_TRADITIONAL = SUBLANG_CHINESE_TRADITIONAL , sUBLANG_CHINESE_SIMPLIFIED = SUBLANG_CHINESE_SIMPLIFIED , sUBLANG_CHINESE_HONGKONG = SUBLANG_CHINESE_HONGKONG , sUBLANG_CHINESE_SINGAPORE = SUBLANG_CHINESE_SINGAPORE , sUBLANG_DUTCH = SUBLANG_DUTCH , sUBLANG_DUTCH_BELGIAN = SUBLANG_DUTCH_BELGIAN , sUBLANG_ENGLISH_US = SUBLANG_ENGLISH_US , sUBLANG_ENGLISH_UK = SUBLANG_ENGLISH_UK , sUBLANG_ENGLISH_AUS = SUBLANG_ENGLISH_AUS , sUBLANG_ENGLISH_CAN = SUBLANG_ENGLISH_CAN , sUBLANG_ENGLISH_NZ = SUBLANG_ENGLISH_NZ , sUBLANG_ENGLISH_EIRE = SUBLANG_ENGLISH_EIRE , sUBLANG_FRENCH = SUBLANG_FRENCH , sUBLANG_FRENCH_BELGIAN = SUBLANG_FRENCH_BELGIAN , sUBLANG_FRENCH_CANADIAN = SUBLANG_FRENCH_CANADIAN , sUBLANG_FRENCH_SWISS = SUBLANG_FRENCH_SWISS , sUBLANG_GERMAN = SUBLANG_GERMAN , sUBLANG_GERMAN_SWISS = SUBLANG_GERMAN_SWISS , sUBLANG_GERMAN_AUSTRIAN = SUBLANG_GERMAN_AUSTRIAN , sUBLANG_ITALIAN = SUBLANG_ITALIAN , sUBLANG_ITALIAN_SWISS = SUBLANG_ITALIAN_SWISS , sUBLANG_NORWEGIAN_BOKMAL = SUBLANG_NORWEGIAN_BOKMAL , sUBLANG_NORWEGIAN_NYNORSK = SUBLANG_NORWEGIAN_NYNORSK , sUBLANG_PORTUGUESE = SUBLANG_PORTUGUESE , sUBLANG_PORTUGUESE_BRAZILIAN = SUBLANG_PORTUGUESE_BRAZILIAN , sUBLANG_SPANISH = SUBLANG_SPANISH , sUBLANG_SPANISH_MEXICAN = SUBLANG_SPANISH_MEXICAN , sUBLANG_SPANISH_MODERN = SUBLANG_SPANISH_MODERN , sUBLANG_ARABIC_SAUDI_ARABIA = SUBLANG_ARABIC_SAUDI_ARABIA , sUBLANG_ARABIC_IRAQ = SUBLANG_ARABIC_IRAQ , sUBLANG_ARABIC_EGYPT = SUBLANG_ARABIC_EGYPT , sUBLANG_ARABIC_LIBYA = SUBLANG_ARABIC_LIBYA , sUBLANG_ARABIC_ALGERIA = SUBLANG_ARABIC_ALGERIA , sUBLANG_ARABIC_MOROCCO = SUBLANG_ARABIC_MOROCCO , sUBLANG_ARABIC_TUNISIA = SUBLANG_ARABIC_TUNISIA , sUBLANG_ARABIC_OMAN = SUBLANG_ARABIC_OMAN , sUBLANG_ARABIC_YEMEN = SUBLANG_ARABIC_YEMEN , sUBLANG_ARABIC_SYRIA = SUBLANG_ARABIC_SYRIA , sUBLANG_ARABIC_JORDAN = SUBLANG_ARABIC_JORDAN , sUBLANG_ARABIC_LEBANON = SUBLANG_ARABIC_LEBANON , sUBLANG_ARABIC_KUWAIT = SUBLANG_ARABIC_KUWAIT , sUBLANG_ARABIC_UAE = SUBLANG_ARABIC_UAE , sUBLANG_ARABIC_BAHRAIN = SUBLANG_ARABIC_BAHRAIN , sUBLANG_ARABIC_QATAR = SUBLANG_ARABIC_QATAR , sUBLANG_AZERI_CYRILLIC = SUBLANG_AZERI_CYRILLIC , sUBLANG_AZERI_LATIN = SUBLANG_AZERI_LATIN , sUBLANG_CHINESE_MACAU = SUBLANG_CHINESE_MACAU , sUBLANG_ENGLISH_SOUTH_AFRICA = SUBLANG_ENGLISH_SOUTH_AFRICA , sUBLANG_ENGLISH_JAMAICA = SUBLANG_ENGLISH_JAMAICA , sUBLANG_ENGLISH_CARIBBEAN = SUBLANG_ENGLISH_CARIBBEAN , sUBLANG_ENGLISH_BELIZE = SUBLANG_ENGLISH_BELIZE , sUBLANG_ENGLISH_TRINIDAD = SUBLANG_ENGLISH_TRINIDAD , sUBLANG_ENGLISH_PHILIPPINES = SUBLANG_ENGLISH_PHILIPPINES , sUBLANG_ENGLISH_ZIMBABWE = SUBLANG_ENGLISH_ZIMBABWE , sUBLANG_FRENCH_LUXEMBOURG = SUBLANG_FRENCH_LUXEMBOURG , sUBLANG_FRENCH_MONACO = SUBLANG_FRENCH_MONACO , sUBLANG_GERMAN_LUXEMBOURG = SUBLANG_GERMAN_LUXEMBOURG , sUBLANG_GERMAN_LIECHTENSTEIN = SUBLANG_GERMAN_LIECHTENSTEIN , sUBLANG_KASHMIRI_INDIA = SUBLANG_KASHMIRI_INDIA , sUBLANG_KOREAN = SUBLANG_KOREAN , sUBLANG_LITHUANIAN = SUBLANG_LITHUANIAN , sUBLANG_MALAY_MALAYSIA = SUBLANG_MALAY_MALAYSIA , sUBLANG_MALAY_BRUNEI_DARUSSALAM = SUBLANG_MALAY_BRUNEI_DARUSSALAM , sUBLANG_NEPALI_INDIA = SUBLANG_NEPALI_INDIA , sUBLANG_SERBIAN_LATIN = SUBLANG_SERBIAN_LATIN , sUBLANG_SERBIAN_CYRILLIC = SUBLANG_SERBIAN_CYRILLIC , sUBLANG_SPANISH_GUATEMALA = SUBLANG_SPANISH_GUATEMALA , sUBLANG_SPANISH_COSTA_RICA = SUBLANG_SPANISH_COSTA_RICA , sUBLANG_SPANISH_PANAMA = SUBLANG_SPANISH_PANAMA , sUBLANG_SPANISH_DOMINICAN_REPUBLIC = SUBLANG_SPANISH_DOMINICAN_REPUBLIC , sUBLANG_SPANISH_VENEZUELA = SUBLANG_SPANISH_VENEZUELA , sUBLANG_SPANISH_COLOMBIA = SUBLANG_SPANISH_COLOMBIA , sUBLANG_SPANISH_PERU = SUBLANG_SPANISH_PERU , sUBLANG_SPANISH_ARGENTINA = SUBLANG_SPANISH_ARGENTINA , sUBLANG_SPANISH_ECUADOR = SUBLANG_SPANISH_ECUADOR , sUBLANG_SPANISH_CHILE = SUBLANG_SPANISH_CHILE , sUBLANG_SPANISH_URUGUAY = SUBLANG_SPANISH_URUGUAY , sUBLANG_SPANISH_PARAGUAY = SUBLANG_SPANISH_PARAGUAY , sUBLANG_SPANISH_BOLIVIA = SUBLANG_SPANISH_BOLIVIA , sUBLANG_SPANISH_EL_SALVADOR = SUBLANG_SPANISH_EL_SALVADOR , sUBLANG_SPANISH_HONDURAS = SUBLANG_SPANISH_HONDURAS , sUBLANG_SPANISH_NICARAGUA = SUBLANG_SPANISH_NICARAGUA , sUBLANG_SPANISH_PUERTO_RICO = SUBLANG_SPANISH_PUERTO_RICO , sUBLANG_SWEDISH = SUBLANG_SWEDISH , sUBLANG_SWEDISH_FINLAND = SUBLANG_SWEDISH_FINLAND , sUBLANG_URDU_PAKISTAN = SUBLANG_URDU_PAKISTAN , sUBLANG_URDU_INDIA = SUBLANG_URDU_INDIA , sUBLANG_UZBEK_LATIN = SUBLANG_UZBEK_LATIN , sUBLANG_UZBEK_CYRILLIC = SUBLANG_UZBEK_CYRILLIC } -- , SUBLANG_LITHUANIAN_CLASSIC (not in mingw-20001111) hugs98-plus-Sep2006/packages/Win32/System/Win32/FileMapping.hsc0000644006511100651110000001524510504340503022524 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.FileMapping -- Copyright : (c) Esa Ilari Vuokko, 2006 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32 mapped files. -- ----------------------------------------------------------------------------- module System.Win32.FileMapping where import System.Win32.Types ( HANDLE, DWORD, BOOL, SIZE_T, LPCTSTR, withTString , failIf, failIfNull, DDWORD, ddwordToDwords , iNVALID_HANDLE_VALUE ) import System.Win32.Mem import System.Win32.File import System.Win32.Info import Control.Exception ( block, bracket ) import Data.ByteString.Base ( ByteString(..) ) import Foreign ( Ptr, nullPtr, plusPtr, maybeWith, FunPtr , ForeignPtr, newForeignPtr ) #include "windows.h" --------------------------------------------------------------------------- -- Derived functions --------------------------------------------------------------------------- -- | Maps file fully and returns ForeignPtr and length of the mapped area. -- The mapped file is opened read-only and shared reading. mapFile :: FilePath -> IO (ForeignPtr a, Int) mapFile path = do bracket (createFile path gENERIC_READ fILE_SHARE_READ Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing) (closeHandle) $ \fh -> bracket (createFileMapping (Just fh) pAGE_READONLY 0 Nothing) (closeHandle) $ \fm -> do fi <- getFileInformationByHandle fh fp <- block $ do ptr <- mapViewOfFile fm fILE_MAP_READ 0 0 newForeignPtr c_UnmapViewOfFileFinaliser ptr return (fp, fromIntegral $ bhfiSize fi) -- | As mapFile, but returns ByteString mapFileBs :: FilePath -> IO ByteString mapFileBs p = do (fp,i) <- mapFile p return $ PS fp 0 i data MappedObject = MappedObject HANDLE HANDLE FileMapAccess -- | Opens an existing file and creates mapping object to it. withMappedFile :: FilePath -- ^ Path -> Bool -- ^ Write? (False = read-only) -> Maybe Bool -- ^ Sharing mode, no sharing, share read, share read+write -> (Integer -> MappedObject -> IO a) -- ^ Action -> IO a withMappedFile path write share act = bracket (createFile path access share' Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing) (closeHandle) $ \fh -> bracket (createFileMapping (Just fh) page 0 Nothing) (closeHandle) $ \fm -> do bhfi <- getFileInformationByHandle fh act (fromIntegral $ bhfiSize bhfi) (MappedObject fh fm mapaccess) where access = if write then gENERIC_READ+gENERIC_WRITE else gENERIC_READ page = if write then pAGE_READWRITE else pAGE_READONLY mapaccess = if write then fILE_MAP_ALL_ACCESS else fILE_MAP_READ share' = case share of Nothing -> fILE_SHARE_NONE Just False -> fILE_SHARE_READ Just True -> fILE_SHARE_READ + fILE_SHARE_WRITE -- | Maps area into memory. withMappedArea :: MappedObject -- ^ Mapped object, from withMappedFile -> Integer -- ^ Position in file -> Int -- ^ Size of mapped area -> (Ptr a -> IO b) -- ^ Action -> IO b withMappedArea (MappedObject _ mh access) pos size act = do si <- getSystemInfo let gran = fromIntegral $ siAllocationGranularity si (blocks, offset) = divMod pos gran start = blocks*gran size' = fromIntegral $ size + fromIntegral (pos - start) bracket (mapViewOfFileEx mh access (fromIntegral start) size' nullPtr) (unmapViewOfFile) (act . flip plusPtr (fromIntegral offset)) --------------------------------------------------------------------------- -- Enums --------------------------------------------------------------------------- type ProtectSectionFlags = DWORD #{enum ProtectSectionFlags, , sEC_COMMIT = SEC_COMMIT , sEC_IMAGE = SEC_IMAGE , sEC_NOCACHE = SEC_NOCACHE , sEC_RESERVE = SEC_RESERVE } type FileMapAccess = DWORD #{enum FileMapAccess, , fILE_MAP_ALL_ACCESS = FILE_MAP_ALL_ACCESS , fILE_MAP_COPY = FILE_MAP_COPY , fILE_MAP_READ = FILE_MAP_READ , fILE_MAP_WRITE = FILE_MAP_WRITE } --------------------------------------------------------------------------- -- API in Haskell --------------------------------------------------------------------------- createFileMapping :: Maybe HANDLE -> ProtectFlags -> DDWORD -> Maybe String -> IO HANDLE createFileMapping mh flags mosize name = maybeWith withTString name $ \name -> failIf (==nullPtr) "createFileMapping: CreateFileMapping" $ c_CreateFileMapping handle nullPtr flags moshi moslow name where (moshi,moslow) = ddwordToDwords mosize handle = maybe iNVALID_HANDLE_VALUE id mh openFileMapping :: FileMapAccess -> BOOL -> Maybe String -> IO HANDLE openFileMapping access inherit name = maybeWith withTString name $ \name -> failIf (==nullPtr) "openFileMapping: OpenFileMapping" $ c_OpenFileMapping access inherit name mapViewOfFileEx :: HANDLE -> FileMapAccess -> DDWORD -> SIZE_T -> Ptr a -> IO (Ptr b) mapViewOfFileEx h access offset size base = failIfNull "mapViewOfFile(Ex): c_MapViewOfFileEx" $ c_MapViewOfFileEx h access ohi olow size base where (ohi,olow) = ddwordToDwords offset mapViewOfFile :: HANDLE -> FileMapAccess -> DDWORD -> SIZE_T -> IO (Ptr a) mapViewOfFile h a o s = mapViewOfFileEx h a o s nullPtr unmapViewOfFile :: Ptr a -> IO () unmapViewOfFile v = c_UnmapViewOfFile v >> return () --------------------------------------------------------------------------- -- Imports --------------------------------------------------------------------------- foreign import stdcall "windows.h OpenFileMappingW" c_OpenFileMapping :: DWORD -> BOOL -> LPCTSTR -> IO HANDLE foreign import stdcall "windows.h CreateFileMappingW" c_CreateFileMapping :: HANDLE -> Ptr () -> DWORD -> DWORD -> DWORD -> LPCTSTR -> IO HANDLE foreign import stdcall "windows.h MapViewOfFileEx" c_MapViewOfFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> SIZE_T -> Ptr a -> IO (Ptr b) foreign import stdcall "windows.h UnmapViewOfFile" c_UnmapViewOfFile :: Ptr a -> IO BOOL {-# CFILES cbits/HsWin32.c #-} foreign import ccall "HsWin32.h &UnmapViewOfFileFinaliser" c_UnmapViewOfFileFinaliser :: FunPtr (Ptr a -> IO ()) hugs98-plus-Sep2006/packages/Win32/System/Win32/Registry.hsc0000644006511100651110000004512110504340503022135 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.Registry -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for accessing the Win32 registry. -- ----------------------------------------------------------------------------- module System.Win32.Registry ( module System.Win32.Registry ) where {- What's really on offer: ( regCloseKey -- :: HKEY -> IO () , regConnectRegistry -- :: Maybe String -> HKEY -> IO HKEY , regCreateKey -- :: HKEY -> String -> IO HKEY , regCreateKeyEx -- :: HKEY -> String -> String -- -> RegCreateOptions -> REGSAM -- -> Maybe LPSECURITY_ATTRIBUTES -- -> IO (HKEY, Bool) , regDeleteKey -- :: HKEY -> String -> IO () , regDeleteValue -- :: HKEY -> String -> IO () , regEnumKeys -- :: HKEY -> IO [String] , regEnumKey -- :: HKEY -> DWORD -> Addr -> DWORD -> IO String , regEnumKeyValue -- :: HKEY -> DWORD -> Addr -> DWORD -> Addr -> DWORD -> IO String , regFlushKey -- :: HKEY -> IO () , regLoadKey -- :: HKEY -> String -> String -> IO () , regNotifyChangeKeyValue -- :: HKEY -> Bool -> RegNotifyOptions -- -> HANDLE -> Bool -> IO () , regOpenKey -- :: HKEY -> String -> IO HKEY , regOpenKeyEx -- :: HKEY -> String -> REGSAM -> IO HKEY , regQueryInfoKey -- :: HKEY -> IO RegInfoKey , regQueryValue -- :: HKEY -> Maybe String -> IO String , regQueryValueKey -- :: HKEY -> Maybe String -> IO String , regQueryValueEx -- :: HKEY -> String -> Addr -> Int -> IO RegValueType , regReplaceKey -- :: HKEY -> String -> String -> String -> IO () , regRestoreKey -- :: HKEY -> String -> RegRestoreFlags -> IO () , regSaveKey -- :: HKEY -> String -> Maybe LPSECURITY_ATTRIBUTES -> IO () , regSetValue -- :: HKEY -> String -> String -> IO () , regSetValueEx -- :: HKEY -> String -> RegValueType -> LPTSTR -> Int -> IO () , regSetStringValue -- :: HKEY -> String -> String -> IO () , regUnloadKey -- :: HKEY -> String -> IO () ) where -} {- Registry API omissions: RegQueryMultipleValues() RegEnumKeyEx() -} import System.Win32.Time import System.Win32.Types import System.Win32.File import Foreign #include #{enum HKEY, (unsafePerformIO . newForeignHANDLE . castUINTToPtr) , hKEY_CLASSES_ROOT = (UINT)HKEY_CLASSES_ROOT , hKEY_CURRENT_CONFIG = (UINT)HKEY_CURRENT_CONFIG , hKEY_CURRENT_USER = (UINT)HKEY_CURRENT_USER , hKEY_LOCAL_MACHINE = (UINT)HKEY_LOCAL_MACHINE , hKEY_USERS = (UINT)HKEY_USERS } -- , PKEYERFORMANCE_DATA NT only -- , HKEY_DYN_DATA 95/98 only regCloseKey :: HKEY -> IO () regCloseKey key = withForeignPtr key $ \ p_key -> failUnlessSuccess "RegCloseKey" $ c_RegCloseKey p_key foreign import stdcall unsafe "windows.h RegCloseKey" c_RegCloseKey :: PKEY -> IO ErrCode -- Connects to a predefined registry handle on another computer. regConnectRegistry :: Maybe String -> HKEY -> IO HKEY regConnectRegistry mb_machine key = withForeignPtr key $ \ p_key -> maybeWith withTString mb_machine $ \ c_machine -> alloca $ \ p_out_key -> do failUnlessSuccess "RegConnectRegistry" $ c_RegConnectRegistry c_machine p_key p_out_key p_new_key <- peek p_out_key newForeignHANDLE p_new_key foreign import stdcall unsafe "windows.h RegConnectRegistryW" c_RegConnectRegistry :: LPCTSTR -> PKEY -> Ptr PKEY -> IO ErrCode regCreateKey :: HKEY -> String -> IO HKEY regCreateKey key subkey = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> alloca $ \ p_out_key -> do failUnlessSuccess "RegCreateKey" $ c_RegCreateKey p_key c_subkey p_out_key p_new_key <- peek p_out_key newForeignHANDLE p_new_key foreign import stdcall unsafe "windows.h RegCreateKeyW" c_RegCreateKey :: PKEY -> LPCTSTR -> Ptr PKEY -> IO ErrCode type RegCreateOptions = DWORD #{enum RegCreateOptions, , rEG_OPTION_NON_VOLATILE = REG_OPTION_NON_VOLATILE , rEG_OPTION_VOLATILE = REG_OPTION_VOLATILE } type REGSAM = #{type REGSAM} #{enum REGSAM, , kEY_ALL_ACCESS = KEY_ALL_ACCESS , kEY_CREATE_LINK = KEY_CREATE_LINK , kEY_CREATE_SUB_KEY = KEY_CREATE_SUB_KEY , kEY_ENUMERATE_SUB_KEYS = KEY_ENUMERATE_SUB_KEYS , kEY_EXECUTE = KEY_EXECUTE , kEY_NOTIFY = KEY_NOTIFY , kEY_QUERY_VALUE = KEY_QUERY_VALUE , kEY_READ = KEY_READ , kEY_SET_VALUE = KEY_SET_VALUE , kEY_WRITE = KEY_WRITE } regCreateKeyEx :: HKEY -> String -> String -> RegCreateOptions -> REGSAM -> Maybe LPSECURITY_ATTRIBUTES -> IO (HKEY, Bool) regCreateKeyEx key subkey cls opts sam mb_attr = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> withTString cls $ \ c_cls -> alloca $ \ p_res -> alloca $ \ p_disp -> do failUnlessSuccess "RegCreateKeyEx" $ c_RegCreateKeyEx p_key c_subkey 0 c_cls opts sam (maybePtr mb_attr) p_res p_disp p_out_key <- peek p_res out_key <- newForeignHANDLE p_out_key disp <- peek p_disp return (out_key, disp == #{const REG_CREATED_NEW_KEY}) foreign import stdcall unsafe "windows.h RegCreateKeyExW" c_RegCreateKeyEx :: PKEY -> LPCTSTR -> DWORD -> LPCTSTR -> RegCreateOptions -> REGSAM -> LPSECURITY_ATTRIBUTES -> Ptr PKEY -> Ptr DWORD -> IO ErrCode regDeleteKey :: HKEY -> String -> IO () regDeleteKey key subkey = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> failUnlessSuccess "RegDeleteKey" $ c_RegDeleteKey p_key c_subkey foreign import stdcall unsafe "windows.h RegDeleteKeyW" c_RegDeleteKey :: PKEY -> LPCTSTR -> IO ErrCode regDeleteValue :: HKEY -> String -> IO () regDeleteValue key name = withForeignPtr key $ \ p_key -> withTString name $ \ c_name -> failUnlessSuccess "RegDeleteValue" $ c_RegDeleteValue p_key c_name foreign import stdcall unsafe "windows.h RegDeleteValueW" c_RegDeleteValue :: PKEY -> LPCTSTR -> IO ErrCode regEnumKeys :: HKEY -> IO [String] regEnumKeys hkey = do hinfo <- regQueryInfoKey hkey let buflen = 1+max_subkey_len hinfo buf <- mallocBytes (fromIntegral buflen) ls <- go 0 buf buflen free buf return ls where go n buf buflen = do (v,flg) <- regEnumKey hkey n buf buflen if flg /= 0 then return [] else do vs <- go (n+1) buf buflen return (v:vs) regEnumKeyVals :: HKEY -> IO [(String,String,RegValueType)] regEnumKeyVals hkey = do hinfo <- regQueryInfoKey hkey let nmlen = 1+max_value_name_len hinfo -- add spc for terminating NUL. let vallen = 1+max_value_len hinfo nmbuf <- mallocBytes (fromIntegral nmlen) valbuf <- mallocBytes (fromIntegral vallen) ls <- go 0 nmbuf nmlen valbuf vallen free nmbuf free valbuf return ls where go n nmbuf nmlen valbuf vallen = do (ty,nm,flg) <- regEnumValue hkey n nmbuf nmlen valbuf vallen if flg /= 0 then return [] else do val <- case ty of x | x == rEG_SZ -> peekTString (castPtr valbuf) | x == rEG_DWORD -> peekElemOff (castPtr valbuf) 0 >>= \ v -> return (show (v :: DWORD)) | otherwise -> return "<>" vs <- go (n+1) nmbuf nmlen valbuf vallen return ((nm,val,ty):vs) -- It's up to the programmer to ensure that a large enough -- buffer is passed in here. regEnumKey :: HKEY -> DWORD -> LPTSTR -> DWORD -> IO (String, Int) regEnumKey key index c_name len = withForeignPtr key $ \ p_key -> do no_more <- failUnlessSuccessOr eRROR_NO_MORE_ITEMS "RegEnumKey" $ c_RegEnumKey p_key index c_name len str <- peekTString c_name return (str, fromEnum no_more) foreign import stdcall unsafe "windows.h RegEnumKeyW" c_RegEnumKey :: PKEY -> DWORD -> LPTSTR -> DWORD -> IO ErrCode regEnumValue :: HKEY -> DWORD -> LPTSTR -> DWORD -> LPBYTE -> DWORD -> IO (RegValueType, String, Int) regEnumValue key index name name_len value value_len = withForeignPtr key $ \ p_key -> with name_len $ \ p_name_len -> with value_len $ \ p_value_len -> alloca $ \ p_reg_ty -> do no_more <- failUnlessSuccessOr eRROR_NO_MORE_ITEMS "RegEnumValue" $ c_RegEnumValue p_key index name p_name_len nullPtr p_reg_ty value p_value_len reg_ty <- peek p_reg_ty str <- peekTString name return (reg_ty, str, fromEnum no_more) foreign import stdcall unsafe "windows.h RegEnumValueW" c_RegEnumValue :: PKEY -> DWORD -> LPTSTR -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> LPBYTE -> Ptr DWORD -> IO ErrCode eRROR_NO_MORE_ITEMS :: ErrCode eRROR_NO_MORE_ITEMS = #{const ERROR_NO_MORE_ITEMS} regFlushKey :: HKEY -> IO () regFlushKey key = withForeignPtr key $ \ p_key -> failUnlessSuccess "RegFlushKey" $ c_RegFlushKey p_key foreign import stdcall unsafe "windows.h RegFlushKey" c_RegFlushKey :: PKEY -> IO ErrCode -- ifdef FOR_WINDOWS_NT -- RegGetKeySecurity :: HKEY -> SECURITY_INFORMATION -> IO SECURITY_DESCRIPTION -- endif regLoadKey :: HKEY -> String -> String -> IO () regLoadKey key subkey file = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> withTString file $ \ c_file -> failUnlessSuccess "RegLoadKey" $ c_RegLoadKey p_key c_subkey c_file foreign import stdcall unsafe "windows.h RegLoadKeyW" c_RegLoadKey :: PKEY -> LPCTSTR -> LPCTSTR -> IO ErrCode -- ifdef FOR_WINDOWS_NT type RegNotifyOptions = DWORD #{enum RegNotifyOptions, , rEG_NOTIFY_CHANGE_NAME = REG_NOTIFY_CHANGE_NAME , rEG_NOTIFY_CHANGE_ATTRIBUTES = REG_NOTIFY_CHANGE_ATTRIBUTES , rEG_NOTIFY_CHANGE_LAST_SET = REG_NOTIFY_CHANGE_LAST_SET , rEG_NOTIFY_CHANGE_SECURITY = REG_NOTIFY_CHANGE_SECURITY } regNotifyChangeKeyValue :: HKEY -> Bool -> RegNotifyOptions -> HANDLE -> Bool -> IO () regNotifyChangeKeyValue key watch notifyFilter event async = withForeignPtr key $ \ p_key -> failUnlessSuccess "RegNotifyChangeKeyValue" $ c_RegNotifyChangeKeyValue p_key watch notifyFilter event async foreign import stdcall unsafe "windows.h RegNotifyChangeKeyValue" c_RegNotifyChangeKeyValue :: PKEY -> Bool -> RegNotifyOptions -> HANDLE -> Bool -> IO ErrCode -- endif -- for Win 3.x compatibility, use RegOpenKeyEx instead. regOpenKey :: HKEY -> String -> IO HKEY regOpenKey key subkey = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> alloca $ \ p_res -> do failUnlessSuccess "RegOpenKey" $ c_RegOpenKey p_key c_subkey p_res p_res_key <- peek p_res newForeignHANDLE p_res_key foreign import stdcall unsafe "windows.h RegOpenKeyW" c_RegOpenKey :: PKEY -> LPCTSTR -> Ptr PKEY -> IO ErrCode regOpenKeyEx :: HKEY -> String -> REGSAM -> IO HKEY regOpenKeyEx key subkey sam = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> alloca $ \ p_res -> do failUnlessSuccess "RegOpenKeyEx" $ c_RegOpenKeyEx p_key c_subkey 0 sam p_res p_res_key <- peek p_res newForeignHANDLE p_res_key foreign import stdcall unsafe "windows.h RegOpenKeyExW" c_RegOpenKeyEx :: PKEY -> LPCTSTR -> DWORD -> REGSAM -> Ptr PKEY -> IO ErrCode data RegInfoKey = RegInfoKey { class_string :: String, class_id :: Int, subkeys :: Word32, max_subkey_len :: Word32, max_class_len :: Word32, values :: Word32, max_value_name_len :: Word32, max_value_len :: Word32, sec_len :: Int, lastWrite_lo :: Word32, lastWrite_hi :: Word32 } regQueryInfoKey :: HKEY -> IO RegInfoKey regQueryInfoKey key = withForeignPtr key $ \ p_key -> allocaBytes 100 $ \ c_class_string -> alloca $ \ p_class_id -> alloca $ \ p_subkeys -> alloca $ \ p_max_subkey_len -> alloca $ \ p_max_class_len -> alloca $ \ p_values -> alloca $ \ p_max_value_name_len -> alloca $ \ p_max_value_len -> alloca $ \ p_sec_len -> allocaBytes (#{size FILETIME}) $ \ p_lastWrite -> do failUnlessSuccess "RegQueryInfoKey" $ c_RegQueryInfoKey p_key c_class_string p_class_id nullPtr p_subkeys p_max_subkey_len p_max_class_len p_values p_max_value_name_len p_max_value_len p_sec_len p_lastWrite class_string <- peekTString c_class_string class_id <- peek p_class_id subkeys <- peek p_subkeys max_subkey_len <- peek p_max_subkey_len max_class_len <- peek p_max_class_len values <- peek p_values max_value_name_len <- peek p_max_value_name_len max_value_len <- peek p_max_value_len sec_len <- peek p_sec_len lastWrite_lo <- #{peek FILETIME,dwLowDateTime} p_lastWrite lastWrite_hi <- #{peek FILETIME,dwHighDateTime} p_lastWrite return $ RegInfoKey { class_string = class_string , class_id = fromIntegral class_id , subkeys = subkeys , max_subkey_len = max_subkey_len , max_class_len = max_class_len , values = values , max_value_name_len = max_value_name_len , max_value_len = max_value_len , sec_len = fromIntegral sec_len , lastWrite_lo = lastWrite_lo , lastWrite_hi = lastWrite_hi } foreign import stdcall unsafe "windows.h RegQueryInfoKeyW" c_RegQueryInfoKey :: PKEY -> LPTSTR -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr FILETIME -> IO ErrCode -- RegQueryMultipleValues :: HKEY -> IO ([VALENT],String) -- RegQueryValue() isn't really that, it just allows you to -- get at the default values of keys, so we provide our own -- (and better!) version of it. If you want RegQueryValue()s -- behaviour, use regQueryValueKey. regQueryValueKey :: HKEY -> Maybe String -> IO String regQueryValueKey key mb_subkey = withForeignPtr key $ \ p_key -> maybeWith withTString mb_subkey $ \ c_subkey -> alloca $ \ p_value_len -> do failUnlessSuccess "RegQueryValue" $ c_RegQueryValue p_key c_subkey nullPtr p_value_len value_len <- peek p_value_len allocaArray0 (fromIntegral value_len) $ \ c_value -> do failUnlessSuccess "RegQueryValue" $ c_RegQueryValue p_key c_subkey c_value p_value_len peekTString c_value foreign import stdcall unsafe "windows.h RegQueryValueW" c_RegQueryValue :: PKEY -> LPCTSTR -> LPTSTR -> Ptr LONG -> IO ErrCode regQueryValue :: HKEY -> Maybe String -> IO String regQueryValue key mb_subkey = withForeignPtr key $ \ p_key -> maybeWith withTString mb_subkey $ \ c_subkey -> alloca $ \ p_ty -> alloca $ \ p_value_len -> do failUnlessSuccess "RegQueryValue" $ c_RegQueryValueEx p_key c_subkey nullPtr p_ty nullPtr p_value_len ty <- peek p_ty failUnlessSuccess "RegQueryValue" $ return (if ty == rEG_SZ then 0 else 1) value_len <- peek p_value_len allocaArray0 (fromIntegral value_len) $ \ c_value -> do failUnlessSuccess "RegQueryValue" $ c_RegQueryValueEx p_key c_subkey nullPtr p_ty c_value p_value_len peekTString (castPtr c_value) regQueryValueEx :: HKEY -> String -> LPBYTE -> Int -> IO RegValueType regQueryValueEx key name value value_len = withForeignPtr key $ \ p_key -> withTString name $ \ c_name -> alloca $ \ p_ty -> with (fromIntegral value_len) $ \ p_value_len -> do failUnlessSuccess "RegQueryValueEx" $ c_RegQueryValueEx p_key c_name nullPtr p_ty value p_value_len peek p_ty foreign import stdcall unsafe "windows.h RegQueryValueExW" c_RegQueryValueEx :: PKEY -> LPCTSTR -> Ptr DWORD -> Ptr DWORD -> LPBYTE -> Ptr DWORD -> IO ErrCode regReplaceKey :: HKEY -> String -> String -> String -> IO () regReplaceKey key subkey newfile oldfile = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> withTString newfile $ \ c_newfile -> withTString oldfile $ \ c_oldfile -> failUnlessSuccess "RegReplaceKey" $ c_RegReplaceKey p_key c_subkey c_newfile c_oldfile foreign import stdcall unsafe "windows.h RegReplaceKeyW" c_RegReplaceKey :: PKEY -> LPCTSTR -> LPCTSTR -> LPCTSTR -> IO ErrCode type RegRestoreFlags = DWORD #{enum RegRestoreFlags, , rEG_WHOLE_HIVE_VOLATILE = REG_WHOLE_HIVE_VOLATILE , rEG_REFRESH_HIVE = REG_REFRESH_HIVE , rEG_NO_LAZY_FLUSH = REG_NO_LAZY_FLUSH } regRestoreKey :: HKEY -> String -> RegRestoreFlags -> IO () regRestoreKey key file flags = withForeignPtr key $ \ p_key -> withTString file $ \ c_file -> failUnlessSuccess "RegRestoreKey" $ c_RegRestoreKey p_key c_file flags foreign import stdcall unsafe "windows.h RegRestoreKeyW" c_RegRestoreKey :: PKEY -> LPCTSTR -> RegRestoreFlags -> IO ErrCode regSaveKey :: HKEY -> String -> Maybe LPSECURITY_ATTRIBUTES -> IO () regSaveKey key file mb_attr = withForeignPtr key $ \ p_key -> withTString file $ \ c_file -> failUnlessSuccess "RegSaveKey" $ c_RegSaveKey p_key c_file (maybePtr mb_attr) foreign import stdcall unsafe "windows.h RegSaveKeyW" c_RegSaveKey :: PKEY -> LPCTSTR -> LPSECURITY_ATTRIBUTES -> IO ErrCode -- ifdef FOR_WINDOWS_NT -- RegSetKeySecurity :: HKEY -> SECURITY_INFORMATION -> SECURITY_DESCRIPTOR -> IO () -- endif -- 3.1 compat. - only allows storage of REG_SZ values. regSetValue :: HKEY -> String -> String -> IO () regSetValue key subkey value = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> withTStringLen value $ \ (c_value, value_len) -> failUnlessSuccess "RegSetValue" $ c_RegSetValue p_key c_subkey rEG_SZ c_value value_len foreign import stdcall unsafe "windows.h RegSetValueW" c_RegSetValue :: PKEY -> LPCTSTR -> DWORD -> LPCTSTR -> Int -> IO ErrCode type RegValueType = DWORD #{enum RegValueType, , rEG_BINARY = REG_BINARY , rEG_DWORD = REG_DWORD , rEG_DWORD_LITTLE_ENDIAN = REG_DWORD_LITTLE_ENDIAN , rEG_DWORD_BIG_ENDIAN = REG_DWORD_BIG_ENDIAN , rEG_EXPAND_SZ = REG_EXPAND_SZ , rEG_LINK = REG_LINK , rEG_MULTI_SZ = REG_MULTI_SZ , rEG_NONE = REG_NONE , rEG_RESOURCE_LIST = REG_RESOURCE_LIST , rEG_SZ = REG_SZ } -- regSetValueEx has a somewhat wieldly interface if all you want to do is -- add a string value (a Common Thing to want to do), so we support this -- specially: regSetStringValue :: HKEY -> String -> String -> IO () regSetStringValue hk key val = withTString val $ \ v -> regSetValueEx hk key rEG_SZ v (length val) regSetValueEx :: HKEY -> String -> RegValueType -> LPTSTR -> Int -> IO () regSetValueEx key subkey ty value value_len = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> failUnlessSuccess "RegSetValueEx" $ c_RegSetValueEx p_key c_subkey 0 ty value value_len foreign import stdcall unsafe "windows.h RegSetValueExW" c_RegSetValueEx :: PKEY -> LPCTSTR -> DWORD -> RegValueType -> LPTSTR -> Int -> IO ErrCode regUnLoadKey :: HKEY -> String -> IO () regUnLoadKey key subkey = withForeignPtr key $ \ p_key -> withTString subkey $ \ c_subkey -> failUnlessSuccess "RegUnLoadKey" $ c_RegUnLoadKey p_key c_subkey foreign import stdcall unsafe "windows.h RegUnLoadKeyW" c_RegUnLoadKey :: PKEY -> LPCTSTR -> IO ErrCode hugs98-plus-Sep2006/packages/Win32/System/Win32/Types.hs0000644006511100651110000001701110504340503021263 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.Types -- Copyright : (c) Alastair Reid, 1997-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32. -- ----------------------------------------------------------------------------- module System.Win32.Types ( module System.Win32.Types , nullPtr ) where import Data.Maybe import Foreign import Foreign.C import Numeric (showHex) ---------------------------------------------------------------- -- Platform specific definitions -- -- Most typedefs and prototypes in Win32 are expressed in terms -- of these types. Try to follow suit - it'll make it easier to -- get things working on Win64 (or whatever they call it on Alphas). ---------------------------------------------------------------- type BOOL = Bool type BYTE = Word8 type USHORT = Word16 type UINT = Word32 type INT = Int32 type WORD = Word16 type DWORD = Word32 type LONG = Int32 type FLOAT = Float type LARGE_INTEGER = Int64 -- Not really a basic type, but used in many places type DDWORD = Word64 ---------------------------------------------------------------- type MbString = Maybe String type MbINT = Maybe INT type ATOM = UINT type WPARAM = UINT type LPARAM = LONG type LRESULT = LONG type SIZE_T = DWORD type MbATOM = Maybe ATOM ---------------------------------------------------------------- -- Pointers ---------------------------------------------------------------- type Addr = Ptr () type LPVOID = Ptr () type LPBYTE = Ptr BYTE type LPSTR = Ptr CChar type LPCSTR = LPSTR type LPWSTR = Ptr CWchar type LPCWSTR = LPWSTR type LPTSTR = Ptr TCHAR type LPCTSTR = LPTSTR type LPCTSTR_ = LPCTSTR -- Optional things with defaults maybePtr :: Maybe (Ptr a) -> Ptr a maybePtr = fromMaybe nullPtr ptrToMaybe :: Ptr a -> Maybe (Ptr a) ptrToMaybe p = if p == nullPtr then Nothing else Just p maybeNum :: Num a => Maybe a -> a maybeNum = fromMaybe 0 numToMaybe :: Num a => a -> Maybe a numToMaybe n = if n == 0 then Nothing else Just n type MbLPVOID = Maybe LPVOID type MbLPCSTR = Maybe LPCSTR type MbLPCTSTR = Maybe LPCTSTR ---------------------------------------------------------------- -- Chars and strings ---------------------------------------------------------------- withTString :: String -> (LPTSTR -> IO a) -> IO a withTStringLen :: String -> ((LPTSTR, Int) -> IO a) -> IO a peekTString :: LPCTSTR -> IO String peekTStringLen :: (LPCTSTR, Int) -> IO String newTString :: String -> IO LPCTSTR -- UTF-16 version: type TCHAR = CWchar withTString = withCWString withTStringLen = withCWStringLen peekTString = peekCWString peekTStringLen = peekCWStringLen newTString = newCWString {- ANSI version: type TCHAR = CChar withTString = withCString withTStringLen = withCStringLen peekTString = peekCString peekTStringLen = peekCStringLen newTString = newCString -} ---------------------------------------------------------------- -- Handles ---------------------------------------------------------------- type HANDLE = Ptr () type ForeignHANDLE = ForeignPtr () newForeignHANDLE :: HANDLE -> IO ForeignHANDLE newForeignHANDLE = newForeignPtr deleteObject_p handleToWord :: HANDLE -> UINT handleToWord = castPtrToUINT type HKEY = ForeignHANDLE type PKEY = HANDLE nullHANDLE :: HANDLE nullHANDLE = nullPtr type MbHANDLE = Maybe HANDLE type HINSTANCE = Ptr () type MbHINSTANCE = Maybe HINSTANCE type HMODULE = Ptr () type MbHMODULE = Maybe HMODULE nullFinalHANDLE :: ForeignPtr a nullFinalHANDLE = unsafePerformIO (newForeignPtr_ nullPtr) iNVALID_HANDLE_VALUE :: HANDLE iNVALID_HANDLE_VALUE = castUINTToPtr 0xffffffff ---------------------------------------------------------------- -- Errors ---------------------------------------------------------------- type ErrCode = DWORD failIf :: (a -> Bool) -> String -> IO a -> IO a failIf p wh act = do v <- act if p v then errorWin wh else return v failIf_ :: (a -> Bool) -> String -> IO a -> IO () failIf_ p wh act = do v <- act if p v then errorWin wh else return () failIfNull :: String -> IO (Ptr a) -> IO (Ptr a) failIfNull = failIf (== nullPtr) failIfZero :: Num a => String -> IO a -> IO a failIfZero = failIf (== 0) failIfFalse_ :: String -> IO Bool -> IO () failIfFalse_ = failIf_ not failUnlessSuccess :: String -> IO ErrCode -> IO () failUnlessSuccess fn_name act = do r <- act if r == 0 then return () else failWith fn_name r failUnlessSuccessOr :: ErrCode -> String -> IO ErrCode -> IO Bool failUnlessSuccessOr val fn_name act = do r <- act if r == 0 then return False else if r == val then return True else failWith fn_name r errorWin :: String -> IO a errorWin fn_name = do err_code <- getLastError failWith fn_name err_code failWith :: String -> ErrCode -> IO a failWith fn_name err_code = do c_msg <- getErrorMessage err_code msg <- peekTString c_msg localFree c_msg fail (fn_name ++ ": " ++ msg ++ " (error code: " ++ showHex err_code ")") ---------------------------------------------------------------- -- Misc helpers ---------------------------------------------------------------- ddwordToDwords :: DDWORD -> (DWORD,DWORD) ddwordToDwords n = (fromIntegral (n `shiftR` bitSize (undefined::DWORD)) ,fromIntegral (n .&. fromIntegral (maxBound :: DWORD))) dwordsToDdword:: (DWORD,DWORD) -> DDWORD dwordsToDdword (hi,low) = (fromIntegral low) .|. (fromIntegral hi `shiftL`bitSize hi) ---------------------------------------------------------------- -- Primitives ---------------------------------------------------------------- foreign import stdcall unsafe "windows.h &DeleteObject" deleteObject_p :: FunPtr (HANDLE -> IO ()) foreign import stdcall unsafe "windows.h LocalFree" localFree :: Ptr a -> IO (Ptr a) foreign import stdcall unsafe "windows.h GetLastError" getLastError :: IO ErrCode {-# CFILES cbits/errors.c #-} foreign import ccall unsafe "errors.h" getErrorMessage :: DWORD -> IO LPWSTR {-# CFILES cbits/HsWin32.c #-} foreign import ccall unsafe "HsWin32.h" lOWORD :: DWORD -> WORD foreign import ccall unsafe "HsWin32.h" hIWORD :: DWORD -> WORD foreign import ccall unsafe "HsWin32.h" castUINTToPtr :: UINT -> Ptr a foreign import ccall unsafe "HsWin32.h" castPtrToUINT :: Ptr s -> UINT foreign import ccall unsafe "HsWin32.h" castFunPtrToLONG :: FunPtr a -> LONG type LCID = DWORD type LANGID = WORD type SortID = WORD foreign import ccall unsafe "HsWin32.h prim_MAKELCID" mAKELCID :: LANGID -> SortID -> LCID foreign import ccall unsafe "HsWin32.h prim_LANGIDFROMLCID" lANGIDFROMLCID :: LCID -> LANGID foreign import ccall unsafe "HsWin32.h prim_SORTIDFROMLCID" sORTIDFROMLCID :: LCID -> SortID type SubLANGID = WORD type PrimaryLANGID = WORD foreign import ccall unsafe "HsWin32.h prim_MAKELANGID" mAKELANGID :: PrimaryLANGID -> SubLANGID -> LANGID foreign import ccall unsafe "HsWin32.h prim_PRIMARYLANGID" pRIMARYLANGID :: LANGID -> PrimaryLANGID foreign import ccall unsafe "HsWin32.h prim_SUBLANGID" sUBLANGID :: LANGID -> SubLANGID ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/System/Win32/Time.hsc0000644006511100651110000003252610504340503021230 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.Time -- Copyright : (c) Esa Ilari Vuokko, 2006 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32 Time API. -- ----------------------------------------------------------------------------- module System.Win32.Time where import System.Win32.Types ( DWORD, WORD, LONG, BOOL, failIf, failIf_, HANDLE , peekTStringLen, LCID, LPTSTR, LPCTSTR, DDWORD , LARGE_INTEGER, ddwordToDwords, dwordsToDdword ) import Control.Monad ( when, liftM3, liftM ) import Data.Word ( Word8 ) import Foreign ( Storable(sizeOf, alignment, peekByteOff, peek, pokeByteOff, poke) , Ptr, nullPtr, castPtr, plusPtr, advancePtr , with, alloca, allocaBytes, copyArray ) import Foreign.C ( CInt, CWchar , peekCWString, withCWStringLen, withCWString ) #include "windows.h" ---------------------------------------------------------------- -- data types ---------------------------------------------------------------- newtype FILETIME = FILETIME DDWORD deriving (Show, Eq, Ord) data SYSTEMTIME = SYSTEMTIME { wYear, wMonth, wDayOfWeek, wDay, wHour, wMinute, wSecond, wMilliseconds :: WORD } deriving (Show, Eq, Ord) data TIME_ZONE_INFORMATION = TIME_ZONE_INFORMATION { tziBias :: LONG , tziStandardName :: String , tziStandardDate :: SYSTEMTIME , tziStandardBias :: LONG , tziDaylightName :: String , tziDaylightDate :: SYSTEMTIME , tziDaylightBias :: LONG } deriving (Show,Eq,Ord) data TimeZoneId = TzIdUnknown | TzIdStandard | TzIdDaylight deriving (Show, Eq, Ord) ---------------------------------------------------------------- -- Instances ---------------------------------------------------------------- instance Storable FILETIME where sizeOf = const (#size FILETIME) alignment = sizeOf poke buf (FILETIME n) = do (#poke FILETIME, dwLowDateTime) buf low (#poke FILETIME, dwHighDateTime) buf hi where (hi,low) = ddwordToDwords n peek buf = do low <- (#peek FILETIME, dwLowDateTime) buf hi <- (#peek FILETIME, dwHighDateTime) buf return $ FILETIME $ dwordsToDdword (hi,low) instance Storable SYSTEMTIME where sizeOf _ = #size SYSTEMTIME alignment = sizeOf poke buf st = do (#poke SYSTEMTIME, wYear) buf (wYear st) (#poke SYSTEMTIME, wMonth) buf (wMonth st) (#poke SYSTEMTIME, wDayOfWeek) buf (wDayOfWeek st) (#poke SYSTEMTIME, wDay) buf (wDay st) (#poke SYSTEMTIME, wHour) buf (wHour st) (#poke SYSTEMTIME, wMinute) buf (wMinute st) (#poke SYSTEMTIME, wSecond) buf (wSecond st) (#poke SYSTEMTIME, wMilliseconds) buf (wMilliseconds st) peek buf = do year <- (#peek SYSTEMTIME, wYear) buf month <- (#peek SYSTEMTIME, wMonth) buf dow <- (#peek SYSTEMTIME, wDayOfWeek) buf day <- (#peek SYSTEMTIME, wDay) buf hour <- (#peek SYSTEMTIME, wHour) buf min <- (#peek SYSTEMTIME, wMinute) buf sec <- (#peek SYSTEMTIME, wSecond) buf ms <- (#peek SYSTEMTIME, wMilliseconds) buf return $ SYSTEMTIME year month dow day hour min sec ms instance Storable TIME_ZONE_INFORMATION where sizeOf _ = (#size TIME_ZONE_INFORMATION) alignment = sizeOf poke buf tzi = do (#poke TIME_ZONE_INFORMATION, Bias) buf (tziBias tzi) (#poke TIME_ZONE_INFORMATION, StandardDate) buf (tziStandardDate tzi) (#poke TIME_ZONE_INFORMATION, StandardBias) buf (tziStandardBias tzi) (#poke TIME_ZONE_INFORMATION, DaylightDate) buf (tziDaylightDate tzi) (#poke TIME_ZONE_INFORMATION, DaylightBias) buf (tziDaylightBias tzi) write buf (#offset TIME_ZONE_INFORMATION, StandardName) (tziStandardName tzi) write buf (#offset TIME_ZONE_INFORMATION, DaylightName) (tziDaylightName tzi) where write buf offset str = withCWStringLen str $ \(str,len) -> do when (len>31) $ fail "Storable TIME_ZONE_INFORMATION.poke: Too long string." let start = (advancePtr (castPtr buf) offset) end = advancePtr start len copyArray (castPtr str :: Ptr Word8) start len poke end 0 peek buf = do bias <- (#peek TIME_ZONE_INFORMATION, Bias) buf sdat <- (#peek TIME_ZONE_INFORMATION, StandardDate) buf sbia <- (#peek TIME_ZONE_INFORMATION, StandardBias) buf ddat <- (#peek TIME_ZONE_INFORMATION, DaylightDate) buf dbia <- (#peek TIME_ZONE_INFORMATION, DaylightBias) buf snam <- peekCWString (plusPtr buf (#offset TIME_ZONE_INFORMATION, StandardName)) dnam <- peekCWString (plusPtr buf (#offset TIME_ZONE_INFORMATION, DaylightName)) return $ TIME_ZONE_INFORMATION bias snam sdat sbia dnam ddat dbia foreign import stdcall "windows.h GetSystemTime" c_GetSystemTime :: Ptr SYSTEMTIME -> IO () getSystemTime :: IO SYSTEMTIME getSystemTime = alloca $ \res -> do c_GetSystemTime res peek res foreign import stdcall "windows.h SetSystemTime" c_SetSystemTime :: Ptr SYSTEMTIME -> IO BOOL setSystemTime :: SYSTEMTIME -> IO () setSystemTime st = with st $ \st -> failIf_ not "setSystemTime: SetSystemTime" $ c_SetSystemTime st foreign import stdcall "windows.h GetSystemTimeAsFileTime" c_GetSystemTimeAsFileTime :: Ptr FILETIME -> IO () getSystemTimeAsFileTime :: IO FILETIME getSystemTimeAsFileTime = alloca $ \ret -> do c_GetSystemTimeAsFileTime ret peek ret foreign import stdcall "windows.h GetLocalTime" c_GetLocalTime :: Ptr SYSTEMTIME -> IO () getLocalTime :: IO SYSTEMTIME getLocalTime = alloca $ \res -> do c_GetLocalTime res peek res foreign import stdcall "windows.h SetLocalTime" c_SetLocalTime :: Ptr SYSTEMTIME -> IO BOOL setLocalTime :: SYSTEMTIME -> IO () setLocalTime st = with st $ \st -> failIf_ not "setLocalTime: SetLocalTime" $ c_SetLocalTime st foreign import stdcall "windows.h GetSystemTimeAdjustment" c_GetSystemTimeAdjustment :: Ptr DWORD -> Ptr DWORD -> Ptr BOOL -> IO BOOL getSystemTimeAdjustment :: IO (Maybe (Int, Int)) getSystemTimeAdjustment = alloca $ \ta -> alloca $ \ti -> alloca $ \enabled -> do failIf not "getSystemTimeAdjustment: GetSystemTimeAdjustment" $ c_GetSystemTimeAdjustment ta ti enabled enabled <- peek enabled if enabled then do ta <- peek ta ti <- peek ti return $ Just (fromIntegral ta, fromIntegral ti) else return Nothing foreign import stdcall "windows.h GetTickCount" getTickCount :: IO DWORD foreign import stdcall "windows.h SetSystemTimeAdjustment" c_SetSystemTimeAdjustment :: DWORD -> BOOL -> IO BOOL setSystemTimeAdjustment :: Maybe Int -> IO () setSystemTimeAdjustment ta = failIf_ not "setSystemTimeAjustment: SetSystemTimeAdjustment" $ c_SetSystemTimeAdjustment time disabled where (time,disabled) = case ta of Nothing -> (0,True) Just x -> (fromIntegral x,False) foreign import stdcall "windows.h GetTimeZoneInformation" c_GetTimeZoneInformation :: Ptr TIME_ZONE_INFORMATION -> IO DWORD getTimeZoneInformation :: IO (TimeZoneId, TIME_ZONE_INFORMATION) getTimeZoneInformation = alloca $ \tzi -> do tz <- failIf (==(#const TIME_ZONE_ID_INVALID)) "getTimeZoneInformation: GetTimeZoneInformation" $ c_GetTimeZoneInformation tzi tzi <- peek tzi return . flip (,) tzi $ case tz of (#const TIME_ZONE_ID_UNKNOWN) -> TzIdUnknown (#const TIME_ZONE_ID_STANDARD) -> TzIdStandard (#const TIME_ZONE_ID_DAYLIGHT) -> TzIdDaylight _ -> TzIdUnknown -- to remove warning foreign import stdcall "windows.h SystemTimeToFileTime" c_SystemTimeToFileTime :: Ptr SYSTEMTIME -> Ptr FILETIME -> IO BOOL systemTimeToFileTime :: SYSTEMTIME -> IO FILETIME systemTimeToFileTime s = with s $ \s -> alloca $ \ret -> do failIf not "systemTimeToFileTime: SystemTimeToFileTime" $ c_SystemTimeToFileTime s ret peek ret foreign import stdcall "windows.h FileTimeToSystemTime" c_FileTimeToSystemTime :: Ptr FILETIME -> Ptr SYSTEMTIME -> IO BOOL fileTimeToSystemTime :: FILETIME -> IO SYSTEMTIME fileTimeToSystemTime s = with s $ \s -> alloca $ \ret -> do failIf not "fileTimeToSystemTime: FileTimeToSystemTime" $ c_FileTimeToSystemTime s ret peek ret foreign import stdcall "windows.h GetFileTime" c_GetFileTime :: HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL getFileTime :: HANDLE -> IO (FILETIME,FILETIME,FILETIME) getFileTime h = alloca $ \crt -> alloca $ \acc -> alloca $ \wrt -> do failIf not "getFileTime: GetFileTime" $ c_GetFileTime h crt acc wrt liftM3 (,,) (peek crt) (peek acc) (peek wrt) foreign import stdcall "windows.h SetFileTime" c_SetFileTime :: HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL setFileTime :: HANDLE -> FILETIME -> FILETIME -> FILETIME -> IO () setFileTime h crt acc wrt = with crt $ \crt -> with acc $ \acc -> with wrt $ \wrt -> do failIf not "setFileTime: SetFileTime" $ c_SetFileTime h crt acc wrt return () foreign import stdcall "windows.h FileTimeToLocalFileTime" c_FileTimeToLocalFileTime :: Ptr FILETIME -> Ptr FILETIME -> IO BOOL fileTimeToLocalFileTime :: FILETIME -> IO FILETIME fileTimeToLocalFileTime ft = with ft $ \ft -> alloca $ \res -> do failIf not "fileTimeToLocalFileTime: FileTimeToLocalFileTime" $ c_FileTimeToLocalFileTime ft res peek res foreign import stdcall "windows.h LocalFileTimeToFileTime" c_LocalFileTimeToFileTime :: Ptr FILETIME -> Ptr FILETIME -> IO BOOL localFileTimeToFileTime :: FILETIME -> IO FILETIME localFileTimeToFileTime ft = with ft $ \ft -> alloca $ \res -> do failIf not "localFileTimeToFileTime: LocalFileTimeToFileTime" $ c_LocalFileTimeToFileTime ft res peek res {- -- Windows XP SP1 foreign import stdcall "windows.h GetSystemTimes" c_GetSystemTimes :: Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL getSystemTimes :: IO (FILETIME,FILETIME,FILETIME) getSystemTimes = alloca $ \idle -> alloca $ \kernel -> alloca $ \user -> do failIf not "getSystemTimes: GetSystemTimes" $ c_GetSystemTimes idle kernel user liftM3 (,,) (peek idle) (peek kernel) (peek user) -} {- -- Windows XP foreign import stdcall "windows.h SystemTimeToTzSpecificLocalTime" c_SystemTimeToTzSpecificLocalTime :: Ptr TIME_ZONE_INFORMATION -> Ptr SYSTEMTIME -> Ptr SYSTEMTIME -> IO BOOL systemTimeToTzSpecificLocalTime :: TIME_ZONE_INFORMATION -> SYSTEMTIME -> IO SYSTEMTIME systemTimeToTzSpecificLocalTime tzi st = with tzi $ \tzi -> with st $ \st -> alloca $ \res -> do failIf not "systemTimeToTzSpecificLocalTime: SystemTimeToTzSpecificLocalTime" $ c_SystemTimeToTzSpecificLocalTime tzi st res peek res foreign import stdcall "windows.h TzSpecificLocalTimeToSystemTime" c_TzSpecificLocalTimeToSystemTime :: Ptr TIME_ZONE_INFORMATION -> Ptr SYSTEMTIME -> Ptr SYSTEMTIME -> IO BOOL tzSpecificLocalTimeToSystemTime :: TIME_ZONE_INFORMATION -> SYSTEMTIME -> IO SYSTEMTIME tzSpecificLocalTimeToSystemTime tzi st = with tzi $ \tzi -> with st $ \st -> alloca $ \res -> do failIf not "tzSpecificLocalTimeToSystemTime: TzSpecificLocalTimeToSystemTime" $ c_TzSpecificLocalTimeToSystemTime tzi st res peek res -} foreign import stdcall "windows.h QueryPerformanceFrequency" c_QueryPerformanceFrequency :: Ptr LARGE_INTEGER -> IO BOOL queryPerformanceFrequency :: IO Integer queryPerformanceFrequency = alloca $ \res -> do failIf not "queryPerformanceFrequency: QueryPerformanceFrequency" $ c_QueryPerformanceFrequency res liftM fromIntegral $ peek res foreign import stdcall "windows.h QueryPerformanceCounter" c_QueryPerformanceCounter:: Ptr LARGE_INTEGER -> IO BOOL queryPerformanceCounter:: IO Integer queryPerformanceCounter= alloca $ \res -> do failIf not "queryPerformanceCounter: QueryPerformanceCounter" $ c_QueryPerformanceCounter res liftM fromIntegral $ peek res type GetTimeFormatFlags = DWORD #{enum GetTimeFormatFlags, , lOCALE_NOUSEROVERRIDE = LOCALE_NOUSEROVERRIDE , lOCALE_USE_CP_ACP = LOCALE_USE_CP_ACP , tIME_NOMINUTESORSECONDS = TIME_NOMINUTESORSECONDS , tIME_NOSECONDS = TIME_NOSECONDS , tIME_NOTIMEMARKER = TIME_NOTIMEMARKER , tIME_FORCE24HOURFORMAT= TIME_FORCE24HOURFORMAT } foreign import stdcall "windows.h GetTimeFormatW" c_GetTimeFormat :: LCID -> GetTimeFormatFlags -> Ptr SYSTEMTIME -> LPCTSTR -> LPTSTR -> CInt -> IO CInt getTimeFormat :: LCID -> GetTimeFormatFlags -> SYSTEMTIME -> String -> IO String getTimeFormat locale flags st fmt = with st $ \st -> withCWString fmt $ \fmt -> do size <- c_GetTimeFormat locale flags st fmt nullPtr 0 allocaBytes ((fromIntegral size) * (sizeOf (undefined::CWchar))) $ \out -> do size <- failIf (==0) "getTimeFormat: GetTimeFormat" $ c_GetTimeFormat locale flags st fmt (castPtr out) (fromIntegral size) peekTStringLen (out,fromIntegral size) hugs98-plus-Sep2006/packages/Win32/System/Win32/Console.hsc0000644006511100651110000000307410504340503021730 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.Console -- Copyright : (c) University of Glasgow 2006 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for interfacing with Win32 Console API -- ----------------------------------------------------------------------------- module System.Win32.Console ( -- * Console code pages getConsoleCP, setConsoleCP, getConsoleOutputCP, setConsoleOutputCP, -- * Ctrl events CtrlEvent, cTRL_C_EVENT, cTRL_BREAK_EVENT, generateConsoleCtrlEvent ) where import System.Win32.Types foreign import stdcall unsafe "windows.h GetConsoleCP" getConsoleCP :: IO UINT foreign import stdcall unsafe "windows.h SetConsoleCP" setConsoleCP :: UINT -> IO () foreign import stdcall unsafe "windows.h GetConsoleOutputCP" getConsoleOutputCP :: IO UINT foreign import stdcall unsafe "windows.h SetConsoleOutputCP" setConsoleOutputCP :: UINT -> IO () type CtrlEvent = DWORD #{enum CtrlEvent, , cTRL_C_EVENT = 0 , cTRL_BREAK_EVENT = 1 } generateConsoleCtrlEvent :: CtrlEvent -> DWORD -> IO () generateConsoleCtrlEvent e p = failIfFalse_ "generateConsoleCtrlEvent" $ c_GenerateConsoleCtrlEvent e p foreign import stdcall safe "windows.h GenerateConsoleCtrlEvent" c_GenerateConsoleCtrlEvent :: CtrlEvent -> DWORD -> IO BOOL -- ToDo: lots more hugs98-plus-Sep2006/packages/Win32/System/Win32/DebugApi.hsc0000644006511100651110000003576010504340503022015 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.DebugApi -- Copyright : (c) Esa Ilari Vuokko, 2006 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- A collection of FFI declarations for using Windows DebugApi. -- ----------------------------------------------------------------------------- module System.Win32.DebugApi where import Control.Exception( bracket_ ) import Data.Word ( Word8, Word32 ) import Foreign ( Ptr, nullPtr, ForeignPtr, mallocForeignPtrBytes , peekByteOff, plusPtr, allocaBytes, castPtr, poke , withForeignPtr, Storable, sizeOf, peek, pokeByteOff ) import System.IO ( fixIO ) import System.Win32.Types ( HANDLE, BOOL, WORD, DWORD, failIf_, failWith , getLastError, failIf, LPTSTR, withTString ) #include "windows.h" type PID = DWORD type TID = DWORD type DebugEventId = (PID, TID) type ForeignAddress = Word32 type PHANDLE = Ptr () type THANDLE = Ptr () type ThreadInfo = (THANDLE, ForeignAddress, ForeignAddress) -- handle to thread, thread local, thread start type ImageInfo = (HANDLE, ForeignAddress, DWORD, DWORD, ForeignAddress) type ExceptionInfo = (Bool, Bool, ForeignAddress) -- First chance, continuable, address data Exception = UnknownException | AccessViolation Bool ForeignAddress | ArrayBoundsExceeded | Breakpoint | DataTypeMisalignment | FltDenormalOperand | FltDivideByZero | FltInexactResult | FltInvalidOperation | FltOverflow | FltStackCheck | FltUnderflow | IllegalInstruction | InPageError | IntDivideByZero | IntOverflow | InvalidDisposition | NonContinuable | PrivilegedInstruction | SingleStep | StackOverflow deriving (Show) data DebugEventInfo = UnknownDebugEvent | Exception ExceptionInfo Exception | CreateThread ThreadInfo | CreateProcess PHANDLE ImageInfo ThreadInfo | ExitThread TID | ExitProcess PID | LoadDll ImageInfo | UnloadDll TID | DebugString ForeignAddress Bool WORD deriving (Show) type DebugEvent = (DebugEventId, DebugEventInfo) -------------------------------------------------------------------------- -- Handling debugevents peekDebugEvent :: Ptr a -> IO DebugEvent peekDebugEvent p = do code <- (#peek DEBUG_EVENT, dwDebugEventCode) p pid <- (#peek DEBUG_EVENT, dwProcessId) p tid <- (#peek DEBUG_EVENT, dwThreadId) p r <- rest (code::DWORD) (plusPtr p (#offset DEBUG_EVENT, u)) return ((pid,tid), r) where dwZero = 0 :: DWORD wZero = 0 :: WORD rest (#const EXCEPTION_DEBUG_EVENT) p = do chance <- (#peek EXCEPTION_DEBUG_INFO, dwFirstChance) p flags <- (#peek EXCEPTION_RECORD, ExceptionFlags) p addr <- (#peek EXCEPTION_RECORD, ExceptionAddress) p code <- (#peek EXCEPTION_RECORD, ExceptionCode) p e <- case code::DWORD of (#const EXCEPTION_ACCESS_VIOLATION) -> return $ AccessViolation False 0 (#const EXCEPTION_ARRAY_BOUNDS_EXCEEDED) -> return ArrayBoundsExceeded (#const EXCEPTION_BREAKPOINT) -> return Breakpoint (#const EXCEPTION_DATATYPE_MISALIGNMENT) -> return DataTypeMisalignment (#const EXCEPTION_FLT_DENORMAL_OPERAND) -> return FltDenormalOperand (#const EXCEPTION_FLT_DIVIDE_BY_ZERO) -> return FltDivideByZero (#const EXCEPTION_FLT_INEXACT_RESULT) -> return FltInexactResult (#const EXCEPTION_FLT_INVALID_OPERATION) -> return FltInvalidOperation (#const EXCEPTION_FLT_OVERFLOW) -> return FltOverflow (#const EXCEPTION_FLT_STACK_CHECK) -> return FltStackCheck (#const EXCEPTION_FLT_UNDERFLOW) -> return FltUnderflow (#const EXCEPTION_ILLEGAL_INSTRUCTION) -> return IllegalInstruction (#const EXCEPTION_IN_PAGE_ERROR) -> return InPageError (#const EXCEPTION_INT_DIVIDE_BY_ZERO) -> return IntDivideByZero (#const EXCEPTION_INT_OVERFLOW) -> return IntOverflow (#const EXCEPTION_INVALID_DISPOSITION) -> return InvalidDisposition (#const EXCEPTION_NONCONTINUABLE_EXCEPTION) -> return NonContinuable (#const EXCEPTION_PRIV_INSTRUCTION) -> return PrivilegedInstruction (#const EXCEPTION_SINGLE_STEP) -> return SingleStep (#const EXCEPTION_STACK_OVERFLOW) -> return StackOverflow _ -> return UnknownException return $ Exception (chance/=dwZero, flags==dwZero, addr) e rest (#const CREATE_THREAD_DEBUG_EVENT) p = do handle <- (#peek CREATE_THREAD_DEBUG_INFO, hThread) p local <- (#peek CREATE_THREAD_DEBUG_INFO, lpThreadLocalBase) p start <- (#peek CREATE_THREAD_DEBUG_INFO, lpStartAddress) p return $ CreateThread (handle, local, start) rest (#const CREATE_PROCESS_DEBUG_EVENT) p = do file <- (#peek CREATE_PROCESS_DEBUG_INFO, hFile) p proc <- (#peek CREATE_PROCESS_DEBUG_INFO, hProcess) p thread <- (#peek CREATE_PROCESS_DEBUG_INFO, hThread) p imgbase <- (#peek CREATE_PROCESS_DEBUG_INFO, lpBaseOfImage) p dbgoff <- (#peek CREATE_PROCESS_DEBUG_INFO, dwDebugInfoFileOffset) p dbgsize <- (#peek CREATE_PROCESS_DEBUG_INFO, nDebugInfoSize) p local <- (#peek CREATE_PROCESS_DEBUG_INFO, lpThreadLocalBase) p start <- (#peek CREATE_PROCESS_DEBUG_INFO, lpStartAddress) p imgname <- (#peek CREATE_PROCESS_DEBUG_INFO, lpImageName) p --unicode <- (#peek CREATE_PROCESS_DEBUG_INFO, fUnicode) p return $ CreateProcess proc (file, imgbase, dbgoff, dbgsize, imgname) --, unicode/=wZero) (thread, local, start) rest (#const EXIT_THREAD_DEBUG_EVENT) p = (#peek EXIT_THREAD_DEBUG_INFO, dwExitCode) p >>= return.ExitThread rest (#const EXIT_PROCESS_DEBUG_EVENT) p = (#peek EXIT_PROCESS_DEBUG_INFO, dwExitCode) p >>= return.ExitProcess rest (#const LOAD_DLL_DEBUG_EVENT) p = do file <- (#peek LOAD_DLL_DEBUG_INFO, hFile) p imgbase <- (#peek LOAD_DLL_DEBUG_INFO, lpBaseOfDll) p dbgoff <- (#peek LOAD_DLL_DEBUG_INFO, dwDebugInfoFileOffset) p dbgsize <- (#peek LOAD_DLL_DEBUG_INFO, nDebugInfoSize) p imgname <- (#peek LOAD_DLL_DEBUG_INFO, lpImageName) p --unicode <- (#peek LOAD_DLL_DEBUG_INFO, fUnicode) p return $ LoadDll (file, imgbase, dbgoff, dbgsize, imgname)--, unicode/=wZero) rest (#const OUTPUT_DEBUG_STRING_EVENT) p = do dat <- (#peek OUTPUT_DEBUG_STRING_INFO, lpDebugStringData) p unicode <- (#peek OUTPUT_DEBUG_STRING_INFO, fUnicode) p length <- (#peek OUTPUT_DEBUG_STRING_INFO, nDebugStringLength) p return $ DebugString dat (unicode/=wZero) length rest (#const UNLOAD_DLL_DEBUG_EVENT) p = (#peek UNLOAD_DLL_DEBUG_INFO, lpBaseOfDll) p >>= return.UnloadDll rest _ _ = return UnknownDebugEvent waitForDebugEvent :: Maybe Int -> IO (Maybe DebugEvent) waitForDebugEvent timeout = allocaBytes (#size DEBUG_EVENT) $ \buf -> do res <- c_WaitForDebugEvent buf $ maybe (#const INFINITE) fromIntegral timeout if res then peekDebugEvent buf >>= return.Just else getLastError >>= \e -> case e of (#const ERROR_INVALID_HANDLE) -> return Nothing (#const ERROR_SEM_TIMEOUT) -> return Nothing _ -> die e where die res = failWith "WaitForDebugEvent" res getDebugEvents :: Int -> IO [DebugEvent] getDebugEvents timeout = waitForDebugEvent (Just timeout) >>= getMore where getMore e = case e of Nothing -> return [] Just e -> do rest <- waitForDebugEvent (Just 0) >>= getMore return $ e:rest continueDebugEvent :: DebugEventId -> Bool -> IO () continueDebugEvent (pid,tid) cont = failIf_ not "ContinueDebugEvent" $ c_ContinueDebugEvent pid tid cont' where cont' = if cont then (#const DBG_CONTINUE) else (#const DBG_EXCEPTION_NOT_HANDLED) -------------------------------------------------------------------------- -- Process control debugActiveProcess :: PID -> IO () debugActiveProcess pid = failIf_ not "debugActiveProcess: DebugActiveProcess" $ c_DebugActiveProcess pid -- Windows XP -- debugActiveProcessStop :: PID -> IO () -- debugActiveProcessStop pid = -- failIf_ not "debugActiveProcessStop: DebugActiveProcessStop" $ -- c_DebugActiveProcessStop pid -------------------------------------------------------------------------- -- Process memory peekProcessMemory :: PHANDLE -> ForeignAddress -> Int -> Ptr a -> IO () peekProcessMemory proc addr size buf = failIf_ not "peekProcessMemory: ReadProcessMemory" $ c_ReadProcessMemory proc (plusPtr nullPtr $ fromIntegral addr) (castPtr buf) (fromIntegral size) nullPtr readProcessMemory :: PHANDLE -> ForeignAddress -> Int -> IO (ForeignPtr a) readProcessMemory proc addr size = do res <- mallocForeignPtrBytes size withForeignPtr res $ peekProcessMemory proc addr size return res pokeProcessMemory :: PHANDLE -> ForeignAddress -> Int -> Ptr a -> IO () pokeProcessMemory proc addr size buf = failIf_ not "pokeProcessMemory: WriteProcessMemory" $ c_WriteProcessMemory proc (plusPtr nullPtr $ fromIntegral addr) (castPtr buf) (fromIntegral size) nullPtr withProcessMemory :: PHANDLE -> ForeignAddress -> Int -> (Ptr a -> IO b) -> IO b withProcessMemory proc addr size act = allocaBytes size $ \buf -> do peekProcessMemory proc addr size buf res <- act buf pokeProcessMemory proc addr size buf return res peekP :: (Storable a) => PHANDLE -> ForeignAddress -> IO a peekP proc addr = fixIO $ \res -> withProcessMemory proc addr (sizeOf res) peek pokeP :: (Storable a) => PHANDLE -> ForeignAddress -> a -> IO () pokeP proc addr v = withProcessMemory proc addr (sizeOf v) $ \buf -> poke buf v -------------------------------------------------------------------------- -- Thread Control suspendThread :: THANDLE -> IO DWORD suspendThread t = failIf (==0-1) "SuspendThread" $ c_SuspendThread t resumeThread :: THANDLE -> IO DWORD resumeThread t = failIf (==0-1) "ResumeThread" $ c_ResumeThread t withSuspendedThread :: THANDLE -> IO a -> IO a withSuspendedThread t = bracket_ (suspendThread t) (resumeThread t) --getThreadId :: THANDLE -> IO TID --getThreadId = failIf (==0) "GetThreadId" . c_GetThreadId -------------------------------------------------------------------------- -- Thread register control getThreadContext :: THANDLE -> Ptr a -> IO () getThreadContext t buf = failIf_ not "GetThreadContext" $ c_GetThreadContext t (castPtr buf) setThreadContext :: THANDLE -> Ptr a -> IO () setThreadContext t buf = failIf_ not "SetThreadContext" $ c_SetThreadContext t (castPtr buf) useAllRegs :: Ptr a -> IO () useAllRegs buf = (#poke CONTEXT, ContextFlags) buf v where v = (#const CONTEXT_FULL|CONTEXT_DEBUG_REGISTERS|CONTEXT_FLOATING_POINT) :: DWORD withThreadContext :: THANDLE -> (Ptr a -> IO b) -> IO b withThreadContext t act = allocaBytes (#size CONTEXT) $ \buf -> bracket_ (useAllRegs buf >> getThreadContext t buf) (useAllRegs buf >> setThreadContext t buf) (act buf) eax, ebx, ecx, edx :: Int esi, edi :: Int ebp, eip, esp :: Int segCs, segDs, segEs, segFs, segGs :: Int eFlags :: Int eax = (#offset CONTEXT, Eax) ebx = (#offset CONTEXT, Ebx) ecx = (#offset CONTEXT, Ecx) edx = (#offset CONTEXT, Edx) esi = (#offset CONTEXT, Esi) edi = (#offset CONTEXT, Edi) ebp = (#offset CONTEXT, Ebp) eip = (#offset CONTEXT, Eip) esp = (#offset CONTEXT, Esp) segCs = (#offset CONTEXT, SegCs) segDs = (#offset CONTEXT, SegDs) segEs = (#offset CONTEXT, SegEs) segFs = (#offset CONTEXT, SegFs) segGs = (#offset CONTEXT, SegGs) eFlags = (#offset CONTEXT, EFlags) dr :: Int -> Int dr n = case n of 0 -> (#offset CONTEXT, Dr0) 1 -> (#offset CONTEXT, Dr1) 2 -> (#offset CONTEXT, Dr2) 3 -> (#offset CONTEXT, Dr3) 6 -> (#offset CONTEXT, Dr6) 7 -> (#offset CONTEXT, Dr7) _ -> undefined setReg :: Ptr a -> Int -> DWORD -> IO () setReg = pokeByteOff getReg :: Ptr a -> Int -> IO DWORD getReg = peekByteOff modReg :: Ptr a -> Int -> (DWORD->DWORD) -> IO DWORD modReg buf r f = do old <- getReg buf r setReg buf r (f old) return old makeModThreadContext :: [(Int, DWORD->DWORD)] -> Ptr a -> IO [DWORD] makeModThreadContext act buf = mapM (uncurry $ modReg buf) act modifyThreadContext :: THANDLE -> [(Int, DWORD->DWORD)] -> IO [DWORD] modifyThreadContext t a = withThreadContext t $ makeModThreadContext a -------------------------------------------------------------------------- -- On process being debugged outputDebugString :: String -> IO () outputDebugString s = withTString s $ \s -> c_OutputDebugString s -------------------------------------------------------------------------- -- Raw imports foreign import stdcall "windows.h SuspendThread" c_SuspendThread :: THANDLE -> IO DWORD foreign import stdcall "windows.h ResumeThread" c_ResumeThread :: THANDLE -> IO DWORD foreign import stdcall "windows.h WaitForDebugEvent" c_WaitForDebugEvent :: Ptr () -> DWORD -> IO BOOL foreign import stdcall "windows.h ContinueDebugEvent" c_ContinueDebugEvent :: DWORD -> DWORD -> DWORD -> IO BOOL foreign import stdcall "windows.h DebugActiveProcess" c_DebugActiveProcess :: DWORD -> IO Bool -- Windows XP -- foreign import stdcall "windows.h DebugActiveProcessStop" -- c_DebugActiveProcessStop :: DWORD -> IO Bool foreign import stdcall "windows.h ReadProcessMemory" c_ReadProcessMemory :: PHANDLE -> Ptr () -> Ptr Word8 -> DWORD -> Ptr DWORD -> IO BOOL foreign import stdcall "windows.h WriteProcessMemory" c_WriteProcessMemory :: PHANDLE -> Ptr () -> Ptr Word8 -> DWORD -> Ptr DWORD -> IO BOOL foreign import stdcall "windows.h GetThreadContext" c_GetThreadContext :: THANDLE -> Ptr () -> IO BOOL foreign import stdcall "windows.h SetThreadContext" c_SetThreadContext :: THANDLE -> Ptr () -> IO BOOL --foreign import stdcall "windows.h GetThreadId" -- c_GetThreadId :: THANDLE -> IO TID foreign import stdcall "windows.h OutputDebugStringW" c_OutputDebugString :: LPTSTR -> IO () foreign import stdcall "windows.h IsDebuggerPresent" isDebuggerPresent :: IO BOOL foreign import stdcall "windows.h DebugBreak" debugBreak :: IO () hugs98-plus-Sep2006/packages/Win32/System/Win32/SimpleMAPI.hsc0000644006511100651110000003641610504340503022234 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32.SimpleMAPI -- Copyright : (c) Esa Ilari Vuokko, 2006 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- FFI-bindings to interact with SimpleMAPI -- ----------------------------------------------------------------------------- module System.Win32.SimpleMAPI where import Control.Exception ( bracket, handle, throw, finally ) import Control.Monad ( liftM5 ) import Foreign ( FunPtr, newForeignPtr, pokeByteOff, maybeWith , Ptr, castPtr, castPtrToFunPtr, nullPtr , touchForeignPtr, alloca, peek, allocaBytes , minusPtr, plusPtr, copyBytes, ForeignPtr ) import Foreign.C ( withCString, withCStringLen ) import Graphics.Win32.GDI.Types ( HWND) import System.Win32.DLL ( loadLibrary, c_GetProcAddress, freeLibrary , c_FreeLibraryFinaliser ) import System.Win32.Types ( DWORD, LPSTR, HMODULE, failIfNull ) #include "windows.h" #include "mapi.h" type ULONG = DWORD type LHANDLE = ULONG newtype MapiRecipDesc = MapiRecipDesc () type MapiFlag = ULONG #{enum MapiFlag, , mAPI_LOGON_UI = MAPI_LOGON_UI , mAPI_NEW_SESSION = MAPI_NEW_SESSION , mAPI_FORCE_DOWNLOAD = MAPI_FORCE_DOWNLOAD , mAPI_LOGOFF_SHARED = MAPI_LOGOFF_SHARED , mAPI_LOGOFF_UI = MAPI_LOGOFF_UI , mAPI_DIALOG = MAPI_DIALOG , mAPI_UNREAD_ONLY = MAPI_UNREAD_ONLY , mAPI_LONG_MSGID = MAPI_LONG_MSGID , mAPI_GUARANTEE_FIFO = MAPI_GUARANTEE_FIFO , mAPI_ENVELOPE_ONLY = MAPI_ENVELOPE_ONLY , mAPI_PEEK = MAPI_PEEK , mAPI_BODY_AS_FILE = MAPI_BODY_AS_FILE , mAPI_SUPPRESS_ATTACH = MAPI_SUPPRESS_ATTACH , mAPI_AB_NOMODIFY = MAPI_AB_NOMODIFY , mAPI_OLE = MAPI_OLE , mAPI_OLE_STATIC = MAPI_OLE_STATIC , mAPI_UNREAD = MAPI_UNREAD , mAPI_RECEIPT_REQUESTED = MAPI_RECEIPT_REQUESTED , mAPI_SENT = MAPI_SENT } mapiErrors :: [(ULONG,String)] mapiErrors = [ ((#const SUCCESS_SUCCESS) , "Success") , ((#const MAPI_E_FAILURE) , "Generic error or multiple errors") , ((#const MAPI_E_USER_ABORT) , "User aborted") , ((#const MAPI_E_LOGIN_FAILURE) , "Logoff failed") , ((#const MAPI_E_LOGON_FAILURE) , "Logon failed") , ((#const MAPI_E_DISK_FULL) , "Disk full") , ((#const MAPI_E_INSUFFICIENT_MEMORY) , "Not enough memory") , ((#const MAPI_E_ACCESS_DENIED) , "Access denied") , ((#const MAPI_E_BLK_TOO_SMALL) , "BLK_TOO_SMALL") , ((#const MAPI_E_TOO_MANY_SESSIONS), "Too many open sessions") , ((#const MAPI_E_TOO_MANY_FILES) , "Too many open files") , ((#const MAPI_E_TOO_MANY_RECIPIENTS) , "Too many recipients") , ((#const MAPI_E_ATTACHMENT_NOT_FOUND) , "Attachemnt not found") , ((#const MAPI_E_ATTACHMENT_OPEN_FAILURE) , "Couldn't open attachment") , ((#const MAPI_E_ATTACHMENT_WRITE_FAILURE) , "Couldn't write attachment") , ((#const MAPI_E_UNKNOWN_RECIPIENT) , "Unknown recipient") , ((#const MAPI_E_BAD_RECIPTYPE) , "Bad recipient type") , ((#const MAPI_E_NO_MESSAGES) , "No messages") , ((#const MAPI_E_INVALID_MESSAGE) , "Invalid message") , ((#const MAPI_E_TEXT_TOO_LARGE) , "Text too large") , ((#const MAPI_E_INVALID_SESSION) , "Invalid session") , ((#const MAPI_E_TYPE_NOT_SUPPORTED) , "Type not supported") , ((#const MAPI_E_AMBIGUOUS_RECIPIENT) , "Ambigious recipient") , ((#const MAPI_E_AMBIGUOUS_RECIP) , "Ambigious recipient") , ((#const MAPI_E_MESSAGE_IN_USE) , "Message in use") , ((#const MAPI_E_NETWORK_FAILURE) , "Network failure") , ((#const MAPI_E_INVALID_EDITFIELDS) , "Invalid editfields") , ((#const MAPI_E_INVALID_RECIPS) , "Invalid recipient(s)") , ((#const MAPI_E_NOT_SUPPORTED) , "Not supported") ] mapiErrorString :: ULONG -> String mapiErrorString c = case lookup c mapiErrors of Nothing -> "Unkown error (" ++ show c ++ ")" Just x -> x mapiFail :: String -> IO ULONG -> IO ULONG mapiFail name act = act >>= \err -> if err==(#const SUCCESS_SUCCESS) then return err else fail $ name ++ ": " ++ mapiErrorString err mapiFail_ :: String -> IO ULONG -> IO () mapiFail_ n a = mapiFail n a >> return () type MapiLogonType = ULONG -> LPSTR -> LPSTR -> MapiFlag -> ULONG -> Ptr LHANDLE -> IO ULONG foreign import stdcall "dynamic" mkMapiLogon :: FunPtr MapiLogonType -> MapiLogonType type MapiLogoffType = LHANDLE -> ULONG -> MapiFlag -> ULONG -> IO ULONG foreign import stdcall "dynamic" mkMapiLogoff :: FunPtr MapiLogoffType -> MapiLogoffType type MapiResolveNameType = LHANDLE -> ULONG -> LPSTR -> MapiFlag -> ULONG -> Ptr (Ptr MapiRecipDesc) -> IO ULONG foreign import stdcall "dynamic" mkMapiResolveName :: FunPtr MapiResolveNameType -> MapiResolveNameType type MapiFreeBufferType = Ptr () -> IO ULONG foreign import stdcall "dynamic" mkMapiFreeBuffer :: FunPtr MapiFreeBufferType -> MapiFreeBufferType type MapiSendMailType = LHANDLE -> ULONG -> Ptr Message -> MapiFlag -> ULONG -> IO ULONG foreign import stdcall "dynamic" mkMapiSendMail :: FunPtr MapiSendMailType -> MapiSendMailType data MapiFuncs = MapiFuncs { mapifLogon :: MapiLogonType , mapifLogoff :: MapiLogoffType , mapifResolveName :: MapiResolveNameType , mapifFreeBuffer :: MapiFreeBufferType , mapifSendMail :: MapiSendMailType } type MapiLoaded = (MapiFuncs, ForeignPtr ()) -- | loadMapiFuncs :: String -> HMODULE -> IO MapiFuncs loadMapiFuncs dllname dll = liftM5 MapiFuncs (loadProc "MAPILogon" dll mkMapiLogon) (loadProc "MAPILogoff" dll mkMapiLogoff) (loadProc "MAPIResolveName" dll mkMapiResolveName) (loadProc "MAPIFreeBuffer" dll mkMapiFreeBuffer) (loadProc "MAPISendMail" dll mkMapiSendMail) where loadProc name dll conv = withCString name $ \name' -> do proc <- failIfNull ("loadMapiDll: " ++ dllname ++ ": " ++ name) $ c_GetProcAddress dll name' return $ conv $ castPtrToFunPtr proc -- | loadMapiDll :: String -> IO (MapiFuncs, HMODULE) loadMapiDll dllname = do dll <- loadLibrary dllname handle (\e -> freeLibrary dll >> throw e) $ do funcs <- loadMapiFuncs dllname dll return (funcs, dll) -- | withMapiFuncs :: [String] -> (MapiFuncs -> IO a) -> IO a withMapiFuncs dlls act = bracket load free (act . fst) where loadOne l = case l of [] -> fail $ "withMapiFuncs: Failed to load DLLs: " ++ show dlls x:y -> handle (const $ loadOne y) (loadMapiDll x) load = loadOne dlls free = freeLibrary . snd -- | loadMapi :: [String] -> IO MapiLoaded loadMapi dlls = do (f,m) <- loadOne dlls m' <- newForeignPtr c_FreeLibraryFinaliser m return (f,m') where loadOne l = case l of [] -> fail $ "loadMapi: Failed to load any of DLLs: " ++ show dlls x:y -> handle (const $ loadOne y) (loadMapiDll x) -- | withMapiLoaded :: MapiLoaded -> (MapiFuncs -> IO a) -> IO a withMapiLoaded (f,m) act = finally (act f) (touchForeignPtr m) maybeHWND :: Maybe HWND -> ULONG maybeHWND = maybe 0 (fromIntegral . flip minusPtr nullPtr) -- | Create Simple MAPI-session by logon mapiLogon :: MapiFuncs -- ^ Functions loaded from MAPI DLL -> Maybe HWND -- ^ Parent window, used for modal logon dialog -> Maybe String -- ^ Session -> Maybe String -- ^ Password -> MapiFlag -- ^ None, one or many flags: FORCE_DOWNLOAD, NEW_SESSION, LOGON_UI, PASSWORD_UI -> IO LHANDLE mapiLogon f hwnd ses pw flags = maybeWith withCString ses $ \ses -> maybeWith withCString pw $ \pw -> alloca $ \out -> do mapiFail "MAPILogon: " $ mapifLogon f (maybeHWND hwnd) ses pw flags 0 out peek out -- | End Simple MAPI-session mapiLogoff :: MapiFuncs -> LHANDLE -> Maybe HWND -> IO () mapiLogoff f ses hwnd = mapiFail_ "MAPILogoff" $ mapifLogoff f ses (maybeHWND hwnd) 0 0 data RecipientClass = RcOriginal | RcTo | RcCc | RcBcc deriving (Show, Eq, Ord, Enum) rcToULONG :: RecipientClass -> ULONG rcToULONG = fromIntegral . fromEnum uLONGToRc :: ULONG -> RecipientClass uLONGToRc = toEnum . fromIntegral data Recipient = RecipResolve (Maybe HWND) MapiFlag String (Maybe Recipient) | Recip String String deriving (Show) type Recipients = [(RecipientClass, Recipient)] simpleRecip :: String -> Recipient simpleRecip s = RecipResolve Nothing 0 s $ Just $ Recip s s withRecipient :: MapiFuncs -> LHANDLE -> RecipientClass -> Recipient -> (Ptr MapiRecipDesc -> IO a) -> IO a withRecipient f ses rcls rec act = resolve "" rec where a buf = do (#poke MapiRecipDesc, ulRecipClass) buf (rcToULONG rcls) act buf resolve err rc = case rc of Recip name addr -> withCString name $ \name -> withCString addr $ \addr -> allocaBytes (#size MapiRecipDesc) $ \buf -> do (#poke MapiRecipDesc, ulReserved) buf (0::ULONG) (#poke MapiRecipDesc, lpszName) buf name (#poke MapiRecipDesc, lpszAddress) buf addr (#poke MapiRecipDesc, ulEIDSize) buf (0::ULONG) (#poke MapiRecipDesc, lpEntryID) buf nullPtr a buf RecipResolve hwnd flag name fallback -> do res <- alloca $ \res -> withCString name $ \name' -> do errn <- mapifResolveName f ses (maybeHWND hwnd) name' flag 0 res if errn==(#const SUCCESS_SUCCESS) then do buf <- peek res v <- a buf mapifFreeBuffer f $ castPtr buf return $ Right v else return $ Left $ err ++ ", " ++ name ++ ":" ++ mapiErrorString errn case res of Left e -> case fallback of Nothing -> fail $ "Failed to resolve any of the recipients: " ++ e Just x -> resolve e x Right x -> return x withRecipients :: MapiFuncs -> LHANDLE -> Recipients -> (Int -> Ptr MapiRecipDesc -> IO a) -> IO a withRecipients f ses rec act = w [] rec where w res [] = allocaBytes (length res*rs) $ \buf -> do mapM_ (write buf) $ zip [0..] $ reverse res act (length res) buf w res ((c,r):y) = withRecipient f ses c r $ \x -> w (x:res) y rs = (#size MapiRecipDesc) write buf (off,src) = do let buf' = plusPtr buf (off*rs) copyBytes buf' src rs data FileTag = FileTag { ftTag :: Maybe String -- ^ mime , ftEncoding :: Maybe String } deriving (Show) defFileTag :: FileTag defFileTag = FileTag Nothing Nothing withFileTag :: FileTag -> (Ptr FileTag -> IO a) -> IO a withFileTag ft act = allocaBytes (#size MapiFileTagExt) $ \buf -> w (ftTag ft) $ \(tbuf,tsiz) -> w (ftEncoding ft) $ \(ebuf,esiz) -> do (#poke MapiFileTagExt, ulReserved) buf (0::ULONG) (#poke MapiFileTagExt, cbTag) buf tsiz (#poke MapiFileTagExt, lpTag) buf tbuf (#poke MapiFileTagExt, cbEncoding) buf esiz (#poke MapiFileTagExt, lpEncoding) buf ebuf act buf where w v a = case v of Nothing -> a (nullPtr, 0) Just x -> withCStringLen x a data Attachment = Attachment { attFlag :: MapiFlag , attPosition :: Maybe ULONG , attPath :: String , attName :: Maybe String , attTag :: Maybe FileTag } deriving (Show) defAttachment :: Attachment defAttachment = Attachment 0 Nothing "" Nothing Nothing type Attachments = [Attachment] withAttachments :: Attachments -> (Int -> Ptr Attachment -> IO a) -> IO a withAttachments att act = allocaBytes (len*as) $ \buf -> write (act len buf) buf att where as = (#size MapiFileDesc) len = length att write act _ [] = act write act buf (att:y) = withCString (attPath att) $ \path -> maybeWith withFileTag (attTag att) $ \tag -> withCString (maybe (attPath att) id (attName att)) $ \name -> do (#poke MapiFileDesc, ulReserved) buf (0::ULONG) (#poke MapiFileDesc, flFlags) buf (attFlag att) (#poke MapiFileDesc, nPosition) buf (maybe 0xffffffff id $ attPosition att) (#poke MapiFileDesc, lpszPathName) buf path (#poke MapiFileDesc, lpszFileName) buf name (#poke MapiFileDesc, lpFileType) buf tag write act (plusPtr buf as) y data Message = Message { msgSubject :: String , msgBody :: String , msgType :: Maybe String , msgDate :: Maybe String , msgConversationId :: Maybe String , msgFlags :: MapiFlag , msgFrom :: Maybe Recipient , msgRecips :: Recipients , msgAttachments :: Attachments } deriving (Show) defMessage :: Message defMessage = Message "" "" Nothing Nothing Nothing 0 Nothing [] [] withMessage :: MapiFuncs -> LHANDLE -> Message -> (Ptr Message -> IO a) -> IO a withMessage f ses m act = withCString (msgSubject m) $ \subject -> withCString (msgBody m) $ \body -> maybeWith withCString (msgType m) $ \message_type -> maybeWith withCString (msgDate m) $ \date -> maybeWith withCString (msgConversationId m) $ \conv_id -> withRecipients f ses (msgRecips m) $ \rlen rbuf -> withAttachments (msgAttachments m) $ \alen abuf -> maybeWith (withRecipient f ses RcOriginal) (msgFrom m) $ \from -> allocaBytes (#size MapiMessage) $ \buf -> do (#poke MapiMessage, ulReserved) buf (0::ULONG) (#poke MapiMessage, lpszSubject) buf subject (#poke MapiMessage, lpszNoteText) buf body (#poke MapiMessage, lpszMessageType) buf message_type (#poke MapiMessage, lpszDateReceived) buf date (#poke MapiMessage, lpszConversationID) buf conv_id (#poke MapiMessage, flFlags) buf (msgFlags m) (#poke MapiMessage, lpOriginator) buf from (#poke MapiMessage, nRecipCount) buf (fromIntegral rlen :: ULONG) (#poke MapiMessage, lpRecips) buf rbuf (#poke MapiMessage, nFileCount) buf alen (#poke MapiMessage, lpFiles) buf abuf act buf mapiSendMail :: MapiFuncs -> LHANDLE -> Maybe HWND -> Message -> MapiFlag -> IO () mapiSendMail f ses hwnd msg flag = withMessage f ses msg $ \msg -> mapiFail_ "MAPISendMail" $ mapifSendMail f ses (maybeHWND hwnd) msg flag 0 hugs98-plus-Sep2006/packages/Win32/System/Win32.hs0000644006511100651110000000273210504340503020163 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : System.Win32 -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Esa Ilari Vuokko -- Stability : provisional -- Portability : portable -- -- An FFI binding to the system part of the Win32 API. -- ----------------------------------------------------------------------------- module System.Win32 ( module System.Win32.DLL , module System.Win32.File , module System.Win32.FileMapping , module System.Win32.Info , module System.Win32.Mem , module System.Win32.NLS , module System.Win32.Process , module System.Win32.Registry , module System.Win32.Time , module System.Win32.Console , module System.Win32.Types ) where import System.Win32.DLL import System.Win32.File import System.Win32.FileMapping import System.Win32.Info import System.Win32.Mem import System.Win32.NLS hiding ( LCID, LANGID, SortID, SubLANGID , PrimaryLANGID, mAKELCID, lANGIDFROMLCID , sORTIDFROMLCID, mAKELANGID, pRIMARYLANGID , sUBLANGID ) import System.Win32.Process import System.Win32.Registry import System.Win32.Time import System.Win32.Console import System.Win32.Types ---------------------------------------------------------------- -- End ---------------------------------------------------------------- hugs98-plus-Sep2006/packages/Win32/LICENSE0000644006511100651110000000303110504340503016437 0ustar rossrossCopyright (c) 1997-2003, Alastair Reid Copyright (c) 2006, Esa Ilari Vuokko All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither names of the copyright holders nor the names of the contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/Win32/Makefile0000644006511100651110000000241210504340503017074 0ustar rossross# ----------------------------------------------------------------------------- # $Id: Makefile,v 1.13 2004/11/26 16:22:08 simonmar Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk # include mk/version.mk # ----------------------------------------------------------------------------- # Comment out if you want to do initial debugging on Unix systems SUBDIRS = cbits include ALL_DIRS = \ Graphics \ Graphics/Win32 \ Graphics/Win32/GDI \ System \ System/Win32 PACKAGE = Win32 VERSION = 2.0 PACKAGE_DEPS = base EXCLUDED_SRCS += Setup.hs SRC_HSC2HS_OPTS += -Iinclude SRC_HC_OPTS += -Wall -fno-warn-name-shadowing SRC_HC_OPTS += -optc-Iinclude -Iinclude SRC_HC_OPTS += -optc-DUNICODE SRC_HC_OPTS += -fffi -O SRC_HADDOCK_OPTS += -t "Win32 Libraries ($(PACKAGE) package)" # _stub.o files are a side-effect from compiling .hs files that # contain 'foreign export' declarations. EXTRA_C_OBJS += Graphics/Win32/Dialogue_stub.o Graphics/Win32/Window_stub.o STUBOBJS += $(filter-out $(EXTRA_C_OBJS), $(patsubst %.c, %.o, $(C_SRCS))) $(EXTRA_C_OBJS) Graphics/Win32/Dialogue_stub.o : Graphics/Win32/Dialogue.o @: Graphics/Win32/Window_stub.o : Graphics/Win32/Window.o @: # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/Win32/cbits/0000755006511100651110000000000010504340503016541 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/cbits/HsGDI.c0000644006511100651110000000016210504340503017602 0ustar rossross// Out-of-line versions of all the inline functions from HsGDI.h #define INLINE /* nothing */ #include "HsGDI.h" hugs98-plus-Sep2006/packages/Win32/cbits/HsWin32.c0000644006511100651110000000046610504340503020110 0ustar rossross// Out-of-line versions of all the inline functions from HsWin32.h #define INLINE /* nothing */ #include "HsWin32.h" void UnmapViewOfFileFinaliser(void * p) { UnmapViewOfFile(p); } void CloseHandleFinaliser(HANDLE h) { CloseHandle(h); } void FreeLibraryFinaliser(HMODULE m) { FreeLibrary(m); } hugs98-plus-Sep2006/packages/Win32/cbits/Makefile0000644006511100651110000000106310504340503020201 0ustar rossross# ----------------------------------------------------------------------------- TOP = ../.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- SRC_CC_OPTS += -Wall SRC_CC_OPTS += -I$(GHC_INCLUDE_DIR) -I../include SRC_CC_OPTS += -DUNICODE LIBRARY = libHSWin32_cbits.a LIBOBJS = $(C_OBJS) # ----------------------------------------------------------------------------- # Per-module flags # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/Win32/cbits/WndProc.c0000644006511100651110000000367010504340503020267 0ustar rossross#include "WndProc.h" #include /* Debugging code - might come in handy. */ #if 0 HWND mkWin(long l) { static char appN[] = "TestWin"; HWND hw; WNDCLASSEX wndclass; wndclass.cbSize = sizeof(wndclass); wndclass.style = CS_HREDRAW | CS_VREDRAW; wndclass.lpfnWndProc = genericWndProc; wndclass.cbClsExtra = 0; wndclass.cbWndExtra = 0; wndclass.hInstance = GetModuleHandle(NULL); wndclass.hIcon = LoadIcon(NULL, IDI_APPLICATION); wndclass.hCursor = LoadCursor(NULL, IDC_ARROW); wndclass.hbrBackground = (HBRUSH)GetStockObject(WHITE_BRUSH); wndclass.lpszMenuName = NULL; wndclass.lpszClassName = appN; wndclass.hIconSm = LoadIcon(NULL, IDI_APPLICATION); RegisterClassEx(&wndclass); hw = CreateWindow(appN, "test", WS_OVERLAPPEDWINDOW,100,100,100,100, NULL, NULL, GetModuleHandle(NULL),NULL); //ShowWindow (hw, SW_SHOWNORMAL); //UpdateWindow (hw); /*WndPump();*/ //SetWindowLong( hw, GWL_USERDATA,l); return hw; } void WndPump() { MSG msg; fprintf(stderr, "Getting..\n"); while (GetMessage(&msg, NULL, 0,0) != 0) { fprintf(stderr, "..got,\n"); TranslateMessage(&msg); fprintf(stderr, "delivering.\n"); DispatchMessage(&msg); fprintf(stderr, "Getting..\n"); } } #endif #ifdef DEBUG char* __current_fun__ = NULL; #endif void WndPump () { MSG msg; while(1) { GetMessage(&msg,NULL, 0,0); TranslateMessage(&msg); DispatchMessage(&msg); } return; } LRESULT CALLBACK genericWndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) { LRESULT lr; if (hwnd) { LONG wndprocptr = GetWindowLong(hwnd,GWL_USERDATA); if (wndprocptr) { lr = ((LRESULT (*)(HWND,UINT,WPARAM,LPARAM))(wndprocptr))(hwnd,msg,wParam,lParam); #if 0 if (lr == -1) { return DefWindowProc(hwnd, msg, wParam, lParam); } else { return lr; } #else return lr; #endif } } return DefWindowProc(hwnd, msg, wParam, lParam); } hugs98-plus-Sep2006/packages/Win32/cbits/diatemp.c0000644006511100651110000001076010504340503020334 0ustar rossross/* * Helper functions for filling in DLG(ITEM)TEMPLATEs - * closely based on code provided Rector & Newcomer * in their book, Win32 programming. * * The only change here is to make it possible to * add any number of controls to the dialog without * having to worry about overrunning the chunk of * memory that we're writing all this info into. * */ #include #include #include #include "diatemp.h" #define DLGTEMPLATE_WORKING_SIZE 4096 LPDLGTEMPLATE getFinalDialog(DIA_TEMPLATE* dt) { LPDLGTEMPLATE ptr = dt->dtemplate; free(dt); return ptr; } LPWORD appendString (LPWORD ptr, LPCWSTR text) { LPWSTR str = (LPWSTR)ptr; wcscpy(str, text); ptr = (LPWORD)(str + wcslen(str) + 1); return ptr; } LPWORD setClassAtom(LPDLGITEMTEMPLATE item, WORD classatom) { LPWORD ptr = (LPWORD)&item[1]; *ptr++ = 0xffff; *ptr++ = classatom; return ptr; } LPWORD setClassName(LPDLGITEMTEMPLATE item, LPCWSTR classname) { LPWORD ptr = (LPWORD)&item[1]; ptr = appendString(ptr, classname); return ptr; } LPWORD setResourceID(LPWORD ptr, WORD id) { *ptr++ = 0xffff; *ptr++ = (WORD)id; return ptr; } DIA_TEMPLATE* mkDiaTemplate ( UINT size, int x, int y, int cx, int cy , DWORD style, DWORD exstyle , LPCWSTR menu, LPCWSTR class , LPCWSTR caption, LPCWSTR font , int height ) { LPDLGTEMPLATE dlg; LPWORD ptr; DIA_TEMPLATE* dtemp; if ( size == 0 ) { size = DLGTEMPLATE_WORKING_SIZE; } dlg = (LPDLGTEMPLATE)malloc(size); if (dlg == NULL) { return NULL; } dlg->x = x; dlg->y = y; dlg->cx = cx; dlg->cy = cy; dlg->cdit = 0; dlg->style = style; if (font == NULL) { dlg->style &= ~ DS_SETFONT; } else { dlg->style |= DS_SETFONT; } dlg->dwExtendedStyle = exstyle; ptr= (LPWORD)&dlg[1]; if (menu == NULL) { *ptr++ = 0; } else if (HIWORD(menu) == 0) { ptr = setResourceID(ptr, LOWORD(menu)); } else { ptr = appendString(ptr, menu); } if ( class == NULL ) { *ptr++ = 0; } else if ( HIWORD(class) == 0 ) { ptr = setResourceID(ptr, LOWORD(class)); } else { ptr = appendString(ptr, class); } ptr = appendString(ptr, (caption == NULL ? L"" : caption)); if ( font != NULL ) { *ptr++ = height; ptr = appendString(ptr, font); } dtemp = (DIA_TEMPLATE*)malloc(sizeof(DIA_TEMPLATE)); if ( dtemp == NULL ) return NULL; dtemp->dtemplate = dlg; dtemp->next_dia_item = (LPDLGITEMTEMPLATE)ptr; dtemp->bytes_left = (unsigned int)(((char*)dlg + size) - (char*)ptr); dtemp->bytes_alloced = size; return dtemp; } static DIA_TEMPLATE* check_if_enough_mem(DIA_TEMPLATE* dia, LPCWSTR text, LPCWSTR classname) { unsigned int sz = 0; sz += sizeof(DLGITEMTEMPLATE); if ( HIWORD(classname) == 0 ) { sz += sizeof(WORD); } else { sz += wcslen(classname) + 1; } if ( HIWORD(text) == 0 ) { sz += sizeof(WORD); } else { sz += wcslen(text) + 1; } if ( sz >= dia->bytes_left ) { unsigned int diff; dia->bytes_left = dia->bytes_left + dia->bytes_alloced; dia->bytes_alloced *= 2; /* Being defensive here.. */ diff = (unsigned int)((char*)dia->next_dia_item - (char*)dia->dtemplate); dia->dtemplate = (LPDLGTEMPLATE)realloc((void*)dia->dtemplate, dia->bytes_alloced); if ( dia->dtemplate == NULL ) return NULL; dia->next_dia_item = (LPDLGITEMTEMPLATE)((char*)dia->dtemplate + diff); return dia; } else { return dia; } } static LPWORD noParms (LPDLGITEMTEMPLATE item, LPWORD ptr) { *ptr++ = 0; if ( (((LPWORD)item) - ptr) & 0x1) *ptr++ = 0; return ptr; } DIA_TEMPLATE* addDiaControl ( DIA_TEMPLATE* dia , LPCWSTR text, short id , LPCWSTR classname, DWORD style , int x, int y, int cx, int cy , DWORD exstyle ) { LPWORD ptr; LPDLGITEMTEMPLATE item; dia = check_if_enough_mem(dia, text, classname); ptr = (LPWORD)&(dia->next_dia_item[1]); item = dia->next_dia_item; item->style = WS_CHILD | style; item->dwExtendedStyle = exstyle; item->x = x; item->y = y; item->cx = cx; item->cy = cy; item->id = (WORD)id; if ( HIWORD(classname) != 0 ) { ptr = setClassName(item, classname); } else { ptr = setResourceID(ptr, LOWORD(classname)); } if ( HIWORD(text) != 0 ) { ptr = appendString(ptr, text); } else { ptr = setResourceID(ptr, (short)(LOWORD(text))); } ptr = noParms(item, ptr); dia->bytes_left -= ((char*)ptr - ((char*)dia->next_dia_item)); dia->next_dia_item = (LPDLGITEMTEMPLATE)ptr; return dia; } hugs98-plus-Sep2006/packages/Win32/cbits/dumpBMP.c0000644006511100651110000001343710504340503020221 0ustar rossross/******************************Module*Header*******************************\ * Module Name: savebmp.c * * * Created: 06-Jan-1992 10:59:36 * * Copyright (C) 1993-1995 Microsoft Corporation * * Contains the main routine, SaveBitmapFile, for saving a DDB into file * in DIB format. * * Dependencies: * * (#defines) * (#includes) * #include * \**************************************************************************/ #include #include #include "dumpBMP.h" /******************************Public*Routine******************************\ * SaveBitmapFile * * * Effects: Save pInfo->hBmpSaved into disk specified by pszFileName * * Warnings: assumes hBmpSaved is not selected into window's DC other than * pInfo->hwnd's DC * \**************************************************************************/ //typedef LPBITMAPINFO PBITMAPINFO; // hack to keep cygwin32b17 happy void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC) { int hFile; OFSTRUCT ofReOpenBuff; HBITMAP hTmpBmp, hBmpOld; BOOL bSuccess; BITMAPFILEHEADER bfh; LPBITMAPINFO pbmi; PBYTE pBits; BITMAPINFO bmi; PBYTE pjTmp, pjTmpBmi; ULONG sizBMI; bSuccess = TRUE; #if 0 if (ghPal) { SelectPalette(hDC, ghPal, FALSE); RealizePalette(hDC); } #endif if (!hBmp) { fprintf(stderr, "There's no Bitmap to save!"); return; } // // Let the graphics engine to retrieve the dimension of the bitmap for us // GetDIBits uses the size to determine if its BITMAPCOREINFO or BITMAPINFO // if BitCount != 0, color table will be retrieved // bmi.bmiHeader.biSize = 0x28; // GDI need this to work bmi.bmiHeader.biBitCount = 0; // dont get the color table if ((GetDIBits(hDC, hBmp, 0, 0, (LPSTR)NULL, &bmi, DIB_RGB_COLORS)) == 0) { fprintf(stderr, "GetDIBits failed!"); return; } // // Now that we know the size of the image, alloc enough memory to retrieve // the actual bits // if ((pBits = (PBYTE)GlobalAlloc(GMEM_FIXED | GMEM_ZEROINIT, bmi.bmiHeader.biSizeImage)) == NULL) { fprintf(stderr, "Failed in Memory Allocation for pBits!"); return; } // // Note: 24 bits per pixel has no color table. So, we dont have to // allocate memory for retrieving that. Otherwise, we do. // pbmi = &bmi; // assume no color table switch (bmi.bmiHeader.biBitCount) { case 24: // has color table sizBMI = sizeof(BITMAPINFOHEADER); break; case 16: case 32: sizBMI = sizeof(BITMAPINFOHEADER)+sizeof(DWORD)*3; break; default: sizBMI = sizeof(BITMAPINFOHEADER)+sizeof(RGBQUAD)*(1<bmiHeader.biSizeImage; bfh.bfReserved1 = bfh.bfReserved2 = 0; bfh.bfOffBits = sizeof(BITMAPFILEHEADER)+sizBMI; // // Write out the file header now // if (_lwrite(hFile, (LPSTR)&bfh, sizeof(BITMAPFILEHEADER)) == -1) { fprintf(stderr, "Failed in WriteFile!"); bSuccess = FALSE; goto ErrExit3; } // // Bitmap cant be selected into a DC when calling GetDIBits // Assume that the hDC is the DC where the bitmap would have been selected // if indeed it has been selected // if (hTmpBmp = CreateCompatibleBitmap(hDC, pbmi->bmiHeader.biWidth, pbmi->bmiHeader.biHeight)) { hBmpOld = SelectObject(hDC, hTmpBmp); if ((GetDIBits(hDC, hBmp, 0, pbmi->bmiHeader.biHeight, (LPSTR)pBits, pbmi, DIB_RGB_COLORS))==0){ fprintf(stderr, "Failed in GetDIBits!"); bSuccess = FALSE; goto ErrExit4; } } else { fprintf(stderr, "Failed in creating bitmap!"); bSuccess = FALSE; goto ErrExit3; } // // Now write out the BitmapInfoHeader and color table, if any // if (_lwrite(hFile, (LPSTR)pbmi, sizBMI) == -1) { fprintf(stderr, "Failed in WriteFile!"); bSuccess = FALSE; goto ErrExit4; } // // write the bits also // if (_lwrite(hFile, (LPSTR)pBits, pbmi->bmiHeader.biSizeImage) == -1) { fprintf(stderr, "Failed in WriteFile!"); bSuccess = FALSE; goto ErrExit4; } ErrExit4: SelectObject(hDC, hBmpOld); DeleteObject(hTmpBmp); ErrExit3: _lclose(hFile); ErrExit2: GlobalFree(pbmi); ErrExit1: GlobalFree(pBits); return; } hugs98-plus-Sep2006/packages/Win32/cbits/ellipse.c0000644006511100651110000000241010504340503020337 0ustar rossross#include #include /* * Rotatable Ellipse hack * * Win95 (Win32?) doesn't support rotating ellipses - so we * implement them with polygons. * * We use a fixed number of edges rather than varying the number * according to the radius of the ellipse. * If anyone feels like improving the code (to vary the number), * they should place a fixed upper bound on the number of edges * since it takes a relatively long time to draw 1000 edges. */ int transformedEllipse( HDC hdc, LONG x0, LONG y0, LONG x1, LONG y1, LONG x2, LONG y2) { static BOOL firstTime = 1; static double sins[20]; static double coss[20]; int i; POINT pts[20]; double x = (x1 + x2) / 2; /* centre of parallelogram */ double y = (y1 + y2) / 2; double dx1 = (x1 - x0) / 2; /* distance to corners from centre */ double dy1 = (y1 - y0) / 2; double dx2 = (x2 - x0) / 2; double dy2 = (y2 - y0) / 2; if (firstTime) { double a = 0.0; double da = 2.0*3.14159 / 20; for (i=0; i < 20; ++i, a+=da) { sins[i] = sin(a); coss[i] = cos(a); } firstTime = 0; } for(i=0; i < 20; ++i) { double c = coss[i]; double s = sins[i]; pts[i].x = x + c*dx1 + s*dx2; pts[i].y = y + c*dy1 + s*dy2; } return Polygon(hdc,pts,20); } hugs98-plus-Sep2006/packages/Win32/cbits/errors.c0000644006511100651110000000152710504340503020226 0ustar rossross#include #include #include #include "errors.h" /* There's two ways we can generate error messages - with different tradeoffs: * If we do a function call, we have to use a static buffer. * If we use a macro and ANSI C's string splicing, we have to use constant * strings - and accept a certain amount of overhead from inserting the * boilerplate text. * * Why the concern about performance? Error messages are only generated * in exceptional situations -- sof 9/98 * * sof 9/98 : Removed use of non-standard (and wimpy :-) snprintf(). */ LPTSTR getErrorMessage(DWORD err) { LPTSTR what; FormatMessage( (FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER) , NULL, err, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), /* Default language */ (LPTSTR) &what, 0, NULL ); return what; } hugs98-plus-Sep2006/packages/Win32/Win32.cabal0000644006511100651110000000275510504340503017334 0ustar rossrossname: Win32 version: 2.0 license: BSD3 license-file: LICENSE author: Alastair Reid copyright: Alastair Reid, 1999-2003 maintainer: Esa Ilari Vuokko category: System, Graphics synopsis: A binding to part of the Win32 library build-depends: base ghc-options: -O -fvia-C -Wall -fno-warn-name-shadowing exposed-modules: Graphics.Win32.GDI, Graphics.Win32.GDI.Bitmap, Graphics.Win32.GDI.Brush, Graphics.Win32.GDI.Clip, Graphics.Win32.GDI.Font, Graphics.Win32.GDI.Graphics2D, Graphics.Win32.GDI.HDC, Graphics.Win32.GDI.Palette, Graphics.Win32.GDI.Path, Graphics.Win32.GDI.Pen, Graphics.Win32.GDI.Region, Graphics.Win32.GDI.Types, Graphics.Win32, Graphics.Win32.Control, Graphics.Win32.Dialogue, Graphics.Win32.Icon, Graphics.Win32.Key, Graphics.Win32.Menu, Graphics.Win32.Message, Graphics.Win32.Misc, Graphics.Win32.Resource, Graphics.Win32.Window, System.Win32, System.Win32.DebugApi, System.Win32.DLL, System.Win32.File, System.Win32.FileMapping, System.Win32.Info, System.Win32.Mem, System.Win32.NLS, System.Win32.Process, System.Win32.Registry, System.Win32.SimpleMAPI, System.Win32.Time, System.Win32.Console, System.Win32.Types extensions: ForeignFunctionInterface extra-libraries: "user32", "gdi32", "winmm", "kernel32", "advapi32" include-dirs: include includes: "HsWin32.h", "HsGDI.h", "WndProc.h" c-sources: cbits/HsGDI.c, cbits/HsWin32.c, cbits/WndProc.c, cbits/diatemp.c, cbits/dumpBMP.c, cbits/ellipse.c, cbits/errors.c cc-options: -DUNICODE hugs98-plus-Sep2006/packages/Win32/doc/0000755006511100651110000000000010504340503016202 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/doc/HSWin32.xml0000644006511100651110000001461310504340503020066 0ustar rossross 2003-05-22 HSX11 Guide Alastair Reid

alastair@reid-consulting-uk.ltd.uk
1999-2003 Alastair Reid This document describes HSWin32, the Haskell binding to Win32, version 2.00. Introduction HSWin32 is a Haskell binding to the popular Win32 library provided on Microsoft operating systems. The library aims to provide a direct translation of the Win32 binding into Haskell so the most important pieces of documentation you should read are the Win32 documents which can be obtained from the Microsoft MSDN website and Charles Petzold's excellent book Programming Windows. Let me say that again because it is very important. Get hold of this documentation and read it: it tells you almost everything you need to know to use this library. Changes from Win32 documentation In making a Haskell binding to a C library, there are certain necessary and/or desirable changes in the interface. These can be divided into systematic changes which are applied uniformly throughout the library and ad-hoc changes which are applied to particular parts of the interface. Systematic Changes Naming Conventions In translating the library, we had to change names to conform with Haskell's lexical syntax: function names and names of constants must start with a lowercase letter; type names must start with an uppercase letter. For example, we translate some C functions, constants and types as follows: C Name Haskell Name HBRUSH HBRUSH CreateSolidBrush createSolidBrush wHITEBRUSH WHITEBRUSH Types We translate type names as follows... POINT POINT (LONG,LONG) RECT RECT (LONG,LONG,LONG,LONG) SIZE SIZE (LONG,LONG) We systematically use a type of the form ListFoo as a synonym for [Foo] and MbFoo as a synonym for Maybe Foo. This is an unfortunate side-effect of the tool we used to generate the bindings. We named enumeration types so that function types would be easier to understand. For example, we added ... Note that the types are synonyms for Int so no extra typesafety was obtained. Exception Handling We consistently raise exceptions when a function returns an error code. This affects most of the functions in the library. As an example of how these rules are applied in generating a function type, the C function with type: COLORREF GetBkColor( HDC hdc // handle to device context ); is given the Haskell type: getBkColor :: HDC -> IO COLORREF Ad hoc Changes Finally, we chose to make some changes in the interface to better conform with idiomatic Haskell style or to allow a typesafe interface. These have not yet been documented. hugs98-plus-Sep2006/packages/Win32/doc/Makefile0000644006511100651110000000013510504340503017641 0ustar rossrossTOP = ../.. include $(TOP)/mk/boilerplate.mk XML_DOC = HSWin32 include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/Win32/examples/0000755006511100651110000000000010504340503017253 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/examples/Makefile0000644006511100651110000000127110504340503020714 0ustar rossross# ----------------------------------------------------------------------------- # $Id: Makefile,v 1.1 2004/09/14 07:40:51 mthomas Exp $ TOP = ../.. include $(TOP)/mk/boilerplate.mk # # Disable 'make boot' # NO_BOOT_TARGET=YES WAYS= # ----------------------------------------------------------------------------- EXAMPLES := $(wildcard *.lhs) BINS := $(EXAMPLES:.lhs=$(exeext)) CLEAN_FILES += $(BINS) HC = $(GHC_INPLACE) MKDEPENDHS = $(GHC_INPLACE) SRC_HC_OPTS += -package Win32 all:: $(BINS) $(BINS): %$(exeext): %.lhs $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $< # ----------------------------------------------------------------------------- include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/Win32/examples/hello.lhs0000644006511100651110000000763010504340503021074 0ustar rossross% % (c) sof, 1999 % Haskell version of "Hello, World" using the Win32 library. Demonstrates how the Win32 library can be put to use. Works with Hugs and GHC. To compile it up using the latter, do: "ghc -o main hello.lhs -syslib win32 -fglasgow-exts" For GHC 5.03: ghc -package win32 hello.lhs -o hello.exe -optl "-Wl,--subsystem,windows" \begin{code} module Main(main) where import qualified Graphics.Win32 import qualified System.Win32.DLL import qualified System.Win32.Types import Control.Exception (bracket) import Foreign import System.Exit {-import Addr-} \end{code} Toplevel main just creates a window and pumps messages. The window procedure (wndProc) we pass in is partially applied with the user action that takes care of responding to repaint messages (WM_PAINT). \begin{code} main :: IO () main = Graphics.Win32.allocaPAINTSTRUCT $ \ lpps -> do hwnd <- createWindow 200 200 (wndProc lpps onPaint) messagePump hwnd {- OnPaint handler for a window - draw a string centred inside it. -} onPaint :: Graphics.Win32.RECT -> Graphics.Win32.HDC -> IO () onPaint (_,_,w,h) hdc = do Graphics.Win32.setBkMode hdc Graphics.Win32.tRANSPARENT Graphics.Win32.setTextColor hdc (Graphics.Win32.rgb 255 255 0) let y | h==10 = 0 | otherwise = ((h-10) `div` 2) x | w==50 = 0 | otherwise = (w-50) `div` 2 Graphics.Win32.textOut hdc x y "Hello, world" return () \end{code} Simple window procedure - one way to improve and generalise it would be to pass it a message map (represented as a finite map from WindowMessages to actions, perhaps). \begin{code} wndProc :: Graphics.Win32.LPPAINTSTRUCT -> (Graphics.Win32.RECT -> Graphics.Win32.HDC -> IO ()) -- on paint action -> Graphics.Win32.HWND -> Graphics.Win32.WindowMessage -> Graphics.Win32.WPARAM -> Graphics.Win32.LPARAM -> IO Graphics.Win32.LRESULT wndProc lpps onPaint hwnd wmsg wParam lParam | wmsg == Graphics.Win32.wM_DESTROY = do Graphics.Win32.sendMessage hwnd Graphics.Win32.wM_QUIT 1 0 return 0 | wmsg == Graphics.Win32.wM_PAINT && hwnd /= nullPtr = do r <- Graphics.Win32.getClientRect hwnd paintWith lpps hwnd (onPaint r) return 0 | otherwise = Graphics.Win32.defWindowProc (Just hwnd) wmsg wParam lParam createWindow :: Int -> Int -> Graphics.Win32.WindowClosure -> IO Graphics.Win32.HWND createWindow width height wndProc = do let winClass = Graphics.Win32.mkClassName "Hello" icon <- Graphics.Win32.loadIcon Nothing Graphics.Win32.iDI_APPLICATION cursor <- Graphics.Win32.loadCursor Nothing Graphics.Win32.iDC_ARROW bgBrush <- Graphics.Win32.createSolidBrush (Graphics.Win32.rgb 0 0 255) mainInstance <- System.Win32.DLL.getModuleHandle Nothing Graphics.Win32.registerClass ( Graphics.Win32.cS_VREDRAW + Graphics.Win32.cS_HREDRAW , mainInstance , Just icon , Just cursor , Just bgBrush , Nothing , winClass ) w <- Graphics.Win32.createWindow winClass "Hello, World example" Graphics.Win32.wS_OVERLAPPEDWINDOW Nothing Nothing -- leave it to the shell to decide the position -- at where to put the window initially (Just width) (Just height) Nothing -- no parent, i.e, root window is the parent. Nothing -- no menu handle mainInstance wndProc Graphics.Win32.showWindow w Graphics.Win32.sW_SHOWNORMAL Graphics.Win32.updateWindow w return w messagePump :: Graphics.Win32.HWND -> IO () messagePump hwnd = Graphics.Win32.allocaMessage $ \ msg -> let pump = do Graphics.Win32.getMessage msg (Just hwnd) `catch` \ _ -> exitWith ExitSuccess Graphics.Win32.translateMessage msg Graphics.Win32.dispatchMessage msg pump in pump paintWith :: Graphics.Win32.LPPAINTSTRUCT -> Graphics.Win32.HWND -> (Graphics.Win32.HDC -> IO a) -> IO a paintWith lpps hwnd p = bracket (Graphics.Win32.beginPaint hwnd lpps) (const $ Graphics.Win32.endPaint hwnd lpps) p \end{code} hugs98-plus-Sep2006/packages/Win32/include/0000755006511100651110000000000010504340503017060 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/include/win32debug.h0000644006511100651110000000036710504340503021210 0ustar rossross#ifndef __WIN32_LIB_DEBUG_H /* prefix WIN32_LIB to give it a better chance of being unique */ #define __WIN32_LIB_DEBUG_H #if defined(TARGET_GHC) && defined(WIN32_LIB_DEBUG) extern char* __current_fun__; #endif #endif /* __WIN32_LIB_DEBUG_H */ hugs98-plus-Sep2006/packages/Win32/include/HsGDI.h0000644006511100651110000000222310504340503020126 0ustar rossross#ifndef __HSGDI_H #define __HSGDI_H #include #ifndef INLINE # if defined(_MSC_VER) # define INLINE extern __inline # else # define INLINE extern inline # endif #endif INLINE COLORREF rgb(BYTE r, BYTE g, BYTE b) { return RGB(r, g, b); } INLINE BYTE getRValue(COLORREF color) { return GetRValue(color); } INLINE BYTE getGValue(COLORREF color) { return GetGValue(color); } INLINE BYTE getBValue(COLORREF color) { return GetBValue(color); } INLINE COLORREF pALETTERGB(BYTE r, BYTE g, BYTE b) { return PALETTERGB(r, g, b); } INLINE COLORREF pALETTEINDEX(WORD w) { return PALETTEINDEX(w); } #ifdef __WINE_WINDOWS_H INLINE UINT mAKEROP4(UINT op1, UINT op2) { return 0; } #else INLINE UINT mAKEROP4(UINT op1, UINT op2) { return MAKEROP4(op1, op2); } #endif INLINE UINT prim_MenuItemFromPoint(HWND wnd, HMENU menu, LPPOINT p_pt) { return MenuItemFromPoint(wnd, menu, *p_pt); } INLINE HWND prim_ChildWindowFromPoint(HWND parent, LPPOINT p_pt) { return ChildWindowFromPoint(parent, *p_pt); } INLINE HWND prim_ChildWindowFromPointEx(HWND parent, LPPOINT p_pt, UINT flags) { return ChildWindowFromPointEx(parent, *p_pt, flags); } #endif /* __HSGDI_H */ hugs98-plus-Sep2006/packages/Win32/include/HsWin32.h0000644006511100651110000000205410504340503020427 0ustar rossross#ifndef __HSWIN32_H #define __HSWIN32_H #include #ifndef INLINE # if defined(_MSC_VER) # define INLINE extern __inline # else # define INLINE extern inline # endif #endif INLINE UINT castPtrToUINT(void *p) { return (UINT)p; } INLINE void *castUINTToPtr(UINT n) { return (void *)n; } INLINE LONG castFunPtrToLONG(void *p) { return (LONG)p; } INLINE WORD hIWORD(DWORD w) { return HIWORD(w); } INLINE WORD lOWORD(DWORD w) { return LOWORD(w); } INLINE LANGID prim_LANGIDFROMLCID(LCID id) { return LANGIDFROMLCID(id); } INLINE LANGID prim_MAKELANGID(LANGID primary, LANGID sub) { return MAKELANGID(primary, sub); } INLINE LCID prim_MAKELCID(LANGID id, WORD sort) { return MAKELCID(id, sort); } INLINE LANGID prim_PRIMARYLANGID(LANGID id) { return PRIMARYLANGID(id); } INLINE LANGID prim_SUBLANGID(LCID id) { return SUBLANGID(id); } INLINE WORD prim_SORTIDFROMLCID(LCID id) { return SORTIDFROMLCID(id); } void UnmapViewOfFileFinaliser(void *); void CloseHandleFinaliser(HANDLE); void FreeLibraryFinaliser(HMODULE); #endif /* __HSWIN32_H */ hugs98-plus-Sep2006/packages/Win32/include/Makefile0000644006511100651110000000024110504340503020515 0ustar rossrossTOP=../.. include $(TOP)/mk/boilerplate.mk H_FILES = $(wildcard *.h) includedir = $(libdir)/include INSTALL_INCLUDES = $(H_FILES) include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/Win32/include/Win32Aux.h0000644006511100651110000000012710504340503020611 0ustar rossross/* We define OEMRESOURCE so that we can get the OBM_ constants */ #define OEMRESOURCE hugs98-plus-Sep2006/packages/Win32/include/WndProc.h0000644006511100651110000000026410504340503020607 0ustar rossross#ifndef __WNDPROC_H #define __WNDPROC_H #include extern LRESULT CALLBACK genericWndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam); #endif /* __WNDPROC_H */ hugs98-plus-Sep2006/packages/Win32/include/diatemp.h0000644006511100651110000000134410504340503020656 0ustar rossross#ifndef _DIATEMP_H_ #define _DIATEMP_H_ #include typedef struct { LPDLGTEMPLATE dtemplate; unsigned int bytes_left; /* bytes left in the chunk that 'dtemplate' points to. */ unsigned int bytes_alloced; LPDLGITEMTEMPLATE next_dia_item; } DIA_TEMPLATE; extern LPDLGTEMPLATE getFinalDialog(DIA_TEMPLATE* dt); extern DIA_TEMPLATE* mkDiaTemplate ( UINT size, int x, int y, int cx, int cy , DWORD style, DWORD exstyle , LPCWSTR menu, LPCWSTR class , LPCWSTR caption, LPCWSTR font , int height ); extern DIA_TEMPLATE* addDiaControl ( DIA_TEMPLATE* dia , LPCWSTR text, short id , LPCWSTR classname, DWORD style , int x, int y, int cx, int cy , DWORD exstyle ); #endif hugs98-plus-Sep2006/packages/Win32/include/dumpBMP.h0000644006511100651110000000026510504340503020540 0ustar rossross#include /* There's currently no #define that indicate whether we're compiling a .hc file. */ extern void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC); hugs98-plus-Sep2006/packages/Win32/include/ellipse.h0000644006511100651110000000024110504340503020663 0ustar rossross#ifndef __ELLIPSE_H #define __ELLIPSE_H #include extern int transformedEllipse(HDC, LONG, LONG, LONG, LONG, LONG, LONG); #endif /* __ELLIPSE_H */ hugs98-plus-Sep2006/packages/Win32/include/errors.h0000644006511100651110000000075410504340503020553 0ustar rossross#ifndef _MY_ERRORS_H #define _MY_ERRORS_H #include /* There's two ways we can generate error messages - with different tradeoffs: * If we do a function call, we have to use a static buffer. * If we use a macro and ANSI C's string splicing, we have to use constant * strings - and accept a certain amount of overhead from inserting the * boilerplate text. */ /* result should be freed using LocalFree */ extern LPTSTR getErrorMessage(DWORD err); #endif /* _MY_ERRORS_H */ hugs98-plus-Sep2006/packages/Win32/include/gettime.h0000644006511100651110000000014410504340503020666 0ustar rossross#include /* Prototype missing from Cygwin B20.1 */ extern DWORD WINAPI timeGetTime(); hugs98-plus-Sep2006/packages/Win32/mk/0000755006511100651110000000000010504340503016044 5ustar rossrosshugs98-plus-Sep2006/packages/Win32/mk/boilerplate.mk0000644006511100651110000000233510504340503020702 0ustar rossross# Begin by slurping in the boilerplate from one level up. # Remember, TOP is the top level of the innermost level # (FPTOOLS_TOP is the fptools top) # We need to set TOP to be the TOP that the next level up expects! # The TOP variable is reset after the inclusion of the fptools # boilerplate, so we stash TOP away first: LIBRARY_TOP := $(TOP) TOP:=$(TOP)/fptools HIERARCHICAL_LIB = YES # Some of the libraries rely on GreenCard. When you compile the GreenCard # generated code, you have to use -I/usr/lib/ghc-/include so that # the C compiler can find HsFFI.h. The easy way of doing this is to use ghc # as your C compiler. UseGhcForCc = YES # NOT YET: Haddock needs to understand about .raw-hs files # # Set our source links to point to the CVS repository on the web. # SRC_HADDOCK_OPTS += -s http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/libaries/$(PACKAGE) # Pull in the fptools boilerplate include $(TOP)/mk/boilerplate.mk # Reset TOP TOP:=$(LIBRARY_TOP) # ----------------------------------------------------------------- # Everything after this point # augments or overrides previously set variables. -include $(TOP)/mk/paths.mk -include $(TOP)/mk/opts.mk -include $(TOP)/mk/suffix.mk -include $(TOP)/mk/version.mk hugs98-plus-Sep2006/packages/Win32/mk/target.mk0000644006511100651110000000010410504340503017656 0ustar rossrossTOP:=$(TOP)/fptools include $(TOP)/mk/target.mk TOP:=$(LIBRARY_TOP) hugs98-plus-Sep2006/packages/Win32/mk/version.mk0000644006511100651110000000240710504340503020065 0ustar rossross# # Project-specific version information. # # Note: # this config file is intended to centralise all # project version information. To bump up the version # info on your package, edit this file and recompile # all the dependents. This file lives in the source tree. # # Project settings: # # ProjectVersion is treated as a *string* # ProjectVersionInt is treated as an *integer* (for cpp defines) # Versioning scheme: A.B.C # A: major version, decimal, any number of digits # B: minor version, decimal, any number of digits # C: patchlevel, one digit, omitted if zero. # # ProjectVersionInt does *not* contain the patchlevel (rationale: this # figure is used for conditional compilations, and library interfaces # etc. are not supposed to change between patchlevels). # # The ProjectVersionInt is included in interface files, and GHC # checks that it's reading interface generated by the same ProjectVersion # as itself. It does this even though interface file syntax may not # change between versions. Rationale: calling conventions or other # random .o-file stuff might change even if the .hi syntax doesn't ProjectName = Win32 Haskell library ProjectNameShort = HSWin32 ProjectVersion = 2.0 ProjectVersionInt = 200 ProjectPatchLevel = 0 hugs98-plus-Sep2006/packages/Win32/package.conf.in0000644006511100651110000000262010504340503020304 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: Graphics.Win32.GDI.Bitmap, Graphics.Win32.GDI.Brush, Graphics.Win32.GDI.Clip, Graphics.Win32.GDI.Font, Graphics.Win32.GDI.Graphics2D, Graphics.Win32.GDI.HDC, Graphics.Win32.GDI.Palette, Graphics.Win32.GDI.Path, Graphics.Win32.GDI.Pen, Graphics.Win32.GDI.Region, Graphics.Win32.GDI.Types, Graphics.Win32.Control, Graphics.Win32.Dialogue, Graphics.Win32.GDI, Graphics.Win32.Icon, Graphics.Win32.Key, Graphics.Win32.Menu, Graphics.Win32.Message, Graphics.Win32.Misc, Graphics.Win32.Resource, Graphics.Win32.Window, Graphics.Win32, System.Win32.DLL, System.Win32.File, System.Win32.FileMapping, System.Win32.Info, System.Win32.Mem, System.Win32.NLS, System.Win32.Process, System.Win32.Registry, System.Win32.Time, System.Win32.Console, System.Win32.Types, System.Win32 hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR #ifndef INSTALLING , LIB_DIR"/cbits" #endif hs-libraries: "HSWin32" extra-libraries: "HSWin32_cbits", "user32", "gdi32", "winmm", "kernel32", "advapi32" include-dirs: INCLUDE_DIR includes: "HsWin32.h", "HsGDI.h", "WndProc.h" depends: base hugs-options: cc-options: "-DUNICODE" ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/Win32/prologue.txt0000644006511100651110000000004410504340503020030 0ustar rossrossA Haskell binding to the Win32 API. hugs98-plus-Sep2006/packages/Win32/Setup.hs0000644006511100651110000000005610504340503017072 0ustar rossrossimport Distribution.Simple main = defaultMain hugs98-plus-Sep2006/packages/Win32/boring.txt0000644006511100651110000000234510504340503017462 0ustar rossross# Boring file regexps: \.hi$ \.o$ \.o\.cmd$ # *.ko files aren't boring by default because they might # be Korean translations rather than kernel modules. # \.ko$ \.ko\.cmd$ \.mod\.c$ (^|/)\.tmp_versions($|/) (^|/)CVS($|/) (^|/)RCS($|/) ~$ #(^|/)\.[^/] (^|/)_darcs($|/) \.bak$ \.BAK$ \.orig$ (^|/)vssver\.scc$ \.swp$ (^|/)MT($|/) (^|/)\{arch\}($|/) (^|/).arch-ids($|/) (^|/), \.class$ \.prof$ (^|/)\.DS_Store$ (^|/)BitKeeper($|/) (^|/)ChangeSet($|/) (^|/)\.svn($|/) \.py[co]$ \# \.cvsignore$ (^|/)Thumbs\.db$ \.exe$ (^|/)dist _stub\.[ch]$ ^\. \.suo$ \.sln$ Graphics/Win32/Control.hs$ Graphics/Win32/Dialogue.hs$ Graphics/Win32/GDI/Bitmap.hs$ Graphics/Win32/GDI/Brush.hs$ Graphics/Win32/GDI/Clip.hs$ Graphics/Win32/GDI/Font.hs$ Graphics/Win32/GDI/Palette.hs$ Graphics/Win32/GDI/Pen.hs$ Graphics/Win32/GDI/Types.hs$ Graphics/Win32/Key.hs$ Graphics/Win32/Menu.hs$ Graphics/Win32/Message.hs$ Graphics/Win32/Misc.hs$ Graphics/Win32/Resource.hs$ Graphics/Win32/Window.hs$ System/Win32/DebugApi.hs$ System/Win32/DLL.hs$ System/Win32/Console.hs$ System/Win32/File.hs$ System/Win32/FileMapping.hs$ System/Win32/Info.hs$ System/Win32/Mem.hs$ System/Win32/NLS.hs$ System/Win32/Process.hs$ System/Win32/Registry.hs$ System/Win32/SimpleMAPI.hs$ System/Win32/Time.hs$ hugs98-plus-Sep2006/packages/time/0000755006511100651110000000000010504340734015477 5ustar rossrosshugs98-plus-Sep2006/packages/time/Data/0000755006511100651110000000000010504340547016352 5ustar rossrosshugs98-plus-Sep2006/packages/time/Data/Time/0000755006511100651110000000000010504340546017247 5ustar rossrosshugs98-plus-Sep2006/packages/time/Data/Time/Calendar/0000755006511100651110000000000010504340546020760 5ustar rossrosshugs98-plus-Sep2006/packages/time/Data/Time/Calendar/JulianYearDay.hs0000644006511100651110000000254110504340546024017 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.Calendar.JulianYearDay ( -- * Year and day format module Data.Time.Calendar.JulianYearDay ) where import Data.Time.Calendar.Days import Data.Time.Calendar.Private -- | convert to ISO 8601 Ordinal Day format. First element of result is year (proleptic Gregoran calendar), -- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31. toJulianYearAndDay :: Day -> (Integer,Int) toJulianYearAndDay (ModifiedJulianDay mjd) = (year,yd) where a = mjd + 678577 quad = div a 1461 d = mod a 1461 y = min (div d 365) 3 yd = fromInteger (d - (y * 365) + 1) year = quad * 4 + y + 1 -- | convert from ISO 8601 Ordinal Day format. -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366). fromJulianYearAndDay :: Integer -> Int -> Day fromJulianYearAndDay year day = ModifiedJulianDay mjd where y = year - 1 mjd = (fromIntegral (clip 1 (if isJulianLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - 678578 -- | show in ISO 8601 Ordinal Day format (yyyy-ddd) showJulianYearAndDay :: Day -> String showJulianYearAndDay date = (show4 y) ++ "-" ++ (show3 d) where (y,d) = toJulianYearAndDay date -- | Is this year a leap year according to the propleptic Gregorian calendar? isJulianLeapYear :: Integer -> Bool isJulianLeapYear year = (mod year 4 == 0) hugs98-plus-Sep2006/packages/time/Data/Time/Calendar/MonthDay.hs0000644006511100651110000000275410504340546023047 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Data.Time.Calendar.MonthDay ( monthAndDayToDayOfYear,dayOfYearToMonthAndDay,monthLength ) where import Data.Time.Calendar.Private -- | convert month and day in the Gregorian or Julian calendars to day of year. -- First arg is leap year flag monthAndDayToDayOfYear :: Bool -> Int -> Int -> Int monthAndDayToDayOfYear isLeap month day = (div (367 * month'' - 362) 12) + k + day' where month' = clip 1 12 month day' = fromIntegral (clip 1 (monthLength' isLeap month') day) month'' = fromIntegral month' k = if month' <= 2 then 0 else if isLeap then -1 else -2 -- | convert day of year in the Gregorian or Julian calendars to month and day. -- First arg is leap year flag dayOfYearToMonthAndDay :: Bool -> Int -> (Int,Int) dayOfYearToMonthAndDay isLeap yd = findMonthDay (monthLengths isLeap) (clip 1 (if isLeap then 366 else 365) yd) findMonthDay :: [Int] -> Int -> (Int,Int) findMonthDay (n:ns) yd | yd > n = (\(m,d) -> (m + 1,d)) (findMonthDay ns (yd - n)) findMonthDay _ yd = (1,yd) -- | the length of a given month in the Gregorian or Julian calendars. -- First arg is leap year flag monthLength :: Bool -> Int -> Int monthLength isLeap month' = monthLength' isLeap (clip 1 12 month') monthLength' :: Bool -> Int -> Int monthLength' isLeap month' = (monthLengths isLeap) !! (month' - 1) monthLengths :: Bool -> [Int] monthLengths isleap = [31,if isleap then 29 else 28,31,30,31,30,31,31,30,31,30,31] --J F M A M J J A S O N D hugs98-plus-Sep2006/packages/time/Data/Time/Calendar/Gregorian.hs0000644006511100651110000000576110504340546023242 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.Calendar.Gregorian ( -- * Gregorian calendar toGregorian,fromGregorian,showGregorian,gregorianMonthLength, -- calendrical arithmetic -- e.g. "one month after March 31st" addGregorianMonthsClip,addGregorianMonthsRollOver, addGregorianYearsClip,addGregorianYearsRollOver, -- re-exported from OrdinalDate isLeapYear ) where import Data.Time.Calendar.MonthDay import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Days import Data.Time.Calendar.Private -- | convert to proleptic Gregorian calendar. First element of result is year, second month number (1-12), third day (1-31). toGregorian :: Day -> (Integer,Int,Int) toGregorian date = (year,month,day) where (year,yd) = toOrdinalDate date (month,day) = dayOfYearToMonthAndDay (isLeapYear year) yd -- | convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31). -- Invalid values will be clipped to the correct range, month first, then day. fromGregorian :: Integer -> Int -> Int -> Day fromGregorian year month day = fromOrdinalDate year (monthAndDayToDayOfYear (isLeapYear year) month day) -- | show in ISO 8601 format (yyyy-mm-dd) showGregorian :: Day -> String showGregorian date = (show4 y) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d) where (y,m,d) = toGregorian date -- | The number of days in a given month according to the proleptic Gregorian calendar. First argument is year, second is month. gregorianMonthLength :: Integer -> Int -> Int gregorianMonthLength year = monthLength (isLeapYear year) rolloverMonths :: (Integer,Integer) -> (Integer,Int) rolloverMonths (y,m) = (y + (div (m - 1) 12),fromIntegral (mod (m - 1) 12) + 1) addGregorianMonths :: Integer -> Day -> (Integer,Int,Int) addGregorianMonths n day = (y',m',d) where (y,m,d) = toGregorian day (y',m') = rolloverMonths (y,fromIntegral m + n) -- | Add months, with days past the last day of the month clipped to the last day. -- For instance, 2005-01-30 + 1 month = 2005-02-28. addGregorianMonthsClip :: Integer -> Day -> Day addGregorianMonthsClip n day = fromGregorian y m d where (y,m,d) = addGregorianMonths n day -- | Add months, with days past the last day of the month rolling over to the next month. -- For instance, 2005-01-30 + 1 month = 2005-03-02. addGregorianMonthsRollOver :: Integer -> Day -> Day addGregorianMonthsRollOver n day = addDays (fromIntegral d - 1) (fromGregorian y m 1) where (y,m,d) = addGregorianMonths n day -- | Add years, matching month and day, with Feb 29th clipped to Feb 28th if necessary. -- For instance, 2004-02-29 + 2 years = 2006-02-28. addGregorianYearsClip :: Integer -> Day -> Day addGregorianYearsClip n = addGregorianMonthsClip (n * 12) -- | Add years, matching month and day, with Feb 29th rolled over to Mar 1st if necessary. -- For instance, 2004-02-29 + 2 years = 2006-03-01. addGregorianYearsRollOver :: Integer -> Day -> Day addGregorianYearsRollOver n = addGregorianMonthsRollOver (n * 12) instance Show Day where show = showGregorian hugs98-plus-Sep2006/packages/time/Data/Time/Calendar/Private.hs0000644006511100651110000000202410504340546022724 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.Calendar.Private where import Data.Fixed show2 :: (Num t,Ord t,Show t) => t -> String show2 i | i < 0 = '-':(show2 (negate i)) show2 i = let s = show i in case s of [_] -> '0':s _ -> s show2Space :: (Num t,Ord t,Show t) => t -> String show2Space i | i < 0 = '-':(show2Space (negate i)) show2Space i = let s = show i in case s of [_] -> ' ':s _ -> s show2Fixed :: Pico -> String show2Fixed x | x < 10 = '0':(showFixed True x) show2Fixed x = showFixed True x show3 :: (Num t,Ord t,Show t) => t -> String show3 i | i < 0 = '-':(show3 (negate i)) show3 i = let s = show2 i in case s of [_,_] -> '0':s _ -> s show4 :: (Num t,Ord t,Show t) => t -> String show4 i | i < 0 = '-':(show4 (negate i)) show4 i = let s = show3 i in case s of [_,_,_] -> '0':s _ -> s mod100 :: (Integral i) => i -> i mod100 x = mod x 100 div100 :: (Integral i) => i -> i div100 x = div x 100 clip :: (Ord t) => t -> t -> t -> t clip a _ x | x < a = a clip _ b x | x > b = b clip _ _ x = x hugs98-plus-Sep2006/packages/time/Data/Time/Calendar/OrdinalDate.hs0000644006511100651110000000457710504340546023517 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- | ISO 8601 Ordinal Date format module Data.Time.Calendar.OrdinalDate where import Data.Time.Calendar.Days import Data.Time.Calendar.Private -- | convert to ISO 8601 Ordinal Date format. First element of result is year (proleptic Gregoran calendar), -- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31. toOrdinalDate :: Day -> (Integer,Int) toOrdinalDate (ModifiedJulianDay mjd) = (year,yd) where a = mjd + 678575 quadcent = div a 146097 b = mod a 146097 cent = min (div b 36524) 3 c = b - (cent * 36524) quad = div c 1461 d = mod c 1461 y = min (div d 365) 3 yd = fromInteger (d - (y * 365) + 1) year = quadcent * 400 + cent * 100 + quad * 4 + y + 1 -- | convert from ISO 8601 Ordinal Date format. -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366). fromOrdinalDate :: Integer -> Int -> Day fromOrdinalDate year day = ModifiedJulianDay mjd where y = year - 1 mjd = (fromIntegral (clip 1 (if isLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576 -- | show in ISO 8601 Ordinal Date format (yyyy-ddd) showOrdinalDate :: Day -> String showOrdinalDate date = (show4 y) ++ "-" ++ (show3 d) where (y,d) = toOrdinalDate date -- | Is this year a leap year according to the propleptic Gregorian calendar? isLeapYear :: Integer -> Bool isLeapYear year = (mod year 4 == 0) && ((mod year 400 == 0) || not (mod year 100 == 0)) -- | Get the number of the Monday-starting week in the year and the day of the week. -- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as \"%W\" in formatTime). -- Monday is 1, Sunday is 7 (as \"%u\" in formatTime). mondayStartWeek :: Day -> (Int,Int) mondayStartWeek date = (fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7) + 1) where yd = snd (toOrdinalDate date) d = (toModifiedJulianDay date) + 2 k = d - (toInteger yd) -- | Get the number of the Sunday-starting week in the year and the day of the week. -- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as \"%U\" in formatTime). -- Sunday is 0, Saturday is 6 (as \"%w\" in formatTime). sundayStartWeek :: Day -> (Int,Int) sundayStartWeek date =(fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7)) where yd = snd (toOrdinalDate date) d = (toModifiedJulianDay date) + 3 k = d - (toInteger yd) hugs98-plus-Sep2006/packages/time/Data/Time/Calendar/Easter.hs0000644006511100651110000000277310504340546022550 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Data.Time.Calendar.Easter ( sundayAfter, orthodoxPaschalMoon,orthodoxEaster, gregorianPaschalMoon,gregorianEaster ) where -- formulae from Reingold & Dershowitz, _Calendrical Calculations_, ch. 8. import Data.Time.Calendar import Data.Time.Calendar.Julian -- | The next Sunday strictly after a given day. sundayAfter :: Day -> Day sundayAfter day = addDays (7 - (mod (toModifiedJulianDay day + 3) 7)) day -- | Given a year, find the Paschal full moon according to Orthodox Christian tradition orthodoxPaschalMoon :: Integer -> Day orthodoxPaschalMoon year = addDays (- shiftedEpact) (fromJulian jyear 4 19) where shiftedEpact = mod (14 + 11 * (mod year 19)) 30 jyear = if year > 0 then year else year - 1 -- | Given a year, find Easter according to Orthodox Christian tradition orthodoxEaster :: Integer -> Day orthodoxEaster = sundayAfter . orthodoxPaschalMoon -- | Given a year, find the Paschal full moon according to the Gregorian method gregorianPaschalMoon :: Integer -> Day gregorianPaschalMoon year = addDays (- adjustedEpact) (fromGregorian year 4 19) where century = (div year 100) + 1 shiftedEpact = mod (14 + 11 * (mod year 19) - (div (3 * century) 4) + (div (5 + 8 * century) 25)) 30 adjustedEpact = if shiftedEpact == 0 || ((shiftedEpact == 1) && (mod year 19 < 10)) then shiftedEpact + 1 else shiftedEpact -- | Given a year, find Easter according to the Gregorian method gregorianEaster :: Integer -> Day gregorianEaster = sundayAfter . gregorianPaschalMoon hugs98-plus-Sep2006/packages/time/Data/Time/Calendar/Julian.hs0000644006511100651110000000551010504340546022537 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Data.Time.Calendar.Julian ( module Data.Time.Calendar.JulianYearDay, toJulian,fromJulian,showJulian,julianMonthLength, -- calendrical arithmetic -- e.g. "one month after March 31st" addJulianMonthsClip,addJulianMonthsRollOver, addJulianYearsClip,addJulianYearsRollOver ) where import Data.Time.Calendar.MonthDay import Data.Time.Calendar.JulianYearDay import Data.Time.Calendar.Days import Data.Time.Calendar.Private -- | convert to proleptic Julian calendar. First element of result is year, second month number (1-12), third day (1-31). toJulian :: Day -> (Integer,Int,Int) toJulian date = (year,month,day) where (year,yd) = toJulianYearAndDay date (month,day) = dayOfYearToMonthAndDay (isJulianLeapYear year) yd -- | convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31). -- Invalid values will be clipped to the correct range, month first, then day. fromJulian :: Integer -> Int -> Int -> Day fromJulian year month day = fromJulianYearAndDay year (monthAndDayToDayOfYear (isJulianLeapYear year) month day) -- | show in ISO 8601 format (yyyy-mm-dd) showJulian :: Day -> String showJulian date = (show4 y) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d) where (y,m,d) = toJulian date -- | The number of days in a given month according to the proleptic Julian calendar. First argument is year, second is month. julianMonthLength :: Integer -> Int -> Int julianMonthLength year = monthLength (isJulianLeapYear year) rolloverMonths :: (Integer,Integer) -> (Integer,Int) rolloverMonths (y,m) = (y + (div (m - 1) 12),fromIntegral (mod (m - 1) 12) + 1) addJulianMonths :: Integer -> Day -> (Integer,Int,Int) addJulianMonths n day = (y',m',d) where (y,m,d) = toJulian day (y',m') = rolloverMonths (y,fromIntegral m + n) -- | Add months, with days past the last day of the month clipped to the last day. -- For instance, 2005-01-30 + 1 month = 2005-02-28. addJulianMonthsClip :: Integer -> Day -> Day addJulianMonthsClip n day = fromJulian y m d where (y,m,d) = addJulianMonths n day -- | Add months, with days past the last day of the month rolling over to the next month. -- For instance, 2005-01-30 + 1 month = 2005-03-02. addJulianMonthsRollOver :: Integer -> Day -> Day addJulianMonthsRollOver n day = addDays (fromIntegral d - 1) (fromJulian y m 1) where (y,m,d) = addJulianMonths n day -- | Add years, matching month and day, with Feb 29th clipped to Feb 28th if necessary. -- For instance, 2004-02-29 + 2 years = 2006-02-28. addJulianYearsClip :: Integer -> Day -> Day addJulianYearsClip n = addJulianMonthsClip (n * 12) -- | Add years, matching month and day, with Feb 29th rolled over to Mar 1st if necessary. -- For instance, 2004-02-29 + 2 years = 2006-03-01. addJulianYearsRollOver :: Integer -> Day -> Day addJulianYearsRollOver n = addJulianMonthsRollOver (n * 12) hugs98-plus-Sep2006/packages/time/Data/Time/Calendar/Days.hs0000644006511100651110000000400710504340546022215 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.Calendar.Days ( -- * Days Day(..),addDays,diffDays ) where -- | The Modified Julian Day is a standard count of days, with zero being the day 1858-11-17. newtype Day = ModifiedJulianDay {toModifiedJulianDay :: Integer} deriving (Eq,Ord) -- necessary because H98 doesn't have "cunning newtype" derivation instance Enum Day where succ (ModifiedJulianDay a) = ModifiedJulianDay (succ a) pred (ModifiedJulianDay a) = ModifiedJulianDay (pred a) toEnum = ModifiedJulianDay . toEnum fromEnum (ModifiedJulianDay a) = fromEnum a enumFrom (ModifiedJulianDay a) = fmap ModifiedJulianDay (enumFrom a) enumFromThen (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromThen a b) enumFromTo (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromTo a b) enumFromThenTo (ModifiedJulianDay a) (ModifiedJulianDay b) (ModifiedJulianDay c) = fmap ModifiedJulianDay (enumFromThenTo a b c) addDays :: Integer -> Day -> Day addDays n (ModifiedJulianDay a) = ModifiedJulianDay (a + n) diffDays :: Day -> Day -> Integer diffDays (ModifiedJulianDay a) (ModifiedJulianDay b) = a - b {- instance Show Day where show (ModifiedJulianDay d) = "MJD " ++ (show d) -- necessary because H98 doesn't have "cunning newtype" derivation instance Num Day where (ModifiedJulianDay a) + (ModifiedJulianDay b) = ModifiedJulianDay (a + b) (ModifiedJulianDay a) - (ModifiedJulianDay b) = ModifiedJulianDay (a - b) (ModifiedJulianDay a) * (ModifiedJulianDay b) = ModifiedJulianDay (a * b) negate (ModifiedJulianDay a) = ModifiedJulianDay (negate a) abs (ModifiedJulianDay a) = ModifiedJulianDay (abs a) signum (ModifiedJulianDay a) = ModifiedJulianDay (signum a) fromInteger = ModifiedJulianDay instance Real Day where toRational (ModifiedJulianDay a) = toRational a instance Integral Day where toInteger (ModifiedJulianDay a) = toInteger a quotRem (ModifiedJulianDay a) (ModifiedJulianDay b) = (ModifiedJulianDay c,ModifiedJulianDay d) where (c,d) = quotRem a b -} hugs98-plus-Sep2006/packages/time/Data/Time/Calendar/WeekDate.hs0000644006511100651110000000343510504340546023012 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- | ISO 8601 Week Date format module Data.Time.Calendar.WeekDate where import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Days import Data.Time.Calendar.Private -- | convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday). -- Note that \"Week\" years are not quite the same as Gregorian years, as the first day of the year is always a Monday. -- The first week of a year is the first week to contain at least four days in the corresponding Gregorian year. toWeekDate :: Day -> (Integer,Int,Int) toWeekDate date@(ModifiedJulianDay mjd) = (y1,fromInteger (w1 + 1),fromInteger (mod d 7) + 1) where (y0,yd) = toOrdinalDate date d = mjd + 2 foo :: Integer -> Integer foo y = bar (toModifiedJulianDay (fromOrdinalDate y 6)) bar k = (div d 7) - (div k 7) w0 = bar (d - (toInteger yd) + 4) (y1,w1) = if w0 == -1 then (y0 - 1,foo (y0 - 1)) else if w0 == 52 then if (foo (y0 + 1)) == 0 then (y0 + 1,0) else (y0,w0) else (y0,w0) -- | convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday). -- Invalid week and day values will be clipped to the correct range. fromWeekDate :: Integer -> Int -> Int -> Day fromWeekDate y w d = ModifiedJulianDay (k - (mod k 7) + (toInteger (((clip 1 (if longYear then 53 else 52) w) * 7) + (clip 1 7 d))) - 10) where k = toModifiedJulianDay (fromOrdinalDate y 6) longYear = case toWeekDate (fromOrdinalDate y 365) of (_,53,_) -> True _ -> False -- | show in ISO 8601 Week Date format as yyyy-Www-dd (e.g. showWeekDate :: Day -> String showWeekDate date = (show4 y) ++ "-W" ++ (show2 w) ++ "-" ++ (show d) where (y,w,d) = toWeekDate date hugs98-plus-Sep2006/packages/time/Data/Time/Calendar.hs0000644006511100651110000000031510504340546021313 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Data.Time.Calendar ( module Data.Time.Calendar.Days, module Data.Time.Calendar.Gregorian ) where import Data.Time.Calendar.Days import Data.Time.Calendar.Gregorian hugs98-plus-Sep2006/packages/time/Data/Time/Clock.hs0000644006511100651110000000076510504340546020646 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- | Types and functions for UTC and UT1 module Data.Time.Clock ( module Data.Time.Clock.Scale, module Data.Time.Clock.UTC, module Data.Time.Clock.UTCDiff, module Data.Time.Clock ) where import Data.Time.Clock.Scale import Data.Time.Clock.UTCDiff import Data.Time.Clock.UTC import Data.Time.Clock.POSIX import Control.Monad -- | Get the current UTC time from the system clock. getCurrentTime :: IO UTCTime getCurrentTime = liftM posixSecondsToUTCTime getPOSIXTime hugs98-plus-Sep2006/packages/time/Data/Time/Clock/0000755006511100651110000000000010504340547020303 5ustar rossrosshugs98-plus-Sep2006/packages/time/Data/Time/Clock/TAI.hs0000644006511100651110000001012310504340546021250 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- | TAI and leap-second tables for converting to UTC: most people won't need this module. module Data.Time.Clock.TAI ( -- TAI arithmetic AbsoluteTime,taiEpoch,addAbsoluteTime,diffAbsoluteTime, -- leap-second table type LeapSecondTable, -- conversion between UTC and TAI with table utcDayLength,utcToTAITime,taiToUTCTime, parseTAIUTCDATFile ) where import Data.Time.LocalTime import Data.Time.Calendar.Days import Data.Time.Clock import Data.Fixed -- | AbsoluteTime is TAI, time as measured by a clock. newtype AbsoluteTime = MkAbsoluteTime {unAbsoluteTime :: DiffTime} deriving (Eq,Ord) instance Show AbsoluteTime where show t = show (utcToLocalTime utc (taiToUTCTime (const 0) t)) ++ " TAI" -- ugly, but standard apparently -- | The epoch of TAI, which is taiEpoch :: AbsoluteTime taiEpoch = MkAbsoluteTime 0 -- | addAbsoluteTime a b = a + b addAbsoluteTime :: DiffTime -> AbsoluteTime -> AbsoluteTime addAbsoluteTime t (MkAbsoluteTime a) = MkAbsoluteTime (a + t) -- | diffAbsoluteTime a b = a - b diffAbsoluteTime :: AbsoluteTime -> AbsoluteTime -> DiffTime diffAbsoluteTime (MkAbsoluteTime a) (MkAbsoluteTime b) = a - b -- | TAI - UTC during this day. -- No table is provided, as any program compiled with it would become -- out of date in six months. type LeapSecondTable = Day -> Integer utcDayLength :: LeapSecondTable -> Day -> DiffTime utcDayLength table day = realToFrac (86400 + (table (addDays 1 day)) - (table day)) dayStart :: LeapSecondTable -> Day -> AbsoluteTime dayStart table day = MkAbsoluteTime (realToFrac ((toModifiedJulianDay day) * 86400 + (table day))) utcToTAITime :: LeapSecondTable -> UTCTime -> AbsoluteTime utcToTAITime table (UTCTime day dtime) = MkAbsoluteTime (t + dtime) where MkAbsoluteTime t = dayStart table day taiToUTCTime :: LeapSecondTable -> AbsoluteTime -> UTCTime taiToUTCTime table abstime = stable (ModifiedJulianDay (div' (unAbsoluteTime abstime) 86400)) where stable day = if (day == day') then UTCTime day dtime else stable day' where dayt = dayStart table day dtime = diffAbsoluteTime abstime dayt day' = addDays (div' dtime (utcDayLength table day)) day -- | Parse the contents of a tai-utc.dat file. -- This does not do any kind of validation and will return a bad table for input -- not in the correct format. parseTAIUTCDATFile :: String -> LeapSecondTable parseTAIUTCDATFile ss = offsetlist 0 (parse (lines ss)) where offsetlist :: Integer -> [(Day,Integer)] -> LeapSecondTable offsetlist i [] _ = i offsetlist i ((d0,_):_) d | d < d0 = i offsetlist _ ((_,i0):xx) d = offsetlist i0 xx d parse :: [String] -> [(Day,Integer)] parse [] = [] parse (a:as) = let ps = parse as in case matchLine a of Just di -> di:ps Nothing -> ps matchLine :: String -> Maybe (Day,Integer) matchLine s = do check0S s (d,s') <- findJD s i <- findOffset s' return (d,i) -- a bit fragile check0S :: String -> Maybe () check0S "X 0.0 S" = Just () check0S [] = Nothing check0S (_:cs) = check0S cs findJD :: String -> Maybe (Day,String) findJD ('=':'J':'D':s) = do d <- getInteger '5' s return (ModifiedJulianDay (d - 2400000),s) findJD [] = Nothing findJD (_:cs) = findJD cs findOffset :: String -> Maybe Integer findOffset ('T':'A':'I':'-':'U':'T':'C':'=':s) = getInteger '0' s findOffset [] = Nothing findOffset (_:cs) = findOffset cs getInteger :: Char -> String -> Maybe Integer getInteger p s = do digits <- getDigits p s fromDigits 0 digits getDigits :: Char -> String -> Maybe String getDigits p (' ':s) = getDigits p s getDigits p (c:cs) | c >= '0' && c <= '9' = do s <- getDigits p cs return (c:s) getDigits p ('.':p1:_) = if p == p1 then Just [] else Nothing getDigits _ _ = Nothing fromDigits :: Integer -> String -> Maybe Integer fromDigits i [] = Just i fromDigits i (c:cs) | c >= '0' && c <= '9' = fromDigits ((i * 10) + (fromIntegral ((fromEnum c) - (fromEnum '0')))) cs fromDigits _ _ = Nothing -- typical line format: -- 1972 JAN 1 =JD 2441317.5 TAI-UTC= 10.0 S + (MJD - 41317.) X 0.0 S -- 1972 JUL 1 =JD 2441499.5 TAI-UTC= 11.0 S + (MJD - 41317.) X 0.0 S hugs98-plus-Sep2006/packages/time/Data/Time/Clock/POSIX.hs0000644006511100651110000000356010504340547021545 0ustar rossross{-# OPTIONS -Wall -Werror -cpp #-} -- | POSIX time, if you need to deal with timestamps and the like. -- Most people won't need this module. module Data.Time.Clock.POSIX ( posixDayLength,POSIXTime,posixSecondsToUTCTime,utcTimeToPOSIXSeconds,getPOSIXTime ) where import Data.Time.Clock.UTC import Data.Time.Calendar.Days import Data.Fixed import Control.Monad #ifdef mingw32_HOST_OS import Data.Word ( Word64) import System.Win32.Time #else import Data.Time.Clock.CTimeval #endif -- | 86400 nominal seconds in every day posixDayLength :: NominalDiffTime posixDayLength = 86400 -- | POSIX time is the nominal time since 1970-01-01 00:00 UTC type POSIXTime = NominalDiffTime unixEpochDay :: Day unixEpochDay = ModifiedJulianDay 40587 posixSecondsToUTCTime :: POSIXTime -> UTCTime posixSecondsToUTCTime i = let (d,t) = divMod' i posixDayLength in UTCTime (addDays d unixEpochDay) (realToFrac t) utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime utcTimeToPOSIXSeconds (UTCTime d t) = (fromInteger (diffDays d unixEpochDay) * posixDayLength) + min posixDayLength (realToFrac t) -- | Get the current POSIX time from the system clock. getPOSIXTime :: IO POSIXTime #ifdef mingw32_HOST_OS -- On Windows, the equlvalent of POSIX time is "file time", defined as -- the number of 100-nanosecond intervals that have elapsed since -- 12:00 A.M. January 1, 1601 (UTC). We can convert this into a POSIX -- time by adjusting the offset to be relative to the POSIX epoch. getPOSIXTime = do FILETIME ft <- System.Win32.Time.getSystemTimeAsFileTime return (fromIntegral (ft - win32_epoch_adjust) / 10000000) win32_epoch_adjust :: Word64 win32_epoch_adjust = 116444736000000000 #else -- Use POSIX time ctimevalToPosixSeconds :: CTimeval -> POSIXTime ctimevalToPosixSeconds (MkCTimeval s mus) = (fromIntegral s) + (fromIntegral mus) / 1000000 getPOSIXTime = liftM ctimevalToPosixSeconds getCTimeval #endif hugs98-plus-Sep2006/packages/time/Data/Time/Clock/Scale.hs0000644006511100651110000000417610504340546021675 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.Clock.Scale ( -- * Universal Time -- | Time as measured by the earth. UniversalTime(..), -- * Absolute intervals DiffTime ) where import Data.Fixed -- | The Modified Julian Date is the day with the fraction of the day, measured from UT midnight. -- It's used to represent UT1, which is time as measured by the earth's rotation, adjusted for various wobbles. newtype UniversalTime = ModJulianDate {getModJulianDate :: Rational} deriving (Eq,Ord) -- | This is a length of time, as measured by a clock. -- Conversion functions will treat it as seconds. -- It has an accuracy of 10^-12 s. newtype DiffTime = MkDiffTime Pico deriving (Eq,Ord) -- necessary because H98 doesn't have "cunning newtype" derivation instance Enum DiffTime where succ (MkDiffTime a) = MkDiffTime (succ a) pred (MkDiffTime a) = MkDiffTime (pred a) toEnum = MkDiffTime . toEnum fromEnum (MkDiffTime a) = fromEnum a enumFrom (MkDiffTime a) = fmap MkDiffTime (enumFrom a) enumFromThen (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromThen a b) enumFromTo (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromTo a b) enumFromThenTo (MkDiffTime a) (MkDiffTime b) (MkDiffTime c) = fmap MkDiffTime (enumFromThenTo a b c) instance Show DiffTime where show (MkDiffTime t) = (showFixed True t) ++ "s" -- necessary because H98 doesn't have "cunning newtype" derivation instance Num DiffTime where (MkDiffTime a) + (MkDiffTime b) = MkDiffTime (a + b) (MkDiffTime a) - (MkDiffTime b) = MkDiffTime (a - b) (MkDiffTime a) * (MkDiffTime b) = MkDiffTime (a * b) negate (MkDiffTime a) = MkDiffTime (negate a) abs (MkDiffTime a) = MkDiffTime (abs a) signum (MkDiffTime a) = MkDiffTime (signum a) fromInteger i = MkDiffTime (fromInteger i) -- necessary because H98 doesn't have "cunning newtype" derivation instance Real DiffTime where toRational (MkDiffTime a) = toRational a -- necessary because H98 doesn't have "cunning newtype" derivation instance Fractional DiffTime where (MkDiffTime a) / (MkDiffTime b) = MkDiffTime (a / b) recip (MkDiffTime a) = MkDiffTime (recip a) fromRational r = MkDiffTime (fromRational r) hugs98-plus-Sep2006/packages/time/Data/Time/Clock/UTC.hs0000644006511100651110000000730410504340546021275 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.Clock.UTC ( -- * UTC -- | UTC is time as measured by a clock, corrected to keep pace with the earth by adding or removing -- occasional seconds, known as \"leap seconds\". -- These corrections are not predictable and are announced with six month's notice. -- No table of these corrections is provided, as any program compiled with it would become -- out of date in six months. -- -- If you don't care about leap seconds, use UTCTime and NominalDiffTime for your clock calculations, -- and you'll be fine. UTCTime(..),NominalDiffTime ) where import Data.Time.Calendar.Days import Data.Time.Clock.Scale import Data.Fixed -- | This is the simplest representation of UTC. -- It consists of the day number, and a time offset from midnight. -- Note that if a day has a leap second added to it, it will have 86401 seconds. data UTCTime = UTCTime { -- | the day utctDay :: Day, -- | the time from midnight, 0 <= t < 86401s (because of leap-seconds) utctDayTime :: DiffTime } instance Eq UTCTime where (UTCTime da ta) == (UTCTime db tb) = (da == db) && (ta == tb) instance Ord UTCTime where compare (UTCTime da ta) (UTCTime db tb) = case (compare da db) of EQ -> compare ta tb cmp -> cmp -- | This is a length of time, as measured by UTC. -- Conversion functions will treat it as seconds. -- It has an accuracy of 10^-12 s. -- It ignores leap-seconds, so it's not necessarily a fixed amount of clock time. -- For instance, 23:00 UTC + 2 hours of NominalDiffTime = 01:00 UTC (+ 1 day), -- regardless of whether a leap-second intervened. newtype NominalDiffTime = MkNominalDiffTime Pico deriving (Eq,Ord) instance Enum NominalDiffTime where succ (MkNominalDiffTime a) = MkNominalDiffTime (succ a) pred (MkNominalDiffTime a) = MkNominalDiffTime (pred a) toEnum = MkNominalDiffTime . toEnum fromEnum (MkNominalDiffTime a) = fromEnum a enumFrom (MkNominalDiffTime a) = fmap MkNominalDiffTime (enumFrom a) enumFromThen (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromThen a b) enumFromTo (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromTo a b) enumFromThenTo (MkNominalDiffTime a) (MkNominalDiffTime b) (MkNominalDiffTime c) = fmap MkNominalDiffTime (enumFromThenTo a b c) instance Show NominalDiffTime where show (MkNominalDiffTime t) = (showFixed True t) ++ "s" -- necessary because H98 doesn't have "cunning newtype" derivation instance Num NominalDiffTime where (MkNominalDiffTime a) + (MkNominalDiffTime b) = MkNominalDiffTime (a + b) (MkNominalDiffTime a) - (MkNominalDiffTime b) = MkNominalDiffTime (a - b) (MkNominalDiffTime a) * (MkNominalDiffTime b) = MkNominalDiffTime (a * b) negate (MkNominalDiffTime a) = MkNominalDiffTime (negate a) abs (MkNominalDiffTime a) = MkNominalDiffTime (abs a) signum (MkNominalDiffTime a) = MkNominalDiffTime (signum a) fromInteger i = MkNominalDiffTime (fromInteger i) -- necessary because H98 doesn't have "cunning newtype" derivation instance Real NominalDiffTime where toRational (MkNominalDiffTime a) = toRational a -- necessary because H98 doesn't have "cunning newtype" derivation instance Fractional NominalDiffTime where (MkNominalDiffTime a) / (MkNominalDiffTime b) = MkNominalDiffTime (a / b) recip (MkNominalDiffTime a) = MkNominalDiffTime (recip a) fromRational r = MkNominalDiffTime (fromRational r) -- necessary because H98 doesn't have "cunning newtype" derivation instance RealFrac NominalDiffTime where properFraction (MkNominalDiffTime a) = (i,MkNominalDiffTime f) where (i,f) = properFraction a truncate (MkNominalDiffTime a) = truncate a round (MkNominalDiffTime a) = round a ceiling (MkNominalDiffTime a) = ceiling a floor (MkNominalDiffTime a) = floor a hugs98-plus-Sep2006/packages/time/Data/Time/Clock/CTimeval.hs0000644006511100651110000000163010504340547022343 0ustar rossross{-# OPTIONS -ffi -Wall -Werror -cpp #-} -- #hide module Data.Time.Clock.CTimeval where #ifndef mingw32_HOST_OS -- All Unix-specific, this import Foreign import Foreign.C data CTimeval = MkCTimeval CLong CLong instance Storable CTimeval where sizeOf _ = (sizeOf (undefined :: CLong)) * 2 alignment _ = alignment (undefined :: CLong) peek p = do s <- peekElemOff (castPtr p) 0 mus <- peekElemOff (castPtr p) 1 return (MkCTimeval s mus) poke p (MkCTimeval s mus) = do pokeElemOff (castPtr p) 0 s pokeElemOff (castPtr p) 1 mus foreign import ccall unsafe "time.h gettimeofday" gettimeofday :: Ptr CTimeval -> Ptr () -> IO CInt -- | Get the current POSIX time from the system clock. getCTimeval :: IO CTimeval getCTimeval = with (MkCTimeval 0 0) (\ptval -> do result <- gettimeofday ptval nullPtr if (result == 0) then peek ptval else fail ("error in gettimeofday: " ++ (show result)) ) #endif hugs98-plus-Sep2006/packages/time/Data/Time/Clock/UTCDiff.hs0000644006511100651110000000067110504340546022066 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.Clock.UTCDiff where import Data.Time.Clock.POSIX import Data.Time.Clock.UTC -- | addUTCTime a b = a + b addUTCTime :: NominalDiffTime -> UTCTime -> UTCTime addUTCTime x t = posixSecondsToUTCTime (x + (utcTimeToPOSIXSeconds t)) -- | diffUTCTime a b = a - b diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime diffUTCTime a b = (utcTimeToPOSIXSeconds a) - (utcTimeToPOSIXSeconds b) hugs98-plus-Sep2006/packages/time/Data/Time/LocalTime/0000755006511100651110000000000010504340547021121 5ustar rossrosshugs98-plus-Sep2006/packages/time/Data/Time/LocalTime/LocalTime.hs0000644006511100651110000000537510504340546023337 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.LocalTime.LocalTime ( -- * Local Time LocalTime(..), -- converting UTC and UT1 times to LocalTime utcToLocalTime,localTimeToUTC,ut1ToLocalTime,localTimeToUT1, ZonedTime(..),utcToZonedTime,zonedTimeToUTC,getZonedTime,utcToLocalZonedTime ) where import Data.Time.LocalTime.TimeOfDay import Data.Time.LocalTime.TimeZone import Data.Time.Calendar import Data.Time.Clock -- | A simple day and time aggregate, where the day is of the specified parameter, -- and the time is a TimeOfDay. -- Conversion of this (as local civil time) to UTC depends on the time zone. -- Conversion of this (as local mean time) to UT1 depends on the longitude. data LocalTime = LocalTime { localDay :: Day, localTimeOfDay :: TimeOfDay } deriving (Eq,Ord) instance Show LocalTime where show (LocalTime d t) = (showGregorian d) ++ " " ++ (show t) -- | show a UTC time in a given time zone as a LocalTime utcToLocalTime :: TimeZone -> UTCTime -> LocalTime utcToLocalTime tz (UTCTime day dt) = LocalTime (addDays i day) tod where (i,tod) = utcToLocalTimeOfDay tz (timeToTimeOfDay dt) -- | find out what UTC time a given LocalTime in a given time zone is localTimeToUTC :: TimeZone -> LocalTime -> UTCTime localTimeToUTC tz (LocalTime day tod) = UTCTime (addDays i day) (timeOfDayToTime todUTC) where (i,todUTC) = localToUTCTimeOfDay tz tod -- | 1st arg is observation meridian in degrees, positive is East ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime ut1ToLocalTime long (ModJulianDate date) = LocalTime (ModifiedJulianDay localMJD) (dayFractionToTimeOfDay localToDOffset) where localTime = date + long / 360 :: Rational localMJD = floor localTime localToDOffset = localTime - (fromIntegral localMJD) -- | 1st arg is observation meridian in degrees, positive is East localTimeToUT1 :: Rational -> LocalTime -> UniversalTime localTimeToUT1 long (LocalTime (ModifiedJulianDay localMJD) tod) = ModJulianDate ((fromIntegral localMJD) + (timeOfDayToDayFraction tod) - (long / 360)) -- | A local time together with a TimeZone. data ZonedTime = ZonedTime { zonedTimeToLocalTime :: LocalTime, zonedTimeZone :: TimeZone } utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime utcToZonedTime zone time = ZonedTime (utcToLocalTime zone time) zone zonedTimeToUTC :: ZonedTime -> UTCTime zonedTimeToUTC (ZonedTime t zone) = localTimeToUTC zone t instance Show ZonedTime where show (ZonedTime t zone) = show t ++ " " ++ show zone instance Show UTCTime where show t = show (utcToZonedTime utc t) getZonedTime :: IO ZonedTime getZonedTime = do t <- getCurrentTime zone <- getTimeZone t return (utcToZonedTime zone t) -- | utcToLocalZonedTime :: UTCTime -> IO ZonedTime utcToLocalZonedTime t = do zone <- getTimeZone t return (utcToZonedTime zone t) hugs98-plus-Sep2006/packages/time/Data/Time/LocalTime/Format.hs0000644006511100651110000001700510504340546022707 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.LocalTime.Format ( -- * UNIX-style formatting module Data.Time.LocalTime.Format ) where import Data.Time.LocalTime.LocalTime import Data.Time.LocalTime.TimeOfDay import Data.Time.LocalTime.TimeZone import Data.Time.Calendar.WeekDate import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar import Data.Time.Calendar.Private import Data.Time.Clock import Data.Time.Clock.POSIX import System.Locale import Data.Maybe import Data.Char -- class FormatTime t where formatCharacter :: Char -> Maybe (TimeLocale -> t -> String) -- | Substitute various time-related information for each %-code in the string, as per 'formatCharacter'. -- -- For all types (note these three are done here, not by 'formatCharacter'): -- -- [@%%@] @%@ -- -- [@%t@] tab -- -- [@%n@] newline -- -- For TimeZone (and ZonedTime and UTCTime): -- -- [@%z@] timezone offset -- -- [@%Z@] timezone name -- -- For LocalTime (and ZonedTime and UTCTime): -- -- [@%c@] as 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@) -- -- For TimeOfDay (and LocalTime and ZonedTime and UTCTime): -- -- [@%R@] same as @%H:%M@ -- -- [@%T@] same as @%H:%M:%S@ -- -- [@%X@] as 'timeFmt' @locale@ (e.g. @%H:%M:%S@) -- -- [@%r@] as 'time12Fmt' @locale@ (e.g. @%I:%M:%S %p@) -- -- [@%P@] day half from ('amPm' @locale@), converted to lowercase, @am@, @pm@ -- -- [@%p@] day half from ('amPm' @locale@), @AM@, @PM@ -- -- [@%H@] hour, 24-hour, leading 0 as needed, @00@ - @23@ -- -- [@%I@] hour, 12-hour, leading 0 as needed, @01@ - @12@ -- -- [@%k@] hour, 24-hour, leading space as needed, @ 0@ - @23@ -- -- [@%l@] hour, 12-hour, leading space as needed, @ 1@ - @12@ -- -- [@%M@] minute, @00@ - @59@ -- -- [@%S@] second with decimal part if not an integer, @00@ - @60.999999999999@ -- -- For UTCTime and ZonedTime: -- -- [@%s@] number of seconds since the Unix epoch -- -- For Day (and LocalTime and ZonedTime and UTCTime): -- -- [@%D@] same as @%m\/%d\/%y@ -- -- [@%F@] same as @%Y-%m-%d@ -- -- [@%x@] as 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@) -- -- [@%Y@] year -- -- [@%y@] last two digits of year, @00@ - @99@ -- -- [@%C@] century (being the first two digits of the year), @00@ - @99@ -- -- [@%B@] month name, long form ('fst' from 'months' @locale@), @January@ - @December@ -- -- [@%b@, @%h@] month name, short form ('snd' from 'months' @locale@), @Jan@ - @Dec@ -- -- [@%m@] month of year, leading 0 as needed, @01@ - @12@ -- -- [@%d@] day of month, leading 0 as needed, @01@ - @31@ -- -- [@%e@] day of month, leading space as needed, @ 1@ - @31@ -- -- [@%j@] day of year for Ordinal Date format, @001@ - @366@ -- -- [@%G@] year for Week Date format -- -- [@%g@] last two digits of year for Week Date format, @00@ - @99@ -- -- [@%V@] week for Week Date format, @01@ - @53@ -- -- [@%u@] day for Week Date format, @1@ - @7@ -- -- [@%a@] day of week, short form ('snd' from 'wDays' @locale@), @Sun@ - @Sat@ -- -- [@%A@] day of week, long form ('fst' from 'wDays' @locale@), @Sunday@ - @Saturday@ -- -- [@%U@] week number of year, where weeks start on Sunday (as 'sundayStartWeek'), @01@ - @53@ -- -- [@%w@] day of week number, @0@ (= Sunday) - @6@ (= Saturday) -- -- [@%W@] week number of year, where weeks start on Monday (as 'mondayStartWeek'), @01@ - @53@ formatTime :: (FormatTime t) => TimeLocale -> String -> t -> String formatTime _ [] _ = "" formatTime locale ('%':c:cs) t = (formatChar c) ++ (formatTime locale cs t) where formatChar '%' = "%" formatChar 't' = "\t" formatChar 'n' = "\n" formatChar _ = case (formatCharacter c) of Just f -> f locale t _ -> "" formatTime locale (c:cs) t = c:(formatTime locale cs t) instance FormatTime LocalTime where formatCharacter 'c' = Just (\locale -> formatTime locale (dateTimeFmt locale)) formatCharacter c = case (formatCharacter c) of Just f -> Just (\locale dt -> f locale (localDay dt)) Nothing -> case (formatCharacter c) of Just f -> Just (\locale dt -> f locale (localTimeOfDay dt)) Nothing -> Nothing instance FormatTime TimeOfDay where -- Aggregate formatCharacter 'R' = Just (\locale -> formatTime locale "%H:%M") formatCharacter 'T' = Just (\locale -> formatTime locale "%H:%M:%S") formatCharacter 'X' = Just (\locale -> formatTime locale (timeFmt locale)) formatCharacter 'r' = Just (\locale -> formatTime locale (time12Fmt locale)) -- AM/PM formatCharacter 'P' = Just (\locale day -> map toLower ((if (todHour day) < 12 then fst else snd) (amPm locale))) formatCharacter 'p' = Just (\locale day -> (if (todHour day) < 12 then fst else snd) (amPm locale)) -- Hour formatCharacter 'H' = Just (\_ -> show2 . todHour) formatCharacter 'I' = Just (\_ -> show2 . (\h -> (mod (h - 1) 12) + 1) . todHour) formatCharacter 'k' = Just (\_ -> show2Space . todHour) formatCharacter 'l' = Just (\_ -> show2Space . (\h -> (mod (h - 1) 12) + 1) . todHour) -- Minute formatCharacter 'M' = Just (\_ -> show2 . todMin) -- Second formatCharacter 'S' = Just (\_ -> show2Fixed . todSec) -- Default formatCharacter _ = Nothing instance FormatTime ZonedTime where formatCharacter 's' = Just (\_ zt -> show (truncate (utcTimeToPOSIXSeconds (zonedTimeToUTC zt)) :: Integer)) formatCharacter c = case (formatCharacter c) of Just f -> Just (\locale dt -> f locale (zonedTimeToLocalTime dt)) Nothing -> case (formatCharacter c) of Just f -> Just (\locale dt -> f locale (zonedTimeZone dt)) Nothing -> Nothing instance FormatTime TimeZone where formatCharacter 'z' = Just (\_ -> timeZoneOffsetString) formatCharacter 'Z' = Just (\_ -> timeZoneName) formatCharacter _ = Nothing instance FormatTime Day where -- Aggregate formatCharacter 'D' = Just (\locale -> formatTime locale "%m/%d/%y") formatCharacter 'F' = Just (\locale -> formatTime locale "%Y-%m-%d") formatCharacter 'x' = Just (\locale -> formatTime locale (dateFmt locale)) -- Year Count formatCharacter 'Y' = Just (\_ -> show . fst . toOrdinalDate) formatCharacter 'y' = Just (\_ -> show2 . mod100 . fst . toOrdinalDate) formatCharacter 'C' = Just (\_ -> show2 . div100 . fst . toOrdinalDate) -- Month of Year formatCharacter 'B' = Just (\locale -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian) formatCharacter 'b' = Just (\locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian) formatCharacter 'h' = Just (\locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian) formatCharacter 'm' = Just (\_ -> show2 . (\(_,m,_) -> m) . toGregorian) -- Day of Month formatCharacter 'd' = Just (\_ -> show2 . (\(_,_,d) -> d) . toGregorian) formatCharacter 'e' = Just (\_ -> show2Space . (\(_,_,d) -> d) . toGregorian) -- Day of Year formatCharacter 'j' = Just (\_ -> show3 . snd . toOrdinalDate) -- ISO 8601 Week Date formatCharacter 'G' = Just (\_ -> show . (\(y,_,_) -> y) . toWeekDate) formatCharacter 'g' = Just (\_ -> show2 . mod100 . (\(y,_,_) -> y) . toWeekDate) formatCharacter 'V' = Just (\_ -> show2 . (\(_,w,_) -> w) . toWeekDate) formatCharacter 'u' = Just (\_ -> show . (\(_,_,d) -> d) . toWeekDate) -- Day of week formatCharacter 'a' = Just (\locale -> snd . ((wDays locale) !!) . snd . sundayStartWeek) formatCharacter 'A' = Just (\locale -> fst . ((wDays locale) !!) . snd . sundayStartWeek) formatCharacter 'U' = Just (\_ -> show2 . fst . sundayStartWeek) formatCharacter 'w' = Just (\_ -> show . snd . sundayStartWeek) formatCharacter 'W' = Just (\_ -> show2 . fst . mondayStartWeek) -- Default formatCharacter _ = Nothing instance FormatTime UTCTime where formatCharacter c = fmap (\f locale t -> f locale (utcToZonedTime utc t)) (formatCharacter c) hugs98-plus-Sep2006/packages/time/Data/Time/LocalTime/TimeOfDay.hs0000644006511100651110000000516210504340546023301 0ustar rossross{-# OPTIONS -Wall -Werror #-} -- #hide module Data.Time.LocalTime.TimeOfDay ( -- * Time of day TimeOfDay(..),midnight,midday, utcToLocalTimeOfDay,localToUTCTimeOfDay, timeToTimeOfDay,timeOfDayToTime, dayFractionToTimeOfDay,timeOfDayToDayFraction ) where import Data.Time.LocalTime.TimeZone import Data.Time.Calendar.Private import Data.Time.Clock import Data.Fixed -- | Time of day as represented in hour, minute and second (with picoseconds), typically used to express local time of day. data TimeOfDay = TimeOfDay { -- | range 0 - 23 todHour :: Int, -- | range 0 - 59 todMin :: Int, -- | Note that 0 <= todSec < 61, accomodating leap seconds. -- Any local minute may have a leap second, since leap seconds happen in all zones simultaneously todSec :: Pico } deriving (Eq,Ord) -- | Hour zero midnight :: TimeOfDay midnight = TimeOfDay 0 0 0 -- | Hour twelve midday :: TimeOfDay midday = TimeOfDay 12 0 0 instance Show TimeOfDay where show (TimeOfDay h m s) = (show2 h) ++ ":" ++ (show2 m) ++ ":" ++ (show2Fixed s) -- | Convert a ToD in UTC to a ToD in some timezone, together with a day adjustment. utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay) utcToLocalTimeOfDay zone (TimeOfDay h m s) = (fromIntegral (div h' 24),TimeOfDay (mod h' 24) (mod m' 60) s) where m' = m + timeZoneMinutes zone h' = h + (div m' 60) -- | Convert a ToD in some timezone to a ToD in UTC, together with a day adjustment. localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay) localToUTCTimeOfDay zone = utcToLocalTimeOfDay (minutesToTimeZone (negate (timeZoneMinutes zone))) posixDayLength :: DiffTime posixDayLength = fromInteger 86400 -- | Get a TimeOfDay given a time since midnight. -- Time more than 24h will be converted to leap-seconds. timeToTimeOfDay :: DiffTime -> TimeOfDay timeToTimeOfDay dt | dt >= posixDayLength = TimeOfDay 23 59 (60 + (realToFrac (dt - posixDayLength))) timeToTimeOfDay dt = TimeOfDay (fromInteger h) (fromInteger m) s where s' = realToFrac dt s = mod' s' 60 m' = div' s' 60 m = mod' m' 60 h = div' m' 60 -- | Find out how much time since midnight a given TimeOfDay is. timeOfDayToTime :: TimeOfDay -> DiffTime timeOfDayToTime (TimeOfDay h m s) = ((fromIntegral h) * 60 + (fromIntegral m)) * 60 + (realToFrac s) -- | Get a TimeOfDay given the fraction of a day since midnight. dayFractionToTimeOfDay :: Rational -> TimeOfDay dayFractionToTimeOfDay df = timeToTimeOfDay (realToFrac (df * 86400)) -- | Get the fraction of a day since midnight given a TimeOfDay. timeOfDayToDayFraction :: TimeOfDay -> Rational timeOfDayToDayFraction tod = realToFrac (timeOfDayToTime tod / posixDayLength) hugs98-plus-Sep2006/packages/time/Data/Time/LocalTime/TimeZone.hs0000644006511100651110000000502210504340547023206 0ustar rossross{-# OPTIONS -ffi -Wall -Werror #-} -- #hide module Data.Time.LocalTime.TimeZone ( -- * Time zones TimeZone(..),timeZoneOffsetString,minutesToTimeZone,hoursToTimeZone,utc, -- getting the locale time zone getTimeZone,getCurrentTimeZone ) where --import System.Time.Calendar.Format import Data.Time.Calendar.Private import Data.Time.Clock import Data.Time.Clock.POSIX import Foreign import Foreign.C -- | A TimeZone is a whole number of minutes offset from UTC, together with a name and a \"just for summer\" flag. data TimeZone = TimeZone { -- | The number of minutes offset from UTC. Positive means local time will be later in the day than UTC. timeZoneMinutes :: Int, -- | Is this time zone just persisting for the summer? timeZoneSummerOnly :: Bool, -- | The name of the zone, typically a three- or four-letter acronym. timeZoneName :: String } deriving (Eq,Ord) -- | Create a nameless non-summer timezone for this number of minutes minutesToTimeZone :: Int -> TimeZone minutesToTimeZone m = TimeZone m False "" -- | Create a nameless non-summer timezone for this number of hours hoursToTimeZone :: Int -> TimeZone hoursToTimeZone i = minutesToTimeZone (60 * i) showT :: Int -> String showT t = (show2 (div t 60)) ++ (show2 (mod t 60)) -- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like %z in formatTime) timeZoneOffsetString :: TimeZone -> String timeZoneOffsetString (TimeZone t _ _) | t < 0 = '-':(showT (negate t)) timeZoneOffsetString (TimeZone t _ _) = '+':(showT t) instance Show TimeZone where show zone@(TimeZone _ _ "") = timeZoneOffsetString zone show (TimeZone _ _ name) = name -- | The UTC time zone utc :: TimeZone utc = TimeZone 0 False "UTC" {-# CFILES cbits/HsTime.c #-} foreign import ccall unsafe "HsTime.h get_current_timezone_seconds" get_current_timezone_seconds :: CTime -> Ptr CInt -> Ptr CString -> IO CLong posixToCTime :: POSIXTime -> CTime posixToCTime = fromInteger . floor -- | Get the local time-zone for a given time (varying as per summertime adjustments) getTimeZone :: UTCTime -> IO TimeZone getTimeZone time = with 0 (\pdst -> with nullPtr (\pcname -> do secs <- get_current_timezone_seconds (posixToCTime (utcTimeToPOSIXSeconds time)) pdst pcname case secs of 0x80000000 -> fail "localtime_r failed" _ -> do dst <- peek pdst cname <- peek pcname name <- peekCString cname return (TimeZone (div (fromIntegral secs) 60) (dst == 1) name) )) -- | Get the current time-zone getCurrentTimeZone :: IO TimeZone getCurrentTimeZone = getCurrentTime >>= getTimeZone hugs98-plus-Sep2006/packages/time/Data/Time/LocalTime.hs0000644006511100651110000000055410504340546021460 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Data.Time.LocalTime ( module Data.Time.LocalTime.TimeZone, module Data.Time.LocalTime.TimeOfDay, module Data.Time.LocalTime.LocalTime, module Data.Time.LocalTime.Format ) where import Data.Time.LocalTime.TimeZone import Data.Time.LocalTime.TimeOfDay import Data.Time.LocalTime.LocalTime import Data.Time.LocalTime.Format hugs98-plus-Sep2006/packages/time/Data/Time.hs0000644006511100651110000000033010504340546017577 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Data.Time ( module Data.Time.Calendar, module Data.Time.Clock, module Data.Time.LocalTime ) where import Data.Time.Calendar import Data.Time.Clock import Data.Time.LocalTime hugs98-plus-Sep2006/packages/time/time/0000755006511100651110000000000010504340547016437 5ustar rossrosshugs98-plus-Sep2006/packages/time/time/Makefile0000644006511100651110000001447610504340546020112 0ustar rossrossdefault: build test doc cabal-configure: runghc Setup.hs configure cabal-build: cabal-configure runghc Setup.hs build cabal-install: cabal-build sudo runghc Setup.hs install PACKAGENAME = time LIBFILE = libHS$(PACKAGENAME).a build: $(patsubst %.hs,%.hi,$(SRCS)) $(LIBFILE) test: build cd test && make cleantest: cd test && make clean SRCS = \ Data/Time/Calendar/Private.hs \ Data/Time/Calendar/Days.hs \ Data/Time/Calendar/OrdinalDate.hs \ Data/Time/Calendar/MonthDay.hs \ Data/Time/Calendar/Gregorian.hs \ Data/Time/Calendar/WeekDate.hs \ Data/Time/Calendar/JulianYearDay.hs \ Data/Time/Calendar/Julian.hs \ Data/Time/Calendar/Easter.hs \ Data/Time/Calendar.hs \ Data/Time/Clock/Scale.hs \ Data/Time/Clock/UTC.hs \ Data/Time/Clock/CTimeval.hs \ Data/Time/Clock/POSIX.hs \ Data/Time/Clock/UTCDiff.hs \ Data/Time/Clock/TAI.hs \ Data/Time/Clock.hs \ Data/Time/LocalTime/TimeZone.hs \ Data/Time/LocalTime/TimeOfDay.hs \ Data/Time/LocalTime/LocalTime.hs \ Data/Time/LocalTime/Format.hs \ Data/Time/LocalTime.hs \ Data/Time.hs timestuff.o: timestuff.c timestuff.h gcc -o $@ -c $< $(LIBFILE): $(patsubst %.hs,%.o,$(SRCS)) timestuff.o rm -f $@ ar cru $@ $^ ranlib $@ cleanbuild: rm -rf *.a *.o *.hi $(patsubst %.hs,%.o,$(SRCS)) $(patsubst %.hs,%.hi,$(SRCS)) Makefile.bak cleandoc: rm -rf doc haddock clean: cleandoc cleantest cleanbuild doc: haddock/index.html haddock/index.html: $(SRCS) mkdir -p haddock haddock -h -o haddock $^ sources: echo $(SRCS) > $@ %.diff: %.ref %.out diff -u $^ %.out: % ./$< > $@ %.run: % ./$< %.hi: %.o @: %.o: %.hs ghc -c $< -o $@ FORCE: .SECONDARY: .PHONY: default build test doc clean depend: $(SRCS) ghc -M $^ # DO NOT DELETE: Beginning of Haskell dependencies Data/Time/Clock/CTimeval.o : Data/Time/Clock/CTimeval.hs Data/Time/Clock/Scale.o : Data/Time/Clock/Scale.hs Data/Time/Calendar/Private.o : Data/Time/Calendar/Private.hs Data/Time/Calendar/MonthDay.o : Data/Time/Calendar/MonthDay.hs Data/Time/Calendar/MonthDay.o : Data/Time/Calendar/Private.hi Data/Time/Calendar/Days.o : Data/Time/Calendar/Days.hs Data/Time/Calendar/OrdinalDate.o : Data/Time/Calendar/OrdinalDate.hs Data/Time/Calendar/OrdinalDate.o : Data/Time/Calendar/Private.hi Data/Time/Calendar/OrdinalDate.o : Data/Time/Calendar/Days.hi Data/Time/Calendar/Gregorian.o : Data/Time/Calendar/Gregorian.hs Data/Time/Calendar/Gregorian.o : Data/Time/Calendar/Private.hi Data/Time/Calendar/Gregorian.o : Data/Time/Calendar/Days.hi Data/Time/Calendar/Gregorian.o : Data/Time/Calendar/OrdinalDate.hi Data/Time/Calendar/Gregorian.o : Data/Time/Calendar/MonthDay.hi Data/Time/Calendar/WeekDate.o : Data/Time/Calendar/WeekDate.hs Data/Time/Calendar/WeekDate.o : Data/Time/Calendar/Private.hi Data/Time/Calendar/WeekDate.o : Data/Time/Calendar/Days.hi Data/Time/Calendar/WeekDate.o : Data/Time/Calendar/OrdinalDate.hi Data/Time/Calendar/JulianYearDay.o : Data/Time/Calendar/JulianYearDay.hs Data/Time/Calendar/JulianYearDay.o : Data/Time/Calendar/Private.hi Data/Time/Calendar/JulianYearDay.o : Data/Time/Calendar/Days.hi Data/Time/Calendar/Julian.o : Data/Time/Calendar/Julian.hs Data/Time/Calendar/Julian.o : Data/Time/Calendar/Private.hi Data/Time/Calendar/Julian.o : Data/Time/Calendar/Days.hi Data/Time/Calendar/Julian.o : Data/Time/Calendar/JulianYearDay.hi Data/Time/Calendar/Julian.o : Data/Time/Calendar/MonthDay.hi Data/Time/Calendar.o : Data/Time/Calendar.hs Data/Time/Calendar.o : Data/Time/Calendar/Gregorian.hi Data/Time/Calendar.o : Data/Time/Calendar/Days.hi Data/Time/Calendar/Easter.o : Data/Time/Calendar/Easter.hs Data/Time/Calendar/Easter.o : Data/Time/Calendar/Julian.hi Data/Time/Calendar/Easter.o : Data/Time/Calendar.hi Data/Time/Clock/UTC.o : Data/Time/Clock/UTC.hs Data/Time/Clock/UTC.o : Data/Time/Clock/Scale.hi Data/Time/Clock/UTC.o : Data/Time/Calendar/Days.hi Data/Time/Clock/POSIX.o : Data/Time/Clock/POSIX.hs Data/Time/Clock/POSIX.o : Data/Time/Calendar/Days.hi Data/Time/Clock/POSIX.o : Data/Time/Clock/UTC.hi Data/Time/Clock/POSIX.o : Data/Time/Clock/CTimeval.hi Data/Time/Clock/UTCDiff.o : Data/Time/Clock/UTCDiff.hs Data/Time/Clock/UTCDiff.o : Data/Time/Clock/UTC.hi Data/Time/Clock/UTCDiff.o : Data/Time/Clock/POSIX.hi Data/Time/Clock.o : Data/Time/Clock.hs Data/Time/Clock.o : Data/Time/Clock/POSIX.hi Data/Time/Clock.o : Data/Time/Clock/UTC.hi Data/Time/Clock.o : Data/Time/Clock/UTCDiff.hi Data/Time/Clock.o : Data/Time/Clock/Scale.hi Data/Time/LocalTime/TimeZone.o : Data/Time/LocalTime/TimeZone.hs Data/Time/LocalTime/TimeZone.o : Data/Time/Clock/POSIX.hi Data/Time/LocalTime/TimeZone.o : Data/Time/Clock.hi Data/Time/LocalTime/TimeZone.o : Data/Time/Calendar/Private.hi Data/Time/LocalTime/TimeOfDay.o : Data/Time/LocalTime/TimeOfDay.hs Data/Time/LocalTime/TimeOfDay.o : Data/Time/Clock.hi Data/Time/LocalTime/TimeOfDay.o : Data/Time/Calendar/Private.hi Data/Time/LocalTime/TimeOfDay.o : Data/Time/LocalTime/TimeZone.hi Data/Time/LocalTime/LocalTime.o : Data/Time/LocalTime/LocalTime.hs Data/Time/LocalTime/LocalTime.o : Data/Time/Clock.hi Data/Time/LocalTime/LocalTime.o : Data/Time/Calendar.hi Data/Time/LocalTime/LocalTime.o : Data/Time/LocalTime/TimeZone.hi Data/Time/LocalTime/LocalTime.o : Data/Time/LocalTime/TimeOfDay.hi Data/Time/LocalTime/Format.o : Data/Time/LocalTime/Format.hs Data/Time/LocalTime/Format.o : Data/Time/Clock/POSIX.hi Data/Time/LocalTime/Format.o : Data/Time/Clock.hi Data/Time/LocalTime/Format.o : Data/Time/Calendar/Private.hi Data/Time/LocalTime/Format.o : Data/Time/Calendar.hi Data/Time/LocalTime/Format.o : Data/Time/Calendar/OrdinalDate.hi Data/Time/LocalTime/Format.o : Data/Time/Calendar/WeekDate.hi Data/Time/LocalTime/Format.o : Data/Time/LocalTime/TimeZone.hi Data/Time/LocalTime/Format.o : Data/Time/LocalTime/TimeOfDay.hi Data/Time/LocalTime/Format.o : Data/Time/LocalTime/LocalTime.hi Data/Time/LocalTime.o : Data/Time/LocalTime.hs Data/Time/LocalTime.o : Data/Time/LocalTime/Format.hi Data/Time/LocalTime.o : Data/Time/LocalTime/LocalTime.hi Data/Time/LocalTime.o : Data/Time/LocalTime/TimeOfDay.hi Data/Time/LocalTime.o : Data/Time/LocalTime/TimeZone.hi Data/Time.o : Data/Time.hs Data/Time.o : Data/Time/LocalTime.hi Data/Time.o : Data/Time/Clock.hi Data/Time.o : Data/Time/Calendar.hi Data/Time/Clock/TAI.o : Data/Time/Clock/TAI.hs Data/Time/Clock/TAI.o : Data/Time/Clock.hi Data/Time/Clock/TAI.o : Data/Time/Calendar/Days.hi Data/Time/Clock/TAI.o : Data/Time/LocalTime.hi # DO NOT DELETE: End of Haskell dependencies hugs98-plus-Sep2006/packages/time/time/test/0000755006511100651110000000000010504340546017415 5ustar rossrosshugs98-plus-Sep2006/packages/time/time/test/CurrentTime.hs0000644006511100651110000000050210504340546022207 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time main :: IO () main = do now <- getCurrentTime putStrLn (show (utctDay now) ++ "," ++ show (utctDayTime now)) putStrLn (show (utcToZonedTime utc now :: ZonedTime)) myzone <- getCurrentTimeZone putStrLn (show (utcToZonedTime myzone now :: ZonedTime)) hugs98-plus-Sep2006/packages/time/time/test/ShowDST.hs0000644006511100651110000000256710504340546021256 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time monthBeginning :: TimeZone -> Integer -> Int -> UTCTime monthBeginning zone year month = localTimeToUTC zone (LocalTime (fromGregorian year month 1) midnight) findTransition :: UTCTime -> UTCTime -> IO [(UTCTime,TimeZone,TimeZone)] findTransition a b = do za <- getTimeZone a zb <- getTimeZone b if za == zb then return [] else do let c = addUTCTime ((diffUTCTime b a) / 2) a if a == c then return [(b,za,zb)] else do tp <- findTransition a c tq <- findTransition c b return (tp ++ tq) showZoneTime :: TimeZone -> UTCTime -> String showZoneTime zone time = show (utcToZonedTime zone time) showTransition :: (UTCTime,TimeZone,TimeZone) -> String showTransition (time,zone1,zone2) = (showZoneTime zone1 time) ++ " => " ++ (showZoneTime zone2 time) main :: IO () main = do now <- getCurrentTime zone <- getTimeZone now let (year,_,_) = toGregorian (localDay (utcToLocalTime zone now)) putStrLn ("DST adjustments for " ++ show year ++ ":") let t0 = monthBeginning zone year 1 let t1 = monthBeginning zone year 4 let t2 = monthBeginning zone year 7 let t3 = monthBeginning zone year 10 let t4 = monthBeginning zone (year + 1) 1 tr1 <- findTransition t0 t1 tr2 <- findTransition t1 t2 tr3 <- findTransition t2 t3 tr4 <- findTransition t3 t4 mapM_ (putStrLn . showTransition) (tr1 ++ tr2 ++ tr3 ++ tr4) hugs98-plus-Sep2006/packages/time/time/test/TestFormat.hs0000644006511100651110000000566510504340546022055 0ustar rossross{-# OPTIONS -ffi -Wall -Werror #-} module Main where import Data.Time import Data.Time.Clock.POSIX import System.Locale import Foreign import Foreign.C {- size_t format_time ( char *s, size_t maxsize, const char *format, int isdst,int gmtoff,time_t t); -} foreign import ccall unsafe "TestFormatStuff.h format_time" format_time :: CString -> CSize -> CString -> CInt -> CInt -> CString -> CTime -> IO CSize withBuffer :: Int -> (CString -> IO CSize) -> IO String withBuffer n f = withArray (replicate n 0) (\buffer -> do len <- f buffer peekCStringLen (buffer,fromIntegral len) ) unixFormatTime :: String -> TimeZone -> UTCTime -> IO String unixFormatTime fmt zone time = withCString fmt (\pfmt -> withCString (timeZoneName zone) (\pzonename -> withBuffer 100 (\buffer -> format_time buffer 100 pfmt (if timeZoneSummerOnly zone then 1 else 0) (fromIntegral (timeZoneMinutes zone * 60)) pzonename (fromInteger (truncate (utcTimeToPOSIXSeconds time))) ) )) locale :: TimeLocale locale = defaultTimeLocale {dateTimeFmt = "%a %b %e %H:%M:%S %Y"} zones :: [TimeZone] zones = [utc,TimeZone 87 True "Fenwickian Daylight Time"] baseTime0 :: UTCTime baseTime0 = localTimeToUTC utc (LocalTime (fromGregorian 1970 01 01) midnight) baseTime1 :: UTCTime baseTime1 = localTimeToUTC utc (LocalTime (fromGregorian 2000 01 01) midnight) getDay :: Integer -> UTCTime getDay day = addUTCTime ((fromInteger day) * posixDayLength) baseTime1 getYearP1 :: Integer -> UTCTime getYearP1 year = localTimeToUTC utc (LocalTime (fromGregorian year 01 01) midnight) getYearP2 :: Integer -> UTCTime getYearP2 year = localTimeToUTC utc (LocalTime (fromGregorian year 02 04) midnight) getYearP3 :: Integer -> UTCTime getYearP3 year = localTimeToUTC utc (LocalTime (fromGregorian year 03 04) midnight) getYearP4 :: Integer -> UTCTime getYearP4 year = localTimeToUTC utc (LocalTime (fromGregorian year 12 31) midnight) times :: [UTCTime] times = [baseTime0] ++ (fmap getDay [0..23]) ++ (fmap getDay [0..100]) ++ (fmap getYearP1 [1980..2000]) ++ (fmap getYearP2 [1980..2000]) ++ (fmap getYearP3 [1980..2000]) ++ (fmap getYearP4 [1980..2000]) compareFormat :: String -> TimeZone -> UTCTime -> IO () compareFormat fmt zone time = let ctime = utcToZonedTime zone time haskellText = formatTime locale fmt ctime in do unixText <- unixFormatTime fmt zone time if haskellText == unixText then return () else putStrLn ("Mismatch with " ++ fmt ++ " for " ++ (show ctime) ++ ": UNIX=\"" ++ unixText ++ "\", TimeLib=\"" ++ haskellText ++ "\".") -- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html -- plus FgGklz -- P not always supported -- s time-zone dependent chars :: [Char] chars = "aAbBcCdDeFgGhHIjklmMnprRStTuUVwWxXyYzZ%" formats :: [String] formats = ["%G-W%V-%u","%U-%w","%W-%u"] ++ (fmap (\char -> '%':char:[]) chars) main :: IO () main = mapM_ (\fmt -> mapM_ (\time -> mapM_ (\zone -> compareFormat fmt zone time) zones) times) formats hugs98-plus-Sep2006/packages/time/time/test/TestFormatStuff.c0000644006511100651110000000050310504340545022656 0ustar rossross#include "TestFormatStuff.h" size_t format_time ( char* buffer, size_t maxsize, const char* format, int isdst,int gmtoff,char* zonename,time_t t) { t += gmtoff; struct tm tmd; gmtime_r(&t,&tmd); tmd.tm_isdst = isdst; tmd.tm_gmtoff = gmtoff; tmd.tm_zone = zonename; return strftime(buffer,maxsize,format,&tmd); } hugs98-plus-Sep2006/packages/time/time/test/TestFormatStuff.h0000644006511100651110000000020710504340545022664 0ustar rossross#include size_t format_time ( char *s, size_t maxsize, const char *format, int isdst,int gmtoff,char* zonename,time_t t); hugs98-plus-Sep2006/packages/time/time/test/TestTime.hs0000644006511100651110000000425210504340546021512 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate import Data.Time showCal :: Integer -> IO () showCal mjd = do let date = ModifiedJulianDay mjd let (y,m,d) = toGregorian date let date' = fromGregorian y m d putStr ((show mjd) ++ "=" ++ (showGregorian date) ++ "=" ++ (showOrdinalDate date) ++ "=" ++ (showWeekDate date)) putStrLn (if date == date' then "" else "=" ++ (show (toModifiedJulianDay date')) ++ "!") testCal :: IO () testCal = do -- days around 1 BCE/1 CE mapM_ showCal [-678950 .. -678930] -- days around 1000 CE mapM_ showCal [-313710 .. -313690] -- days around MJD zero mapM_ showCal [-30..30] showCal 40000 showCal 50000 -- 1900 not a leap year showCal 15078 showCal 15079 -- 1980 is a leap year showCal 44297 showCal 44298 showCal 44299 -- 1990 not a leap year showCal 47950 showCal 47951 -- 2000 is a leap year showCal 51602 showCal 51603 showCal 51604 -- years 2000 and 2001, plus some slop mapM_ showCal [51540..52280] showUTCTime :: UTCTime -> String showUTCTime (UTCTime d t) = show (toModifiedJulianDay d) ++ "," ++ show t myzone :: TimeZone myzone = hoursToTimeZone (- 8) leapSec1998Cal :: LocalTime leapSec1998Cal = LocalTime (fromGregorian 1998 12 31) (TimeOfDay 23 59 60.5) leapSec1998 :: UTCTime leapSec1998 = localTimeToUTC utc leapSec1998Cal testUTC :: IO () testUTC = do putStrLn "" showCal 51178 putStrLn (show leapSec1998Cal) putStrLn (showUTCTime leapSec1998) let lsMineCal = utcToLocalTime myzone leapSec1998 putStrLn (show lsMineCal) let lsMine = localTimeToUTC myzone lsMineCal putStrLn (showUTCTime lsMine) neglong :: Rational neglong = -120 poslong :: Rational poslong = 120 testUT1 :: IO () testUT1 = do putStrLn "" putStrLn (show (ut1ToLocalTime 0 (ModJulianDate 51604.0))) putStrLn (show (ut1ToLocalTime 0 (ModJulianDate 51604.5))) putStrLn (show (ut1ToLocalTime neglong (ModJulianDate 51604.0))) putStrLn (show (ut1ToLocalTime neglong (ModJulianDate 51604.5))) putStrLn (show (ut1ToLocalTime poslong (ModJulianDate 51604.0))) putStrLn (show (ut1ToLocalTime poslong (ModJulianDate 51604.5))) main :: IO () main = do testCal testUTC testUT1 hugs98-plus-Sep2006/packages/time/time/test/TestTime.ref0000644006511100651110000007614610504340546021667 0ustar rossross-678950=-0001-12-23=-0001-357=-0001-W51-4 -678949=-0001-12-24=-0001-358=-0001-W51-5 -678948=-0001-12-25=-0001-359=-0001-W51-6 -678947=-0001-12-26=-0001-360=-0001-W51-7 -678946=-0001-12-27=-0001-361=-0001-W52-1 -678945=-0001-12-28=-0001-362=-0001-W52-2 -678944=-0001-12-29=-0001-363=-0001-W52-3 -678943=-0001-12-30=-0001-364=-0001-W52-4 -678942=-0001-12-31=-0001-365=-0001-W52-5 -678941=0000-01-01=0000-001=-0001-W52-6 -678940=0000-01-02=0000-002=-0001-W52-7 -678939=0000-01-03=0000-003=0000-W01-1 -678938=0000-01-04=0000-004=0000-W01-2 -678937=0000-01-05=0000-005=0000-W01-3 -678936=0000-01-06=0000-006=0000-W01-4 -678935=0000-01-07=0000-007=0000-W01-5 -678934=0000-01-08=0000-008=0000-W01-6 -678933=0000-01-09=0000-009=0000-W01-7 -678932=0000-01-10=0000-010=0000-W02-1 -678931=0000-01-11=0000-011=0000-W02-2 -678930=0000-01-12=0000-012=0000-W02-3 -313710=0999-12-20=0999-354=0999-W51-5 -313709=0999-12-21=0999-355=0999-W51-6 -313708=0999-12-22=0999-356=0999-W51-7 -313707=0999-12-23=0999-357=0999-W52-1 -313706=0999-12-24=0999-358=0999-W52-2 -313705=0999-12-25=0999-359=0999-W52-3 -313704=0999-12-26=0999-360=0999-W52-4 -313703=0999-12-27=0999-361=0999-W52-5 -313702=0999-12-28=0999-362=0999-W52-6 -313701=0999-12-29=0999-363=0999-W52-7 -313700=0999-12-30=0999-364=1000-W01-1 -313699=0999-12-31=0999-365=1000-W01-2 -313698=1000-01-01=1000-001=1000-W01-3 -313697=1000-01-02=1000-002=1000-W01-4 -313696=1000-01-03=1000-003=1000-W01-5 -313695=1000-01-04=1000-004=1000-W01-6 -313694=1000-01-05=1000-005=1000-W01-7 -313693=1000-01-06=1000-006=1000-W02-1 -313692=1000-01-07=1000-007=1000-W02-2 -313691=1000-01-08=1000-008=1000-W02-3 -313690=1000-01-09=1000-009=1000-W02-4 -30=1858-10-18=1858-291=1858-W42-1 -29=1858-10-19=1858-292=1858-W42-2 -28=1858-10-20=1858-293=1858-W42-3 -27=1858-10-21=1858-294=1858-W42-4 -26=1858-10-22=1858-295=1858-W42-5 -25=1858-10-23=1858-296=1858-W42-6 -24=1858-10-24=1858-297=1858-W42-7 -23=1858-10-25=1858-298=1858-W43-1 -22=1858-10-26=1858-299=1858-W43-2 -21=1858-10-27=1858-300=1858-W43-3 -20=1858-10-28=1858-301=1858-W43-4 -19=1858-10-29=1858-302=1858-W43-5 -18=1858-10-30=1858-303=1858-W43-6 -17=1858-10-31=1858-304=1858-W43-7 -16=1858-11-01=1858-305=1858-W44-1 -15=1858-11-02=1858-306=1858-W44-2 -14=1858-11-03=1858-307=1858-W44-3 -13=1858-11-04=1858-308=1858-W44-4 -12=1858-11-05=1858-309=1858-W44-5 -11=1858-11-06=1858-310=1858-W44-6 -10=1858-11-07=1858-311=1858-W44-7 -9=1858-11-08=1858-312=1858-W45-1 -8=1858-11-09=1858-313=1858-W45-2 -7=1858-11-10=1858-314=1858-W45-3 -6=1858-11-11=1858-315=1858-W45-4 -5=1858-11-12=1858-316=1858-W45-5 -4=1858-11-13=1858-317=1858-W45-6 -3=1858-11-14=1858-318=1858-W45-7 -2=1858-11-15=1858-319=1858-W46-1 -1=1858-11-16=1858-320=1858-W46-2 0=1858-11-17=1858-321=1858-W46-3 1=1858-11-18=1858-322=1858-W46-4 2=1858-11-19=1858-323=1858-W46-5 3=1858-11-20=1858-324=1858-W46-6 4=1858-11-21=1858-325=1858-W46-7 5=1858-11-22=1858-326=1858-W47-1 6=1858-11-23=1858-327=1858-W47-2 7=1858-11-24=1858-328=1858-W47-3 8=1858-11-25=1858-329=1858-W47-4 9=1858-11-26=1858-330=1858-W47-5 10=1858-11-27=1858-331=1858-W47-6 11=1858-11-28=1858-332=1858-W47-7 12=1858-11-29=1858-333=1858-W48-1 13=1858-11-30=1858-334=1858-W48-2 14=1858-12-01=1858-335=1858-W48-3 15=1858-12-02=1858-336=1858-W48-4 16=1858-12-03=1858-337=1858-W48-5 17=1858-12-04=1858-338=1858-W48-6 18=1858-12-05=1858-339=1858-W48-7 19=1858-12-06=1858-340=1858-W49-1 20=1858-12-07=1858-341=1858-W49-2 21=1858-12-08=1858-342=1858-W49-3 22=1858-12-09=1858-343=1858-W49-4 23=1858-12-10=1858-344=1858-W49-5 24=1858-12-11=1858-345=1858-W49-6 25=1858-12-12=1858-346=1858-W49-7 26=1858-12-13=1858-347=1858-W50-1 27=1858-12-14=1858-348=1858-W50-2 28=1858-12-15=1858-349=1858-W50-3 29=1858-12-16=1858-350=1858-W50-4 30=1858-12-17=1858-351=1858-W50-5 40000=1968-05-24=1968-145=1968-W21-5 50000=1995-10-10=1995-283=1995-W41-2 15078=1900-02-28=1900-059=1900-W09-3 15079=1900-03-01=1900-060=1900-W09-4 44297=1980-02-28=1980-059=1980-W09-4 44298=1980-02-29=1980-060=1980-W09-5 44299=1980-03-01=1980-061=1980-W09-6 47950=1990-02-28=1990-059=1990-W09-3 47951=1990-03-01=1990-060=1990-W09-4 51602=2000-02-28=2000-059=2000-W09-1 51603=2000-02-29=2000-060=2000-W09-2 51604=2000-03-01=2000-061=2000-W09-3 51540=1999-12-28=1999-362=1999-W52-2 51541=1999-12-29=1999-363=1999-W52-3 51542=1999-12-30=1999-364=1999-W52-4 51543=1999-12-31=1999-365=1999-W52-5 51544=2000-01-01=2000-001=1999-W52-6 51545=2000-01-02=2000-002=1999-W52-7 51546=2000-01-03=2000-003=2000-W01-1 51547=2000-01-04=2000-004=2000-W01-2 51548=2000-01-05=2000-005=2000-W01-3 51549=2000-01-06=2000-006=2000-W01-4 51550=2000-01-07=2000-007=2000-W01-5 51551=2000-01-08=2000-008=2000-W01-6 51552=2000-01-09=2000-009=2000-W01-7 51553=2000-01-10=2000-010=2000-W02-1 51554=2000-01-11=2000-011=2000-W02-2 51555=2000-01-12=2000-012=2000-W02-3 51556=2000-01-13=2000-013=2000-W02-4 51557=2000-01-14=2000-014=2000-W02-5 51558=2000-01-15=2000-015=2000-W02-6 51559=2000-01-16=2000-016=2000-W02-7 51560=2000-01-17=2000-017=2000-W03-1 51561=2000-01-18=2000-018=2000-W03-2 51562=2000-01-19=2000-019=2000-W03-3 51563=2000-01-20=2000-020=2000-W03-4 51564=2000-01-21=2000-021=2000-W03-5 51565=2000-01-22=2000-022=2000-W03-6 51566=2000-01-23=2000-023=2000-W03-7 51567=2000-01-24=2000-024=2000-W04-1 51568=2000-01-25=2000-025=2000-W04-2 51569=2000-01-26=2000-026=2000-W04-3 51570=2000-01-27=2000-027=2000-W04-4 51571=2000-01-28=2000-028=2000-W04-5 51572=2000-01-29=2000-029=2000-W04-6 51573=2000-01-30=2000-030=2000-W04-7 51574=2000-01-31=2000-031=2000-W05-1 51575=2000-02-01=2000-032=2000-W05-2 51576=2000-02-02=2000-033=2000-W05-3 51577=2000-02-03=2000-034=2000-W05-4 51578=2000-02-04=2000-035=2000-W05-5 51579=2000-02-05=2000-036=2000-W05-6 51580=2000-02-06=2000-037=2000-W05-7 51581=2000-02-07=2000-038=2000-W06-1 51582=2000-02-08=2000-039=2000-W06-2 51583=2000-02-09=2000-040=2000-W06-3 51584=2000-02-10=2000-041=2000-W06-4 51585=2000-02-11=2000-042=2000-W06-5 51586=2000-02-12=2000-043=2000-W06-6 51587=2000-02-13=2000-044=2000-W06-7 51588=2000-02-14=2000-045=2000-W07-1 51589=2000-02-15=2000-046=2000-W07-2 51590=2000-02-16=2000-047=2000-W07-3 51591=2000-02-17=2000-048=2000-W07-4 51592=2000-02-18=2000-049=2000-W07-5 51593=2000-02-19=2000-050=2000-W07-6 51594=2000-02-20=2000-051=2000-W07-7 51595=2000-02-21=2000-052=2000-W08-1 51596=2000-02-22=2000-053=2000-W08-2 51597=2000-02-23=2000-054=2000-W08-3 51598=2000-02-24=2000-055=2000-W08-4 51599=2000-02-25=2000-056=2000-W08-5 51600=2000-02-26=2000-057=2000-W08-6 51601=2000-02-27=2000-058=2000-W08-7 51602=2000-02-28=2000-059=2000-W09-1 51603=2000-02-29=2000-060=2000-W09-2 51604=2000-03-01=2000-061=2000-W09-3 51605=2000-03-02=2000-062=2000-W09-4 51606=2000-03-03=2000-063=2000-W09-5 51607=2000-03-04=2000-064=2000-W09-6 51608=2000-03-05=2000-065=2000-W09-7 51609=2000-03-06=2000-066=2000-W10-1 51610=2000-03-07=2000-067=2000-W10-2 51611=2000-03-08=2000-068=2000-W10-3 51612=2000-03-09=2000-069=2000-W10-4 51613=2000-03-10=2000-070=2000-W10-5 51614=2000-03-11=2000-071=2000-W10-6 51615=2000-03-12=2000-072=2000-W10-7 51616=2000-03-13=2000-073=2000-W11-1 51617=2000-03-14=2000-074=2000-W11-2 51618=2000-03-15=2000-075=2000-W11-3 51619=2000-03-16=2000-076=2000-W11-4 51620=2000-03-17=2000-077=2000-W11-5 51621=2000-03-18=2000-078=2000-W11-6 51622=2000-03-19=2000-079=2000-W11-7 51623=2000-03-20=2000-080=2000-W12-1 51624=2000-03-21=2000-081=2000-W12-2 51625=2000-03-22=2000-082=2000-W12-3 51626=2000-03-23=2000-083=2000-W12-4 51627=2000-03-24=2000-084=2000-W12-5 51628=2000-03-25=2000-085=2000-W12-6 51629=2000-03-26=2000-086=2000-W12-7 51630=2000-03-27=2000-087=2000-W13-1 51631=2000-03-28=2000-088=2000-W13-2 51632=2000-03-29=2000-089=2000-W13-3 51633=2000-03-30=2000-090=2000-W13-4 51634=2000-03-31=2000-091=2000-W13-5 51635=2000-04-01=2000-092=2000-W13-6 51636=2000-04-02=2000-093=2000-W13-7 51637=2000-04-03=2000-094=2000-W14-1 51638=2000-04-04=2000-095=2000-W14-2 51639=2000-04-05=2000-096=2000-W14-3 51640=2000-04-06=2000-097=2000-W14-4 51641=2000-04-07=2000-098=2000-W14-5 51642=2000-04-08=2000-099=2000-W14-6 51643=2000-04-09=2000-100=2000-W14-7 51644=2000-04-10=2000-101=2000-W15-1 51645=2000-04-11=2000-102=2000-W15-2 51646=2000-04-12=2000-103=2000-W15-3 51647=2000-04-13=2000-104=2000-W15-4 51648=2000-04-14=2000-105=2000-W15-5 51649=2000-04-15=2000-106=2000-W15-6 51650=2000-04-16=2000-107=2000-W15-7 51651=2000-04-17=2000-108=2000-W16-1 51652=2000-04-18=2000-109=2000-W16-2 51653=2000-04-19=2000-110=2000-W16-3 51654=2000-04-20=2000-111=2000-W16-4 51655=2000-04-21=2000-112=2000-W16-5 51656=2000-04-22=2000-113=2000-W16-6 51657=2000-04-23=2000-114=2000-W16-7 51658=2000-04-24=2000-115=2000-W17-1 51659=2000-04-25=2000-116=2000-W17-2 51660=2000-04-26=2000-117=2000-W17-3 51661=2000-04-27=2000-118=2000-W17-4 51662=2000-04-28=2000-119=2000-W17-5 51663=2000-04-29=2000-120=2000-W17-6 51664=2000-04-30=2000-121=2000-W17-7 51665=2000-05-01=2000-122=2000-W18-1 51666=2000-05-02=2000-123=2000-W18-2 51667=2000-05-03=2000-124=2000-W18-3 51668=2000-05-04=2000-125=2000-W18-4 51669=2000-05-05=2000-126=2000-W18-5 51670=2000-05-06=2000-127=2000-W18-6 51671=2000-05-07=2000-128=2000-W18-7 51672=2000-05-08=2000-129=2000-W19-1 51673=2000-05-09=2000-130=2000-W19-2 51674=2000-05-10=2000-131=2000-W19-3 51675=2000-05-11=2000-132=2000-W19-4 51676=2000-05-12=2000-133=2000-W19-5 51677=2000-05-13=2000-134=2000-W19-6 51678=2000-05-14=2000-135=2000-W19-7 51679=2000-05-15=2000-136=2000-W20-1 51680=2000-05-16=2000-137=2000-W20-2 51681=2000-05-17=2000-138=2000-W20-3 51682=2000-05-18=2000-139=2000-W20-4 51683=2000-05-19=2000-140=2000-W20-5 51684=2000-05-20=2000-141=2000-W20-6 51685=2000-05-21=2000-142=2000-W20-7 51686=2000-05-22=2000-143=2000-W21-1 51687=2000-05-23=2000-144=2000-W21-2 51688=2000-05-24=2000-145=2000-W21-3 51689=2000-05-25=2000-146=2000-W21-4 51690=2000-05-26=2000-147=2000-W21-5 51691=2000-05-27=2000-148=2000-W21-6 51692=2000-05-28=2000-149=2000-W21-7 51693=2000-05-29=2000-150=2000-W22-1 51694=2000-05-30=2000-151=2000-W22-2 51695=2000-05-31=2000-152=2000-W22-3 51696=2000-06-01=2000-153=2000-W22-4 51697=2000-06-02=2000-154=2000-W22-5 51698=2000-06-03=2000-155=2000-W22-6 51699=2000-06-04=2000-156=2000-W22-7 51700=2000-06-05=2000-157=2000-W23-1 51701=2000-06-06=2000-158=2000-W23-2 51702=2000-06-07=2000-159=2000-W23-3 51703=2000-06-08=2000-160=2000-W23-4 51704=2000-06-09=2000-161=2000-W23-5 51705=2000-06-10=2000-162=2000-W23-6 51706=2000-06-11=2000-163=2000-W23-7 51707=2000-06-12=2000-164=2000-W24-1 51708=2000-06-13=2000-165=2000-W24-2 51709=2000-06-14=2000-166=2000-W24-3 51710=2000-06-15=2000-167=2000-W24-4 51711=2000-06-16=2000-168=2000-W24-5 51712=2000-06-17=2000-169=2000-W24-6 51713=2000-06-18=2000-170=2000-W24-7 51714=2000-06-19=2000-171=2000-W25-1 51715=2000-06-20=2000-172=2000-W25-2 51716=2000-06-21=2000-173=2000-W25-3 51717=2000-06-22=2000-174=2000-W25-4 51718=2000-06-23=2000-175=2000-W25-5 51719=2000-06-24=2000-176=2000-W25-6 51720=2000-06-25=2000-177=2000-W25-7 51721=2000-06-26=2000-178=2000-W26-1 51722=2000-06-27=2000-179=2000-W26-2 51723=2000-06-28=2000-180=2000-W26-3 51724=2000-06-29=2000-181=2000-W26-4 51725=2000-06-30=2000-182=2000-W26-5 51726=2000-07-01=2000-183=2000-W26-6 51727=2000-07-02=2000-184=2000-W26-7 51728=2000-07-03=2000-185=2000-W27-1 51729=2000-07-04=2000-186=2000-W27-2 51730=2000-07-05=2000-187=2000-W27-3 51731=2000-07-06=2000-188=2000-W27-4 51732=2000-07-07=2000-189=2000-W27-5 51733=2000-07-08=2000-190=2000-W27-6 51734=2000-07-09=2000-191=2000-W27-7 51735=2000-07-10=2000-192=2000-W28-1 51736=2000-07-11=2000-193=2000-W28-2 51737=2000-07-12=2000-194=2000-W28-3 51738=2000-07-13=2000-195=2000-W28-4 51739=2000-07-14=2000-196=2000-W28-5 51740=2000-07-15=2000-197=2000-W28-6 51741=2000-07-16=2000-198=2000-W28-7 51742=2000-07-17=2000-199=2000-W29-1 51743=2000-07-18=2000-200=2000-W29-2 51744=2000-07-19=2000-201=2000-W29-3 51745=2000-07-20=2000-202=2000-W29-4 51746=2000-07-21=2000-203=2000-W29-5 51747=2000-07-22=2000-204=2000-W29-6 51748=2000-07-23=2000-205=2000-W29-7 51749=2000-07-24=2000-206=2000-W30-1 51750=2000-07-25=2000-207=2000-W30-2 51751=2000-07-26=2000-208=2000-W30-3 51752=2000-07-27=2000-209=2000-W30-4 51753=2000-07-28=2000-210=2000-W30-5 51754=2000-07-29=2000-211=2000-W30-6 51755=2000-07-30=2000-212=2000-W30-7 51756=2000-07-31=2000-213=2000-W31-1 51757=2000-08-01=2000-214=2000-W31-2 51758=2000-08-02=2000-215=2000-W31-3 51759=2000-08-03=2000-216=2000-W31-4 51760=2000-08-04=2000-217=2000-W31-5 51761=2000-08-05=2000-218=2000-W31-6 51762=2000-08-06=2000-219=2000-W31-7 51763=2000-08-07=2000-220=2000-W32-1 51764=2000-08-08=2000-221=2000-W32-2 51765=2000-08-09=2000-222=2000-W32-3 51766=2000-08-10=2000-223=2000-W32-4 51767=2000-08-11=2000-224=2000-W32-5 51768=2000-08-12=2000-225=2000-W32-6 51769=2000-08-13=2000-226=2000-W32-7 51770=2000-08-14=2000-227=2000-W33-1 51771=2000-08-15=2000-228=2000-W33-2 51772=2000-08-16=2000-229=2000-W33-3 51773=2000-08-17=2000-230=2000-W33-4 51774=2000-08-18=2000-231=2000-W33-5 51775=2000-08-19=2000-232=2000-W33-6 51776=2000-08-20=2000-233=2000-W33-7 51777=2000-08-21=2000-234=2000-W34-1 51778=2000-08-22=2000-235=2000-W34-2 51779=2000-08-23=2000-236=2000-W34-3 51780=2000-08-24=2000-237=2000-W34-4 51781=2000-08-25=2000-238=2000-W34-5 51782=2000-08-26=2000-239=2000-W34-6 51783=2000-08-27=2000-240=2000-W34-7 51784=2000-08-28=2000-241=2000-W35-1 51785=2000-08-29=2000-242=2000-W35-2 51786=2000-08-30=2000-243=2000-W35-3 51787=2000-08-31=2000-244=2000-W35-4 51788=2000-09-01=2000-245=2000-W35-5 51789=2000-09-02=2000-246=2000-W35-6 51790=2000-09-03=2000-247=2000-W35-7 51791=2000-09-04=2000-248=2000-W36-1 51792=2000-09-05=2000-249=2000-W36-2 51793=2000-09-06=2000-250=2000-W36-3 51794=2000-09-07=2000-251=2000-W36-4 51795=2000-09-08=2000-252=2000-W36-5 51796=2000-09-09=2000-253=2000-W36-6 51797=2000-09-10=2000-254=2000-W36-7 51798=2000-09-11=2000-255=2000-W37-1 51799=2000-09-12=2000-256=2000-W37-2 51800=2000-09-13=2000-257=2000-W37-3 51801=2000-09-14=2000-258=2000-W37-4 51802=2000-09-15=2000-259=2000-W37-5 51803=2000-09-16=2000-260=2000-W37-6 51804=2000-09-17=2000-261=2000-W37-7 51805=2000-09-18=2000-262=2000-W38-1 51806=2000-09-19=2000-263=2000-W38-2 51807=2000-09-20=2000-264=2000-W38-3 51808=2000-09-21=2000-265=2000-W38-4 51809=2000-09-22=2000-266=2000-W38-5 51810=2000-09-23=2000-267=2000-W38-6 51811=2000-09-24=2000-268=2000-W38-7 51812=2000-09-25=2000-269=2000-W39-1 51813=2000-09-26=2000-270=2000-W39-2 51814=2000-09-27=2000-271=2000-W39-3 51815=2000-09-28=2000-272=2000-W39-4 51816=2000-09-29=2000-273=2000-W39-5 51817=2000-09-30=2000-274=2000-W39-6 51818=2000-10-01=2000-275=2000-W39-7 51819=2000-10-02=2000-276=2000-W40-1 51820=2000-10-03=2000-277=2000-W40-2 51821=2000-10-04=2000-278=2000-W40-3 51822=2000-10-05=2000-279=2000-W40-4 51823=2000-10-06=2000-280=2000-W40-5 51824=2000-10-07=2000-281=2000-W40-6 51825=2000-10-08=2000-282=2000-W40-7 51826=2000-10-09=2000-283=2000-W41-1 51827=2000-10-10=2000-284=2000-W41-2 51828=2000-10-11=2000-285=2000-W41-3 51829=2000-10-12=2000-286=2000-W41-4 51830=2000-10-13=2000-287=2000-W41-5 51831=2000-10-14=2000-288=2000-W41-6 51832=2000-10-15=2000-289=2000-W41-7 51833=2000-10-16=2000-290=2000-W42-1 51834=2000-10-17=2000-291=2000-W42-2 51835=2000-10-18=2000-292=2000-W42-3 51836=2000-10-19=2000-293=2000-W42-4 51837=2000-10-20=2000-294=2000-W42-5 51838=2000-10-21=2000-295=2000-W42-6 51839=2000-10-22=2000-296=2000-W42-7 51840=2000-10-23=2000-297=2000-W43-1 51841=2000-10-24=2000-298=2000-W43-2 51842=2000-10-25=2000-299=2000-W43-3 51843=2000-10-26=2000-300=2000-W43-4 51844=2000-10-27=2000-301=2000-W43-5 51845=2000-10-28=2000-302=2000-W43-6 51846=2000-10-29=2000-303=2000-W43-7 51847=2000-10-30=2000-304=2000-W44-1 51848=2000-10-31=2000-305=2000-W44-2 51849=2000-11-01=2000-306=2000-W44-3 51850=2000-11-02=2000-307=2000-W44-4 51851=2000-11-03=2000-308=2000-W44-5 51852=2000-11-04=2000-309=2000-W44-6 51853=2000-11-05=2000-310=2000-W44-7 51854=2000-11-06=2000-311=2000-W45-1 51855=2000-11-07=2000-312=2000-W45-2 51856=2000-11-08=2000-313=2000-W45-3 51857=2000-11-09=2000-314=2000-W45-4 51858=2000-11-10=2000-315=2000-W45-5 51859=2000-11-11=2000-316=2000-W45-6 51860=2000-11-12=2000-317=2000-W45-7 51861=2000-11-13=2000-318=2000-W46-1 51862=2000-11-14=2000-319=2000-W46-2 51863=2000-11-15=2000-320=2000-W46-3 51864=2000-11-16=2000-321=2000-W46-4 51865=2000-11-17=2000-322=2000-W46-5 51866=2000-11-18=2000-323=2000-W46-6 51867=2000-11-19=2000-324=2000-W46-7 51868=2000-11-20=2000-325=2000-W47-1 51869=2000-11-21=2000-326=2000-W47-2 51870=2000-11-22=2000-327=2000-W47-3 51871=2000-11-23=2000-328=2000-W47-4 51872=2000-11-24=2000-329=2000-W47-5 51873=2000-11-25=2000-330=2000-W47-6 51874=2000-11-26=2000-331=2000-W47-7 51875=2000-11-27=2000-332=2000-W48-1 51876=2000-11-28=2000-333=2000-W48-2 51877=2000-11-29=2000-334=2000-W48-3 51878=2000-11-30=2000-335=2000-W48-4 51879=2000-12-01=2000-336=2000-W48-5 51880=2000-12-02=2000-337=2000-W48-6 51881=2000-12-03=2000-338=2000-W48-7 51882=2000-12-04=2000-339=2000-W49-1 51883=2000-12-05=2000-340=2000-W49-2 51884=2000-12-06=2000-341=2000-W49-3 51885=2000-12-07=2000-342=2000-W49-4 51886=2000-12-08=2000-343=2000-W49-5 51887=2000-12-09=2000-344=2000-W49-6 51888=2000-12-10=2000-345=2000-W49-7 51889=2000-12-11=2000-346=2000-W50-1 51890=2000-12-12=2000-347=2000-W50-2 51891=2000-12-13=2000-348=2000-W50-3 51892=2000-12-14=2000-349=2000-W50-4 51893=2000-12-15=2000-350=2000-W50-5 51894=2000-12-16=2000-351=2000-W50-6 51895=2000-12-17=2000-352=2000-W50-7 51896=2000-12-18=2000-353=2000-W51-1 51897=2000-12-19=2000-354=2000-W51-2 51898=2000-12-20=2000-355=2000-W51-3 51899=2000-12-21=2000-356=2000-W51-4 51900=2000-12-22=2000-357=2000-W51-5 51901=2000-12-23=2000-358=2000-W51-6 51902=2000-12-24=2000-359=2000-W51-7 51903=2000-12-25=2000-360=2000-W52-1 51904=2000-12-26=2000-361=2000-W52-2 51905=2000-12-27=2000-362=2000-W52-3 51906=2000-12-28=2000-363=2000-W52-4 51907=2000-12-29=2000-364=2000-W52-5 51908=2000-12-30=2000-365=2000-W52-6 51909=2000-12-31=2000-366=2000-W52-7 51910=2001-01-01=2001-001=2001-W01-1 51911=2001-01-02=2001-002=2001-W01-2 51912=2001-01-03=2001-003=2001-W01-3 51913=2001-01-04=2001-004=2001-W01-4 51914=2001-01-05=2001-005=2001-W01-5 51915=2001-01-06=2001-006=2001-W01-6 51916=2001-01-07=2001-007=2001-W01-7 51917=2001-01-08=2001-008=2001-W02-1 51918=2001-01-09=2001-009=2001-W02-2 51919=2001-01-10=2001-010=2001-W02-3 51920=2001-01-11=2001-011=2001-W02-4 51921=2001-01-12=2001-012=2001-W02-5 51922=2001-01-13=2001-013=2001-W02-6 51923=2001-01-14=2001-014=2001-W02-7 51924=2001-01-15=2001-015=2001-W03-1 51925=2001-01-16=2001-016=2001-W03-2 51926=2001-01-17=2001-017=2001-W03-3 51927=2001-01-18=2001-018=2001-W03-4 51928=2001-01-19=2001-019=2001-W03-5 51929=2001-01-20=2001-020=2001-W03-6 51930=2001-01-21=2001-021=2001-W03-7 51931=2001-01-22=2001-022=2001-W04-1 51932=2001-01-23=2001-023=2001-W04-2 51933=2001-01-24=2001-024=2001-W04-3 51934=2001-01-25=2001-025=2001-W04-4 51935=2001-01-26=2001-026=2001-W04-5 51936=2001-01-27=2001-027=2001-W04-6 51937=2001-01-28=2001-028=2001-W04-7 51938=2001-01-29=2001-029=2001-W05-1 51939=2001-01-30=2001-030=2001-W05-2 51940=2001-01-31=2001-031=2001-W05-3 51941=2001-02-01=2001-032=2001-W05-4 51942=2001-02-02=2001-033=2001-W05-5 51943=2001-02-03=2001-034=2001-W05-6 51944=2001-02-04=2001-035=2001-W05-7 51945=2001-02-05=2001-036=2001-W06-1 51946=2001-02-06=2001-037=2001-W06-2 51947=2001-02-07=2001-038=2001-W06-3 51948=2001-02-08=2001-039=2001-W06-4 51949=2001-02-09=2001-040=2001-W06-5 51950=2001-02-10=2001-041=2001-W06-6 51951=2001-02-11=2001-042=2001-W06-7 51952=2001-02-12=2001-043=2001-W07-1 51953=2001-02-13=2001-044=2001-W07-2 51954=2001-02-14=2001-045=2001-W07-3 51955=2001-02-15=2001-046=2001-W07-4 51956=2001-02-16=2001-047=2001-W07-5 51957=2001-02-17=2001-048=2001-W07-6 51958=2001-02-18=2001-049=2001-W07-7 51959=2001-02-19=2001-050=2001-W08-1 51960=2001-02-20=2001-051=2001-W08-2 51961=2001-02-21=2001-052=2001-W08-3 51962=2001-02-22=2001-053=2001-W08-4 51963=2001-02-23=2001-054=2001-W08-5 51964=2001-02-24=2001-055=2001-W08-6 51965=2001-02-25=2001-056=2001-W08-7 51966=2001-02-26=2001-057=2001-W09-1 51967=2001-02-27=2001-058=2001-W09-2 51968=2001-02-28=2001-059=2001-W09-3 51969=2001-03-01=2001-060=2001-W09-4 51970=2001-03-02=2001-061=2001-W09-5 51971=2001-03-03=2001-062=2001-W09-6 51972=2001-03-04=2001-063=2001-W09-7 51973=2001-03-05=2001-064=2001-W10-1 51974=2001-03-06=2001-065=2001-W10-2 51975=2001-03-07=2001-066=2001-W10-3 51976=2001-03-08=2001-067=2001-W10-4 51977=2001-03-09=2001-068=2001-W10-5 51978=2001-03-10=2001-069=2001-W10-6 51979=2001-03-11=2001-070=2001-W10-7 51980=2001-03-12=2001-071=2001-W11-1 51981=2001-03-13=2001-072=2001-W11-2 51982=2001-03-14=2001-073=2001-W11-3 51983=2001-03-15=2001-074=2001-W11-4 51984=2001-03-16=2001-075=2001-W11-5 51985=2001-03-17=2001-076=2001-W11-6 51986=2001-03-18=2001-077=2001-W11-7 51987=2001-03-19=2001-078=2001-W12-1 51988=2001-03-20=2001-079=2001-W12-2 51989=2001-03-21=2001-080=2001-W12-3 51990=2001-03-22=2001-081=2001-W12-4 51991=2001-03-23=2001-082=2001-W12-5 51992=2001-03-24=2001-083=2001-W12-6 51993=2001-03-25=2001-084=2001-W12-7 51994=2001-03-26=2001-085=2001-W13-1 51995=2001-03-27=2001-086=2001-W13-2 51996=2001-03-28=2001-087=2001-W13-3 51997=2001-03-29=2001-088=2001-W13-4 51998=2001-03-30=2001-089=2001-W13-5 51999=2001-03-31=2001-090=2001-W13-6 52000=2001-04-01=2001-091=2001-W13-7 52001=2001-04-02=2001-092=2001-W14-1 52002=2001-04-03=2001-093=2001-W14-2 52003=2001-04-04=2001-094=2001-W14-3 52004=2001-04-05=2001-095=2001-W14-4 52005=2001-04-06=2001-096=2001-W14-5 52006=2001-04-07=2001-097=2001-W14-6 52007=2001-04-08=2001-098=2001-W14-7 52008=2001-04-09=2001-099=2001-W15-1 52009=2001-04-10=2001-100=2001-W15-2 52010=2001-04-11=2001-101=2001-W15-3 52011=2001-04-12=2001-102=2001-W15-4 52012=2001-04-13=2001-103=2001-W15-5 52013=2001-04-14=2001-104=2001-W15-6 52014=2001-04-15=2001-105=2001-W15-7 52015=2001-04-16=2001-106=2001-W16-1 52016=2001-04-17=2001-107=2001-W16-2 52017=2001-04-18=2001-108=2001-W16-3 52018=2001-04-19=2001-109=2001-W16-4 52019=2001-04-20=2001-110=2001-W16-5 52020=2001-04-21=2001-111=2001-W16-6 52021=2001-04-22=2001-112=2001-W16-7 52022=2001-04-23=2001-113=2001-W17-1 52023=2001-04-24=2001-114=2001-W17-2 52024=2001-04-25=2001-115=2001-W17-3 52025=2001-04-26=2001-116=2001-W17-4 52026=2001-04-27=2001-117=2001-W17-5 52027=2001-04-28=2001-118=2001-W17-6 52028=2001-04-29=2001-119=2001-W17-7 52029=2001-04-30=2001-120=2001-W18-1 52030=2001-05-01=2001-121=2001-W18-2 52031=2001-05-02=2001-122=2001-W18-3 52032=2001-05-03=2001-123=2001-W18-4 52033=2001-05-04=2001-124=2001-W18-5 52034=2001-05-05=2001-125=2001-W18-6 52035=2001-05-06=2001-126=2001-W18-7 52036=2001-05-07=2001-127=2001-W19-1 52037=2001-05-08=2001-128=2001-W19-2 52038=2001-05-09=2001-129=2001-W19-3 52039=2001-05-10=2001-130=2001-W19-4 52040=2001-05-11=2001-131=2001-W19-5 52041=2001-05-12=2001-132=2001-W19-6 52042=2001-05-13=2001-133=2001-W19-7 52043=2001-05-14=2001-134=2001-W20-1 52044=2001-05-15=2001-135=2001-W20-2 52045=2001-05-16=2001-136=2001-W20-3 52046=2001-05-17=2001-137=2001-W20-4 52047=2001-05-18=2001-138=2001-W20-5 52048=2001-05-19=2001-139=2001-W20-6 52049=2001-05-20=2001-140=2001-W20-7 52050=2001-05-21=2001-141=2001-W21-1 52051=2001-05-22=2001-142=2001-W21-2 52052=2001-05-23=2001-143=2001-W21-3 52053=2001-05-24=2001-144=2001-W21-4 52054=2001-05-25=2001-145=2001-W21-5 52055=2001-05-26=2001-146=2001-W21-6 52056=2001-05-27=2001-147=2001-W21-7 52057=2001-05-28=2001-148=2001-W22-1 52058=2001-05-29=2001-149=2001-W22-2 52059=2001-05-30=2001-150=2001-W22-3 52060=2001-05-31=2001-151=2001-W22-4 52061=2001-06-01=2001-152=2001-W22-5 52062=2001-06-02=2001-153=2001-W22-6 52063=2001-06-03=2001-154=2001-W22-7 52064=2001-06-04=2001-155=2001-W23-1 52065=2001-06-05=2001-156=2001-W23-2 52066=2001-06-06=2001-157=2001-W23-3 52067=2001-06-07=2001-158=2001-W23-4 52068=2001-06-08=2001-159=2001-W23-5 52069=2001-06-09=2001-160=2001-W23-6 52070=2001-06-10=2001-161=2001-W23-7 52071=2001-06-11=2001-162=2001-W24-1 52072=2001-06-12=2001-163=2001-W24-2 52073=2001-06-13=2001-164=2001-W24-3 52074=2001-06-14=2001-165=2001-W24-4 52075=2001-06-15=2001-166=2001-W24-5 52076=2001-06-16=2001-167=2001-W24-6 52077=2001-06-17=2001-168=2001-W24-7 52078=2001-06-18=2001-169=2001-W25-1 52079=2001-06-19=2001-170=2001-W25-2 52080=2001-06-20=2001-171=2001-W25-3 52081=2001-06-21=2001-172=2001-W25-4 52082=2001-06-22=2001-173=2001-W25-5 52083=2001-06-23=2001-174=2001-W25-6 52084=2001-06-24=2001-175=2001-W25-7 52085=2001-06-25=2001-176=2001-W26-1 52086=2001-06-26=2001-177=2001-W26-2 52087=2001-06-27=2001-178=2001-W26-3 52088=2001-06-28=2001-179=2001-W26-4 52089=2001-06-29=2001-180=2001-W26-5 52090=2001-06-30=2001-181=2001-W26-6 52091=2001-07-01=2001-182=2001-W26-7 52092=2001-07-02=2001-183=2001-W27-1 52093=2001-07-03=2001-184=2001-W27-2 52094=2001-07-04=2001-185=2001-W27-3 52095=2001-07-05=2001-186=2001-W27-4 52096=2001-07-06=2001-187=2001-W27-5 52097=2001-07-07=2001-188=2001-W27-6 52098=2001-07-08=2001-189=2001-W27-7 52099=2001-07-09=2001-190=2001-W28-1 52100=2001-07-10=2001-191=2001-W28-2 52101=2001-07-11=2001-192=2001-W28-3 52102=2001-07-12=2001-193=2001-W28-4 52103=2001-07-13=2001-194=2001-W28-5 52104=2001-07-14=2001-195=2001-W28-6 52105=2001-07-15=2001-196=2001-W28-7 52106=2001-07-16=2001-197=2001-W29-1 52107=2001-07-17=2001-198=2001-W29-2 52108=2001-07-18=2001-199=2001-W29-3 52109=2001-07-19=2001-200=2001-W29-4 52110=2001-07-20=2001-201=2001-W29-5 52111=2001-07-21=2001-202=2001-W29-6 52112=2001-07-22=2001-203=2001-W29-7 52113=2001-07-23=2001-204=2001-W30-1 52114=2001-07-24=2001-205=2001-W30-2 52115=2001-07-25=2001-206=2001-W30-3 52116=2001-07-26=2001-207=2001-W30-4 52117=2001-07-27=2001-208=2001-W30-5 52118=2001-07-28=2001-209=2001-W30-6 52119=2001-07-29=2001-210=2001-W30-7 52120=2001-07-30=2001-211=2001-W31-1 52121=2001-07-31=2001-212=2001-W31-2 52122=2001-08-01=2001-213=2001-W31-3 52123=2001-08-02=2001-214=2001-W31-4 52124=2001-08-03=2001-215=2001-W31-5 52125=2001-08-04=2001-216=2001-W31-6 52126=2001-08-05=2001-217=2001-W31-7 52127=2001-08-06=2001-218=2001-W32-1 52128=2001-08-07=2001-219=2001-W32-2 52129=2001-08-08=2001-220=2001-W32-3 52130=2001-08-09=2001-221=2001-W32-4 52131=2001-08-10=2001-222=2001-W32-5 52132=2001-08-11=2001-223=2001-W32-6 52133=2001-08-12=2001-224=2001-W32-7 52134=2001-08-13=2001-225=2001-W33-1 52135=2001-08-14=2001-226=2001-W33-2 52136=2001-08-15=2001-227=2001-W33-3 52137=2001-08-16=2001-228=2001-W33-4 52138=2001-08-17=2001-229=2001-W33-5 52139=2001-08-18=2001-230=2001-W33-6 52140=2001-08-19=2001-231=2001-W33-7 52141=2001-08-20=2001-232=2001-W34-1 52142=2001-08-21=2001-233=2001-W34-2 52143=2001-08-22=2001-234=2001-W34-3 52144=2001-08-23=2001-235=2001-W34-4 52145=2001-08-24=2001-236=2001-W34-5 52146=2001-08-25=2001-237=2001-W34-6 52147=2001-08-26=2001-238=2001-W34-7 52148=2001-08-27=2001-239=2001-W35-1 52149=2001-08-28=2001-240=2001-W35-2 52150=2001-08-29=2001-241=2001-W35-3 52151=2001-08-30=2001-242=2001-W35-4 52152=2001-08-31=2001-243=2001-W35-5 52153=2001-09-01=2001-244=2001-W35-6 52154=2001-09-02=2001-245=2001-W35-7 52155=2001-09-03=2001-246=2001-W36-1 52156=2001-09-04=2001-247=2001-W36-2 52157=2001-09-05=2001-248=2001-W36-3 52158=2001-09-06=2001-249=2001-W36-4 52159=2001-09-07=2001-250=2001-W36-5 52160=2001-09-08=2001-251=2001-W36-6 52161=2001-09-09=2001-252=2001-W36-7 52162=2001-09-10=2001-253=2001-W37-1 52163=2001-09-11=2001-254=2001-W37-2 52164=2001-09-12=2001-255=2001-W37-3 52165=2001-09-13=2001-256=2001-W37-4 52166=2001-09-14=2001-257=2001-W37-5 52167=2001-09-15=2001-258=2001-W37-6 52168=2001-09-16=2001-259=2001-W37-7 52169=2001-09-17=2001-260=2001-W38-1 52170=2001-09-18=2001-261=2001-W38-2 52171=2001-09-19=2001-262=2001-W38-3 52172=2001-09-20=2001-263=2001-W38-4 52173=2001-09-21=2001-264=2001-W38-5 52174=2001-09-22=2001-265=2001-W38-6 52175=2001-09-23=2001-266=2001-W38-7 52176=2001-09-24=2001-267=2001-W39-1 52177=2001-09-25=2001-268=2001-W39-2 52178=2001-09-26=2001-269=2001-W39-3 52179=2001-09-27=2001-270=2001-W39-4 52180=2001-09-28=2001-271=2001-W39-5 52181=2001-09-29=2001-272=2001-W39-6 52182=2001-09-30=2001-273=2001-W39-7 52183=2001-10-01=2001-274=2001-W40-1 52184=2001-10-02=2001-275=2001-W40-2 52185=2001-10-03=2001-276=2001-W40-3 52186=2001-10-04=2001-277=2001-W40-4 52187=2001-10-05=2001-278=2001-W40-5 52188=2001-10-06=2001-279=2001-W40-6 52189=2001-10-07=2001-280=2001-W40-7 52190=2001-10-08=2001-281=2001-W41-1 52191=2001-10-09=2001-282=2001-W41-2 52192=2001-10-10=2001-283=2001-W41-3 52193=2001-10-11=2001-284=2001-W41-4 52194=2001-10-12=2001-285=2001-W41-5 52195=2001-10-13=2001-286=2001-W41-6 52196=2001-10-14=2001-287=2001-W41-7 52197=2001-10-15=2001-288=2001-W42-1 52198=2001-10-16=2001-289=2001-W42-2 52199=2001-10-17=2001-290=2001-W42-3 52200=2001-10-18=2001-291=2001-W42-4 52201=2001-10-19=2001-292=2001-W42-5 52202=2001-10-20=2001-293=2001-W42-6 52203=2001-10-21=2001-294=2001-W42-7 52204=2001-10-22=2001-295=2001-W43-1 52205=2001-10-23=2001-296=2001-W43-2 52206=2001-10-24=2001-297=2001-W43-3 52207=2001-10-25=2001-298=2001-W43-4 52208=2001-10-26=2001-299=2001-W43-5 52209=2001-10-27=2001-300=2001-W43-6 52210=2001-10-28=2001-301=2001-W43-7 52211=2001-10-29=2001-302=2001-W44-1 52212=2001-10-30=2001-303=2001-W44-2 52213=2001-10-31=2001-304=2001-W44-3 52214=2001-11-01=2001-305=2001-W44-4 52215=2001-11-02=2001-306=2001-W44-5 52216=2001-11-03=2001-307=2001-W44-6 52217=2001-11-04=2001-308=2001-W44-7 52218=2001-11-05=2001-309=2001-W45-1 52219=2001-11-06=2001-310=2001-W45-2 52220=2001-11-07=2001-311=2001-W45-3 52221=2001-11-08=2001-312=2001-W45-4 52222=2001-11-09=2001-313=2001-W45-5 52223=2001-11-10=2001-314=2001-W45-6 52224=2001-11-11=2001-315=2001-W45-7 52225=2001-11-12=2001-316=2001-W46-1 52226=2001-11-13=2001-317=2001-W46-2 52227=2001-11-14=2001-318=2001-W46-3 52228=2001-11-15=2001-319=2001-W46-4 52229=2001-11-16=2001-320=2001-W46-5 52230=2001-11-17=2001-321=2001-W46-6 52231=2001-11-18=2001-322=2001-W46-7 52232=2001-11-19=2001-323=2001-W47-1 52233=2001-11-20=2001-324=2001-W47-2 52234=2001-11-21=2001-325=2001-W47-3 52235=2001-11-22=2001-326=2001-W47-4 52236=2001-11-23=2001-327=2001-W47-5 52237=2001-11-24=2001-328=2001-W47-6 52238=2001-11-25=2001-329=2001-W47-7 52239=2001-11-26=2001-330=2001-W48-1 52240=2001-11-27=2001-331=2001-W48-2 52241=2001-11-28=2001-332=2001-W48-3 52242=2001-11-29=2001-333=2001-W48-4 52243=2001-11-30=2001-334=2001-W48-5 52244=2001-12-01=2001-335=2001-W48-6 52245=2001-12-02=2001-336=2001-W48-7 52246=2001-12-03=2001-337=2001-W49-1 52247=2001-12-04=2001-338=2001-W49-2 52248=2001-12-05=2001-339=2001-W49-3 52249=2001-12-06=2001-340=2001-W49-4 52250=2001-12-07=2001-341=2001-W49-5 52251=2001-12-08=2001-342=2001-W49-6 52252=2001-12-09=2001-343=2001-W49-7 52253=2001-12-10=2001-344=2001-W50-1 52254=2001-12-11=2001-345=2001-W50-2 52255=2001-12-12=2001-346=2001-W50-3 52256=2001-12-13=2001-347=2001-W50-4 52257=2001-12-14=2001-348=2001-W50-5 52258=2001-12-15=2001-349=2001-W50-6 52259=2001-12-16=2001-350=2001-W50-7 52260=2001-12-17=2001-351=2001-W51-1 52261=2001-12-18=2001-352=2001-W51-2 52262=2001-12-19=2001-353=2001-W51-3 52263=2001-12-20=2001-354=2001-W51-4 52264=2001-12-21=2001-355=2001-W51-5 52265=2001-12-22=2001-356=2001-W51-6 52266=2001-12-23=2001-357=2001-W51-7 52267=2001-12-24=2001-358=2001-W52-1 52268=2001-12-25=2001-359=2001-W52-2 52269=2001-12-26=2001-360=2001-W52-3 52270=2001-12-27=2001-361=2001-W52-4 52271=2001-12-28=2001-362=2001-W52-5 52272=2001-12-29=2001-363=2001-W52-6 52273=2001-12-30=2001-364=2001-W52-7 52274=2001-12-31=2001-365=2002-W01-1 52275=2002-01-01=2002-001=2002-W01-2 52276=2002-01-02=2002-002=2002-W01-3 52277=2002-01-03=2002-003=2002-W01-4 52278=2002-01-04=2002-004=2002-W01-5 52279=2002-01-05=2002-005=2002-W01-6 52280=2002-01-06=2002-006=2002-W01-7 51178=1998-12-31=1998-365=1998-W53-4 1998-12-31 23:59:60.5 51178,86400.5s 1998-12-31 15:59:60.5 51178,86400.5s 2000-03-01 00:00:00 2000-03-01 12:00:00 2000-02-29 16:00:00 2000-03-01 04:00:00 2000-03-01 08:00:00 2000-03-01 20:00:00 hugs98-plus-Sep2006/packages/time/time/test/TimeZone.hs0000644006511100651110000000023610504340546021504 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time main :: IO () main = do zone <- getCurrentTimeZone putStrLn (timeZoneOffsetString zone) hugs98-plus-Sep2006/packages/time/time/test/LongWeekYears.hs0000644006511100651110000000076110504340546022474 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate import Data.Time.Calendar longYear :: Integer -> Bool longYear year = case toWeekDate (fromGregorian year 12 31) of (_,53,_) -> True _ -> False showLongYear :: Integer -> IO () showLongYear year = putStrLn ((show year) ++ ": " ++ (if isLeapYear year then "L" else " ") ++ (if longYear year then "*" else " ")) main :: IO () main = do mapM_ showLongYear [1901 .. 2050] hugs98-plus-Sep2006/packages/time/time/test/ConvertBack.hs0000644006511100651110000000167110504340546022157 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Julian import Data.Time.Calendar.WeekDate import Data.Time.Calendar checkDay :: (Show t) => (Day -> t) -> (t -> Day) -> Day -> IO () checkDay encodeDay decodeDay day = do let st = encodeDay day let day' = decodeDay st if day /= day' then putStrLn ((show day) ++ " -> " ++ (show st) ++ " -> " ++ (show day') ++ " (diff " ++ (show (diffDays day' day)) ++ ")") else return () checkers :: [Day -> IO ()] checkers = [ checkDay toOrdinalDate (\(y,d) -> fromOrdinalDate y d), checkDay toWeekDate (\(y,w,d) -> fromWeekDate y w d), checkDay toGregorian (\(y,m,d) -> fromGregorian y m d), checkDay toJulian (\(y,m,d) -> fromJulian y m d) ] days :: [Day] days = [ModifiedJulianDay 50000 .. ModifiedJulianDay 50200] ++ (fmap (\year -> (fromGregorian year 1 4)) [1980..2000]) main :: IO () main = mapM_ (\ch -> mapM_ ch days) checkers hugs98-plus-Sep2006/packages/time/time/test/Makefile0000644006511100651110000000350110504340546021054 0ustar rossrossdefault: CurrentTime.run ShowDST.run test TestMonthDay: TestMonthDay.o ../libHStime.a ghc -package fixed $^ -o $@ ConvertBack: ConvertBack.o ../libHStime.a ghc -package fixed $^ -o $@ TestCalendars: TestCalendars.o ../libHStime.a ghc -package fixed $^ -o $@ TestTime: TestTime.o ../libHStime.a ghc -package fixed $^ -o $@ LongWeekYears: LongWeekYears.o ../libHStime.a ghc -package fixed $^ -o $@ ClipDates: ClipDates.o ../libHStime.a ghc -package fixed $^ -o $@ AddDays: AddDays.o ../libHStime.a ghc -package fixed $^ -o $@ TestFormat: TestFormat.o TestFormatStuff.o ../libHStime.a ghc -package fixed $^ -o $@ TestFormatStuff.o: TestFormatStuff.c TestFormatStuff.h gcc -o $@ -c $< TestParseDAT: TestParseDAT.o ../libHStime.a ghc -package fixed $^ -o $@ TestEaster: TestEaster.o ../libHStime.a ghc -package fixed $^ -o $@ CurrentTime: CurrentTime.o ../libHStime.a ghc -package fixed $^ -o $@ ShowDST: ShowDST.o ../libHStime.a ghc -package fixed $^ -o $@ TimeZone: TimeZone.o ../libHStime.a ghc -package fixed $^ -o $@ TimeZone.ref: FORCE date +%z > $@ test: \ TestMonthDay.diff \ ConvertBack.diff0 \ TestCalendars.diff \ TestTime.diff \ LongWeekYears.diff \ ClipDates.diff \ AddDays.diff \ TimeZone.diff \ TestFormat.diff0 \ TestParseDAT.diff \ TestEaster.diff \ UseCases.o clean: rm -rf TestMonthDay ConvertBack TestCalendars TestTime LongWeekYears ClipDates \ AddDays TestFormat TestParseDAT TestEaster CurrentTime ShowDST TimeZone TimeZone.ref *.out *.o *.hi Makefile.bak %.diff: %.ref %.out diff -u $^ %.diff0: %.out echo -n | diff -u - $^ %.out: % ./$< > $@ %.run: % ./$< %.hi: %.o @: %.o: %.hs ghc -i.. -c $< -o $@ %.o: %.lhs ghc -i.. -c $< -o $@ FORCE: .SECONDARY: # TestTime.o TestFormat.o CurrentTime.o ShowDST.o TimeZone.o: $(patsubst %.hs,%.hi,$(SRCS)) TestFixed.o: ../Data/Fixed.hi hugs98-plus-Sep2006/packages/time/time/test/ClipDates.hs0000644006511100651110000000207410504340546021624 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate import Data.Time.Calendar import Control.Monad checkYearAndDay :: (Integer,Int) -> IO () checkYearAndDay (y,d) = putStrLn ((show y) ++ "-" ++ (show d) ++ " = " ++ (showOrdinalDate (fromOrdinalDate y d))) checkGregorian :: (Integer,Int,Int) -> IO () checkGregorian (y,m,d) = putStrLn ((show y) ++ "-" ++ (show m) ++ "-" ++ (show d) ++ " = " ++ (showGregorian (fromGregorian y m d))) checkISOWeekDay :: (Integer,Int,Int) -> IO () checkISOWeekDay (y,w,d) = putStrLn ((show y) ++ "-W" ++ (show w) ++ "-" ++ (show d) ++ " = " ++ (showWeekDate (fromWeekDate y w d))) main :: IO () main = do putStrLn "YearAndDay" mapM_ checkYearAndDay (liftM2 (,) [1968,1969,1971] [-4,0,1,200,364,365,366,367,700]) putStrLn "Gregorian" mapM_ checkGregorian (liftM3 (,,) [1968,1969,1971] [-20,-1,0,1,2,12,13,17] [-7,-1,0,1,2,27,28,29,30,31,32,40]) putStrLn "ISOWeekDay" mapM_ checkISOWeekDay (liftM3 (,,) [1968,1969,2004] [-20,-1,0,1,20,51,52,53,54] [-2,-1,0,1,4,6,7,8,9]) hugs98-plus-Sep2006/packages/time/time/test/ClipDates.ref0000644006511100651110000003160010504340546021763 0ustar rossrossYearAndDay 1968--4 = 1968-001 1968-0 = 1968-001 1968-1 = 1968-001 1968-200 = 1968-200 1968-364 = 1968-364 1968-365 = 1968-365 1968-366 = 1968-366 1968-367 = 1968-366 1968-700 = 1968-366 1969--4 = 1969-001 1969-0 = 1969-001 1969-1 = 1969-001 1969-200 = 1969-200 1969-364 = 1969-364 1969-365 = 1969-365 1969-366 = 1969-365 1969-367 = 1969-365 1969-700 = 1969-365 1971--4 = 1971-001 1971-0 = 1971-001 1971-1 = 1971-001 1971-200 = 1971-200 1971-364 = 1971-364 1971-365 = 1971-365 1971-366 = 1971-365 1971-367 = 1971-365 1971-700 = 1971-365 Gregorian 1968--20--7 = 1968-01-01 1968--20--1 = 1968-01-01 1968--20-0 = 1968-01-01 1968--20-1 = 1968-01-01 1968--20-2 = 1968-01-02 1968--20-27 = 1968-01-27 1968--20-28 = 1968-01-28 1968--20-29 = 1968-01-29 1968--20-30 = 1968-01-30 1968--20-31 = 1968-01-31 1968--20-32 = 1968-01-31 1968--20-40 = 1968-01-31 1968--1--7 = 1968-01-01 1968--1--1 = 1968-01-01 1968--1-0 = 1968-01-01 1968--1-1 = 1968-01-01 1968--1-2 = 1968-01-02 1968--1-27 = 1968-01-27 1968--1-28 = 1968-01-28 1968--1-29 = 1968-01-29 1968--1-30 = 1968-01-30 1968--1-31 = 1968-01-31 1968--1-32 = 1968-01-31 1968--1-40 = 1968-01-31 1968-0--7 = 1968-01-01 1968-0--1 = 1968-01-01 1968-0-0 = 1968-01-01 1968-0-1 = 1968-01-01 1968-0-2 = 1968-01-02 1968-0-27 = 1968-01-27 1968-0-28 = 1968-01-28 1968-0-29 = 1968-01-29 1968-0-30 = 1968-01-30 1968-0-31 = 1968-01-31 1968-0-32 = 1968-01-31 1968-0-40 = 1968-01-31 1968-1--7 = 1968-01-01 1968-1--1 = 1968-01-01 1968-1-0 = 1968-01-01 1968-1-1 = 1968-01-01 1968-1-2 = 1968-01-02 1968-1-27 = 1968-01-27 1968-1-28 = 1968-01-28 1968-1-29 = 1968-01-29 1968-1-30 = 1968-01-30 1968-1-31 = 1968-01-31 1968-1-32 = 1968-01-31 1968-1-40 = 1968-01-31 1968-2--7 = 1968-02-01 1968-2--1 = 1968-02-01 1968-2-0 = 1968-02-01 1968-2-1 = 1968-02-01 1968-2-2 = 1968-02-02 1968-2-27 = 1968-02-27 1968-2-28 = 1968-02-28 1968-2-29 = 1968-02-29 1968-2-30 = 1968-02-29 1968-2-31 = 1968-02-29 1968-2-32 = 1968-02-29 1968-2-40 = 1968-02-29 1968-12--7 = 1968-12-01 1968-12--1 = 1968-12-01 1968-12-0 = 1968-12-01 1968-12-1 = 1968-12-01 1968-12-2 = 1968-12-02 1968-12-27 = 1968-12-27 1968-12-28 = 1968-12-28 1968-12-29 = 1968-12-29 1968-12-30 = 1968-12-30 1968-12-31 = 1968-12-31 1968-12-32 = 1968-12-31 1968-12-40 = 1968-12-31 1968-13--7 = 1968-12-01 1968-13--1 = 1968-12-01 1968-13-0 = 1968-12-01 1968-13-1 = 1968-12-01 1968-13-2 = 1968-12-02 1968-13-27 = 1968-12-27 1968-13-28 = 1968-12-28 1968-13-29 = 1968-12-29 1968-13-30 = 1968-12-30 1968-13-31 = 1968-12-31 1968-13-32 = 1968-12-31 1968-13-40 = 1968-12-31 1968-17--7 = 1968-12-01 1968-17--1 = 1968-12-01 1968-17-0 = 1968-12-01 1968-17-1 = 1968-12-01 1968-17-2 = 1968-12-02 1968-17-27 = 1968-12-27 1968-17-28 = 1968-12-28 1968-17-29 = 1968-12-29 1968-17-30 = 1968-12-30 1968-17-31 = 1968-12-31 1968-17-32 = 1968-12-31 1968-17-40 = 1968-12-31 1969--20--7 = 1969-01-01 1969--20--1 = 1969-01-01 1969--20-0 = 1969-01-01 1969--20-1 = 1969-01-01 1969--20-2 = 1969-01-02 1969--20-27 = 1969-01-27 1969--20-28 = 1969-01-28 1969--20-29 = 1969-01-29 1969--20-30 = 1969-01-30 1969--20-31 = 1969-01-31 1969--20-32 = 1969-01-31 1969--20-40 = 1969-01-31 1969--1--7 = 1969-01-01 1969--1--1 = 1969-01-01 1969--1-0 = 1969-01-01 1969--1-1 = 1969-01-01 1969--1-2 = 1969-01-02 1969--1-27 = 1969-01-27 1969--1-28 = 1969-01-28 1969--1-29 = 1969-01-29 1969--1-30 = 1969-01-30 1969--1-31 = 1969-01-31 1969--1-32 = 1969-01-31 1969--1-40 = 1969-01-31 1969-0--7 = 1969-01-01 1969-0--1 = 1969-01-01 1969-0-0 = 1969-01-01 1969-0-1 = 1969-01-01 1969-0-2 = 1969-01-02 1969-0-27 = 1969-01-27 1969-0-28 = 1969-01-28 1969-0-29 = 1969-01-29 1969-0-30 = 1969-01-30 1969-0-31 = 1969-01-31 1969-0-32 = 1969-01-31 1969-0-40 = 1969-01-31 1969-1--7 = 1969-01-01 1969-1--1 = 1969-01-01 1969-1-0 = 1969-01-01 1969-1-1 = 1969-01-01 1969-1-2 = 1969-01-02 1969-1-27 = 1969-01-27 1969-1-28 = 1969-01-28 1969-1-29 = 1969-01-29 1969-1-30 = 1969-01-30 1969-1-31 = 1969-01-31 1969-1-32 = 1969-01-31 1969-1-40 = 1969-01-31 1969-2--7 = 1969-02-01 1969-2--1 = 1969-02-01 1969-2-0 = 1969-02-01 1969-2-1 = 1969-02-01 1969-2-2 = 1969-02-02 1969-2-27 = 1969-02-27 1969-2-28 = 1969-02-28 1969-2-29 = 1969-02-28 1969-2-30 = 1969-02-28 1969-2-31 = 1969-02-28 1969-2-32 = 1969-02-28 1969-2-40 = 1969-02-28 1969-12--7 = 1969-12-01 1969-12--1 = 1969-12-01 1969-12-0 = 1969-12-01 1969-12-1 = 1969-12-01 1969-12-2 = 1969-12-02 1969-12-27 = 1969-12-27 1969-12-28 = 1969-12-28 1969-12-29 = 1969-12-29 1969-12-30 = 1969-12-30 1969-12-31 = 1969-12-31 1969-12-32 = 1969-12-31 1969-12-40 = 1969-12-31 1969-13--7 = 1969-12-01 1969-13--1 = 1969-12-01 1969-13-0 = 1969-12-01 1969-13-1 = 1969-12-01 1969-13-2 = 1969-12-02 1969-13-27 = 1969-12-27 1969-13-28 = 1969-12-28 1969-13-29 = 1969-12-29 1969-13-30 = 1969-12-30 1969-13-31 = 1969-12-31 1969-13-32 = 1969-12-31 1969-13-40 = 1969-12-31 1969-17--7 = 1969-12-01 1969-17--1 = 1969-12-01 1969-17-0 = 1969-12-01 1969-17-1 = 1969-12-01 1969-17-2 = 1969-12-02 1969-17-27 = 1969-12-27 1969-17-28 = 1969-12-28 1969-17-29 = 1969-12-29 1969-17-30 = 1969-12-30 1969-17-31 = 1969-12-31 1969-17-32 = 1969-12-31 1969-17-40 = 1969-12-31 1971--20--7 = 1971-01-01 1971--20--1 = 1971-01-01 1971--20-0 = 1971-01-01 1971--20-1 = 1971-01-01 1971--20-2 = 1971-01-02 1971--20-27 = 1971-01-27 1971--20-28 = 1971-01-28 1971--20-29 = 1971-01-29 1971--20-30 = 1971-01-30 1971--20-31 = 1971-01-31 1971--20-32 = 1971-01-31 1971--20-40 = 1971-01-31 1971--1--7 = 1971-01-01 1971--1--1 = 1971-01-01 1971--1-0 = 1971-01-01 1971--1-1 = 1971-01-01 1971--1-2 = 1971-01-02 1971--1-27 = 1971-01-27 1971--1-28 = 1971-01-28 1971--1-29 = 1971-01-29 1971--1-30 = 1971-01-30 1971--1-31 = 1971-01-31 1971--1-32 = 1971-01-31 1971--1-40 = 1971-01-31 1971-0--7 = 1971-01-01 1971-0--1 = 1971-01-01 1971-0-0 = 1971-01-01 1971-0-1 = 1971-01-01 1971-0-2 = 1971-01-02 1971-0-27 = 1971-01-27 1971-0-28 = 1971-01-28 1971-0-29 = 1971-01-29 1971-0-30 = 1971-01-30 1971-0-31 = 1971-01-31 1971-0-32 = 1971-01-31 1971-0-40 = 1971-01-31 1971-1--7 = 1971-01-01 1971-1--1 = 1971-01-01 1971-1-0 = 1971-01-01 1971-1-1 = 1971-01-01 1971-1-2 = 1971-01-02 1971-1-27 = 1971-01-27 1971-1-28 = 1971-01-28 1971-1-29 = 1971-01-29 1971-1-30 = 1971-01-30 1971-1-31 = 1971-01-31 1971-1-32 = 1971-01-31 1971-1-40 = 1971-01-31 1971-2--7 = 1971-02-01 1971-2--1 = 1971-02-01 1971-2-0 = 1971-02-01 1971-2-1 = 1971-02-01 1971-2-2 = 1971-02-02 1971-2-27 = 1971-02-27 1971-2-28 = 1971-02-28 1971-2-29 = 1971-02-28 1971-2-30 = 1971-02-28 1971-2-31 = 1971-02-28 1971-2-32 = 1971-02-28 1971-2-40 = 1971-02-28 1971-12--7 = 1971-12-01 1971-12--1 = 1971-12-01 1971-12-0 = 1971-12-01 1971-12-1 = 1971-12-01 1971-12-2 = 1971-12-02 1971-12-27 = 1971-12-27 1971-12-28 = 1971-12-28 1971-12-29 = 1971-12-29 1971-12-30 = 1971-12-30 1971-12-31 = 1971-12-31 1971-12-32 = 1971-12-31 1971-12-40 = 1971-12-31 1971-13--7 = 1971-12-01 1971-13--1 = 1971-12-01 1971-13-0 = 1971-12-01 1971-13-1 = 1971-12-01 1971-13-2 = 1971-12-02 1971-13-27 = 1971-12-27 1971-13-28 = 1971-12-28 1971-13-29 = 1971-12-29 1971-13-30 = 1971-12-30 1971-13-31 = 1971-12-31 1971-13-32 = 1971-12-31 1971-13-40 = 1971-12-31 1971-17--7 = 1971-12-01 1971-17--1 = 1971-12-01 1971-17-0 = 1971-12-01 1971-17-1 = 1971-12-01 1971-17-2 = 1971-12-02 1971-17-27 = 1971-12-27 1971-17-28 = 1971-12-28 1971-17-29 = 1971-12-29 1971-17-30 = 1971-12-30 1971-17-31 = 1971-12-31 1971-17-32 = 1971-12-31 1971-17-40 = 1971-12-31 ISOWeekDay 1968-W-20--2 = 1968-W01-1 1968-W-20--1 = 1968-W01-1 1968-W-20-0 = 1968-W01-1 1968-W-20-1 = 1968-W01-1 1968-W-20-4 = 1968-W01-4 1968-W-20-6 = 1968-W01-6 1968-W-20-7 = 1968-W01-7 1968-W-20-8 = 1968-W01-7 1968-W-20-9 = 1968-W01-7 1968-W-1--2 = 1968-W01-1 1968-W-1--1 = 1968-W01-1 1968-W-1-0 = 1968-W01-1 1968-W-1-1 = 1968-W01-1 1968-W-1-4 = 1968-W01-4 1968-W-1-6 = 1968-W01-6 1968-W-1-7 = 1968-W01-7 1968-W-1-8 = 1968-W01-7 1968-W-1-9 = 1968-W01-7 1968-W0--2 = 1968-W01-1 1968-W0--1 = 1968-W01-1 1968-W0-0 = 1968-W01-1 1968-W0-1 = 1968-W01-1 1968-W0-4 = 1968-W01-4 1968-W0-6 = 1968-W01-6 1968-W0-7 = 1968-W01-7 1968-W0-8 = 1968-W01-7 1968-W0-9 = 1968-W01-7 1968-W1--2 = 1968-W01-1 1968-W1--1 = 1968-W01-1 1968-W1-0 = 1968-W01-1 1968-W1-1 = 1968-W01-1 1968-W1-4 = 1968-W01-4 1968-W1-6 = 1968-W01-6 1968-W1-7 = 1968-W01-7 1968-W1-8 = 1968-W01-7 1968-W1-9 = 1968-W01-7 1968-W20--2 = 1968-W20-1 1968-W20--1 = 1968-W20-1 1968-W20-0 = 1968-W20-1 1968-W20-1 = 1968-W20-1 1968-W20-4 = 1968-W20-4 1968-W20-6 = 1968-W20-6 1968-W20-7 = 1968-W20-7 1968-W20-8 = 1968-W20-7 1968-W20-9 = 1968-W20-7 1968-W51--2 = 1968-W51-1 1968-W51--1 = 1968-W51-1 1968-W51-0 = 1968-W51-1 1968-W51-1 = 1968-W51-1 1968-W51-4 = 1968-W51-4 1968-W51-6 = 1968-W51-6 1968-W51-7 = 1968-W51-7 1968-W51-8 = 1968-W51-7 1968-W51-9 = 1968-W51-7 1968-W52--2 = 1968-W52-1 1968-W52--1 = 1968-W52-1 1968-W52-0 = 1968-W52-1 1968-W52-1 = 1968-W52-1 1968-W52-4 = 1968-W52-4 1968-W52-6 = 1968-W52-6 1968-W52-7 = 1968-W52-7 1968-W52-8 = 1968-W52-7 1968-W52-9 = 1968-W52-7 1968-W53--2 = 1968-W52-1 1968-W53--1 = 1968-W52-1 1968-W53-0 = 1968-W52-1 1968-W53-1 = 1968-W52-1 1968-W53-4 = 1968-W52-4 1968-W53-6 = 1968-W52-6 1968-W53-7 = 1968-W52-7 1968-W53-8 = 1968-W52-7 1968-W53-9 = 1968-W52-7 1968-W54--2 = 1968-W52-1 1968-W54--1 = 1968-W52-1 1968-W54-0 = 1968-W52-1 1968-W54-1 = 1968-W52-1 1968-W54-4 = 1968-W52-4 1968-W54-6 = 1968-W52-6 1968-W54-7 = 1968-W52-7 1968-W54-8 = 1968-W52-7 1968-W54-9 = 1968-W52-7 1969-W-20--2 = 1969-W01-1 1969-W-20--1 = 1969-W01-1 1969-W-20-0 = 1969-W01-1 1969-W-20-1 = 1969-W01-1 1969-W-20-4 = 1969-W01-4 1969-W-20-6 = 1969-W01-6 1969-W-20-7 = 1969-W01-7 1969-W-20-8 = 1969-W01-7 1969-W-20-9 = 1969-W01-7 1969-W-1--2 = 1969-W01-1 1969-W-1--1 = 1969-W01-1 1969-W-1-0 = 1969-W01-1 1969-W-1-1 = 1969-W01-1 1969-W-1-4 = 1969-W01-4 1969-W-1-6 = 1969-W01-6 1969-W-1-7 = 1969-W01-7 1969-W-1-8 = 1969-W01-7 1969-W-1-9 = 1969-W01-7 1969-W0--2 = 1969-W01-1 1969-W0--1 = 1969-W01-1 1969-W0-0 = 1969-W01-1 1969-W0-1 = 1969-W01-1 1969-W0-4 = 1969-W01-4 1969-W0-6 = 1969-W01-6 1969-W0-7 = 1969-W01-7 1969-W0-8 = 1969-W01-7 1969-W0-9 = 1969-W01-7 1969-W1--2 = 1969-W01-1 1969-W1--1 = 1969-W01-1 1969-W1-0 = 1969-W01-1 1969-W1-1 = 1969-W01-1 1969-W1-4 = 1969-W01-4 1969-W1-6 = 1969-W01-6 1969-W1-7 = 1969-W01-7 1969-W1-8 = 1969-W01-7 1969-W1-9 = 1969-W01-7 1969-W20--2 = 1969-W20-1 1969-W20--1 = 1969-W20-1 1969-W20-0 = 1969-W20-1 1969-W20-1 = 1969-W20-1 1969-W20-4 = 1969-W20-4 1969-W20-6 = 1969-W20-6 1969-W20-7 = 1969-W20-7 1969-W20-8 = 1969-W20-7 1969-W20-9 = 1969-W20-7 1969-W51--2 = 1969-W51-1 1969-W51--1 = 1969-W51-1 1969-W51-0 = 1969-W51-1 1969-W51-1 = 1969-W51-1 1969-W51-4 = 1969-W51-4 1969-W51-6 = 1969-W51-6 1969-W51-7 = 1969-W51-7 1969-W51-8 = 1969-W51-7 1969-W51-9 = 1969-W51-7 1969-W52--2 = 1969-W52-1 1969-W52--1 = 1969-W52-1 1969-W52-0 = 1969-W52-1 1969-W52-1 = 1969-W52-1 1969-W52-4 = 1969-W52-4 1969-W52-6 = 1969-W52-6 1969-W52-7 = 1969-W52-7 1969-W52-8 = 1969-W52-7 1969-W52-9 = 1969-W52-7 1969-W53--2 = 1969-W52-1 1969-W53--1 = 1969-W52-1 1969-W53-0 = 1969-W52-1 1969-W53-1 = 1969-W52-1 1969-W53-4 = 1969-W52-4 1969-W53-6 = 1969-W52-6 1969-W53-7 = 1969-W52-7 1969-W53-8 = 1969-W52-7 1969-W53-9 = 1969-W52-7 1969-W54--2 = 1969-W52-1 1969-W54--1 = 1969-W52-1 1969-W54-0 = 1969-W52-1 1969-W54-1 = 1969-W52-1 1969-W54-4 = 1969-W52-4 1969-W54-6 = 1969-W52-6 1969-W54-7 = 1969-W52-7 1969-W54-8 = 1969-W52-7 1969-W54-9 = 1969-W52-7 2004-W-20--2 = 2004-W01-1 2004-W-20--1 = 2004-W01-1 2004-W-20-0 = 2004-W01-1 2004-W-20-1 = 2004-W01-1 2004-W-20-4 = 2004-W01-4 2004-W-20-6 = 2004-W01-6 2004-W-20-7 = 2004-W01-7 2004-W-20-8 = 2004-W01-7 2004-W-20-9 = 2004-W01-7 2004-W-1--2 = 2004-W01-1 2004-W-1--1 = 2004-W01-1 2004-W-1-0 = 2004-W01-1 2004-W-1-1 = 2004-W01-1 2004-W-1-4 = 2004-W01-4 2004-W-1-6 = 2004-W01-6 2004-W-1-7 = 2004-W01-7 2004-W-1-8 = 2004-W01-7 2004-W-1-9 = 2004-W01-7 2004-W0--2 = 2004-W01-1 2004-W0--1 = 2004-W01-1 2004-W0-0 = 2004-W01-1 2004-W0-1 = 2004-W01-1 2004-W0-4 = 2004-W01-4 2004-W0-6 = 2004-W01-6 2004-W0-7 = 2004-W01-7 2004-W0-8 = 2004-W01-7 2004-W0-9 = 2004-W01-7 2004-W1--2 = 2004-W01-1 2004-W1--1 = 2004-W01-1 2004-W1-0 = 2004-W01-1 2004-W1-1 = 2004-W01-1 2004-W1-4 = 2004-W01-4 2004-W1-6 = 2004-W01-6 2004-W1-7 = 2004-W01-7 2004-W1-8 = 2004-W01-7 2004-W1-9 = 2004-W01-7 2004-W20--2 = 2004-W20-1 2004-W20--1 = 2004-W20-1 2004-W20-0 = 2004-W20-1 2004-W20-1 = 2004-W20-1 2004-W20-4 = 2004-W20-4 2004-W20-6 = 2004-W20-6 2004-W20-7 = 2004-W20-7 2004-W20-8 = 2004-W20-7 2004-W20-9 = 2004-W20-7 2004-W51--2 = 2004-W51-1 2004-W51--1 = 2004-W51-1 2004-W51-0 = 2004-W51-1 2004-W51-1 = 2004-W51-1 2004-W51-4 = 2004-W51-4 2004-W51-6 = 2004-W51-6 2004-W51-7 = 2004-W51-7 2004-W51-8 = 2004-W51-7 2004-W51-9 = 2004-W51-7 2004-W52--2 = 2004-W52-1 2004-W52--1 = 2004-W52-1 2004-W52-0 = 2004-W52-1 2004-W52-1 = 2004-W52-1 2004-W52-4 = 2004-W52-4 2004-W52-6 = 2004-W52-6 2004-W52-7 = 2004-W52-7 2004-W52-8 = 2004-W52-7 2004-W52-9 = 2004-W52-7 2004-W53--2 = 2004-W53-1 2004-W53--1 = 2004-W53-1 2004-W53-0 = 2004-W53-1 2004-W53-1 = 2004-W53-1 2004-W53-4 = 2004-W53-4 2004-W53-6 = 2004-W53-6 2004-W53-7 = 2004-W53-7 2004-W53-8 = 2004-W53-7 2004-W53-9 = 2004-W53-7 2004-W54--2 = 2004-W53-1 2004-W54--1 = 2004-W53-1 2004-W54-0 = 2004-W53-1 2004-W54-1 = 2004-W53-1 2004-W54-4 = 2004-W53-4 2004-W54-6 = 2004-W53-6 2004-W54-7 = 2004-W53-7 2004-W54-8 = 2004-W53-7 2004-W54-9 = 2004-W53-7 hugs98-plus-Sep2006/packages/time/time/test/LongWeekYears.ref0000644006511100651110000000250610504340546022635 0ustar rossross1901: 1902: 1903: * 1904: L 1905: 1906: 1907: 1908: L* 1909: 1910: 1911: 1912: L 1913: 1914: * 1915: 1916: L 1917: 1918: 1919: 1920: L* 1921: 1922: 1923: 1924: L 1925: * 1926: 1927: 1928: L 1929: 1930: 1931: * 1932: L 1933: 1934: 1935: 1936: L* 1937: 1938: 1939: 1940: L 1941: 1942: * 1943: 1944: L 1945: 1946: 1947: 1948: L* 1949: 1950: 1951: 1952: L 1953: * 1954: 1955: 1956: L 1957: 1958: 1959: * 1960: L 1961: 1962: 1963: 1964: L* 1965: 1966: 1967: 1968: L 1969: 1970: * 1971: 1972: L 1973: 1974: 1975: 1976: L* 1977: 1978: 1979: 1980: L 1981: * 1982: 1983: 1984: L 1985: 1986: 1987: * 1988: L 1989: 1990: 1991: 1992: L* 1993: 1994: 1995: 1996: L 1997: 1998: * 1999: 2000: L 2001: 2002: 2003: 2004: L* 2005: 2006: 2007: 2008: L 2009: * 2010: 2011: 2012: L 2013: 2014: 2015: * 2016: L 2017: 2018: 2019: 2020: L* 2021: 2022: 2023: 2024: L 2025: 2026: * 2027: 2028: L 2029: 2030: 2031: 2032: L* 2033: 2034: 2035: 2036: L 2037: * 2038: 2039: 2040: L 2041: 2042: 2043: * 2044: L 2045: 2046: 2047: 2048: L* 2049: 2050: hugs98-plus-Sep2006/packages/time/time/test/AddDays.hs0000644006511100651110000000160610504340546021265 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time.Calendar import Control.Monad days ::[Day] days = [ fromGregorian 2005 2 28, fromGregorian 2004 2 29, fromGregorian 2004 1 31, fromGregorian 2004 12 31, fromGregorian 2005 7 1, fromGregorian 2005 4 21, fromGregorian 2005 6 30 ] increments :: [Integer] increments = [-10,-4,-1,0,1,7,83] adders :: [(String,Integer -> Day -> Day)] adders = [ ("day",addDays), ("month (clip)",addGregorianMonthsClip), ("month (roll over)",addGregorianMonthsRollOver), ("year (clip)",addGregorianYearsClip), ("year (roll over)",addGregorianYearsRollOver) ] resultDays :: [String] resultDays = do (aname,adder) <- adders increment <- increments day <- days return ((showGregorian day) ++ " + " ++ (show increment) ++ " * " ++ aname ++ " = " ++ showGregorian (adder increment day)) main :: IO () main = do mapM_ putStrLn resultDays hugs98-plus-Sep2006/packages/time/time/test/AddDays.ref0000644006511100651110000002464510504340546021437 0ustar rossross2005-02-28 + -10 * day = 2005-02-18 2004-02-29 + -10 * day = 2004-02-19 2004-01-31 + -10 * day = 2004-01-21 2004-12-31 + -10 * day = 2004-12-21 2005-07-01 + -10 * day = 2005-06-21 2005-04-21 + -10 * day = 2005-04-11 2005-06-30 + -10 * day = 2005-06-20 2005-02-28 + -4 * day = 2005-02-24 2004-02-29 + -4 * day = 2004-02-25 2004-01-31 + -4 * day = 2004-01-27 2004-12-31 + -4 * day = 2004-12-27 2005-07-01 + -4 * day = 2005-06-27 2005-04-21 + -4 * day = 2005-04-17 2005-06-30 + -4 * day = 2005-06-26 2005-02-28 + -1 * day = 2005-02-27 2004-02-29 + -1 * day = 2004-02-28 2004-01-31 + -1 * day = 2004-01-30 2004-12-31 + -1 * day = 2004-12-30 2005-07-01 + -1 * day = 2005-06-30 2005-04-21 + -1 * day = 2005-04-20 2005-06-30 + -1 * day = 2005-06-29 2005-02-28 + 0 * day = 2005-02-28 2004-02-29 + 0 * day = 2004-02-29 2004-01-31 + 0 * day = 2004-01-31 2004-12-31 + 0 * day = 2004-12-31 2005-07-01 + 0 * day = 2005-07-01 2005-04-21 + 0 * day = 2005-04-21 2005-06-30 + 0 * day = 2005-06-30 2005-02-28 + 1 * day = 2005-03-01 2004-02-29 + 1 * day = 2004-03-01 2004-01-31 + 1 * day = 2004-02-01 2004-12-31 + 1 * day = 2005-01-01 2005-07-01 + 1 * day = 2005-07-02 2005-04-21 + 1 * day = 2005-04-22 2005-06-30 + 1 * day = 2005-07-01 2005-02-28 + 7 * day = 2005-03-07 2004-02-29 + 7 * day = 2004-03-07 2004-01-31 + 7 * day = 2004-02-07 2004-12-31 + 7 * day = 2005-01-07 2005-07-01 + 7 * day = 2005-07-08 2005-04-21 + 7 * day = 2005-04-28 2005-06-30 + 7 * day = 2005-07-07 2005-02-28 + 83 * day = 2005-05-22 2004-02-29 + 83 * day = 2004-05-22 2004-01-31 + 83 * day = 2004-04-23 2004-12-31 + 83 * day = 2005-03-24 2005-07-01 + 83 * day = 2005-09-22 2005-04-21 + 83 * day = 2005-07-13 2005-06-30 + 83 * day = 2005-09-21 2005-02-28 + -10 * month (clip) = 2004-04-28 2004-02-29 + -10 * month (clip) = 2003-04-29 2004-01-31 + -10 * month (clip) = 2003-03-31 2004-12-31 + -10 * month (clip) = 2004-02-29 2005-07-01 + -10 * month (clip) = 2004-09-01 2005-04-21 + -10 * month (clip) = 2004-06-21 2005-06-30 + -10 * month (clip) = 2004-08-30 2005-02-28 + -4 * month (clip) = 2004-10-28 2004-02-29 + -4 * month (clip) = 2003-10-29 2004-01-31 + -4 * month (clip) = 2003-09-30 2004-12-31 + -4 * month (clip) = 2004-08-31 2005-07-01 + -4 * month (clip) = 2005-03-01 2005-04-21 + -4 * month (clip) = 2004-12-21 2005-06-30 + -4 * month (clip) = 2005-02-28 2005-02-28 + -1 * month (clip) = 2005-01-28 2004-02-29 + -1 * month (clip) = 2004-01-29 2004-01-31 + -1 * month (clip) = 2003-12-31 2004-12-31 + -1 * month (clip) = 2004-11-30 2005-07-01 + -1 * month (clip) = 2005-06-01 2005-04-21 + -1 * month (clip) = 2005-03-21 2005-06-30 + -1 * month (clip) = 2005-05-30 2005-02-28 + 0 * month (clip) = 2005-02-28 2004-02-29 + 0 * month (clip) = 2004-02-29 2004-01-31 + 0 * month (clip) = 2004-01-31 2004-12-31 + 0 * month (clip) = 2004-12-31 2005-07-01 + 0 * month (clip) = 2005-07-01 2005-04-21 + 0 * month (clip) = 2005-04-21 2005-06-30 + 0 * month (clip) = 2005-06-30 2005-02-28 + 1 * month (clip) = 2005-03-28 2004-02-29 + 1 * month (clip) = 2004-03-29 2004-01-31 + 1 * month (clip) = 2004-02-29 2004-12-31 + 1 * month (clip) = 2005-01-31 2005-07-01 + 1 * month (clip) = 2005-08-01 2005-04-21 + 1 * month (clip) = 2005-05-21 2005-06-30 + 1 * month (clip) = 2005-07-30 2005-02-28 + 7 * month (clip) = 2005-09-28 2004-02-29 + 7 * month (clip) = 2004-09-29 2004-01-31 + 7 * month (clip) = 2004-08-31 2004-12-31 + 7 * month (clip) = 2005-07-31 2005-07-01 + 7 * month (clip) = 2006-02-01 2005-04-21 + 7 * month (clip) = 2005-11-21 2005-06-30 + 7 * month (clip) = 2006-01-30 2005-02-28 + 83 * month (clip) = 2012-01-28 2004-02-29 + 83 * month (clip) = 2011-01-29 2004-01-31 + 83 * month (clip) = 2010-12-31 2004-12-31 + 83 * month (clip) = 2011-11-30 2005-07-01 + 83 * month (clip) = 2012-06-01 2005-04-21 + 83 * month (clip) = 2012-03-21 2005-06-30 + 83 * month (clip) = 2012-05-30 2005-02-28 + -10 * month (roll over) = 2004-04-28 2004-02-29 + -10 * month (roll over) = 2003-04-29 2004-01-31 + -10 * month (roll over) = 2003-03-31 2004-12-31 + -10 * month (roll over) = 2004-03-02 2005-07-01 + -10 * month (roll over) = 2004-09-01 2005-04-21 + -10 * month (roll over) = 2004-06-21 2005-06-30 + -10 * month (roll over) = 2004-08-30 2005-02-28 + -4 * month (roll over) = 2004-10-28 2004-02-29 + -4 * month (roll over) = 2003-10-29 2004-01-31 + -4 * month (roll over) = 2003-10-01 2004-12-31 + -4 * month (roll over) = 2004-08-31 2005-07-01 + -4 * month (roll over) = 2005-03-01 2005-04-21 + -4 * month (roll over) = 2004-12-21 2005-06-30 + -4 * month (roll over) = 2005-03-02 2005-02-28 + -1 * month (roll over) = 2005-01-28 2004-02-29 + -1 * month (roll over) = 2004-01-29 2004-01-31 + -1 * month (roll over) = 2003-12-31 2004-12-31 + -1 * month (roll over) = 2004-12-01 2005-07-01 + -1 * month (roll over) = 2005-06-01 2005-04-21 + -1 * month (roll over) = 2005-03-21 2005-06-30 + -1 * month (roll over) = 2005-05-30 2005-02-28 + 0 * month (roll over) = 2005-02-28 2004-02-29 + 0 * month (roll over) = 2004-02-29 2004-01-31 + 0 * month (roll over) = 2004-01-31 2004-12-31 + 0 * month (roll over) = 2004-12-31 2005-07-01 + 0 * month (roll over) = 2005-07-01 2005-04-21 + 0 * month (roll over) = 2005-04-21 2005-06-30 + 0 * month (roll over) = 2005-06-30 2005-02-28 + 1 * month (roll over) = 2005-03-28 2004-02-29 + 1 * month (roll over) = 2004-03-29 2004-01-31 + 1 * month (roll over) = 2004-03-02 2004-12-31 + 1 * month (roll over) = 2005-01-31 2005-07-01 + 1 * month (roll over) = 2005-08-01 2005-04-21 + 1 * month (roll over) = 2005-05-21 2005-06-30 + 1 * month (roll over) = 2005-07-30 2005-02-28 + 7 * month (roll over) = 2005-09-28 2004-02-29 + 7 * month (roll over) = 2004-09-29 2004-01-31 + 7 * month (roll over) = 2004-08-31 2004-12-31 + 7 * month (roll over) = 2005-07-31 2005-07-01 + 7 * month (roll over) = 2006-02-01 2005-04-21 + 7 * month (roll over) = 2005-11-21 2005-06-30 + 7 * month (roll over) = 2006-01-30 2005-02-28 + 83 * month (roll over) = 2012-01-28 2004-02-29 + 83 * month (roll over) = 2011-01-29 2004-01-31 + 83 * month (roll over) = 2010-12-31 2004-12-31 + 83 * month (roll over) = 2011-12-01 2005-07-01 + 83 * month (roll over) = 2012-06-01 2005-04-21 + 83 * month (roll over) = 2012-03-21 2005-06-30 + 83 * month (roll over) = 2012-05-30 2005-02-28 + -10 * year (clip) = 1995-02-28 2004-02-29 + -10 * year (clip) = 1994-02-28 2004-01-31 + -10 * year (clip) = 1994-01-31 2004-12-31 + -10 * year (clip) = 1994-12-31 2005-07-01 + -10 * year (clip) = 1995-07-01 2005-04-21 + -10 * year (clip) = 1995-04-21 2005-06-30 + -10 * year (clip) = 1995-06-30 2005-02-28 + -4 * year (clip) = 2001-02-28 2004-02-29 + -4 * year (clip) = 2000-02-29 2004-01-31 + -4 * year (clip) = 2000-01-31 2004-12-31 + -4 * year (clip) = 2000-12-31 2005-07-01 + -4 * year (clip) = 2001-07-01 2005-04-21 + -4 * year (clip) = 2001-04-21 2005-06-30 + -4 * year (clip) = 2001-06-30 2005-02-28 + -1 * year (clip) = 2004-02-28 2004-02-29 + -1 * year (clip) = 2003-02-28 2004-01-31 + -1 * year (clip) = 2003-01-31 2004-12-31 + -1 * year (clip) = 2003-12-31 2005-07-01 + -1 * year (clip) = 2004-07-01 2005-04-21 + -1 * year (clip) = 2004-04-21 2005-06-30 + -1 * year (clip) = 2004-06-30 2005-02-28 + 0 * year (clip) = 2005-02-28 2004-02-29 + 0 * year (clip) = 2004-02-29 2004-01-31 + 0 * year (clip) = 2004-01-31 2004-12-31 + 0 * year (clip) = 2004-12-31 2005-07-01 + 0 * year (clip) = 2005-07-01 2005-04-21 + 0 * year (clip) = 2005-04-21 2005-06-30 + 0 * year (clip) = 2005-06-30 2005-02-28 + 1 * year (clip) = 2006-02-28 2004-02-29 + 1 * year (clip) = 2005-02-28 2004-01-31 + 1 * year (clip) = 2005-01-31 2004-12-31 + 1 * year (clip) = 2005-12-31 2005-07-01 + 1 * year (clip) = 2006-07-01 2005-04-21 + 1 * year (clip) = 2006-04-21 2005-06-30 + 1 * year (clip) = 2006-06-30 2005-02-28 + 7 * year (clip) = 2012-02-28 2004-02-29 + 7 * year (clip) = 2011-02-28 2004-01-31 + 7 * year (clip) = 2011-01-31 2004-12-31 + 7 * year (clip) = 2011-12-31 2005-07-01 + 7 * year (clip) = 2012-07-01 2005-04-21 + 7 * year (clip) = 2012-04-21 2005-06-30 + 7 * year (clip) = 2012-06-30 2005-02-28 + 83 * year (clip) = 2088-02-28 2004-02-29 + 83 * year (clip) = 2087-02-28 2004-01-31 + 83 * year (clip) = 2087-01-31 2004-12-31 + 83 * year (clip) = 2087-12-31 2005-07-01 + 83 * year (clip) = 2088-07-01 2005-04-21 + 83 * year (clip) = 2088-04-21 2005-06-30 + 83 * year (clip) = 2088-06-30 2005-02-28 + -10 * year (roll over) = 1995-02-28 2004-02-29 + -10 * year (roll over) = 1994-03-01 2004-01-31 + -10 * year (roll over) = 1994-01-31 2004-12-31 + -10 * year (roll over) = 1994-12-31 2005-07-01 + -10 * year (roll over) = 1995-07-01 2005-04-21 + -10 * year (roll over) = 1995-04-21 2005-06-30 + -10 * year (roll over) = 1995-06-30 2005-02-28 + -4 * year (roll over) = 2001-02-28 2004-02-29 + -4 * year (roll over) = 2000-02-29 2004-01-31 + -4 * year (roll over) = 2000-01-31 2004-12-31 + -4 * year (roll over) = 2000-12-31 2005-07-01 + -4 * year (roll over) = 2001-07-01 2005-04-21 + -4 * year (roll over) = 2001-04-21 2005-06-30 + -4 * year (roll over) = 2001-06-30 2005-02-28 + -1 * year (roll over) = 2004-02-28 2004-02-29 + -1 * year (roll over) = 2003-03-01 2004-01-31 + -1 * year (roll over) = 2003-01-31 2004-12-31 + -1 * year (roll over) = 2003-12-31 2005-07-01 + -1 * year (roll over) = 2004-07-01 2005-04-21 + -1 * year (roll over) = 2004-04-21 2005-06-30 + -1 * year (roll over) = 2004-06-30 2005-02-28 + 0 * year (roll over) = 2005-02-28 2004-02-29 + 0 * year (roll over) = 2004-02-29 2004-01-31 + 0 * year (roll over) = 2004-01-31 2004-12-31 + 0 * year (roll over) = 2004-12-31 2005-07-01 + 0 * year (roll over) = 2005-07-01 2005-04-21 + 0 * year (roll over) = 2005-04-21 2005-06-30 + 0 * year (roll over) = 2005-06-30 2005-02-28 + 1 * year (roll over) = 2006-02-28 2004-02-29 + 1 * year (roll over) = 2005-03-01 2004-01-31 + 1 * year (roll over) = 2005-01-31 2004-12-31 + 1 * year (roll over) = 2005-12-31 2005-07-01 + 1 * year (roll over) = 2006-07-01 2005-04-21 + 1 * year (roll over) = 2006-04-21 2005-06-30 + 1 * year (roll over) = 2006-06-30 2005-02-28 + 7 * year (roll over) = 2012-02-28 2004-02-29 + 7 * year (roll over) = 2011-03-01 2004-01-31 + 7 * year (roll over) = 2011-01-31 2004-12-31 + 7 * year (roll over) = 2011-12-31 2005-07-01 + 7 * year (roll over) = 2012-07-01 2005-04-21 + 7 * year (roll over) = 2012-04-21 2005-06-30 + 7 * year (roll over) = 2012-06-30 2005-02-28 + 83 * year (roll over) = 2088-02-28 2004-02-29 + 83 * year (roll over) = 2087-03-01 2004-01-31 + 83 * year (roll over) = 2087-01-31 2004-12-31 + 83 * year (roll over) = 2087-12-31 2005-07-01 + 83 * year (roll over) = 2088-07-01 2005-04-21 + 83 * year (roll over) = 2088-04-21 2005-06-30 + 83 * year (roll over) = 2088-06-30 hugs98-plus-Sep2006/packages/time/time/test/UseCases.lhs0000644006511100651110000000542210504340546021643 0ustar rossross> module UseCases where > import Data.Time.Calendar.OrdinalDate > import Data.Time > import System.Locale From Brian Smith: Use cases (primarily taken from real-world corporate IT applications I have developed) : * What is the equivalent (or closest aproximation) of the SQL DateTime type (date and time without any timezone information)? What is the equivalent of the SQL Date type (date without any timezone information)? > type SQLDateTime = LocalTime > type SQLDate = Day * The user enters a date as "7/4/2005." How do I determine if this date is before or after July 1st of this year? TODO: Parsing * How do I present the date "July 1st of this year" to the user in M/D/YYYY format? > july1st = do > now <- getZonedTime > let (thisYear,_,_) = toGregorian (localDay (zonedTimeToLocalTime now)) > let day = fromGregorian thisYear 7 1 > return (formatTime defaultTimeLocale "%m/%d/%Y" day) This actually gives "07/01/2005" rather than "7/1/2005". ISSUE: Should I make additional %-codes for this? * How do I truncate a datetime to midnight of the same day? How do I truncate a date to the first of the month? How do I truncate a date to the first day of the year it occurred in? > truncateToMidnight (LocalTime day _) = (LocalTime day midnight) > truncateToFirstOfMonth day = fromGregorian y m 1 where > (y,m,_) = toGregorian day > truncateToJan1st day = fromOrdinalDate y 1 where > (y,_) = toOrdinalDate day * Given a date X, how do I find the last day of the month that X occurs in. For example, If X is July 4th, 2005, then I want the result to be July 31st, 2005. If X is Februrary 5, then I want the result to be Februrary 28 for non-leap-years and February 29 for leap years. > lastDayOfMonth day = fromGregorian y m (gregorianMonthLength y m) where > (y,m,_) = toGregorian day * The user enters a time T with no date, e.g. "17:30". How do I merge this time onto a date D (e.g. July 4, 2005), so that the result has is a datetime with date D and the time T (July 4, 2005 at 17:30). > mergeDateAndTime = LocalTime * Given two datetimes T1, T2, how do I determine if they are on the same date? > sameDay (LocalTime d1 _) (LocalTime d2 _) = d1 == d2 From Simon Marlow: I just had a little look around, mainly at System.Time.Calendar. I think the structure is rather complicated - I wanted to find out how to get a CalendarTime for "this time tomorrow", and ended up with this: *System.Time.Calendar> let c' = c{ztTime=zttime{dtDay=dtday{gregDay=day+1}}} where { zttime = ztTime c; dtday = dtDay zttime; day = gregDay dtday } > thisTimeTomorrow (ZonedTime (LocalTime day tod) zone) = (ZonedTime (LocalTime (addDays 1 day) tod) zone) hugs98-plus-Sep2006/packages/time/time/test/TestParseDAT.hs0000644006511100651110000000270010504340546022213 0ustar rossross{-# OPTIONS -ffi -Wall -Werror #-} module Main where import Data.Time import Data.Time.Clock.TAI import System.IO hSafeGetContents :: Handle -> IO String hSafeGetContents h = do eof <- hIsEOF h if eof then return [] else do c <- hGetChar h cs <- hSafeGetContents h return (c:cs) tods :: [TimeOfDay] tods = [ TimeOfDay 0 0 0, TimeOfDay 0 0 0.5, TimeOfDay 0 0 1, TimeOfDay 0 0 1.5, TimeOfDay 0 0 2, TimeOfDay 23 59 28, TimeOfDay 23 59 28.5, TimeOfDay 23 59 29, TimeOfDay 23 59 29.5, TimeOfDay 23 59 30, TimeOfDay 23 59 30.5, TimeOfDay 23 59 31, TimeOfDay 23 59 31.5, TimeOfDay 23 59 32, TimeOfDay 23 59 59, TimeOfDay 23 59 59.5, TimeOfDay 23 59 60, TimeOfDay 23 59 60.5 ] times :: [LocalTime] times = fmap (LocalTime (fromGregorian 1998 04 02)) tods ++ fmap (LocalTime (fromGregorian 1998 12 30)) tods ++ fmap (LocalTime (fromGregorian 1998 12 31)) tods ++ fmap (LocalTime (fromGregorian 1999 01 01)) tods ++ fmap (LocalTime (fromGregorian 1999 01 02)) tods main :: IO () main = do h <- openFile "tai-utc.dat" ReadMode s <- hSafeGetContents h hClose h let lst = parseTAIUTCDATFile s mapM_ (\lt -> do let utcTime = localTimeToUTC utc lt let taiTime = utcToTAITime lst utcTime let utcTime' = taiToUTCTime lst taiTime if utcTime == utcTime' then putStrLn ((show utcTime) ++ " == " ++ (show taiTime)) else putStrLn ("correction: " ++ (show utcTime) ++ " -> " ++ (show taiTime) ++ " -> " ++ (show utcTime')) ) times hugs98-plus-Sep2006/packages/time/time/test/TestParseDAT.ref0000644006511100651110000001171610504340546022364 0ustar rossross1998-04-02 00:00:00 UTC == 1998-04-02 00:00:31 TAI 1998-04-02 00:00:00.5 UTC == 1998-04-02 00:00:31.5 TAI 1998-04-02 00:00:01 UTC == 1998-04-02 00:00:32 TAI 1998-04-02 00:00:01.5 UTC == 1998-04-02 00:00:32.5 TAI 1998-04-02 00:00:02 UTC == 1998-04-02 00:00:33 TAI 1998-04-02 23:59:28 UTC == 1998-04-02 23:59:59 TAI 1998-04-02 23:59:28.5 UTC == 1998-04-02 23:59:59.5 TAI 1998-04-02 23:59:29 UTC == 1998-04-03 00:00:00 TAI 1998-04-02 23:59:29.5 UTC == 1998-04-03 00:00:00.5 TAI 1998-04-02 23:59:30 UTC == 1998-04-03 00:00:01 TAI 1998-04-02 23:59:30.5 UTC == 1998-04-03 00:00:01.5 TAI 1998-04-02 23:59:31 UTC == 1998-04-03 00:00:02 TAI 1998-04-02 23:59:31.5 UTC == 1998-04-03 00:00:02.5 TAI 1998-04-02 23:59:32 UTC == 1998-04-03 00:00:03 TAI 1998-04-02 23:59:59 UTC == 1998-04-03 00:00:30 TAI 1998-04-02 23:59:59.5 UTC == 1998-04-03 00:00:30.5 TAI correction: 1998-04-02 23:59:60 UTC -> 1998-04-03 00:00:31 TAI -> 1998-04-03 00:00:00 UTC correction: 1998-04-02 23:59:60.5 UTC -> 1998-04-03 00:00:31.5 TAI -> 1998-04-03 00:00:00.5 UTC 1998-12-30 00:00:00 UTC == 1998-12-30 00:00:31 TAI 1998-12-30 00:00:00.5 UTC == 1998-12-30 00:00:31.5 TAI 1998-12-30 00:00:01 UTC == 1998-12-30 00:00:32 TAI 1998-12-30 00:00:01.5 UTC == 1998-12-30 00:00:32.5 TAI 1998-12-30 00:00:02 UTC == 1998-12-30 00:00:33 TAI 1998-12-30 23:59:28 UTC == 1998-12-30 23:59:59 TAI 1998-12-30 23:59:28.5 UTC == 1998-12-30 23:59:59.5 TAI 1998-12-30 23:59:29 UTC == 1998-12-31 00:00:00 TAI 1998-12-30 23:59:29.5 UTC == 1998-12-31 00:00:00.5 TAI 1998-12-30 23:59:30 UTC == 1998-12-31 00:00:01 TAI 1998-12-30 23:59:30.5 UTC == 1998-12-31 00:00:01.5 TAI 1998-12-30 23:59:31 UTC == 1998-12-31 00:00:02 TAI 1998-12-30 23:59:31.5 UTC == 1998-12-31 00:00:02.5 TAI 1998-12-30 23:59:32 UTC == 1998-12-31 00:00:03 TAI 1998-12-30 23:59:59 UTC == 1998-12-31 00:00:30 TAI 1998-12-30 23:59:59.5 UTC == 1998-12-31 00:00:30.5 TAI correction: 1998-12-30 23:59:60 UTC -> 1998-12-31 00:00:31 TAI -> 1998-12-31 00:00:00 UTC correction: 1998-12-30 23:59:60.5 UTC -> 1998-12-31 00:00:31.5 TAI -> 1998-12-31 00:00:00.5 UTC 1998-12-31 00:00:00 UTC == 1998-12-31 00:00:31 TAI 1998-12-31 00:00:00.5 UTC == 1998-12-31 00:00:31.5 TAI 1998-12-31 00:00:01 UTC == 1998-12-31 00:00:32 TAI 1998-12-31 00:00:01.5 UTC == 1998-12-31 00:00:32.5 TAI 1998-12-31 00:00:02 UTC == 1998-12-31 00:00:33 TAI 1998-12-31 23:59:28 UTC == 1998-12-31 23:59:59 TAI 1998-12-31 23:59:28.5 UTC == 1998-12-31 23:59:59.5 TAI 1998-12-31 23:59:29 UTC == 1999-01-01 00:00:00 TAI 1998-12-31 23:59:29.5 UTC == 1999-01-01 00:00:00.5 TAI 1998-12-31 23:59:30 UTC == 1999-01-01 00:00:01 TAI 1998-12-31 23:59:30.5 UTC == 1999-01-01 00:00:01.5 TAI 1998-12-31 23:59:31 UTC == 1999-01-01 00:00:02 TAI 1998-12-31 23:59:31.5 UTC == 1999-01-01 00:00:02.5 TAI 1998-12-31 23:59:32 UTC == 1999-01-01 00:00:03 TAI 1998-12-31 23:59:59 UTC == 1999-01-01 00:00:30 TAI 1998-12-31 23:59:59.5 UTC == 1999-01-01 00:00:30.5 TAI 1998-12-31 23:59:60 UTC == 1999-01-01 00:00:31 TAI 1998-12-31 23:59:60.5 UTC == 1999-01-01 00:00:31.5 TAI 1999-01-01 00:00:00 UTC == 1999-01-01 00:00:32 TAI 1999-01-01 00:00:00.5 UTC == 1999-01-01 00:00:32.5 TAI 1999-01-01 00:00:01 UTC == 1999-01-01 00:00:33 TAI 1999-01-01 00:00:01.5 UTC == 1999-01-01 00:00:33.5 TAI 1999-01-01 00:00:02 UTC == 1999-01-01 00:00:34 TAI 1999-01-01 23:59:28 UTC == 1999-01-02 00:00:00 TAI 1999-01-01 23:59:28.5 UTC == 1999-01-02 00:00:00.5 TAI 1999-01-01 23:59:29 UTC == 1999-01-02 00:00:01 TAI 1999-01-01 23:59:29.5 UTC == 1999-01-02 00:00:01.5 TAI 1999-01-01 23:59:30 UTC == 1999-01-02 00:00:02 TAI 1999-01-01 23:59:30.5 UTC == 1999-01-02 00:00:02.5 TAI 1999-01-01 23:59:31 UTC == 1999-01-02 00:00:03 TAI 1999-01-01 23:59:31.5 UTC == 1999-01-02 00:00:03.5 TAI 1999-01-01 23:59:32 UTC == 1999-01-02 00:00:04 TAI 1999-01-01 23:59:59 UTC == 1999-01-02 00:00:31 TAI 1999-01-01 23:59:59.5 UTC == 1999-01-02 00:00:31.5 TAI correction: 1999-01-01 23:59:60 UTC -> 1999-01-02 00:00:32 TAI -> 1999-01-02 00:00:00 UTC correction: 1999-01-01 23:59:60.5 UTC -> 1999-01-02 00:00:32.5 TAI -> 1999-01-02 00:00:00.5 UTC 1999-01-02 00:00:00 UTC == 1999-01-02 00:00:32 TAI 1999-01-02 00:00:00.5 UTC == 1999-01-02 00:00:32.5 TAI 1999-01-02 00:00:01 UTC == 1999-01-02 00:00:33 TAI 1999-01-02 00:00:01.5 UTC == 1999-01-02 00:00:33.5 TAI 1999-01-02 00:00:02 UTC == 1999-01-02 00:00:34 TAI 1999-01-02 23:59:28 UTC == 1999-01-03 00:00:00 TAI 1999-01-02 23:59:28.5 UTC == 1999-01-03 00:00:00.5 TAI 1999-01-02 23:59:29 UTC == 1999-01-03 00:00:01 TAI 1999-01-02 23:59:29.5 UTC == 1999-01-03 00:00:01.5 TAI 1999-01-02 23:59:30 UTC == 1999-01-03 00:00:02 TAI 1999-01-02 23:59:30.5 UTC == 1999-01-03 00:00:02.5 TAI 1999-01-02 23:59:31 UTC == 1999-01-03 00:00:03 TAI 1999-01-02 23:59:31.5 UTC == 1999-01-03 00:00:03.5 TAI 1999-01-02 23:59:32 UTC == 1999-01-03 00:00:04 TAI 1999-01-02 23:59:59 UTC == 1999-01-03 00:00:31 TAI 1999-01-02 23:59:59.5 UTC == 1999-01-03 00:00:31.5 TAI correction: 1999-01-02 23:59:60 UTC -> 1999-01-03 00:00:32 TAI -> 1999-01-03 00:00:00 UTC correction: 1999-01-02 23:59:60.5 UTC -> 1999-01-03 00:00:32.5 TAI -> 1999-01-03 00:00:00.5 UTC hugs98-plus-Sep2006/packages/time/time/test/tai-utc.dat0000644006511100651110000000566510504340546021471 0ustar rossross 1961 JAN 1 =JD 2437300.5 TAI-UTC= 1.4228180 S + (MJD - 37300.) X 0.001296 S 1961 AUG 1 =JD 2437512.5 TAI-UTC= 1.3728180 S + (MJD - 37300.) X 0.001296 S 1962 JAN 1 =JD 2437665.5 TAI-UTC= 1.8458580 S + (MJD - 37665.) X 0.0011232S 1963 NOV 1 =JD 2438334.5 TAI-UTC= 1.9458580 S + (MJD - 37665.) X 0.0011232S 1964 JAN 1 =JD 2438395.5 TAI-UTC= 3.2401300 S + (MJD - 38761.) X 0.001296 S 1964 APR 1 =JD 2438486.5 TAI-UTC= 3.3401300 S + (MJD - 38761.) X 0.001296 S 1964 SEP 1 =JD 2438639.5 TAI-UTC= 3.4401300 S + (MJD - 38761.) X 0.001296 S 1965 JAN 1 =JD 2438761.5 TAI-UTC= 3.5401300 S + (MJD - 38761.) X 0.001296 S 1965 MAR 1 =JD 2438820.5 TAI-UTC= 3.6401300 S + (MJD - 38761.) X 0.001296 S 1965 JUL 1 =JD 2438942.5 TAI-UTC= 3.7401300 S + (MJD - 38761.) X 0.001296 S 1965 SEP 1 =JD 2439004.5 TAI-UTC= 3.8401300 S + (MJD - 38761.) X 0.001296 S 1966 JAN 1 =JD 2439126.5 TAI-UTC= 4.3131700 S + (MJD - 39126.) X 0.002592 S 1968 FEB 1 =JD 2439887.5 TAI-UTC= 4.2131700 S + (MJD - 39126.) X 0.002592 S 1972 JAN 1 =JD 2441317.5 TAI-UTC= 10.0 S + (MJD - 41317.) X 0.0 S 1972 JUL 1 =JD 2441499.5 TAI-UTC= 11.0 S + (MJD - 41317.) X 0.0 S 1973 JAN 1 =JD 2441683.5 TAI-UTC= 12.0 S + (MJD - 41317.) X 0.0 S 1974 JAN 1 =JD 2442048.5 TAI-UTC= 13.0 S + (MJD - 41317.) X 0.0 S 1975 JAN 1 =JD 2442413.5 TAI-UTC= 14.0 S + (MJD - 41317.) X 0.0 S 1976 JAN 1 =JD 2442778.5 TAI-UTC= 15.0 S + (MJD - 41317.) X 0.0 S 1977 JAN 1 =JD 2443144.5 TAI-UTC= 16.0 S + (MJD - 41317.) X 0.0 S 1978 JAN 1 =JD 2443509.5 TAI-UTC= 17.0 S + (MJD - 41317.) X 0.0 S 1979 JAN 1 =JD 2443874.5 TAI-UTC= 18.0 S + (MJD - 41317.) X 0.0 S 1980 JAN 1 =JD 2444239.5 TAI-UTC= 19.0 S + (MJD - 41317.) X 0.0 S 1981 JUL 1 =JD 2444786.5 TAI-UTC= 20.0 S + (MJD - 41317.) X 0.0 S 1982 JUL 1 =JD 2445151.5 TAI-UTC= 21.0 S + (MJD - 41317.) X 0.0 S 1983 JUL 1 =JD 2445516.5 TAI-UTC= 22.0 S + (MJD - 41317.) X 0.0 S 1985 JUL 1 =JD 2446247.5 TAI-UTC= 23.0 S + (MJD - 41317.) X 0.0 S 1988 JAN 1 =JD 2447161.5 TAI-UTC= 24.0 S + (MJD - 41317.) X 0.0 S 1990 JAN 1 =JD 2447892.5 TAI-UTC= 25.0 S + (MJD - 41317.) X 0.0 S 1991 JAN 1 =JD 2448257.5 TAI-UTC= 26.0 S + (MJD - 41317.) X 0.0 S 1992 JUL 1 =JD 2448804.5 TAI-UTC= 27.0 S + (MJD - 41317.) X 0.0 S 1993 JUL 1 =JD 2449169.5 TAI-UTC= 28.0 S + (MJD - 41317.) X 0.0 S 1994 JUL 1 =JD 2449534.5 TAI-UTC= 29.0 S + (MJD - 41317.) X 0.0 S 1996 JAN 1 =JD 2450083.5 TAI-UTC= 30.0 S + (MJD - 41317.) X 0.0 S 1997 JUL 1 =JD 2450630.5 TAI-UTC= 31.0 S + (MJD - 41317.) X 0.0 S 1999 JAN 1 =JD 2451179.5 TAI-UTC= 32.0 S + (MJD - 41317.) X 0.0 S 2006 JAN 1 =JD 2453736.5 TAI-UTC= 33.0 S + (MJD - 41317.) X 0.0 S hugs98-plus-Sep2006/packages/time/time/test/TestMonthDay.hs0000644006511100651110000000113210504340546022331 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time.Calendar.MonthDay showCompare :: (Eq a,Show a) => a -> String -> a -> String showCompare a1 b a2 | a1 == a2 = (show a1) ++ " == " ++ b showCompare a1 b a2 = "DIFF: " ++ (show a1) ++ " -> " ++ b ++ " -> " ++ (show a2) main :: IO () main = mapM_ (\isLeap -> do putStrLn (if isLeap then "Leap:" else "Regular:") mapM_ (\yd -> do let (m,d) = dayOfYearToMonthAndDay isLeap yd let yd' = monthAndDayToDayOfYear isLeap m d let mdtext = (show m) ++ "-" ++ (show d) putStrLn (showCompare yd mdtext yd') ) [-2..369] ) [False,True] hugs98-plus-Sep2006/packages/time/time/test/TestMonthDay.ref0000644006511100651110000002121510504340546022477 0ustar rossrossRegular: DIFF: -2 -> 1-1 -> 1 DIFF: -1 -> 1-1 -> 1 DIFF: 0 -> 1-1 -> 1 1 == 1-1 2 == 1-2 3 == 1-3 4 == 1-4 5 == 1-5 6 == 1-6 7 == 1-7 8 == 1-8 9 == 1-9 10 == 1-10 11 == 1-11 12 == 1-12 13 == 1-13 14 == 1-14 15 == 1-15 16 == 1-16 17 == 1-17 18 == 1-18 19 == 1-19 20 == 1-20 21 == 1-21 22 == 1-22 23 == 1-23 24 == 1-24 25 == 1-25 26 == 1-26 27 == 1-27 28 == 1-28 29 == 1-29 30 == 1-30 31 == 1-31 32 == 2-1 33 == 2-2 34 == 2-3 35 == 2-4 36 == 2-5 37 == 2-6 38 == 2-7 39 == 2-8 40 == 2-9 41 == 2-10 42 == 2-11 43 == 2-12 44 == 2-13 45 == 2-14 46 == 2-15 47 == 2-16 48 == 2-17 49 == 2-18 50 == 2-19 51 == 2-20 52 == 2-21 53 == 2-22 54 == 2-23 55 == 2-24 56 == 2-25 57 == 2-26 58 == 2-27 59 == 2-28 60 == 3-1 61 == 3-2 62 == 3-3 63 == 3-4 64 == 3-5 65 == 3-6 66 == 3-7 67 == 3-8 68 == 3-9 69 == 3-10 70 == 3-11 71 == 3-12 72 == 3-13 73 == 3-14 74 == 3-15 75 == 3-16 76 == 3-17 77 == 3-18 78 == 3-19 79 == 3-20 80 == 3-21 81 == 3-22 82 == 3-23 83 == 3-24 84 == 3-25 85 == 3-26 86 == 3-27 87 == 3-28 88 == 3-29 89 == 3-30 90 == 3-31 91 == 4-1 92 == 4-2 93 == 4-3 94 == 4-4 95 == 4-5 96 == 4-6 97 == 4-7 98 == 4-8 99 == 4-9 100 == 4-10 101 == 4-11 102 == 4-12 103 == 4-13 104 == 4-14 105 == 4-15 106 == 4-16 107 == 4-17 108 == 4-18 109 == 4-19 110 == 4-20 111 == 4-21 112 == 4-22 113 == 4-23 114 == 4-24 115 == 4-25 116 == 4-26 117 == 4-27 118 == 4-28 119 == 4-29 120 == 4-30 121 == 5-1 122 == 5-2 123 == 5-3 124 == 5-4 125 == 5-5 126 == 5-6 127 == 5-7 128 == 5-8 129 == 5-9 130 == 5-10 131 == 5-11 132 == 5-12 133 == 5-13 134 == 5-14 135 == 5-15 136 == 5-16 137 == 5-17 138 == 5-18 139 == 5-19 140 == 5-20 141 == 5-21 142 == 5-22 143 == 5-23 144 == 5-24 145 == 5-25 146 == 5-26 147 == 5-27 148 == 5-28 149 == 5-29 150 == 5-30 151 == 5-31 152 == 6-1 153 == 6-2 154 == 6-3 155 == 6-4 156 == 6-5 157 == 6-6 158 == 6-7 159 == 6-8 160 == 6-9 161 == 6-10 162 == 6-11 163 == 6-12 164 == 6-13 165 == 6-14 166 == 6-15 167 == 6-16 168 == 6-17 169 == 6-18 170 == 6-19 171 == 6-20 172 == 6-21 173 == 6-22 174 == 6-23 175 == 6-24 176 == 6-25 177 == 6-26 178 == 6-27 179 == 6-28 180 == 6-29 181 == 6-30 182 == 7-1 183 == 7-2 184 == 7-3 185 == 7-4 186 == 7-5 187 == 7-6 188 == 7-7 189 == 7-8 190 == 7-9 191 == 7-10 192 == 7-11 193 == 7-12 194 == 7-13 195 == 7-14 196 == 7-15 197 == 7-16 198 == 7-17 199 == 7-18 200 == 7-19 201 == 7-20 202 == 7-21 203 == 7-22 204 == 7-23 205 == 7-24 206 == 7-25 207 == 7-26 208 == 7-27 209 == 7-28 210 == 7-29 211 == 7-30 212 == 7-31 213 == 8-1 214 == 8-2 215 == 8-3 216 == 8-4 217 == 8-5 218 == 8-6 219 == 8-7 220 == 8-8 221 == 8-9 222 == 8-10 223 == 8-11 224 == 8-12 225 == 8-13 226 == 8-14 227 == 8-15 228 == 8-16 229 == 8-17 230 == 8-18 231 == 8-19 232 == 8-20 233 == 8-21 234 == 8-22 235 == 8-23 236 == 8-24 237 == 8-25 238 == 8-26 239 == 8-27 240 == 8-28 241 == 8-29 242 == 8-30 243 == 8-31 244 == 9-1 245 == 9-2 246 == 9-3 247 == 9-4 248 == 9-5 249 == 9-6 250 == 9-7 251 == 9-8 252 == 9-9 253 == 9-10 254 == 9-11 255 == 9-12 256 == 9-13 257 == 9-14 258 == 9-15 259 == 9-16 260 == 9-17 261 == 9-18 262 == 9-19 263 == 9-20 264 == 9-21 265 == 9-22 266 == 9-23 267 == 9-24 268 == 9-25 269 == 9-26 270 == 9-27 271 == 9-28 272 == 9-29 273 == 9-30 274 == 10-1 275 == 10-2 276 == 10-3 277 == 10-4 278 == 10-5 279 == 10-6 280 == 10-7 281 == 10-8 282 == 10-9 283 == 10-10 284 == 10-11 285 == 10-12 286 == 10-13 287 == 10-14 288 == 10-15 289 == 10-16 290 == 10-17 291 == 10-18 292 == 10-19 293 == 10-20 294 == 10-21 295 == 10-22 296 == 10-23 297 == 10-24 298 == 10-25 299 == 10-26 300 == 10-27 301 == 10-28 302 == 10-29 303 == 10-30 304 == 10-31 305 == 11-1 306 == 11-2 307 == 11-3 308 == 11-4 309 == 11-5 310 == 11-6 311 == 11-7 312 == 11-8 313 == 11-9 314 == 11-10 315 == 11-11 316 == 11-12 317 == 11-13 318 == 11-14 319 == 11-15 320 == 11-16 321 == 11-17 322 == 11-18 323 == 11-19 324 == 11-20 325 == 11-21 326 == 11-22 327 == 11-23 328 == 11-24 329 == 11-25 330 == 11-26 331 == 11-27 332 == 11-28 333 == 11-29 334 == 11-30 335 == 12-1 336 == 12-2 337 == 12-3 338 == 12-4 339 == 12-5 340 == 12-6 341 == 12-7 342 == 12-8 343 == 12-9 344 == 12-10 345 == 12-11 346 == 12-12 347 == 12-13 348 == 12-14 349 == 12-15 350 == 12-16 351 == 12-17 352 == 12-18 353 == 12-19 354 == 12-20 355 == 12-21 356 == 12-22 357 == 12-23 358 == 12-24 359 == 12-25 360 == 12-26 361 == 12-27 362 == 12-28 363 == 12-29 364 == 12-30 365 == 12-31 DIFF: 366 -> 12-31 -> 365 DIFF: 367 -> 12-31 -> 365 DIFF: 368 -> 12-31 -> 365 DIFF: 369 -> 12-31 -> 365 Leap: DIFF: -2 -> 1-1 -> 1 DIFF: -1 -> 1-1 -> 1 DIFF: 0 -> 1-1 -> 1 1 == 1-1 2 == 1-2 3 == 1-3 4 == 1-4 5 == 1-5 6 == 1-6 7 == 1-7 8 == 1-8 9 == 1-9 10 == 1-10 11 == 1-11 12 == 1-12 13 == 1-13 14 == 1-14 15 == 1-15 16 == 1-16 17 == 1-17 18 == 1-18 19 == 1-19 20 == 1-20 21 == 1-21 22 == 1-22 23 == 1-23 24 == 1-24 25 == 1-25 26 == 1-26 27 == 1-27 28 == 1-28 29 == 1-29 30 == 1-30 31 == 1-31 32 == 2-1 33 == 2-2 34 == 2-3 35 == 2-4 36 == 2-5 37 == 2-6 38 == 2-7 39 == 2-8 40 == 2-9 41 == 2-10 42 == 2-11 43 == 2-12 44 == 2-13 45 == 2-14 46 == 2-15 47 == 2-16 48 == 2-17 49 == 2-18 50 == 2-19 51 == 2-20 52 == 2-21 53 == 2-22 54 == 2-23 55 == 2-24 56 == 2-25 57 == 2-26 58 == 2-27 59 == 2-28 60 == 2-29 61 == 3-1 62 == 3-2 63 == 3-3 64 == 3-4 65 == 3-5 66 == 3-6 67 == 3-7 68 == 3-8 69 == 3-9 70 == 3-10 71 == 3-11 72 == 3-12 73 == 3-13 74 == 3-14 75 == 3-15 76 == 3-16 77 == 3-17 78 == 3-18 79 == 3-19 80 == 3-20 81 == 3-21 82 == 3-22 83 == 3-23 84 == 3-24 85 == 3-25 86 == 3-26 87 == 3-27 88 == 3-28 89 == 3-29 90 == 3-30 91 == 3-31 92 == 4-1 93 == 4-2 94 == 4-3 95 == 4-4 96 == 4-5 97 == 4-6 98 == 4-7 99 == 4-8 100 == 4-9 101 == 4-10 102 == 4-11 103 == 4-12 104 == 4-13 105 == 4-14 106 == 4-15 107 == 4-16 108 == 4-17 109 == 4-18 110 == 4-19 111 == 4-20 112 == 4-21 113 == 4-22 114 == 4-23 115 == 4-24 116 == 4-25 117 == 4-26 118 == 4-27 119 == 4-28 120 == 4-29 121 == 4-30 122 == 5-1 123 == 5-2 124 == 5-3 125 == 5-4 126 == 5-5 127 == 5-6 128 == 5-7 129 == 5-8 130 == 5-9 131 == 5-10 132 == 5-11 133 == 5-12 134 == 5-13 135 == 5-14 136 == 5-15 137 == 5-16 138 == 5-17 139 == 5-18 140 == 5-19 141 == 5-20 142 == 5-21 143 == 5-22 144 == 5-23 145 == 5-24 146 == 5-25 147 == 5-26 148 == 5-27 149 == 5-28 150 == 5-29 151 == 5-30 152 == 5-31 153 == 6-1 154 == 6-2 155 == 6-3 156 == 6-4 157 == 6-5 158 == 6-6 159 == 6-7 160 == 6-8 161 == 6-9 162 == 6-10 163 == 6-11 164 == 6-12 165 == 6-13 166 == 6-14 167 == 6-15 168 == 6-16 169 == 6-17 170 == 6-18 171 == 6-19 172 == 6-20 173 == 6-21 174 == 6-22 175 == 6-23 176 == 6-24 177 == 6-25 178 == 6-26 179 == 6-27 180 == 6-28 181 == 6-29 182 == 6-30 183 == 7-1 184 == 7-2 185 == 7-3 186 == 7-4 187 == 7-5 188 == 7-6 189 == 7-7 190 == 7-8 191 == 7-9 192 == 7-10 193 == 7-11 194 == 7-12 195 == 7-13 196 == 7-14 197 == 7-15 198 == 7-16 199 == 7-17 200 == 7-18 201 == 7-19 202 == 7-20 203 == 7-21 204 == 7-22 205 == 7-23 206 == 7-24 207 == 7-25 208 == 7-26 209 == 7-27 210 == 7-28 211 == 7-29 212 == 7-30 213 == 7-31 214 == 8-1 215 == 8-2 216 == 8-3 217 == 8-4 218 == 8-5 219 == 8-6 220 == 8-7 221 == 8-8 222 == 8-9 223 == 8-10 224 == 8-11 225 == 8-12 226 == 8-13 227 == 8-14 228 == 8-15 229 == 8-16 230 == 8-17 231 == 8-18 232 == 8-19 233 == 8-20 234 == 8-21 235 == 8-22 236 == 8-23 237 == 8-24 238 == 8-25 239 == 8-26 240 == 8-27 241 == 8-28 242 == 8-29 243 == 8-30 244 == 8-31 245 == 9-1 246 == 9-2 247 == 9-3 248 == 9-4 249 == 9-5 250 == 9-6 251 == 9-7 252 == 9-8 253 == 9-9 254 == 9-10 255 == 9-11 256 == 9-12 257 == 9-13 258 == 9-14 259 == 9-15 260 == 9-16 261 == 9-17 262 == 9-18 263 == 9-19 264 == 9-20 265 == 9-21 266 == 9-22 267 == 9-23 268 == 9-24 269 == 9-25 270 == 9-26 271 == 9-27 272 == 9-28 273 == 9-29 274 == 9-30 275 == 10-1 276 == 10-2 277 == 10-3 278 == 10-4 279 == 10-5 280 == 10-6 281 == 10-7 282 == 10-8 283 == 10-9 284 == 10-10 285 == 10-11 286 == 10-12 287 == 10-13 288 == 10-14 289 == 10-15 290 == 10-16 291 == 10-17 292 == 10-18 293 == 10-19 294 == 10-20 295 == 10-21 296 == 10-22 297 == 10-23 298 == 10-24 299 == 10-25 300 == 10-26 301 == 10-27 302 == 10-28 303 == 10-29 304 == 10-30 305 == 10-31 306 == 11-1 307 == 11-2 308 == 11-3 309 == 11-4 310 == 11-5 311 == 11-6 312 == 11-7 313 == 11-8 314 == 11-9 315 == 11-10 316 == 11-11 317 == 11-12 318 == 11-13 319 == 11-14 320 == 11-15 321 == 11-16 322 == 11-17 323 == 11-18 324 == 11-19 325 == 11-20 326 == 11-21 327 == 11-22 328 == 11-23 329 == 11-24 330 == 11-25 331 == 11-26 332 == 11-27 333 == 11-28 334 == 11-29 335 == 11-30 336 == 12-1 337 == 12-2 338 == 12-3 339 == 12-4 340 == 12-5 341 == 12-6 342 == 12-7 343 == 12-8 344 == 12-9 345 == 12-10 346 == 12-11 347 == 12-12 348 == 12-13 349 == 12-14 350 == 12-15 351 == 12-16 352 == 12-17 353 == 12-18 354 == 12-19 355 == 12-20 356 == 12-21 357 == 12-22 358 == 12-23 359 == 12-24 360 == 12-25 361 == 12-26 362 == 12-27 363 == 12-28 364 == 12-29 365 == 12-30 366 == 12-31 DIFF: 367 -> 12-31 -> 366 DIFF: 368 -> 12-31 -> 366 DIFF: 369 -> 12-31 -> 366 hugs98-plus-Sep2006/packages/time/time/test/TestEaster.hs0000644006511100651110000000140110504340546022030 0ustar rossross{-# OPTIONS -ffi -Wall -Werror #-} module Main where import Data.Time.Calendar.Easter import Data.Time.Calendar import Data.Time.LocalTime import System.Locale days :: [Day] days = [ModifiedJulianDay 53000 .. ModifiedJulianDay 53014] showWithWDay :: Day -> String showWithWDay = formatTime defaultTimeLocale "%F %A" main :: IO () main = do mapM_ (\day -> putStrLn ((showWithWDay day) ++ " -> " ++ (showWithWDay (sundayAfter day)))) days mapM_ (\year -> do putStrLn ((show year) ++ ", Gregorian: moon, " ++ (show (gregorianPaschalMoon year)) ++ ": Easter, " ++ (showWithWDay (gregorianEaster year))) putStrLn ((show year) ++ ", Orthodox : moon, " ++ (show (orthodoxPaschalMoon year)) ++ ": Easter, " ++ (showWithWDay (orthodoxEaster year))) ) [2000..2020] hugs98-plus-Sep2006/packages/time/time/test/TestEaster.ref0000644006511100651110000000613510504340546022203 0ustar rossross2003-12-27 Saturday -> 2003-12-28 Sunday 2003-12-28 Sunday -> 2004-01-04 Sunday 2003-12-29 Monday -> 2004-01-04 Sunday 2003-12-30 Tuesday -> 2004-01-04 Sunday 2003-12-31 Wednesday -> 2004-01-04 Sunday 2004-01-01 Thursday -> 2004-01-04 Sunday 2004-01-02 Friday -> 2004-01-04 Sunday 2004-01-03 Saturday -> 2004-01-04 Sunday 2004-01-04 Sunday -> 2004-01-11 Sunday 2004-01-05 Monday -> 2004-01-11 Sunday 2004-01-06 Tuesday -> 2004-01-11 Sunday 2004-01-07 Wednesday -> 2004-01-11 Sunday 2004-01-08 Thursday -> 2004-01-11 Sunday 2004-01-09 Friday -> 2004-01-11 Sunday 2004-01-10 Saturday -> 2004-01-11 Sunday 2000, Gregorian: moon, 2000-04-18: Easter, 2000-04-23 Sunday 2000, Orthodox : moon, 2000-04-23: Easter, 2000-04-30 Sunday 2001, Gregorian: moon, 2001-04-08: Easter, 2001-04-15 Sunday 2001, Orthodox : moon, 2001-04-12: Easter, 2001-04-15 Sunday 2002, Gregorian: moon, 2002-03-28: Easter, 2002-03-31 Sunday 2002, Orthodox : moon, 2002-05-01: Easter, 2002-05-05 Sunday 2003, Gregorian: moon, 2003-04-16: Easter, 2003-04-20 Sunday 2003, Orthodox : moon, 2003-04-20: Easter, 2003-04-27 Sunday 2004, Gregorian: moon, 2004-04-05: Easter, 2004-04-11 Sunday 2004, Orthodox : moon, 2004-04-09: Easter, 2004-04-11 Sunday 2005, Gregorian: moon, 2005-03-25: Easter, 2005-03-27 Sunday 2005, Orthodox : moon, 2005-04-28: Easter, 2005-05-01 Sunday 2006, Gregorian: moon, 2006-04-13: Easter, 2006-04-16 Sunday 2006, Orthodox : moon, 2006-04-17: Easter, 2006-04-23 Sunday 2007, Gregorian: moon, 2007-04-02: Easter, 2007-04-08 Sunday 2007, Orthodox : moon, 2007-04-06: Easter, 2007-04-08 Sunday 2008, Gregorian: moon, 2008-03-22: Easter, 2008-03-23 Sunday 2008, Orthodox : moon, 2008-04-25: Easter, 2008-04-27 Sunday 2009, Gregorian: moon, 2009-04-10: Easter, 2009-04-12 Sunday 2009, Orthodox : moon, 2009-04-14: Easter, 2009-04-19 Sunday 2010, Gregorian: moon, 2010-03-30: Easter, 2010-04-04 Sunday 2010, Orthodox : moon, 2010-04-03: Easter, 2010-04-04 Sunday 2011, Gregorian: moon, 2011-04-18: Easter, 2011-04-24 Sunday 2011, Orthodox : moon, 2011-04-22: Easter, 2011-04-24 Sunday 2012, Gregorian: moon, 2012-04-07: Easter, 2012-04-08 Sunday 2012, Orthodox : moon, 2012-04-11: Easter, 2012-04-15 Sunday 2013, Gregorian: moon, 2013-03-27: Easter, 2013-03-31 Sunday 2013, Orthodox : moon, 2013-04-30: Easter, 2013-05-05 Sunday 2014, Gregorian: moon, 2014-04-14: Easter, 2014-04-20 Sunday 2014, Orthodox : moon, 2014-04-18: Easter, 2014-04-20 Sunday 2015, Gregorian: moon, 2015-04-03: Easter, 2015-04-05 Sunday 2015, Orthodox : moon, 2015-04-07: Easter, 2015-04-12 Sunday 2016, Gregorian: moon, 2016-03-23: Easter, 2016-03-27 Sunday 2016, Orthodox : moon, 2016-04-26: Easter, 2016-05-01 Sunday 2017, Gregorian: moon, 2017-04-11: Easter, 2017-04-16 Sunday 2017, Orthodox : moon, 2017-04-15: Easter, 2017-04-16 Sunday 2018, Gregorian: moon, 2018-03-31: Easter, 2018-04-01 Sunday 2018, Orthodox : moon, 2018-04-04: Easter, 2018-04-08 Sunday 2019, Gregorian: moon, 2019-04-18: Easter, 2019-04-21 Sunday 2019, Orthodox : moon, 2019-04-23: Easter, 2019-04-28 Sunday 2020, Gregorian: moon, 2020-04-08: Easter, 2020-04-12 Sunday 2020, Orthodox : moon, 2020-04-12: Easter, 2020-04-19 Sunday hugs98-plus-Sep2006/packages/time/time/test/TestCalendars.hs0000644006511100651110000000110610504340546022503 0ustar rossross{-# OPTIONS -Wall -Werror #-} module Main where import Data.Time.Calendar.Julian import Data.Time.Calendar.WeekDate import Data.Time.Calendar showers :: [(String,Day -> String)] showers = [ ("MJD",show . toModifiedJulianDay), ("Gregorian",showGregorian), ("Julian",showJulian), ("ISO 8601",showWeekDate) ] days :: [Day] days = [ fromGregorian 0 12 31, fromJulian 1752 9 2, fromGregorian 1752 9 14, fromGregorian 2005 1 23 ] main :: IO () main = mapM_ (\day -> do mapM_ (\(name,shower) -> putStr (" == " ++ name ++ " " ++ (shower day))) showers putStrLn "" ) days hugs98-plus-Sep2006/packages/time/time/test/TestCalendars.ref0000644006511100651110000000051410504340546022647 0ustar rossross == MJD -678576 == Gregorian 0000-12-31 == Julian 0001-01-02 == ISO 8601 0000-W52-7 == MJD -38780 == Gregorian 1752-09-13 == Julian 1752-09-02 == ISO 8601 1752-W37-3 == MJD -38779 == Gregorian 1752-09-14 == Julian 1752-09-03 == ISO 8601 1752-W37-4 == MJD 53393 == Gregorian 2005-01-23 == Julian 2005-01-10 == ISO 8601 2005-W03-7 hugs98-plus-Sep2006/packages/time/LICENSE0000644006511100651110000000241110504340546016503 0ustar rossrossTimeLib is Copyright (c) Ashley Yakeley, 2004-2005. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/time/cbits/0000755006511100651110000000000010504340547016605 5ustar rossrosshugs98-plus-Sep2006/packages/time/cbits/HsTime.c0000644006511100651110000000213710504340547020145 0ustar rossross#include "HsTime.h" #include long int get_current_timezone_seconds (time_t t,int* pdst,char const* * pname) { struct tm* ptm; long gmtoff; int dst; const char *name; #if HAVE_LOCALTIME_R struct tm tmd; ptm = localtime_r(&t,&tmd); #else ptm = localtime(&t); #endif // We don't have a better API to use on Windows, the logic to // decide whether a given data/time falls within DST is // implemented as part of localtime() in the CRT. This is_dst // flag is all we need here. if (ptm) { dst = ptm -> tm_isdst; #if HAVE_TM_ZONE name = ptm -> tm_zone; gmtoff = ptm -> tm_gmtoff; #elif defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) name = dst ? _tzname[1] : _tzname[0]; gmtoff = dst ? _timezone - 3600 : _timezone; #else # if HAVE_TZNAME name = *tzname; # else # error "Don't know how to get at timezone name on your OS" # endif # if HAVE_DECL_ALTZONE gmtoff = dst ? altzone : timezone; # else gmtoff = dst ? timezone - 3600 : timezone; # endif #endif // HAVE_TM_ZONE *pdst = dst; *pname = name; return gmtoff; } else return 0x80000000; } hugs98-plus-Sep2006/packages/time/time.cabal0000644006511100651110000000224110504340547017422 0ustar rossrossName: time Version: 1.0 Stability: stable License: BSD3 License-File: LICENSE Author: Ashley Yakeley Maintainer: Homepage: http://semantic.org/TimeLib/ Category: Build-Depends: base Synopsis: time library Exposed-Modules: Data.Time.Calendar, Data.Time.Calendar.MonthDay, Data.Time.Calendar.OrdinalDate, Data.Time.Calendar.WeekDate, Data.Time.Calendar.Julian, Data.Time.Calendar.Easter, Data.Time.Clock, Data.Time.Clock.POSIX, Data.Time.Clock.TAI, Data.Time.LocalTime, Data.Time Extensions: ForeignFunctionInterface, CPP C-Sources: cbits/HsTime.c Other-Modules: Data.Time.Calendar.Private, Data.Time.Calendar.Days, Data.Time.Calendar.Gregorian, Data.Time.Calendar.JulianYearDay, Data.Time.Clock.Scale, Data.Time.Clock.UTC, Data.Time.Clock.CTimeval, Data.Time.Clock.UTCDiff, Data.Time.LocalTime.TimeZone, Data.Time.LocalTime.TimeOfDay, Data.Time.LocalTime.LocalTime, Data.Time.LocalTime.Format Extra-Source-Files: aclocal.m4 configure.ac configure include/HsTime.h include/HsTimeConfig.h.in Extra-Tmp-Files: config.log config.status autom4te.cache include/HsTimeConfig.h Include-Dirs: include Install-Includes: HsTime.h HsTimeConfig.h hugs98-plus-Sep2006/packages/time/configure.ac0000644006511100651110000000053710504340547017774 0ustar rossrossAC_INIT([Haskell time package], [0.3.1], [ashley@semantic.org], [time]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([include/HsTime.h]) AC_CONFIG_HEADERS([include/HsTimeConfig.h]) AC_CHECK_HEADERS([time.h]) AC_CHECK_FUNCS([gmtime_r localtime_r]) AC_STRUCT_TM AC_STRUCT_TIMEZONE FP_DECL_ALTZONE AC_OUTPUT hugs98-plus-Sep2006/packages/time/TimeLib.xcodeproj/0000755006511100651110000000000010504340546021021 5ustar rossrosshugs98-plus-Sep2006/packages/time/TimeLib.xcodeproj/project.pbxproj0000644006511100651110000007713310504340546024110 0ustar rossross// !$*UTF8*$! { archiveVersion = 1; classes = { }; objectVersion = 42; objects = { /* Begin PBXAggregateTarget section */ ABFA25E50839F99F0096540C /* Everything */ = { isa = PBXAggregateTarget; buildConfigurationList = ABD26A530878B4D200AD8A23 /* Build configuration list for PBXAggregateTarget "Everything" */; buildPhases = ( ); buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Everything; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; dependencies = ( ABD678610841714900CF37C0 /* PBXTargetDependency */, ABFA25E90839F9AF0096540C /* PBXTargetDependency */, ABFA25EB0839F9B10096540C /* PBXTargetDependency */, ABFA25E70839F9AD0096540C /* PBXTargetDependency */, ); name = Everything; productName = Everything; }; /* End PBXAggregateTarget section */ /* Begin PBXBuildStyle section */ AB01DCEC083747B1003C9EF7 /* Development */ = { isa = PBXBuildStyle; buildSettings = { COPY_PHASE_STRIP = NO; }; name = Development; }; AB01DCED083747B1003C9EF7 /* Deployment */ = { isa = PBXBuildStyle; buildSettings = { COPY_PHASE_STRIP = YES; }; name = Deployment; }; /* End PBXBuildStyle section */ /* Begin PBXContainerItemProxy section */ ABD678600841714900CF37C0 /* PBXContainerItemProxy */ = { isa = PBXContainerItemProxy; containerPortal = AB01DCEE083747B1003C9EF7 /* Project object */; proxyType = 1; remoteGlobalIDString = ABD6785F0841710C00CF37C0; remoteInfo = Dependencies; }; ABFA25E60839F9AD0096540C /* PBXContainerItemProxy */ = { isa = PBXContainerItemProxy; containerPortal = AB01DCEE083747B1003C9EF7 /* Project object */; proxyType = 1; remoteGlobalIDString = ABFA25E20839F9310096540C; remoteInfo = Documentation; }; ABFA25E80839F9AF0096540C /* PBXContainerItemProxy */ = { isa = PBXContainerItemProxy; containerPortal = AB01DCEE083747B1003C9EF7 /* Project object */; proxyType = 1; remoteGlobalIDString = AB01DD2108374A56003C9EF7; remoteInfo = Build; }; ABFA25EA0839F9B10096540C /* PBXContainerItemProxy */ = { isa = PBXContainerItemProxy; containerPortal = AB01DCEE083747B1003C9EF7 /* Project object */; proxyType = 1; remoteGlobalIDString = AB3571F5083759B20059BD19; remoteInfo = Test; }; /* End PBXContainerItemProxy section */ /* Begin PBXFileReference section */ AB01DCF508374807003C9EF7 /* Makefile */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.make; path = Makefile; sourceTree = ""; }; AB01DCF608374808003C9EF7 /* Setup.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Setup.hs; sourceTree = ""; }; AB01DCF708374808003C9EF7 /* time.cabal */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = time.cabal; sourceTree = ""; }; AB01DCF808374808003C9EF7 /* timestuff.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = timestuff.c; sourceTree = ""; }; AB01DCF908374808003C9EF7 /* timestuff.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = timestuff.h; sourceTree = ""; }; AB01DCFC08374838003C9EF7 /* Calendar.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Calendar.hs; sourceTree = ""; }; AB01DCFD08374838003C9EF7 /* Clock.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Clock.hs; sourceTree = ""; }; AB01DCFE08374838003C9EF7 /* TAI.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TAI.hs; sourceTree = ""; }; AB01DD12083748EC003C9EF7 /* LocalTime.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = LocalTime.hs; sourceTree = ""; }; AB01DD13083748EC003C9EF7 /* Format.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Format.hs; sourceTree = ""; }; AB01DD14083748EC003C9EF7 /* Gregorian.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Gregorian.hs; sourceTree = ""; }; AB01DD15083748EC003C9EF7 /* WeekDate.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = WeekDate.hs; sourceTree = ""; }; AB01DD16083748EC003C9EF7 /* Private.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Private.hs; sourceTree = ""; }; AB01DD17083748EC003C9EF7 /* TimeOfDay.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TimeOfDay.hs; sourceTree = ""; }; AB01DD18083748EC003C9EF7 /* TimeZone.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TimeZone.hs; sourceTree = ""; }; AB01DD19083748EC003C9EF7 /* OrdinalDate.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = OrdinalDate.hs; sourceTree = ""; }; AB20A933092741BA001A7C3C /* MonthDay.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = MonthDay.hs; sourceTree = ""; }; AB20A93E09274282001A7C3C /* TestMonthDay.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TestMonthDay.hs; sourceTree = ""; }; AB20A93F09274299001A7C3C /* TestMonthDay.ref */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = TestMonthDay.ref; sourceTree = ""; }; AB20A9E309275771001A7C3C /* Easter.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Easter.hs; sourceTree = ""; }; AB20A9E409275795001A7C3C /* TestEaster.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TestEaster.hs; sourceTree = ""; }; AB20A9E509275795001A7C3C /* TestEaster.ref */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = TestEaster.ref; sourceTree = ""; }; AB20A9FC092758C3001A7C3C /* Julian.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Julian.hs; sourceTree = ""; }; AB20AA1109275961001A7C3C /* JulianYearDay.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = JulianYearDay.hs; sourceTree = ""; }; AB20AA62092872B9001A7C3C /* TestCalendars.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TestCalendars.hs; sourceTree = ""; }; AB20AA63092872C8001A7C3C /* TestCalendars.ref */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = TestCalendars.ref; sourceTree = ""; }; AB2665B008A1F65B0059DEC0 /* ClipDates.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = ClipDates.hs; sourceTree = ""; }; AB2665B108A1F65B0059DEC0 /* ClipDates.ref */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = ClipDates.ref; sourceTree = ""; }; AB2665E708A215AA0059DEC0 /* LongWeekYears.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = LongWeekYears.hs; sourceTree = ""; }; AB2665E808A215AA0059DEC0 /* LongWeekYears.ref */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = LongWeekYears.ref; sourceTree = ""; }; AB2666E808A571460059DEC0 /* LocalTime.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = LocalTime.hs; sourceTree = ""; }; AB2666F108A572520059DEC0 /* Time.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Time.hs; sourceTree = ""; }; AB26682008A5FF0D0059DEC0 /* AddDays.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = AddDays.hs; sourceTree = ""; }; AB26682108A5FF0D0059DEC0 /* AddDays.ref */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = AddDays.ref; sourceTree = ""; }; AB26689F08A6D7290059DEC0 /* UseCases.lhs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell.literate; path = UseCases.lhs; sourceTree = ""; }; AB7FC7490954C86800796113 /* UTCDiff.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = UTCDiff.hs; sourceTree = ""; }; AB7FC7A00954D54C00796113 /* fixed.cabal */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = fixed.cabal; sourceTree = ""; }; AB7FC8340954E15700796113 /* LICENSE */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = LICENSE; sourceTree = ""; }; AB7FC8350954E15700796113 /* Setup.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Setup.hs; sourceTree = ""; }; AB7FC8360954E17000796113 /* LICENSE */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = LICENSE; sourceTree = ""; }; AB7FC8370954E1A500796113 /* Makefile */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.make; path = Makefile; sourceTree = ""; }; AB7FC8540954F4E200796113 /* Makefile */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.make; path = Makefile; sourceTree = ""; }; AB7FC8710954F5C200796113 /* Makefile */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.make; path = Makefile; sourceTree = ""; }; ABC0F98D090C7A6000DEF265 /* tai-utc.dat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = "tai-utc.dat"; sourceTree = ""; }; ABC0F98E090C7A6000DEF265 /* TestParseDAT.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TestParseDAT.hs; sourceTree = ""; }; ABC0F9910913518A00DEF265 /* TestParseDAT.ref */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = TestParseDAT.ref; sourceTree = ""; }; ABD6783F084167B900CF37C0 /* POSIX.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = POSIX.hs; sourceTree = ""; }; ABD67840084167D100CF37C0 /* CTimeval.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = CTimeval.hs; sourceTree = ""; }; ABD67841084168B700CF37C0 /* UTC.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = UTC.hs; sourceTree = ""; }; ABD67842084168CB00CF37C0 /* Scale.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Scale.hs; sourceTree = ""; }; ABF3FF8B0880D284006724E1 /* Days.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Days.hs; sourceTree = ""; }; ABFA25DF0839F8F70096540C /* Fixed.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = Fixed.hs; sourceTree = ""; }; ABFA2623083B28C00096540C /* ConvertBack.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = ConvertBack.hs; sourceTree = ""; }; ABFA2624083B28C00096540C /* CurrentTime.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = CurrentTime.hs; sourceTree = ""; }; ABFA2625083B28C00096540C /* Makefile */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.make; path = Makefile; sourceTree = ""; }; ABFA2626083B28C00096540C /* ShowDST.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = ShowDST.hs; sourceTree = ""; }; ABFA2627083B28C00096540C /* TestFixed.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TestFixed.hs; sourceTree = ""; }; ABFA2628083B28C00096540C /* TestFixed.ref */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = TestFixed.ref; sourceTree = ""; }; ABFA2629083B28C00096540C /* TestFormat.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TestFormat.hs; sourceTree = ""; }; ABFA262A083B28C00096540C /* TestFormatStuff.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = TestFormatStuff.c; sourceTree = ""; }; ABFA262B083B28C00096540C /* TestFormatStuff.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = TestFormatStuff.h; sourceTree = ""; }; ABFA262C083B28C00096540C /* TestTime.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TestTime.hs; sourceTree = ""; }; ABFA262D083B28C00096540C /* TestTime.ref */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = TestTime.ref; sourceTree = ""; }; ABFA262E083B28C00096540C /* TimeZone.hs */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.haskell; path = TimeZone.hs; sourceTree = ""; }; ABFA2649083BF6210096540C /* index.html */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.html; path = index.html; sourceTree = ""; }; /* End PBXFileReference section */ /* Begin PBXGroup section */ AB01DCEA083747B1003C9EF7 = { isa = PBXGroup; children = ( AB7FC8710954F5C200796113 /* Makefile */, AB7FC81F0954E01C00796113 /* fixed */, AB7FC82B0954E09800796113 /* time */, AB35747F08386FCD00B5F897 /* Cabal */, ABFA264B083C8AA40096540C /* Target Doc */, ); sourceTree = ""; }; AB01DD0008374848003C9EF7 /* Time */ = { isa = PBXGroup; children = ( AB01DD0D083748C0003C9EF7 /* Calendar */, AB01DCFC08374838003C9EF7 /* Calendar.hs */, ABD6783C0841677900CF37C0 /* Clock */, AB01DCFD08374838003C9EF7 /* Clock.hs */, AB2666A808A56FE30059DEC0 /* LocalTime */, AB2666E808A571460059DEC0 /* LocalTime.hs */, ); path = Time; sourceTree = ""; }; AB01DD0D083748C0003C9EF7 /* Calendar */ = { isa = PBXGroup; children = ( AB01DD16083748EC003C9EF7 /* Private.hs */, ABF3FF8B0880D284006724E1 /* Days.hs */, AB01DD19083748EC003C9EF7 /* OrdinalDate.hs */, AB20A933092741BA001A7C3C /* MonthDay.hs */, AB01DD14083748EC003C9EF7 /* Gregorian.hs */, AB20AA1109275961001A7C3C /* JulianYearDay.hs */, AB20A9FC092758C3001A7C3C /* Julian.hs */, AB01DD15083748EC003C9EF7 /* WeekDate.hs */, AB20A9E309275771001A7C3C /* Easter.hs */, ); path = Calendar; sourceTree = ""; }; AB2666A808A56FE30059DEC0 /* LocalTime */ = { isa = PBXGroup; children = ( AB01DD18083748EC003C9EF7 /* TimeZone.hs */, AB01DD17083748EC003C9EF7 /* TimeOfDay.hs */, AB01DD12083748EC003C9EF7 /* LocalTime.hs */, AB01DD13083748EC003C9EF7 /* Format.hs */, ); path = LocalTime; sourceTree = ""; }; AB35747F08386FCD00B5F897 /* Cabal */ = { isa = PBXGroup; children = ( ); name = Cabal; sourceTree = ""; }; AB7FC81F0954E01C00796113 /* fixed */ = { isa = PBXGroup; children = ( AB7FC8350954E15700796113 /* Setup.hs */, AB7FC7A00954D54C00796113 /* fixed.cabal */, AB7FC8340954E15700796113 /* LICENSE */, AB7FC8370954E1A500796113 /* Makefile */, AB7FC8200954E03C00796113 /* Data */, AB7FC84D0954F4A700796113 /* test */, ); path = fixed; sourceTree = ""; }; AB7FC8200954E03C00796113 /* Data */ = { isa = PBXGroup; children = ( ABFA25DF0839F8F70096540C /* Fixed.hs */, ); path = Data; sourceTree = ""; }; AB7FC82B0954E09800796113 /* time */ = { isa = PBXGroup; children = ( AB01DCF608374808003C9EF7 /* Setup.hs */, AB01DCF708374808003C9EF7 /* time.cabal */, AB7FC8360954E17000796113 /* LICENSE */, AB01DCF508374807003C9EF7 /* Makefile */, ABFA25DC0839F8C90096540C /* Data */, AB01DCF908374808003C9EF7 /* timestuff.h */, AB01DCF808374808003C9EF7 /* timestuff.c */, ABFA25EC0839F9FD0096540C /* Test */, ); path = time; sourceTree = ""; }; AB7FC84D0954F4A700796113 /* test */ = { isa = PBXGroup; children = ( AB7FC8540954F4E200796113 /* Makefile */, ABFA2627083B28C00096540C /* TestFixed.hs */, ABFA2628083B28C00096540C /* TestFixed.ref */, ); path = test; sourceTree = ""; }; ABD6783C0841677900CF37C0 /* Clock */ = { isa = PBXGroup; children = ( ABD67842084168CB00CF37C0 /* Scale.hs */, ABD67841084168B700CF37C0 /* UTC.hs */, ABD67840084167D100CF37C0 /* CTimeval.hs */, ABD6783F084167B900CF37C0 /* POSIX.hs */, AB7FC7490954C86800796113 /* UTCDiff.hs */, AB01DCFE08374838003C9EF7 /* TAI.hs */, ); path = Clock; sourceTree = ""; }; ABFA25DC0839F8C90096540C /* Data */ = { isa = PBXGroup; children = ( AB01DD0008374848003C9EF7 /* Time */, AB2666F108A572520059DEC0 /* Time.hs */, ); path = Data; sourceTree = ""; }; ABFA25EC0839F9FD0096540C /* Test */ = { isa = PBXGroup; children = ( ABFA2625083B28C00096540C /* Makefile */, AB20A93E09274282001A7C3C /* TestMonthDay.hs */, AB20A93F09274299001A7C3C /* TestMonthDay.ref */, ABFA2624083B28C00096540C /* CurrentTime.hs */, ABFA2626083B28C00096540C /* ShowDST.hs */, ABFA2623083B28C00096540C /* ConvertBack.hs */, AB20AA62092872B9001A7C3C /* TestCalendars.hs */, AB20AA63092872C8001A7C3C /* TestCalendars.ref */, ABFA262C083B28C00096540C /* TestTime.hs */, ABFA262D083B28C00096540C /* TestTime.ref */, AB2665E708A215AA0059DEC0 /* LongWeekYears.hs */, AB2665E808A215AA0059DEC0 /* LongWeekYears.ref */, AB2665B008A1F65B0059DEC0 /* ClipDates.hs */, AB2665B108A1F65B0059DEC0 /* ClipDates.ref */, AB26682008A5FF0D0059DEC0 /* AddDays.hs */, AB26682108A5FF0D0059DEC0 /* AddDays.ref */, ABFA262E083B28C00096540C /* TimeZone.hs */, ABFA262B083B28C00096540C /* TestFormatStuff.h */, ABFA262A083B28C00096540C /* TestFormatStuff.c */, ABFA2629083B28C00096540C /* TestFormat.hs */, ABC0F98E090C7A6000DEF265 /* TestParseDAT.hs */, ABC0F9910913518A00DEF265 /* TestParseDAT.ref */, AB20A9E409275795001A7C3C /* TestEaster.hs */, AB20A9E509275795001A7C3C /* TestEaster.ref */, ABC0F98D090C7A6000DEF265 /* tai-utc.dat */, AB26689F08A6D7290059DEC0 /* UseCases.lhs */, ); name = Test; path = test; sourceTree = ""; }; ABFA264B083C8AA40096540C /* Target Doc */ = { isa = PBXGroup; children = ( ABFA2649083BF6210096540C /* index.html */, ); name = "Target Doc"; path = haddock; sourceTree = ""; }; /* End PBXGroup section */ /* Begin PBXLegacyTarget section */ AB01DD2108374A56003C9EF7 /* Build */ = { isa = PBXLegacyTarget; buildArgumentsString = "$(ACTION)build"; buildConfigurationList = ABD26A470878B4D200AD8A23 /* Build configuration list for PBXLegacyTarget "Build" */; buildPhases = ( ); buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; buildToolPath = /usr/bin/make; dependencies = ( ); name = Build; passBuildSettingsInEnvironment = 1; productName = Untitled; }; AB3571F5083759B20059BD19 /* Test */ = { isa = PBXLegacyTarget; buildArgumentsString = "$(ACTION)test"; buildConfigurationList = ABD26A4B0878B4D200AD8A23 /* Build configuration list for PBXLegacyTarget "Test" */; buildPhases = ( ); buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Test; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; buildToolPath = /usr/bin/make; dependencies = ( ); name = Test; passBuildSettingsInEnvironment = 1; productName = Test; }; ABD6785F0841710C00CF37C0 /* Dependencies */ = { isa = PBXLegacyTarget; buildArgumentsString = depend; buildConfigurationList = ABD26A430878B4D200AD8A23 /* Build configuration list for PBXLegacyTarget "Dependencies" */; buildPhases = ( ); buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; buildToolPath = /usr/bin/make; dependencies = ( ); name = Dependencies; passBuildSettingsInEnvironment = 1; productName = Untitled; }; ABFA25E20839F9310096540C /* Documentation */ = { isa = PBXLegacyTarget; buildArgumentsString = "$(ACTION)doc"; buildConfigurationList = ABD26A4F0878B4D200AD8A23 /* Build configuration list for PBXLegacyTarget "Documentation" */; buildPhases = ( ); buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; buildToolPath = /usr/bin/make; dependencies = ( ); name = Documentation; passBuildSettingsInEnvironment = 1; productName = Untitled; }; /* End PBXLegacyTarget section */ /* Begin PBXProject section */ AB01DCEE083747B1003C9EF7 /* Project object */ = { isa = PBXProject; buildConfigurationList = ABD26A570878B4D200AD8A23 /* Build configuration list for PBXProject "TimeLib" */; buildSettings = { }; buildStyles = ( AB01DCEC083747B1003C9EF7 /* Development */, AB01DCED083747B1003C9EF7 /* Deployment */, ); hasScannedForEncodings = 0; mainGroup = AB01DCEA083747B1003C9EF7; projectDirPath = ""; targets = ( ABD6785F0841710C00CF37C0 /* Dependencies */, AB01DD2108374A56003C9EF7 /* Build */, AB3571F5083759B20059BD19 /* Test */, ABFA25E20839F9310096540C /* Documentation */, ABFA25E50839F99F0096540C /* Everything */, ); }; /* End PBXProject section */ /* Begin PBXTargetDependency section */ ABD678610841714900CF37C0 /* PBXTargetDependency */ = { isa = PBXTargetDependency; target = ABD6785F0841710C00CF37C0 /* Dependencies */; targetProxy = ABD678600841714900CF37C0 /* PBXContainerItemProxy */; }; ABFA25E70839F9AD0096540C /* PBXTargetDependency */ = { isa = PBXTargetDependency; target = ABFA25E20839F9310096540C /* Documentation */; targetProxy = ABFA25E60839F9AD0096540C /* PBXContainerItemProxy */; }; ABFA25E90839F9AF0096540C /* PBXTargetDependency */ = { isa = PBXTargetDependency; target = AB01DD2108374A56003C9EF7 /* Build */; targetProxy = ABFA25E80839F9AF0096540C /* PBXContainerItemProxy */; }; ABFA25EB0839F9B10096540C /* PBXTargetDependency */ = { isa = PBXTargetDependency; target = AB3571F5083759B20059BD19 /* Test */; targetProxy = ABFA25EA0839F9B10096540C /* PBXContainerItemProxy */; }; /* End PBXTargetDependency section */ /* Begin XCBuildConfiguration section */ ABD26A440878B4D200AD8A23 /* Development */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = NO; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Development; }; ABD26A450878B4D200AD8A23 /* Deployment */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = YES; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Deployment; }; ABD26A460878B4D200AD8A23 /* Default */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Default; }; ABD26A480878B4D200AD8A23 /* Development */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = NO; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Development; }; ABD26A490878B4D200AD8A23 /* Deployment */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = YES; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Deployment; }; ABD26A4A0878B4D200AD8A23 /* Default */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Default; }; ABD26A4C0878B4D200AD8A23 /* Development */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = NO; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Test; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Development; }; ABD26A4D0878B4D200AD8A23 /* Deployment */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = YES; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Test; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Deployment; }; ABD26A4E0878B4D200AD8A23 /* Default */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Test; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Default; }; ABD26A500878B4D200AD8A23 /* Development */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = NO; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Development; }; ABD26A510878B4D200AD8A23 /* Deployment */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = YES; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Deployment; }; ABD26A520878B4D200AD8A23 /* Default */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Untitled; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Default; }; ABD26A540878B4D200AD8A23 /* Development */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = NO; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Everything; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Development; }; ABD26A550878B4D200AD8A23 /* Deployment */ = { isa = XCBuildConfiguration; buildSettings = { COPY_PHASE_STRIP = YES; OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Everything; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Deployment; }; ABD26A560878B4D200AD8A23 /* Default */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_CFLAGS = ""; OTHER_LDFLAGS = ""; OTHER_REZFLAGS = ""; PRODUCT_NAME = Everything; SECTORDER_FLAGS = ""; WARNING_CFLAGS = ( "-Wmost", "-Wno-four-char-constants", "-Wno-unknown-pragmas", ); }; name = Default; }; ABD26A580878B4D200AD8A23 /* Development */ = { isa = XCBuildConfiguration; buildSettings = { }; name = Development; }; ABD26A590878B4D200AD8A23 /* Deployment */ = { isa = XCBuildConfiguration; buildSettings = { }; name = Deployment; }; ABD26A5A0878B4D200AD8A23 /* Default */ = { isa = XCBuildConfiguration; buildSettings = { }; name = Default; }; /* End XCBuildConfiguration section */ /* Begin XCConfigurationList section */ ABD26A430878B4D200AD8A23 /* Build configuration list for PBXLegacyTarget "Dependencies" */ = { isa = XCConfigurationList; buildConfigurations = ( ABD26A440878B4D200AD8A23 /* Development */, ABD26A450878B4D200AD8A23 /* Deployment */, ABD26A460878B4D200AD8A23 /* Default */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Default; }; ABD26A470878B4D200AD8A23 /* Build configuration list for PBXLegacyTarget "Build" */ = { isa = XCConfigurationList; buildConfigurations = ( ABD26A480878B4D200AD8A23 /* Development */, ABD26A490878B4D200AD8A23 /* Deployment */, ABD26A4A0878B4D200AD8A23 /* Default */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Default; }; ABD26A4B0878B4D200AD8A23 /* Build configuration list for PBXLegacyTarget "Test" */ = { isa = XCConfigurationList; buildConfigurations = ( ABD26A4C0878B4D200AD8A23 /* Development */, ABD26A4D0878B4D200AD8A23 /* Deployment */, ABD26A4E0878B4D200AD8A23 /* Default */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Default; }; ABD26A4F0878B4D200AD8A23 /* Build configuration list for PBXLegacyTarget "Documentation" */ = { isa = XCConfigurationList; buildConfigurations = ( ABD26A500878B4D200AD8A23 /* Development */, ABD26A510878B4D200AD8A23 /* Deployment */, ABD26A520878B4D200AD8A23 /* Default */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Default; }; ABD26A530878B4D200AD8A23 /* Build configuration list for PBXAggregateTarget "Everything" */ = { isa = XCConfigurationList; buildConfigurations = ( ABD26A540878B4D200AD8A23 /* Development */, ABD26A550878B4D200AD8A23 /* Deployment */, ABD26A560878B4D200AD8A23 /* Default */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Default; }; ABD26A570878B4D200AD8A23 /* Build configuration list for PBXProject "TimeLib" */ = { isa = XCConfigurationList; buildConfigurations = ( ABD26A580878B4D200AD8A23 /* Development */, ABD26A590878B4D200AD8A23 /* Deployment */, ABD26A5A0878B4D200AD8A23 /* Default */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Default; }; /* End XCConfigurationList section */ }; rootObject = AB01DCEE083747B1003C9EF7 /* Project object */; } hugs98-plus-Sep2006/packages/time/prologue.txt0000644006511100651110000000003210504340547020071 0ustar rossrossClock and calendar time. hugs98-plus-Sep2006/packages/time/include/0000755006511100651110000000000010504340706017121 5ustar rossrosshugs98-plus-Sep2006/packages/time/include/HsTime.h0000644006511100651110000000030410504340547020463 0ustar rossross#ifndef __HSTIME_H__ #define __HSTIME_H__ #include "HsTimeConfig.h" #if HAVE_TIME_H #include #endif long int get_current_timezone_seconds (time_t,int* dst,char const* * name); #endif hugs98-plus-Sep2006/packages/time/include/HsTimeConfig.h.in0000644006511100651110000000445710504340706022230 0ustar rossross/* include/HsTimeConfig.h.in. Generated from configure.ac by autoheader. */ /* Define to 1 if you have the declaration of `altzone', and to 0 if you don't. */ #undef HAVE_DECL_ALTZONE /* Define to 1 if you have the declaration of `tzname', and to 0 if you don't. */ #undef HAVE_DECL_TZNAME /* Define to 1 if you have the `gmtime_r' function. */ #undef HAVE_GMTIME_R /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if you have the `localtime_r' function. */ #undef HAVE_LOCALTIME_R /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if `tm_zone' is member of `struct tm'. */ #undef HAVE_STRUCT_TM_TM_ZONE /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_TIME_H /* Define to 1 if your `struct tm' has `tm_zone'. Deprecated, use `HAVE_STRUCT_TM_TM_ZONE' instead. */ #undef HAVE_TM_ZONE /* Define to 1 if you don't have `tm_zone' but do have the external array `tzname'. */ #undef HAVE_TZNAME /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS /* Define to 1 if you can safely include both and . */ #undef TIME_WITH_SYS_TIME /* Define to 1 if your declares `struct tm'. */ #undef TM_IN_SYS_TIME hugs98-plus-Sep2006/packages/time/Makefile0000644006511100651110000000064410504340547017145 0ustar rossrossTOP=.. include $(TOP)/mk/boilerplate.mk SUBDIRS = ALL_DIRS = \ cbits \ Data \ Data/Time \ Data/Time/Calendar \ Data/Time/Clock \ Data/Time/LocalTime PACKAGE = time VERSION = 1.0 PACKAGE_DEPS = base SRC_HC_OPTS += -Wall -Werror -fffi -Iinclude SRC_CC_OPTS += -Wall -Werror -Iinclude SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries ($(PACKAGE) package)" UseGhcForCc = YES include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/time/aclocal.m40000644006511100651110000000067610504340547017352 0ustar rossross# FP_DECL_ALTZONE # --------------- # Defines HAVE_DECL_ALTZONE to 1 if declared, 0 otherwise. # # Used by base package. AC_DEFUN([FP_DECL_ALTZONE], [AC_REQUIRE([AC_HEADER_TIME])dnl AC_CHECK_HEADERS([sys/time.h]) AC_CHECK_DECLS([altzone], [], [],[#if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif]) ])# FP_DECL_ALTZONE hugs98-plus-Sep2006/packages/time/package.conf.in0000644006511100651110000000226110504340547020351 0ustar rossross#include "ghcconfig.h" Name: PACKAGE Version: VERSION Stability: Beta License: BSD3 License-File: LICENSE Author: Ashley Yakeley Maintainer: Homepage: http://semantic.org/TimeLib/ exposed: True Category: #if mingw32_HOST_OS depends: Win32, base #else depends: base #endif Synopsis: time library Exposed-modules: Data.Time.Calendar, Data.Time.Calendar.MonthDay, Data.Time.Calendar.OrdinalDate, Data.Time.Calendar.WeekDate, Data.Time.Calendar.Julian, Data.Time.Calendar.Easter, Data.Time.Clock, Data.Time.Clock.POSIX, Data.Time.Clock.TAI, Data.Time.LocalTime, Data.Time Extensions: ForeignFunctionInterface C-Sources: HsTime.c Hidden-modules: Data.Time.Calendar.Private, Data.Time.Calendar.Days, Data.Time.Calendar.Gregorian, Data.Time.Calendar.JulianYearDay, Data.Time.Clock.Scale, Data.Time.Clock.UTC, Data.Time.Clock.CTimeval, Data.Time.Clock.UTCDiff, Data.Time.LocalTime.TimeZone, Data.Time.LocalTime.TimeOfDay, Data.Time.LocalTime.LocalTime, Data.Time.LocalTime.Format import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HStime" include-dirs: INCLUDE_DIR includes: "HsTime.h" haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/time/.darcs-boring0000644006511100651110000000113410504340547020053 0ustar rossross# Boring file regexps: \.hi$ \.o$ \.p_hi$ \.p_o$ \.raw-hs$ _split$ \.a$ (^|/)dist$ (^|/)package.conf.inplace$ (^|/)package.conf.installed$ (^|/)\.depend$ (^|/)\.setup-config$ \.haddock$ ^build$ \.xcodeproj/.*\.pbxuser$ \.xcodeproj/.*\.mode1$ \.o\.cmd$ \.ko$ \.ko\.cmd$ \.mod\.c$ (^|/)\.tmp_versions($|/) (^|/)CVS($|/) (^|/)RCS($|/) ~$ #(^|/)\.[^/] (^|/)_darcs($|/) \.bak$ \.BAK$ \.orig$ (^|/)vssver\.scc$ \.swp$ (^|/)MT($|/) (^|/)\{arch\}($|/) (^|/).arch-ids($|/) (^|/), \.class$ \.prof$ (^|/)\.DS_Store$ (^|/)BitKeeper($|/) (^|/)ChangeSet($|/) (^|/)\.svn($|/) \.py[co]$ \# \.cvsignore$ (^|/)Thumbs\.db$ hugs98-plus-Sep2006/packages/time/configure0000755006511100651110000044005610504340705017415 0ustar rossross#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.60a for Haskell time package 0.3.1. # # Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /usr/bin/posix$PATH_SEPARATOR/bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell autoconf@gnu.org about your system, echo including any error possibly output before this echo message } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='Haskell time package' PACKAGE_TARNAME='time' PACKAGE_VERSION='0.3.1' PACKAGE_STRING='Haskell time package 0.3.1' PACKAGE_BUGREPORT='ashley@semantic.org' ac_unique_file="include/HsTime.h" # Factoring default headers for most tests. ac_includes_default="\ #include #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_STAT_H # include #endif #ifdef STDC_HEADERS # include # include #else # ifdef HAVE_STDLIB_H # include # endif #endif #ifdef HAVE_STRING_H # if !defined STDC_HEADERS && defined HAVE_MEMORY_H # include # endif # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datarootdir datadir sysconfdir sharedstatedir localstatedir includedir oldincludedir docdir infodir htmldir dvidir pdfdir psdir libdir localedir mandir DEFS ECHO_C ECHO_N ECHO_T LIBS build_alias host_alias target_alias CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP GREP EGREP LIBOBJS LTLIBOBJS' ac_subst_files='' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS CPPFLAGS CPP' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` eval with_$ac_package=\$ac_optarg ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval with_$ac_package=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute directory names. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { echo "$as_me: error: Working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$0" || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # 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 Haskell time package 0.3.1 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/time] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of Haskell time package 0.3.1:";; esac cat <<\_ACEOF Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF Haskell time package configure 0.3.1 generated by GNU Autoconf 2.60a Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by Haskell time package $as_me 0.3.1, which was generated by GNU Autoconf 2.60a. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then set x "$CONFIG_SITE" elif test "x$prefix" != xNONE; then set x "$prefix/share/config.site" "$prefix/etc/config.site" else set x "$ac_default_prefix/share/config.site" \ "$ac_default_prefix/etc/config.site" fi shift for ac_site_file do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Safety check: Ensure that we are in the correct source directory. ac_config_headers="$ac_config_headers include/HsTimeConfig.h" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO: checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; } ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # # List of possible output files, starting from the most likely. # The algorithm is not robust to junk in `.', hence go to wildcards (a.*) # only as a last resort. b.out is created by i960 compilers. ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' # # The IRIX 6 linker writes into existing files which may not be # executable, retaining their permissions. Remove them first so a # subsequent execution test works. ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { (ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi { echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6; } if test -z "$ac_file"; then echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } { echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6; } { echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext { echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT { echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; } if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; } GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CFLAGS="" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_c89+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_c89=$ac_arg else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6; } ;; xno) { echo "$as_me:$LINENO: result: unsupported" >&5 echo "${ECHO_T}unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Extract the first word of "grep ggrep" to use in msg output if test -z "$GREP"; then set dummy grep ggrep; ac_prog_name=$2 if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_GREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_GREP" && $as_executable_p "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_GREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_GREP_found && break 3 done done done IFS=$as_save_IFS fi GREP="$ac_cv_path_GREP" if test -z "$GREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_GREP=$GREP fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 echo "${ECHO_T}$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" { echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6; } if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else # Extract the first word of "egrep" to use in msg output if test -z "$EGREP"; then set dummy egrep; ac_prog_name=$2 if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_EGREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_EGREP" && $as_executable_p "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_EGREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_found && break 3 done done done IFS=$as_save_IFS fi EGREP="$ac_cv_path_EGREP" if test -z "$EGREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_EGREP=$EGREP fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 echo "${ECHO_T}$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" { echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) return 2; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in time.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ---------------------------------- ## ## Report this to ashley@semantic.org ## ## ---------------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in gmtime_r localtime_r do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking whether struct tm is in sys/time.h or time.h" >&5 echo $ECHO_N "checking whether struct tm is in sys/time.h or time.h... $ECHO_C" >&6; } if test "${ac_cv_struct_tm+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { struct tm *tp; tp->tm_sec; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_struct_tm=time.h else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_struct_tm=sys/time.h fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_struct_tm" >&5 echo "${ECHO_T}$ac_cv_struct_tm" >&6; } if test $ac_cv_struct_tm = sys/time.h; then cat >>confdefs.h <<\_ACEOF #define TM_IN_SYS_TIME 1 _ACEOF fi { echo "$as_me:$LINENO: checking for struct tm.tm_zone" >&5 echo $ECHO_N "checking for struct tm.tm_zone... $ECHO_C" >&6; } if test "${ac_cv_member_struct_tm_tm_zone+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include <$ac_cv_struct_tm> int main () { static struct tm ac_aggr; if (ac_aggr.tm_zone) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_tm_tm_zone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include <$ac_cv_struct_tm> int main () { static struct tm ac_aggr; if (sizeof ac_aggr.tm_zone) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_tm_tm_zone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_member_struct_tm_tm_zone=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_member_struct_tm_tm_zone" >&5 echo "${ECHO_T}$ac_cv_member_struct_tm_tm_zone" >&6; } if test $ac_cv_member_struct_tm_tm_zone = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_TM_TM_ZONE 1 _ACEOF fi if test "$ac_cv_member_struct_tm_tm_zone" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_TM_ZONE 1 _ACEOF else { echo "$as_me:$LINENO: checking whether tzname is declared" >&5 echo $ECHO_N "checking whether tzname is declared... $ECHO_C" >&6; } if test "${ac_cv_have_decl_tzname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { #ifndef tzname char *p = (char *) tzname; return !p; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_tzname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_tzname=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_have_decl_tzname" >&5 echo "${ECHO_T}$ac_cv_have_decl_tzname" >&6; } if test $ac_cv_have_decl_tzname = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_TZNAME 1 _ACEOF else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_TZNAME 0 _ACEOF fi { echo "$as_me:$LINENO: checking for tzname" >&5 echo $ECHO_N "checking for tzname... $ECHO_C" >&6; } if test "${ac_cv_var_tzname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #if !HAVE_DECL_TZNAME extern char *tzname[]; #endif int main () { return tzname[0][0]; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_var_tzname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_var_tzname=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_var_tzname" >&5 echo "${ECHO_T}$ac_cv_var_tzname" >&6; } if test $ac_cv_var_tzname = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_TZNAME 1 _ACEOF fi fi { echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6; } if test "${ac_cv_header_time+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include int main () { if ((struct tm *) 0) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_time=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_time=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 echo "${ECHO_T}$ac_cv_header_time" >&6; } if test $ac_cv_header_time = yes; then cat >>confdefs.h <<\_ACEOF #define TIME_WITH_SYS_TIME 1 _ACEOF fi for ac_header in sys/time.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ---------------------------------- ## ## Report this to ashley@semantic.org ## ## ---------------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking whether altzone is declared" >&5 echo $ECHO_N "checking whether altzone is declared... $ECHO_C" >&6; } if test "${ac_cv_have_decl_altzone+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif int main () { #ifndef altzone char *p = (char *) altzone; return !p; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_altzone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_altzone=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_have_decl_altzone" >&5 echo "${ECHO_T}$ac_cv_have_decl_altzone" >&6; } if test $ac_cv_have_decl_altzone = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_ALTZONE 1 _ACEOF else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_ALTZONE 0 _ACEOF fi cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { echo "$as_me:$LINENO: updating cache $cache_file" >&5 echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by Haskell time package $as_me 0.3.1, which was generated by GNU Autoconf 2.60a. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for. config_headers="$ac_config_headers" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration headers: $config_headers Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ Haskell time package config.status 0.3.1 configured by $0, generated by GNU Autoconf 2.60a, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2006 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header { echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 CONFIG_SHELL=$SHELL export CONFIG_SHELL exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "include/HsTimeConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsTimeConfig.h" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } for ac_tag in :H $CONFIG_HEADERS do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 echo "$as_me: error: Invalid tag $ac_tag." >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac ac_file_inputs="$ac_file_inputs $ac_f" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input="Generated from "`IFS=: echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} fi case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin";; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :H) # # CONFIG_HEADER # _ACEOF # Transform confdefs.h into a sed script `conftest.defines', that # substitutes the proper values into config.h.in to produce config.h. rm -f conftest.defines conftest.tail # First, append a space to every undef/define line, to ease matching. echo 's/$/ /' >conftest.defines # Then, protect against being on the right side of a sed subst, or in # an unquoted here document, in config.status. If some macros were # called several times there might be several #defines for the same # symbol, which is useless. But do not sort them, since the last # AC_DEFINE must be honored. ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* # These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where # NAME is the cpp macro being defined, VALUE is the value it is being given. # PARAMS is the parameter list in the macro definition--in most cases, it's # just an empty string. ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' ac_dB='\\)[ (].*,\\1define\\2' ac_dC=' ' ac_dD=' ,' uniq confdefs.h | sed -n ' t rset :rset s/^[ ]*#[ ]*define[ ][ ]*// t ok d :ok s/[\\&,]/\\&/g s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p ' >>conftest.defines # Remove the space that was appended to ease matching. # Then replace #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. # (The regexp can be short, since the line contains either #define or #undef.) echo 's/ $// s,^[ #]*u.*,/* & */,' >>conftest.defines # Break up conftest.defines: ac_max_sed_lines=50 # First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" # Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" # Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" # et cetera. ac_in='$ac_file_inputs' ac_out='"$tmp/out1"' ac_nxt='"$tmp/out2"' while : do # Write a here document: cat >>$CONFIG_STATUS <<_ACEOF # First, check the format of the line: cat >"\$tmp/defines.sed" <<\\CEOF /^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def /^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def b :def _ACEOF sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail grep . conftest.tail >/dev/null || break rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines conftest.tail echo "ac_result=$ac_in" >>$CONFIG_STATUS cat >>$CONFIG_STATUS <<\_ACEOF if test x"$ac_file" != x-; then echo "/* $configure_input */" >"$tmp/config.h" cat "$ac_result" >>"$tmp/config.h" if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else rm -f $ac_file mv "$tmp/config.h" $ac_file fi else echo "/* $configure_input */" cat "$ac_result" fi rm -f "$tmp/out12" ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi hugs98-plus-Sep2006/packages/stm/0000755006511100651110000000000010504340573015345 5ustar rossrosshugs98-plus-Sep2006/packages/stm/Control/0000755006511100651110000000000010504340552016762 5ustar rossrosshugs98-plus-Sep2006/packages/stm/Control/Concurrent/0000755006511100651110000000000010504340552021104 5ustar rossrosshugs98-plus-Sep2006/packages/stm/Control/Concurrent/STM/0000755006511100651110000000000010504340552021547 5ustar rossrosshugs98-plus-Sep2006/packages/stm/Control/Concurrent/STM/TArray.hs0000644006511100651110000000325110504340552023306 0ustar rossross{-# OPTIONS -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.STM.TArray -- Copyright : (c) The University of Glasgow 2005 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (requires STM) -- -- TArrays: transactional arrays, for use in the STM monad -- ----------------------------------------------------------------------------- module Control.Concurrent.STM.TArray ( TArray ) where import Control.Monad (replicateM) import Data.Array (Array, bounds) import Data.Array.Base (listArray, arrEleBottom, unsafeAt, MArray(..)) import Data.Ix (rangeSize) import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar, writeTVar) #ifdef __GLASGOW_HASKELL__ import GHC.Conc (STM) #else import Control.Sequential.STM (STM) #endif -- |TArray is a transactional array, supporting the usual 'MArray' -- interface for mutable arrays. -- -- It is currently implemented as @Array ix (TVar e)@, -- but it may be replaced by a more efficient implementation in the future -- (the interface will remain the same, however). -- newtype TArray i e = TArray (Array i (TVar e)) instance MArray TArray e STM where getBounds (TArray a) = return (bounds a) newArray b e = do a <- replicateM (rangeSize b) (newTVar e) return $ TArray (listArray b a) newArray_ b = do a <- replicateM (rangeSize b) (newTVar arrEleBottom) return $ TArray (listArray b a) unsafeRead (TArray a) i = readTVar $ unsafeAt a i unsafeWrite (TArray a) i e = writeTVar (unsafeAt a i) e hugs98-plus-Sep2006/packages/stm/Control/Concurrent/STM/TChan.hs0000644006511100651110000000422010504340552023076 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.STM.TChan -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (requires STM) -- -- TChan: Transactional channels -- ----------------------------------------------------------------------------- module Control.Concurrent.STM.TChan ( -- * TChans TChan, newTChan, newTChanIO, readTChan, writeTChan, dupTChan, unGetTChan, isEmptyTChan ) where import GHC.Conc -- | 'TChan' is an abstract type representing an unbounded FIFO channel. data TChan a = TChan (TVar (TVarList a)) (TVar (TVarList a)) type TVarList a = TVar (TList a) data TList a = TNil | TCons a (TVarList a) newTChan :: STM (TChan a) newTChan = do hole <- newTVar TNil read <- newTVar hole write <- newTVar hole return (TChan read write) newTChanIO :: IO (TChan a) newTChanIO = do hole <- newTVarIO TNil read <- newTVarIO hole write <- newTVarIO hole return (TChan read write) writeTChan :: TChan a -> a -> STM () writeTChan (TChan _read write) a = do listend <- readTVar write -- listend == TVar pointing to TNil new_listend <- newTVar TNil writeTVar listend (TCons a new_listend) writeTVar write new_listend readTChan :: TChan a -> STM a readTChan (TChan read _write) = do listhead <- readTVar read head <- readTVar listhead case head of TNil -> retry TCons a tail -> do writeTVar read tail return a dupTChan :: TChan a -> STM (TChan a) dupTChan (TChan read write) = do hole <- readTVar write new_read <- newTVar hole return (TChan new_read write) unGetTChan :: TChan a -> a -> STM () unGetTChan (TChan read _write) a = do listhead <- readTVar read newhead <- newTVar (TCons a listhead) writeTVar read newhead -- |Returns 'True' if the supplied 'TChan' is empty. isEmptyTChan :: TChan a -> STM Bool isEmptyTChan (TChan read write) = do listhead <- readTVar read head <- readTVar listhead case head of TNil -> return True TCons _ _ -> return False hugs98-plus-Sep2006/packages/stm/Control/Concurrent/STM/TMVar.hs0000644006511100651110000000437310504340552023103 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.STM.TMVar -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (requires STM) -- -- TMVar: Transactional MVars, for use in the STM monad -- ----------------------------------------------------------------------------- module Control.Concurrent.STM.TMVar ( -- * TVars TMVar, newTMVar, newEmptyTMVar, newTMVarIO, newEmptyTMVarIO, takeTMVar, putTMVar, readTMVar, swapTMVar, tryTakeTMVar, tryPutTMVar, isEmptyTMVar ) where import GHC.Conc newtype TMVar a = TMVar (TVar (Maybe a)) newTMVar :: a -> STM (TMVar a) newTMVar a = do t <- newTVar (Just a) return (TMVar t) newTMVarIO :: a -> IO (TMVar a) newTMVarIO a = do t <- newTVarIO (Just a) return (TMVar t) newEmptyTMVar :: STM (TMVar a) newEmptyTMVar = do t <- newTVar Nothing return (TMVar t) newEmptyTMVarIO :: IO (TMVar a) newEmptyTMVarIO = do t <- newTVarIO Nothing return (TMVar t) takeTMVar :: TMVar a -> STM a takeTMVar (TMVar t) = do m <- readTVar t case m of Nothing -> retry Just a -> do writeTVar t Nothing; return a tryTakeTMVar :: TMVar a -> STM (Maybe a) tryTakeTMVar (TMVar t) = do m <- readTVar t case m of Nothing -> return Nothing Just a -> do writeTVar t Nothing; return (Just a) putTMVar :: TMVar a -> a -> STM () putTMVar (TMVar t) a = do m <- readTVar t case m of Nothing -> do writeTVar t (Just a); return () Just _ -> retry tryPutTMVar :: TMVar a -> a -> STM Bool tryPutTMVar (TMVar t) a = do m <- readTVar t case m of Nothing -> do writeTVar t (Just a); return True Just _ -> return False readTMVar :: TMVar a -> STM a readTMVar (TMVar t) = do m <- readTVar t case m of Nothing -> retry Just a -> return a swapTMVar :: TMVar a -> a -> STM a swapTMVar (TMVar t) new = do m <- readTVar t case m of Nothing -> retry Just old -> do writeTVar t (Just new); return old isEmptyTMVar :: TMVar a -> STM Bool isEmptyTMVar (TMVar t) = do m <- readTVar t case m of Nothing -> return True Just _ -> return False hugs98-plus-Sep2006/packages/stm/Control/Concurrent/STM/TVar.hs0000644006511100651110000000133610504340552022762 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.STM.TVar -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (requires STM) -- -- TVar: Transactional variables -- ----------------------------------------------------------------------------- module Control.Concurrent.STM.TVar ( -- * TVars TVar, newTVar, readTVar, writeTVar, newTVarIO, #ifdef __GLASGOW_HASKELL__ registerDelay #endif ) where #ifdef __GLASGOW_HASKELL__ import GHC.Conc #else import Control.Sequential.STM #endif hugs98-plus-Sep2006/packages/stm/Control/Concurrent/STM.hs0000644006511100651110000000236610504340552022112 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.STM -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (requires STM) -- -- Software Transactional Memory: a modular composable concurrency -- abstraction. See -- -- * /Composable memory transactions/, by Tim Harris, Simon Marlow, Simon -- Peyton Jones, and Maurice Herlihy, in /ACM Conference on Principles -- and Practice of Parallel Programming/ 2005. -- -- ----------------------------------------------------------------------------- module Control.Concurrent.STM ( module Control.Monad.STM, module Control.Concurrent.STM.TVar, #ifdef __GLASGOW_HASKELL__ module Control.Concurrent.STM.TMVar, module Control.Concurrent.STM.TChan, #endif module Control.Concurrent.STM.TArray ) where import Control.Monad.STM import Control.Concurrent.STM.TVar #ifdef __GLASGOW_HASKELL__ import Control.Concurrent.STM.TMVar import Control.Concurrent.STM.TChan #endif import Control.Concurrent.STM.TArray hugs98-plus-Sep2006/packages/stm/Control/Sequential/0000755006511100651110000000000010504340552021074 5ustar rossrosshugs98-plus-Sep2006/packages/stm/Control/Sequential/STM.hs0000644006511100651110000000324610504340552022100 0ustar rossross-- Transactional memory for sequential implementations. -- Transactions do not run concurrently, but are atomic in the face -- of exceptions. -- #hide module Control.Sequential.STM ( STM, atomically, catchSTM, TVar, newTVar, newTVarIO, readTVar, writeTVar ) where import Prelude hiding (catch) import Control.Exception import Data.IORef -- The reference contains a rollback action to be executed on exceptions newtype STM a = STM (IORef (IO ()) -> IO a) unSTM :: STM a -> IORef (IO ()) -> IO a unSTM (STM f) = f instance Functor STM where fmap f (STM m) = STM (fmap f . m) instance Monad STM where return x = STM (const (return x)) STM m >>= k = STM $ \ r -> do x <- m r unSTM (k x) r atomically :: STM a -> IO a atomically (STM m) = do r <- newIORef (return ()) m r `catch` \ ex -> do rollback <- readIORef r rollback throw ex catchSTM :: STM a -> (Exception -> STM a) -> STM a catchSTM (STM m) h = STM $ \ r -> do old_rollback <- readIORef r writeIORef r (return ()) res <- try (m r) rollback_m <- readIORef r case res of Left ex -> do rollback_m writeIORef r old_rollback unSTM (h ex) r Right a -> do writeIORef r (rollback_m >> old_rollback) return a newtype TVar a = TVar (IORef a) deriving (Eq) newTVar :: a -> STM (TVar a) newTVar a = STM (const (newTVarIO a)) newTVarIO :: a -> IO (TVar a) newTVarIO a = do ref <- newIORef a return (TVar ref) readTVar :: TVar a -> STM a readTVar (TVar ref) = STM (const (readIORef ref)) writeTVar :: TVar a -> a -> STM () writeTVar (TVar ref) a = STM $ \ r -> do oldval <- readIORef ref modifyIORef r (writeIORef ref oldval >>) writeIORef ref a hugs98-plus-Sep2006/packages/stm/Control/Monad/0000755006511100651110000000000010504340552020020 5ustar rossrosshugs98-plus-Sep2006/packages/stm/Control/Monad/STM.hs0000644006511100651110000000232410504340552021020 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Control.Monad.STM -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (requires STM) -- -- Software Transactional Memory: a modular composable concurrency -- abstraction. See -- -- * /Composable memory transactions/, by Tim Harris, Simon Marlow, Simon -- Peyton Jones, and Maurice Herlihy, in /ACM Conference on Principles -- and Practice of Parallel Programming/ 2005. -- -- ----------------------------------------------------------------------------- module Control.Monad.STM ( STM, atomically, #ifdef __GLASGOW_HASKELL__ retry, orElse, check, #endif catchSTM ) where #ifdef __GLASGOW_HASKELL__ import GHC.Conc import Control.Monad ( MonadPlus(..) ) #else import Control.Sequential.STM #endif #ifdef __GLASGOW_HASKELL__ instance MonadPlus STM where mzero = retry mplus = orElse check :: Bool -> STM a check b = if b then return undefined else retry #endif hugs98-plus-Sep2006/packages/stm/prologue.txt0000644006511100651110000000011510504340552017734 0ustar rossrossSoftware Transactional Memory: a modular composable concurrency abstraction. hugs98-plus-Sep2006/packages/stm/Makefile0000644006511100651110000000045610504340552017007 0ustar rossrossTOP=.. include $(TOP)/mk/boilerplate.mk ALL_DIRS = \ Control/Concurrent \ Control/Concurrent/STM \ Control/Monad PACKAGE = stm VERSION = 2.0 PACKAGE_DEPS = base SRC_HC_OPTS += -fglasgow-exts -cpp SRC_HADDOCK_OPTS += -t "Haskell Hierarchical Libraries (stm package)" include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/stm/package.conf.in0000644006511100651110000000100610504340552020206 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: Control.Concurrent.STM, Control.Concurrent.STM.TVar, Control.Concurrent.STM.TChan, Control.Concurrent.STM.TMVar, Control.Monad.STM hidden-modules: import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSstm" extra-libraries: include-dirs: includes: depends: base hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/stm/LICENSE0000644006511100651110000000311310504340552016345 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/stm/stm.cabal0000644006511100651110000000071510504340552017134 0ustar rossrossname: stm version: 2.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org synopsis: Software Transactional Memory description: A modular composable concurrency abstraction. -- these are the modules exposed by the cut-down non-GHC interface. exposed-modules: Control.Concurrent.STM Control.Concurrent.STM.TArray Control.Concurrent.STM.TVar Control.Monad.STM other-modules: Control.Sequential.STM build-depends: base extensions: CPP hugs98-plus-Sep2006/packages/xhtml/0000755006511100651110000000000010504340573015676 5ustar rossrosshugs98-plus-Sep2006/packages/xhtml/LICENSE0000644006511100651110000000315110504340572016702 0ustar rossrossCopyright 2001-2005, The University Court of the University of Glasgow, Bjorn Bringert, Andy Gill, Ian Lynagh, Erik Meijer, Sven Panne All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/packages/xhtml/Text/0000755006511100651110000000000010504340573016622 5ustar rossrosshugs98-plus-Sep2006/packages/xhtml/Text/XHtml/0000755006511100651110000000000010504340573017656 5ustar rossrosshugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Frameset/0000755006511100651110000000000010504340573021424 5ustar rossrosshugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Frameset/Attributes.hs0000644006511100651110000000106510504340573024110 0ustar rossross-- #hide module Text.XHtml.Frameset.Attributes where import Text.XHtml.Internals -- * Extra attributes in XHTML Frameset frameborder :: Int -> HtmlAttr frameborder = intAttr "frameborder" marginheight :: Int -> HtmlAttr marginheight = intAttr "marginheight" marginwidth :: Int -> HtmlAttr marginwidth = intAttr "marginwidth" noresize :: HtmlAttr noresize = emptyAttr "noresize" scrolling :: String -> HtmlAttr scrolling = strAttr "scrolling" hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Frameset/Elements.hs0000644006511100651110000000052610504340573023537 0ustar rossross-- #hide module Text.XHtml.Frameset.Elements where import Text.XHtml.Internals -- * Extra elements in XHTML Frameset frame :: Html -> Html frame = tag "frame" frameset :: Html -> Html frameset = tag "frameset" noframes :: Html -> Html noframes = tag "noframes" hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/BlockTable.hs0000644006511100651110000001077310504340573022224 0ustar rossross-- #hide ----------------------------------------------------------------------------- -- | -- Module : Text.XHtml.BlockTable -- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of -- Science and Technology, 1999-2001 -- License : BSD-style (see the file LICENSE) -- Maintainer : Bjorn Bringert -- Stability : experimental -- Portability : portable -- -- An XHTML combinator library -- -- These combinators can be used to build formated 2D tables. -- The specific target usage is for HTML table generation. ----------------------------------------------------------------------------- {- Examples of use: > table1 :: BlockTable String > table1 = single "Hello" +-----+ |Hello| This is a 1x1 cell +-----+ Note: single has type single :: a -> BlockTable a So the cells can contain anything. > table2 :: BlockTable String > table2 = single "World" +-----+ |World| +-----+ > table3 :: BlockTable String > table3 = table1 %-% table2 +-----%-----+ |Hello%World| % is used to indicate +-----%-----+ the join edge between the two Tables. > table4 :: BlockTable String > table4 = table3 %/% table2 +-----+-----+ |Hello|World| Notice the padding on the %%%%%%%%%%%%% smaller (bottom) cell to |World | force the table to be a +-----------+ rectangle. > table5 :: BlockTable String > table5 = table1 %-% table4 +-----%-----+-----+ |Hello%Hello|World| Notice the padding on the | %-----+-----+ leftmost cell, again to | %World | force the table to be a +-----%-----------+ rectangle. Now the table can be rendered with processTable, for example: Main> processTable table5 [[("Hello",(1,2)), ("Hello",(1,1)), ("World",(1,1))], [("World",(2,1))]] :: [[([Char],(Int,Int))]] Main> -} module Text.XHtml.BlockTable ( -- * Datatypes BlockTable, -- * Contruction Functions single, above, beside, -- * Investigation Functions getMatrix, showsTable, showTable, ) where infixr 4 `beside` infixr 3 `above` -- -- * Construction Functions -- -- Perhaps one day I'll write the Show instance -- to show boxes aka the above ascii renditions. instance (Show a) => Show (BlockTable a) where showsPrec p = showsTable type TableI a = [[(a,(Int,Int))]] -> [[(a,(Int,Int))]] data BlockTable a = Table (Int -> Int -> TableI a) Int Int -- | Creates a (1x1) table entry single :: a -> BlockTable a single a = Table (\ x y z -> [(a,(x+1,y+1))] : z) 1 1 -- | Composes tables vertically. above :: BlockTable a -> BlockTable a -> BlockTable a -- | Composes tables horizontally. beside :: BlockTable a -> BlockTable a -> BlockTable a t1 `above` t2 = trans (combine (trans t1) (trans t2) (.)) t1 `beside` t2 = combine t1 t2 (\ lst1 lst2 r -> let -- Note this depends on the fact that -- that the result has the same number -- of lines as the y dimention; one list -- per line. This is not true in general -- but is always true for these combinators. -- I should assert this! -- I should even prove this. beside (x:xs) (y:ys) = (x ++ y) : beside xs ys beside (x:xs) [] = x : xs ++ r beside [] (y:ys) = y : ys ++ r beside [] [] = r in beside (lst1 []) (lst2 [])) -- | trans flips (transposes) over the x and y axis of -- the table. It is only used internally, and typically -- in pairs, ie. (flip ... munge ... (un)flip). trans :: BlockTable a -> BlockTable a trans (Table f1 x1 y1) = Table (flip f1) y1 x1 combine :: BlockTable a -> BlockTable b -> (TableI a -> TableI b -> TableI c) -> BlockTable c combine (Table f1 x1 y1) (Table f2 x2 y2) comb = Table new_fn (x1+x2) max_y where max_y = max y1 y2 new_fn x y = case compare y1 y2 of EQ -> comb (f1 0 y) (f2 x y) GT -> comb (f1 0 y) (f2 x (y + y1 - y2)) LT -> comb (f1 0 (y + y2 - y1)) (f2 x y) -- -- * Investigation Functions -- -- | This is the other thing you can do with a Table; -- turn it into a 2D list, tagged with the (x,y) -- sizes of each cell in the table. getMatrix :: BlockTable a -> [[(a,(Int,Int))]] getMatrix (Table r _ _) = r 0 0 [] -- You can also look at a table showsTable :: (Show a) => BlockTable a -> ShowS showsTable table = shows (getMatrix table) showTable :: (Show a) => BlockTable a -> String showTable table = showsTable table "" hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Strict/0000755006511100651110000000000010504340573021126 5ustar rossrosshugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Strict/Attributes.hs0000644006511100651110000000741010504340573023612 0ustar rossross-- #hide module Text.XHtml.Strict.Attributes where import Text.XHtml.Internals -- * Attributes in XHTML Strict action :: String -> HtmlAttr align :: String -> HtmlAttr alt :: String -> HtmlAttr altcode :: String -> HtmlAttr archive :: String -> HtmlAttr base :: String -> HtmlAttr border :: Int -> HtmlAttr bordercolor :: String -> HtmlAttr cellpadding :: Int -> HtmlAttr cellspacing :: Int -> HtmlAttr checked :: HtmlAttr codebase :: String -> HtmlAttr cols :: String -> HtmlAttr colspan :: Int -> HtmlAttr content :: String -> HtmlAttr coords :: String -> HtmlAttr enctype :: String -> HtmlAttr height :: String -> HtmlAttr href :: String -> HtmlAttr httpequiv :: String -> HtmlAttr identifier :: String -> HtmlAttr ismap :: HtmlAttr lang :: String -> HtmlAttr maxlength :: Int -> HtmlAttr method :: String -> HtmlAttr multiple :: HtmlAttr name :: String -> HtmlAttr nohref :: HtmlAttr rel :: String -> HtmlAttr rev :: String -> HtmlAttr rows :: String -> HtmlAttr rowspan :: Int -> HtmlAttr rules :: String -> HtmlAttr selected :: HtmlAttr shape :: String -> HtmlAttr size :: String -> HtmlAttr src :: String -> HtmlAttr theclass :: String -> HtmlAttr thestyle :: String -> HtmlAttr thetype :: String -> HtmlAttr title :: String -> HtmlAttr usemap :: String -> HtmlAttr valign :: String -> HtmlAttr value :: String -> HtmlAttr width :: String -> HtmlAttr action = strAttr "action" align = strAttr "align" alt = strAttr "alt" altcode = strAttr "altcode" archive = strAttr "archive" base = strAttr "base" border = intAttr "border" bordercolor = strAttr "bordercolor" cellpadding = intAttr "cellpadding" cellspacing = intAttr "cellspacing" checked = emptyAttr "checked" codebase = strAttr "codebase" cols = strAttr "cols" colspan = intAttr "colspan" content = strAttr "content" coords = strAttr "coords" enctype = strAttr "enctype" height = strAttr "height" href = strAttr "href" httpequiv = strAttr "http-equiv" identifier = strAttr "id" ismap = emptyAttr "ismap" lang = strAttr "lang" maxlength = intAttr "maxlength" method = strAttr "method" multiple = emptyAttr "multiple" name = strAttr "name" nohref = emptyAttr "nohref" rel = strAttr "rel" rev = strAttr "rev" rows = strAttr "rows" rowspan = intAttr "rowspan" rules = strAttr "rules" selected = emptyAttr "selected" shape = strAttr "shape" size = strAttr "size" src = strAttr "src" theclass = strAttr "class" thestyle = strAttr "style" thetype = strAttr "type" title = strAttr "title" usemap = strAttr "usemap" valign = strAttr "valign" value = strAttr "value" width = strAttr "width" hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Strict/Elements.hs0000644006511100651110000001256610504340573023250 0ustar rossross-- #hide module Text.XHtml.Strict.Elements where import Text.XHtml.Internals -- * Elements in XHTML Strict abbr :: Html -> Html acronym :: Html -> Html address :: Html -> Html anchor :: Html -> Html area :: Html bdo :: Html -> Html big :: Html -> Html blockquote :: Html -> Html body :: Html -> Html bold :: Html -> Html br :: Html button :: Html -> Html caption :: Html -> Html cite :: Html -> Html col :: Html -> Html colgroup :: Html -> Html del :: Html -> Html ddef :: Html -> Html define :: Html -> Html dlist :: Html -> Html dterm :: Html -> Html emphasize :: Html -> Html fieldset :: Html -> Html form :: Html -> Html h1 :: Html -> Html h2 :: Html -> Html h3 :: Html -> Html h4 :: Html -> Html h5 :: Html -> Html h6 :: Html -> Html header :: Html -> Html hr :: Html image :: Html input :: Html ins :: Html -> Html italics :: Html -> Html keyboard :: Html -> Html label :: Html -> Html legend :: Html -> Html li :: Html -> Html meta :: Html noscript :: Html -> Html object :: Html -> Html olist :: Html -> Html optgroup :: Html -> Html option :: Html -> Html paragraph :: Html -> Html param :: Html pre :: Html -> Html quote :: Html -> Html sample :: Html -> Html script :: Html -> Html select :: Html -> Html small :: Html -> Html strong :: Html -> Html style :: Html -> Html sub :: Html -> Html sup :: Html -> Html table :: Html -> Html tbody :: Html -> Html td :: Html -> Html textarea :: Html -> Html tfoot :: Html -> Html th :: Html -> Html thead :: Html -> Html thebase :: Html thecode :: Html -> Html thediv :: Html -> Html thehtml :: Html -> Html thelink :: Html -> Html themap :: Html -> Html thespan :: Html -> Html thetitle :: Html -> Html tr :: Html -> Html tt :: Html -> Html ulist :: Html -> Html variable :: Html -> Html abbr = tag "abbr" acronym = tag "acronym" address = tag "address" anchor = tag "a" area = itag "area" bdo = tag "bdo" big = tag "big" blockquote = tag "blockquote" body = tag "body" bold = tag "b" button = tag "button" br = itag "br" caption = tag "caption" cite = tag "cite" col = tag "col" colgroup = tag "colgroup" ddef = tag "dd" define = tag "dfn" del = tag "del" dlist = tag "dl" dterm = tag "dt" emphasize = tag "em" fieldset = tag "fieldset" form = tag "form" h1 = tag "h1" h2 = tag "h2" h3 = tag "h3" h4 = tag "h4" h5 = tag "h5" h6 = tag "h6" header = tag "head" hr = itag "hr" image = itag "img" input = itag "input" ins = tag "ins" italics = tag "i" keyboard = tag "kbd" label = tag "label" legend = tag "legend" li = tag "li" meta = itag "meta" noscript = tag "noscript" object = tag "object" olist = tag "ol" optgroup = tag "optgroup" option = tag "option" paragraph = tag "p" param = itag "param" pre = tag "pre" quote = tag "q" sample = tag "samp" script = tag "script" select = tag "select" small = tag "small" strong = tag "strong" style = tag "style" sub = tag "sub" sup = tag "sup" table = tag "table" tbody = tag "tbody" td = tag "td" textarea = tag "textarea" tfoot = tag "tfoot" th = tag "th" thead = tag "thead" thebase = itag "base" thecode = tag "code" thediv = tag "div" thehtml = tag "html" thelink = tag "link" themap = tag "map" thespan = tag "span" thetitle = tag "title" tr = tag "tr" tt = tag "tt" ulist = tag "ul" variable = tag "var" hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Transitional/0000755006511100651110000000000010504340573022325 5ustar rossrosshugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Transitional/Attributes.hs0000644006511100651110000000731310504340573025013 0ustar rossross-- #hide module Text.XHtml.Transitional.Attributes where import Text.XHtml.Internals -- * Extra attributes in XHTML Transitional {-# DEPRECATED alink "This attribute is deprecated in XHTML 1.0" #-} alink :: String -> HtmlAttr alink = strAttr "alink" {-# DEPRECATED background "This attribute is deprecated in XHTML 1.0" #-} background :: String -> HtmlAttr background = strAttr "background" {-# DEPRECATED bgcolor "This attribute is deprecated in XHTML 1.0" #-} bgcolor :: String -> HtmlAttr bgcolor = strAttr "bgcolor" {-# DEPRECATED clear "This attribute is deprecated in XHTML 1.0" #-} clear :: String -> HtmlAttr clear = strAttr "clear" {-# DEPRECATED code "This attribute is deprecated in XHTML 1.0" #-} code :: String -> HtmlAttr code = strAttr "code" {-# DEPRECATED color "This attribute is deprecated in XHTML 1.0" #-} color :: String -> HtmlAttr color = strAttr "color" {-# DEPRECATED compact "This attribute is deprecated in XHTML 1.0" #-} compact :: HtmlAttr compact = emptyAttr "compact" {-# DEPRECATED face "This attribute is deprecated in XHTML 1.0" #-} face :: String -> HtmlAttr face = strAttr "face" {-# DEPRECATED hspace "This attribute is deprecated in XHTML 1.0" #-} hspace :: Int -> HtmlAttr hspace = intAttr "hspace" {-# DEPRECATED link "This attribute is deprecated in XHTML 1.0" #-} link :: String -> HtmlAttr link = strAttr "link" {-# DEPRECATED noshade "This attribute is deprecated in XHTML 1.0" #-} noshade :: HtmlAttr noshade = emptyAttr "noshade" {-# DEPRECATED nowrap "This attribute is deprecated in XHTML 1.0" #-} nowrap :: HtmlAttr nowrap = emptyAttr "nowrap" {-# DEPRECATED start "This attribute is deprecated in XHTML 1.0" #-} start :: Int -> HtmlAttr start = intAttr "start" target :: String -> HtmlAttr target = strAttr "target" {-# DEPRECATED text "This attribute is deprecated in XHTML 1.0" #-} text :: String -> HtmlAttr text = strAttr "text" {-# DEPRECATED version "This attribute is deprecated in XHTML 1.0" #-} version :: String -> HtmlAttr version = strAttr "version" {-# DEPRECATED vlink "This attribute is deprecated in XHTML 1.0" #-} vlink :: String -> HtmlAttr vlink = strAttr "vlink" {-# DEPRECATED vspace "This attribute is deprecated in XHTML 1.0" #-} vspace :: Int -> HtmlAttr vspace = intAttr "vspace" -- -- * Html colors -- {-# DEPRECATED aqua,black,blue,fuchsia,gray,green,lime,maroon,navy,olive,purple,red,silver,teal,yellow,white "The use of color attibutes is deprecated in XHTML 1.0" #-} aqua :: String black :: String blue :: String fuchsia :: String gray :: String green :: String lime :: String maroon :: String navy :: String olive :: String purple :: String red :: String silver :: String teal :: String yellow :: String white :: String aqua = "aqua" black = "black" blue = "blue" fuchsia = "fuchsia" gray = "gray" green = "green" lime = "lime" maroon = "maroon" navy = "navy" olive = "olive" purple = "purple" red = "red" silver = "silver" teal = "teal" yellow = "yellow" white = "white" hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Transitional/Elements.hs0000644006511100651110000000266010504340573024441 0ustar rossross-- #hide module Text.XHtml.Transitional.Elements where import Text.XHtml.Internals -- * Extra elements in XHTML Transitional {-# DEPRECATED applet "This element is deprecated in XHTML 1.0" #-} applet :: Html -> Html applet = tag "applet" {-# DEPRECATED basefont "This element is deprecated in XHTML 1.0" #-} basefont :: Html basefont = itag "basefont" {-# DEPRECATED center "This element is deprecated in XHTML 1.0" #-} center :: Html -> Html center = tag "center" {-# DEPRECATED dir "This element is deprecated in XHTML 1.0" #-} dir :: Html -> Html dir = tag "dir" {-# DEPRECATED font "This element is deprecated in XHTML 1.0" #-} font :: Html -> Html font = tag "font" iframe :: Html -> Html iframe = tag "iframe" {-# DEPRECATED isindex "This element is deprecated in XHTML 1.0" #-} isindex :: Html isindex = itag "isindex" {-# DEPRECATED themenu "This element is deprecated in XHTML 1.0" #-} themenu :: Html -> Html themenu = tag "menu" {-# DEPRECATED strike "This element is deprecated in XHTML 1.0" #-} strike :: Html -> Html strike = tag "strike" {-# DEPRECATED underline "This element is deprecated in XHTML 1.0" #-} underline :: Html -> Html underline = tag "u" hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Frameset.hs0000644006511100651110000000340710504340573021764 0ustar rossross-- | Produces XHTML 1.0 Frameset. module Text.XHtml.Frameset ( -- * Data types Html, HtmlAttr, -- * Classes HTML(..), ADDATTRS(..), -- * Primitives and basic combinators (<<), concatHtml, (+++), noHtml, isNoHtml, tag, itag, emptyAttr, intAttr, strAttr, primHtml, -- * Rendering showHtml, renderHtml, prettyHtml, showHtmlFragment, renderHtmlFragment, prettyHtmlFragment, module Text.XHtml.Strict.Elements, module Text.XHtml.Frameset.Elements, module Text.XHtml.Strict.Attributes, module Text.XHtml.Frameset.Attributes, module Text.XHtml.Extras ) where import Text.XHtml.Internals import Text.XHtml.Strict.Elements import Text.XHtml.Frameset.Elements import Text.XHtml.Strict.Attributes import Text.XHtml.Frameset.Attributes import Text.XHtml.Extras docType = "" -- | Output the HTML without adding newlines or spaces within the markup. -- This should be the most time and space efficient way to -- render HTML, though the ouput is quite unreadable. showHtml :: HTML html => html -> String showHtml = showHtmlInternal docType -- | Outputs indented HTML. Because space matters in -- HTML, the output is quite messy. renderHtml :: HTML html => html -> String renderHtml = renderHtmlInternal docType -- | Outputs indented HTML, with indentation inside elements. -- This can change the meaning of the HTML document, and -- is mostly useful for debugging the HTML output. -- The implementation is inefficient, and you are normally -- better off using 'showHtml' or 'renderHtml'. prettyHtml :: HTML html => html -> String prettyHtml = prettyHtmlInternal docTypehugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Debug.hs0000644006511100651110000000672310504340573021250 0ustar rossross-- | This module contains functions for displaying -- HTML as a pretty tree. module Text.XHtml.Debug where import Text.XHtml.Internals import Text.XHtml.Extras import Text.XHtml.Table import Text.XHtml.Strict.Elements import Text.XHtml.Strict.Attributes import Text.XHtml.Transitional.Elements import Text.XHtml.Transitional.Attributes -- -- * Tree Displaying Combinators -- -- | The basic idea is you render your structure in the form -- of this tree, and then use treeHtml to turn it into a Html -- object with the structure explicit. data HtmlTree = HtmlLeaf Html | HtmlNode Html [HtmlTree] Html treeHtml :: [String] -> HtmlTree -> Html treeHtml colors h = table ! [ border 0, cellpadding 0, cellspacing 2] << treeHtml' colors h where manycolors = scanr (:) [] treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable treeHtmls c ts = aboves (zipWith treeHtml' c ts) treeHtml' :: [String] -> HtmlTree -> HtmlTable treeHtml' (c:_) (HtmlLeaf leaf) = cell (td ! [width "100%"] << bold << leaf) treeHtml' (c:cs@(c2:_)) (HtmlNode hopen ts hclose) = if null ts && isNoHtml hclose then cell hd else if null ts then hd bar `beside` (td ! [bgcolor c2] << spaceHtml) tl else hd (bar `beside` treeHtmls morecolors ts) tl where -- This stops a column of colors being the same -- color as the immeduately outside nesting bar. morecolors = filter ((/= c).head) (manycolors cs) bar = td ! [bgcolor c,width "10"] << spaceHtml hd = td ! [bgcolor c] << hopen tl = td ! [bgcolor c] << hclose treeHtml' _ _ = error "The imposible happens" instance HTML HtmlTree where toHtml x = treeHtml treeColors x -- type "length treeColors" to see how many colors are here. treeColors = ["#88ccff","#ffffaa","#ffaaff","#ccffff"] ++ treeColors -- -- * Html Debugging Combinators -- -- | This uses the above tree rendering function, and displays the -- Html as a tree structure, allowing debugging of what is -- actually getting produced. debugHtml :: (HTML a) => a -> Html debugHtml obj = table ! [border 0] << ( th ! [bgcolor "#008888"] << underline << "Debugging Output" td << (toHtml (debug' (toHtml obj))) ) where debug' :: Html -> [HtmlTree] debug' (Html markups) = map debug markups debug :: HtmlElement -> HtmlTree debug (HtmlString str) = HtmlLeaf (spaceHtml +++ linesToHtml (lines str)) debug (HtmlTag { markupTag = markupTag, markupContent = markupContent, markupAttrs = markupAttrs }) = case markupContent of Html [] -> HtmlNode hd [] noHtml Html xs -> HtmlNode hd (map debug xs) tl where args = if null markupAttrs then "" else " " ++ unwords (map show markupAttrs) hd = font ! [size "1"] << ("<" ++ markupTag ++ args ++ ">") tl = font ! [size "1"] << ("") hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Extras.hs0000644006511100651110000000616310504340573021466 0ustar rossross-- #hide module Text.XHtml.Extras where import Text.XHtml.Internals import Text.XHtml.Strict.Elements import Text.XHtml.Strict.Attributes -- -- * Converting strings to HTML -- -- | Convert a 'String' to 'Html', converting -- characters that need to be escaped to HTML entities. stringToHtml :: String -> Html stringToHtml = primHtml . stringToHtmlString -- | This converts a string, but keeps spaces as non-line-breakable. lineToHtml :: String -> Html lineToHtml = primHtml . concatMap htmlizeChar2 . stringToHtmlString where htmlizeChar2 ' ' = " " htmlizeChar2 c = [c] -- | This converts a string, but keeps spaces as non-line-breakable, -- and adds line breaks between each of the strings in the input list. linesToHtml :: [String] -> Html linesToHtml [] = noHtml linesToHtml (x:[]) = lineToHtml x linesToHtml (x:xs) = lineToHtml x +++ br +++ linesToHtml xs -- -- * Html abbreviations -- primHtmlChar :: String -> Html -- | Copyright sign. copyright :: Html -- | Non-breaking space. spaceHtml :: Html bullet :: Html primHtmlChar = \ x -> primHtml ("&" ++ x ++ ";") copyright = primHtmlChar "copy" spaceHtml = primHtmlChar "nbsp" bullet = primHtmlChar "#149" -- | Same as 'paragraph'. p :: Html -> Html p = paragraph -- -- * Hotlinks -- type URL = String data HotLink = HotLink { hotLinkURL :: URL, hotLinkContents :: Html, hotLinkAttributes :: [HtmlAttr] } deriving Show instance HTML HotLink where toHtml hl = anchor ! (href (hotLinkURL hl) : hotLinkAttributes hl) << hotLinkContents hl hotlink :: URL -> Html -> HotLink hotlink url h = HotLink { hotLinkURL = url, hotLinkContents = h, hotLinkAttributes = [] } -- -- * Lists -- -- (Abridged from Erik Meijer's Original Html library) ordList :: (HTML a) => [a] -> Html ordList items = olist << map (li <<) items unordList :: (HTML a) => [a] -> Html unordList items = ulist << map (li <<) items defList :: (HTML a,HTML b) => [(a,b)] -> Html defList items = dlist << [ [ dterm << dt, ddef << dd ] | (dt,dd) <- items ] -- -- * Forms -- widget :: String -> String -> [HtmlAttr] -> Html widget w n markupAttrs = input ! ([thetype w,name n] ++ markupAttrs) checkbox :: String -> String -> Html hidden :: String -> String -> Html radio :: String -> String -> Html reset :: String -> String -> Html submit :: String -> String -> Html password :: String -> Html textfield :: String -> Html afile :: String -> Html clickmap :: String -> Html checkbox n v = widget "checkbox" n [value v] hidden n v = widget "hidden" n [value v] radio n v = widget "radio" n [value v] reset n v = widget "reset" n [value v] submit n v = widget "submit" n [value v] password n = widget "password" n [] textfield n = widget "text" n [] afile n = widget "file" n [] clickmap n = widget "image" n [] menu :: String -> [Html] -> Html menu n choices = select ! [name n] << [ option << p << choice | choice <- choices ] gui :: String -> Html -> Html gui act = form ! [action act,method "post"]hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Transitional.hs0000644006511100651110000000371110504340573022663 0ustar rossross-- | Produces XHTML 1.0 Transitional. module Text.XHtml.Transitional ( -- * Data types Html, HtmlAttr, -- * Classes HTML(..), ADDATTRS(..), -- * Primitives and basic combinators (<<), concatHtml, (+++), noHtml, isNoHtml, tag, itag, emptyAttr, intAttr, strAttr, primHtml, -- * Rendering showHtml, renderHtml, prettyHtml, showHtmlFragment, renderHtmlFragment, prettyHtmlFragment, module Text.XHtml.Strict.Elements, module Text.XHtml.Frameset.Elements, module Text.XHtml.Transitional.Elements, module Text.XHtml.Strict.Attributes, module Text.XHtml.Frameset.Attributes, module Text.XHtml.Transitional.Attributes, module Text.XHtml.Extras ) where import Text.XHtml.Internals import Text.XHtml.Strict.Elements import Text.XHtml.Frameset.Elements import Text.XHtml.Transitional.Elements import Text.XHtml.Strict.Attributes import Text.XHtml.Frameset.Attributes import Text.XHtml.Transitional.Attributes import Text.XHtml.Extras docType = "" -- | Output the HTML without adding newlines or spaces within the markup. -- This should be the most time and space efficient way to -- render HTML, though the ouput is quite unreadable. showHtml :: HTML html => html -> String showHtml = showHtmlInternal docType -- | Outputs indented HTML. Because space matters in -- HTML, the output is quite messy. renderHtml :: HTML html => html -> String renderHtml = renderHtmlInternal docType -- | Outputs indented HTML, with indentation inside elements. -- This can change the meaning of the HTML document, and -- is mostly useful for debugging the HTML output. -- The implementation is inefficient, and you are normally -- better off using 'showHtml' or 'renderHtml'. prettyHtml :: HTML html => html -> String prettyHtml = prettyHtmlInternal docTypehugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Internals.hs0000644006511100651110000002363610504340573022163 0ustar rossross-- #hide ----------------------------------------------------------------------------- -- | -- Module : Text.XHtml.internals -- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of -- Science and Technology, 1999-2001, -- (c) Bjorn Bringert, 2004-2006 -- License : BSD-style (see the file LICENSE) -- Maintainer : Bjorn Bringert -- Stability : experimental -- Portability : portable -- -- Internals of the XHTML combinator library. ----------------------------------------------------------------------------- module Text.XHtml.Internals where import Data.Char import Data.Monoid infixr 2 +++ -- combining Html infixr 7 << -- nesting Html infixl 8 ! -- adding optional arguments -- -- * Data types -- -- | A important property of Html is that all strings inside the -- structure are already in Html friendly format. data HtmlElement = HtmlString String -- ^ ..just..plain..normal..text... but using © and &amb;, etc. | HtmlTag { markupTag :: String, markupAttrs :: [HtmlAttr], markupContent :: Html } -- ^ tag with internal markup -- | Attributes with name and value. data HtmlAttr = HtmlAttr String String newtype Html = Html { getHtmlElements :: [HtmlElement] } -- -- * Classes -- instance Show Html where showsPrec _ html = showString (renderHtmlFragment html) showList htmls = foldr (.) id (map shows htmls) instance Show HtmlAttr where showsPrec _ (HtmlAttr str val) = showString str . showString "=" . shows val instance Monoid Html where mempty = noHtml mappend = (+++) -- | HTML is the class of things that can be validly put -- inside an HTML tag. So this can be one or more 'Html' elements, -- or a 'String', for example. class HTML a where toHtml :: a -> Html toHtmlFromList :: [a] -> Html toHtmlFromList xs = Html (concat [ x | (Html x) <- map toHtml xs]) instance HTML Html where toHtml a = a instance HTML Char where toHtml a = toHtml [a] toHtmlFromList [] = Html [] toHtmlFromList str = Html [HtmlString (stringToHtmlString str)] instance (HTML a) => HTML [a] where toHtml xs = toHtmlFromList xs class ADDATTRS a where (!) :: a -> [HtmlAttr] -> a instance (ADDATTRS b) => ADDATTRS (a -> b) where fn ! attr = \ arg -> fn arg ! attr instance ADDATTRS Html where (Html htmls) ! attr = Html (map addAttrs htmls) where addAttrs (html@(HtmlTag { markupAttrs = markupAttrs }) ) = html { markupAttrs = markupAttrs ++ attr } addAttrs html = html -- -- * Html primitives and basic combinators -- -- | Put something inside an HTML element. (<<) :: (HTML a) => (Html -> b) -- ^ Parent -> a -- ^ Child -> b fn << arg = fn (toHtml arg) concatHtml :: (HTML a) => [a] -> Html concatHtml as = Html (concat (map (getHtmlElements.toHtml) as)) -- | Create a piece of HTML which is the concatenation -- of two things which can be made into HTML. (+++) :: (HTML a,HTML b) => a -> b -> Html a +++ b = Html (getHtmlElements (toHtml a) ++ getHtmlElements (toHtml b)) -- | An empty piece of HTML. noHtml :: Html noHtml = Html [] -- | Checks whether the given piece of HTML is empty. isNoHtml :: Html -> Bool isNoHtml (Html xs) = null xs -- | Constructs an element with a custom name. tag :: String -- ^ Element name -> Html -- ^ Element contents -> Html tag str htmls = Html [ HtmlTag { markupTag = str, markupAttrs = [], markupContent = htmls }] -- | Constructs an element with a custom name, and -- without any children. itag :: String -> Html itag str = tag str noHtml emptyAttr :: String -> HtmlAttr emptyAttr s = HtmlAttr s s intAttr :: String -> Int -> HtmlAttr intAttr s i = HtmlAttr s (show i) strAttr :: String -> String -> HtmlAttr strAttr s t = HtmlAttr s (stringToHtmlString t) {- foldHtml :: (String -> [HtmlAttr] -> [a] -> a) -> (String -> a) -> Html -> a foldHtml f g (HtmlTag str attr fmls) = f str attr (map (foldHtml f g) fmls) foldHtml f g (HtmlString str) = g str -} -- | Processing Strings into Html friendly things. stringToHtmlString :: String -> String stringToHtmlString = concatMap fixChar where fixChar '<' = "<" fixChar '>' = ">" fixChar '&' = "&" fixChar '"' = """ fixChar c | ord c < 0xff = [c] fixChar c = "&#" ++ show (ord c) ++ ";" -- | This is not processed for special chars. -- use stringToHtml or lineToHtml instead, for user strings, -- because they understand special chars, like @'<'@. primHtml :: String -> Html primHtml x = Html [HtmlString x] -- -- * Html Rendering -- -- | Output the HTML without adding newlines or spaces within the markup. -- This should be the most time and space efficient way to -- render HTML, though the ouput is quite unreadable. showHtmlInternal :: HTML html => String -- ^ DOCTYPE declaration -> html -> String showHtmlInternal docType theHtml = docType ++ showHtmlFragment (tag "html" << theHtml) -- | Outputs indented HTML. Because space matters in -- HTML, the output is quite messy. renderHtmlInternal :: HTML html => String -- ^ DOCTYPE declaration -> html -> String renderHtmlInternal docType theHtml = docType ++ "\n" ++ renderHtmlFragment (tag "html" << theHtml) ++ "\n" -- | Outputs indented HTML, with indentation inside elements. -- This can change the meaning of the HTML document, and -- is mostly useful for debugging the HTML output. -- The implementation is inefficient, and you are normally -- better off using 'showHtml' or 'renderHtml'. prettyHtmlInternal :: HTML html => String -- ^ DOCTYPE declaration -> html -> String prettyHtmlInternal docType theHtml = docType ++ "\n" ++ prettyHtmlFragment (tag "html" << theHtml) -- | Render a piece of HTML without adding a DOCTYPE declaration -- or root element. Does not add any extra whitespace. showHtmlFragment :: HTML html => html -> String showHtmlFragment h = (foldr (.) id $ map showHtml' $ getHtmlElements $ toHtml h) "" -- | Render a piece of indented HTML without adding a DOCTYPE declaration -- or root element. Only adds whitespace where it does not change -- the meaning of the document. renderHtmlFragment :: HTML html => html -> String renderHtmlFragment h = (foldr (.) id $ map (renderHtml' 0) $ getHtmlElements $ toHtml h) "" -- | Render a piece of indented HTML without adding a DOCTYPE declaration -- or a root element. -- The indentation is done inside elements. -- This can change the meaning of the HTML document, and -- is mostly useful for debugging the HTML output. -- The implementation is inefficient, and you are normally -- better off using 'showHtmlFragment' or 'renderHtmlFragment'. prettyHtmlFragment :: HTML html => html -> String prettyHtmlFragment = unlines . concat . map prettyHtml' . getHtmlElements . toHtml -- | Show a single HTML element, without adding whitespace. showHtml' :: HtmlElement -> ShowS showHtml' (HtmlString str) = (++) str showHtml'(HtmlTag { markupTag = name, markupContent = html, markupAttrs = markupAttrs }) = if isNoHtml html && elem name validHtmlITags then renderTag True name markupAttrs "" else (renderTag False name markupAttrs "" . foldr (.) id (map showHtml' (getHtmlElements html)) . renderEndTag name "") renderHtml' :: Int -> HtmlElement -> ShowS renderHtml' _ (HtmlString str) = (++) str renderHtml' n (HtmlTag { markupTag = name, markupContent = html, markupAttrs = markupAttrs }) = if isNoHtml html && elem name validHtmlITags then renderTag True name markupAttrs (nl n) else (renderTag False name markupAttrs (nl n) . foldr (.) id (map (renderHtml' (n+2)) (getHtmlElements html)) . renderEndTag name (nl n)) where nl n = "\n" ++ replicate (n `div` 8) '\t' ++ replicate (n `mod` 8) ' ' prettyHtml' :: HtmlElement -> [String] prettyHtml' (HtmlString str) = [str] prettyHtml' (HtmlTag { markupTag = name, markupContent = html, markupAttrs = markupAttrs }) = if isNoHtml html && elem name validHtmlITags then [rmNL (renderTag True name markupAttrs "" "")] else [rmNL (renderTag False name markupAttrs "" "")] ++ shift (concat (map prettyHtml' (getHtmlElements html))) ++ [rmNL (renderEndTag name "" "")] where shift = map (\x -> " " ++ x) rmNL = filter (/= '\n') -- | Show a start tag renderTag :: Bool -- ^ 'True' if the empty tag shorthand should be used -> String -- ^ Tag name -> [HtmlAttr] -- ^ Attributes -> String -- ^ Whitespace to add after attributes -> ShowS renderTag empty name attrs nl r = "<" ++ name ++ showAttrs attrs ++ nl ++ close ++ r where close = if empty then " />" else ">" showAttrs attrs = concat [' ':showPair attr | attr <- attrs ] showPair :: HtmlAttr -> String showPair (HtmlAttr tag val) = tag ++ "=\"" ++ val ++ "\"" -- | Show an end tag renderEndTag :: String -- ^ Tag name -> String -- ^ Whitespace to add after tag name -> ShowS renderEndTag name nl r = "" ++ r -- | The names of all elements which can represented using the empty tag -- short-hand. validHtmlITags :: [String] validHtmlITags = [ "area", "base", "basefont", "br", "col", "frame", "hr", "img", "input", "isindex", "link", "meta", "param" ] hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Strict.hs0000644006511100651110000000313710504340573021466 0ustar rossross-- | Produces XHTML 1.0 Strict. module Text.XHtml.Strict ( -- * Data types Html, HtmlAttr, -- * Classes HTML(..), ADDATTRS(..), -- * Primitives and basic combinators (<<), concatHtml, (+++), noHtml, isNoHtml, tag, itag, emptyAttr, intAttr, strAttr, primHtml, -- * Rendering showHtml, renderHtml, prettyHtml, showHtmlFragment, renderHtmlFragment, prettyHtmlFragment, module Text.XHtml.Strict.Elements, module Text.XHtml.Strict.Attributes, module Text.XHtml.Extras ) where import Text.XHtml.Internals import Text.XHtml.Strict.Elements import Text.XHtml.Strict.Attributes import Text.XHtml.Extras docType = "" -- | Output the HTML without adding newlines or spaces within the markup. -- This should be the most time and space efficient way to -- render HTML, though the ouput is quite unreadable. showHtml :: HTML html => html -> String showHtml = showHtmlInternal docType -- | Outputs indented HTML. Because space matters in -- HTML, the output is quite messy. renderHtml :: HTML html => html -> String renderHtml = renderHtmlInternal docType -- | Outputs indented HTML, with indentation inside elements. -- This can change the meaning of the HTML document, and -- is mostly useful for debugging the HTML output. -- The implementation is inefficient, and you are normally -- better off using 'showHtml' or 'renderHtml'. prettyHtml :: HTML html => html -> String prettyHtml = prettyHtmlInternal docType hugs98-plus-Sep2006/packages/xhtml/Text/XHtml/Table.hs0000644006511100651110000000637210504340573021251 0ustar rossross-- | Table combinators for XHTML. module Text.XHtml.Table (HtmlTable, HTMLTABLE(..), (), above, (<->), beside, aboves, besides, simpleTable) where import Text.XHtml.Internals import Text.XHtml.Strict.Elements import Text.XHtml.Strict.Attributes import qualified Text.XHtml.BlockTable as BT infixr 3 -- combining table cells infixr 4 <-> -- combining table cells -- -- * Tables -- class HTMLTABLE ht where cell :: ht -> HtmlTable instance HTMLTABLE HtmlTable where cell = id instance HTMLTABLE Html where cell h = let cellFn x y = h ! (add x colspan $ add y rowspan $ []) add 1 fn rest = rest add n fn rest = fn n : rest r = BT.single cellFn in mkHtmlTable r -- | We internally represent the Cell inside a Table with an -- object of the type -- -- > Int -> Int -> Html -- -- When we render it later, we find out how many columns -- or rows this cell will span over, and can -- include the correct colspan\/rowspan command. newtype HtmlTable = HtmlTable (BT.BlockTable (Int -> Int -> Html)) mkHtmlTable :: BT.BlockTable (Int -> Int -> Html) -> HtmlTable mkHtmlTable r = HtmlTable r -- We give both infix and nonfix, take your pick. -- Notice that there is no concept of a row/column -- of zero items. (),above,(<->),beside :: (HTMLTABLE ht1,HTMLTABLE ht2) => ht1 -> ht2 -> HtmlTable above a b = combine BT.above (cell a) (cell b) () = above beside a b = combine BT.beside (cell a) (cell b) (<->) = beside combine fn (HtmlTable a) (HtmlTable b) = mkHtmlTable (a `fn` b) -- Both aboves and besides presume a non-empty list. -- here is no concept of a empty row or column in these -- table combinators. aboves :: (HTMLTABLE ht) => [ht] -> HtmlTable aboves [] = error "aboves []" aboves xs = foldr1 () (map cell xs) besides :: (HTMLTABLE ht) => [ht] -> HtmlTable besides [] = error "besides []" besides xs = foldr1 (<->) (map cell xs) -- | renderTable takes the HtmlTable, and renders it back into -- and Html object. renderTable :: BT.BlockTable (Int -> Int -> Html) -> Html renderTable theTable = concatHtml [tr << [theCell x y | (theCell,(x,y)) <- theRow ] | theRow <- BT.getMatrix theTable] instance HTML HtmlTable where toHtml (HtmlTable tab) = renderTable tab instance Show HtmlTable where showsPrec _ (HtmlTable tab) = shows (renderTable tab) -- | If you can't be bothered with the above, then you -- can build simple tables with simpleTable. -- Just provide the attributes for the whole table, -- attributes for the cells (same for every cell), -- and a list of lists of cell contents, -- and this function will build the table for you. -- It does presume that all the lists are non-empty, -- and there is at least one list. -- -- Different length lists means that the last cell -- gets padded. If you want more power, then -- use the system above, or build tables explicitly. simpleTable :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html simpleTable attr cellAttr lst = table ! attr << (aboves . map (besides . map ((td ! cellAttr) . toHtml)) ) lst hugs98-plus-Sep2006/packages/xhtml/Text/XHtml.hs0000644006511100651110000000401110504340573020206 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Text.XHtml -- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of -- Science and Technology, 1999-2001, -- (c) Bjorn Bringert, 2004-2006 -- License : BSD-style (see the file LICENSE) -- Maintainer : Bjorn Bringert -- Stability : experimental -- Portability : portable -- -- An XHTML combinator library. -- -- Based on the original Text.Html library by Andy Gill. -- See for -- an introduction to that library. -- -- This module re-exports "Text.XHtml.Transitional", which produces -- XHTML 1.0 Transitional. -- Use "Text.XHtml.Strict" if you want XHTML 1.0 Strict, -- and "Text.XHtml.Frameset" if you want -- to produce XHTML 1.0 Frameset. -- -- See for more information about -- XHTML 1.0. ----------------------------------------------------------------------------- {- -- Changes by Bjorn Bringert: -- -- * produces XHTML 1.0 Transitional () -- -- * escapes characters inside attribute values -- -- * changed 'height' to a String attribute -- -- * added 'Monoid' instance for 'Html'. -- -- * added elements from HTML 4.0: 'abbr', 'acronym', 'bdo', 'button', 'col', -- 'colgroup', 'del', 'iframe', 'ins', 'label', 'legend', 'noframes', -- 'noscript', 'object', 'optgroup', 'script', 'strike', 'tbody', 'tfoot', -- 'thead', and 'quote'. -- -- * 'defList' no longer makes terms bold. -- -- * deprecated functions for elements and attributes -- deprecated in HTML 4.0 -- -- * hid or removed some internal functions. -- -- TODO: -- -- * add new attributes introduced in HTML 4.0 -- -- * character encoding -} module Text.XHtml ( module Text.XHtml.Transitional, module Text.XHtml.Table, module Text.XHtml.Debug ) where import Text.XHtml.Transitional import Text.XHtml.Table import Text.XHtml.Debug hugs98-plus-Sep2006/packages/xhtml/xhtml.cabal0000644006511100651110000000166710504340573020030 0ustar rossrossName: xhtml Version: 2006.9.13 Copyright: Bjorn Bringert 2004-2006, Andy Gill, and the Oregon Graduate Institute of Science and Technology, 1999-2001 Maintainer: bjorn@bringert.net Author: Bjorn Bringert Homepage: http://www.cs.chalmers.se/~bringert/darcs/haskell-xhtml/doc/ License: BSD3 License-file: LICENSE build-depends: haskell98, base Extensions: Synopsis: A Haskell XHTML combinator library Description: This is a version of the standard Text.Html modified to produce XHTML 1.0. Exposed-Modules: Text.XHtml, Text.XHtml.Frameset, Text.XHtml.Strict, Text.XHtml.Transitional, Text.XHtml.Debug, Text.XHtml.Table Other-modules: Text.XHtml.Strict.Attributes, Text.XHtml.Strict.Elements, Text.XHtml.Frameset.Attributes, Text.XHtml.Frameset.Elements, Text.XHtml.Transitional.Attributes, Text.XHtml.Transitional.Elements, Text.XHtml.BlockTable, Text.XHtml.Extras, Text.XHtml.Internals ghc-options: -O2 -W hugs98-plus-Sep2006/packages/xhtml/Setup.hs0000644006511100651110000000023210504340573017327 0ustar rossrossmodule Main (main) where import Distribution.Simple (defaultMainWithHooks, defaultUserHooks) main :: IO () main = defaultMainWithHooks defaultUserHooks hugs98-plus-Sep2006/packages/xhtml/prologue.txt0000644006511100651110000000003510504340573020271 0ustar rossrossAn XHtml combinator library. hugs98-plus-Sep2006/packages/xhtml/Makefile0000644006511100651110000000046510504340573017343 0ustar rossrossTOP=.. include $(TOP)/mk/boilerplate.mk ALL_DIRS = Text Text/XHtml Text/XHtml/Frameset Text/XHtml/Strict Text/XHtml/Transitional PACKAGE = xhtml VERSION = 2006.9.13 PACKAGE_DEPS = base SRC_HADDOCK_OPTS += -t "Haskell Core Libraries (xhtml package)" EXCLUDED_SRCS += Setup.hs include $(TOP)/mk/target.mk hugs98-plus-Sep2006/packages/xhtml/package.conf.in0000644006511100651110000000056110504340573020547 0ustar rossrossname: PACKAGE version: VERSION license: BSD3 maintainer: bjorn@bringert.net exposed: True exposed-modules: Text.XHtml Text.XHtml.Frameset Text.XHtml.Strict Text.XHtml.Transitional Text.XHtml.Debug Text.XHtml.Table import-dirs: IMPORT_DIR library-dirs: LIB_DIR hs-libraries: "HSxhtml" depends: base haddock-interfaces: HADDOCK_IFACE haddock-html: HTML_DIR hugs98-plus-Sep2006/packages/xhtml/README0000644006511100651110000000073010504340573016556 0ustar rossrossThis is a version of the standard [http://www.haskell.org/ghc/docs/latest/html/libraries/base/Text-Html.html Text.Html module], modified to produce [http://www.w3.org/TR/xhtml1/ XHTML 1.0]. There are modules for XHTML 1.0 Strict, Frameset and Transitional. The original Html combinator library was written by Andy Gill. He has [http://www.cse.ogi.edu/~andy/html/intro.htm some notes on using the Haskell Html library] which are mostly applicable also to this library. hugs98-plus-Sep2006/cpphs/0000755006511100651110000000000010504340601014071 5ustar rossrosshugs98-plus-Sep2006/cpphs/CHANGELOG0000644006511100651110000001016010504340601015301 0ustar rossrossVersion 1.2 ----------- * Re-arranged the source files into hierarchical libraries. * Exposed the library interface as an installable Cabal package, with Haddock documentation. * Added the --unlit option, for removing literate-style comments. Version 1.1 ----------- * Fix the .cabal way of building cpphs. * Update the --version reported (forgotten in 1.0, which still reports 0.9) * No longer throws an error when given an empty file as input. Version 1.0 ----------- * Add a compatibility script cpphs.compat, allowing cpphs to act as a drop-in replacement for cpp, e.g. ghc -cpp -pgmP cpphs.compat * Place quotes around replacements for special macros __FILE__, __DATE__, and __TIME__. * If no files are specified, read from stdin. * Ignore #! lines (e.g. in scripts) * Parse -D commandline options once only, and consistently with cpp, i.e. -Dfoo means foo=1 * Fix compatibility with preprocessors like hsc2hs, which use non-cpp directives like #def. They are now passed through to the output with a warning to stderr. Version 0.9 ----------- * Bugfix for ghc-6.4 -O: flush the output buffer. Version 0.8 ----------- * Added the --text option, to signify the input should not be lexed as Haskell. This causes macros to be defined or expanded regardless of their location within comments, string delimiters, etc. * Shuffle a few files around to make it easier to say 'hmake cpphs'. There is also now a runhugs script to invoke cpphs nicely. Version 0.7 ----------- * Enable the __FILE__, __LINE__, __DATE__, and __TIME__ specials, which can be useful for creating DIY error messages. Version 0.6 ----------- * Recognise and ignore the #pragma cpp directive. * Fix beginning-of-file bug, where in --noline mode, a # cpp directive at the top of the file appeared in the output. * Fix chained parenthesised boolean exprs in #if, e.g. #if ( foo ) && ( bar ) * Fix precedence in chained unparenthesised boolean exprs in #if, e.g. #if foo && bar || baz && frob * For better compatibility with cpp, and because otherwise there are certain constructs that cannot be expressed, we no longer permit whitespace in a #define between the symbolname and an opening parenthesis, e.g. #define f (f' id) Previously, this was interpreted as a parametrised macro, with arguments in the parens, and no expansion. Now, the space indicates that this is a textual replacement, and the parenthesised expression is in fact the replacement. Version 0.5 ----------- * Added a --version flag to report the version number. * Renamed --stringise to --hashes, and use it to turn on ## catenation as well. * Bugfix for #if 1, previously taken as false. * Bugfix for --nolines: it no longer adds extra spurious newlines. * File inclusion now looks in the directory of the calling file. * Failure to find an include file is now merely a warning to stderr rather than an error. * Added a --layout flag. Previously, line continuations in a macro definition were always preserved in the output, permitting use of the Haskell layout rule even inside a macro. The default is now to remove line continuations for conformance with cpp, but the option of using --layout is still possible. Version 0.4 ----------- * New flag -Ofile to redirect output * Bugfix for precedence in #if !False && False * Bugfix for whitespace between # and if * Bugfix for #define F "blah"; #include F Version 0.3 ----------- * Bugfix for recursive macro expansion. * New flag --strip to remove C comments even outside cpp directives. * New flag --stringise to recognise the # stringise operator in macros. Version 0.2 ----------- * New flag --noline to eliminate #line directives from output. * Add symbol-replacement and macro-expansion. * New flag --nomacro to turn off symbol/macro-expansion. 2004-Apr-21 ----------- * Now accept multi-line # commands via the \ line continuation operator. The original file line numbering is preserved in the output by some tricky acrobatics. Version 0.1 ----------- * Initial release. hugs98-plus-Sep2006/cpphs/docs/0000755006511100651110000000000010504340601015021 5ustar rossrosshugs98-plus-Sep2006/cpphs/docs/cpphs.10000644006511100651110000001714110504340601016224 0ustar rossross.TH CPPHS 1 2004-10-01 "cpphs version 0.9" "User Manual" .SH NAME cpphs \- liberalised cpp-a-like preprocessor for Haskell .SH SYNOPSIS .B cpphs [\fIFILENAME\fR|\fIOPTION\fR]... .SH DESCRIPTION .ds c \fIcpphs\fP \*c is a liberalised re-implementation of .B cpp (1), the C pre-processor, in and for Haskell. .PP Why re-implement cpp? Rightly or wrongly, the C pre-processor is widely used in Haskell source code. It enables conditional compilation for different compilers, different versions of the same compiler, and different OS platforms. It is also occasionally used for its macro language, which can enable certain forms of platform-specific detail-filling, such as the tedious boilerplate generation of instance definitions and FFI declarations. However, there are two problems with cpp, aside from the obvious aesthetic ones: .IP For some Haskell systems, notably Hugs on Windows, a true cpp is not available by default. .IP Even for the other Haskell systems, the common cpp provided by the gcc 3.x series is changing subtly in ways that are incompatible with Haskell's syntax. There have always been problems with, for instance, string gaps, and prime characters in identifiers. These problems are only going to get worse. .PP So, it seemed right to attempt to provide an alternative to cpp, both more compatible with Haskell, and itself written in Haskell so that it can be distributed with compilers. .PP \*c is pretty-much feature-complete, and compatible with the .B \-traditional style of cpp. It has two modes: .IP conditional compilation only (\fB\-\-nomacro\fR), .IP and full macro-expansion (default). .PP In .B \-\-nomacro mode, \*c performs only conditional compilation actions, i.e. \fB#include\fR's, \fB#if\fR's, and \fB#ifdef\fR's are processed according to text-replacement definitions (both command-line and internal), but no parameterised macro expansion is performed. In full compatibility mode (the default), textual replacements and macro expansions are also processed in the remaining body of non-cpp text. .PP Working Features: .TP .B #ifdef simple conditional compilation .TP .B #if the full boolean language of defined(), &&, ||, ==, etc. .TP .B #elif chained conditionals .TP .B #define in-line definitions (text replacements and macros) .TP .B #undef in-line revocation of definitions .TP .B #include file inclusion .TP .B #line line number directives .TP .B \\\\n line continuations within all # directives .TP .B /**/ token catenation within a macro definition .TP .B ## ANSI-style token catenation .TP .B # ANSI-style token stringisation .TP .B __FILE__ special text replacement for DIY error messages .TP .B __LINE__ special text replacement for DIY error messages .TP .B __DATE__ special text replacement .TP .B __TIME__ special text replacement .PP Macro expansion is recursive. Redefinition of a macro name does not generate a warning. Macros can be defined on the command-line with .B \-D just like textual replacements. Macro names are permitted to be Haskell identifiers e.g. with the prime \(ga and backtick \(aa characters, which is slightly looser than in C, but they still may not include operator symbols. .PP Numbering of lines in the output is preserved so that any later processor can give meaningful error messages. When a file is \fB#include\fR'd, \*c inserts .B #line directives for the same reason. Numbering should be correct even in the presence of line continuations. If you don't want .B #line directives in the final output, use the .B \-\-noline option. .PP Any syntax errors in cpp directives gives a message to stderr and halts the program. Failure to find a #include'd file produces a warning to stderr, but processing continues. .PP You can give any number of filenames on the command-line. The results are catenated on standard output. .TP .B \-D\fIsym\fR define a textual replacement (default value is 1) .TP .B \-Dsym=\fIval\fR define a textual replacement with a specific value .TP .B \-I\fIpath\fR add a directory to the search path for #include's .TP .B \-O\fIfile\fR specify a file for output (default is stdout) .TP .B \-\-nomacro only process #ifdef's and #include's, do not expand macros .TP .B \-\-noline remove #line droppings from the output .TP .B \-\-strip convert C-style comments to whitespace, even outside cpp directives .TP .B \-\-hashes recognise the ANSI # stringise operator, and ## for token catenation, within macros .TP .B \-\-text treat the input as plain text, not Haskell code .TP .B \-\-layout preserve newlines within macro expansions .TP .B \-\-unlit remove literate-style comments .TP .B \-\-version report version number of cpphs and stop .PP There are NO textual replacements defined by default. (Normal cpp usually has definitions for machine, OS, etc. These could easily be added to the cpphs source code if you wish.) The search path is searched in order of the .B \-I options, except that the directory of the calling file, then the current directory, are always searched first. Again, there is no default search path (and again, this could easily be changed). .SH "DIFFERENCES FROM CPP" .PP In general, cpphs is based on the .B \-traditional behaviour, not ANSI C, and has the following main differences from the standard cpp. .B General .PP The .B # that introduces any cpp directive must be in the first column of a line (whereas ANSI permits whitespace before the .B # ). .PP Generates the .B "#line \fIn\fR \(dq\fIfilename\fR\(dq" syntax, not the .B "# \fIn\fR \(dq\fIfilename\fR\(dq" variant. .PP C comments are only removed from within cpp directives. They are not stripped from other text. Consider for instance that in Haskell, all of the following are valid operator symbols: .B /* */ */* However, you can turn on C-comment removal with the .B \-\-strip option. .B Macro language .PP Accepts .B /**/ for token-pasting in a macro definition. However, .B /* */ (with any text between the open/close comment) inserts whitespace. .PP The ANSI .B ## token-pasting operator is available with the .B \-\-hashes flag. This is to avoid misinterpreting any valid Haskell operator of the same name. .PP Replaces a macro formal parameter with the actual, even inside a string (double or single quoted). This is \-traditional behaviour, not supported in ANSI. .PP Recognises the .B # stringisation operator in a macro definition only if you use the .B \-\-hashes option. (It is an ANSI addition, only needed because quoted stringisation (above) is prohibited by ANSI.) .PP Preserves whitespace within a textual replacement definition exactly (modulo newlines), but leading and trailing space is eliminated. .PP Preserves whitespace within a macro definition (and trailing it) exactly (modulo newlines), but leading space is eliminated. .PP Preserves whitespace within macro call arguments exactly (including newlines), but leading and trailing space is eliminated. .PP With the .B \-\-layout option, line continuations in a textual replacement or macro definition are preserved as line-breaks in the macro call. (Useful for layout-sensitive code in Haskell.) .SH BUGS Bug reports, and any other feedback, should be sent to Malcolm Wallace .SH COPYRIGHT Copyright \(co 2004-2005 Malcolm Wallace, except for ParseLib (Copyright \(co 1995 Graham Hutton and Erik Meijer). .PP The library modules in cpphs are distributed under the terms of the LGPL. If that's a problem for you, contact me to make other arrangements. The application module .B Main.hs itself is GPL. .SH "SEE ALSO" .BR cpp (1) .SH AUTHOR This manual page was written, based on \fBindex.html\fR, by Ian Lynagh for the Debian system (but may be used by others). hugs98-plus-Sep2006/cpphs/docs/design0000644006511100651110000000211210504340601016211 0ustar rossrossDesign for hspp First pass: ----------- * traverse the file, - processing #if's and #ifdef's - reading #include's and recursively doing this pass on them - leaving #line's behind - whilst taking account of #define's and #undef's * only needs to look at lines beginning with a # * should discard C-style comments? (no) * DO NOT gather the #define's for macros - their sequence matters! pass1 :: SymTab -> String -> String Second pass: ------------ * traverse the residual file, - keeping track of #define'd macros - expanding #define'd macros when an instance is encountered * needs a whitespace-preserving tokeniser with odd rules to cover e.g. token concatenation. Within Haskell, quotation marks start strings, haskell comments are preserved. Within a cpp directive, quotation marks do not start a string, and C-style comments are converted to whitespace. * Line continuation characters are tricky; probably should only be recognised within a macro definition, not in ordinary code. pass2 :: SymTab -> String -> String hugs98-plus-Sep2006/cpphs/docs/index.html0000644006511100651110000004460510504340601017027 0ustar rossross cpphs

cpphs

What is cpphs?
How do I use it?
Downloads
 Differences to cpp
cpphs as a library
Contacts

What is cpphs?

cpphs is a liberalised re-implementation of cpp, the C pre-processor, in Haskell.

Why re-implement cpp? Rightly or wrongly, the C pre-processor is widely used in Haskell source code. It enables conditional compilation for different compilers, different versions of the same compiler, and different OS platforms. It is also occasionally used for its macro language, which can enable certain forms of platform-specific detail-filling, such as the tedious boilerplate generation of instance definitions and FFI declarations. However, there are two problems with cpp, aside from the obvious aesthetic ones:

  • For some Haskell systems, notably Hugs on Windows, a true cpp is not available by default.
  • Even for the other Haskell systems, the common cpp provided by the gcc 3.x and 4.x series has changed subtly in ways that are incompatible with Haskell's syntax. There have always been problems with, for instance, string gaps, and prime characters in identifiers. These problems are only going to get worse.
So, it seemed right to provide an alternative to cpp, both more compatible with Haskell, and itself written in Haskell so that it can be distributed with compilers.

This version of the C pre-processor is pretty-much feature-complete, and compatible with the -traditional style. It has two main modes:

  • conditional compilation only (--nomacro),
  • and full macro-expansion (default).
In --nomacro mode, cpphs performs only conditional compilation actions, namely #include's, #if's, and #ifdef's are processed according to text-replacement definitions (both command-line and internal), but no parameterised macro expansion is performed. In full compatibility mode (the default), textual replacements and macro expansions are also processed in the remaining body of non-cpp text.

Source language features:
#ifdef simple conditional compilation
#if the full boolean language of defined(), &&, ||, ==, etc.
#elif chained conditionals
#define in-line definitions (text replacements and macros)
#undef in-line revocation of definitions
#includefile inclusion
#line line number directives
\\n line continuations within all # directives
/**/ token catenation within a macro definition
## ANSI-style token catenation
# ANSI-style token stringisation
__FILE__special text replacement for DIY error messages
__LINE__special text replacement for DIY error messages
__DATE__special text replacement
__TIME__special text replacement

Macro expansion is recursive. Redefinition of a macro name does not generate a warning. Macros can be defined on the command-line with -D just like textual replacements. Macro names are permitted to be Haskell identifiers e.g. with the prime ' and backtick ` characters, which is slightly looser than in C, but they still may not include operator symbols.

Numbering of lines in the output is preserved so that any later processor can give meaningful error messages. When a file is #include'd, cpphs inserts #line directives for the same reason. Numbering should be correct even in the presence of line continuations. If you don't want #line directives in the final output, use the --noline option.

Any syntax error in a cpp directive gives a warning message to stderr. Failure to find a #include'd file also produces a warning to stderr. In both cases, processing continues on the rest of the input.

How do I use it?

Usage: cpphs  [ filename | -Dsym | -Dsym=val | -Ipath ]+  [-Ofile]
              [--nomacro|--noline|--strip|--text|--hashes|--layout|--unlit]*
       cpphs --version

You can give any number of filenames on the command-line. If no filename is given, cpphs reads from standard input. The results are catenated on standard output. (Macro definitions in one file do not carry over into the next.)

Options:
-Dsym define a textual replacement (default value is 1)
-Dsym=val define a textual replacement with a specific value
-Dsym(args)=val define a macro with arguments
-Ipath add a directory to the search path for #include's
-Ofile specify a file for output (default is stdout)
--nomacro only process #ifdef's and #include's, do not expand macros
--noline remove #line droppings from the output
--strip convert C-style comments to whitespace, even outside cpp directives
--hashes recognise the ANSI # stringise operator, and ## for token catenation, within macros
--text treat input as plain text, not Haskell code
--layout preserve newlines within macro expansions
--unlit unlit literate source code
--version report version number of cpphs and stop

There are NO textual replacements defined by default. (Normal cpp usually has definitions for machine, OS, etc. You can easily create a wrapper script if you need these.) The search path is searched in order of the -I options, except that the directory of the calling file, then the current directory, are always searched first. Again, there is no default search path (unless you define one via a wrapper script).

Downloads

Current stable version:

cpphs-1.2, release date 2006.05.04
By HTTP: .tar.gz, .zip, Windows binary, Fedora package, Gentoo package, FreeBSD port, OpenBSD port.

  • Re-arranged the source files into hierarchical libraries.
  • Exposed the library interface as an installable Cabal package, with Haddock documentation.
  • Added the --unlit option, for removing literate-style comments.

Development:

The current darcs repository of cpphs is available at 

    darcs get http://www.cs.york.ac.uk/fp/darcs/cpphs
(Users on Windows or MacOS filesystems need to use the --partial flag.) The source tree and version history can be browsed on-line through darcsweb.

Older versions:

cpphs-1.1, release date 2005.10.14
By HTTP: .tar.gz, .zip,

  • Fixed the .cabal way of building cpphs.
  • Update the --version reported (forgotten in 1.0, which still mistakenly reports 0.9).
  • No longer throws an error on an empty file.

cpphs-1.0, release date 2005.10.05
By HTTP: .tar.gz, .zip,

  • Included the cpphs.compat script for argument compatibility with the original cpp.
  • Placed quotes around replacements for special macros __FILE__, __DATE__, and __TIME__.
  • If no files are specified, read from stdin.
  • Ignore #! lines (e.g. in scripts)
  • Parse -D commandline options consistently with cpp, i.e. -Dfoo means foo=1
  • Fix compatibility with preprocessors like hsc2hs, which use non-cpp directives like #def. They are now passed through to the output with a warning to stderr.

cpphs-0.9, release date 2005.03.17
By HTTP: .tar.gz, .zip,

  • Bugfix for ghc-6.4 -O: flush output buffer.

cpphs-0.8, release date 2004.11.14
By HTTP: .tar.gz, .zip,

  • Added the --text option, to signify the input should not be lexed as Haskell. This causes macros to be defined or expanded regardless of their location within comments, string delimiters, etc.
  • Shuffled some source files around - there is now a runhugs script to invoke cpphs nicely.

cpphs-0.7, release date 2004.09.01
By HTTP: .tar.gz, .zip,

  • Enable the __FILE__, __LINE__, __DATE__, and __TIME__ specials, which can be useful for creating DIY error messages.

cpphs-0.6, release date 2004.07.30
By HTTP: .tar.gz, .zip,

  • Recognise and ignore the #pragma cpp directive.
  • Fix beginning-of-file bug, where in --noline mode, a #line cpp directive appeared at the top of the output file.
  • Fix chained parenthesised boolean exprs in #if, e.g. 
    #if ( foo ) && ( bar )
  • Fix precedence in chained unparenthesised boolean exprs in #if, e.g. 
    #if foo && bar || baz && frob
  • For better compatibility with cpp, and because otherwise there are certain constructs that cannot be expressed, we no longer permit whitespace in a #define between the symbolname and an opening parenthesis, e.g. 
    #define f (f' id)
    . Previously, this was interpreted as a parametrised macro, with arguments in the parens, and no expansion. Now, the space indicates that this is a textual replacement, and the parenthesised expression is in fact the replacement.

cpphs-0.5, release date 2004.06.07
By HTTP: .tar.gz, .zip,

  • Added a --version flag to report the version number.
  • Renamed --stringise to --hashes, and use it to turn on ## catenation as well.
  • Bugfix for #if 1, previously interpreted as false.
  • Bugfix for --nolines: it no longer adds extra spurious newlines.
  • File inclusion now looks in the directory of the calling file.
  • Failure to find an include file is now merely a warning to stderr rather than an error.
  • Added a --layout flag. Previously, line continuations in a macro definition were always preserved in the output, permitting use of the Haskell layout rule even inside a macro. The default is now to remove line continuations for conformance with cpp, but the option of using --layout is still possible.

cpphs-0.4, release date 2004.05.19
By HTTP: .tar.gz, .zip.

  • New flag -Ofile to redirect output
  • Bugfix for precedence of ! in #if !False && False
  • Bugfix for whitespace permitted between # and if
  • Bugfix for #define F "blah"; #include F

cpphs-0.3, release date 2004.05.18
By HTTP: .tar.gz, .zip.

Fix recursive macro expansion bug. Added option to strip C comments. Added option to recognise the # stringise operator.

cpphs-0.2, release date 2004.05.15
By HTTP: .tar.gz, .zip.

Implements textual replacement and macro expansion.

cpphs-0.1, release date 2004.04.07
By HTTP: .tar.gz, .zip.

Initial release: implements conditional compilation and file inclusion only.

Building instructions

To build cpphs, use 

    hmake cpphs [-package base]
or 
    ghc --make cpphs [-o cpphs]
or 
    mv cpphs.hugs cpphs	# a simple runhugs script

You will notice that the command-line arguments for cpphs are not the same as for the original cpp. If you want to use cpphs as a completely drop-in replacement for the real cpp, that is, to accept the same arguments, and have broadly the same behaviour in response to them, then edit the cpphs.compat script to point to the installed location of cpphs, then use this script instead of cpp, e.g. 

    ghc -cpp -pgmPcpphs.compat

Differences from cpp

In general, cpphs is based on the -traditional behaviour, not ANSI C, and has the following main differences from the standard cpp.

General

  • The # that introduces any cpp directive must be in the first column of a line (whereas ANSI permits whitespace before the #).
  • Generates the #line n "filename" syntax, not the # n "filename" variant.
  • C comments are only removed from within cpp directives. They are not stripped from other text. Consider for instance that in Haskell, all of the following are valid operator symbols: /* */ */* However, you can turn on C-comment removal with the --strip option.
  • Macros are never expanded within Haskell comments, strings, or character constants, unless you give the --text option to disable lexing the input as Haskell.
  • Macros are always expanded recursively, unlike ANSI, which detects and prevents self-recursion. For instance, #define foo x:foo expands foo once only to x:foo in ANSI, but in cpphs it becomes an infinite list x:x:x:x:..., i.e. cpphs does not terminate.

Macro definition language

  • Accepts /**/ for token-pasting in a macro definition. However, /* */ (with any text between the open/close comment) inserts whitespace.
  • The ANSI ## token-pasting operator is available with the --hashes flag. This is to avoid misinterpreting any valid Haskell operator of the same name.
  • Replaces a macro formal parameter with the actual, even inside a string (double or single quoted). This is -traditional behaviour, not supported in ANSI.
  • Recognises the # stringisation operator in a macro definition only if you use the --hashes option. (It is an ANSI addition, only needed because quoted stringisation (above) is prohibited by ANSI.)
  • Preserves whitespace within a textual replacement definition exactly (modulo newlines), but leading and trailing space is eliminated.
  • Preserves whitespace within a macro definition (and trailing it) exactly (modulo newlines), but leading space is eliminated.
  • Preserves whitespace within macro call arguments exactly (including newlines), but leading and trailing space is eliminated.
  • With the --layout option, line continuations in a textual replacement or macro definition are preserved as line-breaks in the macro call. (Useful for layout-sensitive code in Haskell.)

cpphs as a library

You can use cpphs as a library from within a Haskell program. The main interface is in Language.Preprocessor.Cpphs. Haddock documentation is here. To make the library available to your haskell compiler, you must install the cpphs package using Cabal.

Contacts

I am interested in hearing your feedback on cpphs. Bug reports especially welcome. You can send feature requests too, but I won't guarantee to implement them if they depart much from the ordinary cpp's behaviour. Please mail

Copyright: © 2004-2006 Malcolm Wallace, except for ParseLib (Copyright © 1995 Graham Hutton and Erik Meijer)

License: The library modules in cpphs are distributed under the terms of the LGPL (see file LICENCE-LGPL for more details). If that's a problem for you, contact me to make other arrangements. The application module 'cpphs.hs' itself is GPL (see file LICENCE-GPL).

This software comes with no warranty. Use at your own risk.

hugs98-plus-Sep2006/cpphs/Text/0000755006511100651110000000000010504340601015015 5ustar rossrosshugs98-plus-Sep2006/cpphs/Text/ParserCombinators/0000755006511100651110000000000010504340601020452 5ustar rossrosshugs98-plus-Sep2006/cpphs/Text/ParserCombinators/HuttonMeijer.hs0000644006511100651110000001671410504340601023434 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : ParseLib -- Copyright : ... -- Copyright : Graham Hutton (University of Nottingham), Erik Meijer (University of Utrecht) -- -- Maintainer : Malcolm Wallace -- Stability : Stable -- Portability : All -- -- A LIBRARY OF MONADIC PARSER COMBINATORS -- -- 29th July 1996 -- -- Graham Hutton Erik Meijer -- University of Nottingham University of Utrecht -- -- This Haskell script defines a library of parser combinators, and is -- taken from sections 1-6 of our article "Monadic Parser Combinators". -- Some changes to the library have been made in the move from Gofer -- to Haskell: -- -- * Do notation is used in place of monad comprehension notation; -- -- * The parser datatype is defined using "newtype", to avoid the overhead -- of tagging and untagging parsers with the P constructor. ----------------------------------------------------------------------------- module Text.ParserCombinators.HuttonMeijer (Parser(..), item, first, papply, (+++), sat, {-tok,-} many, many1, sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper, letter, alphanum, string, ident, nat, int, spaces, comment, junk, skip, token, natural, integer, symbol, identifier) where import Char import Monad infixr 5 +++ type Token = Char --------------------------------------------------------- -- | The parser monad newtype Parser a = P ([Token] -> [(a,[Token])]) instance Functor Parser where -- map :: (a -> b) -> (Parser a -> Parser b) fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp]) instance Monad Parser where -- return :: a -> Parser a return v = P (\inp -> [(v,inp)]) -- >>= :: Parser a -> (a -> Parser b) -> Parser b (P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp]) -- fail :: String -> Parser a fail _ = P (\_ -> []) instance MonadPlus Parser where -- mzero :: Parser a mzero = P (\_ -> []) -- mplus :: Parser a -> Parser a -> Parser a (P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp)) -- ------------------------------------------------------------ -- * Other primitive parser combinators -- ------------------------------------------------------------ item :: Parser Token item = P (\inp -> case inp of [] -> [] (x:xs) -> [(x,xs)]) first :: Parser a -> Parser a first (P p) = P (\inp -> case p inp of [] -> [] (x:_) -> [x]) papply :: Parser a -> [Token] -> [(a,[Token])] papply (P p) inp = p inp -- ------------------------------------------------------------ -- * Derived combinators -- ------------------------------------------------------------ (+++) :: Parser a -> Parser a -> Parser a p +++ q = first (p `mplus` q) sat :: (Token -> Bool) -> Parser Token sat p = do {x <- item; if p x then return x else mzero} --tok :: Token -> Parser Token --tok t = do {x <- item; if t==snd x then return t else mzero} many :: Parser a -> Parser [a] many p = many1 p +++ return [] --many p = force (many1 p +++ return []) many1 :: Parser a -> Parser [a] many1 p = do {x <- p; xs <- many p; return (x:xs)} sepby :: Parser a -> Parser b -> Parser [a] p `sepby` sep = (p `sepby1` sep) +++ return [] sepby1 :: Parser a -> Parser b -> Parser [a] p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)} chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a chainl p op v = (p `chainl1` op) +++ return v chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a p `chainl1` op = do {x <- p; rest x} where rest x = do {f <- op; y <- p; rest (f x y)} +++ return x chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a chainr p op v = (p `chainr1` op) +++ return v chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a p `chainr1` op = do {x <- p; rest x} where rest x = do {f <- op; y <- p `chainr1` op; return (f x y)} +++ return x ops :: [(Parser a, b)] -> Parser b ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs] bracket :: Parser a -> Parser b -> Parser c -> Parser b bracket open p close = do {open; x <- p; close; return x} -- ------------------------------------------------------------ -- * Useful parsers -- ------------------------------------------------------------ char :: Char -> Parser Char char x = sat (\y -> x == y) digit :: Parser Char digit = sat isDigit lower :: Parser Char lower = sat isLower upper :: Parser Char upper = sat isUpper letter :: Parser Char letter = sat isAlpha alphanum :: Parser Char alphanum = sat isAlphaNum +++ char '_' string :: String -> Parser String string "" = return "" string (x:xs) = do {char x; string xs; return (x:xs)} ident :: Parser String ident = do {x <- lower; xs <- many alphanum; return (x:xs)} nat :: Parser Int nat = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op where m `op` n = 10*m + n int :: Parser Int int = do {char '-'; n <- nat; return (-n)} +++ nat -- ------------------------------------------------------------ -- * Lexical combinators -- ------------------------------------------------------------ spaces :: Parser () spaces = do {many1 (sat isSpace); return ()} comment :: Parser () --comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()} --comment = do -- _ <- string "--" -- _ <- many (sat (\x -> x /= '\n')) -- return () comment = do bracket (string "/*") (many item) (string "*/") return () junk :: Parser () junk = do {many (spaces +++ comment); return ()} skip :: Parser a -> Parser a skip p = do {junk; p} token :: Parser a -> Parser a token p = do {v <- p; junk; return v} -- ------------------------------------------------------------ -- * Token parsers -- ------------------------------------------------------------ natural :: Parser Int natural = token nat integer :: Parser Int integer = token int symbol :: String -> Parser String symbol xs = token (string xs) identifier :: [String] -> Parser String identifier ks = token (do {x <- ident; if not (elem x ks) then return x else return mzero}) ------------------------------------------------------------------------------ hugs98-plus-Sep2006/cpphs/CpphsTest.hs0000644006511100651110000000404710504340601016347 0ustar rossross{- -- A test module for cpphs -- Copyright (c) 2004 Graham Klyne -- Note: this file is no longer up-to-date with respect to tests/runtests -} module Main where import RunCpphs ( runCpphs ) import Test.HUnit ( Test(TestCase,TestList), Counts, assertEqual, runTestTT ) runCpphsTest :: [String] -> String -> String -> Test runCpphsTest args result expect = TestCase $ do runCpphs "cpphs" (("-O"++result):args) res <- readFile result exP <- readFile expect assertEqual ("cpphs "++concatMap (' ':) args) exP res test1, test2, test3, test4, test5, test6, test7, test8, test9, test10 :: Test test1 = runCpphsTest ["-Itests/","--nomacro","tests/testfile"] "tests/resultfile" "tests/expect1" test2 = runCpphsTest ["-Itests/","--nomacro","-Dnoelif","tests/testfile"] "tests/resultfile" "tests/expect2" test3 = runCpphsTest ["-Itests/","--nomacro","-Delif","tests/testfile"] "tests/resultfile" "tests/expect3" test4 = runCpphsTest ["-Itests/","--nomacro","-Dinclude","tests/testfile"] "tests/resultfile" "tests/expect4" test5 = runCpphsTest ["-Itests/","--noline","-Dinclude","tests/testfile"] "tests/resultfile" "tests/expect5" test6 = runCpphsTest ["-Itests/","tests/cpp"] "tests/resultfile" "tests/expect6" test7 = runCpphsTest ["-Itests/","-D__GLASGOW_HASKELL__","tests/Storable.hs"] "tests/resultfile" "tests/expect7" test8 = runCpphsTest ["-Itests/","-DCALLCONV=ccall","tests/HsOpenGLExt.h"] "tests/resultfile" "tests/expect8" test9 = runCpphsTest ["-Itests/","tests/multiline"] "tests/resultfile" "tests/expect9" test10 = runCpphsTest ["-Itests/","--nomacro","tests/multiline"] "tests/resultfile" "tests/expect10" allTests :: Test allTests = TestList [ test1 , test2 , test3 , test4 , test5 , test6 , test7 , test8 , test9 , test10 ] run :: Test -> IO Counts run t = runTestTT t main :: IO () main = run allTests >>= print hugs98-plus-Sep2006/cpphs/cpphs.spec0000644006511100651110000000337110504340601016066 0ustar rossross# # rpm spec for cpphs # # ====================================================================== Summary: Liberalized C pre-processor re-implementation in Haskell Name: cpphs Version: 1.2 Release: 1%{?_distver:.%{_distver}} License: LGPL 2.1 Group: Development/Tools Source: http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.2.tar.gz URL: http://www.cs.york.ac.uk/fp/cpphs/ Packager: Paul Heinlein BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) BuildRequires: ghc %description cpphs is a liberalised re-implementation of cpp, the C pre-processor, in Haskell. Why re-implement cpp? * For some Haskell systems, notably Hugs on Windows, a true cpp is not available by default. * Even for the other Haskell systems, the common cpp provided by the gcc 3.x and 4.x series is changing subtly in ways that are incompatible with Haskell's syntax. There have always been problems with, for instance, string gaps, and prime characters in identifiers. These problems are only going to get worse. So, it seemed right to provide an alternative to cpp, both more compatible with Haskell, and itself written in Haskell so that it can be distributed with compilers. %prep %setup -q %build ghc --make cpphs -o cpphs ( cd tests && ./runtests ) %install rm -rf ${RPM_BUILD_ROOT} install -d ${RPM_BUILD_ROOT}%{_bindir} install cpphs ${RPM_BUILD_ROOT}%{_bindir} install -d ${RPM_BUILD_ROOT}%{_mandir}/man1 install -m 0644 docs/cpphs.1 ${RPM_BUILD_ROOT}%{_mandir}/man1 %clean rm -rf ${RPM_BUILD_ROOT} %files %defattr(-,root,root) %doc CHANGELOG README docs/design docs/index.html %{_bindir}/cpphs %doc %{_mandir}/man1/cpphs.* %changelog * Tue Apr 11 2006 Paul Heinlein 1.1-1 - initial release # # eof # hugs98-plus-Sep2006/cpphs/LICENCE-LGPL0000644006511100651110000006362610504340601015627 0ustar rossross GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! hugs98-plus-Sep2006/cpphs/Makefile0000644006511100651110000000321310504340601015530 0ustar rossrossLIBRARY = cpphs VERSION = 1.2 DIRS = Language/Preprocessor/Cpphs \ Text/ParserCombinators SRCS = Language/Preprocessor/Cpphs.hs \ Language/Preprocessor/Cpphs/CppIfdef.hs \ Language/Preprocessor/Cpphs/HashDefine.hs \ Language/Preprocessor/Cpphs/MacroPass.hs \ Language/Preprocessor/Cpphs/Options.hs \ Language/Preprocessor/Cpphs/Position.hs \ Language/Preprocessor/Cpphs/ReadFirst.hs \ Language/Preprocessor/Cpphs/RunCpphs.hs \ Language/Preprocessor/Cpphs/SymTab.hs \ Language/Preprocessor/Cpphs/Tokenise.hs \ Language/Preprocessor/Unlit.hs \ Text/ParserCombinators/HuttonMeijer.hs \ cpphs.hs AUX = README LICENCE* CHANGELOG $(LIBRARY).cabal Setup.hs Makefile \ cpphs.hugs cpphs.compat \ tests/[A-BD-Z]* tests/[a-np-z]* \ docs/[a-z]* all: $(LIBRARY) package: tar cf tmp.tar $(SRCS) $(AUX) mkdir $(LIBRARY)-$(VERSION) cd $(LIBRARY)-$(VERSION); tar xf ../tmp.tar tar zcf $(LIBRARY)-$(VERSION).tar.gz $(LIBRARY)-$(VERSION) zip -r $(LIBRARY)-$(VERSION).zip $(LIBRARY)-$(VERSION) rm -r tmp.tar $(LIBRARY)-$(VERSION) haddock: $(SRCS) mkdir -p docs/$(LIBRARY) for dir in $(DIRS); do mkdir -p docs/$(LIBRARY)/$$dir; done for file in $(SRCS); \ do HsColour -anchorHTML $$file \ >docs/$(LIBRARY)/`dirname $$file`/`basename $$file .hs`.html;\ done haddock --html --title=$(LIBRARY) \ --odir=docs/$(LIBRARY) --package=$(LIBRARY) \ --source-module="%{MODULE/.//}.html" \ --source-entity="%{MODULE/.//}.html#%{NAME}" \ $(SRCS) $(LIBRARY): $(SRCS) $(HC) $(HFLAGS) $(HEAP) -o $@ $(SRCS) $(STRIP) $@ hugs98-plus-Sep2006/cpphs/Makefile.inc0000644006511100651110000000022310504340601016276 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/cpphs/Makefile.nhc980000644006511100651110000001452110504340601016464 0ustar rossrossinclude Makefile.inc OBJDIR = $(BUILDDIR)/$(OBJ)/cpphs CPPHS = $(DST)/cpphs$(EXE) TARGET = $(CPPHS) VERSION = 1.2 SRCS = Language/Preprocessor/Cpphs.hs \ Language/Preprocessor/Cpphs/CppIfdef.hs \ Language/Preprocessor/Cpphs/HashDefine.hs \ Language/Preprocessor/Cpphs/MacroPass.hs \ Language/Preprocessor/Cpphs/Options.hs \ Language/Preprocessor/Cpphs/Position.hs \ Language/Preprocessor/Cpphs/ReadFirst.hs \ Language/Preprocessor/Cpphs/RunCpphs.hs \ Language/Preprocessor/Cpphs/SymTab.hs \ Language/Preprocessor/Cpphs/Tokenise.hs \ Language/Preprocessor/Unlit.hs \ Text/ParserCombinators/HuttonMeijer.hs \ cpphs.hs DIRS = Language/Preprocessor \ Language/Preprocessor/Cpphs \ Text/ParserCombinators \ . FLATSRCS = $(shell for file in $(SRCS); do basename $$file ; done) OBJS = $(patsubst %.hs, $(OBJDIR)/%.$O, $(SRCS)) CFILES = $(patsubst %.hs, %.$C, $(SRCS)) AUX = README LICENCE* CHANGELOG cpphs.hugs cpphs.compat cpphs.cabal \ Setup.hs \ tests/[A-BD-Z]* tests/[a-np-z]* \ docs/[a-z]* HC = $(LOCAL)nhc98 # can be overridden by caller HC=... HFLAGS = $(shell echo $(BUILDOPTS)) #-$(CFG) ifeq "nhc98" "$(findstring nhc98, ${HC})" HEAP = -H4M -package base endif ifeq "ghc" "$(findstring ghc, ${HC})" HFLAGS += $(shell ${LOCAL}fixghc ${GHCSYM} -package base) endif ifeq "hbc" "$(findstring hbc, ${HC})" hbc: $(FLATSRCS) sed -e 's/System.IO.Unsafe/IOExts/' CppIfdef.hs >hbc mv hbc CppIfdef.hs sed -e 's/System.IO.Unsafe/IOExts/' MacroPass.hs >hbc cp -a hbc MacroPass.hs all: hbc endif all: $(TARGET) install: $(TARGET) cfiles: cleanC $(CFILES) fromC: $(OBJDIR) $(LOCAL)/nhc98 -c -d $(OBJDIR) $(CFILES) $(LOCAL)nhc98 -H8M -o $(TARGET) $(OBJS) $(STRIP) $(TARGET) clean: cleanHi cleanO cleanO: rm -f $(OBJS) cleanHi: for dir in $(DIRS); do rm -f $$dir/*.hi; done cleanC: for dir in $(DIRS); do rm -f $$dir/*.hc $$dir/*.c; done realclean: clean cleanC rm -f *.raw *.html haddock.css haskell_icon.gif rm -f $(TARGET) package: tar cf tmp.tar $(SRCS) $(AUX) mkdir cpphs-$(VERSION) cd cpphs-$(VERSION); tar xf ../tmp.tar tar zcf cpphs-$(VERSION).tar.gz cpphs-$(VERSION) zip -r cpphs-$(VERSION).zip cpphs-$(VERSION) rm -r tmp.tar cpphs-$(VERSION) haddock: $(SRCS) mkdir -p docs/cpphs for dir in $(DIRS); do mkdir -p docs/cpphs/$$dir; done for file in $(SRCS); \ do HsColour -anchorHTML $$file \ >docs/cpphs/`dirname $$file`/`basename $$file .hs`.html;\ done haddock --html --title=cpphs --odir=docs/cpphs --package=cpphs \ --source-module="%{MODULE/.//}.html" \ --source-entity="%{MODULE/.//}.html#%{NAME}" \ $(SRCS) flat: @echo $(FLATSRCS) $(CPPHS): $(OBJDIR) $(OBJS) $(HC) $(HFLAGS) $(HEAP) -o $@ $(OBJS) $(STRIP) $@ $(OBJDIR): mkdir -p $(OBJDIR) || $(TRUE) for dir in $(DIRS); do mkdir -p $(OBJDIR)/$$dir || $(TRUE); done $(OBJS): $(OBJDIR)/%.$O : %.hs $(HC) $(HFLAGS) -c -o $@ $< $(CFILES): %.$C : %.hs $(HC) $(HFLAGS) -C $< #$(FLATSRCS): $(SRCS) # -cp $(SRCS) . # dependencies generated by hmake -Md: ${OBJDIR}/Language/Preprocessor/Cpphs/Options.o: ${OBJDIR}/Language/Preprocessor/Cpphs/RunCpphs.o: \ ${OBJDIR}/Language/Preprocessor/Cpphs/CppIfdef.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/MacroPass.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/Options.o \ ${OBJDIR}/Language/Preprocessor/Unlit.o ${OBJDIR}/Language/Preprocessor/Cpphs/MacroPass.o: \ ${OBJDIR}/Language/Preprocessor/Cpphs/HashDefine.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/Tokenise.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/SymTab.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/Position.o ${OBJDIR}/Language/Preprocessor/Cpphs/HashDefine.o: ${OBJDIR}/Language/Preprocessor/Cpphs/Tokenise.o: \ ${OBJDIR}/Language/Preprocessor/Cpphs/HashDefine.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/Position.o ${OBJDIR}/Language/Preprocessor/Cpphs/ReadFirst.o: \ ${OBJDIR}/Language/Preprocessor/Cpphs/Position.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/SymTab.o ${OBJDIR}/Language/Preprocessor/Cpphs/Position.o: ${OBJDIR}/Language/Preprocessor/Cpphs/ReadFirst.o: \ ${OBJDIR}/Language/Preprocessor/Cpphs/Position.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/SymTab.o ${OBJDIR}/Language/Preprocessor/Cpphs/Position.o: ${OBJDIR}/Text/ParserCombinators/HuttonMeijer.o: ${OBJDIR}/Language/Preprocessor/Cpphs/SymTab.o: ${OBJDIR}/Language/Preprocessor/Cpphs/CppIfdef.o: \ ${OBJDIR}/Language/Preprocessor/Cpphs/SymTab.o \ ${OBJDIR}/Text/ParserCombinators/HuttonMeijer.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/Position.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/ReadFirst.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/Tokenise.o ${OBJDIR}/Language/Preprocessor/Cpphs.o: \ ${OBJDIR}/Language/Preprocessor/Cpphs/CppIfdef.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/MacroPass.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/RunCpphs.o \ ${OBJDIR}/Language/Preprocessor/Cpphs/Options.o ${OBJDIR}/Language/Preprocessor/Unlit.o: ${OBJDIR}/cpphs.o: \ ${OBJDIR}/Language/Preprocessor/Cpphs.o # C-files dependencies. Language/Preprocessor/Cpphs/Options.hc: Language/Preprocessor/Cpphs/RunCpphs.hc: \ Language/Preprocessor/Cpphs/CppIfdef.hc \ Language/Preprocessor/Cpphs/MacroPass.hc \ Language/Preprocessor/Cpphs/Options.hc \ Language/Preprocessor/Unlit.hc Language/Preprocessor/Cpphs/MacroPass.hc: \ Language/Preprocessor/Cpphs/HashDefine.hc \ Language/Preprocessor/Cpphs/Tokenise.hc \ Language/Preprocessor/Cpphs/SymTab.hc \ Language/Preprocessor/Cpphs/Position.hc Language/Preprocessor/Cpphs/HashDefine.hc: Language/Preprocessor/Cpphs/Tokenise.hc: \ Language/Preprocessor/Cpphs/HashDefine.hc \ Language/Preprocessor/Cpphs/Position.hc Language/Preprocessor/Cpphs/ReadFirst.hc: \ Language/Preprocessor/Cpphs/Position.hc \ Language/Preprocessor/Cpphs/SymTab.hc Language/Preprocessor/Cpphs/Position.hc: Text/ParserCombinators/HuttonMeijer.hc: Language/Preprocessor/Cpphs/SymTab.hc: Language/Preprocessor/Cpphs/CppIfdef.hc: \ Language/Preprocessor/Cpphs/SymTab.hc \ Text/ParserCombinators/HuttonMeijer.hc \ Language/Preprocessor/Cpphs/Position.hc \ Language/Preprocessor/Cpphs/ReadFirst.hc \ Language/Preprocessor/Cpphs/Tokenise.hc Language/Preprocessor/Cpphs.hc: \ Language/Preprocessor/Cpphs/CppIfdef.hc \ Language/Preprocessor/Cpphs/MacroPass.hc \ Language/Preprocessor/Cpphs/RunCpphs.hc \ Language/Preprocessor/Cpphs/Options.hc Language/Preprocessor/Unlit.hc: cpphs.hc: Language/Preprocessor/Cpphs.hc hugs98-plus-Sep2006/cpphs/Language/0000755006511100651110000000000010504340601015614 5ustar rossrosshugs98-plus-Sep2006/cpphs/Language/Preprocessor/0000755006511100651110000000000010504340601020302 5ustar rossrosshugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/0000755006511100651110000000000010504340601021357 5ustar rossrosshugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/CppIfdef.hs0000644006511100651110000002042610504340601023377 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : CppIfdef -- Copyright : 1999-2004 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace -- Stability : experimental -- Portability : All -- -- Perform a cpp.first-pass, gathering \#define's and evaluating \#ifdef's. -- and \#include's. ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs.CppIfdef ( cppIfdef -- :: FilePath -> [(String,String)] -> [String] -> Bool -> Bool -- -> String -> [(Posn,String)] ) where import Language.Preprocessor.Cpphs.SymTab import Text.ParserCombinators.HuttonMeijer -- import HashDefine import Language.Preprocessor.Cpphs.Position (Posn,newfile,newline,newlines,cppline,newpos) import Language.Preprocessor.Cpphs.ReadFirst (readFirst) import Language.Preprocessor.Cpphs.Tokenise (linesCpp,reslash) import Char (isDigit) import Numeric (readHex,readOct,readDec) import System.IO.Unsafe (unsafePerformIO) import IO (hPutStrLn,stderr) -- | Run a first pass of cpp, evaluating \#ifdef's and processing \#include's, -- whilst taking account of \#define's and \#undef's as we encounter them. cppIfdef :: FilePath -- ^ File for error reports -> [(String,String)] -- ^ Pre-defined symbols and their values -> [String] -- ^ Search path for \#includes -> Bool -- ^ Leave \#define and \#undef in output? -> Bool -- ^ Place \#line droppings in output? -> String -- ^ The input file content -> [(Posn,String)] -- ^ The file after processing (in lines) cppIfdef fp syms search leave locat = cpp posn defs search leave locat Keep . (cppline posn:) . linesCpp where posn = newfile fp defs = foldr insertST emptyST syms -- Notice that the symbol table is a very simple one mapping strings -- to strings. This pass does not need anything more elaborate, in -- particular it is not required to deal with any parameterised macros. -- | Internal state for whether lines are being kept or dropped. -- In @Drop n b@, @n@ is the depth of nesting, @b@ is whether -- we have already succeeded in keeping some lines in a chain of -- @elif@'s data KeepState = Keep | Drop Int Bool -- | Return just the list of lines that the real cpp would decide to keep. cpp :: Posn -> SymTab String -> [String] -> Bool -> Bool -> KeepState -> [String] -> [(Posn,String)] cpp _ _ _ _ _ _ [] = [] cpp p syms path leave ln Keep (l@('#':x):xs) = let ws = words x cmd = head ws sym = head (tail ws) rest = tail (tail ws) val = maybe "1" id (un rest) un v = if null v then Nothing else Just (unwords v) down = if definedST sym syms then (Drop 1 False) else Keep up = if definedST sym syms then Keep else (Drop 1 False) keep str = if gatherDefined p syms str then Keep else (Drop 1 False) skipn cpp' p' syms' path' ud xs' = let n = 1 + length (filter (=='\n') l) in (if leave then ((p,reslash l):) else (replicate n (p,"") ++)) $ cpp' (newlines n p') syms' path' leave ln ud xs' in case cmd of "define" -> skipn cpp p (insertST (sym,val) syms) path Keep xs "undef" -> skipn cpp p (deleteST sym syms) path Keep xs "ifndef" -> skipn cpp p syms path down xs "ifdef" -> skipn cpp p syms path up xs "if" -> skipn cpp p syms path (keep (unwords (tail ws))) xs "else" -> skipn cpp p syms path (Drop 1 False) xs "elif" -> skipn cpp p syms path (Drop 1 True) xs "endif" -> skipn cpp p syms path Keep xs "pragma" -> skipn cpp p syms path Keep xs ('!':_) -> skipn cpp p syms path Keep xs -- \#!runhs scripts "include"-> let (inc,content) = unsafePerformIO (readFirst (unwords (tail ws)) p path syms) in cpp p syms path leave ln Keep (("#line 1 "++show inc) : linesCpp content ++ cppline p :"": xs) "warning"-> unsafePerformIO $ do hPutStrLn stderr (l++"\nin "++show p) return $ skipn cpp p syms path Keep xs "error" -> error (l++"\nin "++show p) "line" | all isDigit sym -> (if ln then ((p,l):) else id) $ cpp (newpos (read sym) (un rest) p) syms path leave ln Keep xs n | all isDigit n -> (if ln then ((p,l):) else id) $ cpp (newpos (read n) (un (tail ws)) p) syms path leave ln Keep xs | otherwise -> unsafePerformIO $ do hPutStrLn stderr ("Warning: unknown directive #"++n ++"\nin "++show p) return $ ((p,l): cpp (newline p) syms path leave ln Keep xs) cpp p syms path leave ln (Drop n b) (('#':x):xs) = let ws = words x cmd = head ws delse | n==1 && b = Drop 1 b | n==1 = Keep | otherwise = Drop n b dend | n==1 = Keep | otherwise = Drop (n-1) b keep str | n==1 = if not b && gatherDefined p syms str then Keep else (Drop 1) b | otherwise = Drop n b skipn cpp' p' syms' path' ud xs' = let n' = 1 + length (filter (=='\n') x) in replicate n' (p,"") ++ cpp' (newlines n' p') syms' path' leave ln ud xs' in if cmd == "ifndef" || cmd == "if" || cmd == "ifdef" then skipn cpp p syms path (Drop (n+1) b) xs else if cmd == "elif" then skipn cpp p syms path (keep (unwords (tail ws))) xs else if cmd == "else" then skipn cpp p syms path delse xs else if cmd == "endif" then skipn cpp p syms path dend xs else skipn cpp p syms path (Drop n b) xs -- define, undef, include, error, warning, pragma, line cpp p syms path leave ln Keep (x:xs) = let p' = newline p in seq p' $ (p,x): cpp p' syms path leave ln Keep xs cpp p syms path leave ln d@(Drop _ _) (_:xs) = let p' = newline p in seq p' $ (p,""): cpp p' syms path leave ln d xs ---- gatherDefined :: Posn -> SymTab String -> String -> Bool gatherDefined p st inp = case papply (parseBoolExp st) inp of [] -> error ("Cannot parse #if directive in file "++show p) [(b,_)] -> b _ -> error ("Ambiguous parse for #if directive in file "++show p) parseBoolExp :: SymTab String -> Parser Bool parseBoolExp st = do a <- parseExp1 st skip (string "||") b <- first (skip (parseBoolExp st)) return (a || b) +++ parseExp1 st parseExp1 :: SymTab String -> Parser Bool parseExp1 st = do a <- parseExp0 st skip (string "&&") b <- first (skip (parseExp1 st)) return (a && b) +++ parseExp0 st parseExp0 :: SymTab String -> Parser Bool parseExp0 st = do skip (string "defined") sym <- bracket (skip (char '(')) (skip (many1 alphanum)) (skip (char ')')) return (definedST sym st) +++ do bracket (skip (char '(')) (parseBoolExp st) (skip (char ')')) +++ do skip (char '!') a <- parseExp0 st return (not a) +++ do sym1 <- skip (many1 alphanum) op <- parseOp st sym2 <- skip (many1 alphanum) let val1 = convert sym1 st let val2 = convert sym2 st return (op val1 val2) +++ do sym <- skip (many1 alphanum) case convert sym st of 0 -> return False _ -> return True where convert sym st' = case lookupST sym st' of Nothing -> safeRead sym (Just a) -> safeRead a safeRead s = case s of '0':'x':s' -> number readHex s' '0':'o':s' -> number readOct s' _ -> number readDec s number rd s = case rd s of [] -> 0 :: Integer ((n,_):_) -> n :: Integer parseOp :: SymTab String -> Parser (Integer -> Integer -> Bool) parseOp _ = do skip (string ">=") return (>=) +++ do skip (char '>') return (>) +++ do skip (string "<=") return (<=) +++ do skip (char '<') return (<) +++ do skip (string "==") return (==) +++ do skip (string "!=") return (/=) hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/HashDefine.hs0000644006511100651110000000765310504340601023724 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : HashDefine -- Copyright : 2004 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace -- Stability : experimental -- Portability : All -- -- What structures are declared in a \#define. ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs.HashDefine ( HashDefine(..) , ArgOrText(..) , expandMacro , parseHashDefine ) where import Char (isSpace) import List (intersperse) data HashDefine = LineDrop { name :: String } | SymbolReplacement { name :: String , replacement :: String , linebreaks :: Int } | MacroExpansion { name :: String , arguments :: [String] , expansion :: [(ArgOrText,String)] , linebreaks :: Int } deriving (Eq,Show) -- | 'smart' constructor to avoid warnings from ghc (undefined fields) symbolReplacement :: HashDefine symbolReplacement = SymbolReplacement { name=undefined, replacement=undefined, linebreaks=undefined } -- | Macro expansion text is divided into sections, each of which is classified -- as one of three kinds: a formal argument (Arg), plain text (Text), -- or a stringised formal argument (Str). data ArgOrText = Arg | Text | Str deriving (Eq,Show) -- | Expand an instance of a macro. -- Precondition: got a match on the macro name. expandMacro :: HashDefine -> [String] -> Bool -> String expandMacro macro parameters layout = let env = zip (arguments macro) parameters replace (Arg,s) = maybe (error "formal param") id (lookup s env) replace (Str,s) = maybe (error "formal param") str (lookup s env) replace (Text,s) = if layout then s else filter (/='\n') s str s = '"':s++"\"" in concatMap replace (expansion macro) -- | Parse a \#define, or \#undef, ignoring other \# directives parseHashDefine :: Bool -> [String] -> Maybe HashDefine parseHashDefine ansi def = (command . skip) def where skip xss@(x:xs) | all isSpace x = skip xs | otherwise = xss skip [] = [] command ("line":xs) = Just (LineDrop ("#line"++concat xs)) command ("define":xs) = Just (((define . skip) xs) { linebreaks=count def }) command ("undef":xs) = Just (((undef . skip) xs) { linebreaks=count def }) command _ = Nothing undef (sym:_) = symbolReplacement { name=sym, replacement=sym } define (sym:xs) = case {-skip-} xs of ("(":ys) -> (macroHead sym [] . skip) ys ys -> symbolReplacement { name=sym , replacement=chop (skip ys) } macroHead sym args (",":xs) = (macroHead sym args . skip) xs macroHead sym args (")":xs) = MacroExpansion { name =sym , arguments = reverse args , expansion = classifyRhs args (skip xs) , linebreaks = undefined } macroHead sym args (var:xs) = (macroHead sym (var:args) . skip) xs macroHead sym args [] = error ("incomplete macro definition:\n" ++" #define "++sym++"(" ++concat (intersperse "," args)) classifyRhs args ("#":x:xs) | ansi && x `elem` args = (Str,x): classifyRhs args xs classifyRhs args ("##":xs) | ansi = classifyRhs args xs classifyRhs args (word:xs) | word `elem` args = (Arg,word): classifyRhs args xs | otherwise = (Text,word): classifyRhs args xs classifyRhs _ [] = [] count = length . filter (=='\n') . concat chop = concat . reverse . dropWhile (all isSpace) . reverse hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/MacroPass.hs0000644006511100651110000001261110504340601023604 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : MacroPass -- Copyright : 2004 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace -- Stability : experimental -- Portability : All -- -- Perform a cpp.second-pass, accumulating \#define's and \#undef's, -- whilst doing symbol replacement and macro expansion. ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs.MacroPass ( macroPass , preDefine ) where import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro) import Language.Preprocessor.Cpphs.Tokenise (tokenise, WordStyle(..), parseMacroCall) import Language.Preprocessor.Cpphs.SymTab (SymTab, lookupST, insertST, emptyST) import Language.Preprocessor.Cpphs.Position (Posn, newfile, filename, lineno) import System.IO.Unsafe (unsafePerformIO) import Time (getClockTime, toCalendarTime, formatCalendarTime) import Locale (defaultTimeLocale) noPos :: Posn noPos = newfile "preDefined" -- | Walk through the document, replacing calls of macros with their expanded RHS. macroPass :: [(String,String)] -- ^ Pre-defined symbols and their values -> Bool -- ^ Strip C-comments? -> Bool -- ^ Accept \# and \## operators? -> Bool -- ^ Retain layout in macros? -> Bool -- ^ Input language (Haskell\/not) -> [(Posn,String)] -- ^ The input file content -> String -- ^ The file after processing macroPass syms strip hashes layout language = safetail -- to remove extra "\n" inserted below . concat . macroProcess layout language (preDefine hashes language syms) . tokenise strip hashes language . ((noPos,""):) -- ensure recognition of "\n#" at start of file where safetail [] = [] safetail (_:xs) = xs -- | Turn command-line definitions (from @-D@) into 'HashDefine's. preDefine :: Bool -> Bool -> [(String,String)] -> SymTab HashDefine preDefine hashes lang defines = foldr (insertST.defval) emptyST defines where defval (s,d) = let (Cmd (Just hd):_) = tokenise True hashes lang [(noPos,"\n#define "++s++" "++d++"\n")] in (name hd, hd) -- | Trundle through the document, one word at a time, using the WordStyle -- classification introduced by 'tokenise' to decide whether to expand a -- word or macro. Encountering a \#define or \#undef causes that symbol to -- be overwritten in the symbol table. Any other remaining cpp directives -- are discarded and replaced with blanks, except for \#line markers. -- All valid identifiers are checked for the presence of a definition -- of that name in the symbol table, and if so, expanded appropriately. macroProcess :: Bool -> Bool -> SymTab HashDefine -> [WordStyle] -> [String] macroProcess _ _ _ [] = [] macroProcess y l st (Other x: ws) = x: macroProcess y l st ws macroProcess y l st (Cmd Nothing: ws) = "\n": macroProcess y l st ws macroProcess y l st (Cmd (Just (LineDrop x)): ws)= "\n":x:macroProcess y l st ws macroProcess layout lang st (Cmd (Just hd): ws) = let n = 1 + linebreaks hd in replicate n "\n" ++ macroProcess layout lang (insertST (name hd, hd) st) ws macroProcess layout lang st (Ident p x: ws) = case x of "__FILE__" -> show (filename p): macroProcess layout lang st ws "__LINE__" -> show (lineno p): macroProcess layout lang st ws "__DATE__" -> formatCalendarTime defaultTimeLocale "\"%d %b %Y\"" (unsafePerformIO (getClockTime>>=toCalendarTime)): macroProcess layout lang st ws "__TIME__" -> formatCalendarTime defaultTimeLocale "\"%H:%M:%S\"" (unsafePerformIO (getClockTime>>=toCalendarTime)): macroProcess layout lang st ws _ -> case lookupST x st of Nothing -> x: macroProcess layout lang st ws Just hd -> case hd of SymbolReplacement _ r _ -> -- one-level expansion only: -- r: macroProcess layout st ws -- multi-level expansion: let r' = if layout then r else filter (/='\n') r in macroProcess layout lang st (tokenise True False lang [(p,r')] ++ ws) MacroExpansion _ _ _ _ -> case parseMacroCall ws of Nothing -> x: macroProcess layout lang st ws Just (args,ws') -> if length args /= length (arguments hd) then x: macroProcess layout lang st ws else -- one-level expansion only: -- expandMacro hd args layout: -- macroProcess layout st ws' -- multi-level expansion: macroProcess layout lang st (tokenise True False lang [(p,expandMacro hd args layout)] ++ ws') hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/Position.hs0000644006511100651110000000472310504340601023525 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Position -- Copyright : 2000-2004 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace -- Stability : experimental -- Portability : All -- -- Simple file position information, with recursive inclusion points. ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs.Position ( Posn(..) , newfile , addcol, newline, tab, newlines, newpos , cppline , filename, lineno, directory ) where -- | Source positions contain a filename, line, column, and an -- inclusion point, which is itself another source position, -- recursively. data Posn = Pn String !Int !Int (Maybe Posn) deriving (Eq) instance Show Posn where showsPrec _ (Pn f l c i) = showString f . showString " at line " . shows l . showString " col " . shows c . ( case i of Nothing -> id Just p -> showString "\n used by " . shows p ) -- | Constructor newfile :: String -> Posn newfile name = Pn name 1 1 Nothing -- | Updates addcol :: Int -> Posn -> Posn addcol n (Pn f r c i) = Pn f r (c+n) i newline, tab :: Posn -> Posn --newline (Pn f r _ i) = Pn f (r+1) 1 i newline (Pn f r _ i) = let r' = r+1 in r' `seq` Pn f r' 1 i tab (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i newlines :: Int -> Posn -> Posn newlines n (Pn f r _ i) = Pn f (r+n) 1 i newpos :: Int -> Maybe String -> Posn -> Posn newpos r Nothing (Pn f _ c i) = Pn f r c i newpos r (Just ('"':f)) (Pn _ _ c i) = Pn (init f) r c i newpos r (Just f) (Pn _ _ c i) = Pn f r c i -- | Projections lineno :: Posn -> Int filename :: Posn -> String directory :: Posn -> FilePath lineno (Pn _ r _ _) = r filename (Pn f _ _ _) = f directory (Pn f _ _ _) = dirname f -- | cpp-style printing cppline :: Posn -> String cppline (Pn f r _ _) = "#line "++show r++" "++show f -- | Strip non-directory suffix from file name (analogous to the shell -- command of the same name). dirname :: String -> String dirname = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse where safetail [] = [] safetail (_:x) = x hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/ReadFirst.hs0000644006511100651110000000434310504340601023602 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : ReadFirst -- Copyright : 2004 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace -- Stability : experimental -- Portability : All -- -- Read the first file that matches in a list of search paths. ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs.ReadFirst ( readFirst ) where import IO (hPutStrLn, stderr) import Directory (doesFileExist) import List (intersperse) import Language.Preprocessor.Cpphs.Position (Posn,directory) import Language.Preprocessor.Cpphs.SymTab (SymTab,lookupST) -- | Attempt to read the given file from any location within the search path. -- The first location found is returned, together with the file content. -- (The directory of the calling file is always searched first, then -- the current directory, finally any specified search path.) readFirst :: String -- ^ filename -> Posn -- ^ inclusion point -> [String] -- ^ search path -> SymTab String -- ^ \#defined symbols -> IO ( FilePath , String ) -- ^ discovered filepath, and file contents readFirst name demand path syms = try (cons dd (".":path)) where dd = directory demand cons x xs = if null x then xs else x:xs realname = real name syms try [] = do hPutStrLn stderr ("Warning: Can't find file \""++realname ++"\" in directories\n\t" ++concat (intersperse "\n\t" (cons dd (".":path))) ++"\n Asked for by: "++show demand) return ("missing file: "++realname,"") try (p:ps) = do let file = p++'/':realname ok <- doesFileExist file if not ok then try ps else do content <- readFile file return (file,content) real :: String -> SymTab String -> String real name syms = case name of ('"':ns) -> init ns ('<':ns) -> init ns _ -> case lookupST name syms of Nothing -> name Just f -> real f syms hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/RunCpphs.hs0000644006511100651110000000240610504340601023457 0ustar rossross{- -- The main program for cpphs, a simple C pre-processor written in Haskell. -- Copyright (c) 2004 Malcolm Wallace -- This file is GPL, although the libraries it uses are either standard -- Haskell'98 or distributed under the LGPL. -} module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs ) where import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef) import Language.Preprocessor.Cpphs.MacroPass(macroPass) import Language.Preprocessor.Cpphs.Options(CpphsOption(..), parseOption) import Language.Preprocessor.Unlit as Unlit (unlit) runCpphs :: [CpphsOption] -> FilePath -> String -> IO String runCpphs opts filename input = do let ds = [x | CpphsMacro x <- opts] is = [x | CpphsPath x <- opts] macro = not (CpphsNoMacro `elem` opts) locat = not (CpphsNoLine `elem` opts) lang = not (CpphsText `elem` opts) strip = CpphsStrip `elem` opts ansi = CpphsAnsi `elem` opts layout= CpphsLayout `elem` opts unlit = CpphsUnlit `elem` opts let pass1 = cppIfdef filename ds is macro locat input pass2 = macroPass ds strip ansi layout lang pass1 result = if not macro then unlines (map snd pass1) else pass2 pass3 = if unlit then Unlit.unlit filename result else result return pass3 hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/SymTab.hs0000644006511100651110000000456510504340601023124 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : SymTab -- Copyright : 2000-2004 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace -- Stability : Stable -- Portability : All -- -- Symbol Table, based on index trees using a hash on the key. -- Keys are always Strings. Stored values can be any type. ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs.SymTab ( SymTab , emptyST , insertST , deleteST , lookupST , definedST , IndTree ) where -- | Symbol Table. Stored values are polymorphic, but the keys are -- always strings. type SymTab v = IndTree [(String,v)] emptyST :: SymTab v insertST :: (String,v) -> SymTab v -> SymTab v deleteST :: String -> SymTab v -> SymTab v lookupST :: String -> SymTab v -> Maybe v definedST :: String -> SymTab v -> Bool emptyST = itgen maxHash [] insertST (s,v) ss = itiap (hash s) ((s,v):) ss id deleteST s ss = itiap (hash s) (filter ((/=s).fst)) ss id lookupST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss) in if null vs then Nothing else (Just . snd . head) vs definedST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss) in (not . null) vs ---- -- | Index Trees (storing indexes at nodes). data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t) deriving Show itgen :: Int -> a -> IndTree a itgen 1 x = Leaf x itgen n x = let n' = n `div` 2 in Fork n' (itgen n' x) (itgen (n-n') x) itiap :: --Eval a => Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b itiap _ f (Leaf x) k = let fx = f x in {-seq fx-} (k (Leaf fx)) itiap i f (Fork n lt rt) k = if i k (Fork n lt' rt) else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt') itind :: Int -> IndTree a -> a itind _ (Leaf x) = x itind i (Fork n lt rt) = if i a -> Int hash :: a -> Int hash = hashWithMax maxHash instance Enum a => Hashable [a] where hashWithMax m = h 0 where h a [] = a h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs ---- hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/Tokenise.hs0000644006511100651110000003162410504340601023502 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Tokenise -- Copyright : 2004 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace -- Stability : experimental -- Portability : All -- -- The purpose of this module is to lex a source file (language -- unspecified) into tokens such that cpp can recognise a replaceable -- symbol or macro-use, and do the right thing. ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs.Tokenise ( linesCpp , reslash , tokenise , WordStyle(..) , deWordStyle , parseMacroCall ) where import Char import Language.Preprocessor.Cpphs.HashDefine import Language.Preprocessor.Cpphs.Position -- | A Mode value describes whether to tokenise a la Haskell, or a la Cpp. -- The main difference is that in Cpp mode we should recognise line -- continuation characters. data Mode = Haskell | Cpp -- | linesCpp is, broadly speaking, Prelude.lines, except that -- on a line beginning with a \#, line continuation characters are -- recognised. In a line continuation, the newline character is -- preserved, but the backslash is not. linesCpp :: String -> [String] linesCpp [] = [] linesCpp (x:xs) | x=='#' = tok Cpp ['#'] xs | otherwise = tok Haskell [] (x:xs) where tok Cpp acc ('\\':'\n':ys) = tok Cpp ('\n':acc) ys tok _ acc ('\n':'#':ys) = reverse acc: tok Cpp ['#'] ys tok _ acc ('\n':ys) = reverse acc: tok Haskell [] ys tok _ acc [] = reverse acc: [] tok mode acc (y:ys) = tok mode (y:acc) ys -- | Put back the line-continuation characters. reslash :: String -> String reslash ('\n':xs) = '\\':'\n':reslash xs reslash (x:xs) = x: reslash xs reslash [] = [] ---- -- | Submodes are required to deal correctly with nesting of lexical -- structures. data SubMode = Any | Pred (Char->Bool) (Posn->String->WordStyle) | String Char | LineComment | NestComment Int | CComment -- | Each token is classified as one of Ident, Other, or Cmd: -- * Ident is a word that could potentially match a macro name. -- * Cmd is a complete cpp directive (\#define etc). -- * Other is anything else. data WordStyle = Ident Posn String | Other String | Cmd (Maybe HashDefine) deriving (Eq,Show) other _ s = Other s deWordStyle :: WordStyle -> String deWordStyle (Ident _ i) = i deWordStyle (Other i) = i deWordStyle (Cmd _) = "\n" -- | tokenise is, broadly-speaking, Prelude.words, except that: -- * the input is already divided into lines -- * each word-like "token" is categorised as one of {Ident,Other,Cmd} -- * \#define's are parsed and returned out-of-band using the Cmd variant -- * All whitespace is preserved intact as tokens. -- * C-comments are converted to white-space (depending on first param) -- * Parens and commas are tokens in their own right. -- * Any cpp line continuations are respected. -- No errors can be raised. -- The inverse of tokenise is (concatMap deWordStyle). tokenise :: Bool -> Bool -> Bool -> [(Posn,String)] -> [WordStyle] tokenise _ _ _ [] = [] tokenise strip ansi lang ((pos,str):pos_strs) = (if lang then haskell else plaintext) Any [] pos pos_strs str where -- rules to lex Haskell haskell :: SubMode -> String -> Posn -> [(Posn,String)] -> String -> [WordStyle] haskell Any acc p ls ('\n':'#':xs) = emit acc $ -- emit "\n" $ cpp Any haskell [] [] p ls xs -- warning: non-maximal munch on comment haskell Any acc p ls ('-':'-':xs) = emit acc $ haskell LineComment "--" p ls xs haskell Any acc p ls ('{':'-':xs) = emit acc $ haskell (NestComment 0) "-{" p ls xs haskell Any acc p ls ('/':'*':xs)|strip = emit acc $ haskell CComment " " p ls xs haskell Any acc p ls ('"':xs) = emit acc $ haskell (String '"') ['"'] p ls xs haskell Any acc p ls ('\'':xs) = emit acc $ haskell (String '\'') "'" p ls xs haskell Any acc p ls (x:xs) | single x = emit acc $ emit [x] $ haskell Any [] p ls xs haskell Any acc p ls (x:xs) | space x = emit acc $ haskell (Pred space other) [x] p ls xs haskell Any acc p ls (x:xs) | symbol x = emit acc $ haskell (Pred symbol other) [x] p ls xs -- haskell Any [] p ls (x:xs) | ident0 x = id $ haskell Any acc p ls (x:xs) | ident0 x = emit acc $ haskell (Pred ident1 Ident) [x] p ls xs haskell Any acc p ls (x:xs) = haskell Any (x:acc) p ls xs haskell pre@(Pred pred ws) acc p ls (x:xs) | pred x = haskell pre (x:acc) p ls xs | otherwise = ws p (reverse acc): haskell Any [] p ls (x:xs) haskell (Pred _ ws) acc p [] [] = ws p (reverse acc): [] haskell (String c) acc p ls ('\\':x:xs) | x=='\\' = haskell (String c) ('\\':'\\':acc) p ls xs | x==c = haskell (String c) (c:'\\':acc) p ls xs haskell (String c) acc p ls (x:xs) | x==c = emit (c:acc) $ haskell Any [] p ls xs | otherwise = haskell (String c) (x:acc) p ls xs haskell LineComment acc p ls xs@('\n':_) = emit acc $ haskell Any [] p ls xs haskell LineComment acc p ls (x:xs) = haskell LineComment (x:acc) p ls xs haskell (NestComment n) acc p ls ('{':'-':xs) = haskell (NestComment (n+1)) ("-{"++acc) p ls xs haskell (NestComment 0) acc p ls ('-':'}':xs) = emit ("}-"++acc) $ haskell Any [] p ls xs haskell (NestComment n) acc p ls ('-':'}':xs) = haskell (NestComment (n-1)) ("}-"++acc) p ls xs haskell (NestComment n) acc p ls (x:xs) = haskell (NestComment n) (x:acc) p ls xs haskell CComment acc p ls ('*':'/':xs) = emit (" "++acc) $ haskell Any [] p ls xs haskell CComment acc p ls (_:xs) = haskell CComment (' ':acc) p ls xs haskell mode acc _ ((p,l):ls) [] = haskell mode acc p ls ('\n':l) haskell _ acc _ [] [] = emit acc $ [] -- rules to lex Cpp cpp :: SubMode -> (SubMode -> String -> Posn -> [(Posn,String)] -> String -> [WordStyle]) -> String -> [String] -> Posn -> [(Posn,String)] -> String -> [WordStyle] cpp mode next word line pos remaining input = lexcpp mode word line remaining input where lexcpp Any w l ls ('/':'*':xs) = lexcpp (NestComment 0) "" (w*/*l) ls xs lexcpp Any w l ls ('/':'/':xs) = lexcpp LineComment " " (w*/*l) ls xs lexcpp Any w l ((p,l'):ls) ('\\':[]) = cpp Any next [] ("\n":w*/*l) p ls l' lexcpp Any w l ls ('\\':'\n':xs) = lexcpp Any [] ("\n":w*/*l) ls xs lexcpp Any w l ls xs@('\n':_) = Cmd (parseHashDefine ansi (reverse (w*/*l))): next Any [] pos ls xs -- lexcpp Any w l ls ('"':xs) = lexcpp (String '"') ['"'] (w*/*l) ls xs -- lexcpp Any w l ls ('\'':xs) = lexcpp (String '\'') "'" (w*/*l) ls xs lexcpp Any w l ls ('"':xs) = lexcpp Any [] ("\"":(w*/*l)) ls xs lexcpp Any w l ls ('\'':xs) = lexcpp Any [] ("'": (w*/*l)) ls xs lexcpp Any [] l ls (x:xs) | ident0 x = lexcpp (Pred ident1 Ident) [x] l ls xs -- lexcpp Any w l ls (x:xs) | ident0 x = lexcpp (Pred ident1 Ident) [x] (w*/*l) ls xs lexcpp Any w l ls (x:xs) | single x = lexcpp Any [] ([x]:w*/*l) ls xs | space x = lexcpp (Pred space other) [x] (w*/*l) ls xs | symbol x = lexcpp (Pred symbol other) [x] (w*/*l) ls xs | otherwise = lexcpp Any (x:w) l ls xs lexcpp pre@(Pred pred _) w l ls (x:xs) | pred x = lexcpp pre (x:w) l ls xs | otherwise = lexcpp Any [] (w*/*l) ls (x:xs) lexcpp (Pred _ _) w l [] [] = lexcpp Any [] (w*/*l) [] "\n" lexcpp (String c) w l ls ('\\':x:xs) | x=='\\' = lexcpp (String c) ('\\':'\\':w) l ls xs | x==c = lexcpp (String c) (c:'\\':w) l ls xs lexcpp (String c) w l ls (x:xs) | x==c = lexcpp Any [] ((c:w)*/*l) ls xs | otherwise = lexcpp (String c) (x:w) l ls xs lexcpp LineComment w l ((p,l'):ls) ('\\':[]) = cpp LineComment next [] (('\n':w)*/*l) pos ls l' lexcpp LineComment w l ls ('\\':'\n':xs) = lexcpp LineComment [] (('\n':w)*/*l) ls xs lexcpp LineComment w l ls xs@('\n':_) = lexcpp Any w l ls xs lexcpp LineComment w l ls (_:xs) = lexcpp LineComment (' ':w) l ls xs lexcpp (NestComment _) w l ls ('*':'/':xs) = lexcpp Any [] (w*/*l) ls xs lexcpp (NestComment n) w l ls (_:xs) = lexcpp (NestComment n) (' ':w) l ls xs lexcpp mode w l ((p,l'):ls) [] = cpp mode next w l pos ls ('\n':l') lexcpp _ _ _ [] [] = [] -- rules to lex non-Haskell, non-cpp text plaintext :: SubMode -> String -> Posn -> [(Posn,String)] -> String -> [WordStyle] plaintext Any acc p ls ('\n':'#':xs) = emit acc $ -- emit "\n" $ cpp Any plaintext [] [] p ls xs plaintext Any acc p ls ('/':'*':xs)|strip = emit acc $ plaintext CComment " " p ls xs plaintext Any acc p ls (x:xs) | single x = emit acc $ emit [x] $ plaintext Any [] p ls xs plaintext Any acc p ls (x:xs) | space x = emit acc $ plaintext (Pred space other) [x] p ls xs plaintext Any acc p ls (x:xs) | ident0 x = emit acc $ plaintext (Pred ident1 Ident) [x] p ls xs plaintext Any acc p ls (x:xs) = plaintext Any (x:acc) p ls xs plaintext pre@(Pred pred ws) acc p ls (x:xs) | pred x = plaintext pre (x:acc) p ls xs | otherwise = ws p (reverse acc): plaintext Any [] p ls (x:xs) plaintext (Pred _ ws) acc p [] [] = ws p (reverse acc): [] plaintext CComment acc p ls ('*':'/':xs) = emit (" "++acc) $ plaintext Any [] p ls xs plaintext CComment acc p ls (_:xs) = plaintext CComment (' ':acc) p ls xs plaintext mode acc _ ((p,l):ls) [] = plaintext mode acc p ls ('\n':l) plaintext _ acc _ [] [] = emit acc $ [] -- predicates for lexing Haskell. ident0 x = isAlpha x || x `elem` "_`" ident1 x = isAlphaNum x || x `elem` "'_`" symbol x = x `elem` ":!#$%&*+./<=>?@\\^|-~" single x = x `elem` "(),[];{}" space x = x `elem` " \t" -- emit a token (if there is one) from the accumulator emit "" = id emit xs = (Other (reverse xs):) -- add a reversed word to the accumulator "" */* l = l w */* l = reverse w : l -- | Parse a possible macro call, returning argument list and remaining input parseMacroCall :: [WordStyle] -> Maybe ([String],[WordStyle]) parseMacroCall = call . skip where skip (Other x:xs) | all isSpace x = skip xs skip xss = xss call (Other "(":xs) = (args (0::Int) [] [] . skip) xs call _ = Nothing args 0 w acc (Other ",":xs) = args 0 [] (addone w acc) (skip xs) args n w acc (Other "(":xs) = args (n+1) ("(":w) acc xs args 0 w acc (Other ")":xs) = Just (reverse (addone w acc), xs) args n w acc (Other ")":xs) = args (n-1) (")":w) acc xs args n w acc (Ident _ var:xs) = args n (var:w) acc xs args n w acc (Other var:xs) = args n (var:w) acc xs args _ _ _ _ = Nothing addone w acc = concat (reverse (dropWhile (all isSpace) w)): acc hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs/Options.hs0000644006511100651110000000263610504340601023355 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Options -- Copyright : 2006 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace -- Stability : experimental -- Portability : All -- -- This module deals with Cpphs options and parsing them ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs.Options(CpphsOption(..), parseOption) where import Maybe data CpphsOption = CpphsNoMacro | CpphsNoLine | CpphsText | CpphsStrip | CpphsAnsi | CpphsLayout | CpphsUnlit | CpphsMacro (String,String) | CpphsPath String deriving (Eq, Show) flags = [ ("--nomacro", CpphsNoMacro) , ("--noline", CpphsNoLine) , ("--text", CpphsText) , ("--strip", CpphsStrip) , ("--hashes", CpphsAnsi) , ("--layout", CpphsLayout) , ("--unlit", CpphsUnlit) ] parseOption :: String -> Maybe CpphsOption parseOption x | isJust a = Just $ fromJust a where a = lookup x flags parseOption ('-':'D':xs) = Just $ CpphsMacro (s, if null d then "1" else tail d) where (s,d) = break (=='=') xs parseOption ('-':'I':xs) = Just $ CpphsPath $ trail "/\\" xs parseOption _ = Nothing trail :: (Eq a) => [a] -> [a] -> [a] trail xs = reverse . dropWhile (`elem`xs) . reverse hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Cpphs.hs0000644006511100651110000000142010504340601021710 0ustar rossross----------------------------------------------------------------------------- -- | -- Module : Language.Preprocessor.Cpphs -- Copyright : 2000-2006 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace -- Stability : experimental -- Portability : All -- -- Include the interface that is exported ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs (runCpphs, cppIfdef, macroPass, CpphsOption(..), parseOption) where import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef) import Language.Preprocessor.Cpphs.MacroPass(macroPass) import Language.Preprocessor.Cpphs.RunCpphs(runCpphs) import Language.Preprocessor.Cpphs.Options(CpphsOption(..), parseOption) hugs98-plus-Sep2006/cpphs/Language/Preprocessor/Unlit.hs0000644006511100651110000000642610504340601021741 0ustar rossross-- | Part of this code is from "Report on the Programming Language Haskell", -- version 1.2, appendix C. module Language.Preprocessor.Unlit (unlit) where import Char data Classified = Program String | Blank | Comment | Include Int String | Pre String classify :: [String] -> [Classified] classify [] = [] classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs where allProg [] = [] -- Should give an error message, -- but I have no good position information. allProg (('\\':x):xs) | x == "end{code}" = Blank : classify xs allProg (x:xs) = Program x:allProg xs classify (('>':x):xs) = Program (' ':x) : classify xs classify (('#':x):xs) = (case words x of (line:file:_) | all isDigit line -> Include (read line) file _ -> Pre x ) : classify xs classify (x:xs) | all isSpace x = Blank:classify xs classify (x:xs) = Comment:classify xs unclassify :: Classified -> String unclassify (Program s) = s unclassify (Pre s) = '#':s unclassify (Include i f) = '#':' ':show i ++ ' ':f unclassify Blank = "" unclassify Comment = "" -- | 'unlit' takes a filename (for error reports), and transforms the -- given string, to eliminate the literate comments from the program text. unlit :: FilePath -> String -> String unlit file lhs = (unlines . map unclassify . adjacent file (0::Int) Blank . classify) (inlines lhs) adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified] adjacent file 0 _ (x :xs) = x : adjacent file 1 x xs -- force evaluation of line number adjacent file n y@(Program _) (x@Comment :xs) = error (message file n "program" "comment") adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs adjacent file n y@(Program _) (x@(Pre _) :xs) = x: adjacent file (n+1) y xs adjacent file n y@Comment (x@(Program _) :xs) = error (message file n "comment" "program") adjacent file n y@Comment (x@(Include i f):xs) = x: adjacent f i y xs adjacent file n y@Comment (x@(Pre _) :xs) = x: adjacent file (n+1) y xs adjacent file n y@Blank (x@(Include i f):xs) = x: adjacent f i y xs adjacent file n y@Blank (x@(Pre _) :xs) = x: adjacent file (n+1) y xs adjacent file n _ (x@next :xs) = x: adjacent file (n+1) x xs adjacent file n _ [] = [] message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" message [] n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" message file n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n" -- Re-implementation of 'lines', for better efficiency (but decreased laziness). -- Also, importantly, accepts non-standard DOS and Mac line ending characters. inlines s = lines' s id where lines' [] acc = [acc []] lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS lines' ('\n':s) acc = acc [] : lines' s id -- Unix lines' (c:s) acc = lines' s (acc . (c:)) hugs98-plus-Sep2006/cpphs/README0000644006511100651110000000246310504340601014756 0ustar rossrossThis directory contains 'cpphs', a simplified re-implementation of cpp, the C pre-processor, in Haskell. TO BUILD -------- Just use hmake cpphs [-package base] or ghc --make cpphs [-o cpphs] # -o needed for ghc <= 6.4.1 ] or runhugs cpphs # or rename the script cpphs.hugs to cpphs USAGE ----- cpphs [filename | -Dsym | -Dsym=val | -Ipath]+ [-Ofile] [--nomacro|--noline|--strip|--text|--hashes|--layout|--unlit]* For fuller details, see docs/index.html If you want to use cpphs as a completely drop-in replacement for the real cpp, that is, to accept the same arguments, and have broadly the same behaviour in response to them, then edit the "cpphs.compat" script to point to the installed location of cpphs, then use this script instead of cpp, e.g. ghc -cpp -pgmP cpphs.compat COPYRIGHT --------- Copyright (c) 2004-2006 Malcolm Wallace (Malcolm.Wallace@cs.york.ac.uk) except for Text.ParserCombinators.HuttonMeijer (Copyright (c) 1995 Graham Hutton and Erik Meijer). LICENCE ------- These library modules are distributed under the terms of the LGPL. The application module 'cpphs.hs' is GPL. This software comes with no warranty. Use at your own risk. WEBSITE ------- http://haskell.org/cpphs/ http://www.cs.york.ac.uk/fp/cpphs/ darcs get http://www.cs.york.ac.uk/fp/darcs/cpphs hugs98-plus-Sep2006/cpphs/Setup.hs0000644006511100651110000000005610504340601015526 0ustar rossrossimport Distribution.Simple main = defaultMain hugs98-plus-Sep2006/cpphs/cpphs.cabal0000644006511100651110000000341410504340601016174 0ustar rossrossName: cpphs Version: 1.2 Copyright: 2004-6, Malcolm Wallace Build-Depends: base, haskell98 License: LGPL License-File: LICENCE-LGPL Author: Malcolm Wallace Maintainer: Malcolm Wallace Homepage: http://haskell.org/cpphs/ Synopsis: A liberalised re-implementation of cpp, the C pre-processor. Description: Cpphs is a re-implementation of the C pre-processor that is both more compatible with Haskell, and itself written in Haskell so that it can be distributed with compilers. . This version of the C pre-processor is pretty-much feature-complete and compatible with traditional (K&R) pre-processors. Additional features include: a plain-text mode; an option to unlit literate code files; and an option to turn off macro-expansion. Category: Development Exposed-Modules: Language.Preprocessor.Cpphs Language.Preprocessor.Unlit Other-Modules: Language.Preprocessor.Cpphs.CppIfdef, Language.Preprocessor.Cpphs.HashDefine, Language.Preprocessor.Cpphs.MacroPass, Language.Preprocessor.Cpphs.Options, Language.Preprocessor.Cpphs.Position, Language.Preprocessor.Cpphs.ReadFirst, Language.Preprocessor.Cpphs.RunCpphs, Language.Preprocessor.Cpphs.SymTab, Language.Preprocessor.Cpphs.Tokenise, Text.ParserCombinators.HuttonMeijer Executable: cpphs Main-Is: cpphs.hs Other-Modules: Language.Preprocessor.Cpphs Language.Preprocessor.Unlit Language.Preprocessor.Cpphs.CppIfdef, Language.Preprocessor.Cpphs.HashDefine, Language.Preprocessor.Cpphs.MacroPass, Language.Preprocessor.Cpphs.Options, Language.Preprocessor.Cpphs.Position, Language.Preprocessor.Cpphs.ReadFirst, Language.Preprocessor.Cpphs.RunCpphs, Language.Preprocessor.Cpphs.SymTab, Language.Preprocessor.Cpphs.Tokenise, Text.ParserCombinators.HuttonMeijer hugs98-plus-Sep2006/cpphs/cpphs.compat0000644006511100651110000000273010504340601016415 0ustar rossross#!/bin/sh # A minimal compatibility script to make cpphs accept the same # arguments as real cpp, wherever possible. CPPHS=/usr/malcolm/Haskell/cpphs/cpphs processArgs () { TRADITIONAL=no STRIP=yes INFILE="-" OUTFILE="-" while test "$1" != "" do case $1 in -D) shift; echo -D$1 ;; -D*) echo $1 ;; -U) shift; echo -U$1 ;; -U*) echo $1 ;; -I) shift; echo -I$1 ;; -I*) echo $1 ;; -o) shift; echo -O$1 ;; -o*) echo -O`echo $1 | cut -c3-` ;; -std*) ;; # ignore language spec -x) shift ;; # ignore language spec -ansi*) TRADITIONAL=no ;; -traditional*) TRADITIONAL=yes ;; -include) shift; echo $1 ;; -P) echo --noline ;; -C) STRIP=no ;; -CC) STRIP=no ;; -A) shift ;; # strip assertions --help) echo $1 ;; -version) echo -$1 ;; --version) echo $1 ;; -*) ;; # strip all other flags *) if [ "$INFILE" = "-" ] then INFILE=$1 else OUTFILE=$1 fi ;; esac if test "$1" != ""; then shift; fi done if [ "$TRADITIONAL" = "no" ]; then echo "--hashes"; fi if [ "$STRIP" = "yes" ]; then echo "--strip"; fi echo $INFILE if [ "$OUTFILE" != "-" ]; then echo "-O$OUTFILE"; fi } exec $CPPHS `processArgs "$@"` hugs98-plus-Sep2006/cpphs/cpphs.hs0000644006511100651110000001132410504340601015543 0ustar rossross{- -- The main program wrapper for cpphs, a simple C pre-processor -- written in Haskell. -- Author: Malcolm Wallace, 2004 -- This file is licensed under the GPL. Note however, that all other -- modules used by it are either distributed under the LGPL, or are Haskell'98. -- -- Thus, when compiled as a standalone executable, this program will fall -- under the GPL. -} module Main where import System ( getArgs, getProgName, exitWith, ExitCode(..) ) import Maybe import Language.Preprocessor.Cpphs ( runCpphs, CpphsOption, parseOption ) import IO ( stdout, IOMode(WriteMode), openFile, hPutStr, hFlush, hClose ) import Monad ( when ) import List ( isPrefixOf ) version :: String version = "1.2" main :: IO () main = do args <- getArgs args <- return $ if "--cpp" `elem` args then convertArgs args else args prog <- getProgName when ("--version" `elem` args) (do putStrLn (prog++" "++version) exitWith ExitSuccess) when ("--help" `elem` args) (do putStrLn ("Usage: "++prog ++" [file ...] [ -Dsym | -Dsym=val | -Ipath ]* [-Ofile]\n" ++"\t\t[--nomacro] [--noline] [--text]" ++" [--strip] [--hashes] [--layout]" ++" [--unlit] [--cpp]") exitWith ExitSuccess) let parsedArgs = parseOptions args Right (opts, ins, outs) = parsedArgs out = listToMaybe outs when (isLeft parsedArgs) (do putStrLn $ "Unknown option, for valid options try " ++prog++" --help\n"++fromLeft parsedArgs exitWith (ExitFailure 1)) when (length outs > 1) (do putStrLn $ "At most one output file (-O) can be specified" exitWith (ExitFailure 2)) if null ins then execute opts out Nothing else mapM_ (execute opts out) (map Just ins) isLeft (Left _) = True isLeft _ = False fromLeft (Left x) = x -- | Parse the list of options -- Return either Right (options, input files, output files) -- or Left invalid flag parseOptions :: [String] -> Either String ([CpphsOption], [FilePath], [FilePath]) parseOptions xs = f ([], [], []) xs where f (opts, ins, outs) (('-':'O':x):xs) = f (opts, ins, x:outs) xs f (opts, ins, outs) (x@('-':_):xs) = case parseOption x of Nothing -> Left x Just a -> f (a:opts, ins, outs) xs f (opts, ins, outs) (x:xs) = f (opts, x:ins, outs) xs f (opts, ins, outs) [] = Right (reverse opts, reverse ins, reverse outs) -- | Parse a list of options, remaining compatible with cpp if possible -- Based on a shell script cpphs.compat data ConvertArgs = ConvertArgs {traditional :: Bool, strip :: Bool, infile :: String, outfile :: String} convertArgs :: [String] -> [String] convertArgs xs = f (ConvertArgs False True "-" "-") xs where flg = "DUI" f e (['-',r]:x:xs) | r `elem` flg = ('-':r:x) : f e xs f e (x@('-':r:_):xs) | r `elem` flg = x : f e xs f e ("-o":x:xs) = ('-':'O':x) : f e xs f e (('-':'o':x):xs) = ('-':'O':drop 2 x) : f e xs f e (('-':x):xs) | "ansi" `isPrefixOf` x = f e{traditional=False} xs | "tranditional" `isPrefixOf` x = f e{traditional=True} xs | "std" `isPrefixOf` x = f e xs -- ignore language spec f e ("-x":x:xs) = f e xs -- ignore langauge spec f e ("-include":x:xs) = x : f e xs f e ("-P":xs) = "--noline" : f e xs f e (x:xs) | x == "-C" || x == "-CC" = f e{strip=False} xs f e ("-A":x:xs) = f e xs -- strip assertions f e ("--help":xs) = "--help" : f e xs f e ("--version":xs) = "--version" : f e xs f e ("-version":xs) = "--version" : f e xs f e (('-':x):xs) = f e xs -- strip all other flags f e (x:xs) = f (if infile e == "-" then e{infile=x} else e{outfile=x}) xs f e [] = ["--hashes" | not (traditional e)] ++ ["--strip" | strip e] ++ [infile e] ++ ["-O" ++ outfile e | outfile e /= "-"] -- | Execute the preprocessor, -- using the given options; an output path; and an input path. -- If the filepath is Nothing then default to stdout\/stdin as appropriate. execute :: [CpphsOption] -> Maybe FilePath -> Maybe FilePath -> IO () execute opts output input = let (filename, action) = case input of Just x -> (x, readFile x) Nothing -> ("stdin", getContents) in do contents <- action result <- runCpphs opts filename contents case output of Nothing -> do putStr result hFlush stdout Just x -> do h <- openFile x WriteMode hPutStr h result hFlush h hClose h hugs98-plus-Sep2006/cpphs/cpphs.hugs0000644006511100651110000000010410504340601016071 0ustar rossross#!/bin/sh runhugs cpphs.hs --noline -D__HASKELL98__ -D__HUGS__ "$@" hugs98-plus-Sep2006/cpphs/tests/0000755006511100651110000000000010504340601015233 5ustar rossrosshugs98-plus-Sep2006/cpphs/tests/HsOpenGLExt.h0000644006511100651110000000227110504340601017506 0ustar rossross/* ----------------------------------------------------------------------------- * * Module : GL extension support for Graphics.Rendering.OpenGL * Copyright : (c) Sven Panne 2002-2004 * License : BSD-style (see the file libraries/OpenGL/LICENSE) * * Maintainer : sven.panne@aedion.de * Stability : provisional * Portability : portable * * This header should only define preprocessor macros! * * -------------------------------------------------------------------------- */ #ifndef HSOPENGLEXT_H #define HSOPENGLEXT_H /* NOTE: The macro must immediately start with the foreign declaration, otherwise the magic mangler (hack_foreign) in the Hugs build system doesn't recognize it. */ #define EXTENSION_ENTRY(_msg,_entry,_ty) \ foreign import CALLCONV unsafe "dynamic" dyn_/**/_entry :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (_ty) ; \ _entry :: (_ty) ; \ _entry = dyn_##_entry ptr_##_entry ; \ ptr_/**/_entry :: FunPtr a ; \ ptr_/**/_entry = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress (_msg) ("_entry")) ; \ {-# NOINLINE ptr_/**/_entry #-} #endif EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoorddEXT,GLdouble -> IO ()) hugs98-plus-Sep2006/cpphs/tests/MachDeps.h0000644006511100651110000000000010504340601017056 0ustar rossrosshugs98-plus-Sep2006/cpphs/tests/Storable.hs0000644006511100651110000002033010504340601017340 0ustar rossross{-# OPTIONS -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Storable -- Copyright : (c) The FFI task force 2001 -- License : see libraries/base/LICENSE -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- The module "Foreign.Storable" provides most elementary support for -- marshalling and is part of the language-independent portion of the -- Foreign Function Interface (FFI), and will normally be imported via -- the "Foreign" module. -- ----------------------------------------------------------------------------- module Foreign.Storable ( Storable( sizeOf, -- :: a -> Int alignment, -- :: a -> Int peekElemOff, -- :: Ptr a -> Int -> IO a pokeElemOff, -- :: Ptr a -> Int -> a -> IO () peekByteOff, -- :: Ptr b -> Int -> IO a pokeByteOff, -- :: Ptr b -> Int -> a -> IO () peek, -- :: Ptr a -> IO a poke) -- :: Ptr a -> a -> IO () ) where #ifdef __NHC__ import NHC.FFI (Storable(..),Ptr,FunPtr,StablePtr ,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64) #else import Control.Monad ( liftM ) #include "MachDeps.h" #include "config.h" #ifdef __GLASGOW_HASKELL__ import GHC.Storable import GHC.Stable ( StablePtr ) import GHC.Num import GHC.Int import GHC.Word import GHC.Stable import GHC.Ptr import GHC.Float import GHC.Err import GHC.IOBase import GHC.Base #else import Data.Int import Data.Word import Foreign.Ptr import Foreign.StablePtr #endif #ifdef __HUGS__ import Hugs.Prelude import Hugs.Storable #endif {- | The member functions of this class facilitate writing values of primitive types to raw memory (which may have been allocated with the above mentioned routines) and reading values from blocks of raw memory. The class, furthermore, includes support for computing the storage requirements and alignment restrictions of storable types. Memory addresses are represented as values of type @'Ptr' a@, for some @a@ which is an instance of class 'Storable'. The type argument to 'Ptr' helps provide some valuable type safety in FFI code (you can\'t mix pointers of different types without an explicit cast), while helping the Haskell type system figure out which marshalling method is needed for a given pointer. All marshalling between Haskell and a foreign language ultimately boils down to translating Haskell data structures into the binary representation of a corresponding data structure of the foreign language and vice versa. To code this marshalling in Haskell, it is necessary to manipulate primtive data types stored in unstructured memory blocks. The class 'Storable' facilitates this manipulation on all types for which it is instantiated, which are the standard basic types of Haskell, the fixed size @Int@ types ('Int8', 'Int16', 'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16', 'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types", as well as 'Ptr'. Minimal complete definition: 'sizeOf', 'alignment', one of 'peek', 'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and 'pokeByteOff'. -} class Storable a where sizeOf :: a -> Int -- ^ Computes the storage requirements (in bytes) of the argument. -- The value of the argument is not used. alignment :: a -> Int -- ^ Computes the alignment constraint of the argument. An -- alignment constraint @x@ is fulfilled by any address divisible -- by @x@. The value of the argument is not used. peekElemOff :: Ptr a -> Int -> IO a -- ^ Read a value from a memory area regarded as an array -- of values of the same kind. The first argument specifies -- the start address of the array and the second the index into -- the array (the first element of the array has index -- @0@). The following equality holds, -- -- > peekElemOff addr idx = IOExts.fixIO $ \result -> -- > peek (addr `plusPtr` (idx * sizeOf result)) -- -- Note that this is only a specification, not -- necessarily the concrete implementation of the -- function. pokeElemOff :: Ptr a -> Int -> a -> IO () -- ^ Write a value to a memory area regarded as an array of -- values of the same kind. The following equality holds: -- -- > pokeElemOff addr idx x = -- > poke (addr `plusPtr` (idx * sizeOf x)) x peekByteOff :: Ptr b -> Int -> IO a -- ^ Read a value from a memory location given by a base -- address and offset. The following equality holds: -- -- > peekByteOff addr off = peek (addr `plusPtr` off) pokeByteOff :: Ptr b -> Int -> a -> IO () -- ^ Write a value to a memory location given by a base -- address and offset. The following equality holds: -- -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x peek :: Ptr a -> IO a -- ^ Read a value from the given memory location. -- -- Note that the peek and poke functions might require properly -- aligned addresses to function correctly. This is architecture -- dependent; thus, portable code should ensure that when peeking or -- poking values of some type @a@, the alignment -- constraint for @a@, as given by the function -- 'alignment' is fulfilled. poke :: Ptr a -> a -> IO () -- ^ Write the given value to the given memory location. Alignment -- restrictions might apply; see 'peek'. -- circular default instances #ifdef __GLASGOW_HASKELL__ peekElemOff = peekElemOff_ undefined where peekElemOff_ :: a -> Ptr a -> Int -> IO a peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef) #else peekElemOff ptr off = peekByteOff ptr (off * sizeOfPtr ptr undefined) #endif pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val peekByteOff ptr off = peek (ptr `plusPtr` off) pokeByteOff ptr off = poke (ptr `plusPtr` off) peek ptr = peekElemOff ptr 0 poke ptr = pokeElemOff ptr 0 #ifndef __GLASGOW_HASKELL__ sizeOfPtr :: Storable a => Ptr a -> a -> Int sizeOfPtr px x = sizeOf x #endif -- System-dependent, but rather obvious instances instance Storable Bool where sizeOf _ = sizeOf (undefined::HTYPE_INT) alignment _ = alignment (undefined::HTYPE_INT) peekElemOff p i = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT) #define STORABLE(T,size,align,read,write) \ instance Storable (T) where { \ sizeOf _ = size; \ alignment _ = align; \ peekElemOff = read; \ pokeElemOff = write } #ifdef __GLASGOW_HASKELL__ STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32, readWideCharOffPtr,writeWideCharOffPtr) #elif defined(__HUGS__) STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR, readCharOffPtr,writeCharOffPtr) #endif STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT, readIntOffPtr,writeIntOffPtr) #ifdef __GLASGOW_HASKELL__ STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD, readWordOffPtr,writeWordOffPtr) #endif STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR, readPtrOffPtr,writePtrOffPtr) STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR, readFunPtrOffPtr,writeFunPtrOffPtr) STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR, readStablePtrOffPtr,writeStablePtrOffPtr) STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT, readFloatOffPtr,writeFloatOffPtr) STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE, readDoubleOffPtr,writeDoubleOffPtr) STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8, readWord8OffPtr,writeWord8OffPtr) STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16, readWord16OffPtr,writeWord16OffPtr) STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32, readWord32OffPtr,writeWord32OffPtr) STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64, readWord64OffPtr,writeWord64OffPtr) STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8, readInt8OffPtr,writeInt8OffPtr) STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16, readInt16OffPtr,writeInt16OffPtr) STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32, readInt32OffPtr,writeInt32OffPtr) STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64, readInt64OffPtr,writeInt64OffPtr) #endif hugs98-plus-Sep2006/cpphs/tests/Test.hsc0000644006511100651110000000031710504340601016652 0ustar rossrossmodule Test where main :: IO () main = putStrLn "shows a cpphs+hsc2hs bug with comments" #def inline int that_one_will_work(void) {return 42;} {- #def inline int cpphs_will_stumble(void) {return 42;} -} hugs98-plus-Sep2006/cpphs/tests/chains0000644006511100651110000000075410504340601016431 0ustar rossrossFor this test, assume that all of e,f,g,h are defined. Also that c,d are defined, a,b are not. If cpphs does operator precedence wrongly in infix chains, the final conditional will be interpreted wrongly. #if defined(a) || defined(b) || defined(c) || defined(d) chained || OK #endif #if defined(e) && defined(f) && defined(g) && defined(h) chained && OK #endif #if defined(a) && defined(b) || defined(c) && defined(d) mixed chain of || and && OK #else mixed chain of || and && BROKEN #endif hugs98-plus-Sep2006/cpphs/tests/config.h0000644006511100651110000000000010504340601016637 0ustar rossrosshugs98-plus-Sep2006/cpphs/tests/cpp0000644006511100651110000000035710504340601015745 0ustar rossross#define /**/ ++ `mplus` // not expected to work #define 0 mzero // not expected to work #define x0 X' // should work #define x' Xprime // should work #define `foo` .(foo)/**/, // bizarreness x ++ y = x0 * 0 * y `foo` x' // /* hugs98-plus-Sep2006/cpphs/tests/expect10000644006511100651110000000025110504340601016525 0ustar rossross#line 1 "testfile" 1 top of file 3 5 X is defined 7 11 15 19 23 no inclusion, this is an else clause 25 31 third branch of elif 33 34 end of file hugs98-plus-Sep2006/cpphs/tests/expect100000644006511100651110000000027510504340601016613 0ustar rossross#line 1 "multiline" 5 back to ordinary text. #line 1 "./inclusion" hello world, this is an inclusion #line 6 "multiline" 7 hello again 8 some more 9 aLongMacroDefinition(a,b) 10 end hugs98-plus-Sep2006/cpphs/tests/expect110000644006511100651110000000006310504340601016607 0ustar rossross#line 1 "stringise" This is "abcd ef" foo abcd ef hugs98-plus-Sep2006/cpphs/tests/expect120000644006511100651110000000004710504340601016612 0ustar rossross#line 1 "recursive" D D D D D D D D hugs98-plus-Sep2006/cpphs/tests/expect130000644006511100651110000000040510504340601016611 0ustar rossross#line 1 "ross" f = 4 g = do { putStr "Hello "; putStrLn "World" } h = 4 hugs98-plus-Sep2006/cpphs/tests/expect140000644006511100651110000000003010504340601016604 0ustar rossross#line 1 "precedence" hugs98-plus-Sep2006/cpphs/tests/expect150000644006511100651110000000014110504340601016610 0ustar rossross#line 1 "indirect" #line 1 "./inclusion" hello world, this is an inclusion #line 2 "indirect" hugs98-plus-Sep2006/cpphs/tests/expect160000644006511100651110000000024010504340601016611 0ustar rossross#line 1 "numbers" number (1) in if number (0) in if rejected false hex number in if real hex number (0x1) in if hex number (0x00) in if hugs98-plus-Sep2006/cpphs/tests/expect170000644006511100651110000000002210504340601016610 0ustar rossross#line 1 "pragma" hugs98-plus-Sep2006/cpphs/tests/expect180000644006511100651110000000000110504340601016606 0ustar rossross hugs98-plus-Sep2006/cpphs/tests/expect190000644006511100651110000000003010504340601016611 0ustar rossross#line 1 "parens" yes hugs98-plus-Sep2006/cpphs/tests/expect20000644006511100651110000000023410504340601016527 0ustar rossross#line 1 "testfile" 1 top of file 3 5 X is defined 7 11 15 19 23 no inclusion, this is an else clause 25 27 no elif 33 34 end of file hugs98-plus-Sep2006/cpphs/tests/expect200000644006511100651110000000043710504340601016614 0ustar rossross#line 1 "chains" For this test, assume that all of 1,1,1,1 are defined. Also that 1,1 are defined, a,b are not. If cpphs does operator precedence wrongly in infix chains, the final conditional will be interpreted wrongly. chained || OK chained && OK mixed chain of || and && OK hugs98-plus-Sep2006/cpphs/tests/expect210000644006511100651110000000013710504340601016612 0ustar rossross#line 1 "specials" line 2 line 3 line 4 Error "horrible" at line 4 of file "specials" line 5 hugs98-plus-Sep2006/cpphs/tests/expect220000644006511100651110000000023710504340601016614 0ustar rossross#line 1 "specialinclude" 1 2 #line 1 "./specials" line 2 line 3 line 4 Error "horrible" at line 4 of file "./specials" line 5 #line 3 "specialinclude" 4 5 hugs98-plus-Sep2006/cpphs/tests/expect230000644006511100651110000000003710504340601016613 0ustar rossross#line 1 "incomplete" incompletehugs98-plus-Sep2006/cpphs/tests/expect240000644006511100651110000000113110504340601016610 0ustar rossross#line 1 "text" Here is some ordinary text with embedded Haskell-ish constructs, that should however /not/ be interpreted as Haskell if the --text option is given to cpphs. For instance, here is a Haskell comment including a cpp definition: {- # define FOO bar and now we end the comment: -} and try out the definition: FOO Likewise, double and single quotes no longer delimit strings or chars: " # define BAZ FOO and what do we have here?: " ' BAZ ' Also, in text-mode, macros should be expanded inside Haskell comments: -- expand(this,other,that) and strings "expand(this,other,that)". hugs98-plus-Sep2006/cpphs/tests/expect250000644006511100651110000000114510504340601016616 0ustar rossross#line 1 "text" Here is some ordinary text with embedded Haskell-ish constructs, that should however /not/ be interpreted as Haskell if the --text option is given to cpphs. For instance, here is a Haskell comment including a cpp definition: {- and now we end the comment: -} and try out the definition: bar Likewise, double and single quotes no longer delimit strings or chars: " and what do we have here?: " ' bar ' Also, in text-mode, macros should be expanded inside Haskell comments: -- Some text including this, the other, and that. and strings "Some text including this, the other, and that.". hugs98-plus-Sep2006/cpphs/tests/expect260000644006511100651110000000032110504340601016612 0ustar rossross#line 1 "nastyhack" -- hackery to convice cpp to splice 6.2.2 into a string version :: String version = tail "\ \ 6.2.2" version2 = "6.2.2" version3 = "6.2.2" version4 = #6.2.2 version5 = "6.2.2" hugs98-plus-Sep2006/cpphs/tests/expect270000644006511100651110000000040310504340601016614 0ustar rossross#line 1 "nastyhack" -- hackery to convice cpp to splice GHC_PKG_VERSION into a string version :: String version = tail "\ \ GHC_PKG_VERSION" version2 = "GHC_PKG_VERSION" version3 = "GHC_PKG_VERSION" version4 = #6.2.2 version5 = "GHC_PKG_VERSION" hugs98-plus-Sep2006/cpphs/tests/expect280000644006511100651110000000006310504340601016617 0ustar rossross#line 1 "symbolvalue" the symbol is defined as 1 hugs98-plus-Sep2006/cpphs/tests/expect290000644006511100651110000000025510504340601016623 0ustar rossross#line 1 "Test.hsc" module Test where main :: IO () main = putStrLn "shows a cpphs+hsc2hs bug with comments" {- #def inline int cpphs_will_stumble(void) {return 42;} -} hugs98-plus-Sep2006/cpphs/tests/expect30000644006511100651110000000024410504340601016531 0ustar rossross#line 1 "testfile" 1 top of file 3 5 X is defined 7 11 15 19 23 no inclusion, this is an else clause 25 29 this is an elif 33 34 end of file hugs98-plus-Sep2006/cpphs/tests/expect40000644006511100651110000000031710504340601016533 0ustar rossross#line 1 "testfile" 1 top of file 3 5 X is defined 7 11 15 19 #line 1 "./inclusion" hello world, this is an inclusion #line 21 "testfile" 25 31 third branch of elif 33 34 end of file hugs98-plus-Sep2006/cpphs/tests/expect50000644006511100651110000000022110504340601016526 0ustar rossross1 top of file 3 5 0 is defined 7 11 15 19 hello world, this is an inclusion 25 31 third branch of elif 33 34 end of file hugs98-plus-Sep2006/cpphs/tests/expect60000644006511100651110000000010010504340601016523 0ustar rossross#line 1 "cpp" x ++ y = X' * 0 * y .(foo), Xprime // /* hugs98-plus-Sep2006/cpphs/tests/expect70000644006511100651110000002213110504340601016534 0ustar rossross#line 1 "Storable.hs" {-# OPTIONS -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.Storable -- Copyright : (c) The FFI task force 2001 -- License : see libraries/base/LICENSE -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- -- The module "Foreign.Storable" provides most elementary support for -- marshalling and is part of the language-independent portion of the -- Foreign Function Interface (FFI), and will normally be imported via -- the "Foreign" module. -- ----------------------------------------------------------------------------- module Foreign.Storable ( Storable( sizeOf, -- :: a -> Int alignment, -- :: a -> Int peekElemOff, -- :: Ptr a -> Int -> IO a pokeElemOff, -- :: Ptr a -> Int -> a -> IO () peekByteOff, -- :: Ptr b -> Int -> IO a pokeByteOff, -- :: Ptr b -> Int -> a -> IO () peek, -- :: Ptr a -> IO a poke) -- :: Ptr a -> a -> IO () ) where import Control.Monad ( liftM ) #line 1 "./MachDeps.h" #line 39 "Storable.hs" #line 1 "./config.h" #line 40 "Storable.hs" import GHC.Storable import GHC.Stable ( StablePtr ) import GHC.Num import GHC.Int import GHC.Word import GHC.Stable import GHC.Ptr import GHC.Float import GHC.Err import GHC.IOBase import GHC.Base {- | The member functions of this class facilitate writing values of primitive types to raw memory (which may have been allocated with the above mentioned routines) and reading values from blocks of raw memory. The class, furthermore, includes support for computing the storage requirements and alignment restrictions of storable types. Memory addresses are represented as values of type @'Ptr' a@, for some @a@ which is an instance of class 'Storable'. The type argument to 'Ptr' helps provide some valuable type safety in FFI code (you can\'t mix pointers of different types without an explicit cast), while helping the Haskell type system figure out which marshalling method is needed for a given pointer. All marshalling between Haskell and a foreign language ultimately boils down to translating Haskell data structures into the binary representation of a corresponding data structure of the foreign language and vice versa. To code this marshalling in Haskell, it is necessary to manipulate primtive data types stored in unstructured memory blocks. The class 'Storable' facilitates this manipulation on all types for which it is instantiated, which are the standard basic types of Haskell, the fixed size @Int@ types ('Int8', 'Int16', 'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16', 'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types", as well as 'Ptr'. Minimal complete definition: 'sizeOf', 'alignment', one of 'peek', 'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and 'pokeByteOff'. -} class Storable a where sizeOf :: a -> Int -- ^ Computes the storage requirements (in bytes) of the argument. -- The value of the argument is not used. alignment :: a -> Int -- ^ Computes the alignment constraint of the argument. An -- alignment constraint @x@ is fulfilled by any address divisible -- by @x@. The value of the argument is not used. peekElemOff :: Ptr a -> Int -> IO a -- ^ Read a value from a memory area regarded as an array -- of values of the same kind. The first argument specifies -- the start address of the array and the second the index into -- the array (the first element of the array has index -- @0@). The following equality holds, -- -- > peekElemOff addr idx = IOExts.fixIO $ \result -> -- > peek (addr `plusPtr` (idx * sizeOf result)) -- -- Note that this is only a specification, not -- necessarily the concrete implementation of the -- function. pokeElemOff :: Ptr a -> Int -> a -> IO () -- ^ Write a value to a memory area regarded as an array of -- values of the same kind. The following equality holds: -- -- > pokeElemOff addr idx x = -- > poke (addr `plusPtr` (idx * sizeOf x)) x peekByteOff :: Ptr b -> Int -> IO a -- ^ Read a value from a memory location given by a base -- address and offset. The following equality holds: -- -- > peekByteOff addr off = peek (addr `plusPtr` off) pokeByteOff :: Ptr b -> Int -> a -> IO () -- ^ Write a value to a memory location given by a base -- address and offset. The following equality holds: -- -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x peek :: Ptr a -> IO a -- ^ Read a value from the given memory location. -- -- Note that the peek and poke functions might require properly -- aligned addresses to function correctly. This is architecture -- dependent; thus, portable code should ensure that when peeking or -- poking values of some type @a@, the alignment -- constraint for @a@, as given by the function -- 'alignment' is fulfilled. poke :: Ptr a -> a -> IO () -- ^ Write the given value to the given memory location. Alignment -- restrictions might apply; see 'peek'. -- circular default instances peekElemOff = peekElemOff_ undefined where peekElemOff_ :: a -> Ptr a -> Int -> IO a peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef) pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val peekByteOff ptr off = peek (ptr `plusPtr` off) pokeByteOff ptr off = poke (ptr `plusPtr` off) peek ptr = peekElemOff ptr 0 poke ptr = pokeElemOff ptr 0 -- System-dependent, but rather obvious instances instance Storable Bool where sizeOf _ = sizeOf (undefined::HTYPE_INT) alignment _ = alignment (undefined::HTYPE_INT) peekElemOff p i = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT) instance Storable (Char) where { sizeOf _ = SIZEOF_INT32; alignment _ = ALIGNMENT_INT32; peekElemOff = readWideCharOffPtr; pokeElemOff = writeWideCharOffPtr } instance Storable (Int) where { sizeOf _ = SIZEOF_HSINT; alignment _ = ALIGNMENT_HSINT; peekElemOff = readIntOffPtr; pokeElemOff = writeIntOffPtr } instance Storable (Word) where { sizeOf _ = SIZEOF_HSWORD; alignment _ = ALIGNMENT_HSWORD; peekElemOff = readWordOffPtr; pokeElemOff = writeWordOffPtr } instance Storable ((Ptr a)) where { sizeOf _ = SIZEOF_HSPTR; alignment _ = ALIGNMENT_HSPTR; peekElemOff = readPtrOffPtr; pokeElemOff = writePtrOffPtr } instance Storable ((FunPtr a)) where { sizeOf _ = SIZEOF_HSFUNPTR; alignment _ = ALIGNMENT_HSFUNPTR; peekElemOff = readFunPtrOffPtr; pokeElemOff = writeFunPtrOffPtr } instance Storable ((StablePtr a)) where { sizeOf _ = SIZEOF_HSSTABLEPTR; alignment _ = ALIGNMENT_HSSTABLEPTR; peekElemOff = readStablePtrOffPtr; pokeElemOff = writeStablePtrOffPtr } instance Storable (Float) where { sizeOf _ = SIZEOF_HSFLOAT; alignment _ = ALIGNMENT_HSFLOAT; peekElemOff = readFloatOffPtr; pokeElemOff = writeFloatOffPtr } instance Storable (Double) where { sizeOf _ = SIZEOF_HSDOUBLE; alignment _ = ALIGNMENT_HSDOUBLE; peekElemOff = readDoubleOffPtr; pokeElemOff = writeDoubleOffPtr } instance Storable (Word8) where { sizeOf _ = SIZEOF_WORD8; alignment _ = ALIGNMENT_WORD8; peekElemOff = readWord8OffPtr; pokeElemOff = writeWord8OffPtr } instance Storable (Word16) where { sizeOf _ = SIZEOF_WORD16; alignment _ = ALIGNMENT_WORD16; peekElemOff = readWord16OffPtr; pokeElemOff = writeWord16OffPtr } instance Storable (Word32) where { sizeOf _ = SIZEOF_WORD32; alignment _ = ALIGNMENT_WORD32; peekElemOff = readWord32OffPtr; pokeElemOff = writeWord32OffPtr } instance Storable (Word64) where { sizeOf _ = SIZEOF_WORD64; alignment _ = ALIGNMENT_WORD64; peekElemOff = readWord64OffPtr; pokeElemOff = writeWord64OffPtr } instance Storable (Int8) where { sizeOf _ = SIZEOF_INT8; alignment _ = ALIGNMENT_INT8; peekElemOff = readInt8OffPtr; pokeElemOff = writeInt8OffPtr } instance Storable (Int16) where { sizeOf _ = SIZEOF_INT16; alignment _ = ALIGNMENT_INT16; peekElemOff = readInt16OffPtr; pokeElemOff = writeInt16OffPtr } instance Storable (Int32) where { sizeOf _ = SIZEOF_INT32; alignment _ = ALIGNMENT_INT32; peekElemOff = readInt32OffPtr; pokeElemOff = writeInt32OffPtr } instance Storable (Int64) where { sizeOf _ = SIZEOF_INT64; alignment _ = ALIGNMENT_INT64; peekElemOff = readInt64OffPtr; pokeElemOff = writeInt64OffPtr } hugs98-plus-Sep2006/cpphs/tests/expect80000644006511100651110000000221610504340601016537 0ustar rossross#line 1 "HsOpenGLExt.h" /* ----------------------------------------------------------------------------- * * Module : GL extension support for Graphics.Rendering.OpenGL * Copyright : (c) Sven Panne 2002-2004 * License : BSD-style (see the file libraries/OpenGL/LICENSE) * * Maintainer : sven.panne@aedion.de * Stability : provisional * Portability : portable * * This header should only define preprocessor macros! * * -------------------------------------------------------------------------- */ /* NOTE: The macro must immediately start with the foreign declaration, otherwise the magic mangler (hack_foreign) in the Hugs build system doesn't recognize it. */ foreign import ccall unsafe "dynamic" dyn_glFogCoorddEXT :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (GLdouble -> IO ()) ; glFogCoorddEXT :: (GLdouble -> IO ()) ; glFogCoorddEXT = dyn_glFogCoorddEXT ptr_glFogCoorddEXT ; ptr_glFogCoorddEXT :: FunPtr a ; ptr_glFogCoorddEXT = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress ("GL_EXT_fog_coord or OpenGL 1.4") ("glFogCoorddEXT")) ; {-# NOINLINE ptr_glFogCoorddEXT #-} hugs98-plus-Sep2006/cpphs/tests/expect90000644006511100651110000000032010504340601016532 0ustar rossross#line 1 "multiline" 5 back to ordinary text. #line 1 "./inclusion" hello world, this is an inclusion #line 6 "multiline" 7 hello again 8 some more 9 some line here; and some more; finish now 10 end hugs98-plus-Sep2006/cpphs/tests/inclusion0000644006511100651110000000004210504340601017155 0ustar rossrosshello world, this is an inclusion hugs98-plus-Sep2006/cpphs/tests/incomplete0000644006511100651110000000001210504340601017306 0ustar rossrossincompletehugs98-plus-Sep2006/cpphs/tests/indirect0000644006511100651110000000004110504340601016752 0ustar rossross#define F "inclusion" #include F hugs98-plus-Sep2006/cpphs/tests/multiline0000644006511100651110000000030010504340601017151 0ustar rossross#define aLongMacroDefinition(x,y) \ some line here; \ and some more; \ finish now 5 back to ordinary text. #include "inclusion" 7 hello again 8 some more 9 aLongMacroDefinition(a,b) 10 end hugs98-plus-Sep2006/cpphs/tests/nastyhack0000644006511100651110000000054710504340601017151 0ustar rossross#define GHC_PKG_VERSION 6.2.2 -- hackery to convice cpp to splice GHC_PKG_VERSION into a string version :: String version = tail "\ \ GHC_PKG_VERSION" version2 = "GHC_PKG_VERSION" #define v3 "GHC_PKG_VERSION" version3 = v3 #define stringify(s) #s version4 = stringify(GHC_PKG_VERSION) #define stringify2(s) "s" version5 = stringify2(GHC_PKG_VERSION) hugs98-plus-Sep2006/cpphs/tests/numbers0000644006511100651110000000060610504340601016633 0ustar rossross#if 1 number (1) in if #else rejected number (1) in if #endif #if 0 wrongly accepted number (0) in if #else number (0) in if #endif #if eaf false hex number in if #else rejected false hex number in if #endif #if 0x1 real hex number (0x1) in if #else rejected real hex number (0x1) in if #endif #if 0x00 wrongly accepted real hex number (0x00) in if #else hex number (0x00) in if #endif hugs98-plus-Sep2006/cpphs/tests/parens0000644006511100651110000000024010504340601016442 0ustar rossross#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 600 ) \ || ( defined(__NHC__) && __NHC__ >= 117 ) #define FINALIZERPTR yes #endif FINALIZERPTR hugs98-plus-Sep2006/cpphs/tests/pragma0000644006511100651110000000011310504340601016420 0ustar rossross#pragma ident "@(#)time.h 1.39 99/08/10 SMI" /* SVr4.0 1.18 */ hugs98-plus-Sep2006/cpphs/tests/precedence0000644006511100651110000000007010504340601017250 0ustar rossross#if !0 && 0 boolean operator precedence is wrong #endif hugs98-plus-Sep2006/cpphs/tests/recursive0000644006511100651110000000005410504340601017164 0ustar rossross#define C D D #define B C C #define A B B A hugs98-plus-Sep2006/cpphs/tests/ross0000644006511100651110000000051610504340601016146 0ustar rossross/* 1. C comments should be deleted by the preprocessor */ /* 2. repeated expansion */ #define FOO 4 #define BAR FOO f = BAR /* 3. continuation lines in macros shouldn't give newlines */ #define LONG_MACRO \ { putStr "Hello "; \ putStrLn "World" } g = do LONG_MACRO /* 4. projection macros */ #define MACRO(x) x h = MACRO(FOO) hugs98-plus-Sep2006/cpphs/tests/runtests0000644006511100651110000000317710504340601017055 0ustar rossross#!/bin/sh CPPHS=${1:-"../cpphs"} FAIL=0 runtest() { if $1 >out 2>/dev/null && diff $2 out >/dev/null then echo "passed: " $1 else FAIL=$? echo "FAILED: ($2) " $1 fi } if $CPPHS Ix a where -- | The list of values in the subrange defined by a bounding pair. range :: (a,a) -> [a] -- | The position of a subscript in the subrange. index :: (a,a) -> a -> Int -- | Like 'index', but without checking that the value is in range. unsafeIndex :: (a,a) -> a -> Int -- | Returns 'True' the given subscript lies in the range defined -- the bounding pair. inRange :: (a,a) -> a -> Bool -- | The size of the subrange defined by a bounding pair. rangeSize :: (a,a) -> Int -- | like 'rangeSize', but without checking that the upper bound is -- in range. unsafeRangeSize :: (a,a) -> Int -- Must specify one of index, unsafeIndex index b i | inRange b i = unsafeIndex b i | otherwise = error "Error in array index" unsafeIndex b i = index b i rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1 | otherwise = 0 -- This case is only here to -- check for an empty range -- NB: replacing (inRange b h) by (l <= h) fails for -- tuples. E.g. (1,2) <= (2,1) but the range is empty unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1 \end{code} Note that the following is NOT right rangeSize (l,h) | l <= h = index b h + 1 | otherwise = 0 Because it might be the case that l (a,a) -> a -> String -> b indexError rng i tp = error (showString "Ix{" . showString tp . showString "}.index: Index " . showParen True (showsPrec 0 i) . showString " out of range " $ showParen True (showsPrec 0 rng) "") ---------------------------------------------------------------------- instance Ix Char where {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = fromEnum i - fromEnum m index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Char" inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- instance Ix Int where {-# INLINE range #-} -- The INLINE stops the build in the RHS from getting inlined, -- so that callers can fuse with the result of range range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = i - m index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Int" {-# INLINE inRange #-} inRange (I# m,I# n) (I# i) = m <=# i && i <=# n ---------------------------------------------------------------------- instance Ix Integer where {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = fromInteger (i - m) index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Integer" inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- instance Ix Bool where -- as derived {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (l,_) i = fromEnum i - fromEnum l index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Bool" inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- instance Ix Ordering where -- as derived {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (l,_) i = fromEnum i - fromEnum l index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Ordering" inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- instance Ix () where {-# INLINE range #-} range ((), ()) = [()] {-# INLINE unsafeIndex #-} unsafeIndex ((), ()) () = 0 {-# INLINE inRange #-} inRange ((), ()) () = True {-# INLINE index #-} index b i = unsafeIndex b i ---------------------------------------------------------------------- instance (Ix a, Ix b) => Ix (a, b) where -- as derived {-# SPECIALISE instance Ix (Int,Int) #-} {- INLINE range #-} range ((l1,l2),(u1,u2)) = [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ] {- INLINE unsafeIndex #-} unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) = unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2 {- INLINE inRange #-} inRange ((l1,l2),(u1,u2)) (i1,i2) = inRange (l1,u1) i1 && inRange (l2,u2) i2 -- Default method for index ---------------------------------------------------------------------- instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where {-# SPECIALISE instance Ix (Int,Int,Int) #-} range ((l1,l2,l3),(u1,u2,u3)) = [(i1,i2,i3) | i1 <- range (l1,u1), i2 <- range (l2,u2), i3 <- range (l3,u3)] unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) = unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( unsafeIndex (l1,u1) i1)) inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) = inRange (l1,u1) i1 && inRange (l2,u2) i2 && inRange (l3,u3) i3 -- Default method for index ---------------------------------------------------------------------- instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where range ((l1,l2,l3,l4),(u1,u2,u3,u4)) = [(i1,i2,i3,i4) | i1 <- range (l1,u1), i2 <- range (l2,u2), i3 <- range (l3,u3), i4 <- range (l4,u4)] unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) = unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( unsafeIndex (l1,u1) i1))) inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) = inRange (l1,u1) i1 && inRange (l2,u2) i2 && inRange (l3,u3) i3 && inRange (l4,u4) i4 -- Default method for index instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) = [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1), i2 <- range (l2,u2), i3 <- range (l3,u3), i4 <- range (l4,u4), i5 <- range (l5,u5)] unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) = unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( unsafeIndex (l1,u1) i1)))) inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) = inRange (l1,u1) i1 && inRange (l2,u2) i2 && inRange (l3,u3) i3 && inRange (l4,u4) i4 && inRange (l5,u5) i5 -- Default method for index \end{code} %********************************************************* %* * \subsection{The @Array@ types} %* * %********************************************************* \begin{code} type IPr = (Int, Int) -- | The type of immutable non-strict (boxed) arrays -- with indices in @i@ and elements in @e@. data Ix i => Array i e = Array !i !i (Array# e) -- | Mutable, boxed, non-strict arrays in the 'ST' monad. The type -- arguments are as follows: -- -- * @s@: the state variable argument for the 'ST' type -- -- * @i@: the index type of the array (should be an instance of 'Ix') -- -- * @e@: the element type of the array. -- data STArray s i e = STArray !i !i (MutableArray# s e) -- No Ix context for STArray. They are stupid, -- and force an Ix context on the equality instance. -- Just pointer equality on mutable arrays: instance Eq (STArray s i e) where STArray _ _ arr1# == STArray _ _ arr2# = sameMutableArray# arr1# arr2# \end{code} %********************************************************* %* * \subsection{Operations on immutable arrays} %* * %********************************************************* \begin{code} {-# NOINLINE arrEleBottom #-} arrEleBottom :: a arrEleBottom = error "(Array.!): undefined array element" -- | Construct an array with the specified bounds and containing values -- for given indices within these bounds. -- -- The array is undefined (i.e. bottom) if any index in the list is -- out of bounds. The Haskell 98 Report further specifies that if any -- two associations in the list have the same index, the value at that -- index is undefined (i.e. bottom). However in GHC's implementation, -- the value at such an index is the value part of the last association -- with that index in the list. -- -- Because the indices must be checked for these errors, 'array' is -- strict in the bounds argument and in the indices of the association -- list, but nonstrict in the values. Thus, recurrences such as the -- following are possible: -- -- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]]) -- -- Not every index within the bounds of the array need appear in the -- association list, but the values associated with indices that do not -- appear will be undefined (i.e. bottom). -- -- If, in any dimension, the lower bound is greater than the upper bound, -- then the array is legal, but empty. Indexing an empty array always -- gives an array-bounds error, but 'bounds' still yields the bounds -- with which the array was constructed. {-# INLINE array #-} array :: Ix i => (i,i) -- ^ a pair of /bounds/, each of the index type -- of the array. These bounds are the lowest and -- highest indices in the array, in that order. -- For example, a one-origin vector of length -- '10' has bounds '(1,10)', and a one-origin '10' -- by '10' matrix has bounds '((1,1),(10,10))'. -> [(i, e)] -- ^ a list of /associations/ of the form -- (/index/, /value/). Typically, this list will -- be expressed as a comprehension. An -- association '(i, x)' defines the value of -- the array at index 'i' to be 'x'. -> Array i e array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeArray #-} unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e unsafeArray (l,u) ies = runST (ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) -> foldr (fill marr#) (done l u marr#) ies s2# }}) {-# INLINE fill #-} fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a fill marr# (I# i#, e) next s1# = case writeArray# marr# i# e s1# of { s2# -> next s2# } {-# INLINE done #-} done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e) done l u marr# s1# = case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) -> (# s2#, Array l u arr# #) } -- This is inefficient and I'm not sure why: -- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es) -- The code below is better. It still doesn't enable foldr/build -- transformation on the list of elements; I guess it's impossible -- using mechanisms currently available. -- | Construct an array from a pair of bounds and a list of values in -- index order. {-# INLINE listArray #-} listArray :: Ix i => (i,i) -> [e] -> Array i e listArray (l,u) es = runST (ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) -> let fillFromList i# xs s3# | i# ==# n# = s3# | otherwise = case xs of [] -> s3# y:ys -> case writeArray# marr# i# y s3# of { s4# -> fillFromList (i# +# 1#) ys s4# } in case fillFromList 0# es s2# of { s3# -> done l u marr# s3# }}}) -- | The value at the given index in an array. {-# INLINE (!) #-} (!) :: Ix i => Array i e -> i -> e arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i) {-# INLINE unsafeAt #-} unsafeAt :: Ix i => Array i e -> Int -> e unsafeAt (Array _ _ arr#) (I# i#) = case indexArray# arr# i# of (# e #) -> e -- | The bounds with which an array was constructed. {-# INLINE bounds #-} bounds :: Ix i => Array i e -> (i,i) bounds (Array l u _) = (l,u) -- | The list of indices of an array in ascending order. {-# INLINE indices #-} indices :: Ix i => Array i e -> [i] indices (Array l u _) = range (l,u) -- | The list of elements of an array in index order. {-# INLINE elems #-} elems :: Ix i => Array i e -> [e] elems arr@(Array l u _) = [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]] -- | The list of associations of an array in index order. {-# INLINE assocs #-} assocs :: Ix i => Array i e -> [(i, e)] assocs arr@(Array l u _) = [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)] -- | The 'accumArray' deals with repeated indices in the association -- list using an /accumulating function/ which combines the values of -- associations with the same index. -- For example, given a list of values of some index type, @hist@ -- produces a histogram of the number of occurrences of each index within -- a specified range: -- -- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b -- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i] -- -- If the accumulating function is strict, then 'accumArray' is strict in -- the values, as well as the indices, in the association list. Thus, -- unlike ordinary arrays built with 'array', accumulated arrays should -- not in general be recursive. {-# INLINE accumArray #-} accumArray :: Ix i => (e -> a -> e) -- ^ accumulating function -> e -- ^ initial value -> (i,i) -- ^ bounds of the array -> [(i, a)] -- ^ association list -> Array i e accumArray f init (l,u) ies = unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeAccumArray #-} unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# init s1# of { (# s2#, marr# #) -> foldr (adjust f marr#) (done l u marr#) ies s2# }}) {-# INLINE adjust #-} adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b adjust f marr# (I# i#, new) next s1# = case readArray# marr# i# s1# of { (# s2#, old #) -> case writeArray# marr# i# (f old new) s2# of { s3# -> next s3# }} -- | Constructs an array identical to the first argument except that it has -- been updated by the associations in the right argument. -- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then -- -- > m//[((i,i), 0) | i <- [1..n]] -- -- is the same matrix, except with the diagonal zeroed. -- -- Repeated indices in the association list are handled as for 'array': -- Haskell 98 specifies that the resulting array is undefined (i.e. bottom), -- but GHC's implementation uses the last association for each index. {-# INLINE (//) #-} (//) :: Ix i => Array i e -> [(i, e)] -> Array i e arr@(Array l u _) // ies = unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeReplace #-} unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e unsafeReplace arr@(Array l u _) ies = runST (do STArray _ _ marr# <- thawSTArray arr ST (foldr (fill marr#) (done l u marr#) ies)) -- | @'accum' f@ takes an array and an association list and accumulates -- pairs from the list into the array with the accumulating function @f@. -- Thus 'accumArray' can be defined using 'accum': -- -- > accumArray f z b = accum f (array b [(i, z) | i <- range b]) -- {-# INLINE accum #-} accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e accum f arr@(Array l u _) ies = unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeAccum #-} unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e unsafeAccum f arr@(Array l u _) ies = runST (do STArray _ _ marr# <- thawSTArray arr ST (foldr (adjust f marr#) (done l u marr#) ies)) {-# INLINE amap #-} amap :: Ix i => (a -> b) -> Array i a -> Array i b amap f arr@(Array l u _) = unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]] -- | 'ixmap' allows for transformations on array indices. -- It may be thought of as providing function composition on the right -- with the mapping that the original array embodies. -- -- A similar transformation of array values may be achieved using 'fmap' -- from the 'Array' instance of the 'Functor' class. {-# INLINE ixmap #-} ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e ixmap (l,u) f arr = unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)] {-# INLINE eqArray #-} eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) = if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else l1 == l2 && u1 == u2 && and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]] {-# INLINE cmpArray #-} cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2) {-# INLINE cmpIntArray #-} cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) = if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else if rangeSize (l2,u2) == 0 then GT else case compare l1 l2 of EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1] other -> other where cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of EQ -> rest other -> other {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-} \end{code} %********************************************************* %* * \subsection{Array instances} %* * %********************************************************* \begin{code} instance Ix i => Functor (Array i) where fmap = amap instance (Ix i, Eq e) => Eq (Array i e) where (==) = eqArray instance (Ix i, Ord e) => Ord (Array i e) where compare = cmpArray instance (Ix a, Show a, Show b) => Show (Array a b) where showsPrec p a = showParen (p > appPrec) $ showString "array " . showsPrec appPrec1 (bounds a) . showChar ' ' . showsPrec appPrec1 (assocs a) -- Precedence of 'array' is the precedence of application -- The Read instance is in GHC.Read \end{code} %********************************************************* %* * \subsection{Operations on mutable arrays} %* * %********************************************************* Idle ADR question: What's the tradeoff here between flattening these datatypes into @STArray ix ix (MutableArray# s elt)@ and using it as is? As I see it, the former uses slightly less heap and provides faster access to the individual parts of the bounds while the code used has the benefit of providing a ready-made @(lo, hi)@ pair as required by many array-related functions. Which wins? Is the difference significant (probably not). Idle AJG answer: When I looked at the outputted code (though it was 2 years ago) it seems like you often needed the tuple, and we build it frequently. Now we've got the overloading specialiser things might be different, though. \begin{code} {-# INLINE newSTArray #-} newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e) newSTArray (l,u) init = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# init s1# of { (# s2#, marr# #) -> (# s2#, STArray l u marr# #) }} {-# INLINE boundsSTArray #-} boundsSTArray :: STArray s i e -> (i,i) boundsSTArray (STArray l u _) = (l,u) {-# INLINE readSTArray #-} readSTArray :: Ix i => STArray s i e -> i -> ST s e readSTArray marr@(STArray l u _) i = unsafeReadSTArray marr (index (l,u) i) {-# INLINE unsafeReadSTArray #-} unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# -> readArray# marr# i# s1# {-# INLINE writeSTArray #-} writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s () writeSTArray marr@(STArray l u _) i e = unsafeWriteSTArray marr (index (l,u) i) e {-# INLINE unsafeWriteSTArray #-} unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s () unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# -> case writeArray# marr# i# e s1# of { s2# -> (# s2#, () #) } \end{code} %********************************************************* %* * \subsection{Moving between mutable and immutable} %* * %********************************************************* \begin{code} freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e) freezeSTArray (STArray l u marr#) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) -> let copy i# s3# | i# ==# n# = s3# | otherwise = case readArray# marr# i# s3# of { (# s4#, e #) -> case writeArray# marr'# i# e s4# of { s5# -> copy (i# +# 1#) s5# }} in case copy 0# s2# of { s3# -> case unsafeFreezeArray# marr'# s3# of { (# s4#, arr# #) -> (# s4#, Array l u arr# #) }}}} {-# INLINE unsafeFreezeSTArray #-} unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e) unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# -> case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) -> (# s2#, Array l u arr# #) } thawSTArray :: Ix i => Array i e -> ST s (STArray s i e) thawSTArray (Array l u arr#) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) -> let copy i# s3# | i# ==# n# = s3# | otherwise = case indexArray# arr# i# of { (# e #) -> case writeArray# marr# i# e s3# of { s4# -> copy (i# +# 1#) s4# }} in case copy 0# s2# of { s3# -> (# s3#, STArray l u marr# #) }}} {-# INLINE unsafeThawSTArray #-} unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e) unsafeThawSTArray (Array l u arr#) = ST $ \s1# -> case unsafeThawArray# arr# s1# of { (# s2#, marr# #) -> (# s2#, STArray l u marr# #) } \end{code} hugs98-plus-Sep2006/cpphs/tests/expect300000644006511100651110000005353210504340601016621 0ustar rossross#line 1 "Arr.lhs" {-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Arr -- Copyright : (c) The University of Glasgow, 1994-2000 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- GHC\'s array implementation. -- ----------------------------------------------------------------------------- -- #hide module GHC.Arr where import {-# SOURCE #-} GHC.Err ( error ) import GHC.Enum import GHC.Num import GHC.ST import GHC.Base import GHC.List import GHC.Show infixl 9 !, // default () -- | The 'Ix' class is used to map a contiguous subrange of values in -- a type onto integers. It is used primarily for array indexing -- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray"). -- -- The first argument @(l,u)@ of each of these operations is a pair -- specifying the lower and upper bounds of a contiguous subrange of values. -- -- An implementation is entitled to assume the following laws about these -- operations: -- -- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@ -- -- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@ -- -- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@ -- -- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@ -- -- Minimal complete instance: 'range', 'index' and 'inRange'. -- class (Ord a) => Ix a where -- | The list of values in the subrange defined by a bounding pair. range :: (a,a) -> [a] -- | The position of a subscript in the subrange. index :: (a,a) -> a -> Int -- | Like 'index', but without checking that the value is in range. unsafeIndex :: (a,a) -> a -> Int -- | Returns 'True' the given subscript lies in the range defined -- the bounding pair. inRange :: (a,a) -> a -> Bool -- | The size of the subrange defined by a bounding pair. rangeSize :: (a,a) -> Int -- | like 'rangeSize', but without checking that the upper bound is -- in range. unsafeRangeSize :: (a,a) -> Int -- Must specify one of index, unsafeIndex index b i | inRange b i = unsafeIndex b i | otherwise = error "Error in array index" unsafeIndex b i = index b i rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1 | otherwise = 0 -- This case is only here to -- check for an empty range -- NB: replacing (inRange b h) by (l <= h) fails for -- tuples. E.g. (1,2) <= (2,1) but the range is empty unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1 -- abstract these errors from the relevant index functions so that -- the guts of the function will be small enough to inline. {-# NOINLINE indexError #-} indexError :: Show a => (a,a) -> a -> String -> b indexError rng i tp = error (showString "Ix{" . showString tp . showString "}.index: Index " . showParen True (showsPrec 0 i) . showString " out of range " $ showParen True (showsPrec 0 rng) "") ---------------------------------------------------------------------- instance Ix Char where {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = fromEnum i - fromEnum m index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Char" inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- instance Ix Int where {-# INLINE range #-} -- The INLINE stops the build in the RHS from getting inlined, -- so that callers can fuse with the result of range range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = i - m index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Int" {-# INLINE inRange #-} inRange (I# m,I# n) (I# i) = m <=# i && i <=# n ---------------------------------------------------------------------- instance Ix Integer where {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = fromInteger (i - m) index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Integer" inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- instance Ix Bool where -- as derived {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (l,_) i = fromEnum i - fromEnum l index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Bool" inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- instance Ix Ordering where -- as derived {-# INLINE range #-} range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (l,_) i = fromEnum i - fromEnum l index b i | inRange b i = unsafeIndex b i | otherwise = indexError b i "Ordering" inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- instance Ix () where {-# INLINE range #-} range ((), ()) = [()] {-# INLINE unsafeIndex #-} unsafeIndex ((), ()) () = 0 {-# INLINE inRange #-} inRange ((), ()) () = True {-# INLINE index #-} index b i = unsafeIndex b i ---------------------------------------------------------------------- instance (Ix a, Ix b) => Ix (a, b) where -- as derived {-# SPECIALISE instance Ix (Int,Int) #-} {- INLINE range #-} range ((l1,l2),(u1,u2)) = [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ] {- INLINE unsafeIndex #-} unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) = unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2 {- INLINE inRange #-} inRange ((l1,l2),(u1,u2)) (i1,i2) = inRange (l1,u1) i1 && inRange (l2,u2) i2 -- Default method for index ---------------------------------------------------------------------- instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where {-# SPECIALISE instance Ix (Int,Int,Int) #-} range ((l1,l2,l3),(u1,u2,u3)) = [(i1,i2,i3) | i1 <- range (l1,u1), i2 <- range (l2,u2), i3 <- range (l3,u3)] unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) = unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( unsafeIndex (l1,u1) i1)) inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) = inRange (l1,u1) i1 && inRange (l2,u2) i2 && inRange (l3,u3) i3 -- Default method for index ---------------------------------------------------------------------- instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where range ((l1,l2,l3,l4),(u1,u2,u3,u4)) = [(i1,i2,i3,i4) | i1 <- range (l1,u1), i2 <- range (l2,u2), i3 <- range (l3,u3), i4 <- range (l4,u4)] unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) = unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( unsafeIndex (l1,u1) i1))) inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) = inRange (l1,u1) i1 && inRange (l2,u2) i2 && inRange (l3,u3) i3 && inRange (l4,u4) i4 -- Default method for index instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) = [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1), i2 <- range (l2,u2), i3 <- range (l3,u3), i4 <- range (l4,u4), i5 <- range (l5,u5)] unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) = unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( unsafeIndex (l1,u1) i1)))) inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) = inRange (l1,u1) i1 && inRange (l2,u2) i2 && inRange (l3,u3) i3 && inRange (l4,u4) i4 && inRange (l5,u5) i5 -- Default method for index type IPr = (Int, Int) -- | The type of immutable non-strict (boxed) arrays -- with indices in @i@ and elements in @e@. data Ix i => Array i e = Array !i !i (Array# e) -- | Mutable, boxed, non-strict arrays in the 'ST' monad. The type -- arguments are as follows: -- -- * @s@: the state variable argument for the 'ST' type -- -- * @i@: the index type of the array (should be an instance of 'Ix') -- -- * @e@: the element type of the array. -- data STArray s i e = STArray !i !i (MutableArray# s e) -- No Ix context for STArray. They are stupid, -- and force an Ix context on the equality instance. -- Just pointer equality on mutable arrays: instance Eq (STArray s i e) where STArray _ _ arr1# == STArray _ _ arr2# = sameMutableArray# arr1# arr2# {-# NOINLINE arrEleBottom #-} arrEleBottom :: a arrEleBottom = error "(Array.!): undefined array element" -- | Construct an array with the specified bounds and containing values -- for given indices within these bounds. -- -- The array is undefined (i.e. bottom) if any index in the list is -- out of bounds. The Haskell 98 Report further specifies that if any -- two associations in the list have the same index, the value at that -- index is undefined (i.e. bottom). However in GHC's implementation, -- the value at such an index is the value part of the last association -- with that index in the list. -- -- Because the indices must be checked for these errors, 'array' is -- strict in the bounds argument and in the indices of the association -- list, but nonstrict in the values. Thus, recurrences such as the -- following are possible: -- -- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]]) -- -- Not every index within the bounds of the array need appear in the -- association list, but the values associated with indices that do not -- appear will be undefined (i.e. bottom). -- -- If, in any dimension, the lower bound is greater than the upper bound, -- then the array is legal, but empty. Indexing an empty array always -- gives an array-bounds error, but 'bounds' still yields the bounds -- with which the array was constructed. {-# INLINE array #-} array :: Ix i => (i,i) -- ^ a pair of /bounds/, each of the index type -- of the array. These bounds are the lowest and -- highest indices in the array, in that order. -- For example, a one-origin vector of length -- '10' has bounds '(1,10)', and a one-origin '10' -- by '10' matrix has bounds '((1,1),(10,10))'. -> [(i, e)] -- ^ a list of /associations/ of the form -- (/index/, /value/). Typically, this list will -- be expressed as a comprehension. An -- association '(i, x)' defines the value of -- the array at index 'i' to be 'x'. -> Array i e array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeArray #-} unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e unsafeArray (l,u) ies = runST (ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) -> foldr (fill marr#) (done l u marr#) ies s2# }}) {-# INLINE fill #-} fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a fill marr# (I# i#, e) next s1# = case writeArray# marr# i# e s1# of { s2# -> next s2# } {-# INLINE done #-} done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e) done l u marr# s1# = case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) -> (# s2#, Array l u arr# #) } -- This is inefficient and I'm not sure why: -- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es) -- The code below is better. It still doesn't enable foldr/build -- transformation on the list of elements; I guess it's impossible -- using mechanisms currently available. -- | Construct an array from a pair of bounds and a list of values in -- index order. {-# INLINE listArray #-} listArray :: Ix i => (i,i) -> [e] -> Array i e listArray (l,u) es = runST (ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) -> let fillFromList i# xs s3# | i# ==# n# = s3# | otherwise = case xs of [] -> s3# y:ys -> case writeArray# marr# i# y s3# of { s4# -> fillFromList (i# +# 1#) ys s4# } in case fillFromList 0# es s2# of { s3# -> done l u marr# s3# }}}) -- | The value at the given index in an array. {-# INLINE (!) #-} (!) :: Ix i => Array i e -> i -> e arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i) {-# INLINE unsafeAt #-} unsafeAt :: Ix i => Array i e -> Int -> e unsafeAt (Array _ _ arr#) (I# i#) = case indexArray# arr# i# of (# e #) -> e -- | The bounds with which an array was constructed. {-# INLINE bounds #-} bounds :: Ix i => Array i e -> (i,i) bounds (Array l u _) = (l,u) -- | The list of indices of an array in ascending order. {-# INLINE indices #-} indices :: Ix i => Array i e -> [i] indices (Array l u _) = range (l,u) -- | The list of elements of an array in index order. {-# INLINE elems #-} elems :: Ix i => Array i e -> [e] elems arr@(Array l u _) = [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]] -- | The list of associations of an array in index order. {-# INLINE assocs #-} assocs :: Ix i => Array i e -> [(i, e)] assocs arr@(Array l u _) = [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)] -- | The 'accumArray' deals with repeated indices in the association -- list using an /accumulating function/ which combines the values of -- associations with the same index. -- For example, given a list of values of some index type, @hist@ -- produces a histogram of the number of occurrences of each index within -- a specified range: -- -- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b -- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i] -- -- If the accumulating function is strict, then 'accumArray' is strict in -- the values, as well as the indices, in the association list. Thus, -- unlike ordinary arrays built with 'array', accumulated arrays should -- not in general be recursive. {-# INLINE accumArray #-} accumArray :: Ix i => (e -> a -> e) -- ^ accumulating function -> e -- ^ initial value -> (i,i) -- ^ bounds of the array -> [(i, a)] -- ^ association list -> Array i e accumArray f init (l,u) ies = unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeAccumArray #-} unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# init s1# of { (# s2#, marr# #) -> foldr (adjust f marr#) (done l u marr#) ies s2# }}) {-# INLINE adjust #-} adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b adjust f marr# (I# i#, new) next s1# = case readArray# marr# i# s1# of { (# s2#, old #) -> case writeArray# marr# i# (f old new) s2# of { s3# -> next s3# }} -- | Constructs an array identical to the first argument except that it has -- been updated by the associations in the right argument. -- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then -- -- > m//[((i,i), 0) | i <- [1..n]] -- -- is the same matrix, except with the diagonal zeroed. -- -- Repeated indices in the association list are handled as for 'array': -- Haskell 98 specifies that the resulting array is undefined (i.e. bottom), -- but GHC's implementation uses the last association for each index. {-# INLINE (//) #-} (//) :: Ix i => Array i e -> [(i, e)] -> Array i e arr@(Array l u _) // ies = unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeReplace #-} unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e unsafeReplace arr@(Array l u _) ies = runST (do STArray _ _ marr# <- thawSTArray arr ST (foldr (fill marr#) (done l u marr#) ies)) -- | @'accum' f@ takes an array and an association list and accumulates -- pairs from the list into the array with the accumulating function @f@. -- Thus 'accumArray' can be defined using 'accum': -- -- > accumArray f z b = accum f (array b [(i, z) | i <- range b]) -- {-# INLINE accum #-} accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e accum f arr@(Array l u _) ies = unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies] {-# INLINE unsafeAccum #-} unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e unsafeAccum f arr@(Array l u _) ies = runST (do STArray _ _ marr# <- thawSTArray arr ST (foldr (adjust f marr#) (done l u marr#) ies)) {-# INLINE amap #-} amap :: Ix i => (a -> b) -> Array i a -> Array i b amap f arr@(Array l u _) = unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]] -- | 'ixmap' allows for transformations on array indices. -- It may be thought of as providing function composition on the right -- with the mapping that the original array embodies. -- -- A similar transformation of array values may be achieved using 'fmap' -- from the 'Array' instance of the 'Functor' class. {-# INLINE ixmap #-} ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e ixmap (l,u) f arr = unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)] {-# INLINE eqArray #-} eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) = if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else l1 == l2 && u1 == u2 && and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]] {-# INLINE cmpArray #-} cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2) {-# INLINE cmpIntArray #-} cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) = if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else if rangeSize (l2,u2) == 0 then GT else case compare l1 l2 of EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1] other -> other where cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of EQ -> rest other -> other {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-} instance Ix i => Functor (Array i) where fmap = amap instance (Ix i, Eq e) => Eq (Array i e) where (==) = eqArray instance (Ix i, Ord e) => Ord (Array i e) where compare = cmpArray instance (Ix a, Show a, Show b) => Show (Array a b) where showsPrec p a = showParen (p > appPrec) $ showString "array " . showsPrec appPrec1 (bounds a) . showChar ' ' . showsPrec appPrec1 (assocs a) -- Precedence of 'array' is the precedence of application -- The Read instance is in GHC.Read {-# INLINE newSTArray #-} newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e) newSTArray (l,u) init = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# init s1# of { (# s2#, marr# #) -> (# s2#, STArray l u marr# #) }} {-# INLINE boundsSTArray #-} boundsSTArray :: STArray s i e -> (i,i) boundsSTArray (STArray l u _) = (l,u) {-# INLINE readSTArray #-} readSTArray :: Ix i => STArray s i e -> i -> ST s e readSTArray marr@(STArray l u _) i = unsafeReadSTArray marr (index (l,u) i) {-# INLINE unsafeReadSTArray #-} unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# -> readArray# marr# i# s1# {-# INLINE writeSTArray #-} writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s () writeSTArray marr@(STArray l u _) i e = unsafeWriteSTArray marr (index (l,u) i) e {-# INLINE unsafeWriteSTArray #-} unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s () unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# -> case writeArray# marr# i# e s1# of { s2# -> (# s2#, () #) } freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e) freezeSTArray (STArray l u marr#) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) -> let copy i# s3# | i# ==# n# = s3# | otherwise = case readArray# marr# i# s3# of { (# s4#, e #) -> case writeArray# marr'# i# e s4# of { s5# -> copy (i# +# 1#) s5# }} in case copy 0# s2# of { s3# -> case unsafeFreezeArray# marr'# s3# of { (# s4#, arr# #) -> (# s4#, Array l u arr# #) }}}} {-# INLINE unsafeFreezeSTArray #-} unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e) unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# -> case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) -> (# s2#, Array l u arr# #) } thawSTArray :: Ix i => Array i e -> ST s (STArray s i e) thawSTArray (Array l u arr#) = ST $ \s1# -> case rangeSize (l,u) of { I# n# -> case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) -> let copy i# s3# | i# ==# n# = s3# | otherwise = case indexArray# arr# i# of { (# e #) -> case writeArray# marr# i# e s3# of { s4# -> copy (i# +# 1#) s4# }} in case copy 0# s2# of { s3# -> (# s3#, STArray l u marr# #) }}} {-# INLINE unsafeThawSTArray #-} unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e) unsafeThawSTArray (Array l u arr#) = ST $ \s1# -> case unsafeThawArray# arr# s1# of { (# s2#, marr# #) -> (# s2#, STArray l u marr# #) } hugs98-plus-Sep2006/cpphs/tests/elif0000644006511100651110000000054110504340601016075 0ustar rossross#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \ ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__) import System.IO.Unsafe (unsafePerformIO) #elif defined(__GLASGOW_HASKELL__) import IOExts (unsafePerformIO) #elif defined(__NHC__) import IOExtras (unsafePerformIO) #elif defined(__HBC__) import UnsafePerformIO #endif hugs98-plus-Sep2006/cpphs/tests/expect310000644006511100651110000000010110504340601016602 0ustar rossross#line 1 "elif" import System.IO.Unsafe (unsafePerformIO) hugs98-plus-Sep2006/hsc2hs/0000755006511100651110000000000010504340627014156 5ustar rossrosshugs98-plus-Sep2006/hsc2hs/Makefile.inc0000644006511100651110000000022310504340627016363 0ustar rossrossifeq "" "${MKDIR}" MKDIR:=$(shell pwd) #MKDIR:=$(PWD) else MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) endif include ${MKDIR}/Makefile.inc hugs98-plus-Sep2006/hsc2hs/Main.hs0000644006511100651110000007225710504340627015413 0ustar rossross{-# OPTIONS -cpp #-} ------------------------------------------------------------------------ -- Program for converting .hsc files to .hs files, by converting the -- file into a C program which is run to generate the Haskell source. -- Certain items known only to the C compiler can then be used in -- the Haskell module; for example #defined constants, byte offsets -- within structures, etc. -- -- See the documentation in the Users' Guide for more details. import Control.Monad ( MonadPlus(..), liftM, liftM2, when ) import Data.Char ( isAlpha, isAlphaNum, isSpace, isDigit, toUpper, intToDigit, ord ) import Data.List ( intersperse, isSuffixOf ) import System.Cmd ( system, rawSystem ) import System.Console.GetOpt import System.Directory ( removeFile, doesFileExist ) import System.Environment ( getProgName, getArgs ) import System.Exit ( ExitCode(..), exitWith ) import System.IO ( hPutStr, hPutStrLn, stderr ) #if __GLASGOW_HASKELL__ >= 604 || defined(__NHC__) || defined(__HUGS__) import System.Directory ( findExecutable ) #else import System.Directory ( getPermissions, executable ) import System.Environment ( getEnv ) import Control.Monad ( foldM ) #endif #if __GLASGOW_HASKELL__ >= 604 import System.Process ( runProcess, waitForProcess ) import System.IO ( openFile, IOMode(..), hClose ) #define HAVE_runProcess #endif #if ! BUILD_NHC import Paths_hsc2hs ( getDataFileName ) #else import System.Directory ( getCurrentDirectory ) getDataFileName s = do here <- getCurrentDirectory return (here++"/"++s) #endif #ifdef __GLASGOW_HASKELL__ default_compiler = "ghc" #else default_compiler = "gcc" #endif #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 604) findExecutable :: String -> IO (Maybe FilePath) findExecutable cmd = let dir = dirname cmd in case dir of "" -> do -- search the shell environment PATH variable for candidates val <- getEnv "PATH" let psep = pathSep val dirs = splitPath psep "" val foldM (\a dir-> testFile a (dir++'/':cmd)) Nothing dirs _ -> do testFile Nothing cmd where splitPath :: Char -> String -> String -> [String] splitPath sep acc [] = [reverse acc] splitPath sep acc (c:path) | c==sep = reverse acc : splitPath sep "" path splitPath sep acc (c:path) = splitPath sep (c:acc) path pathSep s = if length (filter (==';') s) >0 then ';' else ':' testFile :: Maybe String -> String -> IO (Maybe String) testFile gotit@(Just _) path = return gotit testFile Nothing path = do ok <- doesFileExist path if ok then perms path else return Nothing perms file = do p <- getPermissions file return (if executable p then Just file else Nothing) dirname = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse where safetail [] = [] safetail (_:x) = x #endif version :: String version = "hsc2hs version 0.66\n" data Flag = Help | Version | Template String | Compiler String | Linker String | CompFlag String | LinkFlag String | NoCompile | Include String | Define String (Maybe String) | Output String | Verbose template_flag :: Flag -> Bool template_flag (Template _) = True template_flag _ = False include :: String -> Flag include s@('\"':_) = Include s include s@('<' :_) = Include s include s = Include ("\""++s++"\"") define :: String -> Flag define s = case break (== '=') s of (name, []) -> Define name Nothing (name, _:value) -> Define name (Just value) options :: [OptDescr Flag] options = [ Option ['o'] ["output"] (ReqArg Output "FILE") "name of main output file", Option ['t'] ["template"] (ReqArg Template "FILE") "template file", Option ['c'] ["cc"] (ReqArg Compiler "PROG") "C compiler to use", Option ['l'] ["ld"] (ReqArg Linker "PROG") "linker to use", Option ['C'] ["cflag"] (ReqArg CompFlag "FLAG") "flag to pass to the C compiler", Option ['I'] [] (ReqArg (CompFlag . ("-I"++)) "DIR") "passed to the C compiler", Option ['L'] ["lflag"] (ReqArg LinkFlag "FLAG") "flag to pass to the linker", Option ['i'] ["include"] (ReqArg include "FILE") "as if placed in the source", Option ['D'] ["define"] (ReqArg define "NAME[=VALUE]") "as if placed in the source", Option [] ["no-compile"] (NoArg NoCompile) "stop after writing *_hsc_make.c", Option ['v'] ["verbose"] (NoArg Verbose) "dump commands to stderr", Option ['?'] ["help"] (NoArg Help) "display this help and exit", Option ['V'] ["version"] (NoArg Version) "output version information and exit" ] main :: IO () main = do prog <- getProgramName let header = "Usage: "++prog++" [OPTIONS] INPUT.hsc [...]\n" args <- getArgs let (flags, files, errs) = getOpt Permute options args -- If there is no Template flag explicitly specified, -- use the file placed by the Cabal installation. flags_w_tpl <- if any template_flag flags then return flags else do templ <- getDataFileName "template-hsc.h" return (Template templ : flags) case (files, errs) of (_, _) | any isHelp flags_w_tpl -> bye (usageInfo header options) | any isVersion flags_w_tpl -> bye version where isHelp Help = True; isHelp _ = False isVersion Version = True; isVersion _ = False ((_:_), []) -> mapM_ (processFile flags_w_tpl) files (_, _ ) -> die (concat errs ++ usageInfo header options) getProgramName :: IO String getProgramName = liftM (`withoutSuffix` "-bin") getProgName where str `withoutSuffix` suff | suff `isSuffixOf` str = take (length str - length suff) str | otherwise = str bye :: String -> IO a bye s = putStr s >> exitWith ExitSuccess die :: String -> IO a die s = hPutStr stderr s >> exitWith (ExitFailure 1) processFile :: [Flag] -> String -> IO () processFile flags name = do let file_name = dosifyPath name s <- readFile file_name case parser of Parser p -> case p (SourcePos file_name 1) s of Success _ _ _ toks -> output flags file_name toks Failure (SourcePos name' line) msg -> die (name'++":"++show line++": "++msg++"\n") ------------------------------------------------------------------------ -- A deterministic parser which remembers the text which has been parsed. newtype Parser a = Parser (SourcePos -> String -> ParseResult a) data ParseResult a = Success !SourcePos String String a | Failure !SourcePos String data SourcePos = SourcePos String !Int updatePos :: SourcePos -> Char -> SourcePos updatePos pos@(SourcePos name line) ch = case ch of '\n' -> SourcePos name (line + 1) _ -> pos instance Monad Parser where return a = Parser $ \pos s -> Success pos [] s a Parser m >>= k = Parser $ \pos s -> case m pos s of Success pos' out1 s' a -> case k a of Parser k' -> case k' pos' s' of Success pos'' out2 imp'' b -> Success pos'' (out1++out2) imp'' b Failure pos'' msg -> Failure pos'' msg Failure pos' msg -> Failure pos' msg fail msg = Parser $ \pos _ -> Failure pos msg instance MonadPlus Parser where mzero = fail "mzero" Parser m `mplus` Parser n = Parser $ \pos s -> case m pos s of success@(Success _ _ _ _) -> success Failure _ _ -> n pos s getPos :: Parser SourcePos getPos = Parser $ \pos s -> Success pos [] s pos setPos :: SourcePos -> Parser () setPos pos = Parser $ \_ s -> Success pos [] s () message :: Parser a -> String -> Parser a Parser m `message` msg = Parser $ \pos s -> case m pos s of success@(Success _ _ _ _) -> success Failure pos' _ -> Failure pos' msg catchOutput_ :: Parser a -> Parser String catchOutput_ (Parser m) = Parser $ \pos s -> case m pos s of Success pos' out s' _ -> Success pos' [] s' out Failure pos' msg -> Failure pos' msg fakeOutput :: Parser a -> String -> Parser a Parser m `fakeOutput` out = Parser $ \pos s -> case m pos s of Success pos' _ s' a -> Success pos' out s' a Failure pos' msg -> Failure pos' msg lookAhead :: Parser String lookAhead = Parser $ \pos s -> Success pos [] s s satisfy :: (Char -> Bool) -> Parser Char satisfy p = Parser $ \pos s -> case s of c:cs | p c -> Success (updatePos pos c) [c] cs c _ -> Failure pos "Bad character" char_ :: Char -> Parser () char_ c = do satisfy (== c) `message` (show c++" expected") return () anyChar_ :: Parser () anyChar_ = do satisfy (const True) `message` "Unexpected end of file" return () any2Chars_ :: Parser () any2Chars_ = anyChar_ >> anyChar_ many :: Parser a -> Parser [a] many p = many1 p `mplus` return [] many1 :: Parser a -> Parser [a] many1 p = liftM2 (:) p (many p) many_ :: Parser a -> Parser () many_ p = many1_ p `mplus` return () many1_ :: Parser a -> Parser () many1_ p = p >> many_ p manySatisfy, manySatisfy1 :: (Char -> Bool) -> Parser String manySatisfy = many . satisfy manySatisfy1 = many1 . satisfy manySatisfy_, manySatisfy1_ :: (Char -> Bool) -> Parser () manySatisfy_ = many_ . satisfy manySatisfy1_ = many1_ . satisfy ------------------------------------------------------------------------ -- Parser of hsc syntax. data Token = Text SourcePos String | Special SourcePos String String parser :: Parser [Token] parser = do pos <- getPos t <- catchOutput_ text s <- lookAhead rest <- case s of [] -> return [] _:_ -> liftM2 (:) (special `fakeOutput` []) parser return (if null t then rest else Text pos t : rest) text :: Parser () text = do s <- lookAhead case s of [] -> return () c:_ | isAlpha c || c == '_' -> do anyChar_ manySatisfy_ (\c' -> isAlphaNum c' || c' == '_' || c' == '\'') text c:_ | isHsSymbol c -> do symb <- catchOutput_ (manySatisfy_ isHsSymbol) case symb of "#" -> return () '-':'-':symb' | all (== '-') symb' -> do return () `fakeOutput` symb manySatisfy_ (/= '\n') text _ -> do return () `fakeOutput` unescapeHashes symb text '\"':_ -> do anyChar_; hsString '\"'; text '\'':_ -> do anyChar_; hsString '\''; text '{':'-':_ -> do any2Chars_; linePragma `mplus` hsComment; text _:_ -> do anyChar_; text hsString :: Char -> Parser () hsString quote = do s <- lookAhead case s of [] -> return () c:_ | c == quote -> anyChar_ '\\':c:_ | isSpace c -> do anyChar_ manySatisfy_ isSpace char_ '\\' `mplus` return () hsString quote | otherwise -> do any2Chars_; hsString quote _:_ -> do anyChar_; hsString quote hsComment :: Parser () hsComment = do s <- lookAhead case s of [] -> return () '-':'}':_ -> any2Chars_ '{':'-':_ -> do any2Chars_; hsComment; hsComment _:_ -> do anyChar_; hsComment linePragma :: Parser () linePragma = do char_ '#' manySatisfy_ isSpace satisfy (\c -> c == 'L' || c == 'l') satisfy (\c -> c == 'I' || c == 'i') satisfy (\c -> c == 'N' || c == 'n') satisfy (\c -> c == 'E' || c == 'e') manySatisfy1_ isSpace line <- liftM read $ manySatisfy1 isDigit manySatisfy1_ isSpace char_ '\"' name <- manySatisfy (/= '\"') char_ '\"' manySatisfy_ isSpace char_ '#' char_ '-' char_ '}' setPos (SourcePos name (line - 1)) isHsSymbol :: Char -> Bool isHsSymbol '!' = True; isHsSymbol '#' = True; isHsSymbol '$' = True isHsSymbol '%' = True; isHsSymbol '&' = True; isHsSymbol '*' = True isHsSymbol '+' = True; isHsSymbol '.' = True; isHsSymbol '/' = True isHsSymbol '<' = True; isHsSymbol '=' = True; isHsSymbol '>' = True isHsSymbol '?' = True; isHsSymbol '@' = True; isHsSymbol '\\' = True isHsSymbol '^' = True; isHsSymbol '|' = True; isHsSymbol '-' = True isHsSymbol '~' = True isHsSymbol _ = False unescapeHashes :: String -> String unescapeHashes [] = [] unescapeHashes ('#':'#':s) = '#' : unescapeHashes s unescapeHashes (c:s) = c : unescapeHashes s lookAheadC :: Parser String lookAheadC = liftM joinLines lookAhead where joinLines [] = [] joinLines ('\\':'\n':s) = joinLines s joinLines (c:s) = c : joinLines s satisfyC :: (Char -> Bool) -> Parser Char satisfyC p = do s <- lookAhead case s of '\\':'\n':_ -> do any2Chars_ `fakeOutput` []; satisfyC p _ -> satisfy p charC_ :: Char -> Parser () charC_ c = do satisfyC (== c) `message` (show c++" expected") return () anyCharC_ :: Parser () anyCharC_ = do satisfyC (const True) `message` "Unexpected end of file" return () any2CharsC_ :: Parser () any2CharsC_ = anyCharC_ >> anyCharC_ manySatisfyC :: (Char -> Bool) -> Parser String manySatisfyC = many . satisfyC manySatisfyC_ :: (Char -> Bool) -> Parser () manySatisfyC_ = many_ . satisfyC special :: Parser Token special = do manySatisfyC_ (\c -> isSpace c && c /= '\n') s <- lookAheadC case s of '{':_ -> do anyCharC_ manySatisfyC_ isSpace sp <- keyArg (== '\n') charC_ '}' return sp _ -> keyArg (const False) keyArg :: (Char -> Bool) -> Parser Token keyArg eol = do pos <- getPos key <- keyword `message` "hsc keyword or '{' expected" manySatisfyC_ (\c' -> isSpace c' && c' /= '\n' || eol c') arg <- catchOutput_ (argument eol) return (Special pos key arg) keyword :: Parser String keyword = do c <- satisfyC (\c' -> isAlpha c' || c' == '_') cs <- manySatisfyC (\c' -> isAlphaNum c' || c' == '_') return (c:cs) argument :: (Char -> Bool) -> Parser () argument eol = do s <- lookAheadC case s of [] -> return () c:_ | eol c -> do anyCharC_; argument eol '\n':_ -> return () '\"':_ -> do anyCharC_; cString '\"'; argument eol '\'':_ -> do anyCharC_; cString '\''; argument eol '(':_ -> do anyCharC_; nested ')'; argument eol ')':_ -> return () '/':'*':_ -> do any2CharsC_; cComment; argument eol '/':'/':_ -> do any2CharsC_; manySatisfyC_ (/= '\n'); argument eol '[':_ -> do anyCharC_; nested ']'; argument eol ']':_ -> return () '{':_ -> do anyCharC_; nested '}'; argument eol '}':_ -> return () _:_ -> do anyCharC_; argument eol nested :: Char -> Parser () nested c = do argument (== '\n'); charC_ c cComment :: Parser () cComment = do s <- lookAheadC case s of [] -> return () '*':'/':_ -> do any2CharsC_ _:_ -> do anyCharC_; cComment cString :: Char -> Parser () cString quote = do s <- lookAheadC case s of [] -> return () c:_ | c == quote -> anyCharC_ '\\':_:_ -> do any2CharsC_; cString quote _:_ -> do anyCharC_; cString quote ------------------------------------------------------------------------ -- Write the output files. splitName :: String -> (String, String) splitName name = case break (== '/') name of (file, []) -> ([], file) (dir, sep:rest) -> (dir++sep:restDir, restFile) where (restDir, restFile) = splitName rest splitExt :: String -> (String, String) splitExt name = case break (== '.') name of (base, []) -> (base, []) (base, sepRest@(sep:rest)) | null restExt -> (base, sepRest) | otherwise -> (base++sep:restBase, restExt) where (restBase, restExt) = splitExt rest output :: [Flag] -> String -> [Token] -> IO () output flags name toks = do (outName, outDir, outBase) <- case [f | Output f <- flags] of [] -> if not (null ext) && last ext == 'c' then return (dir++base++init ext, dir, base) else if ext == ".hs" then return (dir++base++"_out.hs", dir, base) else return (dir++base++".hs", dir, base) where (dir, file) = splitName name (base, ext) = splitExt file [f] -> let (dir, file) = splitName f (base, _) = splitExt file in return (f, dir, base) _ -> onlyOne "output file" let cProgName = outDir++outBase++"_hsc_make.c" oProgName = outDir++outBase++"_hsc_make.o" progName = outDir++outBase++"_hsc_make" #if defined(mingw32_HOST_OS) || defined(__CYGWIN32__) -- This is a real hack, but the quoting mechanism used for calling the C preprocesseor -- via GHC has changed a few times, so this seems to be the only way... :-P * * * ++ ".exe" #endif outHFile = outBase++"_hsc.h" outHName = outDir++outHFile outCName = outDir++outBase++"_hsc.c" beVerbose = any (\ x -> case x of { Verbose -> True; _ -> False}) flags let execProgName | null outDir = dosifyPath ("./" ++ progName) | otherwise = progName let specials = [(pos, key, arg) | Special pos key arg <- toks] let needsC = any (\(_, key, _) -> key == "def") specials needsH = needsC let includeGuard = map fixChar outHName where fixChar c | isAlphaNum c = toUpper c | otherwise = '_' compiler <- case [c | Compiler c <- flags] of [] -> do mb_path <- findExecutable default_compiler case mb_path of Nothing -> die ("Can't find "++default_compiler++"\n") Just path -> return path [c] -> return c _ -> onlyOne "compiler" linker <- case [l | Linker l <- flags] of [] -> return compiler [l] -> return l _ -> onlyOne "linker" writeFile cProgName $ concatMap outFlagHeaderCProg flags++ concatMap outHeaderCProg specials++ "\nint main (int argc, char *argv [])\n{\n"++ outHeaderHs flags (if needsH then Just outHName else Nothing) specials++ outHsLine (SourcePos name 0)++ concatMap outTokenHs toks++ " return 0;\n}\n" -- NOTE: hbc compiles "[() | NoCompile <- flags]" into wrong code, -- so we use something slightly more complicated. :-P when (any (\x -> case x of NoCompile -> True; _ -> False) flags) $ exitWith ExitSuccess rawSystemL ("compiling " ++ cProgName) beVerbose compiler ( ["-c"] ++ [f | CompFlag f <- flags] ++ [cProgName] ++ ["-o", oProgName] ) removeFile cProgName rawSystemL ("linking " ++ oProgName) beVerbose linker ( [f | LinkFlag f <- flags] ++ [oProgName] ++ ["-o", progName] ) removeFile oProgName rawSystemWithStdOutL ("running " ++ execProgName) beVerbose execProgName [] outName removeFile progName when needsH $ writeFile outHName $ "#ifndef "++includeGuard++"\n" ++ "#define "++includeGuard++"\n" ++ "#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n" ++ "#include \n" ++ "#endif\n" ++ "#include \n" ++ "#if __NHC__\n" ++ "#undef HsChar\n" ++ "#define HsChar int\n" ++ "#endif\n" ++ concatMap outFlagH flags++ concatMap outTokenH specials++ "#endif\n" when needsC $ writeFile outCName $ "#include \""++outHFile++"\"\n"++ concatMap outTokenC specials -- NB. outHFile not outHName; works better when processed -- by gcc or mkdependC. rawSystemL :: String -> Bool -> FilePath -> [String] -> IO () rawSystemL action flg prog args = do let cmdLine = prog++" "++unwords args when flg $ hPutStrLn stderr ("Executing: " ++ cmdLine) #ifndef HAVE_rawSystem exitStatus <- system cmdLine #else exitStatus <- rawSystem prog args #endif case exitStatus of ExitFailure _ -> die $ action ++ " failed\ncommand was: " ++ cmdLine ++ "\n" _ -> return () rawSystemWithStdOutL :: String -> Bool -> FilePath -> [String] -> FilePath -> IO () rawSystemWithStdOutL action flg prog args outFile = do let cmdLine = prog++" "++unwords args++" >"++outFile when flg (hPutStrLn stderr ("Executing: " ++ cmdLine)) #ifndef HAVE_runProcess exitStatus <- system cmdLine #else hOut <- openFile outFile WriteMode process <- runProcess prog args Nothing Nothing Nothing (Just hOut) Nothing exitStatus <- waitForProcess process hClose hOut #endif case exitStatus of ExitFailure _ -> die $ action ++ " failed\ncommand was: " ++ cmdLine ++ "\n" _ -> return () onlyOne :: String -> IO a onlyOne what = die ("Only one "++what++" may be specified\n") outFlagHeaderCProg :: Flag -> String outFlagHeaderCProg (Template t) = "#include \""++t++"\"\n" outFlagHeaderCProg (Include f) = "#include "++f++"\n" outFlagHeaderCProg (Define n Nothing) = "#define "++n++" 1\n" outFlagHeaderCProg (Define n (Just v)) = "#define "++n++" "++v++"\n" outFlagHeaderCProg _ = "" outHeaderCProg :: (SourcePos, String, String) -> String outHeaderCProg (pos, key, arg) = case key of "include" -> outCLine pos++"#include "++arg++"\n" "define" -> outCLine pos++"#define "++arg++"\n" "undef" -> outCLine pos++"#undef "++arg++"\n" "def" -> case arg of 's':'t':'r':'u':'c':'t':' ':_ -> outCLine pos++arg++"\n" 't':'y':'p':'e':'d':'e':'f':' ':_ -> outCLine pos++arg++"\n" _ -> "" _ | conditional key -> outCLine pos++"#"++key++" "++arg++"\n" "let" -> case break (== '=') arg of (_, "") -> "" (header, _:body) -> case break isSpace header of (name, args) -> outCLine pos++ "#define hsc_"++name++"("++dropWhile isSpace args++") " ++ "printf ("++joinLines body++");\n" _ -> "" where joinLines = concat . intersperse " \\\n" . lines outHeaderHs :: [Flag] -> Maybe String -> [(SourcePos, String, String)] -> String outHeaderHs flags inH toks = "#if " ++ "__GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n" ++ " printf (\"{-# OPTIONS -optc-D" ++ "__GLASGOW_HASKELL__=%d #-}\\n\", " ++ "__GLASGOW_HASKELL__);\n" ++ "#endif\n"++ case inH of Nothing -> concatMap outFlag flags++concatMap outSpecial toks Just f -> outInclude ("\""++f++"\"") where outFlag (Include f) = outInclude f outFlag (Define n Nothing) = outOption ("-optc-D"++n) outFlag (Define n (Just v)) = outOption ("-optc-D"++n++"="++v) outFlag _ = "" outSpecial (pos, key, arg) = case key of "include" -> outInclude arg "define" | goodForOptD arg -> outOption ("-optc-D"++toOptD arg) | otherwise -> "" _ | conditional key -> outCLine pos++"#"++key++" "++arg++"\n" _ -> "" goodForOptD arg = case arg of "" -> True c:_ | isSpace c -> True '(':_ -> False _:s -> goodForOptD s toOptD arg = case break isSpace arg of (name, "") -> name (name, _:value) -> name++'=':dropWhile isSpace value outOption s = "#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 603\n" ++ " printf (\"{-# OPTIONS %s #-}\\n\", \""++ showCString s++"\");\n"++ "#else\n"++ " printf (\"{-# OPTIONS_GHC %s #-}\\n\", \""++ showCString s++"\");\n"++ "#endif\n" outInclude s = "#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 603\n" ++ " printf (\"{-# OPTIONS -#include %s #-}\\n\", \""++ showCString s++"\");\n"++ "#else\n"++ " printf (\"{-# INCLUDE %s #-}\\n\", \""++ showCString s++"\");\n"++ "#endif\n" outTokenHs :: Token -> String outTokenHs (Text pos txt) = case break (== '\n') txt of (allTxt, []) -> outText allTxt (first, _:rest) -> outText (first++"\n")++ outHsLine pos++ outText rest where outText s = " fputs (\""++showCString s++"\", stdout);\n" outTokenHs (Special pos key arg) = case key of "include" -> "" "define" -> "" "undef" -> "" "def" -> "" _ | conditional key -> outCLine pos++"#"++key++" "++arg++"\n" "let" -> "" "enum" -> outCLine pos++outEnum arg _ -> outCLine pos++" hsc_"++key++" ("++arg++");\n" outEnum :: String -> String outEnum arg = case break (== ',') arg of (_, []) -> "" (t, _:afterT) -> case break (== ',') afterT of (f, afterF) -> let enums [] = "" enums (_:s) = case break (== ',') s of (enum, rest) -> let this = case break (== '=') $ dropWhile isSpace enum of (name, []) -> " hsc_enum ("++t++", "++f++", " ++ "hsc_haskellize (\""++name++"\"), "++ name++");\n" (hsName, _:cName) -> " hsc_enum ("++t++", "++f++", " ++ "printf (\"%s\", \""++hsName++"\"), "++ cName++");\n" in this++enums rest in enums afterF outFlagH :: Flag -> String outFlagH (Include f) = "#include "++f++"\n" outFlagH (Define n Nothing) = "#define "++n++" 1\n" outFlagH (Define n (Just v)) = "#define "++n++" "++v++"\n" outFlagH _ = "" outTokenH :: (SourcePos, String, String) -> String outTokenH (pos, key, arg) = case key of "include" -> outCLine pos++"#include "++arg++"\n" "define" -> outCLine pos++"#define " ++arg++"\n" "undef" -> outCLine pos++"#undef " ++arg++"\n" "def" -> outCLine pos++case arg of 's':'t':'r':'u':'c':'t':' ':_ -> arg++"\n" 't':'y':'p':'e':'d':'e':'f':' ':_ -> arg++"\n" 'i':'n':'l':'i':'n':'e':' ':_ -> "#ifdef __GNUC__\n" ++ "extern\n" ++ "#endif\n"++ arg++"\n" _ -> "extern "++header++";\n" where header = takeWhile (\c -> c /= '{' && c /= '=') arg _ | conditional key -> outCLine pos++"#"++key++" "++arg++"\n" _ -> "" outTokenC :: (SourcePos, String, String) -> String outTokenC (pos, key, arg) = case key of "def" -> case arg of 's':'t':'r':'u':'c':'t':' ':_ -> "" 't':'y':'p':'e':'d':'e':'f':' ':_ -> "" 'i':'n':'l':'i':'n':'e':' ':arg' -> case span (\c -> c /= '{' && c /= '=') arg' of (header, body) -> outCLine pos++ "#ifndef __GNUC__\n" ++ "extern inline\n" ++ "#endif\n"++ header++ "\n#ifndef __GNUC__\n" ++ ";\n" ++ "#else\n"++ body++ "\n#endif\n" _ -> outCLine pos++arg++"\n" _ | conditional key -> outCLine pos++"#"++key++" "++arg++"\n" _ -> "" conditional :: String -> Bool conditional "if" = True conditional "ifdef" = True conditional "ifndef" = True conditional "elif" = True conditional "else" = True conditional "endif" = True conditional "error" = True conditional "warning" = True conditional _ = False outCLine :: SourcePos -> String outCLine (SourcePos name line) = "#line "++show line++" \""++showCString (snd (splitName name))++"\"\n" outHsLine :: SourcePos -> String outHsLine (SourcePos name line) = " hsc_line ("++show (line + 1)++", \""++ showCString name++"\");\n" showCString :: String -> String showCString = concatMap showCChar where showCChar '\"' = "\\\"" showCChar '\'' = "\\\'" showCChar '?' = "\\?" showCChar '\\' = "\\\\" showCChar c | c >= ' ' && c <= '~' = [c] showCChar '\a' = "\\a" showCChar '\b' = "\\b" showCChar '\f' = "\\f" showCChar '\n' = "\\n\"\n \"" showCChar '\r' = "\\r" showCChar '\t' = "\\t" showCChar '\v' = "\\v" showCChar c = ['\\', intToDigit (ord c `quot` 64), intToDigit (ord c `quot` 8 `mod` 8), intToDigit (ord c `mod` 8)] ----------------------------------------- -- Modified version from ghc/compiler/SysTools -- Convert paths foo/baz to foo\baz on Windows subst :: Char -> Char -> String -> String #if defined(mingw32_HOST_OS) || defined(__CYGWIN32__) subst a b = map (\x -> if x == a then b else x) #else subst _ _ = id #endif dosifyPath :: String -> String dosifyPath = subst '/' '\\' hugs98-plus-Sep2006/hsc2hs/hsc2hs.sh0000644006511100651110000000041610504340627015705 0ustar rossross tflag="--template=$HSC2HS_DIR/template-hsc.h" for arg do case "$arg" in -c*) HSC2HS_EXTRA=;; --cc=*) HSC2HS_EXTRA=;; -t*) tflag=;; --template=*) tflag=;; --) break;; esac done $HSC2HS_BINDIR/$HS_PROG $tflag $HSC2HS_EXTRA "$@" hugs98-plus-Sep2006/hsc2hs/template-hsc.h0000644006511100651110000001112410504340627016714 0ustar rossross#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409 #include #endif #include #include #include #include #include #include #ifndef offsetof #define offsetof(t, f) ((size_t) &((t *)0)->f) #endif #if __NHC__ #define hsc_line(line, file) \ printf ("# %d \"%s\"\n", line, file); #else #define hsc_line(line, file) \ printf ("{-# LINE %d \"%s\" #-}\n", line, file); #endif #define hsc_const(x) \ if ((x) < 0) \ printf ("%ld", (long)(x)); \ else \ printf ("%lu", (unsigned long)(x)); #define hsc_const_str(x) \ { \ const char *s = (x); \ printf ("\""); \ while (*s != '\0') \ { \ if (*s == '"' || *s == '\\') \ printf ("\\%c", *s); \ else if (*s >= 0x20 && *s <= 0x7E) \ printf ("%c", *s); \ else \ printf ("\\%d%s", \ (unsigned char) *s, \ s[1] >= '0' && s[1] <= '9' ? "\\&" : ""); \ ++s; \ } \ printf ("\""); \ } #define hsc_type(t) \ if ((t)(int)(t)1.4 == (t)1.4) \ printf ("%s%d", \ (t)(-1) < (t)0 ? "Int" : "Word", \ sizeof (t) * 8); \ else \ printf ("%s", \ sizeof (t) > sizeof (double) ? "LDouble" : \ sizeof (t) == sizeof (double) ? "Double" : \ "Float"); #define hsc_peek(t, f) \ printf ("(\\hsc_ptr -> peekByteOff hsc_ptr %ld)", (long) offsetof (t, f)); #define hsc_poke(t, f) \ printf ("(\\hsc_ptr -> pokeByteOff hsc_ptr %ld)", (long) offsetof (t, f)); #define hsc_ptr(t, f) \ printf ("(\\hsc_ptr -> hsc_ptr `plusPtr` %ld)", (long) offsetof (t, f)); #define hsc_offset(t, f) \ printf("(%ld)", (long) offsetof (t, f)); #define hsc_size(t) \ printf("(%ld)", (long) sizeof(t)); #define hsc_enum(t, f, print_name, x) \ print_name; \ printf (" :: %s\n", #t); \ print_name; \ printf (" = %s ", #f); \ if ((x) < 0) \ printf ("(%ld)\n", (long)(x)); \ else \ printf ("%lu\n", (unsigned long)(x)); #define hsc_haskellize(x) \ { \ const char *s = (x); \ int upper = 0; \ if (*s != '\0') \ { \ putchar (tolower (*s)); \ ++s; \ while (*s != '\0') \ { \ if (*s == '_') \ upper = 1; \ else \ { \ putchar (upper ? toupper (*s) : tolower (*s)); \ upper = 0; \ } \ ++s; \ } \ } \ } hugs98-plus-Sep2006/hsc2hs/Makefile.nhc980000644006511100651110000000227410504340627016553 0ustar rossrossinclude Makefile.inc OBJDIR = ${BUILDDIR}/obj/hsc2hs TARGET = ${DST}/hsc2hs$(EXE) SRCS = Main.hs FROMC = ../libraries/base/System/Console/GetOpt.$C \ ../libraries/base/Data/List.$C \ ../libraries/base/System/Cmd.$C \ ../libraries/base/System/Directory.$C \ ../libraries/base/System/Directory/Internals.$C \ ../libraries/base/Control/Monad.$C ifeq "$(findstring ghc, ${HC})" "ghc" HFLAGS = $(shell $(LOCAL)fixghc $(GHCSYM) -package base -package lang ) export HFLAGS endif ifeq "$(findstring hbc, ${HC})" "hbc" HFLAGS = export HFLAGS endif ifeq "$(findstring nhc98, ${HC})" "nhc98" HFLAGS = -package base +CTS -H4M -CTS export HFLAGS endif all: $(TARGET) install: $(TARGET) cfiles: cleanC $(SRCS) $(HMAKE) -hc=$(LOCAL)nhc98 -package base -C Main.hs clean: -rm -f *.hi *.o $(OBJDIR)/*.o cleanC: clean -rm -f *.hc *.c realclean: clean cleanC -rm -f $(OBJDIR)/Main$(EXE) $(TARGET): $(OBJDIR) $(SRCS) $(HMAKE) -hc=$(HC) Main -d$(OBJDIR) -DBUILD_NHC \ $(shell echo "${BUILDOPTS}") $(HFLAGS) $(CYGFLAG) mv $(OBJDIR)/Main$(EXE) $(TARGET) $(STRIP) $(TARGET) $(OBJDIR): mkdir -p $(OBJDIR) fromC: $(OBJDIR) cp $(FROMC) . $(LOCAL)nhc98 -cpp -o $(TARGET) -d$(OBJDIR) *.$C $(STRIP) $(TARGET) hugs98-plus-Sep2006/hsc2hs/LICENSE0000644006511100651110000000311310504340627015161 0ustar rossrossThe Glasgow Haskell Compiler License Copyright 2002, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hugs98-plus-Sep2006/hsc2hs/hsc2hs.cabal0000644006511100651110000000177510504340627016346 0ustar rossrossName: hsc2hs Version: 0.67 Copyright: 2000, Marcin Kowalczyk Build-Depends: base License: BSD3 License-File: LICENSE Author: Marcin Kowalczyk Maintainer: cvs-fptools@haskell.org Synopsis: A preprocessor that helps with writing Haskell bindings to C code Description: The hsc2hs program can be used to automate some parts of the process of writing Haskell bindings to C code. It reads an almost-Haskell source file with embedded special constructs, and outputs a real Haskell file with these constructs processed, based on information taken from some C headers. The extra constructs provide Haskell counterparts of C types, values of C constants, including sizes of C types, and access to fields of C structs. . For more details, see http://www.haskell.org/ghc/docs/latest/html/users_guide/hsc2hs.html Category: Development Data-Files: template-hsc.h Executable: hsc2hs Main-Is: Main.hs -- needed for ReadP (used by Data.Version) Hugs-Options: -98 Extensions: CPP, ForeignFunctionInterface hugs98-plus-Sep2006/hsc2hs/Setup.hs0000644006511100651110000000005610504340627015613 0ustar rossrossimport Distribution.Simple main = defaultMain hugs98-plus-Sep2006/configure0000755006511100651110000171627010504340733014707 0ustar rossross#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.60a for Hugs98 1.0. # # Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /usr/bin/posix$PATH_SEPARATOR/bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell autoconf@gnu.org about your system, echo including any error possibly output before this echo message } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='Hugs98' PACKAGE_TARNAME='hugs98' PACKAGE_VERSION='1.0' PACKAGE_STRING='Hugs98 1.0' PACKAGE_BUGREPORT='hugs-bugs@haskell.org' ac_unique_file="src/hugs.c" # Factoring default headers for most tests. ac_includes_default="\ #include #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_STAT_H # include #endif #ifdef STDC_HEADERS # include # include #else # ifdef HAVE_STDLIB_H # include # endif #endif #ifdef HAVE_STRING_H # if !defined STDC_HEADERS && defined HAVE_MEMORY_H # include # endif # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datarootdir datadir sysconfdir sharedstatedir localstatedir includedir oldincludedir docdir infodir htmldir dvidir pdfdir psdir libdir localedir mandir DEFS ECHO_C ECHO_N ECHO_T LIBS build_alias host_alias target_alias subdirs build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os HostPlatform BuildPlatform_CPP HostPlatform_CPP TargetPlatform_CPP BuildArch_CPP HostArch_CPP TargetArch_CPP BuildOS_CPP HostOS_CPP TargetOS_CPP YACC YFLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP GREP EGREP PTHREAD_CC PTHREAD_LIBS PTHREAD_CFLAGS RM CP LD PERL SET_MAKE have_hp2ps DOCBOOK2HTML DOCBOOK2DVI DOCBOOK2PDF DOCBOOK2PS DIFF CONTEXT_DIFF ALLOCA OPTFLAGS DEBUGFLAGS LDDEBUGFLAGS FFI_LIBRARIES HUGSPATH HUGSSUFFIXES hugsdir HUGSDIR BINDIR DLL DLL_ENDING DEV_NULL BAT WOBJECTS RC_FILES STRIP LIBOBJS LTLIBOBJS' ac_subst_files='MkInstall MkDepend' ac_precious_vars='build_alias host_alias target_alias YACC YFLAGS CC CFLAGS LDFLAGS CPPFLAGS CPP' ac_subdirs_all='libraries' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval enable_$ac_feature=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` eval with_$ac_package=\$ac_optarg ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval with_$ac_package=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute directory names. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { echo "$as_me: error: Working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$0" || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # 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 Hugs98 1.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/hugs98] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF System types: --build=BUILD configure for building on BUILD [guessed] --host=HOST cross-compile to build programs to run on HOST [BUILD] --target=TARGET configure for building compilers for TARGET [HOST] _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of Hugs98 1.0:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-path-canonicalization enable canonicalization of filenames --enable-timer enable evaluation timing (for benchmarking Hugs) --enable-profiling enable heap profiler --enable-stack-dumps enable stack dump on stack overflow --disable-large-banner disable multiline startup banner --enable-internal-prims experimental primitives to access Hugs's innards --enable-debug include C debugging information (for debugging Hugs) --enable-tag-checks runtime tag checking (for debugging Hugs) --enable-lint enable "lint" flags (for debugging Hugs) --enable-only98 build Hugs to understand Haskell 98 only --enable-ffi include modules that use the FFI [default=autodetect] --enable-char-encoding encode all character I/O using the byte encoding determined by the locale in effect at that time. To require that the UTF-8 encoding is always used, give the --enable-char-encoding=utf8 option. [default=autodetect] Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-nmake produce a Makefile compatible with nmake --with-gui build Hugs for Windows GUI (Borland C++ only) --with-pthreads build Hugs using POSIX threads C library Some influential environment variables: YACC The `Yet Another C Compiler' implementation to use. Defaults to the first program found out of: `bison -y', `byacc', `yacc'. YFLAGS The list of arguments that will be passed by default to $YACC. This script will default YFLAGS to the empty string to avoid a default value of `-d' given by some make applications. CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF Hugs98 configure 1.0 generated by GNU Autoconf 2.60a Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by Hugs98 $as_me 1.0, which was generated by GNU Autoconf 2.60a. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then set x "$CONFIG_SITE" elif test "x$prefix" != xNONE; then set x "$prefix/share/config.site" "$prefix/etc/config.site" else set x "$ac_default_prefix/share/config.site" \ "$ac_default_prefix/etc/config.site" fi shift for ac_site_file do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_aux_dir= for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do if test -f "$ac_dir/install-sh"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install-sh -c" break elif test -f "$ac_dir/install.sh"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install.sh -c" break elif test -f "$ac_dir/shtool"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/shtool install -c" break fi done if test -z "$ac_aux_dir"; then { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" >&5 echo "$as_me: error: cannot find install-sh or install.sh in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" >&2;} { (exit 1); exit 1; }; } fi # These three variables are undocumented and unsupported, # and are intended to be withdrawn in a future Autoconf release. # They can cause serious problems if a builder's source tree is in a directory # whose full name contains unusual characters. ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. subdirs="$subdirs libraries" ac_config_headers="$ac_config_headers src/config.h src/options.h" # Make sure we can run config.sub. $SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || { { echo "$as_me:$LINENO: error: cannot run $SHELL $ac_aux_dir/config.sub" >&5 echo "$as_me: error: cannot run $SHELL $ac_aux_dir/config.sub" >&2;} { (exit 1); exit 1; }; } { echo "$as_me:$LINENO: checking build system type" >&5 echo $ECHO_N "checking build system type... $ECHO_C" >&6; } if test "${ac_cv_build+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_build_alias=$build_alias test "x$ac_build_alias" = x && ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` test "x$ac_build_alias" = x && { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5 echo "$as_me: error: cannot guess build type; you must specify one" >&2;} { (exit 1); exit 1; }; } ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&5 echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&2;} { (exit 1); exit 1; }; } fi { echo "$as_me:$LINENO: result: $ac_cv_build" >&5 echo "${ECHO_T}$ac_cv_build" >&6; } case $ac_cv_build in *-*-*) ;; *) { { echo "$as_me:$LINENO: error: invalid value of canonical build" >&5 echo "$as_me: error: invalid value of canonical build" >&2;} { (exit 1); exit 1; }; };; esac build=$ac_cv_build ac_save_IFS=$IFS; IFS='-' set x $ac_cv_build shift build_cpu=$1 build_vendor=$2 shift; shift # Remember, the first character of IFS is used to create $*, # except with old shells: build_os=$* IFS=$ac_save_IFS case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac { echo "$as_me:$LINENO: checking host system type" >&5 echo $ECHO_N "checking host system type... $ECHO_C" >&6; } if test "${ac_cv_host+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "x$host_alias" = x; then ac_cv_host=$ac_cv_build else ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&5 echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&2;} { (exit 1); exit 1; }; } fi fi { echo "$as_me:$LINENO: result: $ac_cv_host" >&5 echo "${ECHO_T}$ac_cv_host" >&6; } case $ac_cv_host in *-*-*) ;; *) { { echo "$as_me:$LINENO: error: invalid value of canonical host" >&5 echo "$as_me: error: invalid value of canonical host" >&2;} { (exit 1); exit 1; }; };; esac host=$ac_cv_host ac_save_IFS=$IFS; IFS='-' set x $ac_cv_host shift host_cpu=$1 host_vendor=$2 shift; shift # Remember, the first character of IFS is used to create $*, # except with old shells: host_os=$* IFS=$ac_save_IFS case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac { echo "$as_me:$LINENO: checking target system type" >&5 echo $ECHO_N "checking target system type... $ECHO_C" >&6; } if test "${ac_cv_target+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "x$target_alias" = x; then ac_cv_target=$ac_cv_host else ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` || { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $target_alias failed" >&5 echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $target_alias failed" >&2;} { (exit 1); exit 1; }; } fi fi { echo "$as_me:$LINENO: result: $ac_cv_target" >&5 echo "${ECHO_T}$ac_cv_target" >&6; } case $ac_cv_target in *-*-*) ;; *) { { echo "$as_me:$LINENO: error: invalid value of canonical target" >&5 echo "$as_me: error: invalid value of canonical target" >&2;} { (exit 1); exit 1; }; };; esac target=$ac_cv_target ac_save_IFS=$IFS; IFS='-' set x $ac_cv_target shift target_cpu=$1 target_vendor=$2 shift; shift # Remember, the first character of IFS is used to create $*, # except with old shells: target_os=$* IFS=$ac_save_IFS case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac # The aliases save the names the user supplied, while $host etc. # will get canonicalized. test -n "$target_alias" && test "$program_prefix$program_suffix$program_transform_name" = \ NONENONEs,x,x, && program_prefix=${target_alias}- BuildPlatform=`./fp-platform $build` HostPlatform=`./fp-platform $host` TargetPlatform=`./fp-platform $target` if test x"$HostPlatform" != x"$BuildPlatform" ; then { { echo "$as_me:$LINENO: error: Hugs98 does not yet support differing build/host (i.e., cross-compiling)" >&5 echo "$as_me: error: Hugs98 does not yet support differing build/host (i.e., cross-compiling)" >&2;} { (exit 1); exit 1; }; } fi fp_get_cpu='s/-.*//' fp_get_os='s/^[^-]*-[^-]*-\([^-]*\).*/\1/' build_cpu=`echo $BuildPlatform | sed "$fp_get_cpu"` build_os=`echo $BuildPlatform | sed "$fp_get_os"` host_cpu=`echo $HostPlatform | sed "$fp_get_cpu"` host_os=`echo $HostPlatform | sed "$fp_get_os"` target_cpu=`echo $TargetPlatform | sed "$fp_get_cpu"` target_os=`echo $TargetPlatform | sed "$fp_get_os"` # We don't use AS_TR_CPP here, because it changes case too. fp_tr_cpp="sed s/[^_a-zA-Z0-9]/_/g" BuildPlatform_CPP=`echo $BuildPlatform | $fp_tr_cpp` HostPlatform_CPP=`echo $HostPlatform | $fp_tr_cpp` TargetPlatform_CPP=`echo $TargetPlatform | $fp_tr_cpp` BuildArch_CPP=`echo $build_cpu | $fp_tr_cpp` HostArch_CPP=`echo $host_cpu | $fp_tr_cpp` TargetArch_CPP=`echo $target_cpu | $fp_tr_cpp` BuildOS_CPP=`echo $build_os | $fp_tr_cpp` HostOS_CPP=`echo $host_os | $fp_tr_cpp` TargetOS_CPP=`echo $target_os | $fp_tr_cpp` # Check whether --enable-path-canonicalization was given. if test "${enable_path_canonicalization+set}" = set; then enableval=$enable_path_canonicalization; if test "$enableval" = yes; then cat >>confdefs.h <<\_ACEOF #define PATH_CANONICALIZATION 1 _ACEOF fi fi # Check whether --enable-timer was given. if test "${enable_timer+set}" = set; then enableval=$enable_timer; fi # Check whether --enable-profiling was given. if test "${enable_profiling+set}" = set; then enableval=$enable_profiling; if test "$enableval" = yes; then cat >>confdefs.h <<\_ACEOF #define PROFILING 1 _ACEOF fi fi # Check whether --enable-stack-dumps was given. if test "${enable_stack_dumps+set}" = set; then enableval=$enable_stack_dumps; if test "$enableval" = yes; then cat >>confdefs.h <<\_ACEOF #define GIMME_STACK_DUMPS 1 _ACEOF fi fi # Check whether --with-nmake was given. if test "${with_nmake+set}" = set; then withval=$with_nmake; if test "$withval" = yes; then RM="del";CP="copy"; fi fi # Check whether --enable-large-banner was given. if test "${enable_large_banner+set}" = set; then enableval=$enable_large_banner; if test "$enableval" = no; then cat >>confdefs.h <<\_ACEOF #define SMALL_BANNER 1 _ACEOF fi fi # Check whether --with-gui was given. if test "${with_gui+set}" = set; then withval=$with_gui; fi # Check whether --enable-internal-prims was given. if test "${enable_internal_prims+set}" = set; then enableval=$enable_internal_prims; if test "$enableval" = yes; then cat >>confdefs.h <<\_ACEOF #define INTERNAL_PRIMS 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define BYTECODE_PRIMS 1 _ACEOF fi fi # Check whether --enable-debug was given. if test "${enable_debug+set}" = set; then enableval=$enable_debug; if test "$enableval" = yes; then cat >>confdefs.h <<\_ACEOF #define DEBUG_CODE 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define DEBUG_PRINTER 1 _ACEOF fi fi # Check whether --enable-tag-checks was given. if test "${enable_tag_checks+set}" = set; then enableval=$enable_tag_checks; if test "$enableval" = yes; then cat >>confdefs.h <<\_ACEOF #define CHECK_TAGS 1 _ACEOF fi fi # Check whether --enable-lint was given. if test "${enable_lint+set}" = set; then enableval=$enable_lint; fi # Check whether --enable-only98 was given. if test "${enable_only98+set}" = set; then enableval=$enable_only98; if test "$enableval" = yes; then cat >>confdefs.h <<\_ACEOF #define HASKELL_98_ONLY 1 _ACEOF fi fi # Check whether --with-pthreads was given. if test "${with_pthreads+set}" = set; then withval=$with_pthreads; if test "$withval" = yes; then # needed with pthreads cat >>confdefs.h <<\_ACEOF #define DONT_PANIC 1 _ACEOF fi fi # Check whether --enable-ffi was given. if test "${enable_ffi+set}" = set; then enableval=$enable_ffi; else enable_ffi=autodetect fi # Check whether --enable-char-encoding was given. if test "${enable_char_encoding+set}" = set; then enableval=$enable_char_encoding; else enable_char_encoding=autodetect fi for ac_prog in 'bison -y' byacc do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_YACC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$YACC"; then ac_cv_prog_YACC="$YACC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_YACC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi YACC=$ac_cv_prog_YACC if test -n "$YACC"; then { echo "$as_me:$LINENO: result: $YACC" >&5 echo "${ECHO_T}$YACC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$YACC" && break done test -n "$YACC" || YACC="yacc" if test x"`basename ${YACC}`" = x"byacc"; then { { echo "$as_me:$LINENO: error: Found 'byacc', but the Hugs98 parser is incompatible with it. You need to install 'bison' and re-run the configure script." >&5 echo "$as_me: error: Found 'byacc', but the Hugs98 parser is incompatible with it. You need to install 'bison' and re-run the configure script." >&2;} { (exit 1); exit 1; }; } fi : ${CFLAGS=-g} OPTFLAGS="-O2" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO: checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; } ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # # List of possible output files, starting from the most likely. # The algorithm is not robust to junk in `.', hence go to wildcards (a.*) # only as a last resort. b.out is created by i960 compilers. ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' # # The IRIX 6 linker writes into existing files which may not be # executable, retaining their permissions. Remove them first so a # subsequent execution test works. ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { (ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi { echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6; } if test -z "$ac_file"; then echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } { echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6; } { echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext { echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT { echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; } if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; } GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 CFLAGS="" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } if test "${ac_cv_prog_cc_c89+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_c89=$ac_arg else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6; } ;; xno) { echo "$as_me:$LINENO: result: unsupported" >&5 echo "${ECHO_T}unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; esac ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Extract the first word of "grep ggrep" to use in msg output if test -z "$GREP"; then set dummy grep ggrep; ac_prog_name=$2 if test "${ac_cv_path_GREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_GREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_GREP" && $as_executable_p "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_GREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_GREP_found && break 3 done done done IFS=$as_save_IFS fi GREP="$ac_cv_path_GREP" if test -z "$GREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_GREP=$GREP fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 echo "${ECHO_T}$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" { echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6; } if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else # Extract the first word of "egrep" to use in msg output if test -z "$EGREP"; then set dummy egrep; ac_prog_name=$2 if test "${ac_cv_path_EGREP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_path_EGREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" { test -f "$ac_path_EGREP" && $as_executable_p "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" echo 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ac_count=`expr $ac_count + 1` if test $ac_count -gt ${ac_path_EGREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_found && break 3 done done done IFS=$as_save_IFS fi EGREP="$ac_cv_path_EGREP" if test -z "$EGREP"; then { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} { (exit 1); exit 1; }; } fi else ac_cv_path_EGREP=$EGREP fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 echo "${ECHO_T}$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" if test $ac_cv_c_compiler_gnu = yes; then { echo "$as_me:$LINENO: checking whether $CC needs -traditional" >&5 echo $ECHO_N "checking whether $CC needs -traditional... $ECHO_C" >&6; } if test "${ac_cv_prog_gcc_traditional+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_pattern="Autoconf.*'x'" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include Autoconf TIOCGETP _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "$ac_pattern" >/dev/null 2>&1; then ac_cv_prog_gcc_traditional=yes else ac_cv_prog_gcc_traditional=no fi rm -f conftest* if test $ac_cv_prog_gcc_traditional = no; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include Autoconf TCGETA _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "$ac_pattern" >/dev/null 2>&1; then ac_cv_prog_gcc_traditional=yes fi rm -f conftest* fi fi { echo "$as_me:$LINENO: result: $ac_cv_prog_gcc_traditional" >&5 echo "${ECHO_T}$ac_cv_prog_gcc_traditional" >&6; } if test $ac_cv_prog_gcc_traditional = yes; then CC="$CC -traditional" fi fi if test "$with_pthreads" = yes; then ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu acx_pthread_ok=no # We used to check for pthread.h first, but this fails if pthread.h # requires special compiler flags (e.g. on True64 or Sequent). # It gets checked for in the link test anyway. # First of all, check if the user has set any of the PTHREAD_LIBS, # etcetera environment variables, and if threads linking works using # them: if test x"$PTHREAD_LIBS$PTHREAD_CFLAGS" != x; then save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS $PTHREAD_CFLAGS" save_LIBS="$LIBS" LIBS="$PTHREAD_LIBS $LIBS" { echo "$as_me:$LINENO: checking for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS" >&5 echo $ECHO_N "checking for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char pthread_join (); int main () { return pthread_join (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then acx_pthread_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext { echo "$as_me:$LINENO: result: $acx_pthread_ok" >&5 echo "${ECHO_T}$acx_pthread_ok" >&6; } if test x"$acx_pthread_ok" = xno; then PTHREAD_LIBS="" PTHREAD_CFLAGS="" fi LIBS="$save_LIBS" CFLAGS="$save_CFLAGS" fi # We must check for the threads library under a number of different # names; the ordering is very important because some systems # (e.g. DEC) have both -lpthread and -lpthreads, where one of the # libraries is broken (non-POSIX). # Create a list of thread flags to try. Items starting with a "-" are # C compiler flags, and other items are library names, except for "none" # which indicates that we try without any flags at all. acx_pthread_flags="pthreads none -Kthread -kthread lthread -pthread -pthreads -mthreads pthread --thread-safe -mt" # The ordering *is* (sometimes) important. Some notes on the # individual items follow: # pthreads: AIX (must check this before -lpthread) # none: in case threads are in libc; should be tried before -Kthread and # other compiler flags to prevent continual compiler warnings # -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h) # -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able) # lthread: LinuxThreads port on FreeBSD (also preferred to -pthread) # -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads) # -pthreads: Solaris/gcc # -mthreads: Mingw32/gcc, Lynx/gcc # -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it # doesn't hurt to check since this sometimes defines pthreads too; # also defines -D_REENTRANT) # pthread: Linux, etcetera # --thread-safe: KAI C++ case "${host_cpu}-${host_os}" in *solaris*) # On Solaris (at least, for some versions), libc contains stubbed # (non-functional) versions of the pthreads routines, so link-based # tests will erroneously succeed. (We need to link with -pthread or # -lpthread.) (The stubs are missing pthread_cleanup_push, or rather # a function called by this macro, so we could check for that, but # who knows whether they'll stub that too in a future libc.) So, # we'll just look for -pthreads and -lpthread first: acx_pthread_flags="-pthread -pthreads pthread -mt $acx_pthread_flags" ;; esac if test x"$acx_pthread_ok" = xno; then for flag in $acx_pthread_flags; do case $flag in none) { echo "$as_me:$LINENO: checking whether pthreads work without any flags" >&5 echo $ECHO_N "checking whether pthreads work without any flags... $ECHO_C" >&6; } ;; -*) { echo "$as_me:$LINENO: checking whether pthreads work with $flag" >&5 echo $ECHO_N "checking whether pthreads work with $flag... $ECHO_C" >&6; } PTHREAD_CFLAGS="$flag" ;; *) { echo "$as_me:$LINENO: checking for the pthreads library -l$flag" >&5 echo $ECHO_N "checking for the pthreads library -l$flag... $ECHO_C" >&6; } PTHREAD_LIBS="-l$flag" ;; esac save_LIBS="$LIBS" save_CFLAGS="$CFLAGS" LIBS="$PTHREAD_LIBS $LIBS" CFLAGS="$CFLAGS $PTHREAD_CFLAGS" # Check for various functions. We must include pthread.h, # since some functions may be macros. (On the Sequent, we # need a special flag -Kthread to make this header compile.) # We check for pthread_join because it is in -lpthread on IRIX # while pthread_create is in libc. We check for pthread_attr_init # due to DEC craziness with -lpthreads. We check for # pthread_cleanup_push because it is one of the few pthread # functions on Solaris that doesn't have a non-functional libc stub. # We try pthread_create on general principles. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { pthread_t th; pthread_join(th, 0); pthread_attr_init(0); pthread_cleanup_push(0, 0); pthread_create(0,0,0,0); pthread_cleanup_pop(0); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then acx_pthread_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS="$save_LIBS" CFLAGS="$save_CFLAGS" { echo "$as_me:$LINENO: result: $acx_pthread_ok" >&5 echo "${ECHO_T}$acx_pthread_ok" >&6; } if test "x$acx_pthread_ok" = xyes; then break; fi PTHREAD_LIBS="" PTHREAD_CFLAGS="" done fi # Various other checks: if test "x$acx_pthread_ok" = xyes; then save_LIBS="$LIBS" LIBS="$PTHREAD_LIBS $LIBS" save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS $PTHREAD_CFLAGS" # Detect AIX lossage: threads are created detached by default # and the JOINABLE attribute has a nonstandard name (UNDETACHED). { echo "$as_me:$LINENO: checking for joinable pthread attribute" >&5 echo $ECHO_N "checking for joinable pthread attribute... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { int attr=PTHREAD_CREATE_JOINABLE; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ok=PTHREAD_CREATE_JOINABLE else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ok=unknown fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext if test x"$ok" = xunknown; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { int attr=PTHREAD_CREATE_UNDETACHED; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ok=PTHREAD_CREATE_UNDETACHED else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ok=unknown fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi if test x"$ok" != xPTHREAD_CREATE_JOINABLE; then cat >>confdefs.h <<\_ACEOF #define PTHREAD_CREATE_JOINABLE $ok _ACEOF fi { echo "$as_me:$LINENO: result: ${ok}" >&5 echo "${ECHO_T}${ok}" >&6; } if test x"$ok" = xunknown; then { echo "$as_me:$LINENO: WARNING: we do not know how to create joinable pthreads" >&5 echo "$as_me: WARNING: we do not know how to create joinable pthreads" >&2;} fi { echo "$as_me:$LINENO: checking if more special flags are required for pthreads" >&5 echo $ECHO_N "checking if more special flags are required for pthreads... $ECHO_C" >&6; } flag=no case "${host_cpu}-${host_os}" in *-aix* | *-freebsd*) flag="-D_THREAD_SAFE";; *solaris* | *-osf* | *-hpux*) flag="-D_REENTRANT";; esac { echo "$as_me:$LINENO: result: ${flag}" >&5 echo "${ECHO_T}${flag}" >&6; } if test "x$flag" != xno; then PTHREAD_CFLAGS="$flag $PTHREAD_CFLAGS" fi LIBS="$save_LIBS" CFLAGS="$save_CFLAGS" # More AIX lossage: must compile with cc_r # Extract the first word of "cc_r", so it can be a program name with args. set dummy cc_r; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_PTHREAD_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$PTHREAD_CC"; then ac_cv_prog_PTHREAD_CC="$PTHREAD_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_PTHREAD_CC="cc_r" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_PTHREAD_CC" && ac_cv_prog_PTHREAD_CC="${CC}" fi fi PTHREAD_CC=$ac_cv_prog_PTHREAD_CC if test -n "$PTHREAD_CC"; then { echo "$as_me:$LINENO: result: $PTHREAD_CC" >&5 echo "${ECHO_T}$PTHREAD_CC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi else PTHREAD_CC="$CC" fi # Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: if test x"$acx_pthread_ok" = xyes; then cat >>confdefs.h <<\_ACEOF #define HAVE_PTHREAD 1 _ACEOF : else acx_pthread_ok=no fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LIBS="$PTHREAD_LIBS $LIBS" CC="$PTHREAD_CC" fi case $HostPlatform in *-*-darwin*) CFLAGS="$CFLAGS -no-cpp-precomp" LDFLAGS="$LDFLAGS -flat_namespace" ;; # As suggested by James B. White III (Trey) (for # AIX 4.3.3 & XL C 5.0.2 at least, may need to tweak the pattern match # below some to avoid upsetting other AIX versions). *-*-aix*) optcflags="-qalloca" CFLAGS_save="$CFLAGS" CFLAGS="$CFLAGS $optcflags" { echo "$as_me:$LINENO: checking whether $CC accepts $optcflags" >&5 echo $ECHO_N "checking whether $CC accepts $optcflags... $ECHO_C" >&6; } ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int main(){return(0);} ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then optok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 optok=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext if test "$optok" = "yes"; then # lump the recognition of -qalloca together with -qmaxmem=-1 and -bmaxdata.. CFLAGS="$CFLAGS_save $optcflags" LDFLAGS="$LDFLAGS -bmaxdata:0x70000000"; OPTFLAGS="-O -qmaxmem=-1" { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } else CFLAGS="$CFLAGS_save" { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi ;; esac if test "x$CP" != "xcopy"; then # Only check for RM&CP if they haven't been overridden already (cf. --with-nmake) # Extract the first word of "rm", so it can be a program name with args. set dummy rm; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_path_RM+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $RM in [\\/]* | ?:[\\/]*) ac_cv_path_RM="$RM" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_RM="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi RM=$ac_cv_path_RM if test -n "$RM"; then { echo "$as_me:$LINENO: result: $RM" >&5 echo "${ECHO_T}$RM" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi RM="$RM -f" # Extract the first word of "cp", so it can be a program name with args. set dummy cp; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_path_CP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $CP in [\\/]* | ?:[\\/]*) ac_cv_path_CP="$CP" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_CP="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CP=$ac_cv_path_CP if test -n "$CP"; then { echo "$as_me:$LINENO: result: $CP" >&5 echo "${ECHO_T}$CP" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi # Extract the first word of "ld", so it can be a program name with args. set dummy ld; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_LD+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$LD"; then ac_cv_prog_LD="$LD" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_LD="ld" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi LD=$ac_cv_prog_LD if test -n "$LD"; then { echo "$as_me:$LINENO: result: $LD" >&5 echo "${ECHO_T}$LD" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi for ac_prog in perl do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_PERL+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$PERL"; then ac_cv_prog_PERL="$PERL" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_PERL="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi PERL=$ac_cv_prog_PERL if test -n "$PERL"; then { echo "$as_me:$LINENO: result: $PERL" >&5 echo "${ECHO_T}$PERL" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$PERL" && break done { echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6; } set x ${MAKE-make}; ac_make=`echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.make <<\_ACEOF SHELL = /bin/sh all: @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. case `${MAKE-make} -f conftest.make 2>/dev/null` in *@@@%%%=?*=@@@%%%*) eval ac_cv_prog_make_${ac_make}_set=yes;; *) eval ac_cv_prog_make_${ac_make}_set=no;; esac rm -f conftest.make fi if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } SET_MAKE= else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } SET_MAKE="MAKE=${MAKE-make}" fi # Extract the first word of "hp2ps", so it can be a program name with args. set dummy hp2ps; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_have_hp2ps+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$have_hp2ps"; then ac_cv_prog_have_hp2ps="$have_hp2ps" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_have_hp2ps="1" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_have_hp2ps" && ac_cv_prog_have_hp2ps="0" fi fi have_hp2ps=$ac_cv_prog_have_hp2ps if test -n "$have_hp2ps"; then { echo "$as_me:$LINENO: result: $have_hp2ps" >&5 echo "${ECHO_T}$have_hp2ps" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "$have_hp2ps" = "1"; then cat >>confdefs.h <<\_ACEOF #define HAVE_HP2PS 1 _ACEOF fi for ac_prog in docbook2html db2html do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_DOCBOOK2HTML+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$DOCBOOK2HTML"; then ac_cv_prog_DOCBOOK2HTML="$DOCBOOK2HTML" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_DOCBOOK2HTML="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi DOCBOOK2HTML=$ac_cv_prog_DOCBOOK2HTML if test -n "$DOCBOOK2HTML"; then { echo "$as_me:$LINENO: result: $DOCBOOK2HTML" >&5 echo "${ECHO_T}$DOCBOOK2HTML" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$DOCBOOK2HTML" && break done for ac_prog in docbook2dvi db2dvi do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_DOCBOOK2DVI+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$DOCBOOK2DVI"; then ac_cv_prog_DOCBOOK2DVI="$DOCBOOK2DVI" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_DOCBOOK2DVI="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi DOCBOOK2DVI=$ac_cv_prog_DOCBOOK2DVI if test -n "$DOCBOOK2DVI"; then { echo "$as_me:$LINENO: result: $DOCBOOK2DVI" >&5 echo "${ECHO_T}$DOCBOOK2DVI" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$DOCBOOK2DVI" && break done for ac_prog in docbook2pdf db2pdf do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_DOCBOOK2PDF+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$DOCBOOK2PDF"; then ac_cv_prog_DOCBOOK2PDF="$DOCBOOK2PDF" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_DOCBOOK2PDF="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi DOCBOOK2PDF=$ac_cv_prog_DOCBOOK2PDF if test -n "$DOCBOOK2PDF"; then { echo "$as_me:$LINENO: result: $DOCBOOK2PDF" >&5 echo "${ECHO_T}$DOCBOOK2PDF" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$DOCBOOK2PDF" && break done for ac_prog in docbook2ps db2ps do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_DOCBOOK2PS+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$DOCBOOK2PS"; then ac_cv_prog_DOCBOOK2PS="$DOCBOOK2PS" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_DOCBOOK2PS="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi DOCBOOK2PS=$ac_cv_prog_DOCBOOK2PS if test -n "$DOCBOOK2PS"; then { echo "$as_me:$LINENO: result: $DOCBOOK2PS" >&5 echo "${ECHO_T}$DOCBOOK2PS" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$DOCBOOK2PS" && break done # Extract the first word of "diff", so it can be a program name with args. set dummy diff; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_path_DIFF+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $DIFF in [\\/]* | ?:[\\/]*) ac_cv_path_DIFF="$DIFF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_DIFF="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi DIFF=$ac_cv_path_DIFF if test -n "$DIFF"; then { echo "$as_me:$LINENO: result: $DIFF" >&5 echo "${ECHO_T}$DIFF" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi { echo "$as_me:$LINENO: checking whether to use \"diff -c1\" or \"diff -C 1\"" >&5 echo $ECHO_N "checking whether to use \"diff -c1\" or \"diff -C 1\"... $ECHO_C" >&6; } if test "${CONTEXT_DIFF+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if { ac_try='diff -C 1 config.log config.log' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then CONTEXT_DIFF="$DIFF -C 1" else if { ac_try='diff -c1 config.log config.log' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then CONTEXT_DIFF="$DIFF -c1" else CONTEXT_DIFF="$DIFF" fi fi fi { echo "$as_me:$LINENO: result: $CONTEXT_DIFF" >&5 echo "${ECHO_T}$CONTEXT_DIFF" >&6; } cat >>confdefs.h <<\_ACEOF #define HAVE_BIN_SH 1 _ACEOF { echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5 echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6; } if test "${ac_cv_lib_dl_dlopen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char dlopen (); int main () { return dlopen (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dl_dlopen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dl_dlopen=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5 echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6; } if test $ac_cv_lib_dl_dlopen = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBDL 1 _ACEOF LIBS="-ldl $LIBS" fi { echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6; } if test "${ac_cv_lib_dld_shl_load+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char shl_load (); int main () { return shl_load (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dld_shl_load=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dld_shl_load=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6; } if test $ac_cv_lib_dld_shl_load = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBDLD 1 _ACEOF LIBS="-ldld $LIBS" fi { echo "$as_me:$LINENO: checking for atan in -lm" >&5 echo $ECHO_N "checking for atan in -lm... $ECHO_C" >&6; } if test "${ac_cv_lib_m_atan+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char atan (); int main () { return atan (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_atan=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_atan=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_m_atan" >&5 echo "${ECHO_T}$ac_cv_lib_m_atan" >&6; } if test $ac_cv_lib_m_atan = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" fi { echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) return 2; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi { echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi { echo "$as_me:$LINENO: checking for sys/wait.h that is POSIX.1 compatible" >&5 echo $ECHO_N "checking for sys/wait.h that is POSIX.1 compatible... $ECHO_C" >&6; } if test "${ac_cv_header_sys_wait_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #ifndef WEXITSTATUS # define WEXITSTATUS(stat_val) ((unsigned int) (stat_val) >> 8) #endif #ifndef WIFEXITED # define WIFEXITED(stat_val) (((stat_val) & 255) == 0) #endif int main () { int s; wait (&s); s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_sys_wait_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_sys_wait_h=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5 echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6; } if test $ac_cv_header_sys_wait_h = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_SYS_WAIT_H 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in stdarg.h stdlib.h unistd.h assert.h ctype.h string.h limits.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in fcntl.h sgtty.h termio.h termios.h signal.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in sys/types.h sys/stat.h sys/ioctl.h sys/resource.h sys/param.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in console.h Files.h errno.h stat.h direct.h dirent.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6; } if test "${ac_cv_header_time+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include int main () { if ((struct tm *) 0) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_time=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_time=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 echo "${ECHO_T}$ac_cv_header_time" >&6; } if test $ac_cv_header_time = yes; then cat >>confdefs.h <<\_ACEOF #define TIME_WITH_SYS_TIME 1 _ACEOF fi for ac_header in time.h sys/time.h sys/timeb.h sys/times.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in float.h values.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in dos.h conio.h io.h std.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in windows.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done for ac_header in dlfcn.h dl.h mach-o/dyld.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF break fi done if test "${ac_cv_header_alloc_h+set}" = set; then { echo "$as_me:$LINENO: checking for alloc.h" >&5 echo $ECHO_N "checking for alloc.h... $ECHO_C" >&6; } if test "${ac_cv_header_alloc_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi { echo "$as_me:$LINENO: result: $ac_cv_header_alloc_h" >&5 echo "${ECHO_T}$ac_cv_header_alloc_h" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking alloc.h usability" >&5 echo $ECHO_N "checking alloc.h usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking alloc.h presence" >&5 echo $ECHO_N "checking alloc.h presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: alloc.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: alloc.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: alloc.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: alloc.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: alloc.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: alloc.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: alloc.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: alloc.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: alloc.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: alloc.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: alloc.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: alloc.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: alloc.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: alloc.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: alloc.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: alloc.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for alloc.h" >&5 echo $ECHO_N "checking for alloc.h... $ECHO_C" >&6; } if test "${ac_cv_header_alloc_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_alloc_h=$ac_header_preproc fi { echo "$as_me:$LINENO: result: $ac_cv_header_alloc_h" >&5 echo "${ECHO_T}$ac_cv_header_alloc_h" >&6; } fi if test $ac_cv_header_alloc_h = yes; then for ac_func in farcalloc do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done fi if test "${ac_cv_header_stdlib_h+set}" = set || test "${ac_cv_header_unistd_h+set}" = set; then for ac_func in valloc do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done fi for ac_header in locale.h wchar.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done if test "x$host_os" = "xmingw32"; then wchar_t_is_unicode=yes # actually UTF-16 elif test "${ac_cv_header_wchar_h+set}" = set; then { echo "$as_me:$LINENO: checking whether wchar_t is ISO 10646 (Unicode)" >&5 echo $ECHO_N "checking whether wchar_t is ISO 10646 (Unicode)... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #ifndef __STDC_ISO_10646__ # error __STDC_ISO_10646__ not defined #endif int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then wchar_t_is_unicode=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 wchar_t_is_unicode=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $wchar_t_is_unicode" >&5 echo "${ECHO_T}$wchar_t_is_unicode" >&6; } else wchar_t_is_unicode=no fi { echo "$as_me:$LINENO: checking for locale-based character encoding" >&5 echo $ECHO_N "checking for locale-based character encoding... $ECHO_C" >&6; } if test "${ac_cv_header_locale_h+set}" = set && test "$wchar_t_is_unicode" = yes; then locale_char_encoding=yes else locale_char_encoding=no fi { echo "$as_me:$LINENO: result: $locale_char_encoding" >&5 echo "${ECHO_T}$locale_char_encoding" >&6; } case $enable_char_encoding in locale|yes) if test "$locale_char_encoding" = yes; then enable_char_encoding=locale else { { echo "$as_me:$LINENO: error: System does not support locale-based encoding of Unicode." >&5 echo "$as_me: error: System does not support locale-based encoding of Unicode." >&2;} { (exit 1); exit 1; }; } enable_char_encoding=no fi ;; autodetect) if test "$locale_char_encoding" = yes; then enable_char_encoding=locale fi ;; esac case $enable_char_encoding in locale) cat >>confdefs.h <<\_ACEOF #define CHAR_ENCODING_LOCALE 1 _ACEOF ;; utf8) cat >>confdefs.h <<\_ACEOF #define CHAR_ENCODING_UTF8 1 _ACEOF ;; esac { echo "$as_me:$LINENO: checking for library containing wcrtomb" >&5 echo $ECHO_N "checking for library containing wcrtomb... $ECHO_C" >&6; } if test "${ac_cv_search_wcrtomb+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_func_search_save_LIBS=$LIBS cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char wcrtomb (); int main () { return wcrtomb (); ; return 0; } _ACEOF for ac_lib in '' msvcp60; do if test -z "$ac_lib"; then ac_res="none required" else ac_res=-l$ac_lib LIBS="-l$ac_lib $ac_func_search_save_LIBS" fi rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_search_wcrtomb=$ac_res else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext if test "${ac_cv_search_wcrtomb+set}" = set; then break fi done if test "${ac_cv_search_wcrtomb+set}" = set; then : else ac_cv_search_wcrtomb=no fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_search_wcrtomb" >&5 echo "${ECHO_T}$ac_cv_search_wcrtomb" >&6; } ac_res=$ac_cv_search_wcrtomb if test "$ac_res" != no; then test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" fi { echo "$as_me:$LINENO: checking for WinExec" >&5 echo $ECHO_N "checking for WinExec... $ECHO_C" >&6; } if test "${fp_cv_func_WinExec+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { WinExec("",0) ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_func_WinExec=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fp_cv_func_WinExec=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $fp_cv_func_WinExec" >&5 echo "${ECHO_T}$fp_cv_func_WinExec" >&6; } if test $fp_cv_func_WinExec = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_WINEXEC 1 _ACEOF fi { echo "$as_me:$LINENO: checking for GetModuleFileName" >&5 echo $ECHO_N "checking for GetModuleFileName... $ECHO_C" >&6; } if test "${fp_cv_func_GetModuleFileName+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { GetModuleFileName((HMODULE)0,(LPTSTR)0,0) ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_func_GetModuleFileName=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fp_cv_func_GetModuleFileName=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $fp_cv_func_GetModuleFileName" >&5 echo "${ECHO_T}$fp_cv_func_GetModuleFileName" >&6; } if test $fp_cv_func_GetModuleFileName = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_GETMODULEFILENAME 1 _ACEOF fi for ac_func in atan do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define FLOATS_SUPPORTED 1 _ACEOF fi done for ac_func in strcasecmp _stricmp stricmp strcmpi do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in strcmp do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in rindex do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in strrchr do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in realpath _fullpath do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in macsystem do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in fseek ftell do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in vsnprintf _vsnprintf do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in snprintf _snprintf do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in popen _popen do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in pclose _pclose do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in sigprocmask do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in getrusage do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in times do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in isatty do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in fstat do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in select do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in gettimeofday do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in ftime do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in time do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in localtime do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in gmtime do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in mktime do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done for ac_func in dup do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking whether struct tm is in sys/time.h or time.h" >&5 echo $ECHO_N "checking whether struct tm is in sys/time.h or time.h... $ECHO_C" >&6; } if test "${ac_cv_struct_tm+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { struct tm *tp; tp->tm_sec; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_struct_tm=time.h else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_struct_tm=sys/time.h fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_struct_tm" >&5 echo "${ECHO_T}$ac_cv_struct_tm" >&6; } if test $ac_cv_struct_tm = sys/time.h; then cat >>confdefs.h <<\_ACEOF #define TM_IN_SYS_TIME 1 _ACEOF fi { echo "$as_me:$LINENO: checking for struct tm.tm_zone" >&5 echo $ECHO_N "checking for struct tm.tm_zone... $ECHO_C" >&6; } if test "${ac_cv_member_struct_tm_tm_zone+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include <$ac_cv_struct_tm> int main () { static struct tm ac_aggr; if (ac_aggr.tm_zone) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_tm_tm_zone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include <$ac_cv_struct_tm> int main () { static struct tm ac_aggr; if (sizeof ac_aggr.tm_zone) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_member_struct_tm_tm_zone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_member_struct_tm_tm_zone=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_member_struct_tm_tm_zone" >&5 echo "${ECHO_T}$ac_cv_member_struct_tm_tm_zone" >&6; } if test $ac_cv_member_struct_tm_tm_zone = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_TM_TM_ZONE 1 _ACEOF fi if test "$ac_cv_member_struct_tm_tm_zone" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_TM_ZONE 1 _ACEOF else { echo "$as_me:$LINENO: checking whether tzname is declared" >&5 echo $ECHO_N "checking whether tzname is declared... $ECHO_C" >&6; } if test "${ac_cv_have_decl_tzname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { #ifndef tzname char *p = (char *) tzname; return !p; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_tzname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_tzname=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_have_decl_tzname" >&5 echo "${ECHO_T}$ac_cv_have_decl_tzname" >&6; } if test $ac_cv_have_decl_tzname = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_TZNAME 1 _ACEOF else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_TZNAME 0 _ACEOF fi { echo "$as_me:$LINENO: checking for tzname" >&5 echo $ECHO_N "checking for tzname... $ECHO_C" >&6; } if test "${ac_cv_var_tzname+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #if !HAVE_DECL_TZNAME extern char *tzname[]; #endif int main () { return tzname[0][0]; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_var_tzname=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_var_tzname=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_var_tzname" >&5 echo "${ECHO_T}$ac_cv_var_tzname" >&6; } if test $ac_cv_var_tzname = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_TZNAME 1 _ACEOF fi fi for ac_header in sys/time.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } else # Is the header compilable? { echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6; } # Is the header present? { echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext { echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6; } # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ------------------------------------ ## ## Report this to hugs-bugs@haskell.org ## ## ------------------------------------ ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi ac_res=`eval echo '${'$as_ac_Header'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking whether timezone is declared" >&5 echo $ECHO_N "checking whether timezone is declared... $ECHO_C" >&6; } if test "${ac_cv_have_decl_timezone+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif int main () { #ifndef timezone char *p = (char *) timezone; return !p; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_timezone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_timezone=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_have_decl_timezone" >&5 echo "${ECHO_T}$ac_cv_have_decl_timezone" >&6; } if test $ac_cv_have_decl_timezone = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_TIMEZONE 1 _ACEOF else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_TIMEZONE 0 _ACEOF fi { echo "$as_me:$LINENO: checking whether _timezone is declared" >&5 echo $ECHO_N "checking whether _timezone is declared... $ECHO_C" >&6; } if test "${ac_cv_have_decl__timezone+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif int main () { #ifndef _timezone char *p = (char *) _timezone; return !p; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl__timezone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl__timezone=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_have_decl__timezone" >&5 echo "${ECHO_T}$ac_cv_have_decl__timezone" >&6; } if test $ac_cv_have_decl__timezone = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL__TIMEZONE 1 _ACEOF else cat >>confdefs.h <<_ACEOF #define HAVE_DECL__TIMEZONE 0 _ACEOF fi { echo "$as_me:$LINENO: checking whether altzone is declared" >&5 echo $ECHO_N "checking whether altzone is declared... $ECHO_C" >&6; } if test "${ac_cv_have_decl_altzone+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif int main () { #ifndef altzone char *p = (char *) altzone; return !p; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_have_decl_altzone=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_have_decl_altzone=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_have_decl_altzone" >&5 echo "${ECHO_T}$ac_cv_have_decl_altzone" >&6; } if test $ac_cv_have_decl_altzone = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_DECL_ALTZONE 1 _ACEOF else cat >>confdefs.h <<_ACEOF #define HAVE_DECL_ALTZONE 0 _ACEOF fi # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! { echo "$as_me:$LINENO: checking for working alloca.h" >&5 echo $ECHO_N "checking for working alloca.h... $ECHO_C" >&6; } if test "${ac_cv_working_alloca_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *p = (char *) alloca (2 * sizeof (int)); if (p) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_working_alloca_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_working_alloca_h=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_working_alloca_h" >&5 echo "${ECHO_T}$ac_cv_working_alloca_h" >&6; } if test $ac_cv_working_alloca_h = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_ALLOCA_H 1 _ACEOF fi { echo "$as_me:$LINENO: checking for alloca" >&5 echo $ECHO_N "checking for alloca... $ECHO_C" >&6; } if test "${ac_cv_func_alloca_works+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __GNUC__ # define alloca __builtin_alloca #else # ifdef _MSC_VER # include # define alloca _alloca # else # ifdef HAVE_ALLOCA_H # include # else # ifdef _AIX #pragma alloca # else # ifndef alloca /* predefined by HP cc +Olibcalls */ char *alloca (); # endif # endif # endif # endif #endif int main () { char *p = (char *) alloca (1); if (p) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_alloca_works=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_alloca_works=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_func_alloca_works" >&5 echo "${ECHO_T}$ac_cv_func_alloca_works" >&6; } if test $ac_cv_func_alloca_works = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_ALLOCA 1 _ACEOF else # The SVR3 libPW and SVR4 libucb both contain incompatible functions # that cause trouble. Some versions do not even contain alloca or # contain a buggy version. If you still want to use their alloca, # use ar to extract alloca.o from them instead of compiling alloca.c. ALLOCA=\${LIBOBJDIR}alloca.$ac_objext cat >>confdefs.h <<\_ACEOF #define C_ALLOCA 1 _ACEOF { echo "$as_me:$LINENO: checking whether \`alloca.c' needs Cray hooks" >&5 echo $ECHO_N "checking whether \`alloca.c' needs Cray hooks... $ECHO_C" >&6; } if test "${ac_cv_os_cray+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #if defined CRAY && ! defined CRAY2 webecray #else wenotbecray #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "webecray" >/dev/null 2>&1; then ac_cv_os_cray=yes else ac_cv_os_cray=no fi rm -f conftest* fi { echo "$as_me:$LINENO: result: $ac_cv_os_cray" >&5 echo "${ECHO_T}$ac_cv_os_cray" >&6; } if test $ac_cv_os_cray = yes; then for ac_func in _getb67 GETB67 getb67; do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define CRAY_STACKSEG_END $ac_func _ACEOF break fi done fi { echo "$as_me:$LINENO: checking stack direction for C alloca" >&5 echo $ECHO_N "checking stack direction for C alloca... $ECHO_C" >&6; } if test "${ac_cv_c_stack_direction+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then ac_cv_c_stack_direction=0 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int find_stack_direction () { static char *addr = 0; auto char dummy; if (addr == 0) { addr = &dummy; return find_stack_direction (); } else return (&dummy > addr) ? 1 : -1; } int main () { return find_stack_direction () < 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_stack_direction=1 else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_c_stack_direction=-1 fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi { echo "$as_me:$LINENO: result: $ac_cv_c_stack_direction" >&5 echo "${ECHO_T}$ac_cv_c_stack_direction" >&6; } cat >>confdefs.h <<_ACEOF #define STACK_DIRECTION $ac_cv_c_stack_direction _ACEOF fi { echo "$as_me:$LINENO: checking for _alloca" >&5 echo $ECHO_N "checking for _alloca... $ECHO_C" >&6; } if test "${ac_cv_c__alloca+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int test1() { return _alloca(42); } int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c__alloca=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c__alloca=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_c__alloca" >&5 echo "${ECHO_T}$ac_cv_c__alloca" >&6; } if test "$ac_cv_c__alloca" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE__ALLOCA 1 _ACEOF fi for ac_func in stime poly do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done { echo "$as_me:$LINENO: checking for an ANSI C-conforming const" >&5 echo $ECHO_N "checking for an ANSI C-conforming const... $ECHO_C" >&6; } if test "${ac_cv_c_const+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { /* FIXME: Include the comments suggested by Paul. */ #ifndef __cplusplus /* Ultrix mips cc rejects this. */ typedef int charset[2]; const charset cs; /* SunOS 4.1.1 cc rejects this. */ char const *const *pcpcc; char **ppc; /* NEC SVR4.0.2 mips cc rejects this. */ struct point {int x, y;}; static struct point const zero = {0,0}; /* AIX XL C 1.02.0.0 rejects this. It does not let you subtract one const X* pointer from another in an arm of an if-expression whose if-part is not a constant expression */ const char *g = "string"; pcpcc = &g + (g ? g-g : 0); /* HPUX 7.0 cc rejects these. */ ++pcpcc; ppc = (char**) pcpcc; pcpcc = (char const *const *) ppc; { /* SCO 3.2v4 cc rejects this. */ char *t; char const *s = 0 ? (char *) 0 : (char const *) 0; *t++ = 0; if (s) return 0; } { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */ int x[] = {25, 17}; const int *foo = &x[0]; ++foo; } { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */ typedef const int *iptr; iptr p = 0; ++p; } { /* AIX XL C 1.02.0.0 rejects this saying "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ struct s { int j; const int *ap[3]; }; struct s *b; b->j = 5; } { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ const int foo = 10; if (!foo) return 0; } return !cs[0] && !zero.x; #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_const=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_const=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_c_const" >&5 echo "${ECHO_T}$ac_cv_c_const" >&6; } if test $ac_cv_c_const = no; then cat >>confdefs.h <<\_ACEOF #define const _ACEOF fi { echo "$as_me:$LINENO: checking for function prototypes" >&5 echo $ECHO_N "checking for function prototypes... $ECHO_C" >&6; } if test "$ac_cv_prog_cc_c89" != no; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } cat >>confdefs.h <<\_ACEOF #define PROTOTYPES 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define __PROTOTYPES 1 _ACEOF else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi { echo "$as_me:$LINENO: checking for arrays of jmp_bufs" >&5 echo $ECHO_N "checking for arrays of jmp_bufs... $ECHO_C" >&6; } if test "${ac_cv_c_jmp_buf_array+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int test1() { jmp_buf jb[1]; jmp_buf *jbp = jb; return (setjmp(jb[0]) == 0); } int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_jmp_buf_array=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_jmp_buf_array=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_c_jmp_buf_array" >&5 echo "${ECHO_T}$ac_cv_c_jmp_buf_array" >&6; } if test "$ac_cv_c_jmp_buf_array" = yes; then cat >>confdefs.h <<\_ACEOF #define JMPBUF_ARRAY 1 _ACEOF fi { echo "$as_me:$LINENO: checking labels as values" >&5 echo $ECHO_N "checking labels as values... $ECHO_C" >&6; } if test "${ac_cv_labels_as_values+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int foo(int); int foo(i) int i; { static void *label[] = { &&l1, &&l2 }; goto *label[i]; l1: return 1; l2: return 2; } int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_labels_as_values=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_labels_as_values=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_labels_as_values" >&5 echo "${ECHO_T}$ac_cv_labels_as_values" >&6; } if test "$ac_cv_labels_as_values" = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_LABELS_AS_VALUES 1 _ACEOF fi { echo "$as_me:$LINENO: checking whether struct tm is in sys/time.h or time.h" >&5 echo $ECHO_N "checking whether struct tm is in sys/time.h or time.h... $ECHO_C" >&6; } if test "${ac_cv_struct_tm+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { struct tm *tp; tp->tm_sec; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_struct_tm=time.h else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_struct_tm=sys/time.h fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_struct_tm" >&5 echo "${ECHO_T}$ac_cv_struct_tm" >&6; } if test $ac_cv_struct_tm = sys/time.h; then cat >>confdefs.h <<\_ACEOF #define TM_IN_SYS_TIME 1 _ACEOF fi { echo "$as_me:$LINENO: checking return type of signal handlers" >&5 echo $ECHO_N "checking return type of signal handlers... $ECHO_C" >&6; } if test "${ac_cv_type_signal+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { return *(signal (0, 0)) (0) == 1; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_signal=int else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_signal=void fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_signal" >&5 echo "${ECHO_T}$ac_cv_type_signal" >&6; } cat >>confdefs.h <<_ACEOF #define RETSIGTYPE $ac_cv_type_signal _ACEOF if test "$ac_cv_type_signal" = void; then cat >>confdefs.h <<\_ACEOF #define VOID_INT_SIGNALS 1 _ACEOF fi { echo "$as_me:$LINENO: checking for tputs in -lncurses" >&5 echo $ECHO_N "checking for tputs in -lncurses... $ECHO_C" >&6; } if test "${ac_cv_lib_ncurses_tputs+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lncurses $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char tputs (); int main () { return tputs (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_ncurses_tputs=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_ncurses_tputs=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_ncurses_tputs" >&5 echo "${ECHO_T}$ac_cv_lib_ncurses_tputs" >&6; } if test $ac_cv_lib_ncurses_tputs = yes; then HaveLibTermcap=YES; LibTermcap=ncurses else { echo "$as_me:$LINENO: checking for tputs in -ltermcap" >&5 echo $ECHO_N "checking for tputs in -ltermcap... $ECHO_C" >&6; } if test "${ac_cv_lib_termcap_tputs+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ltermcap $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char tputs (); int main () { return tputs (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_termcap_tputs=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_termcap_tputs=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_termcap_tputs" >&5 echo "${ECHO_T}$ac_cv_lib_termcap_tputs" >&6; } if test $ac_cv_lib_termcap_tputs = yes; then HaveLibTermcap=YES; LibTermcap=termcap else { echo "$as_me:$LINENO: checking for tputs in -lcurses" >&5 echo $ECHO_N "checking for tputs in -lcurses... $ECHO_C" >&6; } if test "${ac_cv_lib_curses_tputs+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lcurses $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char tputs (); int main () { return tputs (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_curses_tputs=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_curses_tputs=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_curses_tputs" >&5 echo "${ECHO_T}$ac_cv_lib_curses_tputs" >&6; } if test $ac_cv_lib_curses_tputs = yes; then HaveLibTermcap=YES; LibTermcap=curses else HaveLibTermcap=NO fi fi fi if test $HaveLibTermcap = YES ; then LIBS="-l$LibTermcap $LIBS" fi { echo "$as_me:$LINENO: checking for readline in -lreadline" >&5 echo $ECHO_N "checking for readline in -lreadline... $ECHO_C" >&6; } if test "${ac_cv_lib_readline_readline+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lreadline $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char readline (); int main () { return readline (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_readline_readline=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_readline_readline=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_readline_readline" >&5 echo "${ECHO_T}$ac_cv_lib_readline_readline" >&6; } if test $ac_cv_lib_readline_readline = yes; then HaveLibReadline=YES; LibReadline=readline else { echo "$as_me:$LINENO: checking for readline in -leditline" >&5 echo $ECHO_N "checking for readline in -leditline... $ECHO_C" >&6; } if test "${ac_cv_lib_editline_readline+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-leditline $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char readline (); int main () { return readline (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_editline_readline=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_editline_readline=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { echo "$as_me:$LINENO: result: $ac_cv_lib_editline_readline" >&5 echo "${ECHO_T}$ac_cv_lib_editline_readline" >&6; } if test $ac_cv_lib_editline_readline = yes; then HaveLibReadline=YES; LibReadline=editline else HaveLibReadline=NO fi fi if test $HaveLibTermcap = YES && test $HaveLibReadline = YES && test "$enable_char_encoding" != utf8; then LIBS="-l$LibReadline $LIBS" cat >>confdefs.h <<\_ACEOF #define USE_READLINE 1 _ACEOF fi if test "$enable_profiling" = yes; then if test "$have_hp2ps" = "0"; then { echo "$as_me:$LINENO: WARNING: hp2ps (heap profile display program) not available (not ignoring --enable-profiling)" >&5 echo "$as_me: WARNING: hp2ps (heap profile display program) not available (not ignoring --enable-profiling)" >&2;} fi fi want_timer=no if test "$enable_timer" = yes; then if test "$ac_cv_header_time_h" = yes; then want_timer=yes elif test "$ac_cv_header_sys_time_h" = yes && test "$ac_cv_header_sys_resource_h" = yes; then want_timer=yes else { echo "$as_me:$LINENO: WARNING: neither nor ( and ) is available (ignoring --enable-timer)" >&5 echo "$as_me: WARNING: neither nor ( and ) is available (ignoring --enable-timer)" >&2;} fi fi if test "$want_timer" = yes; then cat >>confdefs.h <<\_ACEOF #define WANT_TIMER 1 _ACEOF fi if test "$enable_debug" = yes; then OPTFLAGS="" else CFLAGS="-DNDEBUG=1 $CFLAGS" DEBUGFLAGS="" LDDEBUGFLAGS="" fi { echo "$as_me:$LINENO: checking for int" >&5 echo $ECHO_N "checking for int... $ECHO_C" >&6; } if test "${ac_cv_type_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_int=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_int=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_int" >&5 echo "${ECHO_T}$ac_cv_type_int" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of int" >&5 echo $ECHO_N "checking size of int... $ECHO_C" >&6; } if test "${ac_cv_sizeof_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_int=$ac_lo;; '') if test "$ac_cv_type_int" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_int=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_int=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_int" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (int) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_int=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_int" >&5 echo "${ECHO_T}$ac_cv_sizeof_int" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_INT $ac_cv_sizeof_int _ACEOF { echo "$as_me:$LINENO: checking for float" >&5 echo $ECHO_N "checking for float... $ECHO_C" >&6; } if test "${ac_cv_type_float+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_float=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_float=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_float" >&5 echo "${ECHO_T}$ac_cv_type_float" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of float" >&5 echo $ECHO_N "checking size of float... $ECHO_C" >&6; } if test "${ac_cv_sizeof_float+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_float=$ac_lo;; '') if test "$ac_cv_type_float" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (float) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (float) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_float=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef float ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_float=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_float" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (float) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (float) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_float=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_float" >&5 echo "${ECHO_T}$ac_cv_sizeof_float" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_FLOAT $ac_cv_sizeof_float _ACEOF { echo "$as_me:$LINENO: checking for double" >&5 echo $ECHO_N "checking for double... $ECHO_C" >&6; } if test "${ac_cv_type_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_double=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_double=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_double" >&5 echo "${ECHO_T}$ac_cv_type_double" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of double" >&5 echo $ECHO_N "checking size of double... $ECHO_C" >&6; } if test "${ac_cv_sizeof_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_double=$ac_lo;; '') if test "$ac_cv_type_double" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (double) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (double) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_double=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef double ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_double=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_double" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (double) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (double) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_double=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_double" >&5 echo "${ECHO_T}$ac_cv_sizeof_double" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_DOUBLE $ac_cv_sizeof_double _ACEOF { echo "$as_me:$LINENO: checking for int*" >&5 echo $ECHO_N "checking for int*... $ECHO_C" >&6; } if test "${ac_cv_type_intp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int* ac__type_new_; int main () { if ((ac__type_new_ *) 0) return 0; if (sizeof (ac__type_new_)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_intp=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_intp=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_type_intp" >&5 echo "${ECHO_T}$ac_cv_type_intp" >&6; } # The cast to long int works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. { echo "$as_me:$LINENO: checking size of int*" >&5 echo $ECHO_N "checking size of int*... $ECHO_C" >&6; } if test "${ac_cv_sizeof_intp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int* ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int* ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int* ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int* ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int* ac__type_sizeof_; int main () { static int test_array [1 - 2 * !(((long int) (sizeof (ac__type_sizeof_))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_intp=$ac_lo;; '') if test "$ac_cv_type_intp" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (int*) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int*) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_intp=0 fi ;; esac else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default typedef int* ac__type_sizeof_; static long int longval () { return (long int) (sizeof (ac__type_sizeof_)); } static unsigned long int ulongval () { return (long int) (sizeof (ac__type_sizeof_)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) return 1; if (((long int) (sizeof (ac__type_sizeof_))) < 0) { long int i = longval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%ld\n", i); } else { unsigned long int i = ulongval (); if (i != ((long int) (sizeof (ac__type_sizeof_)))) return 1; fprintf (f, "%lu\n", i); } return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_intp=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) if test "$ac_cv_type_intp" = yes; then { { echo "$as_me:$LINENO: error: cannot compute sizeof (int*) See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int*) See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } else ac_cv_sizeof_intp=0 fi fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.val fi { echo "$as_me:$LINENO: result: $ac_cv_sizeof_intp" >&5 echo "${ECHO_T}$ac_cv_sizeof_intp" >&6; } cat >>confdefs.h <<_ACEOF #define SIZEOF_INTP $ac_cv_sizeof_intp _ACEOF if test "$ac_cv_sizeof_int" -eq "2"; then cat >>confdefs.h <<\_ACEOF #define SMALL_HUGS 1 _ACEOF else if test 0 -eq 1; then echo "building regular hugs" cat >>confdefs.h <<\_ACEOF #define REGULAR_HUGS 1 _ACEOF else echo "building large hugs" cat >>confdefs.h <<\_ACEOF #define LARGE_HUGS 1 _ACEOF fi fi { echo "$as_me:$LINENO: checking if '/LD' builds loadable libraries" >&5 echo $ECHO_N "checking if '/LD' builds loadable libraries... $ECHO_C" >&6; } if test "${ac_cv_dll_flags+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat > conftest_dl.c <&5 (eval $ac_mkdll) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest_dl.so then cat > conftest.c << EOF #include "confdefs.h" #if PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif #define SYMBOL1 "test" #define SYMBOL2 "_test" #define CANTRUN 1 #define CANTOPEN 2 #define SYM1_OK 3 #define SYM2_OK 4 #define CANTFIND 5 #if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */ #include #include main() { void *instance; void *sym; instance = dlopen("./conftest_dl.so",1); if (instance==0) exit(CANTOPEN); sym = dlsym(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = dlsym(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_DL_H /* eg HPUX */ #include main() { shl_t instance; void* r; instance = shl_load("./conftest_dl.so",BIND_IMMEDIATE,0L); if (instance == 0) exit(CANTOPEN); if (0 == shl_findsym(&instance,SYMBOL1,TYPE_PROCEDURE,&r)) exit(SYM1_OK); if (0 == shl_findsym(&instance,SYMBOL2,TYPE_PROCEDURE,&r)) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_MACH_O_DYLD_H /* MacOS X */ #include #include main() { NSObjectFileImage ofile; NSModule handle = NULL; void* addr; NSSymbol sym; if (NSCreateObjectFileImageFromFile("./conftest_dl.so",&ofile) != NSObjectFileImageSuccess) exit(CANTOPEN); handle = NSLinkModule(ofile,"./conftest_dl.so",NSLINKMODULE_OPTION_PRIVATE); if (handle == 0) exit(CANTOPEN); sym = NSLookupSymbolInModule(handle, SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = NSLookupSymbolInModule(handle, SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_WINDOWS_H #include main() { HINSTANCE instance; void* sym; instance = LoadLibrary("conftest_dl.so"); if (instance ==0) exit(CANTOPEN); sym = (void*)GetProcAddress(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = (void*)GetProcAddress(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #else main() { exit(CANTRUN); } #endif EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext} then ./conftest 2>/dev/null ac_result=$? if test $ac_result = 3; then ac_cv_dll_flags='/LD' ac_cv_leading_underscore=no fi if test $ac_result = 4; then ac_cv_dll_flags='/LD' ac_cv_leading_underscore=yes fi fi fi rm -fr conftest* a.out fi { echo "$as_me:$LINENO: result: $ac_cv_dll_flags" >&5 echo "${ECHO_T}$ac_cv_dll_flags" >&6; } { echo "$as_me:$LINENO: checking if '/LD /ML /nologo' builds loadable libraries" >&5 echo $ECHO_N "checking if '/LD /ML /nologo' builds loadable libraries... $ECHO_C" >&6; } if test "${ac_cv_dll_flags+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat > conftest_dl.c <&5 (eval $ac_mkdll) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest_dl.so then cat > conftest.c << EOF #include "confdefs.h" #if PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif #define SYMBOL1 "test" #define SYMBOL2 "_test" #define CANTRUN 1 #define CANTOPEN 2 #define SYM1_OK 3 #define SYM2_OK 4 #define CANTFIND 5 #if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */ #include #include main() { void *instance; void *sym; instance = dlopen("./conftest_dl.so",1); if (instance==0) exit(CANTOPEN); sym = dlsym(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = dlsym(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_DL_H /* eg HPUX */ #include main() { shl_t instance; void* r; instance = shl_load("./conftest_dl.so",BIND_IMMEDIATE,0L); if (instance == 0) exit(CANTOPEN); if (0 == shl_findsym(&instance,SYMBOL1,TYPE_PROCEDURE,&r)) exit(SYM1_OK); if (0 == shl_findsym(&instance,SYMBOL2,TYPE_PROCEDURE,&r)) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_MACH_O_DYLD_H /* MacOS X */ #include #include main() { NSObjectFileImage ofile; NSModule handle = NULL; void* addr; NSSymbol sym; if (NSCreateObjectFileImageFromFile("./conftest_dl.so",&ofile) != NSObjectFileImageSuccess) exit(CANTOPEN); handle = NSLinkModule(ofile,"./conftest_dl.so",NSLINKMODULE_OPTION_PRIVATE); if (handle == 0) exit(CANTOPEN); sym = NSLookupSymbolInModule(handle, SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = NSLookupSymbolInModule(handle, SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_WINDOWS_H #include main() { HINSTANCE instance; void* sym; instance = LoadLibrary("conftest_dl.so"); if (instance ==0) exit(CANTOPEN); sym = (void*)GetProcAddress(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = (void*)GetProcAddress(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #else main() { exit(CANTRUN); } #endif EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext} then ./conftest 2>/dev/null ac_result=$? if test $ac_result = 3; then ac_cv_dll_flags='/LD /ML /nologo' ac_cv_leading_underscore=no fi if test $ac_result = 4; then ac_cv_dll_flags='/LD /ML /nologo' ac_cv_leading_underscore=yes fi fi fi rm -fr conftest* a.out fi { echo "$as_me:$LINENO: result: $ac_cv_dll_flags" >&5 echo "${ECHO_T}$ac_cv_dll_flags" >&6; } case "$host_os" in mingw32|cygwin32) { echo "$as_me:$LINENO: checking if '-shared' builds loadable libraries" >&5 echo $ECHO_N "checking if '-shared' builds loadable libraries... $ECHO_C" >&6; } if test "${ac_cv_dll_flags+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat > conftest_dl.c <&5 (eval $ac_mkdll) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest_dl.so then cat > conftest.c << EOF #include "confdefs.h" #if PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif #define SYMBOL1 "test" #define SYMBOL2 "_test" #define CANTRUN 1 #define CANTOPEN 2 #define SYM1_OK 3 #define SYM2_OK 4 #define CANTFIND 5 #if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */ #include #include main() { void *instance; void *sym; instance = dlopen("./conftest_dl.so",1); if (instance==0) exit(CANTOPEN); sym = dlsym(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = dlsym(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_DL_H /* eg HPUX */ #include main() { shl_t instance; void* r; instance = shl_load("./conftest_dl.so",BIND_IMMEDIATE,0L); if (instance == 0) exit(CANTOPEN); if (0 == shl_findsym(&instance,SYMBOL1,TYPE_PROCEDURE,&r)) exit(SYM1_OK); if (0 == shl_findsym(&instance,SYMBOL2,TYPE_PROCEDURE,&r)) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_MACH_O_DYLD_H /* MacOS X */ #include #include main() { NSObjectFileImage ofile; NSModule handle = NULL; void* addr; NSSymbol sym; if (NSCreateObjectFileImageFromFile("./conftest_dl.so",&ofile) != NSObjectFileImageSuccess) exit(CANTOPEN); handle = NSLinkModule(ofile,"./conftest_dl.so",NSLINKMODULE_OPTION_PRIVATE); if (handle == 0) exit(CANTOPEN); sym = NSLookupSymbolInModule(handle, SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = NSLookupSymbolInModule(handle, SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_WINDOWS_H #include main() { HINSTANCE instance; void* sym; instance = LoadLibrary("conftest_dl.so"); if (instance ==0) exit(CANTOPEN); sym = (void*)GetProcAddress(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = (void*)GetProcAddress(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #else main() { exit(CANTRUN); } #endif EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext} then ./conftest 2>/dev/null ac_result=$? if test $ac_result = 3; then ac_cv_dll_flags='-shared' ac_cv_leading_underscore=no fi if test $ac_result = 4; then ac_cv_dll_flags='-shared' ac_cv_leading_underscore=yes fi fi fi rm -fr conftest* a.out fi { echo "$as_me:$LINENO: result: $ac_cv_dll_flags" >&5 echo "${ECHO_T}$ac_cv_dll_flags" >&6; } ;; esac { echo "$as_me:$LINENO: checking if '-shared -fPIC' builds loadable libraries" >&5 echo $ECHO_N "checking if '-shared -fPIC' builds loadable libraries... $ECHO_C" >&6; } if test "${ac_cv_dll_flags+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat > conftest_dl.c <&5 (eval $ac_mkdll) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest_dl.so then cat > conftest.c << EOF #include "confdefs.h" #if PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif #define SYMBOL1 "test" #define SYMBOL2 "_test" #define CANTRUN 1 #define CANTOPEN 2 #define SYM1_OK 3 #define SYM2_OK 4 #define CANTFIND 5 #if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */ #include #include main() { void *instance; void *sym; instance = dlopen("./conftest_dl.so",1); if (instance==0) exit(CANTOPEN); sym = dlsym(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = dlsym(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_DL_H /* eg HPUX */ #include main() { shl_t instance; void* r; instance = shl_load("./conftest_dl.so",BIND_IMMEDIATE,0L); if (instance == 0) exit(CANTOPEN); if (0 == shl_findsym(&instance,SYMBOL1,TYPE_PROCEDURE,&r)) exit(SYM1_OK); if (0 == shl_findsym(&instance,SYMBOL2,TYPE_PROCEDURE,&r)) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_MACH_O_DYLD_H /* MacOS X */ #include #include main() { NSObjectFileImage ofile; NSModule handle = NULL; void* addr; NSSymbol sym; if (NSCreateObjectFileImageFromFile("./conftest_dl.so",&ofile) != NSObjectFileImageSuccess) exit(CANTOPEN); handle = NSLinkModule(ofile,"./conftest_dl.so",NSLINKMODULE_OPTION_PRIVATE); if (handle == 0) exit(CANTOPEN); sym = NSLookupSymbolInModule(handle, SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = NSLookupSymbolInModule(handle, SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_WINDOWS_H #include main() { HINSTANCE instance; void* sym; instance = LoadLibrary("conftest_dl.so"); if (instance ==0) exit(CANTOPEN); sym = (void*)GetProcAddress(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = (void*)GetProcAddress(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #else main() { exit(CANTRUN); } #endif EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext} then ./conftest 2>/dev/null ac_result=$? if test $ac_result = 3; then ac_cv_dll_flags='-shared -fPIC' ac_cv_leading_underscore=no fi if test $ac_result = 4; then ac_cv_dll_flags='-shared -fPIC' ac_cv_leading_underscore=yes fi fi fi rm -fr conftest* a.out fi { echo "$as_me:$LINENO: result: $ac_cv_dll_flags" >&5 echo "${ECHO_T}$ac_cv_dll_flags" >&6; } { echo "$as_me:$LINENO: checking if '-flat_namespace -bundle -undefined suppress' builds loadable libraries" >&5 echo $ECHO_N "checking if '-flat_namespace -bundle -undefined suppress' builds loadable libraries... $ECHO_C" >&6; } if test "${ac_cv_dll_flags+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat > conftest_dl.c <&5 (eval $ac_mkdll) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest_dl.so then cat > conftest.c << EOF #include "confdefs.h" #if PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif #define SYMBOL1 "test" #define SYMBOL2 "_test" #define CANTRUN 1 #define CANTOPEN 2 #define SYM1_OK 3 #define SYM2_OK 4 #define CANTFIND 5 #if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */ #include #include main() { void *instance; void *sym; instance = dlopen("./conftest_dl.so",1); if (instance==0) exit(CANTOPEN); sym = dlsym(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = dlsym(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_DL_H /* eg HPUX */ #include main() { shl_t instance; void* r; instance = shl_load("./conftest_dl.so",BIND_IMMEDIATE,0L); if (instance == 0) exit(CANTOPEN); if (0 == shl_findsym(&instance,SYMBOL1,TYPE_PROCEDURE,&r)) exit(SYM1_OK); if (0 == shl_findsym(&instance,SYMBOL2,TYPE_PROCEDURE,&r)) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_MACH_O_DYLD_H /* MacOS X */ #include #include main() { NSObjectFileImage ofile; NSModule handle = NULL; void* addr; NSSymbol sym; if (NSCreateObjectFileImageFromFile("./conftest_dl.so",&ofile) != NSObjectFileImageSuccess) exit(CANTOPEN); handle = NSLinkModule(ofile,"./conftest_dl.so",NSLINKMODULE_OPTION_PRIVATE); if (handle == 0) exit(CANTOPEN); sym = NSLookupSymbolInModule(handle, SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = NSLookupSymbolInModule(handle, SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_WINDOWS_H #include main() { HINSTANCE instance; void* sym; instance = LoadLibrary("conftest_dl.so"); if (instance ==0) exit(CANTOPEN); sym = (void*)GetProcAddress(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = (void*)GetProcAddress(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #else main() { exit(CANTRUN); } #endif EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext} then ./conftest 2>/dev/null ac_result=$? if test $ac_result = 3; then ac_cv_dll_flags='-flat_namespace -bundle -undefined suppress' ac_cv_leading_underscore=no fi if test $ac_result = 4; then ac_cv_dll_flags='-flat_namespace -bundle -undefined suppress' ac_cv_leading_underscore=yes fi fi fi rm -fr conftest* a.out fi { echo "$as_me:$LINENO: result: $ac_cv_dll_flags" >&5 echo "${ECHO_T}$ac_cv_dll_flags" >&6; } { echo "$as_me:$LINENO: checking if '-bundle' builds loadable libraries" >&5 echo $ECHO_N "checking if '-bundle' builds loadable libraries... $ECHO_C" >&6; } if test "${ac_cv_dll_flags+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat > conftest_dl.c <&5 (eval $ac_mkdll) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest_dl.so then cat > conftest.c << EOF #include "confdefs.h" #if PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif #define SYMBOL1 "test" #define SYMBOL2 "_test" #define CANTRUN 1 #define CANTOPEN 2 #define SYM1_OK 3 #define SYM2_OK 4 #define CANTFIND 5 #if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */ #include #include main() { void *instance; void *sym; instance = dlopen("./conftest_dl.so",1); if (instance==0) exit(CANTOPEN); sym = dlsym(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = dlsym(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_DL_H /* eg HPUX */ #include main() { shl_t instance; void* r; instance = shl_load("./conftest_dl.so",BIND_IMMEDIATE,0L); if (instance == 0) exit(CANTOPEN); if (0 == shl_findsym(&instance,SYMBOL1,TYPE_PROCEDURE,&r)) exit(SYM1_OK); if (0 == shl_findsym(&instance,SYMBOL2,TYPE_PROCEDURE,&r)) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_MACH_O_DYLD_H /* MacOS X */ #include #include main() { NSObjectFileImage ofile; NSModule handle = NULL; void* addr; NSSymbol sym; if (NSCreateObjectFileImageFromFile("./conftest_dl.so",&ofile) != NSObjectFileImageSuccess) exit(CANTOPEN); handle = NSLinkModule(ofile,"./conftest_dl.so",NSLINKMODULE_OPTION_PRIVATE); if (handle == 0) exit(CANTOPEN); sym = NSLookupSymbolInModule(handle, SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = NSLookupSymbolInModule(handle, SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_WINDOWS_H #include main() { HINSTANCE instance; void* sym; instance = LoadLibrary("conftest_dl.so"); if (instance ==0) exit(CANTOPEN); sym = (void*)GetProcAddress(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = (void*)GetProcAddress(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #else main() { exit(CANTRUN); } #endif EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext} then ./conftest 2>/dev/null ac_result=$? if test $ac_result = 3; then ac_cv_dll_flags='-bundle' ac_cv_leading_underscore=no fi if test $ac_result = 4; then ac_cv_dll_flags='-bundle' ac_cv_leading_underscore=yes fi fi fi rm -fr conftest* a.out fi { echo "$as_me:$LINENO: result: $ac_cv_dll_flags" >&5 echo "${ECHO_T}$ac_cv_dll_flags" >&6; } { echo "$as_me:$LINENO: checking if '-r' builds loadable libraries" >&5 echo $ECHO_N "checking if '-r' builds loadable libraries... $ECHO_C" >&6; } if test "${ac_cv_dll_flags+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat > conftest_dl.c <&5 (eval $ac_mkdll) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest_dl.so then cat > conftest.c << EOF #include "confdefs.h" #if PROTOTYPES /* To enable use of prototypes whenever possible */ #define Args(x) x #else #define Args(x) () #endif #define SYMBOL1 "test" #define SYMBOL2 "_test" #define CANTRUN 1 #define CANTOPEN 2 #define SYM1_OK 3 #define SYM2_OK 4 #define CANTFIND 5 #if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */ #include #include main() { void *instance; void *sym; instance = dlopen("./conftest_dl.so",1); if (instance==0) exit(CANTOPEN); sym = dlsym(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = dlsym(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_DL_H /* eg HPUX */ #include main() { shl_t instance; void* r; instance = shl_load("./conftest_dl.so",BIND_IMMEDIATE,0L); if (instance == 0) exit(CANTOPEN); if (0 == shl_findsym(&instance,SYMBOL1,TYPE_PROCEDURE,&r)) exit(SYM1_OK); if (0 == shl_findsym(&instance,SYMBOL2,TYPE_PROCEDURE,&r)) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_MACH_O_DYLD_H /* MacOS X */ #include #include main() { NSObjectFileImage ofile; NSModule handle = NULL; void* addr; NSSymbol sym; if (NSCreateObjectFileImageFromFile("./conftest_dl.so",&ofile) != NSObjectFileImageSuccess) exit(CANTOPEN); handle = NSLinkModule(ofile,"./conftest_dl.so",NSLINKMODULE_OPTION_PRIVATE); if (handle == 0) exit(CANTOPEN); sym = NSLookupSymbolInModule(handle, SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = NSLookupSymbolInModule(handle, SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #elif HAVE_WINDOWS_H #include main() { HINSTANCE instance; void* sym; instance = LoadLibrary("conftest_dl.so"); if (instance ==0) exit(CANTOPEN); sym = (void*)GetProcAddress(instance,SYMBOL1); if (sym != 0) exit(SYM1_OK); sym = (void*)GetProcAddress(instance,SYMBOL2); if (sym != 0) exit(SYM2_OK); exit(CANTFIND); } #else main() { exit(CANTRUN); } #endif EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext} then ./conftest 2>/dev/null ac_result=$? if test $ac_result = 3; then ac_cv_dll_flags='-r' ac_cv_leading_underscore=no fi if test $ac_result = 4; then ac_cv_dll_flags='-r' ac_cv_leading_underscore=yes fi fi fi rm -fr conftest* a.out fi { echo "$as_me:$LINENO: result: $ac_cv_dll_flags" >&5 echo "${ECHO_T}$ac_cv_dll_flags" >&6; } cat >>confdefs.h <<_ACEOF #define MKDLL_CMD "${CC-cc} $CFLAGS $CPPFLAGS $LDFLAGS $ac_cv_dll_flags" _ACEOF if test "$ac_cv_leading_underscore" = "yes"; then cat >>confdefs.h <<\_ACEOF #define LEADING_UNDERSCORE 1 _ACEOF fi dynamic_loading=no { echo "$as_me:$LINENO: checking for LoadLibrary" >&5 echo $ECHO_N "checking for LoadLibrary... $ECHO_C" >&6; } if test "${fp_cv_func_LoadLibrary+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { LoadLibrary("") ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then fp_cv_func_LoadLibrary=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fp_cv_func_LoadLibrary=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $fp_cv_func_LoadLibrary" >&5 echo "${ECHO_T}$fp_cv_func_LoadLibrary" >&6; } if test $fp_cv_func_LoadLibrary = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_LOADLIBRARY 1 _ACEOF dynamic_loading=yes else for ac_func in dlopen shl_load NSCreateObjectFileImageFromFile do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; } if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$ac_func || defined __stub___$ac_func choke me #endif int main () { return $ac_func (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi ac_res=`eval echo '${'$as_ac_var'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF dynamic_loading=yes; break fi done fi if test x"$enable_ffi" = xautodetect; then enable_ffi="$dynamic_loading" fi if test x"$enable_ffi" = xyes; then FFI_LIBRARIES=ffi_libraries else FFI_LIBRARIES= fi GCC_LINT_FLAGS='-Wall -Wpointer-arith -Wbad-function-cast -Wcast-qual -Wmissing-prototypes -Wmissing-declarations -Wnested-externs -Wno-parentheses' if test "$enable_lint" = yes; then case "$CC" in gcc|gcc-*|*/gcc|*/gcc-*) LINT_FLAGS="$GCC_LINT_FLAGS" ;; # bcc32) # LINT_FLAGS="$BCC32_LINT_FLAGS" ;; *) { echo "$as_me:$LINENO: WARNING: lint flags only defined for gcc (at present) (ignoring --enable-lint)" >&5 echo "$as_me: WARNING: lint flags only defined for gcc (at present) (ignoring --enable-lint)" >&2;} ;; esac CFLAGS="$CFLAGS $LINT_FLAGS" fi if test "x$host_os" = "xmingw32"; then BAT=.bat DLL=".dll" DLL_ENDING="-dll" DEV_NULL="nul" hugsdir_deflt='${libdir}/hugs' HUGSPATH=".;{Hugs}\\\\packages\\\\*" HUGSSUFFIXES=".hs;.lhs" MkInstall="src/MkInstal.in" elif test "x$host" = "xdos"; then # Much the same as for Windows BAT=.bat DLL=".dll" DLL_ENDING="-dll" DEV_NULL="nul" hugsdir_deflt='${libdir}\\hugs' HUGSPATH=".;{Hugs}\\\\packages\\\\*" HUGSSUFFIXES=".hs;.lhs" MkInstall="src/MkNull.in" else BAT= hugsdir_deflt='${libdir}/hugs' HUGSPATH=".:{Home}/lib/hugs/packages/*:/usr/local/lib/hugs/packages/*:{Hugs}/packages/*" HUGSSUFFIXES=".hs:.lhs" MkInstall="src/MkInstal.in" fi cat >>confdefs.h <<_ACEOF #define HUGSSUFFIXES "$HUGSSUFFIXES" _ACEOF if test "x$prefix" = xNONE; then prefix="$ac_default_prefix" fi hugsdir=${hugsdir="$hugsdir_deflt"} test "x$prefix" = xNONE && prefix=$ac_default_prefix test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' HUGSDIR=`sh -c "prefix=$prefix; exec_prefix=$exec_prefix; libdir=$libdir; datadir=$datadir; echo $hugsdir"` cat >>confdefs.h <<_ACEOF #define HUGSDIR "$HUGSDIR" _ACEOF BINDIR=`sh -c "prefix=$prefix; exec_prefix=$exec_prefix; echo $bindir"` DLL=${DLL=".so"} DLL_ENDING=${DLL_ENDING="-so"} DEV_NULL=${DEV_NULL="/dev/null"} RM=${RM="/bin/rm -f"} CP=${CP="/bin/cp"} MkDepend=src/MkDepend.in cat >>confdefs.h <<_ACEOF #define HUGSPATH "${HUGSPATH}" _ACEOF HUGS_FOR_WINDOWS=no if test "x$with_gui" = xyes; then if test "x$host_os" = "xmingw32"; then LDFLAGS="$LDFLAGS -W" WOBJECTS="win-text.obj" STRIP="brc32 hugs32.rc hugs.exe -w32" RC_FILES="hugs32.rc" HUGS_FOR_WINDOWS=yes elif test "x$host" = "xdos"; then WOBJECTS="win-text.obj" STRIP="brc hugs16.rc hugs.exe" RC_FILES="hugs16.rc" HUGS_FOR_WINDOWS=yes else { echo "$as_me:$LINENO: WARNING: not building Hugs GUI because this isn't a DOS machine " >&5 echo "$as_me: WARNING: not building Hugs GUI because this isn't a DOS machine " >&2;} fi fi if test $HUGS_FOR_WINDOWS = yes; then cat >>confdefs.h <<\_ACEOF #define HUGS_FOR_WINDOWS 1 _ACEOF fi WOBJECTS=${WOBJECTS=""} RC_FILES=${RC_FILES=""} STRIP=${STRIP=""} TESTSCRIPT="" if test -f tests/config.in ; then TESTSCRIPT=tests/config fi MAKEFILES='src/Makefile docs/Makefile docs/users_guide/Makefile demos/Makefile' ac_config_files="$ac_config_files MkDefs $MAKEFILES src/platform.h docs/hugs.1 $TESTSCRIPT" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { echo "$as_me:$LINENO: updating cache $cache_file" >&5 echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac fi BIN_SH=xpg4; export BIN_SH # for Tru64 DUALCASE=1; export DUALCASE # for MKS sh # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # Find out whether ``test -x'' works. Don't use a zero-byte file, as # systems may use methods other than mode bits to determine executability. cat >conf$$.file <<_ASEOF #! /bin/sh exit 0 _ASEOF chmod +x conf$$.file if test -x conf$$.file >/dev/null 2>&1; then as_executable_p="test -x" else as_executable_p=: fi rm -f conf$$.file # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by Hugs98 $as_me 1.0, which was generated by GNU Autoconf 2.60a. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for. config_files="$ac_config_files" config_headers="$ac_config_headers" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ Hugs98 config.status 1.0 configured by $0, generated by GNU Autoconf 2.60a, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2006 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header { echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 CONFIG_SHELL=$SHELL export CONFIG_SHELL exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "src/config.h") CONFIG_HEADERS="$CONFIG_HEADERS src/config.h" ;; "src/options.h") CONFIG_HEADERS="$CONFIG_HEADERS src/options.h" ;; "MkDefs") CONFIG_FILES="$CONFIG_FILES MkDefs" ;; "$MAKEFILES") CONFIG_FILES="$CONFIG_FILES $MAKEFILES" ;; "src/platform.h") CONFIG_FILES="$CONFIG_FILES src/platform.h" ;; "docs/hugs.1") CONFIG_FILES="$CONFIG_FILES docs/hugs.1" ;; "$TESTSCRIPT") CONFIG_FILES="$CONFIG_FILES $TESTSCRIPT" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } # # Set up the sed scripts for CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "$CONFIG_FILES"; then _ACEOF # Create sed commands to just substitute file output variables. # Remaining file output variables are in a fragment that also has non-file # output varibles. ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF SHELL!$SHELL$ac_delim PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim PACKAGE_NAME!$PACKAGE_NAME$ac_delim PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim PACKAGE_STRING!$PACKAGE_STRING$ac_delim PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim exec_prefix!$exec_prefix$ac_delim prefix!$prefix$ac_delim program_transform_name!$program_transform_name$ac_delim bindir!$bindir$ac_delim sbindir!$sbindir$ac_delim libexecdir!$libexecdir$ac_delim datarootdir!$datarootdir$ac_delim datadir!$datadir$ac_delim sysconfdir!$sysconfdir$ac_delim sharedstatedir!$sharedstatedir$ac_delim localstatedir!$localstatedir$ac_delim includedir!$includedir$ac_delim oldincludedir!$oldincludedir$ac_delim docdir!$docdir$ac_delim infodir!$infodir$ac_delim htmldir!$htmldir$ac_delim dvidir!$dvidir$ac_delim pdfdir!$pdfdir$ac_delim psdir!$psdir$ac_delim libdir!$libdir$ac_delim localedir!$localedir$ac_delim mandir!$mandir$ac_delim DEFS!$DEFS$ac_delim ECHO_C!$ECHO_C$ac_delim ECHO_N!$ECHO_N$ac_delim ECHO_T!$ECHO_T$ac_delim LIBS!$LIBS$ac_delim build_alias!$build_alias$ac_delim host_alias!$host_alias$ac_delim target_alias!$target_alias$ac_delim subdirs!$subdirs$ac_delim build!$build$ac_delim build_cpu!$build_cpu$ac_delim build_vendor!$build_vendor$ac_delim build_os!$build_os$ac_delim host!$host$ac_delim host_cpu!$host_cpu$ac_delim host_vendor!$host_vendor$ac_delim host_os!$host_os$ac_delim target!$target$ac_delim target_cpu!$target_cpu$ac_delim target_vendor!$target_vendor$ac_delim target_os!$target_os$ac_delim HostPlatform!$HostPlatform$ac_delim BuildPlatform_CPP!$BuildPlatform_CPP$ac_delim HostPlatform_CPP!$HostPlatform_CPP$ac_delim TargetPlatform_CPP!$TargetPlatform_CPP$ac_delim BuildArch_CPP!$BuildArch_CPP$ac_delim HostArch_CPP!$HostArch_CPP$ac_delim TargetArch_CPP!$TargetArch_CPP$ac_delim BuildOS_CPP!$BuildOS_CPP$ac_delim HostOS_CPP!$HostOS_CPP$ac_delim TargetOS_CPP!$TargetOS_CPP$ac_delim YACC!$YACC$ac_delim YFLAGS!$YFLAGS$ac_delim CC!$CC$ac_delim CFLAGS!$CFLAGS$ac_delim LDFLAGS!$LDFLAGS$ac_delim CPPFLAGS!$CPPFLAGS$ac_delim ac_ct_CC!$ac_ct_CC$ac_delim EXEEXT!$EXEEXT$ac_delim OBJEXT!$OBJEXT$ac_delim CPP!$CPP$ac_delim GREP!$GREP$ac_delim EGREP!$EGREP$ac_delim PTHREAD_CC!$PTHREAD_CC$ac_delim PTHREAD_LIBS!$PTHREAD_LIBS$ac_delim PTHREAD_CFLAGS!$PTHREAD_CFLAGS$ac_delim RM!$RM$ac_delim CP!$CP$ac_delim LD!$LD$ac_delim PERL!$PERL$ac_delim SET_MAKE!$SET_MAKE$ac_delim have_hp2ps!$have_hp2ps$ac_delim DOCBOOK2HTML!$DOCBOOK2HTML$ac_delim DOCBOOK2DVI!$DOCBOOK2DVI$ac_delim DOCBOOK2PDF!$DOCBOOK2PDF$ac_delim DOCBOOK2PS!$DOCBOOK2PS$ac_delim DIFF!$DIFF$ac_delim CONTEXT_DIFF!$CONTEXT_DIFF$ac_delim ALLOCA!$ALLOCA$ac_delim OPTFLAGS!$OPTFLAGS$ac_delim DEBUGFLAGS!$DEBUGFLAGS$ac_delim LDDEBUGFLAGS!$LDDEBUGFLAGS$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 91; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` if test -n "$ac_eof"; then ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` ac_eof=`expr $ac_eof + 1` fi cat >>$CONFIG_STATUS <<_ACEOF cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof /@[a-zA-Z_][a-zA-Z_0-9]*@/!b /^[ ]*@MkInstall@[ ]*$/{ r $MkInstall d } /^[ ]*@MkDepend@[ ]*$/{ r $MkDepend d } _ACEOF sed ' s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g s/^/s,@/; s/!/@,|#_!!_#|/ :n t n s/'"$ac_delim"'$/,g/; t s/$/\\/; p N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n ' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF CEOF$ac_eof _ACEOF ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF FFI_LIBRARIES!$FFI_LIBRARIES$ac_delim HUGSPATH!$HUGSPATH$ac_delim HUGSSUFFIXES!$HUGSSUFFIXES$ac_delim hugsdir!$hugsdir$ac_delim HUGSDIR!$HUGSDIR$ac_delim BINDIR!$BINDIR$ac_delim DLL!$DLL$ac_delim DLL_ENDING!$DLL_ENDING$ac_delim DEV_NULL!$DEV_NULL$ac_delim BAT!$BAT$ac_delim WOBJECTS!$WOBJECTS$ac_delim RC_FILES!$RC_FILES$ac_delim STRIP!$STRIP$ac_delim LIBOBJS!$LIBOBJS$ac_delim LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 15; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` if test -n "$ac_eof"; then ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` ac_eof=`expr $ac_eof + 1` fi cat >>$CONFIG_STATUS <<_ACEOF cat >"\$tmp/subs-2.sed" <<\CEOF$ac_eof /@[a-zA-Z_][a-zA-Z_0-9]*@/!b end _ACEOF sed ' s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g s/^/s,@/; s/!/@,|#_!!_#|/ :n t n s/'"$ac_delim"'$/,g/; t s/$/\\/; p N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n ' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF :end s/|#_!!_#|//g CEOF$ac_eof _ACEOF # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/ s/:*\${srcdir}:*/:/ s/:*@srcdir@:*/:/ s/^\([^=]*=[ ]*\):*/\1/ s/:*$// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF fi # test -n "$CONFIG_FILES" for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 echo "$as_me: error: Invalid tag $ac_tag." >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac ac_file_inputs="$ac_file_inputs $ac_f" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input="Generated from "`IFS=: echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} fi case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin";; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= case `sed -n '/datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p ' $ac_file_inputs` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s&@configure_input@&$configure_input&;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " $ac_file_inputs | sed -f "$tmp/subs-1.sed" | sed -f "$tmp/subs-2.sed" >$tmp/out test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out"; rm -f "$tmp/out";; *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; esac ;; :H) # # CONFIG_HEADER # _ACEOF # Transform confdefs.h into a sed script `conftest.defines', that # substitutes the proper values into config.h.in to produce config.h. rm -f conftest.defines conftest.tail # First, append a space to every undef/define line, to ease matching. echo 's/$/ /' >conftest.defines # Then, protect against being on the right side of a sed subst, or in # an unquoted here document, in config.status. If some macros were # called several times there might be several #defines for the same # symbol, which is useless. But do not sort them, since the last # AC_DEFINE must be honored. ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* # These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where # NAME is the cpp macro being defined, VALUE is the value it is being given. # PARAMS is the parameter list in the macro definition--in most cases, it's # just an empty string. ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' ac_dB='\\)[ (].*,\\1define\\2' ac_dC=' ' ac_dD=' ,' uniq confdefs.h | sed -n ' t rset :rset s/^[ ]*#[ ]*define[ ][ ]*// t ok d :ok s/[\\&,]/\\&/g s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p ' >>conftest.defines # Remove the space that was appended to ease matching. # Then replace #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. # (The regexp can be short, since the line contains either #define or #undef.) echo 's/ $// s,^[ #]*u.*,/* & */,' >>conftest.defines # Break up conftest.defines: ac_max_sed_lines=50 # First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" # Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" # Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" # et cetera. ac_in='$ac_file_inputs' ac_out='"$tmp/out1"' ac_nxt='"$tmp/out2"' while : do # Write a here document: cat >>$CONFIG_STATUS <<_ACEOF # First, check the format of the line: cat >"\$tmp/defines.sed" <<\\CEOF /^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def /^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def b :def _ACEOF sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail grep . conftest.tail >/dev/null || break rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines conftest.tail echo "ac_result=$ac_in" >>$CONFIG_STATUS cat >>$CONFIG_STATUS <<\_ACEOF if test x"$ac_file" != x-; then echo "/* $configure_input */" >"$tmp/config.h" cat "$ac_result" >>"$tmp/config.h" if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else rm -f $ac_file mv "$tmp/config.h" $ac_file fi else echo "/* $configure_input */" cat "$ac_result" fi rm -f "$tmp/out12" ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi # # CONFIG_SUBDIRS section. # if test "$no_recursion" != yes; then # Remove --cache-file and --srcdir arguments so they do not pile up. ac_sub_configure_args= ac_prev= eval "set x $ac_configure_args" shift for ac_arg do if test -n "$ac_prev"; then ac_prev= continue fi case $ac_arg in -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* \ | --c=*) ;; --config-cache | -C) ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) ;; *) case $ac_arg in *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac ac_sub_configure_args="$ac_sub_configure_args '$ac_arg'" ;; esac done # Always prepend --prefix to ensure using the same prefix # in subdir configurations. ac_arg="--prefix=$prefix" case $ac_arg in *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac ac_sub_configure_args="$ac_arg $ac_sub_configure_args" ac_popdir=`pwd` for ac_dir in : $subdirs; do test "x$ac_dir" = x: && continue # Do not complain, so a configure script can configure whichever # parts of a large source tree are present. test -d "$srcdir/$ac_dir" || continue ac_msg="=== configuring in $ac_dir (`pwd`/$ac_dir)" echo "$as_me:$LINENO: $ac_msg" >&5 echo "$ac_msg" >&6 { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" # Check for guested configure; otherwise get Cygnus style configure. if test -f "$ac_srcdir/configure.gnu"; then ac_sub_configure=$ac_srcdir/configure.gnu elif test -f "$ac_srcdir/configure"; then ac_sub_configure=$ac_srcdir/configure elif test -f "$ac_srcdir/configure.in"; then # This should be Cygnus configure. ac_sub_configure=$ac_aux_dir/configure else { echo "$as_me:$LINENO: WARNING: no configuration information is in $ac_dir" >&5 echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2;} ac_sub_configure= fi # The recursion is here. if test -n "$ac_sub_configure"; then # Make the cache file name correct relative to the subdirectory. case $cache_file in [\\/]* | ?:[\\/]* ) ac_sub_cache_file=$cache_file ;; *) # Relative name. ac_sub_cache_file=$ac_top_build_prefix$cache_file ;; esac { echo "$as_me:$LINENO: running $SHELL $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_srcdir" >&5 echo "$as_me: running $SHELL $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_srcdir" >&6;} # The eval makes quoting arguments work. eval "\$SHELL \"\$ac_sub_configure\" $ac_sub_configure_args \ --cache-file=\"\$ac_sub_cache_file\" --srcdir=\"\$ac_srcdir\"" || { { echo "$as_me:$LINENO: error: $ac_sub_configure failed for $ac_dir" >&5 echo "$as_me: error: $ac_sub_configure failed for $ac_dir" >&2;} { (exit 1); exit 1; }; } fi cd "$ac_popdir" done fi echo '' echo '************************************************' echo '*** NOW DO: make ; make install' echo '************************************************' exit 0